6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-01-07 00:29:34 +00:00
Code Issues Projects Releases Wiki Activity

Fill out rest of SANE floating point functions

Browse Source
This commit is contained in:
David Schmenk 2024-07-17 12:52:37 -07:00
parent cae5cd110e
commit 5b4050d1d2
5 changed files with 481 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/lisp/minmax.lisp Normal file
View File

@ -0,0 +1,26 @@
(DEFINE
(MINL (LAMBDA (M L)
(COND ((NULL L), M)
((< M (CAR L), (MINL M (CDR L))))
(T, (MINL (CAR L) (CDR L)))
))
)
(MINLIST (LAMBDA (L)
(COND ((NULL L), NIL)
((ATOM L), L)
(T, (MINL (CAR L) (CDR L)))
))
)
(MAXL (LAMBDA (M L)
(COND ((NULL L), M)
((> M (CAR L), (MINL M (CDR L))))
(T, (MINL (CAR L) (CDR L)))
))
)
(MAXLIST (LAMBDA (L)
(COND ((NULL L), NIL)
((ATOM L), L)
(T, (MAXL (CAR L) (CDR L)))
))
)
)

40
src/lisp/s-expr.pla
View File

@ -65,6 +65,10 @@ var sym_list = NULL
var build_list = NULL
var eval_last = NULL
const MAX_PARAMS = 64
var param_vals[MAX_PARAMS] // In-flight evaluated argument values
var param_cnt
var sym_nil, sym_quote, sym_lambda, sym_cond, sym_set
res[t_elem] pred_true = 0, 0, BOOL_TRUE
@ -112,6 +116,9 @@ def sweep_used#0
sweep_expr(eval_last)
symptr = sym_list
while symptr
//
// Sweep symbol properties
//
if symptr=>apval
sweep_expr(symptr=>apval)
elsif symptr=>lambda
@ -125,6 +132,14 @@ def sweep_used#0
fin
symptr = symptr=>link
loop
if param_cnt
//
// Sweep in-flight lambda argument parameters
//
for i = 0 to param_cnt - 1
sweep_expr(param_vals[i])
next
fin
end
def collect_list(listhead, freehead)#2
@ -653,9 +668,7 @@ end
//
def enter_lambda(curl, expr, params)#2 // curl, expr
var args, arglist, pairlist
var paramvals[16]
byte paramcnt
var args, arglist, pairlist, parambase, i
if !expr or expr=>car <> sym_lambda
puts("Invalid LAMBDA expression: "); print_expr(expr); putln
@ -664,18 +677,18 @@ def enter_lambda(curl, expr, params)#2 // curl, expr
//
// Evaluate the parameters
//
paramcnt = 0
parambase = param_cnt
while params
paramvals[paramcnt] = eval_expr(params=>car)
params = params=>cdr
paramcnt++
if paramcnt > 15
param_vals[param_cnt] = eval_expr(params=>car)
params = params=>cdr
param_cnt++
if param_cnt > MAX_PARAMS
puts("Parameter overflow:"); print_expr(expr); putln
break
fin
loop
args = expr=>cdr=>car
paramcnt = 0
i = parambase
if curl == expr
//puts("Tail: "); print_expr(expr); putln
//
@ -683,10 +696,10 @@ def enter_lambda(curl, expr, params)#2 // curl, expr
//
arglist = assoc_list
while args
arglist=>car=>cdr = paramvals[paramcnt]
arglist=>car=>cdr = param_vals[i]
arglist = arglist=>cdr
args = args=>cdr
paramcnt++
i++
loop
else
//puts("Enter: "); print_expr(expr); putln
@ -707,15 +720,16 @@ def enter_lambda(curl, expr, params)#2 // curl, expr
fin
pairlist=>car = new_cons
pairlist=>car=>car = args=>car
pairlist=>car=>cdr = paramvals[paramcnt]
pairlist=>car=>cdr = param_vals[i]
args = args=>cdr
paramcnt++
i++
loop
if arglist
pairlist=>cdr = assoc_list
assoc_list = arglist
fin
fin
param_cnt = parambase
//print_expr(assoc_list); putln; getc
return expr, expr=>cdr=>cdr=>car
end

