![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to POP.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / pfort|
Return to POP.f CVS log | Up to [Research Unix] / researchv10no / cmd / pfort |
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.