; w65c02 assembly code for 'minus' ; generated by prog8.codegen.cpu6502.ProgramAndVarsGen on 2024-03-13T21:13:57 ; 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 ; 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 sta P8ZP_SCRATCH_W1 sty P8ZP_SCRATCH_W1+1 ldx #prog8_bss_section_size lda #0 jsr prog8_lib.memset .endif + clv clc ; statements stz p8b_main.p8s_minus_ubyte.p8v_a1 stz p8b_main.p8s_minus_ubyte.p8v_a2 stz p8b_main.p8s_minus_ubyte.p8v_c jsr p8b_main.p8s_minus_ubyte lda #$c8 sta p8b_main.p8s_minus_ubyte.p8v_a1 stz p8b_main.p8s_minus_ubyte.p8v_a2 lda #$c8 sta p8b_main.p8s_minus_ubyte.p8v_c jsr p8b_main.p8s_minus_ubyte lda #$c8 sta p8b_main.p8s_minus_ubyte.p8v_a1 lda #$64 sta p8b_main.p8s_minus_ubyte.p8v_a2 sta p8b_main.p8s_minus_ubyte.p8v_c jsr p8b_main.p8s_minus_ubyte lda #$64 sta p8b_main.p8s_minus_ubyte.p8v_a1 lda #$c8 sta p8b_main.p8s_minus_ubyte.p8v_a2 lda #$9c sta p8b_main.p8s_minus_ubyte.p8v_c jsr p8b_main.p8s_minus_ubyte stz p8b_main.p8s_minus_byte.p8v_a1 stz p8b_main.p8s_minus_byte.p8v_a2 stz p8b_main.p8s_minus_byte.p8v_c jsr p8b_main.p8s_minus_byte lda #$64 sta p8b_main.p8s_minus_byte.p8v_a1 sta p8b_main.p8s_minus_byte.p8v_a2 stz p8b_main.p8s_minus_byte.p8v_c jsr p8b_main.p8s_minus_byte lda #$32 sta p8b_main.p8s_minus_byte.p8v_a1 lda #-$32 sta p8b_main.p8s_minus_byte.p8v_a2 lda #$64 sta p8b_main.p8s_minus_byte.p8v_c jsr p8b_main.p8s_minus_byte stz p8b_main.p8s_minus_byte.p8v_a1 lda #-$1e sta p8b_main.p8s_minus_byte.p8v_a2 lda #$1e sta p8b_main.p8s_minus_byte.p8v_c jsr p8b_main.p8s_minus_byte lda #-$1e sta p8b_main.p8s_minus_byte.p8v_a1 stz p8b_main.p8s_minus_byte.p8v_a2 lda #-$1e sta p8b_main.p8s_minus_byte.p8v_c jsr p8b_main.p8s_minus_byte stz p8b_main.p8s_minus_uword.p8v_a1 stz p8b_main.p8s_minus_uword.p8v_a1+1 stz p8b_main.p8s_minus_uword.p8v_a2 stz p8b_main.p8s_minus_uword.p8v_a2+1 stz p8b_main.p8s_minus_uword.p8v_c stz p8b_main.p8s_minus_uword.p8v_c+1 jsr p8b_main.p8s_minus_uword lda #<$c350 ldy #>$c350 sta p8b_main.p8s_minus_uword.p8v_a1 sty p8b_main.p8s_minus_uword.p8v_a1+1 stz p8b_main.p8s_minus_uword.p8v_a2 stz p8b_main.p8s_minus_uword.p8v_a2+1 lda #<$c350 ldy #>$c350 sta p8b_main.p8s_minus_uword.p8v_c sty p8b_main.p8s_minus_uword.p8v_c+1 jsr p8b_main.p8s_minus_uword lda #<$c350 ldy #>$c350 sta p8b_main.p8s_minus_uword.p8v_a1 sty p8b_main.p8s_minus_uword.p8v_a1+1 lda #<$4e20 ldy #>$4e20 sta p8b_main.p8s_minus_uword.p8v_a2 sty p8b_main.p8s_minus_uword.p8v_a2+1 lda #<$7530 ldy #>$7530 sta p8b_main.p8s_minus_uword.p8v_c sty p8b_main.p8s_minus_uword.p8v_c+1 jsr p8b_main.p8s_minus_uword lda #<$4e20 ldy #>$4e20 sta p8b_main.p8s_minus_uword.p8v_a1 sty p8b_main.p8s_minus_uword.p8v_a1+1 lda #<$c350 ldy #>$c350 sta p8b_main.p8s_minus_uword.p8v_a2 sty p8b_main.p8s_minus_uword.p8v_a2+1 lda #<$8ad0 ldy #>$8ad0 sta p8b_main.p8s_minus_uword.p8v_c sty p8b_main.p8s_minus_uword.p8v_c+1 jsr p8b_main.p8s_minus_uword stz p8b_main.p8s_minus_word.p8v_a1 stz p8b_main.p8s_minus_word.p8v_a1+1 stz p8b_main.p8s_minus_word.p8v_a2 stz p8b_main.p8s_minus_word.p8v_a2+1 stz p8b_main.p8s_minus_word.p8v_c stz p8b_main.p8s_minus_word.p8v_c+1 jsr p8b_main.p8s_minus_word lda #<$03e8 ldy #>$03e8 sta p8b_main.p8s_minus_word.p8v_a1 sty p8b_main.p8s_minus_word.p8v_a1+1 sta p8b_main.p8s_minus_word.p8v_a2 sty p8b_main.p8s_minus_word.p8v_a2+1 stz p8b_main.p8s_minus_word.p8v_c stz p8b_main.p8s_minus_word.p8v_c+1 jsr p8b_main.p8s_minus_word lda #<-$03e8 ldy #>-$03e8 sta p8b_main.p8s_minus_word.p8v_a1 sty p8b_main.p8s_minus_word.p8v_a1+1 lda #<$03e8 ldy #>$03e8 sta p8b_main.p8s_minus_word.p8v_a2 sty p8b_main.p8s_minus_word.p8v_a2+1 lda #<-$07d0 ldy #>-$07d0 sta p8b_main.p8s_minus_word.p8v_c sty p8b_main.p8s_minus_word.p8v_c+1 jsr p8b_main.p8s_minus_word lda #<$03e8 ldy #>$03e8 sta p8b_main.p8s_minus_word.p8v_a1 sty p8b_main.p8s_minus_word.p8v_a1+1 lda #<$01f4 ldy #>$01f4 sta p8b_main.p8s_minus_word.p8v_a2 sty p8b_main.p8s_minus_word.p8v_a2+1 sta p8b_main.p8s_minus_word.p8v_c sty p8b_main.p8s_minus_word.p8v_c+1 jsr p8b_main.p8s_minus_word stz p8b_main.p8s_minus_word.p8v_a1 stz p8b_main.p8s_minus_word.p8v_a1+1 lda #<-$0d05 ldy #>-$0d05 sta p8b_main.p8s_minus_word.p8v_a2 sty p8b_main.p8s_minus_word.p8v_a2+1 lda #<$0d05 ldy #>$0d05 sta p8b_main.p8s_minus_word.p8v_c sty p8b_main.p8s_minus_word.p8v_c+1 jsr p8b_main.p8s_minus_word lda #<-$0d05 ldy #>-$0d05 sta p8b_main.p8s_minus_word.p8v_a1 sty p8b_main.p8s_minus_word.p8v_a1+1 stz p8b_main.p8s_minus_word.p8v_a2 stz p8b_main.p8s_minus_word.p8v_a2+1 lda #<-$0d05 ldy #>-$0d05 sta p8b_main.p8s_minus_word.p8v_c sty p8b_main.p8s_minus_word.p8v_c+1 jsr p8b_main.p8s_minus_word stz p8b_main.p8s_minus_float.p8v_a1 stz p8b_main.p8s_minus_float.p8v_a1+1 stz p8b_main.p8s_minus_float.p8v_a1+2 stz p8b_main.p8s_minus_float.p8v_a1+3 stz p8b_main.p8s_minus_float.p8v_a1+4 stz p8b_main.p8s_minus_float.p8v_a2 stz p8b_main.p8s_minus_float.p8v_a2+1 stz p8b_main.p8s_minus_float.p8v_a2+2 stz p8b_main.p8s_minus_float.p8v_a2+3 stz p8b_main.p8s_minus_float.p8v_a2+4 stz p8b_main.p8s_minus_float.p8v_c stz p8b_main.p8s_minus_float.p8v_c+1 stz p8b_main.p8s_minus_float.p8v_c+2 stz p8b_main.p8s_minus_float.p8v_c+3 stz p8b_main.p8s_minus_float.p8v_c+4 jsr p8b_main.p8s_minus_float lda #prog8_float_const_0 sta P8ZP_SCRATCH_W1 sty P8ZP_SCRATCH_W1+1 lda #p8b_main.p8s_minus_float.p8v_a1 jsr floats.copy_float lda #prog8_float_const_1 sta P8ZP_SCRATCH_W1 sty P8ZP_SCRATCH_W1+1 lda #p8b_main.p8s_minus_float.p8v_a2 jsr floats.copy_float lda #prog8_float_const_2 sta P8ZP_SCRATCH_W1 sty P8ZP_SCRATCH_W1+1 lda #p8b_main.p8s_minus_float.p8v_c jsr floats.copy_float jsr p8b_main.p8s_minus_float lda #prog8_float_const_3 sta P8ZP_SCRATCH_W1 sty P8ZP_SCRATCH_W1+1 lda #p8b_main.p8s_minus_float.p8v_a1 jsr floats.copy_float lda #prog8_float_const_4 sta P8ZP_SCRATCH_W1 sty P8ZP_SCRATCH_W1+1 lda #p8b_main.p8s_minus_float.p8v_a2 jsr floats.copy_float lda #prog8_float_const_5 sta P8ZP_SCRATCH_W1 sty P8ZP_SCRATCH_W1+1 lda #p8b_main.p8s_minus_float.p8v_c jsr floats.copy_float jsr p8b_main.p8s_minus_float jmp test_stack.test ; variables .section BSS .send BSS .pend p8s_minus_ubyte .proc p8v_r = 50 ; zp UBYTE p8v_c = 51 ; zp UBYTE p8v_a2 = 52 ; zp UBYTE p8v_a1 = 53 ; zp UBYTE ; statements lda p8v_a1 sec sbc p8v_a2 sta p8v_r cmp p8v_c bne label_asm_2_else ldy #>prog8_interned_strings.string_1 lda #prog8_interned_strings.string_2 lda #prog8_interned_strings.string_3 lda #prog8_interned_strings.string_4 lda #prog8_interned_strings.string_5 lda #prog8_interned_strings.string_1 lda #prog8_interned_strings.string_2 lda #prog8_interned_strings.string_6 lda #prog8_interned_strings.string_4 lda #prog8_interned_strings.string_5 lda #prog8_interned_strings.string_1 lda #prog8_interned_strings.string_2 lda #prog8_interned_strings.string_7 lda #prog8_interned_strings.string_4 lda #prog8_interned_strings.string_5 lda #prog8_interned_strings.string_1 lda #prog8_interned_strings.string_2 lda #prog8_interned_strings.string_8 lda #prog8_interned_strings.string_4 lda #prog8_interned_strings.string_5 lda #p8v_a2 jsr floats.MOVFM lda #p8v_a1 jsr floats.CONUPK jsr floats.FSUBT ldx #p8v_r jsr floats.MOVMF lda #p8v_c jsr floats.MOVFM lda #p8v_r jsr floats.CONUPK jsr floats.FSUBT ldx #prog8_float_eval_result2 jsr floats.MOVMF ldy #>prog8_float_eval_result2 lda #prog8_float_const_6 jsr floats.var_fac1_less_f beq label_asm_10_else ldy #>prog8_interned_strings.string_1 lda #prog8_interned_strings.string_2 lda #prog8_interned_strings.string_9 lda #p8v_a1 jsr floats.MOVFM jsr floats.print ldy #>prog8_interned_strings.string_4 lda #p8v_a2 jsr floats.MOVFM jsr floats.print ldy #>prog8_interned_strings.string_5 lda #p8v_r jsr floats.MOVFM jsr floats.print lda #13 jmp cbm.CHROUT ; variables .section BSS prog8_float_eval_result2 .fill 5 .send BSS ; non-zeropage variables without initialization value .section BSS p8v_a1 .fill 5 p8v_a2 .fill 5 p8v_c .fill 5 p8v_r .fill 5 .send BSS .pend .pend ; ---- block: 'prog8_interned_strings' ---- prog8_interned_strings .proc ; non-zeropage variables string_1 ; PETSCII:" ok " .byte $20, $4f, $4b, $20, $20, $00 string_2 ; PETSCII:"err! " .byte $45, $52, $52, $21, $20, $00 string_3 ; PETSCII:"ubyte " .byte $55, $42, $59, $54, $45, $20, $00 string_4 ; PETSCII:" - " .byte $20, $2d, $20, $00 string_5 ; PETSCII:" = " .byte $20, $3d, $20, $00 string_6 ; PETSCII:"byte " .byte $42, $59, $54, $45, $20, $00 string_7 ; PETSCII:"uword " .byte $55, $57, $4f, $52, $44, $20, $00 string_8 ; PETSCII:"word " .byte $57, $4f, $52, $44, $20, $00 string_9 ; PETSCII:" float " .byte $20, $20, $46, $4c, $4f, $41, $54, $20, $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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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: 'test_stack' ---- test_stack .proc test .proc lda #13 jsr txt.chrout lda #'-' ldy #12 - jsr txt.chrout dey bne - lda #13 jsr txt.chrout lda #'s' jsr txt.chrout lda #'p' jsr txt.chrout lda #'=' jsr txt.chrout tsx txa jsr txt.print_ub lda #13 jsr txt.chrout lda #'-' ldy #12 - jsr txt.chrout dey bne - lda #13 jmp txt.chrout .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, $20, $00, $00, $00 ; float 2.5 prog8_float_const_1 .byte $81, $40, $00, $00, $00 ; float 1.5 prog8_float_const_2 .byte $81, $00, $00, $00, $00 ; float 1.0 prog8_float_const_3 .byte $81, $c0, $00, $00, $00 ; float -1.5 prog8_float_const_4 .byte $82, $60, $00, $00, $00 ; float 3.5 prog8_float_const_5 .byte $83, $a0, $00, $00, $00 ; float -5.0 prog8_float_const_6 .byte $70, $27, $c5, $ac, $47 ; float 1.0E-5 ; 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()