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;