[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-79-gfd62932

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=fd629322442e3a7131d779a266745ffd05e83c56

The branch, master has been updated
       via  fd629322442e3a7131d779a266745ffd05e83c56 (commit)
       via  f318aa1e386a941df1d2cb2f4d82f8337578baa5 (commit)
       via  31a26df2cc91427f0a4281d6ac5a1c0b53a8c0f1 (commit)
      from  d8164b046c71c3f313fa4f7e239d50823b619297 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit fd629322442e3a7131d779a266745ffd05e83c56
Author: Andy Wingo <address@hidden>
Date:   Tue Jan 5 16:51:58 2010 +0100

    add subr-call VM op
    
    * libguile/vm-i-system.c (subr_call): Add subr-call VM op.

commit f318aa1e386a941df1d2cb2f4d82f8337578baa5
Author: Andy Wingo <address@hidden>
Date:   Tue Jan 5 16:50:58 2010 +0100

    add SCM_PROGRAM_IS_PRIMITIVE_GENERIC flag and checker
    
    * libguile/programs.h (SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC)
      (SCM_PROGRAM_IS_PRIMITIVE_GENERIC): Add a primitive-generic flag and
      accessor, for when we switch primitives to be implemented using VM
      trampolines.

commit 31a26df2cc91427f0a4281d6ac5a1c0b53a8c0f1
Author: Andy Wingo <address@hidden>
Date:   Tue Jan 5 16:50:39 2010 +0100

    program-meta procedures get their program's objtable
    
    * libguile/programs.c (scm_program_meta): Give the program meta
      procedure the same object table as the main procedure. Will allow for
      easier hand-crafting of meta programs. Of course when compiling a
      metadata procedure from Scheme, one still wants to avoid preallocating
      the heap objects needed by the metadata...

-----------------------------------------------------------------------

Summary of changes:
 libguile/programs.c    |    5 ++-
 libguile/programs.h    |    4 ++-
 libguile/vm-i-system.c |   69 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 75 insertions(+), 3 deletions(-)

diff --git a/libguile/programs.c b/libguile/programs.c
index 336e621..fdc0c32 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -138,7 +138,8 @@ SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0,
 
   metaobj = scm_objcode_meta (SCM_PROGRAM_OBJCODE (program));
   if (scm_is_true (metaobj))
-    return scm_make_program (metaobj, SCM_BOOL_F, SCM_BOOL_F);
+    return scm_make_program (metaobj, SCM_PROGRAM_OBJTABLE (program),
+                             SCM_BOOL_F);
   else
     return SCM_BOOL_F;
 }
diff --git a/libguile/programs.h b/libguile/programs.h
index 836f1ff..0ae5bfe 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -27,6 +27,7 @@
  */
 
 #define SCM_F_PROGRAM_IS_BOOT 0x100
+#define SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC 0x200
 
 #define SCM_PROGRAM_P(x)       (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_program)
 #define SCM_PROGRAM_OBJCODE(x) (SCM_CELL_OBJECT_1 (x))
@@ -35,6 +36,7 @@
 #define SCM_PROGRAM_DATA(x)    (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x)))
 #define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
 #define SCM_PROGRAM_IS_BOOT(x) (SCM_CELL_WORD_0 (x) & SCM_F_PROGRAM_IS_BOOT)
+#define SCM_PROGRAM_IS_PRIMITIVE_GENERIC(x) (SCM_CELL_WORD_0 (x) & 
SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC)
 
 SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_variables);
 
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 99c6381..546c9e0 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -886,6 +886,75 @@ VM_DEFINE_INSTRUCTION (55, tail_call, "tail-call", 1, -1, 
1)
   goto vm_error_wrong_type_apply;
 }
 
+VM_DEFINE_INSTRUCTION (80, subr_call, "subr-call", 1, -1, -1)
+{
+  SCM foreign, ret;
+  SCM (*subr)();
+  nargs = FETCH ();
+  POP (foreign);
+
+  subr = SCM_FOREIGN_OBJECT_REF (foreign, void*);
+
+  VM_HANDLE_INTERRUPTS;
+  SYNC_REGISTER ();
+
+  switch (nargs)
+    {
+    case 0:
+      ret = subr ();
+      break;
+    case 1:
+      ret = subr (sp[0]);
+      break;
+    case 2:
+      ret = subr (sp[-1], sp[0]);
+      break;
+    case 3:
+      ret = subr (sp[-2], sp[-1], sp[0]);
+      break;
+    case 4:
+      ret = subr (sp[-3], sp[-2], sp[-1], sp[0]);
+      break;
+    case 5:
+      ret = subr (sp[-4], sp[-3], sp[-2], sp[-1], sp[0]);
+      break;
+    case 6:
+      ret = subr (sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]);
+      break;
+    case 7:
+      ret = subr (sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], sp[0]);
+      break;
+    case 8:
+      ret = subr (sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], sp[-1], 
sp[0]);
+      break;
+    case 9:
+      ret = subr (sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], sp[-2], 
sp[-1], sp[0]);
+      break;
+    case 10:
+      ret = subr (sp[-9], sp[-8], sp[-7], sp[-6], sp[-5], sp[-4], sp[-3], 
sp[-2], sp[-1], sp[0]);
+      break;
+    default:
+      abort ();
+    }
+  
+  NULLSTACK_FOR_NONLOCAL_EXIT ();
+  DROPN (nargs + 1); /* drop args and procedure */
+      
+  if (SCM_UNLIKELY (SCM_VALUESP (ret)))
+    {
+      /* multiple values returned to continuation */
+      ret = scm_struct_ref (ret, SCM_INUM0);
+      nvalues = scm_ilength (ret);
+      PUSH_LIST (ret, scm_is_null);
+      goto vm_return_values;
+    }
+  else
+    {
+      PUSH (ret);
+      goto vm_return;
+    }
+}
+
 VM_DEFINE_INSTRUCTION (56, tail_call_nargs, "tail-call/nargs", 0, 0, 1)
 {
   SCM x;


hooks/post-receive
-- 
GNU Guile