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