DIRECTORY
Alloc: TYPE USING [Create, Chunkify, Destroy, Failure, Reset, TableInfo],
Ascii: TYPE USING [Lower],
BasicTime: TYPE USING [GMT, Now, Period, ToNSTime],
BcdBindDefs: TYPE USING [RelocHandle],
BcdComData:
TYPE
USING [
aborted, bcdName, binderVersion, codeName, commandArgs, copyCode, copySymbols, currentName, debug, errors, errorStream, logStream, nConfigs, nErrors, nExports, nImports, nModules, nPages, nWarnings, objectStamp, op, outputFile, outputFti, rootName, sourceName, sourceStream, sourceVersion, symbolName, table, textIndex, warnings],
BcdControlDefs:
TYPE
USING [
BindRoot, BuildSemanticEntries, LoadRoot, WriteBcd, PrintBcd, PrintRelocations, PrintSemanticEntries, PrintTree],
BcdDefs:
TYPE
USING [
BinderNTables, httype, MTNull, NullName, sstype, treetype, VersionStamp],
BcdErrorDefs: TYPE USING [Finalize, GetModule, GetSti, Initialize],
BcdFileDefs: TYPE USING [BuildFileTable, EraseFileTable],
BcdLiterals: TYPE USING [Initialize, Finalize, SealLiterals],
BcdParseData: TYPE,
BcdUtilDefs: TYPE USING [EnterFile, Init, Reset],
Commander: TYPE USING [Handle, Register],
CommandUtil: TYPE USING [Echo, Failed, GetNthPair, ListLength, PairList, Parse, SetExtension],
DebuggerSwap: TYPE USING [CallDebugger],
FileViewerOps: TYPE USING [WaitUntilSaved, ShowLog],
FS:
TYPE
USING [
Close, Create, Delete, Error, nullOpenFile, Open, OpenFile, StreamFromOpenFile, FileInfo],
HashOps: TYPE USING [Finalize, Initialize],
IO:
TYPE
USING [
char, Close, CR, CreateStream, CreateStreamProcs, int, Put, PutChar, PutRope, rope, SetLength, STREAM, StreamProcs, time, RIS],
Loader: TYPE USING [BCDBuildTime],
OSMiscOps: TYPE USING [MergeStamps, TimeToStamp],
P1: TYPE USING [InstallParseTable, Parse],
PrincOpsUtils: TYPE USING [Codebase],
ProcessExtras: TYPE USING [CheckForAbort],
Rope: TYPE USING [Equal, Fetch, Find, Flatten, Length, ROPE, Substr, Cat],
Symbols: TYPE USING [stNull],
Tree: TYPE USING [Link],
TreeOps: TYPE USING [PopTree, Finalize, Initialize],
UserProfile: TYPE USING [Token, Boolean];
BcdControl:
PROGRAM
IMPORTS
Alloc, Ascii, BasicTime, BcdControlDefs, BcdErrorDefs, BcdFileDefs, BcdLiterals, BcdParseData, BcdUtilDefs, Commander, CommandUtil, DebuggerSwap, FileViewerOps, FS, HashOps, IO, Loader, OSMiscOps, P1, PrincOpsUtils, ProcessExtras, Rope, TreeOps, UserProfile,
data: BcdComData = {
EquivalentRope:
PROC [s1, s2: Rope.
ROPE]
RETURNS [
BOOL] ~ {
RETURN [Rope.Equal[s1, s2, FALSE]]};
command gathering and logging
log: IO.STREAM ← NIL;
logFile: FS.OpenFile ← FS.nullOpenFile;
SetLogStream:
PROC ~ {
logFile ← FS.Create["Binder.Log"];
log ← FS.StreamFromOpenFile[logFile, $write];
log.SetLength[0];
};
LogRope: PROC [s: Rope.ROPE] ~ {IO.PutRope[log, s]};
LogChar: PROC [c: CHAR] ~ {IO.PutChar[log, c]};
LogNumber: PROC [n: INTEGER] ~ {IO.Put[log, IO.int[n]]};
renamedOutput: BOOL ← FALSE;
RepeatCommand:
PROC [s:
IO.
STREAM] ~ {
OPEN IO;
PutRope[s, "\nBinding "]; PutRope[s, data.sourceName];
IF renamedOutput THEN {PutRope[s, ", BCD to "]; PutRope[s, data.bcdName]};
IF data.copyCode
THEN {
PutRope[s, ", code to "];
PutRope[s, IF data.codeName = NIL THEN "BCD" ELSE data.codeName]};
IF data.copySymbols
THEN {
PutRope[s, ", symbols to "];
PutRope[s, IF data.symbolName = NIL THEN "BCD" ELSE data.symbolName]};
PutChar[s, '\n]};
error logging
errorName: Rope.ROPE ← NIL;
errorFile: FS.OpenFile ← FS.nullOpenFile;
errorStream: IO.STREAM ← NIL;
errorStreamProcs: REF IO.StreamProcs ← NIL;
SetErrorName:
PROC ~ {
IF errorName =
NIL
THEN {
errorName ← CommandUtil.SetExtension[data.rootName, "errlog"]}};
DummyErrorStream:
PROC [
putProc: SAFE PROC[self: IO.STREAM, char: CHAR]] RETURNS [IO.STREAM] ~ {
IF errorStreamProcs =
NIL
THEN
errorStreamProcs ←
IO.CreateStreamProcs[
variety: $output,
class: $DummyErrorStream,
putChar: putProc
];
RETURN[IO.CreateStream[errorStreamProcs, NIL]]};
OpenErrorStream:
PROC ~ {
IF errorName = NIL THEN SetErrorName[];
IF errorFile = FS.nullOpenFile THEN errorFile ← FS.Create[errorName];
errorStream ← FS.StreamFromOpenFile[errorFile, $write];
IO.SetLength[errorStream, 0];
WriteHerald[errorStream, errorName]; RepeatCommand[errorStream]};
CloseErrorStream: PROC ~ INLINE {IF data.errorStream # NIL THEN ErrorDestroy[]};
ErrorPut:
SAFE
PROC[self:
IO.
STREAM, char:
CHAR] ~
TRUSTED {
IF errorStream = NIL THEN OpenErrorStream[];
errorStream.PutChar[char]};
ErrorDestroy:
PROC ~ {
IF errorFile #
FS.nullOpenFile
AND errorStream #
NIL
THEN {
IO.Close[errorStream]; errorStream ← NIL}};
WriteHerald:
PROC [stream:
IO.
STREAM, id: Rope.
ROPE] ~ {
stream.Put[IO.rope["Cedar 5.0 Binder of "], IO.time[Loader.BCDBuildTime[]]];
IF fbh = NIL AND feedback.create # NIL
THEN fbh ← feedback.create[system~"Binder"L, herald~herald];
IF id.Length[] # 0 THEN stream.Put[IO.rope[id], IO.rope[" -- "]];
stream.Put[IO.time[], IO.char['\n]]};
Logger:
PROC [proc:
PROC [log:
IO.
STREAM]] = {
proc[data.errorStream]};
file bookkeeping
sourceFile, bcdFile: FS.OpenFile ← FS.nullOpenFile;
GetRoot:
PROC [s: Rope.
ROPE]
RETURNS[Rope.
ROPE] ~ {
dotIndex: INT ← Rope.Find[s, "."];
IF dotIndex > -1 THEN s ← Rope.Substr[s, 0, dotIndex];
switches
StandardDefaults:
PACKED
ARRAY
CHAR ['a..'z]
OF
BOOL ~ [
FALSE, -- A Copy all (code and symbols)
FALSE, -- B Unused
TRUE , -- C Copy code
FALSE, -- D Call debugger error
FALSE, -- E Unused
FALSE, -- F Unused
TRUE , -- G TRUE => errlog goes to binder.log, FALSE => use root.errlog
FALSE, -- H Unused
FALSE, -- I Unused
FALSE, -- J Unused
FALSE, -- K Unused
FALSE, -- L Unused
FALSE, -- M Unused
FALSE, -- N Unused
FALSE, -- O Unused
FALSE, -- P Pause after config with errors
FALSE, -- Q Unused
FALSE, -- R Unused
FALSE, -- S Copy symbols
FALSE, -- T Unused
FALSE, -- U Unused
FALSE, -- V Unused
FALSE, -- W Pause after config with warnings
FALSE, -- X Copy compressed symbols (not implemented)
FALSE, -- Y Unused
FALSE -- Z Unused
];
Bind:
SAFE PROC [cmd: Commander.Handle]
RETURNS [result: REF ← NIL, msg: Rope.ROPE ← NIL] ~ TRUSTED {
results: CommandUtil.PairList;
switches: Rope.ROPE;
key, value: Rope.ROPE;
anyErrors, anyWarnings: BOOL ← FALSE;
localPause: BOOL;
cmdStream: IO.STREAM;
defaultSwitches: PACKED ARRAY CHAR ['a..'z] OF BOOL ← StandardDefaults;
defaultDebugPass: CARDINAL ← CARDINAL.LAST;
localSwitches: PACKED ARRAY CHAR ['a..'z] OF BOOL;
debugPass: CARDINAL;
cmd.commandLine ← Rope.Cat[UserProfile.Token["Binder.Switches"], " ", cmd.commandLine];
cmdStream ← IO.RIS[cmd.commandLine];
data.sourceName ← data.bcdName ← data.codeName ← data.symbolName ← NIL;
SetLogStream[];
WriteHerald[log, NIL];
data.op ← $bind;
data.table ← NIL;
main loop
DO {
Initialize:
PROC ~ {
weights:
ARRAY [0..BcdDefs.BinderNTables)
OF Alloc.TableInfo ← [
-- empirical (SDD)
[4], [2], [10], [4], [5], [4], [4], [4], [2], [1],
[4], [4], [4], [2], [4], [2], [4], [5], [1], [1]];
RepeatCommand[log];
data.errors ← data.warnings ← FALSE;
data.nErrors ← data.nWarnings ← 0;
data.textIndex ← 0;
data.currentName ← BcdDefs.NullName;
IF data.table =
NIL
THEN {
data.table ← Alloc.Create[weights~DESCRIPTOR[weights]];
(data.table).Chunkify[BcdDefs.treetype]}
ELSE (data.table).Reset[];
HashOps.Initialize[data.table, BcdDefs.httype, BcdDefs.sstype];
TreeOps.Initialize[data.table];
BcdUtilDefs.Init[data.table];
BcdLiterals.Initialize[data.table];
BcdErrorDefs.Initialize[];
errorStream ← NIL};
Finalize:
PROC ~ {
TreeOps.Finalize[]; HashOps.Finalize[];
BcdErrorDefs.Finalize[];
BcdLiterals.Finalize[]; BcdUtilDefs.Reset[];
(data.table).Reset[];
anyErrors ← data.errors OR anyErrors; anyWarnings ← data.warnings OR anyWarnings;
IF data.aborted THEN LogRope["Binding aborted\n"]
ELSE IF data.errors THEN LogRope["Errors detected; BCD not written\n"]
ELSE {
IF data.nConfigs > 1
THEN {
LogNumber[data.nConfigs]; LogRope[" configs, "]};
LogNumber[data.nModules]; LogRope[" modules, "];
LogNumber[data.nImports]; LogRope[" imports, "];
LogNumber[data.nExports]; LogRope[" exports, "];
LogNumber[data.nPages]; LogRope[" pages, "];
LogNumber[BasicTime.Period[from: startTime, to: BasicTime.Now[]]]; LogRope[" seconds\n"]};
IF errorStream #
NIL
THEN {
LogRope["See "]; LogRope[data.rootName]; LogRope[".errlog\n"]};
IF log # data.errorStream THEN CloseErrorStream[];
IF errorName =
NIL
THEN {
SetErrorName[];
OSMiscOps.DeleteFile[errorName];
};
IO.Close[data.sourceStream];
sourceFile ← FSClose[sourceFile];
bcdFile ← FSClose[bcdFile];
IF data.nErrors # 0
OR data.aborted
THEN
FS.Delete[data.bcdName ! FS.Error => TRUSTED {CONTINUE}];
data.outputFile ← FS.nullOpenFile;
IF feedback.finishItem # NIL THEN ...
IF data.errors
THEN cmd.out.Put[IO.rope["no errors"]]
ELSE cmd.out.Put[IO.int[data.nErrors], IO.rope[" errors"]];
IF data.nWarnings # 0
THEN cmd.out.Put[IO.rope[", "], IO.int[data.nWarnings], IO.rope[" warnings"]];
cmd.out.Put[IO.char['\n]];
Debug:
PROC [printRel, printBcd:
BOOL] ~ {
BcdControlDefs.PrintTree[root];
BcdControlDefs.PrintSemanticEntries[];
IF printRel THEN BcdControlDefs.PrintRelocations[relocationHead];
IF printBcd THEN BcdControlDefs.PrintBcd[]};
parsed: BOOL;
root: Tree.Link;
first: BOOL ← TRUE;
relocationHead: BcdBindDefs.RelocHandle;
startTime: BasicTime.GMT;
localSwitches ← defaultSwitches;
localPause ← FALSE; debugPass ← defaultDebugPass;
renamedOutput ← FALSE;
data.aborted ← FALSE;
[data.sourceName, data.commandArgs, results, switches] ←
CommandUtil.Parse[s: cmdStream
! CommandUtil.Failed => {GOTO badSyntax}];
IF data.sourceName = NIL AND switches = NIL THEN EXIT; -- done binding
LogRope["\nCommand: "];
CommandUtil.Echo[
d~log, operator~data.sourceName, argList~data.commandArgs,
resultList~results, switches~switches];
IF data.sourceName = NIL THEN GOTO globalSwitches;
FOR n:
CARDINAL
IN [0..CommandUtil.ListLength[results])
DO
[key, value] ← CommandUtil.GetNthPair[list~results, n~n];
SELECT
TRUE
FROM
(key =
NIL), EquivalentRope[key, "bcd"] => {
data.bcdName ← value; renamedOutput ← TRUE};
EquivalentRope[key, "code"] => {
data.codeName ← value; localSwitches['c] ← TRUE};
EquivalentRope[key, "symbols"] => {
data.symbolName ← value; localSwitches['s] ← TRUE};
ENDCASE => GO TO badSemantics;
ENDLOOP;
data.rootName ← GetRoot[
(IF data.bcdName # NIL THEN data.bcdName ELSE data.sourceName)];
IF switches #
NIL
THEN {
sense: BOOL ← TRUE;
length: INT ← switches.Length[];
FOR i:
INT
IN [0..length)
DO
c: CHAR ~ switches.Fetch[i];
SELECT c
FROM
'-, '~ => sense ← ~sense;
IN ['a..'z] => {localSwitches[c] ← sense; sense ← TRUE};
IN ['A..'Z] => {localSwitches[Ascii.Lower[c]] ← sense; sense ← TRUE};
'! => {DebuggerSwap.CallDebugger[NIL]; sense ← TRUE};
IN ['1..'4] => {debugPass ← c-'0; sense ← TRUE};
ENDCASE;
ENDLOOP;
};
data.sourceName ← CommandUtil.SetExtension[data.sourceName, "config"];
FileViewerOps.WaitUntilSaved[data.sourceName, cmd.out
! ABORTED => {data.aborted ← TRUE; EXIT}];
IF data.bcdName = NIL THEN data.bcdName ← data.rootName;
data.bcdName ← CommandUtil.SetExtension[data.bcdName, "bcd"];
data.copyCode ← (localSwitches['c] OR localSwitches['a]);
data.copySymbols ← (localSwitches['s] OR localSwitches['x] OR localSwitches['a]);
IF localSwitches['x]
THEN
LogRope["\nSymbol compression not available in this version"];
IF data.copyCode
AND data.codeName #
NIL
THEN {
data.codeName ← CommandUtil.SetExtension[data.codeName, "code"];
IF EquivalentRope[data.codeName, data.bcdName] THEN data.codeName ← NIL;
};
IF data.copySymbols
AND ~(localSwitches['a]
AND data.symbolName =
NIL)
THEN {
data.symbolName ← CommandUtil.SetExtension[data.symbolName, "symbols"];
IF EquivalentRope[data.symbolName, data.bcdName] THEN data.symbolName ← NIL;
};
cmd.out.Put[IO.rope["Binding: "], IO.rope[data.rootName]];
FOR c:
CHAR
IN ['a..'z]
DO
IF localSwitches[c] # StandardDefaults[c]
THEN {
IF first THEN {first ← FALSE; cmd.out.PutChar['/]};
IF StandardDefaults[c] THEN cmd.out.PutChar['-];
cmd.out.PutChar[c]};
ENDLOOP;
startTime ← BasicTime.Now[];
sourceFile ← FS.nullOpenFile;
errorFile ← data.outputFile ← FS.nullOpenFile;
data.sourceStream ← NIL;
sourceFile ← FS.Open[data.sourceName ! FS.Error => TRUSTED {CONTINUE}];
IF sourceFile #
NIL
THEN {
data.sourceStream ← FS.StreamFromOpenFile[sourceFile];
data.sourceVersion ← BcdDefs.VersionStamp[
net~0, host~0, time~BasicTime.ToNSTime[FS.FileInfo[data.sourceName].created]];
};
IF data.sourceStream = NIL THEN GOTO noSource;
data.outputFile ← bcdFile ← FS.Create[data.bcdName ! FS.Error => TRUSTED {CONTINUE}];
data.logStream ← log;
data.errorStream ←
IF localSwitches['g] THEN log ELSE DummyErrorStream[putProc~ErrorPut];
localPause ← localSwitches['p];
data.debug ← localSwitches['d];
localSwitches['g] ← localSwitches['p] ← localSwitches['d] ← FALSE;
data.objectStamp ← OSMiscOps.TimeToStamp[data.sourceVersion];
encode switches, binder version (see BcdLoad processing also)
data.objectStamp ← OSMiscOps.MergeStamps[
data.objectStamp, OSMiscOps.TimeToStamp[[0, 0, LOOPHOLE[localSwitches]]]];
data.objectStamp ← OSMiscOps.MergeStamps[
data.objectStamp, OSMiscOps.TimeToStamp[data.binderVersion]];
BEGIN
ENABLE {
BcdErrorDefs.GetModule => RESUME [BcdDefs.MTNull, 0];
BcdErrorDefs.GetSti => RESUME [Symbols.stNull];
Alloc.Failure => {
data.errors ← TRUE;
IF ~data.debug
THEN {
LogRope["Storage Overflow\n"]; GOTO Overflow}};
UNWIND => Finalize[];
};
ProcessExtras.CheckForAbort[! ABORTED => GOTO Abort];
cmd.out.PutRope[". " ! ABORTED => GOTO Abort]; -- pass 1
[complete~parsed, nErrors~data.nErrors] ← P1.Parse[data.sourceStream, Logger];
IF ~parsed THEN GO TO Failed;
IF data.nErrors > 0 THEN data.errors ← TRUE;
root ← TreeOps.PopTree[];
BcdControlDefs.BuildSemanticEntries[root];
data.outputFti ← BcdUtilDefs.EnterFile[LOOPHOLE[Rope.Flatten[data.bcdName]]];
BcdFileDefs.BuildFileTable[data.table];
IF debugPass <= 1 THEN Debug[printRel~FALSE, printBcd~FALSE];
ProcessExtras.CheckForAbort[! ABORTED => GOTO AbortAndEraseFileTable];
cmd.out.PutRope[". " ! ABORTED => GOTO AbortAndEraseFileTable]; -- pass 2
relocationHead ← BcdControlDefs.LoadRoot[root];
BcdLiterals.SealLiterals[];
IF debugPass <= 2 THEN Debug[printRel~TRUE, printBcd~TRUE];
ProcessExtras.CheckForAbort[! ABORTED => GOTO AbortAndEraseFileTable];
cmd.out.PutRope[". " ! ABORTED => GOTO AbortAndEraseFileTable]; -- pass 3
BcdControlDefs.BindRoot[relocationHead];
IF debugPass <= 3 THEN Debug[printRel~FALSE, printBcd~TRUE];
IF ~data.errors
THEN {
ProcessExtras.CheckForAbort[! ABORTED => GOTO AbortAndEraseFileTable];
cmd.out.PutRope[". " ! ABORTED => GOTO AbortAndEraseFileTable]; -- pass 4
BcdControlDefs.WriteBcd[root]};
BcdFileDefs.EraseFileTable[];
EXITS
Overflow => NULL;
Failed => data.errors ← TRUE;
Abort => data.aborted ← TRUE;
AbortAndEraseFileTable => {BcdFileDefs.EraseFileTable[]; data.aborted ← TRUE};
END;
Finalize[];
EXITS
noSource => {
LogRope["\nCan't open "]; LogRope[data.sourceName]; LogChar['\n];
data.errors ← TRUE};
globalSwitches => {
sense: BOOL ← TRUE;
length: INT ← switches.Length[];
FOR i:
INT
IN [0..length)
DO
c: CHAR ~ switches.Fetch[i];
SELECT c
FROM
'-, '~ => sense ← ~sense;
'! => DebuggerSwap.CallDebugger[NIL];
IN ['a..'z] => {defaultSwitches[c] ← sense; sense ← TRUE};
IN ['A..'Z] => {defaultSwitches[Ascii.Lower[c]] ← sense; sense ← TRUE};
IN ['1..'5] => {defaultDebugPass ← c-'0; sense ← TRUE};
ENDCASE => EXIT;
ENDLOOP};
badSemantics => {
data.errors ← TRUE;
LogRope["\n -- Illegal command"]};
};
data.sourceName ← data.bcdName ← data.codeName ← data.symbolName ← NIL;
errorName ← NIL;
IF data.aborted THEN EXIT; -- stop binding
IF (data.errors OR (data.warnings AND localSwitches['w])) AND localPause THEN EXIT;
REPEAT
badSyntax => {anyErrors ← data.errors ← TRUE; LogRope["-- Illegal syntax"]};
ENDLOOP;
IF data.table # NIL THEN {Alloc.Destroy[data.table]; data.table ← NIL};
IO.Close[log];
logFile ← FS.nullOpenFile;
cmd.out.PutRope["End of binding\n"];
IF data.aborted
OR anyErrors
OR anyWarnings
THEN result ← $Failure
ELSE result ← $Success;
FileViewerOps.ShowLog[fileName: "Binder.log", destroyIt: result # $Failure, createIconic: UserProfile.Boolean["Compiler.IconicLogs", FALSE], blinkIfIconic: UserProfile.Boolean["Compiler.IconicLogs", FALSE]];
};