.NLIST	TTM 
	.TITLE	HISTI 
	.IDENT	/RICE04/
HI.TYP=0
HI.YSZ=1
HI.DAT=2
HI.XSZ=4
HI.X0=8.
HI.XS=6
HI.YS=10.
HI.Y0=12.
;$EIS=1		; define this to use EIS instead of FPP
;
; 
;	CALL HISTI( NO. ,X ,Y)
;	CFLL HISTA(NO,X,Y)
;	NO. = HIST NUMBER  ** X = X VALUE ** Y = Y VALUE
;	Y MAY BE OMITTED FOR 1 DIM ARRAYS 
;
;	IN HISTI X,Y ARE INTEGER
;	IN HISTA X,Y ARE FLOAT PT 
; 
; 
;	SETUP WHICH BUFFER TO DISPLAY AND SCALE FACTOR 
; 
; 
; 
	.psect	$CODE,Ro,i,lcl,con
HISTI::	CALL	HIS1  		; PRELIM SETUP 
	CALL	SCALI 		; GET X VALUE SCALED 
	DEC	R1		; CHECK IF PARAM COUNT OK
	BMI	HINC		; 1 DIM HIST ONLY	< 
	MOVB	@(SP),R4	; Get y size
	CMP	R4,#1		; Check dimension
	BLE	HINC 		; 1 dimension ?
	CMP	(R0)+,(R0)+ 
	MOV	R2,R1 		; SAVE X COOR
	CALL	SCALI		; GET Y VALUE SCALED 
	BR	HINC2 
NERR:	JMP	BPARM
HISTF::
HISTA::	CALL	HIS1		; PRELIMINARY SETUP
	CALL	SCALF		; GET X VALUE SCALED 
	DEC	R1		; CHECK IF PARAM COUNT OK
	BMI	HINC		; 1 DIM HIST ONLY
	BNE	NERR		; BAD INPUT
	MOVB	@(SP),R4	; Get y size
	CMP	R4,#1		; Check dimension
	BLE	HINC 		; 1 dimension ?
	CMP	(R0)+,(R0)+ 
	MOV	R2,R1 		; SAVE X COOR
	CALL	SCALF		; GET Y VALUE SCALED 
HINC2:
	MUL	-6(R0),R2	; MULTIPLY BY DIMENSION
	MOV	R3,R2 
	ADD	R1,R2 		; ADD X VALUE TO Y VALUE 
HINC:
	ASL	R2		; NOW IS BYTE ADDRESS
	MOV	(SP)+,R0	; Parameter address
	CMPB	#1,1(R0)	; 2 Word/ chan.?
	BNE	10$		; Yes
	ADD	2(R0),R2	; Add offset to array address
	ADD	R0,R2		; Now is data address
	INC	(R2)		; INCREMENT THE HISTOGRAM
	RETURN			; NORMAL RETURN
10$:	ASL	R2		; Double word index
	ADD	2(R0),R2	; Add offset to array address
	ADD	R0,R2		; Now is data address
	INC	(R2)+		; Increment 1'st word
	BNE	20$		; NO OVERFLOW
	INC	(R2)		; Increment 2'nd word
20$:	RETURN
; 
;	Initialize for histogram
;
HIS1:	MOVB	(R5),R1		; GET NO OF WORDS IN PARAM LIST
	SUB	#2,R1		; 2 OR MORE PARAM MANDATORY 
	BLT	NERR
	TST	(R5)+		; GET NO OF PARAM
	CALL	SWIT		; GET HISTOGRAM ADDRESS
	MOV	(SP),-(SP)	; Return address
	MOV	R0,2(SP)	; Save param address
	TSTB	1(R0)		; Hist exists ?
	BEQ	RSTAK		; NO 
	CMP	(R0)+,(R0)+	; Skip data area offset
	MOV	(R0)+,R4	; X SIZE
	.IFNDF	$EIS
	LDFPS	#0		; Set floating,single,1 word integer
	.ENDC
	RETURN	
