Apple-2-SW/prog8
1
0
Fork 0
mirror of https://github.com/irmen/prog8.git synced 2024-12-27 05:29:38 +00:00
Code Issues Projects Releases Wiki Activity
4700a239b9
prog8/compiler/test/arithmetic/sgn.asm
Irmen de Jong 56c1035581 Merge branch 'master' into multi-assign 
# Conflicts:
#	docs/source/todo.rst
#	examples/test.p8
2024-03-26 22:09:16 +01:00

6601 lines
128 KiB
NASM
Raw Blame History

; w65c02 assembly code for 'sgn'
; generated by prog8.codegen.cpu6502.ProgramAndVarsGen on 2024-03-13T21:13:58
; assembler syntax is for the 64tasm cross-assembler
; output options: output=PRG launcher=BASIC zp=BASICSAFE
.cpu 'w65c02'
.enc 'none'
P8ZP_SCRATCH_B1 = 122
P8ZP_SCRATCH_REG = 123
P8ZP_SCRATCH_W1 = 124 ; word
P8ZP_SCRATCH_W2 = 126 ; word
.weak
.endweak
; ---- basic program with sys call ----
* = $0801
.word (+), 2024
.null $9e, format(' %d ', prog8_entrypoint), $3a, $8f, ' prog8'
+ .word 0
prog8_entrypoint ; assembly code starts here
jsr sys.init_system
jsr sys.init_system_phase2
lda #4
sta $01
jsr p8b_main.p8s_start
jmp sys.cleanup_at_exit
; ---- block: 'p8b_main' ----
p8b_main .proc
p8s_start .proc
p8v_w2 = 34 ; zp WORD
p8v_w1 = 36 ; zp WORD
p8v_uw2 = 38 ; zp UWORD
p8v_uw1 = 40 ; zp UWORD
p8v_ub2 = 42 ; zp UBYTE
p8v_ub1 = 43 ; zp UBYTE
p8v_b2 = 44 ; zp BYTE
p8v_b1 = 45 ; zp BYTE
; program startup initialization
cld
tsx
stx prog8_lib.orig_stackpointer ; required for sys.exit()
.if prog8_bss_section_size>0
; reset all variables in BSS section to zero
lda #<prog8_bss_section_start
ldy #>prog8_bss_section_start
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldx #<prog8_bss_section_size
ldy #>prog8_bss_section_size
lda #0
jsr prog8_lib.memset
.endif
+
clv
clc
; statements
stz p8v_b1
stz p8v_b2
stz p8v_ub1
stz p8v_ub2
stz p8v_w1
stz p8v_w1+1
stz p8v_w2
stz p8v_w2+1
stz p8v_uw1
stz p8v_uw1+1
stz p8v_uw2
stz p8v_uw2+1
stz p8v_f1
stz p8v_f1+1
stz p8v_f1+2
stz p8v_f1+3
stz p8v_f1+4
stz p8v_f2
stz p8v_f2+1
stz p8v_f2+2
stz p8v_f2+3
stz p8v_f2+4
lda #10
sta p8v_b1
sta p8v_b2
sec
sbc p8v_b1
jsr prog8_lib.func_sign_b_into_A
cmp #0
beq label_asm_1_afterif
ldy #>prog8_interned_strings.string_1
lda #<prog8_interned_strings.string_1
jsr txt.print
label_asm_1_afterif
lda #-$64
sta p8v_b1
sta p8v_b2
sec
sbc p8v_b1
jsr prog8_lib.func_sign_b_into_A
cmp #0
beq label_asm_2_afterif
ldy #>prog8_interned_strings.string_2
lda #<prog8_interned_strings.string_2
jsr txt.print
label_asm_2_afterif
lda #$c8
sta p8v_ub1
sta p8v_ub2
sec
sbc p8v_ub1
jsr prog8_lib.func_sign_ub_into_A
cmp #0
beq label_asm_3_afterif
ldy #>prog8_interned_strings.string_3
lda #<prog8_interned_strings.string_3
jsr txt.print
label_asm_3_afterif
lda #<$64
ldy #>$64
sta p8v_w1
sty p8v_w1+1
sta p8v_w2
sty p8v_w2+1
sec
sbc p8v_w1
tax
tya
sbc p8v_w1+1
tay
txa
jsr prog8_lib.func_sign_w_into_A
cmp #0
beq label_asm_4_afterif
ldy #>prog8_interned_strings.string_4
lda #<prog8_interned_strings.string_4
jsr txt.print
label_asm_4_afterif
lda #<-$07d0
ldy #>-$07d0
sta p8v_w1
sty p8v_w1+1
sta p8v_w2
sty p8v_w2+1
sec
sbc p8v_w1
tax
tya
sbc p8v_w1+1
tay
txa
jsr prog8_lib.func_sign_w_into_A
cmp #0
beq label_asm_5_afterif
ldy #>prog8_interned_strings.string_5
lda #<prog8_interned_strings.string_5
jsr txt.print
label_asm_5_afterif
lda #<$03e7
ldy #>$03e7
sta p8v_uw1
sty p8v_uw1+1
sta p8v_uw2
sty p8v_uw2+1
sec
sbc p8v_uw1
tax
tya
sbc p8v_uw1+1
tay
txa
jsr prog8_lib.func_sign_uw_into_A
cmp #0
beq label_asm_6_afterif
ldy #>prog8_interned_strings.string_6
lda #<prog8_interned_strings.string_6
jsr txt.print
label_asm_6_afterif
lda #<prog8_float_const_0
ldy #>prog8_float_const_0
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda #<p8v_f1
ldy #>p8v_f1
jsr floats.copy_float
lda #<p8v_f2
ldy #>p8v_f2
jsr floats.copy_float
lda #<p8v_f1
ldy #>p8v_f1
jsr floats.MOVFM
lda #<p8v_f2
ldy #>p8v_f2
jsr floats.CONUPK
jsr floats.FSUBT
ldx #<prog8_float_eval_result2
ldy #>prog8_float_eval_result2
jsr floats.MOVMF
ldy #>prog8_float_eval_result2
lda #<prog8_float_eval_result2
jsr floats.func_sign_f_into_A
cmp #0
beq label_asm_7_afterif
ldy #>prog8_interned_strings.string_7
lda #<prog8_interned_strings.string_7
jsr txt.print
label_asm_7_afterif
lda #11
sta p8v_b1
lda #10
sta p8v_b2
sec
sbc p8v_b1
jsr prog8_lib.func_sign_b_into_A
cmp #-1
beq label_asm_8_afterif
ldy #>prog8_interned_strings.string_8
lda #<prog8_interned_strings.string_8
jsr txt.print
label_asm_8_afterif
lda #-10
sta p8v_b1
lda #-$64
sta p8v_b2
sec
sbc p8v_b1
jsr prog8_lib.func_sign_b_into_A
cmp #-1
beq label_asm_9_afterif
ldy #>prog8_interned_strings.string_9
lda #<prog8_interned_strings.string_9
jsr txt.print
label_asm_9_afterif
lda #$ca
sta p8v_ub1
lda #$c8
sta p8v_ub2
pha
lda p8v_ub1
sta P8ZP_SCRATCH_B1
pla
sec
sbc P8ZP_SCRATCH_B1
jsr prog8_lib.func_sign_b_into_A
cmp #-1
beq label_asm_10_afterif
ldy #>prog8_interned_strings.string_10
lda #<prog8_interned_strings.string_10
jsr txt.print
label_asm_10_afterif
lda #<$65
ldy #>$65
sta p8v_w1
sty p8v_w1+1
lda #<$64
ldy #>$64
sta p8v_w2
sty p8v_w2+1
sec
sbc p8v_w1
tax
tya
sbc p8v_w1+1
tay
txa
jsr prog8_lib.func_sign_w_into_A
cmp #-1
beq label_asm_11_afterif
ldy #>prog8_interned_strings.string_11
lda #<prog8_interned_strings.string_11
jsr txt.print
label_asm_11_afterif
lda #<-$c8
ldy #>-$c8
sta p8v_w1
sty p8v_w1+1
lda #<-$07d0
ldy #>-$07d0
sta p8v_w2
sty p8v_w2+1
sec
sbc p8v_w1
tax
tya
sbc p8v_w1+1
tay
txa
jsr prog8_lib.func_sign_w_into_A
cmp #-1
beq label_asm_12_afterif
ldy #>prog8_interned_strings.string_12
lda #<prog8_interned_strings.string_12
jsr txt.print
label_asm_12_afterif
lda #<$08ae
ldy #>$08ae
sta p8v_uw1
sty p8v_uw1+1
lda #<$03e7
ldy #>$03e7
sta p8v_uw2
sty p8v_uw2+1
lda p8v_uw1
sta P8ZP_SCRATCH_W1
lda p8v_uw1+1
sta P8ZP_SCRATCH_W1+1
ldy p8v_uw2+1
lda p8v_uw2
sec
sbc P8ZP_SCRATCH_W1
tax
tya
sbc P8ZP_SCRATCH_W1+1
tay
txa
jsr prog8_lib.func_sign_w_into_A
cmp #-1
beq label_asm_13_afterif
ldy #>prog8_interned_strings.string_13
lda #<prog8_interned_strings.string_13
jsr txt.print
label_asm_13_afterif
ldy p8v_uw2+1
lda p8v_uw2
sec
sbc p8v_uw1
tax
tya
sbc p8v_uw1+1
tay
txa
jsr prog8_lib.func_sign_uw_into_A
cmp #1
beq label_asm_14_afterif
ldy #>prog8_interned_strings.string_14
lda #<prog8_interned_strings.string_14
jsr txt.print
label_asm_14_afterif
lda #<prog8_float_const_0
ldy #>prog8_float_const_0
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda #<p8v_f1
ldy #>p8v_f1
jsr floats.copy_float
lda #<prog8_float_const_1
ldy #>prog8_float_const_1
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda #<p8v_f2
ldy #>p8v_f2
jsr floats.copy_float
lda #<p8v_f1
ldy #>p8v_f1
jsr floats.MOVFM
lda #<p8v_f2
ldy #>p8v_f2
jsr floats.CONUPK
jsr floats.FSUBT
ldx #<prog8_float_eval_result2
ldy #>prog8_float_eval_result2
jsr floats.MOVMF
ldy #>prog8_float_eval_result2
lda #<prog8_float_eval_result2
jsr floats.func_sign_f_into_A
cmp #-1
beq label_asm_15_afterif
ldy #>prog8_interned_strings.string_15
lda #<prog8_interned_strings.string_15
jsr txt.print
label_asm_15_afterif
lda #11
sta p8v_b1
lda #$14
sta p8v_b2
sec
sbc p8v_b1
jsr prog8_lib.func_sign_b_into_A
cmp #1
beq label_asm_16_afterif
ldy #>prog8_interned_strings.string_16
lda #<prog8_interned_strings.string_16
jsr txt.print
label_asm_16_afterif
lda #-10
sta p8v_b1
lda #-1
sta p8v_b2
sec
sbc p8v_b1
jsr prog8_lib.func_sign_b_into_A
cmp #1
beq label_asm_17_afterif
ldy #>prog8_interned_strings.string_17
lda #<prog8_interned_strings.string_17
jsr txt.print
label_asm_17_afterif
lda #$ca
sta p8v_ub1
lda #$cd
sta p8v_ub2
sec
sbc p8v_ub1
jsr prog8_lib.func_sign_ub_into_A
cmp #1
beq label_asm_18_afterif
ldy #>prog8_interned_strings.string_18
lda #<prog8_interned_strings.string_18
jsr txt.print
label_asm_18_afterif
lda #<$65
ldy #>$65
sta p8v_w1
sty p8v_w1+1
lda #<$c8
ldy #>$c8
sta p8v_w2
sty p8v_w2+1
sec
sbc p8v_w1
tax
tya
sbc p8v_w1+1
tay
txa
jsr prog8_lib.func_sign_w_into_A
cmp #1
beq label_asm_19_afterif
ldy #>prog8_interned_strings.string_19
lda #<prog8_interned_strings.string_19
jsr txt.print
label_asm_19_afterif
lda #<-$c8
ldy #>-$c8
sta p8v_w1
sty p8v_w1+1
lda #<-$14
ldy #>-$14
sta p8v_w2
sty p8v_w2+1
sec
sbc p8v_w1
tax
tya
sbc p8v_w1+1
tay
txa
jsr prog8_lib.func_sign_w_into_A
cmp #1
beq label_asm_20_afterif
ldy #>prog8_interned_strings.string_20
lda #<prog8_interned_strings.string_20
jsr txt.print
label_asm_20_afterif
lda #<$08ae
ldy #>$08ae
sta p8v_uw1
sty p8v_uw1+1
lda #<$270f
ldy #>$270f
sta p8v_uw2
sty p8v_uw2+1
sec
sbc p8v_uw1
tax
tya
sbc p8v_uw1+1
tay
txa
jsr prog8_lib.func_sign_uw_into_A
cmp #1
beq label_asm_21_afterif
ldy #>prog8_interned_strings.string_21
lda #<prog8_interned_strings.string_21
jsr txt.print
label_asm_21_afterif
lda #<prog8_float_const_0
ldy #>prog8_float_const_0
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda #<p8v_f1
ldy #>p8v_f1
jsr floats.copy_float
lda #<prog8_float_const_2
ldy #>prog8_float_const_2
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda #<p8v_f2
ldy #>p8v_f2
jsr floats.copy_float
lda #<p8v_f1
ldy #>p8v_f1
jsr floats.MOVFM
lda #<p8v_f2
ldy #>p8v_f2
jsr floats.CONUPK
jsr floats.FSUBT
ldx #<prog8_float_eval_result2
ldy #>prog8_float_eval_result2
jsr floats.MOVMF
ldy #>prog8_float_eval_result2
lda #<prog8_float_eval_result2
jsr floats.func_sign_f_into_A
cmp #1
beq label_asm_22_afterif
ldy #>prog8_interned_strings.string_22
lda #<prog8_interned_strings.string_22
jsr txt.print
label_asm_22_afterif
ldy #>prog8_interned_strings.string_23
lda #<prog8_interned_strings.string_23
jmp txt.print
; variables
.section BSS
prog8_float_eval_result2 .fill 5
.send BSS
; non-zeropage variables without initialization value
.section BSS
p8v_f1 .fill 5
p8v_f2 .fill 5
.send BSS
.pend
.pend
; ---- block: 'prog8_interned_strings' ----
prog8_interned_strings .proc
; non-zeropage variables
string_1 ; PETSCII:"sgn1 error1\n"
.byte $53, $47, $4e, $31, $20, $45, $52, $52, $4f, $52, $31, $0d, $00
string_10 ; PETSCII:"sgn2 error3\n"
.byte $53, $47, $4e, $32, $20, $45, $52, $52, $4f, $52, $33, $0d, $00
string_11 ; PETSCII:"sgn2 error4\n"
.byte $53, $47, $4e, $32, $20, $45, $52, $52, $4f, $52, $34, $0d, $00
string_12 ; PETSCII:"sgn2 error5\n"
.byte $53, $47, $4e, $32, $20, $45, $52, $52, $4f, $52, $35, $0d, $00
string_13 ; PETSCII:"sgn2 error6a\n"
.byte $53, $47, $4e, $32, $20, $45, $52, $52, $4f, $52, $36, $41, $0d, $00
string_14 ; PETSCII:"sgn2 error6b\n"
.byte $53, $47, $4e, $32, $20, $45, $52, $52, $4f, $52, $36, $42, $0d, $00
string_15 ; PETSCII:"sgn2 error7\n"
.byte $53, $47, $4e, $32, $20, $45, $52, $52, $4f, $52, $37, $0d, $00
string_16 ; PETSCII:"sgn3 error1\n"
.byte $53, $47, $4e, $33, $20, $45, $52, $52, $4f, $52, $31, $0d, $00
string_17 ; PETSCII:"sgn3 error2\n"
.byte $53, $47, $4e, $33, $20, $45, $52, $52, $4f, $52, $32, $0d, $00
string_18 ; PETSCII:"sgn3 error3\n"
.byte $53, $47, $4e, $33, $20, $45, $52, $52, $4f, $52, $33, $0d, $00
string_19 ; PETSCII:"sgn3 error4\n"
.byte $53, $47, $4e, $33, $20, $45, $52, $52, $4f, $52, $34, $0d, $00
string_2 ; PETSCII:"sgn1 error2\n"
.byte $53, $47, $4e, $31, $20, $45, $52, $52, $4f, $52, $32, $0d, $00
string_20 ; PETSCII:"sgn3 error5\n"
.byte $53, $47, $4e, $33, $20, $45, $52, $52, $4f, $52, $35, $0d, $00
string_21 ; PETSCII:"sgn3 error6\n"
.byte $53, $47, $4e, $33, $20, $45, $52, $52, $4f, $52, $36, $0d, $00
string_22 ; PETSCII:"sgn3 error7\n"
.byte $53, $47, $4e, $33, $20, $45, $52, $52, $4f, $52, $37, $0d, $00
string_23 ; PETSCII:"should see no sgn errors\n"
.byte $53, $48, $4f, $55, $4c, $44, $20, $53, $45, $45, $20, $4e, $4f, $20, $53, $47
.byte $4e, $20, $45, $52, $52, $4f, $52, $53, $0d, $00
string_3 ; PETSCII:"sgn1 error3\n"
.byte $53, $47, $4e, $31, $20, $45, $52, $52, $4f, $52, $33, $0d, $00
string_4 ; PETSCII:"sgn1 error4\n"
.byte $53, $47, $4e, $31, $20, $45, $52, $52, $4f, $52, $34, $0d, $00
string_5 ; PETSCII:"sgn1 error5\n"
.byte $53, $47, $4e, $31, $20, $45, $52, $52, $4f, $52, $35, $0d, $00
string_6 ; PETSCII:"sgn1 error6\n"
.byte $53, $47, $4e, $31, $20, $45, $52, $52, $4f, $52, $36, $0d, $00
string_7 ; PETSCII:"sgn1 error7\n"
.byte $53, $47, $4e, $31, $20, $45, $52, $52, $4f, $52, $37, $0d, $00
string_8 ; PETSCII:"sgn2 error1\n"
.byte $53, $47, $4e, $32, $20, $45, $52, $52, $4f, $52, $31, $0d, $00
string_9 ; PETSCII:"sgn2 error2\n"
.byte $53, $47, $4e, $32, $20, $45, $52, $52, $4f, $52, $32, $0d, $00
.pend
; ---- block: 'floats' ----
floats .proc
AYINT_facmo = $c6
PI = 3.141592653589793
TWOPI = 6.283185307179586
π = 3.141592653589793
AYINT = $fe00
GIVAYF = $fe03
FOUT = $fe06
VAL_1 = $fe09
GETADR = $fe0c
FLOATC = $fe0f
FSUB = $fe12
FSUBT = $fe15
FADD = $fe18
FADDT = $fe1b
FMULT = $fe1e
FMULTT = $fe21
FDIV = $fe24
FDIVT = $fe27
LOG = $fe2a
INT = $fe2d
SQR = $fe30
NEGOP = $fe33
FPWR = $fe36
FPWRT = $fe39
EXP = $fe3c
COS = $fe3f
SIN = $fe42
TAN = $fe45
ATN = $fe48
ROUND = $fe4b
ABS = $fe4e
SIGN = $fe51
FCOMP = $fe54
RND_0 = $fe57
RND = $fe57
CONUPK = $fe5a
ROMUPK = $fe5d
MOVFRM = $fe60
MOVFM = $fe63
MOVMF = $fe66
MOVFA = $fe69
MOVAF = $fe6c
FADDH = $fe6f
ZEROFC = $fe72
NORMAL = $fe75
NEGFAC = $fe78
MUL10 = $fe7b
DIV10 = $fe7e
MOVEF = $fe81
SGN = $fe84
FLOAT = $fe87
FLOATS = $fe8a
QINT = $fe8d
FINLOG = $fe90
FREADSA .proc
tay
bpl +
lda #$ff
jmp GIVAYF
+ lda #0
jmp GIVAYF
.pend
GIVUAYFAY .proc
sty $c4 ; facmo ($64 on c128)
sta $c5 ; facmo+1 ($65 on c128)
ldx #$90
sec
jmp FLOATC
.pend
GIVAYFAY .proc
sta P8ZP_SCRATCH_B1
tya
ldy P8ZP_SCRATCH_B1
jmp GIVAYF ; this uses the inverse order, Y/A
.pend
GETADRAY .proc
jsr GETADR ; this uses the inverse order, Y/A
sta P8ZP_SCRATCH_B1
tya
ldy P8ZP_SCRATCH_B1
rts
.pend
FREADUY .proc
lda #0
jmp GIVAYF
.pend
parse .proc
ldx VAL_1
cpx #$4c ; is there an implementation in VAL_1? (test for JMP)
bne + ; no, do it ourselves
pha ; yes, count the length and call rom VAL_1.
phy
jsr prog8_lib.strlen
tya
ply
plx
jmp VAL_1
+ sta $a9 ; 'index' variable
sty $aa
jsr prog8_lib.strlen
lda $deb6
cmp #$d0 ; sanity check for kernal routine correct
bne +
tya
jmp $deb6 ; kernal version dependent...
+ ; print error message if routine is borked in kernal, and exit program
ldy #0
- lda _msg,y
beq +
jsr cbm.CHROUT
iny
bne -
+ jmp sys.exit
_msg .text 13,"?val kaputt",13,0
.pend
normalize .proc
jmp floats.NORMAL
.pend
; --- low level floating point assembly routines for the C64
FL_ONE_const .byte 129 ; 1.0
FL_ZERO_const .byte 0,0,0,0,0 ; 0.0
FL_LOG2_const .byte $80, $31, $72, $17, $f8 ; log(2)
floats_temp_var .byte 0,0,0,0,0 ; temporary storage for a float
ub2float .proc
; -- convert ubyte in SCRATCH_ZPB1 to float at address A/Y
; clobbers A, X, Y
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy P8ZP_SCRATCH_B1
lda #0
jsr GIVAYF
_fac_to_mem ldx P8ZP_SCRATCH_W2
ldy P8ZP_SCRATCH_W2+1
jmp MOVMF
.pend
b2float .proc
; -- convert byte in SCRATCH_ZPB1 to float at address A/Y
; clobbers A, X, Y
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
lda P8ZP_SCRATCH_B1
jsr FREADSA
jmp ub2float._fac_to_mem
.pend
uw2float .proc
; -- convert uword in SCRATCH_ZPWORD1 to float at address A/Y
; clobbers X
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
lda P8ZP_SCRATCH_W1
ldy P8ZP_SCRATCH_W1+1
jsr GIVUAYFAY
jmp ub2float._fac_to_mem
.pend
w2float .proc
; -- convert word in SCRATCH_ZPWORD1 to float at address A/Y
; clobbers X
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
jsr GIVAYF
jmp ub2float._fac_to_mem
.pend
cast_from_uw .proc
; -- uword in A/Y into float var at (P8ZP_SCRATCH_W2)
; clobbers X
jsr GIVUAYFAY
jmp ub2float._fac_to_mem
.pend
cast_from_w .proc
; -- word in A/Y into float var at (P8ZP_SCRATCH_W2)
; clobbers X
jsr GIVAYFAY
jmp ub2float._fac_to_mem
.pend
cast_from_ub .proc
; -- ubyte in Y into float var at (P8ZP_SCRATCH_W2)
; clobbers X
jsr FREADUY
jmp ub2float._fac_to_mem
.pend
cast_from_b .proc
; -- byte in A into float var at (P8ZP_SCRATCH_W2)
; clobbers X
jsr FREADSA
jmp ub2float._fac_to_mem
.pend
cast_as_uw_into_ya .proc ; also used for float 2 ub
; -- cast float at A/Y to uword into Y/A
; clobbers X
jsr MOVFM
jmp cast_FAC1_as_uw_into_ya
.pend
cast_as_w_into_ay .proc ; also used for float 2 b
; -- cast float at A/Y to word into A/Y
; clobbers X
jsr MOVFM
jmp cast_FAC1_as_w_into_ay
.pend
cast_as_bool_into_a .proc
; -- cast float at A/Y to bool into A
; clobbers X
jsr MOVFM
jmp cast_FAC1_as_bool_into_a
.pend
cast_FAC1_as_bool_into_a .proc
; -- cast fac1 to bool into A
; clobbers X
jsr SIGN
and #1
rts
.pend
cast_FAC1_as_uw_into_ya .proc ; also used for float 2 ub
; -- cast fac1 to uword into Y/A
; clobbers X
jmp GETADR ; into Y/A
.pend
cast_FAC1_as_w_into_ay .proc ; also used for float 2 b
; -- cast fac1 to word into A/Y
; clobbers X
jsr AYINT
ldy floats.AYINT_facmo
lda floats.AYINT_facmo+1
rts
.pend
copy_float .proc
; -- copies the 5 bytes of the mflt value pointed to by P8ZP_SCRATCH_W1,
; into the 5 bytes pointed to by A/Y. Clobbers A,Y.
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
lda (P8ZP_SCRATCH_W1),y
sta (P8ZP_SCRATCH_W2),y
iny
lda (P8ZP_SCRATCH_W1),y
sta (P8ZP_SCRATCH_W2),y
iny
lda (P8ZP_SCRATCH_W1),y
sta (P8ZP_SCRATCH_W2),y
iny
lda (P8ZP_SCRATCH_W1),y
sta (P8ZP_SCRATCH_W2),y
iny
lda (P8ZP_SCRATCH_W1),y
sta (P8ZP_SCRATCH_W2),y
rts
.pend
inc_var_f .proc
; -- add 1 to float pointed to by A/Y
; clobbers X
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
jsr MOVFM
lda #<FL_ONE_const
ldy #>FL_ONE_const
jsr FADD
ldx P8ZP_SCRATCH_W1
ldy P8ZP_SCRATCH_W1+1
jmp MOVMF
.pend
dec_var_f .proc
; -- subtract 1 from float pointed to by A/Y
; clobbers X
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda #<FL_ONE_const
ldy #>FL_ONE_const
jsr MOVFM
lda P8ZP_SCRATCH_W1
ldy P8ZP_SCRATCH_W1+1
jsr FSUB
ldx P8ZP_SCRATCH_W1
ldy P8ZP_SCRATCH_W1+1
jmp MOVMF
.pend
fmath_float1 .byte 0,0,0,0,0 ; storage for a mflpt5 value
fmath_float2 .byte 0,0,0,0,0 ; storage for a mflpt5 value
var_fac1_less_f .proc
; -- is the float in FAC1 < the variable AY? Result in A. Clobbers X.
jsr FCOMP
cmp #255
beq +
lda #0
rts
+ lda #1
rts
.pend
var_fac1_lesseq_f .proc
; -- is the float in FAC1 <= the variable AY? Result in A. Clobbers X.
jsr FCOMP
cmp #0
beq +
cmp #255
beq +
lda #0
rts
+ lda #1
rts
.pend
var_fac1_greater_f .proc
; -- is the float in FAC1 > the variable AY? Result in A. Clobbers X.
jsr FCOMP
cmp #1
beq +
lda #0
rts
+ lda #1
rts
.pend
var_fac1_greatereq_f .proc
; -- is the float in FAC1 >= the variable AY? Result in A. Clobbers X.
jsr FCOMP
cmp #0
beq +
cmp #1
beq +
lda #0
rts
+ lda #1
rts
.pend
var_fac1_equal_f .proc
; -- are the floats numbers in FAC1 and the variable AY identical? Result in A. Clobbers X.
jsr FCOMP
and #1
eor #1
rts
.pend
var_fac1_notequal_f .proc
; -- are the floats numbers in FAC1 and the variable AY *not* identical? Result in A. Clobbers X.
jsr FCOMP
and #1
rts
.pend
vars_equal_f .proc
; -- are the mflpt5 numbers in P8ZP_SCRATCH_W1 and AY identical? Result in A
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
lda (P8ZP_SCRATCH_W1),y
cmp (P8ZP_SCRATCH_W2),y
bne _false
iny
lda (P8ZP_SCRATCH_W1),y
cmp (P8ZP_SCRATCH_W2),y
bne _false
iny
lda (P8ZP_SCRATCH_W1),y
cmp (P8ZP_SCRATCH_W2),y
bne _false
iny
lda (P8ZP_SCRATCH_W1),y
cmp (P8ZP_SCRATCH_W2),y
bne _false
iny
lda (P8ZP_SCRATCH_W1),y
cmp (P8ZP_SCRATCH_W2),y
bne _false
lda #1
rts
_false lda #0
rts
.pend
vars_less_f .proc
; -- is float in AY < float in P8ZP_SCRATCH_W2 ? Result in A. Clobbers X.
jsr MOVFM
lda P8ZP_SCRATCH_W2
ldy P8ZP_SCRATCH_W2+1
jsr FCOMP
cmp #255
bne +
lda #1
rts
+ lda #0
rts
.pend
vars_lesseq_f .proc
; -- is float in AY <= float in P8ZP_SCRATCH_W2 ? Result in A. Clobbers X.
jsr MOVFM
lda P8ZP_SCRATCH_W2
ldy P8ZP_SCRATCH_W2+1
jsr FCOMP
cmp #255
bne +
- lda #1
rts
+ cmp #0
beq -
lda #0
rts
.pend
less_f .proc
; -- is f1 < f2? Result in A. Clobbers X.
jsr compare_floats
cmp #255
beq compare_floats._return_true
bne compare_floats._return_false
.pend
lesseq_f .proc
; -- is f1 <= f2? Result in A. Clobbers X.
jsr compare_floats
cmp #255
beq compare_floats._return_true
cmp #0
beq compare_floats._return_true
bne compare_floats._return_false
.pend
greater_f .proc
; -- is f1 > f2? Result in A. Clobbers X.
jsr compare_floats
cmp #1
beq compare_floats._return_true
bne compare_floats._return_false
.pend
greatereq_f .proc
; -- is f1 >= f2? Result in A. Clobbers X.
jsr compare_floats
cmp #1
beq compare_floats._return_true
cmp #0
beq compare_floats._return_true
bne compare_floats._return_false
.pend
set_array_float_from_fac1 .proc
; -- set the float in FAC1 in the array (index in A, array in P8ZP_SCRATCH_W1)
; clobbers X
sta P8ZP_SCRATCH_B1
asl a
asl a
clc
adc P8ZP_SCRATCH_B1
ldy P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W1
bcc +
iny
+ tax
jmp MOVMF
.pend
set_0_array_float .proc
; -- set a float in an array to zero (index in A, array in P8ZP_SCRATCH_W1)
sta P8ZP_SCRATCH_B1
asl a
asl a
clc
adc P8ZP_SCRATCH_B1
tay
lda #0
sta (P8ZP_SCRATCH_W1),y
iny
sta (P8ZP_SCRATCH_W1),y
iny
sta (P8ZP_SCRATCH_W1),y
iny
sta (P8ZP_SCRATCH_W1),y
iny
sta (P8ZP_SCRATCH_W1),y
rts
.pend
set_array_float .proc
; -- set a float in an array to a value (index in A, float in P8ZP_SCRATCH_W1, array in P8ZP_SCRATCH_W2)
sta P8ZP_SCRATCH_B1
asl a
asl a
clc
adc P8ZP_SCRATCH_B1
adc P8ZP_SCRATCH_W2
ldy P8ZP_SCRATCH_W2+1
bcc +
iny
+ jmp copy_float
; -- copies the 5 bytes of the mflt value pointed to by SCRATCH_ZPWORD1,
; into the 5 bytes pointed to by A/Y. Clobbers A,Y.
.pend
pushFAC1 .proc
;-- push floating point in FAC onto the cpu stack
; save return address
pla
sta P8ZP_SCRATCH_W2
pla
sta P8ZP_SCRATCH_W2+1
ldx #<floats.floats_temp_var
ldy #>floats.floats_temp_var
jsr floats.MOVMF
lda floats.floats_temp_var
pha
lda floats.floats_temp_var+1
pha
lda floats.floats_temp_var+2
pha
lda floats.floats_temp_var+3
pha
lda floats.floats_temp_var+4
pha
; re-push return address
lda P8ZP_SCRATCH_W2+1
pha
lda P8ZP_SCRATCH_W2
pha
rts
.pend
popFAC .proc
; -- pop floating point value from cpu stack into FAC1 or FAC2 (
; carry flag clear=FAC1, carry set=FAC2
; save return address
pla
sta P8ZP_SCRATCH_W2
pla
sta P8ZP_SCRATCH_W2+1
pla
sta floats.floats_temp_var+4
pla
sta floats.floats_temp_var+3
pla
sta floats.floats_temp_var+2
pla
sta floats.floats_temp_var+1
pla
sta floats.floats_temp_var
lda #<floats.floats_temp_var
ldy #>floats.floats_temp_var
bcs +
jsr floats.MOVFM
jmp ++
+ jsr floats.CONUPK
+ ; re-push return address
lda P8ZP_SCRATCH_W2+1
pha
lda P8ZP_SCRATCH_W2
pha
rts
.pend
; --- floating point builtin functions
func_sign_f_into_A .proc
jsr MOVFM
jmp SIGN
.pend
func_swap_f .proc
; -- swap floats pointed to by SCRATCH_ZPWORD1, SCRATCH_ZPWORD2
ldy #4
- lda (P8ZP_SCRATCH_W1),y
pha
lda (P8ZP_SCRATCH_W2),y
sta (P8ZP_SCRATCH_W1),y
pla
sta (P8ZP_SCRATCH_W2),y
dey
bpl -
rts
.pend
func_reverse_f .proc
; --- reverse an array of floats (array in P8ZP_SCRATCH_W1, num elements in A)
_left_index = P8ZP_SCRATCH_W2
_right_index = P8ZP_SCRATCH_W2+1
_loop_count = P8ZP_SCRATCH_REG
pha
jsr a_times_5
sec
sbc #5
sta _right_index
lda #0
sta _left_index
pla
lsr a
sta _loop_count
_loop ; push the left indexed float on the stack
ldy _left_index
lda (P8ZP_SCRATCH_W1),y
pha
iny
lda (P8ZP_SCRATCH_W1),y
pha
iny
lda (P8ZP_SCRATCH_W1),y
pha
iny
lda (P8ZP_SCRATCH_W1),y
pha
iny
lda (P8ZP_SCRATCH_W1),y
pha
; copy right index float to left index float
ldy _right_index
lda (P8ZP_SCRATCH_W1),y
ldy _left_index
sta (P8ZP_SCRATCH_W1),y
inc _left_index
inc _right_index
ldy _right_index
lda (P8ZP_SCRATCH_W1),y
ldy _left_index
sta (P8ZP_SCRATCH_W1),y
inc _left_index
inc _right_index
ldy _right_index
lda (P8ZP_SCRATCH_W1),y
ldy _left_index
sta (P8ZP_SCRATCH_W1),y
inc _left_index
inc _right_index
ldy _right_index
lda (P8ZP_SCRATCH_W1),y
ldy _left_index
sta (P8ZP_SCRATCH_W1),y
inc _left_index
inc _right_index
ldy _right_index
lda (P8ZP_SCRATCH_W1),y
ldy _left_index
sta (P8ZP_SCRATCH_W1),y
; pop the float off the stack into the right index float
ldy _right_index
pla
sta (P8ZP_SCRATCH_W1),y
dey
pla
sta (P8ZP_SCRATCH_W1),y
dey
pla
sta (P8ZP_SCRATCH_W1),y
dey
pla
sta (P8ZP_SCRATCH_W1),y
dey
pla
sta (P8ZP_SCRATCH_W1),y
inc _left_index
lda _right_index
sec
sbc #9
sta _right_index
dec _loop_count
bne _loop
rts
.pend
a_times_5 .proc
sta P8ZP_SCRATCH_B1
asl a
asl a
clc
adc P8ZP_SCRATCH_B1
rts
.pend
func_any_f_into_A .proc
jsr a_times_5
jmp prog8_lib.func_any_b_into_A
.pend
func_all_f_into_A .proc
jsr a_times_5
jmp prog8_lib.func_all_b_into_A
.pend
func_any_f_stack .proc
jsr a_times_5
jmp prog8_lib.func_any_b_stack
.pend
func_all_f_stack .proc
jsr a_times_5
jmp prog8_lib.func_all_b_stack
.pend
func_abs_f_into_FAC1 .proc
jsr MOVFM
jmp ABS
.pend
func_sqrt_into_FAC1 .proc
jsr MOVFM
jmp SQR
.pend
containment_floatarray .proc
; -- check if a value exists in a float array.
; parameters: FAC1: value to check, P8ZP_SCRATCH_W1: address of the word array, Y = length of array (>=1).
; returns boolean 0/1 in A.
sty P8ZP_SCRATCH_REG
ldx #<floats.floats_temp_var
ldy #>floats.floats_temp_var
jsr floats.MOVMF
ldx P8ZP_SCRATCH_REG
ldy #0
- lda floats.floats_temp_var
cmp (P8ZP_SCRATCH_W1),y
bne _firstmiss
iny
lda floats.floats_temp_var+1
cmp (P8ZP_SCRATCH_W1),y
bne _secondmiss
iny
lda floats.floats_temp_var+2
cmp (P8ZP_SCRATCH_W1),y
bne _thirdmiss
iny
lda floats.floats_temp_var+3
cmp (P8ZP_SCRATCH_W1),y
bne _fourthmiss
iny
lda floats.floats_temp_var+4
cmp (P8ZP_SCRATCH_W1),y
bne _fifthmiss
lda #1
rts
_firstmiss
iny
_secondmiss
iny
_thirdmiss
iny
_fourthmiss
iny
_fifthmiss
iny
dex
bne -
lda #0
rts
.pend
print .proc
jsr tostr
ldy #0
- lda (P8ZP_SCRATCH_W1),y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
.pend
tostr .proc
jsr FOUT
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
lda (P8ZP_SCRATCH_W1),y
cmp #' '
bne +
inc P8ZP_SCRATCH_W1
bne +
inc P8ZP_SCRATCH_W1+1
+ lda P8ZP_SCRATCH_W1
ldy P8ZP_SCRATCH_W1+1
rts
.pend
sin .proc
; statements
lda #<angle
ldy #>angle
jsr MOVFM
jmp SIN
; variables
.section BSS
.send BSS
; non-zeropage variables without initialization value
.section BSS
angle .fill 5
.send BSS
.pend
rad .proc
; statements
lda #<angle
ldy #>angle
jsr MOVFM
lda #<_pi_div_180
ldy #>_pi_div_180
jmp FMULT
_pi_div_180 .byte 123, 14, 250, 53, 18 ; pi / 180
; variables
.section BSS
.send BSS
; non-zeropage variables without initialization value
.section BSS
angle .fill 5
.send BSS
.pend
.pend
; ---- block: 'txt' ----
txt .proc
DEFAULT_HEIGHT = $3c
DEFAULT_WIDTH = $50
VERA_TEXTMATRIX_ADDR = $b000
VERA_TEXTMATRIX_BANK = 1
chrout = $ffd2
column .proc
sec
jsr cbm.PLOT
tay
clc
jmp cbm.PLOT
.pend
get_column .proc
sec
jmp cbm.PLOT
.pend
row .proc
sec
jsr cbm.PLOT
tax
clc
jmp cbm.PLOT
.pend
get_row .proc
sec
jmp cbm.PLOT
.pend
fill_screen .proc
sty _ly+1
pha
jsr cbm.SCREEN ; get dimensions in X/Y
txa
lsr a
lsr a
sta _lx+1
lda #%00010000
jsr set_vera_textmatrix_addresses
pla
_lx ldx #0 ; modified
phy
_ly ldy #1 ; modified
- sta cx16.VERA_DATA0
sty cx16.VERA_DATA0
sta cx16.VERA_DATA0
sty cx16.VERA_DATA0
sta cx16.VERA_DATA0
sty cx16.VERA_DATA0
sta cx16.VERA_DATA0
sty cx16.VERA_DATA0
dex
bne -
ply
dey
beq +
stz cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M ; next line
bra _lx
+ rts
set_vera_textmatrix_addresses:
stz cx16.VERA_CTRL
ora #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
stz cx16.VERA_ADDR_L ; start at (0,0)
lda #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
rts
.pend
clear_screenchars .proc
pha
jsr cbm.SCREEN ; get dimensions in X/Y
txa
lsr a
lsr a
sta _lx+1
lda #%00100000
jsr fill_screen.set_vera_textmatrix_addresses
pla
_lx ldx #0 ; modified
- sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
dex
bne -
dey
beq +
stz cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M ; next line
bra _lx
+ rts
.pend
clear_screencolors .proc
sta _la+1
jsr cbm.SCREEN ; get dimensions in X/Y
txa
lsr a
lsr a
sta _lx+1
stz cx16.VERA_CTRL
lda #%00100000
jsr fill_screen.set_vera_textmatrix_addresses
inc cx16.VERA_ADDR_L ; start at (1,0) - the color attribute byte
_lx ldx #0 ; modified
_la lda #0 ; modified
- sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
dex
bne -
dey
beq +
lda #1
sta cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M ; next line
bra _lx
+ rts
.pend
scroll_left .proc
jsr cbm.SCREEN
dex
stx _lx+1
dey
sty P8ZP_SCRATCH_B1 ; number of rows to scroll
_nextline
stz cx16.VERA_CTRL ; data port 0: source column
lda #%00010000 | VERA_TEXTMATRIX_BANK ; auto increment 1
sta cx16.VERA_ADDR_H
lda #2
sta cx16.VERA_ADDR_L ; begin in column 1
lda P8ZP_SCRATCH_B1
clc
adc #>VERA_TEXTMATRIX_ADDR
tay
sty cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1: destination column
lda #%00010000 | VERA_TEXTMATRIX_BANK ; auto increment 1
sta cx16.VERA_ADDR_H
stz cx16.VERA_ADDR_L
sty cx16.VERA_ADDR_M
_lx ldx #0 ; modified
- lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy char
lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy color
dex
bne -
dec P8ZP_SCRATCH_B1
bpl _nextline
lda #0
sta cx16.VERA_CTRL
rts
.pend
scroll_right .proc
jsr cbm.SCREEN
dex
stx _lx+1
txa
asl a
dea
sta _rcol+1
ina
ina
sta _rcol2+1
dey
sty P8ZP_SCRATCH_B1 ; number of rows to scroll
_nextline
stz cx16.VERA_CTRL ; data port 0: source column
lda #%00011000 | VERA_TEXTMATRIX_BANK ; auto decrement 1
sta cx16.VERA_ADDR_H
_rcol lda #79*2-1 ; modified
sta cx16.VERA_ADDR_L ; begin in rightmost column minus one
lda P8ZP_SCRATCH_B1
clc
adc #>VERA_TEXTMATRIX_ADDR
tay
sty cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1: destination column
lda #%00011000 | VERA_TEXTMATRIX_BANK ; auto decrement 1
sta cx16.VERA_ADDR_H
_rcol2 lda #79*2+1 ; modified
sta cx16.VERA_ADDR_L
sty cx16.VERA_ADDR_M
_lx ldx #0 ; modified
- lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy char
lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy color
dex
bne -
dec P8ZP_SCRATCH_B1
bpl _nextline
lda #0
sta cx16.VERA_CTRL
rts
.pend
scroll_up .proc
jsr cbm.SCREEN
stx _nextline+1
dey
sty P8ZP_SCRATCH_B1
stz cx16.VERA_CTRL ; data port 0 is source
lda #1 | (>VERA_TEXTMATRIX_ADDR)
sta cx16.VERA_ADDR_M ; start at second line
stz cx16.VERA_ADDR_L
lda #%00010000 | VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
lda #1
sta cx16.VERA_CTRL ; data port 1 is destination
lda #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M ; start at top line
stz cx16.VERA_ADDR_L
lda #%00010000 | VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
_nextline
ldx #80 ; modified
- lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy char
lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy color
dex
bne -
dec P8ZP_SCRATCH_B1
beq +
stz cx16.VERA_CTRL ; data port 0
stz cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1
stz cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M
bra _nextline
+ lda #0
sta cx16.VERA_CTRL
rts
.pend
scroll_down .proc
jsr cbm.SCREEN
stx _nextline+1
dey
sty P8ZP_SCRATCH_B1
stz cx16.VERA_CTRL ; data port 0 is source
dey
tya
clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M ; start at line before bottom line
stz cx16.VERA_ADDR_L
lda #%00010000 | VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
lda #1
sta cx16.VERA_CTRL ; data port 1 is destination
iny
tya
clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M ; start at bottom line
stz cx16.VERA_ADDR_L
lda #%00010000 | VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
_nextline
ldx #80 ; modified
- lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy char
lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy color
dex
bne -
dec P8ZP_SCRATCH_B1
beq +
stz cx16.VERA_CTRL ; data port 0
stz cx16.VERA_ADDR_L
dec cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1
stz cx16.VERA_ADDR_L
dec cx16.VERA_ADDR_M
bra _nextline
+ lda #0
sta cx16.VERA_CTRL
rts
.pend
print .proc
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
ldy #0
- lda (P8ZP_SCRATCH_B1),y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
.pend
print_ub0 .proc
jsr conv.ubyte2decimal
pha
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
txa
jmp cbm.CHROUT
.pend
print_ub .proc
jsr conv.ubyte2decimal
_print_byte_digits
pha
cpy #'0'
beq +
tya
jsr cbm.CHROUT
pla
jsr cbm.CHROUT
bra _ones
+ pla
cmp #'0'
beq _ones
jsr cbm.CHROUT
_ones txa
jmp cbm.CHROUT
.pend
print_b .proc
pha
cmp #0
bpl +
lda #'-'
jsr cbm.CHROUT
+ pla
jsr conv.byte2decimal
bra print_ub._print_byte_digits
.pend
print_ubhex .proc
bcc +
pha
lda #'$'
jsr cbm.CHROUT
pla
+ jsr conv.ubyte2hex
jsr cbm.CHROUT
tya
jmp cbm.CHROUT
.pend
print_ubbin .proc
sta P8ZP_SCRATCH_B1
bcc +
lda #'%'
jsr cbm.CHROUT
+ ldy #8
- lda #'0'
asl P8ZP_SCRATCH_B1
bcc +
lda #'1'
+ jsr cbm.CHROUT
dey
bne -
rts
.pend
print_uwbin .proc
pha
tya
jsr print_ubbin
pla
clc
bra print_ubbin
.pend
print_uwhex .proc
pha
tya
jsr print_ubhex
pla
clc
bra print_ubhex
.pend
print_uw0 .proc
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq +
jsr cbm.CHROUT
iny
bne -
+ rts
.pend
print_uw .proc
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
iny
bne -
_gotdigit
jsr cbm.CHROUT
iny
lda conv.uword2decimal.decTenThousands,y
bne _gotdigit
rts
_allzero
lda #'0'
jmp cbm.CHROUT
.pend
print_w .proc
cpy #0
bpl +
pha
lda #'-'
jsr cbm.CHROUT
tya
eor #255
tay
pla
eor #255
ina
bne +
iny
+ bra print_uw
.pend
input_chars .proc
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0 ; char counter = 0
- jsr cbm.CHRIN
cmp #$0d ; return (ascii 13) pressed?
beq + ; yes, end.
sta (P8ZP_SCRATCH_W1),y ; else store char in buffer
iny
bne -
+ lda #0
sta (P8ZP_SCRATCH_W1),y ; finish string with 0 byte
rts
.pend
setchr .proc
pha
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
txa
asl a
sta cx16.VERA_ADDR_L
tya
; clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
pla
sta cx16.VERA_DATA0
rts
.pend
getchr .proc
asl a
pha
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
pla
sta cx16.VERA_ADDR_L
tya
; clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
lda cx16.VERA_DATA0
rts
.pend
setclr .proc
pha
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
txa
asl a
ina
sta cx16.VERA_ADDR_L
tya
; clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
pla
sta cx16.VERA_DATA0
rts
.pend
getclr .proc
asl a
ina
pha
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
pla
sta cx16.VERA_ADDR_L
tya
; clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
lda cx16.VERA_DATA0
rts
.pend
plot .proc
clc
jmp cbm.PLOT
.pend
width .proc
jsr cbm.SCREEN
txa
rts
.pend
height .proc
jsr cbm.SCREEN
tya
rts
.pend
waitkey .proc
- jsr cbm.GETIN
beq -
rts
.pend
petscii2scr .proc
sta P8ZP_SCRATCH_REG
lsr a
lsr a
lsr a
lsr a
lsr a
tax
lda _offsets,x
eor P8ZP_SCRATCH_REG
rts
_offsets .byte 128, 0, 64, 32, 64, 192, 128, 128
.pend
petscii2scr_str .proc
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
- lda (P8ZP_SCRATCH_W1),y
beq +
jsr petscii2scr
sta (P8ZP_SCRATCH_W1),y
iny
bne -
+ rts
.pend
.pend
; ---- block: 'cbm' ----
cbm .proc
CINT = $ff81
IOINIT = $ff84
RAMTAS = $ff87
RESTOR = $ff8a
VECTOR = $ff8d
SETMSG = $ff90
SECOND = $ff93
TKSA = $ff96
MEMTOP = $ff99
MEMBOT = $ff9c
SCNKEY = $ff9f
SETTMO = $ffa2
ACPTR = $ffa5
CIOUT = $ffa8
UNTLK = $ffab
UNLSN = $ffae
LISTEN = $ffb1
TALK = $ffb4
READST = $ffb7
SETLFS = $ffba
SETNAM = $ffbd
OPEN = $ffc0
CLOSE = $ffc3
CHKIN = $ffc6
CHKOUT = $ffc9
CLRCHN = $ffcc
CHRIN = $ffcf
CHROUT = $ffd2
LOAD = $ffd5
SAVE = $ffd8
SETTIM = $ffdb
RDTIM = $ffde
STOP = $ffe1
GETIN = $ffe4
CLALL = $ffe7
UDTIM = $ffea
SCREEN = $ffed
PLOT = $fff0
IOBASE = $fff3
STOP2 .proc
jsr cbm.STOP
beq +
lda #0
rts
+ lda #1
rts
.pend
RDTIM16 .proc
php
sei
jsr cbm.RDTIM
plp
cli
pha
txa
tay
pla
rts
.pend
.pend
; ---- block: 'cx16' ----
cx16 .proc
r0 = 2
r0s = 2
r0L = 2
r0sL = 2
r0H = 3
r0sH = 3
r1 = 4
r1s = 4
r1L = 4
r1sL = 4
r1H = 5
r1sH = 5
r2 = 6
r2s = 6
r2L = 6
r2sL = 6
r2H = 7
r2sH = 7
r3 = 8
r3s = 8
r3L = 8
r3sL = 8
r3H = 9
r3sH = 9
r4 = 10
r4s = 10
r4L = 10
r4sL = 10
r4H = 11
r4sH = 11
r5 = 12
r5s = 12
r5L = 12
r5sL = 12
r5H = 13
r5sH = 13
r6 = 14
r6s = 14
r6L = 14
r6sL = 14
r6H = 15
r6sH = 15
r7 = $10
r7s = $10
r7L = $10
r7sL = $10
r7H = $11
r7sH = $11
r8 = $12
r8s = $12
r8L = $12
r8sL = $12
r8H = $13
r8sH = $13
r9 = $14
r9s = $14
r9L = $14
r9sL = $14
r9H = $15
r9sH = $15
r10 = $16
r10s = $16
r10L = $16
r10sL = $16
r10H = $17
r10sH = $17
r11 = $18
r11s = $18
r11L = $18
r11sL = $18
r11H = $19
r11sH = $19
r12 = $1a
r12s = $1a
r12L = $1a
r12sL = $1a
r12H = $1b
r12sH = $1b
r13 = $1c
r13s = $1c
r13L = $1c
r13sL = $1c
r13H = $1d
r13sH = $1d
r14 = $1e
r14s = $1e
r14L = $1e
r14sL = $1e
r14H = $1f
r14sH = $1f
r15 = $20
r15s = $20
r15L = $20
r15sL = $20
r15H = $21
r15sH = $21
IERROR = $0300
IMAIN = $0302
ICRNCH = $0304
IQPLOP = $0306
IGONE = $0308
IEVAL = $030a
SAREG = $030c
SXREG = $030d
SYREG = $030e
SPREG = $030f
USRADD = $0311
CINV = $0314
CBINV = $0316
NMINV = $0318
IOPEN = $031a
ICLOSE = $031c
ICHKIN = $031e
ICKOUT = $0320
ICLRCH = $0322
IBASIN = $0324
IBSOUT = $0326
ISTOP = $0328
IGETIN = $032a
ICLALL = $032c
KEYHDL = $032e
ILOAD = $0330
ISAVE = $0332
via1prb = $9f00
via1pra = $9f01
via1ddrb = $9f02
via1ddra = $9f03
via1t1l = $9f04
via1t1h = $9f05
via1t1ll = $9f06
via1t1lh = $9f07
via1t2l = $9f08
via1t2h = $9f09
via1sr = $9f0a
via1acr = $9f0b
via1pcr = $9f0c
via1ifr = $9f0d
via1ier = $9f0e
via1ora = $9f0f
via2prb = $9f10
via2pra = $9f11
via2ddrb = $9f12
via2ddra = $9f13
via2t1l = $9f14
via2t1h = $9f15
via2t1ll = $9f16
via2t1lh = $9f17
via2t2l = $9f18
via2t2h = $9f19
via2sr = $9f1a
via2acr = $9f1b
via2pcr = $9f1c
via2ifr = $9f1d
via2ier = $9f1e
via2ora = $9f1f
VERA_ADDR_L = $9f20
VERA_ADDR = $9f20
VERA_ADDR_M = $9f21
VERA_ADDR_H = $9f22
VERA_DATA0 = $9f23
VERA_DATA1 = $9f24
VERA_CTRL = $9f25
VERA_IEN = $9f26
VERA_ISR = $9f27
VERA_IRQLINE_L = $9f28
VERA_SCANLINE_L = $9f28
VERA_DC_VIDEO = $9f29
VERA_DC_HSTART = $9f29
VERA_DC_VER0 = $9f29
VERA_FX_CTRL = $9f29
VERA_FX_X_INCR_L = $9f29
VERA_FX_X_INCR = $9f29
VERA_FX_X_POS_L = $9f29
VERA_FX_X_POS = $9f29
VERA_FX_X_POS_S = $9f29
VERA_FX_CACHE_L = $9f29
VERA_FX_ACCUM_RESET = $9f29
VERA_DC_HSCALE = $9f2a
VERA_DC_HSTOP = $9f2a
VERA_DC_VER1 = $9f2a
VERA_FX_TILEBASE = $9f2a
VERA_FX_X_INCR_H = $9f2a
VERA_FX_X_POS_H = $9f2a
VERA_FX_Y_POS_S = $9f2a
VERA_FX_CACHE_M = $9f2a
VERA_FX_ACCUM = $9f2a
VERA_DC_VSCALE = $9f2b
VERA_DC_VSTART = $9f2b
VERA_DC_VER2 = $9f2b
VERA_FX_MAPBASE = $9f2b
VERA_FX_Y_INCR_L = $9f2b
VERA_FX_Y_INCR = $9f2b
VERA_FX_Y_POS_L = $9f2b
VERA_FX_Y_POS = $9f2b
VERA_FX_POLY_FILL_L = $9f2b
VERA_FX_POLY_FILL = $9f2b
VERA_FX_CACHE_H = $9f2b
VERA_DC_BORDER = $9f2c
VERA_DC_VSTOP = $9f2c
VERA_DC_VER3 = $9f2c
VERA_FX_MULT = $9f2c
VERA_FX_Y_INCR_H = $9f2c
VERA_FX_Y_POS_H = $9f2c
VERA_FX_POLY_FILL_H = $9f2c
VERA_FX_CACHE_U = $9f2c
VERA_L0_CONFIG = $9f2d
VERA_L0_MAPBASE = $9f2e
VERA_L0_TILEBASE = $9f2f
VERA_L0_HSCROLL_L = $9f30
VERA_L0_HSCROLL = $9f30
VERA_L0_HSCROLL_H = $9f31
VERA_L0_VSCROLL_L = $9f32
VERA_L0_VSCROLL = $9f32
VERA_L0_VSCROLL_H = $9f33
VERA_L1_CONFIG = $9f34
VERA_L1_MAPBASE = $9f35
VERA_L1_TILEBASE = $9f36
VERA_L1_HSCROLL_L = $9f37
VERA_L1_HSCROLL = $9f37
VERA_L1_HSCROLL_H = $9f38
VERA_L1_VSCROLL_L = $9f39
VERA_L1_VSCROLL = $9f39
VERA_L1_VSCROLL_H = $9f3a
VERA_AUDIO_CTRL = $9f3b
VERA_AUDIO_RATE = $9f3c
VERA_AUDIO_DATA = $9f3d
VERA_SPI_DATA = $9f3e
VERA_SPI_CTRL = $9f3f
YM_ADDRESS = $9f40
YM_DATA = $9f41
edkeyvec = $ac03
edkeybk = $ac05
NMI_VEC = $fffa
RESET_VEC = $fffc
IRQ_VEC = $fffe
VERA_BASE = $9f20
VIA1_BASE = $9f00
VIA2_BASE = $9f10
extdev = $9f60
CLOSE_ALL = $ff4a
LKUPLA = $ff59
LKUPSA = $ff5c
screen_mode = $ff5f
screen_set_charset = $ff62
JSRFAR = $ff6e
fetch = $ff74
stash = $ff77
PRIMM = $ff7d
GRAPH_init = $ff20
GRAPH_clear = $ff23
GRAPH_set_window = $ff26
GRAPH_set_colors = $ff29
GRAPH_draw_line = $ff2c
GRAPH_draw_rect = $ff2f
GRAPH_move_rect = $ff32
GRAPH_draw_oval = $ff35
GRAPH_draw_image = $ff38
GRAPH_set_font = $ff3b
GRAPH_get_char_size = $ff3e
GRAPH_put_char = $ff41
GRAPH_put_next_char = $ff41
FB_init = $fef6
FB_get_info = $fef9
FB_set_palette = $fefc
FB_cursor_position = $feff
FB_cursor_next_line = $ff02
FB_get_pixel = $ff05
FB_get_pixels = $ff08
FB_set_pixel = $ff0b
FB_set_pixels = $ff0e
FB_set_8_pixels = $ff11
FB_set_8_pixels_opaque = $ff14
FB_fill_pixels = $ff17
FB_filter_pixels = $ff1a
FB_move_pixels = $ff1d
BSAVE = $feba
i2c_read_byte = $fec6
i2c_write_byte = $fec9
sprite_set_image = $fef0
sprite_set_position = $fef3
memory_fill = $fee4
memory_copy = $fee7
memory_crc = $feea
memory_decompress = $feed
console_init = $fedb
console_put_char = $fede
console_get_char = $fee1
console_put_image = $fed8
console_set_paging_message = $fed5
entropy_get = $fecf
monitor = $fecc
MACPTR = $ff44
MCIOUT = $feb1
enter_basic = $ff47
clock_set_date_time = $ff4d
clock_get_date_time = $ff50
kbdbuf_peek = $febd
kbdbuf_peek2 = $febd
kbdbuf_get_modifiers = $fec0
kbdbuf_put = $fec3
keymap = $fed2
mouse_config = $ff68
mouse_get = $ff6b
mouse_scan = $ff71
joystick_scan = $ff53
joystick_get = $ff56
joystick_get2 = $ff56
x16edit_default = $c000
x16edit_loadfile = $c003
x16edit_loadfile_options = $c006
audio_init = $c09f
bas_fmfreq = $c000
bas_fmnote = $c003
bas_fmplaystring = $c006
bas_fmvib = $c009
bas_playstringvoice = $c00c
bas_psgfreq = $c00f
bas_psgnote = $c012
bas_psgwav = $c015
bas_psgplaystring = $c018
bas_fmchordstring = $c08d
bas_psgchordstring = $c090
notecon_bas2fm = $c01b
notecon_bas2midi = $c01e
notecon_bas2psg = $c021
notecon_fm2bas = $c024
notecon_fm2midi = $c027
notecon_fm2psg = $c02a
notecon_freq2bas = $c02d
notecon_freq2fm = $c030
notecon_freq2midi = $c033
notecon_freq2psg = $c036
notecon_midi2bas = $c039
notecon_midi2fm = $c03c
notecon_midi2psg = $c03f
notecon_psg2bas = $c042
notecon_psg2fm = $c045
notecon_psg2midi = $c048
psg_init = $c04b
psg_playfreq = $c04e
psg_read = $c051
psg_setatten = $c054
psg_setfreq = $c057
psg_setpan = $c05a
psg_setvol = $c05d
psg_write = $c060
psg_write_fast = $c0a2
psg_getatten = $c093
psg_getpan = $c096
ym_init = $c063
ym_loaddefpatches = $c066
ym_loadpatch = $c069
ym_loadpatchlfn = $c06c
ym_playdrum = $c06f
ym_playnote = $c072
ym_setatten = $c075
ym_setdrum = $c078
ym_setnote = $c07b
ym_setpan = $c07e
ym_read = $c081
ym_release = $c084
ym_trigger = $c087
ym_write = $c08a
ym_getatten = $c099
ym_getpan = $c09c
ym_get_chip_type = $c0a5
set_screen_mode .proc
clc
jmp screen_mode
.pend
get_screen_mode .proc
sec
jmp screen_mode
.pend
kbdbuf_clear .proc
- jsr cbm.GETIN
bne -
rts
.pend
mouse_config2 .proc
pha ; save shape
sec
jsr cx16.screen_mode ; set current screen mode and res in A, X, Y
pla ; get shape back
jmp cx16.mouse_config
.pend
mouse_pos .proc
ldx #cx16.r0
jmp cx16.mouse_get
.pend
numbanks .proc
sec
jsr cbm.MEMTOP
ldy #0
cmp #0
bne +
iny
+ rts
.pend
vpeek .proc
stz cx16.VERA_CTRL
sta cx16.VERA_ADDR_H
sty cx16.VERA_ADDR_M
stx cx16.VERA_ADDR_L
lda cx16.VERA_DATA0
rts
.pend
vaddr .proc
pha
lda cx16.r1
and #1
sta cx16.VERA_CTRL
lda cx16.r0
sta cx16.VERA_ADDR_L
lda cx16.r0+1
sta cx16.VERA_ADDR_M
pla
cpy #0
bmi ++
beq +
ora #%00010000
+ sta cx16.VERA_ADDR_H
rts
+ ora #%00011000
sta cx16.VERA_ADDR_H
rts
.pend
vaddr_clone .proc
sta VERA_CTRL
ldx VERA_ADDR_L
ldy VERA_ADDR_H
phy
ldy VERA_ADDR_M
eor #1
sta VERA_CTRL
stx VERA_ADDR_L
sty VERA_ADDR_M
ply
sty VERA_ADDR_H
eor #1
sta VERA_CTRL
rts
.pend
vaddr_autoincr .proc
jsr _setup
lda cx16.r2H
ora cx16.r2L
beq +
jsr _determine_incr_bits
+ ora P8ZP_SCRATCH_REG
sta cx16.VERA_ADDR_H
rts
_setup sta P8ZP_SCRATCH_REG
lda cx16.r1
and #1
sta cx16.VERA_CTRL
lda cx16.r0
sta cx16.VERA_ADDR_L
lda cx16.r0+1
sta cx16.VERA_ADDR_M
rts
_determine_incr_bits
lda cx16.r2H
bne _large
lda cx16.r2L
ldy #13
- cmp _strides_lsb,y
beq +
dey
bpl -
+ tya
asl a
asl a
asl a
asl a
rts
_large ora cx16.r2L
cmp #1 ; 256
bne +
lda #9<<4
rts
+ cmp #2 ; 512
bne +
lda #10<<4
rts
+ cmp #65 ; 320
bne +
lda #14<<4
rts
+ cmp #130 ; 640
bne +
lda #15<<4
rts
+ lda #0
rts
_strides_lsb .byte 0,1,2,4,8,16,32,64,128,255,255,40,80,160,255,255
.pend
vaddr_autodecr .proc
jsr vaddr_autoincr._setup
lda cx16.r2H
ora cx16.r2L
beq +
jsr vaddr_autoincr._determine_incr_bits
ora #%00001000 ; autodecrement
+ ora P8ZP_SCRATCH_REG
sta cx16.VERA_ADDR_H
rts
.pend
vpoke .proc
stz cx16.VERA_CTRL
sta cx16.VERA_ADDR_H
lda cx16.r0
sta cx16.VERA_ADDR_L
lda cx16.r0+1
sta cx16.VERA_ADDR_M
sty cx16.VERA_DATA0
rts
.pend
vpoke_or .proc
stz cx16.VERA_CTRL
sta cx16.VERA_ADDR_H
lda cx16.r0
sta cx16.VERA_ADDR_L
lda cx16.r0+1
sta cx16.VERA_ADDR_M
tya
ora cx16.VERA_DATA0
sta cx16.VERA_DATA0
rts
.pend
vpoke_and .proc
stz cx16.VERA_CTRL
sta cx16.VERA_ADDR_H
lda cx16.r0
sta cx16.VERA_ADDR_L
lda cx16.r0+1
sta cx16.VERA_ADDR_M
tya
and cx16.VERA_DATA0
sta cx16.VERA_DATA0
rts
.pend
vpoke_xor .proc
stz cx16.VERA_CTRL
sta cx16.VERA_ADDR_H
lda cx16.r0
sta cx16.VERA_ADDR_L
lda cx16.r0+1
sta cx16.VERA_ADDR_M
tya
eor cx16.VERA_DATA0
sta cx16.VERA_DATA0
rts
.pend
vpoke_mask .proc
sty P8ZP_SCRATCH_B1
stz cx16.VERA_CTRL
sta cx16.VERA_ADDR_H
lda cx16.r0
sta cx16.VERA_ADDR_L
lda cx16.r0+1
sta cx16.VERA_ADDR_M
txa
and cx16.VERA_DATA0
ora P8ZP_SCRATCH_B1
sta cx16.VERA_DATA0
rts
.pend
save_virtual_registers .proc
ldy #31
- lda cx16.r0,y
sta _cx16_vreg_storage,y
dey
bpl -
rts
_cx16_vreg_storage
.word 0,0,0,0,0,0,0,0
.word 0,0,0,0,0,0,0,0
.pend
restore_virtual_registers .proc
ldy #31
- lda save_virtual_registers._cx16_vreg_storage,y
sta cx16.r0,y
dey
bpl -
rts
.pend
save_vera_context .proc
; note cannot store this on cpu hardware stack because this gets called as a subroutine
lda cx16.VERA_ADDR_L
sta _vera_storage
lda cx16.VERA_ADDR_M
sta _vera_storage+1
lda cx16.VERA_ADDR_H
sta _vera_storage+2
lda cx16.VERA_CTRL
sta _vera_storage+3
eor #1
sta _vera_storage+7
sta cx16.VERA_CTRL
lda cx16.VERA_ADDR_L
sta _vera_storage+4
lda cx16.VERA_ADDR_M
sta _vera_storage+5
lda cx16.VERA_ADDR_H
sta _vera_storage+6
rts
_vera_storage: .byte 0,0,0,0,0,0,0,0
.pend
restore_vera_context .proc
lda cx16.save_vera_context._vera_storage+7
sta cx16.VERA_CTRL
lda cx16.save_vera_context._vera_storage+6
sta cx16.VERA_ADDR_H
lda cx16.save_vera_context._vera_storage+5
sta cx16.VERA_ADDR_M
lda cx16.save_vera_context._vera_storage+4
sta cx16.VERA_ADDR_L
lda cx16.save_vera_context._vera_storage+3
sta cx16.VERA_CTRL
lda cx16.save_vera_context._vera_storage+2
sta cx16.VERA_ADDR_H
lda cx16.save_vera_context._vera_storage+1
sta cx16.VERA_ADDR_M
lda cx16.save_vera_context._vera_storage+0
sta cx16.VERA_ADDR_L
rts
.pend
set_chrin_keyhandler .proc
sei
sta P8ZP_SCRATCH_REG
lda $00
pha
stz $00
lda P8ZP_SCRATCH_REG
sta cx16.edkeybk
stx cx16.edkeyvec
sty cx16.edkeyvec+1
pla
sta $00
cli
rts
.pend
get_chrin_keyhandler .proc
sei
lda $00
pha
stz $00
lda cx16.edkeybk
sta cx16.r0L
lda cx16.edkeyvec
ldy cx16.edkeyvec+1
sta cx16.r1
sty cx16.r1+1
pla
sta $00
cli
rts
.pend
enable_irq_handlers .proc
php
sei
bcc +
lda #%00001111
trb cx16.VERA_IEN ; disable all IRQ sources
+ lda #<_irq_dispatcher
ldy #>_irq_dispatcher
sta cx16.CINV
sty cx16.CINV+1
plp
rts
_irq_dispatcher
; order of handling: LINE, SPRCOL, AFLOW, VSYNC.
jsr sys.save_prog8_internals
cld
lda cx16.VERA_ISR
and cx16.VERA_IEN ; only consider the bits for sources that can actually raise the IRQ
bit #2
beq +
_mod_line_jump
jsr _default_line_handler ; modified
ldy #2
sty cx16.VERA_ISR
bra _dispatch_end
+
bit #4
beq +
_mod_sprcol_jump
jsr _default_sprcol_handler ; modified
ldy #4
sty cx16.VERA_ISR
bra _dispatch_end
+
bit #8
beq +
_mod_aflow_jump
jsr _default_aflow_handler ; modified
; note: AFLOW can only be cleared by filling the audio FIFO for at least 1/4. Not via the ISR bit.
bra _dispatch_end
+
bit #1
beq +
_mod_vsync_jump
jsr _default_vsync_handler ; modified
cmp #0
bne _dispatch_end
ldy #1
sty cx16.VERA_ISR
bra _return_irq
+
lda #0
_dispatch_end
cmp #0
beq _return_irq
jsr sys.restore_prog8_internals
jmp (sys.restore_irq._orig_irqvec) ; continue with normal kernal irq routine
_return_irq
jsr sys.restore_prog8_internals
ply
plx
pla
rti
_default_vsync_handler
lda #1
rts
_default_line_handler
lda #0
rts
_default_sprcol_handler
lda #0
rts
_default_aflow_handler
lda #0
rts
.pend
set_vsync_irq_handler .proc
php
sei
sta enable_irq_handlers._mod_vsync_jump+1
sty enable_irq_handlers._mod_vsync_jump+2
lda #1
tsb cx16.VERA_IEN
plp
rts
.pend
set_line_irq_handler .proc
php
sei
sta enable_irq_handlers._mod_line_jump+1
sty enable_irq_handlers._mod_line_jump+2
lda cx16.r0
ldy cx16.r0+1
jsr sys.set_rasterline
lda #2
tsb cx16.VERA_IEN
plp
rts
.pend
set_sprcol_irq_handler .proc
php
sei
sta enable_irq_handlers._mod_sprcol_jump+1
sty enable_irq_handlers._mod_sprcol_jump+2
lda #4
tsb cx16.VERA_IEN
plp
rts
.pend
set_aflow_irq_handler .proc
php
sei
sta enable_irq_handlers._mod_aflow_jump+1
sty enable_irq_handlers._mod_aflow_jump+2
lda #8
tsb cx16.VERA_IEN
plp
rts
.pend
cpu_is_65816 .proc
php
clv
.byte $e2, $ea ; SEP #$ea, should be interpreted as 2 NOPs by 6502. 65c816 will set the Overflow flag.
bvc +
lda #1
plp
rts
+ lda #0
plp
rts
.pend
get_program_args .proc
lda #0
rol a
sta P8ZP_SCRATCH_REG
lda $00
pha
stz $00
stz P8ZP_SCRATCH_W1
lda #$bf
sta P8ZP_SCRATCH_W1+1
ldy #0
- lda (P8ZP_SCRATCH_W1),y
sta (cx16.r0),y
beq +
_continue iny
cpy cx16.r1L ; max size?
bne -
beq ++
+ lda P8ZP_SCRATCH_REG ; binary?
bne _continue
+ pla
sta $00
rts
.pend
.pend
; ---- block: 'sys' ----
sys .proc
target = $10
init_system .proc
sei
lda #0
tax
tay
jsr cx16.mouse_config ; disable mouse
cld
lda cx16.VERA_DC_VIDEO
and #%00000111 ; retain chroma + output mode
sta P8ZP_SCRATCH_REG
lda #$0a
sta $01 ; rom bank 10 (audio)
jsr cx16.audio_init ; silence
stz $01 ; rom bank 0 (kernal)
jsr cbm.IOINIT
jsr cbm.RESTOR
jsr cbm.CINT
lda cx16.VERA_DC_VIDEO
and #%11111000
ora P8ZP_SCRATCH_REG
sta cx16.VERA_DC_VIDEO ; restore old output mode
lda #$90 ; black
jsr cbm.CHROUT
lda #1
jsr cbm.CHROUT ; swap fg/bg
lda #$9e ; yellow
jsr cbm.CHROUT
lda #147 ; clear screen
jsr cbm.CHROUT
lda #8 ; disable charset case switch
jsr cbm.CHROUT
lda #PROG8_VARSHIGH_RAMBANK
sta $00 ; select ram bank
lda #0
tax
tay
clc
clv
cli
rts
.pend
init_system_phase2 .proc
sei
lda cx16.CINV
sta restore_irq._orig_irqvec
lda cx16.CINV+1
sta restore_irq._orig_irqvec+1
lda #PROG8_VARSHIGH_RAMBANK
sta $00 ; select ram bank
cli
rts
.pend
cleanup_at_exit .proc
lda #1
sta $00 ; ram bank 1
lda #4
sta $01 ; rom bank 4 (basic)
stz $2d ; hack to reset machine code monitor bank to 0
jsr cbm.CLRCHN ; reset i/o channels
_exitcodeCarry = *+1
lda #0
lsr a
_exitcode = *+1
lda #0 ; exit code possibly modified in exit()
_exitcodeX = *+1
ldx #0
_exitcodeY = *+1
ldy #0
rts
.pend
set_irq .proc
sei
sta _modified+1
sty _modified+2
lda #<_irq_handler
sta cx16.CINV
lda #>_irq_handler
sta cx16.CINV+1
lda #1
tsb cx16.VERA_IEN ; enable the vsync irq
cli
rts
_irq_handler
jsr sys.save_prog8_internals
cld
_modified
jsr $ffff ; modified
pha
jsr sys.restore_prog8_internals
pla
beq +
jmp (restore_irq._orig_irqvec) ; continue with normal kernal irq routine
+ lda #1
sta cx16.VERA_ISR ; clear Vera Vsync irq status
ply
plx
pla
rti
.pend
restore_irq .proc
sei
lda _orig_irqvec
sta cx16.CINV
lda _orig_irqvec+1
sta cx16.CINV+1
lda cx16.VERA_IEN
and #%11110000 ; disable all Vera IRQs but the vsync
ora #%00000001
sta cx16.VERA_IEN
cli
rts
_orig_irqvec .word 0
.pend
set_rasterirq .proc
sei
sta _modified+1
sty _modified+2
lda cx16.r0
ldy cx16.r0+1
lda cx16.VERA_IEN
and #%11110000 ; disable all irqs but the line(raster) one
ora #%00000010
sta cx16.VERA_IEN
lda cx16.r0
ldy cx16.r0+1
jsr set_rasterline
lda #<_raster_irq_handler
sta cx16.CINV
lda #>_raster_irq_handler
sta cx16.CINV+1
cli
rts
_raster_irq_handler
jsr sys.save_prog8_internals
cld
_modified jsr $ffff ; modified
jsr sys.restore_prog8_internals
; end irq processing - don't use kernal's irq handling
lda #2
tsb cx16.VERA_ISR ; clear Vera line irq status
ply
plx
pla
rti
.pend
set_rasterline .proc
php
sei
sta cx16.VERA_IRQLINE_L
tya
lsr a
bcs +
lda #%10000000
trb cx16.VERA_IEN
plp
rts
+ lda #%10000000
tsb cx16.VERA_IEN
plp
rts
.pend
reset_system .proc
sei
ldx #$42
ldy #2
lda #0
jsr cx16.i2c_write_byte
bra *
.pend
wait .proc
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
_loop lda P8ZP_SCRATCH_W1
ora P8ZP_SCRATCH_W1+1
bne +
rts
+ sei
jsr cbm.RDTIM
cli
sta P8ZP_SCRATCH_B1
- sei
jsr cbm.RDTIM
cli
cmp P8ZP_SCRATCH_B1
beq -
lda P8ZP_SCRATCH_W1
bne +
dec P8ZP_SCRATCH_W1+1
+ dec P8ZP_SCRATCH_W1
bra _loop
.pend
internal_stringcopy .proc
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda cx16.r0
ldy cx16.r0+1
jmp prog8_lib.strcpy
.pend
memcopy .proc
cpy #0
bne _longcopy
; copy <= 255 bytes
tay
bne _copyshort
rts ; nothing to copy
_copyshort
dey
beq +
- lda (cx16.r0),y
sta (cx16.r1),y
dey
bne -
+ lda (cx16.r0),y
sta (cx16.r1),y
rts
_longcopy
pha ; lsb(count) = remainder in last page
tya
tax ; x = num pages (1+)
ldy #0
- lda (cx16.r0),y
sta (cx16.r1),y
iny
bne -
inc cx16.r0+1
inc cx16.r1+1
dex
bne -
ply
bne _copyshort
rts
.pend
memset .proc
ldy cx16.r0
sty P8ZP_SCRATCH_W1
ldy cx16.r0+1
sty P8ZP_SCRATCH_W1+1
ldx cx16.r1
ldy cx16.r1+1
jmp prog8_lib.memset
.pend
memsetw .proc
ldx cx16.r0
stx P8ZP_SCRATCH_W1
ldx cx16.r0+1
stx P8ZP_SCRATCH_W1+1
ldx cx16.r1
stx P8ZP_SCRATCH_W2
ldx cx16.r1+1
stx P8ZP_SCRATCH_W2+1
jmp prog8_lib.memsetw
.pend
save_prog8_internals .proc
lda P8ZP_SCRATCH_B1
sta save_SCRATCH_ZPB1
lda P8ZP_SCRATCH_REG
sta save_SCRATCH_ZPREG
lda P8ZP_SCRATCH_W1
sta save_SCRATCH_ZPWORD1
lda P8ZP_SCRATCH_W1+1
sta save_SCRATCH_ZPWORD1+1
lda P8ZP_SCRATCH_W2
sta save_SCRATCH_ZPWORD2
lda P8ZP_SCRATCH_W2+1
sta save_SCRATCH_ZPWORD2+1
rts
save_SCRATCH_ZPB1 .byte 0
save_SCRATCH_ZPREG .byte 0
save_SCRATCH_ZPWORD1 .word 0
save_SCRATCH_ZPWORD2 .word 0
.pend
restore_prog8_internals .proc
lda save_prog8_internals.save_SCRATCH_ZPB1
sta P8ZP_SCRATCH_B1
lda save_prog8_internals.save_SCRATCH_ZPREG
sta P8ZP_SCRATCH_REG
lda save_prog8_internals.save_SCRATCH_ZPWORD1
sta P8ZP_SCRATCH_W1
lda save_prog8_internals.save_SCRATCH_ZPWORD1+1
sta P8ZP_SCRATCH_W1+1
lda save_prog8_internals.save_SCRATCH_ZPWORD2
sta P8ZP_SCRATCH_W2
lda save_prog8_internals.save_SCRATCH_ZPWORD2+1
sta P8ZP_SCRATCH_W2+1
rts
.pend
exit .proc
sta cleanup_at_exit._exitcode
ldx prog8_lib.orig_stackpointer
txs
jmp cleanup_at_exit
.pend
exit2 .proc
sta cleanup_at_exit._exitcode
stx cleanup_at_exit._exitcodeX
sty cleanup_at_exit._exitcodeY
ldx prog8_lib.orig_stackpointer
txs
jmp cleanup_at_exit
.pend
exit3 .proc
sta cleanup_at_exit._exitcode
lda #0
rol a
sta cleanup_at_exit._exitcodeCarry
stx cleanup_at_exit._exitcodeX
sty cleanup_at_exit._exitcodeY
ldx prog8_lib.orig_stackpointer
txs
jmp cleanup_at_exit
.pend
.pend
; ---- block: 'conv' ----
conv .proc
; non-zeropage variables
string_out ; PETSCII:"????????????????"
.byte $3f, $3f, $3f, $3f, $3f, $3f, $3f, $3f, $3f, $3f, $3f, $3f, $3f, $3f, $3f, $3f
.byte $00
str_ub0 .proc
jsr conv.ubyte2decimal
sty string_out
sta string_out+1
stx string_out+2
lda #0
sta string_out+3
lda #<string_out
ldy #>string_out
rts
.pend
str_ub .proc
ldy #0
sty P8ZP_SCRATCH_B1
jsr conv.ubyte2decimal
_output_byte_digits
; hundreds?
cpy #'0'
beq +
pha
tya
ldy P8ZP_SCRATCH_B1
sta string_out,y
pla
inc P8ZP_SCRATCH_B1
; tens?
+ ldy P8ZP_SCRATCH_B1
cmp #'0'
beq +
sta string_out,y
iny
+ ; ones.
txa
sta string_out,y
iny
lda #0
sta string_out,y
lda #<string_out
ldy #>string_out
rts
.pend
str_b .proc
ldy #0
sty P8ZP_SCRATCH_B1
cmp #0
bpl +
pha
lda #'-'
sta string_out
inc P8ZP_SCRATCH_B1
pla
+ jsr conv.byte2decimal
bra str_ub._output_byte_digits
.pend
str_ubhex .proc
jsr conv.ubyte2hex
sta string_out
sty string_out+1
lda #0
sta string_out+2
lda #<string_out
ldy #>string_out
rts
.pend
str_ubbin .proc
sta P8ZP_SCRATCH_B1
ldy #0
sty string_out+8
ldy #7
- lsr P8ZP_SCRATCH_B1
bcc +
lda #'1'
bne _digit
+ lda #'0'
_digit sta string_out,y
dey
bpl -
lda #<string_out
ldy #>string_out
rts
.pend
str_uwbin .proc
sta P8ZP_SCRATCH_REG
tya
jsr str_ubbin
ldy #0
sty string_out+16
ldy #7
- lsr P8ZP_SCRATCH_REG
bcc +
lda #'1'
bne _digit
+ lda #'0'
_digit sta string_out+8,y
dey
bpl -
lda #<string_out
ldy #>string_out
rts
.pend
str_uwhex .proc
pha
tya
jsr conv.ubyte2hex
sta string_out
sty string_out+1
pla
jsr conv.ubyte2hex
sta string_out+2
sty string_out+3
lda #0
sta string_out+4
lda #<string_out
ldy #>string_out
rts
.pend
str_uw0 .proc
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
sta string_out,y
beq +
iny
bne -
+
lda #<string_out
ldy #>string_out
rts
.pend
str_uw .proc
jsr conv.uword2decimal
ldx #0
_output_digits
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
iny
bne -
_gotdigit sta string_out,x
inx
iny
lda conv.uword2decimal.decTenThousands,y
bne _gotdigit
_end lda #0
sta string_out,x
lda #<string_out
ldy #>string_out
rts
_allzero lda #'0'
sta string_out,x
inx
bne _end
.pend
str_w .proc
cpy #0
bpl str_uw
pha
lda #'-'
sta string_out
tya
eor #255
tay
pla
eor #255
clc
adc #1
bcc +
iny
+ jsr conv.uword2decimal
ldx #1
bne str_uw._output_digits
rts
.pend
any2uword .proc
pha
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
lda (P8ZP_SCRATCH_W1),y
ldy P8ZP_SCRATCH_W1+1
cmp #'$'
beq _hex
cmp #'%'
beq _bin
pla
jsr str2uword
jmp _result
_hex pla
jsr hex2uword
jmp _result
_bin pla
jsr bin2uword
_result
pha
lda cx16.r15
sta P8ZP_SCRATCH_B1 ; result value
pla
sta cx16.r15
sty cx16.r15+1
lda P8ZP_SCRATCH_B1
rts
.pend
str2uword .proc
_result = P8ZP_SCRATCH_W1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
sty _result
sty _result+1
sty cx16.r15+1
_loop
lda (P8ZP_SCRATCH_W2),y
sec
sbc #48
bpl _digit
_done
sty cx16.r15
lda _result
ldy _result+1
rts
_digit
cmp #10
bcs _done
; add digit to result
pha
jsr _result_times_10
pla
clc
adc _result
sta _result
bcc +
inc _result+1
+ iny
bne _loop
; never reached
_result_times_10 ; (W*4 + W)*2
lda _result+1
sta P8ZP_SCRATCH_REG
lda _result
asl a
rol P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
clc
adc _result
sta _result
lda P8ZP_SCRATCH_REG
adc _result+1
asl _result
rol a
sta _result+1
rts
.pend
str2word .proc
_result = P8ZP_SCRATCH_W1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
sty _result
sty _result+1
sty _negative
sty cx16.r15+1
lda (P8ZP_SCRATCH_W2),y
cmp #'+'
bne +
iny
+ cmp #'-'
bne _parse
inc _negative
iny
_parse lda (P8ZP_SCRATCH_W2),y
sec
sbc #48
bpl _digit
_done
sty cx16.r15
lda _negative
beq +
sec
lda #0
sbc _result
sta _result
lda #0
sbc _result+1
sta _result+1
+ lda _result
ldy _result+1
rts
_digit
cmp #10
bcs _done
; add digit to result
pha
jsr str2uword._result_times_10
pla
clc
adc _result
sta _result
bcc +
inc _result+1
+ iny
bne _parse
; never reached
_negative .byte 0
.pend
hex2uword .proc
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
sty P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sty cx16.r15+1
lda (P8ZP_SCRATCH_W2),y
beq _stop
cmp #'$'
bne _loop
iny
_loop
lda #0
sta P8ZP_SCRATCH_B1
lda (P8ZP_SCRATCH_W2),y
beq _stop
cmp #7 ; screencode letters A-F are 1-6
bcc _add_letter
and #127
cmp #97
bcs _try_iso ; maybe letter is iso:'a'-iso:'f' (97-102)
cmp #'g'
bcs _stop
cmp #'a'
bcs _add_letter
cmp #'0'
bcc _stop
cmp #'9'+1
bcs _stop
_calc
asl P8ZP_SCRATCH_W1
rol P8ZP_SCRATCH_W1+1
asl P8ZP_SCRATCH_W1
rol P8ZP_SCRATCH_W1+1
asl P8ZP_SCRATCH_W1
rol P8ZP_SCRATCH_W1+1
asl P8ZP_SCRATCH_W1
rol P8ZP_SCRATCH_W1+1
and #$0f
clc
adc P8ZP_SCRATCH_B1
ora P8ZP_SCRATCH_W1
sta P8ZP_SCRATCH_W1
iny
bne _loop
_stop
sty cx16.r15
lda P8ZP_SCRATCH_W1
ldy P8ZP_SCRATCH_W1+1
rts
_add_letter
pha
lda #9
sta P8ZP_SCRATCH_B1
pla
jmp _calc
_try_iso
cmp #103
bcs _stop
and #63
bne _add_letter
.pend
bin2uword .proc
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
sty P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sty cx16.r15+1
lda (P8ZP_SCRATCH_W2),y
beq _stop
cmp #'%'
bne _loop
iny
_loop
lda (P8ZP_SCRATCH_W2),y
cmp #'0'
bcc _stop
cmp #'2'
bcs _stop
_first asl P8ZP_SCRATCH_W1
rol P8ZP_SCRATCH_W1+1
and #1
ora P8ZP_SCRATCH_W1
sta P8ZP_SCRATCH_W1
iny
bne _loop
_stop
sty cx16.r15
lda P8ZP_SCRATCH_W1
ldy P8ZP_SCRATCH_W1+1
rts
.pend
ubyte2decimal .proc
ldy #uword2decimal.ASCII_0_OFFSET
jmp uword2decimal.hex_try200
.pend
uword2decimal .proc
;Convert 16 bit Hex to Decimal (0-65535) Rev 2
;By Omegamatrix Further optimizations by tepples
; routine from https://forums.nesdev.org/viewtopic.php?p=130363&sid=1944ba8bac4d6afa9c02e3cc42304e6b#p130363
;HexToDec99
; start in A
; end with A = 10's, decOnes (also in X)
;HexToDec255
; start in A
; end with Y = 100's, A = 10's, decOnes (also in X)
;HexToDec999
; start with A = high byte, Y = low byte
; end with Y = 100's, A = 10's, decOnes (also in X)
; requires 1 extra temp register on top of decOnes, could combine
; these two if HexToDec65535 was eliminated...
;HexToDec65535
; start with A/Y (low/high) as 16 bit value
; end with decTenThousand, decThousand, Y = 100's, A = 10's, decOnes (also in X)
; (irmen: I store Y and A in decHundreds and decTens too, so all of it can be easily printed)
ASCII_0_OFFSET = $30
temp = P8ZP_SCRATCH_B1 ; byte in zeropage
hexHigh = P8ZP_SCRATCH_W1 ; byte in zeropage
hexLow = P8ZP_SCRATCH_W1+1 ; byte in zeropage
HexToDec65535; SUBROUTINE
sty hexHigh ;3 @9
sta hexLow ;3 @12
tya
tax ;2 @14
lsr a ;2 @16
lsr a ;2 @18 integer divide 1024 (result 0-63)
cpx #$A7 ;2 @20 account for overflow of multiplying 24 from 43,000 ($A7F8) onward,
adc #1 ;2 @22 we can just round it to $A700, and the divide by 1024 is fine...
;at this point we have a number 1-65 that we have to times by 24,
;add to original sum, and Mod 1024 to get a remainder 0-999
sta temp ;3 @25
asl a ;2 @27
adc temp ;3 @30 x3
tay ;2 @32
lsr a ;2 @34
lsr a ;2 @36
lsr a ;2 @38
lsr a ;2 @40
lsr a ;2 @42
tax ;2 @44
tya ;2 @46
asl a ;2 @48
asl a ;2 @50
asl a ;2 @52
clc ;2 @54
adc hexLow ;3 @57
sta hexLow ;3 @60
txa ;2 @62
adc hexHigh ;3 @65
sta hexHigh ;3 @68
ror a ;2 @70
lsr a ;2 @72
tay ;2 @74 integer divide 1,000 (result 0-65)
lsr a ;2 @76 split the 1,000 and 10,000 digit
tax ;2 @78
lda ShiftedBcdTab,x ;4 @82
tax ;2 @84
rol a ;2 @86
and #$0F ;2 @88
ora #ASCII_0_OFFSET
sta decThousands ;3 @91
txa ;2 @93
lsr a ;2 @95
lsr a ;2 @97
lsr a ;2 @99
ora #ASCII_0_OFFSET
sta decTenThousands ;3 @102
lda hexLow ;3 @105
cpy temp ;3 @108
bmi _doSubtract ;2³ @110/111
beq _useZero ;2³ @112/113
adc #23 + 24 ;2 @114
_doSubtract
sbc #23 ;2 @116
sta hexLow ;3 @119
_useZero
lda hexHigh ;3 @122
sbc #0 ;2 @124
Start100s
and #$03 ;2 @126
tax ;2 @128 0,1,2,3
cmp #2 ;2 @130
rol a ;2 @132 0,2,5,7
ora #ASCII_0_OFFSET
tay ;2 @134 Y = Hundreds digit
lda hexLow ;3 @137
adc Mod100Tab,x ;4 @141 adding remainder of 256, 512, and 256+512 (all mod 100)
bcs hex_doSub200 ;2³ @143/144
hex_try200
cmp #200 ;2 @145
bcc hex_try100 ;2³ @147/148
hex_doSub200
iny ;2 @149
iny ;2 @151
sbc #200 ;2 @153
hex_try100
cmp #100 ;2 @155
bcc HexToDec99 ;2³ @157/158
iny ;2 @159
sbc #100 ;2 @161
HexToDec99; SUBROUTINE
lsr a ;2 @163
tax ;2 @165
lda ShiftedBcdTab,x ;4 @169
tax ;2 @171
rol a ;2 @173
and #$0F ;2 @175
ora #ASCII_0_OFFSET
sta decOnes ;3 @178
txa ;2 @180
lsr a ;2 @182
lsr a ;2 @184
lsr a ;2 @186
ora #ASCII_0_OFFSET
; irmen: load X with ones, and store Y and A too, for easy printing afterwards
sty decHundreds
sta decTens
ldx decOnes
rts ;6 @192 Y=hundreds, A = tens digit, X=ones digit
HexToDec999; SUBROUTINE
sty hexLow ;3 @9
jmp Start100s ;3 @12
Mod100Tab
.byte 0,56,12,56+12
ShiftedBcdTab
.byte $00,$01,$02,$03,$04,$08,$09,$0A,$0B,$0C
.byte $10,$11,$12,$13,$14,$18,$19,$1A,$1B,$1C
.byte $20,$21,$22,$23,$24,$28,$29,$2A,$2B,$2C
.byte $30,$31,$32,$33,$34,$38,$39,$3A,$3B,$3C
.byte $40,$41,$42,$43,$44,$48,$49,$4A,$4B,$4C
decTenThousands .byte 0
decThousands .byte 0
decHundreds .byte 0
decTens .byte 0
decOnes .byte 0
.byte 0 ; zero-terminate the decimal output string
.pend
byte2decimal .proc
cmp #0
bpl +
eor #255
clc
adc #1
+ jmp ubyte2decimal
.pend
ubyte2hex .proc
pha
and #$0f
tax
ldy _hex_digits,x
pla
lsr a
lsr a
lsr a
lsr a
tax
lda _hex_digits,x
rts
_hex_digits .text "0123456789abcdef" ; can probably be reused for other stuff as well
.pend
uword2hex .proc
sta P8ZP_SCRATCH_REG
tya
jsr ubyte2hex
sta output
sty output+1
lda P8ZP_SCRATCH_REG
jsr ubyte2hex
sta output+2
sty output+3
rts
output .text "0000", $00 ; 0-terminated output buffer (to make printing easier)
.pend
.pend
; ---- block: 'math' ----
math .proc
; Internal Math library routines - always included by the compiler
; Generic machine independent 6502 code.
;
; some more interesting routines can be found here:
; http://6502org.wikidot.com/software-math
; http://codebase64.org/doku.php?id=base:6502_6510_maths
; https://github.com/TobyLobster/multiply_test
; https://github.com/TobyLobster/sqrt_test
multiply_bytes .proc
; -- multiply 2 bytes A and Y, result as byte in A (signed or unsigned)
; https://github.com/TobyLobster/multiply_test/blob/main/tests/mult29.a
_multiplicand = P8ZP_SCRATCH_B1
_multiplier = P8ZP_SCRATCH_REG
sty _multiplicand
lsr a
sta _multiplier
lda #0
ldx #2
-
bcc +
clc
adc _multiplicand
+
ror a
ror _multiplier
bcc +
clc
adc _multiplicand
+
ror a
ror _multiplier
bcc +
clc
adc _multiplicand
+
ror a
ror _multiplier
bcc +
clc
adc _multiplicand
+
ror a
ror _multiplier
dex
bne -
; tay ; if you want 16 bits result in AY, enable this again
lda _multiplier
rts
.pend
multiply_words .proc
; -- multiply two 16-bit words into a 32-bit result (signed and unsigned)
; input: A/Y = first 16-bit number, multiply_words.multiplier = second 16-bit number
; output: multiply_words.result, 4-bytes/32-bits product, LSB order (low-to-high) low 16 bits also in AY.
; NOTE: the result (which includes the multiplier parameter on entry) is a 4-byte array.
; this routine could be faster if we could stick that into zeropage,
; but there currently is no way to use 4 consecutive bytes in ZP (without disabling irq and saving/restoring them)...
; mult62.a
; from: https://github.com/TobyLobster/multiply_test/blob/main/tests/mult62.a
; based on Dr Jefyll, http://forum.6502.org/viewtopic.php?f=9&t=689&start=0#p19958
; - adjusted to use fixed zero page addresses
; - removed 'decrement to avoid clc' as this is slower on average
; - rearranged memory use to remove final memory copy and give LSB first order to result
; - removed temp zp storage bytes
; - unrolled the outer loop
; - unrolled the two inner loops once
;
; 16 bit x 16 bit unsigned multiply, 32 bit result
; Average cycles: ~442 ?
; 93 bytes
_multiplicand = P8ZP_SCRATCH_W2 ; 2 bytes
multiplier = result
; 16 bit x 16 bit unsigned multiply, 32 bit result
;
; On Entry:
; (multiplier, multiplier+1): two byte multiplier, four bytes needed for result
; (multiplicand, multiplicand+1): two byte multiplicand
; On Exit:
; (result, result+1, result+2, result+3): product
sta _multiplicand
sty _multiplicand+1
lda #0 ;
sta result+2 ; 16 bits of zero in A, result+2
; Note: First 8 shifts are A -> result+2 -> result
; Final 8 shifts are A -> result+2 -> result+1
; --- 1st byte ---
ldy #4 ; count for inner loop
lsr result
; inner loop (8 times)
_inner_loop
; first time
bcc +
tax ; retain A
lda result+2
clc
adc _multiplicand
sta result+2
txa ; recall A
adc _multiplicand+1
+
ror a ; shift
ror result+2
ror result
; second time
bcc +
tax ; retain A
lda result+2
clc
adc _multiplicand
sta result+2
txa ; recall A
adc _multiplicand+1
+
ror a ; shift
ror result+2
ror result
dey
bne _inner_loop ; go back for 1 more shift?
; --- 2nd byte ---
ldy #4 ; count for inner loop
lsr result+1
; inner loop (8 times)
_inner_loop2
; first time
bcc +
tax ; retain A
lda result+2
clc
adc _multiplicand
sta result+2
txa ; recall A
adc _multiplicand+1
+
ror a ; shift
ror result+2
ror result+1
; second time
bcc +
tax ; retain A
lda result+2
clc
adc _multiplicand
sta result+2
txa ; recall A
adc _multiplicand+1
+
ror a ; shift
ror result+2
ror result+1
dey
bne _inner_loop2 ; go back for 1 more shift?
sta result+3 ; ms byte of hi-word of result
lda result
ldy result+1
rts
result .byte 0,0,0,0
.pend
divmod_b_asm .proc
; signed byte division: make everything positive and fix sign afterwards
sta P8ZP_SCRATCH_B1
tya
eor P8ZP_SCRATCH_B1
php ; save sign
lda P8ZP_SCRATCH_B1
bpl +
eor #$ff
sec
adc #0 ; make it positive
+ pha
tya
bpl +
eor #$ff
sec
adc #0 ; make it positive
tay
+ pla
jsr divmod_ub_asm
sta _remainder
plp
bpl +
tya
eor #$ff
sec
adc #0 ; negate result
tay
+ rts
_remainder .byte 0
.pend
divmod_ub_asm .proc
; -- divide A by Y, result quotient in Y, remainder in A (unsigned)
; division by zero will result in quotient = 255 and remainder = original number
sty P8ZP_SCRATCH_REG
sta P8ZP_SCRATCH_B1
lda #0
ldx #8
asl P8ZP_SCRATCH_B1
- rol a
cmp P8ZP_SCRATCH_REG
bcc +
sbc P8ZP_SCRATCH_REG
+ rol P8ZP_SCRATCH_B1
dex
bne -
ldy P8ZP_SCRATCH_B1
rts
.pend
divmod_w_asm .proc
; signed word division: make everything positive and fix sign afterwards
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
lda P8ZP_SCRATCH_W1+1
eor P8ZP_SCRATCH_W2+1
php ; save sign
lda P8ZP_SCRATCH_W1+1
bpl +
lda #0
sec
sbc P8ZP_SCRATCH_W1
sta P8ZP_SCRATCH_W1
lda #0
sbc P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W1+1
+ lda P8ZP_SCRATCH_W2+1
bpl +
lda #0
sec
sbc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W2
lda #0
sbc P8ZP_SCRATCH_W2+1
sta P8ZP_SCRATCH_W2+1
+ tay
lda P8ZP_SCRATCH_W2
jsr divmod_uw_asm
plp ; restore sign
bpl +
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
lda #0
sec
sbc P8ZP_SCRATCH_W2
pha
lda #0
sbc P8ZP_SCRATCH_W2+1
tay
pla
+ rts
.pend
divmod_uw_asm .proc
; -- divide two unsigned words (16 bit each) into 16 bit results
; input: P8ZP_SCRATCH_W1 in ZP: 16 bit number, A/Y: 16 bit divisor
; output: P8ZP_SCRATCH_W2 in ZP: 16 bit remainder, A/Y: 16 bit division result
; division by zero will result in quotient = 65535 and remainder = divident
dividend = P8ZP_SCRATCH_W1
remainder = P8ZP_SCRATCH_W2
result = dividend ;save memory by reusing divident to store the result
sta _divisor
sty _divisor+1
lda #0 ;preset remainder to 0
sta remainder
sta remainder+1
ldx #16 ;repeat for each bit: ...
- asl dividend ;dividend lb & hb*2, msb -> Carry
rol dividend+1
rol remainder ;remainder lb & hb * 2 + msb from carry
rol remainder+1
lda remainder
sec
sbc _divisor ;substract divisor to see if it fits in
tay ;lb result -> Y, for we may need it later
lda remainder+1
sbc _divisor+1
bcc + ;if carry=0 then divisor didn't fit in yet
sta remainder+1 ;else save substraction result as new remainder,
sty remainder
inc result ;and INCrement result cause divisor fit in 1 times
+ dex
bne -
lda result
ldy result+1
rts
_divisor .word 0
.pend
randword .proc
; -- 16 bit pseudo random number generator into AY
; default seed = $00c2 $1137
; routine from https://codebase64.org/doku.php?id=base:x_abc_random_number_generator_8_16_bit
inc x1
clc
x1=*+1
lda #$00 ;x1
c1=*+1
eor #$c2 ;c1
a1=*+1
eor #$11 ;a1
sta a1
b1=*+1
adc #$37 ;b1
sta b1
lsr a
eor a1
adc c1
sta c1
ldy b1
rts
.pend
randbyte = randword ; -- 8 bit pseudo random number generator into A (by just reusing randword)
; ----------- optimized multiplications (in-place A (byte) and ?? (word)) : ---------
mul_byte_3 .proc
; A = A + A*2
sta P8ZP_SCRATCH_REG
asl a
clc
adc P8ZP_SCRATCH_REG
rts
.pend
mul_word_3 .proc
; AY = AY*2 + AY
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
adc P8ZP_SCRATCH_W2+1
tay
lda P8ZP_SCRATCH_W1
rts
.pend
mul_byte_5 .proc
; A = A*4 + A
sta P8ZP_SCRATCH_REG
asl a
asl a
clc
adc P8ZP_SCRATCH_REG
rts
.pend
mul_word_5 .proc
; AY = AY*4 + AY
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
adc P8ZP_SCRATCH_W2+1
tay
lda P8ZP_SCRATCH_W1
rts
.pend
mul_byte_6 .proc
; A = (A*2 + A)*2
sta P8ZP_SCRATCH_REG
asl a
clc
adc P8ZP_SCRATCH_REG
asl a
rts
.pend
mul_word_6 .proc
; AY = (AY*2 + AY)*2
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
tay
lda P8ZP_SCRATCH_W1+1
adc P8ZP_SCRATCH_W2+1
sta P8ZP_SCRATCH_W1+1
tya
asl a
rol P8ZP_SCRATCH_W1+1
ldy P8ZP_SCRATCH_W1+1
rts
.pend
mul_byte_7 .proc
; A = A*8 - A
sta P8ZP_SCRATCH_REG
asl a
asl a
asl a
sec
sbc P8ZP_SCRATCH_REG
rts
.pend
mul_word_7 .proc
; AY = AY*8 - AY
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
sec
sbc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
sbc P8ZP_SCRATCH_W2+1
tay
lda P8ZP_SCRATCH_W1
rts
.pend
mul_byte_9 .proc
; A = A*8 + A
sta P8ZP_SCRATCH_REG
asl a
asl a
asl a
clc
adc P8ZP_SCRATCH_REG
rts
.pend
mul_word_9 .proc
; AY = AY*8 + AY
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
adc P8ZP_SCRATCH_W2+1
tay
lda P8ZP_SCRATCH_W1
rts
rts
.pend
mul_byte_10 .proc
; A=(A*4 + A)*2
sta P8ZP_SCRATCH_REG
asl a
asl a
clc
adc P8ZP_SCRATCH_REG
asl a
rts
.pend
mul_word_10 .proc
; AY=(AY*4 + AY)*2
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
adc P8ZP_SCRATCH_W2+1
sta P8ZP_SCRATCH_W1+1
lda P8ZP_SCRATCH_W1
asl a
rol P8ZP_SCRATCH_W1+1
ldy P8ZP_SCRATCH_W1+1
rts
.pend
mul_byte_11 .proc
; A=(A*2 + A)*4 - A
sta P8ZP_SCRATCH_REG
asl a
clc
adc P8ZP_SCRATCH_REG
asl a
asl a
sec
sbc P8ZP_SCRATCH_REG
rts
.pend
; mul_word_11 is skipped (too much code)
mul_byte_12 .proc
; A=(A*2 + A)*4
sta P8ZP_SCRATCH_REG
asl a
clc
adc P8ZP_SCRATCH_REG
asl a
asl a
rts
.pend
mul_word_12 .proc
; AY=(AY*2 + AY)*4
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
adc P8ZP_SCRATCH_W2+1
sta P8ZP_SCRATCH_W1+1
lda P8ZP_SCRATCH_W1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
ldy P8ZP_SCRATCH_W1+1
rts
.pend
mul_byte_13 .proc
; A=(A*2 + A)*4 + A
sta P8ZP_SCRATCH_REG
asl a
clc
adc P8ZP_SCRATCH_REG
asl a
asl a
clc
adc P8ZP_SCRATCH_REG
rts
.pend
; mul_word_13 is skipped (too much code)
mul_byte_14 .proc
; A=(A*8 - A)*2
sta P8ZP_SCRATCH_REG
asl a
asl a
asl a
sec
sbc P8ZP_SCRATCH_REG
asl a
rts
.pend
; mul_word_14 is skipped (too much code)
mul_byte_15 .proc
; A=A*16 - A
sta P8ZP_SCRATCH_REG
asl a
asl a
asl a
asl a
sec
sbc P8ZP_SCRATCH_REG
rts
.pend
mul_word_15 .proc
; AY = AY * 16 - AY
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
sec
sbc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
sbc P8ZP_SCRATCH_W2+1
tay
lda P8ZP_SCRATCH_W1
rts
.pend
mul_byte_20 .proc
; A=(A*4 + A)*4
sta P8ZP_SCRATCH_REG
asl a
asl a
clc
adc P8ZP_SCRATCH_REG
asl a
asl a
rts
.pend
mul_word_20 .proc
; AY = AY * 10 * 2
jsr mul_word_10
sty P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
ldy P8ZP_SCRATCH_REG
rts
.pend
mul_byte_25 .proc
; A=(A*2 + A)*8 + A
sta P8ZP_SCRATCH_REG
asl a
clc
adc P8ZP_SCRATCH_REG
asl a
asl a
asl a
clc
adc P8ZP_SCRATCH_REG
rts
.pend
mul_word_25 .proc
; AY = (AY*2 + AY) *8 + AY
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
adc P8ZP_SCRATCH_W2+1
sta P8ZP_SCRATCH_W1+1
lda P8ZP_SCRATCH_W1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
adc P8ZP_SCRATCH_W2+1
tay
lda P8ZP_SCRATCH_W1
rts
.pend
mul_byte_40 .proc
and #7
tay
lda _forties,y
rts
_forties .byte 0*40, 1*40, 2*40, 3*40, 4*40, 5*40, 6*40, 7*40 & 255
.pend
mul_word_40 .proc
; AY = (AY*4 + AY)*8
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
asl a
rol P8ZP_SCRATCH_W1+1
asl a
rol P8ZP_SCRATCH_W1+1
clc
adc P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_W1
lda P8ZP_SCRATCH_W1+1
adc P8ZP_SCRATCH_W2+1
asl P8ZP_SCRATCH_W1
rol a
asl P8ZP_SCRATCH_W1
rol a
asl P8ZP_SCRATCH_W1
rol a
tay
lda P8ZP_SCRATCH_W1
rts
.pend
mul_byte_50 .proc
and #7
tay
lda _fifties, y
rts
_fifties .byte 0*50, 1*50, 2*50, 3*50, 4*50, 5*50, 6*50 & 255, 7*50 & 255
.pend
mul_word_50 .proc
; AY = AY * 25 * 2
jsr mul_word_25
sty P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
ldy P8ZP_SCRATCH_REG
rts
.pend
mul_byte_80 .proc
and #3
tay
lda _eighties, y
rts
_eighties .byte 0*80, 1*80, 2*80, 3*80
.pend
mul_word_80 .proc
; AY = AY * 40 * 2
jsr mul_word_40
sty P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
ldy P8ZP_SCRATCH_REG
rts
.pend
mul_byte_100 .proc
and #3
tay
lda _hundreds, y
rts
_hundreds .byte 0*100, 1*100, 2*100, 3*100 & 255
.pend
mul_word_100 .proc
; AY = AY * 25 * 4
jsr mul_word_25
sty P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
ldy P8ZP_SCRATCH_REG
rts
.pend
mul_word_320 .proc
; AY = A * 256 + A * 64 (msb in Y doesn't matter)
sta P8ZP_SCRATCH_B1
ldy #0
sty P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
asl a
rol P8ZP_SCRATCH_REG
pha
clc
lda P8ZP_SCRATCH_B1
adc P8ZP_SCRATCH_REG
tay
pla
rts
.pend
mul_word_640 .proc
; AY = (A * 2 * 320) (msb in Y doesn't matter)
asl a
jmp mul_word_320
.pend
; ----------- end optimized multiplications -----------
; support for bit shifting that is too large to be unrolled:
lsr_byte_A .proc
; -- lsr signed byte in A times the value in Y
cpy #0
beq +
cmp #0
bpl lsr_ubyte_A
- sec
ror a
dey
bne -
+ rts
.pend
lsr_ubyte_A .proc
; -- lsr unsigned byte in A times the value in Y
cpy #0
beq +
- lsr a
dey
bne -
+ rts
.pend
asl_byte_A .proc
; -- asl any byte in A times the value in Y
cpy #0
beq +
- asl a
dey
bne -
+ rts
.pend
lsr_word_AY .proc
; -- lsr signed word in AY times the value in X
cpx #0
beq +
cpy #0
bpl lsr_uword_AY
sty P8ZP_SCRATCH_B1
- sec
ror P8ZP_SCRATCH_B1
ror a
dex
bne -
ldy P8ZP_SCRATCH_B1
+ rts
.pend
lsr_uword_AY .proc
; -- lsr unsigned word in AY times the value in X
cpx #0
beq +
sty P8ZP_SCRATCH_B1
- lsr P8ZP_SCRATCH_B1
ror a
dex
bne -
ldy P8ZP_SCRATCH_B1
+ rts
.pend
asl_word_AY .proc
; -- asl any word in AY times the value in X
cpx #0
beq +
sty P8ZP_SCRATCH_B1
- asl a
rol P8ZP_SCRATCH_B1
dex
bne -
ldy P8ZP_SCRATCH_B1
+ rts
.pend
square .proc
; -- calculate square of signed word (actually -255..255) in AY, result in AY
; routine by Lee Davison, source: http://6502.org/source/integers/square.htm
; using this routine is a lot faster as doing a regular multiplication (for words)
;
; Calculates the 16 bit unsigned integer square of the signed 16 bit integer in
; Numberl/Numberh. The result is always in the range 0 to 65025 and is held in
; Squarel/Squareh
;
; The maximum input range is only +/-255 and no checking is done to ensure that
; this is so.
;
; This routine is useful if you are trying to draw circles as for any circle
;
; x^2+y^2=r^2 where x and y are the co-ordinates of any point on the circle and
; r is the circle radius
numberl = P8ZP_SCRATCH_W1 ; number to square low byte
numberh = P8ZP_SCRATCH_W1+1 ; number to square high byte
squarel = P8ZP_SCRATCH_W2 ; square low byte
squareh = P8ZP_SCRATCH_W2+1 ; square high byte
tempsq = P8ZP_SCRATCH_B1 ; temp byte for intermediate result
sta numberl
sty numberh
lda #$00 ; clear a
sta squarel ; clear square low byte
; (no need to clear the high byte, it gets shifted out)
lda numberl ; get number low byte
ldx numberh ; get number high byte
bpl _nonneg ; if +ve don't negate it
; else do a two's complement
eor #$ff ; invert
sec ; +1
adc #$00 ; and add it
_nonneg:
sta tempsq ; save abs(number)
ldx #$08 ; set bit count
_nextr2bit:
asl squarel ; low byte *2
rol squareh ; high byte *2+carry from low
asl a ; shift number byte
bcc _nosqadd ; don't do add if c = 0
tay ; save a
clc ; clear carry for add
lda tempsq ; get number
adc squarel ; add number^2 low byte
sta squarel ; save number^2 low byte
lda #$00 ; clear a
adc squareh ; add number^2 high byte
sta squareh ; save number^2 high byte
tya ; get a back
_nosqadd:
dex ; decrement bit count
bne _nextr2bit ; go do next bit
lda squarel
ldy squareh
rts
.pend
sin8u .proc
tay
lda _sinecos8u,y
rts
_sinecos8u .byte trunc(128.0 + 127.5 * sin(range(256+64) * rad(360.0/256.0)))
.pend
cos8u .proc
tay
lda sin8u._sinecos8u+64,y
rts
.pend
sin8 .proc
tay
lda _sinecos8,y
rts
_sinecos8 .char trunc(127.0 * sin(range(256+64) * rad(360.0/256.0)))
.pend
cos8 .proc
tay
lda sin8._sinecos8+64,y
rts
.pend
sinr8u .proc
tay
lda _sinecosR8u,y
rts
_sinecosR8u .byte trunc(128.0 + 127.5 * sin(range(180+45) * rad(360.0/180.0)))
.pend
cosr8u .proc
tay
lda sinr8u._sinecosR8u+45,y
rts
.pend
sinr8 .proc
tay
lda _sinecosR8,y
rts
_sinecosR8 .char trunc(127.0 * sin(range(180+45) * rad(360.0/180.0)))
.pend
cosr8 .proc
tay
lda sinr8._sinecosR8+45,y
rts
.pend
rnd .proc
jmp math.randbyte
.pend
rndw .proc
jmp math.randword
.pend
rndseed .proc
sta math.randword.x1
sty math.randword.c1
lda cx16.r0L
sta math.randword.a1
lda cx16.r0H
sta math.randword.b1
rts
.pend
log2 .proc
sta P8ZP_SCRATCH_B1
lda #$80
ldy #7
- bit P8ZP_SCRATCH_B1
beq +
rts
+ dey
bne +
rts
+ lsr a
bne -
.pend
log2w .proc
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
lda #<$8000
sta cx16.r0
lda #>$8000
sta cx16.r0+1
ldy #15
- lda P8ZP_SCRATCH_W1
and cx16.r0
sta P8ZP_SCRATCH_B1
lda P8ZP_SCRATCH_W1+1
and cx16.r0+1
ora P8ZP_SCRATCH_B1
beq +
rts
+ dey
bne +
rts
+ lsr cx16.r0+1
ror cx16.r0
jmp -
.pend
mul16_last_upper .proc
lda multiply_words.result+2
ldy multiply_words.result+3
rts
.pend
direction_qd .proc
x_delta = cx16.r0L
y_delta = cx16.r1L
quadrant = cx16.r2L
half_value = cx16.r3L
region_number = cx16.r4L
small = cx16.r5L
large = cx16.r5H
sta quadrant
sty y_delta
stx x_delta
cpx y_delta
bcs _XGreaterOrEqualY
_XLessY:
lda #16
sta region_number
stx small
sty large
bne _DetermineRegion
_XGreaterOrEqualY:
lda #0
sta region_number
stx large
sty small
_DetermineRegion:
; set A = small * 2.5
lda small
lsr a
sta half_value
lda small
asl a
bcs _SmallerQuotient
clc
adc half_value
bcs _SmallerQuotient
cmp large
bcc _LargerQuotient
; S * 2.5 > L
_SmallerQuotient:
; set A = S * 1.25
lsr half_value
lda small
clc
adc half_value
cmp large
bcc _Region1 ; if S * 1.25 < L then goto Region1 (L / S > 1.25)
bcs _Region0 ; (L / S < 1.25)
; S * 2.5 < L
_LargerQuotient:
; set A = S * 7.5
lda small
asl a
asl a
asl a
bcs _Region2
sec
sbc half_value
cmp large
bcc _Region3 ; if S * 7.5 < L then goto Region3 (L / S > 7.5)
jmp _Region2 ; (L / S < 7.5)
_Region0:
; L / S < 1.25. d=3,9,15,21
jmp _LookupResult
_Region1:
; 1.25 < L / S < 2.5. d=2,4,8,10,14,16,20,22
lda region_number
clc
adc #4
sta region_number
bpl _LookupResult
_Region2:
; 2.5 < L / S < 7.5. d=1,5,7,11,13,17,19,23
lda region_number
clc
adc #8
sta region_number
bpl _LookupResult
_Region3:
; 7.5 < L / S. d=0,6,12,18
lda region_number
clc
adc #12
sta region_number
_LookupResult:
lda quadrant
clc
adc region_number
tax
lda _quadrant_region_to_direction,x
rts
_quadrant_region_to_direction:
.byte 9, 3,15,21
.byte 10, 2,14,22
.byte 11, 1,13,23
.byte 12, 0,12, 0
.byte 9, 3,15,21
.byte 8, 4,16,20
.byte 7, 5,17,19
.byte 6, 6,18,18
.pend
atan2 .proc
x1 = cx16.r0L
y1 = cx16.r1L
x2 = cx16.r2L
y2 = cx16.r3L
octant = cx16.r4L ;; temporary zeropage variable
lda x1
sec
sbc x2
bcs *+4
eor #$ff
tax
rol octant
lda y1
sec
sbc y2
bcs *+4
eor #$ff
tay
rol octant
lda log2_tab,x
sec
sbc log2_tab,y
bcc *+4
eor #$ff
tax
lda octant
rol a
and #%111
tay
lda atan_tab,x
eor octant_adjust,y
rts
octant_adjust
.byte %00111111 ;; x+,y+,|x|>|y|
.byte %00000000 ;; x+,y+,|x|<|y|
.byte %11000000 ;; x+,y-,|x|>|y|
.byte %11111111 ;; x+,y-,|x|<|y|
.byte %01000000 ;; x-,y+,|x|>|y|
.byte %01111111 ;; x-,y+,|x|<|y|
.byte %10111111 ;; x-,y-,|x|>|y|
.byte %10000000 ;; x-,y-,|x|<|y|
;;;;;;;; atan(2^(x/32))*128/pi ;;;;;;;;
atan_tab
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$00,$00,$00
.byte $00,$00,$00,$00,$00,$01,$01,$01
.byte $01,$01,$01,$01,$01,$01,$01,$01
.byte $01,$01,$01,$01,$01,$01,$01,$01
.byte $01,$01,$01,$01,$01,$01,$01,$01
.byte $01,$01,$01,$01,$01,$02,$02,$02
.byte $02,$02,$02,$02,$02,$02,$02,$02
.byte $02,$02,$02,$02,$02,$02,$02,$02
.byte $03,$03,$03,$03,$03,$03,$03,$03
.byte $03,$03,$03,$03,$03,$04,$04,$04
.byte $04,$04,$04,$04,$04,$04,$04,$04
.byte $05,$05,$05,$05,$05,$05,$05,$05
.byte $06,$06,$06,$06,$06,$06,$06,$06
.byte $07,$07,$07,$07,$07,$07,$08,$08
.byte $08,$08,$08,$08,$09,$09,$09,$09
.byte $09,$0a,$0a,$0a,$0a,$0b,$0b,$0b
.byte $0b,$0c,$0c,$0c,$0c,$0d,$0d,$0d
.byte $0d,$0e,$0e,$0e,$0e,$0f,$0f,$0f
.byte $10,$10,$10,$11,$11,$11,$12,$12
.byte $12,$13,$13,$13,$14,$14,$15,$15
.byte $15,$16,$16,$17,$17,$17,$18,$18
.byte $19,$19,$19,$1a,$1a,$1b,$1b,$1c
.byte $1c,$1c,$1d,$1d,$1e,$1e,$1f,$1f
;;;;;;;; log2(x)*32 ;;;;;;;;
log2_tab
.byte $00,$00,$20,$32,$40,$4a,$52,$59
.byte $60,$65,$6a,$6e,$72,$76,$79,$7d
.byte $80,$82,$85,$87,$8a,$8c,$8e,$90
.byte $92,$94,$96,$98,$99,$9b,$9d,$9e
.byte $a0,$a1,$a2,$a4,$a5,$a6,$a7,$a9
.byte $aa,$ab,$ac,$ad,$ae,$af,$b0,$b1
.byte $b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9
.byte $b9,$ba,$bb,$bc,$bd,$bd,$be,$bf
.byte $c0,$c0,$c1,$c2,$c2,$c3,$c4,$c4
.byte $c5,$c6,$c6,$c7,$c7,$c8,$c9,$c9
.byte $ca,$ca,$cb,$cc,$cc,$cd,$cd,$ce
.byte $ce,$cf,$cf,$d0,$d0,$d1,$d1,$d2
.byte $d2,$d3,$d3,$d4,$d4,$d5,$d5,$d5
.byte $d6,$d6,$d7,$d7,$d8,$d8,$d9,$d9
.byte $d9,$da,$da,$db,$db,$db,$dc,$dc
.byte $dd,$dd,$dd,$de,$de,$de,$df,$df
.byte $df,$e0,$e0,$e1,$e1,$e1,$e2,$e2
.byte $e2,$e3,$e3,$e3,$e4,$e4,$e4,$e5
.byte $e5,$e5,$e6,$e6,$e6,$e7,$e7,$e7
.byte $e7,$e8,$e8,$e8,$e9,$e9,$e9,$ea
.byte $ea,$ea,$ea,$eb,$eb,$eb,$ec,$ec
.byte $ec,$ec,$ed,$ed,$ed,$ed,$ee,$ee
.byte $ee,$ee,$ef,$ef,$ef,$ef,$f0,$f0
.byte $f0,$f1,$f1,$f1,$f1,$f1,$f2,$f2
.byte $f2,$f2,$f3,$f3,$f3,$f3,$f4,$f4
.byte $f4,$f4,$f5,$f5,$f5,$f5,$f5,$f6
.byte $f6,$f6,$f6,$f7,$f7,$f7,$f7,$f7
.byte $f8,$f8,$f8,$f8,$f9,$f9,$f9,$f9
.byte $f9,$fa,$fa,$fa,$fa,$fa,$fb,$fb
.byte $fb,$fb,$fb,$fc,$fc,$fc,$fc,$fc
.byte $fd,$fd,$fd,$fd,$fd,$fd,$fe,$fe
.byte $fe,$fe,$fe,$ff,$ff,$ff,$ff,$ff
.pend
diff .proc
sty P8ZP_SCRATCH_REG
sec
sbc P8ZP_SCRATCH_REG
bcs +
eor #255
inc a
+ rts
.pend
diffw .proc
sec
sbc cx16.r0L
sta cx16.r0L
tya
sbc cx16.r0H
sta cx16.r0H
bcs +
eor #255
sta cx16.r0H
lda cx16.r0L
eor #255
inc a
sta cx16.r0L
bne +
inc cx16.r0H
+ lda cx16.r0L
ldy cx16.r0H
rts
.pend
.pend
; ---- block: 'prog8_lib' ----
prog8_lib .proc
; 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_in_AY_into_A .proc
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
lda (P8ZP_SCRATCH_W2),y
rts
.pend
write_byte_X_to_address_in_AY .proc
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
txa
sta (P8ZP_SCRATCH_W2),y
rts
.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
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
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
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
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
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
strlen .proc
; -- returns the number of bytes in the string in AY, in Y. Clobbers A.
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
dey
cpy #254
bne -
lda #0
rts
_found lda #1
rts
.pend
arraycopy_split_to_normal_words .proc
; P8ZP_SCRATCH_W1 = start of lsb array
; P8ZP_SCRATCH_W2 = start of msb array
; AY = start of normal word target array
; X = number of elements to copy
sta _modlsb+1
sty _modlsb+2
clc
adc #1
bne +
iny
+ sta _modmsb+1
sty _modmsb+2
ldy #0
- lda (P8ZP_SCRATCH_W1),y
_modlsb sta $ffff ; modified lsb store
lda _modlsb+1
clc
adc #2
sta _modlsb+1
bcc +
inc _modlsb+2
+ lda (P8ZP_SCRATCH_W2),y
_modmsb sta $ffff ; modified msb store
lda _modmsb+1
clc
adc #2
sta _modmsb+1
bcc +
inc _modmsb+2
+ iny
dex
bne -
rts
.pend
arraycopy_normal_to_split_words .proc
; P8ZP_SCRATCH_W1 = start of target lsb array
; P8ZP_SCRATCH_W2 = start of target msb array
; AY = start of normal word source array
; X = number of elements to copy
sta _modsrclsb+1
sty _modsrclsb+2
clc
adc #1
bne +
iny
+ sta _modsrcmsb+1
sty _modsrcmsb+2
ldy #0
_modsrclsb lda $ffff ; modified lsb read
sta (P8ZP_SCRATCH_W1),y
lda _modsrclsb+1
clc
adc #2
sta _modsrclsb+1
bcc +
inc _modsrclsb+2
+
_modsrcmsb lda $ffff ; modnfied msb read
sta (P8ZP_SCRATCH_W2),y
lda _modsrcmsb+1
clc
adc #2
sta _modsrcmsb+1
bcc +
inc _modsrcmsb+2
+ iny
dex
bne _modsrclsb
rts
.pend
memcopy_small .proc
; copy up to a single page (256 bytes) of memory.
; note: only works for NON-OVERLAPPING memory regions!
; P8ZP_SCRATCH_W1 = from address
; P8ZP_SCRATCH_W2 = destination address
; Y = number of bytes to copy (where 0 means 256)
cpy #0
beq _fullpage
dey
beq _lastbyte
_loop lda (P8ZP_SCRATCH_W1),y
sta (P8ZP_SCRATCH_W2),y
dey
bne _loop
_lastbyte lda (P8ZP_SCRATCH_W1),y
sta (P8ZP_SCRATCH_W2),y
rts
_fullpage lda (P8ZP_SCRATCH_W1),y
sta (P8ZP_SCRATCH_W2),y
dey
bne _fullpage
rts
.pend
; ---- builtin functions
func_any_b_into_A .proc
; -- any(array), array in P8ZP_SCRATCH_W1, num bytes in A
sta _cmp_mod+1 ; self-modifying code
ldy #0
- lda (P8ZP_SCRATCH_W1),y
bne _got_any
iny
_cmp_mod cpy #255 ; modified
bne -
lda #0
rts
_got_any lda #1
rts
.pend
func_all_b_into_A .proc
; -- all(array), array in P8ZP_SCRATCH_W1, num bytes in A
sta _cmp_mod+1 ; self-modifying code
ldy #0
- lda (P8ZP_SCRATCH_W1),y
beq _got_not_all
iny
_cmp_mod cpy #255 ; modified
bne -
lda #1
_got_not_all rts
.pend
func_any_w_into_A .proc
asl a
jmp func_any_b_into_A
.pend
func_all_w_into_A .proc
; -- all(warray), array in P8ZP_SCRATCH_W1, num bytes in A
asl a ; times 2 because of word
sta _cmp_mod+1 ; self-modifying code
ldy #0
- lda (P8ZP_SCRATCH_W1),y
bne +
iny
lda (P8ZP_SCRATCH_W1),y
bne ++
lda #0
rts
+ iny
+ iny
_cmp_mod cpy #255 ; modified
bne -
lda #1
rts
.pend
abs_b_into_A .proc
; -- A = abs(A)
cmp #0
bmi +
rts
+ eor #$ff
clc
adc #1
rts
.pend
abs_w_into_AY .proc
; -- AY = abs(AY)
cpy #0
bmi +
rts
+ eor #$ff
pha
tya
eor #$ff
tay
pla
clc
adc #1
bcc +
iny
+ rts
.pend
func_sign_b_into_A .proc
cmp #0
beq _zero
bmi _neg
lda #1
_zero rts
_neg lda #-1
rts
.pend
func_sign_ub_into_A .proc
cmp #0
bne _pos
rts
_pos lda #1
rts
.pend
func_sign_uw_into_A .proc
cpy #0
beq _possibly_zero
_pos lda #1
rts
_possibly_zero cmp #0
bne _pos
rts
.pend
func_sign_w_into_A .proc
cpy #0
beq _possibly_zero
bmi _neg
_pos lda #1
rts
_neg lda #-1
rts
_possibly_zero cmp #0
bne _pos
rts
.pend
func_sqrt16_into_A .proc
; integer square root
; http://6502org.wikidot.com/software-math-sqrt
; https://github.com/TobyLobster/sqrt_test/blob/main/sqrt/sqrt7.a
; Tweaked by TobyLobster and 0xC0DE to be smaller and faster
_numl = P8ZP_SCRATCH_W1
_numh = P8ZP_SCRATCH_W1+1
_loop_counter = P8ZP_SCRATCH_REG
_root = P8ZP_SCRATCH_B1
sta _numl
sty _numh
ldx #$ff
stx _loop_counter
inx
stx _root
sec
_loop lda _numh
sbc #$40
tay
txa
sbc _root
bcc +
sty _numh
bcs ++
+ txa
+ rol _root
asl _numl
rol _numh
rol a
asl _numl
rol _numh
rol a
tax
lsr _loop_counter
bne _loop
lda _root
rts
.pend
func_sort_ub .proc
; 8bit unsigned sort
; sorting subroutine coded by mats rosengren (mats.rosengren@esa.int)
; input: address of array to sort in P8ZP_SCRATCH_W1, length in S
; first, put pointer BEFORE array
sta P8ZP_SCRATCH_B1
lda P8ZP_SCRATCH_W1
bne +
dec P8ZP_SCRATCH_W1+1
+ dec P8ZP_SCRATCH_W1
_sortloop ldy P8ZP_SCRATCH_B1 ;start of subroutine sort
lda (P8ZP_SCRATCH_W1),y ;last value in (what is left of) sequence to be sorted
sta P8ZP_SCRATCH_REG ;save value. will be over-written by largest number
jmp _l2
_l1 dey
beq _l3
lda (P8ZP_SCRATCH_W1),y
cmp P8ZP_SCRATCH_W2+1
bcc _l1
_l2 sty P8ZP_SCRATCH_W2 ;index of potentially largest value
sta P8ZP_SCRATCH_W2+1 ;potentially largest value
jmp _l1
_l3 ldy P8ZP_SCRATCH_B1 ;where the largest value shall be put
lda P8ZP_SCRATCH_W2+1 ;the largest value
sta (P8ZP_SCRATCH_W1),y ;put largest value in place
ldy P8ZP_SCRATCH_W2 ;index of free space
lda P8ZP_SCRATCH_REG ;the over-written value
sta (P8ZP_SCRATCH_W1),y ;put the over-written value in the free space
dec P8ZP_SCRATCH_B1 ;end of the shorter sequence still left
bne _sortloop ;start working with the shorter sequence
rts
.pend
func_sort_b .proc
; 8bit signed sort
; sorting subroutine coded by mats rosengren (mats.rosengren@esa.int)
; input: address of array to sort in P8ZP_SCRATCH_W1, length in A
; first, put pointer BEFORE array
sta P8ZP_SCRATCH_B1
lda P8ZP_SCRATCH_W1
bne +
dec P8ZP_SCRATCH_W1+1
+ dec P8ZP_SCRATCH_W1
_sortloop ldy P8ZP_SCRATCH_B1 ;start of subroutine sort
lda (P8ZP_SCRATCH_W1),y ;last value in (what is left of) sequence to be sorted
sta P8ZP_SCRATCH_REG ;save value. will be over-written by largest number
jmp _l2
_l1 dey
beq _l3
lda (P8ZP_SCRATCH_W1),y
cmp P8ZP_SCRATCH_W2+1
bmi _l1
_l2 sty P8ZP_SCRATCH_W2 ;index of potentially largest value
sta P8ZP_SCRATCH_W2+1 ;potentially largest value
jmp _l1
_l3 ldy P8ZP_SCRATCH_B1 ;where the largest value shall be put
lda P8ZP_SCRATCH_W2+1 ;the largest value
sta (P8ZP_SCRATCH_W1),y ;put largest value in place
ldy P8ZP_SCRATCH_W2 ;index of free space
lda P8ZP_SCRATCH_REG ;the over-written value
sta (P8ZP_SCRATCH_W1),y ;put the over-written value in the free space
dec P8ZP_SCRATCH_B1 ;end of the shorter sequence still left
bne _sortloop ;start working with the shorter sequence
rts
.pend
func_sort_uw .proc
; 16bit unsigned sort
; sorting subroutine coded by mats rosengren (mats.rosengren@esa.int)
; input: address of array to sort in P8ZP_SCRATCH_W1, length in A
; first: subtract 2 of the pointer
asl a
sta P8ZP_SCRATCH_B1
lda P8ZP_SCRATCH_W1
sec
sbc #2
sta P8ZP_SCRATCH_W1
bcs _sort_loop
dec P8ZP_SCRATCH_W1+1
_sort_loop ldy P8ZP_SCRATCH_B1 ;start of subroutine sort
lda (P8ZP_SCRATCH_W1),y ;last value in (what is left of) sequence to be sorted
sta _work3 ;save value. will be over-written by largest number
iny
lda (P8ZP_SCRATCH_W1),y
sta _work3+1
dey
jmp _l2
_l1 dey
dey
beq _l3
iny
lda (P8ZP_SCRATCH_W1),y
dey
cmp P8ZP_SCRATCH_W2+1
bne +
lda (P8ZP_SCRATCH_W1),y
cmp P8ZP_SCRATCH_W2
+ bcc _l1
_l2 sty _work1 ;index of potentially largest value
lda (P8ZP_SCRATCH_W1),y
sta P8ZP_SCRATCH_W2 ;potentially largest value
iny
lda (P8ZP_SCRATCH_W1),y
sta P8ZP_SCRATCH_W2+1
dey
jmp _l1
_l3 ldy P8ZP_SCRATCH_B1 ;where the largest value shall be put
lda P8ZP_SCRATCH_W2 ;the largest value
sta (P8ZP_SCRATCH_W1),y ;put largest value in place
iny
lda P8ZP_SCRATCH_W2+1
sta (P8ZP_SCRATCH_W1),y
ldy _work1 ;index of free space
lda _work3 ;the over-written value
sta (P8ZP_SCRATCH_W1),y ;put the over-written value in the free space
iny
lda _work3+1
sta (P8ZP_SCRATCH_W1),y
dey
dec P8ZP_SCRATCH_B1 ;end of the shorter sequence still left
dec P8ZP_SCRATCH_B1
bne _sort_loop ;start working with the shorter sequence
rts
_work1 .byte 0
_work3 .word 0
.pend
func_sort_w .proc
; 16bit signed sort
; sorting subroutine coded by mats rosengren (mats.rosengren@esa.int)
; input: address of array to sort in P8ZP_SCRATCH_W1, length in A
; first: subtract 2 of the pointer
asl a
sta P8ZP_SCRATCH_B1
lda P8ZP_SCRATCH_W1
sec
sbc #2
sta P8ZP_SCRATCH_W1
bcs _sort_loop
dec P8ZP_SCRATCH_W1+1
_sort_loop ldy P8ZP_SCRATCH_B1 ;start of subroutine sort
lda (P8ZP_SCRATCH_W1),y ;last value in (what is left of) sequence to be sorted
sta _work3 ;save value. will be over-written by largest number
iny
lda (P8ZP_SCRATCH_W1),y
sta _work3+1
dey
jmp _l2
_l1 dey
dey
beq _l3
lda (P8ZP_SCRATCH_W1),y
cmp P8ZP_SCRATCH_W2
iny
lda (P8ZP_SCRATCH_W1),y
dey
sbc P8ZP_SCRATCH_W2+1
bvc +
eor #$80
+ bmi _l1
_l2 sty _work1 ;index of potentially largest value
lda (P8ZP_SCRATCH_W1),y
sta P8ZP_SCRATCH_W2 ;potentially largest value
iny
lda (P8ZP_SCRATCH_W1),y
sta P8ZP_SCRATCH_W2+1
dey
jmp _l1
_l3 ldy P8ZP_SCRATCH_B1 ;where the largest value shall be put
lda P8ZP_SCRATCH_W2 ;the largest value
sta (P8ZP_SCRATCH_W1),y ;put largest value in place
iny
lda P8ZP_SCRATCH_W2+1
sta (P8ZP_SCRATCH_W1),y
ldy _work1 ;index of free space
lda _work3 ;the over-written value
sta (P8ZP_SCRATCH_W1),y ;put the over-written value in the free space
iny
lda _work3+1
sta (P8ZP_SCRATCH_W1),y
dey
dec P8ZP_SCRATCH_B1 ;end of the shorter sequence still left
dec P8ZP_SCRATCH_B1
bne _sort_loop ;start working with the shorter sequence
rts
_work1 .byte 0
_work3 .word 0
.pend
func_reverse_b .proc
; --- reverse an array of bytes (in-place)
; inputs: pointer to array in P8ZP_SCRATCH_W1, length in A
_index_right = P8ZP_SCRATCH_W2
_index_left = P8ZP_SCRATCH_W2+1
_loop_count = P8ZP_SCRATCH_REG
sta _loop_count
lsr _loop_count
sec
sbc #1
sta _index_right
lda #0
sta _index_left
_loop ldy _index_right
lda (P8ZP_SCRATCH_W1),y
pha
ldy _index_left
lda (P8ZP_SCRATCH_W1),y
ldy _index_right
sta (P8ZP_SCRATCH_W1),y
pla
ldy _index_left
sta (P8ZP_SCRATCH_W1),y
inc _index_left
dec _index_right
dec _loop_count
bne _loop
rts
.pend
func_reverse_w .proc
; --- reverse an array of words (in-place)
; inputs: pointer to array in P8ZP_SCRATCH_W1, length in A
_index_first = P8ZP_SCRATCH_W2
_index_second = P8ZP_SCRATCH_W2+1
_loop_count = P8ZP_SCRATCH_REG
pha
asl a ; *2 because words
sec
sbc #2
sta _index_first
lda #0
sta _index_second
pla
lsr a
pha
sta _loop_count
; first reverse the lsbs
_loop_lo ldy _index_first
lda (P8ZP_SCRATCH_W1),y
pha
ldy _index_second
lda (P8ZP_SCRATCH_W1),y
ldy _index_first
sta (P8ZP_SCRATCH_W1),y
pla
ldy _index_second
sta (P8ZP_SCRATCH_W1),y
inc _index_second
inc _index_second
dec _index_first
dec _index_first
dec _loop_count
bne _loop_lo
; now reverse the msbs
dec _index_second
inc _index_first
inc _index_first
inc _index_first
pla
sta _loop_count
_loop_hi ldy _index_first
lda (P8ZP_SCRATCH_W1),y
pha
ldy _index_second
lda (P8ZP_SCRATCH_W1),y
ldy _index_first
sta (P8ZP_SCRATCH_W1),y
pla
ldy _index_second
sta (P8ZP_SCRATCH_W1),y
dec _index_second
dec _index_second
inc _index_first
inc _index_first
dec _loop_count
bne _loop_hi
rts
.pend
func_peekw .proc
; -- read the word value on the address in AY
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0
lda (P8ZP_SCRATCH_W1),y
pha
iny
lda (P8ZP_SCRATCH_W1),y
tay
pla
rts
.pend
func_pokew .proc
; -- store the word value in AY in the address in P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_REG
ldy #0
sta (P8ZP_SCRATCH_W1),y
iny
lda P8ZP_SCRATCH_REG
sta (P8ZP_SCRATCH_W1),y
rts
.pend
func_clamp_byte .proc
; signed value in A, result in A
; minimum in P8ZP_SCRATCH_W1
; maximum in P8ZP_SCRATCH_W1+1
tay
sec
sbc P8ZP_SCRATCH_W1+1
bvc +
eor #$80
+ bmi +
lda P8ZP_SCRATCH_W1+1
tay
jmp ++
+ tya
+ sec
sbc P8ZP_SCRATCH_W1
bvc +
eor #$80
+ bmi +
tya
rts
+ lda P8ZP_SCRATCH_W1
rts
.pend
func_clamp_ubyte .proc
; value in A, result in A
; minimum in P8ZP_SCRATCH_W1
; maximum in P8ZP_SCRATCH_W1+1
cmp P8ZP_SCRATCH_W1+1
bcc +
lda P8ZP_SCRATCH_W1+1
+ cmp P8ZP_SCRATCH_W1
bcc +
rts
+ lda P8ZP_SCRATCH_W1
rts
.pend
func_clamp_word .proc
; signed value in AY, result in AY
; minimum in P8ZP_SCRATCH_W1
; maximum in P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
ldy P8ZP_SCRATCH_W2+1
lda P8ZP_SCRATCH_W2
cmp P8ZP_SCRATCH_B1
tya
sbc P8ZP_SCRATCH_REG
bvc +
eor #$80
+ bpl +
lda P8ZP_SCRATCH_W2
ldy P8ZP_SCRATCH_W2+1
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
+ ldy P8ZP_SCRATCH_W1+1
lda P8ZP_SCRATCH_W1
cmp P8ZP_SCRATCH_B1
tya
sbc P8ZP_SCRATCH_REG
bvc +
eor #$80
+ bpl +
ldy P8ZP_SCRATCH_REG
lda P8ZP_SCRATCH_B1
rts
+ ldy P8ZP_SCRATCH_W1+1
lda P8ZP_SCRATCH_W1
rts
.pend
func_clamp_uword .proc
; value in AY, result in AY
; minimum in P8ZP_SCRATCH_W1
; maximum in P8ZP_SCRATCH_W2
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
cpy P8ZP_SCRATCH_W2+1
bcc ++
bne +
cmp P8ZP_SCRATCH_W2
bcc ++
+ beq +
lda P8ZP_SCRATCH_W2
ldy P8ZP_SCRATCH_W2+1
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
+ ldy P8ZP_SCRATCH_REG
lda P8ZP_SCRATCH_B1
cpy P8ZP_SCRATCH_W1+1
bcc ++
bne +
cmp P8ZP_SCRATCH_W1
bcc ++
+ beq +
ldy P8ZP_SCRATCH_REG
lda P8ZP_SCRATCH_B1
rts
+ ldy P8ZP_SCRATCH_W1+1
lda P8ZP_SCRATCH_W1
rts
.pend
.pend
; global float constants
prog8_float_const_0 .byte $82, $5c, $cc, $cc, $cc ; float 3.45
prog8_float_const_1 .byte $81, $0e, $14, $7a, $e1 ; float 1.11
prog8_float_const_2 .byte $83, $23, $85, $1e, $b8 ; float 5.11
; expression temp vars
.section BSS
.send BSS
; bss sections
PROG8_VARSHIGH_RAMBANK = 1
prog8_bss_section_start
.dsection BSS
prog8_bss_section_size = * - prog8_bss_section_start
.dsection slabs_BSS
prog8_program_end ; end of program label for progend()
Reference in New Issue View Git Blame Copy Permalink