Return to POP.f CVS log

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

researchv10 Norman

      SUBROUTINE POP
      LOGICAL ERR, SYSERR, ABORT
      INTEGER PB, PT, STACK, OP(12), EX(4,4), AO(4,4), RO(3,3)
      COMMON /CEXPRS/ LSTACK, STACK(620)
      COMMON /EXPRS/ PT, PB, AO, RO, EX
      COMMON /DETECT/ ERR, SYSERR, ABORT
      DATA OP(1), OP(3), OP(7), OP(9), OP(10), OP(11) /6*2/, OP(4) /1/,
     *    OP(5) /0/, OP(6), OP(8), OP(2) /3*-1/, OP(12) /1/
C
C     JOB OF SUBROUTINE IS TO POP THE STACK;  DOES ALL POPS
C     EXCEPT REMOVAL OF "FCN(" CONSTRUCTION
C     OP(I) CONTAINS NUM OF ARGS OF OPERATER I  PB CHECKED BEFORE
C     CALLING POP; POP CHECKS PT; ERROR RETURNS FROM THIS ROUTINE STOP
C     EXPRESSION PROCESSING (I.E. ERR=.TRUE.)
C
      ERR = .FALSE.
      I = STACK(PB+1)
      K = OP(I-10)
      IF (K) 190, 180, 10
   10 L = PT - 1
      KQ = K
   20 IF (K) 80, 80, 30
   30 IF (STACK(L)/8.EQ.1) GO TO 220
      IF (STACK(L).GE.8 .OR. STACK(L-1).EQ.0) GO TO 40
      J = IGATT1(STACK(L-1),8)
      IF (J.EQ.0) CALL SATT1(STACK(L-1), 8, 10)
   40 GO TO (60, 50), K
   50 K1 = MOD(STACK(L),8) + 1
      GO TO 70
   60 K2 = MOD(STACK(L),8) + 1
   70 L = L - 2
      K = K - 1
      GO TO 20
C
C     11 +,- 12 ) 13 ** 14 .NOT. 15 ( 16 FCN( 17 *,/ 18 ,
C     19 .AND. 20 .OR. 21 .EQ.  22 UNARY +,-
C
   80 L = I - 10
      GO TO (90, 190, 120, 150, 190, 190, 90, 190, 130, 130, 100, 140),
     *    L
   90 IF (K1.GT.4 .OR. K2.GT.4) GO TO 210
      KK = AO(K1,K2)
      GO TO 160
  100 IF (K1.GT.3 .OR. K2.GT.3) GO TO 110
      KK = RO(K1,K2)
      GO TO 160
  110 IF ((K1.NE.6 .OR. K2.NE.6) .AND. (K1.NE.6 .OR. K2.NE.3) .AND.
     *    (K1.NE.3 .OR. K2.NE.6) ) GO TO 210
      KK = 4
      GO TO 160
  120 IF (K1.GT.4 .OR. K2.GT.4) GO TO 210
      KK = EX(K2,K1)
      GO TO 160
  130 KK = 4
      IF (K1.NE.5 .OR. K2.NE.5) GO TO 210
      GO TO 160
  140 KK = K2 - 1
      IF (KK.LT.0 .OR. KK.GT.3) GO TO 210
      GO TO 160
  150 IF (K2.NE.5) GO TO 210
      KK = 4
  160 IF (-1.EQ.KK) GO TO 210
C
C     STORE ON STACK 0 TO SHOW EXPRESSION RESULT(NO DSA INDEX)
C     ALSO STORE TYPE OF RESULTING OPERAND
C
      PT = PT - 2*KQ
      STACK(PT) = 0
      STACK(PT+1) = KK
      PT = PT + 2
      PB = PB + 1
  170 RETURN
C
C     POPPING "("
C
  180 PB = PB + 1
      GO TO 170
  190 CALL ERROR1(25H ILLEGAL ELEMENT ON STACK, 25)
  200 ERR = .TRUE.
      RETURN
  210 CALL ERROR1(34H ILLEGAL COMBINATION OF DATA TYPES, 34)
      GO TO 200
  220 CALL ERROR1(21H ILLEGAL USE OF ARRAY, 21)
      GO TO 200
      END

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