1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2018, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(c99_decls, 36 [ c99_header_ast/3, % +Header, +Flags, -AST 37 c99_types/4, % +Header, +Flags, +Functions, -AST 38 c99_types/5, % +Header, +Flags, +Functions, -AST, 39 % -Consts 40 ast_constant/2 % +AST, -Constant 41 ]). 42:- use_module(library(process)). 43:- use_module(library(pure_input)). 44:- use_module(library(apply)). 45:- use_module(library(lists)). 46:- use_module(library(debug)). 47:- use_module(cparser). 48:- use_module(clocations). 49:- use_module(ffi, [c_sizeof/2, c_nil/1]).

Extract information from the C AST

This module parses the header string, produces an AST for the C code and extracts type information for a requested set of functions. This implies it finds the function prototypes and recursively unwraps typedefs until it reaches types defined by the C language. This process is split in two:

Find involved declarations from the AST (prototypes//2)
Unwrap the types (expand_types//1)

73c99_types(Header, Flags, Functions, Types) :- 74 c99_types(Header, Flags, Functions, Types, -). 75c99_types(Header, Flags, Functions, Types, Consts) :- 76 c99_header_ast(Header, Flags, AST), 77 phrase(prototypes(Functions, AST, [], _Resolved), Types0), 78 list_to_set(Types0, Types1), 79 phrase(expand_types(Types1), Types), 80 constants(AST, Consts). 81 82prototypes([], _, R, R) --> []. 83prototypes([H|T], AST, R0, R) --> 84 { optional(H, Func, Optional) }, 85 prototype(Func, Optional, AST, R0, R1), 86 prototypes(T, AST, R1, R). 87 88prototype(Func, _, AST, R0, R) --> 89 { skeleton(prototype(Return, RDecl, Params0), Func, FuncDecl), 90 memberchk(FuncDecl, AST), !, 91 parameters(Params0, Params), 92 basic_type(Return, BasicType), 93 pointers(RDecl, BasicType, RType) 94 }, 95 [ function(Func, RType, Params) ], 96 type_opt(RType, AST, R0, R1), 97 types(Params, AST, R1, R). 98prototype(_, optional, _, R, R) --> !. 99prototype(Func, required, _, R, R) --> 100 { print_message(error, ffi(existence_error(function_declaration, Func))) 101 }. 102 103optional([Func], Func, optional) :- !. 104optional(Func, Func, required).

111skeleton(prototype(Return, RDecl, Params), Func, 112 decl(Return, 113 [ declarator(RDecl, dd(Func, dds(Params))) 114 ], 115 _Attributes)). 116skeleton(prototype(Return, RDecl, Params), Func, 117 function(Return, 118 declarator(RDecl, dd(Func, dds(Params))), 119 _Attributes, 120 _Block)). 121 122 123parameters([param([type(void)], ad(-,dad(-,-)))], []) :- 124 !. % f(void) { ... } 125parameters([param([], ad(-,dad(-,-)))], []) :- 126 !. % f() { ... } 127parameters(Params0, Params) :- 128 maplist(param, Params0, Params). 129 130param(param(RetType, declarator(Decl, dd(Name,dds(Params0)))), 131 Name-funcptr(RType, Params)) :- % function pointers 132 basic_type(RetType, RType0), 133 pointers(Decl, RType0, RType), 134 parameters(Params0, Params), 135 !. 136param(param(Specifiers, declarator(Decl, dd(Name,DDS))), Name-Type) :- 137 !, 138 basic_type(Specifiers, BasicType), 139 dds_pointers(DDS, Decl, BasicType, Type). 140param(param(Specifiers, ad(Decl, dad(-, -))), Type) :- 141 basic_type(Specifiers, BasicType), 142 !, 143 pointers(Decl, BasicType, Type). 144param(param([], ...), ...). 145 146dds_pointers(dds([],-), Decl, Basic, Type) :- 147 !, 148 pointers(Decl, *(Basic), Type). 149dds_pointers(_, Decl, Basic, Type) :- 150 pointers(Decl, Basic, Type). 151 152pointers(-, Type, Type). 153pointers([], Type, Type). 154pointers([ptr(_)|T], Basic, Type) :- 155 pointers(T, *(Basic), Type). 156 157basic_type(Specifiers, Type) :- 158 include(is_type, Specifiers, Types), 159 ( phrase(simplify_type(Type), Types) 160 -> true 161 ; print_message(error, ctypes(cannot_simplify(Specifiers))), 162 fail 163 ), 164 !. 165 166is_type(type(_)). 167 168 169 /******************************* 170 * TYPE DEFINITIONS * 171 *******************************/

178types([], _, Resolved, Resolved) --> []. 179types([H|T], AST, Resolved0, Resolved) --> 180 type_opt(H, AST, Resolved0, Resolved1), 181 types(T, AST, Resolved1, Resolved). 182 183type_opt(Type, AST, Resolved0, Resolved) --> 184 type(Type, AST, Resolved0, Resolved), !. 185type_opt(_, _, Resolved, Resolved) --> []. 186 187type(Type, _AST, Resolved, Resolved) --> 188 { memberchk(Type, Resolved) }, 189 !. 190type(_Name-Type, AST, R0, R) --> !, type(Type, AST, R0, R). 191type(*(Type), AST, R0, R) --> !, type(Type, AST, R0, R). 192type(Type, AST, R0, R) --> 193 { ast_type(Type, AST, Defined) }, 194 [ Defined ], 195 type(Defined, AST, [Type|R0], R). 196type(type(Type), AST, R0, R) --> 197 type(Type, AST, R0, R). 198type(type(_, struct, Fields), AST, R0, R) --> 199 types(Fields, AST, R0, R). 200type(type(_, union, Fields), AST, R0, R) --> 201 types(Fields, AST, R0, R). 202type(type(_, enum, _Members), _AST, R, R) --> 203 []. 204type(f(Types, _Declarator, _Attrs), AST, R0, R) --> 205 types(Types, AST, R0, R). 206type(type(funcptr(RType, Parms)), AST, R0, R) --> 207 types(RType, AST, R0, R1), 208 types(Parms, AST, R1, R). 209type(type(_, typedef, Types), AST, R0, R) --> 210 types(Types, AST, R0, R). 211 212ast_type(struct(Name), AST, type(Name, struct, Fields)) :- 213 member(decl(Specifier, _Decl, _Attrs), AST), 214 memberchk(type(struct(Name, Fields0)), Specifier), !, 215 expand_fields(Fields0, Fields). 216ast_type(union(Name), AST, type(Name, union, Fields)) :- 217 member(decl(Specifier, _Decl, _Attrs), AST), 218 memberchk(type(union(Name, Fields0)), Specifier), !, 219 expand_fields(Fields0, Fields). 220ast_type(union(Name, Fields0), _, type(Name, union, Fields)) :- 221 expand_fields(Fields0, Fields). 222ast_type(struct(Name, Fields0), _, type(Name, struct, Fields)) :- 223 expand_fields(Fields0, Fields). 224ast_type(type(enum(Name, Members)), _, type(Name, enum, Members)). 225ast_type(enum(Name), AST, type(Name, enum, Members)) :- 226 member(decl(Specifier, _Decl, _Attrs), AST), 227 memberchk(type(enum(Name, Members)), Specifier), !. 228ast_type(user_type(Name), AST, type(Name, typedef, Primitive)) :- 229 typedef(Name, AST, Primitive).

237typedef(Name, AST, PPrimitive) :- 238 memberchk(decl(Specifier, 239 [ declarator(Ptrs, dd(Name, _))], _Attrs), AST), 240 selectchk(storage(typedef), Specifier, Primitive), !, 241 pointer_type(Ptrs, Primitive, PPrimitive). 242typedef(Name, AST, Primitive) :- % typedef rtype (*type)(param, ...); 243 memberchk(decl(Specifier, 244 [ declarator(_, dd(declarator([ptr([])], dd(Name,_)), 245 dds(Params0))) 246 ], _Attrs), AST), 247 selectchk(storage(typedef), Specifier, RType), !, 248 parameters(Params0, Params), 249 Primitive = [type(funcptr(RType, Params))]. 250 251pointer_type(-, Types, Types). 252pointer_type([], Types, Types). 253pointer_type([ptr(_)|T], Types0, Types) :- 254 pointer_type(T, [*|Types0], Types). 255 256expand_fields(Fields0, Fields) :- 257 maplist(expand_field, Fields0, Fields). 258 259expand_field(f(RType, 260 [ d(declarator(_, dd(declarator([ptr([])], dd(Name,_)), 261 dds(Params0)))) 262 ], Attrs), 263 f([type(funcptr(RType, Params))], 264 [d(declarator(-,dd(Name,-)))], 265 Attrs)) :- !, 266 parameters(Params0, Params). 267expand_field(Field, Field). 268 269 /******************************* 270 * EXPAND TYPES * 271 *******************************/

280expand_types(Types) --> 281 expand_types(Types, Types). 282 283expand_types([], _) --> []. 284expand_types([H|T], Types) --> 285 expand_type(H, Types), !, 286 expand_types(T, Types). 287expand_types([H|T], Types) --> 288 { print_message(error, ffi(expand_type_failed(H))) }, 289 expand_types(T, Types). 290 291 292expand_type(function(Name, Return0, Params0), Types) --> !, 293 { untypedef(Types, Return0, Return), 294 maplist(untypedef(Types), Params0, Params) 295 }, 296 [ function(Name, Return, Params) ]. 297expand_type(type(Name, struct, Fields0), Types) --> !, 298 [ struct(Name, Fields) ], 299 { phrase(expand_field(Fields0, Types), Fields) }. 300expand_type(type(Name, union, Fields0), Types) --> !, 301 [ union(Name, Fields) ], 302 { phrase(expand_field(Fields0, Types), Fields) }. 303expand_type(type(Name, enum, Members), _Types) --> !, 304 [ enum(Name, Members) ]. 305expand_type(type(Name, typedef, Type0), Types) --> !, 306 { simplify_types(Type0, Types, Type1), 307 type_reference(Type1, Type) 308 }, 309 [ typedef(Name, Type) ]. 310expand_type(_, _) --> []. 311 312expand_field([], _) --> []. 313expand_field([f(Type0, Declarators, _)|T], Types) --> 314 { maplist(declarator_name(Types), Declarators, Names), 315 simplify_types(Type0, Types, Type) 316 }, 317 repeat_fields(Names, Type), 318 expand_field(T, Types). 319 320declarator_name(Types, d(declarator(Ptr,dd(Name,dds([],AST)))), 321 array(Name, N, Ptr)) :- 322 ast \== (-), 323 ast_constant(AST, N, Types), 324 !. 325declarator_name(_Types, d(declarator(Ptr,dd(Name,_))), 326 plain(Name, Ptr)) :- !. 327declarator_name(Types, bitfield(declarator(-, dd(Name,_)), AST), 328 bitfield(Name, N)) :- 329 ast \== (-), 330 ast_constant(AST, N, Types), 331 !. 332declarator_name(_Types, Declarator, -) :- 333 print_message(error, ffi(declarator_name(Declarator))), 334 fail. 335 336repeat_fields([], _) --> []. 337repeat_fields([H|T], Type) --> field(H, Type), repeat_fields(T, Type). 338 339field(plain(Name, Ptr), Type0) --> 340 { pointers(Ptr, Type0, Type1), 341 type_reference(Type1, Type) 342 }, 343 [f(Name, Type)]. 344field(array(Name, Length, Ptr), EType0) --> 345 { type_reference(EType0, EType), 346 pointers(Ptr, array(EType,Length), Type) 347 }, 348 [f(Name, Type)]. 349field(bitfield(Name, Width), EType0) --> 350 { type_reference(EType0, EType), 351 assertion(EType == uint) 352 }, 353 [f(Name, bitfield(Width))]. 354 355simplify_types(Type0, Types, Type) :- 356 phrase(expand_user_type(Type0, Types), Type1), 357 ( phrase(simplify_type(Type, Types), Type1) 358 -> true 359 ; print_message(error, ctypes(cannot_simplify(Type0))), 360 Type = Type0 361 ). 362 363expand_user_type([], _) --> []. 364expand_user_type([type(user_type(TypeName))|T], Types) --> !, 365 ( { memberchk(type(TypeName, typedef, Expanded), Types) } 366 -> expand_user_type(Expanded, Types), % recursive 367 expand_user_type(T, Types) 368 ; { print_message(error, ffi(existence_error(user_type, TypeName))) } 369 ). 370expand_user_type([H|T], Types) --> 371 [H], 372 expand_user_type(T, Types). 373 374simplify_type(struct(Name,Fields), Types) --> 375 [ type(struct(Name, Fields0)) ], 376 !, 377 { phrase(expand_field(Fields0, Types), Fields) }. 378simplify_type(union(Name,Fields), Types) --> 379 [ type(union(Name, Fields0)) ], 380 !, 381 { phrase(expand_field(Fields0, Types), Fields) }. 382simplify_type(funcptr(Ret,Params), Types) --> 383 [ type(funcptr(Ret0,Params1)) ], 384 !, 385 { simplify_types(Ret0, Types, Ret), 386 maplist(untypedef(Types), Params1, Params) 387 }. 388simplify_type(*(Type), Types) --> 389 [*], !, 390 simplify_type(Type, Types). 391simplify_type(Type, _Types) --> 392 opt_qualifiers, 393 simplify_type(Type). 394 395opt_qualifiers --> qualifier, !, opt_qualifiers. 396opt_qualifiers --> []. 397 398qualifier --> [const]. 399qualifier --> [volatile]. 400qualifier --> ['_Nonnull']. % Clang on MacOS 401qualifier --> ['_Nullable']. % Clang on MacOS

408simplify_type(Type) --> 409 simplify_type(U,L,B,F), 410 { nonvar(F), 411 ignore(U=s), 412 ignore(B=int), 413 close_list(L), 414 simple_type(U,L,B,Type) 415 }, 416 !. 417simplify_type(Type) --> 418 [ type(Type) ]. 419 420simplify_type(u,L,B,t) --> 421 [type(unsigned)], !, 422 simplify_type(u,L,B,t). 423simplify_type(s,L,B,t) --> 424 [type(signed)], !, 425 simplify_type(s,L,B,t). 426simplify_type(U,[H|L],B,t) --> 427 type_width(H), 428 !, 429 simplify_type(U,L,B,t). 430simplify_type(U,L,B,t) --> 431 base_int_type(B), 432 !, 433 simplify_type(U,L,B,t). 434simplify_type(_,_,_,_) --> 435 []. 436 437type_width(long) --> [type(long)]. 438type_width(short) --> [type(short)]. 439 440base_int_type(int) --> [type(int)]. 441base_int_type(char) --> [type(char)]. 442 443close_list([]) :- !. 444close_list([_|T]) :- close_list(T). 445 446simple_type(u, [long,long], int, ulonglong). 447simple_type(u, [long], int, ulong). 448simple_type(u, [], int, uint). 449simple_type(u, [short], int, ushort). 450simple_type(u, [], char, uchar). 451simple_type(s, [long,long], int, longlong). 452simple_type(s, [long], int, long). 453simple_type(s, [], int, int). 454simple_type(s, [short], int, short). 455simple_type(s, [], char, schar).

459untypedef(Types, *(Type0), *(Type)) :- 460 !, 461 untypedef(Types, Type0, Type). 462untypedef(Types, Name-Type0, Name-Type) :- 463 !, 464 untypedef(Types, Type0, Type). 465untypedef(Types, user_type(Name), Type) :- 466 simplify_types([type(user_type(Name))], Types, Type1), 467 type_reference(Type1, Type), 468 !. 469untypedef(_, Type, Type). 470 471type_reference(struct(Name, _Fields), struct(Name)) :- !. 472type_reference(union(Name, _Fields), union(Name)) :- !. 473type_reference(enum(Name, _Values), enum(Name)) :- !. 474type_reference(Type, Type). 475 476 477 478 /******************************* 479 * EVAL * 480 *******************************/

490ast_constant(AST, Constant) :- 491 ast_constant(AST, Constant, []). 492 493ast_constant(i(V), V, _). 494ast_constant(l(Int), Int, _). 495ast_constant(ll(Int), Int, _). 496ast_constant(u(Int), Int, _). 497ast_constant(ul(Int), Int, _). 498ast_constant(ull(Int), Int, _). 499ast_constant(float(Float), Float, _). 500ast_constant(double(Float), Float, _). 501ast_constant(char(Codes), Codes, _). 502ast_constant(wchar(Codes), Codes, _). 503ast_constant(sizeof(Type), Size, Types) :- 504 ( ast_sizeof(Type, Size, Types) 505 -> true 506 ; print_message(warning, ffi(noconst(sizeof(Type)))), 507 fail 508 ). 509ast_constant(cast(type_name([type(void)],ad([ptr([])],dad(-,-))),i(0)), 510 C, _) :- % (void)0 511 c_nil(C). 512ast_constant(o(Op, L), C, Types) :- 513 ast_constant(L, LC, Types), 514 c_op(Op, LC, C). 515ast_constant(o(Op, L, R), C, Types) :- 516 ast_constant(L, LC, Types), 517 ast_constant(R, RC, Types), 518 c_op(Op, LC, RC, C). 519 520c_op(+, A, A). 521c_op(-, A, V) :- V is -A. 522c_op(~, A, V) :- V is \A. 523c_op(!, A, V) :- ebool(A, B), neg(B, V). 524 525c_op(*, L, R, V) :- V is L*R. 526c_op(/, L, R, V) :- V is L/R. 527c_op('%', L, R, V) :- V is L mod R. 528c_op(+, L, R, V) :- V is L + R. 529c_op(-, L, R, V) :- V is L - R. 530c_op(<<, L, R, V) :- V is L << R. 531c_op(>>, L, R, V) :- V is L >> R. 532c_op(<, L, R, V) :- (L < R -> V = 1 ; V = 0). 533c_op(>, L, R, V) :- (L > R -> V = 1 ; V = 0). 534c_op(>=, L, R, V) :- (L >= R -> V = 1 ; V = 0). 535c_op(<=, L, R, V) :- (L =< R -> V = 1 ; V = 0). 536c_op(==, L, R, V) :- (L =:= R -> V = 1 ; V = 0). 537c_op('!=', L, R, V) :- (L =\= R -> V = 1 ; V = 0). 538c_op(&, L, R, V) :- V is L /\ R. 539c_op('|', L, R, V) :- V is L \/ R. 540c_op(^, L, R, V) :- V is L xor R. 541c_op(&&, L, R, V) :- ebool(L, LB), ebool(R, RB), and(LB, RB, V). 542c_op('||', L, R, V) :- ebool(L, LB), ebool(R, RB), or(LB, RB, V). 543 544ebool(V, 0) :- V =:= 0, !. 545ebool(_, 1). 546 547neg(0, 1). 548neg(1, 0). 549 550and(1, 1, 1) :- !. 551and(_, _, 0). 552 553or(1, 1, 1) :- !. 554or(0, 1, 1) :- !. 555or(1, 0, 1) :- !. 556or(0, 0, 0) :- !.

564ast_sizeof(type(type_name([type(Primitive)],ad(-,dad(-,-)))), Size, _) :- 565 c_sizeof(Primitive, Size), 566 !. 567ast_sizeof(type(type_name(_,ad([ptr(_)|_],dad(-,-)))), Size, _) :- 568 c_sizeof(pointer, Size), 569 !. 570ast_sizeof(TypeName, Size, Types) :- 571 simplify_types([type(user_type(TypeName))], Types, Simple), 572 c_sizeof(Simple, Size). 573/* 574ast_sizeof(Type, Size, Types) :- 575 debugging(ffi(sizeof)), 576 gtrace, 577 ast_sizeof(Type, Size, Types). 578*/ 579 580 /******************************* 581 * CONSTANTS * 582 *******************************/

589constants(_AST, Constants) :- 590 Constants == (-), % constants are not demanded 591 !. 592constants(AST, Constants) :- 593 findall(Name=Value, constant(AST, Name, Value), Constants). 594 595constant(AST, Name, Value) :- 596 member(decl([storage(static),type(int)], 597 [declarator(-,dd(MagicName,-))=init(Value)], 598 _), 599 AST), 600 atom_concat('__swipl_const_', Name, MagicName), 601 Value \== Name. 602 603 604 /******************************* 605 * CALL PREPROCESSOR * 606 *******************************/

610c99_header_ast(Header, Flags, AST) :- 611 debug_dump_header(Header, Flags), 612 setup_call_cleanup( 613 open_gcc_cpp(Header, Flags, In), 614 phrase_from_stream(c99_parse(AST), In), 615 close(In)). 616 617debug_dump_header(Header, Flags) :- 618 debugging(ffi(dump(cpp_output, File))), 619 !, 620 setup_call_cleanup( 621 open(File, write, Out), 622 setup_call_cleanup( 623 open_gcc_cpp(Header, Flags, In), 624 copy_stream_data(In, Out), 625 close(In)), 626 close(Out)). 627debug_dump_header(_,_). 628 629open_gcc_cpp(Header, Flags, Out) :- 630 process_create_options(CreateOptions), 631 cpp(Command, Argv), 632 append(Flags, Argv, CPPFlags), 633 process_create(Command, CPPFlags, 634 [ stdin(pipe(In)), 635 stdout(pipe(Out)), 636 stderr(pipe(Err)) 637 | CreateOptions 638 ]), 639 thread_create(copy_error(Err), _, [detached(true)]), 640 thread_create( 641 setup_call_cleanup( 642 open_string(Header, HIn), 643 copy_stream_data(HIn, In), 644 ( close(HIn), 645 close(In) 646 )), _, [detached(true)]). 647 648process_create_options([cwd(Dir)]) :- 649 prolog_load_context(directory, Dir), 650 !. 651process_create_options([]). 652 653copy_error(Err) :- 654 read_line_to_string(Err, Line), 655 ( Line == end_of_file 656 -> close(Err) 657 ; print_message(error, ffi(cpp(Line))), 658 copy_error(Err) 659 ). 660 661 662 /******************************* 663 * MESSAGES * 664 *******************************/ 665 666:- multifile prolog:message//1. 667 668prolog:message(ffi(Msg)) --> 669 message(Msg). 670 671message(existence_error(function_declaration, Func)) --> 672 [ 'FFI: No declaration for function ~q'-[Func] ]. 673message(existence_error(user_type, Type)) --> 674 [ 'FFI: No declaration for type ~q'-[Type] ]. 675message(noconst(What)) --> 676 [ 'FFI: Could not evaluate ~p to a constant'-[What] ]. 677message(cpp(Message)) --> 678 [ 'CPP: ~s'-[Message] ]