Got the VM up and running! Augmented the documentation.

* src/*.[ch]:  Replaced the remaining `SCM_MAKINUM', and changed `SCM_VELTS'
  into `scm_vector_elements ()'.
* src/vm_loader.c (link):  Fixed so that it pushed a variable object on
  the stack.
* src/vm_system.c (variable-ref):  Fixed so that it uses `scm_variable_ref ()'
  and friends.
* module/system/vm/assemble.scm (dump-object!):  Fixed the string case.
* src/vm_engine.h (CONS):  Use `scm_cons' instead of `SCM_NEWCELL'.
* doc/guile-vm.texi:  Added actual instruction definitions, explanations of
  the program invocation mechanism, programs' object tables, etc., in the
  `Instruction Set' chapter.

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

8 files changed, 213 insertions, 40 deletions

diff --git a/doc/guile-vm.texi b/doc/guile-vm.texi
index 49a681e94..c772056e4 100644
--- a/doc/guile-vm.texi
+++ b/doc/guile-vm.texi
@@ -10,15 +10,21 @@
 @set VERSION 0.6
 @set UPDATED 2005-04-26
 
+@c Macro for instruction definitions.
+@macro insn{}
+Instruction
+@end macro
+
 @ifinfo
 @dircategory Scheme Programming
 @direntry
-* Guile VM: (guile-vm).         Guile Virtual Machine.
+* Guile VM: (guile-vm).         Guile's Virtual Machine.
 @end direntry
 
 This file documents Guile VM.
 
 Copyright @copyright{} 2000 Keisuke Nishida
+Copyright @copyright{} 2005 Ludovic Court`es
 
 Permission is granted to make and distribute verbatim copies of this
 manual provided the copyright notice and this permission notice are
@@ -54,6 +60,7 @@ Updated for Guile VM @value{VERSION} @*
 @value{UPDATED} @*
 
 Copyright @copyright{} 2000 Keisuke Nishida
+Copyright @copyright{} 2005 Ludovic Court`es
 
 Permission is granted to make and distribute verbatim copies of this
 manual provided the copyright notice and this permission notice are
@@ -76,7 +83,9 @@ approved by the Free Software Foundation.
 @node Top, Introduction, (dir), (dir)
 @top Guile VM Specification
 
-This document corresponds to Guile VM @value{VERSION}.
+This document would like to correspond to Guile VM @value{VERSION}.
+However, be warned that important parts still correspond to version
+0.0 and are not valid anymore.
 
 @menu
 * Introduction::                
@@ -457,10 +466,49 @@ External function:
 The Guile VM instruction set is roughly divided two groups: system
 instructions and functional instructions.  System instructions control
 the execution of programs, while functional instructions provide many
-useful calculations.  By convention, system instructions begin with a
-letter `%'.
+useful calculations.
+
+@menu
+* Environment Control Instructions::  
+* Subprogram Control Instructions::  
+* Data Control Instructions::   
+@end menu
+
+@node Environment Control Instructions, Subprogram Control Instructions, Instruction Set, Instruction Set
+@section Environment Control Instructions
+
+@deffn @insn{} link binding-name
+Look up @var{binding-name} (a string) in the current environment and
+push the corresponding variable object onto the stack.  If
+@var{binding-name} is not bound yet, then create a new binding and
+push its variable object.
+@end deffn
+
+@deffn @insn{} variable-ref
+Dereference the variable object which is on top of the stack and
+replace it by the value of the variable it represents.
+@end deffn
+
+@deffn @insn{} variable-set
+Set the value of the variable on top of the stack (at @code{sp[0]}) to
+the object located immediately before (at @code{sp[-1]}).
+@end deffn
+
+As an example, let us look at what a simple function call looks like:
+
+@example
+(+ 2 3)
+@end example
+
+This call yields the following sequence of instructions:
 
-@section Environment control instructions
+@example
+(link "+")      ;; lookup binding "x"
+(variable-ref)  ;; dereference it
+(make-int8 2)   ;; push immediate value `2'
+(make-int8 3)   ;; push immediate value `3'
+(tail-call 2)   ;; call the proc at sp[-3] with two args
+@end example
 
 @itemize
 @item %alloc
@@ -469,15 +517,125 @@ letter `%'.
 @item %unbind
 @end itemize
 
-@section Subprogram control instructions
+@node Subprogram Control Instructions, Data Control Instructions, Environment Control Instructions, Instruction Set
+@section Subprogram Control Instructions
+
+Programs (read: ``compiled procedure'') may refer to external
+bindings, like variables or functions defined outside the program
+itself, in the environment in which it will evaluate at run-time.  In
+a sense, a program's environment and its bindings are an implicit
+parameter of every program.
+
+@cindex Object table
+In order to handle such bindings, each program has an @dfn{object
+table} associated to it.  This table (actually a vector) contains all
+the variable objects corresponding to the external bindings referenced
+by the program.  The object table of a program is initialized right
+before a program is loaded and run with @var{load-program}.
+
+Therefore, external bindings only need to be looked up once before the
+program is loaded.  References to the corresponding external variables
+from within the program are then performed via the @var{object-ref}
+instruction and are almost as fast as local variable references.
+
+Let us consider the following program (procedure) which references
+external bindings @code{frob} and @var{%magic}:
+
+@example
+(lambda (x)
+  (frob x %magic))
+@end example
+
+This yields the following assembly code:
+
+@example
+(make-int8 64)   ;; number of args, vars, etc. (see below)
+(link "frob")
+(link "%magic")
+(vector 2)
+...
+(load-program #u8(20 0 23 21 0 20 1 23 36 2))
+(return)
+@end example
+
+All the instructions occurring before @var{load-program} (some were
+omitted for simplicity) form a @dfn{prologue} which, among other
+things, pushed an object table (a vector) that contains the variable
+objects for the variables bound to @var{frob} and @var{%magic}.  This
+vector and other data pushed onto the stack are then popped by the
+@var{load-program} instruction.
+
+Besides, the @var{load-program} instruction takes one explicit
+argument which is the bytecode of the program itself.  Disassembled,
+this bytecode looks like:
+
+@example
+(object-ref 0)  ;; push the variable object of `frob'
+(variable-ref)  ;; dereference it
+(local-ref 0)   ;; push the value of `x'
+(object-ref 1)  ;; push the variable object of `%magic'
+(variable-ref)  ;; dereference it
+(tail-call 2)   ;; call `frob' with two parameters
+@end example
+
+This clearly shows that there is little difference between references
+to local variables and references to externally bound variables.
+
+@deffn @insn{} load-program bytecode
+Load the program whose bytecode is @var{bytecode} (a u8vector) and pop
+its meta-information from the stack.  The program's meta-information
+may consist of (in the order in which it should be pushed onto the
+stack):
 
 @itemize
-@item %make-program
-@item %call
-@item %return
+@item optionally, a pair representing meta-data (see the
+@var{program-meta} procedure); [FIXME: explain their meaning]
+@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
+the number of arguments taken by the function (@var{nargs}), the
+number of @dfn{rest arguments} (@var{nrest}, 0 or 1), the number of
+local variables (@var{nlocs}) and the number of external variables
+(@var{nexts}) (see the example above).
 @end itemize
 
-@section Data control instructinos
+In the end, push a program object onto the stack.
+
+@end deffn
+
+@deffn @insn{} object-ref offset
+Push the variable object for the external variable located at
+@var{offset} within the program's object table.
+@end deffn
+
+@deffn @insn{} return
+Free the program's frame.
+@end deffn
+
+
+@node Data Control Instructions,  , Subprogram Control Instructions, Instruction Set
+@section Data Control Instructions
+
+@deffn @insn{} make-int8 value
+Push @var{value}, an 8-bit integer, onto the stack.
+@end deffn
+
+@deffn @insn{} make-int8:0
+Push the immediate value @code{0} onto the stack.
+@end deffn
+
+@deffn @insn{} make-int8:1
+Push the immediate value @code{1} onto the stack.
+@end deffn
+
+@deffn @insn{} make-false
+Push @code{#f} onto the stack.
+@end deffn
+
+@deffn @insn{} make-true
+Push @code{#t} onto the stack.
+@end deffn
 
 @itemize
 @item %push
@@ -558,3 +716,5 @@ letter `%'.
 @c mode:outline-minor
 @c outline-regexp:"@\\(ch\\|sec\\|subs\\)"
 @c End:
+
+@c  LocalWords:  bytecode
diff --git a/module/system/vm/assemble.scm b/module/system/vm/assemble.scm
index 3df82c9dc..bc4db91b0 100644
--- a/module/system/vm/assemble.scm
+++ b/module/system/vm/assemble.scm
@@ -258,7 +258,7 @@
 	(($ number)
 	 (push-code! `(load-number ,(number->string x))))
 	(($ string)
-	 (push-code! `(load-string ,(string->string x))))
+	 (push-code! `(load-string ,x)))
 	(($ symbol)
 	 (push-code! `(load-symbol ,(symbol->string x))))
 	(($ keyword)
diff --git a/src/programs.c b/src/programs.c
index 111f87f66..d45cd96dd 100644
--- a/src/programs.c
+++ b/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_MAKINUM (p->nargs),
-		    SCM_MAKINUM (p->nrest),
-		    SCM_MAKINUM (p->nlocs),
-		    SCM_MAKINUM (p->nexts));
+  return SCM_LIST4 (scm_from_uchar (p->nargs),
+		    scm_from_uchar (p->nrest),
+		    scm_from_uchar (p->nlocs),
+		    scm_from_uchar (p->nexts));
 }
 #undef FUNC_NAME
 
diff --git a/src/vm.c b/src/vm.c
index 36bd9e6ee..8a826ef41 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -369,7 +369,7 @@ SCM_DEFINE (scm_vm_fp, "vm:fp", 1, 0, 0,
   SCM_VALIDATE_VM (1, vm);				\
   vp = SCM_VM_DATA (vm);				\
   if (SCM_FALSEP (vp->hooks[n]))			\
-    vp->hooks[n] = scm_make_hook (SCM_MAKINUM (1));	\
+    vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));	\
   return vp->hooks[n];					\
 }
 
@@ -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_MAKINUM (ip[i]), list);
+    list = scm_cons (scm_from_uint8 (ip[i]), list);
   return scm_reverse_x (list, SCM_EOL);
 }
 #undef FUNC_NAME
diff --git a/src/vm_engine.c b/src/vm_engine.c
index c275cfb02..21b8468ef 100644
--- a/src/vm_engine.c
+++ b/src/vm_engine.c
@@ -43,6 +43,7 @@
 
 #include "vm_engine.h"
 
+
 static SCM
 vm_run (SCM vm, SCM program, SCM args)
 #define FUNC_NAME "vm-engine"
diff --git a/src/vm_engine.h b/src/vm_engine.h
index c4ce6b40f..745b68972 100644
--- a/src/vm_engine.h
+++ b/src/vm_engine.h
@@ -130,10 +130,20 @@
   vp->fp = fp;					\
 }
 
-#define CACHE_PROGRAM()				\
-{						\
-  bp = SCM_PROGRAM_DATA (program);		\
-  objects = SCM_VELTS (bp->objs);		\
+/* Get a local copy of the program's "object table" (i.e. the vector of
+   external bindings that are referenced by the program), initialized by
+   `load-program'.  */
+#define CACHE_PROGRAM()					\
+{							\
+  size_t _vsize;					\
+  ssize_t _vincr;					\
+  scm_t_array_handle _vhandle;				\
+							\
+  bp = SCM_PROGRAM_DATA (program);			\
+  /* Was: objects = SCM_VELTS (bp->objs); */		\
+  objects = scm_vector_elements (bp->objs, &_vhandle,	\
+				 &_vsize, &_vincr);	\
+  scm_array_handle_release (&_vhandle);			\
 }
 
 #define SYNC_BEFORE_GC()			\
@@ -208,12 +218,8 @@
 
 #define CONS(x,y,z)				\
 {						\
-  SCM cell;					\
   SYNC_BEFORE_GC ();				\
-  SCM_NEWCELL (cell);				\
-  SCM_SET_CELL_OBJECT_0 (cell, y);		\
-  SCM_SET_CELL_OBJECT_1 (cell, z);		\
-  x = cell;					\
+  x = scm_cons (y, z);				\
 }
 
 #define POP_LIST(n)				\
diff --git a/src/vm_loader.c b/src/vm_loader.c
index fb30b54ee..6516b36c5 100644
--- a/src/vm_loader.c
+++ b/src/vm_loader.c
@@ -130,7 +130,7 @@ VM_DEFINE_LOADER (load_program, "load-program")
     }
 
   /* init object table */
-  if (SCM_VECTORP (x))
+  if (scm_is_vector (x))
     {
       p->objs = x;
       POP (x);
@@ -178,7 +178,7 @@ VM_DEFINE_LOADER (link, "link")
   size_t len;
 
   FETCH_LENGTH (len);
-  sym = scm_mem2symbol (ip, len);
+  sym = scm_from_locale_symboln (ip, len);
   ip += len;
 
 #if 0
@@ -193,7 +193,7 @@ VM_DEFINE_LOADER (link, "link")
       /* Create a new variable if not defined yet */
       var = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
 				     sym, SCM_BOOL_T);
