.TITLE	HISTRE - HISTOGRAM RETRIEVAL
	.IDENT	/17MAY7/	;13:30:00  LV
;	.ENTRY	HISTRE - HISTOGRAM RETRIEVAL
;+
; H I S T R E
;
; PURPOSE:	THIS ROUTINE RETRIEVES THE STATUS OF A HISTOGRAM,
;		AND OPTIONALLY RETRIEVES A SPECIFIED SUBSET OF THE
;		HISTOGRAMMED DATA.  EITHER THE NAME AND OWNER OR
;		THE NUMBER OF THE HISTOGRAM MAY BE SPECIFIED IN
;		THE HDA.
;
; INTERFACE:	CALLING SEQUENCE:  (FORTRAN-CALLABLE SUBROUTINE)
;			CALL HISTRE(HDA,IERR,REJ,DATA,IL,IU,JL,JU)
;
;		INPUT:	HDA (INTEGER ARRAY) = HISTOGRAM DESCRIPTOR
;				ARRAY; THE HISTOGRAM STATUS IS RETURNED
;				IN THE HDA IF EITHER THE NAME OR NUMBER
;				SPECIFY A HISTOGRAM THAT EXISTS.
;				OTHERWISE, THE HDA IS UNCHANGED.
;			IL (INTEGER) = NUMBER OF LOWEST BIN TO BE
;				RETRIEVED IN PARAMETER 1 (BIN NUMBERS
;				START AT ONE).
;			IU (INTEGER) = NUMBER OF HIGHEST BIN TO BE
;				RETRIEVED IN PARAMETER 1.
;			JL (INTEGER) = NUMBER OF LOWEST BIN TO BE
;				RETRIEVED IN PARAMETER 2.
;			JU (INTEGER) = NUMBER OF HIGHEST BIN TO BE
;				RETRIEVED IN PARAMETER 2.
;
;		OUTPUT:	HDA (INTEGER ARRAY) = HISTOGRAM DESCRIPTOR
;				ARRAY; THE HISTOGRAM STATUS IS RETURNED
;				IN THE HDA IF EITHER THE NAME OR NUMBER
;				SPECIFY A HISTOGRAM THAT EXISTS. 
;				OTHERWISE THE HDA IS UNCHANGED.
;			IERR (INTEGER) = ERROR STATUS
;				IERR=0: NO ERROR
;				IERR=1: HISTOGRAM DOES NOT EXIST
;				IERR=2: BIN LIMITS (IL,IU,JL,JU)
;					INCORRECTLY SPECIFIED
;			REJ (REAL) = REJECTED EVENT COUNT FOR THIS
;				HISTOGRAM
;			DATA (REAL ARRAY) = ARRAY INTO WHICH THE
;				HISTOGRAMMED DATA ARE RETRIEVED.  IF THE
;				HISTOGRAM DOES NOT EXIST, THE ENTIRE
;				ARRAY IS SET TO ZEROS.
;
;
;		NOTES:
;		1.  ALL ARGUMENTS EXCEPT HDA AND IERR MAY BE OMITTED.
;     		    IF DATA IS PRESENT, THEN REJ, IL, AND IU MUST BE
;	    	    PRESENT.
;
;		2.  IF JL AND JU ARE ABSENT FOR A 2-PARAMETER HISTOGRAM,
;		    THEY ARE ASSUMED TO BE ONES.
;
;		3.  IF JL AND JU ARE PRESENT FOR A ONE-PARAMETER HISTOGRAM,
;		    ZEROS ARE SUPPLIED FOR ALL BINS WITH AN INDEX IN
;		    PARAMETER 2 OTHER THAN ONE.
;
;		4.  ZEROS ARE SUPPLIED FOR NON-EXISTENT BINS.
;
;		5.  2-PARAMETER RETRIEVAL IS DONE "COLUMN-WISE," I. E.,
;		    USING "IMPLIED DO" NOTATION, THE ORDER OF RETRIEVAL IS
;    		    ((BIN(I,J),I=IL,IU),J=JL,JU)
;
;		EVENT FLAG 23. IS USED BY THIS SUBROUTINE.
;
; LANGUAGE:	MACRO-11
;
; REFERENCES:	"HISTOGRAMMING AND HISTOGRAM PLOTTING"
;		SEE SUBROUTINE HISTSU FOR A DESCRIPTION OF THE
;		HISTOGRAM DESCRIPTOR ARRAY.
;-
; REVISIONS:
; 02-FEB-77	NS	CHANGE GLOBAL NAMES IN HCOM1 TO AVOID NAME 
;			CONFLICTS.   EFLG=H.H.EFLG, HDBPTR=H.DBPT,
;			MAXHST=H.MXHT, MAXOVF=H.MXOV, OVTBL=H.OTBL
;			DEFINE EIS.  (N.S.)
; 10-MAY-77	LV	UPDATED TO CONFORM TO STANDARDS
;
;
; DEFINE HARDWARE CONFIGURATION. (EIS OR FPU)
;
EIS=0
;
	.MCALL	SDAT$C,CLEF$S,WTSE$S,PUSH,POP
