|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1 |0 @State &seenPrefix $1 &numType $1 &number $1 &err $1 &errChar $1 @flag $1 @count $1 |0 @NumType &decimal $1 &octal $1 &hexcadecimal $1 &binary |100 @on-reset ( -> ) #ffff testnum #efff testnum #8fff testnum #7fff testnum #3fff testnum #2710 testnum #0fff testnum #03e8 testnum #01f4 testnum #000b testnum BRK @testnum ( num* -- ) DUP2 printoctal #09 .Console/write DEO DUP2 printdecimal #09 .Console/write DEO SWP printhex printhex #0a .Console/write DEO JMP2r @printhex ( num -- ) #10 DIVk DUP printhexdigit MUL SUB printhexdigit JMP2r @printdecimal ( num* -- ) #01 .flag STZ #00 STH ( return stack is loop counter ) #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 #00 STH ( return stack is loop counter ) 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 @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 @errors &prefix ={ "error 20 "at 20 "position 20 } &prefix2 ={ 20 "with 20 "encoding 20 } &encoding ={ "character 20 "not 20 "valid 20 "in 20 "encoding } @encodings &decimal ={ "decimal } &octal ={ "octal } &hexcadecimal ={ "hexcadecimal } &binary ={ "binary } &tab =&decimal =&octal =&hexcadecimal =&binary