diff --git a/src/cil.ml b/src/cil.ml index 9e49a38ad..7e3bc0f4b 100755 --- a/src/cil.ml +++ b/src/cil.ml @@ -62,7 +62,7 @@ let cilVersionRevision = Cilversion.cilVersionRev let msvcMode = ref false (* Whether the pretty printer should * print output for the MS VC * compiler. Default is GCC *) -let c99Mode = ref false (* True to handle ISO C 99 vs 90 changes. +let c99Mode = ref true (* True to handle ISO C 99 vs 90 changes. (* TODO: This should be exposed *) So far only affects integer parsing. *) (* Set this to true to get old-style handling of gcc's extern inline C extension: @@ -292,6 +292,9 @@ and fkind = FFloat (** [float] *) | FDouble (** [double] *) | FLongDouble (** [long double] *) + | FComplexFloat + | FComplexDouble + | FComplexLongDouble (** An attribute has a name and some optional parameters *) and attribute = Attr of string * attrparam list @@ -1664,6 +1667,9 @@ let d_fkind () = function FFloat -> text "float" | FDouble -> text "double" | FLongDouble -> text "long double" + | FComplexFloat -> text "_Complex float" + | FComplexDouble -> text "_Complex double" + | FComplexLongDouble -> text "_Complex long double" let d_storage () = function NoStorage -> nil @@ -1751,7 +1757,10 @@ let d_const () c = (match fsize with FFloat -> chr 'f' | FDouble -> nil - | FLongDouble -> chr 'L') + | FLongDouble -> chr 'L' + | FComplexFloat -> text "iF" + | FComplexDouble -> chr 'i' + | FComplexLongDouble -> text "iL") | CEnum(_, s, ei) -> text s @@ -2154,6 +2163,9 @@ let rec alignOf_int t = | TFloat(FFloat, _) -> !M.theMachine.M.alignof_float | TFloat(FDouble, _) -> !M.theMachine.M.alignof_double | TFloat(FLongDouble, _) -> !M.theMachine.M.alignof_longdouble + | TFloat(FComplexFloat, _) -> !M.theMachine.M.alignof_float (* TODO! *) + | TFloat(FComplexDouble, _) -> !M.theMachine.M.alignof_double (* TODO! *) + | TFloat(FComplexLongDouble, _) -> !M.theMachine.M.alignof_longdouble (* TODO! *) | TNamed (t, _) -> alignOf_int t.ttype | TArray (t, _, _) -> alignOf_int t | TPtr _ | TBuiltin_va_list _ -> !M.theMachine.M.alignof_ptr @@ -2962,6 +2974,9 @@ let initGccBuiltins () : unit = H.add h "__builtin_ctzl" (intType, [ ulongType ], false); H.add h "__builtin_ctzll" (intType, [ ulongLongType ], false); + (* Do sth smart here, such as add a spurious cast to void *) + (* H.add h "__builtin_classify_type" (intType, [ voidType], false); *) + H.add h "__builtin_exp" (doubleType, [ doubleType ], false); H.add h "__builtin_expf" (floatType, [ floatType ], false); H.add h "__builtin_expl" (longDoubleType, [ longDoubleType ], false); @@ -3340,6 +3355,10 @@ class defaultCilPrinterClass : cilPrinter = object (self) (* variable declaration *) method pVDecl () (v:varinfo) = + (* These were treated as if they were functions but they are not *) + (* if v.vname = "__real__" || v.vname = "__imag__" then + nil + else *) let stom, rest = separateStorageModifiers v.vattr in (* First the storage modifiers *) text (if v.vinline then "__inline " else "") diff --git a/src/cil.mli b/src/cil.mli index c8c9676b7..99063af3f 100644 --- a/src/cil.mli +++ b/src/cil.mli @@ -293,7 +293,9 @@ and fkind = FFloat (** [float] *) | FDouble (** [double] *) | FLongDouble (** [long double] *) - + | FComplexFloat + | FComplexDouble + | FComplexLongDouble (** {b Attributes.} *) diff --git a/src/ext/llvm/llvmutils.ml b/src/ext/llvm/llvmutils.ml index 32585c735..2a4dec107 100644 --- a/src/ext/llvm/llvmutils.ml +++ b/src/ext/llvm/llvmutils.ml @@ -143,6 +143,9 @@ and gType (t:typ) : doc = match t with | TFloat (FFloat, _) -> text "float" | TFloat (FDouble, _) -> text "double" | TFloat (FLongDouble, _) -> text "fp128" +| TFloat (FComplexFloat, _) -> text "float" (* TODO: Incorrect *) +| TFloat (FComplexDouble, _) -> text "double" (* TODO: Incorrect *) +| TFloat (FComplexLongDouble, _) -> text "fp128" (* TODO: Incorrect *) | TPtr (t, _) -> (* LLVM uses "i8 *" for 'void *' *) if isVoidType t then text "i8 *" diff --git a/src/frontc/cabs.ml b/src/frontc/cabs.ml index 4865fe92a..16779e290 100644 --- a/src/frontc/cabs.ml +++ b/src/frontc/cabs.ml @@ -268,6 +268,8 @@ and expression = | CONSTANT of constant | PAREN of expression | VARIABLE of string + | REAL of expression + | IMAG of expression | EXPR_SIZEOF of expression | TYPE_SIZEOF of specifier * decl_type | EXPR_ALIGNOF of expression @@ -281,6 +283,7 @@ and expression = and constant = | CONST_INT of string (* the textual representation *) | CONST_FLOAT of string (* the textual representaton *) + | CONST_COMPLEX of string (* the textual representation *) | CONST_CHAR of int64 list | CONST_WCHAR of int64 list | CONST_STRING of string diff --git a/src/frontc/cabs2cil.ml b/src/frontc/cabs2cil.ml index 327948a2a..b6d2ffb9e 100644 --- a/src/frontc/cabs2cil.ml +++ b/src/frontc/cabs2cil.ml @@ -1256,11 +1256,17 @@ let arithmeticConversion (* c.f. ISO 6.3.1.8 *) (t2: typ) : typ = match unrollType t1, unrollType t2 with TFloat(FLongDouble, _), _ -> t1 + | TFloat(FComplexLongDouble, _), _ -> t1 | _, TFloat(FLongDouble, _) -> t2 + | _, TFloat(FComplexLongDouble, _) -> t2 | TFloat(FDouble, _), _ -> t1 + | TFloat(FComplexDouble, _), _ -> t1 | _, TFloat (FDouble, _) -> t2 + | _, TFloat (FComplexDouble, _) -> t2 | TFloat(FFloat, _), _ -> t1 + | TFloat(FComplexFloat, _), _ -> t1 | _, TFloat (FFloat, _) -> t2 + | _, TFloat (FComplexFloat, _) -> t2 | _, _ -> begin let t1' = integralPromotion t1 in let t2' = integralPromotion t2 in @@ -3446,11 +3452,10 @@ and doExp (asconst: bool) (* This expression is used as a constant *) finishExp se lv' field_type | A.CONSTANT ct -> begin - let hasSuffix str = + let hasSuffix str suffix = let l = String.length str in - fun s -> - let ls = String.length s in - l >= ls && s = String.uppercase_ascii (String.sub str (l - ls) ls) + let ls = String.length suffix in + l >= ls && String.uppercase_ascii suffix = String.uppercase_ascii (String.sub str (l - ls) ls) in match ct with A.CONST_INT str -> begin @@ -3533,13 +3538,12 @@ and doExp (asconst: bool) (* This expression is used as a constant *) | A.CONST_FLOAT str -> begin (* Maybe it ends in U or UL. Strip those *) let l = String.length str in - let hasSuffix = hasSuffix str in let baseint, kind = - if hasSuffix "L" then + if hasSuffix str "L" then String.sub str 0 (l - 1), FLongDouble - else if hasSuffix "F" then + else if hasSuffix str "F" then String.sub str 0 (l - 1), FFloat - else if hasSuffix "D" then + else if hasSuffix str "D" then String.sub str 0 (l - 1), FDouble else str, FDouble @@ -3561,6 +3565,36 @@ and doExp (asconst: bool) (* This expression is used as a constant *) finishExp empty res (typeOf res) end end + | A.CONST_COMPLEX str -> begin + (* Maybe it ends in U or UL. Strip those *) + let l = String.length str in + let baseint, kind = + if hasSuffix str "iL" then + String.sub str 0 (l - 2), FComplexLongDouble + else if hasSuffix str "iF" then + String.sub str 0 (l - 2), FComplexFloat + else if hasSuffix str "iD" then + String.sub str 0 (l - 2), FComplexDouble + else + str, FComplexDouble (* this is not ok *) + in + if kind = FLongDouble then + (* We only have 64-bit values in Ocaml *) + E.log "treating long double constant %s as double constant at %a.\n" + str d_loc !currentLoc; + try + finishExp empty + (Const(CReal(float_of_string baseint, kind, + Some str))) + (TFloat(kind,[])) + with e -> begin + ignore (E.log "float_of_string_2 %s (%s)\n" baseint + (Printexc.to_string e)); + E.hadErrors := true; + let res = Const(CStr "booo CONS_FLOAT") in + finishExp empty res (typeOf res) + end + end end | A.TYPE_SIZEOF (bt, dt) -> diff --git a/src/frontc/clexer.mll b/src/frontc/clexer.mll index e94a8d0be..51837997f 100644 --- a/src/frontc/clexer.mll +++ b/src/frontc/clexer.mll @@ -184,7 +184,8 @@ let init_lexicon _ = ("__alignof__", fun loc -> ALIGNOF loc); ("__volatile__", fun loc -> VOLATILE loc); ("__volatile", fun loc -> VOLATILE loc); - + ("__real__", fun loc -> REAL loc); + ("__imag__", fun loc -> IMAG loc); ("__FUNCTION__", fun loc -> FUNCTION__ loc); ("__func__", fun loc -> FUNCTION__ loc); (* ISO 6.4.2.2 *) ("__PRETTY_FUNCTION__", fun loc -> PRETTY_FUNCTION__ loc); @@ -436,6 +437,9 @@ let hexfloat = hexprefix hexfraction binexponent let floatsuffix = ['f' 'F' 'l' 'L'] let floatnum = (decfloat | hexfloat) floatsuffix? +let complexnum = (decfloat | hexfloat) ['i' 'I'] floatsuffix + + let ident = (letter|'_'|'$')(letter|decdigit|'_'|'$')* let blank = [' ' '\t' '\012' '\r']+ let escape = '\\' _ @@ -502,6 +506,7 @@ rule initial = ("wide string: " ^ Printexc.to_string e))} | floatnum {CST_FLOAT (Lexing.lexeme lexbuf, currentLoc ())} +| complexnum {CST_COMPLEX (Lexing.lexeme lexbuf, currentLoc ())} | hexnum {CST_INT (Lexing.lexeme lexbuf, currentLoc ())} | octnum {CST_INT (Lexing.lexeme lexbuf, currentLoc ())} | intnum {CST_INT (Lexing.lexeme lexbuf, currentLoc ())} diff --git a/src/frontc/cparser.mly b/src/frontc/cparser.mly index 635782065..672b1b903 100644 --- a/src/frontc/cparser.mly +++ b/src/frontc/cparser.mly @@ -246,6 +246,7 @@ let transformOffsetOf (speclist, dtype) member = %token CST_WCHAR %token CST_INT %token CST_FLOAT +%token CST_COMPLEX %token NAMED_TYPE /* Each character is its own list element, and the terminating nul is not @@ -291,7 +292,7 @@ let transformOffsetOf (speclist, dtype) member = %token IF TRY EXCEPT FINALLY %token ELSE -%token ATTRIBUTE INLINE ASM TYPEOF FUNCTION__ PRETTY_FUNCTION__ +%token ATTRIBUTE INLINE ASM TYPEOF REAL IMAG FUNCTION__ PRETTY_FUNCTION__ %token LABEL__ %token BUILTIN_VA_ARG ATTRIBUTE_USED %token BUILTIN_VA_LIST @@ -326,7 +327,7 @@ let transformOffsetOf (speclist, dtype) member = %left INF_INF SUP_SUP %left PLUS MINUS %left STAR SLASH PERCENT CONST RESTRICT VOLATILE COMPLEX HIDDEN -%right EXCLAM TILDE PLUS_PLUS MINUS_MINUS CAST RPAREN ADDROF SIZEOF ALIGNOF +%right EXCLAM TILDE PLUS_PLUS MINUS_MINUS CAST RPAREN ADDROF SIZEOF ALIGNOF IMAG REAL %left LBRACKET %left DOT ARROW LPAREN LBRACE %right NAMED_TYPE /* We'll use this to handle redefinitions of @@ -527,6 +528,10 @@ unary_expression: /*(* 6.5.3 *)*/ {EXPR_SIZEOF (fst $2), $1} | SIZEOF LPAREN type_name RPAREN {let b, d = $3 in TYPE_SIZEOF (b, d), $1} +| REAL cast_expression + {REAL (fst $2), $1} +| IMAG cast_expression + {IMAG (fst $2), $1} | ALIGNOF unary_expression {EXPR_ALIGNOF (fst $2), $1} | ALIGNOF LPAREN type_name RPAREN @@ -687,6 +692,7 @@ expression: /*(* 6.5.17 *)*/ constant: CST_INT {CONST_INT (fst $1), snd $1} | CST_FLOAT {CONST_FLOAT (fst $1), snd $1} +| CST_COMPLEX {CONST_COMPLEX (fst $1), snd $1} | CST_CHAR {CONST_CHAR (fst $1), snd $1} | CST_WCHAR {CONST_WCHAR (fst $1), snd $1} | string_constant {CONST_STRING (fst $1), snd $1} @@ -1405,7 +1411,9 @@ postfix_attr: * that their arguments be expressions, not attributes *)*/ unary_attr: postfix_attr { $1 } -| SIZEOF unary_expression {EXPR_SIZEOF (fst $2) } +| SIZEOF unary_expression { EXPR_SIZEOF (fst $2) } +| REAL unary_expression { REAL (fst $2) } +| IMAG unary_expression { IMAG (fst $2) } | SIZEOF LPAREN type_name RPAREN {let b, d = $3 in TYPE_SIZEOF (b, d)} diff --git a/src/frontc/cprint.ml b/src/frontc/cprint.ml index 79325b61d..3b76f323c 100644 --- a/src/frontc/cprint.ml +++ b/src/frontc/cprint.ml @@ -507,6 +507,7 @@ and print_expression_level (lvl: int) (exp : expression) = (match cst with CONST_INT i -> print i | CONST_FLOAT r -> print r + | CONST_COMPLEX r -> print r | CONST_CHAR c -> print ("'" ^ escape_wstring c ^ "'") | CONST_WCHAR c -> print ("L'" ^ escape_wstring c ^ "'") | CONST_STRING s -> print_string s