.title diskio .list MEB max_luns = 100 dnm_num = 3 ; warning!! dnm_num is referred to explicitly as 3 ; at ctrstr: ; lun_table: .blkl max_luns dnm1: .ascic %IOP% dnm2: .ascic %.DAT% dnm_c_bln = .-dnm1-2+dnm_num prm_c_bln = 80 ; set max prompt string size ! $fabdef $rabdef $xabdef $xabprodef $namdef fab_off = 0 rab_off = fab_off + fab$c_bln xab_off = rab_off + rab$c_bln nam_off = xab_off + xab$c_prolen dnm_off = nam_off + nam$c_bln ddsc_off = dnm_off + dnm_c_bln prm_off = ddsc_off + 8 rss_off = prm_off + prm_c_bln ess_off = rss_off + nam$c_maxrss sts_off = ess_off + nam$c_maxrss stv_off = sts_off + 4 len_off = stv_off + 4 eofmess_off = len_off + 4 memory_size_per_unit = eofmess_off + 4 memsiz: .long memory_size_per_unit ctrstr: .ascid /!AC!3ZB!AC/ errval: .long 0 errval2: .long ss$_filalracc errval3: .long ss$_filnotacc .macro checklun,?a tstl lun_table[r7] bnequ a pushal errval3 calls #1,errmes movl errval3,r0 ret a: .endm checklun setup_lun: tstl lun_table[r7] beqlu newlun pushal errval2 calls #1,errmes movl errval2,r0 ret newlun: pushal lun_table[r7] pushal memsiz calls #2,lib$get_vm blbs r0,okgetvm movl r0,errval pushal errval calls #1,errmes movl errval,r0 ret okgetvm: movl lun_table[r7],r6 movc5 #0,0,#0,#memory_size_per_unit,(r6) movl #dnm_c_bln,ddsc_off(r6) moval dnm_off(r6),ddsc_off+4(r6) $fao_s ctrstr=ctrstr,outbuf=ddsc_off(r6),p1=#dnm1,p2=r7,p3=#dnm2 blbs r0,okfao movl r0,errval pushal errval calls #1,errmes movl errval,r0 jsb cleanup_lun ret okfao: moval fab_off(r6),r0 movb #fab$c_bid,fab$b_bid(r0) movb #fab$c_bln,fab$b_bln(r0) $fab_store ctx=r7,fop=,rfm=,- rat=,nam=nam_off(r6),xab=xab_off(r6),org=,- dna = dnm_off(r6),dns=#dnm_c_bln moval rab_off(r6),r0 movb #rab$c_bid,rab$b_bid(r0) movb #rab$c_bln,rab$b_bln(r0) $rab_store ctx=r7,fab=fab_off(r6),rop=,rac= moval nam_off(r6),r0 movb #nam$c_bid,nam$b_bid(r0) movb #nam$c_bln,nam$b_bln(r0) $nam_store rsa=rss_off(r6),rss=#nam$c_maxrss,- esa=ess_off(r6),ess=#nam$c_maxrss moval xab_off(r6),r0 movb #xab$c_prolen,xab$b_bln(r0) movb #xab$c_pro,xab$b_cod(r0) $xabpro_store pro=<,,,> rsb cleanup_lun: pushl r0 pushal lun_table[r7] pushal memsiz calls #2,lib$free_vm clrl lun_table[r7] blbc r0,nopop popl r0 rsb nopop: movl r0,errval pushal errval calls #1,errmes movl errval,r0 rsb ; ; ; IF(.NOT.D_OPEN(lun,'R' or 'W',filename [,nbuffs]))STOP 'D_OPEN ERROR' ; where lun is the iopack lun (not related to FORTRAN luns at all), ; 'W' must be specified to get write access to the file ; in which case a new file is created, ; filename is the filename in either CHARACTER form or ; null terminated BYTE string, ; and nbuffs is an optional buffer count which specifies ; how many buffers to use in all i/o requests. This has ; a great deal to do with actual speed. 11 is a good choice. ; There is an optional UIC parameter at the end which says ; to set the owner field if its a new file. ; D_OPEN returns .TRUE. iff the open was successful. d_open:: .word ^m ; ; and now a note about register usage! ; In order to avoid difficulties with ; things like MOVC5 which use r0-r5, ; we will always store the pointer ; to the data structure for the current unit ; in r6, and the current unit number itself in r7. ; movzbl @4(ap),r7 ;get lun jsb setup_lun cmpw 0(ap),#5 ;are there 5 args ? beql owner ;yes.set owner cmpw 0(ap),#4 ;are there 4 args ? beql mbc ;YES. They specified a buffer count. cmpw 0(ap),#3 ;are there 3 args ? beql name ;YES. Good, that's only other legal choice jmp badarg ;error owner: tstl 20(ap) ;did they specify an address? beqlu mbc ;no. skip it movl @20(ap),xab$l_uic+xab_off(r6) mbc: ; user-specified buffer count tstl 16(ap) ; did they omit address ? beqlu name ; yes tstl @16(ap) ; did they say 0 ? beqlu name ; Yes. Ignore them moval rab_off(r6),r0 $rab_store mbc=@16(ap) ; use user value for moval fab_off(r6),r0 $fab_store deq=@16(ap) ; multi-buffer count, moval fab_off(r6),r0 $fab_store alq=@16(ap) ; file alloc, & extend. name: moval @12(ap),r0 ; get addr of descriptor jsb filename done: moval @8(ap),r0 ; beql read ;default to read cmpb @4(r0),#^a/W/ ;did they say '/W/rite' beql write ;yes cmpb @4(r0),#^a/w/ ;try small w too. beql write ;yes. cmpb @4(r0),#^a/A/ ;did they say append ? beql append ;yes cmpb @4(ap),#^a/a/ ;try lowercase bneq read ;no must be read append: moval rab_off(r6),r0 $rab_store rop=; select append mode moval fab_off(r6),r0 $fab_store fac=;so you can do find brb rdapp write: ; open a new file for writing moval fab_off(r6),r0 $fab_store fac= $create fab=fab_off(r6),err=error,suc=error blbc r0,opnerret ; on error, return with error code. brb conn read: ; open an existing file to read moval fab_off(r6),r0 $fab_store fac= rdapp: $open fab=fab_off(r6),err=error,suc=error blbc r0,opnerret ; on error, return with error code. conn: ; in either case connect a record stream to it. $connect rab=rab_off(r6),err=error,suc=error blbc r0,opnerret opnret: ret badarg: pushal invarg calls #1,errmes movl invarg,r0 opnerret: jsb cleanup_lun ret invarg: .long mth$_wronumarg filename: ; filename is a simple subroutine to ; store the filename specified in the fab. ; On call, R0 must point to the filename descriptor ; (or address of the BYTE buffer) and R2 must ; serve as a pointer into the FABTB. ; On return the FAB has been set with the appropriate filename. movl r0,r3 cmpb 2(r0),#14 ;is it a character string ? beql char ;yes. Descriptors always have 14 in high word movl r0,r1 ;not CHAR, must be BYTE w/ null at end cloop: tstb (r1)+ ;look for terminating null bneq cloop ;not yet found decl r1 ;found null. point to last good char subl r0,r1 ;get string length moval fab_off(r6),r0 $fab_store fns=r1,fna=(r3) rsb char: movzbl (r3),r1 ;get string length movl 4(r3),r0 ;get string address decl r0 ;r1 is 1 too big chloop: ;get rid of trailing blanks addl2 r1,r0 ;get last char of string cmpb (r0),#^a/ / ;is it a blank ? bneq cdon ;no. stop looking for more blanks subl2 r1,r0 ;fix up address for next time sobgtr r1,chloop ;decrement length cdon: moval fab_off(r6),r0 $fab_store fns=r1,fna=@4(r3) rsb ; ; ; ; CALL D_CLOS(lun) ,where ; lun is the iopack lun (no relation to FORTRAN luns) ; d_clos:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 jsb wait ;even though this is a file operation ;you can't do it until record processing ;completes movzbl #-1,eofmess_off(r6) $close fab=fab_off(r6),err=error,suc=error jsb cleanup_lun ret ; ; error: .word ^m moval @4(ap),r2 ;happily error is called by an AST movl rab$l_ctx(r2),r7 movl lun_table[r7],r6 movl rab$l_sts(r2),sts_off(r6) movl rab$l_stv(r2),stv_off(r6) bitl #nam$m_wildcard,nam$l_fnb+nam_off(r6) beqlu 10$ ; no special stuff except on wildcards cmpl sts_off(r6),#rms$_nmf ; fake it for nmf beqlu 11$ cmpl sts_off(r6),#rms$_fnf ; same for fnf bnequ 10$ 11$: movl #rms$_normal,sts_off(r6) 10$: movzwl rab$w_rsz+rab_off(r6),len_off(r6) pushal stv_off(r6) pushal sts_off(r6) blbs @(sp),okay tstl eofmess_off(r6) beql 12$ cmpl #rms$_eof,@(sp) ;assume that rab$l_sts and fab$l_sts beql okay ;will always coincide. 12$: blbs wrtmes,do_mes cmpl #rms$_rtb,@(sp) beql okay do_mes: calls #2,errmes ;dump error mess. unless EOF. okay: clrl eofmess_off(r6) ret ; ; ; wait: $wait rab=rab_off(r6) rsb ; ; CALL D_LEN(lun) ; where lun is the iopack lun ; returns the number of bytes read in the last ; transfer. d_len:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 jsb wait movl len_off(r6),r0 ret ; ; ; ; IF(D_UNIT(lun))30,40,50 ; where 30 is the label for a successful operation ; 40 is the label for EOF, and ; 50 is the label for error return. ; A call to D_UNIT or D_LEN synchronizes the io by waiting ; for it to complete before returning. d_unit:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 jsb wait movl sts_off(r6),r0 blbs r0,minus cmpl #rms$_eof,r0 beqlu zero cmpl #rms$_rtb,r0 beqlu minus plus: movf #^f1.0,r0 ret zero: movf #^f0.0,r0 ret minus: movf #^f-1.0,r0 ret ; ; ; ; CALL D_GET(lun,buffer,len) ; reads the next record from disk into BUFFER ; The maximum number of bytes in the transfer will ; be len. Note that D_GET is asynchronous. d_get:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 jsb wait cmpw 0(ap),#3 ;better have 3 args beql goin jmp badarg goin: ; set up max record size and buffer address moval rab_off(r6),r0 $rab_store ubf=@8(ap),usz=@12(ap) movzbl #-1,eofmess_off(r6) $get rab=rab_off(r6),err=error,suc=error bits_to_clear = rab$m_cco!rab$m_rne!rab$m_cvt!rab$m_pta!rab$m_pmt bicl2 #bits_to_clear,rab$l_rop+rab_off(r6) ret ; ; map into COMMON/IO_ERR/ ; .save .psect IO_ERR,pic,ovr,rel,gbl,shr,noexe,rd,wrt,long wrtmes: .long 1 .restore ; ; ; ; CALL D_PUT(lun,buffer,len) ; writes out the next record to iopack lun LUN ; using len bytes starting at buffer. Asynchronous. d_put:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 jsb wait cmpw 0(ap),#3 ;better be 3 args beql goout jmp badarg goout: ; set up buffer address and record length moval rab_off(r6),r0 $rab_store rbf=@8(ap),rsz=@12(ap) $put rab=rab_off(r6),err=error,suc=error ret ; ; ; ; CALL D_MARK(lun,addr) ; stores the address (RFA) of the current record ; in addr. addr must be able to hold at least 6 bytes ; d_mark:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 jsb wait movaw @8(ap),r0 movl rab$w_rfa+rab_off(r6),(r0)+ movw rab$w_rfa+4+rab_off(r6),(r0)+ ret ; ; ; ; CALL D_JUMP(lun,addr) ; moves the file position to the record whose ; address was stored previously in addr by a call ; to D_MARK d_jump:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 jsb wait moval rab_off(r6),r0 $rab_store rac= movaw @8(ap),r0 movl (r0)+,rab$w_rfa+rab_off(r6) movw (r0)+,rab$w_rfa+4+rab_off(r6) $find rab=rab_off(r6),err=error,suc=error pushl r0 moval rab_off(r6),r0 $rab_store rac= popl r0 ret ; ; ; ; CALL D_NAME(lun,filename,len) ; ; where filename is a CHARACTER variable ; which will receive the full filespec of the ; currently open file,and LEN is the length ; of the filename d_name:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 movzbl nam$b_rsl+nam_off(r6),r2 ;r2 holds the size of the string moval @nam$l_rsa+nam_off(r6),r1 ;r1 holds the address of the string moval @8(ap),r0 ;r0 holds descriptor movzwl r2,@12(ap) movc5 r2,(r1),#^a/ /,(r0),@4(r0) ret ; ; ; call D_FID(lun,buff) ; ; where lun is the usual iolun number ; and buff is the address of a 28 byte buffer. The first ; 16 bytes are loaded with the device name, ; the next 6 bytes are the FID, and the last ; 6 are the DID. This routine is primarily ; useful if you want to send a message to ; the symbiont. ; d_fid:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 movc5 #nam$c_dvi,nam$t_dvi+nam_off(r6),#^a/ /,#16,@8(ap) movc3 #6,nam$w_fid+nam_off(r6),(r3) movc3 #6,nam$w_did+nam_off(r6),(r3) ret ; ; CALL D_RNAM(lun1,oldfile,lun2,newfile) ; ; where oldfile & newfile are the old and new ; filespecs for the rename operation. ; Note that both lun1 & lun2 must not be open. ; d_rnam:: .word ^m movzbl @4(ap),r7 jsb setup_lun moval @8(ap),r0 jsb filename pushl r6 ; save pointer to old lun structures pushl r7 movzbl @12(ap),r7 jsb setup_lun moval @16(ap),r0 jsb filename popl r3 ; r3 is pointer to oldfab popl r2 $rename oldfab=fab_off(r2),newfab=fab_off(r6),err=error,suc=error jsb cleanup_lun movl r2,r6 movl r3,r7 jsb cleanup_lun ret ; Return with status code. ; ; ; I = D_ERAS(IOLUN,FILENAME),where ; IOLUN is a currently closed IOLUN, & ; FILENAME is the name of a file to be deleted. ; exceptionally, we do allow wildcards in FILENAME ; d_eras:: .word ^m movzbl @4(ap),r7 jsb setup_lun moval @8(ap),r0 jsb filename $parse fab=fab_off(r6),err=error,suc=error blbs r0,edloop jmp eret edloop: $search fab=fab_off(r6),err=error,suc=error cmpl r0,#rms$_nmf ; have we exhausted wild-card processing ? bnequ 10$ jmp edone 10$: blbs r0,20$ jmp eret 20$: bisl2 #fab$m_nam,fab$l_fop+fab_off(r6) ; specify name block $erase fab=fab_off(r6),err=error,suc=error bicl2 #fab$m_nam,fab$l_fop+fab_off(r6) blbc r0,eret bitl #nam$m_wildcard,nam$l_fnb+nam_off(r6) beqlu edone jmp edloop edone: movl #rms$_normal,r0 eret: jsb cleanup_lun ret d_delt:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 bisl2 #fab$m_dlt,fab$l_fop+fab_off(r6) ; specify delete on close ret d_sbmt:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 bisl2 #fab$m_scf,fab$l_fop+fab_off(r6) ; specify submit on close ret d_spool:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 bisl2 #fab$m_spl,fab$l_fop+fab_off(r6) ; specify spool on close ret d_cco:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 bisl2 #rab$m_cco,rab$l_rop+rab_off(r6) ; specify cancel ^O ret d_rne:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 bisl2 #rab$m_rne,rab$l_rop+rab_off(r6) ; specify read no echo ret d_cvt:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 bisl2 #rab$m_cvt,rab$l_rop+rab_off(r6) ; specify CUPPER on next read ret d_pta:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 bisl2 #rab$m_pta,rab$l_rop+rab_off(r6) ; specify purge type ahead ret d_pmt:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 bisl2 #rab$m_pmt,rab$l_rop+rab_off(r6) ; specify prompt on next read moval @8(ap),r0 ; R0 points to descriptor movzbl 0(r0),r3 movb 0(r0),rab$b_psz+rab_off(r6) ; set prompt string size moval prm_off(r6),rab$l_pbf+rab_off(r6) ; set prompt string address movc5 r3,@4(r0),#^a/ /,#prm_c_bln,prm_off(r6) ret d_trunc:: .word ^m movzbl @4(ap),r7 checklun movl lun_table[r7],r6 jsb wait $truncate rab=rab_off(r6),err=error,suc=error ret .end