C	PROGRAM BMPARM.FT
C	----------------
C
C
C	###SUBROUTINE BMPARM(IX,IY,IZ,MEM,IBYTE,IOPR)
C
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	JULY 18, 1977
C
C
C	INTRODUCTION
C	------------
C	READ AND WRITE PARAMETERS FROM COMMON.
C	IOPR	FUNCTION
C	----	--------
C	1	ARGS==>COMMON
C	2	ARGS<==COMMON
C	OPDEFS
C	------
S	OPDEF	RIF	6224
S	OPDEF	TADI	1400
S	OPDEF	DCAI	3400
C
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C
C
C
C
S	DUMMY TMP
S	CPAGE 2
S TMP,	6211 /COMMON
S	1200 /IBUF2

C
C	[0] DO A FAST ARGUMENT FETCH.
S	DUMMY IX
S	DUMMY IY
S	DUMMY IZ
S	DUMMY MEM
S	DUMMY IBYTE
S	DUMMY IOPR
C
S PLNKWD,	LNKWD /POINTER TO DUMMY TABLE
S	CPAGE 15
S LNKWD,	BLOCK 1
S IX, BLOCK 2
S IY, BLOCK 2
S IZ, BLOCK 2
S MEM, BLOCK 2
S IBYTE, BLOCK 2
S IOPR, BLOCK 2
C
S	ENTRY BMPAR
S	CPAGE 2
S BMPAR,	BLOCK 2
C
C	SETUP CURRENT FIELD
S	CLA
S	RIF
S	TAD (6201
S	DCA A2
C
C	SETUP CALLING FIELD
S	TAD BMPAR
S	DCA A1
C
C	SETUP DUMMY BLOCK PTR
S	CLA CMA
S	TAD PLNKWD
S	DCA 12
C
C	SETUP CALLING PTR
S	TAD (-2 /POINT TO LINK WORD (-1 FOR AUTOINDEX)
S	TAD BMPAR#
S	DCA 11
C
C	COPY 15 WORDS
S	TAD (-15
S	DCA 7
S	CPAGE 6
S A1,	0 /CDF CALLING FIELD
S	TADI 11
S A2,	0 /CDF CURRENT FIELD
S	DCAI 12
S	ISZ 7
S	JMP A1 /NOT DONE
C
C	DONE, UPDATE RETURN ADDRESS
S	TAD (14
S	TAD BMPAR#
S	DCA BMPAR#
C
C
C	[0.1] CHECK IF THER ARE 6 ARGS - ERROR IF NOT.
S	TAD LNKWD
S	BSW
S	AND (0077
S	DCA \I
S	TAD \I
S	TAD (-D6
S	SNA CLA
S	JMP \10 /OK, CONTINUE
C
	WRITE(1,11)I
11	FORMAT(' ?BMPARM #ARGS=',I5)
	CALL EXIT
C
C	[0.2] GET IOPR
S\10,	TAD I IOPR
S	DCA \IOPR
C
C
C	[0.3] DISPATCH
C	IF 0 LEQ IOPR OR IOPR > 2
C		THEN ERROR
C		ELSE CONTINUE
S	CLA CMA
S	TAD \IOPR
S	SPA CLA
S	JMP \30 /ERROR
S	TAD (-3
S	TAD \IOPR
S	SMA CLA
S	JMP \30 /ERROR
C
	GOTO(100,200),IOPR
C
C
C	ERROR
30	WRITE(1,31)IOPR
31	FORMAT(' ?BMPARM IOPR=',I5)
	CALL EXIT
S	RETRN BMPAR
C
C
C	[1] ARGS==>COMMON
S\100,	TAD I IX
S	DCA \IX
C
S	TAD I IY
S	DCA \IY
C
S	TAD I IZ
S	DCA \IZ
C
S	TAD I MEM
S	DCA \MEM
C
S	TAD I IBYTE
S	DCA \IBYTE
C
C	[2] ARGS<==COMMON
S\200,	TAD \IX
S	DCA I IX
C
S	TAD \IY
S	DCA I IY
C
S	TAD \IZ
S	DCA I IZ
C
S	TAD \MEM
S	DCA I MEM
C
S	TAD \IBYTE
S	DCA I IBYTE
S	RETRN BMPAR
	END
   