Wild Life  2.30
 All Data Structures Files Functions Variables Typedefs Macros
def_macro.h
Go to the documentation of this file.
1 
6 // from c_life.h
7 
8 /* A useful macro for goals which should succeed */
9 
10 #define WFProve(A) { char *c=(A);if(!WFInput(c)) \
11  fprintf(stderr,"%s failed (%s, line %d)\n",c,__FILE__,__LINE__); }
12 
13 // from error.h
14 
15 #define NOTQUIET (!quietflag || verbose) /* 21.1 */
16 
17 // from print.h
18 
19 
20 #define HEAP_ALLOC(A) (A *)heap_alloc(sizeof(A))
21 #define STACK_ALLOC(A) (A *)stack_alloc(sizeof(A))
22 
23 #define UN_CODED (CODE)0L
24 
25 
26 /* RM: Feb 10 1993 */
27 /* To distinguish function actual parameters from formal parameters during
28  matching:
29  */
30 
31 #define FUNC_ARG(t) ((t)<match_date || (GENERIC)(t)>=heap_pointer)
32 
33 
34 
35 
36 
37 /******************************** MACROS *******************************/
38 
39 /* *** Macros for the tokenizer, define the types of ASCII characters. */
40 
41 
42 #define DIGIT(C) (C>='0' && C<='9')
43 
44 #define UPPER(C) ((C>='A' && C<='Z') || C=='_')
45 
46 #define LOWER(C) (C>='a' && C<='z')
47 
48 #define ISALPHA(C) (DIGIT(C) || UPPER(C) || LOWER(C))
49 
50 /* Must be single-character tokens (unless surrounded by quotes) */
51 /* The chars '.', '?', and '`' have been added */
52 #define SINGLE(C) (C=='(' || C==')' || C=='[' || C==']' || C=='{' || C=='`' || \
53  C=='}' || C==',' || C=='.' || C==';' || C=='@' || \
54  C=='!') /* RM: Jul 7 1993 */
55 
56 /* Can be components of multi-character tokens */
57 #define SYMBOL(C) (C=='#' || C=='$' || C=='%' || C=='&' || \
58  C=='*' || C=='+' || C=='-' || C=='>' || C=='/' || \
59  C==':' || C=='<' || C=='=' || \
60  C=='~' || C=='^' || C=='|' || C=='\\' || \
61  C=='.' || C=='?' /* RM: Jul 7 1993 */ \
62  )
63 /*C=='!' || RM: Jul 7 1993 */
64 
65 /* Returns TRUE iff psi_term A is equal to string B. */
66 /* This cannot be used on encoded types. */
67 #define equ_tok(A,B) (!strcmp(A.type->keyword->symbol,B))
68 #define equ_tok3(A,B,Q) (Q?FALSE:equ_tok(A,B))
69 
70 /* Returns TRUE iff psi_term A is equal to character B. */
71 #define equ_tokch(A,B) (A.type->keyword->symbol[0]==B && A.type->keyword->symbol[1]==0)
72 #define equ_tokch3(A,B,Q) (Q?FALSE:equ_tokch(A,B))
73 
74 /* Returns TRUE iff psi_term A is equal to character B. */
75 /* Handles also the case where B may be NULL, i.e. A must be empty */
76 #define equ_tokc(A,B) (B?equ_tokch(A,B):A.type->keyword->symbol[0]==0)
77 #define equ_tokc3(A,B,Q) (Q?FALSE:equ_tokc(A,B))
78 
79 /* *** Other macros. */
80 
81 /* The cut operation */
82 /* This ensures that a cut is below choice_stack. */
83 
84 
85 #define cut_to(C) { ptr_choice_point cp=choice_stack; \
86  while ((GENERIC)cp>(GENERIC)(C)) cp=cp->next; \
87  choice_stack=cp; \
88  }
89 
90 /*
91 #define cut_to(C) if ((ptr_choice_point)(C)<=choice_stack) { \
92  choice_stack=(ptr_choice_point)(C); \
93  }
94 */
95 
96 
97 /* The basic dereference operation. */
98 /* P must be a pointer to a psi_term. */
99 /* (For the other dereference routines, see lefun.c) */
100 #define deref_ptr(P) while(P->coref) P=P->coref
101 
102 /* Predicates defined in Life whose args should not be evaluated. */
103 #define noneval(T) (T->type==quote || T->type==listingsym || T->type==loadsym)
104 
105 /* CONSTant used to be a function, */
106 /* returns TRUE if psi_term S is a constant. */
107 #define wl_const_1(S) ((S).value_1 ==NULL && (S).type!=variable)
108 #define wl_const_2(S) ((S).value_2 ==NULL && (S).type!=variable)
109 #define wl_const_3(S) ((S).value_3 ==NULL && (S).type!=variable)
110 
111 #define equal_types(A,B) ((A)==(B))
112 
113 #define is_top(T) ((T)!=NULL && (T)->type==top && (T)->attr_list==NULL)
114 
115 /* Object is inside Life data space */
116 
117 /* #define VALID_RANGE(A) ((GENERIC)A>=mem_base && (GENERIC)A<mem_limit) \
118  ?TRUE \
119  :printf("*** Address out of range: %ld, base=%ld, limit=%ld\n", \
120  (unsigned long) A, \
121  (unsigned long) mem_base, \
122  (unsigned long) mem_limit),FALSE;
123 
124  RM: Jan 4 1993 An idea
125 */
126 
127 #define VALID_RANGE(A) ((GENERIC)A>=mem_base && (GENERIC)A<mem_limit)
128 
129 /* Object has valid address to be modified in garbage collector */
130 #ifdef X11
131 #define VALID_ADDRESS(A) ( VALID_RANGE(A) \
132  || (GENERIC)A==(GENERIC)&xevent_list \
133  || (GENERIC)A==(GENERIC)&xevent_existing \
134  || (GENERIC)A==(GENERIC)&var_tree \
135  )
136 #else
137 #define VALID_ADDRESS(A) ( VALID_RANGE(A) \
138  || (GENERIC)A==(GENERIC)&var_tree \
139  )
140 #endif
141 
142 #define stack_empty_list() stack_nil() /* RM: Dec 14 1992 */
143 /* extern ptr_psi_term stack_empty_list(); */
144 
145 // from lefun.h
146 
147 #define deref(P) {deref_ptr(P);if (deref_eval(P)) return TRUE;}
148 #define deref_void(P) {deref_ptr(P);deref_eval(P);}
149 #define deref_rec(P) {deref_ptr(P);if (deref_rec_eval(P)) return TRUE;}
150 #define deref_args(P,S) {deref_ptr(P);if (deref_args_eval(P,S)) return TRUE;}
151 #define deref_args_void(P) {deref_ptr(P);deref_args_eval(P);}
152 
153 // from list.h
154 
155 /*=============================================================================*/
156 /* Get functions (macros) */
157 /*=============================================================================*/
158 
159 #define List_First(header) ((header)->First)
160 #define List_Last(header) ((header)->Last)
161 #define List_Next(header,RefAtom) ((*(header)->GetLinks)(RefAtom)->Next)
162 #define List_Prev(header,RefAtom) ((*(header)->GetLinks)(RefAtom)->Prev)
163 #define List_IsEmpty(header) (List_First(header)==NULL)
164 
165 // from sys.h
166 
167 
168 #define SETARG(args,i,the_feature,the_type,the_options) \
169  { int j = i; \
170  args[j].feature = the_feature; \
171  args[j].type = the_type; \
172  args[j].options = the_options; }
173 
174 #define NARGS(args) (sizeof(args)/sizeof(psi_arg))
175 
176 // from templates.h
177 
178 /* PVR: Dec 17 1992 */
179 #ifdef X11
180 #define XPART(argi,vali,numi) \
181  if (argi->type == xwindow || argi->type == xpixmap) {\
182  vali = GetIntAttr (argi, "id"); \
183  if(vali== -34466) \
184  numi=FALSE; \
185  }
186 
187 #else
188 #define XPART(argi,vali,numi) if (FALSE) ;
189 #endif
190 
191 
192 
193 /* macros */
194 
195 
196 #define include_var_builtin(NBARGS) \
197  ptr_psi_term g, args[NBARGS]; \
198  long num[NBARGS]; \
199  long val[NBARGS]; \
200  long ii, success=TRUE, resi=FALSE
201 
202 
203 #define begin_builtin(FUNCNAME, NBARGS, NBARGSIN, TYPES) \
204  if (NBARGS > MAXNBARGS) \
205  Errorline ("in template: you have to increase MAXNBARGS at least to %d !\n", NBARGS); \
206  \
207  g=aim->aaaa_1; \
208  deref_ptr(g); \
209  \
210  for (ii = 0; success && ii < NBARGS; ii++) \
211  success = get_arg (g, &args[ii], numbers[ii]); \
212  \
213  if (success) \
214  { \
215  for (ii = 0; ii < NBARGS; ii++) \
216  deref (args[ii]); \
217  \
218  deref_args (g, set_extra_args [NBARGS+1]); \
219  \
220  for (ii = 0; success && ii < NBARGS; ii++) \
221  { \
222  success = matches (args[ii]->type, types[ii], &num[ii]); \
223  if (args[ii]->value_3 != NULL && num[ii]) \
224  if (types[ii] == integer) \
225  val[ii] = *(long *) args[ii]->value_3; \
226  else \
227  if (types[ii] == real) \
228  val[ii] = *(REAL *) args[ii]->value_3; \
229  else \
230  if (types[ii] == quoted_string) \
231  val[ii] = (long) args[ii]->value_3; \
232  else \
233  Errorline ("in template: type %T not expected (built-in FUNCNAME).\n", types[ii]); \
234  else \
235  if (args[ii]->type == lf_true) \
236  val[ii] = TRUE; \
237  else \
238  if (args[ii]->type == lf_false) \
239  val[ii] = FALSE; \
240  else \
241  XPART(args[ii],val[ii],num[ii]) /* 16.12 */ \
242  else \
243  num[ii] = FALSE; /* force the residuation */ \
244  } \
245  \
246  if (success) \
247  { \
248  for (ii = 0; ii < NBARGSIN; ii++) \
249  if (args[ii]->resid != NULL || !num[ii]) \
250  { \
251  residuate (args[ii]); \
252  resi = TRUE; \
253  } \
254  \
255  if (success && !resi) \
256  {
257 
258 
259 #define end_builtin() \
260  } \
261  } \
262  else \
263  Errorline ("bad arguments in %P.\n", g); \
264  } \
265  else \
266  Errorline ("missing arguments in %P.\n", g); \
267  \
268  return success;
269 // from extern.h
270 #define ARGS(args) args
271 
272 // from arity.c
273 #define PERUNIF(X) X,100.0*((double)X/(double)Aunif)
274 #define PERMERGE(X) X,100.0*((double)X/(double)Amerge)
275 
276 // from copy.c
277 /* Simple hash function */
278 #define HASH(A) (((long) A + ((long) A >> 3)) & (HASHSIZE-1))
279 
280 /* TRUE iff R is on the heap */
281 #define ONHEAP(R) ((GENERIC)R>=heap_pointer)
282 
283 /* Allocate a new record on the heap or stack if necessary: */
284 #define NEW(A,TYPE) (heap_flag==HEAP \
285  ? (to_heap \
286  ? (ONHEAP(A) \
287  ? A \
288  : HEAP_ALLOC(TYPE) \
289  ) \
290  : HEAP_ALLOC(TYPE) \
291  ) \
292  : STACK_ALLOC(TYPE) \
293  )
294 
295 /* TRUE iff to_heap is TRUE & work is done, i.e. the term is on the heap. */
296 #define HEAPDONE(R) (to_heap && ONHEAP(R))
297 
298 // from memory.c
299 #define ALIGNUP(X) { (X) = (GENERIC)( ((long) (X) + (ALIGN-1)) & ~(ALIGN-1) ); }