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