kinda working fn

build/hello.asm

@@ -19,7 +19,7 @@ _start:
     mov rax, 60
     syscall
 word_puts:
-	; detects string if top is len>=0 and next is a pointer in [data_start, data_end)
+	; detects string if top is len>=0 and next is a pointer in [data_start, data_end]
 	mov rax, [r12]      ; len or int value
 	mov rbx, [r12 + 8]  ; possible address
 	cmp rax, 0

build/t.asm

@@ -0,0 +1,382 @@
+section .text
+%define DSTK_BYTES 65536
+%define RSTK_BYTES 65536
+%define PRINT_BUF_BYTES 128
+global _start
+_start:
+    ; initialize data/return stack pointers
+    lea r12, [rel dstack_top]
+    mov r15, r12
+    lea r13, [rel rstack_top]
+    call word_main
+    mov rax, 0
+    cmp r12, r15
+    je .no_exit_value
+    mov rax, [r12]
+    add r12, 8
+.no_exit_value:
+    mov rdi, rax
+    mov rax, 60
+    syscall
+word_puts:
+	; detects string if top is len>=0 and next is a pointer in [data_start, data_end]
+	mov rax, [r12]      ; len or int value
+	mov rbx, [r12 + 8]  ; possible address
+	cmp rax, 0
+	jl puts_print_int
+	lea r8, [rel data_start]
+	lea r9, [rel data_end]
+	cmp rbx, r8
+	jl puts_print_int
+	cmp rbx, r9
+	jge puts_print_int
+	; treat as string: (addr below len)
+	mov rdx, rax        ; len
+	mov rsi, rbx        ; addr
+	add r12, 16         ; pop len + addr
+	test rdx, rdx
+	jz puts_str_newline_only
+	mov rax, 1
+	mov rdi, 1
+	syscall
+puts_str_newline_only:
+	mov byte [rel print_buf], 10
+	mov rax, 1
+	mov rdi, 1
+	lea rsi, [rel print_buf]
+	mov rdx, 1
+	syscall
+	ret
+
+puts_print_int:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, rax
+	mov r8, 0
+	cmp rbx, 0
+	jge puts_abs
+	neg rbx
+	mov r8, 1
+puts_abs:
+	lea rsi, [rel print_buf_end]
+	mov rcx, 0
+	mov r10, 10
+	cmp rbx, 0
+	jne puts_digits
+	dec rsi
+	mov byte [rsi], '0'
+	inc rcx
+	jmp puts_sign
+puts_digits:
+puts_loop:
+	xor rdx, rdx
+	mov rax, rbx
+	div r10
+	add dl, '0'
+	dec rsi
+	mov [rsi], dl
+	inc rcx
+	mov rbx, rax
+	test rbx, rbx
+	jne puts_loop
+puts_sign:
+	cmp r8, 0
+	je puts_finish_digits
+	dec rsi
+	mov byte [rsi], '-'
+	inc rcx
+puts_finish_digits:
+	mov byte [rsi + rcx], 10
+	inc rcx
+	mov rax, 1
+	mov rdi, 1
+	mov rdx, rcx
+	mov r9, rsi
+	mov rsi, r9
+	syscall
+    ret
+word_dup:
+	mov rax, [r12]
+	sub r12, 8
+	mov [r12], rax
+    ret
+word_drop:
+	add r12, 8
+    ret
+word_over:
+	mov rax, [r12 + 8]
+	sub r12, 8
+	mov [r12], rax
+    ret
+word_swap:
+	mov rax, [r12]
+	mov rbx, [r12 + 8]
+	mov [r12], rbx
+	mov [r12 + 8], rax
+    ret
+word_rot:
+	mov rax, [r12]       ; x3
+	mov rbx, [r12 + 8]   ; x2
+	mov rcx, [r12 + 16]  ; x1
+	mov [r12], rcx       ; top = x1
+	mov [r12 + 8], rax   ; next = x3
+	mov [r12 + 16], rbx  ; third = x2
+    ret
+word__2drot:
+	mov rax, [r12]       ; x3
+	mov rbx, [r12 + 8]   ; x2
+	mov rcx, [r12 + 16]  ; x1
+	mov [r12], rbx       ; top = x2
+	mov [r12 + 8], rcx   ; next = x1
+	mov [r12 + 16], rax  ; third = x3
+    ret
+word_nip:
+	mov rax, [r12]
+	add r12, 8           ; drop lower element
+	mov [r12], rax       ; keep original top
+    ret
+word_tuck:
+	mov rax, [r12]       ; x2
+	mov rbx, [r12 + 8]   ; x1
+	sub r12, 8           ; make room
+	mov [r12], rax       ; x2
+	mov [r12 + 8], rbx   ; x1
+	mov [r12 + 16], rax  ; x2
+    ret
+word_2dup:
+	mov rax, [r12]       ; b
+	mov rbx, [r12 + 8]   ; a
+	sub r12, 8
+	mov [r12], rbx       ; push a
+	sub r12, 8
+	mov [r12], rax       ; push b
+    ret
+word_2drop:
+	add r12, 16
+    ret
+word_2swap:
+	mov rax, [r12]        ; d
+	mov rbx, [r12 + 8]    ; c
+	mov rcx, [r12 + 16]   ; b
+	mov rdx, [r12 + 24]   ; a
+	mov [r12], rcx        ; top = b
+	mov [r12 + 8], rdx    ; next = a
+	mov [r12 + 16], rax   ; third = d
+	mov [r12 + 24], rbx   ; fourth = c
+    ret
+word_2over:
+	mov rax, [r12 + 16]   ; b
+	mov rbx, [r12 + 24]   ; a
+	sub r12, 8
+	mov [r12], rbx        ; push a
+	sub r12, 8
+	mov [r12], rax        ; push b
+    ret
+word__2b:
+	mov rax, [r12]
+	add r12, 8
+	add qword [r12], rax
+    ret
+word__2d:
+	mov rax, [r12]
+	add r12, 8
+	sub qword [r12], rax
+    ret
+word__2a:
+	mov rax, [r12]
+	add r12, 8
+	imul qword [r12]
+	mov [r12], rax
+    ret
+word__2f:
+	mov rbx, [r12]
+	add r12, 8
+	mov rax, [r12]
+	cqo
+	idiv rbx
+	mov [r12], rax
+    ret
+word__25:
+	mov rbx, [r12]
+	add r12, 8
+	mov rax, [r12]
+	cqo
+	idiv rbx
+	mov [r12], rdx
+    ret
+word__3d_3d:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, [r12]
+	cmp rbx, rax
+	mov rbx, 0
+	sete bl
+	mov [r12], rbx
+    ret
+word__21_3d:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, [r12]
+	cmp rbx, rax
+	mov rbx, 0
+	setne bl
+	mov [r12], rbx
+    ret
+word__3c:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, [r12]
+	cmp rbx, rax
+	mov rbx, 0
+	setl bl
+	mov [r12], rbx
+    ret
+word__3e:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, [r12]
+	cmp rbx, rax
+	mov rbx, 0
+	setg bl
+	mov [r12], rbx
+    ret
+word__3c_3d:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, [r12]
+	cmp rbx, rax
+	mov rbx, 0
+	setle bl
+	mov [r12], rbx
+    ret
+word__3e_3d:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, [r12]
+	cmp rbx, rax
+	mov rbx, 0
+	setge bl
+	mov [r12], rbx
+    ret
+word__40:
+	mov rax, [r12]
+	mov rax, [rax]
+	mov [r12], rax
+    ret
+word__21:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, [r12]
+	mov [rax], rbx
+	add r12, 8
+    ret
+word_mmap:
+	mov r9, [r12]
+	add r12, 8
+	mov r8, [r12]
+	add r12, 8
+	mov r10, [r12]
+	add r12, 8
+	mov rdx, [r12]
+	add r12, 8
+	mov rsi, [r12]
+	add r12, 8
+	mov rdi, [r12]
+	mov rax, 9
+	syscall
+	mov [r12], rax
+    ret
+word_munmap:
+	mov rsi, [r12]
+	add r12, 8
+	mov rdi, [r12]
+	mov rax, 11
+	syscall
+	mov [r12], rax
+    ret
+word_exit:
+	mov rdi, [r12]
+	add r12, 8
+	mov rax, 60
+	syscall
+    ret
+word_and:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, [r12]
+	test rax, rax
+	setz cl
+	test rbx, rbx
+	setz dl
+	movzx rcx, cl
+	movzx rdx, dl
+	and rcx, rdx
+	mov [r12], rcx
+    ret
+word_or:
+	mov rax, [r12]
+	add r12, 8
+	mov rbx, [r12]
+	test rax, rax
+	setz cl
+	test rbx, rbx
+	setz dl
+	movzx rcx, cl
+	movzx rdx, dl
+	or rcx, rdx
+	mov [r12], rcx
+    ret
+word_not:
+	mov rax, [r12]
+	test rax, rax
+	setz al
+	movzx rax, al
+	mov [r12], rax
+    ret
+word__3er:
+	mov rax, [r12]
+	add r12, 8
+	sub r13, 8
+	mov [r13], rax
+    ret
+word_r_3e:
+	mov rax, [r13]
+	add r13, 8
+	sub r12, 8
+	mov [r12], rax
+    ret
+word_rdrop:
+	add r13, 8
+    ret
+word_pick:
+	mov rcx, [r12]
+	add r12, 8
+	mov rax, [r12 + rcx * 8]
+	sub r12, 8
+	mov [r12], rax
+    ret
+word_rpick:
+	mov rcx, [r12]
+	add r12, 8
+	mov rax, [r13 + rcx * 8]
+	sub r12, 8
+	mov [r12], rax
+    ret
+word_main:
+    ; push 0
+    sub r12, 8
+    mov qword [r12], 0
+    ret
+section .data
+data_start:
+data_end:
+section .bss
+align 16
+dstack: resb DSTK_BYTES
+dstack_top:
+align 16
+rstack: resb RSTK_BYTES
+rstack_top:
+align 16
+print_buf: resb PRINT_BUF_BYTES
+print_buf_end:

