(* Pasted from Pottier's PP compiler *)

open MIPSOps
open Printf

(* Some of the instructions that we emit are in fact pseudo-instructions. *)

(* We use [addu], [addiu], and [subu] instead of [add], [addi], and
   [sub]. The only difference is that the former never generate
   overflow exceptions. This is what we desire, since the semantics
   of Pseudo-Pascal says nothing about overflow exceptions. Overflow
   is silent. *)

let unop reg f (op, dst, src) =
  match op with
  | UOpAddi 0l ->
      sprintf "move    %a, %a" reg dst reg src (* pseudo-instruction *)
  | UOpAddi i ->
      sprintf "addi    %a, %a, %ld" reg dst reg src i
  | UOpSlti i ->
      sprintf "slti    %a, %a, %ld" reg dst reg src i
  | UOpSltiu i ->
      sprintf "sltiu   %a, %a, %ld" reg dst reg src i
  | UOpAndi i ->
      sprintf "andi    %a, %a, %ld" reg dst reg src i
  | UOpOri i ->
      sprintf "ori     %a, %a, %ld" reg dst reg src i
  | UOpXori i ->
      sprintf "xori    %a, %a, %ld" reg dst reg src i
  | UOpNeg ->
      sprintf "neg     %a, %a" reg dst reg src
  | UOpNot ->
      sprintf "not     %a, %a" reg dst reg src

let binop = function
  | OpAdd ->
      "add    "
  | OpSub ->
      "sub    "
  | OpMul ->
      "mulo   "
  | OpDiv ->
      "div    " (* pseudo-instruction *)
  | OpDivu ->
      "divu   " (* pseudo-instruction *)
  | OpModu ->
      "remu   " (* pseudo-instruction *)
  | OpLt ->
      "slt    "
  | OpLtu ->
      "sltu   "
  | OpLe ->
      "sle    " (* pseudo-instruction *)
  | OpLeu ->
      "sleu   " (* pseudo-instruction *)
  | OpGt ->
      "sgt    " (* pseudo-instruction *)
  | OpGtu ->
      "sgtu   " (* pseudo-instruction *)
  | OpGe ->
      "sge    " (* pseudo-instruction *)
  | OpGeu ->
      "sgeu   " (* pseudo-instruction *)
  | OpEq ->
      "seq    " (* pseudo-instruction *)
  | OpNe ->
      "sne    " (* pseudo-instruction *)
  | OpSllv ->
      "sllv   "
  | OpSrav ->
      "srav   "
  | OpSrlv ->
      "srlv   "
  | OpAnd ->
      "and    "
  | OpOr ->
      "or     "
  | OpXor ->
      "xor    "

let uncon reg f (cond, src) =
  match cond with
  | UConGez ->
      sprintf "bgez   %a" reg src
  | UConGtz ->
      sprintf "bgtz   %a" reg src
  | UConLez ->
      sprintf "blez   %a" reg src
  | UConLtz ->
      sprintf "bltz   %a" reg src

let bincon = function
  | ConEq ->
      "beq    "
  | ConNe ->
      "bne    "