076fe9664ed37cee0a81258b99d49d0f204d8037
[perl.git] / do / subr
1 int
2 do_subr(arg,gimme,arglast)
3 register ARG *arg;
4 int gimme;
5 int *arglast;
6 {
7     register STR **st = stack->ary_array;
8     register int sp = arglast[1];
9     register int items = arglast[2] - sp;
10     register SUBR *sub;
11     SPAT * VOL oldspat = curspat;
12     STR *TARG;
13     STAB *stab;
14     int oldsave = savestack->ary_fill;
15     int oldtmps_base = tmps_base;
16     int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
17     register CSV *csv;
18
19     if ((arg[1].arg_type & A_MASK) == A_WORD)
20         stab = arg[1].arg_ptr.arg_stab;
21     else {
22         STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
23
24         if (tmpstr)
25             stab = stabent(str_get(tmpstr),TRUE);
26         else
27             stab = Nullstab;
28     }
29     if (!stab)
30         fatal("Undefined subroutine called");
31     if (!(sub = stab_sub(stab))) {
32         STR *tmpstr = arg[0].arg_ptr.arg_str;
33
34         stab_efullname(tmpstr, stab);
35         fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
36     }
37     if (arg->arg_type == O_DBSUBR && !sub->usersub) {
38         TARG = stab_val(DBsub);
39         saveitem(TARG);
40         stab_efullname(TARG,stab);
41         sub = stab_sub(DBsub);
42         if (!sub)
43             fatal("No DBsub routine");
44     }
45     TARG = Str_new(15, sizeof(CSV));
46     TARG->str_state = SS_SCSV;
47     (void)apush(savestack,TARG);
48     csv = (CSV*)TARG->str_ptr;
49     csv->sub = sub;
50     csv->stab = stab;
51     csv->oldcsv = curcsv;
52     csv->oldcmd = curcmd;
53     csv->depth = sub->depth;
54     csv->wantarray = gimme;
55     csv->hasargs = hasargs;
56     curcsv = csv;
57     tmps_base = tmps_max;
58     if (sub->usersub) {
59         csv->hasargs = 0;
60         csv->savearray = Null(ARRAY*);;
61         csv->argarray = Null(ARRAY*);
62         st[sp] = ARGTARG;
63         if (!hasargs)
64             items = 0;
65         sp = (*sub->usersub)(sub->userindex,sp,items);
66     }
67     else {
68         if (hasargs) {
69             csv->savearray = stab_xarray(defstab);
70             csv->argarray = afake(defstab, items, &st[sp+1]);
71             stab_xarray(defstab) = csv->argarray;
72         }
73         sub->depth++;
74         if (sub->depth >= 2) {  /* save temporaries on recursion? */
75             if (sub->depth == 100 && dowarn)
76                 warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
77             savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
78         }
79         sp = cmd_exec(sub->cmd,gimme, --sp);    /* so do it already */
80     }
81
82     st = stack->ary_array;
83     tmps_base = oldtmps_base;
84     for (items = arglast[0] + 1; items <= sp; items++)
85         st[items] = str_mortal(st[items]);
86             /* in case restore wipes old TARG */
87     restorelist(oldsave);
88     curspat = oldspat;
89     return sp;
90 }
91