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 --  Version for use with C run time
zfp_genesis            16 with Ada.Text_IO; use Ada.Text_IO;
zfp_genesis            17 
zfp_genesis            18 package body Ada.Integer_Text_IO is
zfp_genesis            19 
zfp_genesis            20    ---------
zfp_genesis            21    -- Put --
zfp_genesis            22    ---------
zfp_genesis            23 
zfp_genesis            24    procedure Put (X : Integer) is
zfp_genesis            25       Neg_X : Integer;
zfp_genesis            26       S     : String (1 .. Integer'Width);
zfp_genesis            27       First : Natural := S'Last + 1;
zfp_genesis            28       Val   : Integer;
zfp_genesis            29 
zfp_genesis            30    begin
zfp_genesis            31       --  Work on negative values to avoid overflows
zfp_genesis            32 
zfp_genesis            33       Neg_X := (if X < 0 then X else -X);
zfp_genesis            34 
zfp_genesis            35       loop
zfp_genesis            36          --  Cf RM 4.5.5 Multiplying Operators.  The rem operator will return
zfp_genesis            37          --  negative values for negative values of Neg_X.
zfp_genesis            38 
zfp_genesis            39          Val := Neg_X rem 10;
zfp_genesis            40          Neg_X := (Neg_X - Val) / 10;
zfp_genesis            41          First := First - 1;
zfp_genesis            42          S (First) := Character'Val (Character'Pos ('0') - Val);
zfp_genesis            43          exit when Neg_X = 0;
zfp_genesis            44       end loop;
zfp_genesis            45 
zfp_genesis            46       if X < 0 then
zfp_genesis            47          First := First - 1;
zfp_genesis            48          S (First) := '-';
zfp_genesis            49       end if;
zfp_genesis            50 
zfp_genesis            51       Put (S (First .. S'Last));
zfp_genesis            52    end Put;
zfp_genesis            53 
zfp_genesis            54 end Ada.Integer_Text_IO;