Commit | Line | Data |
---|---|---|
53e28ed9 | 1 | /* Copyright (C) 2001,2008,2009 Free Software Foundation, Inc. |
17e90c5e | 2 | * |
53e28ed9 AW |
3 | * This library is free software; you can redistribute it and/or |
4 | * modify it under the terms of the GNU Lesser General Public | |
5 | * License as published by the Free Software Foundation; either | |
6 | * version 2.1 of the License, or (at your option) any later version. | |
17e90c5e | 7 | * |
53e28ed9 AW |
8 | * This library is distributed in the hope that it will be useful, |
9 | * but 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. | |
17e90c5e | 12 | * |
53e28ed9 AW |
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 02110-1301 USA | |
16 | */ | |
17 | ||
17e90c5e KN |
18 | |
19 | /* This file is included in vm_engine.c */ | |
20 | ||
53e28ed9 | 21 | VM_DEFINE_LOADER (60, load_integer, "load-integer") |
17e90c5e KN |
22 | { |
23 | size_t len; | |
ea9b4b29 | 24 | |
17e90c5e | 25 | FETCH_LENGTH (len); |
ea9b4b29 KN |
26 | if (len <= 4) |
27 | { | |
53e28ed9 | 28 | int val = 0; |
ea9b4b29 KN |
29 | while (len-- > 0) |
30 | val = (val << 8) + FETCH (); | |
1865ad56 | 31 | SYNC_REGISTER (); |
53e28ed9 | 32 | PUSH (scm_from_int (val)); |
ea9b4b29 KN |
33 | NEXT; |
34 | } | |
35 | else | |
36 | SCM_MISC_ERROR ("load-integer: not implemented yet", SCM_EOL); | |
17e90c5e KN |
37 | } |
38 | ||
53e28ed9 | 39 | VM_DEFINE_LOADER (61, load_number, "load-number") |
17e90c5e KN |
40 | { |
41 | size_t len; | |
f9e8c09d | 42 | |
17e90c5e | 43 | FETCH_LENGTH (len); |
1865ad56 | 44 | SYNC_REGISTER (); |
b6368dbb | 45 | PUSH (scm_string_to_number (scm_from_locale_stringn ((char *)ip, len), |
9cc649b8 | 46 | SCM_UNDEFINED /* radix = 10 */)); |
f9e8c09d | 47 | /* Was: scm_istring2number (ip, len, 10)); */ |
17e90c5e KN |
48 | ip += len; |
49 | NEXT; | |
50 | } | |
51 | ||
53e28ed9 | 52 | VM_DEFINE_LOADER (62, load_string, "load-string") |
17e90c5e KN |
53 | { |
54 | size_t len; | |
55 | FETCH_LENGTH (len); | |
1865ad56 | 56 | SYNC_REGISTER (); |
b6368dbb | 57 | PUSH (scm_from_locale_stringn ((char *)ip, len)); |
f9e8c09d | 58 | /* Was: scm_makfromstr (ip, len, 0) */ |
17e90c5e KN |
59 | ip += len; |
60 | NEXT; | |
61 | } | |
62 | ||
53e28ed9 | 63 | VM_DEFINE_LOADER (63, load_symbol, "load-symbol") |
a80be762 KN |
64 | { |
65 | size_t len; | |
66 | FETCH_LENGTH (len); | |
1865ad56 | 67 | SYNC_REGISTER (); |
b6368dbb | 68 | PUSH (scm_from_locale_symboln ((char *)ip, len)); |
a80be762 KN |
69 | ip += len; |
70 | NEXT; | |
71 | } | |
72 | ||
53e28ed9 | 73 | VM_DEFINE_LOADER (64, load_keyword, "load-keyword") |
17e90c5e | 74 | { |
17e90c5e KN |
75 | size_t len; |
76 | FETCH_LENGTH (len); | |
1865ad56 | 77 | SYNC_REGISTER (); |
a52b96a7 | 78 | PUSH (scm_from_locale_keywordn ((char *)ip, len)); |
17e90c5e KN |
79 | ip += len; |
80 | NEXT; | |
81 | } | |
82 | ||
53e28ed9 | 83 | VM_DEFINE_LOADER (65, load_program, "load-program") |
17e90c5e | 84 | { |
53e28ed9 AW |
85 | scm_t_uint32 len; |
86 | SCM objs, objcode; | |
17e90c5e | 87 | |
53e28ed9 AW |
88 | POP (objs); |
89 | SYNC_REGISTER (); | |
ac99cb0c | 90 | |
53e28ed9 AW |
91 | if (scm_is_vector (objs) && scm_is_false (scm_c_vector_ref (objs, 0))) |
92 | scm_c_vector_set_x (objs, 0, scm_current_module ()); | |
ac99cb0c | 93 | |
53e28ed9 AW |
94 | objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip); |
95 | len = sizeof (struct scm_objcode) + SCM_OBJCODE_LEN (objcode); | |
206a0622 | 96 | |
53e28ed9 | 97 | PUSH (scm_make_program (objcode, objs, SCM_EOL)); |
2fda0242 | 98 | |
53e28ed9 | 99 | ip += len; |
17e90c5e | 100 | |
17e90c5e KN |
101 | NEXT; |
102 | } | |
103 | ||
53e28ed9 | 104 | VM_DEFINE_INSTRUCTION (66, link_now, "link-now", 0, 1, 1) |
17e90c5e | 105 | { |
fd358575 AW |
106 | SCM what; |
107 | POP (what); | |
1865ad56 | 108 | SYNC_REGISTER (); |
fd358575 AW |
109 | if (SCM_LIKELY (SCM_SYMBOLP (what))) |
110 | { | |
111 | PUSH (scm_lookup (what)); /* might longjmp */ | |
112 | } | |
113 | else | |
114 | { | |
115 | SCM mod; | |
116 | /* compilation of @ or @@ | |
117 | `what' is a three-element list: (MODNAME SYM INTERFACE?) | |
118 | INTERFACE? is #t if we compiled @ or #f if we compiled @@ | |
119 | */ | |
120 | mod = scm_resolve_module (SCM_CAR (what)); | |
121 | if (scm_is_true (SCM_CADDR (what))) | |
122 | mod = scm_module_public_interface (mod); | |
123 | if (SCM_FALSEP (mod)) | |
124 | { | |
125 | err_args = SCM_LIST1 (SCM_CAR (what)); | |
126 | goto vm_error_no_such_module; | |
127 | } | |
128 | /* might longjmp */ | |
129 | PUSH (scm_module_lookup (mod, SCM_CADR (what))); | |
130 | } | |
131 | ||
6297d229 AW |
132 | NEXT; |
133 | } | |
134 | ||
53e28ed9 | 135 | VM_DEFINE_LOADER (67, define, "define") |
cd9d95d7 AW |
136 | { |
137 | SCM sym; | |
138 | size_t len; | |
139 | ||
140 | FETCH_LENGTH (len); | |
1865ad56 | 141 | SYNC_REGISTER (); |
cd9d95d7 AW |
142 | sym = scm_from_locale_symboln ((char *)ip, len); |
143 | ip += len; | |
144 | ||
1865ad56 | 145 | SYNC_REGISTER (); |
cd9d95d7 AW |
146 | PUSH (scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T)); |
147 | NEXT; | |
fdcedea6 KN |
148 | } |
149 | ||
53e28ed9 AW |
150 | /* |
151 | (defun renumber-ops () | |
152 | "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences" | |
153 | (interactive "") | |
154 | (save-excursion | |
155 | (let ((counter 59)) (goto-char (point-min)) | |
156 | (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t) | |
157 | (replace-match | |
158 | (number-to-string (setq counter (1+ counter))) | |
159 | t t nil 1))))) | |
160 | */ | |
161 | ||
17e90c5e KN |
162 | /* |
163 | Local Variables: | |
164 | c-file-style: "gnu" | |
165 | End: | |
166 | */ |