home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-bin / lib / gcc-lib / m68k-amigaos / 2.7.2.1 / adainclude / s-imgllw.adb < prev    next >
Encoding:
Text File  |  1995-10-17  |  4.5 KB  |  130 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                       S Y S T E M . I M G _ L L W                        --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.2 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with System.Unsigned_Types; use System.Unsigned_Types;
  27.  
  28. package body System.Img_LLW is
  29.  
  30.    ---------------------------------------
  31.    -- Set_Image_Width_Long_Long_Integer --
  32.    ---------------------------------------
  33.  
  34.    procedure Set_Image_Width_Long_Long_Integer
  35.      (V : Long_Long_Integer;
  36.       W : Integer;
  37.       S : out String;
  38.       P : in out Natural)
  39.    is
  40.       Start : Natural;
  41.  
  42.    begin
  43.       --  Positive case can just use the unsigned circuit directly
  44.  
  45.       if V >= 0 then
  46.          Set_Image_Width_Long_Long_Unsigned
  47.            (Long_Long_Unsigned (V), W, S, P);
  48.  
  49.       --  Negative case has to set a minus sign. Note also that we have to be
  50.       --  careful not to generate overflow with the largest negative number.
  51.  
  52.       else
  53.          P := P + 1;
  54.          S (P) := ' ';
  55.          Start := P;
  56.  
  57.          begin
  58.             pragma Suppress (Overflow_Check);
  59.             pragma Suppress (Range_Check);
  60.             Set_Image_Width_Long_Long_Unsigned
  61.               (Long_Long_Unsigned (-V), W - 1, S, P);
  62.          end;
  63.  
  64.          --  Set minus sign in last leading blank location. Because of the
  65.          --  code above, there must be at least one such location.
  66.  
  67.          while S (Start + 1) = ' ' loop
  68.             Start := Start + 1;
  69.          end loop;
  70.  
  71.          S (Start) := '-';
  72.       end if;
  73.  
  74.    end Set_Image_Width_Long_Long_Integer;
  75.  
  76.    ----------------------------------------
  77.    -- Set_Image_Width_Long_Long_Unsigned --
  78.    ----------------------------------------
  79.  
  80.    procedure Set_Image_Width_Long_Long_Unsigned
  81.      (V : Long_Long_Unsigned;
  82.       W : Integer;
  83.       S : out String;
  84.       P : in out Natural)
  85.    is
  86.       Start : constant Natural := P;
  87.       F, T  : Natural;
  88.  
  89.       procedure Set_Digits (T : Long_Long_Unsigned);
  90.       --  Set digits of absolute value of T
  91.  
  92.       procedure Set_Digits (T : Long_Long_Unsigned) is
  93.       begin
  94.          if T >= 10 then
  95.             Set_Digits (T / 10);
  96.             P := P + 1;
  97.             S (P) := Character'Val (T mod 10 + Character'Pos ('0'));
  98.          else
  99.             P := P + 1;
  100.             S (P) := Character'Val (T + Character'Pos ('0'));
  101.          end if;
  102.       end Set_Digits;
  103.  
  104.    --  Start of processing for Set_Image_Width_Long_Long_Unsigned
  105.  
  106.    begin
  107.       Set_Digits (V);
  108.  
  109.       --  Add leading spaces if required by width parameter
  110.  
  111.       if P - Start < W then
  112.          F := P;
  113.          P := P + (W - (P - Start));
  114.          T := P;
  115.  
  116.          while F > Start loop
  117.             S (T) := S (F);
  118.             T := T - 1;
  119.             F := F - 1;
  120.          end loop;
  121.  
  122.          for J in Start + 1 .. T loop
  123.             S (J) := ' ';
  124.          end loop;
  125.       end if;
  126.  
  127.    end Set_Image_Width_Long_Long_Unsigned;
  128.  
  129. end System.Img_LLW;
  130.