Google
 

Trailing-Edge - PDP-10 Archives - klad_sources - klad.sources/subklm.mac
There are no other files named subklm.mac in the archive.
;[toed.xkl.com]DXX:<KLAD.SOURCES>SUBKLM.MAC.2, 18-Apr-96 17:15:13, Edit by GORIN
;Fixed $CPUTP, it used an indeterminate form of BLT.

SUBTTL	*CONTRL* MAIN SUBROUTINE PACKAGE CONTROL

S
;*SPECIAL SUBPROGRAM LINKAGES
S

	LOC	440

	JRST	DIAGNOS
	JRST	DDT
	JRST	DIAMON
	JRST	REINIT

	LOC	27775

DDTLNK:	10000			;DDT LINKAGE
MODLNK:	MODCHK			;OPERATIONAL MODE CHECK LINKAGE
SUBLNK:	SUBINI			;SUBROUTINE LINKAGE

	LOC	1000		;RESET THE PC AFTER "FIXED" @ 30,000

S
;*INITIALIZE THE SUBROUTINE PACKAGE
S

START:	JRST	$SBSRT		;START SUBROUTINE BY ITSELF
REINIT:	JRST	$REINI		;REINIT SUBROUTINE
SUBINI:	JRST	$PGMIN		;SUBROUTINE INIT ROUTINE
MODCHK:	JRST	$MODCK		;OPERATIONAL MODE CHECK LINKAGE
	0
SUBRTN:	SIXBIT/SUBRTN/		;"SUBRTN" IDENTIFICATION WORD
SUBVER:	MCNVER,,DECVER		;"SUBRTN" VERSION INFORMATION
$TTYSPD:-1			;MONITOR TTY SPEED

NOEXEC:	HALT	.		;PROGRAM NOT CODED FOR EXEC MODE
PLERR:	HALT	.		;FATAL PUSH LIST POINTER ERROR
PLERR1:	HALT	.		;INITIAL PUSH LIST POINTER ERROR
MUOERR:	HALT	.		;MUUO WITH LUUO HANDLER WIPED OUT
DTEBER:	HALT	.		;DTE20 INTERRUPT WITHOUT DOORBELL
DTECER:	HALT	.		;DTE20 CLOCK INTERRUPT WITHOUT FLAG SET
CPIERR:	HALT	.		;CPU INITIALIZATION ERROR
EOPERR:	HALT	.		;END OF PROGRAM ERROR
LUOERR:	HALT	.		;INTERRUPT WITH LUUO HANDLER WIPED OUT
S
;*SPECIAL SUBROUTINE ONLY INITIALIZATION
S
$SBSRT:	MOVEI	1
	MOVEM	ITRCNT		;ALLOW ONLY ONE PASS
	MOVEI	DIAMON
	MOVEM	RETURN
	SETOM	MAPNEW		;FULL 4096K MAPPING
	PGMINT
	JRST	BEGEND

$REINI:	SETZM	$ONETM		;FOR NOW
	SETZM	PASCNT
	SETZM	ERRTLS
	JRST	BEGIN

STARTA:	JRST	BEGEND

PGMNAM:	ASCIZ/
DECSYSTEM DIAGNOSTIC KL10 SUBROUTINE'S
/

S
;*CONTRL* SUBROUTINE PACKAGE INITIALIZATION
S

$PGMIN:	MOVEM	0,$$PAC0
	SETOM	USER
	JSP	0,.+1		;LOAD FLAGS INTO AC0
	TLNN	0,USERF		;USER MODE ?
	SETZM	USER		;EXEC MODE
	SKIPN	MONFLG		;DIAG MON, SPECIAL USER MODE ?
	SETZM	USER		;YES, TREAT I/O AS EXEC
	SKIPE	USER
	JRST	$NOUSR		;NO USER MODE IN "SUBKL"
	CONO	PI,PICLR	;CLEAR PI SYSTEM
	CONO	APR,IOCLR	;CLEAR I/O
	SETZM	$MTRI		;CLEAR METER
	SETZM	$MTRWC
S
;*INITIALIZE PROCESSOR FLAGS AND PUSH LIST
S

$PGMN1:	HLRZ	JOBSA		;RESET JOB FIRST FREE TO
	MOVEM	JOBFF		;END OF LOW SEGMENT
	JRST	2,@.+1		;CLEAR PC FLAGS
		0,,.+1
	MOVE	CONSW
	MOVEM	$SVCSW#		;SAVE PREVIOUS SWITCHES
	SETZM	CONSW#		;CLEAR SWITCH REGISTER
	SETZM	$SWFLG#		;DISALLOW SWITCHES TILL INITED
	MOVE	[JRST $DDTENT]	;SETUP DDT START
	MOVEM	DDTSRT		;DDT IF LOADED, EOPUUO IF NOT
	MOVE	[JRST PSHERR]
	MOVEM	$PSHER		;INIT FOR UNDERFLOW
	MOVE	P,PLIST		;INIT PUSH POINTER
	MOVEI	0,$PSHER
	PUSH	P,0		;SET ERR FOR EXCESSIVE POP'S
	PUSH	P,0

S
;*INITIALIZE SUBROUTINES
S

PGINGO:	GO	$CPUTP		;DETERMINE CPU TYPE (KL/KI/KA)
	SKIPE	KLFLG
	GO	$MAPEX		;MAP EXEC
	GO	$UUOIN		;INIT UUO TRAP TRANSFER LOCATION
	GO	$DTEIN		;INIT DTE-20 INTERRUPT TRANSFER PROCESS
	GO	$PNTIN		;INIT PRINT SUBROUTINE
	GO	$TYPIN		;INIT TTY INPUT SUBROUTINE
	GO	$SWTIN		;INIT SWITCH INPUT SUBROUTINE
	GO	MFICE		;INIT MF20 MEMORY
	GO	$ITRIN		;INIT INTERRUPT SUBROUTINE
	SKIPE	$MMAP		;MEMORY ROUTINES ?
	GO	$MEMMP		;MAP MEMORY
	GO	$KLCSH		;DO CACHE
	SETOM	$ONETM		;SET ONE TIME FLAG
	SETZM	SCOPE		;INIT ERROR SCOPE LOOP
	SETZM	ERRPC		;INIT ERROR PC
	JRST	@$$PAC0#
S
;* -- THIS ROUTINE IS USED TO DETERMINE THE PROPER OPERATIONAL
;*MODE FOR A DIAGNOSTIC JUST LOADED. IT WILL CHECK WHETHER OR NOT
;*IT IS IN USER MODE OR EXEC MODE. AND THEN WILL CHECK TO SEE WHAT
;*MODE HAS BEEN SELECTED FOR THIS TEST TO RUN IN. THIS MODE IS SELECTED
;*AT ASSEMBLY TIME.
S

$MODCK:	JSP	0,.+1		;GET FLAG CONDITIONS
	TLNE	0,USERF		;IN USER MODE ?
	JRST	$UCK		;YES
$ECK:	SETOM	ITRCNT		;EXEC, RUN FOREVER
	SETZM	MONCTL		;NOT HERE IF UNDER MONITOR CONTROL
	SETOM	MONFLG		;SET TO NORMAL OPERATION
	SKIPE	MONTEN		;LOADED BY "DIAMON" ?
	JRST	.+3		;YES, RETURN TO "DIAMON" UPON COMPLETION
	MOVEI	BEGIN		;SET UP RETURN IN CASE WE EVER COUNT OUT
	MOVEM	RETURN		;FOR THE RETURN ADDRESS
	SKIPE	$EMODE		;EXEC MODE ALLOWED?
	JRST	$START		;YES - CONTINUE
	HALT	NOEXEC		;THIS PROGRAM NOT CODED FOR EXEC MODE OPERATION!

$UCK:	SKIPE	$UMODE		;USER MODE ALLOWED?
	JRST	$START		;YES - CONTINUE
$NOUSR:	OUTSTR	[ASCIZ/
EXEC ONLY
/]
	OUTSTR	@$PNAME		;PRINT THE NAME OF THIS FILE
	JRST	@RETURN		;LEAVE FOR EVER

S
;* $MAPEX - KL10 0 TO 112K PAGE MAP SETUP
;*	    0 TO 112K POINTS TO ITSELF
S

$MAPEX:	MOVE	[540000,,540001]
	SKIPN	CSHFLG
	TRO	020000
	MOVEM	600		;SET EPT NON-CACHED
	MOVSI	1,-157
	MOVE	[540000,,540001]
	SKIPN	CSHFLG		;REST CACHED IF ALLOWED
	TDO	[020000,,020000]
	ADD	[2,,2]
	MOVEM	601(1)
	AOBJN	1,.-2
	RTN
SUBTTL	*CONTRL* UUO HANDLING SUBROUTINE

S
;*UUO INITIALIZATION
S

$UUOIN:	MOVE	[GO  $UORTN]	;BRING IN UUORTN ENTRY INSTR.
	MOVEM	JOB41		;SETUP UUO TRAP AT JOB41
	MOVE	[JRST $UOERX]
	MOVEM	$UUOER		;SET UUO ERROR IN "FIXED"
	SETZM	$UPLER#
	RTN			;EXIT

S
;*THIS ROUTINE FIELDS ALL TRAPPED UUO'S AND SELECTS BETWEEN SUBROUTINE
;*PACKAGE UUO'S (037), TEST ERROR UUO'S (034, 035 & 036), AND DIAGNOSTIC
;*PROGRAM SEGMENT UUO'S (001 - 033).
;*AC0 IS SAVED ON THE STACK INITIALLY
S

$UORTN:	SKIPE	$$UUO		;IF NON-ZERO, XCT USERS UUO INTERCEPT
	XCT	$$UUO
	TLNN	P,777000
	JRST	$UOPLE		;CHECK THAT P LOOKS LIKE A P POINTER
	TRNE	P,747000
	JRST	$UOPLE
	PUT	AC0		;SAVE AC0 ON PUSH LIST
	HRRZ	AC0,P		;VERIFY THAT THE PUSH POINTER
	CAIG	AC0,PLIST	;IS STILL OK
	JRST	$UOPLE		;OUT OF RANGE
	CAIL	AC0,PLISTE
	JRST	$UOPLE
	HLRZ	AC0,P		;GET CONTROL COUNT
	CAIG	AC0,777577
	JRST	$UOPLE		;OUT OF RANGE
	CAIL	AC0,777777
	JRST	$UOPLE
	MOVE	AC0,JOBUUO	;GET THE UUO
	LSH	AC0,-^D27	;ISOLATE INSTRUCTION FIELD FOR UUO (RT 27 PLACES)
	CAILE	AC0,33		;IS IT 33 OR LESS? (LOW)
	JRST	$SUBUO		;DECODE 34 - 37 @ $SUBUO
$USRUO:	MOVE	AC0,-1(P)	;GET USRPC + 1 (AC0 IS ALSO ON THE STACK)
	SUBI	1		; - 1
	MOVEM	$SVUPC		;SAVE FOR USER UUO ROUTINE (IF NEEDED)
	MOVE	AC0,JOBUUO	;GET UUO FROM LOCATION 40 IN JDA
	MOVEM	$SVUUO		;SAVE FOR USER UUO ROUTINE
	GET	AC0
	XCT	UUORTN		;EXECUTE USERS ROUTINE IF SUPPLIED
	PUT	AC0
	MOVE	AC0,$SVUUO
	LSH	AC0,-^D27	;RIGHT SHIFT FOR INDEX INTO UUO TABLE
	PUT	1
	LSHC	0,-1
	ADDI	UUODIS		;ADD USER UUO TABLE START TO THE UUO
$XUUO:	TLNN	1,400000
	HRRZ	@0		;EVEN UUO
	TLNE	1,400000
	HLRZ	@0		;ODD UUO
	GET	1
	EXCH	AC0,(P)		;PUT ADR ON STACK, AC0 BACK IN AC0
	RTN			;SPECIAL XFER TO ROUTINE USING ADR ON STACK

$SUBUO:	SUBI	AC0,34		;NORMALIZE TO MAKE LOWEST UUO = 0
	ADDI	AC0,TABLE0	;ADDR OF TABLE + NORM. UUO (0-3)
	JRST	@0		;SELECT THE CORRECT ERROR UUO VIA TABLE

TABLE0:	JRST	%REPT		;UUO = 34 ......................REPEAT
	JRST	%ERLP		;UUO = 35 ...........LOOP ON THE ERROR
	JRST	%ERUUO		;UUO = 36 .REPORT THE ERROR CONDITIONS
	JRST	$UUO37		;UUO = 37 .......DECODE SUBROUTINE UUO
S
;*UUO ERROR EXIT ROUTINE
S
	SALL
	GET	AC0		;POP OFF AC0 (KA MUUO'S)
$UOERX:	PUT	JOBUUO		;SAVE BAD UUO WHILE PRINTING VIA AC0 (P + 1)
	PMSG	<^ILLEGAL UUO^UUO]]FLAGS]  PC^>
	GET	AC0		;GET BAD UUO FROM THE STACK (P - 1)
	PNTHW			;PRINT IT
	PSP			;PRINT SPACE
	GET	AC0		;GET FLAGS & UUO PC + 1 FROM STACK (P - 1)
	SUBI	AC0,1		;SUBTRACT 1
	PNTHW			;PRINT FLAGS & UUO PC
	PCRL			;PRINT C/R & L/F
	XCT	$UORTX		;EXECUTE USERS UUO EXIT, IF PROV
	FATAL

$UOPLE:	SKIPE	$UPLER		;FIRST TIME ?
	HALT	PLERR		;NO, FATAL HALT THEN
	SETOM	$UPLER
	MOVEM	P,$PDOVP	;SAVE "P"
	MOVE	P,PLIST
	CAME	P,[PLIST-PLISTE,,PLIST]
	HALT	PLERR1		;INITIAL POINTER BAD
	MOVEI	$PSHER
	PUSH	P,0
	PMSGF	<^*****^UUO PLIST ERR P=>
	MOVE	$PDOVP
	PNTHWF
	FATAL
	LALL
S
;*MONITOR UUO ERROR EXIT ROUTINE
S
	SALL
MUUOER:	SKIPE	$$MUUO
	XCT	$$MUUO		;EXECUTE USERS MUUO ROUTINE, IF PROV
	MOVE	AC0,JOB41	;GET UUO HANDLER
	CAME	AC0,[GO	$UORTN]
	HALT	MUOERR		;NOT VALID
	MOVE	LMUUOP
	MOVEM	ITRCH1
	CONI	APR,$SVAPR
	CONI	PI,$SVPI
	PMSG	<^ERROR MUUO = >
	MOVE	LMUUO
	PNTHW			;PRINT MUUO
	SETZM	0
	JRST	$ITR1B		;COMMON INTERRUPT ROUTINE START
	LALL
S
;*DECODE ROUTINE FOR SUBROUTINE UUO'S (037)
S

$UUO37:	HRRZ	JOBUUO		;GET CALLING UUO
	JUMPE	$PNTIT		;PRINT UUO
	CAIN	0,1
	JRST	$PNTIF		;PRINT FORCED UUO
	TRNE	777600
	JRST	$EG177		;PRINT MESSAGE UUO
	CAIL	5
	JRST	$EG4		;PRINT CHAR IMMEDIATE UUO
	PUT	1
	MOVE	1,JOBUUO
	LSH	1,-^D23		;EXTRACT UUO AC FIELD
	ANDI	1,17
	LSH	0,4		;POSITION E FIELD
	IOR	0,1		;COMBINE E & AC FIELD
	LSHC	0,-1		;SET ODD/EVEN
	ADDI	$UOTAB-20	;COMPUTE TABLE ENTRY OFFSET
	JRST	$XUUO

$UOTAB:				;E FIELD = 2
	$PTSXF,,$PNTSX
	$PNTCF,,$PNTCW
	$DRPDV,,$PNTNM
	$MODDV,,$MODDP
	$MSEG,,$SWTCH
	$MPADR,,$MZRO
	$MPCNK,,$MPSET
	$PMAP,,$PNTMG
				;E FIELD = 3
	$YESNO,,$OPTLK
	$TPOCT,,$NOYES
	$TPCNV,,$TPDEC
	$TALTM,,$TTLK
	$TTYIN,,$TISIX
	$UOERX,,$UOERX
	$PSIXF,,$PSIX
	$POCSF,,$POCS
				;E FIELD = 4
	$CINVAL,,$MEMMP
	$CWRTB,,$CFLUSH
	$FSELECT,,$MTROP
	$FRD36,,$FREAD
	$UOERX,,$FRD8
	$CLOCK,,$END
	$FATAL,,$ERHLT
	$UOERX,,$EOP

$EG4:	MOVE	JOBUUO		;IMMEDIATE CHARACTER PRINT
	TLNE	(1B12)
	JRST	[PNTCHF
		JRST	$EGX]
	PNTCHR
	JRST	$EGX

$EG177:	MOVE	JOBUUO		;IMMEDIATE MESSAGE PRINT
	TLNE	(4B12)
	JRST	[PSIXLF
		JRST	$EGX]
	TLNE	(2B12)
	JRST	[PSIXL
		JRST	$EGX]
	TLNE	(1B12)
	JRST	[PNTALF
		JRST	$EGX]
	PNTAL
$EGX:	GET	0
	RTN

$DRPDV:				;N/A IN EXEC MODE
$PNTMG:	RTN			;N/A ON KL-10
SUBTTL	*CONTRL* PDP-10 DIAGNOSTIC ERROR HANDLER

S
;*THE DIAGNOSTIC ERROR HANDLER IS A SUBROUTINE CAPABLE OF REPORTING
;*A STANDARD BUT FLEXIBLE FORMAT OF TEST DATA AND DIAGNOSTIC
;*INFORMATION.  THE ERROR HANDLER ALSO INTERPRETS AND CONTROLS TEST
;*SWITCHES SUCH AS TYPEOUT SUPPRESSION, CONTINUE/HALT OR LOOP ON
;*ERROR, AND BELL ON ERROR.
;*ERROR LOOPING ROUTINE
;*EITHER CONTINUES IN-LINE
;*OR TRANSFERS TO E FIELD OF UUO
;*CHECKS PC OF ERROR TO DETERMINE LOOPING
S

%ERLP:	SETZM	%ERFLG#
	PUT	JOBUUO
	GO	$TALTM		;DO ALTMODE CHECK
	JRST	.+4		;NOT ONE
	MOVEI	.+3		;SAVE RESTART ADDRESS
	MOVEM	JOBOPC
	JRST	@ALTMGO		;TRANSFER TO ALTMODE ROUTINE
	GET	JOBUUO
	MOVE	AC0,JOBUUO	;GET AC FIELD OF UUO
	LSH	AC0,-^D23
	ANDI	AC0,17
	CAIN	AC0,2
	JRST	%ERLP2		; 2 = LOOP IF ANY ERROR
	CAIN	AC0,1
	JRST	%ERLP1		; 1 = LOOP IF PC'S MATCH
	CAIN	AC0,0
	JRST	%ERLP0		; 0 = PC'S, REPT, REPT1 & ERROR
	GET	AC0
	JRST	$UOERX
%ERLP0:	SETOM	%ERFLG
	CAMN	REPT,%RP	;ARE REPEAT COUNTS SAME AS ERROR ?
	CAME	REPT1,%RP1	;(AT RIGHT PLACE IN TEST LOOPS ?)
	JRST	%ERX1		;NO, CONTINUE IN LINE
%ERLP1:	HRRZ	AC0,-1(P)	;GET PC OF LOOP CALL FROM STACK
	SUBI	AC0,2		;LESS 2
	CAME	AC0,ERRPC	;NOW EQUAL TO PC OF ERROR CALL ?
	JRST	%ERX1		;NO, CONTINUE IN LINE
%ERLP2:	GO	$SWTCH		;READ SWITCHES INTO AC0
	TLNN	LOOPER		;LOOP ON ERROR ?
	SETZM	SCOPE		;NO ..........CLEAR LOOP CONTROL
	SKIPL	SCOPE		;YES ...WAS THERE AN ERROR ?
	JRST	%ERX1		;NO, CONTINUE IN LINE
%ERX:	GET	AC0		;RESTORE AC0
	SUB	P,[1,,1]	;CORRECT PUSH LIST POINTER FOR NO "RTN"
	JRST	@JOBUUO		;TRANSFER TO E FIELD OF UUO

%ERX1:	GET	AC0		;RESTORE AC0
	RTN

S
;*REPEAT LOOP ROUTINE
;*EITHER CONTINUES IN-LINE
;*OR TRANSFERS TO E FIELD OF UUO
S

%REPT:	SOSLE	REPTU#		;REPEAT TEST SECTION ?
	JRST	%ERX		;YES, E FIELD OF UUO IS RETURN
	JRST	%ERX1		;NO, CONTINUE IN LINE

S
;*COMMON ERROR HANDLER AC SAVE/RESTORE
S

%EACS:	MOVEM	0,%AC0#
	MOVEM	1,%AC1#
	MOVEM	2,%AC2#
	MOVEM	3,%AC3#
	RTN

%EACR:	MOVE	0,%AC0
%EACR1:	MOVE	1,%AC1
	MOVE	2,%AC2
	MOVE	3,%AC3
	RTN
;*ERROR REPORTING ROUTINE
S

%ERUUO:	MOVE	LUUO
	MOVEM	%LUUO#
	SETOM	SCOPE
	GET	AC0
	SKIPE	%ERHI1		;ANY USERS INSTRUCTION ?
	XCT	%ERHI1		;YES, DO USERS ROUTINE
	GO	%EACS		;SAVE AC0 - AC3
	SETZM	%CORFLG#
	SETZM	%ACTFL#
	AOS	ERRTLS		;INCREMENT ERROR TOTALS
	GO	$SWTCH
	HRRZ	3,(P)		;GET <ADDRESS> OF ERROR CALL FROM STACK
	SUBI	3,1
	CAME	3,ERRPC		;SKIP IF SAME ERROR
	JRST	%ERPNT
	SKIPN	%ERFLG
	JRST	.+4		;DON'T CHECK REPEAT COUNTS
	CAMN	REPT,%RP
	CAME	REPT1,%RP1
	JRST	%ERPNT		;DIFFERENT, PRINT ERROR
	TLNN	PALERS		;PRINT ALL ERRORS ?
	JRST	%ERSW1		;THIS ERROR ALREADY REPORTED ONCE.

;*BYPASS ERROR REPORT IF NOPNT SWITCH IS SET
S

%ERPNT:	MOVEM	REPT,%RP#	;SAVE REPEAT COUNTS
	MOVEM	REPT1,%RP1#
	MOVEM	3,ERRPC		;SAVE ERROR CALL ADDRESS
	TLNE	0,NOPNT
	JRST	%ERSW1
	PFORCE			;OVERRIDE CONTROL O
	SETZM	%ERCNT#
	SKIPGE	MONCTL		;DIAG MON OR SYS EXER ?
	JRST	%ERPRA		;YES, GO PRINT TITLE
	SALL
%ERPRB:	SKIPN	PASCNT
	JRST	.+4		;DON'T PRINT PASS COUNTER ON FIRST PASS
	PMSG	<^TEST PASS COUNT = >
	MOVE	0,PASCNT
	PNTDEC			;PRINT TEST PASS COUNTER
	PMSG	<^PC=  >
	MOVEI	0,(3)
	PNT6			;PRINT PC OF ERROR CALL.
	PMSG	<^SWITCHES = >
	MOVE	CONSW
	PNTHW			;PRINT SWITCHES AT ERROR
	GO	%EACR
	SKIPE	%ERHI3		;IF NON-ZERO, XCT USERS ROUTINE
	XCT	%ERHI3

	HRRZ	3,@ERRPC	;GET "E FIELD" OF ERROR CALL
	MOVE	0,CONSW		;AC3 HAS THE ERROR CALL ADDR IN IT
	TLNE	TXTINH		;TEXT INHIBITED ?
	JRST	%ERPR2		;YES
	MOVEI	0,SIXBTZ	<^ERROR IN >
	HLRZ	1,(3)		;GET NAME OF FAILING TEST
	JUMPE	1,%ERPR1	;JUMP IF NO TEST NAME
	PSIXL			;*DEFINE T=0 TO INHIBIT TEST NAME		
	MOVE	0,1
	PSIXL			;REPORT NAME OF FAILING TEST
	MOVEI	0,SIXBTZ	< - >
	JRST	.+2
%ERPR1:	MOVEI	0,SIXBTZ	<^>
	HRRZ	1,(3)		;GET ADDRESS OF FUNCTION MSG
	MOVE	1,(1)		;GET MESSAGE
	CAMN	1,[SIXBIT\_\]	;BLANK MESSAGE ?
	JRST	%ERPR2		;JUMP IF NO FUNCTION CALLED OUT.
	PSIXL		
	HRRZ	0,(3)		;GET MESSAGE ADDRESS AGAIN
	PSIXL			;REPORT FUNCTION BEING TESTED.
%ERPR2:	SETOM	%DISCR#		;SET 'DISCREPANCY FLAG'.
	LALL
;*GET X (AC FIELD) FROM ERROR UUO. PASS X ARGUMENT ONTO $PRINT.
S
	SALL
%ERP2B:	MOVE	%LUUO
	ROT	0,15		;GET THE X ARGUEMENT
	ANDI	0,17
	JUMPN	0,.+2		;PRINT 12 OCTAL DIGITS IF X=0
	MOVEI	0,14
	CAILE	0,14		;MAKE SURE THAT X IS A LEGAL ARGUMENT
	FATAL			;PROGRAM CALL ERROR
	LSH	0,^D<35-12>	;PUT X IN AC FIELD
	ADD	0,[PNTA]	;PRINT THE X ARGUEMENT
	MOVEM	0,%ERIN2
	MOVEI	0,SIXBTZ	<^CORRECT:  >
	HLRZ	2,1(3)		;GET ADDRESS OF EXPECTED TEST RESULTS
	JUMPN	2,.+3
	SETZM	%DISCR		;NO 'CORRECT RESULT' TYPEOUT
	JRST	%ERPR3
	SETOM	%CORFLG
	CAILE	2,3		;ARE TEST RESULTS IN AC THAT HAS BEEN SAVED?
	JRST	%ERP2A
	CAIN	2,1		;AC1?
	MOVE	1,%AC1
	CAIN	2,2		;AC2?
	MOVE	1,%AC2
	CAIN	2,3		;AC3?
	MOVE	1,%AC3
	JRST	.+2
%ERP2A:	MOVE	1,(2)
	LALL
;*AC1 NOW CONTAINS THE CORRECT TEST RESULTS.
S
	SALL
	PSIXL			;CORRECT RESULTS.
	MOVE	0,1
	JSR	%ERIN1		;REPORT CORRECT DATA
	MOVEM	1,%COREC#	;SAVE CORRECT DATA
%ERPR3:	MOVEI	0,SIXBTZ	<^ACTUAL:   >
	HRRZ	2,1(3)		;GET ADDRESS OF ACTUAL TEST RESULTS.
	JUMPN	2,.+3
	SETZM	%DISCR		;NO 'ACTUAL RESULT' TYPEOUT.
	JRST	%ERPR4
	SETOM	%ACTFL
	CAILE	2,3		;ARE ACTUAL TEST RESULTS IN AC THAT IS SAVED?
	JRST	%ERP3A
	CAIN	2,1		;AC1?
	MOVE	1,%AC1
	CAIN	2,2		;AC2?
	MOVE	1,%AC2
	CAIN	2,3		;AC3?
	MOVE	1,%AC3
	JRST	.+2
%ERP3A:	MOVE	1,(2)
	LALL
;*AC1 CONTAINS THE ACTUAL TEST RESULTS.
S
	SALL
	PSIXL			;ACTUAL RESULTS
	MOVE	0,1
	JSR	%ERIN1		;REPORT ACTUAL DATA
	MOVEM	1,%ACTUL#	;SAVE ACTUAL DATA

%ERPR4:	MOVEI	0,SIXBTZ	<^DISCREP:  >
	SKIPN	%DISCR		;REPORT DATA DISCREPANCY IF BOTH CORRECT AND
	JRST	%ERPR5		;ACTUAL DATA REPORTED.
	MOVE	1,%COREC
	XOR	1,%ACTUL	;XOR CORRECT & ACTUAL DATA
	PSIXL		
	MOVE	0,1
	JSR	%ERIN1		;REPORT DISC BETWEEN COR & ACT
	MOVEM	1,%DISCR	;SAVE DISCREPANCY DATA
	LALL
;*PICK UP AND REPORT DIAGNOSTIC COMMENT IF ANY.
S

%ERPR5:	MOVE	0,CONSW
	TLNE	TXTINH		;TEXT INHIBITED ?
	JRST	%ERPR6		;YES
	HLRZ	1,2(3)		;GET ADDRESS OF ASCIZ TEXT.
	MOVE	1,(1)		;GET MESSAGE
	CAMN	1,[SIXBIT\_\]	;BLANK MESSAGE ?
	JRST	%ERPR6		;EXIT FROM ERROR PRINT IF NO DIAGNOSTIC TEXT.
	PCRL
	HLRZ	0,2(3)		;GET MESSAGE ADDRESS AGAIN
	PSIXL		
%ERPR6:	PCRL
	HRRZ	0,2(3)		;GET ADDRESS OF ADDITIONAL ERROR PRINT ROUTINE
	GO	%EACR1
	MOVEM	0,%ERXTR#
	JUMPE	0,%ERMORE	;JUMP IF NONE
	MOVE	0,CONSW
	TLNE	0,TXTINH	;TEXT INHIBITED ?
	JRST	%ERMORE		;YES, NO ADDITIONAL PRINT
	MOVE	0,%AC0
	GO	@%ERXTR		;XFER TO PRINT ROUTINE, RETURN TO ERMORE
	MOVEM	0,%AC0
%ERMORE:MOVE	0,%AC0
	XCT	ERMORE		;TO ADD ROUTINE PLACE XFR AT ERMORE
				;IN "FIXED"
	GO	%EACS
	GO	$SWTCH

;*EXAMINE DATA SWITCHES (OR SOFTWARE SWITCHES IF USER MODE).
S
%ERSW1:	GO	$TALTM		;ALTMODE CHECK
	JRST	.+4		;NONE
	MOVEI	.+3		;SAVE ADDRESS FOR CONTINUE
	MOVEM	JOBOPC
	JRST	@ALTMGO		;PERFORM TRANSFER
	MOVE	3,CONSW
	TLNN	3,ERSTOP	;IS 'HALT ON ERROR' SWITCH SET, (SWITCH ERSTOP)
	JRST	%ERSW2		;NO
;*EXECUTE HALT IF SWITCH ERSTOP SET.
S

%ERS1A:	GO	%EACR		;RESTORE AC'S
	JRST	$ERHLT		;USE SUBROUTINE ERROR HALT

%ERPRA:	SKIPN	%ERFST#		;PRINT PROGRAM NAME
	PNTNM
	SETOM	%ERFST
	JRST	%ERPRB

;*EXAMINE LOOPER SWITCH AND SCOPE LOOP ON ERROR IF SET.
S

%ERSW2:	TLNN	3,LOOPER
	SETZM	SCOPE		;CLEAR SCOPE LOOP CONTROL
	AOS	%ERCNT	;INCREMENT ERROR COUNT

;*RING TTY BELL IF DING SWITCH IS SET.
S

%ERSW3:	TLNE	3,DING
	PBELL

;*RETURN TO ERROR CALL ADDRESS+1
S

%EXCAL:	GO	%EACR1
	SKIPL	MONCTL		;UNDER DIAGNOSTIC MONITOR ?
	JRST	%EXCL1		;NO, CONTINUE PROGRAM
	MOVE	0,ERRTLS	;YES
	CAIL	0,5		;PRINTED ALLOWED ERRORS ?
	JRST	$BEND2		;END OF PROGRAM
%EXCL1:	MOVE	0,%AC0
	SKIPE	%ERHI2		;ANY USERS INSTRUCTION ?
	XCT	%ERHI2		;YES, DO USERS ROUTINE
	RTN			;CONTINUE PROGRAM
SUBTTL	*SUBRTN* DTE-20 INPUT/OUTPUT ROUTINES

S
;*THESE ROUTINES ARE CONCERNED WITH DATA TRANSFER FOR THE KL10 CPU
;*THEY USE THE DTE-20 AND THE DTE-20 COMMUNICATIONS AREA
S

$DTEIN:	SETZM	$DTER1#		;CLEAR DTE20 OUT-OF-SEQUENCE COUNT
	SETZM	140
	SETZM	$DTFLG
	MOVE	0,[140,,141]
	BLT	0,177		;CLEAR DTE20 EPT LOCATIONS
	MOVE	0,[$DTFLG,,$DTCLK]
	BLT	0,$DTSEQ	;CLEAR DTE COMMUNICATIONS AREA
	MOVE	AC0,$DTOPR	;GET OPERATIONAL DTE #
	ORM	AC0,$$DTE0	;INSERT IN DTE I/O INST'S
	ORM	AC0,$$DTE1
	ORM	AC0,$$DTE2
	MOVE	AC0,[JSR $DTRPT];LOAD INTERRUPT TRANSFER INSTR.
	MOVEM	AC0,142		;PUT IN THE DTE-20 AREA
	MOVEM	AC0,152
	MOVEM	AC0,162
	MOVEM	AC0,172
	RTN			;EXIT

S
;*DTE20 INTERRUPT VECTOR INSTRUCTION TRANSFERS TO HERE
S

$$DTEI:
$$DTE1:	CONO	DTE,DNG10C	;CLEAR THE 10 DOORBELL BIT
	SKIPN	$DTCLK		;THIS DTE20 CLOCK INTERRUPT ?
	JRST	$$DTER		;NO FLAGS SET, IMPOSSIBLE CONDITION
	
$CLKDTE:SETZM	$DTCLK		;CLEAR CLOCK FLAG
	SETOM	CLOCKF		;SET DIAG SEGMENT CLOCK FLAG
	SKIPE	$DTCI		;ANY XCT INSTRUCTION ?
	XCT	$DTCI		;YES, DO USERS REQUEST
	JEN	@$DTRPT		;RESUME PROGRAM

$$DTER:	PUT	0		;REPORT DTE ERROR
	PMSGF	<^SPURIOUS DTE INT^>
	GET	0
	JEN	@$DTRPT		;RESUME
S
;*DTE20 COMMUNICATIONS ROUTINE
S

$DTEXX:
$DTEX1:	SKIPE	$DTFLG		;DTE20 INTERRUPT FLAG SET?
	AOS	$DTER1		;YES, NEVER FINISHED LAST OPERATION

$DTEX2:	SETZM	$DTFLG		;INITIALIZE INTERRUPT FLAG
	MOVEM	AC0,$DTCMD	;SETUP 10 TO 11 COMMAND WORD
	SETZM	$DTF11		;CLEAR RESPONSE WORD
	AOS	$DTSEQ		;COUNT DTE20 OPERATION

$$DTE0:	CONO	DTE,DONG11	;RING BELL
	SKIPN	$DTFLG		;WAIT FOR DTE20 COMM INTERRUPT
	JRST	.-1

$DTEX3:	SETZM	$DTFLG		;CLEAR INTERRUPT FLAG
	MOVE	AC0,$DTF11	;PUT RESPONSE IN AC0
	RTN			;RESUME CALLING SUBROUTINE
S
;*this routine looks @ ac0 to determine whether to enable/disable
;*setting clock ticked flag "clockf" IN THE 10 WHEN A POWER LINE
;*CLOCK CYCLE OCCURS IN THE 11 (EVERY 16.67 MS)
;*or TO executE an instruction upon occurrence of the clock tick
;*	ac0 = 0 for disable
;*	ac0 = -1 for enable
;*	AC0 = INST FOR ENABLE & EXECUTE INST
;*	AC0 = 0,,X FOR WAIT X THEN CLOCK XCT OF INST IN AC1
;*	AC0 = 0,,1 FOR READ PRESENT CLOCK COUNT SINCE ENABLED
s

$clock:	CAIN	AC0,1
	JRST	$CLKRD		;READ CLOCK COUNT
	SETZM	$DTCI
	JUMPE	AC0,$CLKOF	;ENABLE the 11 clock to 10?
	CAMN	AC0,[-1]	;YES ...DOES AC0 HAVE -1?
	JRST	$CLKON		;YES ...NOTIFY WHEN CLOCK TICKS
	TLNN	AC0,-1		;IS AC0 = 0,,X ?
	JRST	$CLKWT		;YES...(AC1) IS INST, AC0 = WAIT COUNT
	MOVEM	AC0,$DTCI	;INST IN AC0, SAVE

$CLKON:	MOVEI	AC0,1001	;TURN CLOCK ON
	JRST	$CLKXX

$clkof:	MOVEI	ac0,1000	;TURN CLOCK OFF
	PJRST	$DTEXX

$CLKWT:	MOVEM	1,$DTCI		;(AC1) = INST, (AC0) = WAIT COUNT
	MOVEM	AC0,$DTT11	;SETUP DATA WORD TO PDP-11
	MOVEI	AC0,1002
	JRST	$CLKXX

$CLKRD:	MOVEI	AC0,1003	;READ CLOCK COUNT
	PJRST	$DTEXX		;CLOCK COUNT RETURNED IN AC0

$CLKXX:
$$DTE2:	CONO	DTE,21		;TURN DTE20 INTERRUPTS ON
	PJRST	$DTEXX
S
;*THIS ROUTINE CONTROLS THE DK20 METER FOR NORMAL DIAGNOSTICS
;*ALLOWS METER TO BE ENABLED/DISABLED AND FOR EVERY METER
;*PERIOD THE "CLOCKF" FLAG IS SET AND AN OPTIONAL INSTRUCTION 
;*EXECUTED.  THE METER PERIOD IS SET FOR 16.67 MS (60 HZ).
;*	OR FOR 20 MS FOR A 50HZ PROCESSOR.
S

$MTROP:	CAIN	AC0,1
	JRST	$MTRRD		;0,,1 = READ CLOCK COUNT
	CONO	MTR,0		;CLEAR INTERRUPT ASSIGNMENT
	CONO	TIM,400000	;CLEAR TIMER
	SETZM	$MTRI
	SETZM	$MTRWC
	JUMPE	AC0,$MTROF	;0,,0 = DISABLE
	CAMN	AC0,[-1]
	JRST	$MTRON		;-1 = ENABLE
	TLNN	AC0,-1
	JRST	$MTRW		;0,,X = WAIT
	MOVEM	AC0,$MTRI	;XCT INST

$MTRON:	MOVE	[JSR $MTRIR]
	MOVEM	514		;SETUP METER VECTOR
	SETZM	MTRCNT		;CLEAR METER COUNT
	SKIPN	CYCL60
	CONO	TIM,463203	;60 HZ
	SKIPE	CYCL60
	CONO	TIM,463720	;50 HZ
	CONO	MTR,1		;ON PI CHN 1
	RTN

$MTROF:	CONO	MTR,0		;TURN METER OFF
	RTN

$MTRRD:	MOVE	0,MTRCNT	;READ METER COUNT
	RTN

$MTRW:	MOVEM	1,$MTRI		;WAIT, INSTRUCTION IN AC1
	MOVEM	0,$MTRWC	;WAIT COUNT IN AC0
	JRST	$MTRON
S
;*METER INTERRUPT ROUTINE
S

$MTRIR:	0			;METER INTERRUPT ROUTINE
	CONO	MTR,0		;CLEAR METER
	SKIPN	CYCL60
	CONO	TIM,63203	;RESET PERIOD
	SKIPE	CYCL60
	CONO	TIM,63720
	CONO	MTR,1		;REENABLE
	AOS	MTRCNT		;COUNT CLOCK INTERVAL
	SKIPE	$MTRWC		;DOING A WAIT ?
	JRST	$MTIR2		;YES
$MTIR1:	SETOM	CLOCKF		;SET DIAG SEGMENT CLOCK FLAG
	SKIPE	$MTRI		;ANY XCT INSTRUCTION ?
	XCT	$MTRI		;YES, DO USERS REQUEST
	JEN	@$MTRIR		;RESUME PROGRAM

