.TITLE	HISTSU - HISTOGRAM SETUP ROUTINE
	.IDENT	/25MAY7/	;14:35;00  LV
;	.ENTRY	HISTSU - HISTOGRAM SETUP ROUTINE
;+
; H I S T S U
;
; PURPOSE:	HISTOGRAM SETUP ROUTINE
;		THIS ROUTINE CREATES A HISTOGRAM ACCORDING TO THE
;		SPECIFICATION IN THE HDA.  IF THE HISTOGRAM ALREADY
;		EXISTS, AN ERROR INDICATION IS RETURNED.  THE
;		HISTOGRAM NAME MUST BE SPECIFIED IN THE HDA.
;
;		A HISTOGRAM NAME IS 6 ASCII CHARACTERS WHICH MUST BE
;		IN THE RAD50 SUBSET: SPACE, PERIOD, DOLLAR SIGN, 0-9, OR A-Z.
;
;		A SUCCESSFUL CALL (IERR=0) CAUSES THE NUMBER OF THE
;		CREATED HISTOGRAM TO BE STORED IN THE HDA.
;
; INTERFACE:	CALLING SEQUENCE:  (FORTRAN-CALLABLE SUBROUTINE)
;			CALL HISTSU(HDA,IERR)
;
;	INPUT:	HDA (INTEGER ARRAY):  HISTOGRAM DESCRIPTOR ARRAY
;
;		THE HDA IS THE MEANS BY WHICH THE USER DESCRIBES
;		OR IDENTIFIES A HISTOGRAM TO THE PACKAGE, OR
;		RECEIVES STATUS INFORMATION FROM THE PACKAGE.
;		IT IS USED BY THE PACKAGE ONLY DURING SUBROUTINE
;		EXECUTION, AND CAN BE FREELY CHANGED BY THE USER AT
;		OTHER TIMES.  IT IS NOT NECESSARY FOR THE USER TO
;		MAINTAIN AN HDA FOR EACH HISTOGRAM, SINCE THIS
;		INFORMATION IS MAINTAINED INTERNALLY BY THE PACKAGE.
;
;		THE HDA IS A ONE-WORD INTEGER ARRAY.
;
;		HDA(1) - HDA(3): HISTOGRAM NAME (SIX ASCII CHARACTERS).  THE
;		  CHARACTERS MUST BE FROM THE RAD50 SUBSET, AND EMBEDDED SPACES
;		  ARE NOT ALLOWED (BUT TRAILING SPACES ARE).  IF HDA(1)=0, THEN
;		  THE HISTOGRAM IS ASSUMED TO BE IDENTIFIED BY ITS NUMBER.  THIS
;		  IS NOT ALLOWED BY HISTSU.
;
;		HDA(4): HISTOGRAM OWNER.  THIS CAN BE ANY INTEGER UNIQUE TO THE
;		  OWNER, BUT IT IS RECOMMENDED THAT THE OWNER'S PACKED UIC BE
;		  USED (THE HIGH BYTE CONTAINS THE OWNER'S GROUP NUMBER, AND
;		  THE LOW BYTE HIS INDIVIDUAL USER NUMBER).  AS AN EXAMPLE, IF
;		  THE OWNER'S UIC IS [50,60], THEN THE OCTAL VALUE OF HDA(4)
;		  SHOULD BE 2460.
;
;		  IF THE HISTOGRAM NAME IS GIVEN, THE OWNER MUST ALSO BE GIVEN.
;
;		HDA(5): HISTOGRAM NUMBER.  THIS NUMBER IS ASSIGNED BY HISTSU
;		  WHEN THE HISTOGRAM IS CREATED.  NUMBERS ARE ASSIGNED SEQUEN-
;		  TIALLY STARTING AT ONE.  IF A HISTOGRAM IS DELETED, ITS
;		  NUMBER BECOMES AVAILABLE FOR REASSIGNMENT.
;
;		  THE NUMBER IS USED TO IDENTIFY THE HISTOGRAM TO HISTEN, AND
;		  MAY BE USED TO IDENTIFY IT TO OTHER ROUTINES BY SETTING
;		  HDA(1) = 0.
;
;		THE REST OF THE HDA IS USED ONLY BY SUBROUTINES HISTSU (TO
;		SPECIFY THE HISTOGRAM) AND HISTRE (TO RECEIVE THE HISTOGRAM
;		STATUS).
;
;		HDA(6): NUMBER OF PARAMETERS.  THE MAGNITUDE MUST BE ONE OR TWO.
;		  THE SIGN IS POSITIVE FOR A CORE HISTOGRAM, AND NEGATIVE FOR
;		  A DISK HISTOGRAM.
;
;		THE NEXT FIVE ARRAY ELEMENTS DESCRIBE THE FIRST (OR ONLY)
;		PARAMETER OF THE HISTOGRAM.  THEY SPECIFY TO HISTEN HOW TO
;		PROCESS THE DATA BLOCK TO DETERMINE WHICH BIN TO INCREMENT.
;
;		HDA(7): DATA INDEX (I1)
;
;		HDA(8): MASK (M1).  I1 AND M1 SELECT THE ITEM IN THE DATA BLOCK
;		  TO BE HISTOGRAMMED.  I1 IS THE OFFSET IN WORDS FROM THE
;		  BEGINNING OF THE BLOCK TO THE WORD CONTAINING THE ITEM (I1=0
;		  REFERS TO THE FIRST WORD IN THE BLOCK).  A LOGICAL "AND" IS
;		  PERFORMED BETWEEN THIS WORD AND M1 TO EXTRACT A FIELD, AND
;		  THE NUMBER IN THIS FIELD IS TREATED AS AN INTEGER VALUE WHOSE
;		  LOW-ORDER BIT CORRESPONDS TO THE RIGHTMOST "ONE" BIT IN THE
;		  MASK.  THIS VALUE IS REFERRED TO AS X1 BELOW.
;
;		HDA(9): LOWER LIMIT (L1)
;
;		HDA(10): BIN SIZE (S1)
;
;		HDA(11): NUMBER OF BINS (N1): THE FOLLOWING FORMULA IS APPLIED
;		  TO THE DATA VALUE X1 TO DETERMINE THE BIN B TO INCREMENT:
;
;		  B = MIN[N1-1,MAX[0,(X1-L1)/S1]]
;
;		  NOTE THAT HERE THE BINS ARE NUMBERED 0 TO N1-1, ALTHOUGH IN
;		  HISTRE THEY ARE NUMBERED 1 TO N1.  NOTE ALSO THAT "UNDERFLOWED"
;		  AND "OVERFLOWED" BIN NUMBERS INCREMENT THE LOWEST AND HIGH-
;		  EST BINS, RESPECTIVELY.
;
;		THE NEXT FIVE ARRAY ELEMENTS DESCRIBE THE SECOND PARAMETER OF
;		THE HISTOGRAM, IF PRESENT.
;
;		HDA(12): DATA INDEX (I2)
;
;		HDA(13): MASK (M2)
;
;		HDA(14): LOWER LIMIT (L2)
;
;		HDA(15): BIN SIZE (S2)
;
;		HDA(16): NUMBER OF BINS (N2).  FOR A 2-PARAMETER HISTOGRAM, THE
;		  FOLLOWING FORMULAS DETERMINE B:
;
;		  B1 = MIN[N1-1,MAX[0,(X1-L1)/S1]]
;
;		  B2 = MIN[N2-1,MAX[0,(X2-L2)/S2]]
;
;		  B = B2*N1+B1
;
;		IERR (OUT, INTEGER):  ERROR STATUS
;
;			IERR=0:	NO ERROR
;			IERR=1:	INSUFFICIENT HISTOGRAM MEMORY AVAILABLE
;			IERR=2:	INSUFFICIENT SPACE IN HDB POOL
;			IERR=3:	NO SLOT AVAILABLE IN NUMBER TABLE
;			IERR=4:	NUMBER OF PARAMETERS IS NOT 1 OR 2
;			IERR=5:	PARAMETER INFORMATION INVALID OR INTERNALLY
;			  INCONSISTENT
;			IERR=6:	HISTOGRAM NAME NOT GIVEN OR INVALID
;			IERR=7:	HISTOGRAM ALREADY EXISTS
;			IERR=8:	CANNOT INITIALIZE PACKAGE
;
;		EVENT FLAGS 23. AND 24. ARE USED BY THIS SUBROUTINE
;
; LANGUAGE:	MACRO-11
;
; REFERENCES:	"HISTOGRAMMING AND HISTOGRAM PLOTTING"
;
;-
; REVISIONS:
; 04-JUN-75	MK	WRITTEN
; 15-JAN-76	MK	FIX SCREWUP OF NAMES <3 CHARS
; 14-NOV-76	SS	CHANGE EXEC$C FOR HSTMGE TO RQST$C FOR 11M
;			COMPATIBILITY.  REMOVE LINE DEFINING $DSW!!!
; 02-FEB-77	NS	CHANGE GLOBAL NAMES IN HCOM1 TO AVOID NAME
;			CONFLICTS. 
;			CORCHN=H.CRCH, CQ=H.CORQ, CQPTR=H.CQPT,
;			C1BG=H.C1BG, C1ND=H.C1ND, C2BG=H.C2BG,
;			C2ND=H.C2ND, C3BG=H.C3BG, C3ND=H.C3ND,
;			DSKCHN=H.DKCH, EFLG=H.EFLG, ENABL=H.ENBL,
;			HDBFHD=H.DBFH, HDBLGH=H.DBLG, HDBMEM=H.DBME,
;			HDBPTR=H.DBPT, INTLOK=H.INLK, MAXHST=H.MXHT
; 07-FEB-77	NS	MISSED CQ. 
; 25-MAY-77	LV	UPDATED TO CONFORM TO STANDARDS
;

	.MCALL	SDAT$C,CLEF$S,WTSE$S,MRKT$C
	.MCALL	RQST$C,PUSH,POP
;
; MEMORY REQUIRED MESSAGE (TO SEND TO HSTMGE)
;
MSG:	.BYTE	0,3		;TYPE, COUNT
	.BYTE	H.EFLG,0		;EVENT FLAG
	.WORD	0		;MEMORY NEEDED
;
; SEE WHETHER PACKAGE IS INITIALIZED, AND INTITIALIZE IF NOT
;
HISTSU::
	TST	H.ENBL		;CHECK ENABLE FLAG
	BNE	HS1		;SET
	MOV	#H.C1BG,R0	;ZERO EVERYTHING
1$:	CLR	(R0)+
	CMP	R0,#H.C1ND
	BNE	1$
	MOV	#H.C2BG,R0
2$:	CLR	(R0)+
	CMP	R0,#H.C2ND
	BNE	2$
	MOV	#H.C3BG,R0
3$:	CLR	(R0)+
	CMP	R0,#H.C3ND
	BNE	3$
	DEC	H.INLK		;RESET INTERLOCK
	MOV	#H.CORQ,H.CQPT	;INITIALIZE CORE QUEUE
	MOV	#H.DBME,H.DBFH	;INITIALIZE HDB FREE CORE
	MOV	#H.DBLG*2,H.DBME+2
	RQST$C	HSTMGE		;START UP HSTMGE
	BCC	4$
	MOV	#8.,R0		;ERROR 8 - CAN'T START HSTMGE
	JMP	ERRC
