1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|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
|0 @NumType &decimal $1 &binary $1 &octal $1 &hexcadecimal $1
|100
@on-reset ( -> )
;on-console
.Console/type DEI ?{ ;on-prefix }
.Console/vector DEO2
BRK
@on-console ( -> )
#63 .Console/write DEO
.Console/type DEI #04 NEQ ?{ ( ignore args )
;on-prefix .Console/vector DEO2
} BRK
@on-prefix ( -> )
[ 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 }
.State/numType LDZ ( will fallthrough to decimal or octal )
LITr 01
&matched
.State/numType STZ
;on-digit .Console/vector DEO2
STHr ?{ BRK } ( passthru if we didn't just match a prefix )
@on-digit ( -> )
BRK
( NUMBER PRINTING ROUTINES )
@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 ={ "error 20 "at 20 "position 20 }
&prefix2 ={ 20 "with 20 "encoding 20 }
&encoding ={ "character 20 "not 20 "valid 20 "in 20 "encoding }
@Encodings
&binary ={ "binary }
&octal ={ "octal }
&decimal ={ "decimal }
&hexcadecimal ={ "hexcadecimal }
&tab =&decimal =&binary =&octal =&hexcadecimal