Google
 

Trailing-Edge - PDP-10 Archives - AP-D480B-SB_1978 - forpse.mac
There are 13 other files named forpse.mac in the archive. Click here to see a list.
	TITLE	FORPSE	%4B(423)	PAUSE AND STOP ROUTINES
	SUBTTL	ED YOURDAN		20-MAR-66
	SUBTTL	D. TODD/DRT/HPW/DPL		17-JAN-75




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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION


VERWHO==0
VERVER==4
VEREDT==263
VERUPD==0

VERPSE=BYTE (3)VERWHO(9)VERVER(6)VERUPD(18)VEREDT

PURGE	VERWHO,VERVER,VERUPD,VEREDT

	SUBTTL	REVISION HISTORY

;EDIT	423	15030	FIX PAUSE DESTROYING A REG.

	SUBTTL	PAUSE AND STOP FUNCTION

;THE PAUSE SUBROUTINE MAY BE CALLED FOR ANY OF THE THREE
;FOLLOWING FORTRAN STATEMENTS:
;	PAUSE
;	PAUSE N
;	PAUSE "MESSAGE"
;WHERE N IS AN OCTAL NUMBER, AND "MESSAGE" IS AN ASCII
;MESSAGE.
;THE CALLING SEQUENCES FOR THE THREE TYPES OF PAUSE STATEMENTS
;ARE AS FOLLOWS:
;	PAUSE	GENERATES
;	MOVEI	1, 0
;	PUSHJ	P, PAUSE.

;	PAUSE N		GENERATES
;	HRROI	1, CONST
;	PUSHJ	P, PAUSE.	;CONST HAS THE OCTAL NUMBER IN IT

;	PAUSE "MESSAGE"	GENERATES
;	HRLI	1, N		;NUMBER OR WORDS IN ASCII MESSAGE
;	HRRI	1, CONST	;ASCII MESSAGE STARTS AT CONST
;	PUSHJ	P, PAUSE.

;AFTER TYPING PAUSE, AN OCTAL NUMBER AND/OR A MESSAGE, THE
;ROUTINE ALLOWS THE USER TO CONTINUE BY TYPING A 'G', FOLLOWED
;BY A CARRIAGE RETURN, AND ALLOWS HIM TO EXIT BY TYPING AN
;'X', FOLLOWED BY A CARRIAGE RETURN.

	SEARCH	FORPRM

	P=	17
	A=	0
	B=	1


IFN F10LIB,<
	HELLO	(PAUS.)
	SETOM	PSEFLG		;SET FLAG FOR PAUSE ENTRY
	JRST	PSEARG

	HELLO	(STOP.)
	SETZM	PSEFLG		;SET STOP FLAG
PSEARG:
	PUSH	P,T0
	PUSH	P,T1
	SETZ	T1,		;ASSUME NO ARG
	SKIPL	-1(L)	;IS THERE AN ARG
	JRST	PAUSEZ
	LDB	T1,[POINT 4,(L),12]	;GET THE ARG TYPE
	CAIE	T1,TP%LIT	;LITERAL STRING
	JRST	PAUSEN		;NO, A CONSTANT
	MOVSI	T1,(POINT 7)	;GET A BYTE POINTER
	HRRI	T1,@(L)		;GET THE ADDRESS
	ILDB	T0,T1		;GET A CHARACTER
	JUMPN	T0,.-1		;COUNT THE NUMBER OF WORDS
	SUBI	T1,@(16)	;NUMBER OF WORDS IN THE STING
	MOVSI	T1,1(T1)	;BUILD THE AOB POINTER
	HRRI	T1,@(L)		;GET THE STRING ADDRESS
	JRST	PAUSEZ		;COMMON ROUTINE
PAUSEN:
	HRRO	T1,(L)		;GET THE ADDRESS OF THE CONSTANT
>
IFN F40LIB,<
	JRST	PAUSEZ
	HELLO	(PAUSE.)
	PUSH	P,A
	PUSH	P,B
	SETOM	PSEFLG		;SET PAUSE FLAG
	JRST	PAUSEZ
>
PAUSEZ:
	PUSH	P,L
	TTCALL	13,0		;TURN OFF ^O
	  JFCL
	HLRE	A, B		;GET WORD COUNT OF MESSAGE
	JUMPLE	A, PAUSE1	;CONSTANT, OR NO MESSAGE?
	MOVNS	A		;MESSAGE - FORM AOBJN WORD
	HRLM	A, B		;IN ACCUMULATOR B
	FUNCT	OUT.##,<<XWD 0,-1>,0,0,MESS3,2>
PRLOOP:	FUNCT	IOLST.##,<<XWD 001000,(B)>,0>
	AOBJN	B, PRLOOP	;LOOP BACK FOR MORE WORDS
	JRST	PAUSE3	;ALL DONE, TYPE G AND X STUFF

PAUSE1:	FUNCT	OUT.##,<<XWD 0,-1>,0,0,MESS4,3>
	SKIPN	PSEFLG		;SKIP IF PAUSE CALL
	JRST	PAUSE5		;JUMP
	FUNCT	IOLST.##,<<XWD 001000,MESS5>,0>
	JRST	PAUSE2		;JUMP
PAUSE5:	FUNCT	IOLST.##,<<XWD 001000,MESS6>,0>
PAUSE2:	HRRZ	A, (B)		;GET THE NUMBER IF THERE IS ONE
	JUMPGE	B,PAUSE3	;IS THERE REALLY A NUMBER?
	FUNCT	IOLST.##,<<XWD 001000,A>,0>
PAUSE3:	FUNCT	FIN.##	;FINISH I/O
	SKIPN	PSEFLG		;PAUSE/STOP
	FUNCT	EXIT.##
	FUNCT	OUT.##,<<XWD 0,-1>,0,0,MESS1,11>
	FUNCT	FIN.##
	FUNCT	IN.##,<<XWD 0,-4>,0,0,MESS2,1>
	FUNCT	IOLST.##,<<XWD 001000,A>,<XWD 4000,0>>
	LSH	A, -35		;MAKE CHARACTER RIGHT-JUSTIFIED
	TRZ	A,40		;ACCEPT LOWER CASE ALSO
	CAIN	A, "X"		;IS IT AN X?
	FUNCT	(EXIT.)	;YES, EXIT
	CAIN	A, "G"		;IS IT A G?
	JRST	PAUSE4		;YES, CONTINUE
	CAIE	A, "T"		;T FOR TRACE
	JRST	PAUSE3+1	;NO, TRY AGAIN
	FUNCT	TRACE.,<0>	;[263] YES DO A TRACE
	JRST	PAUSE3+1	;GET THE NEW RESPONCE
PAUSE4:	POP	P,L		;[423] POP IN LIFO ORDER, DUMMY
	POP	P,B
	POP	P, A		;YES, RESTORE AC A
	POPJ	P,		;EXIT


MESS1:	ASCII	"(' Type G to Continue, X to Exit, T To trace.'/2H *,$)"
MESS2:	ASCII	"(A1)"
MESS3:	ASCII	"(1H 14A5/)"
MESS4:	ASCII	"(1H A5,1X,O6)"
MESS5:	ASCII	"PAUSE"
MESS6:	ASCII	"STOP "
PSEFLG:	BLOCK	1
	END