Google
 

Trailing-Edge - PDP-10 Archives - klad_sources - klad.sources/subusm.mac
There are no other files named subusm.mac in the archive.
;[toed.xkl.com]DXX:<KLAD.SOURCES>SUBUSM.MAC.2, 18-Apr-96 17:20:59, Edit by GORIN
;change $CPTYP.  Old code 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 USER 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 ?
	HALT	.		;EXEC MODE
	SETZM	MONTYP
	MOVE	[112,,11]
	GETTAB			;GET MONITOR TYPE ID
	CAM
	CAIN	40000		;TOPS20 ?
	SETOM	MONTYP		;YES
S
;*INITIALIZE PROCESSOR FLAGS AND PUSH LIST
S

$PGMN1:	HLRZ	JOBSA		;RESET JOB FIRST FREE TO
	MOVEM	JOBFF		;END OF LOW SEGMENT
	SKIPN	MONTYP
	CALLI	0		;TOPS10 RESET
	SKIPE	MONTYP
	RESET			;CLEAR USER I/O
	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 (KS/KL/KI/KA)
	GO	$UUOIN		;INIT UUO TRAP TRANSFER LOCATION
	GO	$PNTIN		;INIT PRINT SUBROUTINE
	GO	$TYPIN		;INIT TTY INPUT SUBROUTINE
	GO	$SWTIN		;INIT SWITCH INPUT SUBROUTINE
	GO	$ITRIN		;INIT INTERRUPT SUBROUTINE
	SKIPE	$MMAP		;MEMORY ROUTINES ?
	GO	$MEMMP		;MAP MEMORY
	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:	MOVE	[112,,11]
	GETTAB
	CAM
	CAIN	40000
	JRST	$NOU20
	OUTSTR	[ASCIZ/
EXEC ONLY
/]
	OUTSTR	@$PNAME
	JRST	@RETURN
$NOU20:	HRROI	1,[ASCIZ/
EXEC ONLY
/]
	PSOUT
	HRROI	1,@$PNAME	;PRINT THE NAME OF THIS FILE
	PSOUT
	JRST	@RETURN		;LEAVE FOR EVER
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
;*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,,$TPCLR
	$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
	CAMN	[PFORCE]	;"PFORCE" CALL ?
	JRST	$EGX1		;YES
	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

$EGX1:	GO	$PCLRO		;CLEAR CONTROL O & INPUT BUFFER
	JRST	$EGX

$CFLUSH:
$CINVAL:
$CLOCK:
$CWRTB:
$MPCNK:
$MPSET:
$MTROP:
$PNTMG:
	RTN			;NON-USER MODE UUO'S
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#
	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	$PNTMG		;IF KI10, PRINT MARGINS
	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	1,%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	PROCESSOR TYPE DETERMINATION
S

$CPUTP:	SETZM	CYCL60
	SETZM	SM10
	SETZM	KLFLG
	SETZM	KAIFLG
$CPKL:	SETZ	1,		;source 0, dest 0
	BLT	1,0		;copy 1 word from 0 to 0
	SKIPN	1		;if KL10, BLT will change AC1
	JRST	$CPKAI
	SETOM	KLFLG		;KL10 - SET FLAG

$CPINI:	SKIPN	MONTYP
	JRST	.+5		;TOPS-10
	MOVE	1,[SIXBIT/APRID/]
	SYSGT			;GET SERIAL NUMBER
	MOVE	0,1
	JRST	.+4
	MOVE	0,[20,,11]
	GETTAB
	SETZ	0,
	MOVEM	0,$$SNX#	;SAVE IT
	SKIPN	KLFLG
	RTN
	CAILE	0,^D4096	;IS THIS A KS10 ?
	SETOM	SM10		;YES, SERIAL # GT 4096.
	RTN

$CPKAI:	SETOM	KAIFLG
	MOVNI	0,1
	AOBJN	0,.+1
	SKIPE
	SETZM	KAIFLG		;KA10

	JRST	$CPINI
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
	SALL
$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:	GET	AC0
	SKIPE	MONTYP
	JRST	.+3
	EXIT	1,
	JRST	@$ERH0
	HALTF			;RETURN TO MONITOR
	JRST	@$ERH0		;IF CONTINUED
	LALL
;*FATAL PROGRAM ERROR HALT
S
	SALL
$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:
$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
	LALL
SUBTTL	PROGRAM NAME PRINTER

;*PRINT PROGRAM NAME IF NOT STAND-ALONE OR USER MODE
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

	SKIPN	MONTYP
	PMSG	<, TOPS-10>
	SKIPE	MONTYP
	PMSG	<, TOPS-20>
	
	SKIPE	KLFLG
	JRST	[SKIPE	SM10
		 JRST	[PMSG	<, KS10>
			 JRST	$PNM3]
		 PMSG	<, KL10>
		 JRST	$PNM3]
	SKIPN	KAIFLG
	JRST	[PMSG	<, KA10>
		 JRST	$PNM3]
	PMSG	<, KI10>

$PNM3:	SKIPN	$$SNX		;ANY SERIAL NUMBER ?
	JRST	$PNM2		;NO
	PMSG	<, CPU#=>
	MOVE	$$SNX
	PNTDEC			;PRINT SERIAL NUMBER

$PNM2:	PCRL
	RTN			;EXIT
SUBTTL	*SUBRTN* INTERRUPT HANDLING ROUTINES
	LALL

;*PUSH DOWN LIST EXCESSIVE POPJ ROUTINE
S
	SALL
PSHERR:	PMSGF	<^*****^PLIST UFLOW^>
	FATAL			;PRINT LOCATION AND EXIT
	LALL
S
;*INTERRUPT ROUTINE INITIALIZATION
S
	SALL
$ITRIN:	SKIPE	MONTYP
	JRST	.+6
	MOVEI	ITRUSR		;TOPS10, SETUP USER APR TRAPPING
	MOVEM	JOBAPR
	MOVEI	PDLOVU!MPVU!NXMU!PARU
	APRENB			;ENABLE PROCESSOR TRAPS
	RTN

	MOVEI	1,.FHSLF	;CURRENT PROCESS
	MOVE	2,[LEVTAB,,CHNTAB]
	SIR			;SPECIFY INTERRUPT TABLES
	EIR			;ENABLE SYSTEM
	MOVE	2,[1B1+1B<.ICPOV>+1B<.ICILI>+1B<.ICIRD>+1B<.ICIWR>]
	AIC			;ACTIVATE CHANNELS
	MOVE	1,[.TICCG,,1]
	ATI			;ASSIGN CTRL/G TO CHANNEL 1
	RTN
	LALL
;*INTERRUPT TABLES
S
	SALL

LEVTAB:	0			;LEVEL TABLE
	PC2
	0

PC2:	0

CHNTAB:	0			;CHANNEL TABLE
	2,,CNTRLG		;CHANNEL 1 IS CTRL/G
	REPEAT	^D7,<0>		;CHANNEL 2-8 NOT USED
	2,,PDLINT		;CHANNEL 9 IS PDL
	REPEAT	^D5,<0>		;CHANNEL 10-14 NOT USED
	2,,IININT		;CHANNEL 15 IS ILLEGAL INST
	2,,IMRINT		;CHANNEL 16 IS ILLEGAL MEMORY READ
	2,,IMWINT		;CHANNEL 17 IS ILLEGAL MEMORY WRITE
	REPEAT	^D18,<0>	;CHANNEL 18-35 NOT USED
	LALL
;*TOPS20 CONTROL G ROUTINE
S
	SALL
CNTRLG:	MOVEM	0,$CGAC0#
	TLNN	P,777000	;CHECK THAT P IS "SUBUSR'S" P
	JRST	CNTRG1		;NO
	TRNE	P,747000
	JRST	CNTRG1
	HRRZ	0,P
	CAIG	0,PLIST
	JRST	CNTRG1
	CAIL	0,PLISTE
	JRST	CNTRG1
	HLRZ	0,P
	CAIG	0,777577
	JRST	CNTRG1
	CAIL	0,777777
	JRST	CNTRG1

	SKIPE	$$TAX1
	XCT	$$TAX1		;EXECUTE USER ROUTINE IF SUPPLIED
	GO	$SW0		;DO SWITCHES
	SKIPE	$$TAX2
	XCT	$$TAX2		;EXECUTE USER ROUTINE IF SUPPLIED
	DEBRK			;DISMISS INTERRUPT

