DICTNRY.ASM

;;; Dictionary manipulation & memory management words

	;; ( addr len -- entry? )
	DEFWORD_RAW FIND, 'FIND'
	POP CX						; String length
	POP DI						; Start pointer
	MOV BX, WORD [VAR_LATEST]

.LOOP:
	;; BX and DI are clobbered
	PUSH BX
	PUSH DI
	CALL WORD_MATCHES
	POP DI
	POP BX

	TEST AX, AX
	JNZ .MATCH

	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


	;; BX - Word
	;; CX - Length
	;; DI - Name
	;; 
	;; All three parameter registers may be clobbered.
	;; 
	;; Return: AX - 0 or 1
WORD_MATCHES:
	MOV AL, BYTE [BX + WORDSZ]	; Word length
	AND AL, LENGTH_MASK | HIDDEN_BIT
	CMP AL, CL

	JE .EQUAL

	XOR AX, AX
	RET

.EQUAL:
	PUSH SI
	LEA SI, [BX + 3]			; Point to the dict entry name

.LOOP:
	CMPSB
	JNE .END
	LOOP .LOOP

	MOV AX, 1
	POP SI
	RET

.END:
	XOR AX, AX
	POP SI
	RET


	;; ( *addr -- value )
	DEFWORD_RAW GET, '@'
	POP BX
	PUSH WORD [BX]
	NEXT


	;; ( value *addr -- )
	DEFWORD_RAW SET, '!'
	POP BX
	POP AX
	MOV WORD [BX], AX
	NEXT


	DEFWORD_RAW GETCHAR, 'C@'
	POP BX
	XOR AX, AX
	MOV AL, BYTE [BX]
	PUSH AX
	NEXT


	;; Code field address
	DEFWORD_RAW CFA, '>CFA'
	POP BX
	ADD BX, 2

	XOR CH, CH
	MOV CL, BYTE [BX]			; String length
	AND CL, LENGTH_MASK
	ADD BX, CX					; Code field address
	ADD BX, 2					; 1 to round up, 1 to skip length
	AND BX, (~1)				; Zero the last bit


	PUSH BX
	NEXT


	DEFWORD_THREADED DFA, '>DFA'
	DW CFA, ADD2, EXIT


	DEFWORD_RAW CREATE, 'CREATE'
	POP CX 						; Length
	POP BX						; String

	CALL DO_CREATE
	NEXT

	;; CX = Length
	;; BX = Address
	;;
	;; AX, BX, CX, DX, DI clobbered
DO_CREATE:
	PUSH SI 					; Save SI

	MOV SI, BX
	MOV DI, [VAR_HERE]			; Top of dictionary
	MOV DX, DI					; New LATEST

	MOV AX, [VAR_LATEST]
	STOSW						; Link pointer

	MOV AX, CX					; Length
	STOSB

	REP MOVSB					; Copy string

	TEST DI, 1
	JZ .DONE

	INC DI						; Pad

.DONE:
	MOV [VAR_HERE], DI
	MOV [VAR_LATEST], DX

	POP SI
	RET


	DEFWORD_RAW COMMA, ','
	POP AX
	MOV DI, [VAR_HERE]
	STOSW
	MOV [VAR_HERE], DI
	NEXT


	;; Switch to interpret mode
	DEFWORD_RAW_IMMEDIATE LEFTBRACKET, '['
	MOV WORD [VAR_STATE], 0
	NEXT


	DEFWORD_RAW_IMMEDIATE RIGHTBRACKET, ']'
	MOV WORD [VAR_STATE], 1
	NEXT


	DEFWORD_RAW IMMEDIATE, 'IMMEDIATE'
	MOV BX, [VAR_LATEST]
	XOR BYTE [BX + 2], IMMEDIATE_BIT
	NEXT


	;; LATEST HIDDEN
	DEFWORD_RAW HIDDEN, 'HIDDEN'
	POP BX
	XOR BYTE [BX + 2], HIDDEN_BIT
	NEXT


	;; HIDE DUP
	DEFWORD_THREADED HIDE, 'HIDE'
	DW _WORD, FIND, HIDDEN, EXIT


	DEFWORD_THREADED_IMMED TICK, "'"
	DW _WORD, FIND, CFA, EXIT


	DEFWORD_RAW BRANCH, 'BRANCH'
	LODSW
	ADD SI, AX
	NEXT


	DEFWORD_RAW ZEROBRANCH, '0BRANCH'
	POP DX
	LODSW
	TEST DX, DX
	JNZ .NOTZERO
	ADD SI, AX

