home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pdp11 / k11cpy.mac < prev    next >
Text File  |  2020-01-01  |  9KB  |  274 lines
  1.     .title    K11CPY    copy file from input to output
  2.     .ident    /3.42/
  3.  
  4.  
  5. ;    03-Feb-84  15:08:54  Brian Nelson
  6. ;
  7. ;    Copyright (C) 1984 Change Software, Inc.
  8. ;
  9. ; Bob Denny    05-Mar-84    Remove SY: defaulting.  Not required, and it
  10. ; [RBD01]            prevents DECnet (DAP) remote file access to
  11. ;                VMS and other systems which don't understand
  12. ;                SY:.
  13. ;
  14. ; Bob Denny    07-Mar-84    Close input file if output file open fails,
  15. ; [RBD02]            so copy may be tried again.
  16. ;
  17. ; Brian Nelson    17-Mar-84    Put back the SY: defaulting for RSTS rms11v2
  18. ;
  19. ; Brian Nelson  08-Jan-86    Cut buffer size to reduce size
  20.  
  21.  
  22.  
  23.  
  24.     .if ndf, K11INC
  25.     .ift
  26.     .include    /IN:K11MAC.MAC/
  27.     .endc
  28.  
  29.     .library    /LB:[1,1]RMSMAC.MLB/
  30.  
  31.     .mcall    fab$b    ,fab$e    ,rab$b    ,rab$e
  32.     .mcall    $compar    ,$fetch    ,$set    ,$store
  33.     .mcall    $connec    ,$disco    ,$read    ,$write
  34.     .mcall    $close    ,$creat    ,$open
  35.  
  36.     .mcall    ifaof$            ; access the ifab for the fab
  37.     ifaof$    rms$l            ; get the ifab symbols defined
  38.  
  39.  
  40.     .psect    k11cpy    ,rw,d,lcl,rel,con
  41.  
  42. ;    Allocate a large buffer for $read and $write
  43. ;    Also define the FABs and RAB for the copy.
  44.  
  45.  
  46. copbfs    =    2000            ; nice that RMS in seqeuntial mode
  47. copbuf:    .blkb    copbfs            ; will fix the next blocknumber based
  48.                     ; based on the size of the last write
  49.  
  50.  
  51.  
  52. copfb1:    fab$b
  53.     f$fac    fb$rea            ; allowed i/o operations
  54.     f$fop    fb$sup            ; supercede old versions
  55.     f$lch    1            ; channel number to use
  56.     f$rfm    fb$var
  57.     f$rat    fb$cr
  58.     fab$e
  59.  
  60. copfb2:    fab$b
  61.     f$fac    <fb$wrt!fb$rea>        ; allow block mode write's
  62.     f$fop    fb$sup            ; supercede old versions
  63.     f$lch    2            ; channel number to use
  64.     fab$e
  65.  
  66. coprb1:    rab$b                ; define record access block
  67.     r$fab    copfb1            ; associate a fab with this rab
  68.     r$rac    rb$seq            ; access sequentially
  69.     r$rbf    copbuf            ; where to return the data
  70.     r$ubf    copbuf            ; where to return the data
  71.     r$usz    512.            ; size of myrec (maximum size)
  72.     rab$e                ; end of record access block
  73.  
  74. coprb2:    rab$b                ; define record access block
  75.     r$fab    copfb2            ; associate a fab with this rab
  76.     r$rac    rb$seq            ; access sequentially
  77.     r$rbf    copbuf            ; where to return the data
  78.     r$ubf    copbuf            ; where to return the data
  79.     r$usz    512.            ; size of myrec (maximum size)
  80.     rab$e                ; end of record access block
  81.  
  82.  
  83.  
  84.  
  85.     .sbttl    copy one file to another
  86.     .psect    $code
  87.  
  88. copy::    save    <r2,r3,r4>        ; save r2-r4 please
  89.     sub    #100    ,sp        ; allocate a buffer for the
  90.     mov    sp    ,r3        ; fully parsed input filename
  91.     sub    #100    ,sp        ; allocate a buffer for the
  92.     mov    sp    ,r4        ; fully parsed output filename
  93.     calls    fparse    ,<@r5,r3>    ; simple to do
  94.     tst    r0            ; expand the input filename first
  95.     bne    100$            ; it failed, exit please
  96.     calls    fparse    ,<2(r5),r4>    ; build the output filespec next
  97.     tst    r0            ; did the parse of the name succeed?
  98.     bne    100$            ; no, exit with the RMS error
  99.     mov    #copfb1    ,r1        ; point to the input FAB
  100.     mov    #copfb2    ,r2        ; point to the output FAB
  101.     $store    r3,FNA    ,r1        ; stuff the input  filename in FAB
  102.     $store    r4,FNA    ,r2        ; stuff the output filename in FAB
  103.     strlen    r3            ; get the input filename length
  104.     $store    r0,FNS    ,r1        ; stuff it into the FAB
  105.     strlen    r4            ; get the input filename length
  106.     $store    r0,FNS    ,r2        ; stuff it into the FAB
  107.     tst    fu$def            ; do we really need a def device
  108.     beq    10$            ; no
  109.     $store    #sydska    ,DNA,r1        ; stuff defaults for the name in
  110.     $store    #sydskl    ,DNS,r1        ; FAB since we already parsed and
  111.     $store    #sydska    ,DNA,r2        ; expanded the input and output
  112.     $store    #sydskl    ,DNS,r2        ; filenames with our defaults.
  113.  
  114. 10$:    $open    r1            ; open the input file up please
  115.     $fetch    r0,STS    ,r1        ; get the error code out now
  116.     bmi    100$            ; error exit now
  117.     call    copyatr            ; yes, move file org stuff to out FAB
  118.     $create    r2            ; try to create the output file now
  119.     $fetch    r0,STS    ,r2        ; get the RMS status from the FAB
  120.     bmi    90$            ; it didn't work out, close input file
  121.     call    copyfi            ; do the file copy now
  122.     call    fixatr            ; fix the atttribute data up
  123.     $close    r2            ; Close output file        ;RBD02
  124.  
  125. 90$:    $close    r1            ; Close input file        ;RBD02
  126.  
  127. 100$:    tst    r0            ; set ret. codes to zero if > 0
  128.     bmi    110$            ; ok
  129.     clr    r0            ; say it worked
  130. 110$:    add    #100*2    ,sp        ; pop local filename buffers
  131.     mov    r4    ,r1        ; number of blocks copied
  132.     unsave    <r4,r3,r2>        ; pop local registers and exit
  133.     return
  134.  
  135.  
  136.  
  137.     .sbttl    fix the file attribute data up by looking at the IFAB
  138.  
  139. ;    input:    r1    --> FAB for the input file
  140. ;        r2    --> FAB for the output file
  141. ;
  142. ;     Since these fields all follow each other in order we could
  143. ;    of course use  .assume or assert  macros to check for their
  144. ;    order, but then if rms were altered we would be in trouble.
  145. ;    As it stands,  by doing this (looking at IFABS),  we may be
  146. ;    in trouble for future versions of RMS anyway.  It would  be
  147. ;    much  simpler if RMS  would provide a means to override the
  148. ;    eof and recordsize markers at runtime.
  149.  
  150.  
  151. fixatr:    save    <r3,r4>            ; save temps please
  152.     mov    o$ifi(r1),r3        ; point to the input file IFAB
  153.     mov    o$ifi(r2),r4        ; point to the output file IFAB
  154.     cmpb    o$rfm(r1),#fb$stm    ; stream file as input ?
  155.     bne    10$            ; no
  156.     tst    f$rsiz(r3)        ; yes, stream. Any valid recordsize?
  157.     bne    10$            ; yes, assume that the rest is valid
  158.     clrb    f$ratt(r4)
  159.     clrb    f$forg(r4)
  160.     clr    f$rsiz(r4)
  161.     clr    f$hvbn(r4)
  162.     clr    f$lvbn(r4)
  163.     clr    f$heof(r4)
  164.     clr    f$leof(r4)
  165.     clr    f$ffby(r4)
  166.     clrb    f$hdsz(r4)
  167.     clrb    f$bksz(r4)
  168.     clr    f$mrs(r4)
  169.     clr    f$deq(r4)
  170.     clr    f$rtde(r4)
  171.     br    100$
  172.  
  173. 10$:    movb    f$ratt(r3),f$ratt(r4)    ; stuff the input record attributes
  174.     movb    f$forg(r3),f$forg(r4)    ; also stuff the input file org in
  175.     mov    f$rsiz(r3),f$rsiz(r4)    ; and the input record size please
  176.     mov    f$hvbn(r3),f$hvbn(r4)    ; and the input eof markers
  177.     mov    f$lvbn(r3),f$lvbn(r4)    ; like hi and low virtual block
  178.     mov    f$heof(r3),f$heof(r4)    ; and the high and low eof block
  179.     mov    f$leof(r3),f$leof(r4)    ; numbers also
  180.     mov    f$ffby(r3),f$ffby(r4)    ; and, at last, the first free byte
  181.     movb    f$hdsz(r3),f$hdsz(r4)    ; VFC header size next
  182.     movb    f$bksz(r3),f$bksz(r4)    ; and largest bucket size
  183.     mov    f$mrs(r3) ,f$mrs(r4)    ; the maximum record size
  184.     mov    f$deq(r3) ,f$deq(r4)    ; and the default extenstion size
  185.     mov    f$rtde(r3),f$rtde(r4)    ; and the run time extentsion size
  186. 100$:    unsave    <r4,r3>            ; all done
  187.     return
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.     .sbttl    copyatr    copy the input record format to the output file's FAB
  196.  
  197. ;    We don't really  need this as it turns  out we will have to
  198. ;    do a read attributes for the input file and a write for the
  199. ;    output file anyway due to problems in marking the EOF point
  200. ;    and in copying stream ascii files in general.
  201. ;     It would have been nice to avoid all that.  We could avoid
  202. ;    it if all files had attributes (unlike RSTS)  and if we had
  203. ;    access to RMS blocks regarding EOF info.
  204.  
  205.  
  206.  
  207. copyat:    mov    o$alq+0(r1),o$alq+0(r2)    ; allocation is a double word field.
  208.     mov    o$alq+2(r1),o$alq+2(r2)    ; $fetch to r0 would clobber r1 also
  209.     $fetch    r0,BKS    ,r1        ; the macros select the proper size
  210.     $store    r0,BKS    ,r2        ; of the move at a cost in space.
  211.     $fetch    r0,DEQ    ,r1        ; done with the allocation and bucket
  212.     $store    r0,DEQ    ,r2        ; size, now stuff the extension size.
  213.     $fetch    r0,FOP    ,r1        ; o$fop(r2) := o$fop(r1)
  214.     $set    r0,FOP    ,r2        ; possibly want a contiguous file
  215.     $fetch    r0,FSZ    ,r1        ; get the VFC fixed control size
  216.     $store    r0,FSZ    ,r2        ; o$fsz(r2) := o$fsz(r1)
  217.     $fetch    r0,LRL    ,r1        ; get the longest record size
  218.     $store    r0,LRL    ,r2        ; o$lrl(r2) := o$lrl(r1)
  219.     $fetch    r0,MRS    ,r1        ; get the maximum record size
  220.     $store    r0,MRS    ,r2        ; o$mrs(r2) := o$mrs(r1)
  221.     $fetch    r0,ORG    ,r1        ; get the file organization now
  222.     $store    r0,ORG    ,r2        ; o$org(r2) := o$org(r1)
  223.     $fetch    r0,RAT    ,r1        ; get the record attributes now
  224.     $store    r0,RAT    ,r2        ; o$rat(r2) := o$rat(r1)
  225.     $fetch    r0,RFM    ,r1        ; get the record format next
  226.     $store    r0,RFM    ,r2        ; o$rfm(r2) := o$rfm(r1)
  227.     $fetch    r0,RTV    ,r1        ; get the cluster size next
  228.     $store    r0,RTV    ,r2        ; o$rtv(r2) := o$rtv(r1)
  229.     return                ; ... at last ..........
  230.  
  231.  
  232.     .sbttl    connect, copy and disconnect from the files to be copied
  233.  
  234. copyfi:    save    <r1,r2,r5>        ; save the old FAB addresses
  235.     clr    r4            ; blocks := 0
  236.     mov    #coprb1    ,r1        ; connect up first please
  237.     $connec    r1            ; connect up now
  238.     $fetch    r0,STS    ,r1        ; get the error code out
  239.     bmi    100$            ; oops
  240.     mov    #coprb2    ,r2        ; connect up first please
  241.     $connec    r2            ; connect up now
  242.     $fetch    r0,STS    ,r2        ; get the error code out
  243.     bmi    100$            ; oops
  244.  
  245. 10$:    clr    o$bkt+0(r1)        ; setup for sequential reads and writes
  246.     clr    o$bkt+2(r1)        ; two words for block numbers
  247.     clr    o$bkt+0(r2)        ; do it to both the input RAB and the
  248.     clr    o$bkt+2(r2)        ; output RAB
  249.     $store    #copbfs,USZ,r1        ; stuff the buffer size in
  250.     $store    #copbuf,UBF,r1        ; and also the buffer address please
  251.     $read    r1            ; get the next block
  252.     $fetch    r0,STS    ,r1        ; get the error code out
  253.     bmi    90$            ; oops, exit on error please
  254.     $fetch    r5,RSZ    ,r1        ; get the byte count please
  255.     $store    r5,RSZ    ,r2        ; stuff the buffer size in
  256.     $store    #copbuf    ,RBF,r2        ; and also the buffer address please
  257.     $write    r2            ; write the next block
  258.     $fetch    r0,STS    ,r2        ; get the error code out
  259.     bmi    90$            ; oops, exit on error please
  260.     ash    #-11    ,r5        ; convert byte count to blocks
  261.     add    r5    ,r4        ; blocks := blocks + bytecount/512
  262.     br    10$            ; next please
  263.  
  264. 90$:    $discon    r1            ; disconnect from input RAB
  265.     $discon    r2            ; disconnect from the output RAB
  266.     cmp    r0    ,#ER$EOF    ; normal exit is always EOF
  267.     bne    100$            ; exit with error_code = 0
  268.     clr    r0            ; error_code := 0
  269. 100$:    unsave    <r5,r2,r1>        ; pop the old FAB addresses now.
  270.     return                ; access streams and return.
  271.  
  272.  
  273.     .end
  274.