File: obj.h

package info (click to toggle)
rscheme 0.7.2-1.1
  • links: PTS
  • area: main
  • in suites: slink
  • size: 10,672 kB
  • ctags: 12,430
  • sloc: lisp: 37,104; ansic: 29,763; cpp: 2,630; sh: 1,677; makefile: 568; yacc: 202; lex: 175; perl: 33
file content (304 lines) | stat: -rw-r--r-- 8,935 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
/*-----------------------------------------------------------------*-C-*---
 * File:    handc/runtime/obj.h
 *
 *          Copyright (C)1997 Donovan Kolbly <d.kolbly@rscheme.org>
 *          as part of the RScheme project, licensed for free use.
 *          See <http://www.rscheme.org/> for the latest information.
 *
 * File version:     1.11
 * File mod date:    1997.11.29 23:10:49
 * System build:     v0.7.2, 97.12.21
 *
 * Purpose:          Scheme object type definition, and immob structure
 *------------------------------------------------------------------------*/

#ifndef _H_RSCHEME_OBJ
#define _H_RSCHEME_OBJ

#ifdef INLINES
#define CI_DECL static inline
#define CIH_DECL static inline
#else
#define CI_DECL /* nothing */
#define CIH_DECL /* nothing */
#endif


/*
    WARNING:  Don't think that just because we have defines here
    	      that you can change the values and it will still work.
	      At least some of these values are frozen rock-solid.
*/


#include <rscheme/platform.h>
#include <rscheme/buildsty.h>  /* get build style flags */

#include <assert.h>

/*  declare the C types for the root classes  */

#ifdef GNU_VINSNS
typedef void *jump_addr;
#else
typedef void *(*jump_addr)( void );
#endif


/*  constructor exprs are useful for static type checking,
 *  but it's not portable
 *
 *  the data type is `obj' and the low-level operations
 *  are convert 32-bit int to one of them,
 *  convert one to a 32-bit unsigned int (VAL)
 *              or a 32-bit signed int (IVAL)
 */

#ifdef USE_CONSTRUCTOR_EXPRS

typedef struct _obj { UINT_32 v; } obj;

#define VAL(x)			((x).v)
#define IVAL(x)			((INT_32)(x).v)
#define OBJ(x)			((obj){x})

#else

typedef UINT_32 obj;

#define VAL(x)			(x)
#define IVAL(x)			((INT_32)(x))
#define OBJ(x)			(x)

#endif

typedef enum {
  NO = 0,
  YES = !NO
} rs_bool;

/*typedef bool raw_bool;*/

/*
 *  macros for converting 32-bit values to and from "network" (big-endian)
 *  format are here recast to convert obj values
 */

#define BIG_ENDIAN_TO_HOST_OBJ(x)	OBJ(BIG_ENDIAN_TO_HOST_32(VAL(x)))
#define HOST_TO_BIG_ENDIAN_OBJ(x)	OBJ(HOST_TO_BIG_ENDIAN_32(VAL(x)))

#define EQ(x,y)			(VAL(x)==VAL(y)?YES:NO)
#define RB_NOT(x)		((x)?NO:YES)

/*
 *   define the tag system
 */

/*
   NOTE:  The only reason we are using `+' instead of `|' herein
          (since these are really bit-wise operations) is because
	  it's more likely that an optimizer will fold + than |
*/

#define PRIMARY_TAG_SIZE	(2)
#define SECONDARY_TAG_SIZE	(3)

#define COMBINED_TAG_SIZE	(PRIMARY_TAG_SIZE + SECONDARY_TAG_SIZE)
#define PRIMARY_TAG_MASK	((1<<PRIMARY_TAG_SIZE)-1)
#define COMBINED_TAG_MASK	((1<<COMBINED_TAG_SIZE)-1)

#define SECONDARY_TAG_MASK	(COMBINED_TAG_MASK & ~PRIMARY_TAG_MASK)

/*  define the tag values  */

/*  NOTE:  Because insns on some platforms (e.g., NeXT Motorola)
           are 16-bit aligned,
           the two even tags are used for immediate objects, so that
	   code pointers look like immobs instead of pointers.

	   some platforms are not even so nice (TURBO C), and code
	   can start on any byte boundary.
*/

enum primary_tag {
    FIXNUM_TAG = 0,
    __unused_tag,		/* reserved for future use */
    IMMOB_TAG,
    POINTER_TAG
};

enum secondary_tag {
    BOOLEAN_TAG = 0,
    NIL_TAG,
    ASCII_CHAR_TAG,
    UNICODE_CHAR_TAG,
    UNIQUE_OBJ_TAG,

    SPARE_3_TAG = 5,
    SPARE_2_TAG = 6,
    SPARE_1_TAG = 7
};

