DIRECTORY
Arpa USING [Address, nullAddress],
ArpaBuf USING [Buffer, DataBytes, defaultFragmentCtl, defaultFragmentCtlDontFragment, defaultTypeOfService, DontFragment, endOfListOption, FinalFragmentCtl, FragmentOffsetBytes, hdrBytes, InteriorFragmentCtl, maxBytes, maxTimeToLive, minIHL, noOpOption, OptionsBytes, OptionType, Protocol, thisVersion],
ArpaExtras USING [AddressOr, broadcastAddress, BroadcastAddressOnSubnetWithMask, HostNumberWithMask, IsSpecificNet, NetAndSubnetNumberWithMask],
ArpaIP USING [ChecksumProc, RecvProc],
ArpaIPReassembly USING [ReassembleAndMoveOptions],
ArpaRouterPrivate USING [Route],
ArpaTranslation USING [GetSubnetMask],
Basics USING [BITNOT, Card16FromH, DivMod, HFromCard16, HighHalf, HWORD, LongNumber, LowHalf, ShortNumber],
BasicTime USING [GetClockPulses],
CommBuffer USING [Encapsulation],
CommDriver USING [AllocBuffer, Buffer, FreeBuffer, GetNetworkChain, Network],
PrincOpsUtils USING [ByteBlt]
;

