Trailing-Edge
-
PDP-10 Archives
-
tops10_703a_sys_atpch16_bb-fr67f-bb
-
glxcom.x16
There are 2 other files named glxcom.x16 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/CTK 25-Sep-83
;
;
; 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==57 ;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 Change $STOP to STOPCD.
GCO 10462 14-Nov-86/BAH
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 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
POPJ P, ;*** NOT YET
PUSHJ P,CRLF ;NEW LINE
MOVEI T1,[ASCIZ / Crash saved in /]
PUSHJ P,TXTOUT ;PRINT IT
;*** SAVE CRASH ***
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: SKIPE DEBUGW ;DEBUGGING?
POPJ P, ;YES--THEN 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