DIRECTORY
Alloc: TYPE USING [Base, Notifier, Selector],
BcdDefs: TYPE,
BcdOps: TYPE USING [BcdBase, MTHandle, NameString],
CommanderOps: TYPE USING [InitCommander, WaitCommands],
Environment: TYPE USING [PageCount],
Exec: TYPE USING [AddCommand, w],
File: TYPE USING [Capability, nullCapability],
FileSegment: TYPE USING [Pages, nullPages],
Format: TYPE USING [NumberFormat],
Heap: TYPE USING [systemZone],
ListerDefs: TYPE USING [],
OSMiscOps: TYPE USING [BcdCreateTime, FileError, FindFile],
OutputDefs:
TYPE
USING [
PutChar, PutNumber, PutLongSubString, PutString, PutTime],
Space:
TYPE
USING [
Handle, nullHandle, virtualMemory, Create, Delete, LongPointer, Map],
Strings:
TYPE
USING [
AppendString, AppendSubString, EquivalentSubStrings,
SubString, SubStringDescriptor],
Symbols:
TYPE
USING [
bodyType, ctxType, HTIndex, HTNull, htType, ISEIndex, mdType,
SENull, seType, ssType],
SymbolSegment: TYPE USING [Base, extType, ltType, treeType, Tables],
SymbolTable: TYPE USING [Base],
Time: TYPE USING [Append, Unpack],
TTY: TYPE USING [PutChar, PutDecimal, PutLine, PutOctal, PutString];
ListerRoutines:
PROGRAM
IMPORTS
CommanderOps, Exec, Heap, OSMiscOps, OutputDefs,
Space, Strings, Time, TTY
EXPORTS ListerDefs = {
OPEN OutputDefs;
NoFile: PUBLIC SIGNAL = CODE;
IncorrectVersion: PUBLIC SIGNAL = CODE;
NoFGT: PUBLIC SIGNAL = CODE;
NoCode: PUBLIC SIGNAL = CODE;
NoSymbols: PUBLIC SIGNAL = CODE;
MultipleModules: PUBLIC SIGNAL = CODE;
version, creator, source: BcdDefs.VersionStamp;
Dstar: BOOLEAN;
filename: STRING;
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 [proc: Alloc.Notifier] = {
p: NotifyLink =
(Heap.systemZone).NEW[NotifyNode ← [notifier: proc, link: notifyList]];
notifyList ← p;
proc[DESCRIPTOR[bases]]};
DropNotify:
PUBLIC
PROC [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};
(Heap.systemZone).FREE[@p]};
UpdateBases:
PROC = {
FOR p: NotifyLink ← notifyList, p.link
UNTIL p =
NIL
DO
p.notifier[DESCRIPTOR[bases]] ENDLOOP};
Bounds:
PUBLIC
PROC [table: Alloc.Selector]
RETURNS [base: Alloc.Base, size: CARDINAL] = {
OPEN symbols.stHandle;
SELECT table
FROM
SymbolSegment.treeType => RETURN [bases[table], treeBlock.size];
Symbols.seType => RETURN [bases[table], seBlock.size];
Symbols.htType => RETURN [bases[table], htBlock.size];
Symbols.ssType => RETURN [bases[table], ssBlock.size];
Symbols.ctxType => RETURN [bases[table], ctxBlock.size];
Symbols.mdType => RETURN [bases[table], mdBlock.size];
Symbols.bodyType => RETURN [bases[table], bodyBlock.size];
SymbolSegment.ltType => RETURN [bases[table], litBlock.size];
SymbolSegment.extType => RETURN [bases[table], extBlock.size];
ENDCASE => ERROR};
LoadFromConfig:
PUBLIC
PROC [configName, moduleName:
STRING]
RETURNS [code, symbols, bcd: FileSegment.Pages, mti: BcdDefs.MTIndex] = {
OPEN BcdDefs;
configFile, codeFile, symsFile: File.Capability;
bcdSpace: Space.Handle ← Space.nullHandle;
code ← symbols ← FileSegment.nullPages; Dstar ← TRUE;
configFile ← OSMiscOps.FindFile[configName
! OSMiscOps.FileError => {GOTO noFile}];
filename ← configName;
codeFile ← symsFile ← configFile;
bcd ← ReadHeader[configFile];
IF bcd # FileSegment.nullPages
THEN {
ENABLE
UNWIND => {IF bcdSpace # Space.nullHandle THEN Space.Delete[bcdSpace]};
bcdBase: BcdOps.BcdBase;
sgb, mtb, ftb: BcdDefs.Base;
ssb: BcdOps.NameString;
mtLimit: BcdDefs.MTIndex;
mh: BcdOps.MTHandle;
sfi, cfi: BcdDefs.FTIndex;
ss1, ss2: Strings.SubStringDescriptor;
SearchModules:
PROC [test:
PROC [BcdDefs.MTIndex]
RETURNS [
BOOLEAN]]
RETURNS [BcdDefs.MTIndex] = {
here to avoid dependencies on operations from BcdOps
next: MTIndex;
FOR mti ←
FIRST[BcdDefs.MTIndex], next
UNTIL mti = mtLimit
DO
IF test[mti] THEN RETURN [mti];
next ← mti + (
WITH m: mtb[mti]
SELECT
FROM
direct => SIZE[direct BcdDefs.MTRecord] + m.length*SIZE[BcdDefs.Link],
indirect => SIZE[indirect BcdDefs.MTRecord],
multiple => SIZE[multiple BcdDefs.MTRecord],
ENDCASE => ERROR);
ENDLOOP;
RETURN [BcdDefs.MTNull]};
CheckModule:
PROC [mti: BcdDefs.MTIndex]
RETURNS [
BOOLEAN] = {
ss2.offset ← mtb[mti].name;
ss2.length ← ssb.size[mtb[mti].name];
RETURN [Strings.EquivalentSubStrings[@ss1, @ss2]]};
bcdSpace ← MapPages[bcd]; bcdBase ← bcdSpace.LongPointer[];
ss1 ← [base: moduleName, offset: 0, length: moduleName.length];
version ← bcdBase.version;
creator ← bcdBase.creator;
source ← bcdBase.sourceVersion;
sgb ← LOOPHOLE[bcdBase + bcdBase.sgOffset];
mtb ← LOOPHOLE[bcdBase + bcdBase.mtOffset]; mtLimit ← bcdBase.mtLimit;
ssb ← LOOPHOLE[bcdBase + bcdBase.ssOffset];
ftb ← LOOPHOLE[bcdBase + bcdBase.ftOffset];
ss2.base ← @ssb.string;
mti ← SearchModules[CheckModule];
IF mti = MTNull THEN SIGNAL NoCode
ELSE {
mh ← @mtb[mti];
Dstar ← ~mh.altoCode;
cfi ← sgb[mh.code.sgi].file;
IF cfi # FTSelf
THEN {
codeFileName: STRING ← [40];
codeSpace: Space.Handle;
fileVersion: BcdDefs.VersionStamp;
cfilebase: BcdOps.BcdBase;
ss2.offset ← ftb[cfi].name;
ss2.length ← ssb.size[ftb[cfi].name];
Strings.AppendSubString[codeFileName, @ss2];
FOR i:
CARDINAL
IN [0..codeFileName.length)
DO
IF codeFileName[i] = '. THEN EXIT;
REPEAT FINISHED => Strings.AppendString[codeFileName, ".bcd"L];
ENDLOOP;
codeFile ← OSMiscOps.FindFile[codeFileName
! OSMiscOps.FileError => {GO TO noCode}];
code ← [codeFile, [base: 1, pages: 1]];
codeSpace ← MapPages[code];
cfilebase ← codeSpace.LongPointer;
fileVersion ← cfilebase.version;
Space.Delete[codeSpace];
IF fileVersion # ftb[cfi].version THEN GOTO noCode};
code ← [
file: codeFile,
span: [base: sgb[mh.code.sgi].base, pages: sgb[mh.code.sgi].pages]];
EXITS
noCode => SIGNAL NoCode};
IF mti = MTNull OR sgb[mh.sseg].pages = 0 THEN SIGNAL NoSymbols
ELSE {
sfi ← sgb[mh.sseg].file;
IF sfi # FTSelf
THEN {
symsFileName: STRING ← [40];
ss2.offset ← ftb[sfi].name;
ss2.length ← ssb.size[ftb[sfi].name];
Strings.AppendSubString[symsFileName, @ss2];
FOR i:
CARDINAL
IN [0..symsFileName.length)
DO
IF symsFileName[i] = '. THEN EXIT;
REPEAT FINISHED => Strings.AppendString[symsFileName, ".bcd"L];
ENDLOOP;
symsFile ← OSMiscOps.FindFile[symsFileName
! OSMiscOps.FileError => {GOTO noSymbols}]};
IF sgb[mh.sseg].extraPages = 0 THEN SIGNAL NoFGT;
IF sfi # FTSelf
THEN {
symsSpace: Space.Handle;
sfilebase: BcdOps.BcdBase;
fileVersion: BcdDefs.VersionStamp;
symbols ← [symsFile, [base: 1, pages: 1]];
symsSpace ← MapPages[symbols];
sfilebase ← symsSpace.LongPointer;
fileVersion ← sfilebase.version;
Space.Delete[symsSpace];
IF fileVersion # ftb[sfi].version THEN GOTO noSymbols};
symbols ← [
file: symsFile,
span: [
base: sgb[mh.sseg].base,
pages: sgb[mh.sseg].pages+sgb[mh.sseg].extraPages]];
EXITS
noSymbols => SIGNAL NoSymbols};
Space.Delete[bcdSpace]};
RETURN
EXITS
noFile => {SIGNAL NoFile; bcd ← FileSegment.nullPages}};
Load:
PUBLIC
PROC [name:
STRING]
RETURNS [code, symbols, bcd: FileSegment.Pages] = {
file: File.Capability;
code ← symbols ← FileSegment.nullPages; Dstar ← TRUE;
file ← OSMiscOps.FindFile[name ! OSMiscOps.FileError => {GO TO noFile}];
filename ← name;
bcd ← ReadHeader[file];
IF bcd # FileSegment.nullPages
THEN {
bcdSpace: Space.Handle = MapPages[bcd];
bcdBase: BcdOps.BcdBase = bcdSpace.LongPointer[];
mh: BcdOps.MTHandle;
sgb: BcdDefs.Base;
version ← bcdBase.version;
creator ← bcdBase.creator;
source ← bcdBase.sourceVersion;
mh ← @LOOPHOLE[bcdBase + bcdBase.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
Dstar ← ~mh.altoCode;
sgb ← LOOPHOLE[bcdBase + bcdBase.sgOffset];
IF bcdBase.nModules # 1 THEN SIGNAL MultipleModules;
IF bcdBase.definitions THEN code ← FileSegment.nullPages
ELSE code ← [bcd.file, [sgb[mh.code.sgi].base, sgb[mh.code.sgi].pages]];
IF sgb[mh.sseg].pages = 0 THEN symbols ← FileSegment.nullPages
ELSE {
IF sgb[mh.sseg].extraPages = 0 THEN SIGNAL NoFGT;
symbols ← [
bcd.file,
[sgb[mh.sseg].base, sgb[mh.sseg].pages + sgb[mh.sseg].extraPages]]};
DeleteSpace[bcdSpace]};
RETURN
EXITS
noFile => {SIGNAL NoFile; bcd ← FileSegment.nullPages}};
MapPages:
PUBLIC
PROC [pages: FileSegment.Pages]
RETURNS [s: Space.Handle] = {
IF pages = FileSegment.nullPages THEN s ← Space.nullHandle
ELSE {
s ← Space.Create[size: pages.span.pages, parent: Space.virtualMemory];
s.Map[window: [file: pages.file, base: pages.span.base]]};
RETURN};
DeleteSpace:
PUBLIC
PROC [s: Space.Handle] = {
IF s # Space.nullHandle THEN Space.Delete[s]};
ReadHeader:
PROC [file: File.Capability]
RETURNS [
bcdPages: FileSegment.Pages ← FileSegment.nullPages] = {
headerSpace: Space.Handle ← Space.nullHandle;
DeleteHeader:
PROC = {
IF headerSpace # Space.nullHandle
THEN {
Space.Delete[headerSpace];
headerSpace ← Space.nullHandle}};
IF file # File.nullCapability
THEN {
ENABLE {
UNWIND => {NULL};
ANY => {GO TO badFile}};
BcdBase:
PROC [p:
LONG
POINTER]
RETURNS [BcdDefs.Base] =
INLINE {
RETURN [LOOPHOLE[p, BcdDefs.Base]]};
bcd: BcdOps.BcdBase;
nPages: CARDINAL ← 8;
DO
headerSpace ← Space.Create[size: nPages, parent: Space.virtualMemory];
headerSpace.Map[window: [file: file, base: 1]];
bcd ← headerSpace.LongPointer[];
IF bcd.versionIdent # BcdDefs.VersionID THEN GO TO badFile;
IF nPages >= bcd.nPages THEN EXIT;
nPages ← bcd.nPages;
Space.Delete[headerSpace]; headerSpace ← Space.nullHandle
ENDLOOP;
bcdPages ← [file, [1, bcd.nPages]];
DeleteHeader[];
EXITS
badFile => {DeleteHeader[]; bcdPages ← FileSegment.nullPages}};
RETURN};
WriteVersionId:
PUBLIC
PROC [stamp: BcdDefs.VersionStamp] = {
StampWords: CARDINAL = SIZE[BcdDefs.VersionStamp];
str: PACKED ARRAY [0..4*StampWords) OF [0..16) = LOOPHOLE[stamp];
digit: STRING = "0123456789abcdef"L;
PutChar['"];
FOR i: NAT IN [0..4*StampWords) DO PutChar[digit[str[i]]] ENDLOOP;
PutString["\" ("L];
PutTime[[stamp.time]]; PutString[", "L]; PrintMachine[stamp];
PutChar[')]};
WriteOneVersion:
PROC [
version: LONG POINTER TO BcdDefs.VersionStamp, tag: STRING] = {
OPEN OutputDefs;
IF version = NIL THEN RETURN;
PutString[tag];
PutTime[[version.time]];
PutString[" on "L];
PrintMachine[version^];
PutChar['\n]};
WriteVersions:
PUBLIC
PROC [
version, creator, source: LONG POINTER TO BcdDefs.VersionStamp ← NIL] = {
WriteOneVersion[version, " created "L];
WriteOneVersion[creator, " creator "L];
WriteOneVersion[source, " source "L];
OutputDefs.PutChar['\n]};
PrintMachine:
PUBLIC
PROC [stamp: BcdDefs.VersionStamp] = {
octal: Format.NumberFormat = [8, FALSE, FALSE, 1];
PutNumber[stamp.net, octal]; PutChar['#];
PutNumber[stamp.host, octal]; PutChar['#]};
WriteFileID:
PUBLIC
PROC = {
PutString[filename];
IF ~Dstar THEN PutString[" (/A)"L];
PutString[", version "L]; WriteVersionId[version];
PutString["\n source "L]; PutTime[[source.time]];
PutString["\n creator "L]; WriteVersionId[creator];
PutString["\n\n"L]};
PrintHti:
PUBLIC
PROC [hti: Symbols.HTIndex] = {
desc: Strings.SubStringDescriptor;
s: Strings.SubString = @desc;
IF hti = Symbols.HTNull THEN PutString["(anonymous)"L]
ELSE {symbols.SubStringForName[LOOPHOLE[s], hti]; PutLongSubString[s]}};
PrintSei:
PUBLIC
PROC [sei: Symbols.ISEIndex] = {
PrintHti[IF sei = Symbols.SENull THEN Symbols.HTNull ELSE symbols.seb[sei].hash]};
Indent:
PUBLIC
PROC [n:
CARDINAL] = {
PutChar['\n];
THROUGH [1..n/8] DO PutChar['\t] ENDLOOP;
THROUGH [1..n MOD 8] DO PutChar[' ] ENDLOOP};
IODefs replacement
WriteChar: PUBLIC PROC [char: CHARACTER] = {TTY.PutChar[Exec.w, char]};
WriteString: PUBLIC PROC [s: STRING] = {TTY.PutString[Exec.w, s]};
WriteLine: PUBLIC PROC [s: STRING] = {TTY.PutLine[Exec.w, s]};
WriteOctal: PUBLIC PROC [u: UNSPECIFIED] = {TTY.PutOctal[Exec.w, u]};
WriteDecimal: PUBLIC PROC [i: INTEGER] = {TTY.PutDecimal[Exec.w, i]};
herald: STRING ← [50];
LoadLister:
PROC = {
CommanderOps.InitCommander[herald];
Strings.AppendString[to: herald, from: "Cedar 3 Lister of "L];
Time.Append[herald, Time.Unpack[[OSMiscOps.BcdCreateTime[]]]];
herald.length ← herald.length - 3;
Exec.AddCommand["Lister.~"L, Lister]};
Lister: PROC = {CommanderOps.WaitCommands[]};
LoadLister[];
}.