P       
         DSK '@0:diskio'
         REL

SCREENP  = $C3

DORG     EXT
CODELEN  EXT
CODEFLAG EXT
TEXT     EXT
TEXTEND  EXT

*
* Updates for El Cheapo: added object code stuff,
* modified directory routine, removed unnecessary
* routines.
*
* SLJ 12/98
*

*
* Disk routines.  This is a common disk access routine
* for the music composer.  A string address is passed in
* in (.X,.A) = (lo,hi) which is PRINTed to the screen
* (presumably it includes a screen clear!).  The
* appropriate load and save addresses must be set up
* ahead of time as well.  The program then prints a
* short menu and handles any disk accesses.
*
* New addition: a 2-byte identifier must also be
* specified.  If greater than $FF00 the byte check is
* skipped, otherwise these two-bytes are compared with
* the first two data bytes in the file, and if they
* do not match an incorrect file type is assumed.
*

READST   = $FFB7
SETLFS   = $FFBA
SETNAM   = $FFBD
OPEN     = $FFC0
CLOSE    = $FFC3
CHKIN    = $FFC6
CHKOUT   = $FFC9
CLRCHN   = $FFCC
CHRIN    = $FFCF
CHROUT   = $FFD2
LOAD     = $FFD5
SAVE     = $FFD8
STOP     = $FFE1
GETIN    = $FFE4
CLALL    = $FFE7

FAQ2     = $69
ACC      = FAQ2
AUX      = ACC+2
EXT      = AUX+2
BLNSW    = $CC
BLNON    = $CF
BLNCT    = $CD

LASTFILE ENT
         DS 18,0          ;Last filename
LASTLEN  DFB 00

LOADID   ENT
         DA 00            ;2-byte identifier
LOADADDR ENT
         DA 00            ;Load target address
SAVESTRT ENT
         DA 00            ;Beginning of block to save
SAVEEND  ENT
         DA 00            ;End of block to save
SAVEFLAG ENT
         DFB 00           ;Save disable
NEWDATA  ENT
         DFB 00           ;Was new data loaded?

STRADDR  DA 00

DISKIO   ENT
                          ; STX STRADDR
                          ; STA STRADDR+1
         LDA #00
         STA NEWDATA
         LDA #$C0
         STA $9D          ;Kernal messages on

MAIN     
         DO 0
         LDX STRADDR
         LDA STRADDR+1
         JSR PRINT
         FIN
         JSR STROUT
         DFB 147
                          ; DFB 159 ;Cyan
         DFB 14           ;lowercase
         DFB 13,13,13
         DFB 32,32
         TXT 'l - Load source'
         DFB 13,32,32
         TXT 's - Save source'
         DFB 13,32,32
         TXT 'o - Save object code'
         DFB 13,32,32
         TXT 'd - Directory'
         DFB 13,32,32
         TXT '@ - Send disk command'
         DFB 13,32,32
         TXT 'c - Change drive no.'
         DFB 13,32,32
         TXT 'x - Exit'
         DFB 13,32,32
         TXT 'Current drive: '
                          ; DFB 158 ;Yellow
         DFB 00

         LDA $BA
         CMP #10
         BCC :PRINT
         LDA #'1'
         JSR CHROUT
         LDA $BA
         SEC
         SBC #10
:PRINT   ORA #48
         JSR CHROUT

         DO 0
         JSR STROUT
         DFB 13,32,32
         TXT 'Current file : '
         DFB 00

         LDX #<LASTFILE
         LDA #>LASTFILE
         JSR PRINT
         FIN

:PROMPT  JSR STROUT
         DFB 13,13,32
         TXT '>'
         DFB 00

:WAIT    JSR STOP         ;Dir may have been stopped
         BEQ :WAIT
:WAIT2   JSR GETIN
         BEQ :WAIT2

         CMP #'l'
         BEQ :LOAD
         CMP #'s'
         BEQ :SAVE
         CMP #'o'
         BEQ :OBJ
         CMP #'d'
         BEQ :DIR
         CMP #'@'
         BEQ :CMD
         CMP #'c'
         BEQ :CHDR
         CMP #'x'
         BEQ :EXIT
         JMP MAIN

:EXIT    RTS
:LOAD    JSR LOADFILE
         BCS :WAITJMP
         RTS
:SAVE    JSR SAVEFILE
         JMP :WAITJMP
:OBJ     JSR SAVEOBJ
         JMP :WAITJMP
:DIR     JSR PRINTDIR
         JMP :PROMPT
:CMD     JSR SENDCMD
         JSR GETERR
:WAITJMP JSR WAITKEY
         JMP MAIN
:CHDR    
         LDA #13
         JSR CHROUT
         LDA #'#'
         JSR CHROUT
         JSR GETBYTE
         BEQ :DONE
         CMP #20
         BCS :DONE
         STA $BA
:DONE    JMP MAIN

GETBYTE  
         LDX #3
         JSR INPUT
         BEQ :RTS
         LDX #>STRBUF
         LDA #<STRBUF
         LDY #10
         JSR ASCTONUM
         BCS :RTS
         LDA ACC
:RTS     RTS

WAITKEY  ENT
         JSR STROUT
         DFB 13,13
         TXT 'Press a key to continue...',00

         LDA $0286        ;Set blink color to
         STA $0287        ;current color.

         LDA #1
         STA BLNCT
         LDA #00
         STA BLNSW        ;Blink
:W       LDA BLNON
         BNE :W           ;Wait for one blink
:WAIT    JSR GETIN
         BEQ :WAIT
         LDY #1
         STY BLNCT
:WAIT2   LDY BLNON
         BEQ :WAIT2
         INC BLNSW
         RTS

*
* Disk routines
*
* PRINTDIR reads the directory from the current device
* and prints it to the screen.
*
PRINTDIR 
         LDA #01          ;File no.
         LDX $BA          ;Current device number
         LDY #00          ;Secondary address
         JSR SETLFS
         LDA #1
         LDX #<:DOLLAR
         LDY #>:DOLLAR
         JSR SETNAM
         JSR OPEN
         LDX #01
         JSR CHKIN
         BCS :END         ;Error if carry set

         JSR CHRIN        ;Grab load address
         JSR CHRIN
:LOOP1   LDA #13
         JSR CHROUT
         JSR CHRIN        ;Line link
         JSR CHRIN
         JSR CHRIN        ;Line number (file size)
         TAY
         JSR CHRIN
         TAX
         JSR READST
         BNE :END
         TYA
         LDY #10          ;Base
         JSR PRINTNUM     ;Print out the number in X,Y
         LDA #32
         JSR CHROUT       ;Add a space to look nice
:LOOP2   JSR CHRIN
         TAX
         BEQ :STOP
         JSR CHROUT
         BNE :LOOP2
:STOP    JSR STOP
         BNE :LOOP1
:END     LDA #01
         JSR CLOSE
         JSR CLRCHN
         LDA #13
         JMP CHROUT
:DOLLAR  TXT '$'

*
* SAVEFILE, whose purpose is awfully self-evident.
*
SAVEFILE 
*-------------------------------
         DO 0
         LDA SAVEFLAG
         BNE :NOSAVE
         LDY #00
:LOOP    LDA :TEXT,Y
         BEQ :CONT
         JSR CHROUT
         INY
         BNE :LOOP
:CONT    
         LDX #16          ;Number of chars max
         JSR INPUT
         BEQ :ABORT       ;Zero set means aborted input
                          ;Otherwise A and Y contain # of
                          ;chars entered
         FIN
*-------------------------------

         LDA #'s'
         STA FILEXT
         JSR GETNAME
         BEQ :ABORT       ;Zero set means aborted input

         LDA TEXT         ;Save starts at $0800
         STA FAQ2
         LDA TEXT+1
         STA FAQ2+1
         LDX TEXTEND
         LDY TEXTEND+1
         LDA #FAQ2
         JSR SAVE
         BCS :ERROR
         JMP SAVEOK

         DO 0
:NOSAVE  LDY #00
:L3      LDA :TEXT3,Y
         BEQ :END
         JSR CHROUT
         INY
         BNE :L3
         FIN

:ABORT   LDY #00
:LOOP2   LDA :TEXT2,Y
         BEQ :END
         JSR CHROUT
         INY
         BNE :LOOP2

:ERROR   LDY #00
:L1      LDA :ERTEXT,Y
         BEQ :END
         JSR CHROUT
         INY
         BNE :L1
:END     JSR GETERR
         SEC
         RTS

:ERTEXT  DFB 13
         TXT '*** save error ***'
:TEXT2   DFB 13
         TXT 'save aborted'
         DFB 13,00

*-------------------------------
         DO 0
:TEXT    DFB 13
         TXT 'save file:'
         HEX 00
:TEXT3   DFB 13
         TXT 'old versions are load only'
         DFB 13,00
         FIN
*-------------------------------

SAVEOK   
         JSR CLRCHN
         LDY $B7          ;Copy filename to LASTFILE
         DEY
         DEY              ;Remove extension
         LDA #00
:L4      STA LASTFILE,Y
         DEY
         LDA ($BB),Y
         CPY #00
         BPL :L4
         LDA #13
         JSR CHROUT
         CLC
         RTS

*
* LOADFILE - remarkably similar to SAVEFILE
*
LOADFILE 
         LDA #'s'
         STA FILEXT
         JSR GETNAME
         BEQ :ABORT       ;Zero set means aborted input

*-------------------------------
         DO 0
         LDA LOADID+1     ;ID check
         CMP #$FF
         BEQ :SKIP
         JSR OPEN
         BCS :ERROR
         LDX #$08
         JSR CHKIN

         JSR CHRIN        ;Load address
         JSR CHRIN
         JSR CHRIN
         CMP LOADID
         BNE :IDERR
         JSR CHRIN
         CMP LOADID+1
         BNE :IDERR
         LDA #8
         JSR CLOSE
:SKIP    
         LDA #08          ;File no.
         LDX $BA          ;Current device number
         LDY #00          ;Secondary address
         JSR SETLFS
         FIN
*-------------------------------

         LDA #0
         LDX TEXT
         LDY TEXT+1
         JSR LOAD
         BCS LOADERR
         INC NEWDATA
         JMP SAVEOK

:ABORT   LDY #00
:LOOP3   LDA LTEXT2,Y
         BEQ LEND
         JSR CHROUT
         INY
         BNE :LOOP3
LEND     JSR GETERR
         SEC
         RTS

LOADERR  
:ERROR   JSR CLALL
         JSR CLRCHN
         LDY #00
:LOOP2   LDA :ERTEXT,Y
         BEQ LEND
         JSR CHROUT
         INY
         BNE :LOOP2
         BEQ LEND

         DO 0
:IDERR   JSR CLALL
         JSR CLRCHN
         LDY #00
:L2      LDA :TEXT3,Y
         BEQ :END
         JSR CHROUT
         INY
         BNE :L2
         FIN


:ERTEXT  DFB 13
         TXT '*** load error ***'
LTEXT2   DFB 13
         TXT 'load aborted.'
         DFB 13,00

         DO 0
:TEXT3   DFB 13
         TXT 'incorrect file type.'
         DFB 13,00

:TEXT    DFB 13           ;Return
         TXT 'load file:'
         HEX 00
         FIN

*
* Save object file
*
SAVEOBJ  
         LDA CODEFLAG
         BEQ :EXIT
         LDA #'o'
         STA FILEXT
         JSR GETNAME
         BEQ :EXIT        ;Zero set means aborted input

         LDA #$00         ;Data at $010800
         STA FAQ2
         LDA #$08
         STA FAQ2+1
         LDA #1
         STA FAQ2+2

         LDA #$02
         STA $B9          ;Secondary address
         JSR OPEN
         BCS LOADERR
         LDX #$08
         JSR CHKOUT

         LDA DORG         ;Load address
         JSR CHROUT
         LDA DORG+1
         JSR CHROUT

         LDY CODELEN
         LDX CODELEN+1
         INX
:LOOP    DFB $A7          ;LDA []
         DFB FAQ2
         JSR CHROUT
         INC FAQ2
         BNE :C1
         INC FAQ2+1
:C1      DEY
         BNE :LOOP
         DEX
         BNE :LOOP

         LDA #8
         JSR CLOSE
         JSR CLRCHN

:EXIT    RTS

* Get file name and set file parameters

FILEXT   DFB 's'          ;Filename extension

GETNAME  
         JSR STROUT
         TXT 'Filename:',00

         LDX #00          ;Use default filename
:L2      LDA LASTFILE,X
         STA STRBUF,X
         BEQ :C1
         JSR CHROUT
         INX
         CPX LASTLEN
         BCC :L2
