FTN4
      PROGRAM CTRAC (3,2),92082-16001 REV.2001 800129 
C 
C 
C 
C 
C 
C     DATE: 10-06-79
C     NAME: CTRAC 
C     SOURCE: 92082-18001 
C     RELOC:  92082-16001 
C     PGMR: C.M.M.
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C 
C 
C 
C 
C     THE CTRAC PROGRAM ALONG WITH THE CPLOT PROGRAM PROVIDE THE USER 
C     WITH THE ABILITY TO PERFORM AN ANALYSIS OF ANY PROGRAM WRITTEN
C     IN ANY LANGUAGE RUNNING ON AN RTE4 SYSTEM.
C 
C     THE BASIC IDEA BEHIND THE PROGRAM IS TO SAMPLE THE POINT OF 
C     SUSPENSION WORD IN THE TEST PROGRAMS ID SEGMENT.  THIS IS DONE
C     EVERY 10 MILLISECONDS.  THE DATA IS GATHERED ALONG WITH THE 
C     CURRENTLY ACTIVE ID SEGMENT AND STORED OUT ON A DISC FILE.  THE 
C     DATA CAN THEN BE LOOKED AT LATER WITH THE CPLOT PROGRAM TO GET
C     AN EXECUTION TIME PROFILE OF THE PROGRAM. 
C 
C 
C 
C 
      DIMENSION ISTRNG(40),INAME(3),IDCB(528),IBUF(1024),IPBUF(10)
      DIMENSION IFILE(20),IYES(7),IEXIST(35),ISTATE(3),IDBUF(109) 
      DIMENSION IGO(5),ISS(5),ISTART(5),ISTOP(5),MYNAME(24) 
      INTEGER YESNO,BRKBIT(8) 
      LOGICAL IEXIT 
C 
      DATA ISTATE/1,2,3/
      DATA MYNAME/2H  ,2HEN,2HTE,2HR ,2HA ,2H' ,2HGO,2H, ,2H  ,2H  ,
     &            2H  ,2H  ,
     &            2H' ,2HTO,2H S,2HTA,2HRT,2H T,2HHE,2H A,2HNA,2HLY,
     &            2HSI,2HS./
C 
      DATA BRKBIT/2H  ,2H ',2H B,2HR,,2H  ,2H  ,2H  ,2H '/
      DATA IGO/2HGO,2H, ,2H  ,2H  ,2H  /
      DATA ISS/2HSS,2H, ,2H  ,2H  ,2H  /
      DATA IEXIST/2H  ,2HFI,2HLE,2H  ,2H  ,2H  ,2H  ,2H  ,2HEX,2HIS,
     &            2HTS,2H O,2HN ,2HLU,2H  ,2H  ,2H  ,2H  ,2H .,2H  ,
     &            2HOK,2H T,2HO ,2HOV,2HER,2HLA,2HY ,2HIT,2H ?/ 
      DATA IYES/  2H  ,2HYE,2HS ,2HOR,2H N,2HO ,2H?_/ 
C 
      ISPACE(IDUM) = EXEC(2,LU,2H  ,1)
      IKVT(IERR) = 2H00 + (IERR/10*256) + MOD(IERR,10)
C 
C     GET THE INTERACTIVE LU #
C 
      LU = LOGLU(LU)
      LUREAL = LUTRU(LU)
      LU = LU + 400B
C 
C     GET THE INTERACTIVE TTY EQT ADDRESS 
C 
      IEQT = IAND(IXGET(IXGET(1652B)+LUREAL -1),77B) - 1
      IEQT = (IEQT * 15) + IXGET(1650B) 
C 
C 
C 
      CALL REIO(2,LU,60H  THE RTE PROFILE MONITOR    -    DATA COLLECTIO
     &N SECTION !!,-60) 
      CALL REIO(2,LU,48H  ENTER ' EX ' AT ANY TIME TO EXIT THIS PROGRAM.
     &,-48) 
C 
C                   FIND OUT IF I'M GOING TO RUN THE PROGRAM
C                              OR IF HE IS. 
C 
C 
C 
5     IA = ISPACE(IDUM) 
      IA = ISPACE(IDUM) 
      CALL REIO(2,LU,70H  DO YOU WANT ME TO TAKE CARE OF ALL OF THE DETA
     &ILS OF SCHEDULING AND ,-70) 
      CALL REIO(2,LU,24H  RUNNING YOUR PROGRAM ?, -24)
      CALL REIO(2,LU,IYES,7)
      CALL REIO(1,LU,IFILE,2) 
      IF(IEXIT(IFILE)) GO TO 9999 
      IF(YESNO(IFILE).EQ.0)  GO TO 5
      IF(IFILE .EQ. 2HYE) GO TO 10
