|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

|0 @NumType &decimal $1 &binary $1 &octal $1 &hexcadecimal $1


|100
@on-reset ( -> )
	.Console/type DEI ?{ prompt BRK }
	;on-console .Console/vector DEO2
	BRK

@on-console ( -> )
	#63 .Console/write DEO
	.Console/type DEI #04 NEQ ?{ prompt } BRK

@on-prefix ( -> ) ( FIXME: this could be simpler )
	[ LITr 00 ]
	.Console/read DEI 
	DUP #30 NEQ ?{ .NumType/octal .State/numType STZ BRK }

	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 ]

	&matched
	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 ]

@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-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

@printhex ( num -- )
	#10 DIVk DUP printhexdigit
	MUL SUB printhexdigit
	JMP2r

@printdecimal ( num* -- )
	#01 .flag STZ
	[ LITr 00 ]
	#2710 DIV2k DUP2 NIP DUP #00 EQU ?{
		DUP printbcddigit
		#00 .flag STZ
	} POP
	MUL2 SUB2
	&loop
		#03e8 DIV2k DUP2 NIP ( get 1000s place )
		DUP #00 EQU .flag LDZ AND ?{ ( if flag || s != 0 )
			DUP printbcddigit
			#00 .flag STZ
		} POP
		MUL2 SUB2 #000a MUL2 ( DUP2 SWP printhex printhex )
	STHr #01 ADD DUP STH #04 NEQ
	( end ) ?&loop
	POPr POP2 JMP2r

@printoctal ( num* -- )
	#01 .flag STZ
	[ LITr 00 ]
	DUP2 #0f SFT2 NIP #00 EQU ?{
		#31 .Console/write DEO
		#00 .flag STZ
	}
	#10 SFT2
	&loop
		DUP2 #0d SFT2 NIP ( get top 3 bits )
		DUP #00 EQU .flag LDZ AND ?{ ( if flag || s != 0 )
			DUP printbcddigit
			#00 .flag STZ
		} POP
		#30 SFT2
	STHr #01 ADD DUP STH #05 NEQ
	( end ) ?&loop
	POPr POP2 JMP2r

@printbinary ( num -- )
	[ LITr 00 ]
	&loop
		DUP #07 SFT #30 ADD
		.Console/write DEO
		#10 SFT
	STHr #01 ADD DUP STH #08 NEQ
	( end ) ?&loop
	POPr POP JMP2r

@printhexdigit ( digit -- )
	#0f AND
	DUP #0a LTH ?{ #27 ADD } ( take top part, if 10-15 move to a-f )
	#30 ADD .Console/write DEO
	JMP2r
@printbcddigit ( digit -- )
	#0f AND
	#30 ADD .Console/write DEO
	JMP2r


( STRING DATA )
@Errors
	&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 }
	&octal		={ "octal }
	&decimal	={ "decimal }
	&hexcadecimal	={ "hexcadecimal }
	&tab		=&decimal =&binary =&octal =&hexcadecimal