
<<BcdControl.mesa>>
<<Last edited by Satterthwaite on May 10, 1983 10:24 am    >>
<<Last Edited by: Maxwell, August 29, 1983 2:52 pm>>

DIRECTORY
Alloc: TYPE USING [Create, Chunkify, Destroy, Failure, Reset, TableInfo],
Ascii: TYPE USING [Lower],
BasicTime: TYPE USING [GMT, Now, Period],
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, zone],
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],
FileIO: TYPE USING [StreamFromOpenFile],
FS: TYPE USING [Close, Delete, EnumerateForInfo, Error, InfoProc, nullOpenFile, Open, OpenFile],
HashOps: TYPE USING [Finalize, Initialize],
IO: TYPE USING [char, Close, CR, CreateProcsStream, CreateRefStreamProcs, int, Put, PutChar, PutRope, rope, SetLength, STREAM, 
StreamProcs, time, UserAbort],
OSMiscOps: TYPE USING [
BcdCreateTime, DeleteFile, FindFile, --ImageId,-- MergeStamps, TimeToStamp],
P1: TYPE USING [InstallParseTable, Parse],
PrincOpsUtils: TYPE USING [CodeBase],
Rope: TYPE USING [Equal, Fetch, Find, Flatten, Length, ROPE, Substr], 
Symbols: TYPE USING [stNull],
Tree: TYPE USING [Link],
TreeOps: TYPE USING [PopTree, Finalize, Initialize],
UnsafeStorage: TYPE USING [FreeUZone, NewUZone];

BcdControl: PROGRAM
IMPORTS
Alloc, Ascii, BasicTime, BcdControlDefs, BcdErrorDefs, BcdFileDefs, BcdLiterals, BcdParseData, BcdUtilDefs, Commander, CommandUtil, 
DebuggerSwap, FileIO, FS, HashOps, IO, OSMiscOps, P1, PrincOpsUtils, Rope, TreeOps, UnsafeStorage,
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 ~ {
IF logFile = FS.nullOpenFile THEN 
logFile _ OSMiscOps.FindFile["Binder.Log", $write];
log _ FileIO.StreamFromOpenFile[logFile]; IO.SetLength[log, 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.CreateRefStreamProcs[putChar~putProc];
RETURN [IO.CreateProcsStream[errorStreamProcs, NIL]]};

OpenErrorStream: PROC ~ {
IF errorName = NIL THEN SetErrorName[];
IF errorFile = FS.nullOpenFile THEN
errorFile _ OSMiscOps.FindFile[errorName, $write];
errorStream _ FileIO.StreamFromOpenFile[errorFile];
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 3.x Binder of "], IO.time[OSMiscOps.BcdCreateTime[]]];
<<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];
RETURN[s]};

<<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
];


<<Exec interfaces>>

