Google
 

Trailing-Edge - PDP-10 Archives - bb-x130a-sb - cshdpy.for
There are 4 other files named cshdpy.for in the archive. Click here to see a list.
	IMPLICIT INTEGER (A-Z)
	REAL RHSH,RLEN
	PARAMETER (UNINAM=0, UNILOG=1, UNISYS=3, UNI2ND=58)
	DIMENSION SCREEN(16),SAVED(1000),LREADC(24),LREADH(24),BLANK(16)
	DIMENSION LWRITC(24),LWRITH(24),LBLOCK(24)
	DIMENSION ITIM(5),MAPARG(5),IDATE(2)
	COMMON WRTFLG,LINE
	INCLUDE 'FOR:MAP.FOR'
	CALL ERRSET(0)
	CALL NECHO
	WAIT=10
	NUMBER=0
	INCFLG = .FALSE.
	PERFLG = .FALSE.
	MISFLG = .FALSE.
	WRTFLG = .FALSE.

	MAPARG(1)=MPFSPY
	MAPARG(2)=0
	MAPARG(3)=0
	MAPARG(4)=0
	MAPARG(5)=0
	CALL MAPI(MAPARG)
	UNISCR=IRH(MAPG("000061000016))
	UNICRC=UNISCR-6
	UNICRH=UNICRC+1
	UNICWC=UNICRH+1
	UNICWH=UNICWC+1
	UNICBK=UNICWH+1

	TICKS=MAPG("000044000011)
	TTTYPE = DPYINI(7,'VT52 ')
	CALL DPYZAP
!
!Per repeat loop
!
1	CHAR=CHAR1(0)
	IF(CHAR.EQ.0) GOTO 1101
	IF(CHAR.EQ.'R' .OR. CHAR.EQ.'r') CALL DPYREF
	IF(CHAR.EQ.'I' .OR. CHAR.EQ.'i') INCFLG= .NOT. INCFLG
	IF(CHAR.EQ.'P' .OR. CHAR.EQ.'p') PERFLG = .NOT. PERFLG
	IF(CHAR.EQ.'M' .OR. CHAR.EQ.'m') MISFLG = .NOT. MISFLG
	IF(CHAR.EQ.'W' .OR. CHAR.EQ.'w') THEN
		WRTFLG = .TRUE.
		OPEN(UNIT=1,FILE='CSHDPY.DAT',ACCESS='SEQOUT',MODE='ASCII')
	ENDIF
	IF (CHAR.GE.'0' .AND. CHAR .LE. '9')
	1	NUMBER=NUMBER*10+DPYLSH(CHAR)-"60
	IF (CHAR.EQ.'S' .OR. CHAR.EQ.'s') THEN
		WAIT=NUMBER
		IF (WAIT.GT.60) WAIT=60
		IF (WAIT.LE.0) WAIT=10
		NUMBER=0
	ENDIF
	IF (CHAR.EQ.'B' .OR. CHAR.EQ.'b') THEN
		CALL CSHSIZ(NUMBER)
		NUMBER=0
	ENDIF
	IF(CHAR.NE.'H') GOTO 1104
	CALL DPYSAV(SAVED)
	CALL DPYZAP
	CALL CSHHLP
	CALL DPYWAT(10)
	CALL DPYCLR
	CALL DPYRST(SAVED)
1104	IF(CHAR.EQ.'E' .OR. CHAR.EQ.'e' .OR. CHAR.EQ."151004020100) THEN
		CALL DPYCRM(-1,1,23)
		CALL ECHO
	ENDIF
1101	CONTINUE

	UDB=ILH(MAPG("000007000016))
	UPTIME=MAPG("000136000011)
	IF (INCFLG) THEN
		UP=UPTIME-LUP
	ELSE
		UP=UPTIME
	ENDIF
	LUP=UPTIME
	ITIM(1)=UP/(60*TICKS*60)
	ITIM(3)=(UP-(ITIM(1)*60*TICKS*60))/(60*60)
	ITIM(5)=(UP-(ITIM(1)*60*TICKS*60)-(ITIM(3)*60*60))/60
	ITIM(2)=ITIM(3)/10
	ITIM(4)=ITIM(5)/10
	ITIM(3)=ITIM(3)-(ITIM(2)*10)
	ITIM(5)=ITIM(5)-(ITIM(4)*10)
	CALL DATE(IDATE)
	CALL TIME(ITIME1,ITIME2)
	ITIME2=ITIME2 .OR. (':' .AND. "774000000000)
	IF (INCFLG) THEN
		ENCODE(80,197,SCREEN(1)) ITIM,IDATE,ITIME1,ITIME2
197		FORMAT ('Incremental uptime: ',I4,':',2I1,':',2I1,
	1	T40,2A5,1X,A5,A3)
	ELSE
		ENCODE(80,199,SCREEN(1)) ITIM,IDATE,ITIME1,ITIME2
199		FORMAT ('Uptime: ',I4,':',2I1,':',2I1,
	1	T40,2A5,1X,A5,A3)
	ENDIF
	LINE=0
	CALL DISPLY(SCREEN)
	IF(PERFLG) THEN
		ENCODE(80,198,SCREEN(1))
198		FORMAT('   Unit     Str   Blocks          READS
	1/second              WRITES/second')
	ELSE
		ENCODE(80,200,SCREEN(1))
200		FORMAT('   Unit     Str   Blocks             READS
	1                     WRITES')
	ENDIF
	CALL DISPLY(SCREEN)
	IF (MISFLG) THEN
		ENCODE(80,207,SCREEN(1))
207	FORMAT('                  cached      Rate   Misses  Total
	1      Rate   Misses  Total')
	ELSE
		ENCODE(80,201,SCREEN(1))
201	FORMAT('                  cached      Rate    Hits   Total
	1      Rate    Hits   Total')
	ENDIF
	CALL DISPLY(SCREEN)
	CALL DISPLY(BLANK)

	TREADC=0
	TREADH=0
	TWRITC=0
	TWRITH=0
	TBLOCK=0
10	IF (MAPE(UDB+UNILOG).EQ.0) GOTO 2
	CALL SIXASC(MAPE(UDB+UNINAM),PUNIT)
	PUNIT2='     '
	SEP2=' '
	CALL SIXASC(MAPE(UDB+UNILOG),LUNIT)
	CREADC=MAPE(UDB+UNICRC)
	CREADH=MAPE(UDB+UNICRH)
	CWRITC=MAPE(UDB+UNICWC)
	CWRITH=MAPE(UDB+UNICWH)
	BLOCKS=MAPE(UDB+UNICBK)
	UDB2=IRH(MAPE(UDB+UNI2ND))
	IF (UDB2.NE.0) THEN
		CREADC=CREADC+MAPE(UDB2+UNICRC)
		CREADH=CREADH+MAPE(UDB2+UNICRH)
		CWRITC=CWRITC+MAPE(UDB2+UNICWC)
		CWRITH=CWRITH+MAPE(UDB2+UNICWH)
		CALL SIXASC(MAPE(UDB2+UNINAM),PUNIT2)
	SEP2='/'
	ENDIF
	IF (INCFLG) THEN
		READC=CREADC-LREADC(LINE)
		READH=CREADH-LREADH(LINE)
		WRITC=CWRITC-LWRITC(LINE)
		WRITH=CWRITH-LWRITH(LINE)
	ELSE
		READC=CREADC
		READH=CREADH
		WRITC=CWRITC
		WRITH=CWRITH
	ENDIF
	LREADC(LINE)=CREADC
	LREADH(LINE)=CREADH
	LWRITC(LINE)=CWRITC
	LWRITH(LINE)=CWRITH
	TREADC=TREADC+READC
	TREADH=TREADH+READH
	TWRITC=TWRITC+WRITC
	TWRITH=TWRITH+WRITH
	TBLOCK=TBLOCK+BLOCKS
	IF (READC .EQ. 0) THEN
		READP=0
	ELSE
		READP=READH*100/READC
	ENDIF
	IF (WRITC .EQ. 0) THEN
		WRITP=0
	ELSE
		WRITP=WRITH*100/WRITC
	ENDIF
	IF (PERFLG) THEN
		READC=READC*TICKS/UP
		READH=READH*TICKS/UP
		WRITC=WRITC*TICKS/UP
		WRITH=WRITH*TICKS/UP
	ENDIF
	IF (MISFLG) THEN
		READH=READC-READH
		WRITH=WRITC-WRITH
	ENDIF
	IBLOCK=BLOCKS-LBLOCK(LINE)
	IF (IBLOCK.NE.0) THEN
		ENCODE (80,204,SCREEN(1)) PUNIT,SEP2,PUNIT2,LUNIT,
	1	BLOCKS,IBLOCK,READP,READH,READC,WRITP,WRITH,WRITC
	ELSE
		ENCODE (80,203,SCREEN(1)) PUNIT,SEP2,PUNIT2,LUNIT,
	1	BLOCKS,READP,READH,READC,WRITP,WRITH,WRITC
	ENDIF
203	FORMAT (A4,A1,A4,2X,A6,I7,5X,I4,'%',2I8,5X,I4,'%',2I8)
204	FORMAT (A4,A1,A4,2X,A6,I7,SP,I4,SS,1X,I4,'%',2I8,5X,I4,'%',2I8)
	LBLOCK(LINE)=BLOCKS
	CALL DISPLY(SCREEN)
2	UDB=ILH(MAPE(UDB+UNISYS))
	IF (UDB.NE.0) GOTO 10

	IF (TREADC .EQ. 0) THEN
		TREADP=0
	ELSE
		TREADP=TREADH*100/TREADC
	ENDIF
	IF (TWRITC .EQ. 0) THEN
		TWRITP=0
	ELSE
		TWRITP=TWRITH*100/TWRITC
	ENDIF
	IF (MISFLG) THEN
		TREADH=TREADC-TREADH
		TWRITH=TWRITC-TWRITH
	ENDIF
	IF (PERFLG) THEN
		TREADC=TREADC*TICKS/UP
		TREADH=TREADH*TICKS/UP
		TWRITC=TWRITC*TICKS/UP
		TWRITH=TWRITH*TICKS/UP
	ENDIF
	TSIZE=MAPG("000120000016)
	ENCODE (80,205,SCREEN(1)) TBLOCK,TSIZE,TREADP,TREADH,TREADC,
	1	TWRITP,TWRITH,TWRITC
205	FORMAT ('Totals',11X,I7,'/',I3,1X,I4,'%',2I8,5X,I4,'%',2I8)
	CALL DISPLY(BLANK)
	CALL DISPLY(SCREEN)
	HSHF=MAPG("000125000016)
	HSHC=MAPG("000126000016)
	IF (INCFLG) THEN
		IHSHF=HSHF-LHSHF
		IHSHC=HSHC-LHSHC
	ELSE
		IHSHF=HSHF
		IHSHC=HSHC
	ENDIF
	IF (PERFLG) THEN
		IHSHF=IHSHF*TICKS/UP
		IHSHC=IHSHC*TICKS/UP
	ENDIF
	LHSHF=HSHF
	LHSHC=HSHC
	RHSH=FLOAT(IHSHC)/IHSHF
	ENCODE (80,220,SCREEN(1)) IHSHF,IHSHC,RHSH
220	FORMAT ('CSHFND calls:',I8,'  collisions:',I8,' (',F5.2,'/probe)')
	CALL DISPLY(BLANK)
	CALL DISPLY(SCREEN)
	HSHL=MAPG("000127000016)/2
	HSHADR=MAPG("000130000016)
	NUM=0
	DO 50 I=0,HSHL*2-2,2
50	IF (MAPE(HSHADR+I) .NE. HSHADR+I) NUM=NUM+1
	RLEN=FLOAT(TBLOCK)/NUM
	FULL=NUM*100/HSHL
	ENCODE (80,221,SCREEN(1)) HSHL,NUM,FULL,RLEN
221	FORMAT ('Hash table length:',I4,'  entries:',I4,' (',I2,'% full)
	1 average list length:',F6.2)
	CALL DISPLY(SCREEN)
	IF (WRTFLG) CLOSE (UNIT=1)
	WRTFLG = .FALSE.

	CALL DPYCRM(-1,1,1)
	CALL DPYWAT(WAIT)
	GOTO 1

	END
	SUBROUTINE DISPLY(ARRAY)
	COMMON WRTFLG,LINE
	DIMENSION ARRAY(16)

	LINE=LINE+1
	CALL DPYRSC(ARRAY,1,LINE,80,LINE)
	IF (WRTFLG) WRITE (1,10) ARRAY
10	FORMAT (1X,16A5)

	END