P*********************************
*  Disk copy for Commodore 128  *
*-------------------------------*
*  A sample Merlin source file  *
*-------------------------------*
*       1571 drives only.       *
*    Double sided disks only.   *
*        80 column mode.        *
*-------------------------------*
*  RUN from BASIC low memory    *
*  location only.  ($1C00)      *
*-------------------------------*
*  This will automatically      *
*  lock the boot sector (only   *
*  if it is not already locked, *
*  & only the BAM copy option)  *
*  on the original because a V  *
*  command unlocks it, the make *
*  boot sector program fails to *
*  lock it, & similar nonsense  *
*  courtesy CBM.                *
*-------------------------------*
*   Glen E. Bredon   10/26/85   *
*********************************

          TR              ;Limit to 3 obj bytes/line
          EXP OFF         ;Do not print macro expansion

BUFPNT    = 2             ;Pointer to R/W buffer
CURBNK    = 4             ;Bank containing buffer
CURTRK    = 6             ;Current track
CURSEC    = CURTRK+1      ;Current sector
FRSTTRK   = 8             ;First track of this pass
FRSTSEC   = FRSTTRK+1     ;First sector of this pass
BITM      = $A            ; and $B, $C (track map)
RWFLAG    = $D            ;+ = Read, - = Write
ERR       = $E            ;Save for 1st err chr
FRMTFLG   = $F            ;Flags formatting done
DRIVE     = $10           ;Current device
ORIGDRV   = $11           ;Original device
DESTDRV   = $12           ;Destination device
FNAME     = $B00          ;Disk name buffer
BAMBUF    = $1300         ;BAM buffer (at start)
MAINBUF   = $2200         ;Start of sector buffers

* Kernel stuff:

TIME      = $A0           ;Jiffy clock (used for delay)
COLOR     = $F1           ;V-bit is RVS
STAVEC    = $2B9          ;Indirect store vector
BASIC     = $4003         ;Basic warm restart
DISPLY    = $C003         ;Print entry used for speed
PLOT      = $C018

PRIMM     = $FF7D         ;Print immediate
INDFET    = $FF74         ;Cross bank fetch
INDSTA    = $FF77         ;Cross bank store
SETBNK    = $FF68
ACPTR     = $FFA5
CIOUT     = $FFA8
CHKIN     = $FFC6
CHKOUT    = $FFC9
CHROUT    = $FFD2
CLOSE     = $FFC3
CLRCHN    = $FFCC
GETIN     = $FFE4
OPEN      = $FFC0
CLALL     = $FFE7
RESTOR    = $FF8A
SETLFS    = $FFBA
SETNAM    = $FFBD

MOVD      MAC
          LDA ]1
          STA ]2
          LDA ]1+1
          STA ]2+1
          <<<

GOXY      MAC
          LDY #]1
          LDX #]2
          CLC
          JSR PLOT
          <<<

*=====================================================

          ORG $1C01       ;To be RUN from BASIC at the
                          ; low address.
          DA :TWOBRK      ;BASIC link
          DA 10           ;Line number
          DFB $9E         ;SYS token
          TXT '7181'
          BRK             ;End of line
:TWOBRK   DA 0            ;Zero link = end of program
                          ; as far as BASIC knows
          ERR *-7181

START     LDA #0
          STA $FF00       ;The SYS may leave us in
          JSR RESTOR      ; wrong memory config.
          JSR CLALL
          LDX #$F8
          TXS
          LDA #%100       ;Common to 4k at bottom
          STA $D506
          LDA #1          ;Fast mode
          STA $D030
          LDA #0
          TAX
          JSR SETBNK      ;File name bank = 0
          LDA #'y'
          JSR $C01E       ;Set default tab stops
          LDA COLOR
          AND #%10111111
          STA COLOR
          JSR PRIMM
          DFB 147,14,12   ;Home, lc, defeat shift-comm
          HEX 090909
          TXT '      DISK COPY'0D0D090909
          TXT '   by: Glen Bredon'0D0D090909
          TXT '    (1571 drives)'0D0D0909
          DFB 142         ;Upper/graphic
          TXT 'ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ'
          HEX 0D0D0909
          DFB 14          ;Upper/lower
          TXT 'Specify:'0D0D0909
          TXT 'Original drive:'00
          JSR GETDRIVE
          STA ORIGDRV     ;Set original device spec
          STA DRIVE       ; and current device
          JSR PRIMM
          HEX 0D0D0909
          TXT 'Destination drive:'00
          JSR GETDRIVE
          STA DESTDRV     ;Save destination device
          JSR PRIMM
          HEX 0D0D0D0909
          TXT 'A: All blocks'0D0909
          TXT 'B: BAM blocks only'00
:KY       JSR READKEY
          SEC
          SBC #'a'
          CMP #2
          BGE :KY
          PHA             ;Save 0=all, 1=BAM
          JSR PRIMM
          DFB 147         ;Home & clear
          TXT '  Track  11111111112222222222333333'
          TXT '33334444444444555555555566666666667'0D
DIGITS    TXT '12345678901234567890123456789012345'
          TXT '67890123456789012345678901234567890'00

          JSR INSOURCE    ;Ask for source disk
          JSR OPFILES     ;Open command and # channels
          LDA #>BAMBUF
          STA BUFPNT+1
          LDA #18         ;BAM track
          STA CURTRK
          LDA #20         ;Init first sector to read
          STA FRSTSEC
          LDA #70         ; and first track
          STA FRSTTRK
          LDX #0
          STX CURBNK      ;Use bank 0 for BAM
          STX BUFPNT
          STX CURSEC      ;BAM sector
          STX RWFLAG      ;Init read
          STX FRMTFLG     ;Flag for format of copy
          JSR READSEC     ;Read BAM
          LDA BAMBUF+3    ;Check two sided disk
          BMI :OK
          JSR PRIMM       ;Reject if not 2-sided
          HEX 0D0D
          TXT 'Disk format not supported.'0D00
          JMP BASIC
:OK       LDA BAMBUF+5    ;Is boot sector locked on orig?
          LSR
          BCC :LY         ;Skip if so
          CLC
          ROL             ;Bit 0 cleared
          STA BAMBUF+5    ;Lock it just in case
          DEC BAMBUF+4    ;(Have to signal 1 sector down)
          JSR WRITESEC    ;Write BAM back to orig disk
:LY       LDY #163-144
:MN       LDA BAMBUF+144,Y
          STA FNAME,Y     ;Save file name, will overwrite
          DEY
          BPL :MN
          GOXY 58         ;23
          JSR PRNAME      ;Show it
          LDA #53
          STA CURTRK
          INC BUFPNT+1    ;Next buffer
          JSR READSEC     ;Read side 2 BAM
          PLA
          BNE :FIXBAM     ;Branch if BAM copy wanted
          LDY #-1         ;Fake all sectors used
:ZBAM     STA BAMBUF+3,Y
          STA BAMBUF+$100,Y
          DEY
          BNE :ZBAM
:FIXBAM   LDY #0          ;Move the side 2 BAM info
          LDX #0          ; so that it looks like a
:LP       TXA             ; continuation of side 1 info
          AND #%11
          BNE :OV
          INX
:OV       LDA BAMBUF+$100,Y
          STA BAMBUF+144,X
          INY
          INX
          CPY #105
          BLT :LP
          LDY #35*4       ;Mask off sectors not supported
          LDX #35-1       ; on a track
:L1       LDA MASKS,X
          ORA BAMBUF+3,Y
          STA BAMBUF+3,Y
          LDA MASKS,X
          ORA 35*4+BAMBUF+3,Y
          STA 35*4+BAMBUF+3,Y
          DEY
          DEY
          DEY
          DEY
          DEX
          BPL :L1
          PAG
*===============================
*   Main sector copy routines:
*-------------------------------

MAINLOOP  MOVD FRSTTRK    ;CURTRK
          LDA #1          ;R/W to bank 1 first
          STA CURBNK
          LDA #>MAINBUF   ;Starting buffer adrs
          STA BUFPNT+1
