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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
\ i think something is going on with the stack. i dunno
\ things TODO:
\ better error handling
\ :noname
\ DO LOOP
\ s\"
\ <builds does>
\ argc/argv
\ file io
\ interactive input
: cell+ 8 + ;
: syswrite ( u c-addr fd -- n ) 1 syscall3 ;
: say ( c-addr u -- ) swap 1 syswrite drop ;
: emit ( chr -- ) sp cell+ 1 swap 1 syswrite 2drop ;
: cr 10 emit ;
: decimal 10 base ! ;
: hex 16 base ! ;
: nip swap drop ;
: tuck swap over ;
hex : ret, c3 c, ; decimal
: cells 8 * ;
: allot here @ swap here +! ;
: [compile] parse find drop >cfa compile, ; immediate
: ' parse find drop >cfa [compile] lit ; immediate \ note: no error handling (yet)
: recurse latest @ >cfa compile, ; immediate
: s, ( c-addr u -- ) here @ swap ( c-addr here u ) dup >r cmove r> here +! ;
: literal [compile] lit ; immediate
: constant create [compile] lit ret, ;
: variable 1 cells allot create [compile] lit ret, ;
\ FLOW CONTROL {{{
\ jump helpers from forth83 (got them from pforth tho ehehe)
\ < backward jump > forward jump
\ adding/subtracting 4 gets to the next instruction.
: <mark here @ ;
: <resolve here @ 4 + - d, ;
: >mark here @ 0 d, ;
: >resolve dup here @ swap - 4 - swap d! ;
: begin <mark ; immediate
: again branch <resolve ; immediate
: until ?branch <resolve ; immediate
: if ?branch >mark ; immediate ( I: -- a )
: else branch >mark swap >resolve ; immediate
: then >resolve ; immediate
: while ?branch >mark ; immediate
: repeat branch swap <resolve >resolve ; immediate
: ?dup dup 0<> if dup then ;
\ jonesforth impl
: case 0 ; immediate
: of ' over compile, ' = compile, [compile] if ' drop compile, ; immediate
: endof [compile] else ; immediate
: endcase ' drop compile, begin ?dup while [compile] then repeat ; immediate
\ }}}
\ TODO interpret mode strings?
: s" 1 >in +! [ char " ] literal cparse branch >mark >r 2dup cmove, r> >resolve swap [compile] lit [compile] lit ; immediate
: ." [compile] s" ' say compile, ; immediate \ lol this word breaks the highlighting, here have another "
\ ASSEMBLER {{{
\ https://wiki.osdev.org/X86-64_Instruction_Encoding
\ see dusk os asm/x86.fs
\ my idea is that operands are given in the reverse order that
\ they are in intel notation, so that intel notation can be vaguely
\ turned into this assembler by moving the mnemonic to the end,
\ like: mov r11, r12 -> smth like r11 r12 mov,
\ a lot of this would probably be more elegant but i have to get around
\ to <builds and does>. i don't want to have to
hex
variable rex
variable modrm
: asm$ 0 rex ! c0 modrm ! ;
: rex.w rex @ 48 or rex ! ;
: rex.r rex @ 44 or rex ! ;
: rex.x rex @ 42 or rex ! ;
: rex.b rex @ 41 or rex ! ;
: rex, rex @ ?dup if c, then ;
\ REGISTERS {{{
: rax modrm @ 0 or modrm ! ; : rcx modrm @ 1 or modrm ! ;
: rdx modrm @ 2 or modrm ! ; : rbx modrm @ 3 or modrm ! ;
: rsp modrm @ 4 or modrm ! ; : rbp modrm @ 5 or modrm ! ;
: rsi modrm @ 6 or modrm ! ; : rdi modrm @ 7 or modrm ! ;
: r8 modrm @ 0 or modrm ! rex.b ; : r9 modrm @ 1 or modrm ! rex.b ;
: r10 modrm @ 2 or modrm ! rex.b ; : r11 modrm @ 3 or modrm ! rex.b ;
: r12 modrm @ 4 or modrm ! rex.b ; : r13 modrm @ 5 or modrm ! rex.b ;
: r14 modrm @ 6 or modrm ! rex.b ; : r15 modrm @ 7 or modrm ! rex.b ;
: rax, modrm @ 00 or modrm ! ; : rcx, modrm @ 08 or modrm ! ;
: rdx, modrm @ 10 or modrm ! ; : rbx, modrm @ 18 or modrm ! ;
: rsp, modrm @ 20 or modrm ! ; : rbp, modrm @ 28 or modrm ! ;
: rsi, modrm @ 30 or modrm ! ; : rdi, modrm @ 38 or modrm ! ;
: r8, modrm @ 00 or modrm ! rex.r ; : r9, modrm @ 08 or modrm ! rex.r ;
: r10, modrm @ 10 or modrm ! rex.r ; : r11, modrm @ 18 or modrm ! rex.r ;
: r12, modrm @ 20 or modrm ! rex.r ; : r13, modrm @ 28 or modrm ! rex.r ;
: r14, modrm @ 30 or modrm ! rex.r ; : r15, modrm @ 38 or modrm ! rex.r ;
\ }}}
: /0 modrm @ 00 or modrm ! ; : /1 modrm @ 08 or modrm ! ;
: /2 modrm @ 10 or modrm ! ; : /3 modrm @ 18 or modrm ! ;
: /4 modrm @ 20 or modrm ! ; : /5 modrm @ 28 or modrm ! ;
: /6 modrm @ 30 or modrm ! ; : /7 modrm @ 38 or modrm ! ;
\ TODO store and write the displacement if given
: mod0 modrm @ 3f and modrm ! ;
: d) mod0 0<> if modrm @ 40 or modrm ! then ; \ disp8 or 0 only for now
: mov, rex, 8b c, modrm @ c, asm$ ;
\ example idea: (from execute below)
\ rex.w r11, r14 0 d) mov,
\ rex.w r14, r14 8 d) lea,
\ r11 call,
decimal
\ }}}
: execute [ hex
4d c, 8b c, 1e c, \ mov r11, [r14]
\ REX.W + 8B /r -- MOV r64, r/m64
\ rex w (64 bit operand size), r (modrm.reg ext), b (modrm.rm ext)
\ modrm 00 011 110
\ mod [r/m] reg 1.011 (r11) r/m 1.110 (r14)
4d c, 8d c, 76 c, 08 c, \ lea r14, [r14+8]
\ REX.W + 8D /r -- LEA r64, m
\ rex w (64 bit operand size), r (modrm.reg ext), b (modrm.rm ext)
\ modrm 01 110 110
\ mod [r/m+disp8] reg 1.110 (r14) r/m 1.110 (r14)
41 c, ff c, d3 c, \ call r11
\ FF /2 -- CALL r/m64
\ rex b (.rm ext)
\ modrm 11 010 011
\ mod r/m reg /2 r/m 1.011 (r11)
decimal ] ;
: / /mod swap drop ;
: mod /mod drop ;
: negate 0 swap - ;
: abs dup 0< if negate then ;
32 constant bl
: space bl emit ;
: spaces begin dup 0> while space 1- repeat drop ;
\ PNO {{{
\ mostly from pforth
255 allot variable pad drop
variable hld
: <# pad hld ! ;
: hold 1 hld -! ( chr ) hld @ c! ;
: sign 0< if [ char - ] literal hold then ;
: # base @ /mod swap 9 over > if 7 + then [ char 0 ] literal + hold ;
: #s begin # dup 0= until ;
: #> drop hld @ pad over - ;
: (u.) <# #s #> ;
: u. (u.) say space ;
: u.r >r (u.) r> over - spaces say ;
: (.) dup abs <# #s swap sign #> ;
: . (.) say space ;
: .r >r (.) r> over - spaces say ;
: (.byte) hex <# # # #> decimal ;
: .byte (.byte) say space ;
: (.word) hex <# # # # # #> decimal ;
: .word (.word) say space ;
: (.dword) hex <# # # # # # # # # #> decimal ;
: .dword (.dword) say space ;
: (.qword) hex <# # # # # # # # # # # # # # # # # #> decimal ;
: .qword (.qword) say space ;
\ }}}
: ? @ . ;
: .s sp cell+ ( skip sp itself ) begin dup s0 @ > while dup @ .qword cell+ repeat drop cr ;
: .rs rp cell+ ( skip rsp itself ) begin dup rs0 @ > while dup @ .qword cell+ repeat drop cr ;
: bytes-allocated hend @ h0 @ - ;
: bytes-used here @ h0 @ - ;
: bytes-free bytes-allocated bytes-used - ;
: .free bytes-free u. ." of " bytes-allocated u. ." bytes free (used " bytes-used (.) say ." )" cr ;
\ FUCK is BYE but it takes an error code. its called that because you call it when shit is fucked.
: fuck ( code -- ) 60 syscall1 ;
\ TODO broken as shit
: (handler) error @ dup case
1 of ." stack underflow" endof
2 of ." word not found" endof
." unknown error"
endcase cr fuck ;
\ : _ ' (handler) handler ! ; _ \ so broken that it breaks Seer
: >ffa ( lfa -- ffa ) 8 + ;
: >nfa ( lfa -- nfa ) 9 + ;
: (words) ( lfa -- ) >nfa dup w@ swap 2 + swap say 2 spaces ;
: words latest @ begin ?dup 0<> while dup (words) @ repeat cr ;
: (evaluate) ( c-addr u -- ) 0 >in ! ( u ) #tib ! ( c-addr ) tib ! interpret ;
: evaluate ( c-addr u -- ) tib @ >r #tib @ >r >in @ >r (evaluate) r> >in ! r> #tib ! r> tib ! ;
: teststr3 s" 1 2 3 2drop drop" ;
teststr3 evaluate
\ FILE I/O {{{
\ }}}
.free bye
|
