.section .text

.macro defword label, name, flags=0
.global \label
\label\().padding:
.fill (258 - (\label - \label\().name)) % 4
\label\().header:
	.quad last_defword
	.byte \flags
	.byte \label - \label\().name
\label\().name:
	.ascii "\name"
\label:
.set last_defword, \label\().header
.endm
.set last_defword, 0

.macro pop
	cbz x12, forth_throw.stack_underflow
	sub x12, x12, 8
	ldr x10, [x11, x12]
.endm

.macro push
	cmp x12, x13
	b.ge forth_throw.stack_overflow
	str x10, [x11, x12]
	add x12, x12, 8
.endm

.macro rpop
	cbz x16, forth_throw.return_stack_underflow
	sub x16, x16, 8
	ldr x14, [x15, x16]
.endm

.macro rpush
	cmp x16, x17
	b.ge forth_throw.return_stack_overflow
	str x14, [x15, x16]
	add x16, x16, 8
.endm

.macro next
	ldr x0, [x18], #8
	br x0
.endm

defword forth_allot, "ALLOT"
	ldr x0, =data_space_ptr
	ldr x1, [x0]
	ldr x2, =kernel_end
	add x1, x10, x1
	cmp x1, x2
	b.ge panic.out_of_data_space
	pop
	str x1, [x0]
	next

defword forth_and, "AND"
	mov x0, x10
	pop
	and x10, x10, x0
	next

defword forth_bp, "BP"
	next

defword forth_cells, "CELLS"
	/* TODO(safety): Check stack depth */
	lsl x10, x10, #3
	next

defword forth_clz, "CLZ"
	/* TODO(safety): Check stack depth */
	clz x10, x10
	next

defword forth_comma, ","
	ldr x0, =data_space_ptr
	ldr x1, [x0]
	ldr x2, =kernel_end
	str x10, [x1], #8
	cmp x1, x2
	b.ge panic.out_of_data_space
	pop
	str x1, [x0]
	next

defword forth_comma_8, "C,"
	ldr x0, =data_space_ptr
	ldr x1, [x0]
	ldr x2, =kernel_end
	strb w10, [x1], #1
	cmp x1, x2
	b.ge panic.out_of_data_space
	pop
	str x1, [x0]
	next

defword forth_compile_comma, "COMPILE,"
	/* TODO(safety): alignment check */
	ldr x0, =data_space_ptr
	ldr x1, [x0]
	ldr x2, =kernel_end
	str x10, [x1], #8
	cmp x1, x2
	b.ge panic.out_of_data_space
	pop
	str x1, [x0]
	next

defword forth_cr, "CR"
	bl format_write_newline
	next

defword forth_ctz, "CTZ"
	/* TODO(safety): Check stack depth */
	rbit x10, x10
	clz x10, x10
	next

defword forth_depth, "DEPTH"
	lsr x0, x12, #3
	push
	mov x10, x0
	next

defword forth_div_mod, "/MOD"
	/* TODO(safety): Check stack depth */
	mov x1, x10
	pop
	mov x0, x10
	sdiv x2, x0, x1
	msub x10, x2, x1, x0
	push
	mov x10, x2
	next

defword forth_dot_decimal, ".DECIMAL"
	mov x0, x10
	pop
	bl format_write_num_sd
	next

defword forth_dot_hex, ".HEX"
	mov x0, x10
	pop
	bl format_write_num_ux
	next

defword forth_drop, "DROP"
	pop
	next

defword forth_dup, "DUP"
	push
	next

defword forth_emit, "EMIT"
	str x10, [x11] /* kinda an evil hack... should this be in dataspace instead? */
	pop
	mov x0, x11
	mov x1, 1
	bl format_write_string
	next

defword forth_equals, "="
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	cmp x10, x0
	cinv x10, xzr, eq
	next

defword forth_execute, "EXECUTE"
	mov x0, x10
	pop
	br x0

defword forth_false, "FALSE"
	push
	mov x10, 0
	next

defword forth_find_header, "FIND-HEADER"
	/* TODO(safety): Check stack depth
	 * x0: target name length
	 * x1: target name pointer
	 * x2: current header name chars remaining
	 * x3: target name current position
	 * x4: current header name current position
	 * x5: target current char
	 * x6: current header name current char
	 * x10: current dictionary link pointer
	 */
	mov x0, x10
	pop
	mov x1, x10
	mov x10, x19
