Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99m-bb - glxcom.x19
There are no other files named glxcom.x19 in the archive.
TITLE	GLXCOM  --  Common module for Sub-Systems Components
SUBTTL	Chuck O'Toole /ILG/MLB/PJT/DC/DPM/NT/CTK 20-Apr-88
;
;
;        COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
;			 1983,1984,1985,1986,1987
;                    DIGITAL EQUIPMENT CORPORATION
;			 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.


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

	.JBBPT==76		;UNTIL LINK DEFINES .JBBPT

	COMEDT==62		;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	.POPJ1

ENTRY	.SC2UD,.UD2SC		; Handy routines for second to UDT conversion

ENTRY	.CPUTY			;Determine CPU type

ENTRY	.STOP			;OLD STOPCODE PROCESSOR
ENTRY	.DIE			;NEW STOPCODE 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

0033			Fix .STOP so CONTINUE typed after a stopcode won't
			get ? Ill UUO at user PC 000000

0034			Fix .STKST so that it handles skip returns
0035			Zero out our $DATA space on initialization.
0036			Do not send $FATAL errors to ORION

0037			Only dump ACs if IB.STP is set. Only Galaxy components
			should be setting this bit. Also, don't enter DDT. .
			Stupid users don't know what to do at that point anyway.

0040			Make GLXLIB run execute-only.
			Add PORTAL instructions to all return points within
			the many AC/variable save co-routines. This includes
			the STKVAR and TRVAR routines, and calls to the user
			error processor (pointed to by IB.ERR).

0041			Restructure GLXLIB
			 1) Call .RETE via a PUSHJ instead of a JSP. This
			    allows extended addressing to be used someday.
			 2) GLXVRS is no longer external.
			 3) Define global symbols CRSHAC (TOPS-10) and BUGACS
			    (TOPS-20) to point to .SACS. This causes FILDDT
			    to automatically load the ACs from .SACS.

0042			Remove redumdant message "Crash blocks starts at ..."
			from the stopcode text.

0043			Call STKVAR and TRVAR callable via a PUSHJ, not a JSP
			so it will work in a non-zero section.

0044			Turn off interrupts start start of stopcode processing
			and turn them back on when done.

0045			Add .POPJ1 to allow skip returns.

0046			Have .STOP set up its own PDL.
			Don't turn PSI back on until after user PDL restored.

0047			Restore ACs that .STOP trashes before processing reason
			ITEXT block.

0050			Don't allow .ZCHNK to zap the ACs.

0051			Insert 2 new routines .UD2SC and .SC2UD to convert from
			seconds to UDT and back.
0052			Fix up handling of recursive stopcodes.

0053			Add routine .CPUTY to determine the CPU type.

;**;Begin code maintenance for GALAXY 4.1

0054			Fix error in .CPUTY routine.
			SPR 10-33433	25-SEP-83/CTK

0055			Fix non problem coding error.
			SPR 10-33434/CTK

;**;Begin code maintenance for GALAXY 5.1

0056	G10462		Change $STOP to STOPCD.
			14-Nov-86/BAH

0057	G10484		Fix stopcode problems.
			 6-Jan-88/JAD

0060	G10622		Don't send stopcodes to ORION if we are ORION.
			20-Apr-88/DPM

0061			Added the SAVE. UUO to GLXCOM and added the IB.SAV
			flag for it's use in GLXMAC.MAC
			23-May-88/PERK

0062			Fix the error recovery for the SAVE. function added
			in edit 61.

End of Revision History
\
SUBTTL Global Storage


; GLOBAL CRASH INFORMATION

	$DATA	COMBEG,0		;START OF ZEROABLE $DATA SPACE
	$GDATA	.SBLK,0			;START OF CRASH BLOCK
	$GDATA	.STYPE			;STOPCODE TYPE
	$GDATA	.SPC			;PC OF STOP
	$GDATA	.SCODE			;SIXBIT CODE OF STOP CODE
	STPTSZ==^D100			;LENGTH OF TEXT BUFFER
	$GDATA	.STEXT,STPTSZ		;COMPLETE STOPCODE TEXT
	$GDATA	.SRSN			;REASON
	$GDATA	.SMOD			;SIXBIT MODULE NAME
	$GDATA	.SERR			;LAST OPERATING SYSTEM ERROR (TOPS-20)
TOPS10	<$GDATA	CRSHAC,0>		;CUTE TRICK TO CAUSE FILDDT TO
TOPS20	<$GDATA	BUGACS,0>		; LOAD UP THE ACS FROM .SACS
	$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
	$GDATA	.LGEPC			;PC (USUALLY) OF LAST $RETE

	$DATA	STPFLG			;STOPCODE FLAG
	$DATA	STPCNT			;CHARACTER COUNTER
	$DATA	STPPTR			;BYTE POINTER TO .STEXT
	$DATA	STPCON			;CONTINUE ADDRESS
	$DATA	PIUSE			;PSI IN USE FLAG
	$DATA	BPTCOD,3		;LOW SEG CODE TO ENTER DDT
	STPPSZ==60			;STOPCODE PDL SIZE
	$DATA	STPPDL,STPPSZ		;STOPCODE PDL
	ERRBSZ==20			;LENGTH OF ERROR BUFFER
	$DATA	ERRBUF,ERRBSZ		;ERROR BUFFER

	$DATA	WTOPTR			;Byte ptr for TTY portion of WTO msg
	$DATA	WTOADR			;Addr of page for TTY type-out
	$DATA	STPSVP			;Used to save P during the SAVE. UUO
	$DATA	SAVBLK,.RNMEM+1		;SAVE. block for STOPCD processor
	$DATA	COMEND,0		;END OF ZEROABLE $DATA SPACE
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:	IIB SETUP

