Skip to content
Snippets Groups Projects
Commit f961ff40 authored by xleroy's avatar xleroy
Browse files

Support for 'inline' modifier

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1272 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
parent 6c196ec8
No related branches found
No related tags found
No related merge requests found
...@@ -205,6 +205,7 @@ type struct_or_union = ...@@ -205,6 +205,7 @@ type struct_or_union =
type fundef = { type fundef = {
fd_storage: storage; fd_storage: storage;
fd_inline: bool;
fd_name: ident; fd_name: ident;
fd_ret: typ; (* return type *) fd_ret: typ; (* return type *)
fd_params: (ident * typ) list; (* formal parameters *) fd_params: (ident * typ) list; (* formal parameters *)
......
...@@ -437,7 +437,9 @@ and opt_exp pp s = ...@@ -437,7 +437,9 @@ and opt_exp pp s =
fprintf pp "@[<v 3>({ %a })@]" stmt s fprintf pp "@[<v 3>({ %a })@]" stmt s
let fundef pp f = let fundef pp f =
fprintf pp "@[<hov 2>%a" storage f.fd_storage; fprintf pp "@[<hov 2>%s%a"
(if f.fd_inline then "inline " else "")
storage f.fd_storage;
simple_decl pp (f.fd_name, TFun(f.fd_ret, Some f.fd_params, f.fd_vararg, [])); simple_decl pp (f.fd_name, TFun(f.fd_ret, Some f.fd_params, f.fd_vararg, []));
fprintf pp "@]@ @[<v 2>{@ "; fprintf pp "@]@ @[<v 2>{@ ";
List.iter (fun d -> fprintf pp "%a@ " full_decl d) f.fd_locals; List.iter (fun d -> fprintf pp "%a@ " full_decl d) f.fd_locals;
......
...@@ -288,8 +288,8 @@ let typespec_rank = function (* Don't change this *) ...@@ -288,8 +288,8 @@ let typespec_rank = function (* Don't change this *)
let typespec_order t1 t2 = compare (typespec_rank t1) (typespec_rank t2) let typespec_order t1 t2 = compare (typespec_rank t1) (typespec_rank t2)
(* Elaboration of a type specifier. Returns 3-tuple: (* Elaboration of a type specifier. Returns 4-tuple:
(storage class, elaborated type, new env) (storage class, "inline" flag, elaborated type, new env)
Optional argument "only" is true if this is a standalone Optional argument "only" is true if this is a standalone
struct or union declaration, without variable names. struct or union declaration, without variable names.
*) *)
...@@ -300,6 +300,7 @@ let rec elab_specifier ?(only = false) loc env specifier = ...@@ -300,6 +300,7 @@ let rec elab_specifier ?(only = false) loc env specifier =
- a set of attributes (const, volatile, restrict) - a set of attributes (const, volatile, restrict)
- a list of type specifiers *) - a list of type specifiers *)
let sto = ref Storage_default let sto = ref Storage_default
and inline = ref false
and attr = ref [] and attr = ref []
and tyspecs = ref [] in and tyspecs = ref [] in
...@@ -324,12 +325,12 @@ let rec elab_specifier ?(only = false) loc env specifier = ...@@ -324,12 +325,12 @@ let rec elab_specifier ?(only = false) loc env specifier =
| EXTERN -> sto := Storage_extern | EXTERN -> sto := Storage_extern
| REGISTER -> sto := Storage_register | REGISTER -> sto := Storage_register
end end
| SpecInline -> () | SpecInline -> inline := true
| SpecType tys -> tyspecs := tys :: !tyspecs in | SpecType tys -> tyspecs := tys :: !tyspecs in
List.iter do_specifier specifier; List.iter do_specifier specifier;
let simple ty = (!sto, add_attributes_type !attr ty, env) in let simple ty = (!sto, !inline, add_attributes_type !attr ty, env) in
(* Now interpret the list of type specifiers. Much of this code (* Now interpret the list of type specifiers. Much of this code
is stolen from CIL. *) is stolen from CIL. *)
...@@ -393,19 +394,19 @@ let rec elab_specifier ?(only = false) loc env specifier = ...@@ -393,19 +394,19 @@ let rec elab_specifier ?(only = false) loc env specifier =
let (id', env') = let (id', env') =
elab_struct_or_union only Struct loc id optmembers env in elab_struct_or_union only Struct loc id optmembers env in
let attr' = add_attributes !attr (elab_attributes loc a) in let attr' = add_attributes !attr (elab_attributes loc a) in
(!sto, TStruct(id', attr'), env') (!sto, !inline, TStruct(id', attr'), env')
| [Cabs.Tunion(id, optmembers, a)] -> | [Cabs.Tunion(id, optmembers, a)] ->
let (id', env') = let (id', env') =
elab_struct_or_union only Union loc id optmembers env in elab_struct_or_union only Union loc id optmembers env in
let attr' = add_attributes !attr (elab_attributes loc a) in let attr' = add_attributes !attr (elab_attributes loc a) in
(!sto, TUnion(id', attr'), env') (!sto, !inline, TUnion(id', attr'), env')
| [Cabs.Tenum(id, optmembers, a)] -> | [Cabs.Tenum(id, optmembers, a)] ->
let env' = let env' =
elab_enum loc id optmembers env in elab_enum loc id optmembers env in
let attr' = add_attributes !attr (elab_attributes loc a) in let attr' = add_attributes !attr (elab_attributes loc a) in
(!sto, TInt(enum_ikind, attr'), env') (!sto, !inline, TInt(enum_ikind, attr'), env')
| [Cabs.TtypeofE _] -> | [Cabs.TtypeofE _] ->
fatal_error loc "GCC __typeof__ not supported" fatal_error loc "GCC __typeof__ not supported"
...@@ -469,7 +470,7 @@ and elab_parameters env params = ...@@ -469,7 +470,7 @@ and elab_parameters env params =
(* Elaboration of a function parameter *) (* Elaboration of a function parameter *)
and elab_parameter env (spec, name) = and elab_parameter env (spec, name) =
let (id, sto, ty, env1) = elab_name env spec name in let (id, sto, inl, ty, env1) = elab_name env spec name in
if sto <> Storage_default && sto <> Storage_register then if sto <> Storage_default && sto <> Storage_register then
error (loc_of_name name) error (loc_of_name name)
"'extern' or 'static' storage not supported for function parameter"; "'extern' or 'static' storage not supported for function parameter";
...@@ -481,15 +482,15 @@ and elab_parameter env (spec, name) = ...@@ -481,15 +482,15 @@ and elab_parameter env (spec, name) =
(* Elaboration of a (specifier, Cabs "name") pair *) (* Elaboration of a (specifier, Cabs "name") pair *)
and elab_name env spec (id, decl, attr, loc) = and elab_name env spec (id, decl, attr, loc) =
let (sto, bty, env') = elab_specifier loc env spec in let (sto, inl, bty, env') = elab_specifier loc env spec in
let (ty, env'') = elab_type_declarator loc env' bty decl in let (ty, env'') = elab_type_declarator loc env' bty decl in
let a = elab_attributes loc attr in let a = elab_attributes loc attr in
(id, sto, add_attributes_type a ty, env'') (id, sto, inl, add_attributes_type a ty, env'')
(* Elaboration of a name group *) (* Elaboration of a name group *)
and elab_name_group env (spec, namelist) = and elab_name_group env (spec, namelist) =
let (sto, bty, env') = let (sto, inl, bty, env') =
elab_specifier (loc_of_namelist namelist) env spec in elab_specifier (loc_of_namelist namelist) env spec in
let elab_one_name env (id, decl, attr, loc) = let elab_one_name env (id, decl, attr, loc) =
let (ty, env1) = let (ty, env1) =
...@@ -501,7 +502,7 @@ and elab_name_group env (spec, namelist) = ...@@ -501,7 +502,7 @@ and elab_name_group env (spec, namelist) =
(* Elaboration of an init-name group *) (* Elaboration of an init-name group *)
and elab_init_name_group env (spec, namelist) = and elab_init_name_group env (spec, namelist) =
let (sto, bty, env') = let (sto, inl, bty, env') =
elab_specifier (loc_of_init_name_list namelist) env spec in elab_specifier (loc_of_init_name_list namelist) env spec in
let elab_one_name env ((id, decl, attr, loc), init) = let elab_one_name env ((id, decl, attr, loc), init) =
let (ty, env1) = let (ty, env1) =
...@@ -663,10 +664,10 @@ and elab_enum loc tag optmembers env = ...@@ -663,10 +664,10 @@ and elab_enum loc tag optmembers env =
(* Elaboration of a naked type, e.g. in a cast *) (* Elaboration of a naked type, e.g. in a cast *)
let elab_type loc env spec decl = let elab_type loc env spec decl =
let (sto, bty, env') = elab_specifier loc env spec in let (sto, inl, bty, env') = elab_specifier loc env spec in
let (ty, env'') = elab_type_declarator loc env' bty decl in let (ty, env'') = elab_type_declarator loc env' bty decl in
if sto <> Storage_default then if sto <> Storage_default || inl then
error loc "'extern' or 'static' storage not supported in cast"; error loc "'extern', 'static', 'register' and 'inline' are meaningless in cast";
ty ty
...@@ -1481,7 +1482,7 @@ let rec enter_decdefs local loc env = function ...@@ -1481,7 +1482,7 @@ let rec enter_decdefs local loc env = function
end end
let elab_fundef env (spec, name) body loc1 loc2 = let elab_fundef env (spec, name) body loc1 loc2 =
let (s, sto, ty, env1) = elab_name env spec name in let (s, sto, inline, ty, env1) = elab_name env spec name in
if sto = Storage_register then if sto = Storage_register then
error loc1 "a function definition cannot have 'register' storage class"; error loc1 "a function definition cannot have 'register' storage class";
(* Fix up the type. We can have params = None but only for an (* Fix up the type. We can have params = None but only for an
...@@ -1506,6 +1507,7 @@ let elab_fundef env (spec, name) body loc1 loc2 = ...@@ -1506,6 +1507,7 @@ let elab_fundef env (spec, name) body loc1 loc2 =
(* Build and emit function definition *) (* Build and emit function definition *)
let fn = let fn =
{ fd_storage = sto; { fd_storage = sto;
fd_inline = inline;
fd_name = fun_id; fd_name = fun_id;
fd_ret = ty_ret; fd_ret = ty_ret;
fd_params = params; fd_params = params;
...@@ -1537,9 +1539,9 @@ let rec elab_definition (local: bool) (env: Env.t) (def: Cabs.definition) ...@@ -1537,9 +1539,9 @@ let rec elab_definition (local: bool) (env: Env.t) (def: Cabs.definition)
(* "struct s { ...};" or "union u;" *) (* "struct s { ...};" or "union u;" *)
| ONLYTYPEDEF(spec, loc) -> | ONLYTYPEDEF(spec, loc) ->
let (sto, ty, env') = elab_specifier ~only:true loc env spec in let (sto, inl, ty, env') = elab_specifier ~only:true loc env spec in
if sto <> Storage_default then if sto <> Storage_default || inl then
error loc "Non-default storage on 'struct' or 'union' declaration"; error loc "Non-default storage or 'inline' on 'struct' or 'union' declaration";
([], env') ([], env')
(* global asm statement *) (* global asm statement *)
......
...@@ -173,6 +173,7 @@ let fundef env f = ...@@ -173,6 +173,7 @@ let fundef env f =
let (params', env1) = mmap param env0 f.fd_params in let (params', env1) = mmap param env0 f.fd_params in
let (locals', env2) = mmap decl env1 f.fd_locals in let (locals', env2) = mmap decl env1 f.fd_locals in
( { fd_storage = f.fd_storage; ( { fd_storage = f.fd_storage;
fd_inline = f.fd_inline;
fd_name = name'; fd_name = name';
fd_ret = typ env0 f.fd_ret; fd_ret = typ env0 f.fd_ret;
fd_params = params'; fd_params = params';
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment