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