*      
* JamaicaMON
*
* Original supermon source code courtesy Jim Butterfield
*
* Merlinized and adapted for the SuperCPU by
* Stephen L. Judd
* 12/7/97 (1/98)
*
* v1.0 1/31/98
* v2.0 10/28/98
* v2.1 9/9/99
*
* This program is public domain.
*

* Direct page variables

tmpc     = $22
nemo     = $23
length   = $24
wrap     = $25
acmd     = $26
aflg     = $27            ;3 bytes
satus    = $90
lvflag   = $93
indev    = $99
outdev   = $9a
eal      = $ae
eah      = $af
fnlen    = $b7
wtype    = $b9
fa       = $ba
fnadr    = $bb
psav     = $57
tmp2     = $5a
tmp0     = $5d
savx     = $60
inbuf    = $0100
scpu     = $0208          ;scpu stuff
stage    = $0210
reptemp  = $022d          ;REP/SEP instruction
repval   = $022e          ;and value
ohone    = $022f
pbr      = $0230
pcl      = $0231
pch      = $0232
acc      = $0233
xr       = $0235
yr       = $0237
sp       = $0239
dp       = $023b
dbr      = $023d
flgs     = $023e
emul     = $023f          ;high bit = e
addrs    = $0240          ;load/save string
lastmem  = $0257
bkvec    = $0316
ldvec    = $0330
svvec    = $0332
ready    = $a002
setmsg   = $ff90
rdt      = $ffcf
wrt      = $ffd2
stop1    = $ffe1
kload    = $ffd5
ksave    = $ffd8

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

ACC      = $5A            ;tmp2
AUX      = ACC+2
EXT      = AUX+2          ;tmp0
STRBUF   = addrs


                          ; ** initialization **
super    clc
         >>> xce          ;native mode
         >>> rep,$30      ;everyone 16-bits
         >>> per,vbreak
         sei
         pla
         sta bkvec
         >>> per,break
         pla
         >>> sta1,$fc9d   ;NBRK
         >>> sta1,$7c9d
         lda #00
         dfb 00
         dfb $5b          ;DP -> zero-page
         >>> sep,$30      ;everyone 8-bits
         >>> sta1,$fc9f   ;bank 0
         >>> sta1,$7c9f
         cli
         lda #$80
         jsr setmsg
         brk

*-------------------------------
* Debugging routines
         do 0
debug1   lda #00
         sta $d020
         rts

debug2   inc $d020
:wait    jsr $ffe4
         beq :wait
         rts
         fin

* txt 'ah, moon of my delight that knows no wane'

vbreak                    ; ** vector break entry **
         >>> ply
         >>> plx
         pla
                          ; ** break entry **
break    
         cli
         clc
         >>> xce
         >>> rep,$30
         >>> phd
         pha
         lda #00
         dfb 00
         >>> tcd          ;direct reg=$0000
         sty yr
         stx xr
         pla
         sta acc
         pla
         sta dp
         >>> sep,$30      ;everyone 8-bits
         ror emul         ;high bit = e
         hex af010000     ;LDA $000001
         sta ohone
         ora #$02
         hex 8f010000

         lda $d0b2        ;SuperCPU status reg
         sta scpu
         lda $d0bc        ;RAMLink status
         sta $d073        ;sys speed to turbo
         sta scpu+1
         and #%01000000
         beq :skip
         sta $df20        ;rl wrt-prot off
         sta $df7f        ;rl hw reg out
:skip    sta $d0bf        ;dos ext ,pde pff
         sta $d07f        ;scpu hw out

         >>> phb
         pla
         sta dbr
         pla
         sta flgs
         >>> rep,$30
         pla
         sec
         hex e90200       ;SBC #0002
         sta pcl
         >>> sep,$30
         lda #00
         ldx emul
         bmi :emul
         pla
:emul    sta pbr
         >>> tsc
         sta sp
         >>> xba
         sta sp+1
         lda pcl
         cmp brkaddr
         bne :notbrk
         lda pch
         sbc brkaddr+1
         bne :notbrk
         lda pbr
         sbc brkaddr+2
         bne :notbrk
         jsr getp2
         lda brkinst
         dfb $87,tmp0     ;STA [TMP0]
         lda #$ff
         sta brkaddr
         sta brkaddr+1
         sta brkaddr+2
:notbrk  jsr crlf
         ldx #$42
         lda #$2a
         jsr wrtwo
         lda #$52
         bne s0
                          ; ** print addresses **
whereami ldy #'n'
         jsr altrit
         jsr space
         >>> per,super
         >>> plx
         pla
         jsr wrax
         >>> per,endcode
         >>> plx
         pla
         jsr wrax
         >>> per,endvars
         >>> plx
         pla
         jsr wrax
         jmp strt
                          ; ** write 16-bits in X,A **
wrax     stx tmpc
         jsr wrob
         lda tmpc
         jsr wrob
         jmp space
                          ; ** increment temp pointer **
inctmp   inc tmp0
         bne setwr
         inc tmp0+1
         bne setwr
         inc wrap
setwr    rts
                          ; ** read character **
rdoc     jsr rdt
         cmp #$0d
         bne setwr
         pla
         pla
                          ; ** prompt for command  **
strt     lda #0
         sta wrap
         ldx #$0d
         lda #$2e
         jsr wrtwo
                          ; ** check input command **
st1      jsr rdoc
         cmp #$2e
         beq st1
         cmp #$20
         beq st1
s0       ldx #$1a
s1       cmp keyw,x
         bne s2
         txa
         asl
         tax
         >>> per,super
         >>> rep,$20
         pla
         clc
         adc kaddr,x
         pha
         >>> sep,$30
         rts
s2       dex
         bpl s1
         jmp error
                          ; ** help!  i need somebody **
help     jsr crlf
         ldx #00
:loop    lda keyw,x
         beq strt
         jsr wrt
         inx
         bne :loop
                          ; ** Toggle REP/SEP flag **
repsep   lda repflag
         eor #$ff
         sta repflag
         tax
         lda #32
         jsr wrt
         lda #'o'
         jsr wrt
         lda #'n'
         >>> txy
         bpl :skip
         lda #'f'
         jsr wrt
