-- Copyright (C) 1984 by Xerox Corporation. All rights reserved. -- NetDirBuilderNew.mesa, HGM, 8-Nov-84 16:15:44 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: MONITOR 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.