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
~ {
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;
ipHandle: ArpaIP.Handle _ NIL;
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]]; };
checksumsEnabled: BOOL _ TRUE;

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] -- ~ {
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];
};
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
];
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] ~ {
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] ~ {
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] };
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;
};
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];
};
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;
};
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 };

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;
};


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 = {
Process.SetPriority[Process.priorityForeground];
DO
b: Buffers _ NARROW[SafeStorage.FQNext[bfq]];
SafeStorage.EnableFinalization[b];
FreeBuffers[b];
b _ NIL;
droppedBuffers _ droppedBuffers.SUCC;
ENDLOOP;
};


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[];

}...
ΎArpaUDPImpl.mesa
Demers, November 9, 1987 11:37:12 am PST
Types
IP Interface
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.

Checksums
BEWARE: This is called from TestUDPChecksum with b: ArpaUDP.Buffers.
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.

Hash Table for Objects
Insert newHandle in hash table, making up unique local port number if necessary.
Called before finalization of newHandle is enabled.
Delete oldHandle from hash table.  Called during finalization of oldHandle.
Creation and parameter setting




Drop handle, let finalization remove it from table.
Sending




Receiving


Incoming packets from IP
Statistics ...
The following kludge works because all the packet types share a common format ...
Finalization
Statistics
Beware: See the comments near CommDriver.Buffer
Initialization
Κο˜
codeš
œ™K™(K˜—š
Οk	˜	Kšœ
œ˜)Kšœœ˜"Kšœœ˜+Kšœœ˜Kšœ	œ
˜Kšœœ½
˜Ι
Kšœœ'˜4Kšœœ2˜BKš	œœœœœ˜>Kšœœ
˜Kšœœ˜)Kšœœr˜KšœœN˜_K˜
K˜—šΟnœœ
˜Kšœœ
˜Kšœ1˜8Kšœ˜K˜
head™Kšœœ
œ
˜Kšœœ
œ
˜K˜Kšœ	œ˜Kš
œ+˜+K˜Kšœœ˜Kš
œ%˜%K˜Kšœœ˜!Kšœ	œ˜"K˜Kšœ	œ˜#K˜Kš
žœœ
œœœ
˜(K˜Kš
ž
œœ
œœ.œ
˜Z—™Kšœœ
˜—™K™Ο
K™š
žœœ
œœ
œ˜MKšœœœ˜WKšœœ˜)Kš
œ˜Kšœœ
˜Kšœ
œ˜—š
žœœ.œœ
œ˜gKšœœœ˜WKšœœ˜)Kš
œ˜Kšœ
œ˜—š
žœœ
œœ
œ˜FKšœ
œ˜—š
ž	œœœœ
œ˜HKšœ
œ	˜—š
žœœ
œœ
œ˜:Kšœ
œ˜ ——™	Icode2šœœœ
˜M˜š	œœœ
	œ