4$:	MRKT$C	24.,1,2		;WAIT 1 SECOND
	WTSE$S	#24.
	INC	H.ENBL		;SET ENABLE FLAG
;
; CHECK WHETHER THE HISTOGRAM ALREADY EXISTS, AND WHETHER THE NAME
; IS VALID.
;
HS1:	MOV	2(R5),R4	;GET HDA ADDRESS
	TST	(R4)		;CHECK FOR NAME
	BEQ	ERR6		;NO NAME
	MOV	PC,R1		;SET R1 NON-ZERO
	MOV	R4,R0		;POINT R0 TO NAME
	CALL	$CAT5		;CONVERT 1ST 3 CHARACTERS
	BCC	9$		;3 CHARS CONVERTED
	DEC	R0		;POINT BACK TO NON-RAD50 CHAR (OR SPACE)
9$:	JSR	R1,(PC)		;SAVE RAD50, SET R1 NON-ZERO
	CALL	$CAT5		;CONVERT 2ND 3 CHARACTERS
	POP	R0		;RECOVER 1ST 3 CHARACTERS
	BCC	11$
10$:	CMP	R2,#40		;DID SPACE STOP THE SCAN?
	BNE	ERR6		;NO - BAD NAME
11$:	CALL	HST$LK		;LOCK HDB STRUCTURE
	CALL	HST$FI		;CHECK WHETHER HIST EXISTS
	BCC	ERR7		;IT DOES - ERROR