CNTRG1:	MOVE	0,$CGAC0
	DEBRK
	LALL
;*TOPS20 INTERRUPT PROCESSOR
S
	SALL

PDLINT:	MOVEM	0,$ACC0
	MOVEI	$PDOVU		;SETUP TRANSFER
$$INT:	EXCH	PC2
	MOVEM	ITRCH1		;SAVE TRAPPED ADDRESS
	DEBRK			;DISMISS INTERRUPT

IININT:	MOVEM	0,$ACC0
	MOVEI	$IIN
	JRST	$$INT

IMRINT:	MOVEM	0,$ACC0
	MOVEI	$IMR
	JRST	$$INT

IMWINT:	MOVEM	0,$ACC0
	MOVEI	$IMW
	JRST	$$INT

$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	$ITR1A		;COMMON INTERRUPT ROUTINE

$IIN:	PMSG	<^*****^ILLEGAL INSTRUCTION >
	MOVE	ITRCH1
	SOS
	MOVE	@0
	PNTHW			;PRINT OFFENDING INSTRUCTION
	SETZ
	JRST	$ITR1A		;COMMON INTERRUPT ROUTINE

$IMR:	MOVEI	SIXBTZ	<^ILLEGAL MEMORY READ>
	JRST	$ITR1A		;COMMON INTERRUPT ROUTINE

$IMW:	MOVEI	SIXBTZ	<^ILLEGAL MEMORY WRITE>
	JRST	$ITR1A		;COMMON INTERRUPT ROUTINE

	LALL
;*TOPS10 USER INTERRUPT HANDLER
S
	SALL

ITRUSR:	MOVEM	$ACC0
	MOVE	JOBTPC
	MOVEM	ITRCH1		;SAVE TRAPPED ADDRESS
	MOVE	JOBCNI		;GET CAUSE
	TRNE	PARU
$UPAR:	JRST	$PAREX		;PARITY ERROR
	TRNE	PDLOVU
$UPDL:	JRST	$PDOVU		;PUSHDOWN OVERFLOW
	TRNE	MPVU
$UMPV:	JRST	$MPVU		;MEMORY PROTECTION VIOLATION
	TRNE	NXMU
$UNXM:	JRST	$NXMU		;NON-X-MEMORY

	MOVEI	SIXBTZ	<^UNKNOWN INTERRUPT>
	JRST	$ITR1A

$MPVU:	MOVEI	SIXBTZ	<^MEMORY PROT>
	JRST	$ITR1A

$NXMU:	MOVEI	SIXBTZ	<^NON-X-MEMORY>
	JRST	$ITR1A

$PAREX:	MOVE	$ACC0
	XCT	$PARER		;EXECUTE USERS ROUTINE IF SUPPLIED
	MOVEI	SIXBTZ	<^MEMORY PARITY>
	JRST	$ITR1A
	LALL
;*COMMON INTERRUPT HANDLERS
;*PRINT CAUSE AND OTHER PERTINENT INFO
S
	SALL
$ITR1A:	PUT	0
	PFORCE
	GET	0

$ITR1B:	SKIPE	0
	PSIXL			;PRINT CAUSE
	PMSG	<^FLAGS  PC      PROG^>
	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
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
	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
	LALL

;*END OF PROGRAM ROUTINE
S

$EOP:	SKIPE	MONTEN		;USER, LOADED BY ITSELF ?
	JRST	@RETURN		;NO, RETURN TO LOADER
	SKIPN	MONTYP
	EXIT
	HALTF			;YES, EXIT
	JRST	BEGIN
SUBTTL	*SUBRTN* MEMORY MANAGMENT 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 KI10
;*	$MSEG	(MEMSEG)	SET UP SEGMENTS FROM CHUNKS IN PAGE MAP
;*	$MZRO	(MEMZRO)	ZERO'S THE MAPPED MEMORY
;*	$MPADR	(MAPADR)	VIRTUAL TO PHYSICAL ADDRESS TRANSLATION
S

$MEMMP:	SETZM	MEMSIZ		;USER MEMORY STARTS AT 0
	HRRZ	JOBREL		;GET HIGHEST REL ADDRESS
	MOVEM	MEMSIZ+1	;SAVE AS MEMORY SIZE
	SETOM	MEMSIZ+2	;FLAG END OF MEMSIZ TABLE
	SETZM	MAPNEW		;CLEAR 4096K MAPPING FLAG
	JRST	$PMAP		;GO PRINT MAP

S
;*MEMSEG, ARGUMENTS 0-10: SETUP CORRESPONDING CHUNK FROM MEMSIZ TABLE
;*		  11-37 RETURN 0, MAXIMUM OF 8 CHUNKS IN 256K
;*		  USER MODE, 1-37 ALWAYS RETURNS 0
;*	  	  GT 37 - RETURNS MEMORY AT PHYSICAL ADDRESS
;*RETURNED IN AC0:
;*		  0 - NO MEMORY AVAILABLE
;*		  START ADDRESS,,END ADDRESS
;*RETURNS +1
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
	JUMPE	0,$MSKA		;USER MODE, SEGMENT 0 ONLY
	CAIL	0,40		;IF 1-37, NO MEMORY
	JRST	$MSKAP		;PHY, DO DIRECT PHYSICAL

$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
	RTN
;*PHYSICAL CORE ASSIGNMENT
S

$MSKAP:	CAILE	0,777000	;REQUEST FOR OVER 256K ?
	JRST	$MSEG3		;YES, NO MEMORY

$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

	MOVE	5,0		;1= PHY ADR, 0= END ADR
	HRL	5,1		; START ADR,,END ADR
	JRST	$MSEG3		;EXIT

$MSKA:	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
S
;*MEMZRO, ZERO'S MEMORY FROM MEMLOW UP TO MAXIMUM
;*MAPNEW = 0	 DIRECT MEMORY ZERO
S

$MZRO:	MOVEM	1,$MZROB#	;SAVE AC1 & AC2
	MOVEM	2,$MZROC#

$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
S
;*MAPADR, VIRTUAL ADDRESS IN AC0, PHYSICAL ADDRESS RETURNED IN AC0
;*SKIP RETURN IS NORMAL, NON-SKIP RETURN IS KI10 PAGE INACCESSIBLE
S

$MPADR:	MOVEM	1,$MPAC0#
	HRRZ	1,0
	CAIG	1,17		;ACCUMULATOR ADDRESS ?
	JRST	$MPAD3-1	;YES

	MOVE	CONSW
	SKIPN	PVPAGI
	TLNN	INHPAG
	JRST	.+2
	JRST	$MPAD2		;PAGING INHIBITED
	SKIPE	KLFLG		;KL10 ?
	JRST	$MPADL		;YES
	SKIPN	KAIFLG		;KA10 ?
	JRST	$MPAD2		;YES

$MPAD6:	MAP	0,(1)		;KI10, GET RELOCATION DATA
	TRNE	0,400000	;PAGE FAILURE ?
	JRST	$MPAD4		;YES, SEE IF VALID ANYWAY
$MPAD5:	TRZ	0,760000	;CLEAR P,W,S, NO MATCH BITS
	LSH	0,^D9		;HI-ORDER 13 FROM MAP
	ANDI	1,777		;LO-ORDER 9 FROM VIRTUAL
	OR	0,1		;COMBINE
$MPAD7:	AOS	(P)		;SKIP RETURN
$MPAD3:	MOVE	1,$MPAC0
	RTN

$MPAD4:	TRNE	0,20000		;PAGE FAILURE, ALSO NO MATCH ?
	JRST	$MPAD3		;YES, ERROR
	JRST	$MPAD5		;MATCH (RELOCATION VALID)

$MPAD2:	MOVE	0,1		;KA10
	HRROI	1
	CALLI	41		;GETTAB - RELOCATION TABLE
	SETZ			;ERROR
	HRRZ			;RELOCATION ONLY
	ADD	0,1		;RELOC + VIRTUAL = PHYSICAL
	JRST	$MPAD7

$MPADL:	MOVE	0,1		;MAP ILLEGAL ON KL10
	JRST	$MPAD7		;SO VIRTUAL GIVEN BACK