TRACKLUP  LDA CURTRK      ;Get bit map for CURTRK
          ASL             ;Holds CURTRK
          ASL             ;CURTRK*4
          TAX
          LDA BAMBUF+1,X  ;Get bit map, this track
          STA BITM
          LDA BAMBUF+2,X
          STA BITM+1
          LDA BAMBUF+3,X
          STA BITM+2
          BCC SECLOOP     ;If the ASL did not overflow
          LDA BAMBUF+$100+1,X
          STA BITM
          LDA BAMBUF+$100+2,X
          STA BITM+1
          LDA BAMBUF+$100+3,X
          STA BITM+2
SECLOOP   LDY CURSEC
          LDX BYTPNT,Y    ;Get byte offset for this sector
          TYA
          AND #7
          TAY
          LDA BITS,Y      ;Get the bit for this sector
          AND BITM,X      ;Is sector allocated?
          BNE :NXTSEC     ;Branch if not
          JSR RorWsec     ;Read or write sector
          JSR SHOWIT      ;Print it on screen
:IB       INC BUFPNT+1    ;Bump buffer
          LDA BUFPNT+1    ;Buffer full now?
          CMP #$C5
          BEQ :IB         ;Avoid page $C5
          CMP #$FF
          BNE :NXTSEC     ;Branch if not
          DEC CURBNK
          BMI :BUFFUL     ;Branch if so
          LDA #>MAINBUF   ;Switch to bank 0 buffers
          STA BUFPNT+1
:NXTSEC   DEC CURSEC      ;Point to next sector
          BPL SECLOOP
          LDA #20
          STA CURSEC
          DEC CURTRK
          BNE TRACKLUP    ;Loop if not done
:BUFFUL   LDA RWFLAG
          EOR #$80        ;Read <-> Write
          STA RWFLAG
          BPL NXREAD      ;Branch if now a read
          JSR INDEST      ;Insert message
GOMAIN    JSR OPFILES     ;Files were closed for
          JMP MAINLOOP    ; disk switch

*---------------------
*  Next pass routine:
*---------------------

NXREAD    LDX CURSEC
          LDY CURTRK
          DEX
          BPL :SECOK
          DEY             ;Get next track
          LDX #20         ;Set for sector 20
:SECOK    STX FRSTSEC     ;Becomes first of next sweep
          STY FRSTTRK
          DEY
          BMI EXIT        ;Branch if all finished
          JSR CLOSEFIL    ;Must close for disk swap
          JSR INSOURCE    ;Ask for source disk
          BEQ GOMAIN      ;Always taken

EXIT      JSR CLOSEFIL
          LDA COLOR
          AND #%10111111
          STA COLOR
          JSR TABMSG
          DFB 11          ;Enable comm-shift
          TXT 'Do you want another copy?'00
:ANS      JSR READKEY
          CMP #'n'
          BEQ :END
          CMP #'y'
          BNE :ANS
          JMP START       ;Rerun program

:END      JMP BASIC

*====================================
*  Drive specification input routine:
*------------------------------------

REJECT    LDA #20         ;=DEL, reject impossible device
          JSR CHROUT
GETDRIVE  JSR READKEY
          SEC
          SBC #'8'
          CMP #2
          BLT GOTDRIVE    ;Branch if drive 8 or 9
          CMP #'1'-'8'
          BNE GETDRIVE
          LDA #'1'
          JSR CHROUT
          JSR READKEY     ;Support drives > 9
          SEC
          SBC #'0'
          CMP #3
          BGE REJECT
          JSR PRDRV
          CLC
          ADC #10
          RTS

GOTDRIVE  ADC #8
PRDRV     PHA
          ORA #'0'
          JSR CHROUT
          PLA
          RTS

TABMSG    GOXY 0          ;24 ;Go to bottom left &
          JMP PRIMM       ; print following string

*===============================
*   Read or write one sector:
*-------------------------------

