-- ListBcd.Mesa
-- Last edited by Lewis on May 15, 1980 4:28 PM
-- Last edited by Sweet on September 22, 1980 9:51 AM
DIRECTORY
AltoDefs USING [PageCount, PageNumber],
BcdDefs USING [
Base, BCD, Link, CTIndex, CTNull, CTRecord, EXPIndex, EXPRecord, EVNull,
FPIndex, FPRecord, FTIndex, FTNull, FTRecord, FTSelf, IMPIndex, IMPRecord,
MTIndex, MTRecord, Namee, NameRecord, NTIndex, NTNull, NTRecord, NullName,
SGIndex, VersionID, EVIndex, SpaceID, SPIndex, EVRecord, SPRecord],
BcdOps USING [MTHandle, NameString],
CommanderDefs USING [AddCommand, CommandBlockHandle],
IODefs USING [WriteString],
ListerDefs USING [Indent, PrintMachine, WriteVersions],
OutputDefs USING [
CloseOutput, GetOutputStream, OpenOutput, outStream, PutChar, PutCR,
PutDecimal, PutOctal, PutString, PutSubString, PutTime],
SegmentDefs USING [
DefaultVersion, FileNameError, FileSegmentAddress, FileSegmentHandle,
InvalidSegmentSize, MoveFileSegment, NewFile, NewFileSegment, Read,
SegmentFault, SwapError, SwapIn, SwapOut, Unlock],
StreamDefs USING [GetDefaultDisplayStream],
String USING [AppendString, SubStringDescriptor];
ListBcd: PROGRAM
IMPORTS CommanderDefs, IODefs, ListerDefs, OutputDefs, SegmentDefs, StreamDefs, String
EXPORTS ListerDefs =
BEGIN OPEN OutputDefs, BcdDefs;
bcd: POINTER TO BCD;
tb: Base;
ssb: BcdOps.NameString;
evb: Base;
spb: Base;
fpb: Base;
ctb: Base;
mtb: Base;
itb: Base;
etb: Base;
sgb: Base;
ftb: Base;
ntb: Base;
InstallBcd: PROCEDURE [seg: SegmentDefs.FileSegmentHandle] =
BEGIN OPEN SegmentDefs;
size: CARDINAL;
IF ~seg.swappedin THEN SwapIn[seg];
bcd ← FileSegmentAddress[seg];
IF (size ← bcd.nPages) # seg.pages THEN
BEGIN
Unlock[seg];
MoveFileSegment[seg, seg.base, size];
SwapIn[seg];
bcd ← FileSegmentAddress[seg];
END;
tb ← LOOPHOLE[bcd];
ssb ← LOOPHOLE[bcd + bcd.ssOffset];
ctb ← tb + bcd.ctOffset;
mtb ← tb + bcd.mtOffset;
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;
RETURN
END;
UnstallBcd: PROCEDURE [seg: SegmentDefs.FileSegmentHandle] =
BEGIN OPEN SegmentDefs;
IF seg.swappedin THEN Unlock[seg];
SwapOut[seg];
RETURN
END;
WriteBcdID: PROCEDURE [name: STRING, bcd: POINTER TO BCD] =
BEGIN
PutString[name];
PutString[" configured "];
PutTime[LOOPHOLE[bcd.version.time]];
IF bcd.source # NullName THEN
BEGIN PutString[" from "]; PutName[bcd.source]; END;
PutString[" by "];
ListerDefs.PrintMachine[bcd.version];
IF bcd.versionIdent # VersionID THEN
BEGIN
PutString[" Obsolete VersionID = "];
PutDecimal[bcd.versionIdent]
END;
PutCR[];
PutString[" Configured by "];
PutTime[LOOPHOLE[bcd.creator.time]];
PutString[" "];
ListerDefs.PrintMachine[bcd.creator];
PutCR[];
PutCR[];
RETURN
END;
PrintStamps: PROC =
BEGIN
PutString["Imports:"L]; PutCR[]; PutCR[];
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:"L]; PutCR[]; PutCR[];
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;
PutCR[];
PutString["Modules:"L]; PutCR[]; PutCR[];
FOR mti: MTIndex ← FIRST[MTIndex],
mti + SIZE[MTRecord] + mtb[mti].frame.length
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;
END;
PutFileStamp: PUBLIC PROCEDURE [fti: FTIndex, mName: NameRecord] =
BEGIN OPEN ftb[fti];
SELECT fti FROM
FTNull => PutString["(null)"];
FTSelf => PutString["(self)"];
ENDCASE =>
BEGIN
IF name # mName THEN {PutString[", file: "L]; PutName[name]};
PutString[", time: "];
PutTime[LOOPHOLE[version.time]];
PutString[", processor: "];
ListerDefs.PrintMachine[version];
END;
PutCR[];
RETURN
END;
PrintBcd: PUBLIC PROCEDURE =
BEGIN
PrintHeader[];
PrintConfigs[];
PrintImports[];
PrintExports[];
PrintExpVars[];
PrintModules[];
PrintFiles[];
PrintFramePacks[];
PrintSpaces[];
RETURN
END;
PrintHeader: PUBLIC PROCEDURE =
BEGIN
PutString["Configurations: "];
PutDecimal[bcd.nConfigs];
PutString[", Modules: "];
PutDecimal[bcd.nModules];
PutString[", Imports: "];
PutDecimal[bcd.nImports];
PutString[", Exports: "];
PutDecimal[bcd.nExports];
PutString[", Dummy: "];
PutDecimal[bcd.firstdummy];
PutString[", #Dummies: "];
PutDecimal[bcd.nDummies];
PutCR[];
PutCR[];
RETURN
END;
PrintConfigs: PUBLIC PROCEDURE =
BEGIN
cti: CTIndex ← FIRST[CTIndex];
PutString["Configurations"];
PrintIndex[bcd.ctOffset];
PutChar[':];
PutCR[];
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[];
RETURN
END;
PrintConfig: PUBLIC PROCEDURE [cti: CTIndex] =
BEGIN OPEN ctb[cti];
Tab[2];
PutName[name];
PrintIndex[cti];
IF namedInstance THEN
BEGIN PutString[", instance: "]; PutInstanceName[[config[cti]]]; END;
PutString[", file: "];
PrintFileName[file];
PrintIndex[file];
IF config # CTNull THEN
BEGIN
PutString[", parent: "];
PutName[ctb[config].name];
PrintIndex[config];
END;
IF nControls # 0 THEN
BEGIN
i: CARDINAL;
first: BOOLEAN ← TRUE;
PutString[", controls: ["];
FOR i IN [0..nControls) DO
IF first THEN first ← FALSE ELSE PutString[", "L];
PutName[mtb[controls[i]].name];
PrintIndex[controls[i]];
ENDLOOP;
PutChar[']];
END;
PutCR[];
RETURN
END;
PrintImports: PUBLIC PROCEDURE =
BEGIN
iti: IMPIndex ← FIRST[IMPIndex];
PutString["Imports"];
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[];
RETURN
END;
PrintImport: PUBLIC PROCEDURE [iti: IMPIndex] =
BEGIN OPEN itb[iti];
Tab[2];
PutName[name];
PrintIndex[iti];
IF port = module THEN PutString[" (module)"];
IF namedInstance THEN
BEGIN PutString[", instance: "]; PutInstanceName[[import[iti]]]; END;
PutString[", file: "];
PrintFileName[file];
PrintIndex[file];
PutString[", gfi: "];
PutDecimal[gfi];
PutString[", ngfi: "];
PutDecimal[ngfi];
PutCR[];
RETURN
END;
PrintExports: PUBLIC PROCEDURE =
BEGIN
eti: EXPIndex ← FIRST[EXPIndex];
PutString["Exports"];
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;
PutCR[];
RETURN
END;
PrintExport: PUBLIC PROCEDURE [eti: EXPIndex] =
BEGIN OPEN etb[eti];
i: CARDINAL;
Tab[2];
PutName[name];
PrintIndex[eti];
IF port = module THEN PutString[" (module)"];
IF namedInstance THEN
BEGIN PutString[", instance: "]; PutInstanceName[[export[eti]]]; END;
PutString[", file: "];
PrintFileName[file];
PrintIndex[file];
PutString[", size: "];
PutDecimal[size];
IF DumpLinks THEN
BEGIN
PutString[", links:"];
FOR i IN [0..size) DO
IF i MOD 8 = 0 THEN Tab[4] ELSE PutChar[' ];
PrintControlLink[links[i]];
IF i + 1 # size THEN PutChar[',];
ENDLOOP;
END;
PutCR[];
RETURN
END;
PrintExpVars: PUBLIC PROCEDURE =
BEGIN
evi: EVIndex ← FIRST[EVIndex];
evLimit: EVIndex = bcd.evLimit;
PutString["Exported variables:"L];
PutCR[];
UNTIL evi = evLimit DO
PrintExpVar[evi]; evi ← evi + evb[evi].length + SIZE[EVRecord]; ENDLOOP;
PutCR[];
RETURN
END;
PrintExpVar: PUBLIC PROCEDURE [evi: EVIndex] =
BEGIN OPEN evb[evi];
i: CARDINAL;
Tab[2];
PrintIndex[evi];
PutString[", length: "L];
PutDecimal[length];
PutString[", offsets:"L];
PutCR[];
FOR i IN [1..length] DO
IF i MOD 8 = 1 THEN Tab[4] ELSE PutChar[' ];
PutOctal[offsets[i]];
IF i # length THEN PutChar[',];
ENDLOOP;
PutCR[];
RETURN
END;
PrintSpaces: PUBLIC PROCEDURE =
BEGIN
spi: SPIndex ← FIRST[SPIndex];
spLimit: SPIndex = bcd.spLimit;
PutString["Spaces:"L];
PutCR[];
UNTIL spi = spLimit DO
PrintSpace[spi];
spi ← spi + SIZE[SPRecord] + spb[spi].length*SIZE[SpaceID];
ENDLOOP;
PutCR[];
RETURN
END;
PrintSpace: PUBLIC PROCEDURE [spi: SPIndex] =
BEGIN OPEN spb[spi];
i: CARDINAL;
Tab[2];
PrintIndex[spi];
PutString[", segment: "L];
PrintIndex[seg];
PutString[", length: "L];
PutDecimal[length];
FOR i IN [0..length) DO
Tab[4];
PutName[spaces[i].name];
IF spaces[i].resident THEN PutString[", resident"L];
PutString[", offset: "L];
PutOctal[spaces[i].offset];
PutString[", pages: "L];
PutDecimal[spaces[i].pages];
PutCR[];
ENDLOOP;
RETURN
END;
PrintModules: PUBLIC PROCEDURE =
BEGIN
mti: MTIndex ← FIRST[MTIndex];
PutString["Modules"];
PrintIndex[bcd.mtOffset];
PutChar[':];
PutCR[];
UNTIL mti = bcd.mtLimit DO
PrintModule[@mtb[mti], mti];
mti ← mti + SIZE[MTRecord] + mtb[mti].frame.length;
IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN
GO TO Bogus;
REPEAT Bogus => PrintGarbage[];
ENDLOOP;
PutCR[];
RETURN
END;
PrintModule: PUBLIC PROCEDURE [mth: BcdOps.MTHandle, mti: MTIndex] =
BEGIN OPEN mth;
i: CARDINAL;
Tab[2];
PutName[name];
PrintIndex[mti];
IF namedInstance THEN
BEGIN PutString["instance: "]; PutInstanceName[[module[mti]]]; END;
PutString[", file: "];
PrintFileName[file];
PrintIndex[file];
PutString[", links: "];
PutString[IF links = frame THEN "frame" ELSE "code"];
IF config # CTNull THEN
BEGIN
PutString[", config: "];
PutName[ctb[config].name];
PrintIndex[config];
END;
Tab[4];
PutString[IF altoCode THEN "Alto code"L ELSE "DStar code"L];
IF residentFrame THEN PutString[", resident frame"L];
IF crossJumped THEN PutString[", cross jumped"L];
IF packageable THEN PutString[", packageable"L];
PutString[", framesize: "];
PutDecimal[framesize];
PutString[", gfi: "];
PutDecimal[gfi];
PutString[", ngfi: "];
PutDecimal[ngfi];
Tab[4];
PutString["code: "];
PrintSegment[code.sgi];
PutString[", offset: "];
PutOctal[code.offset];
PutString[", length: "];
PutOctal[code.length];
IF code.linkspace THEN PutString[", link space"L];
IF code.packed THEN PutString[", packed"L];
IF long THEN PutString[", long"L];
IF tableCompiled THEN PutString[", tableCompiled"L];
IF boundsChecks THEN PutString[", boundsChecks"L];
IF nilChecks THEN PutString[", nilChecks"L];
Tab[4];
PutString["symbols: "];
PrintSegment[sseg];
IF variables # EVNull THEN
BEGIN Tab[4]; PutString["variables: "]; PrintIndex[variables] END;
BEGIN OPEN frame;
Tab[4];
PutString["frame length: "];
PutDecimal[length];
IF DumpLinks THEN
BEGIN
PutString[", control links:"];
FOR i IN [0..length) DO
IF i MOD 8 = 0 THEN Tab[6] ELSE PutChar[' ];
PrintControlLink[frag[i]];
IF i + 1 # length THEN PutChar[',];
ENDLOOP;
END;
END;
PutCR[];
RETURN
END;
PrintFramePacks: PUBLIC PROCEDURE =
BEGIN
fpi: FPIndex ← FIRST[FPIndex];
fpLimit: FPIndex = bcd.fpLimit;
PutString["Frame Packs:"L];
PutCR[];
UNTIL fpi = fpLimit DO
PrintFramePack[fpi];
fpi ← fpi + SIZE[FPRecord] + fpb[fpi].length*SIZE[MTIndex];
ENDLOOP;
PutCR[];
RETURN
END;
PrintFramePack: PUBLIC PROCEDURE [fpi: FPIndex] =
BEGIN OPEN fpb[fpi];
i: CARDINAL;
Tab[2];
PutName[name];
PrintIndex[fpi];
PutString[", length: "L];
PutDecimal[length];
PutString[", modules:"L];
PutCR[];
FOR i 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[];
RETURN
END;
PrintSegment: PUBLIC PROCEDURE [sgi: SGIndex] =
BEGIN OPEN sd: sgb[sgi];
PrintFileName[sd.file];
PutString[" [base: "];
PutDecimal[sd.base];
PutString[", pages: "];
PutDecimal[sd.pages];
IF sd.extraPages # 0 THEN BEGIN PutChar['+]; PutDecimal[sd.extraPages]; END;
PutChar[']];
RETURN
END;
PrintFiles: PUBLIC PROCEDURE =
BEGIN
fti: FTIndex ← FIRST[FTIndex];
PutString["Files"];
PrintIndex[bcd.ftOffset];
PutChar[':];
PutCR[];
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[];
RETURN
END;
PrintFile: PUBLIC PROCEDURE [fti: FTIndex] =
BEGIN OPEN ftb[fti];
Tab[2];
SELECT fti FROM
FTNull => PutString["(null)"];
FTSelf => PutString["(self)"];
ENDCASE =>
BEGIN
PutName[name];
PrintIndex[fti];
PutString[", time: "];
PutTime[LOOPHOLE[version.time]];
PutString[", processor: "];
ListerDefs.PrintMachine[version];
END;
PutCR[];
RETURN
END;
-- Utility Prints
PrintControlLink: PROCEDURE [link: Link] =
BEGIN
map: ARRAY BOOLEAN OF CHARACTER = ['0, '1];
PutChar['[];
PutDecimal[link.gfi];
PutChar[',];
PutDecimal[link.ep];
PutChar[',];
PutChar[map[link.tag]];
PutChar[']];
RETURN
END;
PrintFileName: PROCEDURE [fti: FTIndex] =
BEGIN
SELECT fti FROM
FTNull => PutString["(null)"];
FTSelf => PutString["(self)"];
ENDCASE => PutName[ftb[fti].name];
RETURN
END;
PrintIndex: PROCEDURE [index: UNSPECIFIED] =
BEGIN PutString[" ["]; PutDecimal[index]; PutChar[']]; RETURN END;
PrintGarbage: PROCEDURE =
BEGIN
Tab[2];
PutString["? looks like garbage to me ..."];
PutCR[];
RETURN
END;
PrintAnonName: PROCEDURE = BEGIN PutString[" (anon) "]; RETURN END;
-- Utility Puts
PutName: PUBLIC PROCEDURE [n: NameRecord] =
BEGIN
ssd: String.SubStringDescriptor ←
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
PutSubString[@ssd];
RETURN
END;
Tab: PROCEDURE [n: CARDINAL] = BEGIN ListerDefs.Indent[n]; RETURN END;
PutInstanceName: PROCEDURE [n: Namee] =
BEGIN
FindName: PROCEDURE [ntb: Base, nti: NTIndex] RETURNS [BOOLEAN] =
BEGIN RETURN[ntb[nti].item = n]; END;
nti: NTIndex;
IF (nti ← EnumerateNameTable[FindName]) = NTNull THEN PrintAnonName[]
ELSE PutName[ntb[nti].name];
END;
EnumerateNameTable: PROCEDURE [
proc: PROCEDURE [Base, NTIndex] RETURNS [BOOLEAN]] RETURNS [nti: NTIndex] =
BEGIN
FOR nti ← FIRST[NTIndex], nti + SIZE[NTRecord] UNTIL nti = bcd.ntLimit DO
IF proc[ntb, nti] THEN RETURN[nti]; ENDLOOP;
RETURN[NTNull];
END;
-- IncorrectVersion: EXTERNAL SIGNAL;
Version: PROCEDURE [root: STRING] =
BEGIN
i: CARDINAL;
bcdfile: STRING ← [40];
seg: SegmentDefs.FileSegmentHandle;
BEGIN OPEN String;
AppendString[bcdfile, root];
FOR i IN [0..bcdfile.length) DO
IF bcdfile[i] = '. THEN EXIT;
REPEAT FINISHED => AppendString[bcdfile, ".bcd"];
ENDLOOP;
END;
BEGIN OPEN SegmentDefs;
seg ← NewFileSegment[
NewFile[bcdfile, Read, DefaultVersion ! FileNameError => GO TO NoFile], 1,
1, Read];
SwapIn[seg];
bcd ← FileSegmentAddress[seg];
[] ← OutputDefs.GetOutputStream[]; -- make sure Output is started
OutputDefs.outStream ← StreamDefs.GetDefaultDisplayStream[];
PutCR[];
ListerDefs.WriteVersions[
version: @bcd.version,
creator: @bcd.creator,
source: @bcd.sourceVersion];
IF bcd.versionIdent # VersionID THEN
BEGIN
PutString[" Obsolete VersionID = "];
PutDecimal[bcd.versionIdent]
END;
OutputDefs.outStream ← NIL;
Unlock[seg];
SwapOut[seg];
EXITS NoFile => IODefs.WriteString["File not found"];
END;
RETURN
END;
Stamps: PROCEDURE [root: STRING] =
BEGIN
i: CARDINAL;
bcdfile: STRING ← [40];
seg: SegmentDefs.FileSegmentHandle;
BEGIN OPEN String;
AppendString[bcdfile, root];
FOR i IN [0..bcdfile.length) DO
IF bcdfile[i] = '. THEN EXIT;
REPEAT FINISHED => AppendString[bcdfile, ".bcd"];
ENDLOOP;
END;
BEGIN OPEN SegmentDefs;
seg ← NewFileSegment[
NewFile[bcdfile, Read, DefaultVersion ! FileNameError => GO TO NoFile], 1,
1, Read];
InstallBcd[seg];
OpenOutput[root, ".bl"];
WriteBcdID[bcdfile, bcd];
PrintStamps[];
CloseOutput[];
UnstallBcd[seg];
EXITS NoFile => IODefs.WriteString["File not found"];
END;
RETURN
END;
Bcd: PROCEDURE [root: STRING] =
BEGIN
i: CARDINAL;
bcdfile: STRING ← [40];
seg: SegmentDefs.FileSegmentHandle;
BEGIN OPEN String;
AppendString[bcdfile, root];
FOR i IN [0..bcdfile.length) DO
IF bcdfile[i] = '. THEN EXIT;
REPEAT FINISHED => AppendString[bcdfile, ".bcd"];
ENDLOOP;
END;
BEGIN OPEN SegmentDefs;
seg ← NewFileSegment[
NewFile[bcdfile, Read, DefaultVersion ! FileNameError => GO TO NoFile], 1,
1, Read];
InstallBcd[seg];
OpenOutput[root, ".bl"];
WriteBcdID[bcdfile, bcd];
PrintBcd[];
CloseOutput[];
UnstallBcd[seg];
EXITS NoFile => IODefs.WriteString["File not found"];
END;
RETURN
END;
BcdLinks: PROCEDURE [root: STRING] =
BEGIN DumpLinks ← TRUE; Bcd[root]; DumpLinks ← FALSE; RETURN END;
BcdSegment: PROCEDURE [
root: STRING, base: AltoDefs.PageNumber, pages: AltoDefs.PageCount,
links: BOOLEAN] =
BEGIN
i: CARDINAL;
bcdfile: STRING ← [40];
seg: SegmentDefs.FileSegmentHandle;
DumpLinks ← links;
BEGIN OPEN String;
AppendString[bcdfile, root];
FOR i IN [0..bcdfile.length) DO
IF bcdfile[i] = '. THEN EXIT;
REPEAT FINISHED => AppendString[bcdfile, ".bcd"];
ENDLOOP;
END;
BEGIN OPEN SegmentDefs;
seg ← NewFileSegment[
NewFile[bcdfile, Read, DefaultVersion ! FileNameError => GO TO NoFile],
base, pages, Read ! InvalidSegmentSize => GO TO BadSegment];
InstallBcd[seg ! SwapError, SegmentFault => GO TO BadSegment];
OpenOutput[root, ".bl"];
WriteBcdID[bcdfile, bcd];
PrintBcd[];
CloseOutput[];
UnstallBcd[seg];
EXITS
NoFile => IODefs.WriteString["File not found"];
BadSegment => IODefs.WriteString["Bad Segment"];
END;
DumpLinks ← FALSE;
END;
DumpLinks: BOOLEAN ← FALSE;
Init: PROCEDURE =
BEGIN
command: CommanderDefs.CommandBlockHandle;
command ← CommanderDefs.AddCommand["Bcd", LOOPHOLE[Bcd], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["BcdLinks", LOOPHOLE[BcdLinks], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["Version", LOOPHOLE[Version], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.AddCommand["Stamps", LOOPHOLE[Stamps], 1];
command.params[0] ← [type: string, prompt: "Filename"];
command ← CommanderDefs.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"];
END;
Init[];
END....