(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;
(61)
function Valid (Item : in Numeric;
Format : in Display_Format) return Boolean;
(66)
function Length (Format : in Display_Format) return Natural;
(68)
function To_Decimal (Item : in Numeric;
Format : in Display_Format) return Num;
(70)
function To_Display (Item : in Num;
Format : in Display_Format) return Numeric;
(72)
function Valid (Item : in Packed_Decimal;
Format : in Packed_Format) return Boolean;
(74)
function Length (Format : in Packed_Format) return Natural;
(76)
function To_Decimal (Item : in Packed_Decimal;
Format : in Packed_Format) return Num;
(78)
function To_Packed (Item : in Num;
Format : in Packed_Format) return Packed_Decimal;
(80)
function Valid (Item : in Byte_Array;
Format : in Binary_Format) return Boolean;
(82)
function Length (Format : in Binary_Format) return Natural;
(84)
function To_Decimal (Item : in Byte_Array;
Format : in Binary_Format) return Num;
(86)
function To_Binary (Item : in Num;
Format : in Binary_Format) return Byte_Array;
(88)
function To_Decimal (Item : in Binary) return Num;
function To_Decimal (Item : in Long_Binary) return Num;
(90)
function To_Binary (Item : in Num) return Binary;
function To_Long_Binary (Item : in Num) return Long_Binary;
(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;
-- Email comments, additions, corrections, gripes, kudos, etc. to: