Google
 

Trailing-Edge - PDP-10 Archives - BB-J713A-BM - language-sources/glxcom.mac
There are 26 other files named glxcom.mac in the archive. Click here to see a list.
TITLE	GLXCOM  --  Common module for Sub-Systems Components
SUBTTL	Chuck O'Toole /ILG/MLB/PJT/DC 29-Jun-79

;
;
;                COPYRIGHT (c) 1975,1976,1977,1978,1979
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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.


	SEARCH	GLXMAC		;PARAMETER FILE
	PROLOG(GLXCOM,COM)	;GENERATE PROLOG CODE
	SEARCH	ORNMAC		;GET ORION SYMBOLS

	COMEDT==32		;MODULE EDIT LEVEL

;	Entry points found in GLXCOM

ENTRY	.INIT	;Initialize the common module
ENTRY	.ZPAGA	;Zero a page given its address in S1
ENTRY	.ZPAGN	;Zero a page given its page number in S1
ENTRY	.ZCHNK	;Zero an arbitrary area of memory

ENTRY	.SAVE1	;Co-routine to save P1
ENTRY	.SAVE2	;Co-routine to save P1,P2
ENTRY	.SAVE3	;Co-routine to save P1,P2,P3
ENTRY	.SAVE4	;Co-routine to save P1,P2,P3,P4
ENTRY	.SAVE8	;Co-routine to save P1,P2,P3,P4,13,14,15,16
ENTRY	.SAVET	;Co-routine to save T1,T2,T3,T4


ENTRY	.SV13	;Co-routine to save 13 (use SAVE Macro)
ENTRY	.SV14	;Co-routine to save 14 (use SAVE Macro)
ENTRY	.SV15	;Co-routine to save 15 (use SAVE Macro)
ENTRY	.SV16	;Co-routine to save 16 (use SAVE Macro)

ENTRY	.RETT	;Set TF= TRUE and return
ENTRY	.RETF	;Set TF= FALSE and return
ENTRY	.RETE	;Set TF= FALSE, set S1=GLXLIB error code and return



ENTRY	.AOS, .SOS , .ZERO ;Support for INCR, DECR AND ZERO
ENTRY	.STKST, .TRSET		;Support for STKVAR,TRVAR and ASUBR

ENTRY	.POPJ

ENTRY	.STOP	;GLXLIB Central STOP CODE processor
SUBTTL Table of contents

;               TABLE OF CONTENTS FOR GLXCOM
;
;
;                        SECTION                                   PAGE
;    1. Table of contents.........................................   2
;    2. Revision History..........................................   3
;    3. Global Storage............................................   4
;    4. .INIT  - Initialize the common code.......................   5
;    5. .ZPAGA - .ZPAGN - .ZCHNK  --  Zero out memory.............   6
;    6. .SAVEx Routines -- Save permanent ACS.....................   7
;    7. .SAVE8 and .SAVET Routines................................   8
;    8. .SVxx  --  Routines for saving random ACS.................   9
;    9. .POPJ, .RETE,.RETT & .RETF -- Common return routines......  10
;   10. .AOS, .SOS and .ZERO - Support for INCR,DECR, ZERO........  11
;   11. STKVAR SUPPORT CODE.......................................  12
;   12. TRVAR SUPPORT CODE........................................  13
;   13. STOP CODE Processor.......................................  14
;   14. SAVCRS  --      Save Crash on Stopcodes...................  15
SUBTTL Revision History

COMMENT \

Edit	SPR/QAR		Explanation
----	-------		-----------------------------------------------
0001			First model
0002			Create from SBSCOM
0003			Convert to new OTS format
0004	G023		Fix Stopcode Processing for -10 and support
			new WTO formats
0005	G035		Make Stopcode always type ACs and Stack
0006	G038		Force No formating of STOPCODES set in WTO
0007	G051		Force out text if STOPCODE Processor fails
0010			Add STKVAR,TRVAR,ASUBR Support Code
0011			Fix .STKRT and .SAVE8 to be Galaxy Compatable
0012			Add TRFLAG to remember True/False
0013			Remove TRFLAG permanently
0014			Clean up .SAVE8
0015			Change ALTOPR reference to PIDTAB+SP.OPR
			in stop code processor
0016			Change stopcode to use $halt instead of I%EXIT
0017			Change $STOP to do $WTO, allow full $TEXT in
			$STOP message
0020			Remove support code for ASUBR macro definition
			Move it temporarily to a file called GLXEXT
0021			Fix support code .TRSET and .STKST to work
			properly when called with JSP .SAC,ADDR
0022			Have STOPCODE use IB.PRG for Program Name
0023			Have STOPCODE use ^E for last TOPS20 error code
0024			Have STOPCODE Save the Crash if not debugging and
			Requested Stopcodes to ORION
0025			Have STOPCODE also process $FATAL macro
0026			Don't allow $FATAL processing to enter DDT
			Fix bug in ITEXT expansion of $FATAL
0027			Change ^A to ^0 in SAVCRS
0030			Change .ZCHNK to BLT the right amount of words
			(If count ia 1)
0031			On the -20 SAVE the STOPCODE Name in the file spec
			name on a crash. Also make GLXVRS external

0032			Fix .ZCHNK to exit if called with a zero count


End of Revision History
\
SUBTTL Global Storage


; GLOBAL CRASH INFORMATION

	$GDATA	.SPC			;PC OF STOP
	$GDATA	.SCODE			;SIXBIT CODE OF STOP CODE
	$GDATA	.SERR			;LAST OPERATING SYSTEM ERROR (TOPS-20)
	$GDATA	.SACS,20		;ACS AT TIME OF STOP 
	$GDATA	.SPTBL			;BASE OF PAGE TABLE
	$GDATA	.SPRGM			;NAME OF PROGRAM
	$GDATA	.SPVER			;VERSION OF PROGRAM
	$GDATA	.SPLIB			;VERSION OF THE OTS

	$GDATA	.LGERR			;LAST GALAXY ERROR PROCESSED VIA .RETE
	$DATA	STPFLG			;PROCESSING A STOPCODE FLAG
	$GDATA	.LGEPC			;PC (USUALLY) OF LAST $RETE
	$DATA	.SRSN			;Addr of STOPCD reason text
	$DATA	STPOLD			;Old-style STOP flag
	$DATA	WTOPTR			;Byte ptr for TTY portion of WTO msg
	$DATA	WTOADR			;Addr of page for TTY type-out
SUBTTL .INIT  - Initialize the common code

;This code is set up for the stop code processor.
;	Information is copied to the crash block from parameters
;	not known at load time.

;CALL IS:	S1/ Length of the IB (Initialization Block)
;		S2/ Address of the IB

.INIT:	MOVE	S1,IIB##+IB.PRG		;GET THE PROGRAM NAME
	MOVEM	S1,.SPRGM		;STORE FOR LATER
	PUSHJ	P,GJBVER##		;Ask GLXINT for the version
	MOVEM	S1,.SPVER		;SAVE IT
	MOVEI	S1,PAGTBL##		;GET ADDRESS OF PAGE TABLE
	MOVEM	S1,.SPTBL		;STORE FOR LATER
	MOVX	S1,GLXVRS##		;GET LIBRARY VERSION NUMBER
	MOVEM	S1,.SPLIB		;SAVE IT AWAY
	$RETT				;RETURN
SUBTTL	.ZPAGA - .ZPAGN - .ZCHNK  --  Zero out memory

;ROUTINES TO COMPLETELY ZERO A PAGE OF MEMORY.  .ZPAGA IS
;	CALLED WITH THE ADDRESS OF THE FIRST WORD OF THE PAGE
;	IN S1 AND .ZPAGN IS CALLED WITH THE PAGE NUMBER IN S1.
;	.ZCHNK IS USED TO ZERO A CHUNK OF MEMORY
;	  SIZE IN S1 AND LOCATION S2
;	ALL ACS ARE PRESERVED

.ZPAGN:	PUSH	P,S1			;SAVE PAGE NUMBER
	PG2ADR	S1			;CONVERT PAGE NUMBER TO ADR
	SKIPA				;DON'T SAVE S1 TWICE

.ZPAGA:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;AND S2
	MOVE	S2,S1			;GET ADDRESS INTO S2
	MOVX	S1,PAGSIZ		;AND ONE PAGE SIZE INTO S1
	PJRST	ZCHN.1			;JOIN COMMON CODE

