Apple-2-SW/prog8
1
0
Fork 0
mirror of https://github.com/irmen/prog8.git synced 2024-11-23 22:33:12 +00:00
Code Issues Projects Releases Wiki Activity
fb989ae62f
prog8/compiler/res/prog8lib/prog8_lib.asm

1189 lines
22 KiB
NASM
Raw Blame History

; Internal library routines - always included by the compiler
; Generic machine independent 6502 code.
orig_stackpointer .byte 0 ; stores the Stack pointer register at program start
read_byte_from_address_on_stack .proc
; -- read the byte from the memory address on the top of the stack, return in A (stack remains unchanged)
lda P8ESTACK_LO+1,x
ldy P8ESTACK_HI+1,x
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
lda (P8ZP_SCRATCH_W2),y
rts
.pend
write_byte_to_address_on_stack .proc
; -- write the byte in A to the memory address on the top of the stack (stack remains unchanged)
ldy P8ESTACK_LO+1,x
sty P8ZP_SCRATCH_W2
ldy P8ESTACK_HI+1,x
sty P8ZP_SCRATCH_W2+1
ldy #0
sta (P8ZP_SCRATCH_W2),y
rts
.pend
neg_b .proc
lda #0
sec
sbc P8ESTACK_LO+1,x
sta P8ESTACK_LO+1,x
rts
.pend
neg_w .proc
sec
lda #0
sbc P8ESTACK_LO+1,x
sta P8ESTACK_LO+1,x
lda #0
sbc P8ESTACK_HI+1,x
sta P8ESTACK_HI+1,x
rts
.pend
inv_word .proc
lda P8ESTACK_LO+1,x
eor #255
sta P8ESTACK_LO+1,x
lda P8ESTACK_HI+1,x
eor #255
sta P8ESTACK_HI+1,x
rts
.pend
bitand_b .proc
; -- bitwise and (of 2 bytes)
lda P8ESTACK_LO+2,x
and P8ESTACK_LO+1,x
inx
sta P8ESTACK_LO+1,x
rts
.pend
bitor_b .proc
; -- bitwise or (of 2 bytes)
lda P8ESTACK_LO+2,x
ora P8ESTACK_LO+1,x
inx
sta P8ESTACK_LO+1,x
rts
.pend
bitxor_b .proc
; -- bitwise xor (of 2 bytes)
lda P8ESTACK_LO+2,x
eor P8ESTACK_LO+1,x
inx
sta P8ESTACK_LO+1,x
rts
.pend
bitand_w .proc
; -- bitwise and (of 2 words)
lda P8ESTACK_LO+2,x
and P8ESTACK_LO+1,x
sta P8ESTACK_LO+2,x
lda P8ESTACK_HI+2,x
and P8ESTACK_HI+1,x
sta P8ESTACK_HI+2,x
inx
rts
.pend
bitor_w .proc
; -- bitwise or (of 2 words)
lda P8ESTACK_LO+2,x
ora P8ESTACK_LO+1,x
sta P8ESTACK_LO+2,x
lda P8ESTACK_HI+2,x
ora P8ESTACK_HI+1,x
sta P8ESTACK_HI+2,x
inx
rts
.pend
bitxor_w .proc
; -- bitwise xor (of 2 bytes)
lda P8ESTACK_LO+2,x
eor P8ESTACK_LO+1,x
sta P8ESTACK_LO+2,x
lda P8ESTACK_HI+2,x
eor P8ESTACK_HI+1,x
sta P8ESTACK_HI+2,x
inx
rts
.pend
and_b .proc
; -- logical and (of 2 bytes)
lda P8ESTACK_LO+2,x
beq +
lda #1
+ sta P8ZP_SCRATCH_B1
lda P8ESTACK_LO+1,x
beq +
lda #1
+ and P8ZP_SCRATCH_B1
inx
sta P8ESTACK_LO+1,x
rts
.pend
or_b .proc
; -- logical or (of 2 bytes)
lda P8ESTACK_LO+2,x
ora P8ESTACK_LO+1,x
beq +
lda #1
+ inx
sta P8ESTACK_LO+1,x
rts
.pend
xor_b .proc
; -- logical xor (of 2 bytes)
lda P8ESTACK_LO+2,x
beq +
lda #1
+ sta P8ZP_SCRATCH_B1
lda P8ESTACK_LO+1,x
beq +
lda #1
+ eor P8ZP_SCRATCH_B1
inx
sta P8ESTACK_LO+1,x
rts
.pend
and_w .proc
; -- logical and (word and word -> byte)
lda P8ESTACK_LO+2,x
ora P8ESTACK_HI+2,x
beq +
lda #1
+ sta P8ZP_SCRATCH_B1
lda P8ESTACK_LO+1,x
ora P8ESTACK_HI+1,x
beq +
lda #1
+ and P8ZP_SCRATCH_B1
inx
sta P8ESTACK_LO+1,x
sta P8ESTACK_HI+1,x
rts
.pend
or_w .proc
; -- logical or (word or word -> byte)
lda P8ESTACK_LO+2,x
ora P8ESTACK_LO+1,x
ora P8ESTACK_HI+2,x
ora P8ESTACK_HI+1,x
beq +
lda #1
+ inx
sta P8ESTACK_LO+1,x
sta P8ESTACK_HI+1,x
rts
.pend
xor_w .proc
; -- logical xor (word xor word -> byte)
lda P8ESTACK_LO+2,x
ora P8ESTACK_HI+2,x
beq +
lda #1
+ sta P8ZP_SCRATCH_B1
lda P8ESTACK_LO+1,x
ora P8ESTACK_HI+1,x
beq +
lda #1
+ eor P8ZP_SCRATCH_B1
inx
sta P8ESTACK_LO+1,x
sta P8ESTACK_HI+1,x
rts
.pend
add_w .proc
; -- push word+word / uword+uword
inx
clc
lda P8ESTACK_LO,x
adc P8ESTACK_LO+1,x
sta P8ESTACK_LO+1,x
lda P8ESTACK_HI,x
adc P8ESTACK_HI+1,x
sta P8ESTACK_HI+1,x
rts
.pend
sub_w .proc
; -- push word-word
inx
sec
lda P8ESTACK_LO+1,x
sbc P8ESTACK_LO,x
sta P8ESTACK_LO+1,x
lda P8ESTACK_HI+1,x
sbc P8ESTACK_HI,x
sta P8ESTACK_HI+1,x
rts
.pend
mul_byte .proc
; -- b*b->b (signed and unsigned)
inx
lda P8ESTACK_LO,x
ldy P8ESTACK_LO+1,x
jsr math.multiply_bytes
sta P8ESTACK_LO+1,x
rts
.pend
mul_word .proc
inx
lda P8ESTACK_LO,x
sta P8ZP_SCRATCH_W1
lda P8ESTACK_HI,x
sta P8ZP_SCRATCH_W1+1
lda P8ESTACK_LO+1,x
ldy P8ESTACK_HI+1,x
jsr math.multiply_words
lda math.multiply_words.result
sta P8ESTACK_LO+1,x
lda math.multiply_words.result+1
sta P8ESTACK_HI+1,x
rts
.pend
idiv_b .proc
; signed division: use unsigned division and fix sign of result afterwards
inx
lda P8ESTACK_LO,x
eor P8ESTACK_LO+1,x
php ; save sign of result
lda P8ESTACK_LO,x
bpl +
eor #$ff
sec
adc #0 ; make num1 positive
+ tay
inx
lda P8ESTACK_LO,x
bpl +
eor #$ff
sec
adc #0 ; make num2 positive
+ jsr math.divmod_ub_asm
sta _remainder
tya
plp ; get sign of result
bpl +
eor #$ff
sec
adc #0 ; negate result
+ sta P8ESTACK_LO,x
dex
rts
_remainder .byte 0
.pend
idiv_ub .proc
inx
ldy P8ESTACK_LO,x
lda P8ESTACK_LO+1,x
jsr math.divmod_ub_asm
tya
sta P8ESTACK_LO+1,x
rts
.pend
idiv_w .proc
; signed division: use unsigned division and fix sign of result afterwards
lda P8ESTACK_HI+2,x
eor P8ESTACK_HI+1,x
php ; save sign of result
lda P8ESTACK_HI+1,x
bpl +
jsr neg_w ; make value positive
+ inx
lda P8ESTACK_HI+1,x
bpl +
jsr neg_w ; make value positive
+ lda P8ESTACK_LO+1,x
sta P8ZP_SCRATCH_W1
lda P8ESTACK_HI+1,x
sta P8ZP_SCRATCH_W1+1
lda P8ESTACK_LO,x
ldy P8ESTACK_HI,x
jsr math.divmod_uw_asm
sta P8ESTACK_LO+1,x
tya
sta P8ESTACK_HI+1,x
plp
bpl +
jmp neg_w ; negate result
+ rts
.pend
idiv_uw .proc
inx
lda P8ESTACK_LO+1,x
sta P8ZP_SCRATCH_W1
lda P8ESTACK_HI+1,x
sta P8ZP_SCRATCH_W1+1
lda P8ESTACK_LO,x
ldy P8ESTACK_HI,x
jsr math.divmod_uw_asm
sta P8ESTACK_LO+1,x
tya
sta P8ESTACK_HI+1,x
rts
.pend
remainder_ub .proc
inx
ldy P8ESTACK_LO,x ; right operand
lda P8ESTACK_LO+1,x ; left operand
jsr math.divmod_ub_asm
sta P8ESTACK_LO+1,x
rts
.pend
remainder_uw .proc
inx
lda P8ESTACK_LO+1,x
sta P8ZP_SCRATCH_W1
lda P8ESTACK_HI+1,x
sta P8ZP_SCRATCH_W1+1
lda P8ESTACK_LO,x
ldy P8ESTACK_HI,x
jsr math.divmod_uw_asm
lda P8ZP_SCRATCH_W2
sta P8ESTACK_LO+1,x
lda P8ZP_SCRATCH_W2+1
sta P8ESTACK_HI+1,x
rts
.pend
equal_w .proc
; -- are the two words on the stack identical?
lda P8ESTACK_LO+1,x
cmp P8ESTACK_LO+2,x
bne equal_b._equal_b_false
lda P8ESTACK_HI+1,x
cmp P8ESTACK_HI+2,x
bne equal_b._equal_b_false
beq equal_b._equal_b_true
.pend
notequal_b .proc
; -- are the two bytes on the stack different?
lda P8ESTACK_LO+1,x
cmp P8ESTACK_LO+2,x
beq equal_b._equal_b_false
bne equal_b._equal_b_true
.pend
notequal_w .proc
; -- are the two words on the stack different?
lda P8ESTACK_HI+1,x
cmp P8ESTACK_HI+2,x
beq notequal_b
bne equal_b._equal_b_true
.pend
less_ub .proc
lda P8ESTACK_LO+2,x
cmp P8ESTACK_LO+1,x
bcc equal_b._equal_b_true
bcs equal_b._equal_b_false
.pend
less_b .proc
; see http://www.6502.org/tutorials/compare_beyond.html
lda P8ESTACK_LO+2,x
sec
sbc P8ESTACK_LO+1,x
bvc +
eor #$80
+ bmi equal_b._equal_b_true
bpl equal_b._equal_b_false
.pend
reg_less_uw .proc
; AY < P8ZP_SCRATCH_W2?
cpy P8ZP_SCRATCH_W2+1
bcc _true
bne _false
cmp P8ZP_SCRATCH_W2
bcc _true
_false lda #0
rts
_true lda #1
rts
.pend
less_uw .proc
lda P8ESTACK_HI+2,x
cmp P8ESTACK_HI+1,x
bcc equal_b._equal_b_true
bne equal_b._equal_b_false
lda P8ESTACK_LO+2,x
cmp P8ESTACK_LO+1,x
bcc equal_b._equal_b_true
bcs equal_b._equal_b_false
.pend
reg_less_w .proc
; -- AY < P8ZP_SCRATCH_W2?
cmp P8ZP_SCRATCH_W2
tya
sbc P8ZP_SCRATCH_W2+1
bvc +
eor #$80
+ bmi _true
lda #0
rts
_true lda #1
rts
.pend
less_w .proc
lda P8ESTACK_LO+2,x
cmp P8ESTACK_LO+1,x
lda P8ESTACK_HI+2,x
sbc P8ESTACK_HI+1,x
bvc +
eor #$80
+ bmi equal_b._equal_b_true
bpl equal_b._equal_b_false
.pend
equal_b .proc
; -- are the two bytes on the stack identical?
lda P8ESTACK_LO+2,x
cmp P8ESTACK_LO+1,x
bne _equal_b_false
_equal_b_true lda #1
_equal_b_store inx
sta P8ESTACK_LO+1,x
rts
_equal_b_false lda #0
beq _equal_b_store
.pend
lesseq_ub .proc
lda P8ESTACK_LO+1,x
cmp P8ESTACK_LO+2,x
bcs equal_b._equal_b_true
bcc equal_b._equal_b_false
.pend
lesseq_b .proc
; see http://www.6502.org/tutorials/compare_beyond.html
lda P8ESTACK_LO+2,x
clc
sbc P8ESTACK_LO+1,x
bvc +
eor #$80
+ bmi equal_b._equal_b_true
bpl equal_b._equal_b_false
.pend
reg_lesseq_uw .proc
; AY <= P8ZP_SCRATCH_W2?
cpy P8ZP_SCRATCH_W2+1
beq +
bcc _true
lda #0
rts
+ cmp P8ZP_SCRATCH_W2
bcc _true
beq _true
lda #0
rts
_true lda #1
rts
.pend
lesseq_uw .proc
lda P8ESTACK_HI+1,x
cmp P8ESTACK_HI+2,x
bcc equal_b._equal_b_false
bne equal_b._equal_b_true
lda P8ESTACK_LO+1,x
cmp P8ESTACK_LO+2,x
bcs equal_b._equal_b_true
bcc equal_b._equal_b_false
.pend
reg_lesseq_w .proc
; -- P8ZP_SCRATCH_W2 <= AY ? (note: order different from other routines)
cmp P8ZP_SCRATCH_W2
tya
sbc P8ZP_SCRATCH_W2+1
bvc +
eor #$80
+ bpl +
lda #0
rts
+ lda #1
rts
.pend
lesseq_w .proc
lda P8ESTACK_LO+1,x
cmp P8ESTACK_LO+2,x
lda P8ESTACK_HI+1,x
sbc P8ESTACK_HI+2,x
bvc +
eor #$80
+ bpl equal_b._equal_b_true
bmi equal_b._equal_b_false
.pend
greater_ub .proc
lda P8ESTACK_LO+2,x
cmp P8ESTACK_LO+1,x
beq equal_b._equal_b_false
bcs equal_b._equal_b_true
bcc equal_b._equal_b_false
.pend
greater_b .proc
; see http://www.6502.org/tutorials/compare_beyond.html
lda P8ESTACK_LO+2,x
clc
sbc P8ESTACK_LO+1,x
bvc +
eor #$80
+ bpl equal_b._equal_b_true
bmi equal_b._equal_b_false
.pend
greater_uw .proc
lda P8ESTACK_HI+1,x
cmp P8ESTACK_HI+2,x
bcc equal_b._equal_b_true
bne equal_b._equal_b_false
lda P8ESTACK_LO+1,x
cmp P8ESTACK_LO+2,x
bcc equal_b._equal_b_true
bcs equal_b._equal_b_false
.pend
greater_w .proc
lda P8ESTACK_LO+1,x
cmp P8ESTACK_LO+2,x
lda P8ESTACK_HI+1,x
sbc P8ESTACK_HI+2,x
bvc +
eor #$80
+ bmi equal_b._equal_b_true
bpl equal_b._equal_b_false
.pend
greatereq_ub .proc
lda P8ESTACK_LO+2,x
cmp P8ESTACK_LO+1,x
bcs equal_b._equal_b_true
bcc equal_b._equal_b_false
.pend
greatereq_b .proc
; see http://www.6502.org/tutorials/compare_beyond.html
lda P8ESTACK_LO+2,x
sec
sbc P8ESTACK_LO+1,x
bvc +
eor #$80
+ bpl equal_b._equal_b_true
bmi equal_b._equal_b_false
.pend
greatereq_uw .proc
lda P8ESTACK_HI+2,x
cmp P8ESTACK_HI+1,x
bcc equal_b._equal_b_false
bne equal_b._equal_b_true
lda P8ESTACK_LO+2,x
cmp P8ESTACK_LO+1,x
bcs equal_b._equal_b_true
bcc equal_b._equal_b_false
.pend
greatereq_w .proc
lda P8ESTACK_LO+2,x
cmp P8ESTACK_LO+1,x
lda P8ESTACK_HI+2,x
sbc P8ESTACK_HI+1,x
bvc +
eor #$80
+ bmi equal_b._equal_b_false
bpl equal_b._equal_b_true
.pend
shiftleft_b .proc
inx
ldy P8ESTACK_LO,x
bne +
rts
+ lda P8ESTACK_LO+1,x
- asl a
dey
bne -
sta P8ESTACK_LO+1,x
rts
.pend
shiftright_b .proc
inx
ldy P8ESTACK_LO,x
bne +
rts
+ lda P8ESTACK_LO+1,x
- lsr a
dey
bne -
sta P8ESTACK_LO+1,x
rts
.pend
equalzero_b .proc
lda P8ESTACK_LO+1,x
beq _true
bne _false
_true lda #1
sta P8ESTACK_LO+1,x
rts
_false lda #0
sta P8ESTACK_LO+1,x
rts
.pend
equalzero_w .proc
lda P8ESTACK_LO+1,x
ora P8ESTACK_HI+1,x
beq equalzero_b._true
bne equalzero_b._false
.pend
notequalzero_b .proc
lda P8ESTACK_LO+1,x
beq equalzero_b._false
bne equalzero_b._true
.pend
notequalzero_w .proc
lda P8ESTACK_LO+1,x
ora P8ESTACK_HI+1,x
beq equalzero_b._false
bne equalzero_b._true
.pend
lesszero_b .proc
lda P8ESTACK_LO+1,x
bmi equalzero_b._true
jmp equalzero_b._false
.pend
lesszero_w .proc
lda P8ESTACK_HI+1,x
bmi equalzero_b._true
jmp equalzero_b._false
.pend
greaterzero_ub .proc
lda P8ESTACK_LO+1,x
bne equalzero_b._true
beq equalzero_b._false
.pend
greaterzero_sb .proc
lda P8ESTACK_LO+1,x
beq equalzero_b._false
bpl equalzero_b._true
bmi equalzero_b._false
.pend
greaterzero_uw .proc
lda P8ESTACK_LO+1,x
ora P8ESTACK_HI+1,x
bne equalzero_b._true
beq equalzero_b._false
.pend
greaterzero_sw .proc
lda P8ESTACK_HI+1,x
bmi equalzero_b._false
ora P8ESTACK_LO+1,x
beq equalzero_b._false
bne equalzero_b._true
.pend
lessequalzero_sb .proc
lda P8ESTACK_LO+1,x
bmi equalzero_b._true
beq equalzero_b._true
bne equalzero_b._false
.pend
lessequalzero_sw .proc
lda P8ESTACK_HI+1,x
bmi equalzero_b._true
ora P8ESTACK_LO+1,x
beq equalzero_b._true
bne equalzero_b._false
.pend
greaterequalzero_sb .proc
lda P8ESTACK_LO+1,x
bpl equalzero_b._true
bmi equalzero_b._false
.pend
greaterequalzero_sw .proc
lda P8ESTACK_HI+1,x
bmi equalzero_b._false
ora P8ESTACK_LO+1,x
beq equalzero_b._true
bne equalzero_b._false
.pend
memcopy16_up .proc
; -- copy memory UP from (P8ZP_SCRATCH_W1) to (P8ZP_SCRATCH_W2) of length X/Y (16-bit, X=lo, Y=hi)
; clobbers register A,X,Y
source = P8ZP_SCRATCH_W1
dest = P8ZP_SCRATCH_W2
length = P8ZP_SCRATCH_B1 ; (and SCRATCH_ZPREG)
stx length
sty length+1
ldx length ; move low byte of length into X
bne + ; jump to start if X > 0
dec length ; subtract 1 from length
+ ldy #0 ; set Y to 0
- lda (source),y ; set A to whatever (source) points to offset by Y
sta (dest),y ; move A to location pointed to by (dest) offset by Y
iny ; increment Y
bne + ; if Y<>0 then (rolled over) then still moving bytes
inc source+1 ; increment hi byte of source
inc dest+1 ; increment hi byte of dest
+ dex ; decrement X (lo byte counter)
bne - ; if X<>0 then move another byte
dec length ; we've moved 255 bytes, dec length
bpl - ; if length is still positive go back and move more
rts ; done
.pend
memset .proc
; -- fill memory from (P8ZP_SCRATCH_W1), length XY, with value in A.
; clobbers X, Y
stx P8ZP_SCRATCH_B1
sty _save_reg
ldy #0
ldx _save_reg
beq _lastpage
_fullpage sta (P8ZP_SCRATCH_W1),y
iny
bne _fullpage
inc P8ZP_SCRATCH_W1+1 ; next page
dex
bne _fullpage
_lastpage ldy P8ZP_SCRATCH_B1
beq +
- dey
sta (P8ZP_SCRATCH_W1),y
bne -
+ rts
_save_reg .byte 0
.pend
memsetw .proc
; -- fill memory from (P8ZP_SCRATCH_W1) number of words in P8ZP_SCRATCH_W2, with word value in AY.
; clobbers A, X, Y
sta _mod1+1 ; self-modify
sty _mod1b+1 ; self-modify
sta _mod2+1 ; self-modify
sty _mod2b+1 ; self-modify
ldx P8ZP_SCRATCH_W1
stx P8ZP_SCRATCH_B1
ldx P8ZP_SCRATCH_W1+1
inx
stx P8ZP_SCRATCH_REG ; second page
ldy #0
ldx P8ZP_SCRATCH_W2+1
beq _lastpage
_fullpage
_mod1 lda #0 ; self-modified
sta (P8ZP_SCRATCH_W1),y ; first page
sta (P8ZP_SCRATCH_B1),y ; second page
iny
_mod1b lda #0 ; self-modified
sta (P8ZP_SCRATCH_W1),y ; first page
sta (P8ZP_SCRATCH_B1),y ; second page
iny
bne _fullpage
inc P8ZP_SCRATCH_W1+1 ; next page pair
inc P8ZP_SCRATCH_W1+1 ; next page pair
inc P8ZP_SCRATCH_B1+1 ; next page pair
inc P8ZP_SCRATCH_B1+1 ; next page pair
dex
bne _fullpage
_lastpage ldx P8ZP_SCRATCH_W2
beq _done
ldy #0
-
_mod2 lda #0 ; self-modified
sta (P8ZP_SCRATCH_W1), y
inc P8ZP_SCRATCH_W1
bne _mod2b
inc P8ZP_SCRATCH_W1+1
_mod2b lda #0 ; self-modified
sta (P8ZP_SCRATCH_W1), y
inc P8ZP_SCRATCH_W1
bne +
inc P8ZP_SCRATCH_W1+1
+ dex
bne -
_done rts
.pend
ror2_mem_ub .proc
; -- in-place 8-bit ror of byte at memory location in AY
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
lda (P8ZP_SCRATCH_W1),y
lsr a
bcc +
ora #$80
+ sta (P8ZP_SCRATCH_W1),y
rts
.pend
rol2_mem_ub .proc
; -- in-place 8-bit rol of byte at memory location in AY
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
lda (P8ZP_SCRATCH_W1),y
cmp #$80
rol a
sta (P8ZP_SCRATCH_W1),y
rts
.pend
rol_array_ub .proc
; -- rol a ubyte in an array
lda _arg_target
ldy _arg_target+1
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy _arg_index
lda (P8ZP_SCRATCH_W1),y
rol a
sta (P8ZP_SCRATCH_W1),y
rts
_arg_target .word 0
_arg_index .byte 0
.pend
ror_array_ub .proc
; -- ror a ubyte in an array
lda _arg_target
ldy _arg_target+1
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy _arg_index
lda (P8ZP_SCRATCH_W1),y
ror a
sta (P8ZP_SCRATCH_W1),y
rts
_arg_target .word 0
_arg_index .byte 0
.pend
ror2_array_ub .proc
; -- ror2 (8-bit ror) a ubyte in an array
lda _arg_target
ldy _arg_target+1
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy _arg_index
lda (P8ZP_SCRATCH_W1),y
lsr a
bcc +
ora #$80
+ sta (P8ZP_SCRATCH_W1),y
rts
_arg_target .word 0
_arg_index .byte 0
.pend
rol2_array_ub .proc
; -- rol2 (8-bit rol) a ubyte in an array
lda _arg_target
ldy _arg_target+1
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy _arg_index
lda (P8ZP_SCRATCH_W1),y
cmp #$80
rol a
sta (P8ZP_SCRATCH_W1),y
rts
_arg_target .word 0
_arg_index .byte 0
.pend
ror_array_uw .proc
; -- ror a uword in an array
php
lda _arg_target
ldy _arg_target+1
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda _arg_index
asl a
tay
iny
lda (P8ZP_SCRATCH_W1),y
plp
ror a
sta (P8ZP_SCRATCH_W1),y
dey
lda (P8ZP_SCRATCH_W1),y
ror a
sta (P8ZP_SCRATCH_W1),y
rts
_arg_target .word 0
_arg_index .byte 0
.pend
rol_array_uw .proc
; -- rol a uword in an array
php
lda _arg_target
ldy _arg_target+1
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda _arg_index
asl a
tay
lda (P8ZP_SCRATCH_W1),y
plp
rol a
sta (P8ZP_SCRATCH_W1),y
iny
lda (P8ZP_SCRATCH_W1),y
rol a
sta (P8ZP_SCRATCH_W1),y
rts
_arg_target .word 0
_arg_index .byte 0
.pend
rol2_array_uw .proc
; -- rol2 (16-bit rol) a uword in an array
lda _arg_target
ldy _arg_target+1
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda _arg_index
asl a
tay
lda (P8ZP_SCRATCH_W1),y
asl a
sta (P8ZP_SCRATCH_W1),y
iny
lda (P8ZP_SCRATCH_W1),y
rol a
sta (P8ZP_SCRATCH_W1),y
bcc +
dey
lda (P8ZP_SCRATCH_W1),y
adc #0
sta (P8ZP_SCRATCH_W1),y
+ rts
_arg_target .word 0
_arg_index .byte 0
.pend
ror2_array_uw .proc
; -- ror2 (16-bit ror) a uword in an array
lda _arg_target
ldy _arg_target+1
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda _arg_index
asl a
tay
iny
lda (P8ZP_SCRATCH_W1),y
lsr a
sta (P8ZP_SCRATCH_W1),y
dey
lda (P8ZP_SCRATCH_W1),y
ror a
sta (P8ZP_SCRATCH_W1),y
bcc +
iny
lda (P8ZP_SCRATCH_W1),y
ora #$80
sta (P8ZP_SCRATCH_W1),y
+ rts
_arg_target .word 0
_arg_index .byte 0
.pend
strcpy .proc
; copy a string (must be 0-terminated) from A/Y to (P8ZP_SCRATCH_W1)
; it is assumed the target string is large enough.
; returns the length of the string that was copied in Y.
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #$ff
- iny
lda (P8ZP_SCRATCH_W2),y
sta (P8ZP_SCRATCH_W1),y
bne -
rts
.pend
strcmp_expression .proc
; -- compare strings, result in A
lda _arg_s2
ldy _arg_s2+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
lda _arg_s1
ldy _arg_s1+1
jmp strcmp_mem
_arg_s1 .word 0
_arg_s2 .word 0
.pend
strcmp_mem .proc
; -- compares strings in s1 (AY) and s2 (P8ZP_SCRATCH_W2).
; Returns -1,0,1 in A, depeding on the ordering. Clobbers Y.
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
_loop lda (P8ZP_SCRATCH_W1),y
bne +
lda (P8ZP_SCRATCH_W2),y
bne _return_minusone
beq _return
+ cmp (P8ZP_SCRATCH_W2),y
bcc _return_minusone
bne _return_one
inc P8ZP_SCRATCH_W1
bne +
inc P8ZP_SCRATCH_W1+1
+ inc P8ZP_SCRATCH_W2
bne _loop
inc P8ZP_SCRATCH_W2+1
bne _loop
_return_one
lda #1
_return rts
_return_minusone
lda #-1
rts
.pend
sign_extend_stack_byte .proc
; -- sign extend the (signed) byte on the stack to full 16 bits
lda P8ESTACK_LO+1,x
ora #$7f
bmi +
lda #0
+ sta P8ESTACK_HI+1,x
rts
.pend
strlen .proc
; -- returns the number of bytes in the string in AY, in Y.
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
- lda (P8ZP_SCRATCH_W1),y
beq +
iny
bne -
+ rts
.pend
containment_bytearray .proc
; -- check if a value exists in a byte array.
; parameters: P8ZP_SCRATCH_W1: address of the byte array, A = byte to check, Y = length of array (>=1).
; returns boolean 0/1 in A.
dey
- cmp (P8ZP_SCRATCH_W1),y
beq +
dey
cpy #255
bne -
lda #0
rts
+ lda #1
rts
.pend
containment_wordarray .proc
; -- check if a value exists in a word array.
; parameters: P8ZP_SCRATCH_W1: value to check, P8ZP_SCRATCH_W2: address of the word array, Y = length of array (>=1).
; returns boolean 0/1 in A.
dey
tya
asl a
tay
- lda P8ZP_SCRATCH_W1
cmp (P8ZP_SCRATCH_W2),y
bne +
lda P8ZP_SCRATCH_W1+1
iny
cmp (P8ZP_SCRATCH_W2),y
beq _found
+ dey
dey
cpy #254
bne -
lda #0
rts
_found lda #1
rts
.pend
Reference in New Issue View Git Blame Copy Permalink