1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
subroutine intops
c
c operations matricielles
c
c Copyright INRIA
include '../stack.h'
integer op
c
integer star,dstar,slash,bslash,dot,colon,quote
integer less,great,equal,et,ou,non
c
data star/47/,dstar/62/,slash/48/
data bslash/49/,dot/51/,colon/44/,quote/53/
data less/59/,great/60/,equal/50/
data ou/57/,et/58/,non/61/
c
op=fin
c
if (ddt .eq. 4) then
write(buf(1:4),'(i4)') fin
call basout(io,wte,' intops op: '//buf(1:4))
endif
c
c operations binaires et ternaires
c --------------------------------
c
fun = 0
c
c cconc extrac insert rconc
goto(75 , 95 , 78 ,76) op
c
c : + - * / \ = '
goto(50,07,08,10,20,25,130,06,06,70) op+1-colon
c
06 if(op.eq.dstar) goto 31
if(op.eq.quote+dot) goto 71
if(op.eq.dstar+dot) goto 30
if(op.ge.3*dot+star) goto 65
if(op.ge.2*dot+star) goto 120
if(op.ge.less+equal) goto 130
if(op.eq.dot+star) goto 51
if(op.eq.dot+slash) goto 52
if(op.eq.dot+bslash) goto 53
if(op.eq.et.or.op.eq.ou) goto 140
if(op.eq.non) goto 150
if(op.ge.less) goto 130
fin=-fin
return
c
c addition
07 continue
call i_a_i
go to 999
c
c substraction
08 if(rhs.eq.1) then
c . unary minus
call i_s_i
else
call i_s_i
endif
go to 999
c
c multiplication
10 continue
call i_m_i
go to 999
c
c division a droite
20 continue
call i_r_i
go to 999
c
c \
25 continue
call i_l_i
go to 999
c
c .^
30 continue
c call i_j_i
fin=-fin
goto 999
c
c ^
31 continue
c call i_p_i
fin=-fin
go to 999
c
c :
50 continue
c call i_b_i
fin=-fin
go to 999
c
c .*
51 continue
call i_x_i
go to 999
c
c ./
52 continue
call i_d_i
go to 999
c
c .\
53 continue
call i_q_i
go to 999
c .*. ./. .\.
c kronecker
65 call i_kron
go to 999
c
c '
70 continue
call i_t
goto 999
c
c .'
71 continue
call i_t
goto 999
c
c concatenation [a b]
75 continue
call i_c_i
goto 999
c
c concatenation [a;b]
76 continue
call i_f_i
goto 999
c
c extraction a(i) and a(i,j)
c
78 continue
if (rhs.eq.2) then
call i_e
elseif (rhs.eq.3) then
call i_e
else
fin=-fin
endif
go to 999
c
c insertion
c
95 continue
if (rhs.eq.3) then
call i_i_i
elseif (rhs.eq.4) then
call i_i_i
else
fin=-fin
endif
goto 999
c
c *. /. \.
120 fin=-fin
goto 999
c
c == <= >= ~=
130 continue
call i_logic(op)
goto 999
c
c & |
140 continue
call bitops(op)
goto 999
c
c ~
150 continue
call unarybit(61)
goto 999
999 return
end
|