forth_find_header.next_header:
	cbz x10, forth_find_header.end
	ldr x10, [x10]

	ldrb w2, [x10, #9]
	cmp x2, x0
	b.ne forth_find_header.next_header

	mov x3, x1
	add x4, x10, #10

forth_find_header.strcmp_loop:
	cbz x2, forth_find_header.end
	ldrb w5, [x3], #1
	ldrb w6, [x4], #1
	cmp w5, w6
	b.ne forth_find_header.next_header
	sub x2, x2, 1
	b forth_find_header.strcmp_loop

forth_find_header.end:
	next

defword forth_flags, "FLAGS"
	push
	ldr x10, [x19, #0x28]
	next

defword forth_from_rstack, "R>"
	push
	mov x10, x14
	rpop
	next

defword forth_gt, ">"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	cmp x10, x0
	cinv x10, xzr, gt
	next

defword forth_header_to_flags, "HEADER>FLAGS"
	/* TODO(safety): Check stack depth */
	ldrb w10, [x10, #8]
	next

defword forth_header_to_xt, "HEADER>XT"
	/* TODO(safety): Check stack depth */
	ldrb w0, [x10, #9]
	add x10, x10, x0
	add x10, x10, #10
	next

defword forth_here, "HERE"
	push
	ldr x0, =data_space_ptr
	ldr x10, [x0]
	next

defword forth_immediate, "IMMEDIATE"
	ldr x0, [x19]
	ldrb w1, [x0, #8]
	orr w1, w1, #1
	strb w1, [x0, #8]
	next

defword forth_impl_branch, "(BRANCH)"
	ldr x18, [x18]
	next

defword forth_impl_branch_zero, "(BRANCH0)"
	mov x0, x10
	ldr x1, [x18], #8
	pop
	cmp x0, xzr
	csel x18, x1, x18, eq
	next

defword forth_impl_colon, "(:)" /* aka enter, aka docolon */
	rpush
	mov x14, x18
	add x18, x0, #16
	next

defword forth_impl_constant, "(CONSTANT)"
	push
	ldr x10, [x0, #16]
	next

defword forth_impl_does, "(DOES)"
	push
	rpush
	add x10, x0, #16
	mov x14, x18
	add x18, lr, #8
	next

defword forth_impl_literal, "(LITERAL)"
	push
	ldr x10, [x18], #8
	next

defword forth_impl_semicolon, "(;)" /* aka exit */
	mov x18, x14
	rpop
	next

defword forth_impl_value, "(VALUE)"
	push
	ldr x10, [x0, #16]
	next

defword forth_impl_variable, "(VARIABLE)"
	push
	add x10, x0, #16
	next

defword forth_initial_x2, "INITIAL-X2"
	push
	ldr x0, =initial_x2
	ldr x10, [x0]
	next

defword forth_invert, "INVERT"
	/* TODO(safety): Check stack depth */
	mvn x10, x10
	next

defword forth_kernel_end, "KERNEL-END"
	push
	ldr x10, =kernel_end
	next

defword forth_kernel_start, "KERNEL-START"
	push
	ldr x10, =kernel_start
	next

defword forth_load_8, "C@"
	ldrb w10, [x10]
	next

defword forth_load_16, "H@"
	/* TODO(safety): Check stack depth */
	ldrh w10, [x10]
	next

defword forth_load_32, "W@"
	/* TODO(safety): Check stack depth */
	ldr w10, [x10]
	next

defword forth_load_64, "@"
	/* TODO(safety): Check stack depth */
	ldr x10, [x10]
	next

defword forth_lshift, "LSHIFT"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	lsl x10, x10, x0
	next

defword forth_lt, "<"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	cmp x10, x0
	cinv x10, xzr, lt
	next

defword forth_max, "MAX"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	cmp x0, x10
	csel x10, x0, x10, gt
	next

defword forth_min, "MIN"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	cmp x0, x10
	csel x10, x0, x10, lt
	next

defword forth_minus, "-"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	sub x10, x10, x0
	next

defword forth_mode_compile, "]"
	ldr x0, [x19, #0x28]
	and x0, x0, 254
	str x0, [x19, #0x28]
	next

defword forth_mode_interpret, "[", 1
	ldr x0, [x19, #0x28]
	orr x0, x0, 1
	str x0, [x19, #0x28]
	next

defword forth_nonzero, "0<>"
	/* TODO(safety): Check stack depth */
	cmp x10, xzr
	csetm x10, ne
	next

defword forth_not, "NOT"
	/* TODO(safety): Check stack depth */
	cmp x10, xzr
	csetm x10, eq
	next

defword forth_not_equals, "<>"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	cmp x10, x0
	cinv x10, xzr, ne
	next

defword forth_one_minus, "1-"
	sub x10, x10, 1
	next

defword forth_one_plus, "1+"
	add x10, x10, 1
	next

defword forth_or, "OR"
	mov x0, x10
	pop
	orr x10, x10, x0
	next

defword forth_over, "OVER"
	/* TODO(safety): Check stack depth */
	push
	add x0, x11, x12
	ldr x10, [x0, #-16]
	next

defword forth_panic, "PANIC"
	b panic.forth

defword forth_parse, "PARSE"
	/* x0: delim char
	 * x1: string base
	 * x2: string total length
	 * x3: string initial offset
	 * x4: current string pointer
	 * x5: characters remaining in string
	 * x6: current character
	 */
	and x0, x10, #0xff
	ldr x1, [x19, #8]
	ldr x2, [x19, #16]
	ldr x3, [x19, #24]
	add x4, x1, x3
	sub x5, x2, x3
	mov x10, x4
	push
forth_parse.loop:
	cbz x5, forth_parse.loopend
	sub x5, x5, #1
	ldrb w6, [x4], #1
	cmp w6, w0
	b.ne forth_parse.loop
forth_parse.loopend:
	sub x10, x4, x10
	add x3, x3, x10
	str x3, [x19, #24]
	cbz x10, forth_parse.end
	sub x10, x10, #1
forth_parse.end:
	next

defword forth_parse_name, "PARSE-NAME"
	/* x0: string base
	 * x2: string initial offset
	 * x3: current character
	 * x4: string total length
	 */
	ldr x0, [x19, #8]
	ldr x4, [x19, #16]
	ldr x2, [x19, #24]
forth_parse_name.skip_space_loop:
	cmp x4, x2
	b.eq forth_parse_name.spaces_skipped
	ldrb w3, [x0, x2]
	cmp w3, #0x21
	b.hs forth_parse_name.spaces_skipped
	add x2, x2, 1
	b forth_parse_name.skip_space_loop
forth_parse_name.spaces_skipped:
	/* x0: rest of string
	 * x1: remaining length
	 * x2: initial offset of start of string
	 * x3: current character
	 * x4: string total length
	 * x10: length so far
	 */
	sub x1, x4, x2
	push
	add x10, x0, x2
	mov x0, x10
	push
	mov x10, xzr
forth_parse_name.loop:
	cbz x1, forth_parse_name.end
	ldrb w3, [x0], #1
	cmp w3, #0x21
	b.lo forth_parse_name.end
	sub x1, x1, 1
	add x10, x10, 1
	b forth_parse_name.loop
forth_parse_name.end:
	add x2, x2, x10
	add x2, x2, 1
	cmp x2, x4
	csel x2, x2, x4, lt
	str x2, [x19, #24]
	/* TODO(safety): error on name too long */
	next

defword forth_pick, "PICK"
	/* TODO(safety): Check stack depth */
	sub x0, x12, x10, lsl #3
	ldr x10, [x11, x0]
	next

defword forth_plus, "+"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	add x10, x0, x10
	next

defword forth_process_table, "PROCESS-TABLE"
	push
	mov x10, x19
	next

defword forth_qdup, "?DUP"
	/* TODO(safety): Check stack depth */
	cbz x10, forth_qdup.end
	push
forth_qdup.end:
	next

defword forth_rdepth, "RDEPTH"
	push
	lsr x10, x16, #3
	next

defword forth_read_line, "READ-LINE"
	/* TODO(safety): Check stack depth */
	mov x1, x10
	pop
	mov x0, x10
	bl format_read_line
	mov x10, x1
	next

defword forth_rev_32, "WREV"
	/* TODO(safety): Check stack depth */
	rev w10, w10
	next

defword forth_rev_64, "REV"
	/* TODO(safety): Check stack depth */
	rev x10, x10
	next

defword forth_rshift, "RSHIFT"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	lsr x10, x10, x0
	next

defword forth_rot, "ROT" /* a b c -- b c a */
	/* TODO(safety): Check stack depth */
	sub x0, x12, #8
	sub x1, x12, #16
	ldr x2, [x11, x0]
	str x10, [x11, x0]
	ldr x10, [x11, x1]
	str x2, [x11, x1]
	next

defword forth_rot_rev, "-ROT" /* a b c -- c a b */
	/* TODO(safety): Check stack depth */
	sub x0, x12, #8
	sub x1, x12, #16
	ldr x2, [x11, x1]
	str x10, [x11, x1]
	ldr x10, [x11, x0]
	str x2, [x11, x0]
	next

defword forth_rstack_copy, "R@"
	/* TODO(safety): Check rstack depth */
	push
	mov x10, x14
	next

defword forth_rstack_drop, "RDROP"
	rpop
	next

defword forth_rswap, "RSWAP"
	/* TODO(safety): Check stack depth, rstack depth */
	mov x0, x10
	mov x10, x14
	mov x14, x0
	next

defword forth_set_depth, "SET-DEPTH"
	lsl x12, x10, #3
	add x12, x12, #8
	pop
	next

defword forth_set_does, "SET-DOES"
	/* x0: Address of DOES word's CFA / DOES word's XT
	 * x1: Snippet to do jump to absolute addr
	 * x2: Address of word, later addr of CFA
	 * x3: Length of word name (DOES, then target)
	 */
	mov x0, x10
	pop
	ldr x2, [x19]
	ldrb w3, [x2, #9]!
	add x2, x2, #1
	add x2, x2, x3
	/* TODO: Store a direct BL instruction when possible? */
	ldr x1, =0xd63f012058000049 /* ldr x9, [pc, 8]; blr x9 */
	str x1, [x2]
	str x0, [x2, #8]

	/* TODO: Probably clear the icaches? */

	next

defword forth_set_flags, "SET-FLAGS"
	mov x0, x10
	pop
	str x0, [x19, #0x28]
	next

defword forth_set_rdepth, "SET-RDEPTH"
	/* TODO(safety): Check stack depth */
	rpush
	lsl x0, x10, #3
	add x16, x0, #8
	rpop
	pop
	next

defword forth_set_source, "SET-SOURCE"
	str x10, [x19, #24]
	pop
	str x10, [x19, #16]
	pop
	str x10, [x19, #8]
	pop
	next

defword forth_source, "SOURCE"
	push
	ldr x10, [x19, #8]
	push
	ldr x10, [x19, #16]
	push
	ldr x10, [x19, #24]
	next

defword forth_store_8, "C!"
	mov x0, x10
	pop
	mov x1, x10
	pop
	strb w1, [x0]
	next

defword forth_store_64, "!"
	mov x0, x10
	pop
	mov x1, x10
	pop
	str x1, [x0]
	next

defword forth_swap, "SWAP"
	/* TODO(safety): Check stack depth */
	add x2, x11, x12
	ldr x1, [x2, #-8]
	str x10, [x2, #-8]
	mov x10, x1
	next

.global forth_throw.stack_overflow
.global forth_throw.stack_underflow
.global forth_throw.return_stack_overflow
.global forth_throw.return_stack_underflow
defword forth_throw, "THROW"
	cbz x10, forth_throw.zero
	ldr x18, [x19, #0x30]
	next
forth_throw.zero:
	pop
	next
forth_throw.stack_overflow:
	/* We don't have any room left, so we can't push! We also pop a bit so
	 * CATCH can run at all... */
	sub x12, x12, 32
	mov x10, -3
	b forth_throw
forth_throw.stack_underflow:
	push
	mov x10, -4
	b forth_throw
forth_throw.return_stack_overflow:
	/* We rpop so CATCH can run... */
	push
	sub x16, x16, 8
	mov x10, -5
	b forth_throw
forth_throw.return_stack_underflow:
	push
	mov x10, -6
	b forth_throw

defword forth_times, "*"
	/* TODO(safety): Check stack depth */
	mov x0, x10
	pop
	mul x10, x0, x10
	next

defword forth_to_number, ">NUMBER"
	/* TODO(safety): Check stack depth */
	/* Not the ANS >NUMBER! */
	/* ( c-addr len -- num valid? ) */
	mov x1, x10
	pop
	mov x0, x10
	ldrb w2, [x19, #0x28]
	and x2, x2, #2
	bl to_number
	mov x10, x3
	push
	mov x10, x4
	next

defword forth_to_rstack, ">R"
	rpush
	mov x14, x10
	pop
	next

defword forth_todo, "TODO"
	b panic.todo

defword forth_true, "TRUE"
	push
	mvn x10, xzr
	next

defword forth_two_from_rstack, "2R>"
	push
	mov x0, x14
	rpop
	mov x10, x14
	push
	rpop
	mov x10, x0
	next

defword forth_two_to_rstack, "2>R"
	rpush
	mov x0, x10
	pop
	mov x14, x10
	rpush
	pop
	mov x14, x0
	next

defword forth_xor, "XOR"
	mov x0, x10
	pop
	eor x10, x10, x0
	next

.global forth.last_builtin_header
.equiv forth.last_builtin_header, last_defword

.section .bss

.comm data_space_ptr, 8

/* vi: set ft=arm64asm : */