1 /* Copyright (C) 2001,2008,2009 Free Software Foundation, Inc.
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.
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.
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
19 /* FIXME! Need to check that the fetch is within the current program */
21 /* This file is included in vm_engine.c */
23 VM_DEFINE_LOADER (80, load_unsigned_integer
, "load-unsigned-integer")
28 if (SCM_LIKELY (len
<= 8))
32 val
= (val
<< 8U) + FETCH ();
34 PUSH (scm_from_uint64 (val
));
38 SCM_MISC_ERROR ("load-unsigned-integer: not implemented yet", SCM_EOL
);
41 VM_DEFINE_LOADER (81, load_integer
, "load-integer")
46 if (SCM_LIKELY (len
<= 4))
50 val
= (val
<< 8) + FETCH ();
52 PUSH (scm_from_int (val
));
56 SCM_MISC_ERROR ("load-integer: not implemented yet", SCM_EOL
);
59 VM_DEFINE_LOADER (82, load_number
, "load-number")
65 PUSH (scm_string_to_number (scm_from_locale_stringn ((char *)ip
, len
),
66 SCM_UNDEFINED
/* radix = 10 */));
67 /* Was: scm_istring2number (ip, len, 10)); */
72 VM_DEFINE_LOADER (83, load_string
, "load-string")
84 str
= scm_i_make_string (len
, &buf
);
85 memcpy (buf
, (char *) ip
, len
);
90 str
= scm_i_make_wide_string (len
, &wbuf
);
91 memcpy ((char *) wbuf
, (char *) ip
, len
* width
);
94 SCM_MISC_ERROR ("load-string: invalid character width", SCM_EOL
);
100 VM_DEFINE_LOADER (84, load_symbol
, "load-symbol")
111 str
= scm_i_make_string (len
, &buf
);
112 memcpy (buf
, (char *) ip
, len
);
117 str
= scm_i_make_wide_string (len
, &wbuf
);
118 memcpy ((char *) wbuf
, (char *) ip
, len
* width
);
121 SCM_MISC_ERROR ("load-symbol: invalid character width", SCM_EOL
);
122 PUSH (scm_string_to_symbol (str
));
127 VM_DEFINE_LOADER (85, load_keyword
, "load-keyword")
138 str
= scm_i_make_string (len
, &buf
);
139 memcpy (buf
, (char *) ip
, len
);
144 str
= scm_i_make_wide_string (len
, &wbuf
);
145 memcpy ((char *) wbuf
, (char *) ip
, len
* width
);
148 SCM_MISC_ERROR ("load-keyword: invalid character width", SCM_EOL
);
149 PUSH (scm_symbol_to_keyword (scm_string_to_symbol (str
)));
154 VM_DEFINE_LOADER (86, load_program
, "load-program")
162 if (scm_is_vector (objs
) && scm_is_false (scm_c_vector_ref (objs
, 0)))
163 scm_c_vector_set_x (objs
, 0, scm_current_module ());
165 objcode
= scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp
[-1]), ip
);
166 len
= sizeof (struct scm_objcode
) + SCM_OBJCODE_TOTAL_LEN (objcode
);
168 PUSH (scm_make_program (objcode
, objs
, SCM_BOOL_F
));
175 VM_DEFINE_INSTRUCTION (87, link_now
, "link-now", 0, 1, 1)
180 PUSH (resolve_variable (what
, scm_current_module ()));
184 VM_DEFINE_LOADER (88, define
, "define")
196 str
= scm_i_make_string (len
, &buf
);
197 memcpy (buf
, (char *) ip
, len
);
202 str
= scm_i_make_wide_string (len
, &wbuf
);
203 memcpy ((char *) wbuf
, (char *) ip
, len
* width
);
206 SCM_MISC_ERROR ("load define: invalid character width", SCM_EOL
);
207 sym
= scm_string_to_symbol (str
);
211 PUSH (scm_sym2var (sym
, scm_current_module_lookup_closure (), SCM_BOOL_T
));
215 VM_DEFINE_LOADER (89, load_array
, "load-array")
223 PUSH (scm_from_contiguous_typed_array (type
, shape
, ip
, len
));
229 (defun renumber-ops ()
230 "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
233 (let ((counter 79)) (goto-char (point-min))
234 (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
236 (number-to-string (setq counter (1+ counter)))