tests/gpgscm/scheme-private.h

   1 /* scheme-private.h */
   2
   3 #ifndef _SCHEME_PRIVATE_H
   4 #define _SCHEME_PRIVATE_H
   5
   6 #include "scheme.h"
   7 /*------------------ Ugly internals -----------------------------------*/
   8 /*------------------ Of interest only to FFI users --------------------*/
   9
  10 #ifdef __cplusplus
  11 extern "C" {
  12 #endif
  13
  14 enum scheme_port_kind {
  15   port_free=0,
  16   port_file=1,
  17   port_string=2,
  18   port_srfi6=4,
  19   port_input=16,
  20   port_output=32,
  21   port_saw_EOF=64
  22 };
  23
  24 typedef struct port {
  25   unsigned char kind;
  26   union {
  27     struct {
  28       FILE *file;
  29       int closeit;
  30 #if SHOW_ERROR_LINE
  31       int curr_line;
  32       char *filename;
  33 #endif
  34     } stdio;
  35     struct {
  36       char *start;
  37       char *past_the_end;
  38       char *curr;
  39     } string;
  40   } rep;
  41 } port;
  42
  43 /* cell structure */
  44 struct cell {
  45   unsigned int _flag;
  46   union {
  47     struct {
  48       char   *_svalue;
  49       int   _length;
  50     } _string;
  51     num _number;
  52     port *_port;
  53     foreign_func _ff;
  54     struct {
  55       struct cell *_car;
  56       struct cell *_cdr;
  57     } _cons;
  58     struct {
  59          char *_data;
  60          const foreign_object_vtable *_vtable;
  61     } _foreign_object;
  62   } _object;
  63 };
  64
  65 #if USE_HISTORY
  66 /* The history is a two-dimensional ring buffer.  A donut-shaped data
  67  * structure.  This data structure is inspired by MIT/GNU Scheme.  */
  68 struct history {
  69   /* Number of calls to store.  Must be a power of two.  */
  70   size_t N;
  71
  72   /* Number of tail-calls to store in each call frame.  Must be a
  73    * power of two.  */
  74   size_t M;
  75
  76   /* Masks for fast index calculations.  */
  77   size_t mask_N;
  78   size_t mask_M;
  79
  80   /* A vector of size N containing calls.  */
  81   pointer callstack;
  82
  83   /* A vector of size N containing vectors of size M containing tail
  84    * calls.  */
  85   pointer tailstacks;
  86
  87   /* Our current position.  */
  88   size_t n;
  89   size_t *m;
  90 };
  91 #endif
  92
  93 struct scheme {
  94 /* arrays for segments */
  95 func_alloc malloc;
  96 func_dealloc free;
  97
  98 /* return code */
  99 int retcode;
 100 int tracing;
 101
 102
 103 #ifndef CELL_SEGSIZE
 104 #define CELL_SEGSIZE    5000  /* # of cells in one segment */
 105 #endif
 106 #ifndef CELL_NSEGMENT
 107 #define CELL_NSEGMENT   10    /* # of segments for cells */
 108 #endif
 109 void *alloc_seg[CELL_NSEGMENT];
 110 pointer cell_seg[CELL_NSEGMENT];
 111 int     last_cell_seg;
 112
 113 /* We use 4 registers. */
 114 pointer args;            /* register for arguments of function */
 115 pointer envir;           /* stack register for current environment */
 116 pointer code;            /* register for current code */
 117 pointer dump;            /* stack register for next evaluation */
 118
 119 #if USE_HISTORY
 120 struct history history;  /* we keep track of the call history for
 121                           * error messages */
 122 #endif
 123
 124 int interactive_repl;    /* are we in an interactive REPL? */
 125
 126 struct cell _sink;
 127 pointer sink;            /* when mem. alloc. fails */
 128 struct cell _NIL;
 129 pointer NIL;             /* special cell representing empty cell */
 130 struct cell _HASHT;
 131 pointer T;               /* special cell representing #t */
 132 struct cell _HASHF;
 133 pointer F;               /* special cell representing #f */
 134 struct cell _EOF_OBJ;
 135 pointer EOF_OBJ;         /* special cell representing end-of-file object */
 136 pointer oblist;          /* pointer to symbol table */
 137 pointer global_env;      /* pointer to global environment */
 138 pointer c_nest;          /* stack for nested calls from C */
 139
 140 /* global pointers to special symbols */
 141 pointer LAMBDA;               /* pointer to syntax lambda */
 142 pointer QUOTE;           /* pointer to syntax quote */
 143
 144 pointer QQUOTE;               /* pointer to symbol quasiquote */
 145 pointer UNQUOTE;         /* pointer to symbol unquote */
 146 pointer UNQUOTESP;       /* pointer to symbol unquote-splicing */
 147 pointer FEED_TO;         /* => */
 148 pointer COLON_HOOK;      /* *colon-hook* */
 149 pointer ERROR_HOOK;      /* *error-hook* */
 150 pointer SHARP_HOOK;  /* *sharp-hook* */
 151 #if USE_COMPILE_HOOK
 152 pointer COMPILE_HOOK;  /* *compile-hook* */
 153 #endif
 154
 155 #if USE_SMALL_INTEGERS
 156 /* A fixed allocation of small integers.  */
 157 void *integer_alloc;
 158 pointer integer_cells;
 159 #endif
 160
 161 pointer free_cell;       /* pointer to top of free cells */
 162 long    fcells;          /* # of free cells */
 163 size_t  inhibit_gc;      /* nesting of gc_disable */
 164 size_t  reserved_cells;  /* # of reserved cells */
 165 #ifndef NDEBUG
 166 int     reserved_lineno;   /* location of last reservation */
 167 #endif
 168
 169 pointer inport;
 170 pointer outport;
 171 pointer save_inport;
 172 pointer loadport;
 173
 174 #ifndef MAXFIL
 175 #define MAXFIL 64
 176 #endif
 177 port load_stack[MAXFIL];     /* Stack of open files for port -1 (LOADing) */
 178 int nesting_stack[MAXFIL];
 179 int file_i;
 180 int nesting;
 181
 182 char    gc_verbose;      /* if gc_verbose is not zero, print gc status */
 183 char    no_memory;       /* Whether mem. alloc. has failed */
 184
 185 #ifndef LINESIZE
 186 #define LINESIZE 1024
 187 #endif
 188 char    linebuff[LINESIZE];
 189 #ifndef STRBUFFSIZE
 190 #define STRBUFFSIZE 256
 191 #endif
 192 char    *strbuff;
 193 size_t strbuff_size;
 194 FILE *tmpfp;
 195 int tok;
 196 int print_flag;
 197 pointer value;
 198 int op;
 199 unsigned int flags;
 200
 201 void *ext_data;     /* For the benefit of foreign functions */
 202 long gensym_cnt;
 203
 204 struct scheme_interface *vptr;
 205 };
 206
 207 /* operator code */
 208 enum scheme_opcodes {
 209 #define _OP_DEF(A,B,C,D,E,OP) OP,
 210 #include "opdefines.h"
 211   OP_MAXDEFINED
 212 };
 213
 214
 215 #define cons(sc,a,b) _cons(sc,a,b,0)
 216 #define immutable_cons(sc,a,b) _cons(sc,a,b,1)
 217
 218 int is_string(pointer p);
 219 char *string_value(pointer p);
 220 int is_number(pointer p);
 221 num nvalue(pointer p);
 222 long ivalue(pointer p);
 223 double rvalue(pointer p);
 224 int is_integer(pointer p);
 225 int is_real(pointer p);
 226 int is_character(pointer p);
 227 long charvalue(pointer p);
 228 int is_vector(pointer p);
 229
 230 int is_port(pointer p);
 231
 232 int is_pair(pointer p);
 233 pointer pair_car(pointer p);
 234 pointer pair_cdr(pointer p);
 235 pointer set_car(pointer p, pointer q);
 236 pointer set_cdr(pointer p, pointer q);
 237
 238 int is_symbol(pointer p);
 239 char *symname(pointer p);
 240 int hasprop(pointer p);
 241
 242 int is_syntax(pointer p);
 243 int is_proc(pointer p);
 244 int is_foreign(pointer p);
 245 char *syntaxname(pointer p);
 246 int is_closure(pointer p);
 247 #ifdef USE_MACRO
 248 int is_macro(pointer p);
 249 #endif
 250 pointer closure_code(pointer p);
 251 pointer closure_env(pointer p);
 252
 253 int is_continuation(pointer p);
 254 int is_promise(pointer p);
 255 int is_environment(pointer p);
 256 int is_immutable(pointer p);
 257 void setimmutable(pointer p);
 258
 259 int is_foreign_object(pointer p);
 260 const foreign_object_vtable *get_foreign_object_vtable(pointer p);
 261 void *get_foreign_object_data(pointer p);
 262
 263 #ifdef __cplusplus
 264 }
 265 #endif
 266
 267 #endif
 268
 269 /*
 270 Local variables:
 271 c-file-style: "k&r"
 272 End:
 273 */