/[gcl]/gcl/h/object.h
ViewVC logotype

Diff of /gcl/h/object.h

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.48 by camm, Sat Oct 1 15:41:50 2005 UTC revision 1.49 by camm, Thu Oct 6 20:30:08 2005 UTC
# Line 193  struct fixnum_struct { Line 193  struct fixnum_struct {
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    
# Line 302  struct symbol { Line 302  struct symbol {
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    
# Line 912  struct freelist { Line 918  struct freelist {
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  */  */
# Line 1223  EXTER unsigned plong signals_allowed, si Line 1237  EXTER unsigned plong signals_allowed, si
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);})

Legend:
Removed from v.1.48  
changed lines
  Added in v.1.49

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26