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