package Interfaces.COBOL is pragma Preelaborate(COBOL);
-- Types and operations for internal data representations
type Floating is digits implementation-defined; type Long_Floating is digits implementation-defined;
type Binary is range implementation-defined; type Long_Binary is range implementation-defined;
Max_Digits_Binary : constant := implementation-defined; Max_Digits_Long_Binary : constant := implementation-defined;
   type Decimal_Element  is mod implementation-defined;
   type Packed_Decimal is
     array (Positive range <>) of Decimal_Element;
   pragma Pack(Packed_Decimal);
type COBOL_Character is implementation-defined character type;
   Ada_To_COBOL : array (Character) of COBOL_Character
     := implementation-defined;
   COBOL_To_Ada : array (COBOL_Character) of Character
     := implementation-defined;
   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 Packed_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_Binary (Item   : in Num;
                        Format : in Binary_Format)
        return Byte_Array;
      -- Internal Binary formats:
      -- data values are of type Binary or 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 ... -- not specified by the language end Interfaces.COBOL;
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;
function Valid (Item   : in Packed_Decimal;
                Format : in Packed_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;
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_Binary (Item   : in Num;
                    Format : in Binary_Format) return Byte_Array;
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;
NOTES
with Interfaces.COBOL; procedure Test_Call is
-- 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
package COBOL renames Interfaces.COBOL;
type Salary_Type is delta 0.01 digits 7;
   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);
procedure Prog (Item : in out COBOL_Record); pragma Import (COBOL, Prog, "PROG");
   package Salary_Conversions is
      new COBOL.Decimal_Conversions(Salary_Type);
   Some_Salary : Salary_Type := 12_345.67;
   Some_Record : COBOL_Record :=
      (Name   => "Johnson, John       ",
       SSN    => "111223333",
       Salary => Salary_Conversions.To_Binary(Some_Salary));
begin Prog (Some_Record); ... end Test_Call;
with Interfaces.COBOL; with COBOL_Sequential_IO; -- Assumed to be supplied by implementation procedure Test_External_Formats is
-- 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
package COBOL renames Interfaces.COBOL;
type Salary_Type is delta 0.01 digits 7; type Adjustments_Type is delta 0.001 digits 6;
   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);
   package COBOL_Employee_IO is
      new COBOL_Sequential_IO(COBOL_Employee_Record_Type);
   use COBOL_Employee_IO;
COBOL_File : File_Type;
   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;
COBOL_Record : COBOL_Employee_Record_Type; Ada_Record : Ada_Employee_Record_Type;
   package Salary_Conversions is
      new COBOL.Decimal_Conversions(Salary_Type);
   use Salary_Conversions;
   package Adjustments_Conversions is
      new COBOL.Decimal_Conversions(Adjustments_Type);
   use Adjustments_Conversions;
begin Open (COBOL_File, Name => "Some_File");
   loop
     Read (COBOL_File, COBOL_Record);
     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;
Go to the first, previous, next, last section, table of contents.