| 1 | /* Copyright (C) 2001,2008,2009,2010 Free Software Foundation, Inc. |
| 2 | * |
| 3 | * This library is free software; you can redistribute it and/or |
| 4 | * modify it under the terms of the GNU Lesser General Public License |
| 5 | * as published by the Free Software Foundation; either version 3 of |
| 6 | * the License, or (at your option) any later version. |
| 7 | * |
| 8 | * This library is distributed in the hope that it will be useful, but |
| 9 | * WITHOUT ANY WARRANTY; without even the implied warranty of |
| 10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 11 | * Lesser General Public License for more details. |
| 12 | * |
| 13 | * You should have received a copy of the GNU Lesser General Public |
| 14 | * License along with this library; if not, write to the Free Software |
| 15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
| 16 | * 02110-1301 USA |
| 17 | */ |
| 18 | |
| 19 | /* FIXME! Need to check that the fetch is within the current program */ |
| 20 | |
| 21 | /* This file is included in vm_engine.c */ |
| 22 | |
| 23 | VM_DEFINE_LOADER (101, load_number, "load-number") |
| 24 | { |
| 25 | size_t len; |
| 26 | |
| 27 | FETCH_LENGTH (len); |
| 28 | SYNC_REGISTER (); |
| 29 | PUSH (scm_string_to_number (scm_from_locale_stringn ((char *)ip, len), |
| 30 | SCM_UNDEFINED /* radix = 10 */)); |
| 31 | /* Was: scm_istring2number (ip, len, 10)); */ |
| 32 | ip += len; |
| 33 | NEXT; |
| 34 | } |
| 35 | |
| 36 | VM_DEFINE_LOADER (102, load_string, "load-string") |
| 37 | { |
| 38 | size_t len; |
| 39 | char *buf; |
| 40 | |
| 41 | FETCH_LENGTH (len); |
| 42 | SYNC_REGISTER (); |
| 43 | PUSH (scm_i_make_string (len, &buf)); |
| 44 | memcpy (buf, (char *) ip, len); |
| 45 | ip += len; |
| 46 | NEXT; |
| 47 | } |
| 48 | |
| 49 | VM_DEFINE_LOADER (103, load_symbol, "load-symbol") |
| 50 | { |
| 51 | size_t len; |
| 52 | FETCH_LENGTH (len); |
| 53 | SYNC_REGISTER (); |
| 54 | /* FIXME: should be scm_from_latin1_symboln */ |
| 55 | PUSH (scm_from_locale_symboln ((const char*)ip, len)); |
| 56 | ip += len; |
| 57 | NEXT; |
| 58 | } |
| 59 | |
| 60 | VM_DEFINE_LOADER (104, load_program, "load-program") |
| 61 | { |
| 62 | scm_t_uint32 len; |
| 63 | SCM objs, objcode; |
| 64 | |
| 65 | POP (objs); |
| 66 | SYNC_REGISTER (); |
| 67 | |
| 68 | if (scm_is_vector (objs) && scm_is_false (scm_c_vector_ref (objs, 0))) |
| 69 | scm_c_vector_set_x (objs, 0, scm_current_module ()); |
| 70 | |
| 71 | objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip); |
| 72 | len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode); |
| 73 | |
| 74 | PUSH (scm_make_program (objcode, objs, SCM_BOOL_F)); |
| 75 | |
| 76 | ip += len; |
| 77 | |
| 78 | NEXT; |
| 79 | } |
| 80 | |
| 81 | VM_DEFINE_INSTRUCTION (105, link_now, "link-now", 0, 1, 1) |
| 82 | { |
| 83 | SCM what; |
| 84 | POP (what); |
| 85 | SYNC_REGISTER (); |
| 86 | PUSH (resolve_variable (what, scm_current_module ())); |
| 87 | NEXT; |
| 88 | } |
| 89 | |
| 90 | VM_DEFINE_LOADER (106, load_array, "load-array") |
| 91 | { |
| 92 | SCM type, shape; |
| 93 | size_t len; |
| 94 | FETCH_LENGTH (len); |
| 95 | POP (shape); |
| 96 | POP (type); |
| 97 | SYNC_REGISTER (); |
| 98 | PUSH (scm_from_contiguous_typed_array (type, shape, ip, len)); |
| 99 | ip += len; |
| 100 | NEXT; |
| 101 | } |
| 102 | |
| 103 | VM_DEFINE_LOADER (107, load_wide_string, "load-wide-string") |
| 104 | { |
| 105 | size_t len; |
| 106 | scm_t_wchar *wbuf; |
| 107 | |
| 108 | FETCH_LENGTH (len); |
| 109 | if (SCM_UNLIKELY (len % 4)) |
| 110 | { |
| 111 | finish_args = scm_list_1 (scm_from_size_t (len)); |
| 112 | goto vm_error_bad_wide_string_length; |
| 113 | } |
| 114 | |
| 115 | SYNC_REGISTER (); |
| 116 | PUSH (scm_i_make_wide_string (len / 4, &wbuf)); |
| 117 | memcpy ((char *) wbuf, (char *) ip, len); |
| 118 | ip += len; |
| 119 | NEXT; |
| 120 | } |
| 121 | |
| 122 | /* |
| 123 | (defun renumber-ops () |
| 124 | "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences" |
| 125 | (interactive "") |
| 126 | (save-excursion |
| 127 | (let ((counter 100)) (goto-char (point-min)) |
| 128 | (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t) |
| 129 | (replace-match |
| 130 | (number-to-string (setq counter (1+ counter))) |
| 131 | t t nil 1))))) |
| 132 | */ |
| 133 | |
| 134 | /* |
| 135 | Local Variables: |
| 136 | c-file-style: "gnu" |
| 137 | End: |
| 138 | */ |