C	PROGRAM ISOL1.FT
C	----------------
C
C	###SUBROUTINE ISOL1
C
C
C	PETER LEMKIN
C	IMAGE PROCESSING UNIT, DCBD
C	NATIONAL CANCER INSTITUTE
C	NATIONAL INSTITUTES OF HEALTH
C	9000 ROCKVILLE PIKE
C	BETHESDA, MD. 20014
C
C	NOV 30, 1977
C	NOV 29, 1977
C	NOV 28, 1977
C	OCT 11, 1977
C	SEPT 16, 1977
C	SEPT 11, 1977
C	SEPT 9, 1977
C	SEPT 8, 1977
C	AUG 24, 1977
C
C	INTRODUCTION
C	------------
C	TAKE THE CC MIN RECT LIST IN IBUF1-4 AND FIND ALL POTENTIAL
C	ISOLATEABLE PAIRS OF CC'S CONNECTED BY 1'S BY MOVING
C	A WINDOW BETWEEN CCi and CCj LOOKING FOR A MINIMUM WHICH
C	IS NON-ZERO. ALSO USE OTHER METRIC MEASURES TO SAVE OR REJECT
C	[I,J] POTENTIAL PAIRS.

C	EVALUATE THE MINIMUM RECTANGLE LIST IN IBUF1-4 FOR ALL [I,J] PAIRS
C	TO DETERMINE WHETHER A PARTICULAR [I,J] HAS A VALID LINE OF 1'S 
C	CONNECTING CCi WITH CCj. A PAIR IS STAID TO BE A POTENTIAL [I,J]
C	SPLIT PAIR IF VARIOUS HEURISTIC FEATURES ARE TRUE. THE BASIC
C	ALGORITHM IS AS FOLLOWS:
C
C		MEANDIA_((HOR(CCI)+VERT(CCI))/2) + ((HOR(CCJ)+VERT(CCJ))/2)
C		IUNCONNECTED_1; LCNT_0; MODEZERO_0;
C		FOR ALL I1k 8-NEIGH (X,Y) ON LINE[CCi:CCj] DO
C			BEGIN "EVALUATE POINTS ON TEST LINE"
C			END "EVALUATE POINTS ON TEST LINE";
C
C
C
C	ARGUMENTS
C	---------
C	IVAL - NCMAX (MAX CC #)
C	IBUF1 - IY1(CC)
C	IBUF2 - IY2(CC)
C	IBUF3 - IX1(CC)
C	IBUF4 - IX2(CC)
C
C	FBW4 DEBUG SWITCHES
C	-------------------
C	2000	[2.6] III,JJJ, MIN WIND III, MIN WIND JJJ, DISTANCES ETC
C	OPDEFS
C	------
C
S	OPDEF	RIF	6224
S	OPDEF	DMAGO	6070
S	SKPDF	DMASKP	6071
S	OPDEF	DMAWC	6072
S	OPDEF	DMACA	6073
S	OPDEF	DMACLR	6074
S	OPDEF	EXDMA1	6524
S	OPDEF	EXDMA2	6525
C
C
S	OPDEF	LQDT1 6375
S	OPDEF	LQDT2 6376
C
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
S	OPDEF	DISP1	6435
S	OPDEF	DISP2	6436
C
C
S	OPDEF	SHL	7413
S	OPDEF	MUY	7405
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF   KRS	6034
S	OPDEF	BSW	7002
C
C
S	OPDEF 	LDXP	6443
S	OPDEF	LDYP	6444
C
C	[1] ENTRY
S	ENTRY ISOL1
S	CPAGE 2
S ISOL1,	BLOCK 2
C
C	GET THE CC MAX
	NCMAX=IVAL
C
C	DEFINE BMOMNI CALLS
C@	MMOVE=2
C@	MDRAW=3
C
C
C
C	[2] RUN THROUGH THE PAIRS OF CC'S AND DO THE ISOLATION TEST
C	AFTER DRAW LINE SEGMENT IN IH AND ON SCREEN IF /T
C	ON BMJ'
	ITSW=ISW(20)
C
	NCM1=NCMAX-1
C
	DO 200 III=2,NCM1
	J1=III+1
C
	DO 200 JJJ=J1,NCMAX
	IZ=IBCD(III,-1)
S	TAD \IZ
S	DISP1
C
	IZ=IBCD(JJJ,-1)
S	TAD \IZ
S	DISP2
C
C
C	[2.1] GET THE TWO COORDINATE PAIRS
C	NOTE: COORDINATE VALUES ARE [1:256] RATHER THAN [0:255]
	IX1=IBUF3(III)
	IX2=IBUF4(III)
S	TAD \IX1
S	TAD \IX2
S	CLL RAR /DIVIDE BY 2
S	DCA \LX1
C
	IY1=IBUF1(III)
	IY2=IBUF2(III)
S	TAD \IY1
S	TAD \IY2
S	CLL RAR /DIVIDE BY 2
S	DCA \LY1
C
C	COMPUTE MEAN DIAMETER
	IA=((IX2-IX1)+(IY2-IY1))
S	TAD \IA
S	CLL RAR /DIVIDE BY 2
S	DCA \IA
C
C
	IX1=IBUF3(JJJ)
	IX2=IBUF4(JJJ)
S	TAD \IX1
S	TAD \IX2
S	CLL RAR /DIVIDE BY 2
S	DCA \LX2
C
	IY1=IBUF1(JJJ)
	IY2=IBUF2(JJJ)
S	TAD \IY1
S	TAD \IY2
S	CLL RAR /DIVIDE BY 2
S	DCA \LY2
C
C	COMPUTE MEAN DIAMETER
	IB=((IX2-IX1)+(IY2-IY1))
S	TAD \IB
S	CLL RAR /DIVIDE BY 2
S	DCA \IB
C
	MEANDIA=IA+IB
S	TAD \MEANDIA
S	CLL RAR /"/2"
S	DCA \MEANDIA
C
C
C	[2.2] MAP COORDINATES TO [0:255]
	LX1=LX1-1
	LX2=LX2-1
	LY1=LY1-1
	LY2=LY2-1
C
C
C	[2.3] COMPUTE EUCLIDEAN DISTANCE
	FA=LY2-LY1
	FB=LX2-LX1
	CURSYM=SQRT(FA*FA+FB*FB)
C
C
C	[2.4] COMPUTE LINE FROM I:J
C	NOTE:	MMOVE=2
	CALL BMOMNI(0,0, LX1,LY1,0, 0,2)
	KWC=-1
C	NOTE:   MDRAW=3
	CALL BMOMNI(JBM,1-JHGH,LX2,LY2,KWC,IH,3)
C
C
C	[2.5] ANALYZE GRAY SCALE DATA ON THE LINE IN IH FROM BMI2.
C	IF (EXISTS ZERO 3X3 NEIGHBOR(X,Y) IN LINE IN BMI1) OR
C	   (EXISTS PIXEL K ON LINE IN BMI1 SUCH THAT
C		((K NEQ 1) AND K NEQ III) AND (K NEQ JJJ)))
C		THEN IGNORE I:J PAIR
C		ELSE CONTINUE;
C
C	ZERO THE 1'S COUNTER
	LCNT=0
C
C	ZERO THE 0'S COUNTER
	MODEEZERO=0
C
C	ZERO THE MAX ZERO RUN LENGTH
	MXZRUNLTH=0
C
C	RESET THE WORKING ZERO RUN LENGTH
	IZRUN=0
C
C	SET THE LASTK SEEN TO NULL
	LASTK=-1
C
C	SET FLAG TO BE USED LATER FOR TESTING LINE
C	TO TRUE;
	ICCIJFLAG=1
C
C	SET MAX BMI2 CYTOPLASM VALUE (BMI1=1'S) TO MIN (I.E. -1).
	MODEDMX1IZ=-1
C
	DO 250 ICHAN=1,KWC
C	COMPUTE:	IX=IH(2*ICHAN-1)
C	SETUP AUTOINDEX FOR USE IN FETCHING IH DATA
S	TAD (-2
S	TAD \ICHAN
S	TAD PIH
S	DCA 11
C
S	CPAGE 5
S	DCA \IX /FORCE COMON
S	TADI 11
S	CPAGE 4
S	DCA \IX
C
C	COMPUTE:	IY=IH(2*ICHAN)
S	TADI 11
S	DCA \IY
C
C	FOLLOW WITH CURSOR
S	TAD \IXPOSITION
S	TAD \IX
S	LDXP
C
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C	CPAGE 3
S	JMS TTYCTL
S	JMP \2047 /RETURN NOW!
C
C
C
C	[2.5.1] GETNGH(IBM1,IHGH1,IX,IY)
	MEM=IBM1
	IBYTE=IHGH1
S	JMS GETNGH
C
C
C	[2.5.1.1] SUM THE NEIGHBORHOOD
	K=I10+I11+I12+I13+I14+I15+I16+I17+I18
C
C
C	[2.5.1.2] IF (ALL I1i=0) AND (IZRUN=0 OR LASTK=0)
C			THEN IZRUN_IZRUN+1;
S	TAD \K
S	SZA CLA
S	JMP \1251 /NO
C
S	TAD \IZRUN
S	SNA CLA
S	JMP \1252 /YES
C
S	TAD \LASTK
S	SZA CLA
S	JMP \1251 /NO
C
C	YES, INCREMENT CURRENT ZERO RUN COUNTER
S\1252,	ISZ \IZRUN
S	CLA
C
C	UPDATE LASTK
1251	LASTK=K
C
C
C	[2.5.1.3] FIND THE MAXIMUM SIZE RUN OF ZEROS
C	COMPUTE:	MXZRUNLTH=MAX(IZRUN,MXZRUNLTH)
S	TAD \IZRUN
S	CIA
S	TAD \MXZRUNLTH
S	RAL
S	CLA
S	TAD \IZRUN
S	SZL
S	DCA \MXZRUNLTH /UPDATE THE MAX
S	CLA
C
C
C	[2.5.2] IF (K_(SUM I1i=0))
C		 THEN INCREMENT THE ZERO COUNTER
S	TAD \K
S	SNA CLA
S	ISZ \MODEEZERO
S	CLA
C
C
C	[2.5.3] IF BMI1 CYTOPLASM REGION (1'S)
C			THEN INCREMENT 1'S CTR (I.E. LCNT)
C			 AND GET THE MAX VALUE OF BMI2 CYTOPLASM.
C	IF I18=1
C		THEN LCNT_LCNT+1;
S	CLA CMA
S	TAD \I18
S	SZA CLA
S	JMP \254 /NEQ 1
C
C
C	[2.5.3.1] INCR 1'S COUNTER
S	ISZ \LCNT
S	CLA
C
C
C	[2.5.3.2] GET MAX VALUE OF CORRESPONDING BMI2 PIXEL
C	COMPUTE: MODEDMX1IZ=MAX(IZ<==FETCH(IBM2,IHGH2,IX,IY),MODEDMX1IZ) 
	MEM=IBM2
	IBYTE=IHGH2
S	JMS FETCH2D
C
S	TAD \IZ
S	CIA
S	TAD \MODEDMX1IZ
S	SMA CLA
S	JMP \254 /NOT MAX
	MODEDMX1IZ=IZ
C
C
C	[2.5.4] REMEMBER THE FIRST 1'S PIXEL INDEX AFTER CCi.
C	IF LCNT=1
C		THEN K1ST1=ICHAN, MXZRUNLTH_0, IZRUN_0,
C		     MODEEZERO_0;
S\254,	CLA CMA
S	TAD \LCNT
S	SZA CLA
S	JMP \252 /NO
	K1ST1=ICHAN
	MXZRUNLTH=0
	IZRUN=0
	MODEEZERO=0
C
C
C	[2.5.5] IF I18(BMI1)=JJJ
C		THEN DONE;
	ITTYPLAST1=ICHAN-1
S	TAD \I18
S	CIA
S	TAD \JJJ
S	SNA CLA
S	JMP \259 /DONE, GOTO [2.6]
C
C
C	[2.5.6] RESET 1'S AND 0'S COUNTERS IF SEE III CC.
C	IF ANY (I1i=III)
C		THEN MODEZERO_0 "RESET ZERO COUNTER",
C		     LCNT_0 "RESET ONES'S COUNTER";
C

C	FOR n=0:8 DO K_I1n,
C
252	DO 250 IZ=1,9
S	CLA CMA
S	TAD PI10
S	CPAGE 5
S	TAD \IZ
S	DCA 7
S	TADI 7 /K<==I10(IZ)
S	DCA \K
C
C	IF K=III
C		THEN LCNT_0,MODEEZERO_0;
S	TAD \III
S	CIA
S	TAD \K
S	MQL
C
S	MQA
S	SNA CLA
S	DCA \LCNT
C
S	MQA
S	SNA CLA
S	DCA \MODEEZERO
C
C
C
C	[2.5.7] IF ANY (K<==I1i NEQ (III OR JJJ OR 1 OR 0)
C		THEN ICCIJFLAG_FALSE;
S	TAD \K
S	SNA CLA
S	JMP \250 /CONTINUE, K=0
S	CLA CMA /-1
S	TAD \K
S	SNA CLA
S	JMP \250 /K=1, CONTINUE
C
S	TAD \K
S	CIA
S	TAD \III
S	SNA CLA
S	JMP \250 /=III, CONTINUE
C
S	TAD \K
S	CIA
S	TAD \JJJ
S	SZA CLA
S	DCA \ICCIJFLAG /FALSE SINCE JJJ NEQ K
C
250	CONTINUE
C
C	[2.6] DONE! ANALYZED LINE BETWEEN CENTERS OF [III,JJJ].
C	COMPUTE:   RELATIVE LENGTH #1'S/#0'S.
S\259,	TAD \MODEEZERO
S	SNA
S	IAC
S	DCA \IZ
	IX=LCNT/IZ
C
C	COMPUTE:    TOTAL # ZEROS/MAX ZERO RUN LENGTH
S	TAD \MXZRUNLTH
S	SPA
S	TAD (2 /MAKE 1 IF -1
S	SNA /IF 0 MAKE IT 1
S	IAC
S	DCA \IY
	IY=MODEEZERO/IY
C
C
C	COMPUTE:   #1'S/MEAN DIAMETER
	FILE=FLOAT(LCNT)/FLOAT(MEANDIA)
C
C	COMPUTE:   #1'S/EUCLIDEAN DISTANCE
	DMAX=FLOAT(LCNT)/CURSYM
C
C	IF #1'S/EUCLIDEAN DISTANCE < 10%
C		THEN KURPTSHORT_1 
C		ELSE KURPTSHORT_0;
	KURPTSHORT=0
	DMIN=DMAX-0.10
S	TAD \DMIN
S	SPA CLA
S	IAC /SET TO 1
S	DCA \KURPTSHORT 
C
C
C**************DEBUG*****
S	6344 /FBW4
S	AND (2000
S	SNA CLA
S	JMP \1220 /NO
	WRITE(4,1221)III,JJJ,LX1,LY1,LX2,LY2,CURSYM,LCNT
     1,MODEEZERO,IX
1221	FORMAT('0[',I3,':',I3,'], "1[',I3,',',I3,'], "2[',I3,','
     1,I3,'], EUC.D=',F4.0,', #1=',I3,', #0=',I3,', #1/#0=',I3)
C
	WRITE(4,1223)DMAX,MXZRUNLTH,IY,MEANDIA,FILE,ICCIJFLAG
     1,DMIN,KURPTSHORT(1)
1223	FORMAT(5X,'#1/EUC.D=',F4.2,',MX.0.RN=',I3,', #0/MX.0.RN='
     1,I5,', MN.D=',I3    1,', #1/MN.D=',F4.2,',CNTD=',I1
     2,/,5X,'(#1/EUC.D - 0.10)=',F5.2,', SHORTFLAG=',I1)
1220	CONTINUE
C******************************
C
C
C	[2.7] TEST IF CONNECTED OR DISTANCE BETWEEN OBJECTS [III,JJJ]
C	NOT TOO GREAT.
C	IF (ICCIJFLAG=0) 
C		 OR (MEANDIA < 1.5*LCNT))
C		 OR (MXZRUNLTH > 5)
C		THEN "DO NOT TEST" GOTO [2.1.1]
C		ELSE "TEST" GOTO [2.7.1];
S \260,	CLA CMA
S	TAD \ICCIJFLAG
S	SPA CLA
S	JMP \200 /NO
C
	DMIN=1.5 - DMAX
S	TAD \DMIN
S	SPA CLA
S	JMP \200 /NO
C
C	IF MXZRUNLTH > 5
C		THEN DO NOT PASS TEST
S	TAD (-6
S	TAD \MXZRUNLTH
S	SMA CLA
S	JMP \200 /NO
C
C
C
C	[2.7.1] TEST
C	OK, PASSED TESTS
	WRITE(4,262)III,JJJ,CURSYM,LCNT,DMAX
262	FORMAT('0TEST:[',I3,':',I3,'] DIST=',F7.0
     1,', # 1"S =',I5,', 1"S/DIST=',F7.4)
C
C
C	[2.8] IF /T
C		THEN TRACE LINE IN BMJ'
S\270,	TAD \ITSW
S	SNA CLA
S	JMP \280 /NO
	KWC=255
C	NOTE:    MMOVE=2
	CALL BMOMNI(0,0, LX1,LY1,0, 0,2)
C	NOTE:   MDRAW=3
	CALL BMOMNI(JBM,1-JHGH,LX2,LY2,KWC,IH,3)
C
C
C	[2.9] IF KURPTSHORT=0
C		THEN TEST POTENTIAL [I,J] GRAY SCALE (IN ISOL2)
C		LINE DATA FOR POSSIBLE LIGHT REGIONS PERPENDICULAR TO
C		LINE INDICATING THE DISCONTINUITY.
S\280,	TAD \KURPTSHORT
S	SZA CLA
S	JMP \290 /SHORT VECTOR
C
C	PASS THE MAX CYTOPLASM VALUE ON THE LINE
	IA=MODEDMX1IZ
C
C	USE THE NEW MAXIMUM INDEX AT 1ST POINT OF JJJ
	KWC=ITTYPLAST1
	CALL ISOL2(LX1,LY1,LX2,LY2,ICNUM,ITSW,KWC,IA
     1,IBM1,IHGH1,IBM2,IHGH2,IXPOSITION,IYPOSITION,IH,FC)
C
C
C	[2.9.1] TEST INDEX RETURNED FROM ISOL2.
C	NOTE: IF A SPLIT IS TO BE PERFORMED, THEN THE INDEX
C	OF THE LINE X,Y DATA IS RETURNED IN IA (0 IF NO SPLIT 
C	TO BE PERFORMED) AND THE PERPENDICULAR ANGLE TO [I,J]
C	IS (ETA) RETURNED IN RADIANS IN FC.
C
C
C	IF IA > 0
C		THEN SPLIT
C		ELSE GOTO [2.11]
S	CLA CMA
S	TAD \IA
S	SPA CLA
S	JMP \200 /GOTO [2.11] IGNORE SPLIT
C	GO SPLIT
C	GO DRAW A SPLIT BETWEEN [CCi:CCj] AT INDEX IA.
	CALL ISOL3
	GOTO 200
C
C
C	[2.10] IF KURPTSHORT=1
C		THEN SPLIT THE CYTOPLASM AT (K1ST1+LCNT/2);
S\290,	TAD \LCNT
S	CLL RAR /DIVIDE BY 2
S	TAD \K1ST1
S	DCA \IA
C
C	COMPUTE: ETA=THETA+90
C	SPLIT FROM ETA TO BE COMPUTED FROM FA,FB
	FC=ARCTAN(FA,FB)+1.57079
C	GO DRAW A SPLIT BETWEEN [CCi:CCj] AT INDEX IA.
	CALL ISOL3
C
C
C	[2.11] CONTINUING OR IGNORING I:J PAIR.
200	CONTINUE
C
C
C	[3] RETURN
S \2047,	RETRN ISOL1
C
C	*********************************************************
C	SUBROUTINE:	F E T C H 2 D				*
C	*********************************************************
C	FETCH IZ=BM(MEM&IY&IX,IBYTE);
C
C	FETCH AN 8-BIT BYTE FROM THE SPECIFIED BM
C
C	ARGS IN COMMON FOR SPEED
C	------------------------
C	MEM - BM NUMBER 0 TO 7
C	IBYTE - 0 (LOW), 1 FOR HIGH BYTE OF 16 BIT BYTE
C	IX - XADDR , 0 TO 255
C	IY - YADDR, 0 TO 255
C	IZ - RESULT.
C
S	CPAGE 3
S RFETCH2D,	JMP I FETCH2D
S FETCH2D,	0
C
C
C	[1] INITIALIZE PDP8/E REGISTERS
S	DMACLR
S	TAD PBUFF	/BUFFER POINTER
S	DMACA		/LOAD ADDRESS REGISTER
S	CLA CLL IAC RAL		/2 WORDS
S	DMAWC		/LOAD WORD COUNT REGISTER
C
C
C	[2] SET UP I/O DEVICE ADDRESS REGISTERS
C
S	TAD \MEM	
S	CLL RTL; RTL	/MOVE BITS [9:11] ==> [5:7]
S	MQL
S	TAD \IY
S	CLL RTR; RTR		/MOVE BITS [4:7] ==> [8:11]
S	AND (0017
S	MQA
S	EXDMA1			/HIGH-ORDER WORD
C
S	TAD \IY
C@S	CLL RTR; RTR; RAR	/MOVE BITS [8:11] ==> [0:3]
S	BSW; RTL /ALTERNATE MICROCODE
S	AND (7400
S	TAD \IX
S	EXDMA2			/LOAD LO-ORDER WORD
C
C
C	[3] EXECUTE COMMAND
C
S	RIF			/GET CURRENT DATA FIELD FOR READ
S	DMAGO			/DO IT!
S	DCA 7 /ZERO COUNTER
C
S RBM,	DMASKP		/WAIT 'TIL DONE
S	SKP
S	JMP F2D4 /DONE WITH I/O
S	ISZ 7
S	JMP RBM /NOT YET
S	JMP \100 /OVERFLOW
C
C
C	[4] GET 8 BIT WORD FROM 16 BIT DATA
C
S F2D4,	TAD \IBYTE	/=1 FOR HIGH PACKING, =0 FOR LOW PACKING
S	SZA CLA
S	JMP GETHIGH
C
C
C	[4.1] GET LOW BYTE
S	TAD BUFF
S	AND (0377
S	DCA \IZ
S	JMP RFETCH2D		/DONE, RETURN
C
C
C		[4.2] GET HIGH BYTE
S GETHIGH,	TAD BUFF
S	MQL
S	TAD BUFF#
S	CPAGE 2
S	SHL
S	3 /LEFT SHIFT 4 BITS
S	AND (377
S	DCA \IZ	/STORE IT
S	JMP RFETCH2D	/DONE, RETURN
C
C
C
C	[5.] FATAL BM DMA TIMEOUT ERROR
S\100,	CLA
S	DMACLR
	WRITE(1,101)
101	FORMAT('ISOL1 DMA TIMEOUT ERROR, RE-BOOT THE SYS:!')
S	HLT
	GOTO 100
C
C	BUFFER
S PBUFF,	BUFF
S	CPAGE 2
S BUFF,	BLOCK 2
C
C
C	*********************************************************
C	*SUBROUTINE    G E T N G H
C	********************************************************
C	FETCH 3X3 NEIGHBORHOOD INTO I10(1:9) FROM (MEM,IBYTE)
C
S	CPAGE 3
S RGETNGH,	JMP I GETNGH
S GETNGH,	0 /ENTRY
C
C
C
C	[1] 9 PIXEL 3X3 NEIGHBORHOOD FETCH 
C	SAVE IX,IY
	KX=IX
	KY=IY
C
C
C	[1.1] FETCH POINTS ON LINE Y-1
S	CLA CMA
S	TAD \KY
S	DCA \IY
C
S	CLA CMA
S	TAD \KX
S	DCA \IX
C
S	JMS FETCH2D
	I13=IZ
C
S	INC \IX
S	JMS FETCH2D
	I12=IZ
C
S	INC \IX
S	JMS FETCH2D
	I11=IZ
C
C
C	[1.2] FETCH POINTS ON LINE Y
S	INC \IY
C
S	CLA CMA
S	TAD \KX
S	DCA \IX
C
S	JMS FETCH2D
	I14=IZ
C
S	INC \IX
S	JMS FETCH2D
	I18=IZ
C
S	INC \IX
S	JMS FETCH2D
	I10=IZ
C
C
C	[1.3] FETCH POINTS ON LINE Y+1
S	INC \IY
C
S	CLA CMA
S	TAD \KX
S	DCA \IX
C
S	JMS FETCH2D
	I15=IZ
C
S	INC \IX
S	JMS FETCH2D
	I16=IZ
C
S	INC \IX
S	JMS FETCH2D
	I17=IZ
C
C	RESET IX,IY
	IX=KX
	IY=KY
C
S	JMP RGETNGH
C	************************************************************
C	SUBROUTINE:	T T Y C T L	(INTERNAL)
C	************************************************************
C
S	CPAGE 3
S RTTYC,	JMP I TTYCTL
S TTYCTL,	0000	/ENTRY
C
S	KSF	/ANYTHING TYPED
S	JMP NORMAL	/NO, RETURN NORMALLY
S	KRB	/GET TYPED CHARACTER
S	AND (0177	/TAKE CARE OF PARITY PROBLEMS
S	TAD (-17	/TEST FOR CTRL/O
S	SNA	/SKIP IF NOT CTRL/O
S	JMP RTTYC	/ABORT CALLING ROUTINE (ERROR RETURN)
S	TAD (-4	/TEST FOR CTRL/S [-17-4=-23(OCTAL)]
S	SZA CLA	/SKIP IF CTRL/S
S	JMP NORMAL	/NOT CTRL/O OR CTRL/S SO RETURN NORMALLY
C
S SLEEP,KSF	/WAIT FOR CTRL/Q
S	JMP SLEEP	/KEEP WAITING
S	KRB	/READ CHARACTER
S	AND (0177
S	TAD (-17	/IS IT A CTRL/O?
S	SNA	/SKIP IF NOT
S	JMP RTTYC	/YES, ABORT
S	TAD (-2	/TEST FOR CTRL/Q (-17-2=-21 OCTAL)
S	SZA CLA	/SKIP IF SO
S	JMP SLEEP	/NOPE, KEEP SLEEPING
C
S NORMAL,INC TTYCTL	/INCREMENT RETURN ADDRESS FOR NORMAL RETURN
S	CLA	/SAFETY VALVE
S	JMP RTTYC	/RETURN
C************** P A R A M E T E R S *************
S PI10,	\I10
S PIH,	\IH
	END