From 1050d280f1fe323ca235e6c336164949f9faf392 Mon Sep 17 00:00:00 2001 From: d6 Date: Thu, 6 Apr 2023 22:08:05 -0400 Subject: [PATCH] use immediate opcodes, use uxnlin, etc. --- fix16.tal | 193 +++++++++++++++++++++++++++--------------------------- 1 file changed, 98 insertions(+), 95 deletions(-) diff --git a/fix16.tal b/fix16.tal index cf2850b..c7d7e4b 100644 --- a/fix16.tal +++ b/fix16.tal @@ -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 ) - POP2 POP2r #ff JMP2r ( -1 ; x<0 y>=0 ) - &yn DUP2 x16-is-neg ,&same JCN ( x* [y*] ; y<0 ) - POP2 POP2r #01 JMP2r ( 1 ; x>=0 y<0 ) - &same STH2r ;x16-ucmp JMP2 ( res ; x<0 y<0 b ) +( 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 ( 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 ( 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 ,< JCN GTH2 JMP2r + LTH2k ?< GTH2 JMP2r < 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 x x x x x x 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-pi*2 STH2 ( x [2pi] ) - DUP2 STH2kr ;x16-quotient JSR2 ( x x/2pi [2pi] ) - STH2r ;x16-mul JSR2 SUB2 ( x' ; 0 <= x' < 2pi ) +@x16-sin ( x* -> sin[x]* ) + x16-pi*2 STH2 ( 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-pi*2 STH2 ( x [2pi] ) - DUP2 STH2kr ;x16-quotient JSR2 ( x x/2pi [2pi] ) - STH2r ;x16-mul JSR2 SUB2 ( x' ; 0 <= x' < 2pi ) +@x16-tan ( x* -> tan[x]* ) + x16-pi*2 STH2 ( 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)* ) - - DUP2 #0000 GTH2 STH - DUP2 #8000 LTH2 STHr AND ,&0 log[x]* ) - &0 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