Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
forpse.mac
There are 13 other files named forpse.mac in the archive. Click here to see a list.
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