enum unique_object_tag {
    NOVALUE_TAG,
    UNDEFINED_TAG,
    UNINITIALIZED_TAG,
    UNBOUND_TAG,
    REST_TAG,
    KEY_TAG,
    ALL_KEYS_TAG,
    NEXT_TAG,
    MISSING_TAG,    /* used to indicate a missing object at load time */
    DEBUG_TRAP_TAG  /* low-level trap if read or overwritten w/o `init' */
    }; 

#define TEST_PRIMARY_TAG(x,t)	  ((VAL(x) & PRIMARY_TAG_MASK) == t)

#define OBJ_ISA_FIXNUM(x)	  TEST_PRIMARY_TAG( x, FIXNUM_TAG )
#define OBJ_ISA_IMMOB(x)	  TEST_PRIMARY_TAG( x, IMMOB_TAG )
#define OBJ_ISA_PTR(x)	  	  TEST_PRIMARY_TAG( x, POINTER_TAG )

#define SECONDARY_TAG(x)          (enum secondary_tag)\
                                        ((VAL(x) & SECONDARY_TAG_MASK)\
                                                      >> PRIMARY_TAG_SIZE)


/************************* FIXNUMs *************************/

#define MAKE_FIXNUM(x)		OBJ(FIXNUM_TAG \
					+ ((UINT_32)(x) << PRIMARY_TAG_SIZE))

#define FIXNUM_TO_RAWINT(x)	(IVAL(x) >> PRIMARY_TAG_SIZE)
#define RAWINT_TO_FIXNUM(x)	MAKE_FIXNUM(x)
#define ZERO			MAKE_FIXNUM(0)
#define ADD1(x)			OBJ(IVAL(x)+(1<<PRIMARY_TAG_SIZE))
#define SUB1(x)			OBJ(IVAL(x)-(1<<PRIMARY_TAG_SIZE))
#define MUL2(x)			OBJ(IVAL(x)<<1)
#define DIV2(x)			OBJ((IVAL(x)>>1) & ~PRIMARY_TAG_MASK)


#define FX_LT(x,y)		(IVAL(x)<IVAL(y))
#define FX_LE(x,y)		(IVAL(x)<=IVAL(y))
#define FX_GT(x,y)		(IVAL(x)>IVAL(y))
#define FX_GE(x,y)		(IVAL(x)>=IVAL(y))

#define FX_ADD(x,y)		OBJ(IVAL(x)+IVAL(y))
#define FX_SUB(x,y)		OBJ(IVAL(x)-IVAL(y))
#define FX_MUL(x,y)		OBJ(IVAL(x)*fx2int(y))
#define FX_DIV(x,y)		int2fx(fx2int(x)/fx2int(y))

#define FX_AND(x,y)		OBJ(VAL(x)&VAL(y))
#define FX_OR(x,y)		OBJ(VAL(x)|VAL(y))
#define FX_XOR(x,y)		OBJ((VAL(x)^VAL(y)) + FIXNUM_TAG)
#define FX_NOT(x)		OBJ(~VAL(x)-3)

/* nb. the `amt' arg is a raw-int */

#define FX_SHL(x,amt)       	OBJ(IVAL(x)<<(amt))
#define FX_ASHR(x,amt)		OBJ((IVAL(x)>>(amt)) & ~PRIMARY_TAG_MASK)
#define FX_LSHR(x,amt)		OBJ((VAL(x)>>(amt)) & ~PRIMARY_TAG_MASK)

#define RIBYTES_TO_FXWORDS(x)	OBJ(x)
#define FXWORDS_TO_RIBYTES(x)	VAL(x)

#define fx2int(x)		FIXNUM_TO_RAWINT(x)
#define int2fx(x)		RAWINT_TO_FIXNUM(x)

/************************* IMMOBs *************************/

/* TEST_SECONDARY_TAG implicitly tests the primary tag for IMMOB_TAG */

#define TEST_SECONDARY_TAG(x,t)	  ((VAL(x) & \
				     (SECONDARY_TAG_MASK|PRIMARY_TAG_MASK))\
					== ((t << PRIMARY_TAG_SIZE)\
					    |IMMOB_TAG))

#define OBJ_ISA_BOOLEAN(x)	  TEST_SECONDARY_TAG( x, BOOLEAN_TAG )
#define OBJ_ISA_NIL(x)	  	  TEST_SECONDARY_TAG( x, NIL_TAG )
#define OBJ_ISA_ASCII_CHAR(x)	  TEST_SECONDARY_TAG( x, ASCII_CHAR_TAG )
#define OBJ_ISA_UNICODE_CHAR(x)   TEST_SECONDARY_TAG( x, UNICODE_CHAR_TAG )
#define OBJ_ISA_UNIQUE_OBJ(x)	  TEST_SECONDARY_TAG( x, UNIQUE_OBJ_TAG )

