Align on halfwords instead of double words; use data/text boundary to distinguish hnfs and thunks

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