usub/usersub.c

   1 /* $RCSfile: usersub.c,v $$Revision: 4.0.1.1 $$Date: 91/11/05 19:07:24 $
   2  *
   3  * $Log:        usersub.c,v $
   4  * Revision 4.0.1.1  91/11/05  19:07:24  lwall
   5  * patch11: there are now subroutines for calling back from C into Perl
   6  *
   7  * Revision 4.0  91/03/20  01:56:34  lwall
   8  * 4.0 baseline.
   9  *
  10  * Revision 3.0.1.1  90/08/09  04:06:10  lwall
  11  * patch19: Initial revision
  12  *
  13  */
  14
  15 #include "EXTERN.h"
  16 #include "perl.h"
  17
  18 int
  19 userinit()
  20 {
  21     init_curses();
  22 }
  23
  24 /* Be sure to refetch the stack pointer after calling these routines. */
  25
  26 int
  27 callback(subname, sp, gimme, hasargs, numargs)
  28 char *subname;
  29 int sp;                 /* stack pointer after args are pushed */
  30 int gimme;              /* called in array or scalar context */
  31 int hasargs;            /* whether to create a @_ array for routine */
  32 int numargs;            /* how many args are pushed on the stack */
  33 {
  34     static ARG myarg[3];        /* fake syntax tree node */
  35     int arglast[3];
  36
  37     arglast[2] = sp;
  38     sp -= numargs;
  39     arglast[1] = sp--;
  40     arglast[0] = sp;
  41
  42     if (!myarg[0].arg_ptr.arg_str)
  43         myarg[0].arg_ptr.arg_str = str_make("",0);
  44
  45     myarg[1].arg_type = A_WORD;
  46     myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE);
  47
  48     myarg[2].arg_type = hasargs ? A_EXPR : A_NULL;
  49
  50     return do_subr(myarg, gimme, arglast);
  51 }
  52
  53 int
  54 callv(subname, sp, gimme, argv)
  55 char *subname;
  56 register int sp;        /* current stack pointer */
  57 int gimme;              /* called in array or scalar context */
  58 register char **argv;   /* null terminated arg list, NULL for no arglist */
  59 {
  60     register int items = 0;
  61     int hasargs = (argv != 0);
  62
  63     astore(stack, ++sp, Nullstr);       /* reserve spot for 1st return arg */
  64     if (hasargs) {
  65         while (*argv) {
  66             astore(stack, ++sp, str_2mortal(str_make(*argv,0)));
  67             items++;
  68             argv++;
  69         }
  70     }
  71     return callback(subname, sp, gimme, hasargs, items);
  72 }