PDP-10 Archive: forpse.mac from FORTRAN-10_Alpha

Trailing-Edge - PDP-10 Archives - FORTRAN-10_Alpha_31-jul-86 - forpse.mac
There are 13 other files named forpse.mac in the archive. Click here to see a list.

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


;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1977, 1986
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

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 V7 Development *****

3277	TGS	31-Mar-83
	Replace most invocations of FUNCT macro with actual calling
	sequence.  FUNCT calls of the type OUT.##,<<401100,,[-1]>...>
	were generating Q compilation errors.

***** Begin Version 10 *****

4023	JLC	29-Jun-83
	Search MTHPRM.

4106	JLC	2-Mar-84
	Change the title of this module to conform to the new
	rules for symbol searching in FORERR, namely, that the
	title must be the same as the name of one of the globals
	in the module.

***** End V10 Development *****

***** 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
	PUSH	P,L		;[3277]
	XMOVEI	L,1+[-3,,0	;[3277]
		     401100,,[-1] ;[3277] UNIT=-1
		     402100,,MESS3 ;[3277] FMT=MESS3
		     403100,,[5] ;[3277] FMTLEN=5
		    ]		;[3277]
	PUSHJ	P,OUT.##	;[3277]
	POP	P,L		;[3277]
	JRST	PAUS1A		;SKIP STOP CODE
PAUSE1:	PUSH	P,L		;[3277]
	XMOVEI	L,1+[-3,,0	;[3277]
		     401100,,[-1] ;[3277] UNIT=-1
		     402100,,MESS3S ;[3277] FMT=MESS3S
		     403100,,[2] ;[3277] FTMLEN=2
		    ]		;[3277]
	PUSHJ	P,OUT.##	;[3277]
	POP	P,L
;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
	PUSH	P,L		;[3277]
	XMOVEI	L,1+[-3,,0	;[3277]
		     401100,,[-1] ;[3277] UNIT=-1
		     402100,,MESS4 ;[3277] FTM=MESS4
		     403100,,[3] ;[3277] FMTLEN=3
		    ]
	PUSHJ	P,OUT.##	;[3277]
	POP	P,L		;[3277]
	JRST	PAUSE3
PAUSE2:	PUSH	P,L		;[3277]
	XMOVEI	L,1+[-3,,0	;[3277]
		     401100,,[-1] ;[3277] UNIT=-1
		     402100,,MESS4S ;[3277] FMT=MESS4S
		     403100,,[2] ;[3277] FMTLEN=2
		    ]		;[3277]
	PUSHJ	P,OUT.##	;[3277]
	POP	P,L		;[3277]
PAUSE3:	PUSH	P,L		;[3277]
	XMOVEI	L,1+[-2,,0	;[3277]
		     401100,,T1	;[3277] DCALL=1
		     004000,,0	;[3277] OTSFINWD
		    ]		;[3277]
	
	JRST	PAUSE6

PAUSEZ:	SKIPN	PSEFLG		;IS IT PAUSE?
	  JRST	PAUSE8		;NO - STOP - GET OUT
	PUSH	P,L		;[3277]
	XMOVEI	L,1+[-3,,0	;[3277]
		     401100,,[-1] ;[3277] UNIT=-1
		     402100,,MESS5 ;[3277] FMT=MESS5
		     403100,,[2] ;[3277] FMTLEN=2
		    ]		;[3277]
	PUSHJ	P,OUT.##	;[3277]
	POP	P,L		;[3277]

	FUNCT	FIN.##

;TYPE G TO CONTINUE CODE
PAUSE6:	SKIPN	PSEFLG		;PAUSE?
	  JRST	PAUSE8		;NO - STOP - GET OUT
	PUSH	P,L		;[3277]
	XMOVEI	L,1+[-3,,0	;[3277]
		     401100,,[-1] ;[3277] UNIT=-1
		     402100,,MESS1 ;[3277] FMT=MESS1
		     403100,,[^D11] ;[3277] FMTLEN=11
		    ]		;[3277]
	PUSHJ	P,OUT.##	;[3277]
	POP	P,L		;[3277]

	FUNCT	FIN.##
	PUSH	P,L		;[3277]
	XMOVEI	L,1+[-3,,0	;[3277]
		     401100,,[-4] ;[3277] UNIT=-1
		     402100,,MESS2 ;[3277] FMT=MESS2
		     403100,,[1] ;[3277] FMTLEN=1
		    ]		;[3277]
	PUSHJ	P,IN.##		;[3277]
	POP	P,L		;[3277]

	PUSH	P,L		;[3277]
	XMOVEI	L,1+[-2,,0	;[3277]
		     401100,,T1	;[3277] DCALL=1
		     004000,,0	;[3277] OTSINWD
		    ]		;[3277]
	PUSHJ	P,IOLST.##	;[3277]
	POP	P,L		;[3277]

	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