448
src/lisp/s-math.pla
View File

@ -57,7 +57,7 @@ def eval_num(expr)
var result
result = eval_expr(expr=>car)
if result and (result->type & TYPE_MASK == NUM_TYPE)
if result and result->type & TYPE_MASK == NUM_TYPE
return result
fin
puts("Evaluated not an number type: "); print_expr(expr=>car); putln
@ -82,7 +82,7 @@ def push_int32(intptr)#0
var[2] int
byte isneg
isneg = FALSE
isneg = FALSE
if intptr=>[1] < 0
load32(intptr)
isneg = TRUE
@ -148,13 +148,14 @@ def natv_add(symptr, expr)
push_int32(@intsum)
push_num(num)
fpu:addXY()
fpu:pullExt(@extsum)
while expr
num = eval_num(expr)
push_num(num)
push_num(eval_num(expr))
fpu:pushExt(@extsum)
fpu:addXY()
fpu:pullExt(@extsum)
expr = expr=>cdr
loop
fpu:pullExt(@extsum)
return new_float(@extsum)
fin
return new_int(intsum[0], intsum[1])
@ -245,21 +246,40 @@ def natv_neg(symptr, expr)
var[5] ext
num = eval_num(expr)
if num=>type == NUM_INT
if num->type == NUM_INT
load32(num + intval)
neg32
store32(@neg)
return new_int(neg[0], neg[1])
fin
push_num(num)
fpu:negX()
fpu:pullExt(@ext)
return new_float(@ext)
num->floatval[9] = num->floatval[9] ^ $80 // Fun with float bits
return new_float(num + floatval)
end
def natv_abs(symptr, expr)
var num
var[2] abs
var[5] ext
num = eval_num(expr)
if num->type == NUM_INT
if num=>intval[1] < 0
load32(num + intval)
neg32
store32(@abs)
else
abs[0] = num=>intval[0]
abs[1] = num=>intval[1]
fin
return new_int(abs[0], abs[1])
fin
num->floatval[9] = num->floatval[9] & $7F // Fun with float bits
return new_float(num + floatval)
end
def natv_gt(symptr, expr)
res[t_numfloat] num1, num2
var[5] ext
byte[10] ext
memcpy(@num1, eval_num(expr), t_numfloat)
memcpy(@num2, eval_num(expr=>cdr), t_numfloat)
@ -271,12 +291,12 @@ def natv_gt(symptr, expr)
push_num(@num1)
fpu:subXY()
fpu:pullExt(@ext)
return bool_pred(ext[4] < 0)
return bool_pred(ext[9] & $80) // Check sign bit
end
def natv_lt(symptr, expr)
res[t_numfloat] num1, num2
var[5] ext
byte[10] ext
memcpy(@num1, eval_num(expr), t_numfloat)
memcpy(@num2, eval_num(expr=>cdr), t_numfloat)
@ -288,21 +308,405 @@ def natv_lt(symptr, expr)
push_num(@num2)
fpu:subXY()
fpu:pullExt(@ext)
return bool_pred(ext[4] < 0)
return bool_pred(ext[9] & $80) // Check sign bit
end
def natv_min(symptr, expr)
var num
var[2] intmin
var[5] extmin, ext
num = eval_num(expr)
expr = expr=>cdr
if num->type == NUM_INT
//
// Find min as integers unless a float is encountered
//
intmin[0] = num=>intval[0]
intmin[1] = num=>intval[1]
while expr
num = eval_num(expr)
if num->type == NUM_FLOAT
push_int32(@intmin)
fpu:pullExt(@extmin)
break
fin
load32(@intmin)
if isgt32(num + intval)
intmin[0] = num=>intval[0]
intmin[1] = num=>intval[1]
fin
expr = expr=>cdr
loop
if !expr; return new_int(intmin[0], intmin[1]); fin
else
extmin[0] = num=>floatval[0]
extmin[1] = num=>floatval[1]
extmin[2] = num=>floatval[2]
extmin[3] = num=>floatval[3]
extmin[4] = num=>floatval[4]
if expr; num = eval_num(expr); fin
fin
while expr
push_num(num)
fpu:pushExt(@extmin)
fpu:subXY()
fpu:pullExt(@ext)
if ext[4] < 0
if num->type == NUM_INT
push_int32(num + intval)
fpu:pullExt(@ext)
extmin[0] = ext[0]
extmin[1] = ext[1]
extmin[2] = ext[2]
extmin[3] = ext[3]
extmin[4] = ext[4]
else
extmin[0] = num=>floatval[0]
extmin[1] = num=>floatval[1]
extmin[2] = num=>floatval[2]
extmin[3] = num=>floatval[3]
extmin[4] = num=>floatval[4]
fin
fin
expr = expr=>cdr
if expr; num = eval_num(expr); fin
loop
return new_float(@extmin)
end
def natv_max(symptr, expr)
var num
var[2] intmax
var[5] extmax, ext
num = eval_num(expr)
expr = expr=>cdr
if num->type == NUM_INT
//
// Find max as integers unless a float is encountered
//
intmax[0] = num=>intval[0]
intmax[1] = num=>intval[1]
while expr
num = eval_num(expr)
if num->type == NUM_FLOAT
push_int32(@intmax)
fpu:pullExt(@extmax)
break
fin
load32(@intmax)
if islt32(num + intval)
intmax[0] = num=>intval[0]
intmax[1] = num=>intval[1]
fin
expr = expr=>cdr
loop
if !expr; return new_int(intmax[0], intmax[1]); fin
else
extmax[0] = num=>floatval[0]
extmax[1] = num=>floatval[1]
extmax[2] = num=>floatval[2]
extmax[3] = num=>floatval[3]
extmax[4] = num=>floatval[4]
if expr; num = eval_num(expr); fin
fin
while expr
fpu:pushExt(@extmax)
push_num(num)
fpu:subXY()
fpu:pullExt(@ext)
if ext[4] < 0
if num->type == NUM_INT
push_int32(num + intval)
fpu:pullExt(@ext)
extmax[0] = ext[0]
extmax[1] = ext[1]
extmax[2] = ext[2]
extmax[3] = ext[3]
extmax[4] = ext[4]
else
extmax[0] = num=>floatval[0]
extmax[1] = num=>floatval[1]
extmax[2] = num=>floatval[2]
extmax[3] = num=>floatval[3]
extmax[4] = num=>floatval[4]
fin
fin
expr = expr=>cdr
if expr; num = eval_num(expr); fin
loop
return new_float(@extmax)
end
def natv_pi(symptr, expr)
var[5] ext
fpu:constPi()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_e(symptr, expr)
var[5] ext
fpu:constE()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_logb(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:logbX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_scalebI(symptr, expr)
var[5] ext
push_num(eval_num(expr))
push_int32(eval_expr(expr=>cdr) + intval)
fpu:scalebXInt()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_trunc(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:truncX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_round(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:roundX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_sqrt(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:sqrtX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_cos(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:cosX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_sin(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:sinX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_tan(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:tanX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_atan(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:atanX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_log2(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:log2X()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_log21(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:log21X()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_ln(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:lnX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_ln1(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:ln1X()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_pow2(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:pow2X()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_pow21(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:pow21X()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_powE(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:powEX()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_powE1(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:powE1X()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_powE21(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:powE21X()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_powI(symptr, expr)
var[5] ext
push_num(eval_num(expr))
push_int32(eval_int(expr=>cdr) + intval)
fpu:powXInt()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_powY(symptr, expr)
var[5] ext
push_num(eval_num(expr))
push_num(eval_num(expr=>cdr))
fpu:pow2X()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_compY(symptr, expr)
var[5] ext
push_num(eval_num(expr))
push_num(eval_num(expr=>cdr))
fpu:pow2X()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_annuityY(symptr, expr)
var[5] ext
push_num(eval_num(expr))
push_num(eval_num(expr=>cdr))
fpu:annuityXY()
fpu:pullExt(@ext)
return new_float(@ext)
end
def natv_randNum(symptr, expr)
var[5] ext
push_num(eval_num(expr))
fpu:randNum()
fpu:pullExt(@ext)
return new_float(@ext)
end
//
// Install math functions
//
new_sym("+")=>natv = @natv_add
new_sym("-")=>natv = @natv_sub
new_sym("*")=>natv = @natv_mul
new_sym("/")=>natv = @natv_div
new_sym("REM")=>natv = @natv_rem
new_sym("NEG")=>natv = @natv_neg
new_sym(">")=>natv = @natv_gt
new_sym("<")=>natv = @natv_lt
new_sym("+")=>natv = @natv_add
new_sym("-")=>natv = @natv_sub
new_sym("*")=>natv = @natv_mul
new_sym("/")=>natv = @natv_div
new_sym("REM")=>natv = @natv_rem
new_sym("NEG")=>natv = @natv_neg
new_sym("ABS")=>natv = @natv_abs
new_sym(">")=>natv = @natv_gt
new_sym("<")=>natv = @natv_lt
new_sym("MIN")=>natv = @natv_min
new_sym("MAX")=>natv = @natv_max
new_sym("PI")=>natv = @natv_pi
new_sym("MATH_E")=>natv = @natv_e
new_sym("LOGB")=>natv = @natv_logb
new_sym("SCALEB_I")=>natv = @natv_scalebI
new_sym("TRUNCATE")=>natv = @natv_trunc
new_sym("ROUND")=>natv = @natv_round
new_sym("SQRT")=>natv = @natv_sqrt
new_sym("COS")=>natv = @natv_cos
new_sym("SIN")=>natv = @natv_sin
new_sym("TAN")=>natv = @natv_tan
new_sym("ATAN")=>natv = @natv_atan
new_sym("LOG2")=>natv = @natv_log2
new_sym("LOG2_1")=>natv = @natv_log21
new_sym("LN")=>natv = @natv_ln
new_sym("LN_1")=>natv = @natv_ln1
new_sym("POW2")=>natv = @natv_pow2
new_sym("POW2_1")=>natv = @natv_pow21
new_sym("POWE")=>natv = @natv_powE
new_sym("POWE_1")=>natv = @natv_powE1
new_sym("POWE2_1")=>natv = @natv_powE21
new_sym("POW_I")=>natv = @natv_powI
new_sym("POWY")=>natv = @natv_powY
new_sym("COMP")=>natv = @natv_compY
new_sym("ANNUITY")=>natv = @natv_annuityY
new_sym("RANDOM")=>natv = @natv_randNum
fpu:reset()
return modkeep | modinitkeep
done

1
src/mklisp
View File

@ -26,4 +26,5 @@ cat lisp/maplist.lisp | ./ac.jar -ptx DRAWL.po lisp/MAPLIST.LISP TX
cat lisp/gcd.lisp | ./ac.jar -ptx DRAWL.po lisp/GCD.LISP TXT
cat lisp/fact.lisp | ./ac.jar -ptx DRAWL.po lisp/FACT.LISP TXT
cat lisp/loop.lisp | ./ac.jar -ptx DRAWL.po lisp/LOOP.LISP TXT
cat lisp/minmax.lisp | ./ac.jar -ptx DRAWL.po lisp/MINMAX.LISP TXT
cat lisp/prog.lisp | ./ac.jar -ptx DRAWL.po lisp/PROG.LISP TXT

1
src/mkrel
View File

@ -186,6 +186,7 @@ cp lisp/maplist.lisp prodos/bld/lisp/MAPLIST.LISP.TXT
cp lisp/gcd.lisp prodos/bld/lisp/GCD.LISP.TXT
cp lisp/fact.lisp prodos/bld/lisp/FACT.LISP.TXT
cp lisp/loop.lisp prodos/bld/lisp/LOOP.LISP.TXT
cp lisp/minmax.lisp prodos/bld/lisp/MINMAX.LISP.TXT
cp lisp/prog.lisp prodos/bld/lisp/PROG.LISP.TXT
#mkdir prodos/bld/examples