-- Pupwatch: communications and user interface

-- [Indigo]<Grapevine>PupWatch>Looker.mesa

-- Andrew Birrell  23-Nov-81 11:24:44 --

DIRECTORY
  -- Look on [ivy]<Juniper>n.n>User> for Pine bcds (currently n.n = 6.1).

Ascii		USING[ BS, ControlW, CR, DEL, ESC, SP ],
--CommonPineDefs	USING[DataRequest, Parameters],
DisplayDefs	USING[ DestroyDisplay ],
FrameDefs	USING[ IsBound ],
InlineDefs	USING[ BITAND, BITSHIFT, COPY, HighHalf, LowHalf ],
KeyDefs		USING[ Keys ],
LookerDefs	USING[ Clear, DiskChar, DiskCommit, DiskMultiple, DiskPos,
		       EraseChar, GetLength, Lookup, LookupOutcome,
		       SetPos, WriteChar, WriteMultiple, WriteTitle ],
MMOps		USING[ MakeBoot ],
Mopcodes	USING[ zLI2, zLI3, zMISC, zSTARTIO ],
OsStaticDefs	USING[ OsStatics ],
--PrivateCommonPineDefs USING[pLeader],
ProcessDefs	USING[ Abort, CV, InterruptLevel, SetPriority ],
PupDefs		USING[ PupAddress ],
PupTypes,
StreamDefs	USING[ GetDefaultKey, KeyboardHandle, StartKeyHandler ],
StringDefs,
SystemDefs	USING[ AllocateHeapNode, FreeHeapNode ];

Looker: MONITOR

IMPORTS DisplayDefs, InlineDefs, FrameDefs, LookerDefs, MMOps, ProcessDefs,
        StreamDefs, StringDefs, SystemDefs =

BEGIN

herald: STRING = "PupWatch: version of 24-Nov-81 14:49:32"L;

LongTicks: TYPE = LONG CARDINAL;

ClockFormat: TYPE = { AltoI, AltoII};

AltoClock: TYPE = MACHINE DEPENDENT RECORD[ -- hardware clock formats --
   SELECT OVERLAID ClockFormat FROM
      AltoI =>  [clock: CanonicalClock],
      AltoII => [junk1: [0..17B], low10: [0..1777B], junk2: [0..3B], high16: CARDINAL],
   ENDCASE ];

CanonicalClock: TYPE = MACHINE DEPENDENT RECORD[
   SELECT OVERLAID * FROM
      pieces => [low10: [0..1777B], zero: [0..77B], high16: CARDINAL],
      tick =>   [ticks: LongTicks]
   ENDCASE ];

longTicksPerSecond:  LongTicks = 6321200B -- (5.88*10^6/224)SHL 6 --;
longTicksPerMSec:    LongTicks = longTicksPerSecond/1000;

ReadRawClock: PROC RETURNS[ AltoClock ] = MACHINE CODE
   { Mopcodes.zMISC, 11B; };

myClockFormat: ClockFormat;

MSec: PROC[rawClock: AltoClock] RETURNS[ LONG CARDINAL ] = INLINE
   BEGIN
   clock: CanonicalClock;
   WITH raw: rawClock SELECT myClockFormat FROM
      AltoI =>  clock _ raw.clock;
      AltoII => clock _ [pieces[low10:raw.low10, zero:, high16:raw.high16]];
   ENDCASE;
   clock.zero _ 0;
   RETURN[clock.ticks / longTicksPerMSec]
   END;


-- Ethernet driver --

HostNumber: TYPE = [0..256);

maxEtherLength: CARDINAL = 532 + 22 -- max Pup data + Pup header --;
-- Beware: ether packets with maxEtherLength+4 bytes can cause a parity
-- error at location 600B on Alto I's (microcode bug).

EtherBufferData: TYPE = MACHINE DEPENDENT RECORD[
   etherDest, etherSrce: HostNumber,
   etherType: {pup(1000B), ois(3000B), (177777B)},
   body: SELECT OVERLAID * FROM
     raw => [data:PACKED ARRAY [0..maxEtherLength) OF CHARACTER],
     pup => [pup: BufferData],
     ENDCASE ];

EtherBuffer: TYPE = POINTER TO EtherBufferData;

-- driver uses two ether buffers: one current, one standby --
etherBuffers: POINTER TO ARRAY [1..2] OF EtherBufferData =
                 SystemDefs.AllocateHeapNode[2*SIZE[EtherBufferData]];

Ethernet: TYPE = MACHINE DEPENDENT RECORD[
   status:        EtherStatus,
   interrupt:     WORD,
   endCount:      CARDINAL,
   loadMask:      WORD,
   inputCount:    CARDINAL,
   inputPointer:  EtherBuffer,
   outputCount:   CARDINAL, 
   outputPointer: EtherBuffer,
   spare2:        [0..256),
   hostNumber:    HostNumber ];

EtherStatus: TYPE = MACHINE DEPENDENT RECORD[
   micro: { inputDone(0), outputDone(1), overRun(2), overLoad(3),
            zeroLength(4), reset(5), microError(6), unset(255) },
   spare0, spare1, dataLate, collision, crc, input, output, incomplete:
      { yes(0), no(1) } ];

notPosted: EtherStatus = [unset,,,,,,,,];
inputOK:   EtherStatus = [inputDone,no,no,no,no,no,no,no,no];

ethernet: POINTER TO Ethernet = LOOPHOLE[600B];
etherCond: CONDITION; -- for naked notify --

StartInput: PROC = MACHINE CODE
   { Mopcodes.zLI2; Mopcodes.zSTARTIO };

Reset: PROC = MACHINE CODE
   { Mopcodes.zLI3; Mopcodes.zSTARTIO };


-- Pup level --

maxPupLength: CARDINAL = 54;

