#include <setjmp.h>
#define OPTIONAL_ARGUMENT_CHECK(fn, req, count)
#define REQUIRED_ARGUMENT_CHECK(fn, req, count)
/* CONCRETE RAW TYPES */
typedef signed char INT8;
typedef unsigned char UINT8;
typedef signed short INT16;
typedef unsigned short UINT16;
typedef signed long INT32;
typedef unsigned long UINT32;
#if defined(WIN32)
typedef _int64 INT64;
typedef unsigned _int64 UINT64;
#else
typedef signed long long INT64;
typedef unsigned long long UINT64;
#endif
typedef float FLT;
typedef double DFLT;
#ifdef WIN32
typedef double EFLT;
#else
typedef long double EFLT;
#endif
/* C RAW TYPES */
typedef INT64 long_long;
typedef UINT64 unsigned_long_long;
typedef EFLT long_double;
/* DYLAN RAW TYPES */
typedef unsigned long DBOOL;
typedef unsigned char DBCHR;
typedef unsigned char DBYTE;
typedef UINT16 DDBYTE;
typedef UINT16 DUCHR;
typedef long DSINT;
typedef long DMINT;
typedef DMINT DWORD;
typedef unsigned long DUMINT;
typedef INT64 DLMINT;
typedef DLMINT DDWORD;
typedef UINT64 DULMINT;
typedef INT64 DBINT;
typedef float DSFLT;
typedef double DDFLT;
typedef long double DEFLT;
typedef unsigned long DADDR;
typedef char* DBSTR;
typedef const char* DCBSTR;
typedef void* D;
/* DYLAN TAGGING */
#define TAG_BITS(x) (((unsigned long) x)&3)
#define ITAG 1
#define CTAG 2
#define BTAG 3
#define I(n) ((D)((((unsigned long)(n))<<2)|ITAG))
#define C(n) ((D)((((unsigned long)(n))<<2)|CTAG))
#define B(n) ((D)((((unsigned long)(n))<<2)|BTAG))
#define R(n) ((long)(n)>>2)
#define FI(n) ((D)(((unsigned long)(n))|ITAG))
#define FC(n) ((D)(((unsigned long)(n))|CTAG))
#define FB(n) ((D)(((unsigned long)(n))|BTAG))
#define TAGGEDQ(n) (TAG_BITS(n) != 0)
/*
#define DTRUE B(1)
#define DFALSE B(0)
*/
#define DTRUE &KPtrueVKi
#define DFALSE &KPfalseVKi
/* BASIC DYLAN TYPES */
typedef D (*DFN)(D,int,...);
typedef D (*DLFN)();
typedef struct _obj {
D mm_wrapper;
D slots[1];
} OBJECT;
typedef struct _dsf_ {
D mm_wrapper;
DSFLT data;
} DSF_;
typedef struct _ddf_ {
D mm_wrapper;
DDFLT data;
} DDF_;
typedef struct _dmi_ {
D mm_wrapper;
DMINT data;
} DMI_;
typedef struct _dumi_ {
D mm_wrapper;
DUMINT data;
} DUMI_;
typedef struct _dbi_ {
D mm_wrapper;
DUMINT low;
DMINT high;
} DBI_;
typedef struct _Wrapper {
D wrapper_wrapper;
D iclass;
D subtype_mask;
DMINT fixed_part;
DMINT variable_part;
D number_patterns;
DMINT patterns[1]; /* REPEATED */
} Wrapper;
typedef struct _IClass {
D my_wrapper;
D the_class_properties;
D the_class;
D the_wrapper;
} ICLASS;
typedef struct _dylantype {
D mm_wrapper;
DLFN instancep_function;
} DYLANTYPE;
typedef struct _DylanClass {
D my_wrapper;
D instancep_function;
D debug_name;
D the_iclass;
D subtype_bit;
} DYLANCLASS;
#define OBJECT_WRAPPER(x) \
(((OBJECT*)(x))->mm_wrapper)
#define OBJECT_ICLASS(x) \
(((Wrapper*)(OBJECT_WRAPPER(x)))->iclass)
#define OBJECT_CLASS(x) \
(((ICLASS*)(OBJECT_ICLASS(x)))->the_class)
#define CLASS_WRAPPER(x) \
(((DYLANCLASS*)(x))->the_wrapper)
#define CLASS_ICLASS(x) \
(((DYLANCLASS*)(x))->the_iclass)
#define ICLASS_WRAPPER(x) \
(((ICLASS*)(x))->the_wrapper)
#define ICLASS_CLASS(x) \
(((ICLASS*)(x))->the_class)
#define WRAPPER_ICLASS(x) \
(((Wrapper*)(x))->iclass)
#define WRAPPER_CLASS(x) \
(ICLASS_CLASS(WRAPPER_ICLASS(x)))
typedef DSF_* DSF;
typedef DDF_* DDF;
typedef DMI_* DMI;
typedef DUMI_* DUMI;
typedef DBI_* DBI;
#define define_SOV(_name, _size) \
typedef struct _sov##_name { \
D class; \
D size; \
D data[_size]; \
} _name
define_SOV(SOV, 1);
#define STACK_DATA_SIZE 16
#define STACK_SOV_SIZE STACK_DATA_SIZE
define_SOV(STACK_SOV, STACK_SOV_SIZE);
#define define_byte_string(_name, _size) \
typedef struct _bs##_name { \
D class; \
D size; \
char data[_size + 1]; \
} _name
define_byte_string(BS, 0);
typedef struct _symbol {
D class;
D name;
} SYMBOL;
typedef struct _fn {
D class;
DFN xep;
D signature;
DLFN mep;
} FN;
typedef struct _cfn {
D class;
DFN xep;
D signature;
DLFN mep;
D size;
D environment[0];
} CFN;
typedef struct _kfn {
D class;
DFN xep;
D signature;
DLFN mep;
DLFN iep;
D keyword_specifiers;
} KFN;
typedef struct _kcfn {
D class;
DFN xep;
D signature;
DLFN mep;
DLFN iep;
D keyword_specifiers;
D size;
D environment[0];
} KCFN;
typedef struct _accessor_method {
D header;
DFN xep;
D slotd;
} ACCESSOR;
typedef struct _sig {
D class;
D properties;
SOV* required;
SOV* values;
D rest_value;
} SIG;
typedef struct _engine {
D class;
D properties;
DLFN callback;
DLFN entry_point;
} ENGINE;
typedef struct _monomorphic_discriminator {
D class;
D properties;
DLFN callback;
DLFN entry_point;
DWORD key;
D nextnode;
} MONOMORPHICDISCRIMINATOR;
typedef struct _if_type_discriminator {
D class;
D properties;
DLFN callback;
DLFN entry_point;
D type;
D thennode;
D elsenode;
} IFTYPEDISCRIMINATOR;
typedef struct _typecheck_discriminator {
D class;
D properties;
DLFN callback;
DLFN entry_point;
D type;
D nextnode;
} TYPECHECKDISCRIMINATOR;
typedef struct _single_method_engine_node {
D class;
D properties;
DLFN callback;
DLFN entry_point;
D meth;
D data;
D keywords; /* Not in all. */
} SINGLEMETHODENGINE;
typedef struct _cache_header_engine_node {
D class;
D properties;
DLFN callback;
DLFN entry_point;
D nextnode;
D parent;
} CACHEHEADERENGINE;
typedef struct _profiling_cache_header_engine_node {
D class;
D properties;
DLFN callback;
DLFN entry_point;
D nextnode;
D parent;
DSINT count1;
DSINT count2;
} PROFILINGCACHEHEADERENGINE;
typedef struct _gfn {
D class;
DFN xep;
D signature;
D cache;
D debug_name;
D methods;
ENGINE* engine;
} GFN;
#define DEFUN(name, xep, iep) D name[] = {I(0),I(0),I(0),(D)xep,(D)iep,I(0),I(0),I(0),I(0)}
extern D primitive_set_generic_function_entrypoints(D fn); /* !@#$ FIX UP NAME */
extern D primitive_runtime_module_handle();
/* MULTIPLE VALUES */
#define VALUES_MAX 64 /* maximum number of multiple values */
typedef struct _mv {
int count;
D value[VALUES_MAX];
} MV;
extern MV Preturn_values; /* should be per-thread mv return area */
#define MV_GET_ELT(n) \
(Preturn_values.count > (n) ? Preturn_values.value[n] : DFALSE)
#define MV_GET_ELT_KNOWN(n) (Preturn_values.value[n])
#define MV_SET_ELT(n, t) (Preturn_values.value[n] = (t))
#define MV_SET_COUNT(n) (Preturn_values.count = (n))
#define MV_GET_COUNT() (Preturn_values.count)
extern void MV_ADJ (DSINT n);
extern void MV_ADJ_REST (DSINT n);
extern D MV_SPILL (D first_value);
extern D MV_UNSPILL (D spill_t);
extern D MV_GET_REST_AT (D first_value, DSINT first);
extern D MV_SET_REST_AT (D v, DSINT first);
extern D MV_CHECK_TYPE_REST (D first_value, D rest_type, int n, ...);
#define MV_CHECK_TYPE_PROLOGUE(fv) \
MV *spill; \
spill = (MV*)MV_SPILL(fv)
#define MV_CHECK_TYPE_ARGUMENT(i) \
spill->value[i]
#define MV_CHECK_TYPE_EPILOGUE() \
MV_UNSPILL((D)spill)
extern DMINT _unused_arg;
extern DMINT* P_unused_arg;
/* NON-LOCAL CONTROL FLOW FRAMES */
typedef struct _bind_exit_frame {
jmp_buf destination;
MV return_values;
struct _unwind_protect_frame* present_unwind_protect_frame;
} Bind_exit_frame;
typedef struct _unwind_protect_frame {
jmp_buf destination;
MV return_values;
struct _bind_exit_frame* ultimate_destination;
struct _unwind_protect_frame* previous_unwind_protect_frame;
} Unwind_protect_frame;
extern D MAKE_EXIT_FRAME ();
extern D MAKE_UNWIND_FRAME ();
extern D FRAME_DEST (D);
extern D FRAME_RETVAL (D);
extern D FALL_THROUGH_UNWIND (D);
extern D CONTINUE_UNWIND ();
extern D NLX (Bind_exit_frame*, D);
extern Unwind_protect_frame* Pcurrent_unwind_protect_frame;
/* CALLING CONVENTION REGISTERS */
extern FN* Pfunction_;
extern int Pargument_count_;
extern D Pnext_methods_;
extern D XEP(FN*, int, ...);
extern D topI();
/* CALLING CONVENTION ENTRY POINTS */
extern D xep_0 (FN*,int);
extern D xep_1 (FN*,int,D);
extern D xep_2 (FN*,int,D,D);
extern D xep_3 (FN*,int,D,D,D);
extern D xep_4 (FN*,int,D,D,D,D);
extern D xep_5 (FN*,int,D,D,D,D,D);
extern D xep_6 (FN*,int,D,D,D,D,D,D);
extern D xep_7 (FN*,int,D,D,D,D,D,D,D);
extern D xep_8 (FN*,int,D,D,D,D,D,D,D,D);
extern D xep_9 (FN*,int,D,D,D,D,D,D,D,D,D);
extern D xep (FN*,int,...);
extern D rest_xep_0 (FN*,int,...);
extern D rest_xep_1 (FN*,int,D,...);
extern D rest_xep_2 (FN*,int,D,D,...);
extern D rest_xep_3 (FN*,int,D,D,D,...);
extern D rest_xep_4 (FN*,int,D,D,D,D,...);
extern D rest_xep_5 (FN*,int,D,D,D,D,D,...);
extern D rest_xep_6 (FN*,int,D,D,D,D,D,D,...);
extern D rest_xep_7 (FN*,int,D,D,D,D,D,D,D,...);
extern D rest_xep_8 (FN*,int,D,D,D,D,D,D,D,D,...);
extern D rest_xep_9 (FN*,int,D,D,D,D,D,D,D,D,D,...);
extern D rest_xep (FN*,int,...);
extern D rest_key_xep_1 (FN*,int,...);
extern D rest_key_xep_2 (FN*,int,...);
extern D rest_key_xep_3 (FN*,int,...);
extern D rest_key_xep_4 (FN*,int,...);
extern D rest_key_xep_5 (FN*,int,...);
extern D rest_key_xep_6 (FN*,int,...);
extern D rest_key_xep_7 (FN*,int,...);
extern D rest_key_xep_8 (FN*,int,...);
extern D rest_key_xep_9 (FN*,int,...);
extern D rest_key_xep (FN*,int,...);
extern D key_mep_1 (D a1, ...);
extern D key_mep_2 (D a1, ...);
extern D key_mep_3 (D a1, ...);
extern D key_mep_4 (D a1, ...);
extern D key_mep_5 (D a1, ...);
extern D key_mep_6 (D a1, ...);
extern D key_mep_7 (D a1, ...);
extern D key_mep_8 (D a1, ...);
extern D key_mep_9 (D a1, ...);
extern D key_mep (D a1, ...);
extern D gf_xep_0 (FN* fn, int n);
extern D gf_xep_1 (FN* fn, int n, D a1);
extern D gf_xep_2 (FN* fn, int n, D a1, D a2);
extern D gf_xep_3 (FN* fn, int n, D a1, D a2, D a3);
extern D gf_xep_4 (FN* fn, int n, D a1, D a2, D a3, D a4);
extern D gf_xep_5 (FN* fn, int n, D a1, D a2, D a3, D a4, D a5);
extern D gf_xep_6 (FN* fn, int n, D a1, D a2, D a3, D a4, D a5, D a6);
extern D gf_xep_7 (FN* fn, int n, D a1, D a2, D a3, D a4, D a5, D a6, D a7);
extern D gf_xep (FN* fn, int n, ...);
extern D gf_optional_xep_0 (FN* fn, int n, ...);
extern D gf_optional_xep_1 (FN* fn, int n, ...);
extern D gf_optional_xep_2 (FN* fn, int n, ...);
extern D gf_optional_xep_3 (FN* fn, int n, ...);
extern D gf_optional_xep_4 (FN* fn, int n, ...);
extern D gf_optional_xep_5 (FN* fn, int n, ...);
extern D gf_optional_xep_6 (FN* fn, int n, ...);
extern D gf_optional_xep (FN* fn, int n, ...);
extern D gf_iep_0 ();
extern D gf_iep_1 (D a1);
extern D gf_iep_2 (D a1, D a2);
extern D gf_iep_3 (D a1, D a2, D a3);
extern D gf_iep_4 (D a1, D a2, D a3, D a4);
extern D gf_iep_5 (D a1, D a2, D a3, D a4, D a5);
extern D gf_iep_6 (D a1, D a2, D a3, D a4, D a5, D a6);
extern D gf_iep_7 (D a1, D a2, D a3, D a4, D a5, D a6, D a7);
extern D gf_iep (D argvec);
extern D slotacc_single_q_instance_getter_xep (ACCESSOR* am, int n, D a1);
extern D slotacc_single_q_instance_setter_xep (ACCESSOR* am, int n, D a1, D a2);
extern D slotacc_single_q_class_getter_xep (ACCESSOR* am, int n, D a1);
extern D slotacc_single_q_class_setter_xep (ACCESSOR* am, int n, D a1, D a2);
extern D slotacc_repeated_instance_getter_xep (ACCESSOR* am, int n, D a1, D a2);
extern D slotacc_repeated_instance_setter_xep (ACCESSOR* am, int n, D a1, D a2, D a3);
extern D primitive_set_accessor_method_xep (D am, D what);
#define CALLN(fn,n) (D)((((FN*)fn)->xep)(((FN*)(fn)),n
#define CALL0(fn) CALLN(fn,0)))
#define CALL1(fn,a1) CALLN(fn,1),(a1)))
#define CALL2(fn,a1,a2) CALLN(fn,2),(a1),(a2)))
#define CALL3(fn,a1,a2,a3) CALLN(fn,3),(a1),(a2),(a3)))
#define CALL4(fn,a1,a2,a3,a4) CALLN(fn,4),(a1),(a2),(a3),(a4)))
#define CALL5(fn,a1,a2,a3,a4,a5) CALLN(fn,5),(a1),(a2),(a3),(a4),(a5)))
#define CALL6(fn,a1,a2,a3,a4,a5,a6) CALLN(fn,6),(a1),(a2),(a3),(a4),(a5),(a6)))
#define CALL7(fn,a1,a2,a3,a4,a5,a6,a7) CALLN(fn,7),(a1),(a2),(a3),(a4),(a5),(a6),(a7)))
#define CALL8(fn,a1,a2,a3,a4,a5,a6,a7,a8) CALLN(fn,8),(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8)))
#define CALL9(fn,a1,a2,a3,a4,a5,a6,a7,a8,a9) CALLN(fn,9),(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9)))
#define CALL10(fn,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) CALLN(fn,10),(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9),(a10)))
#define MEP_CALL_PROLOG(fn,nm,ac) { Pfunction_ = (FN*)(fn); Pnext_methods_ = (nm); Pargument_count_ = (ac); }
#define MEP_CALLN(fn) (D)((((FN*)fn)->mep)(
#define MEP_CALL0(fn) MEP_CALLN(fn)))
#define MEP_CALL1(fn,a1) MEP_CALLN(fn)(a1)))
#define MEP_CALL2(fn,a1,a2) MEP_CALLN(fn)(a1),(a2)))
#define MEP_CALL3(fn,a1,a2,a3) MEP_CALLN(fn)(a1),(a2),(a3)))
#define MEP_CALL4(fn,a1,a2,a3,a4) MEP_CALLN(fn)(a1),(a2),(a3),(a4)))
#define MEP_CALL5(fn,a1,a2,a3,a4,a5) MEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5)))
#define MEP_CALL6(fn,a1,a2,a3,a4,a5,a6) MEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6)))
#define MEP_CALL7(fn,a1,a2,a3,a4,a5,a6,a7) MEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6),(a7)))
#define MEP_CALL8(fn,a1,a2,a3,a4,a5,a6,a7,a8) MEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8)))
#define MEP_CALL9(fn,a1,a2,a3,a4,a5,a6,a7,a8,a9) MEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9)))
#define MEP_CALL10(fn,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) MEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9),(a10)))
#define MIEP_CALL_PROLOG(nm) { Pnext_methods_ = (nm); }
#define ENGINE_NODE_CALL_PROLOG(fn,eng,ac) \
{ Pnext_methods_ = (fn); Pfunction_ = (FN*)(eng); Pargument_count_ =(ac);}
#define ENGINE_NODE_CALL(fn,eng,ac) \
{ Pnext_methods_ = (fn); Pfunction_ = (FN*)(eng); }
#define ENGINE_NODE_CALL0(eng) \
((((ENGINE*)eng)->entry_point)())
#define ENGINE_NODE_CALL1(eng,a1) \
((((ENGINE*)eng)->entry_point)((a1)))
#define ENGINE_NODE_CALL2(eng,a1,a2) \
((((ENGINE*)eng)->entry_point)((a1),(a2)))
#define ENGINE_NODE_CALL3(eng,a1,a2,a3) \
((((ENGINE*)eng)->entry_point)((a1),(a2),(a3)))
#define ENGINE_NODE_CALL4(eng,a1,a2,a3,a4) \
((((ENGINE*)eng)->entry_point)((a1),(a2),(a3),(a4)))
#define ENGINE_NODE_CALL5(eng,a1,a2,a3,a4,a5) \
((((ENGINE*)eng)->entry_point)((a1),(a2),(a3),(a4),(a5)))
#define ENGINE_NODE_CALL6(eng,a1,a2,a3,a4,a5,a6) \
((((ENGINE*)eng)->entry_point)((a1),(a2),(a3),(a4),(a5),(a6)))
#define ENGINE_NODE_CALL7(eng,a1,a2,a3,a4,a5,a6,a7) \
((((ENGINE*)eng)->entry_point)((a1),(a2),(a3),(a4),(a5),(a6),(a7)))
extern D inline_invoke_engine_node(ENGINE*, int, ...);
#define ENGINE_NODE_CALLN(ac,eng) \
(inline_invoke_engine_node((ENGINE*)(eng),(ac)
#define CONGRUENT_CALL_PROLOG(fn,ac) \
{ Pnext_methods_ = (fn); Pfunction_ = (FN*)(((GFN*)fn)->engine); Pargument_count_ =(ac);}
#define CONGRUENT_CALL(fn,ac) \
{ Pnext_methods_ = (fn); Pfunction_ = (FN*)(((GFN*)fn)->engine); }
#define CONGRUENT_CALL0() \
((((ENGINE*)Pfunction_)->entry_point)())
#define CONGRUENT_CALL1(a1) \
((((ENGINE*)Pfunction_)->entry_point)((a1)))
#define CONGRUENT_CALL2(a1,a2) \
((((ENGINE*)Pfunction_)->entry_point)((a1),(a2)))
#define CONGRUENT_CALL3(a1,a2,a3) \
((((ENGINE*)Pfunction_)->entry_point)((a1),(a2),(a3)))
#define CONGRUENT_CALL4(a1,a2,a3,a4) \
((((ENGINE*)Pfunction_)->entry_point)((a1),(a2),(a3),(a4)))
#define CONGRUENT_CALL5(a1,a2,a3,a4,a5) \
((((ENGINE*)Pfunction_)->entry_point)((a1),(a2),(a3),(a4),(a5)))
#define CONGRUENT_CALL6(a1,a2,a3,a4,a5,a6) \
((((ENGINE*)Pfunction_)->entry_point)((a1),(a2),(a3),(a4),(a5),(a6)))
#define CONGRUENT_CALL7(a1,a2,a3,a4,a5,a6,a7) \
((((ENGINE*)Pfunction_)->entry_point)((a1),(a2),(a3),(a4),(a5),(a6),(a7)))
#define CONGRUENT_CALLN(ac) \
(inline_invoke_engine_node((ENGINE*)(Pfunction_),(ac)
#define IEP_CALLN(fn) (D)((((FN*)fn)->iep)(
#define IEP_CALL0(fn) IEP_CALLN(fn)))
#define IEP_CALL1(fn,a1) IEP_CALLN(fn)(a1)))
#define IEP_CALL2(fn,a1,a2) IEP_CALLN(fn)(a1),(a2)))
#define IEP_CALL3(fn,a1,a2,a3) IEP_CALLN(fn)(a1),(a2),(a3)))
#define IEP_CALL4(fn,a1,a2,a3,a4) IEP_CALLN(fn)(a1),(a2),(a3),(a4)))
#define IEP_CALL5(fn,a1,a2,a3,a4,a5) IEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5)))
#define IEP_CALL6(fn,a1,a2,a3,a4,a5,a6) IEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6)))
#define IEP_CALL7(fn,a1,a2,a3,a4,a5,a6,a7) IEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6),(a7)))
#define IEP_CALL8(fn,a1,a2,a3,a4,a5,a6,a7,a8) IEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8)))
#define IEP_CALL9(fn,a1,a2,a3,a4,a5,a6,a7,a8,a9) IEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9)))
#define IEP_CALL10(fn,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) IEP_CALLN(fn)(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9),(a10)))
/* CLOSURE SUPPORT */
extern void INIT_CLOSURE(D, int, ...);
extern D MAKE_CLOSURE_INITD(D, int, ...);
extern D MAKE_CLOSURE_INITD_SIG(D, D, int, ...);
extern D MAKE_CLOSURE(D, int);
extern D MAKE_CLOSURE_SIG(D, D, int);
extern D MAKE_METHOD_SIG(D, D);
extern D SET_METHOD_SIG(D, D);
#define CAPTURE_ENVIRONMENT CFN* _fn = ((CFN*)Pfunction_);
extern void INIT_KEYWORD_CLOSURE(D, int, ...);
extern D MAKE_KEYWORD_CLOSURE_INITD(D, int, ...);
extern D MAKE_KEYWORD_CLOSURE_INITD_SIG(D, D, int, ...);
extern D MAKE_KEYWORD_CLOSURE(D, int);
extern D MAKE_KEYWORD_CLOSURE_SIG(D, D, int);
extern D MAKE_KEYWORD_METHOD_SIG(D, D);
extern D SET_KEYWORD_METHOD_SIG(D, D);
#define CAPTURE_KEYWORD_ENVIRONMENT KCFN* _fn = ((KCFN*)Pfunction_);
#define CREF(n) (_fn->environment[(n)])
#define MREF (_fn)
/* LOOP SUPPORT */
#define LOOP while(1)
/*
* PRIMITIVES
*/
/* COMPARISON PRIMITIVES */
#define RAWASBOOL(x) ((D)((x) ? DTRUE : DFALSE))
#define primitive_raw_as_boolean(x) RAWASBOOL(x)
#define primitive_as_boolean(x) (((D)(x)) == DFALSE ? DFALSE : DTRUE)
#define BOOLASRAW(x) (((D)(x)) != DFALSE)
#define primitive_boolean_as_raw(x) BOOLASRAW(x)
#define primitive_not(x) (((D)(x)) == DFALSE ? DTRUE : DFALSE)
#define primitive_idQ(x, y) (RAWASBOOL((x) == (y)))
#define primitive_not_idQ(x, y) (RAWASBOOL((x) != (y)))
extern D primitive_compare_bytes(D base1, DSINT offset1,
D base2, DSINT offset2, DSINT size);
extern D primitive_compare_words(D base1, DSINT offset1,
D base2, DSINT offset2, DSINT size);
/* COMPARISON PRIMITIVES */
#define primitive_instanceQ(x, y) ((((DYLANTYPE*)(y))->instancep_function)((x),(y)))
#define primitive_range_check(x, l, h) (RAWASBOOL(((x) >= (l)) & ((x) < (h))))
extern D primitive_type_check(D x, D t);
/* OBJECT REPRESENTATION PRIMITIVES AND SUPPORT */
extern void primitive_break (void);
extern void primitive_invoke_debugger (D format_string, D arguments);
extern D primitive_inside_debuggerQ (void);
extern void primitive_debug_message (D format_string, D arguments);
# if defined(__alpha)
# define ALPHA
# endif
#if defined(ALPHA)
#define primitive_word_size() 8
#else
#define primitive_word_size() 4
#endif
#define primitive_header_size() primitive_word_size ()
/* Well this wasn't right
#define primitive_object_class(object) (((OBJECT*)object)->class)
*/
#define primitive_initialized_slot_value(object, position) \
((((OBJECT*)object)->slots)[position])
#define primitive_slot_value_setter(new_value, object, position) \
((((OBJECT*)object)->slots)[position] = (new_value))
extern D primitive_slot_value(D object, DSINT position);
#define primitive_repeated_slot_value(object, base_position, position) \
((((OBJECT*)object)->slots)[base_position + position])
#define primitive_repeated_slot_value_setter(new_value, object, base_position, position) \
((((OBJECT*)object)->slots)[base_position + position] = (new_value))
#define primitive_repeated_instance_size(object, base_position) \
(R((((OBJECT*)object)->slots)[base_position - 1]))
#define primitive_byte_element(object, position, index) \
(((DBCHR*)&((((OBJECT*)object)->slots)[position]))[index])
#define primitive_byte_element_setter(new_value, object, position, index) \
(((DBCHR*)&((((OBJECT*)object)->slots)[position]))[index] = \
(new_value))
#define SLOT_VALUE_INITD(object, position) \
((((OBJECT*)object)->slots)[position])
#define SLOT_VALUE_SETTER(new_value, object, position) \
((((OBJECT*)object)->slots)[position] = (new_value))
extern D SLOT_VALUE(D object, DSINT position);
#define REPEATED_D_SLOT_VALUE(object, base_position, position) \
((((OBJECT*)object)->slots)[base_position + position])
#define REPEATED_D_SLOT_VALUE_SETTER(new_value, object, base_position, position) \
((((OBJECT*)object)->slots)[base_position + position] = (new_value))
#define REPEATED_DBCHR_SLOT_VALUE(object, position, index) \
(((DBCHR*)&((((OBJECT*)object)->slots)[position]))[index])
#define REPEATED_DBCHR_SLOT_VALUE_SETTER(new_value, object, position, index) \
(((DBCHR*)&((((OBJECT*)object)->slots)[position]))[index] = \
(new_value))
#define REPEATED_DUCHR_SLOT_VALUE(object, position, index) \
(((DUCHR*)&((((OBJECT*)object)->slots)[position]))[index])
#define REPEATED_DUCHR_SLOT_VALUE_SETTER(new_value, object, position, index) \
(((DUCHR*)&((((OBJECT*)object)->slots)[position]))[index] = \
(new_value))
#define REPEATED_DBYTE_SLOT_VALUE(object, position, index) \
(((DBYTE*)&((((OBJECT*)object)->slots)[position]))[index])
#define REPEATED_DBYTE_SLOT_VALUE_SETTER(new_value, object, position, index) \
(((DBYTE*)&((((OBJECT*)object)->slots)[position]))[index] = \
(new_value))
#define REPEATED_DDBYTE_SLOT_VALUE(object, position, index) \
(((DDBYTE*)&((((OBJECT*)object)->slots)[position]))[index])
#define REPEATED_DDBYTE_SLOT_VALUE_SETTER(new_value, object, position, index) \
(((DDBYTE*)&((((OBJECT*)object)->slots)[position]))[index] = \
(new_value))
#define REPEATED_DDFLT_SLOT_VALUE(object, base_position, position) \
(((DDFLT*)(((OBJECT*)object)->slots))[base_position + R(position)])
#define REPEATED_DDFLT_SLOT_VALUE_SETTER(new_value, object, base_position, position) \
(((DDFLT*)(((OBJECT*)object)->slots))[base_position + R(position)] = (new_value))
#define REPEATED_DDWORD_SLOT_VALUE(object, base_position, position) \
(((DDWORD*)(((OBJECT*)object)->slots))[base_position + R(position)])
#define REPEATED_DDWORD_SLOT_VALUE_SETTER(new_value, object, base_position, position) \
(((DDWORD*)(((OBJECT*)object)->slots))[base_position + R(position)] = (new_value))
#define REPEATED_D_SLOT_VALUE_TAGGED(object, base_position, position) \
((((OBJECT*)object)->slots)[base_position + R(position)])
#define REPEATED_D_SLOT_VALUE_TAGGED_SETTER(new_value, object, base_position, position) \
((((OBJECT*)object)->slots)[base_position + R(position)] = (new_value))
#define REPEATED_DWORD_SLOT_VALUE_TAGGED(object, base_position, position) \
(((DWORD*)(((OBJECT*)object)->slots))[base_position + R(position)])
#define REPEATED_DWORD_SLOT_VALUE_TAGGED_SETTER(new_value, object, base_position, position) \
(((DWORD*)(((OBJECT*)object)->slots))[base_position + R(position)] = (new_value))
#define REPEATED_DSFLT_SLOT_VALUE_TAGGED(object, base_position, position) \
(((DSFLT*)(((OBJECT*)object)->slots))[base_position + R(position)])
#define REPEATED_DSFLT_SLOT_VALUE_TAGGED_SETTER(new_value, object, base_position, position) \
(((DSFLT*)(((OBJECT*)object)->slots))[base_position + R(position)] = (new_value))
/* SHOULD REMOVE BELOW */
#define REPEATED_DBCHR_SLOT_VALUE_TAGGED(object, position, index) \
(((DBCHR*)&((((OBJECT*)object)->slots)[position]))[R(index)])
#define REPEATED_DBCHR_SLOT_VALUE_TAGGED_SETTER(new_value, object, position, index) \
(((DBCHR*)&((((OBJECT*)object)->slots)[position]))[R(index)] = \
(new_value))
#define REPEATED_DUCHR_SLOT_VALUE_TAGGED(object, position, index) \
(((DUCHR*)&((((OBJECT*)object)->slots)[position]))[R(index)])
#define REPEATED_DUCHR_SLOT_VALUE_TAGGED_SETTER(new_value, object, position, index) \
(((DUCHR*)&((((OBJECT*)object)->slots)[position]))[R(index)] = \
(new_value))
#define REPEATED_DBYTE_SLOT_VALUE_TAGGED(object, position, index) \
(((DBYTE*)&((((OBJECT*)object)->slots)[position]))[R(index)])
#define REPEATED_DBYTE_SLOT_VALUE_TAGGED_SETTER(new_value, object, position, index) \
(((DBYTE*)&((((OBJECT*)object)->slots)[position]))[R(index)] = \
(new_value))
#define REPEATED_DDBYTE_SLOT_VALUE_TAGGED(object, position, index) \
(((DDBYTE*)&((((OBJECT*)object)->slots)[position]))[R(index)])
#define REPEATED_DDBYTE_SLOT_VALUE_TAGGED_SETTER(new_value, object, position, index) \
(((DDBYTE*)&((((OBJECT*)object)->slots)[position]))[R(index)] = \
(new_value))
#define REPEATED_DDFLT_SLOT_VALUE_TAGGED(object, base_position, position) \
(((DDFLT*)(((OBJECT*)object)->slots))[base_position + R(position)])
#define REPEATED_DDFLT_SLOT_VALUE_TAGGED_SETTER(new_value, object, base_position, position) \
(((DDFLT*)(((OBJECT*)object)->slots))[base_position + R(position)] = (new_value))
extern DSINT primitive_repeated_slot_offset(D x);
extern D primitive_repeated_slot_as_raw(D x, DSINT offset);
extern void primitive_fillX
(D dst, int base_offset, int offset, int size, D value);
extern void primitive_fill_bytesX
(D dst, int base_offset, int offset, int size, DSINT value);
extern void primitive_replace_bytesX
(D dst, DSINT dst_base_offset, DSINT dst_offset,
D src, DSINT src_base_offset, DSINT src_offset, DSINT size);
extern void primitive_replaceX
(D dst, DSINT dst_base_offset, DSINT dst_offset,
D src, DSINT src_base_offset, DSINT src_offset, DSINT size);
/* LOW-LEVEL ACCESSOR PRIMITIVES */
#define AT(t,x,o,b) (((t*)(((DADDR)(x))+(int)(b)))[(int)(o)])
#define AT_SETTER(t,e,x,o,b) (AT(t,x,o,b) = (e))
#define primitive_c_pointer_at(x, o, b) AT(void *,x,o,b)
#define primitive_c_pointer_at_setter(e, x, o, b) AT_SETTER(void*,e,x,o,b)
#define primitive_c_signed_int_at(x, o, b) \
AT(signed int,x,o,b)
#define primitive_c_signed_int_at_setter(e, x, o, b) \
AT_SETTER(signed int,e,x,o,b)
#define primitive_c_unsigned_int_at(x, o, b) \
AT(unsigned int,x,o,b)
#define primitive_c_unsigned_int_at_setter(e, x, o, b) \
AT_SETTER(unsigned int,e,x,o,b)
#define primitive_c_signed_char_at(x, o, b) \
AT(signed char,x,o,b)
#define primitive_c_signed_char_at_setter(e, x, o, b) \
AT_SETTER(signed char,e,x,o,b)
#define primitive_c_unsigned_char_at(x, o, b) \
AT(unsigned char,x,o,b)
#define primitive_c_unsigned_char_at_setter(e, x, o, b) \
AT_SETTER(unsigned char,e,x,o,b)
#define primitive_c_signed_short_at(x, o, b) \
AT(signed short,x,o,b)
#define primitive_c_signed_short_at_setter(e, x, o, b) \
AT_SETTER(signed short,e,x,o,b)
#define primitive_c_unsigned_short_at(x, o, b) \
AT(unsigned short,x,o,b)
#define primitive_c_unsigned_short_at_setter(e, x, o, b) \
AT_SETTER(unsigned short,e,x,o,b)
#define primitive_c_signed_long_at(x, o, b) \
AT(signed long,x,o,b)
#define primitive_c_signed_long_at_setter(e, x, o, b) \
AT_SETTER(signed long,e,x,o,b)
#define primitive_c_unsigned_long_at(x, o, b) \
AT(unsigned long,x,o,b)
#define primitive_c_unsigned_long_at_setter(e, x, o, b) \
AT_SETTER(unsigned long,e,x,o,b)
#define primitive_c_signed_long_long_at(x, o, b) \
AT(signed_long_long,x,o,b)
#define primitive_c_signed_long_long_at_setter(e, x, o, b) \
AT_SETTER(signed_long_long,e,x,o,b)
#define primitive_c_unsigned_long_long_at(x, o, b) \
AT(unsigned_long_long,x,o,b)
#define primitive_c_unsigned_long_long_at_setter(e, x, o, b) \
AT_SETTER(unsigned_long_long,e,x,o,b)
#define primitive_c_float_at(x, o, b) \
AT(float,x,o,b)
#define primitive_c_float_at_setter(e, x, o, b) \
AT_SETTER(float,e,x,o,b)
#define primitive_c_double_at(x, o, b) \
AT(double,x,o,b)
#define primitive_c_double_at_setter(e, x, o, b) \
AT_SETTER(double,e,x,o,b)
#define primitive_c_long_double_at(x, o, b) \
AT(long_double,x,o,b)
#define primitive_c_long_double_at_setter(e, x, o, b) \
AT_SETTER(long_double,e,x,o,b)
/*
* bit-size and bit-offset are Dylan constants so a good C compiler
* should be able to optimize these.
*/
#define MAKE_MASK(t, bit_offset, bit_size) \
((~(((t)(-1l)) << (bit_size))) << (bit_offset))
#define AT_FIELD(t, x, b, bit_offset, bit_size) \
((t)(((*((unsigned long *)(((DADDR)(x))+(b)))) >> (bit_offset)) \
& MAKE_MASK(t, 0, bit_size)))
#define AT_FIELD_SETTER(t, n, x, b, bit_offset, bit_size) \
(*((t *)(((DADDR)(x))+(b))) = \
((((n) & MAKE_MASK(t, 0, bit_size)) << (bit_offset)) \
| ( (*((t *)(((DADDR)(x))+(b)))) \
& ((t)~MAKE_MASK(t, bit_offset, bit_size)))))
#define primitive_c_unsigned_field(pointer, byte_offset, bit_offset, \
bit_size) \
AT_FIELD(unsigned long, pointer, byte_offset, bit_offset, bit_size)
#define primitive_c_signed_field(pointer, byte_offset, bit_offset, \
bit_size) \
AT_FIELD(signed long, pointer, byte_offset, bit_offset, bit_size)
#define primitive_c_int_field(pointer, byte_offset, bit_offset, \
bit_size) \
AT_FIELD(unsigned int, pointer, byte_offset, bit_offset, bit_size)
#define primitive_c_unsigned_field_setter(new, pointer, byte_offset, \
bit_offset, bit_size) \
AT_FIELD_SETTER(unsigned long, new, pointer, byte_offset, bit_offset, \
bit_size)
#define primitive_c_signed_field_setter(new, pointer, byte_offset, \
bit_offset, bit_size) \
AT_FIELD_SETTER(signed long, new, pointer, byte_offset, bit_offset, \
bit_size)
#define primitive_c_int_field_setter(new, pointer, byte_offset, \
bit_offset, bit_size) \
AT_FIELD_SETTER(unsigned int, new, pointer, byte_offset, bit_offset, \
bit_size)
#define primitive_element(x, o, b) \
AT(D,x,o,b)
#define primitive_element_setter(e, x, o, b) \
AT_SETTER(D,e,x,o,b)
/*
#define primitive_boolean_at(x, o, b) \
AT(DBOOL,x,o,b)
#define primitive_boolean_at_setter(e, x, o, b) \
AT_SETTER(DBOOL,e,x,o,b)
#define primitive_byte_character_at(x, o, b) \
AT(DBCHR,x,o,b)
#define primitive_byte_character_at_setter(e, x, o, b) \
AT_SETTER(DBCHR,e,x,o,b)
#define primitive_small_integer_at(x, o, b) \
AT(DSINT,x,o,b)
#define primitive_small_integer_at_setter(e, x, o, b) \
AT_SETTER(DSINT,e,x,o,b)
#define primitive_machine_integer_at(x, o, b) \
AT(DMINT,x,o,b)
#define primitive_machine_integer_at_setter(e, x, o, b) \
AT_SETTER(DMINT,e,x,o,b)
#define primitive_unsigned_machine_integer_at(x, o, b) \
AT(DUMINT,x,o,b)
#define primitive_unsigned_machine_integer_at_setter(e, x, o, b) \
AT_SETTER(DUMINT,e,x,o,b)
#define primitive_long_machine_integer_at(x, o, b) \
AT(DMINT,x,o,b)
#define primitive_long_machine_integer_at_setter(e, x, o, b) \
AT_SETTER(DMINT,e,x,o,b)
#define primitive_unsigned_long_machine_integer_at(x, o, b) \
AT(DUMINT,x,o,b)
#define primitive_unsigned_long_machine_integer_at_setter(e, x, o, b) \
AT_SETTER(DUMINT,e,x,o,b)
#define primitive_single_float_at(x, o, b) \
AT(float,x,o,b)
#define primitive_single_float_at_setter(e, x, o, b) \
AT_SETTER(float,e,x,o,b)
#define primitive_double_float_at(x, o, b) \
AT(double,x,o,b)
#define primitive_double_float_at_setter(e, x, o, b) \
AT_SETTER(double,e,x,o,b)
#define primitive_extended_float_at(x, o, b) \
AT(long_double,x,o,b)
#define primitive_extended_float_at_setter(e, x, o, b) \
AT_SETTER(long_double,e,x,o,b)
#define primitive_pointer_at(x, o, b) \
AT(D,x,o,b)
#define primitive_pointer_at_setter(e, x, o, b) \
AT_SETTER(D,e,x,o,b)
#define primitive_address_at(x, o, b) \
AT(DADDR,x,o,b)
#define primitive_address_at_setter(e, x, o, b) \
AT_SETTER(DADDR,e,x,o,b)
*/
/* ALLOCATION PRIMITIVES */
extern D primitive_allocate(DSINT);
extern D primitive_byte_allocate(DSINT, DSINT);
extern D primitive_untraced_allocate(DSINT);
extern D primitive_manual_allocate(D);
extern void primitive_manual_free(D);
extern D primitive_allocate_wrapper(DSINT, D, DSINT, D, DSINT, DSINT);
extern D primitive_byte_allocate_filled_terminated(DSINT, DSINT, D, DSINT, D, DSINT, DSINT);
#define primitive_byte_allocate_leaf_filled_terminated primitive_byte_allocate_filled_terminated
extern D primitive_allocate_filled(DSINT, D, DSINT, D, DSINT, DSINT);
extern D primitive_object_allocate_filled(DSINT, D, DSINT, D, DSINT, DSINT, D);
extern D primitive_byte_allocate_filled(DSINT, D, DSINT, D, DSINT, DSINT, DBYTE);
extern D primitive_double_byte_allocate_filled(DSINT, D, DSINT, D, DSINT, DSINT, DDBYTE);
extern D primitive_word_allocate_filled(DSINT, D, DSINT, D, DSINT, DSINT, DWORD);
extern D primitive_double_word_allocate_filled(DSINT, D, DSINT, D, DSINT, DSINT, DDWORD);
extern D primitive_single_float_allocate_filled(DSINT, D, DSINT, D, DSINT, DSINT, DSFLT);
extern D primitive_double_float_allocate_filled(DSINT, D, DSINT, D, DSINT, DSINT, DDFLT);
#define primitive_byte_allocate_leaf_filled primitive_byte_allocate_filled
extern D primitive_allocate_in_awl_pool(DSINT, D, DSINT, D, DSINT, DSINT, D);
extern D primitive_allocate_weak_in_awl_pool(DSINT, D, DSINT, D, DSINT, DSINT, D);
/* stack allocation */
#ifdef WIN32
#include <malloc.h>
#else
#include <alloca.h>
#endif
#define primitive_stack_allocate(sz) ((D)(alloca((int)(sz) * sizeof(D))))
#define primitive_save_stack_pointer() ((D)(alloca(0))) /* not used */
#define primitive_restore_stack_pointer(old_sp) /* nop -- return will deallocate */
#define primitive_byte_stack_allocate(numwords, numbytes) \
((D)alloca(numwords * sizeof(D)) + (numbytes))
#define primitive_byte_stack_allocate_filled(size, class_wrapper, number_slots, fill_value, repeated_size, repeated_size_offset, repeated_fill_value) \
initialize_byte_stack_allocate_filled((D*)primitive_byte_stack_allocate(size, repeated_size + 1), class_wrapper, number_slots, fill_value, repeated_size, repeated_size_offset, repeated_fill_value)
extern D initialize_byte_stack_allocate_filled
(D ptr, D class_wrapper, DSINT number_slots,
D fill_value, DSINT repeated_size, DSINT repeated_size_offset,
DBYTE repeated_fill_value);
#define primitive_object_stack_allocate_filled(size, class_wrapper, number_slots, fill_value, repeated_size, repeated_size_offset, repeated_fill_value) \
initialize_object_stack_allocate_filled(primitive_byte_stack_allocate(size, repeated_size * sizeof(D)), class_wrapper, number_slots, fill_value, repeated_size, repeated_size_offset, repeated_fill_value)
extern D initialize_object_stack_allocate_filled
(D ptr, D class_wrapper, DSINT number_slots, D fill_value,
DSINT repeated_size, DSINT repeated_size_offset,
D repeated_fill_value);
/* allocation counting stubs (gts,98sep10) */
#define primitive_initialize_allocation_count()
#define primitive_allocation_count() 0
#define primitive_begin_heap_alloc_stats()
#define primitive_end_heap_alloc_stats(x) 0
/* CLASS BREAKPOINT PRIMITIVES */
#define primitive_display_class_breakpoints(x) 0
#define primitive_clear_class_breakpoint(x)
#define primitive_set_class_breakpoint(x,y)
/* GC PRIMITIVES */
#define primitive_gc_state() (I(0)) /* !@#$ DUMMY DEFN */
#define primitive_pin_object(x) (x)
extern void primitive_unpin_object(D);
#define primitive_mps_finalize(x) { }
#define primitive_mps_finalization_queue_first() ((D)0)
#define primitive_mps_park()
#define primitive_mps_clamp()
#define primitive_mps_release()
extern void primitive_mps_collect(DBOOL);
extern DBOOL primitive_mps_collection_stats(D);
#define primitive_mps_enable_gc_messages()
extern DSINT primitive_mps_committed(void);
#define primitive_mps_begin_ramp_alloc()
#define primitive_mps_end_ramp_alloc()
#define primitive_mps_begin_ramp_alloc_all()
#define primitive_mps_end_ramp_alloc_all()
#define primitive_mps_ld_reset(hs)
#define primitive_mps_ld_add(hs, o)
#define primitive_mps_ld_merge(hs1, hs2)
#define primitive_mps_ld_isstale(x) 0
/* KEYBOARD BREAK HANDLING */
#define primitive_keyboard_interrupt_signaled() ((DBOOL)0)
#define primitive_keyboard_interrupt_signaled_setter(x)
#define primitive_keyboard_interrupt_polling() ((DBOOL)0)
#define primitive_keyboard_interrupt_polling_setter(x)
#define primitive_keyboard_interrupt_polling_thread(x) ((DBOOL)0)
#define primitive_keyboard_interrupt_polling_thread_setter(y, x)
/* BYTE CHARACTER PRIMITIVES */
#define primitive_byte_character_as_raw(x) \
(R(x))
#define primitive_raw_as_byte_character(x) \
(C(x))
/* UNICODE CHARACTER PRIMITIVES */
#define primitive_unicode_character_as_raw(x) \
(R(x))
#define primitive_raw_as_unicode_character(x) \
(C(x))
/* INTEGER PRIMITIVES */
/* SMALL-INTEGER PRIMITIVES */
#define primitive_raw_as_integer(x) \
(I(x))
/* BIG-INTEGER PRIMITIVES */
/* MACHINE-INTEGER PRIMITIVES */
/* UNSIGNED-MACHINE-INTEGER PRIMITIVES */
/* ADDRESS PRIMITIVES */
/* POINTER PRIMITIVES */
#define primitive_cast_pointer_as_raw(x) ((DADDR)x)
#define primitive_cast_raw_as_pointer(x) ((D)x)
/* MACHINE-WORD PRIMITIVES */
#define primitive_integerQ(x) RAWASBOOL(TAG_BITS(x) == 1)
#define primitive_machine_word_equalQ(x, y) RAWASBOOL((DMINT)(x) == (DMINT)(y))
#define primitive_machine_word_not_equalQ(x, y) RAWASBOOL((DMINT)(x) != (DMINT)(y))
#define primitive_machine_word_less_thanQ(x, y) RAWASBOOL((DMINT)(x) < (DMINT)(y))
#define primitive_machine_word_not_less_thanQ(x, y) RAWASBOOL((DMINT)(x) >= (DMINT)(y))
#define primitive_machine_word_greater_thanQ(x, y) RAWASBOOL((DMINT)(x) > (DMINT)(y))
#define primitive_machine_word_not_greater_thanQ(x, y) RAWASBOOL((DMINT)(x) <= (DMINT)(y))
extern D primitive_wrap_machine_word(DMINT);
#define primitive_unwrap_machine_word(x) \
(((DMI)(x))->data)
extern D primitive_wrap_c_pointer(D, DMINT);
/* primitive_unwrap_c_pointer
* assumes that instances of <c-pointer> are implemented as
* struct {D class; D pointer_address; ...}
* ..and that the address is stored as a raw pointer.
*/
#define primitive_unwrap_c_pointer(c_ptr) \
((void*)(*(((D*)(c_ptr))+1)))
#define primitive_cast_integer_as_raw(x) ((DMINT)(x))
#define primitive_cast_raw_as_integer(x) ((D)(x))
extern D primitive_wrap_abstract_integer(DMINT);
extern D primitive_wrap_unsigned_abstract_integer(DMINT);
extern DMINT primitive_unwrap_abstract_integer(D);
#define primitive_box_integer(x) (I(x))
#define primitive_unbox_integer(x) (R(x))
extern DMINT primitive_machine_word_boole(D, DMINT, DMINT);
#define primitive_machine_word_logand(x, y) ((x) & (y))
#define primitive_machine_word_logior(x, y) ((x) | (y))
#define primitive_machine_word_logxor(x, y) ((x) ^ (y))
#define primitive_machine_word_lognot(x) (~(x))
#define primitive_machine_word_logbitQ(i, x) RAWASBOOL((1UL << (i)) & ((DUMINT)(x)))
#define primitive_machine_word_logbit_set(i, x) ((1UL << (i)) | ((DUMINT)(x)))
#define primitive_machine_word_logbit_clear(i, x) (~(1UL << (i)) & ((DUMINT)(x)))
#define primitive_machine_word_bit_field_deposit(f, o, s, x) (((x) & ~(((1 << (s)) - 1) << (o))) | ((f) << (o)))
#define primitive_machine_word_bit_field_extract(o, s, x) (((x) & (((1 << (s)) - 1) << (o))) >> (o))
extern DMINT primitive_machine_word_count_low_zeros(DMINT);
extern DMINT primitive_machine_word_count_high_zeros(DMINT);
#define primitive_machine_word_add(x, y) ((x) + (y))
extern DMINT primitive_machine_word_add_with_overflow(DMINT, DMINT);
#define primitive_machine_word_subtract(x, y) ((x) - (y))
extern DMINT primitive_machine_word_subtract_with_overflow(DMINT, DMINT);
#define primitive_machine_word_multiply_low(x, y) ((x) * (y))
extern DMINT primitive_machine_word_multiply_high(DMINT, DMINT);
extern DMINT primitive_machine_word_multiply_lowShigh(DMINT, DMINT);
extern DMINT primitive_machine_word_multiply_low_with_overflow(DMINT, DMINT);
extern DMINT primitive_machine_word_multiply_with_overflow(DMINT, DMINT);
#define primitive_machine_word_negative(x) (-(signed)(x))
#define primitive_machine_word_abs(x) ((x)<0?-(x):(x))
extern DMINT primitive_machine_word_negative_with_overflow(DMINT);
extern DMINT primitive_machine_word_abs_with_overflow(DMINT);
extern DMINT primitive_machine_word_floorS_quotient(DMINT, DMINT);
extern DMINT primitive_machine_word_floorS_remainder(DMINT, DMINT);
extern DMINT primitive_machine_word_floorS(DMINT, DMINT);
extern DMINT primitive_machine_word_ceilingS_quotient(DMINT, DMINT);
extern DMINT primitive_machine_word_ceilingS_remainder(DMINT, DMINT);
extern DMINT primitive_machine_word_ceilingS(DMINT, DMINT);
extern DMINT primitive_machine_word_roundS_quotient(DMINT, DMINT);
extern DMINT primitive_machine_word_roundS_remainder(DMINT, DMINT);
extern DMINT primitive_machine_word_roundS(DMINT, DMINT);
extern DMINT primitive_machine_word_truncateS_quotient(DMINT, DMINT);
extern DMINT primitive_machine_word_truncateS_remainder(DMINT, DMINT);
extern DMINT primitive_machine_word_truncateS(DMINT, DMINT);
#define primitive_machine_word_divide_quotient(x, y) ((x) / (y))
#define primitive_machine_word_divide_remainder(x, y) ((x) % (y))
extern DMINT primitive_machine_word_divide(DMINT, DMINT);
#define primitive_machine_word_shift_left_low(x, i) ((DMINT)(x) << (i))
extern DMINT primitive_machine_word_shift_left_high(DMINT, DMINT);
extern DMINT primitive_machine_word_shift_left_lowShigh(DMINT, DMINT);
extern DMINT primitive_machine_word_shift_left_low_with_overflow(DMINT, DMINT);
extern DMINT primitive_machine_word_shift_left_with_overflow(DMINT, DMINT);
#define primitive_machine_word_shift_right(x, i) ((DMINT)(x) >> (i))
/* The C run-time does no overflow checks ... */
#define primitive_machine_word_add_signal_overflow(x, y) \
primitive_machine_word_add(x, y)
#define primitive_machine_word_subtract_signal_overflow(x, y) \
primitive_machine_word_subtract(x, y)
#define primitive_machine_word_multiply_signal_overflow(x, y) \
primitive_machine_word_multiply_low(x, y)
#define primitive_machine_word_negative_signal_overflow(x) \
primitive_machine_word_negative(x)
#define primitive_machine_word_abs_signal_overflow(x) \
primitive_machine_word_abs(x)
#define primitive_machine_word_shift_left_signal_overflow(x, y) \
primitive_machine_word_shift_left_low(x, y)
extern DMINT primitive_machine_word_double_floorS_quotient(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_floorS_remainder(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_floorS(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_ceilingS_quotient(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_ceilingS_remainder(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_ceilingS(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_roundS_quotient(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_roundS_remainder(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_roundS(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_truncateS_quotient(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_truncateS_remainder(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_truncateS(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_divide_quotient(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_divide_remainder(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_double_divide(DMINT, DMINT, DMINT);
#define primitive_machine_word_unsigned_less_thanQ(x, y) \
RAWASBOOL(((DUMINT)(x)) < ((DUMINT)(y)))
#define primitive_machine_word_unsigned_not_less_thanQ(x, y) \
RAWASBOOL(((DUMINT)(x)) >= ((DUMINT)(y)))
#define primitive_machine_word_unsigned_greater_thanQ(x, y) \
RAWASBOOL(((DUMINT)(x)) > ((DUMINT)(y)))
#define primitive_machine_word_unsigned_not_greater_thanQ(x, y) \
RAWASBOOL(((DUMINT)(x)) <= ((DUMINT)(y)))
extern DMINT primitive_machine_word_unsigned_add_with_carry(DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_subtract_with_borrow(DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_multiply_high(DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_multiply(DMINT, DMINT);
#define primitive_machine_word_unsigned_divide_quotient(x, y) \
((DMINT)(((DUMINT)(x)) / ((DUMINT)(y))))
#define primitive_machine_word_unsigned_divide_remainder(x, y) \
((DMINT)(((DUMINT)(x)) % ((DUMINT)(y))))
extern DMINT primitive_machine_word_unsigned_divide(DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_rotate_left(DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_rotate_right(DMINT, DMINT);
#define primitive_machine_word_unsigned_shift_right(x, i) \
((DMINT)(((DUMINT)(x)) >> (i)))
extern DMINT primitive_machine_word_unsigned_double_divide_quotient(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_double_divide_remainder(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_double_divide(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_shift_left_high(DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_double_shift_left_high(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_double_shift_left(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_double_shift_right_low(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_double_shift_right_high(DMINT, DMINT, DMINT);
extern DMINT primitive_machine_word_unsigned_double_shift_right(DMINT, DMINT, DMINT);
/* FLOATS */
/* SunOS' and Solaris' <math.h> include <stdio.h> to get the definition of FILE (Sigh) */
#ifndef USE_STDIO_H
#define _STDIO_H
#define FILE void
#endif
#include <math.h>
/* SunOS and Solaris also don't include single precision functions in <math.h> (Sigh)
Win32 only defines the single precision functions for C++ (Huh?) */
#if defined(sun) || defined(WIN32)
#define sqrtf(x) (DSFLT)sqrt((DDFLT)x)
#define logf(x) (DSFLT)log((DDFLT)x)
#define expf(x) (DSFLT)exp((DDFLT)x)
#define powf(b,p) (DSFLT)pow((DDFLT)b,(DDFLT)p)
#define sinf(x) (DSFLT)sin((DDFLT)x)
#define cosf(x) (DSFLT)cos((DDFLT)x)
#define tanf(x) (DSFLT)tan((DDFLT)x)
#define asinf(x) (DSFLT)asin((DDFLT)x)
#define acosf(x) (DSFLT)acos((DDFLT)x)
#define atanf(x) (DSFLT)atan((DDFLT)x)
#endif
#define primitive_double_float_as_single(x) ((DSFLT)x)
#define primitive_single_float_as_double(x) ((DDFLT)x)
/* SINGLE-FLOAT PRIMITIVES */
#define primitive_single_float_as_raw(x) \
(((DSF)x)->data)
extern D primitive_raw_as_single_float(DSFLT x);
#define primitive_single_float_as_integer(x) \
((DSINT)(x))
#define primitive_integer_as_single_float(x) \
((DSFLT)(x))
extern DMINT primitive_single_float_as_double_integer(DSFLT);
extern DSFLT primitive_double_integer_as_single_float(DMINT, DMINT);
extern DUMINT primitive_cast_single_float_as_machine_word(DSFLT);
extern DSFLT primitive_cast_machine_word_as_single_float(DUMINT);
#define primitive_single_float_negate(x) \
(-(x))
#define primitive_single_float_add(x, y) \
((x) + (y))
#define primitive_single_float_subtract(x, y) \
((x) - (y))
#define primitive_single_float_multiply(x, y) \
((x) * (y))
#define primitive_single_float_divide(x, y) \
((x) / (y))
#define primitive_single_float_equalsQ(x, y) \
RAWASBOOL((x) == (y))
#define primitive_single_float_less_thanQ(x, y) \
RAWASBOOL((x) < (y))
#define primitive_single_float_sqrt(x) \
(sqrtf(x))
#define primitive_single_float_log(x) \
(logf(x))
#define primitive_single_float_exp(x) \
(expf(x))
#define primitive_single_float_expt(base, power) \
(powf(base, power))
#define primitive_single_float_sin(x) \
(sinf(x))
#define primitive_single_float_cos(x) \
(cosf(x))
#define primitive_single_float_tan(x) \
(tanf(x))
#define primitive_single_float_asin(x) \
(asinf(x))
#define primitive_single_float_acos(x) \
(acosf(x))
#define primitive_single_float_atan(x) \
(atanf(x))
/* DOUBLE-FLOAT PRIMITIVES */
#define primitive_double_float_as_raw(x) \
(((DDF)x)->data)
extern D primitive_raw_as_double_float(DDFLT x);
#define primitive_double_float_as_integer(x) \
((DSINT)(x))
#define primitive_integer_as_double_float(x) \
((DDFLT)(x))
extern DMINT primitive_double_float_as_double_integer(DDFLT);
extern DDFLT primitive_double_integer_as_double_float(DMINT, DMINT);
extern DUMINT primitive_cast_double_float_as_machine_words(DDFLT);
extern DDFLT primitive_cast_machine_words_as_double_float(DUMINT, DUMINT);
#define primitive_double_float_negate(x) \
(-(x))
#define primitive_double_float_add(x, y) \
((x) + (y))
#define primitive_double_float_subtract(x, y) \
((x) - (y))
#define primitive_double_float_multiply(x, y) \
((x) * (y))
#define primitive_double_float_divide(x, y) \
((x) / (y))
#define primitive_double_float_equalsQ(x, y) \
RAWASBOOL((x) == (y))
#define primitive_double_float_less_thanQ(x, y) \
RAWASBOOL((x) < (y))
#define primitive_double_float_sqrt(x) \
(sqrt(x))
#define primitive_double_float_log(x) \
(log(x))
#define primitive_double_float_exp(x) \
(exp(x))
#define primitive_double_float_expt(base, power) \
(pow(base, power))
#define primitive_double_float_sin(x) \
(sin(x))
#define primitive_double_float_cos(x) \
(cos(x))
#define primitive_double_float_tan(x) \
(tan(x))
#define primitive_double_float_asin(x) \
(asin(x))
#define primitive_double_float_acos(x) \
(acos(x))
#define primitive_double_float_atan(x) \
(atan(x))
/* VECTOR PRIMITIVES */
#define primitive_vector_element(v, i) ((((SOV*)v)->data)[R(i)])
#define primitive_vector_element_setter(e, v, i) ((((SOV*)v)->data)[R(i)] = (e))
#define primitive_vector_size(v) (((SOV*)v)->size)
#define primitive_vector_as_raw(v) (((SOV*)v)->data)
extern D primitive_vector(D dn, ...);
extern D primitive_raw_as_vector(D a, D n);
extern D primitive_make_vector(int size);
extern D primitive_copy_vector(D vector);
extern D VECTOR_REF_OR_F(D v, int offset);
/* STRING PRIMITIVES */
#define primitive_strlen(s) (strlen((DBSTR)s))
#define primitive_string_as_raw(v) (((BS*)v)->data)
extern D primitive_raw_as_string(DBSTR buffer);
/* CALLING CONVENTION PRIMITIVES */
#define primitive_current_function() ((D)(Pfunction_))
#define primitive_function_parameter() ((D)(Pfunction_))
#define primitive_lambda_parameter() ((D)(Pfunction_))
#define primitive_next_methods_parameter() ((D)(Pnext_methods_))
#define primitive_next_methods_parameter_setter(x) ((D)(Pnext_methods_ = (D)x))
/* APPLY PRIMITIVES */
extern D primitive_apply (D fn, D sov);
extern D primitive_apply_spread (D fn, int n, ...);
extern D primitive_mep_apply_spread (D fn, D nm, int n, ...);
extern D primitive_xep_apply (FN* fn, int n, D a[]);
extern D primitive_mep_apply_with_optionals
(FN* fn, D new_next_methods, D a);
extern D primitive_mep_apply (FN* fn, D next_methods, D a[]);
extern D primitive_iep_apply (FN* fn, int n, D a[]);
extern D primitive_engine_node_apply_with_optionals (D engD, D gfD, D args);
#define APPLYN(fn,n) (D)(primitive_apply_spread((fn),n
#define APPLY0(fn) APPLYN(fn,0)))
#define APPLY1(fn,a1) APPLYN(fn,1),(a1)))
#define APPLY2(fn,a1,a2) APPLYN(fn,2),(a1),(a2)))
#define APPLY3(fn,a1,a2,a3) APPLYN(fn,3),(a1),(a2),(a3)))
#define APPLY4(fn,a1,a2,a3,a4) APPLYN(fn,4),(a1),(a2),(a3),(a4)))
#define APPLY5(fn,a1,a2,a3,a4,a5) APPLYN(fn,5),(a1),(a2),(a3),(a4),(a5)))
#define APPLY6(fn,a1,a2,a3,a4,a5,a6) APPLYN(fn,6),(a1),(a2),(a3),(a4),(a5),(a6)))
#define APPLY7(fn,a1,a2,a3,a4,a5,a6,a7) APPLYN(fn,7),(a1),(a2),(a3),(a4),(a5),(a6),(a7)))
#define APPLY8(fn,a1,a2,a3,a4,a5,a6,a7,a8) APPLYN(fn,8),(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8)))
#define APPLY9(fn,a1,a2,a3,a4,a5,a6,a7,a8,a9) APPLYN(fn,9),(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9)))
#define APPLY10(fn,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) APPLYN(fn,10),(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9),(a10)))
#define MEP_APPLYN(fn,nm,n) (D)(primitive_mep_apply_spread((fn),(nm),n
#define MEP_APPLY0(fn,nm) MEP_APPLYN(fn,nm,0)))
#define MEP_APPLY1(fn,nm,a1) MEP_APPLYN(fn,nm,1),(a1)))
#define MEP_APPLY2(fn,nm,a1,a2) MEP_APPLYN(fn,nm,2),(a1),(a2)))
#define MEP_APPLY3(fn,nm,a1,a2,a3) MEP_APPLYN(fn,nm,3),(a1),(a2),(a3)))
#define MEP_APPLY4(fn,nm,a1,a2,a3,a4) MEP_APPLYN(fn,nm,4),(a1),(a2),(a3),(a4)))
#define MEP_APPLY5(fn,nm,a1,a2,a3,a4,a5) MEP_APPLYN(fn,nm,5),(a1),(a2),(a3),(a4),(a5)))
#define MEP_APPLY6(fn,nm,a1,a2,a3,a4,a5,a6) MEP_APPLYN(fn,nm,6),(a1),(a2),(a3),(a4),(a5),(a6)))
#define MEP_APPLY7(fn,nm,a1,a2,a3,a4,a5,a6,a7) MEP_APPLYN(fn,nm,7),(a1),(a2),(a3),(a4),(a5),(a6),(a7)))
#define MEP_APPLY8(fn,nm,a1,a2,a3,a4,a5,a6,a7,a8) MEP_APPLYN(fn,nm,8),(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8)))
#define MEP_APPLY9(fn,nm,a1,a2,a3,a4,a5,a6,a7,a8,a9) MEP_APPLYN(fn,nm,9),(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9)))
#define MEP_APPLY10(fn,nm,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) MEP_APPLYN(fn,nm,10),(a1),(a2),(a3),(a4),(a5),(a6),(a7),(a8),(a9),(a10)))
#define ENGINE_NODE_APPLYN(e,gf,n) (D)(primitive_engine_node_apply_spread((e),(gf),n
/* VALUES PRIMITIVES */
extern D primitive_values (D v);
/* TERMINAL PRIMITIVES */
#ifdef USE_STDIO_H
#include <stdio.h>
#else
/* Explicit declarations to avoid <stdio.h> which would make it impossible to
call rename from the File System library due to conflicting declarations */
extern D fopen (DBSTR name, DBSTR direction);
extern int getchar (void);
extern int putchar (int);
extern int fflush (D fd);
extern int fclose (D fd);
#endif
/* OPERATING SYSTEM PRIMITIVES */
extern D Tcommand_nameT;
extern D pseudo_primitive_command_name (void);
extern D Tcommand_argumentsT;
extern D pseudo_primitive_command_arguments (void);
extern DSINT primitive_run_application (DBSTR command);
extern void primitive_exit_application (DSINT code);
/* TEMPORARY PRIMITIVES FOR ASSIGNMENT */
extern D MAKE_D_CELL(D);
#define GET_D_CELL_VAL(c) (*(D*)c)
#define SET_D_CELL_VAL(c, v) (*(D*)c = v)
extern D MAKE_DBCHR_CELL(DBCHR);
#define GET_DBCHR_CELL_VAL(c) (*(DBCHR*)c)
#define SET_DBCHR_CELL_VAL(c, v) (*(DBCHR*)c = v)
extern D MAKE_DDBYTE_CELL(DDBYTE);
#define GET_DDBYTE_CELL_VAL(c) (*(DDBYTE*)c)
#define SET_DDBYTE_CELL_VAL(c, v) (*(DDBYTE*)c = v)
extern D MAKE_DWORD_CELL(DWORD);
#define GET_DWORD_CELL_VAL(c) (*(DWORD*)c)
#define SET_DWORD_CELL_VAL(c, v) (*(DWORD*)c = v)
extern D MAKE_DDWORD_CELL(DDWORD);
#define GET_DDWORD_CELL_VAL(c) (*(DDWORD*)c)
#define SET_DDWORD_CELL_VAL(c, v) (*(DDWORD*)c = v)
extern D MAKE_DSFLT_CELL(DSFLT);
#define GET_DSFLT_CELL_VAL(c) (*(DSFLT*)c)
#define SET_DSFLT_CELL_VAL(c, v) (*(DSFLT*)c = v)
extern D MAKE_DDFLT_CELL(DDFLT);
#define GET_DDFLT_CELL_VAL(c) (*(DDFLT*)c)
#define SET_DDFLT_CELL_VAL(c, v) (*(DDFLT*)c = v)
/* THREAD SUPPORT */
#define CONDITIONAL_UPDATE(var, new_val, old_val) \
((old_val) == (var) ? (var = (new_val), DTRUE) : DFALSE)
extern D primitive_release_simple_lock(D l);
extern D primitive_release_semaphore(D s);
extern D primitive_owned_recursive_lock(D l);
extern D primitive_destroy_simple_lock(D l);
extern D primitive_wait_for_semaphore_timed(D s, D ms);
extern D primitive_wait_for_semaphore(D s);
extern D primitive_wait_for_simple_lock_timed(D l, D ms);
extern D primitive_wait_for_simple_lock(D l);
extern D primitive_make_recursive_lock(D l, D n);
extern D primitive_release_recursive_lock(D l);
extern D primitive_make_semaphore(D l, D n, D i, D m);
extern D primitive_destroy_recursive_lock(D l);
extern D primitive_owned_simple_lock(D l);
extern D primitive_destroy_semaphore(D l);
extern D primitive_wait_for_recursive_lock_timed(D l, D ms);
extern D primitive_wait_for_recursive_lock(D l);
extern D primitive_thread_join_multiple(D v);
extern D primitive_thread_join_single(D t);
extern D primitive_initialize_current_thread(D t, DBOOL s);
extern D primitive_initialize_special_thread(D t);
extern D primitive_current_thread();
extern D primitive_make_thread(D t, D n, D p, D f, DBOOL s);
extern D primitive_destroy_thread(D t);
extern D primitive_destroy_notification(D n);
extern D primitive_release_all_notification(D n, D l);
extern D primitive_make_notification(D l, D n);
extern D primitive_wait_for_notification_timed(D n, D l, D ms);
extern D primitive_wait_for_notification(D n, D l);
extern D primitive_release_notification(D n, D l);
extern void primitive_thread_yield();
extern void primitive_sleep(D ms);
extern D primitive_make_simple_lock(D l, D n);
extern D primitive_allocate_thread_variable(D i);
extern D primitive_read_thread_variable(D h);
extern D primitive_write_thread_variable(D h, D nv);
extern D primitive_unlock_simple_lock(D l);
extern D primitive_unlock_recursive_lock(D l);
#define primitive_sequence_point()
#define primitive_synchronize_side_effects()
/* RUN-TIME CALLBACKS */
extern D primitive_resolve_symbol (D symbol);
extern D primitive_string_as_symbol (D string);
extern D primitive_preboot_symbols ();
/* TIMER PRIMITIVES */
extern void primitive_start_timer();
extern D primitive_stop_timer();
/* ENGINE NODE HANDLER ASSIGNMENTS */
#define ENGINE_absent 0
#define ENGINE_inapplicable 1
#define ENGINE_unkeyed_single_method 2
#define ENGINE_implicit_keyed_single_method 3
#define ENGINE_explicit_keyed_single_method 4
#define ENGINE_unrestricted_keyed_single_method 5
#define ENGINE_reserved_terminal_n_a 6
#define ENGINE_reserved_terminal_n_b 7
#define ENGINE_reserved_terminal_n_c 8
#define ENGINE_reserved_terminal_n_d 9
#define ENGINE_reserved_terminal_n_e 10
#define ENGINE_reserved_terminal_n_f 11
#define ENGINE_reserved_terminal_n_g 12
#define ENGINE_profiling_cache_header 13
#define ENGINE_cache_header 14
#define ENGINE_ambiguous_methods 15
#define ENGINE_boxed_instance_slot_getter 16
#define ENGINE_boxed_instance_slot_setter 17
#define ENGINE_boxed_repeated_instance_slot_getter 18
#define ENGINE_boxed_repeated_instance_slot_setter 19
#define ENGINE_boxed_class_slot_getter 20
#define ENGINE_boxed_class_slot_setter 21
#define ENGINE_raw_byte_repeated_instance_slot_getter 22
#define ENGINE_raw_byte_repeated_instance_slot_setter 23
#define ENGINE_reserved_slot_a_getter 24
#define ENGINE_reserved_slot_a_setter 25
#define ENGINE_reserved_slot_b_getter 26
#define ENGINE_reserved_slot_b_setter 27
#define ENGINE_reserved_repeated_slot_a_getter 28
#define ENGINE_reserved_repeated_slot_a_setter 29
#define ENGINE_reserved_repeated_slot_b_getter 30
#define ENGINE_reserved_repeated_slot_b_setter 31
#define ENGINE_typecheck 32
#define ENGINE_if_type 33
#define ENGINE_linear_by_class 34
#define ENGINE_hashed_by_class 35
#define ENGINE_linear_by_singleton_class 36
#define ENGINE_hashed_by_singleton_class 37
#define ENGINE_immediate_linear_singleton 38
#define ENGINE_immediate_hashed_noreloc_singleton 39
#define ENGINE_immediate_hashed_singleton 40
#define ENGINE_value_object_linear_singleton 41
#define ENGINE_value_object_hashed_singleton 42
#define ENGINE_monomorphic 42
#define ENGINE_reserved_discriminator_a 43
#define ENGINE_reserved_discriminator_b 44
#define ENGINE_reserved_discriminator_c 45
#define ENGINE_reserved_discriminator_d 46
#define ENGINE_reserved_discriminator_e 47
#define ENGINE_reserved_discriminator_f 48
#define ENGINE_reserved_discriminator_g 49
#define ENGINE_reserved_discriminator_h 50
#define ENGINE_reserved_discriminator_i 51
#define ENGINE_reserved_discriminator_j 52
#define ENGINE_reserved_discriminator_k 53
#define ENGINE_reserved_discriminator_l 54
#define ENGINE_reserved_discriminator_m 55
#define ENGINE_reserved_discriminator_n 56
#define ENGINE_reserved_discriminator_o 57
#define ENGINE_reserved_discriminator_p 58
#define ENGINE_reserved_discriminator_q 59
#define ENGINE_reserved_discriminator_r 60
#define ENGINE_reserved_discriminator_s 61
#define ENGINE_reserved_discriminator_t 62
#define ENGINE_reserved_discriminator_u 63
#define ENGINE_first_discriminator 32
#define ENGINE_first_slot 16
#define ENGINE_number_slot_handlers 16
/* ENGINE NODE PROPERTIES BIT DEFINITIONS
There used to be two other bits having to do with permanency and precomputation or
something (I've forgotten!) which want to be in all engine-nodes at some point in
the future. Adding them will be more convenient when the properties word is made
raw, and we can use the tag bits.
Engine Node
Entry-type is contained in low byte, shifted 2: mask or shift out low 2 bits.
_31_________________________________________________________8_7____________2_1___________0_
| other | entry type | fixnum tag |
-------------------------------------------------------------------------------------------
Discriminator
Argument number to discriminate on is contained in second byte.
Third byte is the number of required arguments, and the following bit indicates whether
there are any optionals. The sum of that byte and the bit give the number of MEP-style
arguments, which may be of use to primitive-initialize-discriminator.
_31_____25____24_____23___________16_15____________________8_7____________2_1___________0_
| other | restp | nrequired | discriminator argnum | entry type | fixnum tag |
-------------------------------------------------------------------------------------------
*/
#define EPROPS_V_ENTRY_TYPE 2
#define EPROPS_S_ENTRY_TYPE 6
#define EPROPS_M_ENTRY_TYPE 0xfc
#define ENODE_V_DATA_START 16
#define DPROPS_V_ARGNUM 8
#define DPROPS_S_ARGNUM 8
#define DPROPS_M_ARGNUM 0xFF00
#define DPROPS_V_NREQUIRED 16
#define DPROPS_S_NREQUIRED 8
#define DPROPS_M_NREQUIRED 0xFF0000
#define DPROPS_V_OPTIONALS 24
#define DPROPS_M_OPTIONALS 0x1000000
/* <simple-typechecked-cache-header-engine-node>. See the Dylan definitions in
dispatch-prologue.dylan for how these are defined.
*/
#define STCHEN_ARGUMENTS_LIMIT 8
#define STCHEN_V_CHECKEDMASK 16
#define STCHEN_S_CHECKEDMASK 8
#define STCHEN_M_CHECKEDMASK 0xff0000
#define SLOTENGINE_V_INDEX ENODE_V_DATA_START
extern D general_engine_node_1_engine (D a1);
extern D general_engine_node_2_engine (D a1, D a2);
extern D general_engine_node_3_engine (D a1, D a2, D a3);
extern D general_engine_node_n_engine (D a1, ...);
extern D general_engine_node_spread_engine (D a1, ...);
extern D cache_header_engine_0 ();
extern D cache_header_engine_1 (D a1);
extern D cache_header_engine_2 (D a1, D a2);
extern D cache_header_engine_3 (D a1, D a2, D a3);
extern D cache_header_engine_4 (D a1, D a2, D a3, D a4);
extern D cache_header_engine_5 (D a1, D a2, D a3, D a4, D a5);
extern D cache_header_engine_6 (D a1, D a2, D a3, D a4, D a5, D a6);
extern D cache_header_engine_7 (D a1, D a2, D a3, D a4, D a5, D a6, D a7);
extern D cache_header_engine_n (D argvec);
/* additions to run-time.c specific to handling pass-by-reference of non-first
return values of primitives (gts,9/97) */
extern DMINT primitive_single_float_as_double_integer_byref(DSFLT f, DMINT* v2);
extern DMINT primitive_double_float_as_double_integer_byref(DDFLT f, DMINT* v2);
extern DMINT primitive_cast_double_float_as_machine_words_byref(DDFLT x, DMINT* v2);
extern DMINT primitive_machine_word_divide_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_floorS_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_ceilingS_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_roundS_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_truncateS_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_double_floorS_byref(DMINT xl, DMINT xh, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_double_ceilingS_byref(DMINT xl, DMINT xh, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_double_roundS_byref(DMINT xl, DMINT xh, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_double_truncateS_byref(DMINT xl, DMINT xh, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_double_divide_byref(DMINT xl, DMINT xh, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_add_with_overflow_byref(DMINT x, DMINT y, D* v2);
extern DMINT primitive_machine_word_subtract_with_overflow_byref(DMINT x, DMINT y, D* v2);
extern DMINT primitive_machine_word_multiply_with_overflow_byref(DMINT x, DMINT y, DMINT* v2, D* v3);
extern DMINT primitive_machine_word_negative_with_overflow_byref(DMINT x, D* v2);
extern DMINT primitive_machine_word_abs_with_overflow_byref(DMINT x, D* v2);
extern DMINT primitive_machine_word_shift_left_with_overflow_byref(DMINT x, DMINT y, DMINT* v2, D* v3);
extern DMINT primitive_machine_word_multiply_lowShigh_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_multiply_low_with_overflow_byref(DMINT x, DMINT y, D* v2);
extern DMINT primitive_machine_word_unsigned_add_with_carry_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_unsigned_subtract_with_borrow_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_unsigned_multiply_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_unsigned_divide_byref(DMINT x, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_unsigned_double_divide_byref(DMINT xl, DMINT xh, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_unsigned_double_shift_left_byref(DMINT xl, DMINT xh, DMINT y, DMINT* v2);
extern DMINT primitive_machine_word_unsigned_double_shift_right_byref(DMINT xl, DMINT xh, DMINT y, DMINT* v2);
/* eof */
syntax highlighted by Code2HTML, v. 0.9.1