Fix loongson implementation of some versions of stream_read/write.
[jiton:jiton.git] / impl_loongson.ml
1 (* Loongson is basically a MIPS3 architecture, with the addition of some
2  * multimedia instructions.  It thus have :
3  *
4  * - 32 64 bits wide general purpose registers, of which 30 can be used freely
5  * as reg 0 has a fixed content of 0 and reg 29 is used as the stack pointer.
6  * On procedure entry we save register 31 (which holds the return address)
7  * onto the stack so that it became available for processing. HI and LO
8  * registers does not appear as available registers of course, even if they are
9  * used to implement some operations. We don't care about reg 30 (frame pointer)
10  * that we use as a disposable register.
11  *
12  * - 32 64 bits wide general floating point registers, all of which being
13  * available (denoted by prefix "f").
14  *
15  * SIMD instructions can perform integer operations on data of 8, 16, 32 or 64
16  * bits in size, using the floating point registers.
17  *
18  * Loongson supports only little endian mode (which is the good one).
19  * All memory accesses must be aligned by a multiple of the data size accessed.
20  *
21  * Functions are called (and returned from) according to the N32 ABI, which is
22  * summarized here :
23  *
24  * - Stack holds 64bits values
25  * - we use registers 4 to 11 to pass integers arguments
26  * - we use FP registers f12 to f19 to pass FP arguments
27  * - these registers are "allocated" even if not used. For instance, prototype
28  *   int, float, int will use register 4, f13, 6
29  * - registers 16 to 23, as well a 28 to 30 are callee saved
30  * - FP registers f20 to f31 are callee saved
31  *
32  * A map of the general purpose registers may help :
33  * 
34  * 0 -> zero
35  * 1..11 -> used to pass arguments
36  * 12..15 ->
37  * 16..23 -> callee-saved
38  * 24..27 ->
39  * 28 -> callee-saved
40  * 29 -> stack pointer, callee-saved
41  * 30 -> (frame pointer), callee-saved
42  * 31 -> (return address), callee-saved
43  *
44  * Note : for now we suppose that we took only integer parameters, which seams reasonable
45  * as we expect mainly pointers to buffers and a width.
46  *)
47
48 open Jiton
49
50 module rec Codebuf : CODEBUFFER = Codebuffer_impl.Codebuffer (Loongson)
51 and Loongson : IMPLEMENTER =
52 struct
53         type word = int32
54         let word_of_int = Int32.of_int
55         let int_of_word = Int32.to_int
56         let nativeint_of_word = Nativeint.of_int32
57         let word_of_string = Int32.of_string
58         let string_of_word = Int32.to_string
59
60         (* Registers *)
61         let register_sets = [|
62                 30 (* number of general registers *) ;
63                 32 (* number of FP/MMX registers *) |]
64         
65         let reg_of = function
66                 | 0, r ->
67                         if r = 0 then 30
68                         else if r = 29 then 31
69                         else r
70                 | _, c -> c
71         
72         let string_of_reg_id (b, r) =
73                 if b = 0 then Printf.sprintf "$%d" (reg_of (0, r))
74                 else (
75                         assert (b = 1) ;
76                         Printf.sprintf "$f%d" (reg_of (1, r)))
77
78         let alignment scale = scale
79
80         (* loop_descr is used to remember where a loop started and where it stops *) 
81         type loop_descr_record = { start : int ; blez : int ; top : loop_descr }
82         and loop_descr = loop_descr_record option
83
84         type proc =
85                 { buffer : Codebuf.t ;  (* program counter *)
86                   mutable loops : loop_descr ;  (* used only when emitting code not when running *)
87                   mutable params : word array ; (* used by load_param operation *)
88                   mutable frame_size : int ; (* the size of our stack frame *)
89                   mutable callee_saved : (int * reg_id) list } (* the reg and location of saved caller regs *)
90
91         type emitter = proc -> (string -> reg_id) -> unit
92         type op_impl =
93                 { helpers : (helper_kind * string * op_impl) array ;
94                   out_banks : bank_num array ;
95                   emitter : emitter }
96
97         type spec_in =
98                 | Reg of (bank_num * data_type)
99                 | Cst of word
100         type impl_lookup = scale * spec_in array * spec_out array -> op_impl
101
102         (* Misc *)
103         let unopt = function
104                 | None -> failwith "Nothing where something was expected."
105                 | Some x -> x
106
107         let rec log2 x =
108                 if x <= 1 then 0
109                 else 1 + (log2 (x lsr 1))
110
111         (* MIPS instruction encoding *)
112
113         let append_hw buffer value =
114                 Codebuf.append buffer (value land 0xff) ;
115                 Codebuf.append buffer ((value lsr 8) land 0xff)
116         
117         let emit_I_type buffer op rs rt imm =
118                 assert (imm >= -32768 && imm < 65536) ; (* we ignore here if imm is signed *)
119                 append_hw buffer imm ;
120                 append_hw buffer
121                         ((op lsl 10) lor ((rs land 0b11111) lsl 5) lor (rt land 0b11111))
122
123         let emit_J_type buffer op instr_idx =
124                 append_hw buffer instr_idx ;
125                 append_hw buffer
126                         ((op lsl 10) lor ((instr_idx lsr 16) land 0b1111111111))
127
128         let emit_R_type buffer op rs rt rd sa fn =
129                 assert (op <= 0b111111) ;
130                 assert (rs <= 0b11111) ;
131                 assert (rt <= 0b11111) ;
132                 assert (rd <= 0b11111) ;
133                 assert (sa <= 0b11111) ;
134                 assert (fn <= 0b111111) ;
135                 append_hw buffer
136                         ((rd lsl 11) lor ((sa land 0b11111) lsl 6) lor (fn land 0b111111)) ;
137                 append_hw buffer
138                         ((op lsl 10) lor ((rs land 0b11111) lsl 5) lor (rt land 0b11111))
139                         
140         let emit_SB buffer reg base offset = emit_I_type buffer 0b101000 base reg offset
141         let emit_SH buffer reg base offset = emit_I_type buffer 0b101001 base reg offset
142         let emit_SW buffer reg base offset = emit_I_type buffer 0b101011 base reg offset
143         let emit_SD buffer reg base offset = emit_I_type buffer 0b111111 base reg offset
144         
145         let emit_LB  buffer reg base offset = emit_I_type buffer 0b100000 base reg offset
146         let emit_LBU buffer reg base offset = emit_I_type buffer 0b100100 base reg offset
147         let emit_LH  buffer reg base offset = emit_I_type buffer 0b100001 base reg offset
148         let emit_LHU buffer reg base offset = emit_I_type buffer 0b100101 base reg offset
149         let emit_LW  buffer reg base offset = emit_I_type buffer 0b100011 base reg offset
150         let emit_LWU buffer reg base offset = emit_I_type buffer 0b100111 base reg offset
151         let emit_LD  buffer reg base offset = emit_I_type buffer 0b110111 base reg offset
152         
153         let emit_SDC copro buffer reg base offset = emit_I_type buffer (0b111100 lor copro) base reg offset
154         let emit_LDC copro buffer reg base offset = emit_I_type buffer (0b110100 lor copro) base reg offset
155
156         let emit_DADDIU buffer dest source imm = emit_I_type buffer 0b011001 source dest imm
157         let emit_ADDIU  buffer dest source imm = emit_I_type buffer 0b001001 source dest imm
158         let emit_ANDI   buffer dest source imm = emit_I_type buffer 0b001100 source dest imm
159         let emit_ORI    buffer dest source imm = emit_I_type buffer 0b001101 source dest imm
160         let emit_LUI    buffer dest        imm = emit_I_type buffer 0b001111 0      dest imm
161
162         let emit_DADDU buffer dest src1 src2 = emit_R_type buffer 0b000000 src1 src2 dest 0b00000 0b101101
163         let emit_ADDU  buffer dest src1 src2 = emit_R_type buffer 0b000000 src1 src2 dest 0b00000 0b100001
164         let emit_AND   buffer dest src1 src2 = emit_R_type buffer 0b000000 src1 src2 dest 0b00000 0b100100
165         let emit_OR    buffer dest src1 src2 = emit_R_type buffer 0b000000 src1 src2 dest 0b00000 0b100101
166         let emit_SUBU  buffer dest src1 src2 = emit_R_type buffer 0b000000 src1 src2 dest 0b00000 0b100011
167
168         let emit_JR buffer reg = emit_J_type buffer 0b000000 ((reg lsl 21) lor 0b1000)
169
170         let emit_BLEZ buffer reg offset = emit_I_type buffer 0b000110 reg 0 offset
171         let emit_BLTZ buffer reg offset = emit_I_type buffer 0b000001 reg 0 offset
172         let emit_BEQ  buffer r1 r2 offset = emit_I_type buffer 0b000100 r1 r2 offset
173         
174         let emit_MULTG   buffer dest a b = emit_R_type buffer 0b011100 a b dest 0b00000 0b010000
175         let emit_MULTUG  buffer dest a b = emit_R_type buffer 0b011100 a b dest 0b00000 0b010010
176         let emit_DMULTG  buffer dest a b = emit_R_type buffer 0b011100 a b dest 0b00000 0b010001
177         let emit_DMULTUG buffer dest a b = emit_R_type buffer 0b011100 a b dest 0b00000 0b010011
178         
179         let emit_SLL  buffer dest reg shift = emit_R_type buffer 0b000000 0 reg dest shift 0b000000
180         let emit_SRL  buffer dest reg shift = emit_R_type buffer 0b000000 0 reg dest shift 0b000000
181         let emit_SRA  buffer dest reg shift = emit_R_type buffer 0b000000 0 reg dest shift 0b000011
182         let emit_SLA  buffer dest reg shift = emit_R_type buffer 0b000000 0 reg dest shift 0b000010
183         let emit_DSLL buffer dest reg shift =
184                 if shift < 32 then
185                         emit_R_type buffer 0b000000 0 reg dest shift 0b111000
186                 else
187                         emit_R_type buffer 0b000000 0 reg dest (shift-32) 0b111100
188         let emit_DSRL buffer dest reg shift =
189                 if shift < 32 then
190                         emit_R_type buffer 0b000000 0 reg dest shift 0b111010
191                 else
192                         emit_R_type buffer 0b000000 0 reg dest (shift-32) 0b111110
193         
194         let emit_MTC1  buffer src dst = emit_R_type buffer 0b010001 0b00100 src dst 0 0
195         let emit_DMTC1 buffer src dst = emit_R_type buffer 0b010001 0b00101 src dst 0 0
196
197         let emit_LI buffer reg value =
198                 if value >= 0l && value < 65536l then
199                         emit_ORI buffer reg 0 (int_of_word value)
200                 else if value >= -32768l && value < 0l then
201                         emit_ADDIU buffer reg 0 (int_of_word value)
202                 else (
203                         let hi = Int32.shift_right_logical value 16
204                         and lo = Int32.logand value 0xffffl in
205                         emit_LUI buffer reg (int_of_word hi) ;
206                         if lo <> 0l then emit_ORI buffer reg reg (int_of_word lo))
207         
208         let emit_NOP buffer = emit_OR buffer 1 1 0 (*emit_SLL buffer 0 0 0*)
209
210         let emit_PCMPGTB   buffer dst a b = emit_R_type buffer 0b010010 0b11101 b a dst 0b001001
211         let emit_PCMPGTH   buffer dst a b = emit_R_type buffer 0b010010 0b11011 b a dst 0b001001
212         let emit_PCMPGTW   buffer dst a b = emit_R_type buffer 0b010010 0b11001 b a dst 0b001001
213         let emit_PMULHUH   buffer dst a b = emit_R_type buffer 0b010010 0b11101 b a dst 0b001010
214         let emit_PMULHH    buffer dst a b = emit_R_type buffer 0b010010 0b11011 b a dst 0b001010
215         let emit_PMULLH    buffer dst a b = emit_R_type buffer 0b010010 0b11010 b a dst 0b001010
216         let emit_PMULUW    buffer dst a b = emit_R_type buffer 0b010010 0b11100 b a dst 0b001010
217         let emit_PSRLH     buffer dst a b = emit_R_type buffer 0b010010 0b11001 b a dst 0b001011
218         let emit_PSRLW     buffer dst a b = emit_R_type buffer 0b010010 0b11000 b a dst 0b001011
219         let emit_PUNPCKLBH buffer dst a b = emit_R_type buffer 0b010010 0b11010 b a dst 0b000011
220         let emit_PUNPCKLHW buffer dst a b = emit_R_type buffer 0b010010 0b11000 b a dst 0b000011
221         let emit_PUNPCKLWD buffer dst a b = emit_R_type buffer 0b010010 0b11100 b a dst 0b001011
222         let emit_POR       buffer dst a b = emit_R_type buffer 0b010010 0b11011 b a dst 0b001100
223         let emit_PSLL      buffer dst a b = emit_R_type buffer 0b010010 0b11000 b a dst 0b001110
224         let emit_PAND      buffer dst a b = emit_R_type buffer 0b010010 0b11110 b a dst 0b000010
225         let emit_PDSLL     buffer dst a b = emit_R_type buffer 0b010010 0b11001 b a dst 0b001110
226         let emit_PSRL      buffer dst a b = emit_R_type buffer 0b010010 0b11000 b a dst 0b001111
227         let emit_PDSRL     buffer dst a b = emit_R_type buffer 0b010010 0b11001 b a dst 0b001111
228         let emit_PSRA      buffer dst a b = emit_R_type buffer 0b010010 0b11001 b a dst 0b001111
229         let emit_PDSRA     buffer dst a b = emit_R_type buffer 0b010010 0b11011 b a dst 0b001111
230         
231         let patch_imm buffer addr imm =
232                 Codebuf.patch_byte buffer addr (imm land 0xff) 0xff ;
233                 Codebuf.patch_byte buffer (addr+1) (imm lsr 8) 0xff
234         
235         (* Helper vars *)
236
237         let clock_var = Invariant, "clock",
238                 { out_banks = [| 0 |] ; helpers = [||] ;
239                   emitter = (fun proc g -> emit_DADDU proc.buffer (reg_of (g "clock")) 0 0) }
240
241         let make_scratch ?(kind=Inline) bank name = kind, name,
242                 { out_banks = [| bank |] ; helpers = [||] ;
243                   emitter = (fun _proc _g -> ()) }
244
245         let const_name bank c = "const_"^(string_of_int bank)^"_"^(string_of_word c)
246         let make_const bank c =
247                 let name = const_name bank c in
248                 let scratch = make_unique "scratch_for_const" in
249                 Invariant, name, { out_banks = [| bank |] ; helpers = [| make_scratch ~kind:Invariant 0 scratch |] ;
250                         emitter = (fun proc g ->
251                                 if bank = 0 then
252                                         emit_LI proc.buffer (reg_of (g name)) c
253                                 else (
254                                         assert (bank = 1) ;
255                                         emit_LI proc.buffer (reg_of (g scratch)) c ;
256                                         emit_DMTC1 proc.buffer (reg_of (g scratch)) (reg_of (g name)))) }
257
258         (* Implemented Operations. *)
259
260         let add = function
261                 | 1, [| Reg (0, (sz, _)) ; Reg (0, (sz', _)) |], [| sz'', _ |]
262                         when sz = sz' && sz = sz'' && sz <= 64 ->
263                         { out_banks = [| 0 |] ;
264                           helpers = [||] ;
265                           emitter = (fun proc g ->
266                                 (if sz <= 32 then emit_ADDU else emit_DADDU)
267                                         proc.buffer (reg_of (g ">0")) (reg_of (g "<1")) (reg_of (g "<2"))) }
268                 | _ -> raise Not_found
269
270         let mul_rshift = function
271                 | 1, [| Reg (0, (sz, sign)) ; Reg (0, (sz', sign')) ; Cst shift |], [| (sz'', sign'') |]
272                         when sz = sz' && sz <= 64 && sz'' <= 64
273                                 && sign = sign' && sign = sign''
274                                 && shift < 64l -> {
275                         out_banks = [| 0 |] ;
276                         helpers = [||] ;
277                         emitter = (fun proc g ->
278                                 (if sz <= 32 && sz'' <= 32 then (
279                                         if sign = Signed then emit_MULTG else emit_MULTUG
280                                 ) else (
281                                         if sign = Signed then emit_DMULTG else emit_DMULTUG
282                                 )) proc.buffer (reg_of (g ">0")) (reg_of (g "<0")) (reg_of (g "<1")) ;
283                                 let shift = int_of_word shift in
284                                 if shift > 0 then (
285                                         (if sz > 32 then emit_DSRL else emit_SRL)
286                                                 proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) shift)) } 
287                 (* SIMD *)
288                 | 4, [| Reg (1, (sz, sign)) ; Reg (1, (sz', sign')) ; Cst 16l |], [| sz'', sign'' |]
289                         when sz <= 16 && sz' <= 16 && sz'' <= 16 &&
290                                 sign = sign' && sign = sign'' ->
291                         { out_banks = [| 1 |] ;
292                           helpers = [||] ;
293                           emitter = (fun proc g ->
294                                 (if sign = Signed then emit_PMULHH else emit_PMULHUH)
295                                         proc.buffer (reg_of (g ">0")) (reg_of (g "<0")) (reg_of (g "<1"))) }
296                 | 4, [| Reg (1, (sz, _)) ; Reg (1, (sz', _)) ; Cst shift |], [| sz'', _ |]
297                         when sz + sz' <= 16 && sz'' <= 16 && shift <= 16l ->
298                         { out_banks = [| 1 |] ;
299                           helpers = [| make_const 1 shift |] ;
300                           emitter = (fun proc g ->
301                                 emit_PMULLH proc.buffer (reg_of (g ">0")) (reg_of (g "<0")) (reg_of (g "<1")) ;
302                                 if shift > 0l then
303                                         emit_PSRLH proc.buffer (reg_of (g ">0")) (reg_of (g "<0")) (reg_of (g (const_name 1 shift)))) }
304                 | _ -> raise Not_found
305
306         let pack565 = function
307                 | 1, [| Reg (0, (8, _)) ; Reg (0, (8, _)) ; Reg (0, (8, _)) |], [| 16, _ |] ->
308                         let scratch = make_unique "scratch_565" in
309                         { out_banks = [| 0 |] ;
310                           helpers = [| make_scratch 0 scratch |] ;
311                           emitter = (fun proc g ->
312                                 emit_ANDI proc.buffer (reg_of (g ">0")) (reg_of (g "<0")) 0xf8 ; (* R *)
313                                 emit_SLL  proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) 8 ;
314                                 emit_ANDI proc.buffer (reg_of (g scratch)) (reg_of (g "<1")) 0xfc ; (* G *)
315                                 emit_SLL  proc.buffer (reg_of (g scratch)) (reg_of (g scratch)) 3 ;
316                                 emit_OR   proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) (reg_of (g scratch)) ;
317                                 emit_SRL  proc.buffer (reg_of (g scratch)) (reg_of (g "<2")) 3 ; (* B *)
318                                 emit_OR   proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) (reg_of (g scratch))) }
319                 (* SIMD *)
320                 | 4, [| Reg (1, (8, _)) ; Reg (1, (8, _)) ; Reg (1, (8, _)) |], [| 16, _ |] ->
321                         let scratch = make_unique "scratch_565" in
322                         { out_banks = [| 1 |] ;
323                           helpers =
324                                 [| make_scratch 0 scratch ;
325                                    make_const 1 3l ; make_const 1 8l ;
326                                    make_const 1 0b11111000l ; make_const 1 0b11111100l |] ;
327                           emitter = (fun proc g ->
328                                 let const_3 = const_name 1 3l
329                                 and const_8 = const_name 1 8l
330                                 and mask_RB = const_name 1 0b11111000l
331                                 and mask_G  = const_name 1 0b11111100l in
332                                 emit_PAND  proc.buffer (reg_of (g ">0")) (reg_of (g "<0")) (reg_of (g mask_RB)) ;
333                                 emit_PDSLL proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) (reg_of (g const_8)) ;
334                                 emit_PAND  proc.buffer (reg_of (g scratch)) (reg_of (g "<1")) (reg_of (g mask_G)) ;
335                                 emit_PDSLL proc.buffer (reg_of (g scratch)) (reg_of (g scratch)) (reg_of (g const_3)) ;
336                                 emit_POR   proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) (reg_of (g scratch)) ;
337                                 emit_PAND  proc.buffer (reg_of (g scratch)) (reg_of (g "<2")) (reg_of (g mask_RB)) ;
338                                 emit_PDSRL proc.buffer (reg_of (g scratch)) (reg_of (g scratch)) (reg_of (g const_3)) ;
339                                 emit_POR   proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) (reg_of (g scratch))) }
340                 | _ -> raise Not_found
341
342         let unpack565 = function
343                 | 1, [| Reg (0, (16, _)) |], [| 8, Unsigned ; 8, Unsigned ; 8, Unsigned |] ->
344                         { out_banks = [| 0 ; 0 ; 0 |] ;
345                           helpers = [||] ;
346                           emitter = (fun proc g ->
347                                 emit_SRL  proc.buffer (reg_of (g ">0")) (reg_of (g "<0")) 8 ; (* R *)
348                                 emit_SRL  proc.buffer (reg_of (g ">1")) (reg_of (g "<0")) 3 ; (* G *)
349                                 emit_SLL  proc.buffer (reg_of (g ">2")) (reg_of (g "<0")) 3 ; (* B *)
350                                 emit_ANDI proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) 0xf8 ;
351                                 emit_ANDI proc.buffer (reg_of (g ">1")) (reg_of (g ">1")) 0xfc ;
352                                 emit_ANDI proc.buffer (reg_of (g ">2")) (reg_of (g ">2")) 0xff) }
353                 (* SIMD *)
354                 | 4, [| Reg (1, (16, _)) |], [| 8, Unsigned ; 8, Unsigned ; 8, Unsigned |] ->
355                         { out_banks = [| 1 ; 1 ; 1 |] ;
356                           (* FIXME: the masks should be repeated scale time, see commented code below *)
357                           helpers = [| make_const 1 3l ; make_const 1 8l ; make_const 1 0b11111000l ; make_const 1 0b11111100l |] ;
358                                 (*if proc.mask_RB = None then (
359                                         proc.mask_RB <- Some (reg_of perms.(2)) ;
360                                         emit_ORI   proc.buffer (reg_of (g scratch)) 0 0b11111000 ;
361                                         emit_DMTC1 proc.buffer (reg_of (g scratch)) proc.mask_RB ;
362                                         for i = 1 to 3 do
363                                                 emit_PINSRH i proc.buffer (unopt proc.mask_RB) (unopt proc.mask_RB) (unopt proc.mask_RB)
364                                         done) ;
365                                 if proc.mask_G = None then (
366                                         proc.mask_G = Some (reg_of perms.(3)) ;
367                                         emit_ORI   proc.buffer (reg_of (g scratch)) 0 0b11111100 ;
368                                         emit_DMTC1 proc.buffer (reg_of (g scratch)) (unopt proc.mask_G) ;
369                                         for i = 1 to 3 do
370                                                 emit_PINSRH i proc.buffer (unopt proc.mask_G) (unopt proc.mask_G) (unopt proc.mask_G)
371                                         done)) ;*)
372                         emitter = (fun proc g ->
373                                 let const_3 = const_name 1 3l
374                                 and const_8 = const_name 1 8l
375                                 and mask_RB = const_name 1 0b11111000l
376                                 and mask_G  = const_name 1 0b11111100l in
377                                 emit_PDSRL proc.buffer (reg_of (g ">0")) (reg_of (g "<0")) (reg_of (g const_8)) ; 
378                                 emit_PAND  proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) (reg_of (g mask_RB)) ;
379                                 emit_PDSRL proc.buffer (reg_of (g ">1")) (reg_of (g "<0")) (reg_of (g const_3)) ;
380                                 emit_PAND  proc.buffer (reg_of (g ">1")) (reg_of (g ">1")) (reg_of (g mask_G)) ;
381                                 emit_PDSLL proc.buffer (reg_of (g ">2")) (reg_of (g "<0")) (reg_of (g const_3)) ;
382                                 emit_PAND  proc.buffer (reg_of (g ">2")) (reg_of (g ">2")) (reg_of (g mask_RB))) }
383                 | _ -> raise Not_found
384
385         let stream_read = function
386                 | 1, [| Reg (0, (32, Unsigned)) |], [| 64, _ |] ->
387                         let scratch = make_unique "scratch_read" in
388                         { out_banks = [| 0 |] ;
389                           helpers = [| make_scratch 0 scratch ; clock_var |] ;
390                           emitter = (fun proc g ->
391                                 emit_SLL  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) 3 ;
392                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g scratch)) (reg_of (g "<0")) ;
393                                 emit_LD   proc.buffer (reg_of (g ">0")) (reg_of (g scratch)) 0) }
394                 | 1, [| Reg (0, (32, Unsigned)) |], [| 32, sign |] ->
395                         let scratch = make_unique "scratch_read" in
396                         { out_banks = [| 0 |] ;
397                           helpers = [| make_scratch 0 scratch ; clock_var |] ;
398                           emitter = (fun proc g ->
399                                 emit_SLL  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) 2 ;
400                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g scratch)) (reg_of (g "<0")) ;
401                                 (if sign = Signed then emit_LW else emit_LWU)
402                                         proc.buffer (reg_of (g ">0")) (reg_of (g scratch)) 0) }
403                 | 1, [| Reg (0, (32, Unsigned)) |], [| 16, sign |] ->
404                         let scratch = make_unique "scratch_read" in
405                         { out_banks = [| 0 |] ;
406                           helpers = [| make_scratch 0 scratch ; clock_var |] ;
407                           emitter = (fun proc g ->
408                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (reg_of (g "clock")) ;
409                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g scratch)) (reg_of (g "<0")) ;
410                                 (if sign = Signed then emit_LH else emit_LHU)
411                                         proc.buffer (reg_of (g ">0")) (reg_of (g scratch)) 0) }
412                 | 1, [| Reg (0, (32, Unsigned)) |], [| 8, sign |] ->
413                         let scratch = make_unique "scratch_read" in
414                         { out_banks = [| 0 |] ;
415                           helpers = [| make_scratch 0 scratch ; clock_var |] ;
416                           emitter = (fun proc g ->
417                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (reg_of (g "<0")) ;
418                                 (if sign = Signed then emit_LB else emit_LBU)
419                                         proc.buffer (reg_of (g ">0")) (reg_of (g scratch)) 0) }
420                 (* SIMD *)
421                 | scale, [| Reg (0, (32, Unsigned)) |], [| sz, _ |] when scale * sz = 64 ->
422                         let scratch = make_unique "scratch_read" in
423                         { out_banks = [| 1 |] ;
424                           helpers = [| make_scratch 1 scratch ; clock_var |] ;
425                           emitter = (fun proc g ->
426                                 (* Offset is (clock/scale) * 8 *)
427                                 if scale = 8 then
428                                         emit_ADDU  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (reg_of (g "<0"))
429                                 else if scale > 8 then (
430                                         emit_SRL  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (log2 (scale/8)) ;
431                                         emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g "<0")) (reg_of (g scratch)))
432                                 else if scale < 8 then (
433                                         emit_SLL  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (log2 (8/scale)) ;
434                                         emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g "<0")) (reg_of (g scratch))) ;
435                                 emit_LDC 1 proc.buffer (reg_of (g ">0")) (reg_of (g scratch)) 0) }
436                 (* In this one we want to store 4 bytes into our SIMD 64 bits register, so we will need to
437                  * expand the values to 16 bits (while still pretending they are 8 bits) *)
438                 | 4, [| Reg (0, (32, Unsigned)) |], [| 8, sign |] ->
439                         let scratch0 = make_unique "scratch_read"
440                         and scratch1 = make_unique "scratch_sign" in
441                         { out_banks = [| 1 |] ;
442                           helpers =
443                                 [| make_scratch 0 scratch0 ;
444                                    make_scratch 1 scratch1 ;
445                                    clock_var ;
446                                    make_const 1 0l |] ;
447                           emitter = (fun proc g ->
448                                 emit_ADDU  proc.buffer (reg_of (g scratch0)) (reg_of (g "clock")) (reg_of (g "<0")) ;
449                                 emit_LW    proc.buffer (reg_of (g scratch0)) (reg_of (g scratch0)) 0 ;
450                                 emit_MTC1  proc.buffer (reg_of (g scratch0)) (reg_of (g ">0")) ;
451                                 (* Expand the 4 low bytes into halfwords (interleaving zeros) *)
452                                 emit_PUNPCKLBH proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) (reg_of (g (const_name 1 0l))) ;
453                                 if sign = Signed then ( (* Now sign-extend the values *)
454                                         emit_PCMPGTB   proc.buffer (reg_of (g scratch1)) (reg_of (g (const_name 1 0l))) (reg_of (g ">0")) ;
455                                         emit_PSLL      proc.buffer (reg_of (g scratch1)) (reg_of (g scratch1)) 8 ;
456                                         emit_POR       proc.buffer (reg_of (g ">0")) (reg_of (g ">0")) (reg_of (g scratch1)))) }
457                 | _ -> raise Not_found
458
459         let stream_write = function
460                 | 1, [| Reg (0, (32, Unsigned)) ; Reg (0, (64, _)) |], [||] ->
461                         let scratch = make_unique "scratch_write" in
462                         { out_banks = [||] ;
463                           helpers = [| make_scratch 0 scratch ; clock_var |] ;
464                           emitter = (fun proc g ->
465                                 emit_SLL  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) 3 ;
466                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g scratch)) (reg_of (g "<0")) ;
467                                 emit_SD   proc.buffer (reg_of (g "<1")) (reg_of (g scratch)) 0) }
468                 | 1, [| Reg (0, (32, Unsigned)) ; Reg (0, (32, _)) |], [||] ->
469                         let scratch = make_unique "scratch_write" in
470                         { out_banks = [||] ;
471                           helpers = [| make_scratch 0 scratch ; clock_var |] ;
472                           emitter = (fun proc g ->
473                                 emit_SLL  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) 2 ;
474                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g scratch)) (reg_of (g "<0")) ;
475                                 emit_SW   proc.buffer (reg_of (g "<1")) (reg_of (g scratch)) 0) }
476                 | 1, [| Reg (0, (32, Unsigned)) ; Reg (0, (16, _)) |], [||] ->
477                         let scratch = make_unique "scratch_write" in
478                         { out_banks = [||] ;
479                           helpers = [| make_scratch 0 scratch ; clock_var |] ;
480                           emitter = (fun proc g ->
481                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (reg_of (g "clock")) ;
482                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g scratch)) (reg_of (g "<0")) ;
483                                 emit_SH   proc.buffer (reg_of (g "<1")) (reg_of (g scratch)) 0) }
484                 | 1, [| Reg (0, (32, Unsigned)) ; Reg (0, (8, _)) |], [||] ->
485                         let scratch = make_unique "scratch_write" in
486                         { out_banks = [||] ;
487                           helpers = [| make_scratch 0 scratch ; clock_var |] ;
488                           emitter = (fun proc g ->
489                                 emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (reg_of (g "<0")) ;
490                                 emit_SB   proc.buffer (reg_of (g "<1")) (reg_of (g scratch)) 0) }
491                 (* SIMD *)
492                 | scale, [| Reg (0, (32, Unsigned)) ; Reg (1, (sz, _)) |], [||] when scale * sz = 64 ->
493                         let scratch = make_unique "scratch_write" in
494                         { out_banks = [||] ;
495                           helpers = [| make_scratch 1 scratch ; clock_var |] ;
496                           emitter = (fun proc g ->
497                                 (* Offset is (clock/scale) * 8 *)
498                                 if scale = 8 then
499                                         emit_ADDU  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (reg_of (g "<0"))
500                                 else if scale > 8 then (
501                                         emit_SRL  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (log2 (scale/8)) ;
502                                         emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g "<0")) (reg_of (g scratch)))
503                                 else if scale < 8 then (
504                                         emit_SLL  proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) (log2 (8/scale)) ;
505                                         emit_ADDU proc.buffer (reg_of (g scratch)) (reg_of (g "<0")) (reg_of (g scratch))) ;
506                                 emit_SDC 1 proc.buffer (reg_of (g "<1")) (reg_of (g scratch)) 0) }
507                 | _ -> raise Not_found
508
509         let loop_head = function
510                 | scale, [| Reg (0, (32, Unsigned)) |], [||] ->
511                         let scratch = make_unique "scratch_head" in
512                         { out_banks = [||] ;
513                           (* FIXME: the compiler don't know that we don't need the value of this scratch
514                            * register from one run to another, and as a result will keep the register for
515                            * the whole loop. *)
516                           helpers = [| make_scratch 0 scratch ; clock_var |] ;
517                           emitter = (fun proc g ->
518                                 let loop_start = Codebuf.offset proc.buffer in
519                                 (* First test if clock + scale > width, and if so jump forward to quit label
520                                  * then save loop label *)
521                                 emit_ADDIU proc.buffer (reg_of (g scratch)) (reg_of (g "clock")) scale ;
522                                 emit_SUBU  proc.buffer (reg_of (g scratch)) (reg_of (g "<0")) (reg_of (g scratch)) ;
523                                 proc.loops <- Some
524                                         { start = loop_start ; blez = Codebuf.offset proc.buffer ; top = proc.loops } ;
525                                 emit_BLTZ  proc.buffer (reg_of (g scratch)) 0; (* actual offset will be patched later *)
526                                 emit_NOP   proc.buffer) }
527                 | _ -> raise Not_found
528
529         let loop_tail = function
530                 | scale, [||], [||] ->
531                         { out_banks = [||] ;
532                           helpers = [| clock_var |] ;
533                           emitter = (fun proc g ->
534                                 let loop = unopt proc.loops in
535                                 let offset = (loop.start - ((Codebuf.offset proc.buffer) + 4)) / 4 in
536                                 Printf.printf "BEQ to %d, from %d to %d\n" offset ((Codebuf.offset proc.buffer) + 8) loop.start ;
537                                 emit_BEQ   proc.buffer 0 0 offset ;
538                                 emit_ADDIU proc.buffer (reg_of (g "clock")) (reg_of (g "clock")) scale ;
539                                 patch_imm  proc.buffer loop.blez (((Codebuf.offset proc.buffer) - (loop.blez + 4)) / 4) ;
540                                 proc.loops <- loop.top) }
541                 | _ -> raise Not_found
542
543         let load_param = function
544                 | _, [| Cst p |], [| sz, _ |] when sz <= 64 ->
545                         { out_banks = [| 0 |] ;
546                           helpers = [||] ;
547                           emitter = (fun proc g ->
548                                 emit_LD proc.buffer (reg_of (g ">0")) 29 (8 * (int_of_word p))) }
549                 | _ -> raise Not_found
550
551         (* Returns the context used by emitters. *)
552         let next_seq =
553                 let seqnum = ref 0 in
554                 (fun () -> incr seqnum ; !seqnum)
555
556         let make_proc _nb_sources =
557                 let seq = next_seq () in
558                 { buffer = Codebuf.make 1024 ("/tmp/test.code"^(string_of_int seq)) ;
559                   loops = None ;
560                   params = [||] ;
561                   frame_size = 0 ;
562                   callee_saved = [] }
563
564         type initer = Param of int | Const of word
565
566         let emit_entry_point proc _inits used_regs =
567                 (* Callee-saved registers and return address, that we are going to save
568                  * if we use them. *)
569                 let is_callee_saved = function
570                         | 0, r -> (match reg_of (0, r) with
571                                 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 28 | 30 -> true
572                                 (* return address is not really a callee saved reg, but we will treat it the same *)
573                                 | 31 -> true
574                                 | _ -> false)
575                         | 1, r -> let r = reg_of (1, r) in r >= 20 && r <= 31
576                         | _ -> failwith "Register is not a Reg" in
577                 (* These are used to store function arguments.
578                  * We save them on the stack since we pretend these registers are available *)
579                 let arg_regs = [| 4 ; 5 ; 6 ; 7 ; 8 ; 9 ; 10 ; 11 |] in
580                 (* We must compute the stack frame size. Reserve as much space for
581                  * arguments registers (that we will save inconditionnaly) and for used
582                  * callee-saved registers. *)
583                 proc.frame_size <- (Array.length arg_regs) * 8 ;
584                 proc.callee_saved <- [] ;
585                 List.iter (fun r ->
586                         if is_callee_saved r then (
587                                 (proc.callee_saved <- (proc.frame_size, r) :: proc.callee_saved ;
588                                 proc.frame_size <- proc.frame_size + 8))) used_regs ;
589                 emit_ADDIU proc.buffer 29 29 (-proc.frame_size) ;
590                 (* Save all registers used to pass arguments on top of this frame,
591                  * so that we can later easily retrieve them. *)
592                 let save_reg offset r =
593                         Printf.printf "Saving register %s at offset %d\n" (string_of_reg_id r) proc.frame_size ;
594                         match r with
595                                 | 0, _ -> emit_SD proc.buffer (reg_of r) 29 offset
596                                 | 1, _ -> emit_SDC 1 proc.buffer (reg_of r) 29 offset
597                                 | _ -> failwith "Saved reg is not a Reg" in
598                 Array.iteri (fun i r -> save_reg (i*8) (0, r)) arg_regs ;
599                 (* Save the callee saved registers that we are going to use *)
600                 List.iter (fun (offset, r) -> save_reg offset r) proc.callee_saved
601
602         let emit_exit proc =
603                 (* Restore r31 and other callee-saved registers that were saved on the stack. *)
604                 let restore_reg offset r = match r with
605                         | 0, _ -> emit_LD proc.buffer (reg_of r) 29 offset
606                         | 1, _ -> emit_LDC 1 proc.buffer (reg_of r) 29 offset
607                         | _ -> failwith "Restored reg is not a Reg" in
608                 List.iter (fun (offset, r) -> restore_reg offset r) proc.callee_saved ;
609                 (* Restore stack pointer and return to caller *)
610                 emit_JR proc.buffer 31 ;
611                 emit_ADDIU proc.buffer 29 29 proc.frame_size
612
613         (* Source values are given as integers. *)
614         let exec proc params =
615                 let rec to_top_loop prev = function
616                         | None -> prev
617                         | Some loop -> to_top_loop (Some loop) loop.top in
618                 proc.loops <- to_top_loop None proc.loops ;
619                 Codebuf.exec proc.buffer 0 params
620 end