home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PERL4036.ZIP / usub / usersub.c < prev   
C/C++ Source or Header  |  1993-02-08  |  2KB  |  73 lines
  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. }
  73.