-    PUSH (scm_variable_ref (var));
+    PUSH (var);
     /* Was: SCM_VARVCELL (var)); */
     NEXT;
   }
diff --git a/src/vm_system.c b/src/vm_system.c
index 894c74643..9b4522747 100644
--- a/src/vm_system.c
+++ b/src/vm_system.c
@@ -119,19 +119,19 @@ VM_DEFINE_INSTRUCTION (make_eol, "make-eol", 0, 0, 1)
 
 VM_DEFINE_INSTRUCTION (make_int8, "make-int8", 1, 0, 1)
 {
-  PUSH (SCM_MAKINUM ((signed char) FETCH ()));
+  PUSH (scm_from_schar ((signed char) FETCH ()));
   NEXT;
 }
 
 VM_DEFINE_INSTRUCTION (make_int8_0, "make-int8:0", 0, 0, 1)
 {
-  PUSH (SCM_MAKINUM (0));
+  PUSH (SCM_INUM0);
   NEXT;
 }
 
 VM_DEFINE_INSTRUCTION (make_int8_1, "make-int8:1", 0, 0, 1)
 {
-  PUSH (SCM_MAKINUM (1));
+  PUSH (SCM_I_MAKINUM (1));
   NEXT;
 }
 
@@ -139,7 +139,7 @@ VM_DEFINE_INSTRUCTION (make_int16, "make-int16", 2, 0, 1)
 {
   int h = FETCH ();
   int l = FETCH ();
-  PUSH (SCM_MAKINUM ((signed short) (h << 8) + l));
+  PUSH (scm_from_short ((signed short) (h << 8) + l));
   NEXT;
 }
 
@@ -197,8 +197,8 @@ 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)
-#define VARIABLE_SET(v,o)	SCM_SETCDR (v, o)
+/* #define VARIABLE_REF(v)		SCM_CDR (v) */
+/* #define VARIABLE_SET(v,o)	SCM_SETCDR (v, o) */
 
 /* ref */
 
@@ -231,13 +231,19 @@ VM_DEFINE_INSTRUCTION (external_ref, "external-ref", 1, 0, 1)
 VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
 {
   SCM x = *sp;
-  SCM o = VARIABLE_REF (x);
-  if (SCM_UNBNDP (o))
+
+  if (SCM_FALSEP (scm_variable_bound_p (x)))
     {
-      err_args = SCM_LIST1 (SCM_CAR (x));
+      err_args = SCM_LIST1 (x);
+      /* Was: err_args = SCM_LIST1 (SCM_CAR (x)); */
       goto vm_error_unbound;
     }
-  *sp = o;
+  else
+    {
+      SCM o = scm_variable_ref (x);
+      *sp = o;
+    }
+
   NEXT;
 }
 
@@ -267,7 +273,7 @@ VM_DEFINE_INSTRUCTION (external_set, "external-set", 1, 1, 0)
 
 VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
 {
-  VARIABLE_SET (sp[0], sp[-1]);
+  scm_variable_set_x (sp[0], sp[-1]);
   scm_set_object_property_x (sp[-1], scm_sym_name, SCM_CAR (sp[0]));
   sp -= 2;
   NEXT;