:C1      TXA

         LDX #14          ;Number of chars max
         JSR INPUT2       ;.A contains length
         BEQ :RTS
         STA LASTLEN
         TAX
         LDA #'.'
         STA STRBUF,X
         INX
         LDA FILEXT
         STA STRBUF,X
         INX
         CMP #'o'
         BNE :NOBJ
         LDY #00
:L1      LDA :OBJ,Y
         STA STRBUF,X
         INX
         INY
         CPY #4
         BNE :L1
:NOBJ    TXA
         LDX #<STRBUF     ;See INPUT for more info
         LDY #>STRBUF
         JSR SETNAM
         LDA #08          ;File no.
         LDX $BA          ;Current device number
         LDY #00          ;Secondary address
         JSR SETLFS
         LDA #$01         ;Clear Z
:RTS     RTS
:OBJ     TXT ',p,w'

*
* SENDCMD sends a command to the current drive
*
SENDCMD  
         DO 0
         LDA #13
         JSR CHROUT
         LDA #'>'
         JSR CHROUT
         FIN

         LDX #36
         JSR INPUT
         BEQ :ERROR

         LDA #$0F
         LDX $BA
         LDY #$0F
         JSR SETLFS
         LDA #00
         JSR SETNAM
         JSR OPEN
         BCS :ERROR
         LDX #$0F
         JSR CHKOUT
         LDY #00
:LOOP    LDA STRBUF,Y
         BEQ :ERROR
         JSR CHROUT
         INY
         BNE :LOOP

:ERROR   JSR CLRCHN
         LDA #$0F
         JSR CLOSE
         JMP CLRCHN

*
* GETERR prints the error message from the current disk drive.
*
GETERR   ENT
         LDA #13
         JSR CHROUT
*
* This method is a bit faster on output to screen.
*
         JSR OPENERR
         BCS GETEXIT
GETERR2  ENT
:LOOP    JSR CHRIN
         CMP #$0D
         BEQ GETEXIT
         JSR CHROUT
         BNE :LOOP
GETEXIT  JSR CHROUT
         JSR CHROUT       ;One more to look nice
         LDA #15
         JSR CLOSE
         JMP CLRCHN

OPENERR  ENT
         LDA #$C0         ;Kernal msg on
         STA $90

         LDA #$0F
         LDX $BA
         LDY #$0F
         JSR SETLFS
         LDA #00
         JSR SETNAM
         JSR OPEN
         LDA #00
         STA $90
         BCS :ERROR
         LDX #$0F
         JMP CHKIN        ;Carry clear -> OK
:ERROR   LDA #13
         SEC
         RTS

* This method seems a little slower
         DO 0             ;Don't assemble
         LDA $BA
         JSR TALK         ;Command device to talk
         LDA #$6F         ;Channel 15
         STA SA           ;Current secondary address
         JSR TKSA
         LDA #$0D         ;Set for initial CR
:LOOP    JSR CHROUT
         JSR ACPTR
         CMP #$0D
         BNE :LOOP
         JSR CHROUT       ;Do CR
         JMP UNTLK        ;... and exit
         FIN

*
* INPUT inputs a string of data into STRBUF.  The maximum
* number of chars to be read are passed in X.  On output,
* zero set means the input was aborted with R/S or is
* empty.  .A (and STRLEN) contains the string length.
*
STRBUF   EQU $0200
STRLEN   ENT
         DFB 00
MAXLEN   DFB 00

INPUT    ENT
         LDA #00
         STA STRBUF
INPUT2   STA STRLEN
         STX MAXLEN
         LDA $0286        ;Set blink color to
         STA $0287        ;current color.

:LOOP    LDA #1
         STA BLNCT
         LDA #00
         STA BLNSW        ;Blink
:W       LDA BLNON
         BNE :W           ;Wait for one blink

:WAIT    JSR GETIN
         BNE :BLOFF
         JSR STOP
         BNE :WAIT
         LDA #00
:BLOFF   LDY #1
         STY BLNCT
:WAIT2   LDY BLNON
         BEQ :WAIT2
         INC BLNSW

         TAY
         BEQ :RTS
         CMP #160         ;Alphanumeric characters
         BCS :NORMAL
         CMP #128
         BCS :LOOP
         CMP #13
         BEQ :DONE
         CMP #20
         BEQ :DEL
         CMP #32
         BCC :LOOP