build/test.asm

@@ -594,18 +594,18 @@ word_test_2dif:
     mov rax, [r12]
     add r12, 8
     test rax, rax
-    jz L_if_false_24
+    jz L_if_false_34
     ; push 111
     sub r12, 8
     mov qword [r12], 111
     call word_puts
-    jmp L_if_end_25
+    jmp L_if_end_35
-L_if_false_24:
+L_if_false_34:
     ; push 222
     sub r12, 8
     mov qword [r12], 222
     call word_puts
-L_if_end_25:
+L_if_end_35:
     ret
 word_test_2delse_2dif:
     ; push 2
@@ -619,13 +619,13 @@ word_test_2delse_2dif:
     mov rax, [r12]
     add r12, 8
     test rax, rax
-    jz L_if_false_26
+    jz L_if_false_36
     ; push 50
     sub r12, 8
     mov qword [r12], 50
     call word_puts
-    jmp L_if_end_27
+    jmp L_if_end_37
-L_if_false_26:
+L_if_false_36:
     call word_dup
     ; push 2
     sub r12, 8
@@ -634,19 +634,19 @@ L_if_false_26:
     mov rax, [r12]
     add r12, 8
     test rax, rax
-    jz L_if_false_28
+    jz L_if_false_38
     ; push 60
     sub r12, 8
     mov qword [r12], 60
     call word_puts
