Apple-2-SW/prog8
1
0
Fork 0
mirror of https://github.com/irmen/prog8.git synced 2025-02-16 22:30:46 +00:00
Code Issues Projects Releases Wiki Activity

split off c64flt library for all floating point routines

Browse Source
This commit is contained in:
Irmen de Jong 2019-01-05 16:09:05 +01:00
parent 39a8508daa
commit 9f4ac37a00
28 changed files with 1358 additions and 1336 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/examples/assignments.p8
View File

@ -1,5 +1,5 @@
%import c64utils
%option enable_floats
%import c64flt
%output raw
%launcher none
%address $4000

2
compiler/examples/comparison_ifs_byte.p8
View File

@ -1,6 +1,4 @@
%import c64utils
%option enable_floats
~ main {

3
compiler/examples/comparison_ifs_float.p8
View File

@ -1,6 +1,5 @@
%import c64utils
%option enable_floats
%import c64flt
~ main {

1
compiler/examples/comparison_ifs_ubyte.p8
View File

@ -1,5 +1,4 @@
%import c64utils
%option enable_floats
~ main {

1
compiler/examples/comparison_ifs_uword.p8
View File

@ -1,5 +1,4 @@
%import c64utils
%option enable_floats
~ main {

1
compiler/examples/comparison_ifs_word.p8
View File

@ -1,5 +1,4 @@
%import c64utils
%option enable_floats
~ main {

3
compiler/examples/comparisons_float.p8
View File

@ -1,6 +1,5 @@
%import c64utils
%option enable_floats
%import c64flt
~ main {

2
compiler/examples/cube3d-c64-float.p8
View File

@ -1,5 +1,5 @@
%import c64utils
%option enable_floats
%import c64flt
~ main {

1
compiler/examples/cube3d-c64.p8
View File

@ -1,5 +1,4 @@
%import c64utils
%option enable_floats ; @todo needed for now to avoid compile error in c64lib
~ main {

2
compiler/examples/cube3d.p8
View File

@ -1,5 +1,5 @@
%import c64utils
%option enable_floats
%import c64flt
~ irq {
uword global_time

2
compiler/examples/forloops.p8
View File

@ -1,4 +1,6 @@
%import c64utils
%import c64flt
~ main {

6
compiler/examples/mandelbrot-c64.p8
View File

@ -1,5 +1,5 @@
%import c64utils
%option enable_floats
%import c64flt
~ main {
const uword width = 30
@ -14,10 +14,10 @@
c64.TIME_LO=0
for ubyte pixely in 0 to height-1 {
float yy = (pixely as float)/0.4/height-1.0
float yy = (pixely as float)/0.4/height - 1.0
for ubyte pixelx in 0 to width-1 {
float xx = (pixelx as float)/0.3/width-2.0
float xx = (pixelx as float)/0.3/width - 2.0
float xsquared = 0.0
float ysquared = 0.0

2
compiler/examples/mandelbrot.p8
View File

@ -1,5 +1,5 @@
%import c64utils
%option enable_floats
%import c64flt
~ main {
const uword width = 320 // 2

15
compiler/examples/numbergame-c64.p8
View File

@ -1,6 +1,5 @@
%output prg
%import c64lib
%import c64utils
%import c64flt
; The classic number guessing game.
@ -29,11 +28,11 @@
c64.STROUT(".\nLet's play a number guessing game.\nI am thinking of a number from 1 to 100!You'll have to guess it!\n")
; create a secret random number from 1-100
c64.RND() ; fac = random number between 0 and 1
c64.MUL10() ; fac *= 10
c64.MUL10() ; .. and now *100
c64.FADDH() ; add 0.5..
c64.FADDH() ; and again, so +1 total
c64flt.RND() ; fac = random number between 0 and 1
c64flt.MUL10() ; fac *= 10
c64flt.MUL10() ; .. and now *100
c64flt.FADDH() ; add 0.5..
c64flt.FADDH() ; and again, so +1 total
A, Y = c64flt.GETADRAY()
secretnumber = A ; secret number = rnd()*100+1
@ -48,7 +47,7 @@ ask_guess:
Y=c64scr.input_chars(input)
c64.CHROUT('\n')
freadstr_arg = input
c64.FREADSTR(Y)
c64flt.FREADSTR(Y)
A, Y = c64flt.GETADRAY()
guess=A
if(guess==secretnumber) {

1
compiler/examples/sprites.p8
View File

@ -1,5 +1,4 @@
%import c64utils
%option enable_floats
~ spritedata $0a00 {

2
compiler/examples/swirl-c64-float.p8
View File

@ -1,5 +1,5 @@
%import c64utils
%option enable_floats
%import c64flt
~ main {

1
compiler/examples/swirl-c64.p8
View File

@ -1,5 +1,4 @@
%import c64utils
%option enable_floats ; @todo needed for now to avoid compile error in c64lib
~ main {

2
compiler/examples/swirl.p8
View File

@ -1,5 +1,5 @@
%import c64utils
%option enable_floats
%import c64flt
~ main {

6
compiler/examples/test.p8
View File

@ -1,6 +1,4 @@
%import c64utils
%option enable_floats
~ main {
@ -10,6 +8,10 @@
memory word w1 = $c002
memory word w2 = $c004
float x =4.34
ubyte xx= x as ubyte
float y = x * 5.55
y =xx as float
b1=50
b2=-50

1
compiler/examples/whizzine.p8
View File

@ -1,5 +1,4 @@
%import c64utils
%option enable_floats ; @todo needed for now to avoid compile error in c64lib
~ spritedata $0a00 {

8
compiler/src/prog8/ast/AstChecker.kt
View File

@ -503,11 +503,9 @@ class AstChecker(private val namespace: INameScope,
}
// FLOATS
// @todo move floating point routines from c64utils into separately included file, then re-enable this check
// if(!compilerOptions.floats && decl.datatype==DataType.FLOAT && decl.type!=VarDeclType.MEMORY) {
// checkResult.add(SyntaxError("floating point used, but that is not enabled via options", decl.position))
// }
if(!compilerOptions.floats && decl.datatype==DataType.FLOAT && decl.type!=VarDeclType.MEMORY) {
checkResult.add(SyntaxError("floating point used, but that is not enabled via options", decl.position))
}
when(decl.type) {
VarDeclType.VAR, VarDeclType.CONST -> {

108
compiler/src/prog8/compiler/target/c64/AsmGen.kt
View File

@ -433,7 +433,29 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
if (ins.arg!!.numericValue() in syscallsForStackVm.map { it.callNr })
throw CompilerException("cannot translate vm syscalls to real assembly calls - use *real* subroutine calls instead. Syscall ${ins.arg.numericValue()}")
val call = Syscall.values().find { it.callNr==ins.arg.numericValue() }
" jsr prog8_lib.${call.toString().toLowerCase()}"
when(call) {
Syscall.FUNC_SIN,
Syscall.FUNC_COS,
Syscall.FUNC_ABS,
Syscall.FUNC_TAN,
Syscall.FUNC_ATAN,
Syscall.FUNC_LN,
Syscall.FUNC_LOG2,
Syscall.FUNC_SQRT,
Syscall.FUNC_RAD,
Syscall.FUNC_DEG,
Syscall.FUNC_ROUND,
Syscall.FUNC_FLOOR,
Syscall.FUNC_CEIL,
Syscall.FUNC_RNDF,
Syscall.FUNC_ANY_F,
Syscall.FUNC_ALL_F,
Syscall.FUNC_MAX_F,
Syscall.FUNC_MIN_F,
Syscall.FUNC_AVG_F,
Syscall.FUNC_SUM_F -> " jsr c64flt.${call.toString().toLowerCase()}"
else -> " jsr prog8_lib.${call.toString().toLowerCase()}"
}
}
Opcode.BREAKPOINT -> {
breakpointCounter++
@ -449,7 +471,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
}
Opcode.PUSH_FLOAT -> {
val floatConst = getFloatConst(ins.arg!!)
" lda #<$floatConst | ldy #>$floatConst | jsr prog8_lib.push_float"
" lda #<$floatConst | ldy #>$floatConst | jsr c64flt.push_float"
}
Opcode.PUSH_VAR_BYTE -> {
when(ins.callLabel) {
@ -462,7 +484,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
Opcode.PUSH_VAR_WORD -> {
" lda ${ins.callLabel} | sta ${ESTACK_LO.toHex()},x | lda ${ins.callLabel}+1 | sta ${ESTACK_HI.toHex()},x | dex"
}
Opcode.PUSH_VAR_FLOAT -> " lda #<${ins.callLabel} | ldy #>${ins.callLabel}| jsr prog8_lib.push_float"
Opcode.PUSH_VAR_FLOAT -> " lda #<${ins.callLabel} | ldy #>${ins.callLabel}| jsr c64flt.push_float"
Opcode.PUSH_MEM_B, Opcode.PUSH_MEM_UB -> {
"""
lda ${hexVal(ins)}
@ -480,7 +502,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
"""
}
Opcode.PUSH_MEM_FLOAT -> {
" lda #<${hexVal(ins)} | ldy #>${hexVal(ins)}| jsr prog8_lib.push_float"
" lda #<${hexVal(ins)} | ldy #>${hexVal(ins)}| jsr c64flt.push_float"
}
Opcode.PUSH_MEMREAD -> {
"""
@ -527,7 +549,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
"""
lda #<${ins.callLabel}
ldy #>${ins.callLabel}
jsr prog8_lib.push_float_from_indexed_var
jsr c64flt.push_float_from_indexed_var
"""
}
Opcode.WRITE_INDEXED_VAR_BYTE -> {
@ -556,7 +578,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
"""
lda #<${ins.callLabel}
ldy #>${ins.callLabel}
jsr prog8_lib.pop_float_to_indexed_var
jsr c64flt.pop_float_to_indexed_var
"""
}
Opcode.POP_MEM_BYTE -> {
@ -576,7 +598,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
"""
}
Opcode.POP_MEM_FLOAT -> {
" lda ${hexVal(ins)} | ldy ${hexValPlusOne(ins)} | jsr prog8_lib.pop_float"
" lda ${hexVal(ins)} | ldy ${hexValPlusOne(ins)} | jsr c64flt.pop_float"
}
Opcode.POP_MEMWRITE -> {
"""
@ -603,7 +625,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
" inx | lda ${ESTACK_LO.toHex()},x | ldy ${ESTACK_HI.toHex()},x | sta ${ins.callLabel} | sty ${ins.callLabel}+1"
}
Opcode.POP_VAR_FLOAT -> {
" lda #<${ins.callLabel} | ldy #>${ins.callLabel} | jsr prog8_lib.pop_float"
" lda #<${ins.callLabel} | ldy #>${ins.callLabel} | jsr c64flt.pop_float"
}
Opcode.INC_VAR_UB, Opcode.INC_VAR_B -> {
@ -621,7 +643,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
"""
lda #<${ins.callLabel}
ldy #>${ins.callLabel}
jsr prog8_lib.inc_var_f
jsr c64flt.inc_var_f
"""
}
Opcode.POP_INC_MEMORY -> {
@ -659,17 +681,17 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
"""
lda #<${ins.callLabel}
ldy #>${ins.callLabel}
jsr prog8_lib.dec_var_f
jsr c64flt.dec_var_f
"""
}
Opcode.INC_MEMORY -> " inc ${hexVal(ins)}"
Opcode.DEC_MEMORY -> " dec ${hexVal(ins)}"
Opcode.NEG_B -> " jsr prog8_lib.neg_b"
Opcode.NEG_W -> " jsr prog8_lib.neg_w"
Opcode.NEG_F -> " jsr prog8_lib.neg_f"
Opcode.NEG_F -> " jsr c64flt.neg_f"
Opcode.ABS_B -> " jsr prog8_lib.abs_b"
Opcode.ABS_W -> " jsr prog8_lib.abs_w"
Opcode.ABS_F -> " jsr prog8_lib.abs_f"
Opcode.ABS_F -> " jsr c64flt.abs_f"
Opcode.INV_BYTE -> {
"""
lda ${(ESTACK_LO + 1).toHex()},x
@ -728,14 +750,14 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
Opcode.CAST_W_TO_B -> "" // is a no-op, just carry on with the lsb of the word as-is
Opcode.CAST_UW_TO_UB -> "" // is a no-op, just carry on with the lsb of the uword as-is
Opcode.CAST_UW_TO_B -> "" // is a no-op, just carry on with the lsb of the uword as-is
Opcode.CAST_UB_TO_F -> " jsr prog8_lib.stack_ub2float"
Opcode.CAST_B_TO_F -> " jsr prog8_lib.stack_b2float"
Opcode.CAST_UW_TO_F -> " jsr prog8_lib.stack_uw2float"
Opcode.CAST_W_TO_F -> " jsr prog8_lib.stack_w2float"
Opcode.CAST_F_TO_UB -> " jsr prog8_lib.stack_float2uw"
Opcode.CAST_F_TO_B -> " jsr prog8_lib.stack_float2w"
Opcode.CAST_F_TO_UW -> " jsr prog8_lib.stack_float2uw"
Opcode.CAST_F_TO_W -> " jsr prog8_lib.stack_float2w"
Opcode.CAST_UB_TO_F -> " jsr c64flt.stack_ub2float"
Opcode.CAST_B_TO_F -> " jsr c64flt.stack_b2float"
Opcode.CAST_UW_TO_F -> " jsr c64flt.stack_uw2float"
Opcode.CAST_W_TO_F -> " jsr c64flt.stack_w2float"
Opcode.CAST_F_TO_UB -> " jsr c64flt.stack_float2uw"
Opcode.CAST_F_TO_B -> " jsr c64flt.stack_float2w"
Opcode.CAST_F_TO_UW -> " jsr c64flt.stack_float2uw"
Opcode.CAST_F_TO_W -> " jsr c64flt.stack_float2w"
Opcode.CAST_UB_TO_UW, Opcode.CAST_UB_TO_W -> " lda #0 | sta ${(ESTACK_HI+1).toHex()},x" // clear the msb
Opcode.CAST_B_TO_UW, Opcode.CAST_B_TO_W -> " lda ${(ESTACK_LO+1)},x | ${signExtendA("${(ESTACK_HI+1).toHex()},x")}" // sign extend the lsb
Opcode.MSB -> " lda ${(ESTACK_HI+1).toHex()},x | sta ${(ESTACK_LO+1).toHex()},x"
@ -762,15 +784,15 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
Opcode.SUB_W, Opcode.SUB_UW -> " jsr prog8_lib.sub_w"
Opcode.MUL_B, Opcode.MUL_UB -> " jsr prog8_lib.mul_byte"
Opcode.MUL_W, Opcode.MUL_UW -> " jsr prog8_lib.mul_word"
Opcode.ADD_F -> " jsr prog8_lib.add_f"
Opcode.SUB_F -> " jsr prog8_lib.sub_f"
Opcode.MUL_F -> " jsr prog8_lib.mul_f"
Opcode.ADD_F -> " jsr c64flt.add_f"
Opcode.SUB_F -> " jsr c64flt.sub_f"
Opcode.MUL_F -> " jsr c64flt.mul_f"
Opcode.DIV_F -> " jsr c64flt.div_f"
Opcode.FLOORDIV -> " jsr c64flt.floordiv_f"
Opcode.DIV_UB -> " jsr prog8_lib.div_ub"
Opcode.DIV_B -> " jsr prog8_lib.div_b"
Opcode.DIV_F -> " jsr prog8_lib.div_f"
Opcode.DIV_W -> " jsr prog8_lib.div_w"
Opcode.DIV_UW -> " jsr prog8_lib.div_uw"
Opcode.FLOORDIV -> " jsr prog8_lib.floordiv_f"
Opcode.AND_BYTE -> {
"""
@ -797,32 +819,32 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
Opcode.GREATER_UB -> " jsr prog8_lib.greater_ub"
Opcode.GREATER_W -> " jsr prog8_lib.greater_w"
Opcode.GREATER_UW -> " jsr prog8_lib.greater_uw"
Opcode.GREATER_F -> " jsr prog8_lib.greater_f"
Opcode.GREATER_F -> " jsr c64flt.greater_f"
Opcode.GREATEREQ_B -> " jsr prog8_lib.greatereq_b"
Opcode.GREATEREQ_UB -> " jsr prog8_lib.greatereq_ub"
Opcode.GREATEREQ_W -> " jsr prog8_lib.greatereq_w"
Opcode.GREATEREQ_UW -> " jsr prog8_lib.greatereq_uw"
Opcode.GREATEREQ_F -> " jsr prog8_lib.greatereq_f"
Opcode.GREATEREQ_F -> " jsr c64flt.greatereq_f"
Opcode.EQUAL_BYTE -> " jsr prog8_lib.equal_b"
Opcode.EQUAL_WORD -> " jsr prog8_lib.equal_w"
Opcode.EQUAL_F -> " jsr prog8_lib.equal_f"
Opcode.EQUAL_F -> " jsr c64flt.equal_f"
Opcode.NOTEQUAL_BYTE -> " jsr prog8_lib.notequal_b"
Opcode.NOTEQUAL_WORD -> " jsr prog8_lib.notequal_w"
Opcode.NOTEQUAL_F -> " jsr prog8_lib.notequal_f"
Opcode.NOTEQUAL_F -> " jsr c64flt.notequal_f"
Opcode.LESS_UB -> " jsr prog8_lib.less_ub"
Opcode.LESS_B -> " jsr prog8_lib.less_b"
Opcode.LESS_UW -> " jsr prog8_lib.less_uw"
Opcode.LESS_W -> " jsr prog8_lib.less_w"
Opcode.LESS_F -> " jsr prog8_lib.less_f"
Opcode.LESS_F -> " jsr c64flt.less_f"
Opcode.LESSEQ_UB -> " jsr prog8_lib.lesseq_ub"
Opcode.LESSEQ_B -> " jsr prog8_lib.lesseq_b"
Opcode.LESSEQ_UW -> " jsr prog8_lib.lesseq_uw"
Opcode.LESSEQ_W -> " jsr prog8_lib.lesseq_w"
Opcode.LESSEQ_F -> " jsr prog8_lib.lesseq_f"
Opcode.LESSEQ_F -> " jsr c64flt.lesseq_f"
else -> null
}
@ -2341,7 +2363,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<${segment[1].callLabel}
ldy #>${segment[1].callLabel}
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// floatvar = float var
@ -2353,7 +2375,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<${segment[1].callLabel}
ldy #>${segment[1].callLabel}
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// floatvar = mem float
@ -2365,7 +2387,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<${segment[1].callLabel}
ldy #>${segment[1].callLabel}
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// floatvar = mem byte
@ -2471,7 +2493,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<${segment[2].callLabel}
ldy #>${segment[2].callLabel}
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
@ -2485,7 +2507,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<${hexVal(segment[1])}
ldy #>${hexVal(segment[1])}
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// memfloat = float var
@ -2497,7 +2519,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<${hexVal(segment[1])}
ldy #>${hexVal(segment[1])}
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// memfloat = ubytevar
@ -2609,7 +2631,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<${hexVal(segment[1])}
ldy #>${hexVal(segment[1])}
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// memfloat = bytearray[index]
@ -2670,7 +2692,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<${hexVal(segment[2])}
ldy #>${hexVal(segment[2])}
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// floatarray[idxbyte] = float
@ -2684,7 +2706,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<(${segment[2].callLabel}+$index)
ldy #>(${segment[2].callLabel}+$index)
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// floatarray[idxbyte] = floatvar
@ -2697,7 +2719,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<(${segment[2].callLabel}+$index)
ldy #>(${segment[2].callLabel}+$index)
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// floatarray[idxbyte] = memfloat
@ -2710,7 +2732,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<(${segment[2].callLabel}+$index)
ldy #>(${segment[2].callLabel}+$index)
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},
// floatarray[idx2] = floatarray[idx1]
@ -2724,7 +2746,7 @@ class AsmGen(val options: CompilationOptions, val program: IntermediateProgram,
sty ${C64Zeropage.SCRATCH_W1+1}
lda #<(${segment[3].callLabel}+$index2)
ldy #>(${segment[3].callLabel}+$index2)
jsr prog8_lib.copy_float
jsr c64flt.copy_float
"""
},

6
docs/source/building.rst
View File

@ -79,6 +79,6 @@ Troubleshooting
---------------
Getting an assembler error about undefined symbols such as ``not defined 'c64flt'``?
This happens when your program uses floating point values, and you forgot to import the ``c64lib``.
If you use floating points, the program will need routines from that library.
Fix it by adding an ``%import c64lib``.
This happens when your program uses floating point values, and you forgot to import ``c64flt`` library.
If you use floating points, the compiler needs routines from that library.
Fix it by adding an ``%import c64flt``.

9
docs/source/programming.rst
View File

@ -284,10 +284,15 @@ Floating point numbers
^^^^^^^^^^^^^^^^^^^^^^
Floats are stored in the 5-byte 'MFLPT' format that is used on CBM machines,
and also most float operations are specific to the Commodore-64.
and currently all floating point operations are specific to the Commodore-64.
This is because routines in the C-64 BASIC and KERNAL ROMs are used for that.
So floating point operations will only work if the C-64 BASIC ROM (and KERNAL ROM)
are banked in (and your code imports the ``c64lib.p8``)
are banked in.
Also your code needs to import the ``c64flt`` library to enable floating point support
in the compiler, and to gain access to the floating point routines.
(this library contains the directive to enable floating points, you don't have
to worry about this yourself)
The largest 5-byte MFLPT float that can be stored is: **1.7014118345e+38** (negative: **-1.7014118345e+38**)

939
prog8lib/c64flt.p8 Normal file
View File

@ -0,0 +1,939 @@
; Prog8 definitions for floating point handling on the Commodore-64
;
; Written by Irmen de Jong (irmen@razorvine.net) - license: GNU GPL 3.0
;
; indent format: TABS, size=8
%option enable_floats
~ c64flt {
; ---- this block contains C-64 floating point related functions ----
; @todo enable float-checkin astchecker.process(decl: VarDecl) again
const float PI = 3.141592653589793
const float TWOPI = 6.283185307179586
; ---- C64 basic and kernal ROM float constants and functions ----
; note: the fac1 and fac2 are working registers and take 6 bytes each,
; floats in memory (and rom) are stored in 5-byte MFLPT packed format.
; constants in five-byte "mflpt" format in the BASIC ROM
memory float FL_PIVAL = $aea8 ; 3.1415926...
memory float FL_N32768 = $b1a5 ; -32768
memory float FL_FONE = $b9bc ; 1
memory float FL_SQRHLF = $b9d6 ; SQR(2) / 2
memory float FL_SQRTWO = $b9db ; SQR(2)
memory float FL_NEGHLF = $b9e0 ; -.5
memory float FL_LOG2 = $b9e5 ; LOG(2)
memory float FL_TENC = $baf9 ; 10
memory float FL_NZMIL = $bdbd ; 1e9 (1 billion)
memory float FL_FHALF = $bf11 ; .5
memory float FL_LOGEB2 = $bfbf ; 1 / LOG(2)
memory float FL_PIHALF = $e2e0 ; PI / 2
memory float FL_TWOPI = $e2e5 ; 2 * PI
memory float FL_FR4 = $e2ea ; .25
; note: fac1/2 might get clobbered even if not mentioned in the function's name.
; note: for subtraction and division, the left operand is in fac2, the right operand in fac1.
; checked functions below:
asmsub MOVFM (uword mflpt @ AY) -> clobbers(A,Y) -> () = $bba2 ; load mflpt value from memory in A/Y into fac1
asmsub FREADMEM () -> clobbers(A,Y) -> () = $bba6 ; load mflpt value from memory in $22/$23 into fac1
asmsub CONUPK (uword mflpt @ AY) -> clobbers(A,Y) -> () = $ba8c ; load mflpt value from memory in A/Y into fac2
asmsub FAREADMEM () -> clobbers(A,Y) -> () = $ba90 ; load mflpt value from memory in $22/$23 into fac2
asmsub MOVFA () -> clobbers(A,X) -> () = $bbfc ; copy fac2 to fac1
asmsub MOVAF () -> clobbers(A,X) -> () = $bc0c ; copy fac1 to fac2 (rounded)
asmsub MOVEF () -> clobbers(A,X) -> () = $bc0f ; copy fac1 to fac2
asmsub MOVMF (uword mflpt @ XY) -> clobbers(A,Y) -> () = $bbd4 ; store fac1 to memory X/Y as 5-byte mflpt
; fac1-> signed word in Y/A (might throw ILLEGAL QUANTITY)
; (tip: use c64flt.FTOSWRDAY to get A/Y output; lo/hi switched to normal little endian order)
asmsub FTOSWORDYA () -> clobbers(X) -> (ubyte @ Y, ubyte @ A) = $b1aa
; fac1 -> unsigned word in Y/A (might throw ILLEGAL QUANTITY) (result also in $14/15)
; (tip: use c64flt.GETADRAY to get A/Y output; lo/hi switched to normal little endian order)
asmsub GETADR () -> clobbers(X) -> (ubyte @ Y, ubyte @ A) = $b7f7
asmsub QINT () -> clobbers(A,X,Y) -> () = $bc9b ; fac1 -> 4-byte signed integer in 98-101 ($62-$65), with the MSB FIRST.
asmsub AYINT () -> clobbers(A,X,Y) -> () = $b1bf ; fac1-> signed word in 100-101 ($64-$65) MSB FIRST. (might throw ILLEGAL QUANTITY)
; GIVAYF: signed word in Y/A (note different lsb/msb order) -> float in fac1
; (tip: use c64flt.GIVAYFAY to use A/Y input; lo/hi switched to normal order)
; there is also c64flt.GIVUAYFAY - unsigned word in A/Y (lo/hi) to fac1
; there is also c64flt.FREADS32 that reads from 98-101 ($62-$65) MSB FIRST
; there is also c64flt.FREADUS32 that reads from 98-101 ($62-$65) MSB FIRST
; there is also c64flt.FREADS24AXY that reads signed int24 into fac1 from A/X/Y (lo/mid/hi bytes)
asmsub GIVAYF (ubyte lo @ Y, ubyte hi @ A) -> clobbers(A,X,Y) -> () = $b391
asmsub FREADUY (ubyte value @ Y) -> clobbers(A,X,Y) -> () = $b3a2 ; 8 bit unsigned Y -> float in fac1
asmsub FREADSA (byte value @ A) -> clobbers(A,X,Y) -> () = $bc3c ; 8 bit signed A -> float in fac1
asmsub FREADSTR (ubyte length @ A) -> clobbers(A,X,Y) -> () = $b7b5 ; str -> fac1, $22/23 must point to string, A=string length
asmsub FPRINTLN () -> clobbers(A,X,Y) -> () = $aabc ; print string of fac1, on one line (= with newline) destroys fac1. (consider FOUT + STROUT as well)
asmsub FOUT () -> clobbers(X) -> (uword @ AY) = $bddd ; fac1 -> string, address returned in AY ($0100)
asmsub FADDH () -> clobbers(A,X,Y) -> () = $b849 ; fac1 += 0.5, for rounding- call this before INT
asmsub MUL10 () -> clobbers(A,X,Y) -> () = $bae2 ; fac1 *= 10
asmsub DIV10 () -> clobbers(A,X,Y) -> () = $bafe ; fac1 /= 10 , CAUTION: result is always positive!
asmsub FCOMP (uword mflpt @ AY) -> clobbers(X,Y) -> (ubyte @ A) = $bc5b ; A = compare fac1 to mflpt in A/Y, 0=equal 1=fac1 is greater, 255=fac1 is less than
asmsub FADDT () -> clobbers(A,X,Y) -> () = $b86a ; fac1 += fac2
asmsub FADD (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $b867 ; fac1 += mflpt value from A/Y
asmsub FSUBT () -> clobbers(A,X,Y) -> () = $b853 ; fac1 = fac2-fac1 mind the order of the operands
asmsub FSUB (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $b850 ; fac1 = mflpt from A/Y - fac1
asmsub FMULTT () -> clobbers(A,X,Y) -> () = $ba2b ; fac1 *= fac2
asmsub FMULT (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $ba28 ; fac1 *= mflpt value from A/Y
asmsub FDIVT () -> clobbers(A,X,Y) -> () = $bb12 ; fac1 = fac2/fac1 (remainder in fac2) mind the order of the operands
asmsub FDIV (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $bb0f ; fac1 = mflpt in A/Y / fac1 (remainder in fac2)
asmsub FPWRT () -> clobbers(A,X,Y) -> () = $bf7b ; fac1 = fac2 ** fac1
asmsub FPWR (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $bf78 ; fac1 = fac2 ** mflpt from A/Y
asmsub NOTOP () -> clobbers(A,X,Y) -> () = $aed4 ; fac1 = NOT(fac1)
asmsub INT () -> clobbers(A,X,Y) -> () = $bccc ; INT() truncates, use FADDH first to round instead of trunc
asmsub LOG () -> clobbers(A,X,Y) -> () = $b9ea ; fac1 = LN(fac1) (natural log)
asmsub SGN () -> clobbers(A,X,Y) -> () = $bc39 ; fac1 = SGN(fac1), result of SIGN (-1, 0 or 1)
asmsub SIGN () -> clobbers() -> (ubyte @ A) = $bc2b ; SIGN(fac1) to A, $ff, $0, $1 for negative, zero, positive
asmsub ABS () -> clobbers() -> () = $bc58 ; fac1 = ABS(fac1)
asmsub SQR () -> clobbers(A,X,Y) -> () = $bf71 ; fac1 = SQRT(fac1)
asmsub SQRA () -> clobbers(A,X,Y) -> () = $bf74 ; fac1 = SQRT(fac2)
asmsub EXP () -> clobbers(A,X,Y) -> () = $bfed ; fac1 = EXP(fac1) (e ** fac1)
asmsub NEGOP () -> clobbers(A) -> () = $bfb4 ; switch the sign of fac1
asmsub RND () -> clobbers(A,X,Y) -> () = $e097 ; fac1 = RND(fac1) float random number generator
asmsub COS () -> clobbers(A,X,Y) -> () = $e264 ; fac1 = COS(fac1)
asmsub SIN () -> clobbers(A,X,Y) -> () = $e26b ; fac1 = SIN(fac1)
asmsub TAN () -> clobbers(A,X,Y) -> () = $e2b4 ; fac1 = TAN(fac1)
asmsub ATN () -> clobbers(A,X,Y) -> () = $e30e ; fac1 = ATN(fac1)
asmsub FREADS32 () -> clobbers(A,X,Y) -> () {
; ---- fac1 = signed int32 from $62-$65 big endian (MSB FIRST)
%asm {{
lda $62
eor #$ff
asl a
lda #0
ldx #$a0
jmp $bc4f ; internal BASIC routine
}}
}
asmsub FREADUS32 () -> clobbers(A,X,Y) -> () {
; ---- fac1 = uint32 from $62-$65 big endian (MSB FIRST)
%asm {{
sec
lda #0
ldx #$a0
jmp $bc4f ; internal BASIC routine
}}
}
asmsub FREADS24AXY (ubyte lo @ A, ubyte mid @ X, ubyte hi @ Y) -> clobbers(A,X,Y) -> () {
; ---- fac1 = signed int24 (A/X/Y contain lo/mid/hi bytes)
; note: there is no FREADU24AXY (unsigned), use FREADUS32 instead.
%asm {{
sty $62
stx $63
sta $64
lda $62
eor #$FF
asl a
lda #0
sta $65
ldx #$98
jmp $bc4f ; internal BASIC routine
}}
}
asmsub GIVUAYFAY (uword value @ AY) -> clobbers(A,X,Y) -> () {
; ---- unsigned 16 bit word in A/Y (lo/hi) to fac1
%asm {{
sty $62
sta $63
ldx #$90
sec
jmp $bc49 ; internal BASIC routine
}}
}
asmsub GIVAYFAY (uword value @ AY) -> clobbers(A,X,Y) -> () {
; ---- signed 16 bit word in A/Y (lo/hi) to float in fac1
%asm {{
sta c64.SCRATCH_ZPREG
tya
ldy c64.SCRATCH_ZPREG
jmp c64flt.GIVAYF ; this uses the inverse order, Y/A
}}
}
asmsub FTOSWRDAY () -> clobbers(X) -> (uword @ AY) {
; ---- fac1 to signed word in A/Y
%asm {{
jsr c64flt.FTOSWORDYA ; note the inverse Y/A order
sta c64.SCRATCH_ZPREG
tya
ldy c64.SCRATCH_ZPREG
rts
}}
}
asmsub GETADRAY () -> clobbers(X) -> (uword @ AY) {
; ---- fac1 to unsigned word in A/Y
%asm {{
jsr c64flt.GETADR ; this uses the inverse order, Y/A
sta c64.SCRATCH_ZPB1
tya
ldy c64.SCRATCH_ZPB1
rts
}}
}
sub print_f (float value) {
; ---- prints the floating point value (without a newline) using basic rom routines.
; clobbers no registers.
; @todo version that takes A/Y pointer to float instead
%asm {{
pha
tya
pha
txa
pha
lda #<print_f_value
ldy #>print_f_value
jsr c64flt.MOVFM ; load float into fac1
jsr c64flt.FOUT ; fac1 to string in A/Y
jsr c64.STROUT ; print string in A/Y
pla
tax
pla
tay
pla
rts
}}
}
sub print_fln (float value) {
; ---- prints the floating point value (with a newline at the end) using basic rom routines
; clobbers no registers.
; @todo version that takes A/Y pointer to float instead
%asm {{
pha
tya
pha
txa
pha
lda #<print_fln_value
ldy #>print_fln_value
jsr c64flt.MOVFM ; load float into fac1
jsr c64flt.FPRINTLN ; print fac1 with newline
pla
tax
pla
tay
pla
rts
}}
}
; --- low level floating point assembly routines
%asm {{
ub2float .proc
; -- convert ubyte in SCRATCH_ZPB1 to float at address A/Y
; clobbers A, Y
stx c64.SCRATCH_ZPREGX
sta c64.SCRATCH_ZPWORD2
sty c64.SCRATCH_ZPWORD1+1
ldy c64.SCRATCH_ZPB1
jsr c64flt.FREADUY
_fac_to_mem ldx c64.SCRATCH_ZPWORD2
ldy c64.SCRATCH_ZPWORD2+1
jsr c64flt.MOVMF
ldx c64.SCRATCH_ZPREGX
rts
.pend
b2float .proc
; -- convert byte in SCRATCH_ZPB1 to float at address A/Y
; clobbers A, Y
stx c64.SCRATCH_ZPREGX
sta c64.SCRATCH_ZPWORD2
sty c64.SCRATCH_ZPWORD2+1
lda c64.SCRATCH_ZPB1
jsr c64flt.FREADSA
jmp ub2float._fac_to_mem
.pend
uw2float .proc
; -- convert uword in SCRATCH_ZPWORD1 to float at address A/Y
stx c64.SCRATCH_ZPREGX
sta c64.SCRATCH_ZPWORD2
sty c64.SCRATCH_ZPWORD2+1
lda c64.SCRATCH_ZPWORD1
ldy c64.SCRATCH_ZPWORD1+1
jsr c64flt.GIVUAYFAY
jmp ub2float._fac_to_mem
.pend
w2float .proc
; -- convert word in SCRATCH_ZPWORD1 to float at address A/Y
stx c64.SCRATCH_ZPREGX
sta c64.SCRATCH_ZPWORD2
sty c64.SCRATCH_ZPWORD2+1
ldy c64.SCRATCH_ZPWORD1
lda c64.SCRATCH_ZPWORD1+1
jsr c64flt.GIVAYF
jmp ub2float._fac_to_mem
.pend
stack_b2float .proc
; -- b2float operating on the stack
inx
lda c64.ESTACK_LO,x
stx c64.SCRATCH_ZPREGX
jsr c64flt.FREADSA
jmp push_fac1_as_result
.pend
stack_w2float .proc
; -- w2float operating on the stack
inx
ldy c64.ESTACK_LO,x
lda c64.ESTACK_HI,x
stx c64.SCRATCH_ZPREGX
jsr c64flt.GIVAYF
jmp push_fac1_as_result
.pend
stack_ub2float .proc
; -- ub2float operating on the stack
inx
lda c64.ESTACK_LO,x
stx c64.SCRATCH_ZPREGX
tay
jsr c64flt.FREADUY
jmp push_fac1_as_result
.pend
stack_uw2float .proc
; -- uw2float operating on the stack
inx
lda c64.ESTACK_LO,x
ldy c64.ESTACK_HI,x
stx c64.SCRATCH_ZPREGX
jsr c64flt.GIVUAYFAY
jmp push_fac1_as_result
.pend
stack_float2w .proc
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.AYINT
ldx c64.SCRATCH_ZPREGX
lda $64
sta c64.ESTACK_HI,x
lda $65
sta c64.ESTACK_LO,x
dex
rts
.pend
stack_float2uw .proc
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.GETADR
ldx c64.SCRATCH_ZPREGX
sta c64.ESTACK_HI,x
tya
sta c64.ESTACK_LO,x
dex
rts
.pend
push_float .proc
; ---- push mflpt5 in A/Y onto stack
; (taking 3 stack positions = 6 bytes of which 1 is padding)
sta c64.SCRATCH_ZPWORD1
sty c64.SCRATCH_ZPWORD1+1
ldy #0
lda (c64.SCRATCH_ZPWORD1),y
sta c64.ESTACK_LO,x
iny
lda (c64.SCRATCH_ZPWORD1),y
sta c64.ESTACK_HI,x
dex
iny
lda (c64.SCRATCH_ZPWORD1),y
sta c64.ESTACK_LO,x
iny
lda (c64.SCRATCH_ZPWORD1),y
sta c64.ESTACK_HI,x
dex
iny
lda (c64.SCRATCH_ZPWORD1),y
sta c64.ESTACK_LO,x
dex
rts
.pend
func_rndf .proc
; -- put a random floating point value on the stack
stx c64.SCRATCH_ZPREG
lda #1
jsr c64flt.FREADSA
jsr c64flt.RND ; rng into fac1
ldx #<_rndf_rnum5
ldy #>_rndf_rnum5
jsr c64flt.MOVMF ; fac1 to mem X/Y
ldx c64.SCRATCH_ZPREG
lda #<_rndf_rnum5
ldy #>_rndf_rnum5
jmp push_float
_rndf_rnum5 .byte 0,0,0,0,0
.pend
push_float_from_indexed_var .proc
; -- push the float from the array at A/Y with index on stack, onto the stack.
sta c64.SCRATCH_ZPWORD1
sty c64.SCRATCH_ZPWORD1+1
jsr prog8_lib.pop_index_times_5
jsr prog8_lib.add_a_to_zpword
lda c64.SCRATCH_ZPWORD1
ldy c64.SCRATCH_ZPWORD1+1
jmp push_float
.pend
pop_float .proc
; ---- pops mflpt5 from stack to memory A/Y
; (frees 3 stack positions = 6 bytes of which 1 is padding)
sta c64.SCRATCH_ZPWORD1
sty c64.SCRATCH_ZPWORD1+1
ldy #4
inx
lda c64.ESTACK_LO,x
sta (c64.SCRATCH_ZPWORD1),y
dey
inx
lda c64.ESTACK_HI,x
sta (c64.SCRATCH_ZPWORD1),y
dey
lda c64.ESTACK_LO,x
sta (c64.SCRATCH_ZPWORD1),y
dey
inx
lda c64.ESTACK_HI,x
sta (c64.SCRATCH_ZPWORD1),y
dey
lda c64.ESTACK_LO,x
sta (c64.SCRATCH_ZPWORD1),y
rts
.pend
pop_float_fac1 .proc
; -- pops float from stack into FAC1
lda #<fmath_float1
ldy #>fmath_float1
jsr pop_float
lda #<fmath_float1
ldy #>fmath_float1
jmp c64flt.MOVFM
.pend
pop_float_to_indexed_var .proc
; -- pop the float on the stack, to the memory in the array at A/Y indexed by the byte on stack
sta c64.SCRATCH_ZPWORD1
sty c64.SCRATCH_ZPWORD1+1
jsr prog8_lib.pop_index_times_5
jsr prog8_lib.add_a_to_zpword
lda c64.SCRATCH_ZPWORD1
ldy c64.SCRATCH_ZPWORD1+1
jmp pop_float
.pend
copy_float .proc
; -- 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.
sta c64.SCRATCH_ZPWORD2
sty c64.SCRATCH_ZPWORD2+1
ldy #0
lda (c64.SCRATCH_ZPWORD1),y
sta (c64.SCRATCH_ZPWORD2),y
iny
lda (c64.SCRATCH_ZPWORD1),y
sta (c64.SCRATCH_ZPWORD2),y
iny
lda (c64.SCRATCH_ZPWORD1),y
sta (c64.SCRATCH_ZPWORD2),y
iny
lda (c64.SCRATCH_ZPWORD1),y
sta (c64.SCRATCH_ZPWORD2),y
iny
lda (c64.SCRATCH_ZPWORD1),y
sta (c64.SCRATCH_ZPWORD2),y
rts
.pend
inc_var_f .proc
; -- add 1 to float pointed to by A/Y
sta c64.SCRATCH_ZPWORD1
sty c64.SCRATCH_ZPWORD1+1
stx c64.SCRATCH_ZPREGX
jsr c64flt.MOVFM
lda #<c64.FL_FONE
ldy #>c64.FL_FONE
jsr c64flt.FADD
ldx c64.SCRATCH_ZPWORD1
ldy c64.SCRATCH_ZPWORD1+1
jsr c64flt.MOVMF
ldx c64.SCRATCH_ZPREGX
rts
.pend
dec_var_f .proc
; -- subtract 1 from float pointed to by A/Y
sta c64.SCRATCH_ZPWORD1
sty c64.SCRATCH_ZPWORD1+1
stx c64.SCRATCH_ZPREGX
lda #<c64.FL_FONE
ldy #>c64.FL_FONE
jsr c64flt.MOVFM
lda c64.SCRATCH_ZPWORD1
ldy c64.SCRATCH_ZPWORD1+1
jsr c64flt.FSUB
ldx c64.SCRATCH_ZPWORD1
ldy c64.SCRATCH_ZPWORD1+1
jsr c64flt.MOVMF
ldx c64.SCRATCH_ZPREGX
rts
.pend
pop_2_floats_f2_in_fac1 .proc
; -- pop 2 floats from stack, load the second one in FAC1 as well
lda #<fmath_float2
ldy #>fmath_float2
jsr pop_float
lda #<fmath_float1
ldy #>fmath_float1
jsr pop_float
lda #<fmath_float2
ldy #>fmath_float2
jmp c64flt.MOVFM
.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
push_fac1_as_result .proc
; -- push the float in FAC1 onto the stack, and return from calculation
ldx #<fmath_float1
ldy #>fmath_float1
jsr c64flt.MOVMF
lda #<fmath_float1
ldy #>fmath_float1
ldx c64.SCRATCH_ZPREGX
jmp push_float
.pend
floordiv_f .proc
; -- push f1//f2 on stack
jsr pop_2_floats_f2_in_fac1
stx c64.SCRATCH_ZPREGX
lda #<fmath_float1
ldy #>fmath_float1
jsr c64flt.FDIV
jsr c64flt.INT
jmp push_fac1_as_result
.pend
div_f .proc
; -- push f1/f2 on stack
jsr pop_2_floats_f2_in_fac1
stx c64.SCRATCH_ZPREGX
lda #<fmath_float1
ldy #>fmath_float1
jsr c64flt.FDIV
jmp push_fac1_as_result
.pend
add_f .proc
; -- push f1+f2 on stack
jsr pop_2_floats_f2_in_fac1
stx c64.SCRATCH_ZPREGX
lda #<fmath_float1
ldy #>fmath_float1
jsr c64flt.FADD
jmp push_fac1_as_result
.pend
sub_f .proc
; -- push f1-f2 on stack
jsr pop_2_floats_f2_in_fac1
stx c64.SCRATCH_ZPREGX
lda #<fmath_float1
ldy #>fmath_float1
jsr c64flt.FSUB
jmp push_fac1_as_result
.pend
mul_f .proc
; -- push f1*f2 on stack
jsr pop_2_floats_f2_in_fac1
stx c64.SCRATCH_ZPREGX
lda #<fmath_float1
ldy #>fmath_float1
jsr c64flt.FMULT
jmp push_fac1_as_result
.pend
neg_f .proc
; -- push -flt back on stack
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.NEGOP
jmp push_fac1_as_result
.pend
abs_f .proc
; -- push abs(float) on stack (as float)
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.ABS
jmp push_fac1_as_result
.pend
equal_f .proc
; -- are the two mflpt5 numbers on the stack identical?
inx
inx
inx
inx
lda c64.ESTACK_LO-3,x
cmp c64.ESTACK_LO,x
bne _equals_false
lda c64.ESTACK_LO-2,x
cmp c64.ESTACK_LO+1,x
bne _equals_false
lda c64.ESTACK_LO-1,x
cmp c64.ESTACK_LO+2,x
bne _equals_false
lda c64.ESTACK_HI-2,x
cmp c64.ESTACK_HI+1,x
bne _equals_false
lda c64.ESTACK_HI-1,x
cmp c64.ESTACK_HI+2,x
bne _equals_false
_equals_true lda #1
_equals_store inx
sta c64.ESTACK_LO+1,x
rts
_equals_false lda #0
beq _equals_store
.pend
notequal_f .proc
; -- are the two mflpt5 numbers on the stack different?
jsr equal_f
eor #1 ; invert the result
sta c64.ESTACK_LO+1,x
rts
.pend
less_f .proc
; -- is f1 < f2?
jsr compare_floats
cmp #255
beq compare_floats._return_true
bne compare_floats._return_false
.pend
lesseq_f .proc
; -- is f1 <= f2?
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?
jsr compare_floats
cmp #1
beq compare_floats._return_true
bne compare_floats._return_false
.pend
greatereq_f .proc
; -- is f1 >= f2?
jsr compare_floats
cmp #1
beq compare_floats._return_true
cmp #0
beq compare_floats._return_true
bne compare_floats._return_false
.pend
compare_floats .proc
lda #<fmath_float2
ldy #>fmath_float2
jsr pop_float
lda #<fmath_float1
ldy #>fmath_float1
jsr pop_float
lda #<fmath_float1
ldy #>fmath_float1
jsr c64flt.MOVFM ; fac1 = flt1
lda #<fmath_float2
ldy #>fmath_float2
stx c64.SCRATCH_ZPREG
jsr c64flt.FCOMP ; A = flt1 compared with flt2 (0=equal, 1=flt1>flt2, 255=flt1<flt2)
ldx c64.SCRATCH_ZPREG
rts
_return_false lda #0
_return_result sta c64.ESTACK_LO,x
dex
rts
_return_true lda #1
bne _return_result
.pend
func_sin .proc
; -- push sin(f) back onto stack
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.SIN
jmp push_fac1_as_result
.pend
func_cos .proc
; -- push cos(f) back onto stack
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.COS
jmp push_fac1_as_result
.pend
func_tan .proc
; -- push tan(f) back onto stack
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.TAN
jmp push_fac1_as_result
.pend
func_atan .proc
; -- push atan(f) back onto stack
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.ATN
jmp push_fac1_as_result
.pend
func_ln .proc
; -- push ln(f) back onto stack
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.LOG
jmp push_fac1_as_result
.pend
func_log2 .proc
; -- push log base 2, ln(f)/ln(2), back onto stack
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.LOG
jsr c64flt.MOVEF
lda #<c64.FL_LOG2
ldy #>c64.FL_LOG2
jsr c64flt.MOVFM
jsr c64flt.FDIVT
jmp push_fac1_as_result
.pend
func_sqrt .proc
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.SQR
jmp push_fac1_as_result
.pend
func_rad .proc
; -- convert degrees to radians (d * pi / 180)
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
lda #<_pi_div_180
ldy #>_pi_div_180
jsr c64flt.FMULT
jmp push_fac1_as_result
_pi_div_180 .byte 123, 14, 250, 53, 18 ; pi / 180
.pend
func_deg .proc
; -- convert radians to degrees (d * (1/ pi * 180))
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
lda #<_one_over_pi_div_180
ldy #>_one_over_pi_div_180
jsr c64flt.FMULT
jmp push_fac1_as_result
_one_over_pi_div_180 .byte 134, 101, 46, 224, 211 ; 1 / (pi * 180)
.pend
func_round .proc
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.FADDH
jsr c64flt.INT
jmp push_fac1_as_result
.pend
func_floor .proc
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
jsr c64flt.INT
jmp push_fac1_as_result
.pend
func_ceil .proc
; -- ceil: tr = int(f); if tr==f -> return else return tr+1
jsr pop_float_fac1
stx c64.SCRATCH_ZPREGX
lda #<fmath_float1
ldy #>fmath_float1
jsr c64flt.MOVMF
jsr c64flt.INT
lda #<fmath_float1
ldy #>fmath_float1
jsr c64flt.FCOMP
cmp #0
beq +
lda #<c64.FL_FONE
ldy #>c64.FL_FONE
jsr c64flt.FADD
+ jmp push_fac1_as_result
.pend
func_any_f .proc
inx
lda c64.ESTACK_LO,x ; array size
sta c64.SCRATCH_ZPB1
asl a
asl a
clc
adc c64.SCRATCH_ZPB1 ; times 5 because of float
jmp func_any_b._entry
.pend
func_all_f .proc
inx
lda c64.ESTACK_LO,x ; array size
sta c64.SCRATCH_ZPB1
asl a
asl a
clc
adc c64.SCRATCH_ZPB1 ; times 5 because of float
sta _cmp_mod+1 ; self-modifying code
jsr peek_address
ldy #0
- lda (c64.SCRATCH_ZPWORD1),y
bne +
iny
lda (c64.SCRATCH_ZPWORD1),y
bne +
iny
lda (c64.SCRATCH_ZPWORD1),y
bne +
iny
lda (c64.SCRATCH_ZPWORD1),y
bne +
iny
lda (c64.SCRATCH_ZPWORD1),y
bne +
lda #0
sta c64.ESTACK_LO+1,x
rts
+ iny
_cmp_mod cpy #255 ; modified
bne -
lda #1
sta c64.ESTACK_LO+1,x
rts
.pend
func_max_f .proc
lda #<_min_float
ldy #>_min_float
jsr c64flt.MOVFM ; fac1=min(float)
lda #255
sta _cmp_mod+1 ; compare using 255 so we keep larger values
_minmax_entry jsr pop_array_and_lengthmin1Y
stx c64.SCRATCH_ZPREGX
- sty c64.SCRATCH_ZPREG
lda c64.SCRATCH_ZPWORD1
ldy c64.SCRATCH_ZPWORD1+1
jsr c64flt.FCOMP
_cmp_mod cmp #255 ; will be modified
bne +
; fac1 is smaller/larger, so store the new value instead
lda c64.SCRATCH_ZPWORD1
ldy c64.SCRATCH_ZPWORD1+1
jsr c64flt.MOVFM
ldy c64.SCRATCH_ZPREG
dey
cmp #255
beq +
lda c64.SCRATCH_ZPWORD1
clc
adc #5
sta c64.SCRATCH_ZPWORD1
bcc -
inc c64.SCRATCH_ZPWORD1+1
bne -
+ jmp push_fac1_as_result
_min_float .byte 255,255,255,255,255 ; -1.7014118345e+38
.pend
func_min_f .proc
lda #<_max_float
ldy #>_max_float
jsr c64flt.MOVFM ; fac1=max(float)
lda #1
sta func_max_f._cmp_mod+1 ; compare using 1 so we keep smaller values
jmp func_max_f._minmax_entry
_max_float .byte 255,127,255,255,255 ; 1.7014118345e+38
.pend
func_sum_f .proc
lda #<c64.FL_NEGHLF
ldy #>c64.FL_NEGHLF
jsr c64flt.MOVFM
jsr pop_array_and_lengthmin1Y
stx c64.SCRATCH_ZPREGX
- sty c64.SCRATCH_ZPREG
lda c64.SCRATCH_ZPWORD1
ldy c64.SCRATCH_ZPWORD1+1
jsr c64flt.FADD
ldy c64.SCRATCH_ZPREG
dey
cpy #255
beq +
lda c64.SCRATCH_ZPWORD1
clc
adc #5
sta c64.SCRATCH_ZPWORD1
bcc -
inc c64.SCRATCH_ZPWORD1+1
bne -
+ jsr c64flt.FADDH
jmp push_fac1_as_result
.pend
}}
} ; ------ end of block c64flt

96
prog8lib/c64lib.p8
View File

@ -12,6 +12,8 @@
memory ubyte SCRATCH_ZPREGX = $fa ; temp storage for X register (stack pointer)
memory uword SCRATCH_ZPWORD1 = $fb ; scratch word in ZP ($fb/$fc)
memory uword SCRATCH_ZPWORD2 = $fd ; scratch word in ZP ($fd/$fe)
const uword ESTACK_LO = $ce00 ; evaluation stack (lsb)
const uword ESTACK_HI = $cf00 ; evaluation stack (msb)
memory ubyte TIME_HI = $a0 ; software jiffy clock, hi byte
@ -138,99 +140,6 @@
; ---- C64 basic and kernal ROM float constants and functions ----
; note: the fac1 and fac2 are working registers and take 6 bytes each,
; floats in memory (and rom) are stored in 5-byte MFLPT packed format.
; constants in five-byte "mflpt" format in the BASIC ROM
memory float FL_PIVAL = $aea8 ; 3.1415926...
memory float FL_N32768 = $b1a5 ; -32768
memory float FL_FONE = $b9bc ; 1
memory float FL_SQRHLF = $b9d6 ; SQR(2) / 2
memory float FL_SQRTWO = $b9db ; SQR(2)
memory float FL_NEGHLF = $b9e0 ; -.5
memory float FL_LOG2 = $b9e5 ; LOG(2)
memory float FL_TENC = $baf9 ; 10
memory float FL_NZMIL = $bdbd ; 1e9 (1 billion)
memory float FL_FHALF = $bf11 ; .5
memory float FL_LOGEB2 = $bfbf ; 1 / LOG(2)
memory float FL_PIHALF = $e2e0 ; PI / 2
memory float FL_TWOPI = $e2e5 ; 2 * PI
memory float FL_FR4 = $e2ea ; .25
; note: fac1/2 might get clobbered even if not mentioned in the function's name.
; note: for subtraction and division, the left operand is in fac2, the right operand in fac1.
; checked functions below:
asmsub MOVFM (uword mflpt @ AY) -> clobbers(A,Y) -> () = $bba2 ; load mflpt value from memory in A/Y into fac1
asmsub FREADMEM () -> clobbers(A,Y) -> () = $bba6 ; load mflpt value from memory in $22/$23 into fac1
asmsub CONUPK (uword mflpt @ AY) -> clobbers(A,Y) -> () = $ba8c ; load mflpt value from memory in A/Y into fac2
asmsub FAREADMEM () -> clobbers(A,Y) -> () = $ba90 ; load mflpt value from memory in $22/$23 into fac2
asmsub MOVFA () -> clobbers(A,X) -> () = $bbfc ; copy fac2 to fac1
asmsub MOVAF () -> clobbers(A,X) -> () = $bc0c ; copy fac1 to fac2 (rounded)
asmsub MOVEF () -> clobbers(A,X) -> () = $bc0f ; copy fac1 to fac2
asmsub MOVMF (uword mflpt @ XY) -> clobbers(A,Y) -> () = $bbd4 ; store fac1 to memory X/Y as 5-byte mflpt
; fac1-> signed word in Y/A (might throw ILLEGAL QUANTITY)
; (tip: use c64flt.FTOSWRDAY to get A/Y output; lo/hi switched to normal little endian order)
asmsub FTOSWORDYA () -> clobbers(X) -> (ubyte @ Y, ubyte @ A) = $b1aa
; fac1 -> unsigned word in Y/A (might throw ILLEGAL QUANTITY) (result also in $14/15)
; (tip: use c64flt.GETADRAY to get A/Y output; lo/hi switched to normal little endian order)
asmsub GETADR () -> clobbers(X) -> (ubyte @ Y, ubyte @ A) = $b7f7
asmsub QINT () -> clobbers(A,X,Y) -> () = $bc9b ; fac1 -> 4-byte signed integer in 98-101 ($62-$65), with the MSB FIRST.
asmsub AYINT () -> clobbers(A,X,Y) -> () = $b1bf ; fac1-> signed word in 100-101 ($64-$65) MSB FIRST. (might throw ILLEGAL QUANTITY)
; GIVAYF: signed word in Y/A (note different lsb/msb order) -> float in fac1
; (tip: use c64flt.GIVAYFAY to use A/Y input; lo/hi switched to normal order)
; there is also c64flt.GIVUAYFAY - unsigned word in A/Y (lo/hi) to fac1
; there is also c64flt.FREADS32 that reads from 98-101 ($62-$65) MSB FIRST
; there is also c64flt.FREADUS32 that reads from 98-101 ($62-$65) MSB FIRST
; there is also c64flt.FREADS24AXY that reads signed int24 into fac1 from A/X/Y (lo/mid/hi bytes)
asmsub GIVAYF (ubyte lo @ Y, ubyte hi @ A) -> clobbers(A,X,Y) -> () = $b391
asmsub FREADUY (ubyte value @ Y) -> clobbers(A,X,Y) -> () = $b3a2 ; 8 bit unsigned Y -> float in fac1
asmsub FREADSA (byte value @ A) -> clobbers(A,X,Y) -> () = $bc3c ; 8 bit signed A -> float in fac1
asmsub FREADSTR (ubyte length @ A) -> clobbers(A,X,Y) -> () = $b7b5 ; str -> fac1, $22/23 must point to string, A=string length
asmsub FPRINTLN () -> clobbers(A,X,Y) -> () = $aabc ; print string of fac1, on one line (= with newline) destroys fac1. (consider FOUT + STROUT as well)
asmsub FOUT () -> clobbers(X) -> (uword @ AY) = $bddd ; fac1 -> string, address returned in AY ($0100)
asmsub FADDH () -> clobbers(A,X,Y) -> () = $b849 ; fac1 += 0.5, for rounding- call this before INT
asmsub MUL10 () -> clobbers(A,X,Y) -> () = $bae2 ; fac1 *= 10
asmsub DIV10 () -> clobbers(A,X,Y) -> () = $bafe ; fac1 /= 10 , CAUTION: result is always positive!
asmsub FCOMP (uword mflpt @ AY) -> clobbers(X,Y) -> (ubyte @ A) = $bc5b ; A = compare fac1 to mflpt in A/Y, 0=equal 1=fac1 is greater, 255=fac1 is less than
asmsub FADDT () -> clobbers(A,X,Y) -> () = $b86a ; fac1 += fac2
asmsub FADD (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $b867 ; fac1 += mflpt value from A/Y
asmsub FSUBT () -> clobbers(A,X,Y) -> () = $b853 ; fac1 = fac2-fac1 mind the order of the operands
asmsub FSUB (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $b850 ; fac1 = mflpt from A/Y - fac1
asmsub FMULTT () -> clobbers(A,X,Y) -> () = $ba2b ; fac1 *= fac2
asmsub FMULT (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $ba28 ; fac1 *= mflpt value from A/Y
asmsub FDIVT () -> clobbers(A,X,Y) -> () = $bb12 ; fac1 = fac2/fac1 (remainder in fac2) mind the order of the operands
asmsub FDIV (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $bb0f ; fac1 = mflpt in A/Y / fac1 (remainder in fac2)
asmsub FPWRT () -> clobbers(A,X,Y) -> () = $bf7b ; fac1 = fac2 ** fac1
asmsub FPWR (uword mflpt @ AY) -> clobbers(A,X,Y) -> () = $bf78 ; fac1 = fac2 ** mflpt from A/Y
asmsub NOTOP () -> clobbers(A,X,Y) -> () = $aed4 ; fac1 = NOT(fac1)
asmsub INT () -> clobbers(A,X,Y) -> () = $bccc ; INT() truncates, use FADDH first to round instead of trunc
asmsub LOG () -> clobbers(A,X,Y) -> () = $b9ea ; fac1 = LN(fac1) (natural log)
asmsub SGN () -> clobbers(A,X,Y) -> () = $bc39 ; fac1 = SGN(fac1), result of SIGN (-1, 0 or 1)
asmsub SIGN () -> clobbers() -> (ubyte @ A) = $bc2b ; SIGN(fac1) to A, $ff, $0, $1 for negative, zero, positive
asmsub ABS () -> clobbers() -> () = $bc58 ; fac1 = ABS(fac1)
asmsub SQR () -> clobbers(A,X,Y) -> () = $bf71 ; fac1 = SQRT(fac1)
asmsub SQRA () -> clobbers(A,X,Y) -> () = $bf74 ; fac1 = SQRT(fac2)
asmsub EXP () -> clobbers(A,X,Y) -> () = $bfed ; fac1 = EXP(fac1) (e ** fac1)
asmsub NEGOP () -> clobbers(A) -> () = $bfb4 ; switch the sign of fac1
asmsub RND () -> clobbers(A,X,Y) -> () = $e097 ; fac1 = RND(fac1) float random number generator
asmsub COS () -> clobbers(A,X,Y) -> () = $e264 ; fac1 = COS(fac1)
asmsub SIN () -> clobbers(A,X,Y) -> () = $e26b ; fac1 = SIN(fac1)
asmsub TAN () -> clobbers(A,X,Y) -> () = $e2b4 ; fac1 = TAN(fac1)
asmsub ATN () -> clobbers(A,X,Y) -> () = $e30e ; fac1 = ATN(fac1)
; ---- C64 basic routines ----
asmsub CLEARSCR () -> clobbers(A,X,Y) -> () = $E544 ; clear the screen
@ -240,7 +149,6 @@ asmsub HOMECRSR () -> clobbers(A,X,Y) -> () = $E566 ; cursor to top left of sc
; ---- end of C64 basic routines ----
; ---- C64 kernal routines ----
asmsub STROUT (uword strptr @ AY) -> clobbers(A, X, Y) -> () = $AB1E ; print null-terminated string (a bit slow, see if you can use c64scr.print_string instead)

152
prog8lib/c64utils.p8
View File

@ -217,6 +217,11 @@ asmsub uword2decimal (uword value @ AY) -> clobbers(A,X,Y) -> () {
; result += digitvalue
; return result
asmsub c64flt_FREADSTR (ubyte length @ A) -> clobbers(A,X,Y) -> () = $b7b5 ; @todo needed for (slow) str conversion below
asmsub c64flt_GETADR () -> clobbers(X) -> (ubyte @ Y, ubyte @ A) = $b7f7 ; @todo needed for (slow) str conversion below
asmsub c64flt_FTOSWORDYA () -> clobbers(X) -> (ubyte @ Y, ubyte @ A) = $b1aa ; @todo needed for (slow) str conversion below
asmsub str2uword(str string @ AY) -> clobbers() -> (uword @ AY) {
%asm {{
;-- convert string (address in A/Y) to uword number in A/Y
@ -226,8 +231,8 @@ asmsub str2uword(str string @ AY) -> clobbers() -> (uword @ AY) {
jsr _strlen2233
tya
stx c64.SCRATCH_ZPREGX
jsr c64.FREADSTR ; string to fac1
jsr c64.GETADR ; fac1 to unsigned word in Y/A
jsr c64flt_FREADSTR ; string to fac1
jsr c64flt_GETADR ; fac1 to unsigned word in Y/A
ldx c64.SCRATCH_ZPREGX
sta c64.SCRATCH_ZPREG
tya
@ -254,8 +259,8 @@ asmsub str2word(str string @ AY) -> clobbers() -> (word @ AY) {
jsr str2uword._strlen2233
tya
stx c64.SCRATCH_ZPREGX
jsr c64.FREADSTR ; string to fac1
jsr c64.FTOSWORDYA ; fac1 to unsigned word in Y/A
jsr c64flt_FREADSTR ; string to fac1
jsr c64flt_FTOSWORDYA ; fac1 to unsigned word in Y/A
ldx c64.SCRATCH_ZPREGX
sta c64.SCRATCH_ZPREG
tya
@ -526,145 +531,6 @@ _raster_irq_handler
} ; ------ end of block c64utils
~ c64flt {
; ---- this block contains C-64 floating point related functions ----
; @todo move to c64fp.p8 and enable float-checkin astchecker.process(decl: VarDecl) again
const float PI = 3.141592653589793
const float TWOPI = 6.283185307179586
asmsub FREADS32 () -> clobbers(A,X,Y) -> () {
; ---- fac1 = signed int32 from $62-$65 big endian (MSB FIRST)
%asm {{
lda $62
eor #$ff
asl a
lda #0
ldx #$a0
jmp $bc4f ; internal BASIC routine
}}
}
asmsub FREADUS32 () -> clobbers(A,X,Y) -> () {
; ---- fac1 = uint32 from $62-$65 big endian (MSB FIRST)
%asm {{
sec
lda #0
ldx #$a0
jmp $bc4f ; internal BASIC routine
}}
}
asmsub FREADS24AXY (ubyte lo @ A, ubyte mid @ X, ubyte hi @ Y) -> clobbers(A,X,Y) -> () {
; ---- fac1 = signed int24 (A/X/Y contain lo/mid/hi bytes)
; note: there is no FREADU24AXY (unsigned), use FREADUS32 instead.
%asm {{
sty $62
stx $63
sta $64
lda $62
eor #$FF
asl a
lda #0
sta $65
ldx #$98
jmp $bc4f ; internal BASIC routine
}}
}
asmsub GIVUAYFAY (uword value @ AY) -> clobbers(A,X,Y) -> () {
; ---- unsigned 16 bit word in A/Y (lo/hi) to fac1
%asm {{
sty $62
sta $63
ldx #$90
sec
jmp $bc49 ; internal BASIC routine
}}
}
asmsub GIVAYFAY (uword value @ AY) -> clobbers(A,X,Y) -> () {
; ---- signed 16 bit word in A/Y (lo/hi) to float in fac1
%asm {{
sta c64.SCRATCH_ZPREG
tya
ldy c64.SCRATCH_ZPREG
jmp c64.GIVAYF ; this uses the inverse order, Y/A
}}
}
asmsub FTOSWRDAY () -> clobbers(X) -> (uword @ AY) {
; ---- fac1 to signed word in A/Y
%asm {{
jsr c64.FTOSWORDYA ; note the inverse Y/A order
sta c64.SCRATCH_ZPREG
tya
ldy c64.SCRATCH_ZPREG
rts
}}
}
asmsub GETADRAY () -> clobbers(X) -> (uword @ AY) {
; ---- fac1 to unsigned word in A/Y
%asm {{
jsr c64.GETADR ; this uses the inverse order, Y/A
sta c64.SCRATCH_ZPB1
tya
ldy c64.SCRATCH_ZPB1
rts
}}
}
sub print_f (float value) {
; ---- prints the floating point value (without a newline) using basic rom routines.
; clobbers no registers.
; @todo version that takes A/Y pointer to float instead
%asm {{
pha
tya
pha
txa
pha
lda #<print_f_value
ldy #>print_f_value
jsr c64.MOVFM ; load float into fac1
jsr c64.FOUT ; fac1 to string in A/Y
jsr c64.STROUT ; print string in A/Y
pla
tax
pla
tay
pla
rts
}}
}
sub print_fln (float value) {
; ---- prints the floating point value (with a newline at the end) using basic rom routines
; clobbers no registers.
; @todo version that takes A/Y pointer to float instead
%asm {{
pha
tya
pha
txa
pha
lda #<print_fln_value
ldy #>print_fln_value
jsr c64.MOVFM ; load float into fac1
jsr c64.FPRINTLN ; print fac1 with newline
pla
tax
pla
tay
pla
rts
}}
}
} ; ------ end of block c64flt

1320
prog8lib/prog8lib.p8
View File

File diff suppressed because it is too large Load Diff