:NORMAL  
         LDY STRLEN
         CPY MAXLEN
         BCS :LOOP
         STA STRBUF,Y
         JSR CHROUT
         INC STRLEN
         BNE :LOOP

:DEL     LDY STRLEN
         BEQ :LOOP
         JSR CHROUT
         DEC STRLEN
         BPL :LOOP

:DONE    LDY STRLEN
         LDA #00
         STA STRBUF,Y
         TYA              ;Z set if string empty
:RTS     RTS

*-------------------------------
*
* My own little kernal routines -- useful utility
* routines.
*
* KERPLOP
* PLOPXY
* PLOP -- Fast screen (text) plotting routines
* CHAROUT -- PLOPs a character to the screen
* REVON/REVOFF -- Turns on/off rvs-chars with CHAROUT
* PRINT -- Prints a string using CHROUT
* STROUT -- Prints a string immediately following call
* PRINPLOP -- Like PRINT but uses PLOP
* PLOPSTR -- PLOPs a string immediately following call
* MULT16 -- 16-bit integer multiply routine
* DIV16 -- 16-bit divide
* ASCTONUM -- Convert string to 16-bit number
* PRINTNUM -- Print 16-bit number using CHROUT
* PLOPNUM -- PLOPs 16-bit number to screen
* PHBYTE -- PLOP two digit hex byte
* BLMOVE -- Block memory move
*

*
* PLOP
*   Stores the value in A to the screen at the point
*   (ROW,COLUMN) and the color in COLOR to the
*   colormap.  If entered at PLOPXY, ROW is set to X and
*   column is set to Y.  If entered at KERPLOP, char
*   is stored to the kerrent screen pointer.
*   On exit, A X and Y are preserved; carry set indicates
*   an error, i.e. row/col out of range.
*
ROW      ENT
         DFB 0            ;Current row,column
COLUMN   ENT
         DFB 0
COLOR    ENT
         DFB 0

PLOPXY   ENT              ;Set Y=column, X=row
         CPX #25
         BCS PLOPRTS
         CPY #40
         BCS PLOPRTS
         STY COLUMN
         STX ROW
PLOP     ENT
         PHA
         LDA ROW          ;We need 40*ROW
         ASL
         ASL
         ADC ROW          ;5*ROW
         STA SCREENP
         LDA #00          ;A=high byte
         ASL SCREENP      ;Mult by 8
         ROL
         ASL SCREENP
         ROL
         ASL SCREENP
         ROL
         ADC #$04         ;Add 1024
         STA SCREENP+1    ;SCREENP now points to screen
         PLA
PLOPRTS  RTS
KTEMP    DS 1

STAXY    ENT
         JSR PLOPXY       ;plop to X,Y
KERPLOP  ENT              ;PLOP to kerrent screen loc.
         STY KTEMP
         LDY COLUMN
         STA (SCREENP),Y
         PHA
         LDA SCREENP+1
         PHA
         AND #$03
         CLC
         ADC #$D8         ;Color mem at $D800
         STA SCREENP+1
         LDA COLOR
         STA (SCREENP),Y
         PLA              ;Restore SCREENP to point to screen
         STA SCREENP+1
         CLC              ;Signal all is well.
         PLA              ;restore A
         LDY KTEMP
         RTS

*
* CHAROUT
*   Sticks a CHR$ character to the screen at the current
*   row,column and advances the column.
*   All registers are preserved.
*
CHAROUT  ENT
         EOR #$E0         ;Convert to screen char
         CLC
         ADC #32
         BPL :CONT
         ADC #64
         BPL :CONT
         EOR #$A0
:CONT    EOR REVERSE
         JSR KERPLOP
         INC COLUMN
         RTS

*
* REVON/REVOFF
*   Turns on/off reverse-character printing with CHAROUT
*
REVERSE  DFB 00

REVON    ENT
         PHA
         LDA #$80
         STA REVERSE
         PLA
         RTS

REVOFF   ENT
         PHA
         LDA #00
         STA REVERSE
         PLA
         RTS

*
* PRINT
*   As the name suggests, this prints a string to the
*   screen, where the address of the string is
*   contained in (.X,.A) = (lo,hi).  The string is
*   assumed to be null-terminated.
*
*   On exit, the location of the last character read
*   (the null-terminator hopefully) is returned in
*   (.X,.A) = (lo,hi).  Y is preserved.
*
PRINT    ENT
         STA :LOOP+2