-    jmp L_if_end_29
+    jmp L_if_end_39
-L_if_false_28:
+L_if_false_38:
     ; push 70
     sub r12, 8
     mov qword [r12], 70
     call word_puts
-L_if_end_29:
+L_if_end_39:
-L_if_end_27:
+L_if_end_37:
     call word_drop
     ret
 word_test_2dfor:
@@ -659,10 +659,10 @@ word_test_2dfor:
     mov rax, [r12]
     add r12, 8
     cmp rax, 0
-    jle L_for_end_31
+    jle L_for_end_41
     sub r13, 8
     mov [r13], rax
-L_for_loop_30:
+L_for_loop_40:
     ; push 1
     sub r12, 8
     mov qword [r12], 1
@@ -670,9 +670,9 @@ L_for_loop_30:
     mov rax, [r13]
     dec rax
     mov [r13], rax
-    jg L_for_loop_30
+    jg L_for_loop_40
     add r13, 8
-L_for_end_31:
+L_for_end_41:
     call word_puts
     ret
 word_test_2dfor_2dzero:
@@ -685,17 +685,17 @@ word_test_2dfor_2dzero:
     mov rax, [r12]
     add r12, 8
     cmp rax, 0
-    jle L_for_end_33
+    jle L_for_end_43
     sub r13, 8
     mov [r13], rax
