Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/17/ph.mac
There are 2 other files named ph.mac in the archive. Click here to see a list.
	SUBTTL	PARAMETER HANDLING MODULE

; AUTHOR:	LARS ENDERIN
;		UPDATED AT ACADIA UNIVERSITY FOR KA10
; VERSION:	[25,27,64,103,115,131,240]
; PURPOSE:	HANDLES PARAMETER TRANSMISSION FOR PROCEDURES

; CONTENTS:
intern	.PHCV	; Convert actual parameter value to formal type
intern	.PHFA	; Address of simple formal parameter
intern	.PHFM	; Dynamic address of formal array, procedure, switch
intern	.PHFS	; Store value of actual parameter
intern	.PHFT	; Dynamic formal text representation
intern	.PHFV	; Value of simple actual parameter

	SALL
	SEARCH	SIMMAC,SIMRPA,SIMMCR

	RTITLE	PH
	ERRMAC	PH
	MACINIT

	TWOSEG
	RELOC	400K



	EXTERN	.CSRA,.CSSA.,.SAAR


;-- LOCAL DEFINITIONS

IFE <%ZFLNTH>,<DEFINE NOTHUNK(A)<JUMPGE A,FALSE>>
IFN <%ZFLNTH>,<DEFINE NOTHUNK(A)<IFOFFA ZFLNTH(A)
				GOTO	FALSE>>
DEFINE	ABSADDR(A,B)	<HLRZ	A,B
			ADDI	A,(B)
>

;REGISTER ASSIGNMENTS;
;--------------------;
XBL=	X14	;Block address of called procedure when not=XRAC
XAT=	X13	;Actual parameter type
XAK=	X12	;Actual parameter kind
XFT=	X11	;Formal parameter type
XFK=	X10	;Formal parameter kind
XAP=	XTAC	;Actual parameter list position
XFP=	XIAC	;Formal parameter list pointer
XRET=	X7	;JSP return register
XFAD=	X6	;Formal location address
XT=	X5	;Temporary register

XFL0=	X0	;First word of ZFL or ZAP
XFL1=	XAP	;Second word of ZFL
XRHT=	XFT	;Right hand side type (.PHCV parameter)
XLHT=	XAT	;Left  hand side type (.PHCV parameter)

OPDEF	ENTERTHUNK	[JSP	XRET,PHET]
OPDEF	THUNKRETURN	[JSP	XRET,PHTR]
OPDEF	PROCVALUE	[JSP	XRET,PHPV]
OPDEF	PHEXIT		[BRANCH	PHEX]
OPDEF	PHINIT		[PUSHJ	XPDP,PHIN]
	SUBTTL	.PHFA

COMMENT;
PURPOSE:	Obtain dynamic address of an actual parameter,
		specified simple and called by name.

ENTRY:		dynamic address of formal parameter location in Xtop
		EXEC	.PHFA
		XWD	number of intermediate results, address of map

NORMAL EXIT:	Return with accumulators restored and result in top ac's

ERROR EXITS:	RTS error if assignment disallowed for actual parameter.

CALLED ROUTINES:PHINIT,THUNKRETURN,ENTERTHUNK,PHEXIT
;



.PHFA:	PHINIT
	IFONA	ZFLVTD
	  PHERR	0,Actual parameter is an expression - assignment is illegal
	IF
		NOTHUNK
	THEN	; DYNAMIC ADDRESS OF VARIABLE TO XRAC
		LF	XRAC,ZFLZBI
		HRLI	XRAC,(XFL1)
	ELSE	;GET DYNAMIC ADDRESS FROM THUNK
		ENTERTHUNK
		THUNKRETURN
	FI
	LF	XAT,ZFLATP(XFL0)
	CAIN	XAT,QREF
	LF	XRAC1,ZFLZQU(XFAD)
	PHEXIT
	SUBTTL	PROCVALUE, PHEXIT, PHINIT

;CALL:		PROCVALUE	[JSP	XRET,PHPV]

