Return to TOKRL.f CVS log

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

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

1.1       root        1:       LOGICAL FUNCTION TOKRL(K1, K2, CODE)
                      2:       INTEGER STMT, CODE, PSTMT
                      3:       LOGICAL TOKLOP
                      4:       COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
                      5: C
                      6: C     ROUTINE RETURNS TRUE IF FINDS A REAL CONSTANT IN
                      7: C     STMT(K1)-STMT(K2-1) . ELSE IT RETURNS FALSE.
                      8: C     BASIC CONSTRUCT IS: <INT> . <INT>
                      9: C     <INT> .
                     10: C     . <INT>
                     11: C     EACH OF THESE MAY BE FOLLOWED BY <D,E> <+,-> <INT>
                     12: C     ALSO LEGAL IS IN-CONST FOLLOWED BY EXPONENT CONSTRUCT
                     13: C
                     14:       TOKRL = .FALSE.
                     15:       CALL NEXTOK(K1, K2, K)
                     16:       IF (K.EQ.3 .AND. STMT(K1).EQ.64) GO TO 10
                     17:       IF (K.EQ.1 .AND. STMT(K2).EQ.64) GO TO 40
                     18: C     IF HAVE INT-CONST NEED EXPONENT FOR THIS TO BE A REAL-CONST
                     19:       IF (K-1) 80, 50, 80
                     20: C
                     21: C     FIND BASIC REAL CONSTANT
                     22: C
                     23: C     (. INT-CONST) CONSTRUCT
                     24:    10 CALL NEXTOK(K2, K3, K)
                     25:       IF (K.NE.1) GO TO 80
                     26:    20 K2 = K3
                     27:    30 TOKRL = .TRUE.
                     28:       CODE = 1
                     29:       GO TO 50
                     30: C     (INT-CONST .) CONSTRUCT; CHECK FOR (INT . INT )
                     31:    40 K2 = K2 + 1
                     32:       CALL NEXTOK(K2, K3, K)
                     33:       IF (K.EQ.1) GO TO 20
                     34:       IF (TOKLOP(K2-1,K4,K)) GO TO 80
                     35:       GO TO 30
                     36: C
                     37: C     CHECK FOR EXPONENT
                     38: C
                     39:    50 IF (STMT(K2).NE.33) GO TO 60
                     40:       CODE = 0
                     41:       GO TO 70
                     42:    60 IF (STMT(K2).NE.34) GO TO 80
                     43:       CODE = 1
                     44:    70 K3 = K2 + 1
                     45:       IF (K3.EQ.NSTMT) GO TO 80
                     46:       IF ((STMT(K3).EQ.60) .OR. (STMT(K3).EQ.61)) K3 = K3 + 1
                     47:       CALL NEXTOK(K3, K4, K)
                     48:       IF (K.NE.1) GO TO 80
                     49:       K2 = K4
                     50:       TOKRL = .TRUE.
                     51:    80 RETURN
                     52:       END

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