C 
C 
C                   HE WANTS TO SCHEDULE THE PROGRAM HIMSELF. 
C                   SET FLAGS AS :
C                                   MYRUN = 0  , HE RUNS PROGRAM HIMSELF
C                                         = 1  ,  I RUN THE PROGRAM 
C                                  IPAUSE = 0  , PAUSE MYSELF TO GIVE 
C                                                HIM A CHANCE TO START
C                                                HIS PROGRAM. 
C                                         = -1   START TAKING DATA
C                                                IMMEDIATELY
C 
C 
C 
      MYRUN = 0 
      IPAUSE = 0
C 
C 
C                   GET THE PROGRAM NAME
C 
      IA = ISPACE(IDUM) 
      CALL REIO(2,LU,54H  ENTER THE NAME OF THE PROGRAM YOU WISH TO PROF
     &ILE. _,-54) 
C 
      CALL REIO(1,LU,ISTRNG,-40)
      CALL ABREG(IA,IB) 
      IONE = 1
      GO TO 20
C 
C 
10    IA = ISPACE(IDUM) 
      MYRUN = 1 
      CALL REIO(2,LU,44H  ENTER PROGRAM RUN STRING AS:  RU,PROG,....,22)
      CALL REIO(1,LU,ISTRNG,-40)
      CALL ABREG(IA,IB) 
      IMLEN = IB
      IONE = 1
      CALL NAMR(IPBUF,ISTRNG,IB,IONE) 
      IF(IEXIT(IPBUF)) GO TO 9999 
      IF(IPBUF .NE. 2HRU) GO TO 10
C 
C     GET THE PROGRAM NAME
C 
20    IF(NAMR(IPBUF,ISTRNG,IB,IONE) .LT.0) GO TO  5 
      IF (MYRUN .EQ.1)  GO TO 25
      IF(IEXIT(IPBUF)) GO TO 23 
      GO TO 25
23    IF(IPBUF(2).EQ. 2H  ) GO TO 9999
25    INAME = IPBUF 
      INAME(2) = IPBUF(2) 
      INAME(3) = IPBUF(3) 
C 
C     NOW SEE IF THE PROGRAM EXISTS 
C 
      IDADR = IDSGA(INAME)
      IF((IDADR .GT. 0).AND. (IAND(IPBUF(4),3).EQ.3)) GO TO 100 
      CALL REIO(2,LU,18H  NO SUCH PROGRAM ,9) 
      GO TO 5 
C 
C 
C     GET THE FILE NAME WHERE THE ANALYSIS DATA IS TO RESIDE. 
C         ALSO CONFIGURE THE  SS,PROG & GO, PROG COMMANDS.
C 
C 
C 
100   IGO(3) = INAME(1) 
      IGO(4) = INAME(2) 
      IGO(5) = INAME(3) 
      ISS(3) = INAME(1) 
      ISS(4) = INAME(2) 
      ISS(5) = INAME(3) 
C 
C                   CALCULATE A FEW ADDRESSES FOR LATER.
C 
C                   IDSTAT = ID SEG STATUS WORD ADDRESS 
C                   ISUSP  = ID SEG POINT OF SUSPENSION WORD ADDR 
C                   ISWP   = ID SEG SWAP ADDRESS WORD 
C 
C 
      IDSTAT = IDADR + 15 
      ISWP   = IDADR + 27 
      ISUSP  = IDADR + 8
C 
C                   SET UP THE BASE PAGE
C 
      CALL IXPUT(1740B,0) 
      CALL IXPUT(1741B,0) 
C 
C                   NOW GET THE FILE NAME FOR THE DATA. 
C 
105   IA = ISPACE(IDUM) 
      CALL REIO(2,LU,38H  ENTER FILE NAMR FOR ANALYSIS DATA  _,-38) 
      CALL REIO(1,LU,IFILE,-40) 
      CALL ABREG(IA,IB) 
      IA = ISPACE(IDUM) 
