perm filename PH.MAC[SIM,SYS] blob sn#462244 filedate 1979-07-31 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBTTL	PARAMETER HANDLING MODULE
C00004 00003	REGISTER ASSIGNMENTS
C00006 00004		SUBTTL	.PHFA
C00008 00005		SUBTTL	PROCVALUE, PHEXIT, PHINIT
C00011 00006		SUBTTL	ENTERTHUNK
C00012 00007		SUBTTL	.PHCV, PHCV1
C00014 00008		SUBTTL	.PHFM
C00015 00009	
C00016 00010		SUBTTL	.PHFS
C00019 00011		SUBTTL	.PHFT
C00022 00012		SUBTTL	.PHFV
C00024 00013		SUBTTL	THUNKRETURN
C00026 00014		SUBTTL	END OF MODULE PH
C00027 00015	
C00028 ENDMK
CāŠ—;
	SUBTTL	PARAMETER HANDLING MODULE

; AUTHOR:	LARS ENDERIN
; VERSION:	3
; 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
	WSF	XRET,ZTSRAD(XSAC)
	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
	MOVSM	XCB,OFFSET(ZTSZBI)(XSAC); ZTSZBI,,ZTSZAC
	HRRZ	XCB,			; NEW XCB POINTS TO BLOCK OF THUNK
	WSF	XRET,ZTSRAD(XSAC)	; SAVE THE 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

PHCVIL:	L	XRHT,XRAC
	MOVM	XRAC1,XRAC
	MOVSI	XRAC,(<200+ā†‘D62>B8)
	DFAD	XRAC,[EXP 0,0]
	JUMPGE	XRHT,.+2
	DMOVN	XRAC,XRAC
	RETURN

PHCVLI:	SKIPGE	XRHT,XRAC
	DMOVN	XRAC,XRAC
	IF
		CAML	XRAC,[233B8]
		GOTO	FALSE
	THEN
		FIXR	XRAC,XRAC
	ELSE
		LDB	XLHT,[POINT 9,XRAC,8]
		TLZ	XRAC,777000
		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
;

.PHFT:	PHINIT
	IF
		IFONA	ZFLVTD(XFL0)
		GOTO	FALSE
	THEN	;ADDRESS TYPE DESCRIPTOR
		IF
			NOTHUNK
		THEN	;Construct dynamic address in XRAC
			LF	XRAC,ZFLZBI(XFL0)
			HRLI	XRAC,(XFL1)
		ELSE
			ENTERTHUNK
			THUNKRETURN
		FI
		ABSADDR	XRAC1,XRAC	;Absolute address may be useful
	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
			LF	XAK,ZFLAKD(XFL0)
			IF	;PARAMETERLESS PROCEDURE AS ACTUAL PARAMETER
				CAIE	XAK,QPROCEDURE
				GOTO	FALSE
			THEN
				ENTERTHUNK
				PROCVALUE
			ELSE
				ENTERTHUNK
			FI
			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
		LF	XRAC,ZFLZBI(XFL0)
		ADDI	XRAC,(XFL1)
		;If short constant, we have the value directly
		LF	XT,ZFLDTP(XFL0)
		CAIE	XT,QDTICO
		LD	XRAC,(XRAC)
	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