------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                      I N T E R F A C E S . C O B O L                     --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                            $Revision: 1.3 $                              --
--                                                                          --
--           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT 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  distributed with GNAT;  see file COPYING.  If not, write --
-- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
--                                                                          --
------------------------------------------------------------------------------

package Interfaces.COBOL is

   --  Types and operations for internal data representations

   type Floating      is new Float;
   type Long_Floating is new Long_Float;

   type Binary        is new Integer;
   type Long_Binary   is new Long_Long_Integer;

   Max_Digits_Binary      : constant := 9;
   Max_Digits_Long_Binary : constant := 18;

   type Decimal_Element  is mod 16;
   type Packed_Decimal is array (Positive range <>) of Decimal_Element;
   pragma Pack (Packed_Decimal);

   subtype COBOL_Character is Character;
   --  Should be derived type declaration, but GNAT 1.81 blows up ???

   Ada_To_COBOL : array (Standard.Character) of COBOL_Character := (
     COBOL_Character'Val (000), COBOL_Character'Val (001),
     COBOL_Character'Val (002), COBOL_Character'Val (003),
     COBOL_Character'Val (004), COBOL_Character'Val (005),
     COBOL_Character'Val (006), COBOL_Character'Val (007),
     COBOL_Character'Val (008), COBOL_Character'Val (009),
     COBOL_Character'Val (010), COBOL_Character'Val (011),
     COBOL_Character'Val (012), COBOL_Character'Val (013),
     COBOL_Character'Val (014), COBOL_Character'Val (015),
     COBOL_Character'Val (016), COBOL_Character'Val (017),
     COBOL_Character'Val (018), COBOL_Character'Val (019),
     COBOL_Character'Val (020), COBOL_Character'Val (021),
     COBOL_Character'Val (022), COBOL_Character'Val (023),
     COBOL_Character'Val (024), COBOL_Character'Val (025),
     COBOL_Character'Val (026), COBOL_Character'Val (027),
     COBOL_Character'Val (028), COBOL_Character'Val (029),
     COBOL_Character'Val (030), COBOL_Character'Val (031),
     COBOL_Character'Val (032), COBOL_Character'Val (033),
     COBOL_Character'Val (034), COBOL_Character'Val (035),
     COBOL_Character'Val (036), COBOL_Character'Val (037),
     COBOL_Character'Val (038), COBOL_Character'Val (039),
     COBOL_Character'Val (040), COBOL_Character'Val (041),
     COBOL_Character'Val (042), COBOL_Character'Val (043),
     COBOL_Character'Val (044), COBOL_Character'Val (045),
     COBOL_Character'Val (046), COBOL_Character'Val (047),
     COBOL_Character'Val (048), COBOL_Character'Val (049),
     COBOL_Character'Val (050), COBOL_Character'Val (051),
     COBOL_Character'Val (052), COBOL_Character'Val (053),
     COBOL_Character'Val (054), COBOL_Character'Val (055),
     COBOL_Character'Val (056), COBOL_Character'Val (057),
     COBOL_Character'Val (058), COBOL_Character'Val (059),
     COBOL_Character'Val (060), COBOL_Character'Val (061),
     COBOL_Character'Val (062), COBOL_Character'Val (063),
     COBOL_Character'Val (064), COBOL_Character'Val (065),
     COBOL_Character'Val (066), COBOL_Character'Val (067),
     COBOL_Character'Val (068), COBOL_Character'Val (069),
     COBOL_Character'Val (070), COBOL_Character'Val (071),
     COBOL_Character'Val (072), COBOL_Character'Val (073),
     COBOL_Character'Val (074), COBOL_Character'Val (075),
     COBOL_Character'Val (076), COBOL_Character'Val (077),
     COBOL_Character'Val (078), COBOL_Character'Val (079),
     COBOL_Character'Val (080), COBOL_Character'Val (081),
     COBOL_Character'Val (082), COBOL_Character'Val (083),
     COBOL_Character'Val (084), COBOL_Character'Val (085),
     COBOL_Character'Val (086), COBOL_Character'Val (087),
     COBOL_Character'Val (088), COBOL_Character'Val (089),
     COBOL_Character'Val (090), COBOL_Character'Val (091),
     COBOL_Character'Val (092), COBOL_Character'Val (093),
     COBOL_Character'Val (094), COBOL_Character'Val (095),
     COBOL_Character'Val (096), COBOL_Character'Val (097),
     COBOL_Character'Val (098), COBOL_Character'Val (099),
     COBOL_Character'Val (100), COBOL_Character'Val (101),
     COBOL_Character'Val (102), COBOL_Character'Val (103),
     COBOL_Character'Val (104), COBOL_Character'Val (105),
     COBOL_Character'Val (106), COBOL_Character'Val (107),
     COBOL_Character'Val (108), COBOL_Character'Val (109),
     COBOL_Character'Val (110), COBOL_Character'Val (111),
     COBOL_Character'Val (112), COBOL_Character'Val (113),
     COBOL_Character'Val (114), COBOL_Character'Val (115),
     COBOL_Character'Val (116), COBOL_Character'Val (117),
     COBOL_Character'Val (118), COBOL_Character'Val (119),
     COBOL_Character'Val (120), COBOL_Character'Val (121),
     COBOL_Character'Val (122), COBOL_Character'Val (123),
     COBOL_Character'Val (124), COBOL_Character'Val (125),
     COBOL_Character'Val (126), COBOL_Character'Val (127),
     COBOL_Character'Val (128), COBOL_Character'Val (129),
     COBOL_Character'Val (130), COBOL_Character'Val (131),
     COBOL_Character'Val (132), COBOL_Character'Val (133),
     COBOL_Character'Val (134), COBOL_Character'Val (135),
     COBOL_Character'Val (136), COBOL_Character'Val (137),
     COBOL_Character'Val (138), COBOL_Character'Val (139),
     COBOL_Character'Val (140), COBOL_Character'Val (141),
     COBOL_Character'Val (142), COBOL_Character'Val (143),
     COBOL_Character'Val (144), COBOL_Character'Val (145),
     COBOL_Character'Val (146), COBOL_Character'Val (147),
     COBOL_Character'Val (148), COBOL_Character'Val (149),
     COBOL_Character'Val (150), COBOL_Character'Val (151),
     COBOL_Character'Val (152), COBOL_Character'Val (153),
     COBOL_Character'Val (154), COBOL_Character'Val (155),
     COBOL_Character'Val (156), COBOL_Character'Val (157),
     COBOL_Character'Val (158), COBOL_Character'Val (159),
     COBOL_Character'Val (160), COBOL_Character'Val (161),
     COBOL_Character'Val (162), COBOL_Character'Val (163),
     COBOL_Character'Val (164), COBOL_Character'Val (165),
     COBOL_Character'Val (166), COBOL_Character'Val (167),
     COBOL_Character'Val (168), COBOL_Character'Val (169),
     COBOL_Character'Val (170), COBOL_Character'Val (171),
     COBOL_Character'Val (172), COBOL_Character'Val (173),
     COBOL_Character'Val (174), COBOL_Character'Val (175),
     COBOL_Character'Val (176), COBOL_Character'Val (177),
     COBOL_Character'Val (178), COBOL_Character'Val (179),
     COBOL_Character'Val (180), COBOL_Character'Val (181),
     COBOL_Character'Val (182), COBOL_Character'Val (183),
     COBOL_Character'Val (184), COBOL_Character'Val (185),
     COBOL_Character'Val (186), COBOL_Character'Val (187),
     COBOL_Character'Val (188), COBOL_Character'Val (189),
     COBOL_Character'Val (190), COBOL_Character'Val (191),
     COBOL_Character'Val (192), COBOL_Character'Val (193),
     COBOL_Character'Val (194), COBOL_Character'Val (195),
     COBOL_Character'Val (196), COBOL_Character'Val (197),
     COBOL_Character'Val (198), COBOL_Character'Val (199),
     COBOL_Character'Val (200), COBOL_Character'Val (201),
     COBOL_Character'Val (202), COBOL_Character'Val (203),
     COBOL_Character'Val (204), COBOL_Character'Val (205),
     COBOL_Character'Val (206), COBOL_Character'Val (207),
     COBOL_Character'Val (208), COBOL_Character'Val (209),
     COBOL_Character'Val (210), COBOL_Character'Val (211),
     COBOL_Character'Val (212), COBOL_Character'Val (213),
     COBOL_Character'Val (214), COBOL_Character'Val (215),
     COBOL_Character'Val (216), COBOL_Character'Val (217),
     COBOL_Character'Val (218), COBOL_Character'Val (219),
     COBOL_Character'Val (220), COBOL_Character'Val (221),
     COBOL_Character'Val (222), COBOL_Character'Val (223),
     COBOL_Character'Val (224), COBOL_Character'Val (225),
     COBOL_Character'Val (226), COBOL_Character'Val (227),
     COBOL_Character'Val (228), COBOL_Character'Val (229),
     COBOL_Character'Val (230), COBOL_Character'Val (231),
     COBOL_Character'Val (232), COBOL_Character'Val (233),
     COBOL_Character'Val (234), COBOL_Character'Val (235),
     COBOL_Character'Val (236), COBOL_Character'Val (237),
     COBOL_Character'Val (238), COBOL_Character'Val (239),
     COBOL_Character'Val (240), COBOL_Character'Val (241),
     COBOL_Character'Val (242), COBOL_Character'Val (243),
     COBOL_Character'Val (244), COBOL_Character'Val (245),
     COBOL_Character'Val (246), COBOL_Character'Val (247),
     COBOL_Character'Val (248), COBOL_Character'Val (249),
     COBOL_Character'Val (250), COBOL_Character'Val (251),
     COBOL_Character'Val (252), COBOL_Character'Val (253),
     COBOL_Character'Val (254), COBOL_Character'Val (255));

   COBOL_To_Ada : array (COBOL_Character) of Standard.Character := (
     Standard.Character'Val (000), Standard.Character'Val (001),
     Standard.Character'Val (002), Standard.Character'Val (003),
     Standard.Character'Val (004), Standard.Character'Val (005),
     Standard.Character'Val (006), Standard.Character'Val (007),
     Standard.Character'Val (008), Standard.Character'Val (009),
     Standard.Character'Val (010), Standard.Character'Val (011),
     Standard.Character'Val (012), Standard.Character'Val (013),
     Standard.Character'Val (014), Standard.Character'Val (015),
     Standard.Character'Val (016), Standard.Character'Val (017),
     Standard.Character'Val (018), Standard.Character'Val (019),
     Standard.Character'Val (020), Standard.Character'Val (021),
     Standard.Character'Val (022), Standard.Character'Val (023),
     Standard.Character'Val (024), Standard.Character'Val (025),
     Standard.Character'Val (026), Standard.Character'Val (027),
     Standard.Character'Val (028), Standard.Character'Val (029),
     Standard.Character'Val (030), Standard.Character'Val (031),
     Standard.Character'Val (032), Standard.Character'Val (033),
     Standard.Character'Val (034), Standard.Character'Val (035),
     Standard.Character'Val (036), Standard.Character'Val (037),
     Standard.Character'Val (038), Standard.Character'Val (039),
     Standard.Character'Val (040), Standard.Character'Val (041),
     Standard.Character'Val (042), Standard.Character'Val (043),
     Standard.Character'Val (044), Standard.Character'Val (045),
     Standard.Character'Val (046), Standard.Character'Val (047),
     Standard.Character'Val (048), Standard.Character'Val (049),
     Standard.Character'Val (050), Standard.Character'Val (051),
     Standard.Character'Val (052), Standard.Character'Val (053),
     Standard.Character'Val (054), Standard.Character'Val (055),
     Standard.Character'Val (056), Standard.Character'Val (057),
     Standard.Character'Val (058), Standard.Character'Val (059),
     Standard.Character'Val (060), Standard.Character'Val (061),
     Standard.Character'Val (062), Standard.Character'Val (063),
     Standard.Character'Val (064), Standard.Character'Val (065),
     Standard.Character'Val (066), Standard.Character'Val (067),
     Standard.Character'Val (068), Standard.Character'Val (069),
     Standard.Character'Val (070), Standard.Character'Val (071),
     Standard.Character'Val (072), Standard.Character'Val (073),
     Standard.Character'Val (074), Standard.Character'Val (075),
     Standard.Character'Val (076), Standard.Character'Val (077),
     Standard.Character'Val (078), Standard.Character'Val (079),
     Standard.Character'Val (080), Standard.Character'Val (081),
     Standard.Character'Val (082), Standard.Character'Val (083),
     Standard.Character'Val (084), Standard.Character'Val (085),
     Standard.Character'Val (086), Standard.Character'Val (087),
     Standard.Character'Val (088), Standard.Character'Val (089),
     Standard.Character'Val (090), Standard.Character'Val (091),
     Standard.Character'Val (092), Standard.Character'Val (093),
     Standard.Character'Val (094), Standard.Character'Val (095),
     Standard.Character'Val (096), Standard.Character'Val (097),
     Standard.Character'Val (098), Standard.Character'Val (099),
     Standard.Character'Val (100), Standard.Character'Val (101),
     Standard.Character'Val (102), Standard.Character'Val (103),
     Standard.Character'Val (104), Standard.Character'Val (105),
     Standard.Character'Val (106), Standard.Character'Val (107),
     Standard.Character'Val (108), Standard.Character'Val (109),
     Standard.Character'Val (110), Standard.Character'Val (111),
     Standard.Character'Val (112), Standard.Character'Val (113),
     Standard.Character'Val (114), Standard.Character'Val (115),
     Standard.Character'Val (116), Standard.Character'Val (117),
     Standard.Character'Val (118), Standard.Character'Val (119),
     Standard.Character'Val (120), Standard.Character'Val (121),
     Standard.Character'Val (122), Standard.Character'Val (123),
     Standard.Character'Val (124), Standard.Character'Val (125),
     Standard.Character'Val (126), Standard.Character'Val (127),
     Standard.Character'Val (128), Standard.Character'Val (129),
     Standard.Character'Val (130), Standard.Character'Val (131),
     Standard.Character'Val (132), Standard.Character'Val (133),
     Standard.Character'Val (134), Standard.Character'Val (135),
     Standard.Character'Val (136), Standard.Character'Val (137),
     Standard.Character'Val (138), Standard.Character'Val (139),
     Standard.Character'Val (140), Standard.Character'Val (141),
     Standard.Character'Val (142), Standard.Character'Val (143),
     Standard.Character'Val (144), Standard.Character'Val (145),
     Standard.Character'Val (146), Standard.Character'Val (147),
     Standard.Character'Val (148), Standard.Character'Val (149),
     Standard.Character'Val (150), Standard.Character'Val (151),
     Standard.Character'Val (152), Standard.Character'Val (153),
     Standard.Character'Val (154), Standard.Character'Val (155),
     Standard.Character'Val (156), Standard.Character'Val (157),
     Standard.Character'Val (158), Standard.Character'Val (159),
     Standard.Character'Val (160), Standard.Character'Val (161),
     Standard.Character'Val (162), Standard.Character'Val (163),
     Standard.Character'Val (164), Standard.Character'Val (165),
     Standard.Character'Val (166), Standard.Character'Val (167),
     Standard.Character'Val (168), Standard.Character'Val (169),
     Standard.Character'Val (170), Standard.Character'Val (171),
     Standard.Character'Val (172), Standard.Character'Val (173),
     Standard.Character'Val (174), Standard.Character'Val (175),
     Standard.Character'Val (176), Standard.Character'Val (177),
     Standard.Character'Val (178), Standard.Character'Val (179),
     Standard.Character'Val (180), Standard.Character'Val (181),
     Standard.Character'Val (182), Standard.Character'Val (183),
     Standard.Character'Val (184), Standard.Character'Val (185),
     Standard.Character'Val (186), Standard.Character'Val (187),
     Standard.Character'Val (188), Standard.Character'Val (189),
     Standard.Character'Val (190), Standard.Character'Val (191),
     Standard.Character'Val (192), Standard.Character'Val (193),
     Standard.Character'Val (194), Standard.Character'Val (195),
     Standard.Character'Val (196), Standard.Character'Val (197),
     Standard.Character'Val (198), Standard.Character'Val (199),
     Standard.Character'Val (200), Standard.Character'Val (201),
     Standard.Character'Val (202), Standard.Character'Val (203),
     Standard.Character'Val (204), Standard.Character'Val (205),
     Standard.Character'Val (206), Standard.Character'Val (207),
     Standard.Character'Val (208), Standard.Character'Val (209),
     Standard.Character'Val (210), Standard.Character'Val (211),
     Standard.Character'Val (212), Standard.Character'Val (213),
     Standard.Character'Val (214), Standard.Character'Val (215),
     Standard.Character'Val (216), Standard.Character'Val (217),
     Standard.Character'Val (218), Standard.Character'Val (219),
     Standard.Character'Val (220), Standard.Character'Val (221),
     Standard.Character'Val (222), Standard.Character'Val (223),
     Standard.Character'Val (224), Standard.Character'Val (225),
     Standard.Character'Val (226), Standard.Character'Val (227),
     Standard.Character'Val (228), Standard.Character'Val (229),
     Standard.Character'Val (230), Standard.Character'Val (231),
     Standard.Character'Val (232), Standard.Character'Val (233),
     Standard.Character'Val (234), Standard.Character'Val (235),
     Standard.Character'Val (236), Standard.Character'Val (237),
     Standard.Character'Val (238), Standard.Character'Val (239),
     Standard.Character'Val (240), Standard.Character'Val (241),
     Standard.Character'Val (242), Standard.Character'Val (243),
     Standard.Character'Val (244), Standard.Character'Val (245),
     Standard.Character'Val (246), Standard.Character'Val (247),
     Standard.Character'Val (248), Standard.Character'Val (249),
     Standard.Character'Val (250), Standard.Character'Val (251),
     Standard.Character'Val (252), Standard.Character'Val (253),
     Standard.Character'Val (254), Standard.Character'Val (255));

   type Alphanumeric is array (Positive range <>) of COBOL_Character;
   pragma Pack (Alphanumeric);

   function To_COBOL (Item : in String) return Alphanumeric;
   function To_Ada   (Item : in Alphanumeric) return String;

   procedure To_COBOL
     (Item   : in String;
      Target : out Alphanumeric;
      Last   : out Natural);

   procedure To_Ada
     (Item   : in Alphanumeric;
      Target : out String;
      Last   : out Natural);

   type Numeric is array (Positive range <>) of COBOL_Character;
   pragma Pack (Numeric);

   --  Formats for COBOL data representations

   type Display_Format is private;

   Unsigned             : constant Display_Format;
   Leading_Separate     : constant Display_Format;
   Trailing_Separate    : constant Display_Format;
   Leading_Nonseparate  : constant Display_Format;
   Trailing_Nonseparate : constant Display_Format;

   type Binary_Format is private;

   High_Order_First  : constant Binary_Format;
   Low_Order_First   : constant Binary_Format;
   Native_Binary     : constant Binary_Format;

   type Packed_Format is private;

   Packed_Unsigned   : constant Packed_Format;
   Packed_Signed     : constant Packed_Format;

   --  Types for external representation of COBOL binary data

   type Byte is mod 2 ** COBOL_Character'Size;
   type Byte_Array is array (Positive range <>) of Byte;
   pragma Pack (Byte_Array);

   Conversion_Error : exception;

   generic
      type Num is delta <> digits <>;

   package Decimal_Conversions is

      --  Display Formats: data values are represented as Numeric

      function Valid
        (Item   : in Numeric;
         Format : in Display_Format)
         return   Boolean;

      function Length
        (Format : in Display_Format)
         return   Natural;

      function To_Decimal
        (Item   : in Numeric;
         Format : in Display_Format)
         return   Num;

      function To_Display
        (Item   : in Num;
         Format : in Display_Format)
         return   Numeric;

      --  Packed Formats: data values are represented as Packed_Decimal

      function Valid
        (Item   : in Packed_Decimal;
         Format : in Display_Format)
         return   Boolean;

      function Length
        (Format : in Packed_Format)
         return   Natural;

      function To_Decimal
        (Item   : in Packed_Decimal;
         Format : in Packed_Format)
         return   Num;

      function To_Packed
        (Item   : in Num;
         Format : in Packed_Format)
         return   Packed_Decimal;

      --  Binary Formats: external data values are represented as Byte_Array

      function Valid
        (Item   : in Byte_Array;
         Format : in Binary_Format)
         return   Boolean;

      function Length
        (Format : in Binary_Format)
         return   Natural;

      function To_Decimal
        (Item   : in Byte_Array;
         Format : in Binary_Format) return Num;

      function To_Comp
        (Item   : in Num;
         Format : in Binary_Format)
         return   Byte_Array;

      --  Internal Binary formats: data values are of type Binary/Long_Binary

      function To_Decimal (Item : in Binary)      return Num;
      function To_Decimal (Item : in Long_Binary) return Num;

      function To_Binary      (Item : in Num)  return Binary;
      function To_Long_Binary (Item : in Num)  return Long_Binary;

   end Decimal_Conversions;

