summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorAndy Wingo <wingo@oblong.net>2009-08-12 16:33:49 +0200
committerAndy Wingo <wingo@oblong.net>2009-08-12 16:34:05 +0200
commit94ff26b96b555f0263fab2221cd55801119ffddd (patch)
tree6911dde6ef41d2b87eb9cfa6b857e7692bc21ac1 /libguile
parent6cf48307989d2552f2215ef8406ea92745d2d3e9 (diff)
downloadguile-94ff26b96b555f0263fab2221cd55801119ffddd.tar.gz
rework the vm support for wide strings
* libguile/_scm.h (SCM_OBJCODE_MINOR_VERSION): Bump. * libguile/vm-engine.c (vm_error_bad_wide_string_length): New error case. * libguile/vm-i-loader.c (load-unsigned-integer, load-integer) (load-keyword): Remove these instructions. The former two are obsoleted by make-int64/make-uint64, the latter via make-keyword. (load-string): Only handle narrow strings. (load-symbol): Only handle narrow symbols. The wide case is handled via make-symbol. (load-wide-string): New instruction, for wide strings. * libguile/vm-i-system.c (define): Move here from loaders.c, as now it just takes a sym on the stack. (make-keyword, make-symbol): New instructions. * module/language/assembly.scm: Remove removed instructions. No more width byte in load-string etc. * module/language/assembly/compile-bytecode.scm (write-bytecode): Adapt to change in instruction set. * module/language/glil/compile-assembly.scm (glil->assembly): Compile define by pushing the sym then emitting (define). (dump-object): Dump narrow and wide strings differently. Use make-keyword and make-symbol as appropriate. * module/language/tree-il/compile-glil.scm (flatten): When compiling a ref to a primitive (not a call), first see if the primitive is actually bound in the root module. (That's not the case with e.g. bytevector-u8-ref). * module/system/xref.scm (program-callee-rev-vars): Don't parse out "nexts". * test-suite/tests/asm-to-bytecode.test ("compiler"): Adapt to bytecode format change.
Diffstat (limited to 'libguile')
-rw-r--r--libguile/_scm.h2
-rw-r--r--libguile/vm-engine.c4
-rw-r--r--libguile/vm-i-loader.c153
-rw-r--r--libguile/vm-i-system.c28
4 files changed, 56 insertions, 131 deletions
diff --git a/libguile/_scm.h b/libguile/_scm.h
index ff16a8587..737e01edd 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -172,7 +172,7 @@
// major and minor versions must be single characters
#define SCM_OBJCODE_MAJOR_VERSION 0
-#define SCM_OBJCODE_MINOR_VERSION A
+#define SCM_OBJCODE_MINOR_VERSION B
#define SCM_OBJCODE_MAJOR_VERSION_STRING \
SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
#define SCM_OBJCODE_MINOR_VERSION_STRING \
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 98a6e491b..b0888c1ec 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -220,6 +220,10 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
finish_args = SCM_EOL;
goto vm_error;
+ vm_error_bad_wide_string_length:
+ err_msg = scm_from_locale_string ("VM: Bad wide string length: ~S");
+ goto vm_error;
+
#if VM_CHECK_IP
vm_error_invalid_address:
err_msg = scm_from_locale_string ("VM: Invalid program address");
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 8de7f0036..e242ef9bf 100644
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -20,42 +20,6 @@
/* This file is included in vm_engine.c */
-VM_DEFINE_LOADER (80, load_unsigned_integer, "load-unsigned-integer")
-{
- size_t len;
-
- FETCH_LENGTH (len);
- if (SCM_LIKELY (len <= 8))
- {
- scm_t_uint64 val = 0;
- while (len-- > 0)
- val = (val << 8U) + FETCH ();
- SYNC_REGISTER ();
- PUSH (scm_from_uint64 (val));
- NEXT;
- }
- else
- SCM_MISC_ERROR ("load-unsigned-integer: not implemented yet", SCM_EOL);
-}
-
-VM_DEFINE_LOADER (81, load_integer, "load-integer")
-{
- size_t len;
-
- FETCH_LENGTH (len);
- if (SCM_LIKELY (len <= 4))
- {
- int val = 0;
- while (len-- > 0)
- val = (val << 8) + FETCH ();
- SYNC_REGISTER ();
- PUSH (scm_from_int (val));
- NEXT;
- }
- else
- SCM_MISC_ERROR ("load-integer: not implemented yet", SCM_EOL);
-}
-
VM_DEFINE_LOADER (82, load_number, "load-number")
{
size_t len;
@@ -72,82 +36,24 @@ VM_DEFINE_LOADER (82, load_number, "load-number")
VM_DEFINE_LOADER (83, load_string, "load-string")
{
size_t len;
- int width;
- SCM str;
+ char *buf;
FETCH_LENGTH (len);
- FETCH_WIDTH (width);
SYNC_REGISTER ();
- if (width == 1)
- {
- char *buf;
- str = scm_i_make_string (len, &buf);
- memcpy (buf, (char *) ip, len);
- }
- else if (width == 4)
- {
- scm_t_wchar *wbuf;
- str = scm_i_make_wide_string (len, &wbuf);
- memcpy ((char *) wbuf, (char *) ip, len * width);
- }
- else
- SCM_MISC_ERROR ("load-string: invalid character width", SCM_EOL);
- PUSH (str);
- ip += len * width;
+ PUSH (scm_i_make_string (len, &buf));
+ memcpy (buf, (char *) ip, len);
+ ip += len;
NEXT;
}
VM_DEFINE_LOADER (84, load_symbol, "load-symbol")
{
size_t len;
- int width;
- SCM str;
- FETCH_LENGTH (len);
- FETCH_WIDTH (width);
- SYNC_REGISTER ();
- if (width == 1)
- {
- char *buf;
- str = scm_i_make_string (len, &buf);
- memcpy (buf, (char *) ip, len);
- }
- else if (width == 4)
- {
- scm_t_wchar *wbuf;
- str = scm_i_make_wide_string (len, &wbuf);
- memcpy ((char *) wbuf, (char *) ip, len * width);
- }
- else
- SCM_MISC_ERROR ("load-symbol: invalid character width", SCM_EOL);
- PUSH (scm_string_to_symbol (str));
- ip += len * width;
- NEXT;
-}
-
-VM_DEFINE_LOADER (85, load_keyword, "load-keyword")
-{
- size_t len;
- int width;
- SCM str;
FETCH_LENGTH (len);
- FETCH_WIDTH (width);
SYNC_REGISTER ();
- if (width == 1)
- {
- char *buf;
- str = scm_i_make_string (len, &buf);
- memcpy (buf, (char *) ip, len);
- }
- else if (width == 4)
- {
- scm_t_wchar *wbuf;
- str = scm_i_make_wide_string (len, &wbuf);
- memcpy ((char *) wbuf, (char *) ip, len * width);
- }
- else
- SCM_MISC_ERROR ("load-keyword: invalid character width", SCM_EOL);
- PUSH (scm_symbol_to_keyword (scm_string_to_symbol (str)));
- ip += len * width;
+ /* FIXME: should be scm_from_latin1_symboln */
+ PUSH (scm_from_locale_symboln ((const char*)ip, len));
+ ip += len;
NEXT;
}
@@ -181,46 +87,33 @@ VM_DEFINE_INSTRUCTION (87, link_now, "link-now", 0, 1, 1)
NEXT;
}
-VM_DEFINE_LOADER (88, define, "define")
+VM_DEFINE_LOADER (89, load_array, "load-array")
{
- SCM str, sym;
+ SCM type, shape;
size_t len;
-
- int width;
FETCH_LENGTH (len);
- FETCH_WIDTH (width);
- SYNC_REGISTER ();
- if (width == 1)
- {
- char *buf;
- str = scm_i_make_string (len, &buf);
- memcpy (buf, (char *) ip, len);
- }
- else if (width == 4)
- {
- scm_t_wchar *wbuf;
- str = scm_i_make_wide_string (len, &wbuf);
- memcpy ((char *) wbuf, (char *) ip, len * width);
- }
- else
- SCM_MISC_ERROR ("load define: invalid character width", SCM_EOL);
- sym = scm_string_to_symbol (str);
- ip += len * width;
-
+ POP (shape);
+ POP (type);
SYNC_REGISTER ();
- PUSH (scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T));
+ PUSH (scm_from_contiguous_typed_array (type, shape, ip, len));
+ ip += len;
NEXT;
}
-VM_DEFINE_LOADER (89, load_array, "load-array")
+VM_DEFINE_LOADER (90, load_wide_string, "load-wide-string")
{
- SCM type, shape;
size_t len;
+ scm_t_wchar *wbuf;
+
FETCH_LENGTH (len);
- POP (shape);
- POP (type);
+ if (SCM_UNLIKELY (len % 4))
+ { finish_args = scm_list_1 (scm_from_size_t (len));
+ goto vm_error_bad_wide_string_length;
+ }
+
SYNC_REGISTER ();
- PUSH (scm_from_contiguous_typed_array (type, shape, ip, len));
+ PUSH (scm_i_make_wide_string (len / 4, &wbuf));
+ memcpy ((char *) wbuf, (char *) ip, len);
ip += len;
NEXT;
}
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 9604ce55a..b298c88a6 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1246,6 +1246,34 @@ VM_DEFINE_INSTRUCTION (65, fix_closure, "fix-closure", 2, 0, 1)
NEXT;
}
+VM_DEFINE_INSTRUCTION (66, define, "define", 0, 0, 2)
+{
+ SCM sym, val;
+ POP (sym);
+ POP (val);
+ SYNC_REGISTER ();
+ VARIABLE_SET (scm_sym2var (sym, scm_current_module_lookup_closure (),
+ SCM_BOOL_T),
+ val);
+ NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (67, make_keyword, "make-keyword", 0, 1, 1)
+{
+ CHECK_UNDERFLOW ();
+ SYNC_REGISTER ();
+ *sp = scm_symbol_to_keyword (*sp);
+ NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (68, make_symbol, "make-symbol", 0, 1, 1)
+{
+ CHECK_UNDERFLOW ();
+ SYNC_REGISTER ();
+ *sp = scm_string_to_symbol (*sp);
+ NEXT;
+}
+
/*
(defun renumber-ops ()