.INIT:	MOVE	S1,[COMBEG,,COMBEG+1]	;BLT PTR TO ZEROABLE $DATA SPACE
;**;[55]CHANGE 1 LINE AT .INIT:+1L	25-SEP-83/CTK
	SETZM	COMBEG			;[55]DO THE FIRST BY HAND
	BLT	S1,COMEND-1		;AND THE REST BY BLT
	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
	SETOM	STPFLG			;FLAG NO STOPCODE PENDING
	$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
	CAIGE	S1,20			;OUT OF THE ACS?
	STOPCD	(AZA,HALT,,<Attempt to zero the ACs>) ;++LOSER
	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. These unconventional looking routines
; actually run about 30% to 40% faster than those in SCAN or the TOPS-10
; monitor.

.SAVE1:	PUSH	P,P1			;SAVE P1
	PUSHJ	P,@-1(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-2(P)			;ADJUST RETURN PC
	POP	P,P1			;RESTORE P1
	SUB	P,[1,,1]		;ADJUST STACK
	POPJ	P,			;RETURN

.SAVE2:	ADD	P,[2,,2]		;ADJUST STACK
	DMOVEM	P1,-1(P)		;SAVE P1 AND P2
	PUSHJ	P,@-2(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-3(P)			;ADJUST RETURN PC
	DMOVE	P1,-1(P)		;RESTORE P1 AND P2
	SUB	P,[3,,3]		;ADJUST STACK
	POPJ	P,			;RETURN

.SAVE3:	ADD	P,[3,,3]		;ADJUST STACK
	DMOVEM	P1,-2(P)		;SAVE P1 AND P2
	MOVEM	P3,0(P)			;SAVE P3
	PUSHJ	P,@-3(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-4(P)			;ADJUST RETURN PC
	DMOVE	P1,-2(P)		;RESTORE P1 AND P2
	MOVE	P3,0(P)			;RESTORE P3
	SUB	P,[4,,4]		;ADJUST STACK
	POPJ	P,			;RETURN

.SAVE4:	ADD	P,[4,,4]		;ADJUST STACK
	DMOVEM	P1,-3(P)		;SAVE P1 AND P2
	DMOVEM	P3,-1(P)		;SAVE P3 AND P4
	PUSHJ	P,@-4(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-5(P)			;ADJUST RETURN PC
	DMOVE	P1,-3(P)		;RESTORE P1 AND P2
	DMOVE	P3,-1(P)		;RESTORE P3 AND P4
	SUB	P,[5,,5]		;ADJUST STACK
	POPJ	P,			;RETURN

SUBTTL	.SAVE8 and .SAVET Routines

.SAVE8:	ADD	P,[10,,10]		;ADJUST STACK
	DMOVEM	P1,-7(P)		;SAVE P1 AND P2
	DMOVEM	P3,-5(P)		;SAVE P3 AND P4
	DMOVEM	13,-3(P)		;SAVE 13 AND 15
	DMOVEM	15,-1(P)		;SAVE 15 AND 16
	PUSHJ	P,@-10(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-11(P)			;ADJUST RETURN PC
	DMOVE	P1,-7(P)		;RESTORE P1 AND P2
	DMOVE	P3,-5(P)		;RESTORE P3 AND P4
	DMOVE	13,-3(P)		;RESTORE 13 AND 15
	DMOVE	15,-1(P)		;RESTORE 15 AND 16
	SUB	P,[11,,11]		;ADJUST STACK
	POPJ	P,			;RETURN


.SAVET:	ADD	P,[4,,4]		;ADJUST STACK
	DMOVEM	T1,-3(P)		;SAVE T1 AND T2
	DMOVEM	T3,-1(P)		;SAVE T3 AND T4
	PUSHJ	P,@-4(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-5(P)			;ADJUST RETURN PC
	DMOVE	T1,-3(P)		;RESTORE T1 AND T2
	DMOVE	T3,-1(P)		;RESTORE T3 AND T4
	SUB	P,[5,,5]		;ADJUST STACK
	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:	PUSH	P,13			;SAVE AC 13
	PUSHJ	P,@-1(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-2(P)			;ADJUST RETURN PC
	POP	P,13			;RESTORE 13
	SUB	P,[1,,1]		;ADJUST STACK
	POPJ	P,			;RETURN

.SV14:	PUSH	P,14			;SAVE AC 14
	PUSHJ	P,@-1(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-2(P)			;ADJUST RETURN PC
	POP	P,14			;RESTORE 14
	SUB	P,[1,,1]		;ADJUST STACK
	POPJ	P,			;RETURN

.SV15:	PUSH	P,15			;SAVE AC 15
	PUSHJ	P,@-1(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-2(P)			;ADJUST RETURN PC
	POP	P,15			;RESTORE 15
	SUB	P,[1,,1]		;ADJUST STACK
	POPJ	P,			;RETURN

.SV16:	PUSH	P,16			;SAVE AC 16
	PUSHJ	P,@-1(P)		;CALL THE CALLER
	  PORTAL .+3			;NON-SKIP RETURN
	PORTAL	.+1			;SKIP RETURN
	AOS	-2(P)			;ADJUST RETURN PC
	POP	P,16			;RESTORE 16
	SUB	P,[1,,1]		;ADJUST STACK
	POPJ	P,			;RETURN
SUBTTL .POPJ, .POPJ1, .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:	XMOVEI	S1,@(P)		;GET RETURN PC
	HRRZ	S1,(S1)		;GET ERROR CODE
	MOVEM	S1,.LGERR	;AND REMEMBER IT
	POP	P,(P)		;TRIM STACK
				;FALL INTO .RETF (RETURN TO CALLER'S CALLER)

; .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,
;
.RETF:	TDZA	TF,TF		;ZEROS MEAN FALSE
.RETT:	SETO	TF,		;ONES MEAN TRUE
	POPJ	P,		;RETURN


; The .POPJ and .POPJ1 routines can be jumped
; to get a return, without changing the value in the TF register
;
.POPJ1:	AOS	(P)		;SKIP
.POPJ:	POPJ	P,		;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::POP	P,.SAC		;GET CALLER'S PC
	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
	PORTAL	[SUB P,0(P)	;NON-SKIP/ CLEAR PUBLIC, SET CONCEALED MODE
		 SUB P,[1,,1]	;REMOVE THE COUNT
		 POPJ	P,0]
	PORTAL	.+1		;SKIP/ CLEAR PUBLIC, SET CONCEALED
	SUB P,0(P)		;SKIP RETURN COMES HERE
	SUB P,[1,,1]		;REMOVE COUNT FROM STACK
	AOS	0(P)		;SKIP RETURN
	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::POP	P,.SAC		;GET CALLER'S PC
	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
	PORTAL	[MOVEM .FP,P	;NON-SKIP/ CLEAR PUBLIC, SET CONCEALED
		POP P,.FP	;RESTORE OLD .FP
		POPJ P,]
	PORTAL	.+1		;SKIP/ CLEAR PUBLIC, SET CONCEALED
	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 Time conversion routines -- .SC2UD

;	This routine will conver a number of seconds to day,,fraction
; with relatively good precion. (Adds an extra second/day)
; CALL:
;	(S1) = Number of seconds
;	Returns here with UDT in S1,S2 Number of milliseconds remainder

	RADIX	10		; *** NOTE ***
.SC2UD:	ASHC	S1,-17		; Position fraction correctly
	DIV	S1,[24*60*60]	; Divide by number of seconds in a day
	CAXLE	S2,<^D<24*60*60/2>> ; Over half to the next?
	AOS	S1		; Yes, increment the UDT
	$RETT			; Return

SUBTTL Time conversion routines -- .UD2SC

;	This routine is the opposite of the above. Given a UDT it will convert
; it into the number of seconds represented by it.
; CALL:
;	(S1) = UDT
;	Returns here with S1 = nuber of seconds, S2 trashed

.UD2SC:	MULX	S1,<^D<24*60*60>>	; Multiply by number of secs/day
	ASHC	S1,17			; Position for return
	$RETT

	RADIX	8			; *** BACK TO OCTAL ***
SUBTTL	Determine CPU type


; This routine will determine the CPU type and return a value.
; Call:	PUSHJ	P,.CPUTY
;
; TRUE return:	S1:= CPU type
; FALSE return:	never
;
.CPUTY::PUSHJ	P,.SAVE4		;SAVE SOME ACS
	JFCL	17,.+1			;CLEAR FLAGS
	JRST	.+1			;CHANGE PC
	JFCL	1,CP166			;PDP-6 HAS PC CHANGE FLAG
	MOVNI	P1,1			;MAKE AC ALL ONES
	AOBJN	P1,.+1			;INCREMENT BOTH HALVES
	JUMPN	P1,KA10			;KA10 if P1:= 1000000
	BLT	P1,0			;DO A NO-OP BLT
	JUMPE	P1,KI10			;NO CHANGE IF A KI10
	MOVEI	P1,1			;SET UP A 1
	MOVEI	P2,0			;CLEAR STRING BYTE POINTER
;**;[54]CHANGE 1 LINE AT .CPUTY:+11L	25-SEP-83/CTK
	MOVEI	P4,1			;[54]SET DOUBLE LENGTH BINARY RESULT
	EXTEND	P1,[CVTBDO]		;CONVERT BINARY TO DECIMAL
	TLNE	P4,200000		;KL10 MICROCODE BUG SET THIS BIT
	JRST	KL10			;WE KNOW THIS BUG WON'T BE FIXED
	JRSTF	@[PC.BIS!.+1]		;SET BYTE INCREMENT SUPRESSION
	MOVSI	P1,440700		;BUILD A BYTE POINTER
	ILDB	P2,P1			;DO AN INCREMENT/LOAD BYTE
	JUMPLE	P1,KS10			;KS10 CHECKS FIRST PART DONE
	JRST	XXXX			;XXXX DOESN'T

CP166:	SKIPA	S1,[%PDP6]		;GET PDP6 CODE
KA10:	MOVEI	S1,%KA10		;GET KA10 CODE
	$RETT				;RETURN
KI10:	SKIPA	S1,[%KI10]		;GET KI10 CODE
KL10:	MOVEI	S1,%KL10		;GET KL10 CODE
	$RETT				;RETURN
KS10:	SKIPA	S1,[%KS10]		;GET KS10 CODE
XXXX:	MOVEI	S1,%XXXX		;GET XXXX CODE
	$RETT				;RETURN
SUBTTL STOP CODE Processor

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

.STOP:	AOSE	STPFLG			;ALREADY PROCESSING A STOPCODE
	 JRST	STOP.4			;YES - JUST TYPE OUT DUMP ON TTY
	MOVEM	0,.SACS			;STORE FIRST AC
	MOVE	0,[XWD 1,.SACS+1]	;SET FOR THE REST
	BLT	0,.SACS+17		;STORE THEM ALL
	MOVE	P,[IOWD STPPSZ,STPPDL]	;SET UP NEW PDL
	PUSHJ	P,I%IOFF		;TURN OFF INTERRUPTS
	MOVE	S1,.SACS+P		;GET OLD PDL POINTER
	MOVE	S1,0(S1)		;GET LOCATION CALLED FROM
	MOVE	S2,@0(S1)		;THEN GET POINTER WORD TO CODE
	HLLZM	S2,.SCODE		;STORE SIXBIT CODE
	HRRZM	S2,.SRSN		;SAVE ADDRESS OF REASON
	MOVEI	S2,@0(S1)		;GET LOCATION THAT XWD FETCHED FROM
	MOVE	S2,1(S2)		;GET MODULE NAME
	MOVEM	S2,.SMOD		;STORE IT
	MOVEI	S2,-1(S1)		;GET ACTUAL LOCATION OF 'PUSHJ P,.STOP'
	MOVEM	S2,.SPC			;REMEMBER IT
	MOVE	S1,.SCODE		;GET REASON CODE
	SKIPE	IIB+IB.ERR		;ERROR PROCESSOR?
	PUSHJ	P,@IIB+IB.ERR		;YES..CALL IT
	PORTAL	.+1			;CLEAR PUBLIC, SET CONCEALED
	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	S1,.SPRGM		;Same as module name?
	$TEXT	(STPDEP,< ^W/.SMOD/^A>)	;No..output module name
	DMOVE	S1,.SACS+S1		;RELOAD ACS THAT WE STEPPED ON
	$TEXT	(STPDEP,< ^I/@.SRSN/>)	;Output reason
	JRST	STOP.4			;Finish up
STOP.1:	DMOVE	S1,.SACS+S1		;RELOAD ACS THAT WE STEPPED ON
	$TEXT	(STPDEP,<^I/STPHDR/^A>)	;OUTPUT STOPCODE HEADER

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

	MOVX	S1,IP.STP		;GET STOPCODE TO ORION FLAG
	TDNN	S1,IIB##+IB.FLG		;CHECK IF SET
	JRST	STOP.4			;NO - ONLY TO TTY, NO AC DUMP
	$TEXT	(STPDEP,<^I/STPACS/^A>)	;DUMP ACS
	MOVE	T1,.SACS+P		;PICK UP PDL POINTER
	$TEXT	(STPDEP,<^I/STPSTK/^A>)	;DUMP LAST FEW STACK LOCATIONS
	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	(< ^W/.SPRGM/ terminated >,<^T/@WTOADR/>,,$WTFLG(WT.NFO))

STOP.4:	SKIPE	S1,WTOADR		;GET MESSAGE ADDRESS
	 PUSHJ	 P,K%SOUT		;DUMP THE DATA
	MOVEI	S1,[ASCIZ/
?Recursion in stopcode handler--Can not continue
/]					;IN CASE WE ARE REALLY SICK
	SKIPE	STPFLG			;FIRST TIME?
	 PUSHJ	P,K%SOUT		;NO--REALLY DEAD
	MOVSI	17,.SACS		;RESTORE THE ACS
	BLT	17,17			;TO THE USER
	PUSHJ	P,I%ION			;TURN ON INTERRUPTS

STPXIT:	$HALT				;Stop without RESET
	JRST	.-1			;Don't allow CONTINUE
; A little routine to output bytes, and advance a pointer
;
STPDEP:	IDPB	S1,WTOPTR		;Just dump the byte
	$RETT				;And return


; ITEXT block for stopcode header
;
STPHDR:	ITEXT	(<
?Stopcode - ^W/.SCODE,LHMASK/ - in module ^W/.SMOD/ on ^H9/[-1]/ on ^C/[-1]/
 Reason: ^I/@.SRSN/
 Program is ^W/.SPRGM/ version ^V/.SPVER/ using GLXLIB version ^V/.SPLIB/
 Crash block starts at location ^O/[.SPC]/
 Last GLXLIB error: ^O/.LGERR,RHMASK/ (^E/.LGERR/)
>)


; ITEXT block for stopcode AC dump
;
STPACS:	ITEXT	(<
 Contents of the ACs:
  0/^O15/.SACS+00/^O15/.SACS+01/^O15/.SACS+02/^O15/.SACS+03/
  4/^O15/.SACS+04/^O15/.SACS+05/^O15/.SACS+06/^O15/.SACS+07/
 10/^O15/.SACS+10/^O15/.SACS+11/^O15/.SACS+12/^O15/.SACS+13/
 14/^O15/.SACS+14/^O15/.SACS+15/^O15/.SACS+16/^O15/.SACS+17/
>)


; ITEXT block for stopcode PDL dump
;
STPSTK:	ITEXT(<
 Last 9 stack locations:
 -1(P)/^O15/-1(T1)/   -2(P)/^O15/-2(T1)/   -3(P)/^O15/-3(T1)/
 -4(P)/^O15/-4(T1)/   -5(P)/^O15/-5(T1)/   -6(P)/^O15/-6(T1)/
 -7(P)/^O15/-7(T1)/   -8(P)/^O15/-8(T1)/   -9(P)/^O15/-9(T1)/
>)
	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
;THIS MODULE SUPPORTS THE NEW GLXLIB STOPCODE PROCESSOR INVOKED
;BY THE "STOPCD" MACRO.  THE MAIN DIFFERENCE BETWEEN THIS STOPCODE
;PROCESSOR AND THE OLD ONE (.STOP) IS .DIE IS COMPLETELY SELF
;CONTAINED.  THIS ALLOWS A CRASH TO BE SAVED INTACT WITHOUT THE
;USE OF THE GLXLIB'S MEMORY MANAGER, IPCF MANAGER, OR TEXT ROUTINES.
;THUS, A CLEAN CRASH MAY BE OBTAINED.
SUBTTL	.DIE -- ENTRY POINT


.DIE::	AOSE	STPFLG			;STOPCODE PROCESSOR LOOPING?
	HALT	.			;YES--STOP IMMEDIATELY
	MOVEM	0,.SACS+0		;SAVE AC 0
	MOVE	0,[1,,.SACS+1]		;SET UP BLT
	BLT	0,.SACS+17		;SAVE ACS 1-16
	MOVE	P,[IOWD STPPSZ,STPPDL]	;SET UP OUR OWN STACK
	PUSHJ	P,PIOFF			;TURN OFF PSI SYSTEM
	MOVEI	T1,<STPTSZ*5>-1		;GET MAXIMUM CHARACTERS IN BUFFER
	MOVEM	T1,STPCNT		;STORE IT
	MOVE	T1,[POINT 7,.STEXT]	;GET BYTE POINTER
	MOVEM	T1,STPPTR		;STORE IT
	MOVE	T1,[.STEXT,,.STEXT+1]	;SET UP BLT
	SETZM	.STEXT			;CLEAR THE FIRST WORD
	BLT	T1,.STEXT+STPTSZ-1	;CLEAR THE WHOLE MESS
	PUSHJ	P,INFO			;GATHER INFORMATION
	MOVE	S1,.SCODE		;GET REASON CODE
	SKIPE	IIB+IB.ERR		;ERROR PROCESSOR?
	PUSHJ	P,@IIB+IB.ERR		;YES..CALL IT
	PORTAL	.+1			;CLEAR PUBLIC, SET CONCEALED
	PUSHJ	P,DDTCHK		;MAKE ANY DDT CHECKS
	PUSHJ	P,BELLS			;MAKE A NOISE
	PUSHJ	P,DIEINF		;PRINT STOPCODE INFO
	PUSHJ	P,DIEPGM		;PRINT PROGRAM INFO
	PUSHJ	P,DIEGLX		;PRINT GLXLIB ERROR INFO
	PUSHJ	P,DIEMON		;PRINT MONITOR ERROR INFO
	PUSHJ	P,DIECRS		;PRINT CRASH FILE INFO
	PUSHJ	P,DIEBLK		;PRINT CRASH BLOCK INFO
	PUSHJ	P,DIETRM		;PRINT TERMINATING INFO
	PUSHJ	P,CRLF			;NEW LINE
	PUSHJ	P,BELLS			;MAKE MORE NOISE
	PUSHJ	P,CRLF			;FINISH OFF TEXT
	PUSHJ	P,SNDOPR		;SEND MESSAGE TO ORION
	PUSHJ	P,TYPE			;TYPE STOPCODE TEXT ON THE TERMINAL
	MOVE	T1,.SACS+P		;GET USER'S PDL POINTER IN T1
	SKIPE	T2,STPCON		;GET CONTINUE ADDRESS (IF ANY)
	MOVEM	T2,(T1)			;STORE AS NEW RETURN ADDRESS
	MOVEM	T1,.SACS+P		;UPDATE POINTER
	PJRST	FINISH			;GO FINISH UP
SUBTTL	.DIE -- GATHER INFORMATION


INFO:	MOVE	P1,.SACS+P		;GET THE USER'S PDL POINTER
	XMOVEI	P1,@0(P1)		;GET THE STOPCODE PC
	MOVEM	P1,.SPC			;STORE IT
	LDB	T1,[POINT 4,(P1),12]	;GET AC FIELD (STOPCODE TYPE)
	MOVEM	T1,.STYPE		;STORE IT
	XMOVEI	P1,@0(P1)		;GET STOPCODE ARGUMENT BLOCK ADDRESS
	HLLZ	T1,0(P1)		;GET STOPCODE MNEMONIC
	MOVEM	T1,.SCODE		;STORE IT
	MOVE	T1,1(P1)		;GET MODULE NAME
	MOVEM	T1,.SMOD		;STORE IT
	SKIPN	T1,2(P1)		;GET CONTINUE ADDRESS
	MOVE	T1,.SPC			;MAKE IT .+1
	MOVEM	T1,STPCON		;STORE IT
	MOVE	T1,3(P1)		;GET ADDRESS OF ASCIZ TEXT
	MOVEM	T1,.SRSN		;STORE IT

TOPS20	<
	SETZM	S.ERR			;INCASE NO ERROR
	SETZM	ERRBUF			;INCASE NO TEXT
	MOVX	S1,.FHSLF		;GET OUR FORK HANDLE
	GETER%				;GET THE LAST JSYS ERROR CODE
	  ERJMP	.+1			;CAN'T
	MOVEM	S2,.SERR		;SAVE IT
	HRROI	S1,@ERRBUF		;POINT TO THE ERROR BUFFER
	HRLI	S2,.FHSLF		;GET OUR FORK HANDLE
	HRLZI	T1,-<ERRBSZ*5>		;MAXIMUM NUMBER OF CHARACTERS
	ERSTR%				;MAP MONITOR ERROR CODE TO TEXT
	  JFCL				;BAD ERROR CODE
	  SETZM	ERRBUF			;INSURE NO JUNK TEXT
> ;END TOPS20

	POPJ	P,			;RETURN
;INITIAL STOPCODE line
DIEINF:	PUSHJ	P,CRLF			;NEW LINE
	MOVEI	T1,[ASCIZ /? Stopcode - /] ;GET INTRODUCTION
	PUSHJ	P,TXTOUT		;STORE TEXT
	MOVE	T1,.SCODE		;GET STOPCODE MNEMONIC
	PUSHJ	P,SIXOUT		;STORE IT
	MOVEI	T1,[ASCIZ / - /]	;GET SEPARATOR
	PUSHJ	P,TXTOUT		;STORE IT
	MOVE	T1,.SRSN		;GET ADDRESS OF STOPCODE TEXT
	PJRST	TXTOUT			;PRINT IT AND RETURN


;PROGRAM INFORMATION
DIEPGM:	PUSHJ	P,CRLF			;NEW LINE
	MOVEI	T1,[ASCIZ /  Program /]	;GET TEXT ADDRESS
	PUSHJ	P,TXTOUT		;PRINT IT
	MOVE	T1,.SPRGM		;GET PROGRAM NAME
	PUSHJ	P,SIXOUT		;PRINT IT
	SKIPE	.SPVER			;HAVE A VERSION?
	PUSHJ	P,SPACE			;OUTPUT A SPACE
	SKIPE	T1,.SPVER		;GET PROGRAM VERSION NUMBER
	PUSHJ	P,VEROUT		;PRINT IT
	MOVEI	T1,[ASCIZ / + GLXLIB /] ;GET SEPARATOR
	PUSHJ	P,TXTOUT		;PRINT IT
	MOVE	T1,.SPLIB		;GET GLXLIB VERSION NUMBER
	PUSHJ	P,VEROUT		;PRINT IT
	MOVEI	T1,[ASCIZ / error at PC /] ;GET ANOTHER SEPARATOR
	PUSHJ	P,TXTOUT		;PRINT IT
	MOVE	T1,.SPC			;GET STOPCODE PC
	PUSHJ	P,PCOUT			;PRINT IT
	MOVEI	T1,[ASCIZ / in module /] ;GET TEXT
	PUSHJ	P,TXTOUT		;PRINT IT
	MOVE	T1,.SMOD		;GET MODULE NAME
	PJRST	SIXOUT			;PRINT IT AND RETURN


;GLXLIB ERROR INFORMATION
DIEGLX:	PUSHJ	P,CRLF			;NEW LINE
	MOVEI	T1,[ASCIZ /  Last GLXLIB error at PC /]
	PUSHJ	P,TXTOUT		;STORE TEXT
	MOVE	T1,.LGEPC		;GET ERROR PC
	PUSHJ	P,PCOUT			;PRINT IT
	MOVEI	T1,[ASCIZ / was /]	;GET SEPARATOR
	PUSHJ	P,TXTOUT		;PRINT IT
	MOVE	T1,.LGERR		;GET THE ERROR CODE
	PUSHJ	P,OCTOUT		;PRINT IT
	MOVEI	T1,[ASCIZ /; /]		;GET ANOTHER SEPARATOR
	PUSHJ	P,TXTOUT		;PRINT IT
	MOVE	T1,.LGERR		;GET THE CODE AGAIN
	MOVE	T1,GLXERR##(T1)		;GET ADDRESS OF ERROR TEXT
	PJRST	TXTOUT			;PRINT IT AND RETURN


;UUO OR JSYS ERROR INFORMATION
DIEMON:
TOPS10	<POPJ	P,>			;RETURN
TOPS20	<
	SKIPN	S.ERR			;HAVE AN ERROR?
	POPJ	P,			;NO
	PUSHJ	P,CRLF			;NEW LINE
	MOVEI	T1,[ASCIZ /  Last JSYS error was /]
	PUSHJ	P,TXTOUT		;PRINT IT
	MOVE	T1,.SERR		;GET THE ERROR CODE
	PUSHJ	P,OCTOUT		;PRINT IT
	SKIPN	ERRBUF			;HAVE TEXT?
	POPJ	P,			;NO
	MOVEI	T1,[ASCIZ /; /]		;GET SEPARATOR
	PUSHJ	P,TXTOUT		;PRINT IT
	MOVEI	T1,ERRBUF		;POINT TO ERROR BUFFER
	PJRST	TXTOUT			;PRINT IT AND RETURN
> ;END TOPS20


;CRASH FILE INFORMATION
DIECRS:	MOVE	T1,.STYPE		;GET STOPCODE TYPE
	CAIN	T1,2			;DEBUG?
	POPJ	P,			;YES--THEN NO CRASH FILE INFO
	MOVE	T1,IIB+IB.FLG		;Get the flag word
	TXNE	T1,IB.SAV		;Is the SAVE bit on?
	POPJ	P,			;No, don't do the save

	MOVSI	T1,'XPN'		;Move the sixbit device name
	MOVEM	T1,SAVBLK+.RNDEV	; to the SAVE. UUO block
	MOVE	T1,.SPRGM		;Get 3 character program code
	HLR	T1,.SCODE		; and the 3 character stopcode
	MOVEM	T1,SAVBLK+.RNNAM	;And use it as the file spec
	SETZM	SAVBLK+.RNEXT
	SETZM	SAVBLK+3
	SETZM	SAVBLK+.RNPPN
	SETZM	SAVBLK+.RNMEM
	MOVEI	T1,SAVBLK		;Pointer to the SAVE. block
	MOVEM	P,STPSVP		;Save P so the SAVE. doesn't smash it
	SAVE.	T1,			;Save the program
	  JRST	SAVERR			;Error
	MOVE	P,STPSVP		;Restore P
	POPJ	P,			;Return

SAVERR:	MOVE	P,STPSVP		;Restore P
	PUSH	P,T1			;Save error code
	PUSHJ	P,CRLF			;New line
	MOVEI	T1,[ASCIZ /  SAVE. UUO Failed, Error code /]
	PUSHJ	P,TXTOUT
	POP	P,T4			;Restore the error code
	HRRZ	T1,T4			;Get it ready to output
	PUSHJ	P,OCTOUT		;And output it
	POPJ	P,			;Return



;CRASH BLOCK INFORMATION
DIEBLK:	PUSHJ	P,CRLF			;NEW LINE
	MOVEI	T1,[ASCIZ /  Crash block begins at /]
	PUSHJ	P,TXTOUT		;PRINT IT
	XMOVEI	T1,.SBLK		;POINT TO START OF CRASH BLOCK
	PJRST	PCOUT			;PRINT PC AND RETURN


;TERMINATING INFO
DIETRM:	PUSHJ	P,CRLF			;NEW LINE
	PUSHJ	P,SPACE			;PRINT A SPACE
	PUSHJ	P,SPACE			;AGAIN
	MOVE	T1,.STYPE		;GET STOPCODE TYPE
	MOVE	T1,TYPTAB(T1)		;GET ADDRESS OF TERMINATION TEXT
	PJRST	TXTOUT			;PRINT IT AND RETURN


TYPTAB:	[ASCIZ	/[Stopping program]/]	;HALT
	[ASCIZ	/[Continuing program]/]	;CONT
	[ASCIZ	/[Entering DDT]/]	;DEBUG
SUBTTL	.DIE -- SEND TO OPERATOR


SNDOPR:	MOVX	T1,IP.STP		;BIT TO TEST
	TDNE	T1,IIB##+IB.FLG		;SEND STOPCODES TO ORION?
	SKIPE	DEBUGW			;YES, BUT ARE WE DEBUGGING?
	POPJ	P,			;DON'T BOTHER THE OPERATOR

TOPS10	<
	MOVE	T1,[QUELEN,,QUEBLK]	;POINT TO BLOCK
	QUEUE.	T1,			;WRITE TO OPR
	  JFCL				;IGNORE ERRORS
> ;END TOPS10

TOPS20	<
	MOVEI	S1,QUELEN		;GET BLOCK LENGTH
	MOVEI	S2,QUEBLK		;GET BLOCK ADDRESS
	QUEUE%				;WRITE TO OPR
	  ERJMP	.+1			;IGNORE ERRORS
> ;END TOPS20

	POPJ	P,			;RETURN

QUEBLK:	$BUILD	(.QUARV+3)		;LENGTH OF UUO ARGUMENT BLOCK
	  $SET	(.QUFNC,QF.FNC,.QUWTO)	;WRITE TO OPR FUNCTION
;	  $SET	(.QUFNC,QF.NBR,1)	;NON-BLOCKING
;	  $SET	(.QUFNC,QF.PIP,1)	;PRIVILEGED JOB INVOKING PRIVS
	  $SET	(.QUNOD,FWMASK,0)	;SEND TO CENTRAL STATION
	  $SET	(.QURSP,FWMASK,0)	;NO RESPONSE BLOCK

	  $SET	(.QUARG,QA.LEN,TYPLEN)	;TYPE BLOCK LENGTH
	  $SET	(.QUARG,QA.TYP,.QBTYP)	;TYPE BLOCK CODE
	  $SET	(.QUARV,FWMASK,TYPTXT)	;TYPE BLOCK ADDRESS

	  $SET	(.QUARG+2,QA.LEN,STPTSZ);MESSAGE BLOCK LENGTH
	  $SET	(.QUARG+2,QA.TYP,.QBMSG);MESSAGE BLOCK CODE
	  $SET	(.QUARV+2,FWMASK,.STEXT);MESSAGE BLOCK ADDRESS
	$EOB				;END OF BLOCK
QUELEN==.-QUEBLK			;LENGTH OF BLOCK

TYPTXT:	ASCIZ	/ Program error /
TYPLEN==.-TYPTXT			;LENGTH OF TYPE TEXT
SUBTTL	.DIE -- TEXT ROUTINES



;ASCIZ TEXT
TXTOUT:	TLO	T1,(POINT 7,)		;MAKE A BYTE POINTER
	MOVE	T2,T1			;PUT IN A SAFER PLACE
TXTO.1:	ILDB	T1,T2			;GET A CHARACTER
	JUMPE	T1,CPOPJ		;STOP ON A NULL
	PUSHJ	P,TYO			;STORE IT
	JRST	TXTO.1			;LOOP THROUGH STRING


;SIXBIT WORD
SIXOUT:	SKIPN	T2,T1			;PUT IN A BETTER PLACE
	POPJ	P,			;NOTHING THERE
SIXO.1:	LSHC	T1,6			;SHIFT IN A CHARACTER
	ANDI	T1,77			;STRIP OFF JUNK
	ADDI	T1," "			;MAKE IT ASCII
	PUSHJ	P,TYO			;STORE IT
	JUMPN	T2,SIXO.1		;LOOP THROUGH WORD
	POPJ	P,			;RETURN


;OCTAL WORD
OCTOUT:	IDIVI	T1,10			;DIVIDE BY RADIX
	PUSH	P,T2			;SAVE REMAINDER
	SKIPE	T1			;DONE?
	PUSHJ	P,OCTOUT		;NO--RECURSE
	POP	P,T1			;GET A DIGIT
	ADDI	T1,"0"			;MAKE IT ASCII
;	PJRST	TYO			;STORE IT AND RETURN


;CHARACTER OUTPUT
TYO:	SOSLE	STPCNT			;COUNT CHARACTERS
	IDPB	T1,STPPTR		;STORE BYTE
CPOPJ:	POPJ	P,			;RETURN
;PC OUTPUT
PCOUT:	PUSH	P,T1			;SAVE PC
	TLNN	T1,-1			;NON-ZERO SECTION?
	JRST	PCOU.1			;NO
	HLRZS	T1			;GET SECTION NUMBER
	PUSHJ	P,OCTOUT		;PRINT IT
	MOVEI	T1,","			;GET A COMMA
	PUSHJ	P,TYO			;PRINT IT
	PUSHJ	P,TYO			;AGAIN
PCOU.1:	POP	P,T2			;GET PC BACK
	HRLZS	T2			;PUT SECTION RELATIVE PC IN LH
	MOVEI	T3,6			;GET A COUNTER
PCOU.2:	LSHC	T1,3			;SHIFT IN A DIGIT
	ANDI	T1,7			;NO JUNK
	ADDI	T1,"0"			;MAKE IT ASCII
	PUSHJ	P,TYO			;PRINT IT
	SOJG	T3,PCOU.2		;LOOP
	POPJ	P,			;RETURN


;VERSION NUMBER OUTPUT
VEROUT:	MOVE	T4,T1			;PUT IN A SAFER PLACE
	LDB	T1,[POINT 9,T4,11]	;GET MAJOR VERSION NUMBER
	SKIPE	T1			;WEED OUT ZEROS
	PUSHJ	P,OCTOUT		;OUTPUT IT
	LDB	T1,[POINT 6,T4,17]	;GET MINOR VERSION NUMBER
	JUMPE	T1,VERO.2		;DON'T OUTPUT ZEROS
	SOS	T1			;PRINT IN MODIFIED
	IDIVI	T1,^D26			;RADIX 26 ALPHA
	JUMPE	T1,VERO.1		;ONLY 1 CHARACTER?
	MOVEI	T1,"A"-1(T1)		;GET FIRST CHARACTER
	PUSHJ	P,TYO			;PRINT IT
VERO.1:	MOVEI	T1,"A"(T2)		;GET SECOND CHARACTER
	PUSHJ	P,TYO			;PRINT IT
VERO.2:	HRRZ	T1,T4			;GET EDIT NUMBER
	JUMPE	T1,VERO.3		;NO ZEROS
	MOVEI	T1,"("			;GET OPENING PARENTHESIS
	PUSHJ	P,TYO			;PRINT IT
	HRRZ	T1,T4			;GET EDIT NUMBER
	PUSHJ	P,OCTOUT		;PRINT IT
	MOVEI	T1,")"			;GET CLOSING PARENTHESIS
	PUSHJ	P,TYO			;PRINT IT
VERO.3:	LDB	T2,[POINT 3,T4,2] 	;GET "WHO" FIELD
	JUMPE	T2,CPOPJ		;DON'T PRINT ZEROS
	MOVEI	T1,"-"			;GET STANDARD DELIMITER
	PUSHJ	P,TYO			;PRINT IT
	MOVE	T1,T2			;GET WHO FIELD AGAIN
	PJRST	OCTOUT			;PRINT IT AND RETURN
;CRLF
CRLF:	MOVEI	T1,[BYTE(7).CHCRT,.CHLFD,0] ;GET ADDRESS OF TEXT
	PJRST	TXTOUT			;PRINT IT AND RETURN


;BELLS
BELLS:	MOVEI	T1,[BYTE(7).CHBEL,.CHBEL,.CHBEL,.CHBEL,0] ;GET TEXT ADDRESS
	PJRST	TXTOUT			;PRINT IT AND RETURN


;Space
SPACE:	MOVEI	T1," "			;GET A SPACE
	PJRST	TYO			;PRINT IT AND RETURN


;TYPE OUT STOPCODE TEXT
TYPE:
TOPS10	<OUTSTR	.STEXT>			;PRINT TOPS-10 STYLE
TOPS20	<
	HRROI	S1,.STEXT		;PRINT
	PSOUT%				; TOPS-20 STYLE
> ;END TOPS20
	POPJ	P,			;RETURN
SUBTTL	.DIE -- DDT CHECKING


;CHECK FOR THE EXISTANCE OF DDT
DDTCHK:	MOVE	T1,.STYPE		;GET STOPCODE TYPE
	CAIE	T1,2			;DEBUG STOPCODE?
	POPJ	P,			;NO
	MOVSI	T2,[PUSH P,.SPC		;PUT RETURN ADDRESS ON STACK
		    JSR  @.-.		;ENTER VIA UNSOLICITED BREAKPOINT
		    POPJ P,]		;RETURN
	HRRI	T2,BPTCOD		;MAKE A BLT POINTER
	BLT	T2,BPTCOD+2		;COPY

TOPS10	<
	SKIPE	T2,.JBBPT		;UNSOLICITED BREAKPOINT AVAILABLE?
	HRRM	T2,BPTCOD+1		;SAVE ENTRY POINT
	SKIPE	T2			;$0BPT AVAILABLE?
	SKIPA	T2,.JBDDT##		;NO--DDT AVAILABLE AT ALL?
	MOVEI	T2,BPTCOD		;USE UNSOLICITED BREAKPOINT
> ;END TOPS10

TOPS20	<
*** SHOULD TRY TO READ DDT PDV FOR UNSOLICITED BREAKPONT STUFF ***
	MOVEI	T2,DDTADR		;GET DDT START ADDRESS
	MOVE	S1,T2			;COPY IT
	ADR2PG				;CONVERT TO A PAGE NUMBER
	HRLI	S1,.FHSLF		;GET OUR FORK HANDLE
	RPACS%				;READ PAGE ACCESSABILITY BITS
	  ERJMP	.+2			;CAN'T--ASSUME NOT THERE
	TXNN	S2,PA%PEX		;PAGE EXIST?
	MOVEI	T2,0			;NO
> ;END TOPS20

DDTC.1:	SKIPN	T2			;DDT AVAILABLE?
	SETZB	T1,T2			;NO
	MOVEM	T1,.STYPE		;UPDATE STOPCODE TYPE
	HRRM	T2,STPCON		;SET DDT ADDRESS AS CONTINUE ADDRESS
	SKIPN	T2			;DDT AVAILABLE?
	POPJ	P,			;RETURN
SUBTTL	.DIE -- FINISH AND EXIT


FINISH:	SKIPN	.STYPE			;WANT TO HALT JOB?
	$HALT				;EXIT WITHOUT RESET
	MOVSI	17,.SACS		;SET UP BLT
	BLT	17,17			;RELOAD THE ACS
	PUSHJ	P,PION			;TURN ON PSI SYSTEM
	SETOM	STPFLG			;CLEAR STOPCODE FLAG
	POPJ	P,			;RETURN TO THE USER
SUBTTL	.DIE -- PSI SUBROUTINES


;TURN OFF PSI SYSTEM
PIOFF:
TOPS10	<
	MOVX	T1,PS.FOF		;FLAG TO TURN OFF SYSTEM
	PISYS.	T1,			;DO IT
	  TDZA	T1,T1			;NOT TURNED ON
	MOVX	T1,-1			;REMEMBER TURNED ON
	MOVEM	T1,PIUSE		;SAVE FOR LATER
	POPJ	P,			;RETURN
> ;END TOPS10
TOPS20	<
	MOVX	S1,.FHSLF		;GET OUR FORK HANDLE
	DIR%				;DISABLE INTERRUPTS
	  ERJMP	.+2			;NOT TURNED ON
	SKIPA	T1,[-1]			;REMEMBER TURNED ON
	MOVEI	T1,0			;TURNED OFF
	MOVEM	T1,PIUSE		;SAVE FOR LATER
	POPJ	P,			;RETURN
> ;END TOPS20


;TURN ON PSI SYSTEM
PION:	SKIPN	PIUSE			;WAS PSI SYSTEM IN USE?
	POPJ	P,			;NO--JUST RETURN
TOPS10	<
	MOVX	T1,PS.FOF		;GET FLAG TO TURN SYSTEM ON
	PISYS.	T1,			;DO IT
	  HALT	.			;CAN'T
	POPJ	P,			;RETURN
> ;END TOPS10
TOPS20	<
	MOVX	S1,.FHSLF		;GET OUR FORK HANDLE
	EIR%				;ENABLE INTERRUPT SYSTEM
	  ERJMP	.+2			;CAN'T
	POPJ	P,			;RETURN
	HALT	.			;STOP NOW
> ;END TOPS20
SUBTTL	End


COM%L:	END