libguile/vm-i-loader.c

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