1 ;:;; -*- Mode:MIDAS -*-
2 ;;; Copyright (c) 1999 Massachusetts Institute of Technology
4 ;;; This program is free software; you can redistribute it and/or
5 ;;; modify it under the terms of the GNU General Public License as
6 ;;; published by the Free Software Foundation; either version 2 of the
7 ;;; License, or (at your option) any later version.
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;;; General Public License for more details.
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program; if not, write to the Free Software
16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18 ; Insert new buffer stuff...
21 IP%VER==740000,, ; 0 IP Version # (= 4)
22 IP%IHL==036000,, ; 0 IP Header Length in 32-bit wds - at least 5
23 IP%TOS==001774,, ; 0 Type Of Service
24 IP%TOL==000003,,777760 ; 0 Total Length in octets (including header)
25 IP%ID== 777774,, ; 1 Identification
26 IP%FLG== 3,,400000 ; 1 Flags
27 IP%FDF== 1,,0 ; Don't-Fragment flag
28 IP%FMF== 400000 ; More-Fragments flag
29 IP%FRG== 0,,377760 ; 1 Fragment Offset
30 IP%TTL==776000,, ; 2 Time To Live
31 IP%PTC== 1774,, ; 2 Protocol
32 IP%CKS== 3,,777760 ; 2 Header Checksum
33 IP%SRC==777777,,777760 ; 3 Source Address
34 IP%DST==777777,,777760 ; 4 Destination Address
36 IP$VER==<.BP IP%VER,0>
37 IP$IHL==<.BP IP%IHL,0>
38 IP$TOS==<.BP IP%TOS,0>
39 IP$TOL==<.BP IP%TOL,0>
40 IP$ID== <.BP IP%ID, 1>
41 IP$FLG==<.BP IP%FLG,1>
42 IP$FRG==<.BP IP%FRG,1>
43 IP$TTL==<.BP IP%TTL,2>
44 IP$PTC==<.BP IP%PTC,2>
45 %PTCIC==:1 ; Protocol ICMP
46 %PTCTC==:6. ; Protocol TCP
47 %PTCUD==:17. ; Protocol UDP
48 IP$CKS==<.BP IP%CKS,2>
49 IP$SRC==<.BP IP%SRC,3>
50 IP$DST==<.BP IP%DST,4>
53 UD$SRC==<242000,,0> ; 0 wd 1 Source port
54 UD$DST==<042000,,0> ; 0 wd 2 Dest port
55 UD$LEN==<242000,,1> ; 1 wd 1 # octets in data
56 UD$CKS==<042000,,1> ; 1 wd 2 UDP checksum
57 UD$DAT==<441000,,2> ; 2 Data - actually an ILDB pointer!
60 IC$TYP==<341000,,0> ; 0 Type of message
61 IC$COD==<241000,,0> ; 0 Code (subtype)
62 IC$CKS==<042000,,0> ; 0 ICMP Checksum
63 IC$GWA==<044000,,1> ; 1 Random arg, usually Gateway Addr
64 IC$IPH==2 ; 2 Random data, usually an IP header
66 ; Hack metering macro, since we'll want lots of 'em to start with.
67 ; You know, MR% used to be MTR%, except that when %NMTRS is over 100
68 ; you get duplicated symbols, and since they used to be defined with
69 ; == instead of ==: you didn't hear about it, either.
71 %NMTRS==:140 ; Allow this many meters
72 DEFINE MTRCOD ; Put this macro someplace after last meter.
74 MTRCNT: BLOCK %NMTRS ; Holds actual meter AOS'd
76 MTRNAM: BLOCK %NMTRS ; Holds <instr loc>,,<addr of ASCIZ meter name>
78 REPEAT %%%MTR,CONC MR%,\.RPCNT
79 IF2, REPEAT %%%MTR,CONC EXPUNGE MR%,\.RPCNT
84 ; METER - Must be used as in following example:
85 ; METER("IP: # of bad cksums")
88 IFGE %%%MTR-%NMTRS,.ERR Too many meters!
90 CONC MR%,\%%%MTR,==:<.,,[ASCIZ NAME]>
91 ;CONC MR%,\%%%MTR,==:<.,,>
92 ;IF1 SHOMTR %%%MTR,NAME
96 DEFINE SHOMTR #OFF#,&STR&
97 PRINTX /;;;;;;;; METER :::: MTRCNT+!OFF! => /
104 IPMDFL: 0 ; # of flushed input datagrams
105 IPMCKF: 0 ; # of input datagrams with bad checksum
106 IPMFRG: 0 ; # of fragments received
107 IPMFRD: 0 ; # of sucessfully reassembled datagrams
110 SUBTTL IP Input Interrupt Level
112 ; IPGIPT - Get datagram input buffer
114 ; A/ Max size of buffer in words
115 ; Returns .+1 if failure (error message already printed)
117 ; A/ Pointer to datagram structure associated with buffer
118 ; B/ Input BLKI pointer to buffer, -<# wds>,,<addr-1>
120 IPGIPT: CAILE A,PKBSIZ ; Make sure size needed will fit in a packet buffer
122 CALL PKTGFI ; Get a packet at int level
123 RET ; Failed, none available.
124 TRCPKT A,"IPGIPT Net input alloc"
125 MOVE T,PK.BUF(A) ; Get addr of buffer
126 HRLOI B,-PKBSIZ ; -<#wds>,,-1
127 ADDI B,(T) ; Now get BLKI pointer into buffer
129 IPGIP9: BUG CHECK,[IP: Too-big buff reqd =],OCT,A
133 ; IPRDGM - Process a received datagram at PI level
134 ; Must put datagram into one of the following lists:
135 ; User IP input queue (IPQ)
136 ; IP reassembly table
138 ; TCP connection queue
139 ; A/ Pointer to datagram structure
140 ; B/ # words read in datagram
141 ; C/ # wds offset to start of IP header
142 ;;; J is not used, and not supplied by all callers
143 ;;; J/ host-table index of address datagram came from
145 ; Can clobber all ACs except P
147 ; R/ addr of packet entry
148 ; W/ addr of IP header
151 IPRDGM: METER("IP: IDs rcvd")
152 MOVEI R,(A) ; Set up packet entry ptr in canonical place
153 TRCPKT R,"IPRDGM Input from net"
154 CAIGE B,5(C) ; Make sure it's big enough
156 HRLM B,PK.BUF(R) ; Store # words read
157 ADD C,PK.BUF(R) ; Find addr of start of IP header
158 HRLZM C,PK.IP(R) ; and set it.
160 LDB H,[IP$IHL (W)] ; Find claimed length of IP header
161 ADDI H,(W) ; Get addr of start of IP data
162 HRLZM H,PK.TCP(R) ; Set that too.
164 ; Do initial vectoring test.
165 SKIPE IPUQUS ; Check Queue 0 (SysIn)
166 JRST IPRDG2 ; It exists!! Always vector for it.
168 ; Perform initial checking for address, checksum, and so forth
169 ; to verify datagram is good; also dispatch to handle fragments.
170 ; This is entry point for re-vectors from SysIn IP queue.
171 IPRDGV: CALL IPCKSM ; Compute checksum for IP header
172 LDB B,[IP$CKS (W)] ; and get what the datagram had,
173 CAIE A,(B) ; in order to compare them...
174 JRST [ METER("IP: Ifl bad cksm")
175 AOS IPMCKF ; Bump two meters
176 JRST IPRD90] ; Go flush it forthwith.
177 MOVE B,IP$DST(W) ; Get destination host, should be us
178 IFE IPUNCP, CAME B,[IMPUS3_4]
181 ; Packet is to be forwarded
182 METER("IP: Packets forwarded")
183 LDB B,[IP$TTL(W)] ; Decrement time to live
184 SOJLE B,[ METER("IP: Packets expired")
186 ICMEK1: DPB B,[IP$TTL(W)]
187 CALL IPCKSM ; Update the checksum
189 MOVEI A,(R) ; Transmit it
192 IPRD10: HRRE B,IP$FRG(W) ; HACK! Get both IP%FMF and IP%FRG!
193 JUMPN B,IPRD50 ; Jump if this is a fragment.
195 ; Do datagram vectoring. This code is temporarily (?) crude,
196 ; it just scans the whole Internet Queue table.
197 ; This is entry point for re-vectoring. W must point to IP
198 ; header, and H to IP data. I should point at 1st queue entry
199 ; to start checking at.
200 IPRD20: MOVEI I,2 ; If drop in, start at 2 (leave 0+1 alone)
201 LDB B,[IP$PTC (W)] ; Get protocol number
202 CAIN B,%PTCTC ; Is it TCP?
203 JRST TCPIS ; Yes, go process TCP input segment.
204 CAIN B,%PTCUD ; Well, is it UDP?
205 JRST IPRD30 ; Yeah, can handle that one.
206 CAIN B,%PTCIC ; Maybe ICMP?
207 JRST ICMP ; Yup, hack it.
209 CALL PKTRT ; Bah, nothing we handle, flush it.
210 AOS IPMDFL ; Bump count of flushed dgms.
213 ; Here to dispatch a UDP datagram
214 IPRD30: LDB A,[IP$TOL (W)] ; Make sure it's long enough! Find dgm length
215 LDB B,[IP$IHL (W)] ; and get IP header length
216 IMULI B,4 ; in octets
217 SUBI A,(B) ; to subtract from dgm length.
218 CAIGE A,2*4 ; Must have enough data for UDP header!
219 JRST [ METER("IP: Ifl bad UDP len")
220 JRST IPRD90] ; Flush this dgm.
222 JRST [ METER("IP: Ifl no UDP port") ; Didn't find any queues,
223 JRST IPRD90] ; so flush it.
224 SKIPN IPUQUS(I) ; Check each active UDP queue
226 LDB B,[UD$DST (H)] ; Get UDP dest port number
227 HRRZ T,IPUQCT(I) ; and port # we're watching for
229 AOJA I,IPRD31 ; No match, try another.
230 METER("IP: # UDP dgms queued")
232 IPRDG2: SETZ I, ; Entry point for SysIn queueing
233 MOVEI Q,IPUQHD(I) ; Hurray, got it! Add to queue
234 MOVE B,(Q) ; Save prev contents of header
236 CALL PKQPL(PK.IP) ; Put at end of input IP queue
237 JUMPE B,IPQUSI ; If nothing previously there, give user int.
240 IPRDG9: BUG INFO,[IP: Netin dgm too small, size ],OCT,B,[ offset ],OCT,C
241 JRST IPRD90 ; Try flushing the packet buffer.
243 ; IP Datagram Reassembly - Handle received fragment.
245 IPRD50: AOS IPMFRG ; Bump count of fragments received
247 LDB D,[IP$ID (W)] ; Get datagram ID field
248 LDB C,[IP$PTC (W)] ; Then protocol field
249 HRLI D,(C) ; Make <ptcl>,,<ID>
250 MOVE E,IP$SRC(W) ; Then source address
252 IPRD51: CAME D,IPFDID(I)
254 JUMPL I,IPRD70 ; If no more, must add to table.
255 MOVE B,IPFDPE(I) ; Matching ID! Get buffer ptr
256 HLRZ T,PK.IP(B) ; Get IP header ptr for existing fragment
257 CAME E,IP$SRC(T) ; Ensure same source host
258 JRST IPRD52 ; Nope, go check next entry.
259 HLRZ H,PK.TCP(B) ; Get ptr to start of data in reassembly buff
261 ; OK, we matched up a fragment! Now start reassembly procedure.
262 ; If fragment is first one (offset 0) then must copy IP header,
263 ; unless already done. Safe to BLT since we always reserve
264 ; enough room for a full 15-word IP header.
265 ; If fragment is last one (IP%FMF 0) then must set IP$TOL to
266 ; the total # octets in full datagram. This gets fixed
267 ; to include the IP header length when datagram is complete.
268 ; I/ idx of reassembly entry
269 ; T/ ptr to IP header in reassembly buff
270 ; H/ ptr to data in reassembly buff
271 ; R, W as for entry to IPRD50
272 IPRD55: LDB A,[IP$IHL (W)] ; Get IP header length in 4-octet wds
273 LDB E,[IP$TOL (W)] ; Get total length of this dgm in octets
274 HRRE D,IP$FRG(W) ; Hack - get frag offset and more-frag flag
275 TRNN D,IP%FRG ; Is frag offset 0 - 1st part of dgm?
276 JRST [ LDB C,[IP$FRG (T)] ; Yeah. Already copied header?
277 JUMPE C,.+1 ; Jump if so, don't do again.
279 HRLI B,(W) ; Set up BLT from,,to
281 ADDI C,(A) ; Get to+IHL
282 MOVE Q,IP$CKS(T) ; Save ptr to hole list
283 LDB TT,[IP$TOL (T)] ; Save TOL, might already be set.
284 BLT B,-1(C) ; Copy the IP header
285 HRRM Q,IP$CKS(T) ; Restore hole list head
288 ASH D,-3 ; Get frag.first in terms of 4-octet words
289 JUMPGE D,[ ; Jump for special processing if last frag
291 ASH B,2 ; Get -<# octets in header>
292 ADDI B,(E) ; Find # octets of data in this fragment
294 LSH C,2 ; Get # octets data is offset
295 ADDI B,(C) ; Finally get total # data octets of full dgm
297 ADDI E,3 ; Okay, round UP to full word
298 LSH E,-2 ; Get rounded-up length in terms of 4-octet wds
299 SUBI E,1(A) ; Get # whole wds of data (minus 1)
300 JRST IPRD56] ; Go rejoin normal processing
302 ; Not last frag. Only special check is to ensure length of data
303 ; is rounded down to a fragment boundary (frags are 8-octet chunks).
304 TRZ D,-1#<IP%FRG_-3> ; Not last frag, clean up RH of frag.first
305 LSH E,-2 ; Get rounded length in terms of 4-octet words
306 SUBI E,1(A) ; Get # whole words of data, minus 1
307 TRNN E,1 ; Paranoia: ensure # wds of data was EVEN
308 SUBI E,1 ; If not, round DOWN to ensure 8-octet boundary
310 IPRD56: JUMPL E,IPRD80 ; Flush if bad length
311 ADDI E,(D) ; Get frag.last
312 CAIL E,<PKBSIZ-16.> ; Make sure datagram won't be too big.
313 JRST [ METER("IP: Ifl huge dgm")
314 CALL IPFDFL ; Ugh, must flush whole datagram entry!
315 JRST IPRD90] ; Would it be better instead to just
316 ; truncate it, and accept anyway since TCP
317 ; can ACK up to that much? Probably not.
319 ; Each hole descriptor is 1 word of format
320 ; hole.first: <hole.last>,,<hole.next (hole.first of next hole)>
322 ; During re-configuration of the hole descriptor list, following
325 ; B/ hole.first (wd offset)
327 ; D/ <lastflg>,,frag.first ; lastflg is 0 if last fragment.
329 ; Q/ ptr to current hole descriptor
330 ; TT/ ptr to previous hole descriptor
331 ; H/ ptr to start of data in reassembly buffer (base for offsets)
332 ; W/ ptr to IP header of just-arrived fragment
333 ; T/ ptr to IP header of reassembly buffer
334 ; R/ ptr to packet entry of just-arrived fragment
335 MOVEI Q,IP$CKS(T) ; Get ptr to 1st hole descriptor
336 IPRD61: MOVEI TT,(Q) ; Save old ptr
337 HRRE Q,(Q) ; Get next descriptor
338 JUMPL Q,IPRD68 ; Jump if end of list
339 MOVEI B,(Q) ; Set hole.first
340 ADDI Q,(H) ; Make ptr to hole descriptor
341 HLRZ C,(Q) ; Get hole.last
342 CAIGE C,(D) ; If hole.last < frag.first,
343 JRST IPRD61 ; back to try next hole farther on.
344 CAIGE E,(B) ; If frag.last < hole.first,
345 JRST IPRD68 ; passed affected area, so can stop now.
347 ; New fragment interacts with current hole in some way!
348 ; Remove current hole from the list, but keep Q pointing to
349 ; start of hole. TT points to the last valid hole descriptor.
350 MOVE A,(Q) ; Get hole.first of next hole
351 HRRM A,(TT) ; Store in prev hole, so current is skipped.
352 CAIL B,(D) ; If hole.first < frag.first, skip.
355 ; Create new hole descriptor at start of old hole
356 ; with new.first = hole.first and new.last = frag.first-1
357 ; i.e. hole.first: <frag.first-1>,,<hole.next>
358 ; First get ptr to new hole and put it on list.
359 HRRM B,(TT) ; Point prev hole to new hole.
360 HRLI A,-1(D) ; Make <frag.first-1>,,<hole.first of next>
361 MOVEM A,(Q) ; Store new hole descriptor.
362 MOVEI TT,(Q) ; Make prev be current, in case test below wins
363 ; Drop thru to check high bound of old hole
365 IPRD66: CAIL E,(C) ; If frag.last < hole.last then hole not all filled
366 JRST IPRD61 ; (hole all filled, so go check further holes)
367 CAIL D, ; Some hole left; is this the last fragment?
368 JRST [ HLLOS (TT) ; Yes! Zap prev hole to ensure list ends.
369 JRST IPRD68] ; and get out of loop now.
371 ; Fragment didn't fill last part of hole, so need to create
372 ; new hole descriptor for it,
373 ; with new.first = frag.last+1 and new.last = hole.last
374 ; i.e. frag.last+1: <hole.last>,,<hole.next>
375 MOVEI Q,1(E) ; Get frag.last+1
376 HRRM Q,(TT) ; Point previous to new hole
377 ADDI Q,(H) ; Make abs ptr to new hole
378 HRLI A,(C) ; Make <hole.last>,,<hole.next>
379 MOVEM A,(Q) ; Store new hole descriptor.
380 ; Can drop through to end loop, since no further holes
383 ; No more holes on list, we can copy the data now!
384 IPRD68: HLL D,PK.TCP(R) ; Get <ptr to start of arrived data>,,<frag.first>
385 ADDI D,(H) ; Now have BLT pointer
386 ADDI E,(H) ; and now have terminating address
387 CAIN E,(D) ; But if only moving 1 word,
388 JRST [ HLRZ D,D ; Can't use BLT?
389 MOVE A,(D) ; So just move by hand
391 JRST .+2] ; Skip over it.
392 BLT D,(E) ; Here we go!
394 ; Now see if any holes left...
395 MOVEI W,(T) ; Save ptr to reassembly IP hdr (H already set)
396 MOVEI A,(R) ; No need for arrived dgm any more,
397 CALL PKTRTA ; so flush it now.
398 HRRE A,IP$CKS(W) ; See if any holes left
399 JUMPGE A,CPOPJ ; Jump if some left, nothing else to do.
401 HRRZ R,IPFDPE(I) ; Win!!! Get back packet-entry ptr
402 LDB A,[IP$IHL (W)] ; Must perform final TOL fixup. Get IHL
403 LSH A,2+4 ; in octets, shifted to TOL field
404 ADDM A,IP$TOL(W) ; Now have proper length!
409 AOS IPMFRD ; Bump cnt of # datagrams reassembled!
410 JRST IPRD20 ; Go dispatch the datagram!
413 ; Create entry in table to store 1st fragment in.
414 IPRD70: MOVEI I,NIPF-1
417 JUMPL I,[METER("IP: Ifls Fragtab full") ; Barf, fragment table full.
419 LDB A,[IP$TTL (W)] ; Get time-to-live
420 JUMPE A,IPRD90 ; Might as well hack zero case
421 IMULI A,30. ; Turn into 30ths
423 MOVEM A,IPFTTL(I) ; Store timeout value
424 MOVEM D,IPFDID(I) ; Store ptcl,,ID
425 HRRZM R,IPFDPE(I) ; Store PE ptr
427 ; Messy stuff, must get data set up into right place in buffer.
428 ; If this is the 1st fragment we are OK, and can use original
429 ; datagram buffer, else we have to shuffle data. Simplest way
430 ; to handle latter case is to just get a new buffer and copy
432 LDB A,[IP$FRG (W)] ; Get fragment offset field
433 JUMPN A,IPRD75 ; If not zero, jump to do copy.
434 LDB A,[IP$TOL (W)] ; Hurray, 1st fragment! Get total length
435 LSH A,-2 ; Round down to # words
437 SUBI A,(B) ; Find # words that fragment uses
438 TRZ A,1 ; Ensure # wds is rounded down to 8-octet chunk
439 JUMPLE A,[CALL IPFDFL ; Sigh, flush entry.
440 RET] ; Just return, only flushing one PE.
441 HRRM A,IP$CKS(W) ; Store first hole.next in header.
443 ADDI B,(H) ; Get addr of start of hole
444 SETOM (B) ; Make it an infinite hole.
447 ; Fragment entry must be stored, but it isn't the 1st thing in
448 ; the datagram. We must cons up a fake initial fragment and
449 ; then copy normally into that fragment.
450 ; Note that this fake fragment must be carefully initiallized
451 ; since certain IP fields are referred to in the reassembly code
453 IPRD75: CALL PKTGFI ; Get a PE ptr at PI lvl
454 JRST IPFDFL ; Failed, must flush entry
455 TRCPKT A,"Reassembly alloc"
456 MOVEM A,IPFDPE(I) ; Store it
458 HRLM T,PK.IP(A) ; Say IP header at start of buffer.
459 MOVEI H,15. ; Use maximum IHL for offset
460 HRRZM H,IP$CKS(T) ; Store this offset as ptr to 1st hole desc
461 ADDI H,(T) ; and make data start at end of max IP hdr.
463 SETOM (H) ; Make 1st hole descriptor be infinite
464 SETOM IP$FRG(T) ; Put crap in frag offset field
465 MOVE B,IP$SRC(W) ; and ensure source host copied too.
467 JRST IPRD55 ; Now go do the copy...
469 IPRD80: METER("IP: Ifl bad len") ; Bad IP length field
470 JRST IPRD90 ; Go flush the dgm.
472 ; IPFCLK - Called every few seconds at clock level to check
473 ; reassembly tables and flush any partially filled datagrams
474 ; which have timed out.
476 IPFCLK: MOVEI I,NIPF-1
478 CONO PI,NETOFF ; Hack with net ints deferred.
480 CALL IPFDFL ; Flush the partial dgm
482 CONO PI,NETON ; Done, re-enable net ints.
485 ; IPFDFL - Flush reassembly entry in I
488 IPFDFL: SKIPE A,IPFDPE(I)
489 CALL PKTRTA ; Flush the packet buffer
491 SETOM IPFDID(I) ; Clear out other table stuffs.
497 ; Datagram Fragment table.
498 ; Free entries have IPFDPE 0, IPFDID -1, and IPFTTL SETZ-1 (max pos time)
500 NIPF==:30 ; Max # of outstanding IP datagram reassembly buffers
501 IPFDPE: BLOCK NIPF ; <PE ptr>
502 IPFDID: REPEAT NIPF,-1 ; <protocol>,,<datagram ID from IP header>
503 IPFTTL: REPEAT NIPF,SETZ-1 ; Sys time after which entry flushed.
506 SUBTTL IP Output Interrupt Level
515 ; IPGIOQ - Get IP Output Queue entry for IMP
516 ; Returns .+1 if nothing in queue
518 ; A/ Pointer to datagram structure
519 ; B/ Output BLKO pointer to buffer, -<# wds>,,<addr-1>
520 ; C/ Arpanet host address
521 ; H/ host-table index
524 IPGOQ1: METER("IP: ODs flushed")
525 CALL PKTRT ; Internal looping point
527 IPGIOQ: MOVEI Q,IPOUTQ
528 CALL PKQGF(PK.IP) ; Get first thing off IP output list
529 JUMPE A,IPGOQ9 ; Jump and return if nothing there.
530 MOVE T,PK.FLG(A) ; Get packet flags
531 TLNE T,(%PKFLS) ; Should we flush this one?
532 JRST IPGOQ1 ; Yes, down the drain it goes.
534 IORM T,PK.FLG(A) ; Say packet locked at PI level.
538 BUG HALT,[IP: Null dgm on queue]
540 ;KS doesn't care, save 2 usec..
541 MOVN B,C ; Straightforward way to put together AOBJN ptr.
542 HRRI B,-1(C) ; Now have BLKO
544 MOVE C,PK.DST(A) ; Get destination address
547 ; Ask interface if it wants this particular datagram right now.
550 JRST IPGOQ5 ; Can't send, requeue
552 ; Got valid dgm, must ensure that block queue is merged back
553 ; onto beginning of output queue.
554 IPGOQ6: METER("IP: ODs sent")
555 SKIPN D,IPOBLQ ; See if anything was blocked
556 JRST POPJ1 ; Nope, just take win return.
557 SETZM IPOBLQ ; Yes, block queue exists!
558 SKIPN T,IPOUTQ ; Get ptr to 1st node on output queue
559 JRST [ MOVEM D,IPOUTQ ; If nothing was left on output queue,
560 JRST POPJ1] ; can simply move the list.
561 HLRZ E,D ; Get ptr to last node on blocked queue
562 HRRM T,PK.IP(E) ; Point end of blocked Q to start of output Q
563 HRRM D,IPOUTQ ; and point start of output Q to start of block Q
564 JRST POPJ1 ; and return with nice winning dgm.
566 ; Come here to handle blockage of IP datagram.
567 IPGOQ5: MOVSI T,(%PKPIL)
568 ANDCAM T,PK.FLG(A) ; Say not locked at PI after all
570 CALL PKQPL(PK.IP) ; Put blocked dgm onto block queue
571 JRST IPGIOQ ; Now go try next dgm.
573 ; Output queue empty, just shift block queue back.
574 IPGOQ9: SKIPN A,IPOBLQ ; See if anything was put on block queue
575 RET ; Nope, all's clear.
576 MOVEM A,IPOUTQ ; Aha, move it to standard output queue
577 SETZM IPOBLQ ; and clear the block-queue ptr.
578 RET ; Nothing to send from IP at moment.
582 ; IPIODN - Output of IP datagram complete, wrap up.
583 ; Called by all device drivers.
584 ; A/ pointer to datagram structure
588 IPIODN: TRCPKT A,"IPIODN Packet output complete"
589 MOVE T,PK.FLG(A) ; Get flags for packet
590 TLO T,(%PKODN) ; Say output done,
591 TLZ T,(%PKPIL) ; and unlock PI level output flag.
592 MOVEM T,PK.FLG(A) ; Store flags back.
593 CALRET PKTRT ; Return to freelist if not otherwise queued
596 SUBTTL ICMP - Internet Control Message Protocol
598 ; ICMP called at NET interrupt level to process just-received ICMP
603 ; First compute and verify checksum for ICMP data.
605 ; Then dispatch on type for processing.
606 LDB E,[IP$SRC (W)] ; Load up source addr (commonly needed)
607 LDB A,[IC$TYP (H)] ; Get ICMP type field
610 AOS ICMPCT(A) ; Bump count of types
611 JRST @ICMPTB(A) ; Dispatch on type
614 ICMP19: BUG INFO,[ICMP: Bad type ],DEC,A,[from ],OCT,E
619 ICMPTB: ICMP90 ; 0 Echo Reply (ignored)
622 ICMP90 ; 3 Destination Unreachable (ignored)
623 ICMP90 ; 4 Source Quench (ignored)
630 ICMP90 ; 11 Time Exceeded (ignored)
631 ICMPP ; 12 Parameter Problem
632 ICMP90 ; 13 TimeStamp (ignored)
633 ICMP90 ; 14 TimeStamp Reply (ignored)
634 ICMP90 ; 15 Information Request (ignored)
635 ICMP90 ; 16 Information Reply (ignored)
638 IPMICM: 0 ; # of ICMP datagrams
639 ICMPCT: BLOCK NICMPT ; # of ICMP datagrams, by type
644 ICMEK: MOVEI A,0 ; Set type to Echo Reply
646 LDB A,[IC$CKS (H)] ; Fix checksum for change of 8 to 0
651 MOVE A,IP$SRC(W) ; Exchange source and destination
654 MOVEI B,60. ; Reset time to live
655 JRST ICMEK1 ; Go send packet
657 ; Type 12 - Parameter Problem.
659 ICMPP: LDB B,[IC$COD (H)] ; Get code field
661 BUG INFO,[ICMP: Param err, code ],OCT,B,[from ],OCT,E
663 ICMPP2: LDB A,[341000,,1(H)] ; Get pointer into bad IP header
665 LSH B,-2 ; Find word # error is in
666 ADDI B,IC$IPH(H) ; Make addr to word
667 BUG INFO,[ICMP: Param err, ptr ],OCT,A,[wd ],OCT,(B),[from ],OCT,E
670 ; ICMP type 5 - Redirect
672 ICMRD: MOVEI D,IC$IPH(H)
673 MOVE A,IP$SRC(D) ; Get source addr of alleged IP header
674 CAME A,[IMPUS4_4] ; Must be a datagram WE sent.
679 JRST ICMP90 ; Bah, flush. Probably should log it.
680 LDB A,[IP$DST (D)] ; Get dest addr we used
681 GETNET A ; Derive net number
682 LDB B,[IC$GWA (H)] ; Get gateway addr recommended for this net
683 MOVEI C,NIPGW-1 ; Scan backwards thru gateway table
684 SETOB T,TT ; Index of free slot, index of oldest slot
685 ICMRD2: CAMN A,IPGWTN(C)
686 JRST [ SKIPN IPGWTG(C) ; Don't change a direct-route entry!
689 CAIL C,NIPPGW ; Skip if prime gateway, not replaceable
690 JRST [ SKIPN IPGWTN(C)
691 MOVEI T,(C) ; Save index of last free slot found
694 MOVEI TT,(C) ; Save index of least recently used slot
699 ; Network not found in gateway table, must make new entry.
700 SKIPL C,T ; If there was one free,
701 JRST ICMRD3 ; go use that one.
702 MOVE C,TT ; Otherwise use least recently used entry
705 CAIGE T,60.*60.*30. ; Flushing entry less than 1 hour old?
706 BUG INFO,[ICMP: GW table full, net/gw ],OCT,IPGWTN(C),OCT,IPGWTG(C),[=>],OCT,A,OCT,B
707 ICMRD3: GETNET D,B ; Figure out which interface this gateway is on
712 JUMPL T,ICMP90 ; I can't figure out how to get to this gateway anyway
713 MOVEM A,IPGWTN(C) ; Set network number
714 MOVEM B,IPGWTG(C) ; and its corresponding gateway addr
715 MOVE T,IPGWTI(T) ; and its interface
717 MOVE T,TIME ; Pretend it was used so it
718 MOVEM T,IPGWTM(C) ; stays around for a while
721 SUBTTL IPQ Device - Internet Protocol Queues
723 ; Internet Protocol User Datagram Queue stuff, manipulated with
724 ; IPKIOT system call.
725 ; Queue 0 is special:
726 ; Must be asked for explicitly
727 ; All Input datagrams are vectored through it.
728 ; No limit on input queue length
729 ; Can put datagrams back into system for further processing
730 ; Can send datagrams (like ordinary queue actually in this respect)
731 ; Queue 1 is also special:
732 ; Must be asked for explicitly
733 ; All output datagrams are vectored through it.
734 ; No limit on queue length
735 ; Can put datagrams back onto device output queue.
737 IFNDEF NIPUQ,NIPUQ==10 ; # User queues allowed
739 IPUQUS: BLOCK NIPUQ ; <flags><channel>,,<user index>
740 IQ%CH==<77,,> ; Field for channel #
741 IQ$CH==<.BP IQ%CH,IPUQUS> ; BP to channel #
742 IPUQHD: BLOCK NIPUQ ; Input queue header
743 IPUQCT: BLOCK NIPUQ ; # datagrams on input queue,,vector args
745 IPQOSW: -1 ? 0 ; IP Queue assignment lock
748 ; IPQO - IPQ OPEN routine
749 ; Control bits currently defined are
750 %IQSYS==100 ; Set up System Queue (0 or 1)
751 %IQSOU==200 ; System Queue 1 if set, otherwise 0
752 %IQUDP==400 ; Set up random queue for UDP (port # in FN1)
754 IPQO: CALL SWTL ; Only one job at a time hacking IQ allocation.
756 SETZB E,I ; Set up convenient zeros
757 TLNE C,%IQSYS ; Asking for system queue?
758 JRST [ TLNE C,%IQSOU ; Yes, want input or output?
759 MOVEI I,1 ; Output, use queue 1
760 SKIPE IPUQUS(I) ; Skip if it's free
761 JRST OPNL23 ; Nope, say "file locked".
762 JRST IPQO2] ; Can grab it, do so!
763 MOVE I,[-<NIPUQ-2>,,2] ; Scan tables, skipping 0'th entry
764 SKIPE IPUQUS(I) ; Look for free slot
766 JUMPGE I,OPNL6 ; If none available, claim "device full"
767 TLNN C,%IQUDP ; Got it. If will use UDP vectoring,
768 JRST OPNL33 ; No, complain "meaningless args"
769 ; since nothing else understood yet.
770 TLO E,%IQUDP ; then set flag for IPUQUS.
771 HRRZM A,IPUQCT(I) ; Store FN1 as UDP port number
773 IPQO2: SETZM IPUQCT(I)
774 SETZM IPUQHD(I) ; Clear input queue
775 MOVEI A,IPQDN ; IOCHNM device index to use
776 HRLI A,(I) ; Save IQ index in LH
778 MOVEI A,-IOCHNM(R) ; Start putting together the IPUQUS entry.
779 SUBI A,(U) ; Get channel #
780 DPB A,[.BP IQ%CH,E] ; Remember it in IPUQUS word
781 HRRI E,(U) ; Put user index in RH
782 MOVEM E,IPUQUS(I) ; Store, queue is now activated!
783 ; Note this must be last thing, to avoid
785 CALRET LSWPJ1 ; Unlock switch and return!
787 ; IPQCLS - IPQ CLOSE routine
789 IPQCLS: HLRZ I,(R) ; Get IQ idx
790 CAILE I,1 ; Is it the Sys In or Out queue?
791 JRST IPQCL5 ; Nope, can handle normal case.
792 CONO PI,NETOFF ; Keep anything from being added meanwhile
793 SETZM IPUQUS(I) ; Mark queue not active, to avoid revector loops.
794 SETZM IPUQCT(I) ; Be tidy and clear other stuff too.
797 ; Close down System Output queue. This means all output
798 ; on this queue gets moved directly onto the real output
800 IPQCL1: MOVEI Q,IPUQHD(I)
801 CALL PKQGF(PK.IP) ; Get first thing queued up
802 JUMPE A,[CONO PI,NETON ; Exit if no more.
803 CALRET IPOGO] ; Ensure output fired up.
805 CALL PKQPL(PK.IP) ; Put at end of real output queue
808 ; Close down System Input queue. This means all currently
809 ; queued input gets processed immediately. Note I gets
810 ; clobbered, but isn't necessary since we know this is queue 0.
811 IPQCL3: MOVEI Q,IPUQHD ; Get header for queue 0
812 CALL PKQGF(PK.IP) ; Get A/ packet ptr
814 HLRZ B,PK.BUF(A) ; Get B/ # words in packet
815 SETZ C, ; Get C/ # wds offset to IP header
816 CALL IPRDGM ; Process and vector it.
817 JRST IPQCL3 ; Get next
820 ; Normal datagram input queue. Doesn't need NETOFF since
821 ; PI level ignores the queue entry if it's inactive. Just
822 ; need to keep another job from assigning it...
823 IPQCL5: CONO PI,CLKOFF
824 SETZM IPUQUS(I) ; Clear its "active" entry word to stop queueing
825 CALL IPQRS2 ; Flush its input queue (clears IPUQHD)
830 ; IPQRST - IPQ RESET routine. Clears queue for channel.
831 ; This is pretty drastic for the System I/O queues.
833 IPQRST: HLRZ I,(R) ; Get IQ idx
834 CONO PI,NETOFF ; Prevent new dgms from arriving meanwhile.
835 CALL IPQRS2 ; Flush the queue
838 IPQRS2: MOVEI Q,IPUQHD(I)
839 CALL PKQGF(PK.IP) ; Pull off 1st thing
840 JUMPE A,CPOPJ ; Return when no more
842 CAIN I,1 ; If queue is the Sys Output queue
843 JRST [ TLNE T,(%PKFLS) ; Then do special stuff.
844 JRST IPQRS3 ; Flush only if explicitly requested
845 TLZ T,(%PKPIL) ; Otherwise clear PI-Locked bit
846 TLO T,(%PKODN) ; and claim "output done" (ha ha)
849 IPQRS3: CALL PKTRT ; Put all stuff on freelist.
852 ; IPQIO - IPQ I/O routine (if anything actually tries using this)
854 IPQIO: JRST OPNL34 ; Say "Wrong Type Device"
857 ; IPQSTA - IPQ STATUS routine
862 ; IPQWHY - IPQ WHYINT routine
867 ; IPQRCH - IPQ RFNAME/RCHST routine
872 ; IPQRFP - IPQ RFPNTR routine
876 ; IPQIOP - IPQ IOPUSH/IOPOP routine
881 MOVEI T,77 ; IOPUSH, use 77
882 HLRZ I,(R) ; Get IPQ index
883 DPB T,[IQ$CH (I)] ; Deposit channel #
886 ; IPQFRC - IPQ FORCE routine
891 ; IPQFIN - IPQ FINISH routine
896 ; IPQUSI - Give User Interrupt on I/O channel. Not a system call,
897 ; but called by PI level routines when input arrives for
898 ; a previously empty queue.
900 ; I/ index to IP Queue
902 IPQUSI: LDB Q,[IQ$CH (I)] ; Get channel #
903 CAIN Q,77 ; If IOPUSHed, no interrupt.
906 HRRZ U,IPUQUS(I) ; Get user index
909 ; MOVSI T,(SETZ) ; Needn't force PCLSR'ing.
919 SUBTTL .CALL IPKIOT - IPQ data transfer
921 ; .CALL IPKIOT - Internet Protocol Packet Transfer.
922 ; Arg 1 is channel (must be open on IPQ:, specifies queue #)
923 ; Arg 2 is address of buffer
924 ; Arg 3 is count of words
925 ; Val 1 is count of words read into user space (if any)
926 ; Control bits specify function. If none, "read" is assumed.
928 %IPIUS==100 ; 1 = Get datagram from user space, not from a queue
929 %IPNOC==200 ; Global input no-check flag, suppresses normal check.
930 ; For User Space, "check" means verify, set cksum.
931 ; For Input Queue, "check" means verify IP header.
932 ; For SysIn Queue, "check" means verify IP hdr.
933 ; For SysOut Queue, means nothing.
934 %IPNOH==400 ; Don't Hang waiting for datagram (Queues only)
935 %IPIQK==1000 ; Keep on queue, don't remove (only for %IPOUS)
937 %IPOUS==0 ; User space
938 %IPOUT==1 ; Output to network (bypasses SysOut queue)
940 %IPORV==3 ; Re-vector to input queues past this one
944 CAIE A,IPQDN ; Must be right type device (IPQ)
945 JRST OPNL34 ; Wrong device
946 HLRZ I,(R) ; Get IP input queue index
947 CAIL I,NIPUQ ; Ensure it's valid.
948 BUG HALT,[Bad IPUQ idx in IOCHNM]
949 MOVE E,CTLBTS(U) ; Get control bits for this call
951 ANDI J,3 ; Get output type in J
953 TRNN E,%IPIUS ; Getting datagram from user?
954 JRST [ CAIN J,%IPOUS ; Giving datagram to user?
955 CAIL W,3 ; Yes, ensure at least 3 args.
956 JRST IPKIO2 ; All's OK, go check input queue.
957 JRST OPNL30] ; Will write to user, but too few args!
958 CAIGE W,3 ; Must have at least 3 args for this one.
959 JRST OPNL30 ; Too few args.
961 ; Get datagram from user.
962 ; B/ user addr of buffer
963 ; C/ # of 32-bit words in buffer
964 TRZ E,%IPIQK ; Flush "keep" bit since won't be on any list!
965 CAIL C,5 ; Must have at least 5 words for IP
966 CAIL C,%IMXLN ; Must be less or eq to maximum datagram size
967 JRST OPNL33 ; Too big, say meaningless args.
968 CAIN J,%IPOUS ; Outputting back to self?
969 JRST POPJ1 ; Yeah, just turn into a NOP.
970 CALL PKTGF ; Get a free packet buffer (hangs until got it)
971 PUSHJ P,LOSSET ; Must put back on freelist if we PCLSR on BLT fault
972 PKTPCL ; Standard routine expects ptr in A
973 TRCPKT A,"IPKIOT Alloc"
977 ADDI D,-1(B) ; Find last address copying into
978 XCTR XBR,[BLT B,(D)] ; Gobble up user's buffer! May fault.
979 PUSHJ P,LSWDEL ; Made it through, can flush PCLSR protection
980 HRLM C,PK.BUF(A) ; Set # words used in buffer
981 MOVE B,PK.BUF(A) ; Find addr of start of buffer
982 HRLZM B,PK.IP(A) ; and set start of IP header.
983 LDB D,[IP$IHL (B)] ; Find claimed length of IP header
984 ADDI D,(B) ; Get addr of start of IP data
985 HRLZM D,PK.TCP(A) ; Set that too.
986 JRST IPKIO3 ; Now decide about checking datagram!
988 ; Get datagram from input queue.
989 IPKIO2: CONO PI,NETOFF
990 SKIPN A,IPUQHD(I) ; Anything in the queue?
992 TRNE E,%IPNOH ; No, see if ok to hang.
993 JRST POPJ1 ; Don't hang, win-return zero wds-read in A.
994 SKIPN IPUQHD(I) ; Hang, here we go.
997 TRNN A,-1 ; Make sure something was there!
999 CAIN I,1 ; Is this SysOut queue?
1000 JRST [ MOVE T,PK.FLG(A) ; Yes, get flags
1001 TLNN T,(%PKFLS) ; Actually wants to flush now?
1002 JRST .+1 ; No, let's go with it.
1004 CALL PKQGF(PK.IP) ; Remove from queue
1007 CALL PKTRT ; Flush it.
1010 MOVE T,PK.BUF(A) ; Verify that something exists
1011 TLNE T,-1 ; in both <# wds> field
1012 TRNN T,-1 ; and <buff addr> field.
1013 BUG HALT,[IPQ: Null dgm found on queue]
1014 HLRZ T,PK.IP(A) ; Should also be an IP pointer
1016 BUG HALT,[IPQ: IP-less dgm on queue]
1018 ; Now have pointer in A to a datagram. It is still linked
1019 ; on the input queue, unless %IPIUS is set.
1020 IPKIO3: TRNE E,%IPNOC ; Should we check the contents at all?
1021 JRST IPKIO5 ; Nope, just go straight ahead.
1022 JFCL ; Here we should verify/set checksum, but...
1024 ; Now figure out where datagram wants to go!
1025 IPKIO5: JRST @.+1(J) ; Only have 4 possibilities so far.
1026 IQIO70 ; %IPOUS Output to user
1027 IQIO60 ; %IPOUT Output to network
1028 IQIO55 ; %IPOFL Flush it
1029 IQIO80 ; %IPORV Re-vector through input queues
1031 ; %IPOFL Flush datagram.
1032 IQIO55: TRNN E,%IPIUS ; Is it from input queue list?
1033 CALL IPIQGF ; Yes, take it off input queue list
1034 CALL PKTRT ; Now can return to packet freelist!
1035 JRST POPJ1 ; Win return.
1037 ; %IPOUT Output datagram to network.
1038 IQIO60: TRNN E,%IPIUS ; Is it still on an input list?
1039 CALL IPIQGF ; Yes, take it off input queue list
1040 CAILE I,1 ; If not from Sys I/O queue,
1041 JRST [ CALL IPKSNQ ; Possibly send onto SysOut queue.
1043 CALL IPKSNI ; Dgm from Sys queue, never goes back to SysOut
1047 ; %IPOUS Output datagram to user (a "read" from user viewpoint)
1048 ; This is the only place where we can PCLSR on "output". Note
1049 ; that we cannot get here if datagram came from user, so the
1050 ; datagram we point to is always still on input queue, and
1051 ; we can safely PCLSR without any special backup.
1052 IQIO70: HLRZ D,PK.BUF(A) ; Find # words available
1053 JUMPLE C,OPNL33 ; Neg or zero count -> meaningless arg error
1054 CAILE C,(D) ; If asking for more wds than exist,
1055 MOVEI C,(D) ; only furnish what we've got.
1057 ADDI D,-1(C) ; Find last user word to write
1059 XCTR XBW,[BLT B,(D)] ; Shove it at him; can PCLSR here.
1060 TRNE E,%IPIQK ; Done! Should we keep datagram around?
1061 JRST IQIO75 ; Yes, don't flush it.
1062 CALL IPIQGF ; Take datagram off the input queue.
1063 CALL PKTRT ; Return entry/buffer to freelist.
1064 IQIO75: MOVEI A,(C) ; Return count as 1st val!
1067 ; Must re-vector through stuff...
1068 ; Note that it is illegal to re-vector a datagram from the SysOut
1069 ; queue, because it still shares pointers and stuff with
1070 ; (for example) TCP retransmit queues. Later, could add code to
1071 ; get another packet buffer and copy it over, but this is better
1072 ; done at the device driver level probably.
1073 IQIO80: TRNN E,%IPIUS ; Came from user?
1074 JRST [ CAIN I,1 ; No, from a queue; is it the SysOut queue?
1075 JRST OPNL2 ; Yes, illegal. Say "Wrong direction".
1076 CALL IPIQGF ; No, is OK. Take it off input list.
1079 HLRZ W,PK.IP(R) ; Get pointer to IP header
1080 HLRZ H,PK.TCP(R) ; and to IP data.
1083 CALL IPRDGV ; Go vector and process the datagram.
1087 ; Auxiliary, clobbers D to do checking.
1089 MOVEI Q,IPUQHD(I) ; Is from list, must take it off.
1090 CALL PKQGF(PK.IP) ; Remove from IP queue list
1092 BUG ; Something added in meantime???
1095 SUBTTL IP TCP Interface Routines
1097 ; IPMTU - Size of largest datagram we want to send to a given destination
1098 ; A/ Destination address
1101 SUBN27==:<HOSTN 18,27,0,0> ; Damn macro generates an error inside literal
1102 NW%CHW==:<HOSTN 128,31,0,0> ; Old CHAOS-wrapping scheme, probably unused
1106 PUSH P,A ; Save address for a bit
1107 MOVEI T,576. ; Default value
1108 GETNET A ; Network part only
1109 CAMN A,[NW%ARP] ; Arpanet?
1110 MOVEI T,%IMMTU ; MTU of IMP
1112 MOVEI T,%IMMTU ; AI net. We know we have a good path
1113 CAMN A,[NW%CHW] ; Wrapped chaos packets
1114 MOVEI T,488. ; Smaller MTU
1115 CAME A,[NW%LCS] ; Net 18 is ugly, must check subnets
1117 MOVE A,(P) ; Get full address back
1118 TRZ A,177777 ; Mask off all but 18.<subnet>
1119 CAMN A,[SUBN27] ; Subnet 27 is fed by chaos-wrapping.
1120 SKIPA T,[488.-40.] ; Giving it a very small MTU
1121 MOVEI T,%IMMTU ; Good path to all others
1124 IFN IPUNCP, MOVEI T,488.-40. ; This should be small enough...
1127 IF1,.ERR Amazing MIT-Specific crocks near IPMTU...
1129 ; IPBSLA - Best Local Address for a given destination
1130 ; A/ Destination IP Address
1131 ; Return A/ Local Address to use
1137 SKIPA A,[IMPUS4] ; Local Address on wrapped-chaos net
1138 MOVE A,[IMPUS3] ; Default local host address to IMP
1140 IFN IPUNCP, MOVE A,[IMPUS4]
1143 ; IPLCLH - Skip return if address in A is one of us.
1144 ; Called with JSP T,IPLCLH
1147 IFE IPUNCP, CAME A,[IMPUS3]
1152 ; IPKSND - Invoked by TCP to send off a segment.
1153 ; Fills in the IP header fields, checksums, and puts on output queue.
1154 ; R, W, H set up pointing to segment
1155 ; The out-of-TCP information is contained in the "IP header" that
1157 ; IP$SRC - Source addr
1158 ; IP$DST - Dest Addr
1159 ; IP$TOL - Length of segment in bytes (must add IP header length)
1160 ; Clobbers A,B,C,D,E,Q,T
1162 IPIDCT: 0 ; IP identification #, incremented for each datagram
1165 IPKHDR: MOVE A,IP$VER(W) ; Get first word
1166 ADDI A,<5*4>_4 ; Add length of IP header (5 wds for now)
1167 HRLI A,212000 ; Fill in Ver, IHL, TOS
1168 MOVEM A,IP$VER(W) ; Set 1st wd
1169 ADDI A,3_4 ; Now, to get # of words, round up
1170 LSH A,-<4+2> ; (note flush 4 spare bits then divide by 4)
1171 ANDI A,37777 ; 14 bit field now
1172 HRLM A,PK.BUF(R) ; Store # of words, for device driver.
1173 MOVSI A,170030 ; TTL and PTC (TCP)
1174 MOVEM A,IP$TTL(W) ; Set 3rd wd
1176 IPKHD2: AOS A,IPIDCT ; Get new ID number
1177 LSH A,<16.+4> ; Left justify it
1178 MOVEM A,IP$ID(W) ; Use to set up 2nd wd (no flags/frags)
1179 CALL IPCKSM ; Get IP header checksum
1180 DPB A,[IP$CKS (W)] ; In it goes!
1183 IPKSND: TRCPKT R,"IPKSND output call"
1185 MOVEI A,(R) ; Set up PE ptr arg for following stuff.
1187 ; IPKSNQ - entry point from IPKIOT, to send a datagram.
1188 ; A/ PE ptr to datagram - PK.BUF must be set up.
1191 IPKSNQ: MOVSI T,(%PKODN) ; Clear the "output-done" flag.
1193 TRCPKT A,"IPKSNQ output call"
1194 SKIPE IPUQUS+1 ; Check - have System Output queue?
1195 JRST IPKSN5 ; Yes, put on that queue.
1196 ; No, drop into IPKSNI
1198 ; IPKSNI - Route packet to appropriate gateway and interface
1199 ; A/ PE ptr to datagram - PK.BUF must be set up.
1202 SKIPLE C,PK.BUF(A) ; Get the packet buffer from the PE
1204 BUG HALT,[IP: Null dgm being sent]
1205 LDB C,[IP$DST(C)] ; Get destination address
1207 ;; This is where to apply final gateway routing code, based on Internet address in C.
1208 GETNET T,C ; Get network # into T
1209 MOVSI Q,-NIPGW ; Search table of gateways and direct routes
1210 CAME T,IPGWTN(Q) ; Skip if network # matches
1212 JUMPL Q,IPSNI1 ; Jump if found entry in table
1213 AOS Q,IPGWPG ; No gateway known for this network, so try a
1214 CAIL Q,NIPMGW ; prime gateway and hope for an ICMP redirect!
1215 SETZB Q,IPGWPG ; Try a different prime gateway each time
1216 IPSNI1: MOVE T,TIME ; Remember that this gateway entry was used
1218 SKIPE IPGWTG(Q) ; Skip if this is a direct route
1219 MOVE C,IPGWTG(Q) ; Get gateway address
1220 MOVEM C,PK.DST(A) ; Save gateway address for interface to use
1221 CALL @IPGWTI(Q) ; Dispatch to interface
1226 IPGWPG: 0 ; Index of current prime gateway
1232 NIPMGW==<.-IPGWTN> ; Number of prime gateways
1233 IFE IPUNCP, NW%ARP ; ARPA Net
1234 HOSTN 128,31,0,0 ; MIT Chaosnet
1235 NIPPGW==<.-IPGWTN> ; Number of permanent gateways
1236 BLOCK 64. ; Extra stuff to patch in and for redirects
1239 ; Internet address of gateway servicing given net number
1242 HOSTN 10,0,0,77 ; MIT-GW
1243 HOSTN 10,3,0,6 ; MIT-AI-GW
1246 HOSTN 128,31,6,1 ; ???
1247 HOSTN 128,31,6,2 ; ???
1249 IFE IPUNCP, 0 ; Send direct to Arpanet
1250 0 ; Send direct to Chaosnet
1251 IFN .-IPGWTG-NIPPGW, .ERR Permanent gateway table at IPGWTG wrong size
1263 IFE IPUNCP, IPKSNA ; direct to Arpanet
1264 IPKSNC ; direct to Chaosnet
1265 IFN .-IPGWTI-NIPPGW, .ERR Permanent gateway table at IPGWTI wrong size
1266 REPEAT NIPGW-NIPPGW,IPKSNA
1268 IPGWTM: BLOCK NIPGW ; TIME entry last used
1274 ; Queue packet for Arpanet interface
1275 IPKSNA: MOVEI Q,IPOUTQ ; Otherwise use direct IP output queue.
1276 MOVE B,(Q) ; Save previous contents of queue header
1277 CALL PKQPL(PK.IP) ; Put on IP output queue
1278 CAIE B,0 ; Kick off IP output if necessary.
1279 RET ; Not necessary, queue was not empty
1280 IPOGO: CALRET IMPIOS ; Just means kicking IMP for now.
1284 ; Queue packet for Chaosnet interface
1286 ; PK.DST(A) has the Internet address to send to, 128.31.subnet.host
1287 ; The low 16 bits are Chaosnet address to send an UNC to
1292 MOVE J,A ;J has address of PE
1293 MOVE H,PK.BUF(A) ;H has address of IP header
1294 MOVEI E,0 ;E has number of bytes sent so far
1295 IPKSC1: CALL CHABGI ;Get a Chaosnet buffer in A
1296 JRST IPKSC9 ;Give up if can't get one
1297 MOVSI T,-%CPKDT ;Zero out the Chaosnet header
1307 MOVEI T,8_8 ;DOD Internet #x0800
1308 DPB T,[$CPKAN(A)] ;Protocol number
1309 AOS CHNIPO ;Meter Internet packets out to Chaosnet
1310 LDB Q,[IP$IHL(H)] ;Internet header length in words
1311 MOVE T,Q ;Save header length for later
1312 MOVSI B,(H) ;BLT IP header into Chaos packet
1315 BLT B,-1(Q) ;Q saves address of first data word
1316 LDB B,[IP$TOL(H)] ;Total length in octets including header
1317 SUB B,E ;Number of bytes remaining to be sent
1318 MOVEI C,IPKSC9 ;Continuation if no more fragments needed
1319 CAIG B,%CPMXC ;Skip if need to fragment
1321 MOVEI B,%CPMXC/4 ;Compute number of 32-bit data words in fragment
1323 TRZ B,1 ;Round down to even multiple of 8 octets
1325 LSH B,2 ;Number of bytes in this fragment including header
1326 MOVEI W,IP%FMF ;Set more-fragments flag
1327 IORM W,IP$FLG+%CPKDT(A)
1328 MOVEI C,IPKSC1 ;Continuation sends another fragment
1329 IPKSC2: DPB B,[IP$TOL+%CPKDT(A)] ;Total length of this fragment
1331 PUSH P,C ;Save continuation address
1332 MOVE W,E ;Get fragment offset
1333 LSH W,-3 ;8-octet units
1334 LSH T,2 ;Number of bytes in header
1335 SUB B,T ;Number of data bytes
1336 LDB C,[IP$FRG+%CPKDT(A)];Set fragment offset
1338 DPB C,[IP$FRG+%CPKDT(A)]
1339 ADD T,E ;Byte offset of start of data to send
1340 LSH T,-2 ;Word offset
1341 ADD T,H ;Word address
1342 HRL Q,T ;BLT pointer to copy data
1344 LSH T,-2 ;Number of words to copy
1345 ADDI T,-1(Q) ;Address of last word to store
1346 BLT Q,(T) ;Copy the data
1347 ADD E,B ;Offset for next fragment
1349 CALL IPCKSM ;Compute header checksum
1350 DPB A,[IP$CKS (W)] ;Store header checksum
1351 MOVEI A,-%CPKDT(W) ;Restore address of chaos packet
1352 SETOM -2(A) ;Not on any packet lists
1353 PUSH P,J ;Save registers clobbered by CHAXMT
1357 CALL CHAXMT ;Launch packet into Chaosnet
1362 POPJ P, ;Take continuation
1364 IPKSC9: MOVE A,J ; The PE
1365 CALL IPIODN ; Say we're done transmitting this packet,
1366 POP P,W ; although it's still in Chaos NCP somewhere
1372 IPKSN5: MOVEI Q,IPUQHD+1 ; Put on System Output queue
1373 MOVE B,(Q) ; Save prev contents of header
1375 CAIE B, ; If stuff already there,
1376 RET ; Just return, else
1377 PUSH P,I ; Nothing there before, give user interrupt.
1378 MOVEI I,1 ; On IPQ SysOut queue.
1383 ; IPCKSM - Computes checksum for IP header.
1384 ; W/ points to IP header.
1386 ; Returns A/ checksum
1388 IFNDEF JCRY0,JCRY0==:<JFCL 4,> ; Jump on Carry from bit 0 (and clear flag)
1391 LDB C,[IP$IHL (W)] ; Get IP header length
1392 MOVE B,IP$CKS(W) ; Get 3rd word
1393 ANDCM B,[IP%CKS] ; Mask out the checksum field
1394 JFCL 17,.+1 ; Clear flags
1395 ADD B,IP$VER(W) ; Add 1st wd
1397 ADD B,IP$ID(W) ; Add 2nd
1399 ADD B,IP$SRC(W) ; Add 4th
1401 ADD B,IP$DST(W) ; Add 5th
1404 JRST IPCKS4 ; Longer than 5 words, must hack options.
1405 IPCKS2: LSHC A,16. ; Get high 2 bytes (plus carries) in A
1406 LSH B,-<16.+4> ; Get low 2 bytes in B
1407 IPCKS3: ADDI A,(B) ; Get total sum
1408 CAILE A,177777 ; Fits?
1409 JRST [ LDB B,[202400,,A] ; No, must get overflow bits
1410 ANDI A,177777 ; then clear them
1411 JRST IPCKS3] ; and add in at low end.
1412 ANDCAI A,177777 ; Return ones complement
1415 IPCKS4: SUBI C,5 ; C has a 4 bit value.
1416 MOVN C,C ; Get neg of # words left
1419 RET ; Something is wrong, so just return bad val.
1422 ADD B,5+<10.-.RPCNT>(W)
1425 IPCKS5: JRST IPCKS2 ; Options all added, now go fold sum.
1427 IFN 0,[ ; Old version
1429 HRLI C,442000 ; Gobble 16-bit bytes
1430 ILDB A,C ; wd 0 byte 1
1432 ADDI A,(B) ; Add 2nd byte of 1st wd
1433 ILDB B,C ? ADDI A,(B) ? ILDB B,C ? ADDI A,(B) ; 1 ID,frag
1434 ILDB B,C ? ADDI A,(B) ? IBP C ; 2 Skip chksum field
1435 ILDB B,C ? ADDI A,(B) ? ILDB B,C ? ADDI A,(B) ; 3 source addr
1436 ILDB B,C ? ADDI A,(B) ? ILDB B,C ? ADDI A,(B) ; 4 dest addr
1437 IPCKS8: CAIG A,177777
1439 LDB B,[202400,,A] ; Get any overflow
1443 IPCKS9: ANDCAI A,177777