:skip    jsr wrt
         >>> bra,strt
                          ; ** set pc addrress **
putp2    lda tmp0+2
         sta pbr
putp     lda tmp0
         sta pcl
         lda tmp0+1
         sta pch
         rts
                          ; ** get pc addrress **
getp2    lda pbr
         sta tmp0+2
getp     lda pcl
         sta tmp0
         lda pch
         sta tmp0+1
         rts
                          ; ** memory display **
dm       jsr olddm
         jsr memadj
         jmp tmp2psav
olddm    lda #$08
         sta tmpc
         ldy #$ff
:loop    jsr space
         iny
         jsr fetchy
         jsr wrob
         dec tmpc
         bne :loop
         sty length
         rts
                          ; ** screen code display **
dscr     lda #32
         sta tmpc
         ldy #$ff
:loop    iny
         jsr fetchy
         jsr wrscr
         dec tmpc
         bne :loop
         sty length
         jsr memadj
         jmp tmp2psav
                          ; ** text display **
dt       lda #$08
         sta tmpc
         ldy #$ff
:loop    iny
         jsr fetchy
         jsr wrtext
         dec tmpc
         bne :loop
         sty length

memadj   jsr pcadj
         sta tmp0
         sty tmp0+1
         rts
                          ; ** change memory **
byte     jsr rdob
         bcc by3
bytest   dfb $87,tmp0     ;STA [TMP0]
         dfb $c7,tmp0     ;CMP [TMP0]
         beq by3
         jmp error
by3      jsr inctmp
         dec tmpc
         rts
                          ; ** store address **
word     jsr rdob
         pha
         jsr byte
         pla
         jmp bytest
                          ; ** set pc reg addrs **
setr     lda #<acc
         sta tmp0
         lda #>acc
         sta tmp0+1
         lda #00
         sta tmp0+2
         lda #8
         rts
                          ; ** write display prompt **
altrit   >>> phy
         jsr crlf
         pla
         ldx #$2e
         jmp wrtwo
                          ; ** print text **
prreg    lda regk,x
         beq :done
         jsr wrt
         inx
         bne prreg
:done    jmp altrit
                          ; **display registers **
dsplyr   jsr displayr
         jmp strt
displayr ldx #0
         ldy #$3b
         jsr prreg
         lda #00
         ldy emul
         bmi :skip
         lda pbr
:skip    jsr wrob
         jsr space
         ldy #00
:loop    lda pcl+1,y
         jsr wrob
         lda pcl,y
         jsr wrob
         jsr space
         iny
         iny
         cpy #10
         bcc :loop
         lda flgs
         jsr wrbin
         lda emul
         asl
         jmp wrbit
                          ; ** display extra regs
dispr2   ldx #regk2-regk
         ldy #'^'
         jsr prreg
         lda dbr
         jsr wrob
         jsr space
         lda dp+1
         jsr wrob
         lda dp
         jsr wrob
         jsr space
         lda ohone
         jsr wrob
         >>> brl,a9
                          ; ** display memory/mem+text **
dsplyt   lda #$ff
         dfb $2c
dsplym   lda #$00
         sta aflg
:rdt     jsr rdt
         cmp #'*'         ;i*
         bne :cr
         asl aflg         ;$00 or $fe
         >>> bra,:rdt
:cr      cmp #$0d
         bne :c0
         jsr psav2tmp
         lda #$ff
         sta tmp2
         sta tmp2+1
         sta tmp2+2
         bne dsp1

:c0      jsr read24
         bcs :c1
         cmp #$0d
         bne merrs1
:c1      ldx tmp0
         stx tmp2
         ldx tmp0+1
         stx tmp2+1
         ldx tmp0+2
         stx tmp2+2
         cmp #$0d
         beq dsp1
         jsr read24
         bcc merrs1
         jsr t2t2

dsp1     jsr stop1
         beq altjmp
         ldx wrap
         bne altjmp
         jsr diffp
         bcc altjmp
         ldx aflg
         bmi :text
         ldy #$3a
         jsr altrit
         jsr wroa24
         jsr dm
         >>> bra,dsp1
:text    inx
         bne :text2       ;i*
         jsr crlf
         jsr wroa24
         jsr olddm
         jsr space
         jsr dt
:blah    jsr pcadj
         >>> bra,dsp1
:text2   jsr crlf
         jsr wroa24
         jsr space
         jsr dscr
         bra :blah
merrs1   jmp error
                          ; ** alter main regs **
altr     jsr rdob
         bcc :skip1
         sta pbr
:skip1   jsr rdoc
         jsr rdoa
         bcc :skip2
         jsr putp
:skip2   jsr setr
         sta tmpc
:loop    jsr rdoc
         jsr word
         bne :loop
         jsr rdoc
         jsr getbits
         sta flgs
         jsr getbit
         ror emul
         bpl altjmp
         lda flgs
         ora #$30
         sta flgs
altjmp   jmp strt
                          ; ** alternate regs **
altr2    jsr rdob
         sta dbr
         jsr rdoc
         jsr rdob
         sta dp+1
         jsr rdob
         sta dp
         jsr rdoc
         jsr rdob
         bcc :exit
         sta ohone
         ora #$02
         hex 8f010000
:exit    jmp strt
                          ; ** alter memory **
altm     jsr read24
         bcc errs2
         lda #$08
         sta tmpc
         bne :loop2       ;kludge
:loop    jsr rdoc
:loop2   jsr byte
         bne :loop
a9       jmp strt
errs2    jmp error
                          ; ** Number conversion **
convnum  jsr rdoc
         ldy #10          ;base
         cmp #'$'
         bne :c1
         ldy #16
:c1      cmp #'%'
         bne :c2
         ldy #2
:c2      >>> phy
         ldx #00
         stx savx
         cpy #10
         beq :sta
:read    jsr rdt
         ldx savx
         cmp #13
         bne :sta
         lda #00
:sta     sta addrs,x
         inc savx
         tax
         bne :read
         >>> ply
         lda #<addrs
         ldx #>addrs
         jsr ASCTONUM
         bcs errs2
         ldx #13
         lda #' '
         jsr wrtwo
         lda ACC
         ldx ACC+1
         sta aflg
         stx aflg+1
         ldy #10
         jsr PRINTNUM
         ldx #' '
         lda #'$'
         jsr wrtwo
         lda aflg
         ldx aflg+1
         ldy #16
         jsr PRINTNUM
         ldx #' '
         lda #'%'
         jsr wrtwo
         lda aflg
         ldx aflg+1
         ldy #2
         jsr PRINTNUM
         jmp strt
                          ; ** Set breakpoint
setbrk   jsr rdt
         jsr read24
         jsr setbrk2
         jsr prline
         jmp strt
setbrk2  lda tmp0
         sta brkaddr
         lda tmp0+1
         sta brkaddr+1
         lda tmp0+2
         sta brkaddr+2
         jsr fetch        ;lda [tmp0]
         tay
         lda #00
         dfb $87,tmp0     ;sta [tmp0]
         tya
         sta brkinst
         rts
                          ; ** Single step **
singstep lda #00
         dfb $2c
                          ; ** .go **
go       lda #$ff
         pha
         jsr rdt
         cmp #$0d
         beq :g1
         cmp #$20
         bne errs3
         jsr read24
         jsr putp2
:g1      pla
         bmi :nobrk
         jsr getp2
         jsr fetch
         jsr getmidx
         jsr memadj
         jsr setbrk2
:nobrk   sta $d07e        ;restore SCPU stuff
         lda scpu+1       ;dos ext + rl status
         sta $d0bc
         and #$40
         beq :skip
         sta $df7e
:skip    lda scpu
         sta $d0b2

         lda dbr
         pha
         >>> plb
         jsr getsp
         >>> tcs
         sei
         lda ohone
         hex 8f010000
         asl emul
         bcs :emul
         lda pbr
         pha
:emul    lda pch
         pha
         lda pcl
         pha
         lda flgs
         pha
         >>> rep,$30
         lda dp
         pha
         lda acc
         ldx xr
         ldy yr
         >>> pld
         >>> xce
         rti
errs3    jmp error
                          ; ** back to basic **
exit     jsr getsp
         >>> tcs
         sec
         >>> xce
         jmp (ready)
                          ; ** read 1 or 2 (decimal) chars **
read12   jsr rdoc
         jsr decit
         sta acmd
         jsr rdt
         cmp #$2c
         beq :skip
         cmp #$0d
         beq :skip
         jsr decit
         ldx acmd
         beq :done
         clc
:l1      adc #10
         dex
         bne :l1
:done    sta acmd
         jsr rdt
:skip    ldx acmd
         rts

                          ; ** send disk command **
diskcmd  jsr rdt
         cmp #'$'
         beq :dir
         cmp #13
         beq :erchan
         cmp #'#'
         bne :sendcmd
         jsr read12       ;get device number
         stx fa
         jmp strt

:dir     jsr rdt
         cmp #13
         bne :err
         jsr PRINTDIR
         jmp strt

:err     jmp error

:erchan  jsr GETERR
         jmp strt

:sendcmd ldx #00
         stx acmd
:loop    ldx acmd
         sta STRBUF,x
         inc acmd
         jsr rdt
         cmp #13
         bne :loop
         ldx acmd
         lda #00
         sta STRBUF,x
         jsr SENDCMD
         jmp strt


*
* 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 #'$'
         STA addrs
         LDA #1
         LDX #<addrs
         LDY #>addrs
         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

*
* SENDCMD sends a command to the current drive
* Command contained in STRBUF
*
SENDCMD  
         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   
         LDA #13
         JSR CHROUT
*
* This method is a bit faster on output to screen.
*
         JSR OPENERR
         BCS GETEXIT
GETERR2  
: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  
         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

*-------------------------------

                          ; ** load/save **
ld       ldy #1
         sty fa
         sty wtype
         dey
         sty fnlen
         sty satus
         sty lvflag
         lda #<addrs
         sta fnadr
         lda #>addrs
         sta fnadr+1
         jsr getchar
         cmp #$0d
         beq l5
         cmp #$22
         bne errl
l3       jsr rdt
         cmp #$22
         beq l8
         cmp #$0d
         beq l5
         sta (fnadr),y
         inc fnlen
         iny
         cpy #$10
         bne l3
errl     jmp error
l8       jsr rdt
         cmp #$0d
         beq l5
         cmp #$2c
         bne errl
         jsr read12
         pha
         txa
         and #$0f
         beq errl
         cmp #$03
         beq errl
         sta fa
         pla
         cmp #$0d
         beq l5
         cmp #$2c
         bne errl
         jsr read24
         bcc errl
         dec wtype
         ldx $f7e5        ;check for 24-bit load/save
         cpx #$91
         beq :cont
         dec wtype
         ldx tmp0+2
         stx $b0
:cont    cmp #$0d
l5       rts
load     jsr ld
         bne errl
         ldx tmp0
         ldy tmp0+1
         lda #00
         jsr kload
         bcs :bye
         jsr space
         lda $c3
         ldx $c4
         jsr wrhex
         lda #'-'
         jsr wrt
         lda $ae
         ldx $af
         jsr wrhex
:bye     jmp strt
save     jsr ld
         cmp #$2c
         bne errl
         jsr t2t2
         jsr read24
         bcc errl
         cmp #$0d
         bne errl
         lda $f7e5        ;check for 24-bit load/save
         cmp #$91
         beq :cont
         lda tmp0+2
         sta $ab
:cont    ldx tmp0
         ldy tmp0+1
         lda #tmp2
         jsr ksave
         jmp strt
                          ; ** print text char **
wrtext   cmp #32
         bcc :zap
         cmp #128
         bcc :ok
         cmp #160
         bcs :ok
:zap     lda #'.'
:ok      jmp wrt
                          ; ** print as screen code **
wrscr    tax
         bpl :c1
         inc $c7          ;rvs on
:c1      txa
         and #$7f
         eor #32          ;Convert to chr$
         clc
         adc #32
         cmp #96          ;bleah
         bcc :wrt
         eor #$e0
         bpl :wrt
         eor #32
:wrt     jsr wrt
         dfb $64,$c7      ;STZ $c7
         rts
                          ; ** print hex byte **
wroa24   lda tmp0+2
         jsr wrob
wroa     lda tmp0+1
         jsr wrob
         lda tmp0