ArpaIPImpl: CEDAR MONITOR
LOCKS lock USING lock: Lock
IMPORTS ArpaBuf, ArpaExtras, ArpaIPReassembly, ArpaRouterPrivate, ArpaTranslation, Basics, BasicTime, CommDriver, PrincOpsUtils
EXPORTS ArpaIP, ArpaRouterPrivate
~ {
HWORD: TYPE ~ Basics.HWORD;

Address: TYPE ~ Arpa.Address;
Buffer: TYPE ~ ArpaBuf.Buffer;
Buffers: TYPE ~ ArpaBuf.Buffer;

Network: TYPE ~ CommDriver.Network;

Lock: TYPE ~ REF LockObject;
LockObject: TYPE ~ MONITORED RECORD [];
Error: PUBLIC ERROR [code: ATOM] ~ CODE;
ComputeIPChecksum: PROC [b: Buffer] RETURNS [HWORD] ~ {
cs, count: CARDINAL;
count _ b.hdr1.ihl * (4/BYTES[CARDINAL]); -- number of 16-bit words in header
cs _ Basics.BITNOT[LOOPHOLE[b.hdr1.checksum]]; -- start with negative of checksum field so we don't have to smash it to zero to compute the real checksum.
TRUSTED { cs _ OnesComplementAddBlock[ptr~@b.hdr1, count~count, initialSum~cs] };
RETURN [LOOPHOLE[Basics.BITNOT[cs]]];
};
DriverBuffer: PROC [b: Buffer] RETURNS [CommDriver.Buffer] ~ TRUSTED INLINE {
RETURN[LOOPHOLE[b]]; };
IPBuffer: PROC [cB: CommDriver.Buffer] RETURNS [Buffer] ~ TRUSTED INLINE {
RETURN[LOOPHOLE[cB]]; };
Next: PROC [b: Buffer] RETURNS [Buffer] = TRUSTED INLINE {
RETURN[LOOPHOLE[b.ovh.next]]; };
idLock: Lock _ NEW[LockObject];

nextID: CARD16 _ Basics.LowHalf[BasicTime.GetClockPulses[]];

NextID: ENTRY PROC [lock: Lock _ idLock] RETURNS [id: HWORD] ~ INLINE {
id _ Basics.HFromCard16[nextID _ nextID.SUCC];
};
Handle: TYPE ~ REF Object;
Object: PUBLIC TYPE ~ RECORD [
recvProc: ArpaIP.RecvProc,
recvErrorProc: ArpaIP.RecvProc,
protocol: ArpaBuf.Protocol,
acceptLongDatagrams: BOOL
];

maxProtocol: CARDINAL ~ ORD[ArpaBuf.Protocol.netblt];
HandleTable: TYPE ~ ARRAY [0..maxProtocol] OF Handle;

handleTableLock: Lock _ NEW[LockObject];
handles: REF HandleTable _ NEW[HandleTable];

CreateHandle: PUBLIC PROC [protocol: ArpaBuf.Protocol, recvProc: ArpaIP.RecvProc, recvErrorProc: ArpaIP.RecvProc, acceptLongDatagrams: BOOL]
RETURNS [handle: Handle] ~ {
protocolIndex: CARDINAL;
IF (protocolIndex _ ORD[protocol]) > maxProtocol
THEN ERROR Error[$protocolOutOfRange];
IF recvProc = NIL
THEN ERROR Error[$nilRecvProc];
handle _ NEW[Object _ [recvProc~recvProc, recvErrorProc~recvErrorProc, protocol~protocol, acceptLongDatagrams~acceptLongDatagrams]];
CreateHandleInner[newHandle~handle, i~protocolIndex];
};

CreateHandleInner: ENTRY PROC [lock: Lock _ handleTableLock, newHandle: Handle, i: CARDINAL] ~ {
ENABLE UNWIND => NULL;
IF handles[i] # NIL THEN RETURN WITH ERROR Error[$protocolAlreadyRegistered];
handles[i] _ newHandle;
}; 

DestroyHandle: PUBLIC PROC [handle: Handle] ~ {
DestroyHandleInner[oldHandle~handle];
};

DestroyHandleInner: ENTRY PROC [lock: Lock _ handleTableLock, oldHandle: Handle] ~ {
IF handles[ORD[oldHandle.protocol]] # oldHandle THEN RETURN WITH ERROR Error[$handleDestroyed];
handles[ORD[oldHandle.protocol]] _ NIL;
};

DispatchICMP: PUBLIC PROC [b: Buffers, protocol: ArpaBuf.Protocol] ~ {
protocolIndex: CARDINAL;
h: Handle;
IF b = NIL THEN RETURN;
IF b.hdr1.protocol # icmp THEN ERROR Error[$notICMP];
IF (protocolIndex _ ORD[protocol]) > maxProtocol THEN ERROR Error[$protocolOutOfRange];
IF ((h _ handles[protocolIndex]) # NIL) AND (h.recvErrorProc # NIL)
AND ((b.ovh.next = NIL) OR h.acceptLongDatagrams)
THEN b _ h.recvErrorProc[b];
IF b # NIL THEN FreeBuffers[b];
};
packetsReceived: CARD _ 0;
errorShortPacket: CARD _ 0;
errorBadChecksum: CARD _ 0;
errorIPVersion: CARD _ 0;
errorNotGateway: CARD _ 0;
trashInNext: CARD _ 0;

EasyToReceive: PROC [b: Buffer] RETURNS [BOOL] ~ INLINE { RETURN [
(b.hdr1.ihl = ArpaBuf.minIHL) AND (b.hdr1.fragmentCtl = ArpaBuf.defaultFragmentCtl)] };

ChecksumsMatch: PROC [c1, c2: HWORD] RETURNS [BOOL] ~ INLINE { RETURN [c1 = c2] };

Dispatch: PROC [b: Buffers] ~ {
protocolIndex: CARDINAL;
h: Handle;
IF (protocolIndex _ ORD[b.hdr1.protocol]) > maxProtocol THEN RETURN;
IF ((h _ handles[protocolIndex]) # NIL)
AND ((b.ovh.next = NIL) OR h.acceptLongDatagrams)
THEN b _ h.recvProc[b];
IF b # NIL THEN FreeBuffers[b];
};

TakeThis: PUBLIC PROC [network: Network, buffer: CommDriver.Buffer, bytes: NAT] RETURNS [returnB: CommDriver.Buffer] ~ {
b: Buffer;

packetsReceived _ packetsReceived.SUCC;
IF buffer.ovh.next # NIL THEN {
trashInNext _ trashInNext.SUCC;  buffer.ovh.next _ NIL };

returnB _ buffer;
b _ IPBuffer[buffer];
IF (NOT ChecksumsMatch[b.hdr1.checksum, ComputeIPChecksum[b]])
THEN { errorBadChecksum _ errorBadChecksum.SUCC; GOTO Out };
IF bytes < Basics.Card16FromH[b.hdr1.length]
THEN { errorShortPacket _ errorShortPacket.SUCC; GOTO Out };
IF b.hdr1.version # ArpaBuf.thisVersion
THEN { errorIPVersion _ errorIPVersion.SUCC; GOTO Out };
IF (b.hdr1.dest # network.arpa.host) AND (b.hdr1.dest # ArpaExtras.broadcastAddress) AND (b.hdr1.dest # ArpaExtras.BroadcastAddressOnSubnetWithMask[network.arpa.host, ArpaTranslation.GetSubnetMask[network]])
THEN { errorNotGateway _ errorNotGateway.SUCC; GOTO Out };
IF EasyToReceive[b]
THEN Dispatch[b]
ELSE {
chain: Buffers;
IF (chain _ ArpaIPReassembly.ReassembleAndMoveOptions[b]) # NIL
THEN Dispatch[chain]; 
};
returnB _ NIL;

EXITS
Out => NULL;
};
FreeBuffers: PUBLIC PROC [b: Buffers] ~ {
WHILE b # NIL DO
next: Buffer ~ Next[b];
b.ovh.next _ NIL;
CommDriver.FreeBuffer[DriverBuffer[b]];
b _ next;
ENDLOOP;
};

GetUserBytes: PUBLIC PROC [b: Buffer]
RETURNS [bodyBytes: CARDINAL, optionsBytes: CARDINAL] ~ {
hdrBytes: CARDINAL _ CARDINAL[b.hdr1.ihl] * BYTES[CARD32];
IF hdrBytes < ArpaBuf.hdrBytes
THEN ERROR Error[$badHeader]; -- can't happen
optionsBytes _ hdrBytes - ArpaBuf.hdrBytes;
bodyBytes _ Basics.Card16FromH[b.hdr1.length] - hdrBytes;
};

GetSource: PUBLIC PROC [b: Buffers] RETURNS [source: Address] ~ {
source _ b.hdr1.source;
IF NOT ArpaExtras.IsSpecificNet[source] THEN {
network: Network _ NARROW[b.ovh.network];
mask: Address _ ArpaTranslation.GetSubnetMask[network];
{ OPEN ArpaExtras;
source _ AddressOr[HostNumberWithMask[source, mask], NetAndSubnetNumberWithMask[source, mask]];
};
};
};
AllocBuffers: PUBLIC PROC [howMany: CARDINAL] RETURNS [b: Buffers _ NIL] ~ {
THROUGH [1..howMany] DO
temp: Buffer _ IPBuffer[CommDriver.AllocBuffer[]];
temp.ovh.next _ b;
b _ temp;
ENDLOOP;
};

SetUserBytes: PUBLIC PROC [b: Buffer, bodyBytes: CARDINAL, optionsBytes: CARDINAL] ~ {
ihl: CARDINAL _ (ArpaBuf.hdrBytes + optionsBytes + 3)/4; -- ceiling[hdrBytes/4]
b.hdr1.ihl _ ihl;
b.hdr1.length _ Basics.HFromCard16[bodyBytes + 4*ihl];
b.hdr1.fragmentCtl _ ArpaBuf.defaultFragmentCtl; -- clients who want to inhibit fragmentation have to simulate SetUserBytes themselves.
};

SetNoFragmentation: PUBLIC PROC [b: Buffers, inhibitFragmentation: BOOL] ~ {
b.hdr1.fragmentCtl _ IF inhibitFragmentation
THEN ArpaBuf.defaultFragmentCtlDontFragment
ELSE ArpaBuf.defaultFragmentCtl;
};

RouteHint: TYPE ~ REF;
Route: TYPE ~ REF RouteObject;
RouteObject: TYPE ~ RECORD [
network: Network,
immediate: Address,	-- not strictly necessary
encapsulation: CommBuffer.Encapsulation
];

nullRouteHint: PUBLIC RouteHint _ NEW[RouteObject];

Send: PUBLIC PROC [h: Handle, b: Buffers, dest: Address, setChecksum: ArpaIP.ChecksumProc, hint: RouteHint] RETURNS [newHint: RouteHint] ~ {
network: Network;
finger: Buffer;
offset: CARDINAL;
optionsPresent: BOOL;

SELECT dest FROM
Arpa.nullAddress => ERROR Error[$nullDestination];
ArpaExtras.broadcastAddress => { Broadcast[h, b, setChecksum]; RETURN };
ENDCASE;

SELECT hint FROM
nullRouteHint, NIL => {
immediate: Address;
[network, immediate] _ ArpaRouterPrivate.Route[dest];
IF network = NIL THEN ERROR Error[$destUnreachable];
b.ovh.encap _ network.arpa.getEncapsulation[network, immediate];
IF hint = nullRouteHint
THEN newHint _ NEW[RouteObject _ [network~network, immediate~immediate, encapsulation~b.ovh.encap]];
};
ENDCASE => {
theRoute: Route _ NARROW[hint];
network _ theRoute.network;
b.ovh.encap _ theRoute.encapsulation;
newHint _ hint;
};

IF ArpaBuf.DontFragment[b] THEN
IF ((Next[b] # NIL) OR (Basics.Card16FromH[b.hdr1.length] > GetMTU[network])) THEN
ERROR Error[$datagramTooLong];

b.hdr1.version _ ArpaBuf.thisVersion;
b.hdr1.typeOfService _ ArpaBuf.defaultTypeOfService;
b.hdr1.fragmentId _ NextID[];
b.hdr1.timeToLive _ ArpaBuf.maxTimeToLive;
b.hdr1.protocol _ h.protocol;
b.hdr1.source _ network.arpa.host;
b.hdr1.dest _ dest;

IF setChecksum # NIL THEN setChecksum[b];

finger _ b;
optionsPresent _ (b.hdr1.ihl > ArpaBuf.minIHL);
offset _ 0;
DO
next: Buffer ~ Next[finger];
bytes: CARDINAL ~ Basics.Card16FromH[finger.hdr1.length];
IF (NOT optionsPresent) AND (bytes <= GetMTU[network])
THEN {
IF finger # b THEN {
finger.ovh.encap _ b.ovh.encap;
finger.hdr1 _ b.hdr1;
finger.hdr1.length _ Basics.HFromCard16[bytes];
};
finger.hdr1.fragmentCtl _ IF next = NIL
THEN ArpaBuf.FinalFragmentCtl[offset]
ELSE ArpaBuf.InteriorFragmentCtl[offset];
SimpleSend[network, finger];
}
ELSE {
ComplexSend[network, b, finger, offset];
};
offset _ offset + bytes - ArpaBuf.hdrBytes;
IF next = NIL THEN EXIT;
IF (next.hdr1.ihl # ArpaBuf.minIHL) OR (offset MOD 8) # 0 THEN ERROR Error[$clientFragmentationError];
finger _ next;
ENDLOOP;
};

SendToSelf: PUBLIC PROC [h: Handle, b: Buffers, dest: Address, setChecksum: ArpaIP.ChecksumProc] ~ {
network: Network;

FOR network _ CommDriver.GetNetworkChain[], network.next DO
IF network = NIL THEN ERROR Error[$destinationNotSelf];
IF network.arpa.host = dest THEN EXIT;
ENDLOOP;

FOR finger: Buffer _ b, Next[b] WHILE finger # NIL DO
finger.ovh.network _ network;
ENDLOOP;

b.hdr1.version _ ArpaBuf.thisVersion;
b.hdr1.typeOfService _ ArpaBuf.defaultTypeOfService;
b.hdr1.fragmentId _ NextID[];
b.hdr1.timeToLive _ ArpaBuf.maxTimeToLive;
b.hdr1.protocol _ h.protocol;
b.hdr1.source _ b.hdr1.dest _ dest;

IF setChecksum # NIL THEN setChecksum[b];

Dispatch[b];
};

Broadcast: PROC [h: Handle, b: Buffers, setChecksum: ArpaIP.ChecksumProc] ~ {
FOR n: Network _ CommDriver.GetNetworkChain[], n.next WHILE n # NIL DO
dest: Address _ ArpaExtras.BroadcastAddressOnSubnetWithMask[n.arpa.host, ArpaTranslation.GetSubnetMask[n]];
[] _ Send[h, b, dest, setChecksum, nullRouteHint];
ENDLOOP;
};

theMTU: CARDINAL _ ArpaBuf.maxBytes; -- change with debugger if you want

GetMTU: PROC [n: Network] RETURNS [CARDINAL] ~ INLINE {
RETURN[theMTU] };

SimpleSend: PROC [n: Network, b: Buffer] ~ {
bytes: CARDINAL ~ Basics.Card16FromH[b.hdr1.length];
IF bytes < ArpaBuf.hdrBytes THEN ERROR Error[$badLength];
IF bytes > GetMTU[n] THEN ERROR;
IF b.hdr1.source = Arpa.nullAddress THEN ERROR; -- Can't happen ????
b.hdr1.checksum _ ComputeIPChecksum[b];
{ savedNext: REF ~ b.ovh.next;
b.ovh.next _ NIL;
n.arpa.send[n, DriverBuffer[b], bytes];
b.ovh.next _ savedNext;
};
};

hardToSend: CARD _ 0;

CopyOptionsFiltered: PROC [hdrBuf: Buffer, b: Buffer]
RETURNS [bytesCopied: CARDINAL] ~ {
hB: CommDriver.Buffer ~ DriverBuffer[hdrBuf];
limit: CARDINAL ~ ArpaBuf.OptionsBytes[hdrBuf];
iFrom, iTo: CARDINAL _ 0;
WHILE iFrom < limit DO
type: ArpaBuf.OptionType ~ LOOPHOLE[hB.spaceForOptions[iFrom]];
length: CARDINAL ~ hB.spaceForOptions[iFrom+1];
IF ((type = ArpaBuf.endOfListOption.type)
OR (type = ArpaBuf.noOpOption.type)) THEN {
iFrom _ iFrom + 1;
LOOP;
};
IF (length < 2) OR ((iFrom + length) > limit)
THEN ERROR Error[$badOptionLength];
IF (NOT type.mustBeCopied) THEN {
iFrom _ iFrom + length;
LOOP;
};
THROUGH [1..length] DO
b.body.bytes[iTo] _ hB.spaceForOptions[iFrom];
iFrom _ iFrom + 1;
iTo _ iTo + 1;
ENDLOOP;
ENDLOOP;
THROUGH [1..Basics.DivMod[num~iTo, den~4].remainder] DO
b.body.bytes[iTo] _ LOOPHOLE[ArpaBuf.endOfListOption.type];
iTo _ iTo + 1;
ENDLOOP;
bytesCopied _ iTo;
};

CopyOptionsUnfiltered: PROC [hdrBuf: Buffer, b: Buffer]
RETURNS [bytesCopied: CARDINAL] ~ {
hB: CommDriver.Buffer ~ DriverBuffer[hdrBuf];
bytesCopied _ ArpaBuf.OptionsBytes[hdrBuf];
IF bytesCopied # 0 THEN TRUSTED {
MoveBytes[toPtr~@hB.spaceForOptions, toOffset~0, fromPtr~@b.body.bytes, fromOffset~0, bytes~bytesCopied];
};
};

ComplexSend: PROC [n: Network, hdrBuf: Buffer, dataBuf: Buffer, offset: CARDINAL] ~ {

moreFragmentsAfterThese: BOOL ~ (dataBuf.ovh.next # NIL);
bytesLeft: CARDINAL _ ArpaBuf.DataBytes[dataBuf];
fragmentOffsetBytes: CARDINAL _ ArpaBuf.FragmentOffsetBytes[dataBuf];
dataOffsetBytes: CARDINAL _ 0;
optionsBytes, dataBytesToSend: CARDINAL;
firstFragment: BOOL;
b: Buffer ~ AllocBuffers[1];

b.hdr1 _ hdrBuf.hdr1;
b.ovh.encap _ hdrBuf.ovh.encap;

IF fragmentOffsetBytes = 0
THEN {
optionsBytes _ CopyOptionsUnfiltered[hdrBuf, b];
firstFragment _ TRUE;
}
ELSE {
optionsBytes _ CopyOptionsFiltered[hdrBuf, b];
firstFragment _ FALSE;
};
b.hdr1.ihl _ (optionsBytes + ArpaBuf.hdrBytes) / 4;

DO
dataBytesToSend _ GetMTU[n] - optionsBytes - ArpaBuf.hdrBytes;
IF dataBytesToSend >= bytesLeft
THEN {
b.hdr1.fragmentCtl _ IF moreFragmentsAfterThese
THEN ArpaBuf.InteriorFragmentCtl[fragmentOffsetBytes]
ELSE ArpaBuf.FinalFragmentCtl[fragmentOffsetBytes];
dataBytesToSend _ bytesLeft;
}
ELSE {
dataBytesToSend _ dataBytesToSend - Basics.DivMod[num~dataBytesToSend, den~8].remainder; -- round down to multiple of 8.
b.hdr1.fragmentCtl _ ArpaBuf.InteriorFragmentCtl[fragmentOffsetBytes];
};
TRUSTED { MoveBytes[toPtr~@b.body.bytes, toOffset~optionsBytes, fromPtr~@dataBuf.body.bytes, fromOffset~dataOffsetBytes, bytes~dataBytesToSend] };
b.hdr1.length _ Basics.HFromCard16[dataBytesToSend+optionsBytes+ArpaBuf.hdrBytes];

SimpleSend[n, b];

dataOffsetBytes _ dataOffsetBytes + dataBytesToSend;
fragmentOffsetBytes _ fragmentOffsetBytes + dataBytesToSend;
IF (bytesLeft _ bytesLeft - dataBytesToSend) = 0 THEN EXIT;

IF firstFragment THEN {
optionsBytes _ CopyOptionsFiltered[hdrBuf, b];
b.hdr1.ihl _ (optionsBytes + ArpaBuf.hdrBytes) / 4;
firstFragment _ FALSE;
};
ENDLOOP;

FreeBuffers[b];
hardToSend _ hardToSend.SUCC;
};
FetchOptionAddress: PUBLIC PROC [b: Buffer, pos: CARDINAL]
RETURNS [address: Address] ~ {
dB: CommDriver.Buffer ~ DriverBuffer[b];
address.a _ dB.spaceForOptions[pos];
address.b _ dB.spaceForOptions[pos+1];
address.c _ dB.spaceForOptions[pos+2];
address.d _ dB.spaceForOptions[pos+3];
};

FetchOptionByte: PUBLIC PROC [b: Buffer, pos: CARDINAL]
RETURNS [value: BYTE] ~ {
dB: CommDriver.Buffer ~ DriverBuffer[b];
value _ dB.spaceForOptions[pos];
};

FetchOptionH: PUBLIC PROC [b: Buffer, pos: CARDINAL]
RETURNS [value: CARD16] ~ {
dB: CommDriver.Buffer ~ DriverBuffer[b];
buf: Basics.ShortNumber;
buf.hi _ dB.spaceForOptions[pos];
buf.lo _ dB.spaceForOptions[pos+1];
value _ buf.sc;
};

FetchOptionF: PUBLIC PROC [b: Buffer, pos: CARDINAL]
RETURNS [value: CARD32] ~ {
dB: CommDriver.Buffer ~ DriverBuffer[b];
buf: Basics.LongNumber;
buf.hh _ dB.spaceForOptions[pos];
buf.hl _ dB.spaceForOptions[pos+1];
buf.lh _ dB.spaceForOptions[pos+2];
buf.ll _ dB.spaceForOptions[pos+3];
value _ buf.lc;
};

StoreOptionAddress: PUBLIC PROC [b: Buffer, pos: CARDINAL, address: Address] ~ {
dB: CommDriver.Buffer ~ DriverBuffer[b];
dB.spaceForOptions[pos] _ address.a;
dB.spaceForOptions[pos+1] _ address.b;
dB.spaceForOptions[pos+2] _ address.c;
dB.spaceForOptions[pos+3] _ address.d;
};

StoreOptionByte: PUBLIC PROC [b: Buffer, pos: CARDINAL, value: BYTE] ~ {
dB: CommDriver.Buffer ~ DriverBuffer[b];
dB.spaceForOptions[pos] _ value; 
};

StoreOptionH: PUBLIC PROC [b: Buffer, pos: CARDINAL, value: CARD16] ~ {
dB: CommDriver.Buffer ~ DriverBuffer[b];
buf: Basics.ShortNumber;
buf.sc _ value;
dB.spaceForOptions[pos] _ buf.hi; 
dB.spaceForOptions[pos+1] _ buf.lo;
};

StoreOptionF: PUBLIC PROC [b: Buffer, pos: CARDINAL, value: CARD32] ~ {
dB: CommDriver.Buffer ~ DriverBuffer[b];
buf: Basics.LongNumber;
buf.lc _ value;
dB.spaceForOptions[pos] _ buf.hh; 
dB.spaceForOptions[pos+1] _ buf.hl;
dB.spaceForOptions[pos+2] _ buf.lh;
dB.spaceForOptions[pos+3] _ buf.ll;
};
OnesComplementAddBlock: PUBLIC UNSAFE PROC [ptr: LONG POINTER, count: CARDINAL, initialSum: CARDINAL _ 0] RETURNS [sum: CARDINAL]
~ UNCHECKED {
p: LONG POINTER TO ARRAY [0..8) OF CARDINAL _ LOOPHOLE[ptr];
s: LONG CARDINAL _ initialSum;
FOR i: CARDINAL IN [0..count MOD 8) DO s _ s + p[i]; ENDLOOP;
p _ p+count MOD 8;
THROUGH [0..count/8) DO
s _ s + LONG[p[0]] + LONG[p[1]] + LONG[p[2]] + LONG[p[3]] + LONG[p[4]] + LONG[p[5]] + LONG[p[6]] + LONG[p[7]];
p _ p+8;
ENDLOOP;
WHILE Basics.HighHalf[s]#0 DO
s _ LONG[Basics.HighHalf[s]]+LONG[Basics.LowHalf[s]];
ENDLOOP;
RETURN[Basics.LowHalf[s]];
};

MoveBytes: PUBLIC UNSAFE PROC [toPtr: LONG POINTER, toOffset: INT, fromPtr: LONG POINTER, fromOffset: INT, bytes: INT]
~ UNCHECKED {
moved: INT;
to: LONG POINTER TO PACKED ARRAY [0..500) OF CHAR = LOOPHOLE[toPtr];
from: LONG POINTER TO PACKED ARRAY [0..500) OF CHAR = LOOPHOLE[fromPtr];
IF NOT (bytes IN [0..LAST[CARDINAL]]) THEN ERROR;
moved _ PrincOpsUtils.ByteBlt[[toPtr, toOffset, toOffset+bytes], [fromPtr, fromOffset, fromOffset+bytes]];
IF moved # bytes THEN ERROR;
};

}...
่ArpaIPImpl.mesa
Demers, September 4, 1987 10:38:10 am PDT
Types
Error
Checksum
Buffer Type Coercions
... we're not actually smashing the types of the objects (they're all CommDriver.Buffer), but just LOOPHOLEing between CommDriver and IP buffer descriptions.

Unique IDs
Objects and Handles
Handle Table
There's an object / handle for every registered protocol.

Backdoor
Dispatch an ICMP packet to given protocol.
Incoming Packets from Driver
Dispatch a packet to its protocol.
Receive Utilities
Sending
NOT YET IMPLEMENTED! ????
Assume Hdr has been entirely filled in except for checksum.
Assume encapsulation has been filled in.
Assume buffer is no longer than MTU of network.
Fill in IP Hdr checksum.
Send buffer on network.
Fragmentation and Options
Copy options from hdrBuf.spaceForOptions into b.body.  Pad with zeroes to a multiple of 4 bytes.  Return the number of bytes stored into b.
Assume hdrBuf's Hdr has been filled in.
Assume the length field of dataBuf has been filled in.
NOTE: hdrBuf = dataBuf is possible.
There may be options, which haven't been moved to their correct position.  Options should be taken from hdrBuf and filtered (for subsequent fragments).
The buffer sizes may exceed the network MTU.
Option Utilities
Utilities
สƒ˜
code™K™)K˜—š
ฯk	˜	Kšœœ˜"Kšœœข˜ฏKšœœ€
˜
Kšœœ˜&Kšœœ˜2Kšœœ	˜ Kšœœ˜&Kšœœœ.œ$˜kKšœ
œ˜!Kšœœ˜!Kšœœ=˜MKšœœ
˜K˜
K˜—šฯn
œœ
˜Kšœœ˜Kšœx˜Kšœ˜!K˜
head™Kšœœ
œ
˜K˜Kšœ	œ˜Kšœœ˜Kšœ	œ˜K˜Kšœ	œ˜#K˜Kšœœœ˜Kšœœ	œ
œ˜'—™Kš
žœœ
œœœ
˜(—™šžœœ
œœ˜7Kšœœ
˜Kšœœ
œฯc#˜MKšœœ
œŸk˜š
KšœJ˜QKšœœœ˜%K˜——™K™
K™š
žœœ
œœ
œ˜MKšœ
œ˜—š
žœœœœ
œ˜JKšœ
œ	˜—š
žœœ
œœ
œ˜:Kšœ
œ˜ ——š
ž
™
Kšœœ
˜K˜Kšœœ.˜<K˜šžœœ
œœœœ˜GKšœ(œ˜.K˜——™Kšœœœ˜šœœ
œœ˜K˜Kš
œ˜K˜Kšœ˜K˜K˜——™K™9K™Kšœ
œœ˜5Kšœ
œœœ˜5K˜Kšœœ
˜(Kšœ	œœ˜,K˜š
žœœ
œnœœ˜ฉ
Kšœœ
˜Kšœœœ
œ˜WKšœœ
œ
œ˜1Kšœ	œx˜„
Jš
œ5˜5K˜K˜—šžœœ
œ6œ˜`Kšœ
œœ
˜Kšœœ
œ
œ
œ
œ#˜MK˜Kš
œ˜K˜—šž
œœ
œ˜/Kš
œ%˜%K˜K˜—šžœœ
œ6˜TKšœ	œ"œ
œ
œ
œ˜_Kšœœœ
˜'K˜K˜——™šžœœ
œ-˜FK™*Kšœœ
˜K˜
Kšœœ
œ
œ
˜Kšœœ
œ˜5Kšœœœ
œ˜Wšœ!œœœœœœ˜uKšœ˜—Kšœœ
œ˜K˜——™Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜Kšœ
œ˜K˜šž
œœ
œœœœ˜BKšœœ6˜WK˜—Kšžœœ
œœœœœ
˜RK˜šžœœ˜K™"Kšœœ
˜K˜
Kšœœ!œ
œ
˜Dš
œ!œœœœ˜YKšœ˜—Kšœœ
œ˜K˜K˜—š
žœœ
œ6œœ!˜xK˜
K˜Kšœ"œ
˜'šœœ
œ˜Kšœœœ˜9—K˜K˜K˜Kš
œœ8œ'œœ˜{Kšœ+œ'œœ˜iKšœ&œ#œœ˜`Kšœ#œ-œxœ%œœ˜Ššœ˜Kšœ˜šœ˜Kš
œ˜Kšœ:œ
œ˜VK˜——Kšœ
œ
˜K˜š
˜Kšœœ
˜—K˜——™šžœœ
œ˜)šœœ
˜K˜Kšœ
œ
˜K˜'K˜	Kšœ
˜—K˜K˜—šžœœ
œ
œ
œœ˜_Kš	œ
œœœ
œ˜:Kšœœ
œŸ˜LKš
œ+˜+Kš
œ9˜9K˜K˜—šž	œœ
œœ˜AK˜šœ
œ"œ˜.Kšœœ˜)K˜7šœœ˜Kš
œ_˜_Kš
œ˜—K˜—K˜——™šžœœ
œœœœ˜Lšœ˜K˜2K˜K˜	Kšœ
˜—K˜K˜—š
žœœ
œœœ˜VKšœœ,Ÿ˜OKš
œ˜K˜6Kšœ1ŸV˜‡
K˜K˜—šžœœ
œ$œ˜LKšœœœ(œ˜yK˜—K˜Kšœœœ
˜Kšœœœ
˜šœ
œœ˜K˜KšœŸ˜-K˜'K˜K˜—Kšœœ
œ˜3K˜šžœœ
œ[œ˜Œ
Kš
œ˜K˜Kšœœ
˜Kšœœ
˜K˜šœ˜Kšœœ˜2Kšœ?œ˜HKšœ
˜—K˜šœ˜šœ
œ˜K˜Kš
œ5˜5Kšœœ
œ
œ˜4Kš
œ@˜@šœ˜KšœœR˜d—K˜—šœ˜Kšœœ˜K˜Jš
œ%˜%J˜K˜——K˜šœ˜šœ
œœ8˜RKšœ˜——K˜Kš
œ%˜%Kš
œ4˜4K˜Kš
œ*˜*K˜Kš
œ"˜"K˜K˜Kšœœ
œ˜)K˜K˜K˜/K˜š
˜K˜Kšœœ*˜9šœœœ˜6šœ˜šœœ˜K˜K˜K˜/K˜—šœœ˜'Kšœ!˜%Kšœ%˜)—Kš
œ˜K˜
—šœ˜K˜(K˜——K˜+Kšœœ
œ
œ
˜Kš
œ"œ	œœ
œ"˜fK˜Kšœ
˜—K˜K˜—šž
œœ
œM˜dKš
œ˜K˜šœ6˜;Kšœœ
œ
œ˜7Kšœœ
œ
˜&Kšœ
˜K˜—šœœ
œ
˜5K˜Kšœ
˜—K˜Kš
œ%˜%Kš
œ4˜4K˜Kš
œ*˜*K˜Kš
œ#˜#K˜Kšœœ
œ˜)K˜K˜K˜K˜—šž	œœ>˜Mšœ3œœ
˜FK˜kKš
œ2˜2Kšœ
˜—K˜K˜—KšœœŸ#˜HK˜š
žœœœœœ˜7K™Kšœ˜K˜—šž
œœ˜,K™;Kš
œ(™(K™/Kš
œ™K™Kšœœ%˜4Kšœœ
œ˜9Kšœœ
œ
˜ Kšœ"œ
œŸ˜DKš
œ'˜'šœ
œ˜Kšœ
œ
˜Kš
œ'˜'Kš
œ˜Kš
œ˜—K˜—K˜—™Kšœœ˜K˜šžœœœœ˜YK™‹
K˜-Kšœœ ˜/Kšœœ˜šœ˜Kšœœ˜?Kšœœ˜/šœ(œ#œ˜UK˜Kšœ
˜Kš
œ˜—Kšœœœ
œ˜Qšœœœ˜!K˜Kšœ
˜K˜—šœ
˜K˜.K˜K˜Kšœ
˜—Kšœ
˜—šœ.˜7Jšœœ˜;J˜Jšœ
˜—K˜K˜K˜—šžœœœœ˜[K˜-K˜+šœœ
œ˜!Kš
œi˜iKš
œ˜—K˜K˜—šžœœ7œ˜UK™'K™6K™#K™—
K™,K˜Kšœœœ˜9Kšœœ˜1Kšœœ(˜EKšœœ˜Kšœœ
˜(Kšœœ
˜K˜K˜K˜K˜K˜šœ˜šœ˜K˜0Kšœœ
˜K˜
—šœ˜K˜.Kšœœ
˜K˜——˜3K˜—š
˜Kš
œ>˜>šœ˜šœ˜Kšœœœ2œ/˜™
Kš
œ˜K˜
—šœ˜KšœYŸ˜xKš
œF˜FK˜——Kšœ‹
˜’
Kš
œR˜RK˜K˜K˜Kš
œ4˜4Kš
œ<˜<Kšœ/œ
œ
˜;K˜šœœ˜K˜.K˜3Kšœœ
˜K˜—Kšœ
˜—K˜K˜Kšœœ
˜K˜——™š
žœœ
œœœ˜YK˜(K˜$K˜&K˜&K˜&K˜—K˜šžœœ
œœœ	œ˜QK˜(Kš
œ ˜ K˜K˜—šžœœ
œœœ	œ˜PK˜(K˜K˜!K˜#K˜K˜K˜—šžœœ
œœœ	œ˜PK˜(K˜K˜!K˜#K˜#K˜#K˜K˜K˜—šžœœ
œœ˜PK˜(K˜$K˜&K˜&K˜&K˜K˜—š
žœœ
œœ	œ˜HK˜(Kš
œ!˜!K˜K˜—š
žœœ
œœ	œ˜GK˜(K˜K˜K˜"K˜#K˜K˜—š
žœœ
œœ	œ˜GK˜(K˜K˜K˜"K˜#K˜#K˜#K˜——™	
code2šžœœ
œ
œœ
œ	œœœœ
˜
Mšœ	œ˜
Kšœœ
œ
œ
œœ
œœ˜<Kšœœ
œ˜Kšœœ
œœœœ
˜=Kšœœ˜šœ˜Kšœœ	œ	œ	œ	œ	œ	œ	œ˜nK˜Kšœ
˜—šœ˜Kšœœœ˜5Kšœ
˜—Mšœ˜M˜M˜—šž	œœ
œ
œ	œ
œœœ
œœ	œ
˜vKšœ	œ˜
Mšœœ
˜Mšœœ
œ
œ
œ
œ
œ
œœ˜DMšœœ
œ
œ
œ
œ
œ
œœ
˜HMšœ
œœœ
œœ
œ
˜1Mš
œj˜jMšœœ
œ
˜Mš
œ
˜—K˜—K˜——…—Dา]=