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
|
subroutine funs(id)
c ====================================================================
c scan function and macros list
c ====================================================================
include '../stack.h'
integer id(nsiz),id1(nsiz),istr(nlgh)
c
logical eqid,loaded
integer srhs,percen,blank,fptr,mode(2)
integer iadr
data nclas/29/,percen/56/,blank/40/
c
iadr(l)=l+l-1
c
c recherche dans les bibliotheques seulement
if(fin.eq.-3) goto 35
if(fin.eq.-4) goto 30
c
c
c recherche parmi les fonctions fortran
call funtab(id,fptr,1)
if(fptr.le.0) then
if(comp(1).eq.0) goto 30
fin=0
fun=0
else
fun = fptr/100
fin = mod(fptr,100)
endif
return
c
c est-ce une macro existant dans la pile?
30 k=bot-1
31 k=k+1
if(k.gt.isiz) goto 35
if(.not.eqid(idstk(1,k),id)) goto 31
il=iadr(lstk(k))
if(istk(il).ne.11.and.istk(il).ne.13) goto 35
fin=k
fun=-1
return
c
c recherche dans les bibliotheques de macro
35 k=bot-1
36 k=k+1
if(k.gt.isiz) then
fin=0
fun=0
return
endif
il=iadr(lstk(k))
if(istk(il).ne.14) goto 36
nbibn=istk(il+1)
lbibn=il+2
il=lbibn+nbibn
ilp=il+1
call namstr(id,istr,nn,1)
ip=abs(istr(1))
if(ip.eq.percen) ip=abs(istr(2))
ip=ip-9
if(ip.gt.nclas) goto 36
n=istk(ilp+ip)-istk(ilp+ip-1)
if(n.eq.0) goto 36
iln=ilp+nclas+1+(istk(ilp+ip-1)-1)*nsiz
do 37 l=1,n
if(eqid(id,istk(iln))) goto 39
iln=iln+nsiz
37 continue
goto 36
c
c
39 if(fin.ne.-1.and.fin.ne.-3) goto 40
fun=k
fin=l
return
c
40 fun=-2
fin=l
c
c chargement
n=nbibn
call cvstr(n,istk(lbibn),buf,1)
call cvname(id,buf(n+1:n+nlgh),1)
n=n+nlgh+1
41 n=n-1
if(buf(n:n).eq.' ') goto 41
buf(n+1:n+4)='.bin'
n=n+4
lunit=0
mode(1)=-101
mode(2)= 0
call clunit(lunit,buf(1:n),mode)
if(err.gt.0) then
buf(n+1:)=' '
call error(241)
return
endif
c
loaded=.false.
49 top=top+1
job=lstk(bot)-lstk(top)
c on recupere toutes les variables du fichier
id1(1)=blank
call savlod(lunit,id1,job,top)
if(err.gt.0) goto 51
il=iadr(lstk(top))
if(istk(il).eq.0) goto 50
srhs=rhs
rhs=0
call stackp(id1,1)
if(err.gt.0) goto 51
if(eqid(id,id1)) loaded=.true.
rhs=srhs
goto 49
50 if(.not.loaded) then
fun=0
fin=0
endif
top=top-1
51 call clunit(-lunit,buf,mode)
return
c
end
|
