diff options
Diffstat (limited to 'translate/ghdldrv/ghdlrun.adb')
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 658 |
1 files changed, 658 insertions, 0 deletions
diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb new file mode 100644 index 000000000..df64ebc66 --- /dev/null +++ b/translate/ghdldrv/ghdlrun.adb @@ -0,0 +1,658 @@ +-- GHDL driver - JIT commands. +-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold +-- +-- 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. +with Interfaces.C; + +with Ghdlmain; use Ghdlmain; +with Ghdllocal; use Ghdllocal; +with GNAT.OS_Lib; use GNAT.OS_Lib; + +with Ada.Unchecked_Conversion; +with Ada.Command_Line; +with Ada.Text_IO; + +with Binary_File; use Binary_File; +with Binary_File.Memory; +with Ortho_Mcode; use Ortho_Mcode; +with Ortho_Code.Flags; use Ortho_Code.Flags; +with Binary_File; +with Interfaces; +with System; use System; +with Trans_Decls; +with Ortho_Code.Binary; +with Ortho_Code.Debug; +with Ortho_Code.X86.Emits; +with Types; +with Iirs; use Iirs; +with Flags; +with Back_End; +with Errorout; use Errorout; +with Libraries; +with Canon; +with Trans_Be; +with Translation; +with Std_Names; +with Ieee.Std_Logic_1164; + +with Binary_File.Elf; + +with Lists; +with Str_Table; +with Nodes; +with Files_Map; +with Name_Table; + +with Grt.Main; +with Grt.Lib; +with Grt.Processes; +with Grt.Rtis; +with Grt.Files; +with Grt.Signals; +with Grt.Options; +with Grt.Types; +with Grt.Images; +with Grt.Values; +with Grt.Names; + +with Ghdlcomp; + +package body Ghdlrun is + Snap_Filename : String_Access := null; + + procedure Compile_Init (Analyze_Only : Boolean) is + begin + Back_End.Sem_Foreign := Trans_Be.Sem_Foreign'Access; + + if Analyze_Only then + return; + end if; + + -- Initialize. + Back_End.Finish_Compilation := Trans_Be.Finish_Compilation'Access; + + Setup_Libraries (False); + Libraries.Load_Std_Library; + + Ortho_Mcode.Init; + + Translation.Initialize; + Canon.Canon_Flag_Add_Labels := True; + end Compile_Init; + + procedure Compile_Elab + (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural) + is + begin + Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg); + if Sec_Name = null then + Sec_Name := new String'(""); + end if; + + Flags.Flag_Elaborate := True; + Translation.Chap12.Elaborate (Prim_Name.all, Sec_Name.all, "", True); + + if Errorout.Nbr_Errors > 0 then + -- This may happen (bad entity for example). + raise Compilation_Error; + end if; + + Ortho_Mcode.Finish; + end Compile_Elab; + + -- Set options. + -- This is a little bit over-kill: from C to Ada and then again to C... + procedure Set_Run_Options (Args : Argument_List) + is + use Interfaces.C; + use Grt.Options; + use Grt.Types; + + function Malloc (Size : size_t) return Argv_Type; + pragma Import (C, Malloc); + + function Strdup (Str : String) return Ghdl_C_String; + pragma Import (C, Strdup); +-- is +-- T : Grt.Types.String_Access; +-- begin +-- T := new String'(Str & Ghdllocal.Nul); +-- return To_Ghdl_C_String (T.all'Address); +-- end Strdup; + begin + Argc := 1 + Args'Length; + Argv := Malloc + (size_t (Argc * (Ghdl_C_String'Size / System.Storage_Unit))); + Argv (0) := Strdup (Ada.Command_Line.Command_Name & Ghdllocal.Nul); + Progname := Argv (0); + for I in Args'Range loop + Argv (1 + I - Args'First) := Strdup (Args (I).all & Ghdllocal.Nul); + end loop; + end Set_Run_Options; + + -- Toplevel function, defined by grt. + Flag_String : String (1 .. 5); + pragma Export (C, Flag_String, "__ghdl_flag_string"); + + procedure Ghdl_Elaborate; + pragma Export (C, Ghdl_Elaborate, "__ghdl_ELABORATE"); + + type Elaborate_Acc is access procedure; + Elaborate_Proc : Elaborate_Acc := null; + + procedure Ghdl_Elaborate is + begin + --Ada.Text_IO.Put_Line (Standard_Error, "ghdl_elaborate"); + Elaborate_Proc.all; + end Ghdl_Elaborate; + + Std_Standard_Bit_RTI_Ptr : Address := Null_Address; + + Std_Standard_Boolean_RTI_Ptr : Address := Null_Address; + + pragma Export (C, Std_Standard_Bit_RTI_Ptr, + "std__standard__bit__RTI_ptr"); + + pragma Export (C, Std_Standard_Boolean_RTI_Ptr, + "std__standard__boolean__RTI_ptr"); + + Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address := Null_Address; + pragma Export (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr, + "ieee__std_logic_1164__resolved_RESOLV_ptr"); + + -- From GCC. + function Divdi3 (A, B : Long_Integer) return Long_Integer; + pragma Import (C, Divdi3, "__divdi3"); + + function Muldi3 (A, B : Long_Integer) return Long_Integer; + pragma Import (C, Muldi3, "__muldi3"); + + function Find_Untruncated_Text_Read return O_Dnode + is + use Types; + use Std_Names; + File, Unit, Lib, Decl : Iir; + begin + if Libraries.Std_Library = Null_Iir then + return O_Dnode_Null; + end if; + File := Get_Design_File_Chain (Libraries.Std_Library); + L1 : loop + if File = Null_Iir then + return O_Dnode_Null; + end if; + Unit := Get_First_Design_Unit (File); + while Unit /= Null_Iir loop + Lib := Get_Library_Unit (Unit); + if Get_Kind (Lib) = Iir_Kind_Package_Body + and then Get_Identifier (Lib) = Name_Textio + then + exit L1; + end if; + Unit := Get_Chain (Unit); + end loop; + File := Get_Chain (File); + end loop L1; + + Decl := Get_Declaration_Chain (Lib); + while Decl /= Null_Iir loop + if Get_Kind (Decl) = Iir_Kind_Procedure_Declaration + and then Get_Identifier (Decl) = Name_Untruncated_Text_Read + then + if not Get_Foreign_Flag (Decl) then + raise Program_Error; + end if; + return Translation.Get_Ortho_Decl (Decl); + end if; + Decl := Get_Chain (Decl); + end loop; + return O_Dnode_Null; + end Find_Untruncated_Text_Read; + + procedure Def (Decl : O_Dnode; Addr : Address) + is + use Ortho_Code.Binary; + begin + Binary_File.Memory.Set_Symbol_Address (Get_Decl_Symbol (Decl), Addr); + end Def; + + function Get_Address (Decl : O_Dnode) return Address + is + use Interfaces; + use Ortho_Code.Binary; + + function Conv is new Ada.Unchecked_Conversion + (Source => Unsigned_32, Target => Address); + begin + return Conv (Get_Symbol_Vaddr (Get_Decl_Symbol (Decl))); + end Get_Address; + + procedure Run + is + use Binary_File; + use Interfaces; + use Ortho_Code.Binary; + + function Conv is new Ada.Unchecked_Conversion + (Source => Address, Target => Elaborate_Acc); + Err : Boolean; + Decl : O_Dnode; + begin + if Flag_Verbose then + Ada.Text_IO.Put_Line ("Linking in memory"); + end if; + + if Ortho_Code.Debug.Flag_Debug_Hli then + -- Can't generate code in HLI. + raise Compile_Error; + end if; + + Binary_File.Memory.Write_Memory_Init; + + Def (Trans_Decls.Ghdl_Memcpy, + Grt.Lib.Ghdl_Memcpy'Address); + Def (Trans_Decls.Ghdl_Bound_Check_Failed_L0, + Grt.Lib.Ghdl_Bound_Check_Failed_L0'Address); + Def (Trans_Decls.Ghdl_Bound_Check_Failed_L1, + Grt.Lib.Ghdl_Bound_Check_Failed_L1'Address); + Def (Trans_Decls.Ghdl_Malloc0, + Grt.Lib.Ghdl_Malloc0'Address); + Def (Trans_Decls.Ghdl_Assert_Default_Report, + Grt.Lib.Ghdl_Assert_Default_Report'Address); + + Def (Trans_Decls.Ghdl_Report, + Grt.Lib.Ghdl_Report'Address); + Def (Trans_Decls.Ghdl_Assert_Failed, + Grt.Lib.Ghdl_Assert_Failed'Address); + Def (Trans_Decls.Ghdl_Program_Error, + Grt.Lib.Ghdl_Program_Error'Address); + Def (Trans_Decls.Ghdl_Malloc, + Grt.Lib.Ghdl_Malloc'Address); + Def (Trans_Decls.Ghdl_Deallocate, + Grt.Lib.Ghdl_Deallocate'Address); + Def (Trans_Decls.Ghdl_Real_Exp, + Grt.Lib.Ghdl_Real_Exp'Address); + Def (Trans_Decls.Ghdl_Integer_Exp, + Grt.Lib.Ghdl_Integer_Exp'Address); + + Def (Trans_Decls.Ghdl_Sensitized_Process_Register, + Grt.Processes.Ghdl_Sensitized_Process_Register'Address); + Def (Trans_Decls.Ghdl_Process_Register, + Grt.Processes.Ghdl_Process_Register'Address); + Def (Trans_Decls.Ghdl_Postponed_Sensitized_Process_Register, + Grt.Processes.Ghdl_Postponed_Sensitized_Process_Register'Address); + Def (Trans_Decls.Ghdl_Postponed_Process_Register, + Grt.Processes.Ghdl_Postponed_Process_Register'Address); + Def (Trans_Decls.Ghdl_Stack2_Allocate, + Grt.Processes.Ghdl_Stack2_Allocate'Address); + Def (Trans_Decls.Ghdl_Stack2_Mark, + Grt.Processes.Ghdl_Stack2_Mark'Address); + Def (Trans_Decls.Ghdl_Stack2_Release, + Grt.Processes.Ghdl_Stack2_Release'Address); + Def (Trans_Decls.Ghdl_Process_Wait_Exit, + Grt.Processes.Ghdl_Process_Wait_Exit'Address); + Def (Trans_Decls.Ghdl_Process_Wait_Suspend, + Grt.Processes.Ghdl_Process_Wait_Suspend'Address); + Def (Trans_Decls.Ghdl_Process_Wait_Timeout, + Grt.Processes.Ghdl_Process_Wait_Timeout'Address); + Def (Trans_Decls.Ghdl_Process_Wait_Set_Timeout, + Grt.Processes.Ghdl_Process_Wait_Set_Timeout'Address); + Def (Trans_Decls.Ghdl_Process_Wait_Add_Sensitivity, + Grt.Processes.Ghdl_Process_Wait_Add_Sensitivity'Address); + Def (Trans_Decls.Ghdl_Process_Wait_Close, + Grt.Processes.Ghdl_Process_Wait_Close'Address); + + Def (Trans_Decls.Ghdl_Process_Add_Sensitivity, + Grt.Processes.Ghdl_Process_Add_Sensitivity'Address); + + Def (Trans_Decls.Ghdl_Now, + Grt.Types.Current_Time'Address); + + Def (Trans_Decls.Ghdl_Process_Add_Driver, + Grt.Signals.Ghdl_Process_Add_Driver'Address); + Def (Trans_Decls.Ghdl_Signal_Add_Source, + Grt.Signals.Ghdl_Signal_Add_Source'Address); + Def (Trans_Decls.Ghdl_Signal_In_Conversion, + Grt.Signals.Ghdl_Signal_In_Conversion'Address); + Def (Trans_Decls.Ghdl_Signal_Out_Conversion, + Grt.Signals.Ghdl_Signal_Out_Conversion'Address); + Def (Trans_Decls.Ghdl_Signal_Effective_Value, + Grt.Signals.Ghdl_Signal_Effective_Value'Address); + Def (Trans_Decls.Ghdl_Signal_Create_Resolution, + Grt.Signals.Ghdl_Signal_Create_Resolution'Address); + + Def (Trans_Decls.Ghdl_Signal_Disconnect, + Grt.Signals.Ghdl_Signal_Disconnect'Address); + Def (Trans_Decls.Ghdl_Signal_Set_Disconnect, + Grt.Signals.Ghdl_Signal_Set_Disconnect'Address); + Def (Trans_Decls.Ghdl_Signal_Merge_Rti, + Grt.Signals.Ghdl_Signal_Merge_Rti'Address); + Def (Trans_Decls.Ghdl_Signal_Name_Rti, + Grt.Signals.Ghdl_Signal_Name_Rti'Address); + Def (Trans_Decls.Ghdl_Signal_Read_Port, + Grt.Signals.Ghdl_Signal_Read_Port'Address); + Def (Trans_Decls.Ghdl_Signal_Read_Driver, + Grt.Signals.Ghdl_Signal_Read_Driver'Address); + + Def (Trans_Decls.Ghdl_Signal_Driving, + Grt.Signals.Ghdl_Signal_Driving'Address); + Def (Trans_Decls.Ghdl_Signal_Driving_Value_B2, + Grt.Signals.Ghdl_Signal_Driving_Value_B2'Address); + Def (Trans_Decls.Ghdl_Signal_Driving_Value_E8, + Grt.Signals.Ghdl_Signal_Driving_Value_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Driving_Value_I32, + Grt.Signals.Ghdl_Signal_Driving_Value_I32'Address); + Def (Trans_Decls.Ghdl_Signal_Driving_Value_I64, + Grt.Signals.Ghdl_Signal_Driving_Value_I64'Address); + Def (Trans_Decls.Ghdl_Signal_Driving_Value_F64, + Grt.Signals.Ghdl_Signal_Driving_Value_F64'Address); + + Def (Trans_Decls.Ghdl_Signal_Create_Guard, + Grt.Signals.Ghdl_Signal_Create_Guard'Address); + Def (Trans_Decls.Ghdl_Signal_Guard_Dependence, + Grt.Signals.Ghdl_Signal_Guard_Dependence'Address); + + Def (Trans_Decls.Ghdl_Signal_Simple_Assign_Error, + Grt.Signals.Ghdl_Signal_Simple_Assign_Error'Address); + Def (Trans_Decls.Ghdl_Signal_Start_Assign_Error, + Grt.Signals.Ghdl_Signal_Start_Assign_Error'Address); + + Def (Trans_Decls.Ghdl_Signal_Start_Assign_Null, + Grt.Signals.Ghdl_Signal_Start_Assign_Null'Address); + + Def (Trans_Decls.Ghdl_Create_Signal_B2, + Grt.Signals.Ghdl_Create_Signal_B2'Address); + Def (Trans_Decls.Ghdl_Signal_Init_B2, + Grt.Signals.Ghdl_Signal_Init_B2'Address); + Def (Trans_Decls.Ghdl_Signal_Simple_Assign_B2, + Grt.Signals.Ghdl_Signal_Simple_Assign_B2'Address); + Def (Trans_Decls.Ghdl_Signal_Start_Assign_B2, + Grt.Signals.Ghdl_Signal_Start_Assign_B2'Address); + Def (Trans_Decls.Ghdl_Signal_Next_Assign_B2, + Grt.Signals.Ghdl_Signal_Next_Assign_B2'Address); + Def (Trans_Decls.Ghdl_Signal_Associate_B2, + Grt.Signals.Ghdl_Signal_Associate_B2'Address); + + Def (Trans_Decls.Ghdl_Create_Signal_E8, + Grt.Signals.Ghdl_Create_Signal_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Init_E8, + Grt.Signals.Ghdl_Signal_Init_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Simple_Assign_E8, + Grt.Signals.Ghdl_Signal_Simple_Assign_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Start_Assign_E8, + Grt.Signals.Ghdl_Signal_Start_Assign_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Next_Assign_E8, + Grt.Signals.Ghdl_Signal_Next_Assign_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Associate_E8, + Grt.Signals.Ghdl_Signal_Associate_E8'Address); + + Def (Trans_Decls.Ghdl_Create_Signal_I32, + Grt.Signals.Ghdl_Create_Signal_I32'Address); + Def (Trans_Decls.Ghdl_Signal_Init_I32, + Grt.Signals.Ghdl_Signal_Init_I32'Address); + Def (Trans_Decls.Ghdl_Signal_Simple_Assign_I32, + Grt.Signals.Ghdl_Signal_Simple_Assign_I32'Address); + Def (Trans_Decls.Ghdl_Signal_Start_Assign_I32, + Grt.Signals.Ghdl_Signal_Start_Assign_I32'Address); + Def (Trans_Decls.Ghdl_Signal_Next_Assign_I32, + Grt.Signals.Ghdl_Signal_Next_Assign_I32'Address); + Def (Trans_Decls.Ghdl_Signal_Associate_I32, + Grt.Signals.Ghdl_Signal_Associate_I32'Address); + + Def (Trans_Decls.Ghdl_Create_Signal_I64, + Grt.Signals.Ghdl_Create_Signal_I64'Address); + Def (Trans_Decls.Ghdl_Signal_Init_I64, + Grt.Signals.Ghdl_Signal_Init_I64'Address); + Def (Trans_Decls.Ghdl_Signal_Simple_Assign_I64, + Grt.Signals.Ghdl_Signal_Simple_Assign_I64'Address); + Def (Trans_Decls.Ghdl_Signal_Start_Assign_I64, + Grt.Signals.Ghdl_Signal_Start_Assign_I64'Address); + Def (Trans_Decls.Ghdl_Signal_Next_Assign_I64, + Grt.Signals.Ghdl_Signal_Next_Assign_I64'Address); + Def (Trans_Decls.Ghdl_Signal_Associate_I64, + Grt.Signals.Ghdl_Signal_Associate_I64'Address); + + Def (Trans_Decls.Ghdl_Create_Signal_F64, + Grt.Signals.Ghdl_Create_Signal_F64'Address); + Def (Trans_Decls.Ghdl_Signal_Init_F64, + Grt.Signals.Ghdl_Signal_Init_F64'Address); + Def (Trans_Decls.Ghdl_Signal_Simple_Assign_F64, + Grt.Signals.Ghdl_Signal_Simple_Assign_F64'Address); + Def (Trans_Decls.Ghdl_Signal_Start_Assign_F64, + Grt.Signals.Ghdl_Signal_Start_Assign_F64'Address); + Def (Trans_Decls.Ghdl_Signal_Next_Assign_F64, + Grt.Signals.Ghdl_Signal_Next_Assign_F64'Address); + Def (Trans_Decls.Ghdl_Signal_Associate_F64, + Grt.Signals.Ghdl_Signal_Associate_F64'Address); + + Def (Trans_Decls.Ghdl_Signal_Attribute_Register_Prefix, + Grt.Signals.Ghdl_Signal_Attribute_Register_Prefix'Address); + Def (Trans_Decls.Ghdl_Create_Stable_Signal, + Grt.Signals.Ghdl_Create_Stable_Signal'Address); + Def (Trans_Decls.Ghdl_Create_Quiet_Signal, + Grt.Signals.Ghdl_Create_Quiet_Signal'Address); + Def (Trans_Decls.Ghdl_Create_Transaction_Signal, + Grt.Signals.Ghdl_Create_Transaction_Signal'Address); + Def (Trans_Decls.Ghdl_Create_Delayed_Signal, + Grt.Signals.Ghdl_Create_Delayed_Signal'Address); + + Def (Trans_Decls.Ghdl_Rti_Top_Instance, + Grt.Rtis.Ghdl_Rti_Top_Instance'Address); + Def (Trans_Decls.Ghdl_Rti_Top_Ptr, + Grt.Rtis.Ghdl_Rti_Top_Ptr'Address); + Std_Standard_Boolean_RTI_Ptr := + Get_Address (Trans_Decls.Std_Standard_Boolean_Rti); + Std_Standard_Bit_RTI_Ptr := + Get_Address (Trans_Decls.Std_Standard_Bit_Rti); + if Ieee.Std_Logic_1164.Resolved /= Null_Iir then + Ieee_Std_Logic_1164_Resolved_Resolv_Ptr := Get_Address + (Translation.Get_Resolv_Ortho_Decl (Ieee.Std_Logic_1164.Resolved)); + end if; + + Def (Trans_Decls.Ghdl_Protected_Enter, + Grt.Processes.Ghdl_Protected_Enter'Address); + Def (Trans_Decls.Ghdl_Protected_Leave, + Grt.Processes.Ghdl_Protected_Leave'Address); + Def (Trans_Decls.Ghdl_Protected_Init, + Grt.Processes.Ghdl_Protected_Init'Address); + Def (Trans_Decls.Ghdl_Protected_Fini, + Grt.Processes.Ghdl_Protected_Fini'Address); + + Def (Trans_Decls.Ghdl_Text_File_Elaborate, + Grt.Files.Ghdl_Text_File_Elaborate'Address); + Def (Trans_Decls.Ghdl_Text_File_Finalize, + Grt.Files.Ghdl_Text_File_Finalize'Address); + Def (Trans_Decls.Ghdl_Text_File_Open, + Grt.Files.Ghdl_Text_File_Open'Address); + Def (Trans_Decls.Ghdl_Text_Write, + Grt.Files.Ghdl_Text_Write'Address); + Def (Trans_Decls.Ghdl_Text_Read_Length, + Grt.Files.Ghdl_Text_Read_Length'Address); + Def (Trans_Decls.Ghdl_Text_File_Close, + Grt.Files.Ghdl_Text_File_Close'Address); + Def (Trans_Decls.Ghdl_File_Close, + Grt.Files.Ghdl_File_Close'Address); + Def (Trans_Decls.Ghdl_File_Elaborate, + Grt.Files.Ghdl_File_Elaborate'Address); + Def (Trans_Decls.Ghdl_File_Open, + Grt.Files.Ghdl_File_Open'Address); + Def (Trans_Decls.Ghdl_Write_Scalar, + Grt.Files.Ghdl_Write_Scalar'Address); + Def (Trans_Decls.Ghdl_Read_Scalar, + Grt.Files.Ghdl_Read_Scalar'Address); + + Def (Trans_Decls.Ghdl_File_Endfile, + Grt.Files.Ghdl_File_Endfile'Address); + + Def (Trans_Decls.Ghdl_Image_B2, + Grt.Images.Ghdl_Image_B2'Address); + Def (Trans_Decls.Ghdl_Image_E8, + Grt.Images.Ghdl_Image_E8'Address); + Def (Trans_Decls.Ghdl_Image_I32, + Grt.Images.Ghdl_Image_I32'Address); + Def (Trans_Decls.Ghdl_Image_F64, + Grt.Images.Ghdl_Image_F64'Address); + Def (Trans_Decls.Ghdl_Image_P64, + Grt.Images.Ghdl_Image_P64'Address); + Def (Trans_Decls.Ghdl_Image_P32, + Grt.Images.Ghdl_Image_P32'Address); + + Def (Trans_Decls.Ghdl_Value_I32, + Grt.Values.Ghdl_Value_I32'Address); + + Def (Trans_Decls.Ghdl_Get_Path_Name, + Grt.Names.Ghdl_Get_Path_Name'Address); + Def (Trans_Decls.Ghdl_Get_Instance_Name, + Grt.Names.Ghdl_Get_Instance_Name'Address); + + Binary_File.Memory.Set_Symbol_Address + (Ortho_Code.X86.Emits.Intrinsics_Symbol + (Ortho_Code.X86.Intrinsic_Mul_Ov_I64), + Muldi3'Address); + Binary_File.Memory.Set_Symbol_Address + (Ortho_Code.X86.Emits.Intrinsics_Symbol + (Ortho_Code.X86.Intrinsic_Div_Ov_I64), + Divdi3'Address); + + -- Find untruncated_text_read, if any. + Decl := Find_Untruncated_Text_Read; + if Decl /= O_Dnode_Null then + Def (Decl, Grt.Files.Ghdl_Untruncated_Text_Read'Address); + end if; + + Binary_File.Memory.Write_Memory_Relocate (Err); + if Err then + raise Compile_Error; + end if; + + Flag_String := Flags.Flag_String; + + Elaborate_Proc := Conv (Get_Address (Trans_Decls.Ghdl_Elaborate)); + + if Snap_Filename /= null then + declare + Fd : File_Descriptor; + begin + Fd := Create_File (Snap_Filename.all, Binary); + if Fd = Invalid_FD then + Error_Msg_Option ("can't open '" & Snap_Filename.all & "'"); + else + Binary_File.Elf.Write_Elf (Fd); + Close (Fd); + end if; + end; + end if; + + -- Free all the memory. + Ortho_Mcode.Free_All; + + Translation.Finalize; + Lists.Initialize; + Str_Table.Initialize; + Nodes.Initialize; + Files_Map.Initialize; + Name_Table.Initialize; + Binary_File.Finish; + + if Flag_Verbose then + Ada.Text_IO.Put_Line ("Starting simulation"); + end if; + + Grt.Main.Run; + --V := Ghdl_Main (1, Gnat_Argv); + end Run; + + function Decode_Option (Option : String) return Boolean + is + begin + if Option = "-g" then + Flag_Debug := Debug_Dwarf; + return True; + elsif Option'Length > 5 and then Option (1 .. 5) = "--be-" then + Ortho_Code.Debug.Set_Be_Flag (Option); + return True; + elsif Option'Length > 7 and then Option (1 .. 7) = "--snap=" then + Snap_Filename := new String'(Option (8 .. Option'Last)); + return True; + else + return False; + end if; + end Decode_Option; + + procedure Disp_Long_Help + is + use Ada.Text_IO; + begin + Put_Line (" -g Generate debugging informations"); + Put_Line (" --debug-be=X Set X internal debugging flags"); + Put_Line (" --snap=FILE Write memory snapshot to FILE"); + end Disp_Long_Help; + + + -- Command run help. + type Command_Run_Help is new Command_Type with null record; + function Decode_Command (Cmd : Command_Run_Help; Name : String) + return Boolean; + function Get_Short_Help (Cmd : Command_Run_Help) return String; + procedure Perform_Action (Cmd : in out Command_Run_Help; + Args : Argument_List); + + function Decode_Command (Cmd : Command_Run_Help; Name : String) + return Boolean + is + pragma Unreferenced (Cmd); + begin + return Name = "--run-help"; + end Decode_Command; + + function Get_Short_Help (Cmd : Command_Run_Help) return String + is + pragma Unreferenced (Cmd); + begin + return "--run-help Disp help for RUNOPTS options"; + end Get_Short_Help; + + procedure Perform_Action (Cmd : in out Command_Run_Help; + Args : Argument_List) + is + pragma Unreferenced (Cmd); + use Ada.Text_IO; + begin + if Args'Length /= 0 then + Error + ("warning: command '--run-help' does not accept any argument"); + end if; + Put_Line ("These options can only be placed at [RUNOPTS]"); + -- Register modules, since they add commands. + Grt.Main.Register_Modules; + -- Bypass usual help header. + Grt.Options.Argc := 0; + Grt.Options.Help; + end Perform_Action; + + procedure Register_Commands + is + begin + Ghdlcomp.Hooks := (Compile_Init'Access, + Compile_Elab'Access, + Set_Run_Options'Access, + Run'Access, + Decode_Option'Access, + Disp_Long_Help'Access); + Ghdlcomp.Register_Commands; + Register_Command (new Command_Run_Help); + end Register_Commands; +end Ghdlrun; |