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     (* 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
  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           (* ignore *)
 159         ELSIF p = "-no-main" THEN
 160           (* ignore *)
 161         ELSIF p = "-include0" THEN
 162           (* ignore *)
 163         ELSIF p = "-no-include0" THEN
 164           (* ignore *)
 165         ELSIF p = "-includedir" THEN
 166           Check;
 167           (* ignore *)
 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     DevCPM.Init(source);
 211     DevCPM.symList := m.insym;
 212     DevCPM.codePath := m.outcode;
 213     DevCPM.symPath := m.outsym;
 214     DevCPM.name := m.path;
 215     IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END;
 216     IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END;
 217     IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;
 218     DevCPT.Init(m.opts);
 219     DevCPB.typSize := DevCPV.TypeSize;
 220     DevCPT.processor := DevCPV.processor;
 221     DevCPP.Module(p);
 222     IF DevCPM.noerr THEN
 223       IF DevCPT.libName # "" THEN EXCL(m.opts, obj) END;
 224       DevCPV.Init(m.opts); DevCPV.Allocate; DevCPT.Export(ext, new);
 225       IF DevCPM.noerr & (obj IN m.opts) THEN
 226         IF emulong IN m.opts2 THEN
 227           DevCPH.UseCalls(p, {DevCPH.longMop, DevCPH.longDop})
 228         END;
 229         DevCPV.Module(p)
 230       END;
 231       DevCPV.Close
 232     END;
 233     IF DevCPM.noerr & (new OR ext) THEN DevCPM.RegisterNewSym
 234     ELSE DevCPM.DeleteNewSym
 235     END;
 236     DevCPT.Close;
 237     error := ~DevCPM.noerr;
 238     IF error THEN
 239       DevCPM.InsertMarks;
 240       IF DevCPM.verbose > 0 THEN DevCPM.LogWStr("  ") END;
 241       IF DevCPM.errors = 1 THEN
 242         DevCPM.LogWStr("one error detected")
 243       ELSE
 244         DevCPM.LogWNum(DevCPM.errors, 0); DevCPM.LogWStr(" errors detected")
 245       END;
 246       DevCPM.LogWLn
 247     ELSE
 248       IF hint IN m.opts THEN DevCPM.InsertMarks END
 249     END;
 250     DevCPM.Close;
 251     p := NIL;
 252     Kernel.FastCollect
 253   END Module;
 254
 255   PROCEDURE ReadText (s: Elem): POINTER TO ARRAY OF CHAR;
 256     VAR
 257       i, len, res: INTEGER;
 258       text: DswDocuments.Text;
 259       loc: Files.Locator; f: Files.File; r: Files.Reader;
 260       ssrc: POINTER TO ARRAY OF SHORTCHAR;
 261       src: POINTER TO ARRAY OF CHAR;
 262       x: POINTER TO ARRAY OF BYTE;
 263       num: ARRAY 32 OF CHAR;
 264   BEGIN
 265     src := NIL;
 266     loc := Files.dir.This(s.dir);
 267     DswDocuments.Import(loc, s.name, text, res);
 268     Strings.IntToString(res, num);
 269     IF res = 0 THEN
 270       src := text.t
 271     ELSIF res = 2 THEN
 272       f := Files.dir.Old(loc, s.name, Files.shared);
 273       IF f # NIL THEN
 274         len := f.Length();
 275         r := f.NewReader(NIL);
 276         NEW(x, len + 1);
 277         r.ReadBytes(x, 0, len);
 278         NEW(ssrc, len + 1);
 279         FOR i := 0 TO len - 1 DO
 280           ssrc[i] := SHORT(CHR(x[i]))
 281         END;
 282         ssrc[i] := 0X;
 283         x := NIL;
 284         NEW(src, len + 1);
 285         Kernel.Utf8ToString(ssrc, src, res);
 286         ssrc := NIL;
 287         f.Close
 288       END
 289     ELSE
 290       IF DevCPM.verbose > 0 THEN
 291         Console.WriteStr("document error ");
 292         Console.WriteStr(num);
 293         Console.WriteLn
 294       END
 295     END;
 296     IF src = NIL THEN
 297       Console.WriteStr("unable to open file ");
 298       Console.WriteStr(s.path);
 299       Console.WriteLn;
 300       Kernel.Quit(1)
 301     END;
 302     RETURN src
 303   END ReadText;
 304
 305   PROCEDURE CompileAll;
 306     VAR loc: Files.Locator; m: Elem; error: BOOLEAN; src: POINTER TO ARRAY OF CHAR;
 307   BEGIN
 308     m := u;
 309     WHILE m # NIL DO
 310       IF DevCPM.verbose > 0 THEN
 311         Console.WriteStr("compiling "); Console.WriteStr(m.path); Console.WriteLn
 312       END;
 313       src := ReadText(m);
 314       Module(src, m, error);
 315       IF error THEN Kernel.Quit(1) END;
 316       m := m.next
 317     END
 318   END CompileAll;
 319
 320   PROCEDURE Init;
 321   BEGIN
 322     IF Kernel.trapCount # 0 THEN Kernel.Quit(1) END;
 323     HostFiles.SetRootDir(".");
 324     InitOptions;
 325     CompileAll;
 326     Kernel.Quit(0)
 327   END Init;
 328
 329 BEGIN
 330   Kernel.intTrap := FALSE;
 331   Kernel.Start(Init)
 332 END DswCompiler486Main.
 333