;
; RETRIEVE DATA MESSAGE AND BUFFER
;
BUFFLG=	256.	;BUFFER LENGTH (MAXIMUM)
;
MSG:	.BYTE	0,5		;TYPE, COUNT
	.BYTE	H.EFLG,0		;EVENT FLAG
BLK:	.WORD	0		;STARTING BLOCK (CHANNEL)
	.WORD	BUFF		;BUFFFER LOC
LGH:	.WORD	0		;BUFFER LENGTH (ACTUAL)
;
FRD:	.WORD	0		;FORCE READ FLAG
BUFF:	.BLKW	BUFFLG		;BUFFER
;
; INITIALIZE DATA ARRAY AND GET HISTOGRAM STATUS
;
HISTRE::
	CLR	@4(R5)		;PRE-CLEAR IERR
	CMPB	(R5),#6		;DATA, IL, IU PRESENT?
	BLT	2$		;NO
	CALL	INDATA		;INIT DATA ARRAY
	BCS	1$		;BAD LIMITS
	CALL	GETST		;GET STATUS
	BCC	DATRS		;OK - RETRIEVE DATA
	ADD	#12,SP		;CLEAN STACK
	BR	3$
1$:	MOV	#2,@4(R5)	;IERR=2 - BAD LIMITS
2$:	CALL	GETST		;GET STATUS
	BCC	4$
3$:	MOV	#1,@4(R5)	;IERR=1 - NO HIST
4$:	CALL	HST$UN		;UNLOCK HDBS
	RETURN

;
; DATA RETRIEVAL SETUP
;
; REGISTER AND STACK STATE:
;	R5 = CALL PARAMETER LIST ADDRESS
;	10(R5) = ADDRESS OF DATA ARRAY
;	R4 = HDB ADDRESS
;	  (SP) = IL
;	 2(SP) = IU-IL
;	 4(SP) = JL (0 IF JL AND JU ABSENT)
;	 6(SP) = JU-JL (1 IF JL AND JU ABSENT)
;	10(SP) = ARRAY SIZE
;	12(SP) = SUBPROGRAM RETURN (SAVED R5)
;
;
DATRS:	MOV	#1,R1		;J COUNTER = 1 FOR 1 PAR
	MOV	(SP),R3		;HIST IND = IL FOR 1 PAR
	BITB	#2,HDB.PA(R4)	;1 OR 2 PARAM?
	BEQ	2$		;BRANCH IF ONE
	MOV	HDB.N2(R4),R1	;GET N2
	SUB	4(SP),R1	;FORM N2-JL
	BLOS	4$		;LEAVE IF JL=>N2
	CMP	R1,6(SP)	;FORM MIN(N2-JL,JU-JL)
	BLOS	1$
	MOV	6(SP),R1
1$:	.IF	DF,EIS
	MOV	4(SP),R3	;GET JL
	MUL	HDB.N1(R4),R3	;FORM JL*N1
	.IFF
	MOV	#MQ,R0
	MOV	4(SP),(R0)+	;GET JL
	MOV	HDB.N1(R4),(R0)	;FORM JL*N1
	MOV	-(R0),R3
	.ENDC
	ADD	(SP),R3		;HIST IND = JL*N1+IL
