raw
zfp_genesis             1 ------------------------------------------------------------------------------
zfp_genesis             2 ------------------------------------------------------------------------------
zfp_genesis             3 -- You do not have, nor can you ever acquire the right to use, copy or      --
zfp_genesis             4 -- distribute this software ; Should you use this software for any purpose, --
zfp_genesis             5 -- or copy and distribute it to anyone or in any manner, you are breaking   --
zfp_genesis             6 -- the laws of whatever soi-disant jurisdiction, and you promise to         --
zfp_genesis             7 -- continue doing so for the indefinite future. In any case, please         --
zfp_genesis             8 -- always : read and understand any software ; verify any PGP signatures    --
zfp_genesis             9 -- that you use - for any purpose.                                          --
zfp_genesis            10 --                                                                          --
zfp_genesis            11 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm .     --
zfp_genesis            12 ------------------------------------------------------------------------------
zfp_genesis            13 ------------------------------------------------------------------------------
zfp_genesis            14 
zfp_genesis            15 with Ada.Text_IO; use Ada.Text_IO;
zfp_genesis            16 with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
zfp_genesis            17 with System.Storage_Elements; use System.Storage_Elements;
zfp_genesis            18 
zfp_genesis            19 procedure Last_Chance_Handler
zfp_genesis            20    (Msg : System.Address; Line : Integer)
zfp_genesis            21 is
zfp_genesis            22    procedure Exit_Now(status: Integer);
zfp_genesis            23    pragma Import
zfp_genesis            24      (Convention    => C,
zfp_genesis            25       Entity        => Exit_Now,
zfp_genesis            26       External_Name => "exit");
zfp_genesis            27 
zfp_genesis            28    function Peek (Addr : System.Address) return Character
zfp_genesis            29    is
zfp_genesis            30       C : Character with Address => Addr;
zfp_genesis            31    begin
zfp_genesis            32       return C;
zfp_genesis            33    end Peek; 
zfp_genesis            34    A : System.Address := Msg;
zfp_genesis            35 begin
zfp_genesis            36    Put ("GNAT Exception!:");
zfp_genesis            37    Put (Line); 
zfp_genesis            38    Put (":");
zfp_genesis            39    while Peek(A) /= ASCII.NUL loop
zfp_genesis            40       Put (Peek(A));
zfp_genesis            41       A := A + 1;
zfp_genesis            42    end loop;
zfp_genesis            43    New_Line;
zfp_genesis            44    Exit_Now(-1);
zfp_genesis            45 end Last_Chance_Handler;