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 3 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
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
513 ; IPGIOQ - Get IP Output Queue entry for IMP
514 ; Returns .+1 if nothing in queue
516 ; A/ Pointer to datagram structure
517 ; B/ Output BLKO pointer to buffer, -<# wds>,,<addr-1>
518 ; C/ Arpanet host address
519 ; H/ host-table index
522 IPGOQ1: METER("IP: ODs flushed")
523 CALL PKTRT ; Internal looping point
525 IPGIOQ: MOVEI Q,IPOUTQ
526 CALL PKQGF(PK.IP) ; Get first thing off IP output list
527 JUMPE A,IPGOQ9 ; Jump and return if nothing there.
528 MOVE T,PK.FLG(A) ; Get packet flags
529 TLNE T,(%PKFLS) ; Should we flush this one?
530 JRST IPGOQ1 ; Yes, down the drain it goes.
532 IORM T,PK.FLG(A) ; Say packet locked at PI level.
536 BUG HALT,[IP: Null dgm on queue]
538 ;KS doesn't care, save 2 usec..
539 MOVN B,C ; Straightforward way to put together AOBJN ptr.
540 HRRI B,-1(C) ; Now have BLKO
542 MOVE C,PK.DST(A) ; Get destination address
545 ; Ask interface if it wants this particular datagram right now.
548 JRST IPGOQ5 ; Can't send, requeue
550 ; Got valid dgm, must ensure that block queue is merged back
551 ; onto beginning of output queue.
552 IPGOQ6: METER("IP: ODs sent")
553 SKIPN D,IPOBLQ ; See if anything was blocked
554 JRST POPJ1 ; Nope, just take win return.
555 SETZM IPOBLQ ; Yes, block queue exists!
556 SKIPN T,IPOUTQ ; Get ptr to 1st node on output queue
557 JRST [ MOVEM D,IPOUTQ ; If nothing was left on output queue,
558 JRST POPJ1] ; can simply move the list.
559 HLRZ E,D ; Get ptr to last node on blocked queue
560 HRRM T,PK.IP(E) ; Point end of blocked Q to start of output Q
561 HRRM D,IPOUTQ ; and point start of output Q to start of block Q
562 JRST POPJ1 ; and return with nice winning dgm.
564 ; Come here to handle blockage of IP datagram.
565 IPGOQ5: MOVSI T,(%PKPIL)
566 ANDCAM T,PK.FLG(A) ; Say not locked at PI after all
568 CALL PKQPL(PK.IP) ; Put blocked dgm onto block queue
569 JRST IPGIOQ ; Now go try next dgm.
571 ; Output queue empty, just shift block queue back.
572 IPGOQ9: SKIPN A,IPOBLQ ; See if anything was put on block queue
573 RET ; Nope, all's clear.
574 MOVEM A,IPOUTQ ; Aha, move it to standard output queue
575 SETZM IPOBLQ ; and clear the block-queue ptr.
576 RET ; Nothing to send from IP at moment.
580 ; IPIODN - Output of IP datagram complete, wrap up.
581 ; Called by all device drivers.
582 ; A/ pointer to datagram structure
586 IPIODN: TRCPKT A,"IPIODN Packet output complete"
587 MOVE T,PK.FLG(A) ; Get flags for packet
588 TLO T,(%PKODN) ; Say output done,
589 TLZ T,(%PKPIL) ; and unlock PI level output flag.
590 MOVEM T,PK.FLG(A) ; Store flags back.
591 CALRET PKTRT ; Return to freelist if not otherwise queued
594 SUBTTL ICMP - Internet Control Message Protocol
596 ; ICMP called at NET interrupt level to process just-received ICMP
601 ; First compute and verify checksum for ICMP data.
603 ; Then dispatch on type for processing.
604 LDB E,[IP$SRC (W)] ; Load up source addr (commonly needed)
605 LDB A,[IC$TYP (H)] ; Get ICMP type field
608 AOS ICMPCT(A) ; Bump count of types
609 JRST @ICMPTB(A) ; Dispatch on type
612 ICMP19: BUG INFO,[ICMP: Bad type ],DEC,A,[from ],OCT,E
617 ICMPTB: ICMP90 ; 0 Echo Reply (ignored)
620 ICMP90 ; 3 Destination Unreachable (ignored)
621 ICMP90 ; 4 Source Quench (ignored)
628 ICMP90 ; 11 Time Exceeded (ignored)
629 ICMPP ; 12 Parameter Problem
630 ICMP90 ; 13 TimeStamp (ignored)
631 ICMP90 ; 14 TimeStamp Reply (ignored)
632 ICMP90 ; 15 Information Request (ignored)
633 ICMP90 ; 16 Information Reply (ignored)
636 IPMICM: 0 ; # of ICMP datagrams
637 ICMPCT: BLOCK NICMPT ; # of ICMP datagrams, by type
642 ICMEK: MOVEI A,0 ; Set type to Echo Reply
644 LDB A,[IC$CKS (H)] ; Fix checksum for change of 8 to 0
649 MOVE A,IP$SRC(W) ; Exchange source and destination
652 MOVEI B,60. ; Reset time to live
653 JRST ICMEK1 ; Go send packet
655 ; Type 12 - Parameter Problem.
657 ICMPP: LDB B,[IC$COD (H)] ; Get code field
659 BUG INFO,[ICMP: Param err, code ],OCT,B,[from ],OCT,E
661 ICMPP2: LDB A,[341000,,1(H)] ; Get pointer into bad IP header
663 LSH B,-2 ; Find word # error is in
664 ADDI B,IC$IPH(H) ; Make addr to word
665 BUG INFO,[ICMP: Param err, ptr ],OCT,A,[wd ],OCT,(B),[from ],OCT,E
668 ; ICMP type 5 - Redirect
670 ICMRD: MOVEI D,IC$IPH(H)
671 MOVE A,IP$SRC(D) ; Get source addr of alleged IP header
672 CAME A,[IMPUS3_4] ; Must be a datagram WE sent.
675 JRST ICMP90 ; Bah, flush. Probably should log it.
676 LDB A,[IP$DST (D)] ; Get dest addr we used
677 GETNET A ; Derive net number
678 LDB B,[IC$GWA (H)] ; Get gateway addr recommended for this net
679 MOVEI C,NIPGW-1 ; Scan backwards thru gateway table
680 SETOB T,TT ; Index of free slot, index of oldest slot
681 ICMRD2: CAMN A,IPGWTN(C)
682 JRST [ SKIPN IPGWTG(C) ; Don't change a direct-route entry!
685 CAIL C,NIPPGW ; Skip if prime gateway, not replaceable
686 JRST [ SKIPN IPGWTN(C)
687 MOVEI T,(C) ; Save index of last free slot found
690 MOVEI TT,(C) ; Save index of least recently used slot
695 ; Network not found in gateway table, must make new entry.
696 SKIPL C,T ; If there was one free,
697 JRST ICMRD3 ; go use that one.
698 MOVE C,TT ; Otherwise use least recently used entry
701 CAIGE T,60.*60.*30. ; Flushing entry less than 1 hour old?
702 BUG INFO,[ICMP: GW table full, net/gw ],OCT,IPGWTN(C),OCT,IPGWTG(C),[=>],OCT,A,OCT,B
703 ICMRD3: GETNET D,B ; Figure out which interface this gateway is on
708 JUMPL T,ICMP90 ; I can't figure out how to get to this gateway anyway
709 MOVEM A,IPGWTN(C) ; Set network number
710 MOVEM B,IPGWTG(C) ; and its corresponding gateway addr
711 MOVE T,IPGWTI(T) ; and its interface
713 MOVE T,TIME ; Pretend it was used so it
714 MOVEM T,IPGWTM(C) ; stays around for a while
717 SUBTTL IPQ Device - Internet Protocol Queues
719 ; Internet Protocol User Datagram Queue stuff, manipulated with
720 ; IPKIOT system call.
721 ; Queue 0 is special:
722 ; Must be asked for explicitly
723 ; All Input datagrams are vectored through it.
724 ; No limit on input queue length
725 ; Can put datagrams back into system for further processing
726 ; Can send datagrams (like ordinary queue actually in this respect)
727 ; Queue 1 is also special:
728 ; Must be asked for explicitly
729 ; All output datagrams are vectored through it.
730 ; No limit on queue length
731 ; Can put datagrams back onto device output queue.
733 IFNDEF NIPUQ,NIPUQ==10 ; # User queues allowed
735 IPUQUS: BLOCK NIPUQ ; <flags><channel>,,<user index>
736 IQ%CH==<77,,> ; Field for channel #
737 IQ$CH==<.BP IQ%CH,IPUQUS> ; BP to channel #
738 IPUQHD: BLOCK NIPUQ ; Input queue header
739 IPUQCT: BLOCK NIPUQ ; # datagrams on input queue,,vector args
741 IPQOSW: -1 ? 0 ; IP Queue assignment lock
744 ; IPQO - IPQ OPEN routine
745 ; Control bits currently defined are
746 %IQSYS==100 ; Set up System Queue (0 or 1)
747 %IQSOU==200 ; System Queue 1 if set, otherwise 0
748 %IQUDP==400 ; Set up random queue for UDP (port # in FN1)
750 IPQO: CALL SWTL ; Only one job at a time hacking IQ allocation.
752 SETZB E,I ; Set up convenient zeros
753 TLNE C,%IQSYS ; Asking for system queue?
754 JRST [ TLNE C,%IQSOU ; Yes, want input or output?
755 MOVEI I,1 ; Output, use queue 1
756 SKIPE IPUQUS(I) ; Skip if it's free
757 JRST OPNL23 ; Nope, say "file locked".
758 JRST IPQO2] ; Can grab it, do so!
759 MOVE I,[-<NIPUQ-2>,,2] ; Scan tables, skipping 0'th entry
760 SKIPE IPUQUS(I) ; Look for free slot
762 JUMPGE I,OPNL6 ; If none available, claim "device full"
763 TLNN C,%IQUDP ; Got it. If will use UDP vectoring,
764 JRST OPNL33 ; No, complain "meaningless args"
765 ; since nothing else understood yet.
766 TLO E,%IQUDP ; then set flag for IPUQUS.
767 HRRZM A,IPUQCT(I) ; Store FN1 as UDP port number
769 IPQO2: SETZM IPUQCT(I)
770 SETZM IPUQHD(I) ; Clear input queue
771 MOVEI A,IPQDN ; IOCHNM device index to use
772 HRLI A,(I) ; Save IQ index in LH
774 MOVEI A,-IOCHNM(R) ; Start putting together the IPUQUS entry.
775 SUBI A,(U) ; Get channel #
776 DPB A,[.BP IQ%CH,E] ; Remember it in IPUQUS word
777 HRRI E,(U) ; Put user index in RH
778 MOVEM E,IPUQUS(I) ; Store, queue is now activated!
779 ; Note this must be last thing, to avoid
781 CALRET LSWPJ1 ; Unlock switch and return!
783 ; IPQCLS - IPQ CLOSE routine
785 IPQCLS: HLRZ I,(R) ; Get IQ idx
786 CAILE I,1 ; Is it the Sys In or Out queue?
787 JRST IPQCL5 ; Nope, can handle normal case.
788 CONO PI,NETOFF ; Keep anything from being added meanwhile
789 SETZM IPUQUS(I) ; Mark queue not active, to avoid revector loops.
790 SETZM IPUQCT(I) ; Be tidy and clear other stuff too.
793 ; Close down System Output queue. This means all output
794 ; on this queue gets moved directly onto the real output
796 IPQCL1: MOVEI Q,IPUQHD(I)
797 CALL PKQGF(PK.IP) ; Get first thing queued up
798 JUMPE A,[CONO PI,NETON ; Exit if no more.
799 CALRET IPOGO] ; Ensure output fired up.
801 CALL PKQPL(PK.IP) ; Put at end of real output queue
804 ; Close down System Input queue. This means all currently
805 ; queued input gets processed immediately. Note I gets
806 ; clobbered, but isn't necessary since we know this is queue 0.
807 IPQCL3: MOVEI Q,IPUQHD ; Get header for queue 0
808 CALL PKQGF(PK.IP) ; Get A/ packet ptr
810 HLRZ B,PK.BUF(A) ; Get B/ # words in packet
811 SETZ C, ; Get C/ # wds offset to IP header
812 CALL IPRDGM ; Process and vector it.
813 JRST IPQCL3 ; Get next
816 ; Normal datagram input queue. Doesn't need NETOFF since
817 ; PI level ignores the queue entry if it's inactive. Just
818 ; need to keep another job from assigning it...
819 IPQCL5: CONO PI,CLKOFF
820 SETZM IPUQUS(I) ; Clear its "active" entry word to stop queueing
821 CALL IPQRS2 ; Flush its input queue (clears IPUQHD)
826 ; IPQRST - IPQ RESET routine. Clears queue for channel.
827 ; This is pretty drastic for the System I/O queues.
829 IPQRST: HLRZ I,(R) ; Get IQ idx
830 CONO PI,NETOFF ; Prevent new dgms from arriving meanwhile.
831 CALL IPQRS2 ; Flush the queue
834 IPQRS2: MOVEI Q,IPUQHD(I)
835 CALL PKQGF(PK.IP) ; Pull off 1st thing
836 JUMPE A,CPOPJ ; Return when no more
838 CAIN I,1 ; If queue is the Sys Output queue
839 JRST [ TLNE T,(%PKFLS) ; Then do special stuff.
840 JRST IPQRS3 ; Flush only if explicitly requested
841 TLZ T,(%PKPIL) ; Otherwise clear PI-Locked bit
842 TLO T,(%PKODN) ; and claim "output done" (ha ha)
845 IPQRS3: CALL PKTRT ; Put all stuff on freelist.
848 ; IPQIO - IPQ I/O routine (if anything actually tries using this)
850 IPQIO: JRST OPNL34 ; Say "Wrong Type Device"
853 ; IPQSTA - IPQ STATUS routine
858 ; IPQWHY - IPQ WHYINT routine
863 ; IPQRCH - IPQ RFNAME/RCHST routine
868 ; IPQRFP - IPQ RFPNTR routine
872 ; IPQIOP - IPQ IOPUSH/IOPOP routine
877 MOVEI T,77 ; IOPUSH, use 77
878 HLRZ I,(R) ; Get IPQ index
879 DPB T,[IQ$CH (I)] ; Deposit channel #
882 ; IPQFRC - IPQ FORCE routine
887 ; IPQFIN - IPQ FINISH routine
892 ; IPQUSI - Give User Interrupt on I/O channel. Not a system call,
893 ; but called by PI level routines when input arrives for
894 ; a previously empty queue.
896 ; I/ index to IP Queue
898 IPQUSI: LDB Q,[IQ$CH (I)] ; Get channel #
899 CAIN Q,77 ; If IOPUSHed, no interrupt.
902 HRRZ U,IPUQUS(I) ; Get user index
905 ; MOVSI T,(SETZ) ; Needn't force PCLSR'ing.
915 SUBTTL .CALL IPKIOT - IPQ data transfer
917 ; .CALL IPKIOT - Internet Protocol Packet Transfer.
918 ; Arg 1 is channel (must be open on IPQ:, specifies queue #)
919 ; Arg 2 is address of buffer
920 ; Arg 3 is count of words
921 ; Val 1 is count of words read into user space (if any)
922 ; Control bits specify function. If none, "read" is assumed.
924 %IPIUS==100 ; 1 = Get datagram from user space, not from a queue
925 %IPNOC==200 ; Global input no-check flag, suppresses normal check.
926 ; For User Space, "check" means verify, set cksum.
927 ; For Input Queue, "check" means verify IP header.
928 ; For SysIn Queue, "check" means verify IP hdr.
929 ; For SysOut Queue, means nothing.
930 %IPNOH==400 ; Don't Hang waiting for datagram (Queues only)
931 %IPIQK==1000 ; Keep on queue, don't remove (only for %IPOUS)
933 %IPOUS==0 ; User space
934 %IPOUT==1 ; Output to network (bypasses SysOut queue)
936 %IPORV==3 ; Re-vector to input queues past this one
940 CAIE A,IPQDN ; Must be right type device (IPQ)
941 JRST OPNL34 ; Wrong device
942 HLRZ I,(R) ; Get IP input queue index
943 CAIL I,NIPUQ ; Ensure it's valid.
944 BUG HALT,[Bad IPUQ idx in IOCHNM]
945 MOVE E,CTLBTS(U) ; Get control bits for this call
947 ANDI J,3 ; Get output type in J
949 TRNN E,%IPIUS ; Getting datagram from user?
950 JRST [ CAIN J,%IPOUS ; Giving datagram to user?
951 CAIL W,3 ; Yes, ensure at least 3 args.
952 JRST IPKIO2 ; All's OK, go check input queue.
953 JRST OPNL30] ; Will write to user, but too few args!
954 CAIGE W,3 ; Must have at least 3 args for this one.
955 JRST OPNL30 ; Too few args.
957 ; Get datagram from user.
958 ; B/ user addr of buffer
959 ; C/ # of 32-bit words in buffer
960 TRZ E,%IPIQK ; Flush "keep" bit since won't be on any list!
961 CAIL C,5 ; Must have at least 5 words for IP
962 CAIL C,%IMXLN ; Must be less or eq to maximum datagram size
963 JRST OPNL33 ; Too big, say meaningless args.
964 CAIN J,%IPOUS ; Outputting back to self?
965 JRST POPJ1 ; Yeah, just turn into a NOP.
966 CALL PKTGF ; Get a free packet buffer (hangs until got it)
967 PUSHJ P,LOSSET ; Must put back on freelist if we PCLSR on BLT fault
968 PKTPCL ; Standard routine expects ptr in A
969 TRCPKT A,"IPKIOT Alloc"
973 ADDI D,-1(B) ; Find last address copying into
974 XCTR XBR,[BLT B,(D)] ; Gobble up user's buffer! May fault.
975 PUSHJ P,LSWDEL ; Made it through, can flush PCLSR protection
976 HRLM C,PK.BUF(A) ; Set # words used in buffer
977 MOVE B,PK.BUF(A) ; Find addr of start of buffer
978 HRLZM B,PK.IP(A) ; and set start of IP header.
979 LDB D,[IP$IHL (B)] ; Find claimed length of IP header
980 ADDI D,(B) ; Get addr of start of IP data
981 HRLZM D,PK.TCP(A) ; Set that too.
982 JRST IPKIO3 ; Now decide about checking datagram!
984 ; Get datagram from input queue.
985 IPKIO2: CONO PI,NETOFF
986 SKIPN A,IPUQHD(I) ; Anything in the queue?
988 TRNE E,%IPNOH ; No, see if ok to hang.
989 JRST POPJ1 ; Don't hang, win-return zero wds-read in A.
990 SKIPN IPUQHD(I) ; Hang, here we go.
993 TRNN A,-1 ; Make sure something was there!
995 CAIN I,1 ; Is this SysOut queue?
996 JRST [ MOVE T,PK.FLG(A) ; Yes, get flags
997 TLNN T,(%PKFLS) ; Actually wants to flush now?
998 JRST .+1 ; No, let's go with it.
1000 CALL PKQGF(PK.IP) ; Remove from queue
1003 CALL PKTRT ; Flush it.
1006 MOVE T,PK.BUF(A) ; Verify that something exists
1007 TLNE T,-1 ; in both <# wds> field
1008 TRNN T,-1 ; and <buff addr> field.
1009 BUG HALT,[IPQ: Null dgm found on queue]
1010 HLRZ T,PK.IP(A) ; Should also be an IP pointer
1012 BUG HALT,[IPQ: IP-less dgm on queue]
1014 ; Now have pointer in A to a datagram. It is still linked
1015 ; on the input queue, unless %IPIUS is set.
1016 IPKIO3: TRNE E,%IPNOC ; Should we check the contents at all?
1017 JRST IPKIO5 ; Nope, just go straight ahead.
1018 JFCL ; Here we should verify/set checksum, but...
1020 ; Now figure out where datagram wants to go!
1021 IPKIO5: JRST @.+1(J) ; Only have 4 possibilities so far.
1022 IQIO70 ; %IPOUS Output to user
1023 IQIO60 ; %IPOUT Output to network
1024 IQIO55 ; %IPOFL Flush it
1025 IQIO80 ; %IPORV Re-vector through input queues
1027 ; %IPOFL Flush datagram.
1028 IQIO55: TRNN E,%IPIUS ; Is it from input queue list?
1029 CALL IPIQGF ; Yes, take it off input queue list
1030 CALL PKTRT ; Now can return to packet freelist!
1031 JRST POPJ1 ; Win return.
1033 ; %IPOUT Output datagram to network.
1034 IQIO60: TRNN E,%IPIUS ; Is it still on an input list?
1035 CALL IPIQGF ; Yes, take it off input queue list
1036 CAILE I,1 ; If not from Sys I/O queue,
1037 JRST [ CALL IPKSNQ ; Possibly send onto SysOut queue.
1039 CALL IPKSNI ; Dgm from Sys queue, never goes back to SysOut
1043 ; %IPOUS Output datagram to user (a "read" from user viewpoint)
1044 ; This is the only place where we can PCLSR on "output". Note
1045 ; that we cannot get here if datagram came from user, so the
1046 ; datagram we point to is always still on input queue, and
1047 ; we can safely PCLSR without any special backup.
1048 IQIO70: HLRZ D,PK.BUF(A) ; Find # words available
1049 JUMPLE C,OPNL33 ; Neg or zero count -> meaningless arg error
1050 CAILE C,(D) ; If asking for more wds than exist,
1051 MOVEI C,(D) ; only furnish what we've got.
1053 ADDI D,-1(C) ; Find last user word to write
1055 XCTR XBW,[BLT B,(D)] ; Shove it at him; can PCLSR here.
1056 TRNE E,%IPIQK ; Done! Should we keep datagram around?
1057 JRST IQIO75 ; Yes, don't flush it.
1058 CALL IPIQGF ; Take datagram off the input queue.
1059 CALL PKTRT ; Return entry/buffer to freelist.
1060 IQIO75: MOVEI A,(C) ; Return count as 1st val!
1063 ; Must re-vector through stuff...
1064 ; Note that it is illegal to re-vector a datagram from the SysOut
1065 ; queue, because it still shares pointers and stuff with
1066 ; (for example) TCP retransmit queues. Later, could add code to
1067 ; get another packet buffer and copy it over, but this is better
1068 ; done at the device driver level probably.
1069 IQIO80: TRNN E,%IPIUS ; Came from user?
1070 JRST [ CAIN I,1 ; No, from a queue; is it the SysOut queue?
1071 JRST OPNL2 ; Yes, illegal. Say "Wrong direction".
1072 CALL IPIQGF ; No, is OK. Take it off input list.
1075 HLRZ W,PK.IP(R) ; Get pointer to IP header
1076 HLRZ H,PK.TCP(R) ; and to IP data.
1079 CALL IPRDGV ; Go vector and process the datagram.
1083 ; Auxiliary, clobbers D to do checking.
1085 MOVEI Q,IPUQHD(I) ; Is from list, must take it off.
1086 CALL PKQGF(PK.IP) ; Remove from IP queue list
1088 BUG ; Something added in meantime???
1091 SUBTTL IP TCP Interface Routines
1093 ; IPMTU - Size of largest datagram we want to send to a given destination
1094 ; A/ Destination address
1097 SUBN27==:<HOSTN 18,27,0,0> ; Damn macro generates an error inside literal
1098 NW%CHW==:<HOSTN 128,31,0,0> ; Old CHAOS-wrapping scheme, probably unused
1100 IPMTU: PUSH P,A ; Save address for a bit
1101 MOVEI T,576. ; Default value
1102 GETNET A ; Network part only
1103 CAMN A,[NW%ARP] ; Arpanet?
1104 MOVEI T,%IMMTU ; MTU of IMP
1106 MOVEI T,%IMMTU ; AI net. We know we have a good path
1107 CAMN A,[NW%CHW] ; Wrapped chaos packets
1108 MOVEI T,488. ; Smaller MTU
1109 CAME A,[NW%LCS] ; Net 18 is ugly, must check subnets
1111 MOVE A,(P) ; Get full address back
1112 TRZ A,177777 ; Mask off all but 18.<subnet>
1113 CAMN A,[SUBN27] ; Subnet 27 is fed by chaos-wrapping.
1114 SKIPA T,[488.-40.] ; Giving it a very small MTU
1115 MOVEI T,%IMMTU ; Good path to all others
1119 IF1,.ERR Amazing MIT-Specific crocks near IPMTU...
1121 ; IPBSLA - Best Local Address for a given destination
1122 ; A/ Destination IP Address
1123 ; Return A/ Local Address to use
1127 SKIPA A,[IMPUS4] ; Local Address on wrapped-chaos net
1128 MOVE A,[IMPUS3] ; Default local host address to IMP
1131 ; IPLCLH - Skip return if address in A is one of us.
1132 ; Called with JSP T,IPLCLH
1134 IPLCLH: CAME A,[IMPUS3]
1139 ; IPKSND - Invoked by TCP to send off a segment.
1140 ; Fills in the IP header fields, checksums, and puts on output queue.
1141 ; R, W, H set up pointing to segment
1142 ; The out-of-TCP information is contained in the "IP header" that
1144 ; IP$SRC - Source addr
1145 ; IP$DST - Dest Addr
1146 ; IP$TOL - Length of segment in bytes (must add IP header length)
1147 ; Clobbers A,B,C,D,E,Q,T
1149 IPIDCT: 0 ; IP identification #, incremented for each datagram
1152 IPKHDR: MOVE A,IP$VER(W) ; Get first word
1153 ADDI A,<5*4>_4 ; Add length of IP header (5 wds for now)
1154 HRLI A,212000 ; Fill in Ver, IHL, TOS
1155 MOVEM A,IP$VER(W) ; Set 1st wd
1156 ADDI A,3_4 ; Now, to get # of words, round up
1157 LSH A,-<4+2> ; (note flush 4 spare bits then divide by 4)
1158 ANDI A,37777 ; 14 bit field now
1159 HRLM A,PK.BUF(R) ; Store # of words, for device driver.
1160 MOVSI A,170030 ; TTL and PTC (TCP)
1161 MOVEM A,IP$TTL(W) ; Set 3rd wd
1163 IPKHD2: AOS A,IPIDCT ; Get new ID number
1164 LSH A,<16.+4> ; Left justify it
1165 MOVEM A,IP$ID(W) ; Use to set up 2nd wd (no flags/frags)
1166 CALL IPCKSM ; Get IP header checksum
1167 DPB A,[IP$CKS (W)] ; In it goes!
1170 IPKSND: TRCPKT R,"IPKSND output call"
1172 MOVEI A,(R) ; Set up PE ptr arg for following stuff.
1174 ; IPKSNQ - entry point from IPKIOT, to send a datagram.
1175 ; A/ PE ptr to datagram - PK.BUF must be set up.
1178 IPKSNQ: MOVSI T,(%PKODN) ; Clear the "output-done" flag.
1180 TRCPKT A,"IPKSNQ output call"
1181 SKIPE IPUQUS+1 ; Check - have System Output queue?
1182 JRST IPKSN5 ; Yes, put on that queue.
1183 ; No, drop into IPKSNI
1185 ; IPKSNI - Route packet to appropriate gateway and interface
1186 ; A/ PE ptr to datagram - PK.BUF must be set up.
1189 SKIPLE C,PK.BUF(A) ; Get the packet buffer from the PE
1191 BUG HALT,[IP: Null dgm being sent]
1192 LDB C,[IP$DST(C)] ; Get destination address
1194 ;; This is where to apply final gateway routing code, based on Internet address in C.
1195 GETNET T,C ; Get network # into T
1196 MOVSI Q,-NIPGW ; Search table of gateways and direct routes
1197 CAME T,IPGWTN(Q) ; Skip if network # matches
1199 JUMPL Q,IPSNI1 ; Jump if found entry in table
1200 AOS Q,IPGWPG ; No gateway known for this network, so try a
1201 CAIL Q,NIPMGW ; prime gateway and hope for an ICMP redirect!
1202 SETZB Q,IPGWPG ; Try a different prime gateway each time
1203 IPSNI1: MOVE T,TIME ; Remember that this gateway entry was used
1205 SKIPE IPGWTG(Q) ; Skip if this is a direct route
1206 MOVE C,IPGWTG(Q) ; Get gateway address
1207 MOVEM C,PK.DST(A) ; Save gateway address for interface to use
1208 CALL @IPGWTI(Q) ; Dispatch to interface
1213 IPGWPG: 0 ; Index of current prime gateway
1216 IPGWTN: HOSTN 26,0,0,0 ; MILNET (core gateway entry)
1217 HOSTN 128,9,0,0 ; ISINET (core gateway entry)
1220 HOSTN 36,0,0,0 ; Stanford
1221 HOSTN 128,2,0,0 ; CMU
1222 HOSTN 11,0,0,0 ; UCL
1223 NIPMGW==<.-IPGWTN> ; Number of prime gateways
1225 HOSTN 128,31,0,0 ; MIT Chaosnet
1226 NIPPGW==<.-IPGWTN> ; Number of permanent gateways
1227 BLOCK 64. ; Extra stuff to patch in and for redirects
1230 ; Internet address of gateway servicing given net number
1231 IPGWTG: HOSTN 10,3,0,111 ; Someplace at MITRE I believe...
1232 HOSTN 10,3,0,27 ; ISI-GATEWAY (core gateway entry)
1233 HOSTN 10,0,0,77 ; MIT-GW
1234 HOSTN 10,3,0,6 ; MIT-AI-GW
1235 HOSTN 10,1,0,11 ; STANFORD-GW
1236 HOSTN 10,2,0,14 ; CMU-GW
1237 HOSTN 10,1,0,20 ; DCEC-GATEWAY
1238 0 ; Send direct to Arpanet
1239 0 ; Send direct to Chaosnet
1240 IFN .-IPGWTG-NIPPGW, .ERR Permanent gateway table at IPGWTG wrong size
1243 IPGWTI: IPKSNA ; BBN-MILNET-GATEWAY (prime gateway entry)
1244 IPKSNA ; ISI-GATEWAY (prime gateway entry)
1247 IPKSNA ; STANFORD-GW
1249 IPKSNA ; DCEC-GATEWAY
1250 IPKSNA ; direct to Arpanet
1251 IPKSNC ; direct to Chaosnet
1252 IFN .-IPGWTI-NIPPGW, .ERR Permanent gateway table at IPGWTI wrong size
1253 REPEAT NIPGW-NIPPGW,IPKSNA
1255 IPGWTM: BLOCK NIPGW ; TIME entry last used
1259 ; Queue packet for Arpanet interface
1260 IPKSNA: MOVEI Q,IPOUTQ ; Otherwise use direct IP output queue.
1261 MOVE B,(Q) ; Save previous contents of queue header
1262 CALL PKQPL(PK.IP) ; Put on IP output queue
1263 CAIE B,0 ; Kick off IP output if necessary.
1264 RET ; Not necessary, queue was not empty
1265 IPOGO: CALRET IMPIOS ; Just means kicking IMP for now.
1267 ; Queue packet for Chaosnet interface
1269 ; PK.DST(A) has the Internet address to send to, 128.31.subnet.host
1270 ; The low 16 bits are Chaosnet address to send an UNC to
1275 MOVE J,A ;J has address of PE
1276 MOVE H,PK.BUF(A) ;H has address of IP header
1277 MOVEI E,0 ;E has number of bytes sent so far
1278 IPKSC1: CALL CHABGI ;Get a Chaosnet buffer in A
1279 JRST IPKSC9 ;Give up if can't get one
1280 MOVSI T,-%CPKDT ;Zero out the Chaosnet header
1290 MOVEI T,8_8 ;DOD Internet #x0800
1291 DPB T,[$CPKAN(A)] ;Protocol number
1292 AOS CHNIPO ;Meter Internet packets out to Chaosnet
1293 LDB Q,[IP$IHL(H)] ;Internet header length in words
1294 MOVE T,Q ;Save header length for later
1295 MOVSI B,(H) ;BLT IP header into Chaos packet
1298 BLT B,-1(Q) ;Q saves address of first data word
1299 LDB B,[IP$TOL(H)] ;Total length in octets including header
1300 SUB B,E ;Number of bytes remaining to be sent
1301 MOVEI C,IPKSC9 ;Continuation if no more fragments needed
1302 CAIG B,%CPMXC ;Skip if need to fragment
1304 MOVEI B,%CPMXC/4 ;Compute number of 32-bit data words in fragment
1306 TRZ B,1 ;Round down to even multiple of 8 octets
1308 LSH B,2 ;Number of bytes in this fragment including header
1309 MOVEI W,IP%FMF ;Set more-fragments flag
1310 IORM W,IP$FLG+%CPKDT(A)
1311 MOVEI C,IPKSC1 ;Continuation sends another fragment
1312 IPKSC2: DPB B,[IP$TOL+%CPKDT(A)] ;Total length of this fragment
1314 PUSH P,C ;Save continuation address
1315 MOVE W,E ;Get fragment offset
1316 LSH W,-3 ;8-octet units
1317 LSH T,2 ;Number of bytes in header
1318 SUB B,T ;Number of data bytes
1319 LDB C,[IP$FRG+%CPKDT(A)];Set fragment offset
1321 DPB C,[IP$FRG+%CPKDT(A)]
1322 ADD T,E ;Byte offset of start of data to send
1323 LSH T,-2 ;Word offset
1324 ADD T,H ;Word address
1325 HRL Q,T ;BLT pointer to copy data
1327 LSH T,-2 ;Number of words to copy
1328 ADDI T,-1(Q) ;Address of last word to store
1329 BLT Q,(T) ;Copy the data
1330 ADD E,B ;Offset for next fragment
1332 CALL IPCKSM ;Compute header checksum
1333 DPB A,[IP$CKS (W)] ;Store header checksum
1334 MOVEI A,-%CPKDT(W) ;Restore address of chaos packet
1335 SETOM -2(A) ;Not on any packet lists
1336 PUSH P,J ;Save registers clobbered by CHAXMT
1340 CALL CHAXMT ;Launch packet into Chaosnet
1345 POPJ P, ;Take continuation
1347 IPKSC9: MOVE A,J ; The PE
1348 CALL IPIODN ; Say we're done transmitting this packet,
1349 POP P,W ; although it's still in Chaos NCP somewhere
1355 IPKSN5: MOVEI Q,IPUQHD+1 ; Put on System Output queue
1356 MOVE B,(Q) ; Save prev contents of header
1358 CAIE B, ; If stuff already there,
1359 RET ; Just return, else
1360 PUSH P,I ; Nothing there before, give user interrupt.
1361 MOVEI I,1 ; On IPQ SysOut queue.
1366 ; IPCKSM - Computes checksum for IP header.
1367 ; W/ points to IP header.
1369 ; Returns A/ checksum
1371 IFNDEF JCRY0,JCRY0==:<JFCL 4,> ; Jump on Carry from bit 0 (and clear flag)
1374 LDB C,[IP$IHL (W)] ; Get IP header length
1375 MOVE B,IP$CKS(W) ; Get 3rd word
1376 ANDCM B,[IP%CKS] ; Mask out the checksum field
1377 JFCL 17,.+1 ; Clear flags
1378 ADD B,IP$VER(W) ; Add 1st wd
1380 ADD B,IP$ID(W) ; Add 2nd
1382 ADD B,IP$SRC(W) ; Add 4th
1384 ADD B,IP$DST(W) ; Add 5th
1387 JRST IPCKS4 ; Longer than 5 words, must hack options.
1388 IPCKS2: LSHC A,16. ; Get high 2 bytes (plus carries) in A
1389 LSH B,-<16.+4> ; Get low 2 bytes in B
1390 IPCKS3: ADDI A,(B) ; Get total sum
1391 CAILE A,177777 ; Fits?
1392 JRST [ LDB B,[202400,,A] ; No, must get overflow bits
1393 ANDI A,177777 ; then clear them
1394 JRST IPCKS3] ; and add in at low end.
1395 ANDCAI A,177777 ; Return ones complement
1398 IPCKS4: SUBI C,5 ; C has a 4 bit value.
1399 MOVN C,C ; Get neg of # words left
1402 RET ; Something is wrong, so just return bad val.
1405 ADD B,5+<10.-.RPCNT>(W)
1408 IPCKS5: JRST IPCKS2 ; Options all added, now go fold sum.
1410 IFN 0,[ ; Old version
1412 HRLI C,442000 ; Gobble 16-bit bytes
1413 ILDB A,C ; wd 0 byte 1
1415 ADDI A,(B) ; Add 2nd byte of 1st wd
1416 ILDB B,C ? ADDI A,(B) ? ILDB B,C ? ADDI A,(B) ; 1 ID,frag
1417 ILDB B,C ? ADDI A,(B) ? IBP C ; 2 Skip chksum field
1418 ILDB B,C ? ADDI A,(B) ? ILDB B,C ? ADDI A,(B) ; 3 source addr
1419 ILDB B,C ? ADDI A,(B) ? ILDB B,C ? ADDI A,(B) ; 4 dest addr
1420 IPCKS8: CAIG A,177777
1422 LDB B,[202400,,A] ; Get any overflow
1426 IPCKS9: ANDCAI A,177777