mirror of
https://github.com/PDP-10/its.git
synced 2026-01-31 22:12:14 +00:00
Eric Swenson
committed by
Lars Brinkhoff
Lars Brinkhoff
parent
3a30a157f1
commit
ad686dd778
713
src/bawden/itsdev.102
Executable file
713
src/bawden/itsdev.102
Executable file
@@ -0,0 +1,713 @@
|
||||
; -*- Midas -*-
|
||||
|
||||
title ITSDEV - ITS device server.
|
||||
|
||||
a=:1
|
||||
b=:2
|
||||
c=:3
|
||||
d=:4
|
||||
cmd=:5
|
||||
t=:6
|
||||
tt=:7
|
||||
t2=:10
|
||||
e=:11 ; Error code
|
||||
|
||||
ip=:14 ; Input block pointer
|
||||
op=:15 ; Output block pointer
|
||||
bp=:16 ; Buffer pointer
|
||||
p=:17
|
||||
|
||||
ch==:0,,-1
|
||||
chneti==:1
|
||||
chneto==:2
|
||||
chdev==:3
|
||||
|
||||
%fr==:0,,525252
|
||||
%fl==:1,,525252
|
||||
%flin==:200000 ; Channel is open for input
|
||||
%flout==:100000 ; Channel is open for output
|
||||
%flnet==:040000 ; Network input interrupts clear this flag
|
||||
%fltcp==:020000 ; Using TCP, not Chaos
|
||||
%fllos==:010000 ; Losing...
|
||||
|
||||
call=:pushj p,
|
||||
return=:popj p,
|
||||
save==:push p,
|
||||
rest==:pop p,
|
||||
flose=:.lose %lsfil
|
||||
slose=:.lose %lssys
|
||||
|
||||
quit=:call .
|
||||
$quit: skipe debug
|
||||
.break 16,100000
|
||||
.logout 1,
|
||||
|
||||
define bltdup org,len
|
||||
move tt,[<org>,,<org>+1]
|
||||
blt tt,<org>+<len>-1
|
||||
termin
|
||||
|
||||
define syscall name,args
|
||||
.call [setz ? .1stwd sixbit /name/ ? args(400000)]
|
||||
termin
|
||||
|
||||
define conc foo,bar
|
||||
foo!bar!termin
|
||||
|
||||
popj1: aos (p)
|
||||
cpopj: return
|
||||
|
||||
itsdvu"$$defs==:1 ; Just get the definitions
|
||||
.insrt itsdvu >
|
||||
|
||||
.vector pdl(lpdl==:100.)
|
||||
.scalar cname ; contact name
|
||||
|
||||
usrvar: sixbit /OPTION/ ? tlo %opint\%opopc
|
||||
sixbit /MASK/ ? move [%pipdl\%piioc]
|
||||
sixbit /MSK2/ ? movei 1_chneti
|
||||
sixbit /HSNAME/ ? move cname
|
||||
lusrvar==:.-usrvar
|
||||
|
||||
dbg: setom debug ; Debugging entry point
|
||||
move 0,[chname sixbit /,/]
|
||||
.value [asciz ""]
|
||||
go: move p,[-lpdl,,pdl-1] ; Normal entry point
|
||||
.close 1,
|
||||
movem 0,cname
|
||||
setzi 0, ; Clear flags
|
||||
move t,[-lusrvar,,usrvar]
|
||||
syscall usrvar,[movei %jself ? move t]
|
||||
slose
|
||||
move a,cname
|
||||
camn a,[chname sixbit /,/]
|
||||
jrst chago
|
||||
camn a,[tcport sixbit /SYN,/]
|
||||
jrst tcpgo
|
||||
.value
|
||||
|
||||
gogo: call brecv
|
||||
jrst @cmdtab(cmd)
|
||||
|
||||
cmdtab: offset -.
|
||||
opdata:: adata
|
||||
oplast:: alast
|
||||
opread:: aread
|
||||
opsync:: async
|
||||
opopen:: aopen
|
||||
opclose:: aclose
|
||||
opscall:: ascall
|
||||
opxcall:: axcall
|
||||
oplink:: alink
|
||||
opmax:: offset 0
|
||||
repeat 20-<.-cmdtab>, aerror
|
||||
|
||||
axcall: move c,6(bp)
|
||||
camn c,[sixbit /MTAPE/]
|
||||
jrst amtape
|
||||
camn c,[sixbit /LOGIN/]
|
||||
jrst alogin
|
||||
camn c,[sixbit /RENAME/]
|
||||
jrst a6call
|
||||
jrst rerr+%enscl
|
||||
|
||||
lbuffer==:2000
|
||||
.vector buffer(lbuffer+6) ; I/O buffer, with room for extra block
|
||||
|
||||
adata: tlne %flout
|
||||
jrst adata0
|
||||
movei d,%ensio
|
||||
movei c,7 ; 7 words (the first!) not written
|
||||
jrst adata5 ; Go wait for the OPLAST
|
||||
|
||||
alast: tlne %flout
|
||||
jrst alast0
|
||||
move c,6(bp)
|
||||
jrst rerr+%ensio
|
||||
|
||||
adata0: movei bp,7(bp)
|
||||
cail bp,buffer+lbuffer ; Still room?
|
||||
jrst adata1
|
||||
adata2: call recv
|
||||
ifn opdata, .err OPDATA must be 0
|
||||
jumpe cmd,adata0
|
||||
caie cmd,oplast
|
||||
jsp t,rlose
|
||||
alast0: move c,6(bp)
|
||||
cail c,0
|
||||
caile c,6
|
||||
jsp t,rlose
|
||||
addi bp,(c)
|
||||
hrloi t,-1-buffer(bp)
|
||||
eqvi t,buffer
|
||||
jumpge t,rvals ; Don't trust your luck...
|
||||
syscall iot,[moves e ? movei chdev ? move t]
|
||||
caia
|
||||
jrst rvals
|
||||
movei c,(bp)
|
||||
subi c,(t) ; C: # words not written
|
||||
jrst rerror
|
||||
|
||||
adata1: move t,[-lbuffer,,buffer]
|
||||
syscall iot,[moves d ? movei chdev ? move t]
|
||||
jrst adata3
|
||||
movei bp,-lbuffer(bp)
|
||||
move t,[buffer+lbuffer,,buffer]
|
||||
blt t,buffer+5 ; Copy down 6 words
|
||||
jrst adata2
|
||||
|
||||
adata3: movei c,(bp)
|
||||
subi c,(t) ; C: # words not written
|
||||
jrst adata5
|
||||
|
||||
adata4: addi c,7 ; 7 more words not written
|
||||
adata5: ;; Error code is in D to avoid clobberage.
|
||||
call brecv
|
||||
ifn opdata, .err OPDATA must be 0
|
||||
jumpe cmd,adata4
|
||||
caie cmd,oplast
|
||||
jsp t,rlose
|
||||
add c,6(bp) ; last 0 to 6 words not written
|
||||
move e,d
|
||||
jrst rerror
|
||||
|
||||
aread: tlnn %flin
|
||||
jrst rerr+%ensio
|
||||
skipge d,0(bp) ; D: # words requested
|
||||
jrst rerr+%ebdrg
|
||||
movei c,buffer ; C: -> BUFFER
|
||||
jrst aread1
|
||||
|
||||
aread2: movei cmd,rsdata
|
||||
call send
|
||||
movei a,7(a)
|
||||
aread0: caig a,-7(c)
|
||||
jrst aread2
|
||||
hrli t,(a)
|
||||
hrri t,buffer
|
||||
blt t,buffer+5 ; Copy down 6 words
|
||||
subi c,-buffer(a)
|
||||
aread1: movei a,buffer
|
||||
jumple d,aread7 ; If no more wanted, flush buffer
|
||||
movei t,lbuffer
|
||||
camle t,d
|
||||
movei t,(d)
|
||||
subi d,(t)
|
||||
movni t,(t)
|
||||
hrli c,(t)
|
||||
syscall iot,[moves e ? movei chdev ? move c]
|
||||
jrst aread5
|
||||
jumpge c,aread0 ; Usual case, go empty buffer
|
||||
tdza d,d ; EOF => D = 0
|
||||
aread5: setoi d, ; Error => D = -1
|
||||
jrst aread0 ; Don't ask for more after emptying buffer
|
||||
|
||||
aread7: movei t,-buffer(c)
|
||||
movem t,buffer+6
|
||||
movei cmd,rslast
|
||||
call send
|
||||
jumpe d,rvals
|
||||
jrst rerror
|
||||
|
||||
ascall: hlrz t,5(bp)
|
||||
trze t,400000
|
||||
jrst ancall
|
||||
caige t,1
|
||||
jrst rerr+%etfrg
|
||||
caile t,6
|
||||
jrst rerr+%etmrg
|
||||
xscall: xct ascltb-1(t)
|
||||
jrst rerror
|
||||
jrst rvals
|
||||
|
||||
ascltb:
|
||||
repeat 6,[
|
||||
syscall call,[moves e ? move 6(bp) ? movei chdev
|
||||
repeat .rpcnt, move .rpcnt(bp)
|
||||
repeat 7, movem vals+.rpcnt
|
||||
movs 5(bp)]
|
||||
] ; repeat 6
|
||||
|
||||
ancall: caige t,0
|
||||
jrst rerr+%etfrg
|
||||
caile t,5
|
||||
jrst rerr+%etmrg
|
||||
xncall: xct ancltb(t)
|
||||
jrst rerror
|
||||
jrst rvals
|
||||
|
||||
ancltb:
|
||||
repeat 6,[
|
||||
syscall call,[moves e ? move 6(bp)
|
||||
repeat .rpcnt, move .rpcnt(bp)
|
||||
repeat 7, movem vals+.rpcnt
|
||||
movs 5(bp)]
|
||||
] ; repeat 6
|
||||
|
||||
a6call: syscall call,[moves e ? move 6(bp)
|
||||
move 0(bp) ? move 1(bp) ? move 2(bp) ? move 3(bp)
|
||||
move 4(bp) ? move 5(bp)]
|
||||
jrst rerror
|
||||
jrst rvals
|
||||
|
||||
amtape: tlnn %flin\%flout
|
||||
jrst rerr+%ensch
|
||||
movei a,0(bp)
|
||||
hrli a,chdev
|
||||
xmtape: .mtape a,
|
||||
jrst rerr+0 ; Non-specific error
|
||||
movem a,vals+0
|
||||
jrst rvals
|
||||
|
||||
xerror: hlrzm c,e
|
||||
movei t,rerror
|
||||
movem t,intpc(p)
|
||||
.call dismis
|
||||
slose
|
||||
|
||||
aerror: jsp t,rlose
|
||||
|
||||
aopen: tlz %flin\%flout ; Now closed
|
||||
hrrz t,4(bp)
|
||||
trnn t,%doblk ; Block mode only
|
||||
jrst rerr+%ensmd
|
||||
syscall open,[moves e ? movsi (t) ? movei chdev
|
||||
move 0(bp) ? move 1(bp) ? move 2(bp) ? move 3(bp)]
|
||||
jrst rerror
|
||||
tlo %flin ; Now open for input
|
||||
trne t,%doout
|
||||
tlc %flin#%flout ; Make that output
|
||||
jrst rvals
|
||||
|
||||
aclose: tlz %flin\%flout
|
||||
.close chdev,
|
||||
jrst rvals
|
||||
|
||||
alink: syscall mlink,[moves e
|
||||
move 0(bp) ? move 1(bp) ? move 2(bp) ? move 3(bp)
|
||||
move 4(bp) ? move 5(bp) ? move 6(bp)]
|
||||
jrst rerror
|
||||
jrst rvals
|
||||
|
||||
async: movei a,0(bp)
|
||||
movei cmd,rssync
|
||||
call send
|
||||
call flush
|
||||
call brecv
|
||||
jrst @cmdtab(cmd)
|
||||
|
||||
xuvars: sixbit /XUNAME/ ? move 0(bp)
|
||||
sixbit /XJNAME/ ? move 1(bp)
|
||||
sixbit /SNAME/ ? move 2(bp)
|
||||
sixbit /HSNAME/ ? move cname
|
||||
lxuvars==:.-xuvars
|
||||
|
||||
.scalar clvers,clprog ; Save client version and program name
|
||||
|
||||
alogin: move t,4(bp)
|
||||
movem t,clvers
|
||||
move t,5(bp)
|
||||
movem t,clprog
|
||||
move c,0(bp)
|
||||
syscall login,[moves e ? move c ? move 3(bp) ? move 0(bp)]
|
||||
jsp t,alogn7
|
||||
movem c,vals+0
|
||||
move c,1(bp)
|
||||
syscall usrvar,[moves e ? movei %jself ? [sixbit /JNAME/] ? move c]
|
||||
jsp t,alogn7
|
||||
movem c,vals+1
|
||||
move t,[-lxuvars,,xuvars]
|
||||
syscall usrvar,[movei %jself ? move t]
|
||||
slose
|
||||
move t,[.fvers]
|
||||
movem t,vals+2
|
||||
jrst rvals
|
||||
|
||||
alogn7: cain e,%eexfl
|
||||
aoja c,-2(t)
|
||||
skipe debug ; If you are debugging
|
||||
jrst (t) ; Then don't sweat the small stuff
|
||||
jrst rerror
|
||||
|
||||
.vector vals(7)
|
||||
|
||||
; JRST RVALS to return values in VALS.
|
||||
rvals: movei cmd,rsvals
|
||||
call vsend
|
||||
call brecv
|
||||
jrst @cmdtab(cmd)
|
||||
|
||||
; JRST RERR+<n> to report error <n>.
|
||||
rerr:
|
||||
repeat 100, jsp e,rerr1
|
||||
|
||||
; JRST RERROR to report error in E.
|
||||
rerr1: movei e,-<rerr+1>(e)
|
||||
rerror: move a,[c,,vals] ; Send him:
|
||||
blt a,vals+6 ; C, D, CMD, T, TT, T2, E
|
||||
movei cmd,rserror
|
||||
call vsend
|
||||
call flush ; Make sure he gets it as soon as possible.
|
||||
call brecv
|
||||
jrst @cmdtab(cmd)
|
||||
|
||||
; JSP T,RLOSE to report fatal lossage.
|
||||
rlose: tloe %fllos
|
||||
.lose ; Don't lose recursively
|
||||
move a,[c,,vals] ; Send him:
|
||||
blt a,vals+6 ; C, D, CMD, T, TT, T2, E
|
||||
movei cmd,rslose
|
||||
call vsend
|
||||
call flush
|
||||
syscall finish,[movei chneto]
|
||||
jfcl
|
||||
quit
|
||||
|
||||
.scalar incnt ; Number of blocks available for reading
|
||||
|
||||
; CALL RECV: Receive next 7 words
|
||||
; BP (a/v): Address of 7 word input block
|
||||
; CMD (val): 4 bit opcode
|
||||
brecv: movei bp,buffer
|
||||
recv: sosge incnt
|
||||
jrst recv1 ; No blocks available, get more
|
||||
move cmd,0(ip)
|
||||
lsh cmd,-4
|
||||
repeat 7,[
|
||||
move t,.rpcnt+1(ip)
|
||||
lshc cmd,-4
|
||||
movem t,.rpcnt(bp)
|
||||
] ; repeat 7
|
||||
movei ip,8(ip)
|
||||
return
|
||||
|
||||
recv2: skiple incnt
|
||||
jrst recv
|
||||
call flush ; Don't hang with buffered output
|
||||
tlne %flnet
|
||||
.hang
|
||||
recv1: save [recv2]
|
||||
tlnn %fltcp
|
||||
jrst chaget
|
||||
jrst tcpget
|
||||
|
||||
.scalar outcnt
|
||||
|
||||
; CALL SEND: Send next 7 words
|
||||
; CMD (arg): 4 bit opcode
|
||||
; A (a/v): Address of 7 word output block
|
||||
vsend: movei a,vals
|
||||
send:
|
||||
repeat 7,[
|
||||
move t,6-.rpcnt(a)
|
||||
lshc cmd,4
|
||||
movem t,7-.rpcnt(op)
|
||||
] ; repeat 7
|
||||
lsh cmd,4
|
||||
movem cmd,0(op)
|
||||
movei op,8(op)
|
||||
sosle outcnt
|
||||
return
|
||||
flush: tlnn %fltcp ; No more blocks empty, send them off
|
||||
jrst chafls
|
||||
jrst tcpfls
|
||||
|
||||
; Network
|
||||
|
||||
.insrt dsk:syseng;chsdef >
|
||||
|
||||
chacnt==:<%cpmxw-%cpkdt>/8 ; Chaos: a packet's worth of blocks
|
||||
tcpcnt==:160. ; TCP: 160. blocks
|
||||
.see maxcnt ; A look at the ITS TCP code suggests that it might offer
|
||||
; as much as 4820. bytes (150. blocks). Experiments with
|
||||
; MAXCNT have seen TCP offer as much as 4768. bytes (149.
|
||||
; blocks), but usually when things get backed up it offers
|
||||
; 3856. (120. blocks). (Note that a disk block of 2000
|
||||
; words fits in 147. blocks.)
|
||||
|
||||
; Make buffers big enough for both:
|
||||
ifge <tcpcnt*8>-%cpmxw, liobuf==:<tcpcnt*8>
|
||||
.else, liobuf==:%cpmxw
|
||||
|
||||
.vector inbuf(liobuf)
|
||||
.vector outbuf(liobuf)
|
||||
|
||||
; Chaosnet
|
||||
|
||||
$cpknx==:$cpknb+<050000,,0>-<000500,,0>
|
||||
|
||||
ifn $cpkop&777777, .err $CPKOP not in first word?
|
||||
ifn $cpknb&777777, .err $CPKNB not in first word?
|
||||
|
||||
define cpkop (op,nb)
|
||||
<.dpb <op>,$cpkop,<.dpb <nb>,$cpknb,0>>!termin
|
||||
|
||||
pktin: setz ? sixbit /PKTIOT/
|
||||
moves e
|
||||
movei chneti
|
||||
setzi inbuf
|
||||
|
||||
pktout: setz ? sixbit /PKTIOT/
|
||||
moves e
|
||||
movei chneto
|
||||
setzi outbuf
|
||||
|
||||
chago: syscall chaoso,[movei chneti ? movei chneto ? movei 15]
|
||||
slose
|
||||
move t,[cpkop %colsn,<chname .length ",">]
|
||||
movem t,outbuf+0
|
||||
move t,[440700,,[chname asciz ","]]
|
||||
move tt,[440800,,outbuf+%cpkdt]
|
||||
chago1: ildb t2,t
|
||||
idpb t2,tt
|
||||
jumpn t2,chago1
|
||||
.call pktout
|
||||
slose
|
||||
movei tt,5*30. ; 5 seconds
|
||||
skipe debug
|
||||
movei tt,60.*60.*30. ; 1 hour
|
||||
syscall netblk,[movei chneti ? movei %cslsn ? move tt ? movem t]
|
||||
slose
|
||||
caie t,%csrfc
|
||||
quit
|
||||
.call pktin
|
||||
slose
|
||||
move t,[cpkop %coopn,0]
|
||||
movem t,outbuf+0
|
||||
.call pktout
|
||||
slose
|
||||
move t,[cpkop %codat,0]
|
||||
movem t,outbuf+0
|
||||
call chflsi
|
||||
call chgeti
|
||||
jrst gogo
|
||||
|
||||
chafls: movei t,chacnt
|
||||
sub t,outcnt
|
||||
jumpe t,cpopj
|
||||
dpb t,[$cpknx outbuf]
|
||||
.call pktout
|
||||
jrst chalos
|
||||
chflsi: movei t,chacnt
|
||||
movem t,outcnt
|
||||
movei op,outbuf+%cpkdt
|
||||
return
|
||||
|
||||
chalos: caie e,12000 ; CHNL IN ILLEGAL MODE ON IOT?
|
||||
.lose ; No, can't JSP T,RLOSE
|
||||
quit ; Yes, well it can happen...
|
||||
|
||||
.scalar pktcnt ; # packets we know system has for us
|
||||
|
||||
chgeti: setzm incnt
|
||||
setzm pktcnt
|
||||
return
|
||||
|
||||
chagt1: tlo %flnet
|
||||
syscall whyint,[movei chneti ? movem tt ? movem tt ? movem t]
|
||||
slose
|
||||
caie tt,%csopn
|
||||
quit ; Not open? He must not care what we do!
|
||||
tlnn t,-1
|
||||
return
|
||||
hlrzm t,pktcnt
|
||||
chaget: sosge pktcnt
|
||||
jrst chagt1
|
||||
.call pktin
|
||||
jsp t,rlose
|
||||
ldb tt,[$cpkop inbuf]
|
||||
ldb t2,[$cpknb inbuf]
|
||||
caie tt,%cocls ; Close (should be impossible)
|
||||
cain tt,%coeof ; or EOF
|
||||
quit ; then quit
|
||||
cain tt,%codat
|
||||
trne t2,37
|
||||
jsp t,rlose
|
||||
lsh t2,-5
|
||||
jumple t2,chaget
|
||||
movem t2,incnt
|
||||
movei ip,inbuf+%cpkdt
|
||||
return
|
||||
|
||||
; TCP
|
||||
|
||||
tcpcnt==:liobuf/8
|
||||
|
||||
tcpgo: tlo %fltcp
|
||||
syscall tcpopn,[movei chneti ? movei chneto
|
||||
movei <tcport 0,> ? [-1] ? [-1]]
|
||||
slose
|
||||
movei tt,5*30. ; 5 seconds
|
||||
skipe debug
|
||||
movei tt,60.*60.*30. ; 1 hour
|
||||
movei t,%ntlsn
|
||||
tcpgo1: syscall netblk,[movei chneto ? move t ? move tt
|
||||
movem t ? movem tt]
|
||||
slose
|
||||
skipg tt
|
||||
quit ; Time ran out
|
||||
cain t,%ntsyr
|
||||
jrst tcpgo1 ; Can pass though %NTSYR
|
||||
caie t,%ntopn
|
||||
cain t,%ntwrt
|
||||
caia
|
||||
quit ; Wrong state
|
||||
call tpflsi
|
||||
call tpgeti
|
||||
jrst gogo
|
||||
|
||||
tcpfls: movei t,tcpcnt
|
||||
sub t,outcnt
|
||||
jumpe t,cpopj
|
||||
lsh t,5
|
||||
move tt,[440800,,outbuf]
|
||||
syscall siot,[moves e ? movei chneto ? move tt ? move t]
|
||||
.lose ; Can't JSP T,RLOSE
|
||||
syscall force,[moves e ? movei chneto]
|
||||
.lose ; Can't JSP T,RLOSE
|
||||
tpflsi: movei t,tcpcnt
|
||||
movem t,outcnt
|
||||
movei op,outbuf
|
||||
return
|
||||
|
||||
; TCP input is coded in this crazy way because there is a bug in WHYINT
|
||||
; such that you can't trust the results of a WHYINT unless you have read
|
||||
; every last byte that it told you about the last time you called it.
|
||||
|
||||
.scalar bytcnt ; # unread bytes still in system
|
||||
.scalar maxcnt ; Largest BYTCNT ever seen (for debugging)
|
||||
.scalar xtrabc ; # bytes at start of INBUF
|
||||
.scalar xtrabp ; BP to space in INBUF
|
||||
|
||||
tpgeti: setzm incnt
|
||||
setzm bytcnt
|
||||
setzm maxcnt
|
||||
jrst tcpgtj
|
||||
|
||||
tcpgtx: ;; Screw case: Before we can call WHYINT, we must pull the last
|
||||
;; few extra bytes out of the system into the beginning of the
|
||||
;; INBUF. (Note how the SIOT below advances XTRABP and clears
|
||||
;; BYTCNT correctly!)
|
||||
movem t,xtrabc
|
||||
syscall siot,[moves e ? movei chneti ? move xtrabp ? move bytcnt]
|
||||
jsp t,rlose
|
||||
tcpgt1: tlo %flnet
|
||||
syscall whyint,[movei chneti ? movem tt ? movem tt ? movem t]
|
||||
slose
|
||||
caie tt,%ntinp ; Input available?
|
||||
jrst [ caie tt,%ntopn ; No, still open?
|
||||
quit ; No. Then he must not care what we do!
|
||||
return ]
|
||||
movem t,bytcnt
|
||||
camle t,maxcnt
|
||||
movem t,maxcnt
|
||||
tcpget: skipg t,bytcnt
|
||||
jrst tcpgt1
|
||||
add t,xtrabc ; T: # bytes available
|
||||
caige t,40
|
||||
jrst tcpgtx ; Not enough for a block, screw case
|
||||
lsh t,-5 ; T: # blocks available
|
||||
caile t,tcpcnt
|
||||
movei t,tcpcnt
|
||||
movem t,incnt ; INCNT: # blocks that will fit this time
|
||||
lsh t,5
|
||||
sub t,xtrabc ; T: # bytes we have to read to get there
|
||||
movni tt,(t)
|
||||
addm tt,bytcnt ; BYTCNT: # bytes that will leave in system
|
||||
syscall siot,[moves e ? movei chneti ? move xtrabp ? move t]
|
||||
jsp t,rlose
|
||||
movei ip,inbuf
|
||||
tcpgtj: move t,[440800,,inbuf]
|
||||
movem t,xtrabp ; When he comes back, there won't
|
||||
setzm xtrabc ; be any extra.
|
||||
return
|
||||
|
||||
; Interrupts
|
||||
|
||||
intsv0==:a ; Save A
|
||||
intsv9==:t2 ; Through T2
|
||||
intsvn==:intsv9+1-intsv0
|
||||
|
||||
intctl==:400000+intsv0_6+intsvn ; control bits
|
||||
intpc==:-<3+intsvn> ; INTPC(P) is PC before interrupt.
|
||||
intdf1==:intpc-2 ; INTDF1(P) is .DF1 before interrupt.
|
||||
intdf2==:intpc-1 ; INTDF2(P) is .DF2 before interrupt.
|
||||
intrq1==:intpc-4 ; INTRQ1(P) are first word bits.
|
||||
intrq2==:intpc-3 ; INTRQ2(P) are second word bits.
|
||||
intac0==:intpc+1-intsv0 ; INTAC0+C(P) is C before interrupt.
|
||||
|
||||
tsint:
|
||||
loc 42
|
||||
-ltsint,,tsint
|
||||
loc tsint
|
||||
intctl,,p
|
||||
%piioc ? 0 ? -1 ? -1 ? iocint
|
||||
0 ? 1_chneti ? 0 ? 1_chneti ? netint
|
||||
ltsint==:.-tsint
|
||||
|
||||
dismis: setz ? sixbit /DISMIS/ ? movsi intctl ? setz p
|
||||
|
||||
; JRST LOSINT to dismis interrupt and do .LOSE at interrupting PC.
|
||||
losint: move t,intrq1(p)
|
||||
jffo t,.+2
|
||||
caia ; So just .LOSE 0
|
||||
addi tt,1
|
||||
hrl tt,intpc(p)
|
||||
syscall dismis,[movsi intctl ? move p ? move intpc(p)
|
||||
move intdf1(p) ? move intdf2(p) ? move tt]
|
||||
slose
|
||||
|
||||
; Network input interrupts just clear %FLNET.
|
||||
netint: tlz %flnet
|
||||
.call dismis
|
||||
slose
|
||||
|
||||
; IOC interrupt of .CALL with error return argument just fails to skip and
|
||||
; returns with IOC error number as error code.
|
||||
iocint: hrrz a,intpc(p)
|
||||
.suset [.rbchn,,b]
|
||||
syscall status,[movei (b) ? movem c]
|
||||
slose
|
||||
tlnn c,-100 ; Better not look like standard error
|
||||
.lose
|
||||
caie a,xscall ; Special cases for various reasons
|
||||
cain a,xmtape
|
||||
jrst xerror
|
||||
cain a,xncall
|
||||
jrst xerror
|
||||
move b,(a)
|
||||
tlc b,(.call)
|
||||
movsi t,(setz)
|
||||
tlnn b,-1 ; Better be .CALL [ SETZ ? ... ]
|
||||
came t,(b)
|
||||
jrst losint
|
||||
iocnt2: move t,2(b)
|
||||
tlc t,%clerr
|
||||
tlne t,(7^9 @(17)) ; Unindexed, direct, error return?
|
||||
aoja b,iocnt1 ; Nope, keep looking
|
||||
movei t,(t)
|
||||
caig t,intsv9
|
||||
caige t,intsv0
|
||||
caia
|
||||
addi t,intac0(p) ; Some locations are on the stack now
|
||||
hlrzm c,(t)
|
||||
aos intpc(p)
|
||||
.call dismis
|
||||
slose
|
||||
|
||||
iocnt1: jumpge t,iocnt2
|
||||
jrst losint
|
||||
|
||||
cnst0: ; Today's weird idea...
|
||||
constants
|
||||
repeat <.-cnst0+77>/100, conc cnst,\.rpcnt,=:cnst0+.rpcnt*100
|
||||
|
||||
variables
|
||||
|
||||
debug: 0
|
||||
|
||||
patch::
|
||||
pat: block 100.
|
||||
epatch: -1 ; Make memory exist, end of patch area
|
||||
|
||||
end go
|
||||
666
src/bawden/itsdvu.25
Executable file
666
src/bawden/itsdvu.25
Executable file
@@ -0,0 +1,666 @@
|
||||
; -*- Midas -*-
|
||||
|
||||
subttl ITSDVU
|
||||
|
||||
.begin itsdvu
|
||||
|
||||
; Modification history:
|
||||
; 1/4/89 Alan: Wrote it.
|
||||
|
||||
COMMENT
|
||||
|
||||
File: ITSDVU, Node: Top, Up: (LIB)
|
||||
|
||||
ITSDVU is a .INSRTable MIDAS library for using the ITSDEV server.
|
||||
|
||||
Requires accumulators A, B, C, D, E, F, G, T, TT, and P. TT must be T+1.
|
||||
P should contain a stack pointer.
|
||||
|
||||
Calls CHACON and TCPCON as if they were the routines of those names in NETWRK.
|
||||
|
||||
All definitions made in ITSDVU block.
|
||||
|
||||
Routines: CONNECT, OPEN, CLOSE, READ, WRITE, SCALLn, XCALLn
|
||||
|
||||
|
||||
; end comment
|
||||
|
||||
.auxil ; Don't CREF
|
||||
|
||||
.tyo6 .ifnm1
|
||||
.tyo 40
|
||||
.tyo6 .ifnm2
|
||||
printx / included in this assembly.
|
||||
/
|
||||
|
||||
version==:.ifvrs ; Version of this library (not inserter)
|
||||
|
||||
; Switches
|
||||
|
||||
ifndef $$defs, $$defs==:0 ; 1 => definitions only, generate no code
|
||||
ifndef $$dbug, $$dbug==:0 ; 1 => assemble for debugging library
|
||||
|
||||
|
||||
; Definitions for ITSDEV protocol.
|
||||
|
||||
ifn $$defs, .end itsdvu ; Do definitions in inserter's block
|
||||
|
||||
; Chaosnet contact name:
|
||||
define chname prefix
|
||||
prefix!ITSDEV!termin
|
||||
|
||||
; TCP port number:
|
||||
define tcport prefix
|
||||
prefix!723!termin ; must be exactly 3 octal digits
|
||||
|
||||
; ITSDEV is designed for the convenience of PDP10's running the ITS
|
||||
; operating system. It allows a remote user process to access a single ITS
|
||||
; channel.
|
||||
|
||||
; Both the input and output byte-streams are divided into "blocks" of 32
|
||||
; 8-bit bytes.
|
||||
;
|
||||
; Each block is used to encode 7 36-bit words plus a 4-bit "opcode", using
|
||||
; the following scheme:
|
||||
;
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | high0 | low0 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | high1 | low1 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | high2 | low2 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | high3 | low3 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | high4 | low4 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | high5 | low5 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | high6 | low6 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
;
|
||||
; +
|
||||
;
|
||||
; +-------+
|
||||
; | opcod |
|
||||
; +-------+
|
||||
;
|
||||
; =
|
||||
;
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | opcod | high6 | high5 | high4 | high3 | high2 | high1 | high0 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | low0 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | low1 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | low2 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | low3 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | low4 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | low5 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
; | low6 |
|
||||
; +-------+-------+-------+-------+-------+-------+-------+-------+
|
||||
;
|
||||
; (As usual, these 32-bit words are transmitted high-order byte first.)
|
||||
;
|
||||
; Over Chaosnet (or any packet-oriented protocol), a block is not allowed
|
||||
; to cross a packet boundary.
|
||||
|
||||
; 4-bit opcodes for command blocks:
|
||||
|
||||
..bop==:0,,17
|
||||
|
||||
opdata==:0 ; 7 words of data: <w0> - <w6>.
|
||||
; No response.
|
||||
oplast==:1 ; <w6> words of data: <w0> - <w5>.
|
||||
; Responds with RSVALS or RSERROR.
|
||||
opread==:2 ; Requests <w0> words of data.
|
||||
; Responds with a series of RSDATA blocks, terminated by an
|
||||
; RSLAST, followed by either an RSVALS or RSERROR block.
|
||||
; Or perhaps just an RSERROR block.
|
||||
opsync==:3 ; Synchronize. Also flush out any buffered network output.
|
||||
; Responds with an RSSYNC that echoes back <w0> - <w6>.
|
||||
; (Normally there is no need to use this for flushing
|
||||
; network output because that is done whenever the server
|
||||
; is about to block waiting for network input. However, if
|
||||
; you were about to issue a command that would cause the
|
||||
; server to block for some other reason (perhaps waiting
|
||||
; for device input), then you might send an OPSYNC first to
|
||||
; be sure you get any other buffered response blocks first.)
|
||||
opopen==:4 ; Open <w0>:<w3>;<w1> <w2>. Mode in RH(<w4>).
|
||||
; Responds with RSVALS or RSERROR.
|
||||
opclose==:5 ; Close channel.
|
||||
; Responds with RSVALS or RSERROR.
|
||||
opscall==:6 ; Perform .CALL <w6> with LH(<w5>) arguments (1 - 6).
|
||||
; Bits in RH(<w5>). First argument is CHDEV, <w0> - <w4>
|
||||
; are the remaining arguments.
|
||||
; If 4.9(<w5>) is set, then <w0> - <w4> are the only
|
||||
; LH(<w5>) arguments.
|
||||
; Responds with RSVALS or RSERROR.
|
||||
opxcall==:7 ; Perform extended command named <w6>.
|
||||
; All extended commands respond with RSVALS or RSERROR.
|
||||
oplink==:8 ; Make link from <w0>:<w3>;<w1> <w2> to <w0>:<w6>;<w4> <w5>.
|
||||
; Responds with RSVALS or RSERROR.
|
||||
opmax==:9 ; First unused opcode.
|
||||
|
||||
; 4-bit opcodes for response blocks:
|
||||
|
||||
..brs==:0,,17
|
||||
|
||||
rsdata==:0 ; Same format as OPDATA.
|
||||
rslast==:1 ; Same format as OPLAST.
|
||||
rsvals==:2 ; <w0> - <w6> are values.
|
||||
rserror==:3 ; Reports error <w6>. <w0> words were discarded in case
|
||||
; this is a response to an OPLAST.
|
||||
rslose==:4 ; Irrecoverable lossage.
|
||||
rssync==:5 ; Respond to OPSYNC.
|
||||
|
||||
; Extended commands
|
||||
|
||||
; LOGIN ; Login with XUNAME <w0>, XJNAME <w1>, and SNAME <w2> from
|
||||
; "terminal" <w3>. Client version number in <w4> and
|
||||
; program name in <w5>.
|
||||
; Returns UNAME in <w0> and JNAME in <w1> and server
|
||||
; version number in <w3>.
|
||||
; MTAPE ; Perform .MTAPE [CHDEV,,[<w0>]],.
|
||||
; Returns value in <w0>.
|
||||
; RENAME ; Rename <w0>:<w3>;<w1> <w2> to <w0>:<w3>;<w4> <w5>.
|
||||
|
||||
ifn itsdvu"$$defs, .ineof ; All done if only definitions wanted
|
||||
|
||||
; Utilities
|
||||
|
||||
call=:pushj p,
|
||||
return=:popj p,
|
||||
save==:push p,
|
||||
rest==:pop p,
|
||||
flose=:.lose %lsfil
|
||||
slose=:.lose %lssys
|
||||
|
||||
define syscall name,args
|
||||
.call [setz ? .1stwd sixbit /name/ ? args(400000)]
|
||||
termin
|
||||
|
||||
; JSP TT,ACBLK
|
||||
acblk: save a
|
||||
save b
|
||||
save c
|
||||
save d
|
||||
save e
|
||||
save f
|
||||
save g
|
||||
movei g,-6(p)
|
||||
call (tt)
|
||||
caia
|
||||
aos -7(p)
|
||||
rest g
|
||||
rest f
|
||||
rest e
|
||||
rest d
|
||||
rest c
|
||||
rest b
|
||||
rest a
|
||||
return
|
||||
|
||||
e0popj: movei t,0
|
||||
cpopj: return
|
||||
|
||||
; JSP TT,ACSAV
|
||||
acsav: save g
|
||||
save f
|
||||
save e
|
||||
save d
|
||||
save c
|
||||
save b
|
||||
save a
|
||||
call (tt)
|
||||
caia
|
||||
aos -7(p)
|
||||
rest a
|
||||
rest b
|
||||
rest c
|
||||
rest d
|
||||
rest e
|
||||
rest f
|
||||
rest g
|
||||
return
|
||||
|
||||
.vector vals(7)
|
||||
|
||||
; CALL WRITE: Write data from buffer
|
||||
; Skip if no error
|
||||
; A (a/v): aobjn to buffer, updated
|
||||
; T (val): error code if error
|
||||
write: jsp tt,acsav
|
||||
move g,-1(p) ; G: buffer aobjn
|
||||
write0: caml g,[-6,,0]
|
||||
jrst write1
|
||||
movei t,opdata
|
||||
call gsend
|
||||
add g,[7,,7]
|
||||
jrst write0
|
||||
|
||||
write1: movei t,0
|
||||
jumpge g,write2
|
||||
write3: move tt,(g)
|
||||
movem tt,vals(t)
|
||||
aoj t,
|
||||
aobjn g,write3
|
||||
write2: movem t,vals+6
|
||||
movem g,-1(p) ; Update caller's aobjn
|
||||
movei g,vals
|
||||
movei t,oplast
|
||||
call gcmd
|
||||
jrst write9
|
||||
aos (p)
|
||||
return
|
||||
|
||||
; Preserve error code in T:
|
||||
write9: hrloi a,-2 ; -2,,-1 = -<1,,1>
|
||||
imul a,vals+0
|
||||
addm a,-1(p) ; Correct caller's aobjn
|
||||
return
|
||||
|
||||
; CALL READ: Read data into buffer
|
||||
; Skip if no error
|
||||
; A (a/v): aobjn to buffer, updated
|
||||
; T (val): error code if error
|
||||
read: jsp tt,acsav
|
||||
hlre a,-1(p)
|
||||
movn a,a
|
||||
movei t,opread
|
||||
call send ; Start the data flowing in
|
||||
call flush
|
||||
move g,-1(p) ; G: buffer aobjn
|
||||
jrst read0
|
||||
|
||||
read1: add g,[7,,7]
|
||||
read0: caml g,[-6,,0]
|
||||
jrst read2
|
||||
call grecv
|
||||
ifn rsdata, .err RSDATA assumed to be 0!
|
||||
jumpe t,read1
|
||||
hrli tt,(g)
|
||||
hrri tt,vals+0
|
||||
blt tt,vals+6
|
||||
movem g,-1(p) ; Update caller's aobjn
|
||||
jrst read3
|
||||
|
||||
read2: movem g,-1(p) ; Update caller's aobjn
|
||||
movei g,vals
|
||||
call grecv
|
||||
read3: ;; Now VALS contains the next block. Its opcode is in T. The
|
||||
;; caller's aobjn has been updated for the work so far.
|
||||
cain t,rserror
|
||||
jrst epopj
|
||||
caie t,rslast
|
||||
.lose
|
||||
move tt,vals+6
|
||||
caige tt,0
|
||||
.lose
|
||||
caile tt,6
|
||||
.lose
|
||||
hrloi t,-1(tt)
|
||||
eqvi t,vals+0
|
||||
jumpge t,cmdrs0
|
||||
move a,-1(p) ; A: buffer aobjn
|
||||
read8: skipl a
|
||||
.lose
|
||||
move tt,(t)
|
||||
movem tt,(a)
|
||||
aobjn a,.+1
|
||||
aobjn t,read8
|
||||
movem a,-1(p) ; Update caller's aobjn
|
||||
cmdrs0: movei g,vals
|
||||
jrst gcmdrs
|
||||
|
||||
; CALL CONNECT
|
||||
; Skips if no error
|
||||
; A (arg): Network input channel
|
||||
; B (arg): Foreign host
|
||||
; T (val): Error code if error
|
||||
connec: jsp tt,acsav
|
||||
movem a,inchn
|
||||
movem a,outchn
|
||||
aos outchn
|
||||
tdne b,[-1_16.]
|
||||
tlne b,(-1_32.)
|
||||
jrst chago
|
||||
jrst tcpgo
|
||||
|
||||
; CALL LOGIN: Login (last part of CONNECT)
|
||||
; Skip if no error
|
||||
; T (val): error code if error
|
||||
login: syscall usrvar,[movei %jself ? [sixbit /XUNAME/] ? movem a]
|
||||
slose
|
||||
move b,[sixbit /ITSDEV/]
|
||||
syscall sstatu,[repeat 6,[ ? movem c]]
|
||||
slose
|
||||
move d,c
|
||||
hrri d,(sixbit /DEV/)
|
||||
move e,[version]
|
||||
move f,[.fnam1]
|
||||
move g,[sixbit /LOGIN/]
|
||||
ife $$dbug, jrst xcall
|
||||
ifn $$dbug,[
|
||||
call xcall
|
||||
return
|
||||
format "~&Logged in ~S ~S (version ~D)~&",[a,b,c]
|
||||
aos (p)
|
||||
return
|
||||
] ; ifn $$dbug
|
||||
|
||||
; CALL OPEN: Open
|
||||
; Skip if no error
|
||||
; A (arg): device
|
||||
; B (arg): name1
|
||||
; C (arg): name2
|
||||
; D (arg): directory
|
||||
; E (arg): mode
|
||||
; T (val): error code if error
|
||||
open: jsp tt,acsav
|
||||
movei t,opopen
|
||||
jrst cmd
|
||||
|
||||
; CALL CLOSE: Close
|
||||
; Skip if no error
|
||||
; T (val): error code if error
|
||||
close: jsp tt,acsav
|
||||
movei t,opclose
|
||||
jrst cmd
|
||||
|
||||
.scalar syncnt
|
||||
|
||||
; CALL SYNC: Synchronize
|
||||
sync: jsp tt,acsav
|
||||
aos a,syncnt
|
||||
movei t,opsync
|
||||
call send
|
||||
call flush
|
||||
sync1: call recv
|
||||
cain t,rssync
|
||||
came a,syncnt
|
||||
jrst sync1
|
||||
return
|
||||
|
||||
; CALL XCALL: Do extended command
|
||||
; Skip if no error
|
||||
; A - F (arg): Arguments
|
||||
; G (arg): Extended command name
|
||||
; A - G (val): Values
|
||||
; T (val): Error code if error
|
||||
; CALL SCALL: Do system call
|
||||
; Skip if no error
|
||||
; A - E (arg): <arg2> - <arg6>
|
||||
; F (arg): <# args>,,<control bits>
|
||||
; G (arg): System call name
|
||||
; A - G (val): <val1> - <val7>
|
||||
; T (val): Error code if error
|
||||
; CALL CMD: Do command
|
||||
; Skip if no error
|
||||
; T (arg): Opcode
|
||||
; T (val): Error code if error
|
||||
; CALL GCMD: Do command using block
|
||||
; Skip if no error
|
||||
; G (a/v): Address of block
|
||||
; T (arg): Opcode
|
||||
; T (val): Error code if error
|
||||
; Clobbers F
|
||||
; CALL GCMDRS: Read command response (RSVALS or RSERROR)
|
||||
; Skip if no error
|
||||
; G (a/v): Address of block
|
||||
; T (val): Error code if error
|
||||
; Clobbers F
|
||||
xcall: skipa t,[opxcall]
|
||||
scall: movei t,opscall
|
||||
cmd: jsp tt,acblk
|
||||
gcmd: call gsend
|
||||
call flush
|
||||
gcmdrs: call grecv
|
||||
caie t,rsvals
|
||||
jrst gcmdr1
|
||||
aos (p)
|
||||
return
|
||||
|
||||
gcmdr1: caie t,rserror
|
||||
.lose
|
||||
epopj: move t,6(g)
|
||||
ifn $$dbug, format "~&Error: ~:H (~:E) ~:H ~:H~&",[6(g),6(g),0(g),1(g)]
|
||||
return
|
||||
|
||||
.scalar outcnt
|
||||
.scalar outptr
|
||||
|
||||
; CALL SEND: Send 7 words
|
||||
; A - G (a/v): 7 words to send
|
||||
; T (arg): Opcode
|
||||
; CALL GSEND: Send 7 words from block
|
||||
; G (a/v): Address of 7-word block
|
||||
; T (arg): Opcode
|
||||
; Clobbers F
|
||||
send: jsp tt,acblk
|
||||
gsend: move f,outptr
|
||||
repeat 7,[
|
||||
move tt,6-.rpcnt(g)
|
||||
lshc t,4
|
||||
movem tt,7-.rpcnt(f)
|
||||
] ; repeat 7
|
||||
lsh t,4
|
||||
movem t,0(f)
|
||||
movei f,8(f)
|
||||
movem f,outptr
|
||||
sosle outcnt
|
||||
return
|
||||
flush: skipn tcpp
|
||||
jrst chafls
|
||||
jrst tcpfls
|
||||
|
||||
.scalar incnt
|
||||
.scalar inptr
|
||||
|
||||
; CALL RECV: Receive 7 words
|
||||
; A - G (val): 7 words recieved
|
||||
; T (val): Opcode
|
||||
; CALL GRECV: Receive 7 words into block
|
||||
; G (a/v): Address of 7-word block
|
||||
; T (val): Opcode
|
||||
; Clobbers F
|
||||
recv: jsp tt,acblk
|
||||
grecv: sosge incnt
|
||||
jrst grecv1
|
||||
move f,inptr
|
||||
move t,0(f)
|
||||
lsh t,-4
|
||||
repeat 7,[
|
||||
move tt,1+.rpcnt(f)
|
||||
lshc t,-4
|
||||
movem tt,.rpcnt(g)
|
||||
] ; repeat 7
|
||||
movei f,8(f)
|
||||
movem f,inptr
|
||||
ife $$dbug,[
|
||||
cain t,rslose
|
||||
.lose
|
||||
return
|
||||
] ; ife $$dbug
|
||||
ifn $$dbug,[
|
||||
caie t,rslose
|
||||
return
|
||||
format "~&Lose at ~:H CMD/ ~:H~@
|
||||
Error ~:H (~:E)~@
|
||||
C/ ~:H D/ ~:H TT/ ~:H T2/ ~:H~@
|
||||
",[3(g),2(g),6(g),6(g),0(g),1(g),4(g),5(g)]
|
||||
.lose
|
||||
] ; ifn $$dbug
|
||||
|
||||
grecv1: save [grecv]
|
||||
skipn tcpp
|
||||
jrst chaget
|
||||
jrst tcpget
|
||||
|
||||
; Network
|
||||
|
||||
; Just in case...
|
||||
ifndef $cpkop, .insrt dsk:syseng;chsdef >
|
||||
|
||||
.scalar tcpp
|
||||
|
||||
chacnt==:<%cpmxw-%cpkdt>/8
|
||||
tcpcnt==:160. ; See comment in ITSDEV
|
||||
|
||||
; Make buffers big enough for both:
|
||||
ifge <tcpcnt*8>-%cpmxw, liobuf==:<tcpcnt*8>
|
||||
.else, liobuf==:%cpmxw
|
||||
|
||||
.scalar inchn
|
||||
.scalar outchn
|
||||
|
||||
.vector inbuf(liobuf)
|
||||
.vector outbuf(liobuf)
|
||||
|
||||
; Chaosnet
|
||||
|
||||
$cpknx==:$cpknb+<050000,,0>-<000500,,0>
|
||||
|
||||
ifn $cpkop&777777, .err $CPKOP not in first word?
|
||||
ifn $cpknb&777777, .err $CPKNB not in first word?
|
||||
|
||||
define cpkop (op,nb)
|
||||
<.dpb <op>,$cpkop,<.dpb <nb>,$cpknb,0>>!termin
|
||||
|
||||
pktin: setz ? sixbit /PKTIOT/
|
||||
move inchn
|
||||
setzi inbuf
|
||||
|
||||
pktout: setz ? sixbit /PKTIOT/
|
||||
move outchn
|
||||
setzi outbuf
|
||||
|
||||
chago: setzm tcpp
|
||||
move c,[440700,,[chname asciz ","]]
|
||||
movei d,15
|
||||
call chacon
|
||||
jrst e0popj
|
||||
move t,[cpkop %codat,0]
|
||||
movem t,outbuf+0
|
||||
setzm incnt
|
||||
call chflsi
|
||||
jrst login
|
||||
|
||||
chafls: movei t,chacnt
|
||||
sub t,outcnt
|
||||
jumpe t,cpopj
|
||||
dpb t,[$cpknx outbuf]
|
||||
.call pktout
|
||||
slose
|
||||
chflsi: movei t,outbuf+%cpkdt
|
||||
movem t,outptr
|
||||
movei t,chacnt
|
||||
movem t,outcnt
|
||||
return
|
||||
|
||||
chaget: .call pktin
|
||||
slose
|
||||
ldb t,[$cpkop inbuf]
|
||||
caie t,%codat
|
||||
.lose
|
||||
ldb t,[$cpknb inbuf]
|
||||
trne t,37
|
||||
.lose
|
||||
lsh t,-5
|
||||
jumple t,chaget
|
||||
movem t,incnt
|
||||
movei t,inbuf+%cpkdt
|
||||
movem t,inptr
|
||||
return
|
||||
|
||||
; TCP
|
||||
|
||||
tcpcnt==:liobuf/8
|
||||
|
||||
tcpgo: setom tcpp
|
||||
movei c,<tcport 0,>
|
||||
call tcpcon
|
||||
jrst e0popj
|
||||
call tpgeti
|
||||
call tpflsi
|
||||
jrst login
|
||||
|
||||
tcpfls: movei t,tcpcnt
|
||||
sub t,outcnt
|
||||
jumpe t,cpopj
|
||||
lsh t,5
|
||||
move tt,[440800,,outbuf]
|
||||
syscall siot,[move outchn ? move tt ? move t]
|
||||
slose
|
||||
syscall force,[move outchn]
|
||||
slose
|
||||
tpflsi: movei t,outbuf
|
||||
movem t,outptr
|
||||
movei t,tcpcnt
|
||||
movem t,outcnt
|
||||
return
|
||||
|
||||
; TCP input is coded in this crazy way because there is a bug in WHYINT
|
||||
; such that you can't trust the results of a WHYINT unless you have read
|
||||
; every last byte that it told you about the last time you called it.
|
||||
|
||||
.scalar bytcnt ; # unread bytes still in system
|
||||
.scalar maxcnt ; Largest BYTCNT ever seen (for debugging)
|
||||
.scalar xtrabc ; # bytes at start of INBUF
|
||||
.scalar xtrabp ; BP to space in INBUF
|
||||
|
||||
tpgeti: setzm incnt
|
||||
setzm bytcnt
|
||||
setzm maxcnt
|
||||
jrst tcpgtj
|
||||
|
||||
tcpgtx: ;; Screw case: Before we can call WHYINT, we must pull the last
|
||||
;; few extra bytes out of the system into the beginning of the
|
||||
;; INBUF. (Note how the SIOT below advances XTRABP and clears
|
||||
;; BYTCNT correctly!)
|
||||
movem t,xtrabc
|
||||
syscall siot,[move inchn ? move xtrabp ? move bytcnt]
|
||||
slose
|
||||
tcpgt1: syscall netblk,[move inchn ? movei %ntopn]
|
||||
slose
|
||||
syscall whyint,[move inchn ? movem tt ? movem tt ? movem t]
|
||||
slose
|
||||
caie tt,%ntinp ; Input available?
|
||||
jrst [ caie tt,%ntcli ; Any last dregs of input?
|
||||
.lose
|
||||
jrst .+1 ]
|
||||
movem t,bytcnt
|
||||
camle t,maxcnt
|
||||
movem t,maxcnt
|
||||
tcpget: skipg t,bytcnt
|
||||
jrst tcpgt1
|
||||
add t,xtrabc ; T: # bytes available
|
||||
caige t,40
|
||||
jrst tcpgtx ; Not enough for a block, screw case
|
||||
lsh t,-5 ; T: # blocks available
|
||||
caile t,tcpcnt
|
||||
movei t,tcpcnt
|
||||
movem t,incnt ; INCNT: # blocks that will fit this time
|
||||
lsh t,5
|
||||
sub t,xtrabc ; T: # bytes we have to read to get there
|
||||
movni tt,(t)
|
||||
addm tt,bytcnt ; BYTCNT: # bytes that will leave in system
|
||||
syscall siot,[move inchn ? move xtrabp ? move t]
|
||||
slose
|
||||
movei t,inbuf
|
||||
movem t,inptr
|
||||
tcpgtj: move t,[440800,,inbuf]
|
||||
movem t,xtrabp ; When he comes back, there won't
|
||||
setzm xtrabc ; be any extra.
|
||||
return
|
||||
|
||||
.end itsdvu
|
||||
|
||||
; Local Modes:
|
||||
; Compile Command: :MIDAS BAWDEN;ITSDEW/Eî
|
||||
; End:
|
||||
Reference in New Issue
Block a user