Prev | Up | Next | Back | Forward
TOC -- / --.-- / --.--.-- | Index | Search | Syntax | Help


B.4 Interfacing with COBOL

(1)
The facilities relevant to interfacing with the COBOL language are the package Interfaces.COBOL and support for the Import, Export and Convention pragmas with convention_identifier COBOL.
(2)
The COBOL interface package supplies several sets of facilities:
(3)
(4)
(5)
Static Semantics
(6)
The library package Interfaces.COBOL has the following declaration:
(7)
       package Interfaces.COBOL is
          pragma Preelaborate(COBOL);
(8)
       -- Types and operations for internal data representations
(9)
          type Floating      is digits implementation-defined;
          type Long_Floating is digits implementation-defined;
(10)
          type Binary      is range implementation-defined;
          type Long_Binary is range implementation-defined;
(11)
          Max_Digits_Binary      : constant := implementation-defined;
          Max_Digits_Long_Binary : constant := implementation-defined;
(12)
          type Decimal_Element  is mod implementation-defined;
          type Packed_Decimal is array (Positive range <>) of Decimal_Element;
          pragma Pack(Packed_Decimal);
(13)
          type COBOL_Character is implementation-defined character type;
(14)
          Ada_To_COBOL : array (Character) of COBOL_Character := implementation-defined;
(15)
          COBOL_To_Ada : array (COBOL_Character) of Character := implementation-defined;
(16)
          type Alphanumeric is array (Positive range <>) of COBOL_Character;
          pragma Pack(Alphanumeric);
(17)
          function To_COBOL (Item : in String) return Alphanumeric;
          function To_Ada   (Item : in Alphanumeric) return String;
(18)
          procedure To_COBOL (Item       : in String;
                              Target     : out Alphanumeric;
                              Last       : out Natural);
(19)
          procedure To_Ada (Item     : in Alphanumeric;
                            Target   : out String;
                            Last     : out Natural);
(20)
          type Numeric is array (Positive range <>) of COBOL_Character;
          pragma Pack(Numeric);
(21)
       -- Formats for COBOL data representations
(22)
          type Display_Format is private;
(23)
          Unsigned             : constant Display_Format;
          Leading_Separate     : constant Display_Format;
          Trailing_Separate    : constant Display_Format;
          Leading_Nonseparate  : constant Display_Format;
          Trailing_Nonseparate : constant Display_Format;
(24)
          type Binary_Format is private;
(25)
          High_Order_First  : constant Binary_Format;
          Low_Order_First   : constant Binary_Format;
          Native_Binary     : constant Binary_Format;
(26)
          type Packed_Format is private;
(27)
          Packed_Unsigned   : constant Packed_Format;
          Packed_Signed     : constant Packed_Format;
(28)
       -- Types for external representation of COBOL binary data
(29)
          type Byte is mod 2**COBOL_Character'Size;
          type Byte_Array is array (Positive range <>) of Byte;
          pragma Pack (Byte_Array);
(30)
          Conversion_Error : exception;
(31)
          generic
             type Num is delta <> digits <>;
          package Decimal_Conversions is
(32)
             -- Display Formats: data values are represented as Numeric
(33)
             function Valid (Item   : in Numeric;
                             Format : in Display_Format) return Boolean;
(34)
             function Length (Format : in Display_Format) return Natural;
(35)
             function To_Decimal (Item   : in Numeric;
                                  Format : in Display_Format) return Num;
(36)
             function To_Display (Item   : in Num;
                                  Format : in Display_Format) return Numeric;
(37)
             -- Packed Formats: data values are represented as Packed_Decimal
(38)
             function Valid (Item   : in Packed_Decimal;
                             Format : in Packed_Format) return Boolean;
(39)
             function Length (Format : in Packed_Format) return Natural;
(40)
             function To_Decimal (Item   : in Packed_Decimal;
                                  Format : in Packed_Format) return Num;
(41)
             function To_Packed (Item   : in Num;
                                 Format : in Packed_Format) return Packed_Decimal;
(42)
             -- Binary Formats: external data values are represented as Byte_Array
(43)
             function Valid (Item   : in Byte_Array;
                             Format : in Binary_Format) return Boolean;
(44)
             function Length (Format : in Binary_Format) return Natural;
             function To_Decimal (Item   : in Byte_Array;
                                  Format : in Binary_Format) return Num;
(45)
             function To_Binary (Item   : in Num;
                               Format : in Binary_Format) return Byte_Array;
(46)
             -- Internal Binary formats: data values are of type Binary or Long_Binary
(47)
             function To_Decimal (Item : in Binary)      return Num;
             function To_Decimal (Item : in Long_Binary) return Num;
(48)
             function To_Binary      (Item : in Num)  return Binary;
             function To_Long_Binary (Item : in Num)  return Long_Binary;
(49)
          end Decimal_Conversions;
(50)
       private
          ... -- not specified by the language
       end Interfaces.COBOL;
(51)
Each of the types in Interfaces.COBOL is COBOL-compatible.
(52)
The types Floating and Long_Floating correspond to the native types in COBOL for data items with computational usage implemented by floating point. The types Binary and Long_Binary correspond to the native types in COBOL for data items with binary usage, or with computational usage implemented by binary.
(53)
Max_Digits_Binary is the largest number of decimal digits in a numeric value that is represented as Binary. Max_Digits_Long_Binary is the largest number of decimal digits in a numeric value that is represented as Long_Binary.
(54)
The type Packed_Decimal corresponds to COBOL's packed-decimal usage.
(55)
The type COBOL_Character defines the run-time character set used in the COBOL implementation. Ada_To_COBOL and COBOL_To_Ada are the mappings between the Ada and COBOL run-time character sets.
(56)
Type Alphanumeric corresponds to COBOL's alphanumeric data category.
(57)
Each of the functions To_COBOL and To_Ada converts its parameter based on the mappings Ada_To_COBOL and COBOL_To_Ada, respectively. The length of the result for each is the length of the parameter, and the lower bound of the result is 1. Each component of the result is obtained by applying the relevant mapping to the corresponding component of the parameter.
(58)
Each of the procedures To_COBOL and To_Ada copies converted elements from Item to Target, using the appropriate mapping (Ada_To_COBOL or COBOL_To_Ada, respectively). The index in Target of the last element assigned is returned in Last (0 if Item is a null array). If Item'Length exceeds Target'Length, Constraint_Error is propagated.
(59)
Type Numeric corresponds to COBOL's numeric data category with display usage.
(60)
The types Display_Format, Binary_Format, and Packed_Format are used in conversions between Ada decimal type values and COBOL internal or external data representations. The value of the constant Native_Binary is either High_Order_First or Low_Order_First, depending on the implementation.
(61)
       function Valid (Item   : in Numeric;
                       Format : in Display_Format) return Boolean;
(62)
(63)
(64)
(65)
(66)
       function Length (Format : in Display_Format) return Natural;
(67)
(68)
       function To_Decimal (Item   : in Numeric;
                            Format : in Display_Format) return Num;
(69)
(70)
       function To_Display (Item   : in Num;
                            Format : in Display_Format) return Numeric;
(71)
(72)
       function Valid (Item   : in Packed_Decimal;
                       Format : in Packed_Format) return Boolean;
(73)
(74)
       function Length (Format : in Packed_Format) return Natural;
(75)
(76)
       function To_Decimal (Item   : in Packed_Decimal;
                            Format : in Packed_Format) return Num;
(77)
(78)
       function To_Packed (Item   : in Num;
                           Format : in Packed_Format) return Packed_Decimal;
(79)
(80)
       function Valid (Item   : in Byte_Array;
                       Format : in Binary_Format) return Boolean;
(81)
(82)
       function Length (Format : in Binary_Format) return Natural;
(83)
(84)
       function To_Decimal (Item   : in Byte_Array;
                            Format : in Binary_Format) return Num;
(85)
(86)
       function To_Binary (Item   : in Num;
                           Format : in Binary_Format) return Byte_Array;
(87)
(88)
       function To_Decimal (Item : in Binary)      return Num;

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

       function To_Long_Binary (Item : in Num)  return Long_Binary;
(91)
Implementation Requirements
(92)
An implementation shall support pragma Convention with a COBOL convention_identifier for a COBOL-eligible type (see B.1).
Implementation Permissions
(93)
An implementation may provide additional constants of the private types Display_Format, Binary_Format, or Packed_Format.
(94)
An implementation may provide further floating point and integer types in Interfaces.COBOL to match additional native COBOL types, and may also supply corresponding conversion functions in the generic package Decimal_Conversions.
Implementation Advice
(95)
An Ada implementation should support the following interface correspondences between Ada and COBOL.
(96)
(97)
(98)

(99)
(100)
Examples
(101)
Examples of Interfaces.COBOL:
(102)
       with Interfaces.COBOL;
       procedure Test_Call is
(103)
          -- Calling a foreign COBOL program
          -- Assume that a COBOL program PROG has the following declaration
          --  in its LINKAGE section:
          --  01 Parameter-Area
          --     05 NAME   PIC X(20).
          --     05 SSN    PIC X(9).
          --     05 SALARY PIC 99999V99 USAGE COMP.
          -- The effect of PROG is to update SALARY based on some algorithm
(104)
          package COBOL renames Interfaces.COBOL;
(105)
          type Salary_Type is delta 0.01 digits 7;
(106)
          type COBOL_Record is
             record
                Name   : COBOL.Numeric(1..20);
                SSN    : COBOL.Numeric(1..9);
                Salary : COBOL.Binary;  -- Assume Binary = 32 bits
             end record;
          pragma Convention (COBOL, COBOL_Record);
(107)
          procedure Prog (Item : in out COBOL_Record);
          pragma Import (COBOL, Prog, "PROG");
(108)
          package Salary_Conversions is
             new COBOL.Decimal_Conversions(Salary_Type);
(109)
          Some_Salary : Salary_Type := 12_345.67;
          Some_Record : COBOL_Record :=
             (Name   => "Johnson, John       ",
              SSN    => "111223333",
              Salary => Salary_Conversions.To_Binary(Some_Salary));
(110)
       begin
          Prog (Some_Record);
          ...
       end Test_Call;
(111)
       with Interfaces.COBOL;
       with COBOL_Sequential_IO; -- Assumed to be supplied by implementation
       procedure Test_External_Formats is
(112)
          -- Using data created by a COBOL program
          -- Assume that a COBOL program has created a sequential file with
          --  the following record structure, and that we need to
          --  process the records in an Ada program
          --  01 EMPLOYEE-RECORD
          --     05 NAME    PIC X(20).
          --     05 SSN     PIC X(9).
          --     05 SALARY  PIC 99999V99 USAGE COMP.
          --     05 ADJUST  PIC S999V999 SIGN LEADING SEPARATE.
          -- The COMP data is binary (32 bits), high-order byte first
(113)
          package COBOL renames Interfaces.COBOL;
(114)
          type Salary_Type      is delta 0.01  digits 7;
          type Adjustments_Type is delta 0.001 digits 6;
(115)
          type COBOL_Employee_Record_Type is  -- External representation
             record
                Name    : COBOL.Alphanumeric(1..20);
                SSN     : COBOL.Alphanumeric(1..9);
                Salary  : COBOL.Byte_Array(1..4);
                Adjust  : COBOL.Numeric(1..7);  -- Sign and 6 digits
             end record;
          pragma Convention (COBOL, COBOL_Employee_Record_Type);
(116)
          package COBOL_Employee_IO is
             new COBOL_Sequential_IO(COBOL_Employee_Record_Type);
          use COBOL_Employee_IO;
(117)
          COBOL_File : File_Type;
(118)
          type Ada_Employee_Record_Type is  -- Internal representation
             record
                Name    : String(1..20);
                SSN     : String(1..9);
                Salary  : Salary_Type;
                Adjust  : Adjustments_Type;
             end record;
(119)
          COBOL_Record : COBOL_Employee_Record_Type;
          Ada_Record   : Ada_Employee_Record_Type;
(120)
          package Salary_Conversions is
             new COBOL.Decimal_Conversions(Salary_Type);
          use Salary_Conversions;
(121)
          package Adjustments_Conversions is
             new COBOL.Decimal_Conversions(Adjustments_Type);
          use Adjustments_Conversions;
(122)
       begin
          Open (COBOL_File, Name => "Some_File");
(123)
          loop
            Read (COBOL_File, COBOL_Record);
(124)
            Ada_Record.Name := To_Ada(COBOL_Record.Name);
            Ada_Record.SSN  := To_Ada(COBOL_Record.SSN);
            Ada_Record.Salary :=
               To_Decimal(COBOL_Record.Salary, COBOL.High_Order_First);
            Ada_Record.Adjust :=
               To_Decimal(COBOL_Record.Adjust, COBOL.Leading_Separate);
            ... -- Process Ada_Record
          end loop;
       exception
          when End_Error => ...
       end Test_External_Formats;


Prev | Up | Next | Back | Forward
TOC -- / --.-- / --.--.-- | Index | Search | Syntax | Help

Ada WWW Home -- Email comments, additions, corrections, gripes, kudos, etc. to:

Magnus Kempe -- Magnus.Kempe@di.epfl.ch
Copyright statement
Page last generated: 95-03-12