RorWsec   BIT RWFLAG      ;Read or Write?
          BMI WRITESEC
READSEC   LDA #'1'        ;Send U1 command to read
          JSR SNDUSER     ; current sector to disk mem
          JSR SETBP       ;Init buffer pointer
          LDX #2
          JSR CHKIN
          LDY #0
          LDA #BUFPNT
          STA STAVEC
:RLUP     JSR ACPTR       ;Move from disk memory
          LDX CURBNK
          JSR INDSTA      ; to buffer
          INY
          BNE :RLUP
JCCH      JMP CLRCHN      ;Force disk to act

WRITESEC  JSR SETBP       ;Init disk buffer pointer
          LDX #2
          JSR CHKOUT
          LDY #0
:WLUP     LDX CURBNK
          LDA #BUFPNT
          JSR INDFET      ;Get byte from buffer and
          JSR CIOUT       ; send to disk memory
          INY
          BNE :WLUP       ;Do a whole page
          LDA #'2'        ;Tell disk to write it (U2 cmd)
SNDUSER   PHA             ;Save '1' or '2'
          LDX #15
          JSR CHKOUT
          LDA #'u'        ;Send USER command
          JSR CHROUT
          PLA
          JSR CHROUT
          JSR PRIMM       ;File 2
          TXT ':2,0,'00
          LDA CURTRK      ;Track CURTRK
          JSR PRBYT
          LDA #','
          JSR CHROUT
          LDA CURSEC      ;Sector CURSEC
          JSR PRBYT
          JSR CLRCHN      ;Check for error on disk
          LDX #15
          JSR CHKIN
          JSR ACPTR       ;1st digit err #
          STA ERR         ;Save it
          JSR ACPTR       ;2nd digit
          CMP ERR         ;Same?
          BNE :ERR        ;Was error if not
          CMP #'0'        ;Both 0?
          BEQ JCCH        ;Branch if no error
:ERR      PHA             ;Save 2nd chr
          LDA COLOR
          AND #%10111111
          STA COLOR
          LDA #19         ;Home cursor
          JSR CHROUT
          JSR CLEARLIN
          LDA #$D
          JSR CHROUT
          JSR CLEARLIN    ;Clear stuff at top
          JSR PRIMM
          DFB 19          ;Home cursor
          TXT 'Disk error - Copy aborted!'0D00
          LDA ERR         ;Print 1st chr
          JSR CHROUT
          PLA             ; then 2nd
:NXCHR    JSR CHROUT
          JSR ACPTR       ;Get rest of err msg
          CMP #$D
          BNE :NXCHR
          JSR CLRCHN
          JMP EXIT        ;Exit on any error

*===============================
* Routine to show current sector
* on the 80 column screen:
*-------------------------------

SHOWIT    LDY CURTRK      ;Use CURTRK - 1 for HTAB
          DEY
          LDX CURSEC      ;CURSEC + 3 for VTAB
          INX
          INX
          INX
          CLC
          JSR PLOT
          LDY CURSEC
          LDA DIGITS+9,Y
          LDX COLOR
          JMP DISPLY
          PAG
*===============================
* Routine to set the buffer ptr:
*-------------------------------

SETBP     LDX #15
          JSR CHKOUT
          JSR PRIMM
          TXT 'b-p:2,0'00
          JMP CLRCHN

*===============================
* Routine to print a byte in A
* in decimal (assumes it < 100):
*-------------------------------

PRBYT     LDX #0
:TEN      CMP #10
          BLT :PB
          SBC #10
          INX
          BNE :TEN
:PB       PHA
          TXA
          BEQ :PULL
          JSR :PRNIB
:PULL     PLA
:PRNIB    ORA #'0'
          JMP CHROUT

*============================================
* Routine to ask for destination disk (if not
* two drives) and to format it if 1st time:
*--------------------------------------------

INDEST    JSR CLOSEFIL
          LDA DESTDRV
          CMP DRIVE       ;Two drives?
          STA DRIVE
          BNE :CHFRM      ;Branch if so
          JSR TABMSG
          TXT 'Insert destination disk'00
          JSR GETRTN
