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