diff options
| author | Tristan Gingold <gingold@adacore.com> | 2015-12-16 09:38:00 +0100 |
|---|---|---|
| committer | Tristan Gingold <gingold@adacore.com> | 2015-12-18 17:16:27 +0100 |
| commit | e8a965f0f42749f7fbcaaee966e24a55fb45d886 (patch) | |
| tree | 448d507f7074f78e80dd4afe5b983609a08396ca | |
| parent | 4680da5edb910910c4a31438798bff0bc6e51380 (diff) | |
| download | ghdl-e8a965f0f42749f7fbcaaee966e24a55fb45d886.tar.gz ghdl-e8a965f0f42749f7fbcaaee966e24a55fb45d886.tar.bz2 ghdl-e8a965f0f42749f7fbcaaee966e24a55fb45d886.zip | |
Pass signal values to interfaces. 'sigptr' optimization.
Improve simulation speed by about 20%.
29 files changed, 1704 insertions, 1293 deletions
diff --git a/src/grt/config/win32thr.c b/src/grt/config/win32thr.c deleted file mode 100644 index bcebc49d5..000000000 --- a/src/grt/config/win32thr.c +++ /dev/null @@ -1,167 +0,0 @@ -/* GRT stack implementation for Win32 - Copyright (C) 2004, 2005 Felix Bertram. - - GHDL is free software; you can redistribute it and/or modify it under - the terms of the GNU General Public License as published by the Free - Software Foundation; either version 2, or (at your option) any later - version. - - GHDL is distributed in the hope that it will be useful, but WITHOUT ANY - WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License - for more details. - - You should have received a copy of the GNU General Public License - along with GCC; see the file COPYING. If not, write to the Free - Software Foundation, 59 Temple Place - Suite 330, Boston, MA - 02111-1307, USA. -*/ -//----------------------------------------------------------------------------- -// Project: GHDL - VHDL Simulator -// Description: Win32 port of stacks package -// Note: Tristan's original i386/Linux used assembly-code -// to manually switch stacks for performance reasons. -// History: 2004feb09, FB, created. -//----------------------------------------------------------------------------- - -#include <windows.h> -//#include <pthread.h> -//#include <stdlib.h> -//#include <stdio.h> - - -//#define INFO printf -#define INFO (void) - -// GHDL names an endless loop calling FUNC with ARG a 'stack' -// at a given time, only one stack may be 'executed' -typedef struct -{ HANDLE thread; // stack's thread - HANDLE mutex; // mutex to suspend/resume thread - void (*Func)(void*); // stack's FUNC - void* Arg; // ARG passed to FUNC -} Stack_Type_t, *Stack_Type; - - -static Stack_Type_t main_stack_context; -extern void grt_set_main_stack (Stack_Type_t *stack); - -//------------------------------------------------------------------------------ -void grt_stack_init(void) -// Initialize the stacks package. -// This may adjust stack sizes. -// Must be called after grt.options.decode. -// => procedure Stack_Init; -{ INFO("grt_stack_init\n"); - INFO(" main_stack_context=0x%08x\n", &main_stack_context); - - // create event. reset event, as we are currently running - main_stack_context.mutex = CreateEvent(NULL, // lpsa - FALSE, // fManualReset - FALSE, // fInitialState - NULL); // lpszEventName - - grt_set_main_stack (&main_stack_context); -} - -//------------------------------------------------------------------------------ -static unsigned long __stdcall grt_stack_loop(void* pv_myStack) -{ - Stack_Type myStack= (Stack_Type)pv_myStack; - - INFO("grt_stack_loop\n"); - - INFO(" myStack=0x%08x\n", myStack); - - // block until event becomes set again. - // this happens when this stack is enabled for the first time - WaitForSingleObject(myStack->mutex, INFINITE); - - // run stack's function in endless loop - while(1) - { INFO(" call 0x%08x with 0x%08x\n", myStack->Func, myStack->Arg); - myStack->Func(myStack->Arg); - } - - // we never get here... - return 0; -} - -//------------------------------------------------------------------------------ -Stack_Type grt_stack_create(void* Func, void* Arg) -// Create a new stack, which on first execution will call FUNC with -// an argument ARG. -// => function Stack_Create (Func : Address; Arg : Address) return Stack_Type; -{ Stack_Type newStack; - DWORD m_IDThread; // Thread's ID (dummy) - - INFO("grt_stack_create\n"); - INFO(" call 0x%08x with 0x%08x\n", Func, Arg); - - newStack= malloc(sizeof(Stack_Type_t)); - - // init function and argument - newStack->Func= Func; - newStack->Arg= Arg; - - // create event. reset event, so that thread will blocked in grt_stack_loop - newStack->mutex= CreateEvent(NULL, // lpsa - FALSE, // fManualReset - FALSE, // fInitialState - NULL); // lpszEventName - - INFO(" newStack=0x%08x\n", newStack); - - // create thread, which executes grt_stack_loop - newStack->thread= CreateThread(NULL, // lpsa - 0, // cbStack - grt_stack_loop, // lpStartAddr - newStack, // lpvThreadParm - 0, // fdwCreate - &m_IDThread); // lpIDThread - - return newStack; -} - -//------------------------------------------------------------------------------ -void grt_stack_switch(Stack_Type To, Stack_Type From) -// Resume stack TO and save the current context to the stack pointed by -// CUR. -// => procedure Stack_Switch (To : Stack_Type; From : Stack_Type); -{ INFO("grt_stack_switch\n"); - INFO(" from 0x%08x to 0x%08x\n", From, To); - - // set 'To' event. this will make the other thread either - // - start for first time in grt_stack_loop - // - resume at WaitForSingleObject below - SetEvent(To->mutex); - - // block until 'From' event becomes set again - // as we are running, our event is reset and we block here - // when stacks are switched, with above SetEvent, we may proceed - WaitForSingleObject(From->mutex, INFINITE); -} - -//------------------------------------------------------------------------------ -void grt_stack_delete(Stack_Type Stack) -// Delete stack STACK, which must not be currently executed. -// => procedure Stack_Delete (Stack : Stack_Type); -{ INFO("grt_stack_delete\n"); -} - -//---------------------------------------------------------------------------- -#ifndef WITH_GNAT_RUN_TIME -void __gnat_raise_storage_error(void) -{ - abort (); -} - -void __gnat_raise_program_error(void) -{ - abort (); -} -#endif - -//---------------------------------------------------------------------------- -// end of file - diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb index bf9db80ba..93787edb2 100644 --- a/src/grt/grt-disp_rti.adb +++ b/src/grt/grt-disp_rti.adb @@ -26,6 +26,7 @@ with Grt.Astdio; use Grt.Astdio; with Grt.Errors; use Grt.Errors; with Grt.Hooks; use Grt.Hooks; with Grt.Rtis_Utils; use Grt.Rtis_Utils; +with Grt.Signals; package body Grt.Disp_Rti is procedure Disp_Kind (Kind : Ghdl_Rtik); @@ -57,7 +58,11 @@ package body Grt.Disp_Rti is Sz : Ghdl_Index_Type; begin if Is_Sig then - Val := To_Ghdl_Value_Ptr (To_Addr_Acc (Addr).all); + -- ADDR is the address of the object. + -- The object contains a pointer to the signal. + -- The first field of the signal is a pointer to the value. + Val := Grt.Signals.To_Ghdl_Signal_Ptr + (To_Addr_Acc (Addr).all).Value_Ptr; Sz := Address'Size / Storage_Unit; else Val := To_Ghdl_Value_Ptr (Addr); diff --git a/src/grt/grt-disp_signals.adb b/src/grt/grt-disp_signals.adb index 684a4548c..265ca7b2c 100644 --- a/src/grt/grt-disp_signals.adb +++ b/src/grt/grt-disp_signals.adb @@ -200,11 +200,15 @@ package body Grt.Disp_Signals is Put_Time (stdout, Sig.Last_Active); end if; Put (" val="); - if Sig_Type /= null then - Disp_Value (stdout, Sig.Value, Sig_Type); - else - Disp_Value (Sig.Value, Sig.Mode); - end if; + declare + Val : constant Value_Union := Read_Value (Sig.Value_Ptr, Sig.Mode); + begin + if Sig_Type /= null then + Disp_Value (stdout, Val, Sig_Type); + else + Disp_Value (Val, Sig.Mode); + end if; + end; Put ("; drv="); if Sig_Type /= null then Disp_Value (stdout, Sig.Driving_Value, Sig_Type); diff --git a/src/grt/grt-fst.adb b/src/grt/grt-fst.adb index a87a4e1ef..9152a29b8 100644 --- a/src/grt/grt-fst.adb +++ b/src/grt/grt-fst.adb @@ -546,7 +546,7 @@ package body Grt.Fst is Str : Std_String_Uncons (0 .. Len - 1); begin for I in Str'Range loop - Str (I) := From_Bit (Sig (I).Value.B1); + Str (I) := From_Bit (Sig (I).Value_Ptr.B1); end loop; fstWriterEmitValueChange (Context, Hand, Str'Address); end; @@ -556,12 +556,12 @@ package body Grt.Fst is Str : Std_String_Uncons (0 .. Len - 1); begin for I in Str'Range loop - Str (I) := From_Std (Sig (I).Value.E8); + Str (I) := From_Std (Sig (I).Value_Ptr.E8); end loop; fstWriterEmitValueChange (Context, Hand, Str'Address); end; when Vcd_Integer32 => - Fst_Put_Integer32 (Hand, Sig (0).Value.E32); + Fst_Put_Integer32 (Hand, Sig (0).Value_Ptr.E32); when Vcd_Float64 => null; when Vcd_Bad => diff --git a/src/grt/grt-signals.adb b/src/grt/grt-signals.adb index b86e23466..23f0eec36 100644 --- a/src/grt/grt-signals.adb +++ b/src/grt/grt-signals.adb @@ -87,9 +87,47 @@ package body Grt.Signals is end case; end Assign; + function Read_Value (Value_Ptr : Ghdl_Value_Ptr; Mode : Mode_Type) + return Value_Union is + begin + case Mode is + when Mode_B1 => + return (Mode => Mode_B1, B1 => Value_Ptr.B1); + when Mode_E8 => + return (Mode => Mode_E8, E8 => Value_Ptr.E8); + when Mode_E32 => + return (Mode => Mode_E32, E32 => Value_Ptr.E32); + when Mode_I32 => + return (Mode => Mode_I32, I32 => Value_Ptr.I32); + when Mode_I64 => + return (Mode => Mode_I64, I64 => Value_Ptr.I64); + when Mode_F64 => + return (Mode => Mode_F64, F64 => Value_Ptr.F64); + end case; + end Read_Value; + -- For direct drivers, only a pointer is available and it may not be -- aligned. Hence this version of Assign. procedure Assign + (Targ : Ghdl_Value_Ptr; Val : Ghdl_Value_Ptr; Mode : Mode_Type) is + begin + case Mode is + when Mode_B1 => + Targ.B1 := Val.B1; + when Mode_E8 => + Targ.E8 := Val.E8; + when Mode_E32 => + Targ.E32 := Val.E32; + when Mode_I32 => + Targ.I32 := Val.I32; + when Mode_I64 => + Targ.I64 := Val.I64; + when Mode_F64 => + Targ.F64 := Val.F64; + end case; + end Assign; + + procedure Assign (Targ : Ghdl_Value_Ptr; Val : Value_Union; Mode : Mode_Type) is begin case Mode is @@ -145,7 +183,7 @@ package body Grt.Signals is function Create_Signal (Mode : Mode_Type; - Init_Val : Value_Union; + Value_Ptr : Ghdl_Value_Ptr; Mode_Sig : Mode_Signal_Type; Resolv_Proc : Resolver_Acc; Resolv_Inst : System.Address) @@ -154,6 +192,7 @@ package body Grt.Signals is Res : Ghdl_Signal_Ptr; Resolv : Resolved_Signal_Acc; S : Ghdl_Signal_Data (Mode_Sig); + Init_Val : Value_Union; begin Sig_Table.Increment_Last; @@ -200,7 +239,8 @@ package body Grt.Signals is null; end case; - Res := new Ghdl_Signal'(Value => Init_Val, + Init_Val := Read_Value (Value_Ptr, Mode); + Res := new Ghdl_Signal'(Value_Ptr => Value_Ptr, Driving_Value => Init_Val, Last_Value => Init_Val, -- Note: use -Std_Time'last instead of @@ -254,7 +294,7 @@ package body Grt.Signals is procedure Ghdl_Signal_Init (Sig : Ghdl_Signal_Ptr; Val : Value_Union) is begin - Sig.Value := Val; + Assign (Sig.Value_Ptr, Val, Sig.Mode); Sig.Driving_Value := Val; Sig.Last_Value := Val; end Ghdl_Signal_Init; @@ -323,6 +363,8 @@ package body Grt.Signals is Trans : Transaction_Acc) return Boolean is + Proc : constant Process_Acc := Get_Current_Process; + type Size_T is mod 2**Standard'Address_Size; function Malloc (Size : Size_T) return Driver_Arr_Ptr; @@ -337,10 +379,7 @@ package body Grt.Signals is return Size_T (N * Driver_Fat_Array'Component_Size / System.Storage_Unit); end Size; - - Proc : Process_Acc; begin - Proc := Get_Current_Process; if Sign.S.Nbr_Drivers = 0 then Check_New_Source (Sign); Sign.S.Drivers := Malloc (Size (1)); @@ -371,7 +410,7 @@ package body Grt.Signals is Line => 0, Time => 0, Next => null, - Val => Sign.Value); + Val => Read_Value (Sign.Value_Ptr, Sign.Mode)); if Ghdl_Signal_Add_Driver (Sign, Trans) then Free (Trans); end if; @@ -388,7 +427,7 @@ package body Grt.Signals is Line => 0, Time => 0, Next => null, - Val => Sign.Value); + Val => Read_Value (Sign.Value_Ptr, Sign.Mode)); if Ghdl_Signal_Add_Driver (Sign, Trans) then Free (Trans); return; @@ -403,7 +442,7 @@ package body Grt.Signals is Trans.Next := Trans1; -- Initialize driver value. - Assign (Drv, Sign.Value, Sign.Mode); + Assign (Drv, Sign.Value_Ptr, Sign.Mode); end Ghdl_Signal_Add_Direct_Driver; procedure Append_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr) @@ -916,21 +955,19 @@ package body Grt.Signals is procedure Ghdl_Signal_Associate (Sig : Ghdl_Signal_Ptr; Val : Value_Union) is begin - Sig.Value := Val; + Assign (Sig.Value_Ptr, Val, Sig.Mode); Sig.Driving_Value := Val; end Ghdl_Signal_Associate; function Ghdl_Create_Signal_B1 - (Init_Val : Ghdl_B1; + (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal - (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); + (Mode_B1, Val_Ptr, Get_Current_Mode_Signal, Resolv_Func, Resolv_Inst); end Ghdl_Create_Signal_B1; procedure Ghdl_Signal_Init_B1 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B1) is @@ -950,7 +987,7 @@ package body Grt.Signals is begin if not Sign.Has_Active and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.B1 + and then Val = Sign.Value_Ptr.B1 and then Sign.S.Drivers (0).First_Trans.Next = null then return; @@ -992,16 +1029,14 @@ package body Grt.Signals is end Ghdl_Signal_Next_Assign_B1; function Ghdl_Create_Signal_E8 - (Init_Val : Ghdl_E8; + (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal - (Mode_E8, Value_Union'(Mode => Mode_E8, E8 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); + (Mode_E8, Val_Ptr, Get_Current_Mode_Signal, Resolv_Func, Resolv_Inst); end Ghdl_Create_Signal_E8; procedure Ghdl_Signal_Init_E8 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E8) is @@ -1021,7 +1056,7 @@ package body Grt.Signals is begin if not Sign.Has_Active and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.E8 + and then Val = Sign.Value_Ptr.E8 and then Sign.S.Drivers (0).First_Trans.Next = null then return; @@ -1063,16 +1098,14 @@ package body Grt.Signals is end Ghdl_Signal_Next_Assign_E8; function Ghdl_Create_Signal_E32 - (Init_Val : Ghdl_E32; + (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal - (Mode_E32, Value_Union'(Mode => Mode_E32, E32 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); + (Mode_E32, Val_Ptr, Get_Current_Mode_Signal, Resolv_Func, Resolv_Inst); end Ghdl_Create_Signal_E32; procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32) @@ -1094,7 +1127,7 @@ package body Grt.Signals is begin if not Sign.Has_Active and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.E32 + and then Val = Sign.Value_Ptr.E32 and then Sign.S.Drivers (0).First_Trans.Next = null then return; @@ -1136,16 +1169,14 @@ package body Grt.Signals is end Ghdl_Signal_Next_Assign_E32; function Ghdl_Create_Signal_I32 - (Init_Val : Ghdl_I32; + (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal - (Mode_I32, Value_Union'(Mode => Mode_I32, I32 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); + (Mode_I32, Val_Ptr, Get_Current_Mode_Signal, Resolv_Func, Resolv_Inst); end Ghdl_Create_Signal_I32; procedure Ghdl_Signal_Init_I32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I32) @@ -1167,7 +1198,7 @@ package body Grt.Signals is begin if not Sign.Has_Active and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.I32 + and then Val = Sign.Value_Ptr.I32 and then Sign.S.Drivers (0).First_Trans.Next = null then return; @@ -1209,16 +1240,14 @@ package body Grt.Signals is end Ghdl_Signal_Next_Assign_I32; function Ghdl_Create_Signal_I64 - (Init_Val : Ghdl_I64; + (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal - (Mode_I64, Value_Union'(Mode => Mode_I64, I64 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); + (Mode_I64, Val_Ptr, Get_Current_Mode_Signal, Resolv_Func, Resolv_Inst); end Ghdl_Create_Signal_I64; procedure Ghdl_Signal_Init_I64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I64) @@ -1240,7 +1269,7 @@ package body Grt.Signals is begin if not Sign.Has_Active and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.I64 + and then Val = Sign.Value_Ptr.I64 and then Sign.S.Drivers (0).First_Trans.Next = null then return; @@ -1282,16 +1311,14 @@ package body Grt.Signals is end Ghdl_Signal_Next_Assign_I64; function Ghdl_Create_Signal_F64 - (Init_Val : Ghdl_F64; + (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal - (Mode_F64, Value_Union'(Mode => Mode_F64, F64 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); + (Mode_F64, Val_Ptr, Get_Current_Mode_Signal, Resolv_Func, Resolv_Inst); end Ghdl_Create_Signal_F64; procedure Ghdl_Signal_Init_F64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_F64) @@ -1313,7 +1340,7 @@ package body Grt.Signals is begin if not Sign.Has_Active and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.F64 + and then Val = Sign.Value_Ptr.F64 and then Sign.S.Drivers (0).First_Trans.Next = null then return; @@ -1419,11 +1446,10 @@ package body Grt.Signals is Obj_Type => null); function Ghdl_Create_Signal_Attribute - (Mode : Mode_Signal_Type; Time : Std_Time) + (Val_Ptr : Ghdl_Value_Ptr; Mode : Mode_Signal_Type; Time : Std_Time) return Ghdl_Signal_Ptr is Res : Ghdl_Signal_Ptr; --- Sig_Type : Ghdl_Desc_Ptr; begin case Mode is when Mode_Transaction => @@ -1437,9 +1463,8 @@ package body Grt.Signals is Internal_Error ("ghdl_create_signal_attribute"); end case; -- Note: bit and boolean are both mode_b1. - Res := Create_Signal - (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => True), - Mode, null, Null_Address); + Val_Ptr.B1 := True; + Res := Create_Signal (Mode_B1, Val_Ptr, Mode, null, Null_Address); Sig_Rti := null; Last_Implicit_Signal := Res; @@ -1449,7 +1474,8 @@ package body Grt.Signals is Line => 0, Time => 0, Next => null, - Val => Res.Value); + Val => (Mode => Mode_B1, + B1 => True)); end if; if Time > 0 then @@ -1460,22 +1486,22 @@ package body Grt.Signals is return Res; end Ghdl_Create_Signal_Attribute; - function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr - is + function Ghdl_Create_Stable_Signal + (Val_Ptr : Ghdl_Value_Ptr; Val : Std_Time) return Ghdl_Signal_Ptr is begin - return Ghdl_Create_Signal_Attribute (Mode_Stable, Val); + return Ghdl_Create_Signal_Attribute (Val_Ptr, Mode_Stable, Val); end Ghdl_Create_Stable_Signal; - function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr - is + function Ghdl_Create_Quiet_Signal + (Val_Ptr : Ghdl_Value_Ptr; Val : Std_Time) return Ghdl_Signal_Ptr is begin - return Ghdl_Create_Signal_Attribute (Mode_Quiet, Val); + return Ghdl_Create_Signal_Attribute (Val_Ptr, Mode_Quiet, Val); end Ghdl_Create_Quiet_Signal; - function Ghdl_Create_Transaction_Signal return Ghdl_Signal_Ptr - is + function Ghdl_Create_Transaction_Signal + (Val_Ptr : Ghdl_Value_Ptr) return Ghdl_Signal_Ptr is begin - return Ghdl_Create_Signal_Attribute (Mode_Transaction, 0); + return Ghdl_Create_Signal_Attribute (Val_Ptr, Mode_Transaction, 0); end Ghdl_Create_Transaction_Signal; procedure Ghdl_Signal_Attribute_Register_Prefix (Sig : Ghdl_Signal_Ptr) @@ -1500,17 +1526,16 @@ package body Grt.Signals is Loc => Null_Rti_Loc, Obj_Type => Std_Standard_Boolean_RTI_Ptr); - function Ghdl_Signal_Create_Guard (This : System.Address; - Proc : Guard_Func_Acc) + function Ghdl_Signal_Create_Guard + (Val_Ptr : Ghdl_Value_Ptr; This : System.Address; Proc : Guard_Func_Acc) return Ghdl_Signal_Ptr is Res : Ghdl_Signal_Ptr; begin Sig_Rti := To_Ghdl_Rtin_Object_Acc (To_Ghdl_Rti_Access (Guard_Rti'Address)); - Res := Create_Signal - (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => Proc.all (This)), - Mode_Guard, null, Null_Address); + Val_Ptr.B1 := Proc.all (This); + Res := Create_Signal (Mode_B1, Val_Ptr, Mode_Guard, null, Null_Address); Sig_Rti := null; Res.S.Guard_Func := Proc; Res.S.Guard_Instance := This; @@ -1525,13 +1550,15 @@ package body Grt.Signals is Sig.Has_Active := True; end Ghdl_Signal_Guard_Dependence; - function Ghdl_Create_Delayed_Signal (Sig : Ghdl_Signal_Ptr; Val : Std_Time) - return Ghdl_Signal_Ptr + function Ghdl_Create_Delayed_Signal + (Sig : Ghdl_Signal_Ptr; Val_Ptr : Ghdl_Value_Ptr; Val : Std_Time) + return Ghdl_Signal_Ptr is Res : Ghdl_Signal_Ptr; begin - Res := Create_Signal (Sig.Mode, Sig.Value, - Mode_Delayed, null, Null_Address); + Assign (Val_Ptr, Sig.Value_Ptr, Sig.Mode); + Res := Create_Signal + (Sig.Mode, Val_Ptr, Mode_Delayed, null, Null_Address); Res.S.Time := Val; if Val > 0 then Res.Flink := Future_List; @@ -1541,7 +1568,8 @@ package body Grt.Signals is Line => 0, Time => 0, Next => null, - Val => Res.Value); + Val => Read_Value (Val_Ptr, + Sig.Mode)); Append_Port (Res, Sig); return Res; end Ghdl_Create_Delayed_Signal; @@ -1767,7 +1795,7 @@ package body Grt.Signals is type Force_Value (Kind : Force_Value_Kind) is record Next : Force_Value_Acc; Sig : Ghdl_Signal_Ptr; - Val : Value_Union; + Val : aliased Value_Union; end record; procedure Free is new Ada.Unchecked_Deallocation @@ -2869,6 +2897,7 @@ package body Grt.Signals is Trans : Transaction_Acc; Last : Transaction_Acc; Prev : Transaction_Acc; + Val : Value_Union; begin if Pfx.Event then -- LRM 14.1 @@ -2890,16 +2919,18 @@ package body Grt.Signals is -- The transaction are scheduled after the last one. pragma Assert (Last.Time <= Ntime); + Val := Read_Value (Pfx.Value_Ptr, Pfx.Mode); + if Last.Time = Ntime then -- Change the projected value. - Last.Val := Pfx.Value; + Last.Val := Val; else -- Create the transaction. Trans := new Transaction'(Kind => Trans_Value, Line => 0, Time => Ntime, Next => null, - Val => Pfx.Value); + Val => Val); -- Append the transaction. Prev.Next := Trans; @@ -2913,23 +2944,59 @@ package body Grt.Signals is -- Set the effective value of signal SIG to VAL. -- If the value is different from the previous one, resume processes. - procedure Set_Effective_Value (Sig : Ghdl_Signal_Ptr; Val : Value_Union) + procedure Set_Effective_Value + (Sig : Ghdl_Signal_Ptr; Val : Ghdl_Value_Ptr) is El : Action_List_Acc; begin - if not Value_Equal (Sig.Value, Val, Sig.Mode) then - Sig.Last_Value := Sig.Value; - Sig.Value := Val; - Sig.Event := True; - Sig.Last_Event := Current_Time; - Sig.Flags.RO_Event := True; - - El := Sig.Event_List; - while El /= null loop - Resume_Process (El.Proc); - El := El.Next; - end loop; - end if; + case Sig.Mode is + when Mode_B1 => + if Sig.Value_Ptr.B1 = Val.B1 then + return; + end if; + Sig.Last_Value.B1 := Sig.Value_Ptr.B1; + Sig.Value_Ptr.B1 := Val.B1; + when Mode_E8 => + if Sig.Value_Ptr.E8 = Val.E8 then + return; + end if; + Sig.Last_Value.E8 := Sig.Value_Ptr.E8; + Sig.Value_Ptr.E8 := Val.E8; + when Mode_E32 => + if Sig.Value_Ptr.E32 = Val.E32 then + return; + end if; + Sig.Last_Value.E32 := Sig.Value_Ptr.E32; + Sig.Value_Ptr.E32 := Val.E32; + when Mode_I32 => + if Sig.Value_Ptr.I32 = Val.I32 then + return; + end if; + Sig.Last_Value.I32 := Sig.Value_Ptr.I32; + Sig.Value_Ptr.I32 := Val.I32; + when Mode_I64 => + if Sig.Value_Ptr.I64 = Val.I64 then + return; + end if; + Sig.Last_Value.I64 := Sig.Value_Ptr.I64; + Sig.Value_Ptr.I64 := Val.I64; + when Mode_F64 => + if Sig.Value_Ptr.F64 = Val.F64 then + return; + end if; + Sig.Last_Value.F64 := Sig.Value_Ptr.F64; + Sig.Value_Ptr.F64 := Val.F64; + end case; + + Sig.Event := True; + Sig.Last_Event := Current_Time; + Sig.Flags.RO_Event := True; + + El := Sig.Event_List; + while El /= null loop + Resume_Process (El.Proc); + El := El.Next; + end loop; end Set_Effective_Value; procedure Run_Propagation (Start : Signal_Net_Type) @@ -3055,7 +3122,8 @@ package body Grt.Signals is | Eff_One_Resolved => Sig := Propagation.Table (I).Sig; if Sig.Active then - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); end if; when Eff_Multiple => declare @@ -3067,14 +3135,15 @@ package body Grt.Signals is for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop Sig := Sig_Table.Table (I); - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); end loop; end if; end; when Eff_Actual => Sig := Propagation.Table (I).Sig; if Sig.Active then - Set_Effective_Value (Sig, Sig.S.Effective.Value); + Set_Effective_Value (Sig, Sig.S.Effective.Value_Ptr); end if; when Imp_Forward | Imp_Forward_Build => @@ -3086,7 +3155,8 @@ package body Grt.Signals is if Sig.Active then Sig.Driving_Value.B1 := Sig.S.Guard_Func.all (Sig.S.Guard_Instance); - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); end if; when Imp_Stable | Imp_Quiet => @@ -3106,7 +3176,8 @@ package body Grt.Signals is Free (Sig.S.Attr_Trans.Next); end if; Sig.S.Attr_Trans.Next := Trans; - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); if Sig.S.Time = 0 then Add_Active_Chain (Sig); end if; @@ -3117,7 +3188,8 @@ package body Grt.Signals is Free (Sig.S.Attr_Trans); Sig.S.Attr_Trans := Trans; Sig.Driving_Value := Trans.Val; - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); end if; end if; when Imp_Transaction => @@ -3128,20 +3200,26 @@ package body Grt.Signals is -- assigning the value of the expression (not S'Transaction) -- to the variable representing the current value of -- S'Transaction. - Sig := Propagation.Table (I).Sig; - for I in 0 .. Sig.Nbr_Ports - 1 loop - if Sig.Ports (I).Active then - Mark_Active (Sig); - Set_Effective_Value - (Sig, Value_Union'(Mode => Mode_B1, - B1 => not Sig.Value.B1)); - exit; - end if; - end loop; + declare + Val : aliased Value_Union; + begin + Sig := Propagation.Table (I).Sig; + Val := (Mode => Mode_B1, + B1 => not Sig.Value_Ptr.B1); + for I in 0 .. Sig.Nbr_Ports - 1 loop + if Sig.Ports (I).Active then + Mark_Active (Sig); + Set_Effective_Value + (Sig, Val'Unrestricted_access); + exit; + end if; + end loop; + end; when Imp_Delayed => Sig := Propagation.Table (I).Sig; if Sig.Active then - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); end if; Delayed_Implicit_Process (Sig); when In_Conversion => @@ -3212,10 +3290,10 @@ package body Grt.Signals is when Force_Driving => Mark_Active (Sig); Sig.Driving_Value := Fv.Val; - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value (Sig, Sig.Driving_Value'Access); when Force_Effective => Mark_Active (Sig); - Set_Effective_Value (Sig, Fv.Val); + Set_Effective_Value (Sig, Fv.Val'Access); end case; Next_Fv := Fv.Next; Free (Fv); @@ -3251,7 +3329,8 @@ package body Grt.Signals is when Trans_Error => Error_Trans_Error (Trans); end case; - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); when Net_One_Direct => Mark_Active (Sig); @@ -3260,7 +3339,8 @@ package body Grt.Signals is Trans := Sig.S.Drivers (0).Last_Trans; Assign (Sig.Driving_Value, Trans.Val_Ptr.all, Sig.Mode); Sig.S.Drivers (0).First_Trans.Val := Sig.Driving_Value; - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); when Net_One_Resolved => -- This signal is active. @@ -3280,7 +3360,8 @@ package body Grt.Signals is end if; end loop; Compute_Resolved_Signal (Sig.S.Resolv); - Set_Effective_Value (Sig, Sig.Driving_Value); + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); when No_Signal_Net => Internal_Error ("update_signals: no_signal_net"); @@ -3412,7 +3493,7 @@ package body Grt.Signals is | Eff_One_Resolved | Imp_Delayed => Sig := Propagation.Table (I).Sig; - Sig.Value := Sig.Driving_Value; + Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode); when Eff_Multiple => declare Resolv : Resolved_Signal_Acc; @@ -3420,18 +3501,18 @@ package body Grt.Signals is Resolv := Propagation.Table (I).Resolv; for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop Sig := Sig_Table.Table (I); - Sig.Value := Sig.Driving_Value; + Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode); end loop; end; when Eff_Actual => Sig := Propagation.Table (I).Sig; - Sig.Value := Sig.S.Effective.Value; + Assign (Sig.Value_Ptr, Sig.S.Effective.Value_Ptr, Sig.Mode); when Imp_Guard => -- Guard signal is active iff one of its dependence is active. Sig := Propagation.Table (I).Sig; Sig.Driving_Value.B1 := Sig.S.Guard_Func.all (Sig.S.Guard_Instance); - Sig.Value := Sig.Driving_Value; + Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode); when Imp_Stable | Imp_Quiet | Imp_Transaction @@ -3470,7 +3551,7 @@ package body Grt.Signals is Sig.Has_Active := True; if Sig.S.Nbr_Drivers + Sig.Nbr_Ports > 0 then Compute_Resolved_Signal (Sig.S.Resolv); - Sig.Value := Sig.Driving_Value; + Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode); end if; when No_Signal_Net => @@ -3488,8 +3569,7 @@ package body Grt.Signals is procedure Init is begin - Signal_End := new Ghdl_Signal'(Value => (Mode => Mode_B1, - B1 => False), + Signal_End := new Ghdl_Signal'(Value_Ptr => null, Driving_Value => (Mode => Mode_B1, B1 => False), Last_Value => (Mode => Mode_B1, diff --git a/src/grt/grt-signals.ads b/src/grt/grt-signals.ads index 36ef69263..e5fbf1944 100644 --- a/src/grt/grt-signals.ads +++ b/src/grt/grt-signals.ads @@ -291,8 +291,8 @@ package Grt.Signals is type Ghdl_Signal is record -- Fields known by the compilers. - Value : Value_Union; - Driving_Value : Value_Union; + Value_Ptr : Ghdl_Value_Ptr; + Driving_Value : aliased Value_Union; Last_Value : Value_Union; Last_Event : Std_Time; Last_Active : Std_Time; @@ -351,6 +351,11 @@ package Grt.Signals is Table_Low_Bound => 0, Table_Initial => 128); + -- Read the value pointed by VALUE_PTR. It cannot be simply deferred as + -- pointer alignment may not be correct. + function Read_Value (Value_Ptr : Ghdl_Value_Ptr; Mode : Mode_Type) + return Value_Union; + -- Elementary propagation computation. -- See LRM 12.6.2 and 12.6.3 type Propagation_Kind_Type is @@ -495,7 +500,7 @@ package Grt.Signals is -- Set the effective value of signal SIG to VAL. -- If the value is different from the previous one, resume processes. - procedure Set_Effective_Value (Sig : Ghdl_Signal_Ptr; Val : Value_Union); + procedure Set_Effective_Value (Sig : Ghdl_Signal_Ptr; Val : Ghdl_Value_Ptr); -- Add PROC in the list of processes to be resumed in case of event on -- SIG. @@ -567,7 +572,7 @@ package Grt.Signals is function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B1; - function Ghdl_Create_Signal_B1 (Init_Val : Ghdl_B1; + function Ghdl_Create_Signal_B1 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr; @@ -589,7 +594,7 @@ package Grt.Signals is procedure Ghdl_Signal_Force_Effective_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1); - function Ghdl_Create_Signal_E8 (Init_Val : Ghdl_E8; + function Ghdl_Create_Signal_E8 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr; @@ -611,7 +616,7 @@ package Grt.Signals is procedure Ghdl_Signal_Force_Effective_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8); - function Ghdl_Create_Signal_E32 (Init_Val : Ghdl_E32; + function Ghdl_Create_Signal_E32 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr; @@ -629,7 +634,7 @@ package Grt.Signals is function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr) return Ghdl_E32; - function Ghdl_Create_Signal_I32 (Init_Val : Ghdl_I32; + function Ghdl_Create_Signal_I32 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr; @@ -647,7 +652,7 @@ package Grt.Signals is function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr) return Ghdl_I32; - function Ghdl_Create_Signal_I64 (Init_Val : Ghdl_I64; + function Ghdl_Create_Signal_I64 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr; @@ -665,7 +670,7 @@ package Grt.Signals is function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr) return Ghdl_I64; - function Ghdl_Create_Signal_F64 (Init_Val : Ghdl_F64; + function Ghdl_Create_Signal_F64 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr; @@ -738,25 +743,29 @@ package Grt.Signals is -- Create a new 'stable (VAL) signal. The prefixes are set by -- ghdl_signal_attribute_register_prefix. - function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr; + function Ghdl_Create_Stable_Signal + (Val_Ptr : Ghdl_Value_Ptr; Val : Std_Time) return Ghdl_Signal_Ptr; -- Create a new 'quiet (VAL) signal. The prefixes are set by -- ghdl_signal_attribute_register_prefix. - function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr; + function Ghdl_Create_Quiet_Signal + (Val_Ptr : Ghdl_Value_Ptr; Val : Std_Time) return Ghdl_Signal_Ptr; -- Create a new 'transaction signal. The prefixes are set by -- ghdl_signal_attribute_register_prefix. - function Ghdl_Create_Transaction_Signal return Ghdl_Signal_Ptr; + function Ghdl_Create_Transaction_Signal + (Val_Ptr : Ghdl_Value_Ptr) return Ghdl_Signal_Ptr; - -- Create a new SIG'delayed (VAL) signal. - function Ghdl_Create_Delayed_Signal (Sig : Ghdl_Signal_Ptr; Val : Std_Time) - return Ghdl_Signal_Ptr; + -- Create a new SIG'delayed (VAL) signal (for a scalar signal). + function Ghdl_Create_Delayed_Signal + (Sig : Ghdl_Signal_Ptr; Val_Ptr : Ghdl_Value_Ptr; Val : Std_Time) + return Ghdl_Signal_Ptr; -- Add SIG in the set of prefix for the last created signal. procedure Ghdl_Signal_Attribute_Register_Prefix (Sig : Ghdl_Signal_Ptr); -- Create a new implicitly defined GUARD signal. - function Ghdl_Signal_Create_Guard (This : System.Address; - Proc : Guard_Func_Acc) - return Ghdl_Signal_Ptr; + function Ghdl_Signal_Create_Guard + (Val_Ptr : Ghdl_Value_Ptr; This : System.Address; Proc : Guard_Func_Acc) + return Ghdl_Signal_Ptr; -- Add SIG to the list of referenced signals that appear in the guard -- expression. diff --git a/src/grt/grt-types.ads b/src/grt/grt-types.ads index 71987119b..acd7f0cb7 100644 --- a/src/grt/grt-types.ads +++ b/src/grt/grt-types.ads @@ -208,7 +208,7 @@ package Grt.Types is end record; pragma Unchecked_Union (Value_Union); - type Ghdl_Value_Ptr is access Value_Union; + type Ghdl_Value_Ptr is access all Value_Union; function To_Ghdl_Value_Ptr is new Ada.Unchecked_Conversion (Source => Address, Target => Ghdl_Value_Ptr); diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb index d29ae2352..063850e36 100644 --- a/src/grt/grt-vcd.adb +++ b/src/grt/grt-vcd.adb @@ -656,27 +656,27 @@ package body Grt.Vcd is case V.Kind is when Vcd_Bit | Vcd_Bool => - Vcd_Put_Bit (V.Sigs (0).Value.B1); + Vcd_Put_Bit (V.Sigs (0).Value_Ptr.B1); when Vcd_Stdlogic => - Vcd_Put_Stdlogic (V.Sigs (0).Value.E8); + Vcd_Put_Stdlogic (V.Sigs (0).Value_Ptr.E8); when Vcd_Integer32 => Vcd_Putc ('b'); - Vcd_Put_Integer32 (V.Sigs (0).Value.E32); + Vcd_Put_Integer32 (V.Sigs (0).Value_Ptr.E32); Vcd_Putc (' '); when Vcd_Float64 => Vcd_Putc ('r'); - Vcd_Put_Float64 (V.Sigs (0).Value.F64); + Vcd_Put_Float64 (V.Sigs (0).Value_Ptr.F64); Vcd_Putc (' '); when Vcd_Bitvector => Vcd_Putc ('b'); for J in 0 .. Len - 1 loop - Vcd_Put_Bit (V.Sigs (J).Value.B1); + Vcd_Put_Bit (V.Sigs (J).Value_Ptr.B1); end loop; Vcd_Putc (' '); when Vcd_Stdlogic_Vector => Vcd_Putc ('b'); for J in 0 .. Len - 1 loop - Vcd_Put_Stdlogic (V.Sigs (J).Value.E8); + Vcd_Put_Stdlogic (V.Sigs (J).Value_Ptr.E8); end loop; Vcd_Putc (' '); when Vcd_Bad => diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index eedb8460c..136010a77 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -478,12 +478,12 @@ package body Grt.Vpi is | Vcd_Bool | Vcd_Bitvector => for J in 0 .. Len - 1 loop - ii_vpi_get_value_bin_str_B1 (Info.Sigs (J).Value.B1); + ii_vpi_get_value_bin_str_B1 (Info.Sigs (J).Value_Ptr.B1); end loop; when Vcd_Stdlogic | Vcd_Stdlogic_Vector => for J in 0 .. Len - 1 loop - ii_vpi_get_value_bin_str_E8 (Info.Sigs (J).Value.E8); + ii_vpi_get_value_bin_str_E8 (Info.Sigs (J).Value_Ptr.E8); end loop; end case; when Vcd_Driving => @@ -571,7 +571,6 @@ package body Grt.Vpi is -- Alter the simulation value of an object. -- see IEEE 1364-2001, chapter 27.14, page 675 -- FIXME - type Std_Ulogic_Array is array (Ghdl_Index_Type range <>) of Std_Ulogic; procedure Ii_Vpi_Put_Value (Info : Verilog_Wire_Info; diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb index 34124e2fc..250d596d1 100644 --- a/src/grt/grt-waves.adb +++ b/src/grt/grt-waves.adb @@ -238,7 +238,7 @@ package body Grt.Waves is Put (Wave_Stream, Str); end Wave_Puts; - procedure Write_Value (Value : Value_Union; Mode : Mode_Type) is + procedure Write_Value (Value : Ghdl_Value_Ptr; Mode : Mode_Type) is begin case Mode is when Mode_B1 => @@ -830,7 +830,7 @@ package body Grt.Waves is when others => Internal_Error ("bad iterator type"); end case; - Write_Value (To_Ghdl_Value_Ptr (Addr).all, Mode); + Write_Value (To_Ghdl_Value_Ptr (Addr), Mode); end Write_Generate_Type_And_Value; type Step_Type is (Step_Name, Step_Hierarchy); @@ -1549,7 +1549,7 @@ package body Grt.Waves is procedure Write_Signal_Value (Sig : Ghdl_Signal_Ptr) is begin -- FIXME: for some signals, the significant value is the driving value! - Write_Value (Sig.Value, Sig.Mode); + Write_Value (Sig.Value_Ptr, Sig.Mode); end Write_Signal_Value; procedure Write_Snapshot is diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index 3123fbdba..6856097e7 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -782,7 +782,7 @@ package body Sem_Assocs is end Finish_Individual_Assoc_Record; -- Called by sem_individual_association to finish the semantization of - -- individual association ASSOC. + -- individual association ASSOC: compute bounds, detect missing elements. procedure Finish_Individual_Association (Assoc : Iir) is Formal : Iir; @@ -795,6 +795,7 @@ package body Sem_Assocs is Formal := Get_Association_Interface (Assoc); Atype := Get_Type (Formal); + Set_Whole_Association_Flag (Assoc, True); case Get_Kind (Atype) is when Iir_Kind_Array_Subtype_Definition => diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index 35cbfb0f0..a3c8233f0 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -75,15 +75,20 @@ package body Trans.Chap1 is is El : Iir; El_Type : Iir; + Default : Iir; begin Push_Local_Factory; + Default := Null_Iir; El := Get_Port_Chain (Entity); while El /= Null_Iir loop Open_Temp; El_Type := Get_Type (El); if not Is_Fully_Constrained_Type (El_Type) then - Chap5.Elab_Unconstrained_Port (El, Get_Default_Value (El)); + if Default = Null_Iir then + Default := Create_Iir (Iir_Kind_Association_Element_Open); + end if; + Chap5.Elab_Unconstrained_Port_Bounds (El, Default); end if; Chap4.Elab_Signal_Declaration_Storage (El); Chap4.Elab_Signal_Declaration_Object (El, Entity, False); diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb index b7fc93a0a..a737c6c24 100644 --- a/src/vhdl/translate/trans-chap14.adb +++ b/src/vhdl/translate/trans-chap14.adb @@ -43,7 +43,7 @@ package body Trans.Chap14 is Arr := T2M (Type_Name, Mode_Value); else -- Prefix is an object. - Arr := Chap6.Translate_Name (Prefix); + Arr := Chap6.Translate_Name (Prefix, Mode_Value); end if; Dim := Natural (Get_Value (Get_Parameter (Expr))); return Chap3.Get_Array_Range (Arr, Get_Type (Prefix), Dim); @@ -431,14 +431,14 @@ package body Trans.Chap14 is begin if Get_Kind (Prefix_Type) in Iir_Kinds_Scalar_Type_Definition then -- Effecient handling for a scalar signal. - Name := Chap6.Translate_Name (Prefix); + Name := Chap6.Translate_Name (Prefix, Mode_Signal); return New_Value (Get_Signal_Field (Name, Field)); else -- Element per element handling for composite signals. Res := Create_Temp (Std_Boolean_Type_Node); Open_Temp; New_Assign_Stmt (New_Obj (Res), New_Lit (Std_Boolean_True_Node)); - Name := Chap6.Translate_Name (Prefix); + Name := Chap6.Translate_Name (Prefix, Mode_Signal); Start_Loop_Stmt (Data.Label); Data.Field := Field; Bool_Sigattr_Foreach (Name, Prefix_Type, Data); @@ -497,17 +497,11 @@ package body Trans.Chap14 is function Translate_Last_Value_Attribute (Attr : Iir) return O_Enode is + Prefix : constant Iir := Get_Prefix (Attr); + Prefix_Type : constant Iir := Get_Type (Prefix); Name : Mnode; - Prefix : Iir; - Prefix_Type : Iir; begin - Prefix := Get_Prefix (Attr); - Prefix_Type := Get_Type (Prefix); - - Name := Chap6.Translate_Name (Prefix); - if Get_Object_Kind (Name) /= Mode_Signal then - raise Internal_Error; - end if; + Name := Chap6.Translate_Name (Prefix, Mode_Signal); return Translate_Last_Value (M2E (Name), Prefix_Type); end Translate_Last_Value_Attribute; @@ -596,7 +590,7 @@ package body Trans.Chap14 is function Translate_Last_Time_Attribute (Prefix : Iir; Field : O_Fnode) return O_Enode is - Prefix_Type : Iir; + Prefix_Type : constant Iir := Get_Type (Prefix); Name : Mnode; Info : Type_Info_Acc; Var : O_Dnode; @@ -604,8 +598,7 @@ package body Trans.Chap14 is Right_Bound : Iir_Int64; If_Blk : O_If_Block; begin - Prefix_Type := Get_Type (Prefix); - Name := Chap6.Translate_Name (Prefix); + Name := Chap6.Translate_Name (Prefix, Mode_Signal); Info := Get_Info (Prefix_Type); Var := Create_Temp (Std_Time_Otype); @@ -728,14 +721,14 @@ package body Trans.Chap14 is if Get_Kind (Prefix_Type) in Iir_Kinds_Scalar_Type_Definition then -- Effecient handling for a scalar signal. - Name := Chap6.Translate_Name (Prefix); + Name := Chap6.Translate_Name (Prefix, Mode_Signal); return Read_Driving_Attribute (New_Value (M2Lv (Name))); else -- Element per element handling for composite signals. Res := Create_Temp (Std_Boolean_Type_Node); Open_Temp; New_Assign_Stmt (New_Obj (Res), New_Lit (Std_Boolean_False_Node)); - Name := Chap6.Translate_Name (Prefix); + Name := Chap6.Translate_Name (Prefix, Mode_Signal); Start_Loop_Stmt (Label); Driving_Foreach (Name, Prefix_Type, Label); New_Assign_Stmt (New_Obj (Res), New_Lit (Std_Boolean_True_Node)); @@ -783,18 +776,11 @@ package body Trans.Chap14 is function Translate_Driving_Value_Attribute (Attr : Iir) return O_Enode is + Prefix : constant Iir := Get_Prefix (Attr); Name : Mnode; - Prefix : Iir; - Prefix_Type : Iir; begin - Prefix := Get_Prefix (Attr); - Prefix_Type := Get_Type (Prefix); - - Name := Chap6.Translate_Name (Prefix); - if Get_Object_Kind (Name) /= Mode_Signal then - raise Internal_Error; - end if; - return Translate_Driving_Value (M2E (Name), Prefix_Type); + Name := Chap6.Translate_Name (Prefix, Mode_Signal); + return Translate_Driving_Value (M2E (Name), Get_Type (Prefix)); end Translate_Driving_Value_Attribute; function Translate_Image_Attribute (Attr : Iir) return O_Enode diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 51be1aebf..0d94e91ea 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -41,6 +41,9 @@ package body Trans.Chap2 is type Name_String_Xlat_Array is array (Name_Id range <>) of String (1 .. 4); + -- Ortho function names are only composed of [A-Za-z0-9_]. For VHDL + -- functions whose name is an operator symbol, we need to create a name + -- with letters. Operator_String_Xlat : constant Name_String_Xlat_Array (Std_Names.Name_Id_Operators) := (Std_Names.Name_Op_Equality => "OPEq", @@ -80,40 +83,55 @@ package body Trans.Chap2 is end Push_Subprg_Identifier; -- Return the type of a subprogram interface. - -- Return O_Tnode_Null if the parameter is passed through the - -- interface record. - function Translate_Interface_Type (Inter : Iir; Is_Foreign : Boolean) - return O_Tnode + procedure Translate_Interface_Mechanism (Inter : Iir) is + Spec : constant Iir := Get_Parent (Inter); + pragma Assert (Get_Kind (Spec) in Iir_Kinds_Subprogram_Declaration); + Info : constant Interface_Info_Acc := Get_Info (Inter); Tinfo : constant Type_Info_Acc := Get_Info (Get_Type (Inter)); - Mode : Object_Kind_Type; - By_Addr : Boolean; + Mech : Call_Mechanism; begin -- Mechanism. case Type_Mode_Valid (Tinfo.Type_Mode) is when Type_Mode_Pass_By_Copy => - By_Addr := False; + Mech := Pass_By_Copy; when Type_Mode_Pass_By_Address => - By_Addr := True; + Mech := Pass_By_Address; end case; case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Interface_File_Declaration => - Mode := Mode_Value; + Info.Interface_Mechanism (Mode_Value) := Mech; when Iir_Kind_Interface_Variable_Declaration => - Mode := Mode_Value; - if Is_Foreign and then Get_Mode (Inter) in Iir_Out_Modes then - By_Addr := True; + if Get_Foreign_Flag (Spec) + and then Get_Mode (Inter) in Iir_Out_Modes + then + Mech := Pass_By_Address; end if; + Info.Interface_Mechanism (Mode_Value) := Mech; when Iir_Kind_Interface_Signal_Declaration => - Mode := Mode_Signal; + Info.Interface_Mechanism (Mode_Signal) := Mech; + -- Values are always passed by address. + if Get_Kind (Spec) = Iir_Kind_Procedure_Declaration then + Mech := Pass_By_Address; + end if; + Info.Interface_Mechanism (Mode_Value) := Mech; + end case; + end Translate_Interface_Mechanism; + + function Translate_Interface_Type (Inter : Iir; Mode : Object_Kind_Type) + return O_Tnode + is + Info : constant Interface_Info_Acc := Get_Info (Inter); + Tinfo : constant Type_Info_Acc := Get_Info (Get_Type (Inter)); + begin + case Info.Interface_Mechanism (Mode) is + when Pass_By_Address => + return Tinfo.Ortho_Ptr_Type (Mode); + when Pass_By_Copy => + return Tinfo.Ortho_Type (Mode); end case; - if By_Addr then - return Tinfo.Ortho_Ptr_Type (Mode); - else - return Tinfo.Ortho_Type (Mode); - end if; end Translate_Interface_Type; procedure Translate_Subprogram_Interfaces (Spec : Iir) @@ -122,7 +140,7 @@ package body Trans.Chap2 is Mark : Id_Mark_Type; Info : Subprg_Info_Acc; El_List : O_Element_List; - Arg_Info : Ortho_Info_Acc; + Param_Info : Ortho_Info_Acc; begin -- Set the identifier prefix with the subprogram identifier and -- overload number if any. @@ -143,11 +161,24 @@ package body Trans.Chap2 is and then not Get_Foreign_Flag (Spec) then Start_Record_Type (El_List); + + -- Create fields for interfaces. while Inter /= Null_Iir loop - Arg_Info := Add_Info (Inter, Kind_Interface); - New_Record_Field (El_List, Arg_Info.Interface_Field, - Create_Identifier_Without_Prefix (Inter), - Translate_Interface_Type (Inter, False)); + Param_Info := Add_Info (Inter, Kind_Interface); + Translate_Interface_Mechanism (Inter); + + New_Record_Field + (El_List, Param_Info.Interface_Field (Mode_Value), + Create_Identifier_Without_Prefix (Inter), + Translate_Interface_Type (Inter, Mode_Value)); + + if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration + then + New_Record_Field + (El_List, Param_Info.Interface_Field (Mode_Signal), + Create_Identifier_Without_Prefix (Inter, "SIG"), + Translate_Interface_Type (Inter, Mode_Signal)); + end if; Inter := Get_Chain (Inter); end loop; @@ -193,7 +224,8 @@ package body Trans.Chap2 is Get_Kind (Spec) = Iir_Kind_Function_Declaration; Is_Foreign : constant Boolean := Get_Foreign_Flag (Spec); Inter : Iir; - Arg_Info : Ortho_Info_Acc; + Param_Info : Ortho_Info_Acc; + Arg_Type : O_Tnode; Tinfo : Type_Info_Acc; Interface_List : O_Inter_List; Mark : Id_Mark_Type; @@ -274,15 +306,21 @@ package body Trans.Chap2 is Inter := Get_Interface_Declaration_Chain (Spec); while Inter /= Null_Iir loop -- Create the info. - Arg_Info := Add_Info (Inter, Kind_Interface); - Arg_Info.Interface_Field := O_Fnode_Null; + Param_Info := Add_Info (Inter, Kind_Interface); + Translate_Interface_Mechanism (Inter); - Arg_Info.Interface_Type := - Translate_Interface_Type (Inter, Is_Foreign); + Arg_Type := Translate_Interface_Type (Inter, Mode_Value); New_Interface_Decl - (Interface_List, Arg_Info.Interface_Node, - Create_Identifier_Without_Prefix (Inter), - Arg_Info.Interface_Type); + (Interface_List, Param_Info.Interface_Decl (Mode_Value), + Create_Identifier_Without_Prefix (Inter), Arg_Type); + + if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then + Arg_Type := Translate_Interface_Type (Inter, Mode_Signal); + New_Interface_Decl + (Interface_List, Param_Info.Interface_Decl (Mode_Signal), + Create_Identifier_Without_Prefix (Inter, "SIG"), + Arg_Type); + end if; Inter := Get_Chain (Inter); end loop; end if; @@ -429,16 +467,30 @@ package body Trans.Chap2 is -- subprograms. declare Inter : Iir; + Inter_Type : O_Tnode; Inter_Info : Inter_Info_Acc; begin Inter := Get_Interface_Declaration_Chain (Spec); while Inter /= Null_Iir loop Inter_Info := Get_Info (Inter); - if Inter_Info.Interface_Node /= O_Dnode_Null then - Inter_Info.Interface_Field := + if Inter_Info.Interface_Decl (Mode_Value) /= O_Dnode_Null + then + Inter_Type := + Translate_Interface_Type (Inter, Mode_Value); + Inter_Info.Interface_Field (Mode_Value) := Add_Instance_Factory_Field - (Create_Identifier_Without_Prefix (Inter), - Inter_Info.Interface_Type); + (Create_Identifier_Without_Prefix (Inter), Inter_Type); + + if Get_Kind (Inter) + = Iir_Kind_Interface_Signal_Declaration + then + Inter_Type := + Translate_Interface_Type (Inter, Mode_Signal); + Inter_Info.Interface_Field (Mode_Signal) := + Add_Instance_Factory_Field + (Create_Identifier_Without_Prefix (Inter, "SIG"), + Inter_Type); + end if; end if; Inter := Get_Chain (Inter); end loop; @@ -571,17 +623,20 @@ package body Trans.Chap2 is Inter := Get_Interface_Declaration_Chain (Spec); while Inter /= Null_Iir loop Inter_Info := Get_Info (Inter); - if Inter_Info.Interface_Node /= O_Dnode_Null then - New_Assign_Stmt - (New_Selected_Element (New_Obj (Frame), - Inter_Info.Interface_Field), - New_Obj_Value (Inter_Info.Interface_Node)); - - -- Forget the reference to the field in FRAME, so that - -- this subprogram will directly reference the parameter - -- (and not its copy in the FRAME). - Inter_Info.Interface_Field := O_Fnode_Null; - end if; + for Mode in Object_Kind_Type loop + if Inter_Info.Interface_Decl (Mode) /= O_Dnode_Null then + New_Assign_Stmt + (New_Selected_Element + (New_Obj (Frame), + Inter_Info.Interface_Field (Mode)), + New_Obj_Value (Inter_Info.Interface_Decl (Mode))); + + -- Forget the reference to the field in FRAME, so that + -- this subprogram will directly reference the + -- parameter (and not its copy in the FRAME). + Inter_Info.Interface_Field (Mode) := O_Fnode_Null; + end if; + end loop; Inter := Get_Chain (Inter); end loop; end; @@ -963,7 +1018,8 @@ package body Trans.Chap2 is pragma Assert (Src.Signal_Function = O_Dnode_Null); Dest.all := (Kind => Kind_Signal, - Signal_Value => Instantiate_Var (Src.Signal_Value), + Signal_Val => Instantiate_Var (Src.Signal_Val), + Signal_Valp => Instantiate_Var (Src.Signal_Valp), Signal_Sig => Instantiate_Var (Src.Signal_Sig), Signal_Driver => Null_Var, Signal_Rti => Src.Signal_Rti, @@ -991,9 +1047,9 @@ package body Trans.Chap2 is Subprg_Result => Src.Subprg_Result); when Kind_Interface => Dest.all := (Kind => Kind_Interface, - Interface_Node => Src.Interface_Node, - Interface_Field => Src.Interface_Field, - Interface_Type => Src.Interface_Type); + Interface_Mechanism => Src.Interface_Mechanism, + Interface_Decl => Src.Interface_Decl, + Interface_Field => Src.Interface_Field); when Kind_Index => Dest.all := (Kind => Kind_Index, Index_Field => Src.Index_Field); diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index fd946d16e..9b67e467a 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -2706,8 +2706,7 @@ package body Trans.Chap3 is Val : Mnode; begin -- Compute parameter - Val := Chap6.Translate_Name (Param); - pragma Assert (Get_Object_Kind (Val) = Mode_Value); + Val := Chap6.Translate_Name (Param, Mode_Value); Stabilize (Val); -- Call deallocator. diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index a33f9ca5b..2fa63f9ee 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -59,6 +59,61 @@ package body Trans.Chap4 is end if; end Get_Object_Type; + -- Return the pointer type for Tinfo. + -- For a fat array, this is the fat pointer to slightly optimize accesses. + function Get_Object_Ptr_Type + (Tinfo : Type_Info_Acc; Kind : Object_Kind_Type) return O_Tnode is + begin + if Tinfo.Type_Mode = Type_Mode_Fat_Array then + -- Fat pointers are already pointers, no need to create an + -- additional indirection. + return Tinfo.Ortho_Type (Kind); + else + if Kind = Mode_Signal + and then Tinfo.Type_Mode in Type_Mode_Scalar + then + -- A scalar signal is already a pointer. + return Tinfo.Ortho_Type (Kind); + else + return Tinfo.Ortho_Ptr_Type (Kind); + end if; + end if; + end Get_Object_Ptr_Type; + + function Lop2M + (Obj_Ptr : O_Lnode; Tinfo : Type_Info_Acc; Mode : Object_Kind_Type) + return Mnode is + begin + if (Mode = Mode_Signal + and then Tinfo.Type_Mode in Type_Mode_Scalar) + or else Tinfo.Type_Mode = Type_Mode_Fat_Array + then + return Lv2M (Obj_Ptr, Tinfo, Mode); + else + return Lp2M (Obj_Ptr, Tinfo, Mode); + end if; + end Lop2M; + + procedure Assign_Obj_Ptr (Dest : Mnode; Src : Mnode) + is + Mode : constant Object_Kind_Type := Get_Object_Kind (Dest); + Tinfo : constant Type_Info_Acc := Get_Type_Info (Dest); + begin + pragma Assert (Mode = Get_Object_Kind (Src)); + pragma Assert (Tinfo.Type_Mode = Get_Type_Info (Src).Type_Mode); + if Tinfo.Type_Mode = Type_Mode_Fat_Array then + Copy_Fat_Pointer (Stabilize (Dest), Stabilize (Src)); + else + if Mode = Mode_Signal + and then Tinfo.Type_Mode in Type_Mode_Scalar + then + New_Assign_Stmt (M2Lv (Dest), M2E (Src)); + else + New_Assign_Stmt (M2Lp (Dest), M2Addr (Src)); + end if; + end if; + end Assign_Obj_Ptr; + procedure Create_Object (El : Iir) is Obj_Type : O_Tnode; @@ -120,8 +175,7 @@ package body Trans.Chap4 is else Info.Object_Static := False; Info.Object_Var := Create_Var - (Create_Var_Identifier (El), - Obj_Type, Global_Storage); + (Create_Var_Identifier (El), Obj_Type, Global_Storage); end if; end if; if Get_Deferred_Declaration (El) = Null_Iir @@ -146,19 +200,29 @@ package body Trans.Chap4 is procedure Create_Signal (Decl : Iir) is Sig_Type_Def : constant Iir := Get_Type (Decl); - Sig_Type : O_Tnode; Type_Info : Type_Info_Acc; - Info : Ortho_Info_Acc; + Info : Signal_Info_Acc; begin Chap3.Translate_Object_Subtype (Decl); Type_Info := Get_Info (Sig_Type_Def); - Sig_Type := Get_Object_Type (Type_Info, Mode_Signal); - pragma Assert (Sig_Type /= O_Tnode_Null); - Info := Add_Info (Decl, Kind_Signal); - Info.Signal_Sig := Create_Var (Create_Var_Identifier (Decl), Sig_Type); + Info.Signal_Sig := Create_Var + (Create_Var_Identifier (Decl, "_SIG", 0), + Get_Object_Type (Type_Info, Mode_Signal)); + + if Get_Kind (Decl) = Iir_Kind_Interface_Signal_Declaration then + -- For interfaces, create a pointer so that there is no need to + -- update a copy if the association is collapsed. + Info.Signal_Valp := Create_Var + (Create_Var_Identifier (Decl, "_VALP", 0), + Get_Object_Ptr_Type (Type_Info, Mode_Value)); + else + Info.Signal_Val := Create_Var + (Create_Var_Identifier (Decl, "_VAL", 0), + Get_Object_Type (Type_Info, Mode_Value)); + end if; case Get_Kind (Decl) is when Iir_Kind_Signal_Declaration @@ -176,30 +240,28 @@ package body Trans.Chap4 is is Sig_Type_Def : constant Iir := Get_Type (Decl); Type_Info : constant Type_Info_Acc := Get_Info (Sig_Type_Def); - Sig_Type : constant O_Tnode := Type_Info.Ortho_Type (Mode_Signal); - Info : Ortho_Info_Acc; + Info : Signal_Info_Acc; begin - -- This has been disabled since DECL can have an anonymous subtype, - -- and DECL has no identifiers, which causes translate_object_subtype - -- to crash. - -- Note: DECL can only be a iir_kind_delayed_attribute. - --Chap3.Translate_Object_Subtype (Decl); - pragma Assert (Sig_Type /= O_Tnode_Null); + -- The type of DECL is already known: either bit, or boolean or the + -- type of the prefix. Info := Add_Info (Decl, Kind_Signal); - Info.Signal_Sig := Create_Var (Create_Uniq_Identifier, Sig_Type); + Info.Signal_Sig := Create_Var + (Create_Uniq_Identifier, + Get_Object_Type (Type_Info, Mode_Signal)); + Info.Signal_Val := Create_Var + (Create_Uniq_Identifier, + Get_Object_Type (Type_Info, Mode_Value)); end Create_Implicit_Signal; procedure Create_File_Object (El : Iir_File_Declaration) is - Obj_Type : O_Tnode; + Obj_Type_Def : constant Iir := Get_Type (El); + Obj_Type : constant O_Tnode := + Get_Ortho_Type (Obj_Type_Def, Mode_Value); Info : Ortho_Info_Acc; - Obj_Type_Def : Iir; begin - Obj_Type_Def := Get_Type (El); - Obj_Type := Get_Ortho_Type (Obj_Type_Def, Mode_Value); - Info := Add_Info (El, Kind_Object); Info.Object_Var := Create_Var (Create_Var_Identifier (El), Obj_Type); @@ -207,10 +269,10 @@ package body Trans.Chap4 is procedure Create_Package_Interface (Inter : Iir) is - Info : Ortho_Info_Acc; Pkg : constant Iir := Get_Named_Entity (Get_Uninstantiated_Package_Name (Inter)); Pkg_Info : constant Ortho_Info_Acc := Get_Info (Pkg); + Info : Ortho_Info_Acc; begin Chap2.Instantiate_Info_Package (Inter); Info := Get_Info (Inter); @@ -344,7 +406,7 @@ package body Trans.Chap4 is Obj : Mnode; Assoc : O_Assoc_List; begin - Obj := Chap6.Translate_Name (Decl); + Obj := Chap6.Translate_Name (Decl, Mode_Value); -- Call the Finalizator. Start_Association (Assoc, Info.T.Prot_Final_Subprg); New_Association (Assoc, M2E (Obj)); @@ -569,7 +631,7 @@ package body Trans.Chap4 is V : Mnode; begin Open_Temp; - V := Chap6.Translate_Name (Obj); + V := Chap6.Translate_Name (Obj, Mode_Value); Stabilize (V); Chap3.Gen_Deallocate (New_Value (M2Lp (Chap3.Get_Array_Bounds (V)))); @@ -579,7 +641,7 @@ package body Trans.Chap4 is end; elsif Is_Complex_Type (Type_Info) then Chap3.Gen_Deallocate - (New_Value (M2Lp (Chap6.Translate_Name (Obj)))); + (New_Value (M2Lp (Chap6.Translate_Name (Obj, Mode_Value)))); end if; end Fini_Object; @@ -729,8 +791,9 @@ package body Trans.Chap4 is type O_If_Block_Acc is access O_If_Block; type Elab_Signal_Data is record + Value : Mnode; -- Default value of the signal. - Val : Mnode; + Init_Val : Mnode; -- If statement for a block of signals. If_Stmt : O_If_Block_Acc; -- True if the default value is set. @@ -747,7 +810,6 @@ package body Trans.Chap4 is is Type_Info : constant Type_Info_Acc := Get_Info (Targ_Type); Create_Subprg : O_Dnode; - Conv : O_Tnode; Res : O_Enode; Assoc : O_Assoc_List; Init_Val : O_Enode; @@ -755,6 +817,7 @@ package body Trans.Chap4 is Func : Iir; If_Stmt : O_If_Block; Targ_Ptr : O_Dnode; + Value : Mnode; begin if Data.Check_Null then Targ_Ptr := Create_Temp_Init @@ -768,39 +831,38 @@ package body Trans.Chap4 is Ghdl_Bool_Type)); end if; + -- Set the value. + Value := Stabilize (Data.Value); + if Data.Has_Val then + Init_Val := M2E (Data.Init_Val); + else + Init_Val := Get_Scalar_Initial_Value (Targ_Type); + end if; + New_Assign_Stmt (M2Lv (Value), Init_Val); + + -- Create the signal. case Type_Info.Type_Mode is when Type_Mode_B1 => Create_Subprg := Ghdl_Create_Signal_B1; - Conv := Ghdl_Bool_Type; when Type_Mode_E8 => Create_Subprg := Ghdl_Create_Signal_E8; - Conv := Ghdl_I32_Type; when Type_Mode_E32 => Create_Subprg := Ghdl_Create_Signal_E32; - Conv := Ghdl_I32_Type; when Type_Mode_I32 | Type_Mode_P32 => Create_Subprg := Ghdl_Create_Signal_I32; - Conv := Ghdl_I32_Type; when Type_Mode_P64 | Type_Mode_I64 => Create_Subprg := Ghdl_Create_Signal_I64; - Conv := Ghdl_I64_Type; when Type_Mode_F64 => Create_Subprg := Ghdl_Create_Signal_F64; - Conv := Ghdl_Real_Type; when others => Error_Kind ("elab_signal_non_composite", Targ_Type); end case; - if Data.Has_Val then - Init_Val := M2E (Data.Val); - else - Init_Val := Get_Scalar_Initial_Value (Targ_Type); - end if; - Start_Association (Assoc, Create_Subprg); - New_Association (Assoc, New_Convert_Ov (Init_Val, Conv)); + New_Association + (Assoc, New_Unchecked_Address (M2Lv (Value), Ghdl_Ptr_Type)); if Get_Kind (Targ_Type) in Iir_Kinds_Subtype_Definition then Func := Has_Resolution_Function (Targ_Type); @@ -861,13 +923,20 @@ package body Trans.Chap4 is Res.Already_Resolved := True; end if; end if; - if Data.Has_Val then - if Get_Type_Info (Data.Val).Type_Mode = Type_Mode_Record then - Res.Val := Stabilize (Data.Val); - else - Res.Val := Chap3.Get_Array_Base (Data.Val); - end if; - end if; + case Get_Info (Targ_Type).Type_Mode is + when Type_Mode_Record => + Res.Value := Stabilize (Data.Value); + if Data.Has_Val then + Res.Init_Val := Stabilize (Data.Init_Val); + end if; + when Type_Mode_Arrays => + Res.Value := Chap3.Get_Array_Base (Data.Value); + if Data.Has_Val then + Res.Init_Val := Chap3.Get_Array_Base (Data.Init_Val); + end if; + when others => + raise Internal_Error; + end case; return Res; end Elab_Signal_Prepare_Composite; @@ -882,42 +951,47 @@ package body Trans.Chap4 is end if; end Elab_Signal_Finish_Composite; - function Elab_Signal_Update_Array (Data : Elab_Signal_Data; - Targ_Type : Iir; - Index : O_Dnode) - return Elab_Signal_Data + function Elab_Signal_Update_Array + (Data : Elab_Signal_Data; Targ_Type : Iir; Index : O_Dnode) + return Elab_Signal_Data is + N_Init_Val : Mnode; begin - if not Data.Has_Val then - return Data; + if Data.Has_Val then + N_Init_Val := Chap3.Index_Base (Data.Init_Val, Targ_Type, + New_Obj_Value (Index)); else - return Elab_Signal_Data' - (Val => Chap3.Index_Base (Data.Val, Targ_Type, - New_Obj_Value (Index)), - Has_Val => True, - If_Stmt => null, - Already_Resolved => Data.Already_Resolved, - Check_Null => Data.Check_Null); + N_Init_Val := Mnode_Null; end if; + return Elab_Signal_Data' + (Value => Chap3.Index_Base (Data.Value, Targ_Type, + New_Obj_Value (Index)), + Init_Val => N_Init_Val, + Has_Val => Data.Has_Val, + If_Stmt => null, + Already_Resolved => Data.Already_Resolved, + Check_Null => Data.Check_Null); end Elab_Signal_Update_Array; - function Elab_Signal_Update_Record (Data : Elab_Signal_Data; - Targ_Type : Iir; - El : Iir_Element_Declaration) - return Elab_Signal_Data + function Elab_Signal_Update_Record + (Data : Elab_Signal_Data; Targ_Type : Iir; El : Iir_Element_Declaration) + return Elab_Signal_Data is pragma Unreferenced (Targ_Type); + N_Init_Val : Mnode; begin - if not Data.Has_Val then - return Data; + if Data.Has_Val then + N_Init_Val := Chap6.Translate_Selected_Element (Data.Init_Val, El); else - return Elab_Signal_Data' - (Val => Chap6.Translate_Selected_Element (Data.Val, El), - Has_Val => True, - If_Stmt => null, - Already_Resolved => Data.Already_Resolved, - Check_Null => Data.Check_Null); + N_Init_Val := Mnode_Null; end if; + return Elab_Signal_Data' + (Value => Chap6.Translate_Selected_Element (Data.Value, El), + Init_Val => N_Init_Val, + Has_Val => Data.Has_Val, + If_Stmt => null, + Already_Resolved => Data.Already_Resolved, + Check_Null => Data.Check_Null); end Elab_Signal_Update_Record; procedure Elab_Signal is new Foreach_Non_Composite @@ -936,7 +1010,8 @@ package body Trans.Chap4 is is Sig_Type : constant Iir := Get_Type (Decl); Type_Info : Type_Info_Acc; - Name_Node : Mnode; + Name_Sig : Mnode; + Name_Val : Mnode; begin New_Debug_Line_Stmt (Get_Line_Number (Decl)); @@ -946,12 +1021,25 @@ package body Trans.Chap4 is Type_Info := Get_Info (Sig_Type); if Type_Info.Type_Mode = Type_Mode_Fat_Array then - Name_Node := Chap6.Translate_Name (Decl); - Name_Node := Stabilize (Name_Node); - Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Node, Sig_Type); + -- Unbounded types are only allowed for ports; in that case the + -- bounds have already been set. + Chap6.Translate_Signal_Name (Decl, Name_Sig, Name_Val); + Name_Sig := Stabilize (Name_Sig); + Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Sig, Sig_Type); + Name_Val := Stabilize (Name_Val); + Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Val, Sig_Type); elsif Is_Complex_Type (Type_Info) then - Name_Node := Chap6.Translate_Name (Decl); - Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Node); + Chap6.Translate_Signal_Name (Decl, Name_Sig, Name_Val); + Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Sig); + Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Val); + elsif Get_Kind (Decl) = Iir_Kind_Interface_Signal_Declaration then + -- A port that isn't collapsed. Allocate value. + Name_Val := Chap6.Translate_Name (Decl, Mode_Value); + New_Assign_Stmt + (M2Lp (Name_Val), + Gen_Alloc (Alloc_System, + Chap3.Get_Object_Size (Name_Val, Sig_Type), + Type_Info.Ortho_Ptr_Type (Mode_Value))); end if; Close_Temp; @@ -981,7 +1069,8 @@ package body Trans.Chap4 is -- Copy bounds from signal. New_Assign_Stmt (M2Lp (Chap3.Get_Array_Bounds (Name_Node)), - M2Addr (Chap3.Get_Array_Bounds (Chap6.Translate_Name (Decl)))); + M2Addr (Chap3.Get_Array_Bounds + (Chap6.Translate_Name (Decl, Mode_Signal)))); -- Allocate base. Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Node, Sig_Type); elsif Is_Complex_Type (Type_Info) then @@ -1003,7 +1092,8 @@ package body Trans.Chap4 is Decl : constant Iir := Strip_Denoting_Name (Sig); Sig_Type : constant Iir := Get_Type (Sig); Base_Decl : constant Iir := Get_Object_Prefix (Sig); - Name_Node : Mnode; + Name_Sig : Mnode; + Name_Val : Mnode; Value : Iir; Data : Elab_Signal_Data; begin @@ -1017,18 +1107,18 @@ package body Trans.Chap4 is begin Start_Association (Assoc, Ghdl_Signal_Name_Rti); New_Association - (Assoc, - New_Lit (New_Global_Unchecked_Address - (Get_Info (Base_Decl).Signal_Rti, - Rtis.Ghdl_Rti_Access))); + (Assoc, New_Lit (New_Global_Unchecked_Address + (Get_Info (Base_Decl).Signal_Rti, + Rtis.Ghdl_Rti_Access))); Rtis.Associate_Rti_Context (Assoc, Parent); New_Procedure_Call (Assoc); end; - Name_Node := Chap6.Translate_Name (Decl); + Chap6.Translate_Signal_Name (Decl, Name_Sig, Name_Val); -- Consistency check: a signal name is a signal. - pragma Assert (Get_Object_Kind (Name_Node) = Mode_Signal); + pragma Assert (Get_Object_Kind (Name_Sig) = Mode_Signal); + Data.Value := Name_Val; if Decl = Base_Decl then Data.Already_Resolved := False; Data.Check_Null := Check_Null; @@ -1037,9 +1127,9 @@ package body Trans.Chap4 is Data.Has_Val := False; else Data.Has_Val := True; - Data.Val := E2M (Chap7.Translate_Expression (Value, Sig_Type), - Get_Info (Sig_Type), - Mode_Value); + Data.Init_Val := E2M (Chap7.Translate_Expression (Value, Sig_Type), + Get_Info (Sig_Type), + Mode_Value); end if; else -- Sub signal. @@ -1050,7 +1140,7 @@ package body Trans.Chap4 is Data.Check_Null := False; Value := Null_Iir; end if; - Elab_Signal (Name_Node, Sig_Type, Data); + Elab_Signal (Name_Sig, Sig_Type, Data); Close_Temp; @@ -1094,6 +1184,9 @@ package body Trans.Chap4 is Error_Kind ("elab_signal_attribute", Decl); end case; Start_Association (Assoc, Subprg); + New_Association (Assoc, + New_Unchecked_Address (Get_Var (Info.Signal_Val), + Ghdl_Ptr_Type)); case Get_Kind (Decl) is when Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute => @@ -1113,13 +1206,20 @@ package body Trans.Chap4 is -- Register all signals this depends on. Prefix := Get_Prefix (Decl); - Prefix_Node := Chap6.Translate_Name (Prefix); + Prefix_Node := Chap6.Translate_Name (Prefix, Mode_Signal); Register_Signal (Prefix_Node, Get_Type (Prefix), Ghdl_Signal_Attribute_Register_Prefix); end Elab_Signal_Attribute; type Delayed_Signal_Data is record + -- Value part of the signal. The signal itself is passed by a + -- parameter. + Targ_Val : Mnode; + + -- Prefix signal. Pfx : Mnode; + + -- Delay time. Param : Iir; end record; @@ -1135,6 +1235,9 @@ package body Trans.Chap4 is New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Data.Pfx)), Ghdl_Signal_Ptr)); + New_Association + (Assoc, + New_Unchecked_Address (M2Lv (Data.Targ_Val), Ghdl_Ptr_Type)); if Data.Param = Null_Iir then Val := New_Lit (New_Signed_Literal (Std_Time_Otype, 0)); else @@ -1145,7 +1248,7 @@ package body Trans.Chap4 is New_Assign_Stmt (M2Lv (Targ), New_Convert_Ov (New_Function_Call (Assoc), - Type_Info.Ortho_Type (Mode_Signal))); + Type_Info.Ortho_Type (Mode_Signal))); end Create_Delayed_Signal_Noncomposite; function Create_Delayed_Signal_Prepare_Composite @@ -1157,8 +1260,10 @@ package body Trans.Chap4 is begin Res.Param := Data.Param; if Get_Type_Info (Targ).Type_Mode = Type_Mode_Record then + Res.Targ_Val := Stabilize (Data.Targ_Val); Res.Pfx := Stabilize (Data.Pfx); else + Res.Targ_Val := Chap3.Get_Array_Base (Data.Targ_Val); Res.Pfx := Chap3.Get_Array_Base (Data.Pfx); end if; return Res; @@ -1170,8 +1275,10 @@ package body Trans.Chap4 is is begin return Delayed_Signal_Data' - (Pfx => Chap3.Index_Base (Data.Pfx, Targ_Type, - New_Obj_Value (Index)), + (Targ_Val => Chap3.Index_Base (Data.Targ_Val, Targ_Type, + New_Obj_Value (Index)), + Pfx => Chap3.Index_Base (Data.Pfx, Targ_Type, + New_Obj_Value (Index)), Param => Data.Param); end Create_Delayed_Signal_Update_Data_Array; @@ -1179,12 +1286,13 @@ package body Trans.Chap4 is (Data : Delayed_Signal_Data; Targ_Type : Iir; El : Iir_Element_Declaration) - return Delayed_Signal_Data + return Delayed_Signal_Data is pragma Unreferenced (Targ_Type); begin return Delayed_Signal_Data' - (Pfx => Chap6.Translate_Selected_Element (Data.Pfx, El), + (Targ_Val => Chap6.Translate_Selected_Element (Data.Targ_Val, El), + Pfx => Chap6.Translate_Selected_Element (Data.Pfx, El), Param => Data.Param); end Create_Delayed_Signal_Update_Data_Record; @@ -1211,24 +1319,26 @@ package body Trans.Chap4 is is Sig_Type : constant Iir := Get_Type (Decl); Type_Info : constant Type_Info_Acc := Get_Info (Sig_Type); - Name_Node : Mnode; + Name_Sig, Name_Val : Mnode; Pfx_Node : Mnode; Data : Delayed_Signal_Data; begin - Name_Node := Chap6.Translate_Name (Decl); + Chap6.Translate_Signal_Name (Decl, Name_Sig, Name_Val); if Is_Complex_Type (Type_Info) then - Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Node); + Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Sig); + Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Val); -- We cannot stabilize NAME_NODE, since Allocate_Complex_Object -- assign it. - Name_Node := Chap6.Translate_Name (Decl); + Chap6.Translate_Signal_Name (Decl, Name_Sig, Name_Val); end if; - Pfx_Node := Chap6.Translate_Name (Get_Prefix (Decl)); - Data := Delayed_Signal_Data'(Pfx => Pfx_Node, + Pfx_Node := Chap6.Translate_Name (Get_Prefix (Decl), Mode_Signal); + Data := Delayed_Signal_Data'(Targ_Val => Name_Val, + Pfx => Pfx_Node, Param => Get_Parameter (Decl)); - Create_Delayed_Signal (Name_Node, Get_Type (Decl), Data); + Create_Delayed_Signal (Name_Sig, Sig_Type, Data); end Elab_Signal_Delayed_Attribute; procedure Elab_File_Declaration (Decl : Iir_File_Declaration) @@ -1243,8 +1353,7 @@ package body Trans.Chap4 is Info : Type_Info_Acc; begin -- Elaborate the file. - Name := Chap6.Translate_Name (Decl); - pragma Assert (Get_Object_Kind (Name) = Mode_Value); + Name := Chap6.Translate_Name (Decl, Mode_Value); if Is_Text then Start_Association (Constr, Ghdl_Text_File_Elaborate); @@ -1267,7 +1376,7 @@ package body Trans.Chap4 is return; end if; Open_Temp; - Name := Chap6.Translate_Name (Decl); + Name := Chap6.Translate_Name (Decl, Mode_Value); Open_Kind := Get_File_Open_Kind (Decl); if Open_Kind /= Null_Iir then -- VHDL 93 and later. @@ -1305,7 +1414,7 @@ package body Trans.Chap4 is Name : Mnode; begin Open_Temp; - Name := Chap6.Translate_Name (Decl); + Name := Chap6.Translate_Name (Decl, Mode_Value); Stabilize (Name); -- LRM 3.4.1 File Operations @@ -1374,6 +1483,7 @@ package body Trans.Chap4 is Info : Alias_Info_Acc; Tinfo : Type_Info_Acc; Atype : O_Tnode; + Id : Var_Ident_Type; begin Chap3.Translate_Named_Type_Definition (Decl_Type, Get_Identifier (Decl)); @@ -1389,33 +1499,40 @@ package body Trans.Chap4 is end case; Tinfo := Get_Info (Decl_Type); - case Tinfo.Type_Mode is - when Type_Mode_Fat_Array => - -- create an object. - -- At elaboration: copy base from name, copy bounds from type, - -- check for matching bounds. - Atype := Get_Ortho_Type (Decl_Type, Info.Alias_Kind); - when Type_Mode_Array - | Type_Mode_Acc - | Type_Mode_Bounds_Acc => - -- Create an object pointer. - -- At elaboration: copy base from name. - Atype := Tinfo.Ortho_Ptr_Type (Info.Alias_Kind); - when Type_Mode_Scalar => - case Info.Alias_Kind is - when Mode_Signal => - Atype := Tinfo.Ortho_Type (Mode_Signal); - when Mode_Value => - Atype := Tinfo.Ortho_Ptr_Type (Mode_Value); - end case; - when Type_Mode_Record => - -- Create an object pointer. - -- At elaboration: copy base from name. - Atype := Tinfo.Ortho_Ptr_Type (Info.Alias_Kind); - when others => - raise Internal_Error; - end case; - Info.Alias_Var := Create_Var (Create_Var_Identifier (Decl), Atype); + for Mode in Mode_Value .. Info.Alias_Kind loop + case Tinfo.Type_Mode is + when Type_Mode_Fat_Array => + -- create an object. + -- At elaboration: copy base from name, copy bounds from type, + -- check for matching bounds. + Atype := Get_Ortho_Type (Decl_Type, Mode); + when Type_Mode_Array + | Type_Mode_Acc + | Type_Mode_Bounds_Acc => + -- Create an object pointer. + -- At elaboration: copy base from name. + Atype := Tinfo.Ortho_Ptr_Type (Mode); + when Type_Mode_Scalar => + case Mode is + when Mode_Signal => + Atype := Tinfo.Ortho_Type (Mode_Signal); + when Mode_Value => + Atype := Tinfo.Ortho_Ptr_Type (Mode_Value); + end case; + when Type_Mode_Record => + -- Create an object pointer. + -- At elaboration: copy base from name. + Atype := Tinfo.Ortho_Ptr_Type (Mode); + when others => + raise Internal_Error; + end case; + if Mode = Mode_Signal then + Id := Create_Var_Identifier (Decl, "_SIG", 0); + else + Id := Create_Var_Identifier (Decl); + end if; + Info.Alias_Var (Mode) := Create_Var (Id, Atype); + end loop; end Translate_Object_Alias_Declaration; procedure Elab_Object_Alias_Declaration @@ -1426,57 +1543,58 @@ package body Trans.Chap4 is Name : constant Iir := Get_Name (Decl); Name_Type : constant Iir := Get_Type (Name); Alias_Info : constant Alias_Info_Acc := Get_Info (Decl); - Name_Node : Mnode; - Alias_Node : Mnode; - Kind : Object_Kind_Type; + Name_Node : Mnode_Array; begin New_Debug_Line_Stmt (Get_Line_Number (Decl)); Chap3.Elab_Object_Subtype (Decl_Type); - Name_Node := Chap6.Translate_Name (Name); - Kind := Get_Object_Kind (Name_Node); - case Tinfo.Type_Mode is - when Type_Mode_Fat_Array => - Open_Temp; - Stabilize (Name_Node); - Alias_Node := Stabilize - (Get_Var (Alias_Info.Alias_Var, - Tinfo, Alias_Info.Alias_Kind)); - Copy_Fat_Pointer (Alias_Node, Name_Node); - Close_Temp; - when Type_Mode_Array => - Open_Temp; - Stabilize (Name_Node); - New_Assign_Stmt - (Get_Var (Alias_Info.Alias_Var), - M2E (Chap3.Get_Array_Base (Name_Node))); - Chap3.Check_Array_Match (Decl_Type, T2M (Decl_Type, Kind), - Name_Type, Name_Node, - Decl); - Close_Temp; - when Type_Mode_Acc - | Type_Mode_Bounds_Acc => - New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), - M2Addr (Name_Node)); - when Type_Mode_Scalar => - case Alias_Info.Alias_Kind is - when Mode_Value => - New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), - M2Addr (Name_Node)); - when Mode_Signal => - New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), - M2E (Name_Node)); - end case; - when Type_Mode_Record => - Open_Temp; - Stabilize (Name_Node); - New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var), - M2Addr (Name_Node)); - Close_Temp; - when others => - raise Internal_Error; + Open_Temp; + + case Alias_Info.Alias_Kind is + when Mode_Value => + Name_Node (Mode_Value) := Chap6.Translate_Name (Name, Mode_Value); + when Mode_Signal => + Chap6.Translate_Signal_Name + (Name, Name_Node (Mode_Signal), Name_Node (Mode_Value)); end case; + + for Mode in Mode_Value .. Alias_Info.Alias_Kind loop + declare + N : Mnode renames Name_Node (Mode); + A : Var_Type renames Alias_Info.Alias_Var (Mode); + Alias_Node : Mnode; + begin + case Tinfo.Type_Mode is + when Type_Mode_Fat_Array => + Stabilize (N); + Alias_Node := Stabilize (Get_Var (A, Tinfo, Mode)); + Copy_Fat_Pointer (Alias_Node, N); + when Type_Mode_Array => + Stabilize (N); + New_Assign_Stmt (Get_Var (A), + M2E (Chap3.Get_Array_Base (N))); + Chap3.Check_Array_Match (Decl_Type, T2M (Decl_Type, Mode), + Name_Type, N, Decl); + when Type_Mode_Acc + | Type_Mode_Bounds_Acc => + New_Assign_Stmt (Get_Var (A), M2Addr (N)); + when Type_Mode_Scalar => + case Mode is + when Mode_Value => + New_Assign_Stmt (Get_Var (A), M2Addr (N)); + when Mode_Signal => + New_Assign_Stmt (Get_Var (A), M2E (N)); + end case; + when Type_Mode_Record => + Stabilize (N); + New_Assign_Stmt (Get_Var (A), M2Addr (N)); + when others => + raise Internal_Error; + end case; + end; + end loop; + Close_Temp; end Elab_Object_Alias_Declaration; procedure Translate_Port_Chain (Parent : Iir) @@ -2381,7 +2499,6 @@ package body Trans.Chap4 is Inter_List : O_Inter_List; In_Type, Out_Type : Iir; In_Info, Out_Info : Type_Info_Acc; - Itype : O_Tnode; El_List : O_Element_List; Block_Info : constant Block_Info_Acc := Get_Info (Base_Block); Stmt_Info : Block_Info_Acc; @@ -2455,22 +2572,22 @@ package body Trans.Chap4 is Conv_Info.Instantiated_Field := O_Fnode_Null; end if; - -- Add input. - case In_Info.Type_Mode is - when Type_Mode_Thin => - Itype := In_Info.Ortho_Type (Mode_Signal); - when Type_Mode_Fat => - Itype := In_Info.Ortho_Ptr_Type (Mode_Signal); - when Type_Mode_Unknown => - raise Internal_Error; - end case; + -- Add inputs, which is a pointer to the signal. New_Record_Field - (El_List, Conv_Info.In_Field, Get_Identifier ("val_in"), Itype); + (El_List, Conv_Info.In_Sig_Field, Get_Identifier ("sig_in"), + Get_Object_Ptr_Type (In_Info, Mode_Signal)); + New_Record_Field + (El_List, Conv_Info.In_Val_Field, Get_Identifier ("val_in"), + Get_Object_Ptr_Type (In_Info, Mode_Value)); -- Add output. New_Record_Field - (El_List, Conv_Info.Out_Field, Get_Identifier ("val_out"), + (El_List, Conv_Info.Out_Sig_Field, Get_Identifier ("sig_out"), Get_Object_Type (Out_Info, Mode_Signal)); + New_Record_Field + (El_List, Conv_Info.Out_Val_Field, Get_Identifier ("val_out"), + Get_Object_Type (Out_Info, Mode_Value)); + Finish_Record_Type (El_List, Conv_Info.Record_Type); New_Type_Decl (Create_Identifier ("DTYPE"), Conv_Info.Record_Type); Conv_Info.Record_Ptr_Type := New_Access_Type (Conv_Info.Record_Type); @@ -2531,13 +2648,16 @@ package body Trans.Chap4 is end if; -- Read signal value. - E := New_Value_Selected_Acc_Value (New_Obj (Var_Data), - Conv_Info.In_Field); case Mode is when Conv_Mode_In => - R := Chap7.Translate_Signal_Effective_Value (E, In_Type); + V1 := New_Selected_Acc_Value (New_Obj (Var_Data), + Conv_Info.In_Val_Field); + R := M2E (Lop2M (V1, In_Info, Mode_Value)); when Conv_Mode_Out => - R := Chap7.Translate_Signal_Driving_Value (E, In_Type); + V1 := New_Selected_Acc_Value (New_Obj (Var_Data), + Conv_Info.In_Sig_Field); + R := M2E (Lop2M (V1, In_Info, Mode_Signal)); + R := Chap7.Translate_Signal_Driving_Value (R, In_Type); end case; case Get_Kind (Imp) is @@ -2598,9 +2718,8 @@ package body Trans.Chap4 is when Iir_Kind_Type_Conversion => declare - Conv_Type : Iir; + Conv_Type : constant Iir := Get_Type (Imp); begin - Conv_Type := Get_Type (Imp); E := Chap7.Translate_Type_Conversion (R, In_Type, Conv_Type, Assoc); E := Chap7.Translate_Implicit_Conv @@ -2613,14 +2732,16 @@ package body Trans.Chap4 is end case; -- Assign signals. - V1 := New_Selected_Acc_Value (New_Obj (Var_Data), - Conv_Info.Out_Field); - V_Out := Lo2M (V1, Out_Info, Mode_Signal); - case Mode is when Conv_Mode_In => - Chap7.Set_Effective_Value (V_Out, Out_Type, Res); + V1 := New_Selected_Acc_Value (New_Obj (Var_Data), + Conv_Info.Out_Val_Field); + V_Out := Lo2M (V1, Out_Info, Mode_Value); + Chap7.Translate_Assign (V_Out, M2E (Res), Formal, Out_Type, Assoc); when Conv_Mode_Out => + V1 := New_Selected_Acc_Value (New_Obj (Var_Data), + Conv_Info.Out_Sig_Field); + V_Out := Lo2M (V1, Out_Info, Mode_Signal); Chap7.Set_Driving_Value (V_Out, Out_Type, Res); end case; @@ -2681,26 +2802,26 @@ package body Trans.Chap4 is Sig_Out : Iir; Reg_Subprg : O_Dnode; Info : Assoc_Conv_Info; - Ndest : out Mnode) - is - Out_Type : Iir; - Out_Info : Type_Info_Acc; - Ssig : Mnode; + Dest_Sig : out Mnode) + is + Out_Type : constant Iir := Get_Type (Sig_Out); + Out_Info : constant Type_Info_Acc := Get_Info (Out_Type); + In_Type : constant Iir := Get_Type (Sig_In); + In_Info : constant Type_Info_Acc := Get_Info (In_Type); + Src_Sig : Mnode; + Src_Val : Mnode; + Dest_Val : Mnode; Constr : O_Assoc_List; Var_Data : O_Dnode; Data : Elab_Signal_Data; begin - Out_Type := Get_Type (Sig_Out); - Out_Info := Get_Info (Out_Type); - -- Allocate data for the subprogram. Var_Data := Create_Temp (Info.Record_Ptr_Type); New_Assign_Stmt (New_Obj (Var_Data), Gen_Alloc (Alloc_System, - New_Lit (New_Sizeof (Info.Record_Type, - Ghdl_Index_Type)), - Info.Record_Ptr_Type)); + New_Lit (New_Sizeof (Info.Record_Type, Ghdl_Index_Type)), + Info.Record_Ptr_Type)); -- Set instance. New_Assign_Stmt @@ -2731,54 +2852,69 @@ package body Trans.Chap4 is end if; -- Set input. - Ssig := Chap6.Translate_Name (Sig_In); - Ssig := Stabilize (Ssig, True); - - New_Assign_Stmt - (New_Selected_Acc_Value (New_Obj (Var_Data), Info.In_Field), - M2E (Ssig)); + Chap6.Translate_Signal_Name (Sig_In, Src_Sig, Src_Val); + Src_Sig := Stabilize (Src_Sig, True); + + Assign_Obj_Ptr (Lop2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.In_Sig_Field), + In_Info, Mode_Signal), + Src_Sig); + Assign_Obj_Ptr (Lop2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.In_Val_Field), + In_Info, Mode_Value), + Src_Val); -- Create a copy of SIG_OUT. - Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), - Info.Out_Field), - Out_Info, Mode_Signal); - Chap4.Allocate_Complex_Object (Out_Type, Alloc_System, Ndest); + Dest_Sig := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Out_Sig_Field), + Out_Info, Mode_Signal); + Chap4.Allocate_Complex_Object (Out_Type, Alloc_System, Dest_Sig); + Dest_Val := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Out_Val_Field), + Out_Info, Mode_Value); + Chap4.Allocate_Complex_Object (Out_Type, Alloc_System, Dest_Val); -- Note: NDEST will be assigned by ELAB_SIGNAL. - Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), - Info.Out_Field), - Out_Info, Mode_Signal); - Data := Elab_Signal_Data'(Has_Val => False, + Dest_Sig := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Out_Sig_Field), + Out_Info, Mode_Signal); + Dest_Val := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Out_Val_Field), + Out_Info, Mode_Value); + Data := Elab_Signal_Data'(Value => Dest_Val, + Has_Val => False, Already_Resolved => True, - Val => Mnode_Null, + Init_Val => Mnode_Null, Check_Null => False, If_Stmt => null); - Elab_Signal (Ndest, Out_Type, Data); + Elab_Signal (Dest_Sig, Out_Type, Data); - Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), - Info.Out_Field), - Out_Info, Mode_Signal); - Ndest := Stabilize (Ndest, True); + Dest_Sig := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data), + Info.Out_Sig_Field), + Out_Info, Mode_Signal); + Dest_Sig := Stabilize (Dest_Sig, True); -- Register. Start_Association (Constr, Reg_Subprg); New_Association (Constr, New_Lit (New_Subprogram_Address (Info.Subprg, - Ghdl_Ptr_Type))); + Ghdl_Ptr_Type))); New_Association (Constr, New_Convert_Ov (New_Obj_Value (Var_Data), Ghdl_Ptr_Type)); New_Association (Constr, - New_Convert_Ov (M2E (Get_Leftest_Signal (Ssig, Get_Type (Sig_In))), - Ghdl_Signal_Ptr)); - New_Association (Constr, Get_Nbr_Signals (Ssig, Get_Type (Sig_In))); + New_Convert_Ov (M2E (Get_Leftest_Signal (Src_Sig, Get_Type (Sig_In))), + Ghdl_Signal_Ptr)); + New_Association + (Constr, Get_Nbr_Signals (Src_Sig, Get_Type (Sig_In))); New_Association (Constr, - New_Convert_Ov - (M2E (Get_Leftest_Signal (Ndest, Get_Type (Sig_Out))), - Ghdl_Signal_Ptr)); - New_Association (Constr, Get_Nbr_Signals (Ndest, Get_Type (Sig_Out))); + New_Convert_Ov (M2E (Get_Leftest_Signal (Dest_Sig, + Get_Type (Sig_Out))), + Ghdl_Signal_Ptr)); + New_Association + (Constr, Get_Nbr_Signals (Dest_Sig, Get_Type (Sig_Out))); New_Procedure_Call (Constr); end Elab_Conversion; @@ -2786,10 +2922,8 @@ package body Trans.Chap4 is -- In conversion: from actual to formal. procedure Elab_In_Conversion (Assoc : Iir; Ndest : out Mnode) is - Assoc_Info : Assoc_Info_Acc; + Assoc_Info : constant Assoc_Info_Acc := Get_Info (Assoc); begin - Assoc_Info := Get_Info (Assoc); - Elab_Conversion (Get_Actual (Assoc), Get_Formal (Assoc), Ghdl_Signal_In_Conversion, Assoc_Info.Assoc_In, Ndest); @@ -2798,10 +2932,8 @@ package body Trans.Chap4 is -- Out conversion: from formal to actual. procedure Elab_Out_Conversion (Assoc : Iir; Ndest : out Mnode) is - Assoc_Info : Assoc_Info_Acc; + Assoc_Info : constant Assoc_Info_Acc := Get_Info (Assoc); begin - Assoc_Info := Get_Info (Assoc); - Elab_Conversion (Get_Formal (Assoc), Get_Actual (Assoc), Ghdl_Signal_Out_Conversion, Assoc_Info.Assoc_Out, Ndest); diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index 47950b737..f51e3c0a0 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -134,7 +134,7 @@ package body Trans.Chap5 is for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; - Gen_Elab_Disconnect (Chap6.Translate_Name (El), + Gen_Elab_Disconnect (Chap6.Translate_Name (El, Mode_Signal), Get_Type (El), Val); end loop; end Elab_Disconnection_Specification; @@ -155,7 +155,7 @@ package body Trans.Chap5 is ); type Connect_Data is record - Actual_Node : Mnode; + Actual_Sig : Mnode; Actual_Type : Iir; -- Mode of the connection. @@ -167,26 +167,25 @@ package body Trans.Chap5 is -- Connect_effective: FORMAL is set from ACTUAL. -- Connect_Source: ACTUAL is set from FORMAL (source of ACTUAL). - procedure Connect_Scalar (Formal_Node : Mnode; - Formal_Type : Iir; - Data : Connect_Data) + procedure Connect_Scalar + (Formal_Sig : Mnode; Formal_Type : Iir; Data : Connect_Data) is Act_Node, Form_Node : Mnode; begin if Data.By_Copy then - New_Assign_Stmt (M2Lv (Formal_Node), M2E (Data.Actual_Node)); + New_Assign_Stmt (M2Lv (Formal_Sig), M2E (Data.Actual_Sig)); return; end if; case Data.Mode is when Connect_Both => Open_Temp; - Act_Node := Stabilize (Data.Actual_Node, True); - Form_Node := Stabilize (Formal_Node, True); + Act_Node := Stabilize (Data.Actual_Sig, True); + Form_Node := Stabilize (Formal_Sig, True); when Connect_Source | Connect_Effective => - Act_Node := Data.Actual_Node; - Form_Node := Formal_Node; + Act_Node := Data.Actual_Sig; + Form_Node := Formal_Sig; when Connect_Value => null; end case; @@ -221,12 +220,11 @@ package body Trans.Chap5 is if Data.Mode = Connect_Value then declare - Type_Info : Type_Info_Acc; + Type_Info : constant Type_Info_Acc := Get_Info (Formal_Type); Subprg : O_Dnode; Constr : O_Assoc_List; Conv : O_Tnode; begin - Type_Info := Get_Info (Formal_Type); case Type_Info.Type_Mode is when Type_Mode_B1 => Subprg := Ghdl_Signal_Associate_B1; @@ -251,10 +249,10 @@ package body Trans.Chap5 is end case; Start_Association (Constr, Subprg); New_Association (Constr, - New_Convert_Ov (New_Value (M2Lv (Formal_Node)), - Ghdl_Signal_Ptr)); + New_Convert_Ov (New_Value (M2Lv (Formal_Sig)), + Ghdl_Signal_Ptr)); New_Association (Constr, - New_Convert_Ov (M2E (Data.Actual_Node), Conv)); + New_Convert_Ov (M2E (Data.Actual_Sig), Conv)); New_Procedure_Call (Constr); end; end if; @@ -266,33 +264,31 @@ package body Trans.Chap5 is function Connect_Prepare_Data_Composite (Targ : Mnode; Formal_Type : Iir; Data : Connect_Data) - return Connect_Data + return Connect_Data is pragma Unreferenced (Targ, Formal_Type); Res : Connect_Data; - Atype : Iir; + Atype : constant Iir := Get_Base_Type (Data.Actual_Type); begin - Atype := Get_Base_Type (Data.Actual_Type); if Get_Kind (Atype) = Iir_Kind_Record_Type_Definition then Res := Data; - Stabilize (Res.Actual_Node); + Stabilize (Res.Actual_Sig); return Res; else return Data; end if; end Connect_Prepare_Data_Composite; - function Connect_Update_Data_Array (Data : Connect_Data; - Formal_Type : Iir; - Index : O_Dnode) - return Connect_Data + function Connect_Update_Data_Array + (Data : Connect_Data; Formal_Type : Iir; Index : O_Dnode) + return Connect_Data is pragma Unreferenced (Formal_Type); Res : Connect_Data; begin -- FIXME: should check matching elements! - Res := (Actual_Node => - Chap3.Index_Base (Chap3.Get_Array_Base (Data.Actual_Node), + Res := (Actual_Sig => + Chap3.Index_Base (Chap3.Get_Array_Base (Data.Actual_Sig), Data.Actual_Type, New_Obj_Value (Index)), Actual_Type => Get_Element_Subtype (Data.Actual_Type), Mode => Data.Mode, @@ -300,16 +296,15 @@ package body Trans.Chap5 is return Res; end Connect_Update_Data_Array; - function Connect_Update_Data_Record (Data : Connect_Data; - Formal_Type : Iir; - El : Iir_Element_Declaration) - return Connect_Data + function Connect_Update_Data_Record + (Data : Connect_Data; Formal_Type : Iir; El : Iir_Element_Declaration) + return Connect_Data is pragma Unreferenced (Formal_Type); Res : Connect_Data; begin - Res := (Actual_Node => - Chap6.Translate_Selected_Element (Data.Actual_Node, El), + Res := (Actual_Sig => + Chap6.Translate_Selected_Element (Data.Actual_Sig, El), Actual_Type => Get_Type (El), Mode => Data.Mode, By_Copy => Data.By_Copy); @@ -334,49 +329,6 @@ package body Trans.Chap5 is Update_Data_Record => Connect_Update_Data_Record, Finish_Data_Record => Connect_Finish_Data_Composite); - procedure Elab_Unconstrained_Port (Port : Iir; Actual : Iir) - is - Actual_Type : constant Iir := Get_Type (Actual); - Act_Node : Mnode; - Bounds : Mnode; - Tinfo : Type_Info_Acc; - Bound_Var : O_Dnode; - begin - Open_Temp; - if Is_Fully_Constrained_Type (Actual_Type) then - Chap3.Create_Array_Subtype (Actual_Type); - Tinfo := Get_Info (Actual_Type); - Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); - if Get_Alloc_Kind_For_Var (Tinfo.T.Array_Bounds) = Alloc_Stack then - -- We need a copy. - Bound_Var := Create_Temp (Tinfo.T.Bounds_Ptr_Type); - New_Assign_Stmt - (New_Obj (Bound_Var), - Gen_Alloc (Alloc_System, - New_Lit (New_Sizeof (Tinfo.T.Bounds_Type, - Ghdl_Index_Type)), - Tinfo.T.Bounds_Ptr_Type)); - Gen_Memcpy (New_Obj_Value (Bound_Var), - M2Addr (Bounds), - New_Lit (New_Sizeof (Tinfo.T.Bounds_Type, - Ghdl_Index_Type))); - Bounds := Dp2M (Bound_Var, Tinfo, Mode_Value, - Tinfo.T.Bounds_Type, - Tinfo.T.Bounds_Ptr_Type); - end if; - else - Bounds := Chap3.Get_Array_Bounds (Chap6.Translate_Name (Actual)); - end if; - Act_Node := Chap6.Translate_Name (Port); - New_Assign_Stmt - (-- FIXME: this works only because it is not stabilized, - -- and therefore the bounds field is returned and not - -- a pointer to the bounds. - M2Lp (Chap3.Get_Array_Bounds (Act_Node)), - M2Addr (Bounds)); - Close_Temp; - end Elab_Unconstrained_Port; - procedure Elab_Port_Map_Aspect_Assoc (Assoc : Iir; By_Copy : Boolean) is Formal : constant Iir := Get_Formal (Assoc); @@ -384,8 +336,10 @@ package body Trans.Chap5 is Formal_Type : constant Iir := Get_Type (Formal); Actual_Type : constant Iir := Get_Type (Actual); Inter : constant Iir := Get_Association_Interface (Assoc); - Formal_Node : Mnode; - Actual_Node : Mnode; + Formal_Sig : Mnode; + Formal_Val : Mnode; + Actual_Sig : Mnode; + Actual_Val : Mnode; Data : Connect_Data; Mode : Connect_Mode; begin @@ -396,14 +350,13 @@ package body Trans.Chap5 is if Get_In_Conversion (Assoc) = Null_Iir and then Get_Out_Conversion (Assoc) = Null_Iir then - Formal_Node := Chap6.Translate_Name (Formal); - pragma Assert (Get_Object_Kind (Formal_Node) = Mode_Signal); + -- Usual case: without conversions. if Is_Signal_Name (Actual) then -- LRM93 4.3.1.2 -- For a signal of a scalar type, each source is either -- a driver or an OUT, INOUT, BUFFER or LINKAGE port of -- a component instance or of a block statement with - -- which the signalis associated. + -- which the signals associated. -- LRM93 12.6.2 -- For a scalar signal S, the effective value of S is @@ -431,97 +384,74 @@ package body Trans.Chap5 is end case; -- translate actual (abort if not a signal). - Actual_Node := Chap6.Translate_Name (Actual); - if Get_Object_Kind (Actual_Node) /= Mode_Signal then - raise Internal_Error; + Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); + Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); + + if By_Copy then + Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); + Chap6.Translate_Signal_Name (Actual, Actual_Sig, Actual_Val); + + -- Copy pointer to the values. + if Get_Info (Formal_Type).Type_Mode in Type_Mode_Arrays then + New_Assign_Stmt + (M2Lp (Chap3.Get_Array_Base (Formal_Val)), + M2Addr (Chap3.Get_Array_Base (Actual_Val))); + else + New_Assign_Stmt (M2Lp (Formal_Val), M2Addr (Actual_Val)); + end if; + else + Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal); + Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); end if; + else - declare - Actual_Val : O_Enode; - begin - Actual_Val := Chap7.Translate_Expression - (Actual, Formal_Type); - Actual_Node := E2M - (Actual_Val, Get_Info (Formal_Type), Mode_Value); - Mode := Connect_Value; - end; + Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); + Actual_Sig := + E2M (Chap7.Translate_Expression (Actual, Formal_Type), + Get_Info (Formal_Type), Mode_Value); + Mode := Connect_Value; +-- raise Internal_Error; end if; - if Get_Kind (Formal_Type) in Iir_Kinds_Array_Type_Definition - then + if Get_Kind (Formal_Type) in Iir_Kinds_Array_Type_Definition then -- Check length matches. - Stabilize (Formal_Node); - Stabilize (Actual_Node); - Chap3.Check_Array_Match (Formal_Type, Formal_Node, - Actual_Type, Actual_Node, + Stabilize (Formal_Sig); + Stabilize (Actual_Sig); + Chap3.Check_Array_Match (Formal_Type, Formal_Sig, + Actual_Type, Actual_Sig, Assoc); end if; - Data := (Actual_Node => Actual_Node, + Data := (Actual_Sig => Actual_Sig, Actual_Type => Actual_Type, Mode => Mode, By_Copy => By_Copy); - Connect (Formal_Node, Formal_Type, Data); + Connect (Formal_Sig, Formal_Type, Data); else if Get_In_Conversion (Assoc) /= Null_Iir then - Chap4.Elab_In_Conversion (Assoc, Actual_Node); - Formal_Node := Chap6.Translate_Name (Formal); - Data := (Actual_Node => Actual_Node, + Chap4.Elab_In_Conversion (Assoc, Actual_Sig); + Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal); + Data := (Actual_Sig => Actual_Sig, Actual_Type => Formal_Type, Mode => Connect_Effective, By_Copy => False); - Connect (Formal_Node, Formal_Type, Data); + Connect (Formal_Sig, Formal_Type, Data); end if; if Get_Out_Conversion (Assoc) /= Null_Iir then -- flow: FORMAL to ACTUAL - Chap4.Elab_Out_Conversion (Assoc, Formal_Node); - Actual_Node := Chap6.Translate_Name (Actual); - Data := (Actual_Node => Actual_Node, + Chap4.Elab_Out_Conversion (Assoc, Formal_Sig); + Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); + Data := (Actual_Sig => Actual_Sig, Actual_Type => Actual_Type, Mode => Connect_Source, By_Copy => False); - Connect (Formal_Node, Actual_Type, Data); + Connect (Formal_Sig, Actual_Type, Data); end if; end if; Close_Temp; end Elab_Port_Map_Aspect_Assoc; - -- Return TRUE if the collapse_signal_flag is set for each individual - -- association. - function Inherit_Collapse_Flag (Assoc : Iir) return Boolean - is - El : Iir; - begin - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_By_Individual => - El := Get_Individual_Association_Chain (Assoc); - while El /= Null_Iir loop - if Inherit_Collapse_Flag (El) = False then - return False; - end if; - El := Get_Chain (El); - end loop; - return True; - when Iir_Kind_Choice_By_Expression - | Iir_Kind_Choice_By_Range - | Iir_Kind_Choice_By_Name => - El := Assoc; - while El /= Null_Iir loop - if not Inherit_Collapse_Flag (Get_Associated_Expr (Assoc)) - then - return False; - end if; - El := Get_Chain (El); - end loop; - return True; - when Iir_Kind_Association_Element_By_Expression => - return Get_Collapse_Signal_Flag (Assoc); - when others => - Error_Kind ("inherit_collapse_flag", Assoc); - end case; - end Inherit_Collapse_Flag; - procedure Elab_Generic_Map_Aspect (Mapping : Iir) is Assoc : Iir; @@ -539,11 +469,11 @@ package body Trans.Chap5 is begin if Get_Whole_Association_Flag (Assoc) then Chap4.Elab_Object_Storage (Formal); - Targ := Chap6.Translate_Name (Formal); + Targ := Chap6.Translate_Name (Formal, Mode_Value); Chap4.Elab_Object_Init (Targ, Formal, Get_Actual (Assoc)); else - Targ := Chap6.Translate_Name (Formal); + Targ := Chap6.Translate_Name (Formal, Mode_Value); Chap7.Translate_Assign (Targ, Get_Actual (Assoc), Get_Type (Formal)); end if; @@ -616,125 +546,221 @@ package body Trans.Chap5 is end loop; end Elab_Generic_Map_Aspect; + function Alloc_Bounds (Atype : Iir; Alloc : Allocation_Kind) + return Mnode + is + Tinfo : constant Type_Info_Acc := Get_Info (Atype); + Var : O_Dnode; + begin + Var := Create_Temp (Tinfo.T.Bounds_Ptr_Type); + New_Assign_Stmt + (New_Obj (Var), + Gen_Alloc (Alloc, + New_Lit (New_Sizeof (Tinfo.T.Bounds_Type, + Ghdl_Index_Type)), + Tinfo.T.Bounds_Ptr_Type)); + return Dp2M (Var, Tinfo, Mode_Value, + Tinfo.T.Bounds_Type, + Tinfo.T.Bounds_Ptr_Type); + end Alloc_Bounds; + + function Get_Unconstrained_Port_Bounds (Assoc : Iir) return Mnode + is + Actual : constant Iir := Get_Actual (Assoc); + Actual_Type : constant Iir := Get_Type (Actual); + In_Conv : constant Iir := Get_In_Conversion (Assoc); + Out_Conv : constant Iir := Get_Out_Conversion (Assoc); + + function Get_Actual_Bounds (Save : Boolean) return Mnode + is + Tinfo : Type_Info_Acc; + Bounds : Mnode; + Bounds_Copy : Mnode; + begin + if Is_Fully_Constrained_Type (Actual_Type) then + Chap3.Create_Array_Subtype (Actual_Type); + Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); + Tinfo := Get_Info (Actual_Type); + if Save + and then + Get_Alloc_Kind_For_Var (Tinfo.T.Array_Bounds) = Alloc_Stack + then + -- We need a copy. + Bounds_Copy := Alloc_Bounds (Actual_Type, Alloc_System); + Chap3.Copy_Bounds (Bounds_Copy, Bounds, Actual_Type); + return Bounds_Copy; + else + return Bounds; + end if; + else + -- Actual type is unconstrained, but as this is an object reads + -- bounds from the object. + return Chap3.Get_Array_Bounds + (Chap6.Translate_Name (Actual, Mode_Signal)); + end if; + end Get_Actual_Bounds; + + In_Conv_Type : Iir; + Param_Type : Iir; + Res_Type : Iir; + Bounds : Mnode; + Can_Convert : Boolean; + Res : Mnode; + begin + if In_Conv = Null_Iir and then Out_Conv = Null_Iir then + -- The easy and usual case. Get bounds from the actual. + return Get_Actual_Bounds (True); + end if; + + Can_Convert := False; + if In_Conv /= Null_Iir then + In_Conv_Type := Get_Type (In_Conv); + if Is_Fully_Constrained_Type (In_Conv_Type) then + -- The 'in' conversion gives the type. + return Chap3.Get_Array_Type_Bounds (In_Conv_Type); + elsif Get_Kind (In_Conv) = Iir_Kind_Type_Conversion then + -- Convert bounds of the actual. + Can_Convert := True; + else + pragma Assert (Get_Kind (In_Conv) = Iir_Kind_Function_Call); + -- Cannot use anything from the in conversion. + null; + end if; + end if; + if Out_Conv /= Null_Iir then + if Get_Kind (Out_Conv) = Iir_Kind_Function_Call then + Param_Type := Get_Type (Get_Interface_Declaration_Chain + (Get_Implementation (Out_Conv))); + if Is_Fully_Constrained_Type (Param_Type) then + return Chap3.Get_Array_Type_Bounds (Param_Type); + else + pragma Assert (Can_Convert); + null; + end if; + else + pragma Assert (Get_Kind (Out_Conv) = Iir_Kind_Type_Conversion); + -- Automatically convert actual type to the formal type. + Can_Convert := True; + end if; + end if; + + pragma Assert (Can_Convert); + Res_Type := Get_Type (Get_Association_Interface (Assoc)); + Bounds := Get_Actual_Bounds (False); + Res := Alloc_Bounds (Res_Type, Alloc_System); + Chap7.Translate_Type_Conversion_Bounds + (Res, Bounds, Res_Type, Actual_Type, Assoc); + return Res; + end Get_Unconstrained_Port_Bounds; + + -- Set bounds for PORT. + procedure Elab_Unconstrained_Port_Bounds (Port : Iir; Assoc : Iir) + is + Bounds : Mnode; + Act_Node : Mnode; + begin + Open_Temp; + case Iir_Kinds_Association_Element (Get_Kind (Assoc)) is + when Iir_Kind_Association_Element_By_Expression => + if not Get_Whole_Association_Flag (Assoc) then + return; + end if; + Bounds := Get_Unconstrained_Port_Bounds (Assoc); + when Iir_Kind_Association_Element_Open => + declare + Actual_Type : constant Iir := + Get_Type (Get_Default_Value (Port)); + begin + Chap3.Create_Array_Subtype (Actual_Type); + Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); + end; + when Iir_Kind_Association_Element_By_Individual => + declare + Actual_Type : constant Iir := Get_Actual_Type (Assoc); + begin + Chap3.Create_Array_Subtype (Actual_Type); + Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); + end; + end case; + + Stabilize (Bounds); + for K in Object_Kind_Type loop + Act_Node := Chap6.Translate_Name (Port, K); + New_Assign_Stmt + (-- Note: this works only because it is not stabilized, and + -- therefore the bounds field is returned and not a pointer to + -- the bounds. + M2Lp (Chap3.Get_Array_Bounds (Act_Node)), + M2Addr (Bounds)); + end loop; + Close_Temp; + end Elab_Unconstrained_Port_Bounds; + procedure Elab_Port_Map_Aspect (Mapping : Iir; Block_Parent : Iir) is - Assoc : Iir; - Formal : Iir; - Formal_Base : Iir; - Fb_Type : Iir; - Fbt_Info : Type_Info_Acc; - Collapse_Individual : Boolean := False; + Assoc : Iir; begin -- Ports. Assoc := Get_Port_Map_Aspect_Chain (Mapping); while Assoc /= Null_Iir loop - Formal := Get_Formal (Assoc); - Formal_Base := Get_Association_Interface (Assoc); - Fb_Type := Get_Type (Formal_Base); + declare + Formal : constant Iir := Strip_Denoting_Name (Get_Formal (Assoc)); + Formal_Base : constant Iir := Get_Association_Interface (Assoc); + Fb_Type : constant Iir := Get_Type (Formal_Base); + Fbt_Info : constant Type_Info_Acc := Get_Info (Fb_Type); + begin + -- Set bounds of unconstrained ports. + if Fbt_Info.Type_Mode = Type_Mode_Fat_Array then + Open_Temp; + Elab_Unconstrained_Port_Bounds (Formal, Assoc); + Close_Temp; + end if; - Open_Temp; - -- Set bounds of unconstrained ports. - Fbt_Info := Get_Info (Fb_Type); - if Fbt_Info.Type_Mode = Type_Mode_Fat_Array then - case Get_Kind (Assoc) is + -- Allocate storage of ports. + Open_Temp; + case Iir_Kinds_Association_Element (Get_Kind (Assoc)) is + when Iir_Kind_Association_Element_By_Individual + | Iir_Kind_Association_Element_Open => + pragma Assert (Get_Whole_Association_Flag (Assoc)); + Chap4.Elab_Signal_Declaration_Storage (Formal); when Iir_Kind_Association_Element_By_Expression => if Get_Whole_Association_Flag (Assoc) then - Elab_Unconstrained_Port (Formal, Get_Actual (Assoc)); + Chap4.Elab_Signal_Declaration_Storage (Formal); end if; - when Iir_Kind_Association_Element_Open => - declare - Value : constant Iir := Get_Default_Value (Formal_Base); - Actual_Type : constant Iir := Get_Type (Value); - Bounds : Mnode; - Formal_Node : Mnode; - begin - Chap3.Create_Array_Subtype (Actual_Type); - Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); - Formal_Node := Chap6.Translate_Name (Formal); - New_Assign_Stmt - (M2Lp (Chap3.Get_Array_Bounds (Formal_Node)), - M2Addr (Bounds)); - Chap9.Destroy_Types (Value); - end; - when Iir_Kind_Association_Element_By_Individual => - declare - Actual_Type : Iir; - Bounds : Mnode; - Formal_Node : Mnode; - begin - Actual_Type := Get_Actual_Type (Assoc); - Chap3.Create_Array_Subtype (Actual_Type); - Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); - Formal_Node := Chap6.Translate_Name (Formal); - New_Assign_Stmt - (M2Lp (Chap3.Get_Array_Bounds (Formal_Node)), - M2Addr (Bounds)); - end; - when others => - Error_Kind ("elab_map_aspect(2)", Assoc); end case; - end if; - Close_Temp; + Close_Temp; - -- Allocate storage of ports. - Open_Temp; - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_By_Individual - | Iir_Kind_Association_Element_Open => - Chap4.Elab_Signal_Declaration_Storage (Formal); - when Iir_Kind_Association_Element_By_Expression => - if Get_Whole_Association_Flag (Assoc) then - Chap4.Elab_Signal_Declaration_Storage (Formal); - end if; - when others => - Error_Kind ("elab_map_aspect(3)", Assoc); - end case; - Close_Temp; - - -- Create or copy signals. - Open_Temp; - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_By_Expression => - if Get_Whole_Association_Flag (Assoc) then - if Get_Collapse_Signal_Flag (Assoc) then - -- For collapsed association, copy signals. - Elab_Port_Map_Aspect_Assoc (Assoc, True); + -- Create or copy signals. + Open_Temp; + case Iir_Kinds_Association_Element (Get_Kind (Assoc)) is + when Iir_Kind_Association_Element_By_Expression => + if Get_Whole_Association_Flag (Assoc) then + if Get_Collapse_Signal_Flag (Assoc) then + -- For collapsed association, copy signals. + Elab_Port_Map_Aspect_Assoc (Assoc, True); + else + -- Create non-collapsed signals. + Chap4.Elab_Signal_Declaration_Object + (Formal, Block_Parent, False); + -- And associate. + Elab_Port_Map_Aspect_Assoc (Assoc, False); + end if; else - -- Create non-collapsed signals. - Chap4.Elab_Signal_Declaration_Object - (Formal, Block_Parent, False); + -- By sub-element. + -- Either the whole signal is collapsed or it was already + -- created. -- And associate. Elab_Port_Map_Aspect_Assoc (Assoc, False); end if; - else - -- By sub-element. - -- Either the whole signal is collapsed or it was already - -- created. - -- And associate. - Elab_Port_Map_Aspect_Assoc (Assoc, Collapse_Individual); - end if; - when Iir_Kind_Association_Element_Open => - -- Create non-collapsed signals. - Chap4.Elab_Signal_Declaration_Object - (Formal, Block_Parent, False); - when Iir_Kind_Association_Element_By_Individual => - -- Inherit the collapse flag. - -- If it is set for all sub-associations, continue. - -- Otherwise, create signals and do not collapse. - -- FIXME: this may be slightly optimized. - if not Inherit_Collapse_Flag (Assoc) then - -- Create the formal. + when Iir_Kind_Association_Element_Open + | Iir_Kind_Association_Element_By_Individual => + -- Create non-collapsed signals. + pragma Assert (Get_Whole_Association_Flag (Assoc)); Chap4.Elab_Signal_Declaration_Object (Formal, Block_Parent, False); - Collapse_Individual := False; - else - Collapse_Individual := True; - end if; - when others => - Error_Kind ("elab_map_aspect(4)", Assoc); - end case; - Close_Temp; - + end case; + Close_Temp; + end; Assoc := Get_Chain (Assoc); end loop; end Elab_Port_Map_Aspect; diff --git a/src/vhdl/translate/trans-chap5.ads b/src/vhdl/translate/trans-chap5.ads index b959bd318..4912dc224 100644 --- a/src/vhdl/translate/trans-chap5.ads +++ b/src/vhdl/translate/trans-chap5.ads @@ -28,7 +28,7 @@ package Trans.Chap5 is (Spec : Iir_Disconnection_Specification); -- Elab an unconstrained port. - procedure Elab_Unconstrained_Port (Port : Iir; Actual : Iir); + procedure Elab_Unconstrained_Port_Bounds (Port : Iir; Assoc : Iir); procedure Elab_Generic_Map_Aspect (Mapping : Iir); diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index 96453f2d7..51c1a4568 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -738,7 +738,7 @@ package body Trans.Chap6 is end Translate_Slice_Name; function Translate_Interface_Name - (Inter : Iir; Info : Ortho_Info_Acc; Kind : Object_Kind_Type) + (Inter : Iir; Info : Ortho_Info_Acc; Mode : Object_Kind_Type) return Mnode is Type_Info : constant Type_Info_Acc := Get_Info (Get_Type (Inter)); @@ -746,22 +746,31 @@ package body Trans.Chap6 is case Info.Kind is when Kind_Object => -- For a generic. - pragma Assert (Kind = Mode_Value); - return Get_Var (Info.Object_Var, Type_Info, Kind); + pragma Assert (Mode = Mode_Value); + return Get_Var (Info.Object_Var, Type_Info, Mode); when Kind_Signal => -- For a port. - return Get_Var (Info.Signal_Sig, Type_Info, Kind); + if Mode = Mode_Signal then + return Get_Var (Info.Signal_Sig, Type_Info, Mode_Signal); + else + pragma Assert (Info.Signal_Valp /= Null_Var); + if Type_Info.Type_Mode = Type_Mode_Fat_Array then + return Get_Var (Info.Signal_Valp, Type_Info, Mode_Value); + else + return Get_Varp (Info.Signal_Valp, Type_Info, Mode_Value); + end if; + end if; when Kind_Interface => -- For a parameter. - if Info.Interface_Field = O_Fnode_Null then + if Info.Interface_Field (Mode) = O_Fnode_Null then -- Normal case: the parameter was translated as an ortho -- interface. - case Type_Mode_Valid (Type_Info.Type_Mode) is - when Type_Mode_Pass_By_Copy => - return Dv2M (Info.Interface_Node, Type_Info, Kind); - when Type_Mode_Pass_By_Address => + case Info.Interface_Mechanism (Mode) is + when Pass_By_Copy => + return Dv2M (Info.Interface_Decl (Mode), Type_Info, Mode); + when Pass_By_Address => -- Parameter is passed by reference. - return Dp2M (Info.Interface_Node, Type_Info, Kind); + return Dp2M (Info.Interface_Decl (Mode), Type_Info, Mode); end case; else -- The parameter was put somewhere else. @@ -771,7 +780,7 @@ package body Trans.Chap6 is Get_Info (Subprg); Linter : O_Lnode; begin - if Info.Interface_Node = O_Dnode_Null then + if Info.Interface_Decl (Mode) = O_Dnode_Null then -- The parameter is passed via a field of the PARAMS -- record parameter. if Subprg_Info.Subprg_Params_Var = Null_Var then @@ -782,20 +791,20 @@ package body Trans.Chap6 is Linter := Get_Var (Subprg_Info.Subprg_Params_Var); end if; Linter := New_Selected_Element - (New_Acc_Value (Linter), Info.Interface_Field); + (New_Acc_Value (Linter), Info.Interface_Field (Mode)); else -- Unnesting case: the parameter was copied in the -- subprogram frame so that nested subprograms can -- reference it. Use field in FRAME. Linter := New_Selected_Element (Get_Instance_Ref (Subprg_Info.Subprg_Frame_Scope), - Info.Interface_Field); + Info.Interface_Field (Mode)); end if; - case Type_Mode_Valid (Type_Info.Type_Mode) is - when Type_Mode_Pass_By_Copy => - return Lv2M (Linter, Type_Info, Kind); - when Type_Mode_Pass_By_Address => - return Lp2M (Linter, Type_Info, Kind); + case Info.Interface_Mechanism (Mode) is + when Pass_By_Copy => + return Lv2M (Linter, Type_Info, Mode); + when Pass_By_Address => + return Lp2M (Linter, Type_Info, Mode); end case; end; end if; @@ -804,9 +813,8 @@ package body Trans.Chap6 is end case; end Translate_Interface_Name; - function Translate_Selected_Element (Prefix : Mnode; - El : Iir_Element_Declaration) - return Mnode + function Translate_Selected_Element + (Prefix : Mnode; El : Iir_Element_Declaration) return Mnode is El_Info : constant Field_Info_Acc := Get_Info (El); El_Type : constant Iir := Get_Type (El); @@ -895,7 +903,7 @@ package body Trans.Chap6 is -- end case; -- end Translate_Formal_Name; - function Translate_Name (Name : Iir) return Mnode + function Translate_Name (Name : Iir; Mode : Object_Kind_Type) return Mnode is Name_Type : constant Iir := Get_Type (Name); Name_Info : constant Ortho_Info_Acc := Get_Info (Name); @@ -903,13 +911,15 @@ package body Trans.Chap6 is begin case Get_Kind (Name) is when Iir_Kind_Constant_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_File_Declaration => + | Iir_Kind_Variable_Declaration + | Iir_Kind_File_Declaration => + pragma Assert (Mode = Mode_Value); return Get_Var (Name_Info.Object_Var, Type_Info, Mode_Value); when Iir_Kind_Attribute_Name => - return Translate_Name (Get_Named_Entity (Name)); + return Translate_Name (Get_Named_Entity (Name), Mode); when Iir_Kind_Attribute_Value => + pragma Assert (Mode = Mode_Value); return Get_Var (Get_Info (Get_Attribute_Specification (Name)).Object_Var, Type_Info, Mode_Value); @@ -920,23 +930,23 @@ package body Trans.Chap6 is declare R : O_Lnode; begin - R := Get_Var (Name_Info.Alias_Var); + pragma Assert (Mode <= Name_Info.Alias_Kind); case Type_Info.Type_Mode is when Type_Mode_Fat_Array => - return Get_Var (Name_Info.Alias_Var, Type_Info, - Name_Info.Alias_Kind); + return Get_Var (Name_Info.Alias_Var (Mode), Type_Info, + Mode); when Type_Mode_Array | Type_Mode_Record | Type_Mode_Acc | Type_Mode_Bounds_Acc => - R := Get_Var (Name_Info.Alias_Var); - return Lp2M (R, Type_Info, Name_Info.Alias_Kind); + R := Get_Var (Name_Info.Alias_Var (Mode)); + return Lp2M (R, Type_Info, Mode); when Type_Mode_Scalar => - R := Get_Var (Name_Info.Alias_Var); - if Name_Info.Alias_Kind = Mode_Signal then - return Lv2M (R, Type_Info, Name_Info.Alias_Kind); + R := Get_Var (Name_Info.Alias_Var (Mode)); + if Mode = Mode_Signal then + return Lv2M (R, Type_Info, Mode_Signal); else - return Lp2M (R, Type_Info, Name_Info.Alias_Kind); + return Lp2M (R, Type_Info, Mode_Value); end if; when others => raise Internal_Error; @@ -944,35 +954,37 @@ package body Trans.Chap6 is end; when Iir_Kind_Signal_Declaration - | Iir_Kind_Stable_Attribute - | Iir_Kind_Quiet_Attribute - | Iir_Kind_Delayed_Attribute - | Iir_Kind_Transaction_Attribute - | Iir_Kind_Guard_Signal_Declaration => - return Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal); - - when Iir_Kind_Interface_Constant_Declaration => - return Translate_Interface_Name (Name, Name_Info, Mode_Value); - - when Iir_Kind_Interface_File_Declaration => - return Translate_Interface_Name (Name, Name_Info, Mode_Value); + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Guard_Signal_Declaration => + if Mode = Mode_Signal then + return Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal); + else + return Get_Var (Name_Info.Signal_Val, Type_Info, Mode_Value); + end if; - when Iir_Kind_Interface_Variable_Declaration => + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_Interface_Variable_Declaration => + pragma Assert (Mode = Mode_Value); return Translate_Interface_Name (Name, Name_Info, Mode_Value); when Iir_Kind_Interface_Signal_Declaration => - return Translate_Interface_Name (Name, Name_Info, Mode_Signal); + return Translate_Interface_Name (Name, Name_Info, Mode); when Iir_Kind_Indexed_Name => return Translate_Indexed_Name - (Translate_Name (Get_Prefix (Name)), Name); + (Translate_Name (Get_Prefix (Name), Mode), Name); when Iir_Kind_Slice_Name => return Translate_Slice_Name - (Translate_Name (Get_Prefix (Name)), Name); + (Translate_Name (Get_Prefix (Name), Mode), Name); when Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference => + | Iir_Kind_Implicit_Dereference => + pragma Assert (Mode = Mode_Value); declare Prefix : constant Iir := Get_Prefix (Name); Prefix_Type : constant Iir := Get_Type (Prefix); @@ -997,10 +1009,11 @@ package body Trans.Chap6 is when Iir_Kind_Selected_Element => return Translate_Selected_Element - (Translate_Name (Get_Prefix (Name)), + (Translate_Name (Get_Prefix (Name), Mode), Get_Selected_Element (Name)); when Iir_Kind_Function_Call => + pragma Assert (Mode = Mode_Value); -- This can appear as a prefix of a name, therefore, the -- result is always a composite type or an access type. declare @@ -1022,13 +1035,14 @@ package body Trans.Chap6 is end; when Iir_Kind_Image_Attribute => + pragma Assert (Mode = Mode_Value); -- Can appear as a prefix. return E2M (Chap14.Translate_Image_Attribute (Name), Type_Info, Mode_Value); when Iir_Kind_Simple_Name | Iir_Kind_Selected_Name => - return Translate_Name (Get_Named_Entity (Name)); + return Translate_Name (Get_Named_Entity (Name), Mode); when others => Error_Kind ("translate_name", Name); @@ -1058,12 +1072,12 @@ package body Trans.Chap6 is Pfx_Sig : Mnode; Pfx_Drv : Mnode; begin - Translate_Direct_Driver - (Get_Prefix (Name), Pfx_Sig, Pfx_Drv); + Translate_Direct_Driver (Get_Prefix (Name), Pfx_Sig, Pfx_Drv); Translate_Slice_Name_Init (Pfx_Sig, Name, Data); Sig := Translate_Slice_Name_Finish (Data.Prefix_Var, Name, Data); - Drv := Translate_Slice_Name_Finish (Pfx_Drv, Name, Data); + Drv := Translate_Slice_Name_Finish + (Pfx_Drv, Name, Data); end; when Iir_Kind_Indexed_Name => declare @@ -1079,13 +1093,12 @@ package body Trans.Chap6 is end; when Iir_Kind_Selected_Element => declare - El : Iir; + El : constant Iir := Get_Selected_Element (Name); Pfx_Sig : Mnode; Pfx_Drv : Mnode; begin Translate_Direct_Driver (Get_Prefix (Name), Pfx_Sig, Pfx_Drv); - El := Get_Selected_Element (Name); Sig := Translate_Selected_Element (Pfx_Sig, El); Drv := Translate_Selected_Element (Pfx_Drv, El); end; @@ -1093,4 +1106,70 @@ package body Trans.Chap6 is Error_Kind ("translate_direct_driver", Name); end case; end Translate_Direct_Driver; + + procedure Translate_Signal_Name + (Name : Iir; Sig : out Mnode; Val : out Mnode) + is + Name_Type : constant Iir := Get_Type (Name); + Name_Info : constant Ortho_Info_Acc := Get_Info (Name); + Type_Info : constant Type_Info_Acc := Get_Info (Name_Type); + begin + case Get_Kind (Name) is + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + Translate_Signal_Name (Get_Named_Entity (Name), Sig, Val); + when Iir_Kind_Object_Alias_Declaration => + Sig := Translate_Name (Name, Mode_Signal); + Val := Translate_Name (Name, Mode_Value); + when Iir_Kind_Signal_Declaration + | Iir_Kind_Stable_Attribute + | Iir_Kind_Quiet_Attribute + | Iir_Kind_Delayed_Attribute + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Guard_Signal_Declaration => + Sig := Get_Var (Name_Info.Signal_Sig, Type_Info, Mode_Signal); + Val := Get_Var (Name_Info.Signal_Val, Type_Info, Mode_Value); + when Iir_Kind_Interface_Signal_Declaration => + Sig := Translate_Interface_Name (Name, Name_Info, Mode_Signal); + Val := Translate_Interface_Name (Name, Name_Info, Mode_Value); + when Iir_Kind_Slice_Name => + declare + Data : Slice_Name_Data; + Pfx_Sig : Mnode; + Pfx_Val : Mnode; + begin + Translate_Signal_Name + (Get_Prefix (Name), Pfx_Sig, Pfx_Val); + Translate_Slice_Name_Init (Pfx_Sig, Name, Data); + Sig := Translate_Slice_Name_Finish + (Data.Prefix_Var, Name, Data); + Val := Translate_Slice_Name_Finish + (Pfx_Val, Name, Data); + end; + when Iir_Kind_Indexed_Name => + declare + Data : Indexed_Name_Data; + Pfx_Sig : Mnode; + Pfx_Val : Mnode; + begin + Translate_Signal_Name + (Get_Prefix (Name), Pfx_Sig, Pfx_Val); + Data := Translate_Indexed_Name_Init (Pfx_Sig, Name); + Sig := Data.Res; + Val := Translate_Indexed_Name_Finish (Pfx_Val, Name, Data); + end; + when Iir_Kind_Selected_Element => + declare + El : constant Iir := Get_Selected_Element (Name); + Pfx_Sig : Mnode; + Pfx_Val : Mnode; + begin + Translate_Signal_Name (Get_Prefix (Name), Pfx_Sig, Pfx_Val); + Sig := Translate_Selected_Element (Pfx_Sig, El); + Val := Translate_Selected_Element (Pfx_Val, El); + end; + when others => + Error_Kind ("translate_signal_name", Name); + end case; + end Translate_Signal_Name; end Trans.Chap6; diff --git a/src/vhdl/translate/trans-chap6.ads b/src/vhdl/translate/trans-chap6.ads index 3ce60c3a5..0d3b0211f 100644 --- a/src/vhdl/translate/trans-chap6.ads +++ b/src/vhdl/translate/trans-chap6.ads @@ -18,10 +18,12 @@ package Trans.Chap6 is -- Translate NAME. - -- RES contains a lnode for the result. This is the object. - -- RES can be a tree, so it may be referenced only once. - -- SIG is true if RES is a signal object. - function Translate_Name (Name : Iir) return Mnode; + function Translate_Name (Name : Iir; Mode : Object_Kind_Type) return Mnode; + + -- Translate signal NAME. Return both the signal name SIG and the value + -- name VAL. + procedure Translate_Signal_Name + (Name : Iir; Sig : out Mnode; Val : out Mnode); -- Translate signal NAME into its node (SIG) and its direct driver -- node (DRV). @@ -39,14 +41,11 @@ package Trans.Chap6 is -- return Mnode; -- Get record element EL of PREFIX. - function Translate_Selected_Element (Prefix : Mnode; - El : Iir_Element_Declaration) - return Mnode; + function Translate_Selected_Element + (Prefix : Mnode; El : Iir_Element_Declaration) return Mnode; - function Get_Array_Bound_Length (Arr : Mnode; - Arr_Type : Iir; - Dim : Natural) - return O_Enode; + function Get_Array_Bound_Length (Arr : Mnode; Arr_Type : Iir; Dim : Natural) + return O_Enode; procedure Gen_Bound_Error (Loc : Iir); diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 7de8c1c94..8ce2b8aca 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -1937,15 +1937,16 @@ package body Trans.Chap7 is is Enums : constant Iir_List := Get_Enumeration_Literal_List (Get_Base_Type (Get_Type (Left))); - Name : Mnode; + Sig : Mnode; + Val : Mnode; begin - Name := Stabilize (Chap6.Translate_Name (Left), True); + Chap6.Translate_Signal_Name (Left, Sig, Val); return New_Dyadic_Op (ON_And, - New_Value (Chap14.Get_Signal_Field (Name, Ghdl_Signal_Event_Field)), + New_Value (Chap14.Get_Signal_Field (Sig, Ghdl_Signal_Event_Field)), New_Compare_Op (ON_Eq, - New_Value (New_Access_Element (M2E (Name))), + M2E (Val), New_Lit (Get_Ortho_Expr (Get_Nth_Element (Enums, Boolean'Pos (Is_Rising)))), Std_Boolean_Type_Node)); @@ -3485,82 +3486,94 @@ package body Trans.Chap7 is end case; end Translate_Type_Conversion; - function Translate_Fat_Array_Type_Conversion - (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) - return O_Enode + procedure Translate_Type_Conversion_Bounds + (Res : Mnode; Src : Mnode; Res_Type : Iir; Src_Type : Iir; Loc : Iir) is - Res_Info : constant Type_Info_Acc := Get_Info (Res_Type); - Expr_Info : constant Type_Info_Acc := Get_Info (Expr_Type); - Res_Indexes : constant Iir_List := - Get_Index_Subtype_List (Res_Type); - Expr_Indexes : constant Iir_List := - Get_Index_Subtype_List (Expr_Type); - + Res_Indexes : constant Iir_List := Get_Index_Subtype_List (Res_Type); + Src_Indexes : constant Iir_List := Get_Index_Subtype_List (Src_Type); Res_Base_Type : constant Iir := Get_Base_Type (Res_Type); - Expr_Base_Type : constant Iir := Get_Base_Type (Expr_Type); + Src_Base_Type : constant Iir := Get_Base_Type (Src_Type); Res_Base_Indexes : constant Iir_List := Get_Index_Subtype_List (Res_Base_Type); - Expr_Base_Indexes : constant Iir_List := - Get_Index_Subtype_List (Expr_Base_Type); - Res : Mnode; - E : Mnode; - Bounds : O_Dnode; + Src_Base_Indexes : constant Iir_List := + Get_Index_Subtype_List (Src_Base_Type); + R_El : Iir; - E_El : Iir; + S_El : Iir; begin - Res := Create_Temp (Res_Info, Mode_Value); - Bounds := Create_Temp (Res_Info.T.Bounds_Type); - E := Stabilize (E2M (Expr, Expr_Info, Mode_Value)); - Open_Temp; - -- Set base. - New_Assign_Stmt - (M2Lp (Chap3.Get_Array_Base (Res)), - New_Convert_Ov (M2Addr (Chap3.Get_Array_Base (E)), - Res_Info.T.Base_Ptr_Type (Mode_Value))); - -- Set bounds. - New_Assign_Stmt - (M2Lp (Chap3.Get_Array_Bounds (Res)), - New_Address (New_Obj (Bounds), Res_Info.T.Bounds_Ptr_Type)); - -- Convert bounds. for I in Natural loop R_El := Get_Index_Type (Res_Indexes, I); - E_El := Get_Index_Type (Expr_Indexes, I); - exit when R_El = Null_Iir; + S_El := Get_Index_Type (Src_Indexes, I); + exit when S_El = Null_Iir; declare Rb_Ptr : Mnode; - Eb_Ptr : Mnode; + Sb_Ptr : Mnode; Ee : O_Enode; Same_Index_Type : constant Boolean := (Get_Index_Type (Res_Base_Indexes, I) - = Get_Index_Type (Expr_Base_Indexes, I)); + = Get_Index_Type (Src_Base_Indexes, I)); begin Open_Temp; - Rb_Ptr := Stabilize - (Chap3.Get_Array_Range (Res, Res_Type, I + 1)); - Eb_Ptr := Stabilize - (Chap3.Get_Array_Range (E, Expr_Type, I + 1)); + Rb_Ptr := Stabilize (Chap3.Bounds_To_Range (Res, Res_Type, I + 1)); + Sb_Ptr := Stabilize (Chap3.Bounds_To_Range (Src, Src_Type, I + 1)); -- Convert left and right (unless they have the same type - -- this is an optimization but also this deals with null -- array in common cases). - Ee := M2E (Chap3.Range_To_Left (Eb_Ptr)); + Ee := M2E (Chap3.Range_To_Left (Sb_Ptr)); if not Same_Index_Type then - Ee := Translate_Type_Conversion (Ee, E_El, R_El, Loc); + Ee := Translate_Type_Conversion (Ee, S_El, R_El, Loc); end if; New_Assign_Stmt (M2Lv (Chap3.Range_To_Left (Rb_Ptr)), Ee); - Ee := M2E (Chap3.Range_To_Right (Eb_Ptr)); + Ee := M2E (Chap3.Range_To_Right (Sb_Ptr)); if not Same_Index_Type then - Ee := Translate_Type_Conversion (Ee, E_El, R_El, Loc); + Ee := Translate_Type_Conversion (Ee, S_El, R_El, Loc); end if; New_Assign_Stmt (M2Lv (Chap3.Range_To_Right (Rb_Ptr)), Ee); -- Copy Dir and Length. New_Assign_Stmt (M2Lv (Chap3.Range_To_Dir (Rb_Ptr)), - M2E (Chap3.Range_To_Dir (Eb_Ptr))); + M2E (Chap3.Range_To_Dir (Sb_Ptr))); New_Assign_Stmt (M2Lv (Chap3.Range_To_Length (Rb_Ptr)), - M2E (Chap3.Range_To_Length (Eb_Ptr))); + M2E (Chap3.Range_To_Length (Sb_Ptr))); Close_Temp; end; end loop; + end Translate_Type_Conversion_Bounds; + + function Translate_Fat_Array_Type_Conversion + (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) + return O_Enode + is + Res_Info : constant Type_Info_Acc := Get_Info (Res_Type); + Expr_Info : constant Type_Info_Acc := Get_Info (Expr_Type); + + Res : Mnode; + E : Mnode; + Bounds : O_Dnode; + begin + Res := Create_Temp (Res_Info, Mode_Value); + Bounds := Create_Temp (Res_Info.T.Bounds_Type); + + Open_Temp; + E := Stabilize (E2M (Expr, Expr_Info, Mode_Value)); + + -- Set base. + New_Assign_Stmt + (M2Lp (Chap3.Get_Array_Base (Res)), + New_Convert_Ov (M2Addr (Chap3.Get_Array_Base (E)), + Res_Info.T.Base_Ptr_Type (Mode_Value))); + -- Set bounds. + New_Assign_Stmt + (M2Lp (Chap3.Get_Array_Bounds (Res)), + New_Address (New_Obj (Bounds), Res_Info.T.Bounds_Ptr_Type)); + + -- Convert bounds. + Translate_Type_Conversion_Bounds + (Dv2M (Bounds, Res_Info, Mode_Value, + Res_Info.T.Bounds_Type, Res_Info.T.Bounds_Ptr_Type), + Stabilize (Chap3.Get_Array_Bounds (E)), + Res_Type, Expr_Type, Loc); + Close_Temp; return M2E (Res); end Translate_Fat_Array_Type_Conversion; @@ -3598,25 +3611,6 @@ package body Trans.Chap7 is null; end Sig2val_Finish_Data_Composite; - procedure Translate_Signal_Assign_Effective_Non_Composite - (Targ : Mnode; Targ_Type : Iir; Data : Mnode) - is - pragma Unreferenced (Targ_Type); - begin - New_Assign_Stmt (New_Access_Element (M2E (Targ)), M2E (Data)); - end Translate_Signal_Assign_Effective_Non_Composite; - - procedure Translate_Signal_Assign_Effective is new Foreach_Non_Composite - (Data_Type => Mnode, - Composite_Data_Type => Mnode, - Do_Non_Composite => Translate_Signal_Assign_Effective_Non_Composite, - Prepare_Data_Array => Sig2val_Prepare_Composite, - Update_Data_Array => Sig2val_Update_Data_Array, - Finish_Data_Array => Sig2val_Finish_Data_Composite, - Prepare_Data_Record => Sig2val_Prepare_Composite, - Update_Data_Record => Sig2val_Update_Data_Record, - Finish_Data_Record => Sig2val_Finish_Data_Composite); - procedure Translate_Signal_Assign_Driving_Non_Composite (Targ : Mnode; Targ_Type : Iir; Data: Mnode) is begin @@ -3703,22 +3697,6 @@ package body Trans.Chap7 is end if; end Translate_Signal_Value; - -- Get the effective value of a simple signal SIG. - function Read_Signal_Value (Sig : O_Enode; Sig_Type : Iir) return O_Enode - is - pragma Unreferenced (Sig_Type); - begin - return New_Value (New_Access_Element (Sig)); - end Read_Signal_Value; - - -- Get the value of signal SIG. - function Translate_Signal is new Translate_Signal_Value - (Read_Value => Read_Signal_Value); - - function Translate_Signal_Effective_Value - (Sig : O_Enode; Sig_Type : Iir) return O_Enode - renames Translate_Signal; - function Read_Signal_Driving_Value (Sig : O_Enode; Sig_Type : Iir) return O_Enode is begin @@ -3733,9 +3711,6 @@ package body Trans.Chap7 is (Sig : O_Enode; Sig_Type : Iir) return O_Enode renames Translate_Signal_Driving_Value_1; - procedure Set_Effective_Value - (Sig : Mnode; Sig_Type : Iir; Val : Mnode) - renames Translate_Signal_Assign_Effective; procedure Set_Driving_Value (Sig : Mnode; Sig_Type : Iir; Val : Mnode) renames Translate_Signal_Assign_Driving; @@ -3895,16 +3870,7 @@ package body Trans.Chap7 is | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Attribute_Value | Iir_Kind_Attribute_Name => - declare - L : Mnode; - begin - L := Chap6.Translate_Name (Expr); - - Res := M2E (L); - if Get_Object_Kind (L) = Mode_Signal then - Res := Translate_Signal (Res, Expr_Type); - end if; - end; + Res := M2E (Chap6.Translate_Name (Expr, Mode_Value)); when Iir_Kind_Iterator_Declaration => declare @@ -3974,9 +3940,8 @@ package body Trans.Chap7 is when Iir_Kind_Type_Conversion => declare - Conv_Expr : Iir; + Conv_Expr : constant Iir := Get_Expression (Expr); begin - Conv_Expr := Get_Expression (Expr); Res := Translate_Type_Conversion (Translate_Expression (Conv_Expr), Get_Type (Conv_Expr), Expr_Type, Expr); diff --git a/src/vhdl/translate/trans-chap7.ads b/src/vhdl/translate/trans-chap7.ads index 2434c3b54..c2817ab9d 100644 --- a/src/vhdl/translate/trans-chap7.ads +++ b/src/vhdl/translate/trans-chap7.ads @@ -24,17 +24,10 @@ package Trans.Chap7 is function Translate_Signal_Value (Sig : O_Enode; Sig_Type : Iir) return O_Enode; - -- Extract the effective value of SIG. - function Translate_Signal_Effective_Value (Sig : O_Enode; Sig_Type : Iir) - return O_Enode; function Translate_Signal_Driving_Value (Sig : O_Enode; Sig_Type : Iir) return O_Enode; - -- Directly set the effective value of SIG with VAL. - -- Used only by conversion. - procedure Set_Effective_Value - (Sig : Mnode; Sig_Type : Iir; Val : Mnode); - + -- For conversions. procedure Set_Driving_Value (Sig : Mnode; Sig_Type : Iir; Val : Mnode); @@ -85,6 +78,10 @@ package Trans.Chap7 is (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir) return O_Enode; + -- Convert bounds SRC (of type SRC_TYPE) to RES (of type RES_TYPE). + procedure Translate_Type_Conversion_Bounds + (Res : Mnode; Src : Mnode; Res_Type : Iir; Src_Type : Iir; Loc : Iir); + -- Convert range EXPR into ortho tree. -- If RANGE_TYPE /= NULL_IIR, convert bounds to RANGE_TYPE. --function Translate_Range (Expr : Iir; Range_Type : Iir) return O_Enode; diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 6fd794deb..9bedbf369 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -950,7 +950,7 @@ package body Trans.Chap8 is declare Targ_Node : Mnode; begin - Targ_Node := Chap6.Translate_Name (Targ); + Targ_Node := Chap6.Translate_Name (Targ, Mode_Value); Chap3.Translate_Object_Copy (Targ_Node, M2E (Val), Targ_Type); end; end if; @@ -982,7 +982,7 @@ package body Trans.Chap8 is return; end; else - Targ_Node := Chap6.Translate_Name (Target); + Targ_Node := Chap6.Translate_Name (Target, Mode_Value); if Get_Kind (Expr) = Iir_Kind_Aggregate then declare E : O_Enode; @@ -1881,7 +1881,8 @@ package body Trans.Chap8 is New_Association (Assocs, Chap7.Translate_Expression (Get_Actual (F_Assoc))); -- value - Value := Chap6.Translate_Name (Get_Actual (Value_Assoc)); + Value := + Chap6.Translate_Name (Get_Actual (Value_Assoc), Mode_Value); New_Association (Assocs, New_Convert_Ov (M2Addr (Value), Ghdl_Ptr_Type)); -- length. @@ -1920,7 +1921,8 @@ package body Trans.Chap8 is (Assocs, Chap7.Translate_Expression (Get_Actual (Value_Assoc), Formal_Type)); - Length := Chap6.Translate_Name (Get_Actual (Length_Assoc)); + Length := + Chap6.Translate_Name (Get_Actual (Length_Assoc), Mode_Value); New_Assign_Stmt (M2Lv (Length), New_Function_Call (Assocs)); end; when Type_Mode_Unknown @@ -1984,7 +1986,8 @@ package body Trans.Chap8 is Str := Chap7.Translate_Expression (Get_Actual (N_Param), String_Type_Definition); N_Param := Get_Chain (N_Param); - Res := Chap6.Translate_Name (Get_Actual (N_Param)); + Res := + Chap6.Translate_Name (Get_Actual (N_Param), Mode_Value); Start_Association (Assocs, Ghdl_Text_Read_Length); -- compute file parameter (get an index) New_Association @@ -2049,7 +2052,7 @@ package body Trans.Chap8 is Constr : O_Assoc_List; Status : Mnode; begin - Status := Chap6.Translate_Name (Status_Param); + Status := Chap6.Translate_Name (Status_Param, Mode_Value); N_Param := Get_Chain (Param_Chain); File_Param := Get_Actual (N_Param); N_Param := Get_Chain (N_Param); @@ -2147,13 +2150,13 @@ package body Trans.Chap8 is Call_Assoc_Info : Call_Assoc_Info_Acc; Actual : Iir; Act_Type : Iir; - Atype_Info : Type_Info_Acc; Has_Bounds_Field : Boolean; Has_Fat_Pointer_Field : Boolean; Has_Value_Field : Boolean; Has_Ref_Field : Boolean; Object_Kind : Object_Kind_Type; Val_Type : O_Tnode; + Vident : Var_Ident_Type; -- For unconstrained interfaces: -- * create a field for the fat pointer, unless @@ -2288,7 +2291,7 @@ package body Trans.Chap8 is end case; -- For out or inout scalar variable, create a field for the - -- value. + -- actual value. if Actual /= Null_Iir and then (Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration) @@ -2324,44 +2327,88 @@ package body Trans.Chap8 is -- Reference to the actual. Therefore the type of the -- actual must be used (due to a possible conversion or -- function call). - Atype_Info := Get_Info (Act_Type); - Call_Assoc_Info.Call_Assoc_Ref := Create_Var - (Create_Var_Identifier (Inter, "__REF", Num), - Atype_Info.Ortho_Ptr_Type (Object_Kind), - O_Storage_Local); + pragma Assert (Object_Kind = Mode_Value); + declare + Atype_Info : constant Type_Info_Acc := + Get_Info (Act_Type); + Atype_Binfo : Type_Info_Acc; + Ref_Type : O_Tnode; + begin + if Atype_Info /= null then + Ref_Type := Atype_Info.Ortho_Ptr_Type (Object_Kind); + else + -- Type of actual was not yet translated. Possible + -- only for slice. Do it manually. + Atype_Binfo := Get_Info (Get_Base_Type (Act_Type)); + Ref_Type := Atype_Binfo.T.Base_Ptr_Type (Object_Kind); + end if; + Call_Assoc_Info.Call_Assoc_Ref := Create_Var + (Create_Var_Identifier (Inter, "__REF", Num), + Ref_Type, O_Storage_Local); + end; end if; + if Has_Value_Field then - if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then - -- For unconstrained arrays/records: - -- - the array (if the actual is constrained and not - -- complex) - TODO - -- - a pointer to the base. - Val_Type := Ftype_Info.T.Base_Ptr_Type (Object_Kind); - else - -- For constrained arrays/records: - -- - the base if not complex - -- - a pointer to the base, if complex - if Is_Complex_Type (Ftype_Info) then - Val_Type := Ftype_Info.Ortho_Ptr_Type (Object_Kind); + for Mode in Mode_Value .. Object_Kind loop + if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then + -- For unconstrained arrays/records: + -- - the array (if the actual is constrained and not + -- complex) - TODO + -- - a pointer to the base. + Val_Type := Ftype_Info.T.Base_Ptr_Type (Mode); else - Val_Type := Ftype_Info.Ortho_Type (Object_Kind); + -- For constrained arrays/records: + -- - the base if not complex + -- - a pointer to the base, if complex + if Is_Complex_Type (Ftype_Info) then + Val_Type := Ftype_Info.Ortho_Ptr_Type (Mode); + else + Val_Type := Ftype_Info.Ortho_Type (Mode); + end if; end if; - end if; - Call_Assoc_Info.Call_Assoc_Value := Create_Var - (Create_Var_Identifier (Inter, "__VAL", Num), - Val_Type, O_Storage_Local); + case Mode is + when Mode_Value => + Vident := + Create_Var_Identifier (Inter, "__VAL", Num); + when Mode_Signal => + Vident := + Create_Var_Identifier (Inter, "__SIG", Num); + end case; + Call_Assoc_Info.Call_Assoc_Value (Mode) := Create_Var + (Vident, Val_Type, O_Storage_Local); + end loop; end if; + if Has_Bounds_Field then Call_Assoc_Info.Call_Assoc_Bounds := Create_Var (Create_Var_Identifier (Inter, "__BND", Num), Ftype_Info.T.Bounds_Type, O_Storage_Local); end if; + if Has_Fat_Pointer_Field then - Call_Assoc_Info.Call_Assoc_Fat := Create_Var - (Create_Var_Identifier (Inter, "__FAT", Num), - Ftype_Info.Ortho_Type (Object_Kind)); + Call_Assoc_Info.Call_Assoc_Fat (Mode_Value) := Create_Var + (Create_Var_Identifier (Inter, "__FATV", Num), + Ftype_Info.Ortho_Type (Mode_Value)); + if Object_Kind = Mode_Signal then + Call_Assoc_Info.Call_Assoc_Fat (Mode_Signal) := Create_Var + (Create_Var_Identifier (Inter, "__FATS", Num), + Ftype_Info.Ortho_Type (Mode_Signal)); + end if; end if; Num := Num + 1; + + elsif Formal /= Inter + and then + Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration + then + -- The whole signal value is composed of parts and must be + -- updated when it changes (at each cycle is a worst case + -- approximation). Keep pointer to the individual value. + Call_Assoc_Info := Add_Info (Assoc, Kind_Call_Assoc); + Call_Assoc_Info.Call_Assoc_Value (Mode_Value) := Create_Var + (Create_Var_Identifier (Inter, "__VALP", Num), + Ftype_Info.Ortho_Ptr_Type (Mode_Value)); + Num := Num + 1; end if; end; Assoc := Get_Chain (Assoc); @@ -2438,26 +2485,27 @@ package body Trans.Chap8 is function Translate_Individual_Association_Formal (Formal_Name : Iir; Formal_Info : Ortho_Info_Acc; - Inter_Var : Mnode) + Inter_Var : Mnode; + Mode : Object_Kind_Type) return Mnode is - Prev_Node : O_Dnode; + Prev_Decl : O_Dnode; Prev_Field : O_Fnode; Res : Mnode; begin -- Change the formal variable so that it is the local variable -- that will be passed to the subprogram. - Prev_Node := Formal_Info.Interface_Node; - Prev_Field := Formal_Info.Interface_Field; + Prev_Decl := Formal_Info.Interface_Decl (Mode); + Prev_Field := Formal_Info.Interface_Field (Mode); -- We need a pointer since the interface is by reference. - Formal_Info.Interface_Node := M2Dp (Inter_Var); - Formal_Info.Interface_Field := O_Fnode_Null; + Formal_Info.Interface_Decl (Mode) := M2Dp (Inter_Var); + Formal_Info.Interface_Field (Mode) := O_Fnode_Null; - Res := Chap6.Translate_Name (Formal_Name); + Res := Chap6.Translate_Name (Formal_Name, Mode); - Formal_Info.Interface_Node := Prev_Node; - Formal_Info.Interface_Field := Prev_Field; + Formal_Info.Interface_Decl (Mode) := Prev_Decl; + Formal_Info.Interface_Field (Mode) := Prev_Field; return Res; end Translate_Individual_Association_Formal; @@ -2494,6 +2542,7 @@ package body Trans.Chap8 is -- The values of actuals. E_Params : O_Enode_Array (0 .. Nbr_Assoc - 1); + E_Sig_Params : O_Enode_Array (0 .. Nbr_Assoc - 1); -- Only for inout/out variables passed by copy of foreign procedures: -- the copy of the scalar. @@ -2568,6 +2617,7 @@ package body Trans.Chap8 is while El /= Null_Iir loop Params (Pos) := Mnode_Null; E_Params (Pos) := O_Enode_Null; + E_Sig_Params (Pos) := O_Enode_Null; Inout_Params (Pos) := Mnode_Null; declare @@ -2576,19 +2626,32 @@ package body Trans.Chap8 is Formal : constant Iir := Strip_Denoting_Name (Get_Formal (El)); Formal_Type : constant Iir := Get_Type (Formal); Ftype_Info : constant Type_Info_Acc := Get_Info (Formal_Type); - Formal_Info : constant Ortho_Info_Acc := Get_Info (Base_Formal); + Formal_Info : constant Interface_Info_Acc := + Get_Info (Base_Formal); Formal_Object_Kind : constant Object_Kind_Type := Get_Interface_Kind (Base_Formal); Act : Iir; Actual_Type : Iir; In_Conv : Iir; Param : Mnode; + Param_Sig : Mnode; Param_Type : Iir; Val : O_Enode; + Sig : O_Enode; Mval : Mnode; Mode : Iir_Mode; - Ptr : O_Lnode; Bounds : Mnode; + + -- Assign PARAMS field for formal to V. + procedure Assign_Params_Field + (V : O_Enode; Mode : Object_Kind_Type) + is + Ptr : O_Lnode; + begin + Ptr := New_Selected_Element + (Get_Var (Params_Var), Formal_Info.Interface_Field (Mode)); + New_Assign_Stmt (Ptr, V); + end Assign_Params_Field; begin -- To translate user redefined operators, -- translate_operator_function_call creates associations, that @@ -2612,56 +2675,63 @@ package body Trans.Chap8 is when Iir_Kind_Association_Element_By_Individual => Actual_Type := Get_Actual_Type (El); - if Assoc_Info = null then - Param := Create_Temp (Ftype_Info, Formal_Object_Kind); - else + for Mode in Mode_Value .. Formal_Object_Kind loop + -- For individual associations, create a variable + -- containing the whole actual. Each individual + -- association (to the same formal) will set a part of + -- this variable. + if Assoc_Info = null then + Param := Create_Temp (Ftype_Info, Mode); + else + declare + Param_Var : Var_Type; + begin + if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then + Param_Var := Assoc_Info.Call_Assoc_Fat (Mode); + else + Param_Var := Assoc_Info.Call_Assoc_Value (Mode); + end if; + Param := Stabilize + (Get_Var (Param_Var, Ftype_Info, Mode)); + end; + end if; + declare - Param_Var : Var_Type; + Alloc : Allocation_Kind; begin + if Does_Callee_Suspend then + Alloc := Alloc_Return; + else + Alloc := Alloc_Stack; + end if; + if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then - Param_Var := Assoc_Info.Call_Assoc_Fat; + -- Create the constraints and then the object. + -- FIXME: do not allocate bounds. + Chap3.Create_Array_Subtype (Actual_Type); + Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); + Chap3.Translate_Object_Allocation + (Param, Alloc, Formal_Type, Bounds); else - Param_Var := Assoc_Info.Call_Assoc_Value; + -- Create the object. + Chap4.Allocate_Complex_Object + (Formal_Type, Alloc, Param); end if; - Param := Stabilize (Get_Var (Param_Var, Ftype_Info, - Formal_Object_Kind)); end; - end if; - declare - Alloc : Allocation_Kind; - begin - if Does_Callee_Suspend then - Alloc := Alloc_Return; - else - Alloc := Alloc_Stack; - end if; + -- Save the object as it will be used by the following + -- associations. + Last_Individual := Pos; + -- In case of signals, don't keep value, only keep + -- signal (so override the value). + Params (Pos) := Param; - if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then - -- Create the constraints and then the object. - -- FIXME: do not allocate bounds. - Chap3.Create_Array_Subtype (Actual_Type); - Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); - Chap3.Translate_Object_Allocation - (Param, Alloc, Formal_Type, Bounds); - else - -- Create the object. - Chap4.Allocate_Complex_Object - (Formal_Type, Alloc, Param); + if Formal_Info.Interface_Field (Mode) /= O_Fnode_Null + then + -- Set the PARAMS field. + Assign_Params_Field (M2E (Param), Mode); end if; - end; - - -- Save the object as it will be used by the following - -- associations. - Last_Individual := Pos; - Params (Pos) := Param; - - if Formal_Info.Interface_Field /= O_Fnode_Null then - -- Set the PARAMS field. - Ptr := New_Selected_Element - (Get_Var (Params_Var), Formal_Info.Interface_Field); - New_Assign_Stmt (Ptr, M2E (Param)); - end if; + end loop; goto Continue; when others => @@ -2677,17 +2747,25 @@ package body Trans.Chap8 is -- No conversion here. pragma Assert (In_Conv = Null_Iir); Val := Chap7.Translate_Expression (Act, Formal_Type); + Sig := O_Enode_Null; Param_Type := Formal_Type; when Iir_Kind_Interface_Signal_Declaration => -- No conversion. - Param := Chap6.Translate_Name (Act); - Val := M2E (Param); + Chap6.Translate_Signal_Name (Act, Param_Sig, Param); + case Formal_Info.Interface_Mechanism (Mode_Value) is + when Pass_By_Copy => + Val := M2E (Param); + when Pass_By_Address => + Val := M2Addr (Param); + end case; + Sig := M2E (Param_Sig); when Iir_Kind_Interface_Variable_Declaration => Mode := Get_Mode (Base_Formal); + Sig := O_Enode_Null; if Mode = Iir_In_Mode then Val := Chap7.Translate_Expression (Act); else - Param := Chap6.Translate_Name (Act); + Param := Chap6.Translate_Name (Act, Mode_Value); if Base_Formal /= Formal or else Ftype_Info.Type_Mode in Type_Mode_Call_By_Value then @@ -2738,7 +2816,12 @@ package body Trans.Chap8 is if Param_Type /= Formal_Type then -- Implicit array conversion or subtype check. Val := Chap7.Translate_Implicit_Conv - (Val, Param_Type, Formal_Type, Formal_Object_Kind, Act); + (Val, Param_Type, Formal_Type, Mode_Value, Act); + if Sig /= O_Enode_Null then + -- FIXME: convert without checking. + Sig := Chap7.Translate_Implicit_Conv + (Sig, Param_Type, Formal_Type, Mode_Signal, Act); + end if; end if; if Get_Kind (Base_Formal) /= Iir_Kind_Interface_Signal_Declaration then @@ -2747,106 +2830,140 @@ package body Trans.Chap8 is -- Assign actual, if needed. if Base_Formal /= Formal then - -- Individual association: assign the individual actual to + -- Individual association: assign the individual actual of -- the whole actual. Param := Translate_Individual_Association_Formal - (Formal, Formal_Info, Params (Last_Individual)); - Chap7.Translate_Assign - (Param, Val, Act, Formal_Type, El); + (Formal, Formal_Info, Params (Last_Individual), + Formal_Object_Kind); + if Formal_Object_Kind = Mode_Value then + Chap7.Translate_Assign (Param, Val, Act, Formal_Type, El); + else + Chap7.Translate_Assign (Param, Sig, Act, Formal_Type, El); + if Is_Suspendable then + -- Keep reference to the value to update the whole object + -- at each call. + New_Assign_Stmt + (Get_Var (Assoc_Info.Call_Assoc_Value (Mode_Value)), + Val); + else + -- Assign the value to the whole object, as there is + -- only one call. + Param := Translate_Individual_Association_Formal + (Formal, Formal_Info, Params (Last_Individual), + Mode_Value); + Chap7.Translate_Assign (Param, Val, Act, Formal_Type, El); + end if; + end if; elsif Assoc_Info /= null then + -- For suspendable caller, write the actual to the state + -- record. In some cases (like expressions), the value has + -- to be copied (it may be the result of a computation). + -- Only for whole association. pragma Assert (Base_Formal = Formal); - Mval := Stabilize - (E2M (Val, Ftype_Info, Formal_Object_Kind), True); - - declare - Fat : Mnode; - Bnd : Mnode; - begin - - if Assoc_Info.Call_Assoc_Fat /= Null_Var then - -- Fat pointer. VAL is a pointer to a fat pointer, so - -- copy the fat pointer to the FAT field, and set the - -- PARAM field to FAT field. - Fat := Stabilize - (Get_Var (Assoc_Info.Call_Assoc_Fat, - Ftype_Info, Formal_Object_Kind)); - - -- Set PARAM field to the address of the FAT field. - pragma Assert - (Formal_Info.Interface_Field /= O_Fnode_Null); - New_Assign_Stmt - (New_Selected_Element (Get_Var (Params_Var), - Formal_Info.Interface_Field), - M2E (Fat)); + for Mode in Mode_Value .. Formal_Object_Kind loop + if Mode = Mode_Value then + Mval := Stabilize + (E2M (Val, Ftype_Info, Mode_Value), True); + else + Mval := Stabilize + (E2M (Sig, Ftype_Info, Mode_Signal), True); + end if; - if Assoc_Info.Call_Assoc_Bounds = Null_Var then - Copy_Fat_Pointer (Fat, Mval); - else - -- Copy the bounds. - Bnd := Stabilize - (Lv2M (Get_Var (Assoc_Info.Call_Assoc_Bounds), - Ftype_Info, Formal_Object_Kind, - Ftype_Info.T.Bounds_Type, - Ftype_Info.T.Bounds_Ptr_Type)); - Chap3.Copy_Bounds (Bnd, Chap3.Get_Array_Bounds (Mval), - Formal_Type); - New_Assign_Stmt - (M2Lp (Chap3.Get_Array_Bounds (Fat)), - M2Addr (Bnd)); - New_Assign_Stmt - (M2Lp (Chap3.Get_Array_Base (Fat)), - M2Addr (Chap3.Get_Array_Base (Mval))); + declare + Fat : Mnode; + Bnd : Mnode; + begin + if Assoc_Info.Call_Assoc_Fat (Mode) /= Null_Var then + -- pragma Assert (Sig = O_Enode_Null); -- TODO + -- Fat pointer. VAL is a pointer to a fat pointer, so + -- copy the fat pointer to the FAT field, and set the + -- PARAM field to FAT field. + Fat := Stabilize + (Get_Var (Assoc_Info.Call_Assoc_Fat (Mode), + Ftype_Info, Mode)); + + -- Set PARAM field to the address of the FAT field. + pragma Assert (Formal_Info.Interface_Field (Mode) + /= O_Fnode_Null); + Assign_Params_Field (M2E (Fat), Mode); + + if Assoc_Info.Call_Assoc_Bounds /= Null_Var then + -- Copy the bounds. + Bnd := Stabilize + (Lv2M (Get_Var (Assoc_Info.Call_Assoc_Bounds), + Ftype_Info, Mode_Value, + Ftype_Info.T.Bounds_Type, + Ftype_Info.T.Bounds_Ptr_Type)); + Chap3.Copy_Bounds + (Bnd, Chap3.Get_Array_Bounds (Mval), Formal_Type); + New_Assign_Stmt + (M2Lp (Chap3.Get_Array_Bounds (Fat)), + M2Addr (Bnd)); + New_Assign_Stmt + (M2Lp (Chap3.Get_Array_Base (Fat)), + M2Addr (Chap3.Get_Array_Base (Mval))); + else + -- No need to copy the bounds. + Copy_Fat_Pointer (Fat, Mval); + end if; end if; - end if; - if Assoc_Info.Call_Assoc_Value /= Null_Var then - if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then - pragma Assert (Assoc_Info.Call_Assoc_Fat /= Null_Var); - -- Allocate array base - Param := Fat; - Chap3.Allocate_Fat_Array_Base - (Alloc_Return, Fat, Formal_Type); - -- NOTE: Call_Assoc_Value is not used, the base is - -- directly allocated in the fat pointer. - else - Param := Get_Var (Assoc_Info.Call_Assoc_Value, - Ftype_Info, Formal_Object_Kind); - Stabilize (Param); - Chap4.Allocate_Complex_Object - (Formal_Type, Alloc_Return, Param); - New_Assign_Stmt - (New_Selected_Element (Get_Var (Params_Var), - Formal_Info.Interface_Field), - M2Addr (Param)); + if Mode = Mode_Value + and then + Assoc_Info.Call_Assoc_Value (Mode_Value) /= Null_Var + then + pragma Assert (Sig = O_Enode_Null); -- TODO + + if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then + pragma Assert + (Assoc_Info.Call_Assoc_Fat (Mode) /= Null_Var); + -- Allocate array base + Param := Fat; + Chap3.Allocate_Fat_Array_Base + (Alloc_Return, Fat, Formal_Type); + -- NOTE: Call_Assoc_Value is not used, the base is + -- directly allocated in the fat pointer. + else + Param := Get_Var + (Assoc_Info.Call_Assoc_Value (Mode_Value), + Ftype_Info, Mode_Value); + Stabilize (Param); + Chap4.Allocate_Complex_Object + (Formal_Type, Alloc_Return, Param); + Assign_Params_Field (M2Addr (Param), Mode); + end if; + Chap3.Translate_Object_Copy + (Param, M2E (Mval), Formal_Type); end if; - Chap3.Translate_Object_Copy - (Param, M2E (Mval), Formal_Type); - end if; - end; + end; + end loop; - if Assoc_Info.Call_Assoc_Value = Null_Var - and then Assoc_Info.Call_Assoc_Fat = Null_Var + if Assoc_Info.Call_Assoc_Value (Mode_Value) = Null_Var + and then Assoc_Info.Call_Assoc_Fat (Mode_Value) = Null_Var then + pragma Assert (Sig = O_Enode_Null); -- Not possible. -- Set the PARAMS field. - New_Assign_Stmt - (New_Selected_Element - (Get_Var (Params_Var), Formal_Info.Interface_Field), - M2E (Mval)); + Assign_Params_Field (M2E (Mval), Mode_Value); + end if; + elsif Formal_Info.Interface_Field (Mode_Value) /= O_Fnode_Null then + Assign_Params_Field (Val, Mode_Value); + + if Sig /= O_Enode_Null then + Assign_Params_Field (Sig, Mode_Signal); end if; - elsif Formal_Info.Interface_Field /= O_Fnode_Null then - -- Set the PARAMS field. - Ptr := New_Selected_Element - (Get_Var (Params_Var), Formal_Info.Interface_Field); - New_Assign_Stmt (Ptr, Val); elsif Inout_Params (Pos) /= Mnode_Null then + -- Not for signals. + pragma Assert (Sig = O_Enode_Null); + Chap3.Translate_Object_Copy (Inout_Params (Pos), Val, Formal_Type); E_Params (Pos) := M2Addr (Inout_Params (Pos)); else E_Params (Pos) := Val; + E_Sig_Params (Pos) := Sig; end if; << Continue >> null; @@ -2874,6 +2991,63 @@ package body Trans.Chap8 is -- Call state. State_Jump (Call_State); State_Start (Call_State); + + -- Update signals value in case of individual association. + declare + Base_Formal : Iir; + Formal : Iir; + Formal_Info : Interface_Info_Acc; + Assoc_Info : Call_Assoc_Info_Acc; + Base_Param : Mnode; + Param : Mnode; + Val : O_Lnode; + begin + Open_Temp; + El := Assoc_Chain; + while El /= Null_Iir loop + Base_Formal := Get_Association_Interface (El); + case Get_Kind (El) is + when Iir_Kind_Association_Element_By_Individual => + if Get_Kind (Base_Formal) + = Iir_Kind_Interface_Signal_Declaration + then + -- Get the whole value. + Formal_Info := Get_Info (Base_Formal); + Base_Param := Lp2M + (New_Selected_Element + (Get_Var (Params_Var), + Formal_Info.Interface_Field (Mode_Value)), + Get_Info (Get_Type (Base_Formal)), Mode_Value); + Stabilize (Base_Param); + end if; + when Iir_Kind_Association_Element_By_Expression => + if not Get_Whole_Association_Flag (El) + and then (Get_Kind (Base_Formal) + = Iir_Kind_Interface_Signal_Declaration) + then + Formal := Strip_Denoting_Name (Get_Formal (El)); + Formal_Info := Get_Info (Base_Formal); + Assoc_Info := Get_Info (El); + -- Reference the individual sub-elements of the + -- whole value. + Param := Translate_Individual_Association_Formal + (Formal, Formal_Info, Base_Param, Mode_Value); + Val := Get_Var + (Assoc_Info.Call_Assoc_Value (Mode_Value)); + -- FIXME: that's for scalar. Use Mnode. + Val := New_Acc_Value (Val); + -- Update. + Chap7.Translate_Assign + (Param, New_Value (Val), Get_Actual (El), + Get_Type (Formal), El); + end if; + when others => + null; + end case; + El := Get_Chain (El); + end loop; + Close_Temp; + end; end if; Start_Association (Constr, Info.Ortho_Func); @@ -2892,7 +3066,8 @@ package body Trans.Chap8 is if Obj /= Null_Iir then -- Protected object. - New_Association (Constr, M2E (Chap6.Translate_Name (Obj))); + New_Association + (Constr, M2E (Chap6.Translate_Name (Obj, Mode_Value))); else -- Instance. Subprgs.Add_Subprg_Instance_Assoc (Constr, Info.Subprg_Instance); @@ -2907,7 +3082,7 @@ package body Trans.Chap8 is Base_Formal : constant Iir := Get_Association_Interface (El); Formal_Info : constant Ortho_Info_Acc := Get_Info (Base_Formal); begin - if Formal_Info.Interface_Field = O_Fnode_Null then + if Formal_Info.Interface_Field (Mode_Value) = O_Fnode_Null then -- Not a PARAMS field. if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then @@ -2916,6 +3091,9 @@ package body Trans.Chap8 is elsif Base_Formal = Formal then -- Whole association. New_Association (Constr, E_Params (Pos)); + if E_Sig_Params (Pos) /= O_Enode_Null then + New_Association (Constr, E_Sig_Params (Pos)); + end if; end if; end if; @@ -2965,26 +3143,28 @@ package body Trans.Chap8 is Last_Individual := Pos; declare Assoc_Info : constant Call_Assoc_Info_Acc := Get_Info (El); + Base_Formal : constant Iir := Get_Association_Interface (El); Formal_Type : Iir; - Base_Formal : Iir; Ftype_Info : Type_Info_Acc; - Formal_Object_Kind : Object_Kind_Type; begin - if Assoc_Info /= null then + if Assoc_Info /= null + and then (Get_Kind (Base_Formal) + = Iir_Kind_Interface_Variable_Declaration) + then Formal_Type := Get_Type (Get_Formal (El)); Ftype_Info := Get_Info (Formal_Type); - Base_Formal := Get_Association_Interface (El); - Formal_Object_Kind := Get_Interface_Kind (Base_Formal); + pragma Assert + (Get_Interface_Kind (Base_Formal) = Mode_Value); declare Param_Var : Var_Type; begin if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then - Param_Var := Assoc_Info.Call_Assoc_Fat; + Param_Var := Assoc_Info.Call_Assoc_Fat (Mode_Value); else - Param_Var := Assoc_Info.Call_Assoc_Value; + Param_Var := Assoc_Info.Call_Assoc_Value (Mode_Value); end if; Params (Pos) := Stabilize - (Get_Var (Param_Var, Ftype_Info, Formal_Object_Kind)); + (Get_Var (Param_Var, Ftype_Info, Mode_Value)); end; end if; end; @@ -3012,13 +3192,16 @@ package body Trans.Chap8 is if Base_Formal /= Formal then -- By individual, copy back. Param := Translate_Individual_Association_Formal - (Formal, Formal_Info, Params (Last_Individual)); + (Formal, Formal_Info, Params (Last_Individual), + Mode_Value); elsif Inout_Params (Pos) /= Mnode_Null then Param := Inout_Params (Pos); else - pragma Assert (Formal_Info.Interface_Field /= O_Fnode_Null); + pragma Assert + (Formal_Info.Interface_Field (Mode_Value) /= O_Fnode_Null); Ptr := New_Selected_Element - (Get_Var (Params_Var), Formal_Info.Interface_Field); + (Get_Var (Params_Var), + Formal_Info.Interface_Field (Mode_Value)); case Type_Mode_Valid (Ftype_Info.Type_Mode) is when Type_Mode_Pass_By_Copy => Param := Lv2M (Ptr, Ftype_Info, Mode_Value); @@ -3044,6 +3227,7 @@ package body Trans.Chap8 is Param := Lp2M (Get_Var (Assoc_Info.Call_Assoc_Ref), Get_Info (Actual_Type), Mode_Value); end if; + -- FIXME: scalar check ? Chap7.Translate_Assign (Param, Val, Out_Expr, Actual_Type, El); end; end if; @@ -3666,7 +3850,7 @@ package body Trans.Chap8 is Close_Temp; end; else - Src := Chap6.Translate_Name (Target); + Src := Chap6.Translate_Name (Target, Mode_Signal); Chap3.Translate_Object_Copy (Aggr, M2E (Src), Target_Type); end if; end Translate_Signal_Target_Aggr; @@ -3858,8 +4042,7 @@ package body Trans.Chap8 is Translate_Direct_Signal_Assignment (Stmt, Value); return; end if; - Targ := Chap6.Translate_Name (Target); - pragma Assert (Get_Object_Kind (Targ) = Mode_Signal); + Targ := Chap6.Translate_Name (Target, Mode_Signal); end if; if We = Null_Iir then diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 0736c6dcd..ae6efeac0 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -1302,7 +1302,7 @@ package body Trans.Chap9 is Gen_Register_Direct_Driver (Sig_Node, Get_Type (Sig), Drv_Node); else - Register_Signal (Chap6.Translate_Name (Sig), + Register_Signal (Chap6.Translate_Name (Sig, Mode_Signal), Get_Type (Sig), Ghdl_Process_Add_Driver); end if; @@ -1432,6 +1432,9 @@ package body Trans.Chap9 is -- Create the guard signal. Start_Association (Constr, Ghdl_Signal_Create_Guard); New_Association + (Constr, New_Unchecked_Address (Get_Var (Info.Signal_Val), + Ghdl_Ptr_Type)); + New_Association (Constr, New_Unchecked_Address (Get_Instance_Ref (Block_Info.Block_Scope), Ghdl_Ptr_Type)); New_Association @@ -2050,7 +2053,8 @@ package body Trans.Chap9 is Data.Has_Val := False; end case; - Merge_Signals_Rti (Chap6.Translate_Name (Port), Port_Type, Data); + Merge_Signals_Rti + (Chap6.Translate_Name (Port, Mode_Signal), Port_Type, Data); Close_Temp; Port := Get_Chain (Port); diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb index 6b8b28b49..03e0e8b8b 100644 --- a/src/vhdl/translate/trans-helpers2.adb +++ b/src/vhdl/translate/trans-helpers2.adb @@ -240,7 +240,7 @@ package body Trans.Helpers2 is El := Get_Nth_Element (List, I); exit when El = Null_Iir; Open_Temp; - Sig := Chap6.Translate_Name (El); + Sig := Chap6.Translate_Name (El, Mode_Signal); Register_Signal (Sig, Get_Type (El), Proc); Close_Temp; end loop; @@ -314,4 +314,3 @@ package body Trans.Helpers2 is (Ghdl_I32_Type, Integer_64 (Line)))); end Assoc_Filename_Line; end Trans.Helpers2; - diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index 1ee19ba7d..b72443440 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -1929,7 +1929,7 @@ package body Trans.Rtis is Var := Info.Signal_Sig; when Iir_Kind_Object_Alias_Declaration => Comm := Ghdl_Rtik_Alias; - Var := Info.Alias_Var; + Var := Info.Alias_Var (Info.Alias_Kind); Mode := Object_Kind_Type'Pos (Info.Alias_Kind); when others => Error_Kind ("rti.generate_object", Decl); diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb index c6cbd50c2..93052b9e9 100644 --- a/src/vhdl/translate/trans.adb +++ b/src/vhdl/translate/trans.adb @@ -818,6 +818,12 @@ package body Trans is return Get_Identifier (Nam_Buffer (1 .. Nam_Length + Str'Length)); end Create_Identifier_Without_Prefix; + function Create_Identifier_Without_Prefix + (Id : Iir; Str : String) return O_Ident is + begin + return Create_Identifier_Without_Prefix (Get_Identifier (Id), Str); + end Create_Identifier_Without_Prefix; + -- Create an identifier from IIR node ID with prefix. function Create_Id (Id : Name_Id; Str : String; Is_Local : Boolean) return O_Ident @@ -1089,6 +1095,21 @@ package body Trans is end case; end Get_Var; + function Get_Varp + (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) + return Mnode + is + Stable : Boolean; + begin + -- FIXME: there may be Vv2M and Vp2M. + Stable := Is_Var_Stable (Var); + if Stable then + return Dp2M (Get_Var_Label (Var), Vtype, Mode); + else + return Lp2M (Get_Var (Var), Vtype, Mode); + end if; + end Get_Varp; + function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode is K : constant Object_Kind_Type := M.M1.K; @@ -1730,16 +1751,16 @@ package body Trans is begin New_Assign_Stmt (New_Obj (V), New_Dyadic_Op (ON_Add_Ov, - New_Obj_Value (V), - New_Lit (Ghdl_Index_1))); + New_Obj_Value (V), + New_Lit (Ghdl_Index_1))); end Inc_Var; procedure Dec_Var (V : O_Dnode) is begin New_Assign_Stmt (New_Obj (V), New_Dyadic_Op (ON_Sub_Ov, - New_Obj_Value (V), - New_Lit (Ghdl_Index_1))); + New_Obj_Value (V), + New_Lit (Ghdl_Index_1))); end Dec_Var; procedure Init_Var (V : O_Dnode) is diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index e9a66c177..1a7c2e53f 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -330,8 +330,10 @@ package Trans is -- Create an identifier from IIR node ID without the prefix. function Create_Identifier_Without_Prefix (Id : Iir) return O_Ident; - function Create_Identifier_Without_Prefix (Id : Name_Id; Str : String) - return O_Ident; + function Create_Identifier_Without_Prefix + (Id : Iir; Str : String) return O_Ident; + function Create_Identifier_Without_Prefix + (Id : Name_Id; Str : String) return O_Ident; -- Create an identifier from the current prefix. function Create_Identifier return O_Ident; @@ -683,6 +685,8 @@ package Trans is ); type O_Tnode_Array is array (Object_Kind_Type) of O_Tnode; type O_Fnode_Array is array (Object_Kind_Type) of O_Fnode; + type O_Dnode_Array is array (Object_Kind_Type) of O_Dnode; + type Var_Type_Array is array (Object_Kind_Type) of Var_Type; type Rti_Depth_Type is new Natural range 0 .. 255; @@ -893,6 +897,9 @@ package Trans is -- composite types use the call-by reference convention. For fat accesses, -- a copy of the value is passed by address. + type Call_Mechanism is (Pass_By_Copy, Pass_By_Address); + type Call_Mechanism_Array is array (Object_Kind_Type) of Call_Mechanism; + -- These parameters are passed by copy, ie the argument of the subprogram -- is the value of the object. subtype Type_Mode_Pass_By_Copy is Type_Mode_Type range @@ -1068,8 +1075,10 @@ package Trans is Instantiated_Entity : Iir; -- and its address. Instantiated_Field : O_Fnode; - In_Field : O_Fnode; - Out_Field : O_Fnode; + In_Sig_Field : O_Fnode; + In_Val_Field : O_Fnode; + Out_Sig_Field : O_Fnode; + Out_Val_Field : O_Fnode; Record_Type : O_Tnode; Record_Ptr_Type : O_Tnode; end record; @@ -1204,9 +1213,9 @@ package Trans is Call_Assoc_Ref : Var_Type := Null_Var; -- Variable containing the value, the bounds and the fat vector. - Call_Assoc_Value : Var_Type := Null_Var; + Call_Assoc_Value : Var_Type_Array := (others => Null_Var); Call_Assoc_Bounds : Var_Type := Null_Var; - Call_Assoc_Fat : Var_Type := Null_Var; + Call_Assoc_Fat : Var_Type_Array := (others => Null_Var); when Kind_Object => -- For constants: set when the object is defined as a constant. @@ -1218,7 +1227,9 @@ package Trans is when Kind_Signal => -- The current value of the signal. - Signal_Value : Var_Type := Null_Var; + Signal_Val : Var_Type := Null_Var; + -- Pointer to the value, for ports. + Signal_Valp : Var_Type := Null_Var; -- A pointer to the signal (contains meta data). Signal_Sig : Var_Type; -- Direct driver for signal (if any). @@ -1230,7 +1241,7 @@ package Trans is Signal_Function : O_Dnode := O_Dnode_Null; when Kind_Alias => - Alias_Var : Var_Type; + Alias_Var : Var_Type_Array; Alias_Kind : Object_Kind_Type; when Kind_Iterator => @@ -1244,22 +1255,23 @@ package Trans is Iterator_Range : Var_Type; when Kind_Interface => + -- Call mechanism (by copy or by address) for the interface. + Interface_Mechanism : Call_Mechanism_Array; + -- Ortho declaration for the interface. If not null, there is -- a corresponding ortho parameter for the interface. While -- translating nested subprograms (that are unnested), -- Interface_Field may be set to the corresponding field in the -- FRAME record. So: - -- Node: not null, Field: null: parameter - -- Node: not null, Field: not null: parameter with a copy in + -- Decl: not null, Field: null: parameter + -- Decl: not null, Field: not null: parameter with a copy in -- the FRAME record. - -- Node: null, Field: null: not possible - -- Node: null, Field: not null: field in RESULT record - Interface_Node : O_Dnode := O_Dnode_Null; + -- Decl: null, Field: null: not possible + -- Decl: null, Field: not null: field in RESULT record + Interface_Decl : O_Dnode_Array := (others => O_Dnode_Null); -- Field of the PARAMS record for arguments of procedure. -- In that case, Interface_Node must be null. - Interface_Field : O_Fnode; - -- Type of the interface. - Interface_Type : O_Tnode; + Interface_Field : O_Fnode_Array := (others => O_Fnode_Null); when Kind_Disconnect => -- Variable which contains the time_expression of the @@ -1484,6 +1496,7 @@ package Trans is subtype Incomplete_Type_Info_Acc is Ortho_Info_Acc (Kind_Incomplete_Type); subtype Index_Info_Acc is Ortho_Info_Acc (Kind_Index); subtype Subprg_Info_Acc is Ortho_Info_Acc (Kind_Subprg); + subtype Interface_Info_Acc is Ortho_Info_Acc (Kind_Interface); subtype Call_Info_Acc is Ortho_Info_Acc (Kind_Call); subtype Call_Assoc_Info_Acc is Ortho_Info_Acc (Kind_Call_Assoc); subtype Object_Info_Acc is Ortho_Info_Acc (Kind_Object); @@ -1627,6 +1640,7 @@ package Trans is Vtype => O_Tnode_Null, T => null)); + type Mnode_Array is array (Object_Kind_Type) of Mnode; -- Object kind of a Mnode function Get_Object_Kind (M : Mnode) return Object_Kind_Type; @@ -1634,7 +1648,12 @@ package Trans is -- Transform VAR to Mnode. function Get_Var (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) - return Mnode; + return Mnode; + + -- Likewise, but VAR is a pointer to the value. + function Get_Varp + (Var : Var_Type; Vtype : Type_Info_Acc; Mode : Object_Kind_Type) + return Mnode; -- Return a stabilized node for M. -- The former M is not usuable anymore. diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index d83758418..b593f475b 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -203,7 +203,7 @@ package body Translation is -- Decorate the tree in order to be usable with the internal simulator. procedure Translate (Unit : Iir_Design_Unit; Main : Boolean) is - Design_File : Iir_Design_File; + Design_File : constant Iir_Design_File := Get_Design_File (Unit); El : Iir; Lib : Iir_Library_Declaration; Lib_Mark, Ent_Mark, Sep_Mark, Unit_Mark : Id_Mark_Type; @@ -211,9 +211,8 @@ package body Translation is begin Update_Node_Infos; - Design_File := Get_Design_File (Unit); - if False then + -- No translation for context items. El := Get_Context_Items (Unit); while El /= Null_Iir loop case Get_Kind (El) is @@ -335,7 +334,6 @@ package body Translation is Current_Filename_Node := O_Dnode_Null; Current_Library_Unit := Null_Iir; - --Pop_Global_Factory; if Id /= Null_Identifier then Pop_Identifier_Prefix (Unit_Mark); end if; @@ -759,15 +757,15 @@ package body Translation is Interfaces : O_Inter_List; Param : O_Dnode; begin - -- function __ghdl_create_signal_XXX (init_val : VAL_TYPE) + -- function __ghdl_create_signal_XXX (val_ptr : ghdl_ptr_type; -- resolv_func : ghdl_ptr_type; - -- resolv_inst : ghdl_ptr_type; + -- resolv_inst : ghdl_ptr_type) -- return __ghdl_signal_ptr; Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_create_signal_" & Suffix), O_Storage_External, Ghdl_Signal_Ptr); New_Interface_Decl - (Interfaces, Param, Get_Identifier ("init_val"), Val_Type); + (Interfaces, Param, Get_Identifier ("val_ptr"), Ghdl_Ptr_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("resolv_func"), Ghdl_Ptr_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("resolv_inst"), @@ -1253,7 +1251,7 @@ package body Translation is Start_Uncomplete_Record_Type (Ghdl_Signal_Type, Rec); New_Record_Field (Rec, Ghdl_Signal_Value_Field, Get_Identifier ("value"), - Ghdl_Scalar_Bytes); + Ghdl_Ptr_Type); New_Record_Field (Rec, Ghdl_Signal_Driving_Value_Field, Get_Identifier ("driving_value"), Ghdl_Scalar_Bytes); @@ -1575,32 +1573,40 @@ package body Translation is end; declare - -- function __ghdl_create_XXX_signal (val : std_time) + -- function __ghdl_create_XXX_signal (val_ptr : ghdl_ptr_type; + -- val : std_time) -- return __ghdl_signal_ptr; procedure Create_Signal_Attribute (Name : String; Res : out O_Dnode) is begin Start_Function_Decl (Interfaces, Get_Identifier (Name), O_Storage_External, Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Get_Identifier ("val_ptr"), + Ghdl_Ptr_Type); New_Interface_Decl (Interfaces, Param, Wki_Val, Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Res); end Create_Signal_Attribute; begin - -- function __ghdl_create_stable_signal (val : std_time) + -- function __ghdl_create_stable_signal (val_ptr : ghdl_ptr_type; + -- val : std_time) -- return __ghdl_signal_ptr; Create_Signal_Attribute ("__ghdl_create_stable_signal", Ghdl_Create_Stable_Signal); - -- function __ghdl_create_quiet_signal (val : std_time) + -- function __ghdl_create_quiet_signal (val_ptr : ghdl_ptr_type; + -- val : std_time) -- return __ghdl_signal_ptr; Create_Signal_Attribute ("__ghdl_create_quiet_signal", Ghdl_Create_Quiet_Signal); -- function __ghdl_create_transaction_signal + -- (val_ptr : ghdl_ptr_type) -- return __ghdl_signal_ptr; Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_create_transaction_signal"), O_Storage_External, Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Get_Identifier ("val_ptr"), + Ghdl_Ptr_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Create_Transaction_Signal); end; @@ -1615,6 +1621,7 @@ package body Translation is (Interfaces, Ghdl_Signal_Attribute_Register_Prefix); -- function __ghdl_create_delayed_signal (sig : __ghdl_signal_ptr; + -- val_ptr : ghdl_ptr_type; -- val : std_time) -- return __ghdl_signal_ptr; Start_Function_Decl @@ -1622,23 +1629,26 @@ package body Translation is O_Storage_External, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("sig"), Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Get_Identifier ("val_ptr"), + Ghdl_Ptr_Type); New_Interface_Decl (Interfaces, Param, Wki_Val, Std_Time_Otype); Finish_Subprogram_Decl (Interfaces, Ghdl_Create_Delayed_Signal); -- function __ghdl_signal_create_guard - -- (this : ghdl_ptr_type; + -- (val_ptr : Ghdl_Ptr_type; + -- this : ghdl_ptr_type; -- proc : ghdl_ptr_type; -- instance_name : __ghdl_instance_name_acc) -- return __ghdl_signal_ptr; Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_signal_create_guard"), O_Storage_External, Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Get_Identifier ("val_ptr"), + Ghdl_Ptr_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("this"), Ghdl_Ptr_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("proc"), Ghdl_Ptr_Type); --- New_Interface_Decl (Interfaces, Param, Get_Identifier ("instance_name"), --- Ghdl_Instance_Name_Acc); Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Create_Guard); -- procedure __ghdl_signal_guard_dependence (sig : __ghdl_signal_ptr); |