Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SEARCH	FORPRM
	TV	FORPSE	PAUSE AND STOP ROUTINES,7(3136)
	SUBTTL	ED YOURDAN/D. TODD/DRT/HPW/DPL/SWG/AHM	1-Jun-81


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

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1977, 1983

COMMENT \

***** Begin Revision History *****

423			15030
	Fix PAUSE destroying a reg.

1100	SWG
	From 4B(423); cleanup for V6; remove F40 conditional
	replace TTCALL; conditionalize for -10/-20;
	modify so STOP not printed out.

1525	JLC/AHM	07-Jul-81
	Fix to output * after pausing, count was in octal instead
	of decimal. Fix save/restore ac code.

***** Begin Version 7 *****

3007	AHM	1-Nov-81
	Fix FUNCT calls to use V6 calling sequence and IFIWs for E/A.

3124	AHM	1-Jun-82
	Change TWOSEG and RELOC into SEGMENT macros.

3136	JLC	26-Jun-82
	Fix STOP and PAUSE so they don't output nulls to TTY, caused
	by change in %ALPHO not substituting spaces for nulls.

***** End Revision History *****

\

	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 NUMBGIT STRING OF UP TO 6 DIGITS
;AND "MESSAGE" IS AN ASCII MESSAGE.
;THE CALLING SEQUENCE FOR PAUSE IS:
;	MOVEI	L,ARGBLK
;	PUSHJ	P,PAUSE.
;
;AFTER TYPING PAUSE, THE DIGIT STRING 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.
;
;THE ARGUMENTS HANDLED AND THE CALLING SEQUENCE FOR STOP
;ARE IDENTICAL TO THOSE FOR PAUSE.  STOP, HOWEVER, DOES
;NOT OUTPUT THE WORD 'STOP' AND ALWAYS CALLS EXIT TO
;TERMINATE.

	SEGMENT	CODE		;[3124] Go to the hiseg

	HELLO	(PAUS.)
	SETOM	PSEFLG		;FLAG=-1 FOR PAUSE ENTRY
	JRST	PSEARG		;SKIP STOP ENTRY

	HELLO	(STOP.)		;STOP ENTRY
	SETZM	PSEFLG		;FLAG=0 FOR STOP ENTRY

PSEARG:
	PUSH	P,T0
	PUSH	P,T1
	PUSH	P,L
IF10,<
	SKPINL			;TURN OFF ^O
	  JFCL
>				;END IF10

IF20,<				;NEED TO SAVE AND RESTORE  T2
	PUSH	P,T2		;ACS USED FOR JSYS
	MOVEI	T1,.PRIOU
	RFMOD%
	TXZE	T2,TT%OSP	;TURN OFF CONTROL-O
	  SFMOD%
	POP	P,T2		;AND RESTORE
>				;END IF20
	SETZ	T1,		;ASSUME NO ARG
	SKIPL	-1(L)		;IS THERE AN ARG
	  JRST	PAUSEZ		;NO ARGUMENT
	LDB	T1,[POINT 4,(L),12]	;GET THE ARG TYPE
	CAIE	T1,TP%LIT	;LITERAL STRING
	  JRST	PAUSEN		;NO, A CONSTANT
	SKIPN	PSEFLG		;SKIP NEXT INSTR IF PAUSE CALL
	  JRST	PAUSE1		;STOP - GOTO HANDLE IT
	FUNCT	OUT.##,<<401100,,[-1]>,<402100,,MESS3>,<403100,,[5]>>
				;[3007] UNIT=-1,FMT=MESS3,FMTLEN=5
	JRST	PAUS1A		;SKIP STOP CODE
PAUSE1:	FUNCT	OUT.##,<<401100,,[-1]>,<402100,,MESS3S>,<403100,,[2]>>
				;[3007] UNIT=-1,FMT=MESS3S,FMTLEN=2
;THE ARGUMENT TO PAUSE OR STOP IS A LITERAL CONSTANT. HERE WE
;MAKE IT INTO A FOROTS DATA CALL (IFIW+1000) AND PASS IT DIRECTLY
;TO IOLST. ALPHO NOW UNDERSTANDS LITERAL STRING OUTPUT, AND TREATS
;IT LIKE CHARACTER OUTPUT, BUT SLOWER, SINCE IT HAS TO SCAN FOR A
;NULL CHARACTER.
PAUS1A:	MOVE	T1,(L)		;GET THE STRING ARG ADDR PNTR
	TLO	T1,401000	;MAKE IT A V7 DATA CALL
	MOVEM	T1,PSEBLK	;SAVE IT FOR CALL
	PUSH	P,L		;SAVE L
	MOVSI	T1,-2		;GET ARG COUNT
	MOVEM	T1,PSECNT
	MOVSI	T1,4000		;DEPOSIT FIN CALL
	MOVEM	T1,PSEBLK+1
	XMOVEI	L,PSEBLK	;POINT TO DATA ARG BLOCK
	PUSHJ	P,IOLST.##	;OUTPUT STRING
	POP	P,L		;RESTORE L
	JRST	PAUSE6		;ALL DONE, TYPE G AND X STUFF

PAUSEN:
	MOVE	T1,@(L)		;GET THE NUMBER
	SKIPN	PSEFLG		;IS THIS PAUSE?
	  JRST	PAUSE2		;NO - STOP
	FUNCT	OUT.##,<<401100,,[-1]>,<402100,,MESS4>,<403100,,[3]>>
				;[3007] UNIT=-1,FMT=MESS4,FMTLEN=3
	JRST	PAUSE3
PAUSE2:	FUNCT	OUT.##,<<401100,,[-1]>,<402100,,MESS4S>,<403100,,[2]>>
				;[3007] UNIT=-1,FMT=MESS4S,FMTLEN=2
PAUSE3:	FUNCT	IOLST.##,<<401100,,T1>,<004000,,0>>
				;[3007] DCALL=1,OTSFINWD
	JRST	PAUSE6

PAUSEZ:	SKIPN	PSEFLG		;IS IT PAUSE?
	  JRST	PAUSE8		;NO - STOP - GET OUT
	FUNCT	OUT.##,<<401100,,[-1]>,<402100,,MESS5>,<403100,,[2]>>
				;[3007] UNIT=-1,FMT=MESS5,FMTLEN=2
	FUNCT	FIN.##

;TYPE G TO CONTINUE CODE
PAUSE6:	SKIPN	PSEFLG		;PAUSE?
	  JRST	PAUSE8		;NO - STOP - GET OUT
	FUNCT	OUT.##,<<401100,,[-1]>,<402100,,MESS1>,<403100,,[^D11]>>
				;[3007] UNIT=-1,FMT=MESS1,FMTLEN=11
	FUNCT	FIN.##
	FUNCT	IN.##,<<401100,,[-4]>,<402100,,MESS2>,<403100,,[1]>>
				;[3007] UNIT=-1,FMT=MESS2,FMTLEN=1
	FUNCT	IOLST.##,<<401100,,T1>,<004000,,0>>
				;[3007] DCALL=1,OTSFINWD
	LSH	T1, -35		;MAKE CHARACTER RIGHT-JUSTIFIED
	TRZ	T1,40		;ACCEPT LOWER CASE ALSO
	CAIE	T1, "X"		;IS IT AN X?
	  JRST	PAUSE7
PAUSE8:	FUNCT	(EXIT.)	;YES, EXIT
PAUSE7:	CAIN	T1, "G"		;IS IT A G?
	  JRST	PAUSE4		;YES, CONTINUE
	CAIE	T1, "T"		;T FOR TRACE
	  JRST	PAUSE6	;NO, TRY AGAIN
	FUNCT	TRACE.,<0>	;YES DO A TRACE
	JRST	PAUSE6		;GET THE NEW RESPONSE
PAUSE4:	POP	P,L		;POP IN LIFO ORDER, DUMMY
	POP	P,T1
	POP	P, T0		;YES, RESTORE T0C A
	POPJ	P,		;EXIT




MESS1:	ASCII	"(' Type G to Continue, X to Exit, T To Trace.'/2H *,$)"
MESS2:	ASCII	"(A1)"
MESS3:	ASCII	"(' PAUSE',/(1X,A))"
MESS3S:	ASCII	"(1X,A)"
MESS4:	ASCII	"(' PAUSE ',O6)"
MESS4S:	ASCII	"(1X,O6)"
MESS5:	ASCII	"(' PAUSE')"

	SEGMENT	DATA		;[3124] Go to the low segment

PSECNT:	BLOCK	1		;ARG COUNT
PSEBLK:	BLOCK	5		;ARG BLOCK

PSEFLG:	BLOCK	1

	END