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
|
int
do_subr(arg,gimme,arglast)
register ARG *arg;
int gimme;
int *arglast;
{
register STR **st = stack->ary_array;
register int sp = arglast[1];
register int items = arglast[2] - sp;
register SUBR *sub;
SPAT * VOL oldspat = curspat;
STR *TARG;
STAB *stab;
int oldsave = savestack->ary_fill;
int oldtmps_base = tmps_base;
int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
register CSV *csv;
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else {
STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
if (tmpstr)
stab = stabent(str_get(tmpstr),TRUE);
else
stab = Nullstab;
}
if (!stab)
fatal("Undefined subroutine called");
if (!(sub = stab_sub(stab))) {
STR *tmpstr = arg[0].arg_ptr.arg_str;
stab_efullname(tmpstr, stab);
fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
}
if (arg->arg_type == O_DBSUBR && !sub->usersub) {
TARG = stab_val(DBsub);
saveitem(TARG);
stab_efullname(TARG,stab);
sub = stab_sub(DBsub);
if (!sub)
fatal("No DBsub routine");
}
TARG = Str_new(15, sizeof(CSV));
TARG->str_state = SS_SCSV;
(void)apush(savestack,TARG);
csv = (CSV*)TARG->str_ptr;
csv->sub = sub;
csv->stab = stab;
csv->oldcsv = curcsv;
csv->oldcmd = curcmd;
csv->depth = sub->depth;
csv->wantarray = gimme;
csv->hasargs = hasargs;
curcsv = csv;
tmps_base = tmps_max;
if (sub->usersub) {
csv->hasargs = 0;
csv->savearray = Null(ARRAY*);;
csv->argarray = Null(ARRAY*);
st[sp] = ARGTARG;
if (!hasargs)
items = 0;
sp = (*sub->usersub)(sub->userindex,sp,items);
}
else {
if (hasargs) {
csv->savearray = stab_xarray(defstab);
csv->argarray = afake(defstab, items, &st[sp+1]);
stab_xarray(defstab) = csv->argarray;
}
sub->depth++;
if (sub->depth >= 2) { /* save temporaries on recursion? */
if (sub->depth == 100 && dowarn)
warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
}
sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
}
st = stack->ary_array;
tmps_base = oldtmps_base;
for (items = arglast[0] + 1; items <= sp; items++)
st[items] = str_mortal(st[items]);
/* in case restore wipes old TARG */
restorelist(oldsave);
curspat = oldspat;
return sp;
}
|