swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 1 | ;; 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 | |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 36 | ;; Used for the compile-time dictionary linked list. At runtime |
| 37 | ;; LATEST is used instead |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 38 | %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 | |
| 53 | WORD_%1: |
| 54 | DW LINK |
| 55 | %DEFINE LINK WORD_%1 |
| 56 | DB WORDLEN_%1 | %3 ; Length | Flags |
| 57 | |
| 58 | NAME_%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 |
| 86 | CODE_%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 |
| 95 | CODE_%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 | |
| 106 | VAR_%1: |
| 107 | %ENDMACRO |
| 108 | |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 109 | |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 110 | %MACRO DEFCONST 2 |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 111 | DEFWORD_RAW %1, %2 |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 112 | PUSH WORD [CONST_%1] |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 113 | NEXT |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 114 | CONST_%1: |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 115 | %ENDMACRO |
| 116 | |
| 117 | |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 118 | %MACRO INCLUDE_STRING 1 |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 119 | DW LITSTRING |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 120 | DW %%STRINGLEN |
| 121 | %%BEFORE_STRING: |
| 122 | DB %1 |
| 123 | %%STRINGLEN EQU $ - %%BEFORE_STRING |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 124 | ALIGN WORDSZ |
| 125 | %ENDMACRO |
| 126 | |
| 127 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 128 | %MACRO RELATIVE_ADDRESS 1 |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 129 | DW (%1 - $ - 2) |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 130 | %ENDMACRO |
| 131 | |
| 132 | |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame^] | 133 | %MACRO DOS_STRING 1 |
| 134 | DB %1, 0Dh, 0Ah, '$' |
| 135 | %ENDMACRO |
| 136 | |
| 137 | |
| 138 | ;; Move the address of the PAD into %1 |
| 139 | ;; Pad starts at 256 bytes above LATEST |
| 140 | %MACRO GET_PAD 1 |
| 141 | MOV %1, [VAR_LATEST] |
| 142 | ADD %1, 256 |
| 143 | %ENDMACRO |
| 144 | |
| 145 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 146 | ;;; PROGRAM CODE ;;; |
| 147 | |
| 148 | _START: |
| 149 | ;; Progran begins |
| 150 | MOV BP, SP |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 151 | SUB BP, 1024 |
| 152 | MOV WORD [CONST_SP_INITIAL], SP |
| 153 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 154 | MOV SI, INDIRECT_START |
| 155 | NEXT |
| 156 | |
| 157 | ALIGN 2 |
| 158 | |
| 159 | |
| 160 | ;; DO COLon definition -- Codeword for indirect threaded code |
| 161 | ;; ax: indirect execution address |
| 162 | DOCOL: |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame^] | 163 | RSPUSH SI |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 164 | ADD AX, WORDSZ ; Point to the first word address |
| 165 | MOV SI, AX ; Enter the function body (set si) |
| 166 | NEXT |
| 167 | |
| 168 | |
| 169 | ;; Interpret raw code (plain machine code) |
| 170 | INTRAW: |
| 171 | ADD AX, WORDSZ |
| 172 | JMP AX |
| 173 | |
| 174 | |
| 175 | INDIRECT_START: |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 176 | DW SETUP |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 177 | DW QUIT |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 178 | |
| 179 | |
| 180 | SETUP: |
| 181 | DW INTRAW |
| 182 | |
| 183 | MOV DX, MSG |
| 184 | WRITESOUT |
| 185 | |
| 186 | NEXT |
| 187 | |
| 188 | LITERAL: |
| 189 | DW INTRAW |
| 190 | |
| 191 | LODSW ; Load the next word |
| 192 | PUSH AX |
| 193 | |
| 194 | NEXT |
| 195 | |
| 196 | |
| 197 | EXIT: |
| 198 | DW INTRAW |
| 199 | RSPOP SI |
| 200 | NEXT |
| 201 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 202 | |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 203 | DEFWORD_RAW BYE, 'BYE' |
swissChili | b921e82 | 2022-04-20 19:47:33 -0700 | [diff] [blame] | 204 | MOV DX, .BYE_MSG |
| 205 | WRITESOUT |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 206 | FLUSH |
| 207 | QUIT_PROC |
| 208 | |
swissChili | b921e82 | 2022-04-20 19:47:33 -0700 | [diff] [blame] | 209 | .BYE_MSG: |
| 210 | DB 'Bye!', 0Dh, 0Ah, '$' |
| 211 | |
| 212 | |
| 213 | DEFWORD_THREADED IMG_DUMPED, 'IMG-DUMPED' |
| 214 | INCLUDE_STRING 'Image dumped!' |
| 215 | DW TYPE, CR, EXIT |
| 216 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 217 | |
| 218 | DEFWORD_RAW LIT, 'LIT' |
| 219 | LODSW ; Read next word from input to AX |
| 220 | PUSH AX |
| 221 | NEXT |
| 222 | |
| 223 | |
| 224 | DEFWORD_RAW DROP, 'DROP' |
| 225 | ADD SP, WORDSZ |
| 226 | NEXT |
| 227 | |
| 228 | |
| 229 | DEFWORD_RAW SWAP, 'SWAP' |
| 230 | POP AX |
| 231 | POP BX |
| 232 | PUSH AX |
| 233 | PUSH BX |
| 234 | NEXT |
| 235 | |
| 236 | |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame^] | 237 | ;; a b -- a b a |
| 238 | DEFWORD_RAW OVER, 'OVER' |
| 239 | POP BX |
| 240 | POP AX |
| 241 | PUSH AX |
| 242 | PUSH BX |
| 243 | PUSH AX |
| 244 | NEXT |
| 245 | |
| 246 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 247 | DEFWORD_RAW DUP, 'DUP' |
| 248 | ;; This is stupid, [SP] is invalid |
| 249 | POP AX |
| 250 | PUSH AX |
| 251 | PUSH AX |
| 252 | NEXT |
| 253 | |
| 254 | |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame^] | 255 | DEFWORD_RAW TO_RET, '>R' |
| 256 | POP AX |
| 257 | RSPUSH AX |
| 258 | NEXT |
| 259 | |
| 260 | |
| 261 | DEFWORD_RAW FROM_RET, 'R>' |
| 262 | RSPOP AX |
| 263 | PUSH AX |
| 264 | NEXT |
| 265 | |
| 266 | |
| 267 | ;; ( a b c -- b c a ) |
| 268 | DEFWORD_RAW ROT, 'ROT' |
| 269 | POP CX |
| 270 | POP BX |
| 271 | POP AX |
| 272 | PUSH BX |
| 273 | PUSH CX |
| 274 | PUSH AX |
| 275 | NEXT |
| 276 | |
| 277 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 278 | DEFWORD_RAW PLUS, '+' |
| 279 | POP AX |
| 280 | POP BX |
| 281 | ADD AX, BX |
| 282 | PUSH AX |
| 283 | NEXT |
| 284 | |
| 285 | |
| 286 | DEFWORD_RAW MINUS, '-' ; ( DX AX -- DX-AX ) |
| 287 | POP AX |
| 288 | POP DX |
| 289 | SUB DX, AX |
| 290 | PUSH DX |
| 291 | NEXT |
| 292 | |
| 293 | |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 294 | DEFWORD_RAW SLASHMOD, '/MOD' |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 295 | POP AX |
swissChili | 94f1e76 | 2022-01-29 21:55:45 -0800 | [diff] [blame] | 296 | POP DX |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 297 | IDIV DX |
| 298 | PUSH DX ; Remainder |
| 299 | PUSH AX ; Quotient |
| 300 | NEXT |
| 301 | |
| 302 | |
| 303 | DEFWORD_RAW _TIMES, '*' |
| 304 | POP AX |
| 305 | POP DX |
| 306 | IMUL DX |
| 307 | PUSH AX |
| 308 | NEXT |
| 309 | |
| 310 | |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 311 | DEFWORD_RAW AND, 'AND' |
| 312 | POP AX |
| 313 | POP DX |
| 314 | AND AX, DX |
| 315 | PUSH AX |
| 316 | NEXT |
| 317 | |
| 318 | |
| 319 | DEFWORD_RAW XOR, 'XOR' |
| 320 | POP DX |
| 321 | POP AX |
| 322 | XOR AX, DX |
| 323 | PUSH AX |
| 324 | NEXT |
| 325 | |
| 326 | |
| 327 | DEFWORD_RAW NOT, 'NOT' |
| 328 | POP AX |
| 329 | NOT AX |
| 330 | PUSH AX |
| 331 | NEXT |
| 332 | |
| 333 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 334 | DEFWORD_RAW ADD1, '1+' |
| 335 | POP AX |
| 336 | ADD AX, 1 |
| 337 | PUSH AX |
| 338 | NEXT |
| 339 | |
| 340 | |
| 341 | DEFWORD_RAW ADD2, '2+' |
| 342 | POP AX |
| 343 | ADD AX, 2 |
| 344 | PUSH AX |
| 345 | NEXT |
| 346 | |
| 347 | |
| 348 | ;; This kind of sucks |
| 349 | DEFWORD_RAW _2DUP, '2DUP' ; ( a b -- a b a b ) |
| 350 | POP AX |
| 351 | POP BX |
| 352 | PUSH BX |
| 353 | PUSH AX |
| 354 | PUSH BX |
| 355 | PUSH AX |
| 356 | NEXT |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 357 | |
| 358 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 359 | %INCLUDE "IOWORDS.ASM" |
| 360 | %INCLUDE "DICTNRY.ASM" |
| 361 | |
| 362 | ;;; LATE-INIT VARIABLES ;;; |
| 363 | DEFVAR STATE, 'STATE' |
swissChili | ce85f57 | 2022-04-20 16:54:34 -0700 | [diff] [blame] | 364 | DW 0 ; Interpret; ( cfa ) |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 365 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 366 | |
| 367 | DEFVAR HERE, 'HERE' |
| 368 | DW HERE_START |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 369 | |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 370 | |
| 371 | DEFCONST SP_INITIAL, 'S0' |
| 372 | DW 0 |
| 373 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 374 | |
| 375 | ;; LATEST must be the last word defined in FORTH.ASM! |
| 376 | DEFVAR LATEST, 'LATEST' |
| 377 | DW LINK |
| 378 | |
| 379 | |
| 380 | ;;; PROGRAM DATA ;;; |
| 381 | MSG DB 'DOS FORTH', 0Dh, 0Ah, '$' |
| 382 | |
| 383 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 384 | ;;; FREE DATA ;;; |
swissChili | e4d2e28 | 2022-01-04 22:22:27 -0800 | [diff] [blame] | 385 | ALIGN 4 |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 386 | HERE_START: |