;*MAPPNT, PRINT MEMORY MAP
S

	SALL
$PMAP:	SETZ	4,
	SKIPL	MONCTL		;UNDER DIAGNOSTIC MONITOR ?
	JRST	$PMAP3		;NO
	JRST	$PMAP1		;YES
$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>

	PCRL
	SETZB	3,5

$PMAPL:	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,$PMAP4
$PMAP7:	PNTDEC			;PRINT DECIMAL SIZE

$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
	PCRL

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

$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:	MOVE	3,$MODDD	;RESTORE AC'S
	MOVE	2,$MODDC
	MOVE	1,$MODDB
	RTN			;EXIT
	LALL
;*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 OR IN
;*USER MODE IF NON-TTY SWITCH CONTROL
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
	JRST	$SWUSR		;USER MODE
$SWCH1:	SKIPGE	MONCTL		;MONITR CONTROL ?
	HRR	0,MONCTL	;YES, USE PRESTORED RH SWITCHES
	MOVEM	0,CONSW		;SAVE
	RTN			;EXIT
$SWUSR:	SETZ			;KL'S DON'T HAVE SWITCHES
	SKIPN	MONTYP
	CALLI	20		;TOPS10 SWITCH CALL
	MOVEM	AC0,CONSW
$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	$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
	RTN			;EXIT
	LALL
;*SWITCH INITIALIZATION ROUTINE
S
	SALL
$SW0:	PUT	0
	SKIPE	$$TOGGLE	;SWITCHES PREVENTED ?
	JRST	$SW9+2		;YES, USE C(CONSW)
	SKIPGE	MONCTL		;DIAGNOSTIC MONITOR MODE ?
	JRST	$SW10		;YES
	SKIPN	$SWONCE		;INITIALIZATION ?
	JRST	$SW11		;YES
$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:	GO	$TPCLR		;CLEAR INPUT
	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, LEAVE SWITCH BIT CLEAR
$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/
	0
	SIXBIT/MODDVC/
	0
	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:	SETZM	INUPTR		;CLEAR INPUT POINTER
	RTN			;NO TYPE-IN AVAILABLE

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

$TTLK:	SETZ	AC0,
	SKIPGE	MONCTL		;NO CHECK IF "MONITOR"
	RTN
	SKIPE	MONTYP
	JRST	.+4
	INCHRS	$TTCHR		;TOPS10 INPUT CHAR AND SKIP
	RTN			;NONE AVAILABLE
	JRST	$HEAR4		;GO PROCESS
	PUT	1
	PUT	2
	MOVEI	1,.PRIIN
	SIBE			;ANY INPUT AVAILABLE ?
	 JRST	.+4		;YES
	GET	2
	GET	1
	RTN
	PBIN			;GET INPUT CHAR
	MOVEM	1,$TTCHR
	GET	2
	GET	1
	JRST	$HEAR4		;CHAR TYPED, GO PROCESS
S
;*TELETYPE IMAGE MODE INPUT
;*PROVIDES UNBUFFERED MODE INPUT
;*WAITS FOREVER, RETURN WITH CHAR UPPER CASED & ECHOED
S

$TTYIN:	SKIPE	MONTYP
	JRST	.+3
	INCHRW			;TOPS10 INPUT CHAR AND WAIT
	JRST	.+5
	PUT	1
	PBIN
	MOVEM	1,$TTCHR
	GET	1
	GO	$HEAR4		;PROCESS IT
	JRST	.-1
	RTN

$OPTLK:	MOVEM	4,$TACB4#
	GO	$HEAR
	JRST	.-1
	AOS	(P)
	MOVEI	4,1
	MOVEM	4,$TWCNT	;INDICATE NO TIMEOUT
	MOVE	4,$TACB4
	RTN

S
;*TELETYPE ALT-MODE CHECK ROUTINE
S

$TALTM:	GO	$TTLK
	RTN			;NO TYPE-IN  ...EXIT

$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

	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
S
;*TELETYPE INPUT CHARACTER 
S

