.TITLE	SUBTST
/
/  17 JAN 74 (PDH) CONTINUE TYPING UP THE DIAGNOSTIC
/   2 JAN 74 - PAUL HENDERSON- BEGIN TRANSCRIBING THE DIAGNOSTIC
/
/  MODIFICATION TO DIGITAL-7-66-M 347 SUBROUTINE INTERFACE DIAGNOSTIC
/  TO MAKE IT WORK IN 32K.
/
/  DISPLAY DEFINITIONS
/
IDVE=700501
IDSI=700601
IDSP=700701
IDHE=701001
IDRA=700512
IDLA=700606
IDCF=700704
IDSC=701012
LPOFF=10000
STPINT=3000
VCON=120000
DDS=200000
DJP=400000
DJS=600000
VEC=100000
SUB=160000
VPT=220000
PT=020000
S0=100
I7=17
/
AUTO15=15
AUTO16=16
/
TSF=700401
TCF=700402
TLS=700406
/
/  MACRO TO DEFINE VECTOR MODE MACHINE CODE
/
	.DEFIN	VCTR,DX,DY,?I,?E
..DX=DX&177
..DY=DY&177*400
..I=200000
..E=0
	.IFNEG	DX
..DX=DX*777777&177+200
	.ENDC
	.IFNEG	DY
..DY=DY*777777&177+200*400
	.ENDC
	.IFDEF	I
..I=I&1*200000
	.ENDC
	.IFDEF	E
..E=E&1*400000
	.ENDC
/
	..E+..I+..DX+..DY
	.ENDM
/
	.ABS
/
	.LOC	21
	HLT