wrob     pha
         lsr a
         lsr a
         lsr a
         lsr a
         jsr ascii
         tax
         pla
         and #$0f
         jsr ascii
                          ; ** print two chars **
wrtwo    pha
         txa
         jsr wrt
         pla
         jmp wrt
                          ; ** print hex address **
wrhex    pha
         lda #'$'
         jsr wrt
         txa
         jsr wrob
         pla
         jmp wrob
                          ; ** convert to ascii **
ascii    ora #$30
         cmp #$3a
         bcc asc1
         adc #$06
asc1     rts
                          ; ** print a binary byte **
wrbin    sta tmpc
         ldy #08
:loop    asl tmpc
         jsr wrbit
         dey
         bne :loop
         rts
                          ; ** print bit in C **
wrbit    lda #'0'
         adc #00
         jmp wrt
                          ; ** read binary byte **
getbits  lda #8
         sta savx
:loop    jsr getbit
         rol tmpc
         dec savx
         bne :loop
         lda tmpc
         rts
                          ; ** read a bit **
getbit   jsr rdoc
         cmp #'1'
         rts
                          ; ** swap tmp0, tmp2 **
t2t2     ldx #$03
t2t21    lda tmp0-1,x
         pha
         lda tmp2-1,x
         sta tmp0-1,x
         pla
         sta tmp2-1,x
         dex
         bne t2t21
         rts
                          ; ** read 16/24 bit hex addr **
read24   jsr rdoa
         bcc rderr
read24b  ldx pbr
         stx tmp0+2
         jsr rdt
         cmp #$0d
         beq rdexit
         cmp #$20
         beq rdexit
         cmp #$2c
         beq rdexit
rdoa24   jsr rdob2
         bcc rdexit
         ldx tmp0+1
         stx tmp0+2
         ldx tmp0
         stx tmp0+1
         sta tmp0
         jsr rdt          ;.a = next char
         sec
         rts
rderr    jmp error
                          ; ** read hex address **
rdoa     jsr rdob
rdoa1    bcc rdoa2
         sta tmp0+1
rdoa2    jsr rdob
         bcc rdexit
         sta tmp0
rdexit   rts
                          ; ** scan for hex byte **
rdob     lda #0
         sta acmd
         jsr rdoc
rdob1    cmp #$20
         bne rdob2
         jsr rdoc
         cmp #$20
         bne rdob3
         clc
         rts
                          ; ** read hex byte **
rdob2    jsr hexit
         asl a
         asl a
         asl a
         asl a
         sta acmd
         jsr rdoc
rdob3    jsr hexit
         ora acmd
         sec
         rts
decit                     ; ** convert from base 10 **
         eor #48
         cmp #10
         bcs :err
         rts
:err     jmp error
                          ; ** convert from hex **
hexit    cmp #$3a
         bcc hex08
         adc #$08
hex08    and #$0f
         rts
                          ; ** decrement t0,t2 **
spread   = tmp2-tmp0
dect2    ldx #<spread
         dfb $2c
dect0    ldx #0
         ldy tmp0,x
         bne dec20
         ldy tmp0+1,x
         bne dec10
         inc wrap
dec10    dec tmp0+1,x
dec20    dec tmp0,x
ret1     rts
                          ; ** get a non space **
gtchr    jsr rdoc
         cmp #$20
         beq gtchr
         rts
                          ; ** including CR **
getchar  jsr rdt
         cmp #$20
         beq getchar
         rts
                          ; ** get address **
input    lda #00
         sta inbuf
         sta acmd
         jsr gtchr
         jsr rdob1
         jsr rdoa1
         bcc error
         jmp read24b
                          ; ** get address **
get2b    cmp #$0d
         beq error
         jsr read24
         bcs ret1
                          ; ** error exit **
error    jsr getsp
         >>> tcs
         lda #$3f
         jsr wrt
         jmp strt
                          ; ** get stack pointer **
getsp    >>> rep,$30
         lda sp
         >>> sep,$30
         rts
                          ; ** print spaces **
spacd    jsr space
         dex
         bne spacd
         rts
                          ; ** inc tmp 2 **
ptrinc   inc tmp2
         bne p1ov
         inc tmp2+1
p1ov     rts 
                          ; ** swap aflg, tmp0 **
swap     ldx #$03
swp1     lda tmp0-1,x
         pha
         lda aflg-1,x
         sta tmp0-1,x
         pla
         sta aflg-1,x
         dex
         bne swp1
         rts
                          ; ** calc tmp2-tmp0-2 **
diffb    lda tmp2
         ldy tmp2+1
         ldx tmp2+2
         sec
         sbc #2
         bcs deck
         dey
         cpy #$ff
         bne deck
         dex
         >>> bra,deck
                          ; ** calc aflg-tmp0 **
diffa    lda aflg
         ldy aflg+1
         ldx aflg+2
         >>> bra,deck
                          ; ** calc tmp2-tmp0 **
diffp    lda tmp2
         ldy tmp2+1
         ldx tmp2+2
deck     sec 
         sbc tmp0
         sta nemo
         >>> xba
         tya
         sbc tmp0+1
         tay
         ora nemo
         sta nemo
         txa
         sbc tmp0+2
         tax
         ora nemo
         rts
                          ; ** check address range **
chkrange ldy #01          ;0 < addr-begin < end-begin
         ldx length
         sec
:loop    jsr fetchy
         sbc tmp2-1,y
         sta stage+5,y
         iny
         dex
         bne :loop
         bcc :rts
         ldx length
         ldy #01
         sec
:loop2   lda aflg-1,y
         sbc stage+5,y
         iny
         dex
         bne :loop2
:rts     rts
                          ; ** relocate **
relocate lda #$ff
         dfb $2c
                          ; ** .transfer **
trans    lda #00
         sta tmpc
         jsr input
         pha
         jsr t2t2
         pla
         jsr get2b
         pha
         lda tmpc
         beq :skip
         jsr diffp        ;start-end code = -# of bytes
         bcs :err
         >>> xba
         sta stage
         sty stage+1
         inx
         bne :err
         pla
         jsr get2b        ;end vars
         pha
:skip    jsr diffp
         bcc :ok
         beq :ok