$HEAR:	SKIPE	MONTYP
	JRST	.+3
	INCHWL	$TTCHR		;TOPS10 INPUT CHAR LINE MODE
	JRST	$HEAR4
	SKIPN	INUPTR		;ANY INPUT POINTER ?
	JRST	.+5		;NO, INPUT CLEARED
	ILDB	0,INUPTR	;GET CHAR FROM STORE
	JUMPE	0,.+3		;USED IT ALL, GET NEW INPUT
	MOVEM	0,$TTCHR	;SAVE IT
	JRST	$HEAR4		;GO PROCESS

	PUT	1
	PUT	2
	PUT	3
	MOVE	1,[POINT 7,D$ISTR]
	MOVEM	1,INUPTR#	;SETUP INPUT POINTER
	MOVE	2,[RD%BRK!RD%TOP!^D132]
	SETZ	3,

	RDTTY			;GET TTY INPUT FROM MONITOR
	 JRST	T20ERR

	GET	3
	GET	2
	GET	1
	JRST	$HEAR		;NOW GO PROCESS

$TPCLR:	PUT	1
	SETZM	INUPTR		;CLEAR INPUT POINTER
	MOVEI	1,.PRIIN
	SKIPN	MONTYP
	CLRBFI			;TOPS10 CLEAR BUFFER
	SKIPE	MONTYP
	CFIBF			;ERROR, CLEAR TYPE-IN BUFFER
	GET	1
	RTN
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
	SKIPN	MONTYP
	INCHRW			;TOPS10 FLUSH LF
	SKIPE	MONTYP
	IBP	INUPTR		;GET RID OF LF
	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 
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
	GO	$TPCLR		;CLEAR INPUT
	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, AND TTY IF IN USER MODE
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

	SKIPN	MONTYP
	JRST	$PNTIX
	movei	1,.priou
	rfmod			;don't translate print output
	trz	2,tt%dam
	tro	2,3b29
	sfmod

$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
	GO	$PCLRO		;CLEAR CONTROL 0 & INPUT BUFFER
	JRST	$PNTIA

$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	$PNTIA
	GET	AC0		;YES ...RESTORE AC0 FROM STACK (P - 1)
	JRST	$PRNTX		;EXIT, DON'T PRINT

$PCLRO:	SKIPE	MONTYP
	JRST	.+4
	TTCALL	13,0		;TOPS10 CLEAR CONTROL O
	JFCL
	RTN
	PUT	1
	PUT	2
	MOVEI	1,.PRIOU
	RFMOD
	TLZ	2,(TT%OSP)	;CLEAR CONTROL O
	SFMOD
	GET	2
	GET	1
	SETZM	INUPTR		;CLEAR TTY INPUT BUFFER
	RTN
;*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

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:	JSP	4,$TOUT2	;SEND CHARACTER USER MODE 

$TOUB3:	SKIPE	USRLFF#		;NEED USER LF FILLERS ?
	JRST	$USRFL		;YES
	SKIPE	USRCRF#		;NEED USER CR FILLERS ?
	JRST	$USRFC		;YES
	JRST	$TOUTA		;NO-BACK TO PRINT ROUTINE
;*USER MODE LF & CR FILLERS
S

$USRFC:	CAIE	1,15		;CR ?
	JRST	$TOUTA		;NO-RETURN TO PRINT ROUTINE 
	MOVE	5,USRCRF	;SEND FILLERS FOR CR
	JRST	$USRF1		;DEPENDING ON 'USRCRF'

$USRFL:	CAIE	1,12		;LF ?
	JRST	$TOUTA		;NO-RETURN TO PRINT 
	MOVE	5,USRLFF	;SEND FILLERS FOR LF
$USRF1:	SOJL	5,$TOUTA	;DEPENDING ON 'USRLFF'
	MOVEI	1,001		;^A
	JSP	4,$TOUT2	;SEND CHARACTER 
	JRST	$USRF1

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

$TOUT2:	MOVEM	4,$PACC4#
	MOVE	0,CONSW
	TLNE	0,PNTLPT	;IS LPT PRINT SWITCH UP ?
	JRST	$TOUT3		;YES, GO PRINT ON LOGICAL DEVICE
	DROPDV			;CLOSE DEV IF SWITCH CHANGED
$TOUT6:	MOVE	0,$CARCT	;CHARACTER NUMBER
	CAIN	0,1		;FIRST CHAR IN LINE ?
	JRST	$TOUT4		;YES
$TOUT5:	SKIPN	MONTYP
	OUTCHR	1
	SKIPE	MONTYP
	GO	$$TOU5		;TOPS-20 OUTPUT
	JRST	@$PACC4		;GO RESTORE AC0 AND RETURN

$TOUT4:	SKIPL	MONCTL		;SYSTEM EXERCISER
	JRST	$TOUT5		;NO
	PUT	1
	MOVEI	1,"?"		;PRECEDE LINE WITH ?
	SKIPN	MONTYP
	OUTCHR	1
	SKIPE	MONTYP
	PBOUT
	GET	1
	JRST	$TOUT5

;*USER MODE LOGICAL DEVICE OUTPUT
S

$TOUT3:	SKIPN	$DVOFF		;DEVICE BEEN INITED YET ?
	GO	$INTDV		;NO, GO DO IT
	GO	$PUTCR		;GO OUTPUT CHAR
	SKIPN	$PNTTY		;SKIP IF MESSAGE ALSO FORCED TO TTY
	JRST	@$PACC4
	JRST	$TOUT6		;OUTPUT 
;*TOPS-20 TTY OUTPUT

$$TOU5:	CAIE	1,33		;PRINTING AN ALTMODE ?
	JRST	$$TOU6		;NO
	PUT	1
	PUT	2
	PUT	3
	MOVEM	1,$$TO5A#
	MOVEI	1,.PRIOU
	RFCOC			;YES, DON'T TRANSLATE IT
	PUT	2
	PUT	3
	TRZ	3,600000
	TRO	3,400000
	SFCOC
	MOVE	1,$$TO5A
	PBOUT			;PRINT AN ACTUAL 33 CODE
	MOVEI	1,.PRIOU
	GET	3
	GET	2
	SFCOC			;RESTORE OUTPUT TRANSLATION
	GET	3
	GET	2
	GET	1
	RTN

$$TOU6:	PBOUT			;NORMAL OUTPUT
	RTN

;* LOGICAL DEVICE OUTPUT ROUTINES
S

$PUTCR:	SKIPN	MONTYP
	JRST	$PUT10
	PUT	1
	PUT	2
	MOVE	2,1
	MOVE	1,DEVJFN
	BOUT
	GET	2
	GET	1
	RTN
S
;*LOGICAL DEVICE INITIALIZATION
;*PHY DEV ASSIGNED AT RUN TIME
S

$INTDV:	MOVE	0,PNTEXT
	MOVEM	0,$OUTEX
	MOVE	0,PNTNAM	;SETUP LOGICAL OUTPUT FILE NAME
	MOVEM	0,$OUTNM
	MOVEM	1,$PACF1#
	MOVEM	2,$PACF2#
	SETZM	$INTD3#
	SKIPN	MONTYP
	JRST	$INT10		;TOPS10
	MOVE	[POINT 7,FILASC,27]
	MOVE	1,[ASCII/DEV:/]
	MOVEM	1,FILASC
$INT21:	MOVEI	1,$OUTNM
	GO	SIXASC		;CONVERT SIXBIT TO ASCII
	HRLZI	1,(GJ%FOU!GJ%SHT)
	HRROI	2,FILASC
	GTJFN
	 ERJMP	$INT22		;DEVICE NOT AVAILABLE, DEFAULT TO DSK
	MOVEM	1,DEVJFN#
	MOVE	2,[7B5!OF%WR]
	OPENF
	 JRST	T20ERR
$INT12:	SETOM	$DVOFF
	MOVE	2,$PACF2
	MOVE	1,$PACF1
	RTN

$INT22:	SKIPE	$INTD3
	 JRST	T20ERR
	HRROI	1,[ASCIZ/
****
USING 'DSK' PRINT FILE
****
/]
	PSOUT
	MOVE	[POINT 7,FILASC,27]
	MOVE	1,[ASCII/DSK:/]
	MOVEM	1,FILASC
	SETOM	$INTD3
	JRST	$INT21
;*USER MODE CLOSE FILE
S