private
   type Display_Format is (U, LS, TS, LN, TN);

   Unsigned             : constant Display_Format := U;
   Leading_Separate     : constant Display_Format := LS;
   Trailing_Separate    : constant Display_Format := TS;
   Leading_Nonseparate  : constant Display_Format := LN;
   Trailing_Nonseparate : constant Display_Format := TN;

   type Binary_Format is (H, L, N);

   High_Order_First  : constant Binary_Format := H;
   Low_Order_First   : constant Binary_Format := L;
   Native_Binary     : constant Binary_Format := N;

   type Packed_Format is (U, S);

   Packed_Unsigned   : constant Packed_Format := U;
   Packed_Signed     : constant Packed_Format := S;

end Interfaces.COBOL;


----------------------
-- REVISION HISTORY --
----------------------

--  ----------------------------
--  revision 1.1
--  date: Mon Dec 27 23:53:37 1993;  author: dewar
--  Initial revision
--  ----------------------------
--  revision 1.2
--  date: Sun Jan  9 09:35:45 1994;  author: dewar
--  New header with 1994 copyright
--  ----------------------------
--  revision 1.3
--  date: Fri Jun 24 17:11:30 1994;  author: dewar
--  Update to match RM 5.0
--  Provide missing private part
--  Minor reformatting to GNAT format
--  ----------------------------
--  New changes after this line.  Each line starts with: "--  "