:err     jmp error
:ok      jsr swap
         pla
         jsr get2b        ;dest
         lda tmp0+2
         sta :mov+1
         lda tmp2+2
         sta :mov+2
         >>> phb
         >>> rep,$30
         ldx tmp2
         ldy tmp0
         lda aflg
         sec
         sbc tmp2
         sta aflg         ;end-begin
:mov     hex 540000       ;MVN
         >>> sep,$30
         >>> plb
         lda tmpc
         bne reloc
         jmp strt
                          ;** relocate chunk of code **
reloc    dfb $64,aflg+2   ;stz
         jsr diffp        ;begin-dest
         >>> xba
         sta stage+3
         sty stage+4
         stx stage+5
:loop    jsr fetch
         jsr getmidx
         lda acmd         ;modes 9-e, 11 are absolute
         cmp #9
         bcc :nope
         cmp #$0f
         bcc :maybe
         cmp #$11
         bne :nope
:maybe   jsr chkrange
         bcc :nope
         ldx length
         ldy #01
         sec
:yep     jsr fetchy
         sbc stage+2,y
         dfb $97,tmp0     ;STA [TMP0],Y
         iny
         dex
         bne :yep
:nope    jsr memadj
         lda stage
         sec
         adc length
         sta stage
         bcc :loop
         inc stage+1
         bne :loop
         jmp strt
                          ; ** .fill **
fill     jsr input
         pha
         jsr t2t2
         pla
         jsr get2b
         cmp #$0d
         beq error2
         jsr t2t2
         jsr rdob
         bcc error2
         sta tmpc
flup1    ldx wrap
         bne strt1
         jsr diffp
         bcc strt1
         lda tmpc
         dfb $87,tmp0     ;sta [tmp0]
         jsr inctmp
         bne flup1
error2   jmp error
strt1    jmp strt
                          ; ** .hunt **
hunt     jsr input
         pha
         jsr t2t2
         pla
         jsr get2b
         cmp #$0d
         beq error2
         jsr t2t2
         ldx #0
         jsr rdoc
         cmp #$22
         bne nostrh
         jsr rdoc
hpar     sta stage,x
         inx
         jsr rdt
         cmp #$0d
         beq htgo
         cmp #$22
         beq htgo
         cpx #$1e
         bne hpar
         beq htgo
nostrh   stx inbuf
         jsr rdob1
         bcc error2
hlp      sta stage,x
         inx
         jsr rdt
         cmp #$0d
         beq htgo
         jsr rdob
         bcc error2
         cpx #$1e
         bne hlp
htgo     stx savx
         jsr crlf
hscan    jsr stop1
         beq hnjmp
         ldx #0
         ldy #0
hlp3     jsr fetchy
         cmp stage,x
         bne hnmtch
         iny
         inx
         cpx savx
         bne hlp3
                          ; ** match found **
         jsr wroa24
         jsr space
hnmtch   jsr inctmp
         ldx wrap
         bne strt1
         jsr diffp
         bcs hscan
hnjmp    jmp strt
                          ; ** Fetch a byte using $01 **
fetchy   php
         sec
         dfb $2c
fetch    php
         clc
         >>> phx
         ldx $01
         lda ohone
         sta $01
         bcs :fetchy
         dfb $a7,tmp0     ;lda [tmp0]
         dfb $2c
:fetchy  dfb $b7,tmp0     ;lda [tmp0],y
         stx $01
         >>> plx
         plp
         and #$ff         ;set flags
         rts
                          ; ** Copy tmp0 to psav **
tmp2psav ldx #2
:loop    lda tmp0,x
         sta psav,x
         dex
         bpl :loop
         rts
                          ; ** Copy psav to tmp0 **
psav2tmp ldx #2
:loop    lda psav,x
         sta tmp0,x
         dex
         bpl :loop
         rts
                          ; ** Backwards disassemble **
backdis  
         lda #21
         sta savx         ;distance
:loop1   jsr psav2tmp
         inc savx
         jsr subsavx
         lda #$16
         sta tmpc
:loop2   jsr fetch        ;disassemble 22 lines
         jsr getmidx
         jsr memadj
:c2      dec tmpc
         bne :loop2
         lda psav
         cmp tmp0
         lda psav+1
         sbc tmp0+1
         lda psav+2
         sbc tmp0+2
         bcc :loop1       ;Until psav >= tmp0
         jsr subsavx
         jmp disas2       ;And disassemble!
subsavx  
         lda tmp0
         sec
         sbc savx
         sta tmp0
         bcs :c1
         dec tmp0+1       ;No 24-bit wrapping
:c1      rts
                          ; ** .disassemble **
disas    jsr rdoc
         jsr read24
disas2   jsr tmp2psav
         ldx #0
         stx aflg
dpag     lda #$93         ;clr
         jsr wrt
         lda #$16
         sta tmpc
dislp    jsr diss1
         jsr memadj
         dec tmpc
         bne dislp
         lda #$91         ;up
         jsr wrt
         jmp strt
                          ; ** diss 1 line **
diss1    ldy #','
         jsr altrit
         jsr space
diss1a   jsr wroa24
         jsr space
         jsr fetch
         sta reptemp
         jsr getmidx      ;mnemonic index
         txa
         pha
         ldy #0
         jsr disvv
         pla
         tax
         jsr propxx
         jsr prlchar      ;leading chars
         jsr praddr       ;address
         lda repflag
         bmi :skip
         lda repval
         ldx reptemp      ;Check for REP/SEP and adjust
         cpx #$c2
         bne :sep         ;status reg accordingly
         eor #$ff
         and flgs
         >>> bra,:sta
:sep     cpx #$e2
         bne :skip
         ora flgs
:sta     ldx emul
         bpl :sta2
         ora #$30         ;X and M always set
:sta2    sta flgs
:skip    jmp prechar      ;final chars

                          ;** Compute mnemonic index,mode **
getmidx  lsr
         tay
         bcc :even
:odd     cmp #$44         ;BIT #
         bne :notbit
         ldx #6
         lda #1
         bne :len
:notbit  and #$07         ;Exception is $xB
         cmp #%00000101
         beq :except
         tya
         lsr
         lsr
         lsr
         lsr              ;msd/16/2
         tax
         lda nemtab2,x
         tax
         tya
         and #$0f
         tay              ;low 5 bits/2
         lda modetab2,y
         bpl :len         ;.X .A = mnemonic, adr mode
