diff options
author | Tristan Gingold <tgingold@free.fr> | 2014-11-04 20:14:19 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2014-11-04 20:14:19 +0100 |
commit | 9c195bf5d86d67ea5eb419ccf6e48dc153e57c68 (patch) | |
tree | 575346e529b99e26382b4a06f6ff2caa0b391ab2 /src/ortho/debug/ortho_debug-main.adb | |
parent | 184a123f91e07c927292d67462561dc84f3a920d (diff) | |
download | ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.gz ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.bz2 ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.zip |
Move sources to src/ subdirectory.
Diffstat (limited to 'src/ortho/debug/ortho_debug-main.adb')
-rw-r--r-- | src/ortho/debug/ortho_debug-main.adb | 151 |
1 files changed, 151 insertions, 0 deletions
diff --git a/src/ortho/debug/ortho_debug-main.adb b/src/ortho/debug/ortho_debug-main.adb new file mode 100644 index 000000000..b470deaab --- /dev/null +++ b/src/ortho/debug/ortho_debug-main.adb @@ -0,0 +1,151 @@ +-- Main procedure of ortho debug back-end. +-- Copyright (C) 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 Ada.Command_Line; use Ada.Command_Line; +with Ada.Unchecked_Deallocation; +with Ada.Text_IO; use Ada.Text_IO; +with Ortho_Debug; use Ortho_Debug; +with Ortho_Debug_Front; use Ortho_Debug_Front; +with Ortho_Debug.Disp; +with System; use System; +with Interfaces.C_Streams; use Interfaces.C_Streams; + +procedure Ortho_Debug.Main is + -- Do not output the ortho code. + Flag_Silent : Boolean := False; + + -- Force output, even in case of crash. + Flag_Force : Boolean := False; + + I : Natural; + Argc : Natural; + Arg : String_Acc; + Opt : String_Acc; + Res : Natural; + File : String_Acc; + Output : FILEs; + R : Boolean; + + procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation + (Name => String_Acc, Object => String); +begin + Ortho_Debug_Front.Init; + Output := NULL_Stream; + + Set_Exit_Status (Failure); + + -- Decode options. + Argc := Argument_Count; + I := 1; + loop + exit when I > Argc; + exit when Argument (I) (1) /= '-'; + if Argument (I) = "--silent" or else Argument (I) = "-quiet" then + Flag_Silent := True; + I := I + 1; + elsif Argument (I) = "--force" then + Flag_Force := True; + I := I + 1; + elsif Argument (I)'Length >= 2 and then Argument (I)(2) = 'g' then + -- Skip -g[XXX] flags. + I := I + 1; + elsif Argument (I) = "-o" and then I + 1 <= Argc then + -- TODO: write the output to the file ? + if Output /= NULL_Stream then + Put_Line (Command_Name & ": only one output allowed"); + return; + end if; + declare + Name : String := Argument (I + 1) & ASCII.Nul; + Mode : String := 'w' & ASCII.Nul; + begin + Output := fopen (Name'Address, Mode'Address); + if Output = NULL_Stream then + Put_Line (Command_Name & ": cannot open " & Argument (I + 1)); + return; + end if; + end; + I := I + 2; + else + Opt := new String'(Argument (I)); + if I < Argc then + Arg := new String'(Argument (I + 1)); + else + Arg := null; + end if; + Res := Ortho_Debug_Front.Decode_Option (Opt, Arg); + Unchecked_Deallocation (Opt); + Unchecked_Deallocation (Arg); + if Res = 0 then + Put_Line (Argument (I) & ": unknown option"); + return; + else + I := I + Res; + end if; + end if; + end loop; + + -- Initialize tree. + begin + Ortho_Debug.Init; + + if I <= Argc then + R := True; + for J in I .. Argc loop + File := new String'(Argument (J)); + R := R and Ortho_Debug_Front.Parse (File); + Unchecked_Deallocation (File); + end loop; + else + R := Ortho_Debug_Front.Parse (null); + end if; + Ortho_Debug.Finish; + exception + when others => + if not Flag_Force then + raise; + else + R := False; + end if; + end; + + -- Write down the result. + if (R and (Output /= NULL_Stream or not Flag_Silent)) + or Flag_Force + then + if Output = NULL_Stream then + Ortho_Debug.Disp.Init_Context (stdout); + else + Ortho_Debug.Disp.Init_Context (Output); + end if; + Ortho_Debug.Disp.Disp_Ortho (Ortho_Debug.Top); + if Output /= NULL_Stream then + declare + Status : int; + pragma Unreferenced (Status); + begin + Status := fclose (Output); + end; + end if; + end if; + + if R then + Set_Exit_Status (Success); + else + Set_Exit_Status (Failure); + end if; +end Ortho_Debug.Main; |