$MTIR2:	MOVEM	0,$MTRAC
	MOVE	0,MTRCNT
	CAML	0,$MTRWC	;WAITED LONG ENOUGH ?
	JRST	$MTIR3		;YES
	MOVE	0,$MTRAC	;NOT YET
	JEN	@$MTRIR		;JUST EXIT

$MTIR3:	MOVE	0,$MTRAC
	JRST	$MTIR1
SUBTTL	PROCESSOR TYPE DETERMINATION


$CPUTP:	SETZM	CYCL60
	SETZM	KLFLG
	SETZM	KAIFLG
$CPKL:	SETZ	1,		;Source 0, Destination 0
	BLT	1,0		;Copy one word from 0 to 0
	SKIPN	1		;If KL10, AC 1 is changed by BLT
	JRST	CPIERR		;WRONG PROCESSOR
	SETOM	KLFLG		;KL10 - SET FLAG

$CPLII:	BLKI	APR,0		;GET KL10 HARDWARE OPTIONS
	TRNE	0,1B18		;50 HZ BIT SET ?
	SETOM	CYCL60		;YES, SET INDICATOR
	TRNN	0,1B19		;CACHE OPTION BIT SET ?
	SETOM	CSHFLG		;NO, INHIBIT CACHE
	MOVE	$DTSWR		;GET INITIAL SWITCHES
	TLNE	CHAIN		;IS "CHAIN MODE" SET ?
	SETOM	$ONETM		;YES, DON'T PRINT ID INFO
	SKIPE	MONCTL		;DIAGNOSTIC MONITOR ?
	RTN			;YES, NO FURTHER INIT
	MOVEI	$IPGFL		;SETUP INITIALIZATION PAGE FAIL TRAP
	MOVEM	LPGFTR
	CONI	PAG,0
	TRZ	0,57777
	CONO	PAG,@0		;CLEAR EBR
	CONI	PAG,0		;READ EBR
	TRZ	0,620000	;CLEAR CACHE & TRPENB
	CAIE	0,0
	HALT	CPIERR		;NOT CLEAR, FATAL ERROR
	DATAO	PAG,[LLPRCN!LLDUSB,,400000] ;CLEAR UBR
	DATAI	PAG,0		;READ UBR
	TLZ	0,747700	;CLEAR MISC, CURR & PREV AC BLOCK
	CAIE	0,0
	HALT	CPIERR		;NOT CLEAR, FATAL ERROR
	RTN
SUBTTL	"DIAMON" FILE SELECTION & READ
S

$FSELECT:PUT	0
	SETZM	$FSELF#
	MOVE	0,[1,,POWER+1]	;SAVE ACS
	BLT	POWER+16
	GET	0
	SKIPN	FSELNK		;ANY FILE SELECT LINK ?
	JRST	$FSEL1		;NO

	GO	@FSELNK		;TRANSFER TO "DIAMON"
	JRST	$FSEL2		;ERROR RTN, AC0 HAS CODE

	SETOM	$FSELF		;FOUND, SET FILE SELECTED FLAG
	AOS	(P)		;SKIP RETURN
$FSEL2:	PUT	0
	MOVS	0,[1,,POWER+1]	;RESTORE ACS
	BLT	16
	GET	0
	RTN

$FSEL1:	SETZM	0		;NO "DIAMON" CAPABILTY
	JRST	$FSEL2

;*"DIAMON" FILE READ
S

$FRD8:	MOVEI	0,1		;SET FLAG FOR 8BIT READ
	JRST	.+4
$FRD36:	SETO			;SET FLAG FOR 36 BIT READ
	JRST	.+2
$FREAD:	SETZ			;SET FLAG FOR 7 BIT ASCII READ
	PUT	0
	SKIPN	$FSELF		;WAS ANY FILE SELECTED ?
	FATAL			;NO
	SKIPN	FRDLNK		;ANY FILE READ LINK ?
	FATAL			;NO
	MOVE	0,[1,,POWER+1]	;SAVE ACS
	BLT	POWER+16
	GET	0		;GET FORMAT FLAG
	GO	@FRDLNK		;TRANSFER TO "DIAMON"
	JRST	$FSEL2		;EOF
	JRST	$FSEL2-1	;OK, SKIP RETURN
SUBTTL	PROGRAM HALTS

;*SUBROUTINE ERROR HALT
S

$ERHLT:	PNTNM			;PRINT PROGRAM NAME
	PMSGF	<ERROR HALT AT >
	GET	$ERH0
	PUT	0
	MOVE	AC0,$ERH0#	;LOAD HALT LOC WITH USRPC + 1 FOR RESTART
	SOS			;SUBTRACT ONE FOR USRPC OF ERROR
	PNT6F			;PRINT USRPC FORCED
	PCRLF

	SKIPL	MONCTL		;UNDER MONITOR CONTROL ?
	JRST	$ERHL4		;NO..HALT AT USRPC WHERE UUO OCCURRED

$ERHL1:	GO	$SWTCH		;READ SWITCHES INTO AC0
	TLNE	0,ERSTOP	;HALT ON ERROR SWITCH SET ?
	JRST	$ERHL4		;YES...HALT

$ERHL3:	GET	AC0		;RESTORE  THE STACK (P - 1)
	JRST	$BEND2		;END OF PROGRAM

$ERHL4:	SETOM	KLNSW
	MOVEI	AC0,402		;IF KL10, NOTIFY PDP-11
	GO	$DTEXX
	GET	AC0
	HALT	@$ERH0		;NO, HALT WHERE ERROR OCCURED
;*FATAL PROGRAM ERROR HALT
S

$FATAL:	PNTNM
	PMSGF	<FATAL PROGRAM ERROR AT >
	MOVE	AC0,(P)		;RETRIEVE USRPC + 1 FROM THE STACK
	SOS			;- 1
	PNT6F			;PRINT IT
	PCRLF
	SKIPL	MONCTL		;EXEC - DIAGNOSTIC MONITOR ?
	JRST	$FATL1		;NO, END OF PROGRAM
	GO	$SWTCH		;YES ... READ SWITCHES
	TLNN	ERSTOP		;STOP ON ERROR ?
	JRST	$BEND2		;NO, END OF PROGRAM

$FATL1:	SETOM	KLNSW
	MOVEI	AC0,401
	GO	$DTEXX		;NOTIFY PDP-11

$DDTENT:PUT	0
	MOVE	AC0,DDT+1	;GET DDT ID
	CAME	AC0,[ASCII/DDT/]
	JRST	$BEND2		;NOT LOADED, END PROGRAM
	GET	0
	JRST	@DDTLNK		;DDT LOADED, GO TO IT
SUBTTL	PROGRAM NAME PRINTER

;*PRINT PROGRAM NAME IF NOT STAND-ALONE
S
	SALL
$PNTNM:	SKIPL	MONCTL		;DIAG MON / SYS EXR ?
	JRST	$PNM2		;NO
	PNTMSG	@$PNAME		;PRINT PROGRAM NAME
	PMSG	<VERSION >
	HLRZ	JOBVER
	PNTOCS			;PRINT MCN LEVEL
	PNTCI	"."
	HRRZ	JOBVER
	PNTOCS			;PRINT DEC VERSION
	PMSG	<, SV=>
	HLRZ	SUBVER
	PNTOCS			;PRINT "SUBRTN" MCN LEVEL
	PNTCI	"."
	HRRZ	SUBVER
	PNTOCS			;PRINT "SUBRTN" DEC VERSION
$KLSN:	BLKI	APR,$KLSNX#	;GET KL10 CPU ID INFO
	MOVE	$KLSNX
	ANDI	7777
	GO	$SNPNT		;PRINT CPU SERIAL NUMBER
	PMSG	<, MCV=>
	MOVE	$KLSNX
	MOVSS
	ANDI	777
	PNTOCS			;PRINT MICRO-CODE VERSION
	PMSG	<, MCO=>
	MOVE	$KLSNX
	LSH	-^D27
	ANDI	777
	PNTOCS			;PRINT MICRO-CODE OPTIONS
	PMSG	<, HO=>
	MOVE	$KLSNX
	LSH	-^D12
	ANDI	77
	PNTOCS			;PRINT HARDWARE OPTIONS

$PNM1:	SKIPN	CYCL60
	PMSG	<, 60HZ>
	SKIPE	CYCL60
	PMSG	<, 50HZ>

$PNM2:	PCRL
	RTN			;EXIT

$SNPNT:	PUT	0
	PMSG	<, CPU#=>
	GET	0
	PNTDEC			;PRINT CPU SERIAL NUMBER
	RTN
SUBTTL	*SUBRTN* INTERRUPT HANDLING ROUTINES
	LALL

;*PUSH DOWN LIST EXCESSIVE POPJ ROUTINE
S

PSHERR:	PMSGF	<^*****^PLIST UFLOW^>
	FATAL			;PRINT LOCATION AND EXIT

S
;*INTERRUPT ROUTINE INITIALIZATION
;*SETUP INTERRUPT VECTORS
S

$ITRIN:	MOVE	[JSR ITRCH1]
	MOVEM	42
	MOVEM	44
	MOVEM	46
	MOVEM	50
	MOVEM	52
	MOVEM	54
	MOVEM	56

	MOVE	[JRST $ITRC1]	;SETUP "FIXED" LINKING
	MOVEM	ITRCH1+1
	MOVE	[JRST RESRTX]
	MOVEM	RESRT1
	JRST	$KL10
;*DIAG SEGMENT TRANSFER POINT FOR INTERRUPT ROUTINES
S
	SALL
$PDOVU:	MOVEM	P,$PDOVP#
	MOVE	P,PLIST		;RESET POINTER
	MOVEI	0,$PSHER
	PUSH	P,0
	PMSG	<^*****^PLIST OVERFLOW P=>
	MOVE	0,$PDOVP
	PNTHW
	SETZ
	JRST	$ITR1B		;COMMON INTERRUPT ROUTINE

$MPVU:	MOVEI	SIXBTZ	<^MEMORY PROT>
	JRST	$ITR1A		;COMMON INTERRUPT ROUTINE

$NXMU:	MOVEI	SIXBTZ	<^NON-EX MEMORY>
	JRST	$ITR1A		;COMMON INTERRUPT ROUTINE

$PAREX:	MOVE	0,$ACC0
	XCT	$PARER		;EXECUTE USER ROUTINE, IF PROVIDED
	MOVEI	SIXBTZ	<^MEMORY PARITY>
	JRST	$ITR1A		;COMMON INTERRUPT ROUTINE
	LALL
;*COMMON INTERRUPT HANDLERS
S
	SALL
$ITRHZ:	MOVE	0,$ACC0
	XCT	$ITRHL		;EXECUTE USER ROUTINE, IF SUPPLIED
	CONO	PI,PIOFF	;CLEAR PI SYSTEM
	MOVEI	SIXBTZ	<^UNKNOWN INTERRUPT>
	LALL
;*PRINT CAUSE AND OTHER PERTINENT INFO
S
	SALL
$ITR1A:	PUT	0
	PFORCE
	700400,,$SVERA		;READ ERA
	PMSG	<^ERROR ADDRESS REG = >
	MOVE	$SVERA
	PNTHW
	GO	MEMSAV		;SAVE & RESET MEMORY CONTROLLERS
	GO	MREPORT		;REPORT CONTROLLERS WITH ERRORS
	GET	0
$ITR1B:	SKIPE	0
	PSIXL			;PRINT CAUSE
	PMSG	<^APR            PI             FLAGS  PC      PROG^>
	MOVE	$SVAPR#
	PNTHW			;PRINT APR CONI BITS
	PSP
	MOVE	$SVPI#
	PNTHW			;PRINT PI CONI BITS
	PSP
	MOVE	ITRCH1
	PNTHW			;PRINT FLAGS, PC
	PSP
	HRRZ	0,(P)
	PNT6			;PRINT LAST PUSHJ ENTRY
	PCRL
	MOVE	0,$ACC0
	XCT	$ITRX1		;EXECUTE USER ROUTINE, IF SUPPLIED
	FATAL
	LALL
;*COMMON INTERRUPT ROUTINE
S

$ITRC1:	MOVEM	AC0,$ACC0#	;SAVE AC0
	CONI	APR,$SVAPR	;SAVE APR SYSTEM
	CONI	PI,$SVPI	;SAVE PI SYSTEM
	MOVE	AC0,JOB41
	CAME	AC0,[GO	$UORTN]
	HALT	LUOERR		;UUO HANDLER INVALID
	MOVE	AC0,$ACC0
	JRST	$KLITR

;*RESTORE PROCESSOR ON POWER FAIL RESTART
S
	SALL
RESRTX:	SKIPN	$PWRF		;DID POWER FAIL WORK?
	JRST	$PWRFL		;NO
	JRST	$KLRST		;KL10

$RSTCM:	HRRZM	1,$SVPI
	HRRZM	3,$SVAPR
	MOVS	[1,,POWER+1]	;RESTORE AC'S
	BLT	17
	PMSGF	<^POWER FAIL RESTART^>
	SETZM	$PWRF#
	MOVE	0,POWER
	XCT	$RSRTX		;EXECUTE USER ROUTINE, IF PROVIDED
	CONO	APR,@$SVAPR	;RESET APR SYSTEM
	CONO	PI,@$SVPI	;RESET PI SYSTEM
	MOVS	[1,,POWER+1]	;RESTORE AC'S
	BLT	17
	MOVE	0,POWER
	XCT	$RSRTY		;EXECUTE USER ROUTINE, IF PROVIDED
	JRSTF	@$PWRST

$PWRFL:	PGMINT			;REINIT THE SUBROUTINE PACKAGE
	PMSGF	<^POWER INTERRUPT FAILED^>
	HALT	BEGIN
	LALL
;*KL10 PUSHDOWN OVERFLOW TRAP ROUTINE
S

$PDLOV:	MOVEM	AC0,ITRCH1	;SAVE USRPC  (VIA JSP)
	CONI	APR,$SVAPR	;SAVE PROCESSOR STATUS
	CONI	PI,$SVPI	;SAVE PI STATUS
	JRST	$PDOVU		;GO HANDLE IT

;*KL10 PAGE FAIL TRAP ROUTINE
S
$PGFL:	MOVE	AC0,LPFWPC	;KL10, GET PAGE FAIL PC
	MOVEM	AC0,ITRCH1	;SAVE USRPC
	CONI	APR,$SVAPR	;SAVE PROCESSOR STATUS
	CONI	PI,$SVPI	;SAVE PI STATUS
	PMSG	<^PAGE FAIL TRAP ERROR^PAGE FAIL WORD- >
$PGFL1:	MOVE	LEUPFW		;GET KL10 PAGE FAIL WORD
	PNTHW			;PRINT IT
	JRST	$PGFL2		;KL10, REPORT APR ERRORS ALSO

;*KL10 TRAP 3 ROUTINE
S
$TRP3:	MOVEM	AC0,ITRCH1	;SAVE THE USRPC
	CONI	APR,$SVAPR	;SAVE PROCESSOR STATUS
	CONI	PI,$SVPI	;SAVE PI STATUS
	MOVEI	AC0,SIXBTZ	^TRAP 3 ERROR
	JRST	$ITR1B		;COMMON INTERRUPT ROUTINE START 

;*KL10 COMMON TRAP & MMUO SETUP
S

$KIKLI:	MOVSI	(JFCL)
	MOVEM	LAROVT		;SETUP ARITHMETIC OV TRAP
	MOVE	[JSP $PDLOV]
	MOVEM	LPDOVTP		;SETUP PDL OV TRAP
	MOVE	[JSP $TRP3]
	MOVEM	LTRP3TP		;SETUP TRAP 3
	MOVEI	MUUOER		;SETP MUUO AS ERROR FOR THE FOLLOWING:
	MOVEM	LKNTRP		;KERNAL MODE - NO TRAP ENABLED
	MOVEM	LKTRP		;	"	TRAP ENABLED
	MOVEM	LSNTRP		;SUPERVISOR - NO TRAP
	MOVEM	LSTRP		;	"	TRAP
	MOVEM	LCNTRP		;CONCEALED - NO TRAP
	MOVEM	LCTRP		;	"	TRAP
	MOVEM	LPNTRP		;PUBLIC - NO TRAP
	MOVEM	LPTRP		;   "	  TRAP
	RTN
;*KL10 INTERRUPT ROUTINE
S
	SALL
$KLITR:	DATAI	PAG,$SVPAG#	;SAVE PAGE
	CONI	PAG,$SPAG1#
	CONSO	APR,LPWRFL	;POWER FAILURE?
	JRST	$KLIT1		;NO ...LOOK FOR PARITY ERROR

$KLPWR:	MOVE	[1,,POWER+1]	;YES
	BLT	POWER+17
	MOVE	$ACC0
	MOVEM	POWER
	MOVE	ITRCH1
	MOVEM	$PWRST#		;USER RESTART IF WANTED
	MOVE	[JRST PFSTRT]
	MOVEM	70
	GO	$CFLUSH		;FLUSH CACHE IF ON
	SETOM	$PWRF		;NOTIFY OF POWER FAIL ON RESTART
	HALT	BEGIN		;UNTIL POWER ON 

$KLIT1:	MOVE	$SVAPR		;GET APR CONDITIONS
	TRNN	LNXMER!LPARER!LSBUSE!LIOPFE!LCADRP!LSADRP
	JRST	$ITRHZ		;NONE OF THESE INTERRUPTS
	TRNE	LNXMER		;NON-X-MEM ERROR ?
	JRST	$NXMU		;YES
	TRNE	LPARER		;PARITY ERROR ?
	JRST	$PAREX		;YES
	TRNE	LSBUSE		;S-BUS ERROR ?
	JRST	$KLSBE
	TRNE	LIOPFE		;I/O PAGE FAIL ?
	JRST	$KLIOP
	TRNE	LCADRP		;CACHE ADR PARITY ?
	JRST	$KLCAD
	TRNE	LSADRP		;S-BUS ADR PARITY ?
	JRST	$KLSAD
	JRST	$ITRHZ		;NO ...REST ARE COMMON 

$KLSBE:	MOVEI	SIXBTZ	<^S-BUS>
	JRST	$ITR1A
$KLIOP:	MOVEI	SIXBTZ	<^I/O PAGE FAIL>
	JRST	$ITR1A
$KLCAD:	MOVEI	SIXBTZ	<^CACHE ADR PARITY>
	JRST	$ITR1A
$KLSAD:	MOVEI	SIXBTZ	<^S-BUS ADR PARITY>
	JRST	$ITR1A
	LALL
;*KL10 INTERRUPT AND TRAP INITIALIZATION
S

$KL10:	MOVEI	$KLPGFL
	MOVEM	LPGFTR		;SETUP PAGE FAIL TRAP
	GO	$KIKLI		;SETUP TRAPS & MUUOS
$KLCLR:	CONO	PI,LRQCLR!LPICLR!LCHNOF!LPIOFF	;CLEAR PI SYSTEM,CHNL & REQ PEND
	CONO	APR,LAPRAL-20	;CLEAR PROCESSOR ALL

$KLENB:	SKIPN	MONFLG		;MONITOR CONTROL (SPECIAL USER) ?
	JRST	.+5
	MOVE	CONSW
	SKIPN	PVPAGI		;PREVENT PAGE INHIBIT ?
	TLNN	INHPAG		;PAGING & TRAPPING INHIBITED ?
	GO	KLPAG		;NO, SETUP TRAP ENABLE
	CONO	APR,LAPRP1	;ENABLE CHANNEL 1
	CONO	PI,LCHNON!LPION!LPICHA	;ENABLE ALL PI CHNS
	RTN			;EXIT

$IPGFL:	HALT	CPIERR		;KL10 INITIALIZATION PAGE FAIL

$KLPGFL:HLRZ	0,LEUPFW	;GET PAGE FAIL WORD
	ANDI	0,770000	;ISOLATE PAGE FAIL CODE
	CAIE	0,360000	;AR PARITY ERROR ?
	JRST	$PGFL		;NO
	CONSO	APR,LNXMER	;YES, ALSO NON-X-MEMORY ?
	JRST	$PGFL		;NO, REAL AR PARITY ERROR
	AOS	LPFWPC		;YES, INCREMENT PAGE FAIL PC
	JRSTF	@LPFWPC		;RETURN TO NEXT INSTRUCTION

$PGFL2:	MOVE	$SVAPR
	TRNN	LNXMER!LPARER!LSBUSE!LIOPFE!LCADRP!LSADRP
	JRST	$ITR1B+2	;NO APR ERRORS
	JRST	$KLIT1		;YES, REPORT APR ERRORS

$KLRST:	MOVE	17,POWER+17	;RESTORE PUSH POINTER
	GO	$KLCLR		;CLEAR & ENABLE APR & PI
	GO	$KLCSH		;SETUP CACHE IF IT WAS ON
	JRST	$RSTCM		;RESTORE CPU & RESTART
SUBTTL	*SUBRTN* END OF PASS/END OF PROGRAM ROUTINES
	LALL
;*END OF PASS ROUTINE
S
	SALL
$END:	AOS	PASCNT		;INCREMENT PASS COUNTER
	SOS	ITRCNT
	SETZM	SCOPE
	SETZM	ERRPC
	GO	$SWTCH
	TLNE	ABORT		;ABORT AT END OF PASS ?
	JRST	$END2		;YES
	GO	$END4
	SKIPN	ITRCNT
$END1:	JRST	$END3		;SKIP RETURN, COMPLETED ALL ITERATIONS
	RTN			;NON - SKIP , KEEP RUNNING
$END2:	PMSGF	<END PASS >
	MOVE	PASCNT		;PRINT END OF PASS COUNT
	PNTDCF
	PNTCIF	"."
	PCRLF
$END3:	AOS	(P)
	RTN
$END4:	SKIPGE	MONCTL
	RTN			;"DIAMON" CONTROL
	MOVEI	AC0,404		;END OF PASS CODE
	GO	$DTEXX		;NOTIFY PDP-11
	RTN
	LALL
;*END OF PROGRAM ROUTINE
S

$EOP:	SETZ
	CLOKOP			;DISABLE PDP-11 CLOCK

	GO	$CWRTBI		;WRITEBACK & INVALIDATE CACHE IF ON
	CONO	PAG,0		;TURN OFF CACHE

	SKIPE	MONTEN		;KL10 & EXEC
	JRST	@RETURN		;LOADED BY 10, RETURN TO LOADER

	MOVEI	AC0,403		;LOADED BY PDP-11
	GO	$DTEXX		;NOTIFY OF EOP
	HALT	EOPERR		;SHOULD NEVER GET HERE
SUBTTL	*SUBRTN* KL10 CACHE ENABLE
S

$KLCSH:	SKIPE	CSHFLG
	RTN			;NO CACHE ALLOWED
	MOVE	CONSW
	TLNE	INHCSH
	RTN			;CACHE INHIBITED

$CSH:	CONSZ	PAG,LCASLO!LCASLD	;CACHE ALREADY SETUP ?
	RTN			;YES, LEAVE IT ALONE THEN
	HLRZ	3,CLKDFL	;GET CACHE ENABLE BITS
	LSH	3,-^D14		;ISOLATE BITS 0,1,2,3
	ANDI	3,17
	SKIPN	3		;ANY CACHES ENABLED ?
	RTN			;NO CACHE

	HRROI	0,-4		;INITIAL "BLKO E"
	MOVEI	1,200		;"BLKO" COUNT
	SETZM	4
	MOVE	2,CTABLE(3)	;GET CACHE REFILL TABLE POINTER
	CAIN	3,10
	JRST	$CSH3		;CACHE 0
	CAIN	3,4
	JRST	$CSH3		;CACHE 1
	CAIN	3,2
	JRST	$CSH3		;CACHE 2
	CAIN	3,1
	JRST	$CSH3		;CACHE 3
$CSH1:	ADDI	0,4		;BUMP "BLKO E" BY 4
	SKIPN	4		;SINGLE CACHE ?
	ILDB	3,2		;EXTRACT BYTE FROM TABLE
	DPB	3,[POINT 3,0,20] ;DEPOSIT INTO "BLKO" WORD
	BLKO	APR,@0		;LOAD CACHE RAM
	SOJGE	1,$CSH1		;LOOP FOR ALL LOC IN RAM

	GO	$CINVAL		;INVALIDATE CACHE

$CSH2:	CONI	PAG,0
	TRO	LCASLO!LCASLD	;ENABLE LOOK & LOAD
	CONO	PAG,@0
	RTN

$CSH3:	MOVE	3,2		;PUT CACHE DIGIT IN AC3
	AOJA	4,$CSH1

$CSHER:	PMSGF	<CSWEEP TIMEOUT^>
	FATAL
CTABLE:	0
	3			;CACHE REFILL 3
	2			;CACHE REFILL 2
	POINT	3,CR23		;CACHE REFILL 2 & 3
	1			;CACHE REFILL 1
	POINT	3,CR13		;CACHE REFILL 1 & 3
	POINT	3,CR12		;CACHE REFILL 1 & 2
	POINT	3,CR123		;CACHE REFILL 1 & 2 & 3
	0			;CACHE REFILL 0
	POINT	3,CR03		;CACHE REFILL 0 & 3
	POINT	3,CR02		;CACHE REFILL 0 & 2
	POINT	3,CR023		;CACHE REFILL 0 & 2 & 3
	POINT	3,CR01		;CACHE REFILL 0 & 1
	POINT	3,CR013		;CACHE REFILL 0 & 1 & 3
	POINT	3,CR012		;CACHE REFILL 0 & 1 & 2
	POINT	3,CR0123	;CACHE REFILL 0 & 1 & 2 & 3

;CACHE REFILL TABLES FOR 1, 2, 3 AND 4 CACHE COMBINATIONS.
;DIGITS AFTER 'CR' INDICATE WHICH CACHES ARE ENABLED.

CR0123:	012345673123
	212371271127
	656755670323
	022301234567
	077700074666
	446431331113
	077700070123
	456745574547
	012201210566
	056045654564
	012345670000

CR012:	012245612122
	212211211121
	656255620626
	022601264560
	000000004666
	446451551115
	044400040125
	456445504540
	012201210566
	056045654564
	012645640000
CR123:	312315673123
	212371271127
	656755677323
	722331232567
	377733372666
	226231331113
	777777777123
	156715571517
	512251216566
	656655655565
	612355670000

CR023:	032342673323
	232373273327
	626722670323
	022307234067
	077700074666
	446437337773
	077700070723
	406740074047
	062206260466
	046044644464
	062344670000

CR013:	013345173133
	313371371137
	151755170373
	077301734507
	077700074000
	440431331113
	077700070173
	450745574547
	015501510544
	054045454544
	015345470000

CR01:	015545115155
	515511411141
	151455140444
	044401444500
	000000004000
	440451551115
	044400040145
	450445504540
	015501510544
	054045454544
	015445440000
CR02:	062242662422
	242266266626
	626222620626
	022604264060
	000000004666
	446444444444
	044400040424
	406440004040
	062206260466
	046044644464
	062644640000

CR03:	033347773333
	333373373337
	777777770373
	077307734007
	077700074000
	440437337773
	077700070773
	400740074047
	044404440444
	044044444444
	044344470000

CR12:	512215612122
	212211211121
	656255621626
	122661262566
	666666662666
	226251551115
	555555555125
	156515521512
	512251216566
	656655655565
	612655660000

CR13:	313315173133
	313371371137
	151755177373
	777331737577
	377733377777
	777731331113
	777777777173
	157715571517
	515551515555
	555555355535
	515355570000
CR23:	332372673323
	232373273327
	626722677323
	722337232767
	377733372666
	226237337773
	777777777723
	776777777777
	362236266366
	636666666666
	662366670000

KLEXCK:	CONSZ	PAG,LCASLO!LCASLD
	RTN			;CACHE IS ON
	SUB	P,[1,,1]	;OTHERWISE DOUBLE RETURN
	RTN
;*KL10 CACHE INVALIDATE
S

$CINVAL:PUT	0
	MOVE	0,[DATAI CCA,0]	;CACHE INVALIDATE ALL

$CSHZ:	PUT	1
	PUT	2
	PUT	3
	PUT	4
	CONI	APR,4
	ANDI	4,7
	TRO	4,LDCASD
	CONO	APR,(4)		;DISABLE CACHE SWEEP DONE INTERRUPT

	MOVE	1,[CONSZ APR,LCASWB]	;CACHE SWEEP BUSY
	MOVE	2,[SOJN 4,1]	;WAIT TILL IT GOES AWAY
	MOVE	3,[JRST $CSHX]	;RETURN FROM AC'S
	MOVEI	4,-1		;WAIT COUNT
	JRST	0		;GO INVALIDATE/FLUSH CACHE

$CSHX:	SKIPN	4		;DID WE TIME OUT ?
	JRST	$CSHER		;YES, REPORT ERROR
	GET	4
	GET	3
	GET	2
	GET	1
	GET	0
	RTN

;*KL10 CACHE FLUSH
S

$CFLUSH:GO	KLEXCK
	PUT	0
	MOVE	0,[BLKO CCA,0]	;CACHE FLUSH
	JRST	$CSHZ

;*KL10 CACHE WRITE-BACK & INVALIDATE
S

$CWRTBI:GO	KLEXCK
	PUT	0
	MOVE	0,[701540,,0]	;CACHE WRITE-BACK & INVALIDATE
	JRST	$CSHZ
SUBTTL	*SUBRTN* KL10 MEMORY INITIALIZE

S
;*MFICE - FIND ALL MF20 MEMORY CONTROLLERS IN THE SYSTEM AND MAKES
;*	SURE THAT ALL IGNORE-CORRECTABLE-ERROR BITS ARE SET.
;*	ALSO KNOCKS SOFTWARE STATUS 3 DOWN TO 2 AND CLEARS THE
;*	ERROR FLAGS.
S

;	 DEFINITIONS.

MFCN=1				;CURRENT CONTROLLER NUMBER
MFSDT=2 			;SBUS DIAG WORD TO MEM CONSTRUCTED HERE
MFSDF=MFSDT+1			;ECHO FOR ABOVE...MODIFIED & SENT OUT AGAIN
OPDEF	SBDIAG	[BLKO PI,]	;S-BUS DIAG

;*	<START HERE> TOP OF CONTROLLER LOOP.  IF CONTROLLER IS MF20 THEN
;*	SET ITS SOFTWARE STATUS PROPERLY & THEN DO BITSUB RAM LOOP, ELSE
;*	JUST GO ON TO NEXT CONTROLLER.

MFICE:	MOVEI	MFCN,37		;INITIAL CONTROLLER #

MFCNLP:	MOVEI	MFSDT,1		;SET UP FUNCTION 1
	DPB	MFCN,[POINT 5,MFSDT,4] ;CONTROLLER # TOO
	SBDIAG	MFSDT		;DO THE FUNCTION 1
	IORI	MFSDT,200(MFSDF);EXISTING SFTWR STAT TO F1 W/LD EN
	LSH	MFSDF,-^D24	;POSITION CONTROLLER TYPE #
	CAIE	MFSDF,5		;SKIP IF IS MF20
	JRST	MFNXTC		;ELSE GO ON TO NEXT CONTROLLER
	TRNE	MFSDT,1000	;SKIP IF CONTR STAT LESS THAN 2
	TRZ	MFSDT,400	;ELSE MAKE SURE IT IS NOT 3
	SBDIAG	MFSDT		;SET PROPER SFTWR STATUS

;*	BITSUB RAM LOOP.  READ EACH RAM LOC & CHANGE STATE OF ICE
;*	BIT.  IF WAS OFF THEN SET IT ELSE GO ON TO NEXT LOCATION.

	HRRI	MFSDT,60007	;INIT F7
MFBSRL:	HRRI	MFSDT,-400(MFSDT) ;NEXT RAM LOC
	SBDIAG	MFSDT		;READ RAM LOC
	AND	MFSDF,[3770,,0] ;CLEAR JUNK
	IOR	MFSDF,MFSDT	;CONTR #, LOC, & FUNC TO ECHO
	TLC	MFSDF,34	;COMP ICE, PAR.  SET LD EN BIT
	TLNE	MFSDF,20	;SKIP IF ICE BIT WAS ALREADY ON
	SBDIAG	MFSDF		;ELSE TURN IT ON FOR THIS LOC
	TRNE	MFSDT,77400	;SKIP IF ALL LOCS DONE
	JRST	MFBSRL		;ELSE LOOP TILL THEY ARE
;*	CREATE THE SBDIAG FCN 0 WORD TO CLEAR THE ERROR FLAGS,
;*	AND THEN GO CLEAR THEM.

MFNXTC:	HRLZI	MFSDT,10000	;CREATE A FUNCTION 0 CLEAR
	DPB	MFCN,[POINT 5,MFSDT,4] ;CONTR # TOO
	SBDIAG	MFSDT		;DO THE CLEAR

	SOJGE	MFCN,MFCNLP	;SEL NXT CONTR UNTIL ALL DONE
	RTN			; <ALL DONE>

S
;*MREPORT - REPORT MEMORY CONTROLLERS WITH ERRORS
S

MREPORT:PUT	1
	PMSG	<^MEMORY CONTROLLERS^>

	MOVEI	1,37
	MOVE	AC0,SBDTBL(1)	;GET CONTROLLER FUNCTION 0
	TLNE	AC0,770000	;ANY ERRORS SET ?
	JRST	[PNTHW
		 PCRL
		 JRST .+1]	;YES, PRINT THE FUNCTION 0
	SOJGE	1,.-3
	GET	1
	RTN
S
;*MEMSAV - DETERMINE MEMORY CONTROLLERS ON SYSTEM AND SAVE THE
;*	ERROR STATUS FROM THEM.
S

MEMSAV:	PUT	MFCN
	PUT	MFSDT
	PUT	MFSDF
	MOVEI	MFCN,37		;INIT CONTROLLER #

MEMSLP:	MOVEI	MFSDT,1		;SETUP FUNCTION 1
	DPB	MFCN,[POINT 5,MFSDT,4]
	SBDIAG	MFSDT		;READ CONTROLLER TYPE

	LDB	MFSDF,[POINT 5,MFSDF,11]
	JUMPE	MFSDF,.+4	;NO CONTROLLER TYPE RETURNED

	SETZ	MFSDT,		;HAVE A CONTROLLER, READ ERROR STATUS
	DPB	MFCN,[POINT 5,MFSDT,4]
	SBDIAG	MFSDT
	MOVEM	MFSDF,SBDTBL(MFCN) ;SAVE ERROR STATUS IN TABLE

	HRLZI	MFSDT,10000	;CREATE A FUNCTION 0 CLEAR
	DPB	MFCN,[POINT 5,MFSDT,4]
	SBDIAG	MFSDT		;CLEAR THE CONTROLLER

	SOJGE	MFCN,MEMSLP	;DO ALL CONTROLLERS
	GET	MFSDF
	GET	MFSDT
	GET	MFCN
	RTN
SUBTTL	*SUBRTN* MEMORY MAPPING ROUTINES

S
;*THESE ROUTINES PERFORM CORE MAPPING AND PRINTING AS WELL AS MEMORY
;*ZEROING AND ADDRESS TRANSLATION FOR PAGING OR DIRECT ADDRESS MODES
;*	$MPCNK	(MAPCNK)	ACTUAL MEMORY CHUNK MAPPER
;*	$MPSET	(MAPSET)	SETS UP PAGE MAP FOR KL10
;*	$MSEG	(MEMSEG)	SET UP SEGMENTS FROM CHUNKS IN PAGE MAP
;*				(MAPNEW=-1 FOR PAGED SEGMENTS UP TO 4096K)
;*				(MAPNEW= 0 FOR DIRECT ADDRESSING UP TO  256K)
;*	$MZRO	(MEMZRO)	ZERO'S THE MAPPED MEMORY
;*	$MPADR	(MAPADR)	VIRTUAL TO PHYSICAL ADDRESS TRANSLATION
S

;*EXEC MODE MEMORY MAPPING
S

$MEMMP:	SETZM	MEMSIZ		;CLEAR MAP TABLE START ADDR
	MOVE  [MEMSIZ,,MEMSIZ+1]
	BLT	MEMSIZ+^D40	;CLEAR MEMSIZ TABLE

$MEEX1:	SKIPN	MONFLG		;SPECIAL USER MODE ?
	JRST	$MPOL1		;YES, USE UPMP & 256K
	MOVEI	0,337777	;NO
	MOVE	1,CONSW		;SETUP SWITCHES
	SKIPN	PVPAGI		;PREVENT PAGE INHIBIT ?
	TLNN	1,INHPAG	;PAGING INHIBITED ?
	JRST	$MEPAG		;NO ...USE PAGING
	JRST	$MPOL1+1	;YES, USE UNPAGED MEM, 0-112K
$MEPAG:	MOVSI	1,-20		;SETUP EXEC-PER-PROCESS MAP
	MOVE	[540336,,540337]
	SKIPN	CSHFLG
	TDO	[020000,,020000]
	ADD	[2,,2]		;SO 112K-128K POINTS TO ITSELF
	MOVEM	400(1)		;VIRTUAL = PHYSICAL
	AOBJN	1,.-2
	MOVSI	(JFCL)		;SETUP ARITHMETIC TRAP
	MOVEM	421		;JUST IN CASE
	SKIPN	MAPNEW		;"MAPNEW" = 0 ?
	JRST	$MPOLD		;YES ...USE 256K MAPPING

S
;*MEMORY MAPPING CONTROL
;*MAP 4096K, 256K, 112K OR 256K SPECIAL USER
S

$MPNEW:	MOVE	1,JOBFF		;USE FIRST FREE UP TEMP
	MOVEI	16,^D31		;4096K IS 32 128K CHUNKS
	MOVE	0,16
	GO	$MPSET		;SET PAGE MAP FOR 128K CHUNK
	MOVE  [400000,,777777]	;LOAD AC0 WITH PAGABLE ADDR BOUNDARIES
	GO	$MPCNK		;MAP 128K-256K VIRTUAL
	SOJGE	16,.-4		;COMPLETED 4096K ?
	JRST	$MPCMB		;YES, COMBINE POINTERS

$MPOLD:	MOVSI	1,-200		;128K-256K VIRTUAL POINTS
	MOVE  [540376,,540377] 	;TO PHYSICAL 128K-256K
	SKIPN	CSHMEM
	TDO	[020000,,020000]
	ADD	[2,,2]		;AND MEMORY ENDS AT 256K
	MOVEM	200(1)
	AOBJN	1,.-2
	GO	KLPAG		;SET TRAP ENABLE
$MPOL1:	MOVEI	0,777777	;MAP 0-256K
	MOVE	1,JOBFF		;USE FIRST FREE UP TEMP
	SETZM	MAPNEW		;DIRECT ADDRESSING ONLY
	GO	$MPCNK		;MAP CHUNK
	JRST	$MPCMB		;COMBINE POINTERS 
S
;*COMBINE EXISTENT CHUNKS FROM MAPCNK
;*PUT POINTERS IN MEMSIZ TABLE
S

$MPCMB:	SETZM	2		;SET MEMSIZ TABLE POINTER (AC2) @ 0
	SUBI	1,1		;DECREMENT TEMP POINTER
	MOVE	AC0,(1)		;GET LOWEST ADR OF LOWEST CHUNK
	CAIE	0,0		;SHOULD BE 0 (THATS WHERE MEMORY STARTS)
	FATAL			;NOT 0
	MOVEM	MEMSIZ(2)	;PUT IN MEMSIZ TABLE (AC2 IS PTR)
	ADDI	2,1		;INCR THE TABLE POINTER

$MPCM1:	SUBI	1,1		;DECR TEMP POINTER
	CAIG	1,@JOBFF	;COMBINED ALL CHUNK POINTERS ?
				;(TEMP PTR > JOBFF)
	JRST	$MPCM2		;YES )
	MOVE	AC0,(1)		;NO ...GET CHUNK END ADDRESS
	MOVE	3,-1(1)		;GET NEXT CHUNK START ADR IN AC3
	MOVE	4,0		;PUT END ADDR IN AC4
	ADDI	4,1		;INCR THE END ADDR
	CAMN	3,4		;IF END & START NOW EQUAL
	SOJA	1,$MPCM1	;IT IS CONT. CHUNK - DO NEXT ONE

$MPCM3:	MOVEM	0,MEMSIZ(2)	;IF NOT =, PUT END ADR IN MEMSIZ TABLE
	CAIL	2,^D38		;HAVE WE FILLED MEMSIZ TABLE ?
	JRST	$MPCMX		;YES ...IGNORE REST OF CHUNKS )
	ADDI	2,1		;NO ...INCR MEMSIZ TABLE PTR (AC2)
	MOVEM	3,MEMSIZ(2)	;AND NEXT CHUNK START ADR
	SOJA	1,$MPCM1-1	;DO NEXT ONE

$MPCM2:	MOVE	(1)		;GET LAST ADDR OF LAST CHUNK
	MOVEM	MEMSIZ(2)	;SAVE LAST ADR OF LAST CHUNK
	SETOM	MEMSIZ+1(2)	;FLAG END OF MEMSIZ TABLE WITH 1'S
	JRST	$PMAP		;PRINT THE MAP 

$MPCMX:	SETOM	MEMSIZ+1(2)	;FLAG END OF MEMSIZ TABLE WITH 1'S

	PMSGF	<^TOO MANY MAP SEGMENTS^>
	JRST	$PMAP		;PRINT THE MAP

SUBTTL	*SUBRTN* "MAPCNK" MEMORY CHUNK MAPPER

S
;*STARTS AT HIGHEST POSSIBLE ADDRESS AND MAPS (ASSUMING NON-X-MEM)
;*UNTIL THE NXM BIT GOES AWAY - THEN MAPS EXISTENT MEMORY
;*IF NXM BIT COMES BACK IT SWITCHES BACK TO NON-X-MEM MAPPING AND
;*MAPS THE HOLE IN EXISTENT MEMORY
;*AC0 HAS BEEN PREVIOUSLY SET UP BY $MPOLD/$MPNEW WITH ADDR LIMITS
S

$MPCNK:	MOVEM	2,$ACMP1#	;SAVE AC2 - AC4
	MOVEM	3,$ACMP2#
	MOVEM	4,$ACMP3#

	HRRZ	2,0		;LOAD ADDRESSER WITH HIGHEST POSS ADDR
	HLRZ	3,0		;LOAD WITH LOWEST POSS ADDR
	CONI	PI,$MSPI#	;SAVE THE PI STATUS
	CONO	PI,PIOFF	;TURN OFF INTERRUPTS
	CONI	APR,$MSAPR#	;SAVE PROCESSOR STATUS
	CAMG	2,3		;END GREATER THAN START ?
	FATAL			;NO

$MPCN1:	MOVEI	4,LCNXER	;SETUP KL10 NXM BIT
	JRST	$MPNXM		;CONO/CONI BIT(S) SET UP - GO MAP 

KLPAG:	PUT	0
	CONI	PAG,0		;GET PRESENT STATE
	TRO	0,LTRPEN	;MAKE SURE TRAP ENABLE SET
	CONO	PAG,@0		;PAGE RESET
	GET	0
	RTN
;*NON-X-MEMORY SEGMENT MAPPER
S

$MPNXM:	CONO	APR,(4)		;CLEAR NXM BIT, IF SET
	CAM	(2)		;ADDRESS THE MEMORY
	CAM	-1(2)		;INTERLEAVE MAP
	CAM	-2(2)		;IF NON-X-MEM FROM ANY 4-WAY INTERLEAVE
	CAM	-3(2)		;MARK ALL NON-X-MEM
	CONSO	APR,(4)		;NON-X-MEMORY BIT SET ?
	JRST	$M5		;NO  ..CONV VIRT & REMAP EXISTENT

$M2:	CONO	APR,(4)		;YES ...CLEAR THE BIT
	SUBI	2,20000		;STEP DOWN 8K
	CAIL	2,(3)		;MEMORY CHUNK DONE ? (< LOWEST POSS)
	JRST	$MPNXM		;NO ...MAP THE NEXT CHUNK


;*RESTORE OVERALL SYSTEM STATUS AFTER MAPPING
S

$MPRST:	CONO	APR,LAPRAL-20	;RESET KL APR STATUS
	HRRZ	3,$MSAPR
	ANDI	3,7
	CONO	APR,(3)		;REASSIGN APR CHANNEL
$MPRPI:	MOVE	3,$MSPI		;GET SAVED PI STATUS
	TRNE	3,PION		;IF INTERRUPTS WERE ON
	CONO	PI,PION		;TURN BACK ON
	MOVE	2,$ACMP1	;RESTORE AC'S
	MOVE	3,$ACMP2
	MOVE	4,$ACMP3
	RTN			;EXIT
;*EXISTANT MEMORY MAPPER
S
$MPEXM:	CAM	(2)		;ADDRESS THE MEMORY
	CAM	-1(2)		;INTERLEAVE THE MAP
	CAM	-2(2)
	CAM	-3(2)
	MOVEI	4,LNXMER	;KL10 NXM BIT
	CONSZ	APR,(4)		;EXISTANT ?
	AOJA	2,$M6		;NO

$M4:	SUBI	2,20000		;YES, STEP DOWN 8K
	CAIL	2,(3)		;BELOW START ADDRESS ?
	JRST	$MPEXM		;NO ...MAP NEXT CHUNK
	AOJA	2,$M7		;YES, THIS CHUNK DONE

S
;*SAVE POINTERS TO TOP AND BOTTOM OF EXISTANT CHUNKS
;*TEMPORY STORAGE POINTER IN AC1
;*VIRTUAL ADDRESS IN AC0
;*"MAPADR" CONVERTS TO ACTUAL PHYSICAL ADDRESS
S

$M5:	GO	$MPCXX
	AOJA	1,$MPEXM	;GO MAP EXISTANT CHUNK

$M6:	GO	$MPCXX
	ADDI	1,1		;INCREMENT ADDR
	GO	$CWRTBI		;CACHE WRITE-BACK & INVALIDATE
	SOJA	2,$MPCN1	;GO MAP NON-X CHUNK

$M7:	GO	$MPCXX
	AOJA	1,$MPRST	;RESTORE AC'S AND RETURN )

$MPCXX:	MOVE	0,2
	GO	$MPADR		;CONVERT VIRTUAL TO PHYSICAL
	FATAL			;CAN'T DO IT
	MOVEM	(1)		;SAVE IN TEMP
	RTN
SUBTTL	*SUBRTN* "MAPSET" SETUP KL10 PAGE MAP 

S
;*FOR VIRTUAL TO PHYSICAL ADDRESS TRANSLATION
;*ARGUMENTS PASSED IN AC0:
;*			NEG - CLEAR PAGE MAP
;*			0-37 - MAP CORRESPONDING 128K SEGMENT
S

$MPSET:	SKIPE	USER
	RTN			;USER MODE
 
$MPSE1:	MOVEM	1,$ACMP4#	;SAVE AC1
	JUMPGE	0,$MPSE2	;ARG NEG ?
	SETZM	200		;YES, CLEAR PAGE MAP
	MOVE	0,[200,,201]
	BLT	0,377

$MPSE3:	GO	KLPAG		;SET TRAP ENABLE
	MOVE	1,$ACMP4	;RESTORE AC1
	RTN			;EXIT

$MPSE2:	CAIL	0,40		;ARG 0-37 ?
	FATAL			;NO, FATAL ERROR
	IMULI	0,400		;COMPUTE PHYSICAL RELOCATION
	TRO	0,540000	;SET A,W,S BITS
	SKIPN	CSHMEM		;MEM SEG'S CACHED ?
	TRO	0,020000	;YES
	HRL	0,0		;MAKE BOTH HALVES SAME
	ADDI	0,1		;RIGHT HALF ODD PAGE
	MOVSI	1,-200		;128K IN PAGE MAP
	MOVEM	200(1)		;PUT RELOCATION DATA IN PAGE MAP
	ADD	[2,,2]		;BUMP FOR NEXT ENTRY
	AOBJN	1,.-2
	JRST	$MPSE3		;CLEAR PAGING MEMORY & EXIT )
SUBTTL	*SUBRTN* "MEMSEG" ## MAPNEW = -1 ##

S
;*SETS UP TO 128K SEGMENT IN PAGE MAP
;*ARGUMENTS:	0-37 - MAP CORRESPONDING 128K SEGMENT
;*		GT 37  - MAP USING PHYSICAL ADDRESS
;*RETURNED IN AC0:
;		0 - NO MEMORY AVAILABLE
;*		HIGHEST VIRTUAL ADDRESS
;*	  	BIT 0 SET IF NON-CONSECUTIVE CORE WAS COMBINED
;*PAGE MAP SET UP SO VIRTUAL ADDRESS 400000 AND UP POINTS
;*TO MEMORY REQUESTED
;*		RETURNS +2
S

$MSEG:	MOVEM	1,$ACMP5#	;AC1 = TEMP STORAGE POINTER
	MOVEM	2,$ACMP6#	;AC2 = MAP STORAGE POINTER
	MOVEM	3,$ACMP7#	;AC3 = CHUNK START ADR
	MOVEM	4,$ACMP8#	;AC4 = CHUNK END ADR
	MOVEM 	5,$ACMP9#	;AC5 = PAGE COUNTER
	SETZB	5,$MNCON#	;SAVED AC1 - AC5
	TLNE	0,777760	;VALID ARGUMENT ?
	FATAL			;NO
	SKIPN	MAPNEW
	JRST	$MSKA		;DIRECT ADDRESSING ONLY
	MOVE	2,[POINT 18,200]
	CAIL	0,40
	JRST	$MSEGP		;ARG IS FOR PHYSICAL CORE
	JRST	$MSEGV		;VIRTUAL CORE

;*SETUP MAP FOR REQUESTED 128K SEGMENT IN VIRTUAL CORE
S

$MSEGV:	MOVE	1,MEMLOW
	GO	$MPSET		;SETUP MAP FOR REQ SEGMENT
	MOVE	[400000,,777777]
	GO	$MPCNK		;MAP THAT SEGMENT

$MSGV1:	CAIG	1,@MEMLOW
	JRST	$MSEG3		;NO CORE IN THIS 128K SEGMENT
				;EXIT
	SETZM	200		;CLEAR PAGE MAP
	MOVE	[200,,201]
	BLT	0,377
$MSGV2:	SUBI	1,1
	MOVE	3,(1)		;GET CHUNK START ADDRESS
	JUMPN	3,.+2		;IF CHUNK ADR IS ZERO
	MOVE	3,MEMLOW	;USE EVEN BREAK ABOVE JOBFF
	SUBI	1,1
	MOVE	4,(1)		;GET CHUNK END ADDRESS
	CAMG	4,3		;END GREATER THAN START ?
	FATAL			;NO ...ABORT
	SUB	4,3		;YES ..END - START = SIZE OF CHUNK
	ADDI	4,1
	TRNE	4,777		;CHUNK SHOULD BE EVEN # OF PAGES
	FATAL			;NO ...ABORT
	LSH	4,-^D9		;COMPUTE # OF PAGES
	ADD	5,4		;KEEP COUNT
	LSH	3,-^D9
	TRO	3,540000	;CREATE RELOCATION DATA
	SKIPN	CSHMEM		;MEM SEG'S CACHED ?
	TRO	3,020000	;YES
	SOJL	4,$MSGV3
	IDPB	3,2		;PUT IN PAGE MAP
	ADDI	3,1		;INCREMENT RELOCATION DATA
	JRST	.-3

$MSGV3:	CAIN	1,@MEMLOW	;ANY MORE CHUNKS IN THIS 128K ?
	JRST	$MSEG2		;NO ...EXIT)
	SETOM	$MNCON		;YES, NON-CONSECUTIVE CHUNKS
	JRST	$MSGV2		;PACK INTO VIRTUAL

;*EXIT FROM MEMSEG ROUTINE
S

$MSEG2:	IMULI	5,1000		;CONVERT # OF PAGES INTO
	ADDI	5,377777	;HIGHEST VIRTUAL ADDRESS
	SKIPE	$MNCON		;WERE CHUNKS COMBINED ?
	TLO	5,400000	;YES, SET BIT 0 AS FLAG

$MSEG3:	MOVE	0,5		;AC0 = RESULTS (SEE TITLE BLOCK)
	MOVE	1,$ACMP5	;RESTORE AC'S
	MOVE	2,$ACMP6
	MOVE	3,$ACMP7
	MOVE	4,$ACMP8
	MOVE	5,$ACMP9
	SKIPN	MAPNEW		;4096K MAPPING (BIG TROUBLE IF NOT)
	RTN			;NO ...ERROR RETURN +1)

$MSEG4:	GO	KLPAG		;SET TRAP ENABLE
	AOS	(P)		;RETURN +2
	RTN			;RETURN +1
;*PHYSICAL CORE ASSIGNMENT
S

$MSEGP:	MOVE	1,0
	TRZ	1,777		;MAKE PHYSICAL EVEN PAGE
	SETZ	4,
	MOVE	MEMSIZ(4)	;GET START ADDRESS
	JUMPL	$MSEG3		;IF END OF TABLE, NO CORE ..EXIT
	CAMGE	1,0		;PHY = OR GT START ?
	JRST	$MSEG3		;NO, NO CORE ...EXIT
	MOVE	MEMSIZ+1(4)	;GET END ADDRESS
	ADDI	4,2
	CAML	1,0		;PHY GT END ?
	JRST	.-7		;YES, TRY NEXT CHUNK

	SKIPN	MAPNEW
	JRST	$MSKAP+3	;DIRECT ADDRESSING
	SUB	0,1		;COMPUTE # OF PAGES
	ADDI	0,1
	LSH	0,-^D9
	CAILE	0,^D256		;MORE THAN 128K WORTH ?
	MOVEI	0,^D256		;YES, LIMIT AT 128K
	MOVEM	0,3		;AC3 = MAP FILL COUNTER
	MOVEM	0,5		;KEEP COUNT OF # OF PAGES
	SETZM	200		;CLEAR PAGE MAP
	MOVE	[200,,201]
	BLT	0,377
	MOVE	0,1
	LSH	0,-^D9		;CREATE RELOCATION DATA
	TRO	0,540000
	SKIPN	CSHMEM		;MEM SEG'S CACHED ?
	TRO	0,020000	;YES
	SOJL	3,$MSEG2	;EXIT
	IDPB	0,2		;PUT DATA IN PAGE MAP
	ADDI	0,1		;INCREMENT RELOCATION DATA
	JRST	.-3
SUBTTL	*SUBRTN* "MEMSEG" ## MAPNEW = 0 ##

S
;*ARGUMENTS 0-10: SETUP CORRESPONDING CHUNK FROM MEMSIZ TABLE
;*		  11-37 RETURN 0, MAXIMUM OF 8 CHUNKS IN 256K
;*	  	  GT 37 - RETURNS MEMORY AT PHYSICAL ADDRESS
;*RETURNED IN AC0:
;*		  0 - NO MEMORY AVAILABLE
;*		  START ADDRESS,,END ADDRESS
;*RETURNS +1
S

$MSKA:	CAIL	0,40
	JRST	$MSKAP		;DIRECT PHYSICAL CORE
	CAIL	^D9
	JRST	$MSEG3		;NO MEMORY 11-37 ...EXIT
	MOVE	1,0
	LSH	1,1		;DOUBLE, 2 ENTRIES PER
	MOVE	0,MEMSIZ(1)	;GET START ADDRESS
	JUMPL	0,$MSEG3	;NO MEMORY ...EXIT
	MOVE	2,MEMSIZ+1(1)	;GET END ADDRESS
	JUMPE	2,$MSEG3	;NO MEMORY ...EXIT
	JUMPN	0,.+2		;IF START ADDRESS IS 0
	MOVE	0,MEMLOW	;USE 'MEMLOW'
	CAMG	2,0		;END GREATER THAN START ?
	FATAL			;NO ...ABORT
	MOVE	5,2		;SETUP START ADR,,END ADR
	HRL	5,0
	JRST	$MSEG3		;EXIT

$MSKAP:	CAILE	0,777000	;REQUEST FOR OVER 256K ?
	JRST	$MSEG3		;YES, NO MEMORY
	JRST	$MSEGP		;DO PHYSICAL SETUP
	MOVE	5,0		;1 = PHY ADR, 0 = END ADR
	HRL	5,1		;  START ADR,,END ADR
	JRST	$MSEG3		;EXIT 

$MSUSR:	JUMPE	0,$MSKA		;USER MODE, SEGMENT 0 ONLY
	CAIL	0,40		;IF 1-37 NO MEMORY
	JRST	$MSKAP		;PHY, DO DIRECT PHYSICAL
	JRST	$MSEG3		;EXIT 
SUBTTL	*SUBRTN* "MEMZRO"

S
;*ZERO'S MEMORY FROM MEMLOW UP TO MAXIMUM
;*MAPNEW = 0	 DIRECT MEMORY ZERO
;*	 =-1	 4096K KL10 PAGED MEMORY ZERO
S

$MZRO:	MOVEM	1,$MZROB#	;SAVE AC1 & AC2
	MOVEM	2,$MZROC#
	SKIPN	MAPNEW		;4096K PAGED OR DIRECT ZERO ?
	JRST	$MZRO2		;DIRECT ZEROING 

$MZRO1:	SETO	2,		;PAGED ZEROING
	ADDI	2,1
	CAILE	2,37
	JRST	$MZROX		;DONE
	MOVE	0,2
	GO	$MSEG		;SETUP MEMORY SEGMENT
	FATAL
	JUMPE	0,$MZRO1+1	;NO MEMORY THIS SEGMENT
	TLZ	0,400000	;DON'T CARE IF COMBINED
	SETZM	400000
	MOVE	1,[400000,,400001]
	BLT	1,@0		;ZERO VIRTUAL
	JRST	$MZRO1+1

$MZRO2:	SETZ	2,		;DIRECT MEMORY ZERO
	MOVE	0,MEMLOW	;START ADDRESS
	CAML	0,MEMSIZ+1
	JRST	$MZROX
	JRST	.+3
$MZRO3:	MOVE	0,MEMSIZ(2)	;SEGMENT START ADDRESS
	JUMPL	0,$MZROX	;DONE 
	SETZM	@0
	HRLS			;CREATE BLT POINTER
	ADDI	1
	BLT	0,@MEMSIZ+1(2)	;ZERO DIRECT
	ADDI	2,2
	JRST	$MZRO3		;DO NEXT SEGMENT

$MZROX:	MOVE	2,$MZROC	;RESTORE AC'S
	MOVE	1,$MZROB
	RTN			;EXIT
SUBTTL	*SUBRTN* "MAPADR" CONV VIRT ADDR TO PHYS ADDR

S
;*VIRTUAL ADDRESS IN AC0, PHYSICAL ADDRESS RETURNED IN AC0
;*SKIP RETURN IS NORMAL, NON-SKIP RETURN IS KL10 PAGE INACCESSIBLE
S

$MPADR:	MOVEM	1,$ACMP0#	;SAVE AC1
	HRRZ	1,0		;18 BIT VIRTUAL ADR IN AC1
	CAIG	1,17		;ACCUMULATOR ADDRESS ?
	JRST	$MPAD3-1	;YES
	MOVE	0,CONSW		;GET CONSOLE SWITCHES
	SKIPN	PVPAGI		;PREVENT PAGE INHIBIT ?
	TLNN	0,INHPAG	;PAGING INHIBITED
	JRST	$MPADL
	MOVE	0,1

$MPAD7:	AOS	(P)
$MPAD3:	MOVE	1,$ACMP0	;RESTORE AC1
	RTN			;RETURN +1/+2 

$MPADL:	MAP	0,(1)		;KL10. GET RELOCATION DATA
	TLNE	0,200000	;PAGE FAILURE
	JRST	$MPAD3		;YES
	TLZ	0,777000	;CLEAR STATUS BITS
	JRST	$MPAD7
SUBTTL	*SUBRTN* PRINT MEMORY MAP
S

	SALL
$PMAP:	SETOB	0,2
	CAMN	0,MEMSIZ+2	;ONLY ONE SEGMENT ?
	MOVEI	2,1		;YES, SET INDICATOR
	SETZ	4,
	SKIPL	MONCTL		;UNDER DIAGNOSTIC MONITOR ?
	JRST	$PMAP3		;NO
	SKIPE	USER		;USER MODE ?
	JRST	$PMAP1		;YES
	HLRZ	MONCTL		;FIRST PASS ?
	CAIE	-1
	JRST	$PMAP1		;NO
$PMAP3:	SKIPN	$ONETM		;FIRST TIME ?
	SETO	4,		;YES, SET FLAG FOR PRINTING
$PMAP1:	JUMPE	4,$PMAPL-1	;NO

	PMSG	<^MEMORY MAP =^FROM     TO         SIZE/K>

	CAIE	2,1		;IF (2) = 1, ONLY ONE SEGMENT
	PMSG	<]START ADR/K>
	PCRL
	SETZB	3,5

$PMAPL:	SKIPGE	MEMSIZ(3)	;GET MAP COORDINATES
	JRST	$PMAP4
	JUMPE	4,.+6
	MOVE	MEMSIZ(3)
	PNTADR			;PRINT START ADDRESS
	MOVE	MEMSIZ+1(3)
	PNTADR			;PRINT END ADDRESS
	PNTCI	"	"
	MOVE	MEMSIZ+1(3)
	ADDI	0,1
	SUB	MEMSIZ(3)
	IDIVI	^D1024
	ADD	5,0
	JUMPE	4,$PMAP5
$PMAP7:	PNTDEC			;PRINT DECIMAL SIZE
	CAIN	2,1
	JRST	.+5
	PNTCI	"	"
	MOVE	MEMSIZ(3)
	IDIVI	^D1024
	PNTDEC			;PRINT START ADR IN K
	PCRL

$PMAP5:	ADDI	3,2
	JRST	$PMAPL		;GET NEXT IF ANY

$PMAP4:	MOVEM	5,MEMTOT	;SAVE TOTAL # OF K
	HRRZ	JOBFF		;SETUP LOWEST USABLE
	ADDI	1000		;MEMORY ADDRESS
	TRZ	777		;EVEN BREAK ABOVE JOBFF
	MOVEM	MEMLOW
	JUMPE	4,$PMAP6	;RETURN
	CAIN	2,1
	JRST	$PMAP6-1	;CRLF & RETURN

	PMSG	<TOTAL MEMORY/K = >
	MOVE	MEMTOT		;OUTPUT TOTAL MEMORY
	PNTDEC
	PCRL
	PCRL

$PMAP6:	RTN			;EXIT
	LALL
SUBTTL	*SUBRTN* DEVICE CODE CHANGE SUBROUTINE

$MODDV:	GO	$SWTCH		;LOAD SWITCHES INTO AC0
	TLNN	0,MODDVC	;DEVICE CODE CHANGE SELECTED ?
	RTN			;NO, DON'T DO IT 

$MODD0:	MOVEM	1,$MODDB#	;SAVE AC'S
	MOVEM	2,$MODDC#
	MOVEM	3,$MODDD#

;*ASK WHETHER CHANGES ARE DESIRED & IF SO; ASK FOR OLD AND NEW DEV CODE
S

	SALL
$MODD1:	PMSGF	<^CHANGE DEVICE CODES,>
	GO	$YESNO		;AFFIRMATIVE ?
	JRST	$MODDX		;NO/NO MORE CHANGES, EXIT

$MODD3:	PMSGF	<OLD DEVICE CODE - >
	JSP	3,$MODD2	;GET OLD DEVICE CODE
	JRST	.-2		;NO RESPONSE ...ASK AGAIN
	MOVEM	0,$MDVCO#	;SAVE THE OLD CODE

$MODD4:	PMSGF	<NEW DEVICE CODE - >
	JSP	3,$MODD2	;GET NEW DEVICE CODE
	JRST	.-2		;NO RESPONSE ...ASK AGAIN
	MOVEM	0,$MDVCN#	;SAVE THE NEW CODE

$MODD5:	PMSGF	<CHANGING FROM > 
	MOVE	1,$MDVCO	;GET OLD CODE
	JSP	3,$MDSRC	;GET THAT CODE OUT OF LIST
$MODD6:	PMSGF	< TO >
	MOVE	1,$MDVCN	;GET NEW CODE
	JSP	3,$MDSRC	;GET THAT CODE OUT OF LIST (
	PCRLF

$MODD7:	PMSGF	<VALID CHANGE,>
	GO	$YESNO		;AFFIRMATIVE ?
	JRST	$MODD1		;NO ...START OVER )
	GO	$MODD8		;YES ...CHANGE THE LIST
	JRST	$MODD1
	LALL

;*CHANGE THE DEVICE CODE LIST
S

$MODD8:	MOVE	2,$MODVL
	SUB	2,$MODVU
	HRLZ	2,2
	HRR	2,$MODVL
	MOVE	1,$MDVCN
	LDB	0,[POINT 10,(2),9] 	;GET IOT & DEVICE CODE
	CAMN	0,$MDVCO	;IS IT REQUESTED ONE ?
	DPB	1,[POINT 10,(2),9] 	;YES, MAKE THE CHANGE
	AOBJN	2,.-3
	RTN

;*INPUT OLD CODE AND CHECK FOR VALIDITY
S

$MODD2:	GO	$TPOCT		;INPUT THE OLD CODE
	JRST	@3		;NO RESPONSE, RETURN + 1 )

$MODD9:	TRNE	0,3		;MUST END IN 0 OR 4
	JRST	$MODER		;ERROR! ASK AGAIN
	CAIG	0,774		;IS DEVICE CODE IN PROPER RANGE
	CAIGE	0,14
	JRST	$MODER		;ERROR, 14 TO 774 ONLY 
	CAIN	0,120		;CTY MAY NOT CHANGE!
	JRST	$MODER		;ASK AGAIN
	TRO	0,7000		;INSERT IOT CODE
	LSH	0,-2		;POSITION
	AOS	3		;RETURN + 2
	JRST	@3		;RETURN 
;*GET THE OLD/NEW CODE FROM DEVICE CODE LIST
S

	SALL
$MDSRC:	LSH	1,2		;POSITION FOR COMPARE
	TRZ	1,7000		;MASK IOT
	MOVE	2,[-$MDEND,,$MDLST]
	LDB	[POINT 9,(2),35] ;EXTRACT CODE FROM LIST
	CAMN	0,1		;IS THIS THE ONE?
	JRST	$MDSR2		;YES! ...PRINT IT & EXIT
	AOBJN	2,.-3		;NOT YET ...GET NEXT
	MOVE	0,1
	PNT3F

$MDSR1:	JRST	@3		;RETURN 
$MDSR2:	MOVE	0,(2)
	TRZ	0,777		;MASK CODE
	PNTSXF			;PRINT IT
	JRST	$MDSR1		;EXIT

$MODER:	PMSGF	<^DEV CODE ERR, 14-774 ONLY^>
	JRST	$MODD3		;ASK WHICH ONE TO CHANGE AGAIN

$MODDX:	GO	$CFLUSH		;IF KL10 & CACHE ON, FLUSH
	MOVE	3,$MODDD	;RESTORE AC'S
	MOVE	2,$MODDC
	MOVE	1,$MODDB
	RTN			;EXIT
	LALL
S
;*DEVICE CODE CHANGE SUBROUTINE BY PROGRAM
;* AC0 = [OLD,,NEW]
S

$MODDP:	LSH	AC0,-2		;RIGHT JUSTIFY
	OR	AC0,[1600,,1600] ;INSERT IOT CODE
	HLRZM	$MDVCO		;SETUP OLD CODE
	HRRZM	$MDVCN		;SETUP NEW CODE
	MOVEM	1,$MODDB
	MOVEM	2,$MODDC
	MOVEM	3,$MODDD

	GO	$MODD8		;CHANGE CODES
	JRST	$MODDX		;EXIT
SUBTTL	*SUBRTN* CONSOLE DATA SWITCH INPUT SUBROUTINE

S
;*INPUT CONSOLE SWITCHES IN EXEC MODE
S

$SWTCH:	SKIPE	$$TOGGLE	;SWITCHES PREVENTED ?
	JRST	$SWU2		;YES, USE C(CONSW)
	SKIPN	$SWFLG		;BEEN INITED ?
	JRST	$SWU1		;NO, USE SAVED SWITCHES
	SKIPE	$USWTF		;TTY SWITCH CONTROL ?
	JRST	$SWU1		;YES, USE SAVED SWITCHES
	GO	$KLSWR		;KL10
$SWCH1:	SKIPGE	MONCTL		;MONITR CONTROL ?
	HRR	0,MONCTL	;YES, USE PRESTORED RH SWITCHES
	MOVEM	0,CONSW		;SAVE
	RTN			;EXIT
$SWU1:	MOVE	0,CONSW
	JRST	$SWCH1
$SWU2:	MOVE	0,CONSW
	RTN
;*SWITCH INITIALIZATION ROUTINE
S

	SALL
$SWTIN:	SETZM	$USWTF#		;CLEAR TTY CONTROL FLAG
	SETZM	$SWONCE#
	GO	$SW0		;INIT SWITCH ROUTINE
$SWIN1:	SETOM	$SWONCE
	SETOM	$SWFLG		;SET INITED FLAG
	GO	$KLSWI		;DEMAND SWITCHES IF KL10
	GO	$SWTCH		;READ CONSOLE SWITCHES
	TLNE	PNTLPT		;PRINT ON LPT/LOGICAL DEVICE ?
	GO	$PNTNM+2	;YES ...PRINT PROGRAM NAME
	MOVE	CONSW
	TLNE	CHAIN		;IN CHAIN MODE ?
	RTN			;YES, DON'T PRINT FOLLOWING
	SKIPGE	MONCTL
	RTN			;DIAGNOSTIC MONITOR
	SKIPE	$$TOGGLE
	JRST	.+5
	PMSGF	<^SWITCHES = >
	MOVE	CONSW		;GET THE SAVED SWITCHES
	PNTHWF			;PRINT PRESENT SWITCH SETTINGS
	PCRLF
	LALL
;*PRINT CLOCK SOURCE, CLOCK RATE & CACHE ENABLES
S

	SALL
	PMSG	<CLK SOURCE = >
	MOVE	1,CLKDFL
	LSH	1,-2
	ANDI	1,3
	MOVE	0,[SIXBIT\NORMAL\
		SIXBIT\FAST\
		SIXBIT\EXTERN\
		SIXBIT\UNUSED\](1)
	PNTSIX
	PMSG	<, CLK RATE = >
	MOVE	1,CLKDFL
	ANDI	1,3
	MOVE	0,[SIXBIT\FULL\
		SIXBIT\1/2\
		SIXBIT\1/4\
		SIXBIT\1/8\](1)
	PNTSIX

	PMSG	<, AC BLK >
	DATAI	PAG,0			;READ CURRENT AC BLOCK SELECTION
	LSH	0,-^D27			;ISOLATE
	ANDI	0,7
	PNT1				;PRINT AC BLOCK DIGIT
	SKIPE	CSHFLG
	JRST	$SWIN3		;CACHE PREVENTED
	MOVE	CONSW
	TLNE	INHCSH
	JRST	$SWIN3		;CACHE INHIBITED
	HLRZ	1,CLKDFL	;GET CACHE ENABLES
	LSH	1,-^D14		;ISOLATE BITS 0-3
	ANDI	1,17
	SKIPN	1
	JRST	$SWIN3		;NOT ENABLED
	PMSG	<, CACHE:>
	TRNE	1,10		;CACHE 0 ENABLED ?
	PMSG	< 0>
	TRNE	1,4		;CACHE 1 ENABLED ?
	PMSG	< 1>
	TRNE	1,2		;CACHE 2 ENABLED ?
	PMSG	< 2>
	TRNE	1,1		;CACHE 3 ENABLED ?
	PMSG	< 3>
$SWIN3:	PCRL
	RTN

$KLSWI:	MOVEI	0,1400		;KL10, GET SWITCHES FROM PDP-11
	GO	$DTEXX
	MOVEM	0,$DTSWR	;PUT IN DTE20 SWITCH WORD
	MOVEI	AC0,405
	GO	$DTEXX		;GET CLOCK DEFAULT WORD
	MOVEM	AC0,CLKDFL#
	SETZM	KLNSW#
	RTN

$KLSWR:	SKIPE	KLNSW		;NEED TO DEMAND SWITCHES ?
	GO	$KLSWI		;YES
	MOVE	AC0,$DTSWR
	RTN
	LALL
;*SWITCH INITIALIZATION ROUTINE
S

	SALL
$SW0:	PUT	0
	SKIPE	$$TOGGLE	;SWITCHES PREVENTED ?
	JRST	$SW9+2		;YES, USE C(CONSW)
	JRST	$SW8		;EXEC

$SW12:	PMSGF	<^SWITCHES = >
	MOVE	CONSW
	PNTHWF

$SW1:	PMSGF	<^TTY SWITCH CONTROL ? - 0,S,Y OR N <CR> - >
	GO	$OPTLK		;INPUT THE ANSWER
	JRST	$SW1		;NO CHARACTER RETURNED, ASK AGAIN
	CAIN	0,15
	JRST	$SWERR		;1ST CHAR CR, ERROR
	LSH	0,7		;POSITION 1ST CHAR
	MOVEM	$SW#
	GO	$OPTLK		;INPUT THE CR
	JRST	$SW1		;NO CHAR, ASK AGAIN
	OR	0,$SW
	CAIN	0,14015		;"0" (CR) ?
	JRST	$SW6		;YES-USE ALL SWITCHES = 0
	CAIN	0,24615		;"S" (CR) ?
	JRST	$SW9		;YES-USE SAVED SWITCHES
	CAIN	0,26215		;"Y" (CR) ?
	JRST	$SW2		;YES-USE TTY INPUT SWITCHES
	CAIN	0,23415		;"N" (CR) ?
	JRST	$SW7		;YES-READ CONSOLE SWITCHES & RETURN

$SWERR:	JRST	$SW1		;ASK AGAIN
$SW6:	SETZM	0
	JRST	$SW4

$SW2:	PMSGF	<^LH SWITCHES <# OR ?>- >
	GO	$TPOCT		;INPUT 6 OCTALS
	JRST	$SW13		;ERROR .....TRY AGAIN
	HRLZM	0,$SW#		;MOVE LH WORD TO SW

$SW3:	PMSGF	<RH SWITCHES <# OR ?>- >
	GO	$TPOCT		;INPUT 6 OCTALS
	JRST	$SW14		;ERROR .....TRY AGAIN
	HLL	0,$SW		;GET LH SWITCHES
$SW4:	MOVEM	0,CONSW		;SAVE SWITCHES IN CONSW
$SW5:	SETOM	$USWTF		;SET TTY INPUT SWITCH FLAG
$SW8:	GET	0
	RTN

$SW7:	SETZM	$USWTF		;N, USE REAL SWITCHES
	JRST	$SW8

$SW9:	SKIPE	$SWONCE		;S, USE SAME AS BEFORE ON "DING" REQUEST
	JRST	$SW8
	MOVE	$SVCSW		;ON INITIALIZATION USE PREVIOUS SWITCHES
	JRST	$SW4

$SW10:	MOVE	0,DIASWS	;GET DIAMON SWITCHES
	JRST	$SW4

$SW11:	MOVE	0,$SVCSW	;IF SAVED SW'S ARE ZERO
	JUMPE	0,$SW1		;DON'T PRINT THEM
	MOVEM	0,CONSW
	JRST	$SW12

$SW13:	CAIE	"?"		;QMARK ?
	JRST	$SW2		;NO, ERROR
	MOVEI	SWTAB
	GO	$SWXX		;PROMPT FOR SWITCHES
	JRST	$SW3-1

$SW14:	CAIE	"?"		;QMARK ?
	JRST	$SW3		;NO, ERROR
	MOVE	SWPTAB		;GET ADDRESS OF USERS TABLE
	JUMPE	$SW3		;IF NONE, ERROR
	GO	$SWXX		;PROMPT FOR SWITCHES
	JRST	$SW4-1
;*PROMPT FOR SWITCHES

$SWXX:	PUT	1
	PUT	2
	PUT	3
	MOVE	1,0		;PUT SWITCH PROMPT TABLE ADDRESS IN 1
	HRLI	1,-^D18		;18 SWITCHES
	MOVEI	2,400000
	SETZ	3,
	PCRLF

$SWXX1:	MOVE	(1)		;GET SIXBIT PROMPT
	JUMPE	0,$SWXX2	;IF BLANK, NO PROMPT
	PNTSXF
	PNTCIF	11		;PRINT A TAB
	GO	$SWZZ		;GET SWITCH ANSWER
	JRST	$SWXX1-1	;ERROR
	JRST	$SWXX3		;CONTROL Z
	JRST	$SWXX4		;UPARROW
	OR	3,2		;YES, OR SWITCH BIT IN
				;NO, DON'T SET SWITCH BIT
$SWXX2:	LSH	2,-1		;POSITION TO NEXT SWITCH
	AOBJN	1,$SWXX1
$SWXX3:	PCRLF
	MOVE	0,3		;RETURN SWITCHES IN 0
	GET	3
	GET	2
	GET	1
	RTN

SWTAB:	SIXBIT/ABORT/
	SIXBIT/RSTART/
	SIXBIT/TOTALS/
	SIXBIT/NOPNT/
	SIXBIT/PNTLPT/
	SIXBIT/DING/
	SIXBIT/LOOPER/
	SIXBIT/ERSTOP/
	SIXBIT/PALERS/
	SIXBIT/RELIAB/
	SIXBIT/TXTINH/
	SIXBIT/INHPAG/
	SIXBIT/MODDVC/
	SIXBIT/INHCSH/
	SIXBIT/OPRSEL/
	SIXBIT/CHAIN/
	0
	0
;*PROCESS PROMPT
;*	CONTROL Z, ENDS PROMPTING
;*	UPARROW, BACK UP ONE PROMPT
;*	Y, SET SWITCH
;*	N, DON'T SET SWITCH
;*	CR, DON'T SET SWITCH

$SWXX4:	CAIN	2,400000	;BACKED UP ALL THE WAY ?
	JRST	.+5		;YES
	LSH	2,1		;BACKUP SWITCH BIT
	SUB	1,[1,,1]	;BACKUP SWITCH TABLE POINTER
	SKIPN	(1)		;THIS POSITION BLANK ?
	JRST	.-5		;YES, BACK UP ANOTHER
	JRST	$SWXX1-1

$SWZZ:	PNTMSF	[ASCIZ/- Y,N, <CR> OR ^,^Z - /]
	GO	$OPTLK
	RTN			;NO RESPONSE
	CAIN	"Z"-100
	JRST	$SWZZ1		;^Z, DONE
	CAIN	"^"
	JRST	$SWZZ2		;^, BACKUP
	CAIN	15
	JRST	$SWZZ4		;CR, SAME AS NO

	CAIE	"Y"		;Y, SET SWITCH BIT
	CAIN	"N"		;N, DON'T SET SWITCH BIT
	JRST	.+2
	RTN			;NEITHER, ERROR
	LSH	0,7
	MOVEM	$SWYYY#
	GO	$OPTLK		;GET CR
	RTN			;NO RESPONSE
	OR	0,$SWYYY
	CAIN	0,26215
	JRST	$SWZZ3		;Y <CR>
	CAIN	0,23415
	JRST	$SWZZ4		;N <CR>
	RTN			;ERROR

$SWZZ4:	AOS	(P)		;NO
$SWZZ3:	AOS	(P)		;YES
$SWZZ2:	AOS	(P)		;UPARROW
$SWZZ1:	AOS	(P)		;CONTROL Z
	RTN

	LALL
SUBTTL	*SUBRTN* TELETYPE INPUT ROUTINES

S
;*CARRIAGE RETURN OR COMMA TERMINATES OCTAL, DECIMAL, OR CONVERT TYPE-IN.
;*CHARACTER OR NUMBER RETURNED IN AC0.
;*CALL SEQUENCE IS AS FOLLOWS:
;*	NAME
;*	NO/ERROR RESPONSE RETURN (+ 1)
;*	NORMAL RESPONSE RETURN (+ 2)
;*$OPTLK =	INPUT ANY CHARACTER
;*$YESNO =	ASK QUESTION, CORRECT RESPONSE Y
;*$NOYES =	ASK QUESTION, CORRECT RESPONSE N
;*$TPOCT =	INPUT UP TO 12 OCTALS
;*$TPDEC =	INPUT UP TO 11 DECIMALS
;*$TPCNV =	INPUT UP TO 9 CONVERT'S
;*$TTLK  =	KEYBOARD CHECK, INPUT ANY CHARACTER (NO WAIT)
;*$TALTM =	KEYBOARD, ALT-MODE CHECK
;*$TISIX =	INPUT UP TO 6 SIXBIT CHARACTERS
S


