Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/perf.mac
There are 7 other files named perf.mac in the archive. Click here to see a list.
; UPD ID= 1853 on 4/23/79 at 5:12 PM by N:<NIXON>
TITLE	PERF FOR COBOTS		
SUBTTL	SET UP A PERFORM			AL BLACKINGTON/CAM

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	LBLPRM		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
	MPWCEX==:MPWCEX

	HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file

;REVISION HISTORY:

; 567	 5-APR-79	CLRH	FIX PROBLEMS WITH LEVEL

;V10 *****

;	15-JAN-75	/ACK	ADD CODE FOR MULTIPLE PERFORMS WITH
;				 A COMMON EXIT.

;*****

COMMENT	/

	A PERFORM CALL LOOKS LIKE:

		PERF.	AC,EXIT-WORD-ADDRESS
		OVLAY.	OVERLAY-PARAMETERS-ADDRESS
	OR
		PERF.	0,EXIT-WORD-ADDRESS
		JRST	ROUTINE-TO-BE-PERFORMED.

	AN EXIT CALL LOOKS LIKE:

		EXIT.	EXIT-WORD-ADDRESS

/
ENTRY PERF.,PERF.E

IFE MPWCEX,<
PERF.:	SKIPE	0(PA)		;EXIT WORD IN USE?
	JRST	PERF.E		;YES--ERROR

	POP	PP,TA		;GET OUR RETURN
	ADDI	TA,1		;THAT + 1 IS RETURN FOR "EXIT."

	AOS	LEVEL.		;BUMP DEPTH OF PERFORM

	HRL	TA,LEVEL.	;STASH THAT IN EXIT WORD

	MOVSM	TA,0(PA)	;SET EXIT WORD
>

IFN MPWCEX,<
PERF.:	AOS	(PA)		;BUMP THE DEPTH OF PERFORMS
				; USING THIS EXIT.
	AOS	TA,(PP)		;SET UP EXIT'S RETURN.
	AOS	TB,LEVEL.		;BUMP DEPTH OF ALL PERFORMS.
	CAILE	TB,LEVLIM	;TOO MANY?
	JRST	PERF.E		;YES
	HRLM	TB,(PP)		;STORE THE EXIT'S RETURN ON THE
				; PDL LIST.
	MOVE	TB,-1(TA)	;HACK TO SEE IF THE NEXT INSTR
	TLNN	TB,001000	; IS A JRST OR A MOVEI FOR COVRLY.
	JRST	@TRAC3.		;GO SEE IF COBDDT WANTS TO DO ANYTHING.
	AOS	(PP)		;IT'S A MOVEI, MAKE EXIT SKIP
				; OVER THE PUSHJ 17,OVLAY.
	LDB	TB,[POINT 7,(TB),26]	;GET CURRENT SEGMENT NO.
	DPB	TB,[POINT 7,(PP),7]	;STORE FOR C.EXIT
>

	JRST	@TRAC3.		;GO SEE IF COBDDT WANTS TO DO ANYTHING.



;ERROR -- EXIT WORD IS BEING USED

PERF.E:
IFE MPWCEX,<
	OUTSTR	[ASCIZ "Exit being used by two PERFORMs"]
>
IFN MPWCEX,<					;[567]
	OUTSTR	[ASCIZ "PERFORM limit exceeded"]
>
	JRST	KILL.
SUBTTL EXIT FROM A PERFORMED ROUTINE	AL BLACKINGTON

ENTRY C.EXIT,EXIT.E

C.EXIT:	SKIPN	TA,0(PA)	;ANY EXIT SET UP?
	POPJ	PP,		;NO--FALL THRU TO NEXT STATEMENT

IFE MPWCEX,<
	MOVE	TB,TA		;IS
	ANDI	TB,377777	;  LEVEL
	CAME	TB,LEVEL.	;    CORRECT?
	JRST	EXIT.E		;NO--ERROR

	HLRM	TA,0(PP)	;SET RETURN ADDRESS

	SETZM	0(PA)		;CLEAR EXIT WORD

	SOS	LEVEL.		;DECREMENT LEVEL OF PERFORM
>

IFN MPWCEX,<
	SOS	(PA)		;DECREMENT DEPTH OF THIS EXIT.
	HLRZ	TA,-1(PP)	;GET EXIT WORD PARAMETERS.
	TRNN	TA,377B25	;[567] NEED TO RESET RETURN SEGMENT
	JRST	CEXIT1		;NO
	MOVEI	PA,TB		;YES, POINT TO PARAMS
	LSH	TA,-^D10	;GET SEGMENT WE WANT
	MOVE	TB,SEGNO.##	;GET CURRENT SEGMENT
	LSH	TB,9
	ADDI	TB,(TA)		;CURRENT + NEXT SEGNENT
	HRLI	TB,.+2		;ADDRESS TO RETURN TO
	PUSHJ	PP,OVLAY.##	;GET IT IN
	HLRZ	TA,-1(PP)	;GET EXIT WORD PARAMS AGAIN
	ANDI	TA,1777		;LEVEL # ONLY
CEXIT1:	CAME	TA,LEVEL.	;ARE WE AT THE RIGHT LEVEL?
	JRST	EXIT.E		;NO, ERROR.
	SOS	LEVEL.		;DECREMENT LEVEL. FOR NEXT TIME.
	POP	PP,TA		;GET RID OF THE UUO'S RETURN
>

	JRST	@TRAC2.		;GO SEE IF COBDDT WANTS TO DO ANYTHING.


;EXITING TO WRONG LEVEL

EXIT.E:	OUTSTR	[ASCIZ "Exit failure"]
	JRST	KILL.
EXTERNAL KILL.	;ROUTINE WHICH WILL KILL THE RUN

EXTERNAL LEVEL.	;CURRENT DEPTH OF THE PERFORM
EXTERNAL TRAC2.	;ADDRESS OF TRPOP.
EXTERNAL TRAC3.	;ADDRESS OF TRPD.


	TA=10	;TEMPORARY
	TB=11	;TEMPORARY
	PA=16	;THE "C.EXIT" UUO
	PP=17	;PUSH-DOWN POINTER

	LEVLIM==1777	;[567]

	END