C	PROGRAM BMIO.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	NOV 15, 1977 /PUT GETI1 BACK WITH 9 CALL TO F2D
C	NOV 14, 1977 /REMOVED GETI1 INTO SEPARATE GETI1.FT (DSKB:)
C	NOV 11, 1977
C	NOV 7, 1977
C	NOV 4, 1977 /ADDED T3BUF SINGLE LINE MODES.
C	SEPT 2, 1977 /SPEED UP PACK2D-FETCH2D
C	JAN 7, 1976 - P2RTN UNDEF
C	OCT 21, 1976 - RETYPED DEC 13, 1976 FROM PAPER COPY!!
C	SEPT 23, 1976
C	SEPT 22, 1976
C	SEPT 19, 1976
C	SEPT 18, 1976
C	SEPT 17, 1976
C	SEPT 15, 1976
C	SEPT 14, 1976
C	SEPT 11, 1976
C	SEPT 9, 1976
C	SEPT 8, 1976
C	SEPT 7, 1976
C	SEPT 3, 1976
C	SEPT 2, 1976
C	SEPT 1, 1976
C	REV AUG 27, 1976
C	REV AUG 24, 1976 - LEMKIN
C	20 JUL 1976
C	 6 JUL 1976
C	 1 JUL 1976
C	30 JUN 1976
C	24 JUN 1976
C	23 JUN 1976
C	22 JUN 1976
C	18 JUN 1976
C	16 JUN 1976
C	15 JUN 1976
C	14 JUN 1976
C
C	PURPOSE
C	-------
C	BMIO CONTAINS SEVERAL EXTERNAL SUBROUTINES WHICH DO POINT,
C	NEIGHBORHOOD (READ ONLY), SINGLE LINE (UNPACKED),
C	AND TRIPLE LINE (PACKED) BM<==>PDP8E CORE I/O.
C	COMPILE AS:
C	-----------
C	.COMPILE BMIO,,<BMCMN,BMIO
C
C
C	NOTE: ARGUMENTS (MEM,IBYTE,IX,IY,IZ,
C		I10,I11,I12,...,I18) ARE PASSED THROUGH COMMON
C
C	NOTE: AUTO INDEX REGISTERS 10 THROUGH 17 ARE DESTROYED
C		IN T3BUF I/O.
C
C	NOTE: THE MQ IS DESTROYED IN ALL CALLS.
C
C
C
C	LIST OF PROCEDURES IN BMIO
C	--------------------------
C	1. FETCH2D - FETCH 8 BIT GRAY VALUE FROM BM.
C	   (INTERNAL SUBROUTINE F2D - SAME AS FETCH2D)
C			MEM - BM NUMBER 0:7
C			IBYTE - LOW (0), HIGH (1) BYTE
C			IX - 0:255 X ADDRESS
C			IY - 0:255 Y ADDRESS
C			IZ - 0:255 GRAY VALUE
C
C	2. PACK2D - PACK 8 BIT GRAY VALUE INTO BM.
C	   (INTERNAL SUBROUTINE P2D - SAME AS PACK2D)
C			MEM - BM NUMBER 0:7
C			IBYTE - LOW (0), HIGH (1) BYTE
C			IX - 0:255 X ADDRESS
C			IY - 0:255 Y ADDRESS
C			IZ - 0:255 GRAY VALUE
C
C
C
C	3. T3BUF(BUFFER,IOPR) - TRANSFER 512 BUFFER WORDS TO/FROM BM
C		IN EITHER 3/2 PACKED FORMAT (IOPR=0,1) OR UNPACKED
C		LINE MODE (IOPR=2,3). THE LINE IS POINTED TO BY COMMON
C		VARIABLES (IY,MEM,IBYTE).
C		IOPR	FUNCTION
C		----	--------
C		0	READ BUFFER<==BM (3 LINES PACKED=512 WORDS)
C		1	WRITE BUFFER==>BM (3 LINES PACKED=512 WORDS)
C		2	READ BUFFER<==BM (1 LINE UNPACKED=256 WORDS)
C		3	WRITE BUFFER==>BM (1 LINE UNPACKED=256 WORDS)
C
C	4. GETI1 - I1i (i=0 to 8) OF (MEM,IBYTE,IX,IY). PIXELS OUTSIDE
C		OF THE BOUNDARY ARE MAPPED TO BOUNDARY PIXELS.
C		THE NEIGHBORHOOD IS READ BY 9 CALLS TO FETCH2D;
C	OPDEFS
C	------
S	OPDEF	RIF	6224
C
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
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
S	OPDEF	SWAB	7431
S	OPDEF	SWBA	7447
S	OPDEF	SHL	7413
S	OPDEF	ASR	7415
S	OPDEF	DAD	7443
S	OPDEF	DST	7445
S	OPDEF	DPIC	7573
S	OPDEF	CLAMQ	7621
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
C
C		NOTE: LBUF[1:176] IS USED IN T3BUF IOPR=2,3 MODES.
	DIMENSION LBUF(176)
C
C	POINTERS
C	--------
C	***DUMMY****
S	DUMMY BB
S	DUMMY BUFF
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	ENTRY FETCH
S	CPAGE 2
S FETCH, BLOCK 2
S	JMS F2D
S	RETRN FETCH
C
C
C	###########################################################
C	# INTERNAL SUBROUTINE    F 2 D
C	###########################################################
C
S	CPAGE 3
S RF2D,	JMP I F2D /RETURN
S F2D,	0 /ENTRY
C
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
S	JMS SETBADDR
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 RF2D		/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 RF2D	/DONE, RETURN
C
C
C
C	[5.] FATAL BM DMA TIMEOUT ERROR
S\100,	CLA
S	DMACLR
	WRITE(1,101)
101	FORMAT('BMIO DMA ERR')
S	HLT
	GOTO 100
C	*********************************************************
C	SUBROUTINE:	P A C K 2 D			*
C	*********************************************************
C	PACK BM(MEM&IY&IX,IBYTE)=IZ
C
C
C	PACK 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 - DATA TO BE PACKED (8-BITS).
C
S	ENTRY PACK2
S	CPAGE 2
S PACK2,	BLOCK 2
S	JMS P2D /INTERNAL CALL
S	RETRN PACK2
C
C
C	#######################################################
C	# INTERNAL SUBROUTINE   P 2 D
C	#######################################################
S	CPAGE 3
S RP2D,	JMP I P2D
S P2D,	0 /ENTRY
C
C
C
C	[1] SAVE DATA FOR RETURN
	IZBACK=IZ
