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
|
/*
* invoke.r -- Perform setup for invocation.
*/
/*
* invoke -- Perform setup for invocation.
*/
int invoke(nargs,cargp,n)
dptr *cargp;
int nargs, *n;
{
register struct pf_marker *newpfp;
register dptr newargp;
register word *newsp = sp;
tended struct descrip arg_sv;
register word i;
struct b_proc *proc;
int nparam;
/*
* Point newargp at Arg0 and dereference it.
*/
newargp = (dptr )(sp - 1) - nargs;
xnargs = nargs;
xargp = newargp;
Deref(newargp[0]);
/*
* See what course the invocation is to take.
*/
if (newargp->dword != D_Proc) {
C_integer tmp;
/*
* Arg0 is not a procedure.
*/
if (cnv:C_integer(newargp[0], tmp)) {
MakeInt(tmp,&newargp[0]);
/*
* Arg0 is an integer, select result.
*/
i = cvpos(IntVal(newargp[0]), (word)nargs);
if (i == CvtFail || i > nargs)
return I_Fail;
newargp[0] = newargp[i];
sp = (word *)newargp + 1;
return I_Continue;
}
else {
struct b_proc *tmp;
/*
* See if Arg0 can be converted to a string that names a procedure
* or operator. If not, generate run-time error 106.
*/
if (!cnv:tmp_string(newargp[0],newargp[0]) ||
((tmp = strprc(newargp, (C_integer)nargs)) == NULL)) {
err_msg(106, newargp);
return I_Fail;
}
BlkLoc(newargp[0]) = (union block *)tmp;
newargp[0].dword = D_Proc;
}
}
/*
* newargp[0] is now a descriptor suitable for invocation. Dereference
* the supplied arguments.
*/
proc = (struct b_proc *)BlkLoc(newargp[0]);
if (proc->nstatic >= 0) /* if negative, don't reference arguments */
for (i = 1; i <= nargs; i++)
Deref(newargp[i]);
/*
* Adjust the argument list to conform to what the routine being invoked
* expects (proc->nparam). If nparam is less than 0, the number of
* arguments is variable. For functions (ndynam = -1) with a
* variable number of arguments, nothing need be done. For Icon procedures
* with a variable number of arguments, arguments beyond abs(nparam) are
* put in a list which becomes the last argument. For fix argument
* routines, if too many arguments were supplied, adjusting the stack
* pointer is all that is necessary. If too few arguments were supplied,
* null descriptors are pushed for each missing argument.
*/
proc = (struct b_proc *)BlkLoc(newargp[0]);
nparam = (int)proc->nparam;
if (nparam >= 0) {
if (nargs > nparam)
newsp -= (nargs - nparam) * 2;
else if (nargs < nparam) {
i = nparam - nargs;
while (i--) {
*++newsp = D_Null;
*++newsp = 0;
}
}
nargs = nparam;
xnargs = nargs;
}
else {
if (proc->ndynam >= 0) { /* this is a procedure */
int lelems;
dptr llargp;
if (nargs < abs(nparam) - 1) {
i = abs(nparam) - 1 - nargs;
while (i--) {
*++newsp = D_Null;
*++newsp = 0;
}
nargs = abs(nparam) - 1;
}
lelems = nargs - (abs(nparam) - 1);
llargp = &newargp[abs(nparam)];
arg_sv = llargp[-1];
Ollist(lelems, &llargp[-1]);
llargp[0] = llargp[-1];
llargp[-1] = arg_sv;
/*
* Reload proc pointer in case Ollist triggered a garbage collection.
*/
proc = (struct b_proc *)BlkLoc(newargp[0]);
newsp = (word *)llargp + 1;
nargs = abs(nparam);
}
}
if (proc->ndynam < 0) {
/*
* A function is being invoked, so nothing else here needs to be done.
*/
if (nargs < abs(nparam) - 1) {
i = abs(nparam) - 1 - nargs;
while (i--) {
*++newsp = D_Null;
*++newsp = 0;
}
nargs = abs(nparam) - 1;
}
*n = nargs;
*cargp = newargp;
sp = newsp;
if ((nparam < 0) || (proc->ndynam == -2))
return I_Vararg;
else
return I_Builtin;
}
/*
* Make a stab at catching interpreter stack overflow. This does
* nothing for invocation in a co-expression other than &main.
*/
if (BlkLoc(k_current) == BlkLoc(k_main) &&
((char *)sp + PerilDelta) > (char *)stackend)
fatalerr(301, NULL);
/*
* Build the procedure frame.
*/
newpfp = (struct pf_marker *)(newsp + 1);
newpfp->pf_nargs = nargs;
newpfp->pf_argp = glbl_argp;
newpfp->pf_pfp = pfp;
newpfp->pf_ilevel = ilevel;
newpfp->pf_scan = NULL;
newpfp->pf_ipc = ipc;
newpfp->pf_gfp = gfp;
newpfp->pf_efp = efp;
glbl_argp = newargp;
pfp = newpfp;
newsp += Vwsizeof(*pfp);
/*
* If tracing is on, use ctrace to generate a message.
*/
if (k_trace) {
k_trace--;
ctrace(&(proc->pname), nargs, &newargp[1]);
}
/*
* Point ipc at the icode entry point of the procedure being invoked.
*/
ipc.opnd = (word *)proc->entryp.icode;
efp = 0;
gfp = 0;
/*
* Push a null descriptor on the stack for each dynamic local.
*/
for (i = proc->ndynam; i > 0; i--) {
*++newsp = D_Null;
*++newsp = 0;
}
sp = newsp;
k_level++;
return I_Continue;
}
|
