1 files changed, 122 insertions(+), 22 deletions(-)

M nanpa.tal

@@ 1,49 1,146 @@
+|0 @System &pad $f &state $1
 |10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
 
 |0 @State &numType $1 &number $2 &err $1 &errChar $1
-	@flag $1 @count $1
+	@flag $1
 
 |0 @NumType &decimal $1 &binary $1 &octal $1 &hexcadecimal $1
 
 
 |100
 @on-reset ( -> )
-	;on-console
-	.Console/type DEI ?{ ;on-prefix }
-	.Console/vector DEO2
-
+	.Console/type DEI ?{ prompt BRK }
+	;on-console .Console/vector DEO2
 	BRK
 
 @on-console ( -> )
 	#63 .Console/write DEO
-	.Console/type DEI #04 NEQ ?{ ( ignore args )
-		;on-prefix .Console/vector DEO2
-	} BRK
+	.Console/type DEI #04 NEQ ?{ prompt } BRK
 
-@on-prefix ( -> )
+@on-prefix ( -> ) ( FIXME: this could be simpler )
 	[ LITr 00 ]
 	.Console/read DEI 
 	DUP #30 NEQ ?{ .NumType/octal .State/numType STZ BRK }
 
-	DUP #62 NEQ ?{ .NumType/binary		!&matched }
-	DUP #6f NEQ ?{ .NumType/octal		!&matched }
-	DUP #64 NEQ ?{ .NumType/decimal		!&matched }
-	    #78 NEQ ?{ .NumType/hexcadecimal	!&matched }
+	DUP LIT "b NEQ ?{ .NumType/binary	!&matched }
+	DUP LIT "o NEQ ?{ .NumType/octal	!&matched }
+	DUP LIT "d NEQ ?{ .NumType/decimal	!&matched }
+	DUP LIT "x NEQ ?{ .NumType/hexcadecimal	!&matched }
+	    LIT "q NEQ ?{ #80 .System/state DEO } ( exit on 'q' )
 	.State/numType LDZ ( will fallthrough to decimal or octal )
-	LITr 01
+	[ LITr 01 ]
 
 	&matched
-	.State/numType STZ
-	;on-digit .Console/vector DEO2
+	DUP .State/numType STZ #10 SFT2 #00 SWP
+	;&parsers ADD2 LDA2 DUP2 .Console/vector DEO2
+	STHr ?{ BRK } JMP2 ( jump to the handler if we matched a non-prefix )
+
+	&parsers [ =on-decimal =on-binary =on-octal =on-hexcadecimal ]
 
-	STHr ?{ BRK } ( passthru if we didn't just match a prefix )
+@peek2 ( val* -- val* )
+	LIT "x .Console/write DEO
+	DUP2 SWP printhex printhex
+	JMP2r
+
+@on-binary ( -> )
+	.Console/read DEI
+	DUP #0a NEQ ?{ finish-number }
+	DUP #fe AND DUP #30 EQU ?{ err-encoding }
+	EOR #00 SWP
+	.State/number LDZ2 #10 SFT2 ORA2
+	.State/number STZ2
+	BRK
+@on-octal ( -> )
+	.Console/read DEI
+	DUP #0a NEQ ?{ finish-number }
+	DUP #f8 AND DUP #30 EQU ?{ err-encoding }
+	EOR #00 SWP
+	.State/number LDZ2 #30 SFT2 ORA2
+	.State/number STZ2
+	BRK
+@on-decimal ( -> )
+	.Console/read DEI
+	DUP #0a NEQ ?{ finish-number }
+	#30 SUB DUP #0a LTH ?{ err-encoding }
+	#00 SWP
+	.State/number LDZ2 #000a MUL2 ADD2
+	.State/number STZ2
+	BRK
+@on-hexcadecimal ( -> )
+	.Console/read DEI
+	DUP #0a NEQ ?{ finish-number }
+	#30 SUB DUP #09 GTH ?{ !&incr } ( 0-9 )
+	#07 SUB DUP #0f GTH ?{ !&incr } ( A-F )
+	#20 SUB DUP #0f GTH ?{ !&incr } ( a-f )
+	err-encoding
+
+	&incr
+	#00 SWP
+	.State/number LDZ2 #40 SFT2 ORA2
+	.State/number STZ2
+	BRK
 
-@on-digit ( -> )
+@on-error ( -> )
+	.Console/read DEI #0a EQU ?{ BRK }
+	;Errors/prefix puts
+	.State/errChar LDZ .Console/write DEO
+	;Errors/prefix2 puts
+	;Encodings/tab .State/numType LDZ indextab puts
+	;Errors/prefix3 puts
+	;Errors/tab .State/err LDZ indextab puts
+	#0a .Console/write DEO
+	prompt
+	BRK
 
+@err-encoding ( char -- )
+	.Console/read DEI .State/errChar STZ
+	#01 .State/err STZ
+	;on-error .Console/vector DEO2
 	BRK
 
+@finish-number ( -- )
+	.State/number LDZ2
+	LIT "0 .Console/write DEO
+	LIT "b .Console/write DEO
+	DUP2 OVR #00 EQU ?{ SWP DUP printbinary SWP } NIP printbinary
+	#09 .Console/write DEO
+
+	LIT "0 .Console/write DEO
+	DUP2 printoctal
+	#09 .Console/write DEO
+
+	DUP2 printdecimal
+	#09 .Console/write DEO
+
+	LIT "0 .Console/write DEO
+	LIT "x .Console/write DEO
+	OVR #00 EQU ?{ SWP DUP printhex SWP } NIP printhex
+	#0a .Console/write DEO
+
+	prompt
+	BRK
+
+@prompt ( -- )
+	#0000 .State/number STZ2
+	#00 .State/numType STZ
+	;on-prefix .Console/vector DEO2
+	LIT "% .Console/write DEO
+	#20 .Console/write DEO
+	JMP2r
+
+( HELPER ROUTINES )
+@indextab ( list* idx -- ptr* )
+	#02 MUL #00 SWP ADD2
+	LDA2
+	JMP2r
+
+@puts ( str* -- )
+	LDA2k SWP2 INC2 INC2 ( end* str+2* )
+	&loop EQU2k ?&break
+		LDAk .Console/write DEO
+	INC2 !&loop
+	&break POP2 POP2 JMP2r
 
-( NUMBER PRINTING ROUTINES )
 @printhex ( num -- )
 	#10 DIVk DUP printhexdigit
 	MUL SUB printhexdigit


@@ 110,9 207,12 @@
 
 ( STRING DATA )
 @Errors
-	&prefix		={ "error 20 "at 20 "position 20 }
-	&prefix2	={ 20 "with 20 "encoding 20 }
-	&encoding	={ "character 20 "not 20 "valid 20 "in 20 "encoding }
+	&prefix		={ "bad 20 "char 20 "' }
+	&prefix2	={ "' 20 "for 20 }
+	&prefix3	={ 20 "encoding: 20 }
+	&unknown	={ "unknown 20 "error }
+	&encoding	={ "not 20 "in 20 "range. }
+	&tab		=&unknown =&encoding
 
 @Encodings
 	&binary		={ "binary }