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