Return to CALLS.f CVS log

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

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

1.1       root        1:       SUBROUTINE CALLS
                      2:       INTEGER STMT, PSTMT, EXPR, M(3), OUTUT3, OUTUT4
                      3:       LOGICAL ERR, SYSERR, ABORT
                      4:       LOGICAL OPT, P1ERR
                      5:       COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
                      6:       COMMON /PARAMS/ I1, I2, I6, I4, I5, OUTUT3, OUTUT4
                      7:       COMMON /DETECT/ ERR, SYSERR, ABORT
                      8:       COMMON /FACTS/ NAME, NOST, ITYP, IASF
                      9:       COMMON /OPTNS/ OPT(5), P1ERR
                     10:       DATA M(1) /4/, M(2) /2/, M(3) /0/
                     11: C
                     12: C      CHECK FOR LEGAL SUBROUTINE NAME BEFORE CALLING EXPR
                     13: C      TO PROCESS ARGUMENTS
                     14: C     IF NO ARGS, CALLS SAVES PASS 2 DATA ITSELF WITHOUT
                     15: C     CALLING EXPR
                     16: C
                     17:       IF (PSTMT.GE.NSTMT) GO TO 10
                     18:       CALL NEXTOK(PSTMT, K2, K)
                     19:       IF (K.NE.0) GO TO 10
                     20:       IF (K2.EQ.NSTMT) GO TO 40
                     21:       IF (STMT(K2).EQ.65) GO TO 30
                     22:    10 CALL ERROR1(26H MISSING ROUTINE NAME OR (, 26)
                     23:    20 RETURN
                     24: C
                     25: C     BY A CALL TO EXPR
                     26: C
                     27:    30 I3 = EXPR(K)
                     28:       IF (SYSERR) GO TO 20
                     29:       IF (PSTMT.NE.NSTMT) CALL ERROR1(18H ILLEGAL CALL STMT, 18)
                     30:       GO TO 20
                     31: C
                     32: C     SAVE SUBROUTINE CALL W/O ARGS
                     33: C
                     34:    40 K = LOOKUP(K2,.FALSE.)
                     35:       IF (SYSERR) GO TO 20
                     36:       I3 = IGATT1(K,8)
                     37:       IF (I3.NE.13 .AND. I3.NE.0) GO TO 50
                     38:       CALL SATT1(K, 8, 6)
                     39:       GO TO 60
                     40: C
                     41: C     MAKE SURE EXTERNAL REFERENCED ID IS NOT USED AS ANYTHING
                     42: C     OTHER AS A SUBROUTINE ELSEWHERE IN THIS P-U
                     43: C
                     44:    50 IF (I3.EQ.6) GO TO 60
                     45:       CALL ERROR1(24H ILLEGAL SUBROUTINE NAME, 24)
                     46:       GO TO 20
                     47:    60 IF (OPT(3) .AND. .NOT.P1ERR) WRITE (OUTUT3) M, K, NOST, M(3)
                     48:       GO TO 20
                     49:       END

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