From ad686dd778a79886fa99a5edf170e073fcc7281f Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Sun, 18 Dec 2016 16:54:14 -0800 Subject: [PATCH] Added ITSDEV. Resolves #246. --- README.md | 1 + build/build.tcl | 5 + src/bawden/itsdev.102 | 713 ++++++++++++++++++++++++++++++++++++++++++ src/bawden/itsdvu.25 | 666 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 1385 insertions(+) create mode 100755 src/bawden/itsdev.102 create mode 100755 src/bawden/itsdvu.25 diff --git a/README.md b/README.md index 62f52cd4..e0f7fb96 100644 --- a/README.md +++ b/README.md @@ -145,6 +145,7 @@ A list of [known ITS machines](doc/machines.md). - INLINE, reads line from TTY and adds to JCL (for DDT init files) - INQUIR, user account database. - INQUPD, processes INQUIR change requests. + - ITSDEV, ITS device server. - INSTAL, install executables on other ITS machines. - JOBS, list jobs by category. - LISP, lisp interpreter and runtime library (autoloads only). diff --git a/build/build.tcl b/build/build.tcl index 5a6db41b..c16313de 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -798,6 +798,11 @@ expect ":KILL" respond "*" ":midas sys;ts palx_sysen1;palx\r" expect ":KILL" +# itsdev +respond "*" ":link syseng;chsdef 999999,system;chsdef >\r" +respond "*" ":midas device;chaos itsdev_bawden;itsdev\r" +expect ":KILL" + # 11sim respond "*" ":midas sys1;ts pdp11_syseng;11sim\r" expect ":KILL" diff --git a/src/bawden/itsdev.102 b/src/bawden/itsdev.102 new file mode 100755 index 00000000..1d36e5ed --- /dev/null +++ b/src/bawden/itsdev.102 @@ -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,[,,+1] + blt tt,+-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+ to report error . +rerr: +repeat 100, jsp e,rerr1 + +; JRST RERROR to report error in E. +rerr1: movei e,-(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 -%cpmxw, liobuf==: +.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 ,$cpkop,<.dpb ,$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,] + 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 ? [-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 diff --git a/src/bawden/itsdvu.25 b/src/bawden/itsdvu.25 new file mode 100755 index 00000000..6da362df --- /dev/null +++ b/src/bawden/itsdvu.25 @@ -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: - . + ; No response. +oplast==:1 ; words of data: - . + ; Responds with RSVALS or RSERROR. +opread==:2 ; Requests 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 - . + ; (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 :; . Mode in RH(). + ; Responds with RSVALS or RSERROR. +opclose==:5 ; Close channel. + ; Responds with RSVALS or RSERROR. +opscall==:6 ; Perform .CALL with LH() arguments (1 - 6). + ; Bits in RH(). First argument is CHDEV, - + ; are the remaining arguments. + ; If 4.9() is set, then - are the only + ; LH() arguments. + ; Responds with RSVALS or RSERROR. +opxcall==:7 ; Perform extended command named . + ; All extended commands respond with RSVALS or RSERROR. +oplink==:8 ; Make link from :; to :; . + ; 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 ; - are values. +rserror==:3 ; Reports error . 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 , XJNAME , and SNAME from + ; "terminal" . Client version number in and + ; program name in . + ; Returns UNAME in and JNAME in and server + ; version number in . +; MTAPE ; Perform .MTAPE [CHDEV,,[]],. + ; Returns value in . +; RENAME ; Rename :; to :; . + +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): - +; F (arg): <# args>,, +; G (arg): System call name +; A - G (val): - +; 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 -%cpmxw, liobuf==: +.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 ,$cpkop,<.dpb ,$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, + 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: