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     maxImps = 127;
   7     maxJobs = maxImps;
   8
   9     (* symbol values *)
  10     null = 0; times = 1; slash = 2; div = 3; mod = 4;
  11     and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  12     neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  13     in = 15; is = 16; arrow = 17; dollar = 18; period = 19;
  14     comma = 20; colon = 21; upto = 22; rparen = 23; rbrak = 24;
  15     rbrace = 25; of = 26; then = 27; do = 28; to = 29;
  16     by = 30; not = 33;
  17     lparen = 40; lbrak = 41; lbrace = 42; becomes = 44;
  18     number = 45; nil = 46; string = 47; ident = 48; semicolon = 49;
  19     bar = 50; end = 51; else = 52; elsif = 53; until = 54;
  20     if = 55; case = 56; while = 57; repeat = 58; for = 59;
  21     loop = 60; with = 61; exit = 62; return = 63; array = 64;
  22     record = 65; pointer = 66; begin = 67; const = 68; type = 69;
  23     var = 70; out = 71; procedure = 72; close = 73; import = 74;
  24     module = 75; eof = 76;
  25
  26     (* module state flags *)
  27     imported = 0; trace = 1; hasObj = 2; hasSym = 3; hasErrors = 4; library = 5;
  28
  29     debugImport = FALSE;
  30     debugOrder = FALSE;
  31     debugJobs = FALSE;
  32
  33   TYPE
  34     String = POINTER TO ARRAY OF CHAR;
  35
  36     Selector = POINTER TO RECORD
  37       name: DevCPT.Name;
  38       value: BOOLEAN;
  39       next: Selector
  40     END;
  41
  42     Module = POINTER TO RECORD
  43       name: DevCPT.Name;
  44       path: Files.Name;
  45       selectors: Selector; (* with head, list of selectors for this module *)
  46       depth: INTEGER; (* 0: leaf, MAX: root *)
  47       mno: INTEGER;
  48       imp: ARRAY maxImps OF Module;
  49       flags: SET;
  50       worker: DswProcs.Process;
  51     END;
  52
  53   VAR
  54     err: INTEGER;
  55     mno, rno: INTEGER; (* num modules *)
  56     modList, lnkList, cmpList: ARRAY maxImps OF Module;
  57     def: Selector; (* with head, global list of selectors *)
  58     auto: INTEGER;
  59     jobs: INTEGER;
  60     exe: String;
  61
  62   (* --------- options --------- *)
  63
  64   PROCEDURE IdentLen (IN s: ARRAY OF CHAR): INTEGER;
  65     VAR i: INTEGER;
  66   BEGIN
  67     i := 0;
  68     IF Strings.IsIdentStart(s[0]) THEN
  69       REPEAT INC(i) UNTIL ~Strings.IsIdent(s[i])
  70     END;
  71     RETURN i
  72   END IdentLen;
  73
  74   PROCEDURE Define (n: ARRAY OF CHAR);
  75     VAR i: INTEGER; v: BOOLEAN; s: Selector;
  76   BEGIN
  77     i := IdentLen(n);
  78     IF i # 0 THEN
  79       IF ~((n[i] = 0X) OR (((n[i] = "+") OR (n[i] = "-")) & (n[i + 1] = 0X))) THEN
  80         Log.String("option -D expect + or - after identifier"); Log.Ln; INC(err)
  81       END;
  82       v := n[i] # "-"; n[i] := 0X; s := def;
  83       WHILE (s.next # NIL) & (s.next.name$ # n$) DO s := s.next END;
  84       IF s.next = NIL THEN
  85         NEW(s.next);
  86         Strings.StringToUtf8(n, s.next.name, i);
  87         ASSERT(i = 0)
  88       END;
  89       s.next.value := v
  90     ELSE
  91       Log.String("option -D expect identifier"); Log.Ln; INC(err)
  92     END
  93   END Define;
  94
  95   PROCEDURE Undefine (IN n: ARRAY OF CHAR);
  96     VAR i: INTEGER; s: Selector;
  97   BEGIN
  98     i := IdentLen(n);
  99     IF (i # 0) & (n[i] = 0X) THEN
 100       s := def;
 101       WHILE (s.next # NIL) & (s.next.name$ # n$) DO s := s.next END;
 102       IF s.next # NIL THEN s.next := s.next.next END
 103     ELSE
 104       Log.String("option -U expect identifier"); Log.Ln; INC(err)
 105     END
 106   END Undefine;
 107
 108   PROCEDURE CopySelectorList (base: Selector): Selector;
 109     VAR s, t, x: Selector;
 110   BEGIN
 111     ASSERT(base # NIL, 20);
 112     s := base; NEW(t); x := t;
 113     WHILE s # NIL DO
 114       x^ := s^;
 115       IF s.next # NIL THEN NEW(x.next); x := x.next END;
 116       s := s.next
 117     END;
 118     RETURN t
 119   END CopySelectorList;
 120
 121   PROCEDURE AddModule (IN n: ARRAY OF CHAR; selectors: Selector);
 122     VAR i, res: INTEGER; m: Module;
 123   BEGIN
 124     i := IdentLen(n);
 125     IF (i # 0) & (n[i] = 0X) THEN
 126       i := 0;
 127       WHILE (i < mno) & (modList[i].name$ # n$) DO INC(i) END;
 128       IF i >= mno THEN
 129         NEW(m);
 130         Strings.StringToUtf8(n, m.name, res);
 131         ASSERT(res = 0);
 132         m.selectors := CopySelectorList(selectors);
 133         modList[i] := m;
 134         INC(mno)
 135       END
 136     ELSE
 137       Log.String("module name must be identifier"); Log.Ln; INC(err)
 138     END
 139   END AddModule;
 140
 141   PROCEDURE StrToInt (IN s: ARRAY OF CHAR; def: INTEGER): INTEGER;
 142     VAR x, res: INTEGER;
 143   BEGIN
 144     Strings.StringToInt(s, x, res);
 145     IF res # 0 THEN
 146       Log.String("expected integer"); Log.Ln; INC(err);
 147       x := def
 148     END;
 149     RETURN x
 150   END StrToInt;
 151
 152   PROCEDURE ParseArgs;
 153   BEGIN
 154     jobs := 1;
 155     LOOP
 156       CASE DswOpts.GetOpt("ao:j:D:U:") OF
 157       | "a": INC(auto)
 158       | "o": exe := DswOpts.str
 159       | "j": IF DswOpts.str = NIL THEN jobs := maxJobs ELSE jobs := MIN(MAX(StrToInt(DswOpts.str, 0), 1), maxJobs) END
 160       | "D": Define(DswOpts.str)
 161       | "U": Undefine(DswOpts.str)
 162       | ":": Log.String("missing argument for option -"); Log.String(DswOpts.str); Log.Ln; INC(err)
 163       | "?": Log.String("unknown option -"); Log.String(DswOpts.str); Log.Ln; INC(err)
 164       | "$": AddModule(DswOpts.str, def)
 165       | 0X: EXIT
 166       END
 167     END
 168   END ParseArgs;
 169
 170   (* --------- loader --------- *)
 171
 172   PROCEDURE Import (m: Module; IN name: DevCPT.Name);
 173     VAR i, j: INTEGER; imp: Module;
 174   BEGIN
 175     ASSERT(m # NIL, 20);
 176     ASSERT(name # "", 21);
 177     IF debugImport THEN Log.String("  import "); Log.String(name$) END;
 178     IF name = "SYSTEM" THEN INCL(DevCPM.options, DevCPM.sysImp)
 179     ELSIF name = "COM" THEN INCL(DevCPM.options, DevCPM.com)
 180     ELSIF name = "JAVA" THEN INCL(DevCPM.options, DevCPM.java)
 181     ELSE
 182       IF debugImport THEN Log.Char(" ") END;
 183       i := 0; (* find module in local list *)
 184       WHILE (i < m.mno) & (m.imp[i].name$ # name$) DO INC(i) END;
 185       IF i >= m.mno THEN
 186         j := 0; (* find module in global list *)
 187         WHILE (j < mno) & (modList[j].name$ # name$) DO INC(j) END;
 188         IF j >= mno THEN
 189           NEW(imp); imp.name := name$; imp.selectors := CopySelectorList(m.selectors);
 190           modList[mno] := imp; INC(mno)
 191         ELSE
 192           imp := modList[j]
 193         END;
 194         m.imp[m.mno] := imp; INC(m.mno)
 195       ELSE DevCPM.err(1)
 196       END
 197     END;
 198     IF debugImport THEN Log.Ln END;
 199   END Import;
 200
 201   PROCEDURE ParseModule (m: Module);
 202     VAR sym: BYTE; SelfName, impName, aliasName: DevCPT.Name;
 203
 204     PROCEDURE err (n: SHORTINT);
 205     BEGIN DevCPM.err(n)
 206     END err;
 207
 208     PROCEDURE CheckSym(s: SHORTINT);
 209     BEGIN
 210       IF sym = s THEN DevCPS.Get(sym) ELSE DevCPM.err(s) END
 211     END CheckSym;
 212
 213   BEGIN
 214     IF debugImport THEN Log.String("module " + m.name); Log.Ln END;
 215     DevCPS.Init; DevCPS.Get(sym);
 216     IF sym = module THEN DevCPS.Get(sym) ELSE err(16) END;
 217     IF sym = ident THEN
 218       SelfName := DevCPS.name$; DevCPS.Get(sym);
 219       IF sym = lbrak THEN
 220         INCL(DevCPM.options, DevCPM.interface); DevCPS.Get(sym);
 221         IF sym = eql THEN DevCPS.Get(sym)
 222         ELSE INCL(DevCPM.options, DevCPM.noCode)
 223         END;
 224         IF sym = string THEN INCL(m.flags, library); DevCPS.Get(sym)
 225         ELSE err(string)
 226         END;
 227         CheckSym(rbrak)
 228       END;
 229       CheckSym(semicolon);
 230       IF sym = import THEN DevCPS.Get(sym);
 231         LOOP
 232           IF sym = ident THEN
 233             aliasName := DevCPS.name$; impName := aliasName$; DevCPS.Get(sym);
 234             IF sym = becomes THEN DevCPS.Get(sym);
 235               IF sym = ident THEN impName := DevCPS.name$; DevCPS.Get(sym) ELSE err(ident) END
 236             END;
 237             Import(m, impName)
 238           ELSE err(ident)
 239           END;
 240           IF sym = comma THEN DevCPS.Get(sym)
 241           ELSIF sym = ident THEN err(comma)
 242           ELSE EXIT
 243           END
 244         END;
 245         CheckSym(semicolon)
 246       END
 247     ELSE err(ident)
 248     END;
 249     DevCPS.str := NIL
 250   END ParseModule;
 251
 252   PROCEDURE CheckModule (m: Module; source: String; OUT ok: BOOLEAN);
 253     VAR s: Selector;
 254   BEGIN
 255     DevCPM.Init(source);
 256 (*
 257     DevCPM.symList := m.insym;
 258     DevCPM.codePath := m.outcode;
 259     DevCPM.symPath := m.outsym;
 260 *)
 261     DevCPM.name := m.name$;
 262 (*
 263     IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END;
 264     IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END;
 265     IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;
 266 *)
 267     DevCPR.Init;
 268     s := m.selectors.next;
 269     WHILE s # NIL DO
 270       DevCPR.Set(s.name, s.value);
 271       s := s.next
 272     END;
 273     ParseModule(m);
 274     DevCPR.Check;
 275     ok := DevCPM.noerr;
 276     DevCPR.Close;
 277     DevCPM.InsertMarks;
 278     DevCPM.Close;
 279     Kernel.FastCollect
 280   END CheckModule;
 281
 282   PROCEDURE GetSource (IN modName: ARRAY OF CHAR; OUT path: Files.Name; OUT s: String);
 283     CONST modDir = "Mod"; sysDir = "System";
 284     VAR dir, name: Files.Name; loc: Files.Locator;
 285       text: DswDocuments.Model; r: DswDocuments.Reader; i, res: INTEGER;
 286
 287     PROCEDURE MakePath (dir, name: Files.Name; type: Files.Type; OUT path: Files.Name);
 288     BEGIN
 289       ASSERT(name # "", 21);
 290       IF dir = "" THEN path := modDir + "/" + name
 291       ELSE path := dir + "/" + modDir + "/" + name
 292       END;
 293       Kernel.MakeFileName(path, type)
 294     END MakePath;
 295
 296   BEGIN
 297     s := NIL; path := "";
 298     Kernel.SplitName(modName, dir, name);
 299     loc := Files.dir.This(dir).This(modDir);
 300     (* --> Kernel.MakeFileName(name, Kernel.docType); <-- *)
 301     MakePath(dir, name, "cp", path);
 302     DswDocuments.Open(loc, name + ".cp", text, res);
 303     IF text = NIL THEN
 304       MakePath(dir, name, "odc", path);
 305       DswDocuments.Open(loc, name + ".odc", text, res);
 306       IF (text = NIL) & (dir = "") THEN
 307         MakePath(sysDir, name, "cp", path);
 308         loc := Files.dir.This(sysDir).This(modDir);
 309         DswDocuments.Open(loc, name + ".cp", text, res);
 310         IF text = NIL THEN
 311           MakePath(sysDir, name, "odc", path);
 312           DswDocuments.Open(loc, name + ".odc", text, res);
 313           IF text = NIL THEN
 314             path := ""
 315           END
 316         END
 317       END
 318     END;
 319     IF text # NIL THEN
 320       NEW(s, text.Length() + 1);
 321       IF s # NIL THEN
 322         r := text.NewReader(NIL);
 323         FOR i := 0 TO text.Length() - 1 DO
 324           r.Read; s[i] := r.char
 325         END
 326       END
 327     END
 328   END GetSource;
 329
 330   PROCEDURE Trace (m, parent: Module; VAR lno: INTEGER);
 331     VAR i: INTEGER;
 332   BEGIN
 333     IF ~(trace IN m.flags) THEN
 334       INCL(m.flags, trace);
 335       FOR i := 0 TO m.mno - 1 DO
 336         Trace(m.imp[i], m, lno);
 337         m.depth := MAX(m.depth, m.imp[i].depth + 1)
 338       END;
 339       IF ~(imported IN m.flags) THEN
 340         INCL(m.flags, imported);
 341         lnkList[lno] := m;
 342         INC(lno)
 343       END;
 344       EXCL(m.flags, trace)
 345     ELSE
 346       Log.String("recursive import of " + m.name + " in " + parent.name); Log.Ln; INC(err)
 347     END
 348   END Trace;
 349
 350   PROCEDURE Sort;
 351     VAR i, j: INTEGER; m: Module;
 352   BEGIN
 353     ASSERT((mno = 0) OR (lnkList[0] # NIL), 20);
 354     cmpList := lnkList;
 355     i := 1;
 356     WHILE i < mno DO
 357       m := cmpList[i];
 358       j := i - 1;
 359       WHILE (j >= 0) & (cmpList[j].depth > m.depth) DO
 360         cmpList[j + 1] := cmpList[j];
 361         DEC(j)
 362       END;
 363       cmpList[j + 1] := m;
 364       INC(i)
 365     END
 366   END Sort;
 367
 368   PROCEDURE CheckDeps;
 369     VAR i, j, num: INTEGER; m: Module; s: String; ok: BOOLEAN;
 370   BEGIN
 371     i := 0; rno := mno;
 372     WHILE (err = 0) & (i < mno) DO
 373       m := modList[i];
 374       GetSource(m.name$, m.path, s);
 375       IF s # NIL THEN
 376         CheckModule(m, s, ok);
 377         IF ~ok THEN INC(err) END
 378       ELSE
 379         Log.String("unable to open module " + m.name); Log.Ln; INC(err)
 380       END;
 381       INC(i)
 382     END;
 383     num := 0;
 384     FOR i := 0 TO rno - 1 DO
 385       Trace(modList[i], modList[i], num)
 386     END;
 387     ASSERT((err # 0) OR (num = mno), 100);
 388     Sort;
 389     IF debugOrder THEN
 390       Log.String("Parallel depth:"); Log.Ln;
 391       FOR i := 0 TO mno - 1 DO
 392         Log.String("  " + cmpList[i].name); Log.Int(cmpList[i].depth); Log.Ln;
 393       END
 394     END
 395   END CheckDeps;
 396
 397   PROCEDURE IsCompiled (m: Module): BOOLEAN;
 398     CONST target = {hasSym, hasObj};
 399     VAR i: INTEGER; ready: BOOLEAN;
 400   BEGIN
 401     ASSERT(m # NIL, 20);
 402     i := 0;
 403     ready := ~(hasErrors IN m.flags) & (m.flags * target = target);
 404     WHILE ready & (i < m.mno) DO
 405       ready := IsCompiled(m.imp[i]);
 406       INC(i)
 407     END;
 408     RETURN ready
 409   END IsCompiled;
 410
 411   PROCEDURE Ready (m: Module): BOOLEAN;
 412     CONST target = {hasSym, hasObj};
 413     VAR i: INTEGER; ready: BOOLEAN;
 414   BEGIN
 415     i := 0;
 416     ready := ~(hasErrors IN m.flags) & (m.flags * target # target) & (m.worker = NIL);
 417     WHILE ready & (i < m.mno) DO
 418       ready := IsCompiled(m.imp[i]);
 419       INC(i)
 420     END;
 421     RETURN ready
 422   END Ready;
 423
 424   PROCEDURE ExecuteCompiler (m: Module): DswProcs.Process;
 425     VAR w: DswProcs.Process; ok: BOOLEAN;
 426   BEGIN
 427     ASSERT(m # NIL, 20);
 428     ASSERT(m.path # "", 21);
 429     ASSERT(m.worker = NIL, 22);
 430     w := DswProcs.dir.New();
 431     w.Program("cpc486");
 432     w.PutParam("-legacy");
 433     w.PutParam(m.path);
 434     w.Execute(ok);
 435     IF ok THEN
 436       Log.String("Compile " + m.name + " (" + m.path + ")"); Log.Ln;
 437     ELSE
 438       w := NIL
 439     END;
 440     RETURN w
 441   END ExecuteCompiler;
 442
 443   PROCEDURE Compile;
 444     VAR i, j, num: INTEGER; ok: BOOLEAN; m: Module; w: DswProcs.Process;
 445   BEGIN
 446     IF mno = 0 THEN RETURN END;
 447     num := 0; j := 0;
 448     WHILE (err = 0) & (num < mno) OR (j > 0) DO
 449       i := 0;
 450       WHILE (err = 0) & (i < mno) & (j < jobs) DO
 451         m := cmpList[i];
 452         IF Ready(m) THEN
 453           w := ExecuteCompiler(m);
 454           IF debugJobs THEN Log.String("Start job " + m.name) END;
 455           IF w # NIL THEN
 456             IF debugJobs THEN Log.String(" ok") END;
 457             m.worker := w;
 458             INC(j)
 459           ELSE
 460             IF debugJobs THEN Log.String(" fail") END;
 461             INCL(m.flags, hasErrors);
 462             INC(err)
 463           END;
 464           IF debugJobs THEN Log.Ln END
 465         END;
 466         INC(i)
 467       END;
 468       WHILE (err = 0) & (j >= jobs) OR (j > 0) DO
 469         i := 0;
 470         WHILE (j > 0) & (i < mno) DO
 471           m := cmpList[i];
 472           w := m.worker;
 473           IF (w # NIL) & w.IsTerminated() THEN
 474             IF debugJobs THEN Log.String("Stop job " + m.name); Log.Int(w.Result()); Log.Ln END;
 475             IF w.Result() = 0 THEN
 476               INCL(m.flags, hasObj);
 477               INCL(m.flags, hasSym);
 478               INC(num)
 479             ELSE
 480               INCL(m.flags, hasErrors);
 481               INC(err)
 482             END;
 483             m.worker := NIL;
 484             DEC(j)
 485           END;
 486           INC(i)
 487         END
 488       END
 489     END
 490   END Compile;
 491
 492   PROCEDURE Link;
 493     VAR p: DswProcs.Process; i: INTEGER; ok: BOOLEAN;
 494   BEGIN
 495     ASSERT(exe # NIL, 20);
 496     ASSERT(exe^ # "", 21);
 497     p := DswProcs.dir.New();
 498     p.Program("cpl486");
 499     p.PutParam("-os");
 500     p.PutParam("linux");
 501     p.PutParam("-kernel");
 502     p.PutParam("Kernel");
 503     p.PutParam("-main");
 504     p.PutParam("Kernel");
 505     p.PutParam("-legacycodedir");
 506     p.PutParam(".");
 507     p.PutParam("-o");
 508     p.PutParam(exe);
 509     i := 0;
 510     WHILE i < mno DO
 511       IF ~(library IN lnkList[i].flags) THEN
 512         p.PutParam(lnkList[i].name$)
 513       END;
 514       INC(i)
 515     END;
 516     p.Execute(ok);
 517     IF ok THEN
 518       i := p.Result();
 519       IF i # 0 THEN
 520         Log.String("linker terminated with error"); Log.Int(i); Log.Ln;
 521         INC(err)
 522       END
 523     ELSE
 524       Log.String("unable to execute linker"); Log.Int(i); Log.Ln;
 525       INC(err)
 526     END
 527   END Link;
 528
 529   PROCEDURE Main;
 530     VAR m: Module; s: Selector; p: DswProcs.Process; ok: BOOLEAN; i, res: INTEGER;
 531   BEGIN
 532     IF Kernel.trapCount # 0 THEN Kernel.Quit(1) END;
 533     ParseArgs;
 534     IF err = 0 THEN
 535       CheckDeps;
 536       IF err = 0 THEN
 537         Compile;
 538         IF err = 0 THEN
 539           IF exe # NIL THEN Link END;
 540         END
 541       END
 542     END;
 543     IF err = 0 THEN Kernel.Quit(0)
 544     ELSE Kernel.Quit(1)
 545     END;
 546   END Main;
 547
 548 BEGIN
 549   NEW(def);
 550   Kernel.Start(Main)
 551 END DswMakeMain.
 552
 553 ==============================
 554
 555 SYNTAX
 556   cpmake {options module}
 557
 558 OPTIONS
 559   -a                         Enable automatic dependency resolution
 560   -o name                    Generate executable file
 561   -j num                     Specifies the number of jobs to run simultaneously
 562   -D ident["+"|"-"]          Add preprocessor selector
 563   -U ident                   Remove proprocessor selector