path: root/sanctuary.s

; sanctuary

; macros {{{
; TODO: error handling (once i add that)
%macro pspush 1
	lea r15, [r15-8]
	mov qword [r15], %1
%endmacro

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

%define s_latest 0

%macro defdict 3 ; name label flags
	%strlen slen %1
	global lfa_%2
	lfa_%2: dq s_latest
	%define s_latest lfa_%2
	ffa_%2: db %3
	nfa_%2: db slen
		db %1
%endmacro

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

; this is just taken from jewelforth, and does not correspond
; to how user variables are planned to work in sanctuary
; so todo make better later? i don't know if it really matters
; because it will only apply to builtin variables.
%macro defvar 4
	%2: dq %4
	defdict %1, %2, %3
	pspush qword %2
%endmacro
; }}}

%assign smudge_mask	0x1
%assign immediate_mask	0x2
%assign comp_only_mask	0x4

%assign true 0x0
%assign false (~0x0)

%assign INTERPRET 0x0
%assign COMPILING (~0x0)

%assign __NR_write	1
%assign __NR_mprotect	10
%assign __NR_brk	12
%assign __NR_exit	60

section .bss
resq 4091
wstk: resq 1

section .text
global _start
_start:
	lea r15, [wstk]

	call brk@
	pspop r11
	mov qword [dp], r11
	mov qword [dp0], r11
	mov r11, 0x9c400
	pspush r11
	call grow
	call parse_name
	call type
	call bye

defcode "brk@", brk@, 0
	xor rdi, rdi
	mov rax, __NR_brk
	syscall
	pspush rax
	ret

defcode "grow", grow, 0
	call brk@
	pspop rdi
	pspop r13
	add rdi, r13
	mov rax, __NR_brk
	syscall
	mov qword [dp$], rax
	ret

defcode "executable", executable, 0
	mov rdx, 0x7 ; PROT_{READ,WRITE,EXEC}
	pspop rdi ; addr
	pspop rsi
	mov rax, __NR_mprotect
	syscall
	ret

defcode "here", here, 0
	mov r11, qword [dp]
	pspush r11
	ret

defcode "bye", bye, 0
	mov rdi, 0
	mov rax, __NR_exit
	syscall
	ret

; input parsing {{{
; r11: string character count
; rsi: input buffer address
; al: char being parsed
; r10: end of input buffer
defcode "parse-name", parse_name, 0
	mov rsi, qword [to_in]
	mov r10, qword [tib]
	add rsi, r10
	add r10, qword [n_tib]
	xor rax, rax

.wsloop:
	cmp rsi, r10
	jge .empty
	lodsb
	cmp al, 0x20
	je .wsloop
	cmp al, 0x09
	je .wsloop
	cmp al, 0x0a
	je .wsloop

	cmp rsi, r10
	jge .empty
	mov r11, 1
	dec rsi ; bring down by one to point to the start
	push rsi ; will become `a`
	inc rsi
.wordloop:
	cmp al, 0x20
	je .wordloop_e
	cmp al, 0x09
	je .wordloop_e
	cmp al, 0x0a
	je .wordloop_e

	cmp rsi, r10
	jge .wordloop_e
	inc r11
	lodsb
	jmp .wordloop

.wordloop_e:
	dec r11
	sub rsi, qword [tib]
	mov qword [to_in], rsi
	pop rsi
	pspush rsi
	pspush r11
	ret

.empty:
	pspush 0
	pspush 0
	ret

; r11: string character count
; rsi: input buffer address
; al: char being parsed
; r10: end of input buffer
defcode "parse", parse, 0
	pspop rbx
	mov rsi, qword [to_in]
	mov r10, qword [tib]
	add rsi, r10
	add r10, qword [n_tib]
	xor rax, rax

.wsloop:
	cmp rsi, r10
	jge .empty
	lodsb
	cmp al, bl
	je .wsloop
	cmp al, 0x0a
	je .wsloop

	cmp rsi, r10
	jge .empty
	mov r11, 1
	dec rsi ; bring down by one to point to the start
	push rsi ; will become `a`
	inc rsi
.wordloop:
	cmp al, bl
	je .wordloop_e
	cmp al, 0x0a
	je .wordloop_e

	cmp rsi, r10
	jge .wordloop_e
	inc r11
	lodsb
	jmp .wordloop

.wordloop_e:
	dec r11
	sub rsi, qword [tib]
	mov qword [to_in], rsi
	pop rsi
	pspush rsi
	pspush r11
	ret

.empty:
	pspush 0
	pspush 0
	ret
; }}}

defcode "type", type, 0
	pspop rdx
	pspop rsi
	mov rdi, 1
	mov rax, __NR_write
	syscall
	ret

; r9:  processing temporary value
; r10: input size
; r11: input addr
; r12: pointer into currently processing word
; r13: same as r12 but kept at xt
defcode "find", find, 0
	pspop r10 ; u
	pspop r11 ; a
	mov r12, qword [latest]
	mov r13, r12

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

	inc r12
	mov r9b, byte [r12]
	cmp r9b, r10b
	jne .no

	mov rsi, r12
	inc rsi
	mov rdi, r11
	mov rcx, r10
	repe cmpsb
	jnz .no

	pspush r13
	mov r13, true
	pspush r13
	ret

.no:
	mov r12, qword [r13]
	mov r13, r12
	cmp r12, 0
	jne .check_smudge

	pspush r11
	pspush r10
	mov r13, false
	pspush r13
	ret

; .s {{{
defcode ".s", dots, 0
	push r11
	push r12

	mov r12, r15
.loop:
	cmp r12, wstk
	jge .done

	mov [.space], r12
	mov rdx, 8 ; qword
	mov rsi, .space
	mov rdi, 1
	mov rax, __NR_write
	syscall

	mov rdx, 8 ; qword
	mov rsi, r12
	mov rdi, 1
	mov rax, __NR_write
	syscall
	lea r12, [r12+8]
	jmp .loop

.done:
	mov rdx, 16 ; 2 qword
	mov rsi, .dmsg
	mov rdi, 1
	mov rax, __NR_write
	syscall

	pop r12
	pop r11
	ret
.space: resq 1
.dmsg: db "DONEDONEYIPPEEEE"
; }}}

defvar "state", state, 0, INTERPRET
defvar "dp", dp, 0, 0
defvar "dp0", dp0, 0, 0
defvar "dp$", dp$, 0, 0
defvar "tib", tib, 0, initfile
defvar "#tib", n_tib, 0, initlen
defvar ">in", to_in, 0, 0
defvar "latest", latest, 0, lfa_latest

initfile: incbin "sanctuary.fs"
initlen equ $ - initfile