path: root/jefs.s

; jewelforth

;; MACROS {{{
%macro pspush 1
	lea r14, [r14-8]
	mov qword [r14], %1
%endmacro

%macro pspop 1
	mov %1, qword [r14]
	lea r14, [r14+8]
%endmacro

;;; dictionary macros {{{
%define mac_latest	0	; updated through defdict

%macro defdict 3 ; name asm-label flags
	%strlen slen %1
	global lfa_%2
	lfa_%2: dq mac_latest
		%define mac_latest lfa_%2
	ffa_%2:	db %3 ; FFA
	nfa_%2:	dw slen ; NFA
		db %1
%endmacro

%macro defword 3
	defdict %1, %2, %3
	%2:
%endmacro

%macro defconst 4 ; ... value
	defdict %1, %2, %3
	%define %2 %4
	pspush qword %4
	ret
%endmacro

%macro defvar 4 ; ... default-value
	%2: dq %4
	defdict %1, %2, %3
	pspush qword %2
	ret
%endmacro

%assign smudge_mask	0x1
%assign immediate_mask	0x2

%assign false 0x0
%assign true 0xffffffffffffffff

%assign interpreting 0x0
%assign compiling 0xffffffffffffffff
;;; }}}

;; syscall
%assign	__NR_read	0
%assign	__NR_write	1
%assign	__NR_brk	12
%assign	__NR_exit	60
;; }}}

section .bss
wstack_b:	resq 2047
wstack:		resq 1

section .text
global _start
_start:
	; init
	mov r14, wstack ; point SP to top

	; EXPAND BRK
	xor rdi, rdi ; brk syscall called with 0 gives the current brk
	mov rax, __NR_brk
	syscall
	mov qword [here], rax
	mov qword [h0], rax

	add rax, 0x9c400 ; 640kb, entirely arbitrary
	mov rdi, rax
	mov rax, __NR_brk
	syscall ; if this fails, have fun
	mov qword [hend], rax

	call interpret
	mov rdi, 0
	mov rax, __NR_exit
	syscall

defword "bye", bye, 0
	mov rdi, 0
	mov rax, __NR_exit
	syscall
	ret ; will not be reached

defword "@", fetch, 0
	pspop r11
	mov r12, qword [r11]
	pspush r12
	ret

defword "c@", cfetch, 0
	pspop r11
	xor r12, r12
	mov r12b, [r11]
	pspush r12
	ret

defword "!", store, 0
	pspop r11
	pspop r12
	mov qword [r11], r12
	ret

defword "c!", cstore, 0
	pspop r11
	pspop r12
	mov [r11], r12b
	ret

; stage 1 parser. very rudimentary, does not recognise numbers,
; only recognises newlines and spaces as whitespace.
; since it will only parse a little bit of the init file
; there won't be any error checking either.
defword "parse", parse, 0
	mov r13, qword [to_in]
	add r13, initfile
	mov r12b, byte [r13]

.wsloop: ; skip initial ws
	cmp r12b, 0x20
	je .wsloop_cont
	cmp r12b, 0x0a
	jne .wordloop_start
.wsloop_cont:
	inc r13
	mov r12b, byte [r13]
	jmp .wsloop

.wordloop_start:
	push r13 ; keep start address of this word for later
	mov r11, 1 ; W: word length count
.wordloop:
	cmp r12b, 0x20
	je .wordloop_end
	cmp r12b, 0x0a
	je .wordloop_end

	inc r11
	inc r13
	mov r12b, byte [r13]
	jmp .wordloop

.wordloop_end:
	dec r11
	sub r13, initfile
	mov qword [to_in], r13
	pop r13
	pspush r13 ; c-addr
	pspush r11 ; u
	ret

defword "find", find, 0
	pspop r10 ; u
	pspop r11 ; c-addr
	mov r12, latest
	mov r13, qword [r12]
	mov r12, r13

.check_smudge:
	add r13, 8
	mov r9b, byte [r13]
	test r9b, smudge_mask
	jnz .no

.no_smudge:
	inc r13
	mov r9w, word [r13]
	cmp r9w, r10w
	jne .no
	mov rsi, r13
	add rsi, 2
	mov rdi, r11
	mov rcx, r10
	repz cmpsb
	jnz .no
	sub r13, 9
	pspush r13
	mov r13, true
	pspush r13
	ret

.no:
	mov r13, qword [r12]
	mov r12, r13
	cmp r13, 0 ; end of dictionary? fallthrough to notfound if so
	jne .check_smudge

	mov r13, false
	pspush r13
	ret

; stage 1 interpreter, just reads from initfile
defword "interpret", interpret, 0
.loop:
; todo interact with state
	call parse
	call find
	pspop r11 ; assume it exists its fine for now
	mov r12, qword [state]
	cmp r12, compiling
	je .compile

.interp:
	call to_cfa
	pspop r11
	call r11
	jmp .loop
	ret ; unreachable safety RET

.compile:
	; handle immediates
	call dup
	call immediate_q
	pspop r13
	cmp r13, true
	je .interp

	call to_cfa
	pspop r11
	call compile_comma
	jmp .loop
	ret ; unreachable safety RET

defword "immediate?", immediate_q, 0 ; ( lfa -- flag )
	pspop r11
	add r11, 8
	mov r12b, byte [r11]
	test r12b, immediate_mask
	jnz .imm

	mov r11, false
	pspush r11
	ret

.imm:
	mov r11, true
	pspush r11
	ret

defword ">cfa", to_cfa, 0
	pspop r11
	add r11, 9
	xor r12, r12
	mov r12w, word [r11]
	add r11, 2
	add r11, r12
	pspush r11
	ret

defword "compile,", compile_comma, 0
	pspop r11
	mov r12, [here]

	; compile mov r11, [cfa]
	mov word [r12], 0x94bb
	add r12, 2
	mov qword [r12], r11
	add r12, 8

	; compile call r11
	mov word [r12], 0x41ff
	add r12, 2
	mov byte [r12], 0xd3
	inc r12

	mov qword [here], r12
	ret

defword ":", colon, 0
	call parse
	pspop r9 ; u
	pspop r10 ; c-addr
	mov r11, [latest]
	mov r12, [here]
	push r12 ; keep for LATEST

	mov qword [r12], r11
	add r12, 8
	mov byte [r12], smudge_mask
	inc r12
	mov word [r12], r9w ; r9w from r9: safe?
	add r12, 2

	; strcpy
	mov rcx, r9
	mov rsi, r10
	mov rdi, r12
	rep movsb
	add r12, r9

	mov qword [here], r12
	pop r12
	mov qword [latest], r12
	ret

defword ";", semicolon, immediate_mask
	; unsmudge
	mov r12, [latest]
	add r12, 8
	mov r13b, [r12]
	mov r15b, smudge_mask ; todo figure out how to do this at assemble time
	not r15b
	and r13b, r15b
	mov byte [r12], r13b

	mov r11, [here]
	mov byte [r11], 0xc3
	inc r11
	mov qword [here], r11
	mov qword [state], interpreting
	ret

defword "dup", dup, 0
	mov r11, [r14]
	pspush r11
	ret

defvar ">in", to_in, 0, 0
defvar "state", state, 0, interpreting
defvar "here", here, 0, 0
defvar "h0", h0, 0, 0 ; beginning of user memory area
defvar "hend", hend, 0, 0 ; ending of user memory area
defvar "latest", latest, 0, lfa_latest

initfile:
incbin "jefs.fs"
initlen equ $ - initfile
initfile_end: