diff options
Diffstat (limited to 'snug-clean/src/MIPS/MIPS32.icl')
| -rw-r--r-- | snug-clean/src/MIPS/MIPS32.icl | 162 |
1 files changed, 162 insertions, 0 deletions
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") |