diff options
Diffstat (limited to 'parse.asm')
| -rw-r--r-- | parse.asm | 996 |
1 files changed, 996 insertions, 0 deletions
diff --git a/parse.asm b/parse.asm new file mode 100644 index 0000000..1b23745 --- /dev/null +++ b/parse.asm @@ -0,0 +1,996 @@ +# 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/>. +# + +bss +align +label lineno + long 0 +label error_flag + long 0 +label macro_flag + long 0 + +label parse_stack_top + skip $((PARSE_STACK_SIZE*4)) +label parse_stack_bottom +label macro_types_start + skip $((MACROS_SIZE*4)) +label macro_types_end +label macro_start + skip $((PARSE_STACK_SIZE*16)) +label macro_end +label input + long 0 +label input_end + long 0 +data +align +label parse_stack_ptr + long parse_stack_bottom +label macro_type_ptr + long macro_types_start +label macro_ptr + long macro_start +text + +# STK +# { IDENT START, IDENT END } (if STK & STK_HAVE_IDENT) +# LINENO (if STK & STK_HAVE_LINENO) + +# On the type stack: +# callee type (if STK & STK_HAVE_VALUE) +# argument type (if STK & STK_SMALL_LAMBDA) + +# stack control words: +STK_BOTTOM=1 +STK_PAREN=2 +STK_SMALL_LAMBDA=4 +STK_BIG_LAMBDA=8 + +STK_TYPE_BOTTOM=256 +STK_TYPE_ARROW=512 +STK_TYPE_PAREN=1024 +STK_TYPE_FORALL=2048 + +STK_HAVE_VALUE=16 +STK_HAVE_IDENT=$((STK_SMALL_LAMBDA|STK_BIG_LAMBDA|STK_TYPE_FORALL)) +STK_HAVE_LINENO=$((STK_PAREN|STK_TYPE_PAREN)) + +BACKSLASH=0x5C +SLASH=0x2F +LPAREN=0x28 +RPAREN=0x29 +LBRACKET=0x5B +RBRACKET=0x5D +COLON=0x3A +SEMICOLON=0x3B +OCTOTHORPE=0x23 +SPACE=0x20 +TAB=0x09 +NEWLINE=0x0A +HYPHEN=0x2D +GREATER=0x3E +UNDERSCORE=0x5F + +label parse_push # (val: i32) -> () + movl @parse_stack_ptr %ecx + cmpl parse_stack_top %ecx + je overflow. + subl 4 %ecx + movl %eax @%ecx + movl %ecx @parse_stack_ptr + ret + +label parse_peek # () -> (val: i32) + movl @parse_stack_ptr %eax + movl @%eax %eax + ret + +label parse_pop # () -> (val: i32) + movl @parse_stack_ptr %eax + addl 4 @parse_stack_ptr + movl @%eax %eax + ret + +L overflow + movl msg_parse_overflow %eax + movl msg_parse_overflow_end %ecx + call report_error + jmp error +rodata +string msg_parse_overflow "Parse stack overflow +" +text + +label parse # (start: *i8, end: *i8) -> (term: *term) + pushl %ebx + pushl %edi + pushl %esi + pushl %ebp + movl %eax @input + movl %ecx @input_end + call align_heap + movl $STK_BOTTOM %eax + call parse_push + # push two bottoms -- this simplifies handling of unmatched ) + movl $STK_BOTTOM %eax + call parse_push + # push an extra poison to the type stack + call ty_poison + movl 0 @lineno + movl 0 @error_flag # this must occur after the ty_poison above +L loop + call skip_white + movl @input %eax + cmpl @input_end %eax + je eof. + cmpb $RPAREN @%eax + je right_paren. + call parse_peek + testl $STK_HAVE_VALUE %eax + jz parse_value. + call ty_top_is_forall + jne parse_value. + call parse_type + call ty_apply_forall + jmp loop^ + +L parse_value + movl @input %eax + movb @%eax %al + cmpb $BACKSLASH %al + je small_lambda. + cmpb $SLASH %al + je big_lambda. + cmpb $LPAREN %al + je left_paren. + # Variable terms + call read_ident + movl $STK_SMALL_LAMBDA %edx + call find_ident + movl %eax %esi + movl %ecx %ebp + movl %edx %edi + movl @heap_ptr %ecx + call push_value + testl %esi %esi + js bad_ident. + movl %edi %eax + movl %ebp %ecx + call ty_copy + jmp value_done. +L bad_ident + movl %esp %eax + call ty_poison +L value_done + movl %esp %eax + call apply + jmp loop^ + +L small_lambda + incl @input + call skip_white + call read_ident + movl %eax %esi + movl %ecx %eax + call parse_push + movl %esi %eax + call parse_push + movl $STK_SMALL_LAMBDA %eax + call parse_push + call skip_white + movl @input %eax + cmpl @input_end %eax + je no_colon. + movb @%eax %al + cmpb $COLON %al + jne no_colon. + incl @input + call parse_type + jmp loop^ + +L no_colon + call stderr_lineno + stderr "Missing argument type in lambda abstraction +" + call ty_poison + movl 1 @error_flag + jmp loop^ + +L big_lambda + movl @input %eax + incl %eax + cmpl @input_end %eax + je bad_char + movb @%eax %al + cmpb $BACKSLASH %al + jne bad_char + addl 2 @input + call skip_white + call read_ident + movl %eax %ebx + movl %ecx %eax + call parse_push + movl %ebx %eax + call parse_push + movl $STK_BIG_LAMBDA %eax + call parse_push + jmp loop^ + +L left_paren + incl @input + movl @lineno %eax + call parse_push + movl $STK_PAREN %eax + call parse_push + jmp loop^ + +L right_paren + incl @input + movl $STK_PAREN %eax + call close_paren + jmp loop^ + +L eof + movl $STK_BOTTOM %eax + call close_paren + popl %ebp + popl %esi + popl %edi + popl %ebx + movl @error_flag %eax + testl %eax %eax + jnz error + ret + +label close_paren # (type: i32) -> () + pushl %ebx + pushl %edi + pushl %ebp + movl %eax %ebx + # %ebx -- type wanted + call parse_pop + movl %eax %edi + # %edi -- type on stack + testl $STK_HAVE_VALUE %edi + jz no_value. +L have_value + testl $STK_HAVE_IDENT %edi + jz skip. + call parse_pop + call parse_pop +L skip + testl $STK_SMALL_LAMBDA %edi + jnz small_lambda. + testl $STK_BIG_LAMBDA %edi + jz skip. +L big_lambda + call ty_forall + jmp skip. +L small_lambda + call ty_arrow + movl @heap_ptr %ecx + movl @%ecx+-8 %ecx + movl $VAL_ABS %eax + call push_value +L skip + testl $STK_HAVE_LINENO %edi + jz no_lineno. + call parse_pop + movl %eax %ebp + # %ebp -- lineno +L no_lineno + call apply + testl %ebx %edi + jnz end. + testl $STK_BOTTOM %edi + jnz unmatched_right. + testl $STK_PAREN %edi + jnz unmatched_left. +L continue + call parse_pop + movl %eax %edi + jmp have_value^ # must have value since we just called apply + +L end + popl %ebp + popl %edi + popl %ebx + ret + +L unmatched_right + movl 1 @error_flag + call stderr_lineno + stderr "Unmatched ')' +" + call parse_pop + movl $STK_BOTTOM %eax + call parse_push + movl $((STK_BOTTOM|STK_HAVE_VALUE)) %eax + call parse_push + jmp end^ + +L unmatched_left + movl 1 @error_flag + xchgl %ebp @lineno + call stderr_lineno + movl %ebp @lineno + stderr "Unmatched '(' +" + jmp continue^ + +L no_value + # Push a poison value so we can continue + orl $STK_HAVE_VALUE %edi + movl 1 @error_flag + movl @heap_ptr %ecx + call push_value + call ty_poison + call stderr_lineno + # %edi -- parse stack element + testl $STK_PAREN %edi + jnz paren. + testl $STK_SMALL_LAMBDA %edi + jnz small. + testl $STK_BIG_LAMBDA %edi + jnz big. + testl $STK_BOTTOM %edi + jnz bottom. + ud2 +L paren + stderr "Empty parentheses +" + jmp have_value^ +L small + stderr "Empty lambda abstraction +" + jmp have_value^ +L big + stderr "Empty type lambda abstraction +" + jmp have_value^ +L bottom + stderr "Empty program +" + jmp have_value^ + +# We have just pushed a value. Check if it is an argument, and push the +# application if so. +label apply # () -> () + call parse_peek + testl $STK_HAVE_VALUE %eax + jnz do_apply. + call parse_pop + orl $STK_HAVE_VALUE %eax + call parse_push + ret +L do_apply + call ty_apply + movl @heap_ptr %ecx + movl @%ecx+-8 %ecx + movl @%ecx+-8 %ecx + movl $VAL_APP %eax + call push_value + ret + +label parse_type # () -> () + pushl %ebx + pushl %edi + pushl %esi + movl $STK_TYPE_BOTTOM %eax + call parse_push +L loop + call skip_white + movl @input %eax + cmpl @input_end %eax + je bad_eof + movb @%eax %al + cmpb $BACKSLASH %al + je forall. + cmpb $LPAREN %al + je left_paren. + # Variable + call read_ident + movl %eax %edi + movl %ecx %esi + # %edi..%esi -- ident + movl @macro_ptr %ebx + # %ebx -- macro iterator +L find_macro + cmpl macro_start %ebx + je no_macro. + subl 16 %ebx + movl %edi %eax + movl %esi %ecx + movl @%ebx %edx + pushl @%ebx+4 + call streq + je found_macro. + jmp find_macro^ + +L found_macro + movl @%ebx+12 %eax + movl @%ebx+8 %ebx + call ty_copy + # %ebx -- remaining arguments + call skip_white + movl @input %eax + cmpl @input_end %eax + je no_args. + cmpb $LBRACKET @%eax + jne no_args. + incl @input +L next_arg + call parse_type + decl %ebx + js extra_arg. + call ty_apply_forall +L arg_done + call skip_white + movl @input %eax + cmpl @input_end %eax + je bad_eof + cmpb $RBRACKET @%eax + jne next_arg^ + + incl @input +L no_args + testl %ebx %ebx + jg missing_args. + jl extra_args. +L have_args + jmp op. + +L extra_arg + call ty_pop + jmp arg_done^ + +L extra_args +rodata +string msg_extra_arg "Extraneous macro arguments +" +text + movl msg_extra_arg %eax + movl msg_extra_arg_end %ecx + call report_error + movl 1 @error_flag + jmp have_args^ + +L missing_args +rodata +string msg_missing_args "Missing macro arguments +" +text + movl msg_missing_args %eax + movl msg_missing_args_end %ecx + call report_error + movl 1 @error_flag +L fake_args + call ty_poison + call ty_apply_forall + decl %ebx %ebx + jnz fake_args^ + jmp have_args^ + +L no_macro + movl %edi %eax + movl %esi %ecx + movl $((STK_BIG_LAMBDA|STK_TYPE_FORALL)) %edx + call find_ident + testl %eax %eax + js not_found. + movl %ecx %eax + call ty_push + jmp op. +L not_found + call ty_poison + jmp op. + +L forall + movl @input %eax + incl %eax + cmpl @input_end %eax + je bad_eof + addl 2 @input + movb @%eax %al + cmpb $SLASH %al + jne bad_char + call skip_white + call read_ident + movl %eax %ebx + movl %ecx %eax + call parse_push + movl %ebx %eax + call parse_push + movl $STK_TYPE_FORALL %eax + call parse_push + jmp loop^ + +L left_paren + incl @input + movl @lineno %eax + call parse_push + movl $STK_TYPE_PAREN %eax + call parse_push + jmp loop^ + +L op + call skip_white + movl @input %eax + cmpl @input_end %eax + je end. + movb @%eax %al + cmpb $HYPHEN %al + je arrow. + cmpb $RPAREN %al + je right_paren. + jmp end. + +L arrow + movl @input %eax + incl %eax + cmpl @input_end %eax + je end. + movb @%eax %al + cmpb $GREATER %al + jne end. + addl 2 @input + movl $STK_TYPE_ARROW %eax + call parse_push + jmp loop^ + +L right_paren + movl $((STK_TYPE_PAREN|STK_TYPE_BOTTOM)) %eax + call close_type_paren + testl $STK_TYPE_PAREN %eax + jz done. + incl @input + jmp op^ + +L end + movl $STK_TYPE_BOTTOM %eax + call close_type_paren +L done + popl %esi + popl %edi + popl %ebx + ret + +label close_type_paren # (types: i32) -> (type: i32) + pushl %ebx + pushl %edi + pushl %esi + movl %eax %ebx + # %ebx -- wanted types +L loop + call parse_pop + movl %eax %edi + # %edi -- current type + testl $STK_HAVE_IDENT %edi + jz no_ident. + call parse_pop + call parse_pop +L no_ident + testl $STK_HAVE_LINENO %edi + jz no_lineno. + call parse_pop + movl %eax %esi + # %esi -- lineno +L no_lineno + testl %ebx %edi + jnz done. + testl $STK_TYPE_ARROW %edi + jnz arrow. + testl $STK_TYPE_PAREN %edi + jnz paren. + testl $STK_TYPE_FORALL %edi + jnz forall. + ud2 + +L arrow + call ty_arrow + jmp loop^ + +L paren + movl 1 @error_flag + xchgl %esi @lineno + call stderr_lineno + movl %esi @lineno + stderr "Unmatched '(' +" + jmp loop^ + +L forall + call ty_forall + jmp loop^ + +L done + movl %edi %eax + popl %esi + popl %edi + popl %ebx + ret + +label find_ident # (start: *i8, end: *i8, type: i32) -> (vidx: i32, tidx: i32, type: *type) + pushl %ebx + pushl %esi + pushl %edi + pushl %ebp + movl %edx %ebx + pushl 0 + pushl 0 + pushl %ecx + pushl %eax + call ty_top + movl %eax %edi + movl @parse_stack_ptr %esi + # %ebx -- type + # @%esp -- ident + # @%esp+4 -- ident end + # @%esp+8 -- value index + # @%esp+12 -- type index + # %esi -- pointer running down the stack + # %edi -- type stack pointer +L loop + # %ebp -- type & flags + movl @%esi %ebp + addl 4 %esi + testl $STK_HAVE_VALUE %ebp + jz no_value. + movl %edi %eax + call ty_skip + movl %eax %edi +L no_value + testl $STK_HAVE_IDENT %ebp + jz no_ident. + movl @%esi %eax + movl @%esi+4 %ecx + addl 8 %esi + movl @%esp %edx + pushl @%esp+4 + call streq + je found. +L no_ident + testl $STK_SMALL_LAMBDA %ebp + jz no_type. + movl %edi %eax + call ty_skip + movl %eax %edi +L no_type + leal @%esi+4 %eax + testl $STK_HAVE_LINENO %ebp + cmovnz %eax %esi + testl $((STK_BIG_LAMBDA|STK_TYPE_FORALL)) %ebp + jz no_type_inc. + incl @%esp+12 +L no_type_inc + testl $STK_SMALL_LAMBDA %ebp + jz no_value_inc. + incl @%esp+8 +L no_value_inc + testl $STK_BOTTOM %ebp + jz loop^ + movl @%esp %eax + movl @%esp+4 %ecx + call missing_ident +L error + movl -1 %eax + movl 1 @error_flag + jmp end. +L found + testl %ebx %ebp + jz bad_ident. + movl @%esp+8 %eax + movl @%esp+12 %ecx + movl %edi %edx +L end + addl 16 %esp + popl %ebp + popl %edi + popl %esi + popl %ebx + ret + +L bad_ident + movl @%esp %eax + movl @%esp+4 %ecx + movl %ebx %edx + call bad_ident + jmp error^ + +label read_ident # () -> (start: *i8, end: *i8) + movl @input %eax + movl %eax %ecx +L loop + cmpl @input_end %ecx + je done. + movb @%ecx %dl + incl %ecx + cmpb $UNDERSCORE %dl + je loop^ + cmpb 0x30 %dl + jb done_ungetc. + cmpb 0x39 %dl + jbe loop^ + cmpb 0x41 %dl + jb done_ungetc. + cmpb 0x5A %dl + jbe loop^ + cmpb 0x61 %dl + jb done_ungetc. + cmpb 0x7A %dl + jbe loop^ +L done_ungetc + decl %ecx +L done + cmpl %eax %ecx + je bad_char + movl %ecx @input + ret + +label bad_char + movl msg_bad_char %eax + movl msg_bad_char_end %ecx + call report_error + jmp error + +label bad_eof + cmpl 0 @macro_flag + jnz macro. + movl msg_bad_eof %eax + movl msg_bad_eof_end %ecx + call report_error + jmp error +L macro + movl msg_bad_eof_macro %eax + movl msg_bad_eof_macro_end %ecx + call report_error + jmp error + +rodata +string msg_bad_char "Unexpected character +" +string msg_bad_eof "Unexpected end of file +" +string msg_bad_eof_macro "Unexpected end of line +" +text + +# Skip whitespace including comments and macros. +label skip_white + movl @input %edx + xorl %ecx %ecx + cmpl %ecx @lineno + jne loop. + incl @lineno + incl %ecx +L loop + cmpl @input_end %edx + je done. + movb @%edx %al + cmpb $SPACE %al + je white. + cmpb $NEWLINE %al + je newline. + cmpb $TAB %al + je white. + cmpb $SEMICOLON %al + je comment. + cmpb $OCTOTHORPE %al + je macro. +L done + movl %edx @input + ret +L comment + incl %edx + cmpl @input_end %edx + je done^ + cmpb $NEWLINE @%edx + jne comment^ +L newline + incl @lineno + movl 1 %ecx + incl %edx + jmp loop^ +L white + xorl %ecx %ecx + incl %edx + jmp loop^ +L macro + testl %ecx %ecx + jz done^ + + pushl %ebx + pushl %edi + + # Macro handlings. + # 1. Find end of line + incl %edx + movl %edx @input +L loop + cmpl @input_end %edx + je eol. + cmpb $NEWLINE @%edx + je eol. + incl %edx + jmp loop^ +L eol + pushl @input_end + movl %edx @input_end + movl 1 @macro_flag + # Now, the entire input is just this line. So we can use normal parse + # functions to parse the line. There is no risk of infinite recursion since + # the input consists of a single line, so there are no newlines. + movl $STK_BOTTOM %eax + call parse_push + + call read_ident + movl @macro_ptr %edx + cmpl macro_end %edx + je macro_overflow. + movl %eax @%edx + movl %ecx @%edx+4 + movl @input %eax + cmpl @input_end %eax + je bad_eof + cmpb $LBRACKET @%eax + jne no_args. + incl @input + call skip_white +L loop + call read_ident + movl %eax %ebx + movl %ecx %eax + call parse_push + movl %ebx %eax + call parse_push + movl $STK_BIG_LAMBDA %eax + call parse_push + call skip_white + movl @input %eax + cmpl @input_end %eax + je bad_eof + cmpb $RBRACKET @%eax + jne loop^ + incl @input +L no_args + call parse_type + movl @input %eax + cmpl @input_end %eax + je ok. +rodata +string msg_macro_extra "Extraneous input at end of macro +" +text + movl msg_macro_extra %eax + movl msg_macro_extra_end %ecx + call report_error + movl 1 @error_flag + +L ok + xorl %edi %edi + # %edi -- num args +L loop + call parse_pop + testl $STK_BOTTOM %eax + jnz done. + incl %edi + call parse_pop + call parse_pop + call ty_forall + jmp loop^ +L done + movl @macro_ptr %eax + movl %edi @%eax+8 + movl @macro_type_ptr %edi + movl %edi @%eax+12 + call ty_top + movl %eax %ebx + call ty_skip + leal @%edi+%eax %ecx + subl %ebx %ecx + cmpl macro_types_end %ecx + ja macro_overflow. + movl %ecx @macro_type_ptr + # %ebx -- src + # %eax -- src end + # %edi -- dst + # %ecx -- dst end +L loop + movl @%ebx %edx + movl %edx @%edi + addl 4 %ebx + addl 4 %edi + cmpl %eax %ebx + jne loop^ + + call ty_pop + addl 16 @macro_ptr + movl @input_end %eax + movl %eax @input + popl @input_end + movl 0 @macro_flag + popl %edi + popl %ebx + jmp skip_white + +L macro_overflow + movl msg_macro_overflow %eax + movl msg_macro_overflow_end %ecx + call report_error + jmp error +rodata +string msg_macro_overflow "Too many macros +" +text + +label push_value # (val: i32, start ptr: *i32) + movl @heap_ptr %edx + addl 8 %edx + movl %edx @heap_ptr + cmpl @heap_end %edx + ja alloc. +L have_space + movl %eax @%edx+-4 + movl %ecx @%edx+-8 + ret +L alloc + pushl %eax + pushl %ecx + call alloc + popl %ecx + popl %eax + movl @heap_ptr %edx + jmp have_space^ + +label missing_ident # (start: *i8, end: *i8) -> () + pushl %eax + pushl %ecx + call stderr_lineno + stderr "Name not found: " + popl %ecx + popl %eax + call stderr + stderr " +" + ret + +label bad_ident # (start: *i8, end: *i8, wanted-type: i32) + pushl %edx + pushl %eax + pushl %ecx + call stderr_lineno + popl %ecx + popl %eax + call stderr + stderr " is not a " + popl %eax + call stderr_type + stderr " +" + ret + +label stderr_type # (type: i32) + testl $STK_SMALL_LAMBDA %eax + jnz small. +L big + stderr "type variable" + ret +L small + stderr "term variable" + ret |