libguile/vm-i-loader.c

   1 /* Copyright (C) 2001 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program 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
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 /* This file is included in vm_engine.c */
  43
  44 VM_DEFINE_LOADER (load_integer, "load-integer")
  45 {
  46   size_t len;
  47
  48   FETCH_LENGTH (len);
  49   if (len <= 4)
  50     {
  51       long val = 0;
  52       while (len-- > 0)
  53         val = (val << 8) + FETCH ();
  54       SYNC_REGISTER ();
  55       PUSH (scm_from_ulong (val));
  56       NEXT;
  57     }
  58   else
  59     SCM_MISC_ERROR ("load-integer: not implemented yet", SCM_EOL);
  60 }
  61
  62 VM_DEFINE_LOADER (load_number, "load-number")
  63 {
  64   size_t len;
  65
  66   FETCH_LENGTH (len);
  67   SYNC_REGISTER ();
  68   PUSH (scm_string_to_number (scm_from_locale_stringn ((char *)ip, len),
  69                               SCM_UNDEFINED /* radix = 10 */));
  70   /* Was: scm_istring2number (ip, len, 10)); */
  71   ip += len;
  72   NEXT;
  73 }
  74
  75 VM_DEFINE_LOADER (load_string, "load-string")
  76 {
  77   size_t len;
  78   FETCH_LENGTH (len);
  79   SYNC_REGISTER ();
  80   PUSH (scm_from_locale_stringn ((char *)ip, len));
  81   /* Was: scm_makfromstr (ip, len, 0) */
  82   ip += len;
  83   NEXT;
  84 }
  85
  86 VM_DEFINE_LOADER (load_symbol, "load-symbol")
  87 {
  88   size_t len;
  89   FETCH_LENGTH (len);
  90   SYNC_REGISTER ();
  91   PUSH (scm_from_locale_symboln ((char *)ip, len));
  92   ip += len;
  93   NEXT;
  94 }
  95
  96 VM_DEFINE_LOADER (load_keyword, "load-keyword")
  97 {
  98   size_t len;
  99   FETCH_LENGTH (len);
 100   SYNC_REGISTER ();
 101   PUSH (scm_from_locale_keywordn ((char *)ip, len));
 102   ip += len;
 103   NEXT;
 104 }
 105
 106 VM_DEFINE_LOADER (load_program, "load-program")
 107 {
 108   size_t len;
 109   SCM prog, x;
 110   struct scm_program *p;
 111
 112   FETCH_LENGTH (len);
 113   SYNC_REGISTER ();
 114   prog = scm_c_make_program (ip, len, program);
 115   p = SCM_PROGRAM_DATA (prog);
 116   ip += len;
 117
 118   POP (x);
 119
 120   /* init meta data */
 121   if (SCM_CONSP (x))
 122     {
 123       p->meta = x;
 124       POP (x);
 125     }
 126
 127   /* init object table */
 128   if (scm_is_vector (x))
 129     {
 130 #if 0
 131       if (scm_is_simple_vector (x))
 132         printf ("is_simple_vector!\n");
 133       else
 134         printf ("NOT is_simple_vector\n");
 135 #endif
 136       p->objs = x;
 137       POP (x);
 138     }
 139
 140   /* init parameters */
 141   /* NOTE: format defined in system/vm/assemble.scm */
 142   if (SCM_I_INUMP (x))
 143     {
 144       int i = SCM_I_INUM (x);
 145       if (-128 <= i && i <= 127)
 146         {
 147           /* 8-bit representation */
 148           p->nargs = (i >> 6) & 0x03;   /* 7-6 bits */
 149           p->nrest = (i >> 5) & 0x01;   /*   5 bit  */
 150           p->nlocs = (i >> 2) & 0x07;   /* 4-2 bits */
 151           p->nexts = i & 0x03;          /* 1-0 bits */
 152         }
 153       else
 154         {
 155           /* 16-bit representation */
 156           p->nargs = (i >> 12) & 0x07;  /* 15-12 bits */
 157           p->nrest = (i >> 11) & 0x01;  /*    11 bit  */
 158           p->nlocs = (i >> 4)  & 0x7f;  /* 10-04 bits */
 159           p->nexts = i & 0x0f;          /* 03-00 bits */
 160         }
 161     }
 162   else
 163     {
 164       /* Other cases */
 165       /* x is #f, and already popped off */
 166       p->nargs = SCM_I_INUM (sp[-3]);
 167       p->nrest = SCM_I_INUM (sp[-2]);
 168       p->nlocs = SCM_I_INUM (sp[-1]);
 169       p->nexts = SCM_I_INUM (sp[0]);
 170       sp -= 4;
 171     }
 172
 173   PUSH (prog);
 174   NEXT;
 175 }
 176
 177 VM_DEFINE_INSTRUCTION (link_now, "link-now", 0, 1, 1)
 178 {
 179   SCM sym;
 180   POP (sym);
 181   SYNC_REGISTER ();
 182   PUSH (scm_lookup (sym)); /* might longjmp */
 183   NEXT;
 184 }
 185
 186 VM_DEFINE_INSTRUCTION (link_later, "link-later", 0, 2, 1)
 187 {
 188   SCM modname, sym;
 189   POP (sym);
 190   POP (modname);
 191   SYNC_REGISTER ();
 192   PUSH (scm_cons (modname, sym));
 193   NEXT;
 194 }
 195
 196 VM_DEFINE_LOADER (define, "define")
 197 {
 198   SCM sym;
 199   size_t len;
 200
 201   FETCH_LENGTH (len);
 202   SYNC_REGISTER ();
 203   sym = scm_from_locale_symboln ((char *)ip, len);
 204   ip += len;
 205
 206   SYNC_REGISTER ();
 207   PUSH (scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T));
 208   NEXT;
 209 }
 210
 211 VM_DEFINE_LOADER (late_bind, "late-bind")
 212 {
 213   SCM sym;
 214   size_t len;
 215
 216   FETCH_LENGTH (len);
 217   SYNC_REGISTER ();
 218   sym = scm_from_locale_symboln ((char *)ip, len);
 219   ip += len;
 220
 221   PUSH (sym);
 222   NEXT;
 223 }
 224
 225 /*
 226   Local Variables:
 227   c-file-style: "gnu"
 228   End:
 229 */