path: root/type.asm

# 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