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