2$:	MOV	HDB.N1(R4),R0	;GET N1
	SUB	(SP),R0		;FORM N1-IL
	BHI	5$		;LEAVE IF IL=>N1
4$:	CALL	HST$UN		;UNLOCK HDBS
	JMP	EXIT
5$:	PUSH	2(SP)		;GET IU-IL
	CMP	R0,(SP)		;FORM MIN(N1-IL,IU-IL)
	BLOS	3$
	MOV	(SP),R0
3$:	SUB	R0,(SP)		;DATA ADDR ADDEND =
	ASL	(SP)		; 4*(IU-MIN(IU,N1))
	ASL	(SP)
	MOV	10(R5),R2	;GET DATA ADDR
	MOV	#1,FRD		;FORCE READ FIRST TIME
;
;
; DATA RETRIEVAL LOOP
;
; REGISTER AND STACK STATE:
;	R5 = CALL PARAMETER LIST ADDRESS
;	R4 = HDB ADDRESS
;	R3 = INITIAL HIST INDEX
;	R2 = DATA ARRAY ADDRESS
;	R1 = INITIAL J COUNTER
;	R0 = INITIAL I COUNTER
;	  (SP) = DATA ADDRESS ADDEND
;	 2(SP) = IL
;	   ETC.
;
;
;
DATRL:	PUSH	<R0,R3>
1$:	JSR	PC,RETCH	;RETRIEVE A CHANNEL
	SOB	R0,1$		;COUNT I
	POP	<R3,R0>
	ADD	HDB.N1(R4),R3	;UPDATE HIST INDEX
	ADD	(SP),R2		;UPDATE DATA ADDR
	SOB	R1,DATRL	;COUNT J
	TST	(SP)+		;POP STACK

; RETRIEVE OVERFLOWS
;
RETO:	MOV	#H.MXOV,R0
	MOV	#H.OTBL,R1
	PUSH	HDB.SZ(R4) 	;PICK UP HIST SIZE
	DEC	(SP)		;FORM SIZE-1
;
;
; OVERFLOW RETRIEVAL LOOP
;
; REGISTER AND STACK STATE:
;	R5 = CALL PARAMETER LIST ADDRESS
;	R4 = HDB ADDRESS
;	R1 = OVFL TABLE ADDRESS
;	R0 = OVFL TABLE LENGTH
;	  (SP) = HIST SIZE-1 (WORDS IF CORE, BLOCKS IF DISK)
;	 2(SP) = IL
;	 4(SP) = IU-IL
;	 6(SP) = JL
;	10(SP) = JU-JL
;	   ETC.
;
;	NOTE:  SIZE-1 IS USED SINCE SIZE=0 MEANS THE SIZE IS 64K.
;
;
;
OVRL:	MOV	(R1)+,R3	;GET OVFL ENTRY (WORD 1)
	MOV	(R1)+,R2	;GET OVFL ENTRY (WORD 2)
	BNE	8$
	TST	R3
	BEQ	7$		;BRANCH IF NO MORE ENTRIES
8$:	CMP	R3,-4(R1)	;VERIFY OVFL ENTRY WORD 1
	BEQ	9$		;OK
	CMP	-(R1),-(R1)	;IT CHANGED
	BR	OVRL		;GET IT AGAIN
9$:	BITB	#HFL.DK,HDB.FL(R4) ;CORE OR DISK?
	BMI	2$		;BRANCH IF DISK
	BIT	#4,R2		;CORE ENTRY?
	BNE	6$		;BRANCH IF NO
	SUB	HDB.ST(R4),R3	;SUBTRACT HIST START
	BLO	6$		;BRANCH IF NOT IN HIST
	CMP	R3,(SP)		;CHECK AGAINST HIST SIZE
	BHI	6$		;BRANCH IF NOT IN HIST
	BR	3$
