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.