.TITLE HIST .IDENT /BL1.0/ ; ; Histogram package for the VAX ; ; ; Histogram buffer structure ; ; HIBUF - n longwords points to hist headers ; HISIZ - contains n # of histograms ; ; Histogram headers ; Word 0 - Data area ; Word 1 - Hist type - HI.TYP ; Word 2 - X size - HI.XSZ ; Word 3 - X origin - HI.X0 ; Word 4 - X step - HI.XS ; Word 5 - Y size - HI.YSZ ; Word 6 - Y origin - HI.Y0 ; Word 7 - Y step - HI.YS ; Word 8 ... - Hist title - HI.TTL ; Data area ; HI.TYP=4 HI.XSZ=8 HI.X0=12 HI.XS=16 HI.YSZ=20 HI.Y0=24 HI.YS=28 HI.TTL=32 ; Title is 1 byte count followed by label ;HI.DAT=42 ;hi.tsz=10 String length ; ; CALL HISET(NHIST,IXSIZE,IYSIZE) ; ; IYSIZE = 0 FOR 1 DIM HISTS ; ; .psect string,noexe,con,lcl,dat NULSTR: .ASCIZ / / ; .psect $VARS,NOEXE,CON,LCL,WRT .psect HIST,EXE,LCL,CON,NOWRT ; .psect BUFF,NOEXE,GBL,OVR,pic,shr,long .ENTRY HISET,^M MOVL AP,R5 MOVL (R5)+,R4 ; Param count TSTL HIBUF ; Hist table buffer BNEQ 20$ ; Yes ? ; ; SET UP FIRST TIME THROUGH ; MOVL #260.,R0 ; Default hist table size BSBW BREQB ; Get buffer # bytes BEQL 10$ ; None ? MOVL R0,HIBUF MOVL #64,HISIZ ; And max bufffer size BSBW HISAV ; ; Here we set up table of markers ; 20$: TSTL MKBUF ; Markers set up? BNEQ 30$ ; Yes MOVL HISIZ,R0 ; Number of hists ASHL #4,R0,R0 ; Number of bytes needed = 16 times ADDL #8,R0 ; One more for marker #0 BSBW BREQB ; Get buffer BEQL 30$ ; Insufficient space ? MOVL R0,MKBUF ; Save address BEQL 30$ ; None MOVL HISIZ,R1 ; # of hists ASHL #1,R1,R1 ; times 2 MOVL R1,MKSIZ ; Marker size MOVL R1,(R0) ; Save for user ; ; SECTION TO GET INDIVIDUAL HIST BUFFER ; BRB 30$ 10$: RET 30$: DECB R4 ; NUMBER OF PARAM LEFT BLSS 10$ ; INPUT ERROR MOVZWL @(R5)+,R6 ; Hist number BLEQ 10$ ; Too small ? CMPL R6,HISIZ ; IS HIST# TOO BIG? BGTR 10$ ; YES, TERMINATE SET UP ASHL #2,R6,R6 ; Now points to table entry ADDL HIBUF,R6 TSTL (R6) ; Test if hist exists BNEQ 10$ ; Exists ? DECB R4 ; TEST IF 2'ND PARAM BLSS 10$ MOVZWL @(R5)+,R2 ; NO OF PST PER LINE(IXSIZE) BEQL 10$ ; Too small ? CMPW R2,#1024. ; IS X SIZE TOO LARGE BGTRU 10$ ; YES CVTBL #1,R3 ; Y axis CVTBL #1,R7 ; Step/chan DECB R4 ; Another param? BLSS 40$ ; No more? MOVZWL @(R5)+,R3 ; Y axis BNEQ 35$ ; Not zero ? INCL R3 ; Make it 1 35$: CMPW R3,#1024. ; Too big? BGTRU 10$ ; Yes DECB R4 ; Another param? BLSS 40$ ; No more? CMPB @(R5)+,#2 ; Is it 2 ? BNEQ 40$ ; No ? MOVB #2,R7 ; Make step 2 40$: MULL3 R3,R2,R0 ; Get product MULL R7,R0 ; Multiply size by step ASHL #1,R0,R0 ; Now is number of bytes needed ADDL #HI.TTL,R0 ; Points to labels DECB R4 ; Another param? BLSS 50$ ; No more? MOVZWL @(R5)+,R3 ; Y axis MOVZWL DSC$W_LENGTH(R3),R4 ; Number of bytes in array MOVL DSC$A_POINTER(R3),R3 ; Address of array BRB 60$ 50$: MOV #12,R4 MOVA NULSTR,R3 60$: ADD R4,R0 ADD #2,R0 ; Make room for 2 more BSBW BREQB ; Get buffer BEQL 10$ ; None ? MOVL R0,(R6) ; Save it in buffer table MOVL R0,(R0) ; Will be data area ADDL R4,(R0) ADDL #HI.TIT+2,(R0)+ ; Now points to data MOVL R7,(R0)+ ; Hist type MOVL R2,(R0)+ ; X size CLRL (R0)+ ; Origin CVTBF #1,(R0)+ ; Step MOVL R3,(R0)+ ; Y size CLRL (R0)+ ; Origin CVTBF #1,(R0)+ ; Step MOVL #HI.TSZ,R1 ; Number of bytes in label 70$: MOVB (R3)+,(R0)+ ; Pad with blanks SOBGTR R4,70$ ; Till full RET ; ; CALL HIEXT(Hinumber,space available,marker number) ; ; Sets up the number of hists, markers and the space available ; .ENTRY HIEXT,^M MOVL AP,R5 MOVL (R5)+,R4 ; Number of params BSBW TESTP ; Get parameter BEQL 10$ ; None ? TSTL HIBUF ; Check hists BNEQ 10$ ; Already set up ? MOVZWL (R3),R3 ; Get number of hists MOVL R3,R0 BEQL 10$ ; None ? INCL R0 ; Add zeroeth ASHL #2,R0,R0 ; Now is byte count BSBW BREQB ; Get space BEQL 10$ ; None available ? MOVL R0,HIBUF ; Hist buffer MOVL R3,HISIZ ; And size saved BSBW HISAV 10$: BSBW TESTP ; Get parameter (dummy space) BSBW TESTP ; Get parameter BEQL 20$ ; None ? MOVZWL (R3),R3 ; Number of markers requested BEQL 20$ ; None ? MOVL R3,R0 INCL R0 ; Add zeroeth ASHL #3,R0,R0 ; Number of bytes required BSBW BREQB ; Request space BEQL 20$ ; None ? MOVL R0,MKBUF ; Save address MOVL R3,MKSIZ ; And size MOVL R3,(R0) ; Also for user 20$: RET HISAV: MOVL #HI.DAT+4,R0 ; Space for zeroeth hist BSBW BREQB ; Get space BEQL 20$ ; None ? MOVL R0,@HIBUF ; Save in hist buffer MOVL R0,(R0) ; ADDL #HI.DAT,(R0) MOVW HISIZ,HI.YSZ(R0) ; Y size is # of hists ADDL #HI.TTL,R0 ; Now points to title MOVZBL (R0),R1 ; Number of words 10$: MOVB #32,(R0)+ ; Blanks SOBGTR R1,10$ 20$: RSB ; ; ; CALL LABLH(IHIS,LABEL) LABEL = 10 CHAR LABEL ; .entry LABLH,^M BSBW HIS1 ; Get hist BSBW TESTP ; Second param ? BEQL 60$ ; None ADDL #HI.TTL,R0 ; Points to labels MOVZBL (R0)+,R2 ; Get title size MOVZWL DSC$W_LENGTH(R3),R3 ; Number of bytes in array MOVL DSC$A_POINTER(R3),R1 ; Address of array CMPL R3,R2 ; Which is bigger BGTR 20$ ; Title is bigger ? MOVL R3,R2 20$: MOVB (R1)+,R3 ; Move title CMPB R3,#32 ; Too small ? BLSS 60$ ; Yes ? CMPB R3,#126 ; Too big ? BGEQ 60$ ; Yes ? MOVB R3,(R0)+ SOBGTR R2,20$ 60$: CLRB (R0)+ RET ; ; CALL GTITL(IHIST,IARRAY,ISIZE) ; .ENTRY GTITL,^M BSBW HIS1 ; Get hist number BSBW TESTP ; Get first param BEQL 40$ ; None ? MOVL R3,R1 ; Output buffer BSBW TESTP ; Get first param BEQL 40$ ; None ? MOVZWL (R3),R2 ; byte count MOVL R2,R3 ; Maximum allowed BLEQ 20$ ; BAD COUNT ADDL #HI.TTL+1,R0 ; Points to title 10$: MOVB (R0)+,(R1)+ ; MOVE 1 WORD BEQL 20$ SOBGTR R2,10$ ; Continue till done 20$: SUBL3 R2,R3,R2 ; Number transferred BSBW TESTP ; Next param BEQL 30$ ; None MOVL R2,(R3) 40$: RET BREQB:: MOVL R1,-(SP) MOVL R0,BUFS ; Buffer size CALLG BUFP,G^LIB$GET_VM ; Get virtual memory CMPB R0,#SS$_NORMAL ; Ok ? BEQL 10$ ; Yes ? MOVL (SP)+,R1 CLRL R0 ; No ! RSB 10$: MOVL BUFB,R0 ; Success 20$: CLRB (R0)+ ; Clear 1 byte DECL BUFS ; Do another ? BNEQ 20$ ; No ? MOVL (SP)+,R1 MOVL BUFB,R0 ; Get address again RSB .psect $VARS,NOEXE,CON,LCL,WRT HIBUF:: .LONG 0 ; Address of histogram buffer HISIZ:: .LONG -1 ; Number of histograms MKBUF:: .LONG 0 ; Marker buffers MKSIZ:: .LONG -1 ; Marker size BUFP:: .LONG 2,BUFS,BUFB BUFS: .LONG 0 BUFB: .LONG 0 BUFEND:: ; End of dynamic buffer area .psect HIST,EXE,LCL,CON,NOWRT ; ; ; CALL HISTI( NO. ,X ,Y) ; CALL HISTF(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 HISTF X,Y ARE FLOAT PT ; ; ; SETUP WHICH BUFFER TO DISPLAY AND SCALE FACTOR ; ; ; .entry HISTI,^M MOVAL SCALI,R6 BRB HISTB HISTA:: .ENTRY HISTF,^M MOVAL SCALF,R6 HISTB: BSBW HIS1 ; PRELIMINARY SETUP MOVL R0,R1 ADDL #8,R1 ; Points to X JSB (R6) ; GET X VALUE SCALED DECB R4 ; CHECK IF PARAM COUNT OK BLEQ 10$ ; 1 DIM HIST ONLY MOVL R2,R7 ; Save chan number MOVL R3,R8 ; Save size JSB (R6) ; GET Y VALUE SCALED MULL R8,R2 ; Now have sweep number ADDL R7,R2 ; Total chan number 10$: CMPB HI.TYP(R0),#2 ; Double word hist ? BEQL 20$ ; Yes ? ASHL #1,R2,R2 ; NOW IS BYTE ADDRESS ADDL (R0),R2 ; Add offset to array address INCW (R2) ; INCREMENT THE HISTOGRAM RET 20$: ASHL #2,R2,R2 ; Double word index ADDL (R0),R2 ; Add offset to array address INCL (R2) ; Increment 1'st word NERR: RET ; ; Initialize for histogram check if hist exists ; HIS1: MOVL AP,R5 ; Contains param list MOVL (R5)+,R4 ; Now contains number of params DECB R4 ; 1 parameter ? BLEQ NERR MOVZWL @(R5)+,R0 ; Hist number CMPL R0,HISIZ ; Compare with max size BGTR NERR ; Too big ASHL #2,R0,R0 ; Now is double word ADDL HIBUF,R0 ; Now points to proper location MOVL (R0),R0 ; Now points to header BEQL NERR ; None ? RSB ; ; Integer input and scale routine ; SCALI: CVTLF @(R5)+,R2 ; Get input data BRB SCAL1 ; ; Floating point input and scale routine ; SCALF: MOVL @(R5)+,R2 ; Get floating point data SCAL1: MOVL (R1)+,R3 ; Get max size BEQL 5$ ; None ? SUBF (R1)+,R2 ; Subtract off origin DIVF (R1)+,R2 ; Divide by step BGTR 10$ ; Positive result ? 5$: CLRL R2 RSB 10$: CVTFL R2,R2 ; Convert to long word result BVS 15$ ; Overflow ? CMPL R2,R3 ; Check size of chan number BLSS 20$ ; Ok ? 15$: MOVL R3,R2 ; Make it max DECL R2 ; - 1 20$: RSB ; ; CALL ZHIST(HIST) ; ; To zero all chans of histogram ; .ENTRY ZHIST,^M MOVL AP,R7 ; Contains param list MOVL (R7)+,R6 ; Now contains number of params DECB R6 ; Check number of params BLSS 50$ ; Too few ? MOVL HISIZ,R6 ; Number of hists to zero BLEQ 50$ ; None ? MOVZWL @(R7)+,R7 ; Hist number BEQL 10$ ; Zero is do all ? CMPL R7,R6 ; Compare with max size BGTR 50$ ; Too big CLRL R6 ; Count 10$: ASHL #2,R7,R7 ; Now is double word ADDL HIBUF,R7 ; Now points to proper location 20$: MOVL (R7)+,R0 ; Now points to header BEQL 40$ ; None ? MOVL HI.XSZ(R0),R1 ; X size MULL HI.YSZ(R0),R1 ; Times the y size MULL HI.TYP(R0),R1 ; Times the step ASHL #1,R1,R1 ; Now is byte count MOVL (R0),R0 ; Data address MOVC5 #0,(R0),#0,R1,(R0) ; Clear the array 40$: SOBGTR R6,20$ ; Another to do ? 50$: RET ; ; CALL SCALH(NHIST,IXSTEP,IX0,IYSTEP,IY0) ; SCALH2:: .entry SCALH,^M BSBW HIS1 ; Get hist number BSB TESTP ; Get 1 param BEQL 10$ ; No param ? CVTLF (R3),HI.XS(R0) ; X step BNEQ 10$ ; Zero ? CVTBF #1,HI.XS(R0) ; Make it 1 10$: BSB TESTP ; Get 1 param BEQL 20$ ; No param ? CVTLF (R3),HI.X0(R0) ; X origin 20$: BSB TESTP ; Get 1 param BEQL 30$ ; No param ? CVTLF (R3),HI.YS(R0) ; Y step BNEQ 30$ ; Zero ? CVTBF #1,HI.YS(R0) ; Make it 1 30$: BSB TESTP ; Get 1 param BEQL 40$ ; No param ? CVTLF (R3),HI.Y0(R0) ; Y origin 40$: RET ; ; R4 = param count (low byte) ; Bit 31=0 No return when end of param list ; Bit 31=1 Return with R3=0 at end of list ; ; TESTP:: DECB R4 ; Another param ? BLSS 10$ ; No MOVL (R5)+,R3 ; Get address of param RSB ; Done 10$: BBS #31,R4,30$ ; Bit 31 set ? ; BBC #30,R4,30$ ; Bit 30 clear ? 20$: RET 30$: CLRL R3 ; Tell user no param RSB ; Return to user ; ; CALL MARKI(M,INO,IX) ; CALL MARKF(M,IN0,X) ; M = MARKER NO. INO = HIST NO. ; IX = XVALUE FOR MARKER ; MARKA:: .ENTRY MARKF,^M BSB MARK ; INTEGER MARK ROUTINE MOVF (R3),4(R0) ; Save in table RET .ENTRY MARKI,^M BSB MARK ; SET UP TO MARK CVTLF (R3),4(R0) ; Save integer marker MEND: RET ; ; Common marker subroutine ; MARK: MOVL AP,R5 ; Address of params MOVL (R5)+,R4 ; Number of params BSBW TESTP ; Next param BEQL MEND MOVZWL (R3),R0 ; Marker number BEQL MEND CMPL R0,MKSIZ ; Too big ? BGTR MEND ; Yes ASHL #3,R0,R0 ; Now is table pointer ADDL MKBUF,R0 ; Points to table BSBW TESTP ; Another param ? BEQL 20$ ; Missin marker location ? CVTWL (R3),R1 ; Get hist number BEQL 20$ ; None ? MOVL R1,(R0) ; Save it 20$: BSBW TESTP ; Get param address BEQL MEND ; None ? RSB ; ; I = MTSTI(IVAL,IMK1,IMK2) ; I = -1 IF IVAR IS BRAKETED BY MARKERS IMK1,IMK2 ; I = 0 IF I IS OUTSIDE MARKERS AND NOT = MARKER VALUE ; .ENTRY MTSTI,^M MOVL AP,R5 ; Param address MOVL (R5)+,R4 ; Param count BSBW TESTP ; Get next param BEQL MTOUT ; None ? CVTLF (R3),R1 ; Value to compare BRB MKT MTSTA:: .ENTRY MTSTF,^M MOVL AP,R5 ; Param address MOVL (R5)+,R4 ; Param count BSBW TESTP ; Get next param BEQL MTOUT ; None ? MOVF (R3),R1 ; Value to compare MKT: MOVL #-1,R0 ; Set comparison true BSBW TESTP ; Get lower limit BEQL 10$ ; None ? MOVZWL (R3),R3 ; Marker number BEQL 10$ ; Bad number ? CMPL R3,MKSIZ ; Check size BGTR 10$ ; Too big ? ASHL #3,R3,R3 ; Get element ADDL MKBUF,R3 ; Points to hist number CMPF R1,4(R3) ; Compare number to marker BLSS MTOUT ; Outside of range ? 10$: BSBW TESTP ; Get upper limit BEQL MTEND ; None ? MOVZWL (R3),R3 ; Marker number BEQL MTEND ; Bad number ? CMPL R3,MKSIZ ; Check size BGTR MTEND ; Too big ? ASHL #3,R3,R3 ; Get element ADDL MKBUF,R3 ; Points to hist number CMPF R1,4(R3) ; Compare number to marker BGTR MTOUT ; Outside of range ? MTEND: RET MTOUT: CLRL R0 ; Outside of range RET ; ; CALL MGETF(IMARK,IHIS,VALUE) ; MGETA:: .ENTRY MGETF,^M MOVL AP,R5 ; Param list MOVL (R5)+,R4 ; Param count BSBW TESTP ; Get marker number BEQL 30$ ; None ? MOVZWL (R3),R0 ; Marker number CMPL R0,MKSIZ ; Check size BGTR 30$ ; Too big ? ASHL #3,R0,R0 ; Get element ADDL MKBUF,R0 ; Points to hist number BSBW TESTP ; Next param BEQL 10$ ; None ? MOVL (R0)+,(R3) ; Save param 10$: BSBW TESTP ; Next param BEQL 30$ ; None ? MOVL (R0),(R3) ; To caller 30$: RET ; ; CALL HSTAT(IHIS,IX,IY,IXSTEP,IX0,IYSTEP,IY0,ITYPE) ; IHIS = HISTOGRAM NUMBER DESIRED ; SUB RETURNS IX,IY (SIZES) STEP, AND OROGIN FOR X,Y ; ; R5 Points to the param list ; R4 Is param count ; R0 Points to current param ; .ENTRY HSTAT,^M CMPB (AP),#2 ; At least 2 params ? BLSS 70$ ; No MOVL 8(AP),R3 ; Second param present ? BEQL 70$ ; No CLRL (R3) ; Clear it in case of no hist BSBW HIS1 ; Get param list BSBW TESTP ; Test next param BEQL 10$ ; No param ? MOVL HI.XSZ(R0),(R3) ; X size to caller 10$: BSBW TESTP ; Test next param BEQL 20$ ; No param ? MOVL HI.YSZ(R0),(R3) ; Y size to caller 20$: BSBW TESTP ; Test next param BEQL 30$ ; No param ? CVTFL HI.XS(R0),(R3) ; X step 30$: BSBW TESTP ; Test next param BEQL 40$ ; No param ? CVTFL HI.X0(R0),(R3) ; X origin 40$: BSBW TESTP ; Test next param BEQL 50$ ; No param ? CVTFL HI.YS(R0),(R3) ; Y step 50$: BSBW TESTP ; Test next param BEQL 60$ ; No param ? CVTFL HI.Y0(R0),(R3) ; Y origin 60$: BSBW TESTP ; Test next param BEQL 70$ ; No param ? MOVL HI.TYP(R0),(R3) ; Save hist type 70$: RET ; ; CALL HGET(IHIST, IARRAY, ICH,ISIZE, ITRANS) ; THIS SUBROUTINE FILLS ARRAY IARRAY OF SIZE STARTING ; FROM CHAN ICHAN OF HISTOGRAM ; ITRANS = # WORDS ACTUALLY TRANSFERRECD ; ITRANS = 0 IF NO HIST OR ICH TOO LARGE ; CALL HPUT(IHIS,IARRAY, ICH, ISIZE, ITRANS) ; HPUT TRANSFERS DATA FROM USER ARRAY TO HISTOGRAM ; .ENTRY HGET,^M BSB GET ; GET ADDRESS ETC. 1$: MOVW (R1)+,(R2)+ ; MOVE 1 WORD SOBGTR R3,1$ ; CONTINUE TILL DONE RET ; .ENTRY HPUT,^M BSB GET 1$: MOVW (R2)+,(R1)+ ; MOVE 1 WORD SOBGTR R3,1$ ; CONTINUE TILL DONE RET ; ; Common set up routine ; GET: BSBW HIS1 ; Get hist address CMPB R4,#4 ; Enough room for params ? BLSS END ; No CLRW @12(R5) ; Clear the count. BSBW TESTP ; Get next param BEQL END ; None ? MOVL R3,R2 ; DESTINATION ADDRESS BSBW TESTP ; Get next param BEQL END ; None ? MOVZWL (R3),R1 ; CHAN IN HIST BEQL END ; Bad chan number ? DECL R1 ; -1 MOVL HI.XSZ(R0),R6 ; X size MULL HI.YSZ(R0),R6 ; multiply by Y size CMPB #2,HI.TYP(R0) ; Number of words / chan BNEQ 10$ ; Not 2 ? ASHL #1,R6,R6 ; Multiply by 2 10$: SUBL R1,R6 ; Chan number out of range ? BLEQ END ; Yes BSBW TESTP ; Get next param BEQL END ; None ? MOVZWL (R3),R3 ; SIZE OF USER ARRAY BLEQ END ; Too small ? SUBL R3,R6 ; Past the end ? BGEQ 20$ ; No ? ADDL R6,R3 ; Yes, shorten the request 20$: ASHL #1,R1,R1 ; Now is byte pointer ADDL (R0),R1 ; Now points to data buffer MOVW R3,@(R5) ; Number of word transferred RSB END: RET .END