Return to ASSIGN.f CVS log

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

researchv10 Norman

      SUBROUTINE ASSIGN
      INTEGER PSTMT, STMT
      LOGICAL TOKLAB, ERR, SYSERR, ABORT
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
      COMMON /DETECT/ ERR, SYSERR, ABORT
C
C      PROCESSES AN ASSIGN STMT: ASSIGN <LABEL> TO <VAR>
C
      IF (PSTMT.GE.NSTMT) GO TO 10
      IF (.NOT.TOKLAB(1,K2,KK,.FALSE.)) GO TO 80
      IF (SYSERR) GO TO 20
      PSTMT = K2
      IF (PSTMT+2.GE.NSTMT) GO TO 10
      IF (STMT(PSTMT).EQ.49 .AND. STMT(PSTMT+1).EQ.44) GO TO 30
   10 CALL ERROR1(15H ILLEGAL SYNTAX, 15)
   20 RETURN
   30 PSTMT = PSTMT + 2
      IF (PSTMT.GE.NSTMT) GO TO 10
      CALL NEXTOK(PSTMT, K2, K)
      IF (K.NE.0) GO TO 10
      K = LOOKUP(K2,.FALSE.)
      IF (SYSERR) GO TO 20
      I1 = IGATT1(K,1)
      I2 = IGATT1(K,7)
      I3 = IGATT1(K,8)
      IF (I3.EQ.0) GO TO 40
      IF (I3.NE.8) GO TO 90
      GO TO 50
   40 CALL SATT1(K, 8, 8)
   50 IF (I1.NE.0) GO TO 60
      I1 = 1
      IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2
      CALL SATT1(K, 1, I1)
   60 IF (MOD(I1,8).EQ.2 .AND. I2.EQ.0) GO TO 70
      CALL ERROR1(35H ASSIGN VARIABLE NOT INTEGER SCALAR, 35)
      GO TO 20
   70 IF (K2.NE.NSTMT) GO TO 10
      GO TO 20
   80 CALL ERROR1(14H MISSING LABEL, 14)
      GO TO 20
   90 CALL ERROR1(23H ILLEGAL VARIABLE USAGE, 23)
      GO TO 20
      END

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