Better interpreter, IO, DUMP-IMAGE
diff --git a/CORE.F b/CORE.F
new file mode 100644
index 0000000..67607a1
--- /dev/null
+++ b/CORE.F
@@ -0,0 +1,6 @@
+\ Core words for DOS FORTH
+
+: / /MOD SWAP DROP ;
+: A 10 ;
+
+A . BYE
diff --git a/DICTNRY.ASM b/DICTNRY.ASM
index 5bb97cb..c7edce4 100644
--- a/DICTNRY.ASM
+++ b/DICTNRY.ASM
@@ -1,5 +1,5 @@
;;; Dictionary manipulation & memory management words
-
+
;; ( addr len -- entry? )
DEFWORD_RAW FIND, 'FIND'
POP CX ; String length
@@ -20,7 +20,7 @@
MOV BX, WORD [BX] ; Offset 0 = *LINK
TEST BX, BX
JNZ .LOOP ; If BX is 0 (end) fall through
-
+
.MATCH:
PUSH BX ; BX holds dict entry
NEXT
@@ -142,7 +142,6 @@
DEFWORD_THREADED CREATE, 'CREATE'
DW HERE, GET ; ( *here )
DW _WORD ; ( *here *string length )
- DW _2DUP, TYPE, SPACE ; ( *here *string length )
DW LATEST, GET ; ( *here *string length link )
DW COMMA, DUP, CHAR_COMMA ; ( *here *string length )
DW CMOVE_HERE ; ( *here )
@@ -354,3 +353,45 @@
RELATIVE_ADDRESS .LOOP
.DONE:
DW CR, EXIT
+
+
+ DEFWORD_RAW SHOW_STACK, '.S'
+ MOV CX, WORD [CONST_SP_INITIAL]
+ RSPUSH SI
+ STD ; Go backwards
+
+ MOV SI, CX ; Going down
+ SUB SI, 2 ; Just below it
+ SUB CX, SP ; Number of bytes on the stack
+ JLE .DONE ; Below stack bottom (oops!)
+ SHR CX, 1 ; Divide by 2 -- number of cells
+
+.LOOP:
+ LODSW
+ PUSH CX ; Clobbered
+ CALL DOT_INT
+ POP CX
+
+ MOV DX, ' '
+ WRITECOUT
+
+ LOOP .LOOP
+
+.DONE:
+ MOV DX, CRLF_MSG
+ WRITESOUT
+
+ RSPOP SI
+ CLD
+ NEXT
+
+
+ DEFWORD_THREADED DUMP_IMAGE, 'DUMP-IMAGE'
+ DW LITERAL, F_WRITE ; ( *string len flags )
+ DW OPEN_FILE ; ( handle )
+ DW DUP ; ( handle handle )
+ DW LITERAL, 100h ; ( handle handle *start )
+ DW SWAP, HERE, GET ; ( handle *start handle *here )
+ DW SWAP, FILE_WRITE_RANGE ; ( handle )
+ DW CLOSE_FILE ; ( )
+ DW EXIT
diff --git a/DOS.ASM b/DOS.ASM
index 646ac7a..ed5d2e9 100644
--- a/DOS.ASM
+++ b/DOS.ASM
@@ -32,3 +32,29 @@
%DEFINE ASCII_RETURN 0Dh
%DEFINE ASCII_NEWLINE 0Ah
+
+ %DEFINE F_READ 0
+ %DEFINE F_WRITE 1
+ %DEFINE F_READ_WRITE 2
+
+ ;; DX - null-terminated file name
+ ;; AL - flags
+ %MACRO OPENF 0
+ MOV AH, 3Dh
+ INT 21h
+ %ENDMACRO
+
+ %MACRO WRITEF 0
+ MOV AH, 40h
+ INT 21h
+ %ENDMACRO
+
+ %MACRO CLOSEF 0
+ MOV AH, 3Eh
+ INT 21h
+ %ENDMACRO
+
+ %MACRO CREATF 0
+ MOV AH, 3Ch
+ INT 21h
+ %ENDMACRO
diff --git a/FORTH.ASM b/FORTH.ASM
index 6ec3fcd..5dd77a7 100644
--- a/FORTH.ASM
+++ b/FORTH.ASM
@@ -107,11 +107,11 @@
%ENDMACRO
- %MACRO DEFCONST 3
+ %MACRO DEFCONST 2
DEFWORD_RAW %1, %2
- PUSH CONST_%1
+ PUSH WORD [CONST_%1]
NEXT
- CONST_%1 EQU %3
+CONST_%1:
%ENDMACRO
@@ -135,8 +135,9 @@
_START:
;; Progran begins
MOV BP, SP
- SUB BP, 1024 ; why can't I use SP as a base for
- ; load effective address?
+ SUB BP, 1024
+ MOV WORD [CONST_SP_INITIAL], SP
+
MOV SI, INDIRECT_START
NEXT
@@ -192,8 +193,7 @@
JMP DOT_INT
- ;; TODO: should not be immediate, that's just for debugging
- DEFWORD_RAW_IMMEDIATE BYE, 'BYE'
+ DEFWORD_RAW BYE, 'BYE'
FLUSH
QUIT_PROC
@@ -241,6 +241,23 @@
NEXT
+ DEFWORD_RAW SLASHMOD, '/MOD'
+ POP DX
+ POP AX
+ IDIV DX
+ PUSH DX ; Remainder
+ PUSH AX ; Quotient
+ NEXT
+
+
+ DEFWORD_RAW _TIMES, '*'
+ POP AX
+ POP DX
+ IMUL DX
+ PUSH AX
+ NEXT
+
+
DEFWORD_RAW AND, 'AND'
POP AX
POP DX
@@ -287,6 +304,41 @@
PUSH BX
PUSH AX
NEXT
+
+
+ DEFWORD_RAW TEST_WRITE_FILE, 'TEST-WRITE-FILE'
+ MOV AL, F_WRITE
+ MOV DX, DUMP
+ OPENF
+ JC .OPEN
+
+ MOV BX, AX ; Handle
+ MOV CX, 4
+ MOV DX, DUMP
+ WRITEF
+ JC .WRITE
+
+ CLOSEF
+ JC .CLOSE
+
+ NEXT
+
+.OPEN:
+ MOV DX, MSG_OPENF_FAILED
+ WRITESOUT
+ NEXT
+
+.WRITE:
+ ;; 06h - invalid handle
+ PUSH AX
+ MOV DX, MSG_WRITEF_FAILED
+ WRITESOUT
+ NEXT
+
+.CLOSE:
+ MOV DX, MSG_CLOSEF_FAILED
+ WRITESOUT
+ NEXT
%INCLUDE "IOWORDS.ASM"
@@ -300,6 +352,10 @@
DEFVAR HERE, 'HERE'
DW HERE_START
+
+ DEFCONST SP_INITIAL, 'S0'
+ DW 0
+
;; LATEST must be the last word defined in FORTH.ASM!
DEFVAR LATEST, 'LATEST'
@@ -308,6 +364,11 @@
;;; PROGRAM DATA ;;;
MSG DB 'DOS FORTH', 0Dh, 0Ah, '$'
+ DUMP DB 'DUMP.COM', 0
+ DUMP_LEN EQU 8
+
+ MSG_CLOSEF_FAILED DB 'CLOSEF FAILED', 0Dh, 0Ah, '$'
+ MSG_WRITEF_FAILED DB 'WRITEF FAILED', 0Dh, 0Ah, '$'
ALIGN 4
diff --git a/IOWORDS.ASM b/IOWORDS.ASM
index d1cea38..b938137 100644
--- a/IOWORDS.ASM
+++ b/IOWORDS.ASM
@@ -18,17 +18,6 @@
;; This routine returns the key in AL, but Forth wants it on the
;; stack, so we have a helper function.
READ_KEY:
- GETSTDINSTATUS
- TEST AL, AL
- JZ .EOF
-
- READCIN
- XOR AH, AH ; We get the result in AL but we want
- ; the whole word to be the correct
- ; char.
- RET
-
-.EOF: ; End of STDIN
;; Check if line buffer is empty
READCIN
XOR AH, AH ; We don't care about the scan code
@@ -93,6 +82,14 @@
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
@@ -166,6 +163,8 @@
;; ( n -- )
DEFWORD_RAW DOT, '.'
POP AX ; The number
+ CALL DOT_INT
+ NEXT
DOT_INT:
TEST AX, AX
@@ -173,7 +172,7 @@
MOV DX, '0'
WRITECOUT
- NEXT
+ RET
.START:
MOV BX, 10 ; The base
@@ -202,11 +201,85 @@
.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 32 DB 0
+ WORD_BUFFER TIMES 33 DB 0
+ FILE_WRITE_BUFFER DW 0
WORD_BUFFER_END: