aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--driver.s76
-rw-r--r--snug-clean/src/MIPS/MIPS32.dcl1
-rw-r--r--snug-clean/src/MIPS/MIPS32.icl1
-rw-r--r--snug-clean/src/Snug/Compile.icl21
-rw-r--r--snug-clean/src/Snug/Compile/ABI.dcl2
-rw-r--r--snug-clean/src/Snug/Compile/Simulate.icl2
6 files changed, 53 insertions, 50 deletions
diff --git a/driver.s b/driver.s
index 7a089a8..44520b2 100644
--- a/driver.s
+++ b/driver.s
@@ -1,10 +1,10 @@
.data
- .align 3
+ .align 1
_cINT:
- .word 0x100 # arity
- .word 3 # name
- .ascii "Int"
+ .byte 0 # pointer arity
+ .byte 1 # basic value arity
+ .byte 0 # number of arguments that still have to be curried in
.align 2
PRINTROOT:
@@ -40,10 +40,11 @@ main:
driver:
addi $sp,$sp,-4
sw $ra,($sp)
+ la $s7,0x10000000 # end of text section / begin of data section
print:
lw $t0,($s1)
- andi $t0,$t0,4
- bne $t0,$0,print_hnf
+ sltu $t0,$t0,$s7
+ beq $t0,$0,print_hnf
nop
la $s2,EVALROOT
addi $s3,$s1,0
@@ -53,41 +54,26 @@ print:
addi $s1,$s3,0
print_hnf:
lw $t0,($s1)
- la $t1,_cINT+4
+ la $t1,_cINT
beq $t0,$t1,print_int
- lw $t1,($t0) # name length
- addi $t2,$t0,4 # name
- add $t1,$t1,$t2
-print_cons:
- lw $t3,-4($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
+ lbu $t3,($t0) # arity
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
+ b print
nop
print_int:
lw $a0,4($s1)
li $v0,1 # print_int
syscall
- j print_rewind
+ b print_rewind
nop
print_rewind:
@@ -96,7 +82,7 @@ print_rewind:
addi $t0,$s0,0
addi $t1,$s0,0 # argument pointer
lw $t2,($t0)
- lw $t2,-4($t2) # arity
+ lbu $t2,($t2) # arity
print_rewind_loop:
addi $t1,$t1,4
lw $t3,($t1)
@@ -106,13 +92,13 @@ print_rewind_loop:
# 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 $a0,','
li $v0,11 # print_char
syscall
sw $s1,($t1)
lw $s1,4($t1)
sw $t3,4($t1)
- j print
+ b print
nop
print_rewind_done:
# this node is fully printed; go up to the parent
@@ -132,8 +118,8 @@ print_rewind_root:
eval:
lw $t0,($s3)
# Exit early in case of hnf
- andi $t1,$t0,4
- bne $t1,$0,eval_rewind
+ sltu $t1,$t0,$s7
+ beq $t1,$0,eval_rewind
# Walk through indirections
la $t1,_nindir
bne $t0,$t1,eval_indir_done
@@ -144,12 +130,12 @@ eval_indir:
beq $t0,$t1,eval_indir
sw $s3,4($t2) # update original indir; optimizes chained indirs
# Check again for hnf
- andi $t1,$t0,4
- bne $t1,$0,eval_rewind
+ sltu $t1,$t0,$s7
+ beq $t1,$0,eval_rewind
nop
eval_indir_done:
- lw $t1,-4($t0) # load arity
- lw $t2,-8($t0) # strictness
+ lbu $t1,-1($t0) # load arity
+ lbu $t2,-2($t0) # strictness
addi $t3,$s3,4 # argument pointer
eval_arg_loop:
beq $t1,$0,eval_args_done
@@ -162,8 +148,8 @@ eval_arg_loop:
eval_arg_strict:
lw $t4,($t3)
lw $t4,($t4)
- andi $t4,$t4,2
- beq $t4,$0,eval_arg
+ sltu $t4,$t4,$s7
+ bne $t4,$0,eval_arg
addi $t1,$t1,-1
j eval_arg_loop
addi $t3,$t3,4
@@ -203,9 +189,12 @@ eval_rewind_root:
cycle_error:
.asciiz "error: cycle in spine detected\n"
.text
- .align 3
- .word 0 # strictness
- .word 1 # arity
+ #.align 1
+ #.byte 0 # strictness
+ #.byte 1 # arity
+ # TODO: we cannot use the above because SPIM does not accept .byte in text section
+ .align 2
+ .word 0x0001 # strictness, arity
_nroot:
la $a0,cycle_error
li $v0,4 # print_string
@@ -216,9 +205,12 @@ _nroot:
indir_error:
.asciiz "error: indirection evaluated\n"
.text
- .align 3
- .word 0x1 # strictness
- .word 1 # arity
+ #.align 1
+ #.byte 0x1 # strictness
+ #.byte 1 # arity
+ # TODO: we cannot use the above because SPIM does not accept .byte in text section
+ .align 2
+ .word 0x0101 # strictness, arity
_nindir:
# indirections are handled in eval
la $a0,indir_error
diff --git a/snug-clean/src/MIPS/MIPS32.dcl b/snug-clean/src/MIPS/MIPS32.dcl
index 4789507..a2c85dc 100644
--- a/snug-clean/src/MIPS/MIPS32.dcl
+++ b/snug-clean/src/MIPS/MIPS32.dcl
@@ -7,6 +7,7 @@ from StdOverloaded import class toString
| Align !Int
| Label !Label
| Instr !Instruction
+ | RawByte !Int
| RawWord !Int
| RawAscii !String
diff --git a/snug-clean/src/MIPS/MIPS32.icl b/snug-clean/src/MIPS/MIPS32.icl
index a124007..6e602be 100644
--- a/snug-clean/src/MIPS/MIPS32.icl
+++ b/snug-clean/src/MIPS/MIPS32.icl
@@ -10,6 +10,7 @@ where
toString (Align i) = "\t.align\t" +++ toString i
toString (Label l) = l +++ ":"
toString (Instr i) = "\t" +++ toString i
+ toString (RawByte i) = "\t.byte\t" +++ toString i
toString (RawWord i) = "\t.word\t" +++ toString i
toString (RawAscii s) = concat3 "\t.ascii\t\"" s "\"" // TODO: escaping
diff --git a/snug-clean/src/Snug/Compile.icl b/snug-clean/src/Snug/Compile.icl
index 26fd5af..c354950 100644
--- a/snug-clean/src/Snug/Compile.icl
+++ b/snug-clean/src/Snug/Compile.icl
@@ -50,9 +50,16 @@ compileDefinition ns globals (DataDef _ _ constructors) =
]
compileDefinition ns globals (FunDef id args ret expr) =
[ StartSection "text"
- , Align 3 // to have 3 bits unused in addresses
- , RawWord (sum [2^i \\ i <- [0..] & _ <- args]) // all strict for now, TODO change
- , RawWord (length args) // arity
+ // TODO: Ideally we would use the following here:
+ //, Align 1
+ //, RawByte (sum [2^i \\ i <- [0..] & _ <- args]) // all strict for now, TODO change
+ //, RawByte (length args) // arity
+ // But since SPIM does not allow .byte in the text section, we use:
+ , Align 2
+ , RawWord
+ (sum [2^i \\ i <- [0..] & _ <- args] bitor // all strict for now, TODO change
+ (length args << 8)) // arity
+ // instead... (end modification)
, Label (functionLabel ns NodeEntry id)
: map Instr (compileExpr ns globals locals expr)
]
@@ -65,11 +72,11 @@ where
compileConstructor :: !Namespace !Globals !ConstructorDef -> [Line]
compileConstructor ns _ (ConstructorDef id args) =
- [ Align 3 // to have 3 bits unused in addresses
+ [ Align 1
, Label (constructorLabel ns id)
- , RawWord (length args) // arity
- , RawWord (size id) // length name
- , RawAscii id // name
+ , RawByte (length args) // pointer arity
+ , RawByte 0 // basic value arity
+ , RawByte 0 // number of arguments still to be curried in
]
compileExpr :: !Namespace !Globals !Locals !Expression -> [Instruction]
diff --git a/snug-clean/src/Snug/Compile/ABI.dcl b/snug-clean/src/Snug/Compile/ABI.dcl
index 938a65e..6de2953 100644
--- a/snug-clean/src/Snug/Compile/ABI.dcl
+++ b/snug-clean/src/Snug/Compile/ABI.dcl
@@ -13,6 +13,8 @@ FrontPrintPtr :== S 1
BackEvalPtr :== S 2
FrontEvalPtr :== S 3
+TextEndDataStart :== S 7
+
HeapPtr :== GP
TempImm :== T 0
diff --git a/snug-clean/src/Snug/Compile/Simulate.icl b/snug-clean/src/Snug/Compile/Simulate.icl
index 9f09467..620ec3e 100644
--- a/snug-clean/src/Snug/Compile/Simulate.icl
+++ b/snug-clean/src/Snug/Compile/Simulate.icl
@@ -83,7 +83,7 @@ storeStackValue (SVRegOffset reg offset) doffset dreg = add
buildCons :: !Label !Int -> Simulator ()
buildCons cons nargs =
- write_heap (SVImmediate (Address 4 cons)) >>= \addr ->
+ write_heap (SVImmediate (Address 0 cons)) >>= \addr ->
mapM_ (\_ -> pop >>= write_heap) [1..nargs] >>|
push addr
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-12 16:11:42 +0000