/*** new names for predicates ***/

#define BOOLEAN_P(x)            OBJ_ISA_BOOLEAN(x)
#define BYTE_CHAR_P(x)          OBJ_ISA_ASCII_CHAR(x)
#define UNICODE_CHAR_P(x)       OBJ_ISA_UNICODE_CHAR(x)
#define FIXNUM_P(x)             OBJ_ISA_FIXNUM(x)
#define PTR_P(x)                OBJ_ISA_PTR(x)

#define MAKE_IMMOB(t,x)		OBJ((IMMOB_TAG \
					+ ((UINT_32)(t) << PRIMARY_TAG_SIZE)) \
				  	+ ((UINT_32)(x) << COMBINED_TAG_SIZE))

#define TRUE_OBJ		(MAKE_IMMOB( BOOLEAN_TAG, 1 ))
#define FALSE_OBJ		(MAKE_IMMOB( BOOLEAN_TAG, 0 ))
#define NIL_OBJ			(MAKE_IMMOB( NIL_TAG, 0 ))

#define NOT(bo)                 (EQ((bo),FALSE_OBJ))
#define truish(bo)              ((!EQ((bo),FALSE_OBJ))?YES:NO)
#define rb_to_bo(rb)            ((rb)?TRUE_OBJ:FALSE_OBJ)

#define IMMOB_TO_FX(imm)        OBJ(VAL(imm)-IMMOB_TAG+FIXNUM_TAG)
#define FX_TO_IMMOB(imm)        OBJ(VAL(imm)+IMMOB_TAG-FIXNUM_TAG)

#define MAKE_UNIQ_OBJ(x)        (MAKE_IMMOB( UNIQUE_OBJ_TAG, x ))
#define UNDEFINED_OBJ		(MAKE_UNIQ_OBJ( UNDEFINED_TAG ))
#define NOVALUE_OBJ		(MAKE_UNIQ_OBJ( NOVALUE_TAG ))
#define UNINITIALIZED_OBJ	(MAKE_UNIQ_OBJ( UNINITIALIZED_TAG ))
#define UNBOUND_OBJ		(MAKE_UNIQ_OBJ( UNBOUND_TAG ))
#define KEY_OBJ                 (MAKE_UNIQ_OBJ( KEY_TAG ))
#define REST_OBJ                (MAKE_UNIQ_OBJ( REST_TAG ))
#define DEBUG_TRAP_OBJ          (MAKE_UNIQ_OBJ( DEBUG_TRAP_TAG ))

#define MAKE_ASCII_CHAR(ch)	(MAKE_IMMOB( ASCII_CHAR_TAG, ch ))
#define MAKE_UNICODE_CHAR(ch)	(MAKE_IMMOB( UNICODE_CHAR_TAG, ch ))

#define GET_IMMEDIATE_VALUE(x)	(VAL(x) >> COMBINED_TAG_SIZE)
#define ASCII_CHAR_VALUE(x)     (GET_IMMEDIATE_VALUE(x) & 0xFF)
#define UNICODE_CHAR_VALUE(x)   (GET_IMMEDIATE_VALUE(x) & 0xFFFF)

/*  breaking obj's into two 16-bit halves, and back again... */

#define OBJ_HIGH_16_FX(x)       OBJ((VAL(x) >> 14) & (0xFFFF<<2))
#define OBJ_LOW_16_FX(x)        OBJ((VAL(x) & 0xFFFF)<<2)
#define OBJ_FROM_HI_LO(hi,lo)   OBJ((VAL(hi) << 14) + (VAL(lo) >> 2))


#ifndef __TURBOC__
#define JUMP_ADDR_TO_OBJ(x)	OBJ((UINT_32)(x))
#define OBJ_TO_JUMP_ADDR(x)	((jump_addr)VAL(x))
#else
#define JUMP_ADDR_TO_OBJ(x)	OBJ((((INT_32)(x))-((INT_32)main))<<2)
#define OBJ_TO_JUMP_ADDR(x)	((jump_addr)((IVAL(x)>>2)+((INT_32)main)))
#endif

#define RAW_PTR_TO_OBJ(x)	OBJ((UINT_32)(x))
#define OBJ_TO_RAW_PTR(x)	((void *)VAL(x))

/* x/4 written as a macro so we can define a primop for it
   this does NOT operate on fixnums
*/

#define RAW_DIV4(x)		((x)/4)

obj class_of( obj item );

#include <rscheme/longint.h>
/*
 *   Get local definitions of MOD and REMDR
 */

#include <rscheme/modulo.h>

#if !HAVE_MEMCPY
#define memcpy(dst,src,len)  (bcopy((src),(dst),(len)))
#endif

/* the details of this representation is unspecified (and left to osglue.c) */

struct RSTime {
  INT_32   rstime[2];
};

#endif