Wild Life: def_macro.h Source File

Wild Life 2.29

- Main Page
- Data Structures
- Files

- File List
- Globals

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