PHPV:	; --- ACTUAL WAS A PROCEDURE - SHOULD HAVE NO PARAMETER
	STACK	X0	;Came here from thunk via JSP X0,@ZTSRAD(XSAC)
	LF	XT,ZDPZPR(,XRAC)
	SKIPGE	OFFSET(ZPCPAR)(XT)
		PHERR	1,Expression expected as actual parameter
	; NO PARAMETER, SO GO AND GET THE VALUE
	HRRZM	XRET,OFFSET(ZTSRAD)(XSAC)	;[240]
	RETURN
	
;-----------------------------------------------------------------------;

;CALL:		PHEXIT		[BRANCH	PHEX]

;--- VALUE IN XRAC & XRAC1 AT THIS POINT. CSRA WILL STORE VALUE IN PROPER
;--- PLACE, IF ANY ACS OBJECT IS TO BE RESTORED

PHEX:	AOS	(XPDP)		; SEE THAT RETURN SKIPS  INLINE PARAMETER
	LOWADR
	SKIPE	XSAC,YCSZAC(XLOW)
	EXEC	.CSRA
	CALLOW
	RETURN

;-----------------------------------------------------------------------;

;CALL:		PHINIT		[PUSHJ	XPDP,PHIN]

PHIN:	PROC
	IF
		SKIPN	XSAC,@-1(XPDP)	;Get inline parameter from nested EXEC
		GOTO	FALSE
	THEN
		STACK	XTAC
		LOWADR
		HLRZ	XTAC,XSAC	;NUMBER OF INTERMEDIATE RESULTS
		L	XWAC1(XTAC)
		ST	YOBJAD(XLOW)	;SAVE INPUT PARAMETER OVER POSSIBLE G.C.
		EXEC	.CSSA.
		;"NORMALIZE" BY PUTTING THE PARAMETER IN XWAC1
		L	XWAC1,YOBJAD(XLOW)
		SETZM	YOBJAD(XLOW)	;MUST NOT CONFUSE GARBAGE COLLECTOR
		UNSTK	XTAC
	FI
	;ABS ADDR OF FORMAL LOCATION
	ABSADDR	XFAD,XWAC1
	;FORMAL LOCATION TO XFL0,XFL1
	WLF	XFL0,ZFLZBI(XFAD)
	WLF	XFL1,ZFLADR(XFAD)
	RETURN
	EPROC
	SUBTTL	ENTERTHUNK

;CALL:		ENTERTHUNK	[JSP	XRET,PHET]

PHET:	LOWADR				; MAKE GLOBALS ADDRESSABLE
	CFORBID
	HRL	XCB,YCSZAC(XLOW)	; ACS ADDRESS
	SETZM	YCSZAC(XLOW)		; CLEAR TO PREVENT CONFUSION
	LFE	XSAC,ZTHZTS(XFL1)	; DISPLACEMENT + BLOCK INSTANCE ADDRESS
	ADD	XSAC,XFL0		;  => THUNK SAVE AREA ADDR
	WSF	XRAC,ZTSFAD(XSAC)	; SAVE FORMAL ADDRESS (IN DYNAMIC FORM)
	UNSTK	OFFSET(ZTSRSR)(XSAC)	; OBJECT CODE RETURN ADDRESS
	HRRZS	OFFSET(ZTSRSR)(XSAC)	;[240] Clear left half to avoid confusion
	MOVSM	XCB,OFFSET(ZTSZBI)(XSAC); ZTSZBI,,ZTSZAC
	HRRZ	XCB,			; NEW XCB POINTS TO BLOCK OF THUNK
	HRRZM	XRET,OFFSET(ZTSRAD)(XSAC)	;[240] Save return address
	CALLOW
	BRANCH	1(XFL1)			; ENTER THUNK
	SUBTTL	.PHCV, PHCV1

Comment;

Purpose:	To convert an arithmetic value according to formal/actual types.

Input:		XRAC (& XRAC1) value to be converted.
		.PHCV: XRHT=RHS type, XLHT=LHS type.
		PHCV1: Left half of X0=copy of left half of ZFL (formal location).

Output:		Converted value in XRAC (& XRAC1).

