MODULE DswMakeMain; IMPORT Kernel, Files, Log, Strings, DswOpts, DswProcs, DswDocuments, DevCPM, DevCPT, DevCPR, DevCPS; CONST version = "0.3"; modDir = "Mod"; sysDir = "System"; maxImps = 127; maxJobs = maxImps; (* symbol values *) null = 0; times = 1; slash = 2; div = 3; mod = 4; and = 5; plus = 6; minus = 7; or = 8; eql = 9; neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14; in = 15; is = 16; arrow = 17; dollar = 18; period = 19; comma = 20; colon = 21; upto = 22; rparen = 23; rbrak = 24; rbrace = 25; of = 26; then = 27; do = 28; to = 29; by = 30; not = 33; lparen = 40; lbrak = 41; lbrace = 42; becomes = 44; number = 45; nil = 46; string = 47; ident = 48; semicolon = 49; bar = 50; end = 51; else = 52; elsif = 53; until = 54; if = 55; case = 56; while = 57; repeat = 58; for = 59; loop = 60; with = 61; exit = 62; return = 63; array = 64; record = 65; pointer = 66; begin = 67; const = 68; type = 69; var = 70; out = 71; procedure = 72; close = 73; import = 74; module = 75; eof = 76; (* module state flags *) imported = 0; trace = 1; hasObj = 2; hasSym = 3; hasErrors = 4; library = 5; force = 6; debugImport = FALSE; debugOrder = FALSE; debugJobs = FALSE; TYPE Name = ARRAY 256 OF CHAR; String = POINTER TO ARRAY OF CHAR; Selector = POINTER TO RECORD name: DevCPT.Name; value: BOOLEAN; next: Selector END; Module = POINTER TO RECORD name: DevCPT.Name; library: DevCPT.Name; odc: Files.Name; depth: INTEGER; (* 0: leaf, MAX: root *) dir: DevCPM.Directory; mno: INTEGER; imp: ARRAY maxImps OF Module; flags: SET; worker: DswProcs.Process; END; Library = POINTER TO RECORD name: Name; library: Name; next: Library; END; VAR (* options *) auto, trap, clean, symonly, nocode1, nocode2: BOOLEAN; exe, target, base: String; jobs: INTEGER; VAR werr, err: INTEGER; mno, rno: INTEGER; (* num modules *) modList, lnkList, cmpList: ARRAY maxImps OF Module; def: Selector; (* with head, global list of selectors *) dirList: DevCPM.Directory; libList: Library; PROCEDURE Error (IN str, p0, p1: ARRAY OF CHAR; i2: INTEGER); VAR p2: ARRAY 32 OF CHAR; BEGIN Strings.IntToString(i2, p2); Log.String("cpmake: "); Log.ParamMsg(str, p0, p1, p2); Log.Ln; INC(err); IF trap THEN HALT(100) END END Error; (* --------- options --------- *) PROCEDURE IdentLen (IN s: ARRAY OF CHAR): INTEGER; VAR i: INTEGER; BEGIN i := 0; IF Strings.IsIdentStart(s[0]) THEN REPEAT INC(i) UNTIL ~Strings.IsIdent(s[i]) END; RETURN i END IdentLen; PROCEDURE Define (n: ARRAY OF CHAR; overwrite: BOOLEAN); VAR i: INTEGER; v: BOOLEAN; s: Selector; BEGIN i := IdentLen(n); IF i # 0 THEN IF ~((n[i] = 0X) OR (((n[i] = "+") OR (n[i] = "-")) & (n[i + 1] = 0X))) THEN Error("expectd + or - after selector identifier (^0)", n, "", 0) END; v := n[i] # "-"; n[i] := 0X; s := def; WHILE (s.next # NIL) & (s.next.name$ # n$) DO s := s.next END; IF s.next = NIL THEN NEW(s.next); Strings.StringToUtf8(n, s.next.name, i); ASSERT(i = 0); s.next.value := v ELSIF overwrite THEN s.next.value := v END ELSE Error("selector '^0' have invalid identifier", n, "", 0) END END Define; PROCEDURE DefineNew (IN n: ARRAY OF CHAR); BEGIN Define(n, FALSE); END DefineNew; PROCEDURE AddModule (IN n: ARRAY OF CHAR; selectors: Selector; dir: DevCPM.Directory); VAR i, res: INTEGER; m: Module; BEGIN i := IdentLen(n); IF (i # 0) & (n[i] = 0X) THEN i := 0; WHILE (i < mno) & (modList[i].name$ # n$) DO INC(i) END; IF i >= mno THEN NEW(m); Strings.StringToUtf8(n, m.name, res); ASSERT(res = 0); m.dir := dir; modList[i] := m; INC(mno) END ELSE Error("invalid module name", "", "", 0) END END AddModule; PROCEDURE AddLibrary (IN key, val: ARRAY OF CHAR); VAR x: Library; BEGIN x := libList; WHILE (x # NIL) & (x.name$ # key$) DO x := x.next END; IF x # NIL THEN x.library := val$ ELSE NEW(x); x.name := key$; x.library := val$; x.next := libList; libList := x END END AddLibrary; PROCEDURE AddLib (IN s: ARRAY OF CHAR); VAR key, val: Name; i, j: INTEGER; BEGIN i := 0; j := 0; WHILE (s[i] # 0X) & (s[i] # "=") DO key[j] := s[i]; INC(j); INC(i) END; key[j] := 0X; j := 0; IF s[i] = "=" THEN INC(i); WHILE s[i] # 0X DO val[j] := s[i]; INC(j); INC(i) END END; val[j] := 0X; IF key # "" THEN AddLibrary(key, val) ELSE Error("empty library key", "", "", 0) END END AddLib; PROCEDURE FindLib (IN key: ARRAY OF CHAR): Library; VAR x: Library; BEGIN x := libList; WHILE (x # NIL) & (x.name$ # key$) DO x := x.next END; RETURN x END FindLib; PROCEDURE StrToInt (IN s: ARRAY OF CHAR; def: INTEGER): INTEGER; VAR x, res: INTEGER; BEGIN Strings.StringToInt(s, x, res); IF res # 0 THEN Error("invalid integer value", s, "", 0); x := def END; RETURN x END StrToInt; PROCEDURE NewStr (IN s: ARRAY OF CHAR): String; VAR p: String; BEGIN NEW(p, LEN(s$) + 1); p^ := s$; RETURN p END NewStr; PROCEDURE Help; BEGIN Log.String("Usage: cpmake [options] module..."); Log.Ln; Log.String("Options:"); Log.Ln; Log.String(" -a Enable automatic dependency resolution"); Log.Ln; Log.String(" -b Do not compile modules"); Log.Ln; Log.String(" -x Do not link objects"); Log.Ln; Log.String(" -c Remove all generated files"); Log.Ln; Log.String(" -s Generate symbol files only"); Log.Ln; Log.String(" -d selector Add selector"); Log.Ln; Log.String(" -r lib[=s] Replace library name on link stage"); Log.Ln; Log.String(" -t target Specify target rules"); Log.Ln; Log.String(" -o file Generate object file"); Log.Ln; Log.String(" -j num Specifies the number of jobs to run simultaneously"); Log.Ln; Log.String(" -f path Specifies path to directory with targets"); Log.Ln; Log.String(" -h Print help"); Log.Ln; Log.String(" -v Print version"); Log.Ln; Kernel.Quit(0) END Help; PROCEDURE ParseArgs; BEGIN exe := NIL; auto := FALSE; jobs := 1; def.next := NIL; mno := 0; rno := 0; target := NewStr("default"); base := NewStr("cprules"); LOOP CASE DswOpts.GetOpt("acbxd:sgGo:t:j:f:r:h") OF | "a": auto := TRUE | "b": nocode1 := TRUE | "x": nocode2 := TRUE | "c": clean := TRUE | "g": trap := TRUE | "G": Kernel.intTrap := TRUE | "s": symonly := TRUE | "f": base := DswOpts.str | "d": Define(DswOpts.str, TRUE) | "r": AddLib(DswOpts.str) | "h": Help | "j": jobs := MIN(MAX(StrToInt(DswOpts.str, 1), 1), maxJobs) | "o": exe := DswOpts.str | "t": target := DswOpts.str | "v": Log.String(version); Log.Ln; Kernel.Quit(0) | ":": Error("missing argument for option -^0", DswOpts.str, "", 0) | "?": Error("unknown option -^0", DswOpts.str, "", 0) | "$": AddModule(DswOpts.str, def, dirList) | 00X: EXIT END END END ParseArgs; PROCEDURE ReadLines (loc: Files.Locator; IN name: Files.Name; p: PROCEDURE (IN s: ARRAY OF CHAR)); VAR s: Name; m: DswDocuments.Model; r: DswDocuments.Reader; i, res: INTEGER; BEGIN ASSERT(loc # NIL, 20); ASSERT(name # "", 21); ASSERT(p # NIL, 22); DswDocuments.Open(loc, name, m, res); IF res = 0 THEN r := m.NewReader(NIL); r.SetPos(0); r.Read; WHILE ~r.eot DO i := 0; WHILE ~r.eot & (r.char <= 20X) DO r.Read END; WHILE ~r.eot & (r.char > 20X) DO s[i] := r.char; r.Read; INC(i) END; IF i # 0 THEN s[i] := 0X; p(s) END END END END ReadLines; PROCEDURE CheckParams; VAR loc: Files.Locator; BEGIN IF (exe # NIL) & (exe^ = "") THEN Error("specified empty file name for exe", "", "", 0) END; IF target^ = "" THEN Error("specified empty rule", "", "", 0) END; IF base^ = "" THEN Error("specified empty path to cpmake rules", "", "", 0) END; loc := Files.dir.This(base).This(target); ReadLines(loc, "defines", DefineNew); ReadLines(loc, "libs", AddLib) END CheckParams; (* --------- loader --------- *) PROCEDURE Import (m: Module; IN name: DevCPT.Name); VAR i, j: INTEGER; imp: Module; BEGIN ASSERT(m # NIL, 20); ASSERT(name # "", 21); IF debugImport THEN Log.String(" import "); Log.String(name$) END; IF name = "SYSTEM" THEN INCL(DevCPM.options, DevCPM.sysImp) ELSIF name = "COM" THEN INCL(DevCPM.options, DevCPM.com) ELSIF name = "JAVA" THEN INCL(DevCPM.options, DevCPM.java) ELSE IF debugImport THEN Log.Char(" ") END; i := 0; (* find module in local list *) WHILE (i < m.mno) & (m.imp[i].name$ # name$) DO INC(i) END; IF i >= m.mno THEN j := 0; (* find module in global list *) WHILE (j < mno) & (modList[j].name$ # name$) DO INC(j) END; IF j >= mno THEN IF ~auto THEN Log.String("module " + name + " required before " + m.name); Log.Ln; INC(werr) END; NEW(imp); imp.name := name$; modList[mno] := imp; INC(mno) ELSE imp := modList[j] END; m.imp[m.mno] := imp; INC(m.mno) ELSE DevCPM.err(1) END END; IF debugImport THEN Log.Ln END; END Import; PROCEDURE ParseModule (m: Module); VAR sym: BYTE; SelfName, impName, aliasName: DevCPT.Name; PROCEDURE err (n: SHORTINT); BEGIN DevCPM.err(n) END err; PROCEDURE CheckSym(s: SHORTINT); BEGIN IF sym = s THEN DevCPS.Get(sym) ELSE DevCPM.err(s) END END CheckSym; BEGIN IF debugImport THEN Log.String("module " + m.name); Log.Ln END; DevCPS.Init; DevCPS.Get(sym); IF sym = module THEN DevCPS.Get(sym) ELSE err(16) END; IF sym = ident THEN SelfName := DevCPS.name$; DevCPS.Get(sym); IF sym = lbrak THEN INCL(DevCPM.options, DevCPM.interface); DevCPS.Get(sym); IF sym = eql THEN DevCPS.Get(sym) ELSE INCL(DevCPM.options, DevCPM.noCode) END; IF sym = string THEN INCL(m.flags, library); m.library := DevCPS.str$; DevCPS.Get(sym) ELSE err(string) END; CheckSym(rbrak) END; CheckSym(semicolon); IF sym = import THEN DevCPS.Get(sym); LOOP IF sym = ident THEN aliasName := DevCPS.name$; impName := aliasName$; DevCPS.Get(sym); IF sym = becomes THEN DevCPS.Get(sym); IF sym = ident THEN impName := DevCPS.name$; DevCPS.Get(sym) ELSE err(ident) END END; Import(m, impName) ELSE err(ident) END; IF sym = comma THEN DevCPS.Get(sym) ELSIF sym = ident THEN err(comma) ELSE EXIT END END; CheckSym(semicolon) END; LOOP (* preprocessor must read module fully *) IF sym = end THEN DevCPS.Get(sym); IF sym = ident THEN DevCPS.Get(sym); IF sym = period THEN IF DevCPS.name # SelfName THEN err(4) END; EXIT ELSIF sym = eof THEN err(period); EXIT END ELSIF sym = eof THEN err(ident); EXIT END; ELSIF sym = eof THEN err(end); EXIT ELSE DevCPS.Get(sym); END END ELSE err(ident) END; DevCPS.str := NIL END ParseModule; PROCEDURE CheckModule (m: Module; source: String; OUT ok: BOOLEAN); VAR s: Selector; BEGIN DevCPM.Init(source); DevCPM.symList := m.dir; (*DevCPM.codePath := m.outcode;*) (*DevCPM.symPath := m.outsym;*) DevCPM.name := m.name$; INCL(DevCPM.options, DevCPM.comAware); IF trap THEN INCL(DevCPM.options, DevCPM.trap) END; (*IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;*) DevCPR.Init; s := def.next; WHILE s # NIL DO DevCPR.Set(s.name, s.value); s := s.next END; ParseModule(m); DevCPR.Check; ok := DevCPM.noerr; IF DevCPR.used THEN INCL(m.flags, force) END; DevCPR.Close; DevCPM.InsertMarks; DevCPM.Close; Kernel.FastCollect END CheckModule; PROCEDURE MakePath (IN dir, name: Files.Name; IN type: Files.Type; OUT path: Files.Name); BEGIN ASSERT(name # "", 21); IF dir = "" THEN path := modDir + "/" + name ELSE path := dir + "/" + modDir + "/" + name END; Kernel.MakeFileName(path, type) END MakePath; PROCEDURE Open (loc: Files.Locator; IN sub, name: Files.Name; OUT path: Files.Name; OUT text: DswDocuments.Model); VAR res: INTEGER; BEGIN ASSERT(loc # NIL, 20); ASSERT(name # "", 21); (* !!! use Kernel.MakeFileName instead ".ext" concat !!! *) MakePath(sub, name, "cp", path); DswDocuments.Open(loc, name + ".cp", text, res); IF text = NIL THEN MakePath(sub, name, "odc", path); DswDocuments.Open(loc, name + ".odc", text, res); IF (text = NIL) & (sub = "") THEN MakePath(sysDir, name, "cp", path); loc := Files.dir.This(sysDir).This(modDir); DswDocuments.Open(loc, name + ".cp", text, res); IF text = NIL THEN MakePath(sysDir, name, "odc", path); DswDocuments.Open(loc, name + ".odc", text, res); IF text = NIL THEN path := "" END END END END END Open; PROCEDURE GetSource (IN modName: ARRAY OF CHAR; list: DevCPM.Directory; OUT path: Files.Name; OUT s: String); VAR sub, name: Files.Name; loc: Files.Locator; base: DevCPM.Directory; text: DswDocuments.Model; r: DswDocuments.Reader; i, res: INTEGER; BEGIN s := NIL; path := ""; base := list; Kernel.SplitName(modName, sub, name); loc := Files.dir.This(sub).This(modDir); Open(loc, sub, name, path, text); WHILE (text = NIL) & (base # NIL) DO ASSERT(base.legacy, 100); loc := Files.dir.This(base.path).This(sub).This(modDir); Open(loc, sub, name, path, text); base := base.next END; IF text # NIL THEN NEW(s, text.Length() + 1); IF s # NIL THEN r := text.NewReader(NIL); FOR i := 0 TO text.Length() - 1 DO r.Read; s[i] := r.char END END END END GetSource; PROCEDURE Trace (m, parent: Module; VAR lno: INTEGER); VAR i: INTEGER; BEGIN IF ~(trace IN m.flags) THEN INCL(m.flags, trace); FOR i := 0 TO m.mno - 1 DO Trace(m.imp[i], m, lno); m.depth := MAX(m.depth, m.imp[i].depth + 1) END; IF ~(imported IN m.flags) THEN INCL(m.flags, imported); lnkList[lno] := m; INC(lno) END; EXCL(m.flags, trace) ELSE Error("recursive import of ^0 in ^1", m.name$, parent.name$, 0) END END Trace; PROCEDURE Sort; VAR i, j: INTEGER; m: Module; BEGIN ASSERT((mno = 0) OR (lnkList[0] # NIL), 20); cmpList := lnkList; i := 1; WHILE i < mno DO m := cmpList[i]; j := i - 1; WHILE (j >= 0) & (cmpList[j].depth > m.depth) DO cmpList[j + 1] := cmpList[j]; DEC(j) END; cmpList[j + 1] := m; INC(i) END END Sort; PROCEDURE CheckDeps; VAR i, j, num: INTEGER; m: Module; src: String; ok: BOOLEAN; BEGIN i := 0; rno := mno; WHILE (err = 0) & (i < mno) DO m := modList[i]; GetSource(m.name$, m.dir, m.odc, src); IF src # NIL THEN CheckModule(m, src, ok); IF ~ok THEN INC(err) END ELSE Error("unable to open module ^1", m.name$, "", 0) END; INC(i) END; INC(err, werr); num := 0; FOR i := 0 TO rno - 1 DO Trace(modList[i], modList[i], num) END; ASSERT((err # 0) OR (num = mno), 100); Sort; IF debugOrder THEN Log.String("Parallel depth:"); Log.Ln; FOR i := 0 TO mno - 1 DO Log.String(" " + cmpList[i].name); Log.Int(cmpList[i].depth); Log.Ln; END END END CheckDeps; PROCEDURE IsCompiled (m: Module): BOOLEAN; CONST target = {hasSym, hasObj}; VAR i: INTEGER; ready: BOOLEAN; BEGIN ASSERT(m # NIL, 20); i := 0; ready := ~(hasErrors IN m.flags) & (m.flags * target = target); WHILE ready & (i < m.mno) DO ready := IsCompiled(m.imp[i]); INC(i) END; RETURN ready END IsCompiled; PROCEDURE Ready (m: Module): BOOLEAN; CONST target = {hasSym, hasObj}; VAR i: INTEGER; ready: BOOLEAN; BEGIN i := 0; ready := ~(hasErrors IN m.flags) & (m.flags * target # target) & (m.worker = NIL); WHILE ready & (i < m.mno) DO ready := IsCompiled(m.imp[i]); INC(i) END; RETURN ready END Ready; PROCEDURE PrepareCompilerDeps (m: Module; p: DswProcs.Process; root, libsOnly: BOOLEAN); VAR i: INTEGER; s: ARRAY 3 OF CHAR; lib: Library; BEGIN IF ~(trace IN m.flags) THEN INCL(m.flags, trace); FOR i := 0 TO m.mno - 1 DO PrepareCompilerDeps(m.imp[i], p, FALSE, libsOnly) END; IF ~libsOnly OR (library IN m.flags) THEN IF library IN m.flags THEN s := "-l" ELSE s := "-m" END; IF root THEN s[1] := CAP(s[1]) END; IF library IN m.flags THEN lib := FindLib(m.library$); IF lib # NIL THEN IF lib.library$ # "" THEN p.PutParam(s); p.PutParam(lib.library$) END ELSE p.PutParam(s); p.PutParam(m.library$) END ELSE p.PutParam(s); p.PutParam(m.name$) END END; EXCL(m.flags, trace) END END PrepareCompilerDeps; PROCEDURE PrepareCompiler (m: Module): DswProcs.Process; VAR p: DswProcs.Process; s: Selector; i: INTEGER; BEGIN ASSERT(m # NIL, 20); ASSERT(m.odc # "", 21); ASSERT(m.worker = NIL, 22); p := DswProcs.dir.New(); p.Program(base + "/" + target + "/" + "build"); p.PutParam(m.odc); IF nocode1 THEN p.PutParam("-b") END; IF nocode2 THEN p.PutParam("-x") END; IF force IN m.flags THEN p.PutParam("-f") END; IF symonly OR (library IN m.flags) THEN p.PutParam("-s") END; s := def.next; WHILE s # NIL DO IF s.value THEN p.PutParam("-D") ELSE p.PutParam("-d") END; p.PutParam(s.name$); s := s.next END; FOR i := 0 TO m.mno - 1 DO PrepareCompilerDeps(m.imp[i], p, TRUE, FALSE); END; RETURN p END PrepareCompiler; PROCEDURE Compile; VAR i, j, num, res: INTEGER; ok: BOOLEAN; m: Module; w: DswProcs.Process; BEGIN IF mno = 0 THEN RETURN END; num := 0; j := 0; WHILE (err = 0) & (num < mno) OR (j > 0) DO i := 0; WHILE (err = 0) & (i < mno) & (j < jobs) DO m := cmpList[i]; IF Ready(m) THEN w := PrepareCompiler(m); IF debugJobs THEN Log.String("Start job " + m.name) END; w.Execute(ok); IF ok THEN IF debugJobs THEN Log.String(" ok") END; m.worker := w; INC(j) ELSE IF debugJobs THEN Log.String(" fail") END; INCL(m.flags, hasErrors); INC(err) END; IF debugJobs THEN Log.Ln END END; INC(i) END; WHILE (err = 0) & (j >= jobs) OR (j > 0) DO i := 0; WHILE (j > 0) & (i < mno) DO m := cmpList[i]; w := m.worker; IF (w # NIL) & w.IsTerminated() THEN res := w.Result(); IF debugJobs THEN Log.String("Stop job " + m.name); Log.Int(res); Log.Ln END; IF res = 0 THEN INCL(m.flags, hasObj); INCL(m.flags, hasSym); INC(num) ELSE INCL(m.flags, hasErrors); INC(err) END; m.worker := NIL; DEC(j) END; INC(i) END END END END Compile; PROCEDURE Link; VAR p: DswProcs.Process; ok: BOOLEAN; i, res: INTEGER; BEGIN IF ~symonly & (exe # NIL) THEN p := DswProcs.dir.New(); p.Program(base + "/" + target + "/" + "link"); p.PutParam(exe$); FOR i := 0 TO mno - 1 DO IF ~(library IN lnkList[i].flags) THEN p.PutParam(lnkList[i].name$) END END; FOR i := 0 TO mno - 1 DO IF library IN lnkList[i].flags THEN PrepareCompilerDeps(lnkList[i], p, FALSE, TRUE) END END; p.Execute(ok); IF ok THEN p.Wait; res := p.Result(); IF res # 0 THEN Error("link failed with code ^2", "", "", res) END ELSE Error("link failed: unable to execute script", "", "", 0) END END END Link; PROCEDURE Cleanup; VAR p: DswProcs.Process; ok: BOOLEAN; res: INTEGER; BEGIN IF clean THEN p := DswProcs.dir.New(); p.Program(base + "/" + target + "/" + "clean"); p.Execute(ok); IF ok THEN p.Wait; res := p.Result(); IF res # 0 THEN Error("cleanup failed with code ^2", "", "", res) END ELSE Error("cleanup failed: unable to execute script", "", "", 0) END END END Cleanup; PROCEDURE Main; BEGIN IF Kernel.trapCount = 0 THEN ParseArgs; IF err = 0 THEN CheckParams; IF err = 0 THEN CheckDeps; IF err = 0 THEN Cleanup; IF err = 0 THEN Compile; IF err = 0 THEN Link END END END END END ELSE Error("trap occured", "", "", 0) END; IF err = 0 THEN Kernel.Quit(0) ELSE Kernel.Quit(1) END END Main; BEGIN NEW(def); ASSERT(def # NIL, 100); Kernel.intTrap := FALSE; Kernel.Start(Main) END DswMakeMain.