ArpaIPImpl.mesa
Demers, September 4, 1987 10:38:10 am PDT
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
~ {
Types
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
Error: PUBLIC ERROR [code: ATOM] ~ CODE;
Checksum
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]]];
};
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.
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]]; };
Unique IDs
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];
};
Objects and Handles
Handle: TYPE ~ REF Object;
Object: PUBLIC TYPE ~ RECORD [
recvProc: ArpaIP.RecvProc,
recvErrorProc: ArpaIP.RecvProc,
protocol: ArpaBuf.Protocol,
acceptLongDatagrams: BOOL
];
Handle Table
There's an object / handle for every registered protocol.
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;
};
Backdoor
DispatchICMP: PUBLIC PROC [b: Buffers, protocol: ArpaBuf.Protocol] ~ {
Dispatch an ICMP packet to given 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];
};
Incoming Packets from Driver
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] ~ {
Dispatch a packet to its protocol.
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;
};
Receive Utilities
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]];
};
};
};
Sending
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 {
NOT YET IMPLEMENTED! ????
RETURN[theMTU] };
SimpleSend: PROC [n: Network, b: Buffer] ~ {
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.
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;
};
};
Fragmentation and Options
hardToSend: CARD ← 0;
CopyOptionsFiltered: PROC [hdrBuf: Buffer, b: Buffer]
RETURNS [bytesCopied: CARDINAL] ~ {
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.
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] ~ {
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.
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;
};
Option Utilities
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;
};
Utilities
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;
};
}...