Google
 

Trailing-Edge - PDP-10 Archives - BB-4172H-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/DPM/NT 1-Jan-82

;

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

ASCIZ/
        COPYRIGHT (C) 1975,1976,1977,1978,1979,1980,1981,1982
                    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.


	COMEDT==55		;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	;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

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.

0054			Fix Copyright.  GCO 4.2.1528

0055			More of Edit 0054.  GCO 4.2.1528

End of Revision History
\
SUBTTL Global Storage


; GLOBAL CRASH INFORMATION

	$DATA	COMBEG,0		;START OF ZEROABLE $DATA SPACE
	$GDATA	.SPC			;PC OF STOP
	$GDATA	.SCODE			;SIXBIT CODE OF STOP CODE
	$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			;PROCESSING A STOPCODE FLAG
	STPPSZ==60			;STOPCODE PDL SIZE
	$DATA	STPPDL,STPPSZ		;STOPCODE PDL

	$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
	$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
	SETZM	S1,COMBEG		;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?
	$STOP	(AZA,<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
	MOVEI	P3,1			;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

COM%L:
	END