C 
C     OK, SO PARSE THE INPUT TO GET THE NAME
C 
      IONE = 1
      IF(NAMR(IPBUF,IFILE,IB,IONE).LT. 0) GO TO 100 
      IF(IAND(IPBUF(4),3) .NE. 3) GO TO 100 
C 
      IF(IEXIT(IPBUF)) 110, 115 
C 
110   IF(IPBUF(2) .NE. 2H  ) GO TO 115
      CALL REIO(2,LU,70H  PLEASE DO NOT USE ' EX, EN, /E, /A, OR AB ' FO
     &R FILE NAMES AS THESE ,-70) 
      CALL REIO(2,LU,42H  ARE ALSO USED FOR THE TERMINATE COMMAND.,-42) 
      IA = ISPACE(IDUM) 
      GO TO 105 
C 
C 
C 
C     GOT A NAMR SO GO SEE IF IT EXISTS & SET UP THE DEFAULTS 
C 
115   IF(IPBUF(8) .EQ.0) IPBUF(8) = 48
      CALL CREAT(IDCB,IER,IPBUF,IPBUF(8),4,IPBUF(5),IPBUF(6),528) 
      IF(IER .EQ. -2) GO TO 125 
      IF(IER .GE.0) GO TO 200 
C 
C     SOME SORT OF FMGR ERROR 
C 
      CALL FMPER(IER,IPBUF,LU)
      GO TO 100 
C 
C     THE FILE SPECIFIED ALREADY EXISTS ASK THE USER IF IT IS OK
C     TO USE THAT FILE. 
C 
C 
125   IEXIST(5) = IPBUF(1)
      IEXIST(6) = IPBUF(2)
      IEXIST(7) = IPBUF(3)
      IEXIST(14) = 2HLU 
      ILEN = 35 
      IF(IPBUF(6) .EQ. 0) ILEN = 11 
      IF(IPBUF(6) .LT. 1) GO TO 130 
C 
      IEXIST(14) = 2HCR 
C 
C     SEE IF THE CRT REF WAS SPECIFIED IN ASCII 
C 
      IF(IAND(IPBUF(4),60B) .NE. 60B) GO TO 130 
C 
C     IT WAS. 
C 
      IEXIST(16) = 2H 
      IEXIST(18) = 2H 
      IEXIST(17) = IPBUF(6) 
      GO TO 135 
C 
C 
130   CALL CNUMD(IABS(IPBUF(6)),IEXIST(16)) 
C 
C                   TELL THE USER THAT THE FILE ALREADY EXISTS
C                   AND ASK IF IT'S OK TO OVERLAY IT. 
C 
135   CALL REIO(2,LU,IEXIST,ILEN) 
      IF(ILEN .EQ.11) CALL REIO(2,LU,IEXIST(20),10) 
136   CALL REIO(2,LU,IYES,7)
      CALL REIO(1,LU,IFILE,2) 
      IF(IEXIT(IFILE)) GO TO 9999 
      IF(YESNO(IFILE) .EQ. 0) GO TO 136 
      IF(IFILE .NE. 2HYE) GO TO 100 
      CALL OPEN(IDCB,IER,IPBUF,IOPTN,IPBUF(5),IPBUF(6),528) 
      IF(IER .GT.0) GO TO 140 
C 
C     FILE OPEN ERROR 
C 
      CALL FMPER(IER,IPBUF,LU)
      GO TO 9999
C 
140   IF(IER .GT. 2) GO TO 200
C 
C     RANDOM ACCESS FILE. WE DON'T WANT THAT. 
C 
      CALL REIO(2,LU,50H  WRONG FILE TYPE.  FILE MUST BE TYPE 3 OR GREAT
     &ER,-50) 
      GO TO 105 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C                                                                        C
C       THE 1ST RECORD OF THE DATA BUFFER IS THE INFORMATION             C
C       NEEDED BY THE GRAPH PROGRAM ABOUT THE PROGRAM UNDER              C
C       TEST AND ALL ITS ID SEGMENTS.                                    C
C       THE BUFFER IS SET UP AS FOLLOWS :                                C
C                                                                        C
C        WORDS   1 - 33      MAINS ID SEGMENT                            C
C        WORD      34        # OF SEGMENT LOADS PERFORMED                C
C        WORD      35        # OF SHORT SEGMENTS THE PROGRAM CALLED      C
C        WORDS  36 - 44      10 WORDS REPEATING. 1ST WORD = SEG ID ADDR  C
C                                NEXT 9 WORDS = CONTENTS OF ID SEG       C
C                                                                        C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
C 
C     FILL IN THE 1ST RECORD OF THE FILE
C 
C 
C 
200   DO 210 I = 1,33 
      IBUF(I) = IXGET(IDADR + I - 1)
