aboutsummaryrefslogtreecommitdiffstats
path: root/cfrontend/C2C.ml
diff options
context:
space:
mode:
Diffstat (limited to 'cfrontend/C2C.ml')
-rw-r--r--cfrontend/C2C.ml91
1 files changed, 51 insertions, 40 deletions
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml
index 5cd5997d..bd281374 100644
--- a/cfrontend/C2C.ml
+++ b/cfrontend/C2C.ml
@@ -524,6 +524,13 @@ let convertField env f =
(intern_string f.fld_name, convertTyp env f.fld_typ)
let convertCompositedef env su id attr members =
+ let t = match su with
+ | C.Struct ->
+ let layout = Cutil.struct_layout env members in
+ List.iter (fun (a,b) -> Debug.set_member_offset id a b) layout;
+ TStruct (id,attr)
+ | C.Union -> TUnion (id,attr) in
+ Debug.set_composite_size id su (Cutil.sizeof env t);
Composite(intern_string id.name,
begin match su with C.Struct -> Struct | C.Union -> Union end,
List.map (convertField env) members,
@@ -741,6 +748,22 @@ let rec convertExpr env e =
| C.ECompound(ty1, ie) ->
unsupported "compound literals"; ezero
+ | C.ECall({edesc = C.EVar {name = "__builtin_debug"}}, args) ->
+ let (kind, args1) =
+ match args with
+ | {edesc = C.EConst(CInt(n,_,_))} :: args1 -> (n, args1)
+ | _ -> error "ill_formed __builtin_debug"; (0L, args) in
+ let (text, args2) =
+ match args1 with
+ | {edesc = C.EConst(CStr(txt))} :: args2 -> (txt, args2)
+ | {edesc = C.EVar id} :: args2 -> (id.name, args2)
+ | _ -> error "ill_formed __builtin_debug"; ("", args1) in
+ let targs2 = convertTypArgs env [] args2 in
+ Ebuiltin(
+ EF_debug(P.of_int64 kind, intern_string text,
+ typlist_of_typelist targs2),
+ targs2, convertExprList env args2, convertTyp env e.etyp)
+
| C.ECall({edesc = C.EVar {name = "__builtin_annot"}}, args) ->
begin match args with
| {edesc = C.EConst(CStr txt)} :: args1 ->
@@ -922,16 +945,6 @@ let rec contains_case s =
(** Annotations for line numbers *)
-let add_lineno prev_loc this_loc s =
- if !Clflags.option_g && prev_loc <> this_loc && this_loc <> Cutil.no_loc
- then begin
- let txt = sprintf "#line:%s:%d" (fst this_loc) (snd this_loc) in
- Ssequence(Sdo(Ebuiltin(EF_debug(P.one, intern_string txt, []),
- Tnil, Enil, Tvoid)),
- s)
- end else
- s
-
(** Statements *)
let swrap = function
@@ -939,36 +952,31 @@ let swrap = function
| Errors.Error msg ->
error ("retyping error: " ^ string_of_errmsg msg); Sskip
-let rec convertStmt ploc env s =
+let rec convertStmt env s =
updateLoc s.sloc;
match s.sdesc with
| C.Sskip ->
Sskip
| C.Sdo e ->
- add_lineno ploc s.sloc (swrap (Ctyping.sdo (convertExpr env e)))
+ swrap (Ctyping.sdo (convertExpr env e))
| C.Sseq(s1, s2) ->
- let s1' = convertStmt ploc env s1 in
- let s2' = convertStmt s1.sloc env s2 in
+ let s1' = convertStmt env s1 in
+ let s2' = convertStmt env s2 in
Ssequence(s1', s2')
| C.Sif(e, s1, s2) ->
let te = convertExpr env e in
- add_lineno ploc s.sloc
- (swrap (Ctyping.sifthenelse te
- (convertStmt s.sloc env s1) (convertStmt s.sloc env s2)))
+ swrap (Ctyping.sifthenelse te (convertStmt env s1) (convertStmt env s2))
| C.Swhile(e, s1) ->
let te = convertExpr env e in
- add_lineno ploc s.sloc
- (swrap (Ctyping.swhile te (convertStmt s.sloc env s1)))
+ swrap (Ctyping.swhile te (convertStmt env s1))
| C.Sdowhile(s1, e) ->
let te = convertExpr env e in
- add_lineno ploc s.sloc
- (swrap (Ctyping.sdowhile te (convertStmt s.sloc env s1)))
+ swrap (Ctyping.sdowhile te (convertStmt env s1))
| C.Sfor(s1, e, s2, s3) ->
let te = convertExpr env e in
- add_lineno ploc s.sloc
- (swrap (Ctyping.sfor
- (convertStmt s.sloc env s1) te
- (convertStmt s.sloc env s2) (convertStmt s.sloc env s3)))
+ swrap (Ctyping.sfor
+ (convertStmt env s1) te
+ (convertStmt env s2) (convertStmt env s3))
| C.Sbreak ->
Sbreak
| C.Scontinue ->
@@ -981,22 +989,20 @@ let rec convertStmt ploc env s =
contains_case init
end;
let te = convertExpr env e in
- add_lineno ploc s.sloc
- (swrap (Ctyping.sswitch te
- (convertSwitch s.sloc env (is_longlong env e.etyp) cases)))
+ swrap (Ctyping.sswitch te
+ (convertSwitch env (is_longlong env e.etyp) cases))
| C.Slabeled(C.Slabel lbl, s1) ->
- add_lineno ploc s.sloc
- (Slabel(intern_string lbl, convertStmt s.sloc env s1))
+ Slabel(intern_string lbl, convertStmt env s1)
| C.Slabeled(C.Scase _, _) ->
unsupported "'case' outside of 'switch'"; Sskip
| C.Slabeled(C.Sdefault, _) ->
unsupported "'default' outside of 'switch'"; Sskip
| C.Sgoto lbl ->
- add_lineno ploc s.sloc (Sgoto(intern_string lbl))
+ Sgoto(intern_string lbl)
| C.Sreturn None ->
- add_lineno ploc s.sloc (Sreturn None)
+ Sreturn None
| C.Sreturn(Some e) ->
- add_lineno ploc s.sloc (Sreturn(Some(convertExpr env e)))
+ Sreturn(Some(convertExpr env e))
| C.Sblock _ ->
unsupported "nested blocks"; Sskip
| C.Sdecl _ ->
@@ -1004,10 +1010,9 @@ let rec convertStmt ploc env s =
| C.Sasm(attrs, txt, outputs, inputs, clobber) ->
if not !Clflags.option_finline_asm then
unsupported "inline 'asm' statement (consider adding option -finline-asm)";
- add_lineno ploc s.sloc
- (Sdo (convertAsm s.sloc env txt outputs inputs clobber))
+ Sdo (convertAsm s.sloc env txt outputs inputs clobber)
-and convertSwitch ploc env is_64 = function
+and convertSwitch env is_64 = function
| [] ->
LSnil
| (lbl, s) :: rem ->
@@ -1024,7 +1029,7 @@ and convertSwitch ploc env is_64 = function
then Z.of_uint64 v
else Z.of_uint32 (Int64.to_int32 v))
in
- LScons(lbl', convertStmt ploc env s, convertSwitch s.sloc env is_64 rem)
+ LScons(lbl', convertStmt env s, convertSwitch env is_64 rem)
(** Function definitions *)
@@ -1038,7 +1043,9 @@ let convertFundef loc env fd =
let params =
List.map
(fun (id, ty) ->
- (intern_string id.name, convertTyp env ty))
+ let id' = intern_string id.name in
+ Debug.atom_parameter fd.fd_name id id';
+ (id', convertTyp env ty))
fd.fd_params in
let vars =
List.map
@@ -1047,10 +1054,13 @@ let convertFundef loc env fd =
unsupported "'static' or 'extern' local variable";
if init <> None then
unsupported "initialized local variable";
- (intern_string id.name, convertTyp env ty))
+ let id' = intern_string id.name in
+ Debug.atom_local_variable id id';
+ (id', convertTyp env ty))
fd.fd_locals in
- let body' = convertStmt loc env fd.fd_body in
+ let body' = convertStmt env fd.fd_body in
let id' = intern_string fd.fd_name.name in
+ Debug.atom_function fd.fd_name id';
Hashtbl.add decl_atom id'
{ a_storage = fd.fd_storage;
a_alignment = None;
@@ -1116,6 +1126,7 @@ let convertInitializer env ty i =
let convertGlobvar loc env (sto, id, ty, optinit) =
let id' = intern_string id.name in
+ Debug.atom_global_variable id id';
let ty' = convertTyp env ty in
let sz = Ctypes.sizeof !comp_env ty' in
let al = Ctypes.alignof !comp_env ty' in
generated by cgit (git 2.34.1) at 2024-07-02 12:39:02 +0000