DEADSOFTWARE

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


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