MODULE DswCompilerCPfrontMain; IMPORT Kernel, HostFiles, Files, Console, Strings, DswDocuments, DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPH, DevCPV := CPfrontCPV, DevCPG := CPfrontCPG, DevCPR; CONST (* compiler options: *) checks = 0; allchecks = 1; assert = 2; obj = 3; ref = 4; allref = 5; srcpos = 6; reallib = 7; signatures = 8; (* pVarInd = 14; bigEnd = 15; *) ctime = 16; mainprog = 20; include0 = 21; hint = 29; oberon = 30; errorTrap = 31; (* defopt = {checks, assert, obj, ref, allref, srcpos, signatures, ctime}; *) defopt = {checks, assert, obj, ctime}; version = "0.3"; emulong = 0; defopt2 = {}; TYPE Elem = POINTER TO RECORD dir, name, path: Files.Name; outsym, outcode: Files.Name; (* dir *) insym: DevCPM.Directory; found: BOOLEAN; (* COM Aware *) opts, opts2: SET; next: Elem END; Def = POINTER TO RECORD name: DevCPT.Name; val: BOOLEAN; next: Def END; VAR u: Elem; d: Def; PROCEDURE GetPath (IN path: ARRAY OF CHAR; OUT dir, name: Files.Name); VAR i, j, len: INTEGER; BEGIN len := LEN(path$); i := len - 1; WHILE (i >= 0) & (path[i] # '/') DO DEC(i) END; IF i >= 0 THEN FOR i := 0 TO i - 1 DO dir[i] := path[i] END; dir[i] := 0X ELSE dir := "" END; j := i + 1; i := 0; WHILE path[j] # 0X DO name[i] := path[j]; INC(i); INC(j) END; name[i] := 0X END GetPath; PROCEDURE InitOptions; VAR i: INTEGER; found: BOOLEAN; insym, sym: DevCPM.Directory; outsym, outcode: Files.Name; p: ARRAY 256 OF CHAR; h, t: Elem; opts, opts2: SET; PROCEDURE Check; BEGIN IF i >= Kernel.argc THEN Console.WriteStr("required more parameters for "); Console.WriteStr(p); Console.WriteLn; Kernel.Quit(1) END END Check; PROCEDURE Define (IN name: DevCPT.Name; val: BOOLEAN); VAR def: Def; BEGIN NEW(def); def.name := name$; def.val := val; def.next := d; d := def END Define; BEGIN outsym := ""; outcode := ""; opts := defopt; opts2 := defopt2; found := FALSE; h := NIL; t := NIL; insym := NIL; i := 1; WHILE i < Kernel.argc DO IF Kernel.argv[i, 0] = "-" THEN p := Kernel.argv[i]$; INC(i); IF p = "-legacy" THEN DevCPM.legacy := TRUE ELSIF p = "-outsym" THEN Check; outsym := Kernel.argv[i]$; INC(i) ELSIF p = "-outcode" THEN Check; outcode := Kernel.argv[i]$; INC(i) ELSIF p = "-symdir" THEN Check; sym := insym; NEW(insym); insym.path := Kernel.argv[i]$; insym.legacy := FALSE; insym.next := sym; INC(i) ELSIF p = "-legacysymdir" THEN Check; sym := insym; NEW(insym); insym.path := Kernel.argv[i]$; insym.legacy := TRUE; insym.next := sym; INC(i) ELSIF p = "-allchecks" THEN INCL(opts, allchecks) ELSIF p = "-no-allchecks" THEN EXCL(opts, allchecks) ELSIF p = "-srcpos" THEN INCL(opts, srcpos) ELSIF p = "-no-srcpos" THEN EXCL(opts, srcpos) ELSIF p = "-structref" THEN INCL(opts, allref) ELSIF p = "-no-structref" THEN EXCL(opts, allref) ELSIF p = "-ref" THEN INCL(opts, ref) ELSIF p = "-no-ref" THEN EXCL(opts, ref) ELSIF p = "-obj" THEN INCL(opts, obj) ELSIF p = "-no-obj" THEN EXCL(opts, obj) ELSIF p = "-assert" THEN INCL(opts, assert) ELSIF p = "-no-assert" THEN EXCL(opts, assert) ELSIF p = "-checks" THEN INCL(opts, checks) ELSIF p = "-no-checks" THEN EXCL(opts, checks) ELSIF p = "-hints" THEN INCL(opts, hint) ELSIF p = "-no-hints" THEN EXCL(opts, hint) ELSIF p = "-trap" THEN Kernel.intTrap := TRUE; INCL(opts, errorTrap) ELSIF p = "-no-trap" THEN EXCL(opts, errorTrap) ELSIF p = "-oberon" THEN INCL(opts, oberon) ELSIF p = "-no-oberon" THEN EXCL(opts, oberon) ELSIF p = "-com-aware" THEN found := TRUE ELSIF p = "-no-com-aware" THEN found := FALSE ELSIF (p = "-v") OR (p = "-verbose") THEN DevCPM.verbose := MIN(DevCPM.verbose + 1, 3) ELSIF p = "-main" THEN INCL(opts, mainprog) ELSIF p = "-no-main" THEN EXCL(opts, mainprog) ELSIF p = "-include0" THEN INCL(opts, include0) ELSIF p = "-no-include0" THEN EXCL(opts, include0) ELSIF p = "-includedir" THEN Check; DevCPG.includePath := Kernel.argv[i]$; INC(i) ELSIF p = "-long-calls" THEN INCL(opts2, emulong) ELSIF p = "-no-long-calls" THEN EXCL(opts2, emulong) ELSIF p = "-version" THEN Console.WriteStr(version); Console.WriteLn; Kernel.Quit(0) ELSIF p = "-use-time" THEN INCL(opts, ctime) ELSIF p = "-no-use-time" THEN EXCL(opts, ctime) ELSIF p = "-define+" THEN Check; Define(Kernel.argv[i]$, TRUE); INC(i) ELSIF p = "-define-" THEN Check; Define(Kernel.argv[i]$, FALSE); INC(i) ELSE Console.WriteStr("unknown option "); Console.WriteStr(p); Console.WriteLn; Kernel.Quit(1) END ELSE IF h = NIL THEN NEW(h); t := h ELSE NEW(t.next); t := t.next END; t.path := Kernel.argv[i]$; t.outcode := outcode; t.outsym := outsym; t.insym := insym; t.found := found; t.opts := opts; t.opts2 := opts2; GetPath(t.path, t.dir, t.name); IF t.name = "" THEN Console.WriteStr("specified path to directory"); Console.WriteLn; Kernel.Quit(1) END; INC(i) END END; u := h END InitOptions; PROCEDURE Module (source: POINTER TO ARRAY OF CHAR; m: Elem; OUT error: BOOLEAN); VAR ext, new: BOOLEAN; p: DevCPT.Node; def: Def; BEGIN DevCPG.opt := {}; (* !!! *) DevCPM.Init(source); DevCPM.symList := m.insym; DevCPM.codePath := m.outcode; DevCPM.symPath := m.outsym; DevCPM.name := m.path; INCL(DevCPM.options, 10); (* !!! allow [ccall] *) INCL(DevCPM.options, DevCPM.allSysVal); (* !!! make nodes for all SYSTEM.VAL *) INCL(DevCPG.opt, DevCPG.ansi); (* !!! *) IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END; IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END; IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END; IF mainprog IN m.opts THEN INCL(DevCPG.opt, DevCPG.mainprog) END; IF include0 IN m.opts THEN INCL(DevCPG.opt, DevCPG.include0) END; IF ctime IN m.opts THEN INCL(DevCPG.opt, DevCPG.ctime) END; DevCPT.Init(m.opts); (* DevCPB.typSize := DevCPV.TypeSize; *) DevCPB.typSize := DevCPV.TypSize; DevCPT.processor := DevCPV.processor; DevCPR.Init; def := d; WHILE def # NIL DO DevCPR.Set(def.name, def.val); def := def.next END; DevCPP.Module(p); DevCPR.Check; IF DevCPM.noerr THEN IF DevCPT.libName # "" THEN EXCL(m.opts, obj) END; DevCPV.Init(m.opts); DevCPV.AdrAndSize(DevCPT.topScope); DevCPT.Export(ext, new); IF DevCPM.noerr & (obj IN m.opts) THEN DevCPG.OpenFiles(DevCPT.SelfName); IF emulong IN m.opts2 THEN DevCPH.UseCalls(p, {DevCPH.longMop, DevCPH.longDop, DevCPH.longConv, DevCPH.longOdd}); END; DevCPV.Module(p) END; (* DevCPV.Close *) END; IF DevCPM.noerr & (DevCPG.mainprog IN DevCPG.opt) & (DevCPG.modName # "SYSTEM") THEN DevCPM.DeleteNewSym; IF DevCPM.verbose > 0 THEN DevCPM.LogWStr(" main program"); DevCPM.LogWLn END ELSIF DevCPM.noerr & (new OR ext) THEN DevCPM.RegisterNewSym ELSE DevCPM.DeleteNewSym END; IF obj IN m.opts THEN DevCPG.CloseFiles END; DevCPR.Close; DevCPT.Close; error := ~DevCPM.noerr; IF error THEN DevCPM.InsertMarks; IF DevCPM.verbose > 0 THEN DevCPM.LogWStr(" ") END; IF DevCPM.errors = 1 THEN DevCPM.LogWStr("one error detected"); ELSE DevCPM.LogWNum(DevCPM.errors, 0); DevCPM.LogWStr(" errors detected") END; DevCPM.LogWLn ELSE IF hint IN m.opts THEN DevCPM.InsertMarks END END; DevCPM.Close; p := NIL; Kernel.FastCollect END Module; PROCEDURE ReadText (s: Elem): POINTER TO ARRAY OF CHAR; VAR i, res: INTEGER; m: DswDocuments.Model; r: DswDocuments.Reader; loc: Files.Locator; src: POINTER TO ARRAY OF CHAR; num: ARRAY 32 OF CHAR; BEGIN loc := Files.dir.This(s.dir); DswDocuments.Open(loc, s.name, m, res); IF m # NIL THEN r := m.NewReader(NIL); NEW(src, m.Length() + 1); IF src # NIL THEN FOR i := 0 TO m.Length() - 1 DO r.Read; src[i] := r.char END END ELSIF DevCPM.verbose > 0 THEN Strings.IntToString(res, num); Console.WriteStr("document error "); Console.WriteStr(num); Console.WriteLn END; IF src = NIL THEN Console.WriteStr("unable to open file "); Console.WriteStr(s.path); Console.WriteLn; Kernel.Quit(1) END; RETURN src END ReadText; PROCEDURE CompileAll; VAR loc: Files.Locator; m: Elem; error: BOOLEAN; src: POINTER TO ARRAY OF CHAR; BEGIN m := u; WHILE m # NIL DO IF DevCPM.verbose > 0 THEN Console.WriteStr("compiling "); Console.WriteStr(m.path); Console.WriteLn END; src := ReadText(m); Module(src, m, error); IF error THEN Kernel.Quit(1) END; m := m.next END END CompileAll; PROCEDURE Init; BEGIN IF Kernel.trapCount # 0 THEN Kernel.Quit(1) END; HostFiles.SetRootDir("."); InitOptions; CompileAll; Kernel.Quit(0) END Init; BEGIN Kernel.intTrap := FALSE; Kernel.Start(Init) END DswCompilerCPfrontMain.