Encode the length of constant lists/vectors on 2 octets instead of 1.

* module/system/vm/assemble.scm (dump-object!): New sub-procedure
  `too-long'.  For `list' and `vector', encode the length on 2 octets
  instead of 1 and report an error if a list/vector is longer than 65535.

* module/system/vm/disasm.scm (original-value): New sub-procedure
  `list-or-vector?'; when true, return the number of elements for that
  list/vector.

* src/vm_system.c (list): Fetch the length as a two-octet integer.
  (vector): Likewise.

* testsuite/t-basic-contructs.scm: New.

* testsuite/Makefile.am (vm_test_files): Added the above file.

* module/system/vm/core.scm (load-compiled): Added a bit of
  documentation.

git-archimport-id: lcourtes@laas.fr--2005-mobile/guile-vm--mobile--0.6--patch-11

module/system/vm/assemble.scm

@@ -213,9 +213,12 @@
 ;;; Object dump
 ;;;
 
-;; NOTE: undumpped in vm_load.c.
+;; NOTE: undumpped in vm_system.c
 
 (define (dump-object! push-code! x)
+  (define (too-long x)
+    (error (string-append x " too long")))
+
   (let dump! ((x x))
     (cond
      ((object->code x) => push-code!)
@@ -269,13 +272,17 @@
 		       ,(symbol->string (keyword-dash-symbol x)))))
 	(($ list)
 	 (for-each dump! x)
-	 (push-code! `(list ,(length x))))
+	 (let ((len (length x)))
+	   (if (>= len 65536) (too-long 'list))
+	   (push-code! `(list ,(quotient len 256) ,(modulo len 256)))))
 	(($ pair)
 	 (dump! (car x))
 	 (dump! (cdr x))
 	 (push-code! `(cons)))
 	(($ vector)
 	 (for-each dump! (vector->list x))
-	 (push-code! `(vector ,(vector-length x))))
+	 (let ((len (vector-length x)))
+	   (if (>= len 65536) (too-long 'vector))
+	   (push-code! `(vector ,(quotient len 256) ,(modulo len 256)))))
 	(else
 	 (error "assemble: unrecognized object" x)))))))

module/system/vm/core.scm

@@ -163,4 +163,6 @@
 (define-public (vm-load vm objcode)
   (vm (objcode->program objcode)))
 
+;; `load-compiled' is referred to by `boot-9.scm' and used by `use-modules'
+;; and friends.
 (set! load-compiled (lambda (file) (vm-load (the-vm) (load-objcode file))))

module/system/vm/disasm.scm

@@ -113,8 +113,16 @@
 (define (original-value addr code objs)
   (define (branch-code? code)
     (string-match "^br" (symbol->string (car code))))
+  (define (list-or-vector? code)
+    (case (car code)
+      ((list vector) #t)
+      (else #f)))
+
   (let ((code (code-unpack code)))
-    (cond ((code->object code) => object->string)
+    (cond ((list-or-vector? code)
+	   (let ((len (+ (* (cadr code) 256) (caddr code))))
+	     (format #f "~a element~a" len (if (> len 1) "s" ""))))
+	  ((code->object code) => object->string)
 	  ((branch-code? code)
 	   (let ((offset (+ (* (cadr code) 256) (caddr code))))
 	     (format #f "-> ~A" (+ addr offset 3))))