;*TELETYPE INPUT INITIALIZATION
S
$TYPIN:	MOVEI	^D180		;INIT OPERATOR WAIT TIME AS 180 SEC
	MOVEM	OPTIME
	RTN			;EXIT

S
;*CHECKS FOR ANY KEY STRUCK, RETURNS IMMEDIATELY
;*RETURNS +1 IF NO TYPEIN, RETURNS +2 IF CHAR TYPED
;*NO INPUT CHECKING ON KL10
S

$TTLK:	SETZ	AC0,
	RTN
S
;*TELETYPE IMAGE MODE INPUT
;*PROVIDES UNBUFFERED MODE INPUT
;*WAITS FOREVER, RETURN WITH CHAR UPPER CASED & ECHOED
S

$TTYIN:	MOVEI	0,3400		;DDT INPUT MODE
	GO	$DTEXX
	ANDI	0,177		;STRIP EXTRA BITS
	JUMPE	0,.-3		;IF 0, NO CHAR, WAIT

	GO	$TIEX2	;RUN THRU NORMAL PROCESS
	FATAL			;CAN'T HAPPEN
	RTN
S
;*TELETYPE INPUT OPERATOR RESPONSE ROUTINE
S

$OPTLK:	MOVEM	4,$TACB4#
	MOVE	4,OPTIME	;COMPUTE WAIT DELAY
	IMULI	4,147400	;1 SEC FUDGE FACTOR
	SOJLE	4,.+4		;WAITED LONG ENOUGH YET ?
	GO	$HEAR		;NO, GO LOOK FOR INPUT & RETURN
	JRST	.-2		;NO RESPONSE, REPEAT
	AOS	(P)		;CHAR TYPED, RETURN +2
	MOVEM	4,$TWCNT	;SAVE TTY WAIT COUNT
	MOVE	4,$TACB4
	RTN			;NO CHAR, RETURN +1
S
;*TELETYPE ALT-MODE CHECK ROUTINE
S

$TALTM:	MOVE	0,$DTCHR	;GET LAST TYPED CHAR
	ANDI	0,177
	CAIL	"A"+40
	CAILE	"Z"+40
	JRST	.+2
	SUBI	40
	SETZM	$DTCHR		;CLEAR FOR NEXT CHAR

$TALT2:	CAIE	175
	CAIN	176
	JRST	$TALT1		;ALT-MODE WAS TYPED
	CAIE	33
	JRST	.+2		;NO ALT-MODE

$TALT1:	JRST	CPOPJ1		;ALT-MODE, RETURN +2

	CAIN	004		;IS CHAR CONTROL D (^D) ?
	JRST	$DDTENT		;YES
	CAIN	024		;IS CHAR CONTROL T (^T) ?
	JRST	$TALT3		;YES
	CAIN	005		;IS CHAR CONTROL E (^E) ?
	JRST	$TALT4		;YES
	CAIE	007		;IS CHAR A BELL ?
	RTN
	SKIPE	$$TAX1
	XCT	$$TAX1		;XCT USERS PRE-ROUTINE
	GO	$SW0		;YES, DING FOR SWITCH CONTROL
	SKIPE	$$TAX2
	XCT	$$TAX2		;XCT USERS POST-ROUTINE
	RTN

$TALT3:	PMSGF	<TEST PC = >
	HRRZ	TESTPC
	PNT6F			;PRINT TEST PC
	PCRLF
	MOVEI	0,024
	RTN

$TALT4:	PMSGF	<ERROR PC = >
	HRRZ	ERRPC
	PNT6F			;PRINT ERROR PC
	PMSGF	< ERROR TOTALS = >
	MOVE	ERRTLS
	PNTDCF			;PRINT ERROR TOTALS
	PCRLF
	MOVEI	0,005
	RTN
S
;*TELETYPE INPUT CHARACTER ROUTINE - KL10 EXEC
S

$HEAR:	MOVEI	AC0,2400
	GO	$DTEXX		;COMMAND CODE TO DTE-20
	ANDI	AC0,377
	MOVEM	AC0,$TTCHR	;CHAR DEPOSITED INTO AC0
	SETZM	$DTCHR
	JUMPN	AC0,$HEAR4
	MOVEI	4,1		;TIMED OUT
	RTN

$TIEX2:	MOVEM	$TTCHR#
	GO	$TYOUT		;ECHO CHAR
	AOS	$CARCT
	ANDI	177
	CAIN	003		;CONTROL C ?
	JRST	$HEAR1		;YES, TERMINATE
	CAIE	15		;IS IT CR ?
	JRST	$HEAR4		;NO, PROCESS IT
	SETZM	$CARCT
	MOVEI	12
	GO	$TYOUT		;ECHO LF
	JRST	$HEAR4		;NOW PROCESS
S
;*CHARACTER PROCESSING ROUTINE FOR INPUT
;*CHARACTER RETURNED IN AC0 IS UPPER CASE
;*ACTUAL CHARACTER IS IN $TTCHR
S

$HEAR4:	MOVE	0,$TTCHR	;GET ACTUAL CHARACTER
	ANDI	0,177		;CLEAR PARITY BIT
	CAIL	0,"A"+40	;CONVERT TO UPPER CASE
	CAILE	0,"Z"+40
	JRST	.+2
	SUBI	0,40
	MOVEM	0,$CHRIN#	;SAVE CHARACTER
	CAIE	0,15		;IS IT CR ?
	JRST	$HEAR3		;NO
	SETZM	$CARCT		;CLEAR CHARACTER COUNTER
	MOVE	0,CONSW
	TLNN	0,PNTLPT	;LPT/LOGICAL DEVICE OUTPUT ?
	JRST	$HEAR2		;NO
	PCRL			;YES-ADD CRLF
$HEAR2:	MOVE	0,$CHRIN	;PUT INPUT CHAR IN AC0
	AOS	(P)		;SKIP RETURN +2 
	RTN			;NORMAL RETURN +1 

$HEAR3:	CAIN	0,04
	JRST	$DDTENT		;CONTROL D, GO TO DDT
	MOVE	0,CONSW		;GET DATA SWITCHES
	TLNN	0,PNTLPT	;PRINT ON LPT?
	JRST	$HEAR2		;NO-EXIT 
	MOVE	0,$CHRIN	;YES
	PNTCHR			;SEND CHAR TO LPT/LOGICAL DEV
	JRST	$HEAR2		;EXIT 

$HEAR1:	MOVEI	0,$HEAR+0	;CONTROL C, SAVE ENTRY TO 
	MOVEM	0,JOBOPC	;TTY ROUTINE FOR RESTART
	JRST	@CNTLC		;TERMINATE
SUBTTL	*SUBRTN* TELETYPE  YES/NO TYPE-IN ROUTINE

S
;*ACCEPTS Y OR N
;*FOR YESNO, Y IS SKIP RETURN, N OR NO RESPONSE IS DIRECT RETURN
;*FOR NOYES, N IS SKIP RETURN, Y OR NO RESPONSE IS DIRECT RETURN
;*'Y OR N <CR> - ' ASKED UPON ENTRY
S

$NOYES:	MOVEI	0,1		;INIT FOR N ANSWER
	JRST	.+2
$YESNO:	MOVEI	0,0		;INIT FOR Y ANSWER
	MOVEM	1,$TACC1#	;SAVE AC'S
	MOVEM	2,$TACC2#
	MOVE	2,0

$YN1:	PMSGF	< Y OR N <CR> - >
	GO	$OPTLK
	JRST	$YN2		;NO RESPONSE
	CAIE	0,"Y"		;IS IT A 'Y' ?
	CAIN	0,"N"		;OR AN 'N' ?
	JRST	.+2		;YES
	JRST	$YN3		;NEITHER, ERROR
	MOVE	1,0
	LSH	1,7		;POSITION 1ST CHAR
	GO	$OPTLK
	JRST	$YN2		;NO RESPONSE
	OR	1,0		;MERGE 2ND CHAR
	CAMN	1,$YN4(2)	;COMPARE FOR REQUESTED
	JRST	.+4		;YES, RETURN +2
	CAMN	1,$YN4+1(2)	;COMPARE FOR OPPOSITE
	JRST	.+3		;YES, RETURN +1
	JRST	$YN3		;ERROR, REPEAT
	AOS	(P)		;YES, RETURN +2
$YN2:	MOVE	2,$TACC2	;RESTORE AC2
	MOVE	0,1
	MOVE	1,$TACC1	;RESTORE AC1
	RTN			;RETURN +1

$YN3:	PCRLF
	JRST	$YN1

$YN4:	EXP	26215		;'Y' (CR)
	EXP	23415		;'N' (CR)
	EXP	26215		;'Y' (CR)
SUBTTL	*SUBRTN* TELETYPE OCTAL-DECIMAL-CONVERT TYPE-IN ROUTINE

S
;*ACCEPTS 0 TO 12 OCTALS, 0 TO 11 DECIMALS, 0 TO 9 CONVERT CHARACTERS
;*NUMBER RETURNED IN AC0.
S

$TPCNV:	MOVEI	AC0,2		;SET INDEX TO CONVERT
	JRST	$TPCV1
$TPDEC:	MOVEI	AC0,1		;SET INDEX TO DECIMAL
	JRST	$TPCV1
$TPOCT:	MOVEI	AC0,0		;SET INDEX TO OCTAL

$TPCV1:	MOVEM	1,$TACD1#	;SAVE AC'S 1-3
	MOVEM	2,$TACD2#
	MOVEM	3,$TACD3#
	MOVE	3,0		;LOAD AC3 WITH THE INDEX
	SETZB	1,2		;CLEAR DATA REG, CHAR COUNTER
	SETZM	$TYPNB#		;CLEAR ERR NUMBER
	SETZM	$NEGF#		;CLEAR NEGATE FLAG
	SETZM	$CNVD#		;CLEAR DECIMAL CONVERT FLAG
	SETZM	TTNBRF		;CLEAR DIGIT TYPED FLAG


;*INPUT AND COMPUTE NUMBER
S

$TYPLP:	GO	$OPTLK
	JRST	$TPERR		;NO RESPONSE, GO TO ERROR EXIT
	CAIN	0,"-"		;IS IT MINUS ?
	JRST	$NEGX		;YES
	CAIN	0,"."		;IS IT PERIOD ?
	JRST	$CNVX		;YES
	CAIN	0,15		;IS IT CR ?
	JRST	$TPEXT		;YES
	CAIN	0,","		;IS IT COMMA ?
	JRST	$TPEXT		;YES
	CAIL	0,"0"		;A VALID DIGIT ?
	XCT	$TPCK(3)	;YES
	JRST	$TPERR		;NO ...ERROR EXIT

$TYPL1:	SETOM	TTNBRF		;SET DIGIT TYPED FLAG
	AOS	2		;INCREMENT CHARACTER COUNTER
	XCT	$TPMUL(3)	;MULT BY OCTAL/DECIMAL BASE, SHIFT CONVERT
	SUBI	60		;ADD IN NEW CHAR
	ADD	1,0
	JRST	$TYPLP		;REPEAT TILL CR OR COMMA
;*CHECK FOR PROPER AMOUNT OF CHARACTERS
S

$TPEXT:	XCT	$TPNBR(3)	;PROPER NUMBER OF CHARACTERS
	JRST	$TPERR		;NO ...ERROR EXIT 
	CAIN	3,2		;CONVERT ? (INDEX = 2)
	JRST	$CNVX1		;YES
				;NO, EXIT

$TPEX1:	MOVE	3,$TACD3	;RESTORE AC'S 3 & 2
	MOVE	2,$TACD2
	MOVE	0,1		;PUT NUMBER IN AC0
	SKIPE	$NEGF		;NEGATE ?
	MOVN	0,1		;YES
	MOVE	1,$TACD1	;RESTORE AC1
	AOS	(P)		;RETURN +2 
	RTN			;RETURN +1 

$TPERR:	MOVEM	1,$TYPNB	;SAVE NUMBER - ERROR EXIT
	MOVE	3,$TACD3	;RESTORE AC'S
	MOVE	2,$TACD2
	MOVE	1,$TACD1
	RTN			;ERROR EXIT )


;*NUMBER COMPUTING CONSTANTS
S

$TPCK:	CAILE	0,"7"		;OCTAL NUMBER CHECK
	CAILE	0,"9"		;DECIMAL NUMBER CHECK
	CAILE	0,"9"		;CONVERT NUMBER CHECK
$TPMUL:	LSH	1,3		;OCTAL BASE SHIFT
	IMULI	1,^D10		;DECIMAL BASE MULTIPLIER
	LSH	1,4		;CONVERT SHIFT
$TPNBR:	CAILE	2,^D12		;ACCEPT UP TO 12 OCTALS
	CAILE	2,^D11		;ACCEPT UP TO 11 DECIMALS
	CAILE	2,^D9		;ACCEPT UP TO 9 CONVERT
$NEGX:	SKIPE	2		;1ST CHAR ?
	JRST	$TPERR		;NO, ERROR EXIT )
	SETOM	$NEGF		;YES, SET NEGATE FLAG
	JRST	$TYPLP		;GET NEXT CHAR

$CNVX:	CAIE	3,2		;PERIOD, IN CONVERT ?
	JRST	$TPERR		;NO, ERROR EXIT )
	SETOM	$CNVD		;YES, SET DECIMAL FLAG
	JRST	$TYPLP		;GET NEXT CHAR


;*CONVERT CONVERSION ROUTINE
S

$CNVX1:	MOVEI	2,^D9		;NINE DIGITS
	SETZM	0
	SKIPE	$CNVD		;OCTAL OR DECIMAL ?
	JRST	$CNVX2		;DECIMAL
	TDNE	1,[421042104210]	;OCTAL
	JRST	$TPERR		;OCTAL ERROR, 8 OR 9 INPUT
	LSH	1,1		;SQUEEZE OUT 4TH BIT
	LSHC	0,3		;COMPACT INTO OCTAL
	SOJN	2,.-2		;COMPLETED ?
	MOVE	1,0		;YES
	JRST	$TPEX1		;RETURN 

$CNVX2:	SETZM	3		;DECIMAL
	SETZM	0
	IMULI	3,^D10		;MULTIPLY BY DECIMAL BASE
	LSHC	0,4		;UNPACK NEXT DIGIT
	ADD	3,0		;ADD IN
	SOJN	2,.-4		;COMPLETED ?
	MOVE	1,3		;YES
	JRST	$TPEX1		;RETURN )

SUBTTL	*SUBRTN*  TELETYPE SIXBIT INPUT ROUTINE

S
;*INPUTS UP TO SIX CHARACTERS, TERMINATES WITH A CR OR COMMA.
;*SIXBIT WORD RETURNED IN AC0
S

$TISIX:	MOVEM	1,$TSX1#	;SAVE AC'S
	MOVEM	2,$TSX2#
	MOVE	2,[POINT 6,1]
	MOVEI	1,0

$TSXB1:	GO	$OPTLK
	JRST	$TSXB3		;NO RESPONSE, RTN + 1
	CAIN	0,15
	JRST	$TSXB2		;CR, TERMINATE, RTN + 2 
	CAIN	0,","
	JRST	$TSXB2		;COMMA, TERMINATE, RTN + 2
	CAIL	0,"0"
	CAILE	0,"Z"
	JRST	$TSXB3		;ERROR, RTN + 1 
	CAILE	0,"9"
	CAIL	0,"A"
	JRST	$TSXB4		;ALPHA-NUMERIC
	JRST	$TSXB3		;ERROR, RTN + 1 

$TSXB4:	TRC	0,40		;CONVERT TO SIX-BIT
	TRNE	1,77
	JRST	$TSXB3		;TOO MANY CHAR'S, RTN + 1
	IDPB	0,2		;PUT INTO WORD
	JRST	$TSXB1		;GET NEXT CHARACTER

$TSXB2:	AOS	(P)		;INCR USRPC FOR RTN + 2 (NORMAL)

$TSXB3:	MOVE	0,1		;SIXBIT WORD IN AC0
	MOVE	1,$TSX1		;RESTORE AC'S
	MOVE	2,$TSX2
	RTN			;EXIT + 1/+2
SUBTTL	*SUBRTN* PRINT SUBROUTINES

S
;*	$PNTSX		PRINT SIXBIT NORMAL
;*	$PTSXF		PRINT SIXBIT FORCED
;*	$PNTCW		PRINT DF10 CONTROL WORD
;*	$PNTI1		PRINT OCTAL NUMBER
;*	$CHRPN		PRINT CHARACTER
;*	$ASCPN		PRINT ASCII CHARACTER/LINE
;*	$DECPN		PRINT DECIMAL NUMBER
S

S
;*PRINT SUBROUTINE INITIALIZATION
;*INITIALIZES CONTROL WORDS
S

$PNTIN:	SETZM	$INTDF#		;CLEAR DEVICE DEFAULT FLAG
	SETZM	$DVOFF#		;CLEAR DEVICE INITED FLAG
	SETZM	PDISF#		;CLEAR PRINT DISABLED FLAG
	SETZM	$PTINH#		;CLEAR PRINT 'TYPE-IN INHIBIT' FLAG
	SETZM	PNTINH#		;ALLOW EXEC PRINT TYPE IN INHIBIT
	SETZM	XOFFLAG#	;CLEAR XOFF FLAG
	SETZM	PNTFLG#		;CLEAR IN PRINT FLAG
	SETOM	PNTSPC#		;SET PRINT SPACE FLAG
	MOVNI	0,^D5000	;SET PRINT ENABLE TO 5000 LINES
	MOVEM	0,PNTENB
	SETZM	TTYFIL		;ALLOW EXEC FILLERS
	SETZM	$CRLF#		;ALLOW FREE CR/LF
	SETZM	$TABF		;ALLOW TAB CONVERSION
	SETZM	$FFF		;ALLOW FORM FEED CONVERSION
	SETZM	$VTF		;ALLOW VERTICAL TAB CONVERSION

$PNTIX:	MOVEI	REENTR		;SETUP REENTER ADDRESS
	MOVEM	JOBREN
	SKIPGE	MONCTL		;MONITOR CONTROL ?
	RTN			;YES, DON'T PRINT TITLE
	SKIPE	$ONETM		;FIRST TIME?
	RTN			;NO .....EXIT
	JRST	$PNTNM+2	;YES ...PRINT PROGRAM NAME
				;AND EXIT
S
;*PRINT SUBROUTINE ENTRY POINT
;*EXIT VIA $PNTI4 BELOW
S

$PNTIF:	SETOM	PNTFLG		;SET IN PRINT FLAG
	SETOM	$PNTTY#		;FORCE TO TTY
	SETZM	$PTINH
	JRST	$PTKL

$PNTIT:	SETOM	PNTFLG		;SET IN PRINT FLAG
	SETZM	$PNTTY		;NOT FORCED TO TTY
	SKIPL	PNTENB#		;PRINT LIMIT REACHED YET?
	JRST	$PNTIB		;YES ..DON'T PRINT
	GO	$SWTCH		;READ DATA SWITCHES INTO AC0
	TLNN	0,NOPNT		;NO PRINT SWITCH SET?
	JRST	$PTKL
	GET	AC0		;YES ...RESTORE AC0 FROM STACK (P - 1)
	JRST	$PRNTX		;EXIT, DON'T PRINT

$PTKL:	MOVEI	AC0,3000	;NORMAL PRINTOUT
	SKIPE	$PNTTY
	AOS	AC0		;FORCED PRINTOUT
	GO	$DTEXX
	JRST	$PNTIA
;*PRINT ROUTINE EXIT
S

$PNTI4:	SETZM	$PNTTY		;CLEAR FORCE TO TTY FLAG

	MOVE	1,$PACA1	;RESTORE AC'S
	MOVE	2,$PACA2
	MOVE	3,$PACA3
	MOVE	4,$PACA4
	MOVE	5,$PACA5
