Changeset 3938 for src/perl5

Timestamp:

05/27/05 02:25:26 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

5515

Message:

* all should work except this memory overflow thing

Location:

src/perl5

Files:

• perl5.c (modified) (2 diffs)
• perl5.h (modified) (1 diff)
• pugsembed.c (modified) (1 diff)

src/perl5/perl5.c

@@ -202 +202 @@
 
 SV *
-perl5_call(char *subname, int argc, SV** args, SV *env, int cxt)
-{
-    int i;
-    SV *rv, *sv;
+perl5_apply(SV *sub, SV *inv, SV** args, SV *env, int cxt)
+{
+    SV *arg;
+    SV *rv;
+    SV *sv;
 
     dSP;
@@ -219 +220 @@
 
     PUSHMARK(SP);
-    for (i = 0; i < argc; i++) {
-        XPUSHs(args[i]);
-    }
-    PUTBACK;
-
-    call_method(subname, cxt);
+    if (inv != NULL) {
+        XPUSHs(inv);
+    }
+    for (arg = args; arg != NULL; arg++) {
+        XPUSHs(arg);
+    }
+    PUTBACK;
+
+    if (inv != NULL) {
+        call_method(SvPV_nolen(sub), cxt);
+    }
+    else {
+        call_sv(sub, cxt);
+    }
 
     SPAGAIN;

src/perl5/perl5.h

@@ -11 +11 @@
 SV * perl5_newSViv ( int iv );
 SV * perl5_newSVnv ( double iv );
-SV * perl5_call(char *subname, int argc, SV** args, SV *env, int cxt);
+SV * perl5_apply(SV *sub, SV *inv, SV** args, SV *env, int cxt);
 bool perl5_can(SV *inv, char *subname);
 SV * perl5_eval(char *code, SV *env, int cxt);

src/perl5/pugsembed.c

@@ -26 +26 @@
     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);
+        stack[0] = sv;
+        sv = perl5_apply(newSVpv("code", 0), newSVpv("pugs::guts", 0), stack, NULL, G_SCALAR);
     }
     return (sv);