2$:	BIT	#4,R2		;DISK ENTRY?
	BEQ	6$		;BRANCH IF NO
	BIC	#177774,R2	;MASK TO HIGH CHAN BITS
	SWAB	R2
	SWAB	R3
	BISB	R3,R2		;BUILD BLOCK NO
	SUB	HDB.ST(R4),R2	;SUBTRACT HIST START
	BLO	6$		;BRANCH IF NOT IN HIST
	CMP	R2,(SP)		;CHECK AGAINST HIST SIZE
	BHI	6$		;BRANCH IF NOT IN HIST
	CLRB	R3		;BUILD FULL CHANNEL NO
	BISB	R2,R3
	SWAB	R3
;	THE OVERFLOW IS IN THE HIST BEING RETRIEVED.
;	NOW SEE IF IT'S IN THE SUBMATRIX.
;	R3=CHANNEL NO.
3$:	CLR	R2		;ARRAY OFFSET =0 FOR 1 PAR
	BITB	#2,HDB.PA(R4)	;ONE OR TWO PARAM?
	BEQ	5$		;BRANCH IF ONE
	.IF	DF,EIS
	DIV	HDB.N1(R4),R2	;DIVIDE BY N1
	BVC	4$		;QUOT=J TO R2; REM=I TO R3
	MOV	R3,R2		;TAKE CARE OF (>77777)/1
	CLR	R3
4$:
	.IFF
	MOV	#MQ,R2
	MOV	R3,(R2)		;CHANNEL NO TO MQ
	CLR	-(R2)		;CLEAR AC
	MOV	HDB.N1(R4),-2(R2) ;N1 TO DIV
	MOV	(R2)+,R3	;REM=I TO R3
	MOV	(R2),R2		;QUOT=J TO R2
	.ENDC
	CMP	R2,HDB.N2(R4)
	BHIS	6$		;BRANCH IF J=>N2
	SUB	6(SP),R2	;FORM J-JL
	BLO	6$		;BRANCH IF J-JL<0
	CMP	R2,10(SP)
	BHIS	6$		;BRANCH IF J-JL=>JU-JL
	.IF	DF,EIS
	PUSH	R3
	MOV	R2,R3		;FORM ARRAY OFFSET
	MUL	6(SP),R3	; =(J-JL)*(IU-IL)
	MOV	R3,R2
	POP	R3
	.IFF
	MOV	R2,@#MQ		;FORM ARRAY OFFSET
	MOV	4(SP),@#MUL	; =(J-JL)*(IU-IL)
	MOV	@#MQ,R2
	.ENDC
5$:	CMP	R3,HDB.N1(R4)
	BHIS	6$		;BRANCH IF I=>N1
	SUB	2(SP),R3	;FORM I-IL
	BLO	6$		;BRANCH IF I-IL<0
	CMP	R3,4(SP)
	BHIS	6$		;BRANCH IF I-IL=>IU-IL
	ADD	R2,R3		;FORM  ARRAY INDEX
	ASL	R3
	ASL	R3
	ADD	10(R5),R3	;ADD ARRAY ORIGIN
	MOV	-2(R1),(R3)	;INSERT OVERFLOW CT
	ROR	(R3)		; (C CLEARED BY ADD)
	ASR	(R3)
	ASR	(R3)
6$:	DEC	R0
	BNE	OVRL		;LOOP IF MORE
7$:	TST	(SP)+		;POP STACK
	CALL	HST$UN		;UNLOCK HDBS

; CONVERT DATA TO FLOATING POINT
;
CVTF:	.IF	DF,FPU
	SETF
	SETL
	.ENDC
	.IF	NDF,EIS
	MOV	#MQ,R2		;SET UP EAE POINTERS
	MOV	#LSH,R3
	.ENDC
	MOV	10(R5),R0	;GET ARRAY ADDRESS
	MOV	10(SP),R1	;GET ARRAY SIZE