$DRPDV:	SKIPN	$DVOFF		;DEVICE INITED?
	RTN			;NO, DON'T BOTHER 
	SKIPN	MONTYP
	JRST	$DRP10		;TOPS10
	PUT	1
	MOVE	1,DEVJFN
	CLOSF
	 JRST	T20ERR
	GET	1
	SETZM	$DVOFF
	RTN			;EXIT 

T20ERR:	MOVEI	1,.PRIOU
	HRLOI	2,.FHSLF
	SETZ	3,
	ERSTR
	 HALTF
	 HALTF
	HALTF

SIXASC:	PUT	2
	PUT	3
	PUT	4
	MOVE	3,0
	MOVE	4,1
	MOVE	1,(4)
	GO	SIXSTR
	MOVEI	"."
	IDPB	0,3
	HLLZ	1,1(4)
	SKIPE	1
	GO	SIXSTR
	IDPB	1,3
	GET	4
	GET	3
	GET	2
	RTN

SIXSTR:	SETZB	0,2
	LSHC	0,6
	ADDI	0,40
	IDPB	0,3
	JUMPN	1,.-4
	RTN
;*TOPS10, LOGICAL DEVICE OUTPUT

$PUT10:	SKIPE	$DVTTY#		;IF DEVICE IS TTY
	JRST	.+5		;EMPTY BUFFER AFTER EACH CHAR
	SOSG	$OBUF+2		;INCREMENT BYTE COUNT
	JRST	.+3
	IDPB	1,$OBUF+1	;STORE CHAR
	RTN
	OUT	$DEVCH,		;EMPTY BUFFER
	JRST	.-3

;*$INT10, TOPS10 INITIALIZE LOGICAL OUTPUT

$INT10:	MOVEM	0,$OUTNM
	INIT	$DEVCH,0	;ASCII MODE, DEV CHANNEL
	SIXBIT	/DEV/		;LOGICAL DEVICE, LPT,DSK,DTAX
	XWD	$OBUF,		;OUTPUT ONLY
	JRST	$INT13		;DEV NOT AVAIL, DEFAULT TO DISK
$INT11:	OUTBUF	$DEVCH,1	;SETUP OUTPUT BUFFER
	ENTER	$DEVCH,$OUTNM	;INIT OUTPUT FILE
	JRST	$OERR2		;NO DIR ROOM, ERROR
	SETOM	$DVOFF		;SET DEVICE INITED FLAG
	MOVEI	0,$DEVCH
	DEVCHR			;GET DEVICE CHARACTERISTICS
	TLNE	0,10
	SETOM	$DVTTY		;DEVICE IS TTY
	JRST	$INT12		;EXIT
$INT13:	SKIPN	$INTDF		;FIRST DEFAULT INIT ?
	OUTSTR	[ASCIZ/
****
USING 'DSK' PRINT FILE
****
/]
	SETOM	$INTDF
	INIT	$DEVCH,0
	SIXBIT	/DSK/
	XWD	$OBUF,
	JRST	$OERR1
	JRST	$INT11

;*USER MODE CLOSE FILE

$DRP10:	CLOSE	$DEVCH,		;CLOSE FILE
	STATZ	$DEVCH,740000	;RECHECK FINAL ERROR BITS
	OUTSTR	[ASCIZ/
%PRINT CLOSE ERROR
/]
	RELEAS	$DEVCH,		;RELINQUISH DEVICE, WRITE DIRECTORY
	SETZM	$DVOFF
	RTN			;EXIT 

$OUTER:	OUTSTR	[ASCIZ/
%PRINT OUTPUT ERROR
/]
	SKIPE	$$OUTER
	XCT	$$OUTER		;EXECUTE USERS ERROR RTN, IF PROV.
	EXIT	1,		;ERROR, QUIT
	JRST	BEGIN		;RESTART USER SEGMENT 

$OERR1:	OUTSTR	[ASCIZ/
DSK INIT ERROR/]
	JRST	$OUTER		;DISK PRINT OUTPUT ERROR

$OERR2:	OUTSTR	[ASCIZ/
NO DIR ROOM/]
	JRST	$OUTER		;DISK PRINT OUTPUT ERROR