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