-- ListUnbound.Mesa Edited by Sweet on July 8, 1980 9:42 AM
DIRECTORY
AltoDefs: FROM "altodefs",
BcdDefs USING [
Base, BCD, EXPIndex, EXPRecord, FTIndex, FTNull, FTSelf, NameRecord, NullName,
VersionID],
BcdOps USING [NameString],
CommanderDefs USING [AddCommand, CommandBlockHandle],
IODefs USING [WriteString],
ListerDefs USING [
FileSegmentHandle, IncorrectVersion, Indent, Load, MultipleModules, NoCode,
NoFGT, NoSymbols, PrintMachine, PrintSei, SetRoutineSymbols],
OutputDefs USING [
CloseOutput, OpenOutput, PutCR, PutDecimal, PutString, PutSubString, PutTime],
SegmentDefs USING [
DefaultVersion, DeleteFileSegment, FileNameError, FileSegmentAddress,
FileSegmentHandle, MoveFileSegment, NewFile, NewFileSegment, Read, SwapError,
SwapIn, SwapOut, Unlock],
String USING [AppendString, AppendSubString, SubStringDescriptor],
Symbols USING [ISEIndex, ISENull],
SymbolTable USING [Acquire, Base, Release, TableForSegment];
ListUnbound: PROGRAM
IMPORTS
CommanderDefs, IODefs, ListerDefs, OutputDefs, SegmentDefs, String,
SymbolTable
EXPORTS ListerDefs =
BEGIN OPEN OutputDefs, BcdDefs;
bcd: POINTER TO BCD;
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: 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;
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 # BcdDefs.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;
PrintUnbound: PROCEDURE =
BEGIN
eti: EXPIndex ← FIRST[EXPIndex];
UNTIL eti = bcd.expLimit DO
CheckExport[
eti !
SegmentDefs.FileNameError =>
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: SegmentDefs.FileSegmentHandle ← NIL;
loaded: BOOLEAN ← FALSE;
LoadSymbols: PROCEDURE [file: FTIndex] =
BEGIN OPEN ListerDefs;
s: STRING ← [60];
cseg: SegmentDefs.FileSegmentHandle;
IF file = FTNull OR file = FTSelf OR symbols # NIL OR sseg # NIL THEN ERROR;
GetBcdName[s, ftb[file].name];
[code: cseg, symbols: sseg] ← Load[s ! NoCode, NoFGT => RESUME ];
IF cseg # NIL THEN SegmentDefs.DeleteFileSegment[cseg];
symbols ← SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
SetRoutineSymbols[symbols];
loaded ← TRUE;
END;
UnloadSymbols: PROCEDURE =
BEGIN OPEN SegmentDefs;
IF symbols # NIL THEN SymbolTable.Release[symbols];
IF sseg # NIL THEN DeleteFileSegment[sseg ! SwapError => CONTINUE];
symbols ← NIL;
sseg ← 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: String.SubStringDescriptor ←
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
s.length ← 0;
String.AppendSubString[s, @ssd];
FOR i IN [0..s.length) DO IF s[i] = '. THEN RETURN ENDLOOP;
String.AppendString[s, ".bcd"L];
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;
UnboundExports: 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, ".xl"L];
WriteBcdID[bcdfile, bcd];
PrintUnbound[];
CloseOutput[];
UnstallBcd[seg];
EXITS NoFile => IODefs.WriteString["File not found"];
END;
RETURN
END;
Init: PROCEDURE =
BEGIN
command: CommanderDefs.CommandBlockHandle;
command ← CommanderDefs.AddCommand[
"UnboundExports", LOOPHOLE[UnboundExports], 1];
command.params[0] ← [type: string, prompt: "Bcd name"];
END;
Init[];
END....