src/ASM/printOps.ml

   1 (* Pasted from Pottier's PP compiler *)
   2
   3 open MIPSOps
   4 open Printf
   5
   6 (* Some of the instructions that we emit are in fact pseudo-instructions. *)
   7
   8 (* We use [addu], [addiu], and [subu] instead of [add], [addi], and
   9    [sub]. The only difference is that the former never generate
  10    overflow exceptions. This is what we desire, since the semantics
  11    of Pseudo-Pascal says nothing about overflow exceptions. Overflow
  12    is silent. *)
  13
  14 let unop reg f (op, dst, src) =
  15   match op with
  16   | UOpAddi 0l ->
  17       sprintf "move    %a, %a" reg dst reg src (* pseudo-instruction *)
  18   | UOpAddi i ->
  19       sprintf "addi    %a, %a, %ld" reg dst reg src i
  20   | UOpSlti i ->
  21       sprintf "slti    %a, %a, %ld" reg dst reg src i
  22   | UOpSltiu i ->
  23       sprintf "sltiu   %a, %a, %ld" reg dst reg src i
  24   | UOpAndi i ->
  25       sprintf "andi    %a, %a, %ld" reg dst reg src i
  26   | UOpOri i ->
  27       sprintf "ori     %a, %a, %ld" reg dst reg src i
  28   | UOpXori i ->
  29       sprintf "xori    %a, %a, %ld" reg dst reg src i
  30   | UOpNeg ->
  31       sprintf "neg     %a, %a" reg dst reg src
  32   | UOpNot ->
  33       sprintf "not     %a, %a" reg dst reg src
  34
  35 let binop = function
  36   | OpAdd ->
  37       "add    "
  38   | OpSub ->
  39       "sub    "
  40   | OpMul ->
  41       "mulo   "
  42   | OpDiv ->
  43       "div    " (* pseudo-instruction *)
  44   | OpDivu ->
  45       "divu   " (* pseudo-instruction *)
  46   | OpModu ->
  47       "remu   " (* pseudo-instruction *)
  48   | OpLt ->
  49       "slt    "
  50   | OpLtu ->
  51       "sltu   "
  52   | OpLe ->
  53       "sle    " (* pseudo-instruction *)
  54   | OpLeu ->
  55       "sleu   " (* pseudo-instruction *)
  56   | OpGt ->
  57       "sgt    " (* pseudo-instruction *)
  58   | OpGtu ->
  59       "sgtu   " (* pseudo-instruction *)
  60   | OpGe ->
  61       "sge    " (* pseudo-instruction *)
  62   | OpGeu ->
  63       "sgeu   " (* pseudo-instruction *)
  64   | OpEq ->
  65       "seq    " (* pseudo-instruction *)
  66   | OpNe ->
  67       "sne    " (* pseudo-instruction *)
  68   | OpSllv ->
  69       "sllv   "
  70   | OpSrav ->
  71       "srav   "
  72   | OpSrlv ->
  73       "srlv   "
  74   | OpAnd ->
  75       "and    "
  76   | OpOr ->
  77       "or     "
  78   | OpXor ->
  79       "xor    "
  80
  81 let uncon reg f (cond, src) =
  82   match cond with
  83   | UConGez ->
  84       sprintf "bgez   %a" reg src
  85   | UConGtz ->
  86       sprintf "bgtz   %a" reg src
  87   | UConLez ->
  88       sprintf "blez   %a" reg src
  89   | UConLtz ->
  90       sprintf "bltz   %a" reg src
  91
  92 let bincon = function
  93   | ConEq ->
  94       "beq    "
  95   | ConNe ->
  96       "bne    "