:LOOP    LDA $A000,X
         BEQ :DONE
         JSR CHROUT
         INX
         BNE :LOOP
         INC :LOOP+2
         BNE :LOOP
:DONE    
         LDA :LOOP+2
         RTS

*
* STROUT
*   Like PRINT, but the string immediately follows the
*   subroutine call; execution resumes right after the
*   null-termination byte.
*
*   On exit, A and X are thoroughly hosed.
*
STROUT   ENT
         PLA
         TAX              ;Lo byte
         PLA
         INX
         BNE :CONT
         CLC
         ADC #01
:CONT    JSR PRINT
         PHA              ;hi byte
         TXA
         PHA              ;lo byte
         RTS

*
* Like PRINT, but uses PLOP.
*
PRINPLOP ENT
         STA :LOOP+2
:LOOP    LDA $A000,X
         BEQ :DONE
         JSR CHAROUT
         INX
         BNE :LOOP
         INC :LOOP+2
         BNE :LOOP
:DONE    
         LDA :LOOP+2
         RTS
*
* PLOPSTR
*   Like STROUT, but uses PLOP
*
TEMPA    DFB 00
TEMPX    DFB 00
PLOPSTR  ENT
         STA TEMPA
         STX TEMPX
         PLA
         TAX              ;Lo byte
         PLA
         INX
         BNE :CONT
         CLC
         ADC #01
:CONT    JSR PRINPLOP
         PHA              ;hi byte
         TXA
         PHA              ;lo byte
         LDX TEMPX
         LDA TEMPA
         RTS

*-------------------------------------
* 16 bit multiply and divide routines.
* Three 16 bit (two-byte) locations
* ACC, AUX and EXT must be set up,
* preferably on zero page.
*-------------------------------------

* MULTIPLY ROUTINE

* ACC*AUX -> [ACC,EXT] (low,hi) 32 bit result

MULT16   ENT
         LDA #0
         STA EXT+1
         LDY #$11
]LOOP    LSR EXT+1
         ROR
         ROR ACC+1
         ROR ACC
         BCC MUL2
         CLC
         ADC AUX
         PHA
         LDA AUX+1
         ADC EXT+1
         STA EXT+1
         PLA
MUL2     DEY
         BNE ]LOOP
         STA EXT
         RTS

* DIVIDE ROUTINE

* ACC/AUX -> ACC, remainder in EXT

DIV16    ENT
         LDA #0
         STA EXT+1
         LDY #$10
]LOOP    ASL ACC
         ROL ACC+1
         ROL
         ROL EXT+1
         PHA
         CMP AUX
         LDA EXT+1
         SBC AUX+1
         BCC DIV2
         STA EXT+1
         PLA
         SBC AUX
         PHA
         INC ACC
DIV2     PLA
         DEY
         BNE ]LOOP
         STA EXT
         RTS

*
* ASCTONUM
*   Converts a string to a 16-bit number.  The address
*   of the string is passed in in (A,X) = (lo,hi), and
*   the base of the number is contained in Y.  Valid
*   bases are 0-16.  The string is assumed to be
*   null-terminated.
*
*   On exit, carry set denotes an error, either an
*   invalid base, an invalid string, or a number
*   overflow.  The number is contained in ACC, as
*   used in MULT16.  The last char read is contained
*   in (A,X)=(lo,hi).  Y is toast.
*
ASCTONUM ENT
         CPY #17
         BCS :EXIT
         STY AUX          ;AUX=number base
         LDY #00
         STY AUX+1
         STY ACC
         STY ACC+1
         STX :LOOP+2
         TAX              ;X=lo byte string

:LOOP    LDA $A000,X      ;Valid chars are $30-$39, $41-$46
         BEQ :EXIT
         EOR #$30
         CMP #10
         BCC :CONT
         EOR #$70         ;Should use SBC #$70-9
         ADC #8           ;Now A-F = 10-16
:CONT    CMP AUX          ;Compare with number base
         BCS :EXIT
         PHA
         JSR MULT16       ;Multiply number times base
         PLA
         LDY EXT          ;Did multiplication exceed 16 bits?
         BNE :ERROR
         CLC
         ADC ACC
         STA ACC
         LDA ACC+1
         ADC #00
         STA ACC+1
         INX
         BNE :LOOP
         INC :LOOP+2
         BNE :LOOP
