1 files changed, 72 insertions, 0 deletions
diff --git a/dlperl/usersub.c b/dlperl/usersub.c
new file mode 100644
index 0000000000..4ba3d6d639
--- /dev/null
+++ b/dlperl/usersub.c
@@ -0,0 +1,72 @@
+/* $RCSfile: usersub.c,v $$Revision: 4.0.1.1 $$Date: 91/11/05 19:07:24 $
+ *
+ * $Log:	usersub.c,v $
+ * 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()
+{
+    dlperl_init();
+}
+
+/* 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);
+}