-- ListBcd.Mesa
-- Last edited by Lewis on 14-Jan-81 16:04:17
-- Last edited by Sweet on 17-Feb-81 12:23:01
-- Last edited by Satterthwaite on September 20, 1982 1:36 pm
DIRECTORY
BcdDefs: TYPE USING [
Base, BCD, Link, CTIndex, CTNull, CTRecord, EXPIndex, EXPRecord, EVIndex, EVNull,
EVRecord, FPIndex, FPRecord, FTIndex, FTNull, FTRecord, FTSelf, IMPIndex, IMPRecord,
LFIndex, LFNull, MTIndex, MTRecord, Namee, NameRecord, NTIndex, NTNull, NTRecord,
NullName, NullLink, RFIndex, RFNull, SGIndex, SGNull, SGRecord, SpaceID,
SPIndex, SPRecord, TFIndex, TFNull, TYPNull, VersionID, VersionStamp],
BcdOps: TYPE USING [BcdBase, MTHandle, NameString],
CommanderOps: TYPE USING [AddCommand, CommandBlockHandle],
Environment: TYPE USING [PageCount, PageNumber, wordsPerPage],
FileSegment: TYPE USING [Pages],
ListerDefs: TYPE USING [
Indent, MapPages, PrintRTBcd,
WriteChar, WriteDecimal, WriteOctal, WriteString, WriteVersionId],
OSMiscOps: TYPE USING [FileError, FindFile],
OutputDefs: TYPE USING [
CloseOutput, OpenOutput, PutChar, PutCR, PutDecimal, PutLongSubString, PutOctal,
PutString, PutTime],
RTBcd: TYPE USING [RTBase],
Space: TYPE USING [Error, Handle, LongPointer, Delete],
Strings: TYPE USING [AppendString, SubStringDescriptor],
Time: TYPE USING [Append, Unpack];
ListBcd: PROGRAM
IMPORTS
CommanderOps, ListerDefs, OSMiscOps, OutputDefs, Space, Strings, Time = {
OPEN OutputDefs, BcdDefs;
bcdSpace: Space.Handle;
bcd: BcdOps.BcdBase;
tb: BcdDefs.Base;
ssb: BcdOps.NameString;
evb: BcdDefs.Base;
spb: BcdDefs.Base;
fpb: BcdDefs.Base;
ctb: BcdDefs.Base;
mtb: BcdDefs.Base;
lfb: BcdDefs.Base;
tfb: BcdDefs.Base;
rfb: BcdDefs.Base;
itb: BcdDefs.Base;
etb: BcdDefs.Base;
sgb: BcdDefs.Base;
ftb: BcdDefs.Base;
ntb: BcdDefs.Base;
rtHeader: RTBcd.RTBase;
InstallBcd: PROC [seg: FileSegment.Pages] = {
DO
bcdSpace ← ListerDefs.MapPages[seg];
bcd ← bcdSpace.LongPointer;
IF bcd.nPages <= seg.span.pages THEN EXIT;
seg.span.pages ← bcd.nPages;
Space.Delete[bcdSpace];
ENDLOOP;
tb ← LOOPHOLE[bcd];
ssb ← LOOPHOLE[bcd + bcd.ssOffset];
ctb ← tb + bcd.ctOffset;
mtb ← tb + bcd.mtOffset;
IF bcd.extended THEN {
lfb ← tb + bcd.lfOffset;
tfb ← tb + bcd.tfOffset;
rfb ← tb + bcd.rfOffset};
itb ← tb + bcd.impOffset;
etb ← tb + bcd.expOffset;
sgb ← tb + bcd.sgOffset;
ftb ← tb + bcd.ftOffset;
ntb ← tb + bcd.ntOffset;
evb ← tb + bcd.evOffset;
spb ← tb + bcd.spOffset;
fpb ← tb + bcd.fpOffset;
rtHeader ← IF bcd.extended AND bcd.rtPages.pages # 0
THEN LOOPHOLE[bcd + bcd.rtPages.relPageBase*Environment.wordsPerPage]
ELSE NIL};
UnstallBcd: PROC [seg: FileSegment.Pages] = {
Space.Delete[bcdSpace]};
WriteBcdID: PROC [name: STRING, bcd: BcdOps.BcdBase] = {
PutString[name];
PutString[", version "L]; ListerDefs.WriteVersionId[bcd.version];
IF bcd.source # NullName THEN {
PutString["\n source "L]; PutName[bcd.source];
PutString[" of "L]; PutTime[[bcd.sourceVersion.time]]};
IF bcd.versionIdent # BcdDefs.VersionID THEN {
PutString["\n (obsolete) version ID = "L];
PutDecimal[bcd.versionIdent]};
PutString["\n creator "L]; ListerDefs.WriteVersionId[bcd.creator];
PutString["\n\n"L]};
PrintStamps: PROC = {
PutString["Imports:\n\n"L];
FOR iti: IMPIndex ← FIRST[IMPIndex], iti + SIZE[IMPRecord]
UNTIL iti = bcd.impLimit DO
OPEN ii: itb[iti];
IF LOOPHOLE[iti, CARDINAL] > LOOPHOLE[bcd.impLimit, CARDINAL] THEN
GO TO Bogus;
IF ii.namedInstance THEN
{PutInstanceName[[import[iti]]]; PutString[": "L]};
PutName[ii.name];
PutFileStamp[ii.file, ii.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutCR[];
PutString["Exports:\n\n"L];
FOR eti: EXPIndex ← FIRST[EXPIndex], eti + etb[eti].size + SIZE[EXPRecord]
UNTIL eti = bcd.expLimit DO
OPEN ee: etb[eti];
IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN GO TO Bogus;
IF ee.namedInstance THEN
{PutInstanceName[[export[eti]]]; PutString[": "L]};
PutName[ee.name];
PutFileStamp[ee.file, ee.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutString["\nModules:\n\n"L];
FOR mti: MTIndex ← FIRST[MTIndex], mti + MTSize[mti] UNTIL mti = bcd.mtLimit DO
OPEN mm: mtb[mti];
IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
IF mm.namedInstance THEN {PutInstanceName[[module[mti]]]; PutString[": "L]};
PutName[mm.name];
PutFileStamp[mm.file, mm.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP};
PutFileStamp: PROC [fti: FTIndex, mName: NameRecord] = {
OPEN ftb[fti];
SELECT fti FROM
FTNull => PutString["(null)"L];
FTSelf => PutString["(self)"L];
ENDCASE => {
IF name # mName THEN {PutString[", file: "L]; PutName[name]};
PutString[", version: "L];
ListerDefs.WriteVersionId[version]};
PutCR[]};
PrintBcd: PROC = {
PrintHeader[];
PrintConfigs[];
PrintImports[];
PrintExports[];
PrintExpVars[];
PrintModules[];
PrintFiles[];
PrintFramePacks[];
PrintSpaces[]};
PrintHeader: PROC = {
PutString["Configurations: "L]; PutDecimal[bcd.nConfigs];
PutString[", Modules: "L]; PutDecimal[bcd.nModules];
PutString[", Imports: "L]; PutDecimal[bcd.nImports];
PutString[", Exports: "L]; PutDecimal[bcd.nExports];
PutString[", Dummy: "L]; PutDecimal[bcd.firstdummy];
PutString[", #Dummies: "L]; PutDecimal[bcd.nDummies];
PutCR[];
IF ~bcd.definitions THEN PutChar['~];
PutString["definitions, "L];
IF ~bcd.repackaged THEN PutChar['~];
PutString["repackaged, "L];
IF ~bcd.typeExported THEN PutChar['~];
PutString["type exported, "L];
IF ~bcd.tableCompiled THEN PutChar['~];
PutString["table compiled, "L];
IF ~bcd.versions THEN PutChar['~];
PutString["versions, "L];
IF ~bcd.extended THEN PutChar['~];
PutString["extended\n\n"L]};
PrintConfigs: PROC = {
cti: CTIndex ← FIRST[CTIndex];
PutString["Configurations"L];
PrintIndex[bcd.ctOffset];
PutString[":\n"L];
UNTIL cti = bcd.ctLimit DO
PrintConfig[cti];
cti ← cti + SIZE[CTRecord] + ctb[cti].nControls;
IF LOOPHOLE[cti, CARDINAL] > LOOPHOLE[bcd.ctLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutCR[]};
PrintConfig: PROC [cti: CTIndex] = {
OPEN ctb[cti];
Tab[2];
PutName[name];
PrintIndex[cti];
IF namedInstance THEN {
PutString[", instance name: "L]; PutInstanceName[[config[cti]]]};
PutString[", file: "L];
PrintFileName[file];
PrintIndex[file];
IF config # CTNull THEN {
PutString[", parent: "L];
PutName[ctb[config].name];
PrintIndex[config]};
PutString[", #controls: "L]; PutDecimal[nControls];
IF nControls # 0 THEN {
PutString[", controls:"L];
FOR i: CARDINAL IN [0..nControls) DO
IF i MOD 6 = 0 THEN Tab[6] ELSE PutString[", "L];
WITH c: controls[i] SELECT FROM
module => PutName[mtb[c.mti].name];
config => {PutName[ctb[c.cti].name]; PutChar['*]};
ENDCASE => ERROR;
PrintIndex[controls[i]];
ENDLOOP};
PutCR[]};
PrintImports: PROC = {
iti: IMPIndex ← FIRST[IMPIndex];
PutString["Imports"L];
PrintIndex[bcd.impOffset];
PutChar[':];
PutCR[];
UNTIL iti = bcd.impLimit DO
PrintImport[iti];
iti ← iti + SIZE[IMPRecord];
IF LOOPHOLE[iti, CARDINAL] > LOOPHOLE[bcd.impLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutCR[]; PutCR[]};
PrintImport: PROC [iti: IMPIndex] = {
OPEN itb[iti];
Tab[2];
PutName[name];
PrintIndex[iti];
IF port = module THEN PutString[" (module)"L];
IF namedInstance THEN {
PutString[", instance name: "L]; PutInstanceName[[import[iti]]]};
PutString[", file: "L];
PrintFileName[file];
PrintIndex[file];
PutString[", gfi: "L]; PutDecimal[gfi];
PutString[", ngfi: "L]; PutDecimal[ngfi]};
PrintExports: PROC = {
eti: EXPIndex ← FIRST[EXPIndex];
PutString["Exports"L];
PrintIndex[bcd.expOffset];
PutChar[':];
PutCR[];
UNTIL eti = bcd.expLimit DO
PrintExport[eti];
eti ← eti + etb[eti].size + SIZE[EXPRecord];
IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IF DumpLinks # all THEN PutCR[];
PutCR[]};
PrintExport: PROC [eti: EXPIndex] = {
OPEN etb[eti];
Tab[2];
PutName[name];
PrintIndex[eti];
IF port = module THEN PutString[" (module)"L];
IF namedInstance THEN {
PutString[", instance name: "L]; PutInstanceName[[export[eti]]]};
PutString[", file: "L];
PrintFileName[file];
PrintIndex[file];
PutString[", "L];
IF ~typeExported THEN PutChar['~];
PutString["typeExported"L];
PutString[", #links: "L]; PutDecimal[size];
IF DumpLinks = all THEN {
PutString[", links:"L];
FOR i: CARDINAL IN [0..size) DO
IF i MOD 7 = 0 THEN Tab[4] ELSE PutChar[' ];
PrintControlLink[links[i]];
IF i + 1 # size THEN PutChar[',];
ENDLOOP};
IF DumpLinks = all THEN PutCR[]};
PrintExpVars: PROC = {
evi: EVIndex ← FIRST[EVIndex];
evLimit: EVIndex = bcd.evLimit;
PutString["Exported variables:\n"L];
UNTIL evi = evLimit DO
PrintExpVar[evi];
evi ← evi + evb[evi].length + SIZE[EVRecord];
ENDLOOP;
PutCR[]};
PrintExpVar: PROC [evi: EVIndex] = {
OPEN evb[evi];
Tab[2];
PrintIndex[evi];
PutString[", #offsets: "L];
PutDecimal[length];
PutString[", offsets:"L];
FOR i: CARDINAL IN [1..length] DO
IF i MOD 8 = 1 THEN Tab[4] ELSE PutChar[' ];
PutOctal[offsets[i]];
IF i # length THEN PutChar[',];
ENDLOOP;
PutCR[]};
PrintSpaces: PROC = {
spi: SPIndex ← FIRST[SPIndex];
spLimit: SPIndex = bcd.spLimit;
PutString["Spaces:\n"L];
UNTIL spi = spLimit DO
PrintSpace[spi];
spi ← spi + SIZE[SPRecord] + spb[spi].length*SIZE[SpaceID];
ENDLOOP;
PutCR[]};
PrintSpace: PROC [spi: SPIndex] = {
OPEN spb[spi];
Tab[2];
PrintIndex[spi];
PutString[", segment: "L]; PrintIndex[seg];
PutString[", #code packs: "L]; PutDecimal[length];
IF length # 0 THEN PutString[", code packs: "L];
FOR i: CARDINAL IN [0..length) DO
Tab[4];
PutString[" code pack "L]; PutName[spaces[i].name];
PutString[", "L];
IF ~spaces[i].resident THEN PutChar['~];
PutString["resident, offset: "L];
PutOctal[spaces[i].offset];
PutString[", pages: "L];
PutDecimal[spaces[i].pages];
PutCR[];
ENDLOOP};
PrintModules: PROC = {
mti: MTIndex ← FIRST[MTIndex];
PutString["Modules"L];
PrintIndex[bcd.mtOffset];
PutString[":\n"L];
UNTIL mti = bcd.mtLimit DO
PrintModule[@mtb[mti], mti];
mti ← mti + MTSize[mti];
IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutCR[]};
PrintModule: PROC [mth: BcdOps.MTHandle, mti: MTIndex] = {
OPEN mth;
Tab[2];
PutName[name];
PrintIndex[mti];
IF namedInstance THEN {
PutString["instance name: "L]; PutInstanceName[[module[mti]]]};
PutString[", file: "L];
PrintFileName[file];
PrintIndex[file];
IF config # CTNull THEN {
PutString[", config: "L];
PutName[ctb[config].name];
PrintIndex[config]};
Tab[4];
IF tableCompiled THEN PutString["table compiled, "L] ELSE {
PutSwitch: PROC [sw: CHAR, value: BOOL] = {
IF ~value THEN PutChar['-]; PutChar[sw]};
PutString["switches: "L];
PutSwitch['b, boundsChecks];
PutSwitch['c, long];
PutSwitch['j, crossJumped];
PutSwitch['l, linkLoc = code];
PutSwitch['n, nilChecks];
PutSwitch['s, ~initial];
PutString[", "L]};
IF ~packageable THEN PutChar['~]; PutString["packageable, "L];
IF residentFrame THEN PutString["resident frame, "L];
Tab[4];
PutString["framesize: "L]; PutDecimal[framesize];
PutString[", gfi: "L]; PutDecimal[gfi];
PutString[", ngfi: "L]; PutDecimal[ngfi];
PutString[", links: "L]; PutString[IF linkLoc = frame THEN "frame"L ELSE "code"L];
Tab[4];
PutString["code: "L]; PrintSegment[code.sgi];
PutString[", offset: "L]; PutOctal[code.offset];
PutString[", length: "L]; PutOctal[code.length];
IF code.linkspace THEN PutString[", link space"L];
IF code.packed THEN PutString[", packed"L];
Tab[4];
PutString["symbols: "L]; PrintSegment[sseg];
IF variables # EVNull THEN {
Tab[4]; PutString["exported variables: "L]; PrintIndex[variables]};
WITH mm: mth↑ SELECT FROM
direct => {
Tab[4];
PutString["#links: "L]; PutDecimal[mm.length];
IF DumpLinks = all THEN {
PutString[", links:"L];
FOR i: CARDINAL IN [0..mm.length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE PutChar[' ];
PrintControlLink[mm.frag[i]];
IF i + 1 # mm.length THEN PutChar[',];
ENDLOOP}};
indirect => {Tab[4]; PrintLinks[mm.links]};
multiple => {
Tab[4];
PrintLinks[mm.links];
Tab[4];
PrintTypes[mm.types];
IF mm.frameRefs THEN {
Tab[5];
PutString["frame type: "L]; PutDecimal[mm.frameType]};
Tab[4];
PrintRefLits[mm.refLiterals]};
ENDCASE;
PutCR[]};
MTSize: PROC [mti: MTIndex] RETURNS [NAT] = {
RETURN [WITH m: mtb[mti] SELECT FROM
direct => SIZE[direct MTRecord] + m.length,
indirect => SIZE[indirect MTRecord],
multiple => SIZE[multiple MTRecord],
ENDCASE => ERROR]};
PrintLinks: PROC [lfi: LFIndex] = {
PutString["#links: "L];
IF lfi = LFNull THEN PutString["none"L]
ELSE {
PutDecimal[lfb[lfi].length];
IF DumpLinks = all THEN {
PutString[", links:"L];
FOR i: CARDINAL IN [0..lfb[lfi].length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE PutChar[' ];
PrintControlLink[lfb[lfi].frag[i]];
IF i + 1 # lfb[lfi].length THEN PutChar[',];
ENDLOOP}}};
PrintTypes: PROC [tfi: TFIndex] = {
PutString["#types: "L];
IF tfi = TFNull THEN PutString["none"L]
ELSE {
PutDecimal[tfb[tfi].length];
PutString[", offset: "L]; PutDecimal[tfb[tfi].offset];
IF DumpLinks # none THEN {
PutString[", indices:"L];
FOR i: CARDINAL IN [0..tfb[tfi].length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE PutChar[' ];
PrintRTIndex[tfb[tfi].frag[i]];
IF i + 1 # tfb[tfi].length THEN PutChar[',];
ENDLOOP}}};
PrintRefLits: PROC [rfi: RFIndex] = {
PutString["#ref lits: "L];
IF rfi = RFNull THEN PutString["none"L]
ELSE {
PutDecimal[rfb[rfi].length];
PutString[", offset: "L]; PutDecimal[rfb[rfi].offset];
IF DumpLinks # none THEN {
PutString[", indices:"L];
FOR i: CARDINAL IN [0..rfb[rfi].length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE PutChar[' ];
PrintRTIndex[rfb[rfi].frag[i]];
IF i + 1 # rfb[rfi].length THEN PutChar[',];
ENDLOOP}}};
PrintFramePacks: PROC = {
fpi: FPIndex ← FIRST[FPIndex];
fpLimit: FPIndex = bcd.fpLimit;
PutString["Frame Packs:\n"L];
UNTIL fpi = fpLimit DO
PrintFramePack[fpi];
fpi ← fpi + SIZE[FPRecord] + fpb[fpi].length*SIZE[MTIndex];
ENDLOOP;
PutCR[]};
PrintFramePack: PROC [fpi: FPIndex] = {
OPEN fpb[fpi];
Tab[2];
PutName[name];
PrintIndex[fpi];
PutString[", #modules: "L];
PutDecimal[length];
PutString[", modules:\n"L];
FOR i: CARDINAL IN [0..length) DO
IF i MOD 4 = 0 THEN Tab[4] ELSE PutChar[' ];
PutName[mtb[modules[i]].name];
PrintIndex[modules[i]];
IF i # length - 1 THEN PutChar[',];
ENDLOOP;
PutCR[]};
PrintSegment: PROC [sgi: SGIndex] = {
IF sgi = BcdDefs.SGNull THEN PutString["(null)"L]
ELSE {
PrintFileName[sgb[sgi].file];
PutString[" [base: "L]; PutDecimal[sgb[sgi].base];
PutString[", pages: "L]; PutDecimal[sgb[sgi].pages];
IF sgb[sgi].extraPages # 0 THEN {PutChar['+]; PutDecimal[sgb[sgi].extraPages]};
PutChar[']]}};
PrintFiles: PROC = {
fti: FTIndex ← FIRST[FTIndex];
PutString["Files"L];
PrintIndex[bcd.ftOffset];
PutString[":\n"L];
UNTIL fti = bcd.ftLimit DO
PrintFile[fti];
fti ← fti + SIZE[FTRecord];
IF LOOPHOLE[fti, CARDINAL] > LOOPHOLE[bcd.ftLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutCR[]; PutCR[]};
PrintFile: PROC [fti: FTIndex] = {
OPEN ftb[fti];
Tab[2];
SELECT fti FROM
FTNull => PutString["(null)"L];
FTSelf => PutString["(self)"L];
ENDCASE => {
PutName[name];
PrintIndex[fti];
PutString[", version: "L];
ListerDefs.WriteVersionId[version]}};
PrintRTBcdExt: PROC = {
PrintHeader[];
PrintConfigs[];
PrintModules[];
IF rtHeader = NIL THEN PutString["No RT Extensions"L]
ELSE {
ListerDefs.PrintRTBcd[rtHeader];
PrintSymbolSegments[]};
PutCR[]; PutCR[]};
PrintSymbolSegments: PROC = {
sgi: SGIndex ← FIRST[SGIndex];
PutString["Symbol Segments\n"L];
UNTIL sgi = bcd.sgLimit DO
IF sgb[sgi].class = symbols THEN {
Tab[1];
PrintIndex[sgi]; PutChar[' ];
PrintSegment[sgi]};
sgi ← sgi + SIZE[SGRecord];
ENDLOOP;
PutCR[]};
-- Utility Prints
PrintControlLink: PROC [link: Link] = {
SELECT TRUE FROM
(link = BcdDefs.NullLink) =>
PutString["(null link)"L];
link.proc => {
PutString["proc["L];
PutDecimal[link.gfi]; PutChar[',]; PutDecimal[link.ep]; PutChar[']]};
link.type => {
PutString["type["L];
IF link.typeID = BcdDefs.TYPNull THEN PutString["null"L]
ELSE PutDecimal[LOOPHOLE[link.typeID]];
PutChar[']]};
ENDCASE => {
PutString["var["L];
PutDecimal[link.vgfi]; PutChar[',]; PutDecimal[link.var]; PutChar[']]}};
PrintRTIndex: PROC [index: NAT] = {
PutChar['[]; PutDecimal[index]; PutChar[']]};
PrintFileName: PROC [fti: FTIndex] = {
SELECT fti FROM
FTNull => PutString["(null)"L];
FTSelf => PutString["(self)"L];
ENDCASE => PutName[ftb[fti].name]};
PrintIndex: PROC [index: UNSPECIFIED] = {
PutString[" ["L]; PutDecimal[index]; PutChar[']]};
PrintGarbage: PROC = {
Tab[2];
PutString["? Looks like garbage ...\n"L]};
PrintAnonName: PROC = {PutString[" (anon) "L]};
-- Utility Puts
PutName: PROC [n: NameRecord] = {
ssd: Strings.SubStringDescriptor ←
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
PutLongSubString[@ssd]};
Tab: PROC [n: CARDINAL] = {ListerDefs.Indent[n]};
PutInstanceName: PROC [n: Namee] = {
FindName: PROC [ntb: Base, nti: NTIndex] RETURNS [stop: BOOLEAN] = {
RETURN [ntb[nti].item = n]};
nti: NTIndex = EnumerateNameTable[FindName];
IF nti = NTNull THEN PrintAnonName[] ELSE PutName[ntb[nti].name]};
EnumerateNameTable: PROC [
proc: PROC [Base, NTIndex] RETURNS [BOOLEAN]] RETURNS [nti: NTIndex] = {
FOR nti ← FIRST[NTIndex], nti + SIZE[NTRecord] UNTIL nti = bcd.ntLimit DO
IF proc[ntb, nti] THEN RETURN[nti];
ENDLOOP;
RETURN [NTNull]};
Version: PROC [root: STRING] = {
bcdfile: STRING ← [40];
seg: FileSegment.Pages;
Strings.AppendString[bcdfile, root];
FOR i: CARDINAL IN [0..bcdfile.length) DO
IF bcdfile[i] = '. THEN EXIT;
REPEAT
FINISHED => Strings.AppendString[bcdfile, ".bcd"L];
ENDLOOP;
seg ← [
file: OSMiscOps.FindFile[bcdfile ! OSMiscOps.FileError => GO TO NoFile],
span: [base: 1, pages: 10]];
InstallBcd[seg];
ListerDefs.WriteChar['\n];
ListerDefs.WriteString[bcdfile];
ListerDefs.WriteString[", version "L]; WriteVersion[bcd.version];
IF bcd.source # BcdDefs.NullName THEN {
ListerDefs.WriteString["\n source "L]; WriteName[bcd.source];
ListerDefs.WriteString[" of "L]; WriteTime[bcd.sourceVersion.time]};
IF bcd.versionIdent # VersionID THEN {
ListerDefs.WriteString["\n (obsolete) version ID = "L];
ListerDefs.WriteDecimal[bcd.versionIdent]};
ListerDefs.WriteString["\n creator "L]; WriteVersion[bcd.creator];
ListerDefs.WriteChar['\n];
UnstallBcd[seg];
EXITS
NoFile => ListerDefs.WriteString["File not found"L]};
WriteVersion: PROC [stamp: BcdDefs.VersionStamp] = {
StampWords: CARDINAL = SIZE[BcdDefs.VersionStamp];
str: PACKED ARRAY [0..4*StampWords) OF [0..16) = LOOPHOLE[stamp];
digit: STRING = "0123456789abcdef"L;
ListerDefs.WriteChar['"];
FOR i: CARDINAL IN [0..4*StampWords) DO
ListerDefs.WriteChar[digit[str[i]]] ENDLOOP;
ListerDefs.WriteString["\" ("L];
WriteTime[stamp.time]; ListerDefs.WriteString[", "]; WriteMachine[stamp]};
WriteTime: PROC [time: LONG CARDINAL] = {
t: STRING ← [20];
Time.Append[t, Time.Unpack[LOOPHOLE[time]]];
ListerDefs.WriteString[t]};
WriteName: PROC [n: BcdDefs.NameRecord] = {
ssd: Strings.SubStringDescriptor ←
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
FOR i: CARDINAL IN [ssd.offset .. ssd.offset+ssd.length) DO
ListerDefs.WriteChar[ssd.base[i]];
ENDLOOP};
WriteMachine: PROC [version: BcdDefs.VersionStamp] = {
ListerDefs.WriteOctal[version.net]; ListerDefs.WriteChar['#];
ListerDefs.WriteOctal[version.host]; ListerDefs.WriteChar['#]};
BcdProc: PROC [
root: STRING,
base: Environment.PageNumber, pages: Environment.PageCount,
proc: PROC] = {
bcdfile: STRING ← [40];
seg: FileSegment.Pages;
Strings.AppendString[bcdfile, root];
FOR i: CARDINAL IN [0..bcdfile.length) DO
IF bcdfile[i] = '. THEN EXIT;
REPEAT
FINISHED => Strings.AppendString[bcdfile, ".bcd"L];
ENDLOOP;
seg ← [
file: OSMiscOps.FindFile[bcdfile, ! OSMiscOps.FileError => GO TO NoFile],
span: [base: base, pages: pages]];
InstallBcd[seg];
OpenOutput[root, ".bl"L];
WriteBcdID[bcdfile, bcd];
proc[];
CloseOutput[];
UnstallBcd[seg];
EXITS
NoFile => ListerDefs.WriteString["File not found"L]};
Stamps: PROC [root: STRING] = {
BcdProc[root, 1, 10, PrintStamps]};
Files: PROC [root: STRING] = {
BcdProc[root, 1, 10, PrintFiles]};
Bcd: PROC [root: STRING] = {
BcdProc[root, 1, 10, PrintBcd]};
BcdLinks: PROC [root: STRING] = {
DumpLinks ← all;
Bcd[root];
DumpLinks ← none};
BcdSegment: PROC [
root: STRING,
base: Environment.PageNumber, pages: Environment.PageCount,
links: BOOLEAN] = {
DumpLinks ← IF links THEN all ELSE none;
BEGIN
BcdProc[root, base, pages, PrintBcd ! Space.Error => GO TO BadSegment];
EXITS
BadSegment => ListerDefs.WriteString["Bad Segment"L];
END;
DumpLinks ← none};
RTBcdExt: PROC [root: STRING] = {
DumpLinks ← rt;
BcdProc[root, 1, 10, PrintRTBcdExt];
DumpLinks ← none};
DumpLinks: {none, rt, all} ← none;
Init: PROC = {
command: CommanderOps.CommandBlockHandle;
command ← CommanderOps.AddCommand["Bcd", LOOPHOLE[Bcd], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderOps.AddCommand["BcdLinks", LOOPHOLE[BcdLinks], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderOps.AddCommand["Version", LOOPHOLE[Version], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderOps.AddCommand["Stamps", LOOPHOLE[Stamps], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderOps.AddCommand["Files", LOOPHOLE[Files], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderOps.AddCommand["BcdSegment", LOOPHOLE[BcdSegment], 4];
command.params[0] ← [type: string, prompt: "Filename"];
command.params[1] ← [type: numeric, prompt: "Base"];
command.params[2] ← [type: numeric, prompt: "Pages"];
command.params[3] ← [type: boolean, prompt: "Links"];
command ← CommanderOps.AddCommand["RTBcd", LOOPHOLE[RTBcdExt], 1];
command.params[0] ← [type: string, prompt: "Filename"]};
Init[];
}.