;-*- Midas -*- title RMTDEV - MLDEV for non-ITS hosts ifndef dbgsw,dbgsw==0 ;;July 1985, GZ a=:1 b=:2 c=:3 d=:4 e=:5 t=:6 tt=:7 j=:10 k=:11 v=:12 w=:13 F=:14 ;Flags U=:15 ;AC munged at interrupt level INT=:16 ;Interrupt-p flag, in AC for more efficient .hanging p=:17 call=:pushj p, ret=:popj p, nop=:jfcl callret==:jrst ;Twenex-style label-generating macros. .insrt midas;macsym define syscal name,args .call [ setz ? sixbit/name/ ? args ((setz))] termin define fallto label if2,ifn .-label,.fatal fallto label not falling to label termin define note &text ifn dbgsw,[ call [call $note .length text ascii text] ] .else jfcl termin define nout loc ifn dbgsw,[ call [call $nout loc] ] .else jfcl termin define nsix loc ifn dbgsw,[ call [call $nsix loc] ] .else jfcl termin define nstr loc ifn dbgsw,[ call [call $nstr loc] ] .else jfcl termin chboj==:1 chusr==:2 chneti==:3 chneto==:chneti+1 chtyo==:chneto+1 ;For debugging output ;;Flags in RHS of F. (LHS of F has the open mode) f%pclsr==:000001 ;Our last JOBRET failed so expect a restarted call. f%open==:000002 ;Creator has file open. f%eofi==:000004 ;Have reached end of input from net f%clss==:000010 ;Sent close request, don't leave til get a reply f%dnrf==:000020 ;Device was xxDNRF: f%blka==:000040 ;Open in block ascii mode f%dbug==:000100 ;Debug mode f%conn==:000200 ;Have a connection f%dir==:000400 ;doing a directory listing ;Flags that say that interrupts happened and are awaiting mp level processing. fi%boj==:100000 fi%nti==:200000 fi%nto==:400000 .insrt dsk:system;chsdef ;;Special Chaosnet Packet Opcodes ;;Opcodes 200-217 are data. The 10 bit means this is eof. The last 3 bits ;;give the number of padding bits in the last byte of the packet, so we can ;;transmit exact numbers of bits. All data is transmitted in FTP-like image ;;mode (i.e. as a bit stream of relevant bits). %COLST==:210 ;Last (EOF) packet of file %COMND==:220 ;A command %CORPL==:221 ;A reply to a command %COASY==:222 ;Asynchronous error from server. ;Dunno, MLDEV uses 10, FCDEV uses 20... WINDOW==:10 ;Net window size chnl==:200\^M ;Chaosnet newline character ;;%COMND/%CORPL opcodes r.opno==:0 ;Output open r.opni==:1 ;Input open r.dirl==:2 ;List directory r.renm==:3 ;Rename r.dele==:4 ;Delete r.expu==:5 ;Expunge r.crdi==:6 ;Create directory r.mlnk==:7 ;Make link r.reu==:10 ;Reuse r.cls==:20 ;Close r.alc==:21 ;Input allocation r.acc==:22 ;Access r.rnmw==:23 ;Rename while open r.delw==:24 ;Delete while open r.srd==:25 ;Set Reference Date r.sfd==:26 ;Set File write Date r.saut==:27 ;Set file Author r.rsts==:30 ;Read file status r.srpb==:31 ;Set File Reap Bit ;;JOBCAL argument definitions ;JOBCAL words for OPEN J.FN1==:1 ;First filename J.FN2==:2 ;Second filename J.SNM==:3 ;Sname J.DEV==:4 ;Device J.MOD==:5 ;Open mode J.FNM==:7 ;String-filename pointer, or 0 if only sixbit ;JOBCAL words for IOT J.PTR==:0 ;IOT pointer ;JOBCAL words for SIOT J.CNT==:0 ;Byte count ;JOBCAL words for ACCESS J.PTR==:0 ;ACCESS pointer ;JOBCAL words for MLINK J.TFN1==:0 ;Target (linked-to) first filename J.FN1==:1 ;Source (link's) first filename J.FN2==:2 ;Source second filename J.SNM==:3 ;Source sname J.DEV==:4 ;Source device J.TFN2==:5 ;Target second filename J.TSNM==:6 ;Target sname J.FNM==:7 ;Source string-filename pointer or 0 J.TFNM==:10 ;Target string-filename pointer or 0 ;JOBCAL words for FDELE (rename/delete) J.TFN1==:0 ;Target (new) first filename, or 0 if delete J.FN1==:1 ;Source (old) first filename J.FN2==:2 ;Source second filename J.SNM==:3 ;Source sname J.DEV==:4 ;Source device J.TFN2==:5 ;Target second filename, or 0 if delete J.FNM==:7 ;Source string-filename pointer J.TFNM==:10 ;Target string-filename pointer ;JOBCAL words for FDELEWO (rename/delete while open) J.TFN1==:0 ;Target (new) first filename, or 0 if delete J.TFN2==:5 ;Target second filename, or 0 if delete J.TFNM==:10 ;Target string-filename pointer ;JOBCAL words for CALL J.CAL==:0 ;Sixbit call name J.CTB==:1 ;Control bits J.ARGC==:2 ;Count of arguments J.ARG1==:3 ;First arg J.ARG2==:4 ;Second arg J.ARG3==:5 ;Third arg ;.... subttl variable definitions loc 42 jsr tsint loc 77 sixbit /MLDEV/ ;The pretender... rdevn: block 4 ;Filename for JOBSTS (and nominally RCHST) raccp: 0 ;Access pointer, must follow RDEVN block for RCHST. opmode: 0 ;Mode from OPEN call (for JOBSTS) crunam: 0 ;Creator's UNAME crjnam: 0 ;Creator's JNAME ;;Next four must be in this order (for FILLEN .call) fillen: 0 ;File length in BYTSIZ bytes or -1 if unknown (unknowable). bytsiz: 0 ;Byte size open in, 7 for unit ascii, otherwise 36. filbln: 0 ;File length in bytes of size written in filbsz: 0 ;Byte size file written in ;Hope nobody snoops beyond this point... debug: 0 pat: patch: block 100 patche: -1 ;;Random file properties. .scalar fildat ;File creation date in universal time or 0 if unknown. .scalar filref ;File reference date in universal time or 0. .scalar filaut ;Author's name in sixbit or 0. ;;Data returned by JOBCAL. .scalar jbcop ;JOBCAL Opcode .scalar jbc(jbclen==:13) ;JOBCAL Arguments ;;Variables for buffer management .scalar bufsiz ;Total buffer size in BYTSIZ bytes .scalar bufcnt ;Number of BYTSIZ bytes available to user for reading/writing .scalar bufptr ;Pointer into buffer for user<->buffer communication. ;In block mode, it's the address of next word to read/write ;In unit mode, it's a byte pointer. .scalar bufptn ;Count of BYTSIZ bytes from BUFPTR to BUFEND .scalar netptr ;Pointer into buffer for net<->buffer communication. ;RH has address of next word, LH has number of bits in ; that word still available to user (and hence not to net) .scalar alcptr ;On input, address of first unallocated word in BUF .scalar alccnt ;Number of allocated bits not received yet. ;;Variables for image mode packet<->buffer conversion .scalar wdlen ;Number of bits in each buffer word (35 if ascii, 36 if image) .scalar fudge ;wdlen-32 (32=number of bits in each packet word) ;;Handling of net commands .scalar seqnum ;Transaction counter .scalar rplseq ;Number of reply that we're waiting for, or -1 if not waiting .scalar accseq ;Number of access command outstanding, or -1 if none. .scalar iotcnt ;If non-zero, number of bytes remaining in a hung IOT ;On input, IOT hung because data still not available. ;On output, because we stopped to read some net reply packets. fnmstl==:100 ;Max length of filename .scalar trunam(fnmstl) ;Truename of file, from the server .scalar sysnam(fnmstl) ;Permanently the truename of file, for JOBSTS .scalar fdevn ;Foreign device name from initial open device name. .scalar fhost ;Foreign host name from initial open device name. .scalar fhostn ;Foreign host number .scalar pktbuf(%cpmxw) ;Chaos packet buffer. pdllen==:100 .scalar pdl(pdllen+4) ;Guess subttl Initialization and top-level loop begin: move p,[-pdllen,,pdl-1] setz f, ;Clear flags ifn dbgsw,[ .suset [.roption,,a] tlnn a,%opddt ifskp. txo f,f%dbug tlo a,%opojb .open chtyo,[.uao\%tjdis,,'tty ? setz ? setz] .lose %lssys .value [asciz ""] .suset [.soption,,a] note "AHere we go..." endif. ] .suset [.smask,,[%piioc+%piilo+%pimpv+%pipdl]] .open chboj,[30\.bio,,'boj] ;20=don't hang, 10=one way. die syscal rfname,[%climm,,chboj ? %clout,,a %clout,,crunam ? %clout,,crjnam] ;Names for PEEK nop .call jobcal ;Get first call die note "[initial jobcal]" move a,jbcop ;If he already pclsr'd, give up, since he will tlne a,%jgcls ;give up on us since we did a JOBGET and saw die ;that fact. andi a,-1 ;Separate out opcode caie a,%jornm ;Should be either FDELE cain a,%jolnk ; or MLINK ifskp. caie a,%joopn ; or OPEN bug ;I wanna know if any new ops get defined. endif. setom jbcaln' ;Flag initial jobget done movei a,hstpag ;Try to figure out host movei b,chusr call netwrk"hstmap bug move a,jbc+j.dev ;Get device movem a,jobdev' ;Save for reuse camn a,[sixbit/KANSAS/] ;Special dispensation move a,[sixbit/OZKS/] camn a,[sixbit/SP/] ;Both acceptable, but standardize on one move a,[sixbit/SPEECH/] movem a,jbc+j.dev tlz a,777700 ;Mask out the first 2 chars came a,['DNRF] ifskp. xorm a,jbc+j.dev ;Clear the DNRF part from official device name tro f,f%dnrf ;and remember we had it endif. setzm fhostn move a,jbc+j.dev movem a,rdevn ;Remember device for .RCHST's movem a,fhost ;Assume it's the host name call sixhst jrst [ hllz a,rdevn ;No luck, try first two chars tlz a,77 movem a,fhost call sixhst jrst [ movsi a,%ensdv ;No other good ideas, return with jrst nogoe] ;no such device move b,rdevn ;Won, get the foreign device lsh b,2*6 ;from last 4 chars jrst .+2] move b,[sixbit/PS/] ;Else default foreign device movem b,fdevn ;Remember this movem b,jbc+j.dev ;Here too, like MLDEV, not sure why movem a,fhostn ;Save host number call netwrk"hstunmap ;Flush host pages bug move w,[440700,,buf] ;Cons RFC string move a,[sixbit/RMTDEV/] ;RMTDEVUNAME call wsix movei a,40 idpb a,w .suset [.rxunam,,a] call wsix setz a, idpb a,w conn: note " Connect..." movei a,chneti ;Make the connection move b,fhostn ;Host number movei c,buf movei d,window call netwrk"chacon jrst nogo txo f,f%conn ;Have a connection now setzm int ;All set up, can turn on interrupts now .suset [.smsk2,,[1_chboj+1_chneti+1_chneto]] setzm seqnum ;Start off transaction sequence numbers note "OK " ;Joins here when reused. REUSE1: setom rplseq ;Not waiting for system call reply. setom accseq ;No access command outstanding. setzm iotcnt ;No iot in progress trz f,f%open\f%clss\f%pclsr ;No file open, no close or pcl outstanding tro f,fi%boj ;Fake a job interrupt for the initial jobcal. fallto goloop ;;Main program loop. ;"<<" goloop: note "==>>Goloop" setzm int trze f,fi%nti ;Net input interrupt jrst ntint ; Read and handle a packet from server skipe iotcnt ;If we interrupted an output IOT to read tlnn f,%doout ;net replies caia jrst jioto ;Go back to finish it trze f,fi%boj ;BOJ interrupt jrst bojint ; process user call trze f,fi%nto ;Net output interrupt jrst ntoint ; Transfer some data if have any skipl int ;Nothing, wait for an interrupt .hang jrst goloop ;;Here on chaosnet failure on initial command nogo: movsi a,%enadv ;Device not available. nogoe: movem a,errcod note "Connection failed" movei c,20. ;Number of times to JOBRET before we think other side do. ;is gone. .call jobcal die ;JOBGET on initial is not supposed to fail. move a,jbcop tlne a,%jgcls ;He closed us so we can stop now. exit. .call jbrerr ;Keep trying to return this error, in case he pclsr's sojg c,[movei b,1 ? .sleep b, ? jrst top.] ;and comes back. enddo. skipn fhostn ;Did we ever get a host? die ;No, that's it fallto reuse ;Let him keep trying if he really wants to ;COME HERE WHEN WE HAVE BEEN FINISHED WITH BY ONE CREATOR, TO OFFER OURSELVES ;TO OTHERS. REUSE: MOVEI A,30.*5 ;WAIT FIVE SECONDS FOR SOMEONE TO REUSE US. .SUSET [.SAMSK2,,[1_CHBOJ]] SYSCAL JOBREU,[ JOBDEV ;DEVICE NAME WE ARE HANDLING. ['JOBDEV] ;FILENAMES WE WERE LOADED FROM. JOBDEV ['DEVICE] A] ;AMOUNT OF TIME TO WAIT JRST REUSL .SUSET [.SIMSK2,,[1_CHBOJ]] note "AHere we go again..." SYSCAL RFNAME,[ ;SOMEBODY GOBBLED US. FIND OUT WHO, FOR PEEK. %CLIMM,,CHBOJ %CLOUT,,A %CLOUT,,CRUNAM %CLOUT,,CRJNAM] JFCL jxe f,f%conn,conn movei a,r.reu call setcmd movem a,rplseq .suset [.rxunam,,a] call wsix call sndcmd do. call reply came b,rplseq loop. enddo. note "Synched" jrst reuse1 ;HERE IF WE SEE WE ARE NOT GOING TO BE REUSED. REUSL: TRNE F,F%CLSS ;IF WE SENT A CLOSE COMMAD, WE MUST WAIT FOR THE REPLY, JRST GOLOOP ;WHICH WILL MAKE US COME BACK TO DIE. ;COME HERE TO REALLY GIVE UP THE GHOST. $die: txne f%dbug ; .break 16,100000 .value .logout 1, .value 0 die==: subttl BOJ interrupt dispatch .scalar lastop ;Last opcode (unless f%pclsr) .scalar ljbrta ;2 + .CALL JOBRET address if f%pclsr pclsr: note " Pclsr'd" pop p,ljbrta ;A failing jobret indicates that creator was setom lastop ;pclsrd and we should expect him to retry his tro f,f%pclsr\fi%boj ;system call. We must set FI%BOJ now because jrst goloop ;coming back in might not set the interrupt bit pcl==:pushj p,pclsr ;Follow every JOBRET with this bojint: note "ABOJ interrupt..." setzm iotcnt ;I guess he gave up on that IOT... aosg jbcaln ;-1 if initial, don't do again ifskp. .call jobcal jrst goloop endif. move b,jbcop ;Dispatch on opcode tlne b,%jgcls jrst jcls movei a,(b) caile a,%jocal bug ;I want to know if any new ops get defined cain a,%jocal move a,jbc+j.cal tlne b,%jgfpd ;If this is a retry of a call that pclsr'ed, jrst [note "retry..." skipl rplseq ;If waiting for a net reply to last command came a,lastop ;And really have the same opcode (paranoia...) caia jrst goloop ;Just keep waiting... trzn f,f%pclsr ;Something PCLSR'd and we noticed? jrst .+1 ;No, treat this as a new invocation. note "retrying" move b,ljbrta ;Else yes, we finished with it so just give jrst -2(b)] ;him the same jobret again. setom rplseq ;I guess he no longer wants that reply setzm iotcnt ;or that (input) iot trz f,f%pclsr ;We can't handle a retry after anything else happens. movem a,lastop jrst @disp(b) disp: offset -. %joopn:: jopen %joiot:: jiot %jolnk:: jmlink %jorst:: jret ;Just return %jorch:: jrch %joacc:: jacc %jornm:: jfdele %jorwo:: jrnmwo %jocal:: jsyscl offset 0 ;More dispatching jsyscl: move a,jbc+j.cal ;Get .call name camn a,[sixbit/FORCE/] jrst jforce camn a,[sixbit/FINISH/] jrst jfinish camn a,[sixbit/FILLEN/] jrst jfille camn a,[sixbit/SFDATE/] jrst jsfdat camn a,[sixbit/SRDATE/] jrst jsrdat camn a,[sixbit/SAUTH/] jrst jsauth camn a,[sixbit/RFDATE/] jrst jrfdat camn a,[sixbit/RRDATE/] jrst jrrdat camn a,[sixbit/RAUTH/] jrst jrauth camn a,[sixbit/ACCESS/] jrst jsacc camn a,[sixbit/SREAPB/] jrst jsreap note ".Call ?" nsix a note "?..." jrst wtderr ;That's all we handle. subttl Initial OPEN ;Should we check that file is not open already, or is that guaranteed? jopen: move a,jbc+j.mod ;Get open-mode trnn a,%doout note "OpenI..." trne a,%doout note "OpenO..." trne f,f%dnrf ;If DNRF: from device name tro a,%donrf ;set here too movem a,opmode ;Save for JOBSTS hrl f,a ;And in F, for easy access movei a,%ensmd ;Check for unknown modes tlne f,#<%doout\%doimg\%doblk\%donrf\%donlk\%dorwt\%dowov> jrst opnerr movei a,%esco ;Check for self-contradictory modes tlnn f,%doout tlnn f,%dowov ;(RWT is also supposedly for output only, but caia ;it sorta has a reasonable interpretation for jrst opnerr ;input as well, so we'll just pass it on.) tlne f,%doblk ;Remember whether block ascii mode, it's tlne f,%doimg ;special because server is in 7 bit (so we trza f,f%blka ;can get exact eof) but user is really 36 bit. tro f,f%blka trz f,f%dir move a,jbc+j.fnm ;Get the user-specified filename move b,jbc+j.snm move c,jbc+j.fn1 move d,jbc+j.fn2 move w,[440700,,trunam] ;Put it here temporarily call usrfnm call opnchk ;Check if have exactly two sixbit filenames ifskp. ;Look out for special names came b,[sixbit/(DIR)/] camn b,[sixbit/(UDIR)/] came a,[sixbit/..NEW./] caia jrst jcrdir camn b,[sixbit/(DIR)/] came a,[sixbit/.EXPUN/] caia jrst jexpun camn b,[sixbit/(DIR)/] came a,[sixbit/.FILE./] caia jrst jdir endif. jopnx: move a,opmode ;Get just the basic mode andi a,%doblk\%doimg\%doout trc a,%doout ;flip direction (he reads<=>we write, and v.v.) tro a,30 ;unhang our iots if he pclsrs. syscal open,[%climm,,chboj ? %clbtw,,a ? [sixbit/BOJ/]] die ;Initialize some variables movei a,35. ;Number of bits in each buffer word tlne f,%doimg movei a,36. movem a,wdlen subi a,32. ;Difference from packet word length movem a,fudge movei a,7 ;Byte size of connection to user. tlnn f,%doblk tlne f,%doimg movei a,36. movem a,bytsiz movei b,bufl ;Size of buffer in those bytes cain a,7 imuli b,5 movem b,bufsiz call bufini ;Buffer and allocation pointers/counts setzm raccp ;File position trz f,f%eofi ;Haven't seen an eof yet movei a,r.opno ;Send command to server tlnn f,%doout movei a,r.opni txne f,f%dir movei a,r.dirl note "setcmd..." call setcmd movem a,rplseq ;Save sequence # for error checking ifxe. f,f%dir movei a,7. ;Open byte size (tell him 7 even if block ascii tlne f,%doimg ;so we can do our local style of eof padding) movei a,36. nout a call wdec movei a,chnl idpb a,w note " " movei a,[asciz "/NRF"] ;Next come the options tlne f,%donrf note "/NRF" tlne f,%donrf call wstr movei a,[asciz "/NLK"] tlne f,%donlk note "/NLK" tlne f,%donlk call wstr movei a,[asciz "/RWT"] tlne f,%dorwt note "/RWT" tlne f,%dorwt call wstr movei a,[asciz "/WOV"] tlne f,%dowov note "/WOV" tlne f,%dowov call wstr movei a,chnl idpb a,w endif. note " " move a,alccnt ;Next the initial allocation call wdec nout alccnt movei a,chnl idpb a,w note " " movei a,trunam ;And finally the filename call wstr nstr trunam call sndcmd note "A reply..." call reply ;Get the reply came b,rplseq bug setom rplseq jumpn a,opnerr note "OK" call rsts ;Open reply is like status .call jbrwin ;Tell the creator that the open succeeded. call ipclsr tro f,f%open ;He now has the file open jrst goloop opnerr: note "Bad#" nout a hrlzm a,errcod ;Here for failure reply to initial command .call jbrerr ;Return the error call ipclsr ;Different pclsr handling for initial commands jrst reuse ;And we're all finished. ipclsr: movei a,30. ;if initial jobret fails, wait a while before jobgeting .sleep a, ;since if we jobget before he retries we will read a jrst pclsr ;close and give up, and he will do whatever it is twice bufini: movei a,buf movem a,netptr movei b,440700 tlne f,%doimg hrli b,444400 tlnn f,%doblk hrl a,b movem a,bufptr move a,bufsiz movem a,bufptn tlnn f,%doout setz a, movem a,bufcnt movei a,buf+bufl-1 movem a,alcptr movei a,bufl-1 imul a,wdlen tlne f,%doout setz a, movem a,alccnt ret subttl Other first-call cases ;Handle OPEN of .FILE. (DIR) -- List a directory jdir: note "DirLst..." tlne f,%doout\%doimg\%donrf\%donlk\%dorwt jrst wtderr tro f,f%dir move b,trufnb ;Get the filename frob from opnchk add b,[4,,0] ;Flush filenames move d,[440700,,temfn1] call rfnl"pfn move a,[temfn1,,trunam] blt a,trunam+fnmstl-1 jrst jopnx ;Join open code ;Handle OPEN of .EXPUN (DIR) -- Expunge a directory. jexpun: note "Expunge..." jrst wtderr ;Not implemented yet ;Handle OPEN of .NEW.. (UDIR) -- Create a directory. jcrdir: note "CrDir..." jrst wtderr ;Not implemented yet ;Handle MLINK -- Create a link. jmlink: note "MLink..." jrst wtderr ;Not implemented yet ;Handle .FDELE -- Delete or rename a file jfdele: move a,jbc+j.fnm ;Get the user-specified filename move b,jbc+j.snm move c,jbc+j.fn1 move d,jbc+j.fn2 move w,[440700,,trunam] ;Put it here temporarily call usrfnm skipn jbc+j.tfn1 ;Have a target? ifskp. note "Rename " ;Then it's a rename movei a,r.renm call setcmd movem a,rplseq movei a,trunam nstr trunam call wstr movei a,chnl idpb a,w note " to " move a,jbc+j.tfnm ;Get target filename move b,jbc+j.snm move c,jbc+j.tfn1 move d,jbc+j.tfn2 push p,w ;Read it into a buffer for logging move w,[440700,,buf] call usrtfn pop p,w movei a,buf nstr buf call wstr else. note "Delete " movei a,r.dele call setcmd movem a,rplseq movei a,trunam nstr trunam call wstr endif. call sndcmd call reply ;Get the reply came b,rplseq bug setom rplseq jumpn a,opnerr .call jbrwin call ipclsr jrst reuse subttl Assorted non-initial non-i/o commands ;Note that the documentation claims only raccp word is used here... The system ;uses filenames from last jobsts. jrch: note "RCHST..." syscal jobret,[%climm,,chboj ? %climm,,0 ? [-5,,raccp-4]] jrst bojint ;No need for "PCL" since we haven't altered anything. jrst goloop jfinish:note "Finish..." ;.CALL FINISH ;;Maybe should also wait for output access to be ack'd. jforce: note "Force..." call force ;.CALL FORCE jrst jrwin jfille: note "Fillen..." skipge fillen ;.CALL FILLEN jrst wtderr ;Not defined move a,[-4,,fillen] jrst jrval ;Foo, it looks like we're not expected to return anything to the creator. ;If file fails to get created properly, he'll never know. I wonder, does ;the .close return immediately or only when we issue the jobreu? If latter, ;maybe we should hold off on that so we can at least signal ioc errors... jcls: note "Close..." tlne f,%doout call force ;Force out buffered output. Maybe should also wait ;for all access's to get ack'd? movei a,r.cls ;Set up a close packet call setcmd movem a,rplseq call sndcmd ;No args, just send it tlne f,%doout tro f,f%clss ;Stick around until we receive a reply or else server jrst reuse ;might notice we're gone and abort ;Close continuation. We only get here if it turned out we weren't reused, ;since we don't do net interrupts while waiting for a reuse. xcls: note "Close..." die jsacc: move a,jbc+j.arg2 ;Access pointer for symbolic call ACCESS movem a,jbc+j.ptr call jacc1 ;Common .call/uuo routine jrwin: note "" .call jbrwin ;Just skip-return... pcl jrst goloop jacc: call jacc1 jret: note "" .call jbret ;Just return... pcl jrst goloop jacc1: note "Access " nout raccp ;"<" note "=>" nout jbc+j.ptr note "..." move b,jbc+j.ptr camn b,raccp ret tlne f,%doout ;If doing input ifskp. ;see if can do it locally sub b,raccp cail b,0 camle b,bufcnt anskp. ;No such luck note "(local)" addm b,raccp ;Else update the file pointer movn a,b ;And buffer count addm a,bufcnt tlnn f,%doblk ;Update buffer pointers tlne f,%doimg tdza c,c idivi b,5 add b,bufptr sojge c,[ibp b ? jrst .] add a,bufptn ifle. a ;Gone past end of buffer? add a,bufsiz ;Yea, wrap subi b,bufl endif. movem a,bufptn movem b,bufptr ;B/updated bufptr for sndalc callret sndalc ;Send allocation if need to and that's it! endif. tlne f,%doout ;Do it for real call force ;If output, force it out now. call bufini ;Flush old input trz f,f%eofi ;No longer have an eof movei a,r.acc call setcmd movem a,accseq move a,jbc+j.ptr movem a,raccp trne f,f%blka ;In block ascii mode, server is in 7-bit imuli a,5 ;bytes even though the user is in 36 bit. call wdec movei a,chnl idpb a,w move a,alccnt ;Include new allocation call wdec callret sndcmd ;send the command. xacc: note "Access..." skipge accseq bug camn b,accseq ;Is this the one we're waiting for? setom accseq ;Yup, so no longer any outstanding tlnn f,%doout skipge accseq skipn a jrst goloop ;No error, or just an old input reply, ignore note "Bad#" nout a ;Here if error and either the latest input or ANY output reply syscal jobioc,[%climm,,chboj ? %climm,,2] ;Make a reasonable error .lose ;If this is input, could recover because no I/O can take place ;until all .ACCESS's ack'd, figure it out later. (Basically: ;give ioc errors on all iot's until he gives a working .access, ;remember to give ioc error now if iotcnt non-zero. Need to remember ;that that alloc didn't take either thou) ;For output, maybe should wait for reply before returning to user ;so we don't have to deal with outstanding access's. All sorts ;of synch problems with closing the file and such... Better yet, ;output iots should hang if there are outstanding access's too. die jsreap: note "SReapb " movei a,r.srpb ;Set the do-not-reap bit call setcmd movem a,rplseq move a,jbc+j.arg2 call wdec nout a call sndcmd jrst goloop xsreap: note "XSReapb " jrst xret jrnmwo: skipn jbc+j.tfn1 jrst jdelwo note "Rnmwo..." movei a,r.rnmwo call setcmd movem a,rplseq move a,jbc+j.tfnm setz b, ;No target sname! move c,jbc+j.tfn1 move d,jbc+j.tfn2 call usrtfn call sndcmd jrst goloop xrnmwo: note "Rnmwo..." ife. a ;If no error, server DID change the names so... push p,b ;read the new names even if user gave up. call rfname pop p,b setz a, endif. jrst xret jdelwo: note "Delwo..." movei a,r.delwo call setcmd movem a,rplseq call sndcmd jrst goloop xdelwo: note "Delwo..." xret: came b,rplseq ;Were we still waiting for this? jrst goloop ;No, tough setom rplseq ;Else no longer wait for it jumpn a,jrerr ;If error, tell him so jrst jrwin ;Else report success. jsrdat: note "SRDate..." movei t,filref movei a,r.srd jrst jsdate jsfdat: note "SFDate..." movei t,fildat movei a,r.sfd jsdate: call setcmd movem a,rplseq move a,jbc+j.arg2 call datime"timnet movem a,rplval' ;Remember the new date setzm (t) ;No longer know the real date call wdec call sndcmd jrst goloop jsauth: note "SAuthor..." movei a,r.saut call setcmd movem a,rplseq move a,jbc+j.arg2 movem a,rplval ;Remember the new author setzm filaut ;No longer know the real author call wsix call sndcmd jrst goloop xsrdat: note "SRDate..." movei t,filref jrst xsval xsfdat: note "SFDate..." movei t,fildat jrst xsval xsauth: note "SAuthor..." movei t,filaut xsval: came b,rplseq jrst goloop setom rplseq jumpn a,jrerr move a,rplval ;Server won, install the new value movem a,(t) jrst jrwin ;And tell the user jrrdat: note "RRDate..." hrroi a,filref ;.CALL RRDATE jrst jrdata jrfdat: note "RFDate..." hrroi a,fildat ;.CALL RFDATE jrst jrdata jrauth: note "RAuthor..." hrroi a,filaut ;.CALL RAUTH jrdata: skipe (a) ;Have it locally? jrst rdata ;Yes, just return it movem a,rplval ;Else read status from server movei a,r.rsts call setcmd movem a,rplseq call sndcmd jrst goloop xrsts: note "RStatus..." ife. a ;If successful reply push p,b ;Might as well read it in call rsts pop p,b setz a, endif. came b,rplseq ;Were we waiting for this? jrst goloop ;No, he gave up setom rplseq jumpn a,jrerr move a,rplval ;Do we have the value we want now? skipn (a) jrst wtderr ;No, must be unknowable rdata: camn a,[-1,,filaut] ;Else return it. jrst jrval ;Author is simple move a,(a) ;Dates have to be converted first tho subi a,datime"estdif*60.*60. call datime"sectim movei b,3600. call datime"odayl call datime"timadd movem a,dskdat' hrroi a,dskdat jrval: movem a,retval' ;All args must stay around in case pclr'd note "" .call jbrval pcl jrst goloop rsts: note "len " call rwdec ;Length in open bytes seto a, ;Not specified nout fillen ifxn. f,f%blka ;If block ascii, he is open in 7 but we're 36 andge. a addi a,4 idiv a,5 endif. movem a,fillen note " bsz " call rwdec ;Byte size of last open setz a, movem a,filbsz nout filbsz note " bln " call rwdec ;Size in bytes of last open setz a, movem a,filbln nout filbln tlnn f,%doout ifskp. move a,bytsiz movem a,filbsz move a,fillen movem a,filbln endif. note " cre " call rwdec ;Creation date setz a, movem a,fildat nout fildat note " ref " call rwdec ;Reference date setz a, movem a,filref nout filref note " aut " call rwsix ;Author movem a,filaut nsix filaut rfname: note " fnm " movei a,trunam ;True name call rwstr nstr trunam note "." call unparse ;Unparse truename into RDEVN block move a,[trunam,,sysnam] blt a,sysnam+fnmstl-1 .call jobsts ;Give it to system for RCHST/RFNAME. bug ret wtderr: note "WTDErr" movei a,%ebddv ;Return "Wrong type device" jrst jrerrX jrerr: note "" jrerrX: hrlzm a,errcod' .call jbrerr pcl jrst goloop subttl IOT/SIOT jiot: note "JIOT(" trnn f,f%open bug tlnn f,%doblk ;Figure out length of transfer ifskp. ;Block mode hlre a,jbc+j.ptr movns a else. ;Else unit mode move a,jbcop tlne a,%jgsio skipa a,jbc+j.cnt movei a,1 endif. movem a,iotcnt ;Save new number of bytes not sent yet nout iotcnt note ")..." tlnn f,%doout ;Dispatch on direction jrst jioti fallto jioto ;Maybe should hang if there are access's outstanding... jioto: skipe d,iotcnt ;If nothing more to do trne f,fi%nti ;or there are replies waiting jrst goloop ;Bail out skipe c,bufcnt ;Get # bytes available in our buffer. ifskp. ;None, send a data packet to make room, call snddat ;even if it means hanging bug jrst jioto ;Should work ok now, but check for FI%NTI again endif. call bojiot ;Do it. A gets new raccp skipl fillen ;If file length known&settable camg a,fillen ;and writing past end of file ifskp. movem a,fillen ;then update the file length movem a,filbln endif. call jout ;Send off some data if we can jrst jioto ;Try it again ;Come here for network output interrupt to move data from buffer to net. ntoint: note "ANET Output interrupt..." trne f,f%open tlnn f,%doout jrst goloop move a,bufcnt ;Anything in buffer? camge a,bufsiz call jout ;Yea, output whatever we can to the network. note "done" jrst goloop ;Output data from BUF to the server, as much as we can without hanging. ;Clobbers A-E,T,TT,J jout: syscal whyint,[%climm,,chneto ? %clout,,j ? %clout,,j ? %clout,,j] .lose %lsfil tlz j,-1 ;Number of packets we can send jumpe j,cpopj ;No room for any data call snddat ;Send some ret ;No more, done sojg j,.-2 ;Not finished yet, go again. txo f,fi%nto ;Out of room, come back later to check again ret force: call snddat ;Send some ret ;No more jrst force ;Send a data packet to server. Clobbers A-E,T,TT. ;Skips if there was data to send. snddat: move e,bufsiz ;Figure number of bytes used sub e,bufcnt jumpe e,cpopj ;None, finished move c,bytsiz trne f,f%blka ;Convert to (server) bit count move c,wdlen imul e,c hlrz d,netptr ;D=bits already sent from first word move a,d idiv a,bytsiz sub e,b ;E=# bits we can send caile e,8*%cpmxc ;At most a packet's worth movei e,8*%cpmxc ;E=# bits we're going to send add b,e ;Update byte count idivi b,(c) addm b,bufcnt hrrz c,netptr ;C=input address move a,d ;Compute new bufptr add a,e idiv a,wdlen hrlm b,netptr hrrz b,netptr add a,b cail a,buf+bufl subi a,bufl hrrm a,netptr movei a,7(e) ;Compute packet counts idivi a,8 dpb a,[$cpknb+pktbuf] ;Number of bytes trc b,%codat\7 ;Account for the padding bits dpb b,[$cpkop+pktbuf] addi a,3 ;Compute output words idivi a,4 movns a hrl b,a hrri b,%cpkdt+pktbuf ;B=output aobjn pointer move t,(c) ;Reprocess 1st word aoj c, tlne f,%doimg ;Right justify it for loop ifskp. ;If ascii lsh t,-1 aoj d, ;One more available bit endif. do. cain c,bufend movei c,buf move tt,(c) lshc t,(d) movem t,(b) aobjp b,endlp. sub d,fudge ;WdLen-32 ifl. d lshc t,40 movem t,(b) aobjp b,endlp. addi d,40 endif. movn e,d lshc t,40(e) aoja c,top. enddo. .call pktout ;Send the packet .lose jrst cpopj1 jioti: skipg d,iotcnt jrst goloop note "AJiotI " nout iotcnt note "/" nout bufcnt note "..." skipe c,bufcnt ;How many bytes do we have available ifskp. ;None trnn f,f%eofi ;Server sez end of file? jrst goloop ;No, go wait for more note "" move a,jbcop ;Else tell user about eof tlnn a,%jgsio ;If SIOT tlne f,%doblk ;Or block mode jrst jret ;Just wake him up tlnn f,%doimg ;Else unit mode IOT jrst [.iot chboj,[-1,,^C] ;If ascii, indicate EOF jrst goloop] syscal jobioc,[%climm,,chboj ? %climm,,2] ;Else IOCERR for EOF jrst bojint jrst goloop endif. call bojiot ;Do it, B gets new bufptr skipn iotcnt ifskp. nout iotcnt note " left to send." else. note "All." endif. call sndalc ;Send allocation if appropriate jrst jioti ;Go try again ;Send allocation if necessary. Call with B/bufptr sndalc: tlnn f,%doblk ;Get address of first used word ibp b tlz b,-1 move a,b ;See how many words we could allocate sub a,alcptr sosge a ;Always leave one for image mode overflow addi a,bufl note "{alccnt:" nout alccnt note " Room:" nout a note "}" caige a,bufl/2 ;At least half the buffer? ret ;No, don't bother note "ASending Allocation " sos b ;Save new pointer caige b,buf addi b,bufl movem b,alcptr imul a,wdlen nout a addm a,alccnt ;and count push p,a ;Now send the command movei a,r.alc call setcmd pop p,a call wdec callret sndcmd ;XDAT - read data from net ;Enters with opcode in B. xdat: note "Data..." skipl accseq ;Waiting for access ack's? jrst goloop ;Yea, keep waiting trne f,f%eofi bug ldb a,[$cpknb+pktbuf] jumpe a,goloop imuli a,8 ;Number of bits in packet trz b,%colst ;Subtract padding sub a,b ;A=# data bits in packet nout a note "bits" movn b,a ;Update alccnt addm b,alccnt note "(alccnt=" nout alccnt note ")..." skipge alccnt bug hlrz b,netptr ;Update byte count idiv b,bytsiz add c,a move b,bytsiz txne f,f%blka move b,wdlen idiv c,b addm c,bufcnt hlrz d,netptr ;D=bit count in last word add a,d ;Update the bit count idiv a,wdlen hrlm b,netptr hrrz b,netptr movni a,1(a) hrl b,a ;B= output aobjn pointer movei c,%cpkdt+pktbuf ;C= input address movei a,buf+bufl ;A= bufend, for easy wraparound checking move t,(b) ;Re-do the last word do. lsh t,-36.(d) sub d,fudge ifl. d move tt,(c) aoj c, lshc t,32. addi d,32. endif. move tt,(c) aoj c, movni e,4(d) rotc t,(e) tlnn f,%doimg lsh tt,1 cain a,(b) hrri b,buf movem tt,(b) aobjn b,top. enddo. soj b, hrrm b,netptr ldb b,[$cpkop+pktbuf] ;Is this an eof packet? caige b,%colst jrst jioti ;No, just go see if user wants this data tro f,f%eofi ;Hit end of file note "" trnn f,f%blka ;If block ascii mode then might need to pad jrst jioti ;beyond the ascii eof for the user hlrz a,netptr idivi a,7 jumpe a,jioti ;If didn't end on word boundary move b,netptr ;Skip over complete bytes we've received hrli b,440700 ibp b sojg a,.-1 movei c,^C ;And fill the rest with ^C's idpb c,b tlne b,700000 jrst .-2 aos bufcnt ;Count this last word jrst jioti ;;BOJIOT: perform an IOT/SIOT on the BOJ channel. ;;Called with C/# bytes available ;; D/# bytes requested ;;Updates bufptr/bufptn,bufcnt,iotcnt and raccp. ;; Returns with A/new raccp ;; B/new bufptr bojiot: camle c,bufptn ;Only go to end of buffer, since IOT/SIOT will move c,bufptn ;not wrap for us camle c,d ;Don't take more than he has move c,d ;C= # bytes we will read sub d,c ;# bytes of user's IOT that will be left. movem d,iotcnt move b,bufptr tlne f,%doblk ifskp. ;Unit mode move a,c syscal siot,[%climm,,chboj ? b ? c] .Lose sub a,c ;A=# bytes we got, C=# bytes we didn't get else. ;Else block mode movn a,c ;Make AOBJN ptr to the words we can read. hrl b,a .iot chboj,b hrrzs a,b sub a,bufptr ;A=# words we got sub c,a ;C=# words we didn't get endif. skipe c ;If didn't get everything, pclsr'd, so don't setz d, ;try to get any more. movn c,a ;Decrement counts addm c,bufcnt ;This many fewer bytes available addm c,bufptn ;And fewer til end of BUF skipe bufptn ;Reached end of BUF? ifskp. subi b,bufl ;Yes, wrap move c,bufsiz movem c,bufptn endif. movem b,bufptr addb a,raccp ret ;Here from GOLOOP to process input from net. ntint: note "ANet Input interrupt..." syscal whyint,[%climm,,chneti ? %clout,,a ? %clout,,b ? %clout,,c] .Lose %lssys cain a,%wycha caie b,%csopn jrst [note "AConn state=" nout b note " A=" nout a jrst ntioc] tlnn c,-1 jrst goloop ;No more input, done txo f,fi%nti ;Else come back here when done note "read..." .call pktin .lose %lsfil ldb b,[$cpkop+pktbuf] cail b,%codat caile b,%codat+17 caia jrst xdat cain b,%coasy jrst xioc note "reply..." call rreply move c,b andi c,377 cain c,r.cls jrst xcls cain c,r.acc jrst xacc cain c,r.rnmwo jrst xrnmwo cain c,r.delwo jrst xdelwo cain c,r.rsts jrst xrsts cain c,r.sfd jrst xsfdat cain c,r.srd jrst xsrdat cain c,r.saut jrst xsauth note "Unknown!" bug ;Read a reply packet. B gets sequence#+opcode, A gets error ;code, V/W set up for reading data reply: .call pktin .lose ldb b,[$cpkop+pktbuf] rreply: caie b,%colos cain b,%cocls jrst [note "ALoss or Close pkt received" jrst ntioc] cain b,%coeof jrst [note "AEOF pkt received" jrst ntioc] caie b,%corpl bug ldb v,[$cpknb+pktbuf] subi v,4 skipge v bug ldb b,[143000,,%cpkdt+pktbuf] move w,[041000,,%cpkdt+pktbuf] ldb a,w ret ;Server reports asynchronous lossage. xioc: ldb a,[341000,,%cpkdt+pktbuf] note "server IOC error #" nout a syscal jobioc,[%climm,,chboj ? a] ;report it to the creator. jfcl die ;Give the user an IOC error because the connection is closed. ;The server is most likely to use 3=non-recoverable data error for his ;errors, so we pick something else.. ntioc: note "ALocal net error!" syscal jobioc,[%climm,,chboj ? %climm,,1] ;Illegal hardware operation jfcl die subttl subroutines to read/write command packets ;Start creating a command packet in PKTBUF. A has opcode. ;On return, W is a BP to store the rest, A is the transaction code setcmd: move w,[141000,,%cpkdt+pktbuf] dpb a,w aos a,seqnum dpb a,[242000,,%cpkdt+pktbuf] ;Sequence ldb a,[143000,,%cpkdt+pktbuf] ;Return whole seq+opcode id ret wsix: setz b, rotc a,6 addi b,40 idpb b,w jumpn a,wsix ret wdec: idivi a,10. ifn. a push p,b call wdec pop p,b endif. addi b,"0 idpb b,w ret wstr: hrli a,440700 do. ildb b,a jumpe b,cpopj idpb b,w loop. enddo. ;Send the packet in PKTBUF, assuming that W contains a bp ;down which the text of the packet has been stuffed. sndcmd: movei b,1-pktbuf-%cpkdt(w) ;Compute length of packet imuli b,4 lsh w,-41 sub b,w movei a,%comnd dpb a,[$cpkop+pktbuf] dpb b,[$cpknb+pktbuf] .call pktout .lose %lsfil ret rwdec: sojl v,cpopj ildb b,w cain b,chnl ret aos (p) ;Have a number, so skip return setz a, do. cail b,"0 caile b,"9 bug imuli a,10. addi a,-"0(b) sojl v,cpopj ildb b,w cain b,chnl ret loop. enddo. rwstr: hrli a,440700 do. sojl v,endlp. ildb b,w cain b,chnl exit. idpb b,a loop. enddo. setz b, idpb b,a ret rwsix: setz a, move b,[440600,,a] do. sojl v,cpopj ildb c,w cain c,chnl ret cail c,140 subi c,40 subi c,40 tlne b,770000 idpb c,b loop. enddo. subttl filename parsing fnblen==30. ;At most 30. components .scalar temfn1(fnmstl),fnb1(2*fnblen) ;Initial user string .scalar temfn2(3),fnb2(2*fnblen) ;Default dir .scalar fnb(2*fnblen) ;Merged block .scalar trufnb ;trunam pointer after opnchk ;;Check if trunam filename (not counting device/dir) can be expressed exactly ;;as 2 sixbit words, which are returned in a,b. opnchk: move b,[-2*fnblen,,fnb] move d,[440700,,trunam] call rfnl"rfn ret movem b,trufnb do. ;Skip to filenames proper jumpge b,cpopj ldb a,1(b) caie a,": cain a,"; caia exit. add b,[2,,2] loop. enddo. hlrz a,b caie a,-4 ;Must be exactly two filenames ret call namsix ret push p,a add b,[2,,2] call namsix ret move b,a pop p,a jrst cpopj1 ;;Convert trunam to ITS format in RDEVN unpars: move b,[-2*fnblen,,fnb] move d,[440700,,trunam] call rfnl"rfn nop setzm rdevn+1 setzm rdevn+2 setzm rdevn+3 do. ;Skip device jumpge b,cpopj ldb a,1(b) caie a,": exit. add b,[2,,2] loop. enddo. caie a,"; ;Process directory ifskp. call namsix move a,[sixbit/.CANT./] movem a,rdevn+3 do. add b,[2,,2] jumpge b,cpopj ldb a,1(b) ;Is the next one also a directory? caie a,"; exit. move a,[sixbit/.CANT./] ;Yea, we lose movem a,rdevn+3 loop. enddo. endif. call namsix nop movem a,rdevn+1 add b,[2,,2] jumpge b,cpopj call namsix nop movem a,rdevn+2 note "(" nsix rdevn note ":" nsix rdevn+3 note ";" nsix rdevn+1 note " " nsix rdevn+2 note ")" ret ;;Given name in (b)-1(b), return its sixbit rep in a. ;;Skips if rep is exact. namsix: setz a, hrrzs (p) move e,[440600,,a] move d,(b) do. ildb c,d camn d,1(b) exit. tlnn e,770000 ret ;longer than 6 chars caie c,^Q ifskp. camn d,1(b) ret ;Could happen if had ^Q^@ ildb c,d cail a,140 ;Quoted lower case can't be represented.. hrros (p) endif. caige c,40 hrros (p) caige c,140 ifskp. cail c,"a caile c,"z hrros (p) ;Non-letter "uppercase" chars can't go... subi c,40 endif. subi c,40 idpb c,e loop. enddo. skipl (p) cpopj1: aos (p) cpopj: ret ;Get user filename into pointer in W. Called with A=pointer,B/C/D=snm/fn1/fn2 usrfnm: call getusr ;get it into temfn1/fnb1 push p,b ;Save block move d,[440700,,temfn2] ;Make default name, just "SNAME;" movem d,fnb2 .uset chboj,[.rsname,,a] movei b,"; call sixnam movem d,fnb2+1 pop p,a ;Get user's spec move b,[-2,,fnb2] ;and the default jrst usrmrg ;Get user name, defaulting sname from TRUNAM, for RENMWO... Really should ;default it from the specified name, in case there are links... Don't ;worry about it for now, there are no servers on hosts with links. ;When do fix it, remember to updated the 'specified' name when renmwo is done! usrtfn: call getusr push p,b move b,[-2*fnblen,,fnb2] move d,[440700,,trunam] call rfnl"rfn nop do. jumpge b,endlp. ldb a,1(b) caie a,": cain a,"; caia exit. add b,[2,,2] loop. enddo. movni c,-fnb2(b) hrl b,c hrri b,fnb2 pop p,a usrmrg: move c,[-2*fnblen,,fnb] ;Merged block here setz d, ;Normal defaulting call rfnl"merge ;Merge nop move b,c ;B=fnm block move d,w ;D=output bp add b,[2,,2] ;Punt the first device (XX: or whatever) skipl b ;Check next tdza a,a ldb a,1(b) cain a,": ;Another device? ifskp. push p,b move a,fdevn ;No, use the default one movei b,": call sixnam pop p,b movei a,.chspc ;Add a space if there is something else there skipge b ;(just for compatibility with rnfl"pfn) idpb a,d endif. call rfnl"pfn ;Append name move w,d ;Update pointer setz a, idpb a,d ret getusr: ife. a ;If no user pointer push p,d ;Just make a string from the sixbit names push p,c push p,b move d,[440700,,temfn1] move a,rdevn movei b,": call sixnam pop p,a movei b,"; call sixnam pop p,a movei b,.chspc call sixnam pop p,a movei b,0 call sixnam move d,[440700,,temfn1] else. .uset chboj,[.ruindex,,b] ;Fetch user string syscal open,[%clbit,,.bai ? %climm,,chusr [sixbit/usr/] ? %climm,,%jsnum(b) ? %climm,,0] die hrrz b,a .access chusr,b move b,[-fnmstl,,temfn1] .iot chusr,b .close chusr, move d,a hrri d,temfn1 ;This is wrong in the aobjn pointer case, I had misunderstood. ;Fix it! tlne d,77 ;Make sure it's a bp (not an aobjn pointer) hrli d,440700 ;Aobjn pointer or something weird, force it endif. move b,[-2*fnblen,,fnb1] call rfnl"rfn nop ret sixnam: jumpe a,cpopj ;Output sixbit filename with quoting push p,b movei c,^Q do. setz b, rotc a,6 addi b,40 caie b,": cain b,"; idpb c,d cain b,.chspc idpb c,d idpb b,d jumpn a,top. enddo. pop p,b idpb b,d ret $$rfn==1 $$pfn==1 $$merge==1 ifn dbgsw,junk1:constants .insrt dsk:syseng;rfnl rfnl"pfnspc: rfnl"rfnspc: popj p, TSINT: 0 0 SKIPL U,TSINT JRST TSFW TRNN U,1_CHBOJ+1_CHNETI+1_CHNETO .VALUE TRZE U,1_CHBOJ TRO F,FI%BOJ TRZE U,1_CHNETI TRO F,FI%NTI TRZE U,1_CHNETO TRO F,FI%NTO CAME U,[SETZ] .VALUE SETOM INT .DISMISS TSINT+1 TSFW: note "A*TSFW*A" TRNN U,%PIIOC .VALUE .SUSET [.RBCHN,,U] CAIE U,CHNETI CAIN U,CHNETO CAIA .VALUE TXNN F,F%OPEN .DISMISS [NOGO] ;ERROR CONNECTING => DEV NOT AVAILABLE .DISMISS [NTIOC] ;ERROR TRANSFERRING => IOC ERROR JOBCAL: SETZ SIXBIT /JOBCAL/ %CLIMM,,CHBOJ %CLOUT,,JBCOP SETZ [-JBCLEN,,JBC] JOBSTS: SETZ SIXBIT /JOBSTS/ %CLIMM,,CHBOJ %CLIMM,,43 ;SNDSK RDEVN RDEVN+1 RDEVN+2 RDEVN+3 OPMODE SETZ [440700,,SYSNAM] JBRWIN: SETZ SIXBIT /JOBRET/ %CLIMM,,CHBOJ SETZI 1 JBRET: SETZ SIXBIT /JOBRET/ %CLIMM,,CHBOJ SETZI 0 JBRVAL: SETZ ;JOBRET a value SIXBIT /JOBRET/ %CLIMM,,CHBOJ %CLIMM,,1 SETZ RETVAL JBRFNF: SETZ ;JOBRET error code 4 ("File not found"). SIXBIT /JOBRET/ %CLIMM,,CHBOJ SETZ [%ENSFL,,0] JBRERR: SETZ ;JOBRET AN ERROR CODE. SIXBIT /JOBRET/ %CLIMM,,CHBOJ SETZ ERRCOD PKTOUT: SETZ SIXBIT/PKTIOT/ %CLIMM,,CHNETO SETZI PKTBUF PKTIN: SETZ SIXBIT/PKTIOT/ %CLIMM,,CHNETI SETZI PKTBUF ;; Assorted subroutines $$CHAOS==1 $$HSTMAP==1 $$HOSTNM==1 $$SYMLOOK==1 $$HST3==1 ;Hosts2 tables are no longer up to date. $$CONNECT==1 .INSRT DSK:SYSENG;NETWRK > ;Lookup sixbit host in A sixhst: camn a,[sixbit/SP/] ;Special dispensation move a,[sixbit/SPEECH/] move w,[440700,,buf] call wsix setz a, idpb a,w movei a,buf callret netwrk"hstlook DATIME"$$SVNG==1 DATIME"$$ABS==1 .INSRT DSK:SYSENG;DATIME > ifn dbgsw,[ $note: exch t,(p) ifxe. f,f%dbug pop p,t ret endif. push p,tt ;t/address of length+string, have push p,t ? push p,tt move tt,(t) movei t,1(t) hrli t,440700 syscal siot,[%climm,,chtyo ? t ? tt] .Lose %LsSys $nret: pop p,tt pop p,t ret $nsix: exch t,(p) ifxe. f,f%dbug pop p,t ret endif. push p,tt move t,@(t) do. setz tt, rotc t,6 addi tt,40 .iot chtyo,tt jumpn t,top. enddo. jrst $nret $nstr: exch t,(p) ifxe. f,f%dbug pop p,t ret endif. push p,tt move t,(t) hrli t,440700 do. ildb tt,t jumpe tt,$nret .iot chtyo,tt loop. enddo. $nout: exch t,(p) ifxe. f,f%dbug pop p,t ret endif. push p,tt move t,@(t) ifl. t .iot chtyo,["-] movns t endif. call .nout pop p,tt pop p,t ret .nout: idivi t,10. ifn. t push p,tt call .nout pop p,tt endif. addi tt,"0 .iot chtyo,tt ret ] bugchk: ;Dump and send mail and stuff die bug==:call bugchk CONSTANTS VARIABLES BUFL==10000-. ;TRY TO FIT IN 4K IFL BUFL-2000,BUFL==2000+ ;OH, WELL BUF: BLOCK BUFL-1 -1 ;Make sure enough core gets dumped. BUFEND:: HSTPAG==:<.+1777>/2000 ;Host tables go here DEFINE INFORM A,B PRINTX/A=B /TERMIN IF2 INFORM Buffer size,\bufl IF2 INFORM Pages used,\<<.+1777>/2000> end begin