home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 541b.lha / OakLisp / src.lzh / emulator.h < prev    next >
Encoding:
C/C++ Source or Header  |  1991-06-16  |  7.4 KB  |  350 lines
  1. /*  Copyright (C) 1987,8,9 Barak Pearlmutter and Kevin Lang    */
  2.  
  3. #include "config.h"
  4.  
  5. /* Define this if you want a guard bit in fixnums. */
  6.  
  7. /* #define GUARD_BIT */
  8.  
  9. #ifdef Mac_LSC
  10. #include <storage.h>
  11. #else
  12. extern char *malloc();
  13. #endif
  14.  
  15.  
  16. /* This is measured in references, so the below is 1 megabyte of storage. */
  17. #define DEFAULT_NEW_SPACE_SIZE    (256*1024L)
  18.  
  19.  
  20.  
  21. #define READ_MODE "r"
  22. #define WRITE_MODE "w"
  23. #define APPEND_MODE "a"
  24.  
  25.  
  26. #ifdef Mac_LSC
  27.  
  28. #define READ_BINARY_MODE "r+b"
  29. #define WRITE_BINARY_MODE "w+b"
  30.  
  31. #else /* Mac_LSC */
  32.  
  33. #define READ_BINARY_MODE READ_MODE
  34. #define WRITE_BINARY_MODE WRITE_MODE
  35.  
  36. #endif /* Mac_LSC */
  37.  
  38.  
  39. #ifdef CANT_FLUSH_STD
  40. #define fflush_stdout()
  41. #define fflush_stderr()
  42. #else
  43. #define fflush_stdout() (void)fflush(stdout)
  44. #define fflush_stderr() (void)fflush(stderr)
  45. #endif
  46.  
  47.  
  48.  
  49. #ifndef NULL
  50. #define NULL 0L
  51. #endif
  52.  
  53.  
  54. typedef int bool;
  55.  
  56. #define FALSE    0
  57. #define TRUE    (!FALSE)
  58.  
  59.  
  60. #ifdef UNSIGNED_CHARS
  61. #define SIGN_8BIT_ARG(c)    (((c) & 0x80) ? ((c) | 0xffffff80) : (c))
  62. #else
  63. #define SIGN_8BIT_ARG(x)    ((char)(x))
  64. #endif
  65.  
  66.  
  67. #define SIGN_16BIT_ARG(x)    ((short)(x))
  68.  
  69.  
  70. typedef unsigned long ref;
  71.  
  72.  
  73. #define TAG_MASK    3
  74. #define TAG_MASKL    3L
  75. #define SUBTAG_MASK    0xFF
  76. #define SUBTAG_MASKL    0xFFL
  77.  
  78. #define INT_TAG        0
  79. #define IMM_TAG        1
  80. #define LOC_TAG     2
  81. #define PTR_TAG        3
  82.  
  83. #define PTR_MASK    2
  84.  
  85. #define CHAR_SUBTAG    ((0<<2)+IMM_TAG)
  86.  
  87. #define TAG_IS(X,TAG)        (((X)&TAG_MASK)==(TAG))
  88. #define SUBTAG_IS(X,SUBTAG)    (((X)&SUBTAG_MASK)==(SUBTAG))
  89.  
  90. #define REF_TO_INT(r)    ((long)ASHR2((long)(r)))
  91.  
  92. #define REF_TO_PTR(r)    ((ref *)((r)-PTR_TAG))
  93. #define LOC_TO_PTR(r)    ((ref *)((r)-LOC_TAG))
  94.  
  95. #define ANY_TO_PTR(r)    ((ref *)((r)&~TAG_MASKL))
  96.  
  97.  
  98. #define PTR_TO_LOC(p)    ((ref)((ref)(p)+LOC_TAG))
  99. #define PTR_TO_REF(p)    ((ref)((ref)(p)+PTR_TAG))
  100.  
  101. #define REF_TO_CHAR(r)    ((char)((r)>>8))
  102. #define CHAR_TO_REF(c)    (((ref)(c)<<8)+CHAR_SUBTAG)
  103.  
  104.  
  105.  
  106.  
  107. /* MIN_REF is the most negative fixnum.  There is no corresponding
  108.    positive fixnum, an asymmetry inherent in a twos complement
  109.    representation. */
  110.  
  111. #ifndef GUARD_BIT
  112.  
  113. #define INT_TO_REF(i)    ((ref)(((long)(i)<<2)+INT_TAG))
  114. #define MIN_REF        ((ref)(1L<<(WORDSIZE-1)))
  115. /* Check if high three bits are equal. */
  116. #define OVERFLOWN_INT(i,code)                    \
  117. { register highcrap = ((unsigned long)(i)) >> (WORDSIZE-3);    \
  118.   if ((highcrap != 0x0) && (highcrap != 0x7)) {code;} }
  119.  
  120. #else
  121.  
  122. #define INT_TO_REF(i)    ((ref)(((long)(i)<<3)>>1)+INT_TAG)
  123. #define MIN_REF        ((ref)(3L<<(WORDSIZE-2)))
  124. /* Check if high bit and next-to-high bit are unequal. */
  125. #define OVERFLOWN(r) (((r)>>(WORDSIZE-1)) != (((r)>>(WORDSIZE-2))&1))
  126. #define FIX_GUARD_BIT(r)    ((ref)((((long)(r))<<1)>>1))
  127.  
  128. #endif
  129.  
  130. #define MAX_REF ((ref)-((long)MIN_REF+1))
  131.  
  132.  
  133.  
  134. /*
  135.  * Offsets for wired types.  Offset includes type and
  136.  * optional length fields when present.
  137.  */
  138.  
  139. /* CONS-PAIR: */
  140. #define CONS_PAIR_CAR_OFF    1
  141. #define CONS_PAIR_CDR_OFF    2
  142.  
  143. /* TYPE: */
  144. #define TYPE_LEN_OFF        1
  145. #define TYPE_VAR_LEN_P_OFF    2
  146. #define TYPE_SUPER_LIST_OFF    3
  147. #define TYPE_IVAR_LIST_OFF    4
  148. #define TYPE_IVAR_COUNT_OFF    5
  149. #define TYPE_TYPE_BP_ALIST_OFF    6
  150. #define TYPE_OP_METHOD_ALIST_OFF 7
  151. #define TYPE_WIRED_P_OFF    8
  152.  
  153. /* METHOD: */
  154. #define METHOD_CODE_OFF        1
  155. #define METHOD_ENV_OFF        2
  156.  
  157. /* CODE-VECTOR: */
  158. #define CODE_IVAR_MAP_OFF    2
  159. #define CODE_CODE_START_OFF    3
  160.  
  161. /* OPERATION: */
  162. #define OPERATION_LAMBDA_OFF        1
  163. #define OPERATION_CACHE_TYPE_OFF    2
  164. #define OPERATION_CACHE_METH_OFF    3
  165. #define OPERATION_CACHE_TYPE_OFF_OFF    4
  166.  
  167. /* ESCAPE-OBJECT */
  168. #define ESCAPE_OBJECT_VAL_OFF    1
  169. #define ESCAPE_OBJECT_CXT_OFF    2
  170.  
  171. /* Continuation Objects */
  172. #define CONTINUATION_VAL_SEGS    1
  173. #define CONTINUATION_VAL_OFF    2
  174. #define CONTINUATION_CXT_SEGS    3
  175. #define CONTINUATION_CXT_OFF    4
  176.  
  177. #define car(x)    (REF_SLOT((x),CONS_PAIR_CAR_OFF))
  178. #define cdr(x)    (REF_SLOT((x),CONS_PAIR_CDR_OFF))
  179.  
  180.  
  181. extern void free_space(), alloc_space(), realloc_space();
  182. extern char *my_malloc();
  183. extern char *dump_file;
  184.  
  185.  
  186.  
  187. extern ref e_t, e_nil, e_fixnum_type, e_loc_type, e_cons_type,
  188.   *e_subtype_table, *e_bp, *e_env, e_env_type, *e_argless_tag_trap_table,
  189.   *e_arged_tag_trap_table, e_object_type, e_segment_type, e_code_segment,
  190.   e_boot_code, e_current_method, e_uninitialized, e_method_type;
  191. extern unsigned long e_next_newspace_size, original_newspace_size;
  192. extern unsigned short *e_pc;
  193.  
  194.  
  195. extern void printref(), init_wp();
  196.  
  197. extern bool trace_segs;
  198.  
  199. extern bool dump_decimal, dump_binary;
  200.  
  201.  
  202. extern void read_world();
  203. extern ref read_ref();
  204. extern void dump_world();
  205.  
  206.  
  207.  
  208. extern long string_to_int();
  209.  
  210. extern unsigned long get_length();
  211.  
  212.  
  213. typedef struct
  214. {
  215.   ref *start, *end;
  216.   long size;
  217. #ifdef UNALIGNED
  218.   char offset;
  219. #endif
  220. } space;
  221.  
  222. extern space spatic, new;
  223. extern ref *free_point;
  224.  
  225.  
  226. #define SPACE_PTR(s,p)    ((s).start<=(p) && (p)<(s).end)
  227.  
  228. #define NEW_PTR(r)    SPACE_PTR(new,(r))
  229. #define SPATIC_PTR(r)    SPACE_PTR(spatic,(r))
  230.  
  231.  
  232. /* Leaving r unsigned lets us checks for negative and too big in one shot: */
  233. #define wp_to_ref(r)                    \
  234.   ( (unsigned long)REF_TO_INT(r) >= wp_index ?        \
  235.    e_nil : wp_table[1+(unsigned long)REF_TO_INT((r))] )
  236.  
  237.  
  238. #ifdef MALLOC_WP_TABLE
  239. extern ref *wp_table;
  240. #else
  241. extern ref wp_table[];
  242. #endif
  243.  
  244. extern ref ref_to_wp();
  245. extern long wp_index;
  246. extern void rebuild_wp_hashtable();
  247.  
  248. extern void gc();
  249. extern void gc_printref();
  250. extern bool gc_shutup;
  251.  
  252. extern ref *gc_examine_ptr;
  253. #define GC_MEMORY(v) {*gc_examine_ptr++ = (v);}
  254. #define GC_RECALL(v) {(v) = *--gc_examine_ptr;}
  255.  
  256.  
  257. /* This is used to allocate some storage.  It calls gc when necessary. */
  258.  
  259. #define ALLOCATE(p, words, place)            \
  260.   ALLOCATE_PROT(p, words, place, , )
  261.  
  262. /* This is used to allocate some storage while the stack pointers have not
  263.    been backed into the structures and must be backed up before gc. */
  264.  
  265. #define ALLOCATE_SS(p, words, place)            \
  266.   ALLOCATE_PROT(p, words, place,            \
  267.         { UNOPTC(cxt_stk.ptr = cxt_stk_ptr);    \
  268.           UNOPTV(val_stk.ptr = val_stk_ptr); },    \
  269.         { UNOPTV(val_stk_ptr = val_stk.ptr);    \
  270.           UNOPTC(cxt_stk_ptr = cxt_stk.ptr); })
  271.  
  272. /* This allocates some storange, assumeing the stack pointers have not been
  273.    backed into the structures and that v must be protected from gc. */
  274.  
  275. #define ALLOCATE1(p, words, place, v)            \
  276.   ALLOCATE_PROT(p, words, place,            \
  277.         { GC_MEMORY(v);                \
  278.           UNOPTC(cxt_stk.ptr = cxt_stk_ptr);    \
  279.           UNOPTV(val_stk.ptr = val_stk_ptr); },    \
  280.         { UNOPTV(val_stk_ptr = val_stk.ptr);    \
  281.           UNOPTC(cxt_stk_ptr = cxt_stk.ptr);    \
  282.           GC_RECALL(v); })
  283.  
  284. #define ALLOCATE_PROT(p, words, place, before, after)    \
  285.   /* ref *p; int words; string place; */        \
  286. {                            \
  287.   ref *new_free_point = free_point + (words);        \
  288.                             \
  289.   if (new_free_point >= new.end)            \
  290.     {                            \
  291.       before;                        \
  292.       gc(FALSE, FALSE, (place), (words));        \
  293.       after;                        \
  294.       new_free_point = free_point + (words);        \
  295.     }                            \
  296.                             \
  297.   (p) = free_point;                    \
  298.   free_point = new_free_point;                \
  299. }
  300.  
  301.  
  302.  
  303. /* These get slots out of Oaklisp objects, and may be used as lvalues. */
  304.  
  305. #define SLOT(p,s)    (*((p)+(s)))
  306. #define REF_SLOT(r,s)    SLOT(REF_TO_PTR(r),s)
  307.  
  308.  
  309.  
  310. #ifdef SIGNALS
  311.  
  312.  
  313. #ifdef __STDC__
  314. extern volatile int signal_poll_flag;
  315. #else
  316. extern int signal_poll_flag;
  317. #endif
  318.  
  319. extern void enable_signal_polling(), disable_signal_polling(), clear_signal();
  320. #define signal_pending()    (signal_poll_flag)
  321. #endif
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328. #ifdef PROTOTYPES
  329.   
  330. extern int isatty(FILE *file);        
  331. extern void maybe_dump_world_aux(int dumpstackp);        
  332. extern void printref(ref refin);        
  333. extern void old_find_method_type_pair(ref op,         
  334.                       ref obj_type,         
  335.                       ref *method_ptr,         
  336.                       ref *type_ptr);        
  337.  
  338. extern void find_method_type_pair(ref op,         
  339.                   ref obj_type,         
  340.                   ref *method_ptr,         
  341.                   ref *type_ptr);        
  342.  
  343. #ifdef Mac_LSC
  344. extern _main(int argc, char **argv);        
  345. #endif
  346.  
  347. #endif
  348.  
  349. /* eof */
  350.