package jasmin

  1. Overview
  2. Docs
package jasmin
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file syntax.ml

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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
open Annotations
open Utils
(* -------------------------------------------------------------------- *)
module L = Location

(* -------------------------------------------------------------------- *)
exception ParseError of Location.t * string option

let parse_error ?msg loc =
  raise (ParseError (loc, msg))

(* -------------------------------------------------------------------- *)
type arr_access = Warray_.arr_access

type sign = [ `Unsigned | `Signed ]

type vesize = [`W1 | `W2 | `W4 | `W8 | `W16 | `W32 | `W64 | `W128]
type vsize   = [ `V2 | `V4 | `V8 | `V16 | `V32 ]

type wsign = [ `Word of sign option | `WInt of sign]
type swsize  = wsize * wsign
type svsize  = vsize * sign * vesize

type castop1 = CSS of swsize | CVS of svsize
type castop = castop1 L.located option

type int_representation = string
let parse_int (i: int_representation) : Z.t =
  let s = String.filter (( <> ) '_') i in
  Z.of_string s

let bits_of_wsize : wsize -> int = Annotations.int_of_ws

let string_of_sign : sign -> string =
  function
  | `Unsigned -> "u"
  | `Signed -> "s"

let suffix_of_wsign = function
  | `Word None -> "w"
  | `Word (Some s) -> string_of_sign s
  | `WInt s -> Format.sprintf "%si" (string_of_sign s)

let string_of_swsize_op (sz,sg) =
  Format.sprintf "%d%s" (bits_of_wsize sz) (suffix_of_wsign sg)

let string_of_swsize_ty (sz,sg) =
  Format.sprintf "%s%d" (suffix_of_wsign sg) (bits_of_wsize sz)

let int_of_vsize : vsize -> int =
  function
  | `V2  -> 2
  | `V4  -> 4
  | `V8  -> 8
  | `V16 -> 16
  | `V32 -> 32

let bits_of_vesize : vesize -> int =
  function
  | `W1   -> 1
  | `W2   -> 2
  | `W4   -> 4
  | `W8   -> 8
  | `W16  -> 16
  | `W32  -> 32
  | `W64  -> 64
  | `W128 -> 128

let string_of_svsize (sv,sg,ve) =
  Format.sprintf "%d%s%d"
    (int_of_vsize sv) (string_of_sign sg) (bits_of_vesize ve)

let string_of_osign = function
  | None -> ""
  | Some s -> string_of_sign s

(* -------------------------------------------------------------------- *)
type cast = [ `ToWord  of swsize | `ToInt of sign option]

type peop1 = [
  | `Cast of cast
  | `Not  of castop
  | `Neg  of castop
]

type peop2 = [
  | `And
  | `Or
  | `Add  of castop
  | `Sub  of castop
  | `Mul  of castop
  | `Div  of sign option * castop
  | `Mod  of sign option * castop
  | `BAnd of castop
  | `BOr  of castop
  | `BXOr of castop
  | `ShR  of sign option * castop
  | `ROR  of castop
  | `ROL  of castop
  | `ShL  of castop

  | `Eq   of castop
  | `Neq  of castop
  | `Lt   of sign option * castop
  | `Le   of sign option * castop
  | `Gt   of sign option * castop
  | `Ge   of sign option * castop
]

let string_of_castop1 : castop1 -> string =
  function
  | CSS sw -> string_of_swsize_op sw
  | CVS sv -> string_of_svsize sv

let string_of_castop : castop -> string =
  function
  | None   -> ""
  | Some c -> string_of_castop1 (L.unloc c)

let string_of_cast s =
  match s with
  | `ToWord s -> string_of_swsize_op s
  | `ToInt s   -> Format.sprintf "%sint" (string_of_osign s)