Function:	Convert input from type ZFLATP to ZFLFTP.

;

PHCV1:	PROC
	LF	XRHT,ZFLATP
	LF	XLHT,ZFLFTP
.PHCV:	IMULI	XRHT,3
	ADDI	XLHT,(XRHT)
	CAIL	XLHT,4*QINTEGER
	CAILE	XLHT,4*QLREAL
	RFAIL	Wrong type combination - cannot convert parameter value

	XCT	PHCV.T-4*QINTEGER(XLHT)
	RETURN

PHCV.T:	RETURN			;II
	FLTR	XRAC,XRAC	;IR
	GOTO	PHCVIL		;IL

	FIXR	XRAC,XRAC	;RI
	RETURN			;RR
	SETZ	XRAC1,		;RL

	GOTO	PHCVLI		;LI
	RETURN			;LR
	RETURN			;LL

;***AUBEG
;INTEGER TO LONG REAL CONVERSION RECODED FOR
;KA10 LONG REAL FORMAT.
PHCVIL:
IFN QKI10,<
	L	XRHT,XRAC
	MOVM	XRAC1,XRAC
	MOVSI	XRAC,(<200+^D62>B8)
	DFAD	XRAC,[EXP 0,0]
	JUMPGE	XRHT,.+2
	DMOVN	XRAC,XRAC
>
IFN QKA10,<
	IDIVI	XRAC,400000	;SIGN AND 18 HIGH ORDER BITS IN XRAC
				;SIGN AND 17 LOW ORDER BITS IN XRAC1
	SKIPE	XRAC		;SKIP IF HIGH ORDER PART IS ZERO
	TLC	XRAC,254000	;SET EXPONENT OF 27+17 FOR HIGH ORDER
	TLC	XRAC1,233000	;SET EXPONENT OF 27 FOR LOW ORDER
	FADL	XRAC,XRAC1	;AND PRODUCE KA10 FORMAT RESULT
>
;***AUEND
	RETURN

PHCVLI:	SKIPGE	XRHT,XRAC
;***AUBEG
;USE DFN FOR NEGATION OF KA10 LONG REAL FORMAT NUMBER.
IFN QKI10,<	DMOVN	XRAC,XRAC>
IFN QKA10,<	DFN	XRAC,XRAC1>
;***AUEND
	IF
		CAML	XRAC,[233B8]
		GOTO	FALSE
	THEN
		FIXR	XRAC,XRAC
	ELSE
		LDB	XLHT,[POINT 9,XRAC,8]
		TLZ	XRAC,777000
;***AUBEG
;FOR KA10 FORMAT, MUST SHIFT LOW ORDER WORD
;8 BITS LEFT TO DELETE EXPONENT, BEFORE
;THE FOLLOWING ASHC INSTRUCTION.
IFN QKA10,<	LSH	XRAC1,^D8>
;***AUEND
		ASHC	XRAC,-233(XLHT)
	FI
	JUMPGE	XRHT,.+2
	MOVN	XRAC,XRAC
	RETURN

	EPROC
	SUBTTL	.PHFM

Comment;

Purpose:	Calculate dynamic address of a switch, procedure or array
		by name.

Input:		Xtop=dynamic address of formal location.

Output:		Dynamic address in Xtop & Xtop+1.

Function:	Like .PHFA, but no check for expression is made.
;

.PHFM:	PHINIT
	IF	;[64] No thunk (only possible for array)
		JUMPGE	FALSE
	THEN	;Get the array address as for PHFV
		LF	XRAC,ZFLZBI
		ADDI	XRAC,(XFL1)
		L	XRAC,(XRAC)
	ELSE
		ENTERTHUNK
		THUNKRETURN
	FI	;[64]
	PHEXIT
	SUBTTL	.PHFS

Comment;

Purpose:	Store the value of an actual parameter into a formal name mode
		parameter, whose address has been computed earlier as a dynamic
		quantity.

Input:		According to the calling sequence
			HLLZ	X0,ZFL instance
			EXEC	PHFS
			XWD	NRHS,NLHS
		formal and actual type, kind, etc are passed in X0.
		The value to be stored resides in accumulator(s) NRHS
		(& NRHS+1). The dynamic address of the actual parameter
		location is passed in ac NLHS (possibly a qualification
		in NLHS+1).

Function:	Convert the RHS value if ZFLCNV is on in X0.
		Perform QUA check (.CSQU) if REF parameter.
		Compute absolute address of actual parameter from its
		dynamic address and store the value. Skip return past inline
		parameter.
;

	EXTERN	.CSQU

.PHFS:	PROC
	SAVE	<XIAC,XRAC,XRAC1,XLHT,XRHT>	;[25] also XIAC
	N==5	;[25] Count number of ac's saved
	LOWADR
	CDEFER
	L	XSAC,@-N(XPDP)
	AOS	-N(XPDP)

	;Load RHS value to XRAC & XRAC1, LHS dynamic address to XTAC & XSAC
	HLRZ	XTAC,XSAC	;NRHS
	STACK	(XTAC)
	STACK	1(XTAC)
	L	XTAC,(XSAC)	;XTAC := LHS first word
	L	XSAC,1(XSAC)	;XSAC := LHS second word
	UNSTK	XRAC1
	UNSTK	XRAC

	LF	XLHT,ZFLATP	;LHS TYPE
	IF	;TYPE REF
		CAIE	XLHT,QREF
		GOTO	FALSE
	THEN	;CHECK QUALIFICATION
		L	XRAC1,XRAC	;Save XRAC over .CSQU
		SETO			;NONE AND SUBCLASS ARE BOTH VALID RHS QUAL
		EXEC	.CSQU
		IF	JUMPN	XRAC,FALSE
		THEN
			PHERR	3,Assignment to formal parameter - r.h.s. not subclass of l.h.s.
		FI
		L	XRAC,XRAC1
	ELSE
		IF	;CONVERSION NECESSARY
			IFOFFA	ZFLCNV
			GOTO	FALSE
		THEN
			LF	XRHT,ZFLFTP
			EXEC	.PHCV
		FI
	FI
	ABSADDR	XSAC,XTAC
	ST	XRAC,(XSAC)
	;DOUBLE-WORD QUANTITY?
	CAIE	XLHT,QLREAL
	CAIN	XLHT,QTEXT
	ST	XRAC1,1(XSAC)
	CENABLE
	RETURN
	EPROC
	SUBTTL	.PHFT

Comment;

Purpose:	Compute dynamic address of a text variable. This text variable
		is either identical with the actual parameter or a dummy text
		variable (ZTT record) generated because the actual parameter is
		an expression.
		Give error message for text constant.

Input:		According to the calling sequence
			EXEC	.PHFT
			XWD	n,address of map
		the top ac (XWAC1+n) has the dynamic address of the formal
		location.

Output:		Dynamic address of text variable in top ac (Xtop=XWAC1+n).
		Absolute address in Xtop+1.

Calls:		TXDA
;

;[131] Code rearranged to handle kind procedure correctly

.PHFT:	PHINIT
	IF	;The descriptor is for a (dynamic) address
		IFONA	ZFLVTD(XFL0)
		GOTO	FALSE
	THEN
		IF
			NOTHUNK
		THEN	;Construct dynamic address in XRAC
			LF	XRAC,ZFLZBI(XFL0)
			HRLI	XRAC,(XFL1)
		ELSE	;Evaluate thunk to get dynamic address of text descr.
			LF	XAK,ZFLAKD(XFL0)
			IF	;Actual parameter is a procedure
				CAIE	XAK,QPROCEDURE
				GOTO	FALSE
			THEN	;It must be evaluated, cannot have any parameter
				ENTERTHUNK
				PROCVALUE	;Compute text descriptor
				THUNKRETURN
				EXEC	TXDA	;Make a copy in a ZTT record
				Z
			ELSE	;Compute dynamic address of text descriptor
				ENTERTHUNK
				THUNKRETURN
		FI	FI
		ABSADDR	XRAC1,XRAC	;Absolute address
	ELSE	;VALUE TYPE DESCRIPTOR
		IF
			NOTHUNK
		THEN	;Constant, give error message
			SKIPE	(XFL1)	;[115] Legal for NOTEXT
			PHERR	4,Assignment to formal parameter which is a text constant
			SETZB	XRAC,XRAC1	;[115] NOTEXT
		ELSE
			ENTERTHUNK
			THUNKRETURN
		FI
		;Now we have text descriptor in XRAC & XRAC1,
		;generate a copy in ZTT record
		EXEC	TXDA
		Z		;Dummy acs descriptor
	FI
	PHEXIT
	SUBTTL	.PHFV

Comment;

Purpose:	Obtain value of an actual parameter,
		specified simple and called by name.

Entry:		Xtop = dynamic address of formal parameter location.
		EXEC	.PHFV
		XWD	number of intermediate results, address of map

Exit:		Return with accumulators restored and result on top

Calls:		PHINIT, ENTERTHUNK, PROCVALUE, THUNKRETURN, PHEXIT
;

.PHFV:	PHINIT
	IF	NOTHUNK
	THEN	;Get value directly or via its address
;***AUBEG
;XRAC1, RATHER THAN XRAC, IS USED AS AN INTERMEDIATE IN THE
;FOLLOWING FEW INSTRUCTIONS IN ORDER TO AVOID USE OF SAME REGISTER
;FOR AC AND INDEX IN LD BELOW. ALSO, IN ORDER TO AVOID SKIP OVER
;THE LD, THE CAIE OF THE ORIGINAL CODE IS REPLACED WITH A CAIN
;INSTRUCTION AND A GOTO.
		LF	XRAC1,ZFLZBI(XFL0)
		ADDI	XRAC1,(XFL1)
		;If short constant, we have the value directly
		LF	XT,ZFLDTP(XFL0)
IFN QKI10,<	CAIE	XT,QDTICO>
IFN QKA10,<	CAIN	XT,QDTICO
		GOTO	.+3>
		LD	XRAC,(XRAC1)
;***AUEND
	ELSE
		LF	XAK,ZFLAKD(XFL0)
		IF	;Parameterless procedure as actual
			CAIE	XAK,QPROCEDURE
			GOTO	FALSE
		THEN	ENTERTHUNK
			PROCVALUE
			THUNKRETURN
		ELSE
			ENTERTHUNK
			THUNKRETURN
			IF	;Thunk returned a dynamic address
				IFONA	ZFLVTD(XFL0)
				GOTO	FALSE
			THEN	;Get absolute address and load value
				ABSADDR	XSAC,XRAC
				LD	XRAC,(XSAC)
	FI	FI	FI
	IFONA	ZFLCNV(XFL0)	;Convert if necessary
	EXEC	PHCV1
	PHEXIT
	SUBTTL	THUNKRETURN

;CALL:		THUNKRETURN	[JSP	XRET,PHTR]

PHTR:	;RETURN FROM THUNK
	LOWADR
	CFORBID
	LF	XT,ZTSFAD(XSAC)
	ABSADDR	XFAD,XT			; ADDR OF FORMAL LOC (ABS FORM)

	STACK	OFFSET(ZTSRSR)(XSAC)	; RETURN ADDRESS TO OBJECT CODE

	SKIPN	OFFSET(ZTSZBI)(XSAC)	;[103]
	RFAIL	Improper call structure	;[103]
	LF	XCB,ZTSZBI(XSAC)	; RESTORE XCB
	LF	,ZTSZAC(XSAC)		; RESTORE ACS POINTER
	ST	YCSZAC(XLOW)		; RESTORE YCSZAC(XLOW) FOR USE IN CSRA
	WLF	XFL0,ZFLZBI(XFAD)	;ZFL CODES TO XFL0
	SETZM	OFFSET(ZTSZBI)(XSAC)	;[27] Zero dynamic ref in thunk save
	SETZM	OFFSET(ZTSFAD)(XSAC)	; area to avoid confusion in SAGC
	CALLOW
	BRANCH	(XRET)
	SUBTTL	END OF MODULE PH

	LIT
	END