home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
kermit11.tar.gz
/
kermit11.tar
/
k11cpy.mac
< prev
next >
Wrap
Text File
|
1989-06-13
|
9KB
|
274 lines
.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 <fb$wrt!fb$rea> ; 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 <r2,r3,r4> ; 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 <r4,r3,r2> ; 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 <r3,r4> ; 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 <r4,r3> ; 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 <r1,r2,r5> ; 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 <r5,r2,r1> ; pop the old FAB addresses now.
return ; access streams and return.
.end