210   CONTINUE
C 
      IBUF(23) = IBUF(23) + 42B 
C 
C 
C     GET SEGMENT FLAG & POST PART OF 1ST RECORD TO FILE
C     WE WILL COME BACK LATER & OPEN THE FILE IN THE UPDATE 
C     MODE TO PLACE THE REST OF THE INFO INTO THE 1ST RECORD. 
C     * NOTE I'VE CHANGED THE PROGRAM TO USE 128 WORD RECORDS.  HOWEVER,
C     * THE LOGICAL RECORD SIZE IS 1024 WORDS.
C 
C 
      ISEG    = IXGET(IDADR + 29) 
      ISEGN   = 0 
C 
C 
      DO 225 KK = 0,7 
      CALL WRITF(IDCB,IER,IBUF(1+KK*128),128) 
      IF(IER .GE. 0) GO TO 225
C 
C     SOME SORT OF WRITE ERROR
C 
      CALL FMPER(IER,IPBUF,LU)
      GO TO 9999
225   CONTINUE
C 
C 
C     OK, SO THE FILE IS ALL SET UP.  NOW GET THE INTERVAL AT WHICH 
C     WE TAKE SAMPLES OF THE PROGRAM'S POINT OF SUSPENSION. 
C     ACTUALLY I'VE HARD CODED THE INTERVAL TO 10MS.
C 
C 
C 
250   INTRVL = -1 
C 
C 
C 
C     NOW SEE IF THE USER WISHES TO COLLECT DATA WHILE
C     PROGRAM IS I/O SUSPENDED OR IN GENERAL WAIT 
C 
C                I/O SUSPEND
C 
C 
      IA = ISPACE(IDUM) 
      CALL REIO(2,LU,66H  DO YOU WANT ME TO TAKE DATA WHILE YOUR PROGRAM
     & IS I/O SUSPENDED ,-66) 
      CALL REIO(2,LU,40H  WAITING FOR INPUT FROM YOUR TERMINAL ?,-40) 
251   CALL REIO(2,LU,IYES,7)
      CALL REIO(1,LU,IBUF(1000),1)
      IF(IEXIT(IBUF(1000))) GO TO 9999
      IF(YESNO(IBUF(1000)).EQ. 0) GO TO 251 
      ITTY = 0
      IF(IBUF(1000) .EQ. 2HYE) ITTY = -1
C 
C 
      IA = ISPACE(IDUM) 
      CALL REIO(2,LU,72H  COLLECT DATA WHILE PROGRAM IS IN I/O SUSPEND S
     &TATE ON OTHER DEVICES  ?,-72) 
C 
275   CALL REIO(2,LU,IYES,7)
      CALL REIO(1,LU,IBUF(1000),1)
      IF(IBUF(1000) .NE.2HYE) ISTATE(2) = 10
      IF(IEXIT(IBUF(1000))) GO TO 9999
      IF(YESNO(IBUF(1000)).EQ. 0) GO TO 275 
C 
C 
C                GENERAL WAIT STATE 
C 
C 
      IA = ISPACE(IDUM) 
      CALL REIO(2,LU,56H  COLLECT DATA WHILE PROGRAM IS IN GENERAL WAIT 
     & STATE ?,-56) 
C 
280   CALL REIO(2,LU,IYES,7)
      CALL REIO(1,LU,IBUF(1000),1)
      IF(IBUF(1000) .NE. 2HYE) ISTATE(3) = 10 
      IF(IEXIT(IBUF(1000))) GO TO 9999
      IF(YESNO(IBUF(1000)).EQ. 0) GO TO 280 
C 
C 
C                   SEE IF HE WANTS PROGRAM TO START IMEDIATELY 
C 
C 
      IF(MYRUN .EQ. 0) GO TO 530
      IA = ISPACE(IDUM) 
      CALL REIO(2,LU,68H  DO YOU WANT ME TO START TAKING DATA IMMEDIATEL
     &Y AFTER THE PROGRAM ,-68) 
      CALL REIO(2,LU,20H  STARTS EXECUTING ?,-20) 