:except  tya
         lsr
         lsr
         lsr
         tay
         ldx nemtab+$80,y
         lda #00          ;All are mode 0
         beq :len
:even    ldx nemtab,y
         lda modetab,y
:len     sta acmd         ;mode
         tay
         lda modelen,y
         sta length
         dey
         bne chkrts
                          ;** test for 16-bit **
         jsr fetch
check16  cmp #$a2         ;LDX
         beq :xchk
         and #$0f         ;CPX CPY LDY
         beq :xchk
         cmp #9           ;SEP REP
         bne chkrts
         lda #%00100000
         dfb $2c
:xchk    lda #%00010000
         and flgs
         bne chkrts
         inc length
chkrts   rts
                          ;** print leading chars **
prlchar  lda acmd
         beq done
         cmp #1
         bne :c1
         ldx #'#'
         bne :two
:c1      cmp #14
         bcc :dollar
         ldx #'('
         cmp #20
         bcc :two
         ldx #'['
:two     txa
         jsr wrt
:dollar  lda #'$'
         jmp wrt
                          ;** print address **
praddr   ldy length
         beq done
         lda acmd
         cmp #2
         beq prmove
         cmp #3
         beq prel
         cmp #4
         beq prel
:loop    jsr fetchy
         sta repval       ;Used with REP/SEP stuff
         jsr wrob
         dey
         bne :loop
done     rts
                          ;** MVN/MVP address **
prmove   jsr :print
         ldx #','
         lda #'$'
         jsr wrtwo
         dey
:print   jsr fetchy
         jmp wrob
                          ; ** print rel address **
prel     ldx #00
         jsr fetchy
         clc
         bpl :test
         dex
:test    dey              ;length
         beq :8bit
         tax
         jsr fetchy
         sec
:8bit    adc #2           ;bleah
         bcc :calc
         inx
         clc
:calc    jsr pcadj2
         tax
         tya
         jsr prbyte
         txa
prbyte   stx savx
         jsr wrob
         ldx savx
         rts 
                          ;** print end characters **
prechar  ldy acmd
:square  cpy #20
         bcc :commas
         lda #']'
         jsr wrt
:commas  ldx #','
         cpy #19
         beq :prs
         cpy #5
         bne :commax
:prs     lda #'s'
         jsr wrtwo
:commax  jsr iscomx
         bne :paren
         lda #'x'
         jsr wrtwo
:paren   cpy #14
         bcc :commay
         cpy #20
         bcs :commay
         lda #')'
         jsr wrt
:commay  jsr iscomy
         bne :bye
         lda #'y'
         jsr wrtwo
:bye     rts
                          ;** Check for ,x and ,y **
iscomx   cpy #7
         beq :rts
         cpy #10
         beq :rts
         cpy #13
         beq :rts
         cpy #17
         beq :rts
         cpy #18
:rts     rts

iscomy   cpy #8
         beq :rts
         cpy #11
         beq :rts
         cpy #16
         beq :rts
         cpy #19
         beq :rts
         cpy #21
:rts     rts
                          ; ** add length+1 to pc **
pcadj    ldx #00
         lda length
         sec
pcadj2   adc tmp0         ;result-> .A .Y = lo hi
         pha
         txa
         adc tmp0+1
         tay
         pla
         rts
                          ; print bytes
disvv    jsr fetchy       ;lda [tmp0],y
         jsr prbyte
         ldx #1
disvl    jsr spacd
         cpy length
         iny 
         bcc disvv
         ldx #$03
         cpy #4
         bcc disvl
         rts
                          ; ** print mnemonic in .X **
propxx   lda mneml,x
         sta aflg
         lda mnemr,x
         sta aflg+1
         ldx #3
:loop1   lda #0
         ldy #$05
:loop2   asl aflg+1
         rol aflg
         rol a
         dey
         bne :loop2
         adc #$40
         jsr wrt
         dex
         bne :loop1
                          ; ** print space **
space    lda #$20
         bne flip
                          ; ** print cr, maybe lf **
crlf     lda #$0d
         bit $13
         bpl flip
         jsr wrt
         lda #$0a
flip     jmp wrt
                          ; **.p disassemble **
prin     jsr input
         pha
         jsr t2t2
         pla
         jsr get2b
         jsr t2t2
         dfb $64,aflg     ;STZ
ploop    jsr crlf
         jsr diss1a
         jsr memadj
         jsr stop1
         beq strtx
         jsr diffp
         bcs ploop
strtx    jmp strt
                          ; ** re-disassemble **
redis    jsr input
         lda #$04
         sta tmpc
:loop    jsr byte
         beq :done
         jsr rdoc
         cmp #$20
         beq :loop
:done    jsr psav2tmp
         jmp dpag

findmnem ldx #91          ;Find mnemonic in the table
:loop    lda mneml,x
         cmp stage
         bne :next
         lda mnemr,x
         cmp stage+1
         bne :next
         stx stage        ;Mnemonic index
         rts
:next    dex
         bpl :loop
         jmp error

islead                    ;** Is .A a leading char?
:loop    cmp leadchar,x
         beq :out
         dex
         bpl :loop
:out     rts

isend    ldx #3           ;** Is .A an ending char?
:loop    cmp endchar,x
         beq :out
         dex
         bpl :loop
:out     rts
                          ;** Flip X and M bits **
flipbit  jsr rdt
         ldx #$30
         cmp #'m'
         bne :c1
         ldx #$20
:c1      cmp #'x'
         bne :c2
         ldx #$10
:c2      lda emul
         bmi :skip
         txa
         eor flgs
         sta flgs
:skip    jsr displayr
         pla
         pla
         jmp asmnext
                          ;** Read in and pack mnemonic
packm    hex 9c           ;STZ
         da stage
         hex 9c
         da stage+1
         jsr gtchr
         cmp #'!'
         beq flipbit
         pha
         jsr rdoc
         pha
         jsr rdoc
         pha
         ldy #3
:loop2   pla
         ldx #5
