<> <> <> <<>> <> DIRECTORY Ascii: TYPE USING [Lower], Atom: TYPE USING [MakeAtom], BasicTime: TYPE USING [GMT, Now, Period, ToNSTime], BcdStamps: TYPE USING [Compute], CompilerOps: TYPE USING [ AppendHerald, CompilerVersion, DefaultSwitches, DoTransaction, LetterSwitches, Start, Stop, StreamId, Transaction], CS: TYPE USING [PartialName, RopeFromStamp, RootName, ShortName], FileParms: TYPE USING [ ActualId, BindingProc, Name, nullActual, nullSymbolSpace, SymbolSpace], FileViewerOps: TYPE USING [AttachErrorLog, ShowLog, RemoveErrorLog], FS: TYPE USING [ OpenFile, nullOpenFile, Delete, Error, ExpandName, GetInfo, Open, StreamOpen, StreamFromOpenFile], IO: TYPE USING [ atom, card, Close, PutChar, PutF, PutRope, rope, STREAM, time], Process: TYPE USING [ Priority, priorityBackground, Abort, CheckForAbort, GetCurrent, GetPriority, SetPriority], Rope: TYPE USING [Concat, Fetch, Length, ROPE, Text], SMComp: TYPE USING [], SMFI: TYPE USING[BcdFileInfo, SrcFileInfo], SMFIOps: TYPE USING [Available, Fill], SMLDriver: TYPE USING [LoadMod, LoadedModule], SMOps: TYPE USING [MS], SMProj: TYPE USING [Proj, Analyzed, Available, Erase, Fill, Find, Update], SMTree: TYPE Tree USING [ApplOp, Handle, Link, Name, null], SMTreeOps: TYPE TreeOps USING [ GetExt, GetName, NthSon, NSons, OpName, PutExt, Scan, ScanSons], SMVal: TYPE USING [ Binding, BtoG, GetExtFromParse, OuterBody, ValOf, ValOfNthSon, VisitNodes], TimeStamp: TYPE USING [Stamp, Null], TiogaMenuOps: TYPE USING [DefaultMenus], VersionMapDefaults: TYPE USING [FileNameFromVersion], ViewerClasses: TYPE USING [Viewer], ViewerOps: TYPE USING [FindViewer]; <> SMCompImpl: CEDAR MONITOR -- this monitor locks the compiler IMPORTS Ascii, Atom, BasicTime, BcdStamps, CompilerOps, CS, FileViewerOps, FS, IO, Process, Rope, SMFIOps, SMLDriver, SMProj, SMTreeOps, SMVal, VersionMapDefaults, TiogaMenuOps, ViewerOps EXPORTS SMComp ~ { OPEN Tree~~SMTree, TreeOps~~SMTreeOps; <> <> compilerIsLocked: BOOL _ FALSE; compilerWait: CONDITION; log: IO.STREAM _ NIL; -- out stream to compiler.log complete: BOOL; nSuccessful, nWarnings, nErrors: CARDINAL; nUnmatched: NAT; -- compiled but not replacable compilerStarted: BOOL _ FALSE; timeCompilerStarted: BasicTime.GMT; userAbort: BOOL _ FALSE; <> CompileAll: PUBLIC PROC[ms: SMOps.MS, t: Tree.Link, replace: BOOL] RETURNS[completed: BOOL] ~ { abort: BOOL; AcquireCompiler[]; { ENABLE UNWIND => {ReleaseCompiler[]}; startTime, endTime: BasicTime.GMT; formals, body: Tree.Link; [formals, body] _ SMVal.OuterBody[t]; startTime _ BasicTime.Now[]; nSuccessful _ nWarnings _ nErrors _ nUnmatched _ 0; userAbort _ FALSE; complete _ TRUE; TraverseTreeForCompile[ms, body, replace ! UNWIND => {[] _ StopBatchCompile[ms]}]; StopBatchCompile[ms]; endTime _ BasicTime.Now[]; IF nSuccessful = 0 AND nErrors = 0 AND nWarnings = 0 THEN ms.out.PutRope["Nothing was compiled.\n\n"] ELSE { ms.out.PutF["%d successful", IO.card[nSuccessful]]; IF nErrors > 0 THEN ms.out.PutF["; %d w/errors", IO.card[nErrors]]; IF nWarnings > 0 THEN ms.out.PutF["; %d w/warnings", IO.card[nWarnings]]; ms.out.PutF[ "\nTotal time to compile: %d seconds.\n\n", IO.card[startTime.Period[endTime]]]; }; completed _ complete AND (nErrors = 0) AND (nUnmatched = 0); abort _ userAbort; }; ReleaseCompiler[]; IF abort THEN TRUSTED {Process.Abort[Process.GetCurrent[]]}; RETURN}; AcquireCompiler: ENTRY PROC ~ { ENABLE UNWIND => {NULL}; WHILE compilerIsLocked DO WAIT compilerWait ENDLOOP; compilerIsLocked _ TRUE}; ReleaseCompiler: ENTRY PROC ~ { ENABLE UNWIND => {NULL}; compilerIsLocked _ FALSE; NOTIFY compilerWait}; InProgress: SIGNAL[appl: Tree.Link] RETURNS[BOOL] ~ CODE; TraverseTreeForCompile: PROC[ms: SMOps.MS, root: Tree.Link, replace: BOOL] ~ INLINE { ForEachApply: PROC[node, parent: Tree.Link] ~ { SELECT TreeOps.OpName[node] FROM IN Tree.ApplOp => WITH SMVal.ValOfNthSon[node, 1] SELECT FROM source: SMFI.SrcFileInfo => WITH TreeOps.GetExt[node] SELECT FROM proj: SMProj.Proj => -- already processed IF ~proj.Available THEN complete _ FALSE; ENDCASE => [] _ DoCompile[ms, source, node, parent, replace]; ENDCASE => NULL; -- ignore this appl on this pass ENDCASE; }; SMVal.VisitNodes[ms.tm, root, ForEachApply ! InProgress => {RESUME[FALSE]}]}; FormalActual: TYPE ~ RECORD[ SEQUENCE length: NAT OF RECORD[ name: Tree.Name, object: SMProj.Proj] ]; DoCompile: PROC[ ms: SMOps.MS, source: SMFI.SrcFileInfo, node, parent: Tree.Link, replace: BOOL] RETURNS[proj: SMProj.Proj] ~ { oldLoadMod: SMLDriver.LoadMod ~ (IF TreeOps.OpName[parent] IN Tree.ApplOp THEN NARROW[SMVal.GetExtFromParse[parent]] ELSE NIL); args: Tree.Link ~ SMVal.ValOfNthSon[node, 2]; proj _ PossibleCompile[ms, source, args, replace, oldLoadMod ! InProgress => {IF appl = node THEN RESUME[TRUE]}]; IF ~userAbort THEN TreeOps.PutExt[node, proj]; IF ~proj.Available THEN complete _ FALSE; -- errors or declined RETURN}; PossibleCompile: PROC[ ms: SMOps.MS, source: SMFI.SrcFileInfo, args: Tree.Link, replace: BOOL, oldLoadMod: SMLDriver.LoadMod] RETURNS[proj: SMProj.Proj] ~ { directoryMap: REF FormalActual; bcdStamp: TimeStamp.Stamp; switches: CompilerOps.LetterSwitches; BcdStampFromAppl: PROC[source: SMFI.SrcFileInfo, args: Tree.Link] RETURNS[ bcdVersion: TimeStamp.Stamp, directoryMap: REF FormalActual, switches: CompilerOps.LetterSwitches] ~ INLINE { inx: NAT _ 0; DeclName: PROC[t: Tree.Link] RETURNS[Tree.Name] ~ INLINE { RETURN[TreeOps.GetName[TreeOps.NthSon[t, 1]]]}; SetFormalName: TreeOps.Scan ~ { SELECT TreeOps.OpName[t] FROM $declElem => IF inx < directoryMap.length THEN { directoryMap[inx].name _ DeclName[t]; inx _ inx + 1}; ENDCASE; }; d: Tree.Link ~ TreeOps.NthSon[source.type, 1]; g: Tree.Link ~ (IF SMVal.Binding[args] THEN SMVal.BtoG[args] ELSE args); TRUSTED {switches _ CompilerOps.DefaultSwitches[]; switches['s] _ FALSE}; directoryMap _ (ms.z).NEW[FormalActual[TreeOps.NSons[d]-1]]; -- excludes &options TreeOps.ScanSons[d, SetFormalName]; IF TreeOps.OpName[g] = $group THEN { i: NAT _ 0; ExtractProjection: PROC[t: Tree.Link, parent: Tree.Link_Tree.null] RETURNS[proj: SMProj.Proj _ NIL] ~ { WITH t SELECT FROM fiBcd: SMFI.BcdFileInfo => { -- temporary (inefficient) proj _ SMProj.Find[fiBcd.stamp]; IF ~proj.Analyzed THEN proj.Fill[fiBcd.fName, ms.wDir, FALSE]}; ENDCASE => SELECT TreeOps.OpName[t] FROM IN Tree.ApplOp => { son1: Tree.Link ~ SMVal.ValOfNthSon[t, 1]; WITH son1 SELECT FROM fiSrc: SMFI.SrcFileInfo => WITH TreeOps.GetExt[t] SELECT FROM p: SMProj.Proj => proj _ p; ENDCASE => IF SIGNAL InProgress[t] THEN { ms.out.PutF[ "Cannot compile %g because of circular dependency\n", IO.rope[fiSrc.localName]]; proj _ NIL; complete _ FALSE} ELSE proj _ DoCompile[ms, fiSrc, t, parent, replace]; ENDCASE => proj _ ExtractProjection[son1, t]; }; $subscript => -- assert: ValOf[son[1]] is an appl proj _ ExtractProjection[SMVal.ValOfNthSon[t, 1]]; ENDCASE; RETURN}; ActualByPosition: TreeOps.Scan ~ { v: Tree.Link ~ SMVal.ValOf[t]; WITH v SELECT FROM text: Rope.Text => switches _ InterpolateSwitches[text]; ENDCASE => {directoryMap[i].object _ ExtractProjection[v]; i _ i+1}; }; TreeOps.ScanSons[g, ActualByPosition]} ELSE ERROR; -- residual TYPE CHECK {compilerVersion: TimeStamp.Stamp; DirectoryEnumerator: PROC[forEach: PROC[TimeStamp.Stamp]] ~ { FOR i: NAT IN [0..directoryMap.length) DO proj: SMProj.Proj ~ directoryMap[i].object; forEach[IF proj = NIL THEN TimeStamp.Null ELSE proj.stamp] ENDLOOP; }; TRUSTED {compilerVersion _ CompilerOps.CompilerVersion[]}; bcdVersion _ BcdStamps.Compute[ BasicTime.ToNSTime[LOOPHOLE[source.create]], switches, compilerVersion, DirectoryEnumerator] }; }; argsAvailable: BOOL _ TRUE; tryToReplace: BOOL; [bcdStamp, directoryMap, switches] _ BcdStampFromAppl[source, args]; <> proj _ SMProj.Find[bcdStamp]; IF proj.Available THEN RETURN; -- already found and analyzed <> proj.Fill[CS.RootName[source.simpleName], ms.wDir, source.new]; IF proj.Available THEN RETURN; -- correct version on file system FOR i: NAT IN [0..directoryMap.length) WHILE argsAvailable DO IF ~(directoryMap[i].object).Available THEN argsAvailable _ FALSE; ENDLOOP; tryToReplace _ replace AND argsAvailable AND Replaceable[oldLoadMod]; IF ~argsAvailable THEN ms.out.PutF[ "Cannot compile %g because compilation of an argument failed\n", IO.rope[source.localName]] ELSE IF ~userAbort THEN { oldProj: SMProj.Proj ~ (IF tryToReplace THEN oldLoadMod.proj ELSE NIL); errors, replaceable: BOOL; CompileMessage[ms, source.localName, switches]; [errors, , replaceable] _ CompileIt[ms, source, directoryMap, switches, proj, oldProj]; IF oldProj ~= NIL THEN { -- tried for replacement IF replaceable AND ~errors THEN ms.out.PutF[" %g passes compiler's test for replaceability.\n", IO.rope[proj.localName]] ELSE { replaceable _ FALSE; IF ~errors THEN ms.out.PutF[" %g is not replaceable (compiler refuses).\n", IO.rope[proj.localName]] }; }; IF oldLoadMod # NIL THEN oldLoadMod.mustReplace _ replaceable} ELSE NULL}; Replaceable: PROC[loadMod: SMLDriver.LoadMod] RETURNS[BOOL] ~ INLINE { RETURN[loadMod # NIL AND loadMod.loadInfo.LoadedModule]}; CompileIt: PROC[ ms: SMOps.MS, source: SMFI.SrcFileInfo, args: REF FormalActual, switches: CompilerOps.LetterSwitches, proj, oldProj: SMProj.Proj] RETURNS[errors, warnings, replaceable: BOOL] ~ { priority: Process.Priority ~ Process.GetPriority[]; t: REF CompilerOps.Transaction ~ (ms.z).NEW[CompilerOps.Transaction]; startTime: BasicTime.GMT; DirectoryBinding: PROC[ formalId, formalType: FileParms.Name, defaultLocator: FileParms.Name, binder: FileParms.BindingProc] ~ { desiredName: Tree.Name ~ Atom.MakeAtom[formalId]; FOR i: NAT IN [0 .. args.length) DO IF args[i].name = desiredName THEN { bcd: SMProj.Proj ~ args[i].object; TRUSTED { binder[ FileParms.ActualId[ version~bcd.stamp, locator~CS.ShortName[bcd.localName]] ] }; RETURN} ENDLOOP; ms.out.PutF["\nError - '%g' not found in argument list.\n", IO.atom[desiredName]]; TRUSTED {binder[FileParms.nullActual]}}; <