1$:	.IF	DF,FPU
	LDCLF	(R0),F0		;PICK UP AND CONVERT DATA
	STF	F0,(R0)+	;STORE BACK
	.IFF
	.IF	DF,EIS
	MOV	(R0),R2		;GET DATA MSH
	MOV	2(R0),R3	;GET DATA LSH
	BNE	2$		;BRANCH IF NOT ZERO
	TST	R2		;IS MSH ZERO?
	BEQ	4$		;BRANCH IF YES
2$:	MOV	#241,R4		;INITIALIZE EXPONENT
3$:	DEC	R4		;NORMALIZE
	ASL	R3		; .
	ROL	R2		; .
	BCC	3$		; .
	CLRB	R3		;SHUFFLE THE BYTES AROUND
	BISB	R2,R3
	CLRB	R2
	BISB	R4,R2		;PACK EXPONENT
	SWAB	R2		;MORE BYTE SHUFFLING
	SWAB	R3
	ROR	R2		;ADJUST FP NUMBER
	ROR	R3
4$:	MOV	R2,(R0)+	;STORE FLOATED DATA
	MOV	R3,(R0)+
	.IFF
	MOV	2(R0),(R2)	;DATA LSH TO MQ
	MOV	(R0),-(R2)	;DATA MSH TO AC
	CLR	-(R3)		;NORMALIZE
	MOV	#237,R4
	SUB	(R3)+,R4	;COMPUTE EXPONENT
	TST	(R2)		;CHECK FOR ZERO
	BEQ	4$		;BRANCH IF YES
	MOV	#-6,(R3)	;ALIGN FRACTION
	MOVB	R4,1(R2)	;PACK EXPONENT
	MOV	#-1,(R3)	;ADJUST FP NUMBER
4$:	MOV	(R2)+,(R0)+	;STORE FLOATED DATA
	MOV	(R2),(R0)+
	.ENDC
	.ENDC
	SOB	R1,1$
;
; EXIT
;
EXIT:	ADD	#12,SP		;CLEAN STACK
	RETURN

;
;
;	INDATA	INITIALIZE DATA ARRAY SUBROUTINE
;
; THIS ROUTINE VALIDATES THE HISTOGRAM BIN LIMITS FOR RETRIEVAL,
; AND INITIALIZES THE USER'S DATA ARRAY TO ALL ZEROS.
;
; ENTRY CONDITIONS:
;
;	R5 POINTS TO ARGUMENT LIST
;	10(R5) = ADDRESS OF DATA ARRAY
;	@12(R5) = IL
;	@14(R5) = IU
;	@16(R5) = JL
;	@20(R5) = JU
;
;	CALL	INDATA
;
; EXIT CONDITONS:
;
;	IF BIN LIMITS ARE VALID:
;
;	C BIT IS CLEARED
;	DATA ARRAY IS ZEROED
;	THE FOLLOWING OUTPUTS ARE ON THE STACK:
;	(SP) = IL (USER IL-1)
;	2(SP) = IU-IL (USER IU-IL+1)
;	4(SP) = JL (USER JL-1; ZERO IF NO JL, JU ARGS)
;	6(SP) = JU-JL (USER JU-JL+1; ONE IF NO JL, JU ARGS)
;	10(SP) = ARRAY SIZE (USER (IU-IL+1)*(JU-JL+1))
;
;	IF BIN LMITS ARE NOT VALID:
;
;	C BIT IS SET
;	DATA ARRAY IS NOT CHANGED
;	STACK IS SAME AS AT CALL
;
;	UNCHANGED REGISTER: R5
;	CHANGED REGISTERS: R0, R1, R2, R3, R4
;
;
;
INDATA:	MOV	R5,R4	
	ADD	#12,R4		;POINT TO INDEX PARAMS
	MOV	@(R4)+,R0	;PICK UP IL
	BLE	4$		;BRANCH IF INVALID
	DEC	R0		;ADJUST IL
	MOV	@(R4)+,R1	;PICK UP IU
	SUB	R0,R1		;FORM IU-IL
	BLE	4$		;BRANCH IF =<0
	CMPB	(R5),#8.	;ARE JL AND JU PRESENT?
	BLT	1$		;BRANCH IF NO
	MOV	@(R4)+,R2	;PICK UP JL
	BLE	4$		;BRANCH IF INVALID
	DEC	R2		;ADJUST JL
	MOV	@(R4)+,R3	;PICK UP JU
	SUB	R2,R3		;FORM JU-JL
	BLE	4$		;BRANCH IF =<0
	.IF	DF,EIS
	PUSH	R3
	MUL	R1,R3		;ARRAY SIZE = (IU-IL)*(JU-JL)
	MOV	R3,R4		;SAVE ARRAY SIZE
	POP	R3
	BCS	4$		;BRANCH IF TOO BIG
	.IFF
	MOV	#MQ,R4
	MOV	R1,(R4)+
	MOV	R3,(R4)		;ARRAY SIZE = (IU-IL)*(JU-JL)
	BITB	#2,@#SR
	BEQ	4$		;BRANCH IF TOO BIG
	MOV	-(R4),R4	;SAVE ARRAY SIZE
	.ENDC
	BR	2$
