193 |
#define make_free(a_) {*(fixnum *)(a_)&=TYPE_BITS;(a_)->d.f=1;} |
#define make_free(a_) {*(fixnum *)(a_)&=TYPE_BITS;(a_)->d.f=1;} |
194 |
#define make_unfree(a_) {(a_)->d.f=0;} |
#define make_unfree(a_) {(a_)->d.f=0;} |
195 |
|
|
196 |
#define is_cons(a_) (!(a_)->d.e || is_imm_fixnum(Zcdr(a_))) |
#define valid_cdr(a_) (!(a_)->d.e || is_imm_fixnum(Zcdr(a_))) |
197 |
|
|
198 |
struct shortfloat_struct { |
struct shortfloat_struct { |
199 |
|
|
302 |
|
|
303 |
}; |
}; |
304 |
|
|
305 |
EXTER char CnilCt[3*sizeof(struct symbol)] OBJ_ALIGN; |
/* EXTER char CnilCt[3*sizeof(struct symbol)] OBJ_ALIGN; */ |
306 |
|
|
307 |
#define Cnil ((object)(CnilCt)) |
/* #define Cnil ((object)(CnilCt)) */ |
308 |
#define Ct ((object)((char *)Cnil+sizeof(struct symbol))) |
/* #define Ct ((object)((char *)Cnil+sizeof(struct symbol))) */ |
309 |
#define Dotnil ((object)((char *)Ct+sizeof(struct symbol))) |
/* #define Dotnil ((object)((char *)Ct+sizeof(struct symbol))) */ |
310 |
|
|
311 |
|
EXTER struct symbol Cnil_body OBJ_ALIGN; |
312 |
|
EXTER struct symbol Ct_body OBJ_ALIGN; |
313 |
|
|
314 |
|
#define Cnil ((object)&Cnil_body) |
315 |
|
#define Ct ((object)&Ct_body) |
316 |
#define sLnil Cnil |
#define sLnil Cnil |
317 |
#define sLt Ct |
#define sLt Ct |
318 |
|
|
918 |
Type_of. |
Type_of. |
919 |
*/ |
*/ |
920 |
#define type_of(x) ({register object _z=(object)(x);\ |
#define type_of(x) ({register object _z=(object)(x);\ |
921 |
_z==Cnil || _z==Dotnil ? t_symbol : \ |
_z==Cnil ? t_symbol : \ |
922 |
(is_imm_fixnum(_z) ? t_fixnum : \ |
(is_imm_fixnum(_z) ? t_fixnum : \ |
923 |
(is_cons(_z) ? t_cons : _z->d.t));}) |
(valid_cdr(_z) ? t_cons : _z->d.t));}) |
924 |
#define set_type_of(x,y) ({object _x=(object)(x);enum type _y=(y);*(fixnum *)(_x)&=TYPE_BITS;\ |
#define set_type_of(x,y) ({object _x=(object)(x);enum type _y=(y);*(fixnum *)(_x)&=TYPE_BITS;\ |
925 |
if (_y!=t_cons) {_x->d.e=1;_x->d.t=_y;}}) |
if (_y!=t_cons) {_x->d.e=1;_x->d.t=_y;}}) |
926 |
|
|
927 |
|
#define consp(x) ({register object _z=(object)(x);\ |
928 |
|
(_z!=Cnil && !is_imm_fixnum(_z) && valid_cdr(_z));}) |
929 |
|
#define listp(x) ({register object _z=(object)(x);\ |
930 |
|
(!is_imm_fixnum(_z) && valid_cdr(_z));}) |
931 |
|
#define atom(x) ({register object _z=(object)(x);\ |
932 |
|
(_z==Cnil || is_imm_fixnum(_z) || !valid_cdr(_z));}) |
933 |
|
|
934 |
/* |
/* |
935 |
Storage manager for each type. |
Storage manager for each type. |
936 |
*/ |
*/ |
1237 |
initialized to be placed in .data as opposed to .bss and thereby |
initialized to be placed in .data as opposed to .bss and thereby |
1238 |
initialized by the loader. 20050616 CM*/ |
initialized by the loader. 20050616 CM*/ |
1239 |
|
|
1240 |
#define endp(x) ({\ |
/* #define endp(x) ({\ */ |
1241 |
static struct cons s_my_dot={Dotnil,Dotnil};\ |
/* static struct cons s_my_dot={Dotnil,Dotnil};\ */ |
1242 |
object _x=(x);\ |
/* object _x=(x);\ */ |
1243 |
bool _b=FALSE;\ |
/* bool _b=FALSE;\ */ |
1244 |
\ |
/* \ */ |
1245 |
if (type_of(_x)==t_cons) {\ |
/* if (type_of(_x)==t_cons) {\ */ |
1246 |
if (type_of(_x->c.c_cdr)!=t_cons && _x->c.c_cdr!=Cnil)\ |
/* if (type_of(_x->c.c_cdr)!=t_cons && _x->c.c_cdr!=Cnil)\ */ |
1247 |
s_my_dot.c_car=_x->c.c_cdr;\ |
/* s_my_dot.c_car=_x->c.c_cdr;\ */ |
1248 |
else \ |
/* else \ */ |
1249 |
s_my_dot.c_car=Dotnil;\ |
/* s_my_dot.c_car=Dotnil;\ */ |
1250 |
} else {\ |
/* } else {\ */ |
1251 |
if (_x==s_my_dot.c_car)\ |
/* if (_x==s_my_dot.c_car)\ */ |
1252 |
x=(object)&s_my_dot;\ |
/* x=(object)&s_my_dot;\ */ |
1253 |
else {\ |
/* else {\ */ |
1254 |
s_my_dot.c_car=Dotnil;\ |
/* s_my_dot.c_car=Dotnil;\ */ |
1255 |
if (_x==Cnil || _x==Dotnil)\ |
/* if (_x==Cnil || _x==Dotnil)\ */ |
1256 |
_b=TRUE;\ |
/* _b=TRUE;\ */ |
1257 |
else\ |
/* else\ */ |
1258 |
FEwrong_type_argument(sLlist, _x);\ |
/* FEwrong_type_argument(sLlist, _x);\ */ |
1259 |
}\ |
/* }\ */ |
1260 |
}\ |
/* }\ */ |
1261 |
_b;\ |
/* _b;\ */ |
1262 |
}) |
/* }) */ |
1263 |
|
|
1264 |
#define endp_prop(a) (type_of(a)==t_cons ? FALSE : ((a)==Cnil ? TRUE : (FEwrong_type_argument(sLlist, (a)),FALSE))) |
/* #define endp_prop(a) (type_of(a)==t_cons ? FALSE : ((a)==Cnil ? TRUE : (FEwrong_type_argument(sLlist, (a)),FALSE))) */ |
1265 |
|
|
1266 |
#define proper_list(a) (type_of(a)==t_cons || (a)==Cnil) |
/* #define proper_list(a) (type_of(a)==t_cons || (a)==Cnil) */ |
1267 |
#define fix_dot(a) ((a) == Dotnil ? Cnil : (type_of(a)==t_cons && (a)->c.c_cdr==Dotnil ? (a)->c.c_car : (a))) |
/* #define fix_dot(a) ((a) == Dotnil ? Cnil : (type_of(a)==t_cons && (a)->c.c_cdr==Dotnil ? (a)->c.c_car : (a))) */ |
1268 |
|
|
1269 |
|
#define endp(a) (type_of(a)==t_cons ? FALSE : ((a)==Cnil ? TRUE : ({TYPE_ERROR((a),sLlist);FALSE;}))) |
1270 |
|
|
1271 |
|
|
1272 |
#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || eql1(_a,_b);}) |
#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || eql1(_a,_b);}) |
1273 |
#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || equal1(_a,_b);}) |
#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || equal1(_a,_b);}) |