diff options
Diffstat (limited to 'driver.s')
-rw-r--r-- | driver.s | 225 |
1 files changed, 225 insertions, 0 deletions
diff --git a/driver.s b/driver.s new file mode 100644 index 0000000..429b147 --- /dev/null +++ b/driver.s @@ -0,0 +1,225 @@ + .data + + .align 3 +_cINT: + .word 0x100 # arity + .word 3 # name + .ascii "Int" + + .align 2 +PRINTROOT: + .word _nroot + .word 0 # to be filled in +EVALROOT: + .word _nroot + .word 0 # to be filled in + + .align 2 +heap: + + .text +main: + la $gp,heap + + la $t0,__main_ntest + sw $t0,($gp) + + la $s0,PRINTROOT + ori $s1,$gp,0 + sw $s1,4($s0) + + jal driver + addi $gp,$gp,8 + + li $a0,'\n' + li $v0,11 # print_char + syscall + li $v0,10 # exit + syscall + +driver: + addi $sp,$sp,-4 + sw $ra,($sp) +print: + lw $t0,($s1) + andi $t0,$t0,2 + bne $t0,$0,print_hnf + nop + la $s2,EVALROOT + addi $s3,$s1,0 + sw $s3,4($s2) + jal eval + nop + addi $s1,$s3,0 +print_hnf: + lw $t0,($s1) + la $t1,_cINT+2 + beq $t0,$t1,print_int + lw $t1,2($t0) # name length + addi $t2,$t0,6 # name + add $t1,$t1,$t2 +print_cons: + lw $t3,-2($t0) # arity + beq $t3,$0,print_cons_no_paren + li $a0,'(' + li $v0,11 # print_char + syscall +print_cons_no_paren: + lb $a0,($t2) + li $v0,11 # print_char + syscall + addi $t2,$t2,1 + bne $t1,$t2,print_cons_no_paren + nop + beq $t3,$0,print_rewind + li $a0,' ' + li $v0,11 # print_char + syscall + # continue with printing the arguments + addi $t2,$s0,1 + addi $s0,$s1,0 + lw $s1,4($s1) + sw $t2,4($s0) + j print + nop + +print_int: + lw $a0,4($s1) + li $v0,1 # print_int + syscall + j print_rewind + nop + +print_rewind: + la $t5,PRINTROOT + beq $s0,$t5,print_rewind_root + addi $t0,$s0,0 + addi $t1,$s0,0 # argument pointer + lw $t2,($t0) + lw $t2,-2($t2) # arity +print_rewind_loop: + addi $t1,$t1,4 + lw $t3,($t1) + andi $t4,$t3,1 + beq $t4,$0,print_rewind_loop + addi $t2,$t2,-1 + # we have found the argument that was being printed + beq $t2,$0,print_rewind_done + # there is a next argument to print + li $a0,' ' + li $v0,11 # print_char + syscall + sw $s1,($t1) + lw $s1,4($t1) + sw $t3,4($t1) + j print + nop +print_rewind_done: + # this node is fully printed; go up to the parent + li $a0,')' + li $v0,11 # print_char + syscall + xori $s0,$t3,1 + sw $s1,($t1) + addi $s1,$t0,0 + j print_rewind + nop +print_rewind_root: + lw $ra,($sp) + jr $ra + addi $sp,$sp,4 + +eval: + lw $t0,($s3) + # Exit early in case of hnf + andi $t1,$t0,2 + bne $t1,$0,eval_rewind + # Walk through indirections + la $t1,_nindir + bne $t0,$t1,eval_indir_done + addi $t2,$s3,0 +eval_indir: + lw $s3,4($s3) + lw $t0,($s3) + beq $t0,$t1,eval_indir + sw $s3,4($t2) # update original indir; optimizes chained indirs + # Check again for hnf + andi $t1,$t0,2 + bne $t1,$0,eval_rewind + nop +eval_indir_done: + lw $t1,-4($t0) # load arity + lw $t2,-8($t0) # strictness + addi $t3,$s3,4 # argument pointer +eval_arg_loop: + beq $t1,$0,eval_args_done + andi $t4,$t2,1 + bne $t4,$0,eval_arg_strict + srl $t2,$t2,1 + addi $t1,$t1,-1 + j eval_arg_loop + addi $t3,$t3,4 +eval_arg_strict: + lw $t4,($t3) + lw $t4,($t4) + andi $t4,$t4,2 + beq $t4,$0,eval_arg + addi $t1,$t1,-1 + j eval_arg_loop + addi $t3,$t3,4 +eval_arg: + lw $t4,($t3) # reverse pointers + addi $s2,$s2,1 + sw $s2,($t3) + addi $s2,$s3,0 + addi $s3,$t4,0 + j eval # continue evaluating argument + nop +eval_args_done: + jr $t0 + nop + +eval_rewind: + la $t4,EVALROOT + beq $s2,$t4,eval_rewind_root + addi $t0,$s2,0 + addi $t1,$s2,0 +eval_rewind_loop: + addi $t1,$t1,4 + lw $t2,($t1) + andi $t3,$t2,1 + beq $t3,$0,eval_rewind_loop + nop + xori $s2,$t2,1 + sw $s3,($t1) + addi $s3,$t0,0 + j eval + nop +eval_rewind_root: + jr $ra + nop + + .data +cycle_error: + .asciiz "error: cycle in spine detected\n" + .text + .word 0 # strictness + .word 1 # arity +_nroot: + la $a0,cycle_error + li $v0,4 # print_string + syscall + break 0 + + .data +indir_error: + .asciiz "error: indirection evaluated\n" + .text + .word 0x1 # strictness + .word 1 # arity +_nindir: + # indirections are handled in eval + la $a0,indir_error + li $v0,4 # print_string + syscall + break 0 |