1$:	MOV	R1,R4		;ARRAY SIZE = IU-IL
	MOV	#1,R3		;JU-JL = 1
	CLR	R2		;JL = 0
2$:	PUSH	<R3,R2,R1,R0>	;PUT RESULTS ON STACK
	PUSH	10(SP)		;FISH OUT RETURN
	MOV	R4,12(SP)	;PUT ARRAY SIZE ON STACK
;
; PRE-CLEAR DATA ARRAY
;
	MOV	10(R5),R0	;ADDR OF DATA
3$:	CLR	(R0)+		;CLEAR ONE ELEMENT
	CLR	(R0)+
	SOB	R4,3$
	RETURN			;(C IS CLEAR FROM CLR)
;
; ERROR EXIT
;
4$:	SEC
	RETURN

;
;	GETST	GET STATUS SUBROUTINE
;
; THIS ROUTINE FINDS THE HDB CORRESPONDING TO THE HDA SUPPLIED
; BY THE USER, AND COPIES THE HISTOGRAM STATUS FROM THE
; HDB TO THE HDA (AND TO THE ARGUMENT REJ, IF PRESENT).
;
; ENTRY CONDITIONS:
;
;	R5 POINTS TO ARGUMENT LIST
;	2(R5) = ADDRESS OF HDA
;	6(R5) = ADDRESS OF REJ
;
;	CALL	GETST
;
; EXIT CONDITIONS:
;
;	IF THE HISTOGRAM EXISTS:
;	STATUS IS COPIED TO THE HDA, AND REJECTED EVENT COUNT TO
;	REJ, IF PRESENT.
;	R4 = ADDRESS OF HDB
;
;	IF THE HISTOGRAM DOES NOT EXIST:
;
;	C BIT IS SET
;	HDA AND REJ ARE UNCHANGED
;
;	UNCHANGED REGISTER: R5
;	CHANGED REGISTERS: R0,R1,R2,R3,R4
;
;
;
GETST:	CALL	HST$LK		;LOCK HDBS
	MOV	2(R5),R4	;GET HDA ADDRESS
	CALL	HST$FI		;FIND HDB
	BCS	9$		;NO HISTOGRAM
	PUSH	R3		;SAVE HDB ADDR
	TST	(R3)+		;POP OVER LINK
	MOV	R4,R0		;POINT R0 TO HDA NAME FIELD
	MOV	(R3)+,R1	;GET 1ST 3 CHARS OF NAME
	CALL	$C5TA		;CONVERT NAME TO ASCII
	MOV	(R3)+,R1	;GET 2ND 3 CHARS OF NAME
	CALL	$C5TA		;CONVERT NAME TO ASCII
	MOV	R0,R4		;UPDATE HDA PTR
	MOV	(R3)+,(R4)+	;GET OWNER
	CMP	(R3)+,(R3)+	;IGNORE START AND SIZE
	MOV	#H.DBPT,R0	;POINT TO NUMBER TABLE
	MOV	#H.MXHT,R1
1$:	CMP	(R0)+,(SP)	;LOOK FOR POINTER TO HDB
	BEQ	2$		;FOUND
	SOB	R1,1$
	CLR	(R4)+		;NOT FOUND
	BR	3$		
