;*************************************************************************** ; EZTRAN ;*************************************************************************** ; ; High volume I/O FORTRAN callable subroutine. Performs block and/or ; record I/O to tape, disk or some other device. ; ; Functions are: ; 1 - Sequential Read ; 2 - Sequential Write ; 3 - Random Read ; 4 - Random Write ; 5 - Open and Assign ; 6 - Close and Deassign ; 7 - Skip Record ; 8 - Skip File ; 9 - Write End Of File ; 10 - Rewind ; 11 - Create File ; 12 - Sequential Record Read ; 13 - Sequential Record Write ; 14 - Random Record Read ; 15 - Random Record Write ; ; For full and complete documentation please see the accompanying ; documentation (EZTRAN.HLP) ; ; Written by: Maria Kalcic, Code 022, U. S. Naval Oceanographic Office ; (April 1983) ; Modified by: Perry Bret Wischow, Code 8311, U. S. Naval Oceanographic Office ; Cleaned up the code, added support for logical names, ; and tape drive independence. (15 April 1987) ; ;*************************************************************************** .title EZTRAN $DVIDEF ; Device item codes $DCDEF ; Device type codes $SSDEF ; System service status codes $RMSDEF ; RMS status and type codes .psect EZTRAN_CODE, long,nowrt .entry EZTRAN, ^M ; ; Get arguments from FORTRAN call with displacement ; of argument pointer (AP) movl @4(ap), lu ; Get logical unit movl @8(ap), r2 ; Get function movl @8(ap), ifun ; movl @12(ap), block_number ; Get block number movl @16(ap), no_of_bytes ; Get no. bytes movab @20(ap), buffer ; Get base address of buffer movl @24(ap), alqw ; Get allocation size for file moval @24(ap), status ; Get address of status word movl lu, r8 ; Store address get LU index for fab address movl fabadr[r8], ezfab ; Store addr of FAB movl rabadr[r8], ezrab ; Store addr of RAB ; ; Use case instruction to branch to function (r2) casel r2,#1,#14 1$: .word seqread-1$ .word seqwrit-1$ .word ranread-1$ .word ranwrit-1$ .word open-1$ .word close-1$ .word skrec-1$ .word skfile-1$ .word weof-1$ .word rewind-1$ .word alloc-1$ .word seqrecrd-1$ .word seqrecwr-1$ .word ranrecrd-1$ .word ranrecwr-1$ brw EXIT ; ; FUNCTION 1: Sequential Read seqread: $RAB_STORE rab=@ezrab, usz=no_of_bytes,- bkt=#0, ubf=@buffer movl #0, @status sread: $READ rab=@ezrab nread: movl ezrab, r4 addl2 #rab$w_rsz, r4 movw (r4), @status blbc r0, CHECK brw EXIT check: cmpl r0, #RMS$_EOF ;check for end of file beql EOF cmpl r0, #RMS$_RER ;check for small block size beql RER ;if so, return 0 in l brw ERROR rer: movl #0, @status ; pushal RER_ERR ; calls #1, G^LIB$PUT_OUTPUT brw EXIT eof: movl ezfab, r4 ; Eof, now check for tape movl FAB$L_CTX@ezfab, dummy addl2 #FAB$L_CTX, r4 movl (r4), ctx cmpl #0, ctx beql FLAG $CLOSE fab=@ezfab ; Eof on tape must reopen $OPEN fab=@ezfab ; to clear up EOF $CONNECT rab=@ezrab ; Position at next file flag: movl #-3, @status ; Set EOF flag brw EXIT ; FUNCTION 2: Sequential Write ; seqwrit: $RAB_STORE rab=@ezrab, bkt=#0, rbf=@buffer,- rsz=no_of_bytes $FAB_STORE fab=@ezfab, bls=no_of_bytes $WRITE rab=@ezrab blbs r0, SW_OK brw ERROR sw_ok: movl no_of_bytes, @status ; Return number bytes written brw EXIT ; FUNCTION 3: Random Read ; ranread: $RAB_STORE rab=@ezrab, usz=no_of_bytes- bkt=block_number, ubf=@buffer $READ rab=@ezrab movl ezrab, r4 addl2 #rab$w_rsz, r4 movw (r4), @status blbs r0, RR_OK brw CHECK rr_ok: brw EXIT ; FUNCTION 4: Random Write ; ranwrit: $RAB_STORE rab=@ezrab, bkt=block_number, rbf=@buffer,- rsz=no_of_bytes $WRITE rab=@ezrab blbs r0, RW_OK brw ERROR rw_ok: movl no_of_bytes, @status ; Return number bytes written brw EXIT ; FUNCTION 5: Open Files And Devices ; ; logical unit numbers assigned also ; logical unit numbers are store in ; file access blocks (fabs) at assembly time open: movw @buffer, leng movl #1, r4 movl buffer, r2 movl (r2)[r4], fnam $GETDVIW_S devnam=@buffer, - ; Get the type of device itmlst=itemlist cmpl #SS$_IVDEVNAM, r0 ; Invalid device name??? beql NEXT1 ; Treat as DISK blbs r0, NEXT0 ; Check other status pushal dvierr brw PUT_MSG next0: cmpl #DC$_TAPE, code ; Tape device??? bneq NEXT1 ; Assume device is disk!!! movl #1, ctx ; movl #1, @status ; Set return status to TAPE brb NEXT2 next1: clrl ctx ; Assume device is disk!!! movl #512, @status ; Set return status to DISK next2: moval nxo, return brw BLD_FLD nxo: $FAB_STORE fab=@ezfab, ctx=ctx, - fna=@fnam, fns=leng cmpl #0, block_number ; Check for block or record I/O beql op2 ; zero is for block I/O $FAB_STORE fab=@ezfab, fac= ; Open for record I/O, check for cmpl #0, no_of_bytes ; read only privilege on open bneq NXTD $FAB_STORE fab=@ezfab, fac= brw NXTD op2: cmpl #1, no_of_bytes ; Block io check for read only beql NXTD movl ezfab, r6 ; Give write privilege - set put option in FAB bisb2 #FAB$M_PUT, FAB$B_FAC(r6) nxtd: movl lu, valu moval set, return brw CONVRT set: pushal @buffer pushal val_desc calls #2, G^LIB$SET_LOGICAL ; Assign LU file -device blbc r0, ER_ASSIGN opn: $OPEN fab=@ezfab cmpl r0, #RMS$_IFI bneq OPN2 brw EXIT opn2: blbc r0, ERMSG ; Branch to ERMSG if error $CONNECT rab=@ezrab ; Connect RAB blbc r0, ERMSG brw EXIT er_assign: pushal era brw PUT_MSG ; Error checking ermsg: cmpl r0, #RMS$_FNF ; File not found? beql FNFERR ; If not found, return -1 in STATUS brw ERROR ; otherwise, error in open fnferr: brw RTN ; FUNCTION 6: Close File And Deassign LU ; close: $CLOSE fab=@ezfab blbs r0, CL_OK cmpl r0, #RMS$_IFI ; Was file already closed? beql CL_OK ; If so just deassign brw ERROR ; otherwise, error cl_ok: $FAB_STORE fab=@ezfab, ctx=#0 movl lu, valu moval dasgn, return brw CONVRT dasgn: pushal val_desc calls #1, G^LIB$DELETE_LOGICAL; Deassign logical unit brw EXIT ; FUNCTION 7: Skip Record ; skrec: $RAB_STORE rab=@ezrab, bkt=block_number $SPACE rab=@ezrab blbs r0, SKR_OK brw ERROR skr_ok: brw EXIT ; FUNCTION 8: Skip File ; skfile: movl block_number, r3 cmpl #0, r3 ; Check for forward or back bgeq BACK $RAB_STORE rab=@ezrab, bkt=#100 brw SKIP back: mnegl r3, r3 ; skip backwards $RAB_STORE rab=@ezrab, bkt=#-100 skip: $SPACE rab=@ezrab ; Skip until eof is reached cmpl r0, #RMS$_EOF bneq SKIP decl r3 bneq SKIP brw EXIT ; FUNCTION 9: Write End-Of-File (close and reopen) ; weof: $CLOSE fab=@ezfab ; Close function writes eof $OPEN fab=@ezfab ; Reopen since close not required $CONNECT rab=@ezrab blbs r0, WE_OK brw ERROR we_ok: brw EXIT ; FUNCTION 10: Rewind ; rewind: $REWIND rab=@ezrab blbs r0, RE_OK brw ERROR re_ok: brw EXIT ; FUNCTION 11: Allocate File (create) ; alloc: movw @buffer, leng movl #1, r4 movl buffer, r2 movl (r2)[r4], fnam cmpl #0, alqw bneq GOHED movl #64, alqw gohed: cmpl #1, block_number beql FIXREC cmpl #2, block_number bneq VAREC brw RECFIX ; Create file for block I/O access with variable length records ; varec: $FAB_STORE fab=@ezfab, alq=alqw, - mrs=#48000, org=seq, rfm=var, - deq=#1000, rat=cr, fop=cbt, - fna=@fnam, fns=leng brw CREATE ; Create file for block I/O access with fixed length recs. ; fixrec: $FAB_STORE fab=@ezfab, alq=alqw, - mrs=no_of_bytes, org=seq, rfm=fix, - deq=#1000, rat=cr, fop=cbt, - fna=@fnam, fns=leng brw CREATE ; Create file record I/O access with fixed length recs. ; recfix: $FAB_STORE fab=@ezfab, alq=alqw, - mrs=no_of_bytes, org=seq, rfm=fix, - deq=#64, rat=cr, fop=cbt, - fac=, - fna=@fnam, fns=leng create: $CREATE fab=@ezfab blbs r0, CNCT brw ERROR cnct: $CONNECT rab=@ezrab ; Connect RAB blbs r0, CR1 brw ERROR cr1: movl #512, @status ; Return disk sector size in status movl lu, valu moval nextep, return brw CONVRT nextep: pushal @buffer pushal val_desc calls #2, G^LIB$SET_LOGICAL ; Assign LU to file blbs r0, CR2 brw ER_ASSIGN cr2: brw EXIT seqrecrd: $FAB_STORE fab=@ezfab $RAB_STORE rab=@ezrab, usz=no_of_bytes, - ubf=@buffer $GET rab=@ezrab movl ezrab, r4 addl2 #RAB$W_RSZ, r4 movw (r4), @status blbs r0, SQRD brw CHECK sqrd: brw EXIT ; ; seqrecwr: $FAB_STORE fab=@ezfab $RAB_STORE rab=@ezrab, rbf=@buffer, - rsz=no_of_bytes $PUT rab=@ezrab blbs r0, SWR_OK brw ERROR swr_ok: movl no_of_bytes, @status brw EXIT ; ; ranrecrd: $FAB_STORE fab=@ezfab $RAB_STORE rab=@ezrab, - rac=key, kbf=block_number, - ubf=@buffer, usz=no_of_bytes $GET rab=@ezrab movl ezrab, r4 addl2 #RAB$W_RSZ, r4 movw (r4), @status blbs r0, RNR_OK brw CHECK rnr_ok: brw EXIT ranrecwr: $FAB_STORE fab=@ezfab $rab_store rab=@ezrab, - rbf=@buffer, rsz=no_of_bytes, - rac=key, kbf=block_number, - rop= $PUT rab=@ezrab blbs r0, RNWR_OK brw ERROR rnwr_ok:movl no_of_bytes, @status brw EXIT exit: ret ; Exit for normal status return ;************************************************* ; ; CONVRT: Routine to convert 1 or 2 digit logical ; unit or function number to ascii ; descriptor for error output ; valu= integer value to be converted ; return = address to return to ; ;************************************************** convrt: movl #1, r10 ; Set for one digit cmpl #10, valu ; Is value two digits? bgtr STORE ; Yes, go store the one incl r10 ; No, set for two digits store: movw r10, val_desc ; Store length in descriptor pushal val_desc ; Push parameters on stack pushal valu calls #2, G^OTS$CVT_L_TI jmp @return ;************************************************** ; ; BLD_FLD: Routine to build file descriptor, file_desc ; buffer = buffer containing file name ; return = address to which to return ; ;************************************************** bld_fld:movl #0, r4 movl #-1, r6 movl fnam, r3 contr: incl r6 ; Get length of filename cmpb #58, (r3)[r6] beql nexta addl2 #1, r4 cmpl #20, r4 beql nexta brb contr nexta: movl r4, file_desc ; Build filename descriptor movl fnam, file_desc+4 jmp @return ;************************************************** ; ; DEVICE: Routine to construct device name as dd: ; Controller and unit specifications are ; suppressed, device name is placed in test ; valu = filename length ; return = address to return to ; ;************************************************** device: movl valu, r4 ; Length of name movl fnam, r3 ; Get address of name movw @fnam, test ; Get first 2 chars. movb (r3)[r4], test+2 ; Pick up colon jmp @return ;************************************************* ; ; Error Handling: Compare contents of register 0 ; to error codes and put address ; of error message on stack ;************************************************** error: cmpl r0, #RMS$_ACT bneq ERR1 pushal act brw PUT_MSG err1: cmpl r0, #RMS$_DNR bneq ERR2 pushal dnr brw PUT_MSG err2: cmpl r0, #RMS$_DPE bneq ERR3 pushal dpe brw PUT_MSG err3: cmpl r0, #RMS$_EXT bneq ERR4 pushal ext brw PUT_MSG err4: cmpl r0, #RMS$_DAC bneq ERR5 pushal dac brw PUT_MSG err5: cmpl r0, #RMS$_CRE bneq ERR6 pushal cre brw PUT_MSG err6: cmpl r0, #RMS$_DNF bneq ERR7 pushal dnf brw PUT_MSG err7: cmpl r0, #RMS$_FLK bneq ERR8 pushal flk brw PUT_MSG err8: cmpl r0, #RMS$_WLK bneq ERR9 pushal acc brw PUT_MSG err9: cmpl r0, #RMS$_ACC bneq ERR10 pushal acc brw PUT_MSG err10: cmpl r0, #RMS$_FNF bneq ERR11 pushal fnf brw PUT_MSG err11: cmpl r0, #RMS$_IFI bneq ERR12 pushal ifi brw PUT_MSG err12: cmpl r0, #RMS$_ISI bneq ERR13 pushal isi brw PUT_MSG err13: cmpl r0, #RMS$_FUL bneq ERR14 pushal ful brw PUT_MSG err14: cmpl r0, #RMS$_FAC bneq ERR15 pushal fac brw PUT_MSG err15: cmpl r0, #RMS$_NEF bneq ERR16 pushal nef brw PUT_MSG err16: pushal ezerr ; General error message put_msg:movl r0, error_status ; Save function status calls #1, G^LIB$PUT_OUTPUT movl ifun, valu ; Convert function code to ASCII moval put_fun, return brw CONVRT put_fun:movc3 @#val_desc,val, - error_msg+7 ; Move function code movl lu, valu ; Convert logical unit to ASCII moval put_lun, return brw CONVRT put_lun:movc3 @#val_desc,val, - error_msg+26 ; Move logical unit number movl lu, valu ; Convert logical unit to ASCII moval put_stat, return BRW CONVRT put_stat: pushal stat_desc pushal error_status calls #2, G^OTS$CVT_L_TZ ; Convert function status to ASCII movc3 @#stat_desc,stat, - error_msg+44 ; Move function status pushal error_desc ; Output complete error message calls #1, G^LIB$PUT_OUTPUT rtn: movl #-1, @status ret ;******************************************************* ; Data Section ;******************************************************* .psect EZTRAN_DATA ,wrt,noexe,long itemlist: .word 4 ; Length of return buffer .word DVI$_DEVCLASS ; Get device type .long code ; Buffer to receive info .long retlen ; # bytes actually returned .long 0 code: .blkl 1 ; Buffer to receive data retlen: .blkl 1 ; Length of received data devstat:.blkq 1 ; Return status on $GETDVI dummy: .blkl 1 lu: .long 0 ifun: .long 0 block_number: .long 0 no_of_bytes: .long 0 buffer: .long 0 status: .long 0 ctx: .long 0 error_status: .long 0 return: .long 0 valu: .long 0 fnam: .long 0 leng: .long 0 alqw: .long 0 test: .ascii / / .align long ; FAB and RAB blocks must be ; aligned on longword boundaries ezfab: .address fab1 ezrab: .address rab1 fab1: $FAB fac=,- fnm=<1> fab2: $FAB fac=,- fnm=<2> fab3: $FAB fac=,- fnm=<3> fab4: $FAB fac=,- fnm=<4> fab5: $FAB fac=,- fnm=<5> fab6: $FAB fac=,- fnm=<6> fab7: $FAB fac=,- fnm=<7> fab8: $FAB fac=,- fnm=<8> fab9: $FAB fac=,- fnm=<9> fab10: $FAB fac=,- fnm=<10> fab11: $FAB fac=,- fnm=<11> fab12: $FAB fac=,- fnm=<12> fab13: $FAB fac=,- fnm=<13> fab14: $FAB fac=,- fnm=<14> fab15: $FAB fac=,- fnm=<15> fab16: $FAB fac=,- fnm=<16> fab17: $FAB fac=,- fnm=<17> fab18: $FAB fac=,- fnm=<18> fab19: $FAB fac=,- fnm=<19> fab20: $FAB fac=,- fnm=<20> fabadr: .long 0 .address fab1 .address fab2 .address fab3 .address fab4 .address fab5 .address fab6 .address fab7 .address fab8 .address fab9 .address fab10 .address fab11 .address fab12 .address fab13 .address fab14 .address fab15 .address fab16 .address fab17 .address fab18 .address fab19 .address fab20 rab1: $RAB fab=fab1 rab2: $RAB fab=fab2 rab3: $RAB fab=fab3 rab4: $RAB fab=fab4 rab5: $RAB fab=fab5 rab6: $RAB fab=fab6 rab7: $RAB fab=fab7 rab8: $RAB fab=fab8 rab9: $RAB fab=fab9 rab10: $RAB fab=fab10 rab11: $RAB fab=fab11 rab12: $RAB fab=fab12 rab13: $RAB fab=fab13 rab14: $RAB fab=fab14 rab15: $RAB fab=fab15 rab16: $RAB fab=fab16 rab17: $RAB fab=fab17 rab18: $RAB fab=fab18 rab19: $RAB fab=fab19 rab20: $RAB fab=fab20 rabadr: .long 0 .address rab1 .address rab2 .address rab3 .address rab4 .address rab5 .address rab6 .address rab7 .address rab8 .address rab9 .address rab10 .address rab11 .address rab12 .address rab13 .address rab14 .address rab15 .address rab16 .address rab17 .address rab18 .address rab19 .address rab20 stat: .blkb 8 stat_desc: .word 8 .byte 14 .byte 1 .long stat val: .blkb 2 val_desc: .word 1 .byte 14 .byte 2 .long val error_desc: .word 66 .byte 14 .byte 2 .long error_msg error_msg: .ascii / :Function/<13><10> .ascii / :Logical unit/<13><10> .ascii / :Hex Status/<13><10> file_desc: .long 0 file_name: .long 0 dvierr: .ascid /%EZTRAN-F-GETDVIERR Error in GETDVI call/ rer_err:.ascid /%EZTRAN-W-READWARN Less bytes read than in record/ era: .ascid /%EZTRAN-F-ASSIGNLU Error in logical unit assignment/ ezerr: .ascid /%EZTRAN-F-UNKNOWNERR Undiagnosed error/ act: .ascid /%EZTRAN-F-FILEACTIV File activity precludes operation/ dnr: .ascid /%EZTRAN-F-DEVNOTRED Device not ready or not mounted/ dpe: .ascid /%EZTRAN-F-POSERR Device positioning error/ ext: .ascid /%EZTRAN-F-ACPEXTDERR Acp file extend failed/ dac: .ascid /%EZTRAN-F-ACPCLOSERR Acp file deaccess failed during close/ cre: .ascid /%EZTRAN-F-ACPCREATERR Acp file creation failed/ dnf: .ascid /%EZTRAN-F-DIRNOTFOU Directory not found/ flk: .ascid /%EZTRAN-F-FILELOC File currently locked by another user/ wlk: .ascid /%EZTRAN-F-WRITLOC Device currently write locked/ acc: .ascid /%EZTRAN-F-ACPACCESERR Acp file access failed/ fnf: .ascid /%EZTRAN-F-FILNOTFOU File not found/ ifi: .ascid /%EZTRAN-F-INVALFAB Invalid identification in FAB - file not open/ isi: .ascid /%EZTRAN-F-INVALRAB Invalid identification in RAB - file not open/ ful: .ascid /%EZTRAN-F-DEVFUL Device full...cannot create or extend file/ fac: .ascid /%EZTRAN-F-ILLEGALOP Operation not allowed...file may be read only/ nef: .ascid /%EZTRAN-F-NOTEOF Not positioned at end of file/ .end