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