src/vm_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       PUSH (scm_from_ulong (val));
  55       NEXT;
  56     }
  57   else
  58     SCM_MISC_ERROR ("load-integer: not implemented yet", SCM_EOL);
  59 }
  60
  61 VM_DEFINE_LOADER (load_number, "load-number")
  62 {
  63   size_t len;
  64
  65   FETCH_LENGTH (len);
  66   PUSH (scm_string_to_number (scm_from_locale_stringn ((char *)ip, len),
  67                               SCM_UNDEFINED /* radix = 10 */));
  68   /* Was: scm_istring2number (ip, len, 10)); */
  69   ip += len;
  70   NEXT;
  71 }
  72
  73 VM_DEFINE_LOADER (load_string, "load-string")
  74 {
  75   size_t len;
  76   FETCH_LENGTH (len);
  77   PUSH (scm_from_locale_stringn ((char *)ip, len));
  78   /* Was: scm_makfromstr (ip, len, 0) */
  79   ip += len;
  80   NEXT;
  81 }
  82
  83 VM_DEFINE_LOADER (load_symbol, "load-symbol")
  84 {
  85   size_t len;
  86   FETCH_LENGTH (len);
  87   PUSH (scm_from_locale_symboln ((char *)ip, len));
  88   ip += len;
  89   NEXT;
  90 }
  91
  92 VM_DEFINE_LOADER (load_keyword, "load-keyword")
  93 {
  94   size_t len;
  95   FETCH_LENGTH (len);
  96   PUSH (scm_from_locale_keywordn ((char *)ip, len));
  97   ip += len;
  98   NEXT;
  99 }
 100
 101 VM_DEFINE_LOADER (load_module, "load-module")
 102 {
 103   size_t len;
 104   FETCH_LENGTH (len);
 105   PUSH (scm_c_lookup_env (scm_from_locale_symboln ((char *)ip, len)));
 106   ip += len;
 107   NEXT;
 108 }
 109
 110 VM_DEFINE_LOADER (load_program, "load-program")
 111 {
 112   size_t len;
 113   SCM prog, x;
 114   struct scm_program *p;
 115
 116   FETCH_LENGTH (len);
 117   prog = scm_c_make_program (ip, len, program);
 118   p = SCM_PROGRAM_DATA (prog);
 119   ip += len;
 120
 121   POP (x);
 122
 123   /* init meta data */
 124   if (SCM_CONSP (x))
 125     {
 126       p->meta = x;
 127       POP (x);
 128     }
 129
 130   /* init object table */
 131   if (scm_is_vector (x))
 132     {
 133 #if 0
 134       if (scm_is_simple_vector (x))
 135         printf ("is_simple_vector!\n");
 136       else
 137         printf ("NOT is_simple_vector\n");
 138 #endif
 139       p->objs = x;
 140       POP (x);
 141     }
 142
 143   /* init parameters */
 144   /* NOTE: format defined in system/vm/assemble.scm */
 145   if (SCM_I_INUMP (x))
 146     {
 147       int i = SCM_I_INUM (x);
 148       if (-128 <= i && i <= 127)
 149         {
 150           /* 8-bit representation */
 151           p->nargs = (i >> 6) & 0x03;   /* 7-6 bits */
 152           p->nrest = (i >> 5) & 0x01;   /*   5 bit  */
 153           p->nlocs = (i >> 2) & 0x07;   /* 4-2 bits */
 154           p->nexts = i & 0x03;          /* 1-0 bits */
 155         }
 156       else
 157         {
 158           /* 16-bit representation */
 159           p->nargs = (i >> 12) & 0x07;  /* 15-12 bits */
 160           p->nrest = (i >> 11) & 0x01;  /*    11 bit  */
 161           p->nlocs = (i >> 4)  & 0x7f;  /* 10-04 bits */
 162           p->nexts = i & 0x0f;          /* 03-00 bits */
 163         }
 164     }
 165   else
 166     {
 167       /* Other cases */
 168       /* x is #f, and already popped off */
 169       p->nargs = SCM_I_INUM (sp[-3]);
 170       p->nrest = SCM_I_INUM (sp[-2]);
 171       p->nlocs = SCM_I_INUM (sp[-1]);
 172       p->nexts = SCM_I_INUM (sp[0]);
 173       sp -= 4;
 174     }
 175
 176   PUSH (prog);
 177   NEXT;
 178 }
 179
 180 VM_DEFINE_INSTRUCTION (link_now, "link-now", 0, 1, 1)
 181 {
 182   SCM sym;
 183   POP (sym);
 184   PUSH (scm_lookup (sym)); /* might longjmp */
 185   NEXT;
 186 }
 187
 188 VM_DEFINE_INSTRUCTION (link_later, "link-later", 0, 2, 1)
 189 {
 190   SCM modname, sym;
 191   POP (sym);
 192   POP (modname);
 193   PUSH (scm_cons (modname, sym));
 194   NEXT;
 195 }
 196
 197 VM_DEFINE_LOADER (define, "define")
 198 {
 199   SCM sym;
 200   size_t len;
 201
 202   FETCH_LENGTH (len);
 203   sym = scm_from_locale_symboln ((char *)ip, len);
 204   ip += len;
 205
 206   PUSH (scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T));
 207   NEXT;
 208 }
 209
 210 VM_DEFINE_LOADER (late_bind, "late-bind")
 211 {
 212   SCM sym;
 213   size_t len;
 214
 215   FETCH_LENGTH (len);
 216   sym = scm_from_locale_symboln ((char *)ip, len);
 217   ip += len;
 218
 219   PUSH (sym);
 220   NEXT;
 221 }
 222
 223 /*
 224   Local Variables:
 225   c-file-style: "gnu"
 226   End:
 227 */