2$:	SUB	#H.DBPT,R0	;COMPUTE NUMBER
	ASR	R0		
	MOV	R0,(R4)+	;PUT NUMBER IN HDA
3$:
	.IF	DF,FPU
	SETF
	SETL
	PUSH	(R3)+		;PUT REJ (LSH) ON STACK
	CLR	-(SP)
	MOVB	(R3)+,(SP)	;PUT REJ (MSH) ON STACK
	LDCLF	(SP)+,F0	;CONVERT TO REAL
	CMPB	(R5),#3		;IS REJ PRESENT?
	BLT	7$		;NO
	STF	F0,@6(R5)	;STORE IN ARG
	.IFF
	MOV	(R3)+,R1	;GET REJ (LSH)
	CLR	R0
	BISB	(R3)+,R0	;GET REJ (MSH)
	CMPB	(R5),#3		;IS REJ PRESENT?
	BLT	7$		;NO
	MOV	R0,R2		;CHECK FOR ZERO
	BIS	R1,R2		
	BEQ	6$		;SKIP NORMALIZE IF ZERO
	MOV	#231,R2		;INITIALIZE EXPONENT
5$:	DEC	R2
	ASL	R1		;NORMALIZE
	ROLB	R0
	BCC	5$
	SWAB	R2		;PACK EXPONENT (CLEAR C)
	BIS	R2,R0		
	ROR	R0		;ALIGN FP NUMBER
	ROR	R1
6$:	MOV	6(R5),R2	;GET ADDR OF REJ ARG
	MOV	R0,(R2)+	;STORE REJ
	MOV	R1,(R2)
	.ENDC
7$:	MOVB	(R3),R0		;GET NO. OF PARAMS
	BIC	#177400+HFL.FL,R0 ;CLEAN UP
	MOV	R0,(R4)+	;SAVE IN HDA
	BITB	#HFL.DK,(R3)+	;CORE OR DISK
	BEQ	8$		;CORE
	NEG	-2(R4)		;DISK
8$:	CALL	GETP		;GET A PARAMETER
	SOB	R0,8$
	POP	R4		;RETURN HDB ADDR
	CLC			;OK
9$:	RETURN

;
;	GETP	GET PARAMETER SUBROUTINE
;
; THIS ROUTINE MOVES INFORMATION ABOUT ONE PARAMETER FROM THE
; HDB TO THE HDA, TRANSLATING FROM HDB TO HDA FORMAT WHEN
; NECESSARY.
;
; ENTRY CONDITIONS:
;
;	R3 POINTS TO PARAMETER BLOCK IN HDB
;	R4 POINTS TO PARAMETER BLOCK IN HDA
;
;	CALL	GETP
;
; EXIT CONDITIONS:
;
;	PARAMETER DATA IS COPIED TO THE HDA
;	R3 AND R4 ARE STEPPED PAST THEIR RESPECTIVE PARAMETER
;	BLOCKS, AND POINT TO THE NEXT BLOCK, IF ANY.
;	UNCHANGED REGISTERS: R0,R5
;	CHANGED REGISTERS: R1,R2,R3,R4
;
;
GETP:	MOV	(R3)+,(R4)	;GET DATA INDEX
	ASR	(R4)+		;BYTE TO WORD
	MOV	(R3)+,(R4)	;GET MASK
	COM	(R4)		;CHANGE FROM 'BIC' TO 'AND'
	MOV	(R4)+,(R4)	;SAVE COPY FOR SHIFTING
	MOV	(R3)+,R1	;GET LOWER LIMIT
	MOV	(R3)+,R2	;GET BIN SIZE
	BR	2$
1$:	ROR	R1		;ALIGN LOWER LIMIT
	ROR	R2		;ALIGN BIN SIZE
2$:	ASR	(R4)		;CHECK FOR RT-HAND END OF MASK
	BCC	1$		;NOT YET
	MOV	R1,(R4)+	;PUT LOWER LIM IN HDA
	MOV	R2,(R4)+	;PUT BIN SIZE IN HDA
	MOV	(R3)+,(R4)+	;GET NUMBER OF BINS
	RETURN

