usub/usersub.c

   1 /* $RCSfile: usersub.c,v $$Revision: 4.1 $$Date: 92/08/07 18:28:59 $
   2  *
   3  * $Log:        usersub.c,v $
   4  * Revision 4.1  92/08/07  18:28:59  lwall
   5  *
   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
   8  *
   9  * Revision 4.0  91/03/20  01:56:34  lwall
  10  * 4.0 baseline.
  11  *
  12  * Revision 3.0.1.1  90/08/09  04:06:10  lwall
  13  * patch19: Initial revision
  14  *
  15  */
  16
  17 #include "EXTERN.h"
  18 #include "perl.h"
  19
  20 int
  21 userinit()
  22 {
  23     init_curses();
  24 }
  25
  26 /* Be sure to refetch the stack pointer after calling these routines. */
  27
  28 int
  29 callback(subname, sp, gimme, hasargs, numargs)
  30 char *subname;
  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 */
  35 {
  36     static ARG myarg[3];        /* fake syntax tree node */
  37     int arglast[3];
  38
  39     arglast[2] = sp;
  40     sp -= numargs;
  41     arglast[1] = sp--;
  42     arglast[0] = sp;
  43
  44     if (!myarg[0].arg_ptr.arg_str)
  45         myarg[0].arg_ptr.arg_str = str_make("",0);
  46
  47     myarg[1].arg_type = A_WORD;
  48     myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE);
  49
  50     myarg[2].arg_type = hasargs ? A_EXPR : A_NULL;
  51
  52     return do_subr(myarg, gimme, arglast);
  53 }
  54
  55 int
  56 callv(subname, sp, gimme, argv)
  57 char *subname;
  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 */
  61 {
  62     register int items = 0;
  63     int hasargs = (argv != 0);
  64
  65     astore(stack, ++sp, Nullstr);       /* reserve spot for 1st return arg */
  66     if (hasargs) {
  67         while (*argv) {
  68             astore(stack, ++sp, str_2mortal(str_make(*argv,0)));
  69             items++;
  70             argv++;
  71         }
  72     }
  73     return callback(subname, sp, gimme, hasargs, items);
  74 }