(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:
Magnus Kempe -- Magnus.Kempe@di.epfl.ch