.title K11CPY copy file from input to output .ident /3.42/ ; 03-Feb-84 15:08:54 Brian Nelson ; ; Copyright (C) 1984 Change Software, Inc. ; ; Bob Denny 05-Mar-84 Remove SY: defaulting. Not required, and it ; [RBD01] prevents DECnet (DAP) remote file access to ; VMS and other systems which don't understand ; SY:. ; ; Bob Denny 07-Mar-84 Close input file if output file open fails, ; [RBD02] so copy may be tried again. ; ; Brian Nelson 17-Mar-84 Put back the SY: defaulting for RSTS rms11v2 ; ; Brian Nelson 08-Jan-86 Cut buffer size to reduce size .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .endc .library /LB:[1,1]RMSMAC.MLB/ .mcall fab$b ,fab$e ,rab$b ,rab$e .mcall $compar ,$fetch ,$set ,$store .mcall $connec ,$disco ,$read ,$write .mcall $close ,$creat ,$open .mcall ifaof$ ; access the ifab for the fab ifaof$ rms$l ; get the ifab symbols defined .psect k11cpy ,rw,d,lcl,rel,con ; Allocate a large buffer for $read and $write ; Also define the FABs and RAB for the copy. copbfs = 2000 ; nice that RMS in seqeuntial mode copbuf: .blkb copbfs ; will fix the next blocknumber based ; based on the size of the last write copfb1: fab$b f$fac fb$rea ; allowed i/o operations f$fop fb$sup ; supercede old versions f$lch 1 ; channel number to use f$rfm fb$var f$rat fb$cr fab$e copfb2: fab$b f$fac ; allow block mode write's f$fop fb$sup ; supercede old versions f$lch 2 ; channel number to use fab$e coprb1: rab$b ; define record access block r$fab copfb1 ; associate a fab with this rab r$rac rb$seq ; access sequentially r$rbf copbuf ; where to return the data r$ubf copbuf ; where to return the data r$usz 512. ; size of myrec (maximum size) rab$e ; end of record access block coprb2: rab$b ; define record access block r$fab copfb2 ; associate a fab with this rab r$rac rb$seq ; access sequentially r$rbf copbuf ; where to return the data r$ubf copbuf ; where to return the data r$usz 512. ; size of myrec (maximum size) rab$e ; end of record access block .sbttl copy one file to another .psect $code copy:: save ; save r2-r4 please sub #100 ,sp ; allocate a buffer for the mov sp ,r3 ; fully parsed input filename sub #100 ,sp ; allocate a buffer for the mov sp ,r4 ; fully parsed output filename calls fparse ,<@r5,r3> ; simple to do tst r0 ; expand the input filename first bne 100$ ; it failed, exit please calls fparse ,<2(r5),r4> ; build the output filespec next tst r0 ; did the parse of the name succeed? bne 100$ ; no, exit with the RMS error mov #copfb1 ,r1 ; point to the input FAB mov #copfb2 ,r2 ; point to the output FAB $store r3,FNA ,r1 ; stuff the input filename in FAB $store r4,FNA ,r2 ; stuff the output filename in FAB strlen r3 ; get the input filename length $store r0,FNS ,r1 ; stuff it into the FAB strlen r4 ; get the input filename length $store r0,FNS ,r2 ; stuff it into the FAB tst fu$def ; do we really need a def device beq 10$ ; no $store #sydska ,DNA,r1 ; stuff defaults for the name in $store #sydskl ,DNS,r1 ; FAB since we already parsed and $store #sydska ,DNA,r2 ; expanded the input and output $store #sydskl ,DNS,r2 ; filenames with our defaults. 10$: $open r1 ; open the input file up please $fetch r0,STS ,r1 ; get the error code out now bmi 100$ ; error exit now call copyatr ; yes, move file org stuff to out FAB $create r2 ; try to create the output file now $fetch r0,STS ,r2 ; get the RMS status from the FAB bmi 90$ ; it didn't work out, close input file call copyfi ; do the file copy now call fixatr ; fix the atttribute data up $close r2 ; Close output file ;RBD02 90$: $close r1 ; Close input file ;RBD02 100$: tst r0 ; set ret. codes to zero if > 0 bmi 110$ ; ok clr r0 ; say it worked 110$: add #100*2 ,sp ; pop local filename buffers mov r4 ,r1 ; number of blocks copied unsave ; pop local registers and exit return .sbttl fix the file attribute data up by looking at the IFAB ; input: r1 --> FAB for the input file ; r2 --> FAB for the output file ; ; Since these fields all follow each other in order we could ; of course use .assume or assert macros to check for their ; order, but then if rms were altered we would be in trouble. ; As it stands, by doing this (looking at IFABS), we may be ; in trouble for future versions of RMS anyway. It would be ; much simpler if RMS would provide a means to override the ; eof and recordsize markers at runtime. fixatr: save ; save temps please mov o$ifi(r1),r3 ; point to the input file IFAB mov o$ifi(r2),r4 ; point to the output file IFAB cmpb o$rfm(r1),#fb$stm ; stream file as input ? bne 10$ ; no tst f$rsiz(r3) ; yes, stream. Any valid recordsize? bne 10$ ; yes, assume that the rest is valid clrb f$ratt(r4) clrb f$forg(r4) clr f$rsiz(r4) clr f$hvbn(r4) clr f$lvbn(r4) clr f$heof(r4) clr f$leof(r4) clr f$ffby(r4) clrb f$hdsz(r4) clrb f$bksz(r4) clr f$mrs(r4) clr f$deq(r4) clr f$rtde(r4) br 100$ 10$: movb f$ratt(r3),f$ratt(r4) ; stuff the input record attributes movb f$forg(r3),f$forg(r4) ; also stuff the input file org in mov f$rsiz(r3),f$rsiz(r4) ; and the input record size please mov f$hvbn(r3),f$hvbn(r4) ; and the input eof markers mov f$lvbn(r3),f$lvbn(r4) ; like hi and low virtual block mov f$heof(r3),f$heof(r4) ; and the high and low eof block mov f$leof(r3),f$leof(r4) ; numbers also mov f$ffby(r3),f$ffby(r4) ; and, at last, the first free byte movb f$hdsz(r3),f$hdsz(r4) ; VFC header size next movb f$bksz(r3),f$bksz(r4) ; and largest bucket size mov f$mrs(r3) ,f$mrs(r4) ; the maximum record size mov f$deq(r3) ,f$deq(r4) ; and the default extenstion size mov f$rtde(r3),f$rtde(r4) ; and the run time extentsion size 100$: unsave ; all done return .sbttl copyatr copy the input record format to the output file's FAB ; We don't really need this as it turns out we will have to ; do a read attributes for the input file and a write for the ; output file anyway due to problems in marking the EOF point ; and in copying stream ascii files in general. ; It would have been nice to avoid all that. We could avoid ; it if all files had attributes (unlike RSTS) and if we had ; access to RMS blocks regarding EOF info. copyat: mov o$alq+0(r1),o$alq+0(r2) ; allocation is a double word field. mov o$alq+2(r1),o$alq+2(r2) ; $fetch to r0 would clobber r1 also $fetch r0,BKS ,r1 ; the macros select the proper size $store r0,BKS ,r2 ; of the move at a cost in space. $fetch r0,DEQ ,r1 ; done with the allocation and bucket $store r0,DEQ ,r2 ; size, now stuff the extension size. $fetch r0,FOP ,r1 ; o$fop(r2) := o$fop(r1) $set r0,FOP ,r2 ; possibly want a contiguous file $fetch r0,FSZ ,r1 ; get the VFC fixed control size $store r0,FSZ ,r2 ; o$fsz(r2) := o$fsz(r1) $fetch r0,LRL ,r1 ; get the longest record size $store r0,LRL ,r2 ; o$lrl(r2) := o$lrl(r1) $fetch r0,MRS ,r1 ; get the maximum record size $store r0,MRS ,r2 ; o$mrs(r2) := o$mrs(r1) $fetch r0,ORG ,r1 ; get the file organization now $store r0,ORG ,r2 ; o$org(r2) := o$org(r1) $fetch r0,RAT ,r1 ; get the record attributes now $store r0,RAT ,r2 ; o$rat(r2) := o$rat(r1) $fetch r0,RFM ,r1 ; get the record format next $store r0,RFM ,r2 ; o$rfm(r2) := o$rfm(r1) $fetch r0,RTV ,r1 ; get the cluster size next $store r0,RTV ,r2 ; o$rtv(r2) := o$rtv(r1) return ; ... at last .......... .sbttl connect, copy and disconnect from the files to be copied copyfi: save ; save the old FAB addresses clr r4 ; blocks := 0 mov #coprb1 ,r1 ; connect up first please $connec r1 ; connect up now $fetch r0,STS ,r1 ; get the error code out bmi 100$ ; oops mov #coprb2 ,r2 ; connect up first please $connec r2 ; connect up now $fetch r0,STS ,r2 ; get the error code out bmi 100$ ; oops 10$: clr o$bkt+0(r1) ; setup for sequential reads and writes clr o$bkt+2(r1) ; two words for block numbers clr o$bkt+0(r2) ; do it to both the input RAB and the clr o$bkt+2(r2) ; output RAB $store #copbfs,USZ,r1 ; stuff the buffer size in $store #copbuf,UBF,r1 ; and also the buffer address please $read r1 ; get the next block $fetch r0,STS ,r1 ; get the error code out bmi 90$ ; oops, exit on error please $fetch r5,RSZ ,r1 ; get the byte count please $store r5,RSZ ,r2 ; stuff the buffer size in $store #copbuf ,RBF,r2 ; and also the buffer address please $write r2 ; write the next block $fetch r0,STS ,r2 ; get the error code out bmi 90$ ; oops, exit on error please ash #-11 ,r5 ; convert byte count to blocks add r5 ,r4 ; blocks := blocks + bytecount/512 br 10$ ; next please 90$: $discon r1 ; disconnect from input RAB $discon r2 ; disconnect from the output RAB cmp r0 ,#ER$EOF ; normal exit is always EOF bne 100$ ; exit with error_code = 0 clr r0 ; error_code := 0 100$: unsave ; pop the old FAB addresses now. return ; access streams and return. .end