add sin/cos/tan/log

This commit is contained in:
~d6 2022-11-07 11:19:09 -05:00
parent a870fc533a
commit b4104e2c7d
2 changed files with 196 additions and 14 deletions

200
fix16.tal
View File

@ -54,6 +54,24 @@
( x/y = z = z'/256 )
( (x'/256)/(y'/256) = (x'*256 / y)/256 )
( z' = (x' * 256 / y)/256 )
( )
( trigonometry, etc: )
( - sin() and cos() are supported )
( - tan() is mostly supported )
( - tan(#0192) and tan(#04b6) throw an error )
( - a few tan() values are inaccurate due to range )
( + values "next to" pi/2 and 3pi/2 are affected )
( + tan(#0191) returns 127.996 not 227.785 )
( + tan(#0193) returns -127.996 not -292.189 )
( + etc. )
( - log() is supported )
( - log(0) throws an error )
( - log values farther from zero may be a bit inaccurate )
( useful macros )
%x16-is-non-neg { x16-minimum LTH2 }
%x16-is-neg { x16-maximum GTH2 }
%x16-emit-dec-digit { #30 ADD #18 DEO }
( useful constants )
( )
@ -74,6 +92,7 @@
%x16-minus-two { #7e00 } ( -2.0 )
%x16-pi/2 { #0192 } ( 1.57079... )
%x16-pi { #0324 } ( 3.14159... )
%x16-3pi/2 { #04b6 } ( 4.71239... )
%x16-pi*2 { #0648 } ( 6.28318... )
%x16-e { #02b8 } ( 2.71828... )
%x16-phi { #019e } ( 1.61803... )
@ -84,17 +103,11 @@
%x16-maximum { #7fff } ( 127.99609... )
%x16-max-whole { #7f00 } ( 127.0 )
( useful macros )
%x16-is-non-neg { x16-minimum LTH2 }
%x16-is-neg { x16-maximum GTH2 }
%x16-emit-dec { #30 ADD #18 DEO }
@x16-emit ( x* -> )
DUP2 #8000 EQU2 ,&is-min JCN
DUP2 #8000 GTH2 ,&is-neg JCN
SWP DUP #64 LTH ,&<100 JCN
#64 DIVk DUP x16-emit-dec MUL SUB ,&>=10 JMP
#64 DIVk DUP x16-emit-dec-digit MUL SUB ,&>=10 JMP
&is-min POP2
LIT "- #18 DEO LIT "1 #18 DEO LIT "2 #18 DEO LIT "8 #18 DEO
LIT ". #18 DEO LIT "0 #18 DEO LIT "0 #18 DEO LIT "0 #18 DEO
@ -102,16 +115,16 @@
&is-neg
LIT "- #18 DEO #ffff EOR2 INC2 ,x16-emit JMP
&<100 DUP #0a LTH ,&<10 JCN
&>=10 #0a DIVk DUP x16-emit-dec MUL SUB
&<10 x16-emit-dec
&>=10 #0a DIVk DUP x16-emit-dec-digit MUL SUB
&<10 x16-emit-dec-digit
LIT '. #18 DEO
( emit fractional part )
#00 SWP ( lo* )
#000a MUL2 #0100 DIV2k DUP2 NIP x16-emit-dec MUL2 SUB2
#000a MUL2 #0100 DIV2k DUP2 NIP x16-emit-dec MUL2 SUB2
#000a MUL2 #0100 DIV2k DUP2 NIP x16-emit-dec MUL2 SUB2
#000a MUL2 #0100 DIV2k DUP2 NIP x16-emit-dec-digit MUL2 SUB2
#000a MUL2 #0100 DIV2k DUP2 NIP x16-emit-dec-digit MUL2 SUB2
#000a MUL2 #0100 DIV2k DUP2 NIP x16-emit-dec-digit MUL2 SUB2
#000a MUL2 #0100 DIV2k STH2k MUL2 SUB2 #0080 LTH2 ,&no-round JCN INC2r
&no-round STH2r NIP x16-emit-dec JMP2r
&no-round STH2r NIP x16-emit-dec-digit JMP2r
( comparison between x and y. )
( - ff: x < y )
@ -185,3 +198,164 @@
@x16-remainder ( x* y* -> x%y* )
DIV2k MUL2 SUB2 JMP2r
@x16-cos ( x* -> cos(x)* )
x16-pi/2 ADD2 ,x16-sin JMP
@x16-sin ( x* -> sin(x)* )
x16-pi*2 STH2 ( x [2pi] )
DUP2 STH2kr ;x16-quotient JSR2 ( x x/2pi [2pi] )
STH2r ;x16-mul JSR2 SUB2 ( x' ; 0 <= x' < 2pi )
DUP2 x16-3pi/2 LTH2 ,&c1 JCN
( -sin(2pi - x) ) x16-pi*2 SWP2 SUB2 ,x16-sin-q JSR ;x16-negate JMP2
&c1 DUP2 x16-pi LTH2 ,&c2 JCN
( -sin(x - pi) ) x16-pi SUB2 ,x16-sin-q JSR ;x16-negate JMP2
&c2 DUP2 x16-pi/2 LTH2 ,&c3 JCN
( sin(pi - x) ) x16-pi SWP2 SUB2 ,x16-sin-q JMP
&c3
( sin(x) ) ,x16-sin-q JMP
( 0 <= x < 2pi )
@x16-sin-q ( x* -> sin(x) )
#10 SFT2 ;x16-sin-table ADD2 LDA2 JMP2r
@x16-sin-table
0000 0001 0002 0003 0004 0005 0006 0007 0008 0009 000a 000b 000c 000d 000e 000f
0010 0011 0012 0013 0014 0015 0016 0017 0018 0019 001a 001b 001c 001d 001e 001f
0020 0021 0022 0023 0024 0025 0026 0027 0028 0029 002a 002b 002c 002d 002e 002f
0030 0031 0032 0033 0034 0035 0036 0037 0038 0039 003a 003a 003b 003c 003d 003e
003f 0040 0041 0042 0043 0044 0045 0046 0047 0048 0049 004a 004b 004c 004d 004e
004f 0050 0051 0052 0053 0053 0054 0055 0056 0057 0058 0059 005a 005b 005c 005d
005e 005f 0060 0061 0061 0062 0063 0064 0065 0066 0067 0068 0069 006a 006b 006c
006c 006d 006e 006f 0070 0071 0072 0073 0074 0075 0075 0076 0077 0078 0079 007a
007b 007c 007c 007d 007e 007f 0080 0081 0082 0083 0083 0084 0085 0086 0087 0088
0089 0089 008a 008b 008c 008d 008e 008e 008f 0090 0091 0092 0093 0093 0094 0095
0096 0097 0097 0098 0099 009a 009b 009b 009c 009d 009e 009f 009f 00a0 00a1 00a2
00a2 00a3 00a4 00a5 00a6 00a6 00a7 00a8 00a9 00a9 00aa 00ab 00ac 00ac 00ad 00ae
00ae 00af 00b0 00b1 00b1 00b2 00b3 00b4 00b4 00b5 00b6 00b6 00b7 00b8 00b8 00b9
00ba 00bb 00bb 00bc 00bd 00bd 00be 00bf 00bf 00c0 00c1 00c1 00c2 00c3 00c3 00c4
00c4 00c5 00c6 00c6 00c7 00c8 00c8 00c9 00ca 00ca 00cb 00cb 00cc 00cd 00cd 00ce
00ce 00cf 00d0 00d0 00d1 00d1 00d2 00d2 00d3 00d4 00d4 00d5 00d5 00d6 00d6 00d7
00d7 00d8 00d8 00d9 00da 00da 00db 00db 00dc 00dc 00dd 00dd 00de 00de 00df 00df
00e0 00e0 00e1 00e1 00e2 00e2 00e2 00e3 00e3 00e4 00e4 00e5 00e5 00e6 00e6 00e7
00e7 00e7 00e8 00e8 00e9 00e9 00ea 00ea 00ea 00eb 00eb 00ec 00ec 00ec 00ed 00ed
00ed 00ee 00ee 00ef 00ef 00ef 00f0 00f0 00f0 00f1 00f1 00f1 00f2 00f2 00f2 00f3
00f3 00f3 00f4 00f4 00f4 00f4 00f5 00f5 00f5 00f6 00f6 00f6 00f6 00f7 00f7 00f7
00f8 00f8 00f8 00f8 00f8 00f9 00f9 00f9 00f9 00fa 00fa 00fa 00fa 00fb 00fb 00fb
00fb 00fb 00fb 00fc 00fc 00fc 00fc 00fc 00fd 00fd 00fd 00fd 00fd 00fd 00fd 00fe
00fe 00fe 00fe 00fe 00fe 00fe 00fe 00ff 00ff 00ff 00ff 00ff 00ff 00ff 00ff 00ff
00ff 00ff 00ff 0100 0100 0100 0100 0100 0100 0100 0100 0100 0100 0100 0100 0100
0100 0100 0100
@x16-tan ( x* -> tan(x)* )
x16-pi*2 STH2 ( x [2pi] )
DUP2 STH2kr ;x16-quotient JSR2 ( x x/2pi [2pi] )
STH2r ;x16-mul JSR2 SUB2 ( x' ; 0 <= x' < 2pi )
( tan(pi/2) = tan(3pi/2) = error )
DUP2 x16-3pi/2 EQU2 ,&error JCN
DUP2 x16-pi/2 EQU2 ,&error JCN
DUP2 x16-3pi/2 LTH2 ,&c1 JCN
( -tan(2pi - x) ) x16-pi*2 SWP2 SUB2 ,x16-tan-q JSR ;x16-negate JMP2
&c1 DUP2 x16-pi LTH2 ,&c2 JCN
( tan(x - pi) ) x16-pi SUB2 ,x16-tan-q JMP
&c2 DUP2 x16-pi/2 LTH2 ,&c3 JCN
( -tan(pi - x) ) x16-pi SWP2 SUB2 ,x16-tan-q JSR ;x16-negate JMP2
&c3
( tan(x) ) ,x16-tan-q JMP
&error #0000 DIV
( 0 <= x < 2pi )
@x16-tan-q ( x* -> sin(x) )
#10 SFT2 ;x16-tan-table ADD2 LDA2 JMP2r
@x16-tan-table
0000 0001 0002 0003 0004 0005 0006 0007 0008 0009 000a 000b 000c 000d 000e 000f
0010 0011 0012 0013 0014 0015 0016 0017 0018 0019 001a 001b 001c 001d 001e 001f
0020 0021 0022 0023 0024 0025 0026 0027 0028 0029 002a 002b 002c 002d 002f 0030
0031 0032 0033 0034 0035 0036 0037 0038 0039 003a 003b 003c 003d 003e 003f 0040
0041 0042 0044 0045 0046 0047 0048 0049 004a 004b 004c 004d 004e 004f 0051 0052
0053 0054 0055 0056 0057 0058 0059 005b 005c 005d 005e 005f 0060 0061 0062 0064
0065 0066 0067 0068 0069 006b 006c 006d 006e 006f 0071 0072 0073 0074 0075 0077
0078 0079 007a 007b 007d 007e 007f 0080 0082 0083 0084 0085 0087 0088 0089 008b
008c 008d 008e 0090 0091 0092 0094 0095 0096 0098 0099 009a 009c 009d 009f 00a0
00a1 00a3 00a4 00a6 00a7 00a8 00aa 00ab 00ad 00ae 00b0 00b1 00b3 00b4 00b6 00b7
00b9 00ba 00bc 00bd 00bf 00c0 00c2 00c4 00c5 00c7 00c8 00ca 00cc 00cd 00cf 00d1
00d2 00d4 00d6 00d7 00d9 00db 00dc 00de 00e0 00e2 00e4 00e5 00e7 00e9 00eb 00ed
00ee 00f0 00f2 00f4 00f6 00f8 00fa 00fc 00fe 0100 0102 0104 0106 0108 010a 010c
010e 0110 0113 0115 0117 0119 011b 011e 0120 0122 0124 0127 0129 012b 012e 0130
0133 0135 0137 013a 013c 013f 0142 0144 0147 0149 014c 014f 0152 0154 0157 015a
015d 0160 0162 0165 0168 016b 016e 0171 0175 0178 017b 017e 0181 0185 0188 018b
018f 0192 0196 0199 019d 01a0 01a4 01a8 01ac 01af 01b3 01b7 01bb 01bf 01c3 01c7
01cc 01d0 01d4 01d8 01dd 01e1 01e6 01eb 01ef 01f4 01f9 01fe 0203 0208 020d 0212
0218 021d 0223 0228 022e 0234 023a 0240 0246 024c 0252 0259 025f 0266 026d 0274
027b 0282 0289 0291 0299 02a0 02a8 02b1 02b9 02c1 02ca 02d3 02dc 02e5 02ef 02f9
0302 030d 0317 0322 032d 0338 0343 034f 035b 0368 0374 0382 038f 039d 03ab 03ba
03c9 03d9 03e9 03f9 040a 041c 042e 0441 0454 0468 047d 0492 04a9 04c0 04d8 04f1
050b 0526 0542 055f 057d 059d 05bf 05e1 0606 062c 0654 067e 06aa 06d9 070a 073e
0775 07af 07ed 082f 0876 08c1 0911 0967 09c4 0a28 0a95 0b0a 0b8b 0c17 0cb2 0d5d
0e1a 0eed 0fdb 10e8 121b 137d 1519 1700 1946 1c0c 1f80 23ed 29cc 31f5 3e13 51f2
7888 7fff 7fff
@x16-log ( x* -> log(x)* )
DUP2 #0000 GTH2 STH
DUP2 #8000 LTH2 STHr AND ,&0<x<128 JCN
( error ) #0000 DIV
&0<x<128 DUP2 #0800 GTH2 ,&8<x<128 JCN
( 0<x<=8 ) DUP2 #0200 GTH2 ,&2<x<=8 JCN
( 0<x<=2 ) ,x16-log-q JMP
&2<x<=8 DUP2 #0400 GTH2 ,&4<x<=8 JCN
( 2<x<=4 ) #0200 ;x16-div JSR2 ,x16-log-q JSR #00b1 ADD2 JMP2r
&4<x<=8 #0400 ;x16-div JSR2 ,x16-log-q JSR #0163 ADD2 JMP2r
&8<x<128 DUP2 #2000 GTH2 ,&32<x<128 JCN
( 8<x<=32 ) DUP2 #1000 GTH2 ,&16<x<=32 JCN
( 8<x<=16 ) #0800 ;x16-div JSR2 ,x16-log-q JSR #0214 ADD2 JMP2r
&16<x<=32 #1000 ;x16-div JSR2 ,x16-log-q JSR #02c6 ADD2 JMP2r
&32<x<128 DUP2 #4000 GTH2 ,&64<x<128 JCN
( 32<x<=64 ) #2000 ;x16-div JSR2 ,x16-log-q JSR #0377 ADD2 JMP2r
&64<x<128 #4000 ;x16-div JSR2 ,x16-log-q JSR #0429 ADD2 JMP2r
( 0 < x <= 2 )
@x16-log-q ( x* -> log(x)* )
#10 SFT2 ;x16-log-table ADD2 LDA2 JMP2r
( the first entry, i.e. log(0), is invalid and should not be used. )
( the last entry is log(2). )
@x16-log-table
8000 fa74 fb26 fb8e fbd7 fc10 fc3f fc67 fc89 fca7 fcc2 fcda fcf1 fd05 fd18 fd2a
fd3a fd4a fd58 fd66 fd73 fd80 fd8c fd97 fda2 fdac fdb7 fdc0 fdc9 fdd2 fddb fde4
fdec fdf4 fdfb fe03 fe0a fe11 fe18 fe1e fe25 fe2b fe31 fe37 fe3d fe43 fe49 fe4e
fe53 fe59 fe5e fe63 fe68 fe6d fe72 fe76 fe7b fe7f fe84 fe88 fe8d fe91 fe95 fe99
fe9d fea1 fea5 fea9 fead feb0 feb4 feb8 febb febf fec2 fec6 fec9 fecc fed0 fed3
fed6 fed9 fedd fee0 fee3 fee6 fee9 feec feef fef2 fef4 fef7 fefa fefd ff00 ff02
ff05 ff08 ff0a ff0d ff0f ff12 ff14 ff17 ff19 ff1c ff1e ff21 ff23 ff25 ff28 ff2a
ff2c ff2f ff31 ff33 ff35 ff38 ff3a ff3c ff3e ff40 ff42 ff44 ff46 ff48 ff4b ff4d
ff4f ff51 ff53 ff54 ff56 ff58 ff5a ff5c ff5e ff60 ff62 ff64 ff65 ff67 ff69 ff6b
ff6d ff6e ff70 ff72 ff74 ff75 ff77 ff79 ff7b ff7c ff7e ff80 ff81 ff83 ff84 ff86
ff88 ff89 ff8b ff8c ff8e ff90 ff91 ff93 ff94 ff96 ff97 ff99 ff9a ff9c ff9d ff9f
ffa0 ffa2 ffa3 ffa4 ffa6 ffa7 ffa9 ffaa ffab ffad ffae ffb0 ffb1 ffb2 ffb4 ffb5
ffb6 ffb8 ffb9 ffba ffbc ffbd ffbe ffc0 ffc1 ffc2 ffc3 ffc5 ffc6 ffc7 ffc8 ffca
ffcb ffcc ffcd ffcf ffd0 ffd1 ffd2 ffd3 ffd5 ffd6 ffd7 ffd8 ffd9 ffda ffdc ffdd
ffde ffdf ffe0 ffe1 ffe2 ffe3 ffe5 ffe6 ffe7 ffe8 ffe9 ffea ffeb ffec ffed ffee
ffef fff1 fff2 fff3 fff4 fff5 fff6 fff7 fff8 fff9 fffa fffb fffc fffd fffe ffff
0000 0001 0002 0003 0004 0005 0006 0007 0008 0009 000a 000b 000c 000d 000e 000f
0010 0010 0011 0012 0013 0014 0015 0016 0017 0018 0019 001a 001b 001b 001c 001d
001e 001f 0020 0021 0022 0023 0023 0024 0025 0026 0027 0028 0029 0029 002a 002b
002c 002d 002e 002f 002f 0030 0031 0032 0033 0033 0034 0035 0036 0037 0038 0038
0039 003a 003b 003c 003c 003d 003e 003f 003f 0040 0041 0042 0043 0043 0044 0045
0046 0046 0047 0048 0049 0049 004a 004b 004c 004c 004d 004e 004f 004f 0050 0051
0052 0052 0053 0054 0054 0055 0056 0057 0057 0058 0059 0059 005a 005b 005c 005c
005d 005e 005e 005f 0060 0060 0061 0062 0062 0063 0064 0064 0065 0066 0066 0067
0068 0068 0069 006a 006a 006b 006c 006c 006d 006e 006e 006f 0070 0070 0071 0072
0072 0073 0074 0074 0075 0075 0076 0077 0077 0078 0079 0079 007a 007a 007b 007c
007c 007d 007e 007e 007f 007f 0080 0081 0081 0082 0082 0083 0084 0084 0085 0085
0086 0087 0087 0088 0088 0089 0089 008a 008b 008b 008c 008c 008d 008e 008e 008f
008f 0090 0090 0091 0092 0092 0093 0093 0094 0094 0095 0095 0096 0097 0097 0098
0098 0099 0099 009a 009a 009b 009c 009c 009d 009d 009e 009e 009f 009f 00a0 00a0
00a1 00a1 00a2 00a3 00a3 00a4 00a4 00a5 00a5 00a6 00a6 00a7 00a7 00a8 00a8 00a9
00a9 00aa 00aa 00ab 00ab 00ac 00ac 00ad 00ad 00ae 00ae 00af 00af 00b0 00b0 00b1
00b1

View File

@ -64,6 +64,10 @@
;buf LDA LIT "> EQU ;test-x16-gt JCN2
;buf LDA LIT "{ EQU ;test-x16-lteq JCN2
;buf LDA LIT "} EQU ;test-x16-gteq JCN2
;buf LDA LIT "s EQU ;test-x16-sin JCN2
;buf LDA LIT "c EQU ;test-x16-cos JCN2
;buf LDA LIT "t EQU ;test-x16-tan JCN2
;buf LDA LIT "l EQU ;test-x16-log JCN2
LIT "? #18 DEO #0a #18 DEO ;reset JSR2 BRK
( set the interpreter to exit now )
@ -104,6 +108,10 @@
@test-x16-lteq #04 #01 ;x16-lteq ;test JMP2
@test-x16-gt #04 #01 ;x16-gt ;test JMP2
@test-x16-gteq #04 #01 ;x16-gteq ;test JMP2
@test-x16-sin #02 #02 ;x16-sin ;test JMP2
@test-x16-cos #02 #02 ;x16-cos ;test JMP2
@test-x16-tan #02 #02 ;x16-tan ;test JMP2
@test-x16-log #02 #02 ;x16-log ;test JMP2
( reads one byte from ASCII: "13" -> 0x13 )
@read-byte ( c0^ c1^ -> n^ )