Add compilation of constructors and basic values

2 files changed, 258 insertions, 0 deletions

diff --git a/snug-clean/src/MIPS/MIPS32.dcl b/snug-clean/src/MIPS/MIPS32.dcl
new file mode 100644
index 0000000..4789507
--- /dev/null
+++ b/snug-clean/src/MIPS/MIPS32.dcl
@@ -0,0 +1,96 @@
+definition module MIPS.MIPS32
+
+from StdOverloaded import class toString
+
+:: Line
+	= StartSection !String
+	| Align !Int
+	| Label !Label
+	| Instr !Instruction
+	| RawWord !Int
+	| RawAscii !String
+
+instance toString Line
+
+:: Instruction
+	= LoadByte !Signedness !TargetRegister !Offset !Base
+	| LoadHalfword !Signedness !TargetRegister !Offset !Base
+	| LoadWord !TargetRegister !Offset !Base
+	| StoreByte !TargetRegister !Offset !Base
+	| StoreHalfword !TargetRegister !Offset !Base
+	| StoreWord !TargetRegister !Offset !Base
+
+	| AddImmediate !Signedness !DestinationRegister !SourceRegister !Immediate
+	| AndImmediate !DestinationRegister !SourceRegister !Immediate
+	| LoadUpperImmediate !DestinationRegister !Immediate
+	| OrImmediate !DestinationRegister !SourceRegister !Immediate
+	| XorImmediate !DestinationRegister !SourceRegister !Immediate
+
+	| AddWord !Signedness !DestinationRegister !SourceRegister !TargetRegister
+	| AndWord !DestinationRegister !SourceRegister !TargetRegister
+	| NorWord !DestinationRegister !SourceRegister !TargetRegister
+	| OrWord !DestinationRegister !SourceRegister !TargetRegister
+	| SubWord !Signedness !DestinationRegister !SourceRegister !TargetRegister
+	| XorWord !DestinationRegister !SourceRegister !TargetRegister
+
+	| Jump !Link !JumpTarget
+	| BranchOn1 !BranchCondition1 !SourceRegister !Offset
+	| BranchOn2 !BranchCondition2 !SourceRegister !TargetRegister !Offset
+
+	| Break !Int
+	| Syscall !Int /* applications should also set v0 to the syscall argument */
+
+	| LoadAddress !DestinationRegister !Immediate
+	| Nop
+
+Move rd rs :== OrImmediate rd rs (Immediate 0)
+
+instance toString Instruction
+
+:: Signedness
+	= Signed
+	| Unsigned
+
+:: Base :== Register
+:: Offset :== Int /* 16-bit signed */
+
+:: DestinationRegister :== Register
+:: SourceRegister :== Register
+:: TargetRegister :== Register
+
+:: Register
+	= R0 /* always zero */
+	| AT /* reserved for assembler; do not use */
+	| V0 | V1 /* expression evaluations, integer results, static link for nested procedures */
+	| A !Int /* 0-3, integer arguments, values not preserved */
+	| T !Int /* 0-9, temporary, values not preserved */
+	| S !Int /* 0-7, saved, values preserved */
+	| K0 | K1 /* reserved for the kernel */
+	| GP /* global (heap) pointer */
+	| SP /* stack pointer */
+	| FP /* frame pointer if needed; otherwise saved register */
+	| RA /* return address; temporary */
+
+:: Immediate
+	= Immediate !Int /* 16-bit */
+	| Address !Offset !Label
+
+:: Link
+	= Link
+	| NoLink
+
+:: JumpTarget
+	= Direct !Immediate
+	| Register !Register
+
+:: Label :== String
+
+:: BranchCondition1
+	= BCGeZero !Link
+	| BCGtZero
+	| BCLeZero
+	| BCLtZero !Link
+
+:: BranchCondition2
+	= BCEq
+	| BCNe
diff --git a/snug-clean/src/MIPS/MIPS32.icl b/snug-clean/src/MIPS/MIPS32.icl
new file mode 100644
index 0000000..a124007
--- /dev/null
+++ b/snug-clean/src/MIPS/MIPS32.icl
@@ -0,0 +1,162 @@
+implementation module MIPS.MIPS32
+
+import StdEnv
+
+import Text
+
+instance toString Line
+where
+	toString (StartSection s) = "\t." +++ s
+	toString (Align i) = "\t.align\t" +++ toString i
+	toString (Label l) = l +++ ":"
+	toString (Instr i) = "\t" +++ toString i
+	toString (RawWord i) = "\t.word\t" +++ toString i
+	toString (RawAscii s) = concat3 "\t.ascii\t\"" s "\"" // TODO: escaping
+
+instance toString Instruction
+where
+	toString (LoadByte signed rt offset base) =
+		memInstrS (if (signed=:Signed) "lb" "lbu") rt (checkOffset offset) base
+	toString (LoadHalfword signed rt offset base) =
+		memInstrS (if (signed=:Signed) "lh" "lhu") rt (checkOffset offset) base
+	toString (LoadWord rt offset base) =
+		memInstrS "lw" rt (checkOffset offset) base
+	toString (StoreByte rt offset base) =
+		memInstrS "sb" rt (checkOffset offset) base
+	toString (StoreHalfword rt offset base) =
+		memInstrS "sh" rt (checkOffset offset) base
+	toString (StoreWord rt offset base) =
+		memInstrS "sw" rt (checkOffset offset) base
+
+	toString (AddImmediate signed rt rs imm) =
+		immediateInstrS (if (signed=:Signed) "addi" "addiu") rt rs (checkImmediate signed imm)
+	toString (AndImmediate rt rs imm) =
+		immediateInstrS "andi" rt rs (checkImmediate Unsigned imm)
+	toString (LoadUpperImmediate rt imm) =
+		concat ["lui\t",toString rt,",",toString (checkImmediate Unsigned imm)]
+	toString (OrImmediate rt rs imm) =
+		immediateInstrS "ori" rt rs (checkImmediate Unsigned imm)
+	toString (XorImmediate rt rs imm) =
+		immediateInstrS "xori" rt rs (checkImmediate Unsigned imm)
+
+	toString (AddWord signed rd rs rt) =
+		threeRegInstrS (if (signed=:Signed) "add" "addu") rd rs rt
+	toString (AndWord rd rs rt) =
+		threeRegInstrS "and" rd rs rt
+	toString (NorWord rd rs rt) =
+		threeRegInstrS "nor" rd rs rt
+	toString (OrWord rd rs rt) =
+		threeRegInstrS "or" rd rs rt
+	toString (SubWord signed rd rs rt) =
+		threeRegInstrS (if (signed=:Signed) "sub" "subu") rd rs rt
+	toString (XorWord rd rs rt) =
+		threeRegInstrS "xor" rd rs rt
+
+	toString (Jump link target) =
+		instr +++ toString target
+	where
+		instr = case (link, target) of
+			(NoLink, Direct _) -> "j\t"
+			(Link, Direct _) -> "jal\t"
+			(NoLink, Register _) -> "jr\t"
+			(Link, Register _) -> "jalr\t"
+	toString (BranchOn1 (BCGeZero link) rs offset) =
+		branch1InstrS (if (link=:Link) "bgezal" "bgez") rs (checkOffset offset)
+	toString (BranchOn1 BCGtZero rs offset) =
+		branch1InstrS "bgtz" rs (checkOffset offset)
+	toString (BranchOn1 BCLeZero rs offset) =
+		branch1InstrS "blez" rs (checkOffset offset)
+	toString (BranchOn1 (BCLtZero link) rs offset) =
+		branch1InstrS (if (link=:Link) "bltzal" "bltz") rs (checkOffset offset)
+	toString (BranchOn2 cond rs rt offset) =
+		immediateInstrS (if (cond=:BCEq) "beq" "bne") rs rt (Immediate (checkOffset offset))
+
+	toString (Break arg) =
+		"break\t" +++ toString arg
+	toString (Syscall arg) =
+		"syscall\t" +++ toString arg
+
+	toString (LoadAddress rd imm) =
+		concat4 "la\t" (toString rd) "," (toString imm)
+	toString Nop =
+		"nop"
+
+instance toString JumpTarget
+where
+	toString (Direct imm)
+		= toString imm
+	toString (Register r)
+		= toString r
+
+instance toString Immediate
+where
+	toString (Immediate i)
+		= toString i
+	toString (Address offset label)
+		| offset == 0
+			= label
+		| offset > 0
+			= concat3 label "+" (toString offset)
+			= concat3 label "-" (toString offset)
+
+memInstrS :: !String !Register !Offset !Base -> String
+memInstrS opcode rt 0 base = concat [opcode,"\t",toString rt,",(",toString base,")"]
+memInstrS opcode rt offset base = concat [opcode,"\t",toString rt,",",toString offset,"(",toString base,")"]
+
+immediateInstrS :: !String !TargetRegister !SourceRegister !Immediate -> String
+immediateInstrS opcode rt rs imm = concat [opcode,"\t",toString rt,",",toString rs,",",toString imm]
+
+threeRegInstrS :: !String !DestinationRegister !SourceRegister !TargetRegister -> String
+threeRegInstrS opcode rd rs rt = concat [opcode,"\t",toString rd,",",toString rs,",",toString rt]
+
+branch1InstrS :: !String !SourceRegister !Offset -> String
+branch1InstrS opcode rs offset = concat [opcode,"\t",toString rs,",",toString offset]
+
+instance toString Register
+where
+	toString reg = toString` (checkReg reg)
+	where
+		/* Sorted by estimated frequency for efficiency */
+		toString` (T n) = "$t" +++ toString n
+		toString` (S n) = "$s" +++ toString n
+		toString` (A n) = "$a" +++ toString n
+		toString` R0 = "$0"
+		toString` GP = "$gp"
+		toString` SP = "$sp"
+		toString` FP = "$fp"
+		toString` RA = "$ra"
+		toString` AT = "$at"
+		toString` V0 = "$v0"
+		toString` V1 = "$v1"
+		toString` K0 = "$k0"
+		toString` K1 = "$k1"
+
+checkReg :: !Register -> Register
+checkReg (T n) | not (0 <= n && n <= 9)
+	= abort ("non-existing register $t" +++ toString n +++ "\n")
+checkReg (S n) | not (0 <= n && n <= 7)
+	= abort ("non-existing register $s" +++ toString n +++ "\n")
+checkReg (A n) | not (0 <= n && n <= 3)
+	= abort ("non-existing register $a" +++ toString n +++ "\n")
+checkReg reg
+	= reg
+
+checkOffset :: !Int -> Int
+checkOffset offset
+	| 0 <= offset && offset <= 0x7fff
+		= offset
+	| offset >= -0x8000
+		= offset bitand 0xffff
+		= abort ("offset " +++ toString offset +++ " out of bounds\n")
+
+checkImmediate :: !Signedness !Immediate -> Immediate
+checkImmediate Signed (Immediate imm)
+	| 0 <= imm && imm <= 0x7fff
+		= Immediate imm
+	| imm >= -0x8000
+		= Immediate (imm bitand 0xffff)
+		= abort ("signed immediate " +++ toString imm +++ " out of bounds\n")
+checkImmediate Unsigned (Immediate imm)
+	| 0 <= imm && imm <= 0xffff
+		= Immediate imm
+		= abort ("unsigned immediate " +++ toString imm +++ " out of bounds\n")