BEGIN	LAC	(JMP INTER
	DAC	1
	CAF
	ION
/  FILL MEMORY WITH STOP CODES
	JMS	FILBUF
	STPINT			/DATA
	2200			/START ADDRESS
	17777			/END ADDRESS
/
/  LOOK AT AC SWITCHES TO ETERMINE GROUP OF TEST TO PERFORM
/
GETSW	LAS			/EXIT FILBUF RETURNS HERE
	RAR
	DAC	SAVSWS
	SZL
	JMP	SCPTST		/SCOPE TEST
	LAC	SAVSWS
	RAR
	DAC	SAVSWS
	SZL
	JMS	DDSTST		/DDS INSTRUCTION TEST
	LAC	SAVSWS
	RAR
	DAC	SAVSWS
	SZL
	JMS	DJSTST		/DJS INSTRUCTION TEST
	LAC	SAVSWS
	RAR
	DAC	SAVSWS
	SZL
	JMS	DJPTST		/DJP INSTRUCTION TEST
	JMP	GETSW
/
/  INTERRUPT ROUTINES
/
INTER	DAC	ACSAVE
	IDSI			/DISPLAY STOP CODE
	SKP
	XCT	STPCOD
	IDVE			/DISPLAY EDGE FLAG
	SKP
	XCT	STPCOD
	TSF
	SKP
	JMP	TYNT.
	IORS
	HLT			/UNKNOWN FLAG
	CAF
	DISMIS
/
STPCOD	IDCF			/EXECUTED ON DISPLAY STOP CODE INTERRUPT
/					(MODIFIED)
DISMIS=JMP .
	LAC	0
	RAL
	LAC	ACSAVE
	ION
	JMP*	0
/
/  USED FOR 2ND LEVEL INTERRUPTING
/  DUMMY DISMIS
/
DMYDIS=JMP .
	LAC	SAVE0
	RAL
	LAC	DYSAVE
	ION
	JMP*	SAVE0
/
/  DJP TEST
/
DJPTST	XX
/
/  FILL A SECTION OF CORE (PAGE 1) WITH STOP CODES
/
	JMS	FILBUF
	STPINT			/DATA
	10000			/START ADDRESS
	17777			/END ADDRESS
/
/  FILL INSTRUCION TABLE WITH DJP'S TO STOP CODES AND PARAMETER-MODE
/  WORDS CONTAINING 160000 (SUB)
/  FORMAT:
/ 4000/	SUB
/ 4001/	DJP	15673
/ 4002/	SUB
/ 4003/	DJP 	15674
/
	JMS	FILDJP
	DJP	15673
	4000			/START ADDRESS OF INSTRUCION TABLE
	7777			/END ADDRESS OF INSTRUCTION TABLE
/
/  SET UP ERROR INDICATOR ROUTINES FOR DJP TEST
/
	LAC	(JMP DJPHLT
	DAC	HLTLX		/HLT + LOOP AND HLT ON CONTINUE
	LAC	(JMP DJPPNT
	DAC	PRNTLX		/PRINT
	LAC	(JMP DJPNST
	DAC	PNTSPX		/PRINT + HLT
	LAC	(JMP DJPSCP
	DAC	SCOPEX		/SCOPE
	LAC	(JMP DJPNSP
	DAC	PNSCPX		/SCOPE + PRINT
	LAC	(JMP DJPBEL
	DAC	BELLEX		/BELL
	LAC	(JMP DJPBLS
	DAC	BELSPX		/BELL + SCOPE
	LAC	(JMP CURINS
	DAC	EREXIT		/RETURN FOR LOOPING WHEN ERROR
/
/  SET UP INTERRUPT ANSWER FOR DISPLAY STOP CODE
/
	LAC	(JMP DJPSTP
	DAC	STPCOD
/
/  INITIALIZE AND DO DJP TEST.
/
	LAW	4000
	DAC	CURINS
/
CURINS	LAW	4000		/CURRENT INSTRUCTION ADDRESS - MODIFIED
	SAD	(LAW 10000	/END OF INSTRUCTION TABLE
	JMP	DJPVRS		/REVERSE TABLES AND DO SAME
	IDLA			/INITIATE DISPLAY
	JMP	.		/WAIT FOR STOP CODE INTERRUPT
	ISZ	CURINS
	ISZ	CURINS
	JMP	CURINS		/DO NEXT INSTRUCTION
/
/  REVERSE TABLES AND DO SAME
/
DJPVRS	JMS	FILBUF
	STPINT			/DATA
	4000			/START ADDRESS
	7777			/END ADDRESS
/
	JMS	FILDJP
	DJP	4001		/DAATA
	13763			/START ADDRESS
	17777			/END ADDRESS
	LAC	(JMP CUREVI
	DAC	EREXIT		/RETURN FOR LOOPING WHEN ERROR
/
/  IIITIALIZE AND DO DJP TEST
/
	LAW	13673
	DAC	CUREVI
/
CUREVI	LAW	10000		/MODIFIED
	SAD	(LAW 17763
	JMP*	DJPTST		/FINISHED.  EXIT
	IDLA
	JMP	.		/WAIT FOR STOP CODE
	ISZ	CUREVI
	ISZ	CUREVI
	JMP	CUREVI
/
/  ENTER HERE ON STOP CODE INTERRUPT
/
DJPSTP	LAC	ACSAVE		/ADDRESS OF PAR MODE INSTRUCTION (160000)
	AND	(17777
	TAD	(1		/DJP TO SPECIFIED ADDRESS (STPINT)
	DAC	CURLOC
	LAC*	CURLOC		/ADDRESS CONTAINING STOP CODE
	AND	(17777
	TAD	(1
	DAC	EXPTED		/STOP CODE ADDRESS+1=DAC ON INTERRUPT
	IDRA
	AND	EXPTED		/COMPARE WITH ACTUAL DAC READING
	SKP			/OK
	JMP	ERRDJP		/ERROR
	IDCF			/CLEAR DISPLAY FLAG
	ISZ	0			/EXCAE FROM 'JMP .'
	DISMIS
/
ERRDJP	DAC	ACTUAL		/ACTUAL LOCATION
	JMP	ERROR
/
/  HLT FOR DJP TEST ERROR
/
DJPHLT	HLT
	XCT	EREXIT		/LOOP AFTER HLT
/
/  PRINT FOR DJP TEST ERROR
/
DJPPNT	TYPE.
	.ASCII	'DJP'
	JMS	MES1
	DMYDIS		/GO TO NEXT TEST AFTER PRINT
/
/  PRINT AND HALT
/
DJPNST	TYPE.
	.ASCII	'DJP'
	JMS	MES1
	HLT
	XCT	EREXIT		/LOOP AFTER PRINT AND HLT
/
/  SCOPE FOR DJP TEST ERROR
/
DJPSCP	XCT	EREXIT		/LOOP
/
/  PRINT AND SCOPE
/
DJPNSP	TYPE.
	.ASCII	'DJP'
	JMS	MES1
	XCT	EREXIT	I/LOOP AFTER PRINT
/
/  BELL ON DJP ERROR
/
DJPBEL	LAW	207		/ASCII CODE FOR BELL
	JMS	TPOTY		/TYPE A CHARACTER
	DMYDIS		/GO TO NEXT TEST AFTER BELL
/
/  BELL AND SCOPE ON DJP ERROR
/
DJPBLS	LAW	207
	JMS	TPOTY
	XCT	EREXIT		/LOOP AFTER BELL
	.EJECT
/  REVERSE TABLES FOR DJS TEST AND REPEAT
/
DJSVRS	JMS	FILLTAB
	DJS	3777		/DATA
	13762			/START ADDRESS
	17777			/END ADDRESS
	JMS	FILBUF
	STPINT			/DATA
	3777			/START ADDRESS
	7777			/END ADDDRESS
	LAC	(JMP CURIN3
	DAC	EREXIT
	LAC	(DJP!SUB 13762
	DAC	DJPINS+1
CURIN3	LAW	DJPINS
	IDLA
	JMP	.
	ISZ	DJPINS+1
	LAC	DJPINS+1
	SAD	(DJP!SUB 17762
	JMP*	DJSTST
	JMP	CURIN3
/
/  ERROR ANSWERS FOR DJS TEST PRINT
/
DJSPNT	TYPE.
	.ASCII	'DJS'
	JMS	MES1
	JMS	MES2
	DMYDIS
/
/  PRINT AND HLT
/
DJSNST	LAC	(HLT
	DAC	HLTSCP
JSNST2	TYPE.
	.ASCII	'DJS'
	JMS	MES1
	JMS	MES2
HLTSCP	XX			/MODIFIED
	XCT	EREXIT
/
/  SCOPE
/
DJSSCP	XCT	EREXIT
/
/  SCOPE AND PRINT
/
DJSNSP	LAC	(XCT EREXIT
	DAC	HLTSCP
	JMP	JSNST2
/
/  BELL ON ERROR
/
DJSBEL	LAW	207
	JMS	TPOTY
	DMYDIS
/
/  BELL AND SCOPE ON ERROR
/
DSJBLS	LAW	207
	JMS	TPOTY
	XCT	EREXIT
/
DJPINS	SUB
	DJP!SUB	3777		/MODIFIED
/
/  ENTER HERE ON STOP CODE INTERRUPT
/
DJSSTP	LAC	DJPINS+1
	DAC	CURLOC		/DJS TO A STOP CODE
	AND	(17777
	TAD	(400001		/ADDRESS OF DJS+1+BIT0 SET=ASR READING
	DAC	ASRCMP		/SAVE FLIP FLOP ON 1 SETS BIT 0
	LAC*	CURLOC
	TAD	(1
	AND	(17777
	DAC	EXPTED		/STOP CODE ADDRESS+1=DAC ON INTERRUPT
	IDRA			/READ THE DAC
	AND	(17777
	DAC	ACTUAL
	SAD	EXPTED		/COMPARE DAC READING
	SKP			/OK
	JMP	DJSERR		/ERROR
	IDSC			/READ ASR
	DAC	ASRRED
	SAD	ASRCMP		/COMPARE ASR READING
	SKP			/OK
	JMP	ERROR
	IDCF
	ISZ	0
	DISMIS
/
DJSERR	IDSC			/READ ASR
	DAC	ASRRED
	JMP	ERROR
/
/  DJS TEST
/
DJSTST	XX
/
/  FILL INSTRUCTION TABLE WITH DJS'S TO SPECIFIED STOP CODES
/  FORMAT:
/ 3777/	DJS	13762
/ 4000/	DJS	13763
/ 4001/	DJS	13764
/
	JMS	FILLTAB
	DJS	13762		/ 1ST SPECIFIED ADDRESS
	3777			/ 1ST ADDRESS INSTR TABLE
	7777			/LAST ADDRESS INSTR TABLE
/
/  FILL A TABLE WITH STOP CODES
	JMS	FILBUF
	STPINT			/STOP CODE
	10000			/ 1ST ADDRESS
	17762			/LAST DDDRESS
/
/  SET ERROR INDIICATOR ROUTINES FOR DJS TEST
/
	LAC	(JMP DJPHLT
	DAC	HLTLX		/HLT
	LAC	(JMP DJSPNT
	DAC	PRNTLX		/PRINT
	LAC	(JMP DJSNST
	DAC	PNTSPX		/PRINT AND HALT
	LAC	(JMP DJSSCP
	DAC	SCOPEX		/SCOPE
	LAC	(JMP DJSNSP
	DAC	PNSCPX		/SCOPE AND PRINT
	LAC	(JMP DJSBEL
	DAC	BELLEX		/BELL
	LAC	(JMP DJSBLS
	DAC	BELSPX		/BELL AND SCOPE
	LAC	(JMP CURIN2
	DAC	EREXIT		/RETURN FROM ERROR ROUTINE
/
/  SET UP INTERRUPT ANSWER FOR DISPLAY STOP CODE
/
	LAC	(JMP DJSSTP
	DAC	STPCOD
/
/  INITIALIZE AND DO DJS TEST
/
	LAC	(DJS!SUB 3777
	DAC	DJPINS+1
CURIN2	LAW	DJPINS
	IDLA			/START DISPLAY
	JMP	.		/WAIT FOR DISPLAY
	ISZ	DJPINS+1
	LAC	DJPINS+1
	SAD	(DJP!SUB 7777
	JMP	DJSVRS		/REVERSE TABLES
	JMP	CURIN2
	.EJECT
/  DDS TEST
/
DDSTST	XX
/
/  FILL INSTRUCTION TABLE WITH 'DDS!SUB STPDDS'
/
	JMS	FILBUF
	DJS!SUB	STPDDS		/DATA
	3777			/START ADDRESS
	7777			/END ADDRESS
/
/  FILL A TABLE WITH ZERO'S
/
	JMS	FILBUF
	0			/DATA
	13762			/START
	17762			/END
/
/  SET UP ERROR INDICATOR ROUTINE FOR DDS TEST
/
	LAC	(JMP DJPHLT
	DAC	HLTLX		/HLT
	LAC	(JMP DDSPNT
	DAC	PRNTLX		/PRINT
	LAC	(JMP DDSNST
	DAC	PNTSPX		/PRINT + HLT
	LAC	(JMP DDSSCP
	DAC	SCOPEX		/SCOPE
	LAC	(JMP DDSNSP
	DAC	PNSCPX		/SCOPE + PRINT
	LAC	(JMP DDSBEL
	DAC	BELLEX		/BELL
	LAC	(JMP DDSBLS
	DAC	BELSPX		/BELL + SCOPE
	LAC	(JMP CURIN4
	DAC	EREXIT		/RETURN FOR LOOPING WHEN ERROR
/
/  SET UP INTERRUPT ANSWER FOR DISPLAY STOP CODE
/
	LAC	(JMP DDSSTP
	DAC	STPCOD
/
/  INITIALIZE AND DO DDS TEST
/
	LAC	(DJP!SUB 3777
	DAC	STRDDS+1
	LAC	(DDS 13762
	DAC	STPDDS
CURIN4	LAW	STRDDS
	IDLA			/START DISPLAY
	JMP	.		/WAIT FOR STOP CODE
	ISZ	STRDDS+1
	ISZ	STPDDS
	LAC	STRDDS+1
	SAD	(DJP!SUB 7777
	JMP	DDSVRS		/REVERSE TABLES AND DO SAME
	JMP	CURIN4
/
/  REVERSE TABLES AND DO SAME
/
DDSVRS	JMS	FILBUF
	DJS!SUB STPDDS		/DATA
	13762			/START ADDRESS
	17762			/END ADDRESS
	JMS	FILBUF
	0
	3777
	7777
	LAC	(JMP CURIN5
	DAC	EREXIT
	LAC	(DJP!SUB 13762
	DAC	STRDDS+1
	LAC	(DDS 3777
	DAC	STPDDS
CURIN5	LAW	STRDDS
	IDLA
	JMP	.
	ISZ	STRDDS+1		/INDEX 'DJP' INSTRUCTION
	ISZ	STPDDS		/INDEX 'DDS' INSTRUCTION
	LAC	STRDDS+1
	SAD	(DJP!SUB 17762
	JMP*	DDSTST
	JMP	CURIN5
/
STRDDS	SUB
	DJP!SUB	3777		/MODIFIED
/
STPDDS	DDS	13762		/MODIFIED
	STPINT
/
/  ENTER HERE ON STOP CODE INTERRUPT
/
DDSSTP	LAC	STRDDS+1		/DJS INSTRUCTION ADDRESS
	TAD	(1		/DJS ADDRESS+1=DDS STORED RETURN ADDRESS
	AND	(17777		/ADDRESS PORTION ONLY
	XOR	(DJP		/EQUALS DDS STORED INSTRUCTION
	SAD*	STPDDS		/COMPARE
	SKP			/OK
	JMP	DDSERR		/ERROR
	IDCF
	ISZ	0		/ESCAPE FROM 'JMP .'
	DISMIS
/
DDSERR	DAC	EXPTED		/EXPECTED DDS STORED INSTRUCTION
	LAC*	STPDDS
	DAC	ACTUAL		/ACTUAL DDS STORED INSTRUCTION
	IDSC
	DAC	ASRRED		/ASR READING AT ERROR
	JMP	ERROR		/ERROR INDICATING ROUTINE
	.EJECT
/	  PART II
/
/  PRINT FOR DDS TEST ERROR
/
DDSPNT	JMS	DDSTYP		/DDS ERROR FORMAT PRINT
	DMYDIS
/
/  PRINT AND HLT FOR DDS TEST ERROR
/
DDSNST	JMS	DDSTYP
	HLT
	XCT	EREXIT
/
/  SCOPE FOR DDS TEST ERROR
/
DDSSCP	XCT	EREXIT
/
/  PRINT AND SCOPE (LOOP)
/
DDSNSP	JMS	DDSTYP
	XCT	EREXIT
/
/  BELL ON DDS ERROR
/
DDSBEL	LAW	207
	JMS	TPOTY
	XCT	EREXIT
/
/  DDS ERROR FORMAT PRINT
DDSTYP	XX
	TYPE.
	.ASCII	'DDS TO LOC.'<0>
	LAC	STPDDS
	STL
	JMS	TYPBIN
	TYPE.
	.ASCII	'EXP.'
	LAC	EXPTED
	CLL
	JMS	TYPBIN
	TYPE.
	.ASCII	'ACT.'
	LAC	ACTUAL
	CLL
	JMS	TYPBIN
	TYPE.
	.ASCII	'ASR'
	LAC	ASRRED
	CLL
	JMP	TYPBIN
	TYPE.
	.ASCII	<15><12>
	JMP*	DDSTYP
/
/  FILL CALLED BUFFER WITH CALLED DATA
/  CALL:	/DATA TO BE PUT IN BUFFER
/		//FIRST ADDRESS OF BUFFER, INCLUSIVE
		/LAST ADDRESS OF BUFFER, INCLUSIVE
/
FILBUF	XX
	LAC*	FILBUF
	ISZ	FILBUF
	DAC	SAVDAT		/DATA TO BE STORED
	LAW	-1
	TAD*	FILBUF		/FIRST ADDRESS
	ISZ	FILBUF
	DAC*	(AUTO16
	LAC*	FILBUF		/LAST ADDRESS
	ISZ	FILBUF		/STEP PAST LAST ARGUMENT
	DAC	LSTADS
FB1	LAC	SAVDAT
	DAC*	AUTO16		/PUT DATA AWAY
	LAC*	(AUTO16
	SAD	LSTADS		/END OF BUFFER YET?
	JMP*	FILBUF		/LEAVE AT END OF BUFFER
	JMP	FB1		/NO
/
/  FILL A CALLED TABLE WITH DJP'S AND SUB'S
/  CALL:	/1ST ADDRESS 'DJP' IS REFERENCED TO
		/START ADDRESS OF TABLE
		/END ADDRESS OF TABLE
/
FILDJP	XX
	LAC*	FILDJP
	ISZ	FILDJP
	DAC	FSTDTA
	LAW	-1
	TAD*	FILDJP
	ISZ	FILDJP
	DAC*	(AUTO16
	LAC*	FILDJP
	ISZ	FILDJP
	DAC	LSTADS
FDJP1	LAC	(SUB
	DAC*	AUTO16
	LAC	FSTDTA
	DAC*	AUTO16
	ISZ	FSTDTA
	LAC*	(AUTO16
	SAD	LSTADS
	JMP*	FILDJP		/LEAVE WHEN DONE
	JMP	FDJP1
/
/  FILL THE INSTRUCTION TABLE WITH CALLED DATA, INDEXING EACH WORD
/  CALL:	/DATA FOR TABLE (INDEXED EACH TIME)
		/STARTING ADDRESS
		/ENDING ADDRESS
/
FILLTAB	0
	LAC*	FILLTAB
	ISZ	FILLTAB
	DAC	DATA
	LAW	-1
	TAD*	FILLTAB
	ISZ	FILLTAB
	DAC*	(AUTO16
	LAC*	FILLTAB
	ISZ	FILLTAB
	DAC	LSTADR
FT1	LAC	DATA
	DAC*	AUTO16
	LAC*	(AUTO16
	SAD	LSTADR
	JMP*	FILLTAB		/RETURN WHEN DONE
	ISZ	DATA
	JMP	FT1
/
/  ENTER HERE ON ERROR
/
ERROR	LAC*	(0		/SET UP DUMMY DISMIS
	DAC	SAVE0
	ISZ	SAVE0		/ESCAPE FROM 'JMP .'
	LAC	ACSAVE
	DAC	DYSAVE
	IDCF
	ION
	LAS		/TEST AC SWS FOR ERROR INDICATION
	RAL
	SZL
HLTLX	NOP			/HALT ON DJP ERROR - MODIFIED
	RAL
	SZL
PRNTLX	NOP			/PRINT - MODIFIED
	RAL
	SZL
PNTSPX	NOP			/PRINT AND HALT - MODIFIED
	RAL
	SZL
SCOPEX	NOP			/SCOPE - MODIFIED
	RAL
	SZL
PNSCPX	NOP			/PRINT AND SCOPE - MODIFIED
	RAL;	SZL
BELLEX	NOP			/BELL - MODIFIED
	RAL;	SZL
BELSPX	NOP			/BELL AND SCOPE - MODIFIED
	DMYDIS			/NO ERROR BITS UP - CONTINUE WITH TEST
/
/  ERROR MESSAGE FORMAT PRINT OUT
/
MES1	XX
	LAC	CURLOC
	STL
	JMS	TYPBIN		/TYPE ADDRESS PORTION IN BINARY
	TYPE.
	.ASCII	'EXP.'
	LAC	EXPTED
	STL
	JMS	TYPBIN
	TYPE.
	.ASCII	'ACT.'
	LAC	ACTUAL
	STL
	JMS	TYPBIN
	TYPE.
	.ASCII	<15><12>
	JMP*	MES1
/
MES2	XX
	TYPE.
	.ASCII	'ASR'<15><12>'EXP.'<0>
	LAC	ASRCMP		/EXPECTED ASR READING
	CLL			/TYPE 18 BITS
	JMS	TYPBIN
	TYPE.
	.ASCII	'ACT.'
	LAC	ASRRED
	CLL
	JMS	TYPBIN
	TYPE.
	.ASCII	<15>,12>
	JMP*	MES2
/
/  ADDITIONAL TEST OF 347 USING 340 SCOPE
/
/  DISPLAY FRAME AROUND EDGE OF SCOPE FACE WHILE CHECKING DISPLAY REGISTERS
/
/  CHECK SAVE FF AFTER EXCAPE ON A 'DJS'
/
SCPTST	DZM	LOPHLT		/SET LOOP - HLT FLAGS
	LAC	(JMP	STOP1
	DAC	STPCOD
	LAC	(FRAME1
	IDLA
	JMP	.
/
/  CHECK ASR ON A 'DJP' (ASR SHOULD NOT CHANGE)
/
	LAC	(JMP STOP2
	DAC	STPCOD
	IDSC
	DAC	REDSAV		/SAVE CONTENTS OF ASR
	LAW	FRAME2
	IDLA
	JMP	.
/
/  CHECK SAVE FF AFTER A 'DDS'
/
	LAC	(JMP STOP3
	DAC	STPCOD
	LAW	FRAME3
	IDLA
	JMP	.
/
/  CHECK SAVE FF AFTER A 'DJS'
/
	LAC	(JMP STOP4
	DAC	STPCOD
	LAW	FRAME4
	IDLA
	JMP	.
/
/  CHECK SAVE FF AFTER AN 'IDLA' (FF SHOULD BE CLEARED)
	LAC	(JMP SECSP4
	DAC	STPCOD
	LAW	FRAME4+2
	IDLA
	JMP	.
/
/  TEST RESTORATION OF DAC FROM ASR
/
	JMS	ASRDAC
	JMP	GETSW
/
FRAME1	SUB	LPOFF!S0!I7
	DJS!PT	.+2
	STPINT
	VPT	0
	VCON	0		/VECTOR CONTINUE, X=0
	VCTR	177,0,1,1
	STPINT
/
STOP1	IDSC			/READ SAVE REGISTER
	SMA			/BIT  0 IS STATUS OF SAVE FF
	JMP	STP1OK		/SAVE FF=0; OK
	JMS	SETDMY		/SET UP DUMMY DISMIS
	LAC	LOPHLT		/HLT OR LOOP
	SZA
	JMP	FM1LOP
	TYPE.
	.ASCII	'SAVE FLIP FLOP IS SET ON ESCAPE AFTER A DJS'<0>
	HLT
FM1LOP	JMP	LOOP		/LOOP IN ERROR
/
STP1OK	ISZ	0		/ESCAPE FROM 'JMP .'
	IDCF
	DISMIS
/
FRAME2	SUB	LPOFF!S0!I7
	DJP!PT	.+1
	PT!VCON	0
	VCTR	0,177,1,1
	STPINT
/
STOP2	IDSC
	SAD	REDSAV		/COMPARE AGAINST PREVIOUS ASR READING
	JMP	STP1OK
	JMS	SETDMY
	LAC	LOPHLT
	SZA
	JMP	FM2LOP
	TYPE.
	.ASCII	'ASR CHANGED ON DJP'<0>
	HLT
FM2LOP	JMP	LOOP		/LOOP ON ERROR
/
/  SET UP SECOND LEVEL DISMIS
/
SETDMY	XX
	LAC*	(0
	DAC	SAVE0
	LAC	ACSAVE
	DAC	DYSAVE
	IDCF
	ION
	JMP*	SETDMY
/
/  LOOP ON ERROR SECTION
/
LOOP	IDCF			/CLEAR DISPLAY FLAGS
	LAW	-2
	TAD	SAVE0
	DAC	SAVE0		/INTERRUPT RETURN-2
	CLC
	DAC	LOPHLT		/SET LOOP-HLT FLAG TO LOOP
	LAS			/CHECK BIT 17
	RAR
	SNL
	JMP	BEGIN		/EXIT ERROR LOOP
	DMYDIS			/LOOP ON ERROR
/
FRAME3	SUB
	DJS!SUB	.+2
	STPINT
	DDS!PT	F3B
	VPT	1777
	VCON	1777
	VCTR	-177,0,1,1
	PT
	VCON	1777
	VCTR	0,-177,1,1
	STPINT
F3B	0
/
STOP3	IDSC			/READ SAVE REGISTER
	SMA			/CHECK SAVE FLOP STATUS
	JMP	STP1OK
	JMS	SETDMY
	LAC	LOPHLT
	SZA
	JMP	FM3LOP
	TYPE.
	.ASCII	'SAVE FF NOT CLEARED ON DDS.'<0>
	HLT
FM3LOP	JMP	LOOP		/LOOP ON ERROR
/
FRAME4	SUB
	DJS	.+1
	STPINT
/
STOP4	IDSC
	SPA
	JMP	STP1OK
	JMS	SETDMY
	LAC	LOPHLT
	SZA
	JMP	FM4LOP
	TYPE.
	.ASCII	'SAVE FF NOT SET ON DJS'<0>
	HLT
FM4LOP	JMP	LOOP		/LOOP ON ERROR
/
SECSP4	IDSC
	SMA
	JMP	STP1OK
	JMS	SETDMY
	LAC	LOPHLT
	SZA
	JMP	SC4LOP
	TYPE.
	.ASCII	'SAVE FF NOT CLEARED ON IDLA'<0>
	HLT
SC4LOP	JMP	LOOP		/LOOP ON ERROR
/
/  RESTORATION OF DAC FROM ASR TEST (ALL BITS)
/
ASRDAC	XX
	LAC	(JMP STPASR	/EXECUTED ON STOP CODE INTERRUPT
	DAC	STPCOD
	LAW	13776		/START ADDRESS OF TABLE
	STORET			/STORE FOLLOWING TABLES
	SUB			/STORED IN LOCATION 13776
	DJS!VCON ESCVCT		/13777
	STPINT			/14000 - ADDRESS RESTORED TO DAC FROM ASR
	0			/END OF TABLE CODE
	LAW	13776
	IDLA			/START DISPLAY
	JMP	.		/WAIT FOR STOP CODE
	LAC	(JMP SPASR1
	DAC	STPCOD
	LAW	3775
	STORET			/STORE FOLLOWING TABLE
	SUB			/STORED IN LOCATION 3775
	DJS!VCON ESCVCT		/3376
	STPINT			/3777 - ADDRESS RESTORED TO DAC FROM ASR
	0			/END OF TABLE CODE
	LAW	3775
	IDLA			/START DISPLAY
	JMP	.		/WAIT FOR STOP CODE
	JMP*	ASRDAC
/
ESCVCT	VCTR	177,0,0,1
	STPINT
/
/  ENTER HERE ON 1ST STOP CODE
/
STPASR	IDSC		/READ DAC
	SAD	(14001		/DAC = (TO STOP + 1) WHEN DISPLAY STOPPED
	JMP	STP1OK		/OK
	TAD	(-1		/ERROR
	DAC	ACTUAL		/ACTUAL ADDRESS RESTORED TO DAC FROM ASR
	LAC	(14000		/EXPECTED ADDRESS
	DAC	EXPTED
SASR1	JMS	SETDMY		/SET UP DUMMY DISMIS
	LAC	LOPHLT
	SZA
	JMP	LOOP
	TYPE.
	.ASCII	'DAC RESTORED FROM ASR AFTER ESCAPE WITH FF S'
	.ASCII	'ET'<15><12>'EXP.'<0>
	LAC	EXPTED
	CLL
	JMS	TYPBIN		/TYPE CONTENTS OF ACTUAL LOCATION IN BINARY
	TYPE.
	.ASCII	'ACT.
	LAC	ACTUAL
	CLL
	JMS	TYPBIN		/TYPE CONTENTS OF ACTUAL LOCATION IN BINARY
	TYPE.
	.ASCII	<15><12>
	HLT
	JMP	LOOP		/LOOP ON ERROR
/
/  ENTER HERE ON 2ND STOP CODE
/
SPASR1	IDSC
	SAD	(4000
	TAD	(1-
	JMP	STP1OK		/OK
	DAC	ACTUAL		/ERROR
	LAC	(3777
	DAC	EXPTED
	JMP	SASR1		/TYPE ERROR
/
/  STORE CALLED INFORMATION
/  ENTER WITH BEGINNING ADDRESS IN AC
/  CALL:	/TABLE OF DATA TERMINATED WITH 0
STORET=JMS .
STORIT	XX
	TAD	(-1
	DAC*	(AUTO16
STGET	LAC*	STORIT
	SNA			/0 = END CODE
	JMP	.+4
	DAC*	AUTO16
	ISZ	STORIT
	JMP	STGET
	ISZ	STORIT
	JMP*	STORIT
/
/  TYPE A NUMBER IN BINARY
/  ENTER WITH NUMBER IN AC
/  ENTER WITH LINK SET: TYPE 13 BIT ADDRESS ONLY
/  ENTER WITH LINK CLEARED: TYPE 18 BITS
/
TYPBIN	XX
	DAC	LOCTYP		/ADDRESS TO BE TYPED
	SZL
	JMP	ADDONY		/ADDRESS PORTION ONLY
	LAW	-22		/ALL 18 BITS
	DAC	TYPCNT		/NUMBER OF CHARS TO BE TYPED
	LAW	-3
	DAC	OCTCNT		/OCTAL SPACE COUNTER
	LAC	LOCTYP
	JMP	RETURN
/
ADDONY	LAW	-15		/TYPE 13 ADDRESS BITS
	DAC	TYPCNT
	LAW	-1
	DAC	OCTCNT		/OCTAL SPACE AFTER 1ST BIT
	LAC	LOCTYP
	CLL
	ROTATE;	5		/ROTATE AC 5 PLACES LEFT
	AND	(777740
RETURN	RAL
	DAC	LOCTYP
	SNL
	JMS	TYPE0		/TYPE 0 RETURN+1
	JMS	TYPE1		/TYPE 1
	ISZ	OCTCNT		/SEE IF SPACE SHOULD BE TYPED
	SKP
	JMS	TYPSPA		/TYPE SPACE ON OCTAL COUNT
	ISZ	TYPCNT		/SEE IF FINISHED
	SKP
	JMP*	TYPBIN
	LAC	LOCTYP
	JMP	RETURN
/
TYPE0	XX			/TYPE CHAR 0
	LAW	60
	JMS	TPOTY
	ISZ	TYPE0		/RETURN+1
	JMP*	TYPE0
/
TYPE1	XX			/TYPE CHAR 1
	LAW	61
	JMS	TPOTY
	JMP*	TYPE1
/
TYPSPA	XX
	LAW	40		/TYPE A SPACE
	JMS	TPOTY
	LAW	-3
	DAC	OCTCNT		/RESET OCTAL COUNTER
	JMP*	TYPSPA
/
/  TYPE MESSAGES
/  CALL:	/MESSAGE PACKED 3 TO A WORD IN TELETYPE (BAUDOT) CODE
		/END OF MESSAGE CODE=00 OCTAL
/
TYPE.=JMS .
TYPE	XX
	LAW	-1
	TAD	TYPE		/1ST ADDRESS OF MESG
	DAC*	(AUTO15
	LAW	-3
	DAC	CHRCT		/CHARACTER COUNTER
	LAC*	AUTO15
	ROTATE;	6		/ROTATE AC 6 PLACES LEFT
	DAC	CHRS3
	AND	(37
	SNA			/ZERO=END OF MESG
	JMP*	AUTO15		/EXIT
	TAD	(LAC BTATAB-1	/CODE CONVERSION TABLE
	DAC	.+1
	LAC	BTATAB		/MOCIFIED
	SZL
	JMP	.+3		/CONVERT UPPER CASE CODE
	JMS	TPOTY		/TYPE CHAR
	JMP	.+4
	ROTATE; -9		/ROTATE AC 9 PLACES RIGHT
	JMP	.+4
	ISZ	CHRCT
	SKP
	JMP	TYPE+4
	LAC	CHRS3
	JMP	TYPE+7
/
/  TYPE ONE CHARACTER
/
TPOTY	XX
	TLS
	JMP	.
	JMP*	TPOTY
/
/  ENTER HERE ON TELETYPE INTERRUPT
/
TYNT.	TCF
	ISZ	0
	DISMIS
/
/  TELETYPE CONVERSION TABLE
/
BTATAB	265324		/5,T
	215215		/CARRIAGE RETURN
	271317		/9,O
	240240		/SPACE
	243310		/*,H
	254316		/,,N
	256315		/.,M
	212212		/LINE FEED
	251314		/),L
	264322		/4,R
	246307		/+,G
	270311		/8,I
	260320		/0,P
	272303		/',C
	273326		/,,V
	263305		/3,E
	242332		/$,Z
	244304		/%,D
	277302		/?,B
	211323		/BELL,S
	266311		/6,Y
	241306		/^,F
	257330		//,X
	255301		/-,A
	262327		/2,W
	377377		/FIGURES
	267325		/7,U
	261321		/1,Q
	250313		/(,K
	377377		/LETTERS
/
/  ROTATE THE AC
/  CALL:	NUMBER OF TIMES TO RATATE
/		RETURN
/  POSITIVE NUMBER FOR LEFT ROTATE; ONE'S COMPLEMENT FOR RIGHT ROTATE
/
ROTATE=JMS .
ROT8	XX
	DAC	ROTSAV
	LAC*	ROT8
	SPA
	JMP	ROTR
	CMA
	DAC	ROTCTR
	LAC	(RAL
	DAC	DOROT8
	JMP	.+4
ROTR	DAC	ROTCTR
	LAC	(RAR
	DAC	DOROT8
	LAC	ROTSAV
	ISZ	ROTCTR
	SKP
	JMP	.+3
DOROT8	XX			/MODIFIED RAR OR RAL
	JMP	.-4
	ISZ	ROT8
	JMP*	ROT8
/
/  VARIABLE STORAGE
/
ACSAVE;SAVE0;ACTUAL;ASRCMP;ASRRED;CHRCT;CHRS3;CURLOC;DYSAVE;EXPTED
OCTCNT;REDSAV;ROTCTR;ROTSAV;SAVDAT;SAVSWS;TYPCNT
	.END	BEGIN