FTN4,L
      PROGRAM TDUMP(19,90),91780-16017 REV.1940 790528
C 
C  **************************************************************** 
C 
C     NAME:         TDUMP 
C     SOURCE:       91780-18017 
C     RELOC:        91780-16017 (PART OF) 
C     PGMR:         D. BOLIERE  ( 07/25/78 )
C                   L. DIETZ    ( 05/28/79 )
C 
C  **************************************************************** 
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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     ADD CAPABILITY TO DECODE TRACE INTO ASCII CHARS WHEN
C       USER SPECIFIED.  DEFAULTS TO EBCDIC.  ( 05/28/79 )
C 
C     ADD AUTO TOF AT COMPLETION IF OUTPUT DEVICE IS LINEPRINTER
C       (DRIVER TYPE = 12B).   ( 06/08/79 ) 
C 
C  **************************************************************** 
C 
C  PROGRAM TDUMP IS USED TO PROVIDE AN OFF-LINE ANALYSIS OF THE TRACE 
C  DATA (EBCDIC/ASCII) RJE/1000 BY THE PROGRAM TRACE. 
C 
C      RU,TDUMP [,INPUT [,OUTPUT [,LINECT [,LNCODE ] ] ] ]
C 
C      WHERE:  INPUT AND OUTPUT ARE ANY LU OR LEGAL FILE
C              NAME IN THE FORMAT NAMR [:SC [:CR ] ]. 
C 
C              INPUT IS THE LOCATION WHERE THE RAW TRACE DATA CAN BE
C              FOUND. 
C 
C              OUTPUT IS THE DESTINATION FOR THE INTERPRETED LISTING. 
C              IF A FILE IS SPECIFIED AND CANNOT BE FOUND, ONE IS 
C              CREATED OF TYPE 3 AND 24 BLOCKS WITH THE OPTIONAL USER 
C              SPECIFIED SECURITY CODE AND CARTRIDGE. 
C 
C              LINECT IS THE MAXIMUM NUMBER OF LINES OF INFORMATION TO
C              PRINT AFTER EACH LINE TURNAROUND.
C 
C              LNCODE IS THE COMMUNICATION LINE CODE WHICH WAS USED IN
C              TRANSMISSION DURING TRACE AND FROM WHICH IT WILL BE
C              DECODED INTO CHARACTERS.  LNCODE IS SPECIFIED AS 
C              EB[CDIC]/AS[CII].
C 
C              DEFAULTS ARE:  INPUT=8, OUTPUT=6, LINECT=999, LNCODE=EB
C 
C 
      INTEGER PARAM(5),DATA(2,64),LABL(14),TIME(2),TIM(16)
      INTEGER IREG(2),AREG,BREG,LBUF(40),LUARY(2),IDCB(144,2) 
      INTEGER DIREC,IBUF(50),TYPE 
      EQUIVALENCE (REG,IREG,AREG), (IREG(2),BREG) 
      EQUIVALENCE (LUARY(1),LUIN), (LUARY(2),LUOUT) 
      DATA TIME/2*0/,LCNT/999/,LUARY/8,6/ 
      DATA LCNTR/0/,DIREC/0/,LNCODE/2HEB/ 
C 
C PICK UP CONSOLE LU AND GET USER PARAMETER STRING
C 
      LUC=LOGLU(ISES) 
      CALL GETST(IBUF(11),-80,LOG)
      ISTRC=1 
C 
C DECODE FIRST TWO PARAMETERS THE SAME WAY
C 
      DO 40 I=1,2 
C 
C IF NO OR NULL PARAMETERS, USE DEFAULTS
C 
      IF(LOG.EQ.0) GO TO 20 
      IF(NAMR(IBUF,IBUF(11),LOG,ISTRC)) 20,10 
10    IF(IBUF(4).EQ.0) GO TO 20 
C 
C CHECK FOR FILE NAME 
C 
      IF(IBUF(4).NE.1) GO TO 30 
C 
C IF NUMERIC AND + , USE AS NEW LU #
C 
      IF(IBUF(1).GT.0) LUARY(I)=IBUF(1) 
C 
C LOCK LU # 
C 
20    REG=LURQ(100001B,LUARY(I),1)
      IF(AREG.EQ.0) GO TO 40
      WRITE(LUC,930) LUARY(I) 
      GO TO 999 
C 
C TRY TO OPEN SPECIFIED FILE
C 
30    LUARY(I)=-1 
      CALL OPEN(IDCB(1,I),IERR,IBUF,0,IBUF(5),IBUF(6))
      IF(IERR.GE.0) GO TO 40
      IF(IERR.EQ.-6.AND.I.NE.1) GO TO 35
      WRITE(LUC,910) IERR,(IBUF(J),J=1,3) 
      GO TO 999 
C 
C TRY TO CREATE THE FILE INSTEAD
C 
35    CALL CREAT(IDCB(1,I),IERR,IBUF,24,3,IBUF(5),IBUF(6))
      IF(IERR.GE.0) GO TO 40
      WRITE(LUC,920) IERR,(IBUF(J),J=1,3) 
      GO TO 999 
C 
40    CONTINUE
C 
C DECODE THIRD PARAMETER AS LINE COUNT LIMITATION 
C 
60    IF(NAMR(IBUF,IBUF(11),LOG,ISTRC)) 80,70 
70    IF(IBUF(4).NE.1) GO TO 80 
      IF(IBUF(1).GE.0) LCNT=IBUF(1) 
C 
C     DECODE FOURTH PARAMETER AS CHARACTER TRANSMISSION TYPE (EB/AS)
C 
80    IF(NAMR(IBUF,IBUF(11),LOG,ISTRC)) 100,90
90    IF(IBUF(4).EQ.0) GO TO 100
      IF(IBUF(1).EQ.2HEB) GO TO 100 
      IF(IBUF(1).EQ.2HAS) GO TO 95
      WRITE(LUC,925)
      GO TO 999 
95    LNCODE=2HAS 
C 
C INITIALIZATION ALL DONE, NOW START INTERPRETING THE FILE
C 
100   NREC=0
C 
C IF INPUT DEVICE IS A LU, READ FROM IT 
C 
110   IF(LUIN.LT.0) GO TO 120 
      REG=REIO(1,LUIN,DATA,128) 
      LEN=BREG
      GO TO 130 
C 
C OTHERWISE READ DATA FROM THE FILE SPECIFIED 
C 
120   CALL READF(IDCB(1,1),IERR,DATA(1,1),128,LEN)
      IF(IERR.GE.0) GO TO 130 
      WRITE(LUC,940)IERR
      GO TO 999 
C 
C MUST BE AN EOF: TERMINATE TDUMP 
C 
130   IF(LEN.LE.0) GO TO 790
C 
C SUCCESSFUL READ, START PROCESSING THE NEXT RECORD. IF ITS THE FIRST 
C RECORD, DECODE TIME STAMP.
C 
200   NREC=NREC+1 
      IPT=1 
      IF(NREC.NE.1) GO TO 210 
      CALL TMDA1(TIM,DATA)
      CALL CODE 
      WRITE(LBUF,800)TIM
      KCNT=25 
      GO TO 700 
C 
C PICK UP NEXT PAIR OF DATA ENTRIES 
C 
210   I1=DATA(1,IPT)
      I2=DATA(2,IPT)
C 
C IF UPPER BYTE OF I2 IS 200B OR 0B, THEN DECODE AS I/O ENTRY 
C WHICH MEANS I1 IS LOWER TIME STAMP AND LOWER BYTE OF I2 IS DATA BYTE
C 
      IF(IAND(I2,77400B).NE.0) GO TO 300
      TIME=I1 
C 
C RESET LINE DIRECTION INDICATOR IF WE'VE TURNED AROUND. ONLY 
C PRINT OUT USER SPECIFIED NUMBER OF LINES AFTER EACH TURNAROUND. 
C 
      K=0 
      IF(I2.LT.0) K=1 
      IF(K.NE.DIREC) LCNTR=0
      DIREC=K 
      IF(LCNTR.GE.LCNT) GO TO 720 
      LCNTR=LCNTR+1 
      CALL TMVAL(TIME,TIM)
C 
C CONVERT BYTE TO 4 CHARACTER DESCRIPTION 
C 
      CALL EBC(I2,LNCODE,LABL)
C 
C PRINT OUT AS RECEIVED IF UPPER BYTE OF I2=0 
C 
      IF(I2.GE.0) GO TO 250 
      CALL CODE 
      WRITE(LBUF,810) TIM(4),TIM(3),TIM(2),TIM(1),I2,LABL(1),LABL(2)
      KCNT=14 
      GO TO 700 
C 
C PRINT OUT AS SENT IF UPPER BYTE OF I2=200B
C 
250   CALL CODE 
      WRITE(LBUF,820) TIM(4),TIM(3),TIM(2),TIM(1),I2,LABL(1),LABL(2)
      KCNT=21 
      GO TO 700 
C 
C IF UPPER BYTE OF I2=100B, ENTRY IS NEW UPPER TIME STAMP.
C 
300   IF(IAND(I2,40000B).EQ.0) GO TO 400
      TIME(2)=I1
      GO TO 750 
C 
C IF UPPER BYTE OF I2=40B, ENTRY IS OVERRUN INDICATOR 
C 
400   IF(IAND(I2,20000B).EQ.0) GO TO 500
      CALL CODE 
      WRITE(LBUF,830) 
      KCNT=18 
      GO TO 700 
