Return to CALLS.f CVS log

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

researchv10 Norman

      SUBROUTINE CALLS
      INTEGER STMT, PSTMT, EXPR, M(3), OUTUT3, OUTUT4
      LOGICAL ERR, SYSERR, ABORT
      LOGICAL OPT, P1ERR
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
      COMMON /PARAMS/ I1, I2, I6, I4, I5, OUTUT3, OUTUT4
      COMMON /DETECT/ ERR, SYSERR, ABORT
      COMMON /FACTS/ NAME, NOST, ITYP, IASF
      COMMON /OPTNS/ OPT(5), P1ERR
      DATA M(1) /4/, M(2) /2/, M(3) /0/
C
C      CHECK FOR LEGAL SUBROUTINE NAME BEFORE CALLING EXPR
C      TO PROCESS ARGUMENTS
C     IF NO ARGS, CALLS SAVES PASS 2 DATA ITSELF WITHOUT
C     CALLING EXPR
C
      IF (PSTMT.GE.NSTMT) GO TO 10
      CALL NEXTOK(PSTMT, K2, K)
      IF (K.NE.0) GO TO 10
      IF (K2.EQ.NSTMT) GO TO 40
      IF (STMT(K2).EQ.65) GO TO 30
   10 CALL ERROR1(26H MISSING ROUTINE NAME OR (, 26)
   20 RETURN
C
C     BY A CALL TO EXPR
C
   30 I3 = EXPR(K)
      IF (SYSERR) GO TO 20
      IF (PSTMT.NE.NSTMT) CALL ERROR1(18H ILLEGAL CALL STMT, 18)
      GO TO 20
C
C     SAVE SUBROUTINE CALL W/O ARGS
C
   40 K = LOOKUP(K2,.FALSE.)
      IF (SYSERR) GO TO 20
      I3 = IGATT1(K,8)
      IF (I3.NE.13 .AND. I3.NE.0) GO TO 50
      CALL SATT1(K, 8, 6)
      GO TO 60
C
C     MAKE SURE EXTERNAL REFERENCED ID IS NOT USED AS ANYTHING
C     OTHER AS A SUBROUTINE ELSEWHERE IN THIS P-U
C
   50 IF (I3.EQ.6) GO TO 60
      CALL ERROR1(24H ILLEGAL SUBROUTINE NAME, 24)
      GO TO 20
   60 IF (OPT(3) .AND. .NOT.P1ERR) WRITE (OUTUT3) M, K, NOST, M(3)
      GO TO 20
      END

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