pragma Import ([Convention =>] convention_identifier, [Entity =>] local_name [, [External_Name =>] string_expression] [, [Link_Name =>] string_expression]);
pragma Export ([Convention =>] convention_identifier, [Entity =>] local_name [, [External_Name =>] string_expression] [, [Link_Name =>] string_expression]);
pragma Convention ([Convention =>] convention_identifier, [Entity =>] local_name);
pragma Linker_Options(string_expression);
Name Resolution Rules
package Fortran_Library is function Sqrt (X : Float) return Float; function Exp (X : Float) return Float; private pragma Import(Fortran, Sqrt); pragma Import(Fortran, Exp); end Fortran_Library;
package Interfaces is pragma Pure(Interfaces);
type Integer_n is range -2**(n-1) .. 2**(n-1) - 1; -- 2's complement
type Unsigned_n is mod 2**n;
function Shift_Left (Value : Unsigned_n;
Amount : Natural) return Unsigned_n;
function Shift_Right (Value : Unsigned_n;
Amount : Natural) return Unsigned_n;
function Shift_Right_Arithmetic (Value : Unsigned_n;
Amount : Natural)
return Unsigned_n;
function Rotate_Left (Value : Unsigned_n;
Amount : Natural) return Unsigned_n;
function Rotate_Right (Value : Unsigned_n;
Amount : Natural) return Unsigned_n;
...
end Interfaces;
Implementation Requirements
Implementation Permissions
package Interfaces.C is pragma Pure(C);
-- Declarations based on C's <limits.h>
CHAR_BIT : constant := implementation-defined; -- typically 8 SCHAR_MIN : constant := implementation-defined; -- typically -128 SCHAR_MAX : constant := implementation-defined; -- typically 127 UCHAR_MAX : constant := implementation-defined; -- typically 255
-- Signed and Unsigned Integers type int is range implementation-defined; type short is range implementation-defined; type long is range implementation-defined;
type signed_char is range SCHAR_MIN .. SCHAR_MAX; for signed_char'Size use CHAR_BIT;
type unsigned is mod implementation-defined; type unsigned_short is mod implementation-defined; type unsigned_long is mod implementation-defined;
type unsigned_char is mod (UCHAR_MAX+1); for unsigned_char'Size use CHAR_BIT;
subtype plain_char is implementation-defined;
type ptrdiff_t is range implementation-defined;
type size_t is mod implementation-defined;
-- Floating Point
type C_float is digits implementation-defined;
type double is digits implementation-defined;
type long_double is digits implementation-defined;
-- Characters and Strings
type char is <implementation-defined character type>;
nul : constant char := char'First;
function To_C (Item : in Character) return char;
function To_Ada (Item : in char) return Character;
type char_array is array (size_t range <>) of aliased char; pragma Pack(char_array); for char_array'Component_Size use CHAR_BIT;
function Is_Nul_Terminated (Item : in char_array) return Boolean;
function To_C (Item : in String;
Append_Nul : in Boolean := True)
return char_array;
function To_Ada (Item : in char_array;
Trim_Nul : in Boolean := True)
return String;
procedure To_C (Item : in String;
Target : out char_array;
Count : out size_t;
Append_Nul : in Boolean := True);
procedure To_Ada (Item : in char_array;
Target : out String;
Count : out Natural;
Trim_Nul : in Boolean := True);
-- Wide Character and Wide String
type wchar_t is implementation-defined;
wide_nul : constant wchar_t := wchar_t'First;
function To_C (Item : in Wide_Character) return wchar_t; function To_Ada (Item : in wchar_t ) return Wide_Character;
type wchar_array is array (size_t range <>) of aliased wchar_t;
pragma Pack(wchar_array);
function Is_Nul_Terminated (Item : in wchar_array)
return Boolean;
function To_C (Item : in Wide_String;
Append_Nul : in Boolean := True)
return wchar_array;
function To_Ada (Item : in wchar_array;
Trim_Nul : in Boolean := True)
return Wide_String;
procedure To_C (Item : in Wide_String;
Target : out wchar_array;
Count : out size_t;
Append_Nul : in Boolean := True);
procedure To_Ada (Item : in wchar_array;
Target : out Wide_String;
Count : out Natural;
Trim_Nul : in Boolean := True);
Terminator_Error : exception;
end Interfaces.C;
function To_C (Item : in Character) return char; function To_Ada (Item : in char ) return Character;
function Is_Nul_Terminated (Item : in char_array) return Boolean;
function To_C (Item : in String;
Append_Nul : in Boolean := True)
return char_array;
function To_Ada (Item : in char_array;
Trim_Nul : in Boolean := True)
return String;
procedure To_C (Item : in String;
Target : out char_array;
Count : out size_t;
Append_Nul : in Boolean := True);
procedure To_Ada (Item : in char_array;
Target : out String;
Count : out Natural;
Trim_Nul : in Boolean := True);
function Is_Nul_Terminated (Item : in wchar_array) return Boolean;
function To_C (Item : in Wide_Character) return wchar_t; function To_Ada (Item : in wchar_t ) return Wide_Character;
function To_C (Item : in Wide_String;
Append_Nul : in Boolean := True)
return wchar_array;
function To_Ada (Item : in wchar_array;
Trim_Nul : in Boolean := True)
return Wide_String;
procedure To_C (Item : in Wide_String;
Target : out wchar_array;
Count : out size_t;
Append_Nul : in Boolean := True);
procedure To_Ada (Item : in wchar_array;
Target : out Wide_String;
Count : out Natural;
Trim_Nul : in Boolean := True);
Implementation Requirements
--Calling the C Library Function strcpy with Interfaces.C; procedure Test is package C renames Interfaces.C; use type C.char_array; -- Call <string.h> strcpy: -- C definition of strcpy: -- char *strcpy(char *s1, const char *s2); -- This function copies the string pointed to by s2 -- (including the terminating null character) into the array -- pointed to by s1. If copying takes place between objects that -- overlap, the behavior is undefined. The strcpy function -- returns the value of s1.
-- Note: since the C function's return value is of no interest,
-- the Ada interface is a procedure
procedure Strcpy (Target : out C.char_array;
Source : in C.char_array);
pragma Import(C, Strcpy, "strcpy");
Chars1 : C.char_array(1..20); Chars2 : C.char_array(1..20);
begin Chars2(1..6) := "qwert" & C.nul;
Strcpy(Chars1, Chars2);
-- Now Chars1(1..6) = "qwert" & C.Nul
end Test;
package Interfaces.C.Strings is pragma Preelaborate(Strings);
type char_array_access is access all char_array;
type chars_ptr is private;
type chars_ptr_array is array (size_t range <>) of chars_ptr;
Null_Ptr : constant chars_ptr;
function To_Chars_Ptr (Item : in char_array_access;
Nul_Check : in Boolean := False)
return chars_ptr;
function New_Char_Array (Chars : in char_array) return chars_ptr;
function New_String (Str : in String) return chars_ptr;
procedure Free (Item : in out chars_ptr);
Dereference_Error : exception;
function Value (Item : in chars_ptr) return char_array;
function Value (Item : in chars_ptr; Length : in size_t)
return char_array;
function Value (Item : in chars_ptr) return String;
function Value (Item : in chars_ptr; Length : in size_t)
return String;
function Strlen (Item : in chars_ptr) return size_t;
procedure Update (Item : in chars_ptr;
Offset : in size_t;
Chars : in char_array;
Check : in Boolean := True);
procedure Update (Item : in chars_ptr;
Offset : in size_t;
Str : in String;
Check : in Boolean := True);
Update_Error : exception;
private ... -- not specified by the language end Interfaces.C.Strings;
function To_Chars_Ptr (Item : in char_array_access;
Nul_Check : in Boolean := False)
return chars_ptr;
function New_Char_Array (Chars : in char_array) return chars_ptr;
function New_String (Str : in String) return chars_ptr;
procedure Free (Item : in out chars_ptr);
function Value (Item : in chars_ptr) return char_array;
function Value (Item : in chars_ptr; Length : in size_t) return char_array;
function Value (Item : in chars_ptr) return String;
function Value (Item : in chars_ptr; Length : in size_t) return String;
function Strlen (Item : in chars_ptr) return size_t;
procedure Update (Item : in chars_ptr;
Offset : in size_t;
Chars : in char_array;
Check : Boolean := True);
procedure Update (Item : in chars_ptr;
Offset : in size_t;
Str : in String;
Check : in Boolean := True);
Erroneous Execution
generic type Index is (<>); type Element is private; type Element_Array is array (Index range <>) of aliased Element; Default_Terminator : Element; package Interfaces.C.Pointers is pragma Preelaborate(Pointers);
type Pointer is access all Element;
function Value(Ref : in Pointer;
Terminator : in Element := Default_Terminator)
return Element_Array;
function Value(Ref : in Pointer;
Length : in ptrdiff_t)
return Element_Array;
Pointer_Error : exception;
-- C-style Pointer arithmetic
function "+" (Left : in Pointer;
Right : in ptrdiff_t) return Pointer;
function "+" (Left : in ptrdiff_t;
Right : in Pointer) return Pointer;
function "-" (Left : in Pointer;
Right : in ptrdiff_t) return Pointer;
function "-" (Left : in Pointer;
Right : in Pointer) return ptrdiff_t;
procedure Increment (Ref : in out Pointer); procedure Decrement (Ref : in out Pointer);
pragma Convention (Intrinsic, "+"); pragma Convention (Intrinsic, "-"); pragma Convention (Intrinsic, Increment); pragma Convention (Intrinsic, Decrement);
function Virtual_Length
(Ref : in Pointer;
Terminator : in Element := Default_Terminator)
return ptrdiff_t;
procedure Copy_Terminated_Array
(Source : in Pointer;
Target : in Pointer;
Limit : in ptrdiff_t := ptrdiff_t'Last;
Terminator : in Element := Default_Terminator);
procedure Copy_Array (Source : in Pointer;
Target : in Pointer;
Length : in ptrdiff_t);
end Interfaces.C.Pointers;
function Value(Ref : in Pointer;
Terminator : in Element := Default_Terminator)
return Element_Array;
function Value(Ref : in Pointer;
Length : in ptrdiff_t)
return Element_Array;
procedure Increment (Ref : in out Pointer);
procedure Decrement (Ref : in out Pointer);
function Virtual_Length (Ref : in Pointer; Terminator : in Element := Default_Terminator) return ptrdiff_t;
procedure Copy_Terminated_Array (Source : in Pointer; Target : in Pointer; Limit : in ptrdiff_t := ptrdiff_t'Last; Terminator : in Element := Default_Terminator);
procedure Copy_Array (Source : in Pointer;
Target : in Pointer;
Length : in ptrdiff_t);
Erroneous Execution
Some_Array : Element_Array(0..5) ; Some_Pointer : Pointer := Some_Array(0)'Access;Examples
with Interfaces.C.Pointers;
with Interfaces.C.Strings;
procedure Test_Pointers is
package C renames Interfaces.C;
package Char_Ptrs is
new C.Pointers (Index => C.size_t,
Element => C.char,
Element_Array => C.char_array,
Default_Terminator => C.nul);
use type Char_Ptrs.Pointer; subtype Char_Star is Char_Ptrs.Pointer;
procedure Strcpy (Target_Ptr, Source_Ptr : Char_Star) is
Target_Temp_Ptr : Char_Star := Target_Ptr;
Source_Temp_Ptr : Char_Star := Source_Ptr;
Element : C.char;
begin
if Target_Temp_Ptr = null or Source_Temp_Ptr = null then
raise C.Strings.Dereference_Error;
end if;
loop
Element := Source_Temp_Ptr.all;
Target_Temp_Ptr.all := Element;
exit when Element = C.nul;
Char_Ptrs.Increment(Target_Temp_Ptr);
Char_Ptrs.Increment(Source_Temp_Ptr);
end loop;
end Strcpy;
begin
...
end Test_Pointers;
Static Semantics
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;
Implementation Requirements
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;
with Ada.Numerics.Generic_Complex_Types; -- see section Complex Types. pragma Elaborate_All(Ada.Numerics.Generic_Complex_Types); package Interfaces.Fortran is pragma Pure(Fortran);
type Fortran_Integer is range implementation-defined;
type Real is digits implementation-defined; type Double_Precision is digits implementation-defined;
type Logical is new Boolean;
package Single_Precision_Complex_Types is
new Ada.Numerics.Generic_Complex_Types (Real);
type Complex is new Single_Precision_Complex_Types.Complex;
subtype Imaginary is Single_Precision_Complex_Types.Imaginary; i : Imaginary renames Single_Precision_Complex_Types.i; j : Imaginary renames Single_Precision_Complex_Types.j;
type Character_Set is implementation-defined character type;
type Fortran_Character is
array (Positive range <>) of Character_Set;
pragma Pack (Fortran_Character);
function To_Fortran (Item : in Character) return Character_Set; function To_Ada (Item : in Character_Set) return Character;
function To_Fortran (Item : in String) return Fortran_Character; function To_Ada (Item : in Fortran_Character) return String;
procedure To_Fortran (Item : in String;
Target : out Fortran_Character;
Last : out Natural);
procedure To_Ada (Item : in Fortran_Character;
Target : out String;
Last : out Natural);
end Interfaces.Fortran;
with Interfaces.Fortran; use Interfaces.Fortran; procedure Ada_Application is
type Fortran_Matrix is array
(Integer range <>,
Integer range <>) of Double_Precision;
pragma Convention (Fortran, Fortran_Matrix);
-- stored in Fortran's column-major order
procedure Invert
(Rank : in Fortran_Integer;
X : in out Fortran_Matrix);
pragma Import (Fortran, Invert);
-- a Fortran subroutine
Rank : constant Fortran_Integer := 100; My_Matrix : Fortran_Matrix (1 .. Rank, 1 .. Rank);
begin
... My_Matrix := ...; ... Invert (Rank, My_Matrix); ...
end Ada_Application;
Go to the first, previous, next, last section, table of contents.