.ZCHNK:	TRNN	S1,-1			;Anything to do?
	$RETT				;No..just return
	PUSH	P,S1			;SAVE CALLER'S SIZE
	PUSH	P,S2			;AND ADDRESS
ZCHN.1:	ZERO	0(S2)			;CLEAR FIRST WORD
	SOJE	S1,ZCHN.2		;COUNT OF 1,,JUST RETURN
	ADDI	S1,0(S2)		;COMPUTE END ADDRESS
	HRLS	S2			;GET ADDR,,ADDR OF CHUNK
	AOS	S2			;AND NOW ADDR,,ADDR+1
	BLT	S2,0(S1)		;NOW CLEAR THE CHUNK
ZCHN.2:	POP	P,S2			;RESTORE CALLER'S CHUNK ADDR
	POP	P,S1			;AND HIS SIZE
	$RETT				;AND RETURN
SUBTTL .SAVEx Routines -- Save permanent ACS

;THESE ROUTINES ACT AS CO-ROUTINES WITH THE ROUTINES WHICH CALL THEM,
;	THEREFORE NO CORRESPONDING "RESTORE" ROUTINES ARE NEEDED. WHEN
;	THE CALLING ROUTINE RETURNS TO ITS CALLER, IT ACTUALLY RETURNS
;	VIA THE RESTORE ROUTINES AUTOMATICALLY.

.SAVE1:	EXCH	P1,(P)		;SAVE P1 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	P1,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	P1,(P1)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	JRST	RES1		;RESTORE P1

.SAVE2:	EXCH	P1,(P)		;SAVE P1 GET CALLERS ADDRESS
	PUSH	P,P2		;SAVE P2
	PUSH	P,.+3		;SAVE RETURN ADDRESS
	HRLI	P1,-2(P)	;SETUP FOR THE JRA
	JRA	P1,(P1)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-2(P)		;SKIP RETURN
	JRST	RES2		;RESTORE P2,P1

.SAVE3:	EXCH	P1,(P)		;SAVE P1 GET RETURN ADDRESS
	PUSH	P,P2		;SAVE P2
	PUSH	P,P3		;SAVE P3
	PUSH	P,.+3		;SAVE RETURN ADDRESS
	HRLI	P1,-3(P)	;SETUP FOR JRA
	JRA	P1,(P1)		;AND CALL THE CALLER
	  CAIA	.		;NON-SKIP
	AOS	-3(P)		;SKIP RETURN
	JRST	RES3		;AND RESTORE P3,P2,P1

.SAVE4:	EXCH	P1,(P)		;SAVE P1 GET RETURN ADDRESS
	PUSH	P,P2		;SAVE P2
	PUSH	P,P3		;SAVE P3
	PUSH	P,P4		;SAVE P4
	PUSH	P,.+3		;SAVE RETURN ADDRESS
	HRLI	P1,-4(P)	;SETUP FOR RETURN
	JRA	P1,(P1)		;AND RETURN
	  CAIA	.		;NON-SKIP RETURN
	AOS	-4(P)		;SKIP RETURN
RES4:	POP	P,P4		;RESTORE P4
RES3:	POP	P,P3		;RESTORE P3
RES2:	POP	P,P2		;RESTORE P2
RES1:	POP	P,P1		;RESTORE P1
	POPJ	P,		;AND RETURN
SUBTTL	.SAVE8 and .SAVET Routines

.SAVE8::EXCH	.FPAC,0(P)	;SAVE P1 AND GET PC
	PUSH	P,.FPAC+1	;SAVE P2
	PUSH	P,.FPAC+2	;SAVE P3
	PUSH	P,.FPAC+3	;SAVE P4
	PUSH	P,.FPAC+4	;SAVE 13
	PUSH	P,.FPAC+5	;SAVE 14
	PUSH	P,.FPAC+6	;SAVE 15
	PUSH	P,.FPAC+7	;SAVE 16
	PUSH	P,.+3		;SAVE RETURN ADDRESS
	HRLI	.FPAC,-10(P)	;LOOK LIKE RESULT OF JRA
	JRA	.FPAC,(.FPAC)	;CALL CALLER
	 CAIA	.		;NON SKIP RETURN
	AOS -10(P)		;SKIP RETURN
	DMOVE	.FPAC+6,-1(P)	;RESTORE 15 &16
	DMOVE	.FPAC+4,-3(P)	;RESTORE 13 & 14
	DMOVE	.FPAC+2,-5(P)	;RESTORE P3 & P4
	DMOVE	.FPAC,-7(P)	;RESTORE P1 & P2
	SUB	P,[10,,10]		;ADJUST STACK
	POPJ	P,			;GIVE SKIP OR NON SKIP RETURN


.SAVET:	EXCH	T1,(P)		;SAVE T1 AND GET RETURN ADDRESS
	PUSH	P,T2		;SAVE T2
	PUSH	P,T3		;SAVE T3
	PUSH	P,T4		;SAVE T4
	PUSH	P,.+3		;SAVE RETURN ADDRESS
	HRLI	T1,-4(P)	;SETUP FOR JRA
	JRA	T1,(T1)		;AND CALL THE CALLER
	  CAIA	.		;RETURN HERE ON NON-SKIP
	AOS	-4(P)		;RETURN HERE ON SKIP
	POP	P,T4		;RESTORE T4
	POP	P,T3		;RESTORE T3
	POP	P,T2		;RESTORE T2
	POP	P,T1		;RESTORE T1
	POPJ	P,		;RETURN
SUBTTL .SVxx  --  Routines for saving random ACS


; THESE ROUTINES ARE CALLED BY THE SAVE MACRO FOR ABSOLUTE AC'S
;	13,14,15, & 16. THE MACRO FIGURES OUT WHICH ONE

.SV13:	EXCH	13,(P)		;SAVE 13 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	13,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	13,(13)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	POP	P,13		;RESTORE 13
	POPJ	P,		;AND RETURN

.SV14:	EXCH	14,(P)		;SAVE 14 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	14,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	14,(14)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	POP	P,14		;RESTORE 14
	POPJ	P,		;AND RETURN

.SV15:	EXCH	15,(P)		;SAVE 15 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	15,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	15,(15)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	POP	P,15		;RESTORE 15
	POPJ	P,		;AND RETURN

.SV16:	EXCH	16,(P)		;SAVE 16 GET CALLERS ADDRESS
	PUSH	P,.+3		;SAVE RETURN ADDRESS FOR CALLER
	HRLI	16,-1(P)	;MAKE IT LOOK LIKE RESULT OF JSA
	JRA	16,(16)		;CALL THE CALLER
	  CAIA	.		;NON-SKIP RETURN
	AOS	-1(P)		;SKIP RETURN
	POP	P,16		;RESTORE 16
	POPJ	P,		;AND RETURN
SUBTTL .POPJ, .RETE,.RETT & .RETF -- Common return routines


; $RETE calls .RETE to set up the last GALAXY error and location
; then set TF = FALSE and return.

.RETE:	HRRZM	TF,.LGEPC	;CALLED VIA JSP TF, SO SET UP PC OF LAST ERROR
	HRRZ	S1,@.LGEPC	;NOW FETCH ERROR CODE
	MOVEM	S1,.LGERR	;AND REMEMBER IT
				;FALL INTO .RETF

; .RETT AND .RETF are called via the $RETT and $RETF macros and can also
; be called directly.  They both set the value of TF, one to TRUE and the other
; to FALSE.  After doing this, they return via a POPJ P,

;The .POPJ  routine can be jumped
; to get a return, without changing the value in the TF register

.RETF:	TDZA	TF,TF		;ZEROS MEAN FALSE
.RETT:	SETO	TF,		;ONES MEAN TRUE
.POPJ:	POPJ	P,0		;RETURN
SUBTTL .AOS, .SOS and .ZERO - Support for INCR,DECR, ZERO

;THIS HAS BEEN OBSOLETED BY NEW INCR,DECR,ZERO MACRO DEFINITIONS

; These routines are never used directly, but are available for the
; INCR, DECR and ZERO macros to use when the field is neither a fullword
; or either half word.

.AOS:	PUSH	P,TF			;SAVE REGISTER WE WILL USE
	HRRZ	TF,-1(P)		;GET LOCATION OF JUMP [POINTR()]
	PUSH	P,@TF			;STORE IN ON THE STACK
	LDB	TF,@0(P)		;GET THE BYTE TO BE INCREASED
	AOJA	TF,ZERO.1		;INCREASE IT AND RETURN

.SOS:	PUSH	P,TF			;SAVE TF
	HRRZ	TF,-1(P)		;PICK UP LOCATION OF CALL
	PUSH	P,@TF			;SAVE ADDR OF POINTER ON STACK
	LDB	TF,@0(P)		;GET THE BYTE
	SOJA	TF,ZERO.1		;DECREASE BY ONE AND RETURN


.ZERO:	PUSH	P,TF			;SAVE TF
	HRRZ	TF,-1(P)		;GET ADDR OF CALL
	PUSH	P,@TF			;SAVE ADDR OF POINTER ON THE STACK
	SETZ	TF,			;GET A ZERO BYTE
ZERO.1:	DPB	TF,@0(P)		;STORE IT BACK
	POP	P,TF			;CLEAR POINTER OF STACK
	POP	P,TF			;RESTORE TF
	POPJ	P,			;THEN RETURN
SUBTTL	STKVAR SUPPORT CODE

;COMMON ENTRY AND EXIT ROUTINE FOR STACK VARIABLE

.STKST::ADD P,@.SAC		;BUMP STACK FOR VARIABLES USED
	JUMPGE P,STKSOV		;TEST FOR STACK OVERFLOW
STKSE1:	PUSH P,@.SAC		;SAVE BLOCK SIZE FOR RETURN
	AOS .SAC		;BUMP PAST POINTER
	PUSHJ P,@.SAC		;CONTINUE ROUTINE, EXIT TO .+1
.STKRT::CAIA			;NON-SKIP RETURN
	AOS -1(P)		;SKIP RETURN
	SUB P,0(P)		;ADJUST PER COUNT OF VARIABLES
	SUB P,[1,,1]		;REMOVE COUNT FROM STACK
	POPJ P,0		;RETURN

STKSOV:	SUB P,@.SAC		;STACK OVERFLOW- UNDO ADD
	HLL .SAC,@.SAC	;SETUP TO DO MULTIPLE PUSH, GET COUNT
STKSO1:	PUSH P,[0]		;DO ONE PUSH AT A TIME, GET REGULAR
	SUB .SAC,[1,,0]		; ACTION ON OVERFLOW
	TLNE .SAC,777777	;COUNT DOWN TO 0?
	JRST STKSO1		;NO, KEEP PUSHING
	JRST STKSE1
SUBTTL	TRVAR SUPPORT CODE

;SUPPORT ROUTINE FOR TRVAR

.TRSET::PUSH P,.FP		;PRESERVE OLD .FP
	MOVE .FP,P		;SETUP FRAME PTR
	ADD P,@.SAC		;ALLOCATE SPACE
	JUMPGE P,TRSOV
	AOS .SAC		;BUMP RETURN ADDRESS
TRSET1:	PUSHJ P,@.SAC		;CONTINUE ROUTINE, EXIT VIA .+1
.TRRET::JRST [	MOVEM .FP,P	;CLEAR STACK
		POP P,.FP	;RESTORE OLD .FP
		POPJ P,]
	MOVEM .FP,P		;HERE IF SKIP RETURN
	POP P,.FP
	AOS 0(P)		;PASS SKIP RETURN
	POPJ P,

TRSOV:	SUB P,@.SAC		;STACK OVERFLOW - UNDO ADD
	HLL .SAC,@.SAC	;GET COUNT
TRSOV1:	PUSH P,[0]		;DO ONE PUSH AT A TIME, GET REGULAR
	SUB .SAC,[1,,0]		; ACTION ON OVERFLOW
	TLNE .SAC,777777	;COUNT TO 0?
	JRST TRSOV1		;NO, KEEP PUSHING
	JRST TRSET1		;CONTINUE SETUP
SUBTTL STOP CODE Processor

; This routine handles the call caused by the $STOP and $FATAL macros

.STOP:	SKIPE	STPFLG			;ALREADY PROCESSING A STOPCODE
	JRST	[PUSHJ	P,STOP.4	;DUMP THE PAGE OUT
		$HALT	]		;AND EXIT
	MOVEM	0,.SACS			;STORE FIRST AC
	MOVE	0,[XWD 1,.SACS+1]	;SET FOR THE REST
	BLT	0,.SACS+17		;STORE THEM ALL
	MOVE	T1,0(P)			;GET LOCATION CALLED FROM
	MOVE	T2,@0(T1)		;THEN GET POINTER WORD TO CODE
	HLLZM	T2,.SCODE		;STORE SIXBIT CODE
	HRRZM	T2,.SRSN		;Save addr of reason TEXT (or ITEXT)
	MOVEI	T3,@0(T1)		;GET LOCATION THAT XWD FETCHED FROM
	MOVE	T3,1(T3)		;GET MODULE NAME
	MOVEI	T1,-1(T1)		;GET ACTUAL LOCATION OF 'PUSHJ P,.STOP'
	MOVEM	T1,.SPC			;REMEMBER IT
	MOVE	S1,.SCODE		;GET REASON CODE
	MOVE	S2,.SPC			;GET PC OF STOP CODE
	SKIPE	IIB+IB.ERR		;ERROR PROCESSOR?
	PUSHJ	P,@IIB+IB.ERR		;YES..CALL IT
	SETOM	STPFLG			;MARK PROCESSING A STOPCODE
	PUSHJ	P,M%GPAG		;SETUP WTO MESSAGE
	MOVEM	S1,WTOADR		;Save start of page for storing
	SETOM	TXTLVL##		;MAKE SURE TEXT WON'T STOP US
	HRLI	S1,(POINT 7,)		;Make a byte pointer
	MOVEM	S1,WTOPTR		;Save it for output
	SKIPE	.SCODE			;Processing a $FATAL message?
	JRST	STOP.1			;No..do full stop code
	$TEXT	(STPDEP,<? ^W/.SPRGM/^A>)	;Output program name
	CAME	T3,.SPRGM		;Same as module name?
	$TEXT	(STPDEP,< ^W/T3/^A>)	;No..output module name
	HRLZI	17,.SACS		;Make AC restoration BLT ptr
	BLT	17,17			;Restore the regs
	$TEXT	(STPDEP,< ^I/@.SRSN/>)	;Output reason
	PUSH	P,[0]			;Don't enter DDT
	JRST	STOP.3			;Finish up

STOP.1:	$TEXT(STPDEP,<?Stop code - ^W/T2,LHMASK/ - in module ^W/T3/ on ^H9/[-1]/ at ^C/[-1]/>)
	HRLZI	17,.SACS		;Make AC restoration BLT ptr
	BLT	17,17			;Restore the regs
	$TEXT(STPDEP,<  Reason: ^I/@.SRSN/>) ;Yes, do it the new way
	$TEXT(STPDEP,<  Program is ^W/.SPRGM/ Version ^V/.SPVER/ using GLXLIB Version ^V/.SPLIB/>)
	$TEXT(STPDEP,<  Last  GLXLIB error: ^O/.LGERR,RHMASK/ (^E/.LGERR/)>)
TOPS20 <
	MOVX	S1,.FHSLF		;FOR SELF,
	GETER				;LOOK UP MOST RECENT ERROR
	 ERJMP	.+1			;IGNORE ANY ERRORS
	MOVEM	S2,.SERR		;SAVE THE ERROR
	$TEXT	(STPDEP,<  Last TOPS-20 error: ^O/.SERR,RHMASK/ (^E/.SERR,RHMASK/)>)
	PUSHJ	P,SAVCRS		;SAVE THE CRASH
> ;END TOPS20 CONDITIONAL

	CONT.	(STOP.)
;Header is built, tack on ACs and stack locations
	HRLZI	17,.SACS		;Make AC restoration BLT ptr
	BLT	17,17			;Restore the regs
	$TEXT	(STPDEP,<^I/ST.ACS/^I/ST.STK/>)
	HRRZ	S1,DDTADR		;GET ADDRESS OF DDT
	PUSH	P,S1			;ADDRESS OF DDT

;Then see if we should send to OPR
STOP.3:	MOVX	S1,IP.STP		;GET STOPCODE TO ORION FLAG
	TDNN	S1,IIB##+IB.FLG		;CHECK IF SET
	JRST	STOP.4			;Don't want to, just dump on TTY
	SKIPE	MYPID##			;Do we have any PIDs at all?
	SKIPE	IMOPR##			;Yes, Yes, Am I ORION?
	JRST	STOP.4			;No PID, or I'm ORION,
					;Just output to terminal
	$WTO	(Program ^W/.SPRGM/ terminated,<^T/@WTOADR/>,,$WTFLG(WT.NFO)) ;Dump TTY msg, acs, stack
STOP.4:	MOVE	S1,WTOADR		;GET MESSAGE ADDRESS
	PUSHJ	P,K%SOUT		;DUMP THE DATA
	MOVSI	16,.SACS		;RESTORE THE ACS
	BLT	16,16			;TO THE USER
	SKIPN	0(P)			;Enter DDT?
	$HALT				;NO..just exit
	$TEXT(T%TTY,<^M^J  Entering DDT	(Crash block starts at loc ^O/[.SPC]/)>)
	POPJ	P,			;GO ENTER DDT

;A little routine to output bytes, and advance a pointer
STPDEP:	IDPB	S1,WTOPTR		;Just dump the byte
	$RETT				;And return

ST.ACS:	ITEXT	(<^M^JContents of the ACs  (Crash block starts at location ^O/[.SPC]/)^M^J^I/ST03/^I/ST47/^I/ST1013/^I/ST1417/>)
ST03:	ITEXT	(<  0/^O15/0/^O15/1/^O15/2/^O15/3/^M^J>)
ST47:	ITEXT	(<  4/^O15/4/^O15/5/^O15/6/^O15/7/^M^J>)
ST1013:	ITEXT	(< 10/^O15/10/^O15/11/^O15/12/^O15/13/^M^J>)
ST1417:	ITEXT	(< 14/^O15/14/^O15/15/^O15/16/^O15/17/^M^J>)

ST.STK:	ITEXT(<^M^JLast 9 Stack Locations:^M^J^I/STK1/^I/STK4/^I/STK7/>)
STK1:	ITEXT(< -1(P)/^O15/-1(P)/   -2(P)/^O15/-2(P)/   -3(P)/^O15/-3(P)/^M^J>)
STK4:	ITEXT(< -4(P)/^O15/-4(P)/   -5(P)/^O15/-5(P)/   -6(P)/^O15/-6(P)/^M^J>)
STK7:	ITEXT(< -7(P)/^O15/-7(P)/   -8(P)/^O15/-8(P)/   -9(P)/^O15/-9(P)/^M^J>)

	
	SUBTTL	SAVCRS	--	Save Crash on Stopcodes

	;This Routine will save the crash for programs that have
	;stopcoded and requested that ORION be informed.

TOPS20	<
SAVCRS:	SKIPE	DEBUGW			;ARE WE DEBUGGING?
	$RETT				;YES..IGNORE SAVE
	MOVX	S1,IP.STP		;GET THE STOPCODE FLAG
	TDNN	S1,IIB##+IB.FLG		;CHECK IF SET?
	$RETT				;NO..IGNORE SAVE
	$TEXT	(<-1,,SAVBUF##>,<^T/SAVNM1/^W/.SPRGM/-^W/.SCODE/-CRASH.EXE^0>)
	MOVX	S1,GJ%FOU!GJ%SHT	;CREATE NEW GENERATION
	HRROI	S2,SAVBUF##		;POINT TO THE STRING
	GTJFN				;GET THE JFN
	   $RETT			;IGNORE IT ..AND RETURN
	HRLI	S1,.FHSLF		;PUT HANDLE IN LEFT HALF (JFN IN RIGHT)
	MOVE	S2,[777760,,20]		;SAVE ALL ASSIGNED NON-ZERO MEMORY
	JSYS	202			;SAVE JSYS (SINCE THERE IS SAVE MACRO)
	ERJMP	.RETT			;IGNORE THE SAVE FAILURE
	$TEXT	(STPDEP,<  Crash Saved in File: ^T/SAVBUF/>)
	$RETT				;RETURN
SAVNM1:	ASCIZ/PS:<SPOOL>/
>;END TOPS20

COM%L:
	END