vm/run.h

   1 /* Callstack top pointer */
   2 CELL cs;
   3
   4 /* TAGGED currently executing quotation */
   5 CELL callframe;
   6
   7 /* UNTAGGED currently executing word in quotation */
   8 CELL callframe_scan;
   9
  10 /* UNTAGGED end of quotation */
  11 CELL callframe_end;
  12
  13 #define USER_ENV 32
  14
  15 #define CARD_OFF_ENV      1 /* for compiling set-slot */
  16 #define NLX_VECTOR_ENV    2 /* non-local exit hook */
  17 #define NAMESTACK_ENV     3 /* used by library only */
  18 #define GLOBAL_ENV        4
  19 #define BREAK_ENV         5
  20 #define CATCHSTACK_ENV    6 /* used by library only */
  21 #define CPU_ENV           7
  22 #define BOOT_ENV          8
  23 #define CALLCC_1_ENV      9 /* used by library only */
  24 #define ARGS_ENV          10
  25 #define OS_ENV            11
  26 #define ERROR_ENV         12 /* a marker consed onto kernel errors */
  27 #define IN_ENV            13
  28 #define OUT_ENV           14
  29 #define GEN_ENV           15 /* set to gen_count */
  30 #define IMAGE_ENV         16 /* image name */
  31 #define CELL_SIZE_ENV     17 /* sizeof(CELL) */
  32
  33 /* TAGGED user environment data; see getenv/setenv prims */
  34 DLLEXPORT CELL userenv[USER_ENV];
  35
  36 /* macros for reading/writing memory, useful when working around
  37 C's type system */
  38 INLINE CELL get(CELL where)
  39 {
  40         return *((CELL*)where);
  41 }
  42
  43 INLINE void put(CELL where, CELL what)
  44 {
  45         *((CELL*)where) = what;
  46 }
  47
  48 INLINE u16 cget(CELL where)
  49 {
  50         return *((u16*)where);
  51 }
  52
  53 INLINE void cput(CELL where, u16 what)
  54 {
  55         *((u16*)where) = what;
  56 }
  57
  58 INLINE CELL align8(CELL a)
  59 {
  60         return (a + 7) & ~7;
  61 }
  62
  63 /* Canonical T object. It's just a word */
  64 CELL T;
  65
  66 #define SLOT(obj,slot) ((obj) + (slot) * CELLS)
  67
  68 INLINE CELL tag_header(CELL cell)
  69 {
  70         return RETAG(cell << TAG_BITS,OBJECT_TYPE);
  71 }
  72
  73 INLINE CELL untag_header(CELL cell)
  74 {
  75         /* if((cell & TAG_MASK) != OBJECT_TYPE)
  76                 critical_error("Corrupt object header",cell); */
  77
  78         return cell >> TAG_BITS;
  79 }
  80
  81 INLINE CELL tag_object(void* cell)
  82 {
  83         return RETAG(cell,OBJECT_TYPE);
  84 }
  85
  86 INLINE CELL object_type(CELL tagged)
  87 {
  88         return untag_header(get(UNTAG(tagged)));
  89 }
  90
  91 INLINE CELL type_of(CELL tagged)
  92 {
  93         if(tagged == F)
  94                 return F_TYPE;
  95         else if(TAG(tagged) == FIXNUM_TYPE)
  96                 return FIXNUM_TYPE;
  97         else
  98                 return object_type(tagged);
  99 }
 100
 101 void call(CELL quot);
 102
 103 void handle_error();
 104 void run(void);
 105 void run_toplevel(void);
 106 DLLEXPORT void run_callback(CELL quot);
 107 void platform_run(void);
 108 void undefined(F_WORD *word);
 109 void docol(F_WORD *word);
 110 void dosym(F_WORD *word);
 111 void primitive_execute(void);
 112 void primitive_call(void);
 113 void primitive_ifte(void);
 114 void primitive_dispatch(void);
 115 void primitive_getenv(void);
 116 void primitive_setenv(void);
 117 void primitive_exit(void);
 118 void primitive_os_env(void);
 119 void primitive_eq(void);
 120 void primitive_millis(void);
 121 void primitive_type(void);
 122 void primitive_tag(void);
 123 void primitive_slot(void);
 124 void primitive_set_slot(void);
 125 void primitive_integer_slot(void);
 126 void primitive_set_integer_slot(void);
 127 CELL clone(CELL obj);
 128 void primitive_clone(void);
 129
 130 /* Runtime errors */
 131 typedef enum
 132 {
 133         ERROR_EXPIRED,
 134         ERROR_IO,
 135         ERROR_UNDEFINED_WORD,
 136         ERROR_TYPE,
 137         ERROR_SIGNAL,
 138         ERROR_NEGATIVE_ARRAY_SIZE,
 139         ERROR_C_STRING,
 140         ERROR_FFI,
 141         ERROR_HEAP_SCAN,
 142         ERROR_UNDEFINED_SYMBOL,
 143         ERROR_USER_INTERRUPT,
 144         ERROR_DS_UNDERFLOW,
 145         ERROR_DS_OVERFLOW,
 146         ERROR_RS_UNDERFLOW,
 147         ERROR_RS_OVERFLOW,
 148         ERROR_CS_UNDERFLOW,
 149         ERROR_CS_OVERFLOW,
 150         ERROR_OBJECTIVE_C
 151 } F_ERRORTYPE;
 152
 153 /* Are we throwing an error? */
 154 bool throwing;
 155 /* When throw_error throws an error, it sets this global and
 156 longjmps back to the top-level. */
 157 CELL thrown_error;
 158 CELL thrown_keep_stacks;
 159 /* Since longjmp restores registers, we must save all these values. */
 160 CELL thrown_ds;
 161 CELL thrown_rs;
 162
 163 void fatal_error(char* msg, CELL tagged);
 164 void critical_error(char* msg, CELL tagged);
 165 void throw_error(CELL error, bool keep_stacks);
 166 void early_error(CELL error);
 167 void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2, bool keep_stacks);
 168 void memory_protection_error(void *addr, int signal);
 169 void signal_error(int signal);
 170 void type_error(CELL type, CELL tagged);
 171 void primitive_throw(void);
 172 void primitive_die(void);
 173
 174 INLINE void type_check(CELL type, CELL tagged)
 175 {
 176         if(type_of(tagged) != type)
 177                 type_error(type,tagged);
 178 }