-- Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved.
-- NetDirBuilderOld.mesa, HGM, 28-Jun-85 17:34:45
DIRECTORY
Ascii USING [CR, SP, TAB, FF, NUL],
Checksum USING [ComputeChecksum],
Environment USING [],
Inline USING [LowHalf, HighHalf],
MSegment USING [FreePages, FreeWords, GetPages, GetWords],
MStream USING [Error, ReadOnly, WriteOnly],
Process USING [Yield],
Put USING [Char, CR, Text, Line, Number, LongDecimal],
Stream USING [Delete, EndOfStream, GetChar, Handle, PutBlock, PutWord],
String USING [UpperCase],
Time USING [AppendCurrent],
Window USING [Handle],
PupTypes USING [PupAddress],
PupWireFormat USING [BcplSTRING, BcplMaxLength],
HeapSort USING [Sort],
NetDirDefs,
NetDirBuilderOps USING [GetNewVersionNumber, log];
NetDirBuilderOld: PROGRAM
IMPORTS
Checksum, Inline, MSegment, MStream, Process, Put, Stream, String, Time,
HeapSort, NetDirBuilderOps
EXPORTS NetDirBuilderOps =
BEGIN OPEN NetDirDefs;
stick: Window.Handle;
fixup: CARDINAL = 100B;
nameFudge: NameOffset = LOOPHOLE[fixup];
addrFudge: AddrOffset = LOOPHOLE[fixup];
entryFudge: EntryOffset = LOOPHOLE[fixup];
stringFudge: StringOffset = LOOPHOLE[fixup];
sizeOfStatementBuffer: CARDINAL = 1000;
slop: CARDINAL = 50;
scratchSize: CARDINAL = MAX[maxNamesInFile, maxAddrsInFile];
BcplString: TYPE = LONG POINTER TO PupWireFormat.BcplSTRING;
PupAddress: TYPE = PupTypes.PupAddress;
nameTable: LONG POINTER TO ARRAY [0..maxNamesInFile) OF NameOffset;
numberOfNames: CARDINAL;
addrTable: LONG POINTER TO ARRAY [0..maxAddrsInFile) OF AddrOffset;
numberOfAddrs: CARDINAL;
entryTable: LONG POINTER TO ARRAY [0..maxEntrysInFile) OF EntryOffset;
numberOfEntries: CARDINAL;
stringTable: LONG POINTER TO ARRAY [0..maxStringsInFile) OF StringOffset;
numberOfStrings: CARDINAL;
numberOfSkips: CARDINAL;
numberOfDiscards: CARDINAL;
e: EntryBase;
n: NameBase;
a: AddrBase;
s: StringBase;
nextEntry: EntryBase RELATIVE POINTER TO Entry;
nextName, lastName: NameBase RELATIVE POINTER TO Name;
nextAddr: AddrBase RELATIVE POINTER TO Addr;
nextString: StringBase RELATIVE POINTER TO PupWireFormat.BcplSTRING;
scratch: LONG POINTER TO ARRAY [0..scratchSize) OF Offset;
digitsOnly: BOOLEAN ← TRUE;
BuildOldDirectory: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN
stick ← NetDirBuilderOps.log;
Put.CR[stick];
IF ~FindInputFile[] THEN RETURN[FALSE];
errors ← 0;
numberOfNames ← numberOfAddrs ← numberOfEntries ← numberOfStrings ← 0;
numberOfSkips ← numberOfDiscards ← 0;
nextEntry ← LOOPHOLE[fixup];
nextName ← lastName ← LOOPHOLE[fixup];
nextAddr ← LOOPHOLE[fixup];
nextString ← LOOPHOLE[fixup];
AllocateThings[];
BEGIN
ENABLE GetMeOutOfHere => BEGIN errors ← errors + 1; CONTINUE; END;
Announce["Parsing input file for old file format..."];
ParseInput[];
CloseInputFile[];
CheckForErrors[];
Put.Text[stick, "There were "];
Put.LongDecimal[stick, input];
Put.Line[stick, " characters in the input file."];
Announce["Sorting name table..."];
SortNameTable[];
CheckNameTable[];
Announce["Sorting address table..."];
SortAddressTable[];
CheckAddressTable[];
CheckForErrors[];
Announce["Fixing up offsets..."];
FindLocations[];
header ← [
numberOfNames: numberOfNames, nameLookupTable: LOOPHOLE[nameTableLocation],
numberOfAddrs: numberOfAddrs, addrLookupTable: LOOPHOLE[addrTableLocation],
lengthOfEntries: nextEntry - entryFudge,
firstEntry: LOOPHOLE[entryLocation], version: NetDirBuilderOps.GetNewVersionNumber[]];
FixupNamePointers[];
FixupAddrPointers[];
FixupEntryPointers[];
Announce["Writing out Pup-network.directory..."];
FindOutputFile[];
WriteOutFile[];
CloseOutputFile[];
Announce["Done."];
END; -- of ENABLE
FreeThings[];
PrintInfo[];
IF errors = 0 THEN
BEGIN
Put.Text[stick, "There are "];
Put.LongDecimal[stick, output];
Put.Line[stick, " words in the output file."];
Put.Text[stick, "There are "];
Put.LongDecimal[stick, LAST[CARDINAL]-output];
Put.Line[stick, " words left in the output file."];
END;
Put.CR[stick];
RETURN[errors = 0];
END;
input: LONG CARDINAL;
source: Stream.Handle;
statement: STRING = [sizeOfStatementBuffer];
finger: CARDINAL;
terminator: CHARACTER;
FindInputFile: PROCEDURE RETURNS [BOOLEAN] =
BEGIN
input ← 0;
source ← MStream.ReadOnly[
"Pup-Network.txt"L, [] ! MStream.Error => GOTO NotFound];
RETURN[TRUE];
EXITS
NotFound =>
BEGIN
Put.Line[stick, "*** I can't find Pup-Network.txt on this disk."];
RETURN[FALSE];
END;
END;
EndOfInput: SIGNAL = CODE;
CloseInputFile: PROCEDURE = BEGIN Stream.Delete[source]; source ← NIL; END;
ParseInput: PROCEDURE =
BEGIN
ENABLE EndOfInput => CONTINUE;
DO
ENABLE ParsingError => CONTINUE;
GetStatment[
! Stream.EndOfStream => Abort["Unexpected end of input data."]];
InitializeNewEntry[];
Process.Yield[];
DO
BuildName[];
SELECT terminator FROM
', => NULL;
'= => EXIT;
ENDCASE => ParseError["Syntax error, = expected"];
ENDLOOP;
IF namesThisEntry = 0 AND name.string.length = 0 THEN
BEGIN -- No interesting names, skip this whole entry.
numberOfDiscards ← numberOfDiscards + 1;
LOOP;
END;
Process.Yield[];
DO
BuildAddress[];
SELECT terminator FROM
', => LOOP;
Ascii.CR => EXIT;
'; =>
BEGIN
IF TRUE THEN EXIT; -- File too big: Patch out Attribute Value pairs
DO
BuiltAttributeValuePair[];
SELECT terminator FROM
', => LOOP;
Ascii.CR => EXIT;
ENDCASE => ParseError["Syntax error, end of statment expected"];
ENDLOOP;
EXIT;
END;
ENDCASE => ParseError["Syntax error, end of statment expected"];
ENDLOOP;
KeepThisEntry[];
Process.Yield[];
ENDLOOP;
END;
GetChar: PROCEDURE RETURNS [CHARACTER] =
BEGIN input ← input + 1; RETURN[Stream.GetChar[source]]; END;
GetStatment: PROCEDURE =
BEGIN
c: CHARACTER;
statement.length ← finger ← 0;
DO
c ← GetChar[ ! Stream.EndOfStream => SIGNAL EndOfInput];
SELECT c FROM
'; => UNTIL c = Ascii.CR DO c ← GetChar[]; ENDLOOP;
Ascii.SP, Ascii.TAB, Ascii.FF, Ascii.CR => NULL;
ENDCASE => EXIT;
ENDLOOP;
UNTIL c = Ascii.CR DO
AppendCharToString[statement, c];
SELECT c FROM
',, ';, '=, '+ =>
BEGIN
DO
c ← GetChar[];
SELECT c FROM Ascii.CR => LOOP; ENDCASE => GOTO AlreadyPeekedAhead;
ENDLOOP;
EXITS AlreadyPeekedAhead => LOOP;
END;
ENDCASE => NULL;
c ← GetChar[];
ENDLOOP;
-- 140C is invisible
FOR i: CARDINAL IN [0..statement.length) DO
IF statement[i] = 140C THEN
ParseError[
"Strange Character: 140C encountered (it's probably invisible)"];
ENDLOOP;
END;
SkipSpaces: PROCEDURE =
BEGIN
c: CHARACTER;
UNTIL finger = statement.length DO
c ← statement[finger];
SELECT c FROM Ascii.SP, Ascii.TAB, Ascii.CR => NULL; ENDCASE => RETURN;
finger ← finger + 1;
ENDLOOP
END;
FindTerminator: PROCEDURE =
BEGIN
SkipSpaces[];
IF finger = statement.length THEN terminator ← Ascii.CR
ELSE BEGIN terminator ← statement[finger]; finger ← finger + 1; END;
Process.Yield[];
END;
CollectString: PROCEDURE [where: STRING] =
BEGIN
c: CHARACTER;
where.length ← 0;
SkipSpaces[];
UNTIL finger = statement.length DO
c ← statement[finger];
SELECT c FROM
IN ['a..'z], IN ['A..'Z], IN ['0..'9], '-, '/ =>
AppendCharToString[where, c];
ENDCASE => EXIT;
finger ← finger + 1;
ENDLOOP;
FindTerminator[];
Process.Yield[];
END;
CollectQuotedBcplString: PROCEDURE [where: BcplString] =
BEGIN
c: CHARACTER;
where.length ← 0;
SkipSpaces[];
c ← statement[finger];
IF c # '" THEN ParseError["Syntax error: opening "" expected"];
finger ← finger + 1;
UNTIL finger = statement.length DO
c ← statement[finger];
finger ← finger + 1;
IF c = '" THEN
BEGIN
IF finger = statement.length OR statement[finger] # '" THEN EXIT;
finger ← finger + 1; -- "" case
END;
AppendCharToBcplString[where, c];
ENDLOOP;
IF c # '" THEN ParseError["Syntax error: closing "" expected"];
where.char[where.length] ← Ascii.NUL; -- keep file clean
FindTerminator[];
Process.Yield[];
END;
CollectBcplString: PROCEDURE [where: BcplString] =
BEGIN
c: CHARACTER;
where.length ← 0;
digitsOnly ← TRUE;
SkipSpaces[];
UNTIL finger = statement.length DO
c ← statement[finger];
SELECT c FROM
IN ['0..'9] => NULL;
IN ['a..'z], IN ['A..'Z], '-, '/ => digitsOnly ← FALSE;
'* =>
BEGIN -- "*" OK, * not allowed in bigger words
IF where.length # 0 THEN EXIT;
AppendCharToBcplString[where, c];
finger ← finger + 1;
digitsOnly ← FALSE;
EXIT;
END;
ENDCASE => EXIT;
AppendCharToBcplString[where, c];
finger ← finger + 1;
ENDLOOP;
where.char[where.length] ← Ascii.NUL; -- keep file clean
FindTerminator[];
END;
oldAddrs, newAddrs: ARRAY [0..maxAddrsPerEntry) OF PupAddress;
old, new: CARDINAL;
InitAddrLists: PROCEDURE =
BEGIN -- initialize to a single empty item
oldAddrs[0] ← [[0], [0], [0, 0]];
old ← 1;
new ← 0;
END;
CrossPort: PROCEDURE [a: PupAddress] =
BEGIN
FOR i: CARDINAL IN [0..old) DO
b: PupAddress ← oldAddrs[i];
IF ~(a.net = b.net OR a.net = 0 OR b.net = 0) THEN LOOP;
IF ~(a.host = b.host OR a.host = 0 OR b.host = 0) THEN LOOP;
IF ~(a.socket = b.socket OR a.socket = [0, 0] OR b.socket = [0, 0]) THEN
LOOP;
-- it got past the filter, add it to the list
IF new = maxAddrsPerEntry THEN ERROR;
IF b.net = 0 THEN b.net ← a.net;
IF b.host = 0 THEN b.host ← a.host;
IF b.socket = [0, 0] THEN b.socket ← a.socket;
newAddrs[new] ← b;
new ← new + 1;
Process.Yield[];
ENDLOOP;
END;
ResetAddrLists: PROCEDURE =
BEGIN -- flush old, move new to old
oldAddrs ← newAddrs;
old ← new;
new ← 0;
END;
BuildAddress: PROCEDURE =
BEGIN
temp: STRING = [255];
number, constantInProgress: BOOLEAN ← FALSE;
val, net, host, socket: LONG CARDINAL;
InitAddrLists[];
DO
CollectString[temp];
[number, val] ← TryStringAsOctal[temp];
IF number THEN
BEGIN
IF ~constantInProgress THEN
BEGIN constantInProgress ← TRUE; net ← host ← 0; END;
socket ← val;
IF terminator = '# THEN
BEGIN
IF net # 0 OR socket > 377B THEN
ParseError["Malformed Address constant"];
net ← host;
host ← socket;
socket ← 0;
LOOP;
END;
CrossPort[
[
[Inline.LowHalf[net]], [Inline.LowHalf[host]], [
Inline.HighHalf[socket], Inline.LowHalf[socket]]]];
END
ELSE
BEGIN
IF constantInProgress THEN ParseError["Non Octal Address constant"];
FOR addr: AddrOffset ← LookupName[temp], a[addr].next UNTIL addr = last DO
CrossPort[a[addr].port]; ENDLOOP;
END;
ResetAddrLists[];
IF terminator # '+ THEN EXIT;
ENDLOOP;
IF old = 0 THEN ParseError["Empty address expression"];
FOR i: CARDINAL IN [0..old) DO
port: PupAddress ← oldAddrs[i];
IF port.net = 0 AND port.host # 0 AND port.socket = [0, 0] THEN
ParseError["Strange address, probably missing net number"];
IF port.net = 0 AND port.host # 0 AND port.socket # [0, 0] THEN
ParseError["Strange address, probably mixedup net number"];
IF port.net # 0 AND port.host = 0 AND port.socket # [0, 0] THEN
ParseError["Strange address, probably missing # after host number"];
IF port.net = 0 AND port.host = 0 AND port.socket = [0, 0] THEN
ParseError[
"Strange address, probably extra "","" after a normal address"];
IF firstAddrSeen THEN KeepThisAddr[FALSE];
addr.port ← port;
firstAddrSeen ← TRUE;
ENDLOOP;
END;
LookupName: PROCEDURE [target: LONG STRING] RETURNS [addr: AddrOffset] =
BEGIN
entry: EntryOffset;
FOR i: CARDINAL IN [0..numberOfNames) DO
IF Same[target, @n[nameTable[i]].string] THEN
BEGIN entry ← n[nameTable[i]].entry; EXIT; END;
REPEAT FINISHED => BEGIN ParseError["Name not known"]; END;
ENDLOOP;
addr ← e[entry].addr;
END;
BuildName: PROCEDURE =
BEGIN
IF name.string.length # 0 THEN KeepThisName[];
CollectBcplString[@name.string];
IF name.string.length > 0 AND digitsOnly THEN
BEGIN
numberOfSkips ← numberOfSkips + 1;
name.string.length ← 0;
END;
IF name.string.length > maxCharsPerName THEN ParseError["Name too long"];
END;
NameSize: PROCEDURE [name: LONG POINTER TO Name] RETURNS [CARDINAL] =
BEGIN
-- SIZE[Name] uses 255 characters
RETURN[sizeOfBasicName + (name.string.length + 2)/2];
END;
BuiltAttributeValuePair: PROCEDURE =
BEGIN
slot: LONG POINTER TO Attribute ← @entry.attributes[entry.numberOfAttributes];
CollectBcplString[@s[nextString]];
slot.name ← FindAttributeSlot[];
CollectQuotedBcplString[@s[nextString]];
slot.value ← FindAttributeSlot[];
entry.numberOfAttributes ← entry.numberOfAttributes + 1;
END;
FindAttributeSlot: PROCEDURE RETURNS [out: StringOffset] =
BEGIN
bottom, top: CARDINAL;
string: BcplString = @s[nextString];
bottom ← 0;
top ← numberOfStrings;
WHILE bottom < top DO
-- target IN [bottom..top)
finger: CARDINAL ← (top + bottom)/2;
this: BcplString ← @s[stringTable[finger]];
IF EquivBcplStrings[this, string] THEN RETURN[stringTable[finger]];
IF LessBcplStrings[this, string] THEN bottom ← finger + 1 ELSE top ← finger;
ENDLOOP;
out ← nextString;
IF numberOfStrings = maxStringsInFile THEN Abort["String table overflow"];
FOR i: CARDINAL DECREASING IN (top..numberOfStrings] DO
stringTable[i] ← stringTable[i - 1]; ENDLOOP;
stringTable[top] ← out;
numberOfStrings ← numberOfStrings + 1;
nextString ← nextString + (string.length + 2)/2;
END;
name: LONG POINTER TO Name;
addr: LONG POINTER TO Addr;
firstAddrSeen: BOOLEAN ← TRUE;
entry: LONG POINTER TO Entry;
namesThisEntry, addrsThisEntry: CARDINAL;
InitializeNewEntry: PROCEDURE =
BEGIN
namesThisEntry ← addrsThisEntry ← 0;
firstAddrSeen ← FALSE;
entry ← @e[nextEntry];
name ← @n[nextName];
addr ← @a[nextAddr];
entry↑ ← [name: nextName, addr: nextAddr, numberOfAttributes: 0, attributes:];
name↑ ← [next: last, entry: nextEntry, string:];
name.string.length ← 0;
addr↑ ← [next:, entry: nextEntry, port:, numberOfAttributes: 0, attributes:];
END;
KeepThisEntry: PROCEDURE =
BEGIN
size: CARDINAL = SIZE[Entry] + entry.numberOfAttributes*SIZE[Attribute];
IF numberOfEntries = maxEntrysInFile THEN Abort["Entry table overflow"];
entryTable[numberOfEntries] ← nextEntry;
numberOfEntries ← numberOfEntries + 1;
IF name.string.length # 0 THEN KeepThisName[];
n[lastName].next ← last;
IF firstAddrSeen THEN KeepThisAddr[TRUE];
nextEntry ← nextEntry + size;
IF nextEntry - entryFudge > oldMaxEntryBufferLength THEN
BEGIN
IF nextEntry - entryFudge - size <= oldMaxEntryBufferLength THEN
Put.CR[stick];
Put.Text[stick, "******** Entry buffer just overflowed the limit of (Apr-81) Alto and Rubicon Gateways"];
Put.CR[stick];
END;
IF namesThisEntry = 0 THEN ParseError["No names for this entry"];
IF addrsThisEntry = 0 THEN ParseError["No addresses for this entry"];
IF addrsThisEntry > maxAddrsPerEntry THEN
ParseError["Too many address in this entry"];
IF namesThisEntry > maxNamesPerEntry THEN
ParseError["Too many names in this entry"];
END;
KeepThisName: PROCEDURE =
BEGIN
size: CARDINAL = ForceEven[name, NameSize[name]];
IF numberOfNames = maxNamesInFile THEN Abort["Name table overflow"];
nameTable[numberOfNames] ← nextName;
numberOfNames ← numberOfNames + 1;
namesThisEntry ← namesThisEntry + 1;
lastName ← nextName;
nextName ← nextName + size;
name.next ← nextName;
name ← @n[nextName];
name↑ ← [next: last, entry: nextEntry, string:];
END;
KeepThisAddr: PROCEDURE [end: BOOLEAN] =
BEGIN
size: CARDINAL = ForceEven[addr, SIZE[Addr]];
IF numberOfAddrs = maxAddrsInFile THEN Abort["Address table overflow"];
addrTable[numberOfAddrs] ← nextAddr;
numberOfAddrs ← numberOfAddrs + 1;
addrsThisEntry ← addrsThisEntry + 1;
nextAddr ← nextAddr + size;
addr.next ← IF end THEN last ELSE nextAddr;
addr ← @a[nextAddr];
addr↑ ← [next:, entry: nextEntry, port:, numberOfAttributes: 0, attributes:];
END;
ForceEven: PROCEDURE [loc: LONG POINTER, size: CARDINAL] RETURNS [CARDINAL] =
BEGIN
IF (size MOD 2) = 0 THEN RETURN[size];
(loc + size)↑ ← 0;
RETURN[size + 1];
END;
SortNameTable: PROCEDURE =
BEGIN
Test: PROCEDURE [x, y: NameOffset] RETURNS [BOOLEAN] =
BEGIN RETURN[LessBcplStrings[@n[x].string, @n[y].string]]; END;
HeapSort.Sort[nameTable, numberOfNames, Test];
END;
-- Assumes that nameTable has been sorted
CheckNameTable: PROCEDURE =
BEGIN
FOR i: CARDINAL IN [0..numberOfNames - 1) DO
IF EquivBcplStrings[@n[nameTable[i]].string, @n[nameTable[i + 1]].string]
THEN
BEGIN
errors ← errors + 1;
Put.Text[stick, "Duplicate name: "L];
Put.Char[stick, '"];
PutBcplString[stick, @n[nameTable[i]].string];
Put.Char[stick, '"];
Put.CR[stick];
END;
ENDLOOP;
END;
SortAddressTable: PROCEDURE =
BEGIN
Test: PROCEDURE [x, y: AddrOffset] RETURNS [BOOLEAN] =
BEGIN RETURN[LessPupAddress[@a[x].port, @a[y].port]]; END;
HeapSort.Sort[addrTable, numberOfAddrs, Test];
END;
-- Assumes that addrTable has been sorted
CheckAddressTable: PROCEDURE =
BEGIN
FOR i: CARDINAL IN [0..numberOfAddrs - 1) DO
IF a[addrTable[i]].port = a[addrTable[i + 1]].port THEN
BEGIN
-- Neither the EntryBuffer nor the NameBuffer is in memory at this point.
name1: NameOffset;
name2: NameOffset;
errors ← errors + 1;
name1 ← e[a[addrTable[i]].entry].name;
name2 ← e[a[addrTable[i + 1]].entry].name;
Put.Text[stick, "Duplicate address: "];
PutPupAddress[stick, a[addrTable[i]].port];
Put.Text[stick, ", names are: "];
PutBcplString[stick, @n[name1].string];
Put.Text[stick, " and "];
PutBcplString[stick, @n[name2].string];
Put.CR[stick];
END;
ENDLOOP;
END;
header: Header;
nameTableLocation: CARDINAL;
addrTableLocation: CARDINAL;
entryLocation: CARDINAL;
nameLocation: CARDINAL;
addressLocation: CARDINAL;
stringLocation: CARDINAL;
FindLocations: PROCEDURE =
BEGIN
nameTableLocation ← 20B;
addrTableLocation ← RoundUp[nameTableLocation + numberOfNames];
entryLocation ← RoundUp[addrTableLocation + numberOfAddrs];
nameLocation ← RoundUp[entryLocation + (nextEntry - entryFudge)];
addressLocation ← RoundUp[nameLocation + (nextName - nameFudge)];
stringLocation ← RoundUp[addressLocation + (nextAddr - addrFudge)];
END;
RoundUp: PROCEDURE [w: CARDINAL] RETURNS [CARDINAL] =
BEGIN IF (w MOD 2) # 0 THEN w ← w + 1; RETURN[w]; END;
FixupNamePointers: PROCEDURE =
BEGIN
next: NameOffset ← LOOPHOLE[nameLocation];
FOR i: CARDINAL IN [0..numberOfNames) DO
scratch[i] ← next;
next ← next + RoundUp[NameSize[@n[nameTable[i]]]];
ENDLOOP;
FOR i: CARDINAL IN [0..numberOfNames) DO
name: LONG POINTER TO Name ← @n[nameTable[i]];
IF name.next = last THEN LOOP;
FOR j: CARDINAL IN [0..numberOfNames) DO
IF name.next = nameTable[j] THEN BEGIN name.next ← scratch[j]; EXIT; END;
REPEAT FINISHED => Abort["Can't fixup nameTable[i].next"];
ENDLOOP;
Process.Yield[];
ENDLOOP;
FOR i: CARDINAL IN [0..numberOfEntries) DO
entry: LONG POINTER TO Entry ← @e[entryTable[i]];
FOR j: CARDINAL IN [0..numberOfNames) DO
IF entry.name = nameTable[j] THEN
BEGIN entry.name ← scratch[j]; EXIT; END;
REPEAT FINISHED => Abort["Can't fixup entryTable[i].name"];
ENDLOOP;
Process.Yield[];
ENDLOOP;
FOR i: CARDINAL IN [0..numberOfNames) DO
name: LONG POINTER TO Name ← @n[nameTable[i]];
name.entry ← name.entry - fixup + entryLocation;
Process.Yield[];
ENDLOOP;
END;
FixupAddrPointers: PROCEDURE =
BEGIN
next: AddrOffset ← LOOPHOLE[addressLocation];
FOR i: CARDINAL IN [0..numberOfAddrs) DO
scratch[i] ← next; next ← next + SIZE[Addr]; ENDLOOP;
FOR i: CARDINAL IN [0..numberOfAddrs) DO
addr: LONG POINTER TO Addr ← @a[addrTable[i]];
IF addr.next = last THEN LOOP;
FOR j: CARDINAL IN [0..numberOfAddrs) DO
IF addr.next = addrTable[j] THEN BEGIN addr.next ← scratch[j]; EXIT; END;
REPEAT FINISHED => Abort["Can't fixup addrTable[i].next"];
ENDLOOP;
Process.Yield[];
ENDLOOP;
FOR i: CARDINAL IN [0..numberOfEntries) DO
entry: LONG POINTER TO Entry ← @e[entryTable[i]];
FOR j: CARDINAL IN [0..numberOfAddrs) DO
IF entry.addr = addrTable[j] THEN
BEGIN entry.addr ← scratch[j]; EXIT; END;
REPEAT FINISHED => Abort["Can't fixup entryTable[i].addr"];
ENDLOOP;
Process.Yield[];
ENDLOOP;
FOR i: CARDINAL IN [0..numberOfAddrs) DO
addr: LONG POINTER TO Addr ← @a[addrTable[i]];
addr.entry ← addr.entry - fixup + entryLocation;
Process.Yield[];
ENDLOOP;
END;
FixupEntryPointers: PROCEDURE =
BEGIN
FOR i: CARDINAL IN [0..numberOfEntries) DO
entry: LONG POINTER TO Entry ← @e[entryTable[i]];
FOR j: CARDINAL IN [0..entry.numberOfAttributes) DO
attribute: LONG POINTER TO Attribute ← @entry.attributes[j];
attribute.name ← attribute.name - fixup + stringLocation;
attribute.value ← attribute.value - fixup + stringLocation;
ENDLOOP;
Process.Yield[];
ENDLOOP;
END;
WriteOutFile: PROCEDURE =
BEGIN
OutBlock[@header, SIZE[Header]];
OutZeros[nameTableLocation - SIZE[Header]];
WriteOutNameTable[];
WriteOutAddrTable[];
WriteOutEntries[];
WriteOutNames[];
WriteOutAddrs[];
WriteOutStrings[];
END;
WriteOutNameTable: PROCEDURE =
BEGIN
next: NameOffset ← LOOPHOLE[nameLocation];
FOR i: CARDINAL IN [0..numberOfNames) DO
scratch[i] ← next;
next ← next + RoundUp[NameSize[@n[nameTable[i]]]];
ENDLOOP;
OutBlock[scratch, numberOfNames];
OutEven[];
END;
WriteOutAddrTable: PROCEDURE =
BEGIN
next: AddrOffset ← LOOPHOLE[addressLocation];
FOR i: CARDINAL IN [0..numberOfAddrs) DO
scratch[i] ← next; next ← next + SIZE[Addr]; ENDLOOP;
OutBlock[scratch, numberOfAddrs];
OutEven[];
END;
WriteOutEntries: PROCEDURE =
BEGIN OutBlock[e + fixup, (nextEntry - entryFudge)]; OutEven[]; END;
WriteOutNames: PROCEDURE =
BEGIN
FOR i: CARDINAL IN [0..numberOfNames) DO
name: LONG POINTER TO Name ← @n[nameTable[i]];
OutBlock[name, NameSize[name]];
OutEven[];
ENDLOOP;
END;
WriteOutAddrs: PROCEDURE =
BEGIN
FOR i: CARDINAL IN [0..numberOfAddrs) DO
addr: LONG POINTER TO Addr ← @a[addrTable[i]];
OutBlock[addr, SIZE[Addr]];
OutEven[];
ENDLOOP;
END;
WriteOutStrings: PROCEDURE =
BEGIN OutBlock[s + fixup, (nextString - stringFudge)]; OutEven[]; END;
sink: Stream.Handle ← NIL;
output: CARDINAL;
checksum: WORD;
FindOutputFile: PROCEDURE =
BEGIN
sink ← MStream.WriteOnly["Pup-network.directory"L, [], binary];
output ← 0;
checksum ← 0;
END;
OutBlock: PROCEDURE [p: LONG POINTER, words: CARDINAL] =
BEGIN
[] ← Stream.PutBlock[sink, [p, 0, 2*words]];
IF LONG[words] + output > LAST[CARDINAL] THEN
Abort["Output file length > 64K."];
output ← output + words;
checksum ← Checksum.ComputeChecksum[checksum, words, p];
END;
OutZeros: PROCEDURE [l: CARDINAL] =
BEGIN zero: WORD ← 0; THROUGH [0..l) DO OutBlock[@zero, 1]; ENDLOOP; END;
OutEven: PROCEDURE = BEGIN IF (output MOD 2) # 0 THEN OutZeros[1]; END;
CloseOutputFile: PROCEDURE =
BEGIN Stream.PutWord[sink, checksum]; Stream.Delete[sink]; sink ← NIL; END;
Announce: PROCEDURE [s: LONG STRING] =
BEGIN
text: STRING = [30];
Time.AppendCurrent[text];
Put.Text[stick, text];
Put.Char[stick, ' ];
Put.Char[stick, ' ];
Put.Line[stick, s];
END;
PrintInfo: PROCEDURE =
BEGIN
Put.CR[stick];
Put.LongDecimal[stick, numberOfNames];
Put.Text[stick, " out of "];
Put.LongDecimal[stick, maxNamesInFile];
Put.Line[stick, " slots in the name table were used."];
Put.LongDecimal[stick, numberOfAddrs];
Put.Text[stick, " out of "];
Put.LongDecimal[stick, maxAddrsInFile];
Put.Line[stick, " slots in the address table were used."];
Put.LongDecimal[stick, numberOfEntries];
Put.Text[stick, " out of "];
Put.LongDecimal[stick, maxEntrysInFile];
Put.Line[stick, " slots in the entry table were used."];
Put.CR[stick];
Put.LongDecimal[stick, numberOfSkips];
Put.Line[stick, " DLion names were skipped."];
Put.LongDecimal[stick, numberOfDiscards];
Put.Line[stick, " DLion entrys were discarded."];
Put.CR[stick];
Put.LongDecimal[stick, nextName - nameFudge];
Put.Line[stick, " words in the name buffer were used."];
Put.LongDecimal[stick, nextAddr - addrFudge];
Put.Line[stick, " words in the address buffer were used."];
Put.LongDecimal[stick, nextEntry - entryFudge];
Put.Line[stick, " words in the entry buffer were used."];
END;
LessPupAddress: PROCEDURE [a, b: LONG POINTER TO PupAddress] RETURNS [BOOLEAN] =
BEGIN
IF a.net < b.net THEN RETURN[TRUE];
IF a.net > b.net THEN RETURN[FALSE];
IF a.host < b.host THEN RETURN[TRUE];
IF a.host > b.host THEN RETURN[FALSE];
IF a.socket.a < b.socket.a THEN RETURN[TRUE];
IF a.socket.a > b.socket.a THEN RETURN[FALSE];
IF a.socket.b < b.socket.b THEN RETURN[TRUE];
IF a.socket.b > b.socket.b THEN RETURN[FALSE];
RETURN[FALSE];
END;
PutPupAddress: PROCEDURE [where: Window.Handle, p: PupAddress] =
BEGIN
Put.Number[where, p.net, [8, FALSE, TRUE, 0]];
Put.Char[where, '#];
Put.Number[where, p.host, [8, FALSE, TRUE, 0]];
Put.Char[where, '#];
IF p.socket.a # 0 THEN
BEGIN
Put.Number[where, p.socket.a, [8, FALSE, TRUE, 0]];
Put.Char[where, '|];
END;
Put.Number[where, p.socket.b, [8, FALSE, TRUE, 0]];
END;
PutBcplString: PROCEDURE [where: Window.Handle, s: BcplString] =
BEGIN
FOR i: CARDINAL IN [0..s.length) DO Put.Char[where, s.char[i]]; ENDLOOP;
END;
AppendCharToBcplString: PROCEDURE [where: BcplString, c: CHARACTER] =
BEGIN
IF where.length = PupWireFormat.BcplMaxLength THEN
ParseError["String too long"];
where.char[where.length] ← c;
where.length ← where.length + 1;
END;
AppendCharToString: PROCEDURE [where: LONG STRING, c: CHARACTER] =
BEGIN
IF where.length = where.maxlength THEN ParseError["String too long"];
where[where.length] ← c;
where.length ← where.length + 1;
END;
EquivBcplStrings: PROCEDURE [a, b: BcplString] RETURNS [BOOLEAN] =
BEGIN
i: CARDINAL;
IF a.length # b.length THEN RETURN[FALSE];
FOR i IN [0..a.length) DO
IF String.UpperCase[a.char[i]] # String.UpperCase[b.char[i]] THEN
RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
END;
EqualBcplStrings: PROCEDURE [a, b: BcplString] RETURNS [BOOLEAN] =
BEGIN
IF a.length # b.length THEN RETURN[FALSE];
FOR i: CARDINAL IN [0..a.length) DO
IF a.char[i] # b.char[i] THEN RETURN[FALSE]; ENDLOOP;
RETURN[TRUE];
END;
Same: PROCEDURE [s: LONG STRING, t: BcplString] RETURNS [BOOLEAN] =
BEGIN
IF s.length # t.length THEN RETURN[FALSE];
FOR i: CARDINAL IN [0..s.length) DO
IF String.UpperCase[s[i]] # String.UpperCase[t.char[i]] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
END;
LessBcplStrings: PROCEDURE [a, b: BcplString] RETURNS [BOOLEAN] =
BEGIN
FOR i: CARDINAL IN [0..MIN[a.length, b.length]) DO
x: CHARACTER ← String.UpperCase[a.char[i]];
y: CHARACTER ← String.UpperCase[b.char[i]];
IF x < y THEN RETURN[TRUE];
IF x > y THEN RETURN[FALSE];
ENDLOOP;
RETURN[a.length < b.length];
END;
GetMeOutOfHere: SIGNAL = CODE;
Abort: PROCEDURE [s: LONG STRING] =
BEGIN
Put.CR[stick];
Put.Text[stick, "*** "];
Put.Line[stick, s];
Put.CR[stick];
ERROR GetMeOutOfHere;
END;
errors: CARDINAL ← 0;
ParsingError: SIGNAL = CODE;
ParseError: PROCEDURE [s: LONG STRING] =
BEGIN
Put.Text[stick, "*** "];
Put.Line[stick, s];
Put.Line[stick, statement];
THROUGH [0..finger) DO Put.Char[stick, Ascii.SP]; ENDLOOP;
Put.Char[stick, '↑];
Put.CR[stick];
errors ← errors + 1;
SIGNAL ParsingError;
END;
CheckForErrors: PROCEDURE =
BEGIN
IF errors = 0 THEN RETURN;
Put.LongDecimal[stick, errors];
Put.Line[stick, " errors."];
Abort["Errors encountered."];
END;
TryStringAsOctal: PROCEDURE [s: LONG STRING] RETURNS [BOOLEAN, LONG CARDINAL] =
BEGIN
val: LONG CARDINAL ← 0;
FOR i: CARDINAL IN [0..s.length) DO
c: CHARACTER ← s[i];
IF c ~IN ['0..'7] THEN RETURN[FALSE, 0];
IF val > 3777777777B THEN RETURN[FALSE, 0];
val ← val*8 + (c - '0);
ENDLOOP;
RETURN[TRUE, val];
END;
AllocateThings: PROCEDURE =
BEGIN
nameTable ← MSegment.GetWords[maxNamesInFile];
addrTable ← MSegment.GetWords[maxAddrsInFile];
entryTable ← MSegment.GetWords[maxEntrysInFile];
stringTable ← MSegment.GetWords[maxStringsInFile];
scratch ← MSegment.GetWords[scratchSize];
e ← MSegment.GetPages[256];
n ← MSegment.GetPages[256];
a ← MSegment.GetPages[256];
s ← MSegment.GetPages[256];
END;
FreeThings: PROCEDURE =
BEGIN
MSegment.FreeWords[nameTable];
MSegment.FreeWords[addrTable];
MSegment.FreeWords[entryTable];
MSegment.FreeWords[stringTable];
MSegment.FreeWords[scratch];
MSegment.FreePages[e];
MSegment.FreePages[n];
MSegment.FreePages[a];
MSegment.FreePages[s];
END;
END.