-- Copyright (C) 1982  by Xerox Corporation. All rights reserved. 
-- NetDirPrinter.Mesa, HGM, 30-Jan-82 18:36:13

DIRECTORY
  Ascii USING [FF],
  Checksum USING [ComputeChecksum],
  Inline USING [LowHalf],
  FormSW USING [
    ClientItemsProcType, ProcType, AllocateItemDescriptor, newLine, CommandItem],
  MFile USING [Error, GetLength, Handle, ReadOnly],
  MSegment USING [Address, Create, Delete, Handle],
  Put USING [Char, CR, Decimal, Text, Line, LongDecimal, Octal, Number],
  Runtime USING [GetBcdTime],
  String USING [AppendString],
  Time USING [Append, Unpack],
  Tool USING [Create, MakeSWsProc, MakeFormSW, MakeFileSW],
  UserInput USING [UserAbort],
  Window USING [Handle],

  PupWireFormat USING [BcplSTRING],
  PupDefs USING [PupAddress],
  NetDirDefs USING [
    Addr, AddrOffset, Entry, EntryOffset, Name, NameOffset, StringOffset,
    NameBase, AddrBase, EntryBase, StringBase, Offset, Header, Attribute, last,
    maxAddrsPerEntry, maxNamesPerEntry];

NetDirPrinter: PROGRAM
  IMPORTS
    Checksum, FormSW, Inline, MFile, MSegment, Put, Runtime, String, Time, Tool,
    UserInput =
  BEGIN OPEN NetDirDefs;

  form, log: Window.Handle;

  header: LONG POINTER TO Header;

  p: LONG POINTER;

  nameTable: LONG POINTER TO ARRAY [0..0) OF NameOffset;
  numberOfNames: CARDINAL ¬ 0;
  addrTable: LONG POINTER TO ARRAY [0..0) OF AddrOffset;
  numberOfAddrs: CARDINAL ¬ 0;
  e: EntryBase;
  n: NameBase;
  a: AddrBase;
  s: StringBase;

  nameTableLocation: CARDINAL;
  addrTableLocation: CARDINAL;
  entryLocation: CARDINAL;
  lengthOfEntries: CARDINAL;

  BcplString: TYPE = LONG POINTER TO PupWireFormat.BcplSTRING;
  PupAddress: TYPE = PupDefs.PupAddress;

  PrintHeader: PROCEDURE =
    BEGIN
    Put.Text[log, "Name lookup table length "];
    Put.Octal[log, header.numberOfNames];
    Put.Text[log, " ("];
    Put.Decimal[log, header.numberOfNames];
    Put.Text[log, "), address "];
    Put.Octal[log, header.nameLookupTable];
    Put.Line[log, "."];
    Put.Text[log, "Address lookup table length "];
    Put.Octal[log, header.numberOfAddrs];
    Put.Text[log, " ("];
    Put.Decimal[log, header.numberOfAddrs];
    Put.Text[log, "), address "];
    Put.Octal[log, header.addrLookupTable];
    Put.Line[log, "."];
    Put.Text[log, "Entry table length "];
    Put.Octal[log, header.lengthOfEntries];
    Put.Text[log, " ("];
    Put.Decimal[log, header.lengthOfEntries];
    Put.Text[log, "), address "];
    Put.Octal[log, header.firstEntry];
    Put.Line[log, "."];
    Put.Text[log, "version = "];
    Put.Decimal[log, header.version];
    Put.Line[log, "."];
    Put.CR[log];
    Put.CR[log];
    END;

  WriteBcplString: PROCEDURE [string: BcplString] =
    BEGIN
    FOR i: CARDINAL IN [0..string.length) DO
      Put.Char[log, string.char[i]]; ENDLOOP;
    END;

  O6: PROCEDURE [n: UNSPECIFIED] =
    BEGIN Put.Number[log, n, [8, FALSE, TRUE, 6]]; END;

  O7: PROCEDURE [n: UNSPECIFIED] =
    BEGIN Put.Number[log, n, [8, FALSE, TRUE, 7]]; END;

  O: PROCEDURE [n: UNSPECIFIED] =
    BEGIN Put.Number[log, n, [8, FALSE, TRUE, 0]]; END;

  PrintPupAddress: PROCEDURE [a: LONG POINTER TO PupAddress] =
    BEGIN
    Put.Number[log, a.net, [8, FALSE, TRUE, 0]];
    Put.Char[log, '#];
    Put.Number[log, a.host, [8, FALSE, TRUE, 0]];
    Put.Char[log, '#];
    IF a.socket.a # 0 THEN
      BEGIN
      Put.Number[log, a.socket.a, [8, FALSE, TRUE, 0]];
      Put.Char[log, '|];
      END;
    Put.Number[log, a.socket.b, [8, FALSE, TRUE, 0]];
    END;

  OutOfBounds: PROCEDURE [x: Offset] RETURNS [BOOLEAN] =
    BEGIN y: CARDINAL = x; RETURN[y > length - 1]; END;

  NotEven: PROCEDURE [x: Offset] RETURNS [BOOLEAN] =
    BEGIN y: CARDINAL = x; RETURN[(x MOD 2) # 0]; END;

  Names: FormSW.ProcType =
    BEGIN
    name: LONG POINTER TO Name;
    IF source = NIL THEN
      BEGIN
      Put.Line[log, "Please get a reasonable Pup-Network.directory."];
      RETURN;
      END;
    Put.Line[log, "Name lookup table:"];
    Put.CR[log];
    Put.Line[log, "  Table    Loc   Next  Entry  Text"];
    FOR i: CARDINAL IN [0..numberOfNames) DO
      IF UserInput.UserAbort[log] THEN EXIT;
      O7[i + nameTableLocation];
      O7[nameTable[i]];
      IF OutOfBounds[nameTable[i]] THEN
        BEGIN Put.Line[log, "  (out of bounds)"]; LOOP; END;
      name ¬ @n[nameTable[i]];
      O7[name.next];
      O7[name.entry];
      Put.Text[log, "  "];
      WriteBcplString[@name.string];
      IF NotEven[nameTable[i]] THEN Put.Text[log, " ****** (not even)"];
      Put.CR[log];
      ENDLOOP;
    Put.Char[log, Ascii.FF];
    Put.CR[log];
    END;

  Addresses: FormSW.ProcType =
    BEGIN
    addr: LONG POINTER TO Addr;
    IF source = NIL THEN
      BEGIN
      Put.Line[log, "Please get a reasonable Pup-Network.directory."];
      RETURN;
      END;
    Put.Line[log, "Address lookup table:"];
    Put.CR[log];
    Put.Line[log, "  Table    Loc   Next  Entry  Address"];
    FOR i: CARDINAL IN [0..numberOfAddrs) DO
      IF UserInput.UserAbort[log] THEN EXIT;
      O7[i + addrTableLocation];
      O7[addrTable[i]];
      IF OutOfBounds[addrTable[i]] THEN
        BEGIN Put.Line[log, "  (out of bounds)"]; LOOP; END;
      addr ¬ @a[addrTable[i]];
      O7[addr.next];
      O7[addr.entry];
      Put.Text[log, "  "];
      PrintPupAddress[@addr.port];
      IF NotEven[addrTable[i]] THEN Put.Text[log, " ****** (not even)"];
      Put.CR[log];
      ENDLOOP;
    Put.Char[log, Ascii.FF];
    Put.CR[log];
    END;

  Entries: FormSW.ProcType =
    BEGIN
    file: CARDINAL ¬ entryLocation;
    size: CARDINAL;
    entry: LONG POINTER TO Entry ¬ LOOPHOLE[e + entryLocation];
    name: NameOffset;
    addr: AddrOffset;
    attribute: LONG POINTER TO Attribute;
    IF source = NIL THEN
      BEGIN
      Put.Line[log, "Please get a reasonable Pup-Network.directory."];
      RETURN;
      END;
    Put.Line[log, "Entry blocks:"];
    Put.CR[log];
    Put.Line[log, "    Loc   Name   Addr  Atrributes"];
    WHILE file < entryLocation + lengthOfEntries DO
      IF UserInput.UserAbort[log] THEN EXIT;
      O6[file];
      Put.Text[log, "	Names: "];
      name ¬ entry.name;
      FOR i: CARDINAL ¬ 0, i + 1 UNTIL i > 50 DO
        O[name];
        Put.Text[log, " "];
        IF OutOfBounds[name] THEN
          BEGIN Put.Text[log, "  (out of bounds)"]; EXIT; END;
        WriteBcplString[@n[name].string];
        name ¬ n[name].next;
        IF name = last THEN
          BEGIN
          IF i >= maxNamesPerEntry THEN Put.Line[log, "******  Too many names."];
          EXIT;
          END;
        Put.Text[log, ",  "];
        REPEAT
          FINISHED =>
            Put.Line[log, "******  Looks like a loop in the name list."];
        ENDLOOP;
      Put.CR[log];
      Put.Text[log, "	Addresses: "];
      addr ¬ entry.addr;
      FOR i: CARDINAL ¬ 0, i + 1 UNTIL i > 50 DO
        O[addr];
        Put.Text[log, " "];
        IF OutOfBounds[addr] THEN
          BEGIN Put.Line[log, "  (out of bounds)"]; EXIT; END;
        PrintPupAddress[@a[addr].port];
        addr ¬ a[addr].next;
        IF addr = last THEN
          BEGIN
          IF i >= maxAddrsPerEntry THEN
            Put.Line[log, "******  Too many addresses."];
          EXIT;
          END;
        Put.Text[log, ",  "];
        REPEAT
          FINISHED =>
            Put.Line[log, "******  Looks like a loop in the address list."];
        ENDLOOP;
      FOR i: CARDINAL IN [0..entry.numberOfAttributes) DO
        IF UserInput.UserAbort[log] THEN EXIT;
        attribute ¬ @entry.attributes[i];
        IF i = 0 THEN
          BEGIN
          Put.CR[log];
          Put.Text[log, "	"];
          Put.Decimal[log, entry.numberOfAttributes];
          Put.Text[log, " Attributes: "];
          END
        ELSE Put.Text[log, ",  "];
        Put.Char[log, '(];
        O[attribute.name];
        Put.Text[log, ") "];
        IF OutOfBounds[attribute.name] THEN Put.Text[log, "(out of bounds)"]
        ELSE WriteBcplString[@s[attribute.name]];
        Put.Text[log, ": ("];
        O[attribute.value];
        Put.Text[log, ") """];
        IF OutOfBounds[attribute.value] THEN Put.Text[log, "(out of bounds)"]
        ELSE WriteBcplString[@s[attribute.value]];
        Put.Char[log, '"];
        ENDLOOP;
      size ¬ SIZE[Entry] + entry.numberOfAttributes*SIZE[Attribute];
      IF size > 50 THEN
        BEGIN
        Put.Line[
          log,
          "   ******  The size of this Entry is huge.  The file is probably trash."];
        EXIT;
        END;
      file ¬ file + size;
      entry ¬ entry + size;
      Put.CR[log];
      IF file > length THEN BEGIN EXIT; END;
      ENDLOOP;
    Put.Char[log, Ascii.FF];
    Put.CR[log];
    END;

  source: MSegment.Handle ¬ NIL;
  length: CARDINAL;

  RoundUp: PROCEDURE [w: CARDINAL] RETURNS [CARDINAL] =
    BEGIN IF (w MOD 2) # 0 THEN w ¬ w + 1; RETURN[w]; END;

  Initialize: FormSW.ProcType = BEGIN CheckFile[]; END;

  CheckFile: PROCEDURE =
    BEGIN
    file: MFile.Handle;
    IF source # NIL THEN RETURN;
    file ¬ MFile.ReadOnly[
      "Pup-Network.Directory", [] !
      MFile.Error =>
        BEGIN
        Put.Line[log, "Can't read Pup-Network.Directory."];
        GOTO NoFile;
        END];
    BEGIN
    eof: LONG CARDINAL ¬ MFile.GetLength[file];
    IF eof < 2*SIZE[Header] THEN
      BEGIN Put.Line[log, "The file is way too short."]; GOTO FileTooShort; END;
    Put.Text[log, "There are "];
    Put.LongDecimal[log, eof];
    Put.Line[log, " bytes in the file."];
    IF eof > 2*LONG[LAST[CARDINAL]] THEN
      BEGIN Put.Line[log, "The file is too big."]; GOTO FileTooBig; END;
    length ¬ Inline.LowHalf[eof/2];
    END;

    source ¬ MSegment.Create[file, [], 0];
    p ¬ MSegment.Address[source];
    e ¬ p;
    n ¬ p;
    a ¬ p;
    s ¬ p;
    header ¬ p;

    PrintHeader[];

    IF (p + length - 1)­ # Checksum.ComputeChecksum[0, length - 1, p] THEN
      Put.Line[log, "******The Checksum is bad."];

    numberOfNames ¬ header.numberOfNames;
    nameTableLocation ¬ LOOPHOLE[header.nameLookupTable];
    nameTable ¬ LOOPHOLE[e + nameTableLocation];
    IF NotEven[nameTableLocation] THEN
      Put.Line[
        log, "******  The Name lookup table does not start on an even word."];
    IF nameTableLocation + numberOfNames > length THEN
      Put.Line[log, "******  (Part of) The Name table is out of bounds."];

    numberOfAddrs ¬ header.numberOfAddrs;
    addrTableLocation ¬ LOOPHOLE[header.addrLookupTable];
    addrTable ¬ LOOPHOLE[e + addrTableLocation];
    IF NotEven[addrTableLocation] THEN
      Put.Line[
        log, "******  The Address lookup table does not start on an even word."];
    IF addrTableLocation + numberOfAddrs > length THEN
      Put.Line[log, "******  (Part of) The Address table is out of bounds."];

    lengthOfEntries ¬ header.lengthOfEntries;
    entryLocation ¬ RoundUp[addrTableLocation + numberOfAddrs];
    IF entryLocation + lengthOfEntries > length THEN
      Put.Line[log, "******  (Some of) The Entry blocks are out of bounds."];
    EXITS
      NoFile,
      FileTooShort,
      FileTooBig =>
        BEGIN IF source # NIL THEN MSegment.Delete[source]; source ¬ NIL; END;
    END;

  MakeSWs: Tool.MakeSWsProc =
    BEGIN
    form ¬ Tool.MakeFormSW[window: window, formProc: MakeForm];
    log ¬ Tool.MakeFileSW[window: window, name: "NetDirPrinter.log"];
    CheckFile[];
    END;

  MakeForm: FormSW.ClientItemsProcType =
    BEGIN
    nParams: CARDINAL = 4;
    items ¬ FormSW.AllocateItemDescriptor[nParams];
    items[0] ¬ FormSW.CommandItem[
      tag: "Initialize"L, proc: Initialize, place: FormSW.newLine];
    items[1] ¬ FormSW.CommandItem[tag: "Names"L, proc: Names];
    items[2] ¬ FormSW.CommandItem[tag: "Addresses"L, proc: Addresses];
    items[3] ¬ FormSW.CommandItem[tag: "Entries"L, proc: Entries];
    RETURN[items, TRUE];
    END;

  Init: PROCEDURE =
    BEGIN
    herald: STRING = [50];
    String.AppendString[herald, "NetDirPrinter of "L];
    Time.Append[herald, Time.Unpack[Runtime.GetBcdTime[]]];
    [] ¬ Tool.Create[name: herald, makeSWsProc: MakeSWs];
    END;

  Init[];
  END.