diff options
| -rw-r--r-- | evaluation.adb | 95 | ||||
| -rw-r--r-- | libraries/Makefile.inc | 4 | ||||
| -rw-r--r-- | ortho/gcc/ortho-lang.c | 1 | ||||
| -rw-r--r-- | parse.adb | 8 | ||||
| -rw-r--r-- | sem_names.adb | 13 | ||||
| -rw-r--r-- | sem_stmts.adb | 1 |
6 files changed, 121 insertions, 1 deletions
diff --git a/evaluation.adb b/evaluation.adb index 16dcb14..3dd7631 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -1240,6 +1240,99 @@ package body Evaluation is return Build_String (Id, Int32 (Img'Last - L), Orig); end Eval_Integer_Image; + function Eval_Floating_Image (Val : Iir_Fp64; Orig : Iir) return Iir + is + use Str_Table; + Id : String_Id; + + -- Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1) + -- + exp_digits (4) -> 24. + Str : String (1 .. 25); + P : Natural; + V : Iir_Fp64; + Vd : Iir_Fp64; + Exp : Integer; + D : Integer; + B : Boolean; + begin + -- Handle sign. + if Val < 0.0 then + Str (1) := '-'; + P := 1; + V := -Val; + else + P := 0; + V := Val; + end if; + + -- Compute the mantissa. + -- FIXME: should do a dichotomy. + if V = 0.0 then + Exp := 0; + elsif V < 1.0 then + Exp := -1; + while V * (10.0 ** (-Exp)) < 1.0 loop + Exp := Exp - 1; + end loop; + else + Exp := 0; + while V / (10.0 ** Exp) >= 10.0 loop + Exp := Exp + 1; + end loop; + end if; + + -- Normalize VAL: in [0; 10[ + if Exp >= 0 then + V := V / (10.0 ** Exp); + else + V := V * 10.0 ** (-Exp); + end if; + + for I in 0 .. 15 loop + Vd := Iir_Fp64'Truncation (V); + P := P + 1; + Str (P) := Character'Val (48 + Integer (Vd)); + V := (V - Vd) * 10.0; + + if I = 0 then + P := P + 1; + Str (P) := '.'; + end if; + exit when I > 0 and V < 10.0 ** (I + 1 - 15); + end loop; + + if Exp /= 0 then + -- LRM93 14.3 + -- if the exponent is present, the `e' is written as a lower case + -- character. + P := P + 1; + Str (P) := 'e'; + + if Exp < 0 then + P := P + 1; + Str (P) := '-'; + Exp := -Exp; + end if; + B := False; + for I in 0 .. 4 loop + D := (Exp / 10000) mod 10; + if D /= 0 or B or I = 4 then + P := P + 1; + Str (P) := Character'Val (48 + D); + B := True; + end if; + Exp := (Exp - D * 10000) * 10; + end loop; + end if; + + Id := Start; + for I in 1 .. P loop + Append (Str (I)); + end loop; + Finish; + return Build_String (Id, Int32 (P), Orig); + end Eval_Floating_Image; + function Eval_Incdec (Expr : Iir; N : Iir_Int64) return Iir is P : Iir_Int64; @@ -1511,6 +1604,8 @@ package body Evaluation is case Get_Kind (Param_Type) is when Iir_Kind_Integer_Type_Definition => return Eval_Integer_Image (Get_Value (Param), Expr); + when Iir_Kind_Floating_Type_Definition => + return Eval_Floating_Image (Get_Fp_Value (Param), Expr); when others => Error_Kind ("eval_static_expr('image)", Param_Type); end case; diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc index e1557c6..e32da22 100644 --- a/libraries/Makefile.inc +++ b/libraries/Makefile.inc @@ -24,6 +24,7 @@ # ANALYZE # LN # CP +# VHDLLIBS_COPY_OBJS # # Note: the source files are analyzed in the LIBxx_DIR. So LIBSRC_DIR must be # relative to the target directory. @@ -110,6 +111,7 @@ synopsys.v93: $(LIB93_DIR) $(SYNOPSYS_SRCS) force mkdir $(SYN93_DIR) prev=`pwd`; cd $(SYN93_DIR); \ $(CP) ../ieee/ieee-obj93.cf .; \ + test x$(VHDLLIBS_COPY_OBJS) = "xno" || \ for i in $(IEEE_SRCS) $(VITAL2000_SRCS); do \ b=`basename $$i .vhdl`; $(LN) ../ieee/$$b.o $$b.o || exit 1; \ done; \ @@ -124,6 +126,7 @@ mentor.v93: $(LIB93_DIR) $(MENTOR93_SRCS) force mkdir $(MENTOR93_DIR) prev=`pwd`; cd $(MENTOR93_DIR); \ $(CP) ../ieee/ieee-obj93.cf . ;\ + test x$(VHDLLIBS_COPY_OBJS) = "xno" || \ for i in $(IEEE_SRCS) $(VITAL2000_SRCS); do \ b=`basename $$i .vhdl`; $(LN) ../ieee/$$b.o $$b.o || exit 1; \ done ; \ @@ -159,6 +162,7 @@ synopsys.v87: $(LIB87_DIR) $(SYNOPSYS_SRCS) force mkdir $(SYN87_DIR) prev=`pwd`; cd $(SYN87_DIR); \ $(CP) ../ieee/ieee-obj87.cf . ; \ + test x$(VHDLLIBS_COPY_OBJS) = "xno" || \ for i in $(IEEE_SRCS) $(VITAL95_SRCS); do \ b=`basename $$i .vhdl`; $(LN) ../ieee/$$b.o $$b.o || exit 1; \ done; \ diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c index c024558..613f225 100644 --- a/ortho/gcc/ortho-lang.c +++ b/ortho/gcc/ortho-lang.c @@ -1556,6 +1556,7 @@ finish_const_value (tree *cst, tree val) { DECL_INITIAL (*cst) = val; TREE_CONSTANT (val) = 1; + TREE_STATIC (*cst) = 1; rest_of_decl_compilation (*cst, current_function_decl == NULL_TREE, 0); } @@ -2782,6 +2782,14 @@ package body Parse is return A_Choice; else Expr1 := Parse_Expression; + + if Expr1 = Null_Iir then + -- Handle parse error now. + -- FIXME: skip until '=>'. + A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression); + Set_Location (A_Choice); + return A_Choice; + end if; end if; else Expr1 := Expr; diff --git a/sem_names.adb b/sem_names.adb index 10df0d4..9d19bfc 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -55,7 +55,17 @@ package body Sem_Names is for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; - Error_Msg_Sem (Disp_Subprg (El), El); + case Get_Kind (El) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + Error_Msg_Sem (Disp_Subprg (El), El); + when Iir_Kind_Function_Call => + Error_Msg_Sem (Disp_Subprg (Get_Implementation (El)), El); + when others => + Error_Msg_Sem (Disp_Node (El), El); + end case; end loop; end Disp_Overload_List; @@ -3114,6 +3124,7 @@ package body Sem_Names is return Null_Iir; elsif Is_Overload_List (Res) then Error_Overload (Name); + Disp_Overload_List (Get_Overload_List (Res), Name); return Null_Iir; else Sem_Name_Free_Result (Expr, Res); diff --git a/sem_stmts.adb b/sem_stmts.adb index 4357065..14fabde 100644 --- a/sem_stmts.adb +++ b/sem_stmts.adb @@ -756,6 +756,7 @@ package body Sem_Stmts is if Expr /= Null_Iir then Expr := Sem_Expression (Expr, String_Type_Definition); Check_Read (Expr); + -- Expr := Eval_Expr_If_Static (Expr); Set_Report_Expression (Stmt, Expr); end if; |