Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
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, 1985
;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