.lif z %defin .title Chaos NCP .sbttl Chaos NCP: Definitions, Macros and Code .iif z %defin, .nlist ;don't list definitions and macros if not ;defining them .if nz %defin ;only define symbols when we are supposed to defncp chs ;we have a CHAOS NCP .ntgiv < ;need these fields in a network object nt$chs:: .blkw 1 ;routine to give a chaos packet nt.chs:: .blkw 1 ;chaos address of this interface $ctrap:: .blkw 1 ;chaos table: routing address pointer $ctrav:: .blkw 1 ;chaos table: routing address value $ctrcp:: .blkw 1 ;chaos table: routing cost pointer $ctrcv:: .blkw 1 ;chaos table: routing cost value > .pkncp < ;need these fields in a packet object ..word $cpkn2,1 ;original value of nbytes (for BRD forwarding) > .sbttl -- Definitions **** .sbttl -- Macros .macro chsncp maxsbn,maxcon chcmsn==maxsbn chcncn==maxcon+ntty .endm chcnfi==0 .macro chsflt name chff'name==-1 ;set Filter Flag .irp num,\chcnfi chcfn'num==*2 ;this gets installed on the last one chcfs'num==cpkf'name ;subroutine to call to check .endm chcnfi==chcnfi+1 .endm txtint chsrvl .macro chnsrv string,routin ;define a new server append chsrvl,< .string .word routine > .endm .endc %defin .iif z %defin, .list ;start listing again .iif nz %defin, .nlist ;don't list code if only doing definitions .if z %defin ;only do code if not defining symbols .sbttl -- Code .iif z ncpchs, .error CHAOS NCP being included without support in PKTNCP ;; ;;;;;; Chaos packet opcodes ;; %CORFC==1 ;Request for connection %COOPN==2 ;Open %COCLS==3 ;Close %COFWD==4 ;Forward %COANS==5 ;Answer %COSNS==6 ;Sense Status %COSTS==7 ;Report Status %CORUT==10 ;Routing info %COLOS==11 ;Report Lossage %COLSN==12 ;Listen for RFC %COMNT==13 ;Maintenance use, ignored by normal NCPs %COEOF==14 ;End of File %COUNC==15 ;Uncontrolled user packet %COBRD==16 %COMAX==17 ;highest non-data opcode +1 %CODAT==200 ;8 bit DATA opcode (note high bit is set) %CODWD==300 ;16 bit DATA opcode ;; ;;;;;; Chaos packet definitions ;; dsect < .blkb $pktdt ;packet header up to data portion ;; flags %cpkaf==100000 ;packet has valid ack field %cpklp==040000 ;This is the last packet in on the connection $cpk:: $cpkzr:: .blkb 1 ;MBZ field $cpkop:: .blkb 1 $cpknb:: ;number of bytes %cpkfc==170000 ;forwarding count mask %cpkfi==010000 ;forwarding count increment .blkw 1 $cpkda:: ;destination address $cpkdh:: .blkb 1 ;destination host within subnet $cpkdn:: .blkb 1 ;destination subnet $cpkdi:: .blkw 1 ;destination index $cpksa:: ;source address $cpksh:: .blkb 1 ;source host within subnet $cpksn:: .blkb 1 ;source subnet $cpksi:: .blkw 1 ;source index $cpkpn:: .blkw 1 ;packet number $cpkan:: .blkw 1 ;ack number $cpkdt:: ;data starts here .blkb 488. ;max chaos packet size >,l$cpk %cpmxc==l$cpk-$cpkdt ;maximum packet size (data characters) %cpkmx==l$cpk-$cpk .pksiz $cpkdt,$cpkdt+4,l$cpk ;minimum for procotol, ;minimum desired (4 bytes for STS) ;maximum packet size expected ;; ;;;;;; Connection states ;; %CSCLS==0 ;CLOSED %CSLSN==1 ;LISTENING %CSRFC==2 ;RFC RECEIVED %CSRFS==3 ;RFC SENT %CSOPN==4 ;OPEN %CSLOS==5 ;BROKEN BY RECEIPT OF "LOS" %CSINC==6 ;BROKEN BY INCOMPLETE TRANSMISSION (NO RESPONSE TO SNS) %CSFRN==7 ;OPEN IN FOREIGN PROTOCOL MODE ;; ;;;;;; Connection structure ;; dsect < $ccsta:: .blkb 1 ;connection state $ccflg:: .blkb 1 ;flags %ccrcp==200 $ccibf:: .blkw 1 ;list of in order received packets $ccibe:: .blkw 1 ;pointer to end for rapid addition of in order packets $ccpbf:: .blkw 1 ;list of out of order packets $ccobf:: .blkw 1 ;list of transmitted packets which have not yet been ;receipted. This list retains the packets for ;retransmission. Control packets do not go on this list, ;only data packets. RFC's and OPN's DO go on this list. $ccobe:: .blkw 1 ;pointer to end for rapid addition of packets $ccnos:: .blkw 1 ;number of output slots. This is the number of packets ;which the user mmay output before the window filles and ;the user must wait. It is eaqual to the window size minus ;the number of unacknowledged packets. $ccsac:: .blkw 1 ;the number of the last packet given to the user. This is ;the number we should try to ack. $cchac:: .blkw 1 ;the number we have acked so far $ccwhs:: .blkw 1 ;window size - 3* number of packets not acked. When the ;user reads a packet, this get decremented by 3. If is ;.le.0 then we send an STS packet $ccrcp:: .blkw 1 ;the packet number we should receipt $cclpn:: .blkw 1 ;number of the last packet sent by the user to the server $cclac:: .blkw 1 ;number of the last packet ACKed by the server $ccnib:: .blkw 1 ;the number of packets in CHSIBF (redundant, but useful) $ccnpb:: .blkw 1 ;the number of packets in CHSPBF (redundant, but useful) $ccitm:: .blkw 1 ;the time (low 16 bits of system up time in 60'ths) that a ;packet was received from the network for this ;connection. Used in probing/incomplete-transmission. $cclwn:: .blkw 1 ;local window size $ccfwn:: .blkw 1 ;foreign window size $cclad:: .blkw 1 ;local address $cclid:: .blkw 1 ;local index $ccfad:: .blkw 1 ;foreign address $ccfid:: .blkw 1 ;foreign index $ccxpk:: .blkw 1 ;stream output packet $ccrpk:: .blkw 1 ;stream input packet $ccebr:: .blkw 1 ;event bits receive $ccepr:: .blkw 1 ;event pointer receive $ccebx:: .blkw 1 ;event bits xmit $ccepx:: .blkw 1 ;event pointer xmit >,l$cc ;length of a connection structure ;; ;;;;;; Variables and tables ;; .wscalar rldtim ;non zero is number of 5 second intervals ;before reload .wscalar chvuni ;uniquizing key .wvector chtcon,chcncn ;table of connections, number of connections .wscalar chvmyn ;my main chaos address .wscalar chvnup ;number of chaos interfaces that are up .wvector chtrou,chcmsn ;chaos routing address table .wvector chtcst,chcmsn ;chaos routing cost table chcbad==1023. ;highest cost ;;; network program variables .wscalar cnvipq ;network input queue .wscalar cnvipe ;pointer to end for FAST insertion ;; ;;;;;; Chaos packet reception from hardware ;; chsrcv: loop < ;easy way to setup exit handler tstb $cpkzr(r1) ;make sure low byte is zero exitl ne push $pktrs(r1) ;received size from hardware (always even) push $cpknb(r1) ;get number of bytes in packet inc (sp) ;for rounding bic #%cpkfc+1,(sp) ;forwarding count and odd bit add #$cpkdt,(sp) ;count our header and chaos header cmp (sp)+,(sp)+ exitl hi ;it is bad if chaos length bigger than packet ;it's a chaos packet, all right netmet in ;count the packet in mov $ctrcv(r5),@$ctrcp(r5) ;and routing cost mov $ctrav(r5),@$ctrap(r5) ;reset routing table entry tst $cpkda(r1) ;is it a broadcast if ne,< cmp $cpkda(r1),nt.chs(r5) ;is it for me? if ne,< add #%cpkfi,$cpknb(r1) ;up the forwarding count exitl cs ;forwarded too many times .if g chcnfi cmpb $cpkop(r1),#%corfc ;is it RFC? if eq, ;maybe filter it .endc mov #-1,$pktul(r1) ;not on a user list jcall cpkrou ;route it out to the network > > ;;it is for me for some reason mov $cpknb(r1),$cpkn2(r1) ;save it for BRDs or anybody else ;that cares bic #%cpkfc,$cpknb(r1) ;clear forwaring count clr (r1) ;clear link for safety lock 6 mov r1,@cnvipe ;link to the back of the input packet queue mov r1,cnvipe ;and make it the end unlock return ;finished > ;; packet lost for some reason netmet ot jcall cpkfre ;go free it .if g chcnfi ;;; registers: ;;; r1 packet ;;; r4 probably I/O page address ;;; r5 hardware object ;;; all others may be used freely cpkfilter: .rept chcnfi .irp num,\.rpcnt cmp r5,netobj+chcfn'num if eq, .endm .endr return .endc chcnfi .if df chffSYMBOLICS cpkfsymbolics: push r5,r4,r0 ;compare with CPRRFR mov #200$,r0 ;point at RFC table loop < mov (r0)+,r2 ;get an entry from the table exitl eq ;exit OK when finished mov $cpknb(r1),r3 ;get length bic #%cpkfc,r3 ;without the forwarding count exitl eq ;exit if nothing there mov r1,r4 ;create pointer to contact name... add #$cpkdt,r4 ;...point at start of RFC loop < tstb (r2) if ne,< ;still chars there movb (r4)+,r5 ;get character from packet bic #40,r5 ;pseudo uppercasify cmpb r5,(r2)+ ;match?? exitl ne ;nope dec r3 ;one less character from packet bmi 50$ ;no match if nothing left in packet rptl > tst r3 ;are there any more characters beq 100$ ;nope, contact name matches cmpb (r4)+,#<' > ;is it a space?? beq 100$ ;also match > 50$: rptl > pop r0,r4,r5 return 100$: clr $cpknb(r1) mov (pc)+,r2 .string call cpkaz1 movb #%cocls,$cpkop(r1) call cpkrvs pop r0,r4,r5 return updash==<'->&<-1-40> ;pseudo uppercasified dash 200$: .litrl <.asciz /BAND//TRANSFER/> .litrl <.asciz /EVAL/> .litrl <.asciz /MINI/> .litrl <.asciz /REMOTE//DISK/> .litrl <.asciz /SPY/> .litrl <.asciz /DIAL/> .litrl <.asciz /PRIME/> .litrl <.asciz /SCICARDS/ .even> .litrl <.asciz /FOOBAR/> .litrl <.asciz /FOO//BAR/ .even> 0 .endc df chffSYMBOLICS ;; ;;;;;; Packet routines ;; cpkall: cmp r1,#l$cpk if hi,< clr r1 return > call pktall if eq, bis #%pkt08,$pktfl(r1) ;declare the packet safe for 8 bit clrb $cpkzr(r1) ;zero the MBZ field clr $cpknb(r1) ;no data in packet yet call cpkptx ;setup xmit pointer clz ;success -- not zero return cpkfre==pktfre ;free a packet is standard cpkfrl==pktfrl ;free a list is standard cpkgro: pktsiz r1,r2 inc r2 cpkchk: call pktchk .word l$cpk ;max size of packet for this protocol return ;unsuccessful return ;old packet has room ;new packet call cpkptx ;setup xmit pointers clz ;not ZERO return cpkptx: pktsiz r1,$pktbc(r1) ;total size of packet for byte count cmp $pktbc(r1),#l$cpk ;range check it for protocol if hi, push #$cpkdt add $cpknb(r1),(sp) ;offset to next byte sub (sp),$pktbc(r1) ;now the real byte count add r1,(sp) ;pointer to first byte pop $pktbp(r1) ;set byte pointer return cpkptr: mov $cpknb(r1),$pktbc(r1) ;number of bytes in packet mov r1,$pktbp(r1) ;point read address at packet add #$cpkdt,$pktbp(r1) ;now pointing to chaos data return chtswp: .byte 00,-1,00,-1 ;nul RFC OPN CLS .byte -1,-1,00,00 ;FWD ANS SNS STS .byte 00,-1,-1,00 ;RUT LOS LSN MNT .byte 00,-1,-1 ;EOF UNC BRD .even loop < cpks08: push #%pkt16,#%pkt08 exitl cpks16: push #%pkt08,#%pkt16 > bit (sp),$pktfl(r1) ;is it already safe? if ne,< pop *,* return > bis (sp)+,$pktfl(r1) ;it will be when finished bic (sp),$pktfl(r1) ;make the other one unsafe for now push r0 movb $cpkop(r1),r0 ;get opcode if pl,< ;non-data cmp r0,#%comax if lo,< tstb chtswp(r0) bne cpkswp > > else < bit #100,r0 beq cpkswp > pop r0 bis (sp)+,$pktfl(r1) ;safe for both 8 and 16 bit return ;;; swap the packet, r0 on stack and flag on stack cpkswp: mov $cpknb(r1),r0 ;packet bytes bic #%cpkfc,r0 ;without forwarding count inc r0 ;round up for word count asr r0 ;word count if ne,< ;if something there push r1 ;save packet pointer add #$cpkdt,r1 ;point to data portion loop < swab (r1)+ ;swap the data sorl r0 ;loop > pop r1 > pop r0,* return ;; ;;;;;; Connection routines ;; ;;; Init the connection (de)allocatro ccnini: clr chvuni mov #chtcon,r5 ;where to start clearing mov #chcncn,r4 ;for as many connections as there are loop < clr (r5)+ sorl r4 > return ;;; Free the connection in r0 ccnfre: call ccnrst ;completely reset the connection to free packets push r0 ;put connection on stack (for FSMFRE) movb $cclid(r0),r0 ;get the low byte of the index asl r0 ;make it index into CHTCON cmp chtcon(r0),(sp) ;am I the one registered there? if eq, ;if so, I go away else ;if not, out of phase (bad) call fsmfre ;wave...bye...bye clr r0 ;no more connection return ccnrst: ;completely reset a connection push r5,r1 mov #%cscls,$ccsta(r0) ;set state to closed clr $ccfid(r0) ;no foreign index mov $ccibf(r0),r1 ;get ready to free the input list of packets if ne,< clr $ccibf(r0) call cpkfrl ;free the list > mov r0,$ccibe(r0) ;reset insertion pointer... add #$ccibf,$ccibe(r0) ;... mov #-1,$ccnib(r0) ;none there mov $ccrpk(r0),r1 ;stream input packet if ne,< clr $ccrpk(r0) call cpkfre > mov #junk,$ccepr(r0) ;event pointer receive at junk mov #junk,$ccepx(r0) ;event pointer xmit at junk loop < ;fall through, but don't double push regs exitl ccnrs2: ;reset the rest (or most) of the connection push r5,r1 > mov time,$ccitm(r0) ;declare the connection active tst $ccnib(r0) if eq, ;if no packets, pretend -1 mov $ccpbf(r0),r1 ;get the out of order list if ne,< clr $ccpbf(r0) call cpkfrl ;free the list > clr $ccnpb(r0) mov $ccxpk(r0),r1 ;stream output packet if ne,< clr $ccxpk(r0) call cpkfre > mov $ccobf(r0),r5 ;get the list of unreceipted packets loop < mov r5,r1 ;get the top of the list exitl eq mov (r1),r5 ;cdr down mov #+1,$pktul(r1) ;not in need of retransmit cmp $pktxl(r1),#-1 ;test the transmit link if eq, ;and free it rptl ;keep going down the list > clr $ccobf(r0) ;no output packets mov #-1,$ccnos(r0) ;no output slots (non-zero so people wake up) bis $ccebx(r0),@$ccepx(r0) ;also hack event bits bis $ccebr(r0),@$ccepr(r0) ;receive side also mov r0,$ccobe(r0) ;setup insertion pointer... add #$ccobf,$ccobe(r0) ;... clr $ccwhs(r0) ;not very important, but might as well pop r1,r5 ;restore regs return ;;; Allocate a connection. Put new connection in r0 (or zero if failed) and ;;; set the Z bit accordingly ccnall: push r5,r4 ;save regs clr r0 ;no connection yet mov #chtcon,r5 ;get pointer to table mov #chcncn,r4 ;number of possible connections loop < tst (r5)+ ;test the connection table slot if ne,< ;if none sorl r4 ;and loop around exitl ;else we didn't find a free connection > ;we have found a free slot to put a connection push #l$cc ;length of a connection structure call fsmall ;allocate the structure call fsmclr ;clear the structure on the stack pop r0 ;get a handle on it exitl eq ;get out if nothing mov r0,-(r5) ;place it in the connection table slot call ccnrst ;reset the connection completely mov r5,r4 ;get the address in CHTCON sub #chtcon,r4 ;make it an index asr r4 ;make it a number movb r4,$cclid(r0) ;set the index as the low part of the ;connection incb chvuni ;up the uniquizer if eq, ;NEVER allow it to be zero movb chvuni,$cclid+1(r0) ;the rest of the source index mov chvmyn,$cclad(r0) ;set my local address > pop r4,r5 ;restore regs tst r0 ;set condition flags return ;and return ;; ;;;;;; Packets coming in ;; ;;; Input packet routines. Z bit set if no packet. ;;; it is the responsibility of the calling task to deschedule itself by ;;; calling cpkwti if it wants to go blocked on packet input. cpkpki: mov $ccibf(r0),r1 if eq,< loop < cmpb $ccsta(r0),#%csopn ;either OPEN exitl eq ;return with Z and no Carry cmpb $ccsta(r0),#%csrfs ;or RFC-Sent exitl eq cmpb $ccsta(r0),#%cslsn ;or Listening exitl eq cmpb $ccsta(r0),#%csfrn ;of FOREIGN is acceptable exitl eq ;return with Z and no carry sec!sez ;make sure the carry and Z are set > return > ;from comparison dec $ccnib(r0) ;one less packet on the input list bit #%cpklp,$pktfl(r1) ;last packet? if ne, ;force count to -1 mov (r1),$ccibf(r0) ;unlink it from the list if eq,< mov #$ccibf,$ccibe(r0) add r0,$ccibe(r0) ;reset the end pointer > clr (r1) ;clear the link field bit #%cpkaf,$pktfl(r1) ;should this packet be acked? if ne,< mov $cpkpn(r1),$ccsac(r0) ;set the SHOULD ACK for connection sub #3,$ccwhs(r0) ;another packet came in if le,< push r1 mov #$cpkdt+4,r1 call cpkall if ne,< movb #%costs,$cpkop(r1) call cpkpko > pop r1 > > call cpkptr ;setup receive pointer and count clz!clc ;clear zero flag and carry bit return .sbttl CPK... Packet receive utility routines ;;; Find the connection to go with the packet in r1. Returns connection in r0 ;;; or zero in r0 if there is none. Understands about a connection in state ;;; %CSRFS cpkfnd: movb $cpkdi(r1),r0 ;get the connection index bic #mask8,r0 ;losing sign extension cmp r0,#chcncn ;is it within range if lt,< asl r0 ;word index mov chtcon(r0),r0 ;try and get the connection if ne,< cmp $cpkdi(r1),$cclid(r0) ;does local index match if eq,< cmp $cpksa(r1),$ccfad(r0) ;does foreign address match if eq,< ;we have found a connection cmp $cpksi(r1),$ccfid(r0) ;is dest idx OK if ne,< ;oops, perhaps %CSRFC cmpb $ccsta(r0),#%csrfs ;in RFC-Sent? bne 10$ ;nope tst $ccfid(r0) ;foreign idx better be zero bne 10$ ;nope again > mov time,$ccitm(r0) ;connection active as of now tst r0 ;set condition flags return >>>> 10$: clr r0 ;no connection return ;return zero condition flag ;;; Give a packet to the user, setting ack fields and adjusting window ;;; boundaries as needed. cpkgiv: push r5,r4 clr (r1) ;clear the link for safety bit #%cpkaf,$pktfl(r1) ;is the ack field important? if eq,< ;no ack field -- jam it on the front mov r1,@$ccibe(r0) ;link it through the end mov r1,$ccibe(r0) ;and make it the end loop ;at least one packet on the list bis $ccebr(r0),@$ccepr(r0) ;set event bits > else < ;packet number and ack field are important call cprack ;go process the ack field mov $ccsac(r0),r5 ;get the bottom of the window inc r5 ;this is the real bottom add $cclwn(r0),r5 ;above the top cmp $cpkpn(r1),r5 ;can we accept it if pl,< ;nope movb #%costs,$cpkop(r1) ;turn it into a status to tell him call cpkpko ;what my window size is. > else < mov $ccrcp(r0),r5 ;get receipted number inc r5 ; cmp $cpkpn(r1),r5 ;compare packet numbers if mi,< ;we already have it movb #%costs,$cpkop(r1) ;make it a status call cpkpko ;and send it back > else inc r5 ;count it ;; now try pulling things off the out of order list mov $ccpbf(r0),r1 ;get the first thing on it if ne,< cmp $cpkpn(r1),r5 ;well? if eq,< mov (r1),$ccpbf(r0) ;unlink it from the list clr (r1) ;and clear the link field br 10$ ;and do this strange loop >> > else < ;it goes on the out of order list push r5 mov r0,r4 add #$ccpbf,r4 ;point to the "previous" packet loop < ;try to find a place to put it mov (r4),r5 ;get a packet off the out of order list if eq,< ;if at the end, stick the packet there mov r1,(r4) ;stuff the packet exitl ;and get out > cmp $cpkpn(r1),$cpkpn(r5) ;what relation are the packet numbers if eq,< ;if same we flush call cpkfre ;bye, bye exitl > if mi,< ;if it is less, we should put it before!! mov r1,(r4) ;put it before mov r5,(r1) ;and link the old part of the list in exitl ;and we are finished > mov r5,r4 ;else go forward in the list rptl ;and repeat as necessary > pop r5 >> dec r5 ;r5 was 1+ highest receipted mov r5,$ccrcp(r0) ;and declare as receipted > > pop r4,r5 return ;;; Receive a packet for this host. (r0 must be bashable) cpkpkr: clr $pktul(r1) ;null user link movb $cpkop(r1),r0 ;get the opcode beq 10$ ;no such thing as a null opcode if mi,< mov #cprdat,r0 ;if 200 bit set, it is data > else < cmp r0,#%comax ;is it too big bge 10$ ;lose if so asl r0 ;to word index mov cprtbl(r0),r0 ;get routine to call > call cpks08 ;make packet safe for 8 bit clrb $pktfl+1(r1) ;clear give-user ack bits jcall (r0) ;call the routine 10$: call cpkfre ;get rid of losing packet sez ;lose return .sbttl CPKPKR->CPR... Packet Receive opcode dispathed routines ;;; for these routines r0 is "supposed" to be a connection object, and may be ;;; used for other things if necessary cprtbl: .word 0 ;code checks for null .word cprrfc,cpropn,cprcls,cprfwd ;01,02,03,04 .word cprans,cprsns,cprsts,cprrut ;05,06,07,10 .word cprlos,cprlsn,cprmnt,cpreof ;11,12,13,14 .word cprunc,cprbrd ;15,16 cprrfc: ;RFC received push r5,r4 ;working regs mov #chcncn,r5 ;number of connections mov #chtcon,r4 ;get the connection table loop < mov (r4)+,r0 ;get the connection beq 40$ ;loop if none cmpb $ccsta(r0),#%csopn ;is it open? if ne,< cmpb $ccsta(r0),#%csrfc ;how about RFC received? bne 40$ ;if neither we lose > cmp $ccfid(r0),$cpksi(r1) ;do foreign indices match if eq,< cmp $ccfad(r0),$cpksa(r1) ;is it from the same host beq 100$ ;if so it is a duplicate > 40$: sorl r5 ;loop until finished checking the ;connections > pop r4,r5 jcall cprrfr ;rfc received 100$: ;RFC is duplicate pop r4,r5 jcall cpkfre ;free the packet ;; ;;;;;; Handle a BRD packet!! ;; chtbrd: .rept 8 .byte 1_.rpcnt .endr cprbrd: loop < add #%cpkfi,$cpkn2(r1) ;up the forwarding count exitl cs ;overflow, throw packet away bit #3,$cpkan(r1) exitl ne cmp $cpkan(r1),#32. exitl hi cmp $cpknb(r1),$cpkan(r1) exitl le cmpb $cpksn(r1),#chcmsn ;discard broadcasts beyond exitl his ; my routing table br 10$ > netmet ot jcall cpkfre 10$: clr $cpkda(r1) ;make sure this is zero (in case it was ;sent directly to me) push r2,r3,r4,r5 push #0 ;end of devices marker clr r0 loop < cmp r0,#nnet*2 exitl ge add #2,r0 ;advance to next (yes, do it now) mov netobj-2(r0),r5 ;get the driver (without preadvance) rptl eq ;go on to next if no driver cmp nt$chs(r5),#pktngv ;does it talk chaos? rptl eq ;nope, go on to next interface movb nt.chs+1(r5),r2 bic #mask8,r2 mov r2,r3 bic #mask3,r3 ;mod 8 ash #-3,r2 ;divide by 8 cmp r2,$cpkan(r1) ;entry exist in the bitmap? rptl ge ;this is why r0 was incremented early add r1,r2 ;offset it into the packet bitb chtbrd(r3),$cpkdt(r2) ;bit exist? rptl eq ;nope (another reason early r0 inc) push r5 ;a packet must go out on this driver bicb chtbrd(r3),$cpkdt(r2) ;clear the bit rptl > ;;; drivers are on the stack. packet has bitmap adjusted mov r1,r0 ;hide the packet in r0 loop < pop r5 ;get a driver exitl eq ;exit when done mov #$cpkdt,r1 ;base packet size add $cpknb(r0),r1 ;length needed for a new packet call cpkall ;get one if eq,< ;oops, no memory .deshed ;let some drivers send some packets rptl ;and try the next driver > push r0,$pktsz(r0),r1 ;save pointers and real packet size pktsiz r0,r2 loop < movb (r0)+,(r1)+ sorl r2 > pop r1,$pktsz(r1) ;get packet, set real size, keep r0 saved on stack mov $cpkn2(r1),$cpknb(r1) ;reset with forwarding count mov #-1,$pktul(r1) ;not on any user list clr r2 ;do a hardware broadcast call cpkxqu ;send it to the interface .deshed ;allow packet drivers to get some work done. pop r0 ;get BRD packet back rptl ;go do the next driver > mov r0,r1 ;get packet back ;;; Sent to all drivers. Convert to RFC (except opcode) and handle ;;; it as a RFC. add #$cpkdt,r0 ;point to bitmap mov r0,r3 ;which is also RFC-like data of new packet add $cpkan(r1),r0 ;point to RFC-like data of old packet sub $cpkan(r1),$cpknb(r1) ;update byte count mov $cpknb(r1),r2 ;get number of bytes if gt,< loop < ;copy old RFC section to new movb (r0)+,(r3)+ sorl r2 > > clr $cpkan(r1) ;be consistent, clear ack field mov chvmyn,$cpkda(r1) ;pretend packet was sent to primary address pop r5,r4,r3,r2 jcall cprrfc ;;; CPRRFC utility -- CPRRFR (RFc Received). cprrfr: push r2,r3,r4,r5 ;working regs mov #chtcnt,r0 ;get table of contact names loop < ;loop over possible contact names mov (r0)+,r2 ;get the string there exitl eq ;quit when finished mov $cpknb(r1),r3 ;get byte count exitl eq mov r1,r4 ;get pointer to data area (contact name) add #$cpkdt,r4 ;... loop < ;loop over characters movb (r2)+,r5 ;get character from contact name table if ne,< cmpb r5,(r4)+ ;check the next byte in the packet exitl ne ;oops, doesn't match, go on to next try dec r3 bmi 50$ ;if nothing left in the packet we lose rptl ;else keep trying > tst r3 ;are there any characters left? beq 100$ ;nope, we win with a match cmpb (r4)+,#<' > ;is it a space beq 100$ ;win this way too > 50$: tst (r0)+ ;skip the address of the startup routine rptl ;and repeat looking for contact names > pop r5,r4,r3,r2 ;restore registers cmpb $cpkop(r1),#%cobrd if eq, ;don't complain about BRD packets movb #%cocls,$cpkop(r1) ;turn it into a close packet mov #ch$ucn,r0 ;no contact name message jcall cprbad 100$: pop r5,r4,r3,r2 ;restore regs jcall @(r0) ;call the routine cprrfg: ;give RFC to connection (newly made) mov #%csrfc,$ccsta(r0) ;connection is RFC received mov $cpksa(r1),$ccfad(r0) ;set foriegn address mov $cpksi(r1),$ccfid(r0) ;and foriegn index mov $cpkda(r1),$cclad(r0) ;set local address correctly mov time,$ccitm(r0) ;time of transaction push $cpkpn(r1) ;get packet number mov (sp),$ccsac(r0) ;set should ack number mov (sp),$cchac(r0) ;and have acked number pop $ccrcp(r0) ;receipt number jcall cpkgiv ;give the packet to the connection cprrfn: ;no connection available movb #%cocls,$cpkop(r1) ;make packet a close mov #ch$nac,r0 ;No available connection jcall cprbad cprrft: ;no task available call ccnfre ;free the connection movb #%cocls,$cpkop(r1) ;make it a close mov #ch$nat,r0 ;no available task message jcall cprbad cpropn: ;Open received call cpkfnd ;find the connection if ne,< ;found it cmpb $ccsta(r0),#%csrfs ;are we waiting for it? if eq,< ;yup mov #%csopn,$ccsta(r0) ;declare connection open mov $cpksi(r1),$ccfid(r0) ;set the foriegn index mov $cpkpn(r1),$ccrcp(r0) ;this is the number we should ;receipt mov $cpkpn(r1),$ccsac(r0) ;and the number we should ack call cprst1 ;extract status information > movb #%costs,$cpkop(r1) ;turn it into a status jcall cpkpko ;output it > movb #%colos,$cpkop(r1) ;turn it into a loss mov #ch$noc,r0 ;no connection message jcall cprbad ;stuff message and send loop < cprcls: ;Close received call cpkfnd ;find the connection for it if eq,< jcall cpkfre > ;if none, just free the packet exitl cprans:: cprfwd: call cpkfnd if ne,< cmpb $ccsta(r0),#%csrfs exitl eq > jcall cpkfre > movb #%cscls,$ccsta(r0) cprfw2: call ccnrs2 ;reset most of the connection bis #%cpklp,$pktfl(r1) ;declare this the last packet on the connection jcall cpkgiv ;give the packet to the user cprlos: call cpkfnd if eq,< jcall cpkfre > movb #%cslos,$ccsta(r0) br cprfw2 ;go join common code cprsns: ;SeNSe packet received call cpkfnd ;try and find the connection if eq,< ;no connection at all movb #%colos,$cpkop(r1) ;turn it into a los packet mov #ch$noc,r0 ;no connection message jcall cprbad ;send it through > cmpb $ccsta(r0),#%csrfs ;in RFC-Sent? if eq, ;don't complain, connection not yet open movb #%costs,$cpkop(r1) ;make it a status packet jcall cpkpko ;and send it out cprsts: call cpkfnd if ne,< ;probably a connection cmpb $ccsta(r0),#%csopn if eq,< ;connection complete call cprst1 ;extract status information call cpkfre ;don't need the packet anymore jcall cnprxc ;retransmit packets on this connection > > movb #%colos,$cpkop(r1) ;turn it into a loss packet mov #ch$noc,r0 ;no connection message jcall cprbad ;send it over to other side cprst1: ;extract status information mov $cpkdt+2(r1),$ccfwn(r0) ;get the foreign window size call cprack ;process ack field push $cpkdt+0(r1) ;get receipt field jcall cprrcp ;and process it cprack: ;process ack field cmp $cclac(r0),$cpkan(r1) ;have we already acked this far? if mi,< ;if not mov $cpkan(r1),$cclac(r0) ;set it > push r5 ;working reg mov $cclac(r0),r5 ;get the last acked add $ccfwn(r0),r5 ;gives top of the window sub $cclpn(r0),r5 ;gives number of output slots mov r5,$ccnos(r0) ;and set it if ne, ;set event bits pop r5 push $cpkan(r1) ;ack number is implied receipt ;;; fall through cprrcp: ;stack arg is reciept number push r5,r4 ;working regs mov 4(sp),r5 ;get the receipt number loop < mov $ccobf(r0),r4 ;get unreceipted packet exitl eq ;quit when finished cmp r5,$cpkpn(r4) ;can we flush it? if pl,< ;yup mov (r4),$ccobf(r0) ;unlink it from the list if eq,< ;if that was the end mov r0,$ccobe(r0) ;set up back pointer add #$ccobf,$ccobe(r0) ;... > mov #+1,$pktul(r4) ;declare not in need of reXmit cmp $pktxl(r4),#-1 ;check the transmit link if eq,< ;it is free able push r1 mov r4,r1 ;** re-write this call cpkfre ;so do so pop r1 > rptl ;and repeat > > pop r4,r5,* ;regs and receipt number return cprrut: ;Routing packet received tst $cpkda(r1) ;make sure the destination address is zero if eq,< mov $cpknb(r1),r0 ;get the number of bytes in the packet bit #3,r0 if eq,< asr r0 asr r0 ;convert to number of word pairs push r1,r5,r4 ;working regs push $cpksa(r1) ;address of host to route at add #$cpkdt,r1 ;go up to the data portion loop < dec r0 exitl mi ;exit when finished mov (r1)+,r4 ;get subnet number mov (r1)+,r5 ;get cost tst r4 ;valid subnet? rptl eq ;nope cmp r4,#chcmsn ;compare with max subnet rptl his ;bad still asl r4 ;convert to word index cmp r5,chtcst(r4) ;compare costs if lo,< ;he can do better than we can cmp r5,#17. ;is he sending garbage?? if hi,< ;nope mov r5,chtcst(r4) ;replace the cost mov (sp),chtrou(r4) ;and set the host as the bounce > > rptl > pop *,r4,r5,r1 ;pop source address of and working regs >> jcall cpkfre ;free the packet cprmnt:: ;discard maintenance packets cprlsn: jcall cpkfre ;???. NEVER get a listen from the net cpreof:: ;EOF cprdat: ;Data bis #%cpkaf,$pktfl(r1) ;ack field is user-interesting cprunc:: ;UNC packet call cpkfnd if ne,< ;if connection found cmpb $ccsta(r0),#%csopn ;and it is open if eq,< jcall cpkgiv ;just give it to the user >> movb #%colos,$cpkop(r1) ;make it a loss mov #ch$noc,r0 ;no connection message jcall cprbad ;stuff message and queue cprbad: clr $cpknb(r1) ;clear the length field push r2 ;save mov r0,r2 ;put message in r2 call cpkaz1 ;put ASCIZ in one packet pop r2 ;restore call cpkrvs ;reverse addresses and indices mov #-1,$pktul(r1) ;it is not on any user lists jcall cpkrou ;route it ;; ;;;;;; Packets going out ;; cpkrou: push r5,r2,#0 ;hardware object,r2, immediate destination tst $cpkda(r1) ;is it a broadcast? if eq, ;use source subnet to determine interface else < mov $cpkda(r1),(sp) ;assume on same subnet movb $cpkdn(r1),r5 ;destination subnet bic #mask8,r5 ;sign extension lossage asl r5 tstb chtrou+1(r5) ;is there a bounding host if ne, ;us it as bouncing bridge movb 1(sp),r5 ;get immediate subnet > pop r2 ;get immediate destination bic #mask8,r5 ;sign extension lossage cmp r5,#chcmsn if lo,< asl r5 tstb chtrou+1(r5) ;test high byte (better be zero) if eq,< ;either hardware or nonexistent mov chtrou(r5),r5 ;get interaface index + 1 if ne,< ;hardware mov netobj-1(r5),r5 ;get the hardware object call cpkxqu pop r2,r5 ;restore return > > > call pktngv ;can't get there from here pop r2,r5 return cpkxqu: push $cpknb(r1) ;length of chaos data field bic #%cpkfc,(sp) ;without the forwarding count add #<$cpkdt-$cpk>,(sp) ;complete packet pop $pktxs(r1) ;save is as xmit size push r1 ;packet gets returned call @nt$chs(r5) ;give it to the hardware pop r1 return cpksts: ;set status information in the packet call cpkack ;ack necessary packets mov #4,$cpknb(r1) ;four bytes of data mov $ccrcp(r0),$cpkdt+0(r1) ;set the receipt number mov $cclwn(r0),$cpkdt+2(r1) ;and the local window size bicb #%ccrcp,$ccflg(r0) ;this connection has been receipted return ;bang-o cpkack: mov $ccsac(r0),$cchac(r0) ;what we should ack, and what we have mov $cchac(r0),$cpkan(r1) ;set the ack number mov $cclwn(r0),$ccwhs(r0) ;reset when-send-status cmp $ccrcp(r0),$cchac(r0) ;did we just do an implicit ack? if eq, ;if so we don't need to receipt return cpkctl: inc $cclpn(r0) ;up the packet number mov $cclpn(r0),$cpkpn(r1) ;set it as the packet number clr (r1) ;clear the link, it is going on a list mov r1,@$ccobe(r0) ;put it on the output list mov r1,$ccobe(r0) ;and set up the end link dec $ccnos(r0) ;one less output slot return cpkhst: tst r0 ;is there really a connection ;if none, assume NCP has set the fields if ne,< ;if there is one mov $ccfad(r0),$cpkda(r1) ;set the destination address mov $ccfid(r0),$cpkdi(r1) ;and the destination index mov $cclad(r0),$cpksa(r1) ;local/source address mov $cclid(r0),$cpksi(r1) ;local/source index > return cpkrvs: ;reverse destination and source addresses push $cpksa(r1),$cpkda(r1) pop $cpksa(r1),$cpkda(r1) push $cpksi(r1),$cpkdi(r1) pop $cpksi(r1),$cpkdi(r1) return ;;; Output a packet -- Z bit set if loses cpkdto: movb #%codat,$cpkop(r1) ;set the opcode to data cpkpko: push r5 mov #-1,$pktul(r1) ;not on a user list (yet) mov #-1,$pktxl(r1) ;not on a transmit link (yet) movb $cpkop(r1),r5 ;get the opcode beq 10$ if mi,< mov #cpxdat,r5 ;use the data routine > else < cmp r5,#%comax ;compare with max allowed if ge,< 10$: ;we are losing call cpkfre ;free the losing packet pop r5 ;restore reg sec ;error return return ;and return > asl r5 ;make it a word index mov cpxtbl(r5),r5 ;get the routine address > call (r5) br 100$ ;controlled packet br 200$ ;send once, uncontrolled packet br 10$ ;error return br 400$ ;LSN packet br 500$ ;UNC packet 200$: ;send once -- user uncontrolled clr $cpkpn(r1) ;no packet number br 500$ ;and send it 100$: ;controlled call cpkack ;set the ack info call cpkctl ;allow retransmission 500$: call cpkhst ;and the host info call cpkrou ;route it 400$: ;don't do anything special pop r5 ;restore .deshed ;let the packet shover run clc ;success return .sbttl CPKPKO->CPX... Opcode transmission routines ;;; In these routines, the connection is in r0 and the packet attempted to be ;;; output is in r1. ;;; return mechanism: ;;; call (dispatching reg) ;;; +0 br ;;; +2 br ;;; +4 br ;;; +6 br ;;; +8 br cpxtbl: .word cpxerr ;null opcode .word cpxrfc,cpxopn,cpxcls,cpxfwd ;01,02,03,04 .word cpxans,cpxsns,cpxsts,cpxrut ;05,06,07,10 .word cpxlos,cpxlsn,cpxmnt,cpxeof ;11,12,13,14 .word cpxunc,cpxbrd ;15,16 cpxrfc: loop < cmpb $ccsta(r0),#%cscls ;is the connection currently closed? exitl eq ;ok if closed cmpb $ccsta(r0),#%cslos exitl eq ;ok if lost (re-using the connection) cmpb $ccsta(r0),#%csinc exitl eq ;ok if incomplete (re-using the connection) bne cpxerr ;else we are losing so error out > call ccnrst ;go reset the connection completely mov $cpkda(r1),$ccfad(r0) ;set the foreign address clr $ccfid(r0) ;no foreign index mov $cpkpn(r1),$cclwn(r0) ;packet number is local window size cmp $cclwn(r0),#100 if hi, clr $ccsac(r0) ;should ack nothing clr $cchac(r0) ;have acked nothing clr $ccrcp(r0) ;have not receipted anything clr $ccnib(r0) ;because there is nothing to reciept mov #1,$ccnos(r0) ;allowed to output one packet (this) mov time,$ccitm(r0) ;declare the connection active as of now mov #%csrfs,$ccsta(r0) ;set the state to rfc sent (do it last) return cpxrut:: cpxlos:: cpxmnt:: cpxbrd:: cpxerr: add #4,(sp) ;error return return cpxopn: cmpb $ccsta(r0),#%csrfc ;are we in RFC received? bne cpxerr ;if not, error mov $cpkpn(r1),$cclwn(r0) ;packet number is local window size ;; something may have to go here to set up other connection ;; variables mov #1,$ccnos(r0) ;allowed to output one packet (this) mov #%csopn,$ccsta(r0) ;state is now open call cpksts ;set status information on the packet return cpxcls: cmpb $ccsta(r0),#%csrfc ;are in in RFC received? if ne,< ;nope cmpb $ccsta(r0),#%csopn ;how about open if ne,< ;nope again cmpb $ccsta(r0),#%csrfs ;we will even allow RFC sent bne cpxerr ;if not we are losing >> mov #%cscls,$ccsta(r0) ;close the connection at this end cpxonce: ;send the packet once add #2,(sp) return cpxfwd:: cpxans: tst r0 ;is there a connection? beq cpxonce ;if no real connection, just send it once cmpb $ccsta(r0),#%csrfc ;are we in RFC received? bne cpxerr ;if not we are losing mov #%cscls,$ccsta(r0) ;declare connection closed br cpxonce ;and send it once cpxsns: cmpb $ccsta(r0),#%csopn ;we should be in open bne cpxerr ;error if not (why do you think we sense?) mov $cchac(r0),$cpkan(r1) ;just in case clr $cpknb(r1) ;clear byte count br cpxonce ;and transmit once cpxsts: cmpb $ccsta(r0),#%csopn ;we should be open bne cpxerr call cpksts ;set status info br cpxonce ;and transmit once cpxlsn: br cpxerr ;on the assumption we don't do things this ;way here cpxeof:: cpxdat: cmpb $ccsta(r0),#%csopn ;are we open bne cpxerr ;if not, we are losing return ;else send it through cpxunc: cmpb $ccsta(r0),#%csopn ;is the connection open? if ne,< ;nope, check for other states cmpb $ccsta(r0),#%csfrn ;already foreign? if ne,< ;sigh, check for other states loop < cmpb $ccsta(r0),#%cscls ;are we closed? exitl eq ;that's fine cmpb $ccsta(r0),#%cslos ;lost connection exitl eq ;ok, re-using the conenction cmpb $ccsta(r0),#%csinc ;incomplete? exitl eq ;also ok, re-using the connection bne cpxerr > call ccnrst ;completely reset the connection movb #%csfrn,$ccsta(r0) ;set the state to foreign tst fixunc ;fix connection information > > add #8.,(sp) ;UNC return return ;;; Strings used by the network control program ch$noc: .asciz "No connection at MINITS end. [MINITS]" ;he will read this ch$fto: .asciz "Foreign host is not responding. [MINITS]" ch$ucn: .asciz "Unknown contact name. [MINITS]" ch$rfc: .asciz "Attempt to connect has timed out. [MINITS]" ch$nac: .asciz "No available connection for server task. [MINITS]" ch$nat: .asciz "No available task for server. [MINITS]" .even ;; ;;;;;; initialization ;; chsini: ;these are done by the packet manager ;becuase we need to know how many ;interfaces are up ;;; clr chvnup ;no interfaces up yet ;;; clr chvmyn ;I don't have a current address yet clr rldtim tst chvnup ;any interfaces up? if ne,< call ccnini ;init the connection routines call cnpini ;init the network control routines > return ;;; Init the Network programs ;;; priorities (0-255. = 0-377) ;;; 060 routing packet sender ;;; 120 display tasks ;;; 160 keyboard tasks ;;; 220 NETI/NETO tasks ;;; 260 NCP tasks ;;; 320 CHAOS interface task cnpini: clr cnvipq ;nothing on the incoming packet queue mov #cnvipq,cnvipe ;point the end at the queue .regs #cnppki,#60,#260_8 .usrgo ;fire up packet receiver call cnpirou ;init the routing table .regs #cnpage,#30.,#260_8 .usrgo ;fire up the routing table ager cmp chvnup,#1 ;is there more than one interface? if gt,< .regs #cnprou,#30.,#060_8 .usrgo ;fire up routing table sender > .regs #cnpsns,#30.,#260_8 .usrgo ;fire up connection sensor .regs #cnprex,#30.,#260_8 .usrgo ;fire up retransmitter .regs #cnpsts,#30.,#50_8 .usrgo ;fire up connection statuser mov #-1,chvtil ;preset the time finding lock .regs #cnptim,#30.,#10_8 .usrgo ;fire up person who finds out the time .if g ntty .regs #cnpstr,#50.,#220_8 .usrgo ;fire up stream IO manager .endc return cnppki: loop < ;do forever mov cnvipq,r1 ;get a packet from the input queue if eq,< .regs #hng.ne,#cnvipq,#zero .hang ;wait for a packet to come in (and let ;higher priority processes run in the ;meantime) rptl> lock 6 mov (r1),cnvipq ;unlink if eq, ;point the end to the beginning unlock call cpkpkr ;receive a packet for this host .deshed ;deschedule self rptl > ;;; Routing table initer cnpirou: mov #chtrou,r5 ;get the routing table mov #chtcst,r4 ;get the cost table mov #chcmsn,r3 ;max number of subnets loop < clr (r5)+ ;don't know how to get there yet mov #chcbad,(r4)+ ;and not knowing costs us a lot sorl r3 > mov #netobj,r5 mov #nnet,r4 loop < mov (r5)+,r3 if ne,< cmp nt$chs(r3),#pktngv ;does it talk chaos? if ne,< mov $ctrav(r3),@$ctrap(r3) ;reset routing table entry mov #chcbad/2,@$ctrcp(r3) ;and routing cost (half of worst) > > sorl r4 > return ;;; Routing table ager cnpage: loop < mov #chtrou,r5 ;get the routing table mov #chtcst,r4 ;get the cost table mov #chcmsn,r3 ;max number of subnets loop < tst (r5) ;does subnet exist? if ne,< ;yup cmp (r4),#chcbad ;is it already virtual +INF if lo, ;age the cost > cmp (r5)+,(r4)+ ;move along the table sorl r3 ;and loop around for each subnet > .regs #60.*4+1,#0 ;the manual says every four seconds .sleep rptl > ;;; Routing table sender cnprou: loop < mov #netobj,r0 ;for all network objects loop < mov (r0),r5 ;get the hardware object if ne,< mov $ntxtm(r5),r1 ;get last xmit time add #60.*10.,r1 ;ten seconds later cmp time,r1 ;have ten seconds gone by yet? if pl, ;go flush xmit packets cmp nt$chs(r5),#pktngv ;does it talk chaos? if ne,< mov #$cpkdt+,r1 ;data + 2 words per subnet call cpkall ;get a packet if ne,< ;if a packet not found, just punt this time movb #%corut,$cpkop(r1) ;set the opcode mov nt.chs(r5),$cpksa(r1) ;set the source address clr $cpkda(r1) ;destination address is zero mov r1,r2 ;get pointer to data in r0 add #$cpkdt,r2 ;... push @$ctrcp(r5) ;indirect putting this cost on stack push $ctrcv(r5) ;get the cost value for this interface asl (sp) asl (sp) asl (sp) asl (sp) ;* 16. (for worst possible) cmp (sp),2(sp) if his, else mov #chtrou,r5 ;get the routing table mov #chtcst,r4 ;get the cost table clr r3 ;starting from subnet zero loop < ;for each subnet tst (r5) ;do we know how to get to this subnet if ne,< ;yup (or at least we did at one time) cmp (r4),#chcbad ;do we still know how? if lo,< ;yup mov r3,(r2)+ ;declare we can get there mov (r4),(r2) ;cost from the table add (sp),(r2)+ ;and cost of hardware add #4,$cpknb(r1) ;four more bytes in the packet > > cmp (r4)+,(r5)+ ;move through the tables inc r3 cmp r3,#chcmsn ;compare with max subnet number rptl lt > pop * ;pop the cost for this subnet mov #-1,$pktul(r1) ;not on any user list mov (r0),r5 ;get hardware object back clr r2 ;do a chaos broadcast call cpkxqu > > > add #2,r0 ;advance to next interface index cmp r0,#netobj+<2*nnet> ;finished yet? rptl lo > .regs #60.*15.+1,#0 ;the manual says send routing tables every ;15 seconds .sleep rptl > ;;; send STATUS packets on connections that want them or need them cnpsts: loop < .regs #20.+1,#0 ;1/3 of a second (plus epsilon) .sleep mov #chtcon,r5 ;get the connection table mov #chcncn,r4 ;get the number of connections loop < ;loop over connections mov (r5)+,r0 ;try to get a connection if ne,< ;if there is one cmpb $ccsta(r0),#%csopn ;only send status on open connections if eq,< cmp $cchac(r0),$ccsac(r0) ;anything left unacked? bmi 100$ ;if so, make sure we do bitb #%ccrcp,$ccflg(r0) ;need receipting? if ne,< cmp $cchac(r0),$ccrcp(r0) ;have we done an implicit receipt? if ne,< ;nop, so must send status 100$: mov #$cpkdt+4,r1 ;size of status packet call cpkall ;try and get one if eq,< .regs #3.,#0 .sleep ;sleep a little tst -(r5) ;go back to the connection rptl ;r0 will get reset > movb #%costs,$cpkop(r1) ;make it a status call cpkpko ;and output it >>>> sorl r4 > rptl > ;;; connection senser. Looks for idle connections and starts probing cnpsns: loop < ;do forever ;; test for reload here (every five seconds) tst rldtim ;did somebody request a reload? if ne,< ;yup dec rldtim ;count down if eq, ;jump to bootstrap prom > mov #chtcon,r5 ;get the connection table mov #chcncn,r4 ;number of connections to deal with loop < ;loop over the connections mov (r5)+,r0 ;try to get a connection if ne,< ;is there one? cmpb $ccsta(r0),#%csopn ;is it open? if eq,< ;yup mov time,r3 ;get current time sub $ccitm(r0),r3 ;minus last activity time cmp r3,#60.*100. ;is connection dead? (100 seconds) if hi,< ;sure looks dead to me mov #$cpkdt,r1 ;get any packet call cpkall ;get me a packet if eq,< ;foo, couldn't get one 100$: .regs #17.,#0 ;sleep a little .sleep tst -(r5) ;go back to the connection rptl ;and try again > movb #%cocls,$cpkop(r1) ;make it a close packet mov $ccfad(r0),$cpksa(r1) ;pretend it came from the mov $ccfid(r0),$cpksi(r1) ;foreign host mov $cclid(r0),$cpkdi(r1) ;and set the local index mov #ch$fto,r2 ;foreign timeout message call cpkaz1 ;copy it in call cpkpkr ;receive the packet > else < ;it has not timed out cmp $cclpn(r0),$cclac(r0) ;has the server acked all ;my pakcets? bne 200$ ;probe if some are outstanding tst $ccfwn(r0) beq 200$ ;probe on a window size of zero as well cmp r3,#60.*60. ;should we send a probe? if hi,< ;yup 200$: mov #$cpkdt,r1 ;get a packet call cpkall ;get it beq 100$ ;barf if no packet movb #%cosns,$cpkop(r1) ;make it a sense packet call cpkpko ;and output it >>>> dec r4 ;sorl can't get there from here rptl ne > .regs #60.*5+1,#0 ;manual says probe every five seconds .sleep ;now I lay me down to sleep rptl > ;;; Retransmitter cnprex: loop < ;do forever mov #chtcon,r5 ;get connection table mov #chcncn,r4 ;getumber of connections to scan loop < ;for each connection mov (r5)+,r0 ;try and get the connection if ne,< ;got one call cnprxc ;retransmitpackets for this connection > sorl r4 ;repeat for the connections in the table > .regs #60./2+1,#0 ;every so much of second .sleep rptl > ;;; Retransmit packets on a given connection cnprxc: push r1,r2 cmpb $ccsta(r0),#%csrfs ;are we RFC sent if eq,< mov time,r2 ;get the current time sub #60.*20.,r2 ;give the host 20 seconds to convince us he ;wants to talk with us cmp $ccitm(r0),r2 ;compare times if mi,< ;timeout call ccnrs2 ;reset most of the connection movb #%csrfs,$ccsta(r0) ;keep connection in RFC sent pop r2,r1 return >> mov time,r2 ;get the current time sub #3,r2 ;1/20 of a second mov $ccobf(r0),r1 ;get the top of the list if ne,< loop < call cpkack ;since it is on a transmit list it has an ;ack field. Update it. cmp $pktxl(r1),#-1 ;is it on a transmit list if eq,< ;nope, may have to retransmit cmp $pktxt(r1),r2 ;compare with transmit time if mi,< ;needs it call cpkrou ;route it exitl ;only retransmit one packet >> mov $pktul(r1),r1 ;go through the user link rptl ne ;and repeat until finished >> pop r2,r1 return ;;; determine what time it is (ARPA time) chctim==0 .macro chmtim host .word host chctim==chctim+1 .endm chttih: chmtim 003114 ;ml chmtim 005542 ;ee chmtim 001440 ;mc chmtim 000500 ;plasma chmtim 002420 ;xx chmtim 000435 ;speech chmtim 000530 ;bypass chmtim 017050 ;vixen chmtim 017042 ;scrc chmtim 017006 ;pointer chmtim 003120 ;vx .wvector chttim,2*chctim .wvector chvtim,4 .wscalar chvtil cnptim: inc chvtil ;grab the lock if ne,< ;somebody else has it dec chvtil .logout > cnpti1: clr arptim ;disavow any knoledge of previous time clr arptim+2 .regs #60.*30.,#0 ;wait for at least two routing packets .sleep mov #chttih,r5 ;pointer to host table mov #chttim,r4 ;pointer to time table mov #chctim,r3 loop < call ccnall ;get a connection beq 5$ ;sleep for a while mov #$cpkdt+4,r1 ;size of packet call cpkall ;get one if eq,< call ccnfre 5$: .regs #60.*5,#0 .sleep rptl> mov (r5)+,$cpkda(r1) mov #"TI,$cpkdt+0(r1) mov #"ME,$cpkdt+2(r1) mov #4,$cpknb(r1) movb #%corfc,$cpkop(r1) call cpkpko call cpkwti ;wait for an input packet call cpkpki ;get it if ne,< cmpb $cpkop(r1),#%coans if eq,< tstb $cpkdt+3(r1) ;test most sig byte if ne,< ;better have somtethin in it mov $cpkdt+0(r1),(r4) mov $cpkdt+2(r1),2(r4) lock 7 sub arptim+0,(r4)+ sbc (r4) sub arptim+2,(r4)+ unlock >> call cpkfre > call ccnfre dec r3 ;can't get there from here (sorl losses). rptl ne > ;; get number of responses and make sure there are at least 3 sub #chttim,r4 asr r4 asr r4 ;get number of good responses cmp r4,#3 ;must have at least three blt cnpti1 ;; average them ;; add them all up into a 48 bit number push #0,#0,#0 mov r4,r2 ;number of entries mov #chttim,r3 ;table of responses loop < add (r3)+,0(sp) adc 2(sp) add (r3)+,2(sp) adc 4(sp) sorl r2 > ;; divide the 48 bit number. this is not as easy as it sounds. ;; First, we have to convert it to bignum-digits, do the ;; division the PDP-11 can handle, and convert back to 32 bits. asl (sp) rol 2(sp) rol 4(sp) ;known to carry out a 0 ror (sp) asl 2(sp) rol 4(sp) ;known to carry out a 0 ror 2(sp) ;; now in bignum digits. Try dividing -- finally! clr r0 mov 4(sp),r1 div r4,r0 mov r0,chvtim+2 ;high order mov r1,r0 mov 2(sp),r1 div r4,r0 mov r0,chvtim+0 ;low order, punt final remainder popn #6 ;; convert from bignum-digits to 32 bit number asl chvtim+0 ;known to shift out a 0 ror chvtim+2 ror chvtim+0 ;; compute unsigned difference from average, accumulating best ;; difference in r0,r1 and best pointer to time in r5 mov #-1,r0 ;unsigned infinity mov #chttim,r3 loop < mov chvtim+0,chvtim+4 mov chvtim+2,chvtim+6 sub (r3)+,chvtim+4 sbc chvtim+6 sub (r3)+,chvtim+6 if lt,< neg chvtim+4 adc chvtim+6 neg chvtim+6 > cmp chvtim+6,r0 blo 100$ if eq,< cmp chvtim+4,r1 if lo,< 100$: mov chvtim+4,r1 mov chvtim+6,r0 mov r3,r5 >> sorl r4 > lock 7 add (r5)+,arptim+0 adc arptim+2 ;don't drop 18 hours add (r5)+,arptim+2 unlock dec chvtil ;unlock the lock .logout cpkxok: ;no packet. Just connection. tst $ccnos(r0) ;check the number of output slots return ;<0 is error state loop < cpkwtx: push #$ccnos ;wait for output slot exitl cpkwti: push #$ccnib ;wait for input packet > push r0,r1,r2 mov r0,r1 add 6(sp),r1 .regs #hng.ne,,#zero .hang pop r2,r1,r0,* return ;;; r1/ packet ;;; r2/ string pointer cpkaz1: call cpkptx ;setup xmit pointer and count push r2,r2 call strlen ;get the length pop r2 add $pktbp(r1),r2 ;write address needed sub r1,r2 ;size needed call cpkchk pop r2 ;get string loop < dec $pktbc(r1) exitl mi tstb (r2) exitl eq movb (r2)+,@$pktbp(r1) inc $pktbp(r1) inc $cpknb(r1) rptl > inc $pktbc(r1) ;fix pre-dec return **** .sbttl CX.... Contact name eXecuting routines .macro chscnm name,routin ;contact name,,routine .string ^"name" .word routin .endm ;;; Contact name routines get packet in r1, and base of the routine in r0. ;;; All other registers must be saved as needed. If the packet needs a ;;; connection (and probably a process), it is up to the routine to spawn ;;; such things. chtcnt: chscnm ^"STATUS",cxstatus .if nz system-110 ;don't let archub have a time server chscnm ^"TIME",cxtime .endc chscnm ^"RESET-TIME-SERVER",cxrtime chscnm ^"UPTIME",cxuptime chscnm ^"ECHO",cxecho chscnm ^"REECHO",cxreecho chscnm ^"SINK",cxsink chscnm ^"SOURCE",cxsource .iif nz system-26, chscnm ^"SUPDUP",cxsupdup chscnm ^"ReLoaD",cxreload chscnm ^"DUMP-ROUTING-TABLE",cxdump .iif z system-26, chscnm ,cxmail .iif z system-26, chscnm ,cxname chscnm ^"ex",cxex chscnm ^"dp",cxdp chsrvl ;servers from other modules .word 0 cxrtime: push r1,r2 .regs #cnptim,#30,#10_8 .usrgo if cs,< pop r2,r1 jcall cpkfre > pop r2,r1 movb #%coans,$cpkop(r1) clr r0 call cpkrvs jcall cpkpko loop < cxtime: tstb arptim+3 ;make sure we know the time if eq, ;if unknown, don't answer .if df brdtim cmpb $cpkop(r1),#%cobrd if eq, ;CJL doesn't want MIT hosts to respond to Broadcast .endc lock 7 ; RFC = TIME mov arptim+0,$cpkdt+0(r1) mov arptim+2,$cpkdt+2(r1) exitl cxuptime: ; RFC = UPTIME lock 7 mov time+0,$cpkdt+0(r1) mov time+2,$cpkdt+2(r1) exitl > unlock mov #4,$cpknb(r1) movb #%coans,$cpkop(r1) clr r0 ;no real connection call cpkrvs ;reverse source and destination jcall cpkpko ;send it on it's way loop < cxex: lock 7 call nxmcat 10$ loop < mov @$cpkdt+4(r1),$cpkdt+0(r1) call nxmclr exitl 10$: clr $cpkdt+0(r1) > unlock mov #2,$cpknb(r1) exitl cxdp: lock 7 call nxmcat 10$ loop < mov $cpkdt+4(r1),@$cpkdt+6(r1) call nxmclr exitl 10$: > unlock clr $cpknb(r1) > movb #%coans,$cpkop(r1) clr r0 call cpkrvs jcall cpkpko cxdump: push r2 ; need r2 mov #$cpkdt+<4*chcmsn>,r2 ; get size of packet we'll need, call cpkchk ; ensure size is reasonable if eq,< pop r2 ; if not, jcall cpkfre> ; punt it push r1,r3,r4 add #$cpkdt,r1 ; ptr to data area mov #chtrou,r2 ; ptr to routing table mov #chtcst,r3 ; ptr to cost table mov #chcmsn,r4 ; chaos constant: max subnet # loop < ; for each subnet, (0 based) mov (r2)+,(r1)+ ; copy "method" word ;; 0 - don't know how to get there, ;; .le. 0,,255. +1 ;; else, immediate host to send to mov (r3)+,(r1)+ ; copy cost value sorl r4 ; loop for all subnets > pop r4,r3,r1,r2 ; finished with regs mov #4*chcmsn,$cpknb(r1) ; set data byte length movb #%coans,$cpkop(r1) ; make it an answer packet clr r0 ; no real connection (it's simple) call cpkrvs ; reverse source/destination jcall cpkpko ; and send the packet ;;; RFC = STATUS cxstatus: push r2,r3 ;working reg mov chvnup,r3 ;get the number of interfaces that are up mul #4+<$nt%%%-$nt%>,r3 ;2 header words plus data mov r3,r2 ;get product pop r3 add #32.+$cpkdt,r2 ;32 bytes for host name + header call cpkchk ;check the size if eq,< ;if we lost, we can't reply pop r2 ;restore reg jcall cpkfre ;free the packet, and hope we win later > pop r2 push r5,r4,r3 ;save regs mov r1,r5 ;get packet add #$cpkdt,r5 ;point at begining of data mov #32.,r4 ;bytes to insert for host name mov r4,$cpknb(r1) ;size of packet so far mov #hststr,r3 ;the actual host name loop < dec r4 ;we are going to move a byte exitl mi ;finished if goes minus movb (r3)+,(r5)+ ;move it rptl ne ;repeat until zero or size constraint > loop < dec r4 ;clear another byte exitl mi ;finished when goes neg clrb (r5)+ rptl > ;;; insert info mov #netobj,r4 ;the number of interfaces to test push r2 loop < mov (r4)+,r3 ;hardware object if ne,< cmp nt$chs(r3),#pktngv ;does it talk chaos? if ne,< add #4,$cpknb(r1) ;2 words for subnet and word count movb nt.chs+1(r3),(r5)+ ;subnet movb #1,(r5)+ ;+400 add #$nt%,r3 ;go to the stats region add #<$nt%%%-$nt%>,$cpknb(r1) ;number of bytes we are ;about to add mov #<$nt%%%-$nt%>/2,r2 ;number of words to move mov r2,(r5)+ ;it goes in the packet too loop < mov (r3)+,(r5)+ sorl r2> > > cmp r4,#netobj+<2*nnet> rptl lo > pop r2,r3,r4,r5 ;restore regs clr r0 ;no real connection movb #%coans,$cpkop(r1) ;make it an ans packet call cpkrvs ;reverse source and destination jcall cpkpko ;and output the packet through the ;non-connection ;;; server creater. ;;; push r2 ;;; jsr r5,cx.srv ;;; .word ,, ;;; ;;; pop r2 ;;; jcall cprrfg ;;; returns with ;;; r0/ connection ;;; r1/ packet ;;; r2/ pointer to server's r1 (server's r0 = connection) ;;; by macro: ;;; cx$srv ,,, .macro cx$srv strt,stksiz,prio,code push r2 jsr r5,cx.srv .word strt,stksiz,prio code pop r2 jcall cprrfg .endm cx.srv: call ccnall if eq,< pop r5,r2 jcall cprrfn > ;no connection available push r1,r0 ;save packet and connection .regs (r5)+,(r5)+,(r5)+ .usrgo if cs,< pop r0,r1,r5,r2 jcall cprrft > ;complain that no task available mov r0,r2 ;remember pointer to server's regs pop r0,r1 ;get connection and packet mov r0,(r2)+ ;put connection in server's r0 rts r5 ;;; SINK server cxsink: cx$srv 100$,40,40_8,<> ;start address, stack size, priority, no ;code 100$: call cpkpki mov #8,$cpkpn(r1) ;set window size movb #%coopn,$cpkop(r1) ;make it an open call cpkpko loop < call cpkpki if cs,< call ccnfre .logout> if eq,< call cpkwti rptl> call cpkfre ;free it rptl > cxsource:cx$srv 100$,40,40_8,<> ;start address stack size, priority, no code 100$: call cpkpki ;get RFC mov #1,$cpkpn(r1) ;small window size movb #%coopn,$cpkop(r1) ;convert to open packet call cpkpko loop < ;send packet loop loop < ;wait for xmit room available call cpkxok if lt,< call ccnfre .logout > exitl gt call cpkwtx rptl > mov #$cpkdt+%cpmxc,r1 call cpkall if eq,< push r0 .regs #1,#0 .sleep pop r0 rptl > mov #%cpmxc,$cpknb(r1) call cpkdto ;send data packet rptl > ;;; ECHO server cxecho: cx$srv 100$,40,40_8,<> ;start address, stack size, priority, no code ;; echoing routine 100$: ;r0 has connection call cpkpki ;get the RFC if cs,< ;oops 110$: call ccnfre ;close and free the connection .logout > mov #8,$cpkpn(r1) ;set window size movb #%coopn,$cpkop(r1) ;make it an open call cpkpko ;output it loop < call cpkpki ;get a packet bcs 110$ ;logout if lose if eq,< ;if none go blocked call cpkwti ;wait for input rptl ;and repeat loop when ready > loop < call cpkxok ;can I transmit? blt 110$ exitl gt call cpkwtx rptl > call cpkpko ;output it rptl > .if z system-26 cxmail: cx$srv cxgate,40,40_8,< mov #12035,(r2)+ ;r1 has host mov (pc)+,(r2)+ ;r2 has contact name .string > cxname: cx$srv cxgate,40,40_8,< mov #12035,(r2)+ ;r1 has host mov (pc)+,(r2)+ ;r2 has contact name .string > .endc system-26 cxreecho: cx$srv cxgate,40,40_8,< mov $cpksa(r1),(r2)+ ;r1 has host mov (pc)+,(r2)+ ;r2 has contact name .string ;which is ECHO > cxsupdup: cx$srv cxgate,40,40_8,< mov #1440,(r2)+ ;r1 has host (MC) mov (pc)+,(r2)+ ;r2 has contact name .string ;which is SUPDUP > ;;; gateway processing. r0/conn, r1/host, r2/contact name cxgate: push r2,r1 ;save contact name and host mov r0,r2 ;incoming connection in r2 clr r3 ;no packets or other connection clr r4 ;... clr r5 ;... call cpkpki ;get the RFC if cs,< ;oops 110$: mov r2,r0 call ccnfre mov r3,r1 if ne, mov r4,r0 if ne, mov r5,r1 if ne, .logout > mov #8,$cpkpn(r1) ;set window size movb #%coopn,$cpkop(r1) ;make it an open call cpkpko ;output it call ccnall ;get a connection object beq 110$ ;total loss if can't get it mov r0,r4 ;set the connection mov #$cpkdt+20,r1 ;should be sufficient packet size call cpkall ;get a packet for RFC beq 110$ movb #%corfc,$cpkop(r1) ;make it an RFC pop $cpkda(r1) ;send it to the desired host mov #8,$cpkpn(r1) ;window size pop r5 ;get contact name mov r1,r3 add #$cpkdt,r3 ;point to data region loop < pushb (r5)+ if eq, popb (r3)+ inc $cpknb(r1) rptl > clr r3 clr r5 call cpkpko bcs 110$ ;logout if we lose push r2,#%csrfs ;rfc sent state .regs #hng.ne,sp mov r4,r2 ;point at connection 2 add #$ccsta,r2 ;point at the state variable .hang ;wait for state to change pop *,r2 push #0 ;flag word loop < clr (sp) mov r3,r1 ;get connection 1 packet if eq, ;logout if error tst r1 ;do we have a packet? if ne,< mov r4,r0 ;get connection 2 call cpkxok ;see if we can send it blt 110$ ;logout if error if gt,< call cpkpko ;send it if we can bcs 110$ ;logout if error clr r1 ;no incoming conn 1 packet inc (sp) ;we did something. Should loop, not hang > mov r1,r3 ;remember the packet > mov r5,r1 ;get connection 2 packet if eq, ;logout if error tst r1 ;do we have a packet if ne,< ;if so mov r2,r0 ;get connection 1 call cpkxok ;see if we can send it blt 110$ ;logout if error if gt,< call cpkpko ;send if if we can bcs 110$ ;if error, logout clr r1 ;no incoming conn 2 packet inc (sp) ;we did something. should loop, not hang > mov r1,r5 ;remember the packet > tst (sp) rptl ne ;repeat if told to tst r3 ;is there a conn 1 packet if ne,;hang waiting for output slot else ;else wait for incoming packet tst r5 ;is there a conn 2 packet if ne,;hang waiting for output slot else ;else wait for incoming packet push r2 mov r0,r2 .regs #hng.or .hang pop r2 rptl > cxreload: cmpb $cpkop(r1),#%corfc if eq,< mov #3,rldtim ;reload in 10 to 15 seconds movb #%coans,$cpkop(r1) > else < ;REFUSE BRD!! mov #'N+<'O_8>,$cpkdt+0(r1) mov #2,$cpknb(r1) movb #%cocls,$cpkop(r1) > clr r0 call cpkrvs jcall cpkpko .if g ntty dsect < ;;; chaos receive device .blkb l$dv ;a raw device and $chccn:: .blkw 1 ;a connection $chodv:: .blkw 1 ;the other (transmit) device >,lchrdv dsect < ;;; chaos xmit device .blkb l$dv ;a raw device and $chccn:: .blkw 1 ;a connection $chodv:: .blkw 1 ;the other (receive) device >,lchxdv ;;; open a stream chaos connection ;;; push window_size,contact_name_and_jcl,host_number ;;; .regs #opncha,sp ;;; .open ;returns r0:rcv channel, r1:xmit channel opncha: mov r1,r4 ;get arglist in r4 call ccnall ;allocate a connection if eq,< 10$: mov #1,usrerr(r5) return > mov #$cpkdt+4,r1 call cpkall ;get a packet for the RFC if eq,< 20$: call ccnfre br 10$ > movb #%corfc,$cpkop(r1) ;opcode RFC mov (r4)+,$cpkda(r1) ;destination host push r2 mov (r4)+,r2 ;get the contact name and jcl call cpkaz1 ;stuff it in one packet mov (r4)+,$cpkpn(r1) call cpkpko ;send out the packet if cs,< 30$: pop r2 br 20$ > call ccnmks bcs 30$ pop r2 return ;;; EMT version $ccnmks: call ccnmks if cs, return ccnmks: push r2 ;working reg mov r0,r2 ;save connection in r2 push #lchrdv,#0 call dvrini pop r0 ;get receive device (stack: r2) if eq,< 30$: mov r2,r0 ;get connection back pop r2 ;restore register sec return > mov #charpg,$dvpgt(r0) ;physical get routine mov #charpi,$dvpio(r0) ;physical io vector for input channel push #lchxdv,#0 call dvxini pop r1 ;get xmit device (stack: r2) if eq,< 40$: push r0 call fsmfre ;free the receive device br 30$ > mov #chaxpp,$dvppt(r1) ;physical put routine mov #chaxpi,$dvpio(r1) ;physical io vector for output channel push r0 call makchn if cs,< pop * ;flush non object 50$: push r1 call fsmfre br 40$ > push r1 call makchn if cs,< pop *,r0 call $close br 50$ > ;stack: r2,r0,r1 mov r2,$chccn(r0) ;put the connection in the devices mov r2,$chccn(r1) mov r1,$chodv(r0) ;put each device in the other mov r0,$chodv(r1) pop r1,r0,r2 clc return ;;; IO control routines charpi: ;chaos receive channel physical io .word $close,charcl ;receiver close .word chnevr,chaevr ;set event bits .word 0 chaxpi: ;chaos xmit channel physical io .word $close,chaxcl ;transmitter close .word chnevx,chaevx ;set event bits .word 0 loop < chaevr: push #$ccebr,#$ccepr exitl chaevx: push #$ccebx,#$ccepx > add $chccn(r4),(sp) ;convert connection offsets to pointers add $chccn(r4),2(sp) ;... mov r2,@2(sp) ;set the bits mov r3,@0(sp) ;set the pointer bis r2,(r3) ;initially cause an event pop *,* ;cleanup return charcl: chaxcl: push r0 mov $chodv(r4),r0 ;get the other device if eq,< ;already gone, so... mov $chccn(r4),r0 ;get the connection call ccnfre ;and flush it off the map > else < ;the other device is there clr $chodv(r0) ;and tell it that this one isn't > pop r0 push r4 call fsmfre ;free the memory of the device return chaxpp: ;transmit physical put push r3,r2,r0,r1 ;put byte on top mov r0,r3 ;put channel in r3 5$: mov $chccn(r4),r0 ;get chaos connection if eq,< 9$: mov #-1,usrerr(r5) 10$: pop r1,r0,r2,r3 return > 15$: mov $ccxpk(r0),r1 ;get stream output packet if eq,< loop < mov #$cpkdt+20,r1 call cpkall if eq,< bit #%clnhg,$clmod(r3) if ne,< 20$: bis #%clnhh,$clmod(r3) br 10$ > call $fsmhng ifpclsr
rptl > mov r1,$ccxpk(r0) > > ;r1 is packet bit #%clmst,$clmod(r3) if eq,< cmp $pktbc(r1),#20 if lt,< call cpkgro if eq,< ;maybe send the packet loop < call cpkxok ;is it ok to send? blt 9$ if gt,< clr $ccxpk(r0) call cpkdto br 5$ > bit #%clnhg,$clmod(r3) bne 20$ call cpkwtx ifpclsr
rptl ;try again for transmit permission > > mov r1,$ccxpk(r0) ;reset it > > movb (sp),@$pktbp(r1) ;r1 is a packet with room in it inc $pktbp(r1) inc $cpknb(r1) dec $pktbc(r1) bit #%clcon,$clmod(r3) if ne, br 10$ charpg: ;chaos receive physical get push r3,r2,r0 mov r0,r3 5$: mov $chccn(r4),r0 ;get the chaos connection if eq,< 9$: mov #-1,usrerr(r5) 10$: pop r0,r2,r3 return > mov $ccrpk(r0),r1 ;get stream input packet if eq,< call cpkpki if eq,< bcs 9$ ;if there is an error bit #%clnhg,$clmod(r3) ;no packet, maybe hang if ne,< bis #%clnhh,$clmod(r3) mov #-1,r1 ;random value for no hang br 10$ > call cpkwti ifpclsr
br 5$ > tst $cpknb(r1) if eq,< call cpkfre br 5$ > mov r1,$ccrpk(r0) > pushb @$pktbp(r1) ;the byte inc $pktbp(r1) dec $pktbc(r1) if eq,< clr $ccrpk(r0) call cpkfre > popb r1 bic #mask8,r1 br 10$ cnpstr: ;perform stream functions loop < .regs #2,#0 .sleep mov #chtcon,r5 loop < mov (r5)+,r0 ;get a connection if ne,< mov $ccxpk(r0),r1 ;get pending stream output packet if ne,< call cpkxok ;may I transmit if gt,< clr $ccxpk(r0) call cpkdto > > > cmp r5,#chtcon+<2*chcncn> rptl lo > rptl > .endc .endc %defin .iif nz %defin, .list ;start listing as usual ;; local modes: ;; mode:midas ;; auto fill mode: ;; fill column:75 ;; comment column:32 ;; end: