Return to ERROR2.f CVS log

Up to [Research Unix] / researchv10no / cmd / pfort

Annotation of researchv10no/cmd/pfort/ERROR2.f, revision 1.1.1.1

1.1       root        1:       SUBROUTINE ERROR2( I,  JJ, K, NN, SPBEF, SPAFT )
                      2: C
                      3: C     PRINTS ERROR MESSAGES AND SYMBOLIC NAME
                      4: C     I IS PACKED HOLLERITH STRING
                      5: C     JJ IS NUMBER OF CHARACTERS TO BE PRINTED ( N = JJ)
                      6: C     K CONTAINS INTEGER OR HOLLERITH INFO TO FOLLOW MESSAGE
                      7: C     NN CONTROLS TYPE OF LINE TO BE PRINTED
                      8: C
                      9: C     NN = 0 MEANS PRINT MESSAGE
                     10: C
                     11: C     NN < 0 MEANS IF JJ=0 NO MESSAGE, ELSE PRINT MESSAGE
                     12: C     ON NEXT LINE IF NN = -1 PRINT PGM UNIT AND/OR STMT NO
                     13: C     (CONTROLLED BY CONTENTS OF K).
                     14: C     ON NEXT LINE IF NN = -2 PRINT PARAMETER NUMBER IN K
                     15: C     NN = -3 USED FOR SPACING CONTROL IN LONG MESSAGES
                     16: C
                     17: C     NN > 0 MEANS PRINT MESSAGE FOLLOWED BY IDENTIFIER IN K
                     18: C     SPBEF, SPAFT CONTROL LINE SPACING BEFORE AND AFTER MESSAGE
                     19: C     IF = 1, BLANK LINE EMMITTED
                     20: C
                     21:       INTEGER I(1), J(80), OUTUT, PDSA, DSA, M(6), K(6), W
                     22:       INTEGER SPBEF, SPAFT
                     23:       LOGICAL OPT, P1ERR, P2, QBR
                     24:       COMMON /CTABL/ LDSA, PDSA, DSA(5000)
                     25:       COMMON /PARAMS/ INUT, OUTUT, NOCHAR, I1, I2, I3, I4
                     26:       COMMON /FACTS/ NAME, NOST, ITYP, IASF
                     27:       COMMON /OPTNS/ OPT(5), P1ERR
                     28:       COMMON /PASS/ P2, QBR
                     29:       DATA W /1HW/, KK /1H-/
                     30: C
                     31: C     ERROR IN P.U. DURING PROCESSING OF A HEADING STMT, SPECIFI STMT,
                     32: C     EQUIV STMT, OR DATA STMT CAUSES PASS 2 TO BE SUPPRESSED FOR THAT
                     33: C     P.U.
                     34: C
                     35:       IF (QBR) GOTO 45
                     36:       IF(SPBEF.EQ.1) WRITE(OUTUT, 99998)
                     37:       N = JJ
                     38:       IF (N.GT.72) N = 72
                     39:       J(2) = KK
                     40:       IF (N.GE.1) CALL S5UNPK(I, J, N)
                     41:       IF (ITYP.LT.14 .AND. J(2).NE.W) P1ERR = .TRUE.
                     42:       IF (NN) 50, 10, 30
                     43: C
                     44: C     NN=0
                     45: C
                     46:    10 CONTINUE
                     47:       WRITE (OUTUT,99997) (J(L),L=1,N)
                     48:       IF(P2 .OR. OPT(4)) GOTO 40
                     49:       CALL S5UNPK(DSA(NAME+4), J(1), 6)
                     50:       WRITE (OUTUT,99999) NOST, (J(L),L=1,6)
                     51: 99999 FORMAT (16H *** AT STMT NO , I6, 13H IN PGM UNIT , 6A1)
                     52: 99998 FORMAT(1H )
                     53:       GO TO 40
                     54: C
                     55: C     NN>0
                     56: C
                     57:    30 CONTINUE
                     58:       IF (N.GT.68) N = 68
                     59:       CALL S5UNPK(K, J(73), 6)
                     60:       WRITE (OUTUT,99997) (J(L),L=1,N), KK, KK, (J(L),L=73,78)
                     61: 99997 FORMAT (4H ***, 76A1)
                     62:  40   IF(SPAFT.EQ.1) WRITE(OUTUT, 99998)
                     63:  45   RETURN
                     64: C
                     65: C     NN<0
                     66: C
                     67:    50 CONTINUE
                     68:       IF (N.GE.1) WRITE (OUTUT,99997) (J(L),L=1,N)
                     69:       IF( -2.EQ.NN ) GOTO 70
                     70:       IF( -3.EQ.NN ) GOTO 40
                     71:       CALL S5UNPK(DSA(NAME+4), M(1), 6)
                     72: C     WRITE OUT STMT NO AND/OR PGM UNIT
                     73:       IF (K(1).EQ.0) GO TO 60
                     74:       WRITE (OUTUT,99996) K(1), (M(L),L=1,6)
                     75: 99996 FORMAT (16H *** AT STMT NO , I6, 1X, 13H IN PGM UNIT , 6A1)
                     76:       GO TO 40
                     77:    60 WRITE (OUTUT,99995) (M(L),L=1,6)
                     78: 99995 FORMAT (17H *** IN PGM UNIT , 6A1)
                     79:       GO TO 40
                     80: C     WRITE OUT PARAMETER NO FOR PARAMETERLIST ERRORS
                     81:  70   WRITE(OUTUT,99994) K(1)
                     82: 99994 FORMAT(22H *** PARAMETER NUMBER ,I6)
                     83:       GOTO 40
                     84:       END

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.