;
; THE NAME IS VALID, THE HISTOGRAM DOES NOT EXIST, AND THE HDBS
; ARE LOCKED. NOTE THAT THE RAD50 NAME IS IN R0 AND R1.
;
; NOW CREATE THE NEW HDB ON THE STACK.
;
	PUSH	#1		;PRE-STORE 1 IN N2
	SUB	#<HD2.SZ-5>*2,SP ;MAKE ROOM ON THE STACK
	PUSH	<HDA.OW(R4),R1,R0> ;SAVE NAME AND OWNER
	CLR	-(SP)		;RESERVE SPACE FOR LINK
	MOV	SP,R0
	ADD	#HDB.RJ,R0	;POINT TO REJ EVENT CT
	CLR	(R0)+		;CLEAR IT
	CLR	(R0)+		;ALSO CLEAR FLAGS
	DEC	R0		;POINT TO FLAGS
	MOV	HDA.PA(R4),R1	;GET NO. OF PARAMETERS
	BEQ	ERR4		;CAN'T BE ZERO
	BGT	1$		;CORE OR DISK?
	BISB	#HFL.DK,(R0)	;DISK
	NEG	R1
1$:	CMP	R1,#2		;NO. OF PARAMETERS LEGAL?
	BGT	ERR4		;NO
	BISB	R1,(R0)+	;PUT NO. OF PARAMETERS IN HDB
;
; WE ARE NOW READY TO VALIDATE AND SET UP PARAMETERS.
;
;	R0 POINTS TO FIRST PARAMETER BLOCK IN NEW HDB
;	R1 = NUMBER OF PARAMETERS
;	R4 POINTS TO HDA
;
	ADD	#HDA.I1,R4	;POINT TO PARAMETERS IN HDA
2$:	CALL	SETP		;SET UP PARAMETER
	BCS	ERR5		;BAD PARAMETER INFORMATION
	SOB	R1,2$
;
; USE N1 AND N2 TO COMPUTE SIZE. NOTE THAT FOR A 1-PARAMETER HISTOGRAM,
; THE 1 THAT WAS PRE-STORED IN N2 IS STILL THERE.
;
	MOV	HDB.N1(SP),R0	;COMPUTE N1*N2
	MUL	HDB.N2(SP),R0	
	TST	R0		;CHECK RESULT RANGE
	BEQ	3$		;<64K IS OK
	DEC	R0		;=64K IS OK, T00
	BIS	R0,R1
	BNE	ERR5		;BUT >64K IS A NO-NO
;
; PUT SIZE IN HDB AND SET UP PARAMETERS FOR SEARCH OF HDB CHAIN.
;
3$:	MOV	#H.CRCH,R3	;R3 WILL BE CURRENT HDB PTR
	MOV	H.DKCH,R2	;R2 WILL BE END-OF-CHAIN PTR
	MOVB	#9.,MSG		;SET UP GET CORE MESSAGE
	BITB	#HFL.DK,HDB.FL(SP) ;CHECK FOR DISK HIST
	BEQ	4$		;CORE HIST
	MOV	#H.DKCH,R3	;SET R2 AND R3 FOR DISK CHAIN
	CLR	R2
	INCB	MSG		;SET UP GET DISK MESSAGE
	DEC	R1		;CONVERT SIZE TO DISK BLOCKS
	CLRB	R1
	SWAB	R1
	INC	R1
4$:	MOV	R1,HDB.SZ(SP)	;PUT SIZE IN HDB
	DEC	R1		;PUT SIZE-1 IN R1
