From e4f1e4982bd4bf76df574b12584786a5b563ce02 Mon Sep 17 00:00:00 2001 From: d6 Date: Mon, 12 Dec 2022 14:43:56 -0500 Subject: [PATCH] working lshift + add --- hoax.tal | 116 ++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 102 insertions(+), 14 deletions(-) diff --git a/hoax.tal b/hoax.tal index ea0f126..3c3358b 100644 --- a/hoax.tal +++ b/hoax.tal @@ -85,6 +85,20 @@ ( "a" 7 bytes ) ( "abcd" 7 bytes ) ( "abcde" 12 bytes ) +( ) +( LITERAL SYNTAX ) +( ) +( 1. decimal numbers ) +( 0|-?[1-9](0-9)* ) +( ) +( 2. hexadecimal numbers ) +( 0x[0-9a-f]+ ) +( ) +( 3. bareword ) +( [^-0-9 ][^ ]*|-([^0-9 ][^ ]*)? ) +( ) +( 4. string ) +( "(\.|[^"\])" ) ( TODO: special case empty string? ) @@ -94,6 +108,7 @@ %SX { ;emit/short JSR2 } %DEBUG { #010e DEO } %EXIT { #010f DEO BRK } +%DIE { #0000 DIV } %D { ;display JSR2 } @@ -114,6 +129,69 @@ ( DEBUG EXIT ) BRK +( returns true if buffer contains a hex number or error ) +@buf-is-hex ( -> bool^ ) + ;buffer/input ;buffer/pos LDA2 OVR2 SUB2 ( start* size* ) + #0003 LTH2 ,&short JCN ( start* ) + LDA2 LIT2 "0x EQU2 JMP2r ( 0x-prefix? ) + &short POP2 #00 JMP2r ( 00 ) + +( returns true if buffer contains a decimal number or error ) +@buf-is-dec + ;buffer/input ;buffer/pos LDA2 OVR2 SUB2 ( start* size* ) + DUP2 #0000 GTH2 ,&nonempty JCN ( start* size* ) + &empty POP2 POP2 #00 JMP2r ( 00 ) + &nonempty ( start* size* ) + OVR2 LDA LIT "- NEQ ,&continue JCN ( start* size* ) + SWP2 INC2 SWP2 ( start+1* size-1* ) + DUP2 #0000 EQU2 ,&empty JCN ( start+1* size-1* ) + &continue ( start* size* ) + LITr "0 #0001 GTH2 STH ADDr ( start* [lower^] ) + LDAk STH GTHr ( start* [lower>c^] ) + LDA LIT "9 GTH ( start* c>upper^ [lower>c^] ) + STHr ORA #00 EQU JMP2r ( lower<=c&&c<=upper ) + +( 0 = #30, a = #61 ) +@char-to-hex ( c^ -> n^ ) + DUP #60 GTH ,&letter JCN + #30 SUB JMP2r + &letter #57 SUB JMP2r + +@lshift-16 ( num$ -> res$ ) + #0000 ;shift-and-add JMP2 + +( shift number left by 16-bits and perform an unsigned ) +( addition of the given 16-bit integer. ) +( the sign of the 16-bit integer to add is assumed ) +( to be the same as the original number. ) +@shift-and-add ( num$ $add -> res$ ) + STH2 ( num$ [add*] ) + DUP2 #8000 EQU2 ,&iszero JCN ( num$ [add*] ) + DUP2 #7fff GTH2 ,&literal JCN ( num$ ) + DUP2 ;read-object JSR2 ( num$ tag^ ohi* olo* [add*] ) + STH2 STH2 ( num$ tag^ [add* olo* ohi*] ) + DUP #f0 AND ( num$ tag^ type^ [add* olo* ohi*] ) + #30 NEQ ,&error JCN ( num$ tag^ [add* olo* ohi*] ) + #04 ANDk EQU ,&non-zero-hi JCN ( num$ tag^ [add* olo* ohi*] ) + STH2kr ORA ,&non-zero-hi JCN ( num$ tag^ [add* olo* ohi*] ) + POP2r STH2r STH2r ( num$ tag^ olo* add* ) + ;make-obj JSR2 NIP2 JMP2r ( res$ ) + &non-zero-hi POP2r POP2r ( num$ tag^ [add*] ) + #04 ORA ROT ROT ( tag^ num$ [add*] ) + STH2r SWP2 ( tag^ add* num$ ) + ;make-obj JMP2 ( res$ ) + &literal ( num$ [add*] ) + #7fff AND2 ( n* [add*] ) + DUP2 #4000 GTH2 ,&negative JCN ( n* [add*] ) + #30 ,&create JMP ( n* 30 [add*] ) + &iszero JMP2r ( zero$ [add*] ) + &error POP POP2 ;error JMP2 ( ) + &negative ( n* [add*] ) + #8000 SWP2 SUB2 #38 ( abs* 38 [add*] ) + &create ( n* ^tag [add*] ) + ROT ROT STH2r ( tag^ n* add* ) + ;make-obj JMP2 ( res$ ) + @sym-from-buf ( -> sym$ ) ;buffer/input ;sym-from-buf-src JMP2 @@ -193,11 +271,11 @@ @end-word0 ( c -> ) POP ;on-key-ready #10 DEO2 ( ) ;echo JSR2 "word 20 00 ( ) + ;buf-is-hex JSR2 BX SP ( ) + ;buf-is-dec JSR2 BX SP ( ) ;sym-from-buf JSR2 ( obj$ ) ;display JSR2 ( ) ;buf-end JSR2 JMP2r ( ) -( ;buffer/input ;print JSR2 NL - POP JMP2r ) @start-escape ( c -> ) ;on-key-escaped #10 DEO2 POP BRK @@ -263,7 +341,12 @@ #3fff ;u16-to-num JSR2 D #4000 ;u16-to-num JSR2 D #4001 ;u16-to-num JSR2 D - #ffff ;u16-to-num JSR2 D + #ffff ;u16-to-num JSR2 STH2k D + STH2r ;lshift-16 JSR2 STH2k D + STH2r ;lshift-16 JSR2 STH2k D + STH2r ;lshift-16 JSR2 STH2k D + STH2r ;lshift-16 JSR2 STH2k D + STH2r ;lshift-16 JSR2 D #30 #5678 #9abc ;make-obj JSR2 STH2k D #34 #1234 STH2r ;make-obj JSR2 D #0003 ;u16-to-num JSR2 null ;cons JSR2 STH2k D @@ -349,22 +432,27 @@ @display0-unk ( addr* -> ) ;echo JSR "unknown< 00 ;emit/short JSR2 LIT "> #18 DEO JMP2r + @display0-rat ( addr* -> ) INC2 LDA2k ;display0 JSR2 LIT "/ #18 DEO INC2 INC2 LDA2 ;display0 JMP2 + @display0-int ( addr* -> ) - LDAk #80 LTH ,&non-neg JCN LIT "- #18 DEO - &non-neg - ;echo JSR2 "0x 00 - &loop - LDAk #04 AND ,&is-long JCN - INC2 LDA2k ;emit/short JSR2 - INC2 INC2 LDA2 ;emit/short JMP2 - &is-long - INC2 LDA2k ;emit/short JSR2 - INC2 INC2 LDA2 ;obj-to-addr JSR2 - ,&loop JMP + LDAk #80 LTH ,&non-neg JCN ( addr* ) + LIT "- #18 DEO ( addr* ) + &non-neg ( addr* ) + ;echo JSR2 "0x 00 ( addr* ) + ,&loop JSR JMP2r ( ) + &loop ( addr* ) + LDAk #04 AND ,&is-long JCN ( addr* ) + INC2 LDA2k ;emit/short JSR2 ( addr+1* ) + INC2 INC2 LDA2 ;emit/short JMP2 ( ) + &is-long ( addr* ) + INC2 DUP2 INC2 INC2 ( addr+1* addr+3* ) + LDA2 ;obj-to-addr JSR2 ( addr+1* obj$ ) + ,&loop JSR ( addr+1* ) + LDA2 ;emit/short JMP2 ( ) ( TODO: \n \t etc. ) @display0-char ( c^ -> )