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