285   CALL REIO(2,LU,IYES,7)
      CALL REIO(1,LU,IBUF(1000),1)
      IF(IEXIT(IBUF(1000))) GO TO 9999
      IF(YESNO(IBUF(1000)).EQ. 0) GO TO 285 
      IPAUSE = 0
      IF(IBUF(1000) .EQ. 2HYE) IPAUSE = -1
C 
C 
C 
C 
C               SO WE'VE GOT THE DATA WE NEED LETS
C                   SEE IF THE USER IS READY. 
C 
C 
300   IA = ISPACE(IDUM) 
      CALL REIO(2,LU,49H  I'M READY TO RUN YOUR PROGRAM.  ARE YOU READY 
     &?,-49)
290   CALL REIO(2,LU,IYES,7)
      CALL REIO(1,LU,IBUF(1000),1)
      IF(IEXIT(IBUF(1000))) GO TO 9999
      IF(YESNO(IBUF(1000)) .EQ. 0) GO TO 290
      IF(IBUF(1000) .NE. 2HYE) GO TO 300
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C           OK, EVERYTHING IS SET UP.  LETS INVOKE THE                 C
C           PROGRAM AND START TAKING THE DATA POINTS.                  C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C     INVOKE THE PROGRAM
C 
400   I = MESSS(ISTRNG,IMLEN,LU)
C 
      IF(I .EQ. 0) GO TO 450
C 
C     OPS WE GOT A MESSAGE BACK.  MUST BE AN ERROR
C 
      CALL REIO(2,LU,ISTRNG,I)
      GO TO 9999
C 
C 
C     DO A CORE LOCK SO WE CON'T GET SWAPPED !! 
C 
450   CALL EXEC(22,1) 
C 
C                   DON'T TAKE ANY DATA UNTIL THE PROGRAM GETS
C                          INTO MEMORY. 
C 
C 
500   CALL EXEC(12,0,1,0,INTRVL)
      K = K + 1 
      IF(K .EQ. 1000) GO TO 10000 
      IF(IFBRK(IDUM)) 9999,510
C 
C     WAIT TILL THE PROGRAM GETS INTO MEMORY
C 
510   IF(IXGET(IDADR + 8) .EQ. 0)  GO TO 500
C 
C 
C 
C                WE MADE IT ! THE PROGRAM GOT INTO
C                MEMORY.  GET THE START TIME &
C                 START TAKING DATA.
C 
C 
      IF(IPAUSE .EQ.-1) I = MESSS(ISS,10) 
      CALL EXEC(11,ISTART)
      IF(I .EQ. 0) GO TO 525
C 
      CALL REIO(2,LU,ISS,I) 
      GO TO 9999
C 
C 
C 
525   IF(IPAUSE)540,530 
C 
530   IA = ISPACE(IDUM) 
      I = 0 
      CALL REIO(2,LU,48H  OK !  I'M READY TO TAKE DATA ON YOUR PROGRAM. 
     &,-48) 
      CALL PNAME(MYNAME(9)) 
      CALL REIO(2,LU,MYNAME,24) 
      CALL EXEC(22,1) 
      CALL EXEC(7)
      CALL EXEC(11,ISTART)
      IF(IAND(IXGET(IDSTAT),7).NE.0) GO TO 540
      CALL REIO(2,LU,26HYOUR PROGRAM IS DORMANT ??,-26) 
      GO TO 9999
C 
C 
C 
540   IA = ISPACE(IDUM) 
      IA = ISPACE(IDUM) 
      IA = ISPACE(IDUM) 
      CALL REIO(2,LU,60H  I'VE STARTED TAKING DATA ON YOUR PROGRAM.  YOU
     & MAY ENTER A,-60) 
C 
       CALL PNAME(BRKBIT(5))
       CALL REIO(2,LU,BRKBIT,8) 
       CALL REIO(2,LU,36H  TO STOP THE ANALYSIS IF YOU WISH. ,-36)
C 
C 
       IA = ISPACE(IDUM)
       IA = ISPACE(IDUM)
C 
C 
       IF(IPAUSE) 550,560 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C                                                                           C 
C           THIS SECTION TAKES THE READINGS & SUSPENDS ITSELF               C 
C                                                                           C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
550   I = MESSS(IGO,10) 
560   K = 0 
      IF(I .EQ. 0) GO TO 600
      CALL REIO(2,LU,IGO,I) 
      GO TO 9999
