title CHA device -- cha:.file. (dir) lists connections idebug==0 ;0<-->not debugging irps ac,,nil a b c d e f g t tt w x y z zz p ac=.irpcnt termin bojo==1 lpdl==30 call=pushj p, return=popj p, define syscal name,args .call [setz ? sixbit/name/ ? args ((setz))] termin tsint: loc 42 -ltsint,,tsint loc tsint p 0? 1_bojo ? -1 ? -1 ? bojint ltsint==.-tsint .vector pdl(lpdl) .vector buffer(80.*64.) ;80 chars accross by 60 lines .vector data(12.) .scalar done go: move p,[-lpdl,,pdl-1] .suset [.roption,,t] tlo t,optint ;new style interrupts .suset [.soption,,t] .suset [.smsk2,,[1_bojo]] ;interrupts on the job device setzm done ;not done yet syscal open,[[.uao,,bojo] ? ['boj,,]] call die syscal jobcal,[movei bojo ? movem a ? [-12,,data]] call die move x,data+1 came x,[sixbit/.file./] call illfnm move x,data+2 came x,[sixbit/(dir)/] call illfnm syscal jobret,[movei bojo ? movei 1] ;winning open call die call evsyms call filbuf ;go fill the buffer with CHAOS listing call shove syscal jobret,[movei bojo ? movei 1] ;tell IOTs that ;they've won jfcl jfcl .hang ;wait until we get a close or ;something illfnm: syscal jobret,[movei bojo ? [%ebdfn,,]] ;illegal file name jfcl call die ;and die ;;; ;;; CLOSE commit suicide ;;; ;;; IOT if still generating, ignore ;;; ;;; if finished, send OK completion and let him worry about it ;;; ;;; 'else send OK return and hope bojint: push p,a push p,b bojin1: syscal jobcal,[movei bojo ? movem a ? [-1,,b]] bojin2: jrst [ pop p,b pop p,a jrst dismis] tlne a,60000 ;bit 4.5 or 4.6 means close call die hrrz a,a camn b,['fillen] jrst [ syscal jobret,[movei bojo ? [%ebddv,,]] jrst lose jrst bojin1] cain a,1 ;iot? skipe done ;finished my IOTing skipa jrst bojin2 ;dismis ioting syscal jobret,[ movei bojo ? movei 1] ;else win (sigh) jrst bojin2 jrst bojin1 dismis: syscal dismis,[p] lose: syscal jobret,[movei bojo ? [%ensmd,,]] ;mode not available call die jrst dismis die: skipe debug .value .logout 1, .break 16,160000 .value define symtab syms irp sym,,[syms] sym',,[squoze 0,/sym/] termin 0 termin symtbl: symtab [nindx,chsusr,uname,jname,chssta,chsibp,chsobp,chsnbf,chsnos,chspkn,chsack,chswin,chsfrn,%cfoff,%cfsts,%cfcls,%cfsty,chttbf,chfrbf,chqrfc,chqlsn] define eval val,tab,idx move val,tab addi val,idx move val,400000(val) termin evsyms: movei a,symtbl evslp: hrrz b,(a) skipn b jrst evsy02 move b,(b) .eval b, .lose 1000 hlrz c,(a) movem b,(c) aoja a,evslp evsy02: move t,[-200,,200] setzi tt, syscal corblk,[movei %cbred+%cbndr movei %jself ? t movei %jsabs ? tt] .lose 1000 return .scalar count define princ &str&, movei .length str addm count move t,[440700,,[asciz str]] skipa idpb tt,a ildb tt,t jumpn tt,.-2 termin define ctype item movei item idpb a aos count termin define terpri movei ^M idpb a movei ^J idpb a movei 2 addm count termin define space n,\m m==n+ifb n,1 movei 40 repeat m, idpb a movei m addm count termin define octprn n,arg movsi -n move t,arg call $octprn termin define decprn n,arg ifnb n, movsi -n ifb n, movsi 400000 move t,arg call $decprn termin define sixprn arg move t,[440600,,arg] movei 6 addm count ildb tt,t addi tt,40 idpb tt,a sojg ,.-3 termin filbuf: setzm count move a,[440700,,buffer] princ / Idx Usr Uname Jname State Ibf Pbf Nos Ack R Win T Foreign Addr Flag / setzi b, filb02: caml b,nindx jrst filb20 eval t,chsusr,(b) skipl t call prtidx aoja b,filb02 filb20: eval c,chttbf decprn ,c princ / buffers, / eval c,chfrbf decprn ,c princ / of which are free./ terpri eval c,chqrfc skipn c jrst filb30 princ /Pending RFCs:/ terpri hlrz c,c call prtpkt jumpn c,.-1 filb30: eval c,chqlsn skipn c jrst filb40 princ /Pending LSNs:/ terpri hlrz c,c call prtpkt jumpn c,.-1 filb40: princ / / return prtidx: octprn 3,b space eval c,chsusr,(b) ldb d,[111100,,c] octprn 3,d space eval d,uname,(c) sixprn d space eval d,jname,(c) sixprn d space eval c,chssta,(b) move d,(c)[sixbit /closedlistenrfcrcvrfcsntopen losingincxmtlowlvl/] sixprn d space eval c,chsnbf,(b) hlrz d,c decprn 3,d space hrrz c,c decprn 3,c space eval c,chsnos,(b) decprn 3,c space eval c,chspkn,(b) eval d,chsack,(b) hlrz c,c hlrz d,d sub c,d skipge c addi c,200000 decprn 3,c space eval c,chswin,(b) hlrz d,c caige d,10. call [ decprn 1,d space 3 return] caige d,100. caige d,10. skipa call [ decprn 2,d space 2 return] cail d,100. call [ decprn 3,d space 1 return] hrrz d,c decprn 3,d space eval c,chsfrn,(b) ldb d,[242000,,c] octprn 6,d space ldb d,[042000,,c] octprn 6,d space eval c,chssta,(b) TSNE c,%CFOFF call [ ctype "F ;F - OFF AT PI LEVEL return] TSNE c,%CFSTS call [ ctype "S ;S - SEND STS return] TSNE c,%CFCLS call [ ctype "C ;C - HALF-CLOSED return] TSNE c,%CFSTY call [ ctype "T ;T - CONNECTED TO STY return] eval c,chsibp,(b) skipe c call [ ctype "I ;I - HAS INPUT BUFFER return] eval c,chsobp,(b) skipe c call [ ctype "O ;O - HAS OUTPUT BUFFER return] terpri return prtpkt: octprn 6,c princ /: / hrlzi d,2(c) hrri d,d .getloc d, ldb d,[041200,,d] octprn 3,d space hrlzi d,(c) hrri d,d .getloc d, ldb b,[041400,,d] hrlzi e,4(c) hrri e,d prtpk2: .getloc e, move f,[441000,,d] repeat 4,[ ildb g,f ctype (g) sojle b,prtpk4 ] add e,[1,,] jrst prtpk2 prtpk4: terpri hrlzi d,-2(c) hrri d,d .getloc d, hrrz c,d return $octprn: idivi t,8 addi tt,"0 push p,tt aobjp $octp3 jumpn t,$octprn movei tt,<" > push p,tt aobjn .-1 $octp3: addm count pop p,tt idpb tt,a sojg .-2 return $decprn: idivi t,10. addi tt,"0 push p,tt aobjp $decp3 jumpn t,$decprn tlnn 200000 jrst [ hrrz ? jrst $decp3] movei tt,<" > push p,tt aobjn .-1 $decp3: addm count pop p,tt idpb tt,a sojg .-2 return shove: move tt,[440700,,buffer] move t,count syscal siot,[movei bojo ? tt ? t] jfcl move t,count idivi t,5 subi tt,5 ;neg number needed to send .iot bojo,[-1,,^C] aojl tt,.-1 setom done ;declare done return ...lit: constants debug: idebug ...var::variables 0 ;make sure page exists end go ;;; local modes: ;;; mode:midas ;;; auto fill mode: ;;; fill column:70 ;;; compile command: :midas device;jobdev cha_1 î ;;; end: