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 (Global l) = "\t.globl\t" +++ 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

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")