Summary: Added phase to construct (incomplete) CFG from existing AST. Individual instructions are not yet translated so any nonempty functions will result in a runtime exception. Added some very short examples of LLVM programs.master
Rohan Jacob-Rao
10 years ago
parent
a9e7fac361
commit
0946c9e460
@ -1,23 +0,0 @@
|
||||
(*
|
||||
* Copyright (c) 2015 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
type prog = Prog of func_def list
|
||||
and func_def = FuncDef of string * typ option * (typ * string) list * instr list
|
||||
and typ =
|
||||
| Tint of int
|
||||
| Tfloat (* just one type for now *)
|
||||
| Tptr of typ
|
||||
| Tvector of int * typ
|
||||
| Tarray of int * typ
|
||||
and instr =
|
||||
| Ret of (typ * value) option
|
||||
and value =
|
||||
| True
|
||||
| False
|
||||
| Intlit of int
|
||||
| Null
|
||||
@ -0,0 +1,4 @@
|
||||
; Definition of main function
|
||||
define void @main() {
|
||||
ret void
|
||||
}
|
||||
@ -0,0 +1,4 @@
|
||||
; Definition of main function
|
||||
define i32 @main() {
|
||||
ret i32 0
|
||||
}
|
||||
@ -0,0 +1,43 @@
|
||||
(*
|
||||
* Copyright (c) 2015 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
|
||||
(** Representation of LLVM constructs *)
|
||||
|
||||
type variable =
|
||||
| Global of string
|
||||
| Local of string
|
||||
|
||||
type constant =
|
||||
| Cint of int
|
||||
| Cnull
|
||||
|
||||
type operand =
|
||||
| Var of variable
|
||||
| Const of constant
|
||||
|
||||
type typ =
|
||||
| Tint of int
|
||||
| Tfloat (* just one type for now *)
|
||||
| Tptr of typ
|
||||
| Tvector of int * typ
|
||||
| Tarray of int * typ
|
||||
| Tlabel
|
||||
| Tmetadata
|
||||
|
||||
type instr =
|
||||
| Ret of (typ * operand) option
|
||||
| UncondBranch of variable
|
||||
| CondBranch of operand * variable * variable
|
||||
|
||||
type func_def = FuncDef of variable * typ option * (typ * string) list * instr list
|
||||
|
||||
type prog = Prog of func_def list
|
||||
|
||||
let string_of_variable : variable -> string = function
|
||||
| Global str | Local str -> str
|
||||
@ -0,0 +1,56 @@
|
||||
(*
|
||||
* Copyright (c) 2015 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
open LAst
|
||||
|
||||
let concatmap (sep : string) (f : 'a -> string) (l : 'a list) : string =
|
||||
String.concat sep (List.map f l)
|
||||
|
||||
let pretty_variable : variable -> string = function
|
||||
| Global id -> "@" ^ id
|
||||
| Local id -> "%" ^ id
|
||||
|
||||
let pretty_constant : constant -> string = function
|
||||
| Cint i -> string_of_int i
|
||||
| Cnull -> "null"
|
||||
|
||||
let pretty_operand : operand -> string = function
|
||||
| Var var -> pretty_variable var
|
||||
| Const const -> pretty_constant const
|
||||
|
||||
let rec pretty_typ : typ -> string = function
|
||||
| Tint width -> "i" ^ string_of_int width
|
||||
| Tfloat (* just one type for now *) -> "float"
|
||||
| Tptr tp -> pretty_typ tp ^ "*"
|
||||
| Tvector (sz, tp) -> "<" ^ string_of_int sz ^ " x " ^ pretty_typ tp ^ ">"
|
||||
| Tlabel -> "label"
|
||||
| Tmetadata -> "metadata"
|
||||
| Tarray (sz, tp) -> "[" ^ string_of_int sz ^ " x " ^ pretty_typ tp ^ "]"
|
||||
|
||||
let pretty_ret_typ : typ option -> string = function
|
||||
| None -> "void"
|
||||
| Some tp -> pretty_typ tp
|
||||
|
||||
let pretty_instr : instr -> string = function
|
||||
| Ret None -> "ret void"
|
||||
| Ret (Some (tp, op)) -> "ret " ^ pretty_typ tp ^ " " ^ pretty_operand op
|
||||
| UncondBranch label -> "br label " ^ pretty_variable label
|
||||
| CondBranch (op, label1, label2) ->
|
||||
"br i1 " ^ pretty_operand op ^ ", label " ^ pretty_variable label1 ^
|
||||
", label " ^ pretty_variable label2
|
||||
|
||||
let pretty_instr_ln (i : instr) : string = pretty_instr i ^ "\n"
|
||||
|
||||
let pretty_func_def : func_def -> string = function
|
||||
FuncDef (name, ret_tp, params, instrs) ->
|
||||
"define " ^ pretty_ret_typ ret_tp ^ " " ^ pretty_variable name ^ "(" ^
|
||||
concatmap ", " (fun (tp, id) -> pretty_typ tp ^ " " ^ id) params ^ ") {\n" ^
|
||||
concatmap "" pretty_instr_ln instrs ^ "}\n"
|
||||
|
||||
let pretty_prog : prog -> string = function
|
||||
Prog defs -> concatmap "" pretty_func_def defs
|
||||
@ -0,0 +1,77 @@
|
||||
(*
|
||||
* Copyright (c) 2015 - Facebook.
|
||||
* All rights reserved.
|
||||
*)
|
||||
open LAst
|
||||
|
||||
exception ImproperTypeError of string
|
||||
exception Unimplemented of string
|
||||
|
||||
let gen_variable : variable -> Sil.exp = function (* HACK *)
|
||||
| Global id -> Sil.Var (Ident.create_normal (Ident.string_to_name id) 0)
|
||||
| Local id -> Sil.Var (Ident.create_normal (Ident.string_to_name id) 0)
|
||||
|
||||
let gen_constant : constant -> Sil.exp = function
|
||||
| Cint i -> Sil.Const (Sil.Cint (Sil.Int.of_int i))
|
||||
| Cnull -> Sil.exp_null
|
||||
|
||||
let gen_operand : operand -> Sil.exp = function
|
||||
| Var var -> gen_variable var
|
||||
| Const const -> gen_constant const
|
||||
|
||||
let rec gen_typ : typ -> Sil.typ = function
|
||||
| Tint i -> Sil.Tint IInt (* need to actually check what size int is needed here *)
|
||||
| Tfloat -> Sil.Tfloat FFloat
|
||||
| Tptr tp -> Tptr (gen_typ tp, Pk_pointer)
|
||||
| Tvector (i, tp)
|
||||
| Tarray (i, tp) -> Sil.Tarray (gen_typ tp, Sil.Const (Sil.Cint (Sil.Int.of_int i)))
|
||||
| Tlabel -> raise (ImproperTypeError "Tried to generate Sil type from LLVM label type.")
|
||||
| Tmetadata -> raise (ImproperTypeError "Tried to generate Sil type from LLVM metadata type.")
|
||||
|
||||
let gen_instr (cfg : Cfg.cfg) (pdesc : Cfg.Procdesc.t) : instr -> Sil.instr list = function
|
||||
| Ret None -> []
|
||||
| Ret (Some (tp, exp)) ->
|
||||
let ret_var = Sil.get_ret_pvar (Cfg.Procdesc.get_proc_name pdesc) in
|
||||
[Sil.Set (Sil.Lvar ret_var, gen_typ tp, gen_operand exp, Sil.dummy_location)]
|
||||
| _ -> raise (Unimplemented "Need to translate instruction to SIL.")
|
||||
|
||||
(* Modify the cfg in place *)
|
||||
let gen_func_def (old_cfg : Cfg.cfg) : func_def -> unit = function
|
||||
FuncDef (func_name, ret_tp_opt, params, instrs) ->
|
||||
let (proc_attrs : Sil.proc_attributes) =
|
||||
{ access = Sil.Default;
|
||||
exceptions = [];
|
||||
is_abstract = false;
|
||||
is_bridge_method = false;
|
||||
is_objc_instance_method = false;
|
||||
is_synthetic_method = false;
|
||||
language = Sil.C_CPP;
|
||||
func_attributes = [];
|
||||
method_annotation = Sil.method_annotation_empty
|
||||
} in
|
||||
let (pdesc_builder : Cfg.Procdesc.proc_desc_builder) =
|
||||
{ cfg = old_cfg;
|
||||
name = Procname.from_string (string_of_variable func_name);
|
||||
is_defined = true; (** is defined and not just declared *)
|
||||
proc_attributes = proc_attrs;
|
||||
ret_type = (match ret_tp_opt with
|
||||
| None -> Sil.Tvoid
|
||||
| Some ret_tp -> gen_typ ret_tp);
|
||||
formals = List.map (fun (tp, name) -> (name, gen_typ tp)) params;
|
||||
locals = []; (* TODO *)
|
||||
captured = [];
|
||||
loc = Sil.dummy_location
|
||||
} in
|
||||
let nodekind_of_instr : instr -> Cfg.Node.nodekind = function
|
||||
| Ret _ -> Cfg.Node.Stmt_node "method_body"
|
||||
| _ -> raise (Unimplemented "Need to get node type for instruction.") in
|
||||
let add_instr (cfg : Cfg.cfg) (pdesc : Cfg.Procdesc.t) (ins : instr) : unit =
|
||||
Cfg.Node.create cfg Sil.dummy_location (nodekind_of_instr ins)
|
||||
(gen_instr cfg pdesc ins) pdesc []; () in
|
||||
let pdesc = Cfg.Procdesc.create pdesc_builder in
|
||||
List.iter (fun ins -> add_instr old_cfg pdesc ins) instrs
|
||||
|
||||
let gen_prog : prog -> Cfg.cfg = function
|
||||
Prog fds ->
|
||||
let cfg = Cfg.Node.create_cfg () in
|
||||
List.iter (gen_func_def cfg) fds; cfg
|
||||
@ -1,43 +0,0 @@
|
||||
(*
|
||||
* Copyright (c) 2015 - present Facebook, Inc.
|
||||
* All rights reserved.
|
||||
*
|
||||
* This source code is licensed under the BSD style license found in the
|
||||
* LICENSE file in the root directory of this source tree. An additional grant
|
||||
* of patent rights can be found in the PATENTS file in the same directory.
|
||||
*)
|
||||
open Ast
|
||||
|
||||
let concatmap (sep : string) (f : 'a -> string) (l : 'a list) : string = String.concat sep (List.map f l)
|
||||
|
||||
let rec pretty_prog : prog -> string = function
|
||||
Prog defs -> concatmap "" pretty_func_def defs
|
||||
|
||||
and pretty_func_def : func_def -> string = function
|
||||
FuncDef (name, ret_tp, params, instrs) ->
|
||||
"define " ^ pretty_ret_typ ret_tp ^ " " ^ name ^ "(" ^
|
||||
concatmap ", " (fun (tp, id) -> pretty_typ tp ^ " " ^ id) params ^ ") {\n" ^
|
||||
concatmap "" pretty_instr_ln instrs ^ "}\n"
|
||||
|
||||
and pretty_ret_typ : typ option -> string = function
|
||||
| None -> "void"
|
||||
| Some tp -> pretty_typ tp
|
||||
|
||||
and pretty_typ : typ -> string = function
|
||||
| Tint width -> "i" ^ string_of_int width
|
||||
| Tfloat (* just one type for now *) -> "float"
|
||||
| Tptr tp -> pretty_typ tp ^ "*"
|
||||
| Tvector (sz, tp) -> "<" ^ string_of_int sz ^ " x " ^ pretty_typ tp ^ ">"
|
||||
| Tarray (sz, tp) -> "[" ^ string_of_int sz ^ " x " ^ pretty_typ tp ^ "]"
|
||||
|
||||
and pretty_instr_ln (i : instr) : string = pretty_instr i ^ "\n"
|
||||
|
||||
and pretty_instr : instr -> string = function
|
||||
| Ret None -> "ret void"
|
||||
| Ret (Some (tp, v)) -> "ret " ^ pretty_typ tp ^ " " ^ pretty_value v
|
||||
|
||||
and pretty_value : value -> string = function
|
||||
| True -> "true"
|
||||
| False -> "false"
|
||||
| Intlit i -> string_of_int i
|
||||
| Null -> "null"
|
||||
Loading…
Reference in new issue