let string_of_peop1 : peop1 -> string =
  let f s p = Format.sprintf "%s%s" p (string_of_castop s) in
  function
  | `Cast s -> Format.sprintf "(%s)" (string_of_cast s)
  | `Not s -> f s "!"
  | `Neg s -> f s "-"

let string_of_signcastop (s, c) =
  match s, c with
  | None, _ -> string_of_castop c
  | Some s, None -> string_of_sign s
  | Some s, Some c -> Format.sprintf "%s %s" (string_of_sign s) (string_of_castop1 (L.unloc c))

let string_of_peop2 : peop2 -> string =
  let f c p = Format.sprintf "%s%s" p (string_of_castop c) in
  let g c p = Format.sprintf "%s%s" p (string_of_signcastop c) in
  function
  | `And -> "&&"
  | `Or  -> "||"
  | `Add c -> f c "+"
  | `Sub c -> f c "-"
  | `Mul c -> f c "*"
  | `Div c -> g c "/"
  | `Mod c -> g c "%"

  | `BAnd c -> f c "&"
  | `BOr  c -> f c "|"
  | `BXOr c -> f c "^"
  | `ShR c -> g c ">>"
  | `ShL c -> f c "<<"
  | `ROR c -> f c ">>r"
  | `ROL c -> f c "<<r"
  | `Eq  c -> f c "=="
  | `Neq c -> f c "!="
  | `Lt c -> g c "<"
  | `Le c -> g c "<="
  | `Gt c -> g c ">"
  | `Ge c -> g c ">="

(* -------------------------------------------------------------------- *)
module W = Wsize

(* -------------------------------------------------------------------- *)

type pexpr_r =
  | PEParens of pexpr
  | PEVar    of pident
  | PEGet    of [`Aligned|`Unaligned] option * arr_access * swsize L.located option * pident * pexpr * pexpr option
  | PEFetch  of mem_access
  | PEpack   of svsize * pexpr list
  | PEBool   of bool
  | PEInt    of int_representation
  | PECall   of pident * pexpr list
  | PECombF  of pident * pexpr list
  | PEPrim   of pident * pexpr list
  | PEOp1    of peop1 * pexpr
  | PEOp2    of peop2 * (pexpr * pexpr)
  | PEIf of pexpr * pexpr * pexpr

and pexpr = pexpr_r L.located

and mem_access = [ `Aligned | `Unaligned ] option * swsize L.located option * pexpr

(* -------------------------------------------------------------------- *)
and psizetype = TypeWsize of swsize | TypeSizeAlias of pident
and ptype_r = TBool | TInt | TWord of swsize | TArray of psizetype * pexpr | TAlias of pident
and ptype   = ptype_r L.located

(* -------------------------------------------------------------------- *)
type writable = [`Constant | `Writable]
type ptr      = [`Pointer of writable option | `Direct ]
type pstorage = [ `Reg of ptr | `Stack of ptr | `Inline | `Global]

(* -------------------------------------------------------------------- *)
type pstotype = pstorage * ptype
type annot_pstotype = annotations * pstotype
(* -------------------------------------------------------------------- *)
type plvalue_r =
  | PLIgnore
  | PLVar   of pident
  | PLArray of [`Aligned|`Unaligned] option * arr_access * swsize L.located option * pident * pexpr * pexpr option
  | PLMem   of mem_access

type plvalue = plvalue_r L.located

(* -------------------------------------------------------------------- *)
type peqop = [
  | `Raw
  | `Add  of castop
  | `Sub  of castop
  | `Mul  of castop
  | `Div  of sign option * castop
  | `Mod  of sign option * castop
  | `ShR  of sign option * castop
  | `ROR  of castop
  | `ROL  of castop
  | `ShL  of castop
  | `BAnd of castop
  | `BXOr of castop
  | `BOr  of castop
]

(* -------------------------------------------------------------------- *)
type align = [`Align | `NoAlign]

type plvals = annotations L.located option * plvalue list


type vardecl = pident * pexpr option
type vardecls = pstotype * vardecl L.located list

let var_decl_id (v, _ : vardecl) : pident = v

type pinstr_r =
  | PIArrayInit of pident
      (** ArrayInit(x); *)
  | PIAssign    of plvals * peqop * pexpr * pexpr option
      (** x, y += z >> 4 if c; *)
  | PIIf        of pexpr * pblock * pblock option
      (** if e { … } else { … } *)
  | PIFor       of pident * (fordir * pexpr * pexpr) * pblock
      (** for i = 0 to N { … } *)
  | PIWhile     of pblock option * pexpr * pblock option
      (** while { … } (x > 0) { … } *)
  | PIdecl      of vardecls
      (** reg u32 x y z; *)

and pblock_r = pinstr list
and fordir   = [ `Down | `Up ]

and pinstr = annotations * pinstr_r L.located
and pblock = pblock_r L.located

let string_of_sizetype =
  function
  | TypeWsize ws -> string_of_swsize_ty ws
  | TypeSizeAlias pident -> L.unloc pident

let pp_writable = function
  | Some `Constant -> " const"
  | Some `Writable -> " mut"
  | None  -> ""

let pp_pointer = function
  | `Pointer w-> pp_writable w ^ " ptr"
  | `Direct  -> ""

let pp_storage = function
  | `Reg(ptr) -> "reg" ^ (pp_pointer ptr)
  | `Stack ptr -> "stack" ^ (pp_pointer ptr)
  | `Inline -> "inline"
  | `Global -> "global"

(* -------------------------------------------------------------------- *)
type pparam = {
  ppa_ty   : ptype;
  ppa_name : pident;
  ppa_init : pexpr;
}

(* -------------------------------------------------------------------- *)
type pfunbody = {
  pdb_instr : pinstr list;
  pdb_ret   : pident list option L.located;
}

(* -------------------------------------------------------------------- *)
type pcall_conv = [
  | `Export
  | `Inline
]

type paramdecls = pstotype * pident list

type pfundef = {
  pdf_annot : annotations;
  pdf_cc   : pcall_conv option;
  pdf_name : pident;
  pdf_args : (annotations * paramdecls) list;
  pdf_rty  : (annotations * pstotype) list option;
  pdf_body : pfunbody;
}

(* -------------------------------------------------------------------- *)
type gpexpr =
  | GEword  of pexpr
  | GEarray of pexpr list
  | GEstring of string L.located

type pglobal = { pgd_type: ptype; pgd_name: pident ; pgd_val: gpexpr }

(* -------------------------------------------------------------------- *)
type pexec = {
  pex_name: pident;
  pex_mem: (int_representation * int_representation) list;
}

(* -------------------------------------------------------------------- *)
type prequire = string L.located

(* -------------------------------------------------------------------- *)
type pitem =
  | PFundef of pfundef
  | PParam of pparam
  | PGlobal of pglobal
  | Pexec of pexec
  | Prequire of (pident option * prequire list)
  | PNamespace of pident * pitem L.located list
  | PTypeAlias of pident * ptype

(* -------------------------------------------------------------------- *)
type pprogram = pitem L.located list