-- Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved.
-- NetDirBuilderNew.mesa, HGM, 28-Jun-85 17:32:23
DIRECTORY
Ascii USING [CR, SP, TAB, FF],
Checksum USING [ComputeChecksum],
Environment USING [wordsPerPage],
Inline USING [LowHalf, HighHalf],
MFile USING [GetCreateDate, Handle],
MSegment USING [FreePages, GetPages],
MStream USING [Error, GetFile, ReadOnly, WriteOnly],
Process USING [Yield],
Put USING [Char, CR, Decimal, Line, LongDecimal, Number, Text],
Stream USING [Delete, EndOfStream, GetChar, Handle, PutBlock, PutWord],
String USING [Equal, Equivalent, UpperCase, WordsForString],
System USING [GetGreenwichMeanTime, GreenwichMeanTime],
Time USING [AppendCurrent],
Window USING [Handle],
PupTypes USING [PupAddress],
HeapSort USING [SortLong],
NetDirDefs USING [maxAddrsPerEntry, maxCharsPerName, maxNamesPerEntry, NewEntry, NewHeader],
NetDirBuilderOps USING [GetNewVersionNumber, log];
NetDirBuilderNew: PROGRAM
IMPORTS
Checksum, Inline, MFile, MSegment, MStream, Process, Put, Stream, String, System, Time,
HeapSort, NetDirBuilderOps
EXPORTS NetDirBuilderOps =
BEGIN
stick: PUBLIC Window.Handle ← NIL;
sizeOfStatementBuffer: CARDINAL = 1000;
maxPagesInFile: CARDINAL = 512;
maxWordsInFile: LONG CARDINAL = LONG[Environment.wordsPerPage]*maxPagesInFile;
PupAddress: TYPE = PupTypes.PupAddress;
Entry: TYPE = LONG POINTER TO NetDirDefs.NewEntry;
numberOfEntries: CARDINAL;
header: LONG POINTER TO NetDirDefs.NewHeader;
first,last, entry: Entry;
name: LONG STRING;
address: LONG POINTER TO PupAddress;
scratchSize: LONG CARDINAL = 50000;
scratch: LONG POINTER;
BuildNewDirectory: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN
stick ← NetDirBuilderOps.log;
Put.CR[stick];
IF ~FindInputFile[] THEN RETURN[FALSE];
errors ← 0;
numberOfEntries ← 0;
AllocateThings[];
BEGIN
ENABLE GetMeOutOfHere => BEGIN errors ← errors + 1; CONTINUE; END;
Announce["Parsing input file for new file format..."];
ParseInput[];
CloseInputFile[];
Put.Text[stick, "There were "];
Put.LongDecimal[stick, input];
Put.Line[stick, " characters in the input file."];
CheckForErrors[];
Announce["Checking for duplicate names..."];
CheckNameTable[];
Announce["Checking for duplicate addresses..."];
CheckAddressTable[];
CheckForErrors[];
header↑ ← [
version: NetDirBuilderOps.GetNewVersionNumber[],
createDate: System.GetGreenwichMeanTime[],
sourceDate: sourceDate,
numberOfEntries: numberOfEntries,
spare: ALL[0] ];
Announce["Writing out Pup-network.big..."];
FindOutputFile[];
WriteOutFile[];
CloseOutputFile[];
Announce["Done."];
END; -- of ENABLE
FreeThings[];
IF errors = 0 THEN
BEGIN
Put.Text[stick, "There are "];
Put.Decimal[stick, numberOfEntries];
Put.Line[stick, " entrys in the database."];
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, maxWordsInFile-output];
Put.Line[stick, " words left in the output file."];
END;
Put.CR[stick];
RETURN[errors = 0];
END;
input: LONG CARDINAL;
source: Stream.Handle;
sourceDate: System.GreenwichMeanTime;
statement: STRING = [sizeOfStatementBuffer];
finger: CARDINAL;
terminator: CHARACTER;
FindInputFile: PROCEDURE RETURNS [BOOLEAN] =
BEGIN
file: MFile.Handle;
input ← 0;
source ← MStream.ReadOnly[
"Pup-Network.txt"L, [] ! MStream.Error => GOTO NotFound];
file ← MStream.GetFile[source];
sourceDate ← MFile.GetCreateDate[file];
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[];
name ← LOOPHOLE[entry];
name ← name + SIZE[NetDirDefs.NewEntry];
DO
BuildName[];
SELECT terminator FROM
', => LOOP;
'= => EXIT;
ENDCASE => ParseError["Syntax error, = expected"];
ENDLOOP;
Process.Yield[];
address ← LOOPHOLE[name];
DO
BuildAddress[];
SELECT terminator FROM
', => LOOP;
Ascii.CR => EXIT;
'; => EXIT; -- Ignore Attribute Value pairs
ENDCASE => ParseError["Syntax error, end of statment expected"];
ENDLOOP;
KeepThisEntry[];
InitializeNewEntry[];
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: LONG 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];
'* =>
BEGIN -- "*" is OK, * not allowed in names
IF where.length # 0 THEN EXIT;
AppendCharToString[where, c];
finger ← finger + 1;
EXIT;
END;
ENDCASE => EXIT;
finger ← finger + 1;
ENDLOOP;
FindTerminator[];
Process.Yield[];
END;
oldAddrs, newAddrs: ARRAY [0..NetDirDefs.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 = NetDirDefs.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
address: LONG POINTER TO PupAddress;
n: CARDINAL;
IF constantInProgress THEN ParseError["Non Octal Address constant"];
[address, n] ← LookupName[temp];
IF address = NIL THEN ParseError["Undefined name"];
FOR i: CARDINAL IN [0..n) DO
CrossPort[address↑];
address ← address + SIZE[PupAddress];
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"];
address↑ ← port;
KeepThisAddr[];
ENDLOOP;
END;
CountNames: PROCEDURE RETURNS [names: LONG CARDINAL ← 0] =
BEGIN
entry: Entry ← first;
UNTIL entry.words = 0 DO
names ← names + entry.numberOfNames;
entry ← entry + entry.words;
ENDLOOP;
END;
CountAddresses: PROCEDURE RETURNS [addresses: LONG CARDINAL ← 0] =
BEGIN
entry: Entry ← first;
UNTIL entry.words = 0 DO
addresses ← addresses + entry.numberOfAddresses;
entry ← entry + entry.words;
ENDLOOP;
END;
CheckNameTable: PROCEDURE =
BEGIN
Test: PROCEDURE [x, y: LONG STRING] RETURNS [BOOLEAN] =
BEGIN RETURN[LessStrings[x, y]]; END;
entry: Entry ← first;
names: LONG CARDINAL ← CountNames[];
nameTable: LONG POINTER TO ARRAY [0..0) OF LONG STRING ← scratch;
p: LONG POINTER TO LONG STRING ← scratch;
IF names > scratchSize THEN Abort["Too many names to sort"];
UNTIL entry.words = 0 DO
name: LONG STRING ← FirstName[entry];
FOR i: CARDINAL IN [0..entry.numberOfNames) DO
p↑ ← name;
p ← p + SIZE[LONG STRING];
name ← NextName[name];
ENDLOOP;
entry ← entry + entry.words;
ENDLOOP;
IF names > LAST[CARDINAL] THEN Abort["Too many names to sort"];
HeapSort.SortLong[nameTable, Inline.LowHalf[names], Test];
FOR i: CARDINAL IN [0..Inline.LowHalf[names - 1]) DO
IF String.Equivalent[nameTable[i], nameTable[i + 1]] THEN
BEGIN
errors ← errors + 1;
Put.Text[stick, "Duplicate name: "L];
Put.Char[stick, '"];
Put.Text[stick, nameTable[i]];
IF ~String.Equal[nameTable[i], nameTable[i + 1]] THEN
BEGIN
Put.Char[stick, '"];
Put.Text[stick, " = "];
Put.Char[stick, '"];
Put.Text[stick, nameTable[i + 1]];
END;
Put.Char[stick, '"];
Put.CR[stick];
END;
ENDLOOP;
END;
CheckAddressTable: PROCEDURE =
BEGIN
entry: Entry ← first;
addresses: LONG CARDINAL ← CountAddresses[];
addressTable: LONG POINTER TO ARRAY OF LONG POINTER TO PupAddress ← scratch;
p: LONG POINTER TO LONG POINTER TO PupAddress ← scratch;
IF addresses > scratchSize THEN Abort["Too many addresses to sort"];
UNTIL entry.words = 0 DO
address: LONG POINTER TO PupAddress ← Address[entry];
FOR i: CARDINAL IN [0..entry.numberOfAddresses) DO
p↑ ← address;
IF address.net = 0 AND address.host # 0 THEN SIGNAL LookAtThis;
p ← p + SIZE[LONG POINTER TO PupAddress];
address ← address + SIZE[PupAddress];
ENDLOOP;
entry ← entry + entry.words;
ENDLOOP;
IF addresses > LAST[CARDINAL] THEN Abort["Too many addresses to sort"];
FOR i: CARDINAL IN [0..Inline.LowHalf[addresses - 1]) DO
temp: PupAddress ← addressTable[i]↑;
IF temp.net = 0 AND temp.host # 0 THEN SIGNAL LookAtThis;
ENDLOOP;
HeapSort.SortLong[addressTable, Inline.LowHalf[addresses], LessPupAddress];
FOR i: CARDINAL IN [0..Inline.LowHalf[addresses - 1]) DO
temp: PupAddress ← addressTable[i]↑;
IF temp.net = 0 AND temp.host # 0 THEN SIGNAL LookAtThis;
ENDLOOP;
FOR i: CARDINAL IN [0..Inline.LowHalf[addresses - 1]) DO
IF addressTable[i]↑ = addressTable[i + 1]↑ THEN
BEGIN
errors ← errors + 1;
Put.Text[stick, "Duplicate address: "L];
PutPupAddress[stick, addressTable[i]↑];
Put.CR[stick];
END;
ENDLOOP;
END;
LookAtThis: SIGNAL = CODE;
cachedName: LONG STRING ← NIL;
cachedEntry: Entry;
LookupName: PROCEDURE [target: LONG STRING] RETURNS [address: LONG POINTER TO PupAddress, n: CARDINAL] =
BEGIN
entry: Entry ← first;
IF cachedName # NIL AND String.Equivalent[cachedName, target] THEN
BEGIN
RETURN[Address[cachedEntry], cachedEntry.numberOfAddresses];
END;
UNTIL entry = last DO -- Can't test entry.words since the last one may have names already
name: LONG STRING ← FirstName[entry];
FOR i: CARDINAL IN [0..entry.numberOfNames) DO
IF String.Equivalent[name, target] THEN
BEGIN
cachedName ← name;
cachedEntry ← entry;
RETURN[Address[entry], entry.numberOfAddresses];
END;
name ← NextName[name];
ENDLOOP;
entry ← entry + entry.words;
ENDLOOP;
RETURN[NIL, 0];
END;
FirstName: PROCEDURE [entry: Entry] RETURNS [name: LONG STRING] =
BEGIN
name ← LOOPHOLE[entry];
name ← name + SIZE[NetDirDefs.NewEntry];
END;
NextName: PROCEDURE [name: LONG STRING] RETURNS [LONG STRING] =
BEGIN
RETURN[name + String.WordsForString[name.length]];
END;
Address: PROCEDURE [entry: Entry] RETURNS [address: LONG POINTER TO PupAddress] =
BEGIN
name: LONG STRING ← FirstName[entry];
FOR i: CARDINAL IN [0..entry.numberOfNames) DO
name ← NextName[name];
ENDLOOP;
address ← LOOPHOLE[name];
END;
BuildName: PROCEDURE =
BEGIN
name↑ ← [length: 0, maxlength: NetDirDefs.maxCharsPerName, text:];
CollectString[name];
IF name.length = 0 THEN ParseError["Empty name"];
IF name.length > NetDirDefs.maxCharsPerName THEN ParseError["Name too long"];
IF name.length = 1 AND name[0] = '* THEN RETURN;
KeepThisName[];
END;
InitializeNewEntry: PROCEDURE =
BEGIN
last ← entry;
entry↑ ← [
words: 0,
numberOfNames: 0,
numberOfAddresses: 0,
numberOfAttributes: 0];
END;
KeepThisEntry: PROCEDURE =
BEGIN
entry.words ← entry.words + SIZE[NetDirDefs.NewEntry];
numberOfEntries ← numberOfEntries + 1;
IF entry.numberOfNames = 0 THEN ParseError["No names for this entry"];
IF entry.numberOfAddresses = 0 THEN ParseError["No addresses for this entry"];
IF entry.numberOfNames > NetDirDefs.maxNamesPerEntry THEN ParseError["Too many names in this entry"];
IF entry.numberOfAddresses > NetDirDefs.maxAddrsPerEntry THEN ParseError["Too many address in this entry"];
entry ← entry + entry.words;
END;
KeepThisName: PROCEDURE =
BEGIN
length: CARDINAL = name.length;
words: CARDINAL = String.WordsForString[length];
name↑ ← [length: length, maxlength: length, text:];
name ← name + words;
entry.words ← entry.words + words;
entry.numberOfNames ← entry.numberOfNames + 1;
END;
KeepThisAddr: PROCEDURE =
BEGIN
words: CARDINAL = SIZE[PupAddress];
address ← address + words;
entry.words ← entry.words + words;
entry.numberOfAddresses ← entry.numberOfAddresses + 1;
END;
WriteOutFile: PROCEDURE =
BEGIN
p: LONG POINTER ← header;
words: LONG CARDINAL ← LOOPHOLE[entry, LONG CARDINAL]-LOOPHOLE[header,LONG CARDINAL];
UNTIL words = 0 DO
clump: CARDINAL = Inline.LowHalf[MIN[words, 10000]];
WriteOutBlock[p, clump];
words ← words - clump;
output ← output + clump;
p ← p + clump;
ENDLOOP;
WriteOutBlock[entry, SIZE[NetDirDefs.NewEntry]];
END;
WriteOutBlock: PROCEDURE [p: LONG POINTER, words: CARDINAL] =
BEGIN
[] ← Stream.PutBlock[sink, [p, 0, 2*words]];
checksum ← Checksum.ComputeChecksum[checksum, words, p];
END;
sink: Stream.Handle ← NIL;
output: LONG CARDINAL;
checksum: WORD;
FindOutputFile: PROCEDURE =
BEGIN
sink ← MStream.WriteOnly["Pup-network.big"L, [], binary];
output ← 0;
checksum ← 0;
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;
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;
LessStrings: PROCEDURE [a, b: LONG STRING] RETURNS [BOOLEAN] =
BEGIN
FOR i: CARDINAL IN [0..MIN[a.length, b.length]) DO
x: CHARACTER ← String.UpperCase[a.text[i]];
y: CHARACTER ← String.UpperCase[b.text[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.Decimal[stick, errors];
Put.Line[stick, " errors."];
Abort["Errors encountered."];
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;
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
scratch ← MSegment.GetPages[1+Inline.LowHalf[scratchSize/Environment.wordsPerPage]];
header ← MSegment.GetPages[maxPagesInFile];
first ← LOOPHOLE[header];
first ← first + SIZE[NetDirDefs.NewHeader];
entry ← first;
cachedName ← NIL;
END;
FreeThings: PROCEDURE =
BEGIN
MSegment.FreePages[scratch];
MSegment.FreePages[header];
header ← NIL;
cachedName ← NIL;
END;
END.