DIRECTORY
BcdDefs:
TYPE
USING [
Base, BCD, BcdBase, Link, CTIndex, CTNull, CTRecord, EXPIndex, EXPRecord, EVIndex, EVNull, EVRecord, FPIndex, FPRecord, FTIndex, FTNull, FTRecord, FTSelf, IMPIndex, IMPRecord, LFIndex, LFNull, MTHandle, MTIndex, MTRecord, Namee, NameRecord, NameString, NTIndex, NTNull, NTRecord, NullName, NullLink, RFIndex, RFNull, SGIndex, SGNull, SGRecord, SpaceID, SPIndex, SPRecord, TFIndex, TFNull, TYPNull, VersionID, VersionStamp],
CommanderOps: TYPE USING [AddCommand, CommandBlockHandle],
ConvertUnsafe: TYPE USING [AppendString, SubStringDescriptor],
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],
PrincOps: TYPE USING [PageCount, PageNumber, wordsPerPage],
RTBcd: TYPE USING [RTBase],
Time: TYPE USING [Append, Unpack];
VM: TYPE USING [Error, Handle, LongPointer, Delete],
ListBcd:
PROGRAM
IMPORTS
CommanderOps, ConvertUnsafe, ListerDefs, OSMiscOps, OutputDefs, Time, VM = {
OPEN OutputDefs, BcdDefs;
bcdSpace: VM.Interval;
bcd: BcdDefs.BcdBase;
tb: BcdDefs.Base;
ssb: BcdDefs.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;
VM.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*PrincOps.wordsPerPage]
ELSE NIL};
UnstallBcd:
PROC [seg: FileSegment.Pages] = {
VM.Delete[bcdSpace]};
WriteBcdID:
PROC [name:
STRING, bcd: BcdDefs.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: BcdDefs.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: ConvertUnsafe.SubString ←
[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;
ConvertUnsafe.AppendString[bcdfile, root];
FOR i:
CARDINAL
IN [0..bcdfile.length)
DO
IF bcdfile[i] = '. THEN EXIT;
REPEAT
FINISHED => ConvertUnsafe.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["FS 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: ConvertUnsafe.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: PrincOps.PageNumber, pages: PrincOps.PageCount,
proc: PROC] = {
bcdfile: STRING ← [40];
seg: FileSegment.Pages;
ConvertUnsafe.AppendString[bcdfile, root];
FOR i:
CARDINAL
IN [0..bcdfile.length)
DO
IF bcdfile[i] = '. THEN EXIT;
REPEAT
FINISHED => ConvertUnsafe.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["FS 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: PrincOps.PageNumber, pages: PrincOps.PageCount,
links: BOOLEAN] = {
DumpLinks ←
IF links
THEN all
ELSE none;
BEGIN
BcdProc[root, base, pages, PrintBcd ! VM.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[];
}.