BufferData: TYPE = MACHINE DEPENDENT RECORD[
   pupLength: CARDINAL,
   pupTransportControl: [0..256),
   pupType: PupTypes.PupType,
   pupID: PupTypes.Pair,
   dest: PupDefs.PupAddress,
   source: PupDefs.PupAddress,
   pupBody: SELECT OVERLAID * FROM
     pupChars => [pupChars: PACKED ARRAY[0..maxPupLength) OF CHARACTER],
     pupBytes => [pupBytes: PACKED ARRAY[0..maxPupLength) OF [0..377B]],
     pupWords => [pupWords: ARRAY[0..maxPupLength/2) OF CARDINAL],
     pupString => [pupString: StringBody],
     rfc =>   [address: PupDefs.PupAddress ],
     ack =>   [maximumBytesPerPup, numberOfPupsAhead,
               numberOfBytesAhead: CARDINAL ],
     abort => [abortCode: CARDINAL,
               abortText: PACKED ARRAY [0..0) OF CHARACTER ],
     error => [errorHeader: ARRAY [0..9] OF WORD,
               errorCode: CARDINAL,
               errorOptions: WORD,
               errorText: PACKED ARRAY [0..0) OF CHARACTER],
     nameIs => [nameIs: ARRAY [0..0) OF PupDefs.PupAddress ],
     ENDCASE ];

Buffer: TYPE = POINTER TO BufferData;

ContentsBytes: PROC[b: Buffer] RETURNS[CARDINAL] = INLINE
   { RETURN[ b.pupLength - 22 ] };

nBuffers: CARDINAL = 300;
BufferIndex: TYPE = [0..nBuffers);

buffers: POINTER TO ARRAY BufferIndex OF BufferData =
            SystemDefs.AllocateHeapNode[nBuffers * SIZE[BufferData]];

times: POINTER TO ARRAY BufferIndex OF AltoClock =
            SystemDefs.AllocateHeapNode[nBuffers * SIZE[AltoClock]];

lost: PACKED ARRAY BufferIndex OF BOOLEAN _ ALL[FALSE];
logged: PACKED ARRAY BufferIndex OF BOOLEAN _ ALL[FALSE];

wBuffer: BufferIndex _ 0; -- buffer being written by ethernet driver --
rBuffer: BufferIndex _ 0; -- buffer Looker wants to read --
fullBuffers: [0..nBuffers] _ 0;
bufferChange: CONDITION;
driverWaiting: BOOLEAN _ FALSE;
lookerWaiting: BOOLEAN _ FALSE;
allUsed: BOOLEAN _ FALSE; -- whether all buffers have been written --

GetBuffer: ENTRY PROC RETURNS[BufferIndex] = --INLINE--
   BEGIN
   ENABLE UNWIND => lookerWaiting _ FALSE;
   WHILE fullBuffers = 0
   DO lookerWaiting _ TRUE; WAIT bufferChange ENDLOOP;
   lookerWaiting _ FALSE;
   RETURN[ rBuffer ]
   END;

ReturnBuffer: ENTRY PROC = --INLINE--
   { rBuffer _ IF rBuffer = LAST[BufferIndex] THEN 0 ELSE SUCC[rBuffer];
     fullBuffers _ fullBuffers-1;
     IF driverWaiting THEN NOTIFY bufferChange };

ReplayBuffers: ENTRY PROC =
   BEGIN
   rBuffer _ IF allUsed
             THEN IF wBuffer = LAST[BufferIndex] THEN 0 ELSE SUCC[wBuffer]
             ELSE 0;
   fullBuffers _ (wBuffer+nBuffers-rBuffer) MOD nBuffers;
   IF lookerWaiting THEN NOTIFY bufferChange;
   END;

FlushBuffers: ENTRY PROC =
   BEGIN
   rBuffer _ wBuffer _ 0;
   fullBuffers _ 0; allUsed _ FALSE; lost _ ALL[FALSE]; logged _ ALL[FALSE];
   IF driverWaiting THEN NOTIFY bufferChange;
   END;

NextBuffer: INTERNAL PROC = --INLINE--
   BEGIN
   ENABLE UNWIND => driverWaiting _ FALSE;
   IF wBuffer = LAST[BufferIndex]
   THEN { allUsed _ TRUE; wBuffer _ 0 }
   ELSE wBuffer _ SUCC[wBuffer];
   IF lookerWaiting THEN NOTIFY bufferChange;
   logged[wBuffer] _ lost[wBuffer] _ FALSE;
   -- don't overwrite nBuffers/2 old ones, to help "replay" facility. --
   IF fullBuffers >= nBuffers/2
   THEN WHILE fullBuffers+50 >= nBuffers/2 --make sure we have 50 free--
        DO driverWaiting_TRUE; lost[wBuffer] _ TRUE;
           WAIT bufferChange
        ENDLOOP;
   fullBuffers _ fullBuffers+1;
   driverWaiting _ FALSE;
   END;

wanted: PupDefs.PupAddress _ [ [0], [0], [0,0] ];

