DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / cpc.git / blob


9df3961d6c067c22ccc57a3672d525ed4631c20b
[cpc.git] / src / generic / Dsw / Mod / MakeMain.cp
1 MODULE DswMakeMain;
2
3 IMPORT Kernel, Files, Log, Strings, DswOpts, DswProcs, DswDocuments, DevCPM, DevCPT, DevCPR, DevCPS;
4
5 CONST
6 version = "0.3.0";
7
8 maxImps = 127;
9 maxJobs = maxImps;
10
11 (* symbol values *)
12 null = 0; times = 1; slash = 2; div = 3; mod = 4;
13 and = 5; plus = 6; minus = 7; or = 8; eql = 9;
14 neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
15 in = 15; is = 16; arrow = 17; dollar = 18; period = 19;
16 comma = 20; colon = 21; upto = 22; rparen = 23; rbrak = 24;
17 rbrace = 25; of = 26; then = 27; do = 28; to = 29;
18 by = 30; not = 33;
19 lparen = 40; lbrak = 41; lbrace = 42; becomes = 44;
20 number = 45; nil = 46; string = 47; ident = 48; semicolon = 49;
21 bar = 50; end = 51; else = 52; elsif = 53; until = 54;
22 if = 55; case = 56; while = 57; repeat = 58; for = 59;
23 loop = 60; with = 61; exit = 62; return = 63; array = 64;
24 record = 65; pointer = 66; begin = 67; const = 68; type = 69;
25 var = 70; out = 71; procedure = 72; close = 73; import = 74;
26 module = 75; eof = 76;
27
28 (* module state flags *)
29 imported = 0; trace = 1; hasObj = 2; hasSym = 3; hasErrors = 4; library = 5;
30
31 (* procesor types *)
32 anymach = 0; cmach = 1; mach386 = 10; mach68k = 20;
33
34 (* operation system types *)
35 anyos = 0; linux = 1; freebsd = 2; openbsd = 3; win32 = 4; cygwin = 5; darwin = 6;
36
37 (* compiler types *)
38 anycp = 0; cpnative = 1; cpfront = 2;
39
40 (* internal linker types *)
41 anyint = 0; dev2 = 1;
42
43 debugImport = FALSE;
44 debugOrder = FALSE;
45 debugJobs = FALSE;
46 debugArgs = FALSE;
47
48 TYPE
49 String = POINTER TO ARRAY OF CHAR;
50 StringList = POINTER TO ARRAY OF String;
51
52 Selector = POINTER TO RECORD
53 name: DevCPT.Name;
54 value: BOOLEAN;
55 next: Selector
56 END;
57
58 Module = POINTER TO RECORD
59 name: DevCPT.Name;
60 path: Files.Name;
61 selectors: Selector; (* with head, list of selectors for this module *)
62 depth: INTEGER; (* 0: leaf, MAX: root *)
63 mno: INTEGER;
64 imp: ARRAY maxImps OF Module;
65 flags: SET;
66 worker: DswProcs.Process;
67 END;
68
69 VAR
70 err: INTEGER;
71 mno, rno: INTEGER; (* num modules *)
72 modList, lnkList, cmpList: ARRAY maxImps OF Module;
73 def: Selector; (* with head, global list of selectors *)
74 processor, compiler, os, linker: INTEGER;
75 cpcExe, cplExe: String;
76 cpcArgs, cplArgs: StringList;
77 auto: BOOLEAN;
78 jobs: INTEGER;
79 exe: String;
80
81 (* --------- options --------- *)
82
83 PROCEDURE IdentLen (IN s: ARRAY OF CHAR): INTEGER;
84 VAR i: INTEGER;
85 BEGIN
86 i := 0;
87 IF Strings.IsIdentStart(s[0]) THEN
88 REPEAT INC(i) UNTIL ~Strings.IsIdent(s[i])
89 END;
90 RETURN i
91 END IdentLen;
92
93 PROCEDURE Define (n: ARRAY OF CHAR);
94 VAR i: INTEGER; v: BOOLEAN; s: Selector;
95 BEGIN
96 i := IdentLen(n);
97 IF i # 0 THEN
98 IF ~((n[i] = 0X) OR (((n[i] = "+") OR (n[i] = "-")) & (n[i + 1] = 0X))) THEN
99 Log.String("option -D expect + or - after identifier"); Log.Ln; INC(err)
100 END;
101 v := n[i] # "-"; n[i] := 0X; s := def;
102 WHILE (s.next # NIL) & (s.next.name$ # n$) DO s := s.next END;
103 IF s.next = NIL THEN
104 NEW(s.next);
105 Strings.StringToUtf8(n, s.next.name, i);
106 ASSERT(i = 0)
107 END;
108 s.next.value := v
109 ELSE
110 Log.String("option -D expect identifier"); Log.Ln; INC(err)
111 END
112 END Define;
113
114 PROCEDURE Undefine (IN n: ARRAY OF CHAR);
115 VAR i: INTEGER; s: Selector;
116 BEGIN
117 i := IdentLen(n);
118 IF (i # 0) & (n[i] = 0X) THEN
119 s := def;
120 WHILE (s.next # NIL) & (s.next.name$ # n$) DO s := s.next END;
121 IF s.next # NIL THEN s.next := s.next.next END
122 ELSE
123 Log.String("option -U expect identifier"); Log.Ln; INC(err)
124 END
125 END Undefine;
126
127 PROCEDURE CopySelectorList (base: Selector): Selector;
128 VAR s, t, x: Selector;
129 BEGIN
130 ASSERT(base # NIL, 20);
131 s := base; NEW(t); x := t;
132 WHILE s # NIL DO
133 x^ := s^;
134 IF s.next # NIL THEN NEW(x.next); x := x.next END;
135 s := s.next
136 END;
137 RETURN t
138 END CopySelectorList;
139
140 PROCEDURE AddModule (IN n: ARRAY OF CHAR; selectors: Selector);
141 VAR i, res: INTEGER; m: Module;
142 BEGIN
143 i := IdentLen(n);
144 IF (i # 0) & (n[i] = 0X) THEN
145 i := 0;
146 WHILE (i < mno) & (modList[i].name$ # n$) DO INC(i) END;
147 IF i >= mno THEN
148 NEW(m);
149 Strings.StringToUtf8(n, m.name, res);
150 ASSERT(res = 0);
151 m.selectors := CopySelectorList(selectors);
152 modList[i] := m;
153 INC(mno)
154 END
155 ELSE
156 Log.String("module name must be identifier"); Log.Ln; INC(err)
157 END
158 END AddModule;
159
160 PROCEDURE StrToInt (IN s: ARRAY OF CHAR; def: INTEGER): INTEGER;
161 VAR x, res: INTEGER;
162 BEGIN
163 Strings.StringToInt(s, x, res);
164 IF res # 0 THEN
165 Log.String("expected integer"); Log.Ln; INC(err);
166 x := def
167 END;
168 RETURN x
169 END StrToInt;
170
171 PROCEDURE NewStr (IN s: ARRAY OF CHAR): String;
172 VAR p: String;
173 BEGIN
174 NEW(p, LEN(s$) + 1); p^ := s$;
175 RETURN p
176 END NewStr;
177
178 PROCEDURE ToStringList (IN s: ARRAY OF CHAR): StringList;
179 VAR i: INTEGER; ch, term: CHAR; pars: StringList;
180
181 PROCEDURE AddChar (c: CHAR);
182 VAR i, n, len: INTEGER; str: String;
183 BEGIN
184 IF pars = NIL THEN
185 NEW(pars, 1); NEW(pars[0], 2); pars[0, 0] := c
186 ELSE
187 n := LEN(pars) - 1;
188 len := LEN(pars[n]$);
189 NEW(str, len + 2);
190 FOR i := 0 TO len - 1 DO
191 str[i] := pars[n, i]
192 END;
193 str[i] := c;
194 pars[n] := str
195 END
196 END AddChar;
197
198 PROCEDURE AddLine;
199 VAR i, len: INTEGER; p: StringList;
200 BEGIN
201 IF pars = NIL THEN
202 NEW(pars, 1); i := 0;
203 ELSE
204 len := LEN(pars);
205 NEW(p, len + 1);
206 FOR i := 0 TO len - 1 DO
207 p[i] := pars[i]
208 END;
209 pars := p
210 END;
211 NEW(pars[i], 1)
212 END AddLine;
213
214 BEGIN
215 i := 0;
216 REPEAT ch := s[i]; INC(i) UNTIL ch # " ";
217 WHILE ch # 0X DO
218 CASE ch OF
219 | '"', "'":
220 term := ch; ch := s[i]; INC(i);
221 WHILE (ch # term) & (ch # 0X) DO
222 AddChar(ch); ch := s[i]; INC(i)
223 END;
224 IF ch # 0X THEN ch := s[i]; INC(i)
225 ELSE Log.String("unterminated string"); Log.Ln; INC(err)
226 END
227 | " ":
228 REPEAT ch := s[i]; INC(i) UNTIL ch # " ";
229 IF ch # 0X THEN AddLine END
230 ELSE
231 AddChar(ch); ch := s[i]; INC(i)
232 END
233 END;
234 RETURN pars
235 END ToStringList;
236
237 PROCEDURE Help;
238 BEGIN
239 Log.String("Usage: cpmake [options] module..."); Log.Ln;
240 Log.String("Options:"); Log.Ln;
241 Log.String(" -Tm cpu Generate code for specified processor"); Log.Ln;
242 Log.String(" none Unknown processor (cpfront only)"); Log.Ln;
243 Log.String(" 486 Intel 486"); Log.Ln;
244 Log.String(" -Ts os Generate code for specified operation system"); Log.Ln;
245 Log.String(" none Unknown operation system"); Log.Ln;
246 Log.String(" linux Linux"); Log.Ln;
247 Log.String(" -Tg compiler Specify Component Pascal compiler"); Log.Ln;
248 Log.String(" native BlackBox based native code compiler"); Log.Ln;
249 Log.String(" cpfront BlackBox based C code translator"); Log.Ln;
250 Log.String(" -Ti linker Specify internal linker (native only)"); Log.Ln;
251 Log.String(" dev2 Dev2 based ELF/PE linker"); Log.Ln;
252 (*
253 Log.String(" -Fp path Add path with project"); Log.Ln;
254 Log.String(" -Fx path Add postfix for project directories"); Log.Ln;
255 *)
256 Log.String(" -Xp path Use executable file for Component Pascal compiler"); Log.Ln;
257 Log.String(" -Xi path Use executable file for internal linker (native only)"); Log.Ln;
258 Log.String(" -Cg params Pass parameters to Component Pasacal compiler directly"); Log.Ln;
259 Log.String(" -Ci params Pass parameters to internal linker directly"); Log.Ln;
260 (*
261 Log.String(" -a Enable automatic dependency resolution"); Log.Ln;
262 *)
263 Log.String(" -o name Generate executable file"); Log.Ln;
264 Log.String(" -j num Specifies the number of jobs to run simultaneously"); Log.Ln;
265 Log.String(' -D ident["+"|"-"] Add preprocessor selector'); Log.Ln;
266 Log.String(' -U ident Remove preprocessor selector'); Log.Ln;
267 Log.String(" -h Print help and quit"); Log.Ln;
268 Log.String(" -V Print version and quit"); Log.Ln;
269 Kernel.Quit(1)
270 END Help;
271
272 PROCEDURE Version;
273 BEGIN
274 Log.String(version); Log.Ln;
275 Kernel.Quit(0)
276 END Version;
277
278 PROCEDURE ParseTargetOpts;
279 VAR s: DswOpts.String;
280 BEGIN
281 CASE DswOpts.GetOpt("m:s:g:i:") OF
282 | "m":
283 s := DswOpts.str;
284 Strings.ToLower(s, s);
285 IF s$ = "none" THEN processor := anymach
286 ELSIF s$ = "486" THEN processor := mach386
287 ELSIF s$ = "68k" THEN processor := mach68k
288 ELSE Log.String("unknwon processor "); Log.String(s); Log.Ln; INC(err)
289 END
290 | "s":
291 s := DswOpts.str;
292 Strings.ToLower(s, s);
293 IF s$ = "none" THEN os := anyos
294 ELSIF s$ = "linux" THEN os := linux
295 ELSIF s$ = "freebsd" THEN os := freebsd
296 ELSIF s$ = "openbsd" THEN os := openbsd
297 ELSIF s$ = "win32" THEN os := win32
298 ELSIF s$ = "cygwin" THEN os := cygwin
299 ELSIF s$ = "darwin" THEN os := darwin
300 ELSE Log.String("unknwon os "); Log.String(s); Log.Ln; INC(err)
301 END
302 | "g":
303 s := DswOpts.str;
304 Strings.ToLower(s, s);
305 IF s$ = "native" THEN compiler := cpnative
306 ELSIF s$ = "cpfront" THEN compiler := cpfront
307 ELSE Log.String("unknwon compiler "); Log.String(s); Log.Ln; INC(err)
308 END
309 | "i":
310 s := DswOpts.str;
311 Strings.ToLower(s, s);
312 IF s$ = "dev2" THEN linker := dev2
313 ELSE Log.String("unknwon linker "); Log.String(s); Log.Ln; INC(err)
314 END
315 | ":": Log.String("missing argument for option -T"); Log.String(DswOpts.str); Log.Ln; INC(err)
316 | "?": Log.String("unknown option -T"); Log.String(DswOpts.str); Log.Ln; INC(err)
317 | 0X: Log.String("unknown option -T"); Log.Ln; INC(err)
318 END
319 END ParseTargetOpts;
320
321 PROCEDURE ParseCommandOpts;
322 BEGIN
323 CASE DswOpts.GetOpt("g:i:") OF
324 | "g": cpcArgs := ToStringList(DswOpts.str);
325 | "i": cplArgs := ToStringList(DswOpts.str);
326 | ":": Log.String("missing argument for option -C"); Log.String(DswOpts.str); Log.Ln; INC(err)
327 | "?": Log.String("unknown option -C"); Log.String(DswOpts.str); Log.Ln; INC(err)
328 | 0X: Log.String("unknown option -C"); Log.Ln; INC(err)
329 END
330 END ParseCommandOpts;
331
332 PROCEDURE ParseExternalOpts;
333 BEGIN
334 CASE DswOpts.GetOpt("g:i:") OF
335 | "g": cpcExe := DswOpts.str;
336 | "i": cplExe := DswOpts.str;
337 | ":": Log.String("missing argument for option -X"); Log.String(DswOpts.str); Log.Ln; INC(err)
338 | "?": Log.String("unknown option -X"); Log.String(DswOpts.str); Log.Ln; INC(err)
339 | 0X: Log.String("unknown option -X"); Log.Ln; INC(err)
340 END
341 END ParseExternalOpts;
342
343 PROCEDURE ParseArgs;
344 BEGIN
345 exe := NIL; auto := FALSE; jobs := 1; def.next := NIL; mno := 0; rno := 0;
346 processor := anymach; os := anyos; compiler := anycp;
347 LOOP
348 CASE DswOpts.GetOpt("ao:j:D:U:TCXhV") OF
349 | "a": auto := TRUE
350 | "o": exe := DswOpts.str
351 | "j": jobs := MIN(MAX(StrToInt(DswOpts.str, 1), 1), maxJobs)
352 | "h": Help
353 | "V": Version
354 | "D": Define(DswOpts.str)
355 | "U": Undefine(DswOpts.str)
356 | "T": ParseTargetOpts
357 | "C": ParseCommandOpts
358 | "X": ParseExternalOpts
359 | ":": Log.String("missing argument for option -"); Log.String(DswOpts.str); Log.Ln; INC(err)
360 | "?": Log.String("unknown option -"); Log.String(DswOpts.str); Log.Ln; INC(err)
361 | "$": AddModule(DswOpts.str, def)
362 | 0X: EXIT
363 END
364 END;
365 END ParseArgs;
366
367 PROCEDURE CheckParams;
368 BEGIN
369 IF compiler = anycp THEN
370 Log.String("compiler not selected"); Log.Ln; INC(err)
371 ELSIF compiler = cpnative THEN
372 IF processor = anymach THEN
373 Log.String("processor not selected"); Log.Ln; INC(err)
374 ELSIF processor # mach386 THEN
375 Log.String("processor not supported by native compiler"); Log.Ln; INC(err)
376 END
377 END;
378 IF (compiler = cpfront) & (linker # anyint) THEN
379 Log.String("internal linker not required for cpfront"); Log.Ln; INC(err)
380 END;
381 IF (compiler = cpfront) & (exe # NIL) THEN
382 Log.String("cpfront can't out executable file"); Log.Ln; INC(err)
383 END;
384 IF (exe # NIL) & (compiler = cpnative) & (linker = anyint) THEN
385 Log.String("linker not selected"); Log.Ln; INC(err)
386 END;
387 IF (linker = dev2) & (os = anyos) THEN
388 Log.String("os not selected"); Log.Ln; INC(err)
389 END;
390 IF (exe # NIL) & (exe^ = "") THEN
391 Log.String("output file name can't be empty"); Log.Ln; INC(err)
392 END;
393 IF cpcExe = NIL THEN
394 IF compiler = cpnative THEN cpcExe := NewStr("cpc486")
395 ELSIF compiler = cpfront THEN cpcExe := NewStr("cpfront")
396 END
397 END;
398 IF cplExe = NIL THEN
399 IF linker = dev2 THEN cplExe := NewStr("cpl486") END
400 END
401 END CheckParams;
402
403 (* --------- loader --------- *)
404
405 PROCEDURE Import (m: Module; IN name: DevCPT.Name);
406 VAR i, j: INTEGER; imp: Module;
407 BEGIN
408 ASSERT(m # NIL, 20);
409 ASSERT(name # "", 21);
410 IF debugImport THEN Log.String(" import "); Log.String(name$) END;
411 IF name = "SYSTEM" THEN INCL(DevCPM.options, DevCPM.sysImp)
412 ELSIF name = "COM" THEN INCL(DevCPM.options, DevCPM.com)
413 ELSIF name = "JAVA" THEN INCL(DevCPM.options, DevCPM.java)
414 ELSE
415 IF debugImport THEN Log.Char(" ") END;
416 i := 0; (* find module in local list *)
417 WHILE (i < m.mno) & (m.imp[i].name$ # name$) DO INC(i) END;
418 IF i >= m.mno THEN
419 j := 0; (* find module in global list *)
420 WHILE (j < mno) & (modList[j].name$ # name$) DO INC(j) END;
421 IF j >= mno THEN
422 NEW(imp); imp.name := name$; imp.selectors := CopySelectorList(m.selectors);
423 modList[mno] := imp; INC(mno)
424 ELSE
425 imp := modList[j]
426 END;
427 m.imp[m.mno] := imp; INC(m.mno)
428 ELSE DevCPM.err(1)
429 END
430 END;
431 IF debugImport THEN Log.Ln END;
432 END Import;
433
434 PROCEDURE ParseModule (m: Module);
435 VAR sym: BYTE; SelfName, impName, aliasName: DevCPT.Name;
436
437 PROCEDURE err (n: SHORTINT);
438 BEGIN DevCPM.err(n)
439 END err;
440
441 PROCEDURE CheckSym(s: SHORTINT);
442 BEGIN
443 IF sym = s THEN DevCPS.Get(sym) ELSE DevCPM.err(s) END
444 END CheckSym;
445
446 BEGIN
447 IF debugImport THEN Log.String("module " + m.name); Log.Ln END;
448 DevCPS.Init; DevCPS.Get(sym);
449 IF sym = module THEN DevCPS.Get(sym) ELSE err(16) END;
450 IF sym = ident THEN
451 SelfName := DevCPS.name$; DevCPS.Get(sym);
452 IF sym = lbrak THEN
453 INCL(DevCPM.options, DevCPM.interface); DevCPS.Get(sym);
454 IF sym = eql THEN DevCPS.Get(sym)
455 ELSE INCL(DevCPM.options, DevCPM.noCode)
456 END;
457 IF sym = string THEN INCL(m.flags, library); DevCPS.Get(sym)
458 ELSE err(string)
459 END;
460 CheckSym(rbrak)
461 END;
462 CheckSym(semicolon);
463 IF sym = import THEN DevCPS.Get(sym);
464 LOOP
465 IF sym = ident THEN
466 aliasName := DevCPS.name$; impName := aliasName$; DevCPS.Get(sym);
467 IF sym = becomes THEN DevCPS.Get(sym);
468 IF sym = ident THEN impName := DevCPS.name$; DevCPS.Get(sym) ELSE err(ident) END
469 END;
470 Import(m, impName)
471 ELSE err(ident)
472 END;
473 IF sym = comma THEN DevCPS.Get(sym)
474 ELSIF sym = ident THEN err(comma)
475 ELSE EXIT
476 END
477 END;
478 CheckSym(semicolon)
479 END
480 ELSE err(ident)
481 END;
482 DevCPS.str := NIL
483 END ParseModule;
484
485 PROCEDURE CheckModule (m: Module; source: String; OUT ok: BOOLEAN);
486 VAR s: Selector;
487 BEGIN
488 DevCPM.Init(source);
489 (*
490 DevCPM.symList := m.insym;
491 DevCPM.codePath := m.outcode;
492 DevCPM.symPath := m.outsym;
493 *)
494 DevCPM.name := m.name$;
495 (*
496 IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END;
497 IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END;
498 IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;
499 *)
500 DevCPR.Init;
501 s := m.selectors.next;
502 WHILE s # NIL DO
503 DevCPR.Set(s.name, s.value);
504 s := s.next
505 END;
506 ParseModule(m);
507 DevCPR.Check;
508 ok := DevCPM.noerr;
509 DevCPR.Close;
510 DevCPM.InsertMarks;
511 DevCPM.Close;
512 Kernel.FastCollect
513 END CheckModule;
514
515 PROCEDURE GetSource (IN modName: ARRAY OF CHAR; OUT path: Files.Name; OUT s: String);
516 CONST modDir = "Mod"; sysDir = "System";
517 VAR dir, name: Files.Name; loc: Files.Locator;
518 text: DswDocuments.Model; r: DswDocuments.Reader; i, res: INTEGER;
519
520 PROCEDURE MakePath (dir, name: Files.Name; type: Files.Type; OUT path: Files.Name);
521 BEGIN
522 ASSERT(name # "", 21);
523 IF dir = "" THEN path := modDir + "/" + name
524 ELSE path := dir + "/" + modDir + "/" + name
525 END;
526 Kernel.MakeFileName(path, type)
527 END MakePath;
528
529 BEGIN
530 s := NIL; path := "";
531 Kernel.SplitName(modName, dir, name);
532 loc := Files.dir.This(dir).This(modDir);
533 (* --> Kernel.MakeFileName(name, Kernel.docType); <-- *)
534 MakePath(dir, name, "cp", path);
535 DswDocuments.Open(loc, name + ".cp", text, res);
536 IF text = NIL THEN
537 MakePath(dir, name, "odc", path);
538 DswDocuments.Open(loc, name + ".odc", text, res);
539 IF (text = NIL) & (dir = "") THEN
540 MakePath(sysDir, name, "cp", path);
541 loc := Files.dir.This(sysDir).This(modDir);
542 DswDocuments.Open(loc, name + ".cp", text, res);
543 IF text = NIL THEN
544 MakePath(sysDir, name, "odc", path);
545 DswDocuments.Open(loc, name + ".odc", text, res);
546 IF text = NIL THEN
547 path := ""
548 END
549 END
550 END
551 END;
552 IF text # NIL THEN
553 NEW(s, text.Length() + 1);
554 IF s # NIL THEN
555 r := text.NewReader(NIL);
556 FOR i := 0 TO text.Length() - 1 DO
557 r.Read; s[i] := r.char
558 END
559 END
560 END
561 END GetSource;
562
563 PROCEDURE Trace (m, parent: Module; VAR lno: INTEGER);
564 VAR i: INTEGER;
565 BEGIN
566 IF ~(trace IN m.flags) THEN
567 INCL(m.flags, trace);
568 FOR i := 0 TO m.mno - 1 DO
569 Trace(m.imp[i], m, lno);
570 m.depth := MAX(m.depth, m.imp[i].depth + 1)
571 END;
572 IF ~(imported IN m.flags) THEN
573 INCL(m.flags, imported);
574 lnkList[lno] := m;
575 INC(lno)
576 END;
577 EXCL(m.flags, trace)
578 ELSE
579 Log.String("recursive import of " + m.name + " in " + parent.name); Log.Ln; INC(err)
580 END
581 END Trace;
582
583 PROCEDURE Sort;
584 VAR i, j: INTEGER; m: Module;
585 BEGIN
586 ASSERT((mno = 0) OR (lnkList[0] # NIL), 20);
587 cmpList := lnkList;
588 i := 1;
589 WHILE i < mno DO
590 m := cmpList[i];
591 j := i - 1;
592 WHILE (j >= 0) & (cmpList[j].depth > m.depth) DO
593 cmpList[j + 1] := cmpList[j];
594 DEC(j)
595 END;
596 cmpList[j + 1] := m;
597 INC(i)
598 END
599 END Sort;
600
601 PROCEDURE CheckDeps;
602 VAR i, j, num: INTEGER; m: Module; s: String; ok: BOOLEAN;
603 BEGIN
604 i := 0; rno := mno;
605 WHILE (err = 0) & (i < mno) DO
606 m := modList[i];
607 GetSource(m.name$, m.path, s);
608 IF s # NIL THEN
609 CheckModule(m, s, ok);
610 IF ~ok THEN INC(err) END
611 ELSE
612 Log.String("unable to open module " + m.name); Log.Ln; INC(err)
613 END;
614 INC(i)
615 END;
616 num := 0;
617 FOR i := 0 TO rno - 1 DO
618 Trace(modList[i], modList[i], num)
619 END;
620 ASSERT((err # 0) OR (num = mno), 100);
621 Sort;
622 IF debugOrder THEN
623 Log.String("Parallel depth:"); Log.Ln;
624 FOR i := 0 TO mno - 1 DO
625 Log.String(" " + cmpList[i].name); Log.Int(cmpList[i].depth); Log.Ln;
626 END
627 END
628 END CheckDeps;
629
630 PROCEDURE IsCompiled (m: Module): BOOLEAN;
631 CONST target = {hasSym, hasObj};
632 VAR i: INTEGER; ready: BOOLEAN;
633 BEGIN
634 ASSERT(m # NIL, 20);
635 i := 0;
636 ready := ~(hasErrors IN m.flags) & (m.flags * target = target);
637 WHILE ready & (i < m.mno) DO
638 ready := IsCompiled(m.imp[i]);
639 INC(i)
640 END;
641 RETURN ready
642 END IsCompiled;
643
644 PROCEDURE Ready (m: Module): BOOLEAN;
645 CONST target = {hasSym, hasObj};
646 VAR i: INTEGER; ready: BOOLEAN;
647 BEGIN
648 i := 0;
649 ready := ~(hasErrors IN m.flags) & (m.flags * target # target) & (m.worker = NIL);
650 WHILE ready & (i < m.mno) DO
651 ready := IsCompiled(m.imp[i]);
652 INC(i)
653 END;
654 RETURN ready
655 END Ready;
656
657 PROCEDURE PutParams (w: DswProcs.Process; p: StringList);
658 VAR i: INTEGER;
659 BEGIN
660 ASSERT(w # NIL, 20);
661 IF debugArgs THEN Log.String("PutParams") END;
662 IF p # NIL THEN
663 IF debugArgs THEN Log.String(":[" + p[0]) END;
664 w.PutParam(p[0]);
665 FOR i := 1 TO LEN(p) - 1 DO
666 IF debugArgs THEN Log.String("|" + p[i]) END;
667 w.PutParam(p[i])
668 END;
669 IF debugArgs THEN Log.Char("]") END
670 END;
671 IF debugArgs THEN Log.Ln END
672 END PutParams;
673
674 PROCEDURE ExecuteCompiler (m: Module): DswProcs.Process;
675 VAR w: DswProcs.Process; ok: BOOLEAN;
676 BEGIN
677 ASSERT(m # NIL, 20);
678 ASSERT(m.path # "", 21);
679 ASSERT(m.worker = NIL, 22);
680 w := DswProcs.dir.New();
681 w.Program(cpcExe);
682 w.PutParam("-legacy");
683 PutParams(w, cpcArgs);
684 CASE compiler OF
685 | cpfront:
686 w.PutParam("-define+"); w.PutParam("CPFRONT");
687 w.PutParam("-define-"); w.PutParam("NATIVE");
688 | cpnative:
689 w.PutParam("-define-"); w.PutParam("CPFRONT");
690 w.PutParam("-define+"); w.PutParam("NATIVE");
691 END;
692 CASE processor OF
693 | mach386:
694 w.PutParam("-define+"); w.PutParam("I486");
695 w.PutParam("-define-"); w.PutParam("M68K");
696 | mach68k:
697 w.PutParam("-define+"); w.PutParam("I486");
698 w.PutParam("-define-"); w.PutParam("M68K");
699 ELSE
700 w.PutParam("-define-"); w.PutParam("I486");
701 w.PutParam("-define-"); w.PutParam("M68K");
702 END;
703 CASE os OF
704 | anyos:
705 w.PutParam("-define-"); w.PutParam("POSIX");
706 w.PutParam("-define-"); w.PutParam("LINUX");
707 w.PutParam("-define-"); w.PutParam("FREEBSD");
708 w.PutParam("-define-"); w.PutParam("OPENBSD");
709 w.PutParam("-define-"); w.PutParam("WIN32");
710 w.PutParam("-define-"); w.PutParam("DARWIN");
711 | linux:
712 w.PutParam("-define+"); w.PutParam("POSIX");
713 w.PutParam("-define+"); w.PutParam("LINUX");
714 w.PutParam("-define-"); w.PutParam("FREEBSD");
715 w.PutParam("-define-"); w.PutParam("OPENBSD");
716 w.PutParam("-define-"); w.PutParam("WIN32");
717 w.PutParam("-define-"); w.PutParam("DARWIN");
718 | freebsd:
719 w.PutParam("-define+"); w.PutParam("POSIX");
720 w.PutParam("-define-"); w.PutParam("LINUX");
721 w.PutParam("-define+"); w.PutParam("FREEBSD");
722 w.PutParam("-define-"); w.PutParam("OPENBSD");
723 w.PutParam("-define-"); w.PutParam("WIN32");
724 w.PutParam("-define-"); w.PutParam("CYGWIN");
725 w.PutParam("-define-"); w.PutParam("DARWIN");
726 | openbsd:
727 w.PutParam("-define+"); w.PutParam("POSIX");
728 w.PutParam("-define-"); w.PutParam("LINUX");
729 w.PutParam("-define-"); w.PutParam("FREEBSD");
730 w.PutParam("-define+"); w.PutParam("OPENBSD");
731 w.PutParam("-define-"); w.PutParam("WIN32");
732 w.PutParam("-define-"); w.PutParam("CYGWIN");
733 w.PutParam("-define-"); w.PutParam("DARWIN");
734 | win32:
735 w.PutParam("-define-"); w.PutParam("POSIX");
736 w.PutParam("-define-"); w.PutParam("LINUX");
737 w.PutParam("-define-"); w.PutParam("FREEBSD");
738 w.PutParam("-define-"); w.PutParam("OPENBSD");
739 w.PutParam("-define+"); w.PutParam("WIN32");
740 w.PutParam("-define-"); w.PutParam("CYGWIN");
741 w.PutParam("-define-"); w.PutParam("DARWIN");
742 | cygwin:
743 w.PutParam("-define+"); w.PutParam("POSIX");
744 w.PutParam("-define-"); w.PutParam("LINUX");
745 w.PutParam("-define-"); w.PutParam("FREEBSD");
746 w.PutParam("-define-"); w.PutParam("OPENBSD");
747 w.PutParam("-define+"); w.PutParam("WIN32");
748 w.PutParam("-define+"); w.PutParam("CYGWIN");
749 w.PutParam("-define-"); w.PutParam("DARWIN");
750 | darwin:
751 w.PutParam("-define+"); w.PutParam("POSIX");
752 w.PutParam("-define-"); w.PutParam("LINUX");
753 w.PutParam("-define-"); w.PutParam("FREEBSD");
754 w.PutParam("-define-"); w.PutParam("OPENBSD");
755 w.PutParam("-define-"); w.PutParam("WIN32");
756 w.PutParam("-define-"); w.PutParam("CYGWIN");
757 w.PutParam("-define+"); w.PutParam("DARWIN");
758 END;
759 CASE linker OF
760 | dev2:
761 w.PutParam("-define+"); w.PutParam("DEV2");
762 ELSE
763 w.PutParam("-define-"); w.PutParam("DEV2");
764 END;
765 w.PutParam(m.path);
766 w.Execute(ok);
767 IF ok THEN
768 Log.String("Compile " + m.name + " (" + m.path + ")"); Log.Ln;
769 ELSE
770 w := NIL
771 END;
772 RETURN w
773 END ExecuteCompiler;
774
775 PROCEDURE Compile;
776 VAR i, j, num: INTEGER; ok: BOOLEAN; m: Module; w: DswProcs.Process;
777 BEGIN
778 IF mno = 0 THEN RETURN END;
779 num := 0; j := 0;
780 WHILE (err = 0) & (num < mno) OR (j > 0) DO
781 i := 0;
782 WHILE (err = 0) & (i < mno) & (j < jobs) DO
783 m := cmpList[i];
784 IF Ready(m) THEN
785 w := ExecuteCompiler(m);
786 IF debugJobs THEN Log.String("Start job " + m.name) END;
787 IF w # NIL THEN
788 IF debugJobs THEN Log.String(" ok") END;
789 m.worker := w;
790 INC(j)
791 ELSE
792 IF debugJobs THEN Log.String(" fail") END;
793 INCL(m.flags, hasErrors);
794 INC(err)
795 END;
796 IF debugJobs THEN Log.Ln END
797 END;
798 INC(i)
799 END;
800 WHILE (err = 0) & (j >= jobs) OR (j > 0) DO
801 i := 0;
802 WHILE (j > 0) & (i < mno) DO
803 m := cmpList[i];
804 w := m.worker;
805 IF (w # NIL) & w.IsTerminated() THEN
806 IF debugJobs THEN Log.String("Stop job " + m.name); Log.Int(w.Result()); Log.Ln END;
807 IF w.Result() = 0 THEN
808 INCL(m.flags, hasObj);
809 INCL(m.flags, hasSym);
810 INC(num)
811 ELSE
812 INCL(m.flags, hasErrors);
813 INC(err)
814 END;
815 m.worker := NIL;
816 DEC(j)
817 END;
818 INC(i)
819 END
820 END
821 END
822 END Compile;
823
824 PROCEDURE LinkDev2;
825 VAR p: DswProcs.Process; i, res: INTEGER; ok: BOOLEAN;
826 BEGIN
827 ASSERT((exe # NIL) & (exe^ # ""), 20);
828 ASSERT(processor = mach386, 21);
829 ASSERT(compiler = cpnative, 22);
830 p := DswProcs.dir.New();
831 p.Program(cplExe);
832 IF os # anyos THEN
833 p.PutParam("-os");
834 CASE os OF
835 | linux: p.PutParam("linux")
836 | freebsd: p.PutParam("freebsd")
837 | openbsd: p.PutParam("openbsd")
838 | win32, cygwin: p.PutParam("win32")
839 | darwin: p.PutParam("darwin")
840 END
841 END;
842 p.PutParam("-kernel");
843 p.PutParam("Kernel");
844 p.PutParam("-main");
845 p.PutParam("Kernel");
846 p.PutParam("-legacycodedir");
847 p.PutParam(".");
848 p.PutParam("-o");
849 p.PutParam(exe);
850 PutParams(p, cplArgs);
851 i := 0;
852 WHILE i < mno DO
853 IF ~(library IN lnkList[i].flags) THEN
854 p.PutParam(lnkList[i].name$)
855 END;
856 INC(i)
857 END;
858 p.Execute(ok);
859 IF ok THEN
860 Log.String("Link "); Log.String(exe); Log.Ln;
861 res := p.Result();
862 IF res # 0 THEN
863 Log.String("linker terminated with error"); Log.Int(res); Log.Ln;
864 INC(err)
865 END
866 ELSE
867 Log.String("unable to execute linker"); Log.Int(i); Log.Ln;
868 INC(err)
869 END
870 END LinkDev2;
871
872 PROCEDURE Link;
873 BEGIN
874 IF exe # NIL THEN
875 CASE linker OF
876 | anyint: (* do not link *)
877 | dev2: LinkDev2
878 END
879 END
880 END Link;
881
882 PROCEDURE Main;
883 VAR m: Module; s: Selector; p: DswProcs.Process; ok: BOOLEAN; i, res: INTEGER;
884 BEGIN
885 IF Kernel.trapCount = 0 THEN
886 ParseArgs;
887 IF err = 0 THEN
888 CheckParams;
889 IF err = 0 THEN
890 CheckDeps;
891 IF err = 0 THEN
892 Compile;
893 IF err = 0 THEN
894 Link
895 END
896 END
897 END
898 END
899 ELSE INC(err)
900 END;
901 IF err = 0 THEN Kernel.Quit(0)
902 ELSE Kernel.Quit(1)
903 END;
904 END Main;
905
906 BEGIN
907 NEW(def);
908 Kernel.Start(Main)
909 END DswMakeMain.
A command line Component Pascal Compiler
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024