DIRECTORY
BcdDefs:
TYPE
USING [
Base, BCD, EXPIndex, EXPRecord, FTIndex, FTNull, FTSelf,
NameRecord, NullName],
BcdOps: TYPE USING [BcdBase, NameString],
CommanderOps: TYPE USING [AddCommand, CommandBlockHandle],
FileSegment: TYPE USING [Pages],
ListerDefs:
TYPE
USING [
IncorrectVersion, Indent, Load, MapPages, MultipleModules, NoCode, NoFGT,
NoFile, NoSymbols, PrintSei, SetRoutineSymbols, WriteString, WriteVersionId],
OSMiscOps: TYPE USING [FileError, FindFile],
OutputDefs:
TYPE
USING [
CloseOutput, OpenOutput, PutCR, PutString, PutLongSubString],
Space: TYPE USING [Handle, Delete, LongPointer],
Strings: TYPE USING [AppendString, AppendSubString, SubStringDescriptor],
Symbols: TYPE USING [ISEIndex, ISENull],
SymbolTable: TYPE USING [Acquire, Base, Release];
ListUnbound:
PROGRAM
IMPORTS
CommanderOps, ListerDefs, Strings, OSMiscOps, OutputDefs, Space, SymbolTable =
BEGIN OPEN OutputDefs, BcdDefs;
bcdSpace: Space.Handle;
bcd: BcdOps.BcdBase;
tb: Base;
ssb: BcdOps.NameString;
evb: Base;
spb: Base;
ctb: Base;
mtb: Base;
itb: Base;
etb: Base;
sgb: Base;
ftb: Base;
ntb: Base;
InstallBcd:
PROCEDURE [seg: FileSegment.Pages] =
BEGIN
DO
nPages: CARDINAL;
bcdSpace ← ListerDefs.MapPages[seg];
bcd ← bcdSpace.LongPointer;
IF (nPages ← bcd.nPages) = seg.span.pages THEN EXIT;
seg.span.pages ← nPages;
Space.Delete[bcdSpace];
ENDLOOP;
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;
RETURN
END;
UnstallBcd:
PROCEDURE [seg: FileSegment.Pages] =
BEGIN
Space.Delete[bcdSpace];
RETURN
END;
WriteBcdID:
PROCEDURE [name:
STRING, bcd: BcdOps.BcdBase] =
BEGIN
PutString[name];
PutString[", version "L]; ListerDefs.WriteVersionId[bcd.version];
IF bcd.source # BcdDefs.NullName
THEN
BEGIN PutString[", source "L]; PutName[bcd.source] END;
PutString["\n creator "L];
ListerDefs.WriteVersionId[bcd.creator];
PutCR[]; PutCR[];
END;
PrintUnbound:
PROCEDURE =
BEGIN
eti: EXPIndex ← FIRST[EXPIndex];
UNTIL eti = bcd.expLimit
DO
CheckExport[
eti !
ListerDefs.NoFile =>
BEGIN OPEN etb[eti];
PutString["Can't find "L];
PutName[ftb[file].name];
PutCR[];
CONTINUE
END;
ListerDefs.MultipleModules =>
BEGIN OPEN etb[eti];
PutString["Bad format for "L];
PutName[ftb[file].name];
PutCR[];
CONTINUE
END;
ListerDefs.NoSymbols =>
BEGIN OPEN etb[eti];
PutString["No symbols for "L];
PutName[ftb[file].name];
PutCR[];
CONTINUE
END;
ListerDefs.IncorrectVersion =>
BEGIN OPEN etb[eti];
PutString["Wrong version: "L];
PutName[ftb[file].name];
PutCR[];
CONTINUE
END];
UnloadSymbols[];
eti ← eti + etb[eti].size + SIZE[EXPRecord];
IF
LOOPHOLE[eti,
CARDINAL] >
LOOPHOLE[bcd.expLimit,
CARDINAL]
THEN
GO TO Bogus;
REPEAT Bogus => PrintGarbage[];
ENDLOOP;
RETURN
END;
CheckExport:
PUBLIC
PROCEDURE [eti: EXPIndex] =
BEGIN OPEN etb[eti];
i: CARDINAL;
n: CARDINAL ← 0;
sei: Symbols.ISEIndex;
FOR i
IN [0..size)
DO
IF links[i].gfi = 0
THEN
BEGIN
IF ~loaded THEN LoadSymbols[file];
sei ← SeiForItem[i];
IF sei = Symbols.ISENull THEN LOOP;
IF n = 0
THEN
BEGIN
PutString["Unbound exports to "L];
PutName[name];
PutString[": "L];
END;
IF n MOD 3 = 0 THEN Tab[2] ELSE PutString[", "L];
n ← n + 1;
ListerDefs.PrintSei[sei];
END;
ENDLOOP;
IF n # 0 THEN BEGIN PutCR[]; PutCR[]; END;
RETURN
END;
SeiForItem:
PROCEDURE [item:
CARDINAL]
RETURNS [sei: Symbols.ISEIndex] =
BEGIN OPEN symbols;
FOR sei ← FirstCtxSe[stHandle.outerCtx], NextSe[sei]
UNTIL sei =
Symbols.ISENull DO
IF seb[sei].idValue = item
THEN
SELECT LinkMode[
sei] FROM
val => IF seb[sei].extended THEN RETURN[Symbols.ISENull] ELSE RETURN;
ref => RETURN[sei];
manifest => LOOP; -- constant
ENDCASE => RETURN[Symbols.ISENull];
ENDLOOP;
ERROR;
END;
symbols: SymbolTable.Base ← NIL;
sseg: FileSegment.Pages;
loaded: BOOLEAN ← FALSE;
LoadSymbols:
PROCEDURE [file: FTIndex] =
BEGIN OPEN ListerDefs;
s: STRING ← [60];
IF file = FTNull OR file = FTSelf OR symbols # NIL THEN ERROR;
GetBcdName[s, ftb[file].name];
[symbols: sseg] ← Load[s ! NoCode, NoFGT => RESUME ];
symbols ← SymbolTable.Acquire[sseg];
SetRoutineSymbols[symbols];
loaded ← TRUE;
END;
UnloadSymbols:
PROCEDURE =
BEGIN
IF symbols # NIL THEN SymbolTable.Release[symbols];
symbols ← NIL;
loaded ← FALSE;
END;
Utility Prints
PrintGarbage:
PROCEDURE =
BEGIN
Tab[2];
PutString["? looks like garbage to me ..."];
PutCR[];
RETURN
END;
GetBcdName:
PUBLIC
PROCEDURE [s:
STRING, n: NameRecord] =
BEGIN
i: CARDINAL;
ssd: Strings.SubStringDescriptor ←
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
s.length ← 0;
Strings.AppendSubString[s, @ssd];
FOR i IN [0..s.length) DO IF s[i] = '. THEN RETURN ENDLOOP;
Strings.AppendString[s, ".bcd"L];
RETURN
END;
Utility Puts
PutName:
PUBLIC
PROCEDURE [n: NameRecord] =
BEGIN
ssd: Strings.SubStringDescriptor ←
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
PutLongSubString[@ssd];
RETURN
END;
Tab: PROCEDURE [n: CARDINAL] = BEGIN ListerDefs.Indent[n]; RETURN END;
UnboundExports:
PROCEDURE [root:
STRING] =
BEGIN
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;
BEGIN
seg ← [
file: OSMiscOps.FindFile[bcdfile, ! OSMiscOps.FileError => GO TO NoFile],
span: [base: 1, pages: 1]];
InstallBcd[seg];
OpenOutput[root, ".xl"L];
WriteBcdID[bcdfile, bcd];
PrintUnbound[];
CloseOutput[];
UnstallBcd[seg];
EXITS NoFile => ListerDefs.WriteString["File not found"L];
END;
RETURN
END;
Init:
PROCEDURE =
BEGIN
command: CommanderOps.CommandBlockHandle;
command ← CommanderOps.AddCommand[
"UnboundExports", LOOPHOLE[UnboundExports], 1];
command.params[0] ← [type: string, prompt: "Bcd name"];
END;
Init[];
END....