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