:ERROR   SEC
:EXIT    TXA
         LDX :LOOP+2
         RTS

*
* PRINTNUM
*   Prints the 16-bit number in (A,X) = (lo,hi)
*   to the screen, i.e. prints using CHROUT.
*   The number base is contained in Y.
*
PRINTNUM ENT
         STA ACC
         STX ACC+1
         STY AUX          ;Base
         LDX #00
         STX AUX+1
* ACC/AUX -> ACC, remainder in EXT
:LOOP    JSR DIV16
         INX
         LDA EXT
         PHA
         LDA ACC
         ORA ACC+1
         BNE :LOOP        ;Divide until result=0
:POOP    PLA
         ORA #$30         ;Convert to chr$
         CMP #$3A
         BCC :PLOP
         ADC #$06         ;$3A->A $3B->B etc.
:PLOP    JSR CHROUT
         DEX
         BNE :POOP
         RTS

*
* PLOPNUM
*   Plops the 16-bit number in (A,X) = (lo,hi)
*   to the screen, i.e. prints using PLOP routine.
*   The number base is contained in Y.
*
PLOPNUM  ENT
         STA ACC
         STX ACC+1
         STY AUX          ;Base
         LDX #00
         STX AUX+1
* ACC/AUX -> ACC, remainder in EXT
:LOOP    JSR DIV16
         INX
         LDA EXT
         PHA
         LDA ACC
         ORA ACC+1
         BNE :LOOP        ;Divide until result=0
:POOP    PLA
         ORA #$30         ;Convert to chr$
         CMP #$3A
         BCC :PLOP
         ADC #$06         ;$3A->A $3B->B etc.
:PLOP    JSR CHAROUT
         DEX
         BNE :POOP
         RTS

*
* PHBYTE
*   Print a hex byte in .A, including trailing zeros
*
PHBYTE   ENT
         PHA
         LSR
         LSR
         LSR
         LSR
         JSR :PRINT
         PLA
         AND #$0F
:PRINT   ORA #$30
         CMP #$3A
         BCC :PLOP
         ADC #$06
:PLOP    JMP CHAROUT


*
* BLMOVE
*   Moves a block of memory to another location.
*   Set BLSTART to the beginning of the block of
*   memory, BLEND to the last byte of the block,
*   and BLDEST to the destination byte (2-bytes
*   each, in lo,hi format).
*
*   The routine is smart, and can tell the difference
*   between forwards and backwards moves, etc.
*
*   AUX and EXT are used, from mult routine.
*
BLSTART  ENT
         DA 0
BLEND    ENT
         DA 0
BLDEST   ENT
         DA 0

BLMOVE   ENT
         LDA BLEND        ;Number of bytes to move
         SEC
         SBC BLSTART
         TAX
         LDA BLEND+1
         SBC BLSTART+1
         BCC :DONE
         STA AUX          ;(.X,AUX) = (LO,HI)

         LDA BLSTART
         SEC
         SBC BLDEST
         LDA BLSTART+1
         SBC BLDEST+1
         BCC :FORWARD

         LDA BLSTART
         STA :BSRC+1
         LDA BLSTART+1
         STA :BSRC+2
         LDA BLDEST
         STA :BDEST+1
         LDA BLDEST+1
         STA :BDEST+2
         INC AUX
         INX
         LDY #00
:LOOP    
:BSRC    LDA $1000,Y
:BDEST   STA $1000,Y
         INY
         BNE :C1
         INC :BSRC+2
         INC :BDEST+2
:C1      DEX
         BNE :LOOP
         DEC AUX
         BNE :LOOP
:DONE    RTS

:FORWARD                  ;Move block forwards
         TXA
         ADC BLDEST       ;Copy to end of blocks
         STA :FDEST+1
         LDA AUX
         ADC BLDEST+1
         STA :FDEST+2
         LDA BLEND
         STA :FSRC+1
         LDA BLEND+1
         STA :FSRC+2
         INC AUX
         INX
         LDY #00
:FLOOP   
:FSRC    LDA $1000,Y
:FDEST   STA $1000,Y
         DEY
         CPY #$FF
         BNE :C2
         DEC :FSRC+2
         DEC :FDEST+2
:C2      DEX
         BNE :FLOOP
         DEC AUX
         BNE :FLOOP
         RTS
e.