œ˜2Mš
œ˜Mš
œ˜Mšœœ˜Mš
œ˜Mšœœ˜—M˜šžœœœœ˜9Jšœœ
˜Kšœ
œœ
œœΟc˜4Kšœ"œ
œœ˜7K˜ Kšœœ
œ
œ˜+Kš
œ˜Kšœ
œ˜K˜K˜—šžœŸœ˜EKš
œD™DKšœœ
˜Kš
œ˜K˜K˜Kš	œ
œœ œŸ˜NKš
œ‚
˜‚
Kšœœ
œŸo˜‘
Mšœ9œœ
œ˜xK˜šœ
œ
˜Kšœœ)˜8šœœœ˜Kš	œœ
œ
œŸ˜4Kš
œ0˜0Kš
œ˜—Kšœœ
œ˜KšœV˜]Kšœœ˜/Kšœ
˜—Kš
œœ
œœ
œ
˜6Kš
œ,˜,K˜——™K™π
K™Kšœœœ˜šœœœ˜(Kšœ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ7˜7Kšœœœ
˜Kšœœœ
˜Kšœ
œœ
˜Kšœœ
˜Kšœœœ
˜K˜K˜Kšœœ
˜Kšœœ
˜#Kšœœ˜Kšœœ˜!Kšœ
˜Kšœ
˜Kšœœ˜Kšœœ
˜Kšœœ˜Kšœœ˜)Kšœœœ
œ˜=Kš
œ˜——š
ž™Kšœœ˜Kšœœ˜(K˜Kšœ
œœ˜'Kšœœœœ˜1K˜Kšœœ˜/K˜Kšœœ	˜&K˜Kšœœ˜'Kšœœ˜3Kšœœ˜"K˜šžœœœœ˜6Kšœœ˜7K˜—šžœœ
œF˜^K™PK™3Kš
œ
˜
šœ
œ
˜˜K˜K˜—šœ˜šœœ˜K˜K˜1šœ,˜.Kšœ,˜0—K˜šœ'œœœ˜aKšœ
œ
œ
˜—Kšœ
œ
œ
œ
˜Kš
œœ
œ
œ
œ˜OKšœ
˜—K˜——Kš
œ ˜ Kš
œ!˜!Kš
œ˜K˜K˜—šžœœ
œ5˜PK™KKš
œ)˜)šœ˜šœ˜Kš
œ"˜"—šœ˜K˜
Kš	œ#œœ
œ
˜RKš
œ˜——KšœœŸ'˜=K˜—šž
œœœ
˜7Kš
œ˜š	œ/œ
œ
œŸ	˜RKšœœ
œ	˜4Kšœ
˜—Kšœ
œ˜——š
ž™šžœœ
œ˜Kš
œ(˜(K˜K˜Kšœ
œ
˜Kšœ
œ
˜Kš
œ!˜!Kšœœ
˜Kšœ˜Kš
œ
˜
Kšœ˜K˜Kšœœ
œ
œ˜:Kšœœ˜Kš
œ/˜/Kš
œ%˜%K˜Kš
œ,˜,šœ˜	Kš
œ&˜&Kš
œ-˜-—Kš
œ˜Kš
œ/˜/Mš
œ"˜"K˜K˜—šžœœ
œ
œ˜>Kšœ˜K˜K˜—šžœœ
œ
œ#˜TKšœ.˜4K˜K˜—šžœœ
œ.˜KKšœ!œ
œ˜GKš
œ˜Kš
œ˜Kš
œ˜KšœœŸ˜$K˜—K™šž
œœ
œ/˜IKšœ
œ
˜šœ	˜Kšœ!œ
˜&šœœ˜ Kš
œ+˜+—šœœ
œœ˜Kš
œF˜F—šœœ˜Kš
œN˜N——Kš
œ˜K˜K™—šžœœ
œœ˜FKš	œœœœ
œ
˜:Kš
œ˜K˜K™—šžœœ
œ
œ˜'Kšœ
œœ
˜Kš	œ˜K˜K™—šžœœ˜*Kšœ	œ
˜Kš	œ˜Kš	œ˜šœœ
œ˜1Kš
œ#˜#Kšœœ
˜šœœ
˜Kš
œ˜Kš
œ˜Kšœœ
˜Kš
œ,˜,Kš
œ*˜*Kšœ
˜—Kšœ
˜—K™3K˜——š
ž™šžœœ
œœœœ˜WKšœ"œ
œ˜GKš
œ˜šœ˜Kš
œ>˜>Kš
œ˜Kš
œ˜K˜	Kšœ
˜—K˜K˜—šžœœ
œœ˜@Kšœ
œœ
˜š
˜Kš
œœ
œ
œ
œ˜9Kšœ:œ
œ
˜FKšœ˜Kšœ
˜—Kš
œ2˜2Kš
œ˜K™—šžœœ
œœ˜:Kšœœ˜=Kš
œ9˜9Jš
œ7˜7K˜—K˜šžœœ
œ˜!Kšœœ˜!Kš
œ˜Kšœœ
˜Kšœœ
œ˜-Kš
œ ˜ Kš
œ˜K˜K˜šœ˜šœ˜šœ!˜#Kšœ˜ Kšœœ
˜—K˜
—šœ˜K˜K˜——Kš
œ˜š
œW˜Wš
œ˜Kšœœ
˜Kš
œœ
œ
œ
œ
˜7Kš
œ
˜
—Kš
œ˜—K˜K˜—šžœœ
œœ˜@Kš
œ˜K˜ Kšœœ
˜K˜K™—šžœœ/˜@Kšœœ˜!Kšœœ
œ˜-Kš
œ ˜ Kš
œ˜K˜š
œ?˜?Kšœœœ
œ
œ
œ˜K—K˜K™—šž
œœ/˜FKšœœ˜!Kšœœ
œ˜-Kš
œ ˜ Kš
œ˜K˜šœ"œ
œ
˜:Kš
œ$˜$Kš
œ˜Kšœ
˜—Kšœ7œ˜<K˜K™—šžœœ
œ˜,Kš
œ:˜:K˜——š
ž	™	šžœœ

œ
œ˜;Kšœ
œœ
˜šœ!œœœ
œœ	œœ
˜eKš	œ˜—Kš
œœ
œ
œ
œ˜9šœœ
œ˜Kšœœœ
˜,Kšœ
œ
œ2˜CK˜—šœ&œ
œ˜2Kšœœ
˜#šœ@˜BKšœ˜—šœ"œ
œ
˜:K˜Kšœ
˜—K˜—K˜K™—šž
œœ˜-Kšœœ˜šœœ
œ˜Kšœœ
˜Kšœ
œ
œ2˜CK˜—K˜K˜—šžœœœ	œ˜DKš
œ@˜@K˜—K˜šž	œœ
œœ#˜NKš
œ(˜(Kš
œ˜Kš
œ˜K™—šžœœ˜)šœœ
˜K˜Kšœœ˜!Kšœ
œ
˜Kšœœ
œ ˜/Kš
œ'˜'K˜	Kšœ
˜—K˜K˜—šžœœ
œ˜?Jšœ
œœ
˜šœ˜š
œ	˜	Kš
œ,˜,Kšœ˜—Kš
œ4˜4Kšœœ
˜—K˜——š
œ™™Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜K˜—šžœŸGœ˜eJ˜K˜š
˜Kšœ
œ˜Kšœœ˜K˜
J˜
K˜Kšœ"œ
˜'Kš
œ˜K˜šœ˜Kš
œ,˜,Kš
œR˜RK˜Kšœœ
œ
œ
˜Kšœ
˜K˜—šœœ;˜NKšœ!œ
œ˜6K˜—Kš
œ#˜#šœ˜
Kšœ!œœ˜6—šœœ
œ˜/Kšœ'œœ˜<—šœœœ˜0Kšœœœ˜4K˜—Kšœ
œ!œ
œ˜6K˜Kšœ˜	K˜š
˜˜Jš
œ˜šœ%œ
œ
˜=Jš
œ˜Jšœ
˜—J˜—Kšœœ
˜—Kšœ
˜—K˜K˜—šž
œœ
œœœœ˜Xšœ˜	Kšœ%œ
œœ˜@—šœ-˜/Kšœ-œœœ˜H—Kš
œ,˜,J˜$šœ@˜BKšœ˜—Jšœ˜Jšœœ˜J˜J˜—Kšœœ˜Kšœ
œ˜Kšœœ˜Kšœœ˜Kšœ
œ˜Kšœœ˜K˜šžœŸGœ˜iK˜
J˜Jšœœ
˜J˜J˜J˜K˜Kšœœ
˜!K˜K˜šœœ
Ÿ˜2Kšœœœ˜0—Kšœ	œ˜šœ˜˜šœ˜(K˜)K˜+K˜3K˜+K˜%K˜1Kšœ"œœ˜8—K˜—˜Jš
œ˜K˜—˜šœ˜%K˜(K˜1Kšœ"œœ˜8—K˜—˜K˜K˜—Kšœ œœ˜6K˜—™QKš
œ6˜6K˜YK˜Z—K˜Kš
œ˜šœ˜
Kšœœœ˜2—K˜Kšœœ7˜MK˜K˜—šžœœ
œœ˜KK˜K˜K˜Kšœ˜K˜K˜—J˜—™™
Kšœœ˜Kšœœ˜Kšœœ˜—K˜Kšœ:Ÿ˜HKšœ:Ÿ˜HK˜šžœœ˜Kš
œ0˜0š
˜Kšœœ˜1šœ
œ˜šœŸ˜%Kš
œ'˜'Kš
œ˜Kšœ œ˜'—šœŸ˜Kš
œ"˜"Kšœ"œ˜)——Kšœ	œ
˜
Kšœ
˜—Kš
œ
˜K˜—šžœœ˜Kš
œ/™/Kš
œ0˜0š
˜Kšœ
œ˜-Kš
œ"˜"Kš
œ˜Kšœœ
˜Kšœ œ
˜%Kšœ
˜—Kš
œ
˜K˜K˜——™šžœœ˜Kšœ(œ˜GKšœ(œ,˜XKšœ<œ˜BKšœœ˜3Kšœœ˜3K˜—K˜K˜—K˜K˜——…—Fΐbm