-L_for_loop_32:
+L_for_loop_42:
     call word_drop
     mov rax, [r13]
     dec rax
     mov [r13], rax
-    jg L_for_loop_32
+    jg L_for_loop_42
     add r13, 8
-L_for_end_33:
+L_for_end_43:
     call word_puts
     ret
 word_test_2dstruct:

fn.sl

@@ -30,6 +30,7 @@ again
 immediate
 compile-only
 
+
 : extend-syntax
 	"call-syntax-rewrite" set-token-hook
 ;
@@ -127,6 +128,181 @@ compile-only
 ;
 compile-only
 
+: fn-emit-prologue             # params out -- params out
+	over list-length              # params out n
+begin
+	dup 0 > if
+		1 -                      # params out n-1
+		>r                       # params out      (r: n-1)
+		">r" list-append         # params out'
+		r>                       # params out' n-1
+		continue
+	then
+	drop                         # params out
+	exit
+again
+;
+compile-only
+
+: fn-emit-epilogue             # params out -- out
+	over list-length >r           # params out   (r: n)
+begin
+	r> dup 0 > if
+		1 - >r
+		"rdrop" list-append
+		continue
+	then
+	drop                          # drop counter
+	swap drop                     # out
+	exit
+again
+;
+compile-only
+
+: fn-translate-prologue-loop   # count --
+	dup 0 > if
+		1 -
+		0 rpick ">r" list-append drop
+		fn-translate-prologue-loop
+		then
+	drop
+;
+compile-only
+
+: fn-translate-epilogue-loop   # count --
+	dup 0 > if
+		1 -
+		0 rpick "rdrop" list-append drop
+		fn-translate-epilogue-loop
+		then
+	drop
+;
+compile-only
+
+: fn-param-index                # params name -- params idx flag
+	>r                             # params        (r: name)
+	0                              # params idx
+
+begin
+	over list-length over swap >= if    # params idx flag (idx >= len?)
+		drop                      # params
+		r> drop                   # drop name
+		-1 0 exit                 # params -1 0
+	then                        # params idx
+	over over list-get            # params idx elem
+	0 rpick string=               # params idx flag
+	if
+		r> drop                   # drop name
+		1 exit                    # params idx 1
+	then
+	drop                          # params idx
+	1 +                           # params idx+1
+again
+;
+compile-only
+
+
+: fn-build-param-map            # params -- params map
+	map-new                         # params map
+	0                               # params map idx
+	begin
+		2 pick list-length            # params map idx len
+		over swap >= if               # params map idx flag
+			drop                        # params map
+			exit
+		then                          # params map idx
+		2 pick over list-get          # params map idx name
+		swap                          # params map name idx
+		dup >r                        # params map name idx   (r: idx)
+		map-set                       # params map'
+		r> 1 +                         # params map' idx'
+		continue
+	again
+;
+compile-only
+
+
+: fn-translate-token            # out map tok -- out map
+	# number?
+	dup string>number              # out map tok num ok
+	if
+		# drop tok, append num
+		swap drop                    # out map num
+		swap >r                      # out num   (r: map)
+		list-append                  # out'
+		r>                           # out' map
+		exit
+	then
+	drop                           # out map tok
+
+	# param?
+	dup >r                         # out map tok   (r: tok)
+	map-get                        # out map idx|nil ok
+	if
+		# append idx
+		swap >r                      # out idx   (r: map tok)
+		list-append                  # out'
+		r>                           # out' map
+		# append "rpick"
+		"rpick"                      # out' map "rpick"
+		swap >r                      # out' "rpick"   (r: map tok)
+		list-append                  # out''
+		r>                           # out'' map
+		# drop saved tok
+		r> drop                      # out'' map
+		exit
+	then
+	# not a param: drop idx|nil, append original tok
+	drop                           # out map
+	r>                             # out map tok
+	swap >r                        # out tok   (r: map)
+	list-append                    # out'
+	r>                             # out' map
+;
+compile-only
+
+
+: fn-translate-postfix-loop     # map out postfix -- map out
+	begin
+		dup list-empty? if
+			drop
+			exit
+		then
+		list-pop-front               # map out postfix' tok
+		swap >r                      # map out tok   (r: postfix')
+		>r swap r>                   # out map tok   (r: postfix')
+		fn-translate-token           # out map
+		swap                         # map out
+		r>                           # map out postfix'
+		continue
+	again
+;
+compile-only
+
+
+: fn-translate-postfix          # postfix params -- out
+	swap                             # params postfix
+	list-new                         # params postfix out
+
+	# prologue: stash args on return stack (emit ">r")
+	swap >r                          # params out       (r: postfix)
+	fn-emit-prologue                  # params out
+	r> swap                           # params postfix out
+
+	# build param map (name -> index)
+	2 pick fn-build-param-map         # params postfix out params map
+	>r drop r>                        # params postfix out map
+	# reorder to: params map out postfix
+	swap >r swap r> swap              # params map out postfix
+
+	# translate tokens
+	fn-translate-postfix-loop          # params map out
+	# drop map, emit epilogue
+	swap drop                         # params out
+	fn-emit-epilogue                   # out
+;
+compile-only
+
 : fn-build-body
 	fn-translate-postfix   # words
 ;

main.py

@@ -476,6 +476,7 @@ class Parser:
 
 	def _execute_immediate_word(self, word: Word) -> None:
 		try:
+			print(f"[ct] invoking {word.name}")
 			self.compile_time_vm.invoke(word)
 		except ParseError:
 			raise
@@ -1066,6 +1067,7 @@ class CompileTimeVM:
 		word = self.dictionary.lookup(name)
 		if word is None:
 			raise ParseError(f"unknown word '{name}' during compile-time execution")
+		print(f"[ct-call] {name} stack={self.stack}")
 		self._call_word(word)
 
 	def _execute_nodes(self, nodes: Sequence[ASTNode]) -> None:
@@ -1741,17 +1743,6 @@ def _ct_nil(vm: CompileTimeVM) -> None:
 	vm.push(None)
 
 
-def _ct_puts(vm: CompileTimeVM) -> None:
-	value = vm.pop()
-	if isinstance(value, str):
-		print(value)
-		return
-	if isinstance(value, int):
-		print(value)
-		return
-	raise ParseError("puts expects string or integer at compile time")
-
-
 def _ct_nil_p(vm: CompileTimeVM) -> None:
 	vm.push(1 if vm.pop() is None else 0)
 
@@ -1796,6 +1787,27 @@ def _ct_list_pop_front(vm: CompileTimeVM) -> None:
 	vm.push(value)
 
 
+def _ct_list_peek_front(vm: CompileTimeVM) -> None:
+	lst = _ensure_list(vm.pop())
+	if not lst:
+		raise ParseError("cannot peek from empty list")
+	vm.push(lst)
+	vm.push(lst[0])
+
+
+def _ct_list_push_front(vm: CompileTimeVM) -> None:
+	value = vm.pop()
+	lst = _ensure_list(vm.pop())
+	lst.insert(0, value)
+	vm.push(lst)
+
+
+def _ct_list_reverse(vm: CompileTimeVM) -> None:
+	lst = _ensure_list(vm.pop())
+	lst.reverse()
+	vm.push(lst)
+
+
 def _ct_list_length(vm: CompileTimeVM) -> None:
 	lst = vm.pop_list()
 	vm.push(len(lst))
@@ -1886,8 +1898,11 @@ def _ct_map_has(vm: CompileTimeVM) -> None:
 
 
 def _ct_string_eq(vm: CompileTimeVM) -> None:
-	right = vm.pop_str()
+	try:
-	left = vm.pop_str()
+		right = vm.pop_str()
+		left = vm.pop_str()
+	except ParseError as exc:
+		raise ParseError(f"string= expects strings; stack={vm.stack!r}") from exc
 	vm.push(1 if left == right else 0)
 
 
@@ -1947,47 +1962,6 @@ def _ct_add_token_chars(vm: CompileTimeVM) -> None:
 	vm.parser.reader.add_token_chars(chars)
 
 
-def _ct_fn_param_index(vm: CompileTimeVM) -> None:
-	name = vm.pop_str()
-	params = _ensure_list(vm.pop())
-	try:
-		idx = params.index(name)
-		vm.push(params)
-		vm.push(idx)
-		vm.push(1)
-	except ValueError:
-		vm.push(params)
-		vm.push(-1)
-		vm.push(0)
-
-
-def _ct_fn_translate_postfix(vm: CompileTimeVM) -> None:
-	params = _ensure_list(vm.pop())
-	postfix = _ensure_list(vm.pop())
-	prologue: List[Any] = [">r"] * len(params)
-	translated: List[Any] = []
-	for tok in postfix:
-		if isinstance(tok, int):
-			translated.append(tok)
-			continue
-		if isinstance(tok, str):
-			try:
-				num_value = int(tok, 0)
-				translated.append(num_value)
-				continue
-			except ValueError:
-				pass
-		if isinstance(tok, str) and tok in params:
-			idx = params.index(tok)
-			translated.append(idx)
-			translated.append("rpick")
-		else:
-			translated.append(tok)
-	epilogue: List[Any] = ["rdrop"] * len(params)
-	out: List[Any] = prologue + translated + epilogue
-	vm.push(out)
-
-
 def _ct_shunt(vm: CompileTimeVM) -> None:
 	"""Convert an infix token list (strings) to postfix using +,-,*,/,%."""
 	ops: List[str] = []
@@ -2026,8 +2000,6 @@ def _ct_int_to_string(vm: CompileTimeVM) -> None:
 	vm.push(str(value))
 
 
-
-
 def _ct_identifier_p(vm: CompileTimeVM) -> None:
 	value = vm._resolve_handle(vm.pop())
 	if isinstance(value, Token):
@@ -2161,6 +2133,9 @@ def _register_compile_time_primitives(dictionary: Dictionary) -> None:
 	register("drop", _ct_drop)
 	register("list-pop", _ct_list_pop, compile_only=True)
 	register("list-pop-front", _ct_list_pop_front, compile_only=True)
+	register("list-peek-front", _ct_list_peek_front, compile_only=True)
+	register("list-push-front", _ct_list_push_front, compile_only=True)
+	register("list-reverse", _ct_list_reverse, compile_only=True)
 	register("list-length", _ct_list_length, compile_only=True)
 	register("list-empty?", _ct_list_empty, compile_only=True)
 	register("list-get", _ct_list_get, compile_only=True)
@@ -2179,8 +2154,6 @@ def _register_compile_time_primitives(dictionary: Dictionary) -> None:
 	register("string-length", _ct_string_length, compile_only=True)
 	register("string-append", _ct_string_append, compile_only=True)
 	register("string>number", _ct_string_to_number, compile_only=True)
-	register("fn-param-index", _ct_fn_param_index, compile_only=True)
-	register("fn-translate-postfix", _ct_fn_translate_postfix, compile_only=True)
 	register("int>string", _ct_int_to_string, compile_only=True)
 	register("identifier?", _ct_identifier_p, compile_only=True)
 	register("shunt", _ct_shunt, compile_only=True)

t.sl

@@ -0,0 +1,13 @@
+import stdlib.sl
+import fn.sl
+
+fn foo(int a){
+    return a + 1;
+}
+
+: main
+    extend-syntax
+    foo(1)
+    puts
+    0
+;