Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/16/phfo.mac
There are 2 other files named phfo.mac in the archive. Click here to see a list.
	SUBTTL	FORTRAN INTERFACE PROCEDURE

; AUTHOR:	LARS ENDERIN
; VERSION:	1
; PURPOSE:	Acts as procedure body for a FORTRAN procedure
;		i e takes care of differences between calling sequences
;		so that the FORTRAN procedure acts to the SIMULA
;		program as if it were a SIMULA procedure.

; CONTENTS:

	ENTRY	.PHFO

	SEARCH	SIMMAC,SIMRPA,SIMMCR

	RTITLE	PHFO
	SALL
	MACINIT
	ERRMAC	PH


	;REGISTER ASSIGNMENTS;
	;--------------------;

XAT=	X13	;Actual parameter type
XFT=	X11	;Formal parameter type
XFK=	X10	;Formal parameter kind
XFP=	X7	;Formal parameter list pointer
XFAD=	X6	;Formal location address

XFL0=	X5	;First word of ZFL
XRHT=	X11	;Right hand side type (.PHCV parameter)
XLHT=	X13	;Left  hand side type (.PHCV parameter)
	SUBTTL	.PHFO

Comment;

Purpose:	PHFO acts as interface between SIMULA and FORTRAN,
		allowing a FORTRAN procedure to be called as if it were
		a SIMULA procedure.

Input:		XCB points to a procedure instance corresponding to a special
		prototype. The procedure instance holds parameter
		values, space for book-keeping, and an address list area
		to be filled with addresses to the parameters as required
		by FORTRAN. The address of the FORTRAN code is found
		in the symbol table (XCB.ZBIZPR.ZPRSYM.ZSMFOR).

Output:		Whatever the FORTRAN procedure produces, possibly
		a function value (returned by FORTRAN in X0 (+X1)).

Function:	The formal parameter list, if any, is scanned. Any para-
		meter which is not in a form acceptable to FORTRAN is
		evaluated to an acceptable form. For NAME mode parameters,
		the formal location (ZFL) is evaluated by one of the
		standard parameter handling procedures (PHFA,PHFV,PHFM)
		to yield a value or an address. If a value is
		computed rather than an address, an anonymous cell
		in the procedure block gets the value, and the address of
		that cell is put into the address list. If the actual
		parameter is a simple variable (possibly accessed
		via dot notation or as an array element), its dynamic
		address is put into the address list, except if the
		actual type is different from the formal type, when
		the value must be converted before and after the call
		to the FORTRAN subroutine. In this case an anonymous cell
		is also used. For an array, the address of the first element
		must be used. When all parameters have been scanned,
		the absolute addresses are computed, and the FORTRAN
		procedure is called (different calling seq. for F40 resp
		FORTRAN 10). Any conversion of differently typed values
		is carried out (from temporary cell to ordinary cell),
		the function result, if any is stored in the block (two
		words are always reserved). If the FORTRAN procedure is
		a function, return via CSEP, otherwise goto ZDRARE with
		XCB=ZDRZBI.
;
	SUBTTL	.PHFO, PROCEDURE BLOCK LAYOUT

Comment;
	0	+-----------------------+
		!	ZBI		!
	2	!-----------------------!
		! Space for function	!
		!    value		!
	4	!-----------------------!
		!	YFOFAD		!
	5	!-----------------------!
		!	YFOAAD		!
	6	!-----------------------!
		!	YFOPAD		!
	7	!-----------------------!
		!	Parameter 	!	Computed at parameter transfer
		!	locations	!	(SIMULA procedure call)
	ZMPDOV	!-----------------------!
		! Temporary cells for	!	Used when types differ or actual is
		! values of NAME para-	!	a constant or expression (cannot
		! meters		!	store into actual parameter)
		!-----------------------!	
		! Address list header	!	FORTRAN-10: -ZPCNRP,,0
	ZMPDRV	!-----------------------!	F40: JSA X16,ZSMFOR
		! Dynamic addresses for	!
		! actual parameters,	!
		! transformed to abs	!
		! addresses before call-!
		! ing FORTRAN subrout.	!
		!-----------------------!
		! Address list trailer	!	F40: JRST back to .PHFO
		+-----------------------+
;
	SUBTTL	.PHFO

.PHFO:	PROC
	LOWADR
	CFORBID
	EXEC	PHFOAD
	IF	;Any parameters
		SKIPL	OFFSET(ZPCPAR)(XSAC)
		GOTO	FALSE
	THEN
		SKIPA	XFP,YFOFAD(XCB)
		LOOP
			ST	XFP,YFOFAD(XCB)
			EXEC	PHFO.1
		AS
			L	XFP,YFOFAD(XCB)
			AOBJN	XFP,TRUE
		SA
		EXEC	PHFOAD
		IFON	ZPCNAM(XSAC)
		EXEC	PHFO.2
	FI
	LOWADR
	ST	XCB,YFOXCB(XLOW)
	LF	XTAC,ZPCNRP(XSAC)
	LF	XWAC1,ZPRSYM(XSAC)
	LF	XWAC1,ZSMFOR(XWAC1)

	IF	;F40
		IFOFF	ZPCF40(XSAC)
		GOTO	FALSE
	THEN	;Put in instructions before and after address list
		HRLI	XWAC1,(JSA	X16,)
		LI	XWAC2,@YFOAAD(XCB)
		ST	XWAC1,-1(XWAC2)
		ADDI	XTAC,(XWAC2)
		L	[BRANCH	L1()]
		ST	(XTAC)
		BRANCH	-1(XWAC2)
	ELSE	;FORTRAN-10
		MOVN	XTAC
		LI	X16,@YFOAAD(XCB)
		HRLM	-1(X16)
		EXEC	0(XWAC1)
	FI
L1():!	;Return point here
	LOWADR
	L	XCB,YFOXCB(XLOW)
	SETZM	YFOXCB(XLOW)
	STD	X0,ZBI%S(XCB)	;Store any function result
	EXEC	PHFOAD
	IF	;Any parameter of mode NAME
		SKIPL	OFFSET(ZPCPAR)(XSAC)
		GOTO	FALSE
		IFOFF	ZPCNAM(XSAC)
		GOTO	FALSE
	THEN
		SKIPA	XFP,YFOFAD(XCB)
		LOOP
			ST	XFP,YFOFAD(XCB)
			LF	,ZFPMOD(XFP)
			CAIN	QNAME
			EXEC	PHFO.3
		AS
			L	XFP,YFOFAD(XCB)
			AOBJN	XFP,TRUE
		SA
	FI
	LF	,ZPCTYP(XSAC)
	IF	;Type procedure
		CAIN	QNOTYPE
		GOTO	FALSE
		JUMPE	FALSE
	THEN	LI	XSAC,CSEP
	ELSE
		LF	XSAC,ZDRARE(XCB)
		LF	XCB,ZDRZBI(XCB)
	FI
	CALLOW
	JSP	(XSAC)
	EPROC
PHFO.1:	PROC
	LF	XWAC2,ZFPOFS(XFP)
	LI	XWAC1,(XCB)
	HRL	XWAC1,XWAC2	;Dynamic address of formal loc
	LF	,ZFPMOD(XFP)
	IF	;NAME mode
		CAIE	QNAME
		GOTO	FALSE
	THEN
		EXEC	PHFOFL
		IF	CAIE	XFK,QARRAY
			GOTO	FALSE
		THEN
			EXEC	PHFM
			Z
			LI	2
			ADDM	YFOPAD(XCB)
			GOTO	L2
		FI
		IF	IFOFFA	ZFLVTD(XFL0)
			GOTO	FALSE
		THEN	;Constant or expression, use PHFV
			GOTO	L1
		ELSE
			EXEC	PHFA
			Z
			EXEC	PHFOFL
			;Simplify ZFL
			SETONA	ZFLNTH(XFL0)
			SF	XWAC1,ZFLZBI(,XFL0)
			SETF	QDTVSI,ZFLDTP(,XFL0)
			ST	XFL0,(XFAD)
			HLRZM	XWAC1,OFFSET(ZFLOFS)(XFAD)
			IF	;Conversion necessary
				IFOFFA	ZFLCNV(XFL0)
				GOTO	FALSE
			THEN	;Compute converted value and save in tmp loc
				HRLZ	XWAC1,(XFP)
				HRRI	XWAC1,(XCB)
	L1():!			EXEC	PHFV
				Z
				EXEC	PHFOFL
				STD	XWAC1,@YFOPAD(XCB)
				;Dyn. address of temp loc
				HRLZ	XWAC1,YFOPAD(XCB)
				HRRI	XWAC1,(XCB)
		FI	FI
		LI	2
		ADDM	YFOPAD(XCB)
	ELSE	;Reference or value mode
		LF	XFK,ZPDKND(XFP)
		IF	CAIE	XFK,QARRAY
			GOTO	FALSE
		THEN	;Compute address of first element of array
			ADDI	XWAC1,(XWAC2)
			L	XWAC1,(XWAC1)
	L2():!		LF	XWAC2,ZARSUB(XWAC1)
			IMULI	XWAC2,3
			ADDI	XWAC2,3
			HRL	XWAC1,XWAC2
	FI	FI
	LF	XSAC,ZBIZPR(XCB)
	IF	;no name parameter
		IFON	ZPCNAM(XSAC)
		GOTO	FALSE
	THEN	;No name param, abs address directly
		HLRZ	XWAC2,XWAC1
		ADDI	XWAC1,(XWAC2)
		;PUT IN TYPE CODE
		LF	XFT,ZTDTYP(XFP)
		HRL	XWAC1,PHFOTY(XFT)
		IFON	ZPCF40(XSAC)
		HLL	XWAC1,PHFOTY(XFT)
	FI
	ST	XWAC1,@YFOAAD(XCB)
	AOS	YFOAAD(XCB)
	RETURN
	EPROC
