src/vm_loader.c

   1 /* Copyright (C) 2000 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_INSTRUCTION (load_integer, "load-integer", -1, 0, 1)
  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_long2num (val));
  55       NEXT;
  56     }
  57   else
  58     SCM_MISC_ERROR ("load-integer: not implemented yet", SCM_EOL);
  59 }
  60
  61 VM_DEFINE_INSTRUCTION (load_symbol, "load-symbol", -1, 0, 1)
  62 {
  63   size_t len;
  64   FETCH_LENGTH (len);
  65   PUSH (scm_mem2symbol (ip, len));
  66   ip += len;
  67   NEXT;
  68 }
  69
  70 VM_DEFINE_INSTRUCTION (load_string, "load-string", -1, 0, 1)
  71 {
  72   size_t len;
  73   FETCH_LENGTH (len);
  74   PUSH (scm_makfromstr (ip, len, 0));
  75   ip += len;
  76   NEXT;
  77 }
  78
  79 VM_DEFINE_INSTRUCTION (load_keyword, "load-keyword", -1, 0, 1)
  80 {
  81   SCM sym;
  82   size_t len;
  83   FETCH_LENGTH (len);
  84   sym = scm_mem2symbol (ip, len);
  85   PUSH (scm_make_keyword_from_dash_symbol (sym));
  86   ip += len;
  87   NEXT;
  88 }
  89
  90 VM_DEFINE_INSTRUCTION (load_module, "load-module", -1, 0, 1)
  91 {
  92   size_t len;
  93   FETCH_LENGTH (len);
  94   PUSH (scm_c_lookup_env (scm_mem2symbol (ip, len)));
  95   ip += len;
  96   NEXT;
  97 }
  98
  99 VM_DEFINE_INSTRUCTION (load_program, "load-program", -1, 0, 1)
 100 {
 101   size_t len;
 102   SCM prog, x;
 103
 104   FETCH_LENGTH (len);
 105   prog = scm_c_make_program (ip, len, program);
 106   ip += len;
 107
 108   /* init object table */
 109   x = *sp;
 110   if (SCM_VECTORP (x))
 111     {
 112       SCM_PROGRAM_OBJS (prog) = x;
 113       DROP ();
 114       x = *sp;
 115     }
 116
 117   /* init parameters */
 118   if (SCM_INUMP (x))
 119     {
 120       int i = SCM_INUM (x);
 121       if (-128 <= i && i <= 127)
 122         {
 123           /* 8-bit representation */
 124           SCM_PROGRAM_NARGS (prog) = (i >> 6) & 0x03;   /* 7-6 bits */
 125           SCM_PROGRAM_NREST (prog) = (i >> 5) & 0x01;   /* 5 bit */
 126           SCM_PROGRAM_NLOCS (prog) = (i >> 2) & 0x07;   /* 4-2 bits */
 127           SCM_PROGRAM_NEXTS (prog) = i & 0x03;          /* 1-0 bits */
 128         }
 129       else
 130         {
 131           /* 16-bit representation */
 132           SCM_PROGRAM_NARGS (prog) = (i >> 12) & 0x07;  /* 15-12 bits */
 133           SCM_PROGRAM_NREST (prog) = (i >> 11) & 0x01;  /* 11 bit */
 134           SCM_PROGRAM_NLOCS (prog) = (i >> 4)  & 0x7f;  /* 10-4 bits */
 135           SCM_PROGRAM_NEXTS (prog) = i & 0x07;          /* 3-0 bits */
 136         }
 137     }
 138   else
 139     {
 140       /* Other cases */
 141       SCM_PROGRAM_NARGS (prog) = SCM_INUM (sp[4]);
 142       SCM_PROGRAM_NREST (prog) = SCM_INUM (sp[3]);
 143       SCM_PROGRAM_NLOCS (prog) = SCM_INUM (sp[2]);
 144       SCM_PROGRAM_NEXTS (prog) = SCM_INUM (sp[1]);
 145       sp += 4;
 146     }
 147
 148   *sp = prog;
 149   NEXT;
 150 }
 151
 152 VM_DEFINE_INSTRUCTION (link, "link", 0, 2, 1)
 153 {
 154   sp[1] = scm_c_env_vcell (sp[1], sp[0], 1);
 155   DROP ();
 156   NEXT;
 157 }
 158
 159 VM_DEFINE_INSTRUCTION (link_current_module, "link/current-module", 0, 1, 1)
 160 {
 161   SCM mod = scm_current_module ();
 162   SCM var = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
 163                                      *sp, SCM_BOOL_F);
 164   if (SCM_FALSEP (var))
 165     /* Create a new variable if not defined yet */
 166     var = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
 167                                    *sp, SCM_BOOL_T);
 168   *sp = SCM_VARVCELL (var);
 169   NEXT;
 170 }
 171
 172 /*
 173   Local Variables:
 174   c-file-style: "gnu"
 175   End:
 176 */