.title PDPFIL file operations (lookup, delete, ...) .ident /1.0.01/ .library /lb:[1,1]rmsmac.mlb/ ; 20-Jun-85 16:38:04 Brian Nelson ; ; For proper documentation, see DISKIO.MAR (the VMS version) ; for detailed explanations of functions. .macro save list .if b , .ift save .iff .irp x, mov x,-(sp) .endr .endc .endm save .macro unsave list .if b , .ift unsave .iff .irp x, mov (sp)+,x .endr .endc .endm unsave .macro print s,l .print s,l .endm print .MACRO .ASSUME ARG1,COND,ARG2 .IF COND - .IFF .ERROR ARG1 ;"COND ARG2" FAILS .ENDC .ENDM .ASSUME cr = 15 lf = 12 ff = 14 soh = 1 .enabl gbl .psect rmscod ,ro,i,lcl,rel,con .psect rmsdat ,rw,d,lcl,rel,con .even .mcall fabof$ .mcall rabof$ .mcall xabof$ fabof$ RMS$L rabof$ RMS$L xabof$ RMS$L .mcall $compar ,$fetch ,$store ,$rewin .mcall $close ,$creat ,$erase ,$open .mcall $connec ,$delet ,$discon,$find .mcall $get ,$put ,$updat ,$flush .mcall $read ,$write ,$off ,$set .mcall $testbit,$parse ,$search .sbttl getnext(&dststring,&srcstring,restart_flag) .psect rmscod ,ro,i,lcl,rel,con getnex::save ; save a register we may use mov #fab$nex,r2 ; get a fab to use for this $fetch r1,NAM,r2 ; Get NAM block address mov o$wcc(r1),oldwcc ; save previous wildcard context dec oldwcc ; previous please bpl 5$ ; clr oldwcc ; oops, clear it out 5$: mov o$wdi(r1),oldwdi ; ditto... mov 6(sp) ,r1 ; filename address $store r1,FNA,r2 ; stuff the filename address in fab 10$: tstb (r1)+ ; look for the end of the string bne 10$ ; no yet sub 6(sp) ,r1 ; get length dec r1 ; less one $store r1,FNS,r2 ; stuff the filename length into FAB tst 10(sp) ; first time here ? bne 20$ ; no clr oldidx ; Clear saved caller's index $parse r2 ; parse the filename $fetch r0,STS,r2 ; get the status bmi 90$ ; exit on error please 20$: cmp 10(sp) ,oldidx ; Trying to back up in directory? bge 25$ ; No cmp systyp ,#4 ; RSTS ? bne 25$ ; No, ignore $fetch r1,NAM,r2 ; Yes, get NAM block address mov oldwcc,O$WCC(r1) ; dec O$WCC(r1) ; Yes, restore previous context bpl 25$ ; clr O$WCC(r1) ; 25$: $search r2 ; now look for the file please $fetch r0,STS,r2 ; get the status bmi 90$ ; exit on error please $fetch r2,NAM,r2 ; get the nam block address $fetch r1,RSA,r2 ; get the nam block resultant string $fetch r0,RSL,r2 ; get the resultant string length mov O$WDI(r2),nxtwdi ; save it mov O$WCC(r2),nxtwcc ; save it mov 10(sp) ,oldidx ; save called index number mov 4(sp) ,r2 ; where to return the name to 30$: movb (r1)+ ,(r2)+ ; copy it over please sob r0 ,30$ ; next please clrb @r2 ; .asciz mov #1 ,r0 ; success br 100$ ; exit 90$: mov r0 ,tedsyserror ; save it cmp r0 ,#ER$NMF ; no more files ? bne 95$ ; no mov #2 ,r0 ; yes, flag as being so br 100$ ; exit 95$: clr r0 ; failure 100$: unsave return .sbttl lookup a file .psect rmscod flooku::save ; save a register we may use mov #fab$sea,r2 ; get a fab to use for this mov 4(sp) ,r1 ; filename address $store r1,FNA,r2 ; stuff the filename address in fab 10$: tstb (r1)+ ; look for the end of the string bne 10$ ; no yet sub 4(sp) ,r1 ; get length dec r1 ; less one $store r1,FNS,r2 ; stuff the filename length into FAB $parse r2 ; parse the filename $fetch r0,STS,r2 ; get the status bmi 90$ ; exit on error please $search r2 ; now look for the file please $fetch r0,STS,r2 ; get the status bmi 90$ ; exit on error please mov #1 ,r0 ; success br 100$ ; exit 90$: mov r0 ,tedsyserror ; save it clr r0 ; failure 100$: unsave return iswild::save ; save a register we may use mov #fab$sea,r2 ; get a fab to use for this mov 4(sp) ,r1 ; filename address $store r1,FNA,r2 ; stuff the filename address in fab 10$: tstb (r1)+ ; look for the end of the string bne 10$ ; no yet sub 4(sp) ,r1 ; get length dec r1 ; less one $store r1,FNS,r2 ; stuff the filename length into FAB $parse r2 ; parse the filename $fetch r0,STS,r2 ; get the status bmi 90$ ; exit on error please $fetch r1,NAM,r2 ; get the name block address $testbi #NB$WVE!NB$WTY!NB$WNA!NB$WDI,FNB,r1 ; any wildcarding today ? beq 90$ ; no mov #1 ,r0 ; yes, return(true) br 100$ ; exit 90$: mov r0 ,tedsyserror ; no, or filename error clr r0 100$: unsave ; pop reg and exit return ; exit .sbttl parse filename (see if it's legit) chkfil::save ; save a register we may use mov #fab$sea,r2 ; get a fab to use for this mov 4(sp) ,r1 ; filename address $store r1,FNA,r2 ; stuff the filename address in fab 10$: tstb (r1)+ ; look for the end of the string bne 10$ ; no yet sub 4(sp) ,r1 ; get length dec r1 ; less one $store r1,FNS,r2 ; stuff the filename length into FAB $parse r2 ; parse the filename $fetch r0,STS,r2 ; get the status bmi 90$ ; exit on error please mov #1 ,r0 ; yes, return(true) br 100$ ; exit 90$: mov r0 ,tedsyserror ; no, or filename error clr r0 100$: unsave ; pop reg and exit return ; exit prsnam::mov r2 ,-(sp) ; save a register we may use mov #fab$sea,r2 ; get a fab to use for this mov 6(sp) ,r1 ; filename address $store r1,FNA,r2 ; stuff the filename address in fab 10$: tstb (r1)+ ; look for the end of the string bne 10$ ; no yet sub 6(sp) ,r1 ; get length dec r1 ; less one $store r1,FNS,r2 ; stuff the filename length into FAB $parse r2 ; parse the filename $fetch r0,STS,r2 ; get the status bmi 90$ ; exit on error please $fetch r2,NAM,r2 ; get the nam block address $fetch r1,ESA,r2 ; get the nam block expanded string $fetch r0,ESL,r2 ; get the expanded string length mov 4(sp) ,r2 ; where to return the name to 30$: movb (r1)+ ,(r2)+ ; copy it over please sob r0 ,30$ ; next please clrb @r2 ; .asciz mov #1 ,r0 ; Success br 100$ ; Exit 90$: mov r0 ,tedsyserr ; Save it clr r0 ; Failure 100$: mov (sp)+ ,r2 ; Pop and exit return .sbttl delete a file .psect rmscod delfil::mov 2(sp) ,-(sp) ; stuff string address call strlen ; get length of the filename tst (sp)+ ; pop parameter mov #fab$sea,r1 ; the fab to use please $store r0,FNS,r1 ; the filename size $store 2(sp),FNA,r1 ; the filename address $parse r1 ; parse the filename $fetch r0,STS,r1 ; see if the parse worked bmi 90$ ; no $erase r1 ; try to delete the thing $fetch r0,STS,r1 ; see if it worked bmi 90$ ; failed mov #1 ,r0 ; success br 100$ ; exit 90$: mov r0 ,tedsyserror ; save error clr r0 ; failure 100$: return .sbttl fixfilename remove version number ; fixfilename(&dst,&src) fixfilename:: save mov 2+4(sp) ,r1 mov 4+4(sp) ,r2 10$: cmpb @r2 ,#'; beq 20$ cmpb @r2 ,#'/ beq 20$ movb (r2)+ ,(r1)+ bne 10$ 20$: clrb @r1 100$: unsave mov #1 ,r0 return .sbttl get mcr/ccl command line .mcall gmcr$ ,dir$ .save .psect rwdata gmcr: gmcr$ .restore ; getmcrcommand(s) getmcr::save ; just for kicks, save these mov 2+4(sp) ,r2 ; point to the resultant command clrb @r2 ; insure .asciz dir$ #gmcr ; get the command line movb @#$dsw ,r0 ; get the length of it ble 90$ ; nothing mov #gmcr+g.mcrb,r1 10$: movb (r1)+ ,(r2)+ sob r0 ,10$ clrb @r2 movb @#$DSW ,r0 br 100$ 90$: clr r0 100$: unsave return .end