Bind: SAFE PROC [cmd: Commander.Handle] ~ TRUSTED { 
results: CommandUtil.PairList;
switches: Rope.ROPE;
key, value: Rope.ROPE;
anyErrors, anyWarnings: BOOL _ FALSE;
localPause: BOOL;

defaultSwitches: PACKED ARRAY CHAR ['a..'z] OF BOOL _ StandardDefaults;
defaultDebugPass: CARDINAL _ CARDINAL.LAST;
localSwitches: PACKED ARRAY CHAR ['a..'z] OF BOOL;
debugPass: CARDINAL;

IF cmd = NIL THEN ERROR;
<<WHILE theCommand.data[theCommand.len] # '\n DO>>
<<theCommand.len _ theCommand.len + 1;>>
<<ENDLOOP;>>
<<>>
SetLogStream[];
WriteHerald[log, NIL];

data.op _ $bind;
data.zone _ UnsafeStorage.NewUZone[];
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, data.zone];
BcdUtilDefs.Init[data.table];
BcdLiterals.Initialize[data.table, data.zone];
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[BasicTime.Now[], startTime]]; 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];
IF sourceFile # FS.nullOpenFile 
THEN {FS.Close[sourceFile]; sourceFile _ FS.nullOpenFile};
IF bcdFile # FS.nullOpenFile 
THEN {FS.Close[bcdFile]; bcdFile _ FS.nullOpenFile};
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 {>>
<<outcome: ExecOps.Outcome ~>>
<<SELECT TRUE FROM>>
<<data.aborted => $aborted,>>
<<data.errors AND data.warnings => $errorsAndWarnings,>>
<<data.errors => $errors,>>
<<data.warnings => $warnings,>>
<<ENDCASE => $ok;>>
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[command: cmd.commandLine 
! CommandUtil.Failed => {GO TO 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 GO TO 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"];
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;
cmd.out.PutChar[IO.CR]; 

startTime _ BasicTime.Now[];

BEGIN
ENABLE ANY => {CONTINUE};
createTime: BasicTime.GMT;
GetCreateTime: FS.InfoProc = TRUSTED {createTime _ created; RETURN[continue: TRUE]};
sourceFile _ FS.nullOpenFile;
errorFile _ data.outputFile _ FS.nullOpenFile;
data.sourceStream _ NIL;
sourceFile _ FS.Open[data.sourceName, ! FS.Error => TRUSTED {CONTINUE}];
FS.EnumerateForInfo[data.sourceName, GetCreateTime];
IF sourceFile # NIL THEN {
data.sourceStream _ FileIO.StreamFromOpenFile[sourceFile];
data.sourceVersion _ BcdDefs.VersionStamp[
net~0, host~0, time~LOOPHOLE[createTime]]};
IF data.sourceStream = NIL THEN GO TO noSource;
data.outputFile _ bcdFile _ FS.Open[data.bcdName];
END;

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]];

Initialize[];
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[]}};

cmd.out.PutRope[". "]; -- pass 1
IF cmd.in.UserAbort[] THEN GOTO Abort;
[complete~parsed, nErrors~data.nErrors] _ P1.Parse[data.sourceStream, data.zone, 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, data.zone];
IF debugPass <= 1 THEN Debug[printRel~FALSE, printBcd~FALSE];

cmd.out.PutRope[". "]; -- pass 2
IF cmd.in.UserAbort[] THEN GOTO AbortAndEraseFileTable;
relocationHead _ BcdControlDefs.LoadRoot[root];
BcdLiterals.SealLiterals[];
IF debugPass <= 2 THEN Debug[printRel~TRUE, printBcd~TRUE];

cmd.out.PutRope[". "]; -- pass 3
IF cmd.in.UserAbort[] THEN GOTO AbortAndEraseFileTable;
BcdControlDefs.BindRoot[relocationHead];
IF debugPass <= 3 THEN Debug[printRel~FALSE, printBcd~TRUE];

IF ~data.errors THEN { 
cmd.out.PutRope[". "]; -- pass 4
IF cmd.in.UserAbort[] THEN GOTO AbortAndEraseFileTable;
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"]}};
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;
UnsafeStorage.FreeUZone[data.zone]; data.zone _ NIL;
IO.Close[log];  logFile _ FS.nullOpenFile;
cmd.out.PutRope["End of binding\n"]};
<<RETURN [SELECT TRUE FROM>>
<<data.aborted => $aborted,>>
<<(anyErrors AND anyWarnings) => $errorsAndWarnings,>>
<<anyErrors => $errors,>>
<<anyWarnings => $warnings,>>
<<ENDCASE => $ok]};>>
<<>>
<<>>
<<global Binder initialization>>

Init: PROC ~ { 
START data;
<<data.binderVersion _ OSMiscOps.ImageId[];>>
data.binderVersion _ [net~0Ch, host~0Bh, time~000F0003h]; -- Cedar release
P1.InstallParseTable[PrincOpsUtils.CodeBase[LOOPHOLE[BcdParseData]]];
Commander.Register["Binder", Bind, "Bind a list of configurations."]};

Init[];

}.