Improved the VM's efficiency. The VM is as fast as the interpreter. :-(

* benchmark/lib.scm:  New file.
* benchmark/measure.scm:  New file.
* README:  Added useful pointers to various threads.
* doc/guile-vm.texi:  Fixed the description of `load-program' (it now expects
  _immediate_ integers).
* src/*.[ch]:  Use immediate integers whereever possible, as in the original
  code.  For `CONS', use `scm_cell' rather than `scm_cons'.

git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-6

README

@@ -1,3 +1,33 @@
+This is an attempt to revive the Guile-VM project by Keisuke Nishida
+written back in the years 2000 and 2001.  Below are a few pointers to
+relevant threads on Guile's development mailing list.
+
+Enjoy!
+
+Ludovic Courtès <ludovic.courtes@laas.fr>, Apr. 2005.
+
+
+Pointers
+--------
+
+Status of the last release, 0.5
+  http://lists.gnu.org/archive/html/guile-devel/2001-04/msg00266.html
+
+The very first release, 0.0
+  http://sources.redhat.com/ml/guile/2000-07/msg00418.html
+
+Performance, portability, GNU Lightning
+  http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00132.html
+
+Playing with GNU Lightning
+  http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00185.html
+
+On things left to be done
+  http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00146.html
+
+
+---8<---  Original README below.  -----------------------------------------
+
 Installation
 ------------
 

benchmark/lib.scm

@@ -0,0 +1,119 @@
+;; -*- Scheme -*-
+;;
+;; A library of dumb functions that may be used to benchmark Guile-VM.
+
+
+(define (fibo x)
+  (if (= 1 x)
+      1
+      (+ x
+	 (fibo (1- x)))))
+
+(define (g-c-d x y)
+  (if (= x y)
+      x
+      (if (< x y)
+	  (g-c-d x (- y x))
+	  (g-c-d (- x y) y))))
+
+(define (loop how-long)
+  ;; This one shows that procedure calls are no faster than within the
+  ;; interpreter: the VM yields no performance improvement.
+  (if (= 0 how-long)
+      0
+      (loop (1- how-long))))
+
+;; Disassembly of `loop'
+;;
+; Disassembly of #<objcode 302360b0>:
+
+; nlocs = 0  nexts = 0
+
+;    0    (make-int8 64)                  ;; 64
+;    2    (link "=")
+;    5    (link "loop")
+;   11    (link "1-")
+;   15    (vector 3)
+;   17    (make-int8:0)                   ;; 0
+;   18    (load-symbol "how-long")        ;; how-long
+;   28    (make-false)                    ;; #f
+;   29    (make-int8:0)                   ;; 0
+;   30    (list 3)
+;   32    (list 2)
+;   34    (list 1)
+;   36    (make-int8 8)                   ;; 8
+;   38    (make-int8 2)                   ;; 2
+;   40    (make-int8 6)                   ;; 6
+;   42    (cons)
+;   43    (cons)
+;   44    (make-int8 23)                  ;; 23
+;   46    (make-int8 4)                   ;; 4
+;   48    (make-int8 12)                  ;; 12
+;   50    (cons)
+;   51    (cons)
+;   52    (make-int8 25)                  ;; 25
+;   54    (make-int8 4)                   ;; 4
+;   56    (make-int8 6)                   ;; 6
+;   42    (cons)
+;   43    (cons)
+;   44    (make-int8 23)                  ;; 23
+;   46    (make-int8 4)                   ;; 4
+;   48    (make-int8 12)                  ;; 12
+;   50    (cons)
+;   51    (cons)
+;   52    (make-int8 25)                  ;; 25
+;   54    (make-int8 4)                   ;; 4
+;   56    (make-int8 6)                   ;; 6
+;   58    (cons)
+;   59    (cons)
+;   60    (list 4)
+;   62    load-program ##{201}#
+;   89    (link "loop")
+;   95    (variable-set)
+;   96    (void)
+;   97    (return)
+
+; Bytecode ##{201}#:
+
+;    0    (object-ref 0)
+;    2    (variable-ref)
+;    3    (make-int8:0)                   ;; 0
+;    4    (local-ref 0)
+;    6    (call 2)
+;    8    (br-if-not 0 2)                 ;; -> 13
+;   11    (make-int8:0)                   ;; 0
+;   12    (return)
+;   13    (object-ref 1)
+;   15    (variable-ref)
+;   16    (object-ref 2)
+;   18    (variable-ref)
+;   19    (local-ref 0)
+;   21    (call 1)
+;   23    (tail-call 1)
+
+
+(define (loopi how-long)
+  ;; Same as `loop'.
+  (let loopi ((how-long how-long))
+    (if (= 0 how-long)
+	0
+	(loopi (1- how-long)))))
+
+
+(define (do-cons x)
+  ;; This one shows that the built-in `cons' instruction yields a significant
+  ;; improvement (speedup: 1.4).
+  (let loop ((x x)
+	     (result '()))
+    (if (<= x 0)
+	result
+	(loop (1- x) (cons x result)))))
+
+(define (copy-list lst)
+  ;; Speedup: 1.3.
+  (let loop ((lst lst)
+	     (result '()))
+    (if (null? lst)
+	result
+	(loop (cdr lst)
+	      (cons (car lst) result)))))

benchmark/measure.scm

@@ -0,0 +1,49 @@
+#!/bin/sh
+# aside from this initial boilerplate, this is actually -*- scheme -*- code
+main='(module-ref (resolve-module '\''(measure)) '\'main')'
+exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
+!#
+
+;; A simple interpreter vs. VM performance comparison tool
+;;
+
+(define-module (measure)
+  :export (measure)
+  :use-module (system vm core)
+  :use-module (system base compile)
+  :use-module (system base language))
+
+(define (time-for-eval sexp eval)
+  (let ((before (tms:utime (times))))
+    (eval sexp (current-module))
+    (let ((elapsed (- (tms:utime (times)) before)))
+      (format #t "elapsed time: ~a~%" elapsed)
+      elapsed)))
+
+(define *scheme* (lookup-language 'scheme))
+
+(define (measure . args)
+  (if (< (length args) 2)
+      (begin
+	(format #t "Usage: measure SEXP FILE-TO-LOAD...~%")
+	(format #t "~%")
+	(format #t "Example: measure '(loop 23424)' lib.scm~%~%")
+	(exit 1)))
+  (for-each load (cdr args))
+  (let* ((sexp (with-input-from-string (car args)
+		 (lambda ()
+		   (read))))
+	 (time-interpreted (time-for-eval sexp eval))
+	 (objcode (compile-in sexp (current-module) *scheme*))
+	 (time-compiled (time-for-eval objcode
+				       (let ((vm (the-vm))
+					     (prog (objcode->program objcode)))
+					 (lambda (o e)
+					   (vm prog))))))
+    (format #t "interpreted: ~a~%" time-interpreted)
+    (format #t "compiled:    ~a~%" time-compiled)
+    (format #t "speedup:     ~a~%"
+	    (exact->inexact (/ time-interpreted time-compiled)))
+    0))
+
+(define main measure)

doc/guile-vm.texi

@@ -593,11 +593,12 @@ stack):
 @item optionally, a vector which is the program's object table (a
 program that does not reference external bindings does not need an
 object table);
-@item either one integer or four integers representing respectively
+@item either one immediate integer or four immediate integers
-the number of arguments taken by the function (@var{nargs}), the
+representing respectively the number of arguments taken by the
-number of @dfn{rest arguments} (@var{nrest}, 0 or 1), the number of
+function (@var{nargs}), the number of @dfn{rest arguments}
-local variables (@var{nlocs}) and the number of external variables
+(@var{nrest}, 0 or 1), the number of local variables (@var{nlocs}) and
-(@var{nexts}) (see the example above).
+the number of external variables (@var{nexts}) (see the example
+above).
 @end itemize
 
 In the end, push a program object onto the stack.

module/system/vm/assemble.scm

@@ -77,7 +77,7 @@
 	   (label-alist '())
 	   (object-alist '()))
        (define (push-code! code)
-	 (format #t "push-code! ~a~%" code)
+;	 (format #t "push-code! ~a~%" code)
 	 (set! stack (cons (code->bytes code) stack)))
        (define (push-object! x)
 	 (cond ((object->code x) => push-code!)
@@ -168,7 +168,7 @@
        ;;
        ;; main
        (for-each generate-code body)
-       (format #t "codegen: stack = ~a~%" (reverse stack))
+;       (format #t "codegen: stack = ~a~%" (reverse stack))
        (let ((bytes (stack->bytes (reverse! stack) label-alist)))
 	 (if toplevel
 	     (bytecode->objcode bytes vars.nlocs vars.nexts)

src/Makefile.am

@@ -4,7 +4,8 @@ guile_vm_SOURCES = guile-vm.c
 guile_vm_LDADD = libguilevm.la 
 guile_vm_LDFLAGS = $(GUILE_LDFLAGS)
 
-AM_CFLAGS = -Wall -g
+AM_CFLAGS = -Wall -g -pg
+guile_vm_LDFLAGS += -pg
 
 lib_LTLIBRARIES = libguilevm.la
 libguilevm_la_SOURCES =							\
@@ -12,6 +13,7 @@ libguilevm_la_SOURCES =							\
 	envs.h frames.h instructions.h objcodes.h programs.h vm.h	\
 	vm_engine.h vm_expand.h
 libguilevm_la_LDFLAGS = -version-info 0:0:0 -export-dynamic
+libguilevm_la_LDFLAGS += -pg
 EXTRA_DIST = vm_engine.c vm_system.c vm_scheme.c vm_loader.c
 BUILT_SOURCES = vm_system.i vm_scheme.i vm_loader.i \
 	envs.x frames.x instructions.x objcodes.x programs.x vm.x
@@ -25,12 +27,23 @@ ETAGS_ARGS = --regex='/SCM_\(SYMBOL\|VCELL\).*\"\([^\"]\)*\"/\3/' \
 
 SNARF = guile-snarf
 SUFFIXES = .i .x
+
 .c.i:
 	grep '^VM_DEFINE' $< > $@
+
 .c.x:
 	$(SNARF) $< $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@ \
 	|| { rm $@; false; }
 
+
+# Extra rules for debugging purposes.
+
+%.I: %.c
+	$(CPP) $(DEFS) $(INCLUDES) $(CPPFLAGS) $< > $@
+
+%.s: %.c
+	$(CC) -S -dA $(DEFS) $(INCLUDES) $(CFLAGS) $(CPPFLAGS) -o $@ $<
+
 GUILE = "$(bindir)/guile"
 guilec: guilec.in
 	sed "s!@guile@!$(GUILE)!" guilec.in > guilec

src/frames.c

@@ -117,7 +117,7 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0,
   SCM_VALIDATE_HEAP_FRAME (1, frame);
   SCM_VALIDATE_INUM (2, index); /* FIXME: Check the range! */
   return SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
-			     scm_to_int (index));
+			     SCM_I_INUM (index));
 }
 #undef FUNC_NAME
 
@@ -129,7 +129,7 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0,
   SCM_VALIDATE_HEAP_FRAME (1, frame);
   SCM_VALIDATE_INUM (2, index); /* FIXME: Check the range! */
   SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
-		      scm_to_int (index)) = val;
+		      SCM_I_INUM (index)) = val;
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME

src/instructions.c

@@ -107,7 +107,7 @@ SCM_DEFINE (scm_instruction_length, "instruction-length", 1, 0, 0,
 #define FUNC_NAME s_scm_instruction_length
 {
   SCM_VALIDATE_INSTRUCTION (1, inst);
-  return scm_from_schar (SCM_INSTRUCTION_LENGTH (inst));
+  return SCM_I_MAKINUM (SCM_INSTRUCTION_LENGTH (inst));
 }
 #undef FUNC_NAME
 
@@ -117,7 +117,7 @@ SCM_DEFINE (scm_instruction_pops, "instruction-pops", 1, 0, 0,
 #define FUNC_NAME s_scm_instruction_pops
 {
   SCM_VALIDATE_INSTRUCTION (1, inst);
-  return scm_from_schar (SCM_INSTRUCTION_POPS (inst));
+  return SCM_I_MAKINUM (SCM_INSTRUCTION_POPS (inst));
 }
 #undef FUNC_NAME
 
@@ -127,7 +127,7 @@ SCM_DEFINE (scm_instruction_pushes, "instruction-pushes", 1, 0, 0,
 #define FUNC_NAME s_scm_instruction_pushes
 {
   SCM_VALIDATE_INSTRUCTION (1, inst);
-  return scm_from_char (SCM_INSTRUCTION_PUSHES (inst));
+  return SCM_I_MAKINUM (SCM_INSTRUCTION_PUSHES (inst));
 }
 #undef FUNC_NAME
 
@@ -137,7 +137,7 @@ SCM_DEFINE (scm_instruction_to_opcode, "instruction->opcode", 1, 0, 0,
 #define FUNC_NAME s_scm_instruction_to_opcode
 {
   SCM_VALIDATE_INSTRUCTION (1, inst);
-  return scm_from_char (SCM_INSTRUCTION_OPCODE (inst));
+  return SCM_I_MAKINUM (SCM_INSTRUCTION_OPCODE (inst));
 }
 #undef FUNC_NAME
 
@@ -148,7 +148,7 @@ SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0,
 {
   int i;
   SCM_VALIDATE_INUM (1, op);
-  i = scm_to_int (op);
+  i = SCM_I_INUM (op);
   SCM_ASSERT_RANGE (1, op, 0 <= i && i < scm_op_last);
   return scm_from_locale_symbol (scm_instruction_table[i].name);
 }

src/objcodes.c

@@ -159,8 +159,8 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 3, 0, 0,
   base = SCM_OBJCODE_BASE (objcode);
 
   memcpy (base, OBJCODE_COOKIE, 8);
-  base[8] = scm_to_int (nlocs);
+  base[8] = SCM_I_INUM (nlocs);
-  base[9] = scm_to_int (nexts);
+  base[9] = SCM_I_INUM (nexts);
 
   memcpy (base + 10, c_bytecode, size - 10);
 
@@ -176,10 +176,13 @@ SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0,
 #define FUNC_NAME s_scm_load_objcode
 {
   int fd;
+  char *c_file;
 
   SCM_VALIDATE_STRING (1, file);
 
-  fd = open (SCM_STRING_CHARS (file), O_RDONLY);
+  c_file = scm_to_locale_string (file);
+  fd = open (c_file, O_RDONLY);
+  free (c_file);
   if (fd < 0) SCM_SYSERROR;
 
   return make_objcode_by_mmap (fd);

src/programs.c

@@ -149,10 +149,10 @@ SCM_DEFINE (scm_program_arity, "program-arity", 1, 0, 0,
   SCM_VALIDATE_PROGRAM (1, program);
 
   p = SCM_PROGRAM_DATA (program);
-  return SCM_LIST4 (scm_from_uchar (p->nargs),
+  return SCM_LIST4 (SCM_I_MAKINUM (p->nargs),
-		    scm_from_uchar (p->nrest),
+		    SCM_I_MAKINUM (p->nrest),
-		    scm_from_uchar (p->nlocs),
+		    SCM_I_MAKINUM (p->nlocs),
-		    scm_from_uchar (p->nexts));
+		    SCM_I_MAKINUM (p->nexts));
 }
 #undef FUNC_NAME
 

src/vm.c

@@ -476,10 +476,10 @@ SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0,
 
   SCM_VALIDATE_VM (1, vm);
 
-  stats = scm_make_vector (scm_from_int (2), SCM_UNSPECIFIED);
+  stats = scm_make_vector (SCM_I_MAKINUM (2), SCM_UNSPECIFIED);
-  scm_vector_set_x (stats, scm_from_int (0),
+  scm_vector_set_x (stats, SCM_I_MAKINUM (0),
 		    scm_from_ulong (SCM_VM_DATA (vm)->time));
-  scm_vector_set_x (stats, scm_from_int (1),
+  scm_vector_set_x (stats, SCM_I_MAKINUM (1),
 		    scm_from_ulong (SCM_VM_DATA (vm)->clock));
 
   return stats;
@@ -528,7 +528,7 @@ SCM_DEFINE (scm_vm_fetch_code, "vm-fetch-code", 1, 0, 0,
 
   list = SCM_LIST1 (scm_str2symbol (p->name));
   for (i = 1; i <= p->len; i++)
-    list = scm_cons (scm_from_uint8 (ip[i]), list);
+    list = scm_cons (SCM_I_MAKINUM (ip[i]), list);
   return scm_reverse_x (list, SCM_EOL);
 }
 #undef FUNC_NAME

src/vm_engine.c

@@ -72,7 +72,7 @@ vm_run (SCM vm, SCM program, SCM args)
 #endif
 
 #ifdef HAVE_LABELS_AS_VALUES
-  /* Jump talbe */
+  /* Jump table */
   static void *jump_table[] = {
 #define VM_INSTRUCTION_TO_LABEL 1
 #include "vm_expand.h"

src/vm_engine.h

@@ -216,10 +216,15 @@
 #define DROP()	do { CHECK_UNDERFLOW (); sp--; } while (0)
 #define POP(x)	do { x = *sp; DROP (); } while (0)
 
-#define CONS(x,y,z)				\
+/* A fast CONS.  This has to be fast since its used, for instance, by
-{						\
+   POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
-  SYNC_BEFORE_GC ();				\
+   inlined function in Guile 1.7.  Unfortunately, it calls
-  x = scm_cons (y, z);				\
+   `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
+   heap.  XXX  */
+#define CONS(x,y,z)					\
+{							\
+  SYNC_BEFORE_GC ();					\
+  x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));	\
 }
 
 #define POP_LIST(n)				\

src/vm_loader.c

@@ -138,9 +138,9 @@ VM_DEFINE_LOADER (load_program, "load-program")
 
   /* init parameters */
   /* NOTE: format defined in system/vm/assemble.scm */
-  if (scm_is_integer (x))
+  if (SCM_I_INUMP (x))
     {
-      int i = scm_to_int (x);
+      int i = SCM_I_INUM (x);
       if (-128 <= i && i <= 127)
 	{
 	  /* 8-bit representation */
@@ -162,10 +162,10 @@ VM_DEFINE_LOADER (load_program, "load-program")
     {
       /* Other cases */
       sp -= 4;
-      p->nargs = scm_to_int (sp[0]);
+      p->nargs = SCM_I_INUM (sp[0]);
-      p->nrest = scm_to_int (sp[1]);
+      p->nrest = SCM_I_INUM (sp[1]);
-      p->nlocs = scm_to_int (sp[2]);
+      p->nlocs = SCM_I_INUM (sp[2]);
-      p->nexts = scm_to_int (sp[3]);
+      p->nexts = SCM_I_INUM (sp[3]);
     }
 
   PUSH (prog);

src/vm_scheme.c

@@ -167,8 +167,8 @@ VM_DEFINE_FUNCTION (set_cdr, "set-cdr!", 2)
 #define REL(crel,srel)						\
 {								\
   ARGS2 (x, y);							\
-  if (scm_is_integer (x) && scm_is_integer (y))			\
+  if (SCM_I_INUMP (x) && SCM_I_INUMP (y))			\
-    RETURN (SCM_BOOL (scm_to_int (x) crel scm_to_int (y)));	\
+    RETURN (SCM_BOOL (SCM_I_INUM (x) crel SCM_I_INUM (y)));	\
   RETURN (srel (x, y));						\
 }
 
@@ -206,11 +206,11 @@ VM_DEFINE_FUNCTION (ge, "ge?", 2)
 #define FUNC1(CEXP,SEXP)			\
 {						\
   ARGS1 (x);					\
-  if (scm_is_integer (x))			\
+  if (SCM_I_INUMP (x))				\
     {						\
       int n = CEXP;				\
       if (SCM_FIXABLE (n))			\
-	RETURN (scm_from_int (n));		\
+	RETURN (SCM_I_MAKINUM (n));		\
     }						\
   RETURN (SEXP);				\
 }
@@ -219,11 +219,11 @@ VM_DEFINE_FUNCTION (ge, "ge?", 2)
 #define FUNC2(CFUNC,SFUNC)				\
 {							\
   ARGS2 (x, y);						\
-  if (scm_is_integer (x) && scm_is_integer (y))		\
+  if (SCM_I_INUMP (x) && SCM_I_INUMP (y))		\
     {							\
-      int n = scm_to_int (x) CFUNC scm_to_int (y);	\
+      int n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y);	\
       if (SCM_FIXABLE (n))				\
-	RETURN (scm_from_int (n));			\
+	RETURN (SCM_I_MAKINUM (n));			\
     }							\
   RETURN (SFUNC (x, y));				\
 }

src/vm_system.c

@@ -119,7 +119,7 @@ VM_DEFINE_INSTRUCTION (make_eol, "make-eol", 0, 0, 1)
 
 VM_DEFINE_INSTRUCTION (make_int8, "make-int8", 1, 0, 1)
 {
-  PUSH (scm_from_schar ((signed char) FETCH ()));
+  PUSH (SCM_I_MAKINUM ((signed char) FETCH ()));
   NEXT;
 }
 
@@ -139,7 +139,7 @@ VM_DEFINE_INSTRUCTION (make_int16, "make-int16", 2, 0, 1)
 {
   int h = FETCH ();
   int l = FETCH ();
-  PUSH (scm_from_short ((signed short) (h << 8) + l));
+  PUSH (SCM_I_MAKINUM ((signed short) (h << 8) + l));
   NEXT;
 }
 
@@ -197,8 +197,12 @@ VM_DEFINE_INSTRUCTION (list_break, "list-break", 0, 0, 0)
 #define LOCAL_REF(i)		SCM_FRAME_VARIABLE (fp, i)
 #define LOCAL_SET(i,o)		SCM_FRAME_VARIABLE (fp, i) = o
 
-/* #define VARIABLE_REF(v)		SCM_CDR (v) */
+/* For the variable operations, we _must_ obviously avoid function calls to
-/* #define VARIABLE_SET(v,o)	SCM_SETCDR (v, o) */
+   `scm_variable_ref ()', `scm_variable_bound_p ()' and friends which do
+   nothing more than the corresponding macros.  */
+#define VARIABLE_REF(v)		SCM_VARIABLE_REF (v)
+#define VARIABLE_SET(v,o)	SCM_VARIABLE_SET (v, o)
+#define VARIABLE_BOUNDP(v)      (VARIABLE_REF (v) != SCM_UNDEFINED)
 
 /* ref */
 
@@ -232,7 +236,7 @@ VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
 {
   SCM x = *sp;
 
-  if (SCM_FALSEP (scm_variable_bound_p (x)))
+  if (!VARIABLE_BOUNDP (x))
     {
       err_args = SCM_LIST1 (x);
       /* Was: err_args = SCM_LIST1 (SCM_CAR (x)); */
@@ -240,7 +244,7 @@ VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
     }
   else
     {
-      SCM o = scm_variable_ref (x);
+      SCM o = VARIABLE_REF (x);
       *sp = o;
     }
 
@@ -273,7 +277,7 @@ VM_DEFINE_INSTRUCTION (external_set, "external-set", 1, 1, 0)
 
 VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
 {
-  scm_variable_set_x (sp[0], sp[-1]);
+  VARIABLE_SET (sp[0], sp[-1]);
   scm_set_object_property_x (sp[-1], scm_sym_name, SCM_CAR (sp[0]));
   sp -= 2;
   NEXT;