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
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
|
subroutine followpath(indtop,listtop,ilindi,voli,ilp,voll,ind,
$ count,info,lwork)
c Copyright INRIA
c =============================================================
c given
c - a path stored in a "linear" index list ind stored in the
c variable number indtop
c and
c - a list L begining at position stored in the
c variable number listtop
c - a current pointer on index list entries count
c returns:
c - the pointer ilp on the deapest sublist of L on the path indtop
c available just by following the list structure of L.
c i.e. ilp is the pointer on the sublist of L pointed to by
c the path indtop(1:count)
c - the vector of numerical indexes corresponding to indtop(1:count)
c - voll (in stk worlds) of the designed sublist,
c and the size (in stk worlds) voli of the designed subindex
c
c lw is a pointer on the beginning of the free area in stk
c info
c 1 : unknown named field
c 2 : current index is a matrix index of an mlist
c 3 : current index is not a single number
c 4 : current index points to a leaf of the L list
c 5 : end of index list reached
c 6 : current index is 0 or greater than current sublist # of fields
c =============================================================
c
c Copyright INRIA
include '../stack.h'
c
integer indtop,listtop,ind(*)
integer typi,count,oldcount,voll,voli
integer strpos
external strpos
integer iadr,sadr
c
iadr(l)=l+l-1
sadr(l)=(l/2)+1
c
oldcount=count
c
ilind=iadr(lstk(indtop))
if(istk(ilind).lt.0) then
itop=istk(ilind+2)
voli=istk(ilind+3)
ilind=iadr(istk(ilind+1))
else
itop=indtop
voli=lstk(itop+1)-lstk(itop)
endif
c
illist=iadr(lstk(listtop))
c if(istk(illist).lt.0) illist=iadr(istk(illist+1))
c
if(istk(ilind).ne.15) then
c . special case if ind is not a list
nlist=1
count=1
ilindi=ilind
ilindir=ilindi
c voli=lstk(itop+1)-lstk(itop)
illistir=illist
if(istk(illist).lt.0) illist=iadr(istk(illist+1))
illisti=illist
goto 12
endif
nlist=istk(ilind+1)
ll=sadr(ilind+3+nlist)
illistir=illist
illisti=illistir
if(istk(illisti).lt.0) illisti=iadr(istk(illisti+1))
c
10 continue
c next index
count=count+1
c move pointer to next entry in index list
ilindi=iadr(ll+istk(ilind+1+count)-1)
voli=istk(ilind+2+count)-istk(ilind+1+count)
ilindir=ilindi
if(istk(ilindi).lt.0) ilindi=iadr(istk(ilindi+1))
c extract infos out of the current sublist
12 typi=istk(illisti)
mi=istk(illisti+1)
llisti=sadr(illisti+mi+3)
voll=istk(illisti+mi+2)-1+sadr(3+mi)
c go ahead along the path
c
if(istk(ilindi).eq.10) then
c . current element index is a name
if(istk(ilindi+1)*istk(ilindi+2).ne.1) then
info=3
goto 50
c call error(21)
c return
endif
ilname=ilindi+6
nname=istk(ilindi+5)-istk(ilindi+4)
c . check if it is an explicit field name
if (typi.ne.16.and.typi.ne.17) then
c . list with no explicit fields names
info=1
goto 50
else
c . first field may contain the fields names
ilfn=iadr(llisti)
nn=istk(ilfn+1)*istk(ilfn+2)
ilptr=ilfn+5
lfn=ilptr+nn
c . look for corresponding index if any
n=strpos(istk(ilptr),nn-1,istk(lfn),istk(ilname),nname)
if(n.le.0) then
c . no such name in the field names
info=1
goto 50
endif
n=n+1
endif
elseif(istk(ilindi).eq.15) then
c . current index is a multi dimensional matrix index
info=2
goto 50
else
c . current index is a standard index
if(typi.eq.17.or.(typi.ne.15.and.typi.ne.16)) then
c . matrix index
c . can be improved for some special mlist types for which
c . matrix entry addressing is predefined
info=2
goto 50
endif
lw=lwork
call indxg(ilindi,mi,ili,nl,mx,lw,10)
if(err.gt.0) return
if(nl.ne.1) then
c . index is a vector or []
info=3
goto 50
endif
n=istk(ili)
if(n.lt.0) then
call error(21)
return
endif
endif
c n is the numerical index of the sublist
if(n.eq.0.or.n.gt.mi) then
if (typi.eq.15.and.count.lt.nlist) then
c . current index is out of definable list indices and is not the
C . last of the index list
call error(21)
return
endif
ind(count)=n
info=6
goto 50
endif
c move pointer to indexed sub-list of L
lti=sadr(illisti+3+mi)+istk(illisti+1+n)-1
voll=istk(illisti+2+n)-istk(illisti+n+1)
illisti=iadr(lti)
illistir=illisti
c if(voll.eq.0) then
c . undefined field found
c info=7
c goto 50
c
c endif
if(istk(illisti).lt.0) then
kk=istk(illisti+2)
c voll=lstk(kk+1)-lstk(kk)
illisti=iadr(istk(illisti+1))
endif
c
ind(count)=n
if(count+1.gt.nlist) then
c . end of index list reached
info=5
goto 50
endif
if(istk(illisti).ge.15.and.istk(illisti).le.17) goto 10
c a leaf of L has been found
c move pointer to next entry in index list
count=count+1
ilindi=iadr(ll+istk(ilind+1+count)-1)
voli=istk(ilind+2+count)-istk(ilind+1+count)
ilindir=ilindi
if(istk(ilindi).lt.0) ilindi=iadr(istk(ilindi+1))
typi=istk(illisti)
info=4
goto 50
50 continue
c end
ilp=illistir
ilindi=ilindir
return
end
|
