1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-07 03:15:54 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

276 lines
6.4 KiB
Fortran
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
IMPLICIT INTEGER (A-Z)
REAL RHSH,RLEN
PARAMETER (UDBNAM=0, UNILOG=11, UNISYS=13, UNI2ND=68)
DIMENSION SCREEN(16),SAVED(1000),LREADC(24),LREADH(24),BLANK(16)
DIMENSION LWRITC(24),LWRITH(24),LBLOCK(24)
DIMENSION ITIM(5),MAPARG(4),IDATE(2)
COMMON WRTFLG,LINE
INCLUDE '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
CALL MAPI(MAPARG)
UNISCR=IRH(MAPG("000061000016))
UNICRC=UNISCR-7
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+UDBNAM),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+UDBNAM),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