[svn:mod_parrot] rev 179 - mod_parrot/trunk

Author: jhorwitz
Date: Wed Jul 27 07:39:47 2005
New Revision: 179

Added:
   mod_parrot/trunk/cc_test.imc
Modified:
   mod_parrot/trunk/Configure.pl
   mod_parrot/trunk/Makefile.in
   mod_parrot/trunk/parrot_util.c
Log:
test for new calling conventions
provide backtrace API for old calling conventions


Modified: mod_parrot/trunk/Configure.pl
==============================================================================
--- mod_parrot/trunk/Configure.pl	(original)
+++ mod_parrot/trunk/Configure.pl	Wed Jul 27 07:39:47 2005
@@ -48,6 +48,21 @@ sub parrot_config
 
 $| = 1;
 
+print "\n";
+
+my $defines;
+print "Determining Parrot calling conventions...";
+my $out = `$parrot_build_dir/parrot cc_test.imc`;
+chomp($out);
+if ($out eq 'new') {
+    $defines = '-DPARROT_NEW_CALL_CONV';
+}
+else {
+    die 'calling convention test failed!' if $out ne 'old';
+}
+
+print "$out\n";
+
 # where are apache includes?
 my $apache_include_dir = `$apxs -q INCLUDEDIR`;
 
@@ -55,7 +70,7 @@ my $apache_include_dir = `$apxs -q INCLU
 my $mpm = `$apxs -q MPM_NAME`;
 $mpm or die "Couldn't find Apache MPM";
 chomp($mpm);
-print "\nConfiguring mod_parrot for $mpm MPM.\n";
+print "Configuring mod_parrot for $mpm MPM.\n";
 
 # we can't use the config verbatim -- apxs chokes on it, so we use what we can
 my $cflags = " -I$parrot_build_dir/include";
@@ -71,6 +86,7 @@ my $template;
     $template = <MAKEFILE_IN>;
     close(MAKEFILE_IN);
 }
+$template =~ s/\@DEFINES\@/$defines/g;
 $template =~ s/\@CFLAGS\@/$cflags/g;
 $template =~ s/\@LDFLAGS\@/$ldflags/g;
 $template =~ s/\@LIBS\@/$libs/g;

Modified: mod_parrot/trunk/Makefile.in
==============================================================================
--- mod_parrot/trunk/Makefile.in	(original)
+++ mod_parrot/trunk/Makefile.in	Wed Jul 27 07:39:47 2005
@@ -2,6 +2,7 @@
 
 # This file is autogenerated.  Changes will be lost after reconfiguration.
 
+DEFINES=@DEFINES@
 CFLAGS=@CFLAGS@
 LDFLAGS=@LDFLAGS@
 LIBS=@LIBS@
@@ -22,7 +23,7 @@ MPLIBS=	lib/Apache/RequestRec \
 all: mod_parrot.la
 
 mod_parrot.la: $(SOURCE_FILES)
-	$(APXS) -c $(CFLAGS) $(LDFLAGS) $(LIBS) $(SOURCE_FILES) $(PARROT_OBJS)
+	$(APXS) -c $(DEFINES) $(CFLAGS) $(LDFLAGS) $(LIBS) $(SOURCE_FILES) $(PARROT_OBJS)
 
 files-clean:
 	rm -f *.o *.lo *.slo *.la core core.*

Added: mod_parrot/trunk/cc_test.imc
==============================================================================
--- (empty file)
+++ mod_parrot/trunk/cc_test.imc	Wed Jul 27 07:39:47 2005
@@ -0,0 +1,21 @@
+# $Id$
+
+# test which calling conventions are in use
+
+.sub ctx_test
+    $P0 = new String
+    $P0 = "abc"
+    .pcc_begin_return
+        .return $P0
+    .pcc_end_return
+.end
+
+.sub main @MAIN
+    $S0 = ctx_test()
+    if $S0 == "abc" goto NEW_CC
+    print "old\n"
+    goto END
+NEW_CC:
+    print "new\n"
+END:
+.end

Modified: mod_parrot/trunk/parrot_util.c
==============================================================================
--- mod_parrot/trunk/parrot_util.c	(original)
+++ mod_parrot/trunk/parrot_util.c	Wed Jul 27 07:39:47 2005
@@ -102,6 +102,7 @@ int modparrot_call_sub_IS(Parrot_Interp 
 }
 
 /* adapted from Parrot's PDB_backtrace */
+#ifdef PARROT_NEW_CALL_CONV
 char *modparrot_backtrace(Parrot_Interp interp)
 {
     STRING *str, *buf = NULL;
@@ -163,3 +164,52 @@ char *modparrot_backtrace(Parrot_Interp 
     trace_string = string_to_cstring(interp, buf);
     return(trace_string);
 }
+#else /* PARROT_NEW_CALL_CONV */
+char *modparrot_backtrace(Parrot_Interp interp)
+{
+    STRING *str, *buf = NULL;
+    PMC *sub;
+    PMC *old = PMCNULL;
+    int rec_level = 0;
+    char *trace_string;
+
+    /* information about the current sub */
+    sub = interpinfo_p(interp, CURRENT_SUB);
+    if (!PMC_IS_NULL(sub)) {
+        str = Parrot_Context_infostr(interp, &interp->ctx);
+        if (str)
+            buf = string_concat(interp, buf, str, 0);
+    }
+
+    /* backtrace: follow the continuation chain */
+    sub = interpinfo_p(interp, CURRENT_CONT);
+    while (!PMC_IS_NULL(sub) &&
+            sub->vtable->base_type == enum_class_Continuation &&
+            NULL != (str = Parrot_Context_infostr(interp,
+                    &PMC_cont(sub)->ctx)) ) {
+
+        /* recursion detection */
+        if (!PMC_IS_NULL(old) && PMC_cont(old) &&
+            PMC_cont(old)->ctx.current_pc == PMC_cont(sub)->ctx.current_pc &&
+            PMC_cont(old)->ctx.current_sub == PMC_cont(sub)->ctx.current_sub) {
+            ++rec_level;
+        } else if (rec_level != 0) {
+            string_nprintf(interp, buf, 0, "... call repeated %d times\n",
+                rec_level);
+            rec_level = 0;
+        }
+
+        /* print the context description */
+        if (rec_level == 0)
+            buf = string_concat(interp, buf, str, 0);
+
+        /* get the next Continuation */
+        old = sub;
+        sub = PMC_cont(sub)->ctx.current_cont;
+    }
+    if (rec_level != 0) {
+        string_nprintf(interp, buf, 0, "... call repeated %d times\n",
+            rec_level);
+    }
+}
+#endif /* PARROT_NEW_CALL_CONV */