blob: b9381373cbc64e792aa40e2380742c5999126935 [file] [log] [blame]
;;; Assembly definitions of built-in Forth words
;;; Assume this is included after all the relevant macros
;;; INPUT & OUTPUT ROUTINES ;;;
;; Read a key from the input. If STDIN is blank wait for a key
;; press.
;;
;; TODO: Keep an internal buffer until RETURN is pressed, allow
;; some line editing.
;;
;; Actually, that could be implemented in Forth for simplicity.
DEFWORD_RAW KEY, 'KEY'
CALL READ_KEY
PUSH AX
NEXT
;; This routine returns the key in AL, but Forth wants it on the
;; stack, so we have a helper function.
READ_KEY:
;; Check if line buffer is empty
READCIN
XOR AH, AH ; We don't care about the scan code
RET
%MACRO WHITESPACE 2
CMP %1, ' '
JE %2
CMP %1, 09h ; \t
JE %2
CMP %1, 0Ah ; \n
JE %2
CMP %1, 0Dh ; \r
JE %2
%ENDMACRO
;; Read a word from the input, max 32 bytes. WORD is reserved in
;; NASM sadly.
DEFWORD_RAW _WORD, 'WORD'
READ_WORD:
MOV DI, WORD_BUFFER
.START:
;; First skip whitespace
CALL READ_KEY ; Char in AL
WHITESPACE AL, .START
CMP AL, '\'
JE .COMMENT
.LOOP:
CMP AL, 'a'
JL .STORE
CMP AL, 'z'
JG .STORE
SUB AL, ('a' - 'A') ; To upper case
.STORE:
STOSB ; Buffer char
CALL READ_KEY
WHITESPACE AL, .DONE
JMP .LOOP
.COMMENT:
CALL READ_KEY
CMP AL, ASCII_RETURN
JNE .COMMENT
JE .START
.DONE:
SUB DI, WORD_BUFFER ; Length
PUSH WORD_BUFFER
PUSH DI
NEXT
DEFWORD_RAW_IMMEDIATE LPAREN, '('
.LOOP:
CALL READ_KEY
CMP AL, ')'
JNE .LOOP
NEXT
;; ( string len -- num unparsed )
DEFWORD_RAW NUMBER, 'NUMBER'
POP DX ; Length
POP BX ; Index
ADD DX, BX ; End pointer
XOR AX, AX ; The number
XOR CX, CX ; CL - used for char
.LOOP:
MOV CL, BYTE [BX]
CMP CL, '0'
JL .DONE
CMP CL, '9'
JG .DONE
SUB CL, '0'
MOV CH, 10 ; This needs to be reset each time
; which is annoying
IMUL CH ; 8-bit IMUL operand means that the
; result is just in AX, not extended
; by DX. Perfect
XOR CH, CH
ADD AX, CX
INC BX
CMP BX, DX
JL .LOOP
.DONE:
SUB DX, BX ; Number of chars unread
PUSH AX
PUSH DX
NEXT
;; Emit a char from the stack
DEFWORD_RAW EMIT, 'EMIT'
POP DX
WRITECOUT
NEXT
DEFWORD_RAW CR, 'CR'
MOV DX, CRLF_MSG
WRITESOUT
NEXT
DEFWORD_THREADED SPACE, 'SPACE'
DW LITERAL, ' ', EMIT, EXIT
DEFWORD_RAW TYPE, 'TYPE'
TYPE_STRING:
POP CX ; Length
POP BX ; Index
ADD CX, BX ; End pointer
.LOOP:
MOV DL, BYTE [BX]
WRITECOUT
INC BX
CMP BX, CX
JNE .LOOP
.DONE:
NEXT
;; ( n -- )
DEFWORD_RAW DOT, '.'
POP AX ; The number
CALL DOT_INT
NEXT
DOT_INT:
TEST AX, AX
JNZ .START
MOV DX, '0'
WRITECOUT
RET
.START:
MOV BX, 10 ; The base
;; TODO: BUG: Depending on this value there is a maximum number
;; that this routine will format, which is weird. For the value of
;; 7 it is 1280.
MOV CX, 7
.LOOP:
XOR DX, DX
DIV BX ; AX = quotient; DX = remainder
PUSH DX
LOOP .LOOP
MOV CX, 7
XOR BX, BX ; At start
.REVERSE:
POP DX
OR BL, DL
JZ .END
ADD DL, '0'
WRITECOUT
.END:
LOOP .REVERSE
RET
;; ( flags *start len )
DEFWORD_RAW OPEN_FILE_NAMED, 'OPEN-FILE-NAMED'
POP CX ; Length
POP BX ; Start
MOV DX, BX
ADD BX, CX
MOV BYTE [BX], 0
POP CX ; Flags
CREATF
MOV AX, CX ; Flags
OPENF
JC FILE_WRITE_ERROR
PUSH AX
NEXT
FILE_WRITE_ERROR:
MOV DX, MSG_OPENF_FAILED
WRITESOUT
PUSH AX
NEXT
;; ( flags -- handle )
DEFWORD_THREADED OPEN_FILE, 'OPEN-FILE'
DW _WORD ; ( flags *str len )
DW OPEN_FILE_NAMED
DW EXIT
DEFWORD_RAW CLOSE_FILE, 'CLOSE-FILE'
POP BX
CLOSEF
NEXT
;; Write word to file
;; ( cell handle -- )
DEFWORD_RAW FILE_COMMA, 'F,'
POP BX ; Handle
POP DX ; Data
MOV WORD [FILE_WRITE_BUFFER], DX
MOV DX, FILE_WRITE_BUFFER ; Address
MOV CX, 2 ; Length
WRITEF
JC FILE_WRITE_ERROR
NEXT
;; ( byte handle -- )
DEFWORD_RAW FILE_CHAR_COMMA, 'FC,'
POP BX
POP DX
MOV BYTE [FILE_WRITE_BUFFER], DL
MOV DX, FILE_WRITE_BUFFER
MOV CX, 1
WRITEF
JC FILE_WRITE_ERROR
NEXT
;; ( *start *end handle -- )
DEFWORD_RAW FILE_WRITE_RANGE, 'FWRITE-RANGE'
POP BX
POP CX ; End
POP DX
SUB CX, DX ; Get difference
WRITEF
NEXT
;;; DATA ;;;
CRLF_MSG DB ASCII_RETURN, ASCII_NEWLINE, '$'
MSG_OPENF_FAILED DB 'File error', ASCII_RETURN, ASCII_NEWLINE, '$'
WORD_BUFFER TIMES 33 DB 0
FILE_WRITE_BUFFER DW 0
WORD_BUFFER_END: