PROGRAM SPMRD C C Read the SPM CLF file and identify packets. C C B. Z. Lederman C IMPLICIT INTEGER (A-Z) PARAMETER DICS = 105 BYTE FILNAM(40), TASK(6), LABEL(64) REAL*8 I8(2, 29), J8(2, 10), RT, DIC(DICS) INTEGER*2 INPT(250), EXC(2), ID, ABOFLG, TIUCB, DEV INTEGER*2 UCB(200, 3) INTEGER*4 TIME, IDLE C EQUIVALENCE (TIME, EXC), (INPT(1), ID), (INPT(7), IDLE) EQUIVALENCE (INPT(6), TIUCB), (INPT(6), DEV), (INPT(2), LABEL) C COMMON /ABOCOM/ ABOFLG C DATA FILNAM / 40 * 0 / DATA UCB, UCBMAX, OLDDEV / 600 * 0, 0, ' ' / DATA I8 / 1 'Directiv', 'e Proc. ', 'Run Task', ' ', 2 'Task Exi', 't ', 'Save Con', 'text ', 3 'Load Con', 'text ', 'Access T', 'ask Reg.', 4 'UnStop T', 'ask ', 'AST to T', 'ask ', 5 'Extend T', 'ask ', 'Request ', 'for Part', 6 'Load Req', ' to Que ', 'Get Load', ' Req ', 7 'Finish L', 'oad Req.', 'Release ', 'Partitn ', 8 'I/O Pkt ', 'to Driv ', 'Driver g', 'ets Pkt ', 9 'I/O Done', ' Proc ', 'I/O Post', ' Complet', * 'I/O Pkt ', 'to ACP ', 'I/O Pkt ', 'at ACP ', 1 'H$GACP ', ' 1 ', 'Create V', 'irtual T', 2 'Eliminat', 'e Virtua', 'Load Ove', 'rlay ', 3 'System E', 'ntrance ', 'System t', 'o User ', 4 'Enter Id', 'le Loop ', 'Exit Idl', 'e Loop ', 5 'User Inf', 'ormation' / C DATA J8 / 1 'First Re', 'cord ', 'System C', 'ommons ', 2 'Checkpoi', 'nt File ', 'Partitio', 'n Cntl B', 3 'Task Con', 'trol Blk', 'Device C', 'ontrol B', 4 'Unit Con', 'trol Blk', 'Start Co', 'llection', 5 'Stop Col', 'lection ', 'System M', 'etrics ' / C DATA DIC / 1 'QIO$ ', 'QIOW$ ', 'GLUN$ ', 'ALUN$ ', 2 'ALTP$ ', 'SPWN$ ', 'STAF$ ', '15. ', 3 'RUN$ ', '19. ', 'SRRA$ ', 'MRKT$ ', 4 'CSRQ$ ', 'CMKT$ ', 'EXST$ ', 'CLEF$ ', 5 'SETF$ ', 'DECL$ ', 'RDSE$ ', 'RDAF$ ', 6 'WTSE$ ', 'WTLO$ ', 'SPND$S ', 'RSUM$ ', 7 'WSIG$S ', 'EXIT$S ', 'EXIF$ ', 'CRRG$ ', 8 'ATRG$ ', 'DTRG$ ', 'GTIM$ ', 'GTSK$ ', 9 'GPRT$ ', '67. ', 'SREF$ ', 'SDAT$ ', * '73. ', 'RCVD$ ', 'RCVX$ ', '79. ', 1 'RREF$ ', 'ABRT$ ', '85. ', '87. ', 2 'EXTK$ ', '91. ', '93. ', 'DCSP$ ', 3 'ENCP$S ', 'DSAR$S ', 'ENAR$S ', 'SVDB$ ', 4 'SVTK$ ', 'SRDA$ ', 'SPRA$ ', 'SFPA$ ', 5 'GMCX$ ', 'ASTX$S ', 'CRAW$ ', 'ELAW$ ', 6 'MAP$ ', 'UMAP$ ', 'GSSW$S ', 'GMCR$ ', 7 'CINT$ ', 'STOP$S ', 'USTP$ ', 'STSE$ ', 8 'STLO$ ', 'RCST$ ', 'SDRC$ ', 'CNCT$ ', 9 '145. ', 'EMST$ ', 'CRVT$ ', 'ELVT$ ', * '153. ', 'SCAL$S ', 'CRGF$ ', 'ELGF$ ', 1 'STAF$ ', 'RMAF$S ', 'SPEA$ ', 'SREX$ ', 2 'G/P SINF', 'TO ERL ', 'CLI DIR ', 'SWI STAT', 3 'FEAT$ ', '179. ', '181. ', '183. ', 4 '185. ', '187. ', '189. ', '191. ', 5 '193. ', '195. ', '197. ', '199. ', 6 'SUPV MAP', 'MOV T SP', 'CPCR ', 'LOG NAM ', 7 'Bad Numb' / C C Turn off errors on record too short. C CALL ERRSET ( 67, .TRUE., .FALSE., .TRUE., .FALSE., 20) C C Clean exit on abort (needs external routine ABORT) C CALL ABOINI C DO 50 U = 1, 200 50 UCB(U, 2) = ' ' ! Blank out UCB device name C WRITE (5, 100) 100 FORMAT ('$ Enter file name: ') READ (5, 110, END = 800) FILNAM 110 FORMAT ( 40A1) C OPEN (UNIT = 1, NAME = FILNAM, TYPE = 'OLD', ERR = 810, 1 FORM = 'UNFORMATTED', ACCESS = 'SEQUENTIAL', 2 READONLY, SHARED, RECORDTYPE = 'VARIABLE') C 200 IF (ABOFLG) GOTO 500 READ (1, ERR = 210, END = 500) INPT 210 IF (ID .GT. 58) GOTO 600 ! startup packets IF (IMOD(ID, 2) .NE. 0) GOTO 310 ! should only have I = ID / 2 ! even ID's C EXC(2) = INPT(2) ! swap high and low EXC(1) = INPT(3) ! words of timestamp RT = 0.00001 * TIME ! convert to real value CALL R50ASC( 6, INPT(4), TASK) ! convert task name C IF (I .LT. 3) GOTO 240 ! no idle time IF (I .GT. 5) GOTO 240 ! ditto T = INPT(7) ! correct idle time INPT(7) = INPT(8) ! word order INPT(8) = T C DO 220 U = 1, UCBMAX IF (TIUCB .EQ. UCB(U, 1)) GOTO 240 ! Found a match 220 CONTINUE U = 1 ! Will never get here C 240 IF (ABOFLG) GOTO 500 GOTO ( 380, 320, 350, 350, 350, 330, 330, 330, 320, 330, 1 330, 330, 330, 330, 340, 330, 330, 330, 340, 340, 2 360, 370, 370, 320, 360, 360, 360, 360, 360) I C 310 WRITE (5, 410) ID GOTO 200 C 320 WRITE (5, 420) RT, I8(1, I), I8(2, I), TASK, 1 UCB(U, 2), UCB(U, 3), INPT(7) GOTO 200 C 330 WRITE (5, 430) RT, I8(1, I), I8(2, I), TASK, 1 UCB(U, 2), UCB(U, 3) GOTO 200 C 340 DO 342 J = 1, UCBMAX IF (INPT(7) .EQ. UCB(J, 1)) GOTO 344 342 CONTINUE 344 WRITE (5, 440) RT, I8(1, I), I8(2, I), TASK, UCB(U, 2), UCB(U, 3), 1 UCB(J, 2), UCB(J, 3), INPT(8), INPT(9) GOTO 200 C 350 WRITE (5, 450) RT, I8(1, I), I8(2, I), TASK, 1 UCB(U, 2), UCB(U, 3), IDLE GOTO 200 C 360 WRITE (5, 460) RT, I8(1, I), I8(2, I) GOTO 200 C 370 WRITE (5, 470) I8(1, I), I8(2, I) GOTO 200 C 380 J = IAND( INPT(7), "377) J = (J + 1) / 2 IF (J .GT. (DICS - 1)) J = DICS WRITE (5, 480) RT, I8(1, I), I8(2, I), TASK, 1 UCB(U, 2), UCB(U, 3), DIC(J) GOTO 200 C 410 FORMAT( 14X, 'Unknown packet ', I4) 420 FORMAT( 1X, F12.5, 1X, 2A8, 1X, 6A1, 1X, A2, O2.2, ': ', I6) 430 FORMAT( 1X, F12.5, 1X, 2A8, 1X, 6A1, 1X, A2, O2.2, ':') 440 FORMAT( 1X, F12.5, 1X, 2A8, 1X, 6A1, 1X, A2, O2.2, ': ', 1 A2, O2.2, ': ', O6, 1X, O4) 450 FORMAT( 1X, F12.5, 1X, 2A8, 1X, 6A1, 1X, A2, O2.2, ': ', I11) 460 FORMAT( 1X, F12.5, 1X, 2A8) 470 FORMAT( 14X, 2A8) 480 FORMAT( 1X, F12.5, 1X, 2A8, 1X, 6A1, 1X, A2, O2.2, ': ', A8) C 600 I = ID - 255. IF (I .EQ. 65) I = 10 ! system metric IF (ABOFLG) GOTO 500 GOTO (700, 670, 670, 630, 620, 680, 690, 640, 640, 660) I GOTO 310 C 630 CALL R50ASC( 6, INPT(6), TASK) ! PCB C WRITE (5, 635) J8(1, I), J8(2, I), TASK, INPT(8) C 635 FORMAT( 14X, 2A8, 1X, 6A1, 1X, O6) GOTO 200 C 620 CALL R50ASC( 6, INPT(7), TASK) ! Get task name from TCB C J = UCBMAX ! if no TI UCB, set to blank C IF (INPT(15) .EQ. 0) GOTO 622 ! no TI UCB C DO 622 J = 1, UCBMAX C IF (INPT(15) .EQ. UCB(J, 1)) GOTO 624 ! "TI" UCB C 622 CONTINUE 624 DO 626 U = 1, UCBMAX IF (INPT(22) .EQ. UCB(U, 1)) GOTO 628 ! Load device UCB 626 CONTINUE 628 GOTO 200 C 628 WRITE (5, 629) J8(1, I), J8(2, I), TASK, C 1 UCB(U, 2), UCB(U, 3), UCB(J, 2), UCB(J, 3) C 629 FORMAT( 14X, 2A8, 1X, 6A1, 2(1X, A2, O2.2, ':')) C GOTO 200 C 640 WRITE (5, 645) J8(1, I), J8(2, I), ! Start and Stop Collection 1 INPT(3), INPT(4), INPT(2), (INPT(J), J = 5, 9) 645 FORMAT( 14X, 2A8, 1X, 1 I2, 2('/',I2.2), 1X, I2, 2(':',I2.2), '.', I5.5, 1X, I5) GOTO 200 C 660 EXC(2) = INPT(2) ! swap high and low EXC(1) = INPT(3) ! words of timestamp RT = 0.00001 * TIME ! convert to real value WRITE( 5, 460) RT, J8(1, I), J8(2, I) ! System Metrics GOTO 200 C 670 WRITE( 5, 470) J8(1, I), J8(2, I) ! commons, checkpoint file GOTO 200 C 680 LOW = IAND( INPT(7), "377) ! DCB J = IAND( INPT(7), "177400) HIGH = ISHFT( J, -8) C WRITE( 5, 685) J8(1, I), J8(2, I), DEV, LOW, HIGH C 685 FORMAT( 14X, 2A8, 1X, A2, 1X, O3, 1X, O3) IF (DEV .NE. OLDDEV) THEN OLDDEV = DEV UNIT = 0 ENDIF GOTO 200 C 690 IF (UCBMAX .GE. 200) GOTO 200 ! no room for next UCB IF (UNIT .GT. '77'O) GOTO 200 ! don't want TT100: and up CX J = IAND( INPT(7), "377) ! get unit number from UCB UCBMAX = UCBMAX + 1 ! next UCB UCB(UCBMAX, 1) = INPT(3) ! store UCB (was word 5) UCB(UCBMAX, 2) = OLDDEV ! device type UCB(UCBMAX, 3) = UNIT C WRITE( 5, 695) J8(1, I), J8(2, I), (UCB(UCBMAX, J), J = 1, 3) C 695 FORMAT( 14X, 2A8, 1X, O6, 1X, A2, O2.2, ':') UNIT = UNIT + 1 GOTO 200 C 700 DO 710 J = 1, 64 ! get label from first record 710 IF ((LABEL(J) .LT. ' ') .OR. (LABEL(J) .GT. '~')) 1 LABEL(J) = ' ' ! without nulls WRITE (5, 720) LABEL 720 FORMAT( 14X, 64A1) GOTO 200 C 500 CLOSE (UNIT = 1) C C DO 510 U = 1, UCBMAX C IF (ABOFLG) GOTO 800 C 510 WRITE (5, 520) U, UCB(U, 1), UCB(U, 2), UCB(U, 3) C 520 FORMAT( 6X, 'UCB List ', I3, 1X, O6, 1X, A2, O2.2, ':') C 800 STOP C 810 STOP ' Error opening input file' C END