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