Changeset 3937 for src/perl5

Timestamp:

05/27/05 02:08:48 (4 years ago)

Author:

clkao

svk:copy_cache_prev:

5515

Message:

Apply more ducktapes.

Location:

src/perl5

Files:

• perl5.c (modified) (3 diffs)
• pugsembed.c (modified) (2 diffs)

src/perl5/perl5.c

@@ -12 +12 @@
 static PerlInterpreter *my_perl;
 
-const char eval_file_code[] =
+int __init = 0;
+
+const char pugs_guts_code[] =
 "use strict;"
 "package pugs;"
@@ -19 +21 @@
 "sub AUTOLOAD { }"
 "warn 'perl5 glue compiled';"
-//"pugs::guts::test();"
-
-"package pugs::code;"
-"sub new { }"
+
+"package pugs::guts;"
+"sub code { my ($class, $val) = @_;"
+"          sub { pugs::guts::invoke($val, undef, @_) } }"
 "1;";
 
-XS(_pugs_guts_test) {
+XS(_pugs_guts_invoke) {
+    Val *val, *inv, **stack;
+    SV *ret;
+    int i;
     dXSARGS;
-    if (items != 1)
+    if (items < 1)
         Perl_croak(aTHX_ "hate software");
 
+    val = pugs_SvToVal(ST(0));
+    inv = pugs_SvToVal(ST(1));
+
+    stack = (Val **)malloc(sizeof(Val*)*items-2);
+    for (i = 2; i < items; ++i) {
+        stack[i-2] = pugs_SvToVal(ST(i));
+    }
+
+    fprintf(stderr, "back to pugs\n");
+    ret = pugs_ValToSv(pugs_Apply (val, inv, stack));
+
+    free (stack);
+    
     XSRETURN(1);
 }
@@ -117 +135 @@
 
     exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
+    fprintf(stderr, "hello, perl5: %d\n", exitstatus);
 
     if (exitstatus == 0)
         exitstatus = perl_run( my_perl );
-    return exitstatus;
-
+
+    __init = 1;
     fprintf(stderr, "hello, perl5\n");
 
-    newXS((char*) "pugs::guts::test", _pugs_guts_test, (char*)__FILE__);
-
-    eval_pv(eval_file_code, FALSE);
+    newXS((char*) "pugs::guts::invoke", _pugs_guts_invoke, (char*)__FILE__);
+
+    eval_pv(pugs_guts_code, TRUE);
 
     if (SvTRUE(ERRSV)) {

src/perl5/pugsembed.c

@@ -1 +1 @@
 #include <pugsembed.h>
+extern int __init;
 
 Val *
@@ -15 +16 @@
 {
     SV *sv = newSV(0);
+    Val *isa[2];
+    SV *stack[8];
+
     fprintf(stderr, "pugs mkvalref: %p\n", val);
-    Val *isa[2];
+    sv_setref_pv(sv, "pugs", val);
+
     isa[0] = pugs_PvToVal("Code");
     isa[1] = NULL;
-    if (pugs_ValToIv(pugs_Apply(pugs_PvToVal("&isa"), val, isa))) {
+    if (__init && pugs_ValToIv(pugs_Apply(pugs_PvToVal("&isa"), val, isa))) {
         fprintf(stderr, "got a code!!\n");
+        stack[0] = newSVpv("pugs::guts", 0);
+        stack[1] = sv;
+        sv = perl5_call("code", 2, stack, NULL, G_SCALAR);
     }
-    sv_setref_pv(sv, "pugs", val);
     return (sv);
 }