Return to POP.f CVS log

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

Annotation of researchv10dc/cmd/pfort/POP.f, revision 1.1

1.1     ! root        1:       SUBROUTINE POP
        !             2:       LOGICAL ERR, SYSERR, ABORT
        !             3:       INTEGER PB, PT, STACK, OP(12), EX(4,4), AO(4,4), RO(3,3)
        !             4:       COMMON /CEXPRS/ LSTACK, STACK(620)
        !             5:       COMMON /EXPRS/ PT, PB, AO, RO, EX
        !             6:       COMMON /DETECT/ ERR, SYSERR, ABORT
        !             7:       DATA OP(1), OP(3), OP(7), OP(9), OP(10), OP(11) /6*2/, OP(4) /1/,
        !             8:      *    OP(5) /0/, OP(6), OP(8), OP(2) /3*-1/, OP(12) /1/
        !             9: C
        !            10: C     JOB OF SUBROUTINE IS TO POP THE STACK;  DOES ALL POPS
        !            11: C     EXCEPT REMOVAL OF "FCN(" CONSTRUCTION
        !            12: C     OP(I) CONTAINS NUM OF ARGS OF OPERATER I  PB CHECKED BEFORE
        !            13: C     CALLING POP; POP CHECKS PT; ERROR RETURNS FROM THIS ROUTINE STOP
        !            14: C     EXPRESSION PROCESSING (I.E. ERR=.TRUE.)
        !            15: C
        !            16:       ERR = .FALSE.
        !            17:       I = STACK(PB+1)
        !            18:       K = OP(I-10)
        !            19:       IF (K) 190, 180, 10
        !            20:    10 L = PT - 1
        !            21:       KQ = K
        !            22:    20 IF (K) 80, 80, 30
        !            23:    30 IF (STACK(L)/8.EQ.1) GO TO 220
        !            24:       IF (STACK(L).GE.8 .OR. STACK(L-1).EQ.0) GO TO 40
        !            25:       J = IGATT1(STACK(L-1),8)
        !            26:       IF (J.EQ.0) CALL SATT1(STACK(L-1), 8, 10)
        !            27:    40 GO TO (60, 50), K
        !            28:    50 K1 = MOD(STACK(L),8) + 1
        !            29:       GO TO 70
        !            30:    60 K2 = MOD(STACK(L),8) + 1
        !            31:    70 L = L - 2
        !            32:       K = K - 1
        !            33:       GO TO 20
        !            34: C
        !            35: C     11 +,- 12 ) 13 ** 14 .NOT. 15 ( 16 FCN( 17 *,/ 18 ,
        !            36: C     19 .AND. 20 .OR. 21 .EQ.  22 UNARY +,-
        !            37: C
        !            38:    80 L = I - 10
        !            39:       GO TO (90, 190, 120, 150, 190, 190, 90, 190, 130, 130, 100, 140),
        !            40:      *    L
        !            41:    90 IF (K1.GT.4 .OR. K2.GT.4) GO TO 210
        !            42:       KK = AO(K1,K2)
        !            43:       GO TO 160
        !            44:   100 IF (K1.GT.3 .OR. K2.GT.3) GO TO 110
        !            45:       KK = RO(K1,K2)
        !            46:       GO TO 160
        !            47:   110 IF ((K1.NE.6 .OR. K2.NE.6) .AND. (K1.NE.6 .OR. K2.NE.3) .AND.
        !            48:      *    (K1.NE.3 .OR. K2.NE.6) ) GO TO 210
        !            49:       KK = 4
        !            50:       GO TO 160
        !            51:   120 IF (K1.GT.4 .OR. K2.GT.4) GO TO 210
        !            52:       KK = EX(K2,K1)
        !            53:       GO TO 160
        !            54:   130 KK = 4
        !            55:       IF (K1.NE.5 .OR. K2.NE.5) GO TO 210
        !            56:       GO TO 160
        !            57:   140 KK = K2 - 1
        !            58:       IF (KK.LT.0 .OR. KK.GT.3) GO TO 210
        !            59:       GO TO 160
        !            60:   150 IF (K2.NE.5) GO TO 210
        !            61:       KK = 4
        !            62:   160 IF (-1.EQ.KK) GO TO 210
        !            63: C
        !            64: C     STORE ON STACK 0 TO SHOW EXPRESSION RESULT(NO DSA INDEX)
        !            65: C     ALSO STORE TYPE OF RESULTING OPERAND
        !            66: C
        !            67:       PT = PT - 2*KQ
        !            68:       STACK(PT) = 0
        !            69:       STACK(PT+1) = KK
        !            70:       PT = PT + 2
        !            71:       PB = PB + 1
        !            72:   170 RETURN
        !            73: C
        !            74: C     POPPING "("
        !            75: C
        !            76:   180 PB = PB + 1
        !            77:       GO TO 170
        !            78:   190 CALL ERROR1(25H ILLEGAL ELEMENT ON STACK, 25)
        !            79:   200 ERR = .TRUE.
        !            80:       RETURN
        !            81:   210 CALL ERROR1(34H ILLEGAL COMBINATION OF DATA TYPES, 34)
        !            82:       GO TO 200
        !            83:   220 CALL ERROR1(21H ILLEGAL USE OF ARRAY, 21)
        !            84:       GO TO 200
        !            85:       END

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