C C FORTRAN EXECUTION PROFILER C C RECEIVES VS: MESSAGES FROM "PROFIL" ROUTINES C EXTERNAL ASTSUB INTEGER*4 RTNAME(200),TSKNAM,RAD50 BYTE LINE(80) INTEGER*2 RTNUM(200) INTEGER*2 STMTNO(2,2000),CURRTN,SMTO2C INTEGER*4 COUNT(2000) COMMON NRTN,NENTRY,TSKNAM,RTNAME,RTNUM,COUNT,STMTNO,CURRTN DATA PROFIL/6RPROFIL/ CALL GETMCR(LINE,N) TSKNAM=RAD50(LINE(5)) CALL VS2INI(1,26) CALL IVSAST(1,1,PROFIL,ASTSUB) 1 CALL STOP CALL DSASTR TYPE 2 2 FORMAT('$Name of file to contain profile information: ') ACCEPT 3,LINE 3 FORMAT(80A1) DO 4 N=80,1,-1 4 IF(LINE(N).GT.' ')GOTO5 CALL ENASTR GOTO1 5 LINE(N+1)=0 OPEN(UNIT=2,NAME=LINE,TYPE='NEW') CALL R50ASC(6,TSKNAM,LINE(1)) CALL TIME(LINE(7)) CALL DATE(LINE(15)) WRITE(2,6)(LINE(J),J=1,23) 6 FORMAT(' EXECUTION PROFILE FOR TASK "',6A1,'" AT ',8A1,' ON ',9A1/) DO 10 I=1,NENTRY DO 7 K=1,NRTN 7 IF(RTNUM(K).EQ.STMTNO(2,I))GOTO8 8 CALL R50ASC(6,RTNAME(K),LINE(1)) WRITE(2,9)(LINE(J),J=1,6),SMTO2C(STMTNO(1,I)),COUNT(I) 9 FORMAT(1X,6A1,' #',I6,' = ',I12) 10 CONTINUE CALL ENASTR CLOSE(UNIT=2) TYPE 11 11 FORMAT('$Exit (Y/N)? ') ACCEPT 3,LINE IF(LINE(1).NE.'Y'.AND.LINE(1).NE.'y')GOTO1 END INTEGER*2 FUNCTION SMTO2C(N) SMTO2C=N IF(N.LT.0)SMTO2C=N.XOR."77777 RETURN END BLOCK DATA INTEGER*4 RTNAME(200),TSKNAM INTEGER*2 RTNUM(200) INTEGER*2 STMTNO(2,2000),CURRTN INTEGER*4 COUNT(2000) COMMON NRTN,NENTRY,TSKNAM,RTNAME,RTNUM,COUNT,STMTNO,CURRTN DATA NRTN,NENTRY/1,1/ DATA RTNAME/6R.MAIN.,199*0/,RTNUM/1,199*0/ DATA CURRTN/1/ DATA COUNT,STMTNO/1,1999*0,0,1,3998*0/ END SUBROUTINE ASTSUB(QNAME,LEN) INTEGER*4 RTNAME(200),ROUTIN,TASK,TSKNAM INTEGER*2 RTNUM(200) INTEGER*2 STMTNO(2,2000),CURRTN INTEGER*4 COUNT(2000) COMMON NRTN,NENTRY,TSKNAM,RTNAME,RTNUM,COUNT,STMTNO,CURRTN INTEGER*2 BUF(4) INTEGER*4 KEY(2000),CURKEY EQUIVALENCE (TASK,BUF(1)),(ROUTIN,BUF(3)),(KEY,STMTNO),(CURKEY,BUF(3)) IF(LEN.LE.8)GOTO100 CALL VS2DLM(QNAME,0,I) RETURN 100 CALL VS2RLB(QNAME,BUF,8,I) IF(TASK.NE.TSKNAM)RETURN IF(LEN.EQ.6)GOTO200 I=0 J=NRTN+1 110 K=(I+J)/2 IF(K.EQ.0)GOTO120 IF(K.GT.NRTN)GOTO140 IF(RTNAME(K)-ROUTIN)120,180,140 120 IO=I I=K GOTO160 140 IO=I J=K 160 IF(IO.NE.K)GOTO110 K=K+1 NRTN=NRTN+1 IF(K.EQ.NRTN)GOTO175 DO 170 J=NRTN,K+1,-1 RTNAME(J)=RTNAME(J-1) RTNUM(J)=RTNUM(J-1) 170 CONTINUE 175 RTNAME(K)=ROUTIN RTNUM(K)=NRTN 180 CURRTN=RTNUM(K) RETURN 200 BUF(4)=CURRTN IF(BUF(3).LT.0)BUF(3)=BUF(3).XOR."77777 I=0 J=NENTRY+1 210 K=(I+J)/2 IF(K.EQ.0)GOTO220 IF(K.GT.NENTRY)GOTO240 IF(KEY(K)-CURKEY)220,280,240 220 IO=I I=K GOTO260 240 IO=I J=K 260 IF(IO.NE.K)GOTO210 K=K+1 NENTRY=NENTRY+1 IF(K.EQ.NENTRY)GOTO275 DO 270 J=NENTRY,K+1,-1 KEY(J)=KEY(J-1) COUNT(J)=COUNT(J-1) 270 CONTINUE 275 KEY(K)=CURKEY COUNT(K)=0 280 COUNT(K)=COUNT(K)+1 RETURN END