github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-03-24 09:30:29 +00:00
Code Issues Releases Wiki Activity
Files
2df88f35cb340263404e0153e6d22b5c6d5e9827
PDP-10.its/src/mits_s/chsncp.49
Lars Brinkhoff f85b53d480 MINITS - mini-ITS network utility.
2018-11-25 20:59:17 +01:00

2689 lines
69 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
.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==<nnet-1>*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 <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,<call cpkfilter> ;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,<jcall chcfs'num>
.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 <Service not available over microwave link.>
call cpkaz1
movb #%cocls,$cpkop(r1)
call cpkrvs
pop r0,r4,r5
return
updash==<'->&<-1-40> ;pseudo uppercasified dash
200$: .litrl <.asciz /BAND/<updash>/TRANSFER/>
.litrl <.asciz /EVAL/>
.litrl <.asciz /MINI/>
.litrl <.asciz /REMOTE/<updash>/DISK/>
.litrl <.asciz /SPY/>
.litrl <.asciz /DIAL/>
.litrl <.asciz /PRIME/>
.litrl <.asciz /SCICARDS/
.even>
.litrl <.asciz /FOOBAR/>
.litrl <.asciz /FOO/<updash>/BAR/
.even>
0
.endc df chffSYMBOLICS
;;
;;;;;; Packet routines
;;
cpkall: cmp r1,#l$cpk
if hi,<
clr r1
return
>
call pktall
if eq,<return>
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,<mov #l$cpk,$pktbc(r1)>
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,<clr chtcon(r0)> ;if so, I go away
else <bpt> ;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,<mov #-1,$ccnib(r0)> ;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,<call cpkfre> ;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,<incb chvuni> ;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,<mov #-1,$ccnib(r0)> ;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 <inc $ccnib(r0)
rptl le> ;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 ;<explain this clearly>
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 <if eq,< ;put it on the back
10$: mov r1,@$ccibe(r0) ;do the putting
mov r1,$ccibe(r0) ;and make it the back
bis $ccebr(r0),@$ccepr(r0) ;set event bits
bisb #%ccrcp,$ccflg(r0) ;declare this connection in need of
loop <inc $ccnib(r0)
rptl eq>
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,<jcall cpkfre> ;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,<jcall cpkfre> ;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,<bis $ccebx(r0),@$ccepx(r0)> ;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,<movb $cpksn(r1),r5> ;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,<mov chtrou(r5),(sp)> ;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,<bicb #%ccrcp,$ccflg(r0)> ;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 <send it out, controlled packet>
;;; +2 br <send it out once, uncontrolled packet>
;;; +4 br <error -- incorrect state or somesuch>
;;; +6 br <was a LSN -- pretend it was sent>
;;; +8 br <UNC -- send once, don't set ack field>
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,<mov #100,$cclwn(r0)>
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,<mov #cnvipq,cnvipe> ;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,<inc (r4)> ;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,<call @$ntfls(r5)> ;go flush xmit packets
cmp nt$chs(r5),#pktngv ;does it talk chaos?
if ne,<
mov #$cpkdt+<chcmsn*4>,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,<pop *>
else <pop (sp)>
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,<jmp @#bootad> ;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 <MAIL>,cxmail
.iif z system-26, chscnm <NAME>,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,<jcall cpkfre> ;if unknown, don't answer
.if df brdtim
cmpb $cpkop(r1),#%cobrd
if eq,<jcall cpkfre> ;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. <interface index * 2>+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 <start address>,<stack size>,<priority>
;;; <do something>
;;; pop r2
;;; jcall cprrfg
;;; returns with
;;; r0/ connection
;;; r1/ packet
;;; r2/ pointer to server's r1 (server's r0 = connection)
;;; by macro:
;;; cx$srv <start address>,<stack size>,<priority>,<code>
.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 <MAIL>
>
cxname:
cx$srv cxgate,40,40_8,<
mov #12035,(r2)+ ;r1 has host
mov (pc)+,(r2)+ ;r2 has contact name
.string <NAME>
>
.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 <ECHO> ;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 <SUPDUP> ;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,<call cpkfre>
mov r4,r0
if ne,<call ccnfre>
mov r5,r1
if ne,<call cpkfre>
.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 *
exitl>
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,<mov r2,r0 ;get connection 1
call cpkpki ;and try and get a packet
bcs 110$> ;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,<mov r4,r0 ;get connection 2
call cpkpki ;try and get a packet
bcs 110$> ;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,<mov r4,r0 ;get connection 2
add #$ccnos,r0>;hang waiting for output slot
else <mov r2,r0 ;get connection 1
add #$ccnib,r0>;else wait for incoming packet
tst r5 ;is there a conn 2 packet
if ne,<mov r2,r1 ;get connection 1
add #$ccnos,r1>;hang waiting for output slot
else <mov r4,r1 ;get connection 2
add #$ccnib,r1>;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,<mov #1,usrerr(r5)>
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 <br 10$>
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 <br 10$>
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,<bis #%clmst,$clmod(r3)>
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 10$>
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:
Reference in New Issue View Git Blame Copy Permalink