# Copyright (C) 2026 Sebastian G. Kirmayer # # 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 . # 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 "" 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