Google
 

Trailing-Edge - PDP-10 Archives - BB-M080H-SM - monitor-sources/aprsrv.mac
There are 54 other files named aprsrv.mac in the archive. Click here to see a list.
;Edit 3200 to APRSRV.MAC by LOMARTIRE on Fri 11-Jan-85, for SPR #20429
;		Prevent ILLUUO from bad byte pointer to GTJFN
;Edit 3069 to APRSRV.MAC by HAUDEL on Mon 23-Jan-84 - ADD MCA25 SUPPORT
;Edit 3063 to APRSRV.MAC by MCLEAN on Thu 19-Jan-84, for SPR #19836
;		stack too small for extended status
;Edit 3063 - prevent MONPDL bughlts when KLSTAT is on.
;Edit 2969 to APRSRV.MAC by LOMARTIRE on Thu 9-Jun-83, for SPR #19223
;		Allow system to continue after a power fail
;Edit 2968 to APRSRV.MAC by LOMARTIRE on Tue 7-Jun-83, for SPR #19162
;		Allow system to continue after spurious power fail
;EDIT 2905 - Prevent ILLUUOs at KIMXCR
; UPD ID= 249, FARK:<5-1-WORKING-SOURCES.MONITOR>APRSRV.MAC.6,   8-Dec-82 13:45:39 by MOSER
;EDIT 2873 - MORE OF 2819
; UPD ID= 192, FARK:<5-1-WORKING-SOURCES.MONITOR>APRSRV.MAC.5,  27-Oct-82 15:44:34 by COBB
;EDIT 2850 - Handle 20 ms scheduler p-faults correctly
; UPD ID= 178, FARK:<5-1-WORKING-SOURCES.MONITOR>APRSRV.MAC.4,  25-Oct-82 20:35:42 by COBB
;EDIT 2839 - Make KIMXCT more paranoid about byte pointers
; UPD ID= 137, FARK:<5-1-WORKING-SOURCES.MONITOR>APRSRV.MAC.3,  27-Sep-82 13:18:03 by MOSER
;EDIT 2819 - PREVENT CRASHES BY MOVING MCENTR IN GFLT0:
; UPD ID= 571, SNARK:<5.MONITOR>APRSRV.MAC.57,   7-Apr-82 16:58:10 by PAETZOLD
;TCO 5.1773 - Add IFIWs to GFLTD
; UPD ID= 553, SNARK:<5.MONITOR>APRSRV.MAC.56,  19-Mar-82 15:47:33 by PAETZOLD
;TCO 5.1764 - Make PFCODT a full word table and make PFAID not reference
; bad sections.
; UPD ID= 519, SNARK:<5.MONITOR>APRSRV.MAC.55,   7-Mar-82 18:52:30 by MILLER
;TCO 5.1487 again. Fix MBERRB
; UPD ID= 492, SNARK:<5.MONITOR>APRSRV.MAC.54,   2-Mar-82 17:14:37 by MILLER
;MORE TCO.5.1735. Fix up analysis to use IOP word correctly
; UPD ID= 484, SNARK:<5.MONITOR>APRSRV.MAC.53,  24-Feb-82 12:17:20 by PAETZOLD
;TCO 5.1735 - Change IO Page Fail code to reflect fact that IOP word
; now gets saved in ACB7 AC2 and not the PFW
; UPD ID= 472, SNARK:<5.MONITOR>APRSRV.MAC.52,  11-Feb-82 16:54:38 by MILLER
;TCO 5.1728. Make sure stack is valid for non-vector PI routines.
;Make sure non-vector PI routines have a stack.
; UPD ID= 467, SNARK:<5.MONITOR>APRSRV.MAC.51,   8-Feb-82 11:05:47 by PAETZOLD
;More TCO 5.1672 - also turn on TRAP1 during overflow in GFLOAT
; UPD ID= 445, SNARK:<5.MONITOR>APRSRV.MAC.50,  27-Jan-82 10:45:29 by PAETZOLD
;TCO 5.1705 - Save BGCCHK and BGCINF calling adrs in BUGCHK and BUGINF
; UPD ID= 434, SNARK:<5.MONITOR>APRSRV.MAC.49,  22-Jan-82 15:18:03 by PAETZOLD
;TCO 5.1672 Simulate GFIX, GFIXR, DGFIX, and DGFIXR for users
; UPD ID= 389, SNARK:<5.MONITOR>APRSRV.MAC.48,  10-Jan-82 12:50:24 by MILLER
;FIX UP CODE TO BE MORE EFFICIENT
; UPD ID= 387, SNARK:<5.MONITOR>APRSRV.MAC.47,   9-Jan-82 18:31:05 by MILLER
;TCO 5.1661. ADD CODE TO UNLATCH CONTROLLERS AFTER TGHA RUNS
; UPD ID= 377, SNARK:<5.MONITOR>APRSRV.MAC.46,   5-Jan-82 10:58:02 by MILLER
;TCO 5.1652. Open code CHKINT macro at power fail interrupt
;Remove TCO 5.1505 for now
;ADD SOME IFN KLFLG CONDITIONALS FOR THE KS
;More clean ups for type out
; UPD ID= 232, SNARK:<5.MONITOR>APRSRV.MAC.41,  29-Sep-81 11:49:02 by MILLER
; More TCO 5.1487. Clean up type out
; UPD ID= 223, SNARK:<5.MONITOR>APRSRV.MAC.40,  29-Sep-81 08:27:41 by PAETZOLD
;More TCO 5.1531 - MAKE DOCUMENTATION TO TCO 5.1531 A LITTLE BETTER
; UPD ID= 217, SNARK:<5.MONITOR>APRSRV.MAC.39,  25-Sep-81 13:56:09 by PAETZOLD
; UPD ID= 216, SNARK:<5.MONITOR>APRSRV.MAC.38,  24-Sep-81 22:44:53 by PAETZOLD
;TCO 5.1531 - Check for ILLUUO's caused by PXCT of byte instruction with
; bad pointer
; UPD ID= 171, SNARK:<5.MONITOR>APRSRV.MAC.37,  14-Sep-81 13:16:22 by MURPHY
;TCO 5.1505 - IN MPE PAGE FAULT, ZERO THE BAD WORD IN MEMORY.
;FIX TYPEO  IN LAST EDIT
; UPD ID= 146, SNARK:<5.MONITOR>APRSRV.MAC.35,   3-Sep-81 15:04:36 by MILLER
; UPD ID= 144, SNARK:<5.MONITOR>APRSRV.MAC.34,   3-Sep-81 12:40:59 by MILLER
;TCO 5.1487. FIX PARITY ERROR CODE
; UPD ID= 113, SNARK:<5.MONITOR>APRSRV.MAC.33,  21-Aug-81 16:12:42 by PAETZOLD
;TCO 5.1008X - ADD SPCSNZ ROUTINE
; UPD ID= 71, SNARK:<5.MONITOR>APRSRV.MAC.32,  24-Jul-81 05:19:09 by PAETZOLD
;TCO 5.1380 - Add call to IMPFPF in APRIOP to see if AN20 caused IOPGF
; UPD ID= 41, SNARK:<5.MONITOR>APRSRV.MAC.31,  17-Jul-81 14:15:25 by PAETZOLD
;Fix typo in previous edit
; UPD ID= 40, SNARK:<5.MONITOR>APRSRV.MAC.30,  17-Jul-81 13:50:28 by PAETZOLD
;TCO 5.1380 - increase size of MEMPP stack
; UPD ID= 2122, SNARK:<5.MONITOR>APRSRV.MAC.29,   3-Jun-81 17:04:46 by PAETZOLD
;MORE OF TCO 5.1318 ADD BAD DATA WORD TO UPTMPE AND EPTMPE BUGHLT'S
; UPD ID= 1975, SNARK:<5.MONITOR>APRSRV.MAC.28,  11-May-81 11:40:03 by PAETZOLD
;FIX TYPO IN PREVIOUS EDIT
; UPD ID= 1971, SNARK:<5.MONITOR>APRSRV.MAC.27,  11-May-81 10:05:02 by PAETZOLD
;TCO 5.1318 DETECT PARITY ERRORS FOR EPT AND UPT RELATIVE ADDRESSING
; UPD ID= 1882, SNARK:<5.MONITOR>APRSRV.MAC.26,  24-Apr-81 09:07:59 by GRANT
;Fix typo in previous edit
; UPD ID= 1880, SNARK:<5.MONITOR>APRSRV.MAC.24,  23-Apr-81 17:52:30 by LYONS
;FIX AN20 ABILITY TO HANG SYSTEM
; UPD ID= 1854, SNARK:<5.MONITOR>APRSRV.MAC.23,  21-Apr-81 07:02:21 by WACHS
;TCO 5.1289 RETURN DIAG RESOURCES ON A BUGCHK
; UPD ID= 1775, SNARK:<5.MONITOR>APRSRV.MAC.22,  27-Mar-81 13:30:28 by MURPHY
;FIX .ENTER FOR NEW BLSUB. MACRO
; UPD ID= 1764, SNARK:<5.MONITOR>APRSRV.MAC.21,  24-Mar-81 16:36:44 by MURPHY
;DITTO
; UPD ID= 1757, SNARK:<5.MONITOR>APRSRV.MAC.20,  23-Mar-81 16:29:15 by MURPHY
;Make BUGCHK and BUGINF called with PUSHJ
; UPD ID= 1705, SNARK:<5.MONITOR>APRSRV.MAC.19,  16-Mar-81 11:42:07 by MURPHY
;MOVE ENTSKD TO SCHED
; UPD ID= 1631, SNARK:<5.MONITOR>APRSRV.MAC.18,   2-Mar-81 16:26:48 by MURPHY
;NEW EXT ADR ENTER/LEAVE ROUTINES
; UPD ID= 1505, SNARK:<5.MONITOR>APRSRV.MAC.17,  27-Jan-81 16:54:04 by HALL
;Miscellaneous cleanup and comments
; UPD ID= 1494, SNARK:<5.MONITOR>APRSRV.MAC.16,  26-Jan-81 12:35:08 by HALL
;Clean up conditionals, add comments. Put MEMPJ0 under Kl conditional.
; UPD ID= 1482, SNARK:<5.MONITOR>APRSRV.MAC.15,  23-Jan-81 09:09:05 by HALL
;Change IFE SMFLG to IFN KLFLG
; UPD ID= 1268, SNARK:<5.MONITOR>APRSRV.MAC.14,  12-Nov-80 16:27:00 by DONAHUE
;TCO 5.1196 - REMOVE SAVET MACRO IN GENBLK
; UPD ID= 1195, SNARK:<5.MONITOR>APRSRV.MAC.13,  25-Oct-80 12:14:54 by HALL
;TCO 5.1180 - MOVE THE DST INTO NON-ZERO SECTION
;	FKSETK - MAKE UPTPFN INCLUDE SECTION 1 SO PAGE FAULT HANDLER
;	RUNS IN SECTION 1
; UPD ID= 1182, SNARK:<5.MONITOR>APRSRV.MAC.12,  20-Oct-80 17:59:16 by MURPHY
;BLSUBR SUPPORT CODE
; UPD ID= 1148, SNARK:<5.MONITOR>APRSRV.MAC.11,  10-Oct-80 14:45:41 by MURPHY
;SASUBR SUPPORT CODE
; UPD ID= 1082, SNARK:<5.MONITOR>APRSRV.MAC.10,   1-Oct-80 11:54:58 by MURPHY
;FIX ACVAR
;NEW SAVEAC SUPPORT ROUTINES
;MAKE STKVAR AND TRVAR GET REAL TRAP ON STACK OVERFLOW
; UPD ID= 1035, SNARK:<5.MONITOR>APRSRV.MAC.9,  23-Sep-80 15:21:44 by HALL
;FIX BUGM0 AND BUGP0 ON KS -- FORGOT TO TAKE OUT THE ZERO WHEN MOVING
; BUGMON AND BUGPRI TO RSDAT PSECT
; UPD ID= 1002, SNARK:<5.MONITOR>APRSRV.MAC.8,  11-Sep-80 17:57:35 by GRANT
;Change MONX01 to MONX05 in GENGEN routine
; UPD ID= 785, SNARK:<5.MONITOR>APRSRV.MAC.7,  23-Jul-80 12:26:44 by HALL
;CLEAN UP COMMENTS ON SECONDARY PROTOCOL OUTPUT ROUTINES
; UPD ID= 687, SNARK:<5.MONITOR>APRSRV.MAC.6,  24-Jun-80 09:50:50 by MURPHY
;NOW MAKE SECALL, SECALE WORK AGAIN
; UPD ID= 652, SNARK:<5.MONITOR>APRSRV.MAC.5,  16-Jun-80 16:00:54 by MURPHY
;MAKE SECALL, SECALE FASTER
; UPD ID= 464, SNARK:<5.MONITOR>APRSRV.MAC.4,  23-Apr-80 13:22:03 by MURPHY
;ALLOW DDT BREAKPOINT WHEN MONITOR WRITE PROTECTED
; UPD ID= 420, SNARK:<5.MONITOR>APRSRV.MAC.3,   8-Apr-80 15:30:37 by HALL
;CHANGED BUGMON AND BUGPRI FOR KS MONITOR (MORE OF PRECEDING EDIT)
; UPD ID= 406, SNARK:<5.MONITOR>APRSRV.MAC.2,   3-Apr-80 16:12:26 by HALL
;CHANGES TO WRITE-PROTECT THE RESIDENT MONITOR:
;	MOVE DEFINITION OF CONOPG TO STG
;	MAKE CASHF BE AN RS
;	MAKE BUG-HANDLING CODE AVOID BREAKPOINT IF MONITOR IS WRITE-PROTECTED
;	TAKE OUT JSR LOCATIONS
; UPD ID= 335, SNARK:<4.1.MONITOR>APRSRV.MAC.264,  14-Mar-80 11:42:52 by HALL
;GET THE NAME FOR FATCDP RIGHT THIS TIME
; UPD ID= 333, SNARK:<4.1.MONITOR>APRSRV.MAC.263,  14-Mar-80 11:04:04 by HALL
;PUT NAMES IN OPTIONAL DATA FOR IOPGF AND FATCDP
; UPD ID= 254, SNARK:<4.1.MONITOR>APRSRV.MAC.262,   7-Feb-80 17:18:52 by HALL
;put names in optional data for bug ilpsec
; UPD ID= 249, SNARK:<4.1.MONITOR>APRSRV.MAC.261,   6-Feb-80 17:24:32 by HALL
;ADD NAMES OF OPTIONAL DATA TO BUG EBSPER
; UPD ID= 238, SNARK:<4.1.MONITOR>APRSRV.MAC.260,   1-Feb-80 14:39:25 by ENGEL
;CALL RQTAD1 AT CLKINI IF KS
; UPD ID= 90, SNARK:<4.1.MONITOR>APRSRV.MAC.259,   5-Dec-79 09:03:00 by OSMAN
;tco 4.1.1043 - Change XCT APHLT1 to BUG(APRNX1)
;<4.1.MONITOR>APRSRV.MAC.258, 15-Nov-79 16:15:46, EDIT BY MILLER
;<4.1.MONITOR>APRSRV.MAC.257, 15-Nov-79 16:12:09, EDIT BY MILLER
;<4.1.MONITOR>APRSRV.MAC.256, 15-Nov-79 16:05:13, EDIT BY MILLER
;SUPPRESS MEM SCAN ON MB PARITY IF CHANNEL WRITE IS CAUSE
;<4.1.MONITOR>APRSRV.MAC.255, 13-Nov-79 06:44:04, EDIT BY R.ACE
;ADD PC ARGUMENT TO ILLDMS AND ILLFLT BUGCHKS
;<4.1.MONITOR>APRSRV.MAC.254,  8-Nov-79 17:39:44, EDIT BY MURPHY
;ADD LSTPFK IN SETPSK
;<4.1.MONITOR>APRSRV.MAC.253,  6-Nov-79 05:45:43, EDIT BY R.ACE
;CHANGE NAMES OF ARGUMENTS TO ILLUUO BUGHLT
;<4.MONITOR>APRSRV.MAC.252,  2-Nov-79 14:22:30, EDIT BY MURPHY
;REMOVE PGLPCS FROM SETMON AND FRIENDS
;<4.MONITOR>APRSRV.MAC.251, 25-Oct-79 13:35:25, EDIT BY MILLER
;MAKE "SUBROUTINE JSYS" ILLEGAL IF NOT IN SECTION 0
;<4.MONITOR>APRSRV.MAC.250, 11-Oct-79 10:56:32, EDIT BY MILLER
;MORE EDITS FOR NON-PI PARITY ERRORS
;<4.MONITOR>APRSRV.MAC.249, 10-Oct-79 16:29:32, EDIT BY MILLER
;ALWAYS USE NON-PI (APR) STACK IN PGMPE0.
;<4.MONITOR>APRSRV.MAC.248, 29-Sep-79 20:35:11, EDIT BY R.ACE
;CHANGE ILLFPT BUG TO ILLFLT BECAUSE OF CONFLICT WITH SYMBOL IN PAGEM
;<4.MONITOR>APRSRV.MAC.247, 28-Sep-79 15:12:59, EDIT BY MURPHY
;BUGCHK IF KA FLT PT INSTRUCTIONS IN MONITOR
;<4.MONITOR>APRSRV.MAC.245, 12-Sep-79 16:04:44, EDIT BY HALL
;CHANGE BLTMU1 AND BLTUM1 TO GET PCS USING XSFM. DON'T APPLY PCS
;IF USER ADDRESS IS IN THE AC'S.
;<4.MONITOR>APRSRV.MAC.244, 11-Sep-79 16:58:03, EDIT BY MURPHY
;SET CSTMSK TO PRESERVE XGAGE
;<OSMAN.MON>APRSRV.MAC.1, 10-Sep-79 15:10:56, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>APRSRV.MAC.242, 29-Aug-79 11:16:15, EDIT BY MILLER
;CLEAR SBUS ERROR AT SBSERR INSTEAD OF AT END OF THIS ROUTINE
; THIS WILL CATCH ANY MOS CORRECTABLE ERRORS GENERATED WHILE
; SBSERR IS POLLING THE MEMORIES EVEN THOUGH IT MAY
; CAUSE SPURIOUS SBUS APR ERRORS
;<4.MONITOR>APRSRV.MAC.241, 17-Aug-79 13:18:47, EDIT BY OSMAN
;tco 4.2410 - Don't print ac1 on APRNX1, and don't have APRNX1 twice
;<4.MONITOR>APRSRV.MAC.240, 15-Aug-79 13:06:51, EDIT BY R.ACE
;ADD CKXADR ROUTINE TO CHECK IF ON AN EXT-ADDRESSING MACHINE
;<4.MONITOR>APRSRV.MAC.239, 12-Aug-79 19:58:19, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.238, 12-Aug-79 19:57:51, EDIT BY MILLER
;SAVE CX AROUND CALL TO GENBLK IN PIAPR
;<4.MONITOR>APRSRV.MAC.237,  2-Jul-79 16:36:39, EDIT BY HALL
;ADD BLTMU1 ENTRY TO BLTMU AND BLTUM1 TO BLTUM
;<4.MONITOR>APRSRV.MAC.236, 27-Jun-79 13:08:45, Edit by KONEN
;PRINT OUT MORE INFORMATION AT BUGHLT
;<4.MONITOR>APRSRV.MAC.235, 24-Jun-79 19:46:41, EDIT BY R.ACE
;MOVE EXTN PI7P OUT OF KL-DEPENDENT CODE
;<4.MONITOR>APRSRV.MAC.234, 20-Jun-79 10:38:16, EDIT BY MILLER
;ADD EXTN PI7P
;<4.MONITOR>APRSRV.MAC.233, 19-Jun-79 12:33:00, EDIT BY HALL
;IN PWRRST, SET UP P TO PI7P IN ORDER TO CALL MONEPT
;<4.MONITOR>APRSRV.MAC.232, 15-Jun-79 14:40:03, EDIT BY HALL
;IN PWRRST, DON'T CALL MONEPT BECAUSE THERE IS NO STACK POINTER.
;DUPLICATE ROUTINE INSTEAD
;<4.MONITOR>APRSRV.MAC.231, 14-Jun-79 17:23:25, EDIT BY HALL
;IN PWRRST SET UP THE EPT BEFORE CALLING BUGMON
;<4.MONITOR>APRSRV.MAC.230, 15-May-79 14:57:28, EDIT BY MURPHY
;REDUCE STACK USAGE
;<4.MONITOR>APRSRV.MAC.229, 19-Mar-79 23:28:07, EDIT BY BOSACK
;MAKE .JSREL BE NOINT DURING RELFRS
;<4.MONITOR>APRSRV.MAC.228, 14-Mar-79 14:42:47, EDIT BY MILLER
;MAKE .JSSET BE NOINT WHEN CALLING ASGJFS
;<4.MONITOR>APRSRV.MAC.227,  4-Mar-79 14:31:40, Edit by KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>APRSRV.MAC.226,  4-Mar-79 13:04:58, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.225,  3-Mar-79 12:20:49, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.224,  3-Mar-79 12:06:08, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.223,  2-Mar-79 15:49:48, EDIT BY MILLER
;ONCE MORE TIME ON ARITH TRAP CODE
;<4.MONITOR>APRSRV.MAC.222,  2-Mar-79 15:20:47, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.221,  2-Mar-79 13:07:33, EDIT BY MILLER
;MAKE ARITH TRAP CODE HANDLE XCT INSTRUCTIONS CORRECTLY
;<4.MONITOR>APRSRV.MAC.220,  1-Mar-79 10:18:07, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.219, 28-Feb-79 15:44:59, EDIT BY MILLER
;CHNAGE ARITH OVERFLOW BLOCK TO BE SAME AS LUUO BLOCK
;<4.MONITOR>APRSRV.MAC.218, 28-Feb-79 11:04:51, EDIT BY MILLER
;CHNAGE UNWEPT NOT TO CLEAR MTR OR TIM
;<4.MONITOR>APRSRV.MAC.217,  5-Feb-79 01:02:10, EDIT BY GILBERT
;Change XBLT MACRO to XBLT. to avoid conflict with hardware opcode.
;<4.MONITOR>APRSRV.MAC.216,  4-Feb-79 22:30:39, EDIT BY GILBERT
;Get rid of spurious character on /G141 to BOOT
;<4.MONITOR>APRSRV.MAC.215, 19-Jan-79 16:55:00, EDIT BY MILLER
;FIX STATUS BLOCK REPORTING FOR APR ERRORS
;<4.MONITOR>APRSRV.MAC.214, 19-Jan-79 12:52:22, EDIT BY MILLER
;FIX APRRPT
;<4.MONITOR>APRSRV.MAC.213, 17-Jan-79 11:08:14, EDIT BY MILLER
;FIX IO PAGE FAIL CODE TO OUTPUT MORE DATA
;<4.MONITOR>APRSRV.MAC.212, 17-Jan-79 10:35:37, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.211, 17-Jan-79 10:30:16, EDIT BY MILLER
;SAVE BAD DATA WORD ON MB PARITY ERROR. CHECK FOR EBUS PROVOKED
; IO PAGE FAIL.
;<4.MONITOR>APRSRV.MAC.210, 16-Jan-79 15:43:32, EDIT BY MILLER
;DON'T SET PGNSAC IN KIPGWD
;<4.MONITOR>APRSRV.MAC.209, 16-Jan-79 15:04:43, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.208, 16-Jan-79 14:36:10, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.207, 16-Jan-79 14:07:56, EDIT BY MILLER
;ADD APRRPT. REPORT RH20/CHANNEL DETECTED ERRORS
;<4.MONITOR>APRSRV.MAC.206, 16-Jan-79 12:16:31, EDIT BY MILLER
;SUPPRESS "LOGOR AND LOGAND" DATA IF NO ERRORS FOUND
;<4.MONITOR>APRSRV.MAC.205, 16-Jan-79 12:06:08, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.204, 16-Jan-79 10:45:29, EDIT BY MILLER
;MORE FIXES TO NXM AND ADDRESS PARITY ERROR PRINT OUT
;<4.MONITOR>APRSRV.MAC.203, 12-Jan-79 13:50:04, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.202, 12-Jan-79 13:24:53, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.201, 12-Jan-79 13:07:38, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.200, 12-Jan-79 13:01:35, EDIT BY MILLER
;ADD TYPEOUT FOR ADDRESS PARITY ERROR
;<4.MONITOR>APRSRV.MAC.199, 12-Jan-79 10:47:28, EDIT BY MILLER
;PRINT OUT WHETHER APR OR CHANNEL DETECTED ERROR ON MB PARITY ERROR
;<4.MONITOR>APRSRV.MAC.198,  8-Jan-79 06:41:33, EDIT BY GILBERT
;TCO 4.2155 - Implement hidden symbol tables:
;	Change the JSVAR macro to the JSBVAR macro.
;<4.MONITOR>APRSRV.MAC.197, 29-Dec-78 12:18:36, EDIT BY MURPHY
;REMOVE PUFLD
;<4.MONITOR>APRSRV.MAC.196, 26-Dec-78 13:50:59, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.195, 26-Dec-78 13:44:16, EDIT BY MILLER
;MORE FIXES TO NXM CODE. PRINT OUT ERA
;<4.MONITOR>APRSRV.MAC.194, 22-Dec-78 13:56:36, EDIT BY MILLER
;CHANGE ERROR CODE ON METER FOR NON-KL PROCESSORS
;<4.MONITOR>APRSRV.MAC.193, 22-Dec-78 11:49:43, EDIT BY MILLER
;MORE FIXED TO SECALE. USE LESS CODE.
;<4.MONITOR>APRSRV.MAC.192, 21-Dec-78 16:24:27, EDIT BY MILLER
;FIX SECALE TO USE 1 LESS REG
;<4.MONITOR>APRSRV.MAC.191, 18-Dec-78 17:35:05, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.190, 18-Dec-78 17:28:05, EDIT BY MILLER
;TCO 4.2124. ADD METER JSYS
;<4.MONITOR>APRSRV.MAC.189, 19-Nov-78 14:25:33, Edit by MCLEAN
;FIX UNBRST NOT TO INIT NON-EX UBA'S
;<4.MONITOR>APRSRV.MAC.188, 15-Nov-78 21:04:35, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.187, 15-Nov-78 19:29:53, EDIT BY MILLER
;HONOR 5 SEC TIMEOUT IN MEMPAR CORRECTLY
;<4.MONITOR>APRSRV.MAC.186,  3-Nov-78 17:09:32, EDIT BY MURPHY
;FIX ENTSKD BUG
;<4.MONITOR>APRSRV.MAC.185, 27-Oct-78 11:29:52, EDIT BY MILLER
;CHECK FOR NON-FATAL MPE AT MEMPJ0
;<4.MONITOR>APRSRV.MAC.184, 21-Oct-78 17:27:01, Edit by MCLEAN
;REMOVE EXRANEOUS CODE AT MEMP7
;<4.MONITOR>APRSRV.MAC.183, 18-Sep-78 12:53:55, Edit by LCAMPBELL
; and remove it - not needed here
;<4.MONITOR>APRSRV.MAC.182, 13-Sep-78 14:30:17, Edit by LCAMPBELL
; Add routine to assign ARPAnet buffers (from resident free pool if KS10)
;<4.MONITOR>APRSRV.MAC.181, 29-Aug-78 14:10:46, Edit by LCAMPBELL
; Leave 23-bit addresses intact for address break
;<4.MONITOR>APRSRV.MAC.180, 25-Aug-78 08:33:35, EDIT BY MILLER
;<4.MONITOR>APRSRV.MAC.179, 25-Aug-78 08:30:23, EDIT BY MILLER
;MAKE SURE SBSERR CAUSES A BUGHLT
;<4.MONITOR>APRSRV.MAC.178, 16-Aug-78 14:57:00, EDIT BY MILLER
;CHANGE SBSERR CODE
;<4.MONITOR>APRSRV.MAC.177,  4-Aug-78 12:08:06, EDIT BY MILLER
;FIX TYPEO
;<4.MONITOR>APRSRV.MAC.176,  4-Aug-78 10:28:13, EDIT BY MILLER
;MORE FIXES FOR NXM
;<4.MONITOR>APRSRV.MAC.175,  4-Aug-78 10:27:28, EDIT BY MILLER
;TYPE OUT SBUS DIAGS ON NXM
;<4.MONITOR>APRSRV.MAC.174,  3-Aug-78 07:44:25, EDIT BY MILLER
;IMPROVE MEM SCAN LOOP FOR PARITY ERROR
;<4.MONITOR>APRSRV.MAC.173, 30-Jul-78 17:43:19, EDIT BY BOSACK
;<3A.MONITOR>APRSRV.MAC.154, 30-Jul-78 16:51:26, EDIT BY BOSACK
;AROUND AND AROUND, MORE KS ECC
;<3A.MONITOR>APRSRV.MAC.153, 29-Jul-78 20:20:03, EDIT BY BOSACK
;MORE FOR HARD ECC
;<4.MONITOR>APRSRV.MAC.170, 29-Jul-78 13:12:12, EDIT BY MILLER
;RESTORE CALLRET BADCPG
;<3A.MONITOR>APRSRV.MAC.151, 28-Jul-78 19:17:44, EDIT BY BOSACK
;FIX HARD ECC FOR KS
;<3A.MONITOR>APRSRV.MAC.149, 20-Jul-78 13:09:02, Edit by MCLEAN
;<4.MONITOR>APRSRV.MAC.167, 18-Jul-78 08:48:27, EDIT BY MILLER
;CALL DTICON IN UNWEPT IF ON THE KL
;<4.MONITOR>APRSRV.MAC.166, 26-Jun-78 14:46:14, Edit by HELLIWELL
;FIX COMPUTATION OF NUMBER OF HUNKS AT MEMLK5
;<4.MONITOR>APRSRV.MAC.165, 20-Jun-78 15:43:36, Edit by HELLIWELL
;ADD NMD16K AND MEMTAB TO EXTN FOR KL
;<4.MONITOR>APRSRV.MAC.164, 20-Jun-78 11:40:45, EDIT BY MILLER
;PRESERVE PC FLAGS IN PAGE FAIL CODE
;<4.MONITOR>APRSRV.MAC.163, 20-Jun-78 01:32:00, EDIT BY BOSACK
;<1BOSACK>APRSRV.MAC.1001,  5-Jun-78 21:33:42, EDIT BY BOSACK
;<4.MONITOR>APRSRV.MAC.161, 19-Jun-78 21:49:42, EDIT BY BOSACK
;<4.MONITOR>APRSRV.MAC.160, 19-Jun-78 21:46:22, EDIT BY BOSACK
;<4.MONITOR>APRSRV.MAC.161, 19-Jun-78 21:45:13, EDIT BY BOSACK
;<4.MONITOR>APRSRV.MAC.159, 11-Jun-78 22:55:42, Edit by JBORCHEK
;<3A.MONITOR>APRSRV.MAC.146, 11-Jun-78 15:37:03, Edit by HELLIWELL
;<4.MONITOR>APRSRV.MAC.157,  9-Jun-78 18:10:47, Edit by HELLIWELL
;<4.MONITOR>APRSRV.MAC.156,  7-Jun-78 15:41:50, Edit by HELLIWELL
;CHANGE TO FUNCTION 12 AT MEMLK6
;<4.MONITOR>APRSRV.MAC.155,  7-Jun-78 12:21:47, Edit by HELLIWELL
;ADD MEMLOK ROUTINE FROM 3A
;<4.MONITOR>APRSRV.MAC.154,  3-Jun-78 16:58:12, Edit by GILBERT
;Suppress .PGTRP, .AROVT, and .PDOVT to DDT typeout
;<3A.MONITOR>APRSRV.MAC.141,  1-Jun-78 12:41:28, EDIT BY MILLER
;ADD MEMSTR ROUTINE TO CLEAR MEM CONTROLLERS
;<4.MONITOR>APRSRV.MAC.152, 26-May-78 08:35:22, EDIT BY MILLER
;ELIMINATE CONTROLLERS 30-37 FROM MEM SCAN
;<4.MONITOR>APRSRV.MAC.151, 22-May-78 10:42:59, EDIT BY MILLER
;GIVE ITRAP IF GENGEN CAN'T GET BLOCK
;<3A.MONITOR>APRSRV.MAC.136, 19-May-78 11:17:11, EDIT BY OPERATOR
;SAVE AND ACCOUNT FOR NEW REGS IN AC BLOCKS 6 AND 7 AT GENBLK
;<4.MONITOR>APRSRV.MAC.149, 19-May-78 08:27:56, EDIT BY MILLER
;FIX UP MINOR BUGS IN GENBLK
;<4.MONITOR>APRSRV.MAC.148, 18-May-78 15:11:19, EDIT BY MILLER
;CHANGE NAME OF BUGP AND BUGPDL
;<4.MONITOR>APRSRV.MAC.147, 18-May-78 12:34:59, EDIT BY MILLER
;FIX TYPEO
;<4.MONITOR>APRSRV.MAC.146, 18-May-78 12:32:18, EDIT BY MILLER
;ADD ROUTINES THAT REDIT COULDN'T FIGURE OUT
;<3A.MONITOR>APRSRV.MAC.132, 18-May-78 12:29:11, EDIT BY MILLER
;ADD ROUTINES TO ENABLE/DISABLE STATUS REPROTING
;<4.MONITOR>APRSRV.MAC.144, 18-May-78 11:18:23, EDIT BY MILLER
;RESTORE INCOMING STACK IN GENBLK
;<3A.MONITOR>APRSRV.MAC.131, 18-May-78 11:15:18, EDIT BY MILLER
;MORE FIXES TO GENBLK. NEEDED TO CREATE PRIVATE STACK
;<3A.MONITOR>APRSRV.MAC.130, 18-May-78 08:52:28, EDIT BY MILLER
;FIX TYPEOS
;<3A.MONITOR>APRSRV.MAC.129, 18-May-78 08:49:23, EDIT BY MILLER
;ADD TYPEOUT ROUTINES TO GENBLK
;<3A.MONITOR>APRSRV.MAC.128, 18-May-78 07:58:01, EDIT BY MILLER
;ONCE AGAIN, AND ADD THE ; FOR COMMENTS
;<3A.MONITOR>APRSRV.MAC.127, 18-May-78 07:55:25, EDIT BY MILLER
;MORE FIXES. ADD CALLS TO GENBLK AT THE PROPER PLACES
;<3A.MONITOR>APRSRV.MAC.126, 17-May-78 18:11:50, EDIT BY MILLER
;CHECK IF PI WAS ON AT ENTRY TO GENBLK
;<3A.MONITOR>APRSRV.MAC.125, 17-May-78 17:49:34, EDIT BY MILLER
;MORE FIXES FOR STATUS BLOCK CODE
;<4.MONITOR>APRSRV.MAC.140, 17-May-78 18:09:26, EDIT BY MILLER
;CHECK IF PI SYSTEM WAS ON AT ENTRY TO GENBLK
;<4.MONITOR>APRSRV.MAC.139, 17-May-78 17:48:58, EDIT BY MILLER
;MORE FIXES FOR STATUS BLOCK CODE
;<3A.MONITOR>APRSRV.MAC.124, 17-May-78 16:59:56, EDIT BY MILLER
;FIX WAY CODE REFERNCES OTHER AC BLOCKS
;<3A.MONITOR>APRSRV.MAC.123, 17-May-78 16:48:36, EDIT BY MILLER
;FIX SOME TYPEOS INS GENBLK
;<3A.MONITOR>APRSRV.MAC.122, 17-May-78 15:35:31, EDIT BY MILLER
;FIX TYPEOS
;<3A.MONITOR>APRSRV.MAC.121, 17-May-78 15:26:56, EDIT BY MILLER
;ADD ROUTINE TO DO STATUS BLOCK REPORTING
;<4.MONITOR>APRSRV.MAC.135, 16-May-78 14:31:20, EDIT BY MURPHY
;<MURPHY.MON>APRSRV.MAC.2, 28-Apr-78 13:35:49, EDIT BY MURPHY
;TCO #1904 - WORKING SET SWAPPING
;<4.MONITOR>APRSRV.MAC.134, 15-May-78 11:34:32, EDIT BY MILLER
;IMPROVE UNPGF1 MESSAGE
;<4.MONITOR>APRSRV.MAC.133, 10-May-78 09:26:47, EDIT BY MILLER
;MARK HARD ERROR ON MEMORY SCAN
;<4.MONITOR>APRSRV.MAC.132,  5-May-78 11:36:43, EDIT BY MILLER
;SAVE PAGE FAIL WORD ON I/O PAGE FAIL
;<4.MONITOR>APRSRV.MAC.131,  3-May-78 14:03:29, EDIT BY MILLER
;CHANGE PARITY ERROR MESSAGE
;<4.MONITOR>APRSRV.MAC.130,  3-May-78 13:27:26, EDIT BY MILLER
;DON'T DO RDERA ON THE 2020
;<4.MONITOR>APRSRV.MAC.129,  3-May-78 13:23:12, EDIT BY MILLER
;READ ERROR REGISTER ON BUGHLT/BUGCHK
;<4.MONITOR>APRSRV.MAC.128,  3-May-78 09:20:15, EDIT BY MILLER
;MORE FIXES TO ARITHMETIC TRAPPING
;<4.MONITOR>APRSRV.MAC.127,  2-May-78 07:02:06, EDIT BY MILLER
;CHANGE MEANING OF ARTHTR. FIX UP CODE THAT USES IT
;<3A.MONITOR>APRSRV.MAC.114, 26-Apr-78 10:39:21, EDIT BY MILLER
;CHECK FOR NON-EX FBUS CONTROLLER (ALL 1'S RETURNED FROM SBSDIAG)
;<3.SM10-RELEASE-3>APRSRV.MAC.78, 12-Apr-78 17:17:25, Edit by MCLEAN
;REMOVE EXTRANEOUS SE1CAL AT XBLTUF (NO ONE ELSE HAS ONE)
;<3A.MONITOR>APRSRV.MAC.112, 12-Apr-78 08:49:10, EDIT BY MILLER
;IF MOS HARD ERROR, LEAVE ERROR BITS IN CONTROLLER AFTER MEM SCAN
;<3.SM10-RELEASE-3>APRSRV.MAC.77, 11-Apr-78 14:49:13, Edit by MCLEAN
;DON'T SET APHER FOR KS AND SET APNXM
;<3A.MONITOR>APRSRV.MAC.110, 11-Apr-78 13:03:02, EDIT BY MILLER
;FIX TYPEOS
;<3A.MONITOR>APRSRV.MAC.109, 11-Apr-78 13:00:03, EDIT BY MILLER
;APPEND MOS "PSEUDO SBUS DIAGS" TO SYSERR ENTRY
;<4.MONITOR>APRSRV.MAC.121, 11-Apr-78 11:40:55, EDIT BY MILLER
;MAKE SBHED SBHEB
;<3A.MONITOR>APRSRV.MAC.107, 11-Apr-78 11:20:57, EDIT BY MILLER
;SET SBHED IN MOS ERROR BLOCK IF A DOUBLE-BIT ERROR
;<3A.MONITOR>APRSRV.MAC.106,  7-Apr-78 17:33:44, EDIT BY MILLER
;NOW DO IT SO MACRO WILL ASSEMBLE IT
;<3A.MONITOR>APRSRV.MAC.105,  7-Apr-78 16:54:29, EDIT BY MILLER
;CHANGE DEFS OF CLRMPE TO ENABLE APR PI CHANNEL
;<3A.MONITOR>APRSRV.MAC.104,  7-Apr-78 00:17:00, Edit by MCLEAN
;FIX IT SO HALT STATUS BLOCK ADDRESS IS = HSBADR
;<4.MONITOR>APRSRV.MAC.116,  5-Apr-78 09:04:23, EDIT BY MILLER
;SAVE PREV CONTEXT ACS ON A BUGHLT
;<4.MONITOR>APRSRV.MAC.115,  3-Apr-78 13:43:41, EDIT BY MILLER
;REMOVE IORST AND PIRST FROM SHCPF0
;<4.MONITOR>APRSRV.MAC.114, 20-Mar-78 14:42:03, EDIT BY MILLER
;SET UP LUUO BLOCK WITH AN RS SO IT IS PRESERVED
;<4.MONITOR>APRSRV.MAC.113, 17-Mar-78 13:52:14, Edit by MCCLURE
; STOP KMC11 IN UNBINI & UNBRST
;<3.SM10-RELEASE-3>APRSRV.MAC.74, 15-Mar-78 19:25:19, Edit by MCLEAN
;FORGOT T1 IN MOVEM T1,CRSHTM IN BUGSTO
;<4.MONITOR>APRSRV.MAC.111, 14-Mar-78 10:21:28, Edit by KIRSCHEN
;INSERT SEMICOLON ON LAST EDIT LINE
;<3A.MONITOR>APRSRV.MAC.97, 13-Mar-78 13:41:47, EDIT BY MILLER
;FIX SBUS PRINT OUT
;<3.SM10-RELEASE-3>APRSRV.MAC.2, 23-Feb-78 16:05:43, Edit by MCLEAN
;FIX IT SO UBA NON-EXISTANCE DOESN'T MATTER
;<4.MONITOR>APRSRV.MAC.108, 24-Feb-78 09:59:10, EDIT BY MILLER
;FIX GAPRID TO ONLY GET 12-BIT SERIAL NUMBER FOR THE KL
;<4.MONITOR>APRSRV.MAC.107, 21-Feb-78 14:53:37, EDIT BY MILLER
;STORE OFFSET TO SBUSDIAGS IN PI%SB2
;<4.MONITOR>APRSRV.MAC.106, 16-Feb-78 09:34:38, EDIT BY MILLER
;CHANGE SWPZPG SO IT CAN RUN IN ANY SECTION
;<4.MONITOR>APRSRV.MAC.105, 13-Feb-78 10:43:34, EDIT BY MILLER
;SMALL CHANGE TO CODE THAT PAUSES DTE ACTIVITY
;<4.MONITOR>APRSRV.MAC.104, 13-Feb-78 10:09:47, EDIT BY MILLER
;PAUSE DTE ACTIVITY IN MEM PAR SCAN. MERGE FROM 3A.MONITOR

;<4.MONITOR>APRSRV.MAC.103, 13-Feb-78 09:22:22, EDIT BY MILLER
;MOVE ERRTBL DEFINITION TO STG
;<4.MONITOR>APRSRV.MAC.102, 11-Feb-78 13:34:57, EDIT BY MILLER
;ADD MXSECN, THE HIGHEST POSSIBLE SECTION #
;<4.MONITOR>APRSRV.MAC.101, 11-Feb-78 10:51:38, EDIT BY MILLER
;ADD USECTO
;<3.SM10-RELEASE-3>APRSRV.MAC.72,  5-Feb-78 17:53:57, Edit by MCLEAN
;ADD CRSHTM FOR KS10 TO SAVE INITIAL TIME
;<3A.MONITOR>APRSRV.MAC.88,  5-Feb-78 14:13:21, EDIT BY MILLER
;ADD UNWEPT
;<4.MONITOR>APRSRV.MAC.98,  5-Feb-78 14:05:33, EDIT BY MILLER
;TREAT UNKNOWN TRAP MUUO FROM USER AS NORMAL MUUO
;<4.MONITOR>APRSRV.MAC.97,  5-Feb-78 13:39:40, EDIT BY MILLER
;FIX SAV4 AND SAV8 TO USE ADJSP AND DMOVEM/DMOVE
;<4.MONITOR>APRSRV.MAC.96,  4-Feb-78 14:42:07, EDIT BY MILLER
;FIX SAVQ TO USE ADJSP.
;FIX SAVP TO USE ADJSP. FIX SAVPQ TO USE ADJSP
;<4.MONITOR>APRSRV.MAC.95,  4-Feb-78 14:29:41, EDIT BY MILLER
;SPEED UP SAVET SUPPORT CODE. USE ADJSP INSTEAD OF MULTIPLE PUSH
;<4.MONITOR>APRSRV.MAC.94,  4-Feb-78 13:58:30, EDIT BY MILLER
;FIX TO SETLUU
;<4.MONITOR>APRSRV.MAC.93,  4-Feb-78 13:37:03, EDIT BY MILLER
;MERGE ALL 2-BIT FIXES IN FROM 3A
;<3A.MONITOR>APRSRV.MAC.87,  4-Feb-78 13:31:30, EDIT BY MILLER
;MORE 2-BIT FIXES
;<3A.MONITOR>APRSRV.MAC.86,  4-Feb-78 13:30:17, EDIT BY MILLER
;FIXES TO DOUBLE-BIT CORRECTION CODE
;<4.MONITOR>APRSRV.MAC.91,  4-Feb-78 11:24:09, EDIT BY MILLER
;FIX BAD BYTE POINTER IN SBSERR
;<3A.MONITOR>APRSRV.MAC.84,  3-Feb-78 12:34:30, EDIT BY MILLER
;USE APR AC BLOCK FOR PARITY ERROR PROCESSING
;<4.MONITOR>APRSRV.MAC.89,  3-Feb-78 11:34:48, EDIT BY MILLER
;MAKE APR STACK BIG ENOUGH FOR ASGFRE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG,SERCOD
	EXTN <PI7P,PIXCX,XPISK,PIXSTK,SYRMAP>

   IFN KLFLG,<
	TTITLE APRSRV
	SEARCH PROKL

EXTN <DTEINA,DTEACT,ENDRGN,NMD16K,MEMTAB,DTICON,PIBITS>
>
   IFN SMFLG,<
	TTITLE APRSRV,APRSSM
	SEARCH PROKS
>

;PROCESSOR SERVICE, PROCESSOR-DEPENDENT PAGING. D. MURPHY

NTMS==:^D100			;TICKS/MS OF SOFTWARE HIGH PRECISION CLOCK

;NEED FX FOR BUGH0 -- BUGHLT CODE

FX==Q3				;DEFINE AC FOR FKJSB

;CONI/CONO APR BIT DEFINITIONS

   IFN KLFLG,<

RS MTSADR,1			;HOLD MEMORY TEST ADDRESS
RS WREQ,1			;WRITE ERROR QUEUE
;FLAG FUNCTIONS (CONO APR)

APIOPR==:1B19			;IOB RESET
APFEN==: 1B20			;FLAG ENABLE
APFDIS==:1B21			;FLAG DISABLE
APFCLR==:1B22			;FLAG CLEAR
APFSET==:1B23			;FLAG SET

;FLAGS - AFFECTED AS CONTROLLED BY FLAG FUNCTION BITS

APSBER==:1B24			;SBUS ERROR
APNXM==: 1B25			;NONX MEM
APIOPF==:1B26			;IO PAGE FAIL
APMPE==: 1B27			;MBOX-DETECTED DATA PARITY ERROR
APCDPE==:1B28			;CACHE DIRECTORY PARITY ERROR
APAPE==: 1B29			;ADDRESS PARITY ERROR
APPWF==: 1B30			;POWER FAIL
APSWPD==:1B31			;SWEEP DONE
APIRQ==: 1B32			;INTERRUPT REQUEST (CONI ONLY)
APPIA==: 7B35			;PI ASSIGNMENT
DEFINE RDTIME (XX)<
	DATAI TIM,XX>
GOPDEF CLRMPE,<CONO APR,APFCLR+APSBER+APMPE+APRCHN>	;CLEAR PAR FLAG

;**;[3069] ADD DEFINITION	RAH	JAN-19-84
DEFINE SMAPOK (AC)<		;[3069]
		TXNN AC,TWHPFF	;[3069]HARD FAILURE?
		TXNN AC,TWVALD>	;[3069]NO. VALID MAPPING?
				;[3069]NO. EITHER HARD FAILURE OR NOT VALID 
				;[3069]NOT HARD FAILURE AND MAPPING IS VALID 
   >				;END IFN KLFLG

   IFN SMFLG,<
;KS flags for WRAPR/RDAPR

APIOPR==:1B19			;IOB RESET

;FLAG FUNCTIONS

APFTEN==1B12			;TIMER INTERRUPT ENABLED
APFEN==:1B20			;FLAG ENABLE
APFDIS==:1B21			;FLAG DISABLE
APFCLR==:1B22			;FLAG CLEAR
APFSET==:1B23			;FLAG SET

;FLAGS - AFFECTED AS CONTROLLED BY FLAG FUNCTION BITS

APINE==:1B25			;INTERRUPT 8080
APPWF==:1B26			;POWER FAIL
APNXM==:1B27			;NONX MEM
APHMP==1B28			;HARD MEMORY PARITY ERROR
APSMP==:0B29			;SOFT MEMORY PARITY ERROR (DISABLED FOR NOW)
APTMR==:1B30			;TIMER INTERRUPT
APINK==:1B31			;INTERRUPT KS10
APIRQ==:1B32			;INTERRUPT REQUEST
APPIA==:7B35			;PI ASSIGNMENT

GOPDEF CLRMPE,<CONO APR,APFCLR+APHMP+APRCHN>

MEMERA=100000			;UNIBUS ADDRESS OF MEMORY ERROR REGISTER

MER%CL==1B0			;CLEAR MEMERA LATCH

   >				;END IFN SMFLG

GOPDEF CLNXMF,<CONO APR,APFCLR+APNXM+APRCHN> ;CLEAR NXM FLAG

APSWPB==:1B19			;SWEEP BUSY (CONI APR OR RDAPR)

;CONO APR WHERE PI CHANNEL IS ALWAYS NEEDED

DEFINE CONOAPR (E)<
	CONO APR,E+APRCHN>
;TRAP MUUO'S

 GSOPDEF .PGTRP,<40B8>		;PAGE FAULT, USER OR MONITOR
 GSOPDEF .AROVT,<41B8>		;AR OV, USER ONLY
 GSOPDEF .PDOVT,<42B8>		;PDL OV, USER OR MONITOR

;GET PROCESSOR SERIAL NUMBER

GAPRID::
	APRID T1
   IFN SMFLG,<			;FOR THE KS
	ANDX T1,<MASKB 21,35>
   >
   IFN KLFLG,<			;FOR THE KL
	ANDX T1,<MASKB 24,35>
   >
	RET

   IFN KLFLG,<SBCLER==1B5>	;SBUSDIAG CLEARR ERROR BIT
   IFN DTFLG,<

;DTE20 SERVICE

;DTE20 CONI/CONO BITS

DTE0==200			;DEVICE CODE, DTE #0
DTECHN==DLSCHN			;PI CHANNEL ASSIGNMENT

DEFINE CONODTE (E)<
	CONO DTE0,E>

;DTE20 DATAO BITS AND FIELDS

; 0-22				;UNUSED
DTETI==:1B23			;TO-10 "I" BIT
DTEBYC==:007777			;(NEGATIVE) BYTE COUNT

;KLDTE PROTOCOL

DTEDAT==377			;DATA BYTE IN DTECMD
DTECCD==17B27			;COMMAND CODE IN DTECMD

;COMMAND CODES

DTETTO==0B27			;TTY OUTPUT
; 1 - PROGRAM CONTROL, NOT USED
DTECOF==2B27+0			;CLOCK OFF
DTECON==2B27+1			;CLOCK ON
; 3 - SWITCHES, NOT USED
; 4 - TTY OUTPUT, SAME AS 0?
; 5 - TTY INPUT, NOT USED
DTEPTN==6B27+0			;PRINT NORMAL
DTEPTF==6B27+1			;PRINT FORCED
DTEDDI==7B27			;DDT INPUT
DTEMNO==10B27			;MONITOR TTY OUTPUT
DTEMMN==11B27			;MONITOR MODE ON
DTEMMF==12B27			;MONITOR MODE OFF
DTERMM==13B27			;READ MONITOR MODE

   >				;END OF IFN DTFLG
;DEFINITIONS FOR MF20 CONTROLLERS

IFN KLFLG,<			;ONLY FOR KL10

MOSTBL:	-10,,10			;FIRST GROUP OF CONTROLLERS
	-5,,0			;THE MB/MB AND DMA CONTROLLERS
MOSLEN==.-MOSTBL		;# OF GROUPS

FMOS==:10			;FIRST MF20 CONTROLLER
MOS==5				;MEMORY TYPE FOR MF20
DEFSTR (MEMTYP,,11,4)		;FIELD IS SBUSD FNC 1 FOR MEMORY TYPE
MOSCER==1B1			;CORRECTABLE ERROR BIT
MOSWPE==1B4			;DATA WRITE PARITY ERROR
MOSDBL==1B25			;DISABLE BIT IN FNC 1 FOR MOS
SBSHER==57B5			;HARD ERROR BITS FOR ANY SBSUS CONTROLLER
SBSRPE==1B3			;READ PARITY ERROR
SBSMAX==2			;# OF SBDIAG'S TO READ
MFBXDS==1B14			;BOX DISABLE IN FNC 12

;OTHER KNOWN MEMORY TYPES FOR SBDIAG USED BY MEMLOK ROUTINE
DMA20==2
MA20==1
MB20==3
	ARQENB==17B35		;TO TEST ANY REQUESTS ENABLED FOR MA20/MB20
MX20==4	;NOT CURRENTLY IMPLEMENTED

;DEFINE NEEDED ERA BITS

	ER%CHN==:1B3		;CHANNEL DETECTED ERROR
	ER%WRT==:1B6		;WRITE TO MEMORY
>
;GENERALLY USED CONSTANTS

;6-BIT POINTER TABLE

	POINT 6,0,-1
CH6TAB::POINT 6,0,5
	POINT 6,0,11
	POINT 6,0,17
	POINT 6,0,23
	POINT 6,0,29
	POINT 6,0,35

;BHC+N CONTAINS N,,N

XX=0
BHC::	REPEAT 20,<EXP XX*1000001
		XX=XX+1>

;BITS+N CONTAINS A WORD WITH A 1 IN BIT N

XX==0
BITS::	REPEAT ^D36,<EXP 1B<XX>
		XX=XX+1>
		SUBTTL Utility routines

;GLOBAL STANDARD RETURNS

;POP AC'S DOWN TO 1 AND RETURN

PA7::	POP P,7
PA6::	POP P,6
PA5::	POP P,5
PA4::	POP P,4
PA3::	POP P,3
PA2::	POP P,2
PA1::	POP P,1
	RET

;POP AC'S DOWN TO 2 AND RETURN

PB7::	POP P,7
PB6::	POP P,6
PB5::	POP P,5
PB4::	POP P,4
PB3::	POP P,3
PB2::	POP P,2
	RET

;FALSE (AC1=0) AND TRUE (AC1#0) RETURNS

RETZ::				;RETURN ZERO
RFALSE::SETZ 1,
	RET

RETO::				;RETURN ONES
RTRUE::	SETO 1,
	RET

;SKIP AND NO-SKIP RETURNS

RSKP::	AOS 0(P)
R::	RET

;SUPPORT ROUTINES FOR EA.ENT, S0.ENT MACROS

;ENTRY ROUTINE TO JUMP INTO EXTENDED SECTION IF NECESSARY AND
;SET STACK FOR AUTOMATIC RETURN TO CALLER'S SECTION

$EAENT::TXNE CX,EXSCBT		;ALREADY IN NON-0 SECTION?
	JRST 0(CX)		;YES, DO NOTHING
	ADJSP P,1		;NO, CONSTRUCT PC TO SWITCH SECTIONS
	XSFM 0(P)
	PUSH P,[MSEC1,,EAENT1]
	XJRSTF -1(P)		;JUMP INTO SECTION 1, KEEPING FLAGS
EAENT1:	ADJSP P,-2		;FLUSH JUNK FROM STACK
	HRRZS 0(P)		;FIX UP STACK FOR RETURN TO SECTION 0
	HRLI CX,MSEC1		;FIX LOCAL RETURN TO STAY IN SECTION 1
	JRST 0(CX)		;CONTINUE WITH ROUTINE

$S0ENT::TXNN CX,EXSCBT		;ALREADY IN SECTION 0?
	JRST 0(CX)		;YES, DO NOTHING
	JRST @[.+1]		;JUMP INTO SECTION 0
	PUSHJ P,0(CX)		;CONTINUE WITH ROUTINE
	 CAIA
	AOS 0(P)		;HANDLE SKIP RETURN
	ADJSP P,1		;CONSTRUCT PC TO SWITCH SECTIONS
	XSFM 0(P)
	PUSH P,[MSEC1,,S0ENT1]
	XJRSTF -1(P)		;JUMP INTO SECTION 1, KEEPING FLAGS
S0ENT1:	ADJSP P,-2		;FLUSH STACK
	RET
;SECALL -- SUPPORT FOR SECTION CALL TO CALL SECTION 1
;SECALE -- REMOVES THE SECTION NUMBER FROM HIGH ORDER BITS OF -1(P)
; SO POPJ WILL WORK THEN ENTERS SECTION 1
;
; REQUIRES A STACK (P) AND IS CALLED USING THE
; SE1ENT AND SE1CAL MACRO'S
;
; ALWAYS RETURNS +1
;
SECALE::MOVX CX,EXFLBT		;GET FLAGS TO CLEAR
	ANDCAM CX,-1(P)		;CLEAR FLAGS FROM RETURN PC
SECALL::SKIPN EXADFL		;EXTENDDED ADDRESSING ENABLED?
	RET			;NO -- FORGET IT AND RETURN
	MOVE CX,[MSEC1,,SCALL1]	;SECTION TO ENTER AND LOCAL PC
	HLLM CX,0(P)		;SET IT
	PUSH P,P6		;ASSUME P6 = CX-1
	XSFM P6			;PRESERVE FLAGS
	XJRSTF P6		;ENTER NEW SECTION AND PRESERVE FLAGS
SCALL1:	POP P,P6		;RESTORE AC
	RET			;RETURN

; SE0CAL -- SUBROUTINE TO SUPPORT SE1ENT MACRO
;
; ENTRY SE0ENT (MACRO)
; REQUIRES STACK BUT DOES NOT DESTROY ANYTHING

SE0CAL::JRST @[.+1]
	RET

; SPCSNZ - Skip if Previous Context Section Non Zero
;	   Destroys no ACs but uses the stack

SPCSNZ::
	PUSH P,T1		; SAVE AN AC
	SETZ T1,		; ZERO THE AC
	XCTU [XHLLI T1,0]	; GET PCS INTO LEFT HALF T1
	SKIPE T1		; PCS NON-ZERO?
	 AOS -1(P)		; YES SO BUMP RETURN PC
	POP P,T1		; GET THE AC BACK
	RET			; RETURN TO CALLER OR CALLER+1
; EXTENDED ADDRESSING BLT SIMULATION FOR CROSSING SECTIONS

; XBLTA SIMULATE AN XBLT 1
;
; CALLING SEQENCE:
;
;	T1	LENGTH TO BLT
;	T2	FROM ADDRESS
;	T3	TO ADDRESS
;	CALL XBLTA
;RETURNS +1 ALWAYS
; PRESERVES T4 AND DESTROYS T1,T2,T3
;

XBLTA::	HRRZS T1		;MAKE SURE REASONABLE SIZE
	SKIPE EXADFL		;CHECK FOR EXTENDED ADDRESSING
	JRST XBLTE		;YES -- DO REAL XBLT
	ADD T1,T3		;NO -- FAKE IT AND DO BLT
	SOS T1
	HRRZS T1
	HRL T3,T2
	BLT T3,0(T1)
	RET

XBLTE:	XBLT. T1
	RET
;EXTENDED BLT MONITOR TO USER FOR EXTENDED ADDRESSING
;
; CALLING SEQUENCE:
;
;	T1	LENGTH TO BLT
;	T2	FROM ADDRESS
;	T3	TO ADDRESS
;	CALL BLTMU
;		OR
;	CALL BLTMU1

;RETURNS +1 ALWAYS
; PRESERVES T4 ALTERS T1,T2,T3

;BLTMU1 IS ALTERNATE ENTRY POINT THAT APPLIES PREVIOUS CONTEXT
;SECTION TO THE USER'S ADDRESS. THIS IS USED IF THE CALLER HAS
;NOT PREVIOUSLY SET UP A 30-BIT ADDRESS AND WANTS THE SECTION FROM
;WHICH THE USER ENTERED THE MONITOR.

BLTMU1::XSFM CX			;GET FLAGS, INCLUDING PCS
	ANDI CX,EXPCS		;GET JUST PREVIOUS CONTEXT SECTION
	TXNN T3,VSECNO		;USER'S ADDRESS IN NON-ZERO SECTION?
	CAIGE T3,20		;NO. STARTING IN THE AC'S?
	SKIPA			;SECTION GIVEN OR AC'S. DON'T APPLY PCS
	HRL T3,CX		;NEED A SECTION. USE PCS
BLTMU::	HRRZS T1		;MAKE SURE RATIONAL SIZE
	SKIPE EXADFL		;CHECK FOR EXTENDED ADDRESSING
	JRST BLTXE		;REAL XBLT POSSIBLE
	ADD T1,T3		;SIMULATE XBLT
	SOS T1
	HRRZS T1
	HRL T3,T2
	XBLTMU [BLT T3,0(T1)]
	RET

BLTXE:	XCT 1,[XBLT. T1]	;DO PXCT OF XBLT
	RET			;RETURN
; BLTUM -- EXTENDED BLT FROM USER TO MONITOR SPACE

;
; CALLING SEQUENCE:
;
;	T1 -- COUNT OF WORDS TO TRANSFER
;	T2 -- FROM ADDRESS
;	T3 -- TO ADDRESS
;	CALL BLTUM
;RETURNS +1 ALWAYS AND PRESERVES T4 ALTERS T1,T2,T3
;

;BLTUM1 IS ALTERNATE ENTRY POINT THAT APPLIES PREVIOUS CONTEXT
;SECTION TO THE USER'S ADDRESS. THIS IS USED IF THE CALLER HAS
;NOT PREVIOUSLY SET UP A 30-BIT ADDRESS AND WANTS THE SECTION FROM
;WHICH THE USER ENTERED THE MONITOR.

BLTUM1::XSFM CX			;GET FLAGS, INCLUDING PCS
	ANDI CX,EXPCS		;GET JUST PREVIOUS CONTEXT SECTION
	TXNN T2,VSECNO		;USER'S ADDRESS IN NON-ZERO SECTION?
	CAIGE T2,20		;NO. STARTING IN THE AC'S?
	SKIPA			;SECTION GIVEN OR AC'S. DON'T APPLY PCS
	HRL T2,CX		;NEED A SECTION. USE PCS
BLTUM::	HRRZS T1		;MAKE SURE COUNT IS REASONABLE
	SKIPE EXADFL		;CHECK FOR EXTENDED ADDRESSING
	JRST XBLTUE		;YES CAN DO REAL XBLT
	ADD T1,T3		;SIMULATE XBLT
	SOS T1
	HRRZS T1
	HRL T3,T2
	XBLTUM [BLT T3,0(T1)]	;DO THE BLT IN SECTION 0 SPACE
	RET			;RETURN TO CALLER

XBLTUE:	XCT 2,[XBLT. T1]	;DO PXCT OF XBLT
	RET			;RETURN TO CALLER
; BLTUU -- EXTENDED BLT FROM USER TO USER SPACE

;
; CALLING SEQUENCE:
;
;	T1 -- COUNT OF WORDS TO TRANSFER
;	T2 -- FROM ADDRESS
;	T3 -- TO ADDRESS
;	CALL BLTUU
;RETURNS +1 ALWAYS AND PRESERVES T4 ALTERS T1,T2,T3
;

BLTUU::	HRRZS T1		;MAKE SURE COUNT IS REASONABLE
	SKIPE EXADFL		;CHECK FOR EXTENDED ADDRESSING
	JRST XBLTUF		;YES CAN DO REAL XBLT
	ADD T1,T3		;SIMULATE XBLT
	SOS T1
	HRRZS T1
	HRL T3,T2
	XBLTUU [BLT T3,0(T1)]	;DO THE BLT IN SECTION 0 SPACE
	RET

XBLTUF:	XCT 3,[XBLT. T1]	;DO PXCT OF XBLT
	RET			;RETURN TO CALLER
;COMMON ENTRY AND EXIT ROUTINE FOR STACK VARIABLE FACILITY

.STKST::ADD P,0(CX)		;BUMP STACK FOR VARIABLES USED
	JUMPGE P,[PUSH P,CX	;OVERFLOW, MUST DO IT PAINFULLY
		HRRZ CX,0(CX)	;GET COUNT
		ADJSP P,-1(CX)	;ADJUST STACK, ACCOUNT FOR PUSH ABOVE
		MOVN CX,CX
		ADDI CX,1(P)	;COMPUTE POSITION WHERE LOCAL RETURN STORED
		MOVE CX,0(CX)	;GET BACK LOCAL RETURN
		JRST .+1]	;OVERFLOW SHOULD HAVE HAPPENED ON PUSH OR ADJSP
	PUSH P,0(CX)		;SAVE BLOCK SIZE FOR RETURN
	PUSHJ P,1(CX)		;CONTINUE ROUTINE, EXIT VIA .+1 OR .+2
.STKRT:: JRST STKRT0		;NON-SKIP RETURN COMES HERE
	POP P,CX		;SKIP RETURN COMES HERE-RECOVER COUNT
	SUB P,CX		;ADJUST STACK TO REMOVE BLOCK
	AOS 0(P)		;NOW DO SKIP RETURN
	RET

STKRT0:	POP P,CX		;RECOVER COUNT
	SUB P,CX		;ADJUST STACK TO REMOVE BLOCK
	RET			;DO NON-SKIP RETURN

;SUPPORT ROUTINE FOR TRVAR

.TRSET::PUSH P,P6		;PRESERVE OLD P6
	MOVE P6,P		;SETUP FRAME PTR
	ADD P,0(CX)		;ALLOCATE SPACE
	JUMPGE P,[PUSH P,CX	;OVERFLOW, MUST DO IT SO AS TO GET TRAP
		HRRZ CX,0(CX)	;GET COUNT
		ADJSP P,-1(CX)	;ADJUST STACK, ACCOUNT FOR PUSH ABOVE
		MOVE CX,1(P6)	;GET BACK LOCAL RETURN
		JRST .+1]	;SHOULD HAVE TRAPPED AT PUSH OR ADJSP
	PUSHJ P,1(CX)		;CONTINUE ROUTINE, EXIT VIA .+1
.TRRET:: JRST [	MOVEM P6,P	;CLEAR STACK
		POP P,P6	;RESTORE OLD P6
		RET]
	MOVEM P6,P		;HERE IF SKIP RETURN
	POP P,P6
	RETSKP			;PASS SKIP RETURN
;SUPPORT ROUTINE FOR ASUBR

.ASSET::PUSH P,P6		;SAVE AC FOR STACK POINTER
	MOVE P6,P		;SETUP FRAME PTR
	ADJSP P,4		;ALLOCATE SPACE
	DMOVEM T1,1(P6)		;SAVE ARGS
	DMOVEM T3,3(P6)
	PUSHJ P,0(CX)		;CONTINUE ROUTINE
.ASRET:: JRST [	MOVEM P6,P	;NO-SKIP RETURN, CLEAR STACK
		POP P,P6
		RET]
	MOVEM P6,P
	POP P,P6
	RETSKP

;SUPPORT ROUTINE FOR SASUBR

.SASET::PUSH P,P6		;SAVE P6
	MOVE P6,P		;SETUP FRAME POINTER
	ADJSP P,4		;BUMP STACK
	DMOVEM A,1(P6)	;SAVE ARGS
	DMOVEM C,3(P6)
	PUSHJ P,0(CX)		;CONTINUE ROUTINE
.SARET:: JRST [	DMOVE A,1(P6)	;RESTORE
		DMOVE C,3(P6)
		MOVEM P6,P	;NO-SKIP RETURN, CLEAR STACK
		POP P,P6
		POPJ P,]
	DMOVE A,1(P6)		;RESTORE
	DMOVE C,3(P6)
	MOVEM P6,P		;SKIP RETURN, CLEAR STACK
	POP P,P6
	AOS 0(P)
	POPJ P,

;SUPPORT CODE FOR BLSUBR

.ENTER::PUSH P,P6
	MOVE P6,P
	ADD P,0(CX)		;ALLOCATE LOCAL STORAGE
	JUMPGE P,ENTOV		;JUMP IF OVERFLOW
ENTOV1:	PUSHJ P,1(CX)
	 JRST [	MOVE P,P6	;RESET STACK PTR
		JRST ENTX1]
	MOVE P,P6
	AOS -1(P)		;PROPAGATE SKIP
ENTX1:	POP P,P6
	POP P,CX
	SUB P,0(P)		;REMOVE ARGS
	JRST 0(CX)		;RETURN

ENTOV:	MOVE P,P6		;STACK OVERFLOW, UNDO ADD
	PUSH P,CX		;SAVE LOCAL RETURN IN 1(P6)
	HRRZ CX,0(CX)		;GET COUNT
	ADJSP P,-1(CX)		;ALLOCATE SPACE, GET TRAP HERE OR ON PUSH
	MOVE CX,1(P6)		;RESTORE LOCAL RETURN
	JRST ENTOV1		;CHARGE AHEAD
;SUPPORT ROUTINE FOR JSBVAR.
;BUILDS A STACK FRAME AS FOLLOWS
; -5(P) := RETURN PC FROM CALLING PROGRAM
; -4(P) THRU -1(P) := PLACE TO SAVE T1-T4
;  0(P) := PLACE TO SAVE PREVIOUS FRAME PNTR

.JSSET::ADJSP P,5		;BUILD STACK FRAME
	DMOVEM T1,-4(P)		;SAVE T1-T2
	DMOVEM T3,-2(P)		; AND T3-T4
	MOVEM CX,0(P)		;SAVE TEMP
	HLRZ T2,0(CX)		;SIZE OF BLOCK REQUIRED
	NOINT			;PROTECT FREE SPACE
	CALL ASGJFS		;ASSIGN SPACE IN JSB
	 JRST [	MOVE CX,0(P)	;RETURN ADDRS
		HRRZ T1,0(CX)	;SEE IF USER ERROR ROUTINE?
		OKINT		;UNDO NOINT ABOVE
		JUMPE T1,[ITERR (MONX02)]
		DMOVE T1,-4(P)	;RESTORE ACS
		DMOVE T3,-2(P)
		MOVEI T1,MONX02	;ERROR CODE
		ADJSP P,-5	;CLEAN OFF STACK
		HRRZ CX,0(CX)	;GET ERROR ADDRS
		JRST 0(CX)]	;XFER TO USER ROUTINE
	OKINT			;UNDO NOINT ABOVE
	MOVE CX,0(P)		;RESTORE CONTEXT
	MOVEM P6,0(P)		;SAVE PREVIOUS FRAME
	MOVEI P6,1(T1)		;POINT TO FIRST LOC
	DMOVE T1,-4(P)		;RESTORE T1-T4
	DMOVE T3,-2(P)
	PUSHJ P,1(CX)		;RETURN TO CALLER
.JSRET:: SKIPA			;NORMAL RETURN
	AOS -5(P)		; SET UP SKIP RETURN
	DMOVEM T1,-4(P)		;SAVE T1-T4 AGAIN
	DMOVEM T3,-2(P)
	MOVEI T1,JSBFRE		;RELEASE STG FROM HER
	MOVEI T2,-1(P6)		;POINT TO BLOCK
	NOINT			;BE NOINT FOR ENTIRE RELEASE
	CALL RELFRS		;RELEASE IT
	OKINT			;STORAGE FREE
	MOVE P6,0(P)		;RESTORE FRAME PNTR
	DMOVE T1,-4(P)		;RESTORE T1-T4
	DMOVE T3,-2(P)
	ADJSP P,-5		;REMOVE STACK FRAME
	RET			;RETURN APPROPRIATELY
;FACILITY TO SAVE ALL ACS.
;NORMALLY INVOKED BY ACSAV MACRO, = JSP CX,ACSAV0
;DUMMY RETURN PUT ON STACK TO DO AUTOMATIC RESTORE ON RETURN

ACSAV0::ADJSP P,16		;MAKE ROOM FOR 16 ACS
	MOVEM 15,0(P)		;PUT HIGHEST AC IN LAST WORD OF BLOCK
	MOVEI 15,-15(P)		;BLT FROM 0 TO FIRST WORD OF BLOCK
	BLT 15,-1(P)		;STOP AT AC 14
	MOVE 15,0(P)		;RESTORE AC 15 ALSO
	PUSHJ P,0(CX)		;CONTINUE ROUTINE, EXIT VIA .+1
ACRET0:: SKIPA			;NO-SKIP ENTRY
	AOS -16(P)		;SKIP ENTRY, PASS IT UPWARD
	MOVSI 15,-15(P)		;BLT FROM FIRST OF BLOCK TO 0
	BLT 15,15		;THROUGH 15
	ADJSP P,-16		;CLEAR STACK
	RET

;ROUTINES TO SAVE P1-P6, OR Q1-Q3, OR Q1-Q3 AND P1-P6
;CALLED WITH SAVEP, SAVEQ, AND SAVEPQ MACROS

SAVP::	ADJSP P,6		;NEED TO SAVE 6 REGS
	DMOVEM P1,-5(P)
	DMOVEM P3,-3(P)
	DMOVEM P5,-1(P)		;SAVE THEM ALL
	PUSHJ P,0(CX)		;CONTINUE ROUTINE, EXIT VIA .+1
RESTP::	 SKIPA			;NON-SKIP RETURN
	AOS -6(P)		;SKIP RETURN
	DMOVE P1,-5(P)
	DMOVE P3,-3(P)
	DMOVE P5,-1(P)		;RESTORE THEM ALL
	ADJSP P,-6		;FIX UP STACK
	RET			;AND RETURN
.SAV3::				;USED BY ACVAR FACILITY
SAVQ::	ADJSP P,3		;NEED TO SAVE 3 REGS
	DMOVEM Q1,-2(P)		;SAVE Q1 AND Q2
	MOVEM Q3,0(P)		;SAVE Q3
	PUSHJ P,0(CX)		;CONTINUE ROUTINE, EXIT VIA .+1
RESTQ::	 SKIPA			;NON-SKIP RETURN
	AOS -3(P)		;SKIP RETURN
	DMOVE Q1,-2(P)		;RESTORE Q1 AND Q2
	MOVE Q3,0(P)		;RESTORE Q3
	ADJSP P,-3		;CLEAN UP THE STACK
	RET

   IFN Q3+1-P1,<PRINTX SAVPQ REQUIRES P1 TO FOLLOW Q3>

SAVPQ::	ADJSP P,11		;GET STACK SPACE
	DMOVEM Q1,-10(P)
	DMOVEM Q3,-6(P)
	DMOVEM P2,-4(P)
	DMOVEM P4,-2(P)
	MOVEM P6,0(P)
	PUSHJ P,0(CX)		;CONTINUE ROUTINE, RETURN VIA .+1
RESTPQ:: SKIPA			;NON-SKIP RETURN
	AOS -11(P)		;SKIP RETURN
	MOVSI P6,-10(P)		;SET UP FOR BLT
	HRRI P6,Q1
	BLT P6,P6
	ADJSP P,-11		;FIX UP STACK
	RET

;SAVE/RESTORE TEMP ACS

SAVT::	ADJSP P,4		;NEED FOUR LOCATION
	DMOVEM T1,-3(P)		;SAVE T1 AND T2
	DMOVEM T3,-1(P)		;SAVE T3 AND T4
	PUSHJ P,0(CX)		;CONTINUE ROUTINE, RETURN VIA .+1
RESTT::	 SKIPA			;NO-SKIP RETURN
	AOS -4(P)		;PASS ALONG SKIP RETURN
	DMOVE T1,-3(P)		;RESTORE T1 AND T2
	DMOVE T3,-1(P)		;RESTORE T3 AND T4
	ADJSP P,-4		;CLEAN UP THE STACK
	RET
;VARIOUS AC SAVE COMBINATION - INVOKED BY SAVEAC MACRO

.SAV24::PUSH P,T2
	PUSH P,T3
	PUSH P,T4
	PUSHJ P,0(CX)
	 TRNA
	AOS -3(P)
	POP P,T4
	POP P,T3
	POP P,T2
	RET

.SAV34::PUSH P,T3
	PUSH P,T4
	PUSHJ P,0(CX)
	 TRNA
	AOS -2(P)
	POP P,T4
	POP P,T3
	RET

.SAV44::PUSH P,T4
	PUSHJ P,0(CX)
	 TRNA
	AOS -1(P)
	POP P,T4
	RET

.SAV33::PUSH P,T3
	PUSHJ P,0(CX)
	 TRNA
	AOS -1(P)
	POP P,T3
	RET

.SAV22::PUSH P,T2
	PUSHJ P,0(CX)
	 TRNA
	AOS -1(P)
	POP P,T2
	RET

.SAV11::PUSH P,T1
	PUSHJ P,0(CX)
	 TRNA
	AOS -1(P)
	POP P,T1
	RET

.SAV12::PUSH P,T1
	PUSH P,T2
	PUSHJ P,0(CX)
	 TRNA
	AOS -2(P)
	POP P,T2
	POP P,T1
	RET

.SAV13::PUSH P,T1
	PUSH P,T2
	PUSH P,T3
	PUSHJ P,0(CX)
	 TRNA
	AOS -3(P)
	POP P,T3
	POP P,T2
	POP P,T1
	RET
;SUPPORT ROUTINES FOR AC VARIABLE FACILITY

.SAV1::	PUSH P,Q1
	PUSHJ P,0(CX)		;CONTINUE PROGRAM
	 SKIPA
	AOS -1(P)
	POP P,Q1
	POPJ P,

.SAV2::	ADJSP P,2		;NEED TWO WORDS OF STACK
	DMOVEM Q1,-1(P)		;SAVE REGS
	PUSHJ P,0(CX)
	 SKIPA
	AOS -2(P)
	DMOVE Q1,-1(P)		;RESTORE REGS
	ADJSP P,-2		;CLEAN UP STACK
	POPJ P,

.SAV4::	ADJSP P,4		;NEED TO SAVE FOUR REGS
	DMOVEM Q1,-3(P)		;SAVE Q1 AND Q2
	DMOVEM Q1+2,-1(P)	;SAVE Q3 AND P1
	PUSHJ P,0(CX)
	 SKIPA
	AOS -4(P)
	DMOVE Q1,-3(P)		;RESTORE Q1 AND Q2
	DMOVE Q1+2,-1(P)	;RESTORE Q3 AND P1
	ADJSP P,-4		;CLEAN UP THE STACK
	POPJ P,

.SAV8::	ADJSP P,10		;NEED TO SAVE EIGHT REGS
	DMOVEM Q1,-7(P)
	DMOVEM Q1+2,-5(P)
	DMOVEM Q1+4,-3(P)
	DMOVEM Q1+6,-1(P)
	PUSHJ P,0(CX)
	 SKIPA
	AOS -10(P)
	DMOVE Q1+6,-1(P)
	DMOVE Q1+4,-3(P)
	DMOVE Q1+2,-5(P)
	DMOVE Q1,-7(P)
	ADJSP P,-10		;CLEAN UP THE STACK
	POPJ P,
		SUBTTL PI system initialization

;Set up XPCW as non-vectored interrupt instruction in the EPT for each level.
;Place address of processing routine in 4th word of XPCW block

PIINIT::MOVSI 4,-NPISET
PII1:	HRRZ 1,PISETT(4)	;E OF JSYS WHICH WOULD BE USED
	HLRZ 2,PISETT(4)	;WHERE IT SHOULD GO
	HLRZ 3,0(1)		;OLD PC ADR FROM C(E)
	HRLI 3,<XPCW>B53	;CONSTRUCT A XPCW
	MOVEM 3,KIEPT(2)
	HRRZ 2,0(1)		;JUMP ADR FROM C(E)
;**;[2968]  Add 1 line after PII1:+5			DML	7-JUN-83
	HRRZ 3,3		;[2968] CLEAR OUT LEFT HALF TO AVOID ILFPTE
	SETZM 2(3)		;CLEAR OUT FLAGS WORD
	MOVEM 2,3(3)		;SETOR TO ADDRESS IN INTERRUPT BLOCK
	AOBJN 4,PII1

;Set up instructions for front end to execute on power failure and
;keep-alive cease

	MOVE 1,[JRST PWRRST]	;INITIALIZE LOCATION EXECUTED BY FRONT END
	MOVEM 1,PWRTRP		; ON POWER FAILURE
	MOVE 1,[XPCW RLODPC]	;INITIALIZE LOCATION EXECUTED BY FRONT END
	MOVEM 1,RLDADR		; ON KEEP-ALIVE CEASE
	SETZM FEFLG		;FORCE SECONDARY PROTOCOL
   IFN KLFLG,<
	SKIPL PWRDWN		;DOING POWER-FAIL RESTART
	CALL DTEINS		;START MONITOR IN SECONDARY PROTOCOL
	CALL MEMLOK		;LOOKUP MEMORY TYPES
   >				;END IFN KLFLG
DOCLCK:	CALL CLKINI		;INIT INTERVAL TIMER, ETC.
   IFN KLFLG,<

;CLEAR THE AN20 (IF IT IS THERE) BEFORE WE TRUN ON THE PI SYSTEM
;IT ENDS UP THAT THE AN20 DOES NOT CLEAR ITS INTERUPTS ON A BUS RESET
;IF THERE IS A TRANSFER IN PROGRESS AT THE TIME OF THE LAST CRASH, WE
;COULD HANG THE SYSTEM FOR A VERY LONG TIME.

;	CONO ANO,0		;TURN OFF OUTPUT SIDE
	CONO 524,0
;	CONO ANI,ANIRST		;CLEAR DEVICE
	CONO 520,200000
;	CONO ANI,ANXVAR		;HAVE TO POINT TO WHERE HOST READY IS
	CONO 520,200
;	DATAO ANI,[<0*ANIHRL>+MSEC1B+ANIVIL]	;CLEAR READY, LEAVE
				; LEAVE INTERRUPT ADDRESS ALONE.
	DATAO 520,[0]

	CONOAPR APFCLR+APSBER+APNXM+APIOPF+APMPE+APAPE+APPWF
	CONO PI,PICHON+PIPION+PICHNM
	CONOAPR APFEN+APSBER+APNXM+APIOPF+APMPE+APCDPE+APAPE+APPWF
   >				;END IFN KLFLG
   IFN SMFLG,<
	CONOAPR APFCLR+APNXM+APHMP+APSMP+APTMR+APPWF
	CONO PI,PICHON+PIPION+PICHNM
	CONOAPR APFEN+APNXM+APPWF+APINK
	CALL RQTAD1		;INIT CLOCKS
   >				;END IFN SMFLG

;Set up for LUUO from EXEC section 0. This causes location 41 to be
;executed. This will lead to a BUGHLT.

	MOVE 1,[XPCW LUUBLK]	;SET UP BUGHLT FOR LUUO'S
	MOVEM 1,41
	MOVE 1,[LUUBUG]		;SET UP XPCW BLOCK
	MOVEM 1,LUUBLK+3
	RET

RS JFDAY,1			;JIFFIES PER DAY - USED IN GTAD, STAD
RS JFDAY2,1			;JIFFIES/DAY/2 - FOR ROUNDING
;FIND MEMORY TYPES AND BUILD TABLE

   IFN KLFLG,<
MEMLOK:	MOVSI T1,-40		;# OF CONTROLLERS
MEMLK1:	MOVEI T2,1		;FUNC 1
	DPB T1,[POINT 5,T2,4]	;SET CONTROLLER NUMBER
	SBDIAG T2		;GET BOUNDS
	LOAD T2,MEMTYP,T3	;GET MEM TYPE
	CAIE T2,MA20
	CAIN T2,MB20
	JRST MEMLK5		;MA/MB HAVE UPPER LOWER BOUNDS
	CAIN T2,MOS
	JRST MEMLK6		;MOS MUST BE POLLED
MEMLK4:	AOBJN T1,MEMLK1		;CHECK ALL CONTROLLERS
	RET			;NOW, BIT OFF MEANS EXT OR NON-EX

MEMLK5:	TRNN T3,ARQENB		;ANY REQUESTS ENABLED?
	JRST MEMLK4		;NO, SKIP THIS ONE
	LDB T2,[POINT 8,T3,21]	;GET LOWER BOUND
	LDB T3,[POINT 4,T3,25]	;GET UPPER BOUND
	SUBI T3,(T2)
	ANDI T3,17		;GET NUMBER OF HUNKS - 1
	MOVNI T3,1(T3)		;MAKE IT - NUMBER OF HUNKS
	HRL T2,T3		;MAKE AOBJN POINTER
MEMLK2:	HRRZ T3,T2		;HUNK # IN T3
	CALL STHUNK
	AOBJN T2,MEMLK2		;NEXT HUNK
	JRST MEMLK4

MEMLK6:	TXNE T3,MOSDBL		;DISABLED?
	JRST MEMLK4		;YES, SKIP IT
	MOVEI T2,12		;FUNC 12
	DPB T1,[POINT 5,T2,4]	;SET CONTROLLER NUMBER
MEMLK7:	SBDIAG T2
	TXNE T3,MFBXDS		;DESELECTED?
	JRST MEMLK8		;YES, SKIP
	LDB T3,[POINT 8,T2,27]	;GET BOX #
	CALL STHUNK		;SET BIT FOR HUNK
MEMLK8:	ADDI T2,1B27		;INC BOX #
	TXNN T2,1B19		;OVERFLOWED?
	JRST MEMLK7		;NO, KEEP GOING
	JRST MEMLK4

;CALL WITH 16K HUNK # IN T3
STHUNK:	CAIL T3,NMD16K		;LEGAL HUNK?
	RET
	IDIVI T3,^D36		;GET WORD AND BIT #
	MOVE T4,BITS(T4)	;GET BIT
	IORM T4,MEMTAB(T3)	;AND LIGHT IT
	RET
   >				;END IFN KLFLG
;Table for initializing unvectored interrupt locations in the EPT
;Indexed by level -- RH is routine to go to on interrupt.
;PIINIT uses this table to set up locations 40+2*n in the EPT
;Some levels are never expected to generate unvectored interrupts;
;an interrupt on any such level produces a BUGCHK.

DEFINE PILC (C,A)<
	XWD 40+2*C,A>

PISETT:	PILC 1,PIERR1		;NO UNVECTORED INTERRUPTS DEFINED
	PILC 2,PIERR2		;NO UNVECTORED INTERRUPTS DEFINED
	PILC APRCHN,PIAPR	;APR CHANNEL
	PILC 4,PIERR4		;GENERAL CHANNELS
	PILC 5,PISC5
	PILC 6,PISC6
	PILC 7,PISC7
NPISET==:.-PISETT

RS PIAPRX,4
RS PI1AC1,2

; UNEXPECTED UNVECTORED INTERRUPTS - ERROR HANDLING

;Level 1 -- no unvectored interrupts defined.

PIERR1:	XWD PI1ER,.+1
	PIOFF
	DMOVEM CX,PIXCX
	MOVE P,[IOWD XPISK,PIXSTK]
	BUG (PI1ERR)
	CLSB 1			;CLEAR THE INTERRUPT ON 1
	DMOVE CX,PIXCX
	PION
	XJEN PI1ER		;DISMISS INTERRUPT AND RETURN
 RS PI1ER,4			;XPCW block, initialized by PIINIT

;Level 2 -- no unvectored interrupts defined.

PIERR2:	XWD PI2ER,.+1
	PIOFF
	DMOVEM CX,PIXCX
	MOVE P,[IOWD XPISK,PIXSTK]
	BUG (PI2ERR)
	CLSB 2			;CLEAR THE INTERRUPT ON 2
	DMOVE CX,PIXCX
	PION
	XJEN PI2ER		;DISMISS INTERRUPT AND RETURN
 RS PI2ER,4			;XPCW block, initialized by PIINIT
;Level 4 -- no unvectored interrupts defined.

PIERR4:	XWD PI4ER,.+1
	PIOFF
	DMOVEM CX,PIXCX
	MOVE P,[IOWD XPISK,PIXSTK]
	BUG (PI4ERR)
	CLSB 4			;CLEAR THE INTERRUPT ON 4
	DMOVE CX,PIXCX
	PION
	XJEN PI4ER		;DISMISS INTERRUPT AND RETURN
RS PI4ER,4			;XPCW block, initialized by PIINIT

;Here when monitor executes an LUUO in section 0. XPCW block is set
;up by PIINIT.

LUUBUG:	BUG(LUUMN0)
RS LUUBLK,4			;LUUO BLOCK FOR XPCW
;PIRST - Clear PI system via CONO PI

;IORST - Reset IO and clear hardware error flags (via CONO APR),
;	 Turn off paging (via CONO PAG)
;	 Save state of cache in CASHF (-1 for on, 0 for off)
;	 Set UPT to special scheduler copy (via DATAO PAG)
;NOTE:	 This routine does not change the page number of the EPT

   IFN KLFLG,<
PIRST::	CONO PI,PICLPI
IORST::	JSP T1,[MOVEM T1,CONOPG	;SAVE AN AC
		CONI PAG,T1	;READ THE CACHE BITS
		ANDI T1,PGCLKE!PGCLDE!PGEBRM	;CLEAR ALL BUT CACHE & EBR
		SETZM CASHF	;INITIALIZE CACHE FLAG
		TRNE T1,PGCLKE!PGCLDE	;IS CACHE ON?
		SETOM CASHF	;YES, REMEMBER THAT
		EXCH T1,CONOPG	;SAVE THE PAGER CONO BITS
		CONO APR,APIOPR+APFCLR+APSBER+APNXM+APIOPF+APMPE+APAPE+APPWF+APSWPD
;**;[2968]  Add 1 line after IORST::+8			DML	7-JUN-83
		CONSO PAG,PGTPEN	;[2968] DO NOT TURN OFF IF ON
		CONO PAG,@CONOPG ;CLEAR PAGING AND CACHE
		DATAO PAG,KIPGW0	 ;USE SCHED CONTEXT UPT
		JRST 0(T1)]
   >				;END IFN KLFLG
   IFN SMFLG,<
PIRST::	CONO PI,PICLPI
IORST::	JSP T1,[MOVEM T1,CONOPG	;SAVE AN AC
		MOVEI T1,HSBADR	;SET UP HALT STATUS BLOCK TO HSBADR
		WRHSB T1	;WRITE HALT STATUS BLOCK ADDRESS
		CONI PAG,T1	;GET CURRENT EPT BASE
		ANDI T1,PGEBRM	;CLEAR ALL ELSE
		IORI T1,PGKLMD	;TURN ON KL PAGING ALWAYS
		EXCH T1,CONOPG	;SAVE THE PAGER CONO BITS
		CONO APR,APIOPR+APFCLR+APHMP+APSMP+APTMR
		CONO PAG,@CONOPG ;MAKE SURE KL PAGING IS ON
		DATAO PAG,KIPGW0 ;USE SCHED CONTEXT UPT
		JRST 0(T1)]
   >				;END IFN SMFLG


;RESTORE APR PI ASSIGNMENT

SETPPI::CONOAPR 0
		SUBTTL APR INTERRUPT SERVICE

;Here on APR interrupt.

   IFN KLFLG,<
PIAPR:	XWD PIAPRX,.+1
	MOVEM A,PI1AC1
	CONSZ APR,APPWF		;POWER FAIL?
	JRST [	CONOAPR APFDIS+APPWF ;YES, DISABLE FLAG
		AOS PWRDWN	;NOTIFY SCHED, ETC.
		AOS SKEDF3	;SIGNAL SCHED TO DO SOMETHING NOW
		ISB SCDCHN	; ""
		JRST OV0]	;DEBREAK
	MOVEM P,PI1AC1+1	;SAVE P
;	MOVEI P,^D10000
;	SOJG P,.		;WAIT FOR CONDITIONS TO SETTLE
	MOVE P,[IOWD NMEMPP,MEMPP] ;GET A STACK FOR STATUS BLOCK
	MOVEI T1,APRBUG-BUGBUG	;GET TYPE OF ERROR
	PUSH P,CX		;SAVE THIS REG AS WELL
	CALL GENBLK		;DO ERROR REPORTING IF ENABLED
	POP P,CX		;RESTORE CX
	MOVE P,PI1AC1+1		;RESTORE INCOMING P

;Get the APR conditions and transfer according to them.

	CONI APR,A		;GET CONI BITS FOR POSSIBLE BUGHLT
	CONSZ APR,APIOPF	;IO PAGE FAIL?
	JRST APRIOP		;GO SEE ABOUT THE PAGE FAIL
	CONSZ APR,APAPE		;ADDRESS PARITY ERROR?
	JRST ADRPER		;YES. GO DO IT
	CONSZ APR,APNXM		;NXM?
	JRST P1NXM		;YES
	CLSB APRCHN		;CLEAR SOFTWARE REQUEST IF ANY
	CONSZ APR,APSBER	;SBUS ERROR?
	JRST SBSERR		;YES. GO POLL SBUS CONTROLLERS
	SKIPN DEVMPE		;DEVICE MPE REQUEST?
	CONSZ APR,APMPE		;MEM PAR ERROR?
	JRST MEMPAR		;YES. MEMORY SCAN
	CONSZ APR,APCDPE	;CACHE DIR PARITY ERROR?
	BUG(FATCDP,<<A,CONIAP>>)
	JRST OV0		;GO DEBREAK
;P1NXM - Here on NXM (APNXM set in CONI word)

P1NXM:	PIOFF			;OWN THE MACHINE
	DATAI PAG,MEMPDP	;SAVE STATE
	DATAO PAG,SETAPI	;SET APR STATE
	MOVE P,[IOWD NMEMPP,MEMPP] ;SET UP A STACK
	MOVEI T1,[SIXBIT '$$NXM DETECTED BY /']
	CALL APRCMN		;DO COMMON STUFF
	DATAO PAG,MEMPDP	;RESTORE REGS
	PION			;AND RESTORE MACHINE
	BUG(APRNX1)		;CAUSE A BUGHLT
	CONOAPR APFCLR+APSBER+APMPE ;CLEAR SUPRIOUS PARITY ERROR INDICATIONS
	CLNXMF			;CLEAR FLAG
	JRST OV0

;COMMON PROCESSING FOR NXM AND ADDRESS PARITY ERROR

APRCMN:	JSR BUGMON		;ENTER SECONDARY PROTOCOL
	JSR BUGMSG
	RDERA T2		;GET THE ERA
	MOVEI T1,[SIXBIT 'APR/'] ;ASSUME APR DETECTED ERROR
	TXNE T2,ER%CHN		;CHANNEL DETECTED?
	MOVEI T1,[SIXBIT 'CHANNEL/'] ;YES
	JSR BUGMSG		;SAY SO
	MOVEI T1,[SIXBIT ', ERA= /']
	JSR BUGMSG		;NEED TO OUPTUT THE ERA
	RDERA T1		;GET THE ERA
	CALL BUGWPT		;OUTPUT IT
	MOVEI T3,PI%SBA+MPISEB
	MOVEI T2,PI%MXS		;MAX SPACE FOR DATA
	CALL RDDIAG		;READ SBUS DIAGS
	HLL T1,T3		;GET COUNT
	HRRI T1,PI%SBA+MPISEB	;WHERE THEY ARE
	CALL PRISBS		;TYPE THEM OUT
	JSR BUGPRI		;RESTORE INCOMING PROTOCOL
	RET			;AND RETURN
;ADRPER - Address parity error (APAPE was on in CONI word)

ADRPER:	PIOFF			;OWN MACHINE
	DATAI PAG,MEMPDP	;SAVE STATE
	DATAO PAG,SETAPI	;GET APR STATE
	MOVE P,[IOWD NMEMPP,MEMPP] ;GET A STACK
	MOVEI T1,[SIXBIT '$$ADDRESS PARITY ERROR DETECTED BY /']
	CALL APRCMN		;DO COMMON CODE
	DATAO PAG,MEMPDP	;RESTORE REGS
	PION			;RESTORE MACHINE
	BUG (APRAPE)
	CONOAPR APFCLR+APAPE+APSBER ;CLEAR ERROOR
	CLNXMF			;CLEAR NXM INDICATORS
	JRST OV0		;AND TRY AGAIN
   >				;END IFN KLFLG

   IFN SMFLG,<
PIAPR:	XWD PIAPRX,.+1
	CONSZ APR,APTMR		;TIMER REQUEST?
	JRST TIMIN0		;YES -- GO DO TIMER
	CONSZ APR,APINK		;CTY INTERRUPT?
	JRST [	ISB DLSCHN	;REQUEST TERMINAL INTERRUPT
		CONO APR,APFCLR+APINK+APRCHN ;CLEAR INTERRUPTING FLAG
		XJEN PIAPRX]	;EXIT
	CONSZ APR,APPWF		;POWER FAIL?
	JRST [	CONO APR,APFDIS+APPWF ;YES, DISABLE FLAG
		AOS PWRDWN	;NOTIFY SCHED, ETC.
		CHKINT
		XJEN PIAPRX]	;DEBREAK
	CONSZ APR,APNXM		;NXM?
	JRST P1NXM		;YES
	CLSB APRCHN		;CLEAR SOFTWARE REQUEST IF ANY
	XJEN PIAPRX		;RETURN

P1NXM:	BUG(APRNX1)
	CONOAPR APFCLR+APHMP+APSMP ;CLEAR SUPRIOUS PARITY ERROR
	CLNXMF			;CLEAR FLAG
	XJEN PIAPRX
   >				;END IFN SMFLG
;EXIT FROM APR PI SERVICE

OV0::	MOVE 1,PI1AC1		;Restore saved AC
	XJEN PIAPRX		;Dismiss the interrupt

MSTKOV::BUG(STKOVF)

;FINAL PHASE OF POWERDOWN SEQUENCE, ENTERED FROM SCHED
;THIS WILL LOOP IN THE ACS UNTIL POWER ACTUALLY VANISHES.
;IF THE POWER FAIL INTERRUPT WAS SPURIOUS, THE LOOP WILL TIME OUT
;AFTER A FEW SECONDS AND THE SYSTEM WILL BE CONTINUED.

SCHPF0::PIOFF			;QUIET DOWN MACHINE
	SETOM PWRDWN		;SAYS WE FINISHED PWR DWN SEQUENCE
	DMOVE Q1,[SOJG T1,Q1	;PUT COUNT LOOP IN ACS
		JRST SCHPR2]
	MOVX T1,^D10000000	;INIT COUNT.  DEPENDING ON MACHINE
	JRST Q1			; SPEED, THIS WILL TAKE FROM 1 TO 20 SECS

;Timed out. BUGCHK and go restart as if front end had restarted us.

SCHPR2:	BUG(SPWRFL)
	JRST SYSRST		;GO RESTART IMMEDIATELY
;AUTO RESTART PROCEDURE.  HERE VIA PWRTRP (LOCATION 70) WHEN POWER
;RESTORED AFTER POWER FAILURE.

PWRRST::XCT PIRST		;RESET WORLD
	XCT IORST
	MOVE P,PI7P		;NEED A STACK TO CALL MONEPT
	CALL MONEPT		;SET EPT ADDRESS IN CONOPG
;**;[2969]  Add 1 line after PWRRST:+3			DML	9-JUN-83
	CONSO PAG,PGTPEN	;[2969] IF PAGING IS ON, PAGER KNOWS ABOUT EPT
	CONO PAG,@CONOPG	;TELL THE HARDWARE WHERE THE EPT IS
	JSR BUGMON		;SET TO SECONDARY PROTOCOL
	MOVEI 1,[SIXBIT '$ATTEMPTING AUTOMATIC RESTART.../']
	JSR BUGMSG
	SETZ Q1,		;CLEAR AC FOR TIME

;WAIT ONE MINUTE FOR DISKS ETC. TO COME UP AND TO BE SURE THE POWER
;IS REALLY GOING TO STAY ON.

	BUG(PWRRES)		;GIVE CHANCE TO LOOK AROUND
	SETO 1,
	CAMN 1,PWRDWN		;POWER FAIL SEQUENCE COMPLETED?
	JRST [	MOVEI 1,[SIXBIT '$ATTEMPTING TO CONTINUE SYSTEM$/']
		JSR BUGMSG	;YES, TELL CTY
		JRST SYSRST]	;GO RESTART

;We never got to shut down gracefully. Complain and then BUGHLT.

	MOVEI 1,[SIXBIT '$PWRDWN .NE. -1, RESTARTING...$/']
	JSR BUGMSG
	AOS INSKED		;BE SURE BUGHLT RESTARTS
	BUG(PWRFL) ;CRASH AND RELOAD
	HALT .			;SHOULD NEVER GET HERE, BUT IN CASE...
;I/O PAGE FAIL DETECTED. IF ON A KL10, SEE IF IT WAS CAUSED BY
;A MISCREANT FE

	IFN KLFLG,<		;IF THE KL

;Note Well....As of KL microcode version 275
;
;	IO Page Fails now return the IOP word in AC block 7 AC 2.
;	The IOP word will also be in TRAPS0.  If the IOPGF should
;	happen during the initial code of page fault handling before
;	TRAPS0 is saved in TRAPSW then the monitor will get very
;	confused.

IOPDEV==17B10			;DEVICE FIELD IN IOP WORD
IODTE0==10			;CODE FOR DTE0
IODTE3==13			;CODE FOR DTE3
IODIA==17			;IO BUS

APRIOP:	PIOFF			;PREVENT INTS
	DATAI PAG,MEMPDP	;SAVE CURRENT REG CONTEXT
	DATAO PAG,SETAPI	;GET APR INT LEVEL AC'S
	JSR BUGMON		;GET IN SECONDARY PROTOCOL
	MOVE P,[IOWD NMEMPP,MEMPP] ;BORROW PAR ERROR STACK
	UMOVE Q1,BK7IOP		;GET THE IOP WORD
	MOVEI T1,[SIXBIT "$$IO PAGE FAIL, IOP= /"]
	JSR BUGMSG		;TELL CTY
	MOVE T1,Q1
	CALL BUGWPT		;AND OUTPUT THE IOP
	MOVEI T1,[SIXBIT "$$/"]
	JSR BUGMSG		;MAKE IT PRETTY
	LOAD T1,IOPDEV,Q1	;GET DEVICE CODE
	CAIL T1,IODTE0		;CHECK FOR A DTE
	CAILE T1,IODTE3		;IS IT?
	IFSKP.			;IF SKIP, IT IS
	 SUBI T1,IODTE0		;COMPUTE DEVICE NUMBER
	 CAMN T1,MSTRDT		;IS THIS THE MASTER?
	 JRST APRFAT		;YES. CAN'T SHUT IT OFF
	 CALL DTEIOP		;SHUT OFF THE DTE
	ELSE.
	 CAIE T1,IODIA		;IS THE DEVICE ON THE IOBUS?
	 JRST APRFAT		;NO
	 LOAD T1,VPGNO,Q1	;GET VIRTUAL PAGE ADDRESS
	 CALL IMPFPF		;SEE IF AN20 DID IT
	  JRST APRFAT		;NO. CAN'T RECOVER THEN
	ENDIF.
APRIO0:	JSR BUGPRI		;ENTER PRIMARY PROTOCOL
;	MOVEI T1,IOBUG-BUGBUG	;INDEX TO PROPER MESSAGE
;	CALL GENBLK		;REPORT THE PROBLEM
	CONOAPR APFCLR+APIOPF	;TURN OFF THE INDICATOR
	DATAO PAG,MEMPDP	;GET BACK ORIGINAL AC BLOCK
	PION			;TURN ON INTS
	JRST OV0		;AND LET IT GO
   >				;END OF IFN KLFLG

;Could not find the reason for the IO page fail, or the condition
;was caused by something we can't proceed without having.

APRFAT:	BUG(IOPGF,<<Q1,IOP>>)

;BUGHLT GOTTEN TO BY AN XCT 71 DONE BY THE FE (OR THE OPERATOR)
;ON A KEEP ALIVE CEASED. THE PC IS IN RLODPC AND RLODPC+1

RLDHLT::BUG(KPALVH)
;ROUTINE USED BY PHYSIO TO OUTPUT RH20/CHANNEL MEMORY
;ERROR INFORMATION
;	T1/ CHANNEL NUMBER
;	T2/ LOGOUT STATUS WORD
;	T3/ UPDATED CCW
;STACK MUST BE SET UP
;REGRETTABLY CLOBBERS T1-T4

   IFN KLFLG,<			;ONLY NEEDED FOR THE KL
APRRPT::SAVEQ
	DMOVE Q1,T1		;SAVE ARGS
	MOVE Q3,T3		;SAVE ALL OF THEM
	PIOFF			;OWN MACHINE
	JSR BUGMON		;REALLY OWN IT
	MOVEI T1,[SIXBIT '$$RH20 OR CHANNEL DETECTED MEMORY ERROR$CHANNEL /']
	JSR BUGMSG		;DO THE MESSAGE
	MOVE T1,Q1		;GET CHANNEL #
	CALL BUGOPT		;PRINT IT
	MOVEI T1,[SIXBIT '$CHANNEL STATUS WORD /']
	JSR BUGMSG
	MOVE T1,Q2		;GET WORD
	CALL BUGWPT		;TYPE IT
	MOVEI T1,[SIXBIT '$FINAL CCW /']
	JSR BUGMSG
	MOVE T1,Q3		;GET FINAL CCW
	CALL BUGWPT
	MOVEI T1,[SIXBIT '$$/']
	JSR BUGMSG		;MAKE OUTPUT PRETTY
	JSR BUGPRI		;TURN ON FE
	PION			;TURN ON PIS
	RET			;AND DONE
   >				;END OF IFN KLFLG
		SUBTTL Memory Parity Error routines

   IFN KLFLG,<
;MEMPAR - MEMORY PARITY ERROR DETECTED

;Here when APR interrupt occurs with bit 27 (MB parity error) set or
;when APR interrupt occurs with bit 24 (SBUS error) set but no MOS
;controller reports a correctable error

MEMPAR::PIOFF
	DATAI PAG,MEMPDP	;SAVE CURRENT AC BLOCK NUMBERS
	DATAO PAG,SETAPI	;SET TO APR AC'S
	MOVE P,[IOWD NMEMPP,MEMPP]
	CONSO APR,APMPE		;MB PARITY ERROR?
	JRST MEMPRX		;NO
	RDERA T1		;GET ERROR INFORMATION
	TXC T1,ER%CHN!ER%WRT	;SEE IF "CHANNEL WRITE" ERROR
	TXNE T1,ER%CHN!ER%WRT	;IS IT?
	JRST MEMPRX		;NO. DO NORMAL PROCESSING

;A CHANNEL WRITE PARITY ERROR HAPPENED. GATHER INFORMATION

	LDB T2,[POINT 2,T1,1]	;GET WORD OFFSET
	ANDX T1,<PHCPNO!PGWD>	;GET PHYSICAL ADDRESS
	IORI T1,0(T2)		;PUT IN WORD OFFSET
	SKIPN T2,WREQ		;ANY QUEUED ENTRIES?
	JRST MEMRXX		;NO
MEMRX0:	CAMN T1,1(T2)		;ALREADY QUEUE?
	JRST NOBLK0		;YEP
	MOVE T2,0(T2)		;GET NEXT
	JUMPN T2,MEMRX0
MEMRXX:	PUSH P,T1		;SAVE ERA
	MOVX T1,<.RESP1,,3>
	MOVEI T2,.RESGP		;SPACE FROM GENERAL POOL
	CALL ASGRES		;GET SOME SPACE
	 JRST [	MOVEI T1,[SIXBIT '$?No free space for channel error$/']
		CALL MEMOUT
		JRST MEMNBK]
	POP P,1(T1)		;SAVE ERROR ADDRESS
	MOVE T2,TODCLK		;TIME
	MOVEM T2,2(T1)		;TIME STAMP
	EXCH T1,WREQ		;ENQUEUE IT
	MOVEM T1,@WREQ		;""

;ADDRESS IS QUEUED ON THE ERROR QUEUE AND ACCOUNTED FOR

MEMNBK: MOVEI Q3,MPISEB		;BLOCK TO STORE ERROR INFORMATION
	CALL PARGER		;GET ERROR STUFF INTO BLOCK
	MOVEI P1,0(T1)		;SAVE COUNT
	ADDI T1,PI%SZ2		;COMPUTE WORDS TO PUT IN SYSERR
	MOVE T2,T1		;COPY WORD COUNT
	CALL ALCSEB		;GET SYSERR BLOCK
	 JRST [	MOVEI T1,[SIXBIT '$? No SYSERR block on channel error$/']
		CALL MEMOUT
		JRST NOBLK0]
	PUSH P,T1		;SAVE BLOCK ADDRESS
	ADDI P1,SEBDAT+PI%SZ2-1(T1) ;WORDS TO MOVE
	MOVEI T1,SEBDAT(T1)	;START OF DEST.
	HRL T1,Q3
	BLT T1,0(P1)		;COPY DATA
	MOVE T1,0(P)
	MOVE T2,[-NMEMPT,,MEMPT]
	CALL SEBCPY		;FINISH OFF DATA COPYING
	 NOP
	POP P,T1
	CALL QUESEB		;AND QUEUE IT
NOBLK0:	CONOAPR APFCLR+APMPE	;CLEAR CONDITION
	CONSO APR,APSBER	;SBUS ERROR PENDING?
	CALL UNLCON		;NO
NOBLKS:	DATAO PAG,MEMPDP	;RESTORE STATE
	PION			;AND PIS
	JRST OV0		;AND DONE
;Routine to output a message in secondary protocol

MEMOUT:	ASUBR <ERRSTR>
	JSR BUGMON		;STOP MACHINE
	MOVE T1,ERRSTR
	JSR BUGMSG		;DO MESSAGE
	JSR BUGPRI		;BACK TO PRIMARY
	RET			;AND DONE
;NOT A CHANNEL WRITE PARITY ERROR. DO NORMAL PROCESSING

MEMPRX: MOVE T1,MPITIM		;GET TIME OF LAST ERROR
	ADDI T1,^D5000		;PROJECT INTO THE FUTURE
	CAMLE T1,TODCLK		;WITHIN 5 SECS OF LAST ERROR?
	JRST [	CLRMPE		;YES. SKIP THIS ONE
		JRST NOBLKS]	;DONE
	SETZM MEMPFF		;CLEAR FATAL ERROR FLAG
	PUSH P,UPTPFO		;SAVE PAGE TRAP VARIABLES
	PUSH P,UPTPFL
	PUSH P,UPTPFN
	PUSH P,UPTPFW
	XPSHUM [PUSH P,BK7PFD]	;SAVE BAD DATA WORD AS WELL
	MOVEI T1,MEMPTP		;SETUP LOCAL TRAP ROUTINE
	MOVEM T1,UPTPFN
	MOVEI Q3,MPISEB		;SETUP BLOCK TO RECEIVE SYSERR INFO
	CALL PARGER
	MOVE P1,T1		;SAVE COUNT
	CONSO APR,APMPE		;AN MB PARITY ERROR?
	AOS MEMPFF		;NO. REMEMBER THIS
MEMPR0:	CONOAPR APFCLR+APMPE	;CLEAR CONDITION

	; ..
;MEMORY SCAN LOOP. THIS IS EXECUTED ONLY FOR MB PARITY ERRORS DETECTED
;BY THE APR OR BY A CHANNEL READ. THE PAGE CONTAINING THE BAD
;ADDRESS (FROM THE ERA) IS SCANNED FOR ERRORS.

	; ..
	LOAD P2,PHCPNO,PI%ER2(Q3); GET ERROR PAGE
	LOAD T1,CSTAGE,(P2)	;GET AGE OF THIS PAGE
	LOAD T2,CSTPST,(P2)	;GET STATE
	CAIE T1,PSSPQ		;ON SPECIAL MEM QUEUE?
	CAIN T2,PSTERR		;NO. ALREADY HAVE AN ERROR?
	JRST MEMP45		;YES. NO SCAN THEN
	MOVE T1,CONOPG
	TXZ T1,PGCLDE		;TURN CACHE LOAD OFF
	CONO PAG,0(T1)
	MOVSI Q1,-PGSIZ		;LOOP COUNTER
	PUSH P,CST0(P2)		;SAVE CST0 FOR THIS PAGE
	MOVX T2,PSASM		;SET CST0 TO ALLOW ACCESS TO PAGE
	IORM T2,CST0(P2)
	MOVE T1,P2
	CALL MAPRCA
	MOVE T4,T1		;SAVE VIRT ADR WHERE MAPPED
	HRLI T4,T3		;MAKE IT INDEXED BY T3
MEMP3:	CALL MEMPXX		;DO THE REFERENCE
	CONSZ APR,APNXM		;NXM?
	JRST MEMP44		;YES. DONE THEN
	CONSZ APR,APMPE+APSBER	;MPE IN THIS LOCATION?
	JRST MEMP1		;YES, GO REPORT IT
MEMP4:	AOBJN Q1,MEMP3 		;DO NEXT LOCATION
MEMP44:	POP P,CST0(P2)		;RESTORE CST0
	CONO PAG,@CONOPG	;RESTORE CACHE STATE
	; ..
	; ..
MEMP45:	CONSO APR,APSBER	;SBUS ERROR PENDING?
	CALL UNLCON		;NO. CLEAR CONTROLLERS THEN
	MOVEI T1,PI%SZ2
	MOVE T2,P1		;WORDS USED IN SBDIAGS
	ADDB T1,T2		;COMPUTE WORDS NEEDED
	CALL ALCSEB		;ALLOCATE SYSERR DATA BLOCK
	 JRST [	MOVEI 1,[SIXBIT '?NO SYSERR BUFFER FOR MB PARITY ERROR$$/']
		CALL MEMOUT
		JRST MEMP10]	;SKIP SYSERR STUFF
	MOVEM T1,Q1		;SAVE SYSERR BUFFER ADDRESS
	MOVE T2,P1		;WORDS USED IN SBDIAGS
	ADDI T2,SEBDAT+PI%SZ2-1(T1) ;COMPUTE END OF DATA
	MOVEI T1,SEBDAT(Q1)
	HRL T1,Q3		;COPY DATA INTO SYSERR BUFFER
	BLT T1,0(T2)
	MOVE T1,Q1
	MOVE T2,[-NMEMPT,,MEMPT]
	CALL SEBCPY		;INCLUDE EVENT CODE
	 JFCL
	MOVE T1,Q1
	CALL QUESEB		;QUEUE SYSERR BLOCK
MEMP10:
	XPOPMU [POP P,BK7PFD]	;RESTORE BAD DATA WORD
	POP P,UPTPFW		;RESTORE PAGE TRAP VARIABLES
	POP P,UPTPFN
	POP P,UPTPFL
	POP P,UPTPFO
	; ..
;ALL DONE. RESTORE PROPER PROTCOLS

;	MOVEI T1,MBBUG-BUGBUG	;INDEX TO PROPER MESSAGE
;	CALL GENBLK		;REPORT STATUS
	CALL UPDTCK		;UPDATE TODCLK NOW
	DATAO PAG,MEMPDP	;RESTORE AC BLOCK SETTING
	PION
;	BUG(MPEDEV)
	SKIPE MEMPFF		;FATAL ERRORS FOUND?
	JRST MEMP8		;YES
	SETZM DEVMPE
	MOVE T1,TODCLK		;GET NOW
	MOVEM T1,MPITIM		;SET TIME OF MP INTERRUPT
	JRST OV0		;CONTINUE RUNNING

MEMP8:	BUG(FATMER)

MEMPT:	SEBPTR 0,SBTEVC,SEC%P1	;EVENT CODE
	SEBPTR 0,SBTFNA,MEMPJ0	;joB 0 CLEANUP ROUTINE
NMEMPT==.-MEMPT

;TEST REFERENCE TO CHECK FOR PARITY ERROR

MEMPXX:	LOAD T3,PGWD,Q1		;GET WORD WITHIN CURRENT PAGE
MEMPXY:	MOVE T1,@T4
	RET

;LOCAL PAGE TRAP ROUTINE. WE EXPECT TO COME HERE WHEN A REFERENCE GENERATES
;AN ERROR DURING THE MEMORY SCAN. PC SHOULD POINT TO MEMPXY.
;IF NOT, SOME OTHER ERROR OCCURRED.

MEMPTP:	SKIPE EXADF1		;EXTENDED ADDRESS?
	JRST MEMPT1		;YES. ALL SET THEN
	HLLZ T1,UPTPFO		;NO. MUST CONVERT
	MOVEM T1,UPTPFL		;STORE FLAGS
	HRRZS UPTPFO		;AND ISOLATE PC
MEMPT1:	HRRZ T1,UPTPFO		;CHECK PC OF TRAP
	CAIE T1,MEMPXY		;FROM EXPECTED PLACE?
	CALL MEMXXX
	CONOAPR APFSET+APMPE	;make damn sure bit is set
	AOS UPTPFO		;SIMULATE COMPLETION OF INSTRUCTION
	UMOVE T1,BK7PFD		;GET BAD DATA FROM AC BLOCK 7
	XJRSTF UPTPFL		;UNTRAP

;Common error place for unexpected page fault. To figure out which
;page fault routine was working, look at UPTPFN!!!

MEMXXX:BUG(UNPGF1)		;ERROR!
;FOUND MEM PAR ERR ON DIRECT REFERENCE
; T4/ 3,,ADDRESS
MEMP1:
	PUSH P,T4		;SAVE MAP ADDRESS
	CONOAPR APFCLR+APMPE	;CLEAR APR PE BITS
	MOVE T4,P2		;GET PAGE NUMBER
	LSH T4,PGSFT		;MAKE IT AN ADDRESS
	ADDI T4,0(Q1)		;AND WITH THE RIGHT WORD
	ANDM T1,PI%AD2(Q3)	;COMPUTE LOGICAL AND/OR OF DATA AND ADR
	IORM T1,PI%OD2(Q3)
	ANDM T4,PI%AA2(Q3)
	IORM T4,PI%OR2(Q3)
	MOVE Q2,PI%ERC(Q3)	;GET ERROR COUNT
	AOS PI%ERC(Q3)		;BUMP IT
	CAIL Q2,PI%NB2		;REPORTED MAX NUMBER ERRORS?
	JRST MPEX1		;YES, DON'T REPORT THIS ONE
	ADD Q2,Q3		;OFFSET TO SYSERR BLOCK
	MOVEM T1,PI%DA2(Q2)	;SAVE DATA
	MOVEM T4,PI%BAD(Q2)	;SAVE ADDRESS
	LOAD T1,PHCPNO,T4	;GET PAGE NUMBER
	CCHUO 0(T1)		;UNLOAD CACHE FOR PAGE
	CONSO APR,APSWPD	;WAIT FOR COMPLETION
	JRST .-1
	CONOAPR APFCLR+APSWPD+APMPE
	CALL MEMPXX		;TRY REFERENCE WITHOUT CACHE
	CONSZ APR,APMPE+APSBER	;ERROR?
	JRST [	SETONE PI%FAT,PI%BAD(Q2) ;YES. MARK HARD ERROR THEN
		JRST MEMP11]	;AND PROCEED
	MOVEM T1,PI%MDA(Q2)	;NO, SAVE DATA
MEMP11:	CONOAPR APFCLR+APMPE	;CLEAR CONDITION
				;END NOCACHE TEST
MPEX1:
	POP P,T4		;RESTORE ADDRESS
	JRST MEMP4		;CONTINUE CORE SCAN
;common code to setup SYSERR block and gather processor info
;Entered with Q3/Pointer to SYSERR block

;returns +1 T1/ count of words used

PARGER:	CONI APR,PI%CN2(Q3)	;GATHER ERROR INFO, CONI...
	CONSZ APR,APMPE		;MB PARITY ERROR?
	RDERA PI%ER2(Q3)	; ...ERA...
	DMOVE T1,PIAPRX		; ...PC...
	MOVEM T1,PI%FL2(Q3)	;STORE FLAGS
	MOVEM T2,PI%PC2(Q3)	;STORE PC

	SETZM PI%ERC(Q3)	;INIT ERROR COUNT
	SETZM PI%OR2(Q3)	;INIT LOGICAL AND/OR WORDS
	SETZM PI%OD2(Q3)
	SETOM PI%AA2(Q3)
	SETOM PI%AD2(Q3)

;READ SBUS DIAG INFO FOR ALL CONTROLLERS

	MOVEI T1,PI%DA2(Q3)	;BAD ADDRESS BLOCK
	HRLI T1,-PI%NB2		;# OF ENTRIES
	SETZM 0(T1)
	AOBJN T1,.-1		;ZERO THE BLOCK
	MOVEI T3,PI%SBA(Q3)	;SBDAG DATA ADDRESSES
	MOVEI T2,PI%SBA		;GET OFFSET
	MOVEM T2,PI%SB2(Q3)	;POINTER TO OFFSET
	MOVEI T2,PI%MXS		;MAX AREA FOR SBDIAGS
	CALL RDDIAG		;READ SBUSDIAG'S
	HLLM T3,PI%SB2(Q3)	;SAVE COUNT OF CONTROLLERS FOUND
	MOVE T1,T2
	RET
;ROUTINE TO READ SBUSDIAG DATA INTO A BUFFER
;ACCEPTS:	T3/ FIRST ADDRESS TO USE
;		T2/ COUNT OF WORDS AVAIALABLE
;RETURNS:	+1 ALWAYS

RDDIAG:	SAVEAC <Q3,P1>
	MOVSI T4,-PI%MXS/2	;SETUP NUMBER OF CONTROLLERS
	SETZM T1		;INIT CONTROL WORD
	MOVNI Q3,-<SBSMAX+1>(T2) ;WORDS AVAILABLE
	HRLZS Q3		;COMPUTE AOBJN WORD
MEMPS1:	SETZM T1		;SET UP TO READ FUNCTIONS
	DPB T4,[POINT 5,T1,4]	;SET CONTROLLER NUMBER
	SBDIAG T1		;DO FIRST FUNCTION, DATA TO T2
	CAMN T2,[-1]		;NON-EX FBUS CONTROLLER?
	JRST RDDIA3		;YES. SKIP PROCESSING
	MOVE P1,T2		;SAVE DATA
	HRRI T1,1		;SET NEXT FUNCTION NUMBER
	SBDIAG T1		;DO SECOND FUNCTION
	SKIPN P1		;EXIST?
	JUMPE T2,RDDIA3		;?
	MOVEM P1,1(T3)		;YES. SAVE IT
	MOVEM T2,2(T3)		;SAVE THEM BOTH
	MOVEM T4,0(T3)		;SAVE CONTROLLER #
	LOAD T2,MEMTYP,T2	;GET MEM TYPE
	CAIN T2,MOS		;MOS MEMORY?
	JRST RDMOS		;YES. SEE IF ANY MOS ERRORS AROUND
	CALL CLRCON		;NO, CLEAR CONTROLLER NOW
RDDIA1:	MOVNI T2,SBSMAX		;# OF SBDIAGS
RDDIA2:	HRLM T2,0(T3)		;SAVE COUNT
	ADD T3,[-1,,SBSMAX+1]	;ADJUST VALUE
	ADD Q3,BHC+SBSMAX	;ACCOUNT FOR 2 OF THE WORDS
	AOBJP Q3,RDDIA4		;ROOM FOR MORE?
RDDIA3:	AOBJN T4,MEMPS1		;LOOP FOR ALL CONTROLLERS
RDDIA4:	HRRZ T2,Q3		;RETURN WORDS USED
	RET			;DONE

;ROUTINE TO TYPE OUT ALL SBUS ERROR REGS
;ACCEPTS: 	T1/ -COUNT,,ADDRESS

PRISBS:	SAVEAC <Q1,Q2>		;GET SOME WORK REGS
	JUMPGE T1,R		;IF NONE, GIVE UP NOW
	MOVE Q1,T1		;SAVE START ADDRESS
	MOVEI T1,[SIXBIT '$$SBUS DIAGS$$CNTRLR FNC 0          FNC 1$/']
	JSR BUGMSG
PRISB1:	HRRZ T1,0(Q1)		;GET CONTROLLER #
	CAIN T1,PI%DMA		;IS THIS THE DMA?
	CALL [	MOVEI T1,[SIXBIT 'DMA   /'] ;YES
		JSR BUGMSG	;SAY SO
		RETSKP]		;AND PROCEED
	CALL BUGOPT		;OUTPUT IT
	MOVEI T1," "		;A SPACE
	JSR BUGTYO
	MOVE T1,1(Q1)		;GET FUNCTION 1
	CALL BUGWPT		;OUTPUT 36 BITS
	MOVEI T1," "		;A SPACE AGAIN
	JSR BUGTYO
	MOVE T1,2(Q1)		;GET FUNCTION 2
	CALL BUGWPT		;OUTPUT IT
	MOVEI T1,[SIXBIT '$/']	;GET EOL
	JSR BUGMSG		;AND GET A NEW LINE
	HLRE T1,0(Q1)		;GET COUNT OF SBDIAGS DONE
	SUB Q1,T1		;SKIP UNWANTED AND WANTED FUNCTIONS
	AOBJN Q1,PRISB1		;DO IT
	RET			;DONE
;RDDIAG CONTINUED...

;READING FOR A MOS CONTROLLER. LOOK FOR ANY MOS HARD ERRORS
;	P1/ SBUSDIAG FUNCTION 1

RDMOS:	TXNN P1,MOSCER		;MOS CORRECTABLE ERROR?
	TXNN P1,SBSHER		;NO. ANY HARD ERRORS?
	CALL CLRCON		;CLEAR CONTROLLER
	HLRZ T2,Q3		;GET REMAINING COUNT
	CAIL T2,-<SBSMAX+1+.PIMSZ> ;ROOM TO RECORD A MOS HARD ERROR?
	SKIPN T2,ERRTBL		;HAVE ANY?
	JRST RDDIA1		;NO. PROCEED AS NORMAL
	HRRZ T1,T4		;YES. GET CONTROLLER
RDMOS0:	OPSTR <CAME T1,>,SBSCN,(T2) ;IS THIS THE CONTROLLER?
	JRST RDMOS1		;NO. SKIP THIS ENTRY
	JE SBHEB,(T2),RDMOS1	;IF ALREADY RECORDED, GO ON

;FOUND ONE TO RECORD

	SETZRO SBHEB,(T2)	;MARK IT RECORDED
	MOVE T1,SBSEAD(T2)	;GET ERROR ADDRESS
	MOVEM T1,PI%MEA(T3)	;STORE IT
	LOAD T1,SBSBN,(T2)	;GET BLOCK NUMBER
	MOVEM T1,PI%MBN(T3)	;STORE IT
	LOAD T1,SBSSB,(T2)	;GET SPARE BIT NUMBER
	MOVEM T1,PI%MSB(T3)	;STORE IT
	LOAD T1,SBSSY,(T2)	;GET SYNDROME OF ERROR
	MOVEM T1,PI%MSY(T3)	;STORE IT
	ADDI T3,.PIMSZ		;ACCOUNT FOR USED WORDS
	ADD Q3,BHC+.PIMSZ	;HERE TOO
	MOVNI T2,SBSMAX+.PIMSZ	;NUMBER OF ENTRIES
	JRST RDDIA2		;AND PROCEED

;THIS ENTRY NOT INTERESTING

RDMOS1:	SKIPE T2,SBSLNK(T2)	;GET NEXT ONE
	JRST RDMOS0		;FOUND ONE
	JRST RDDIA1		;PROCEED

;LOCAL ROUTINE TO CLEAR A CONTROLLER.
;	T4/ COUNT,,CONTROLLER# IF CLRCON CALLED
;	Q1/ COUNT,,CONTROLLER# IF CLRCN0 CALLED

CLRCN0:	MOVE T4,Q1		;ENTRY FOR CONTROLLER NUMBER IN Q1
CLRCON:	MOVX T1,SBCLER		;GET CLEAR BIT
	DPB T4,[POINT 5,T1,4]	;STORE CONTROLLER NUMBER
	SBDIAG T1		;CLEAR CONTROLLER
	RET			;AND DONE
;PROCESS SBUS ERROR FOR KL10. THIS CODE IS GOTTEN TO
;ON AN APR INTERRUPT INDICATING SBUS ERROR.
;THE CODE LOOKS FOR MOS CONTROLLERS THAT INDICATE
;CORRECTABLE ERROR SO THAT THE MOS DIAGNOSITC (TGHA) CAN ANALYZE
;THE PROBLEM. IF A HARD ERROR IS FOUND IN ANY CONTROLLER
;(MOS OR CORE), THEN A MEMORY SCAN WILL BE DONE LATER.
;THE MEMEORY SCAN IS ARRANGED BY TREATING THE HARD SBUS ERROR
;AS A MEM PAR ERROR. ANY CERS THAT ARE FOUND ARE LOGGED IN
;A RESIDENT BUFFER FOR LATER RETRIEVAL BY TGHA.

SBSERR:	DATAI PAG,MEMPDP	;SAVE REGISTER STATE
	DATAO PAG,SETAPI	;SET TO PROPER REGS
	MOVE P,[IOWD NMEMPP,MEMPP] ;ESTABLISH TEMP STACK
	RDERA PI%ER2+MPISEB	;SAVE ERA IN CASE
	SETZM P3		;NO HARD ERRORS YET
	CONOAPR APFCLR+APSBER 	;CLEAR APR FLAG NOW
	MOVEI Q2,MOSLEN		;# OF CONTROLLER GROUPS
	JRST SBSER3		;DO IT
SBSER1:	MOVEI T1,0		;START WITH FUNCTION ZERO
	DPB Q1,[POINT 5,T1,4]	;STORE CONTROLLER NUMBER
	SBDIAG T1		;GET CONTROLLER INFORMATION
	CAME T2,[-1]		;CONTROLLER EXIST?
	TXNN T2,SBSHER!MOSCER	;ANY SORT OF ERROR?
	JRST SBSER2		;NO. GO ON
	MOVE Q3,T2		;SAVE FNC 0 RESULTS
	HRRI T1,1		;DO FNC 1
	SBDIAG T1		;""
	LOAD T3,MEMTYP,T2	;GET TYPE OF THIS MEMORY
	CAIN T3,MOS		;MOS CONTROLLER?
	TXNE T2,MOSDBL		;ENABLED?
	JRST SBSER2		;NO. SKIP THIS CONTROLLER THEN
	JRST SBSER0		;MAYBE. GO LOOK

;NOT MOS OR NOT A CORRECTABLE ERROR. GO ON TO NEXT

SBSER2:	AOBJN Q1,SBSER1		;DO NEXT CONTROLLER
SBSER3:	SOJL Q2,[EXCH P3,MEMPDP
		DATAO PAG,P3	;RESTORE REG
		SKIPN MEMPDP	;FOUND ERROR?
		JRST [	CONOAPR APSBER+APFSET ;NO. REASSERT ERROR AND DO SCAN
			JRST MEMPAR]
		JRST OV0]	;AND PROCEED
	MOVE Q1,MOSTBL(Q2)	;GET NEXT GROUP
	JRST SBSER1		;AND DO IT
;FOUND A MOS CONTROLLER WITH ERROR UP. GET INFORMATION
;FOR TGHA.
;	Q1/-N,,CNTRL#
;	Q3/SBDIAG FNC 0 RESULTS

SBSER0:	MOVE F,Q3		;SAVE SBDIAG FNC 0
	SKIPE T1,MTSADR		;TESTING AN ADDRESS?
	JRST [	XOR T1,Q3	;YES. SEE IF IN ERROR PAGE
		TXNE T1,PHCPNO	;IS IT?
		JRST .+1	;NO
		CALL CLRCN0
		AOJA P3,SBSER2]	;AND DONE
REPEAT 0,<
	CONSZ APR,APMPE		;ACCOMPANYING MB PARITY ERROR?
	JRST [	RDERA T1	;YES. GET ERA
		TXNN T1,ER%WRT	;WRITING?
		JRST .+1	;NO
		ANDX T1,<PHCPNO!PGWD> ;GET ADDRESS
		LOAD T2,<PHCPNO!PGWD>,Q3 ;GET MEM ADDRESS
		CAME T2,T1	;SAME ADDRESS?
		JRST .+1	;NO
		CALL CLRCNO	;CLEAR IT
		AOJA P3,SBSER2]	;AND DONE
 >				;END OF REPEAT 0
	TXNE F,MOSWPE		;A WRITE ERROR?
	JRST SBSER7		;YES. GO ANALYZE
SBSER8:	TXNE F,MOSCER!MOSWPE	;A CORRECTABLE ERROR?
	AOS P3			;YES. REMEMBER THIS
	MOVX T1,<.RESP1,,ERRSIZ> ;GET A BLOCK TO STORE DATA
	MOVEI T2,.RESGP		;FROM THE GENERAL POOL
	CALL ASGRES		;GET IT
	 JRST [	BUG (SBSERF)
		JRST SBSER6]	;CAN'T DO IT THEN
	MOVE P1,T1		;SAVE BLOCK ADDRESS
	EXCH T1,ERRTBL		;MAKE THIS NEW HEAD.
	MOVEM T1,@ERRTBL	;LINK IN REMAINDER OF CHAIN
	STOR Q1,SBSCN,(P1)	;STORE CONTROLLER NUMBER
	MOVEI T1,.PMMER		;ENTRY TYPE
	STOR T1,SBSTP,(P1)	;STORE THIS TOO
	RDERA SBSERA(P1)	;SAVE ERA AT TIME OF ERROR
	TRZ Q3,3		;GET LEFT-MOST 34 BITS OF ERROR ADDRESS
	MOVEI T1,2		;NEED TO GET FNC 2
	DPB Q1,[POINT 5,T1,4]	;FOR THIS CONTROLLER
	SBDIAG T1		;""
	LDB T2,[POINT 2,T2,6]	;GET LOW ORDER-TWO BITS OF ADDRESS
	IOR Q3,T2		;FORM FULL WORD ADDRESS
	MOVEM Q3,SBSEAD(P1)	;SAVE ERROR ADDRESS
	HRRI T1,1B27+6		;DO FUNCTION 6.1
	SBDIAG T1		;TO GET SYNDROME
	LDB T2,[POINT 6,T2,12]	;GET SYNDROME
	STOR T2,SBSSY,(P1)	;SAVE SYNDROME IN ERROR BLOCK
	HRRI T1,12		;SET UP TO GET BN
	LDB T2,[POINT 8,Q3,21]	;GET RAM ADDRESS FROM EA
	DPB T2,[POINT 8,T1,27]	;PUT IN THE FUNCTION
	SBDIAG T1		;GET IT
	LDB T2,[POINT 4,T2,13]	;GET BN
	STOR T2,SBSBN,(P1)	;SAVE IN ERROR BLOCK
	HRRI T1,7		;NOW GET SPARE BIT NUMBER
	DPB T2,[POINT 4,T1,24]	;PUT IN BLOCK #
	LDB T3,[POINT 3,Q3,35]	;GET OFFSET IN INTERLEAVE GROUP
	DPB T3,[POINT 3,T1,27]	;STORE IN FUNCTION
	SBDIAG T1		;GET SPARE BIT #
	LDB T3,[POINT 6,T2,12]	;GET IT
	STOR T3,SBSSB,(P1)	;SAVE IT IN THE ERROR BLOCK
	TXC T2,7B15		;COMPLEMENT ICE FIELD
	IOR T1,T2		;SET UP TO SUPPRESS ERROR REPORTING
	TXNE F,MOSCER		;HARD ERROR?
	SBDIAG T1		;NO, DO IT
	; ..
;NOW READ THE 4 32-BIT SERIAL NUMBERS FROM THE CONTROLLER.

	MOVEI T1,2		;DO IT WITH FUNCTION 2
	DPB Q1,[POINT 5,T1,4]	;STORE CONTROLLER #
	LOAD T2,SBSBN,(P1)	;GET BACK BN
	LSH T2,-2		;DIVIDE BY 4
	DPB T2,[POINT 2,T1,10]	;INTO THE INPUT WORD
	MOVE P2,[POINT 8,SBSSER(P1)] ;BYTE POINTER TO SERIAL # STORAGE
	MOVEI T4,^D16		;# OF BYTES TO GET
SBSER5:	SBDIAG T1		;GET NEXT BYTE
	LDB T2,[POINT 8,T2,14]	;GET BYTE
	IDPB T2,P2		;SAVE BYTE
	ADD T1,[1B14]		;NEXT ONE
	SOJG T4,SBSER5		;GET REST OF THIS ONE
	TXNE F,MOSCER!MOSWPE	;HARD ERROR?
	JRST SBSER6		;NO. PROCEED
	SETONE SBHEB,(P1)	;YES. MARK IT

;DONE WITH ERROR ANALYSIS. CLEAR ERROR AND PROCEED

SBSER6:
   IFNDEF DODBE,<		;IF NOT DOING DOUBLE-BIT CORRECTION
	TXNN F,MOSCER!MOSWPE	;HARD ERROR?
	JRST SBSER2		;YES. LEAVE EVERYTHING ALONE
   >				;END OF IFNDEF DODBE
	LOAD T2,PHCPNO,Q3	;GET PHYSICAL PAGE NUMBER
	LOAD T3,PGWD,Q3		;GET WORD WITHIN PAGE
   IFDEF DODBE,<		;FOR CORRECTING 2-BIT ERRORS
	TXNN F,MOSCER!MOSWPE	;HARD ERROR?
	JRST SBSDBE		;YES. GO SEE IF CORRECTABLE
   >				;END OF IFDEF DODBE
	MOVE T4,[MOVES PIPGA(T3)] ;TO CORRECT IT
	TXNN F,MOSWPE		;WRITE ERROR?
	CALL XCTRCA		;NO, DO CORRECTION
	MOVX T1,SBCLER		;SET UP FOR CLEAR
	DPB Q1,[POINT 5,T1,4]	;THE CONTROLLER
	SBDIAG T1		;CLEAR IT
	JRST SBSER2		;AND PROCEED WITH SCAN

;Here if a controller indicates "write data parity error".

SBSER7:	CONSZ APR,APMPE		;MB ERROR PENDING?
	AOJA P3,SBSER2		;YES. GO ON
	MOVE T1,PI%ER2+MPISEB	;NO. GET LAST MB ERROR REPORTED
	XOR T1,Q3		;SEE IF IN SAME PAGE
	TXNE T1,PHCPNO		;IS IT?
	JRST SBSER8		;NO. REPORT IT THEN
	CALL CLRCN0		;YES. UNLATCH CONTROLLER THEN
	AOJA P3,SBSER2		;DONE
;ROUTINE TO CORRECT DOUBLE BIT ERRORS. AT THIS POINT:

   IFDEF DODBE,<		;IF WANT TO CORRECT 2-BIT ERRORS
SBSDBE:	PIOFF			;OWN MACHINE
	SKIPE P1,CASHF		;GET CACHE STATE
	CALL CASHOF		;WAS ON. TURN IT OFF
	LOAD T1,PHCPNO,Q3	;GET MEM PAGE NUMBER
	PUSH P,CST0(T1)		;SAVE CST0 ENTRY FOR THIS PAGE
	PUSH P,T1		;SAVE PAGE NUMBER
	SETOM CST0(T1)		;MAKE IT FULLY ACCESSIBLE
	CALL MAPRCA		;GET ACCESS TO IT
	LOAD T4,PGWD,Q3		;GET WORD NUMBER IN PAGE
	ADD T4,T1		;FORM ADDRESS OF ERROR WORD
	MOVX T1,SBCLER		;NEED TO CLEAR ERROR NOW
	DPB Q1,[POINT 5,T1,4]
	SBDIAG T1		;DO IT
	MOVE P2,0(T4)		;GET ERROR WORD
	TXZ T1,SBCLER		;SEE IT STILL HAVE AN ERROR
	SBDIAG T1		;"
	TXNN T2,MOSCER		;STILL UNCORRECTABLE?
	TXNN T2,SBSRPE		;DO WE?
	JRST SBSHR5		;NO. FLAKEY MEMORY. IT IS HOPELESS
	SETCAM P2,0(T4)		;COMPLEMENT BAD LOCATION
	MOVE T1,P2		;GET ORIGINAL WORD AGAIN
	EQV T1,0(T4)		;FORM EQUIVALENCE
	MOVE Q3,T1		;SAVE EQV
	JUMPE T1,SBSHR0		;IF ZERO, FATAL ERROR

;NOW COUNT # OF BITS IN RESULTING WORD AND ACCUMULATE SYNDROME

	SETZM P3		;WHERE TO ACCUMULATE SYNDROME
	MOVEI T3,1		;HAVE AT LEAST ONE BIT
SBSHR1:	JFFO T1,.+1		;GET NEXT ONE BIT
	TDZ T1,BITS(T2)		;TURN OFF THE BIT
	ADJBP T2,[POINT 6,SYNWRD,5] ;GET TO PROPER SYNDROME
	LDB T2,T2		;GET SYNDROME FOR BIT
	XOR P3,T2		;COMPUTE SYNDROME
	SKIPE T1		;DONE YET?
	AOJA T3,SBSHR1		;NO. FIND NEXT BIT THEN

;FOUND ALL BITS

	SOJE T3,SBSHR2		;ONE BIT FOUND?
	SOJG T3,SBSHR0		;NO. TWO BITS THEN?
	MOVEI T1,1B27+6		;READ ERROR SYNDROME
	DPB Q1,[POINT 5,T1,4]
	SBDIAG T1		;GET THE SYNDROME
	LDB T2,[POINT 6,T2,12]	;FETCH IT FROM THE WORD
	CAME T2,P3		;SAME SYNDROME?
	JRST SBSHR0		;NO. FLAKEY AGAIN

;COMPUTED SYNDROME MATCHES REPORTED SYNDROME. CAN CORRECT ERROR

SBSHR4:	XOR P2,Q3		;GET CORRECT DATA
SBSHR0:	MOVEM P2,0(T4)		;PUT BACK DATA
SBSHR5:	POP P,T1		;GET BACK MEM PAGE NUMBER
	POP P,CST0(T1)		;RESTORE PAGE STATE
	CALL UNMRCA		;FREE MAPPING
	SKIPE P1		;WAS CACHE ON?
	CALL CASHON		;YES. TURN IT ON AGAIN THEN
	PION			;TURN ON SYSTEM AGAIN
	AOJA P3,SBSER2		;AND DONE. BUT RECORED HARD ERROR
;EQV WORD HAS ONE BIT ON. SEE IF CAN FIND A MATCHING SYNDROME

SBSHR2:	MOVEI T1,1B27+6		;SET UP TO READ SYNDROME
	DPB Q1,[POINT 5,T1,4]
	SBDIAG T1		;GET SYNDROME OF ERROR
	LDB T2,[POINT 6,T2,12]	;EXTRACT THE SYNDROME
	XOR P3,T2		;COMPUTE SYNDROME OF OTHER BIT

;NOW HAVE SYNDROME OF THE OTHER BIT. SEE IF WE CAN FIND THE BIT

	CAMN P3,T2		;MAKE SURE NOT SELF
	JRST SBSHR0		;IT IS. BOO HIS!!!
	MOVEI T3,^D43		;# OF BITS IN A WORD
SBSHR3:	MOVE T2,T3		;COPY BIT NUMBER
	ADJBP T2,[POINT 6,SYNWRD,5] ;GET POINTER TO SYNDROME
	LDB T2,T2		;GET SYNDROME
	CAMN P3,T2		;FOUND IT?
	JRST [	CAIG T3,^D35	;A DATA BIT?
		TDO Q3,BITS(T3)	;YES. PUT IT IN CORRECTION WORD
		JRST SBSHR4]	;AND GO CORRECT DATA
	SOJGE T3,SBSHR3		;NO. DO OTHER BITS
	JRST SBSHR0		;NOT FOUND. CAN'T CORRECT IT

;DEFINE SYNDROMES OF BITS

SYNWRD:	BYTE (6)14B37,24B37,30B37,34B37,44B37,50B37,54B37,60B37,64B37,70B37,74B37,104B37
	BYTE (6)110B37,114B37,120B37,124B37,130B37,134B37,140B37,144B37,150B37,154B37,160B37,164B37
	BYTE (6)170B37,174B37,204B37,210B37,214B37,220B37,224B37,230B37,234B37,240B37,244B37,250B37
	BYTE (6)200B37,100B37,40B37,20B37,10B37,4B37,0B37
   >				;END OF IFDEF DODBE
   >				;END OF IFN KLFLG
;UTILITY ROUTINE TO GET NEXT MEM ERROR BLOCK
;ACCEPTS:	T1/ TYPE OF ENTRY WANTED
;RETURNS:	+1 NONE FOUND
;		+2 FOUND. T1/ ADDRESS

DEQERR::
   IFN SMFLG,<RET>		;FOR THE KS, NO INFORMATION
   IFN KLFLG,<			;FOR THE KL, HOWEVER,
	CAIE T1,.PMMER		;WANT MOS ERRORS?
	RET			;NO. YES, WE HAVE NONE OF THESE
	PIOFF			;OWN MACHINE FOR A WHILE
	SKIPN T1,ERRTBL		;ANY ENTRIES?
	RETBAD (,<PION>)	;NO. GIVE UP THEN
	MOVE T2,SBSLNK(T1)	;YES. GET LINK WORD
	MOVEM T2,ERRTBL		;REMOVE TOP ENTRY
	PION			;RELEASE MACHINE
	RETSKP			;AND DONE
   >				;END OF IFN KLFLG
;Routine to unlatch all MOS memory controllers. MOS controllers
;latch error information and will not report subsequent errors
;while latched. This code is used by the monitor start up routines
;in PAGEM, by the channel write parity error code in APRSRV and MEXEC.


   IFN SMFLG,<
MOSULE::
MEMSTR::RET
   >;	IFN SMFLG

   IFN KLFLG,<

MOSULE::PIOFF			;OWN THE MACHINE
	SKIPN ERRTBL		;ANY ERRORS?
	CALL MEMSTR		;NO. UNLATCH THE CONTROLLERS THEN
	PION
	RET

MEMSTR::MOVSI T3,-MOSLEN	;# OF CONTROLLER PAIRS
MEMST1:	MOVE T4,MOSTBL(T3)	;GET GROUP
	CALL CLRCON		;CLEAR CONTROLLER
	AOBJN T4,.-1		;DO ALL OF THE CONTROLLERS
	AOBJN T3,MEMST1		;DO ALL GROUPS
	RET			;DONE

;ROUTINE TO CLEAR ALL CONTROLLERS WITH WRITE PARITY ERROR

UNLCON:	MOVSI T3,-MOSLEN	;SIZE OF TABLE
UNLCN0:	MOVE T4,MOSTBL(T3)	;GET NEXT GROUP
UNLCN1:	SETZM T1
	DPB T4,[POINT 5,T1,4]	;PUT IN CONTROLLER #
	SBDIAG T1		;GET FUNCTION 0
	TXNE T2,MOSWPE		;WRITE ERROR?
	CALL CLRCON		;YEP. UNLATCH THEN
	AOBJN T4,UNLCN1		;DO ALL OF GROUP
	AOBJN T3,UNLCN0		;DO ALL GROUPS
	RET			;AND DONE

   >				;IF OF IFN KLFLG
;STORAGE FOR PARITY ROUTINES


RS MEMPA,1			;ONE WORD FOR PAGEM TO USE
RS MEMAP,1			;FOR STACK STORAGE
RS DEVMPE,1			;AOS'D TO REQUEST CORE SCAN
RS MPITIM,1			;TIME OF LAST PAR ERR
RS MPISEB,PI%LN2		;TEMP SYSERR DATA
NMEMPP==^D54			;SIZE OF LOCAL STACK
RS MEMPP,NMEMPP			;LOCAL STACK
RS MEMPDP,1			;SAVE AC BLOCK SETTINGS
RS MEMPFF,1			;FATAL FLAG

IFN KLFLG,<

;JOB 0 CLEANUP ROUTINE--MARK PAGES FOUND AS BAD
; T1/ SYSERR BLOCK PTR
;	CALL MEMPJ0
; RETURNS +1 ALWAYS

	SWAPCD
MEMPJ0:	SAVEQ
	MOVEI Q1,SEBDAT(T1)	;SETUP PTR TO DATA BLOCK

;DO TYPEOUT OF PROCESSOR INFORMATION

	HRROI T1,[ASCIZ /


Parity Error Detected by/]
	TMNN APMPE,PI%CN2(Q1)
	HRROI T1,[ASCIZ /


SBUS Error Detected by/]
	PSOUT
	HRROI T1,[ASCIZ / APR/]
	TMNE ER%CHN,PI%ER2(Q1)
	HRROI T1,[ASCIZ / CHANNEL/]
	PSOUT
	HRROI T1,[ASCIZ /, ERA = /]
	PSOUT
	MOVE T2,PI%ER2(Q1)
	MOVEI T1,.PRIOU
	MOVX T3,<NO%MAG!NO%LFL!NO%ZRO+10>+FLD(^D12,NO%COL)
	NOUT
	 NOP
	MOVE T1,PI%SB2(Q1)		;GET SDBIAG WORD
	ADDI T1,0(Q1)			;ADD IN START IF BLOCK
	CALL PPRSBS			;TYPE OUT INFO
	HRROI T1,[ASCIZ /

   LOC      CONTENTS

/]
	PSOUT
	HRLI Q1,-PI%NB2		;SCAN BLOCK OF BAD ADDRESSES
	SETO Q2,
	; ..
	; ..
;Now look at bad word and report on each of them

MEMPJ1:	JN ER%WRT,PI%ER2(Q1),MEMPJ2 ;IF WRITE, DON'T KILL PAGE
	JE PI%FAT,PI%BAD(Q1),MEMPJ2 ;IF NOT FATAL, SKIP IT
	LOAD T1,PHCPNO,PI%BAD(Q1) ;GET PHYS PAGE NUMBER THIS ADDRESS
	CAME T1,Q2		;SAVE AS PREVIOUS?
	SKIPN T1		;OR NONE?
	JRST MEMPJ2		;YES, DO NOTHING
	MOVEM T1,Q2		;SAVE
	CALL BADCPG		;MARK PAGE BAD
	 JFCL
MEMPJ2: SKIPN T2,PI%BAD(Q1)	;HAVE AN ADDRESS?
	RET			;NO. ALL DONE THEN
	ANDX T2,<PHCPNO+PGWD>	;JUST USE ADDRESS BITS
	MOVEI T1,.PRIOU		;YES
	MOVX T3,<NO%LFL!NO%ZRO+10>+FLD(^D8,NO%COL)
	NOUT			;TYPE IT OUT THEN
	 NOP
	MOVEI T2," "
	BOUT			;SPACE
	MOVE T2,PI%DA2(Q1)	;GET BAD DATA
	MOVX T3,<NO%MAG!NO%LFL!NO%ZRO+10>+FLD(^D12,NO%COL)
	NOUT			;TYPE IT OUT ALSO
	 NOP
	MOVEI T2," "
	BOUT
	JN PI%FAT,PI%BAD(Q1),MEMPJ3 ;IF HARD NO GOOD DATA
	MOVE T2,PI%MDA(Q1)
	NOUT
	 NOP
MEMPJ3:	HRROI T1,[ASCIZ /
/]
	PSOUT
	AOBJN Q1,MEMPJ1		;DO ALL ADDRESSES
	RET
;PRINT SBUS DIAGS FOR JOB 0 ROUTINES
PPRSBS:	SAVEAC <Q1,Q2>		;GET SOME WORK REGS
	JUMPGE T1,R		;IF NONE, GIVE UP NOW
	MOVE Q1,T1		;SAVE START ADDRESS
	HRROI T1,[ASCIZ '

SBUS DIAGS

CNTRLR    FNC 0       FNC 1
']
	PSOUT
PPRSB1:	HRRZ T2,0(Q1)		;GET CONTROLLER #
	CAIN T2,PI%DMA		;IS THIS THE DMA?
	JRST [	HRROI T1,[ASCIZ 'DMA    '] ;YES
		PSOUT		;SAY SO
		MOVEI T1,.PRIOU	;PRIMARY OUTPUT
		JRST PPRSB2]
	MOVEI T1,.PRIOU
	MOVX T3,<NO%MAG!NO%LFL!NO%ZRO+10>+FLD(2,NO%COL)
	NOUT
	 NOP
	HRROI T2,[ASCIZ /     /]
	SETZM T3
	SOUT			;SPACES
PPRSB2:	MOVE T2,1(Q1)		;GET FUNCTION 1
	MOVX T3,<NO%MAG!NO%LFL!NO%ZRO+10>+FLD(^D12,NO%COL)
	NOUT
	 NOP
	MOVEI T2," "		;A SPACE
	BOUT
	MOVE T2,2(Q1)		;GET FUNCTION 2
	NOUT
	 NOP
	HRROI T1,[ASCIZ /
/]				;EOL
	PSOUT
	HLRE T1,0(Q1)		;GET COUNT OF SBDIAGS DONE
	SUB Q1,T1		;SKIP UNWANTED AND WANTED FUNCTIONS
	AOBJN Q1,PPRSB1		;DO IT
	RET			;DONE
>				;END OF IFN KLFLG
;ROUTINE TO FINISH LOGGING OF PARITY ERROR - RUN IN JOB 0 CONTEXT

; T1/ ADDRESS OF SYSERR BLOCK

PFCPJ0:	SAVEQ
	HLRZ Q3,SEBDAT+PT%JOB(T1) ;GET FORKX AT TRAP
	CAIE Q3,-1
	SKIPGE FKPT(Q3)
	JRST PFCPJ1
	LOAD T2,FKJOBN		;GET JOB NUMBER
	HRRM T2,SEBDAT+PT%JOB(T1) ;REPORT IT
	HRRZ T3,JOBDIR(T2)	;GET LOGGED-IN DIRECTORY
	HRLI T3,USRLH		;MAKE IT A USER NUMBER
	MOVEM T3,SEBDAT+PT%USR(T1) ;REPORT IT
	MOVE T3,JOBPNM(T2)	;GET PROGRAM NAME
	MOVEM T3,SEBDAT+PT%PGM(T1) ;REPORT IT

; Report on CTY

PFCPJ1:	MOVEI Q1,SEBDAT(T1)
	HRROI T1,[ASCIZ '


AR/ARX Parity error
PFW= ']
	PSOUT
	MOVEI T1,.PRIOU
	MOVE T2,PT%PFW(Q1)
	MOVX T3,<NO%MAG!NO%LFL!NO%ZRO+10>+FLD(^D12,NO%COL)
	NOUT
	 NOP
	HRROI T1,[ASCIZ / MAP WORD= /]
	PSOUT
	MOVEI T1,.PRIOU
	MOVE T2,PT%PMA(Q1)
	NOUT
	 NOP
	HRROI T1,[ASCIZ /
BAD DATA= /]
	PSOUT
	MOVEI T1,.PRIOU
	MOVE T2,PT%BDW(Q1)
	MOVX T3,<NO%MAG!NO%LFL!NO%ZRO+10>+FLD(^D12,NO%COL)
	NOUT
	 NOP
	JN PT%HRD,PT%TRY(Q1),R
	HRROI T1,[ASCIZ /
GOOD DATA= /]
	PSOUT
	MOVEI T1,.PRIOU
	MOVE T2,PT%GDW(Q1)
	NOUT
	 NOP

	RET
;LOCAL TYPOUT OF WORD IN OCTAL

	RESCD
BUGWPT:	PUSH P,T1
	HLRZ T1,T1
	CALL BUGOPT		;TYPE LH
	MOVEI T1,","
	JSR BUGTYO
	JSR BUGTYO
	POP P,T1
	HRRZ T1,T1
	CALL BUGOPT		;TYPE RH
	RET

;NON-PI OCTAL NUMBER TYPEOUT ON CONSOLE TTY

;8-OCTIT, USED FOR PHYSICAL ADDRESSES

BUGOP8:	SAVEAC <Q1,Q2>
	MOVE Q2,[POINT 3,Q1,11]
	JRST BUGOP0

;6-OCTIT

BUGOPT:	SAVEAC <Q1,Q2>
	MOVE Q2,[POINT 3,Q1,17]
BUGOP0:	MOVEM T1,Q1		;SAVE NUMBER
BUGOPA:	ILDB T1,Q2		;GET NEXT OCTIT
	ADDI T1,"0"		;CONVERT TO ASCII
	JSR BUGTYO		;TYPE IT
	TXNE Q2,77B5		;BYTE PTR AT END OF WORD?
	JRST BUGOPA		;NO, LOOP
	RET			;YES, DONE
;Routine to scann portion of memory looking for parity errors.
; This is called from Channel logout code when channel write
; parity errors have occurred.
;
; T1/	STARTING PHYSICAL ADDRESS
; T2/	WORD COUNT

; RETURNS:
;	+1 ONE OR MORE ERRORS FOUND
;	+2 NO ERRORS FOUND

   IFN KLFLG,<
MEMSCN::SAVEP			;SAVE ACS
	SETZM P1		;NO ERRORS YET
	DMOVE P2,T1		;SAVE ARGS

;MUST SCAN ERROR QUEUE

	MOVE P4,T1		;START ADDRESS
	ADDI P4,-1(T2)		;END ADDRESS
MEMSC3:	PIOFF
	SKIPN T1,WREQ		;HEAD OF QUEUE
	JRST MEMSC1		;NONE TO DO
	MOVE T4,TODCLK		;TIME
	SUBI T4,^D30000		;MAX TIME TO HOLD AN ETNRY
	MOVEI T2,WREQ		;PREVIOUS
MEMSC2:	MOVE T3,1(T1)		;GET ERROR ADDRESS
	CAML T3,P2		;WITHIN RANGE?
	CAMLE T3,P4		;STILL?
	JRST [	CAMG T4,2(T1)	;TIME TO FLUSH IT?
		JRST MEMSC4	;NO. KEEP IT FOR THE NEXT TIME
		JRST MEMSC6]	;YES
	AOS P1			;FORCE ERROR
MEMSC6:	MOVE T3,0(T1)		;NXT
	MOVEM T3,0(T2)		;UNLINK THIS ONE
	CALL RELRES		;FREE BLOCK
	JRST MEMSC3		;AND TRY AGAIN

MEMSC4:
	MOVE T2,T1		;NEW PREVIOUS
	MOVE T1,0(T1)		;NEW NEXT
	JUMPN T1,MEMSC2		;DO IT

;Scan of error queue all done


MEMSC1:	PUSH P,UPTPFO		;SAVE PAGE FAIL STATE
	PUSH P,UPTPFL
	PUSH P,UPTPFN
	PUSH P,UPTPFW
	XMOVEI T3,MEMPT0	;LOCAL PAGE FAIL ROUTINE
	MOVEM T3,UPTPFN		;STASH IT

;SCAN THE MEMORY

	MOVEM P2,MTSADR		;SAVE AS TEST ADDRESS
	LOAD T3,PGWD,P2		;GET WORD OFFSET
	LSH P2,-PGSFT		;PAGE NUMBER
	MOVE T1,P2
	CALL MAPRCA		;MAP ADDRESS
	PUSH P,CST0(P2)		;SAVE CST STATE
	MOVX T4,PSASM
	IORM T4,CST0(P2)	;MAKE IT WRITABLE
	ADDI T1,0(T3)		;STARTING WORD
MEMSC5:	MOVES 0(T1)		;TOUCH IT
	ADDI T1,1
	SOJG P3,MEMSC5		;DO ALL OF RANGE

;SCAN IS DONE

	POP P,CST0(P2)		;RESTORE CST STATE
	CALL UNMRCA		;UNMAP PAGE
	POP P,UPTPFW
	POP P,UPTPFN
	POP P,UPTPFL
	POP P,UPTPFO
	PION			;RETURN MACHINE TO OTHERS
	CONSZ APR,APSBER	;SBUS ERROR UP?
	JRST .-1		;YEP. WAIT FOR IT
	SETZM MTSADR		;AND CLEAR TEST LOCATION
	JUMPN P1,R		;IF ERRORS, SAY SO
	RETSKP			;OTHERWISE, DONE

;PAGE fault handler for MEMSCN

MEMPT0:	HRRZ T3,UPTPFO		;GET PAGE FAIL PLACE
	CAIE T3,MEMSC5		;RIGHT PLACE?
	CALL MEMXXX		;ERROR!
	SETZM 0(T1)		;ZAP THE WORD
	CONOAPR APFCLR+APMPE	;CLEAR MB ERROR
	AOJA P1,1(T3)		;INDICATE ERROR, AND PROCEED WITH SCAN
   >				;END OF IFN KLFLG
;THIS CODE GENERATES THE KL10 STATUS BLOCK. THIS BLOCK CONTAINS
;INFORMATION ABOUT THE SYSTEM THAT MAY BE RELEVANT IN DEBUGGING
;HARDWARE FAULTS. THIS ROUTINE IS CALLED ON EVERY BUGHLT,BUGCHK,
;BUGINF AND MASSBUS ERROR.
;ACCEPTS:	T1/ TYPE OF ERROR THAT OCCURRED
;USES PRIVATE STACK BUT CALLER MUST PROVIDE SMALL STACK FOR REG SAVES

;TABLE OF TITLES


   IFN SMFLG,<
MASBGX==:0			;DUMMY VALUE TO KEEP PHYSIO HAPPY
GENGEN::
UNGEN::
GENBLK::RET>			;ON THE KS, JUST RETURN

   IFN KLFLG,<			;ONLY ON THE KL
BUGBUG:	[SIXBIT 'BUGHLT,BUGCHK, OR BUGINF$/']
MASBUG:	[SIXBIT 'MASSBUS ERROR$/']
ARBUG:	[SIXBIT 'AR ARX PARITY ERROR$/']
APRBUG:	[SIXBIT "APR INTERRUPT$/"]
MASBGX==:MASBUG-BUGBUG		;INDEX VALUE FOR MASSBUS ERROR
BUGPL==54			;REQUIRED PDL
RS BUGSP,1			;TO HOLD OLD PDL
RS BUGSPL,BUGPL			;ALLOCATE A STACK

GENBLK::SKIPN STSBLK		;HAVE A STATUS BLOCK
	RET			;NO. NO REPORT THEN
	CONI PI,BUGSPL		;SAVE INCOMING PI STATE
	MOVEM T1,BUGSPL+1	;SAVE INCOMING MESSAGE POINTER
	PIOFF			;YES. STOP MACHINE
	JSR BUGMON		;AND THE FE AS WELL
	SAVEP			;GET SOME WORK REGS
	SAVET			;SAVE TEMPS AS WELL
	MOVEI T1,[SIXBIT '$$$CPU STATUS BLOCK FOR /']
	JSR BUGMSG
	MOVE T1,BUGSPL+1	;GET MESSAGE POINTER
	MOVE T1,BUGBUG(T1)	;GET ADDRESS OF MESSAGE
	JSR BUGMSG
	MOVE P1,STSBLK		;GET BLOCK ADDRESS
	APRID SB%API(P1)	;GET APR ID
	CONI APR,SB%APR(P1)	;GET APR STATUS
	RDERA SB%ERA(P1)	;GET ERROR REG
	MOVE P2,BUGSPL		;GET INCOMING PI STATUS
	MOVEM P2,SB%PIC(P1)	;SAVE IT
	MOVEM P,BUGSP		;SAVE INCOMING STACK
	MOVE P,[IOWD BUGPL,BUGSPL] ;GET TEMP STACK
	DATAI PAG,SB%PGD(P1)	;GET PAGING DATA
	CONI PAG,SB%PGC(P1)	;GET PAGING STATUS
	MOVEI P2,SB%RHC(P1)
	MOVE P3,[CONI 540,0(P2)] ;THE INSTRUCTION
	MOVEI P4,10		;# OF RH20'S
CTLBL0:	XCT P3			;GET CONI
	ADD P3,[4B11+1]		;NEXT RH20, NEXT MEM LOC
	SOJG P4,CTLBL0		;DO THEM ALL
	; ..
;GENBLK CODE CONTINUED

	CONI DTE0,SB%DTC(P1)	;DTE0 STATUS
	CONI DTE1,SB%DTC+1(P1)	;DTE1 STATUS
	CONI DTE2,SB%DTC+2(P1)	;DTE2 STATUS
	CONI DTE3,SB%DTC+3(P1)	;DTE2 STATUS
	MOVEI P2,SB%EP0(P1)	;DEST OF EPT LOCS 0-37
	HRLI P2,KIEPT		;SOURCE OF SAME
	BLT P2,SB%EP0+37(P1)	;DO THEM ALL
	MOVEI P2,SB%EP1(P1)	;DEST OF EPT LOCS 140-177
	HRLI P2,KIEPT+140
	BLT P2,SB%EP1+37(P1)	;DO THEM ALL
	MOVEI P2,SB%UP0(P1)	;DEST OF UPT LOCS 424-427
	HRLI P2,HWPTA+424
	BLT P2,SB%UP0+3(P1)	;DO THEM ALL
	MOVEI P2,SB%UP1(P1)	;DEST OF UPT LOCS 500-503
	HRLI P2,HWPTA+500
	BLT P2,SB%UP1+3(P1)	;DO THEM ALL
	MOVE P4,SB%PGD(P1)	;GET INCOMING DATAI PAG,
	MOVEI P3,HWRACB		;SWITCH TO AC BLOCK 6
	STOR P3,PGPACB,P4	;SET UP TO REFERENCE AC BLOCK 6
	DATAO PAG,P4		;DO IT
	XCTU [DMOVE P2,CSTMSK]	;GET FIRST TWO
	DMOVEM P2,SB%6(P1)	;STORE THEM
	XCTU [DMOVE P2,CSTBR]	;GET NEXT SET
	DMOVEM P2,SB%6+2(P1)
	UMOVE P2,12		;GET REG 12
	MOVEM P2,SB%6+4(P1)	;SAVE IT FOR LATER SCRUTINY
	MOVEI P3,HW7ACB		;AC BLOCK 7
	STOR P3,PGPACB,P4	;INTO DATAO WORD
	DATAO PAG,P4		;SWITCH TO AC BLOCK 7
	XCTU [DMOVE P2,0]	;GET REGS 0 AND 1
	UMOVE P4,2		;GET REG 2
	DMOVEM P2,SB%7(P1)	;STORE IT
	MOVEM P4,SB%7+2(P1)	;SAVE ALL REGS
	DATAO PAG,SB%PGD(P1)	;BACK TO STANDARD AC BLOCKS
	MOVEI T2,SB%SBL		;COUNT OF WORDS IN SBUSDIAG BLOCK
	MOVEI T3,SB%SBD+1(P1)	;WHERE TO PUT BLOCK
	CALL RDDIAG		;READ THEM
	HRRI T3,SB%SBD+1	;START OF SBUSDIAG DATA
	MOVEM T3,SB%SBD(P1)	;STORE IT
	; ..
;ALL DATA GATHERED. NOW TYPE SOME OF IT OUT ON THE CTY.

;FIRST TRY TO QUEUE UP A SYSERR BLOCK

	MOVE P3,T2		;GET COUNT OF WORDS USED BY RDDIAG
	MOVEI T1,SB%SBD-SB%API+1(P3) ;GET WORDS NEEDED
	MOVEM T1,T2		;THIS NEEDED AS WELL
	CALL ALCSEB		;GET A SYSERR BLOCK
	 JRST [	MOVEI T1,[SIXBIT '$$?NO SYSERR BUFFER. EVENT NOT RECORDED$$/']
		JSR BUGMSG	;TYPE IT OUT
		JRST STSBL1]	;AND GO ON
	MOVSI P2,SB%API(P1)	;GET START OF DATA
	HRRI P2,SEBDAT(T1)	;GET DEST OF DATA
	ADDI P3,SB%SBD+SEBDAT(T1) ;COMPUTE END ADDRESS OF DATA
	BLT P2,0(P3)		;MOVE IT
	MOVE P2,T1		;SAVE POINTER
	MOVE T2,[-1,,[SEBPTR 0,SBTEVC,SB%BLK]]
	CALL SEBCPY		;COPY EVENT CODE
	 JFCL
	MOVE T1,P2		;GET BACK BLOCK ADDRESS
	CALL QUESEB		;QUEUE UP THE BLOCK
STSBL1:	MOVEI T1,[SIXBIT '$/']
	JSR BUGMSG		;GET SOME SPACING
	; ..
;ALL DATA GATHERED AND RECORDED IN SYSERR. NOW TYPE OUT SOME
;IMPORTANT RESULTS ON THE CTY

	MOVEI T1,[SIXBIT '$ERA = /']
	JSR BUGMSG
	MOVE T1,SB%ERA(P1)	;GET ERA
	CALL BUGWPT		;OUTPUT IT
	MOVEI T1,[SIXBIT '$CONI APR, = /']
	JSR BUGMSG
	MOVE T1,SB%APR(P1)
	CALL BUGWPT		;TYPE IT
	MOVEI T1,[SIXBIT '$CONI PI, = /']
	JSR BUGMSG
	MOVE T1,SB%PIC(P1)	;GET DATA
	CALL BUGWPT		;TYPE IT
	MOVEI T1,[SIXBIT '$CONI PAG, = /']
	JSR BUGMSG
	MOVE T1,SB%PGC(P1)	;GET DATA
	CALL BUGWPT
	MOVEI T1,[SIXBIT '$DATAI PAG, = /']
	JSR BUGMSG
	MOVE T1,SB%PGD(P1)	;GET DATA
	CALL BUGWPT		;TYPE IT
	MOVEI T1,[SIXBIT '$AR ARX DATA WORD = /']
	JSR BUGMSG
	MOVE T1,SB%7(P1)	;GET IT
	CALL BUGWPT		;TYPE IT
	MOVEI T1,[SIXBIT '$IO PAGE FAIL WORD = /']
	JSR BUGMSG
	MOVE T1,SB%7+2(P1)	;GET DATA
	CALL BUGWPT		;TYPE IT
	MOVEI T1,SB%SBD+1(P1)	;START OF SBUSDIAG DATA
	HLL T1,SB%SBD(P1)	;GET NEG COUNT
	CALL PRISBS		;PRINT SBUS DIAGS
	MOVEI T1,[SIXBIT '$$$$/'] ;CLEAN UP OUTPUT
	JSR BUGMSG		;CLEAN UP CTY OUTPUT
	JSR BUGPRI		;TURN ON FE
	MOVE T1,SB%PIC(P1)	;GET CONI PI,
	MOVE P,BUGSP		;GET INCOMING STACK
	TXNE T1,PIPION		;WAS PI ON WHEN WE GOT HERE?
	PION			;YES, TURN ON MACHINE
	RET			;AND WE ARE DONE
;ROUTINES TO ENABLE/DISABLE STATUS BLOCK REPROTING

	SWAPCD			;FROM JSYS ONLY
GENGEN::SKIPE STSBLK		;NOW ENABLED?
	RET			;YES. DONE
	MOVE T1,[.RESP3,,SB%SBD+SB%SBL+1] ;REQUIRED LENGTH
	MOVEI T2,.RESGP		;FROM GENERAL POOL
	CALL ASGRES		;GET SPACE
	 ITERR (MONX05)		;INSUFFICIENT RESOURCES - NO RESIDENT FREE PSACE
	MAP T2,0(T1)		;FIND PHYSICAL ADDRESS OF BLOCK
	DMOVEM T1,STSBLK	;START IT UP
	RET			;AND DONE

;DISABLE STATUS BLOCK REPORTING

UNGEN::	SKIPN T1,STSBLK		;HAVE ONE?
	RET			;NO
	SETZM STSBLK		;NOW DISABLED
	CALLRET RELRES		;AND DONE
	RESCD			;AND RETURN TO RESIDENT MONITOR
   >				;END OF IFN KLFLG
		SUBTTL Routines to handle BUGHLT, BUGCHK, BUGINF

;DDT BREAKPOINT LOCATIONS - THESE ARE EXECUTED BY THE ROUTINES
;BELOW DEPENDING ON THE SETTING OF DBUGSW AND DDTPRS.  THEY
;MUST BE IN A WRITABLE AREA SO THAT DDT CAN INSERT THE BREAKPOINT
;INSTRUCTION

RSI HLTADR,<NOP>		;BUGHLT
RSI CHKADR,<NOP>		;BUGCHK
RSI INFADR,<NOP>		;BUGINF

;IMPOSSIBLE SITUATION HALT
;ACTION DEPENDS ON SETTING OF DBUGSW AND DCHKSW
;REACHED VIA JSR BUGHLT

BUGH0::	AOS BUGNUM		;COUNT UP BUG CHECKS SINCE STARTUP
	JRST @[.+1]
	SOS BUGHLT
	SKIPN DBUGSW		;BREAKPOINT WANTED?
	JRST SKPHLT		;NO. SKIP THE BREAKPOINT
	SKIPN DDTPRS		;YES. DDT LOCKED?
	JRST SKPHLT		;SKIP THE BREAKPOINT

;HERE WHEN DEBUGGING IS ENABLED, DDT IS LOCKED DOWN.
;BREAKPOINT CAN BE PLACED HERE TO ALLOW ANALYSIS OF
;A BUGHLT BEFORE THE DUMP IS TAKEN. PROCEED THE BREAKPOINT TO EFFECT A
;NORMAL RELOAD.

HLTAD0::XCT HLTADR		;EXECUTE THE BREAKPOINT
SKPHLT:
;	SKIPN INSKED		;IN SCHEDULER?
;	CONSZ PI,177B27		;OR IN PI?
;	JRST .+2
;	JRST EXBUGH		;NO, CRASH THIS JOB
	PIOFF			;TURN OFF SYSTEM
	AOSE BUGLCK		;FIRST TIME?
	HALT .			;NO!!
	MOVEM 17,BUGACS+17	;SAVE ACS FOR DUMP
	MOVEI 17,BUGACS
	BLT 17,BUGACS+16
	MOVEI 17,BUGACU		;SET UP TO SAVE PACS
	XBLTUM [BLT 17,BUGACU+P] ;SAVE PREV CONTEXT ACS
				;HAVE PRIMARY PROTOCOL?
	JSR BUGMON		;YES. SWITCH TO MONITOR FOR THIS
	MOVE P,[-BUGPLN,,BUGPDL-1]
	CALL CASHOF		;TURN CASH OFF IN CASE DUMP
	CALL SYRMAP		;CHECK OUT SYSERR BLOCKS
	 CALL [	CAIN T1,SEC%PT	;AR/ARX ERROR?
		JRST [	CALLRET PFERRB] ;YEP. DO IT
   IFN KLFLG,<
		CAIN T1,SEC%P1	;MB PARITY?
		CALL MBERRB	;YEP. DO IT
   >				;END OF IFN KLFLG
		RET]
	MOVEI 1,[SIXBIT \$**********$*BUGHLT "/\]
	JSR BUGMSG		;TYPE CRASH MESSAGE
	HRRZ T1,BUGHLT		;GET ADDRESS OF BUGHLT BLOCK
	TLZ T1,77740		;TEMP ******* BECAUSE OF EXTENDED ADDRESSING HACKS******
	HRRZ T1,0(T1)
	MOVE Q1,T1		;STORE ADDRESS
BUGH3:	MOVE T2,1(T1)		;FIND THE SIXBIT NAME
	TLNN T2,770000		;IS THIS SIXBIT?
	AOJA T1,BUGH3		;NO, KEEP LOOKING
	MOVE T3,[POINT 6,T2]	;SET UP TO TYPE OUT NAME
	;..
	;..
BUGH1:	ILDB T1,T3		;GET A CHARACTER
	ADDI T1," "		;MAKE IT ASCII
	JSR BUGTYO		;TYPE IT OUT
	TLNE T3,770000		;DONE?
	JRST BUGH1		;NO, LOOP BACK TILL ALL ARE TYPED
	MOVEI T1,42		;TYPE OUT DOUBLE QUOTE
	JSR BUGTYO
	SKIPN BUGTIM		;ARE DATE AND TIME SET UP YET
	JRST BUGH7		;NO, JUST LOOK FOR ADDITIONAL INFO
	MOVEI T1,[SIXBIT \ AT /\]
	JSR BUGMSG
	MOVNI T2,17		;MAX NUMBER OF CHARACTERS IN TIME & DATE
	MOVE T3,[POINT 7,BUGTIM] ;GET POINTER TO TIME & DATE
BUGH4:	ILDB T1,T3		;GET A CHARACTER
	JUMPE T1,BUGH5		;JUMP IF END OF STRING
	JSR BUGTYO		;TYPE CHARACTER OUT
	AOJN T2,BUGH4		;JUMP IF MORE CHARACTERS

	;..
	;..

BUGH5:	CONSZ PI,177B27		;ARE WE AT INTERRUPT LEVEL?
	JRST BUGH7		;YES, FORGET USER AND JOB
	SKIPGE FORKX		;WAS A USER RUNNING?
	JRST BUGH7		;NO, CONTINUE ON
	LOAD T1,FKJSB		;GET JSB PAGE ADDRESS
	MOVE T1,SPT(T1)
	TXNE T1,NCORTM		;IS JSB IN CORE
	JRST BUGH7		;NO, FORGET THIS
	MOVEI T1,[SIXBIT \$*JOB: /\]
	JSR BUGMSG
	MOVE T1,JOBNO		;GET JOB NUMBER
	JSR BUGNO		;PRINT IT
	MOVEI T1,[SIXBIT \, USER: /\]
	JSR BUGMSG
	MOVE T3,USRNAM		;GET NUMBER OF WORDS IN USER NAME
	IMULI T3,5		;5 CHARACTERS PER WORD
	MOVE T2,[POINT 7,USRNAM+1] ;GET POINTER TO USER NAME
BUGH6:	ILDB T1,T2
	JUMPE T1,BUGH7		;JUMP IF END OF STRING
	JSR BUGTYO		;TYPE CHARACTER
	SOJN T3,BUGH6		;JUMP IF MORE CHARACTERS
BUGH7:	MOVE T2,1(Q1)		;GET FIRST WORD OF BUGHLT BLOCK
	TLNE T2,770000		;IS THIS SIXBIT?
	JRST BUGH10		;YES, THERE IS NO ADDITIONAL INFO
	MOVEI T1,[SIXBIT \$*ADDITIONAL DATA: /\]
	JSR BUGMSG
BUGH8:	CAIG T2,17		;IS THIS AN AC?
	JRST [ MOVE T1,BUGACS(T2) ;YES,GET CONTENTS OF AC
		JSR BUGNO	;PRINT CONTENTS
		JRST BUGH9]
	MAP T1,(T2)		;IS THIS ADDRESS IN CORE?
	TLNE T1,360000
	TLNE T1,200000		;HARD PAGE FAIL CODE?
	JRST BUGH9		;NO, CAN'T PRINT IT OUT
	MOVE T1,(T2)		;GET THE CONTENTS OF LOCATION
	JSR BUGNO		;PRINT IT OUT
BUGH9:	AOS Q1
	MOVE T2,1(Q1)		;GET NEXT ARGUMENT WORD
	TLNE T2,770000		;IS IT SIXBIT?
	JRST BUGH10		;YES, FINISHED
	MOVEI T1,[SIXBIT \, /\]
	JSR BUGMSG
	JRST BUGH8		;GET NEXT DATUM PRINTED
BUGH10:	MOVEI 1,[SIXBIT \$**********$/\]
	JSR BUGMSG
	JSR BUGPRI		;BACK INTO PRIMARY
	;..
	;..
BUGH2:	HRRZ T1,BUGHLT		;GET ADDRESS OF BUGHLT
	MOVX P1,BG%HLT		;SAY THIS IS A BUGHLT
	CALL BUGSTO		;QUEUE UP A SYSERR BLOCK
   IFN KLFLG,<
	CALL LOADME		;LET THE FRONT END REBOOT US
   >				; END IFN KLFLG
   IFN SMFLG,<
	SETONE KSRLD		;REQUEST RELOAD
	CONOAPR APFSET+APINE	;INTERRUPT 8080 FOR RELOAD REQUEST
   >				; END IFN SMFLG
	HALT .			;WAIT TO BE REBOOTED
	JRST SYSGO		;RELOAD AND RESTART
;LESS SERIOUS HALT - BUGCHK

BGCCHK::			;HERE VIA CALL BGCCHK
BUGC0::	AOS BUGNUM		;COUNT UP BUGCHK'S AND BUGINF'S SINCE STARTUP
	JRST @[.+1]
	SKIPN DCHKSW		;BREAKPOINT WANTED?
	JRST SKPCHK		;NO. SKIP THE BREAKPOINT
	SKIPN DDTPRS		;YES. DDT LOCKED?
	JRST SKPCHK		;SKIP THE BREAKPOINT
	MOVEM T1,BUGCHK		;SAVE T1
	MOVE T1,0(P)		;GET THE CALLING ADDRESS
	EXCH T1,BUGCHK		;RESTORE T1 AND SET BUGCHK

;HERE WHEN DEBUGGING IS ENABLED, DDT IS LOCKED DOWN.
;A BREAKPOINT CAN BE PLACED HERE TO ALLOW ANALYSIS OF
;A BUGCHK

CHKAD0::XCT CHKADR		;YES, EXECUTE BREAKPOINT
SKPCHK:	ADJSP P,1		;GET A WORD TO USE
	CONI PI,0(P)		;SAVE PI STATE HERE
	PIOFF
	AOSE BUGLCK		;FIRST TIME?
	HALT .			;NO
	MOVEM 17,BUGACS+17	;SAVE ACS
	MOVEI 17,BUGACS
	BLT 17,BUGACS+16
	MOVE P,BUGACS+P		;RESTORE P FOR A MOMENT
	MOVE T1,-1(P)		;GET ADDRESS OF BUGCHK
	MOVEM T1,BUGCHK		;LEAVE TRACKS
	MOVEI T1,-1(T1)		;...
	MOVE P,[-BUGPLN,,BUGPDL-1] ;GET A STACK
	MOVX P1,BG%CHK		;SAY THIS IS A BUGCHK
	CALL BUGSTO		;GO CREATE SYSERR ENTRY
	MOVE T1,BUGCHK		;ENTER SEC 1 IF NECESSARY
	TXNE T1,EXSCBT
	SE1ENT
	MOVSI 17,BUGACS		;RESTORE ACS
	BLT 17,17
	CALL DGFKIL		;RETURN ANY DIAG RESOURCES THE PROCESS MAY OWN
	MOVSI 17,BUGACS		;RESTORE ACS AGAIN
	BLT 17,17
	SETOM BUGLCK		;UNLOCK
	EXCH T1,0(P)		;SAVE T1, GET PI STATUS
	TXNE T1,PIPION		;NEED TO ENABLE?
	PION
	POP P,T1		;RESTORE T1
	AOS JB0FLG		;GET IT REPORTED
	RET			;CONTINUE
;PROCESS BUGINF

BGCINF::			;HERE VIA CALL BUGINF
BUGI0::	AOS BUGNUM		;COUNT UP BUGCHK'S AND BUGINF'S SINCE STARTUP
	JRST @[.+1]
	SKIPN DINFSW		;BREAKPOINT WANTED?
	JRST SKPINF		;NO. SKIP THE BREAKPOINT
	SKIPN DDTPRS		;YES. DDT LOCKED?
	JRST SKPINF		;SKIP THE BREAKPOINT
	MOVEM T1,BUGINF		;SAVE T1
	MOVE T1,0(P)		;GET THE ADDRESS OF THE CALLER
	EXCH T1,BUGINF		;SAVE BUGINF AND RESTORE T1

;HERE WHEN DEBUGGING IS ENABLED, DDT IS LOCKED DOWN, AND THE MONITOR
;IS WRITE-ENABLED. A BREAKPOINT CAN BE PLACED HERE TO ALLOW ANALYSIS OF
;A BUGINF

INFAD0::XCT INFADR		;YES, EXECUTE BREAKPOINT
SKPINF:	PIOFF
	AOSE BUGLCK		;FIRST TIME?
	HALT .			;NO
	MOVEM 17,BUGACS+17	;SAVE ACS
	MOVEI 17,BUGACS
	BLT 17,BUGACS+16
	MOVE P,BUGACS+P		;RESTORE P FOR A MOMENT
	MOVE T1,0(P)		;GET ADDRESS OF BUGINF
	MOVEM T1,BUGINF		;LEAVE TRACKS
	MOVEI T1,-1(T1)		;...
	MOVE P,[-BUGPLN,,BUGPDL-1] ;GET A STACK
	MOVX P1,BG%INF		;SAY THIS IS A BUGINF
	CALL BUGSTO		;GO CREATE SYSERR ENTRY
	MOVE T1,BUGINF		;ENTER SEC1 IF NECESSARY
	TXNE T1,EXSCBT		;CHECK SEC1 BTS
	SE1ENT
	MOVSI 17,BUGACS		;RESTORE ACS
	BLT 17,17
	AOS JB0FLG		;WAKE UP JOB 0 TO REPORT IT
	SETOM BUGLCK		;UNLOCK
	PION
	RET			;CONTINUE
;ROUTINE TO BUILD A SYSERR BLOCK
;ACCEPTS IN T1/	POINTER TO BUG HLT/CHK BLOCK
;	    P1/	HLT/CHK
;CALLED BY BUGHLT, BUGCHK, AND BUGINF CODE

BUGSTO:	HRRZ T1,0(T1)		;GET ADDRESS OF BLOCK ITSELF
	MOVEM T1,BUGP1		;SAVE POINTER TO BLOCK
	SETOM CRSTD1		;INITIALIZE TIME OF CRASH
	SKIPGE TADIDT		;TIME AND DATE NOW SET?
	JRST BUGST0		;NO
	MOVE T1,TADIDT		;GET INITIAL TIME
	MOVEM T1,CRSHTM		;SAVE IN LOW CORE FOR RELOAD
	MOVE T1,TODPWL		;YES, REMEMBER IT FOR RESTART
	MUL T1,[1B17]		;COMPUTE UNIV FORMAT (SEE GTAD)
	DIV T1,JFDAY
	CAML T2,JFDAY2
	AOS T1
	ADD T1,TADIDT
	MOVEM T1,CRSTD1		;PUT WHERE WILL SURVIVE OVER RELOAD
BUGST0:	MOVE T1,BUGCNT		;SEE HOW MANY ARE IN QUEUE
	CAIL T1,BUGMAX		;TOO MANY?
	JRST BUGST2		;TOO MANY. SEE ABOUT STATUS ONLY
	MOVX T1,BG%LEN		;GET LENGTH OF DATA SEG OF SYSERR BLK
	MOVX T2,BG%SIZ		;GET SIZE OF BLOCK
	CALL ALCSEB		;ALLOCATE A SYSERR BLOCK
	 JRST BUGST2		;NONE LEFT. DO STATUS ONLY THEN
	AOS BUGCNT		;COUNT UP THE QUEUED UP BLOCKS
	MOVEM T1,BUGSEB		;SAVE ADR OF BLOCK
	MOVE T2,[-BUGTLN,,BUGTBL]
	CALL SEBCPY		;LOAD UP BLOCK
	 JFCL			;IGNORING ERRORS
	MOVE T1,BUGSEB		;GET BACK POINTER TO BLOCK
	MOVSI T2,BUGACS		;PUT THE ACS INTO THE BLOCK
	HRRI T2,SEBDAT+BG%ACS(T1)
	BLT T2,SEBDAT+BG%ACS+17(T1)
	MOVEM P1,SEBDAT+BG%FLG(T1) ;SAVE CHK/HLT FLAG
	CONI PI,SEBDAT+BG%PIS(T1) ;SAVE PI FLAGS IN BLOCK
	CONI APR,SEBDAT+BG%APS(T1) ;SAVE APR FLAGS IN BLOCK
	CONI PAG,SEBDAT+BG%PGS(T1) ;SAVE PAGER FLAGS IN BLOCK
	DATAI PAG,SEBDAT+BG%PGD(T1) ;SAVE PAGER DATA IN BLOCK
   IFN KLFLG,<			;IF ON THE KL
	RDERA SEBDAT+BG%ERG(T1)	;READ ERROR REGISTER
   >				;END OF IFN KLFLG
	HRRZ T2,FORKX		;SEE IF THERE IS A FORK RUNNING
	HRLOM T2,SEBDAT+BG%JOB(T1) ;SAVE FORK NUMBER IN BLOCK
	CAIE T2,-1		;ANY FORK THERE?
	SKIPGE FKPT(T2)		;...
	JRST BUGST1		;NO, NO JOB EITHER
	HLRZ T3,FKJOB(T2)	;GET JOB NUMBER
	HRRM T3,SEBDAT+BG%JOB(T1) ;SAVE JOB NUMBER
	HRR T2,JOBDIR(T3)	;GET LOGGED-IN DIRECTORY NUMBER
	HRLI T2,USRLH		;MAKE THIS A USER NUMBER
	MOVEM T2,SEBDAT+BG%USR(T1) ;STORE IN BLOCK
	;..
	;..
BUGST1:	SETZM SEBDAT+BG%RCT(T1)	;MARK NO REGISTERS CURRENTLY
	ADDI T1,SEBDAT+BG%REG	;MAKE POINTER TO REGISTER BLOCK
	MOVEM T1,BUGP2		;SAVE POINTER
	MOVEM P,BUGP		;SAVE PUSH DOWN POINTER
	MOVSI 17,BUGACS		;RESTORE ACS
	BLT 17,17
BUGSTL:	AOS BUGP1		;STEP POINTER TO BUG CHECK BLOCK
	MAP T2,@BUGP1		;CHECK ADDRESS BEFORE REFERENCING
;**;[3069]CHANGE 5 LINES AT BUGSTL+2	RAH	JAN-19-84
	SMAPOK T2		;[3069]VALID MAPPING?
	IFNSK.			;[3069]
	  SETZ T2,		;[3069]NO. CAN'T REFERENCE BLOCK. USE ZERO.
	  JRST BUGSTD		;[3069]
	ENDIF.			;[3069]
	MOVE T2,@BUGP1		;GET FIRST DATA WORD IN BLOCK
	TLNE T2,770000		;SIXBIT NAME?
	JRST BUGSTD		;YES, DONE
	MOVEM T2,BUGP3		;SAVE POINTER TO REGISTER TO GET
;**;[3069]CHANGE 12 LINES		RAH	JAN-19-84
	CAIL T2,20		;[3069]AN AC?
	IFSKP.			;[3069]
	  MOVE T2,BUGACS(T2)	;[3069]YES.
	ELSE.			;[3069]
	  MAP T2,@BUGP3		;[3069]NO. CHECK ADDRESS.
	  SMAPOK T2		;[3069]OK TO REFERENCE IT?
	  TDZA T2,T2		;[3069]NO. USE ZERO.
	  MOVE T2,@BUGP3	;[3069]YES. GET DATA.
	ENDIF.			;[3069]
	MOVEM T2,@BUGP2		;SAVE IT IN SYSERR BLOCK
	AOS BUGP2		;STEP POINTER TO SYSERR BLOCK
	MOVE T2,BUGSEB		;GET POINTER TO BLOCK
	AOS SEBDAT+BG%RCT(T2)	;COUNT UP REGISTER COUNT
	JRST BUGSTL		;LOOP BACK TIL ALL COPIED

BUGSTD:	MOVE T1,BUGSEB		;GET POINTER TO BLOCK AGAIN
	MOVEM T2,SEBDAT+BG%NAM(T1) ;SAVE SIXBIT NAME OF BUG CHECK
	MOVE P,BUGP		;GET BACK PUSH DOWN POINTER
	CALL QUESEB		;QUEUE UP ERROR BLOCK
BUGST2:
   IFN KLFLG,<			;IF THE KL
	MOVEI T1,BUGBUG-BUGBUG	;GET PROPER INDEX FOR MESSAGE
	CALLRET GENBLK>		;DO STATUS
   IFN SMFLG,<RET>		;IF THE KS, JUST RETURN

BUGTBL:	SEBPTR 0,SBTEVC,SEC%BG	;EVENT CODE
	SEBPTR 0,SBTFNA,LOGBUG	;CALL LOGBUG TO GET MESSAGE STRING
	SEBPTR BG%ADR,SBTWD,BUGP1 ;ADDRESS OF BUG HLT/CHK
	SEBPTR BG%DAT,SBTWD,CRSTD1 ;TIME AND DATE OF CRASH
	SEBPTR BG%SER,SBTWD,APRSER ;APR SERIAL NUMBER
	SEBPTR BG%VER,SBTWD,[EXP SVNM] ;VERSION
	SEBPTR BG%SDT,SBTWD,SYSTAD ;BUILD TAD OF MONITOR BUILD
	SEBPTR BG%CNT,SBTWD,BUGNUM ;NUMBER OF BUG CHECKS SINCE STARTUP
BUGTLN==.-BUGTBL
		SUBTTL Write to CTY when PI's are off

;THESE ROUTINES SEND DATA TO THE CTY WHEN PI'S ARE OFF. NOTE THAT
;BUGT0 WAITS FOR CONFIRMATION THAT A CHARACTER WAS SENT

;HERE VIA JSR BUGTYO
;SEND A CHARACTER, AND FILL WITH NULLS IF IT'S A LINE FEED

BUGTY0::
	JSR BUGTYC		;OUTPUT THE CHARACTER
	CAIN 1,12		;LF?
	JRST [	MOVEI 1,0	;YES, PAD
		JSR BUGTYC
		JSR BUGTYC
		JSR BUGTYC
		JSR BUGTYC
		JRST .+1]
	JRST @BUGTYO		;RETURN TO CALLER

;HERE VIA JSR BUGTYC
;OUTPUT A SINGLE CHARACTER AND WAIT FOR IT TO GO.
;	T1/ CHARACTER TO BE SENT

BUGT0::
   IFN SMFLG,<			;KS TYPE OUT ROUTINE
BUGSML:	CONOAPR APFSET+APINE	;INTERRUPT EIGHTYEIGHTY
BUGSLL:	JN CTYOVL,,BUGSLL	;LOOP UNTIL LAST CHARACTER FINISHED
	STOR T1,CTYOCH		;STORE CHARACTER
	SETONE CTYOVL
	CONOAPR APFSET+APINE	;INTERRUPT 8080
BUGLP1:	JN CTYOVL,,BUGLP1	;WAIT FOR 8080
   >				;END OF SMFLG NE CONDITIONAL

   IFN DTFLG,<			;THE KL BUG TYPE OUT CODE
	SETZM DTETMD		;CLEAR FLAG
	TXO A,DTEMNO		;SET COMMAND FOR OUTPUT
	MOVEM A,DTECMD		;SET IN COMMAND WORD
	MOVEI A,DTEEDB		;MUST RING BELL
	XCT DTSCNW		;DO IT
	SKIPN DTETMD		;WAIT FOR RESPONSE
	JRST .-1
	LDB A,[POINT 7,DTECMD,35] ;RESTORE CHARACTER
   >				;END OF DTFLG NE CONDITIONAL
	JRST @BUGTYC		;RETURN TO CALLER
;HERE VIA JSR BUGMSG
;TYPE A STRING. REPLACE "$" WITH <CR><LF>. TERMINATE ON "/".
;	T1/ ADDRESS OF STRING

BUGMS0::
	MOVEM 7,BUG7		;PRESERVE AN AC
	MOVE 7,1
	HRLI 7,440600
BUGM2:	ILDB 1,7
	ADDI 1,40
	CAIN 1,"/"
	JRST BUGM5		; / MARKS END OF STRING
	CAIN 1,"$"
	JRST BUGM1
BUGM3:	JSR BUGTYO
	JRST BUGM2

;FOUND A "$". REPLACE IT WITH <CR><LF>.

BUGM1:	MOVEI 1,15
	JSR BUGTYO
	MOVEI 1,12
	JRST BUGM3

;FOUND A "/". THIS COMPLETES THE STRING

BUGM5:
BUGM6:	MOVE 7,BUG7		;RESTORE AC
	JRST @BUGMSG		;RETURN TO CALLER

RS BUG7,2			;TEMP

;HERE VIA JSR BUGNO
;TYPE A NUMBER
;	T1/ THE VALUE TO BE TYPED

BUGNO0::
	DMOVEM T2,BUG7			;PRESERVE AN AC
	MOVE T2,T1
	MOVNI T3,14			;THERE ARE 14 DIGITS IN NUMBER
BUGN1:	SETZ T1,
	LSHC T1,3			;GET FIRST DIGIT
	ADDI T1,60			;MAKE IT ASCII
	JSR BUGTYO			;TYPE IT OUT
	AOJN T3,BUGN1			;LOOP FOR ALL DIGITS
	DMOVE T2,BUG7			;RESTORE AC'S
	JRST @BUGNO			;RETURN
		SUBTTL Routines to switch protocols with front end

   IFN DTFLG,<

;HERE VIA JSR BUGMON
;ENTER SECONDARY PROTOCOL

BUGM0::
	DMOVEM T1,BUG7		;SAVE WORK REGISTERS
	MOVE T2,MSTRDT		;GET ID OF MASTER DTE
	LSH T2,SDTE		;FIND DTE SET
	SKIPN T1,DTEEPW(T2)	;IN PRIMARY?
	JRST BUGEXT		;NO. ALL DONE
	MOVEM T1,SVVEXM		;SAVE VALUE
	SETZM DTEEPW(T2)	;FORCE MONITOR PROTOCOL
	MOVEI T1,DTEEDB		;GET CODE FOR DOOR BELL
	MOVE T2,DTSCNW		;GET CONO WORD
	ADD T2,[<CONSZ 0>-<CONO 0>] ;MAKE A TEST INSTRUCTION
	XCT T2			;WAIT FOR -11 DOORBELL TO CLEAR
	JRST .-1
	MOVEI T1,DTEEMP		;GET COMMAND
	SETZM DTEFLG		;CLEAR FLAG
	MOVEM T1,DTECMD		;THE COMMAND WORD
	MOVEI T1,DTEEDB		;MUST RING BELL
	XCT DTSCNW		;DO IT
	SKIPN DTEFLG		;-11 ANSWER?
	JRST .-1		;NO
BUGEXT:	DMOVE T1,BUG7		;RESTORE REGS
	JRST @BUGMON		;YES. DONE

;HERE VIA JSR BUGPRI
;ENTER PRIMARY PROTOCOL

BUGP0::
	DMOVEM T1,BUG7		;SAVE REGS
	MOVE T2,MSTRDT		;GET ID OF MASTER DTE
	LSH T2,SDTE		;FIND EPT SET
	SKIPE DTEEPW(T2)	;NOW IN MONITOR PROTOCOL?
	JRST BUGEX1		;NO. JUST GET OUT
	SKIPN T1,SVVEXM		;GET SAVED VALUE
	JRST BUGEX1		;NO. NOTHING TO DO
	SETZM SVVEXM		;LEAVE IT 0 FOR THE NEXT GUY
	MOVEM T1,DTEEPW(T2)	;TURN ON VALID EXAMINE
	MOVEI T1,DTEEPP		;ENTER PRIMARY
	SETZM DTEFLG		;THE FLAG
	MOVEM T1,DTECMD		;THE COMMAND WORD
	MOVEI T1,DTEEDB		;SET UP TO RING -11'S BELL
	XCT DTSCNW		;DO IT
	SKIPN DTEFLG		;ANSWER YET?
	JRST .-1		;NO
BUGEX1:	DMOVE T1,BUG7		;RESTORE REGS
	JRST @BUGPRI		;YES. ALL DONE
   >
   IFN SMFLG,<


;HERE VIA JSR BUGMON -- ENTER MONTIOR MODE

BUGM0::	SKIPE PROFLG		;IF PROTOCOL POSSIBLE DO IT
	JRST [	SETZM FEFLG	;CLEAR FE FLAG
		MOVEM T1,SVVEXM	;SAVE REGISTER
		MOVE T1,RLWORD	;SAVE RELOAD WORD
		EXCH T1,SVVEXM ;RESTORE REGISTER AND SAVE RELOAD WORD
		SETZRO KPACT	;STOP KEEPALIVE
		JRST .+1]
	JRST @BUGMON

;HERE VIA JSR BUGPRI -- ENTER PRIMARY MODE

BUGP0::	SKIPE PROFLG		;IF PROTOCOL POSSIBLE DO IT
	AOS FEFLG		;SET FLAG
	EXCH T1,SVVEXM		;RESTORE RELOAD WORD
	MOVEM T1,RLWORD
	MOVE T1,SVVEXM		;RESTORE REGISTER
	JRST @BUGPRI		;RETURN

   >				;END IFN SMFLG
		SUBTTL Clock service

   IFN KLFLG,<
;APR INTERNAL CLOCK SERVICE

;CONI/CONO MTR,

MTR==024			;DEVICE CODE
GOPDEF RDEACT,<DATAI MTR,>	;TO READ EBOX TICKS
GOPDEF RDMACT,<BLKI MTR,>	;TO READ MBOX TICKS

MTRLOD==1B18			;LOAD  BITS 21-23
;	19-20			;UNUSED, MBZ
MTREPA==1B21			;ENABLE EXEC PI ACCOUNTING
MTRENA==1B22			;ENABLE EXEC NON-PI ACCOUNTING
MTRAMN==1B23			;ACCOUNTING METERS ON
MTRTBF==1B24			;TIME BASE OFF
MTRTBN==1B25			;TIME BASE ON
MTRCTB==1B26			;CLEAR TIME BASE
;	27-32			;UNUSED, MBZ
MTRPIA==7B35			;PI ASSIGNMENT

;CONI/CONO TIM

TIM==020			;DEVICE ASSIGNMENT

TIMCTR==<MASKB 0,17>		;INTERVAL COUNTER
TIMCIC==1B18			;CLEAR INTERVAL COUNTER
;	19-20			;UNUSED, MBZ
TIMITO==1B21			;INTERVAL TIMER ON
TIMDON==1B22			;DONE/CLEAR DONE
TIMICO==1B23			;COUNTER OVERFLOW
TIMPER==<MASKB 24,35>		;PERIOD REGISTER

;	KIEPT+504		;EBOX CLOCK DOUBLEWORD
;	KIEPT+506		;CACHE ACCT CLOCK DOUBLEWORD
TIMBAS=KIEPT+510		;TIME BASE CLOCK DOUBLEWORD
;	KIEPT+512		;PERF ANAL CLOCK DOUBLEWORD
TIMVIL=KIEPT+514		;VECTOR INTERRUPT LOCATION

TIMCHN==APRCHN			;PI ASSIGNMENT

TIMTMS==^D100			;TICKS/MILLISECOND INTERVAL COUNTER
BASTMS==^D1000			;TICKS/MS OF TIME BASE CLOCK
BASUNT==1B23			;UNITS POSITION TIME BASE CLOCK 2ND WORD

DEFINE MSCKOF <
	CONO MTR,MTRTBF>	;TURN CLOCK OFF

DEFINE MSCKON <
	CONO MTR,MTRTBN+MTRPIA>	;TURN CLOCK ON
   >				;END IFN KLFLG

   IFN SMFLG,<
TIMTMS==^D4100			;TICKS/MS OF INTERVAL COUNTER
BASTMS==^D4100			;TICKS/MS OF TIME BASE CLOCK
BASUNT==1B35			;UNITS POSITION OF TIME BASE VALUE
   >
;CLOCK INITIALIZATION

CLKINI:	MOVE T1,[^D<24*3600*1000>]
	MOVEM T1,JFDAY		;COMPUTE JIFFIES PER DAY
	IDIVI T1,2		;AND HALF THAT FOR ROUNDING
	MOVEM T1,JFDAY2
	MOVX T1,BASOV0		;COMPUTE HP CLOCK OVERFLOW VALUE
	SETZ T2,
	DIV T1,BASNDV
	MOVEM T1,BASOVV		;SAVE IT FOR USE BY MTIME CALLERS
   IFN KLFLG,<
	MOVE A,[MSEC1,,TIMIN0]	;SETUP VECTOR INTERRUPT ENTRY
	MOVEM A,TIMINT+3
	SETZM TIMINT+2
	MOVE A,[XPCW TIMINT]
	MOVEM A,TIMVIL
	CALL MTRON		;TURN ON METER AND INTERVAL TIMER
   >
   IFN SMFLG,<
	MOVEI T1,TIMTMS		;SET UP INTERVAL TIMER
	WRINT T1		;WRITE INTERVAL TIMER
	CONO APR,APFEN+APTMR+APRCHN ;ENABLE TIMER
   >
	RET

;INTERVAL TIMER INTERRUPT SERVICE

TIMIN0:
   IFN KLFLG,<CONO TIM,TIMITO+TIMDON+TIMTMS> ;CLEAR DONE
   IFN SMFLG,<CONOAPR APFCLR+APTMR>
	SOSN SCKATM		;DECREMENT SCHED ALARM, DUE NOW?
	ISB SCDCHN		;YES
   IFN KLFLG,<XJEN TIMINT>	;DISMISS INT
   IFN SMFLG,<XJEN PIAPRX>	;DISMISS INT

RS TIMINT,4			;INTERRUPT ENTRY DISPATCH

;UPDATE TODCLK - DONE ONLY ON REQUEST

UPDTCK::RDTIME T1		;READ TIME BASE
	DIV T1,BASDIV		;CONVERT TO MILLISECONDS
	MOVEM T1,TODCLK		;UPDATE MS CLOCK
	MOVEM T1,TODPWL		;UPDATE GTAD CLOCK
	RET

;read clock, convert to normal millisecond units

GETMST::RDTIME T1		;READ TIME BASE
	DIV T1,BASDIV
	RET

;READ HIGH-PRECISION CLOCK

BASND0==<BASTMS/NTMS>*BASUNT	;HW UNITS PER HP UNIT
BASOV0==1B<^L<BASND0>>		;VALUE AT WHICH HP WORD OVERFLOWS

MTIME::	RDTIME T1		;READ TIME BASE
	ANDI T1,BASOV0-1	;DO MODULO 76 HOURS
	DIV T1,BASNDV		;CONVERT TO HP UNITS
	JRST 0(4)
;DIVISORS FOR CONVERTING TIMEBASE CLOCK TO MONITOR UNITS

BASDIV::BASTMS*BASUNT		;CONVERT TO MILLISECONDS
BASNDV::BASND0			;CONVERT TO HP UNITS
RS BASOVV,1			;OVERFLOW VALUE FOR HP CLOCK
		SUBTTL DTE control routines

;GETMID - ROUTINE TO GENERATE A MEDIA ID FOR A STRUCTURE. THE LOW ORDER
;	  PART OF TIMBAS IS USED, SINCE AT STRUCTURE CREATION TIME THE
;	  NORMAL TIME AND DATE (A LA LGTAD) MAY NOT YET EXIST.
;
;CALL:		CALL GETMID
;RETURNS: +1 ALWAYS, WITH T1/ MEDIA ID

   IFN KLFLG,<
GETMID::MOVE T1,TIMBAS+1	;GET LOW ORDER PART OF TIMBAS AS MEDIA ID
   >				;END IFN KLFLG
   IFN SMFLG,<
GETMID::PUSH P,T2		;SAVE T2
	RDTIME T1		;READ TIME BASE
	EXCH T1,T2		;RETURN LOW ORDER TIME BASE
	POP P,T2		;RESTORE T2
   >				;END IFN SMFLG
	RET			;RETURN
;DTE20 INITIALIZATION
;START MONITOR IN SECONDARY PROTOCOL
   IFN DTFLG,<

DTEINS:	MOVE T1,[ DTESV0]
	MOVEM T1,DTESV+3	;INTERRUPT INITIATION
	SETZM DTESV+2
	MOVE T2,MSTRDT		;GET MASTER DTE
	LSH T2,SDTE		;FIND CORRECT EPT SET
	MOVE T1,[XPCW DTESV]
	MOVEM T1,DTEINT(T2)
	MOVEI T1,DTEMMN		;TURN ON MONITOR MODE TTY
	SETZM DTEFLG
	MOVEM T1,DTECMD
	MOVEI T1,DTEEDB+DTEPIE+DTECHN ;POKE -11 AND SET UP PI
	XCT DTSCNW		;DO IT
	SKIPN DTEFLG		;WAIT FOR COMPLETION
	JRST .-1
	RET

;SEND TTY CHARACTER VIA DTE20
; T1/ CHARACTER
; T2/ LINE NUMBER
;	CALL DTECHO
; RETURN +1, FAILURE, UNKNOWN LINE.
; RETURN +2, SUCCESS CHARACTER SENT.  TTODON WILL BE CALLED WHEN
;	OUTPUT HAS BEEN COMPLETED

DTECHO::CAME T2,CTYLNO		;CTY?
	RET			;NO, NOTHING ELSE SUPPORTED YET
	TXO T1,DTEMNO		;SET MONITOR MODE OUTPUT
	MOVEM T1,DTECMD		;PUT WHERE -11 SEES IT
	MOVEI T1,DTEEDB		;NEED TO RING -11'S BELL
	XCT DTSCNW		;DO IT
	RETSKP
;DTE20 INTERRUPT SERVICE
;HERE FROM JSR IN VECTOR INTERRUPT LOCATION

DTESV0:	MOVEM P,DTEACB+P	;SAVE HIGH ONE
	MOVEI P,DTEACB		;WHERE TO SAVE THE REGS
	BLT P,DTEACB+T4		;SAVE TEMPS
	MOVE P,DTESTK		;SET UP LOCAL STACK
	PUSH P,CX		;SAVE GENERAL TEMP
	MOVEI T1,DTETDB		;CLEAR OUR BELL
	XCT DTSCNW		;DO IT
	SKIPE DTETMD		;TTY OUTPUT DONE?
	JRST DTECO		;YES
	SKIPE DTEMTI		;TTY INPUT READY?
	JRST DTECI		;YES
DTESVX:	POP P,CX		;RESTORE REGS
	MOVSI T4,DTEACB
	BLT T4,T4
	MOVE P,DTEACB+P
	XJEN DTESV		;DISMISS

DTECO:	SETZM DTETMD		;CLEAR FLAG
	MOVE T2,CTYLNO		;ASSUME CTY
	CALL TTODON		;NOTIFY TTYSRV
	JRST DTESVX

DTECI:	MOVE T1,DTEF11		;GET FROM-11 DATA
	MOVE T2,CTYLNO		;ASSUME CTY
	SETZM DTEMTI		;CLEAR FLAG
	CALL TTIDON		;PASS CHAR TO TTYSRV
	JRST DTESVX

RS DTESV,4			;PC AND DISPATCH FOR JSR
   >				; END IFN DTFLG
   IFN SMFLG,<

; UNIBUS ADAPTER INITILIZATION -- CLEARS ALL THE UNIBUS
; WINDOWS EXCEPT 0 (USED FOR BOOTSTRAP) AND SETS THEM TO
; NOACCESS.

; UNBINI -- INITALIZES THE UNIBUS ADAPTER TO ALL NO ACCESS EXCEPT
; FOR THE FIRST REGISTER WHICH IS USED BY BOOT
;
; UNBRST -- RESTART FOR THE UNIBUS ADAPTER SETS ALL TO NO ACCESS
; EXCEPT FOR THE FIRST REGISTER


UNBINI::SETZ T4,0		;START WITH UNIBUS 0
UNBILP:	SETZM SMADNX(T4)	;SET UP TO START ALLOCATION AT REGISTER 1
	SETZM SMTEPT(T4)	;CLEAR POINTER INCASE NO UBA
	SKIPN UBAEXT(T4)	;CHECK FOR UBA EXISTANCE
	JRST UNBNAD		;NONE - DON'T ALLOCATE SPACE
	MOVE T1,[.RESP1,,200]	;SET UP SPACE FOR UNIBUS VECTORS
	MOVEI T2,.RESGP		;IN RESIDENT POOL
	PUSH P,T4
	CALL ASGRES		;ASSIGN FREE SPACE
	BUG(SMNOFR)
	POP P,T4
	HLRZ T2,UBAEXT(T4)	;GET OFFSET INTO EPT
	MOVEM T1,SMTEPT(T2)
	SETZ T2,0		;ERROR ON UNIBUS (TABLE ENTRY 0)
	MOVEM T2,0(T1)		;CLEAR VECTOR TABLE
	HRL T3,T1		;SET UP TO BLT THE
	HRR T3,T1		;VECTOR TABLE
	AOS T3
	BLT T3,177(T1)
	CALL UNBZRO		;ZERO UNIBUS WINDOWS
UNBNAD:	AOS T4			;NEXT ADAPTER
	CAIG T4,MXSMCH		;LAST ONE?
	JRST UNBILP		;NO TRY AGAIN
	CALLRET KMCSTP		;STOP THE KMC11 THEN EXIT

UNBRST::SETZ T4,0		;ZERO ALL WINDOWS
UNBRLP:	SKIPN UBAEXT(T4)	;CHECK FOR UBA EXISTANCE
	CALL UNBZRO		;ZERO
	AOS T4			;NEXT ONE
	CAIG T4,MXSMCH		;LAST ONE?
	JRST UNBRLP		;NO TRY AGAIN
	;CALLRET KMCSTP		;STOP THE KMC11 THEN EXIT

;HERE TO STOP THE KMC11
KMCSTP:	MOVE T1,[KMCADR]	;ADDRESS OF THE KMC11
	CALL UBGOOD		;IS THERE ONE ?
	RET			;NO SO DONE
	DMOVE T1,[EXP KMCADR,0]	;GET ADDRESS AGAIN
	WRIO T2,(T1)		;STOP THE KMC11
	RET

UNBZRO::MOVEI T2,UNBTMO+UNBBME+UNBBPE+UNBNED+UNBENI+UNBDTR+UNBPI7+UNBPI5
	MOVE T1,UBAEXT(T4)	;FIND UNIBUS EXTERNAL PAGE ADDRESS
	SETZ T3,0		;CHECK TO SEE IF UBA EXISTS
	TIOE T3,UNBSTS(T1)	;IF SKIPS THEN ALL OK
	RET			;NO UBA HERE
	WRIO T2,UNBSTS(T1)	;RESET UNIBUS ADAPTER
	MOVNI T2,UBAPGS		;GET THE NUMBER OF REGISTERS
UNBIN1:	WRIO T3,(T1)		;CLEAR THE REGISTERS
	AOS T1			;POINT TO NEXT REGISTER
	AOJN T2,UNBIN1		;DO UNTIL DONE
	RET



UBAEXT::0			;UNIT 0 DOES NOT EXIST
	UBAEXP			;UNIBUS ADAPTER EXTERNAL PAGE ADDRESSES (#1)
	0			;UNIT 2 DOES NOT EXIST
	UB1EXP			;UNIBUS ADAPTER EXTERNAL PAGE ADDRESS (#3)
	UB4EXP			;UNIBUS ADAPTER EXTERNAL PAGE ADD(# 4)
;
; ALUBWA: -- SUBROUTINE TO ALLOCATE UNIBUS WINDOW ADDRESSES
; FROM THE FREE POOL OF THE SM10 UNIBUS ADAPTER.
;
;	CALLING SEQUENCE:
;
;	T1 -- UNIBUS ADAPTER NUMBER (CURRENTLY ONLY 0 IS LEGAL)
;	T2 -- NUMBER OF CONTIGUOUS REGISTERS TO ALLOCATE
;	CALL ALUBWA
;	T1 -- EXTERNAL PAGE ADDRESS OF SM10 MAP REGISTER
;	T2 -- BASE OF PDP11 BUS ADDRESS FOR THIS MAP SLOT
;	RETURNS +1 -- NO MORE MAP REGISTERS AVAILABLE
;	RETURNS +2 -- FOUND REGISTER
;

ALUBWA::PUSH P,SMADNX(T1)		;SAVE ADDRESS OF LAST ALLOCATED
	ADDB T2,SMADNX(T1)		;GET A REGISTER
	CAILE T2,MXUBWN		;CHECK FOR MAX WINDOW NUMBER
	RETBAD ()		;ERROR NONE LEFT
	POP P,T2		;FIND LAST
	AOS T2			;POINT TO THIS ONE
	MOVE T3,T1		;SAVE ADAPTER NUMBER
	MOVE T1,T2		;RETURN REGISTER ADDRESS
	ADD T1,UBAEXT(T3)	;SET UNIBUS ADAPTER STARTING ADDRESS OF WINDOW
	IMULI T2,UBAMUL		;MAKE PDP11 ADDRESS OUT OF IT
	RETSKP			;AND RETURN TO CALLER
;
; UBGOOD -- SUBROUTINE TO TEST TO SEE IF A UNIBUS ADDRESS
; EXISTS.
;
;	CALLING SEQUENCE:
;
;	T1 -- ADDRESS TO TEST
;
;	RETURNS +1 ADDRESS NOT FOUND
;	RETURNS +2 ADDRESS FOUND
;
;

UBGOOD::MOVE T2,[KIPFS]		;SET UP FOR CORRECT PAGEFAIL TRAP
	SETZ T3,0		;AND SET TEST FOR NO BITS
	PIOFF			;TURN OFF PI REQUESTS
	EXCH T2,UPTPFN		;SET PAGE FAIL TRAP ADDRESS
	TIOE T3,0(T1)		;TEST ADDRESS
	SKIPA			;FAILED
	AOS 0(P)		;SKIP RETURN
	MOVEI T4,UNBNED		;CLEAR NED IN UNIBUS ADAPTER
	HRRI T1,UNBSTW		;GET BASIC ADDRESS OF UNIBUS
	BSIO T4,0(T1)		;CLEAR NED
	JFCL			;NO ERROR HERE UBA DIDN'T EXIST EITHER
	EXCH T2,UPTPFN		;RESTORE TRAP ADDRESS
	PION
	RET			;RETURN


; PROINI -- PRIMARY PROTOCOL INITLIZATION FOR SM10
; CURRENTLY IT SETS FEFLG TO MAKE TTYSRV USE OTHER
; THAN CTY.

PROINI::SKIPN PROFLG		;SHOULD WE CHANGE?
	RET			;NO RETURN
	SETONE KPACT		;SET KEEP ALIVE
	AOS FEFLG		;YES - SET FEFLG
	RET			;RETURN
; INTETY -- SUBROUTINE TO CAUSE THE KS10 TO INTERRUPT THE 8080

;  ALTERS NO REGISTERS

INTETY::CONOAPR APFSET+APINE
	RET			;RETURN TO CALLER
   >				;END IFN SMFLG
;AC BLOCK ASSIGNMENTS

MONACB==0			;MONITOR
USRACB==1			;USER
APRACB==2			;APR INT AC BLOCK
HW7ACB==7			;HARDWARE HAS SOME THINGS IN BLOCK 7
	BK7PFD==0		;DATA WORD ON AR/ARX PARITY ERROR
	BK7IOP==2		;PF WORD ON IO PAGE FAIL

DEFINE CLHWPT<
	DATAO PAG,KIPGWD>	;CLEAR AND LOAD PAGING HARDWARE

;DEFINITION OF PAGE FAIL WORD

PFUSR==:1B0			;USER REFERENCE
PFHPFF==:1B1			;HARD FAILURE
PFACC==:1B2			;ACCESS BIT FROM PAGING MEM
PFWRT==:1B5			;WRITE REFERENCE
PFCOD==:<MASKB 1,5>		;PAGE FAIL CODE
PFPGNO==:37777B26		;PAGE NUMBER OF REFERENCE
PFVADR==:<MASKB 13,35>		;VIRTUAL ADDRESS OF REFERENCE
;**;[3069]DELETE AND ADD DEFINITIONS	RAH	JAN-19-84
;PFPAGR==:1B8			;[3069]MAP INST DATA - PAGED REF
TWHPFF==:1B1			;[3069]HARD FAILURE
TWVALD==:1B2			;[3069]VALID TRANSLATION,IF TWHPFF OFF.

RS KIPGWD,1			;PAGER WORD FOR DATAO
RS PFSA1,2			;SAVED ACS AT KIPFS
		SUBTTL Context-handling routines

;INIT PAGING AND MUUO HANDLERS
   IFN KLFLG,<

PAGRST::MOVE 1,KIPGW0
	TXZ T1,PGNSAC		;STORE ACCOUNT DATA FROM NOW ON
	MOVEM 1,KIPGWD		;SET UP FOR DATAO PAG
	MOVE 1,[MSEC1,,.LBCHK]	;GET LUUO DISPATCH ADDRESS
	MOVEM 1,.LUTRP+3	;STORE IN DATA BLOCK
	MOVE 1,[XWD IEPT0,EPTTPI]
	BLT 1,EPTTPI+NIEPT-1
	MOVE 1,[IUPT0,,SKHWPT+420]
	BLT 1,SKHWPT+437	;INIT SYSTEM HWPT
	DATAO PAG,SETHWR	;SET TO REFERENCE HARDWARE RESERVED ACS
	MOVEI T1,SPT		;DECLARE SPT BASE
	UMOVEM T1,SPTBR		;(WORD IN RESERVED AC BLOCK)
	MOVEI T1,CST0		;DECLARE CST BASE
	UMOVEM T1,CSTBR		;(WORD IN RESERVED AC BLOCK)
	MOVX T1,XGAGE+CORMB+PSTFLD	 ;CST MASK SELECTS USE AND MODIFIED BITS
	UMOVEM T1,CSTMSK	;(WORD IN RESERVED AC BLOCK)
	MOVX T1,PSASM		;SET AGE TO ARBITRARY LEGAL VALUE
	UMOVEM T1,CSTDAT	;(WORD IN RESERVED AC BLOCK)
	DATAO PAG,SETMON	;SET TO MONITOR ACS
	MOVE A,[KIPFS]		;SETUP PAGE FAIL DISPATCH
	MOVEM A,UPTPFN-HWPTA+SKHWPT ;SETUP PAGE FAIL DISPATCH
	MOVX A,PGKLMD+PGTPEN
	IORM A,CONOPG		;USE KL MODE PAGING
	RET
   >				;END IFN KLFLG

   IFN SMFLG,<
PAGRST::MOVE T1,KIPGW0
	MOVEM T1,KIPGWD		;SET UP FOR WRUBR
	MOVE 1,[MSEC1,,.LBCHK]	;LUUO DISPATCH
	MOVEM 1,.LUTRP+3	;STORE IN DATA BLOCK ADDRESS
	MOVE T1,[XWD IEPT0,EPTTPI]
	BLT T1,EPTTPI+NIEPT-1	;INIT TRAP FUNCTION WORDS IN EPT
	MOVE T1,[IUPT0,,SKHWPT+420] ;INIT TRAP FUNCTION WORDS AND MUUO
	BLT T1,SKHWPT+437	; BLOCKS IN UPT
	MOVEI T1,SPT		;DECLARE SPT BASE
	WRSPB T1
	MOVEI T1,CST0		;DECLARE CST BASE
	WRCSB T1
	MOVX T1,XGAGE+CORMB+PSTFLD	 ;CST MASK SELECTS USE AND MODFIED BITS
	WRCSTM T1
	MOVX T1,PSASM		;SET AGE TO ARBITRARY LEGAL VALUE
	WRPUR T1
	MOVE T1,[KIPFS]		;SETUP PAGE FAIL DISPATCH
	MOVEM T1,UPTPFN-HWPTA+SKHWPT ;SETUP PAGE FAIL DISPATCH
	MOVX T1,PGKLMD+PGTPEN
	IORM A,CONOPG		;USE KL MODE PAGING
	RET

   >				;END IFN SMFLG
;CACHE CONTROL

RS CASHF,1			;STATE OF THE CACHE (-1 FOR ON, 0 FOR OFF)
   IFN KLFLG,<

;TURN CACHE ON

CASHON::SETOM CASHF		;INDICATE CACHE ON
	CONSZ PAG,PGCLKE+PGCLDE	;CASH NOW ON?
	RET			;YES, DO NOTHING
	CONI PI,T2		;SAVE PI STATE
	PIOFF
	CCHIA			;INVALIDATE ALL
	CONSO APR,APSWPD	;WAIT UNTIL DONE
	JRST .-1
	CONOAPR APFCLR+APSWPD	;CLEAR DONE BIT
	MOVX A,PGCLKE+PGCLDE
	IORM A,CONOPG		;SET CACHE ENABLE BITS
	CONO PAG,@CONOPG	;DO IT
	TXNE T2,PIPION		;RESTORE PI STATE
	PION
	RET

;TURN CACHE OFF

CASHOF::SETZM CASHF		;INDICATE CACHE OFF
	CONSO PAG,PGCLKE+PGCLDE	;CASH NOW OFF?
	RET			;YES, DO NOTHING
	MOVX A,PGCLDE		;NO. GET LOAD BIT
	ANDCAB A,CONOPG		;CLEAR LOAD LEAVING ONLY LOOK
	CONO PAG,@A		;SET CACHE TO LOOK ONLY
	CCHUA			;STORE ALL CACHE DATA
	CONSO APR,APSWPD
	JRST .-1		;WAIT FOR DONE
	CONOAPR APFCLR+APSWPD	;CLEAR DONE BIT
	TXZ A,PGCLKE+PGCLDE	;CLEAR CACHE ENABLE BITS
	CONO PAG,@A		;TELL HARDWARE
	MOVEM A,CONOPG
	RET

;FLUSH A SPECIFIED PAGE FROM THE CACHE
;T1/ PHYSICAL PAGE
;	CALL CASHFP
;RETURNS+1(ALWAYS):
;	PAGE WRITTEN BACK AND INVALIDATED
;PRESERVES ALL ACS

CASHFP::CCHUO (T1)		;START UNLOAD SWEEP
	CONSO APR,APSWPD	;WAIT FOR DONE FLAG
	JRST .-1		; ...
	CONOAPR APFCLR+APSWPD	;CLEAR FLAG
	RET			;DONE
   >				;END IFN KLFLG

   IFN SMFLG,<
; CACHE SIMULATION FOR SM10

CASHON::SETOM CASHF		;INDICATE CACHE ON
	RET

CASHOF::SETZM CASHF		;INDICATE CACHE OFF
	RET

CASHFP::RET			;FLUSH PAGE ROM CACHE
   >				;END IFN SMFLG
;INIT NEWLY CREATED FORK

FKSETK::MOVE 1,[XWD IUPT0,UPTTPI]
	BLT 1,UPTTPI+NIUPT-1	;INIT UPT
	MOVE 1,[ENSKED]
	MOVEM 1,ENSKR+3
	SETZM ENSKR+2
	MOVE A,[MSEC1,,PGFAIL]
	MOVEM A,UPTPFN		;SETUP PAGE FAIL NEW PC
	SETZM UPTPFL
	RET

;ASSORTED STANDARD FORMS OF DATAO PAG.
;KIPGW0 - LOAD UBR TO POINT TO SCHEDULER'S UPT
;SETMON - SET CURRENT AC'S TO MONITOR'S AC'S, PREVIOUS TO USER'S
;SETUSR - SET CURRENT AC'S TO USER'S AC'S
;SETBK7 - SET CURRENT AC'S TO MONITOR'S, PREVIOUS TO AC'S USED BY HARDWARE
;SETAPI - SET CURRENT AC'S TO AC'S USED BY HARDWARE, PREVIOUS TO APR INTERRUPT AC'S

KIPGW0: PGLUBR+PGNSAC+SKHWPT/PGSIZ
SETMON::PGLACB+FLD(MONACB,PGCACB)+FLD(USRACB,PGPACB) ;SET MON CONTEXT
SETUSR::PGLACB+FLD(USRACB,PGCACB)		 ;SET USER CONTEXT
SETBK7::PGLACB+FLD(MONACB,PGCACB)+FLD(HW7ACB,PGPACB) ;SET BK7 PREVIOUS
SETAPI:	PGLACB+FLD(HW7ACB,PGPACB)+FLD(APRACB,PGCACB) ;APR INT ACS
;UPT AND EPT TEMPLATES

;IUPT0 - TEMPLATE FOR UPT. COPIED INTO A PROCESS'S PSB WHEN IT IS CREATED
;First location is LUUO word. If left as initalized below, an
;LUUO by the user (from non-zero section) will cause an illegal memory
;reference. User can change the location via SWTRP JSYS.

	LUUNUL==<7777,,-1>	;DEFAULT ADDRESS

IUPT0:	LUUNUL			;LUUO TRAP WORD

;Next three locations are trap words. Initial values cause trap 1 and trap 3
;to be ignored. Trap 2 (push down overflow) executes an MUUO.
;If user has executed SWTRP JSYS or enabled for interrupts on arithmetic
;overflow, next location contains an MUUO.

	JFCL			;USER AROV TRAP
	.PDOVT			;USER PDL OV TRAP
	JFCL			;USER TRAP 3

;Next 4 words are MUUO block. Microcode stores into them when MUUO is
;executed.

	0			;MUUO AND PAGE FAIL WORDS (4)
	0
	0
	0

;Next 8 words are trap function words. Each contains location to which
;control is transferred when an MUUO is executed under the conditions
;indicated (trap/no-trap, EXEC mode/user mode)

	MSEC1,,KIMUOM		;KERNAL NO-TRAP (JSYS)
	MSEC1,,KITRPM		;KERNAL TRAP (PAGING, PDL OV)
	MSEC1,,KIMUOS		;SUPV. NO-TRAP (NOT USED)
	MSEC1,,KITRPS		;SUPV. TRAP (NOT USED)
	4000+MSEC1,,KIMUOU	;USER (CONC.) NO-TRAP
	4000+MSEC1,,KITRPU	;USER (CONC.) TRAP
	4000+MSEC1,,KIMUOU	;USER (PUBLIC) NO-TRAP (JSYS, 10/50)
	4000+MSEC1,,KITRPU	; " TRAP (PAGING, OV, PDL OV)
				;TRAPS FROM USER SET UXCT BIT
NIUPT==.-IUPT0
;Prototype EPT LUUO and trap words
;If the monitor executes an LUUO from non-zero section, it BUGHLT's
;at .LBCHK.

IEPT0:	MSEC1,,.LUTRP		;LUUO FROM MONITOR
	JFCL			;MONITOR AROV
	.PDOVT			;MONITOR PDL OV
	JFCL			;MONITOR TRAP 3
NIEPT==.-IEPT0

;
; LUUO FROM MONITOR CONTEXT TRAP

RS	.LUTRP,4		;LUUO BLOCK

.LBCHK:	BUG(LUUMON)
;SAVE AND RESTORE STUFF POSSIBLY VULNERABLE WHEN SCHEDULER
;IS STARTING AND STOPPING PROCESS
;CALLED WITH JSP 7,

KISSAV::JSP 4,MTIME		;READ HIGH PRECISION CLOCK
	MOVEM 1,SKDLST		;NOTE TIME SCHED OVERHEAD STARTED
	XJRSTF [PCU		;TURN ON UXCT FLAG
		0,,.+1]
   IFN KLFLG,<
	SKIPE ADRBRK		;ADDRESS BREAK IN PLACE?
	DATAO APR,[0]		;YES, CLEAR IT
   >
	MOVEI 5,UAC		;SAVE AC'S FROM USER BLOCK (BLOCK 1)
	XBLTUM [BLT 5,UAC+17]
	JRST 0(7)

KISLOD::XJRSTF [PCU		;SET UXCT FLAG
		0,,.+1]
	MOVSI 5,UAC		;RESTORE USER'S AC'S (BLOCK 1)
	XBLTMU [BLT 5,17]
   IFN KLFLG,<			;IF THE KL
	SKIPE T1,ADRBRK		;ADDRESS BREAK IN PLACE?
	JRST [	LOAD T2,ABFLG	;YES, GET FLAG BITS
		JSP T4,SETBRK	; AND SET IT UP
		JRST .+1]
   >
KISLD1:	JSP 4,MTIME		;READ HIGH PRECISION CLOCK
	MOVEM 1,FKT0		;INIT MEASURING INTERVAL
	SKIPE FKTOFF		;CLOCK OFF?
	MOVEM T1,FKTOFF		;YES, UPDATE OFF TIME
	SUB 1,SKDLST		;COMPUTE TIME SINCE LAST SCHED UPDATE
	CAIGE T1,0		;OVERFLOW?
	ADD T1,BASOVV		;YES, CORRECT
	ADDM 1,SKDOVH		;CHARGE IT TO SCHED OVERHEAD
	JRST 0(7)
;SETUP OVERFLOW TRAP INSTRUCTION IF PROCESS HAS ENABLED OV INTERRUPTS

	SWAPCD			;ONLY CALLED IN PROCESS CONTEXT
;SETOVF::SETZM T1		;FOR SELF
SETOV0::SKIPE ARTHTR(T1)	;USER-SPECIFIED TRAP INSTRUCTION?
	JRST SETOV1		;YES. SET UP TRAP THEN
	MOVE T3,PSICHM(T1)	;PROCESS CHN MASK
	MOVSI T2,<JFCL>B53	;USE JFCL IF NO INTS
	TLNE T3,(1B6+1B7)	;OVERFLOW OR FLOATING OV?
SETOV1:	MOVSI T2,<.AROVT>B53	;YES, USE TRAP MUUO
	MOVEM T2,UPTOVI(T1)
	RET
	RESCD			;BACK TO RESIDENT MONITOR

;CONVERT FROM A MODEL A TO MODEL B CPU FORMATS FOR MUUO'S

CVTMAB:	MOVEM CX,MONPC		;SAVE PC IN PSB
	MOVEM T1,KIMUFL		;SAVE T1
	MOVE T1,KIMUPC		;PICK UP THE KIMUUO WORD
	HRRZ CX,T1		;FORM EFFECTIVE ADDRESS ONLY
	EXCH CX,KIMUEF		;STORE EFFECTIVE ADDRESS AND PICK UP PC & FLAGS
	HLR T1,T1		;PUT OPCODE AND AC IN RIGHT HALF
	HLL T1,CX		;PUT IN FLAGS
	EXCH T1,KIMUFL		;SAVE FLAGS AND RESTORE T1
	HRRZM CX,KIMUPC		;SAVE PC
	JRST @MONPC		;END RETURN
   IFN KLFLG,<

;SET ADDRESS BREAK.  CALL WITH JSP T4,SETBRK WITH C(T1)=ADDRESS,
; C(T2)=USER FLAGS (RIGHT-JUSTIFIED -- WILL BE LSH'ED TO RIGHT PLACE)

SETBRK::ANDX T1,EXPCBT		;MASK OFF ALL BUT ADDRESS
	LSH T2,<^D35-^L<AB%XCT>> ;PUT BITS IN RIGHT PLACE (ASSUMES THAT
				; AB%XCT IS RIGHTMOST FLAG BIT)
	TXZE T2,AB%RED		;CONVERT SOFTWARE BITS TO
	TXO T1,ABDR		; HARDWARE BITS
	TXZE T2,AB%WRT		; ..
	TXO T1,ABDW
	TXZE T2,AB%XCT
	TXO T1,ABIF
	TXO T1,ABUM		;ALL REFERENCES TO USER ADDRESSES
	TLZ T1,777000
	DATAO APR,T1		;SET IT UP
	JRST 0(T4)		;RETURN

;CHECK AVAILABILITY OF ADDRESS BREAK (DOESN'T EXIST ON KS10)

BRKAVL::RETSKP
   >

   IFN SMFLG,<
BRKAVL::RET
SETBRK::JRST 0(T4)
   >


;CKXADR - CHECK IF MACHINE SUPPORTS EXTENDED ADDRESSING
;
;call:		call CKXADR
;returns: +1	EXTENDED ADDRESSING NOT SUPPORTED, T1/ ERROR CODE
;	  +2	EXTENDED ADDRESSING SUPPORTED

CKXADR::SKIPN EXADFL		;HARDWARE SUPPORT EXT. ADDRESSING?
	RETBAD (ARGX28)		;NO, "NOT AVAILABLE ON THIS SYSTEM"
	RETSKP			;YES
;Here for Kernel or Supervisor No-trap MUUO

;PAGER TRAPS CAN HAPPEN AT CERTAIN POINTS HEREIN.  SINCE THE
;PAGE TRAP IS VIA AN MUUO, KIMUPC AND KIMUUO MUST NOT
;BE VULNERABLE AT THOSE TIMES. (KI10 ONLY)

KIMUOS:
KIMUOM:
	DATAO PAG,SETMON	;CLEAR PCS
	SKIPN EXADF1		;EXTENDED ADDRESS? (MODEL B)?
	JSP CX,CVTMAB		;CONVERT MODEL A TO B

	LDB CX,[POINT 9,KIMUFL,26] ;GET OPCODE
	CAIE CX,<JSYS>B62	;JSYS?
	JRST KIMUO4		;NO
	HRRZ CX,KIMUEF		;YES, GET E
	CAIGE CX,1000		;EXEC JSYS?
	JRST MENTM		;YES, GO TO ENTRY SEQUENCE
	CAIG CX,DMSMAX		;DMS JSYS?
	JRST BADDMS		;YES, NOT ALLOWED FROM THE MONITOR
	MOVS CX,0(CX)		;NO, SIMULATE JSYS (NOT USED BY
	HRRZ 2,CX		;GET ADDRESS ONLY
	MOVEM 1,0(2)		; ANY MONITOR CODE, ONLY MDDT)
	MOVE 1,FPC		;GET PC
	EXCH 1,0(2)		;STORE IT VIA LH OF E
	HLRM CX,FPC		;SETUP JUMP ADDRESS
	XCT MJRSTF		;JUMP

KIMUO4:				;HERE WHEN NOT A JSYS
	JUMPN CX,KIMUO5		;IS IT AN ILLEGAL UUO?

;**;[2839] REPLACE 3 LINES WITH 10 LINES AT KIMUO4+1L	DSC	25-OCT-82
	;None of the above, check for bad byte pointers

	PUSH P,T3	      ;[2839]SAVE WORK REG
	CALL KIMXCT	      ;[2839]PXCT OF A BYTE INSTRUCTION?
	IMULI T3,2	      ;[2839]DISPATCH BY DOUBLEWORDS
	JRST KIXCT1(T3)	      ;[2839]DISPATCH
KIXCT1:	POP P,T3	      ;[2839]RESTORE T3
	JRST KIBADU	      ;[2839]BUGHLT
KIXCT2:	POP P,T3	      ;[2839]RESTORE T3
 	ITERR (ARGX09)	      ;[2839]GENERATE INST TRAP, GIVE ERROR
KIXCT3:	POP P,T3	      ;[2839]RESTORE T3
	XCT MJRSTF	      ;[2839]IGNORE THE INSTRUCTION

;HERE WHEN THE CAUSE APPEARS TO BE AN ILLUUO.  IT IS POSSIBLE THAT
;THE CAUSE OF THE ILLUUO IS PXCT OF A BYTE INSTRUCTION WITH A BAD
;BYTE POINTER.  IF THE USER SENDS A <<77B5>!<ANYTHING ELSE>> AS A
;BYTE POINTER TO A JSYS (EG. PSOUT) THEN AN ILLUUO WILL RESULT.
;WE WILL CHECK THE PC THAT CAUSED THE ILLUUO.  IF IT CONTAINS A PXCT
;OF A BYTE INSTRUCTION THEN WE WILL GENERATE AN ILLEGAL INSTRUCTION
;TRAP AND NOT CRASH.  THIS CODE ASSUMES THAT SECTION 0 AND SECTION 1
;HAVE A COMMON MAP.  THIS CODE ALSO ASSUMES THAT MONITOR CODE WILL
;NEVER EXECUTE IN SECTIONS OTHER THAN 0 OR 1.
;
;ON RETURN, T3 CONTAINS:
;	0	MONITOR WILL BUGHLT
;	1	MONITOR WILL ITRAP USER
;	2	MONITOR WILL CONTINUE AT MONITOR PC + 1 (BEFORE TRAP)

KIMXCT:				;HERE TO DETERMINE IF PXCT OF BYTE INST
	STKVAR <KIMXT1,KIMXT2,KIMXPC,KIMXFG>
	MOVEM T1,KIMXT1		;SAVE T1 AND T2
	MOVEM T2,KIMXT2
	HRRZ T1,KIMUPC		;GET THE UUO PC
	SOJ T1,			;GET THE PC OF INST THAT CAUSED ILLUUO
	MOVEM T1,KIMXPC		;SAVE THE ILLUUO PC
	MOVE T1,KIMXT1		;RESTORE T1
	SETZM KIMXFG		;RESET THE XCT FOUND FLAG

;**;[2839] REPLACE 3 LINES WITH 8 LINES AT KIMXCT+9	DSC	25-OCT-82

	MOVE T2,@KIMXPC	      ;[2839] GET THE INSTRUCTION WORD
	LDB T1,[POINT 9,T2,8] ;[2839] GET THE OPCODE
	CAIE T1,<<IBP>_-^D27> ;[2839] IS IT IBP OR ADJBP?
	 JRST KIMXLP	      ;[2839] SEE IF ITS AN XCT
	SKIPGE INTDF	      ;[2839] ARE WE NOINT
	SKIPA T3,[1]	      ;[2839] NO
	MOVEI T3,2	      ;[2839] YES
	JRST KIMXCF	      ;[2839] GO RESTORE ACS AND RETURN

KIMXLP:				;LOOP TO CHASE DOWN PXCT CHAIN
	CAIE T1,<<XCT>_-^D27>	;IS IT AN XCT?
	 JRST KIMXCR		;NO...SO SEE IF IF ITS A BYTE PXCT
	SETOM KIMXFG		;YES...SET THE XCT FOUND FLAG
;**;[3200]  Add 1 line after KIMXLP:+3			DML	11-Jan-84
	MOVE T2,KIMXT2		;[3200] GET INSTRUCTION WHICH CAUSED UUO
	TXZ T2,<777>B8		;ZERO THE OPCODE FIELD
	TXO T2,IFIW		;MAKE THIS AN IFIW POINTER
	MOVEM T2,KIMXPC		;SAVE IT AS THE NEW PC
	MOVE T1,KIMXT1		;RESTORE ACS
	MOVE T2,KIMXT2
;**;[2839] INSERT 2 LINES AT KIMXLP+8L	DSC	25-OCT-82
	MOVE T2,@KIMXPC	      ;[2839] GET THE INSTRUCTION WORD
	LDB T1,[POINT 9,T2,8] ;[2839] GET THE OP-CODE
	JRST KIMXLP		;LOOP TO FIND NEXT INSTRUCTION
;**;[2839] CHANGE 1 LINE AT KIMXCR+1L	DSC	25-OCT-82
KIMXCR:				;HERE WHEN PXCT OF BYTE INST NOT TRUE
	SKIPN KIMXFG		;HAVE WE SEEN AN XCT?
	 JRST KNOXCT		;NO....
;**;[2905] ADD 3 LINES AT KIMXCR: + 3L	DSC	23-JAN-83
	SKIPGE INTDF		;[2905]NOINT?
	SKIPA T3,[1]		;[2905]NO, SET UP TO ITRAP
	 MOVEI T3,2		;[2905]YES, CAN'T ITRAP, CONTINUE...
	CAIL T1,133		;IS IT A BYTE INSTRUCTION?
	 CAILE T1,137		;IS IT A BYTE INSTRUCTION?
;**;[2839] REPLACE 2 LINES WITH ONE LINE AT KIMXCR+5L	DSC	25-OCT-82
KNOXCT:	SETZM T3	      ;[2839] NOT A BYTE INST.

KIMXCF:	MOVE T1,KIMXT1		;RESTORE ACS
	MOVE T2,KIMXT2
	RET			;RETURN AT NON-SKIP RETURN

KIBADU:	BUG(ILLUUO,<<KIMUFL,FLAGS>,<KIMUPC,PC>,<KIMUEF,EFFADR>>)
	JRST ILUUO

BADDMS:	BUG(ILLDMS,<<KIMUPC,PC>>)
	JRST ILUUO

KIMUO5:	CAIL CX,130		;WITHIN LONG FLOATING POINT RANGE?
	CAILE CX,177
	JRST KIBADU		;NO, UNKNOWN
	BUG(ILLFLT,<<KIMUPC,PC>>) ;SHOULDN'T HAPPEN ANYMORE
	MCENTR			;SWITCH CONTEXT
	JRST KIMUM1		;PROCESS IT
;Here for concealed or public (user) no-trap MUUO

KIMUOU:	DATAO PAG,SETMON	;SET MONITOR CONTEXT
	SKIPN EXADF1		;EXTENDED ADDRESS? (MODEL B)?
	JSP CX,CVTMAB		;NO -- CONVERT TO MODEL B
KIMUOT:	MOVE CX,KIMUFL		;GET UUO WORD
	MOVEM CX,KIMUU1		;SAVE IT AS LAST USER UUO
	MOVE CX,KIMUEF
	MOVEM CX,KIMUU1+1
	LDB CX,[POINT 9,KIMUFL,26] ;GET OPCODE
	CAIE CX,<JSYS>B62	;JSYS?
	JRST KIMUO2		;NO
	HRRZ CX,KIMUEF		;YES, GET E
	CAIGE CX,1000		;EXEC JSYS?
	JRST MENTU		;YES, GO TO ENTRY SEQUENCE
	CAIG CX,DMSMAX		;DMS JSYS?
	JRST DMSENT		;YES, GO JUMP TO DMS CODE
	MOVE 1,FPC		;NO, SIMULATE ORDINARY JSYS
	TXNE 1,VSECNO		;SECTION 0?
	JRST ILUUO		;NO. ERROR THEN
	HLL 1,FFL		;SAVE FLAGS
	XCTU [MOVS CX,0(CX)]	;GET C(E)
	HRRZ 2,CX		;GET ADDRESS ONLY
	XCTU [MOVEM 1,0(2)]	;STORE PC PER LH OF C(E)
	HLR 1,CX		;JUMP ADDRESS - COMBINE WITH FLAGS
	TLZ 1,(FPD)		;FLAGS UNCHANGED EXCEPT FPD CLEARED
	HLLZM 1,FFL		;SET FLAGS AND PC (NO EXADR BITS!)
	HRRZM 1,FPC
	JRST GOUSR		;RETURN TO USER

KIMUO2:	CAIL CX,100		;POSSIBLY A TOPS10 UUO?
	JRST KIMUO3		;NO
	CAIL CX,40
	JRST UU1050		;YES, GO TO COMPAT
	JUMPE CX,ILUUO		;0 IS ALWAYS ILLEG
	BUG(IMPUUO)

;TEST FOR INTERPRETED OPCODES

KIMUO3:
IFN KLFLG,<			;IF A KL CHECK FOR GFLT STUFF
	CAIN CX,<<EXTEND>_-^D27> ;IS IT AN EXTEND?
	 JRST GFLT0		;YES...CHECK FOR GFLT
KIMUO6:				;HERE ALSO IF GFLT CHECK IS NEGATIVE
>

	CAIL CX,130		;WITHIN LONG FLOATING POINT RANGE?
	CAILE CX,177
	JRST ILUUO		;NO, UNKNOWN
	MCENTR			;ESTABLISH CONTEXT
	;..
;DISPATCH TO KA10 LONG FLOATING POINT SIMULATION ROUTINE, UFA(130),
;DFN(131), FADL(141), FSBL(151), FMPL(161), FDVL(171).

	;..
KIMUM1:	LDB CX,[POINT 9,MONFL,26] ;GET OPCODE
	CAIGE CX,132		;UFA OR DFN?
	TRZA CX,110		;YES, TRANSLATE TO 20,21
	LSH CX,-3		;FADL, ETC.  TRANSLATE TO 14-17
	HRRZ CX,FLONGD-14(CX)	;GET ADDRESS
	CALL 0(CX)		;DO FUNCTION
	JRST MRETN		;RETURN +1

;DISPATCH ON DIDDLED OPCODES

FLONGD:	SFADL
	SFSBL
	SFMPL
	SFDVL
	SUFA
	SDFN

IFN KLFLG,<			;GFLT CODE FOR KL'S

	GFLT%O==1B1		;GFLOAT OVERFLOW FLAG
	GFLT%2==1B2		;GFLOAT TWO AC STORE FLAG
	PC%TP1==1B10		;TRAP1 PC FLAG...ONLY USED BY GFLOAT

OPDEF DGFIX	[023000,,0]	;GFLT TO DOUBLE INTEGER
OPDEF GFIX	[024000,,0]	;GFLT TO INTEGER
OPDEF DGFIXR	[025000,,0]	;GFLT TO DOUBLE INTEGER ROUNDED
OPDEF GFIXR	[026000,,0]	;GFLT TO INTEGER ROUNDED

GFLT0:				;HERE TO CHECK FOR GFLT'S
;**;[2873] REMOVE [2819] LINES AT GFLT0:	TAM	7-DEC-82
;**;[2819] DELETE 1 LINE AT GFLT0:+1L	TAM	27-SEP-82
	MCENTR			;[2873] ENTER JSYS CONTEXT
	MOVE T4,KIMUU1+1	;GET E FOR THE MUUO
	UMOVE T4,(T4)		;GET THE EXTENDED INSTRUCTION
	LDB T3,[POINT 9,T4,8]	;GET THE EXTENDED OPCODE
	CAIL T3,<<DGFIX>_-^D27>	;IS IT A GFLT INSTRUCTION?
	 CAILE T3,<<GFIXR>_-^D27>
;**;[2873] MAKE CHANGES AT GFLT0:+7L	TAM	23-NOV-82
	  JRST ILUUO1		;[2873] NO, ILLEGAL OPCODE
	SUBI T3,<<DGFIX>_-^D27>	;CONVERT TO GFLTD OFFSET
	MOVE T1,T4		;GET THE EXTENDED INSTRUCTION
	TLZ T1,777740		;TURN OFF EVERYTHING EXCEPT I,X,AND Y
	TLO T1,(DMOVE T1,)	;GET THE INSTRUCTION
	XCTUU T1		;GET THE USERS ARGUMENTS
	CALL @GFLTD(T3)		;DISPATCH TO WORKER ROUTINES
	TXNE T4,GFLT%O		;DID IT OVERFLOW
	 JRST GFLT1		;YES...GO HANDLE IT
	LDB T3,[POINT 4,KIMUU1,30] ;GET THE AC THE USER USED
	UMOVEM T1,(T3)		;SAVE THE FIRST AC
	TXNN T4,GFLT%2		;IS IT A TWO AC RESULT?
	 JRST MRETN		;NO...SO WE ARE DONE
	ADDI T3,1		;YES...SO BUMP THE AC VALUE
	ANDI T3,17		;MAKE ADDITION MODULO 16
	UMOVEM T2,(T3)		;SAVE THE SECOND AC RESULT
	JRST MRETN		;RETURN TO USER
GFLT1:	EXCH T2,MPP		;HERE ON AN OVERFLOW...GET STACK FRAME
	MOVX T1,PC%OVF!PC%TP1	;GET OVERFLOW FLAGS
	IORM T1,0(T2)		;SET THE BIT IN THE USER'S FLAGS
	EXCH T2,MPP		;GET OUR STACK BACK
	JRST MRETN		;AND RETURN

GFLTD:	IFIW!.DGFX		;DGFIX
	IFIW!.GFX		;GFIX
	IFIW!.DGFXR		;DGFIXR
	IFIW!.GFXR		;GFIXR
>				;END OF IFN KLFLG
;Here if user trap word for overflow had an MUUO in it and user got
;arithmetic overflow

KIAROV:	SKIPE T3,ARTHTR		;USER SPECIFIED-TRAP ADDRESS?
	JRST ARTHTC		;YES. GO HANDLE IT THEN
	SETZ 1,
	MOVE 2,KIMUFL		;GET FLAGS AT TIME OF TRAP
	MOVE 3,PSICHM		;USER'S CHANNEL ENABLED WORD

;If interrupts are enabled, and user did not provide trap address
;give interrupt

	TLNE 3,(1B7)		;FOV ENB?
	JRST [	TLNN 2,(1B3)	;AND FOV ON?
		JRST .+1	;NO
		MOVEI 1,7	;YES, CHANNEL 7 INTERRUPT
		JRST KITRP1]
	TLNE 3,(1B6)		;OV ENB?
	JRST [	TLNN 2,(1B0)	;AND OV ON?
		JRST .+1	;NO
		MOVEI 1,6	;YES, CHANNEL 6 INTERRUPT
		JRST KITRP1]
	JRST KITRP1		;ENTER SCHED, FINISH UP

;USER HAS TRAP BLOCK. HANDLE IT

ARTHTC:	DMOVE T1,KIMUFL		;GET TRAP FLAGS AND PC
	UMOVE T4,-1(T2)		;GET INSTRUCTION
	XCTU [DMOVEM T1,.ARPFL(T3)]  ;STORE TRAP FLAGS AND PC
	UMOVE T2,.ARNPC(T3) 	;GET NEW PC WORD
	TXZ T1,FPD		;CLEAR FPD SO NEW INSTRUCTION WILL WORK
	DMOVEM T1,FFL		;SET UP NEW PC FOR USER
ARTHT0:	LDB T1,[POINT ^D13,T4,12] ;GET OPCODE AND AC
	LSH T1,5		;POSITION IT
	XCTU [HRRM T1,.ARPFL(T3)] ;STORE IN BLOCK
	LSH T1,-<5+4>		;ISOLATE OPCODE
	TXZ T4,-1B12		;CLEAR INST AND AC
	TXO T4,<XMOVEI T2,>
	XCTUU T4		;GET EFFECTIVE ADDRESS
	CAIN T1,<XCT>B62	;IS IT AN XCT?
	JRST [	UMOVE T4,0(T2)	;YES. GET TARGET OF XCT INSTRUCTION
		JRST ARTHT0]	;AND PROCEED
	UMOVEM T2,.AREFA(T3) 	;STORE EFFECTIVE ADDRESS
	JRST GOUSR		;AND RETURN

;Here if user had PDL overflow and trap word contained an MUUO.

KIPDOV:	MOVEI 1,^D9		;CHANNEL 9 FOR PDL OV
	JRST KITRP1
;PAGE FAIL ENTRY WHEN IN SCHED CONTEXT

;**;[2850]CHANGE 1 LINE AT KIPFS:	DSC	27-OCT-82
KIPFS::	SKIPE EXADF1		;[2850]FIXUP IF NOT EXADDR MACHINE
	JRST KIPFS1
	EXCH T1,TRAPFL		;GET FLAGS
	MOVEM T1,UPTPFW		;SET PAGE FAIL WORD
	HLLZ T1,TRAPPC		;GET PAGE FAIL WORD
	HRRZS TRAPPC		;SET PC TO 0,,PC
	EXCH T1,TRAPFL		;SET FLAGS
KIPFS1:	DMOVEM T1,PFSA1		;SAVE ACS
	MOVE T1,UPTPFW		;CHECK PAGE FAIL CODE
	TXNN T1,PFHPFF		;SPECIAL?
	BUG(SKDPF1) ;NO
	JSP T2,PFAID		;YES, DISPATCH ON TYPE
	CLHWPT			;CONTINUE
	DMOVE T1,PFSA1
	XJRSTF TRAPFL
;EXECUTED BECAUSE OF PAGE FAULT (KI10), OV, OR PDLOV
;Here when user executed a trap MUUO.

KITRPU:	DATAO PAG,SETMON
	SKIPN EXADF1		;EXTENDEDED ADDRESS? (MODEL B)?
	JSP CX,CVTMAB		;NO -- BETTER CONVERT IT TO MODEL B
	LDB CX,[POINT 9,KIMUFL,26]
	CAIL CX,40		;RANGE OK?
	CAIL CX,40+MAXUTU
KITRPX:	JRST KIMUOT		;NOT INTERSTING. GO SEE ABOUT STANDARD STUFF
	JRST UTUTAB-40(CX)	;DISPATCH

UTUTAB:	JRST KIPTU		;PAGER
	JRST KIAROV		;OVERFLOW
	JRST KIPDOV		;PDL OV
MAXUTU==.-UTUTAB

;Here on EXEC mode trap MUUO

KIPTU==KITRPX			;NOT USED
KITRPS:
KITRPM:	BUG(MONPDL)
;PAGER CONTROL ROUTINES - KL10 PAGING

;MOVE FROM REAL CORE ADDRESS
; T1/ WORD NUMBER
; T2/ PHYSICAL CORE PAGE NUMBER
;	CALL MOVRCA
; RETURN +1 ALWAYS, T1/ WORD FROM PAGE
;MAY BE CALLED AT ANY PI LEVEL

MOVRCA::MOVE T4,[MOVE T1,PIPGA(T1)] ;INSTR TO EXECUTE
	CALLRET XCTRCA		;DO INSTR WITH ADDR MAPPED

;STORE TO REAL CORE ADDRESS
;T1/ WORD NUMBER
;T2/ PHYSICAL CORE PAGE NUMBER
;T3/ WORD TO STORE
;	CALL STORCA
;RETURNS+1(ALWAYS)

STORCA::MOVX T4,CORMB
	IORM T4,CST0(T2)	;NOTE PAGE MODIFIED
	MOVE T4,[MOVEM T3,PIPGA(T1)] ;INSTR TO EXECUTE
;	CALLRET XCTRCA		;DO INSTR WITH ADDR MAPPED

;LOCAL ROUTINE TO EXECUTE AN INSTRUCTION WITH PIPGA SETUP
;T2/ CORE PAGE NUMBER
;T4/ INSTR TO EXECUTE
;T1 & T3 MAY BE USED BY THE INSTRUCTION.
;THE USUAL CASE IS TO HAVE T1 CONTAIN THE RELATIVE WORD ADDRESS.

XCTRCA:	PIOFF
	PUSH P,CST0(T2)		;SAVE OLD CST ENTRY
	SETOM CST0(T2)		;FORCE NO AGE FAULT
	HLL T2,IMMPTR		;CONSTRUCT POINTER
	MOVEM T2,MMAP+PIPG	;PUT IN MON MAP TEMP SLOT
	CLRPT PIPGA		;CLEAR HDWR
	XCT T4			;DO INSTR FOR CALER
	SETZM MMAP+PIPG		;CLEAR TEMP MAPPING
	HRRZS T2		;CLEAR BACK TO ADDRESS ONLY
	POP P,CST0(T2)		;RESTORE CST
	CLRPT PIPGA		;CLEAR HARDWARE
	PION
	RET

;MAP PHYSICAL CORE PAGE FOR LOCAL REFERENCE.  ASSUMES PI OFF.
; T1/ PHYSICAL CORE PAGE NUMBER
;	CALL MAPRCA
; RETURN +1 ALWAYS, T1/ VIRTUAL ADDRESS WHERE PAGE MAPPED

MAPRCA::HLL T1,IMMPTR		;CONSTRUCT PTR
	MOVEM T1,MMAP+PIPG
	CLRPT PIPGA
	MOVEI T1,PIPGA		;RETURN ADDRESS OF TEMP PAGE
	RET
;CLEAR MAPPING SETUP BY MAPRCA
;NO ARGUMENTS, PRESERVES ALL REGISTERS

UNMRCA::SETZM MMAP+PIPG		;CLEAR MAP SLOT
	CLRPT PIPGA		;CLEAR HARDWARE PAGER
	RET

;CLEAR PAGING MEMORY - VARIOUS AREAS.  ALL DO COMPLETE CLEAR AT PRESENT.

PGRLOD::			;LOAD PAGING VARIABLES
MONCLA::			;CLEAR ALL MONITOR PAGES
PGRCLD::			;CLEAR ALL PAGES
KICLKP::			;CLEAR AND LOAD SELECTED PAGE (T1)
	CLHWPT
	RET

;CLEAR PAGING MEMORY FOR SPECIFIC PAGE
; T1/ PAGE NUMBER
;	CALL MONCLR
; RETURNS +1 ALWAYS

MONCLR::JUMPE T1,MONCLA		;0 MEANS CLEAR ALL
	CLRPT 0(T1)		;CLEAR
	RET
;**;[3069]ADD 2 ROUTINES		RAH	JAN-19-84
STKEEP::	MOVX T1,PGCLKP	;[3069]GET THE "KEEP ME" BIT.
	IORM T1,KIPGWD		;[3069]SET THE BIT IN KIPGWD.
	RET			;[3069]

TESTKP::	MAP T1,(T1)	;[3069]TEST FOR KEEP ME. DEBUGGING USE ONLY.
	SMAPOK T1		;[3069]VALID MAPPING?
	RETBAD ()		;[3069]NO.
	TXNN T1,TWKEEP		;[3069]YES. PAGE KEPT?
	RETBAD ()		;[3069]NO.
	RETSKP			;[3069]YES.
;LOAD AGE
; T1/ AGE
;	CALL LDAGER
; RETURN +1 ALWAYS

   IFN KLFLG,<
LDAGER::DATAO PAG,SETHWR	;SET TO LOAD SPECIAL AC BLOCK
	XCTBU [STOR T1,AGEMSK,CSTDAT] ;SET NEW AGE IN CST UPDATE DATA
	DATAO PAG,SETMON	;RESTORE NORMAL AC BLOCKS
	CLHWPT
	RET
   >				; END IFN KLFLG

   IFN SMFLG,<
LDAGER::RDPUR T2		;FIND OLD VALUE
	STOR T1,AGEMSK,T2	;SET NEW AGE
	WRPUR T2		;RE-WRITE
	CLHWPT
	RET
   >				;END IFN SMFLG

;MOVE TO AGE
; T2 /NEW AGE WORD
;	CALL MVAGER
;	RETURN +1 ALWAYS

   IFN KLFLG,<
MVAGER::DATAO PAG,SETHWR	;SET HARDWARE AC BLOCK ADDRESS
	UMOVEM T2,CSTDAT	;SET CST AGE WORD
	DATAO PAG,SETMON	;SET AC'S BACK
	CLHWPT			;CLEAR HARDWARE PAGE TABLE
	RET			;RETURN

   >				;END IFN KLFLG

   IFN SMFLG,<
MVAGER::WRPUR T2		;WRITE NEW CST AGE WORD
	CLHWPT			;CLEAR HARDWARE PAGE TABLE
	RET			;RETURN
   >				;END IFN SMFLG
;PAGE FAIL

PGFAIL==PGRTRP##

;TURN PAGER ON

PGRON::
   IFN SMFLG,<
	MOVSI T1,(PTCACH)	;UNCACHE PAGE 0
	ANDCAM T1,MMAP
   >
	CONO PAG,@CONOPG
	CLHWPT
	RET

;TURN PAGER OFF

PGROFF::MOVE A,CONOPG
	TXZ A,PGTPEN		;CLEAR TRAP ENABLE
	CONO PAG,0(A)
	RET


;SET CONOPG TO POINT TO MONITOR EPT

MONEPT::MOVEI T1,KIEPT/PGSIZ	;PAGE NUMBER OF EPT
	DPB T1,[POINTR CONOPG,PGEBRM]	;STORE FOR PGRON/PGROFF
	RET			;DONE


;SET PAGER FOR SCHEDULER CONTEXT

SETPSK::MOVEI T1,SKHWPT/PGSIZ	;CORE PAGE NUMBER OF SYSTEM PSB
	STOR T1,PAGUBA		;PUT IT IN DATAO WORD
	MOVE T2,PSBBAS
	STOR T1,STGADR,SPT(T2)	;PUT IT IN MMAP BASE
	CLHWPT
	SETOM LSTPFK		;NO FORK NOW SETUP
	RET

   IFN KLFLG,<
SETHWR::PGLACB+FLD(MONACB,PGCACB)+FLD(HWRACB,PGPACB) ;HARDWARE REGISTERS
   >				; END IFN KLFLG
;ROUTINES USED BY SWTRP TO VERIFY TRAP ARGS

;VERIFY AND SET ARITHMETIC TRAP INSTRUTION
;	T1/ FORK PSB INDEX
;	T3/ BLOCK ADDRESS TO USE
;RETURNS:	+1 NOT VALID
;		+2 VALID

	SWAPCD			;SWAPPABLE
SETART::HLRZ T4,T3		;GET SECTION NUMBER
	CAIL T4,7777		;VALID SECTION?
	RET			;NO. CAN'T DO IT THEN
	MOVEM T3,ARTHTR(T1)	;YES. SET IT THEN
	CALL SETOV0		;MAKE IT VISIBLE
	RETSKP			;AND DONE

;ROUTINE TO VERIFY AND SET LUUO BLOCK ADDRESS
;	T1/ PSB OFFSET
;	T3/ BLOCK ADDRESS
;RETURNS:	+1 INVALID
;		+2 VALID

SETLUU::HLRZ T2,T3		;GET SECTION #
	CAIL T2,7777		;VALID SECTION?
	RET			;NO.
	SKIPN T3		;CLEARING?
	MOVE T3,[LUUNUL]	;YES. GET NULL VALUE
	MOVEM T3,KLLUUO(T1)	;SET IT
	RETSKP			;YES. DO IT THEN

;ROUTINE TO RETURN LUUO BLOCK ADDRESS SETTING
;RETURNS:	+1 ALWAYS
;		T3/ VALUE OF LUUO BLOCK SETTING

GTLUUB::MOVE T3,KLLUUO(T1)	;GET IT
	CAMN T3,[LUUNUL]	;NULL SETTING
	SETZM T3		;YES,. RETURN A ZERO THEN
	RET			;DONE
;SPECIAL ROUTINES USED BY DIAG MEM MEANAGEMENT TO ENABLE AND
;DISABLE METER UPDATES IN THE EPT.

;DISABLE UPDATES. ARRANGES FOR METER UPDATES TO BE DISABLED
;UPON RETURN TO THE USER.

	RESCD
MTROFF::
   IFN KLFLG,<
	CONO MTR,MTRLOD+MTRTBF	;TURN OFF METER
	CONO TIM,0		;TURN OFF TIME BASE
   >				;END OF IFN KLFLG
	RET			;DONE

;REENABLE METER UPDATES.
;ALSO USED BY CLKINI TO TURN ON METER AND INTERVAL TIMER
;AT SYSTEM START UP

MTRON::
   IFN KLFLG,<
	CONO TIM,TIMCIC+TIMDON+TIMITO+TIMTMS ;CLEAR AND INIT INTERVAL TIMER
	CONO MTR,MTRLOD+MTRTBN+MTRCTB+MTRAMN+PIBITS+TIMCHN ;TIME BASE ON, CLEAR, GIVE PI ASSMT
   >				;END OF IFN KLFLG
	RET			;AND DONE

;SPECIAL ROUTINE TO WAIT FOR EPT USERS TO FINISH.
;MUST BE CALLED WITH PIOFF. MAY NOT RETURN FOR A LONG
;TIME, SO CALLER MUST INSURE THAT KEEP-ALIVE CHECKING
;IS DISABLED. WAITS FOR CHANNELS AND DEVICES THAT
;MAY MODIFY MEMORY (THE EPT ESPECIALLY) TO COMPLETE

WATEPT::
   IFN KLFLG,<			;FOR THE KL ONLY
	CALL DTEINA		;WAIT FOR DTE TO ABATE
   >				;END OF IFN KLFLG
	MOVX T1,^D500000
	SOJG T1,.
	RET			;HACK FOR NOW.

;ROUTINE TO REVERSE EFFECT OF WATEPT. USED BY DIAG TO
;TURN SYSTEM ON AGAIN

UNWEPT::
   IFN KLFLG,<			;IF ON THE KL
	CALL DTICON		;SUPPRESS "CONTINUED" MESSAGE
	CALL DTEACT		;REACTIVATE DTES
	CONO TIM,TIMDON+TIMITO+TIMTMS ;TURN ON TIMER, BUT DON'T CLEAR
	CONO MTR,MTRLOD+MTRTBN+MTRAMN+PIBITS+TIMCHN ;AND TURN ON MTR
   >				;END OF IFN KLFLG CONDITIONAL
	RET			;AND DONE
;ROUTINE TO CHECK IF A RESIDENT MONITOR PAGE IS MOVABLE.
;CALLED FROM PAGEM
;	T1/ PAGE NUMBER
;RETURNS:	+1 NOT MOVABLE
;		+2 MOVABLE

RMPCHK::
   IFN KLFLG,<			;FOR THE KL NEED TO CHECK COMM REGION
	CAIL T1,COMBUF/PGSIZ	;WITHIN THE COMM REGION?
	CAILE T1,<ENDRGN-1>/PGSIZ ;?
	RETSKP			;NO. GOOD THEN
	RETBAD()		;YES IT IS. CAN'T MOVE IT
   >				;END OF IFN KLFLG

IFN SMFLG,<RETSKP>		;DONE
;SET SWAPPER SPECIAL PAGE TO CURRENT PAGE TABLE
; T1/ PTN,,PN
;	CALL SETSPG
; RETURN +1 ALWAYS, PTN MAPPED INTO CSWPGA

SETSPG::PUSH P,1
	HLRZ 1,1		;GET PTN
	LOAD 1,STGADR,SPT(1)	;GET ADDRESS
SETSP1:	CAMLE 1,NHIPG		;LEGAL PAGE?
	BUG(PTNIC1)
	IOR T1,IMMPTR		;CONSTRUCT PRIVATE PTR
	MOVEM T1,MMAP+CSWPG	;PUT IN MON MAP
	HRRZS T1
	HLL 1,CST0(1)		;CHECK AGE
	TXNN 1,PSASM		;NOW ASSIGNED?
	CALL AGESN		;NO, SET AGE
	CLRPT CSWPGA
	POP P,1
	RET

;GIVEN CORE PAGE NUMBER IN 1, SETUP CSWPG

SETSP0::IOR T1,IMMPTR		;CONSTRUCT PTR
	MOVEM T1,MMAP+CSWPG	;PUT IN MON MAP
	CLRPT CSWPGA
	RET

RELSPG::SETZM MMAP+CSWPG
	CLRPT CSWPGA
	RET

;ZERO CORE PAGE GIVEN IN 1

SWPZPG::MOVX T2,PSASM		;SET LEGAL AGE FOR LOCAL REF
	IORM T2,CST0(T1)
	MOVE T2,IMMPTR
	STOR T1,STGADR,T2	;CONSTRUCT PRIVATE PTR
	MOVEM T2,MMAP+CSWPG	;PUT IN MON MAP
	CLRPT CSWPGA
	MOVE 2,[XWD CSWPGA,CSWPGA+1]
	SETZM CSWPGA		;CLEAR FIRST LOCATION
	BLT 2,CSWPGA+PGSIZ-1	;ZERO THE PAGE
	SETZM MMAP+CSWPG
	CLRPT CSWPGA
	RET
;SETUP TEMP MAPPING UNDER SCHED CONTEXT
; T1/ SPTN OF DESIRED PAGE
;	CALL SFITPG
; RETURNS +1 ALWAYS, PAGE MAPPED AT FITPGA

SFITPG::JUMPE T1,[SETZM MMAP+FITPG ;CLEAR SLOT IF 0 GIVEN
		JRST SFITP1]
	PUSH P,SHRPTR		;CONSTRUCT SHARE PTR
	STOR T1,SPTX,0(P)
	POP P,MMAP+FITPG	;PUT IN MON MAP
SFITP1:	CLRPT FITPGA
	RET

;SETUP TEMP MAPPING UNDER SCHED CONTEXT
; T1/ SPTN OF DESIRED PAGE
;	CALL SFITPG
; RETURNS +1 ALWAYS, PAGE MAPPED AT PRLPGA

SPRLPG::JUMPE T1,[SETZM MMAP+PRLPG ;CLEAR SLOT IF 0 GIVEN
		JRST SPRLP1]
	PUSH P,SHRPTR		;CONSTRUCT SHARE POINTER
	STOR T1,SPTX,0(P)
	POP P,MMAP+PRLPG
SPRLP1:	CLRPT PRLPGA
	RET

;SET SWAPPER SPECIAL PAGE TO GIVEN PTN
; 6/ SPTX OF DESIRED PAGE
;	CALL SETSP6
; RETURN +1 ALWAYS, PAGE MAPPED INTO CSWPG,
; 6/ PHYSICAL ADDRESS OF PAGE

SETSP6::PUSH P,1
	LOAD 6,STGADR,SPT(6)	;GET ADR AND RETURN IT IN 6
	MOVE 1,6
	JRST SETSP1		;JOIN STANDARD CASE
;DIAGNOSE PAGE FAIL WITH FAIL CODE
; 1/ PAGE FAIL WORD
;	JSP T2,PFAID		;JSP USED BECAUSE NO STACK SETUP HERE
; RETURN +1 IF PROGRAM TO BE CONTINUED

;Here on a page fail where the code indicates "hard" failure. Called
;by

;	1. PIPTRP when page fail code is 36 or 37 (AR or ARX parity error) and page
;fail occurred when taking an interrupt
;	2. PGRTH when page fail code is 20 or 22 (undefined) or 25 (page table
;parity error)
;	3. KIPFS when page fault occurred in scheduler context

PFAID::	LOAD T1,PFCOD,T1	;GET PAGE FAIL CODE
	CAIL T1,PECOD0		;MPE GROUP?
	JRST PFCDPE		;YES

;Page fail code is not AR or ARX parity error. We expect some sort of
;hard error code here. BUGHLT if that is not the case.
;Otherwise transfer according to the vector below

	CAIL T1,KLCOD0		;KL PAGING CODE?
	JRST PFCDX		;YES, NOT EXPECTED HERE
	HRRZ T1,PFCODT-PFCOD0(T1) ;GET DISPATCH ADDRESS
	JRST 0(T1)		;AND GO THERE

;Transfer vector for page fail codes 20 to 27

PFCOD0==20			;FIRST SPECIAL TRAP CODE
KLCOD0==30			;LOWER BOUND OF CODES FOR KL PAGING
PECOD0==36			;MPE GROUP
PFCODT:	PFCD20			;NXM
	PFCD21			;PROPRIETARY VIOLATION
	PFCD22			;REFILL ERROR
	PFCD23			;ADDRESS BREAK
	PFCDX			;ILLEGAL INDIRECT
	PFCD25			;PAGE TABLE PARITY ERROR
	PFCDX			;UNKNOWN
	PFCD27			;ILLEGAL ADDRESS

;Didn't expect this page fail. BUGHLT

PFCDX::	BUG(UNPGF2)

;Page fail code is 20. BUGHLT on KL. Complain and continue on KS

   IFN KLFLG,<
PFCD20::JRST PFCDX		;ILLEGAL ON OTHER THAN SM10
   >
   IFN SMFLG,<
PFCD20::CONSZ PI,PIPION		;HARD I/O NXM CHECK FOR PI ON
	BUG(IONXM)
	AOS TRAPPC		;FAKE COMPLETION OF INSTRUCTION
	JRST 0(T2)		;CONTINUE, ASSUME ERROR IN ADAPTER WILL BE CLEARED BY CALLER
   >

;Page fail code is 21 (proprietary violation).

PFCD21:	BUG(PVTRP)

;Page fail code is 22 (refill error). This is not supposed to happen
;in TOPS-20 paging.

PFCD22::BUG(RFILPF)
	JRST 0(T2)		;TRY AGAIN

;Page fail code is 27 (illegal address). Scheduler referenced a
;section greater than 37
PFCD27::BUG(ILPSEC,<<TRAPPC,PC>,<TRAPSW,PFW>>)
	HRRZS TRAPPC		;CLEAR SECTION
;	JRST PFCD23

;ADDRESS COMPARE - MAY BE SETUP WITH DATAO APR,[ADDRESS]
;Page fail code is 23 (address compare). Address break is set on
;the location in the page fail word
;note -- address break in user context goes to adrcmp in pagem

PFCD23::MOVX T1,PC%AFI		;(CAN PUT BREAKPOINT HERE)
	IORM T1,TRAPFL		;INHIBIT TRAP ONCE SO PGM CAN CONTINUE
	JRST 0(T2)		;CONTINUE

;Page fail code is 25 (page table parity error). Hardware failure.

PFCD25::BUG(PTMPE)

;Here when page fail code is 36 or 37, indicating parity error.

   IFN KLFLG,<
PFCDPE:	HRRZ T1,TRAPPC		;FIND TRAP ADDRESS
	CONSZ APR,APNXM		;NXM CAUSED THIS?
	JRST PFNXM		;YES
	CONSO PI,PIPION		;PI ON?
	JRST [	CAIGE T1,PGRI6	;NO -- CHECK FOR LEGAL PARITY ERRORS
		CAIGE T1,PGRI2A	;THE ONLY LEGAL TIMES ARE DURING CORE SCAN IN PGRINI
		JRST PFCDP1	;NOT LEGAL. QUIT
		JRST PFNXM]	;TREAT AS NXM (SKIP INSTRUCTION)
	MOVX T1,1B17		;GET A LARGE NUMBER
	CONSZ APR,APMPE		;SWEEP DONE?
	SOJG T1,.-1		;WAIT A WHILE FOR IT TO COMPLETE
	PIOFF			;TURN OFF PI SYSTEM NOW
PFCDP1:	MOVEM P,MEMAP		;SAVE OLD STACK JUST IN CASE
	MOVE P,[IOWD NMEMPP,MEMPP] ;SET UP A STACK
	CALL PGMPE0		;GO HANDLE AR/ARX TRAP
	 JFCL			;DON'T CARE IF IT WAS HARD OR NOT
	BUG(SKDMPE)

;Here on a NXM. This also causes an AR/ARX parity error. Normally we
;don't get here because NXM causes an interrupt, wich leads to an
;APRNX1 BUGHLT.

PFNXM::	CONOAPR APFCLR+APSBER+APMPE ;CLEAR SPURIOUS FLAGS
	CONSZ PI,PIPION		;PI SYSTEM ON?
	BUG(APRNX2) ;YES
	AOS TRAPPC		;FAKE COMPLETION OF INSTRUCTION
	JRST 0(T2)		;CONTINUE, ASSUME PGM WILL CHECK FOR NXM
   >				;END IFN KLFLG
;PARITY ERROR TRAP IN PROCESS CONTEXT - HERE FROM DISPATCH AT PGRTRP
;RETURNS +1, NOT RECOVERABLE; RETURNS +2, RECOVERABLE

;Here from PGRTRP or PFAID when page fail code indicated AR or ARX parity error
;From PGRTRP, in user context. From PFAID, in scheduler or interrupt context.

;LOCAL FLAGS

PFCPF0==1B18			;ON WHEN EXECUTING TEST REFERENCE
PFCPF1==1B19			;ON IF LAST TEST REFERENCE FAILED
PFCPF2==1B20			;ON IF PI SYSTEM ON AT ENTRY
PFCPF3==1B21			;ON IF TESTING AN EPT WORD
PFCPF4==1B22			;ON IF TESTING A UPT WORD

PGMPE0::SKIPE T1,DIAGAR		;AR/ARX INTERCEPT SET?
	JRST [	JE UMODF,UPTPFL,.+1 ;USER MODE?
		AOS UPTPFO	;YES. ASSUME NO INTERVENTION
		SKIPL T1	;AN ADDRESS GIVEN?
		MOVEM T1,UPTPFO	;YES. STORE NEW ADDRESS
		RETSKP]		;AND RETURN TO THE USER
	CONSZ APR,APNXM		;NXM CAUSED THIS?
	JRST PGNXM0		;YES
	PUSH P,F		;INIT LOCAL FLAG REG
	SETZ F,
	CONSO PI,PIPION		;NORMAL SYSTEM OPERATION (PI ON)?
   IFN KLFLG,<
	JRST [	CONOAPR APFCLR+APSBER+APIOPF+APMPE+APCDPE+APAPE
		JRST PFCP3]	;NO, CLEAR APR BITS, NO INTERRUPT
   >
   IFN SMFLG,<
	JRST [	CONOAPR APFCLR+APHMP
		JRST PFCP3]	;NO, CLEAR APR BITS, NO INTERRUPT
   >
	TXO F,PFCPF2		;REMEMBER TO RESTORE PI
   IFN KLFLG,<
	MOVX T1,1B17		;GET A LARGE NUMBER
	CONSZ APR,APMPE!APSBER	;AN APR INT PENDING?
	SOJG T1,.-1		;YES. WAIT FOR IT
PFCP3:	MOVE T1,CONOPG
	TXZ T1,PGCLDE		;SET CACHE NO LOAD
	CONO PAG,0(T1)
   >
   IFN SMFLG,<
PFCP3:>
;Get SYSERR block and store data

	MOVEI T1,PT%LEN
	MOVEI T2,PT%SIZ
	CALL ALCSEB		;ASSIGN SYSERR BUFFER
	 BUG(NOSEB2)
	MOVEI Q2,SEBDAT(T1)	;Q2 HOLDS PTR TO DATA BLOCK
	HRL Q2,T1		;LH HOLDS ORIGINAL PTR
	PIOFF			;PROCEED WITH PI OFF

	TXNE F,PFCPF2		;NON-PI CODE?
	JRST [	MOVEM P,MEMAP	;NO. SAVE CURRENT STACK POINTER
		MOVE P,[IOWD NMEMPP,MEMPP] ;AND SET UP APR STACK
		JRST .+1]	;CONTINUE CODE
	;..
	;..

;Set up UPT so that page faults will go to special routine, which will
;determine if fault occurred while testing memory. Save current page
;fail information

	PUSH P,UPTPFN		;SAVE OLD AND NEW TRAP PC
	PUSH P,UPTPFO
	PUSH P,UPTPFL
	MOVE T1,UPTPFW
	MOVEM T1,PT%PFW(Q2)	;REPORT IT
	MOVE T3,[PFCPTP]	;BUILD TEMPORARY PF TRAP DISPATCH
	XSFM T2			;GET FLAGS
	TXNE T1,PFUSR		;USER REFERENCE?
	TXO T2,PCU		;YES, SET PREVIOUS CONTEXT
	MOVEM T3,UPTPFN		;TRAPS WILL GO TO SPECIAL PLACE HEREIN
	HRRI T3,.+2
	XJRSTF T2		;SET PCU NOW
	TXZ T1,EXFLBT		;CLEAR EXTRANEOUS BITS
	CALL PRV1XC		;DO REFERENCE IN SECTION 1
	 MAP T1,0(T1)
	MOVEM T1,PT%PMA(Q2)	;SAVE FOR REPORT
	SETZM PT%TRY(Q2)	;CLEAR REPORTED RETRY COUNT
	DATAO PAG,SETBK7	;SET TO REFERENCE AC BLOCK 7
	UMOVE T1,BK7PFD		;GET BAD DATA
	DATAO PAG,SETMON	;RESTORE NORMAL AC BLOCK
	MOVEM T1,PT%BDW(Q2)	;SAVE BAD DATA FOR REPORT
	MOVE T1,FORKX		;SAVE USER INFO
	HRLOM T1,PT%JOB(Q2)

; THE KL10 EBOX CAN MAKE REQUESTS TO THE MBOX ON AN EPT OR UPT
; RELATIVE BASIS.  IF A PARITY ERROR OCCURS ON SUCH A REFERENCE
; THE PAGE FAIL WORD DOES NOT SHOW WHICH KIND OF REFERENCE WAS
; OCCURING.  IF PHYSICAL PAGE ZERO IS REFERENCED WE WILL CHECK
; WORDS IN THE EPT AND UPT FOR ERRORS.  IF ERRORS ARE PRESENT
; A BUGHLT WILL OCCUR.

	SETZM PT%EPD(Q2)	; ZERO OUT DATA CELLS
	SETZM PT%EPA(Q2)
	SETZM PT%UPD(Q2)
	SETZM PT%UPA(Q2)
	LOAD T1,VPGNO,PT%PFW(Q2) ; GET THE PAGE NUMBER...IS IT ZERO?
	JUMPN T1,PGMPE1		; NO SO IT CANT BE UPT OR EPT RELATIVE
	LOAD T1,PGWD,PT%PFW(Q2) ; GET THE LINE NUMBER IN THE PAGE
	TXO F,PFCPF3		; FLAG THAT WE ARE TOUCHING EPT WORD
	MOVE T2,KIEPT(T1)	; GET THE EPT OFFSET WORD
	TXZ F,PFCPF3		; RESET THE FLAG
	MOVEM T2,PT%EPD(Q2)	; SAVE THE EPT WORD
	MAP T2,KIEPT(T1)	; GET PHYSICAL ADDRESS OF THE EPT WORD
	MOVEM T2,PT%EPA(Q2)	; AND SAVE IT
	TXO F,PFCPF4		; FLAG THAT WE ARE TOUCHING UPT WORD
	MOVE T2,HWPTA(T1)	; GET THE UPT OFFSET WORD
	TXZ F,PFCPF4		; RESET THE FLAG
	MOVEM T2,PT%UPD(Q2)	; SAVE THE UPT DATA WORD
	MAP T2,HWPTA(T1)	; GET THE PHYSICAL ADDRESS
	MOVEM T2,PT%UPA(Q2)	; SAVE THE PHYSICAL ADDRESS
PGMPE1:

	;..
	;..
   IFN SMFLG,<
	MOVEI T1,[SIXBIT '$AT ERROR, MEMERA= /']
	JSR BUGMSG		;PROBABLY USELESS
	RDIO T1,MEMERA		;GET MEMERA OF FIRST ERROR
	CALL BUGWPT		;PRINT IT
   >

;Flush cache and turn it off

   IFN KLFLG,<
	MOVE Q1,CONOPG
	TXZN Q1,PGCLKE+PGCLDE	;CACHE ON?
	JRST PFCP4		;NO
	TXO F,PT%CCH		;YES, NOTE
	CCHUA			;UNLOAD IT
	CONSO APR,APSWPD	;WAIT FOR COMPLETION
	JRST .-1
	CONOAPR APFCLR+APSWPD	;CLEAR FLAG
	CONSZ APR,APMPE		;ERROR ON WRITE TO CORE?
	JRST [	TXO F,PT%ESW	;YES. REMEMBER THAT
		RDERA PI%ER2+MPISEB ;AND SAVE ERA AS WELL FOR SBUS CODE
		JRST .+1]
	CONO PAG,0(Q1)		;TURN CACHE OFF
>;END IFN KLFLG

;BEGIN RETRY ALGORITHM
;Retry with cache off.

PFCP4:	CALL PFCPRT		;RETRY REFERENCE WITHOUT CACHE
	 JRST PFCPH		;RETRIES FAILED, HARD IN CORE

	MOVEM T1,PT%GDW(Q2)	;SAVE GOOD DATA
	MOVEM T3,PT%TRY(Q2)	;AND SAVE RETRY COUNT

   IFN SMFLG,<
	MOVX T1,MER%CL		;RESET MEMORY REGISTER
	WRIO T1,MEMERA		;SO MAYBE USEFUL DATA LATCHED
   >
IFN KLFLG,<

;If cache was on previously, turn it back on

	TXNN F,PT%CCH		;WERE USING CACHE?
	JRST PFCP2		;NO
	CONO PAG,PGCLKE(Q1)	;YES, TURN IT BACK ON
	CALL PFCPRT		;RETRY REFERENCE WITH CACHE
	 JRST PFCPHH		;RETRIES FAILED, HARD IN CACHE
   >
	;..
	;..

;Here when error is recoverable. Either the memory retry succeeded and
;cache was off originally or both retries succeeded and cache was on
;Queue the SYSERR block and restore the context to continue

PFCP2:	HLLM F,PT%TRY(Q2)	;SAVE FLAGS
	CALL PFCPLG		;LOG INFO
	POP P,UPTPFL		;RESTORE PAGE FAIL VARIABLES
	POP P,UPTPFO
	POP P,UPTPFN
   IFN KLFLG,<			;IF THIS IS THE KL10
	MOVEI T1,ARBUG-BUGBUG	;GET PROPER INDEX FOR MESSAGE
	CALL GENBLK		;DO STATUS REPORT
   >				;END OF IFN KLFLG
	TXNE F,PFCPF2		;NON-PI CODE?
	MOVE P,MEMAP		;NO. RESTORE ORIGINAL STACK POINTER
	CONO PAG,@CONOPG	;RESTORE CACHE STATE
	TXNE F,PFCPF2		;RESTORE PI
	PION
	POP P,F
	RETSKP			;RETURN RECOVERABLE

;ROUTINE TO EXECUTE A PXCT IN SECTION 1 AND RETURN TO CURRENT SECTION
;Executes the instruction after the call.

;Returns: +2 always

PRV1XC:	SE1CAL			;ENTER SECTION 1
	MOVE CX,@0(P)		;GET INSTRUCTION TO DO
				; NOTE THIS IS DONE SINCE AN
				; XCTU @0(P) WOULD EXECUTE THE
				; TARGET INST IN THE SECTION OF THE
				; CALLING ROUTINE RATHER THAN
				; THE SECTION OF THE CURRENT PC
				; BOO HIS!
	XCTU CX			;DO IT IN SECTION 1
	RETSKP			;AND DONE
;Here if BUGHLT and want to type out MB parity error block
;	T2/ SYSERR BLOCK
;PIOFF, Secondary protocol

   IFN KLFLG,<

MBERRB:	SAVEQ
	MOVEI Q1,SEBDAT(T2)

;DO TYPEOUT OF PROCESSOR INFORMATION

	MOVEI T1,[SIXBIT '$$PARITY ERROR DETECTED BY /']
	TMNN APMPE,PI%CN2(Q1)
	MOVEI T1,[SIXBIT '$$SBUS ERROR DETECTED BY /']
	JSR BUGMSG
	MOVEI T1,[SIXBIT 'APR/']
	TMNE ER%CHN,PI%ER2(Q1)
	MOVEI T1,[SIXBIT 'CHANNEL/']
	JSR BUGMSG
	MOVEI T1,[SIXBIT ', ERA = /']
	JSR BUGMSG
	MOVE T1,PI%ER2(Q1)
	CALL BUGWPT
	MOVE T1,PI%SB2(Q1)		;GET SDBIAG WORD
	ADDI T1,0(Q1)			;ADD IN START IF BLOCK
	CALL PRISBS			;DO SBUS DIAGS AS WELL
	MOVEI T1,[SIXBIT '$$   LOC   CONTENTS$$/']
	JSR BUGMSG
	HRLI Q1,-PI%NB2		;SCAN BLOCK OF BAD ADDRESSES
	; ..
	; ..
;Now look at bad word and report on each of them

MBERR2: SKIPN T1,PI%BAD(Q1)	;HAVE AN ADDRESS?
	RET			;NO. ALL DONE THEN
	ANDX T1,<PHCPNO+PGWD>	;JUST USE ADDRESS BITS
	CALL BUGOP8
	MOVEI T1," "
	JSR BUGTYO
	MOVE T1,PI%DA2(Q1)	;GET BAD DATA
	CALL BUGWPT
	MOVEI T1," "
	JSR BUGTYO
	JN PI%FAT,PI%BAD(Q1),MBERR3 ;IF HARD NO GOOD DATA
	MOVE T1,PI%MDA(Q1)
	CALL BUGWPT
MBERR3:	MOVEI T1,[SIXBIT '$/']
	JSR BUGMSG
	AOBJN Q1,MBERR2		;DO ALL ADDRESSES
	RET
   >				;END OF IFN KLFLG
;HERE IF BADCPG WANTS TO BUGHLT. DO FORCE TYPE OUT OF AR/ARX INFO
;	T2/ SYSERR BLOCK

PFERRB:	SAVEQ
	MOVEI Q2,SEBDAT(T2)	;SAVE BLOCK ADDRESS
	MOVEI T1,[SIXBIT '$$AR OR ARX PARITY ERROR$PFW= /']
	JSR BUGMSG
	MOVE T1,PT%PFW(Q2)	;PF WORD
	CALL BUGWPT
	MOVEI T1,[SIXBIT ' MAP WORD= /']
	JSR BUGMSG
	MOVE T1,PT%PMA(Q2)	;MAP WORD
	CALL BUGWPT
	MOVEI T1,[SIXBIT '$BAD DATA= /']
	JSR BUGMSG
	MOVE T1,PT%BDW(Q2)
	CALLRET BUGWPT

;HERE IF ERROR REPEATABLE ON DIRECT REFERENCES TO CORE
;Queue the SYSERR entry, disable the page, and print a message on the CTY

PFCPH:	TXO F,PT%HRD		;NOTE HARD ERROR
	HLLM F,PT%TRY(Q2)	;SAVE FLAGS FOR REPORT
   IFN SMFLG,<
	MOVEI T1,[SIXBIT '$RETRIES FAILED, MEMERA= /']
	JSR BUGMSG		;PRINT TITLE
	RDIO T1,MEMERA		;GET CURRENT MEMERA
	CALL BUGWPT		;AND PRINT POSSIBLE JUNK
	MOVX T1,MER%CL		;RESET MEMORY REGISTER
	WRIO T1,MEMERA		;SO MAYBE USEFUL DATA LATCHED
   >
	CALL PFCPLG		;LOG ERROR INFO
	LOAD T2,PFVADR,PT%PFW(Q2) ;SETUP TO REFERENCE BAD WORD AGAIN
	TXO F,PFCPF0		;NOTE CONTROLLED REFERENCE
;	CALL PRV1XC		;REF IT
;	 SETZM 0(T2)		;ZERO THE BAD WORD
	TXZ F,PFCPF0+PFCPF1
	POP P,UPTPFL		;RESTORE PAGE FAIL VARIABLES
	POP P,UPTPFO
	POP P,UPTPFN

   IFN KLFLG,<			;IF THIS IS A KL10
	MOVEI T1,ARBUG-BUGBUG	;GET PROPER INDEX
	CALL GENBLK		;DO STATUS
   >				;END OF IFN KLFLG
	LOAD T1,PHCPNO,PT%PMA(Q2) ;GET PHYS PAGE NUMBER
	TXNE F,PFCPF2		;NON-PI CODE?
	MOVE P,MEMAP		;NO. RESTORE INCOMING STACK
	CONO PAG,@CONOPG	;RESTORE CACHE STATE
	NOSKD1
	TXNE F,PFCPF2		;RESTORE PI
	PION
	POP P,F

;Turn the page offline. This routine may BUGHLT if page is critical

	CALL BADCPG		;MARK CORE PAGE BAD
	OKSKD1			;ALLOW SCHEDULING
	RET			;AND DONE

;HERE IF ERROR REPEATABLE ONLY ON REFERENCES THROUGH CACHE
;Turn off the cache and continue

   IFN KLFLG,<
CCHEMX==3			;MAX CACHE ERRORS ALLOWED

PFCPHH:	CONO PAG,0(Q1)		;TURN CACHE OFF
	TXO F,PT%CCF+PT%HRD	;NOTE HARD CACHE ERROR
	AOS T1,CCHECT		;COUNT HARD CACHE ERRORS
	CAIGE T1,CCHEMX		;REACHED MAX?
	JRST PFCP2		;NO, CONTINUE
	BUG(HARDCE)
	MOVEM Q1,CONOPG		;SET CACHE OFF
	JRST PFCP2		;CONTINUE
   >
;LOCAL ROUTINE TO LOG ERROR INFORMATION

   IFN KLFLG,<
PFCPLG:	CONOAPR APFCLR+APNXM+APMPE ;CLEAR RESIDUAL FLAGS
   >
   IFN SMFLG,<
PFCPLG:	CONOAPR APFCLR+APNXM+APHMP ;CLEAR FLAGS
   >
	HLRZ T1,Q2		;GET PTR TO SYSERR BLK
	MOVE T2,[-NPFCPT,,PFCPT]
	CALL SEBCPY		;PUT IN CODE, ETC.
	 JFCL
	HLRZ T1,Q2
	CALLRET QUESEB		;QUEUE IT AND RETURN

PFCPT:	SEBPTR 0,SBTEVC,SEC%PT	;EVENT CODE
	SEBPTR 0,SBTFNA,PFCPJ0	;FUNCTION ADDRESS--JOB 0 FIXUP
NPFCPT==.-PFCPT

RS CCHECT,1			;CACHE HARD ERROR COUNT
;LOCAL RETRY ROUTINE
;RETURN +1: HARD FAILURE
;RETURN +2: RETRY SUCCEEDED,
;  T1/ GOOD DATA
;  T3/ NUMBER OF TRY WHICH WORKED (FIRST TRY = 1)
;  Q2/ ADDRESS OF SYSERR BLOCK

;This routine tries to reference data that previously caused an AR or ARX
;parity error. Caller has enabled or disabled cache. UPTPFN has been set up
;so that an error will call PFCPTP below. This routine sets the flag
;PFCPF0 in F to indicate it is retrying an error

PFCPRT:	MOVEI T3,1		;INIT RETRY COUNT
PFCPL1:
IFN SMFLG,<
	CALL PGRCLD		;CLEAR VIRTUAL CACHE
	MOVX T1,MER%CL		;RESET MEMORY REGISTER
	WRIO T1,MEMERA		;SO MAYBE USEFUL DATA LATCHED
>
	LOAD T2,PFVADR,PT%PFW(Q2) ;GET VA OF ORIGINAL TRAP
	TXO F,PFCPF0		;NOTE TEST REFERENCE
	CALL PRV1XC		;DO THE REFERENCE
	 MOVE T1,0(T2)		;IN PROPER SECTION
	TXZ F,PFCPF0
	TXZN F,PFCPF1		;ANOTHER ERROR?
	RETSKP			;NO, RETURN SUCCESS
	CAIGE T3,4		;REACHED RETRY LIMIT?
	AOJA T3,PFCPL1		;NO
	RET			;YES, RETURN FAILURE

;PAGE FAIL TRAPS TO HERE WHILE PROCESSING MPE TRAPS
;PGMPE0 set UPTPFN to point here

PFCPTP:	SKIPE EXADF1		;EXTENDED ADDRESSING?
	JRST PFCPT1		;YES. ALL SET
	MOVE T1,UPTPFL		;NO. GET REASON
	MOVEM T1,UPTPFW		;STORE IT
	HLLZ T1,UPTPFO		;GET PC FLAGS
	MOVEM T1,UPTPFL		;STORE THEM
	HRRZS UPTPFO		;ISOLATE PC
PFCPT1:
	MOVE T1,UPTPFW		;GET THE PAGE FAIL WORD
	MOVE T2,T1		;GET THE ADDRESS IN T2 ALSO
	TXZ T2,EXFLBT		;TURN OFF UNWANTED BITS
	CALL PRV1XC		;EXECUTE NEXT INSTRUCTION IN SEC 1
	 MAP T2,0(T2)		;GET THE PHYSICAL ADDRESS OF THE WORD
	TXNE F,PFCPF3!PFCPF4	;DOING EPT OR UPT TEST REFERENCE?
	 JRST [	DATAO PAG,SETBK7  ;YES SO SET TO REFERENCE AC BLK 7
		UMOVE T3,BK7PFD	  ;GET THE BAD DATA WORD
		DATAO PAG,SETMON  ;PUT PAGER BACK TO MONITOR CONTEXT
		TXNE F,PFCPF3	  ;DOING EPT REFERENCE?
		 BUG (EPTMPE,<<T1,PFW>,<T2,PADR>,<T3,BDATA>>) ;YES
		BUG (UPTMPE,<<T1,PFW>,<T2,PADR>,<T3,BDATA>>) ;NO
		JRST .+1]	  ;SHOULD NEVER BE EXECUTED
	TXNN F,PFCPF0		;DOING TEST REFERENCE?
	 BUG (UNXMPE,<<T1,PFW>,<T2,PADR>>) ; NO
	LOAD T1,PFCOD,UPTPFW	;YES, CHECK CODE
	CAIGE T1,PECOD0		;ANOTHER PARITY ERROR?
	BUG(MPEUTP)
	TXO F,PFCPF1		;YES, NOTE REFERENCE FAILED
	AOS UPTPFO		;SKIP FAILING INSTRUCTION
	XJRSTF UPTPFL		;RETURN
;HERE IF NXM CAUSED TRAP
;Jumped to from PGMPE0 if APNXM is set in CONI APR word.

   IFN SMFLG,<
PGNXM0:	JRST PGNXER
   >
   IFN KLFLG,<

PGNXM0:	CONOAPR APFCLR+APMPE	;CLEAR RESIDUAL FLAGS
	CONSZ PI,PIPION		;PI SYSTEM ON?
	BUG(PRONX2)
	AOS TRAPPC		;BYPASS FAILING INSTRUCTION
	RET
   >				;END IFN KLFLG

   IFN SMFLG,<
PFCDPE::HRRZ T1,TRAPPC		;FIND TRAP ADDRESS
	CONSO PI,PIPION		;CHECK FOR LEGAL DPE
	JRST [	CAIGE T1,PGRI6
		CAIGE T1,PGRI2A	;BOUNDS CHECK  BECAUSE PGRINI MAY HAVE LEGAL PARITY ERRORS
		JRST .+1
		CONOAPR APFCLR+APHMP ;CLEAR MEMORY PARITY ERROR
		JRST PFNXM]	;LEGAL ERROR
	CONSO APR,APNXM		;CHECK FOR NXM
PGNXER:	BUG(PFCDP)
PFNXM:	AOS TRAPPC
	JRST 0(2)
   >				; END IFN SMFLG
;SIMULATION ROUTINES FOR LONG-MODE FLOATING POINT ARITHMETIC
; (KA10-STYLE DOUBLE PRECISION)

	SWAPCD

;HERE WITH INSTRUCTION IN KIMUUO AND PREVIOUS CONTEXT SET UP

SDFN::	SE1CAL
	CALL GTARGS
	LSHC T2,11		;EXPONENT TO T2 (ISN'T CHANGED)
	SETCM T1,T1		;ONE'S COMPLEMENT THE HIGH WORD
	MOVN T3,T3		;TWO'S COMPLEMENT THE LOW WORD.
	SKIPN T3		;SKIP UNLESS LOW WORD IS ZERO
	ADDI T1,1		;TWO'S COMPLEMENT THE HIGH WORD
	LSHC T2,-11		;RESTORE OLD BITS 0-8
	XCTU [MOVEM T1,0(Q1)]	;HIGH PART TO AC
	XCTU [MOVEM T3,@KIMUEF]	;LOW PART TO E
	RET

;SUBROUTINE FOR ARGUMENT FETCH AND PREPARATION (EXTRACT EXPONENT, SIGN EXTEND)
GTARGS:	LDB Q1,[POINT 4,MONFL,30] ;GET AC FIELD OF INSTR
	XCTU [MOVE T1,0(Q1)]	;GET AC ARG
	XCTU [MOVE T3,@KIMUEF]	;GET (E)
	SETZB T2,T4		;CLEAR LOW PARTS
	RET

SFLGET:	XCTU [MOVE T2,@KIMUEF]	;FETCH C(E).
SFLGT1:	LDB Q1,[POINT 4,MONFL,30] ;GET AC FIELD OF INSTR
	XCTU [MOVE Q3,(Q1)]	;FETCH C(AC)
SFLGT2:	LDB Q2,[POINT 9,Q3,8]	;EXPONENT AND SIGN OF C(AC)
	LDB T1,[POINT 9,T2,8]	;EXPONENT AND SIGN OF C(E)
	TRNE Q2,400
	XORI Q2,777		;ONES COMPLEMENT OF NEGATIVE EXPONENT
	TRNE T1,400
	XORI T1,777
	SKIPL Q3		;SKIP IF C(AC) ARE NEGATIVE
	TLZA Q3,777000		;POSITIVE. EXTEND SIGN BIT
	TLO Q3,777000		;NEGATIVE. EXTEND SIGN
	SKIPL T2		;SKIP IF C(E) ARE NEGATIVE
	TLZA T2,777000		;POSITIVE. EXTEND SIGN BIT
	TLO T2,777000		;NEGATIVE. EXTEND SIGN
	RET

;SUBROUTINE FOR ADD/SUBTRACT TYPE OPERATIONS.  DENORMALIZE SMALLER ARGUMENT
SFAT3A:	CAML Q2,T1		;DECIDE WHICH EXPONENT IS LARGER
	JRST SFAT3B		;AND DO PRENORMALIZE (DENORMALIZE)
	EXCH Q2,T1		;INTERCHANGE OPERANDS
	EXCH Q3,T2		;SMALLER OPERAND INTO T1/T2/T3=0
SFAT3B:	SUB T1,Q2		;T1=SHIFT FACTOR (0 OR NEGATIVE)
	MOVEI T3,0		;FOR PEOPLE WHO WANT DOUBLE LENGTH
	CAMGE T1,[-100]		;ARE WE GOING TO LOSE ALL SIGNIFIGANCE?
	TDZA T2,T2		;YES.  T2=0 SKIP THE SHIFT
	ASHC T2,(T1)
	TRZ T3,177		;KA10 MAKES A 54 BIT RESULT
	ADD T2,Q3		;DOUBLE LENGTH RESULT TO T2/T3
	SKIPL T2		;POSITIVE OR NEGATIVE RESULT
	SKIPA Q3,[TLNN T2,1000]
	MOVE Q3,[TLNE T2,1000]
	XCT Q3			;SKIP IF ADD OVERFLOWED
	JRST SFAT3C		;NO OVERFLOW
	ASHC T2,-1		;ADD PRODUCED AN HIGH ORDER BIT.
	ADDI Q2,1		;SHIFT RESULT DOWN AND BUMP EXPONENT
SFAT3C:	TLZ T3,400000		;CLEAR SIGN BIT IN LOW WORD (SET BY ASHC)
	RET

SUFA::	SE1CAL
	CALL SFLGET		;FETCH AND SETUP ARGUMENTS
	CALL SFAT3A		;PRENORMALIZE AND DO THE ADD.
	CAIG Q2,377		;DID EXPONENT OVERFLOW?
	JRST SUFA1		;NO.
	MOVSI Q3,440200		;SET AROV, FOV, AND TRAP1
	IORM Q3,-1(P)		;STORE WHERE THEY'LL BE RESTORED.
SUFA1:	SKIPN T2		;SKIP IF RESULT NON ZERO.
	JUMPE T3,STORA1		;HIGH PART IS 0.  RETURN 0 IF LOW PART IS 0
	DPB Q2,[POINT 8,T2,8]	;STORE EXPONENT
	SKIPGE T2		;SKIP IF RESULT IS POSITIVE
	TLC T2,377000		;ONES COMPLEMENT TO EXPONENT
	MOVE T3,T2		;COPY RESULT TO T3 FOR STORA1
	JRST STORA1

SFADL::	SE1CAL
	CALL SFLGET		;FETCH AND PREPARE ARGUMENTS
	JRST SFADL0

SFSBL::	SE1CAL
	CALL SFLGET		;FETCH AND PREPARE ARGUMENTS
	MOVN T2,T2		;NEGATE C(E)
SFADL0:	CALL SFAT3A		;PRENORMALIZE AND DO ADD
;POSTNORMALIZE.  Q2= EXPONENT, T2--T3 ARE FRACTION
SFLNRM:	SKIPN T2		;Q2=EXPONENT. T2--T3 ARE FRACTION
	JUMPE T3,SFLSTR		;JUMP IF RESULT IS ZERO.  STORE RESULT
	SKIPL T2		;POSTNORMALIZE BY SHIFTING LEFT
	SKIPA T1,[TLNE T2,400]	;SKIP IF POSITIVE NUMBER IS UNNORMALIZED
	MOVE T1,[TLNN T2,400]	;SKIP IF NEGATIVE NUMBER IS UNNORMALIZED
SFLNR2:	XCT T1			;SKIP IF UNNORMALIZED
	JRST SFLNR3		;NORMALIZE COMPLETE
	ASHC T2,1		;SHIFT TO NORMALIZE
	SOJA Q2,SFLNR2		;DECREMENT EXPONENT. LOOP UNTIL DONE

SFLNR3:	JUMPGE T2,SFLN3A	;JUMP IF POSITIVE
	TDNE T2,[777,,-1]	;NEGATIVE.  SKIP IF NO SIGNIFICANCE
	JRST SFLN3A
	ASHC T2,-1		;GET THAT BIT BACK HERE
	ADDI Q2,1
SFLN3A:	TLZ T3,400000		;CLEAR SIGN BIT OF LOW WORD
	LSH T3,-10		;LEAVE ROOM IN LOW WORD FOR EXPONENT
	CAIGE Q2,400		;SKIP IF OVERFLOW
	JUMPGE Q2,SFLNR6	;JUMP UNLESS UNDERFLOW
	MOVSI T1,440200		;AROV, FOV, TRAP 1
	CAIL Q2,433		;DOES EXPONENT EXCEED 128+27?
	JRST SFLNR4		;YES.  STORE ZERO IN LOW WORD
	JUMPG Q2,SFLNR5
	TRNE Q2,200		;SOMETIMES THE KA10 FORGETS AN UNDERFLOW
	TLO T1,100		;SET FLOATING UNDERFLOW TOO.
SFLNR4:	MOVEI T3,0		;AND CLEAR LOW WORD.
SFLNR5:	IORM T1,-1(P)		;STORE FLAGS FOR USER.
SFLNR6:	HRREI Q3,-33(Q2)	;COMPUTE EXPONENT OF LOW PART
	SKIPGE Q3
	MOVEI T3,0		;ZERO LOW PART, IF EXPONENT TOO SMALL
	ANDI Q2,377		;TRUNCATE EXPONENT
	SKIPE T3		;SKIP IF LOW FRACTION IS ZERO
	DPB Q3,[POINT 9,T3,8]	;STORE LOW EXPONENT. CLEAR SIGN BIT.
	ROT Q2,-11		;SHIFT EXPONENT TO RIGHT PLACE
	XOR T2,Q2		;ONES COMPLEMENT OF EXP, IF NEGATIVE
SFLSTR:	XCTU [MOVEM T2,(Q1)]	;STORE DOUBLEWORD RESULT IN C(AC)
STORA1:	ADDI Q1,1		;AND IN C(AC+1 MOD 20)
	ANDI Q1,17
	XCTU [MOVEM T3,(Q1)]
	RET

SFMPL::	SE1CAL
	CALL SFLGET		;FETCH AND PREPARE ARGUMENTS
	MUL T2,Q3		;DOUBLE WORD PRODUCT TO T2/T3
	ADD Q2,T1		;Q2=EXPONENT OF RESULT
	SUBI Q2,200		;ACCOUNT FOR EXCESS 200 IN EXPONENTS
	ASHC T2,10		;RESULT OF MULTIPLY IS TOO FAR RIGHT BY 8
				;PLACES (NOT 9 SINCE BIT 0 OF T3 IS SIGN)
	TLZ T3,400000		;FLUSH SIGNBIT
	JRST SFLNRM		;DO POSTNORMALIZE

SFDVL::	SE1CAL
	LDB Q1,[POINT 4,MONFL,30] ;GET AC FIELD OF INSTR
	XCTU [MOVE T2,(Q1)]	;FETCH C(AC)
	MOVEI T3,1(Q1)
	ANDI T3,17
	XCTU [MOVE T3,(T3)]	;FETCH C(AC+1)
	SKIPN T2		;IF DIVIDING ZERO
	JUMPE T3,SFLSTR		; WITHOUT FURTHER ADO, STORE ZERO
	XCTU [MOVE Q3,@KIMUEF]	;FETCH C(E).
	LSH T3,10		;FLUSH EXPONENT FROM LOW WORD
	TLZ T3,400000		;FLUSH SIGNBIT FROM LOW WORD
	CALL SFLGT2		;SETUP EXPONENTS, ETC
SFDVL1:	MOVEI T4,0		;ASSUME BOTH ARGUMENTS ARE POSITIVE
	JUMPGE T2,SFDVL2	;JUMP IF DIVIDEND IS POSITIVE
	SETCA T2,		;DIVIDEND IS NEGATIVE.  TAKE TWOS COMPLEMENT
	MOVN T3,T3		;OF THE DOUBLE WORD (THIS SHOULD BE DMOVN
	SKIPN T3		;EXCEPT, WE HAVE TO RUN THIS ON THE KA10 TO
	ADDI T2,1		;VERIFY IT).
	MOVSI T4,600000		;QUOTIENT AND REMAINDER ARE NEGATIVE
SFDVL2:	JUMPGE Q3,SFDVL3	;JUMP IF DIVISOR IS POSITIVE
	MOVN Q3,Q3
	TLC T4,400000		;COMPLEMENT SIGN OF QUOTIENT
SFDVL3:	CAMGE T2,Q3		;IS QUOTIENT GREATER THAN 1.0?
	JRST SFDVL4		;NO.
	ASHC T2,-1		;YES.  TRY A 1 BIT SHIFT
	CAML T2,Q3		;DID THAT FIX IT?
	JRST SFDVLX		;NO. WE HAVE A NO-DIVIDE CONDITION
	ADDI T1,1		;ADJUST EXPONENT OF DIVIDEND
SFDVL4:	TLNN Q3,1000		;ONLY CRETINS DIVIDE BY "SETZ"
	JRST SFDVL6
	LSH Q3,-1		;BUT TO KEEP THEM HAPPY...
	ADDI Q2,1
SFDVL6:	SUBM T1,Q2		;Q2=EXPONENT OF QUOTIENT
	ADDI Q2,200		;MAKE EXPONENT INTO EXCESS 200.
	LSH Q3,10		;SCALE DIVISOR TO ALLOW ONLY 27 DIVIDE STEPS
	DIV T2,Q3		;T2=QUOTIENT, T3=REMAINDER
	JUMPE T2,SFDVL9		;IF QUOTIENT IS ZERO, DON'T NORMALIZE
SFDVL8:	TLNE T2,400		;NOW, NORMALIZE THE QUOTIENT
	JRST SFDVL9
	LSH T2,1		;BEFORE COMPUTING OVERFLOW CONDITION
	SOJA Q2,SFDVL8

SFDVL9:	CAIGE Q2,400		;OVERFLOW?
	JUMPGE Q2,SFDVL7	;NO.  JUMP UNLESS UNDERFLOW
	MOVSI Q3,440200		;AROV, FOV, TRAP 1
	JUMPGE Q2,SFDVL5
	TRNE Q2,200		;SOMETIMES THE KA10 FORGETS FXU
	TLO Q3,100		;FXU
SFDVL5:	IORM Q3,-1(P)
	ANDI Q2,377
SFDVL7:	SKIPE T2		;AVOID STORING EXPONENT IN A ZERO FRACTION
	DPB Q2,[POINT 9,T2,8]	;STUFF EXPONENT
	TLNE T4,400000		;SHOULD QUOTIENT BE NEGATIVE?
	MOVN T2,T2		;YES.
	SUBI T1,33		;CALCULATE EXPONENT OF REMAINDER
	SKIPGE T1		;IF UNDERFLOW, SET REMAINDER TO ZERO
	MOVEI T3,0
	JUMPE T3,SFLSTR		;IF ZERO REMAINDER, STORE ZERO
	LSH T3,-10		;MAKE ROOM FOR EXPONENT
	DPB T1,[POINT 8,T3,8]	;STUFF EXPONENT
	TLNE T4,200000		;SHOULD WE NEGATE REMAINDER?
	MOVN T3,T3
	JRST SFLSTR		;STORE AC, AC+1


SFDVLX:	MOVSI T3,440240		;AROV, FOV, NO DIVIDE, TRAP1
	IORM T3,-1(P)
	RET
	SUBTTL GFLOAT TO INTEGER CONVERSION SIMULATION ROUTINES

IFN KLFLG,<

.DGFXR:				;GFLT TO DOUBLE INTEGER ROUNDED
	MOVX T4,GFLT%2		;SET THE DOUBLE AC FLAG
	CALL DGFXR0		;GO TO COMMON CODE
	JUMPG T3,DGFXR1		;IF SHIFT POSITIVE THEN SHIFT LEFT
	CAMG T3,[-^D70]		;SHIFT INSTS ARE MOD 256 SO REDUCE
	 MOVNI T3,^D70		;EXPONENT IF ITS TOO LARGE
	ASHC T1,1(T3)		;SHIFT ROUNDING BIT INTO RIGHTMOST OF T2
	DADD T1,[EXP 0,1]	;ROUND
	ASHC T1,-1		;SHIFT ROUNDING BIT OUT
	RET			;RETURN TO CALLER
DGFXR1:	CAILE T3,^D11		;CHECK EXPONENT SIZE
	 JRST DGFXR3		;TOO BIG THEN OVERFLOW
DGFXR2:	ASHC T1,(T3)		;SHIFT LEFT NO ROUNDING
	RET			;RETURN TO CALLER
DGFXR3:	CAIN T3,^D12		;CHECK FOR LARGEST NEGATIVE INTEGER
	 JUMPL T1,[CAMN T1,[777740000000]
		    JUMPE T2,DGFXR2 ;LET THAT ONE THROUGH
		   JRST .+1]	;OVERFLOW ON ALL OTHERS
DGFXR4:	TXO T4,GFLT%O		;SET THE OVERFLOW FLAG
	RET			;AND RETURN TO CALLER

DGFXR0:				;COMMON CODE FOR DGFIXR AND DFIXR
	LDB T3,[POINT 11,T1,11]	;GET THE EXPONENT
	TLNE T1,(1B0)		;PROPAGATE SIGN THROUGH EXPONENT BITS
	 TLOA T1,777700		;NEGATIVE SET TO ONES
	  TLZA T1,777700	;POSITIVE SET TO ZEROES
	   TRC T3,3777		;UNCOMPLEMENT EXPONENT IF NEGATIVE
	SUBI T3,2000+^D59	;GET SHIFT VALUE TO ALIGN INTEGER PART
	RET			;RETURN TO CALLER

.GFXR:				;GFLOAT TO SINGLE INTEGER ROUNDED
	SETZ T4,		;RESET FLAG AC
	CALL DGFXR0		;GO TO COMMON CODE
	JUMPG T3,DFXR1		;IF SHIFT COUNT POSITIVE GO SHIFT LEFT
	CAMG T3,[-^D70]		;SHIFT INSTS ARE MOD 256 SO REDUCE
	 MOVNI T3,^D70		;NEW EXPONENT IF IT WAS TOO LARGE
	ASHC T1,1(T3)		;SHIFT ROUNDING BIT INTO T2
	DADD T1,[EXP 0,1]	;ROUND
	ASHC T1,-1		;SHIFT ROUNDING BIT OUT
	JRST DFXR3		;GO CONVERT TO SINGLE INTEGER
DFXR1:	CAILE T3,^D11		;CHECK EXPONENT SIZE
	 JRST DGFXR4		;GO DO OVERFLOW STUFF
DFXR2:	ASHC T1,(T3)		;SHIFT LEFT NO ROUNDING NEEDED
DFXR3:	CAME T1,[-1]		;HIGH WORD MUST BE ALL SIGN BITS
	 JUMPN T1,DGFXR4	;IF IT ISNT THEN OVERFLOW
	MOVE T1,T2		;GET WORD INTO CORRECT AC
	RET			;RETURN TO CALLER

.GFX:				;GFLOAT TO SINGLE INTEGER
	SETZ T4,		;RESET FLAG AC
	PUSH P,T1		;SAVE ORIGINAL SIGN
	SKIPGE T1		;IS NUMBER POSITIVE?
	 DMOVN T1,T1		;NO...GET ABSOLUTE VALUE
	LDB T3,[POINT 11,T1,11]	;GET THE EXPONENT
	TLZ T1,777700		;CLEAR EXPONENT FROM NUMBE
	SUBI T3,2000+^D59	;GET SHIFT AMOUNT TO ALIGN INTEGER PART
	CAMG T3,[-^D70]		;SHIFT INSTS ARE MOD 256 SO REDUCE
	 MOVNI T3,^D70		;EXPONENT IF ITS LARGE
	CAILE T3,^D11		;CHECK EXPONENT SIZE
	 JRST GFX2		;TOO BIG...OVERFLOW
	ASHC T1,(T3)		;SHIFT FRACTION OFF
	SKIPGE 0(P)		;CHECK ORIGINAL SIGN
	 DMOVN T1,T1		;IF NEGATIVE COMPLEMENT RESULT
	TLNE T1,(1B0)		;COPY HIGH SIGN INTO LOW WORD
	 TLO T2,(1B0)
	CAME T1,[-1]		;HIGH WORD MUST BE ALL SIGN  BITS
	 JUMPN T1,GFX2		;ELSE OVERFLOW
	MOVE T1,T2		;PUT RESULT INTO PROPER AC FOR RETURN
GFX1:	ADJSP P,-1		;FIX STACK
	RET			;AND RETURN TO CALLER
GFX2:	TXO T4,GFLT%O		;HERE ON OVERFLOW...SET THE FLAG
	JRST GFX1		;AND RETURN TO USER

.DGFX:				;GFLOAT TO DOUBLE INTEGER
	MOVX T4,GFLT%2		;SET THE TWO ACS FLAG
	PUSH P,T1		;SAVE THE ORIGINAL SIGN
	JUMPGE T1,DGFX1		;IS NUMBER POSITIVE?
	DMOVN T1,T1		;NO...SO GET ABSOLUTE VALUE
	CAMN T1,[210740000000]	;CHECK FOR -2^70
	 JUMPE T2,DGFX5		;IT IS SPECIAL SO HANDLE IT
DGFX1:	LDB T3,[POINT 11,T1,11]	;GET THE EXPONENT
	TLZ T1,777700		;CLEAR THE EXPONENT FIELD
	SUBI T3,2000+^D59	;GET SHIFT AMOUNT TO ALIGN INTEGER PART
	CAMG T3,[-^D70]		;SHIFT INSTS ARE MOD 256
	 MOVNI T3,^D70		;REDUCE EXPONENT IF IT IS LARGE
	CAILE T3,^D11		;CHECK EXPONENT SIZE
	 JRST DGFX4		;TOO BIG SO OVERFLOW
	ASHC T1,(T3)		;SHIFT FRACTION OFF
	SKIPGE 0(P)		;CHECK ORIGINAL SIGN
	 DMOVN T1,T1		;IF NEGATIVE THEN COMPLEMENT
	TLNE T1,(1B0)		;COPY HIGH SIGN INTO LOW WORD
	 TLO T2,(1B0)
DGFX2:	ADJSP P,-1		;FIX UP THE STACK
	RET			;AND RETURN TO CALLER
DGFX4:	TXO T4,GFLT%O		;SET THE OVERFLOW FLAG
	JRST DGFX2		;AND RETURN
DGFX5:	MOVSI T1,(1B0)		;-2^70 SPECIAL CASE
	MOVE T2,T1
	JRST DGFX2		;AND GO RETURN
>				;END OF IFN KLFLG
;METER JSYS FOR KL ONLY

.METER::MCENT			;DO ENTRY STUFF
   IFE KLFLG,<ITERR (METRX1)>	;IF NOT A KL, ERROR
   IFN KLFLG,<			;FOR THE KL
	SKIPLE T1		;CHECK FOR VALID FUNCTION
	CAILE T1,METMFC		;STILL?
	ITERR (ARGX02)		;NO.
	XCT MTRTBL-1(T1)	;DO FUNCTION
	XCTU [DMOVEM T1,2]	;RETURN DATA
	MRETNG			;AND DONE

;FUNCTION TABLE

MTRTBL:	RDEACT T1		;GET EBOX TICKS
	RDMACT T1		;GET MBOX TICKS
METMFC==.-MTRTBL		;MAX FUNCTION
   >				;END OF IFN KLFLG CONDITIONAL

	RESCD

	TNXEND
	END