C	MAKE SURE THE DATA IS 0:255
S	TAD \IZBACK
S	AND (377
S	DCA \IZBACK
C
C
C	[2] FETCH IT
S	JMS F2D /INTERNAL FETCH2D CALL
C
C
C	[3] SET UP OUTPUT WORD
C
S	DMACLR	/CLEAR
S	TAD PBUFF	/BUFFER POINTER
S	DMACA	/LOAD ADDRESS
S	CLA CLL IAC RAL	/2 WORDS
S	DMAWC	/LOAD WORD COUNT
C
C
C	SELECT PACKING MODE
S	TAD \IBYTE
S	SZA CLA
S	JMP PACKHIGH
C
C
C	[3.1] TRANSFER LOW BYTE
S	TAD BUFF
S	AND (7400
S	TAD \IZBACK
S	DCA BUFF
S	JMP TRANSFER
C
C	[3.2] PACK HIGH BYTE
S PACKHIGH,	TAD BUFF
S	AND (0377
S	MQL
S	TAD \IZBACK
S	BSW
S	RTL
S	AND (7400
S	MQA
S	DCA BUFF
S	TAD \IZBACK
S	RTR;RTR
S	DCA BUFF#
C
C
C	[4] EXECUTE TRANSFER
C
S TRANSFER,	CLA CLL IAC RTR /LOAD 4000 = WRITE BIT
S	RIF		/GET CURRENT DATA FIELD
S	DMAGO		/GO TO IT!
S	DCA 7 /ZERO COUNTER
C
S WBM,	DMASKP
S	SKP
S	JMP P2D4/IO DONE
S	ISZ 7
S	JMP WBM /NOT YET
S	JMP \100 /TIMEOUT!!!
C
C	(RESTORE IZ)
S P2D4,	TAD \IZBACK
S	DCA \IZ
C
S	JMP RP2D /RETURN
C	*****************************************************
C	* SUBROUTINE T 3 B U F   (BUFFER,IOPR)
C	*****************************************************
C
C	T3BUF(BUFFER,IOPR) - TRANSFER 512 BUFFER WORDS TO/FROM BM
C	IN EITHER 3/2 PACKED FORMAT (IOPR=0,1) OR UNPACKED
C	LINE MODE (IOPR=2,3). THE LINE IS POINTED TO BY COMMON
C	VARIABLES (IY,MEM,IBYTE).
C		IOPR	FUNCTION
C		----	--------
C		0	READ BUFFER<==BM (3 LINES PACKED=512 WORDS)
C		1	WRITE BUFFER==>BM (3 LINES PACKED=512 WORDS)
C		2	READ BUFFER<==BM (1 LINE UNPACKED=256 WORDS)
C		3	WRITE BUFFER==>BM (1 LINE UNPACKED=256 WORDS)
C
C
S	CPAGE 2
S BB,	BLOCK 2 /ARG PTR
C
S	ENTRY T3BUF
S	CPAGE 2
S T3BUF,	BLOCK 2
C
C
C	[1] GET THE BUFFER FIELD AND PTR, AND READ/WRITE WORD
C	SAVE IY
S	TAD \IY
S	DCA 17 /IYBACK
C
S	DMACLR /CLEAR THE CHANNEL
C
	ICMD=0
C
S	TAD I T3BUF
S	DCA BB
C
C
C	[2] GET THE BUFFER ADDRESS
S	INC T3BUF#
S	TAD I T3BUF
S	DCA BB#
C
C
C	[3] GET THE OPERATION
S	INC T3BUF#
S	TAD I T3BUF
S	DCA BUFF
S	INC T3BUF#
S	TAD I T3BUF
S	DCA BUFF#
C
S	TAD I BUFF
S	IAC /+1 FOR COMPUTED GOTO
S	DCA \IXX
C	TEST IF READ (IOPR=0,2) OR WRITE(1,3)
S	TAD I BUFF
S	CLL RAR /MOVE THE LOW BIT TO LINK BIT
S	CLA RAR /LINK BIT TO BIT 0 SO (0000) OR (4000)
S	DCA \ICMD
C
S	INC T3BUF# /SETUP RETURN
C
C	DISPATCH TO EITHER 3 PACKED OR 1 LINE UNPACKED I/O
	GOTO (1400,1450,1500,1550),IXX
C
C
C	[3.1] TEST IF WRITING OUT LINES 254,255
C	IN WHICH CASE WRITE OUT ONLY LINES 254, 255 USING PACK2D.
C	IF IY GEQ 254
C		THEN GOTO [3.2] 
C		ELSE GOTO [4];
S\1450,	TAD (-D254
S	TAD \IY
S	SPA CLA
S	JMP \1400 /GOTO [4]
C
C
C	[3.2] GO WRITE OUT LINES 254,255 USING PACK2D AFTER
C	UNPACKING THE DATA FROM THE BUFFER.
	ICMD=IY
C	3 BYTE COUNTER 
	K=0
C
	DO 1452	IY=ICMD,255
	DO 1452 IXX=1,256
S	CLA CMA
S	TAD \IXX
S	DCA \IX
C
C	GET THE BYTE USING THE TRIPLE COUNTER
S	INC \K
	GOTO(1461,1462,1463),K
C
C	GET 2 WORDS AND PACK 1ST BYTE
S \1461,	TAD I BB /ARG FETCH
S	INC BB#
S	DCA 12
S	TAD I BB
S	INC BB#
S	DCA 13
S	TAD 12
S	AND (377
	GOTO 1464
C
C	GET 2ND BYTE
S \1462,	TAD 13
S	AND (377
	GOTO 1464
C
C	GET 3RD BYTE
1463	K=0
S	TAD 12
S	RTR;RTR
S	AND (0360
S	MQL
S	TAD 13
C@S	RTL; RTL; RAL
S	BSW; RTR /ALTERNATIVE MICROCODE
S	AND (0017
S	MQA
C
S \1464,	DCA \IZ
S	JMS P2D
1452	CONTINUE
C
C	RESTORE CURRENT DATA FIELD
S	CPAGE 3
S\1499,	JMS 45
S	CLA
C
C	RESTORE  IY
S	TAD 17 /IYBACK
S	DCA \IY
S	RETRN T3BUF
C
C
C
C	[4] FINISH SETTING UP THE CHANNEL TO MOVE 3 LINES
S\1400,	TAD (D512	/SET WORD COUNT TO...
S	DMAWC	/...2 BLOCKS
C
C	LOAD CA TO POINT TO EXTERNAL BUFFER
S	TAD BB#
S	DMACA
C
C
C	SETUP BM I/O ADDR
	IX=0
S	JMS SETBADDR
C
C
S	TAD BB /SETUP BUFFER FIELD
S	AND (0070
S	MQL
S	TAD \IBYTE	/SEE IF HIGH BYTE (IE. JHGH=1)
S	SZA CLA
S	TAD (200 /HIGH BYTE
S	TAD (200 /LOW BYTE
S	TAD \ICMD 	/READ OR WRITE THE BUFFER FIELD
S	MQA /OR IN THE BUFFER FIELD
S	DMAGO
S	DCA 7 /ZERO COUNTER
C
S WAITZ, DMASKP
S	SKP
S	JMP \1499 /DONE WITH I/O
S	ISZ 7
S	JMP WAITZ /NOT YET
S	JMP \100 /OVERFLOW
C
C	[5] WRITE 1 LINE OF 256 UNPACKED BYTES ==>BM.
C	PACK 1ST 252 BYTES FROM EXTERNAL BUFFER INTO 175 WORDS OF LBUF
C	IN LOCAL BUFFER. WRITE LAST FOUR BYTES SEPARATELY.
C
C	SETUP AUTOINDEX REGISTERS TO BUFFER POINTERS

S\1550,	CLA CMA
S	TAD BB#
S	DCA 10
C
S	CLA CMA
S	TAD PLBUF
S	DCA 11
C
S	TAD (-D84 /PACK 3*84=252 BYTES (4 SHORT OF 256)
S	DCA 7
C
C	SETUP EXTERNAL BUFFER FIELD
S	TAD BB
S	DCA SRC1
C
C	SETUP LOCAL BUFFER FIELD
S	RIF
S	TAD (6201 /CDF 00
S	DCA SNK1
C
S	CPAGE 6
S SRC1,	0 /CDF BUFFER FIELD
S	TADI 10
S	DCA 12 /SAVE BYTE 1
C
S	TADI 10 
S	DCA 13 /BYTE 2
C
S	TADI 10 /BYTE 3 TO BE SPLIT
S	MQL
C
S	MQA
S	CLL RTL; RTL /GET B3H
S	AND (7400
S	TAD 12 /BYTE 1
C
S SNK1,	6201 /CDF CURRENT FIELD
S	DCAI 11
C
S	MQA
C@	COMPUTE: S	RTR; RTR; RAR /MOVE B3L==>HIGH 4 BITS
S	BSW; RTL /ALTERNATE MICROCODE
S	AND (7400 
S	TAD 13 /BYTE 2
S	DCAI 11
C
C	TEST IF DONE WITH 252 BYTE TRANSFER
S	ISZ 7
S	JMP SRC1 /DONE
C
C
C
C	[6] FINISH SETTING UP THE CHANNEL TO MOVE 1 LINE.
C	READ WC = (6/4)*(252+6 BYTES)=176 WORDS
C	WRITE WC = (6/4)*(252 BYTES)=172 WORDS
C		NOTE:NEED TO WRITE BYTES 253,4,5,6 SEPARATELY!
C	NOTE: IOPR IS NOW COPIED LOCALLY TO IXX
C	COMPUTE: WC=176-4*(IXX-3)
C
S\1500,	CLA CLL CMA RTL /LOAD -3
S	TAD \IXX
S	CLL RAL; RAL /MULTIPLY BY 4
S	CIA
S	TAD (D176
S	DMAWC
C
C	SET CURRENT ADDRESS TO POINT TO LBUF
S	TAD PLBUF
S	DMACA
C
C	SETUP BM I/O ADDR
	IX=0
S	JMS SETBADDR
C
C
C	GET THE BYTE SPECIAL COMMAND OPTION
S	TAD \IBYTE
S	SZA CLA
S	TAD (0200 /HIGH BYTE
S	TAD (0200 /LOW BYTE
S	TAD \ICMD /READ OR WRITE COMMAND
S	RIF /OR IN THE CURRENT BUFFER FIELD
S	DMAGO
S	DCA 7 /ZERO COUNTER
C
S WAIT1Z, DMASKP
S	SKP
S	JMP \1570 /DONE WITH I/O
S	ISZ 7
S	JMP WAIT1Z /NOT YET
S	JMP \100 /OVERFLOW
C
C
C	[6.1] IF WRITE, THEN WRITE OUT THE LAST 4 BYTES BYTE
S\1570,	TAD \ICMD
S	SMA CLA
S	JMP \1590 /NO, READ
C
S	TAD (D252
S	TAD BB#
S	DCA BB#
C
C	COPY 4 PIXELS
	DO 1571 IX=252,255
S	TAD I BB
S	DCA \IZ
S	INC BB#
S	JMS P2D
1571	CONTINUE
C
C	DONE, RETURN
	GOTO 1499
C
C
C	[6.2] READ, SO UNPACK LBUF[1:175.5] INTO BB[1:256]
C	SET UP AUTOINDEX REGISTERS
S \1590,	CLA CMA
S	TAD BB#
S	DCA 11
C
S	CLA CMA
S	TAD PLBUF
S	DCA 10
C
S	TAD (-D86 /TRANSFER 3*86=256+2 BYTES
S	DCA 7
C
C	SETUP EXTERNAL BUFFER FIELD
S	TAD BB
S	DCA SNK2
S	TAD BB
S	DCA SNK3
S	TAD BB
S	DCA SNK4
C
C	SETUP LOCAL (CURRENT) INTERNAL BUFER FIELD
S	RIF
S	TAD (6201 /CDF 00
S	DCA SRC2
C
C	UNPACK COPY LOOP
S SRC2,	6201 /CDF CURRENT BUFFER FIELD
S	TADI 10 /B3H&B1
S	MQL
S	TADI 10 /B3L&B2
S	DCA 13
C
S	MQA
S	AND (377
S	CPAGE 2
S SNK2,	6201 /CDF OUTPUT BUFFER FIELD
S	DCAI 11 /BYTE 1
C
C	TEST IF GET OUT
C	IF C(7) GEQ -1
C		THEN DONE
S	CLA IAC
S	TAD 7
S	SMA CLA
S	JMP \1499 /DONE!
C
S	TAD 13
S	AND (377
S	CPAGE 2
S SNK3,	6201 /CDF BUFFER FIELD
S	DCAI 11 /BYTE 2
C
S	MQA /COMPUTE BYTE 3=BM3H&BM3L
S	RTR; RTR
S	AND (0360
S	MQL
S	TAD 13
C@S	RTL; RTL; RAL
S	BSW; RTR /ALTERNATIVE MICROCODE
S	AND (0017
S	MQA
S	CPAGE 2
S SNK4,	6201 /CDF BUFFER FIELD
S	DCAI 11
C
C	TEST IF DONE
S	ISZ 7
S	JMP SRC2 /NOT DONE
C
C	DONE
	GOTO 1499
C	####################################################
C	# INTERNAL SUBROUTINE    S E T B A D D R
C	####################################################
C	SETUP THE BM I/O PIXEL ADDRESS (MEM&IY&IX)==>EXDAM[1:2];
C
S	CPAGE 30
S SETBADDR,	0 /ENTRY
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			/'OR'
S	EXDMA1			/HIGH-ORDER WORD
C
S	TAD \IY
C@S	CLL RTR; RTR; RAR	/MOVE BITS [8:11] ==> [0:3]
S	BSW; RTL		/    ALTERNATIVE MICROCODE SEQUENCE
S	AND (7400
S	TAD \IX
S	EXDMA2			/LOAD LO-ORDER WORD
C
S	JMP I SETBADDR
C
C	****************************************************
C	*SUBROUTINE     G E T I 1
C	*************************************************************
C	GET THE 3X3 NEIGHBORHOOD ==> I10 TO I18.
C	MAP PIXELS OUTSIDE OF THE BOUNDARY TO BOUNDARY PIXELS.
C	IT MAKES 9 CALLS TO CLIPF2D
C	[0] ENTRY
S	ENTRY GETI1
S	CPAGE 2
S GETI1,	BLOCK 2
C
C
C	[1] 9 PIXEL 3X3 NEIGHBORHOOD FETCH 
C	SAVE IX,IY
S	TAD \IX
S	DCA 17
S	TAD \IY
S	DCA 16
C
C
C	[1.1] FETCH POINTS ON LINE Y-1
S	CLA CMA
S	TAD 16
S	DCA \IY
C
S	CLA CMA
S	TAD 17
S	DCA \IX
S	JMS CLIPF2D
	I13=IZ
C
S	TAD 17
S	DCA \IX
S	JMS CLIPF2D
	I12=IZ
C
S	CLA IAC
S	TAD 17
S	DCA \IX
S	JMS CLIPF2D
	I11=IZ
C
C
C	[1.2] FETCH POINTS ON LINE Y
S	TAD 16
S	DCA \IY
S	CLA CMA /-1
S	TAD 17
S	DCA \IX
S	JMS CLIPF2D
	I14=IZ
C
S	TAD 17
S	DCA \IX
S	JMS CLIPF2D
	I18=IZ
C
S	CLA IAC /+1
S	TAD 17
S	DCA \IX
S	JMS CLIPF2D
	I10=IZ
C
C
C	[1.3] FETCH POINTS ON LINE Y+1
S	CLA IAC /+1
S	TAD 16
S	DCA \IY
C
S	CLA CMA /-1
S	TAD 17
S	DCA \IX
S	JMS CLIPF2D
	I15=IZ
C
S	TAD 17
S	DCA \IX
S	JMS CLIPF2D
	I16=IZ
C
S	CLA IAC
S	TAD 17
S	DCA \IX
S	JMS CLIPF2D
	I17=IZ
C
C	RESET IX,IY
S	TAD 17
S	DCA \IX
S	TAD 16
S	DCA \IY
C
S	RETRN GETI1
C
CC	**************************************************
C	*INTERNAL SUBROUTINE    C L I P F 2 D
C	*****************************************************
C
C	IZ<==FETCH2D(MEM,IBYTE,IX,IY)
C		WHERE: IX AND IY ARE CLIPPED BEFORE THE CALL
C		TO [0:255];
C
S	CPAGE 32
S CLIPF2D,	0 /ENTRY
C
C	CLIP X TO [0:255]
S	TAD \IX
S	JMS CLIP
S	DCA \IX
C
C	CLIP Y TO [0:255]
S	TAD \IY
S	JMS CLIP
S	DCA \IY
C
C
S	JMS F2D
S	JMP I CLIPF2D /RETURN
C
C
C
S CLIP, 0 /INTERNAL SUBR
S	SPA
S	CLA /CLIP TO 0 IF < 0
S	TAD (-D256
S	SMA
S	CLA CMA /NO, MAKE IT 255
S	TAD (D256
S	JMP I CLIP
C
C	************POINTERS**************
S PBUFF, BUFF /POINTER
S PLBUF, \LBUF /POINTER
C
C
S	CPAGE 2
S BUFF,	BLOCK 2
C
C
	END