$PRNTX:	SETZM	PNTFLG		;CLEAR IN PRINT FLAG
	RTN			;RETURN 

;*PRINT LIMIT WARNING & ALTERNATE EXIT PATH
S

$PNTIB:	GET	AC0		;RESTORE THE STACK (P - 1)
	SKIPE	PDISF#		;FIRST TIME PRINT DISABLED?
	JRST	$PRNTX		;YES	...EXIT )

$PNTB1:	SETOM	PDISF		;NO ........SET IT
	MOVEM	1,$PACA1	;SAVE AC'S 1 - 5
	MOVEM	2,$PACA2
	MOVEM	3,$PACA3
	MOVEM	4,$PACA4
	MOVEM	5,$PACA5
	SETOM	$PNTTY		;SET FORCE TO TTY FLAG
	MOVEI	[ASCIZ/
******
EXCEEDED ALLOWED PRINTOUTS
/]
	JRST	$ASCPN-1	;PRINT THE WARNING & EXIT
S
;*PRINT ROUTINE SELECTOR
;*BASED ON "AC FIELD" = 12 - 17
S

$PNTIA:	MOVEM	1,$PACA1#	;SAVE AC1.
	MOVEM	2,$PACA2#	;SAVE AC2.
	MOVEM	3,$PACA3#	;SAVE AC3.
	MOVEM	4,$PACA4#	;SAVE AC4.
	MOVEM	5,$PACA5#	;SAVE AC5.
	GET	AC0		;RESTORE AC0 FROM STACK (P - 1)
	SETZM	$PNT#		;CLEAR PRINT HALF WORDS FLAG
	MOVE	2,LUUO
	ROT	2,15		;GET X (AC FIELD)
	ANDI	2,17		;OUT OF THE UUO

$PNTIC:	CAIN	2,17		;X=17?
	JRST	$PNTLN		;YES. PRINT ASCII LINE
	JUMPE	2,$ASCPN	;X=0? YES. GO PRINT 1 WORD ASCII
	CAIN	2,15		;X=15?
	JRST	$DECPN		;YES, PRINT DECIMALS )
	CAIN	2,16		;X=16?
	JRST	$DECSP		;YES, PRINT DECIMALS, LEADING SPACES 
	CAIN	2,13		;X=13?
	JRST	$PNTI3		;YES, PRINT OCTALS, 6 SP 6
	CAIN	2,12		;X=12?
	JRST	$CHRPN		;YES, PRINT CHARACTER )

	JRST	$PNTI1		;NONE OF THE ABOVE, PRINT OCTAL
				;(AC FIELD <12 OR = TO 14)
S
;*SIXBIT PRINT SUBROUTINE
;*PRINTS SIXBIT WORD IN AC0
S

;*NORMAL PRINTOUT
S

$PNTSX:	PUT	1		;SAVE AC1 ON STACK (P + 1)
	MOVE	1,0		;PUT SIXBIT WORD IN AC1
	MOVEI	0,0
	LSHC	0,6		;GET NEXT CHAR INTO AC0
	ADDI	0,40		;CONVERT TO ASCII
	PNTCHR			;PRINT IT
	JUMPN	1,.-4		;LOOP TILL ALL PRINTED
	GET	1		;RESTORE AC1 FROM THE STACK (P - 1)
	RTN			;EXIT

;*FORCED PRINTOUT
S

$PTSXF:	PUT	1		;SAVE AC1 ON THE STACK (P + 1)
	MOVE	1,0		;PUT SIXBIT WORD IN AC1
	MOVEI	0,0
	LSHC	0,6		;GET NEXT CHAR INTO AC0
	ADDI	0,40		;CONVERT TO ASCII
	PNTCHF			;PRINT
	JUMPN	1,.-4		;LOOP TILL ALL PRINTED
	GET	1		;FROM THE STACK (P - 1)
	RTN			;EXIT 
S
;*SIXBIT MESSAGE PRINT ROUTINE
;*PRINTS THE SIXBIT MESSAGE THOSE ADDRESS IS IN AC0
;*"BACKARROW" (77) SIGNIFIES END OF TEXT
;*"UPARROW" (76) SIGNIFIES CR/LF
;*"RIGHT SQUARE BRACKET" (75) SIGNIFIES TAB
S

$PSIXF:	PUT	5
	SETO	5,		;SET FORCED PRINTING FLAG
	JRST	.+3

$PSIX:	PUT	5
	SETZ	5,		;NORMAL PRINTING
	PUT	1
	PUT	2
	PUT	3
	PUT	4

	HRRZ	4,0		;MESSAGE ADDRESS TO AC4

$PSIX1:	MOVEI	3,6		;6 = NUM OF 6BIT CHAR PER WORD
	MOVE	1,(4)		;GET FIRST/NEXT WORD OF MESSAGE

$PSIX2:	SETZ	2,
	ROTC	1,6		;C(AC1) = CHAR TO BE PRINTED
	CAIN	2,77
	JRST	$PSIX5		;"BACKARROW", DONE
	CAIN	2,76
	JRST	$PSIX4		;"UPARROW", CR/LF
	CAIN	2,75
	MOVEI	2,151		;"BRACKET", CHANGE TO TAB (151+40=11)
	MOVEI	0,40(2)		;CHANGE TO ASCII
	JUMPN	5,[PNTCHF
		JRST	.+2]	;FORCED PRINT
	PNTCHR
$PSIX3:	SOJN	3,$PSIX2	;PRINTED ALL CHARS FROM THIS WORD ?
	AOJA	4,$PSIX1	;YES, DO NEXT WORD

$PSIX4:	JUMPN	5,[PCRLF
		JRST	.+2]
	PCRL			;PRINT CR/LF
	JRST	$PSIX3

$PSIX5:	GET	4
	GET	3
	GET	2
	GET	1
	GET	5
	RTN
S
;*OCTAL SUPPRESS LEADING ZEROS PRINT ROUTINE
;*PRINTS NUMBER IN AC0, SUPPRESSING LEADING ZEROS
;*PRINTS MINUS SIGN IF NUMBER IS NEGATIVE
S

$POCSF:	PUT	5
	SETO	5,		;FORCED PRINTOUT
	JRST	.+3

$POCS:	PUT	5
	SETZ	5,		;NORMAL PRINTOUT
	PUT	1
	PUT	2
	PUT	3
	PUT	4

	MOVE	2,0
	JUMPGE	2,$POCS1	;IS NUMBER NEGATIVE ?
	MOVEI	"-"
	JUMPN	5,[PNTCHF
		JRST	.+2]
	PNTCHR			;YES, PRINT MINUS SIGN
	MOVN	2,2		;MAKE NUMBER POSITIVE

$POCS1:	SETZ	4,
	SETZB	3,1
	JUMPE	2,$POCS3	;IF NUMBER 0, PRINT 1 ZERO

	MOVEI	3,^D12		;PRINT UP TO 12 DIGITS
$POCS2:	SETZ	1,
	LSHC	1,3
	JUMPE	1,$POCS5	;IS THIS DIGIT ZERO ?
	SETO	4,		;NO, SET NON-ZERO DIGIT FLAG
$POCS3:	MOVEI	"0"(1)		;MAKE ASCII NUMBER
	JUMPN	5,[PNTCHF
		JRST	.+2]
	PNTCHR			;PRINT DIGIT

$POCS4:	SOJG	3,$POCS2	;ALL DONE ?
	GET	4
	GET	3
	GET	2
	GET	1
	GET	5
	RTN

$POCS5:	JUMPE	4,$POCS4	;PRINTED NON-ZERO DIGIT ?
	JRST	$POCS3		;YES, PRINT ZEROS
S
;*DF10 CONTROL WORD PRINT ROUTINE
;*PRINTS WORD IN AC0
;*DF22F = 0, ######  ######  ,18 BIT DF10
;*       -1, ##### ########  ,22 BIT DF10
S

$PNTCW:	MOVEM	1,$PTCA#	;SAVE AC1
	MOVEI	1,0		;NORMAL PRINTOUT
	MOVEM	2,$PTCB#	;SAVE AC2
	MOVE	2,0
	SKIPN	DF22F#		;22 OR 18 BIT DF10 ?
	JRST	$PNTC2
	LSH	0,-^D21		;NEW 22 BIT DF10
	TRZ	0,1
	JUMPN	1,[PNT5F
		JRST .+2]
	PNT5			;PRINT WORD COUNT, 14 BITS
	MOVE	0,2
	TLZ	0,777760
	JUMPN	1,[PNTADF
		JRST .+2]
	PNTADR			;PRINT ADDRESS, 22 BITS
$PNTC3:	MOVE	2,$PTCB
	MOVE	1,$PTCA
	RTN			;EXIT

$PNTC2:	HLRZ			;18 BIT DF10
	JUMPN	1,[PNT6F
		JRST .+2]
	PNT6			;PRINT WORD COUNT, 18 BITS
	MOVEI	40
	JUMPN	1,[PNTCHF
		JRST .+2]
	PNTCHR			;EXTRA SPACE
	HRRZ	0,2
	JUMPN	1,[PNT6F
		JRST .+2]
	PNT6			;PRINT ADDRESS, 18 BITS
	JRST	$PNTC3

$PNTCF:	MOVEM	1,$PTCA		;SAVE AC1
				;FORCED PRINTOUT
	MOVE	1,$PNTCF
	MOVEM	1,$PNTCW	;SETUP RETURN
	MOVEI	1,1		;FORCED PRINT INDEX
	JRST	$PNTCW+2	;REST AS ABOVE
S
;*OCTAL PRINTOUT ROUTINE
;*PRINTS NUMBER IN AC0
S

$PNTI1:	MOVE	3,2		;MOVE X INTO AC3.
	ROT	0,-3		;ROT OCTAL NUM 3 PLACES
	SOJN	3,.-1		;X AMOUNT OF TIMES.

$PNTI2:	MOVEI	1,6		;PUT 6 INTO AC1 SO THAT
	ROTC	0,3		;C(AC1) AFTER THE ROTC WILL BE 60
	JSP	3,$TOUT		;PLUS NUMBER TO BE PRINTED
	SOJN	2,$PNTI2	;SUB 1 FROM X...PRINT UNTIL X=0.
	MOVEM	1,$PNTSV#	;SAVE NUMBER
	SKIPN	PNTSPC
	JRST	.+3
	MOVEI	1,40		;AT THIS POINT WE HAVE PRINTED
	JSP	3,$TOUT		;X AMOUNT OF NUMBER(S) AND NOW A SPACE
	SKIPN	$PNT#		;PRINT 6 SP 6 FLAG SET?
	JRST	$PNTI4		;NO, EXIT )
	MOVE	1,$PNTSV	;RESTORE NUMBER
	MOVEI	2,6		;SETUP FOR 2ND HALF
	SETZM	$PNT		;CLEAR PRINT SPACE FLAG
	JRST	$PNTI2		;PRINT REST OF NUMBER

$PNTI3:	MOVEI	3,14		;SETUP FOR LH WORD
	MOVEI	2,6		;SETUP FOR FIRST HALF
	SETOM	$PNT		;SET PRINT 6 SP 6 FLAG
	SETOM	PNTSPC		;SET THE PRINT SPACE FLAG
	JRST	$PNTI1+1	;PRINT FIRST HALF NUMBER
	JRST	$PNTI4		;EXIT

S
;*ASCII/CHARACTER PRINTOUT ROUTINE
;*PRINTS CHAR IN LOWER 7 BITS OF AC0
S

$CHRPN:	ANDI	0,177		;STRIP CHAR TO 7 BITS
	MOVE	1,0
	JSP	3,$TOUT		;PRINT A CHARACTER
	JRST	$PNTI4		;LEAVE 

S
;*PRINTS ASCII WHOSE ADDRESS IS IN AC0
S

$PNTLN:	SETOM	$PNT#		;SET PRINT MORE THAN 1 WORD FLAG.

$ASCPN:	MOVEM	0,$POINT#	;SAVE ADDRESS OF ASCII MESSAGE.
$ASCP1:	MOVEI	2,5		;5 = NUM OF ASCII CHAR. IN A WORD.
	MOVE	0,@$POINT	;C(AC0) = FIRST/NEXT WORD OF ASCII MESS

$ASCP2:	SETZ	1,		;CLEAR AC1.
	ROTC	0,7		;C(AC1) = CHAR TO BE PRINTED.
	JUMPE	1,$PNTI4	;CHAR = NULL?..NO MORE CHAR..EXIT
	JSP	3,$TOUT		;PRINT A CHAR
	SOJN	2,$ASCP2	;PNT ALL CHAR FROM THIS WORD?
	AOS	$POINT		;YES. INC TO GET NEXT WORD.
	SKIPN	$PNT		;PNT MORE THAN ONE WORD FLAG SET?
	JRST	$PNTI4		;NO..LEAVE
	JRST	$ASCP1		;YES...RETURN TO PNT NEXT WORD.
S
;*DECIMAL PRINTOUT ROUTINE
;*PRINTS NUMBER IN AC0
S

$DECSP:	SETOM	$PNT		;SET LEADING SPACES PRINT CONTROL

$DECPN:	JUMPGE	0,.+4		;IS NUMBER NEGATIVE ?
	MOVEI	1,"-"		;YES, PRINT MINUS SIGN
	JSP	3,$TOUT
	MOVN	0,0		;MAKE NUMBER POSITIVE
	GO	$RADIX		;DECIMAL-ASCII CONVERSION & PRINT CHARS
	JRST	$PNTI4		;EXIT

$RADIX:	MOVE	2,RADLSC	;SETUP DIGIT COUNTER
	LSHC	0,-^D35		;SHIFT RIGHT 35 BITS INTO AC1
	LSH	1,-1		;VACATE AC1 SIGN BIT

$DCCMP:	DIV	0,RADIX		;DIVIDE DOUBLE LENGTH INTERGER BY 10
	HRLM	1,(17)		;SAVE DIGIT
	SOS	2		;COUNT DIGIT
	JUMPE	0,$LDSPS	;ALL DIGITS FORMED?
	GO	$RADIX+1	;NO, COMPUTE NEXT ONE

$DECP1:	HLRZ	1,(17)		;YES, RETRIEVE DIGIT
	ADDI	1,60		;CONVERT TO ASCII
	JSP	3,$TOUT		;TYPE-OUT A DIGIT
	RTN			;GET NEXT/EXIT

$LDSPS:	SKIPN	$PNT		;LEADING SPACES PRINT SET?
	JRST	$DECP1		;NO ...GO PRINT
				;YES ...DO IT
$DCSPS:	SOJL	2,$DECP1	;SPACES COMPLETE ?  YES
	MOVE	1,RADLSP	;NO, PRINT LEADING SPACE
	JSP	3,$TOUT		;TYPE OUT THE SPACE
	JRST	.-3		;CHECK FOR NEXT
SUBTTL	*SUBRTN*  CHARACTER OUTPUT ROUTINES

S
;*OUTPUT TERMINATION CONTROL ROUTINE
S

$TOUT:	MOVEM	0,$PACB0#	;SAVE AC0.
	MOVEM	1,$PNTYC#	;SAVE CHARACTER TO BE PRINTED
	JRST	$TOUTB		;KL10  ...DON'T CHECK FOR TYPE INS 

S
;*OVERALL CHARACTER OUTPUT CONTROL ROUTINE
S

$TOUTB:	MOVE	AC0,CONSW	;DATA SWITCHES INTO AC0
	AOS	$CARCT#		;INC CHAR CNTR.
	CAIN	1,7		;CHAR A BELL ?
	SETZM	$PTINH		;YES, CLEAR PRINT INHIBIT
	CAIE	1,15		;CHAR A CR?
	JRST	$TOUB1		;NO-CHK FOR LF
	SKIPN	$PTINH		;DON'T COUNT ^O'ED LINES
	AOS	PNTENB		;COUNT LINES, TILL NO MORE
	SETZM	$CARCT		;CLR CHAR CNTR.

$TOUB1:	CAIN	1,12		;IS CHAR A LF?
	SETZM	$CARCT		;YES-CLR CHAR CNTR.
	SKIPE	$PNTTY		;NO-IS PRINT FORCED ON?
	JRST	$TOUB2		;YES-DON'T CHECK NON-PNT SW
	TLNE	0,NOPNT		;IS NON PNT SWITCH ON?
	JRST	(3)		;YES, RETURN

$TOUB2:	JRST	$TOUTC		;SEND CHAR EXEC MODE 

;*ALT-MODE TRANSFER TO USER ROUTINE
S

	MOVEM	0,JOBOPC	;2-TERMINATED IN JOBOPC
	JRST	@CNTLC		;3-TERMINATE
$TUTX2:	JSP	0,.-2		;1-SAVE PC WHERE
	JRST	$TOUTB		;4-HERE IF CONTINUED
	MOVEM	0,JOBOPC	;2-TERMINATED IN JOBOPC
	JRST	@ALTMGO		;3-TERMINATE
$TUTX3:	JSP	0,.-2		;1-SAVE PC WHERE
	JRST	$TOUTB		;4-HERE IF CONTINUED
S
;*EXEC MODE CHARACTER OUTPUT CONTROL ROUTINE
S

$TOUTC:	TLNE	0,PNTLPT	;PRINT ON LINE PRINTER ?
	JRST	$TOUT1		;YES 

$PNTY1:	SKIPE	$PTINH		;NO, TYPE-OUT INHIBIT ?
	JRST	$TOUTA		;YES-EXIT 

$PNTY2:	MOVE	0,$PNTYC	;RESTORE CHAR (SAVED @ $TOUT)
	SKIPE	$FFF		;FORM FEED CONV INHIBITED ?
	JRST	.+3		;YES, DON'T DO IT
	CAIN	0,14		;IS CHAR A FF ?
	JRST	$FFEED		;YES, SUBSTITUTE 8 LF'S
	SKIPE	$VTF		;VERT TAB CONV INHIBITED ?
	JRST	$PNTY3		;YES, DON'T DO IT
	CAIN	0,13		;IS CHAR A VT ?
	JRST	$VTAB		;YES, SUBSTITUTE 4 LF'S

$PNTY3:	GO	$TYOUT
	JRST	$TOUTA		;RETURN 

;*RETURN BACK TO PRINTING ROUTINE FROM CHAR OUTPUT
S
$TOUTA:	MOVE	AC0,$PACB0	;RESTORE AC0
	JRST	(3)		;RETURN TO PRINT ROUTINE
S
;*EXEC MODE LPT OUTPUT
S

$TOUT1:	CAIN	1,7		;NO BELLS TO LPT
	JRST	$PNTY1
	CAIN	1,26		;NO NULLS TO LPT
	JRST	$PNTY1
	LSH	1,1		;C(AC1) HAS TO BE LEFT JUSTIFIED.
	ANDI	1,376		;CLEAR PARITY BIT
	DATAO	LPT,1		;PRINT CHAR ONTO LPT.
	MOVE	1,[^D<<1000*2000>/7>]	;ABOUT TWO SECONDS
	CONSO	LPT,100		;LPT DONE?
	SOJG	1,.-1		;NO.
	JUMPG	1,.+4		;IF LPT HUNG, CLEAR LPT PRINT
	MOVE	0,CONSW		;FOR THIS PRINT ENTRY
	TLZ	0,PNTLPT
	MOVEM	0,CONSW
	SKIPN	$PNTTY		;SKIP IF MSG ALSO FORCED TO TTY
	JUMPG	1,$TOUTA	;RETURN IF LPT NOT HUNG, ELSE ALL TO TTY
	MOVE	1,$PNTYC
	JRST	$PNTY1		;GO SET UP MORE OUTPUT, IF ANY

;*TELETYPE FF & VT CONVERSION
S

$VTAB:	MOVEI	1,4
	SKIPA

$FFEED:	MOVEI	1,^D8
	MOVEI	0,12
	GO	$TYOUT		;SEND LF'S 
	SOJG	1,$FFEED+1
	JRST	$TOUTA		;RETURN 
S
;*EXEC MODE CHARACTER OUTPUT
S

$TYOUT:	PUT	AC0
	ANDI	AC0,177		;CLEAR JUNK BITS
	GO	$DTEXX		;SEND TO PDP-11
	GET	AC0
	RTN