1 /* Copyright (C) 2001,2008,2009,2010,2011,2012 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 (101, load_number
, "load-number")
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)); */
36 VM_DEFINE_LOADER (102, load_string
, "load-string")
43 PUSH (scm_i_make_string (len
, &buf
, 1));
44 memcpy (buf
, (char *) ip
, len
);
49 VM_DEFINE_LOADER (103, load_symbol
, "load-symbol")
54 /* FIXME: should be scm_from_latin1_symboln */
55 PUSH (scm_from_latin1_symboln ((const char*)ip
, len
));
60 VM_DEFINE_LOADER (104, load_program
, "load-program")
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 ());
71 objcode
= scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp
[-1]), ip
);
72 len
= sizeof (struct scm_objcode
) + SCM_OBJCODE_TOTAL_LEN (objcode
);
74 PUSH (scm_make_program (objcode
, objs
, SCM_BOOL_F
));
81 VM_DEFINE_INSTRUCTION (105, link_now
, "link-now", 0, 1, 1)
86 PUSH (resolve_variable (what
, scm_current_module ()));
90 VM_DEFINE_LOADER (106, load_array
, "load-array")
97 PUSH (scm_from_contiguous_typed_array (type
, shape
, ip
, len
));
102 VM_DEFINE_LOADER (107, load_wide_string
, "load-wide-string")
108 VM_ASSERT ((len
% 4) == 0,
109 vm_error_bad_wide_string_length (len
));
112 PUSH (scm_i_make_wide_string (len
/ 4, &wbuf
, 1));
113 memcpy ((char *) wbuf
, (char *) ip
, len
);
119 (defun renumber-ops ()
120 "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
123 (let ((counter 100)) (goto-char (point-min))
124 (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
126 (number-to-string (setq counter (1+ counter)))