:CHFRM    LDA FRMTFLG     ;First time through?
          BNE :SETINV     ;Branch if not
          DEC FRMTFLG
          JSR TABMSG
          TXT 'Formatting disk'00
          LDA #15
          JSR DOOPN
          BCS DVCERR      ;Branch if switch gives error
          LDX #15
          JSR CHKOUT
          JSR PRIMM
          TXT 'n0:'00
          JSR PRNAME
          JSR CLRCHN      ;Make disk act on command
          JSR CLS15
          LDA TIME+1      ;Wait for a few seconds
          ADC #8          ; while formatting is going
:WT       CMP TIME+1      ; so that message is seen.
          BNE :WT
          JSR ERASE
:SETINV   LDA COLOR
          ORA #$40
          STA COLOR
          RTS

DVCERR    JMP START       ;Just abort
          RTS

*====================================================
* Routine to ask for source disk (if not two drives):
*----------------------------------------------------

INSOURCE  LDA COLOR
          AND #%10111111
          STA COLOR
          LDA ORIGDRV
          CMP DRIVE       ;Single drive?
          STA DRIVE
          BNE ERASE       ;Branch if two drives
          JSR TABMSG
          TXT 'Insert source disk in drive '00
          LDA ORIGDRV
          CMP #10
          BLT :DIG
          LDA #'1'
          JSR CHROUT
          LDA ORIGDRV
          SEC
          SBC #10
:DIG      ORA #'0'
          JSR CHROUT
GETRTN    JSR READKEY
          CMP #$D
          BNE GETRTN
ERASE     GOXY 0          ;24
CLEARLIN  LDY #38
:LUP      LDA #' '
          JSR CHROUT
          DEY
          BNE :LUP
BACK      RTS

*=======================================
* Routine to print the disk name and id:
*---------------------------------------

PRNAME    LDY #0          ;Print disk name
:SNDNAM   LDA FNAME,Y
          JSR CHROUT
          INY
          CPY #20
          BEQ BACK
          CPY #18
          BNE :SNDNAM
          LDA #','
          JSR CHROUT
          JMP :SNDNAM

*========================================
* Routines to open & close disk channels:
*----------------------------------------

CLOSEFIL  LDA #2          ;Close # file
          JSR CLOSE
CLS15     LDA #15         ;Close command file
          JMP CLOSE

OPFILES   LDA #15         ;Open command file
          JSR DOOPN
          LDA #1
          LDX #HASH
          LDY #>HASH
          JSR SETNAM
          LDA #2          ;Open # file
DOOPN     TAY
          LDX DRIVE
          JSR SETLFS
          JMP OPEN

HASH      TXT '#'

*======================================
* Routine to get a key from keyboard
* (or input device).  It first turns on
* the cursor and turns it back off when
* character has been gathered.
* Character is returned in A-register.
*--------------------------------------

READKEY   LDA #'f'        ;Enable flashing cursor
          JSR $C01E
:RDKEY    JSR GETIN       ;Get a key
          TAX             ;One available?
          BEQ :RDKEY      ;Loop if not
          PHA
          LDX #$A
          LDA #$10
          STX $D600
:WT       BIT $D600
          BPL :WT
          STA $D601       ;Cursor off
          PLA
          RTS
          PAG
*===========================
* Table of sector bit masks:
*---------------------------

MASKS    
          LUP 17
          DFB %11100000
          --^
          LUP 7
          DFB %11111000
          --^
          LUP 6
          DFB %11111100
          --^
          LUP 5
          DFB %11111110
          --^

BYTPNT    DFB 0,0,0,0,0,0,0,0
          DFB 1,1,1,1,1,1,1,1
          DFB 2,2,2,2,2,2,2,2

BITS      DFB %00000001
          DFB %00000010
          DFB %00000100
          DFB %00001000
          DFB %00010000
          DFB %00100000
          DFB %01000000
          DFB %10000000

          ERR ^MAINBUF
