diff --git a/Makefile b/Makefile index 97cd005f..50c460d8 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ EMULATOR ?= simh -SRC = system syseng sysen1 sysen2 sysnet kshack dragon channa midas _teco_ emacs emacs1 rms klh syshst sra mrc ksc cstacy gren bawden emacs1 _mail_ l lisp liblsp libdoc comlap lspsrc nilcom rwk inquir acount +SRC = system syseng sysen1 sysen2 sysnet kshack dragon channa midas _teco_ emacs emacs1 rms klh syshst sra mrc ksc cstacy gren bawden emacs1 _mail_ l lisp liblsp libdoc comlap lspsrc nilcom rwk inquir acount gz DOC = info _info_ sysdoc kshack _teco_ emacs emacs1 MINSYS = _ sys sys3 device sysbin inquir diff --git a/README.md b/README.md index a70c6e80..ae542e55 100644 --- a/README.md +++ b/README.md @@ -115,6 +115,7 @@ from scratch. - DIRED, directory editor (independent from EMACS DIRED) - HSNAME, displays user's HSNAME - ARCSAL, archive salvager + - RMTDEV, MLDEV for non-ITS hosts 6. A brand new host table is built from the host table source and installed into SYSBIN; HOSTS3 > using H3MAKE. diff --git a/build/build.tcl b/build/build.tcl index c9f51535..9343b523 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -660,6 +660,10 @@ expect ":KILL" respond "*" ":midas sys1;ts arcsal_sysen1;arcsal\r" expect ":KILL" +# rmtdev +respond "*" ":midas device;atsign rmtdev_gz;rmtdev\r" +expect ":KILL" + # ndskdmp tape respond "*" ":link kshack;good ram,.;ram ram\r" diff --git a/src/gz/rmtdev.59 b/src/gz/rmtdev.59 new file mode 100644 index 00000000..6199bfdd --- /dev/null +++ b/src/gz/rmtdev.59 @@ -0,0 +1,2096 @@ +;-*- 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 diff --git a/src/midas/macsym.14 b/src/midas/macsym.14 new file mode 100644 index 00000000..700ffed7 --- /dev/null +++ b/src/midas/macsym.14 @@ -0,0 +1,679 @@ +;;The official source for this file is MIDAS;MACSYM > +;;Midas versions of some MACSYM.MAC macros, by GZ@MC. +;;(Also some useful macros/symbols no supported by MACSYM.MAC) + +;Stuff supported (will add more stuff as need arises): +; PGVER. VMAJ,VMIN,VEDIT,VWHO and related masks(VI%MAJ,VI%MIN,VI%EDN,VI%WHO) +; Random symbols (.INFIN,.MINFI,.LHALF,.RHALF,.FWORD, .CHxxx, +; ASCPTR, USRLH, PSLH, .PRxxx) +; FLD(VAL,MSK) & BIT(n) & POINT SIZE,ADDR,OFFSET & ERNOP & ERSKP +; MOVX AC,MASK & TXxx AC,MASK & JXx AC,MASK,ADDR & LOAD/STOR AC,MASK,ADDR +; DO./ENDDO. macros (and related stuff) +; IFxxx/ANxxx macros +; TMSG /text/, FMSG /text/, EMSG /text/ +; SAVEACS [A,B,C,D] & SAVE. [LOC,LOC,LOC] +; FLDDB.(FUNC,FLAGS,DATA,"Help","Default",NEXT) +; FLDBK.(FUNC,FLAGS,DATA,"Help","Default",BRKMASK,NEXT) +; BRMSK.(INI0,INI1,INI2,INI3,[ALLOW],[DISALLOW]) +IFNDEF $$JSER,$$JSER==0 ; Conditional on $$JSER: +; PERSTR /optional msg/ +; ERMSG /text/ +; JSERR/EJSERR/JSHLT/EJSHLT +; and support code for above. +IFNDEF $$STK,$$STK==0 ; Conditional on $$STK: +; CALL/RET/RETSKP/CALLRET +; STKVAR [AA,[QQ,5],ZZ]/ENDSV. +; labels RSKP and R +; and support code for above. + + +.KILL ..XX,..TXZ,..TXO,..TXC,..X0,..X1,..X2,..X3,TOP. +.XCREF ..XX,..TXZ,..TXO,..TXC,..X0,..X1,..X2,..X3 +.XCREF ..DX,..IX,..EX,.SAVX1,.SAVX2,..BRK + +IF2,IFE $$STK\$$JSER,.INEOF ;Don't bother if no code + +;.NSTGW ;No storage words in this part + +DEFINE PGVER. (VMAJ,VMIN,VEDIT,VWHO) + ..XX==. + LOC 137 +.JBVER: .BYTE 3.,9.,6.,18. + VWHO + VMAJ + VMIN + VEDIT + .BYTE + LOC ..XX +TERMIN + +;MASKS FOR THE ABOVE + +VI%WHO==:700000,,000000 ;Customer edit code +VI%MAJ==:077700,,000000 ;Major version number +VI%MIN==:000077,,000000 ;Minor version/update +VI%EDN==:000000,,777777 ;Edit number + +;MISC CONSTANTS + +.INFIN==:377777,,777777 ;PLUS INFINITY +.MINFI==:400000,,000000 ;MINUS INFINITY +.LHALF==:-1,,0 ;LEFT HALF +.RHALF==:0,,-1 ;RIGHT HALF +.FWORD==:-1 ;FULL WORD +ASCPTR==:440700,,0 +USERLH==:500000 +PSLH==:540000 + +;MIT EXEC PRARG command codes + .PRCCL==0 ;redo last CCL command + .PRKEP==1 ;keep fork, and halt it + .PRKIL==2 ;kill fork + .PRBKG==3 ;continue fork in background + + +;SYMBOLS FOR THE CONTROL CHARACTERS + +.CHNUL==:000 ;NULL +.CHCNA==:001 +.CHCNB==:002 +.CHCNC==:003 +.CHCND==:004 +.CHCNE==:005 +.CHCNF==:006 +.CHBEL==:007 ;BELL +.CHBSP==:010 ;BACKSPACE +.CHTAB==:011 ;TAB +.CHLFD==:012 ;LINE-FEED +.CHVTB==:013 ;VERTICAL TAB +.CHFFD==:014 ;FORM FEED +.CHCRT==:015 ;CARRIAGE RETURN +.CHCNN==:016 +.CHCNO==:017 +.CHCNP==:020 +.CHCNQ==:021 +.CHCNR==:022 +.CHCNS==:023 +.CHCNT==:024 +.CHCNU==:025 +.CHCNV==:026 +.CHCNW==:027 +.CHCNX==:030 +.CHCNY==:031 +.CHCNZ==:032 +.CHESC==:033 ;ESCAPE +.CHCBS==:034 ;CONTROL BACK SLASH +.CHCRB==:035 ;CONTROL RIGHT BRACKET +.CHCCF==:036 ;CONTROL CIRCUMFLEX +.CHCUN==:037 ;CONTROL UNDERLINE +.CHSPC==:040 ;SPACE + +.CHALT==:175 ;OLD ALTMODE +.CHAL2==:176 ;ALTERNATE OLD ALTMODE +.CHDEL==:177 ;DELETE + +;PC FLAGS + +PC%OVF==:400000,,0 ;OVERFLOW +PC%CY0==:200000,,0 ;CARRY 0 +PC%CY1==:100000,,0 ;CARRY 1 +PC%FOV==:040000,,0 ;FLOATING OVERFLOW +PC%BIS==:020000,,0 ;BYTE INCREMENT SUPPRESSION +PC%USR==:010000,,0 ;USER MODE +PC%UIO==:004000,,0 ;USER IOT MODE +PC%LIP==:002000,,0 ;LAST INSTRUCTION PUBLIC +PC%AFI==:001000,,0 ;ADDRESS FAILURE INHIBIT +PC%ATN==:000600,,0 ;APR TRAP NUMBER +PC%FUF==:000100,,0 ;FLOATING UNDERFLOW +PC%NDV==:000040,,0 ;NO DIVIDE + + +DEFINE FLD (VAL,MASK) +<.DPB ,<.BP ,>,0>TERMIN + +DEFINE BIT (N) +<1_<35.->>TERMIN + +DEFINE POINT SIZE=7,ADDR=0,COUNT=0 +RADIX 8+2 +..X1==SIZE +..X2==COUNT +RADIX 8 +..XX==<..X2-1>/<36./..X1> +..X2==..X2-..XX*<36./..X1> +<<<36.-<..X1*..X2>>_30.>+<..X1_24.>++..X1> +TERMIN + +DEFINE ERNOP + ERJMP .+1 +TERMIN + +DEFINE ERSKP + ERJMP .+2 +TERMIN + +ABSKP==:TRNA + +;MOVX - LOAD AC WITH CONSTANT + +DEFINE MOVX AC,#MSK + IFE <-1,,0>&MSK,[MOVEI AC,MSK] + .ELSE [IFE <0,,-1>&MSK,[MOVSI AC,(MSK)] + .ELSE [IFE <<-1,,0>&MSK>-<-1,,0>,[HRROI AC,MSK] + .ELSE [IFE <<0,,-1>&MSK>-<0,,-1>,[HRLOI AC,(MSK&.LHALF)] + .ELSE [MOVE AC,[MSK]]]]] +TERMIN + +;TX - TEST MASK + +IRP OP,,[N,NA,OE,ON,OA,ZE,ZN,ZA,CE,CN,CA] + DEFINE TX!OP AC,#MSK + IFE <-1,,0>&MSK,[TR!OP AC,MSK] + .ELSE [IFE <0,,-1>&MSK,[TL!OP AC,(MSK)] + .ELSE [TD!OP AC,[MSK]]] + TERMIN +TERMIN + +IRP OP,,[N,E] + DEFINE TXN!OP AC,#MSK + IFE <-1,,0>&MSK,[TRN!OP AC,MSK] + .ELSE [IFE <0,,-1>&MSK,[TLN!OP AC,(MSK)] + .ELSE [IFE MSK+1,[CAI!OP AC,0] + .ELSE [TDN!OP AC,[MSK]]]] + TERMIN +TERMIN + +..TXZ==ANDI +..TXO==ORCMI +..TXC==EQVI +IRP OP,,[Z,O,C] + DEFINE TX!OP AC,#MSK + IFE <-1,,0>&MSK,[TR!OP AC,MSK] + .ELSE [IFE <0,,-1>&MSK,[TL!OP AC,(MSK)] + .ELSE [IFE <<-1,,0>&MSK>-<-1,,0>,[..TX!OP AC,-1#MSK] + .ELSE [TD!OP AC,[MSK]]]] + TERMIN +TERMIN + +EQUALS IORX,TXO +EQUALS XORX,TXC + +DEFINE ANDX AC,#MSK +TXZ AC,-1#MSK +TERMIN + + SUBTTL JX -- JUMP ON MASK + +;JXE -- JUMP IF MASKED BITS ARE EQUAL TO 0 +;JXN -- JUMP IF MASKED BITS ARE NOT EQUAL TO 0 +;JXO -- JUMP IF MASKED BITS ARE ALL ONES +;JXF -- JUMP IF MASKED BITS ARE NOT ALL ONES (FALSE) + +DEFINE JXE AC,#MSK,?ADR + IFE MSK-.MINFI,[JUMPGE AC,ADR] + .ELSE [IFE MSK+1,[JUMPE AC,ADR] + .ELSE [TXNN AC,MSK + JRST ADR]] +TERMIN + +DEFINE JXN AC,#MSK,?ADR + IFE MSK-.MINFI,[JUMPL AC,ADR] + .ELSE [IFE MSK+1,[JUMPN AC,ADR] + .ELSE [TXNE AC,MSK + JRST ADR]] +TERMIN + +DEFINE JXO AC,#MSK,?ADR + IFE <.LZ MSK,>+<.TZ MSK,>-35.,[JXN AC,MSK,ADR] + .ELSE [TXC AC,MSK + TXCN AC,MSK + JRST ADR] +TERMIN + +DEFINE JXF AC,#MSK,?ADR +IFE <.LZ MSK,>+<.TZ MSK,>-35.,[JXE AC,MSK,ADR] +.ELSE [TXC AC,MSK + TXCE AC,MSK + JRST ADR] +TERMIN + +;LOAD, STOR +DEFINE LOAD AC,#MSK,?LOCN + IFE MSK+1,[MOVE AC,LOCN] + .ELSE [IFE MSK-777777,[HRRZ AC,LOCN] + .ELSE [IFE MSK-<-1,,0>,[HLRZ AC,LOCN] + .ELSE [LDB AC,[.BP MSK,LOCN]]]] +TERMIN + +DEFINE STOR AC,#MSK,?LOCN + IFE MSK+1,[MOVEM AC,LOCN] + .ELSE [IFE MSK-777777,[HRRM AC,LOCN] + .ELSE [IFE MSK-<-1,,0>,[HRLM AC,LOCN] + .ELSE [DPB AC,[.BP MSK,LOCN]]]] +TERMIN + + SUBTTL BLOCK MACROS + +;MACROS TO PROVIDE SOME BLOCK HANDLING OF CODE + +;DO. - LOOP STRUCTURE, DECLARES TOP OF LOOP +; LOOP. - JUMPS TO TOP OF LOOP +; EXIT. - EXITS LOOP +; TOP. - TAG AT TOP OF LOOP FOR JUMPS, E.G. SOJG T4,TOP. +; ENDLP. - TAG AT END OF LOOP FOR JUMPS, E.G. SOJL T4,ENDLP. + +DEFINE DO. + ..DX +TERMIN + +DEFINE ..DX \%TGE,%SV1,%SV2,%SV3 + EQUALS %SV1,TOP. ? EQUALS %SV2,ENDDO. ? EQUALS %SV3,ENDLP. + .KILL %SV1 + TOP.==. + DEFINE ENDDO. + %TGE::EQUALS TOP.,%SV1 ? EQUALS ENDDO.,%SV2 ? EQUALS ENDLP.,%SV3 + .KILL %TGE + TERMIN + DEFINE ENDLP. +%TGE!!TERMIN +TERMIN + +DEFINE ENDDO. +.ERR ENDDO. outside loop +TERMIN +DEFINE ENDLP. +.ERR ENDLP. outside loop +TERMIN +TOP.==-1 + +DEFINE OD. +ENDDO.!TERMIN + +DEFINE LOOP. +JRST TOP.!TERMIN + +DEFINE EXIT. +JRST ENDLP.!TERMIN + + +;Conditionals + +DEFINE IFSKP. +..IX [JRST ] +TERMIN + +DEFINE IFNSK. +ABSKP + ..IX [JRST ] +TERMIN + +DEFINE IFXN. AC,#MASK + IFE 1_35.-MASK,..IX [JUMPGE AC,] + .ELSE [IFE MASK+1,..IX [JUMPE AC,] + .ELSE [TXNN AC,MASK + ..IX [JRST ] + ]] +TERMIN + +DEFINE IFXE. AC,#MASK + IFE 1_35.-MASK,..IX [JUMPL AC,] + .ELSE [IFE MASK+1,..IX [JUMPN AC,] + .ELSE [TXNE AC,MASK + ..IX [JRST ] + ]] +TERMIN + +DEFINE IFJER. +ERJMP .+2 + ..IX [JRST ] +TERMIN + +DEFINE IFNES. + PRINTX /% IFNES. should be changed to IFJER. +/ + IFJER. +TERMIN + +DEFINE IFNJE. +..IX [ERJMP ] +TERMIN + +DEFINE IFESK. + PRINTX /% IFESK. should be changed to IFNJE. +/ + IFNJE. +TERMIN + +DEFINE IFE. AC +..IX [JUMPN AC,] +TERMIN + +DEFINE IFN. AC +..IX [JUMPE AC,] +TERMIN + +DEFINE IFG. AC +..IX [JUMPLE AC,] +TERMIN + +DEFINE IFGE. AC +..IX [JUMPL AC,] +TERMIN + +DEFINE IFLE. AC +..IX [JUMPG AC,] +TERMIN + +DEFINE IFL. AC +..IX [JUMPGE AC,] +TERMIN + +DEFINE ..IX OP,\%TAG,%SV1,%SV2 + OP!%TAG + EQUALS %SV1,..TG ? EQUALS %SV2,ENDIF. + DEFINE ..TG LBL + %TAG!!LBL!TERMIN + DEFINE ENDIF. + ..TG [::] + .KILL ..TG + EQUALS ..TG,%SV1 ? EQUALS ENDIF.,%SV2 + TERMIN +TERMIN + +DEFINE ELSE. +..EX +TERMIN + +DEFINE ..EX \%TAG + JRST %TAG + ..TG [::] + DEFINE ..TG LBL + %TAG!!LBL!TERMIN +TERMIN + +DEFINE ..TG LBL + .ERR Conditional construct outside a conditional +TERMIN + +DEFINE ENDIF. + .ERR ENDIF. outside a conditional +TERMIN + + +;GENERAL CASES WITHIN CONDITIONALS + +DEFINE ANSKP. + JRST ..TG +TERMIN + +DEFINE ANNSK. + ABSKP + JRST ..TG +TERMIN + +DEFINE ANJER. + ERJMP .+2 + JRST ..TG +TERMIN + +DEFINE ANNJE. + ERJMP ..TG +TERMIN + +DEFINE ANDXN. AC,#MASK +IFE 1_35.-MASK,JUMPGE AC,..TG +.ELSE [IFE MASK+1,JUMPE AC,..TG + .ELSE [TXNN AC,MASK + JRST ..TG + ]] +TERMIN + +DEFINE ANDXE. AC,#MASK +IFE 1_35.-MASK,JUMPL AC,..TG +.ELSE [IFE MASK+1,JUMPN AC,..TG + .ELSE [TXNE AC,MASK + JRST ..TG + ]] +TERMIN + +DEFINE ANDE. AC + JUMPN AC,..TG +TERMIN + +DEFINE ANDN. AC + JUMPE AC,..TG +TERMIN + +DEFINE ANDG. AC + JUMPLE AC,..TG +TERMIN + +DEFINE ANDGE. AC + JUMPL AC,..TG +TERMIN + +DEFINE ANDLE. AC + JUMPG AC,..TG +TERMIN + +DEFINE ANDL. AC + JUMPGE AC,..TG +TERMIN + + +;MACRO TO PRINT MESSAGE ON TERMINAL + +DEFINE TMSG &MSG + HRROI 1,[ASCIZ MSG] + PSOUT +TERMIN + +;MACRO TO OUTPUT MESSAGE TO FILE +; ASSUMES JFN ALREADY IN .AC1 + +DEFINE FMSG &MSG + HRROI 2,[ASCIZ MSG] + MOVEI 3,0 + SOUT +TERMIN + +DEFINE EMSG &MSG + HRROI 1,[ASCIZ MSG] + ESOUT +TERMIN + +; SAVEAC [A,B,C] +; Supports +1/+2 returns. +; Unlike macro version, supports arbitrary locations (not just AC's) +; and doesn't clobber AC16. + +DEFINE SAVEAC ACS + IRP AC,,[ACS] + PUSH P,AC + ..XX==.IRPCNT + TERMIN + .SAVX1 ..XX+1,[ACS] +TERMIN + +EQUALS SAVE.,SAVEAC ;Not in MACRO version... + +DEFINE .SAVX1 #N#,ACS + PUSH P,[[ABSKP + AOS -N(P) + .SAVX2 [ACS] + POPJ P, + ]] +TERMIN + +DEFINE .SAVX2 ACS + IRP AC,REST,[ACS] + .SAVX2 [REST] + POP P,AC + .ISTOP + TERMIN +TERMIN + +DEFINE BRMSK. INI0=0,INI1=0,INI2=0,INI3=0,ALLOW,DISALW + ..X0==INI0 + ..X1==INI1 + ..X2==INI2 + ..X3==INI3 + IRPC CH,,[ALLOW] + ..BRK 0,<.ASCVL /CH>/32.,35.-<.ASCVL /CH>&31. + TERMIN + IRPC CH,,[DISALW] + ..BRK 1,<.ASCVL /CH>/32.,35.-<.ASCVL /CH>&31. + TERMIN + ..X0 ? ..X1 ? ..X2 ? ..X3 +TERMIN + +DEFINE ..BRK VAL,#WD,BT + ..X!WD==.DPB VAL,BT!0100,..X!WD +TERMIN + +DEFINE FLDDB. ?FNC,FLAGS=0,DATA=0,&HLPM,DEFM,?NXT=0 +FLDBK.(FNC,FLAGS,DATA,HLPM,DEFM,,NXT)TERMIN + +DEFINE FLDBK. ?FNC,FLAGS=0,DATA=0,&HLPM,DEFM,?BRK,NXT=0 + ..XX==0 + IFSN [HLPM][] ..XX==..XX\CM%HPP + IFSN [DEFM][] ..XX==..XX\CM%DPP + IFSN [BRK][] ..XX==..XX\CM%BRK + <_27.>\\..XX\<0,,NXT> + DATA + IFSN [HLPM][][440700,,[ASCIZ HLPM]] + .ELSE [IFSN [DEFM!BRK][][0]] + IFSN [DEFM][][440700,,[ASCIZ DEFM]] + .ELSE [IFSN [BRK][][0]] + IFSN [BRK][][BRK] +TERMIN + +;.YSTGW ;Allow storage words again + +IFN $$JSER,[ ;Optional Jsys error support + +IFNDEF P,P==:17 + +;MACRO TO PRINT MESSAGE FOR LAST ERROR, RETURNS +1 + +DEFINE PERSTR &MSG + IFSN [MSG][]TMSG MSG + PUSHJ P,JSMSG0 +TERMIN + +;PRINT ERROR MESSAGE IF JSYS FAILS + +DEFINE ERMSG *TEXT + ERJMP [TMSG ż!TEXTŠ JSHLT] +TERMIN + +;JSYS ERROR HANDLER +; CALL JSERR0 +; RETURNS +1: ALWAYS, CAN BE USED IN +1 RETURN OF JSYS'S + +JSERR0: MOVEI 1,.PRIIN + CFIBF ;CLEAR TYPAHEAD + MOVEI 1,.PRIOU + DOBE ;WAIT FOR PREVIOUS OUTPUT TO FINISH + TMSG " +?JSYS error: " +JSMSG0: MOVEI 1,.PRIOU + HRLOI 2,.FHSLF ;SAY THIS FORK ,, LAST ERROR + SETZ 3, + ERSTR + NOP + NOP + TMSG " +" + POPJ P, + +JSERR=: ;Prints last jsys error, returns +1 +EJSERR=: + +;FATAL JSYS ERROR - PRINT MESSAGE AND HALT +; CALL JSHLT0 +; RETURNS: NEVER + +JSHLT0: JSERR ;PRINT THE MSG +JSHLT1: HALTF + TMSG "?Program cannot continue +" + JRST JSHLT1 ;HALT AGAIN IF CONTINUED + +.KILL JSHLT1 + +JSHLT=: ;Prints last jsys error, halts +EJSHLT=: + +];$$JSER + + +IFN $$STK,[ ;Optional stack related support + + SUBTTL STKVAR - STACK VARIABLE FACILITY + +IFNDEF P,P==:17 + +CALL=: +RET=: +CALLRET==: + +;; STKVAR [AA,BB,[QQ,5],ZZ] +;; ENDSV. (end of scope, flush names) +;; Supports return and skip return. +;; Unlike the macro version, AC16 is NOT clobbered. +;; Unlike the macro version, variables defined in left-to-right order +;; (so above, DMOVEM 1,AA will put 1 in AA and 2 in BB) +DEFINE STKVAR ARGS + ..STKN==1+IRP VAR,,[ARGS] <.STKV1(VAR)>+TERMIN + ..STKQ==..STKN + IRP VAR,,[ARGS] + .STKV2 ..STKQ,VAR + TERMIN + DEFINE ENDSV. + IRP ARG,,[ARGS] + .ENSV1(ARG) + TERMIN + .KILL ..STKN,..STKQ + TERMIN + ADJSP P,..STKN + PUSHJ P,.STKST +TERMIN + +DEFINE .STKV1 ?VAR,SIZE=1 +SIZE!TERMIN + +DEFINE .STKV2 #LOC#,VAR,SIZE=1 + DEFINE VAR +-LOC(P)TERMIN + ..STKQ==LOC-SIZE +TERMIN + +DEFINE .ENSV1 (VAR) + EXPUNGE VAR +TERMIN + + +.STKST: EXCH 16,(P) ;Get return address, save AC16 + MOVEM 16,-1(P) ;Save ret address + MOVN 16,-2(16) ;Fetch the word with ..stkn in it, negated + MOVEI 16,(16) ;Clear lhs to allow indirecting in .STKRT + EXCH 16,-1(P) ;Save it, get return address + PUSH P,16 ;Set up for popj + HRRI 16,.STKRT ;Fake return address for caller + EXCH 16,-1(P) ;set it up, restoring AC16 + POPJ P, + +.STKRT: JRST STKRT0 ;Normal return + ADJSP P,@(P) ;Skip return +RSKP: AOS (P) +R: POPJ P, + +STKRT0: ADJSP P,@(P) + POPJ P, + +.KILL STKRT0 + +RETSKP=: +];$$STK + \ No newline at end of file diff --git a/src/syseng/rfnl.26 b/src/syseng/rfnl.26 new file mode 100644 index 00000000..a3b5cde3 --- /dev/null +++ b/src/syseng/rfnl.26 @@ -0,0 +1,636 @@ + +.BEGIN RFNL ;-*-MIDAS-*- + +SUBTTL Routines for parsing and printing filenames + +;Basic conventions: + +;We assume that there are accumulators A, B, C, and D, not necessarily +;consecutive, and that the stack is in P. +;No routine clobbers ACs other than the +;ones it is documented to clobber, and none touches even temporarily +;any AC other than A, B, C, D and P. +;All code generated is pure, except for a few .SCALAR definitions. +;The main routines PFN, PFNCT and PFNMCH never skip. +;The main routines RFN and MERGE skip if the filename block to +;be filled in was big enough for the data to be put in it. +;The main routine STKMRG skips if it was able to allocate the result string. + +;;; Filename blocks: + +;A filename block consists any number of two-word entries, +;each of which holds a pair of byte pointers to the beginning and end +;of one component of a filename string. +;The last character in the component is one of ":", ";", " ", ^@, ^X or ^Y, +;and it identifies the type of component. + +;;; Parsing and unparsing filenames: + +;This file contains two routines, RFN to read filenames and PFN to print. +;The $$RFN and $$PFN assembly switches control them. +;Both expect a b.p. for ILDB'ing or IDPB'ing the text, in D. +;Both expect an AOBJN pointer to a filename block in B. + +;For RFN, the AOBJN pointer in B should point to the space +;available for a filename block. On return, B will be an AOBJN +;pointer to the space actually used. RFN skips unless data +;was lost because the block was full. + +;The filename block constructed by RFN contains pointers into the +;argument string, so that string must be kept intact until after the +;filename block is no longer needed. In particular, it does not work +;to PFN the same filename block, or the result of merging it with another, +;into the same space that the original string was in. + +;The RFN routine assumes that the user has defined the label RFNSPC +;which says which characters are terminators or start switches. +;RFNSPC should examine the character in A and skip if it should +;either terminate the filename or start a switch. +;If the character is "/" or "(" and $$SWITCH is 1, it will start +;a switch; otherwise, it will terminate the filespec. +;If RFNSPC does not skip, the character will neither terminate nor start a switch. +;However, RFNSPC is not called for the characters ":", ";", " ", and ^Q. +;For CR and ^@, it makes no difference whether RFNSPC skips. + +;PFN similarly assumes that there is a routine PFNSPC which will +;skip for a character in A that needs a ^Q printed in front of it. +;Normally, RFNSPC and PFNSPC can be the same routine. + +;If you want switches to be processed in filenames, +;set $$SWITCH to 1 and define the label SWITCH as a routine to read a switch. +;It will be called with the first character of the switch in A. +;It can read more characters off D, or by calling RFN"RUC +;If it skips, RFN assumes that the character in A should be reprocessed. +;A slash is followed by a single switch, while parentheses enclose +;any number of switches. However, neither slash nor "(" will be +;recognized unless RFNSPC skips for it. This gives the caller +;run-time control of whether switches are to be processed. + +;If $$MNAME is set, the user must define MNAME to point to +;a word holding this machine's name in SIXBIT. + +;;; Merging defaults: + +;The MERGE routine takes two filename blocks (A and B) as input +;and a third AOBJN pointer in C to space to store a filename block as output. +;It copies the components of the first block, putting them in canonical order, +;and defaulting missing components from the second block. +;The results go in the third block. +;On return, C is an AOBJN pointer to the part of the output block +;which was actually filled with data, +;and MERGE skips unless data was lost because the block was full. + +;Because the merged filename block contains pointers copied from the +;two input filename blocks, the strings which those input filename blocks +;were parsed from must be kept intact until the merged filename block +;is passed to PFN. + +;^X and ^Y components in the first argument are replaced by the +;default names from the second argument to which they refer. + +;The STKMRG routine is a high level interface which parses, merges +;and makes a string all on one. It takes two ASCIZ strings, +;does RFN on each, does MERGE to the two filename blocks, +;then does PFN on the result, storing into a dynamically allocated string +;All temporary storage comes from the stack. + +;These symbols should be defined by the user to select parts of this file: +IFNDEF $$RFN,$$RFN==0 ;Include RFN, the routine for reading filenames. +IFNDEF $$SWITCH,$$SWITCH==0 ;Include routines for processing "/" and "(-)" switches. +IFNDEF $$PFN,$$PFN==0 ;Include PFN, the routine for printing filenames. +IFNDEF $$MNAME,$$MNAME==0 ;1 => assume MNAME is defined and holds this machine's name. +IFNDEF $$MERGE,$$MERGE==0 ;1 => provide MERGE routine to merge defaults. +IFNDEF $$STKMRG,$$STKMRG==0 ;1 => provide STKMRG routine. + +.AUXIL ;Don't mention all our internal symbols in crefs. + +;PRINT VERSION NUMBER +.TYO6 .IFNM1 +.TYO 40 +.TYO6 .IFNM2 +PRINTX/ INCLUDED IN THIS ASSEMBLY. +/ + +DEFINE SYSCAL NAME,ARGS +.CALL [SETZ ? SIXBIT/NAME/ ? ARGS ((SETZ))] +TERMIN + +IFN $$RFN,[ ;Routine for parsing a filename. + +;Given a BP in D pointing to a filename, +;store in the filename block <- AOBJN ptr in B +;pointers to the beginnings and ends of the components of the filename. + +;The block <- B contains two-word entries. +;In each entry is placed a pair of BPs, pointing to the start +;and end of one name (or device or directory) in the filename. + +;Since B contains only pointers to the originally supplied string, +;you must not clobber the string itself until after you are through +;with the data in the filename block. + +;Advances D through the string. +;Sets B to an AOBJN pointer to the used portion of the table; +;skips if the table was long enough. +;Clobbers C and A. + +;If B's right half starts out as 0, then only the left half is incremented +;and the table is not stored. So call with B/ SETZ to compute how long +;a table is required for a given string. +rfn: push p,b +rfn0: move c,d +rfn1: ildb a,d +rfnunr: caie a,"; + cain a,": ;Check for special pathname syntax chars + jrst rfn2 ;that always have these special meanings. + cain a,40 + jrst rfn2 + caie a,^X + cain a,^Y + jrst rfn3 + cain a,^Q + jrst [ ildb a,d + jrst rfn4] + pushj p,rfnspc ;Otherwise, ask user whether char is special. + jrst rfn4 ;No skip => treat char as ordinary. +ifn $$switch,[ + cain a,"/ ;If stopped on "/" or "(", call switch rtn. + jrst rfnsl ;Read 1 switch. + cain a,"( + jrst rfnpar ;Read many switches until ). +];ifn $$switch + setz a, ;If any unrecognized char is "special" according to the user, + jrst rfn2 ;it must be a terminator. + +rfn4: cain a,^M ;CR and null character terminate, even if quoted. + setz a, + jumpn a,rfn1 +rfn2: push p,c ;Push this entry iff it contains more than one character. + ibp c + camn c,d + jrst [ pop p,c + jrst rfn5] + pop p,c +;Push this component, regardless of its length. +rfn3: trnn b,-1 + jrst [ add b,[2,,] ;But if B's rh is 0, just increment the lh; don't store. + jrst rfn5] + jumpge b,rfn6 ;Don't actually store in table if past the end. + movem c,(b) + movem d,1(b) +rfn6: add b,[2,,2] +rfn5: jumpn a,rfn0 ;If string not terminated, keep parsing. + camge b,[2,,] ;Else skip if we did not run out of space in the table. + aos -1(p) +;Adjust B to contain a pointer to the used portion of the filename block. + pop p,c ;Else pop original B into C. + sub b,c + trz b,-1 ;LH(B) gets number of words pushed onto the filename block. + movns b + hrr b,c ;B gets AOBJN ptr to used portion. + popj p, + +IFN $$SWITCH,[ ;Code for processing switches, when a "/" or "(" is seen. + +rfnpar: pushj p,ruc ;Get next char. Is it a ")"? +rfnpa1: cain a,") + jrst rfn1 ;Paren ends switches; gobble next character. + caie a,0 + cain a,^M + jrst rfnunr ;CR ends spec even in switch list; reread it. + pushj p,switch ;Try to gobble the switch. + jrst rfnpar ;Char in A used up, get another. + jrst rfnpa1 ;Char in A not part of switch; is it ")"? + +rfnsl: pushj p,ruc + caie a,0 + cain a,^M ;/ ends spec; reread it. + jrst rfnunr + pushj p,switch ;Otherwise, process it as switch. + jrst rfnunr ;No skip => char in A was gobbled by switch. + jrst rfn1 ;Skip => let next RSIXG gobble the char now in A. + +;Read a char into A off the bp in D and convert to upper case. +ruc: ildb a,d + cail a,140 + subi a,40 + popj p, + +];IFN $$SWITCH + +];IFN $$RFN + +IFN $$PFN,[ ;Routine to turn a filename block into a single string. + +;Given a filename block of two-word entries <- AOBJN ptr in B, +;output a filename down the BP in D. +;Clobbers A and C. Counts B out through the filename block. + +;The filename components are printed in the order they appear. +;If you want them permuted into standard order, +;merge them with an empty block of defaults first with MERGE +;(since the output from MERGE always has the components in standard order). +pfn: jumpge b,pfn2 +pfnmc2: jumpge b,pfn2a + move c,(b) + pushj p,pfn1 + add b,[2,,2] + jumpl b,pfnmc2 +pfn2a: setz a, ;Replace the space at the end of the last + dpb a,d ;entry with a null; + ldb a,[300600,,d] ;then decrement the bp in D to point before the null. + ldb c,[360600,,d] + add c,a + dpb c,[360600,,d] + popj p, + +pfn2: setz a, ;If filename block is empty, + move c,d ;store a null, but don't advance over it. + idpb a,c + popj p, + +;Copy one entry's string into the output string. +pfn1: camn c,1(b) ;Stop at end of entry. + jrst [ cain a,40 ;If the entry ended in other than space, put in a space. + popj p, + movei a,40 + idpb a,d + popj p,] + ildb a,c ;Fetch the next character. + cain a,0 ;If it's a terminating null, + movei a,40 ;output a space instead. + pushj p,pfnspc ;Is it special in this program? + jrst pfn3 + push p,a ;If so, put a ^Q in front of it. + movei a,^Q + idpb a,d + pop p,a +pfn3: idpb a,d ;In any case, output the char itself. + caie a,^Q ;If it is a ^Q, don't check the following char + jrst pfn1 ;for being special or for being ^Q. + camn c,1(b) + popj p, + ildb a,c + idpb a,d + movei a,1 ;Don't leave space in A if it was quoted. + jrst pfn1 + +;Return in D the number of characters required to hold a single string +;made from the parsed block of two-word entries pointed to by B. +;Clobbers A and C. + +;Use this to decide how long a block to allocate for a string to be +;constructed with PFN. + +;Note that the value returned is the length of the contents of the ASCIZ +;string that PFN will write. It does not count the zero written +;to terminate that string. +pfnct: setz d, + jumpge b,cpopj +pfnct0: jumpge b,[soja d,cpopj] + move c,(b) + pushj p,pfnct1 + add b,[2,,2] + jrst pfnct0 + +pfnct1: camn c,1(b) ;Stop at end of entry, but count one + jrst [ caie a,40 ;for a following space if the entry didn't end in one. + cain a,0 + aos d + popj p,] + ildb a,c ;Fetch the next character. + addi d,1 ;Count it. + pushj p,pfnspc ;Is it special in this program? + jrst pfnct3 + addi d,1 ;If so, count a ^Q for it. +pfnct3: caie a,^Q ;If it is a ^Q, don't check the following char + jrst pfnct1 ;for being special or for being ^Q. + camn c,1(b) + popj p, + ibp c ;Skip that char, but leave ^Q in A. + aoja d,pfnct1 ;DO count the char. + +;Like PFN, but if the first component in the filename block is "DSK:" +;we output the machine name instead. +pfnmch: pushj p,pfnmc1 ;IS the first component "DSK:"? + jrst pfn ;No, just print normally. + push p,b +IFN $$MNAME,move a,mname ;Yes, print the machine name instead +.ELSE [ syscal sstatu,[repeat 6,[? %clout,,a]] + .lose %lssys +] + movei b,": ;with a colon after it + pushj p,sixstr + movei b,40 ;and a space just as PFN would put after that. + idpb b,d + pop p,b + add b,[2,,2] ;Discard the component "DSK:" and + jrst pfnmc2 ;process the remaining components. + +;Skip if the first component in the filename block in B is "DSK:". +pfnmc1: move c,(b) +irpc char,,[DSK:] + ildb a,c + caie a,"char + popj p, ;Return non-skip if a character doesn't match. +termin + camn c,1(b) ;Skip only if the entry length is correct. + aos (p) + popj p, + +;Output sixbit word in A as ASCII down BP in D +;followed by terminator in B and a null character. Clobbers C. +sixstr: push p,b + move b,[440600,,a] +sixst1: ildb c,b + addi c,40 + idpb c,d + setz c, + dpb c,b + jumpn a,sixst1 +sixst2: pop p,b + idpb b,d + push p,d + setz c, + idpb c,d + pop p,d + popj p, + +];IFN $$PFN + +IFN $$MERGE,[ ;Routine to merge defaults from one filename block with another filename block. + +;Given in A and B two AOBJN pointers to filename blocks of input data, +;and in C an AOBJN pointer to an output filename block, +;merge the two input blocks writing the result in the output one. +;The first argument's components take priority over the second argument's. + +;D should contain nonzero if a single name specified in the +;first argument should override all names of the second argument. +;This value is stored in MRGFN2 while MERGE is running. +;If MRGFN2 is nonzero, then if the first argument contains only one NAME, +;the second NAME (if any) from the second argument is used as well. +;If MRGFN2 is zero, then if the first argument contains only one NAME, +;only that NAME is used. +.scalar mrgfn2 + +;On return, C's lh is set to minus the number of words used. +;We skip if the space provided was sufficient. +merge: push p,mrgfn2 + movem d,mrgfn2 + push p,c + movei d,": + pushj p,merge1 + movei d,"; + pushj p,merge1 + movei d,40 + push p,a + push p,b + pushj p,msrch + jrst merge2 + move a,(p) ;No NAME found in input 1 => copy all NAMEs from input 2. +merge3: move b,(p) + pushj p,mcopy +mergex: pop p,b + pop p,a +mergx1: pop p,d ;Pop original C into D. + caml c,[2,,] + jrst [ move c,d + jrst mergx2] + sub c,d + andi c,-1 ;C gets number of words pushed onto filename block now in D. + movns c + hrlzs c + hrr c,d ;C gets AOBJN ptr to used portion of filename block. + aos -1(p) +mergx2: move d,mrgfn2 + pop p,mrgfn2 +cpopj: popj p, + +merge2: move b,(p) + pushj p,mcopnm ;One NAME found in input 1 => copy it to output. + add a,[2,,2] + pushj p,msrch ;Search for a second one. + jrst merge3 ;Found => copy all remaining NAMEs from input 1. + move a,(p) + skipe mrgfn2 ;Not found: if want no default fn2, return with just this one. + pushj p,mergln + jrst mergex + +;Search the filename block <- AOBJN ptr in A for an entry whose string +;ends in the character in D. Skip if NOT found. +;Leave A pointing at the entry if it is found. +;Clobbers B. +;An entry ending in a null character is considered to end with a space. +msrch: jumpge a,popj1 + move b,1(a) + ldb b,b + skipn b + movei b,40 + caie b,^X ;Finding either a ^X or a ^Y + cain b,^Y ;counts as finding a name. + movei b,40 + cain b,(d) + popj p, + add a,[2,,2] + jrst msrch + +popj1: aos (p) + popj p, + +;Copy all the elements ending in the character in D +;from the filename block <- AOBJN ptr in A if it contains any; +;otherwise, copy all the ones from the filename block <- AOBJN ptr in B. +;D should NOT contain a space. +merge1: push p,a + push p,b + pushj p,msrch + jrst merge9 + move a,(p) + pushj p,msrch +merge9: pushj p,mcopy +popbaj: pop p,b + pop p,a + popj p, + +;Copy entries from the filename block <- AOBJN ptr in A to that in C. +;Copy all those whose ending character matches that in D. +;When copying NAMEs (D contains a space) +;^X and ^Y entries are processed as well, +;using the filename block <- AOBJN ptr in B. +mcopy: push p,b +mcopy0: jumpge c,popbj + jumpge a,popbj + move b,1(a) + ldb b,b + caie b,^X + cain b,^Y + caie d,40 + caia + jrst mcopy3 + skipn b + movei b,40 + came b,d + jrst mcopy1 +mcopy3: move b,(p) + pushj p,mcopnm +mcopy1: add a,[2,,2] + jrst mcopy0 + +;Copy the filename component that A points to +;into the filename block in C, assuming that B +;contains the filename block to find defaults in (for ^X and ^Y). +mcopnm: push p,b + move b,1(a) + ldb b,b + caie b,^X + cain b,^Y + jrst mcopy2 + jumpge c,mcopn1 + move b,(a) + movem b,(c) + move b,1(a) + movem b,1(c) +mcopn1: add c,[2,,2] + jrst popbj + +;Copy a NAME which is really a ^X or ^Y. +;Get, off the stack, the second arg block +;and copy either its first NAME or its last one. +mcopy2: exch a,(p) + push p,a + pushj p,[cain b,^X + jrst mergfn + jrst mergln] + jrst popbaj + +;Copy the first NAME from the arg block in A into the output here. +mergfn: push p,b + push p,d + movei d,40 + pushj p,msrch + jrst mergf1 + jrst popdbj + +;Copy the last NAME from the arg block in A into the output here. +mergln: push p,b + push p,d + movei d,40 + pushj p,msrch ;Don't even consider the first name. Find it now + caia ;so we can start from after it. + jrst popdbj + push p,[0] +mergl1: add a,[2,,2] + pushj p,msrch ;Keep searching, and remember the last place we found one. + jrst [ movem a,(p) + jrst mergl1] + pop p,a +mergf1: jumpe a,popdbj + jumpge c,mergf2 + move b,(a) ;Copy that last one into the output. + movem b,(c) + move b,1(a) + movem b,1(c) +mergf2: add c,[2,,2] +popdbj: pop p,d +popbj: pop p,b + popj p, + +];IFN $$MERGE + +IFN $$STKMRG,[ + +;Parse and merge filenames using temprary storage on the stack. + +.scalar stkmp1,stkmp2,stkmp3 ;Temporaries used by STKMRG. + +;Merge two filename strings to produce a new string, +;which is stored into freshly allocated storage. +;The user-provided STRALC routine is used to allocate that new string. +;All other temporary space is allocated on the stack. + +;Call with byte pointers to the two strings in A and B. +;A points to the specified string and B points to the defaults. +;On return, A points to the newly allocated string's contents. +;No accumulators except A, B, C and D are touched, +;so the allocation routine can return additional information +;or other sorts of pointers to the string +;in any of the other accumulators. + +;You must supply a subroutine named STRALC which should +;allocate a string of a size given in C, and return a byte pointer +;to the string in A. It should skip if successful, +;and not skip if such a string cannot be allocated +;(length is too great). + +;STKMRG skips if STRALC did. + +stkmrg: push p,a + push p,b + move d,a + movsi b,(setz) ;How much space do we need for a filename block for the 1st arg? + pushj p,rfn + hrri b,1(p) + movem b,stkmp1 ;Save an AOBJN ptr to table we are allocating. + hlre c,b + movns c ;C gets length required. + hrls c + move d,-1(p) + add p,c ;Mark space as in use. + pushj p,rfn ;Parse the 1st arg into the space allocated. + move a,stkmp1 + move d,-1(a) + movsi b,(setz) + pushj p,rfn ;How much space do we need for a filename block for 2nd arg? + hrri b,1(p) + movem b,stkmp2 ;Save an AOBJN ptr to table we are allocating. + hlre c,b + movns c ;C gets length required. + hrls c + add p,c ;Mark space as in use. + move a,stkmp1 + move d,-1(a) ;Get back our 2nd arg and parse into that space. + pushj p,rfn + move a,stkmp1 + move b,stkmp2 ;Get the AOBJN ptrs to the two tables in the stack. + hlre d,a + hlre c,b + subi c,2 + addb d,c ;Get (minus) sum of their lengths; allocate filename block + hrlzs c ;that long to hold the merged filenames. + hrri c,1(p) + movem c,stkmp3 + movns d ;D gets length allocated for merged filename block, + hrls d ;in both halves. + add p,d ;Allocate the space. + pushj p,merge ;Now merge into that table. + movem c,stkmp3 ;Save ptr to what was used. + move b,c + pushj p,pfnct ;Put length in D. + move c,d + pushj p,stralc ;Call user-supplied routine to allocate and put BP in A. + jrst stkmr1 + move b,stkmp3 + push p,a + move d,a + pushj p,pfn ;Store the ultimate name into the user-supplied string. + pop p,a + move b,p ;Deallocate the temporary storage + sub b,stkmp1 + hrls b + sub p,b + sub p,[3,,3] + aos (p) + popj p, + +;Return non-skipping. +stkmr1: move b,p ;Deallocate the temporary storage + sub b,stkmp1 + hrls b + sub p,b + sub p,[3,,3] + popj p, + +] ;end $$STKMRG + +.end rfnl