.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 GLOBAL LIST .GLOBL LIST .ENDM GLOBAL .MACRO .ASSUME ARG1,COND,ARG2 .IF COND - .IFF .ERROR ARG1 ;"COND ARG2" FAILS .ENDC .ENDM .ASSUME .macro .chksp arg .ntype $$5 ,arg .iif eq,<$$5 & 7>-6, .error arg ; Illegal use of SP(r6) in call .endm .chksp cr = 15 lf = 12 ff = 14 soh = 1 .enabl gbl .psect rmscod ,ro,i,lcl,rel,con .psect rmsdat ,rw,d,lcl,rel,con .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 .save .psect rwdata ,rw,d,lcl,rel,con hlpdef: .asciz /LB:[1,2]/ hlptyp: .asciz /.HLP/ .even workna: .asciz /TED$TEMP:EDIT.TMP/ ; name for RSTS/E and P/OS workln = . - workna tmpnam: .asciz /SY:EDIT.TMP/ tmplen = . - tmpnam sysdv: .ascii /SY:/ sysln = . - sysdv .even .restore .sbttl create work files .psect rmscod cretmp::cmpb systype ,#4 ; RSTS/E ? bne 5$ ; No jmp rstscr ; Yes, bypass RMS 5$: save mov #fab$search,r2 ; fab to use for the $parse $store #workna,FNA,r2 ; setup for $PARSE to get dev and UIC $store #workln,FNS,r2 ; to see if the logical will translate $store #sysdv,DNA,r2 ; default device $store #sysln,DNS,r2 ; ... $parse r2 ; see if we can get the logical done $compar #0,STS,r2 ; success ? blt 10$ ; no, revert to SY: $fetch r2,NAM,r2 ; get the NAM block address for FAB $fetch r0,ESL,r2 ; get expanded string length please $fetch r1,ESA,r2 ; get expanded string address add r1 ,r0 ; make it .asciz clrb @r0 ; simple mov r1 ,-(sp) ; call the create routine call .cretm ; ... tst (sp)+ ; pop stack tst r0 ; did it work ok bne 100$ ; yes 10$: mov #tmpnam ,-(sp) ; no, drop back to simple name call .cretm ; and do it again tst (sp)+ ; pop stack 100$: unsave return .cretm: mov #fab$work,r1 ; get the main workfile call 190$ ; set up the fab with filename $create r1 ; try hard to create the thing call 200$ ; check to see if it worked ok beq 100$ ; no mov #rab1 ,r1 ; it worked, now connect it up $store #0,ROP,r1 ; ?? $connec r1 ; ... call 200$ ; see if it succeeded beq 100$ ; no cmp nwindows,#1 ; don't bother with second file beq 100$ ; if we will never need it mov #fab$scwork,r1 ; get the secondary workfile call 190$ ; set up the fab with filename $create r1 ; try to create this one also call 200$ ; and see if that worked ok beq 100$ ; no mov #rab2 ,r1 ; yes, so now try to connect the $connec r1 ; access stream up now. call 200$ ; check for success and exit 100$: return 190$: mov 4(sp) ,r0 ; get filename address $store r0,FNA,r1 ; stuff the address into the fab mov r0 ,-(sp) ; stuff onto stack for strlen call strlen ; get filename length $store r0,FNS,r1 tst (sp)+ ; pop stack cmpb systype ,#4 ; RSTS/E bne 195$ ; no $off #FB$TMP,FOP,r1 ; yes. FB$TMP --> UIC's are ignored 195$: $off #FB$CTG,FOP,r1 ; also, we can't extend contig files return ; exit 200$: $fetch r0,sts,r1 ; get status back out please mov r0 ,tedsyserror ; save this please bmi 210$ ; error, return(0) mov #1 ,r0 ; no error, return(1) return 210$: clr r0 return clotmp::cmpb systype ,#4 ; RSTS/E ? bne 5$ ; No jmp rstscl ; Yes, ignore 5$: save $discon #rab1 $close #fab$work $discon #rab2 $close #fab$scwork mov #cutmap ,r1 mov #cutopen,r2 10$: tst @r1 ; see if this is the end of cutpaste beq 30$ ; files tst (r2)+ ; not end, is this one open now? beq 20$ ; no mov @r1 ,r3 ; yes, index to the channel map asl r3 ; words please $discon rablst(r3) ; disconnect access stream $close fablst(r3) ; simple 20$: tst (r1)+ ; next please br 10$ ; simple 30$: 100$: unsave return cretm1:: cretm2::mov #1 ,r0 return .sbttl help routines opnhlp::save ; save temp registers mov #fab$hl ,r2 ; tst o$ifi(r2) ; file already open? beq 5$ ; no $discon #rab$hl ; yes, close up please $close r2 ; ... 5$: mov sp ,r1 ; save stack pointer sub #100 ,sp ; allocate a filename buffer mov sp ,r3 ; and a pointer to buffer mov #hlpdef ,r2 ; copy the default string 10$: movb (r2)+ ,(r3)+ ; move a byte bne 10$ ; and do it again until a null dec r3 ; back up over the null mov 2+4(r1) ,r2 ; get address of filename 20$: movb (r2)+ ,(r3)+ ; and copy it until a null bne 20$ ; next dec r3 mov #hlptyp ,r2 ; stuff a filetype in 30$: movb (r2)+ ,(r3)+ ; ... bne 30$ ; mov sp ,r3 ; point back to the buffer mov r3 ,-(sp) ; setup to call strlen call strlen ; get the string length tst (sp)+ ; pop parameter mov #fab$hl ,r2 ; get the fab address $store r3,FNA,r2 ; stuff the filename in $store r0,FNS,r2 ; and the filename size $open r2 ; open it $fetch r0,STS,r2 ; and see if it worked bmi 90$ ; no mov #rab$hl ,r2 ; it's open, now connect rab $connec r2 ; ... $fetch r0,STS,r2 ; successfull ? bmi 90$ ; no mov #1 ,r0 ; yes, return success br 100$ ; exit 90$: mov r0 ,tedsyserror ; save error code clr -(sp) mov r3 ,-(sp) call putbin cmp (sp)+ ,(sp)+ clr r0 ; return(0) 100$: add #100 ,sp ; pop local buffer and exit unsave ; pop regs return ; exit .sbttl open/create file openfi::save mov sp ,r4 ; get pointer to arglist add #4*2 ,r4 ; got it mov #cfile ,r3 ; assume fileio ? cmpb 2(r4) ,indlun ; is that the case bne 10$ ; yes mov #cind ,r3 br 20$ ; open it 10$: cmpb 2(r4) ,inlun ; for reading ? beq 20$ ; yes call cre ; no, create the thing br 100$ 20$: call ope 100$: unsave return closef::save cmpb 2+4(sp) ,kblun beq 80$ mov #cfile ,r2 cmpb 2+4(sp) ,indlun bne 10$ mov #cind ,r2 10$: asl r2 mov rablst(r2),r3 $discon r3 mov fablst(r2),r3 $close r3 80$: mov #1 ,r0 100$: unsave return .sbttl open for read ope: asl r3 ; index into rab/fab mapping mov fablst(r3),r2 ; get the fab address mov rablst(r3),r3 ; get the rab address also mov @r4 ,-(sp) ; get filename length call strlen ; length tst (sp)+ ; pop arglist $store @r4,FNA,r2 ; stuff the filename address $store r0,FNS,r2 ; insert the filename size $store #FB$GET,FAC,r2 ; get access only $store #proxab,XAB,r2 ; find out file protection $open r2 ; open the file please $fetch r0,STS,r2 ; see if the open worked bmi 90$ ; failed $connec r3 ; connect access stream $fetch r0,STS,r3 ; see if that worked bmi 90$ ; no mov (r2),filesize ; save size of infile mov #1 ,r0 ; success br 100$ ; exit 90$: mov r0 ,tedsyserror ; save error and exit clr r0 ; flag failure 100$: return setmbc::save mov #rab$fi ,r3 mov #fab$fi ,r2 ;- cmpb cmdlun ,kblun ;- bne 100$ call pdpbuf $store r0,BPA ,r2 $store r1,MBC ,r3 mul #1000 ,r1 $store r1,BPS ,r2 100$: unsave return clrmbc::mov #rab$fi ,r0 $store #0,MBC ,r0 mov #fab$fi ,r0 $store #0,BPA ,r0 $store #0,BPS ,r0 return .sbttl create seq file cre: asl r3 ; index into rab/fab mapping mov fablst(r3),r2 ; get the fab address mov rablst(r3),r3 ; get the rab address also mov @r4 ,-(sp) ; get filename length call strlen ; length tst (sp)+ ; pop arglist clr (r2) ; clear filesize $store #FB$SEQ,ORG,r2 ; sequential file $store #FB$CR,RAT,r2 ; implied carriage control $store #FB$VAR,RFM,r2 ; variable $store #FB$PUT,FAC,r2 ; get access only $store @r4,FNA,r2 ; stuff the filename address $store r0,FNS,r2 ; insert the filename size cmpb systyp ,#4 ; RSTS/E ? bne 10$ ; no $store #FB$STM,RFM,r2 ; yes, default to stream ascii please $store #0,RAT,r2 ; ... 10$: $create r2 ; open the file please $fetch r0,STS,r2 ; see if the open worked bmi 90$ ; failed $connec r3 ; connect access stream $fetch r0,STS,r3 ; see if that worked bmi 90$ ; no mov #1 ,r0 ; success br 100$ ; exit 90$: mov r0 ,tedsyserror ; save error and exit clr r0 ; flag failure 100$: return .end