Google
 

Trailing-Edge - PDP-10 Archives - bb-lw55a-bm - galaxy-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	Preliminaries

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
;	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 THAT IS NOT SUPPLIED BY DIGITAL.

	SEARCH	GLXMAC		;PARAMETER FILE
	PROLOG(GLXCOM,COM)	;GENERATE PROLOG CODE
	SEARCH	ORNMAC		;For support of $WTO in stopcd processing
	SUBTTL	Source vector for GLXLIB

	COMMAN==:0			;Maintenance edit number
	COMDEV==:102			;Development edit number
	VERSIN (COM)			;Generate module edit number


	GLXVER==6			;MAJOR LIBRARY VERSION NUMBER
	GLXMIN==0			;MINOR LIBRARY VERSION NUMBER
	GLXWHO==0			;CUSTOMER VERSION

;Generate vector for REL version

	GLXVRS==:<BYTE(3)GLXWHO(9)GLXVER(6)GLXMIN>

IFN GLXPURE,<

;Generate vectors for EXE version

GLXVEC:	BLDVEC	(GLXCOM,COM,L)
	BLDVEC	(GLXFIL,FIL)
	BLDVEC	(GLXINI,INI)
	BLDVEC	(GLXINT,INT)
	BLDVEC	(GLXIPC,IPC)
	BLDVEC	(GLXKBD,KBD)
	BLDVEC	(GLXLNK,LNK)
	BLDVEC	(GLXMAC,GMC,L)
	BLDVEC	(GLXMEM,MEM)
	BLDVEC	(GLXOTS,OTS)
	BLDVEC	(GLXSCN,SCN)
	BLDVEC	(GLXTXT,TXT)

	EXTERNAL GMCEDT,FILEDT,INIEDT,EXSYM1,EXSYM2
	GLXEDT==:COMEDT+FILEDT+INIEDT+GMCEDT+EXSYM1+EXSYM2
	GLXVRS==:GLXVRS+GLXEDT

	LOC 137
	GLXVRS
	RELOC

> ; End of IFN GLXPURE
	Subttl	Table of Contents

;		     Table of Contents for GLXCOM
;
;				  Section		      Page
;
;
;    1. Source vector for GLXLIB . . . . . . . . . . . . . . .   2
;    2. Revision History . . . . . . . . . . . . . . . . . . .   4
;    3. Entry points found in GLXCOM . . . . . . . . . . . . .   5
;    4. Global Storage . . . . . . . . . . . . . . . . . . . .   6
;    5. .INIT - Initialize the common code . . . . . . . . . .   7
;    6. .ZPAGA - .ZPAGN - .ZCHNK - Zero out memory . . . . . .   8
;    7. .SAVEx routines - save permanent ACs . . . . . . . . .   9
;    8. .SAVE8 and .SAVET Routines . . . . . . . . . . . . . .  10
;    9. .SVxx - Routines for saving random ACS . . . . . . . .  11
;   10. .POPJ, .POPJ1, .RETE,.RETT & .RETF - Common return rou  12
;   11. .AOS, .SOS and .ZERO - Support for INCR,DECR, ZERO . .  13
;   12. STKVAR SUPPORT CODE  . . . . . . . . . . . . . . . . .  14
;   13. TRVAR SUPPORT CODE . . . . . . . . . . . . . . . . . .  15
;   14. Time conversion routines - .SC2UD  . . . . . . . . . .  16
;   15. Determine CPU type . . . . . . . . . . . . . . . . . .  17
;   16. STOP CODE Processor  . . . . . . . . . . . . . . . . .  18
;   17. SAVCRS - Save Crash on Stopcodes . . . . . . . . . . .  21
SUBTTL Revision History

COMMENT \

54	4.2.1528	
	Fix Copyright.

55	4.2.1528
	More of Edit 54.

*****  Release 4.2 -- begin maintenance edits  *****

*****  Release 5.0 -- begin development edits  *****

60	5.1002		28-Dec-82
	Move to new development area.  Remove need for GLXVER.  Add version
vector.  Clean up edit organization.  Update TOC.

61	5.1093		13-Feb-84
	Move the GLXLIB version number, GLXVRS, from GLXMAC to here. Also,
move the major, minor and customer version numbers over from GLXMAC to here.

62      5.1119		19-Mar-84
	Split the calculation of GLXVRS so that MACRO can handle it without a
PTC error.

63	5.1132		9-Apr-84
	Modify edit 62 by calculating GLXVRS among three modules: GLXCOM,
GLXTXT and GLXMEM.

64	5.1133		9-APR-84
	Place the value of GLXVRS into location 137.

65	5.1134		10-Apr-84
	Define GLXVRS outside the IFN GLXPURE conditional.

66	5.1136		13-Apr-84
	DEfine GLXVRS for both REL and EXE versions.

*****	Release 5.0 -- begin maintenance edits	*****
70	Increment maintenance edit level for version 5 of GALAXY.

*****	Release 6.0 -- begin development edits	*****

100	6.1037		26-Oct-87
	Move sources from G5: to G6:

101	6.1057		4-Nov-87
	Change PS: to BS: and PS:[SPOOL] to SPOOL: for Non PS: login feature.

102	6.1225		8-Mar-88
	Update copyright notice.

\  ;End of Revision History
	SUBTTL	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 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/SPOOL:/			;[101]
>;END TOPS20

COM%L:
	END