Commits

Calascibetta Romain committed 38331f2

First jet for call instruction

  • Participants
  • Parent commits ff3327d

Comments (0)

Files changed (2)

   | Sspstrong
   | Uwtable
 
-type parameter_attribute =
-  | Zeroext
-  | Signext
-  | Inreg
-  | Byval
-  | Sret
-  | Noalias
-  | Nocapture
-  | Nest
-  | Returned
+type parameter_attribute = [
+  | `Zeroext
+  | `Signext
+  | `Inreg
+  | `Byval
+  | `Sret
+  | `Noalias
+  | `Nocapture
+  | `Nest
+  | `Returned
+  ]
+
+type variable =
+  | VGlobal of string
+  | VLocal of string
 
 type 'a instr =
   | Ret of 'a LLVM_types.value
+  | Call of (bool * calling_convention option *
+    [`Zeroext | `Signext | `Inreg ] option * 'a LLVM_types.t *
+    variable * ('a instr list))
 
 type ('a, 'b, 'c) context_module =
   | Global of
   | Definition of
     (('a LLVM_types.t * string * 'b LLVM_types.t array) * 'c instr list)
 
+let string_of_variable : variable -> string = function
+  | VGlobal s               -> "@" ^ s
+  | VLocal s                -> "%" ^ s
+
 let string_of_link_type = function
   | `Private                -> "private"
   | `Linker_private         -> "linker_private"
   | `Dllimport              -> "dllimport"
   | `Dllexport              -> "dllexport"
 
-let string_of_instr = function
-  | Ret a                   -> "\tret " ^ (LLVM_types.value_to_string a)
+let string_of_parameter_attribute = function
+  | `Zeroext                -> "zeroext"
+  | `Signext                -> "signext"
+  | `Inreg                  -> "inreg"
+  | `Byval                  -> "byval"
+  | `Sret                   -> "sret"
+  | `Noalias                -> "noalias"
+  | `Nocapture              -> "nocapture"
+  | `Nest                   -> "nest"
+  | `Returned               -> "returned"
+
+let string_of_calling_conventation = function
+  | CCC                     -> "ccc"
+  | FastCC                  -> "fastcc"
+  | ColdCC                  -> "coldcc"
+  | CC i                    -> "cc " ^ (string_of_int i)
+
+let rec string_of_instr a =
+  let rec aux acc = function
+    | [] -> acc
+    | x :: r -> aux (acc ^ ", " ^ (string_of_instr x)) r
+  in match a with
+    | Ret a                   -> "\tret " ^ (LLVM_types.value_to_string a)
+    | Call (tail, cconv, ret_attr, ret_type, name, arguments) ->
+        let tail_string = if tail = true then "tail " else "" in
+        let cconv_string = match cconv with
+          | Some a -> " " ^ (string_of_calling_conventation a)
+          | None -> ""
+        in let ret_attr_string = match ret_attr with
+          | Some a -> " " ^ (string_of_parameter_attribute a)
+          | None -> ""
+        in let ret_type_string = " " ^ (LLVM_types.to_string ret_type)
+        in let name_string = " " ^ (string_of_variable name)
+        in let arguments_string = match arguments with
+          | [] -> ""
+          | x :: r -> aux (string_of_instr x) r
+        in "\t" ^ tail_string ^ "call" ^ cconv_string ^ ret_attr_string ^
+        ret_type_string ^ name_string ^ "(" ^ arguments_string ^ ")"
 
 let string_of_address = function
   | Addrspace i             -> "addr(" ^ (string_of_int i) ^ ")"
     | true                  -> " constant"
     | false                 -> ""
   in let string_data_type = match data_type with
-    | LLVM_types.Value v -> " " ^ LLVM_types.value_to_string v
-    | LLVM_types.Type t -> " " ^ LLVM_types.to_string t
+    | LLVM_types.Value v    -> " " ^ LLVM_types.value_to_string v
+    | LLVM_types.Type t     -> " " ^ LLVM_types.to_string t
   in let string_section = match section with
     | None                  -> ""
     | Some a                -> ", section \"" ^ a ^ "\""
   in "define " ^ string_type_return ^ " @" ^ id
   ^ "(" ^ string_type_arguments ^ ")" ^ " {\n" ^ string_instr_list ^ "}"
 
+let call
+  ?(tail=false)
+  ?(cconv=None)
+  ?(ret_attr=None)
+  ret_type name arguments =
+  Call (tail, cconv, (ret_attr :> [ `Zeroext | `Signext | `Inreg ] option),
+    ret_type, name, arguments)
+
 let print_global a = print_string (string_of_global a)
 
 let new_global
   | Sspstrong
   | Uwtable
 
-type parameter_attribute =
-  | Zeroext
-  | Signext
-  | Inreg
-  | Byval
-  | Sret
-  | Noalias
-  | Nocapture
-  | Nest
-  | Returned
+type parameter_attribute = [
+  | `Zeroext
+  | `Signext
+  | `Inreg
+  | `Byval
+  | `Sret
+  | `Noalias
+  | `Nocapture
+  | `Nest
+  | `Returned
+  ]
+
+type variable =
+  | VGlobal of string
+  | VLocal of string
 
 type 'a instr =
   | Ret of 'a LLVM_types.value
+  | Call of (bool * calling_convention option *
+    [`Zeroext | `Signext | `Inreg ] option * 'a LLVM_types.t *
+    variable * ('a instr list))
 
 type ('a, 'b, 'c) context_module =
   | Global of
  *    - function attribute
  *)
 
+val call:
+  ?tail: bool ->
+  ?cconv: calling_convention option ->
+  ?ret_attr: [< `Zeroext | `Signext | `Inreg ] option ->
+  'a LLVM_types.t -> variable -> 'a instr list -> 'a instr
+
 val new_global:
   ?thread_local:thread_local option ->
   ?address: address ->