;
;	RETCH	RETRIEVE CHANNEL SUBROUTINE
;
; THIS ROUTINE RETRIEVES ONE HISTOGRAM CHANNEL (BIN)
;
; ENTRY CONDITIONS:
;
;	R2 = ADDRESS AT WHICH TO STORE DATA
;	R3 = RELATIVE CHANNEL NUMBER WITHIN HISTOGRAM
;	R4 = ADDRESS OF HDB
;	BLK = NUMBER OF DATA BLOCK CURRENTLY IN BUFFER
;	FRD FORCES A READ IF SET NON-ZERO.
;
;	CALL	RETCH
;
; EXIT CONDITIONS:
;
;	(R2) IS SET TO ZERO, AND THE RETRIEVED DATA ITEM IS
;	STORED AT (R2)+2.
;	R2 IS INCREMENTED BY 4 (2 WORDS).
;	R3 IS INCREMENTED BY 1.
;	BLK IS UPDATED IF A READ FROM CORE OR DISK WAS REQUIRED.
;	FRD IS SET TO ZERO.
;	OTHER REGISTERS ARE UNCHANGED.
;
;
;
	.ENABL	LSB
RETCH:	PUSH	<R0,R1>
	MOV	R3,R0		;GET CHANNEL NUMBER
	BITB	#HFL.DK,HDB.FL(R4) ;CORE OR DISK?
	BNE	2$		;DISK
;
; RETRIEVE FROM CORE
;
	ADD	HDB.ST(R4),R0	;ADD IN CORE START
	TST	FRD		;READ FORCED?
	BNE	1$		;YES
	MOV	R0,R1		;COMPUTE OFFSET IN CURRENT BUFF
	SUB	BLK,R1
	BLO	1$		;NEED NEW BUFF
	CMP	R1,#BUFFLG	;WITHIN CURRENT BUFF?
	BLO	4$		;YES
1$:	MOV	HDB.SZ(R4),R1	;SEE HOW CLOSE WE ARE
	SUB	R3,R1		; TO THE END OF THE HIST
	CMP	R1,#BUFFLG	;CLOSER THAN BUFFER LENGTH?
	BLOS	10$		;YES
	MOV	#BUFFLG,R1	;NO - LOAD ENTIRE BUFFER
10$:	MOV	R1,LGH		;SET ACTUAL BUFFER LENGTH
	CLR	R1		;OFFSET IN NEW BUFF IS ZERO
	MOVB	#3,MSG		;SET TO RETRIEVE CORE
	BR	3$
;
; RETRIEVE FROM DISK
;
2$:	CLR	R1		;GET OFFSET IN BUFFER
	BISB	R0,R1
	CLRB	R0		;GET DISK BLOCK
	SWAB	R0
	TST	FRD		;READ FORCED?
	BNE	5$		;YES
	CMP	R0,BLK		;SAME AS CURRENT BLOCK?
	BEQ	4$		;YES
5$:	MOV	#BUFFLG,LGH	;SET BUFFER LENGTH
	MOVB	#4,MSG		;SET TO RETRIEVE DISK
;
; WE NEED TO RELOAD THE BUFFER.  R0 HAS STARTING CHANNEL OR BLOCK.
;
3$:	MOV	R0,BLK		;UPDATE CURRENT BLOCK
	CLR	FRD		;UNFORCE READ
	CLEF$S	#H.EFLG
	SDAT$C	HSTMGE,MSG	;LOAD BUFFER
	WTSE$S	#H.EFLG
;
; BUFFER IS LOADED.  R1 HAS WORD OFFSET IN BUFFER.
;
4$:	ASL	R1		;WORD TO BYTE OFFSET
	CLR	(R2)+		;CLEAR DATA MSH
	MOV	BUFF(R1),(R2)+	;STORE DATA LSH
	INC	R3		;BUMP CHANNEL
	POP	<R1,R0>
	RETURN
	.DSABL	LSB
;
	.END