.NOTZERO:
	NEXT


	DEFWORD_RAW LITSTRING, 'LITSTRING'
	LODSW						; Length
	PUSH SI
	ADD SI, AX
	INC SI						; Round up
	AND SI, (~1)
	PUSH AX
	NEXT


	DEFWORD_THREADED INTERPRET, 'INTERPRET'
	DW _WORD					; ( addr len )
	DW _2DUP, FIND				; ( addr len entry? )
	DW DUP						; ( addr len entry? entry? )
	DW ZEROBRANCH, 26			; ( addr len entry? ); jump to .NUM if
								; the entry was not found.

	DW CFA						; ( addr len cfa )

	DW SWAP, DROP				; ( addr cfa )
	DW SWAP, DROP				; ( cfa )
	DW STATE, GET				; ( cfa 0|1 )

	DW ZEROBRANCH, 4
	DW COMMA					; Add to HERE
	DW EXIT

.WORD_IMMED:
	DW EXECUTE					; ( )
	DW EXIT

.NUM:							; ( addr len 0 )
	DW DROP						; ( addr len )
	DW NUMBER					; ( number unparsed )
	DW ZEROBRANCH, 4			; ( number ); jump to .NUMOK

	DW BRANCH, 18				; jump to .FAILED

.NUMOK:
	;; ( number )
	DW STATE, GET				; ( number STATE )
	DW ZEROBRANCH, 8			; ( number )

	DW LITERAL, LITERAL			; ( number LITERAL )
	DW COMMA, COMMA				; ( )

.NUM_IMMED:						; ( number )
	DW EXIT

.FAILED:						; ( number )
	INCLUDE_STRING $, 'Word is neither defined nor a number'
	DW TYPE, CR					; ( number )
	DW DROP, EXIT 				; ( )


	DEFWORD_RAW EXECUTE, 'EXECUTE'
	POP AX
	MOV BX, AX
	JMP [BX]


	;; TODO: await newline
	DEFWORD_THREADED QUIT, 'QUIT'
	DW INTERPRET
	DW BRANCH, -6


	DEFWORD_THREADED COLON, ':'
	DW _WORD, CREATE
	DW LITERAL, DOCOL, COMMA
	DW LATEST, GET, HIDDEN
	DW RIGHTBRACKET
	DW EXIT


	DEFWORD_THREADED_IMMED SEMICOLON, ';'
	DW LITERAL, EXIT, COMMA
	DW LATEST, GET, HIDDEN
	DW LEFTBRACKET
	DW EXIT


	;; ( *entry -- len *string )
	DEFWORD_THREADED ENTRY_NAME, ''
	DW DUP						; ( *entry *entry )
	DW LITERAL, 2, PLUS			; ( *entry *len )
	DW GETCHAR					; ( *entry len )
	DW SWAP						; ( len *entry )
	DW LITERAL, 3, PLUS			; ( len *string )
	DW SWAP
	DW EXIT


	DEFWORD_THREADED SHOW_DICT, '.d'
	DW LATEST, GET				; ( *entry )
	DW DUP, ENTRY_NAME			; ( *entry len *string)
	DW TYPE, CR					; ( *entry )
	DW GET						; ( *prev-entry )
	DW DUP						; ( *prev-entry *prev-entry )
	DW ZEROBRANCH, 2
	DW BRANCH, -24				; Back to start!
	DW EXIT