C 
C IF UPPER BYTE OF I2=20B, ENTRY IS NEW I/O REQUEST. ADDITIONALY, 
C IF THE LOWER BIT OF I2 IS SET, WE'VE ALSO STARTED A NEW TRACE.
C 
500   IF(IAND(I2,10000B).EQ.0) GO TO 600
      IF(IAND(I2,1).EQ.0) GO TO 550 
      CALL CODE 
      WRITE(LBUF,840) 
      KCNT=37 
      DATA(2,IPT)=IAND(I2,177776B)
      IPT=IPT-1 
      GO TO 700 
C 
550   CALL CMD(I1,LABL) 
      CALL CODE 
      WRITE(LBUF,850)I1,LABL
      KCNT=25 
      GO TO 700 
C 
C IF UPPER BYTE OF I2=10B, ENTRY IS A I/O COMPLETION/STATUS REPORT
C 
600   IF(IAND(I2,4000B).EQ.0) GO TO 650 
      CALL CODE 
      WRITE(LBUF,860)I2,I1
      KCNT=23 
      GO TO 700 
C 
C IF WE'VE GOT HERE, ITS AN ENTRY TYPE THAT IS NOT RECOGNIZED, SO 
C PRINT OUT DECODE ERROR. 
C 
650   CALL CODE 
      WRITE(LBUF,870) 
      KCNT=7
      GO TO 700 
C 
C IF LUOUT=-1, WRITE EXPLANATION BUFFER TO DISC FILE
C 
700   IF(LUOUT.GE.0) GO TO 710
      CALL WRITF(IDCB(1,2),IERR,LBUF,KCNT)
      IF(IERR.GE.0) GO TO 720 
      WRITE(LUC,950) IERR 
      GO TO 999 
C 
C IF LUOUT>0, WRITE BUFFER TO THAT LU.
C 
710   CALL REIO(2,LUOUT,LBUF,KCNT)
C 
C IF JUST WROTE HEADER, WRITE SECOND LINE AS WELL 
C 
720   IF(NREC.NE.1.OR.IPT.NE.1) GO TO 750 
      IPT=3 
      CALL CODE 
      WRITE(LBUF,880) 
      KCNT=21 
      GO TO 700 
C 
C IF MORE DATA IN RECORD, REPEAT ANALYSIS BEFORE ACCESSING I/O DEVICE 
C 
750   IPT=IPT+1 
      IF(IPT*2.LE.LEN) GO TO 210
      GO TO 110 
C 
C COMPLETION! 
C 
790   IF(LUIN.LT.0) CALL CLOSE(IDCB(1,1)) 
      IF(LUOUT.LT.0) CALL CLOSE(IDCB(1,2))
      WRITE(LUC,890)
      IF(LUOUT.LT.0) GO TO 999
C 
C GET EQUIPMENT TYPE CODE OF LUOUT.  DO TOF IF TYPE = 12B (LP). 
C 
      CALL EXEC(13,LUOUT,TYPE)
      TYPE=IAND(37400B,TYPE)/256
      IF(TYPE.EQ.12B) CALL EXEC(3,11B*64+LUOUT,-2)
      GO TO 999 
C 
C FORMAT STATEMENTS 
C 
800   FORMAT("1RJE/1000 TRACE OF",16A2) 
810   FORMAT(5X,I2,":",I2,":",I2,".",I2,3X,@3,1X,2A2,1X)
820   FORMAT(5X,I2,":",I2,":",I2,".",I2,17X,@3,1X,2A2,1X) 
830   FORMAT(" OVERRUN! ",6X,20("*")) 
840   FORMAT(" NEW TRACE STARTED ",55("*")) 
850   FORMAT(" I/O REQUEST=",@6,3X,14A2)
860   FORMAT(" COMPLETION/ERROR REPORT, STATUS=",@3,4X,@6)
870   FORMAT(" DECODE ERROR!")
880   FORMAT(5X,"HR:MN:SECOND",2X,"SENT",10X,"RECEIVED ") 
890   FORMAT(" TDUMP COMPLETED!") 
910   FORMAT(" TDUMP ABORTED DUE TO OPEN ERROR",I4," ON FILE ",3A2) 
920   FORMAT(" TDUMP ABORTED DUE TO CREATE ERROR",I4," ON FILE ",3A2) 
925   FORMAT(" TDUMP ABORTED DUE TO LINECODE PARAMETER ERROR")
930   FORMAT(" TDUMP ABORTED DUE TO LOCK FAILURE ON LU",I4) 
940   FORMAT(" TDUMP ABORTED DUE TO FILE READ ERROR",I4)
950   FORMAT(" TDUMP ABORTED DUE TO FILE WRITE ERROR",I4) 
C 
999   END 
      END$