-- 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.