1 /* $RCSfile: usersub.c,v $$Revision: 4.1 $$Date: 92/08/07 18:28:59 $
4 * Revision 4.1 92/08/07 18:28:59 lwall
6 * Revision 4.0.1.1 91/11/05 19:07:24 lwall
7 * patch11: there are now subroutines for calling back from C into Perl
9 * Revision 4.0 91/03/20 01:56:34 lwall
12 * Revision 3.0.1.1 90/08/09 04:06:10 lwall
13 * patch19: Initial revision
26 /* Be sure to refetch the stack pointer after calling these routines. */
29 callback(subname, sp, gimme, hasargs, numargs)
31 int sp; /* stack pointer after args are pushed */
32 int gimme; /* called in array or scalar context */
33 int hasargs; /* whether to create a @_ array for routine */
34 int numargs; /* how many args are pushed on the stack */
36 static ARG myarg[3]; /* fake syntax tree node */
44 if (!myarg[0].arg_ptr.arg_str)
45 myarg[0].arg_ptr.arg_str = str_make("",0);
47 myarg[1].arg_type = A_WORD;
48 myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE);
50 myarg[2].arg_type = hasargs ? A_EXPR : A_NULL;
52 return do_subr(myarg, gimme, arglast);
56 callv(subname, sp, gimme, argv)
58 register int sp; /* current stack pointer */
59 int gimme; /* called in array or scalar context */
60 register char **argv; /* null terminated arg list, NULL for no arglist */
62 register int items = 0;
63 int hasargs = (argv != 0);
65 astore(stack, ++sp, Nullstr); /* reserve spot for 1st return arg */
68 astore(stack, ++sp, str_2mortal(str_make(*argv,0)));
73 return callback(subname, sp, gimme, hasargs, items);