RSTAK:	CMP	(SP)+,(SP)+	; Unstack return address
	RETURN	
;
;	Integer input and scale routine
;
	.IFNDF	$EIS		; EIS version requested?
SCALI:	LDCIF	@(R5)+,%0	; Integer number to floating
	BR	SCALB
;
;	Floating point input and scale routine
;
SCALF:	LDF	@(R5)+,%0	; GET FLOATING NO. 
SCALB:	LDCIF	2(R0),%1	; GET OROGIN 
	SUBF	%1,%0		; SUBTRACT 
	LDCIF	(R0),%1		; GET STEP 
	DIVF	%1,%0		; Divide by step
	STCFI	%0,R2		; GET RESULT OF CALC.
	BCS	30$		; OVERFLOW OCCURRED
	.IFF
SCALF:	CALL	ROUN2		; Get rounded floating point
	BR	SCALB
SCALI:	CLR	R2		; Clear hi order bits
	MOV	@(R5)+,R3	; Number to rescale
	BGE	SCALB		; Positive
	NEG	R2
SCALB:	SUB	2(R0),R3	; Subtract orogin
	SBC	R2		; And carry
	TST	2(R0)		; Check if further subtraction
	BGE	10$		; None
	INC	R2		; Subtract -1
10$:	DIV	(R0),R2		; Divide by step
	BVS	30$		; Out of range?
	.iftf
	BMI	50$		; Minus is too small
	CMP	R2,R4   	; CHECK ON SIZE
	BGE	40$		; Too big!
	RETURN	
	.ift
30$:	TSTF	%0		; TEST SIGN OF RESULT
	CFCC
	.iff
30$:	MOV	(R0),R3		; Get step
	XOR	R3,R2		; Are number and step of opposite sign?
	.endc
	BMI	50$		; THEY ARE DIFFERENT
40$:	MOV	R4,R2   	; VALUE = MAX
	DEC	R2
	RETURN	
50$:	CLR	R2		; TOO SMALL MAKE ZERO
	RETURN	
	.ifdf	$EIS
;
;	Routine to round off Floatin point to integer
;
ROUN2::	MOV	R4,-(SP)	; Save
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	MOV	(R5)+,R3
	MOV	(R3)+,R2	; hi order
	MOV	(R3)+,R3	; Lo order
	MOV	R2,-(SP)	; Save sign
	MOV	R2,R4		; And exponent
	ASH	#-7,R4		; Get exponent into lo bits
	BIC	#177400,R4	; Complete exponent
	SUB	#200+24.,R4	; Now is shift count
	CMP	R4,#8.		; Too big?
	BGT	35$		; Yes
	BIC	#177600,R2	; Clear exponent part of floating
	ADD	#200,R2		; Put back hidden bit
	TST	(SP)		; Positive mantissa?
	BGE	30$		; Yes
	TST	R4		; Shift right?
	BGE	30$		; No
	MOV	#-1,R1		; Get -1
	MOV	R1,R0
	NEG	R4		; Reverse shift
	ASHC	R4,R0		; now have 0's where bits shift out
	NEG	R4		; Restore shift
	COM	R0
	COM	R1		; Number to add for round off
	ADD	R1,R3
	ADC	R2
	ADD	R0,R2		; Finish round off
30$:	ASHC	R4,R2		; Shift to proper magnitude
	BVC	36$		; No overflow?
35$:	MOV	#77777,R2	; Yes make it max number
	MOV	#177776,R3
36$:	TST	(SP)+		; Sign of result??
	BGE	40$		; Positive
	COM	R2
	COM	R3
	ADD	#1,R3		; Make 2's complement
	ADC	R2
40$:	MOV	(SP)+,R0
	MOV	(SP)+,R1
	MOV	(SP)+,R4	; Restore
	RETURN
	.ENDC
	.END