0.1HEADmaster

1 files changed, 555 insertions, 0 deletions

diff --git a/type.asm b/type.asm
new file mode 100644
index 0000000..a866e74
--- /dev/null
+++ b/type.asm
@@ -0,0 +1,555 @@
+# Copyright (C) 2026 Sebastian G. Kirmayer <gloria@gloria-mundi.eu>
+#
+#  This file is part of sysf-i386.
+#
+#  sysf-i386 is free software: you can redistribute it and/or modify it under
+#  the terms of the GNU General Public License as published by the Free
+#  Software Foundation, either version 3 of the License, or (at your option)
+#  any later version.
+#
+#  sysf-i386 is distributed in the hope that it will be useful, but WITHOUT ANY
+#  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+#  FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+#  details.
+#
+#  You should have received a copy of the GNU General Public License along
+#  with sysf-i386. If not, see <https://www.gnu.org/licenses/>.
+#
+
+TY_POISON=-1
+TY_ARROW=-2
+TY_FORALL=-3
+
+bss
+align
+label type_stack_top
+	skip $((TYPE_STACK_SIZE*4))
+label type_stack_bottom
+label type_stack2
+	skip $TYPE_STACK_SIZE
+data
+align
+label type_stack_ptr
+	long type_stack_bottom
+text
+
+label ty_push # (ty: i32) -> ()
+	movl @type_stack_ptr %ecx
+	cmpl type_stack_top %ecx
+	je ty_overflow
+	subl 4 %ecx
+	movl %eax @%ecx
+	movl %ecx @type_stack_ptr
+	ret
+
+label ty_overflow
+	movl msg_type_stack_overflow %eax
+	movl msg_type_stack_overflow_end %ecx
+	call report_error
+	jmp error
+
+rodata
+string msg_type_stack_overflow "Type stack overflow
+"
+text
+
+label ty_eq # (ty1: *type, ty2: *type) -> ZF
+	pushl %ebx
+	movl 1 %edx
+L loop
+	decl %edx
+
+	movl @%eax %ebx
+	cmpl @%ecx %ebx
+	jne diff.
+
+	leal @%edx+2 %ebx
+	cmpl $TY_ARROW @%eax
+	cmove %ebx %edx
+
+	leal @%edx+1 %ebx
+	cmpl $TY_FORALL @%eax
+	cmove %ebx %edx
+
+	addl 4 %eax
+	addl 4 %ecx
+	testl %edx %edx
+	jnz loop^
+L done
+	popl %ebx
+	ret
+L diff
+	cmpl $TY_POISON @%eax
+	je done^
+	cmpl $TY_POISON @%ecx
+	jmp done^
+	
+
+label ty_poison # () -> ()
+	movl 1 @error_flag
+	movl $TY_POISON %eax
+	jmp ty_push
+
+label ty_apply # () -> ()
+	movl @type_stack_ptr %eax
+	call ty_skip
+	cmpl $TY_ARROW @%eax
+	jne no_arrow.
+
+	pushl %eax
+	addl 4 %eax
+	movl @type_stack_ptr %ecx
+	call ty_eq
+	popl %eax
+	jne loud_fail.
+	addl 4 %eax
+	call ty_skip
+	movl %eax @type_stack_ptr
+	ret
+
+L no_arrow
+	cmpl $TY_POISON @%eax
+	je silent_fail.
+L loud_fail
+	pushl %eax
+	call stderr_lineno
+	stderr "Failed to apply "
+	movl @%esp %eax
+	call ty_stderr
+	stderr " to "
+	movl @type_stack_ptr %eax
+	call ty_stderr
+	stderr "
+"
+	popl %eax
+L silent_fail
+	call ty_skip
+	subl 4 %eax
+	movl %eax @type_stack_ptr
+	movl $TY_POISON @%eax
+	movl 1 @error_flag
+	ret
+
+label ty_apply_forall # () -> ()
+	movl @type_stack_ptr %eax
+	call ty_skip
+	cmpl $TY_FORALL @%eax
+	jne no_forall.
+
+	# 1. Determine the number of substitutions
+	pushl %eax
+	addl 4 %eax
+	xorl %ecx %ecx
+	xorl %edx %edx
+	call ty_subst
+	# @%esp -- start of forall
+	# %eax -- number of substitutions
+
+	# 2. Allocate space, by moving the substituted type up the stack.
+	movl @%esp %ecx
+	subl @type_stack_ptr %ecx
+	subl 4 %ecx
+	mull %ecx
+	# %eax is size delta
+	movl @type_stack_ptr %ecx
+	negl %eax
+	addl %ecx %eax
+	# We will discard the outer forall. If there are no substitutions, this
+	# means the move below is broken since %ecx < %eax, but it doesn't matter
+	# since we will never substitute.
+	addl 4 %eax
+	cmpl type_stack_top %eax
+	jb ty_overflow
+	movl %eax @type_stack_ptr
+L loop
+	movl @%ecx %edx
+	movl %edx @%eax
+	addl 4 %ecx
+	addl 4 %eax
+	cmpl @%esp %ecx
+	jne loop^
+
+	# 3. Perform the substitution
+	movl %eax %ecx
+	popl %eax
+	addl 4 %eax
+	movl @type_stack_ptr %edx
+	movl %ecx @type_stack_ptr
+	jmp ty_subst # tail call
+
+L no_forall
+	cmpl $TY_POISON @%eax
+	je silent_fail.
+	pushl %eax
+	call stderr_lineno
+	stderr "Failed to apply "
+	movl @%esp %eax
+	call ty_stderr
+	stderr " to a type
+"
+	popl %eax
+L silent_fail
+	call ty_skip
+	subl 4 %eax
+	movl %eax @type_stack_ptr
+	movl $TY_POISON @%eax
+	movl 1 @error_flag
+	ret
+
+# If out is 0, subst must also be 0. Then no substitution is performed,
+# and subst count is returned.
+label ty_subst # (in: *type, out: *type, subst: *type) -> ...
+	pushl %ebx
+	pushl %edi
+	pushl %esi
+	pushl %ebp
+	pushl %edx
+	movl %eax %ebx
+	movl type_stack2 %edi
+	xorl %ebp %ebp
+	movl %ecx %esi
+	# %ebx -- in ptr
+	# %edi -- stack2 ptr
+	# %ebp -- index offset
+	# %esi -- out ptr
+L loop
+	movl @%ebx %eax
+	addl 4 %ebx
+
+	cmpl $TY_ARROW %eax
+	je arrow.
+	cmpl $TY_FORALL %eax
+	je forall.
+	cmpl $TY_POISON %eax
+	je var.
+
+	leal @%eax+-1 %ecx
+	cmpl %ebp %eax
+	je do_subst.
+	cmova %ecx %eax
+
+L var
+	testl %esi %esi
+	jz next.
+	movl %eax @%esi
+	addl 4 %esi
+L next
+	cmpl type_stack2 %edi
+	je done.
+	decl %edi
+	cmpb 1 @%edi
+	je loop^
+	cmpb 2 @%edi
+	je close_forall.
+	ud2
+L close_forall
+	decl %ebp
+	jmp next^
+
+L do_subst
+	testl %esi %esi
+	jz no_copy.
+
+	movl @%esp %eax
+	movl %esi %ecx
+	movl %ebp %edx
+	pushl %edi
+	call ty_copy2
+	movl %eax %esi
+	jmp next^
+
+L no_copy
+	incl @%esp
+	jmp next^
+
+L arrow
+	testl %esi %esi
+	jz no_copy.
+	movl %eax @%esi
+	addl 4 %esi
+L no_copy
+	movb 1 @%edi
+	incl %edi
+	jmp loop^
+
+L forall
+	testl %esi %esi
+	jz no_copy.
+	movl %eax @%esi
+	addl 4 %esi
+L no_copy
+	movl 2 @%edi
+	incl %edi
+	incl %ebp
+	jmp loop^
+
+L done
+	popl %eax
+	popl %ebp
+	popl %esi
+	popl %edi
+	popl %ebx
+	ret
+
+label ty_stderr # (ty: *type) -> ()
+	pushl %ebx
+	pushl %edi
+	pushl %ebp
+	movl %eax %ebx
+	movl type_stack2 %edi
+	movl 0 %ebp
+	# %ebx -- type ptr
+	# %edi -- stack2 ptr
+	# %ebp -- index offset
+L loop
+	movl @%ebx %eax
+	addl 4 %ebx
+
+	cmpl $TY_ARROW %eax
+	je arrow.
+	cmpl $TY_FORALL %eax
+	je forall.
+	cmpl $TY_POISON %eax
+	je poison.
+
+	subl %ebp %eax
+	jae outside.
+	notl %eax
+	movl 0x61 %ecx
+	jmp baseconv.
+L outside
+	movl 0x41 %ecx
+L baseconv
+	call stderr_name
+L next
+	cmpl type_stack2 %edi
+	je done.
+	decl %edi
+	cmpb 0 @%edi
+	je close_paren.
+	cmpb 1 @%edi
+	je close_arrow.
+	cmpb 2 @%edi
+	je close_forall.
+	ud2
+L close_paren
+	stderr ")"
+	jmp next^
+L close_arrow
+	stderr " -> "
+	jmp loop^
+L close_forall
+	decl %ebp
+	jmp next^
+
+L done
+	popl %ebp
+	popl %edi
+	popl %ebx
+	ret
+
+L arrow
+	movb 1 @%edi
+	incl %edi
+	cmpl $TY_ARROW @%ebx
+	je paren.
+	cmpl $TY_FORALL @%ebx
+	jne loop^
+L paren
+	movb 0 @%edi
+	incl %edi
+	stderr "("
+	jmp loop^
+
+L forall
+	stderr "\\/"
+	movl 0x61 %ecx
+	movl %ebp %eax
+	incl %ebp
+	call stderr_name
+	stderr " "
+	movl 2 @%edi
+	incl %edi
+	jmp loop^
+
+L poison
+	stderr "<error>"
+	jmp next^
+
+label stderr_name # (name: i32, offset: i32) -> ()
+	pushl %edi
+	pushl %ebx
+	movl %esp %ebx
+	subl 16 %esp
+	movl 26 %edi
+	incl %eax
+L baseconv_loop
+	decl %eax
+	xorl %edx %edx
+	divl %edi
+	addl %ecx %edx
+	decl %ebx
+	movb %dl @%ebx
+	testl %eax %eax
+	jnz baseconv_loop^
+	movl %ebx %eax
+	leal @%esp+16 %ecx
+	call stderr
+	addl 16 %esp
+	popl %ebx
+	popl %edi
+	ret
+
+label ty_top # () -> (top: *type)
+	movl @type_stack_ptr %eax
+	ret
+
+label ty_pop # () -> ()
+	movl @type_stack_ptr %eax
+	call ty_skip
+	movl %eax @type_stack_ptr
+	ret
+
+label ty_skip # (ty: *type) -> (next: *type)
+	movl 1 %ecx
+L loop
+	decl %ecx
+
+	leal @%ecx+2 %edx
+	cmpl $TY_ARROW @%eax
+	cmove %edx %ecx
+
+	leal @%ecx+1 %edx
+	cmpl $TY_FORALL @%eax
+	cmove %edx %ecx
+
+	addl 4 %eax
+	testl %ecx %ecx
+	jnz loop^
+	ret
+
+label ty_forall # () -> ()
+	movl $TY_FORALL %eax
+	jmp ty_push
+
+label ty_var # (idx: i32) -> ()
+	jmp ty_push
+
+label ty_arrow # () -> ()
+	movl @type_stack_ptr %eax
+	call ty_skip
+	pushl %eax
+	movl %eax %ecx
+	movl @type_stack_ptr %eax
+	call reverse
+	movl @%esp %eax
+	call ty_skip
+	movl %eax %ecx
+	xchgl %eax @%esp
+	call reverse
+	movl @type_stack_ptr %eax
+	popl %ecx
+	call reverse
+	movl $TY_ARROW %eax
+	jmp ty_push
+
+label reverse # (start: *i32, end: *i32) -> ()
+L loop
+	cmpl %ecx %eax
+	je done.
+	subl 4 %ecx
+	cmpl %ecx %eax
+	je done.
+	movl @%eax %edx
+	xchgl @%ecx %edx
+	movl %edx @%eax
+	addl 4 %eax
+	jmp loop^
+L done
+	ret
+
+label ty_top_is_forall # () -> (ZF)
+	movl @type_stack_ptr %eax
+	cmpl $TY_FORALL @%eax
+	ret
+
+label ty_copy # (ty: *type, shift: i32) -> ()
+	pushl %ecx
+	pushl %eax
+	call ty_skip
+	movl @%esp %ecx
+	subl %eax %ecx
+	addl @type_stack_ptr %ecx
+	cmpl type_stack_top %ecx
+	jb ty_overflow
+	movl %ecx @type_stack_ptr
+	popl %eax
+	popl %edx
+	pushl type_stack2
+	call ty_copy2
+	ret
+
+label ty_copy2 # (src: i32, dst: i32, shift: i32, stack2: i32) -> (dstend: i32)
+	pushl %ebx
+	pushl %edi
+	pushl %esi
+	movl @%esp+16 %edi
+	movb 0 @%edi
+	incl %edi
+	xorl %ebx %ebx
+	# %eax -- src ptr
+	# %ecx -- dst ptr
+	# %ebx -- index offset
+	# %edx -- index shift
+	# %edi -- stack2 ptr
+L loop
+	movl @%eax %esi
+	addl 4 %eax
+
+	cmpl $TY_ARROW %esi
+	je arrow.
+	cmpl $TY_FORALL %esi
+	je forall.
+	cmpl $TY_POISON %esi
+	je var.
+
+	cmpl %ebx %esi
+	jb var.
+	addl %edx %esi
+L var
+	movl %esi @%ecx
+	addl 4 %ecx
+L next
+	decl %edi
+	cmpb 0 @%edi
+	je done.
+	cmpb 1 @%edi
+	je loop^
+	cmpb 2 @%edi
+	je forall_done.
+	ud2
+L forall_done
+	decl %ebx
+	jmp next^
+
+L arrow
+	movl %esi @%ecx
+	addl 4 %ecx
+	movb 1 @%edi
+	incl %edi
+	jmp loop^
+
+L forall
+	movl %esi @%ecx
+	addl 4 %ecx
+	movb 2 @%edi
+	incl %edi
+	incl %ebx
+	jmp loop^
+
+L done
+	movl %ecx %eax
+	popl %esi
+	popl %edi
+	popl %ebx
+	ret 4