34
35:- module(c99_decls,
36 [ c99_header_ast/3, 37 c99_types/4, 38 c99_types/5, 39 40 ast_constant/2 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]).
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 !. 125parameters([param([], ad(-,dad(-,-)))], []) :-
126 !. 127parameters(Params0, Params) :-
128 maplist(param, Params0, Params).
129
130param(param(RetType, declarator(Decl, dd(Name,dds(Params0)))),
131 Name-funcptr(RType, Params)) :- 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
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) :- 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
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), 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']. 401qualifier --> ['_Nullable'].
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
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, _) :- 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).
579
580
589constants(_AST, Constants) :-
590 Constants == (-), 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
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
(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 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] ]
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:
*/