PHFO.2:	PROC
	;Convert dynamic addresses in address list to absolute addresses
	LF	XTAC,ZPCNRP(XSAC)
	LOOP
		L	XWAC1,@YFOAAD(XCB)
		HLRZ	XWAC2,XWAC1
		ADDI	XWAC2,(XWAC1)
		ST	XWAC2,@YFOAAD(XCB)
		AOS	YFOAAD(XCB)
		L	XFP,@YFOFAD(XCB)
		LF	XFT,ZTDTYP(XFP)
		;PUT IN TYPE CODE
		HRL	XWAC1,PHFOTY(XFT)
		IFON	ZPCF40(XSAC)
		HLL	XWAC1,PHFOTY(XFT)
		AOS	YFOFAD(XCB)
	AS
		SOJG	XTAC,TRUE
	SA
	EXEC	PHFOAD
	RETURN
	EPROC
PHFO.3:	PROC
	;Perform any necessary conversion before returning name parameter
	;value from the FORTRAN procedure
	EXEC	PHFOFL
	IF	;an address was passed as actual parameter
		IFONA	ZFLVTD(XFAD)
		GOTO	FALSE
	THEN	;the value should be returned to caller
		LF	XLHT,ZFLATP(XFAD)
		LD	XWAC1,@YFOPAD(XCB)
		IF	;Conversion called for
			IFOFFA	ZFLCNV(XFL0)
			GOTO	FALSE
		THEN
			LF	XRHT,ZFLFTP(XFAD)
			EXEC	PHCV
			LF	X0,ZFLZBI(XFAD)
			LF	XTAC,ZFLOFS(XFAD)
			ADD	XTAC,X0
			ST	XWAC1,(XTAC)
			CAIN	XLHT,QLREAL
			ST	XWAC2,1(XTAC)
	FI	FI
	LI	2
	ADDM	YFOPAD(XCB)
	RETURN
	EPROC
PHFOAD:	PROC
	LF	XSAC,ZBIZPR(XCB)
	LF	XTAC,ZPCNRP(XSAC)
	MOVSI	(Z	(XCB))	;INDEX=XCB
	LF	XFP,ZPRMAP(XSAC)
	HRR	OFFSET(ZMPDRV)(XFP)
	ST	YFOAAD(XCB)
	HRR	OFFSET(ZMPDOV)(XFP)
	ST	YFOPAD(XCB)
	MOVN	XFP,XTAC
	MOVSS	XFP
	HRRI	XFP,ZPC%S(XSAC)
	ST	XFP,YFOFAD(XCB)
	RETURN
	EPROC


PHFOFL:	L	XFP,YFOFAD(XCB)
	LF	XFAD,ZFPOFS(XFP)
	ADDI	XFAD,(XCB)
	L	XFL0,(XFAD)
	LF	XFK,ZPDKND(XFP)
	RETURN

	OPDEF	ARG	[JUMP]
PHFOTY:	;Type code table for FORTRAN , lhs=F40, rhs=F10
	ARG	0,0	;UNDEF
	ARG	0,100	;INTEGER
	ARG	2,200	;REAL
	ARG	6,400	;LONG REAL
	ARG	0,100	;CHARACTER==INTEGER
	ARG	3,40	;BOOLEAN
	LIT
	END