swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 1 | ;;; Assembly definitions of built-in Forth words |
| 2 | ;;; Assume this is included after all the relevant macros |
| 3 | |
| 4 | |
| 5 | ;;; INPUT & OUTPUT ROUTINES ;;; |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 6 | ;; Stack of input file pointers |
swissChili | 7156d51 | 2022-04-22 22:19:55 -0700 | [diff] [blame] | 7 | KEY_INP_STACK TIMES 32 DW 0 |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 8 | |
| 9 | ;; Top of the stack |
| 10 | DEFVAR INP_SP, 'INP-SP' |
| 11 | KEY_INP_STACKP: |
| 12 | DW KEY_INP_STACK |
| 13 | |
| 14 | |
| 15 | ;; ( handle -- ) |
| 16 | DEFWORD_RAW SEEK_START, 'SEEK-START' |
| 17 | XOR AL, AL |
| 18 | POP BX |
| 19 | XOR CX, CX |
| 20 | XOR DX, DX |
| 21 | SEEKF |
| 22 | NEXT |
| 23 | |
| 24 | |
| 25 | ;; ( *str len -- ) |
| 26 | ;; Opens the file specified by *str and len for reading and adds it |
| 27 | ;; to the input stack. |
| 28 | DEFWORD_THREADED INCLUDED, 'INCLUDED' |
| 29 | DW TO_RET, TO_RET ; ( ) [ len *str ] |
| 30 | DW LITERAL, F_READ ; ( flags ) |
| 31 | DW FROM_RET, FROM_RET ; ( flags *str len ) [ ] |
| 32 | DW OPEN_FILE_NAMED ; ( handle ) |
| 33 | DW DUP, SEEK_START ; ( handle ) |
| 34 | DW INP_SP ; ( handle *inp-sp ) |
| 35 | DW GET, ADD2 ; ( handle inp-sp+2 ) |
| 36 | DW SWAP, OVER ; ( inp-sp+2 handle inp-sp+2 ) |
| 37 | DW SET ; ( inp-sp+2 ) |
| 38 | DW INP_SP ; ( inp-sp+2 *inp-sp ) |
| 39 | DW SET, EXIT ; ( ) |
| 40 | |
| 41 | |
| 42 | DEFWORD_THREADED INCLUDE, 'INCLUDE' |
| 43 | DW _WORD, INCLUDED, EXIT |
| 44 | |
| 45 | |
| 46 | KEY_INP_BUF: |
| 47 | DW 0 |
| 48 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 49 | ;; Read a key from the input. If STDIN is blank wait for a key |
| 50 | ;; press. |
| 51 | ;; |
| 52 | ;; TODO: Keep an internal buffer until RETURN is pressed, allow |
| 53 | ;; some line editing. |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 54 | DEFWORD_RAW KEY, 'KEY' |
| 55 | CALL READ_KEY |
| 56 | PUSH AX |
| 57 | NEXT |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 58 | |
swissChili | 7156d51 | 2022-04-22 22:19:55 -0700 | [diff] [blame] | 59 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 60 | ;; This routine returns the key in AL, but Forth wants it on the |
| 61 | ;; stack, so we have a helper function. |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 62 | ;; |
| 63 | ;; Clobbers: BX, CX |
| 64 | ;; Return: AX |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 65 | READ_KEY: |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 66 | MOV BX, [KEY_INP_STACKP] ; Address of current input file handle |
| 67 | MOV BX, [BX] |
| 68 | TEST BX, BX |
| 69 | JZ .READ_STDIN ; If the file handle is 0 |
| 70 | |
| 71 | MOV CX, 1 ; We're reading 1 byte from a file |
| 72 | MOV DX, KEY_INP_BUF ; Write to our temporary buffer |
| 73 | READF |
| 74 | |
| 75 | JC .READ_ERR ; CF - general read error |
| 76 | TEST AX, AX |
| 77 | JZ .READ_ERR ; AX=0 - at EOF |
| 78 | |
| 79 | MOV AX, [KEY_INP_BUF] |
| 80 | |
| 81 | RET |
| 82 | |
| 83 | .READ_ERR: |
swissChili | 7156d51 | 2022-04-22 22:19:55 -0700 | [diff] [blame] | 84 | ;; BX already holds the file handle |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 85 | CLOSEF ; Close the input stream |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 86 | MOV BX, [KEY_INP_STACKP] |
| 87 | SUB BX, 2 ; Pop off input stack |
| 88 | MOV [KEY_INP_STACKP], BX |
| 89 | JMP READ_KEY ; Re-try reading the key |
| 90 | |
| 91 | .READ_STDIN: |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 92 | READCIN |
| 93 | XOR AH, AH ; We don't care about the scan code |
| 94 | RET |
| 95 | |
| 96 | |
| 97 | %MACRO WHITESPACE 2 |
| 98 | CMP %1, ' ' |
| 99 | JE %2 |
| 100 | |
| 101 | CMP %1, 09h ; \t |
| 102 | JE %2 |
| 103 | |
| 104 | CMP %1, 0Ah ; \n |
| 105 | JE %2 |
| 106 | |
| 107 | CMP %1, 0Dh ; \r |
| 108 | JE %2 |
| 109 | %ENDMACRO |
| 110 | |
| 111 | |
| 112 | ;; Read a word from the input, max 32 bytes. WORD is reserved in |
| 113 | ;; NASM sadly. |
| 114 | DEFWORD_RAW _WORD, 'WORD' |
| 115 | READ_WORD: |
| 116 | MOV DI, WORD_BUFFER |
| 117 | |
| 118 | .START: |
| 119 | ;; First skip whitespace |
| 120 | CALL READ_KEY ; Char in AL |
| 121 | |
| 122 | WHITESPACE AL, .START |
| 123 | CMP AL, '\' |
| 124 | JE .COMMENT |
| 125 | |
| 126 | .LOOP: |
| 127 | CMP AL, 'a' |
| 128 | JL .STORE |
| 129 | CMP AL, 'z' |
| 130 | JG .STORE |
| 131 | |
| 132 | SUB AL, ('a' - 'A') ; To upper case |
| 133 | |
| 134 | .STORE: |
| 135 | STOSB ; Buffer char |
| 136 | |
| 137 | CALL READ_KEY |
| 138 | WHITESPACE AL, .DONE |
| 139 | JMP .LOOP |
| 140 | |
| 141 | .COMMENT: |
| 142 | CALL READ_KEY |
swissChili | e4d2e28 | 2022-01-04 22:22:27 -0800 | [diff] [blame] | 143 | CMP AL, ASCII_NEWLINE |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 144 | JE .START |
swissChili | e4d2e28 | 2022-01-04 22:22:27 -0800 | [diff] [blame] | 145 | CMP AL, ASCII_RETURN |
| 146 | JE .START |
| 147 | |
| 148 | JMP .COMMENT |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 149 | |
| 150 | .DONE: |
| 151 | SUB DI, WORD_BUFFER ; Length |
| 152 | PUSH WORD_BUFFER |
| 153 | PUSH DI |
| 154 | |
| 155 | NEXT |
| 156 | |
| 157 | |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 158 | DEFWORD_RAW_IMMEDIATE LPAREN, '(' |
| 159 | .LOOP: |
| 160 | CALL READ_KEY |
| 161 | CMP AL, ')' |
| 162 | JNE .LOOP |
| 163 | NEXT |
| 164 | |
| 165 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 166 | ;; ( string len -- num unparsed ) |
| 167 | DEFWORD_RAW NUMBER, 'NUMBER' |
| 168 | POP DX ; Length |
| 169 | POP BX ; Index |
| 170 | ADD DX, BX ; End pointer |
| 171 | XOR AX, AX ; The number |
| 172 | |
| 173 | XOR CX, CX ; CL - used for char |
| 174 | |
| 175 | .LOOP: |
| 176 | MOV CL, BYTE [BX] |
| 177 | CMP CL, '0' |
| 178 | JL .DONE |
| 179 | CMP CL, '9' |
| 180 | JG .DONE |
| 181 | |
| 182 | SUB CL, '0' |
| 183 | MOV CH, 10 ; This needs to be reset each time |
| 184 | ; which is annoying |
| 185 | IMUL CH ; 8-bit IMUL operand means that the |
| 186 | ; result is just in AX, not extended |
| 187 | ; by DX. Perfect |
| 188 | XOR CH, CH |
| 189 | ADD AX, CX |
| 190 | INC BX |
| 191 | CMP BX, DX |
| 192 | JL .LOOP |
| 193 | |
| 194 | .DONE: |
| 195 | SUB DX, BX ; Number of chars unread |
| 196 | PUSH AX |
| 197 | PUSH DX |
| 198 | NEXT |
| 199 | |
| 200 | |
| 201 | ;; Emit a char from the stack |
| 202 | DEFWORD_RAW EMIT, 'EMIT' |
| 203 | POP DX |
| 204 | WRITECOUT |
| 205 | NEXT |
| 206 | |
| 207 | |
| 208 | DEFWORD_RAW CR, 'CR' |
| 209 | MOV DX, CRLF_MSG |
| 210 | WRITESOUT |
| 211 | NEXT |
| 212 | |
| 213 | |
swissChili | f8849dc | 2021-12-31 23:15:57 -0800 | [diff] [blame] | 214 | DEFWORD_THREADED SPACE, 'SPACE' |
| 215 | DW LITERAL, ' ', EMIT, EXIT |
| 216 | |
| 217 | |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 218 | DEFWORD_RAW TYPE, 'TYPE' |
| 219 | TYPE_STRING: |
| 220 | POP CX ; Length |
| 221 | POP BX ; Index |
| 222 | ADD CX, BX ; End pointer |
| 223 | |
| 224 | .LOOP: |
| 225 | MOV DL, BYTE [BX] |
| 226 | WRITECOUT |
| 227 | |
| 228 | INC BX |
| 229 | CMP BX, CX |
| 230 | JNE .LOOP |
| 231 | |
| 232 | .DONE: |
| 233 | NEXT |
| 234 | |
| 235 | |
| 236 | ;; ( n -- ) |
| 237 | DEFWORD_RAW DOT, '.' |
| 238 | POP AX ; The number |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 239 | CALL DOT_INT |
| 240 | NEXT |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 241 | |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 242 | ;; AX - number to print |
| 243 | ;; Clobbers: DX, BX, CX |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 244 | DOT_INT: |
| 245 | TEST AX, AX |
| 246 | JNZ .START |
| 247 | |
| 248 | MOV DX, '0' |
| 249 | WRITECOUT |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 250 | RET |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 251 | |
| 252 | .START: |
| 253 | MOV BX, 10 ; The base |
| 254 | |
| 255 | ;; TODO: BUG: Depending on this value there is a maximum number |
| 256 | ;; that this routine will format, which is weird. For the value of |
| 257 | ;; 7 it is 1280. |
| 258 | MOV CX, 7 |
| 259 | .LOOP: |
| 260 | XOR DX, DX |
| 261 | DIV BX ; AX = quotient; DX = remainder |
| 262 | PUSH DX |
| 263 | |
| 264 | LOOP .LOOP |
| 265 | |
| 266 | MOV CX, 7 |
| 267 | XOR BX, BX ; At start |
| 268 | .REVERSE: |
| 269 | POP DX |
| 270 | OR BL, DL |
| 271 | JZ .END |
| 272 | |
| 273 | ADD DL, '0' |
| 274 | WRITECOUT |
| 275 | |
| 276 | .END: |
| 277 | LOOP .REVERSE |
| 278 | |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 279 | RET |
| 280 | |
| 281 | |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 282 | ;; Write a string to the PAD and 0-terminate it. For use with DOS |
| 283 | ;; I/O words that require ASCIZ strings. |
| 284 | ;; |
| 285 | ;; CX - string length |
| 286 | ;; BX - start of string |
| 287 | ;; Clobbers: none |
| 288 | ;; Returns: BX - address of temporary string |
| 289 | MAKE_STRING_ASCIZ: |
| 290 | PUSH SI |
| 291 | PUSH DI |
| 292 | PUSH CX |
| 293 | |
| 294 | MOV SI, BX |
| 295 | GET_PAD DI |
| 296 | PUSH DI ; Save start of temp string |
| 297 | REP MOVSB ; Copy bytes |
| 298 | MOV BYTE [DI], 0 ; 0-terminate |
| 299 | POP BX ; Return start in BX |
| 300 | |
| 301 | POP CX |
| 302 | POP DI |
| 303 | POP SI |
| 304 | |
| 305 | RET |
| 306 | |
| 307 | ;; ( flags *start len -- ) |
| 308 | DEFWORD_RAW CREATE_FILE_NAMED, 'CREATE-FILE-NAMED' |
| 309 | POP CX ; Len |
| 310 | POP BX ; Start |
| 311 | CALL MAKE_STRING_ASCIZ |
| 312 | POP CX ; Flags |
| 313 | MOV DX, BX |
| 314 | CREATF |
| 315 | NEXT |
| 316 | |
| 317 | |
| 318 | ;; ( flags -- ) CREATE-FILE <file-name> |
| 319 | DEFWORD_THREADED CREATE_FILE, 'CREATE-FILE' |
| 320 | DW _WORD, CREATE_FILE_NAMED, EXIT |
| 321 | |
| 322 | |
swissChili | 94f1e76 | 2022-01-29 21:55:45 -0800 | [diff] [blame] | 323 | ;; ( flags *start len -- handle ) |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 324 | DEFWORD_RAW OPEN_FILE_NAMED, 'OPEN-FILE-NAMED' |
| 325 | POP CX ; Length |
| 326 | POP BX ; Start |
swissChili | e1abd07 | 2022-04-22 22:07:42 -0700 | [diff] [blame] | 327 | CALL MAKE_STRING_ASCIZ |
| 328 | MOV DX, BX ; ASCIZ string in DX |
| 329 | POP AX ; Flags |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 330 | OPENF |
| 331 | |
| 332 | JC FILE_WRITE_ERROR |
| 333 | PUSH AX |
| 334 | NEXT |
| 335 | |
| 336 | FILE_WRITE_ERROR: |
| 337 | MOV DX, MSG_OPENF_FAILED |
| 338 | WRITESOUT |
| 339 | PUSH AX |
| 340 | NEXT |
| 341 | |
| 342 | |
| 343 | ;; ( flags -- handle ) |
| 344 | DEFWORD_THREADED OPEN_FILE, 'OPEN-FILE' |
| 345 | DW _WORD ; ( flags *str len ) |
| 346 | DW OPEN_FILE_NAMED |
| 347 | DW EXIT |
| 348 | |
| 349 | |
| 350 | DEFWORD_RAW CLOSE_FILE, 'CLOSE-FILE' |
| 351 | POP BX |
| 352 | CLOSEF |
| 353 | NEXT |
| 354 | |
| 355 | |
| 356 | ;; Write word to file |
| 357 | ;; ( cell handle -- ) |
| 358 | DEFWORD_RAW FILE_COMMA, 'F,' |
| 359 | POP BX ; Handle |
| 360 | POP DX ; Data |
| 361 | MOV WORD [FILE_WRITE_BUFFER], DX |
| 362 | MOV DX, FILE_WRITE_BUFFER ; Address |
| 363 | MOV CX, 2 ; Length |
| 364 | WRITEF |
| 365 | JC FILE_WRITE_ERROR |
| 366 | NEXT |
| 367 | |
| 368 | |
| 369 | ;; ( byte handle -- ) |
| 370 | DEFWORD_RAW FILE_CHAR_COMMA, 'FC,' |
| 371 | POP BX |
| 372 | POP DX |
| 373 | MOV BYTE [FILE_WRITE_BUFFER], DL |
| 374 | MOV DX, FILE_WRITE_BUFFER |
| 375 | MOV CX, 1 |
| 376 | WRITEF |
| 377 | JC FILE_WRITE_ERROR |
| 378 | NEXT |
| 379 | |
| 380 | |
| 381 | ;; ( *start *end handle -- ) |
| 382 | DEFWORD_RAW FILE_WRITE_RANGE, 'FWRITE-RANGE' |
| 383 | POP BX |
| 384 | POP CX ; End |
| 385 | POP DX |
| 386 | SUB CX, DX ; Get difference |
| 387 | WRITEF |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 388 | NEXT |
| 389 | |
| 390 | |
| 391 | ;;; DATA ;;; |
| 392 | CRLF_MSG DB ASCII_RETURN, ASCII_NEWLINE, '$' |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 393 | MSG_OPENF_FAILED DB 'File error', ASCII_RETURN, ASCII_NEWLINE, '$' |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 394 | |
swissChili | 7c626b9 | 2022-01-01 23:35:39 -0800 | [diff] [blame] | 395 | WORD_BUFFER TIMES 33 DB 0 |
| 396 | FILE_WRITE_BUFFER DW 0 |
swissChili | f7f1e2b | 2021-12-31 14:42:43 -0800 | [diff] [blame] | 397 | WORD_BUFFER_END: |