% This file is part of melmac. See file COPYING for copyright information. % Author: Gergo Barany % Utilities related to construction of ALF fragments from smaller parts; % these are things like "given two operand ALF expressions, generate an % addition expression". Also, some predicates for deconstructing/filtering % ALF terms. :- module(alf_utils, [ stmts_allocs_inits_execs/4, declarations_funcdefs/2, declarations_inits/2, declarations_allocs/2, label_body/3, alf_offset/2, alf_bit/2, alf_varref/3, alf_funcref/2, alf_label/1, alflabel_name/2, pointer_basetype_dereferenced/3, alf_binop/5, condition_bitexp/2, address_offset_fieldaddress/3, make_global/5, string_address/2, string_address_fact/2, string_addresses/1, clear_string_addresses/0, string_constant_declarations/2, alfexpr_size/2, alfterm_withoutmacrodefs/2 ]). stmts_allocs_inits_execs([], [], [], []). stmts_allocs_inits_execs([A|Ss], [A|As], Is, Es) :- A = alloc(_, _, _), stmts_allocs_inits_execs(Ss, As, Is, Es). stmts_allocs_inits_execs([L:A,S|Ss], [A|As], Is, Es) :- A = alloc(_, _, _), % Pass the label correctly. ( S = L:_Stmt -> S2 = S ; S2 = L:S ), stmts_allocs_inits_execs([S2|Ss], As, Is, Es). stmts_allocs_inits_execs([I|Ss], As, [I|Is], Es) :- I = init(_, _, _), stmts_allocs_inits_execs(Ss, As, Is, Es). stmts_allocs_inits_execs([E|Ss], As, Is, [E|Es]) :- dif(E, alloc(_, _, _)), dif(E, _Label:alloc(_, _, _)), dif(E, init(_, _, _)), stmts_allocs_inits_execs(Ss, As, Is, Es). declarations_funcdefs([], []). declarations_funcdefs([Func|Ds], [Func|Defs]) :- Func = func(_,_,_), declarations_funcdefs(Ds, Defs). declarations_funcdefs([D|Ds], Defs) :- dif(D, func(_,_,_)), declarations_funcdefs(Ds, Defs). declarations_inits([], []). declarations_inits([Init|Ds], [Init|Defs]) :- Init = init(_,_,_), declarations_inits(Ds, Defs). declarations_inits([D|Ds], Defs) :- dif(D, store(_,_)), dif(D, init(_,_,_)), declarations_inits(Ds, Defs). declarations_allocs([], []). declarations_allocs([A|Ds], [A|As]) :- A = alloc(_,_,_), declarations_allocs(Ds, As). declarations_allocs([D|Ds], As) :- dif(D, alloc(_,_,_)), declarations_allocs(Ds, As). % label_body(Body, Label, LabeledBody) label_body(Body, Label, Label:Body) :- Body = scope(_,_,_). label_body([L:B|Bs], Label, [Label:B|Bs]) :- L = Label. label_body([B|Bs], Label, [Label:B|Bs]) :- B \= _:_. alf_offset(Num, dec_unsigned(PtrSize, Num)) :- ptrsize(PtrSize). alf_bit(Num, dec_unsigned(1, Num)). % GB (2009-01-21): Ignoring the Type argument now! It used to be used to % compute Size, which I took to be the size of the frame. However, I now % think that it's supposed to be the size of the fref, so Size is now % unified with PtrSize. alf_varref(Name, _Type, addr(PtrSize, fref(Size, Name), Offset)) :- % type_bitsize(Type, Size), Size = PtrSize, ptrsize(PtrSize), alf_offset(0, Offset). alf_funcref(Name, label(LabelSize, lref(PtrSize, Name), Offset)) :- labelsize(LabelSize), ptrsize(PtrSize), alf_offset(0, Offset). alf_label(label(LabelSize, lref(PtrSize, _Label), Offset)) :- labelsize(LabelSize), ptrsize(PtrSize), alf_offset(0, Offset). alflabel_name(label(_LabelSize, lref(_PtrSize, Label), _Offset), Label). % pointer_basetype_dereferenced(+PtrVal, +Type, -LoadExp): PtrVal is an ALF % expression that evaluates to an address; LoadExp is an expression that % refers to the object of type Type at that address. In other words, this % wraps a pseudo-load around PtrVal. pointer_basetype_dereferenced(PtrVal, Type, LoadExp) :- type_bitsize(Type, Size), LoadExp = alf_varref_with_size(Size, PtrVal). % alf_binop(Functor, Size, LHS, RHS, Result). % Integer comparisons alf_binop(Comparison, Size, LHS, RHS, Term) :- member(Comparison, [eq, neq, u_lt, u_ge, u_gt, u_le, s_lt, s_ge, s_gt, s_le]), Term =.. [Comparison, Size, LHS, RHS]. % Floating-point comparisons alf_binop(Comparison, Exp:Mant, LHS, RHS, Term) :- member(Comparison, [f_eq, f_ne, f_lt, f_ge, f_gt, f_le]), Term =.. [Comparison, Exp, Mant, LHS, RHS]. % add, sub, u_mul, s_mul, u_div, s_div % Pretty much any operation has some weird property. Addition and % subtraction need a carry-in (always 0 when translating from C), % multiplication and division have two size parameters, one for each % operand. Multiplication must also be truncated. alf_binop(add, Size, LHS, RHS, add(Size, LHS, RHS, CarryIn)) :- alf_bit(0, CarryIn). alf_binop(sub, Size, LHS, RHS, sub(Size, LHS, RHS, CarryIn)) :- alf_bit(1, CarryIn). alf_binop(u_mul, Size, LHS, RHS, UMul) :- Size2 is 2 * Size, SizeMin1 is Size - 1, UMul = select(Size2, 0, SizeMin1, u_mul(Size, Size, LHS, RHS)). alf_binop(s_mul, Size, LHS, RHS, SMul) :- Size2 is 2 * Size, SizeMin1 is Size - 1, SMul = select(Size2, 0, SizeMin1, s_mul(Size, Size, LHS, RHS)). % Integer division operators. These have two size parameters; when % translating from C, we use the same size for both (because C forces both % operands to the same type, at least that's what I think). alf_binop(Functor, Size, LHS, RHS, Term) :- member(Functor, [u_div, s_div, u_mod, s_mod]), Term =.. [Functor, Size, Size, LHS, RHS]. % Floating-point arithmetic: add, sub, mul, div alf_binop(Functor, Exp:Mant, LHS, RHS, Term) :- member(Functor, [f_add, f_sub, f_mul, f_div]), Term =.. [Functor, Exp, Mant, LHS, RHS]. % Bitwise operators: and, or, xor. alf_binop(Functor, Size, LHS, RHS, Term) :- member(Functor, [and, or, xor]), Term =.. [Functor, Size, LHS, RHS]. % Bitwise operators: shifts. These have a second size operand. alf_binop(Functor, Size, LHS, RHS, Term) :- member(Functor, [l_shift, r_shift, r_shift_a]), alfexpr_size(RHS, RhsSize), Term =.. [Functor, Size, RhsSize, LHS, RHS]. % For loop conditions, ROSE does not always introduce comparisons against 0. % So we must do that here. condition_bitexp(BitExp, BitExp) :- alfexpr_size(BitExp, 1), !. condition_bitexp(dec_signed(_Size, Value), BitExp) :- !, ( Value = 0 -> alf_bit(0, BitExp) ; alf_bit(1, BitExp) ). condition_bitexp(conc(_,_,_, Exp), BitExp) :- !, condition_bitexp(Exp, BitExp). condition_bitexp(if(Size, dec_signed(Size, Value), True, False), BitExp) :- ( Value = 0 -> condition_bitexp(False, BitExp) ; condition_bitexp(True, BitExp) ). condition_bitexp(Cond, _) :- log_error('* unsupported condition expression: ~w~n', [Cond]), !. address_offset_fieldaddress(Addr, Offset, FieldAddress) :- Addr = addr(PtrSize, Base, OldOffset), OldOffset =.. [Functor, OffsetSize, OldOffsetVal], NewOffsetVal is OldOffsetVal + Offset, NewOffset =.. [Functor, OffsetSize, NewOffsetVal], FieldAddress = addr(PtrSize, Base, NewOffset). address_offset_fieldaddress(Addr, Offset, FieldAddress) :- Addr \= addr(_, _, _), % Addr is not an explicit constant address; for instance, it may be a load % expression that evaluates to an address. So we have to generate an % addition. ptrsize(PtrSize), OffsetExp = dec_unsigned(PtrSize, Offset), alf_bit(0, CarryIn), FieldAddress = add(PtrSize, Addr, OffsetExp, CarryIn). make_global(ImportExports, Allocs, Inits, Funcs, Result) :- Defs = macro_defs([]), % FIXME: Get Lau from the config file. But when you do that, also grep for % all occurrences of the constant 8 in the source code and replace them. Lau = least_addr_unit(8), endianness(Endian), alf_import_exports(ImportExports, ExFs, ExLs, ImFs, ImLs), Exports = exports(frefs(ExFs), lrefs(ExLs)), Imports = imports(frefs(ImFs), lrefs(ImLs)), Decls = decls(Allocs), Result = alf(Defs, Lau, Endian, Exports, Imports, Decls, Inits, Funcs). % private alf_import_exports([], [], [], [], []). alf_import_exports([export(F)|Gs], [F|EFs], ELs, IFs, ILs) :- F = fref(_FrefSize, _Name), alf_import_exports(Gs, EFs, ELs, IFs, ILs). alf_import_exports([export(L)|Gs], EFs, [L|ELs], IFs, ILs) :- L = lref(_LrefSize, _Name), alf_import_exports(Gs, EFs, ELs, IFs, ILs). alf_import_exports([import(F)|Gs], EFs, ELs, [F|IFs], ILs) :- F = fref(_FrefSize, _Name), alf_import_exports(Gs, EFs, ELs, IFs, ILs). alf_import_exports([import(L)|Gs], EFs, ELs, IFs, [L|ILs]) :- L = lref(_LrefSize, _Name), alf_import_exports(Gs, EFs, ELs, IFs, ILs). alf_import_exports([A|Gs], EFs, ELs, IFs, ILs) :- A = alloc(_FrefSize, _Name, _Size), alf_import_exports(Gs, EFs, ELs, IFs, ILs). :- dynamic string_address_fact/2. % string_address(+String, -Address): Address is an ALF address expression of % the form addr(PtrSize, Fref, Offset) associated with a variable containing % String. There is an address for any string: If none has been recorded yet, % string_address generates one. Further occurrences of the same string (as % determined by unifiability) are associated with the same address. string_address(String, Address) :- string_address_fact(String, Address), !. string_address(String, Address) :- stringvarname(StringVarName), ptrsize(PtrSize), Fref = fref(PtrSize, StringVarName), alf_offset(0, Offset), Address = addr(PtrSize, Fref, Offset), assert(string_address_fact(String, Address)). % string_addresses(-StringAddressList): StringAddressList is a list of % pairs of the form String-Address containing all pairs that have been % recorded using string_address up to this point. string_addresses(StringAddressList) :- bagof(S-A, string_address_fact(S,A), StringAddressList), !. % bagof fails if it finds no solutions, so there is this alternative. string_addresses([]). % clear_string_addresses: Forget everything you know about strings and their % addresses. clear_string_addresses :- retractall(string_address_fact(_,_)), reset_gensym(alf_string_constant_). % private stringvarname(Name) :- gensym('alf_string_constant_', Name). % string_constant_declarations(+StringAddresses, -DeclsAndInits): % StringAddresses is a list of String-Address pairs, DeclsAndInits is a list % of corresponding alloc and init statements. string_constant_declarations([], []). string_constant_declarations([S-A|SAs], [Alloc, Init | AIs]) :- ptrsize(PtrSize), A = addr(_, fref(PtrSize, Name), Offset), string_length(S, Length), % Length is the length of the string's contents, but we also need a byte % for the null terminator. StringSize is (Length + 1) * 8, Alloc = alloc(PtrSize, Name, StringSize), Ref = ref(Name, Offset), Init = init(Ref, char_string(S), read_only), string_constant_declarations(SAs, AIs). % FIXME: This is ugly, dangerous, and wrong in some cases (select)! alfexpr_size(select(_, Min, Max, _), Size) :- !, Size is Max - Min + 1. alfexpr_size(conc(A, B, _, _), Size) :- !, Size is A + B. alfexpr_size(s_ext(_, Size, _), Size) :- !. alfexpr_size(float_val(Exp, Frac, _), Size) :- !, Size is Exp + Frac + 1. alfexpr_size(CmpExpr, 1) :- CmpExpr =.. [Functor, _OperandSize, _L, _R], member(Functor, [eq, neq, u_lt, u_ge, u_gt, u_le, s_lt, s_ge, s_gt, s_le]), !. alfexpr_size(CmpExpr, 1) :- CmpExpr =.. [Functor, _ExpSize, _FracSize, _L, _R], member(Functor, [f_eq, f_ne, f_lt, f_ge, f_gt, f_le]), !. alfexpr_size(Expr, Size) :- Expr =.. [_Functor, Size | _]. alfterm_withoutmacrodefs(AlfTerm, StrippedAlfTerm) :- AlfTerm = alf(macro_defs(_Defs), L, Endi, Exp, Imp, Ds, Is, Fs), StrippedAlfTerm = alf(macro_defs([]), L, Endi, Exp, Imp, Ds, Is, Fs).