:loop    lsr
         ror stage
         ror stage+1
         dex
         bne :loop
         dey
         bne :loop2
         jmp findmnem     ;...and find it in the table

                          ;** Assemble **
assemble jsr rdoc
         jsr read24       ;address
         bcc jerr1
         cmp #$0d
         bne ardarg
         jmp strt
ardarg   jsr packm        ;mnemonic
         jsr getchar      ;argument
         ldx #7
         jsr islead
         bne jerr1
         dfb $64,aflg     ;STZ AFLG
         txa
         asl
         tax
         >>> per,super
         >>> rep,$20
         pla
         clc
         adc leadadr,x
         pha
         >>> sep,$30
         rts
                          ;** Form number from stack
cpstack  pla
         sta tmp2
         pla
         sta tmp2+1
         ldy #00
:loop    txa              ;.X contains # of bytes
         beq :skip
         dex
         pla
:skip    sta stage+4,y
         iny
         cpy #3           ;zero out any extra
         bne :loop
         txa
         bne jerr1        ;No more than 24 bits
         beq restore
                          ;** Read in an address
getaddr  jsr getchar      ;(of arbitrary length)
getaddr3 cmp #'$'
         bne jerr1
getaddr2 pla
         sta tmp2
         pla
         sta tmp2+1
         dfb $64,tmpc     ;Count # of bytes read
         dfb $64,acmd
         jsr rdt
:loop    jsr rdob1        ;read hex bytes
         bcc jerr1
         pha
         inc tmpc
         dfb $64,acmd
         jsr rdt
         jsr isend
         bne :loop
         ldx tmpc
restore  tay
         lda tmp2+1
         pha
         lda tmp2
         pha
         tya
         rts
jerr1    jmp error

*** Instruction modes
                          ;** Absolute mode $
abs      jsr getaddr2
         stx stage+2
         ldy times3p3,x
         sty stage+1
         bne absend

abs8     ldy #1           ;Zero page absolute <
         hex 2c           ;BIT
abs16    ldy #2           ;16-bit absolute !
         hex 2c
abs24    ldy #3           ;24-bit absolute >
         sty stage+2      ;max # of bytes allowed
         lda times3p3,y
         sta stage+1      ;addressing mode
         jsr getaddr
         cpx stage+2
         bcc absend
         bne jerr1

absend   stx tmpc
         cmp #$0d         ;last char read
         beq :done
         cmp #','         ;index
         bne jerr1
         jsr rdt
         ldx tmpc
         cmp #'$'
         beq :move
         cmp #'s'
         beq :stack
         inc stage+1
         cmp #'x'
         beq :done
         inc stage+1
         cmp #'y'
         bne jerr1
:done    ldy stage+1
         cpy #14          ;13 is highest
         bcs jerr1
         jmp instout
:stack   cpx #1           ;d,s
         bne jerr1
         ldy #5
         jmp instout
:move    dex              ;** MVN/MVP d,d
         bne jerr1
         jsr getaddr2
         dex              ;1 byte only
         bne jerr1
         ldx #2
         ldy #2
         jmp instout

indir    jsr getaddr      ;** Indirect ()
         stx stage+2
         cmp #')'
         bne :index
         ldy #14
         sty stage+1
         dex
         bne :done
         inc stage+1
         jsr rdt
         cmp #$0d
         beq :done
         inc stage+1
         jsr rdoc
         cmp #'y'
         bne jerr2
:done    ldy stage+1
         ldx stage+2
         jmp instout
:index   cmp #','
         bne jerr2
         ldy #17
         dex
         bne :zp
         iny
:zp      sty stage+1
         jsr rdoc
         cmp #'x'
         beq :done
         cmp #'s'
         bne jerr2
         lda #19
         sta stage+1
         jsr rdt
         jsr rdt
         jsr rdt
         cmp #'y'
         beq :done
jerr2    jmp error

lindir   jsr getaddr      ;Long indirect []
         stx stage+2
         dex
         bne jerr2
         cmp #']'
         bne jerr2
         ldy #20
         sty stage+1
         jsr rdt
         cmp #$0d
         beq :done
         inc stage+1
         jsr rdt
         cmp #'y'
         bne jerr2
:done    ldx stage+2
         ldy stage+1
         >>> bra,instout

accum    ldy #0           ;No arguments
         ldx #0
         beq instout
                          ;** Immediate addressing #
immed    jsr getaddr
         cmp #$0d         ;End with a CR!
         bne jerr2
         ldy #1           ;.Y = address mode

                          ;** Check and output inst bytes
instout  sty stage+1
         jsr cpstack
         jsr isop2        ;Search through opcode tables
         bcc :gotcha
         jsr isop1
         bcc :gotcha
         jmp error
:gotcha  sta stage+3      ;opcode
         ldx stage+1      ;mode
         ldy modelen,x    ;number of bytes
         dex
         bne :loop
         sty length
         jsr check16
         ldy length
:loop    lda stage+3,y
         dfb $97,tmp0     ;sta [tmp0],y
         dey
         bpl :loop
         jsr prline       ;print assembled line
         jsr memadj       ;inc tmp0
asmnext  ldy #'a'
         jsr altrit
         jsr space
         jsr wroa24
         jsr space
         jmp ardarg
                          ;** print assembled line
prline   jsr crlf
         lda #145         ;up
         jsr wrt
         jsr wrt
         jmp diss1

                          ;** Search through nemtab2
isop2    ldy #$07
         lda stage
:loop    cmp nemtab2,y
         beq :mode
         dey
         bpl :loop
         cmp #6           ;BIT
         bne :fail
         ldx stage+1
         dex
         bne :fail
         ldy #8
         lda #$89
         clc
         rts
:mode    ldx #15          ;16 possible modes
         lda stage+1
:loop2   cmp modetab2,x
         beq :crazy
         dex
         bpl :loop2
:fail    sec
         rts
:crazy   txa              ;Figure out this crazy thing
         sec
         rol              ;low 5 bits of opcode
         sta tmpc
         tya
         asl              ;msb = mnem*32
         asl
         asl
         asl
         asl
         ora tmpc         ;add to get opcode
         cmp #$89         ;STA #
         beq :fail
         clc
         rts
                          ;** Search through table 1 **
isop1    ldy #$7f
         lda stage