C 
C                   SUSPEND THYSELF.  COME BACK IN 10 MS. 
C 
600   CALL EXEC(12,0,1,0,INTRVL)
      IF(IFBRK(IDUM)) 9000,610
610   ISTAT = IAND(IXGET(IDSTAT),7) 
C 
C 
C                   GOT THE PROGRAM STATUS.  LETS SEE WHAT TO DO
C 
C 
C 
      IF(ISTAT .EQ. 1) GO TO 690
      IF(ISTAT .EQ. 2) GO TO 650
      IF(ISTAT .EQ. ISTATE(3)) GO TO 700
      IF(ISTAT .EQ. 0) GO TO 9000 
C 
C     MUST BE STATE 4, 5, OR 6  SO DON'T TAKE DATA. 
C 
      GO TO 600 
C 
C 
C                   PROGRAM IS I/O SUSPENDED
C              SEE IF WE ARE SUPPOSED TO TAKE DATA. 
C 
C 
C 
650   IF(IXGET(IEQT) .EQ. IDADR) GO TO 675
C 
      IF(ISTATE(2) .EQ. 10) GO TO 600 
      GO TO 700 
C 
675   IF(ITTY) 700,600
C 
C              STATUS IS SCHEDULED.  MAKE SURE THAT TARGET
C              PROGRAM WAS THE ONE WE INTERUPTED AND THAT 
C              HE IS NOT CURRENTLY SWAPPED OUT. 
C 
C 
690   IF(IXGET(IXGET(1717B)).NE.IDADR) GO TO 600
      IF(IXGET(ISWP) .NE. 0) GO TO 600
C 
C                   ALLS WELL.  SO TAKE THE DATA. 
C 
700   K = K + 1 
      IBUF(K) = IXGET(ISUSP)
C 
C     OK, NOW DO ALL THE PAINFUL THINGS REQUIRED FOR SEGMENTED
C     PROGRAMS. 
C 
C                   ANY SEGMENTS LOADED YET ? 
C 
      IF(ISEG .EQ. 0) GO TO 750 
      K = K + 1 
C 
C     YES, SO SET UP
C     ITHIS = THIS SEGMENTS ID ADDRESS , IOLD = LAST SEGMENT ID ADDRESS 
C 
C                   SEE IF ANY SEGMENTS LOADED IN THE LAST
C                   10 MS.
C 
      ITHIS = IXGET(1740B)
      IBUF(K) = ITHIS 
      IF(ITHIS .EQ. IOLD) GO TO 750 
      IOLD = ITHIS
C 
C                   A SEGMENT WAS LOADED !! 
C                   SEE IF THIS IS A NEW SEG OR HAS BEEN LOADED BEFORE. 
C 
C 
      DO 725 I = 1,ISEGN
      IF(ITHIS .EQ. IDBUF(I)) GO TO 750 
725   CONTINUE
C 
C                   NEW SEGMENT.  WE HAVEN'T SEEN THIS ONE BEFORE.
C                   SO GET THE INFO ON THE SEGMENT AND CONTINUE.
C 
C 
      IF(ISEGN .NE. 108) ISEGN = ISEGN + 1
      IDBUF(ISEGN) = ITHIS
750   IF(K .NE.1024) GO TO 600
C 
C 
C     INTERNAL BUFFER IS FULL SO POST IT TO THE DISC BUT SUSPEND
C     THE PROGRAM WERE INTERESTED IN FIRST. 
C 
C 
      I = MESSS(ISS,10) 
      IF(I. EQ. 0) GO TO 775
      CALL REIO(2,LU,ISS,I) 
      GO TO 9999
C 
C                   WRITE THE INFO TO THE DISC. 
C 
775   DO 800 KK = 0,7 
      CALL WRITF(IDCB,IER,IBUF(1+KK*128),128) 
      IF(IER .GE. 0) GO TO 800
C 
C     SOME SORT OF WRITE ERROR
C 
      CALL FMPER(IER,IPBUF,LU)
      GO TO 9000
800   CONTINUE
C 
C              RESCHEDULE THE PROGRAM & START TAKING DATA AGAIN.
C 
      GO TO 550 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                          C
