PROGRAM SPMTSK C C Read the SPM CLF (FCS) file and output data from one task. C C B. Z. Lederman C IMPLICIT INTEGER (A-Z) PARAMETER DICS = 85 BYTE INFILE(40), OUTFIL(40), TASK(6), T3(3), ANS REAL*8 I8(2, 29), J8(2, 10), RT, B, RSUM, DIC(DICS) INTEGER*2 INPT(250), EXC(2), ID, ABOFLG, TIUCB, DEV INTEGER*2 UCB(100, 3), GENER, GTSK, T4(2) INTEGER*4 TIME, IDLE, TSK, TSKIN, DATOUT(4) C EQUIVALENCE (TIME, EXC), (INPT(1), ID), (INPT(7), IDLE) EQUIVALENCE (INPT(6), TIUCB), (INPT(6), DEV) EQUIVALENCE (INPT(4), TSKIN), (TSK, T4) C COMMON /ABOCOM/ ABOFLG C DATA INFILE, OUTFIL / 80 * 0 / DATA DOTS / 3R... / DATA UCB, UCBMAX, OLDDEV / 300 * 0, 1, 0 / DATA DATOUT / 4 * 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 ' *** ', ' 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 ', 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$ ', '37. ', '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$ ', '119. ', 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 '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 UCB(1, 2) = ' ' ! Blank out first UCB B = 0. TWO = 2 GENER = .FALSE. C WRITE (5, 100) 100 FORMAT ('$ Enter input file name: ') READ (5, 110, END = 800) INFILE 110 FORMAT ( 40A1) C OPEN (UNIT = 1, NAME = INFILE, TYPE = 'OLD', ERR = 810, 1 FORM = 'UNFORMATTED', ACCESS = 'SEQUENTIAL', 2 READONLY, SHARED, RECORDTYPE = 'VARIABLE') C WRITE (5, 120) 120 FORMAT ('$ Enter output file name: ') READ (5, 110, END = 800) OUTFIL C OPEN (UNIT = 2, NAME = OUTFIL, TYPE = 'NEW', ERR = 820, 1 FORM = 'UNFORMATTED', ACCESS = 'SEQUENTIAL', 2 RECORDTYPE = 'FIXED', RECL = 8) C WRITE (5, 130) 130 FORMAT ('$ Enter task name to trace: ') READ (5, 140, END = 800) TASK 140 FORMAT (6A1) CALL IRAD50( 6, TASK, TSK) IF (T4(1) .EQ. DOTS) THEN GENER = .TRUE. GTSK = T4(2) ENDIF C J = 1 WRITE (5, 150) 150 FORMAT ('$ Enter summation interval in whole seconds: ') READ (5, 160, END = 800) J 160 FORMAT (I5) IF (J .LE. 0) J = 1 RSUM = FLOATI(J) C 200 IF (ABOFLG) GOTO 500 READ (1, ERR = 210, END = 500) INPT 210 IF (ID .GT. 58) GOTO 600 ! startup packets C C DO 220 U = 1, UCBMAX C IF (TIUCB .EQ. UCB(U, 1)) GOTO 240 ! Found a match C220 CONTINUE C U = 1 ! Will never get here C 240 IF (ABOFLG) GOTO 500 EXC(2) = INPT(2) ! swap high and low EXC(1) = INPT(3) ! words of timestamp RT = 0.00001 * TIME ! convert to real value 242 IF (RT .GE. B) THEN ! have gone past end of interval B = RSUM + RT ! increase to next interval WRITE (2) TWO, RT, TASK, DATOUT ! write data DO 245 I = 1, 4 245 DATOUT(I) = 0 ! re-set counters ENDIF IF (GENER) THEN IF (INPT(4) .NE. GTSK) GOTO 200 ! not proper ...XXX task ELSE IF (TSKIN .NE. TSK) GOTO 200 ! not proper XXXXXX task ENDIF IF (IMOD(ID, 2) .NE. 0) GOTO 310 ! should only have I = ID / 2 ! even ID's C C IF (I .LT. 3) GOTO 250 ! no idle time C IF (I .GT. 5) GOTO 250 ! ditto C T = INPT(7) ! correct idle time C INPT(7) = INPT(8) ! word order C INPT(8) = T C 250 IF (ABOFLG) GOTO 500 GOTO ( 380, 200, 200, 200, 350, 200, 200, 330, 200, 200, 1 200, 200, 200, 200, 340, 200, 200, 200, 360, 200, 2 200, 200, 200, 200, 200, 200, 200, 200, 200) I C 310 WRITE (5, 410) ID ! unknown 410 FORMAT( 14X, 'Unknown packet ', I4) GOTO 200 C320 WRITE (2) ID, RT, TASK, INPT(7) C GOTO 200 330 DATOUT(4) = DATOUT(4) + 1 ! AST's to task GOTO 200 340 DATOUT(2) = DATOUT(2) + 1 ! I/O pkt to driver GOTO 200 350 DATOUT(3) = DATOUT(3) + 1 ! Load context GOTO 200 360 DATOUT(2) = DATOUT(2) + 1 ! I/O pkt to ACP GOTO 200 C370 WRITE (2) ID, I8(1, I), I8(2, I) C GOTO 200 380 J = IAND( INPT(7), "377) CCCC J = (J + 1) / 2 CCCC IF (J .GT. (DICS - 1)) J = DICS DATOUT(1) = DATOUT(1) + 1 ! directives GOTO 200 C 600 I = ID - 255. IF (I .EQ. 65) I = 10 ! system metric IF (ABOFLG) GOTO 500 GOTO (200, 200, 200, 200, 620, 680, 690, 640, 640, 660) I GOTO 310 C 620 CONTINUE C DO 622 U = 1, UCBMAX ! TCB C IF (INPT(15) .EQ. UCB(U, 1)) GOTO 624 C622 CONTINUE C624 CALL R50ASC( 6, INPT(7), TASK) C WRITE (5, 626) J8(1, I), J8(2, I), TASK, UCB(U, 2), UCB(U, 3) C626 FORMAT( 14X, 2A8, 1X, 6A1, 1X, A2, O2.2, ':') GOTO 200 C 640 EXC(2) = INPT(10) ! exchange low and EXC(1) = INPT(11) ! high KW11P counts WRITE (2) ID, EXC, (INPT(J), J = 2, 9) ! write record B = 0.00001 * TIME ! current base time B = 1.0 + B ! next second 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 GOTO 242 ! check for write C 680 IF (DEV .NE. OLDDEV) THEN ! DCB OLDDEV = DEV UNIT = 0 ENDIF GOTO 200 C 690 UCBMAX = UCBMAX + 1 CX J = IAND( INPT(7), "377) ! get unit number UCB(UCBMAX, 1) = INPT(3) ! store UCB (was word 5) UCB(UCBMAX, 2) = OLDDEV ! device type UCB(UCBMAX, 3) = UNIT UNIT = UNIT + 1 GOTO 200 C 500 CLOSE (UNIT = 1) CLOSE (UNIT = 2) C 800 STOP C 810 STOP ' Error opening input file' C 820 STOP ' Error opening output file' C END