:loop    cmp nemtab,y
         bne :dey
         ldx modetab,y
         cpx stage+1
         beq :gotcha
         cpx #3           ;Check for relative addresses
         beq :rel
         cpx #4
         beq :rel
:dey     dey
         bpl :loop
         ldy #$8f         ;second part of table
         ldx stage+1      ;$xB is all no args
         bne :exit
:loop2   cmp nemtab,y
         beq :gotcha2
:dey2    dey
         bmi :loop2
:exit    sec
         rts
:rel     lda stage+1
         cmp #9           ;a
         bne :exit
         stx stage+1
         lda stage+2
         cmp #2
         bne :exit
         jsr makerel      ;make address relative
:gotcha  tya
         asl
         rts
:gotcha2 tya
         asl
         asl
         asl
         asl
         ora #$0b
         rts
                          ;** Convert stage address to rel
makerel  stx tmpc
         dec tmpc
         lda stage+4
         sec
         sbc tmpc         ;2/3 for r/rlong
         bcs :cont
         dec stage+5
         sec
:cont    sbc tmp0
         sta stage+4
         lda stage+5
         sbc tmp0+1
         sta stage+5
         cpx #3           ;check for overflow
         bne :rts
         lda stage+4
         clc
         adc #$80
         lda stage+5
         adc #00
         beq :rts
         jmp error
:rts     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   
         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    
         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 
         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 
         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


endcode  
* txt 'brevity is... wit.'

* Variables
brkinst  dfb 0            ;Old break instruction
brkaddr  dfb 0,0,0        ;address

repflag  dfb 0            ;REP/SEP flag

keyw     txt ':;rmgxls'
         txt 'tfhd_p,ae^bziwn\#@?',00

kaddr    dw altm-super-1
         dw altr-super-1
         dw dsplyr-super-1
         dw dsplym-super-1
         dw go-super-1
         dw exit-super-1
         dw load-super-1
         dw save-super-1
         dw trans-super-1
         dw fill-super-1
         dw hunt-super-1
         dw disas-super-1
         dw backdis-super-1
         dw prin-super-1
         dw redis-super-1
         dw assemble-super-1
         dw dispr2-super-1
         dw altr2-super-1
         dw setbrk-super-1
         dw singstep-super-1
         dw dsplyt-super-1
         dw whereami-super-1
         dw relocate-super-1
         dw repsep-super-1
         dw convnum-super-1
         dw diskcmd-super-1
         dw help-super-1
regk     dfb $0d
         txt ' pbr  pc '
         txt '  ac   xr   yr   sp '
         txt ' vnmxdizce'
         dfb 00
regk2    dfb 13
         txt ' dbr  dp  01',00

endchar  txt ',)]'
         dfb $0d          ;return!

leadchar txt '$!><([#'
         dfb 13
leadadr  
         da abs-super-1   ;Absolute
         da abs8-super-1  ;Absolute ZP
         da abs16-super-1 ;Absolute 16-bit
         da abs24-super-1 ;Absolute long
         da indir-super-1 ;Indirect
         da lindir-super-1 ;Long indirect
         da immed-super-1 ;Immediate
         da accum-super-1 ;Accumulator

times3p3 dfb 3,6,9,12,15  ;x*3+3

                          ;opcode mnemonic table index
nemtab   dfb 11,20,80,2,49,2,80,2    ;$0x
         dfb 9,41,79,2,15,27,79,2    ;$1x
         dfb 33,32,6,59,55,59,6,59   ;$2x
         dfb 7,1,6,59,65,23,6,59     ;$3x
         dfb 61,89,39,37,45,37,31,37 ;$4x
         dfb 13,26,38,37,17,51,31,37 ;$5x
         dfb 63,44,73,60,52,60,31,60 ;$6x
         dfb 14,0,73,60,67,57,31,60  ;$7x
         dfb 10,12,72,71,25,83,72,71 ;$8x
         dfb 3,69,72,71,86,84,73,73  ;$9x
         dfb 36,35,36,35,75,74,36,35 ;$ax
         dfb 4,34,36,35,18,82,36,35  ;$bx
         dfb 22,58,22,23,29,24,22,23 ;$cx
         dfb 8,19,43,23,16,50,30,23  ;$dx
         dfb 21,68,21,27,28,40,21,27 ;$ex
         dfb 5,64,42,27,66,56,33,27  ;$fx

         dfb 47,77,54,81,48,76,62,78 ;last row = $xb / 16
         dfb 46,85,53,87,88,70,90,91

                          ;even opcodes: ORA AND EOR ADC
                          ;              STA LDA CMP SBC
nemtab2  dfb 41,1,26,0,69,34,19,64

                          ; opcode mode table for above
                          ; 0= A/i/s  6= d    b= a,y   10= (d),y
                          ; 1= #      7= d,x  c= al    11= (a,x)
                          ; 2= d,d    8= d,y  d= al,x  12= (d,x)
                          ; 3= rel    9= a    e= (a)   13= (d,s),y
                          ; 4= rlong  a= a,x  f= (d)   14= [d]
                          ; 5= d,s                     15= [d],y
modetab  dfb 0,0,6,6,0,0,9,9
         hex 030f06070000090a ;$1x
         hex 090c060600000909 ;$2x
         hex 030f070700000a0a ;$3x
         hex 0006020600000909 ;$4x
         hex 030f020700000c0a ;$5x
         hex 0004060600000e09 ;$6x
         hex 030f07070000110a ;$7x
         hex 0304060600000909 ;$8x
         hex 030f07080000090a ;$9x
         hex 0101060600000909 ;$ax
         hex 030f070800000a0b ;$bx
         hex 0101060600000909 ;$cx
         hex 030f0f0700000e0a ;$dx
         hex 0101060600000909 ;$ex
         hex 030f09070000110a ;$fx

modetab2 hex 1205061401ff090c ;odd opcodes
         hex 101307150bff0a0d ;most sig. 5 bits

                          ; Address mode lengths
modelen  dfb 0,1,2,1,2,1
         dfb 1,1,1,2,2
         dfb 2,3,3,2,1
         dfb 1,2,1,1,1,1
                          ; packed mnemonics
mneml    
mnemr    = mneml+92

endvars  = mnemr+92
