           CASE ON
           keep     o/shell
           mcopy    fcopy.mac
           longi    on
           longa    on

*****************************************************************************
*
*  word dCopy(GSString255Ptr target, GSString255Ptr source, word userID);
*  word rCopy(GSString255Ptr target, GSString255Ptr source, word userID);
*
* Marc W Wolfgram  5/29/91 17:32:45
*                 10/13/91  9:15:07     Added level code to preserve open
*                                       files (for Foundation specifically)
*****************************************************************************

dCopy      START

           phb
           phd
           phk
           plb                                         1 1111 11
           tsc                             12 3 456 7890 1234 56
           tcd                          DP>dp b RTL t255 s255 id

           lda      #0                  data fork
           jsr      params

           _OpenGS  openP1              open source file
           bcs      exit2

           _OpenGSh openP2              open target file
           bcs      exit1

           PushLong dEOF
           bra      common

rCopy      ENTRY

           phb
           phd
           phk
           plb                                         1 1111 11
           tsc                             12 3 456 7890 1234 56
           tcd                          DP>dp b RTL t255 s255 id

           lda      #1                  resource fork
           jsr      params

           _OpenGS  openP1              open source nile
           bcs      exit2

           _OpenGS  openP2              open target file
           bcs      exit1

           PushLong rEOF

common     jsr      fileio
           plx                          handle off
           ply
           pha                          error state and handle on
           phy
           phx
           _DisposeHandle
           _CloseGS closeP2
           pla                          error state off and on
exit1      pha
           lda      openP1+2
           sta      kloseP1+2

           _CloseGS closeP1
           pla

exit2      sta      11,s                dpbRTL----aa----
           pld                          bRTL----aa----
           pla
           sta      9,s                 TL----aabR--
           pla
           sta      9,s                 ----aabRTL
           pla
           pla                          aabRTL

           _SetLevelGS levelPB

           clc
           pla                          bRTL
           beq      exit3
           sec
exit3      plb                          RTL
           rtl

*
* Source parameter blocks...
*
openP1     dc       i2'14,0'
source     dc       i4'0',i2'1'
oFork1     dc       i2'0'
           ds       30
dEOF       dc       i4'0,0'
rEOF       dc       i4'0'

rwioP1     dc       i2'5,0'
buffer1    dc       i4'0'
request1   dc       i4'0'
transfer   dc       i4'0',i2'0'

closeP1    dc       i2'1,0'

*
* Target parameter blocks...
*
openP2     dc       i2'4,0'
target     dc       i4'0',i2'3'
oFork2     dc       i2'0'

rwioP2     dc       i2'5,0'
buffer2    dc       i4'0'
request2   dc       i4'0,0',i2'0'

eofP2      dc       i2'3,0,0',i4'0'

closeP2    dc       i2'1,0'

*
* System parameter blocks...
*
levelPB    dc       i2'1,0'

*****************************************************************************
*
* Setup file references...
*
params     sta      oFork1
           sta      oFork2

           _GetLevelGS levelPB
           inc      levelPB+2
           _SetLevelGS levelPB
           dec      levelPB+2

           lda      7
           ldx      9
           sta      target
           stx      target+2

           lda      11
           ldx      13
           sta      source
           stx      source+2

           rts

*****************************************************************************
*
* Allocate a memory buffer of optimum size and transfer the fork data...
*
fileio     lda      3,s
           sta      request1
           lda      5,s
           sta      request1+2

           pla
           sta      7                   available dp space

alloc_loop PushLong request1
           PushWord 15
           PushWord #$C008
           PushLong #0
           _NewHandle
           bcc      alloc_done          wot some...

           cmp      #$201               can't allocate memory
           bne      rwio_exit           other memory error...

           lsr      request1+2
           ror      request1
           lda      request1+2
           bne      alloc_loop

           lda      request1
           cmp      #2048               less than 2k and we have trouble!
           bge      alloc_loop

           lda      #$201

rwio_exit  ldy      7                   restore rts to stack
           phy
           rts

alloc_done lda      openP1+2
           sta      rwioP1+2

           lda      openP2+2
           sta      rwioP2+2
           sta      eofP2+2
           sta      closeP2+2

           lda      request1
           ldx      request1+2
           sta      request2
           stx      request2+2

           phd
           tsc
           tcd
           ldy      #2
           lda      [3]
           sta      buffer1
           sta      buffer2
           lda      [3],y
           sta      buffer1+2
           sta      buffer2+2
           pld

           _SetEOFGS eofP2

rwio_loop  _ReadGS  rwioP1              read a buffer full
           bcc      write_buf

           cmp      #$4c                GS/OS EOF
           bne      rwio_exit           some other failure...

           lda      transfer
           ldx    0 transfer+2
           sta      request2
           ora      transfer+2
           beq      rwio_exit

           stx      request2+2
write_buf  _WriteGS rwioP2              write a buffer full
           bcc      rwio_loop
           bra      rwio_exit

           END

*****************************************************************************
