diff options
Diffstat (limited to 'gnu/usr.bin/perl/usub/usersub.c')
-rw-r--r-- | gnu/usr.bin/perl/usub/usersub.c | 77 |
1 files changed, 0 insertions, 77 deletions
diff --git a/gnu/usr.bin/perl/usub/usersub.c b/gnu/usr.bin/perl/usub/usersub.c deleted file mode 100644 index 26fbcbc..0000000 --- a/gnu/usr.bin/perl/usub/usersub.c +++ /dev/null @@ -1,77 +0,0 @@ -/* $RCSfile: usersub.c,v $$Revision: 1.1 $$Date: 1995/03/24 04:33:54 $ - * - * $Log: usersub.c,v $ - * Revision 1.1 1995/03/24 04:33:54 jkh - * Bring back perl/usub as usub/, this time containing an updated curseperl - * which is also installed by default (the reason for which should also be - * plain shortly). - * - * Revision 4.0.1.1 91/11/05 19:07:24 lwall - * patch11: there are now subroutines for calling back from C into Perl - * - * Revision 4.0 91/03/20 01:56:34 lwall - * 4.0 baseline. - * - * Revision 3.0.1.1 90/08/09 04:06:10 lwall - * patch19: Initial revision - * - */ - -#include "EXTERN.h" -#include "perl.h" - -int -userinit() -{ - init_curses(); -} - -/* Be sure to refetch the stack pointer after calling these routines. */ - -int -callback(subname, sp, gimme, hasargs, numargs) -char *subname; -int sp; /* stack pointer after args are pushed */ -int gimme; /* called in array or scalar context */ -int hasargs; /* whether to create a @_ array for routine */ -int numargs; /* how many args are pushed on the stack */ -{ - static ARG myarg[3]; /* fake syntax tree node */ - int arglast[3]; - - arglast[2] = sp; - sp -= numargs; - arglast[1] = sp--; - arglast[0] = sp; - - if (!myarg[0].arg_ptr.arg_str) - myarg[0].arg_ptr.arg_str = str_make("",0); - - myarg[1].arg_type = A_WORD; - myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE); - - myarg[2].arg_type = hasargs ? A_EXPR : A_NULL; - - return do_subr(myarg, gimme, arglast); -} - -int -callv(subname, sp, gimme, argv) -char *subname; -register int sp; /* current stack pointer */ -int gimme; /* called in array or scalar context */ -register char **argv; /* null terminated arg list, NULL for no arglist */ -{ - register int items = 0; - int hasargs = (argv != 0); - - astore(stack, ++sp, Nullstr); /* reserve spot for 1st return arg */ - if (hasargs) { - while (*argv) { - astore(stack, ++sp, str_2mortal(str_make(*argv,0))); - items++; - argv++; - } - } - return callback(subname, sp, gimme, hasargs, items); -} |