C	PROGRAM PROP1.FT
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	AUG 24, 1977
C
C	INTRODUCTION
C	------------
C	PROPAGATE BMJ 1'S INTO G(X,Y) > 1. NOTE: 0'S DO NOT
C	PROPAGATE. ALSO DO THIS INSIDE OF (KX1:KX2,KY1:KY2).
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	SWAB	7431
S	OPDEF	SWBA	7447
C
S	OPDEF	SHL	7413
S	OPDEF	MUY	7405
S	OPDEF	DVI	7407
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 PROP1
S	CPAGE 2
S PROP1,	BLOCK 2
C
C
C	[2] PROPAGATE
C	GO PROPAGATE BMJ UNTIL DONE OR ^O OUT.
C	SETUP PROP MEMORY
	MEM=JBM
	IBYTE=JHGH
C
	IPROP=0
C
C	WHILE TRUE DO
C		BEGIN "PROPAGATE1 PASS"
300	CONTINUE
C	ZERO IA[1:2]
	IA=0
S	DCA \IA#
C
	DO 310 IY1=KY1,KY2
C
S	CPAGE 3
S	JMS TTYCTL	/TEST FOR TTY INPUTS
S	JMP \2047	/ERROR RETURN: ABORT
C
	IY=IY1-1
S	TAD \IY
S	DISP2		/PUT BMY ADDRESS IN RIGHT LED'S
C
C	COMPUTE COMPLEMENTARY COORDINATE
	IY2=(KY2-IY1)+KY1
C
C
	DO 310 IX1=KX1,KX2
	IX2=(KX2-IX1)+KX1
C
C
C	[2.1] PROP (IX1,IY1)
	IX=IX1-1
	IY=IY1-1
S	JMS PROPNGH
C
C
C	[2.2] PROP (IX1,IY2)
	IX=IX1-1
	IY=IY2-1
S	JMS PROPNGH
C
C
C	[2.3] PROP (IX2,IY1)
	IX=IX2-1
	IY=IY1-1
S	JMS PROPNGH
C
C
C	[2.4] PROP (IX2,IY2)
	IX=IX2-1
	IY=IY2-1
S	JMS PROPNGH
310	CONTINUE
C
C	CVT TOTAL PROPAGATIONS TO F.P. #
	CALL DPCVRT(IA,FA,-1)
C
C	PRINT # PROPAGATIONS THIS PASS
	IPROP=IPROP+1
S	TAD \IA
S	DISP1
C
C	LOAD PASS #
	IX=IBCD(IPROP,-1)
S	TAD \IX
S	LQDT1
S	LQDT2
C
	DO 312 INDEX=1,3,2
312	WRITE(INDEX,311)IPROP,FA
311	FORMAT(' PROPAGATION PASS',I5,', PROPAGATED ',F7.0,' PIXELS')
C
C	IF FA =0
C		THEN DONE
C		ELSE CONTINUE AT 2]
	IF(FA)2047,2047,300
