
    <<XNSSpyTool.mesa>>
        <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
        <<Demers, December 9, 1986 10:12:19 am PST>>
        <<Hal Murray, May 5, 1986 11:42:59 pm PDT>>
    <<>>
    <<Tool to watch all XNS packets received.>>
    <<>>
    DIRECTORY
        BasicTime USING [earliestGMT, GMT, Now],
        Commander USING [CommandProc, Register],
        CommBuffer USING [Overhead],
        CommDriver USING [Buffer, BufferObject, CreateInterceptor, DestroyInterceptor, GetNetworkChain, Interceptor, Network, 
        RecvInterceptor, SendInterceptor],
        Convert USING [RopeFromCard],
        Endian USING[BYTE, CardFromF, CardFromH, FFromCard, FWORD, HFromCard, HWORD],
        GenericTool USING [ButtonProc, CreateInstance, PutMsgRope, ToolHandle],
        IO USING [Error, PutChar, PutF, PutFR, PutRope, STREAM],
        PrincOpsUtils USING [LongMove],
        Process USING [ConditionPointer, EnableAborts, Pause, SecondsToTicks, SetTimeout],
        Pup USING [Host],
        Rope USING [Concat, FromChar, Length, ROPE],
        ViewerClasses USING [Viewer],
        XNS USING [Address, broadcastHost, GetThisHost, Host, Net, unknownHost],
        XNSAddressParsing USING [AddressFromRope, Error, Format, MyRope, RopeFromAddress],
        XNSBuf USING [Buffer, hdrBytes],
        XNSEchoBuf USING [Buffer],
        XNSErrorBuf USING [Buffer, minBodyBytes],
        XNSErrorTypes USING [badChecksumErr, ErrorType, invalidPacketTypeErr, listenerRejectErr, noSocketErr, protocolViolationErr, 
        resourceLimitsErr],
        XNSExchangeBuf USING [Buffer, hdrBytes],
        XNSExchangeTypes USING [ExchangeType, clearinghouseServiceType, teledebugType, timeServiceType],
        XNSRoutingBuf USING [Buffer, NumTuplesFromUserBytes],
        XNSSocket USING [GetUserBytes],
        XNSSPPBuf USING [Buffer, hdrBytes],
        XNSSPPTypes USING [];

    XNSSpyTool: CEDAR MONITOR
    IMPORTS BasicTime, Commander, CommDriver, Convert, Endian, GenericTool, IO, PrincOpsUtils, Process, Rope, XNS, XNSAddressParsing, 
    XNSRoutingBuf, XNSSocket
    ~ BEGIN

        ROPE: TYPE ~ Rope.ROPE;
        STREAM: TYPE ~ IO.STREAM;
        Viewer: TYPE ~ ViewerClasses.Viewer;

        BYTE: TYPE ~ Endian.BYTE;
        FWORD: TYPE ~ Endian.FWORD;
        HWORD: TYPE ~ Endian.HWORD;

        ToolHandle: TYPE ~ GenericTool.ToolHandle;
        ButtonProc: TYPE ~ GenericTool.ButtonProc;

        thisHost: XNS.Host _ XNS.GetThisHost[];

    <<Tool Creation>>
        toolName: ROPE ~ "XNSSpyTool";

        globalToolHandle: ToolHandle;

        RunningType: TYPE ~ { none, watch, stats };

        ControlHandle: TYPE ~ REF ControlObject;
        ControlObject: TYPE ~ RECORD [
            running: RunningType _ none,
            stop: ButtonProc _ Stop,
            watch: ButtonProc _ Watch,
            stats: ButtonProc _ Stats,
            putRouting: BOOL _ FALSE,
            putEcho: BOOL _ FALSE,
            putError: BOOL _ FALSE,
            putExchange: BOOL _ FALSE,
            putSPP: BOOL _ FALSE,
            putTranslation: BOOL _ FALSE,
            shortFormat: BOOL _ FALSE,
            maxLength: CARDINAL _ 576,
            thisMachine: ROPE,
            to: ROPE,
            from: ROPE];

        DataHandle: TYPE ~ REF DataObject;
        DataObject: TYPE ~ RECORD [
            interceptor: CommDriver.Interceptor _ NIL,
            printQHead, printQTail, printQFree: PrintBuf,
            printQNonempty: CONDITION,
            pleaseStop: BOOL _ FALSE,
            promiscuous: BOOL _ FALSE,
            fromHost: XNS.Host _ XNS.unknownHost,
            toHost: XNS.Host _ XNS.unknownHost,
            nTooLong: INT _ 0,
            nEcho: INT _ 0,
            nError: INT _ 0,
            nExchange: INT _ 0,
            nRouting: INT _ 0,
            nSPP: INT _ 0,
            nTranslation: INT _ 0
            ];

        Create: ENTRY PROC RETURNS [created: BOOL] ~ {
            cH: ControlHandle;
            dH: DataHandle;
            IF globalToolHandle # NIL THEN RETURN [FALSE];
            cH _ NEW[ControlObject _ [thisMachine~XNSAddressParsing.MyRope[]]];
            dH _ NEW[DataObject _ []];
            TRUSTED { InitCond[@dH.printQNonempty] };
            globalToolHandle _ GenericTool.CreateInstance[
                toolName~toolName,
                control~cH,
                options~LIST[
                    ["thisMachine", readonly[]],
                    ["to", notify[GetFilterAddresses]],
                    ["from", notify[GetFilterAddresses]]
                    ],
                data~dH,
                preDestroy~PreDestroy
                ];
            RETURN [TRUE];
            };

        InitCond: UNSAFE PROC [cP: Process.ConditionPointer] ~ UNCHECKED {
            Process.EnableAborts[cP];
            Process.SetTimeout[cP, Process.SecondsToTicks[1]];
            };

        Enter: ENTRY PROC [tH: ToolHandle, me: RunningType] RETURNS [entered: BOOL] ~ {
            cH: ControlHandle ~ NARROW[tH.control];
            IF cH.running # none THEN {
                GenericTool.PutMsgRope[tH, "Tool is busy", TRUE];
                RETURN [FALSE] };
            cH.running _ me;
            RETURN [TRUE];
            };

        Exit: PROC [tH: ToolHandle] ~ {
            cH: ControlHandle ~ NARROW[tH.control];
            cH.running _ none };

        Stop: ButtonProc ~ {
            cH: ControlHandle ~ NARROW[tH.control];
            dH: DataHandle ~ NARROW[tH.data];
            WHILE cH.running # none DO
                dH.pleaseStop _ TRUE;
                Process.Pause[ Process.SecondsToTicks[1] ];
                ENDLOOP;
            dH.pleaseStop _ FALSE;
            };

        PreDestroy: ButtonProc ~ {
            Stop[tH];
            globalToolHandle _ NIL };

        GetFilterAddresses: ButtonProc ~ {
            dH: DataHandle ~ NARROW[tH.data];
            cH: ControlHandle ~ NARROW[tH.control];
            gotTo, gotFrom: BOOL;
            {
                ENABLE XNSAddressParsing.Error => {
                    GenericTool.PutMsgRope[tH, text, TRUE]; CONTINUE };
                gotTo _ gotFrom _ FALSE;
                dH.toHost _ dH.fromHost _ thisHost; 
                IF Rope.Length[cH.to] > 0 THEN {
                    dH.toHost _ XNSAddressParsing.AddressFromRope[cH.to].host;
                    gotTo _ TRUE };
                IF Rope.Length[cH.from] > 0 THEN {
                    dH.fromHost _ XNSAddressParsing.AddressFromRope[cH.from].host;
                    gotFrom _ TRUE };
                };
            dH.promiscuous _ (gotTo OR gotFrom);
            };

        Stats: ButtonProc ~ {
            dH: DataHandle ~ NARROW[tH.data];
            cH: ControlHandle ~ NARROW[tH.control];
        IF NOT Enter[tH, stats] THEN RETURN;
            { ENABLE IO.Error, ABORTED => CONTINUE;
                IO.PutF[tH.out, "\n%7g echo\n%7g error\n%7g exchange\n%7g routing\n%7g spp\n", [integer[dH.nEcho]], [integer[dH.nError]], 
                [integer[dH.nExchange]], [integer[dH.nRouting]], [integer[dH.nSPP]] ];
                IO.PutF[tH.out, "\n%7g translation\n", [integer[dH.nTranslation]] ];
                IO.PutF[tH.out, "\n%7g dropped (too long)\n", [integer[dH.nTooLong]] ];
                IO.PutF[tH.out, "\n%7g total\n\n", [integer[
                    dH.nEcho+dH.nError+dH.nExchange+dH.nRouting+dH.nSPP+dH.nTranslation]] ];
                };
            Exit[tH];
            };
    <<Print Utilities>>
        HfC: PROC [c: CARDINAL] RETURNS [HWORD] ~ INLINE {
            RETURN [Endian.HFromCard[c]] };
        FfC: PROC [c: LONG CARDINAL] RETURNS [FWORD] ~ INLINE {
            RETURN [Endian.FFromCard[c]] };
        CfH: PROC [h: HWORD] RETURNS [CARDINAL] ~ INLINE {
            RETURN [Endian.CardFromH[h]] };
        CfF: PROC [f: FWORD] RETURNS [LONG CARDINAL] ~ INLINE {
            RETURN [Endian.CardFromF[f]] };

        RopeFromHost: PROC[h: XNS.Host] RETURNS[r: ROPE] ~ {
            temp: MACHINE DEPENDENT RECORD[host1: FWORD, host2: HWORD] ~ LOOPHOLE[h];
            r _ IO.PutFR["%x%04xH", [cardinal[CfF[temp.host1]]], [cardinal[CfH[temp.host2]]] ];
            };

        PutAddress: PROC[s: STREAM, a: XNS.Address] ~ {
            temp: MACHINE DEPENDENT RECORD[
                net: FWORD, host1: FWORD, host2: HWORD, socket: HWORD] ~ LOOPHOLE[a];
            IO.PutF[s, "%xH.%x%04xH.%xH",
            [cardinal[CfF[temp.net]]], [cardinal[CfF[temp.host1]]],
            [cardinal[CfH[temp.host2]]], [cardinal[CfH[temp.socket]]] ];
            };

    <<XNS Buffers>>
        DisplayXNSBuf: PROC [s: STREAM, b: XNSBuf.Buffer, heading: ROPE, when: BasicTime.GMT, short: BOOL] ~ {
            <<Print an XNS buffer on s.  No assumptions about encapsulation.>>

            PutHdr: PROC [typeName: ROPE] ~ {
                IO.PutF[s, "XNS %g %g:\nlen %g, dst ", [rope[heading]], [time[when]], [cardinal[CfH[b.hdr1.length]]] ];
                PutAddress[s, b.hdr1.dest];
                IO.PutRope[s, ", src "];
                PutAddress[s, b.hdr1.source];
                IO.PutF[s, ", type %g\n", [rope[typeName]] ];
                };

            SELECT b.hdr1.type FROM
                routing => {
                    PutHdr["routing"];
                    TRUSTED { PutRoutingBuf[s, LOOPHOLE[b], short] }};
                echo => {
                    PutHdr["echo"];
                    TRUSTED { PutEchoBuf[s, LOOPHOLE[b], short] }};
                error => {
                    PutHdr["error"];
                    TRUSTED { PutErrorBuf[s, LOOPHOLE[b], short] }};
                exchange => {
                    PutHdr["exchange"];
                    TRUSTED { PutExchangeBuf[s, LOOPHOLE[b], short] }};
                spp => {
                    PutHdr["spp"];
                    TRUSTED { PutSPPBuf[s, LOOPHOLE[b], short] }};
                ENDCASE => {
                    PutHdr[Convert.RopeFromCard[ORD[b.hdr1.type], 16]] };
            };
            <<>>
        PutRoutingBuf: PROC [s: STREAM, b: XNSRoutingBuf.Buffer, short: BOOL] ~ {
            <<Print contents of a routing information packet.>>
            numTuples: NAT ~ XNSRoutingBuf.NumTuplesFromUserBytes[b.hdr1.length - XNSBuf.hdrBytes];
            numToPrint: NAT;
            IO.PutF[s, "routingType %g, %g tuples:\n",
                [rope[ SELECT b.hdr2.type FROM
                request => "request", response => "response", ENDCASE => "???"]],
                [cardinal[numTuples]]
                ];
            numToPrint _ numTuples;
            IF short THEN numToPrint _ MIN[numToPrint, 5]; 
            FOR i: CARDINAL IN [0 .. numToPrint) DO
                IO.PutF[s, "[%09x,%2g] ", [cardinal[CfF[LOOPHOLE[b.body.tuples[i].net]]]], [cardinal[CfH[b.body.tuples[i].delay]]] ];
                ENDLOOP;
            IF numToPrint < numTuples THEN IO.PutRope[s, " ..."];
            IO.PutChar[s, '\n];
            };
            <<>>
        PutEchoBuf: PROC [s: STREAM, b: XNSEchoBuf.Buffer, short: BOOL] ~ {
            <<Put generic part of echo packet.>>
            IO.PutF[s, "echoType %g\n",
                [rope[SELECT b.hdr2.type FROM
                request => "request",
                reply => "reply",
                ENDCASE => Convert.RopeFromCard[ORD[b.hdr2.type]]]]
                ];
            };
            <<>>
        RopeFromErrorType: PROC [t: XNSErrorTypes.ErrorType] RETURNS [r: ROPE] ~ INLINE {
            SELECT TRUE FROM
                t = XNSErrorTypes.badChecksumErr => r _ "badChecksum";
                t = XNSErrorTypes.noSocketErr => r _ "noSocket";
                t = XNSErrorTypes.resourceLimitsErr => r _ "resourceLimit";
                t = XNSErrorTypes.listenerRejectErr => r _ "listenerReject";
                t = XNSErrorTypes.invalidPacketTypeErr => r _ "invalidPacketType";
                t = XNSErrorTypes.protocolViolationErr => r _ "protocolViolation";
                ENDCASE => r _ Convert.RopeFromCard[t.a*256+t.b, 16];
            };

        PutErrorBuf: PROC [s: STREAM, b: XNSErrorBuf.Buffer, short: BOOL] ~ {
            <<Print generic part of an error packet.>>
            <<Note this clobbers the content of the buffer!>>
            IO.PutF[s, "errorType %g, param %g\n",
                [rope[ RopeFromErrorType[b.hdr2.type] ]],
                [cardinal[CfH[b.hdr2.param]]]
                ];
            IF NOT short THEN {
                nsb: XNSBuf.Buffer;
                TRUSTED { nsb _ LOOPHOLE[b] };
                IF XNSSocket.GetUserBytes[nsb] >= XNSErrorBuf.minBodyBytes
                    THEN TRUSTED {
                        PrincOpsUtils.LongMove[
                            from: @b.body,
                            nwords: (XNSErrorBuf.minBodyBytes+1)/2,
                            to: @nsb.hdr1];
                        DisplayXNSBuf[s, nsb, "error body", BasicTime.earliestGMT, TRUE];
                        }
                    ELSE {
                        IO.PutF[s, "(short body)\n"];
                        };
                };
            };
            <<>>
        RopeFromExchangeType: PROC [t: XNSExchangeTypes.ExchangeType]
        RETURNS [r: ROPE] ~ INLINE {
            SELECT TRUE FROM
                t = XNSExchangeTypes.timeServiceType => r _ "timeService";
                t = XNSExchangeTypes.clearinghouseServiceType => r _ "clearinghouseService";
                t = XNSExchangeTypes.teledebugType => r _ "teledebug";
                ENDCASE => r _ Convert.RopeFromCard[t.a*256+t.b, 16];
            };

        PutExchangeBuf: PROC [s: STREAM, b: XNSExchangeBuf.Buffer, short: BOOL] ~ {
            <<Print generic part of an exchange packet.>>
            IO.PutF[s, "exchangeID %g, exchangeType %g\n",
                [cardinal[ CfF[b.hdr2.id] ]],
                [rope[ RopeFromExchangeType[b.hdr2.type] ]]
                ];
            {
                nBytes: INT _ CfH[b.hdr1.length];
                nHWords, nToPrint: INT;
                nBytes _ nBytes - XNSBuf.hdrBytes - XNSExchangeBuf.hdrBytes;
                IO.PutF[s, "len %g, data", [integer[nBytes]]];
                nToPrint _ nHWords _ (nBytes + 1) / 2;
                IF short THEN nToPrint _ MIN[nToPrint, 8];
                FOR i: INT IN [0 .. nToPrint) DO
                    IO.PutF[s, " %g", [cardinal[CfH[b.body.hWords[i]]]] ];
                    ENDLOOP;
                IF nToPrint < nHWords THEN IO.PutF[s, " ..."];
                IO.PutChar[s, '\n];
                };
            };
            <<>>
        PutSPPBuf: PROC [s: STREAM, b: XNSSPPBuf.Buffer, short: BOOL] ~ {
            <<Print generic part of an SPP packet.>>
            IO.PutF[s, "[ "];
            IF b.hdr2.connCtl.system THEN IO.PutF[s, "system "];
            IF b.hdr2.connCtl.sendAck THEN IO.PutF[s, "sendAck "];
            IF b.hdr2.connCtl.attn THEN IO.PutF[s, "attention "];
            IF b.hdr2.connCtl.endOfMsg THEN IO.PutF[s, "endOfMsg "];
            IO.PutF[s, "], "];
            IO.PutF[s, "sst %g, srcID %g, destID %g, ",
            [cardinal[b.hdr2.sst]], [cardinal[CfH[b.hdr2.sourceConnID]]], [cardinal[CfH[b.hdr2.destConnID]]] ];
            IO.PutF[s, "seq %g, ack %g, alloc %g\n",
            [cardinal[CfH[b.hdr2.seqNum]]], [cardinal[CfH[b.hdr2.ackNum]]], [cardinal[CfH[b.hdr2.allocNum]]] ];
            {
                nBytes: INT _ CfH[b.hdr1.length];
                nHWords, nToPrint: INT;
                nBytes _ nBytes - XNSBuf.hdrBytes - XNSSPPBuf.hdrBytes;
                IO.PutF[s, "len %g, data", [integer[nBytes]]];
                nToPrint _ nHWords _ (nBytes + 1) / 2;
                IF short THEN nToPrint _ MIN[nToPrint, 8];
                FOR i: INT IN [0 .. nToPrint) DO
                    IO.PutF[s, " %g", [cardinal[CfH[b.body.hWords[i]]]] ];
                    ENDLOOP;
                IF nToPrint < nHWords THEN IO.PutF[s, " ..."];
                IO.PutChar[s, '\n];
                };
            };

    <<Translation Buffers>>
        TranslationType: TYPE ~ MACHINE DEPENDENT RECORD [a, b: BYTE];

        requestType: TranslationType ~ [010H, 041H];
        replyType: TranslationType ~ [00eH, 038H];

        HostPair: TYPE ~ MACHINE DEPENDENT RECORD [
            xnsHost: XNS.Host,
            pupHost: Pup.Host,
            filler: BYTE];

        TranslationBuf: TYPE ~ REF TranslationBufObject;
        TranslationBufObject: TYPE ~ MACHINE DEPENDENT RECORD [
            ovh: CommBuffer.Overhead,
            translationType: TranslationType,
            replier: HostPair,
            requestor: HostPair];

        putTranslation: BOOL _ FALSE;

        PutHostPair: PROC [s: STREAM, hosts: HostPair] ~ INLINE {
            IO.PutF[s, "%g -> %g", [rope[RopeFromHost[hosts.xnsHost]]], [cardinal[hosts.pupHost]]];
        };

        DisplayTranslationBuf: PROC [s: STREAM, b: TranslationBuf, heading: ROPE, when: BasicTime.GMT, short: BOOL] ~ {
            <<Print an XNSEthernetOneTranslation buffer on s.  No assumptions about encapsulation.>>
            t: TranslationType ~ b.translationType;
            IO.PutF[s, "Translation %g %g:\ntype %g, ", [rope[heading]], [time[when]], 
                [rope[SELECT TRUE FROM
                    t = requestType => "request",
                    t = replyType => "reply",
                    ENDCASE => "???"]]
                ];
            IO.PutRope[s, "replier "];  PutHostPair[s, b.replier];  IO.PutRope[s, ", "];
            IO.PutRope[s, "requestor "];  PutHostPair[s, b.requestor];
            IO.PutChar[s, '\n];
            };

    <<Send and Receive Interceptor Procs>>
        Recv: CommDriver.RecvInterceptor
            <<[recv: RecvType, data: REF ANY, network: Network, buffer: Buffer, bytes: NAT] RETURNS [kill: BOOL _ FALSE]>>
            ~ {
            tH: ToolHandle;
            dH: DataHandle;
            cH: ControlHandle;

            tH _ NARROW[data];
            dH _ NARROW[tH.data];
            cH _ NARROW[tH.control];
            IF bytes > cH.maxLength THEN {
                dH.nTooLong _ dH.nTooLong.SUCC;
                RETURN };
            SELECT recv FROM
                xns => {
                    b: XNSBuf.Buffer;
                    TRUSTED { b _ LOOPHOLE[buffer] };
                    IF dH.promiscuous
                        THEN {
                            SELECT TRUE FROM
                                (b.hdr1.source.host = dH.fromHost) => {
                                    PostPrintRequest[tH~tH, kind~ns, buffer~buffer, direction~send] };
                                (b.hdr1.dest.host = dH.toHost) => {
                                    PostPrintRequest[tH~tH, kind~ns, buffer~buffer, direction~recv] };
                                (b.hdr1.dest.host = XNS.broadcastHost) => {
                                    PostPrintRequest[tH~tH, kind~ns, buffer~buffer, direction~recv] };
                                ENDCASE;
                            }
                        ELSE {
                            PostPrintRequest[tH~tH, kind~ns, buffer~buffer, direction~recv];
                            };
                    };
                xnsTranslate => {
                    PostPrintRequest[tH~tH, kind~translation, buffer~buffer, direction~recv];
                    };
                ENDCASE => NULL;
            }; 

        Send: CommDriver.SendInterceptor
            <<[send: SendType, data: REF ANY, network: Network, buffer: Buffer, bytes: NAT] RETURNS [kill: BOOL _ FALSE]]>>
            ~ {
            tH: ToolHandle;
            dH: DataHandle;
            cH: ControlHandle;

            tH _ NARROW[data];
            dH _ NARROW[tH.data];
            cH _ NARROW[tH.control];
            IF dH.promiscuous THEN RETURN;
            IF bytes > cH.maxLength THEN {
                dH.nTooLong _ dH.nTooLong.SUCC;
                RETURN };
            SELECT send FROM
                xns, xnsReturn => {
                    b: XNSBuf.Buffer;
                    TRUSTED { b _ LOOPHOLE[buffer] };
                    PostPrintRequest[tH~tH, kind~ns, buffer~buffer, direction~send];
                    };
                xnsTranslate => {
                    PostPrintRequest[tH~tH, kind~translation, buffer~buffer, direction~send];
                    };
                ENDCASE => NULL;
            };

        Install: ENTRY PROC [tH: ToolHandle] ~ {
            dH: DataHandle ~ NARROW[tH.data];
            network: CommDriver.Network ~ CommDriver.GetNetworkChain[];
            IF dH.interceptor # NIL THEN RETURN;
            IF network = NIL THEN RETURN;
            dH.interceptor _ CommDriver.CreateInterceptor[
                network~network,
                sendMask~[arpa~FALSE, arpaReturn~FALSE, arpaTranslate~FALSE, xns~TRUE, xnsReturn~TRUE, xnsTranslate~TRUE, pup~FALSE, 
                pupReturn~FALSE, pupTranslate~FALSE, other~FALSE, otherReturn~FALSE, otherTranslate~FALSE, raw~FALSE],
                sendProc~Send,
                recvMask~[arpa~FALSE, arpaTranslate~FALSE, xns~TRUE, xnsTranslate~TRUE, pup~FALSE, pupTranslate~FALSE, other~FALSE, 
                otherTranslate~FALSE, error~FALSE],
                recvProc~Recv,
                data~tH,
                promiscuous~dH.promiscuous];
            };

        UnInstall: ENTRY PROC [tH: ToolHandle] ~ {
            dH: DataHandle ~ NARROW[tH.data];
            IF dH.interceptor = NIL THEN RETURN;
            CommDriver.DestroyInterceptor[dH.interceptor];
            dH.interceptor _ NIL };
    <<Print Daemon>>
        <<The Daemon actually prints buffers that have been queued by Recv and Translate procs.>>

        BufKind: TYPE ~ { ns, translation };
        BufDirection: TYPE ~ { send, recv };

        PrintBuf: TYPE ~ REF PrintBufObject;
        PrintBufObject: TYPE ~ RECORD [
            bufObject: CommDriver.BufferObject,
            time: BasicTime.GMT,
            kind: BufKind,
            direction: BufDirection,
            next: PrintBuf];

        FlushPrintQueue: ENTRY PROC [dH: DataHandle] ~ {
            IF dH.printQTail # NIL THEN {
                dH.printQTail.next _ dH.printQFree;  dH.printQFree _ dH.printQHead; 
                dH.printQHead _ dH.printQTail _ NIL };
            };

        EnqueuePrintBuf: ENTRY PROC [dH: DataHandle, b: PrintBuf] ~ INLINE {
            IF dH.printQHead = NIL
                THEN {
                    dH.printQHead _ dH.printQTail _ b;
                    NOTIFY dH.printQNonempty }
                ELSE {
                    dH.printQTail.next _ b;
                    dH.printQTail _ b };
            b.next _ NIL
            };

        DequeuePrintBuf: ENTRY PROC [dH: DataHandle] RETURNS [b: PrintBuf] ~ INLINE {
            ENABLE UNWIND => NULL;
            WHILE (b _ dH.printQHead) = NIL DO
                IF dH.pleaseStop THEN RETURN;
                WAIT dH.printQNonempty
                ENDLOOP;
            dH.printQHead _ b.next;
            b.next _ NIL;
            };

        AllocPrintBuf: ENTRY PROC [dH: DataHandle] RETURNS [b: PrintBuf] ~ INLINE {
            IF (b _ dH.printQFree) # NIL
                THEN {
                    dH.printQFree _ b.next;
                    b.next _ NIL }
                ELSE {
                    b _ NEW[PrintBufObject _ [bufObject~, time~, kind~, direction~, next~NIL]] };
            };

        FreePrintBuf: ENTRY PROC [dH: DataHandle, b: PrintBuf] ~ INLINE {
            b.next _ dH.printQFree;  dH.printQFree _ b;
            };

        PostPrintRequest: PROC [tH: ToolHandle, kind: BufKind, buffer: CommDriver.Buffer, direction: BufDirection] ~ {
            cH: ControlHandle ~ NARROW[tH.control];
            dH: DataHandle _ NARROW[tH.data];
            b: PrintBuf;
            SELECT kind FROM
                ns => {
                    nsb: XNSBuf.Buffer;
                    TRUSTED { nsb _ LOOPHOLE[buffer] };
                    SELECT nsb.hdr1.type FROM
                        routing => {
                            dH.nRouting _ dH.nRouting + 1;
                            IF NOT cH.putRouting THEN RETURN };
                        echo => {
                            dH.nEcho _ dH.nEcho + 1;
                            IF NOT cH.putEcho THEN RETURN };
                        error => {
                            dH.nError _ dH.nError + 1;
                            IF NOT cH.putError THEN RETURN };
                        exchange => {
                            dH.nExchange _ dH.nExchange + 1;
                            IF NOT cH.putExchange THEN RETURN };
                        spp => {
                            dH.nSPP _ dH.nSPP + 1;
                            IF NOT cH.putSPP THEN RETURN };
                        ENDCASE => {
                            NULL };
                    };
                translation => {
                    IF NOT cH.putTranslation THEN RETURN };
                ENDCASE => ERROR;
            b _ AllocPrintBuf[dH];
            b.bufObject _ buffer^;
            b.bufObject.ovh.next _ NIL;
            b.bufObject.ovh.network _ NIL;
            b.time _ BasicTime.Now[];
            b.kind _ kind;
            b.direction _ direction;
            EnqueuePrintBuf[dH, b];
            };

        Watch: PROC [tH: ToolHandle]  ~ {
            cH: ControlHandle ~ NARROW[tH.control];
            dH: DataHandle ~ NARROW[tH.data];
            b: PrintBuf;
            IF NOT Enter[tH, watch] THEN RETURN;
            FlushPrintQueue[dH];
            Install[tH];
            IO.PutF[tH.out, "\nStarted %g\n\n", [time[BasicTime.Now[]]] ];
            DO
                ENABLE IO.Error, ABORTED => EXIT;
                b _ DequeuePrintBuf[dH];
                IF dH.pleaseStop THEN EXIT;
                IF b = NIL THEN LOOP;
                SELECT b.direction FROM
                    send => SELECT b.kind FROM
                        ns => TRUSTED {
                            DisplayXNSBuf[tH.out, LOOPHOLE[b], "Send", b.time, cH.shortFormat] };
                        translation => TRUSTED {
                            DisplayTranslationBuf[tH.out, LOOPHOLE[b], "Send", b.time, cH.shortFormat] };
                        ENDCASE => ERROR;
                    recv => SELECT b.kind FROM
                        ns => TRUSTED {
                            DisplayXNSBuf[tH.out, LOOPHOLE[b], "Recv", b.time, cH.shortFormat] };
                        translation => TRUSTED {
                            DisplayTranslationBuf[tH.out, LOOPHOLE[b], "Recv", b.time, cH.shortFormat] };
                        ENDCASE => ERROR;
                    ENDCASE;
                IO.PutChar[tH.out, '\n];
                FreePrintBuf[dH, b];
                ENDLOOP;
            IO.PutF[tH.out, "\n\nStopped %g\n", [time[BasicTime.Now[]]] ];
        UnInstall[tH];
        Exit[tH];
            };

    <<Conversion Procs (for use from interpreter)>>
        CvtRopeFromCardinals: PROC [args: LIST OF CARDINAL] RETURNS [result: ROPE _ NIL] ~ {
            WHILE args # NIL DO
                n: CARDINAL ~ args.first;
                result _ Rope.Concat[result, Rope.FromChar[VAL[n/256]]];
                result _ Rope.Concat[result, Rope.FromChar[VAL[n MOD 256]]];
                args _ args.rest;
                ENDLOOP;
            };

        CvtAddrFromCardinals: PROC [args: LIST OF CARDINAL,
        format: XNSAddressParsing.Format _ productSoftware]
        RETURNS [result: ROPE _ NIL] ~ {
            buf: ARRAY [0..6) OF CARDINAL;
            FOR i: CARDINAL IN [0..6) DO
                IF args = NIL THEN RETURN ["args too short"];
                buf[i] _ args.first;  args _ args.rest;
                ENDLOOP;
            TRUSTED {
                result _ XNSAddressParsing.RopeFromAddress[LOOPHOLE[buf], format] };
            };
    <<Initialization>>
        Go: Commander.CommandProc
            <<[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]>>
            ~ {
            IF Create[]
                THEN RETURN [result~$Done]
                ELSE RETURN [result~$Failure]
            };

        Commander.Register[key~toolName, proc~Go];

        END.