src/generic/Dsw/Mod/Compiler486Main.cp

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