Driver: ENTRY PROC =
   BEGIN
   ProcessDefs.SetPriority[4];
   ethernet.inputCount _ SIZE[EtherBufferData];
   ethernet.inputPointer _ @(etherBuffers[1]);
   ethernet.status _ notPosted;
   StartInput[];
   DO ENABLE ABORTED => EXIT;
      current: EtherBuffer = ethernet.inputPointer;
      next:    EtherBuffer = IF current = @(etherBuffers[1])
                             THEN @(etherBuffers[2])
                             ELSE @(etherBuffers[1]);
      thisStatus: EtherStatus;
      DO WAIT etherCond;
         IF (thisStatus _ ethernet.status) # notPosted
         THEN BEGIN
              -- restart the microcode as soon as possible --
              ethernet.inputPointer _ next;
              ethernet.status _ notPosted;
              StartInput[];
              EXIT
              END;
      ENDLOOP;
      IF thisStatus = inputOK
      AND current.etherType = pup
      AND (  (current.pup.dest.host = wanted.host
              AND current.pup.dest.net = wanted.net)
          OR (current.pup.source.host = wanted.host
              AND current.pup.source.net = wanted.net)
          )
      THEN BEGIN
           myBuffer: BufferIndex = wBuffer;
           times[myBuffer] _ ReadRawClock[];
           InlineDefs.COPY[from: @(current.pup), to: @(buffers[myBuffer]),
                           nwords: SIZE[BufferData] ];
           NextBuffer[];
           END;
   ENDLOOP;
   Reset[];
   ProcessDefs.SetPriority[1];
   END;



driverProcess: PROCESS;

NoInterruptLevel: ERROR = CODE;
etherLevel: ProcessDefs.InterruptLevel;

TakeEthernet: PROC =
   BEGIN
   ethernet.hostNumber _ 0 --promiscuous--;
   FOR i: ProcessDefs.InterruptLevel IN ProcessDefs.InterruptLevel
   DO IF ProcessDefs.CV[i] = NIL THEN { etherLevel _ i; EXIT };
   REPEAT
   FINISHED => ERROR NoInterruptLevel[];
   ENDLOOP;
   ProcessDefs.CV[etherLevel] _ @etherCond;
   ethernet.interrupt _ InlineDefs.BITSHIFT[1, etherLevel];
   Reset[]; Reset[]; -- Hal says it sometimes doesn't work! --
   driverProcess _ FORK Driver[];
   END;

GiveEthernet: PROC =
   BEGIN
   ProcessDefs.Abort[driverProcess];
   JOIN driverProcess;
   ethernet.interrupt _ 0;
   ProcessDefs.CV[etherLevel] _ NIL;
   Reset[];
   END;



-- Synchronization with user type-in --

inputActive:  BOOLEAN _ TRUE;
lookerActive: BOOLEAN _ FALSE;
pauseWanted:  BOOLEAN _ FALSE;
inputChange:  CONDITION;
lookerChange: CONDITION;

ActivateLooker: ENTRY PROC RETURNS[ BOOLEAN ] = --INLINE--
   BEGIN
   ENABLE UNWIND => NULL;
   IF inputActive OR pauseWanted
   THEN BEGIN
        WHILE inputActive OR pauseWanted DO WAIT inputChange ENDLOOP;
        RETURN[FALSE]
        END
   ELSE BEGIN
        lookerActive _ TRUE; RETURN[TRUE]
        END;
   END;

DeactivateLooker: ENTRY PROC = INLINE
   { lookerActive _ FALSE; IF inputActive THEN NOTIFY lookerChange };

ActivateInput: ENTRY PROC =
   BEGIN
   ENABLE UNWIND => NULL;
   inputActive _ TRUE;
   WHILE lookerActive DO WAIT lookerChange ENDLOOP;
   END;

DeactivateInput: ENTRY PROC =
   BEGIN
   inputActive _ FALSE; NOTIFY inputChange;
   END;


-- Output subroutines --

mode: { display, disk} _ display;

-- Display line layout is:
-- 7777: from 77#377#777 [aData,L:777,to:177777]abcdefghijklmn
-- 7777:   to 77#377#777 [aData,L:777,to:177777]abcdefghijklmn
tabFrom:  CARDINAL;
tabTo:    CARDINAL;
tabAddr:  CARDINAL;
tabPkt:   CARDINAL;
tabData:  CARDINAL;

-- Disk log line layout is:
-- 7777: from 377#377#377 [aData,L:1024,to:177777] abcdefghijklmn
-- 7777:   to 377#377#377 [aData,L:1024,to:177777] abcdefghijklmn
diskFrom: CARDINAL;
diskPkt:  CARDINAL;
diskData: CARDINAL;

InitTabs: PROC =
  BEGIN
  tabFrom  _ LookerDefs.GetLength["7777: "L];
  tabTo    _ tabFrom +
              (LookerDefs.GetLength["from"L]-LookerDefs.GetLength["to"L]);
  tabAddr  _ tabFrom + LookerDefs.GetLength["from "L];
  tabPkt   _ tabAddr + LookerDefs.GetLength["77#777#777 "L];
  tabData  _ tabPkt + LookerDefs.GetLength["[aData,L:777,to:177777]"L];
  diskFrom _ 6;             -- "7777: " --
  diskPkt  _ diskFrom + 17; -- "from 377#377#377 " --
  diskData _ diskPkt + 25;  -- "[aData,L:1024,to:177777] " --
  END;

WriteChar: PROC[CHARACTER] _ LookerDefs.WriteChar;

WriteMultiple: PROC[DESCRIPTOR FOR PACKED ARRAY OF CHARACTER] _
  LookerDefs.WriteMultiple;

WriteString: PROC[s: STRING] =
   { WriteMultiple[DESCRIPTOR[@(s.text),s.length]] };

WritePup: PROC[b: Buffer] = INLINE
   { WriteMultiple[DESCRIPTOR[@(b.pupChars),
                   MIN[ContentsBytes[b],maxPupLength]]] };

