-- BcdControl.mesa
-- Last edited by Satterthwaite on January 10, 1983 2:53 pm
-- Last edited by Lewis on 30-Mar-81 11:36:12
DIRECTORY
Alloc: TYPE USING [Create, Chunkify, Destroy, Failure, Reset, TableInfo],
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],
CharIO: TYPE USING [PutChar, PutDecimal, PutLine, PutString],
CommandUtil: TYPE USING [
CommandObject, CopyString, Echo, Failed, FreePairList, FreeString,
GetNthPair, ListLength, PairList, Parse, SetExtension],
ExecOps: TYPE USING [CheckForAbort, Command, Outcome],
Feedback: TYPE USING [Handle, Outcome, Procs, ProcsHandle],
File: TYPE USING [Capability, nullCapability],
FileStream: TYPE USING [Create, GetLeaderProperties, SetLength],
HashOps: TYPE USING [Finalize, Initialize],
Heap: TYPE USING [Create, Delete],
LongString: TYPE USING [AppendDecimal],
OSMiscOps: TYPE USING [
BcdCreateTime, DeleteFile, FileError, FindFile, --ImageId,-- MergeStamps,
TimeToStamp],
P1: TYPE USING [InstallParseTable, Parse],
Runtime: TYPE USING [CallDebugger, GetTableBase],
Stream: TYPE USING [Handle, Object, PutByteProcedure, Delete, PutByte],
Strings: TYPE USING [
AppendChar, AppendString, EquivalentSubString, String, SubStringDescriptor],
Symbols: TYPE USING [stNull],
SymbolTable: TYPE USING [anySpan, Forget, Locked],
TemporarySpecialExecOps: TYPE USING [],
Time: TYPE USING [Append, AppendCurrent, Current, Unpack],
Tree: TYPE USING [Link],
TreeOps: TYPE USING [PopTree, Finalize, Initialize];
BcdControl: PROGRAM
IMPORTS
Alloc, BcdControlDefs, BcdErrorDefs, BcdFileDefs, BcdLiterals,
BcdParseData, BcdUtilDefs, CharIO, CommandUtil, ExecOps,
FileStream, HashOps, Heap, OSMiscOps, P1, Runtime, Stream,
String: LongString, Strings, SymbolTable, Time, TreeOps,
data: BcdComData
EXPORTS ExecOps, TemporarySpecialExecOps = {
EquivalentString: PROC [s1, s2: Strings.String] RETURNS [BOOL] ~ {
ss1: Strings.SubStringDescriptor ← [base~s1, offset~0, length~s1.length];
ss2: Strings.SubStringDescriptor ← [base~s2, offset~0, length~s2.length];
RETURN [Strings.EquivalentSubString[@ss1, @ss2]]};
-- feedback control
feedback: Feedback.ProcsHandle;
fbh: Feedback.Handle ← NIL;
-- command gathering and logging
log: Stream.Handle ← NIL;
logFile: File.Capability ← File.nullCapability;
SetLogStream: PROC ~ {
IF logFile = File.nullCapability THEN
logFile ← OSMiscOps.FindFile["Binder.Log"L, $write];
log ← FileStream.Create[logFile]; FileStream.SetLength[log, 0]};
LogString: PROC [s: Strings.String] ~ {CharIO.PutString[log, s]};
LogChar: PROC [c: CHAR] ~ {CharIO.PutChar[log, c]};
LogNumber: PROC [n: INTEGER] ~ {CharIO.PutDecimal[log, n]};
renamedOutput: BOOL ← FALSE;
RepeatCommand: PROC [s: Stream.Handle] ~ {
OPEN CharIO;
PutString[s, "\nBinding "L]; PutString[s, data.sourceName];
IF renamedOutput THEN {PutString[s, ", BCD to "L]; PutString[s, data.bcdName]};
IF data.copyCode THEN {
PutString[s, ", code to "L];
PutString[s, IF data.codeName = NIL THEN "BCD"L ELSE data.codeName]};
IF data.copySymbols THEN {
PutString[s, ", symbols to "L];
PutString[s, IF data.symbolName = NIL THEN "BCD"L ELSE data.symbolName]};
PutChar[s, '\n]};
-- error logging
errorName: Strings.String ← NIL;
errorFile: File.Capability ← File.nullCapability;
errorStream: Stream.Handle ← NIL;
errorStreamObject: Stream.Object;
SetErrorName: PROC ~ {
IF errorName = NIL THEN {
errorName ← CommandUtil.CopyString[data.rootName, 1+("errlog"L).length];
errorName ← CommandUtil.SetExtension[errorName, "errlog"L]}};
DummyErrorStream: PROC [
putProc: Stream.PutByteProcedure] RETURNS [Stream.Handle] ~ {
errorStreamObject ← [
options~TRASH,
getByte~TRASH, putByte~putProc,
getWord~TRASH, putWord~TRASH,
get~TRASH, put~TRASH,
setSST~TRASH, sendAttention~TRASH, waitAttention~TRASH,
delete~TRASH];
RETURN [@errorStreamObject]};
OpenErrorStream: PROC ~ {
IF errorName = NIL THEN SetErrorName[];
IF errorFile = File.nullCapability THEN
errorFile ← OSMiscOps.FindFile[errorName, $write];
errorStream ← FileStream.Create[errorFile];
FileStream.SetLength[errorStream, 0];
WriteHerald[errorStream, errorName]; RepeatCommand[errorStream]};
CloseErrorStream: PROC ~ INLINE {IF data.errorStream # NIL THEN ErrorDestroy[]};
ErrorPut: Stream.PutByteProcedure ~ {
IF errorStream = NIL THEN OpenErrorStream[];
errorStream.PutByte[byte]};
ErrorDestroy: PROC ~ {
IF errorFile # File.nullCapability AND errorStream # NIL THEN {
Stream.Delete[errorStream]; errorStream ← NIL}};
WriteHerald: PROC [s: Stream.Handle, id: Strings.String] ~ {
OPEN Time, CharIO;
herald: STRING ← [80];
Strings.AppendString[herald, "Cedar 3.4 Binder of "L];
Time.Append[herald, Time.Unpack[[OSMiscOps.BcdCreateTime[]]]];
herald.length ← herald.length-3;
Strings.AppendString[herald, " (Pilot Version)"L];
PutLine[s, herald];
IF fbh = NIL AND feedback.create # NIL
THEN fbh ← feedback.create[system~"Binder"L, herald~herald];
IF id # NIL THEN {PutString[s, id]; PutString[s, " -- "L]};
herald.length ← 0; Time.AppendCurrent[herald]; PutLine[s, herald]};
Logger: PROC [proc: PROC [log: Stream.Handle]] = {
proc[data.errorStream]};
-- file bookkeeping
sourceFile: File.Capability;
SetRoot: PROC [root, s: Strings.String] ~ {
root.length ← 0;
FOR i: CARDINAL IN [0..s.length) DO
IF s[i] = '. THEN EXIT;
Strings.AppendChar[root, s[i]];
ENDLOOP};
SetFileName: PROC [
fileName, extension: Strings.String] RETURNS [Strings.String] ~ {
root: Strings.String ~
(IF fileName = NIL THEN
CommandUtil.CopyString[data.rootName, 1+extension.length]
ELSE fileName);
RETURN [CommandUtil.SetExtension[root, extension]]};
-- 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: PUBLIC PROC [cmd: ExecOps.Command] RETURNS [outcome: ExecOps.Outcome] ~ {
fProcs: Feedback.Procs ← []; -- all NIL
RETURN [BindUsingFeedback[cmd, @fProcs]]};
BindUsingFeedback: PUBLIC PROC [cmd: ExecOps.Command, feedbackProcs: Feedback.ProcsHandle]
RETURNS [outcome: ExecOps.Outcome] ~ {
theCommand: CommandUtil.CommandObject ← [pos~0, len~0, data~cmd];
results: CommandUtil.PairList;
switches: Strings.String;
key, value: Strings.String;
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;
fbh ← NIL; feedback ← feedbackProcs;
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 ← Heap.Create[initial~16, increment~8];
data.table ← NIL;
data.rootName ← (data.zone).NEW[StringBody[100]];
-- 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 LogString["Binding aborted\n"L]
ELSE IF data.errors THEN LogString["Errors detected; BCD not written\n"L]
ELSE {
IF data.nConfigs > 1 THEN {
LogNumber[data.nConfigs]; LogString[" configs, "L]};
LogNumber[data.nModules]; LogString[" modules, "L];
LogNumber[data.nImports]; LogString[" imports, "L];
LogNumber[data.nExports]; LogString[" exports, "L];
LogNumber[data.nPages]; LogString[" pages, "L];
LogNumber[Time.Current[] - startTime]; LogString[" seconds\n"L]};
IF errorStream # NIL THEN {
LogString["See "L]; LogString[data.rootName]; LogString[".errlog\n"L]};
IF log # data.errorStream THEN CloseErrorStream[];
IF errorName = NIL THEN {SetErrorName[]; OSMiscOps.DeleteFile[errorName]};
Stream.Delete[data.sourceStream];
IF data.nErrors # 0 OR data.aborted THEN OSMiscOps.DeleteFile[data.bcdName];
data.outputFile ← File.nullCapability;
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;
msg: STRING ← [30];
IF ~data.errors
THEN Strings.AppendString[msg, "no"L]
ELSE String.AppendDecimal[msg, data.nErrors];
Strings.AppendString[msg, " errors"L];
IF data.nWarnings # 0
THEN {
Strings.AppendString[msg, ", "L];
String.AppendDecimal[msg, data.nWarnings];
Strings.AppendString[msg, " warnings"L]};
feedback.finishItem[fbh, outcome, msg]}};
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;
relocationHead: BcdBindDefs.RelocHandle;
startTime: LONG CARDINAL;
localSwitches ← defaultSwitches;
localPause ← FALSE; debugPass ← defaultDebugPass;
renamedOutput ← FALSE;
data.aborted ← FALSE;
[data.sourceName, data.commandArgs, results, switches] ←
CommandUtil.Parse[
s~@theCommand,
opX~2+("config"L).length, resultX~2+("symbols"L).length
! CommandUtil.Failed => {GO TO badSyntax}];
IF data.sourceName = NIL AND switches = NIL THEN EXIT; -- done binding
LogString["\nCommand: "L];
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), EquivalentString[key, "bcd"L] => {
data.bcdName ← value; renamedOutput ← TRUE};
EquivalentString[key, "code"L] => {
data.codeName ← value; localSwitches['c] ← TRUE};
EquivalentString[key, "symbols"L] => {
data.symbolName ← value; localSwitches['s] ← TRUE};
ENDCASE => GO TO badSemantics;
ENDLOOP;
SetRoot[
data.rootName,
(IF data.bcdName # NIL THEN data.bcdName ELSE data.sourceName)];
IF switches # NIL THEN {
i: CARDINAL ← 0;
sense: BOOL ← TRUE;
WHILE i < switches.length DO
c: CHAR ~ switches[i];
SELECT c FROM
'-, '~ => sense ← ~sense;
IN ['a..'z] => {localSwitches[c] ← sense; sense ← TRUE};
IN ['A..'Z] => {localSwitches[c + ('a-'A)] ← sense; sense ← TRUE};
'! => {Runtime.CallDebugger[NIL]; sense ← TRUE};
IN ['1..'4] => {debugPass ← c-'0; sense ← TRUE};
ENDCASE;
i ← i+1;
ENDLOOP;
switches ← CommandUtil.FreeString[switches]};
data.sourceName ← SetFileName[data.sourceName, "config"L];
data.bcdName ← SetFileName[data.bcdName, "bcd"L];
data.copyCode ← (localSwitches['c] OR localSwitches['a]);
data.copySymbols ← (localSwitches['s] OR localSwitches['x] OR localSwitches['a]);
IF localSwitches['x] THEN
LogString["\nSymbol compression not available in this version"L];
IF data.copyCode AND data.codeName # NIL THEN {
data.codeName ← SetFileName[data.codeName, "code"L];
IF EquivalentString[data.codeName, data.bcdName] THEN
data.codeName ← CommandUtil.FreeString[data.codeName]};
IF data.copySymbols AND ~(localSwitches['a] AND data.symbolName = NIL) THEN {
data.symbolName ← SetFileName[data.symbolName, "symbols"L];
IF EquivalentString[data.symbolName, data.bcdName] THEN
data.symbolName ← CommandUtil.FreeString[data.symbolName]};
IF feedback.beginItem # NIL THEN {
item: STRING ← [100];
first: BOOL ← TRUE;
Strings.AppendString[item, "Binding: "L]; Strings.AppendString[item, data.rootName];
FOR c: CHAR IN ['a..'z] DO
IF localSwitches[c] # StandardDefaults[c] THEN {
IF first THEN {first ← FALSE; Strings.AppendChar[item, '/]};
IF StandardDefaults[c] THEN Strings.AppendChar[item, '-];
Strings.AppendChar[item, c]};
ENDLOOP;
feedback.beginItem[fbh, item]};
startTime ← Time.Current[];
BEGIN
ENABLE ANY => {CONTINUE};
sourceFile ← errorFile ← data.outputFile ← File.nullCapability;
data.sourceStream ← NIL;
sourceFile ← OSMiscOps.FindFile[data.sourceName, $read
! OSMiscOps.FileError => {CONTINUE}];
IF sourceFile # File.nullCapability THEN {
data.sourceStream ← FileStream.Create[sourceFile];
data.sourceVersion ← BcdDefs.VersionStamp[
net~0, host~0,
time~FileStream.GetLeaderProperties[data.sourceStream].create]};
IF data.sourceStream = NIL THEN GO TO noSource;
data.outputFile ← OSMiscOps.FindFile[data.bcdName, $write];
SymbolTable.Forget[[data.outputFile, SymbolTable.anySpan]
! SymbolTable.Locked => {CONTINUE}]; -- for now
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 {
LogString["Storage Overflow\n"L]; GOTO Overflow}};
UNWIND => {Finalize[]}};
IF ExecOps.CheckForAbort[] THEN GO TO AbortBinding;
IF feedback.noteProgress # NIL THEN feedback.noteProgress[fbh, 1];
[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];
IF ExecOps.CheckForAbort[] THEN GO TO AbortBinding;
data.outputFti ← BcdUtilDefs.EnterFile[data.bcdName];
BcdFileDefs.BuildFileTable[data.table, data.zone];
IF debugPass <= 1 THEN Debug[printRel~FALSE, printBcd~FALSE];
IF ExecOps.CheckForAbort[] THEN GO TO AbortBindingAndEraseFileTable;
IF feedback.noteProgress # NIL THEN feedback.noteProgress[fbh, 2];
relocationHead ← BcdControlDefs.LoadRoot[root];
BcdLiterals.SealLiterals[];
IF debugPass <= 2 THEN Debug[printRel~TRUE, printBcd~TRUE];
IF ExecOps.CheckForAbort[] THEN GO TO AbortBindingAndEraseFileTable;
IF feedback.noteProgress # NIL THEN feedback.noteProgress[fbh, 3];
BcdControlDefs.BindRoot[relocationHead];
IF debugPass <= 3 THEN Debug[printRel~FALSE, printBcd~TRUE];
IF ExecOps.CheckForAbort[] THEN GO TO AbortBindingAndEraseFileTable;
IF ~data.errors THEN {
IF feedback.noteProgress # NIL THEN feedback.noteProgress[fbh, 4];
BcdControlDefs.WriteBcd[root];
IF ExecOps.CheckForAbort[] THEN GO TO AbortBindingAndEraseFileTable};
BcdFileDefs.EraseFileTable[];
EXITS
Overflow => NULL;
Failed => data.errors ← TRUE;
AbortBinding => {data.aborted ← TRUE};
AbortBindingAndEraseFileTable => {
BcdFileDefs.EraseFileTable[];
data.aborted ← TRUE};
END;
Finalize[];
EXITS
noSource => {
LogString["\nCan't open "L]; LogString[data.sourceName]; LogChar['\n];
data.errors ← TRUE};
globalSwitches => {
sense: BOOL ← TRUE;
results ← CommandUtil.FreePairList[results];
FOR i: CARDINAL IN [0..switches.length) DO
c: CHAR ~ switches[i];
SELECT c FROM
'-, '~ => sense ← ~sense;
'! => Runtime.CallDebugger[NIL];
IN ['a..'z] => {defaultSwitches[c] ← sense; sense ← TRUE};
IN ['A..'Z] => {defaultSwitches[c + ('a-'A)] ← sense; sense ← TRUE};
IN ['1..'5] => {defaultDebugPass ← c-'0; sense ← TRUE};
ENDCASE => EXIT;
ENDLOOP;
switches ← CommandUtil.FreeString[switches]};
badSemantics => {
results ← CommandUtil.FreePairList[results];
data.errors ← TRUE;
LogString["\n -- Illegal command"L]}};
data.sourceName ← CommandUtil.FreeString[data.sourceName];
data.bcdName ← CommandUtil.FreeString[data.bcdName];
data.codeName ← CommandUtil.FreeString[data.codeName];
data.symbolName ← CommandUtil.FreeString[data.symbolName];
data.commandArgs ← CommandUtil.FreePairList[data.commandArgs];
errorName ← CommandUtil.FreeString[errorName];
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; LogString["-- Illegal syntax"L]};
ENDLOOP;
IF data.table # NIL THEN Alloc.Destroy[data.table]; data.table ← NIL;
(data.zone).FREE[@data.rootName];
Heap.Delete[data.zone]; data.zone ← NIL;
Stream.Delete[log]; logFile ← File.nullCapability;
IF feedback.destroy # NIL THEN feedback.destroy[fbh, "End of binding"L];
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[Runtime.GetTableBase[LOOPHOLE[BcdParseData]]]};
Init[];
}.