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