C          TARGET PROGRAM IS DORMANT.  SO POST LAST BUFFER AND             C
C                  SET UP TO CLOSE THE DATA FILE                           C
C                   ALSO GET THE END TIME                                  C
C                                                                          C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
9000  CALL EXEC(11,ISTOP) 
      IF(K .EQ. 1024) GO TO 9200
      DO 9100 I = K+1,1024
      IBUF(I) = 0 
9100  CONTINUE
C 
C 
C 
      DO 9250 KK = 0,7
9200  CALL WRITF(IDCB,IER,IBUF(1+KK*128),128) 
      IF(IER .GE. 0 ) GO TO 9250
      CALL FMPER(IER,IPBUF,LU)
      GO TO 9300
9250  CONTINUE
C 
C 
9300  CALL CLOSE(IDCB,IER)
      IF(IER .GE. 0) GO TO 9350 
C 
C     SOME SORT OF CLOSE ERROR
C 
      CALL FMPER(IER,IPBUF,LU)
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                          C
C                     SET UP THE 1ST RECORD FOR THE                        C
C                          GRAPHING PROGRAM                                C
C                                                                          C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C     REOPEN THE FILE IN THE UPDATE MODE
C 
9350  CALL OPEN(IDCB,IER,IPBUF,2,IPBUF(5),IPBUF(6),528) 
      IF(IER .GE.0) GO TO 9375
C 
C     SOME SORT OF OPEN ERROR 
C 
      CALL FMPER(IER,IPBUF,LU)
      GO TO 9999
C 
9375  DO 9380 KK =0,7 
      CALL READF(IDCB,IER,IBUF(1+KK*128),128) 
      IF(IER .GE.0) GO TO 9380
C 
C     READ ERROR
C 
      CALL FMPER(IER,IPBUF,LU)
      GO TO 9999
9380  CONTINUE
C 
9400  CALL RWNDF(IDCB,IER)
      IF(IER .GE. 0) GO TO 9425 
C 
C     REWIND ERROR ? OH COME NOW !
C 
      CALL FMPER(IER,IPBUF,LU)
      GO TO 9999
C 
9425  IBUF(34) = IXGET(1741B) 
      IBUF(35) = ISEGN
      IF(ISEGN .EQ. 0) GO TO 9460 
      ICOUNT = 35 
C 
      DO 9450 I = 1,ISEGN 
      ICOUNT = ICOUNT + 1 
      IBUF(ICOUNT) = IDBUF(I) 
      IOFFST = 0
      DO 9430 J = 1,9 
      ICOUNT = ICOUNT + 1 
      IBUF(ICOUNT) = IXGET(IDBUF(I) + 10 + J + IOFFST)
C 
C     WATCH OUT FOR LONG ID SEG 
C 
      IF((J .EQ. 4) .AND. (IAND(IBUF(ICOUNT),20B).EQ.  0 )) IOFFST = 7
9430  CONTINUE
9450  CONTINUE
C 
C 
C     POST START & STOP TIME
C 
C 
9460  DO 9475 I = 1,4 
      IBUF(1016 + I) = ISTART(I)
      IBUF(1020 + I) = ISTOP(I) 
9475  CONTINUE
C 
C 
C 
C     POST ID INFO TO THE DISC
C 
      DO 9600 KK = 0,7
9500  CALL WRITF(IDCB,IER,IBUF(1+KK*128),128) 
      IF(IER .GE. 0) GO TO 9600 
C 
C     WRITE ERROR 
C 
      CALL FMPER(IER,IPBUF,LU)
      GO TO 9999
9600  CONTINUE
C 
C 
9999  IA = ISPACE(IDUM) 
      CALL REIO(2,LU,22H  ANALYSIS COMPLETE !!,11)
      CALL CLOSE(IDCB,IER)
      CALL EXEC(6,0)
10000 IF(IAND(IXGET(IDSTAT),7).NE. 0) GO TO 10001 
      CALL REIO(2,LU,43H YOUR PROGRAM RUNS TOO FAST TO BE ANALIZED.,-43)
      GO TO 9999
C 
C 
10001 CALL REIO(2,LU,60H  PARTITION CONFLICT !  ASSIGN THIS PROGRAM AND 
     &THE PROGRAM ,-60) 
      CALL REIO(2,LU,42H  TO BE ANALIZED TO DIFFERENT PARTITIONS. ,-42) 
      GO TO 9999
      END 
      END$