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 } _object; 59 }; 60 61 struct scheme { 62 /* arrays for segments */ 63 func_alloc malloc; 64 func_dealloc free; 65 66 /* return code */ 67 int retcode; 68 int tracing; 69 70 71 #define CELL_SEGSIZE 5000 /* # of cells in one segment */ 72 #define CELL_NSEGMENT 10 /* # of segments for cells */ 73 char *alloc_seg[CELL_NSEGMENT]; 74 cell_ptr cell_seg[CELL_NSEGMENT]; 75 int last_cell_seg; 76 77 /* We use 4 registers. */ 78 cell_ptr args; /* register for arguments of function */ 79 cell_ptr envir; /* stack register for current environment */ 80 cell_ptr code; /* register for current code */ 81 cell_ptr dump; /* stack register for next evaluation */ 82 83 int interactive_repl; /* are we in an interactive REPL? */ 84 85 struct cell _sink; 86 cell_ptr sink; /* when mem. alloc. fails */ 87 struct cell _NIL; 88 cell_ptr NIL; /* special cell representing empty cell */ 89 struct cell _HASHT; 90 cell_ptr T; /* special cell representing #t */ 91 struct cell _HASHF; 92 cell_ptr F; /* special cell representing #f */ 93 struct cell _EOF_OBJ; 94 cell_ptr EOF_OBJ; /* special cell representing end-of-file object */ 95 cell_ptr oblist; /* pointer to symbol table */ 96 cell_ptr global_env; /* pointer to global environment */ 97 cell_ptr c_nest; /* stack for nested calls from C */ 98 99 /* global pointers to special symbols */ 100 cell_ptr LAMBDA; /* pointer to syntax lambda */ 101 cell_ptr QUOTE; /* pointer to syntax quote */ 102 103 cell_ptr QQUOTE; /* pointer to symbol quasiquote */ 104 cell_ptr UNQUOTE; /* pointer to symbol unquote */ 105 cell_ptr UNQUOTESP; /* pointer to symbol unquote-splicing */ 106 cell_ptr FEED_TO; /* => */ 107 cell_ptr COLON_HOOK; /* *colon-hook* */ 108 cell_ptr ERROR_HOOK; /* *error-hook* */ 109 cell_ptr SHARP_HOOK; /* *sharp-hook* */ 110 cell_ptr COMPILE_HOOK; /* *compile-hook* */ 111 112 cell_ptr free_cell; /* pointer to top of free cells */ 113 long fcells; /* # of free cells */ 114 115 cell_ptr inport; 116 cell_ptr outport; 117 cell_ptr save_inport; 118 cell_ptr loadport; 119 120 #define MAXFIL 64 121 port load_stack[MAXFIL]; /* Stack of open files for port -1 (LOADing) */ 122 int nesting_stack[MAXFIL]; 123 int file_i; 124 int nesting; 125 126 char gc_verbose; /* if gc_verbose is not zero, print gc status */ 127 char no_memory; /* Whether mem. alloc. has failed */ 128 129 #define LINESIZE 1024 130 char linebuff[LINESIZE]; 131 #define STRBUFFSIZE 256 132 char strbuff[STRBUFFSIZE]; 133 134 FILE *tmpfp; 135 int tok; 136 int print_flag; 137 cell_ptr value; 138 int op; 139 140 void *ext_data; /* For the benefit of foreign functions */ 141 long gensym_cnt; 142 143 struct scheme_interface *vptr; 144 void *dump_base; /* pointer to base of allocated dump stack */ 145 int dump_size; /* number of frames allocated for dump stack */ 146 }; 147 148 /* operator code */ 149 enum scheme_opcodes { 150 #define _OP_DEF(A,B,C,D,E,OP) OP, 151 #include "opdefines.h" 152 OP_MAXDEFINED 153 }; 154 155 156 #define cons(sc,a,b) _cons(sc,a,b,0) 157 #define immutable_cons(sc,a,b) _cons(sc,a,b,1) 158 159 int is_string(cell_ptr p); 160 char *string_value(cell_ptr p); 161 int string_length(cell_ptr p); 162 int is_number(cell_ptr p); 163 num nvalue(cell_ptr p); 164 long ivalue(cell_ptr p); 165 double rvalue(cell_ptr p); 166 int is_integer(cell_ptr p); 167 int is_real(cell_ptr p); 168 int is_character(cell_ptr p); 169 long charvalue(cell_ptr p); 170 int is_vector(cell_ptr p); 171 int is_blackbox(cell_ptr p); 172 void *blackboxvalue(cell_ptr p); 173 174 int is_port(cell_ptr p); 175 176 int is_pair(cell_ptr p); 177 cell_ptr pair_car(cell_ptr p); 178 cell_ptr pair_cdr(cell_ptr p); 179 cell_ptr set_car(cell_ptr p, cell_ptr q); 180 cell_ptr set_cdr(cell_ptr p, cell_ptr q); 181 182 int is_symbol(cell_ptr p); 183 char *symname(cell_ptr p); 184 int symlen(cell_ptr p); 185 int hasprop(cell_ptr p); 186 187 int is_syntax(cell_ptr p); 188 int is_proc(cell_ptr p); 189 int is_foreign(cell_ptr p); 190 char *syntaxname(cell_ptr p); 191 int is_closure(cell_ptr p); 192 #ifdef USE_MACRO 193 int is_macro(cell_ptr p); 194 #endif 195 cell_ptr closure_code(cell_ptr p); 196 cell_ptr closure_env(cell_ptr p); 197 198 int is_continuation(cell_ptr p); 199 int is_promise(cell_ptr p); 200 int is_environment(cell_ptr p); 201 int is_immutable(cell_ptr p); 202 void setimmutable(cell_ptr p); 203 204 #ifdef __cplusplus 205 } 206 #endif 207 208 #endif 209 210 /* 211 Local variables: 212 c-file-style: "k&r" 213 End: 214 */ 215