d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

use immediate opcodes, use uxnlin, etc.

This commit is contained in:
~d6 2023-04-06 22:08:05 -04:00
parent a22f9877fe
commit 1050d280f1
1 changed files with 98 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

183
fix16.tal
View File

@ -88,11 +88,6 @@
( with a fractional part of 0.5, they will )
( round towards the nearest even value. )
( 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 )
( )
( to generate your own: )
@ -123,55 +118,64 @@
%x16-maximum { #7fff } ( 127.99609... )
%x16-max-whole { #7f00 } ( 127.0 )
( utils )
@x16-is-non-neg ( x* -> bool^ ) x16-minimum LTH2 JMP2r
@x16-is-neg ( x* -> bool^ ) x16-maximum GTH2 JMP2r
@x16-emit-dec-digit ( d^ -> ) #30 ADD #18 DEO JMP2r
@error [ #0000 DIV ]
@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-digit MUL SUB ,&>=10 JMP
DUP2 #8000 EQU2 ?&is-min
DUP2 #8000 GTH2 ?&is-neg
SWP DUP #64 LTH ?&<100
#64 DIVk DUP x16-emit-dec-digit MUL SUB !&>=10
&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
[ 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 ]
JMP2r
&is-neg
LIT "- #18 DEO #ffff EOR2 INC2 ,x16-emit JMP
&<100 DUP #0a LTH ,&<10 JCN
[ LIT "- #18 DEO ] #ffff EOR2 INC2 !x16-emit
&<100 DUP #0a LTH ?&<10
&>=10 #0a DIVk DUP x16-emit-dec-digit MUL SUB
&<10 x16-emit-dec-digit
LIT ". #18 DEO
[ LIT ". #18 DEO ]
( emit fractional part )
#00 SWP ( lo* )
#000a MUL2 #0100 DIV2k DUP x16-emit-dec-digit MUL2 SUB2
#000a MUL2 #0100 DIV2k DUP x16-emit-dec-digit MUL2 SUB2
#000a MUL2 #0100 DIV2k DUP 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-digit JMP2r
#000a MUL2 #0100 DIV2k STH2k MUL2 SUB2 #0080 LTH2 ?&no-round INC2r
&no-round STH2r NIP !x16-emit-dec-digit
( comparison between x and y. )
( - ff: x < y )
( - 00: x = y )
( - 01: x > y )
@x16-cmp ( x* y* -> c^ )
STH2k x16-is-neg ,&yn JCN ( x* [y*] ; ? )
DUP2 x16-is-non-neg ,&same JCN ( x* [y*] ; y>=0 )
( STH2k x16-is-neg ?&yn ( x* [y*] ; ? ) )
STH2k x16-maximum GTH2 ?&yn ( x* [y*] ; ? )
( DUP2 x16-is-non-neg ?&same ( x* [y*] ; y>=0 ) )
DUP2 x16-minimum LTH2 ?&same ( x* [y*] ; y>=0 )
POP2 POP2r #ff JMP2r ( -1 ; x<0 y>=0 )
&yn DUP2 x16-is-neg ,&same JCN ( x* [y*] ; y<0 )
( &yn DUP2 x16-is-neg ?&same ( x* [y*] ; y<0 ) )
&yn DUP2 x16-maximum GTH2 ?&same ( x* [y*] ; y<0 )
POP2 POP2r #01 JMP2r ( 1 ; x>=0 y<0 )
&same STH2r ;x16-ucmp JMP2 ( res ; x<0 y<0 b )
&same STH2r ( fall-thru ) ( res ; x<0 y<0 b )
( unsigned comparison between x and y. )
( - ff: x < y )
( - 00: x = y )
( - 01: x > y )
@x16-ucmp ( x* y* -> c^ )
LTH2k ,&lt JCN GTH2 JMP2r
LTH2k ?&lt GTH2 JMP2r
&lt POP2 POP2 #ff JMP2r
@x16-eq ( x* y* -> x=y^ ) EQU2 JMP2r
@x16-ne ( x* y* -> x!=0^ ) NEQ2 JMP2r
@x16-lt ( x* y* -> x<y^ ) ;x16-cmp JSR2 #ff EQU JMP2r
@x16-lteq ( x* y* -> x<y^ ) ;x16-cmp JSR2 #01 NEQ JMP2r
@x16-gt ( x* y* -> x<y^ ) ;x16-cmp JSR2 #01 EQU JMP2r
@x16-gteq ( x* y* -> x<y^ ) ;x16-cmp JSR2 #ff NEQ JMP2r
@x16-lt ( x* y* -> x<y^ ) x16-cmp #ff EQU JMP2r
@x16-lteq ( x* y* -> x<y^ ) x16-cmp #01 NEQ JMP2r
@x16-gt ( x* y* -> x<y^ ) x16-cmp #01 EQU JMP2r
@x16-gteq ( x* y* -> x<y^ ) x16-cmp [ #ff NEQ ] JMP2r
@x16-is-whole ( x* -> bool^ )
NIP #00 EQU JMP2r
@ -186,8 +190,8 @@
#0000 SWP2 SUB2 JMP2r
@x16-mul ( x* y* -> xy* )
DUP #00 EQU ,&rhs-whole JCN
SWP2 DUP #00 EQU ,&rhs-whole JCN
DUP #00 EQU ?&rhs-whole
SWP2 DUP #00 EQU ?&rhs-whole
,&y3 STR ,&y1 STR ,&x3 STR ,&x1 STR
LIT2 &x2 00 &x3 00 LIT2 &y2 00 &y3 00 MUL2 #08 SFT2
LIT2 &x0 00 &x1 00 ,&y2 LDR2 MUL2 ADD2
@ -203,12 +207,12 @@
STH2r LIT2r 0100 ( x%y y {0100 div} )
( we know x%y < y, so start right-shifting y )
&loop
DUP2 #0000 EQU2 ,&done JCN
ORAk #00 EQU ?&done
#01 SFT2 LITr 01 SFT2r ( rem yi {shifti div} )
LTH2k ,&loop JCN ( rem yi {shifti div} )
LTH2k ?&loop ( rem yi {shifti div} )
SWP2 OVR2 SUB2 SWP2 ( rem-yi yi {shifti div} )
DUP2r ROT2r ADD2r SWP2r ( rem-yi yi {shifti div+shifti} )
,&loop JMP ( rem-yi yi {shifti div+shifti} )
!&loop ( rem-yi yi {shifti div+shifti} )
&done
POP2 POP2 ( {shiftk div} )
POP2r STH2r JMP2r ( div )
@ -223,15 +227,14 @@
#00 JMP2r
@x16-from-s16 ( n* -> x* )
DUP2 #ff80 GTH2 ,&neg JCN
DUP2 #007f GTH2 ,&error JCN
DUP2 #ff80 GTH2 ?&neg
DUP2 #007f GTH2 ?error
NIP #00 SWP JMP2r
&neg NIP #ff SWP JMP2r
&error #0000 DIV
( 1.5 -> 1, 0.5 -> 0, -1.5 -> -1 )
@x16-to-s16 ( x* -> whole* )
DUP2 #7fff GTH2 ,&neg JCN ( x0 x1 )
DUP2 #7fff GTH2 ?&neg ( x0 x1 )
DUP EOR ( x0 00 )
SWP JMP2r ( 0 x0 )
&neg #00ff STHk ( x0 x1 00 ff [ff] )
@ -244,21 +247,22 @@
DUP2 #0f SFT2 #00ff MUL2 ADD2 POP JMP2r
( e.g. #0812 -> #0800 )
@x16-floor ( x* -> floor(x)* )
@x16-floor ( x* -> floor[x]* )
DUP EOR JMP2r
( e.g. #0812 -> #0900 )
@x16-ceil ( x* -> floor(x)* )
@x16-ceil ( x* -> floor[x]* )
#00ff ADD2 DUP EOR JMP2r
( round half-even, #0080 -> #0000, #0180 -> #0200 )
@x16-round ( x* -> round(x)* )
OVR #01 AND ,&odd JCN
( even ) #007f ,&rest JMP
@x16-round ( x* -> round[x]* )
OVR #01 AND ?&odd
( even ) #007f !&rest
&odd #0080
&rest ADD2 DUP EOR JMP2r
@x16-sqrt ( x* -> sqrt(x)* )
( use up to 256 iterations of heron's algorithm )
@x16-sqrt ( x* -> sqrt[x]* )
LIT2r ff00
LIT2r 0200 ( [c* 2*] )
DUP2 STH2kr x16-div ( x* s=x/2* [c* 2*] )
@ -275,26 +279,26 @@
&done ( x* s1* [c* 2*] )
POP2r POP2r NIP2 JMP2r ( s1* )
@x16-cos ( x* -> cos(x)* )
x16-pi/2 ADD2 ,x16-sin JMP
@x16-cos ( x* -> cos[x]* )
x16-pi/2 ADD2 ( fall-thru )
@x16-sin ( x* -> sin(x)* )
@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 STH2kr x16-quotient ( x x/2pi [2pi] )
STH2r x16-mul 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
DUP2 x16-3pi/2 LTH2 ?&c1
( -sin(2pi - x) ) x16-pi*2 SWP2 SUB2 x16-sin-q !x16-negate
&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) ) ,x16-sin-q JMP
( sin[x] ) ( fall-thru )
( 0 <= x < 2pi )
@x16-sin-q ( x* -> sin(x) )
#10 SFT2 ;x16-sin-table ADD2 LDA2 JMP2r
@x16-sin-q ( x* -> sin[x] )
DUP2 ADD2 ;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
@ -324,28 +328,27 @@
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-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 )
DUP2 STH2kr x16-quotient ( x x/2pi [2pi] )
STH2r x16-mul 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 EQU2 ?error
DUP2 x16-pi/2 EQU2 ?error
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
DUP2 x16-3pi/2 LTH2 ?&c1
( -tan(2pi - x) ) x16-pi*2 SWP2 SUB2 x16-tan-q !x16-negate
&c1 DUP2 x16-pi LTH2 ?&c2
( tan(x - pi) ) x16-pi SUB2 !x16-tan-q
&c2 DUP2 x16-pi/2 LTH2 ?&c3
( -tan(pi - x) ) x16-pi SWP2 SUB2 x16-tan-q !x16-negate
&c3
( tan(x) ) ,x16-tan-q JMP
&error #0000 DIV
( tan[x] ) ( fall-thru )
( 0 <= x < 2pi )
@x16-tan-q ( x* -> sin(x) )
#10 SFT2 ;x16-tan-table ADD2 LDA2 JMP2r
@x16-tan-q ( x* -> sin[x] )
DUP2 ADD2 ;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
@ -375,32 +378,32 @@
0e1a 0eed 0fdb 10e8 121b 137d 1519 1700 1946 1c0c 1f80 23ed 29cc 31f5 3e13 51f2
7888 7fff 7fff
@x16-log ( x* -> log(x)* )
@x16-log ( x* -> log[x]* )
DUP2 #0000 GTH2 STH
DUP2 #8000 LTH2 STHr AND ,&0<x<128 JCN
( error ) #0000 DIV
[ DUP2 #0000 GTH2 ] STH
[ DUP2 #8000 LTH2 ] STHr AND ?&0<x<128
( error ) !error
&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<128 DUP2 #0800 GTH2 ?&8<x<128
( 0<x<=8 ) DUP2 #0200 GTH2 ?&2<x<=8
( 0<x<=2 ) !x16-log-q
&2<x<=8 DUP2 #0400 GTH2 ?&4<x<=8
( 2<x<=4 ) #0200 x16-div x16-log-q #00b1 ADD2 JMP2r
&4<x<=8 #0400 x16-div x16-log-q #0163 ADD2 JMP2r
&8<x<128 DUP2 #2000 GTH2 ?&32<x<128
( 8<x<=32 ) DUP2 #1000 GTH2 ?&16<x<=32
( 8<x<=16 ) #0800 x16-div x16-log-q #0214 ADD2 JMP2r
&16<x<=32 #1000 x16-div x16-log-q #02c6 ADD2 JMP2r
&32<x<128 DUP2 #4000 GTH2 ?&64<x<128
( 32<x<=64 ) #2000 x16-div x16-log-q #0377 ADD2 JMP2r
&64<x<128 #4000 x16-div x16-log-q #0429 ADD2 JMP2r
( 0 < x <= 2 )
@x16-log-q ( x* -> log(x)* )
#10 SFT2 ;x16-log-table ADD2 LDA2 JMP2r
@x16-log-q ( x* -> log[x]* )
DUP2 ADD2 ;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). )
( 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