DIRECTORY
Alloc: TYPE USING [Base, Handle, Notifier, Selector],
BasicTime: TYPE USING [GMT],
BcdDefs: TYPE,
ConvertUnsafe: TYPE USING [EqualSubStrings, SubString, SubStringToRope],
FileIO: TYPE USING [Open],
FileSegment: TYPE USING [Pages, nullPages],
FS: TYPE USING [Read, OpenFile, nullOpenFile],
IO: TYPE USING [card, CR, PutChar, Put, PutF, PutRope, rope, STREAM, time],
ListerUtil: TYPE USING [],
MessageWindow: TYPE USING [Append, Blink],
OSMiscOps: TYPE USING [FileError, FindFile],
PrincOps: TYPE USING [PageCount],
Rope: TYPE USING [Cat, Find, Flatten, Length, ROPE],
Symbols:
TYPE
USING [
bodyType, ctxType, Name, nullName, htType, ISEIndex, mdType,
SENull, seType, ssType],
SymbolSegment: TYPE USING [Base, extType, ltType, treeType, Tables],
SymbolTable: TYPE USING [Base],
UnsafeStorage: TYPE USING [GetSystemUZone],
VM: TYPE USING [AddressForPageNumber, Interval, nullInterval, Allocate, Free];
ListerUtilities:
PROGRAM
IMPORTS
ConvertUnsafe, FileIO, FS, IO, OSMiscOps, Rope, UnsafeStorage, VM
EXPORTS Alloc, ListerUtil = {
UnknownModule: PUBLIC ERROR = CODE;
version, creator, source: BcdDefs.VersionStamp;
filename: Rope.ROPE;
symbols: SymbolTable.Base;
bases: PRIVATE ARRAY SymbolSegment.Tables OF Alloc.Base;
SetRoutineSymbols:
PUBLIC
PROC [s: SymbolTable.Base] = {
OPEN s.stHandle;
symbase: SymbolSegment.Base ← LOOPHOLE[s.stHandle];
symbols ← s;
bases[SymbolSegment.treeType] ← symbase + treeBlock.offset;
bases[Symbols.seType] ← symbase + seBlock.offset;
bases[Symbols.htType] ← symbase + htBlock.offset;
bases[Symbols.ssType] ← symbase + ssBlock.offset;
bases[Symbols.ctxType] ← symbase + ctxBlock.offset;
bases[Symbols.mdType] ← symbase + mdBlock.offset;
bases[Symbols.bodyType] ← symbase + bodyBlock.offset;
bases[SymbolSegment.ltType] ← symbase + litBlock.offset;
bases[SymbolSegment.extType] ← symbase + extBlock.offset;
UpdateBases[]};
NotifyLink: TYPE = LONG POINTER TO NotifyNode;
NotifyNode: TYPE = RECORD [notifier: Alloc.Notifier, link: NotifyLink];
notifyList: NotifyLink ← NIL;
AddNotify:
PUBLIC
PROC [h: Alloc.Handle, proc: Alloc.Notifier] = {
p: NotifyLink =
(UnsafeStorage.GetSystemUZone[]).NEW[NotifyNode ← [notifier: proc, link: notifyList]];
notifyList ← p;
proc[DESCRIPTOR[bases]]};
DropNotify:
PUBLIC
PROC [h: Alloc.Handle, proc: Alloc.Notifier] = {
p, q: NotifyLink;
IF notifyList = NIL THEN RETURN;
p ← notifyList;
IF p.notifier = proc THEN notifyList ← p.link
ELSE {
DO
q ← p;
p ← p.link;
IF p = NIL THEN RETURN;
IF p.notifier = proc THEN EXIT
ENDLOOP;
q.link ← p.link};
(UnsafeStorage.GetSystemUZone[]).FREE[@p]};
UpdateBases:
PROC = {
FOR p: NotifyLink ← notifyList, p.link
UNTIL p =
NIL
DO
p.notifier[DESCRIPTOR[bases]] ENDLOOP};
Bounds:
PUBLIC
PROC [h: Alloc.Handle, table: Alloc.Selector]
RETURNS [base: Alloc.Base, size: CARDINAL] = {
OPEN symbols.stHandle;
RETURN [bases[table],
SELECT table
FROM
SymbolSegment.treeType => treeBlock.size,
Symbols.seType => seBlock.size,
Symbols.htType => htBlock.size,
Symbols.ssType => ssBlock.size,
Symbols.ctxType => ctxBlock.size,
Symbols.mdType => mdBlock.size,
Symbols.bodyType => bodyBlock.size,
SymbolSegment.ltType => litBlock.size,
SymbolSegment.extType => extBlock.size,
ENDCASE => ERROR]};
SetExtension:
PUBLIC
PROC [root, extension: Rope.
ROPE]
RETURNS[name: Rope.
ROPE]= {
IF Rope.Find[root, "."] < 0 THEN root ← Rope.Cat[root, ".", extension];
CreateStream:
PUBLIC
PROC [name: Rope.
ROPE]
RETURNS [
IO.
STREAM] = {
RETURN [FileIO.Open[name]]};
LoadBcd:
PUBLIC
PROC [fileId: Rope.
ROPE]
RETURNS [bcd: FileSegment.Pages] = {
file: FS.OpenFile;
file ← OSMiscOps.FindFile[fileId, $read ! OSMiscOps.FileError => {GO TO noFile}];
filename ← fileId;
bcd ← ReadHeader[file];
RETURN
EXITS noFile => bcd ← FileSegment.nullPages};
LoadModule:
PUBLIC
PROC [bcd: FileSegment.Pages, typeId: Rope.
ROPE]
RETURNS [mti: BcdDefs.MTIndex, code, symbols: FileSegment.Pages] = {
mti ← BcdDefs.MTNull; code ← symbols ← FileSegment.nullPages;
IF bcd # FileSegment.nullPages
THEN {
BcdBase:
PROC [p:
LONG
POINTER]
RETURNS [BcdDefs.Base] =
INLINE {
RETURN [LOOPHOLE[p, BcdDefs.Base]]};
bcdInterval: VM.Interval = MapPages[bcd];
bcdBase: BcdDefs.BcdBase = VM.AddressForPageNumber[bcdInterval.page];
mtb: BcdDefs.Base = BcdBase[bcdBase + bcdBase.mtOffset];
ftb: BcdDefs.Base = BcdBase[bcdBase + bcdBase.ftOffset];
sgb: BcdDefs.Base = BcdBase[bcdBase + bcdBase.sgOffset];
nString: BcdDefs.NameString = LOOPHOLE[bcdBase + bcdBase.ssOffset];
AcquireFile:
PROC [fti: BcdDefs.FTIndex]
RETURNS [file:
FS.OpenFile] = {
IF fti = BcdDefs.FTSelf THEN file ← [bcd.file]
ELSE {
d: ConvertUnsafe.SubString ← [@nString.string, TRASH, TRASH];
fileName: Rope.ROPE;
fileInterval: VM.Interval;
fileBase: BcdDefs.BcdBase;
d.offset ← ftb[fti].name; d.length ← nString.size[ftb[fti].name];
fileName ← ConvertUnsafe.SubStringToRope[d];
fileName ← SetExtension[fileName, "bcd"];
file ← OSMiscOps.FindFile[fileName, $read
! OSMiscOps.FileError => {GO TO NoFile}];
fileInterval ← MapPages[[file, [base: 0, pages: 1]]];
fileBase ← VM.AddressForPageNumber[fileInterval.page];
IF fileBase.versionIdent # BcdDefs.VersionID
OR fileBase.version # ftb[fti].version
THEN {
VM.Free[fileInterval]; GO TO BadFile};
VM.Free[fileInterval];
EXITS
NoFile, BadFile => file ← FS.nullOpenFile};
RETURN};
d1: ConvertUnsafe.SubString;
d2: ConvertUnsafe.SubString ← [@nString.string, TRASH, TRASH];
d1.offset ← 0;
d1.length ← typeId.Length[];
d1.base ← LOOPHOLE[Rope.Flatten[typeId]];
mti ← BcdDefs.MTIndex.FIRST;
UNTIL mti = bcdBase.mtLimit
DO
d2.offset ← mtb[mti].name; d2.length ← nString.size[mtb[mti].name];
IF ConvertUnsafe.EqualSubStrings[d1, d2, FALSE] THEN EXIT;
mti ← mti + (
WITH m: mtb[mti]
SELECT
FROM
direct => BcdDefs.MTRecord.direct.SIZE + m.length*BcdDefs.Link.SIZE,
indirect => BcdDefs.MTRecord.indirect.SIZE,
multiple => BcdDefs.MTRecord.multiple.SIZE,
ENDCASE => ERROR);
REPEAT
FINISHED =>
IF bcdBase.nModules = 1 THEN mti ← BcdDefs.MTIndex.FIRST
ELSE {FreeInterval[bcdInterval]; ERROR UnknownModule};
ENDLOOP;
IF ~bcdBase.definitions
THEN {
code.file ← AcquireFile[sgb[mtb[mti].code.sgi].file];
IF code.file #
FS.nullOpenFile
THEN
code.span ← [sgb[mtb[mti].code.sgi].base, sgb[mtb[mti].code.sgi].pages]};
IF sgb[mtb[mti].sseg].pages # 0
THEN {
symbols.file ← AcquireFile[sgb[mtb[mti].sseg].file];
IF symbols.file #
FS.nullOpenFile
THEN
symbols.span ← [
sgb[mtb[mti].sseg].base,
sgb[mtb[mti].sseg].pages + sgb[mtb[mti].sseg].extraPages]};
FreeInterval[bcdInterval]};
RETURN};
MapPages:
PUBLIC
PROC [pages: FileSegment.Pages]
RETURNS [s:
VM.Interval] = {
IF pages = FileSegment.nullPages THEN s ← VM.nullInterval
ELSE {
pointer: LONG POINTER;
s ← VM.Allocate[pages.span.pages];
pointer ← VM.AddressForPageNumber[s.page];
FS.Read[file: [pages.file], from: pages.span.base, nPages: pages.span.pages, to: pointer]};
RETURN};
FreeInterval:
PUBLIC
PROC [s:
VM.Interval] = {
IF s # VM.nullInterval THEN VM.Free[s]};
ReadHeader:
PROC [file:
FS.OpenFile]
RETURNS [
bcdPages: FileSegment.Pages ← FileSegment.nullPages] = {
headerInterval: VM.Interval ← VM.nullInterval;
DeleteHeader:
PROC = {
IF headerInterval #
VM.nullInterval
THEN {
VM.Free[headerInterval];
headerInterval ← VM.nullInterval}};
IF file #
FS.nullOpenFile
THEN {
ENABLE {
UNWIND => {NULL};
ANY => {GO TO badFile}};
BcdBase:
PROC [p:
LONG
POINTER]
RETURNS [BcdDefs.Base] =
INLINE {
RETURN [LOOPHOLE[p, BcdDefs.Base]]};
bcd: BcdDefs.BcdBase;
nPages: CARDINAL ← 8;
DO
headerInterval ← VM.Allocate[nPages];
bcd ← VM.AddressForPageNumber[headerInterval.page];
FS.Read[file: file, from: 0, nPages: nPages, to: bcd];
IF bcd.versionIdent # BcdDefs.VersionID THEN GO TO badFile;
IF nPages >= bcd.nPages THEN EXIT;
nPages ← bcd.nPages;
VM.Free[headerInterval]; headerInterval ← VM.nullInterval
ENDLOOP;
bcdPages ← [file, [0, bcd.nPages]];
version ← bcd.version;
creator ← bcd.creator;
source ← bcd.sourceVersion;
DeleteHeader[];
EXITS
badFile => {DeleteHeader[]; bcdPages ← FileSegment.nullPages}};
RETURN};
PutVersionId:
PUBLIC
PROC [out:
IO.
STREAM, stamp: BcdDefs.VersionStamp] = {
OPEN IO;
StampWords: CARDINAL = BcdDefs.VersionStamp.SIZE;
str: PACKED ARRAY [0..4*StampWords) OF [0..16) = LOOPHOLE[stamp];
digit: STRING = "0123456789abcdef"L;
PutChar[out, '"];
FOR i: NAT IN [0..4*StampWords) DO PutChar[out, digit[str[i]]] ENDLOOP;
IO.Put[out, IO.rope["\" ("], IO.time[LOOPHOLE[stamp.time]], IO.rope[", "]];
PutMachine[out, stamp];
PutChar[out, ')]};
WriteOneVersion:
PROC [
out: IO.STREAM,
version: LONG POINTER TO BcdDefs.VersionStamp, tag: Rope.ROPE] = {
OPEN IO;
IF version = NIL THEN RETURN;
PutRope[out, tag];
PutTime[out, LOOPHOLE[version.time]];
PutRope[out, " on "];
PutMachine[out, version^];
PutChar[out, IO.CR]};
PutVersions:
PUBLIC
PROC [
out: IO.STREAM,
version, creator, source: LONG POINTER TO BcdDefs.VersionStamp ← NIL] = {
WriteOneVersion[out, version, " created "];
WriteOneVersion[out, creator, " creator "];
WriteOneVersion[out, source, " source "];
IO.PutChar[out, '\n]};
PutTime:
PUBLIC
PROC [out:
IO.
STREAM, time: BasicTime.
GMT] = {
IO.Put[out, IO.time[time]]};
PutMachine:
PUBLIC
PROC [out:
IO.
STREAM, stamp: BcdDefs.VersionStamp] = {
out.PutF["%b#%b#", IO.card[stamp.net], IO.card[stamp.host]]};
PutFileID:
PUBLIC
PROC [out:
IO.
STREAM] = {
OPEN IO;
PutRope[out, filename];
PutRope[out, ", version "]; PutVersionId[out, version];
PutRope[out, "\n source "]; PutTime[out, LOOPHOLE[source.time]];
PutRope[out, "\n creator "]; PutVersionId[out, creator];
PutRope[out, "\n\n"]};
PutHti:
PUBLIC
PROC [out:
IO.
STREAM, name: Symbols.Name] = {
OPEN IO;
IF name = Symbols.nullName THEN {PutRope[out, "(anonymous)"]; RETURN}
ELSE out.PutRope[ConvertUnsafe.SubStringToRope[symbols.SubStringForName[name]]]};
PutSei:
PUBLIC
PROC [out:
IO.
STREAM, sei: Symbols.ISEIndex] = {
PutHti[out, IF sei = Symbols.SENull THEN Symbols.nullName ELSE symbols.seb[sei].hash]};
TTY interface
tty: IO.STREAM;
Message:
PUBLIC
PROC [s: Rope.
ROPE] = {
IF tty #
NIL
THEN tty.PutRope[s]};
ELSE {MessageWindow.Append[s, TRUE]; MessageWindow.Blink[]}};
SetTypescript: PUBLIC PROC [typescript: IO.STREAM] = {tty ← typescript};
GetTypescript: PUBLIC PROC RETURNS [IO.STREAM] = {RETURN[tty]};
}.