
    <<ArpaUDPImpl.mesa>>
        <<Demers, November 9, 1987 9:45:14 am PST>>

    DIRECTORY
        Allocator USING [NHeaderP, NormalHeader],
        Arpa USING [Address, nullAddress],
        ArpaBuf USING [Buffer, hdrBytes, Protocol],
        ArpaExtras USING [IsBroadcast],
        ArpaICMP USING [Buffer],
        ArpaIP USING [AllocBuffers, ChecksumProc, CreateHandle, Error, FreeBuffers, GetSource, GetUserBytes, Handle, nullRouteHint, 
        OnesComplementAddBlock, RecvProc, RouteHint, Send, SendToSelf, SetUserBytes],
        ArpaUDP USING [dontWait, Milliseconds, waitForever],
        ArpaUDPBuf USING [Buffer, BufferObject, hdrBytes, nullPort, Port],
        Basics USING [BITNOT, Card16FromH, FWORD, HFromCard16, HWORD],
        CommBuffer USING [Direction],
        CommDriver USING [BufferObject, Network],
        Process USING [Detach, DisableTimeout, EnableAborts, MsecToTicks, priorityForeground, SecondsToTicks, SetPriority, SetTimeout],
        SafeStorage USING [EnableFinalization, EstablishFinalization, FinalizationQueue, FQNext, NewFQ]
        ;

    ArpaUDPImpl: CEDAR MONITOR
        LOCKS h USING h: Handle
        IMPORTS ArpaExtras, ArpaIP, Basics, Process, SafeStorage
        EXPORTS ArpaUDP
        ~ {
    <<Types>>
        HWORD: TYPE ~ Basics.HWORD;
        FWORD: TYPE ~ Basics.FWORD;

        Address: TYPE ~ Arpa.Address;
        unknownAddress: Address ~ Arpa.nullAddress;

        Port: TYPE ~ ArpaUDPBuf.Port;
        nullPort: Port ~ ArpaUDPBuf.nullPort;

        Buffer: TYPE ~ ArpaUDPBuf.Buffer;
        Buffers: TYPE ~ ArpaUDPBuf.Buffer;

        Network: TYPE ~ CommDriver.Network;

        Error: PUBLIC ERROR [code: ATOM] ~ CODE;

        ReceivedError: PUBLIC ERROR [code: ATOM, remoteAddress: Address, remotePort: Port] ~ CODE;
    <<IP Interface>>
        ipHandle: ArpaIP.Handle _ NIL;
    <<Smashing Types of Buffers ...>>
        <<... between CommDriver.Buffer and ArpaUDPBuf.Buffer.  This is so the right finalizer gets to see any dropped buffers.  See the 
        comments near CommDriver.Buffer.  BEWARE: this stuff may be word size dependent.>>
        <<>>
        SmashToIPBuffer: PROC [b: Buffer] RETURNS [ArpaBuf.Buffer] = TRUSTED INLINE {
            nhp: Allocator.NHeaderP _ LOOPHOLE[b, Allocator.NHeaderP]-SIZE[Allocator.NormalHeader];
            nhp.type _ CODE[CommDriver.BufferObject];
            b.ovh.direction _ none;
            b.ovh.socket _ NIL;
            RETURN[LOOPHOLE[b]]; };
        SmashToUDPBuffer: PROC [b: ArpaBuf.Buffer, d: CommBuffer.Direction] RETURNS [Buffer] = TRUSTED INLINE {
            nhp: Allocator.NHeaderP _ LOOPHOLE[b, Allocator.NHeaderP]-SIZE[Allocator.NormalHeader];
            nhp.type _ CODE[ArpaUDPBuf.BufferObject];
            b.ovh.direction _ d;
            RETURN[LOOPHOLE[b]]; };
        IPBuffer: PROC [b: Buffer] RETURNS [ArpaBuf.Buffer] = TRUSTED INLINE {
            RETURN[LOOPHOLE[b]]; };
        UDPBuffer: PROC [aB: ArpaBuf.Buffer] RETURNS [Buffer] = TRUSTED INLINE {
            RETURN[LOOPHOLE[aB]]; };
        Next: PROC [b: Buffer] RETURNS [Buffer] = TRUSTED INLINE {
            RETURN[LOOPHOLE[b.ovh.next]]; };
    <<Checksums>>
    checksumsEnabled: BOOL _ FALSE;

    UDPPseudoHeader: TYPE ~ MACHINE DEPENDENT RECORD [
    sourceAddr: Arpa.Address, 
    destAddr: Arpa.Address, 
    zeroes: BYTE, 
    protocol: ArpaBuf.Protocol, 
    udpLength: HWORD];

        TestUDPChecksum: PROC [b: Buffers] RETURNS [ok: BOOL] ~ {
        tcs: HWORD;
            IF NOT checksumsEnabled THEN RETURN [TRUE]; -- DEBUG
            IF (tcs _ b.hdr2.checksum) = [0, 0] THEN RETURN [TRUE];
            ComputeUDPChecksum[IPBuffer[b]];
            IF b.hdr2.checksum = tcs THEN RETURN[TRUE];
            b.hdr2.checksum _ tcs;
            RETURN[FALSE];
            };

        ComputeUDPChecksum: ArpaIP.ChecksumProc -- [b: ArpaIP.Buffers] -- ~ {
            <<BEWARE: This is called from TestUDPChecksum with b: ArpaUDP.Buffers.>>
            cs: CARD16;
            udpPH: UDPPseudoHeader;
            udpB: Buffer _ UDPBuffer[b];
            finger: ArpaBuf.Buffer;
            IF NOT checksumsEnabled THEN { udpB.hdr2.checksum _ [0, 0]; RETURN }; -- DEBUG
            udpPH _ [sourceAddr~udpB.hdr1.source, destAddr~udpB.hdr1.dest, zeroes~0, protocol~udpB.hdr1.protocol, udpLength~udpB.hdr2.length];
            cs _ Basics.BITNOT[LOOPHOLE[udpB.hdr2.checksum]]; -- start with negative of UDP checksum field so we don't have to smash it to zero 
            to compute the real checksum.
        TRUSTED { cs _ ArpaIP.OnesComplementAddBlock[ptr~@udpPH, count~(BYTES[UDPPseudoHeader]/BYTES[CARD16]), initialSum~cs] };
            finger _ b;
            WHILE finger # NIL DO
                count: CARDINAL _ ArpaIP.GetUserBytes[finger].bodyBytes;
                IF (count MOD 2) # 0 THEN {
                    IF finger.ovh.next # NIL THEN ERROR; -- can't happen
                    finger.body.bytes[count] _ 0; count _ count + 1;
                    };
                count _ count / BYTES[CARD16];
                TRUSTED { cs _ ArpaIP.OnesComplementAddBlock[ptr~@finger.body, count~count, initialSum~cs] };
                TRUSTED { finger _ LOOPHOLE[finger.ovh.next] };
                ENDLOOP;
            IF (cs _ Basics.BITNOT[cs]) = 0 THEN cs _ CARD16.LAST;
            udpB.hdr2.checksum _ Basics.HFromCard16[cs];
            };
    <<Handles / Objects>>
        <<Conventions: must hold ML to touch ...BuffersInUse, inputEnqueue, inputDequeue, next.  May access address, port and BOOL fields 
        without holding ML.  BOOLs are atomic; it is client's responsibility not to change addresses/ports concurrently.>>
        <<>>
        Handle: TYPE ~ REF Object;
        Object: PUBLIC TYPE ~ MONITORED RECORD [
            next: Handle _ NIL,
            remoteAddress: Address,
            remotePort: Port,
            localPort: Port,
            sendChecksum: ArpaIP.ChecksumProc _ ComputeUDPChecksum,
            recvChecksum: BOOL _ TRUE,
            dead: BOOL _ FALSE,
            dontWait: BOOL _ FALSE,
            acceptErrors: BOOL,
            errorCode: ATOM _ NIL,
            errorAddress: Address,
            errorPort: Port,
            acceptLongDatagrams: BOOL,
            routeCache: ArpaIP.RouteHint _ NIL,
            putsUntilFlush: CARDINAL _ 0,
            putsBetweenFlushes: CARDINAL _ 0,
            waitForInput: CONDITION,
            waitForSendBuffer: CONDITION,
            sendBuffersInUse: CARDINAL _ 0,
            sendBuffersAllocated: CARDINAL,
            recvBuffersInUse: CARDINAL _ 0,
            inputEnqueue, inputDequeue: CARDINAL _ 0,
            inputQueue: SEQUENCE recvBuffersAllocated: CARDINAL OF Buffer
            ];
    <<Hash Table for Objects>>
        numHashHeaders: CARDINAL ~ 64;
        HashIndex: TYPE ~ [0 .. numHashHeaders);

        ObjectTable: TYPE ~ REF ObjectTableRep;
        ObjectTableRep: TYPE ~ ARRAY HashIndex OF Handle;

        objectTable: ObjectTable ~ NEW[ObjectTableRep];

        objectTableLock: Handle ~ NEW[Object];

        firstUniqueLocalPortNum: CARD16 ~ 4096;
        nextLocalPortNum: CARD16 _ firstUniqueLocalPortNum;
        maxLocalPortTries: CARDINAL _ 100;

        Hash: PROC [port: Port] RETURNS [HashIndex] ~ INLINE {
            RETURN [Basics.Card16FromH[port] MOD numHashHeaders] };

        AddNewHandle: ENTRY PROC [h: Handle _ objectTableLock, newHandle: Handle, localPort: Port] ~ {
            <<Insert newHandle in hash table, making up unique local port number if necessary.>>
            <<Called before finalization of newHandle is enabled.>>
            i: HashIndex;
            SELECT TRUE FROM
                (localPort # nullPort) => {
                    i _ Hash[localPort];
                    };
                ENDCASE => {
                    FOR try: CARDINAL _ 0, try+1 DO
                        finger: Handle;
                        localPort _ Basics.HFromCard16[nextLocalPortNum];
                        IF (nextLocalPortNum _ nextLocalPortNum+1) = 0
                            THEN nextLocalPortNum _ firstUniqueLocalPortNum;
                        i _ Hash[localPort];
                        FOR finger _ objectTable^[i], finger.next
                        WHILE (finger # NIL) AND (finger.localPort # localPort)
                            DO NULL ENDLOOP;
                        IF finger = NIL THEN EXIT;
                        IF try >= maxLocalPortTries THEN RETURN WITH ERROR Error[$cantAssignLocalPort];
                        ENDLOOP;
                    };
            newHandle.localPort _ localPort;
            newHandle.next _ objectTable^[i];
            objectTable^[i] _ newHandle;
            };

        RemoveOldHandle: ENTRY PROC [h: Handle _ objectTableLock, oldHandle: Handle] ~ {
            <<Delete oldHandle from hash table.  Called during finalization of oldHandle.>>
            i: HashIndex ~ Hash[oldHandle.localPort];
            IF oldHandle = objectTable^[i]
                THEN {
                    objectTable^[i] _ oldHandle.next }
                ELSE {
                    prev: Handle;
                    FOR prev _ objectTable^[i], prev.next WHILE prev.next # oldHandle DO NULL ENDLOOP;
                    prev.next _ oldHandle.next };
            oldHandle.next _ NIL; -- Help finalization of oldHandle.next^
            };

        FindHandle: PROC [localPort: Port] RETURNS [Handle] ~ {
            i: HashIndex ~ Hash[localPort];
            FOR handle: Handle _ objectTable^[i], handle.next UNTIL handle = NIL DO  -- ATOMIC
                IF handle.localPort = localPort THEN RETURN[handle];
                ENDLOOP;
            RETURN[NIL] };
    <<Creation and parameter setting>>
        Create: PUBLIC PROC [
            remoteAddress: Address _ unknownAddress,
            remotePort: Port,
            localPort: Port,
            sendBuffers: CARDINAL,
            recvBuffers: CARDINAL,
            getTimeout: ArpaUDP.Milliseconds,
            acceptErrors: BOOL,
            acceptLongDatagrams: BOOL
            ]
            RETURNS [h: Handle]
            ~ {
            IF ipHandle = NIL THEN ERROR Error[$cantRegisterProtocol];
            h _ NEW [Object[recvBuffers]];
            SetRemoteAddress[h, remoteAddress, remotePort];
            h.sendBuffersAllocated _ sendBuffers;
            h.acceptErrors _ acceptErrors;
            h.acceptLongDatagrams _ acceptLongDatagrams;
            TRUSTED {
                Process.EnableAborts[@h.waitForInput];
                Process.EnableAborts[@h.waitForSendBuffer] };
            SetGetTimeout[h, getTimeout];
            AddNewHandle[newHandle~h, localPort~localPort];
        SafeStorage.EnableFinalization[h];
            };

        GetLocalPort: PUBLIC PROC [h: Handle] RETURNS [port: Port] ~ {
            RETURN[h.localPort];
            };

        GetRemoteAddress: PUBLIC PROC [h: Handle]
        RETURNS [address: Address, port: Port] ~ {
            RETURN [address~h.remoteAddress, port~h.remotePort];
            };

        SetRemoteAddress: PUBLIC PROC [h: Handle, address: Address, port: Port] ~ {
            IF ArpaExtras.IsBroadcast[address] THEN ERROR Error[$badRemoteAddress];
            h.remoteAddress _ address;
            h.remotePort _ port;
            h.putsUntilFlush _ 0;
            h.routeCache _ NIL; -- just for luck
            };
        <<>>
        SetGetTimeout: PUBLIC PROC [h: Handle, timeout: ArpaUDP.Milliseconds] ~ {
            h.dontWait _ FALSE;
            SELECT timeout FROM
                ArpaUDP.dontWait => h.dontWait _ TRUE;
                ArpaUDP.waitForever => TRUSTED {
                    Process.DisableTimeout[@h.waitForInput]; };
                < CARDINAL.LAST => TRUSTED {
                    Process.SetTimeout[@h.waitForInput, Process.MsecToTicks[timeout] ]; };
                ENDCASE => TRUSTED {
                    Process.SetTimeout[@h.waitForInput, Process.SecondsToTicks[timeout/1000] ]; };
            };

            <<>>
        SetSoftwareChecksumming: PUBLIC PROC [h: Handle, send, recv: BOOL] ~ {
            h.sendChecksum _ IF send THEN ComputeUDPChecksum ELSE NIL;
            h.recvChecksum _ recv;
            };
            <<>>
        Kick: PUBLIC ENTRY PROC [h: Handle] ~ {
            ENABLE UNWIND => NULL;
            BROADCAST h.waitForInput;
            };
            <<>>
        Destroy: PUBLIC ENTRY PROC [h: Handle] ~ {
            h.dead _ TRUE;
            BROADCAST h.waitForInput;
            BROADCAST h.waitForSendBuffer;
            FOR i: CARDINAL IN [0..h.recvBuffersAllocated) DO
                buffers: Buffers _ h.inputQueue[i];
                h.inputQueue[i] _ NIL;
                WHILE buffers # NIL DO
                    temp: Buffer _ buffers;
                    buffers _ Next[temp];
                    temp.ovh.next _ NIL;
                    h.recvBuffersInUse _ h.recvBuffersInUse - 1;
                    ArpaIP.FreeBuffers[SmashToIPBuffer[temp]];
                    ENDLOOP;
                ENDLOOP;
            <<Drop handle, let finalization remove it from table.>>
            };
    <<Sending>>
        AllocBuffers: PUBLIC PROC [h: Handle, howMany: CARDINAL] RETURNS [b: Buffers _ NIL] ~ {
            IF howMany > h.sendBuffersAllocated THEN ERROR Error[$requestTooLarge];
            AllocBuffersInner[h, howMany];
            THROUGH [1..howMany] DO
                temp: Buffer ~ SmashToUDPBuffer[ArpaIP.AllocBuffers[1], send];
                temp.ovh.socket _ h;
                temp.ovh.next _ b;
                b _ temp;
                ENDLOOP;
            };

        AllocBuffersInner: ENTRY PROC [h: Handle, howMany: CARDINAL] ~ {
            ENABLE UNWIND => NULL;
            DO
                IF h.dead THEN RETURN WITH ERROR Error[$handleDestroyed];
                IF (h.sendBuffersInUse + howMany) <= h.sendBuffersAllocated THEN EXIT;
                WAIT h.waitForSendBuffer;
                ENDLOOP;
            h.sendBuffersInUse _ h.sendBuffersInUse + howMany;
            };
            <<>>
        SetUserBytes: PUBLIC PROC [b: Buffer, bytes: CARDINAL] ~ {
            bytesIncludingUPDHdr: CARDINAL ~ bytes + ArpaUDPBuf.hdrBytes;
            b.hdr2.length _ Basics.HFromCard16[bytesIncludingUPDHdr];
        ArpaIP.SetUserBytes[IPBuffer[b], bytesIncludingUPDHdr];
            };

        Put: PUBLIC PROC [b: Buffers] ~ {
            h: Handle ~ NARROW[b.ovh.socket];
            hint: ArpaIP.RouteHint;
            cnt: CARDINAL;
            IF h.dead THEN ERROR Error[$handleDestroyed];
            b.hdr2.sourcePort _ h.localPort;
            b.hdr2.destPort _ h.remotePort;
            b.hdr2.checksum _ [0, 0];
            hint _ h.routeCache;
            IF (cnt _ h.putsUntilFlush) = 0
                THEN {
                    IF (cnt _ h.putsBetweenFlushes) # 0
                        THEN hint _ ArpaIP.nullRouteHint
                        ELSE hint _ NIL;
                    }
                ELSE {
                    cnt _ cnt - 1;
                    };
            h.putsUntilFlush _ cnt;
            h.routeCache _ ArpaIP.Send[ipHandle, IPBuffer[b], h.remoteAddress, h.sendChecksum, hint
                ! ArpaIP.Error => {
                    h.routeCache _ NIL;
                    IF h.acceptErrors THEN ERROR Error[code] ELSE CONTINUE;
                    }
                ];
            };

        SetCacheRefresh: PUBLIC PROC [h: Handle, interval: CARDINAL] ~ {
            h.putsUntilFlush _ 0;
            h.putsBetweenFlushes _ interval;
            h.routeCache _ NIL;
            };
            <<>>
        Send: PUBLIC PROC [b: Buffers, address: Address, port: Port] ~ {
            h: Handle ~ NARROW[b.ovh.socket];
            IF h.dead THEN ERROR Error[$handleDestroyed];
            b.hdr2.sourcePort _ h.localPort;
            b.hdr2.destPort _ port;
            b.hdr2.checksum _ [0, 0];
            [] _ ArpaIP.Send[ipHandle, IPBuffer[b], address, h.sendChecksum
                ! ArpaIP.Error => IF h.acceptErrors THEN ERROR Error[code] ELSE CONTINUE ];
            };
            <<>>
        SendToSelf: PUBLIC PROC [b: Buffers, address: Address, port: Port] ~ {
            h: Handle ~ NARROW[b.ovh.socket];
            IF h.dead THEN ERROR Error[$handleDestroyed];
            b.hdr2.sourcePort _ h.localPort;
            b.hdr2.destPort _ port;
            b.hdr2.checksum _ [0, 0];
            FOR finger: Buffer _ b, Next[finger] WHILE finger # NIL DO
                AccountForReturnedBuffer[h, finger];
                [] _ SmashToIPBuffer[finger];
                ENDLOOP;
            [] _ ArpaIP.SendToSelf[ipHandle, IPBuffer[b], address, NIL];
            };
            <<>>
        ReturnToSender: PUBLIC PROC [b: Buffers] ~ {
            Send[b, ArpaIP.GetSource[IPBuffer[b]], b.hdr2.sourcePort];
            };
    <<Receiving>>
        Get: PUBLIC ENTRY PROC [h: Handle] RETURNS [b: Buffers] ~ {
            ENABLE UNWIND => NULL;
            IF (h.inputQueue[h.inputDequeue] = NIL) AND (NOT h.dontWait) AND (NOT h.dead) AND (h.errorCode = NIL)
                THEN WAIT h.waitForInput;
            IF h.dead THEN RETURN WITH ERROR Error[$handleDestroyed];
            IF h.errorCode # NIL THEN {
                code: ATOM ~ h.errorCode; h.errorCode _ NIL;
                RETURN WITH ERROR ReceivedError[code, h.errorAddress, h.errorPort];
                };
            IF (b _ h.inputQueue[h.inputDequeue]) # NIL THEN {
                h.inputQueue[h.inputDequeue] _ NIL;
                IF (h.inputDequeue _ h.inputDequeue + 1) >= h.recvBuffersAllocated
                    THEN h.inputDequeue _ 0;
                FOR finger: Buffer _ b, Next[finger] WHILE finger # NIL DO
                    finger.ovh.socket _ h;
                    ENDLOOP;
                };
            };
            <<>>
        CheckError: PUBLIC ENTRY PROC [h: Handle] ~ {
            code: ATOM ~ h.errorCode;
            IF code # NIL THEN {
                h.errorCode _ NIL;
                RETURN WITH ERROR ReceivedError[code, h.errorAddress, h.errorPort];
                };
            };

        GetUserBytes: PUBLIC PROC [b: Buffers] RETURNS [bytes: CARDINAL] ~ {
            bytes _ Basics.Card16FromH[b.hdr2.length] - ArpaUDPBuf.hdrBytes;
            };

        GetSource: PUBLIC PROC [b: Buffers] RETURNS [address: Address, port: Port] ~ {
            address _ ArpaIP.GetSource[IPBuffer[b]];
            port _ b.hdr2.sourcePort;
            };
            <<>>
        FreeBuffers: PUBLIC PROC [b: Buffers] ~ {
            WHILE b # NIL DO
                next: Buffer ~ Next[b];
                h: Handle ~ NARROW[b.ovh.socket];
                b.ovh.next _ NIL;
                IF h # NIL THEN AccountForReturnedBuffer[h, b];
                ArpaIP.FreeBuffers[SmashToIPBuffer[b]];
                b _ next;
                ENDLOOP;
            };

    AccountForReturnedBuffer: ENTRY PROC [h: Handle, b: Buffer] ~ {
    ENABLE UNWIND => NULL;
    SELECT b.ovh.direction FROM
        send => {
            h.sendBuffersInUse _ h.sendBuffersInUse - 1;
            NOTIFY h.waitForSendBuffer };
        recv => h.recvBuffersInUse _ h.recvBuffersInUse - 1;
        ENDCASE => ERROR;
        };
    <<Incoming packets from IP>>
        <<Statistics ...>>
            packetsReceived: INT _ 0;
            errorTooShort: CARD _ 0;
            errorTooLong: CARD _ 0;
            errorNoHandle: CARD _ 0;
            errorDeadHandle: CARD _ 0;
            errorBadChecksum: CARD _ 0;
            errorFullInputQueue: CARD _ 0;

        TakeThis: ArpaIP.RecvProc -- [b: ArpaIP.Buffers, clientData: REF] RETURNS [rB: ArpaIP.Buffers] -- ~ {
        head: Buffers;

            BEGIN
                nBuffers: CARDINAL _ 0;
                totalBytes: CARDINAL _ 0;
                h: Handle;
            tail: Buffer;

                packetsReceived _ packetsReceived.SUCC;
                head _ UDPBuffer[b];

                FOR tail _ head, Next[tail] DO
                    [] _ SmashToUDPBuffer[IPBuffer[tail], recv];
                    totalBytes _ totalBytes + Basics.Card16FromH[tail.hdr1.length] - ArpaBuf.hdrBytes;
                    nBuffers _ nBuffers + 1;
                    IF Next[tail] = NIL THEN EXIT;
                    ENDLOOP;

                IF totalBytes < MAX[Basics.Card16FromH[head.hdr2.length], ArpaUDPBuf.hdrBytes]
                    THEN { errorTooShort _ errorTooShort.SUCC; GOTO Fix };

                h _ FindHandle[head.hdr2.destPort];
                IF h = NIL
                    THEN { errorNoHandle _ errorNoHandle.SUCC; GOTO Fix };
                IF h.recvChecksum AND NOT TestUDPChecksum[head]
                    THEN { errorBadChecksum _ errorBadChecksum.SUCC; GOTO Fix };
                IF (tail # head) AND (NOT h.acceptLongDatagrams)
                    THEN { errorTooLong _ errorTooLong.SUCC; GOTO Fix };

                IF NOT TakeThisInner[h, head, nBuffers] THEN GOTO Fix;

                GOTO Out;

                EXITS
                    Fix => {
                    rB _ b;
                    FOR finger: Buffer _ head, Next[finger] WHILE finger # NIL DO
                    [] _ SmashToIPBuffer[finger];
                    ENDLOOP;
                    };
                    Out => NULL;
                END;
            };

        TakeThisInner: ENTRY PROC [h: Handle, head: Buffers, n: CARDINAL]
        RETURNS [ok: BOOL] ~ {
            IF h.dead
                THEN { errorDeadHandle _ errorDeadHandle.SUCC; RETURN [FALSE] };
            IF h.recvBuffersInUse >= h.recvBuffersAllocated
                THEN { errorFullInputQueue _ errorFullInputQueue.SUCC; RETURN [FALSE] };
            h.recvBuffersInUse _ h.recvBuffersInUse + n;
        h.inputQueue[h.inputEnqueue] _ head;
            IF (h.inputEnqueue _ h.inputEnqueue + 1) >= h.recvBuffersAllocated
                THEN h.inputEnqueue _ 0;
        NOTIFY h.waitForInput;
        RETURN [TRUE];
        };

        icmpReceived: CARD _ 0;
        icmpTooLong: CARD _ 0;
        icmpBadCode1: CARD _ 0;
        icmpBadCode2: CARD _ 0;
        icmpBadType: CARD _ 0;
        icmpNoHandle: CARD _ 0;

        TakeThisICMP: ArpaIP.RecvProc -- [b: ArpaIP.Buffers, clientData: REF] RETURNS [rB: ArpaIP.Buffers] -- ~ {
            h: Handle;
        buf: ArpaICMP.Buffer;
        code: ATOM;
        remoteAddress: Address;
        remotePort: Port;
        localPort: Port;

            icmpReceived _ icmpReceived.SUCC;

            rB _ b;
            IF b.ovh.next # NIL -- too horrible to contemplate
                THEN { icmpTooLong _ icmpTooLong.SUCC; RETURN };
            TRUSTED { buf _ LOOPHOLE[b] };
            SELECT buf.hdr2.icmpType FROM
                destUnreachable => {
                    SELECT buf.hdr2.destUnreachableCode FROM
                        netUnreachable => code _ $netUnreachable;
                        hostUnreachable => code _ $hostUnreachable;
                        protocolUnreachable => code _ $protocolUnreachable;
                        portUnreachable => code _ $portUnreachable;
                        mustFragment => code _ $mustFragment;
                        sourceRouteFailure => code _ $sourceRouteFailure;
                        ENDCASE => { icmpBadCode1 _ icmpBadCode1.SUCC; RETURN };
                    };
                sourceQuench => {
                code _ $sourceQuench;
                    };
                timeExceeded => {
                    SELECT buf.hdr2.timeExceededCode FROM
                        timeToLive => code _ $timeoutTimeToLive;
                        fragmentReassembly => code _ $fragmentReassembly;
                        ENDCASE => { icmpBadCode2 _ icmpBadCode2.SUCC; RETURN };
                    };
                parameterProblem => {
                    code _ $parameterProblem;
                    };
                ENDCASE => { icmpBadType _ icmpBadType.SUCC; RETURN };

            <<The following kludge works because all the packet types share a common format ...>>
                remoteAddress _ buf.body.destUnreachable.origHdr.dest;
                localPort _ [buf.body.destUnreachable.origBody[0], buf.body.destUnreachable.origBody[1]];
                remotePort _ [buf.body.destUnreachable.origBody[2], buf.body.destUnreachable.origBody[3]];

            h _ FindHandle[localPort];
            IF h = NIL
                THEN { icmpNoHandle _ icmpNoHandle.SUCC; RETURN };

            IF h.acceptErrors THEN TakeThisICMPInner[h, code, remoteAddress, remotePort];
            };

        TakeThisICMPInner: ENTRY PROC [h: Handle, c: ATOM, a: Address, p: Port] ~ {
            h.errorPort _ p;
            h.errorAddress _ a;
            h.errorCode _ c;
            NOTIFY h.waitForInput;
            };


    <<Finalization>>
        <<Statistics>>
            droppedSockets: INT _ 0;
            finishedSockets: INT _ 0;
            droppedBuffers: INT _ 0;

        ofq: SafeStorage.FinalizationQueue ~ SafeStorage.NewFQ[]; -- for Objects
        bfq: SafeStorage.FinalizationQueue ~ SafeStorage.NewFQ[]; -- for Buffers

        ObjectFinalizer: PROC = {
            Process.SetPriority[Process.priorityForeground];
            DO
                handle: Handle _ NARROW[SafeStorage.FQNext[ofq]];
                IF NOT handle.dead
                    THEN { -- User forgot to call Destroy
                        SafeStorage.EnableFinalization[handle];
                        Destroy[handle];
                        droppedSockets _ droppedSockets.SUCC; }
                    ELSE { -- Normal end of life
                        RemoveOldHandle[oldHandle~handle];
                        finishedSockets _ finishedSockets.SUCC };
                handle _ NIL;
                ENDLOOP;
            };

        BufferFinalizer: PROC = {
            <<Beware: See the comments near CommDriver.Buffer>>
            Process.SetPriority[Process.priorityForeground];
            DO
                b: Buffers _ NARROW[SafeStorage.FQNext[bfq]];
                SafeStorage.EnableFinalization[b];
                FreeBuffers[b];
                b _ NIL;
                droppedBuffers _ droppedBuffers.SUCC;
                ENDLOOP;
            };


    <<Initialization>>
        Init: PROC ~ {
            SafeStorage.EstablishFinalization[type: CODE[Object], npr: 1, fq: ofq];
            SafeStorage.EstablishFinalization[type: CODE[ArpaUDPBuf.BufferObject], npr: 0, fq: bfq];
            ipHandle _ ArpaIP.CreateHandle[udp, TakeThis, TakeThisICMP, TRUE];
            TRUSTED { Process.Detach[FORK ObjectFinalizer[]] };
            TRUSTED { Process.Detach[FORK BufferFinalizer[]] };
            };

        Init[];

        }...