;
; SEARCH THE HDB CHAIN.
;
;	R1 = SIZE-1 OF NEW HDB
;	R2 = VALUE OF LINK WORD OF LAST HDB IN CHAIN
;	R3 = ADDRESS OF POINTER TO FIRST HDB IN CHAIN
;	IF (R3)=R2, THERE IS NO CHAIN
;
HS2:	CLR	R0		;INITIALIZE SEARCH FOR FREE MEMORY
1$:	MOV	R0,HDB.ST(SP)	;SET UP TENTATIVE HIST START
	MOV	(R3),R4		;GET ADDRESS OF NEXT HDB
	CMP	R4,R2		;DOES IT EXIST?
	BEQ	HS3		;NO
	ADD	R1,R0		;FIND WHERE TOP OF NEW HIST WOULD BE
	BCS	ERR1		;CATCH OVERFLOW
	CMP	R0,HDB.ST(R4)	;DOES IT FIT?
	BLO	HS4		;YES
	MOV	R4,R3		;POINT R3 TO NEXT HDB
	MOV	HDB.SZ(R3),R0	;GET HIST SIZE
	BEQ	ERR1		;ZERO MEANS 64K - GIVE UP
	ADD	HDB.ST(R3),R0	;COMPUTE NEXT AVAILABLE ADDRESS
	BCC	1$		;NO OVERFLOW
;	BR	ERR1
;
; ERROR EXITS:
;
; THESE ARE STUCK IN HERE TO BRING THE BRANCHES TO THEM WITHIN RANGE.
;
ERR1:	MOV	#1,R0
	BR	ERRA
ERR2:	MOV	#2,R0
	BR	ERRA
ERR3:	MOV	#3,R0
	BR	ERRA
ERR4:	MOV	#4,R0
	BR	ERRA
ERR5:	MOV	#5,R0
	BR	ERRA
ERR6:	MOV	#6,R0
	BR	ERRC
ERR7:	MOV	#7,R0
	BR	ERRB
ERRA:	ADD	#HD2.SZ*2,SP	;CLEAR STACK
ERRB:	CALL	HST$UN		;UNLOCK HDBS
ERRC:	MOV	R0,@4(R5)	;SIGNAL ERROR
	RETURN

; THE HDB CHAIN SEARCH HAS TWO EXITS (NOT COUNTING ERRORS). IN ONE CASE,
; A HOLE IN THE HIST ALLOCATION WAS FOUND; IN THE OTHER CASE, IT WAS
; NOT. IN EITHER CASE, R3 POINTS TO THE LINK OF THE PRECEDING HDB IN
; THE CHAIN, AND R4 CONTAINS THE LINK OF THE NEW HDB.
;
; THE FOLLOWING CODE HANDLES THE CASE WHERE NO HOLE WAS FOUND.
;
HS3:	ADD	R0,R1		;GET TOP OF NEW HIST
	BCS	ERR1		;CATCH OVERFLOW
	INC	R1	
	MOV	R1,MSG+4	;SET UP MEMORY NEEDED IN MSG
	CLEF$S	#H.EFLG		;CLEAR EVENT FLAGS
	CLEF$S	#H.EFLG+1	
	SDAT$C	HSTMGE,MSG	;SEND MESSAGE TO HSTMGE
	WTSE$S	#H.EFLG		;WAIT FOR COMPLETION
	CLEF$S	#H.EFLG+1		;CHECK NAK FLAG
	TST	$DSW		;IF SET, CAN'T GET MEMORY
	BNE	ERR1
;
; THERE IS SPACE IN HISTOGRAM MEMORY AND A COMPLETE HDB ON THE STACK.
; WE NEED TO FIND A SLOT IN THE NUMBER TABLE AND SPACE IN THE HDB
; POOL BEFORE WE CAN ACTUALLY CREATE THE HISTOGRAM.
;
HS4:	MOV	R4,(SP)		;SET UP LINK
	MOV	#H.DBPT,R4	;SEARCH PTR TABLE FOR A SLOT
4$:	MOV	#H.MXHT,R0	
	TST	(R4)+
	BEQ	5$		;FOUND ONE
	SOB	R0,4$
	BR	ERR3		;CAN'T FIND ONE
5$:	MOV	#H.DBFH,R0	;GET POOL HEAD ADDRESS
	BITB	#2,HDB.PA(SP)	;2-PARAMETER HIST?
	BNE	6$		;YES
	MOV	#HD1.SZ*2,R1	
	CALL	$RQCB		;TRY FOR POOL SPACE
	MOV	#HD1.SZ,R1	;SET COUNT FOR COPY
	BR	7$
6$:	MOV	#HD2.SZ*2,R1
	CALL	$RQCB		;TRY FOR POOL SPACE
	MOV	#HD2.SZ,R1	;SET COUNT FOR COPY
7$:	BCS	ERR2		;NO POOL SPACE AVAILABLE
;
; EVERYTHING IS READY.  COPY THE HDB, SET UP THE NUMBER, UNLOCK HDBS,
; AND RETURN.  R0 HAS THE ADDRESS IN THE HDB POOL FOR THE NEW HDB.
;
HS5:	MOV	SP,R2		;POINT TO HDB ON STACK
	PUSH	R3		;SAVE ADDRESS OF PREVIOUS LINK
	MOV	R0,R3		;POINT TO NEW HDB IN POOL
1$:	MOV	(R2)+,(R3)+	;COPY HDB
	SOB	R1,1$		
	MOV	R0,@(SP)+	;LINK IN NEW HDB
	MOV	R0,-(R4)	;SET UP PTR IN NUMBER TABLE
	ADD	#HD2.SZ*2,SP	;CLEAN STACK
	CALL	HST$UN		;UNLOCK HDBS
	SUB	#H.DBPT-2,R4	;GET HIST NUMBER
	ASR	R4
	MOV	2(R5),R0
	MOV	R4,HDA.NB(R0)	;PUT NUMBER IN HDA
	CLR	@4(R5)		;NO ERROR
	RETURN

;	SETP	SET PARAMETER SUBROUTINE
;
; THIS ROUTINE SETS UP ONE PARAMETER IN THE HDB, VALIDATING THE
; INFORMATION SUPPLIED IN THE HDA.
;
; ENTRY CONDITIONS:
;
;	R0 POINTS TO PARAMETER BLOCK IN HDB
;	R4 POINTS TO PARAMETER BLOCK IN HDA
;
;	CALL	SETP
;
; EXIT CONDITIONS:
;
;	IF PARAMETER VALUES ARE VALID:
;	C BIT IS CLEAR
;	PARAMETER IS SET UP IN HDB
;	R0 AND R4 ARE STEPPED PAST THEIR RESPECTIVE PARAMETER
;	BLOCKS, AND POINT TO THE NEXT BLOCK, IF ANY.
;
;	IF PARAMETER VALUES ARE NOT VALID:
;	C BIT IS SET
;	R0 AND R4 ARE UNDEFINED
;
;	UNCHANGED REGISTERS:	R1, R5
;	CHANGED REGISTERS:	R0, R2, R3, R4
;
SETP:	MOV	(R4)+,(R0)	;SET UP DATA INDEX
	ASL	(R0)+		;WORD TO BYTE
	MOV	(R4),(R0)	;SET UP MASK
	COM	(R0)+		;MAKE BIC MASK (SET C)
	MOV	(R4)+,(R0)	;SAVE COPY FOR SHIFTING
	MOV	(R4)+,R2	;GET LOWER LIMIT
	MOV	(R4)+,R3	;GET BIN SIZE
	BEQ	3$		;CATCH ZERO SIZE (C STILL SET)
;
; THE LOWER LIMIT AND BIN SIZE MUST BE ALIGNED WITH THE RIGHT-HAND END
; (RIGHTMOST 1-BIT) OF THE MASK
;
1$:	ASR	(R0)		;SHIFT MASK
	BCS	2$		;FOUND RIGHT-HAND END
	ASL	R2		;SHIFT LOWER LIMIT
	BCS	3$		;OVERFLOW
	ASL	R3		;SHIFT BIN SIZE
	BCC	1$		;NO OVERFLOW
	BR	3$		;ERROR RETURN (C SET)
2$:	MOV	R2,(R0)+	;SET UP LOWER LIMIT
	MOV	R3,(R0)+	;SET UP BIN SIZE
	MOV	(R4)+,(R0)+	;SET UP NUMBER OF BINS
	BLE	3$		;BAD (C IS STILL SET)
	CLC			;ALLES IST GEMUETLICH
3$:	RETURN
	.END