C
C
C
C	[3] RETURN
S \2047,	RETRN PROP1
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
S	CLL RTR; RTR; RAR	/MOVE BITS [8:11] ==> [0:3]
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('PROPAGATE 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
	IXSAV=IX
	IYSAV=IY
C
C
C	[1.1] FETCH POINTS ON LINE Y-1
	IY=-1+IYSAV
	IX=-1+IXSAV
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
	IX=-1+IXSAV
S	JMS FETCH2D
	I14=IZ
C
S	INC \IX
C	*** DO NOT NEED I18 SINCE HAVE IT ALREADY -- SAVE TIME***
C@S	JMS FETCH2D
C@	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
	IX=-1+IXSAV
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=IXSAV
	IY=IYSAV
C
S	JMP RGETNGH
C	*******************************************************
C	*SUBROUTINE   P R O P N G H
C	*******************************************************
C	PROP THE NEIGHBORHOOD
C
S	CPAGE 3
SRPROPNGH,	JMP I PROPNGH
S PROPNGH,	0
C
C
C	FOLLOW CURSOR IN BMJ
S	TAD \IXPOSITION
S	TAD \IX
S	LDXP
C
S	TAD \IYPOSITION
S	TAD \IY
S	LDYP
C
C
C	GET PIXEL
S	JMS FETCH2D
	I18=IZ
C@C***********DEBUG*****
C@	WRITE(3,1999)IX1,IY1,IX,IY,I18
C@1999	FORMAT('IX1/Y1=',2I5,', IX/Y=',2I5,',I18=',I5)
C@C**********************
C
C	IF I18 > 1
C		THEN PROP
C		ELSE NOP;
S	TAD (-2
S	TAD \I18
S	SPA CLA
S	JMP RPROPNGH /NO
C
C	GET THE DATA TO PROP FROM OUTPUT IMAGE BMJ
S	JMS GETNGH
C
C	SET THE COMPONENT NUMBER
	IZ=I18
C
C
C	[PN.1] PROP TOP ROW
	IY=IYSAV-1
C	IF I13=1
C		THEN PROP
S	CLA CMA
S	TAD \I13
S	SZA CLA
S	JMP \612 /NO
	IX=IXSAV-1
	CALL PACK2D
S	ISZ \IA /INCREMENT PROPAGATED PIXEL COUNTER
S	SKP
S	ISZ \IA# /HIGH ORDER
S	CLA

C
C	IF I12=1
C		THEN PROP
S\612,	CLA CMA
S	TAD \I12
S	SZA CLA
S	JMP \611 /NO
	IX=IXSAV
	CALL PACK2D
S	ISZ \IA /INCREMENT PROPAGATED PIXEL COUNTER
S	SKP
S	ISZ \IA# /HIGH ORDER
S	CLA

C
C	IF I11=1
C		THEN PROP
S\611,	CLA CMA
S	TAD \I11
S	SZA CLA
S	JMP \614 /NO
	IX=IXSAV+1
	CALL PACK2D
S	ISZ \IA /INCREMENT PROPAGATED PIXEL COUNTER
S	SKP
S	ISZ \IA# /HIGH ORDER
S	CLA

C
C
C	[PN.2] PROP MIDDLE ROW
614	IY=IYSAV
C	IF I14=1
C		THEN PROP
S	CLA CMA
S	TAD \I14
S	SZA CLA
S	JMP \610 /NO
	IX=IXSAV-1
	CALL PACK2D
S	ISZ \IA /INCREMENT PROPAGATED PIXEL COUNTER
S	SKP
S	ISZ \IA# /HIGH ORDER
S	CLA

C
C	IF I10=1
C		THEN PROP
S\610,	CLA CMA
S	TAD \I10
S	SZA CLA
S	JMP \615 /NO
	IX=IXSAV+1
	CALL PACK2D
S	ISZ \IA /INCREMENT PROPAGATED PIXEL COUNTER
S	SKP
S	ISZ \IA# /HIGH ORDER
S	CLA

C
C
C	[PN.3] PROP BOTTOM ROW
615	IY=IYSAV+1
C	IF I15=1
C		THEN PROP
S	CLA CMA
S	TAD \I15
S	SZA CLA
S	JMP \616 /NO
	IX=IXSAV-1
	CALL PACK2D
S	ISZ \IA /INCREMENT PROPAGATED PIXEL COUNTER
S	SKP
S	ISZ \IA# /HIGH ORDER
S	CLA

C
C	IF I16=1
C		THEN PROP
S\616,	CLA CMA
S	TAD \I16
S	SZA CLA
S	JMP \617 /NO
	IX=IXSAV
	CALL PACK2D
S	ISZ \IA /INCREMENT PROPAGATED PIXEL COUNTER
S	SKP
S	ISZ \IA# /HIGH ORDER
S	CLA

C
C	IF I17=1
C		THEN PROP
S\617,	CLA CMA
S	TAD \I17
S	SZA CLA
S	JMP RPROPNGH /NO
	IX=IXSAV+1
	CALL PACK2D
S	ISZ \IA /INCREMENT PROPAGATED PIXEL COUNTER
S	SKP
S	ISZ \IA# /HIGH ORDER
S	CLA
C
S	JMP RPROPNGH
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 *************
	END
 