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.