src/generic/Dsw/Mod/CompilerCPfrontMain.cp

   1 MODULE DswCompilerCPfrontMain;
   2
   3   IMPORT Kernel, HostFiles, Files, Console, Strings, DswDocuments,
   4     DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPH, DevCPV := CPfrontCPV, DevCPG := CPfrontCPG,
   5     DevCPR;
   6
   7   CONST
   8     (* compiler options: *)
   9     checks = 0; allchecks = 1; assert = 2; obj = 3; ref = 4; allref = 5;
  10     srcpos = 6; reallib = 7; signatures = 8;
  11     (* pVarInd = 14; bigEnd = 15; *) ctime = 16;
  12     mainprog = 20; include0 = 21;
  13     hint = 29; oberon = 30; errorTrap = 31;
  14     (* defopt = {checks, assert, obj, ref, allref, srcpos, signatures, ctime}; *)
  15     defopt = {checks, assert, obj, ctime};
  16
  17     version = "0.3";
  18
  19     emulong = 0;
  20     defopt2 = {};
  21
  22   TYPE
  23     Elem = POINTER TO RECORD
  24       dir, name, path: Files.Name;
  25       outsym, outcode: Files.Name; (* dir *)
  26       insym: DevCPM.Directory;
  27       found: BOOLEAN; (* COM Aware *)
  28       opts, opts2: SET;
  29       next: Elem
  30     END;
  31
  32     Def = POINTER TO RECORD
  33       name: DevCPT.Name;
  34       val: BOOLEAN;
  35       next: Def
  36     END;
  37
  38   VAR
  39     u: Elem;
  40     d: Def;
  41
  42   PROCEDURE GetPath (IN path: ARRAY OF CHAR; OUT dir, name: Files.Name);
  43     VAR i, j, len: INTEGER;
  44   BEGIN
  45     len := LEN(path$);
  46     i := len - 1;
  47     WHILE (i >= 0) & (path[i] # '/') DO DEC(i) END;
  48     IF i >= 0 THEN
  49       FOR i := 0 TO i - 1 DO
  50         dir[i] := path[i]
  51       END;
  52       dir[i] := 0X
  53     ELSE
  54       dir := ""
  55     END;
  56     j := i + 1; i := 0;
  57     WHILE path[j] # 0X DO
  58       name[i] := path[j];
  59       INC(i); INC(j)
  60     END;
  61     name[i] := 0X
  62   END GetPath;
  63
  64   PROCEDURE InitOptions;
  65     VAR
  66       i: INTEGER;
  67       found: BOOLEAN;
  68       insym, sym: DevCPM.Directory;
  69       outsym, outcode: Files.Name;
  70       p: ARRAY 256 OF CHAR;
  71       h, t: Elem;
  72       opts, opts2: SET;
  73
  74     PROCEDURE Check;
  75     BEGIN
  76       IF i >= Kernel.argc THEN
  77         Console.WriteStr("required more parameters for ");
  78         Console.WriteStr(p); Console.WriteLn;
  79         Kernel.Quit(1)
  80       END
  81     END Check;
  82
  83     PROCEDURE Define (IN name: DevCPT.Name; val: BOOLEAN);
  84       VAR def: Def;
  85     BEGIN
  86       NEW(def); def.name := name$; def.val := val; def.next := d; d := def
  87     END Define;
  88
  89   BEGIN
  90     outsym := ""; outcode := "";
  91     opts := defopt; opts2 := defopt2; found := FALSE;
  92     h := NIL; t := NIL; insym := NIL;
  93     i := 1;
  94     WHILE i < Kernel.argc DO
  95       IF Kernel.argv[i, 0] = "-" THEN
  96         p := Kernel.argv[i]$;
  97         INC(i);
  98         IF p = "-legacy" THEN
  99           DevCPM.legacy := TRUE
 100         ELSIF p = "-outsym" THEN
 101           Check;
 102           outsym := Kernel.argv[i]$;
 103           INC(i)
 104         ELSIF p = "-outcode" THEN
 105           Check;
 106           outcode := Kernel.argv[i]$;
 107           INC(i)
 108         ELSIF p = "-symdir" THEN
 109           Check;
 110           sym := insym;
 111           NEW(insym);
 112           insym.path := Kernel.argv[i]$;
 113           insym.legacy := FALSE;
 114           insym.next := sym;
 115           INC(i)
 116         ELSIF p = "-legacysymdir" THEN
 117           Check;
 118           sym := insym;
 119           NEW(insym);
 120           insym.path := Kernel.argv[i]$;
 121           insym.legacy := TRUE;
 122           insym.next := sym;
 123           INC(i)
 124         ELSIF p = "-allchecks" THEN
 125           INCL(opts, allchecks)
 126         ELSIF p = "-no-allchecks" THEN
 127           EXCL(opts, allchecks)
 128         ELSIF p = "-srcpos" THEN
 129           INCL(opts, srcpos)
 130         ELSIF p = "-no-srcpos" THEN
 131           EXCL(opts, srcpos)
 132         ELSIF p = "-structref" THEN
 133           INCL(opts, allref)
 134         ELSIF p = "-no-structref" THEN
 135           EXCL(opts, allref)
 136         ELSIF p = "-ref" THEN
 137           INCL(opts, ref)
 138         ELSIF p = "-no-ref" THEN
 139           EXCL(opts, ref)
 140         ELSIF p = "-obj" THEN
 141           INCL(opts, obj)
 142         ELSIF p = "-no-obj" THEN
 143           EXCL(opts, obj)
 144         ELSIF p = "-assert" THEN
 145           INCL(opts, assert)
 146         ELSIF p = "-no-assert" THEN
 147           EXCL(opts, assert)
 148         ELSIF p = "-checks" THEN
 149           INCL(opts, checks)
 150         ELSIF p = "-no-checks" THEN
 151           EXCL(opts, checks)
 152         ELSIF p = "-hints" THEN
 153           INCL(opts, hint)
 154         ELSIF p = "-no-hints" THEN
 155           EXCL(opts, hint)
 156         ELSIF p = "-trap" THEN
 157           Kernel.intTrap := TRUE;
 158           INCL(opts, errorTrap)
 159         ELSIF p = "-no-trap" THEN
 160           EXCL(opts, errorTrap)
 161         ELSIF p = "-oberon" THEN
 162           INCL(opts, oberon)
 163         ELSIF p = "-no-oberon" THEN
 164           EXCL(opts, oberon)
 165         ELSIF p = "-com-aware" THEN
 166           found := TRUE
 167         ELSIF p = "-no-com-aware" THEN
 168           found := FALSE
 169         ELSIF (p = "-v") OR (p = "-verbose") THEN
 170           DevCPM.verbose := MIN(DevCPM.verbose + 1, 3)
 171         ELSIF p = "-main" THEN
 172           INCL(opts, mainprog)
 173         ELSIF p = "-no-main" THEN
 174           EXCL(opts, mainprog)
 175         ELSIF p = "-include0" THEN
 176           INCL(opts, include0)
 177         ELSIF p = "-no-include0" THEN
 178           EXCL(opts, include0)
 179         ELSIF p = "-includedir" THEN
 180           Check;
 181           DevCPG.includePath := Kernel.argv[i]$;
 182           INC(i)
 183         ELSIF p = "-long-calls" THEN
 184           INCL(opts2, emulong)
 185         ELSIF p = "-no-long-calls" THEN
 186           EXCL(opts2, emulong)
 187         ELSIF p = "-version" THEN
 188           Console.WriteStr(version); Console.WriteLn;
 189           Kernel.Quit(0)
 190         ELSIF p = "-use-time" THEN
 191           INCL(opts, ctime)
 192         ELSIF p = "-no-use-time" THEN
 193           EXCL(opts, ctime)
 194         ELSIF p = "-define+" THEN
 195           Check; Define(Kernel.argv[i]$, TRUE); INC(i)
 196         ELSIF p = "-define-" THEN
 197           Check; Define(Kernel.argv[i]$, FALSE); INC(i)
 198         ELSE
 199           Console.WriteStr("unknown option ");
 200           Console.WriteStr(p); Console.WriteLn;
 201           Kernel.Quit(1)
 202         END
 203       ELSE
 204         IF h = NIL THEN NEW(h); t := h
 205         ELSE NEW(t.next); t := t.next
 206         END;
 207         t.path := Kernel.argv[i]$;
 208         t.outcode := outcode;
 209         t.outsym := outsym;
 210         t.insym := insym;
 211         t.found := found;
 212         t.opts := opts;
 213         t.opts2 := opts2;
 214         GetPath(t.path, t.dir, t.name);
 215         IF t.name = "" THEN
 216           Console.WriteStr("specified path to directory"); Console.WriteLn;
 217           Kernel.Quit(1)
 218         END;
 219         INC(i)
 220       END
 221     END;
 222     u := h
 223   END InitOptions;
 224
 225   PROCEDURE Module (source: POINTER TO ARRAY OF CHAR; m: Elem; OUT error: BOOLEAN);
 226     VAR ext, new: BOOLEAN; p: DevCPT.Node; def: Def;
 227   BEGIN
 228     DevCPG.opt := {}; (* !!! *)
 229     DevCPM.Init(source);
 230     DevCPM.symList := m.insym;
 231     DevCPM.codePath := m.outcode;
 232     DevCPM.symPath := m.outsym;
 233     DevCPM.name := m.path;
 234     INCL(DevCPM.options, 10); (* !!! allow [ccall] *)
 235     INCL(DevCPM.options, DevCPM.allSysVal); (* !!! make nodes for all SYSTEM.VAL *)
 236     INCL(DevCPG.opt, DevCPG.ansi); (* !!! *)
 237     IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END;
 238     IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END;
 239     IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;
 240     IF mainprog IN m.opts THEN INCL(DevCPG.opt, DevCPG.mainprog) END;
 241     IF include0 IN m.opts THEN INCL(DevCPG.opt, DevCPG.include0) END;
 242     IF ctime IN m.opts THEN INCL(DevCPG.opt, DevCPG.ctime) END;
 243     DevCPT.Init(m.opts);
 244     (* DevCPB.typSize := DevCPV.TypeSize; *)
 245     DevCPB.typSize := DevCPV.TypSize;
 246     DevCPT.processor := DevCPV.processor;
 247     DevCPR.Init;
 248     def := d;
 249     WHILE def # NIL DO
 250       DevCPR.Set(def.name, def.val);
 251       def := def.next
 252     END;
 253     DevCPP.Module(p);
 254     DevCPR.Check;
 255     IF DevCPM.noerr THEN
 256       IF DevCPT.libName # "" THEN EXCL(m.opts, obj) END;
 257       DevCPV.Init(m.opts); DevCPV.AdrAndSize(DevCPT.topScope); DevCPT.Export(ext, new);
 258       IF DevCPM.noerr & (obj IN m.opts) THEN
 259         DevCPG.OpenFiles(DevCPT.SelfName);
 260         IF emulong IN m.opts2 THEN
 261           DevCPH.UseCalls(p, {DevCPH.longMop, DevCPH.longDop, DevCPH.longConv, DevCPH.longOdd});
 262         END;
 263         DevCPV.Module(p)
 264       END;
 265       (* DevCPV.Close *)
 266     END;
 267     IF DevCPM.noerr & (DevCPG.mainprog IN DevCPG.opt) & (DevCPG.modName # "SYSTEM") THEN
 268       DevCPM.DeleteNewSym;
 269       IF DevCPM.verbose > 0 THEN
 270         DevCPM.LogWStr("  main program"); DevCPM.LogWLn
 271       END
 272     ELSIF DevCPM.noerr & (new OR ext) THEN
 273       DevCPM.RegisterNewSym
 274     ELSE
 275       DevCPM.DeleteNewSym
 276     END;
 277     IF obj IN m.opts THEN
 278       DevCPG.CloseFiles
 279     END;
 280     DevCPR.Close;
 281     DevCPT.Close;
 282     error := ~DevCPM.noerr;
 283     IF error THEN
 284       DevCPM.InsertMarks;
 285       IF DevCPM.verbose > 0 THEN DevCPM.LogWStr(" ") END;
 286       IF DevCPM.errors = 1 THEN
 287         DevCPM.LogWStr("one error detected");
 288       ELSE
 289         DevCPM.LogWNum(DevCPM.errors, 0); DevCPM.LogWStr(" errors detected")
 290       END;
 291       DevCPM.LogWLn
 292     ELSE
 293       IF hint IN m.opts THEN DevCPM.InsertMarks END
 294     END;
 295     DevCPM.Close;
 296     p := NIL;
 297     Kernel.FastCollect
 298   END Module;
 299
 300   PROCEDURE ReadText (s: Elem): POINTER TO ARRAY OF CHAR;
 301     VAR
 302       i, len, res: INTEGER;
 303       text: DswDocuments.Text;
 304       loc: Files.Locator; f: Files.File; r: Files.Reader;
 305       ssrc: POINTER TO ARRAY OF SHORTCHAR;
 306       src: POINTER TO ARRAY OF CHAR;
 307       x: POINTER TO ARRAY OF BYTE;
 308       num: ARRAY 32 OF CHAR;
 309   BEGIN
 310     src := NIL;
 311     loc := Files.dir.This(s.dir);
 312     DswDocuments.Import(loc, s.name, text, res);
 313     Strings.IntToString(res, num);
 314     IF res = 0 THEN
 315       src := text.t
 316     ELSIF res = 2 THEN
 317       f := Files.dir.Old(loc, s.name, Files.shared);
 318       IF f # NIL THEN
 319         len := f.Length();
 320         r := f.NewReader(NIL);
 321         NEW(x, len + 1);
 322         r.ReadBytes(x, 0, len);
 323         NEW(ssrc, len + 1);
 324         FOR i := 0 TO len - 1 DO
 325           ssrc[i] := SHORT(CHR(x[i]))
 326         END;
 327         ssrc[i] := 0X;
 328         x := NIL;
 329         NEW(src, len + 1);
 330         Kernel.Utf8ToString(ssrc, src, res);
 331         ssrc := NIL;
 332         f.Close
 333       END
 334     ELSE
 335       IF DevCPM.verbose > 0 THEN
 336         Console.WriteStr("document error ");
 337         Console.WriteStr(num);
 338         Console.WriteLn
 339       END
 340     END;
 341     IF src = NIL THEN
 342       Console.WriteStr("unable to open file ");
 343       Console.WriteStr(s.path);
 344       Console.WriteLn;
 345       Kernel.Quit(1)
 346     END;
 347     RETURN src
 348   END ReadText;
 349
 350   PROCEDURE CompileAll;
 351     VAR loc: Files.Locator; m: Elem; error: BOOLEAN; src: POINTER TO ARRAY OF CHAR;
 352   BEGIN
 353     m := u;
 354     WHILE m # NIL DO
 355       IF DevCPM.verbose > 0 THEN
 356         Console.WriteStr("compiling "); Console.WriteStr(m.path); Console.WriteLn
 357       END;
 358       src := ReadText(m);
 359       Module(src, m, error);
 360       IF error THEN Kernel.Quit(1) END;
 361       m := m.next
 362     END
 363   END CompileAll;
 364
 365   PROCEDURE Init;
 366   BEGIN
 367     IF Kernel.trapCount # 0 THEN Kernel.Quit(1) END;
 368     HostFiles.SetRootDir(".");
 369     InitOptions;
 370     CompileAll;
 371     Kernel.Quit(0)
 372   END Init;
 373
 374 BEGIN
 375   Kernel.intTrap := FALSE;
 376   Kernel.Start(Init)
 377 END DswCompilerCPfrontMain.