blob: 53bae7550c5786020a1ebd2e65bc913a19e1d709 [file] [log] [blame]
swissChilif7f1e2b2021-12-31 14:42:43 -08001 ;; FORTH.ASM -- Forth system for Microsoft (R) DOS
2
3 BITS 16
4
5 ;; DOS loads .COM executables here
6 ORG 100h
7
8 %INCLUDE "DOS.ASM"
9
10;;; MACROS ;;;
11
12 ;; Step indirect threaded code to next word. Call this in a raw
13 ;; word to effectively return. In an interpreted word SI first
14 ;; needs to be reset to the calling value.
15 %MACRO NEXT 0
16 LODSW
17 MOV BX, AX ; [ax] is invalid in 16 bits
18 JMP [BX]
19 %ENDMACRO
20
21
22 ;; Push register operand to return stack
23 %MACRO RSPUSH 1
24 SUB BP, WORDSZ
25 MOV [BP], %1
26 %ENDMACRO
27
28
29 ;; Pop from return stack to register operand
30 %MACRO RSPOP 1
31 MOV %1, [BP]
32 ADD BP, WORDSZ
33 %ENDMACRO
34
35
swissChilif8849dc2021-12-31 23:15:57 -080036 ;; Used for the compile-time dictionary linked list. At runtime
37 ;; LATEST is used instead
swissChilif7f1e2b2021-12-31 14:42:43 -080038 %DEFINE LINK 0
39
40
41 IMMEDIATE_BIT EQU 1 << 6
42 HIDDEN_BIT EQU 1 << 5
43 LENGTH_MASK EQU 0b11111
44
45
46 ;; Define a threaded word. The arguments should be the symbol for
47 ;; the word, followed by the string version. e.g.:
48 ;;
49 ;; DEFWORD DUP, 'DUP', IMMEDIATE_BIT
50 %MACRO DEFWORD 3
51 ALIGN 2
52
53WORD_%1:
54 DW LINK
55 %DEFINE LINK WORD_%1
56 DB WORDLEN_%1 | %3 ; Length | Flags
57
58NAME_%1:
59 DB %2,
60 WORDLEN_%1 EQU $ - NAME_%1
61
62 ALIGN 2
63
64%1:
65 %ENDMACRO
66
67
68 %MACRO DEFWORD_THREADED 2
69 DEFWORD %1, %2, 0
70 DW DOCOL
71 %ENDMACRO
72
73
74 %MACRO DEFWORD_THREADED_IMMED 2
75 DEFWORD %1, %2, IMMEDIATE_BIT
76 DW DOCOL
77 %ENDMACRO
78
79
80 ;; Same as DEFWORD_THREADED but this time with raw code
81 %MACRO DEFWORD_RAW 2
82 DEFWORD %1, %2, 0
83 DW INTRAW ; Raw interpreter codeword
84
85 ;; Callable from assembly
86CODE_%1:
87 %ENDMACRO
88
89
90 %MACRO DEFWORD_RAW_IMMEDIATE 2
91 DEFWORD %1, %2, IMMEDIATE_BIT
92 DW INTRAW
93
94 ;; Callable from assembly
95CODE_%1:
96 %ENDMACRO
97
98
99 ;; DEFVAR name, 'name'
100 ;; dw 0
101 %MACRO DEFVAR 2
102 DEFWORD_RAW %1, %2
103 PUSH VAR_%1
104 NEXT
105
106VAR_%1:
107 %ENDMACRO
108
swissChilif8849dc2021-12-31 23:15:57 -0800109
swissChili7c626b92022-01-01 23:35:39 -0800110 %MACRO DEFCONST 2
swissChilif7f1e2b2021-12-31 14:42:43 -0800111 DEFWORD_RAW %1, %2
swissChili7c626b92022-01-01 23:35:39 -0800112 PUSH WORD [CONST_%1]
swissChilif7f1e2b2021-12-31 14:42:43 -0800113 NEXT
swissChili7c626b92022-01-01 23:35:39 -0800114CONST_%1:
swissChilif7f1e2b2021-12-31 14:42:43 -0800115 %ENDMACRO
116
117
swissChilif8849dc2021-12-31 23:15:57 -0800118 %MACRO INCLUDE_STRING 1
swissChilif7f1e2b2021-12-31 14:42:43 -0800119 DW LITSTRING
swissChilif8849dc2021-12-31 23:15:57 -0800120 DW %%STRINGLEN
121%%BEFORE_STRING:
122 DB %1
123 %%STRINGLEN EQU $ - %%BEFORE_STRING
swissChilif7f1e2b2021-12-31 14:42:43 -0800124 ALIGN WORDSZ
125 %ENDMACRO
126
127
swissChilif7f1e2b2021-12-31 14:42:43 -0800128 %MACRO RELATIVE_ADDRESS 1
swissChilif8849dc2021-12-31 23:15:57 -0800129 DW (%1 - $ - 2)
swissChilif7f1e2b2021-12-31 14:42:43 -0800130 %ENDMACRO
131
132
133;;; PROGRAM CODE ;;;
134
135_START:
136 ;; Progran begins
137 MOV BP, SP
swissChili7c626b92022-01-01 23:35:39 -0800138 SUB BP, 1024
139 MOV WORD [CONST_SP_INITIAL], SP
140
swissChilif7f1e2b2021-12-31 14:42:43 -0800141 MOV SI, INDIRECT_START
142 NEXT
143
144 ALIGN 2
145
146
147 ;; DO COLon definition -- Codeword for indirect threaded code
148 ;; ax: indirect execution address
149DOCOL:
150 RSPUSH si
151 ADD AX, WORDSZ ; Point to the first word address
152 MOV SI, AX ; Enter the function body (set si)
153 NEXT
154
155
156 ;; Interpret raw code (plain machine code)
157INTRAW:
158 ADD AX, WORDSZ
159 JMP AX
160
161
162INDIRECT_START:
swissChilif8849dc2021-12-31 23:15:57 -0800163 DW SETUP
swissChilif7f1e2b2021-12-31 14:42:43 -0800164 DW QUIT
swissChilif7f1e2b2021-12-31 14:42:43 -0800165
166
167SETUP:
168 DW INTRAW
169
170 MOV DX, MSG
171 WRITESOUT
172
173 NEXT
174
175LITERAL:
176 DW INTRAW
177
178 LODSW ; Load the next word
179 PUSH AX
180
181 NEXT
182
183
184EXIT:
185 DW INTRAW
186 RSPOP SI
187 NEXT
188
swissChilif7f1e2b2021-12-31 14:42:43 -0800189
swissChili7c626b92022-01-01 23:35:39 -0800190 DEFWORD_RAW BYE, 'BYE'
swissChilif7f1e2b2021-12-31 14:42:43 -0800191 FLUSH
192 QUIT_PROC
193
194
195 DEFWORD_RAW LIT, 'LIT'
196 LODSW ; Read next word from input to AX
197 PUSH AX
198 NEXT
199
200
201 DEFWORD_RAW DROP, 'DROP'
202 ADD SP, WORDSZ
203 NEXT
204
205
206 DEFWORD_RAW SWAP, 'SWAP'
207 POP AX
208 POP BX
209 PUSH AX
210 PUSH BX
211 NEXT
212
213
214 DEFWORD_RAW DUP, 'DUP'
215 ;; This is stupid, [SP] is invalid
216 POP AX
217 PUSH AX
218 PUSH AX
219 NEXT
220
221
222 DEFWORD_RAW PLUS, '+'
223 POP AX
224 POP BX
225 ADD AX, BX
226 PUSH AX
227 NEXT
228
229
230 DEFWORD_RAW MINUS, '-' ; ( DX AX -- DX-AX )
231 POP AX
232 POP DX
233 SUB DX, AX
234 PUSH DX
235 NEXT
236
237
swissChili7c626b92022-01-01 23:35:39 -0800238 DEFWORD_RAW SLASHMOD, '/MOD'
swissChili7c626b92022-01-01 23:35:39 -0800239 POP AX
swissChili94f1e762022-01-29 21:55:45 -0800240 POP DX
swissChili7c626b92022-01-01 23:35:39 -0800241 IDIV DX
242 PUSH DX ; Remainder
243 PUSH AX ; Quotient
244 NEXT
245
246
247 DEFWORD_RAW _TIMES, '*'
248 POP AX
249 POP DX
250 IMUL DX
251 PUSH AX
252 NEXT
253
254
swissChilif8849dc2021-12-31 23:15:57 -0800255 DEFWORD_RAW AND, 'AND'
256 POP AX
257 POP DX
258 AND AX, DX
259 PUSH AX
260 NEXT
261
262
263 DEFWORD_RAW XOR, 'XOR'
264 POP DX
265 POP AX
266 XOR AX, DX
267 PUSH AX
268 NEXT
269
270
271 DEFWORD_RAW NOT, 'NOT'
272 POP AX
273 NOT AX
274 PUSH AX
275 NEXT
276
277
swissChilif7f1e2b2021-12-31 14:42:43 -0800278 DEFWORD_RAW ADD1, '1+'
279 POP AX
280 ADD AX, 1
281 PUSH AX
282 NEXT
283
284
285 DEFWORD_RAW ADD2, '2+'
286 POP AX
287 ADD AX, 2
288 PUSH AX
289 NEXT
290
291
292 ;; This kind of sucks
293 DEFWORD_RAW _2DUP, '2DUP' ; ( a b -- a b a b )
294 POP AX
295 POP BX
296 PUSH BX
297 PUSH AX
298 PUSH BX
299 PUSH AX
300 NEXT
swissChili7c626b92022-01-01 23:35:39 -0800301
302
swissChilif7f1e2b2021-12-31 14:42:43 -0800303 %INCLUDE "IOWORDS.ASM"
304 %INCLUDE "DICTNRY.ASM"
305
306;;; LATE-INIT VARIABLES ;;;
307 DEFVAR STATE, 'STATE'
swissChilice85f572022-04-20 16:54:34 -0700308 DW 0 ; Interpret; ( cfa )
swissChilif8849dc2021-12-31 23:15:57 -0800309
swissChilif7f1e2b2021-12-31 14:42:43 -0800310
311 DEFVAR HERE, 'HERE'
312 DW HERE_START
swissChilif8849dc2021-12-31 23:15:57 -0800313
swissChili7c626b92022-01-01 23:35:39 -0800314
315 DEFCONST SP_INITIAL, 'S0'
316 DW 0
317
swissChilif7f1e2b2021-12-31 14:42:43 -0800318
319 ;; LATEST must be the last word defined in FORTH.ASM!
320 DEFVAR LATEST, 'LATEST'
321 DW LINK
322
323
324;;; PROGRAM DATA ;;;
325 MSG DB 'DOS FORTH', 0Dh, 0Ah, '$'
326
327
swissChilif7f1e2b2021-12-31 14:42:43 -0800328;;; FREE DATA ;;;
swissChilie4d2e282022-01-04 22:22:27 -0800329 ALIGN 4
swissChilif7f1e2b2021-12-31 14:42:43 -0800330HERE_START: