X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/9c44cd4559a5d04ba70bbd9ff47f41bfdfebd09d..26d148066f9cb20e395a7dc4fefdf2e2ef0b2fb0:/libguile/vm-i-loader.c diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c index 8de7f0036..c3231568e 100644 --- a/libguile/vm-i-loader.c +++ b/libguile/vm-i-loader.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001,2008,2009 Free Software Foundation, Inc. +/* Copyright (C) 2001,2008,2009,2010,2011,2012 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 @@ -20,43 +20,7 @@ /* 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") +VM_DEFINE_LOADER (101, load_number, "load-number") { size_t len; @@ -69,89 +33,31 @@ VM_DEFINE_LOADER (82, load_number, "load-number") NEXT; } -VM_DEFINE_LOADER (83, load_string, "load-string") +VM_DEFINE_LOADER (102, 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; - 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; + PUSH (scm_i_make_string (len, &buf, 1)); + memcpy (buf, (char *) ip, len); + ip += len; NEXT; } -VM_DEFINE_LOADER (85, load_keyword, "load-keyword") +VM_DEFINE_LOADER (103, 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-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_latin1_symboln ((const char*)ip, len)); + ip += len; NEXT; } -VM_DEFINE_LOADER (86, load_program, "load-program") +VM_DEFINE_LOADER (104, load_program, "load-program") { scm_t_uint32 len; SCM objs, objcode; @@ -172,7 +78,7 @@ VM_DEFINE_LOADER (86, load_program, "load-program") NEXT; } -VM_DEFINE_INSTRUCTION (87, link_now, "link-now", 0, 1, 1) +VM_DEFINE_INSTRUCTION (105, link_now, "link-now", 0, 1, 1) { SCM what; POP (what); @@ -181,46 +87,30 @@ VM_DEFINE_INSTRUCTION (87, link_now, "link-now", 0, 1, 1) NEXT; } -VM_DEFINE_LOADER (88, define, "define") +VM_DEFINE_LOADER (106, load_array, "load-array") { - SCM str, sym; + SCM type, shape; size_t len; - - int width; FETCH_LENGTH (len); - FETCH_WIDTH (width); + POP2 (shape, type); 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; - - 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 (107, load_wide_string, "load-wide-string") { - SCM type, shape; size_t len; + scm_t_wchar *wbuf; + FETCH_LENGTH (len); - POP (shape); - POP (type); + VM_ASSERT ((len % 4) == 0, + vm_error_bad_wide_string_length (len)); + SYNC_REGISTER (); - PUSH (scm_from_contiguous_typed_array (type, shape, ip, len)); + PUSH (scm_i_make_wide_string (len / 4, &wbuf, 1)); + memcpy ((char *) wbuf, (char *) ip, len); ip += len; NEXT; } @@ -230,7 +120,7 @@ VM_DEFINE_LOADER (89, load_array, "load-array") "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences" (interactive "") (save-excursion - (let ((counter 79)) (goto-char (point-min)) + (let ((counter 100)) (goto-char (point-min)) (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t) (replace-match (number-to-string (setq counter (1+ counter)))