mirror of https://github.com/marketideas/qasm.git
2276 lines
54 KiB
ArmAsm
2276 lines
54 KiB
ArmAsm
|
|
mx %00
|
|
|
|
doop stz lvalue
|
|
stz lvalue+2
|
|
lda domask
|
|
bpl :ok
|
|
lda #nesterror
|
|
sec
|
|
rts
|
|
:ok lda dolevel
|
|
bne :set
|
|
ldx #$00
|
|
jsr eval
|
|
bcc :set
|
|
cmp #undeflable
|
|
bne :err
|
|
lda #forwardref
|
|
:err sec
|
|
rts
|
|
:set lda domask
|
|
bne :shift0
|
|
:shift1 sec
|
|
rol domask
|
|
jmp :test
|
|
:shift0 asl domask
|
|
:test lda lvalue
|
|
ora lvalue+2
|
|
beq :dooff
|
|
lda domask
|
|
trb dolevel
|
|
jmp condout
|
|
:dooff lda domask
|
|
tsb dolevel
|
|
jmp condout
|
|
|
|
ifop stz lvalue
|
|
stz lvalue+2
|
|
lda domask
|
|
bpl :ok
|
|
lda #nesterror
|
|
sec
|
|
rts
|
|
:ok lda dolevel
|
|
beq :ok1
|
|
jmp :set
|
|
:ok1 lda linebuff
|
|
and #$00ff
|
|
bne :test
|
|
:bad rep $30
|
|
lda #badoperand
|
|
sec
|
|
:sec3 rep $30
|
|
rts
|
|
:test stz lvalue
|
|
stz lvalue+2
|
|
sep $30
|
|
ldy #$00
|
|
:flush lda (lineptr),y
|
|
iny
|
|
cmp #' '
|
|
blt :bad
|
|
beq :flush
|
|
cmp #'M'
|
|
beq :mx
|
|
cmp #'m'
|
|
beq :mx
|
|
cmp #'X'
|
|
beq :xc1
|
|
cmp #'x'
|
|
beq :xc1
|
|
:save sta :first
|
|
lda (lineptr),y
|
|
cmp #' '+1
|
|
blt :bad
|
|
iny
|
|
lda (lineptr),y
|
|
cmp #' '+1
|
|
blt :bad
|
|
cmp :first
|
|
bne :set
|
|
inc lvalue
|
|
:set rep $30
|
|
lda domask
|
|
bne :shift0
|
|
:shift1 sec
|
|
rol domask
|
|
jmp :test1
|
|
:xc1 jmp :xc
|
|
:shift0 asl domask
|
|
:test1 lda lvalue
|
|
ora lvalue+2
|
|
beq :dooff
|
|
lda domask
|
|
trb dolevel
|
|
jmp condout
|
|
:dooff lda domask
|
|
tsb dolevel
|
|
jmp condout
|
|
|
|
mx %11
|
|
:mx pha
|
|
lda (lineptr),y
|
|
and #$5f
|
|
cmp #'X'
|
|
beq :testmx
|
|
pla
|
|
bra :save
|
|
:testmx pla
|
|
dey
|
|
tyx
|
|
lda #ifflag
|
|
tsb modeflag+1
|
|
jsr eval
|
|
pha
|
|
php
|
|
lda #ifflag
|
|
trb modeflag+1
|
|
plp
|
|
pla
|
|
bcc :mxval
|
|
cmp #undeflable
|
|
bne :sec2
|
|
lda #forwardref
|
|
:sec2 rep $30
|
|
sec
|
|
rts
|
|
:mxval jmp :set
|
|
|
|
mx %11
|
|
:xc pha
|
|
lda [lineptr],y
|
|
and #$5f
|
|
cmp #'C'
|
|
beq :testxc
|
|
pla
|
|
jmp :save
|
|
:testxc pla
|
|
dey
|
|
tyx
|
|
lda #ifflag
|
|
tsb modeflag+1
|
|
jsr eval
|
|
pha
|
|
php
|
|
lda #ifflag
|
|
trb modeflag+1
|
|
plp
|
|
pla
|
|
bcc :set
|
|
cmp #undeflable
|
|
bne :sec1
|
|
lda #forwardref
|
|
:sec1 rep $30
|
|
sec
|
|
rts
|
|
:first ds 2
|
|
|
|
|
|
|
|
do 0
|
|
***
|
|
ifop lda domask
|
|
bpl :ok
|
|
lda #nesterror
|
|
sec
|
|
rts
|
|
:ok lda dolevel
|
|
bne :set
|
|
ldx #$00
|
|
jsr eval
|
|
bcc :set
|
|
cmp #undeflable
|
|
bne :err
|
|
lda #forwardref
|
|
:err rts
|
|
:set lda lvalue
|
|
ora lvalue+2
|
|
beq :dooff
|
|
lda domask
|
|
trb dolevel
|
|
asl domask
|
|
jmp condout
|
|
:dooff lda domask
|
|
tsb dolevel
|
|
asl domask
|
|
jmp condout
|
|
fin
|
|
|
|
elseop lda domask
|
|
eor dolevel
|
|
sta dolevel
|
|
jmp condout
|
|
|
|
finop lda domask
|
|
trb dolevel
|
|
lsr domask
|
|
jmp condout
|
|
|
|
condout lda dolevel
|
|
beq :on
|
|
lda #doflag
|
|
tsb modeflag
|
|
jmp :setlist
|
|
:on lda #doflag
|
|
trb modeflag
|
|
:setlist lda #lstdoon
|
|
bit listflag+1
|
|
beq :clc
|
|
lda #$80
|
|
trb listflag+1
|
|
:clc clc
|
|
rts
|
|
|
|
macop sep $30
|
|
lda macflag
|
|
and #%01100000 ;if expanding either mactype
|
|
beq :mac
|
|
rep $30
|
|
lda #badopcode
|
|
sec
|
|
rts
|
|
|
|
mx %11
|
|
|
|
:mac lda #$40
|
|
tsb clrglob
|
|
lda #putflag
|
|
bit modeflag
|
|
beq :good
|
|
pea #badopcode
|
|
jmp :error
|
|
:good lda passnum
|
|
jne :p1
|
|
lda macflag
|
|
bmi :define
|
|
|
|
lda #doflag
|
|
bit modeflag
|
|
beq :rep
|
|
|
|
:define lda [fileptr]
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '+1
|
|
blt :bl
|
|
cmp #':'
|
|
beq :bl
|
|
cmp #']'
|
|
beq :bl
|
|
ldy #$00
|
|
ldx #$00
|
|
]l lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #' '+1
|
|
blt :slab
|
|
cpx #$0f
|
|
bge :siny
|
|
sta labstr+1,x
|
|
:siny iny
|
|
inx
|
|
jmp ]l
|
|
:slab cpx #$10
|
|
blt :slab1
|
|
ldx #$0f
|
|
:slab1 stx labstr
|
|
lda #$ff
|
|
sta linelable
|
|
sta linelable+1
|
|
lda macflag
|
|
sta :mflag
|
|
rep $20
|
|
lda oldglob
|
|
sta :old
|
|
lda globlab
|
|
sta :glob
|
|
sep $20
|
|
stz macflag
|
|
jsr defineall
|
|
rep $10
|
|
ldy :old
|
|
sty oldglob
|
|
ldy :glob
|
|
sty globlab
|
|
sep $10
|
|
ldy :mflag
|
|
sty macflag
|
|
jcs :err1
|
|
:rep rep $30
|
|
lda linelable
|
|
bpl :ok
|
|
:bl pea #badlable
|
|
jmp :error
|
|
:ok asl
|
|
asl
|
|
tay
|
|
lda [lableptr1],y
|
|
sta lableptr
|
|
iny
|
|
iny
|
|
lda [lableptr1],y
|
|
sta lableptr+2
|
|
|
|
lda lablect
|
|
cmp #maxsymbols
|
|
blt :init
|
|
pea #symfull
|
|
jmp :error
|
|
|
|
:init ldy #26
|
|
lda #$8004
|
|
sta [lableptr],y
|
|
ldy #28
|
|
lda nextlableptr
|
|
sta [lableptr],y
|
|
tax
|
|
ldy #30
|
|
lda nextlableptr+2
|
|
sta [lableptr],y
|
|
sta lableptr+2
|
|
stx lableptr
|
|
|
|
lda lablect
|
|
asl
|
|
asl
|
|
tay
|
|
lda nextlableptr
|
|
sta [lableptr1],y
|
|
iny
|
|
iny
|
|
lda nextlableptr+2
|
|
sta [lableptr1],y
|
|
ldy #2
|
|
lda lastlen
|
|
clc
|
|
adc fileptr
|
|
tax
|
|
lda fileptr+2
|
|
bcc :sta
|
|
inc
|
|
:sta sta [lableptr],y
|
|
dey
|
|
dey
|
|
txa
|
|
sta [lableptr],y
|
|
ldy #4
|
|
lda #$0000
|
|
sta [lableptr],y
|
|
ldy #6
|
|
sta [lableptr],y
|
|
ldy #26
|
|
sta [lableptr],y
|
|
jsr inclablect
|
|
bcs :err1
|
|
:p1 sep $20
|
|
lda #$80
|
|
tsb macflag
|
|
rep $30
|
|
clc
|
|
rts
|
|
:err1 rep $30
|
|
pha
|
|
:error rep $30
|
|
pla
|
|
sec
|
|
rts
|
|
:mflag ds 2
|
|
:old ds 2
|
|
:glob ds 2
|
|
|
|
pmcop php
|
|
sep $30
|
|
stz :y
|
|
stz :y+1
|
|
ldy #$00
|
|
]lup lda [lineptr],y
|
|
iny
|
|
cmp #' '
|
|
blt :err
|
|
beq ]lup
|
|
dey
|
|
ldx #$00
|
|
]lup lda [lineptr],y
|
|
cpx #15
|
|
bge :c1
|
|
sta labstr+1,x
|
|
:c1 cmp #' '+1
|
|
blt :ok
|
|
cmp #','
|
|
beq :ok1
|
|
cmp #';'
|
|
beq :ok1
|
|
inx
|
|
iny
|
|
cpx #$10
|
|
blt ]lup
|
|
bra :ok
|
|
:ok1 iny
|
|
:ok txa
|
|
cmp #$10
|
|
blt :ls
|
|
lda #$0f
|
|
:ls sta labstr
|
|
sty :y
|
|
sep $30
|
|
lda macflag
|
|
sta :mflag
|
|
stz macflag
|
|
jsr findlable
|
|
ldy :mflag
|
|
sty macflag
|
|
* bcc :builtin ;not found so try built in macs
|
|
bcc :sec
|
|
rep $30
|
|
ldy #26
|
|
lda [lableptr],y
|
|
cmp #absolutebit.macrobit
|
|
bne :notmac
|
|
* bit expflag
|
|
* bmi :setup
|
|
* bvc :setup
|
|
* lda #$80
|
|
* trb listflag
|
|
:setup sep $30
|
|
lda macflag
|
|
sta :mflag
|
|
lda #$C1
|
|
tsb macflag
|
|
* sec
|
|
* ror lstobjflag
|
|
ldy :y
|
|
sty macvarpos
|
|
stz macvarpos+1
|
|
jsr initmac
|
|
bcc :clc
|
|
ldy :mflag
|
|
sty macflag
|
|
plp
|
|
sec
|
|
rts
|
|
:clc rep $30
|
|
plp
|
|
clc
|
|
rts
|
|
:sec rep $30
|
|
stz opcodeword
|
|
:err rep $30
|
|
lda #badlable
|
|
plp
|
|
sec ;return clear if handled opcode
|
|
rts
|
|
:notmac rep $30
|
|
lda #notmacro
|
|
plp
|
|
sec ;return clear if handled opcode
|
|
rts
|
|
:y ds 2
|
|
:mflag ds 2
|
|
|
|
|
|
|
|
|
|
eomop sep $30
|
|
lda macflag
|
|
bmi :ok
|
|
:bad pea #badopcode
|
|
jmp :error
|
|
:ok bit #%01100000
|
|
beq :define
|
|
bit #%00100000
|
|
beq :ext
|
|
jmp :internal
|
|
:ext lda maclevel
|
|
and #$ff
|
|
beq :bad
|
|
jsr pullmac
|
|
:rtn sep $30
|
|
lda #$FF
|
|
jsr setmaclist
|
|
lda maclevel
|
|
bne :noerror
|
|
lda #%01000000
|
|
trb macflag
|
|
:define stz maclevel
|
|
lda #%10000000
|
|
trb macflag
|
|
:noerror pea $00
|
|
:error rep $30
|
|
pla
|
|
cmp #$01
|
|
rts
|
|
:internal rep $30
|
|
lda imaclen
|
|
sta flen
|
|
lda imaclen+2
|
|
sta flen+2
|
|
lda imacptr
|
|
sta fileptr
|
|
lda imacptr+2
|
|
sta fileptr+2
|
|
lda imaclast
|
|
sta lastlen
|
|
lda #%00100000
|
|
trb macflag
|
|
jmp :rtn
|
|
|
|
definemacro
|
|
sep $30
|
|
lda opcode
|
|
bne :1
|
|
rep $30
|
|
clc
|
|
rts
|
|
|
|
:1 rep $30
|
|
jsr hashopcode
|
|
bcc :test
|
|
pha
|
|
jsr domac1
|
|
pla
|
|
bcc :test
|
|
clc
|
|
rts
|
|
|
|
:test hex c9 ;CMP 'EOM '
|
|
usr 'EOM '
|
|
beq :eom
|
|
hex c9
|
|
usr '<<< '
|
|
beq :eom
|
|
hex c9
|
|
usr 'MAC ' ;CMP 'MAC '
|
|
beq :mac
|
|
:clcx clc
|
|
rts
|
|
:eom jmp eomop
|
|
:mac lda passnum
|
|
bne :clcx
|
|
jmp macop
|
|
:bad rep $30
|
|
lda #badlable
|
|
:sec sec
|
|
rts
|
|
;macstack definition
|
|
;0 = fileptr
|
|
;2 = fileptr+2
|
|
;4 = flen
|
|
;6 = flen+2
|
|
;8 = lastlen
|
|
;10 = mac lable num
|
|
;12 = num of variables
|
|
;14 = offset into macvars of var txt
|
|
;16.... same
|
|
|
|
initmac php
|
|
rep $30
|
|
lda maclevel
|
|
and #$ff
|
|
cmp #macnestmax
|
|
blt :ok
|
|
lda #nesterror
|
|
plp
|
|
sec
|
|
rts
|
|
:ok asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda fileptr
|
|
sta macstack,x
|
|
lda fileptr+2
|
|
sta macstack+2,x
|
|
lda flen
|
|
sta macstack+4,x
|
|
lda flen+2
|
|
sta macstack+6,x
|
|
lda lastlen
|
|
sta macstack+8,x
|
|
ldy #16
|
|
lda [lableptr],y
|
|
sta macstack+10,x
|
|
|
|
stz lastlen
|
|
lda #$FFFF
|
|
sta flen
|
|
sta flen+2
|
|
|
|
ldy #30
|
|
lda [lableptr],y
|
|
sta workspace+2
|
|
ldy #28
|
|
lda [lableptr],y
|
|
sta workspace
|
|
ldy #2
|
|
lda [workspace]
|
|
sta fileptr
|
|
lda [workspace],y
|
|
sta fileptr+2
|
|
lda passnum
|
|
bne :p1
|
|
ldy #04
|
|
lda [workspace],y
|
|
inc
|
|
sta [workspace],y
|
|
jmp :get
|
|
:p1 ldy #06
|
|
lda [workspace],y
|
|
inc
|
|
sta [workspace],y
|
|
:get jsr getvars
|
|
inc maclevel
|
|
lda #$00
|
|
jsr setmaclist
|
|
plp
|
|
clc
|
|
rts
|
|
|
|
setmaclist php
|
|
sep $20
|
|
cmp #$00
|
|
beq :all
|
|
:eom lda linehaslab
|
|
bne :plp
|
|
lda #expflag
|
|
bit modeflag+1
|
|
beq :only
|
|
:all lda linehaslab
|
|
bne :plp
|
|
lda #exponly
|
|
bit modeflag+1
|
|
beq :plp
|
|
:only lda #$80
|
|
trb listflag+1
|
|
:plp plp
|
|
rts
|
|
|
|
macvarpos ds 2
|
|
|
|
getvars
|
|
|
|
]where = workspace
|
|
]ct = ]where+2
|
|
]lit = ]ct+1
|
|
]done = ]lit+1
|
|
|
|
php
|
|
rep $30
|
|
|
|
lda maclevel
|
|
and #$ff
|
|
xba
|
|
lsr ;quick * 128
|
|
sta ]where
|
|
tax
|
|
stz :tbl ;init number
|
|
sep $20
|
|
lda #128
|
|
sta ]ct
|
|
stz ]lit
|
|
stz ]done
|
|
ldy macvarpos
|
|
|
|
:flush lda (lineptr),y
|
|
cmp #' '
|
|
jlt :move
|
|
beq :finy
|
|
cmp #';'
|
|
bne :first
|
|
jmp :move
|
|
:finy iny
|
|
jmp :flush
|
|
:first cmp #$22
|
|
beq :literal
|
|
cmp #$27
|
|
bne :giny
|
|
:literal sta ]lit
|
|
:giny sta macvars,x
|
|
* jsr :print
|
|
dec ]ct
|
|
inx
|
|
iny
|
|
:loop lda (lineptr),y
|
|
cmp #' '
|
|
blt :done
|
|
beq :checklit
|
|
cmp #';'
|
|
beq :semi
|
|
cmp ]lit
|
|
beq :littog
|
|
cmp #$27
|
|
beq :lit1
|
|
cmp #$22
|
|
bne :x1
|
|
:lit1 sta ]lit
|
|
:x1 xba
|
|
:sta1 lda ]ct
|
|
beq :badvar
|
|
xba
|
|
sta macvars,x
|
|
* jsr :print
|
|
iny
|
|
inx
|
|
dec ]ct
|
|
jmp :loop
|
|
:checklit xba
|
|
lda ]lit
|
|
bne :sta1
|
|
jmp :done
|
|
:littog xba
|
|
lda ]lit
|
|
bne :loff
|
|
xba
|
|
sta ]lit
|
|
xba
|
|
jmp :sta1
|
|
:loff stz ]lit
|
|
jmp :sta1
|
|
:done sec
|
|
ror ]done
|
|
:semi xba
|
|
lda ]lit
|
|
bne :sta1
|
|
:next stz macvars,x
|
|
* jsr :printcr
|
|
inx
|
|
iny
|
|
dec ]ct
|
|
rep $20
|
|
phx
|
|
inc :tbl
|
|
lda :tbl
|
|
asl
|
|
tax
|
|
lda ]where
|
|
sta :tbl,x
|
|
plx
|
|
stx ]where
|
|
lda :tbl
|
|
cmp #$08
|
|
bge :move
|
|
sep $20
|
|
lda ]done
|
|
bne :move
|
|
stz ]lit
|
|
lda (lineptr),y
|
|
cmp #' '+1
|
|
blt :move
|
|
jmp :first
|
|
:badvar rep $30
|
|
lda #badoperand
|
|
plp
|
|
sec
|
|
rts
|
|
:move rep $30
|
|
lda maclevel
|
|
and #$ff
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
ldy #$00
|
|
]lup lda :tbl,y
|
|
sta macstack+12,x
|
|
iny
|
|
iny
|
|
inx
|
|
inx
|
|
cpy #9*2
|
|
blt ]lup
|
|
:xit plp
|
|
clc
|
|
rts
|
|
:tbl ds 9*2
|
|
|
|
:print php
|
|
rep $30
|
|
phx
|
|
phy
|
|
pha
|
|
jsr drawchar
|
|
pla
|
|
ply
|
|
plx
|
|
plp
|
|
rts
|
|
:printcr php
|
|
rep $30
|
|
phx
|
|
phy
|
|
pha
|
|
lda #'|'
|
|
jsr drawchar
|
|
lda #$0d
|
|
jsr drawchar
|
|
sep $20
|
|
:b999 ldal $e0c010
|
|
ldal $e0c061
|
|
bpl :b999
|
|
rep $20
|
|
pla
|
|
ply
|
|
plx
|
|
plp
|
|
rts
|
|
|
|
|
|
pullmac php
|
|
rep $30
|
|
dec maclevel
|
|
lda maclevel
|
|
and #$ff
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda macstack,x
|
|
sta fileptr
|
|
lda macstack+2,x
|
|
sta fileptr+2
|
|
lda macstack+4,x
|
|
sta flen
|
|
lda macstack+6,x
|
|
sta flen+2
|
|
lda macstack+8,x
|
|
sta lastlen
|
|
plp
|
|
rts
|
|
|
|
expandmac php
|
|
rep $30
|
|
jmp :init
|
|
|
|
:entry sep $20
|
|
stz linebuff
|
|
stz labstr
|
|
stz opcode
|
|
stz comment
|
|
|
|
rep $30
|
|
stz linehaslab
|
|
lda #$2020
|
|
sta opcode+1
|
|
sta opcode+3
|
|
sta opcode+5
|
|
|
|
:init
|
|
lda fileptr
|
|
clc
|
|
adc lastlen
|
|
sta fileptr
|
|
bcc :prt
|
|
inc fileptr+2
|
|
|
|
:prt lda fileptr
|
|
sta printptr
|
|
lda fileptr+2
|
|
sta printptr+2
|
|
|
|
stz :errcode
|
|
|
|
sep $30
|
|
ldy #$00
|
|
|
|
lda [fileptr]
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '
|
|
blt :sjmp ;to savlen =>
|
|
beq :getopcode
|
|
cmp #'*'
|
|
beq :fjmp ;to flushiny =>
|
|
cmp #';'
|
|
beq :fjmp
|
|
cmp #':' ;is it a valid lable?
|
|
bge :glabel ;yes...
|
|
:errbl xba
|
|
lda #badlable
|
|
sta :errcode
|
|
xba
|
|
|
|
:glabel sta labstr+1
|
|
sta linehaslab
|
|
ldx #$01
|
|
:gliny iny
|
|
lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #' '+1
|
|
blt :glabdone
|
|
cmp #'0'
|
|
blt :errbl1 ;bad lable
|
|
cmp #'<'
|
|
blt :cpx
|
|
cmp #'>'+1
|
|
blt :errbl1 ;"<=>" not allowed either..
|
|
:cpx cpx #$0f
|
|
bge :gliny
|
|
sta labstr+1,x
|
|
inx
|
|
jmp :gliny
|
|
:errbl1 pha
|
|
lda #badlable
|
|
sta :errcode
|
|
pla
|
|
jmp :cpx
|
|
:fjmp jmp :flushiny
|
|
:sjmp jmp :savlen
|
|
|
|
:glabdone cpx #$10
|
|
blt :gl2
|
|
ldx #$0f
|
|
:gl2 stx labstr
|
|
cmp #' '
|
|
bge :getopcode
|
|
jmp :savlen
|
|
|
|
:getopcode
|
|
:giny iny
|
|
lda [fileptr],y
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '
|
|
blt :sl1
|
|
beq :giny
|
|
cmp #';'
|
|
jeq :flushiny
|
|
|
|
sta opcode+1
|
|
|
|
ldx #$01
|
|
:goiny iny
|
|
lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #' '+1
|
|
blt :godone
|
|
cpx #31
|
|
bge :goiny
|
|
sta opcode+1,x
|
|
inx
|
|
jmp :goiny
|
|
|
|
:sl1 jmp :savlen
|
|
:fl1 jmp :flushiny
|
|
|
|
:godone cpx #32
|
|
blt :go2
|
|
ldx #31
|
|
:go2 stx opcode
|
|
cmp #' '
|
|
blt :sl1
|
|
|
|
:getoperand
|
|
:giny1 iny
|
|
lda [fileptr],y
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '
|
|
blt :sl1
|
|
beq :giny1
|
|
cmp #';'
|
|
beq :fl1
|
|
|
|
dey
|
|
ldx #$00
|
|
phx
|
|
|
|
:goiny1 iny
|
|
lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #' ' ;read in the rest of the line
|
|
blt :gotoper
|
|
beq :chklit
|
|
cmp #$27
|
|
beq :lit
|
|
cmp #$22
|
|
beq :lit
|
|
jmp :xba0
|
|
:chklit xba
|
|
lda 1,s
|
|
bne :xba1
|
|
xba
|
|
jmp :gotoper
|
|
:lit cmp 1,s
|
|
beq :litoff
|
|
sta 1,s
|
|
jmp :cpx1
|
|
:litoff xba
|
|
lda #$00
|
|
sta 1,s
|
|
jmp :xba1
|
|
:xba0 xba
|
|
lda #doflag
|
|
bit modeflag
|
|
bne :xba1
|
|
xba
|
|
cmp #']'
|
|
bne :cpx1
|
|
xba
|
|
iny
|
|
lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #'0'
|
|
blt :xba
|
|
beq :number
|
|
cmp #'9'
|
|
bge :xba
|
|
jmp :expand
|
|
:number phx
|
|
rep $30
|
|
lda maclevel
|
|
and #$ff
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda macstack+12,x
|
|
sep $30
|
|
plx
|
|
ora #$30
|
|
jmp :cpx1
|
|
:xba dey
|
|
:xba1 xba
|
|
:cpx1 cpx #128
|
|
bge :goiny1
|
|
sta linebuff+1,x
|
|
inx
|
|
jmp :goiny1
|
|
|
|
:gotoper cpx #128
|
|
blt :go3
|
|
ldx #128
|
|
:go3 stx linebuff
|
|
xba
|
|
pla
|
|
xba
|
|
cmp #' '
|
|
blt :savlen
|
|
|
|
:flushiny ldx passnum
|
|
bne :cp1
|
|
:cp0 iny
|
|
lda [fileptr],y
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '
|
|
bge :cp0
|
|
jmp :savlen
|
|
bra :cp0
|
|
:cp1 ldx #$00
|
|
:cf1 lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #' '
|
|
blt :savcom
|
|
bne :c11
|
|
iny
|
|
bra :cf1
|
|
:c11 lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #' '
|
|
blt :savcom
|
|
iny
|
|
cpx #128
|
|
bge :c11
|
|
sta comment+1,x
|
|
inx
|
|
bra :c11
|
|
:savcom stx comment
|
|
:savlen iny
|
|
sty lastlen
|
|
ldx linebuff
|
|
lda #$0d
|
|
sta linebuff+1,x
|
|
inc linebuff
|
|
|
|
lda :errcode
|
|
bne :secxit
|
|
lda opcode ;was there an opcode?
|
|
bne :process
|
|
jmp :clcxit
|
|
;list the line if necessary
|
|
|
|
:process sep $30
|
|
lda opcode
|
|
beq :c1
|
|
cmp #$04
|
|
blt :p1
|
|
:c1 jmp :clcxit
|
|
:p1 rep $30
|
|
jsr hashopcode
|
|
bcc :noforce ;not "forcelong"
|
|
pha
|
|
jsr domac1
|
|
pla
|
|
bcs :c1
|
|
:noforce hex c9 ;CMP 'MAC '
|
|
usr 'MAC '
|
|
bne :c1
|
|
jmp :entry
|
|
|
|
:clcxit rep $30
|
|
lda #$00
|
|
:secxit rep $30
|
|
and #$FF
|
|
pha
|
|
sep $30
|
|
lda linebuff
|
|
beq :xit
|
|
ldy #$00
|
|
]lup iny
|
|
lda linebuff,y
|
|
cmp #' '
|
|
blt :xit
|
|
beq ]lup
|
|
cmp #'#'
|
|
beq ]lup
|
|
cmp #'^'
|
|
beq :swap
|
|
cmp #'>'
|
|
beq :swap
|
|
cmp #'<'
|
|
bne :xit
|
|
:swap iny
|
|
xba
|
|
lda linebuff,y
|
|
cmp #'#'
|
|
bne :xit
|
|
sta linebuff-1,y
|
|
xba
|
|
sta linebuff,y
|
|
jmp :swap
|
|
:xit rep $30
|
|
pla
|
|
plp
|
|
cmp :one
|
|
rts
|
|
:one dw $01
|
|
:errcode ds 2
|
|
|
|
:expand phx
|
|
phy
|
|
rep $30
|
|
pha
|
|
and #$7f
|
|
sec
|
|
sbc #'0'
|
|
tay
|
|
lda maclevel
|
|
and #$ff
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
tya
|
|
cmp macstack+12,x
|
|
beq :exok
|
|
bge :expbad
|
|
:exok phx
|
|
asl
|
|
clc
|
|
adc 1,s
|
|
plx
|
|
tax
|
|
lda macstack+12,x
|
|
tay
|
|
lda 4,s
|
|
and #$ff
|
|
tax
|
|
sep $20
|
|
:exl lda macvars,y
|
|
and #$7f
|
|
beq :exgood
|
|
cpx #128
|
|
bge :xsta
|
|
:s1 sta linebuff+1,x
|
|
inx
|
|
:xsta iny
|
|
jmp :exl
|
|
:exgood rep $30
|
|
pla
|
|
pla
|
|
and #$ff
|
|
tay
|
|
sep $30
|
|
jmp :goiny1
|
|
:expbad pla ;do not replace
|
|
sep $30
|
|
ply
|
|
plx
|
|
jmp :xba
|
|
|
|
|
|
hashopcode
|
|
php
|
|
pea $00
|
|
pea $00
|
|
rep $30
|
|
lda opcode+$1
|
|
xba
|
|
sep $30
|
|
asl
|
|
asl
|
|
asl
|
|
rep $30
|
|
asl
|
|
asl
|
|
asl
|
|
sta 1,s
|
|
lda opcode+$4
|
|
and #$5F5F
|
|
beq :clc
|
|
cmp #$4C
|
|
beq :last
|
|
cmp #$4F44
|
|
beq :last
|
|
sta 3,s
|
|
:clc clc
|
|
:last lda opcode+$3
|
|
and #$1F
|
|
rol
|
|
ora 1,s
|
|
plx
|
|
plx
|
|
bne :sec
|
|
plp
|
|
clc
|
|
rts
|
|
:sec plp ;indicate "forcelong"
|
|
sec
|
|
rts
|
|
|
|
mx %00
|
|
|
|
|
|
lupbuffer ds 16*maxlup,0
|
|
|
|
lupop lda luplevel
|
|
cmp #maxlup
|
|
blt :ok
|
|
lda #nesterror
|
|
sec
|
|
rts
|
|
:ok ldx #$00
|
|
jsr eval
|
|
bcc :start
|
|
cmp #undeflable
|
|
bne :sec
|
|
lda #forwardref
|
|
:sec sec
|
|
rts
|
|
:start lda lvalue
|
|
ora lvalue+2
|
|
bne :s1
|
|
lda #badoperand
|
|
jmp :sec
|
|
:s1 lda #$80
|
|
trb listflag+1
|
|
lda luplevel
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda fileptr
|
|
sta lupbuffer,x
|
|
lda fileptr+2
|
|
sta lupbuffer+2,x
|
|
lda flen
|
|
sta lupbuffer+4,x
|
|
lda flen+2
|
|
sta lupbuffer+6,x
|
|
lda lastlen
|
|
sta lupbuffer+8,x
|
|
lda lvalue
|
|
sta lupbuffer+10,x
|
|
lda lvalue+2
|
|
sta lupbuffer+12,x
|
|
lda #lupflag
|
|
tsb modeflag
|
|
inc luplevel
|
|
clc
|
|
rts
|
|
|
|
lupend lda #lupflag
|
|
bit modeflag
|
|
bne :ok
|
|
lda #badopcode
|
|
sec
|
|
rts
|
|
:ok lda #$80
|
|
trb listflag+1
|
|
lda luplevel
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda lupbuffer+10,x
|
|
bne :dec
|
|
lda lupbuffer+12,x
|
|
beq :end
|
|
dec lupbuffer+12,x
|
|
:dec dec lupbuffer+10,x
|
|
lda lupbuffer+12,x
|
|
ora lupbuffer+10,x
|
|
beq :end
|
|
:cont lda lupbuffer,x
|
|
sta fileptr
|
|
lda lupbuffer+2,x
|
|
sta fileptr+2
|
|
lda lupbuffer+4,x
|
|
sta flen
|
|
lda lupbuffer+6,x
|
|
sta flen+2
|
|
lda lupbuffer+8,x
|
|
sta lastlen
|
|
clc
|
|
rts
|
|
:end dec luplevel
|
|
bne :clc
|
|
lda #lupflag
|
|
trb modeflag
|
|
:clc clc
|
|
rts
|
|
|
|
|
|
do 0
|
|
lupstart ds 4
|
|
luplen ds 4
|
|
lupcount ds 4
|
|
luplast ds 2
|
|
|
|
lupop lda #lupflag
|
|
bit modeflag
|
|
beq :ok
|
|
lda #badopcode
|
|
sec
|
|
rts
|
|
:ok ldx #$00
|
|
jsr eval
|
|
bcc :start
|
|
cmp #undeflable
|
|
bne :sec
|
|
lda #forwardref
|
|
:sec sec
|
|
rts
|
|
:start lda lvalue
|
|
ora lvalue+2
|
|
bne :s1
|
|
lda #badoperand
|
|
jmp :sec
|
|
:s1 lda #$80
|
|
trb listflag+1
|
|
lda fileptr
|
|
sta lupstart
|
|
lda fileptr+2
|
|
sta lupstart+2
|
|
lda flen
|
|
sta luplen
|
|
lda flen+2
|
|
sta luplen+2
|
|
lda lastlen
|
|
sta luplast
|
|
lda lvalue
|
|
sta lupcount
|
|
lda lvalue+2
|
|
sta lupcount+2
|
|
lda #lupflag
|
|
tsb modeflag
|
|
clc
|
|
rts
|
|
|
|
lupend
|
|
lda #lupflag
|
|
bit modeflag
|
|
bne :ok
|
|
lda #badopcode
|
|
sec
|
|
rts
|
|
:ok lda #$80
|
|
trb listflag+1
|
|
lda lupcount
|
|
bne :dec1
|
|
dec lupcount+2
|
|
:dec1 dec
|
|
sta lupcount
|
|
ora lupcount+2
|
|
bne :loop
|
|
lda #lupflag
|
|
trb modeflag
|
|
clc
|
|
rts
|
|
:loop lda lupstart
|
|
sta fileptr
|
|
lda lupstart+2
|
|
sta fileptr+2
|
|
lda luplen
|
|
sta flen
|
|
lda luplen+2
|
|
sta flen+2
|
|
lda luplast
|
|
sta lastlen
|
|
clc
|
|
rts
|
|
fin
|
|
|
|
checklup php
|
|
rep $30
|
|
lda luplevel
|
|
beq :xit
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda lupbuffer+10,x
|
|
sta :count
|
|
sep $30
|
|
lda labstr
|
|
beq :opc
|
|
tax
|
|
:lab lda labstr,x
|
|
cmp #'@'
|
|
bne :dex1
|
|
clc
|
|
adc :count
|
|
sta labstr,x
|
|
:dex1 dex
|
|
bne :lab
|
|
|
|
:opc lda opcode
|
|
beq :operand
|
|
tax
|
|
:opc1 lda opcode,x
|
|
cmp #'@'
|
|
bne :dex2
|
|
clc
|
|
adc :count
|
|
sta opcode,x
|
|
:dex2 dex
|
|
bne :opc1
|
|
:operand lda linebuff
|
|
beq :xit
|
|
tax
|
|
:oper1 lda linebuff,x
|
|
cmp #'@'
|
|
bne :dex3
|
|
clc
|
|
adc :count
|
|
sta linebuff,x
|
|
:dex3 dex
|
|
bne :oper1
|
|
:xit plp
|
|
rts
|
|
:count ds 2
|
|
|
|
macinsert
|
|
|
|
]ct equ workspace
|
|
]offset equ ]ct+$2
|
|
]pos equ ]offset+$2
|
|
]pos1 equ ]pos+$2
|
|
]len1 equ ]pos1+$2
|
|
]len2 equ ]len1+$2
|
|
]ptr equ ]len2+2
|
|
|
|
:entry php
|
|
rep $30
|
|
lda #$0020
|
|
sta labtype
|
|
lda lablect
|
|
cmp #maxsymbols ;max number of lables
|
|
blt :ne0
|
|
:full lda #symfull ;symtable full
|
|
jmp :error
|
|
:ne0 lda macvarptr
|
|
cmp #macsize
|
|
bge :full
|
|
:ne1 lda labstr
|
|
and #$FF
|
|
bne :ne2
|
|
:bad lda #badlable
|
|
jmp :error
|
|
:ne2 sta ]len1
|
|
lda labstr+$1 ;first byte of string
|
|
and #$7F
|
|
cmp #':' ;local lable?
|
|
beq :bad
|
|
* cmp #']' ;can't allow variables because
|
|
* beq :bad ;of parameter passing
|
|
lda maclevel
|
|
dec
|
|
and #$ff
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
sta :offset
|
|
tax
|
|
lda macstack+10,x
|
|
asl
|
|
asl
|
|
tay
|
|
lda [lableptr1],y
|
|
sta lableptr
|
|
iny
|
|
iny
|
|
lda [lableptr1],y
|
|
sta lableptr+2
|
|
ldy #28
|
|
lda [lableptr],y
|
|
sta ]ptr
|
|
ldy #30
|
|
lda [lableptr],y
|
|
sta ]ptr+2
|
|
ldy #$04
|
|
lda passnum
|
|
beq :py2
|
|
ldy #$06
|
|
:py2 lda []ptr],y
|
|
sta :count
|
|
ldy #24
|
|
lda [lableptr],y
|
|
jpl :start
|
|
lda macstack+10,x
|
|
bra :ne3
|
|
:udf lda #undeflable
|
|
jmp :error
|
|
:ne3 sta ]pos
|
|
sta labprev
|
|
ldy #24
|
|
lda lablect
|
|
sta [lableptr],y ;set local ptr for GLable
|
|
:save rep $30
|
|
jsr :saveit
|
|
bcc :nosave
|
|
plp
|
|
sec
|
|
rts
|
|
:nosave lda #$00
|
|
plp
|
|
clc
|
|
rts
|
|
:start sta ]pos
|
|
]lup lda ]pos
|
|
asl
|
|
asl
|
|
tay
|
|
lda [lableptr1],y
|
|
sta lableptr
|
|
iny
|
|
iny
|
|
lda [lableptr1],y
|
|
sta lableptr+2
|
|
stz ]offset
|
|
sep $20
|
|
lda [lableptr]
|
|
sta ]len2
|
|
stz ]len2+1
|
|
ldx #$02 ;start at byte 2
|
|
txy
|
|
]lup1 cpx #$10
|
|
jeq :error2
|
|
cpx ]len1
|
|
blt :1
|
|
beq :1
|
|
jmp :goleft1
|
|
:1 cpx ]len2
|
|
blt :2
|
|
beq :2
|
|
jmp :goright
|
|
:2 lda [lableptr],y
|
|
cmp labstr,x
|
|
bne :next
|
|
iny
|
|
inx
|
|
jmp ]lup1
|
|
:next rep $30
|
|
blt :goright
|
|
jmp :goleft
|
|
:goleft1 rep $30
|
|
lda ]len1
|
|
cmp ]len2
|
|
bne :goleft
|
|
:replace ldy #22 ;offset to equ value
|
|
lda [lableptr],y
|
|
:rl tay
|
|
iny
|
|
iny
|
|
lda [macptr],y
|
|
cmp :count
|
|
beq :r1
|
|
dey
|
|
dey
|
|
lda [macptr],y
|
|
bpl :rl
|
|
:rs lda macvarptr
|
|
sta [macptr],y
|
|
tay
|
|
lda #$ffff
|
|
sta [macptr],y
|
|
iny
|
|
iny
|
|
lda :count
|
|
sta [macptr],y
|
|
iny
|
|
iny
|
|
lda labval
|
|
sta [macptr],y
|
|
iny
|
|
iny
|
|
lda labval+2 ;replace equate
|
|
sta [macptr],y
|
|
iny
|
|
iny
|
|
sty macvarptr
|
|
jmp :nosave
|
|
:r1 iny
|
|
iny
|
|
lda labval
|
|
sta [macptr],y
|
|
iny
|
|
iny
|
|
lda labval+2 ;replace equate
|
|
sta [macptr],y
|
|
jmp :nosave
|
|
:goleft rep $30
|
|
ldy #18 ;leftptr
|
|
lda [lableptr],y
|
|
bpl :p1
|
|
lda lablect
|
|
sta [lableptr],y
|
|
jmp :save
|
|
:p1 sta ]pos
|
|
jmp ]lup
|
|
:goright rep $30
|
|
ldy #20 ;leftptr
|
|
lda [lableptr],y
|
|
bpl :p2
|
|
lda lablect
|
|
sta [lableptr],y
|
|
jmp :save
|
|
:p2 sta ]pos
|
|
jmp ]lup
|
|
:error2 rep $30
|
|
lda #badlable
|
|
:error plp
|
|
sec
|
|
rts
|
|
:saveit sta labnum
|
|
pha
|
|
lda ]pos
|
|
sta labprev
|
|
lda labtype
|
|
ora orgor
|
|
sta labtype
|
|
lda #dumflag
|
|
bit modeflag
|
|
beq :si1
|
|
lda labtype
|
|
ora dumor ;#$8000
|
|
sta labtype
|
|
:si1 lda #$FFFF
|
|
sta lableft
|
|
sta labright
|
|
sta lablocal
|
|
|
|
ldy macvarptr
|
|
lda #$ffff
|
|
sta [macptr],y
|
|
iny
|
|
iny
|
|
lda :count
|
|
sta [macptr],y
|
|
iny
|
|
iny
|
|
lda labval
|
|
sta [macptr],y
|
|
iny
|
|
iny
|
|
lda labval+2
|
|
sta [macptr],y
|
|
iny
|
|
iny
|
|
lda macvarptr
|
|
sta labprev
|
|
sty macvarptr
|
|
|
|
pla
|
|
sta ]pos ;for movefound
|
|
asl
|
|
asl
|
|
tay
|
|
lda nextlableptr
|
|
sta [lableptr1],y
|
|
sta lableptr
|
|
pha ;for mvn below
|
|
iny
|
|
iny
|
|
lda nextlableptr+2
|
|
sta [lableptr1],y
|
|
sta lableptr+2
|
|
sep $20
|
|
sta :mvn+1
|
|
rep $20
|
|
ply ;low of destination
|
|
tdc
|
|
clc
|
|
adc #labstr
|
|
tax ;source low word
|
|
lda #31 ;MVN
|
|
phb
|
|
:mvn mvn $000000,$000000
|
|
plb
|
|
jsr inclablect
|
|
rts
|
|
:offset ds 2
|
|
:count ds 2
|
|
|
|
macfind
|
|
|
|
]ct equ workspace
|
|
]offset equ ]ct+$2
|
|
]pos equ ]offset+$2
|
|
]pos1 equ ]pos+$2
|
|
]len1 equ ]pos1+$2
|
|
]len2 equ ]len1+$2
|
|
|
|
:entry php
|
|
sep $30
|
|
:normal lda modeflag
|
|
and #caseflag
|
|
beq :macentry
|
|
jsr caselable
|
|
:macentry stz labtype
|
|
stz labtype+1
|
|
lda lablect
|
|
ora lablect+1
|
|
jeq :notfound
|
|
lda labstr
|
|
jeq :notfound
|
|
sta ]len1
|
|
stz ]len1+1
|
|
lda maclevel
|
|
sta :lev
|
|
stz :lev+1
|
|
:loop rep $30
|
|
lda :lev
|
|
beq :notfound
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda macstack+10,x
|
|
asl
|
|
asl
|
|
tay
|
|
lda [lableptr1],y
|
|
sta lableptr
|
|
iny
|
|
iny
|
|
lda [lableptr1],y
|
|
sta lableptr+2
|
|
ldy #24
|
|
lda [lableptr],y
|
|
jmi :nf1
|
|
sta ]pos
|
|
ldy #28
|
|
lda [lableptr],y
|
|
tax
|
|
ldy #30
|
|
lda [lableptr],y
|
|
sta lableptr+2
|
|
stx lableptr
|
|
ldy #$04
|
|
ldx passnum
|
|
beq :noinx
|
|
ldy #$06
|
|
:noinx lda [lableptr],y
|
|
sta :count
|
|
:gloop
|
|
]lup lda ]pos
|
|
asl
|
|
asl
|
|
tay
|
|
lda [lableptr1],y
|
|
sta lableptr
|
|
iny
|
|
iny
|
|
lda [lableptr1],y
|
|
sta lableptr+2
|
|
stz ]offset
|
|
lda [lableptr]
|
|
and #$0f
|
|
sta ]len2
|
|
sep $20
|
|
ldx #$02 ;start at byte 2
|
|
txy
|
|
]lup1 cpx #$10
|
|
bge :movefound
|
|
cpx ]len1
|
|
blt :1
|
|
beq :1
|
|
jmp :goleft1
|
|
:notfound plp
|
|
clc
|
|
rts
|
|
:1 cpx ]len2
|
|
blt :2
|
|
beq :2
|
|
jmp :goright
|
|
:2 lda labstr,x
|
|
cmp [lableptr],y
|
|
bne :next
|
|
iny
|
|
inx
|
|
jmp ]lup1
|
|
:next blt :goleft
|
|
jmp :goright
|
|
:goleft1 lda ]len1
|
|
cmp ]len2
|
|
beq :movefound
|
|
:goleft rep $30
|
|
ldy #18
|
|
lda [lableptr],y
|
|
bmi :nf1
|
|
sta ]pos
|
|
jmp ]lup
|
|
:goright rep $30
|
|
ldy #20
|
|
lda [lableptr],y
|
|
bmi :nf1
|
|
sta ]pos
|
|
jmp ]lup
|
|
:nf1 rep $30
|
|
dec :lev
|
|
jmp :loop
|
|
:movefound rep $30
|
|
lda ]pos
|
|
asl
|
|
asl
|
|
tay
|
|
lda [lableptr1],y
|
|
sta lableptr
|
|
iny
|
|
iny
|
|
lda [lableptr1],y
|
|
sta lableptr+2
|
|
ldy #22
|
|
lda [lableptr],y
|
|
:lup tay
|
|
iny
|
|
iny
|
|
lda [macptr],y
|
|
cmp :count
|
|
beq :valfound
|
|
dey
|
|
dey
|
|
lda [macptr],y
|
|
bpl :lup
|
|
jmp :nf1
|
|
:valfound iny
|
|
iny
|
|
lda [macptr],y
|
|
tax
|
|
iny
|
|
iny
|
|
lda [macptr],y
|
|
ldy #30
|
|
sta [lableptr],y
|
|
txa
|
|
ldy #28
|
|
sta [lableptr],y
|
|
plp
|
|
sec
|
|
rts
|
|
:count ds 2
|
|
:lev ds 2
|
|
|
|
imacptr ds 4
|
|
imaclen ds 4
|
|
imaclast ds 4
|
|
|
|
expandint php
|
|
rep $30
|
|
lda fileptr
|
|
clc
|
|
adc lastlen
|
|
sta fileptr
|
|
bcc :prt
|
|
inc fileptr+2
|
|
|
|
:prt lda fileptr
|
|
sta printptr
|
|
lda fileptr+2
|
|
sta printptr+2
|
|
|
|
sep $30
|
|
* ldy #$00
|
|
|
|
lda [fileptr]
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '
|
|
blt :sjmp ;to savlen =>
|
|
beq :getopcode
|
|
cmp #'*'
|
|
beq :fjmp ;to flushiny =>
|
|
cmp #';'
|
|
beq :fjmp
|
|
:errbl lda #badlable
|
|
jmp :errflush
|
|
:fjmp jmp :flushiny
|
|
:sjmp jmp :savlen
|
|
|
|
:getopcode
|
|
:giny iny
|
|
lda [fileptr],y
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '
|
|
blt :sl1
|
|
beq :giny
|
|
cmp #';'
|
|
jeq :flushiny
|
|
|
|
and tbxand
|
|
sta opcode+1
|
|
|
|
ldx #$01
|
|
:goiny iny
|
|
lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #' '+1
|
|
blt :godone
|
|
cpx #31
|
|
bge :goiny
|
|
and tbxand
|
|
sta opcode+1,x
|
|
inx
|
|
jmp :goiny
|
|
|
|
:sl1 jmp :savlen
|
|
:fl1 jmp :flushiny
|
|
|
|
:godone cpx #32
|
|
blt :go2
|
|
ldx #31
|
|
:go2 stx opcode
|
|
cmp #' '
|
|
blt :sl1
|
|
|
|
:getoperand
|
|
:giny1 iny
|
|
lda [fileptr],y
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '
|
|
blt :sl1
|
|
beq :giny1
|
|
cmp #';'
|
|
beq :fl1
|
|
|
|
dey
|
|
ldx #$00
|
|
phx
|
|
:goiny1 iny
|
|
lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #' ' ;read in the rest of the line
|
|
blt :gotoper
|
|
beq :chklit
|
|
cmp #$27
|
|
beq :lit
|
|
cmp #$22
|
|
beq :lit
|
|
jmp :xba0
|
|
:chklit xba
|
|
lda 1,s
|
|
bne :xba1
|
|
xba
|
|
jmp :gotoper
|
|
:lit cmp 1,s
|
|
beq :litoff
|
|
sta 1,s
|
|
jmp :cpx1
|
|
:litoff xba
|
|
lda #$00
|
|
sta 1,s
|
|
jmp :xba1
|
|
:xba0 xba
|
|
lda #doflag
|
|
bit modeflag
|
|
bne :xba1
|
|
xba
|
|
cmp #']'
|
|
bne :cpx1
|
|
xba
|
|
iny
|
|
lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #'0'
|
|
blt :xba
|
|
beq :number
|
|
cmp #'9'
|
|
bge :xba
|
|
jmp :expand
|
|
:number phx
|
|
rep $30
|
|
lda #macnestmax+1
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
lda macstack+12,x
|
|
sep $30
|
|
plx
|
|
ora #$30
|
|
jmp :cpx1
|
|
:xba dey
|
|
:xba1 xba
|
|
:cpx1 cpx #128
|
|
bge :goiny1
|
|
sta linebuff+1,x
|
|
inx
|
|
jmp :goiny1
|
|
|
|
:gotoper cpx #128
|
|
blt :go3
|
|
ldx #128
|
|
:go3 stx linebuff
|
|
xba
|
|
pla
|
|
xba
|
|
cmp #' '
|
|
blt :savlen
|
|
|
|
:flushiny ldx passnum
|
|
bne :cp1
|
|
:cp0 iny
|
|
lda [fileptr],y
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '
|
|
bge :cp0
|
|
jmp :savlen
|
|
bra :cp0
|
|
:cp1 ldx #$00
|
|
:c11 lda [fileptr],y
|
|
phx
|
|
tax
|
|
lda inputtbl,x
|
|
plx
|
|
cmp #' '
|
|
blt :savcom
|
|
iny
|
|
cpx #128
|
|
bge :c11
|
|
sta comment+1,x
|
|
inx
|
|
bra :c11
|
|
:savcom stx comment
|
|
:savlen iny
|
|
sty lastlen
|
|
ldx linebuff
|
|
lda #$0d
|
|
sta linebuff+1,x
|
|
inc linebuff
|
|
|
|
|
|
lda opcode ;was there an opcode?
|
|
bne :process
|
|
jmp :clcxit
|
|
;list the line if necessary
|
|
|
|
:errflush pha ;we got an error somewhere..before
|
|
]f iny ;we got to the EOLN...so we must
|
|
lda [fileptr],y ;flush it out
|
|
tax
|
|
lda inputtbl,x
|
|
cmp #' '
|
|
bge ]f
|
|
iny
|
|
sty lastlen
|
|
ldx linebuff ;put a <CR> at end anyway
|
|
lda #$0d
|
|
sta linebuff+1,x
|
|
inc linebuff
|
|
pla ;restore the error code
|
|
jmp :secxit
|
|
|
|
:process
|
|
:clcxit rep $30
|
|
lda #$00
|
|
:secxit rep $30
|
|
pha
|
|
sep $30
|
|
lda linebuff
|
|
beq :xit
|
|
ldy #$00
|
|
]lup iny
|
|
lda linebuff,y
|
|
cmp #' '
|
|
blt :xit
|
|
beq ]lup
|
|
cmp #'#'
|
|
beq ]lup
|
|
cmp #'^'
|
|
beq :swap
|
|
cmp #'>'
|
|
beq :swap
|
|
cmp #'<'
|
|
bne :xit
|
|
:swap iny
|
|
xba
|
|
lda linebuff,y
|
|
cmp #'#'
|
|
bne :xit
|
|
sta linebuff-1,y
|
|
xba
|
|
sta linebuff,y
|
|
jmp :swap
|
|
:xit rep $30
|
|
pla
|
|
plp
|
|
cmp :one
|
|
rts
|
|
:one dw $01
|
|
|
|
:expand phx
|
|
phy
|
|
rep $30
|
|
pha
|
|
and #$7f
|
|
sec
|
|
sbc #'0'
|
|
tay
|
|
lda #macnestmax+1
|
|
dec
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
asl
|
|
tax
|
|
tya
|
|
cmp macstack+12,x
|
|
beq :exok
|
|
bge :expbad
|
|
:exok phx
|
|
asl
|
|
clc
|
|
adc 1,s
|
|
plx
|
|
tax
|
|
lda macstack+12,x
|
|
tay
|
|
lda 4,s
|
|
and #$ff
|
|
tax
|
|
sep $20
|
|
:exl lda macvars,y
|
|
and #$7f
|
|
beq :exgood
|
|
cpx #128
|
|
bge :xsta
|
|
:s1 sta linebuff+1,x
|
|
inx
|
|
:xsta iny
|
|
jmp :exl
|
|
:exgood rep $30
|
|
pla
|
|
pla
|
|
and #$ff
|
|
tay
|
|
sep $30
|
|
jmp :goiny1
|
|
:expbad pla ;do not replace
|
|
sep $30
|
|
ply
|
|
plx
|
|
jmp :xba
|
|
|
|
|
|
initinternal rep $30
|
|
sta :low+1
|
|
stx :high+1
|
|
lda macflag
|
|
bit #%00100000
|
|
beq :ok
|
|
lda #badmacro
|
|
sec
|
|
rts
|
|
:ok lda fileptr
|
|
sta imacptr
|
|
lda fileptr+2
|
|
sta imacptr+2
|
|
lda lastlen
|
|
sta imaclast
|
|
lda flen
|
|
sta imaclen
|
|
lda flen+2
|
|
sta imaclen+2
|
|
lda #%10100001
|
|
tsb macflag
|
|
:high lda #$FFFF
|
|
sta fileptr+2
|
|
:low lda #$FFFF
|
|
sta fileptr
|
|
stz lastlen
|
|
lda #$ffff
|
|
sta flen
|
|
sta flen+2
|
|
lda maclevel
|
|
pha
|
|
lda #macnestmax
|
|
sta maclevel
|
|
stz macvarpos
|
|
jsr getvars
|
|
pla
|
|
sta maclevel
|
|
lda #$00
|
|
jsr setmaclist
|
|
clc
|
|
rts
|
|
|