WriteOctal777: PROC[n: CARDINAL] =
   BEGIN
   IF n >= 10B
   THEN BEGIN
        IF n >= 100B
        THEN WriteChar['0 + n / 100B];
        WriteChar['0 + (n/10B) MOD 10B];
        END;
   WriteChar['0 + n MOD 10B];
   END;

WriteOctal: PROC[n: CARDINAL] = INLINE
   BEGIN
   IF n < 1000B
   THEN WriteOctal777[n]
   ELSE WriteFullOctal[n];
   END;

WriteFullOctal: PROC[n: CARDINAL] =
   BEGIN
   WriteOctal777[n/1000B];
   WriteChar['0 + ((n/100B) MOD 10B)];
   WriteChar['0 + ((n/10B) MOD 10B)];
   WriteChar['0 + n MOD 10B];
   END; 

WriteLongOctal: PROC[n: LONG CARDINAL]  = INLINE
   BEGIN
   IF InlineDefs.HighHalf[n] # 0 THEN WriteOctal[InlineDefs.HighHalf[n]];
   WriteOctal[InlineDefs.LowHalf[n]];
   END;

WritePair: PROC[p: PupTypes.Pair] =
   { WriteOctal[p.a]; WriteChar[',]; WriteOctal[p.b] };

WriteDecimal: PROC[n: CARDINAL] = INLINE
   { s: STRING = [5]; StringDefs.AppendDecimal[s,n]; WriteString[s] };
 
WriteAddr: PROC[addr: PupDefs.PupAddress] = INLINE
   BEGIN
   WriteOctal777[addr.net];
   WriteChar['#];
   WriteOctal777[addr.host];
   WriteChar['#];
   WriteOctal777[InlineDefs.BITAND[addr.socket.b,777B]];
   END;

WriteID: PROC[n: CARDINAL] = INLINE
   BEGIN
   WriteString["to:"];
   WriteOctal[n];
   END;

prevMS: LONG CARDINAL _ MSec[ReadRawClock[]];

-- layout of Pup id's for Sequin/Leaf protocol --

SequinID: TYPE = MACHINE DEPENDENT RECORD[
   allocate: Byte, receiveSequence: Byte,
   control: SequinControl, sendSequence: Byte ];

Byte: TYPE = [0..256);

SequinControl: TYPE = MACHINE DEPENDENT {
  data(0), ack(1), nop(2), restart(3),
  check(4), open(5), break(6), close(7),
  closed(8), destroy(9), dallying(10), quit(11),
  broken(12), retransmit(13), stifle(14), openclose(15),
  opendestroy(16), (255) };

leafSocket: PupTypes.PupSocketID = [a:0,b:43B];


Watch: PROC[ b: Buffer, time: AltoClock ] =
   BEGIN
   DefaultBodyPrintout: PROC[b: Buffer] = INLINE
      { WriteString["L:"]; WriteOctal[ContentsBytes[b]] };
   BEGIN
        mscSrv: BOOLEAN = b.source.socket = PupTypes.miscSrvSoc
                          OR b.dest.socket = PupTypes.miscSrvSoc;
        leaf: BOOLEAN = b.source.socket = leafSocket
                        OR b.dest.socket = leafSocket;
        newMS: LONG CARDINAL = MSec[time];
        IF newMS >= prevMS + 10000
        THEN IF newMS >= prevMS + 1000*LONG[1000] -- 1000 seconds --
             THEN WriteString[IF prevMS = 0 THEN "first"L ELSE "long"L]
             ELSE BEGIN
                  WriteDecimal[InlineDefs.LowHalf[(newMS-prevMS)/1000]];
                  WriteChar['s];
                  END
        ELSE WriteDecimal[InlineDefs.LowHalf[ (newMS-prevMS) MOD 10000 ]];
        prevMS _ newMS;
        WriteChar[':];
        IF mode = display
        THEN BEGIN
             IF b.source.host = wanted.host
             AND b.source.net = wanted.net
             THEN { LookerDefs.SetPos[tabTo]; WriteString["to"];
                    LookerDefs.SetPos[tabAddr]; WriteAddr[b.dest] }
             ELSE { LookerDefs.SetPos[tabFrom]; WriteString["from"];
                    LookerDefs.SetPos[tabAddr]; WriteAddr[b.source] };
             LookerDefs.SetPos[tabPkt];
             END
        ELSE BEGIN
             LookerDefs.DiskPos[diskFrom];
             IF b.source.host = wanted.host
             AND b.source.net = wanted.net
             THEN { WriteString["  to "]; WriteAddr[b.dest] }
             ELSE { WriteString["from "]; WriteAddr[b.source] };
             LookerDefs.DiskPos[diskPkt];
             END;
        WriteChar['[];
        BEGIN
          type: STRING = SELECT b.pupType FROM

              -- registered pup types
              echoMe =>  "echoMe",
              iAmEcho => "iAmEcho",
              badEcho => "badEcho",
              error =>   "error",
              rfc =>     "rfc",
              abort =>   "abort",
              end =>     "end",
              endRep =>  "endRep",
              data =>    "data",
              aData =>   "aData",
              ack =>     "ack",
              mark =>    "mark",
              int =>     "int",
              intRep =>  "intRep",
              aMark =>   "aMark",
              eData =>   "eData",
              eAck =>    "eAck",
              eEnd =>    "eEnd",
              eAbort =>  "eAbort",
              rpp =>     "rpp",
              -- Cedar RPC pup types.  Bits are:
              -- 8..10: 3 (=> start at pt140)
              -- 11: {end(0),notEnd(1)}
              -- 12: {dontAck(0),pleaseAck(1)}
              -- 13..15: {call,data,ack,nak,rfa}
              pt140 =>   "RPC-call-end",
              pt141 =>   "RPC-data-end",
              pt142 =>   "RPC-ack",
              pt143 =>   "RPC-nak",
              pt144 =>   "RPC-RFA",
              pt150 =>   "RPC-a-call-end",
              pt151 =>   "RPC-a-data-end",
              pt152 =>   "RPC-ping",
              pt153 =>   "RPC-a-nak",
              pt154 =>   "RPC-a-RFA",
              pt160 =>   "RPC-call-more",
              pt161 =>   "RPC-data-more",
              pt170 =>   "RPC-a-call-more",
              pt171 =>   "RPC-a-data-more",

              -- unregistered pup types (possible overlap)
              gatewayRequest =>   "gatewayRequest",
              --also dateTextRequest (socket 4), statisticsRequest (socket 22)
              gatewayInfo =>      "gatewayInfo",
              --also dateTextIs (socket 4), statisticsAre (socket 22)
              dateTenexRequest => "dateTenexRequest",
              dateTenexIs =>      "dateTenexIs",
              dateAltoRequest =>  "dateAltoRequest",
              dateAltoIs =>       "dateAltoIs",
              mailCheck =>        "mailCheck",
              mailIsNew =>        "mailIsNew",
              mailNotNew =>       "mailNotNew",
              mailError =>        "mailError",
              mailCheckLaurel =>  "mailCheckL",
              nameLookup =>       "nameLookup",
              nameIs =>           "nameIs",
              nameError =>        "nameError",
              addressLookup =>    "addrLookup",
              addressIs =>        "addrIs",
              whereIsUser =>      "whereIsUser",
              userIs =>           "userIs",
              userError =>        "userError",
              netDirVersion =>    "netDirVersion",
              --also eventReport (socket 30)
              sendNetDir =>       "sendNetDir",
              --also eventReportReply (socket 30)
              bootFileSend =>     "bootFileSend",
              kissOfDeath =>      "kissOfDeath",
              bootDirReq =>       "bootDirReq",
              bootDirReply =>
                IF NOT leaf THEN "bootDirReply"
                ELSE SELECT LOOPHOLE[b.pupID,SequinID].control FROM
                     data=>  "lData",          ack=>        "lAck",
                     nop=>   "nop",            restart=>    "restart",
                     check=> "check",          open=>       "open",
                     break=> "break",          close=>      "close",
                     closed=>"closed",         destroy=>    "destroy",
                     dallying=>"dallying",     quit=>       "quit",
                     broken=>"broken",         retransmit=> "retransmit",
                     stifle=>"stifle",         openclose=>  "openClose",
                     opendestroy=>"opendestroy",
                     ENDCASE => "leaf?",
              -- Pine pup types
              request =>          IF mscSrv THEN "userAuthReq"
                                  ELSE "request",
              result =>           IF mscSrv THEN "userAuthOk"
                                  ELSE "result",
              unsolicited =>      IF mscSrv THEN "userAuthBad"
                                  ELSE "unsolicited",
              custodian =>        "custodian",
              sync =>             "sync",
              pineAck =>          "pineAck",
              noop =>             "noop",
            ENDCASE => NIL;
          IF type = NIL
          THEN BEGIN
               WriteString["pt"];
               WriteOctal[LOOPHOLE[b.pupType, CARDINAL]];
               END
          ELSE WriteString[type];
        END;

        WriteChar[',];

        SELECT b.pupType FROM
          error =>
            SELECT b.errorCode FROM
              PupTypes.badChecksumPupErrorCode =>
                WriteString["badChecksum"];
              PupTypes.noProcessPupErrorCode =>
                WriteString["noSuchPort"];
              PupTypes.resourceLimitsPupErrorCode =>
                WriteString["resourceLimits"];
              PupTypes.inconsistentPupErrorCode =>
                WriteString["inconsistentPup"];
              PupTypes.cantGetTherePupErrorCode =>
                WriteString["cantGetThere"];
              PupTypes.hostDownPupErrorCode =>
                WriteString["hostDown"];
              PupTypes.eightHopsPupErrorCode =>
                WriteString["sixteenHops"];
              PupTypes.tooBigPupErrorCode =>
                WriteString["tooBigPup"];
              PupTypes.iAmNotAGatewayPupErrorCode =>
                WriteString["iAmNotAGateway"];
              PupTypes.gatewayResourceLimitsPupErrorCode =>
                WriteString["gatewayResources"];
            ENDCASE => WriteOctal[b.errorCode];
          mailCheck, mailCheckLaurel, nameLookup =>
            WritePup[b];
          nameIs =>
            WriteAddr[b.nameIs[0]];
          abort =>
            WriteOctal[b.abortCode];
          data, aData =>
            BEGIN
            l: CARDINAL = ContentsBytes[b];
            WriteID[b.pupID.b+l];
            WriteString[",L:"];
            WriteOctal[l];
            END;
          ack =>
            BEGIN
            WriteID[b.pupID.b];
            WriteString[",pups:"];
            WriteOctal777[b.numberOfPupsAhead];
            END;
          mark, aMark =>
            BEGIN
            WriteID[b.pupID.b+1];
            WriteString[",mk:"];
            WriteOctal777[b.pupBytes[0]];
            END;
          rfc, echoMe =>
            BEGIN
            wellKnown: STRING = SELECT b.dest.socket FROM
                PupTypes.telnetSoc =>      "telnet",
                PupTypes.gatewaySoc =>     "gateway",
                PupTypes.ftpSoc =>         "ftp",
                PupTypes.miscSrvSoc =>     "miscSrv",
                PupTypes.echoSoc =>        "echo",
                PupTypes.bspTestSoc =>     "bspTest",
                PupTypes.mailSoc =>        "mail",
                PupTypes.eftpReceiveSoc => "eftp",
                PupTypes.copyDiskSoc =>    "copyDisk",
                PupTypes.rpcpSoc =>        "rpcp",
                PupTypes.librarianSoc =>   "librarian",
                PupTypes.pineSoc =>        "pine",
              ENDCASE => NIL;
            IF wellKnown # NIL
            THEN WriteString[wellKnown]
            ELSE BEGIN
                 IF b.dest.socket.b IN [50B..57B]
                 AND b.dest.socket.a IN [0..1]
                 THEN BEGIN -- RFC or EchoMe on a Grapevine socket --
                      gvSoc: STRING = SELECT b.dest.socket.b FROM
                          50B => "RS-enquire",
                          51B => "RS-update",
                          52B => "RS-poll",
                          53B => "GV-Lily",
                          54B => "MS-poll",
                          55B => "MS-forward",
                          56B => "MS-send",
                          57B => "MS-retrieve",
                        ENDCASE => ERROR;
                      IF b.dest.socket.a = 1 THEN WriteString["Test-"];
                      WriteString[gvSoc];
                      END
                 ELSE IF b.dest.socket.a = 0
                      AND b.dest.socket.b IN [0 .. 256)
                      THEN WriteOctal777[b.dest.socket.b];
                 END;
            END;
          end, endRep, int, intRep => NULL;
          pt140,pt141,pt142,pt143,pt144,
          pt150,pt151,pt152,pt153,pt154,
          pt160,pt161,
          pt170,pt171 => --Cedar RPC packet--
            BEGIN
            l: CARDINAL = ContentsBytes[b];
            WriteString["W:"];
            IF l < 20
            THEN { WriteString["?-"L]; WriteOctal[10-l/2] }
            ELSE WriteOctal[l/2-10];
            END;
          addressLookup =>
            WriteAddr[b.nameIs[0]];
          bootDirReply =>
            IF leaf
            THEN BEGIN
                 id: SequinID = LOOPHOLE[b.pupID];
                 IF b.dest.socket = leafSocket
                 THEN BEGIN
                      WriteString["rec:"];
                      WriteOctal777[id.receiveSequence];
                      WriteString[",send:"];
                      WriteOctal777[id.sendSequence];
                      END
                 ELSE BEGIN
                      WriteString["send:"];
                      WriteOctal777[id.sendSequence];
                      WriteString[",rec:"];
                      WriteOctal777[id.receiveSequence];
                      END;
--                 WriteString[",alloc:"];
--                 WriteOctal777[id.allocate];
                 IF id.control = data
                 THEN BEGIN
                      l: CARDINAL = ContentsBytes[b];
                      WriteString[",L:"];
                      WriteOctal[l];
                      END;
                 END;
          request =>
            IF mscSrv THEN WriteString[@(b.pupString)] --userAuthReq--
            ELSE {
-- Pine stuff commented out to save space - otherwise the compiler runs out
--              Wr: PROC[s: STRING] = { WriteString[s] };
--              L: PrivateCommonPineDefs.pLeader = LOOPHOLE[@b.pupBody];
--              P: POINTER TO CommonPineDefs.Parameters = LOOPHOLE[@L.params];
--	    WITH R: P.requestP SELECT FROM
--	      ReadPage => { Wr["ReadPage "]; WriteOctal[R.pageNumber] };
--	      WritePage => { Wr["WritePage "]; WriteOctal[R.pageNumber] };
--	      SetLength => { Wr["SetLength "]; WriteLongOctal[R.byteCount] };
--	      ReadLength => Wr["ReadLength"];
--	      CloseFile => Wr["CloseFile"];
--	      DestroyAnonymousFile => Wr["DestroyAnonymousFile"];
--	      ReadData => { Wr["ReadData "]; WriteLongOctal[R.firstBytePosition];
--	        WriteString[" for "]; WriteOctal[R.byteCount] };
--	      WriteData => { Wr["WriteData "]; WriteLongOctal[R.firstBytePosition];
--	        WriteString[" for "]; WriteOctal[R.byteCount] };
--	      ReadAttribute => { Wr["ReadAttribute "]; WriteOctal[R.attributeNumber] };
--	      WriteAttribute => { Wr["WriteAttribute "]; WriteOctal[R.attributeNumber] };
--	      SetReadLock => Wr["SetReadLock"];
--	      SetWriteLock => Wr["SetWriteLock"]; 
--	      ReleaseReadLock => Wr["ReleaseReadLock"];
--	      ObtainCapability => Wr["ObtainCapability"];
--	      Room => Wr["Room"];
--	      ChangePassword => Wr["ChangePassword"];
--	      OpenFile => Wr["OpenFile"];
--	      CreateAnonymousFile => Wr["CreateAnonymousFile"];
--	      FindFile => Wr["FindFile"];
--	      LockQuery => Wr["LockQuery"];
--	      TransCompletionQuery => Wr["TransCompletionQuery"];
--	      OpenFileFromCapability => Wr["OpenFileFromCapability"];
--	      Logout => Wr["Logout"];
--	      CloseTransaction => Wr["CloseTransaction"];
--	      AbortTransaction => Wr["AbortTransaction"];
--	      LookupFile => Wr["LookupFile"];
--	      CreateFile => Wr["CreateFile"];
--	      DestroyFile => Wr["DestroyFile"];
--	      RenameFile => Wr["RenameFile"];
--	      NextFile => Wr["NextFile"];
--	      NextFewFiles => Wr["NextFewFiles"];
--	      ValidateYourLocks => Wr["ValidateYourLocks"];
--	      ReleaseYourReadLocks => Wr["ReleaseYourReadLocks"];
--	      ENDCASE => Wr["Unknown Request Variant"];
--	    IF P.requestP.code IN CommonPineDefs.DataRequest THEN {
--	      Wr[" sfh "]; WriteOctal[P.h] };
            };
          result =>
            IF mscSrv THEN DefaultBodyPrintout[b] --userAuthOk--
            ELSE {
-- More Pine stuff commented out ...
--              Wr: PROC[s: STRING] = { WriteString[s] };
--              L: PrivateCommonPineDefs.pLeader = LOOPHOLE[@b.pupBody];
--              P: POINTER TO CommonPineDefs.Parameters = LOOPHOLE[@L.params];
--	    WITH R: P.resultP SELECT FROM
--	      HeresData => { Wr["HeresData "]; WriteOctal[R.length] };
--	      HeresLFH => Wr["HeresLFH"];
--	      HeresEntry => Wr["HeresEntry"];
--	      HeresFileList => { Wr["HeresFileList "]; WriteOctal[R.count] };
--	      HeresFile => { Wr["HeresFile "]; WriteOctal[R.f] };
--	      HeresLength => { Wr["HeresLength "]; WriteLongOctal[R.length] };
--	      CommandAck => Wr["CommandAck"];
--	      CommandNak => { Wr["CommandNak "]; WriteOctal[LOOPHOLE[R.en]] };
--	      LoginResponse => Wr["LoginResponse"];
--	      TransactionClosed => Wr["TransactionClosed"];
--	      LogoutResponse => Wr["LogoutResponse"];
--	      ResourceData => Wr["ResourceData"];
--	      TransCompletionInfo => Wr["TransCompletionInfo"];
--	      HeresRoom => Wr["HeresRoom"];
--	      LockQueryResponse => Wr["LockQueryResponse"];
--	      ENDCASE => Wr["Unknown Result Variant"];
            };
          unsolicited =>
            IF mscSrv THEN DefaultBodyPrintout[b] --userAuthBad--
            ELSE {
-- More Pine stuff commented out ...
--              L: PrivateCommonPineDefs.pLeader = LOOPHOLE[@b.pupBody];
--              P: POINTER TO CommonPineDefs.Parameters = LOOPHOLE[@L.params];
--	    WITH R: P.unsolicitedP SELECT FROM
--	      TransactionAborted => WriteString["TransactionAborted"];
--	      ReadLockBroken => WriteString["ReadLockBroken"];
--	      ENDCASE => WriteString["Unknown Unsolicited Variant"];
            };
          custodian => {
-- More Pine stuff commented out ...
--            L: PrivateCommonPineDefs.pLeader = LOOPHOLE[@b.pupBody];
--            P: POINTER TO CommonPineDefs.Parameters = LOOPHOLE[@L.params];
--	  WITH R: P.custodianP SELECT FROM
--	    Login => WriteString["Login"];
--	    AddServer => WriteString["AddServer"];
--	    ResourceLocation => WriteString["ResourceLocation"];
--	    ENDCASE => WriteString["Unknown Custodian Variant"];
            };
          sync => NULL;
          pineAck => NULL;
          noop => NULL;
        ENDCASE => DefaultBodyPrintout[b];
        WriteChar[']];
        IF mode = disk
        THEN BEGIN
             LookerDefs.DiskPos[diskData];
             WriteString["ID="];
             WritePair[b.pupID];
             WriteString[" from="];
             WritePair[LOOPHOLE[b.source.socket]];
             WriteString[" to="];
             WritePair[LOOPHOLE[b.dest.socket]];
             BEGIN
               l: CARDINAL = MIN[ContentsBytes[b],maxPupLength];
               WriteChar[Ascii.CR];
               LookerDefs.DiskPos[diskData];
               IF l = 0 THEN WriteString["{empty}"] ELSE WritePup[b];
               WriteChar[Ascii.CR];
               LookerDefs.DiskPos[diskData];
               IF l = 0
               THEN WriteString["{empty}"]
               ELSE FOR i: CARDINAL IN [0..MIN[l,maxPupLength/2])
                    DO WriteOctal777[b.pupBytes[i]];
                       WriteChar[Ascii.SP]
                    ENDLOOP;
             END;
             END
        ELSE IF b.pupType = data OR b.pupType = aData
             THEN { LookerDefs.SetPos[tabData]; WritePup[b] };
        WriteChar[Ascii.CR];
   END;
   END;


speed: {slow, fast} _ fast;
lookerCount: CARDINAL;

LookerMain: PROC =
   BEGIN
   countLimit: CARDINAL = 40;
   ProcessDefs.SetPriority[0];
   DO ENABLE ABORTED => EXIT;
      this: BufferIndex = GetBuffer[];
      IF ActivateLooker[]
      THEN BEGIN
           IF lost[this]
           THEN { WriteString["Lost packet(s)"L]; WriteChar[Ascii.CR] };
           Watch[@(buffers[this]), times[this]];
           ReturnBuffer[];
           IF speed = slow
           AND (lookerCount _ lookerCount + 1) >= countLimit
           THEN { WriteString["Type <SP> to continue ..."L];
                  pauseWanted _ TRUE };
           DeactivateLooker[];
           END;
   ENDLOOP;
   GiveEthernet[];
   END;

WriteDiskLog: PROC =
   BEGIN
   WriteChar _ LookerDefs.DiskChar;
   WriteMultiple _ LookerDefs.DiskMultiple;
   mode _ disk;
   WriteChar[Ascii.CR];
   ReplayBuffers[];
   IF logged[GetBuffer[]]
   THEN BEGIN
        WriteString["{ continued from previous logged packets }"L];
        WriteChar[Ascii.CR];
        THROUGH [1..fullBuffers]
        DO this: BufferIndex = GetBuffer[];
           IF logged[this]
           THEN prevMS _ MSec[times[this]]
           ELSE EXIT;
           ReturnBuffer[];
        ENDLOOP;
        END
   ELSE BEGIN
        WriteString["Watching host "L];
        WriteOctal777[wanted.net]; WriteChar['#];
        WriteOctal777[wanted.host]; WriteChar['#];
        WriteChar[Ascii.CR];
        END;
   THROUGH [1..fullBuffers]
   DO this: BufferIndex = GetBuffer[];
      IF lost[this]
      THEN { WriteString["Lost packet(s)"L]; WriteChar[Ascii.CR] };
      Watch[@(buffers[this]), times[this]];
      logged[this] _ TRUE;
      ReturnBuffer[];
   ENDLOOP;
   WriteChar _ LookerDefs.WriteChar;
   WriteMultiple _ LookerDefs.WriteMultiple;
   mode _ display;
   LookerDefs.DiskCommit[];
   END;



-- user command input --

WriteTitle: PROC =
   BEGIN
   myTitle: STRING = [50];
   StringDefs.AppendString[myTitle, "PUPWatch: watching host "L];
   StringDefs.AppendNumber[myTitle, wanted.net, 8];
   StringDefs.AppendChar[myTitle, '#];
   StringDefs.AppendNumber[myTitle, wanted.host, 8];
   StringDefs.AppendChar[myTitle, '#];
   LookerDefs.WriteTitle[myTitle];
   END;

HandleInput: PROC =
   BEGIN
   c: CHARACTER _ 'h;
   DO alreadyPaused: BOOLEAN = pauseWanted;
      IF pauseWanted AND c # Ascii.SP THEN WriteChar[Ascii.CR];
      lookerCount _ 0;
      SELECT c FROM
     'q, 'Q => { WriteString["Quit"]; EXIT };
     'f, 'F =>
       BEGIN
       WriteString["Fast"L];
       speed _ fast; pauseWanted _ FALSE;
       END;
     'h, 'H =>
       BEGIN
       s: STRING = [40];
       WriteString["Host (NLS-name or Net-address): "];
       DO c: CHARACTER = key.get[key];
          SELECT c FROM
           Ascii.BS =>
             BEGIN
             IF s.length > 0
             THEN { s.length _ s.length-1;
                    LookerDefs.EraseChar[s[s.length]] };
             LOOP
             END;
           Ascii.ControlW =>
             BEGIN
             FOR i: CARDINAL DECREASING IN [0..s.length)
             DO LookerDefs.EraseChar[s[i]] ENDLOOP;
             s.length _ 0;
             LOOP
             END;
           Ascii.DEL => GOTO del;
           Ascii.SP, Ascii.CR, Ascii.ESC => EXIT;
          ENDCASE => NULL;
          IF s.length < s.maxlength
          THEN { StringDefs.AppendChar[s, c]; WriteChar[c] };
       ENDLOOP;
       WriteString[" ... "];
       GiveEthernet[]; -- stops driver --
       BEGIN
          outcome: LookerDefs.LookupOutcome;
          net, host: [0..255];
          [outcome, net, host] _ LookerDefs.Lookup[s];
          SELECT outcome FROM
            ok =>
              BEGIN
              WriteString["ok"L];
              wanted.net _ [net]; wanted.host _ [host];
              LookerDefs.Clear[];
              FlushBuffers[];
              WriteTitle[];
              pauseWanted _ FALSE;
              END;
            noResponse => WriteString["no name-lookup response"L];
            badName => WriteString["name not found"L];
          ENDCASE => ERROR;
       END;
       TakeEthernet[]; -- starts driver --
       EXITS
         del => WriteString[" XXX"L];
       END;
     'r, 'R =>
       BEGIN
       LookerDefs.Clear[];
       WriteString["Replay (Slow)"L];
       ReplayBuffers[]; speed _ slow;
       pauseWanted _ FALSE;
       END;
     's, 'S =>
       BEGIN
       WriteString["Slow"L];
       speed _ slow;
       pauseWanted _ FALSE;
       END;
     'w, 'W =>
       IF version = boot
       THEN WriteString["""Write log"" not available in Pupwatch.boot"L]
       ELSE BEGIN
            WriteString["Writing Pupwatch.log ... "L];
            WriteDiskLog[];
            WriteString["ok"L];
            END;
     Ascii.SP =>
       IF pauseWanted
       THEN { WriteString[" continuing"L]; pauseWanted _ FALSE }
       ELSE pauseWanted _ TRUE;
     '? =>
       BEGIN
       WriteString["Commands are: Fast, Host, Quit, Replay, Slow"];
       IF version # boot THEN WriteString[", Write-log"L];
       IF NOT pauseWanted
       THEN { WriteChar[Ascii.CR]; WriteString["Type <SP> to pause"L] };
       END;
     ENDCASE => WriteChar['?];
     IF NOT pauseWanted OR alreadyPaused THEN WriteChar[Ascii.CR];
     IF pauseWanted THEN WriteString["Type <SP> to continue ..."L];
     DeactivateInput[];
     c _ key.get[key];
     ActivateInput[];
   ENDLOOP;
   END;



-- Initialisation --

version: { bcd, image, boot } = SELECT TRUE FROM
    FrameDefs.IsBound[MMOps.MakeBoot] => boot,
    FrameDefs.IsBound[DisplayDefs.DestroyDisplay] => bcd,
  ENDCASE => image;

lookerProcess: PROCESS;
key: StreamDefs.KeyboardHandle;

-- Our display module hasn't been started yet --

SELECT version FROM
  image => { StreamDefs.StartKeyHandler[]; STOP };
  bcd =>   { DisplayDefs.DestroyDisplay[] };
  boot =>  { IF KeyDefs.Keys.Spare1=up THEN MMOps.MakeBoot[] };
ENDCASE => ERROR;

-- We're now fully running, possibly after ether-booting --

myClockFormat _
  SELECT OsStaticDefs.OsStatics.AltoVersion.engineeringnumber FROM
    2,3 => AltoII,
  ENDCASE => AltoI;

LookerDefs.WriteTitle[herald];

key _ StreamDefs.GetDefaultKey[];

InitTabs[];

lookerProcess _ FORK LookerMain[];

TakeEthernet[];

HandleInput[];

ProcessDefs.Abort[lookerProcess]; JOIN lookerProcess;

SystemDefs.FreeHeapNode[etherBuffers];
SystemDefs.FreeHeapNode[buffers];
SystemDefs.FreeHeapNode[times];

END.