diff options
Diffstat (limited to 'plusplus.s')
| -rw-r--r-- | plusplus.s | 326 |
1 files changed, 326 insertions, 0 deletions
diff --git a/plusplus.s b/plusplus.s new file mode 100644 index 0000000..d347a7f --- /dev/null +++ b/plusplus.s @@ -0,0 +1,326 @@ +#define $hp $gp +#define $print_back $s0 +#define $print_front $s1 +#define $eval_back $s2 +#define $eval_front $s3 + + .data + .align 2 +CONS: + .word 2 # arity + .word 4 # name + .ascii "Cons" + + .align 2 +NIL: + .word 0 # arity + .word 3 # name + .ascii "Nil" + + .align 2 +INT: + .word 0x100 # arity + .word 3 # name + .ascii "Int" + + .align 2 +PRINTROOT: + .word root + .word 0 # to be filled in +EVALROOT: + .word root + .word 0 # to be filled in + + .align 2 +heap: + + .text +main: + la $gp,heap + + # NIL @ hp[0] + la $t0,NIL+2 + sw $t0,($gp) + # INT 5 @ hp[4] + la $t0,INT+2 + sw $t0,4($gp) + ori $t0,$0,5 + sw $t0,8($gp) + # x = cons (INT 5) NIL @ hp[12] + la $t0,cons + sw $t0,12($gp) + addi $t0,$gp,4 + sw $t0,16($gp) + addi $t0,$gp,0 + sw $t0,20($gp) + # y = plusplus x x @ hp[24] + la $t0,plusplus + sw $t0,24($gp) + addi $t0,$gp,12 + sw $t0,28($gp) + sw $t0,32($gp) + # z = plusplus y y @ hp[36] + la $t0,plusplus + sw $t0,36($gp) + addi $t0,$gp,24 + sw $t0,40($gp) + sw $t0,44($gp) + # a = plusplus z z @ hp[48] + la $t0,plusplus + sw $t0,48($gp) + addi $t0,$gp,36 + sw $t0,52($gp) + sw $t0,56($gp) + + la $s0,PRINTROOT + addi $s1,$gp,48 # node to eval + sw $s1,4($s0) + + jal driver + addi $gp,$gp,60 + + 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,INT+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,indir + 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 +root: + 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 +indir: + # indirections are handled in eval + la $a0,indir_error + li $v0,4 # print_string + syscall + break 0 + + .word 0x1 # strict in 1st argument + .word 2 # arity +plusplus: + lw $t0,4($s3) # xs + lw $t1,($t0) + la $t2,NIL+2 + beq $t1,$t2,plusplus_nil + nop + # TODO check heap space + lw $t1,4($t0) # hd xs + lw $t2,8($t0) # tl xs + lw $t3,8($s3) # ys + # Build node: (++ (tl xs) ys) + la $t0,plusplus + sw $t0,($gp) + sw $t2,4($gp) + sw $t3,8($gp) + # Build node: CONS (hd xs) (++ (tl xs) ys) + la $t0,CONS+2 + sw $t0,12($gp) + sw $t1,16($gp) + sw $gp,20($gp) + # Update front and heap pointers + addi $s3,$gp,12 + j eval + addi $gp,$gp,24 +plusplus_nil: + # indirect to second argument + la $t0,indir + sw $t0,($s3) + lw $t0,8($s3) + sw $t0,4($s3) + addi $s3,$t0,0 + j eval + nop + + .word 0x3 # strict in 1st and 2nd argument + .word 2 # arity +cons: + # TODO check heap space + # Create new CONS node with same arguments + la $t0,CONS+2 + lw $t1,4($s3) + lw $t2,8($s3) + sw $t0,($gp) + sw $t1,4($gp) + sw $t2,8($gp) + # Overwrite original cons node with indirection + la $t0,indir + sw $t0,($s3) + sw $gp,4($s3) + # Update front and heap pointers + addi $s3,$gp,0 + j eval + addi $gp,$gp,12 |