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 | ||
782a82ee | 18 | /* FIXME! Need to check that the fetch is within the current program */ |
17e90c5e KN |
19 | |
20 | /* This file is included in vm_engine.c */ | |
21 | ||
b912a1cd LC |
22 | VM_DEFINE_LOADER (59, load_unsigned_integer, "load-unsigned-integer") |
23 | { | |
24 | size_t len; | |
25 | ||
26 | FETCH_LENGTH (len); | |
586cfdec | 27 | if (SCM_LIKELY (len <= 8)) |
b912a1cd | 28 | { |
586cfdec | 29 | scm_t_uint64 val = 0; |
b912a1cd LC |
30 | while (len-- > 0) |
31 | val = (val << 8U) + FETCH (); | |
32 | SYNC_REGISTER (); | |
586cfdec | 33 | PUSH (scm_from_uint64 (val)); |
b912a1cd LC |
34 | NEXT; |
35 | } | |
36 | else | |
37 | SCM_MISC_ERROR ("load-unsigned-integer: not implemented yet", SCM_EOL); | |
38 | } | |
39 | ||
53e28ed9 | 40 | VM_DEFINE_LOADER (60, load_integer, "load-integer") |
17e90c5e KN |
41 | { |
42 | size_t len; | |
ea9b4b29 | 43 | |
17e90c5e | 44 | FETCH_LENGTH (len); |
b912a1cd | 45 | if (SCM_LIKELY (len <= 4)) |
ea9b4b29 | 46 | { |
53e28ed9 | 47 | int val = 0; |
ea9b4b29 KN |
48 | while (len-- > 0) |
49 | val = (val << 8) + FETCH (); | |
1865ad56 | 50 | SYNC_REGISTER (); |
53e28ed9 | 51 | PUSH (scm_from_int (val)); |
ea9b4b29 KN |
52 | NEXT; |
53 | } | |
54 | else | |
55 | SCM_MISC_ERROR ("load-integer: not implemented yet", SCM_EOL); | |
17e90c5e KN |
56 | } |
57 | ||
53e28ed9 | 58 | VM_DEFINE_LOADER (61, load_number, "load-number") |
17e90c5e KN |
59 | { |
60 | size_t len; | |
f9e8c09d | 61 | |
17e90c5e | 62 | FETCH_LENGTH (len); |
1865ad56 | 63 | SYNC_REGISTER (); |
b6368dbb | 64 | PUSH (scm_string_to_number (scm_from_locale_stringn ((char *)ip, len), |
9cc649b8 | 65 | SCM_UNDEFINED /* radix = 10 */)); |
f9e8c09d | 66 | /* Was: scm_istring2number (ip, len, 10)); */ |
17e90c5e KN |
67 | ip += len; |
68 | NEXT; | |
69 | } | |
70 | ||
53e28ed9 | 71 | VM_DEFINE_LOADER (62, load_string, "load-string") |
17e90c5e KN |
72 | { |
73 | size_t len; | |
74 | FETCH_LENGTH (len); | |
1865ad56 | 75 | SYNC_REGISTER (); |
b6368dbb | 76 | PUSH (scm_from_locale_stringn ((char *)ip, len)); |
f9e8c09d | 77 | /* Was: scm_makfromstr (ip, len, 0) */ |
17e90c5e KN |
78 | ip += len; |
79 | NEXT; | |
80 | } | |
81 | ||
53e28ed9 | 82 | VM_DEFINE_LOADER (63, load_symbol, "load-symbol") |
a80be762 KN |
83 | { |
84 | size_t len; | |
85 | FETCH_LENGTH (len); | |
1865ad56 | 86 | SYNC_REGISTER (); |
b6368dbb | 87 | PUSH (scm_from_locale_symboln ((char *)ip, len)); |
a80be762 KN |
88 | ip += len; |
89 | NEXT; | |
90 | } | |
91 | ||
53e28ed9 | 92 | VM_DEFINE_LOADER (64, load_keyword, "load-keyword") |
17e90c5e | 93 | { |
17e90c5e KN |
94 | size_t len; |
95 | FETCH_LENGTH (len); | |
1865ad56 | 96 | SYNC_REGISTER (); |
a52b96a7 | 97 | PUSH (scm_from_locale_keywordn ((char *)ip, len)); |
17e90c5e KN |
98 | ip += len; |
99 | NEXT; | |
100 | } | |
101 | ||
53e28ed9 | 102 | VM_DEFINE_LOADER (65, load_program, "load-program") |
17e90c5e | 103 | { |
53e28ed9 AW |
104 | scm_t_uint32 len; |
105 | SCM objs, objcode; | |
17e90c5e | 106 | |
53e28ed9 AW |
107 | POP (objs); |
108 | SYNC_REGISTER (); | |
ac99cb0c | 109 | |
53e28ed9 AW |
110 | if (scm_is_vector (objs) && scm_is_false (scm_c_vector_ref (objs, 0))) |
111 | scm_c_vector_set_x (objs, 0, scm_current_module ()); | |
ac99cb0c | 112 | |
53e28ed9 | 113 | objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip); |
ac47d5f6 | 114 | len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode); |
206a0622 | 115 | |
53e28ed9 | 116 | PUSH (scm_make_program (objcode, objs, SCM_EOL)); |
2fda0242 | 117 | |
53e28ed9 | 118 | ip += len; |
17e90c5e | 119 | |
17e90c5e KN |
120 | NEXT; |
121 | } | |
122 | ||
53e28ed9 | 123 | VM_DEFINE_INSTRUCTION (66, link_now, "link-now", 0, 1, 1) |
17e90c5e | 124 | { |
fd358575 AW |
125 | SCM what; |
126 | POP (what); | |
1865ad56 | 127 | SYNC_REGISTER (); |
b7393ea1 | 128 | PUSH (resolve_variable (what, scm_current_module ())); |
6297d229 AW |
129 | NEXT; |
130 | } | |
131 | ||
53e28ed9 | 132 | VM_DEFINE_LOADER (67, define, "define") |
cd9d95d7 AW |
133 | { |
134 | SCM sym; | |
135 | size_t len; | |
136 | ||
137 | FETCH_LENGTH (len); | |
1865ad56 | 138 | SYNC_REGISTER (); |
cd9d95d7 AW |
139 | sym = scm_from_locale_symboln ((char *)ip, len); |
140 | ip += len; | |
141 | ||
1865ad56 | 142 | SYNC_REGISTER (); |
cd9d95d7 AW |
143 | PUSH (scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T)); |
144 | NEXT; | |
fdcedea6 KN |
145 | } |
146 | ||
782a82ee AW |
147 | VM_DEFINE_LOADER (68, load_array, "load-array") |
148 | { | |
149 | SCM type, shape; | |
150 | size_t len; | |
151 | FETCH_LENGTH (len); | |
152 | POP (shape); | |
153 | POP (type); | |
154 | SYNC_REGISTER (); | |
155 | PUSH (scm_from_contiguous_typed_array (type, shape, ip, len)); | |
156 | ip += len; | |
157 | NEXT; | |
158 | } | |
159 | ||
53e28ed9 AW |
160 | /* |
161 | (defun renumber-ops () | |
162 | "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences" | |
163 | (interactive "") | |
164 | (save-excursion | |
165 | (let ((counter 59)) (goto-char (point-min)) | |
166 | (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t) | |
167 | (replace-match | |
168 | (number-to-string (setq counter (1+ counter))) | |
169 | t t nil 1))))) | |
170 | */ | |
171 | ||
17e90c5e KN |
172 | /* |
173 | Local Variables: | |
174 | c-file-style: "gnu" | |
175 | End: | |
176 | */ |