more issues, more fixes

This commit is contained in:
~d6 2023-11-05 22:44:17 -05:00
parent 2392745f6f
commit f8fbae1af1
1 changed files with 28 additions and 49 deletions

View File

@ -30,8 +30,8 @@
( ) ( )
( due to the limited range operations saturate at the ) ( due to the limited range operations saturate at the )
( terminal values (i.e. #7fff and #8001). #8000 should ) ( terminal values (i.e. #7fff and #8001). #8000 should )
( never be generated, and can be considered a Nan value ) ( never be generated through valid arithmetic, and can be )
( although this library does not use it as such. ) ( considered an error if present. )
( ) ( )
( many 8.8 operations are equivalent to unsigned int16: ) ( many 8.8 operations are equivalent to unsigned int16: )
( * addition ) ( * addition )
@ -113,21 +113,20 @@
%x16-pi/2 { #0192 } ( 1.57079... ) %x16-pi/2 { #0192 } ( 1.57079... )
%x16-pi { #0324 } ( 3.14159... ) %x16-pi { #0324 } ( 3.14159... )
%x16-3pi/2 { #04b6 } ( 4.71239... ) %x16-3pi/2 { #04b6 } ( 4.71239... )
%x16-pi*2 { #0648 } ( 6.28318... ) %x16-2pi { #0648 } ( 6.28318... )
%x16-e { #02b8 } ( 2.71828... ) %x16-e { #02b8 } ( 2.71828... )
%x16-phi { #019e } ( 1.61803... ) %x16-phi { #019e } ( 1.61803... )
%x16-sqrt-2 { #016a } ( 1.41421... ) %x16-sqrt-2 { #016a } ( 1.41421... )
%x16-sqrt-3 { #01bb } ( 1.73205... ) %x16-sqrt-3 { #01bb } ( 1.73205... )
%x16-epsilon { #0001 } ( 0.00390... ) %x16-epsilon { #0001 } ( 0.00390... )
%x16-minimum { #8000 } ( -128.0 ) %x16-minimum { #8001 } ( -127.99609... )
%x16-maximum { #7fff } ( 127.99609... ) %x16-maximum { #7fff } ( 127.99609... )
%x16-max-whole { #7f00 } ( 127.0 ) %x16-error { #8000 } ( not a number )
( utils ) ( utils )
@x16-is-non-neg ( x* -> bool^ ) x16-minimum LTH2 JMP2r @x16-is-non-neg ( x* -> bool^ ) x16-minimum LTH2 JMP2r
@x16-is-neg ( x* -> bool^ ) x16-maximum GTH2 JMP2r @x16-is-neg ( x* -> bool^ ) x16-maximum GTH2 JMP2r
@x16-emit-dec-digit ( d^ -> ) #30 ADD #18 DEO JMP2r @x16-emit-dec-digit ( d^ -> ) #30 ADD #18 DEO JMP2r
@error [ #0000 DIV ]
@x16-emit ( x* -> ) @x16-emit ( x* -> )
DUP2 #8000 EQU2 ?&is-min DUP2 #8000 EQU2 ?&is-min
@ -287,9 +286,10 @@
@x16-from-s16 ( n* -> x* ) @x16-from-s16 ( n* -> x* )
DUP2 #ff80 GTH2 ?&neg DUP2 #ff80 GTH2 ?&neg
DUP2 #007f GTH2 ?error DUP2 #007f GTH2 ?&error
NIP #00 SWP JMP2r NIP #00 SWP JMP2r
&neg NIP #ff SWP JMP2r &neg NIP #ff SWP JMP2r
&error POP2 #8000 JMP2r
( 1.5 -> 1, 0.5 -> 0, -1.5 -> -1 ) ( 1.5 -> 1, 0.5 -> 0, -1.5 -> -1 )
@x16-to-s16 ( x* -> whole* ) @x16-to-s16 ( x* -> whole* )
@ -343,32 +343,23 @@
POP2r POP2r NIP2 JMP2r ( s1* ) POP2r POP2r NIP2 JMP2r ( s1* )
@x16-unit-circle ( x* -> x'* ) @x16-unit-circle ( x* -> x'* )
x16-pi*2 STH2 ( x [2pi] ) x16-2pi STH2 ( x* [2pi*] )
DUP2 STH2kr x16-quotient ( x x/2pi [2pi] ) DUP2 STH2kr x16-quotient ( x* x/2pi* [2pi*] )
DUP2 #1400 DIV2 STH2 SWP2r ( x x/2pi [adj* 2pi*] ) DUP2 #1400 DIV2 STH2 SWP2r ( x* x/2pi* [adj* 2pi*] )
STH2r x16-mul STH2r ADD2 SUB2 ( x' ; 0 <= x' < 2pi ) STH2r x16-mul SUB2 ( x-x/2pi* [adj*] )
JMP2r STH2r LTH2k ?{ SUB2 JMP2r } ( x'* ; 0 <= x' < 2pi )
POP2 POP2 #0000 JMP2r ( x'* ; 0 <= x' < 2pi )
@x16-cos ( x* -> cos[x]* ) @x16-cos ( x* -> cos[x]* )
x16-unit-circle x16-pi/2 ADD2 ( fall-through ) x16-unit-circle x16-pi/2 ADD2 ( fall-through )
@x16-sin ( x* -> sin[x]* ) @x16-sin ( x* -> sin[x]* )
DUP2 #8000 LTH2 ?&non-negative DUP2 #8000 LTH2 ?&positive x16-negate x16-sin/positive !x16-negate
x16-negate x16-sin/non-negative !x16-negate &positive x16-unit-circle
&non-negative DUP2 x16-3pi/2 LTH2 ?{ x16-2pi SWP2 SUB2 x16-sin/q !x16-negate }
x16-unit-circle DUP2 x16-pi LTH2 ?{ x16-pi SUB2 x16-sin/q !x16-negate }
DUP2 x16-3pi/2 LTH2 ?&c1 DUP2 x16-pi/2 LTH2 ?{ x16-pi SWP2 SUB2 }
( -sin(2pi - x) ) x16-pi*2 SWP2 SUB2 x16-sin-q !x16-negate &q DUP2 ADD2 ;x16-sin-table ADD2 LDA2 JMP2r
&c1 DUP2 x16-pi LTH2 ?&c2
( -sin(x - pi) ) x16-pi SUB2 x16-sin-q !x16-negate
&c2 DUP2 x16-pi/2 LTH2 ?&c3
( sin(pi - x) ) x16-pi SWP2 SUB2 !x16-sin-q
&c3
( sin[x] ) ( fall-thru )
( 0 <= x < 2pi )
@x16-sin-q ( x* -> sin[x] )
DUP2 ADD2 ;x16-sin-table ADD2 LDA2 JMP2r
@x16-sin-table @x16-sin-table
0000 0001 0002 0003 0004 0005 0006 0007 0008 0009 000a 000b 000c 000d 000e 000f 0000 0001 0002 0003 0004 0005 0006 0007 0008 0009 000a 000b 000c 000d 000e 000f
@ -399,27 +390,15 @@
0100 0100 0100 0100 0100 0100
@x16-tan ( x* -> tan[x]* ) @x16-tan ( x* -> tan[x]* )
x16-pi*2 STH2 ( x [2pi] ) x16-unit-circle
DUP2 STH2kr x16-quotient ( x x/2pi [2pi] )
DUP2 #1400 DIV2 STH2 SWP2r ( x x/2pi [adj* 2pi*] )
STH2r x16-mul STH2r ADD2 SUB2 ( x' ; 0 <= x' < 2pi )
( tan(pi/2) = tan(3pi/2) = error ) ( tan(pi/2) = tan(3pi/2) = error )
DUP2 x16-3pi/2 EQU2 ?error DUP2 x16-3pi/2 EQU2 ?&error
DUP2 x16-pi/2 EQU2 ?error DUP2 x16-pi/2 EQU2 ?&error
DUP2 x16-3pi/2 LTH2 ?{ x16-2pi SWP2 SUB2 x16-tan/q !x16-negate }
DUP2 x16-3pi/2 LTH2 ?&c1 DUP2 x16-pi LTH2 ?{ x16-pi SUB2 !x16-tan/q }
( -tan(2pi - x) ) x16-pi*2 SWP2 SUB2 x16-tan-q !x16-negate DUP2 x16-pi/2 LTH2 ?{ x16-pi SWP2 SUB2 x16-tan/q !x16-negate }
&c1 DUP2 x16-pi LTH2 ?&c2 &q DUP2 ADD2 ;x16-tan-table ADD2 LDA2 JMP2r
( tan(x - pi) ) x16-pi SUB2 !x16-tan-q &error POP2 #8000 JMP2r
&c2 DUP2 x16-pi/2 LTH2 ?&c3
( -tan(pi - x) ) x16-pi SWP2 SUB2 x16-tan-q !x16-negate
&c3
( tan[x] ) ( fall-thru )
( 0 <= x < 2pi )
@x16-tan-q ( x* -> sin[x] )
DUP2 ADD2 ;x16-tan-table ADD2 LDA2 JMP2r
@x16-tan-table @x16-tan-table
0000 0001 0002 0003 0004 0005 0006 0007 0008 0009 000a 000b 000c 000d 000e 000f 0000 0001 0002 0003 0004 0005 0006 0007 0008 0009 000a 000b 000c 000d 000e 000f
@ -453,7 +432,7 @@
[ DUP2 #0000 GTH2 ] STH [ DUP2 #0000 GTH2 ] STH
[ DUP2 #8000 LTH2 ] STHr AND ?&0<x<128 [ DUP2 #8000 LTH2 ] STHr AND ?&0<x<128
( error ) !error ( error ) POP2 #8000 JMP2r ( error )
&0<x<128 DUP2 #0800 GTH2 ?&8<x<128 &0<x<128 DUP2 #0800 GTH2 ?&8<x<128
( 0<x<=8 ) DUP2 #0200 GTH2 ?&2<x<=8 ( 0<x<=8 ) DUP2 #0200 GTH2 ?&2<x<=8