How Non-Pascal Programs Call Pascal Routines [ HP Pascal/iX Programmer's Guide ] MPE/iX 5.0 Documentation
HP Pascal/iX Programmer's Guide
How Non-Pascal Programs Call Pascal Routines
A program written in C, COBOL II, FORTRAN 66/V, FORTRAN 77, or SPL can
call an external routine written in HP Pascal. You must match the formal
parameters and result type of the HP Pascal routine with those that the
calling program specifies.
The matching rules are:
* Corresponding formal parameter lists must have the same number of
parameters in the same order. If the Pascal routine requires
hidden parameters, the non-Pascal routine must have actual
parameters that correspond to them (see Chapter 7 for
details).
* Corresponding formal parameters must be of corresponding types.
Correspondence depends upon the source language of the external
routine. See the parameter descriptions in "EXTERNAL Directive"
.
* Corresponding formal parameters can have different names.
Example 1
This C program calls the external Pascal procedure pas:
main()
{ extern void pas(); /*This is non ANSI C */
char carr[21];
short sint1, sint2;
short sum;
strcpy(carr, "Add these 2 numbers ");
sint1 = 25;
sint2 = 15;
pas(carr, sint1, sint2, &sum);
}
This Pascal program contains the procedure pas:
$SUBPROGRAM$
PROGRAM Pas_Proc;
TYPE
arr = PACKED ARRAY [1..21] OF char;
PROCEDURE pas (VAR carr : arr;
sint1 : shortint;
sint2 : shortint;
VAR sum : shortint);
BEGIN
carr := 'Sum of two numbers: '#0;
sum := sint1 + sint2;
END;
BEGIN
END.
Example 2
The COBOL II program COBOL-TO-PASCAL calls the external Pascal procedure
pasprog.
COBOL II program:
IDENTIFICATION DIVISION.
PROGRAM-ID. COBOL-TO-PASCAL.
AUTHOR. BP.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 ASTRING PIC X(16) VALUE "A COBOL STRING!".
77 ANUM PIC 9(04) USAGE COMP.
77 ANUM2 PIC 9(04) USAGE COMP.
77 RESULT PIC -ZZZZ.
PROCEDURE DIVISION.
FIRST-PARA.
MOVE 9999 TO ANUM.
DISPLAY ASTRING.
CALL "PASPROG" USING ASTRING, \ANUM\, ANUM2.
MOVE ANUM2 TO RESULT.
DISPLAY ASTRING, RESULT.
STOP RUN.
Pascal procedure:
$SUBPROGRAM$
PROGRAM pas_proc;
TYPE
charstr = PACKED ARRAY [1..16] OF char;
PROCEDURE pasprog(VAR astr : charstr;
num : short_int;
VAR num2 : short_int);
BEGIN
astr := 'A PASCAL STRING!';
num2 := num;
END;
BEGIN
END.
Example 3
The following FORTRAN 66/V program calls the external Pascal procedure
pas:
INTEGER INT1, INT2, ISUM
CHARACTER CSTR*20
CSTR = "Add these 2 numbers"
INT1 = 25
INT2 = 15
DISPLAY CSTR, INT1, INT2
CALL PAS(CSTR,\INT1\,\INT2\,ISUM)
DISPLAY CSTR, ISUM
STOP
END
Pascal procedure:
$SUBPROGRAM$
PROGRAM example(input,output);
TYPE
arr = PACKED ARRAY [1..20] OF char;
small_int = -32768..32767;
PROCEDURE pas $CHECK_ACTUAL_PARM 0; CHECK_FORMAL_PARM 0$
(VAR carr : arr;
sint : small_int;
sint2 : small_int;
VAR sum : small_int);
BEGIN
carr := 'Sum of two numbers: ';
sum := sint1 + sint2;
END;
BEGIN
END.
Example 4
The following FORTRAN77 program calls the external Pascal procedure pas:
$ALIAS PAS(%REF,%VAL,%VAL,%REF)
INTEGER INT1, INT2, ISUM
CHARACTER CSTR*20
CSTR = "Add these 2 numbers"
INT1 = 25
INT2 = 15
PRINT *, CSTR, INT1, INT2
CALL PAS(CSTR, INT1, INT2, ISUM)
PRINT *, CSTR, ISUM
STOP
END
Pascal procedure:
$SUBPROGRAM$
PROGRAM example;
TYPE
arr = PACKED ARRAY [1..20] OF char;
small_int = -32768..32767;
PROCEDURE pas(VAR carr : arr;
sint : small_int;
sint2 : small_int;
VAR sum : small_int);
BEGIN
carr := 'Sum of two numbers: ';
sum := sint1 + sint2;
END;
BEGIN
END.
Example 5
The following SPL program calls the external Pascal procedure pas:
BEGIN
LOGICAL ARRAY chr(0:9) := "Add these 2 numbers:";
BYTE ARRAY bchr(*) = chr;
INTEGER sint:=15,sint2:=25,len;
INTEGER int, int2, sum;
BYTE ARRAY csum(0:1), cint(0:1), cint2(0:1);
INTRINSIC PRINT,ASCII
PROCEDURE pas(chr,sint,sint2,sum);
VALUE sint,sint2;
INTEGER sint,sint2,sum;
BYTE ARRAY chr;
OPTION EXTERNAL;
PRINT(chr,10,0);
len := ASCII(sint,-10,cint);
len := ASCII(sint2,-10,cint2);
PRINT(cint,-2,0);
PRINT(cint2,-2,0);
pas(chr,sint,sint2,sum);
PRINT(chr,10,0);
len := ASCII(sum,-10,csum);
PRINT(csum,-2,0);
END.
Pascal procedure:
$HP3000_16$
$SUBPROGRAM$
PROGRAM example;
TYPE
arr = PACKED ARRAY [1..20] OF char;
small_int = -32768..32767;
PROCEDURE pas(VAR carr : arr;
sint : small_int;
sint2 : small_int;
VAR sum : small_int);
BEGIN
carr := 'Sum of two numbers: ';
sum := sint1 + sint2;
END;
BEGIN
END.
MPE/iX 5.0 Documentation