1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
(** Copyright 2025, Ksenia Kotelnikova <xeniia.ka@gmail.com>, Sofya Kozyreva <k81sofia@gmail.com>, Vyacheslav Kochergin <vyacheslav.kochergin1@gmail.com> *)
(** SPDX-License-Identifier: LGPL-3.0-or-later *)
open Format
type value =
| Num of int
| Ptr of int
type reg =
| Zero
| Ra
| Fp
| Sp
| Stack of int * reg (* offset from sp or fp *)
| Temp of int
| Saved of int
| Arg of int
type variable_type =
| Argument
| Local
(* for mapping names with the way they can be reached *)
type meta_info =
| Var of int * variable_type
(* represents stack offset of a variable, and bool if it is an argument *)
| Func of string * int (* represents label and arity of a function *)
| Value of reg (* represents value in a register *)
let temp i = Temp i
let saved i = Saved i
let arg i = Arg i
(* small subset enough to codegen factorial *)
type rtype_op =
| ADD
| SUB
| MUL
| DIV
| AND
| OR
| XOR
| SLT
type itype_op =
| ADDI
(* | LI *)
| JALR
| SLTI
| XORI
| SLLI (* for converting ints into tagged ints *)
| SRLI (* and back *)
type stack_op =
| LW
| SW
| LD
| SD
(* type stype_op = SW *)
type btype_op =
| BEQ
| BNE
| BLE
type utype_op =
| LUI
| AUIPC
type jtype_op = JAL
type pseudo_instr =
| LI of reg * value
| LA of reg * string
| MV of reg * reg
| J of string
| RET
| CALL of string
| SNEZ of reg * reg (* puts 0 in rd if rs equals 0, else puts 1. is used for <> binop *)
| SEQZ of reg * reg (* puts 1 in rd if rs equals 0, else puts 0. is used for = binop *)
type true_instr =
| RType of rtype_op * reg * reg * reg (* op rd rs1 rs2 *)
| IType of itype_op * reg * reg * value (* op rd rs1 imm *)
| StackType of stack_op * reg * reg (* op rd offset(rs) *)
(*| SType of stype_op * reg * reg * int (* op rs2 rs1 imm *) *)
| BType of btype_op * reg * reg * string (* op rs1 rs2 imm/label offset *)
| UType of utype_op * reg * value (* op rd imm *)
| JType of jtype_op * reg * value (* op rd imm/label offset *)
| Label of string
| Ecall
type instr =
| True of true_instr
| Pseudo of pseudo_instr
let pp_value fmt = function
| Num imm -> fprintf fmt "%d" imm
| Ptr imm -> fprintf fmt "%d" imm
;;
let rec pp_reg fmt = function
| Zero -> fprintf fmt "x0"
| Ra -> fprintf fmt "ra"
| Fp -> fprintf fmt "fp"
| Sp -> fprintf fmt "sp"
| Stack (o, reg) ->
let () = fprintf fmt "%d(" o in
let () = pp_reg fmt reg in
fprintf fmt ")"
| Temp i -> fprintf fmt "t%d" i
| Saved i -> fprintf fmt "s%d" i
| Arg i -> fprintf fmt "a%d" i
;;
let pp_rtype_op fmt = function
| ADD -> fprintf fmt "add"
| SUB -> fprintf fmt "sub"
| MUL -> fprintf fmt "mul"
| DIV -> fprintf fmt "div"
| AND -> fprintf fmt "and"
| OR -> fprintf fmt "or"
| XOR -> fprintf fmt "xor"
| SLT -> fprintf fmt "slt"
;;
let pp_itype_op fmt = function
| ADDI -> fprintf fmt "addi"
(* | LI -> fprintf fmt "li" *)
| JALR -> fprintf fmt "jalr"
| SLTI -> fprintf fmt "slti"
| XORI -> fprintf fmt "xori"
| SLLI -> fprintf fmt "slli"
| SRLI -> fprintf fmt "srli"
;;
let pp_stack_op fmt = function
| LW -> fprintf fmt "lw"
| SW -> fprintf fmt "sw"
| LD -> fprintf fmt "ld"
| SD -> fprintf fmt "sd"
;;
(* let pp_stype_op fmt = function
| SW -> fprintf fmt "sw"
;; *)
let pp_btype_op fmt = function
| BEQ -> fprintf fmt "beq"
| BNE -> fprintf fmt "bne"
| BLE -> fprintf fmt "ble"
;;
let pp_utype_op fmt = function
| LUI -> fprintf fmt "lui"
| AUIPC -> fprintf fmt "auipc"
;;
let pp_jtype_op fmt = function
| JAL -> fprintf fmt "jal"
;;
let pp_pseudo_instr fmt = function
| LI (r, imm) -> fprintf fmt "@[\tli %a, %a@]@." pp_reg r pp_value imm
| LA (r, l) -> fprintf fmt "@[\tla %a, %s@]@." pp_reg r l
| MV (r1, r2) -> fprintf fmt "@[\tmv %a, %a@]@." pp_reg r1 pp_reg r2
| J l -> fprintf fmt "@[\tj %s@]@." l
| RET -> fprintf fmt "@[\tret @]@."
| CALL l -> fprintf fmt "@[\tcall %s@]@." l
| SNEZ (r1, r2) -> fprintf fmt "@[\tsnez %a, %a@]@." pp_reg r1 pp_reg r2
| SEQZ (r1, r2) -> fprintf fmt "@[\tseqz %a, %a@]@." pp_reg r1 pp_reg r2
;;
let pp_true_instr fmt = function
| RType (op, rd, rs1, rs2) ->
fprintf fmt "@[\t%a %a, %a, %a@]@." pp_rtype_op op pp_reg rd pp_reg rs1 pp_reg rs2
| IType (op, rd, rs1, imm) ->
fprintf fmt "@[\t%a %a, %a, %a@]@." pp_itype_op op pp_reg rd pp_reg rs1 pp_value imm
| StackType (op, rd, rs) ->
fprintf fmt "@[\t%a %a, %a@]@." pp_stack_op op pp_reg rd pp_reg rs
(* | SType (op, rs2, rs1, imm) ->
fprintf fmt "@[\t%a %a, %d(%a)@]@." pp_stype_op op pp_reg rs2 imm pp_reg rs1 *)
| BType (op, rs1, rs2, l) ->
fprintf fmt "@[\t%a %a, %a, %s@]@." pp_btype_op op pp_reg rs1 pp_reg rs2 l
| UType (op, rd, imm) ->
fprintf fmt "@[\t%a %a, %a@]@." pp_utype_op op pp_reg rd pp_value imm
| JType (op, rd, imm) ->
fprintf fmt "@[\t%a %a, %a@]@." pp_jtype_op op pp_reg rd pp_value imm
| Label l -> fprintf fmt "%s:@." l
| Ecall -> fprintf fmt "ecall@."
;;
let pp_instr = function
| True i -> pp_true_instr std_formatter i
| Pseudo i -> pp_pseudo_instr std_formatter i
;;