1 /****************************************************************************
2 **
3 ** This file is part of GAP, a system for computational discrete algebra.
4 **
5 ** Copyright of GAP belongs to its developers, whose names are too numerous
6 ** to list here. Please refer to the COPYRIGHT file for details.
7 **
8 ** SPDX-License-Identifier: GPL-2.0-or-later
9 **
10 ** This file contains the GAP to C compiler.
11 */
12
13 #include "compiler.h"
14
15 #include "ariths.h"
16 #include "bool.h"
17 #include "calls.h"
18 #include "code.h"
19 #include "error.h"
20 #include "exprs.h"
21 #include "gvars.h"
22 #include "integer.h"
23 #include "io.h"
24 #include "lists.h"
25 #include "modules.h"
26 #include "plist.h"
27 #include "records.h"
28 #include "stats.h"
29 #include "stringobj.h"
30 #include "sysopt.h"
31 #include "vars.h"
32
33 #include <stdarg.h>
34
35
36 /****************************************************************************
37 **
38 *F * * * * * * * * * * * * * compilation flags * * * * * * * * * * * * * * *
39 */
40
41
42 /****************************************************************************
43 **
44 *V CompFastIntArith . . option to emit code that handles small ints. faster
45 */
46 static Int CompFastIntArith;
47
48
49 /****************************************************************************
50 **
51 *V CompFastPlainLists . option to emit code that handles plain lists faster
52 */
53 static Int CompFastPlainLists;
54
55
56 /****************************************************************************
57 **
58 *V CompFastListFuncs . . option to emit code that inlines calls to functions
59 */
60 static Int CompFastListFuncs;
61
62
63 /****************************************************************************
64 **
65 *V CompCheckTypes . . . . option to emit code that assumes all types are ok.
66 */
67 static Int CompCheckTypes;
68
69
70 /****************************************************************************
71 **
72 *V CompCheckListElements . option to emit code that assumes list elms exist
73 */
74 static Int CompCheckListElements;
75
76
77 /****************************************************************************
78 **
79 *V CompPass . . . . . . . . . . . . . . . . . . . . . . . . . compiler pass
80 **
81 ** 'CompPass' holds the number of the current pass.
82 **
83 ** The compiler does two passes over the source.
84 **
85 ** In the first pass it only collects information but emits no code.
86 **
87 ** It finds out which global variables and record names are used, so that
88 ** the compiler can output code to define and initialize global variables
89 ** 'G_<name>' resp. 'R_<name>' to hold their identifiers.
90 **
91 ** It finds out which arguments and local variables are used as higher
92 ** variables from inside local functions, so that the compiler can output
93 ** code to allocate and manage a stack frame for them.
94 **
95 ** It finds out how many temporary variables are used, so that the compiler
96 ** can output code to define corresponding local variables.
97 **
98 ** In the second pass it emits code.
99 **
100 ** The only difference between the first pass and the second pass is that
101 ** 'Emit' emits no code during the first pass. While this causes many
102 ** unneccessary computations during the first pass, the advantage is that
103 ** the two passes are guaranteed to do exactly the same computations.
104 */
105 static Int CompPass;
106
107
108 /****************************************************************************
109 **
110 *F * * * * * * * * * * * * temp, C, local functions * * * * * * * * * * * * *
111 */
112
113
114 /****************************************************************************
115 **
116 *V compilerMagic1 . . . . . . . . . . . . . . . . . . . . . current magic1
117 */
118 static Int compilerMagic1;
119
120
121 /****************************************************************************
122 **
123 *V compilerMagic2 . . . . . . . . . . . . . . . . . . . . . current magic2
124 */
125 static Obj compilerMagic2;
126
127
128 /****************************************************************************
129 **
130 *T CVar . . . . . . . . . . . . . . . . . . . . . . . type for C variables
131 **
132 ** A C variable represents the result of compiling an expression. There are
133 ** three cases (distinguished by the least significant two bits).
134 **
135 ** If the expression is an immediate integer expression, the C variable
136 ** contains the value of the immediate integer expression.
137 **
138 ** If the expression is an immediate reference to a local variable, the C
139 ** variable contains the index of the local variable.
140 **
141 ** Otherwise the expression compiler emits code that puts the value of the
142 ** expression into a temporary variable, and the C variable contains the
143 ** index of that temporary variable.
144 */
145 typedef UInt CVar;
146
147 #define IS_INTG_CVAR(c) ((((UInt)(c)) & 0x03) == 0x01)
148 #define INTG_CVAR(c) (((Int)(c)) >> 2)
149 #define CVAR_INTG(i) ((((UInt)(i)) << 2) + 0x01)
150
151 #define IS_TEMP_CVAR(c) ((((UInt)(c)) & 0x03) == 0x02)
152 #define TEMP_CVAR(c) (((UInt)(c)) >> 2)
153 #define CVAR_TEMP(l) ((((UInt)(l)) << 2) + 0x02)
154
155 #define IS_LVAR_CVAR(c) ((((UInt)(c)) & 0x03) == 0x03)
156 #define LVAR_CVAR(c) (((UInt)(c)) >> 2)
157 #define CVAR_LVAR(l) ((((UInt)(l)) << 2) + 0x03)
158
159
160 /****************************************************************************
161 **
162 *F SetInfoCVar( <cvar>, <type> ) . . . . . . . set the type of a C variable
163 *F GetInfoCVar( <cvar> ) . . . . . . . . . . . get the type of a C variable
164 *F HasInfoCVar( <cvar>, <type> ) . . . . . . . test the type of a C variable
165 **
166 *F NewInfoCVars() . . . . . . . . . allocate a new info bag for C variables
167 *F CopyInfoCVars( <dst>, <src> ) . . copy between info bags for C variables
168 *F MergeInfoCVars( <dst>, <src> ) . . . merge two info bags for C variables
169 *F IsEqInfoCVars( <dst>, <src> ) . . . compare two info bags for C variables
170 **
171 ** With each function we associate a C variables information bag. In this
172 ** bag we store the number of the function, the number of local variables,
173 ** the number of local variables that are used as higher variables, the
174 ** number of temporaries used, the current number of used temporaries.
175 **
176 ** Furthermore for each local variable and temporary we store what we know
177 ** about this local variable or temporary, i.e., whether the variable has an
178 ** assigned value, whether that value is an integer, a boolean, etc.
179 **
180 ** 'SetInfoCVar' sets the information for the C variable <cvar>.
181 ** 'GetInfoCVar' gets the information for the C variable <cvar>.
182 ** 'HasInfoCVar' returns true if the C variable <cvar> has the type <type>.
183 **
184 ** 'NewInfoCVars' creates a new C variables information bag.
185 ** 'CopyInfoCVars' copies the C variables information from <src> to <dst>.
186 ** 'MergeInfoCVars' merges the C variables information from <src> to <dst>,
187 ** i.e., if there are two paths to a certain place in the source and <dst>
188 ** is the information gathered along one path and <src> is the information
189 ** gathered along the other path, then 'MergeInfoCVars' stores in <dst> the
190 ** information for that point (independent of the path travelled).
191 ** 'IsEqInfoCVars' returns true if <src> and <dst> contain the same
192 ** information.
193 **
194 ** Note that the numeric values for the types are defined such that if
195 ** <type1> implies <type2>, then <type1> is a bitwise superset of <type2>.
196 */
197 typedef UInt4 LVar;
198
199 #define INFO_FEXP(fexp) PROF_FUNC(fexp)
200 #define SET_INFO_FEXP(fexp,x) SET_PROF_FUNC(fexp,x)
201 #define NEXT_INFO(info) PTR_BAG(info)[1]
202 #define NR_INFO(info) (*((Int*)(PTR_BAG(info)+2)))
203 #define NLVAR_INFO(info) (*((Int*)(PTR_BAG(info)+3)))
204 #define NHVAR_INFO(info) (*((Int*)(PTR_BAG(info)+4)))
205 #define NTEMP_INFO(info) (*((Int*)(PTR_BAG(info)+5)))
206 #define CTEMP_INFO(info) (*((Int*)(PTR_BAG(info)+6)))
207 #define TNUM_LVAR_INFO(info,i) (*((Int*)(PTR_BAG(info)+7+(i))))
208
209 #define TNUM_TEMP_INFO(info,i) \
210 (*((Int*)(PTR_BAG(info)+7+NLVAR_INFO(info)+(i))))
211
212 #define SIZE_INFO(nlvar,ntemp) (sizeof(Int) * (1 + 7 + (nlvar) + (ntemp)))
213
214 #define W_UNUSED 0 /* TEMP is currently unused */
215 #define W_HIGHER (1L<<0) /* LVAR is used as higher variable */
216 #define W_UNKNOWN ((1L<<1) | W_HIGHER)
217 #define W_UNBOUND ((1L<<2) | W_UNKNOWN)
218 #define W_BOUND ((1L<<3) | W_UNKNOWN)
219 #define W_INT ((1L<<4) | W_BOUND)
220 #define W_INT_SMALL ((1L<<5) | W_INT)
221 #define W_INT_POS ((1L<<6) | W_INT)
222 #define W_BOOL ((1L<<7) | W_BOUND)
223 #define W_FUNC ((1L<<8) | W_BOUND)
224 #define W_LIST ((1L<<9) | W_BOUND)
225
226 #define W_INT_SMALL_POS (W_INT_SMALL | W_INT_POS)
227
SetInfoCVar(CVar cvar,UInt type)228 static void SetInfoCVar(CVar cvar, UInt type)
229 {
230 Bag info; /* its info bag */
231
232 /* get the information bag */
233 info = INFO_FEXP( CURR_FUNC() );
234
235 /* set the type of a temporary */
236 if ( IS_TEMP_CVAR(cvar) ) {
237 TNUM_TEMP_INFO( info, TEMP_CVAR(cvar) ) = type;
238 }
239
240 /* set the type of a lvar (but do not change if it is a higher variable) */
241 else if ( IS_LVAR_CVAR(cvar)
242 && TNUM_LVAR_INFO( info, LVAR_CVAR(cvar) ) != W_HIGHER ) {
243 TNUM_LVAR_INFO( info, LVAR_CVAR(cvar) ) = type;
244 }
245 }
246
GetInfoCVar(CVar cvar)247 static Int GetInfoCVar(CVar cvar)
248 {
249 Bag info; /* its info bag */
250
251 /* get the information bag */
252 info = INFO_FEXP( CURR_FUNC() );
253
254 /* get the type of an integer */
255 if ( IS_INTG_CVAR(cvar) ) {
256 return ((0 < INTG_CVAR(cvar)) ? W_INT_SMALL_POS : W_INT_SMALL);
257 }
258
259 /* get the type of a temporary */
260 else if ( IS_TEMP_CVAR(cvar) ) {
261 return TNUM_TEMP_INFO( info, TEMP_CVAR(cvar) );
262 }
263
264 /* get the type of a lvar */
265 else if ( IS_LVAR_CVAR(cvar) ) {
266 return TNUM_LVAR_INFO( info, LVAR_CVAR(cvar) );
267 }
268
269 /* hmm, avoid warning by compiler */
270 else {
271 return 0;
272 }
273 }
274
HasInfoCVar(CVar cvar,Int type)275 static Int HasInfoCVar(CVar cvar, Int type)
276 {
277 return ((GetInfoCVar( cvar ) & type) == type);
278 }
279
280
NewInfoCVars(void)281 static Bag NewInfoCVars(void)
282 {
283 Bag old;
284 Bag new;
285 old = INFO_FEXP( CURR_FUNC() );
286 new = NewBag( TNUM_BAG(old), SIZE_BAG(old) );
287 return new;
288 }
289
CopyInfoCVars(Bag dst,Bag src)290 static void CopyInfoCVars(Bag dst, Bag src)
291 {
292 Int i;
293 if ( SIZE_BAG(dst) < SIZE_BAG(src) ) ResizeBag( dst, SIZE_BAG(src) );
294 if ( SIZE_BAG(src) < SIZE_BAG(dst) ) ResizeBag( src, SIZE_BAG(dst) );
295 NR_INFO(dst) = NR_INFO(src);
296 NLVAR_INFO(dst) = NLVAR_INFO(src);
297 NHVAR_INFO(dst) = NHVAR_INFO(src);
298 NTEMP_INFO(dst) = NTEMP_INFO(src);
299 CTEMP_INFO(dst) = CTEMP_INFO(src);
300 for ( i = 1; i <= NLVAR_INFO(src); i++ ) {
301 TNUM_LVAR_INFO(dst,i) = TNUM_LVAR_INFO(src,i);
302 }
303 for ( i = 1; i <= NTEMP_INFO(dst) && i <= NTEMP_INFO(src); i++ ) {
304 TNUM_TEMP_INFO(dst,i) = TNUM_TEMP_INFO(src,i);
305 }
306 }
307
MergeInfoCVars(Bag dst,Bag src)308 static void MergeInfoCVars(Bag dst, Bag src)
309 {
310 Int i;
311 if ( SIZE_BAG(dst) < SIZE_BAG(src) ) ResizeBag( dst, SIZE_BAG(src) );
312 if ( SIZE_BAG(src) < SIZE_BAG(dst) ) ResizeBag( src, SIZE_BAG(dst) );
313 if ( NTEMP_INFO(dst)<NTEMP_INFO(src) ) NTEMP_INFO(dst)=NTEMP_INFO(src);
314 for ( i = 1; i <= NLVAR_INFO(src); i++ ) {
315 TNUM_LVAR_INFO(dst,i) &= TNUM_LVAR_INFO(src,i);
316 }
317 for ( i = 1; i <= NTEMP_INFO(dst) && i <= NTEMP_INFO(src); i++ ) {
318 TNUM_TEMP_INFO(dst,i) &= TNUM_TEMP_INFO(src,i);
319 }
320 }
321
IsEqInfoCVars(Bag dst,Bag src)322 static Int IsEqInfoCVars(Bag dst, Bag src)
323 {
324 Int i;
325 if ( SIZE_BAG(dst) < SIZE_BAG(src) ) ResizeBag( dst, SIZE_BAG(src) );
326 if ( SIZE_BAG(src) < SIZE_BAG(dst) ) ResizeBag( src, SIZE_BAG(dst) );
327 for ( i = 1; i <= NLVAR_INFO(src); i++ ) {
328 if ( TNUM_LVAR_INFO(dst,i) != TNUM_LVAR_INFO(src,i) ) {
329 return 0;
330 }
331 }
332 for ( i = 1; i <= NTEMP_INFO(dst) && i <= NTEMP_INFO(src); i++ ) {
333 if ( TNUM_TEMP_INFO(dst,i) != TNUM_TEMP_INFO(src,i) ) {
334 return 0;
335 }
336 }
337 return 1;
338 }
339
340
341 /****************************************************************************
342 **
343 *F NewTemp( <name> ) . . . . . . . . . . . . . . . allocate a new temporary
344 *F FreeTemp( <temp> ) . . . . . . . . . . . . . . . . . . free a temporary
345 **
346 ** 'NewTemp' allocates a new temporary variable (<name> is currently
347 ** ignored).
348 **
349 ** 'FreeTemp' frees the temporary <temp>.
350 **
351 ** Currently allocations and deallocations of temporaries are done in a
352 ** strict nested (laff -- last allocated, first freed) order. This means we
353 ** do not have to search for unused temporaries.
354 */
355 typedef UInt4 Temp;
356
NewTemp(const Char * name)357 static Temp NewTemp(const Char * name)
358 {
359 Temp temp; /* new temporary, result */
360 Bag info; /* information bag */
361
362 /* get the information bag */
363 info = INFO_FEXP( CURR_FUNC() );
364
365 /* take the next available temporary */
366 CTEMP_INFO( info )++;
367 temp = CTEMP_INFO( info );
368
369 /* maybe make room for more temporaries */
370 if ( NTEMP_INFO( info ) < temp ) {
371 if ( SIZE_BAG(info) < SIZE_INFO( NLVAR_INFO(info), temp ) ) {
372 ResizeBag( info, SIZE_INFO( NLVAR_INFO(info), temp+7 ) );
373 }
374 NTEMP_INFO( info ) = temp;
375 }
376 TNUM_TEMP_INFO( info, temp ) = W_UNKNOWN;
377
378 /* return the temporary */
379 return temp;
380 }
381
FreeTemp(Temp temp)382 static void FreeTemp(Temp temp)
383 {
384 Bag info; /* information bag */
385
386 /* get the information bag */
387 info = INFO_FEXP( CURR_FUNC() );
388
389 /* check that deallocations happens in the correct order */
390 if ( temp != CTEMP_INFO( info ) && CompPass == 2 ) {
391 Pr("PROBLEM: freeing t_%d, should be t_%d\n",(Int)temp,CTEMP_INFO(info));
392 }
393
394 /* free the temporary */
395 TNUM_TEMP_INFO( info, temp ) = W_UNUSED;
396 CTEMP_INFO( info )--;
397 }
398
399
400 /****************************************************************************
401 **
402 *F CompSetUseHVar( <hvar> ) . . . . . . . . register use of higher variable
403 *F CompGetUseHVar( <hvar> ) . . . . . . . . get use mode of higher variable
404 *F GetLevlHVar( <hvar> ) . . . . . . . . . . . get level of higher variable
405 *F GetIndxHVar( <hvar> ) . . . . . . . . . . . get index of higher variable
406 **
407 ** 'CompSetUseHVar' register (during pass 1) that the variable <hvar> is
408 ** used as higher variable, i.e., is referenced from inside a local
409 ** function. Such variables must be allocated in a stack frame bag (and
410 ** cannot be mapped to C variables).
411 **
412 ** 'CompGetUseHVar' returns nonzero if the variable <hvar> is used as higher
413 ** variable.
414 **
415 ** 'GetLevlHVar' returns the level of the higher variable <hvar>, i.e., the
416 ** number of frames that must be walked upwards for the one containing
417 ** <hvar>. This may be properly smaller than 'LEVEL_HVAR(<hvar>)', because
418 ** only those compiled functions that have local variables that are used as
419 ** higher variables allocate a stack frame.
420 **
421 ** 'GetIndxHVar' returns the index of the higher variable <hvar>, i.e., the
422 ** position of <hvar> in the stack frame. This may be properly smaller than
423 ** 'INDEX_HVAR(<hvar>)', because only those local variable that are used as
424 ** higher variables are allocated in a stack frame.
425 */
426 typedef UInt4 HVar;
427
CompSetUseHVar(HVar hvar)428 static void CompSetUseHVar(HVar hvar)
429 {
430 Bag info; /* its info bag */
431 Int i; /* loop variable */
432
433 /* only mark in pass 1 */
434 if ( CompPass != 1 ) return;
435
436 /* walk up */
437 info = INFO_FEXP( CURR_FUNC() );
438 for ( i = 1; i <= (hvar >> 16); i++ ) {
439 info = NEXT_INFO( info );
440 }
441
442 /* set mark */
443 if ( TNUM_LVAR_INFO( info, (hvar & 0xFFFF) ) != W_HIGHER ) {
444 TNUM_LVAR_INFO( info, (hvar & 0xFFFF) ) = W_HIGHER;
445 NHVAR_INFO(info) = NHVAR_INFO(info) + 1;
446 }
447
448 }
449
CompGetUseHVar(HVar hvar)450 static Int CompGetUseHVar(HVar hvar)
451 {
452 Bag info; /* its info bag */
453 Int i; /* loop variable */
454
455 /* walk up */
456 info = INFO_FEXP( CURR_FUNC() );
457 for ( i = 1; i <= (hvar >> 16); i++ ) {
458 info = NEXT_INFO( info );
459 }
460
461 /* get mark */
462 return (TNUM_LVAR_INFO( info, (hvar & 0xFFFF) ) == W_HIGHER);
463 }
464
GetLevlHVar(HVar hvar)465 static UInt GetLevlHVar(HVar hvar)
466 {
467 UInt levl; /* level of higher variable */
468 Bag info; /* its info bag */
469 Int i; /* loop variable */
470
471 /* walk up */
472 levl = 0;
473 info = INFO_FEXP( CURR_FUNC() );
474 levl++;
475 for ( i = 1; i <= (hvar >> 16); i++ ) {
476 info = NEXT_INFO( info );
477 levl++;
478 }
479
480 /* return level (the number steps to go up) */
481 return levl - 1;
482 }
483
GetIndxHVar(HVar hvar)484 static UInt GetIndxHVar(HVar hvar)
485 {
486 UInt indx; /* index of higher variable */
487 Bag info; /* its info bag */
488 Int i; /* loop variable */
489
490 /* walk up */
491 info = INFO_FEXP( CURR_FUNC() );
492 for ( i = 1; i <= (hvar >> 16); i++ ) {
493 info = NEXT_INFO( info );
494 }
495
496 /* walk right */
497 indx = 0;
498 for ( i = 1; i <= (hvar & 0xFFFF); i++ ) {
499 if ( TNUM_LVAR_INFO( info, i ) == W_HIGHER ) indx++;
500 }
501
502 /* return the index */
503 return indx;
504 }
505
506
507 /****************************************************************************
508 **
509 *F CompSetUseGVar( <gvar>, <mode> ) . . . . register use of global variable
510 *F CompGetUseGVar( <gvar> ) . . . . . . . . get use mode of global variable
511 **
512 ** 'CompSetUseGVar' registers (during pass 1) the use of the global variable
513 ** with identifier <gvar>.
514 **
515 ** 'CompGetUseGVar' returns the bitwise OR of all the <mode> arguments for
516 ** the global variable with identifier <gvar>.
517 **
518 ** Currently the interpretation of the <mode> argument is as follows
519 **
520 ** If '<mode> & COMP_USE_GVAR_ID' is nonzero, then the produced code shall
521 ** define and initialize 'G_<name>' with the identifier of the global
522 ** variable (which may be different from <gvar> by the time the compiled
523 ** code is actually run).
524 **
525 ** If '<mode> & COMP_USE_GVAR_COPY' is nonzero, then the produced code shall
526 ** define and initialize 'GC_<name>' as a copy of the global variable
527 ** (see 'InitCopyGVar' in 'gvars.h').
528 **
529 ** If '<mode> & COMP_USE_GVAR_FOPY' is nonzero, then the produced code shall
530 ** define and initialize 'GF_<name>' as a function copy of the global
531 ** variable (see 'InitFopyGVar' in 'gvars.h').
532 */
533 typedef UInt GVar;
534
535 #define COMP_USE_GVAR_ID (1L << 0)
536 #define COMP_USE_GVAR_COPY (1L << 1)
537 #define COMP_USE_GVAR_FOPY (1L << 2)
538
539 static Bag CompInfoGVar;
540
CompSetUseGVar(GVar gvar,UInt mode)541 static void CompSetUseGVar(GVar gvar, UInt mode)
542 {
543 /* only mark in pass 1 */
544 if ( CompPass != 1 ) return;
545
546 /* resize if neccessary */
547 if ( SIZE_OBJ(CompInfoGVar)/sizeof(UInt) <= gvar ) {
548 ResizeBag( CompInfoGVar, sizeof(UInt)*(gvar+1) );
549 }
550
551 /* or with <mode> */
552 ((UInt*)PTR_BAG(CompInfoGVar))[gvar] |= mode;
553 }
554
CompGetUseGVar(GVar gvar)555 static UInt CompGetUseGVar(GVar gvar)
556 {
557 return ((UInt*)PTR_BAG(CompInfoGVar))[gvar];
558 }
559
560
561 /****************************************************************************
562 **
563 *F CompSetUseRNam( <rnam>, <mode> ) . . . . . . register use of record name
564 *F CompGetUseRNam( <rnam> ) . . . . . . . . . . get use mode of record name
565 **
566 ** 'CompSetUseRNam' registers (during pass 1) the use of the record name
567 ** with identifier <rnam>. 'CompGetUseRNam' returns the bitwise OR of all
568 ** the <mode> arguments for the global variable with identifier <rnam>.
569 **
570 ** Currently the interpretation of the <mode> argument is as follows
571 **
572 ** If '<mode> & COMP_USE_RNAM_ID' is nonzero, then the produced code shall
573 ** define and initialize 'R_<name>' with the identifier of the record name
574 ** (which may be different from <rnam> when the time the compiled code is
575 ** actually run).
576 */
577 typedef UInt RNam;
578
579 #define COMP_USE_RNAM_ID (1L << 0)
580
581 static Bag CompInfoRNam;
582
CompSetUseRNam(RNam rnam,UInt mode)583 static void CompSetUseRNam(RNam rnam, UInt mode)
584 {
585 /* only mark in pass 1 */
586 if ( CompPass != 1 ) return;
587
588 /* resize if neccessary */
589 if ( SIZE_OBJ(CompInfoRNam)/sizeof(UInt) <= rnam ) {
590 ResizeBag( CompInfoRNam, sizeof(UInt)*(rnam+1) );
591 }
592
593 /* or with <mode> */
594 ((UInt*)PTR_BAG(CompInfoRNam))[rnam] |= mode;
595 }
596
CompGetUseRNam(RNam rnam)597 static UInt CompGetUseRNam(RNam rnam)
598 {
599 return ((UInt*)PTR_BAG(CompInfoRNam))[rnam];
600 }
601
602
603 /****************************************************************************
604 **
605 *F Emit( <fmt>, ... ) . . . . . . . . . . . . . . . . . . . . . . emit code
606 **
607 ** 'Emit' outputs the string <fmt> and the other arguments, which must
608 ** correspond to the '%' format elements in <fmt>. Nothing is actually
609 ** outputted if 'CompPass' is not 2.
610 **
611 ** 'Emit' supports the following '%' format elements: '%d' formats an
612 ** integer, '%s' formats a string, '%S' formats a string with all the
613 ** necessary escapes, %C does the same but uses only valid C escapes, '%n'
614 ** formats a name ('_' is converted to '__', special characters are
615 ** converted to '_<hex1><hex2>'), '%c' formats a C variable
616 ** ('INTOBJ_INT(<int>)' for integers, 'a_<name>' for arguments, 'l_<name>'
617 ** for locals, 't_<nr>' for temporaries), and '%%' outputs a single '%'.
618 */
619 static Int EmitIndent;
620
621 static Int EmitIndent2;
622
Emit(const char * fmt,...)623 static void Emit(const char * fmt, ...)
624 {
625 Int narg; /* number of arguments */
626 va_list ap; /* argument list pointer */
627 Int dint; /* integer argument */
628 CVar cvar; /* C variable argument */
629 Char * string; /* string argument */
630 const Char * p; /* loop variable */
631 const Char * hex = "0123456789ABCDEF";
632
633 /* are we in pass 2? */
634 if ( CompPass != 2 ) return;
635
636 /* get the information bag */
637 narg = NARG_FUNC( CURR_FUNC() );
638 if (narg < 0) {
639 narg = -narg;
640 }
641
642 /* loop over the format string */
643 va_start( ap, fmt );
644 for ( p = fmt; *p != '\0'; p++ ) {
645
646 /* print an indent, except for preprocessor commands */
647 if ( *fmt != '#' ) {
648 if ( 0 < EmitIndent2 && *p == '}' ) EmitIndent2--;
649 while ( 0 < EmitIndent2-- ) Pr( " ", 0L, 0L );
650 }
651
652 /* format an argument */
653 if ( *p == '%' ) {
654 p++;
655
656 /* emit an integer */
657 if ( *p == 'd' ) {
658 dint = va_arg( ap, Int );
659 Pr( "%d", dint, 0L );
660 }
661
662 // emit a C string
663 else if ( *p == 's' || *p == 'S' ) {
664 const Char f[] = { '%', *p, 0 };
665 string = va_arg( ap, Char* );
666 Pr( f, (Int)string, 0L );
667 }
668
669 // emit a GAP string
670 else if ( *p == 'g' || *p == 'G' || *p == 'C' ) {
671 const Char f[] = { '%', *p, 0 };
672 Obj str = va_arg( ap, Obj );
673 Pr( f, (Int)str, 0L );
674 }
675
676 /* emit a name */
677 else if ( *p == 'n' ) {
678 Obj str = va_arg( ap, Obj );
679 UInt i = 0;
680 Char c;
681 while ((c = CONST_CSTR_STRING(str)[i++])) {
682 if ( IsAlpha(c) || IsDigit(c) ) {
683 Pr( "%c", (Int)c, 0L );
684 }
685 else if ( c == '_' ) {
686 Pr( "__", 0L, 0L );
687 }
688 else {
689 Pr("_%c%c",hex[((UInt)c)/16],hex[((UInt)c)%16]);
690 }
691 }
692 }
693
694 /* emit a C variable */
695 else if ( *p == 'c' ) {
696 cvar = va_arg( ap, CVar );
697 if ( IS_INTG_CVAR(cvar) ) {
698 Int x = INTG_CVAR(cvar);
699 if (x >= -(1L <<28) && x < (1L << 28))
700 Pr( "INTOBJ_INT(%d)", x, 0L );
701 else
702 Pr( "ObjInt_Int8(%d)", x, 0L );
703 }
704 else if ( IS_TEMP_CVAR(cvar) ) {
705 Pr( "t_%d", TEMP_CVAR(cvar), 0L );
706 }
707 else if ( LVAR_CVAR(cvar) <= narg ) {
708 Emit( "a_%n", NAME_LVAR( LVAR_CVAR(cvar) ) );
709 }
710 else {
711 Emit( "l_%n", NAME_LVAR( LVAR_CVAR(cvar) ) );
712 }
713 }
714
715 /* emit a C variable */
716 else if ( *p == 'i' ) {
717 cvar = va_arg( ap, CVar );
718 if ( IS_INTG_CVAR(cvar) ) {
719 Pr( "%d", INTG_CVAR(cvar), 0L );
720 }
721 else if ( IS_TEMP_CVAR(cvar) ) {
722 Pr( "INT_INTOBJ(t_%d)", TEMP_CVAR(cvar), 0L );
723 }
724 else if ( LVAR_CVAR(cvar) <= narg ) {
725 Emit( "INT_INTOBJ(a_%n)", NAME_LVAR( LVAR_CVAR(cvar) ) );
726 }
727 else {
728 Emit( "INT_INTOBJ(l_%n)", NAME_LVAR( LVAR_CVAR(cvar) ) );
729 }
730 }
731
732 /* emit a '%' */
733 else if ( *p == '%' ) {
734 Pr( "%%", 0L, 0L );
735 }
736
737 /* what */
738 else {
739 Pr( "%%illegal format statement", 0L, 0L );
740 }
741
742 }
743
744 else if ( *p == '{' ) {
745 Pr( "{", 0L, 0L );
746 EmitIndent++;
747 }
748 else if ( *p == '}' ) {
749 Pr( "}", 0L, 0L );
750 EmitIndent--;
751 }
752 else if ( *p == '\n' ) {
753 Pr( "\n", 0L, 0L );
754 EmitIndent2 = EmitIndent;
755 }
756
757 else {
758 Pr( "%c", (Int)(*p), 0L );
759 }
760
761 }
762 va_end( ap );
763
764 }
765
766
767 /****************************************************************************
768 **
769 *F * * * * * * * * * * * * * * compile checks * * * * * * * * * * * * * * * *
770 */
771
772
773 /****************************************************************************
774 **
775 *F CompCheckBound( <obj>, <name> ) emit code to check that <obj> has a value
776 */
CompCheckBound(CVar obj,Obj name)777 static void CompCheckBound(CVar obj, Obj name)
778 {
779 if ( ! HasInfoCVar( obj, W_BOUND ) ) {
780 if ( CompCheckTypes ) {
781 Emit( "CHECK_BOUND( %c, \"%g\" );\n", obj, name );
782 }
783 SetInfoCVar( obj, W_BOUND );
784 }
785 }
786
787
788 /****************************************************************************
789 **
790 *F CompCheckFuncResult( <obj> ) . emit code to check that <obj> has a value
791 */
CompCheckFuncResult(CVar obj)792 static void CompCheckFuncResult(CVar obj)
793 {
794 if ( ! HasInfoCVar( obj, W_BOUND ) ) {
795 if ( CompCheckTypes ) {
796 Emit( "CHECK_FUNC_RESULT( %c );\n", obj );
797 }
798 SetInfoCVar( obj, W_BOUND );
799 }
800 }
801
802
803 /****************************************************************************
804 **
805 *F CompCheckIntSmall( <obj> ) emit code to check that <obj> is a small int
806 */
CompCheckIntSmall(CVar obj)807 static void CompCheckIntSmall(CVar obj)
808 {
809 if ( ! HasInfoCVar( obj, W_INT_SMALL ) ) {
810 if ( CompCheckTypes ) {
811 Emit( "CHECK_INT_SMALL( %c );\n", obj );
812 }
813 SetInfoCVar( obj, W_INT_SMALL );
814 }
815 }
816
817
818
819 /****************************************************************************
820 **
821 *F CompCheckIntSmallPos( <obj> ) emit code to check that <obj> is a position
822 */
CompCheckIntSmallPos(CVar obj)823 static void CompCheckIntSmallPos(CVar obj)
824 {
825 if ( ! HasInfoCVar( obj, W_INT_SMALL_POS ) ) {
826 if ( CompCheckTypes ) {
827 Emit( "CHECK_INT_SMALL_POS( %c );\n", obj );
828 }
829 SetInfoCVar( obj, W_INT_SMALL_POS );
830 }
831 }
832
833 /****************************************************************************
834 **
835 *F CompCheckIntPos( <obj> ) emit code to check that <obj> is a position
836 */
CompCheckIntPos(CVar obj)837 static void CompCheckIntPos(CVar obj)
838 {
839 if ( ! HasInfoCVar( obj, W_INT_POS ) ) {
840 if ( CompCheckTypes ) {
841 Emit( "CHECK_INT_POS( %c );\n", obj );
842 }
843 SetInfoCVar( obj, W_INT_POS );
844 }
845 }
846
847
848 /****************************************************************************
849 **
850 *F CompCheckBool( <obj> ) . . . emit code to check that <obj> is a boolean
851 */
CompCheckBool(CVar obj)852 static void CompCheckBool(CVar obj)
853 {
854 if ( ! HasInfoCVar( obj, W_BOOL ) ) {
855 if ( CompCheckTypes ) {
856 Emit( "CHECK_BOOL( %c );\n", obj );
857 }
858 SetInfoCVar( obj, W_BOOL );
859 }
860 }
861
862
863 /****************************************************************************
864 **
865 *F * * * * * * * * * * * * compile expressions * * * * * * * * * * * * * * *
866 */
867
868
869 /****************************************************************************
870 **
871 *F CompExpr( <expr> ) . . . . . . . . . . . . . . . . compile an expression
872 **
873 ** 'CompExpr' compiles the expression <expr> and returns the C variable that
874 ** will contain the result.
875 */
876 static CVar (*CompExprFuncs[256])(Expr expr);
877
878
CompExpr(Expr expr)879 static CVar CompExpr(Expr expr)
880 {
881 return (* CompExprFuncs[ TNUM_EXPR(expr) ])( expr );
882 }
883
884
885 /****************************************************************************
886 **
887 *F CompUnknownExpr( <expr> ) . . . . . . . . . . . . log unknown expression
888 */
CompUnknownExpr(Expr expr)889 static CVar CompUnknownExpr(Expr expr)
890 {
891 Emit( "CANNOT COMPILE EXPRESSION OF TNUM %d;\n", TNUM_EXPR(expr) );
892 return 0;
893 }
894
895
896
897 /****************************************************************************
898 **
899 *F CompBoolExpr( <expr> ) . . . . . . . compile bool expr and return C bool
900 */
901 static CVar (*CompBoolExprFuncs[256])(Expr expr);
902
CompBoolExpr(Expr expr)903 static CVar CompBoolExpr(Expr expr)
904 {
905 return (* CompBoolExprFuncs[ TNUM_EXPR(expr) ])( expr );
906 }
907
908
909 /****************************************************************************
910 **
911 *F CompUnknownBool( <expr> ) . . . . . . . . . . use 'CompExpr' and convert
912 */
CompUnknownBool(Expr expr)913 static CVar CompUnknownBool(Expr expr)
914 {
915 CVar res; /* result */
916 CVar val; /* value of expression */
917
918 /* allocate a new temporary for the result */
919 res = CVAR_TEMP( NewTemp( "res" ) );
920
921 /* compile the expression and check that the value is boolean */
922 val = CompExpr( expr );
923 CompCheckBool( val );
924
925 /* emit code to store the C boolean value in the result */
926 Emit( "%c = (Obj)(UInt)(%c != False);\n", res, val );
927
928 /* we know that the result is boolean (should be 'W_CBOOL') */
929 SetInfoCVar( res, W_BOOL );
930
931 /* free the temporary */
932 if ( IS_TEMP_CVAR( val ) ) FreeTemp( TEMP_CVAR( val ) );
933
934 /* return the result */
935 return res;
936 }
937
938 /****************************************************************************
939 **
940 *V G_Length . . . . . . . . . . . . . . . . . . . . . . . function 'Length'
941 */
942 static GVar G_Length;
943
944
945 /****************************************************************************
946 **
947 *F CompFunccall0to6Args( <expr> ) . . . EXPR_FUNCCALL_0ARGS...EXPR_FUNCCALL_6ARGS
948 */
949 static CVar CompRefGVarFopy(Expr expr);
950
951
CompFunccall0to6Args(Expr expr)952 static CVar CompFunccall0to6Args(Expr expr)
953 {
954 CVar result; /* result, result */
955 CVar func; /* function */
956 CVar args [8]; /* arguments */
957 Int narg; /* number of arguments */
958 Int i; /* loop variable */
959
960 /* special case to inline 'Length' */
961 if ( CompFastListFuncs
962 && TNUM_EXPR( FUNC_CALL(expr) ) == EXPR_REF_GVAR
963 && READ_EXPR( FUNC_CALL(expr), 0 ) == G_Length
964 && NARG_SIZE_CALL(SIZE_EXPR(expr)) == 1 ) {
965 result = CVAR_TEMP( NewTemp( "result" ) );
966 args[1] = CompExpr( ARGI_CALL(expr,1) );
967 if ( CompFastPlainLists ) {
968 Emit( "C_LEN_LIST_FPL( %c, %c )\n", result, args[1] );
969 }
970 else {
971 Emit( "C_LEN_LIST( %c, %c )\n", result, args[1] );
972 }
973 SetInfoCVar( result, W_INT_SMALL );
974 if ( IS_TEMP_CVAR( args[1] ) ) FreeTemp( TEMP_CVAR( args[1] ) );
975 return result;
976 }
977
978 /* allocate a temporary for the result */
979 result = CVAR_TEMP( NewTemp( "result" ) );
980
981 /* compile the reference to the function */
982 if ( TNUM_EXPR( FUNC_CALL(expr) ) == EXPR_REF_GVAR ) {
983 func = CompRefGVarFopy( FUNC_CALL(expr) );
984 }
985 else {
986 func = CompExpr( FUNC_CALL(expr) );
987 }
988
989 /* compile the argument expressions */
990 narg = NARG_SIZE_CALL(SIZE_EXPR(expr));
991 for ( i = 1; i <= narg; i++ ) {
992 args[i] = CompExpr( ARGI_CALL(expr,i) );
993 }
994
995 /* emit the code for the function call */
996 Emit( "if ( TNUM_OBJ( %c ) == T_FUNCTION ) {\n", func );
997 Emit( "%c = CALL_%dARGS( %c", result, narg, func );
998 for ( i = 1; i <= narg; i++ ) {
999 Emit( ", %c", args[i] );
1000 }
1001 Emit( " );\n" );
1002 Emit( "}\n" );
1003 Emit( "else {\n" );
1004 Emit( "%c = DoOperation2Args( CallFuncListOper, %c, NewPlistFromArgs(", result, func);
1005 if (narg >= 1) {
1006 Emit( " %c", args[1] );
1007 }
1008 for ( i = 2; i <= narg; i++ ) {
1009 Emit( ", %c", args[i] );
1010 }
1011 Emit( " ) );\n" );
1012 Emit( "}\n" );
1013
1014 /* emit code for the check (sets the information for the result) */
1015 CompCheckFuncResult( result );
1016
1017 /* free the temporaries */
1018 for ( i = narg; 1 <= i; i-- ) {
1019 if ( IS_TEMP_CVAR( args[i] ) ) FreeTemp( TEMP_CVAR( args[i] ) );
1020 }
1021 if ( IS_TEMP_CVAR( func ) ) FreeTemp( TEMP_CVAR( func ) );
1022
1023 /* return the result */
1024 return result;
1025 }
1026
1027
1028 /****************************************************************************
1029 **
1030 *F CompFunccallXArgs( <expr> ) . . . . . . . . . . . . . EXPR_FUNCCALL_XARGS
1031 */
CompFunccallXArgs(Expr expr)1032 static CVar CompFunccallXArgs(Expr expr)
1033 {
1034 CVar result; /* result, result */
1035 CVar func; /* function */
1036 CVar argl; /* argument list */
1037 CVar argi; /* <i>-th argument */
1038 UInt narg; /* number of arguments */
1039 UInt i; /* loop variable */
1040
1041 /* allocate a temporary for the result */
1042 result = CVAR_TEMP( NewTemp( "result" ) );
1043
1044 /* compile the reference to the function */
1045 if ( TNUM_EXPR( FUNC_CALL(expr) ) == EXPR_REF_GVAR ) {
1046 func = CompRefGVarFopy( FUNC_CALL(expr) );
1047 }
1048 else {
1049 func = CompExpr( FUNC_CALL(expr) );
1050 }
1051
1052 /* compile the argument expressions */
1053 narg = NARG_SIZE_CALL(SIZE_EXPR(expr));
1054 argl = CVAR_TEMP( NewTemp( "argl" ) );
1055 Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", argl, narg );
1056 Emit( "SET_LEN_PLIST( %c, %d );\n", argl, narg );
1057 for ( i = 1; i <= narg; i++ ) {
1058 argi = CompExpr( ARGI_CALL( expr, i ) );
1059 Emit( "SET_ELM_PLIST( %c, %d, %c );\n", argl, i, argi );
1060 if ( ! HasInfoCVar( argi, W_INT_SMALL ) ) {
1061 Emit( "CHANGED_BAG( %c );\n", argl );
1062 }
1063 if ( IS_TEMP_CVAR( argi ) ) FreeTemp( TEMP_CVAR( argi ) );
1064 }
1065
1066 /* emit the code for the function call */
1067 Emit( "if ( TNUM_OBJ( %c ) == T_FUNCTION ) {\n", func );
1068 Emit( "%c = CALL_XARGS( %c, %c );\n", result, func, argl );
1069 Emit( "}\n" );
1070 Emit( "else {\n" );
1071 Emit( "%c = DoOperation2Args( CallFuncListOper, %c, %c );\n", result, func, argl );
1072 Emit( "}\n" );
1073
1074 /* emit code for the check (sets the information for the result) */
1075 CompCheckFuncResult( result );
1076
1077 /* free the temporaries */
1078 if ( IS_TEMP_CVAR( argl ) ) FreeTemp( TEMP_CVAR( argl ) );
1079 if ( IS_TEMP_CVAR( func ) ) FreeTemp( TEMP_CVAR( func ) );
1080
1081 /* return the result */
1082 return result;
1083 }
1084
1085 /****************************************************************************
1086 **
1087 *F CompFunccallXArgs( <expr> ) . . . . . . . . . . . . . EXPR_FUNCCALL_OPTS
1088 */
CompFunccallOpts(Expr expr)1089 static CVar CompFunccallOpts(Expr expr)
1090 {
1091 CVar opts = CompExpr(READ_STAT(expr, 0));
1092 GVar pushOptions;
1093 GVar popOptions;
1094 CVar result;
1095 pushOptions = GVarName("PushOptions");
1096 popOptions = GVarName("PopOptions");
1097 CompSetUseGVar(pushOptions, COMP_USE_GVAR_FOPY);
1098 CompSetUseGVar(popOptions, COMP_USE_GVAR_FOPY);
1099 Emit("CALL_1ARGS( GF_PushOptions, %c );\n", opts);
1100 if (IS_TEMP_CVAR( opts) ) FreeTemp( TEMP_CVAR( opts ));
1101 result = CompExpr(READ_STAT(expr, 1));
1102 Emit("CALL_0ARGS( GF_PopOptions );\n");
1103 return result;
1104 }
1105
1106
1107 /****************************************************************************
1108 **
1109 *F CompFuncExpr( <expr> ) . . . . . . . . . . . . . . . . . . . . EXPR_FUNC
1110 */
CompFuncExpr(Expr expr)1111 static CVar CompFuncExpr(Expr expr)
1112 {
1113 CVar func; /* function, result */
1114 CVar tmp; /* dummy body */
1115
1116 Obj fexp; /* function expression */
1117 Int nr; /* number of the function */
1118
1119 /* get the number of the function */
1120 fexp = GET_VALUE_FROM_CURRENT_BODY(READ_EXPR(expr, 0));
1121 nr = NR_INFO( INFO_FEXP( fexp ) );
1122
1123 /* allocate a new temporary for the function */
1124 func = CVAR_TEMP( NewTemp( "func" ) );
1125
1126 /* make the function (all the pieces are in global variables) */
1127 Int narg = NARG_FUNC(fexp);
1128 Emit( "%c = NewFunction( NameFunc[%d], %d", func, nr, narg );
1129 if (narg != 0) {
1130 Obj nams = NAMS_FUNC(fexp);
1131 if (narg < 0)
1132 narg = -narg;
1133 Emit( ", ArgStringToList(\"" );
1134 Emit( "%g", ELM_PLIST(nams, 1) );
1135 for (Int i = 2; i <= narg; i++) {
1136 Emit( ",%g", ELM_PLIST(nams, i) );
1137 }
1138 Emit( "\")" );
1139 }
1140 else {
1141 Emit( ", 0" );
1142 }
1143 Emit( ", HdlrFunc%d );\n", nr );
1144
1145 /* this should probably be done by 'NewFunction' */
1146 Emit( "SET_ENVI_FUNC( %c, STATE(CurrLVars) );\n", func );
1147 tmp = CVAR_TEMP( NewTemp( "body" ) );
1148 Emit( "%c = NewFunctionBody();\n", tmp );
1149 Emit( "SET_STARTLINE_BODY(%c, %d);\n", tmp, GET_STARTLINE_BODY(BODY_FUNC(fexp)));
1150 Emit( "SET_ENDLINE_BODY(%c, %d);\n", tmp, GET_ENDLINE_BODY(BODY_FUNC(fexp)));
1151 Emit( "SET_FILENAME_BODY(%c, FileName);\n",tmp);
1152 Emit( "SET_BODY_FUNC(%c, %c);\n", func, tmp );
1153 FreeTemp( TEMP_CVAR( tmp ) );
1154
1155 /* we know that the result is a function */
1156 SetInfoCVar( func, W_FUNC );
1157
1158 /* return the number of the C variable that will hold the function */
1159 return func;
1160 }
1161
1162
1163 /****************************************************************************
1164 **
1165 *F CompOr( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . EXPR_OR
1166 */
CompOr(Expr expr)1167 static CVar CompOr(Expr expr)
1168 {
1169 CVar val; /* or, result */
1170 CVar left; /* left operand */
1171 CVar right; /* right operand */
1172 Bag only_left; /* info after evaluating only left */
1173
1174 /* allocate a new temporary for the result */
1175 val = CVAR_TEMP( NewTemp( "val" ) );
1176
1177 /* compile the left expression */
1178 left = CompBoolExpr(READ_EXPR(expr, 0));
1179 Emit( "%c = (%c ? True : False);\n", val, left );
1180 Emit( "if ( %c == False ) {\n", val );
1181 only_left = NewInfoCVars();
1182 CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC()) );
1183
1184 /* compile the right expression */
1185 right = CompBoolExpr(READ_EXPR(expr, 1));
1186 Emit( "%c = (%c ? True : False);\n", val, right );
1187 Emit( "}\n" );
1188
1189 /* we know that the result is boolean */
1190 MergeInfoCVars( INFO_FEXP(CURR_FUNC()), only_left );
1191 SetInfoCVar( val, W_BOOL );
1192
1193 /* free the temporaries */
1194 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1195 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1196
1197 /* return the result */
1198 return val;
1199 }
1200
1201
1202 /****************************************************************************
1203 **
1204 *F CompOrBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . EXPR_OR
1205 */
CompOrBool(Expr expr)1206 static CVar CompOrBool(Expr expr)
1207 {
1208 CVar val; /* or, result */
1209 CVar left; /* left operand */
1210 CVar right; /* right operand */
1211 Bag only_left; /* info after evaluating only left */
1212
1213 /* allocate a new temporary for the result */
1214 val = CVAR_TEMP( NewTemp( "val" ) );
1215
1216 /* compile the left expression */
1217 left = CompBoolExpr(READ_EXPR(expr, 0));
1218 Emit( "%c = %c;\n", val, left );
1219 Emit( "if ( ! %c ) {\n", val );
1220 only_left = NewInfoCVars();
1221 CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC()) );
1222
1223 /* compile the right expression */
1224 right = CompBoolExpr(READ_EXPR(expr, 1));
1225 Emit( "%c = %c;\n", val, right );
1226 Emit( "}\n" );
1227
1228 /* we know that the result is boolean (should be 'W_CBOOL') */
1229 MergeInfoCVars( INFO_FEXP(CURR_FUNC()), only_left );
1230 SetInfoCVar( val, W_BOOL );
1231
1232 /* free the temporaries */
1233 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1234 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1235
1236 /* return the result */
1237 return val;
1238 }
1239
1240
1241 /****************************************************************************
1242 **
1243 *F CompAnd( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_AND
1244 */
CompAnd(Expr expr)1245 static CVar CompAnd(Expr expr)
1246 {
1247 CVar val; /* result */
1248 CVar left; /* left operand */
1249 CVar right1; /* right operand 1 */
1250 CVar right2; /* right operand 2 */
1251 Bag only_left; /* info after evaluating only left */
1252
1253 /* allocate a temporary for the result */
1254 val = CVAR_TEMP( NewTemp( "val" ) );
1255
1256 /* compile the left expression */
1257 left = CompExpr(READ_EXPR(expr, 0));
1258 only_left = NewInfoCVars();
1259 CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC()) );
1260
1261 /* emit the code for the case that the left value is 'false' */
1262 Emit( "if ( %c == False ) {\n", left );
1263 Emit( "%c = %c;\n", val, left );
1264 Emit( "}\n" );
1265
1266 /* emit the code for the case that the left value is 'true' */
1267 Emit( "else if ( %c == True ) {\n", left );
1268 right1 = CompExpr(READ_EXPR(expr, 1));
1269 CompCheckBool( right1 );
1270 Emit( "%c = %c;\n", val, right1 );
1271 Emit( "}\n" );
1272
1273 /* emit the code for the case that the left value is a filter */
1274 Emit( "else if (IS_FILTER( %c ) ) {\n", left );
1275 right2 = CompExpr(READ_EXPR(expr, 1));
1276 Emit( "%c = NewAndFilter( %c, %c );\n", val, left, right2 );
1277 Emit( "}\n" );
1278
1279 /* signal an error */
1280 Emit( "else {\n" );
1281 Emit( "RequireArgumentEx(0, %c, \"<expr>\",\n"
1282 "\"must be 'true' or 'false' or a filter\" );\n", left );
1283 Emit( "}\n" );
1284
1285 /* we know precious little about the result */
1286 MergeInfoCVars( INFO_FEXP(CURR_FUNC()), only_left );
1287 SetInfoCVar( val, W_BOUND );
1288
1289 /* free the temporaries */
1290 if ( IS_TEMP_CVAR( right2 ) ) FreeTemp( TEMP_CVAR( right2 ) );
1291 if ( IS_TEMP_CVAR( right1 ) ) FreeTemp( TEMP_CVAR( right1 ) );
1292 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1293
1294 /* return the result */
1295 return val;
1296 }
1297
1298
1299 /****************************************************************************
1300 **
1301 *F CompAndBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . EXPR_AND
1302 */
CompAndBool(Expr expr)1303 static CVar CompAndBool(Expr expr)
1304 {
1305 CVar val; /* or, result */
1306 CVar left; /* left operand */
1307 CVar right; /* right operand */
1308 Bag only_left; /* info after evaluating only left */
1309
1310 /* allocate a new temporary for the result */
1311 val = CVAR_TEMP( NewTemp( "val" ) );
1312
1313 /* compile the left expression */
1314 left = CompBoolExpr(READ_EXPR(expr, 0));
1315 Emit( "%c = %c;\n", val, left );
1316 Emit( "if ( %c ) {\n", val );
1317 only_left = NewInfoCVars();
1318 CopyInfoCVars( only_left, INFO_FEXP(CURR_FUNC()) );
1319
1320 /* compile the right expression */
1321 right = CompBoolExpr(READ_EXPR(expr, 1));
1322 Emit( "%c = %c;\n", val, right );
1323 Emit( "}\n" );
1324
1325 /* we know that the result is boolean (should be 'W_CBOOL') */
1326 MergeInfoCVars( INFO_FEXP(CURR_FUNC()), only_left );
1327 SetInfoCVar( val, W_BOOL );
1328
1329 /* free the temporaries */
1330 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1331 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1332
1333 /* return the result */
1334 return val;
1335 }
1336
1337
1338 /****************************************************************************
1339 **
1340 *F CompNot( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_NOT
1341 */
CompNot(Expr expr)1342 static CVar CompNot(Expr expr)
1343 {
1344 CVar val; /* result */
1345 CVar left; /* operand */
1346
1347 /* allocate a new temporary for the result */
1348 val = CVAR_TEMP( NewTemp( "val" ) );
1349
1350 /* compile the operand */
1351 left = CompBoolExpr(READ_EXPR(expr, 0));
1352
1353 /* invert the operand */
1354 Emit( "%c = (%c ? False : True);\n", val, left );
1355
1356 /* we know that the result is boolean */
1357 SetInfoCVar( val, W_BOOL );
1358
1359 /* free the temporaries */
1360 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1361
1362 /* return the result */
1363 return val;
1364 }
1365
1366
1367 /****************************************************************************
1368 **
1369 *F CompNotBoot( <expr> ) . . . . . . . . . . . . . . . . . . . . . EXPR_NOT
1370 */
CompNotBool(Expr expr)1371 static CVar CompNotBool(Expr expr)
1372 {
1373 CVar val; /* result */
1374 CVar left; /* operand */
1375
1376 /* allocate a new temporary for the result */
1377 val = CVAR_TEMP( NewTemp( "val" ) );
1378
1379 /* compile the operand */
1380 left = CompBoolExpr(READ_EXPR(expr, 0));
1381
1382 /* invert the operand */
1383 Emit( "%c = (Obj)(UInt)( ! ((Int)%c) );\n", val, left );
1384
1385 /* we know that the result is boolean */
1386 SetInfoCVar( val, W_BOOL );
1387
1388 /* free the temporaries */
1389 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1390
1391 /* return the result */
1392 return val;
1393 }
1394
1395
1396 /****************************************************************************
1397 **
1398 *F CompEq( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . EXPR_EQ
1399 */
CompEq(Expr expr)1400 static CVar CompEq(Expr expr)
1401 {
1402 CVar val; /* result */
1403 CVar left; /* left operand */
1404 CVar right; /* right operand */
1405
1406 /* allocate a new temporary for the result */
1407 val = CVAR_TEMP( NewTemp( "val" ) );
1408
1409 /* compile the two operands */
1410 left = CompExpr( READ_EXPR(expr, 0) );
1411 right = CompExpr( READ_EXPR(expr, 1) );
1412
1413 /* emit the code */
1414 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1415 Emit("%c = ((((Int)%c) == ((Int)%c)) ? True : False);\n", val, left, right);
1416 }
1417 else {
1418 Emit( "%c = (EQ( %c, %c ) ? True : False);\n", val, left, right );
1419 }
1420
1421 /* we know that the result is boolean */
1422 SetInfoCVar( val, W_BOOL );
1423
1424 /* free the temporaries */
1425 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1426 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1427
1428 /* return the result */
1429 return val;
1430 }
1431
1432
1433 /****************************************************************************
1434 **
1435 *F CompEqBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . EXPR_EQ
1436 */
CompEqBool(Expr expr)1437 static CVar CompEqBool(Expr expr)
1438 {
1439 CVar val; /* result */
1440 CVar left; /* left operand */
1441 CVar right; /* right operand */
1442
1443 /* allocate a new temporary for the result */
1444 val = CVAR_TEMP( NewTemp( "val" ) );
1445
1446 /* compile the two operands */
1447 left = CompExpr( READ_EXPR(expr, 0) );
1448 right = CompExpr( READ_EXPR(expr, 1) );
1449
1450 /* emit the code */
1451 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1452 Emit( "%c = (Obj)(UInt)(((Int)%c) == ((Int)%c));\n", val, left, right);
1453 }
1454 else {
1455 Emit( "%c = (Obj)(UInt)(EQ( %c, %c ));\n", val, left, right );
1456 }
1457
1458 /* we know that the result is boolean (should be 'W_CBOOL') */
1459 SetInfoCVar( val, W_BOOL );
1460
1461 /* free the temporaries */
1462 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1463 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1464
1465 /* return the result */
1466 return val;
1467 }
1468
1469
1470 /****************************************************************************
1471 **
1472 *F CompNe( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_NE
1473 */
CompNe(Expr expr)1474 static CVar CompNe(Expr expr)
1475 {
1476 CVar val; /* result */
1477 CVar left; /* left operand */
1478 CVar right; /* right operand */
1479
1480 /* allocate a new temporary for the result */
1481 val = CVAR_TEMP( NewTemp( "val" ) );
1482
1483 /* compile the two operands */
1484 left = CompExpr( READ_EXPR(expr, 0) );
1485 right = CompExpr( READ_EXPR(expr, 1) );
1486
1487 /* emit the code */
1488 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1489 Emit("%c = ((((Int)%c) == ((Int)%c)) ? False : True);\n", val, left, right);
1490 }
1491 else {
1492 Emit( "%c = (EQ( %c, %c ) ? False : True);\n", val, left, right );
1493 }
1494
1495 /* we know that the result is boolean */
1496 SetInfoCVar( val, W_BOOL );
1497
1498 /* free the temporaries */
1499 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1500 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1501
1502 /* return the result */
1503 return val;
1504 }
1505
1506
1507 /****************************************************************************
1508 **
1509 *F CompNeBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_NE
1510 */
CompNeBool(Expr expr)1511 static CVar CompNeBool(Expr expr)
1512 {
1513 CVar val; /* result */
1514 CVar left; /* left operand */
1515 CVar right; /* right operand */
1516
1517 /* allocate a new temporary for the result */
1518 val = CVAR_TEMP( NewTemp( "val" ) );
1519
1520 /* compile the two operands */
1521 left = CompExpr( READ_EXPR(expr, 0) );
1522 right = CompExpr( READ_EXPR(expr, 1) );
1523
1524 /* emit the code */
1525 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1526 Emit( "%c = (Obj)(UInt)(((Int)%c) != ((Int)%c));\n", val, left, right );
1527 }
1528 else {
1529 Emit( "%c = (Obj)(UInt)( ! EQ( %c, %c ));\n", val, left, right );
1530 }
1531
1532 /* we know that the result is boolean (should be 'W_CBOOL') */
1533 SetInfoCVar( val, W_BOOL );
1534
1535 /* free the temporaries */
1536 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1537 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1538
1539 /* return the result */
1540 return val;
1541 }
1542
1543
1544 /****************************************************************************
1545 **
1546 *F CompLt( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_LT
1547 */
CompLt(Expr expr)1548 static CVar CompLt(Expr expr)
1549 {
1550 CVar val; /* result */
1551 CVar left; /* left operand */
1552 CVar right; /* right operand */
1553
1554 /* allocate a new temporary for the result */
1555 val = CVAR_TEMP( NewTemp( "val" ) );
1556
1557 /* compile the two operands */
1558 left = CompExpr( READ_EXPR(expr, 0) );
1559 right = CompExpr( READ_EXPR(expr, 1) );
1560
1561 /* emit the code */
1562 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1563 Emit( "%c = ((((Int)%c) < ((Int)%c)) ? True : False);\n", val, left, right );
1564 }
1565 else {
1566 Emit( "%c = (LT( %c, %c ) ? True : False);\n", val, left, right );
1567 }
1568
1569 /* we know that the result is boolean */
1570 SetInfoCVar( val, W_BOOL );
1571
1572 /* free the temporaries */
1573 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1574 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1575
1576 /* return the result */
1577 return val;
1578 }
1579
1580
1581 /****************************************************************************
1582 **
1583 *F CompLtBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_LT
1584 */
CompLtBool(Expr expr)1585 static CVar CompLtBool(Expr expr)
1586 {
1587 CVar val; /* result */
1588 CVar left; /* left operand */
1589 CVar right; /* right operand */
1590
1591 /* allocate a new temporary for the result */
1592 val = CVAR_TEMP( NewTemp( "val" ) );
1593
1594 /* compile the two operands */
1595 left = CompExpr( READ_EXPR(expr, 0) );
1596 right = CompExpr( READ_EXPR(expr, 1) );
1597
1598 /* emit the code */
1599 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1600 Emit( "%c = (Obj)(UInt)(((Int)%c) < ((Int)%c));\n", val, left, right );
1601 }
1602 else {
1603 Emit( "%c = (Obj)(UInt)(LT( %c, %c ));\n", val, left, right );
1604 }
1605
1606 /* we know that the result is boolean (should be 'W_CBOOL') */
1607 SetInfoCVar( val, W_BOOL );
1608
1609 /* free the temporaries */
1610 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1611 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1612
1613 /* return the result */
1614 return val;
1615 }
1616
1617
1618 /****************************************************************************
1619 **
1620 *F CompGe( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_GE
1621 */
CompGe(Expr expr)1622 static CVar CompGe(Expr expr)
1623 {
1624 CVar val; /* result */
1625 CVar left; /* left operand */
1626 CVar right; /* right operand */
1627
1628 /* allocate a new temporary for the result */
1629 val = CVAR_TEMP( NewTemp( "val" ) );
1630
1631 /* compile the two operands */
1632 left = CompExpr( READ_EXPR(expr, 0) );
1633 right = CompExpr( READ_EXPR(expr, 1) );
1634
1635 /* emit the code */
1636 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1637 Emit("%c = ((((Int)%c) < ((Int)%c)) ? False : True);\n", val, left, right);
1638 }
1639 else {
1640 Emit( "%c = (LT( %c, %c ) ? False : True);\n", val, left, right );
1641 }
1642
1643 /* we know that the result is boolean */
1644 SetInfoCVar( val, W_BOOL );
1645
1646 /* free the temporaries */
1647 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1648 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1649
1650 /* return the result */
1651 return val;
1652 }
1653
1654
1655 /****************************************************************************
1656 **
1657 *F CompGeBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_GE
1658 */
CompGeBool(Expr expr)1659 static CVar CompGeBool(Expr expr)
1660 {
1661 CVar val; /* result */
1662 CVar left; /* left operand */
1663 CVar right; /* right operand */
1664
1665 /* allocate a new temporary for the result */
1666 val = CVAR_TEMP( NewTemp( "val" ) );
1667
1668 /* compile the two operands */
1669 left = CompExpr( READ_EXPR(expr, 0) );
1670 right = CompExpr( READ_EXPR(expr, 1) );
1671
1672 /* emit the code */
1673 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1674 Emit( "%c = (Obj)(UInt)(((Int)%c) >= ((Int)%c));\n", val, left, right );
1675 }
1676 else {
1677 Emit( "%c = (Obj)(UInt)(! LT( %c, %c ));\n", val, left, right );
1678 }
1679
1680 /* we know that the result is boolean (should be 'W_CBOOL') */
1681 SetInfoCVar( val, W_BOOL );
1682
1683 /* free the temporaries */
1684 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1685 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1686
1687 /* return the result */
1688 return val;
1689 }
1690
1691
1692 /****************************************************************************
1693 **
1694 *F CompGt( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_GT
1695 */
CompGt(Expr expr)1696 static CVar CompGt(Expr expr)
1697 {
1698 CVar val; /* result */
1699 CVar left; /* left operand */
1700 CVar right; /* right operand */
1701
1702 /* allocate a new temporary for the result */
1703 val = CVAR_TEMP( NewTemp( "val" ) );
1704
1705 /* compile the two operands */
1706 left = CompExpr( READ_EXPR(expr, 0) );
1707 right = CompExpr( READ_EXPR(expr, 1) );
1708
1709 /* emit the code */
1710 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1711 Emit("%c = ((((Int)%c) < ((Int)%c)) ? True : False);\n", val, right, left);
1712 }
1713 else {
1714 Emit( "%c = (LT( %c, %c ) ? True : False);\n", val, right, left );
1715 }
1716
1717 /* we know that the result is boolean */
1718 SetInfoCVar( val, W_BOOL );
1719
1720 /* free the temporaries */
1721 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1722 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1723
1724 /* return the result */
1725 return val;
1726 }
1727
1728
1729 /****************************************************************************
1730 **
1731 *F CompGtBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_GT
1732 */
CompGtBool(Expr expr)1733 static CVar CompGtBool(Expr expr)
1734 {
1735 CVar val; /* result */
1736 CVar left; /* left operand */
1737 CVar right; /* right operand */
1738
1739 /* allocate a new temporary for the result */
1740 val = CVAR_TEMP( NewTemp( "val" ) );
1741
1742 /* compile the two operands */
1743 left = CompExpr( READ_EXPR(expr, 0) );
1744 right = CompExpr( READ_EXPR(expr, 1) );
1745
1746 /* emit the code */
1747 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1748 Emit( "%c = (Obj)(UInt)(((Int)%c) < ((Int)%c));\n", val, right, left );
1749 }
1750 else {
1751 Emit( "%c = (Obj)(UInt)(LT( %c, %c ));\n", val, right, left );
1752 }
1753
1754 /* we know that the result is boolean (should be 'W_CBOOL') */
1755 SetInfoCVar( val, W_BOOL );
1756
1757 /* free the temporaries */
1758 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1759 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1760
1761 /* return the result */
1762 return val;
1763 }
1764
1765
1766 /****************************************************************************
1767 **
1768 *F CompLe( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_LE
1769 */
CompLe(Expr expr)1770 static CVar CompLe(Expr expr)
1771 {
1772 CVar val; /* result */
1773 CVar left; /* left operand */
1774 CVar right; /* right operand */
1775
1776 /* allocate a new temporary for the result */
1777 val = CVAR_TEMP( NewTemp( "val" ) );
1778
1779 /* compile the two operands */
1780 left = CompExpr( READ_EXPR(expr, 0) );
1781 right = CompExpr( READ_EXPR(expr, 1) );
1782
1783 /* emit the code */
1784 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1785 Emit("%c = ((((Int)%c) < ((Int)%c)) ? False : True);\n", val, right, left);
1786 }
1787 else {
1788 Emit( "%c = (LT( %c, %c ) ? False : True);\n", val, right, left );
1789 }
1790
1791 /* we know that the result is boolean */
1792 SetInfoCVar( val, W_BOOL );
1793
1794 /* free the temporaries */
1795 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1796 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1797
1798 /* return the result */
1799 return val;
1800 }
1801
1802
1803 /****************************************************************************
1804 **
1805 *F CompLeBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_LE
1806 */
CompLeBool(Expr expr)1807 static CVar CompLeBool(Expr expr)
1808 {
1809 CVar val; /* result */
1810 CVar left; /* left operand */
1811 CVar right; /* right operand */
1812
1813 /* allocate a new temporary for the result */
1814 val = CVAR_TEMP( NewTemp( "val" ) );
1815
1816 /* compile the two operands */
1817 left = CompExpr( READ_EXPR(expr, 0) );
1818 right = CompExpr( READ_EXPR(expr, 1) );
1819
1820 /* emit the code */
1821 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1822 Emit( "%c = (Obj)(UInt)(((Int)%c) >= ((Int)%c));\n", val, right, left );
1823 }
1824 else {
1825 Emit( "%c = (Obj)(UInt)(! LT( %c, %c ));\n", val, right, left );
1826 }
1827
1828 /* we know that the result is boolean (should be 'W_CBOOL') */
1829 SetInfoCVar( val, W_BOOL );
1830
1831 /* free the temporaries */
1832 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1833 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1834
1835 /* return the result */
1836 return val;
1837 }
1838
1839
1840 /****************************************************************************
1841 **
1842 *F CompIn( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_IN
1843 */
CompIn(Expr expr)1844 static CVar CompIn(Expr expr)
1845 {
1846 CVar val; /* result */
1847 CVar left; /* left operand */
1848 CVar right; /* right operand */
1849
1850 /* allocate a new temporary for the result */
1851 val = CVAR_TEMP( NewTemp( "val" ) );
1852
1853 /* compile the two operands */
1854 left = CompExpr( READ_EXPR(expr, 0) );
1855 right = CompExpr( READ_EXPR(expr, 1) );
1856
1857 /* emit the code */
1858 Emit( "%c = (IN( %c, %c ) ? True : False);\n", val, left, right );
1859
1860 /* we know that the result is boolean */
1861 SetInfoCVar( val, W_BOOL );
1862
1863 /* free the temporaries */
1864 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1865 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1866
1867 /* return the result */
1868 return val;
1869 }
1870
1871
1872 /****************************************************************************
1873 **
1874 *F CompInBool( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_IN
1875 */
CompInBool(Expr expr)1876 static CVar CompInBool(Expr expr)
1877 {
1878 CVar val; /* result */
1879 CVar left; /* left operand */
1880 CVar right; /* right operand */
1881
1882 /* allocate a new temporary for the result */
1883 val = CVAR_TEMP( NewTemp( "val" ) );
1884
1885 /* compile the two operands */
1886 left = CompExpr( READ_EXPR(expr, 0) );
1887 right = CompExpr( READ_EXPR(expr, 1) );
1888
1889 /* emit the code */
1890 Emit( "%c = (Obj)(UInt)(IN( %c, %c ));\n", val, left, right );
1891
1892 /* we know that the result is boolean (should be 'W_CBOOL') */
1893 SetInfoCVar( val, W_BOOL );
1894
1895 /* free the temporaries */
1896 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1897 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1898
1899 /* return the result */
1900 return val;
1901 }
1902
1903
1904 /****************************************************************************
1905 **
1906 *F CompSum( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_SUM
1907 */
CompSum(Expr expr)1908 static CVar CompSum(Expr expr)
1909 {
1910 CVar val; /* result */
1911 CVar left; /* left operand */
1912 CVar right; /* right operand */
1913
1914 /* allocate a new temporary for the result */
1915 val = CVAR_TEMP( NewTemp( "val" ) );
1916
1917 /* compile the two operands */
1918 left = CompExpr( READ_EXPR(expr, 0) );
1919 right = CompExpr( READ_EXPR(expr, 1) );
1920
1921 /* emit the code */
1922 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
1923 Emit( "C_SUM_INTOBJS( %c, %c, %c )\n", val, left, right );
1924 }
1925 else if ( CompFastIntArith ) {
1926 Emit( "C_SUM_FIA( %c, %c, %c )\n", val, left, right );
1927 }
1928 else {
1929 Emit( "C_SUM( %c, %c, %c )\n", val, left, right );
1930 }
1931
1932 /* set the information for the result */
1933 if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
1934 SetInfoCVar( val, W_INT );
1935 }
1936 else {
1937 SetInfoCVar( val, W_BOUND );
1938 }
1939
1940 /* free the temporaries */
1941 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
1942 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1943
1944 /* return the result */
1945 return val;
1946 }
1947
1948
1949 /****************************************************************************
1950 **
1951 *F CompAInv( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_AINV
1952 */
CompAInv(Expr expr)1953 static CVar CompAInv(Expr expr)
1954 {
1955 CVar val; /* result */
1956 CVar left; /* left operand */
1957
1958 /* allocate a new temporary for the result */
1959 val = CVAR_TEMP( NewTemp( "val" ) );
1960
1961 /* compile the operands */
1962 left = CompExpr(READ_EXPR(expr, 0));
1963
1964 /* emit the code */
1965 if ( HasInfoCVar(left,W_INT_SMALL) ) {
1966 Emit( "C_AINV_INTOBJS( %c, %c )\n", val, left );
1967 }
1968 else if ( CompFastIntArith ) {
1969 Emit( "C_AINV_FIA( %c, %c )\n", val, left );
1970 }
1971 else {
1972 Emit( "C_AINV( %c, %c )\n", val, left );
1973 }
1974
1975 /* set the information for the result */
1976 if ( HasInfoCVar(left,W_INT) ) {
1977 SetInfoCVar( val, W_INT );
1978 }
1979 else {
1980 SetInfoCVar( val, W_BOUND );
1981 }
1982
1983 /* free the temporaries */
1984 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
1985
1986 /* return the result */
1987 return val;
1988 }
1989
1990
1991 /****************************************************************************
1992 **
1993 *F CompDiff( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_DIFF
1994 */
CompDiff(Expr expr)1995 static CVar CompDiff(Expr expr)
1996 {
1997 CVar val; /* result */
1998 CVar left; /* left operand */
1999 CVar right; /* right operand */
2000
2001 /* allocate a new temporary for the result */
2002 val = CVAR_TEMP( NewTemp( "val" ) );
2003
2004 /* compile the two operands */
2005 left = CompExpr( READ_EXPR(expr, 0) );
2006 right = CompExpr( READ_EXPR(expr, 1) );
2007
2008 /* emit the code */
2009 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
2010 Emit( "C_DIFF_INTOBJS( %c, %c, %c )\n", val, left, right );
2011 }
2012 else if ( CompFastIntArith ) {
2013 Emit( "C_DIFF_FIA( %c, %c, %c )\n", val, left, right );
2014 }
2015 else {
2016 Emit( "C_DIFF( %c, %c, %c )\n", val, left, right );
2017 }
2018
2019 /* set the information for the result */
2020 if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
2021 SetInfoCVar( val, W_INT );
2022 }
2023 else {
2024 SetInfoCVar( val, W_BOUND );
2025 }
2026
2027 /* free the temporaries */
2028 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
2029 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
2030
2031 /* return the result */
2032 return val;
2033 }
2034
2035
2036 /****************************************************************************
2037 **
2038 *F CompProd( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . EXPR_PROD
2039 */
CompProd(Expr expr)2040 static CVar CompProd(Expr expr)
2041 {
2042 CVar val; /* result */
2043 CVar left; /* left operand */
2044 CVar right; /* right operand */
2045
2046 /* allocate a new temporary for the result */
2047 val = CVAR_TEMP( NewTemp( "val" ) );
2048
2049 /* compile the two operands */
2050 left = CompExpr( READ_EXPR(expr, 0) );
2051 right = CompExpr( READ_EXPR(expr, 1) );
2052
2053 /* emit the code */
2054 if ( HasInfoCVar(left,W_INT_SMALL) && HasInfoCVar(right,W_INT_SMALL) ) {
2055 Emit( "C_PROD_INTOBJS( %c, %c, %c )\n", val, left, right );
2056 }
2057 else if ( CompFastIntArith ) {
2058 Emit( "C_PROD_FIA( %c, %c, %c )\n", val, left, right );
2059 }
2060 else {
2061 Emit( "C_PROD( %c, %c, %c )\n", val, left, right );
2062 }
2063
2064 /* set the information for the result */
2065 if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
2066 SetInfoCVar( val, W_INT );
2067 }
2068 else {
2069 SetInfoCVar( val, W_BOUND );
2070 }
2071
2072 /* free the temporaries */
2073 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
2074 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
2075
2076 /* return the result */
2077 return val;
2078 }
2079
2080
2081 /****************************************************************************
2082 **
2083 *F CompQuo( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_QUO
2084 */
CompQuo(Expr expr)2085 static CVar CompQuo(Expr expr)
2086 {
2087 CVar val; /* result */
2088 CVar left; /* left operand */
2089 CVar right; /* right operand */
2090
2091 /* allocate a new temporary for the result */
2092 val = CVAR_TEMP( NewTemp( "val" ) );
2093
2094 /* compile the two operands */
2095 left = CompExpr( READ_EXPR(expr, 0) );
2096 right = CompExpr( READ_EXPR(expr, 1) );
2097
2098 /* emit the code */
2099 Emit( "%c = QUO( %c, %c );\n", val, left, right );
2100
2101 /* set the information for the result */
2102 SetInfoCVar( val, W_BOUND );
2103
2104 /* free the temporaries */
2105 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
2106 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
2107
2108 /* return the result */
2109 return val;
2110 }
2111
2112
2113 /****************************************************************************
2114 **
2115 *F CompMod( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_MOD
2116 */
CompMod(Expr expr)2117 static CVar CompMod(Expr expr)
2118 {
2119 CVar val; /* result */
2120 CVar left; /* left operand */
2121 CVar right; /* right operand */
2122
2123 /* allocate a new temporary for the result */
2124 val = CVAR_TEMP( NewTemp( "val" ) );
2125
2126 /* compile the two operands */
2127 left = CompExpr( READ_EXPR(expr, 0) );
2128 right = CompExpr( READ_EXPR(expr, 1) );
2129
2130 /* emit the code */
2131 Emit( "%c = MOD( %c, %c );\n", val, left, right );
2132
2133 /* set the information for the result */
2134 if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
2135 SetInfoCVar( val, W_INT );
2136 }
2137 else {
2138 SetInfoCVar( val, W_BOUND );
2139 }
2140
2141 /* free the temporaries */
2142 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
2143 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
2144
2145 /* return the result */
2146 return val;
2147 }
2148
2149
2150 /****************************************************************************
2151 **
2152 *F CompPow( <expr> ) . . . . . . . . . . . . . . . . . . . . . . . . . EXPR_POW
2153 */
CompPow(Expr expr)2154 static CVar CompPow(Expr expr)
2155 {
2156 CVar val; /* result */
2157 CVar left; /* left operand */
2158 CVar right; /* right operand */
2159
2160 /* allocate a new temporary for the result */
2161 val = CVAR_TEMP( NewTemp( "val" ) );
2162
2163 /* compile the two operands */
2164 left = CompExpr( READ_EXPR(expr, 0) );
2165 right = CompExpr( READ_EXPR(expr, 1) );
2166
2167 /* emit the code */
2168 Emit( "%c = POW( %c, %c );\n", val, left, right );
2169
2170 /* set the information for the result */
2171 if ( HasInfoCVar(left,W_INT) && HasInfoCVar(right,W_INT) ) {
2172 SetInfoCVar( val, W_INT );
2173 }
2174 else {
2175 SetInfoCVar( val, W_BOUND );
2176 }
2177
2178 /* free the temporaries */
2179 if ( IS_TEMP_CVAR( right ) ) FreeTemp( TEMP_CVAR( right ) );
2180 if ( IS_TEMP_CVAR( left ) ) FreeTemp( TEMP_CVAR( left ) );
2181
2182 /* return the result */
2183 return val;
2184 }
2185
2186
2187 /****************************************************************************
2188 **
2189 *F CompIntExpr( <expr> ) . . . . . . . . . . . . . . . EXPR_INT/EXPR_INTPOS
2190 **
2191 ** This is complicated by the need to produce code that will compile
2192 ** correctly in 32 or 64 bit and with or without GMP.
2193 **
2194 ** The problem is that when we compile the code, we know the integer
2195 ** representation of the stored literal in the compiling process but NOT the
2196 ** representation which will apply to the compiled code or the endianness
2197 **
2198 ** The solution to this is macros: C_SET_LIMB4(bag, limbnumber, value)
2199 ** C_SET_LIMB8(bag, limbnumber, value)
2200 **
2201 ** we compile using the one appropriate for the compiling system, but their
2202 ** definition depends on the limb size of the target system.
2203 **
2204 */
C_SET_LIMB4(Obj bag,UInt limbnumber,UInt4 value)2205 void C_SET_LIMB4(Obj bag, UInt limbnumber, UInt4 value)
2206 {
2207 #ifdef SYS_IS_64_BIT
2208 UInt8 * p;
2209 if (limbnumber % 2) {
2210 p = ((UInt8 *)ADDR_OBJ(bag)) + (limbnumber - 1) / 2;
2211 *p = (*p & 0xFFFFFFFFUL) | ((UInt8)value << 32);
2212 }
2213 else {
2214 p = ((UInt8 *)ADDR_OBJ(bag)) + limbnumber / 2;
2215 *p = (*p & 0xFFFFFFFF00000000UL) | (UInt8)value;
2216 }
2217 #else
2218 ((UInt4 *)ADDR_OBJ(bag))[limbnumber] = value;
2219 #endif
2220 }
2221
2222
C_SET_LIMB8(Obj bag,UInt limbnumber,UInt8 value)2223 void C_SET_LIMB8(Obj bag, UInt limbnumber, UInt8 value)
2224 {
2225 #ifdef SYS_IS_64_BIT
2226 ((UInt8 *)ADDR_OBJ(bag))[limbnumber] = value;
2227 #else
2228 ((UInt4 *)ADDR_OBJ(bag))[2 * limbnumber] = (UInt4)(value & 0xFFFFFFFFUL);
2229 ((UInt4 *)ADDR_OBJ(bag))[2 * limbnumber + 1] = (UInt4)(value >> 32);
2230 #endif
2231 }
2232
2233
CompIntExpr(Expr expr)2234 static CVar CompIntExpr(Expr expr)
2235 {
2236 CVar val;
2237 Int siz;
2238 Int i;
2239 UInt typ;
2240
2241 if ( IS_INTEXPR(expr) ) {
2242 return CVAR_INTG( INT_INTEXPR(expr) );
2243 }
2244 else {
2245 // get the actual integer
2246 Obj obj = EVAL_EXPR(expr);
2247
2248 val = CVAR_TEMP( NewTemp( "val" ) );
2249 siz = SIZE_OBJ(obj);
2250 typ = TNUM_OBJ(obj);
2251 if ( typ == T_INTPOS ) {
2252 Emit( "%c = NewWordSizedBag(T_INTPOS, %d);\n", val, siz);
2253 SetInfoCVar(val, W_INT_POS);
2254 }
2255 else {
2256 GAP_ASSERT(typ == T_INTNEG);
2257 Emit( "%c = NewWordSizedBag(T_INTNEG, %d);\n", val, siz);
2258 SetInfoCVar(val, W_INT);
2259 }
2260
2261 for ( i = 0; i < siz/sizeof(UInt); i++ ) {
2262 UInt limb = CONST_ADDR_INT(obj)[i];
2263 #ifdef SYS_IS_64_BIT
2264 Emit("C_SET_LIMB8( %c, %d, %dLL);\n", val, i, limb);
2265 #else
2266 Emit("C_SET_LIMB4( %c, %d, %dL);\n", val, i, limb);
2267 #endif
2268 }
2269 if (siz <= 8) {
2270 Emit("#ifdef SYS_IS_64_BIT");
2271 Emit("%c = C_NORMALIZE_64BIT(%c);\n", val,val);
2272 Emit("#endif");
2273 }
2274 return val;
2275 }
2276 }
2277
2278 /****************************************************************************
2279 **
2280 *F CompTildeExpr( <expr> ) . . . . . . . . . . . . . . . . . . EXPR_TILDE
2281 */
CompTildeExpr(Expr expr)2282 static CVar CompTildeExpr(Expr expr)
2283 {
2284 Emit( "if ( ! STATE(Tilde) ) {\n");
2285 Emit( " ErrorMayQuit(\"'~' does not have a value here\",0L,0L);\n" );
2286 Emit( "}\n" );
2287 CVar val; /* value, result */
2288
2289 /* allocate a new temporary for the 'true' value */
2290 val = CVAR_TEMP( NewTemp( "val" ) );
2291
2292 /* emit the code */
2293 Emit( "%c = STATE(Tilde);\n", val );
2294
2295 /* return '~' */
2296 return val;
2297 }
2298
2299 /****************************************************************************
2300 **
2301 *F CompTrueExpr( <expr> ) . . . . . . . . . . . . . . . . . . . EXPR_TRUE
2302 */
CompTrueExpr(Expr expr)2303 static CVar CompTrueExpr(Expr expr)
2304 {
2305 CVar val; /* value, result */
2306
2307 /* allocate a new temporary for the 'true' value */
2308 val = CVAR_TEMP( NewTemp( "val" ) );
2309
2310 /* emit the code */
2311 Emit( "%c = True;\n", val );
2312
2313 /* we know that the result is boolean ;-) */
2314 SetInfoCVar( val, W_BOOL );
2315
2316 /* return 'true' */
2317 return val;
2318 }
2319
2320
2321 /****************************************************************************
2322 **
2323 *F CompFalseExpr( <expr> ) . . . . . . . . . . . . . . . . . . EXPR_FALSE
2324 */
CompFalseExpr(Expr expr)2325 static CVar CompFalseExpr(Expr expr)
2326 {
2327 CVar val; /* value, result */
2328
2329 /* allocate a new temporary for the 'false' value */
2330 val = CVAR_TEMP( NewTemp( "val" ) );
2331
2332 /* emit the code */
2333 Emit( "%c = False;\n", val );
2334
2335 /* we know that the result is boolean ;-) */
2336 SetInfoCVar( val, W_BOOL );
2337
2338 /* return 'false' */
2339 return val;
2340 }
2341
2342
2343 /****************************************************************************
2344 **
2345 *F CompCharExpr( <expr> ) . . . . . . . . . . . . . . . . . . . EXPR_CHAR
2346 */
CompCharExpr(Expr expr)2347 static CVar CompCharExpr(Expr expr)
2348 {
2349 CVar val; /* result */
2350
2351 /* allocate a new temporary for the char value */
2352 val = CVAR_TEMP( NewTemp( "val" ) );
2353
2354 /* emit the code */
2355 Emit( "%c = ObjsChar[%d];\n", val, READ_EXPR(expr, 0));
2356
2357 /* we know that we have a value */
2358 SetInfoCVar( val, W_BOUND );
2359
2360 /* return the value */
2361 return val;
2362 }
2363
2364
2365 /****************************************************************************
2366 **
2367 *F CompPermExpr( <expr> ) . . . . . . . . . . . . . . . . . . . EXPR_PERM
2368 */
CompPermExpr(Expr expr)2369 static CVar CompPermExpr(Expr expr)
2370 {
2371 CVar perm; /* result */
2372 CVar lcyc; /* one cycle as list */
2373 CVar lprm; /* perm as list of list cycles */
2374 CVar val; /* one point */
2375 Int i;
2376 Int j;
2377 Int n;
2378 Int csize;
2379 Expr cycle;
2380
2381 /* check for the identity */
2382 if ( SIZE_EXPR(expr) == 0 ) {
2383 perm = CVAR_TEMP( NewTemp( "idperm" ) );
2384 Emit( "%c = IdentityPerm;\n", perm );
2385 SetInfoCVar( perm, W_BOUND );
2386 return perm;
2387 }
2388
2389 /* for each cycle create a list */
2390 perm = CVAR_TEMP( NewTemp( "perm" ) );
2391 lcyc = CVAR_TEMP( NewTemp( "lcyc" ) );
2392 lprm = CVAR_TEMP( NewTemp( "lprm" ) );
2393
2394 /* start with the identity permutation */
2395 Emit( "%c = IdentityPerm;\n", perm );
2396
2397 /* loop over the cycles */
2398 n = SIZE_EXPR(expr)/sizeof(Expr);
2399 Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", lprm, n );
2400 Emit( "SET_LEN_PLIST( %c, %d );\n", lprm, n );
2401
2402 for ( i = 1; i <= n; i++ ) {
2403 cycle = READ_EXPR(expr, i - 1);
2404 csize = SIZE_EXPR(cycle)/sizeof(Expr);
2405 Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", lcyc, csize );
2406 Emit( "SET_LEN_PLIST( %c, %d );\n", lcyc, csize );
2407 Emit( "SET_ELM_PLIST( %c, %d, %c );\n", lprm, i, lcyc );
2408 Emit( "CHANGED_BAG( %c );\n", lprm );
2409
2410 /* loop over the entries of the cycle */
2411 for ( j = 1; j <= csize; j++ ) {
2412 val = CompExpr(READ_EXPR(cycle, j - 1));
2413 Emit( "SET_ELM_PLIST( %c, %d, %c );\n", lcyc, j, val );
2414 Emit( "CHANGED_BAG( %c );\n", lcyc );
2415 if ( IS_TEMP_CVAR(val) ) FreeTemp( TEMP_CVAR(val) );
2416 }
2417 }
2418 Emit( "%c = Array2Perm( %c );\n", perm, lprm );
2419
2420 /* free the termporaries */
2421 FreeTemp( TEMP_CVAR(lprm) );
2422 FreeTemp( TEMP_CVAR(lcyc) );
2423
2424 return perm;
2425 }
2426
2427
2428 /****************************************************************************
2429 **
2430 *F CompListExpr( <expr> ) . . . . . . . . . . . . . . . . . . . EXPR_LIST
2431 */
2432 static CVar CompListExpr1(Expr expr);
2433 static void CompListExpr2(CVar list, Expr expr);
2434 static CVar CompRecExpr1(Expr expr);
2435 static void CompRecExpr2(CVar rec, Expr expr);
2436
CompListExpr(Expr expr)2437 static CVar CompListExpr(Expr expr)
2438 {
2439 CVar list; /* list, result */
2440
2441 /* compile the list expression */
2442 list = CompListExpr1( expr );
2443 CompListExpr2( list, expr );
2444
2445 /* return the result */
2446 return list;
2447 }
2448
2449
2450 /****************************************************************************
2451 **
2452 *F CompListTildeExpr( <expr> ) . . . . . . . . . . . . . . EXPR_LIST_TILDE
2453 */
CompListTildeExpr(Expr expr)2454 static CVar CompListTildeExpr(Expr expr)
2455 {
2456 CVar list; /* list value, result */
2457 CVar tilde; /* old value of tilde */
2458
2459 /* remember the old value of '~' */
2460 tilde = CVAR_TEMP( NewTemp( "tilde" ) );
2461 Emit( "%c = STATE(Tilde);\n", tilde );
2462
2463 /* create the list value */
2464 list = CompListExpr1( expr );
2465
2466 /* assign the list to '~' */
2467 Emit( "STATE(Tilde) = %c;\n", list );
2468
2469 /* evaluate the subexpressions into the list value */
2470 CompListExpr2( list, expr );
2471
2472 /* restore old value of '~' */
2473 Emit( "STATE(Tilde) = %c;\n", tilde );
2474 if ( IS_TEMP_CVAR( tilde ) ) FreeTemp( TEMP_CVAR( tilde ) );
2475
2476 /* return the list value */
2477 return list;
2478 }
2479
2480
2481 /****************************************************************************
2482 **
2483 *F CompListExpr1( <expr> ) . . . . . . . . . . . . . . . . . . . . . . local
2484 */
CompListExpr1(Expr expr)2485 static CVar CompListExpr1(Expr expr)
2486 {
2487 CVar list; /* list, result */
2488 Int len; /* logical length of the list */
2489
2490 /* get the length of the list */
2491 len = SIZE_EXPR( expr ) / sizeof(Expr);
2492
2493 /* allocate a temporary for the list */
2494 list = CVAR_TEMP( NewTemp( "list" ) );
2495
2496 /* emit the code to make the list */
2497 Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", list, len );
2498 Emit( "SET_LEN_PLIST( %c, %d );\n", list, len );
2499
2500 /* we know that <list> is a list */
2501 SetInfoCVar( list, W_LIST );
2502
2503 /* return the list */
2504 return list;
2505 }
2506
2507
2508 /****************************************************************************
2509 **
2510 *F CompListExpr2( <list>, <expr> ) . . . . . . . . . . . . . . . . . . local
2511 */
CompListExpr2(CVar list,Expr expr)2512 static void CompListExpr2(CVar list, Expr expr)
2513 {
2514 CVar sub; /* subexpression */
2515 Int len; /* logical length of the list */
2516 Int i; /* loop variable */
2517
2518 /* get the length of the list */
2519 len = SIZE_EXPR( expr ) / sizeof(Expr);
2520
2521 /* emit the code to fill the list */
2522 for ( i = 1; i <= len; i++ ) {
2523
2524 /* if the subexpression is empty */
2525 if (READ_EXPR(expr, i - 1) == 0) {
2526 continue;
2527 }
2528
2529 /* special case if subexpression is a list expression */
2530 else if (TNUM_EXPR(READ_EXPR(expr, i - 1)) == EXPR_LIST) {
2531 sub = CompListExpr1(READ_EXPR(expr, i - 1));
2532 Emit( "SET_ELM_PLIST( %c, %d, %c );\n", list, i, sub );
2533 Emit( "CHANGED_BAG( %c );\n", list );
2534 CompListExpr2(sub, READ_EXPR(expr, i - 1));
2535 if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
2536 }
2537
2538 /* special case if subexpression is a record expression */
2539 else if (TNUM_EXPR(READ_EXPR(expr, i - 1)) == EXPR_REC) {
2540 sub = CompRecExpr1(READ_EXPR(expr, i - 1));
2541 Emit( "SET_ELM_PLIST( %c, %d, %c );\n", list, i, sub );
2542 Emit( "CHANGED_BAG( %c );\n", list );
2543 CompRecExpr2(sub, READ_EXPR(expr, i - 1));
2544 if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
2545 }
2546
2547 /* general case */
2548 else {
2549 sub = CompExpr(READ_EXPR(expr, i - 1));
2550 Emit( "SET_ELM_PLIST( %c, %d, %c );\n", list, i, sub );
2551 if ( ! HasInfoCVar( sub, W_INT_SMALL ) ) {
2552 Emit( "CHANGED_BAG( %c );\n", list );
2553 }
2554 if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
2555 }
2556
2557 }
2558
2559 }
2560
2561
2562 /****************************************************************************
2563 **
2564 *F CompRangeExpr( <expr> ) . . . . . . . . . . . . . . . . . . EXPR_RANGE
2565 */
CompRangeExpr(Expr expr)2566 static CVar CompRangeExpr(Expr expr)
2567 {
2568 CVar range; /* range, result */
2569 CVar first; /* first element */
2570 CVar second; /* second element */
2571 CVar last; /* last element */
2572
2573 /* allocate a new temporary for the range */
2574 range = CVAR_TEMP( NewTemp( "range" ) );
2575
2576 /* evaluate the expressions */
2577 if ( SIZE_EXPR(expr) == 2 * sizeof(Expr) ) {
2578 first = CompExpr( READ_EXPR(expr, 0) );
2579 second = 0;
2580 last = CompExpr( READ_EXPR(expr, 1) );
2581 }
2582 else {
2583 first = CompExpr( READ_EXPR(expr, 0) );
2584 second = CompExpr( READ_EXPR(expr, 1) );
2585 last = CompExpr( READ_EXPR(expr, 2) );
2586 }
2587
2588 /* emit the code */
2589 if ( SIZE_EXPR(expr) == 2 * sizeof(Expr) ) {
2590 Emit( "%c = Range2Check( %c, %c );\n",
2591 range, first, last );
2592 }
2593 else {
2594 Emit( "%c = Range3Check( %c, %c, %c );\n",
2595 range, first, second, last );
2596 }
2597
2598 /* we know that the result is a list */
2599 SetInfoCVar( range, W_LIST );
2600
2601 /* free the temporaries */
2602 if ( SIZE_EXPR(expr) == 2 * sizeof(Expr) ) {
2603 if ( IS_TEMP_CVAR( last ) ) FreeTemp( TEMP_CVAR( last ) );
2604 if ( IS_TEMP_CVAR( first ) ) FreeTemp( TEMP_CVAR( first ) );
2605 }
2606 else {
2607 if ( IS_TEMP_CVAR( last ) ) FreeTemp( TEMP_CVAR( last ) );
2608 if ( IS_TEMP_CVAR( second ) ) FreeTemp( TEMP_CVAR( second ) );
2609 if ( IS_TEMP_CVAR( first ) ) FreeTemp( TEMP_CVAR( first ) );
2610 }
2611
2612 /* return the range */
2613 return range;
2614 }
2615
2616
2617 /****************************************************************************
2618 **
2619 *F CompStringExpr( <expr> ) . . . . . . . . . . compile a string expression
2620 */
CompStringExpr(Expr expr)2621 static CVar CompStringExpr(Expr expr)
2622 {
2623 CVar string; /* string value, result */
2624 Obj str; // the actual string object
2625
2626 /* allocate a new temporary for the string */
2627 string = CVAR_TEMP( NewTemp( "string" ) );
2628
2629 // get the string of this expression
2630 str = EVAL_EXPR(expr);
2631
2632 /* create the string and copy the stuff */
2633 Emit( "%c = MakeString( \"%C\" );\n", string, str);
2634
2635 /* we know that the result is a list */
2636 SetInfoCVar( string, W_LIST );
2637
2638 /* return the string */
2639 return string;
2640 }
2641
2642
2643 /****************************************************************************
2644 **
2645 *F CompRecExpr( <expr> ) . . . . . . . . . . . . . . . . . . . . EXPR_REC
2646 */
CompRecExpr(Expr expr)2647 static CVar CompRecExpr(Expr expr)
2648 {
2649 CVar rec; /* record value, result */
2650
2651 /* compile the record expression */
2652 rec = CompRecExpr1( expr );
2653 CompRecExpr2( rec, expr );
2654
2655 /* return the result */
2656 return rec;
2657 }
2658
2659
2660 /****************************************************************************
2661 **
2662 *F CompRecTildeExpr( <expr> ) . . . . . . . . . . . . . . EXPR_REC_TILDE
2663 */
CompRecTildeExpr(Expr expr)2664 static CVar CompRecTildeExpr(Expr expr)
2665 {
2666 CVar rec; /* record value, result */
2667 CVar tilde; /* old value of tilde */
2668
2669 /* remember the old value of '~' */
2670 tilde = CVAR_TEMP( NewTemp( "tilde" ) );
2671 Emit( "%c = STATE(Tilde);\n", tilde );
2672
2673 /* create the record value */
2674 rec = CompRecExpr1( expr );
2675
2676 /* assign the record value to the variable '~' */
2677 Emit( "STATE(Tilde) = %c;\n", rec );
2678
2679 /* evaluate the subexpressions into the record value */
2680 CompRecExpr2( rec, expr );
2681
2682 /* restore the old value of '~' */
2683 Emit( "STATE(Tilde) = %c;\n", tilde );
2684 if ( IS_TEMP_CVAR( tilde ) ) FreeTemp( TEMP_CVAR( tilde ) );
2685
2686 /* return the record value */
2687 return rec;
2688 }
2689
2690
2691 /****************************************************************************
2692 **
2693 *F CompRecExpr1( <expr> ) . . . . . . . . . . . . . . . . . . . . . . local
2694 */
CompRecExpr1(Expr expr)2695 static CVar CompRecExpr1(Expr expr)
2696 {
2697 CVar rec; /* record value, result */
2698 Int len; /* number of components */
2699
2700 /* get the number of components */
2701 len = SIZE_EXPR( expr ) / (2*sizeof(Expr));
2702
2703 /* allocate a new temporary for the record */
2704 rec = CVAR_TEMP( NewTemp( "rec" ) );
2705
2706 /* emit the code to allocate the new record object */
2707 Emit( "%c = NEW_PREC( %d );\n", rec, len );
2708
2709 /* we know that we have a value */
2710 SetInfoCVar( rec, W_BOUND );
2711
2712 /* return the record */
2713 return rec;
2714 }
2715
2716
2717 /****************************************************************************
2718 **
2719 *F CompRecExpr2( <rec>, <expr> ) . . . . . . . . . . . . . . . . . . . local
2720 */
CompRecExpr2(CVar rec,Expr expr)2721 static void CompRecExpr2(CVar rec, Expr expr)
2722 {
2723 CVar rnam; /* name of component */
2724 CVar sub; /* value of subexpression */
2725 Int len; /* number of components */
2726 Expr tmp; /* temporary variable */
2727 Int i; /* loop variable */
2728
2729 /* get the number of components */
2730 len = SIZE_EXPR( expr ) / (2*sizeof(Expr));
2731
2732 /* handle the subexpressions */
2733 for ( i = 1; i <= len; i++ ) {
2734
2735 /* handle the name */
2736 tmp = READ_EXPR(expr, 2 * i - 2);
2737 rnam = CVAR_TEMP( NewTemp( "rnam" ) );
2738 if ( IS_INTEXPR(tmp) ) {
2739 CompSetUseRNam( (UInt)INT_INTEXPR(tmp), COMP_USE_RNAM_ID );
2740 Emit( "%c = (Obj)R_%n;\n",
2741 rnam, NAME_RNAM((UInt)INT_INTEXPR(tmp)) );
2742 }
2743 else {
2744 sub = CompExpr( tmp );
2745 Emit( "%c = (Obj)RNamObj( %c );\n", rnam, sub );
2746 }
2747
2748 /* if the subexpression is empty (cannot happen for records) */
2749 tmp = READ_EXPR(expr, 2 * i - 1);
2750 if ( tmp == 0 ) {
2751 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
2752 continue;
2753 }
2754
2755 /* special case if subexpression is a list expression */
2756 else if ( TNUM_EXPR( tmp ) == EXPR_LIST ) {
2757 sub = CompListExpr1( tmp );
2758 Emit( "AssPRec( %c, (UInt)%c, %c );\n", rec, rnam, sub );
2759 CompListExpr2( sub, tmp );
2760 if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
2761 }
2762
2763 /* special case if subexpression is a record expression */
2764 else if ( TNUM_EXPR( tmp ) == EXPR_REC ) {
2765 sub = CompRecExpr1( tmp );
2766 Emit( "AssPRec( %c, (UInt)%c, %c );\n", rec, rnam, sub );
2767 CompRecExpr2( sub, tmp );
2768 if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
2769 }
2770
2771 /* general case */
2772 else {
2773 sub = CompExpr( tmp );
2774 Emit( "AssPRec( %c, (UInt)%c, %c );\n", rec, rnam, sub );
2775 if ( IS_TEMP_CVAR( sub ) ) FreeTemp( TEMP_CVAR( sub ) );
2776 }
2777
2778 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
2779 }
2780 Emit( "SortPRecRNam( %c, 0 );\n", rec );
2781
2782 }
2783
2784
2785 /****************************************************************************
2786 **
2787 *F CompRefLVar( <expr> ) . . . . . . . EXPR_REF_LVAR
2788 */
CompRefLVar(Expr expr)2789 static CVar CompRefLVar(Expr expr)
2790 {
2791 CVar val; /* value, result */
2792 LVar lvar; /* local variable */
2793
2794 lvar = LVAR_REF_LVAR(expr);
2795
2796 /* emit the code to get the value */
2797 if ( CompGetUseHVar( lvar ) ) {
2798 val = CVAR_TEMP( NewTemp( "val" ) );
2799 Emit( "%c = OBJ_LVAR( %d );\n", val, GetIndxHVar(lvar) );
2800 }
2801 else {
2802 val = CVAR_LVAR(lvar);
2803 }
2804
2805 /* emit code to check that the variable has a value */
2806 CompCheckBound( val, NAME_LVAR(lvar) );
2807
2808 /* return the value */
2809 return val;
2810 }
2811
2812
2813 /****************************************************************************
2814 **
2815 *F CompIsbLVar( <expr> ) . . . . . . . . . . . . . . . . . . . . EXPR_ISB_LVAR
2816 */
CompIsbLVar(Expr expr)2817 static CVar CompIsbLVar(Expr expr)
2818 {
2819 CVar isb; /* isbound, result */
2820 CVar val; /* value */
2821 LVar lvar; /* local variable */
2822
2823 /* get the local variable */
2824 lvar = (LVar)(READ_EXPR(expr, 0));
2825
2826 /* allocate a new temporary for the result */
2827 isb = CVAR_TEMP( NewTemp( "isb" ) );
2828
2829 /* emit the code to get the value */
2830 if ( CompGetUseHVar( lvar ) ) {
2831 val = CVAR_TEMP( NewTemp( "val" ) );
2832 Emit( "%c = OBJ_LVAR( %d );\n", val, GetIndxHVar(lvar) );
2833 }
2834 else {
2835 val = CVAR_LVAR(lvar);
2836 }
2837
2838 /* emit the code to check that the variable has a value */
2839 Emit( "%c = ((%c != 0) ? True : False);\n", isb, val );
2840
2841 /* we know that the result is boolean */
2842 SetInfoCVar( isb, W_BOOL );
2843
2844 /* free the temporaries */
2845 if ( IS_TEMP_CVAR( val ) ) FreeTemp( TEMP_CVAR( val ) );
2846
2847 /* return the result */
2848 return isb;
2849 }
2850
2851
2852 /****************************************************************************
2853 **
2854 *F CompRefHVar( <expr> ) . . . . . . . . . . . . . . . . . . . . EXPR_REF_HVAR
2855 */
CompRefHVar(Expr expr)2856 static CVar CompRefHVar(Expr expr)
2857 {
2858 CVar val; /* value, result */
2859 HVar hvar; /* higher variable */
2860
2861 /* get the higher variable */
2862 hvar = (HVar)(READ_EXPR(expr, 0));
2863 CompSetUseHVar( hvar );
2864
2865 /* allocate a new temporary for the value */
2866 val = CVAR_TEMP( NewTemp( "val" ) );
2867
2868 /* emit the code to get the value */
2869 Emit( "%c = OBJ_HVAR( (%d << 16) | %d );\n",
2870 val, GetLevlHVar(hvar), GetIndxHVar(hvar) );
2871
2872 /* emit the code to check that the variable has a value */
2873 CompCheckBound( val, NAME_HVAR(hvar) );
2874
2875 /* return the value */
2876 return val;
2877 }
2878
2879
2880 /****************************************************************************
2881 **
2882 *F CompIsbHVar( <expr> ) . . . . . . . . . . . . . . . . . . . . EXPR_ISB_HVAR
2883 */
CompIsbHVar(Expr expr)2884 static CVar CompIsbHVar(Expr expr)
2885 {
2886 CVar isb; /* isbound, result */
2887 CVar val; /* value */
2888 HVar hvar; /* higher variable */
2889
2890 /* get the higher variable */
2891 hvar = (HVar)(READ_EXPR(expr, 0));
2892 CompSetUseHVar( hvar );
2893
2894 /* allocate new temporaries for the value and the result */
2895 val = CVAR_TEMP( NewTemp( "val" ) );
2896 isb = CVAR_TEMP( NewTemp( "isb" ) );
2897
2898 /* emit the code to get the value */
2899 Emit( "%c = OBJ_HVAR( (%d << 16) | %d );\n",
2900 val, GetLevlHVar(hvar), GetIndxHVar(hvar) );
2901
2902 /* emit the code to check that the variable has a value */
2903 Emit( "%c = ((%c != 0) ? True : False);\n", isb, val );
2904
2905 /* we know that the result is boolean */
2906 SetInfoCVar( isb, W_BOOL );
2907
2908 /* free the temporaries */
2909 if ( IS_TEMP_CVAR( val ) ) FreeTemp( TEMP_CVAR( val ) );
2910
2911 /* return the result */
2912 return isb;
2913 }
2914
2915
2916 /****************************************************************************
2917 **
2918 *F CompRefGVar( <expr> ) . . . . . . . . . . . . . . . . . . . . EXPR_REF_GVAR
2919 */
CompRefGVar(Expr expr)2920 static CVar CompRefGVar(Expr expr)
2921 {
2922 CVar val; /* value, result */
2923 GVar gvar; /* higher variable */
2924
2925 /* get the global variable */
2926 gvar = (GVar)(READ_EXPR(expr, 0));
2927 CompSetUseGVar( gvar, COMP_USE_GVAR_COPY );
2928
2929 /* allocate a new global variable for the value */
2930 val = CVAR_TEMP( NewTemp( "val" ) );
2931
2932 /* emit the code to get the value */
2933 Emit( "%c = GC_%n;\n", val, NameGVar(gvar) );
2934
2935 /* emit the code to check that the variable has a value */
2936 CompCheckBound( val, NameGVar(gvar) );
2937
2938 /* return the value */
2939 return val;
2940 }
2941
2942
2943 /****************************************************************************
2944 **
2945 *F CompRefGVarFopy( <expr> ) . . . . . . . . . . . . . . . . . . . . . local
2946 */
CompRefGVarFopy(Expr expr)2947 static CVar CompRefGVarFopy(Expr expr)
2948 {
2949 CVar val; /* value, result */
2950 GVar gvar; /* higher variable */
2951
2952 /* get the global variable */
2953 gvar = (GVar)(READ_EXPR(expr, 0));
2954 CompSetUseGVar( gvar, COMP_USE_GVAR_FOPY );
2955
2956 /* allocate a new temporary for the value */
2957 val = CVAR_TEMP( NewTemp( "val" ) );
2958
2959 /* emit the code to get the value */
2960 Emit( "%c = GF_%n;\n", val, NameGVar(gvar) );
2961
2962 /* we know that the object in a function copy is a function */
2963 SetInfoCVar( val, W_FUNC );
2964
2965 /* return the value */
2966 return val;
2967 }
2968
2969
2970 /****************************************************************************
2971 **
2972 *F CompIsbGVar( <expr> ) . . . . . . . . . . . . . . . . . . . . EXPR_ISB_GVAR
2973 */
CompIsbGVar(Expr expr)2974 static CVar CompIsbGVar(Expr expr)
2975 {
2976 CVar isb; /* isbound, result */
2977 CVar val; /* value, result */
2978 GVar gvar; /* higher variable */
2979
2980 /* get the global variable */
2981 gvar = (GVar)(READ_EXPR(expr, 0));
2982 CompSetUseGVar( gvar, COMP_USE_GVAR_COPY );
2983
2984 /* allocate new temporaries for the value and the result */
2985 isb = CVAR_TEMP( NewTemp( "isb" ) );
2986 val = CVAR_TEMP( NewTemp( "val" ) );
2987
2988 /* emit the code to get the value */
2989 Emit( "%c = GC_%n;\n", val, NameGVar(gvar) );
2990
2991 /* emit the code to check that the variable has a value */
2992 Emit( "%c = ((%c != 0) ? True : False);\n", isb, val );
2993
2994 /* we know that the result is boolean */
2995 SetInfoCVar( isb, W_BOOL );
2996
2997 /* free the temporaries */
2998 if ( IS_TEMP_CVAR( val ) ) FreeTemp( TEMP_CVAR( val ) );
2999
3000 /* return the result */
3001 return isb;
3002 }
3003
3004
3005 /****************************************************************************
3006 **
3007 *F CompElmList( <expr> ) . . . . . . . . . . . . . . . . . . . . EXPR_ELM_LIST
3008 */
CompElmList(Expr expr)3009 static CVar CompElmList(Expr expr)
3010 {
3011 CVar elm; /* element, result */
3012 CVar list; /* list */
3013 CVar pos; /* position */
3014
3015 /* allocate a new temporary for the element */
3016 elm = CVAR_TEMP( NewTemp( "elm" ) );
3017
3018 /* compile the list expression (checking is done by 'ELM_LIST') */
3019 list = CompExpr(READ_EXPR(expr, 0));
3020
3021 /* compile and check the position expression */
3022 pos = CompExpr(READ_EXPR(expr, 1));
3023 CompCheckIntPos( pos );
3024
3025 /* emit the code to get the element */
3026 if ( CompCheckListElements && CompFastPlainLists ) {
3027 Emit( "C_ELM_LIST_FPL( %c, %c, %c )\n", elm, list, pos );
3028 }
3029 else if ( CompCheckListElements && ! CompFastPlainLists ) {
3030 Emit( "C_ELM_LIST( %c, %c, %c );\n", elm, list, pos );
3031 }
3032 else if ( ! CompCheckListElements && CompFastPlainLists ) {
3033 Emit( "C_ELM_LIST_NLE_FPL( %c, %c, %c );\n", elm, list, pos );
3034 }
3035 else {
3036 Emit( "C_ELM_LIST_NLE( %c, %c, %c );\n", elm, list, pos );
3037 }
3038
3039 /* we know that we have a value */
3040 SetInfoCVar( elm, W_BOUND );
3041
3042 /* free the temporaries */
3043 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
3044 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
3045
3046 /* return the element */
3047 return elm;
3048 }
3049
3050
3051 /****************************************************************************
3052 **
3053 *F CompElmsList( <expr> ) . . . . . . . . . . . . . . . . . . . EXPR_ELMS_LIST
3054 */
CompElmsList(Expr expr)3055 static CVar CompElmsList(Expr expr)
3056 {
3057 CVar elms; /* elements, result */
3058 CVar list; /* list */
3059 CVar poss; /* positions */
3060
3061 /* allocate a new temporary for the elements */
3062 elms = CVAR_TEMP( NewTemp( "elms" ) );
3063
3064 /* compile the list expression (checking is done by 'ElmsListCheck') */
3065 list = CompExpr(READ_EXPR(expr, 0));
3066
3067 /* compile the position expression (checking done by 'ElmsListCheck') */
3068 poss = CompExpr(READ_EXPR(expr, 1));
3069
3070 /* emit the code to get the element */
3071 Emit( "%c = ElmsListCheck( %c, %c );\n", elms, list, poss );
3072
3073 /* we know that the elements are a list */
3074 SetInfoCVar( elms, W_LIST );
3075
3076 /* free the temporaries */
3077 if ( IS_TEMP_CVAR( poss ) ) FreeTemp( TEMP_CVAR( poss ) );
3078 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
3079
3080 /* return the elements */
3081 return elms;
3082 }
3083
3084
3085 /****************************************************************************
3086 **
3087 *F CompElmListLev( <expr> ) . . . . . . . . . . . . . . . . EXPR_ELM_LIST_LEV
3088 */
CompElmListLev(Expr expr)3089 static CVar CompElmListLev(Expr expr)
3090 {
3091 CVar lists; /* lists */
3092 CVar pos; /* position */
3093 UInt level; /* level */
3094
3095 /* compile the lists expression */
3096 lists = CompExpr(READ_EXPR(expr, 0));
3097
3098 /* compile and check the position expression */
3099 pos = CompExpr(READ_EXPR(expr, 1));
3100 CompCheckIntSmallPos( pos );
3101
3102 /* get the level */
3103 level = READ_EXPR(expr, 2);
3104
3105 /* emit the code to select the elements from several lists (to <lists>)*/
3106 Emit( "ElmListLevel( %c, %c, %d );\n", lists, pos, level );
3107
3108 /* free the temporaries */
3109 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
3110
3111 /* return the lists */
3112 return lists;
3113 }
3114
3115
3116 /****************************************************************************
3117 **
3118 *F CompElmsListLev( <expr> ) . . . . . . . . . . . . . . . . EXPR_ELMS_LIST_LEV
3119 */
CompElmsListLev(Expr expr)3120 static CVar CompElmsListLev(Expr expr)
3121 {
3122 CVar lists; /* lists */
3123 CVar poss; /* positions */
3124 UInt level; /* level */
3125
3126 /* compile the lists expression */
3127 lists = CompExpr(READ_EXPR(expr, 0));
3128
3129 /* compile the position expression (checking done by 'ElmsListLevel') */
3130 poss = CompExpr(READ_EXPR(expr, 1));
3131
3132 /* get the level */
3133 level = READ_EXPR(expr, 2);
3134
3135 /* emit the code to select the elements from several lists (to <lists>)*/
3136 Emit( "ElmsListLevelCheck( %c, %c, %d );\n", lists, poss, level );
3137
3138 /* free the temporaries */
3139 if ( IS_TEMP_CVAR( poss ) ) FreeTemp( TEMP_CVAR( poss ) );
3140
3141 /* return the lists */
3142 return lists;
3143 }
3144
3145
3146 /****************************************************************************
3147 **
3148 *F CompIsbList( <expr> ) . . . . . . . . . . . . . . . . . . . . EXPR_ISB_LIST
3149 */
CompIsbList(Expr expr)3150 static CVar CompIsbList(Expr expr)
3151 {
3152 CVar isb; /* isbound, result */
3153 CVar list; /* list */
3154 CVar pos; /* position */
3155
3156 /* allocate a new temporary for the result */
3157 isb = CVAR_TEMP( NewTemp( "isb" ) );
3158
3159 /* compile the list expression (checking is done by 'ISB_LIST') */
3160 list = CompExpr(READ_EXPR(expr, 0));
3161
3162 /* compile and check the position expression */
3163 pos = CompExpr(READ_EXPR(expr, 1));
3164 CompCheckIntPos( pos );
3165
3166 /* emit the code to test the element */
3167 Emit( "%c = C_ISB_LIST( %c, %c );\n", isb, list, pos );
3168
3169 /* we know that the result is boolean */
3170 SetInfoCVar( isb, W_BOOL );
3171
3172 /* free the temporaries */
3173 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
3174 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
3175
3176 /* return the element */
3177 return isb;
3178 }
3179
3180
3181 /****************************************************************************
3182 **
3183 *F CompElmRecName( <expr> ) . . . . . . . . . . . . . . . . EXPR_ELM_REC_NAME
3184 */
CompElmRecName(Expr expr)3185 static CVar CompElmRecName(Expr expr)
3186 {
3187 CVar elm; /* element, result */
3188 CVar record; /* the record, left operand */
3189 UInt rnam; /* the name, right operand */
3190
3191 /* allocate a new temporary for the element */
3192 elm = CVAR_TEMP( NewTemp( "elm" ) );
3193
3194 /* compile the record expression (checking is done by 'ELM_REC') */
3195 record = CompExpr(READ_EXPR(expr, 0));
3196
3197 /* get the name (stored immediately in the expression) */
3198 rnam = READ_EXPR(expr, 1);
3199 CompSetUseRNam( rnam, COMP_USE_RNAM_ID );
3200
3201 /* emit the code to select the element of the record */
3202 Emit( "%c = ELM_REC( %c, R_%n );\n", elm, record, NAME_RNAM(rnam) );
3203
3204 /* we know that we have a value */
3205 SetInfoCVar( elm, W_BOUND );
3206
3207 /* free the temporaries */
3208 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
3209
3210 /* return the element */
3211 return elm;
3212 }
3213
3214
3215 /****************************************************************************
3216 **
3217 *F CompElmRecExpr( <expr> ) . . . . . . . . . . . . . . . . EXPR_ELM_REC_EXPR
3218 */
CompElmRecExpr(Expr expr)3219 static CVar CompElmRecExpr(Expr expr)
3220 {
3221 CVar elm; /* element, result */
3222 CVar record; /* the record, left operand */
3223 CVar rnam; /* the name, right operand */
3224
3225 /* allocate a new temporary for the element */
3226 elm = CVAR_TEMP( NewTemp( "elm" ) );
3227
3228 /* compile the record expression (checking is done by 'ELM_REC') */
3229 record = CompExpr(READ_EXPR(expr, 0));
3230
3231 /* compile the record name expression */
3232 rnam = CompExpr(READ_EXPR(expr, 1));
3233
3234 /* emit the code to select the element of the record */
3235 Emit( "%c = ELM_REC( %c, RNamObj(%c) );\n", elm, record, rnam );
3236
3237 /* we know that we have a value */
3238 SetInfoCVar( elm, W_BOUND );
3239
3240 /* free the temporaries */
3241 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
3242 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
3243
3244 /* return the element */
3245 return elm;
3246 }
3247
3248
3249 /****************************************************************************
3250 **
3251 *F CompIsbRecName( <expr> ) . . . . . . . . . . . . . . . . EXPR_ISB_REC_NAME
3252 */
CompIsbRecName(Expr expr)3253 static CVar CompIsbRecName(Expr expr)
3254 {
3255 CVar isb; /* isbound, result */
3256 CVar record; /* the record, left operand */
3257 UInt rnam; /* the name, right operand */
3258
3259 /* allocate a new temporary for the result */
3260 isb = CVAR_TEMP( NewTemp( "isb" ) );
3261
3262 /* compile the record expression (checking is done by 'ISB_REC') */
3263 record = CompExpr(READ_EXPR(expr, 0));
3264
3265 /* get the name (stored immediately in the expression) */
3266 rnam = READ_EXPR(expr, 1);
3267 CompSetUseRNam( rnam, COMP_USE_RNAM_ID );
3268
3269 /* emit the code to test the element */
3270 Emit( "%c = (ISB_REC( %c, R_%n ) ? True : False);\n",
3271 isb, record, NAME_RNAM(rnam) );
3272
3273 /* we know that the result is boolean */
3274 SetInfoCVar( isb, W_BOOL );
3275
3276 /* free the temporaries */
3277 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
3278
3279 /* return the result */
3280 return isb;
3281 }
3282
3283
3284 /****************************************************************************
3285 **
3286 *F CompIsbRecExpr( <expr> ) . . . . . . . . . . . . . . . . EXPR_ISB_REC_EXPR
3287 */
CompIsbRecExpr(Expr expr)3288 static CVar CompIsbRecExpr(Expr expr)
3289 {
3290 CVar isb; /* isbound, result */
3291 CVar record; /* the record, left operand */
3292 CVar rnam; /* the name, right operand */
3293
3294 /* allocate a new temporary for the result */
3295 isb = CVAR_TEMP( NewTemp( "isb" ) );
3296
3297 /* compile the record expression (checking is done by 'ISB_REC') */
3298 record = CompExpr(READ_EXPR(expr, 0));
3299
3300 /* compile the record name expression */
3301 rnam = CompExpr(READ_EXPR(expr, 1));
3302
3303 /* emit the code to test the element */
3304 Emit( "%c = (ISB_REC( %c, RNamObj(%c) ) ? True : False);\n",
3305 isb, record, rnam );
3306
3307 /* we know that the result is boolean */
3308 SetInfoCVar( isb, W_BOOL );
3309
3310 /* free the temporaries */
3311 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
3312 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
3313
3314 /* return the result */
3315 return isb;
3316 }
3317
3318
3319 /****************************************************************************
3320 **
3321 *F CompElmPosObj( <expr> ) . . . . . . . . . . . . . . . . . . EXPR_ELM_POSOBJ
3322 */
CompElmPosObj(Expr expr)3323 static CVar CompElmPosObj(Expr expr)
3324 {
3325 CVar elm; /* element, result */
3326 CVar list; /* list */
3327 CVar pos; /* position */
3328
3329 /* allocate a new temporary for the element */
3330 elm = CVAR_TEMP( NewTemp( "elm" ) );
3331
3332 /* compile the list expression (checking is done by 'ELM_LIST') */
3333 list = CompExpr(READ_EXPR(expr, 0));
3334
3335 /* compile and check the position expression */
3336 pos = CompExpr(READ_EXPR(expr, 1));
3337 CompCheckIntSmallPos( pos );
3338
3339 /* emit the code to get the element */
3340 Emit( "%c = ElmPosObj( %c, %i );\n", elm, list, pos );
3341
3342 /* we know that we have a value */
3343 SetInfoCVar( elm, W_BOUND );
3344
3345 /* free the temporaries */
3346 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
3347 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
3348
3349 /* return the element */
3350 return elm;
3351 }
3352
3353
3354 /****************************************************************************
3355 **
3356 *F CompIsbPosObj( <expr> ) . . . . . . . . . . . . . . . . . . EXPR_ISB_POSOBJ
3357 */
CompIsbPosObj(Expr expr)3358 static CVar CompIsbPosObj(Expr expr)
3359 {
3360 CVar isb; /* isbound, result */
3361 CVar list; /* list */
3362 CVar pos; /* position */
3363
3364 /* allocate a new temporary for the result */
3365 isb = CVAR_TEMP( NewTemp( "isb" ) );
3366
3367 /* compile the list expression (checking is done by 'ISB_LIST') */
3368 list = CompExpr(READ_EXPR(expr, 0));
3369
3370 /* compile and check the position expression */
3371 pos = CompExpr(READ_EXPR(expr, 1));
3372 CompCheckIntSmallPos( pos );
3373
3374 /* emit the code to test the element */
3375 Emit( "%c = IsbPosObj( %c, %i ) ? True : False;\n", isb, list, pos );
3376
3377 /* we know that the result is boolean */
3378 SetInfoCVar( isb, W_BOOL );
3379
3380 /* free the temporaries */
3381 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
3382 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
3383
3384 /* return the element */
3385 return isb;
3386 }
3387
3388
3389 /****************************************************************************
3390 **
3391 *F CompElmObjName( <expr> ) . . . . . . . . . . . . . . . EXPR_ELM_COMOBJ_NAME
3392 */
CompElmComObjName(Expr expr)3393 static CVar CompElmComObjName(Expr expr)
3394 {
3395 CVar elm; /* element, result */
3396 CVar record; /* the record, left operand */
3397 UInt rnam; /* the name, right operand */
3398
3399 /* allocate a new temporary for the element */
3400 elm = CVAR_TEMP( NewTemp( "elm" ) );
3401
3402 /* compile the record expression (checking is done by 'ELM_REC') */
3403 record = CompExpr(READ_EXPR(expr, 0));
3404
3405 /* get the name (stored immediately in the expression) */
3406 rnam = READ_EXPR(expr, 1);
3407 CompSetUseRNam( rnam, COMP_USE_RNAM_ID );
3408
3409 /* emit the code to select the element of the record */
3410 Emit( "%c = ElmComObj( %c, R_%n );\n", elm, record, NAME_RNAM(rnam) );
3411
3412 /* we know that we have a value */
3413 SetInfoCVar( elm, W_BOUND );
3414
3415 /* free the temporaries */
3416 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
3417
3418 /* return the element */
3419 return elm;
3420 }
3421
3422
3423
3424 /****************************************************************************
3425 **
3426 *F CompElmComObjExpr( <expr> ) . . . . . . . . . . . . . . EXPR_ELM_COMOBJ_EXPR
3427 */
CompElmComObjExpr(Expr expr)3428 static CVar CompElmComObjExpr(Expr expr)
3429 {
3430 CVar elm; /* element, result */
3431 CVar record; /* the record, left operand */
3432 CVar rnam; /* the name, right operand */
3433
3434 /* allocate a new temporary for the element */
3435 elm = CVAR_TEMP( NewTemp( "elm" ) );
3436
3437 /* compile the record expression (checking is done by 'ELM_REC') */
3438 record = CompExpr(READ_EXPR(expr, 0));
3439
3440 /* get the name (stored immediately in the expression) */
3441 rnam = CompExpr(READ_EXPR(expr, 1));
3442
3443 /* emit the code to select the element of the record */
3444 Emit( "%c = ElmComObj( %c, RNamObj(%c) );\n", elm, record, rnam );
3445
3446 /* we know that we have a value */
3447 SetInfoCVar( elm, W_BOUND );
3448
3449 /* free the temporaries */
3450 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
3451 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
3452
3453 /* return the element */
3454 return elm;
3455 }
3456
3457
3458 /****************************************************************************
3459 **
3460 *F CompIsbComObjName( <expr> ) . . . . . . . . . . . . . . EXPR_ISB_COMOBJ_NAME
3461 */
CompIsbComObjName(Expr expr)3462 static CVar CompIsbComObjName(Expr expr)
3463 {
3464 CVar isb; /* isbound, result */
3465 CVar record; /* the record, left operand */
3466 UInt rnam; /* the name, right operand */
3467
3468 /* allocate a new temporary for the result */
3469 isb = CVAR_TEMP( NewTemp( "isb" ) );
3470
3471 /* compile the record expression (checking is done by 'ISB_REC') */
3472 record = CompExpr(READ_EXPR(expr, 0));
3473
3474 /* get the name (stored immediately in the expression) */
3475 rnam = READ_EXPR(expr, 1);
3476 CompSetUseRNam( rnam, COMP_USE_RNAM_ID );
3477
3478 /* emit the code to test the element */
3479 Emit( "%c = IsbComObj( %c, R_%n ) ? True : False;\n",
3480 isb, record, NAME_RNAM(rnam) );
3481
3482 /* we know that the result is boolean */
3483 SetInfoCVar( isb, W_BOOL );
3484
3485 /* free the temporaries */
3486 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
3487
3488 /* return the result */
3489 return isb;
3490 }
3491
3492
3493 /****************************************************************************
3494 **
3495 *F CompIsbComObjExpr( <expr> ) . . . . . . . . . . . . . . EXPR_ISB_COMOBJ_EXPR
3496 */
CompIsbComObjExpr(Expr expr)3497 static CVar CompIsbComObjExpr(Expr expr)
3498 {
3499 CVar isb; /* isbound, result */
3500 CVar record; /* the record, left operand */
3501 UInt rnam; /* the name, right operand */
3502
3503 /* allocate a new temporary for the result */
3504 isb = CVAR_TEMP( NewTemp( "isb" ) );
3505
3506 /* compile the record expression (checking is done by 'ISB_REC') */
3507 record = CompExpr(READ_EXPR(expr, 0));
3508
3509 /* get the name (stored immediately in the expression) */
3510 rnam = CompExpr(READ_EXPR(expr, 1));
3511
3512 /* emit the code to test the element */
3513 Emit( "%c = IsbComObj( %c, RNamObj(%c) ) ? True : False;\n",
3514 isb, record, rnam );
3515
3516 /* we know that the result is boolean */
3517 SetInfoCVar( isb, W_BOOL );
3518
3519 /* free the temporaries */
3520 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
3521 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
3522
3523 /* return the result */
3524 return isb;
3525 }
3526
3527
3528 /****************************************************************************
3529 **
3530 *F * * * * * * * * * * * * * compile statements * * * * * * * * * * * * * * *
3531 */
3532
3533
3534 /****************************************************************************
3535 **
3536 *F CompStat( <stat> ) . . . . . . . . . . . . . . . . . compile a statement
3537 **
3538 ** 'CompStat' compiles the statement <stat>.
3539 */
3540 static void (*CompStatFuncs[256])(Stat stat);
3541
CompStat(Stat stat)3542 static void CompStat(Stat stat)
3543 {
3544 (* CompStatFuncs[ TNUM_STAT(stat) ])( stat );
3545 }
3546
3547
3548 /****************************************************************************
3549 **
3550 *F CompUnknownStat( <stat> ) . . . . . . . . . . . . . . . . signal an error
3551 */
CompUnknownStat(Stat stat)3552 static void CompUnknownStat(Stat stat)
3553 {
3554 Emit( "CANNOT COMPILE STATEMENT OF TNUM %d;\n", TNUM_STAT(stat) );
3555 }
3556
3557
3558 /****************************************************************************
3559 **
3560 *V G_Add . . . . . . . . . . . . . . . . . . . . . . . . . . function 'Add'
3561 */
3562 static GVar G_Add;
3563
3564
3565 /****************************************************************************
3566 **
3567 *F CompProccall0to6Args( <stat> ) . . . STAT_PROCCALL_0ARGS...STAT_PROCCALL_6ARGS
3568 */
CompProccall0to6Args(Stat stat)3569 static void CompProccall0to6Args(Stat stat)
3570 {
3571 CVar func; /* function */
3572 CVar args[8]; /* arguments */
3573 UInt narg; /* number of arguments */
3574 UInt i; /* loop variable */
3575
3576 /* print a comment */
3577 if ( CompPass == 2 ) {
3578 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
3579 }
3580
3581 /* special case to inline 'Add' */
3582 if ( CompFastListFuncs
3583 && TNUM_EXPR( FUNC_CALL(stat) ) == EXPR_REF_GVAR
3584 && READ_EXPR( FUNC_CALL(stat), 0 ) == G_Add
3585 && NARG_SIZE_CALL(SIZE_EXPR(stat)) == 2 ) {
3586 args[1] = CompExpr( ARGI_CALL(stat,1) );
3587 args[2] = CompExpr( ARGI_CALL(stat,2) );
3588 if ( CompFastPlainLists ) {
3589 Emit( "C_ADD_LIST_FPL( %c, %c )\n", args[1], args[2] );
3590 }
3591 else {
3592 Emit( "C_ADD_LIST( %c, %c )\n", args[1], args[2] );
3593 }
3594 if ( IS_TEMP_CVAR( args[2] ) ) FreeTemp( TEMP_CVAR( args[2] ) );
3595 if ( IS_TEMP_CVAR( args[1] ) ) FreeTemp( TEMP_CVAR( args[1] ) );
3596 return;
3597 }
3598
3599 /* compile the reference to the function */
3600 if ( TNUM_EXPR( FUNC_CALL(stat) ) == EXPR_REF_GVAR ) {
3601 func = CompRefGVarFopy( FUNC_CALL(stat) );
3602 }
3603 else {
3604 func = CompExpr( FUNC_CALL(stat) );
3605 }
3606
3607 /* compile the argument expressions */
3608 narg = NARG_SIZE_CALL(SIZE_STAT(stat));
3609 for ( i = 1; i <= narg; i++ ) {
3610 args[i] = CompExpr( ARGI_CALL(stat,i) );
3611 }
3612
3613 /* emit the code for the procedure call */
3614 Emit( "if ( TNUM_OBJ( %c ) == T_FUNCTION ) {\n", func );
3615 Emit( "CALL_%dARGS( %c", narg, func );
3616 for ( i = 1; i <= narg; i++ ) {
3617 Emit( ", %c", args[i] );
3618 }
3619 Emit( " );\n" );
3620 Emit( "}\n" );
3621 Emit( "else {\n" );
3622 Emit( "DoOperation2Args( CallFuncListOper, %c, NewPlistFromArgs(", func);
3623 if (narg >= 1) {
3624 Emit( " %c", args[1] );
3625 }
3626 for ( i = 2; i <= narg; i++ ) {
3627 Emit( ", %c", args[i] );
3628 }
3629 Emit( " ) );\n" );
3630 Emit( "}\n" );
3631
3632 /* free the temporaries */
3633 for ( i = narg; 1 <= i; i-- ) {
3634 if ( IS_TEMP_CVAR( args[i] ) ) FreeTemp( TEMP_CVAR( args[i] ) );
3635 }
3636 if ( IS_TEMP_CVAR( func ) ) FreeTemp( TEMP_CVAR( func ) );
3637 }
3638
3639
3640 /****************************************************************************
3641 **
3642 *F CompProccallXArgs . . . . . . . . . . . . . . . . . . . STAT_PROCCALL_XARGS
3643 */
CompProccallXArgs(Stat stat)3644 static void CompProccallXArgs(Stat stat)
3645 {
3646 CVar func; /* function */
3647 CVar argl; /* argument list */
3648 CVar argi; /* <i>-th argument */
3649 UInt narg; /* number of arguments */
3650 UInt i; /* loop variable */
3651
3652 /* print a comment */
3653 if ( CompPass == 2 ) {
3654 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
3655 }
3656
3657 /* compile the reference to the function */
3658 if ( TNUM_EXPR( FUNC_CALL(stat) ) == EXPR_REF_GVAR ) {
3659 func = CompRefGVarFopy( FUNC_CALL(stat) );
3660 }
3661 else {
3662 func = CompExpr( FUNC_CALL(stat) );
3663 }
3664
3665 /* compile the argument expressions */
3666 narg = NARG_SIZE_CALL(SIZE_STAT(stat));
3667 argl = CVAR_TEMP( NewTemp( "argl" ) );
3668 Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", argl, narg );
3669 Emit( "SET_LEN_PLIST( %c, %d );\n", argl, narg );
3670 for ( i = 1; i <= narg; i++ ) {
3671 argi = CompExpr( ARGI_CALL( stat, i ) );
3672 Emit( "SET_ELM_PLIST( %c, %d, %c );\n", argl, i, argi );
3673 if ( ! HasInfoCVar( argi, W_INT_SMALL ) ) {
3674 Emit( "CHANGED_BAG( %c );\n", argl );
3675 }
3676 if ( IS_TEMP_CVAR( argi ) ) FreeTemp( TEMP_CVAR( argi ) );
3677 }
3678
3679 /* emit the code for the procedure call */
3680 Emit( "if ( TNUM_OBJ( %c ) == T_FUNCTION ) {\n", func );
3681 Emit( "CALL_XARGS( %c, %c );\n", func, argl );
3682 Emit( "}\n" );
3683 Emit( "else {\n" );
3684 Emit( "DoOperation2Args( CallFuncListOper, %c, %c );\n", func, argl );
3685 Emit( "}\n" );
3686
3687 /* free the temporaries */
3688 if ( IS_TEMP_CVAR( argl ) ) FreeTemp( TEMP_CVAR( argl ) );
3689 if ( IS_TEMP_CVAR( func ) ) FreeTemp( TEMP_CVAR( func ) );
3690 }
3691
3692 /****************************************************************************
3693 **
3694 *F CompProccallXArgs( <expr> ) . . . . . . . . . . . . . . STAT_PROCCALL_OPTS
3695 */
CompProccallOpts(Stat stat)3696 static void CompProccallOpts(Stat stat)
3697 {
3698 CVar opts = CompExpr(READ_STAT(stat, 0));
3699 GVar pushOptions;
3700 GVar popOptions;
3701 pushOptions = GVarName("PushOptions");
3702 popOptions = GVarName("PopOptions");
3703 CompSetUseGVar(pushOptions, COMP_USE_GVAR_FOPY);
3704 CompSetUseGVar(popOptions, COMP_USE_GVAR_FOPY);
3705 Emit("CALL_1ARGS( GF_PushOptions, %c );\n", opts);
3706 if (IS_TEMP_CVAR( opts) ) FreeTemp( TEMP_CVAR( opts ));
3707 CompStat(READ_STAT(stat, 1));
3708 Emit("CALL_0ARGS( GF_PopOptions );\n");
3709 }
3710
3711
3712 /****************************************************************************
3713 **
3714 *F CompSeqStat( <stat> ) . . . . . . . . . . . . . STAT_SEQ_STAT...STAT_SEQ_STAT7
3715 */
CompSeqStat(Stat stat)3716 static void CompSeqStat(Stat stat)
3717 {
3718 UInt nr; /* number of statements */
3719 UInt i; /* loop variable */
3720
3721 /* get the number of statements */
3722 nr = SIZE_STAT( stat ) / sizeof(Stat);
3723
3724 /* compile the statements */
3725 for ( i = 1; i <= nr; i++ ) {
3726 CompStat(READ_STAT(stat, i - 1));
3727 }
3728 }
3729
3730
3731 /****************************************************************************
3732 **
3733 *F CompIf( <stat> ) . . . . . . . . STAT_IF/STAT_IF_ELSE/STAT_IF_ELIF/STAT_IF_ELIF_ELSE
3734 */
CompIf(Stat stat)3735 static void CompIf(Stat stat)
3736 {
3737 CVar cond; /* condition */
3738 UInt nr; /* number of branches */
3739 Bag info_in; /* information at branch begin */
3740 Bag info_out; /* information at branch end */
3741 UInt i; /* loop variable */
3742
3743 /* get the number of branches */
3744 nr = SIZE_STAT( stat ) / (2*sizeof(Stat));
3745
3746 /* print a comment */
3747 if ( CompPass == 2 ) {
3748 Emit( "\n/* if " );
3749 PrintExpr(READ_EXPR(stat, 0));
3750 Emit( " then */\n" );
3751 }
3752
3753 /* compile the expression */
3754 cond = CompBoolExpr(READ_STAT(stat, 0));
3755
3756 /* emit the code to test the condition */
3757 Emit( "if ( %c ) {\n", cond );
3758 if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );
3759
3760 /* remember what we know after evaluating the first condition */
3761 info_in = NewInfoCVars();
3762 CopyInfoCVars( info_in, INFO_FEXP(CURR_FUNC()) );
3763
3764 /* compile the body */
3765 CompStat(READ_STAT(stat, 1));
3766
3767 /* remember what we know after executing the first body */
3768 info_out = NewInfoCVars();
3769 CopyInfoCVars( info_out, INFO_FEXP(CURR_FUNC()) );
3770
3771 /* emit the rest code */
3772 Emit( "\n}\n" );
3773
3774 /* loop over the 'elif' branches */
3775 for ( i = 2; i <= nr; i++ ) {
3776
3777 /* do not handle 'else' branch here */
3778 if (i == nr && TNUM_EXPR(READ_STAT(stat, 2 * (i - 1))) == EXPR_TRUE)
3779 break;
3780
3781 /* print a comment */
3782 if ( CompPass == 2 ) {
3783 Emit( "\n/* elif " );
3784 PrintExpr(READ_EXPR(stat, 2 * (i - 1)));
3785 Emit( " then */\n" );
3786 }
3787
3788 /* emit the 'else' to connect this branch to the 'if' branch */
3789 Emit( "else {\n" );
3790
3791 /* this is what we know if we enter this branch */
3792 CopyInfoCVars( INFO_FEXP(CURR_FUNC()), info_in );
3793
3794 /* compile the expression */
3795 cond = CompBoolExpr(READ_STAT(stat, 2 * (i - 1)));
3796
3797 /* emit the code to test the condition */
3798 Emit( "if ( %c ) {\n", cond );
3799 if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );
3800
3801 /* remember what we know after evaluating all previous conditions */
3802 CopyInfoCVars( info_in, INFO_FEXP(CURR_FUNC()) );
3803
3804 /* compile the body */
3805 CompStat(READ_STAT(stat, 2 * (i - 1) + 1));
3806
3807 /* remember what we know after executing one of the previous bodies*/
3808 MergeInfoCVars( info_out, INFO_FEXP(CURR_FUNC()) );
3809
3810 /* emit the rest code */
3811 Emit( "\n}\n" );
3812
3813 }
3814
3815 /* handle 'else' branch */
3816 if ( i == nr ) {
3817
3818 /* print a comment */
3819 if ( CompPass == 2 ) {
3820 Emit( "\n/* else */\n" );
3821 }
3822
3823 /* emit the 'else' to connect this branch to the 'if' branch */
3824 Emit( "else {\n" );
3825
3826 /* this is what we know if we enter this branch */
3827 CopyInfoCVars( INFO_FEXP(CURR_FUNC()), info_in );
3828
3829 /* compile the body */
3830 CompStat(READ_STAT(stat, 2 * (i - 1) + 1));
3831
3832 /* remember what we know after executing one of the previous bodies*/
3833 MergeInfoCVars( info_out, INFO_FEXP(CURR_FUNC()) );
3834
3835 /* emit the rest code */
3836 Emit( "\n}\n" );
3837
3838 }
3839
3840 /* fake empty 'else' branch */
3841 else {
3842
3843 /* this is what we know if we enter this branch */
3844 CopyInfoCVars( INFO_FEXP(CURR_FUNC()), info_in );
3845
3846 /* remember what we know after executing one of the previous bodies*/
3847 MergeInfoCVars( info_out, INFO_FEXP(CURR_FUNC()) );
3848
3849 }
3850
3851 /* close all unbalanced parenthesis */
3852 for ( i = 2; i <= nr; i++ ) {
3853 if (i == nr && TNUM_EXPR(READ_STAT(stat, 2 * (i - 1))) == EXPR_TRUE)
3854 break;
3855 Emit( "}\n" );
3856 }
3857 Emit( "/* fi */\n" );
3858
3859 /* put what we know into the current info */
3860 CopyInfoCVars( INFO_FEXP(CURR_FUNC()), info_out );
3861
3862 }
3863
3864
3865 /****************************************************************************
3866 **
3867 *F CompFor( <stat> ) . . . . . . . STAT_FOR...STAT_FOR3/STAT_FOR_RANGE...STAT_FOR_RANGE3
3868 */
CompFor(Stat stat)3869 static void CompFor(Stat stat)
3870 {
3871 UInt var; /* loop variable */
3872 Char vart; /* variable type */
3873 CVar list; /* list to loop over */
3874 CVar islist; /* is the list a proper list */
3875 CVar first; /* first loop index */
3876 CVar last; /* last loop index */
3877 CVar lidx; /* loop index variable */
3878 CVar elm; /* element of list */
3879 Int pass; /* current pass */
3880 Bag prev; /* previous temp-info */
3881 Int i; /* loop variable */
3882
3883 /* handle 'for <lvar> in [<first>..<last>] do' */
3884 if ( IS_REF_LVAR( READ_STAT(stat, 0) )
3885 && ! CompGetUseHVar( LVAR_REF_LVAR( READ_STAT(stat, 0) ) )
3886 && TNUM_EXPR( READ_STAT(stat, 1) ) == EXPR_RANGE
3887 && SIZE_EXPR( READ_STAT(stat, 1) ) == 2*sizeof(Expr) ) {
3888
3889 /* print a comment */
3890 if ( CompPass == 2 ) {
3891 Emit( "\n/* for " );
3892 PrintExpr(READ_EXPR(stat, 0));
3893 Emit( " in " );
3894 PrintExpr(READ_EXPR(stat, 1));
3895 Emit( " do */\n" );
3896 }
3897
3898 /* get the local variable */
3899 var = LVAR_REF_LVAR(READ_STAT(stat, 0));
3900
3901 /* allocate a new temporary for the loop variable */
3902 lidx = CVAR_TEMP( NewTemp( "lidx" ) );
3903
3904 /* compile and check the first and last value */
3905 first = CompExpr(READ_EXPR(READ_STAT(stat, 1), 0));
3906 CompCheckIntSmall( first );
3907
3908 /* compile and check the last value */
3909 /* if the last value is in a local variable, */
3910 /* we must copy it into a temporary, */
3911 /* because the local variable may change its value in the body */
3912 last = CompExpr(READ_EXPR(READ_STAT(stat, 1), 1));
3913 CompCheckIntSmall( last );
3914 if ( IS_LVAR_CVAR(last) ) {
3915 elm = CVAR_TEMP( NewTemp( "last" ) );
3916 Emit( "%c = %c;\n", elm, last );
3917 last = elm;
3918 }
3919
3920 /* find the invariant temp-info */
3921 pass = CompPass;
3922 CompPass = 99;
3923 prev = NewInfoCVars();
3924 do {
3925 CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC()) );
3926 if ( HasInfoCVar( first, W_INT_SMALL_POS ) ) {
3927 SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL_POS );
3928 }
3929 else {
3930 SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL );
3931 }
3932 for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
3933 CompStat(READ_STAT(stat, i));
3934 }
3935 MergeInfoCVars( INFO_FEXP(CURR_FUNC()), prev );
3936 } while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC()), prev ) );
3937 CompPass = pass;
3938
3939 /* emit the code for the loop */
3940 Emit( "for ( %c = %c;\n", lidx, first );
3941 Emit( " ((Int)%c) <= ((Int)%c);\n", lidx, last );
3942 Emit( " %c = (Obj)(((UInt)%c)+4) ", lidx, lidx );
3943 Emit( ") {\n" );
3944
3945 /* emit the code to copy the loop index into the loop variable */
3946 Emit( "%c = %c;\n", CVAR_LVAR(var), lidx );
3947
3948 /* set what we know about the loop variable */
3949 if ( HasInfoCVar( first, W_INT_SMALL_POS ) ) {
3950 SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL_POS );
3951 }
3952 else {
3953 SetInfoCVar( CVAR_LVAR(var), W_INT_SMALL );
3954 }
3955
3956 /* compile the body */
3957 for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
3958 CompStat(READ_STAT(stat, i));
3959 }
3960
3961 /* emit the end code */
3962 Emit( "\n}\n" );
3963 Emit( "/* od */\n" );
3964
3965 /* free the temporaries */
3966 if ( IS_TEMP_CVAR( last ) ) FreeTemp( TEMP_CVAR( last ) );
3967 if ( IS_TEMP_CVAR( first ) ) FreeTemp( TEMP_CVAR( first ) );
3968 if ( IS_TEMP_CVAR( lidx ) ) FreeTemp( TEMP_CVAR( lidx ) );
3969
3970 }
3971
3972 /* handle other loops */
3973 else {
3974
3975 /* print a comment */
3976 if ( CompPass == 2 ) {
3977 Emit( "\n/* for " );
3978 PrintExpr(READ_EXPR(stat, 0));
3979 Emit( " in " );
3980 PrintExpr(READ_EXPR(stat, 1));
3981 Emit( " do */\n" );
3982 }
3983
3984 /* get the variable (initialize them first to please 'lint') */
3985 if ( IS_REF_LVAR( READ_STAT(stat, 0) )
3986 && ! CompGetUseHVar( LVAR_REF_LVAR( READ_STAT(stat, 0) ) ) ) {
3987 var = LVAR_REF_LVAR( READ_STAT(stat, 0) );
3988 vart = 'l';
3989 }
3990 else if (IS_REF_LVAR(READ_STAT(stat, 0))) {
3991 var = LVAR_REF_LVAR(READ_STAT(stat, 0));
3992 vart = 'm';
3993 }
3994 else if (TNUM_EXPR(READ_STAT(stat, 0)) == EXPR_REF_HVAR) {
3995 var = READ_EXPR(READ_STAT(stat, 0), 0);
3996 vart = 'h';
3997 }
3998 else /* if ( TNUM_EXPR( READ_STAT(stat, 0) ) == EXPR_REF_GVAR ) */ {
3999 var = READ_EXPR(READ_STAT(stat, 0), 0);
4000 CompSetUseGVar( var, COMP_USE_GVAR_ID );
4001 vart = 'g';
4002 }
4003
4004 /* allocate a new temporary for the loop variable */
4005 lidx = CVAR_TEMP( NewTemp( "lidx" ) );
4006 elm = CVAR_TEMP( NewTemp( "elm" ) );
4007 islist = CVAR_TEMP( NewTemp( "islist" ) );
4008
4009 /* compile and check the first and last value */
4010 list = CompExpr(READ_STAT(stat, 1));
4011
4012 /* SL Patch added to try and avoid a bug */
4013 if (IS_LVAR_CVAR(list))
4014 {
4015 CVar copylist;
4016 copylist = CVAR_TEMP( NewTemp( "copylist" ) );
4017 Emit("%c = %c;\n",copylist, list);
4018 list = copylist;
4019 }
4020 /* end of SL patch */
4021
4022 /* find the invariant temp-info */
4023 pass = CompPass;
4024 CompPass = 99;
4025 prev = NewInfoCVars();
4026 do {
4027 CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC()) );
4028 if ( vart == 'l' ) {
4029 SetInfoCVar( CVAR_LVAR(var), W_BOUND );
4030 }
4031 for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
4032 CompStat(READ_STAT(stat, i));
4033 }
4034 MergeInfoCVars( INFO_FEXP(CURR_FUNC()), prev );
4035 } while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC()), prev ) );
4036 CompPass = pass;
4037
4038 /* emit the code for the loop */
4039 /* (plenty ugly because of iterator handling) */
4040 Emit( "if ( IS_SMALL_LIST(%c) ) {\n", list );
4041 Emit( "%c = (Obj)(UInt)1;\n", islist );
4042 Emit( "%c = INTOBJ_INT(1);\n", lidx );
4043 Emit( "}\n" );
4044 Emit( "else {\n" );
4045 Emit( "%c = (Obj)(UInt)0;\n", islist );
4046 Emit( "%c = CALL_1ARGS( GF_ITERATOR, %c );\n", lidx, list );
4047 Emit( "}\n" );
4048 Emit( "while ( 1 ) {\n" );
4049 Emit( "if ( %c ) {\n", islist );
4050 Emit( "if ( LEN_LIST(%c) < %i ) break;\n", list, lidx );
4051 Emit( "%c = ELMV0_LIST( %c, %i );\n", elm, list, lidx );
4052 Emit( "%c = (Obj)(((UInt)%c)+4);\n", lidx, lidx );
4053 Emit( "if ( %c == 0 ) continue;\n", elm );
4054 Emit( "}\n" );
4055 Emit( "else {\n" );
4056 Emit( "if ( CALL_1ARGS( GF_IS_DONE_ITER, %c ) != False ) break;\n",
4057 lidx );
4058 Emit( "%c = CALL_1ARGS( GF_NEXT_ITER, %c );\n", elm, lidx );
4059 Emit( "}\n" );
4060
4061 /* emit the code to copy the loop index into the loop variable */
4062 if ( vart == 'l' ) {
4063 Emit( "%c = %c;\n",
4064 CVAR_LVAR(var), elm );
4065 }
4066 else if ( vart == 'm' ) {
4067 Emit( "ASS_LVAR( %d, %c );\n",
4068 GetIndxHVar(var), elm );
4069 }
4070 else if ( vart == 'h' ) {
4071 Emit( "ASS_HVAR( (%d << 16) | %d, %c );\n",
4072 GetLevlHVar(var), GetIndxHVar(var), elm );
4073 }
4074 else if ( vart == 'g' ) {
4075 Emit( "AssGVar( G_%n, %c );\n",
4076 NameGVar(var), elm );
4077 }
4078
4079 /* set what we know about the loop variable */
4080 if ( vart == 'l' ) {
4081 SetInfoCVar( CVAR_LVAR(var), W_BOUND );
4082 }
4083
4084 /* compile the body */
4085 for ( i = 2; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
4086 CompStat(READ_STAT(stat, i));
4087 }
4088
4089 /* emit the end code */
4090 Emit( "\n}\n" );
4091 Emit( "/* od */\n" );
4092
4093 /* free the temporaries */
4094 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
4095 if ( IS_TEMP_CVAR( islist ) ) FreeTemp( TEMP_CVAR( islist ) );
4096 if ( IS_TEMP_CVAR( elm ) ) FreeTemp( TEMP_CVAR( elm ) );
4097 if ( IS_TEMP_CVAR( lidx ) ) FreeTemp( TEMP_CVAR( lidx ) );
4098
4099 }
4100
4101 }
4102
4103
4104 /****************************************************************************
4105 **
4106 *F CompWhile( <stat> ) . . . . . . . . . . . . . . . . . STAT_WHILE...STAT_WHILE3
4107 */
CompWhile(Stat stat)4108 static void CompWhile(Stat stat)
4109 {
4110 CVar cond; /* condition */
4111 Int pass; /* current pass */
4112 Bag prev; /* previous temp-info */
4113 UInt i; /* loop variable */
4114
4115 /* find an invariant temp-info */
4116 /* the emits are probably not needed */
4117 pass = CompPass;
4118 CompPass = 99;
4119 Emit( "while ( 1 ) {\n" );
4120 prev = NewInfoCVars();
4121 do {
4122 CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC()) );
4123 cond = CompBoolExpr(READ_STAT(stat, 0));
4124 Emit( "if ( ! %c ) break;\n", cond );
4125 if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );
4126 for ( i = 1; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
4127 CompStat(READ_STAT(stat, i));
4128 }
4129 MergeInfoCVars( INFO_FEXP(CURR_FUNC()), prev );
4130 } while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC()), prev ) );
4131 Emit( "}\n" );
4132 CompPass = pass;
4133
4134 /* print a comment */
4135 if ( CompPass == 2 ) {
4136 Emit( "\n/* while " );
4137 PrintExpr(READ_EXPR(stat, 0));
4138 Emit( " do */\n" );
4139 }
4140
4141 /* emit the code for the loop */
4142 Emit( "while ( 1 ) {\n" );
4143
4144 /* compile the condition */
4145 cond = CompBoolExpr(READ_STAT(stat, 0));
4146 Emit( "if ( ! %c ) break;\n", cond );
4147 if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );
4148
4149 /* compile the body */
4150 for ( i = 1; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
4151 CompStat(READ_STAT(stat, i));
4152 }
4153
4154 /* thats it */
4155 Emit( "\n}\n" );
4156 Emit( "/* od */\n" );
4157
4158 }
4159
4160
4161 /****************************************************************************
4162 **
4163 *F CompRepeat( <stat> ) . . . . . . . . . . . . . . . STAT_REPEAT...STAT_REPEAT3
4164 */
CompRepeat(Stat stat)4165 static void CompRepeat(Stat stat)
4166 {
4167 CVar cond; /* condition */
4168 Int pass; /* current pass */
4169 Bag prev; /* previous temp-info */
4170 UInt i; /* loop variable */
4171
4172 /* find an invariant temp-info */
4173 /* the emits are probably not needed */
4174 pass = CompPass;
4175 CompPass = 99;
4176 Emit( "do {\n" );
4177 prev = NewInfoCVars();
4178 do {
4179 CopyInfoCVars( prev, INFO_FEXP(CURR_FUNC()) );
4180 for ( i = 1; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
4181 CompStat(READ_STAT(stat, i));
4182 }
4183 cond = CompBoolExpr(READ_STAT(stat, 0));
4184 Emit( "if ( %c ) break;\n", cond );
4185 if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );
4186 MergeInfoCVars( INFO_FEXP(CURR_FUNC()), prev );
4187 } while ( ! IsEqInfoCVars( INFO_FEXP(CURR_FUNC()), prev ) );
4188 Emit( "} while ( 1 );\n" );
4189 CompPass = pass;
4190
4191 /* print a comment */
4192 if ( CompPass == 2 ) {
4193 Emit( "\n/* repeat */\n" );
4194 }
4195
4196 /* emit the code for the loop */
4197 Emit( "do {\n" );
4198
4199 /* compile the body */
4200 for ( i = 1; i < SIZE_STAT(stat)/sizeof(Stat); i++ ) {
4201 CompStat(READ_STAT(stat, i));
4202 }
4203
4204 /* print a comment */
4205 if ( CompPass == 2 ) {
4206 Emit( "\n/* until " );
4207 PrintExpr(READ_EXPR(stat, 0));
4208 Emit( " */\n" );
4209 }
4210
4211 /* compile the condition */
4212 cond = CompBoolExpr(READ_STAT(stat, 0));
4213 Emit( "if ( %c ) break;\n", cond );
4214 if ( IS_TEMP_CVAR( cond ) ) FreeTemp( TEMP_CVAR( cond ) );
4215
4216 /* thats it */
4217 Emit( "} while ( 1 );\n" );
4218 }
4219
4220
4221 /****************************************************************************
4222 **
4223 *F CompBreak( <stat> ) . . . . . . . . . . . . . . . . . . . . . . . STAT_BREAK
4224 */
CompBreak(Stat stat)4225 static void CompBreak(Stat stat)
4226 {
4227 /* print a comment */
4228 if ( CompPass == 2 ) {
4229 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4230 }
4231
4232 Emit( "break;\n" );
4233 }
4234
4235 /****************************************************************************
4236 **
4237 *F CompContinue( <stat> ) . . . . . . . . . . . . . . . . . . . . STAT_CONTINUE
4238 */
CompContinue(Stat stat)4239 static void CompContinue(Stat stat)
4240 {
4241 /* print a comment */
4242 if ( CompPass == 2 ) {
4243 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4244 }
4245
4246 Emit( "continue;\n" );
4247 }
4248
4249
4250 /****************************************************************************
4251 **
4252 *F CompReturnObj( <stat> ) . . . . . . . . . . . . . . . . . . STAT_RETURN_OBJ
4253 */
CompReturnObj(Stat stat)4254 static void CompReturnObj(Stat stat)
4255 {
4256 CVar obj; /* returned object */
4257
4258 /* print a comment */
4259 if ( CompPass == 2 ) {
4260 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4261 }
4262
4263 /* compile the expression */
4264 obj = CompExpr(READ_STAT(stat, 0));
4265
4266 /* emit code to remove stack frame */
4267 Emit( "SWITCH_TO_OLD_FRAME(oldFrame);\n" );
4268
4269 /* emit code to return from function */
4270 Emit( "return %c;\n", obj );
4271
4272 /* free the temporary */
4273 if ( IS_TEMP_CVAR( obj ) ) FreeTemp( TEMP_CVAR( obj ) );
4274 }
4275
4276
4277 /****************************************************************************
4278 **
4279 *F CompReturnVoid( <stat> ) . . . . . . . . . . . . . . . . . STAT_RETURN_VOID
4280 */
CompReturnVoid(Stat stat)4281 static void CompReturnVoid(Stat stat)
4282 {
4283 /* print a comment */
4284 if ( CompPass == 2 ) {
4285 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4286 }
4287
4288 /* emit code to remove stack frame */
4289 Emit( "SWITCH_TO_OLD_FRAME(oldFrame);\n" );
4290
4291 /* emit code to return from function */
4292 Emit( "return 0;\n" );
4293 }
4294
4295
4296 /****************************************************************************
4297 **
4298 *F CompAssLVar( <stat> ) . . . . . . . . . . . . STAT_ASS_LVAR...T_ASS_LVAR_16
4299 */
CompAssLVar(Stat stat)4300 static void CompAssLVar(Stat stat)
4301 {
4302 LVar lvar; /* local variable */
4303 CVar rhs; /* right hand side */
4304
4305 /* print a comment */
4306 if ( CompPass == 2 ) {
4307 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4308 }
4309
4310 /* compile the right hand side expression */
4311 rhs = CompExpr(READ_STAT(stat, 1));
4312
4313 /* emit the code for the assignment */
4314 lvar = (LVar)(READ_STAT(stat, 0));
4315 if ( CompGetUseHVar( lvar ) ) {
4316 Emit( "ASS_LVAR( %d, %c );\n", GetIndxHVar(lvar), rhs );
4317 }
4318 else {
4319 Emit( "%c = %c;\n", CVAR_LVAR(lvar), rhs );
4320 SetInfoCVar( CVAR_LVAR(lvar), GetInfoCVar( rhs ) );
4321 }
4322
4323 /* free the temporary */
4324 if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );
4325 }
4326
4327
4328 /****************************************************************************
4329 **
4330 *F CompUnbLVar( <stat> ) . . . . . . . . . . . . . . . . . . . . STAT_UNB_LVAR
4331 */
CompUnbLVar(Stat stat)4332 static void CompUnbLVar(Stat stat)
4333 {
4334 LVar lvar; /* local variable */
4335
4336 /* print a comment */
4337 if ( CompPass == 2 ) {
4338 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4339 }
4340
4341 /* emit the code for the assignment */
4342 lvar = (LVar)(READ_STAT(stat, 0));
4343 if ( CompGetUseHVar( lvar ) ) {
4344 Emit( "ASS_LVAR( %d, 0 );\n", GetIndxHVar(lvar) );
4345 }
4346 else {
4347 Emit( "%c = 0;\n", CVAR_LVAR( lvar ) );
4348 SetInfoCVar( lvar, W_UNBOUND );
4349 }
4350 }
4351
4352
4353 /****************************************************************************
4354 **
4355 *F CompAssHVar( <stat> ) . . . . . . . . . . . . . . . . . . . . STAT_ASS_HVAR
4356 */
CompAssHVar(Stat stat)4357 static void CompAssHVar(Stat stat)
4358 {
4359 HVar hvar; /* higher variable */
4360 CVar rhs; /* right hand side */
4361
4362 /* print a comment */
4363 if ( CompPass == 2 ) {
4364 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4365 }
4366
4367 /* compile the right hand side expression */
4368 rhs = CompExpr(READ_STAT(stat, 1));
4369
4370 /* emit the code for the assignment */
4371 hvar = (HVar)(READ_STAT(stat, 0));
4372 CompSetUseHVar( hvar );
4373 Emit( "ASS_HVAR( (%d << 16) | %d, %c );\n",
4374 GetLevlHVar(hvar), GetIndxHVar(hvar), rhs );
4375
4376 /* free the temporary */
4377 if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );
4378 }
4379
4380
4381 /****************************************************************************
4382 **
4383 *F CompUnbHVar( <stat> ) . . . . . . . . . . . . . . . . . . . . STAT_UNB_HVAR
4384 */
CompUnbHVar(Stat stat)4385 static void CompUnbHVar(Stat stat)
4386 {
4387 HVar hvar; /* higher variable */
4388
4389 /* print a comment */
4390 if ( CompPass == 2 ) {
4391 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4392 }
4393
4394 /* emit the code for the assignment */
4395 hvar = (HVar)(READ_STAT(stat, 0));
4396 CompSetUseHVar( hvar );
4397 Emit( "ASS_HVAR( (%d << 16) | %d, 0 );\n",
4398 GetLevlHVar(hvar), GetIndxHVar(hvar) );
4399 }
4400
4401
4402 /****************************************************************************
4403 **
4404 *F CompAssGVar( <stat> ) . . . . . . . . . . . . . . . . . . . . STAT_ASS_GVAR
4405 */
CompAssGVar(Stat stat)4406 static void CompAssGVar(Stat stat)
4407 {
4408 GVar gvar; /* global variable */
4409 CVar rhs; /* right hand side */
4410
4411 /* print a comment */
4412 if ( CompPass == 2 ) {
4413 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4414 }
4415
4416 /* compile the right hand side expression */
4417 rhs = CompExpr(READ_STAT(stat, 1));
4418
4419 /* emit the code for the assignment */
4420 gvar = (GVar)(READ_STAT(stat, 0));
4421 CompSetUseGVar( gvar, COMP_USE_GVAR_ID );
4422 Emit( "AssGVar( G_%n, %c );\n", NameGVar(gvar), rhs );
4423
4424 /* free the temporary */
4425 if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );
4426 }
4427
4428
4429 /****************************************************************************
4430 **
4431 *F CompUnbGVar( <stat> ) . . . . . . . . . . . . . . . . . . . . STAT_UNB_GVAR
4432 */
CompUnbGVar(Stat stat)4433 static void CompUnbGVar(Stat stat)
4434 {
4435 GVar gvar; /* global variable */
4436
4437 /* print a comment */
4438 if ( CompPass == 2 ) {
4439 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4440 }
4441
4442 /* emit the code for the assignment */
4443 gvar = (GVar)(READ_STAT(stat, 0));
4444 CompSetUseGVar( gvar, COMP_USE_GVAR_ID );
4445 Emit( "AssGVar( G_%n, 0 );\n", NameGVar(gvar) );
4446 }
4447
4448
4449 /****************************************************************************
4450 **
4451 *F CompAssList( <stat> ) . . . . . . . . . . . . . . . . . . . . STAT_ASS_LIST
4452 */
CompAssList(Stat stat)4453 static void CompAssList(Stat stat)
4454 {
4455 CVar list; /* list */
4456 CVar pos; /* position */
4457 CVar rhs; /* right hand side */
4458
4459 /* print a comment */
4460 if ( CompPass == 2 ) {
4461 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4462 }
4463
4464 /* compile the list expression */
4465 list = CompExpr(READ_STAT(stat, 0));
4466
4467 /* compile and check the position expression */
4468 pos = CompExpr(READ_STAT(stat, 1));
4469 CompCheckIntPos( pos );
4470
4471 /* compile the right hand side */
4472 rhs = CompExpr(READ_STAT(stat, 2));
4473
4474 /* emit the code */
4475 if ( CompFastPlainLists ) {
4476 if ( HasInfoCVar( rhs, W_INT_SMALL ) ) {
4477 Emit( "C_ASS_LIST_FPL_INTOBJ( %c, %c, %c )\n", list, pos, rhs );
4478 }
4479 else {
4480 Emit( "C_ASS_LIST_FPL( %c, %c, %c )\n", list, pos, rhs );
4481 }
4482 }
4483 else {
4484 Emit( "C_ASS_LIST( %c, %c, %c );\n", list, pos, rhs );
4485 }
4486
4487 /* free the temporaries */
4488 if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );
4489 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
4490 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
4491 }
4492
4493
4494 /****************************************************************************
4495 **
4496 *F CompAsssList( <stat> ) . . . . . . . . . . . . . . . . . . . STAT_ASSS_LIST
4497 */
CompAsssList(Stat stat)4498 static void CompAsssList(Stat stat)
4499 {
4500 CVar list; /* list */
4501 CVar poss; /* positions */
4502 CVar rhss; /* right hand sides */
4503
4504 /* print a comment */
4505 if ( CompPass == 2 ) {
4506 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4507 }
4508
4509 /* compile the list expression */
4510 list = CompExpr(READ_STAT(stat, 0));
4511
4512 /* compile and check the position expression */
4513 poss = CompExpr(READ_STAT(stat, 1));
4514
4515 /* compile the right hand side */
4516 rhss = CompExpr(READ_STAT(stat, 2));
4517
4518 /* emit the code */
4519 Emit( "AsssListCheck( %c, %c, %c );\n", list, poss, rhss );
4520
4521 /* free the temporaries */
4522 if ( IS_TEMP_CVAR( rhss ) ) FreeTemp( TEMP_CVAR( rhss ) );
4523 if ( IS_TEMP_CVAR( poss ) ) FreeTemp( TEMP_CVAR( poss ) );
4524 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
4525 }
4526
4527
4528 /****************************************************************************
4529 **
4530 *F CompAssListLev( <stat> ) . . . . . . . . . . . . . . . . STAT_ASS_LIST_LEV
4531 */
CompAssListLev(Stat stat)4532 static void CompAssListLev(Stat stat)
4533 {
4534 CVar lists; /* lists */
4535 CVar pos; /* position */
4536 CVar rhss; /* right hand sides */
4537 UInt level; /* level */
4538
4539 /* print a comment */
4540 if ( CompPass == 2 ) {
4541 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4542 }
4543
4544 /* compile the list expressions */
4545 lists = CompExpr(READ_STAT(stat, 0));
4546
4547 /* compile and check the position expression */
4548 pos = CompExpr(READ_STAT(stat, 1));
4549 CompCheckIntSmallPos( pos );
4550
4551 /* compile the right hand sides */
4552 rhss = CompExpr(READ_STAT(stat, 2));
4553
4554 /* get the level */
4555 level = READ_STAT(stat, 3);
4556
4557 /* emit the code */
4558 Emit( "AssListLevel( %c, %c, %c, %d );\n", lists, pos, rhss, level );
4559
4560 /* free the temporaries */
4561 if ( IS_TEMP_CVAR( rhss ) ) FreeTemp( TEMP_CVAR( rhss ) );
4562 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
4563 if ( IS_TEMP_CVAR( lists ) ) FreeTemp( TEMP_CVAR( lists ) );
4564 }
4565
4566
4567 /****************************************************************************
4568 **
4569 *F CompAsssListLev( <stat> ) . . . . . . . . . . . . . . . . STAT_ASSS_LIST_LEV
4570 */
CompAsssListLev(Stat stat)4571 static void CompAsssListLev(Stat stat)
4572 {
4573 CVar lists; /* list */
4574 CVar poss; /* positions */
4575 CVar rhss; /* right hand sides */
4576 UInt level; /* level */
4577
4578 /* print a comment */
4579 if ( CompPass == 2 ) {
4580 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4581 }
4582
4583 /* compile the list expressions */
4584 lists = CompExpr(READ_STAT(stat, 0));
4585
4586 /* compile and check the position expression */
4587 poss = CompExpr(READ_STAT(stat, 1));
4588
4589 /* compile the right hand side */
4590 rhss = CompExpr(READ_STAT(stat, 2));
4591
4592 /* get the level */
4593 level = READ_STAT(stat, 3);
4594
4595 /* emit the code */
4596 Emit( "AsssListLevelCheck( %c, %c, %c, %d );\n",
4597 lists, poss, rhss, level );
4598
4599 /* free the temporaries */
4600 if ( IS_TEMP_CVAR( rhss ) ) FreeTemp( TEMP_CVAR( rhss ) );
4601 if ( IS_TEMP_CVAR( poss ) ) FreeTemp( TEMP_CVAR( poss ) );
4602 if ( IS_TEMP_CVAR( lists ) ) FreeTemp( TEMP_CVAR( lists ) );
4603 }
4604
4605
4606 /****************************************************************************
4607 **
4608 *F CompUnbList( <stat> ) . . . . . . . . . . . . . . . . . . . . STAT_UNB_LIST
4609 */
CompUnbList(Stat stat)4610 static void CompUnbList(Stat stat)
4611 {
4612 CVar list; /* list, left operand */
4613 CVar pos; /* position, left operand */
4614
4615 /* print a comment */
4616 if ( CompPass == 2 ) {
4617 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4618 }
4619
4620 /* compile the list expression */
4621 list = CompExpr(READ_STAT(stat, 0));
4622
4623 /* compile and check the position expression */
4624 pos = CompExpr(READ_STAT(stat, 1));
4625 CompCheckIntPos( pos );
4626
4627 /* emit the code */
4628 Emit( "C_UNB_LIST( %c, %c );\n", list, pos );
4629
4630 /* free the temporaries */
4631 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
4632 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
4633 }
4634
4635
4636 /****************************************************************************
4637 **
4638 *F CompAssRecName( <stat> ) . . . . . . . . . . . . . . . . STAT_ASS_REC_NAME
4639 */
CompAssRecName(Stat stat)4640 static void CompAssRecName(Stat stat)
4641 {
4642 CVar record; /* record, left operand */
4643 UInt rnam; /* name, left operand */
4644 CVar rhs; /* rhs, right operand */
4645
4646 /* print a comment */
4647 if ( CompPass == 2 ) {
4648 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4649 }
4650
4651 /* compile the record expression */
4652 record = CompExpr(READ_STAT(stat, 0));
4653
4654 /* get the name (stored immediately in the statement) */
4655 rnam = READ_STAT(stat, 1);
4656 CompSetUseRNam( rnam, COMP_USE_RNAM_ID );
4657
4658 /* compile the right hand side */
4659 rhs = CompExpr(READ_STAT(stat, 2));
4660
4661 /* emit the code for the assignment */
4662 Emit( "ASS_REC( %c, R_%n, %c );\n", record, NAME_RNAM(rnam), rhs );
4663
4664 /* free the temporaries */
4665 if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );
4666 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
4667 }
4668
4669
4670 /****************************************************************************
4671 **
4672 *F CompAssRecExpr( <stat> ) . . . . . . . . . . . . . . . . STAT_ASS_REC_EXPR
4673 */
CompAssRecExpr(Stat stat)4674 static void CompAssRecExpr(Stat stat)
4675 {
4676 CVar record; /* record, left operand */
4677 CVar rnam; /* name, left operand */
4678 CVar rhs; /* rhs, right operand */
4679
4680 /* print a comment */
4681 if ( CompPass == 2 ) {
4682 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4683 }
4684
4685 /* compile the record expression */
4686 record = CompExpr(READ_STAT(stat, 0));
4687
4688 /* get the name (stored immediately in the statement) */
4689 rnam = CompExpr(READ_STAT(stat, 1));
4690
4691 /* compile the right hand side */
4692 rhs = CompExpr(READ_STAT(stat, 2));
4693
4694 /* emit the code for the assignment */
4695 Emit( "ASS_REC( %c, RNamObj(%c), %c );\n", record, rnam, rhs );
4696
4697 /* free the temporaries */
4698 if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );
4699 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
4700 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
4701 }
4702
4703
4704 /****************************************************************************
4705 **
4706 *F CompUnbRecName( <stat> ) . . . . . . . . . . . . . . . . STAT_UNB_REC_NAME
4707 */
CompUnbRecName(Stat stat)4708 static void CompUnbRecName(Stat stat)
4709 {
4710 CVar record; /* record, left operand */
4711 UInt rnam; /* name, left operand */
4712
4713 /* print a comment */
4714 if ( CompPass == 2 ) {
4715 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4716 }
4717
4718 /* compile the record expression */
4719 record = CompExpr(READ_STAT(stat, 0));
4720
4721 /* get the name (stored immediately in the statement) */
4722 rnam = READ_STAT(stat, 1);
4723 CompSetUseRNam( rnam, COMP_USE_RNAM_ID );
4724
4725 /* emit the code for the assignment */
4726 Emit( "UNB_REC( %c, R_%n );\n", record, NAME_RNAM(rnam) );
4727
4728 /* free the temporaries */
4729 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
4730 }
4731
4732
4733 /****************************************************************************
4734 **
4735 *F CompUnbRecExpr( <stat> ) . . . . . . . . . . . . . . . . STAT_UNB_REC_EXPR
4736 */
CompUnbRecExpr(Stat stat)4737 static void CompUnbRecExpr(Stat stat)
4738 {
4739 CVar record; /* record, left operand */
4740 CVar rnam; /* name, left operand */
4741
4742 /* print a comment */
4743 if ( CompPass == 2 ) {
4744 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4745 }
4746
4747 /* compile the record expression */
4748 record = CompExpr(READ_STAT(stat, 0));
4749
4750 /* get the name expression */
4751 rnam = CompExpr(READ_STAT(stat, 1));
4752
4753 /* emit the code for the assignment */
4754 Emit( "UNB_REC( %c, RNamObj(%c) );\n", record, rnam );
4755
4756 /* free the temporaries */
4757 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
4758 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
4759 }
4760
4761
4762 /****************************************************************************
4763 **
4764 *F CompAssPosObj( <stat> ) . . . . . . . . . . . . . . . . . . STAT_ASS_POSOBJ
4765 */
CompAssPosObj(Stat stat)4766 static void CompAssPosObj(Stat stat)
4767 {
4768 CVar list; /* list */
4769 CVar pos; /* position */
4770 CVar rhs; /* right hand side */
4771
4772 /* print a comment */
4773 if ( CompPass == 2 ) {
4774 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4775 }
4776
4777 /* compile the list expression */
4778 list = CompExpr(READ_STAT(stat, 0));
4779
4780 /* compile and check the position expression */
4781 pos = CompExpr(READ_STAT(stat, 1));
4782 CompCheckIntSmallPos( pos );
4783
4784 /* compile the right hand side */
4785 rhs = CompExpr(READ_STAT(stat, 2));
4786
4787 /* emit the code */
4788 Emit( "AssPosObj( %c, %i, %c );\n", list, pos, rhs );
4789
4790 /* free the temporaries */
4791 if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );
4792 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
4793 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
4794 }
4795
4796
4797 /****************************************************************************
4798 **
4799 *F CompUnbPosObj( <stat> ) . . . . . . . . . . . . . . . . . . STAT_UNB_POSOBJ
4800 */
CompUnbPosObj(Stat stat)4801 static void CompUnbPosObj(Stat stat)
4802 {
4803 CVar list; /* list, left operand */
4804 CVar pos; /* position, left operand */
4805
4806 /* print a comment */
4807 if ( CompPass == 2 ) {
4808 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4809 }
4810
4811 /* compile the list expression */
4812 list = CompExpr(READ_STAT(stat, 0));
4813
4814 /* compile and check the position expression */
4815 pos = CompExpr(READ_STAT(stat, 1));
4816 CompCheckIntSmallPos( pos );
4817
4818 /* emit the code */
4819 Emit( "UnbPosObj( %c, %i );\n", list, pos );
4820
4821 /* free the temporaries */
4822 if ( IS_TEMP_CVAR( pos ) ) FreeTemp( TEMP_CVAR( pos ) );
4823 if ( IS_TEMP_CVAR( list ) ) FreeTemp( TEMP_CVAR( list ) );
4824 }
4825
4826
4827 /****************************************************************************
4828 **
4829 *F CompAssComObjName( <stat> ) . . . . . . . . . . . . . . STAT_ASS_COMOBJ_NAME
4830 */
CompAssComObjName(Stat stat)4831 static void CompAssComObjName(Stat stat)
4832 {
4833 CVar record; /* record, left operand */
4834 UInt rnam; /* name, left operand */
4835 CVar rhs; /* rhs, right operand */
4836
4837 /* print a comment */
4838 if ( CompPass == 2 ) {
4839 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4840 }
4841
4842 /* compile the record expression */
4843 record = CompExpr(READ_STAT(stat, 0));
4844
4845 /* get the name (stored immediately in the statement) */
4846 rnam = READ_STAT(stat, 1);
4847 CompSetUseRNam( rnam, COMP_USE_RNAM_ID );
4848
4849 /* compile the right hand side */
4850 rhs = CompExpr(READ_STAT(stat, 2));
4851
4852 /* emit the code for the assignment */
4853 Emit( "AssComObj( %c, R_%n, %c );\n", record, NAME_RNAM(rnam), rhs );
4854
4855 /* free the temporaries */
4856 if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );
4857 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
4858 }
4859
4860
4861 /****************************************************************************
4862 **
4863 *F CompAssComObjExpr( <stat> ) . . . . . . . . . . . . . . STAT_ASS_COMOBJ_EXPR
4864 */
CompAssComObjExpr(Stat stat)4865 static void CompAssComObjExpr(Stat stat)
4866 {
4867 CVar record; /* record, left operand */
4868 CVar rnam; /* name, left operand */
4869 CVar rhs; /* rhs, right operand */
4870
4871 /* print a comment */
4872 if ( CompPass == 2 ) {
4873 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4874 }
4875
4876 /* compile the record expression */
4877 record = CompExpr(READ_STAT(stat, 0));
4878
4879 /* get the name (stored immediately in the statement) */
4880 rnam = CompExpr(READ_STAT(stat, 1));
4881
4882 /* compile the right hand side */
4883 rhs = CompExpr(READ_STAT(stat, 2));
4884
4885 /* emit the code for the assignment */
4886 Emit( "AssComObj( %c, RNamObj(%c), %c );\n", record, rnam, rhs );
4887
4888 /* free the temporaries */
4889 if ( IS_TEMP_CVAR( rhs ) ) FreeTemp( TEMP_CVAR( rhs ) );
4890 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
4891 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
4892 }
4893
4894
4895 /****************************************************************************
4896 **
4897 *F CompUnbComObjName( <stat> ) . . . . . . . . . . . . . . STAT_UNB_COMOBJ_NAME
4898 */
CompUnbComObjName(Stat stat)4899 static void CompUnbComObjName(Stat stat)
4900 {
4901 CVar record; /* record, left operand */
4902 UInt rnam; /* name, left operand */
4903
4904 /* print a comment */
4905 if ( CompPass == 2 ) {
4906 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4907 }
4908
4909 /* compile the record expression */
4910 record = CompExpr(READ_STAT(stat, 0));
4911
4912 /* get the name (stored immediately in the statement) */
4913 rnam = READ_STAT(stat, 1);
4914 CompSetUseRNam( rnam, COMP_USE_RNAM_ID );
4915
4916 /* emit the code for the assignment */
4917 Emit( "UnbComObj( %c, R_%n );\n", record, NAME_RNAM(rnam) );
4918
4919 /* free the temporaries */
4920 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
4921 }
4922
4923
4924 /****************************************************************************
4925 **
4926 *F CompUnbComObjExpr( <stat> ) . . . . . . . . . . . . . . STAT_UNB_COMOBJ_EXPR
4927 */
CompUnbComObjExpr(Stat stat)4928 static void CompUnbComObjExpr(Stat stat)
4929 {
4930 CVar record; /* record, left operand */
4931 UInt rnam; /* name, left operand */
4932
4933 /* print a comment */
4934 if ( CompPass == 2 ) {
4935 Emit( "\n/* " ); PrintStat( stat ); Emit( " */\n" );
4936 }
4937
4938 /* compile the record expression */
4939 record = CompExpr(READ_STAT(stat, 0));
4940
4941 /* get the name expression */
4942 rnam = CompExpr(READ_STAT(stat, 1));
4943
4944 /* emit the code for the assignment */
4945 Emit( "UnbComObj( %c, RNamObj(%c) );\n", record, rnam );
4946
4947 /* free the temporaries */
4948 if ( IS_TEMP_CVAR( rnam ) ) FreeTemp( TEMP_CVAR( rnam ) );
4949 if ( IS_TEMP_CVAR( record ) ) FreeTemp( TEMP_CVAR( record ) );
4950 }
4951
4952 /****************************************************************************
4953 **
4954 *F CompEmpty( <stat> ) . . . . . . . . . . . . . . . . . . . . . . . T_EMPY
4955 */
CompEmpty(Stat stat)4956 static void CompEmpty(Stat stat)
4957 {
4958 // do nothing
4959 }
4960
4961 /****************************************************************************
4962 **
4963 *F CompInfo( <stat> ) . . . . . . . . . . . . . . . . . . . . . . . STAT_INFO
4964 */
CompInfo(Stat stat)4965 static void CompInfo(Stat stat)
4966 {
4967 CVar tmp;
4968 CVar sel;
4969 CVar lev;
4970 CVar lst;
4971 Int narg;
4972 Int i;
4973
4974 Emit( "\n/* Info( ... ); */\n" );
4975 sel = CompExpr( ARGI_INFO( stat, 1 ) );
4976 lev = CompExpr( ARGI_INFO( stat, 2 ) );
4977 lst = CVAR_TEMP( NewTemp( "lst" ) );
4978 tmp = CVAR_TEMP( NewTemp( "tmp" ) );
4979 Emit( "%c = InfoCheckLevel( %c, %c );\n", tmp, sel, lev );
4980 Emit( "if ( %c == True ) {\n", tmp );
4981 if ( IS_TEMP_CVAR( tmp ) ) FreeTemp( TEMP_CVAR( tmp ) );
4982 narg = NARG_SIZE_INFO(SIZE_STAT(stat))-2;
4983 Emit( "%c = NEW_PLIST( T_PLIST, %d );\n", lst, narg );
4984 Emit( "SET_LEN_PLIST( %c, %d );\n", lst, narg );
4985 for ( i = 1; i <= narg; i++ ) {
4986 tmp = CompExpr( ARGI_INFO( stat, i+2 ) );
4987 Emit( "SET_ELM_PLIST( %c, %d, %c );\n", lst, i, tmp );
4988 Emit( "CHANGED_BAG(%c);\n", lst );
4989 if ( IS_TEMP_CVAR( tmp ) ) FreeTemp( TEMP_CVAR( tmp ) );
4990 }
4991 Emit( "InfoDoPrint( %c, %c, %c );\n", sel, lev, lst );
4992 Emit( "}\n" );
4993
4994 /* free the temporaries */
4995 if ( IS_TEMP_CVAR( lst ) ) FreeTemp( TEMP_CVAR( lst ) );
4996 if ( IS_TEMP_CVAR( lev ) ) FreeTemp( TEMP_CVAR( lev ) );
4997 if ( IS_TEMP_CVAR( sel ) ) FreeTemp( TEMP_CVAR( sel ) );
4998 }
4999
5000
5001 /****************************************************************************
5002 **
5003 *F CompAssert2( <stat> ) . . . . . . . . . . . . . . . . . . STAT_ASSERT_2ARGS
5004 */
CompAssert2(Stat stat)5005 static void CompAssert2(Stat stat)
5006 {
5007 CVar lev; /* the level */
5008 CVar cnd; /* the condition */
5009
5010 Emit( "\n/* Assert( ... ); */\n" );
5011 lev = CompExpr(READ_STAT(stat, 0));
5012 Emit( "if ( ! LT(CurrentAssertionLevel, %c) ) {\n", lev );
5013 cnd = CompBoolExpr(READ_STAT(stat, 1));
5014 Emit( "if ( ! %c ) {\n", cnd );
5015 Emit( "AssertionFailure();\n" );
5016 Emit( "}\n" );
5017 Emit( "}\n" );
5018
5019 /* free the temporaries */
5020 if ( IS_TEMP_CVAR( cnd ) ) FreeTemp( TEMP_CVAR( cnd ) );
5021 if ( IS_TEMP_CVAR( lev ) ) FreeTemp( TEMP_CVAR( lev ) );
5022 }
5023
5024
5025 /****************************************************************************
5026 **
5027 *F CompAssert3( <stat> ) . . . . . . . . . . . . . . . . . . STAT_ASSERT_3ARGS
5028 */
CompAssert3(Stat stat)5029 static void CompAssert3(Stat stat)
5030 {
5031 CVar lev; /* the level */
5032 CVar cnd; /* the condition */
5033 CVar msg; /* the message */
5034
5035 Emit( "\n/* Assert( ... ); */\n" );
5036 lev = CompExpr(READ_STAT(stat, 0));
5037 Emit( "if ( ! LT(CurrentAssertionLevel, %c) ) {\n", lev );
5038 cnd = CompBoolExpr(READ_STAT(stat, 1));
5039 Emit( "if ( ! %c ) {\n", cnd );
5040 msg = CompExpr(READ_STAT(stat, 2));
5041 Emit( "if ( %c != (Obj)(UInt)0 )", msg );
5042 Emit( "{\n if ( IS_STRING_REP ( %c ) )\n", msg);
5043 Emit( " PrintString1( %c);\n else\n PrintObj(%c);\n}\n", msg, msg );
5044 Emit( "}\n" );
5045 Emit( "}\n" );
5046
5047 /* free the temporaries */
5048 if ( IS_TEMP_CVAR( msg ) ) FreeTemp( TEMP_CVAR( msg ) );
5049 if ( IS_TEMP_CVAR( cnd ) ) FreeTemp( TEMP_CVAR( cnd ) );
5050 if ( IS_TEMP_CVAR( lev ) ) FreeTemp( TEMP_CVAR( lev ) );
5051 }
5052
5053
5054
5055 /****************************************************************************
5056 **
5057 *F * * * * * * * * * * * * * * start compiling * * * * * * * * * * * * * * *
5058 */
5059
5060
5061 /****************************************************************************
5062 **
5063 *F CompFunc( <func> ) . . . . . . . . . . . . . . . . . compile a function
5064 **
5065 ** 'CompFunc' compiles the function <func>, i.e., it emits the code for the
5066 ** handler of the function <func> and the handlers of all its subfunctions.
5067 */
5068 static Obj CompFunctions;
5069
CompFunc(Obj func)5070 static void CompFunc(Obj func)
5071 {
5072 Bag info; /* info bag for this function */
5073 Int narg; /* number of arguments */
5074 Int nloc; /* number of locals */
5075 Bag oldFrame; /* old frame */
5076 Int i; /* loop variable */
5077 Int prevarargs; /* we have varargs with a prefix */
5078
5079 /* get the number of arguments and locals */
5080 narg = NARG_FUNC(func);
5081 prevarargs = 0;
5082 if(narg < -1) prevarargs = 1;
5083 if (narg < 0) {
5084 narg = -narg;
5085 }
5086
5087 nloc = NLOC_FUNC(func);
5088
5089 /* in the first pass allocate the info bag */
5090 if ( CompPass == 1 ) {
5091
5092 UInt nr = PushPlist( CompFunctions, func );
5093
5094 info = NewKernelBuffer(SIZE_INFO(narg+nloc,8));
5095 NEXT_INFO(info) = INFO_FEXP( CURR_FUNC() );
5096 NR_INFO(info) = nr;
5097 NLVAR_INFO(info) = narg + nloc;
5098 NHVAR_INFO(info) = 0;
5099 NTEMP_INFO(info) = 0;
5100
5101 SET_INFO_FEXP(func, info);
5102 CHANGED_BAG(func);
5103
5104 }
5105
5106 /* switch to this function (so that 'CONST_ADDR_STAT' and 'CONST_ADDR_EXPR' work) */
5107 SWITCH_TO_NEW_LVARS( func, narg, nloc, oldFrame );
5108
5109 /* get the info bag */
5110 info = INFO_FEXP( CURR_FUNC() );
5111
5112 /* compile the inner functions */
5113 Obj values = VALUES_BODY(BODY_FUNC(func));
5114 if (values) {
5115 UInt len = LEN_PLIST(values);
5116 for (i = 1; i <= len; i++) {
5117 Obj val = ELM_PLIST(values, i);
5118 if (IS_FUNC(val))
5119 CompFunc(val);
5120 }
5121 }
5122
5123 /* emit the code for the function header and the arguments */
5124 Emit( "\n/* handler for function %d */\n", NR_INFO(info));
5125 if ( narg == 0 ) {
5126 Emit( "static Obj HdlrFunc%d (\n", NR_INFO(info) );
5127 Emit( " Obj self )\n" );
5128 Emit( "{\n" );
5129 }
5130 else if ( narg <= 6 && !prevarargs ) {
5131 Emit( "static Obj HdlrFunc%d (\n", NR_INFO(info) );
5132 Emit( " Obj self,\n" );
5133 for ( i = 1; i < narg; i++ ) {
5134 Emit( " Obj %c,\n", CVAR_LVAR(i) );
5135 }
5136 Emit( " Obj %c )\n", CVAR_LVAR(narg) );
5137 Emit( "{\n" );
5138 }
5139 else {
5140 Emit( "static Obj HdlrFunc%d (\n", NR_INFO(info) );
5141 Emit( " Obj self,\n" );
5142 Emit( " Obj args )\n" );
5143 Emit( "{\n" );
5144 for ( i = 1; i <= narg; i++ ) {
5145 Emit( "Obj %c;\n", CVAR_LVAR(i) );
5146 }
5147 }
5148
5149 /* emit the code for the local variables */
5150 for ( i = 1; i <= nloc; i++ ) {
5151 if ( ! CompGetUseHVar( i+narg ) ) {
5152 Emit( "Obj %c = 0;\n", CVAR_LVAR(i+narg) );
5153 }
5154 }
5155
5156 /* emit the code for the temporaries */
5157 for ( i = 1; i <= NTEMP_INFO(info); i++ ) {
5158 Emit( "Obj %c = 0;\n", CVAR_TEMP(i) );
5159 }
5160
5161 for ( i = 1; i <= nloc; i++ ) {
5162 if ( ! CompGetUseHVar( i+narg ) ) {
5163 Emit( "(void)%c;\n", CVAR_LVAR(i+narg) );
5164 }
5165 }
5166
5167 /* emit the code for the higher variables */
5168 Emit( "Bag oldFrame;\n" );
5169
5170 /* emit the code to get the arguments for xarg functions */
5171 if ( 6 < narg ) {
5172 Emit( "CHECK_NR_ARGS( %d, args )\n", narg );
5173 for ( i = 1; i <= narg; i++ ) {
5174 Emit( "%c = ELM_PLIST( args, %d );\n", CVAR_LVAR(i), i );
5175 }
5176 }
5177
5178 if ( prevarargs ) {
5179 Emit( "CHECK_NR_AT_LEAST_ARGS( %d, args )\n", narg );
5180 for ( i = 1; i < narg; i++ ) {
5181 Emit( "%c = ELM_PLIST( args, %d );\n", CVAR_LVAR(i), i );
5182 }
5183 Emit( "Obj x_temp_range = Range2Check(INTOBJ_INT(%d), INTOBJ_INT(LEN_PLIST(args)));\n", narg);
5184 Emit( "%c = ELMS_LIST(args , x_temp_range);\n", CVAR_LVAR(narg));
5185 }
5186
5187 /* emit the code to switch to a new frame for outer functions */
5188 Emit( "\n/* allocate new stack frame */\n" );
5189 Emit( "SWITCH_TO_NEW_FRAME(self,%d,0,oldFrame);\n",NHVAR_INFO(info));
5190 if (NHVAR_INFO(info) > 0) {
5191 Emit("MakeHighVars(STATE(CurrLVars));\n");
5192 }
5193 for ( i = 1; i <= narg; i++ ) {
5194 if ( CompGetUseHVar( i ) ) {
5195 Emit( "ASS_LVAR( %d, %c );\n",GetIndxHVar(i),CVAR_LVAR(i));
5196 }
5197 }
5198
5199 /* we know all the arguments have values */
5200 for ( i = 1; i <= narg; i++ ) {
5201 SetInfoCVar( CVAR_LVAR(i), W_BOUND );
5202 }
5203 for ( i = narg+1; i <= narg+nloc; i++ ) {
5204 SetInfoCVar( CVAR_LVAR(i), W_UNBOUND );
5205 }
5206
5207 /* compile the body */
5208 CompStat( OFFSET_FIRST_STAT );
5209
5210 /* emit the code to switch back to the old frame and return */
5211 Emit( "\n/* return; */\n" );
5212
5213 Emit( "SWITCH_TO_OLD_FRAME(oldFrame);\n" );
5214 Emit( "return 0;\n" );
5215 Emit( "}\n" );
5216
5217 /* switch back to old frame */
5218 SWITCH_TO_OLD_LVARS( oldFrame );
5219 }
5220
5221
5222 /****************************************************************************
5223 **
5224 *F CompileFunc( <output>, <func>, <name>, <magic1>, <magic2> ) . . . compile
5225 */
CompileFunc(Obj output,Obj func,Obj name,Int magic1,Obj magic2)5226 Int CompileFunc (
5227 Obj output,
5228 Obj func,
5229 Obj name,
5230 Int magic1,
5231 Obj magic2 )
5232 {
5233 Int i; /* loop variable */
5234 Obj n; /* temporary */
5235 UInt col;
5236 UInt compFunctionsNr;
5237
5238 /* open the output file */
5239 if ( ! OpenOutput( CONST_CSTR_STRING(output) ) ) {
5240 return 0;
5241 }
5242 col = SyNrCols;
5243 SyNrCols = 255;
5244
5245 /* store the magic values */
5246 compilerMagic1 = magic1;
5247 compilerMagic2 = magic2;
5248
5249 /* create 'CompInfoGVar' and 'CompInfoRNam' */
5250 CompInfoGVar = NewKernelBuffer(sizeof(UInt) * 1024);
5251 CompInfoRNam = NewKernelBuffer(sizeof(UInt) * 1024);
5252
5253 /* create the list to collection the function expressions */
5254 CompFunctions = NEW_PLIST( T_PLIST, 8 );
5255
5256 /* first collect information about variables */
5257 CompPass = 1;
5258 CompFunc( func );
5259
5260 /* ok, lets emit some code now */
5261 CompPass = 2;
5262 compFunctionsNr = LEN_PLIST( CompFunctions );
5263
5264 /* emit code to include the interface files */
5265 Emit( "/* C file produced by GAC */\n" );
5266 Emit( "#include \"compiled.h\"\n" );
5267 Emit( "#define FILE_CRC \"%d\"\n", magic1 );
5268
5269 /* emit code for global variables */
5270 Emit( "\n/* global variables used in handlers */\n" );
5271 for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) {
5272 if ( CompGetUseGVar( i ) ) {
5273 Emit( "static GVar G_%n;\n", NameGVar(i) );
5274 }
5275 if ( CompGetUseGVar( i ) & COMP_USE_GVAR_COPY ) {
5276 Emit( "static Obj GC_%n;\n", NameGVar(i) );
5277 }
5278 if ( CompGetUseGVar( i ) & COMP_USE_GVAR_FOPY ) {
5279 Emit( "static Obj GF_%n;\n", NameGVar(i) );
5280 }
5281 }
5282
5283 /* emit code for record names */
5284 Emit( "\n/* record names used in handlers */\n" );
5285 for ( i = 1; i < SIZE_OBJ(CompInfoRNam)/sizeof(UInt); i++ ) {
5286 if ( CompGetUseRNam( i ) ) {
5287 Emit( "static RNam R_%n;\n", NAME_RNAM(i) );
5288 }
5289 }
5290
5291 /* emit code for the functions */
5292 Emit( "\n/* information for the functions */\n" );
5293 Emit( "static Obj NameFunc[%d];\n", compFunctionsNr+1 );
5294 Emit( "static Obj FileName;\n" );
5295
5296
5297 /* now compile the handlers */
5298 CompFunc( func );
5299
5300 // emit the code for PostRestore
5301 Emit( "\n/* 'PostRestore' restore gvars, rnams, functions */\n" );
5302 Emit( "static Int PostRestore ( StructInitInfo * module )\n" );
5303 Emit( "{\n" );
5304 Emit( "\n/* global variables used in handlers */\n" );
5305 for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) {
5306 if ( CompGetUseGVar( i ) ) {
5307 Emit( "G_%n = GVarName( \"%g\" );\n",
5308 NameGVar(i), NameGVar(i) );
5309 }
5310 }
5311 Emit( "\n/* record names used in handlers */\n" );
5312 for ( i = 1; i < SIZE_OBJ(CompInfoRNam)/sizeof(UInt); i++ ) {
5313 if ( CompGetUseRNam( i ) ) {
5314 Emit( "R_%n = RNamName( \"%g\" );\n",
5315 NAME_RNAM(i), NAME_RNAM(i) );
5316 }
5317 }
5318 Emit( "\n/* information for the functions */\n" );
5319 for ( i = 1; i <= compFunctionsNr; i++ ) {
5320 n = NAME_FUNC(ELM_PLIST(CompFunctions,i));
5321 if ( n != 0 && IsStringConv(n) ) {
5322 Emit( "NameFunc[%d] = MakeImmString(\"%G\");\n", i, n );
5323 }
5324 else {
5325 Emit( "NameFunc[%d] = 0;\n", i );
5326 }
5327 }
5328 Emit( "\n/* return success */\n" );
5329 Emit( "return 0;\n" );
5330 Emit( "\n}\n" );
5331 Emit( "\n" );
5332
5333 // emit the code for InitKernel
5334 Emit( "\n/* 'InitKernel' sets up data structures, fopies, copies, handlers */\n" );
5335 Emit( "static Int InitKernel ( StructInitInfo * module )\n" );
5336 Emit( "{\n" );
5337 Emit( "\n/* global variables used in handlers */\n" );
5338 for ( i = 1; i < SIZE_OBJ(CompInfoGVar)/sizeof(UInt); i++ ) {
5339 if ( CompGetUseGVar( i ) & COMP_USE_GVAR_COPY ) {
5340 Emit( "InitCopyGVar( \"%g\", &GC_%n );\n",
5341 NameGVar(i), NameGVar(i) );
5342 }
5343 if ( CompGetUseGVar( i ) & COMP_USE_GVAR_FOPY ) {
5344 Emit( "InitFopyGVar( \"%g\", &GF_%n );\n",
5345 NameGVar(i), NameGVar(i) );
5346 }
5347 }
5348 Emit( "\n/* information for the functions */\n" );
5349 Emit( "InitGlobalBag( &FileName, \"%g:FileName(\"FILE_CRC\")\" );\n",
5350 magic2 );
5351 for ( i = 1; i <= compFunctionsNr; i++ ) {
5352 Emit( "InitHandlerFunc( HdlrFunc%d, \"%g:HdlrFunc%d(\"FILE_CRC\")\" );\n",
5353 i, compilerMagic2, i );
5354 Emit( "InitGlobalBag( &(NameFunc[%d]), \"%g:NameFunc[%d](\"FILE_CRC\")\" );\n",
5355 i, magic2, i );
5356 n = NAME_FUNC(ELM_PLIST(CompFunctions,i));
5357 }
5358 Emit( "\n/* return success */\n" );
5359 Emit( "return 0;\n" );
5360 Emit( "\n}\n" );
5361
5362 // emit the code for InitLibrary
5363 Emit( "\n/* 'InitLibrary' sets up gvars, rnams, functions */\n" );
5364 Emit( "static Int InitLibrary ( StructInitInfo * module )\n" );
5365 Emit( "{\n" );
5366 Emit( "Obj func1;\n" );
5367 Emit( "Obj body1;\n" );
5368 Emit( "\n/* Complete Copy/Fopy registration */\n" );
5369 Emit( "UpdateCopyFopyInfo();\n" );
5370 Emit( "FileName = MakeImmString( \"%g\" );\n", magic2 );
5371 Emit( "PostRestore(module);\n" );
5372 Emit( "\n/* create all the functions defined in this module */\n" );
5373 Emit( "func1 = NewFunction(NameFunc[1],%d,0,HdlrFunc1);\n", NARG_FUNC(ELM_PLIST(CompFunctions,1)) );
5374 Emit( "SET_ENVI_FUNC( func1, STATE(CurrLVars) );\n" );
5375 Emit( "body1 = NewFunctionBody();\n" );
5376 Emit( "SET_BODY_FUNC( func1, body1 );\n" );
5377 Emit( "CHANGED_BAG( func1 );\n");
5378 Emit( "CALL_0ARGS( func1 );\n" );
5379 Emit( "\n/* return success */\n" );
5380 Emit( "return 0;\n" );
5381 Emit( "\n}\n" );
5382
5383 /* emit the initialization code */
5384 Emit( "\n/* <name> returns the description of this module */\n" );
5385 Emit( "static StructInitInfo module = {\n" );
5386 if ( ! strcmp( "Init_Dynamic", CONST_CSTR_STRING(name) ) ) {
5387 Emit( ".type = MODULE_DYNAMIC,\n" );
5388 }
5389 else {
5390 Emit( ".type = MODULE_STATIC,\n" );
5391 }
5392 Emit( ".name = \"%g\",\n", magic2 );
5393 Emit( ".crc = %d,\n", magic1 );
5394 Emit( ".initKernel = InitKernel,\n" );
5395 Emit( ".initLibrary = InitLibrary,\n" );
5396 Emit( ".postRestore = PostRestore,\n" );
5397 Emit( "};\n" );
5398 Emit( "\n" );
5399 Emit( "StructInitInfo * %n ( void )\n", name );
5400 Emit( "{\n" );
5401 Emit( "return &module;\n" );
5402 Emit( "}\n" );
5403 Emit( "\n/* compiled code ends here */\n" );
5404
5405 /* close the output file */
5406 SyNrCols = col;
5407 CloseOutput();
5408
5409 /* return success */
5410 return compFunctionsNr;
5411 }
5412
5413
5414 /****************************************************************************
5415 **
5416 *F FuncCOMPILE_FUNC( <self>, <output>, <func>, <name>, <magic1>, <magic2> )
5417 */
FuncCOMPILE_FUNC(Obj self,Obj arg)5418 static Obj FuncCOMPILE_FUNC(Obj self, Obj arg)
5419 {
5420 Obj output;
5421 Obj func;
5422 Obj name;
5423 Obj magic1;
5424 Obj magic2;
5425 Int nr;
5426 Int len;
5427
5428 /* unravel the arguments */
5429 len = LEN_LIST(arg);
5430 if ( len < 5 ) {
5431 ErrorQuit( "usage: COMPILE_FUNC( <output>, <func>, <name>, %s",
5432 (Int)"<magic1>, <magic2>, ... )", 0 );
5433 }
5434 output = ELM_LIST( arg, 1 );
5435 func = ELM_LIST( arg, 2 );
5436 name = ELM_LIST( arg, 3 );
5437 magic1 = ELM_LIST( arg, 4 );
5438 magic2 = ELM_LIST( arg, 5 );
5439
5440 // check the arguments
5441 RequireStringRep("CompileFunc", output);
5442 RequireFunction("CompileFunc", func);
5443 RequireStringRep("CompileFunc", name);
5444 RequireSmallInt("CompileFunc", magic1, "<magic1>");
5445 RequireStringRep("CompileFunc", magic2);
5446
5447 /* possible optimiser flags */
5448 CompFastIntArith = 1;
5449 CompFastPlainLists = 1;
5450 CompFastListFuncs = 1;
5451 CompCheckTypes = 1;
5452 CompCheckListElements = 1;
5453
5454 if ( 6 <= len ) {
5455 CompFastIntArith = EQ( ELM_LIST( arg, 6 ), True );
5456 }
5457 if ( 7 <= len ) {
5458 CompFastPlainLists = EQ( ELM_LIST( arg, 7 ), True );
5459 }
5460 if ( 8 <= len ) {
5461 CompFastListFuncs = EQ( ELM_LIST( arg, 8 ), True );
5462 }
5463 if ( 9 <= len ) {
5464 CompCheckTypes = EQ( ELM_LIST( arg, 9 ), True );
5465 }
5466 if ( 10 <= len ) {
5467 CompCheckListElements = EQ( ELM_LIST( arg, 10 ), True );
5468 }
5469
5470 /* compile the function */
5471 nr = CompileFunc(
5472 output, func, name,
5473 INT_INTOBJ(magic1), magic2 );
5474
5475
5476 /* return the result */
5477 return INTOBJ_INT(nr);
5478 }
5479
5480
5481 /****************************************************************************
5482 **
5483 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
5484 */
5485
5486 /****************************************************************************
5487 **
5488 *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
5489 */
5490 static StructGVarFunc GVarFuncs [] = {
5491
5492 GVAR_FUNC(COMPILE_FUNC, -1, "arg"),
5493 { 0, 0, 0, 0, 0 }
5494
5495 };
5496
5497
5498 /****************************************************************************
5499 **
5500 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
5501 */
InitKernel(StructInitInfo * module)5502 static Int InitKernel (
5503 StructInitInfo * module )
5504 {
5505 Int i; /* loop variable */
5506
5507 CompFastIntArith = 1;
5508 CompFastListFuncs = 1;
5509 CompFastPlainLists = 1;
5510 CompCheckTypes = 1;
5511 CompCheckListElements = 1;
5512 CompPass = 0;
5513
5514 /* init filters and functions */
5515 InitHdlrFuncsFromTable( GVarFuncs );
5516
5517 /* announce the global variables */
5518 InitGlobalBag( &CompInfoGVar, "src/compiler.c:CompInfoGVar" );
5519 InitGlobalBag( &CompInfoRNam, "src/compiler.c:CompInfoRNam" );
5520 InitGlobalBag( &CompFunctions, "src/compiler.c:CompFunctions" );
5521
5522 /* enter the expression compilers into the table */
5523 for ( i = 0; i < 256; i++ ) {
5524 CompExprFuncs[ i ] = CompUnknownExpr;
5525 }
5526
5527 CompExprFuncs[ EXPR_FUNCCALL_0ARGS ] = CompFunccall0to6Args;
5528 CompExprFuncs[ EXPR_FUNCCALL_1ARGS ] = CompFunccall0to6Args;
5529 CompExprFuncs[ EXPR_FUNCCALL_2ARGS ] = CompFunccall0to6Args;
5530 CompExprFuncs[ EXPR_FUNCCALL_3ARGS ] = CompFunccall0to6Args;
5531 CompExprFuncs[ EXPR_FUNCCALL_4ARGS ] = CompFunccall0to6Args;
5532 CompExprFuncs[ EXPR_FUNCCALL_5ARGS ] = CompFunccall0to6Args;
5533 CompExprFuncs[ EXPR_FUNCCALL_6ARGS ] = CompFunccall0to6Args;
5534 CompExprFuncs[ EXPR_FUNCCALL_XARGS ] = CompFunccallXArgs;
5535 CompExprFuncs[ EXPR_FUNC ] = CompFuncExpr;
5536
5537 CompExprFuncs[ EXPR_OR ] = CompOr;
5538 CompExprFuncs[ EXPR_AND ] = CompAnd;
5539 CompExprFuncs[ EXPR_NOT ] = CompNot;
5540 CompExprFuncs[ EXPR_EQ ] = CompEq;
5541 CompExprFuncs[ EXPR_NE ] = CompNe;
5542 CompExprFuncs[ EXPR_LT ] = CompLt;
5543 CompExprFuncs[ EXPR_GE ] = CompGe;
5544 CompExprFuncs[ EXPR_GT ] = CompGt;
5545 CompExprFuncs[ EXPR_LE ] = CompLe;
5546 CompExprFuncs[ EXPR_IN ] = CompIn;
5547
5548 CompExprFuncs[ EXPR_SUM ] = CompSum;
5549 CompExprFuncs[ EXPR_AINV ] = CompAInv;
5550 CompExprFuncs[ EXPR_DIFF ] = CompDiff;
5551 CompExprFuncs[ EXPR_PROD ] = CompProd;
5552 CompExprFuncs[ EXPR_QUO ] = CompQuo;
5553 CompExprFuncs[ EXPR_MOD ] = CompMod;
5554 CompExprFuncs[ EXPR_POW ] = CompPow;
5555
5556 CompExprFuncs[ EXPR_INT ] = CompIntExpr;
5557 CompExprFuncs[ EXPR_INTPOS ] = CompIntExpr;
5558 CompExprFuncs[ EXPR_TRUE ] = CompTrueExpr;
5559 CompExprFuncs[ EXPR_FALSE ] = CompFalseExpr;
5560 CompExprFuncs[ EXPR_TILDE ] = CompTildeExpr;
5561 CompExprFuncs[ EXPR_CHAR ] = CompCharExpr;
5562 CompExprFuncs[ EXPR_PERM ] = CompPermExpr;
5563 CompExprFuncs[ EXPR_PERM_CYCLE ] = CompUnknownExpr;
5564 CompExprFuncs[ EXPR_LIST ] = CompListExpr;
5565 CompExprFuncs[ EXPR_LIST_TILDE ] = CompListTildeExpr;
5566 CompExprFuncs[ EXPR_RANGE ] = CompRangeExpr;
5567 CompExprFuncs[ EXPR_STRING ] = CompStringExpr;
5568 CompExprFuncs[ EXPR_REC ] = CompRecExpr;
5569 CompExprFuncs[ EXPR_REC_TILDE ] = CompRecTildeExpr;
5570
5571 CompExprFuncs[ EXPR_REF_LVAR ] = CompRefLVar;
5572 CompExprFuncs[ EXPR_ISB_LVAR ] = CompIsbLVar;
5573 CompExprFuncs[ EXPR_REF_HVAR ] = CompRefHVar;
5574 CompExprFuncs[ EXPR_ISB_HVAR ] = CompIsbHVar;
5575 CompExprFuncs[ EXPR_REF_GVAR ] = CompRefGVar;
5576 CompExprFuncs[ EXPR_ISB_GVAR ] = CompIsbGVar;
5577
5578 CompExprFuncs[ EXPR_ELM_LIST ] = CompElmList;
5579 CompExprFuncs[ EXPR_ELMS_LIST ] = CompElmsList;
5580 CompExprFuncs[ EXPR_ELM_LIST_LEV ] = CompElmListLev;
5581 CompExprFuncs[ EXPR_ELMS_LIST_LEV ] = CompElmsListLev;
5582 CompExprFuncs[ EXPR_ISB_LIST ] = CompIsbList;
5583 CompExprFuncs[ EXPR_ELM_REC_NAME ] = CompElmRecName;
5584 CompExprFuncs[ EXPR_ELM_REC_EXPR ] = CompElmRecExpr;
5585 CompExprFuncs[ EXPR_ISB_REC_NAME ] = CompIsbRecName;
5586 CompExprFuncs[ EXPR_ISB_REC_EXPR ] = CompIsbRecExpr;
5587
5588 CompExprFuncs[ EXPR_ELM_POSOBJ ] = CompElmPosObj;
5589 CompExprFuncs[ EXPR_ISB_POSOBJ ] = CompIsbPosObj;
5590 CompExprFuncs[ EXPR_ELM_COMOBJ_NAME ] = CompElmComObjName;
5591 CompExprFuncs[ EXPR_ELM_COMOBJ_EXPR ] = CompElmComObjExpr;
5592 CompExprFuncs[ EXPR_ISB_COMOBJ_NAME ] = CompIsbComObjName;
5593 CompExprFuncs[ EXPR_ISB_COMOBJ_EXPR ] = CompIsbComObjExpr;
5594
5595 CompExprFuncs[ EXPR_FUNCCALL_OPTS ] = CompFunccallOpts;
5596
5597 /* enter the boolean expression compilers into the table */
5598 for ( i = 0; i < 256; i++ ) {
5599 CompBoolExprFuncs[ i ] = CompUnknownBool;
5600 }
5601
5602 CompBoolExprFuncs[ EXPR_OR ] = CompOrBool;
5603 CompBoolExprFuncs[ EXPR_AND ] = CompAndBool;
5604 CompBoolExprFuncs[ EXPR_NOT ] = CompNotBool;
5605 CompBoolExprFuncs[ EXPR_EQ ] = CompEqBool;
5606 CompBoolExprFuncs[ EXPR_NE ] = CompNeBool;
5607 CompBoolExprFuncs[ EXPR_LT ] = CompLtBool;
5608 CompBoolExprFuncs[ EXPR_GE ] = CompGeBool;
5609 CompBoolExprFuncs[ EXPR_GT ] = CompGtBool;
5610 CompBoolExprFuncs[ EXPR_LE ] = CompLeBool;
5611 CompBoolExprFuncs[ EXPR_IN ] = CompInBool;
5612
5613 /* enter the statement compilers into the table */
5614 for ( i = 0; i < 256; i++ ) {
5615 CompStatFuncs[ i ] = CompUnknownStat;
5616 }
5617
5618 CompStatFuncs[ STAT_PROCCALL_0ARGS ] = CompProccall0to6Args;
5619 CompStatFuncs[ STAT_PROCCALL_1ARGS ] = CompProccall0to6Args;
5620 CompStatFuncs[ STAT_PROCCALL_2ARGS ] = CompProccall0to6Args;
5621 CompStatFuncs[ STAT_PROCCALL_3ARGS ] = CompProccall0to6Args;
5622 CompStatFuncs[ STAT_PROCCALL_4ARGS ] = CompProccall0to6Args;
5623 CompStatFuncs[ STAT_PROCCALL_5ARGS ] = CompProccall0to6Args;
5624 CompStatFuncs[ STAT_PROCCALL_6ARGS ] = CompProccall0to6Args;
5625 CompStatFuncs[ STAT_PROCCALL_XARGS ] = CompProccallXArgs;
5626
5627 CompStatFuncs[ STAT_SEQ_STAT ] = CompSeqStat;
5628 CompStatFuncs[ STAT_SEQ_STAT2 ] = CompSeqStat;
5629 CompStatFuncs[ STAT_SEQ_STAT3 ] = CompSeqStat;
5630 CompStatFuncs[ STAT_SEQ_STAT4 ] = CompSeqStat;
5631 CompStatFuncs[ STAT_SEQ_STAT5 ] = CompSeqStat;
5632 CompStatFuncs[ STAT_SEQ_STAT6 ] = CompSeqStat;
5633 CompStatFuncs[ STAT_SEQ_STAT7 ] = CompSeqStat;
5634 CompStatFuncs[ STAT_IF ] = CompIf;
5635 CompStatFuncs[ STAT_IF_ELSE ] = CompIf;
5636 CompStatFuncs[ STAT_IF_ELIF ] = CompIf;
5637 CompStatFuncs[ STAT_IF_ELIF_ELSE ] = CompIf;
5638 CompStatFuncs[ STAT_FOR ] = CompFor;
5639 CompStatFuncs[ STAT_FOR2 ] = CompFor;
5640 CompStatFuncs[ STAT_FOR3 ] = CompFor;
5641 CompStatFuncs[ STAT_FOR_RANGE ] = CompFor;
5642 CompStatFuncs[ STAT_FOR_RANGE2 ] = CompFor;
5643 CompStatFuncs[ STAT_FOR_RANGE3 ] = CompFor;
5644 CompStatFuncs[ STAT_WHILE ] = CompWhile;
5645 CompStatFuncs[ STAT_WHILE2 ] = CompWhile;
5646 CompStatFuncs[ STAT_WHILE3 ] = CompWhile;
5647 CompStatFuncs[ STAT_REPEAT ] = CompRepeat;
5648 CompStatFuncs[ STAT_REPEAT2 ] = CompRepeat;
5649 CompStatFuncs[ STAT_REPEAT3 ] = CompRepeat;
5650 CompStatFuncs[ STAT_BREAK ] = CompBreak;
5651 CompStatFuncs[ STAT_CONTINUE ] = CompContinue;
5652 CompStatFuncs[ STAT_RETURN_OBJ ] = CompReturnObj;
5653 CompStatFuncs[ STAT_RETURN_VOID ] = CompReturnVoid;
5654
5655 CompStatFuncs[ STAT_ASS_LVAR ] = CompAssLVar;
5656 CompStatFuncs[ STAT_UNB_LVAR ] = CompUnbLVar;
5657 CompStatFuncs[ STAT_ASS_HVAR ] = CompAssHVar;
5658 CompStatFuncs[ STAT_UNB_HVAR ] = CompUnbHVar;
5659 CompStatFuncs[ STAT_ASS_GVAR ] = CompAssGVar;
5660 CompStatFuncs[ STAT_UNB_GVAR ] = CompUnbGVar;
5661
5662 CompStatFuncs[ STAT_ASS_LIST ] = CompAssList;
5663 CompStatFuncs[ STAT_ASSS_LIST ] = CompAsssList;
5664 CompStatFuncs[ STAT_ASS_LIST_LEV ] = CompAssListLev;
5665 CompStatFuncs[ STAT_ASSS_LIST_LEV ] = CompAsssListLev;
5666 CompStatFuncs[ STAT_UNB_LIST ] = CompUnbList;
5667 CompStatFuncs[ STAT_ASS_REC_NAME ] = CompAssRecName;
5668 CompStatFuncs[ STAT_ASS_REC_EXPR ] = CompAssRecExpr;
5669 CompStatFuncs[ STAT_UNB_REC_NAME ] = CompUnbRecName;
5670 CompStatFuncs[ STAT_UNB_REC_EXPR ] = CompUnbRecExpr;
5671
5672 CompStatFuncs[ STAT_ASS_POSOBJ ] = CompAssPosObj;
5673 CompStatFuncs[ STAT_UNB_POSOBJ ] = CompUnbPosObj;
5674 CompStatFuncs[ STAT_ASS_COMOBJ_NAME ] = CompAssComObjName;
5675 CompStatFuncs[ STAT_ASS_COMOBJ_EXPR ] = CompAssComObjExpr;
5676 CompStatFuncs[ STAT_UNB_COMOBJ_NAME ] = CompUnbComObjName;
5677 CompStatFuncs[ STAT_UNB_COMOBJ_EXPR ] = CompUnbComObjExpr;
5678
5679 CompStatFuncs[ STAT_INFO ] = CompInfo;
5680 CompStatFuncs[ STAT_ASSERT_2ARGS ] = CompAssert2;
5681 CompStatFuncs[ STAT_ASSERT_3ARGS ] = CompAssert3;
5682 CompStatFuncs[ STAT_EMPTY ] = CompEmpty;
5683
5684 CompStatFuncs[ STAT_PROCCALL_OPTS ] = CompProccallOpts;
5685 /* return success */
5686 return 0;
5687 }
5688
5689
5690 /****************************************************************************
5691 **
5692 *F PostRestore( <module> ) . . . . . . . . . . . . . after restore workspace
5693 */
PostRestore(StructInitInfo * module)5694 static Int PostRestore (
5695 StructInitInfo * module )
5696 {
5697 /* get the identifiers of 'Length' and 'Add' (for inlining) */
5698 G_Length = GVarName( "Length" );
5699 G_Add = GVarName( "Add" );
5700
5701 /* return success */
5702 return 0;
5703 }
5704
5705
5706 /****************************************************************************
5707 **
5708 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
5709 */
InitLibrary(StructInitInfo * module)5710 static Int InitLibrary (
5711 StructInitInfo * module )
5712 {
5713 /* init filters and functions */
5714 InitGVarFuncsFromTable( GVarFuncs );
5715
5716 /* return success */
5717 return PostRestore( module );
5718 }
5719
5720
5721 /****************************************************************************
5722 **
5723 *F InitInfoCompiler() . . . . . . . . . . . . . . . table of init functions
5724 */
5725 static StructInitInfo module = {
5726 // init struct using C99 designated initializers; for a full list of
5727 // fields, please refer to the definition of StructInitInfo
5728 .type = MODULE_BUILTIN,
5729 .name = "compiler",
5730 .initKernel = InitKernel,
5731 .initLibrary = InitLibrary,
5732 .postRestore = PostRestore
5733 };
5734
InitInfoCompiler(void)5735 StructInitInfo * InitInfoCompiler ( void )
5736 {
5737 return &module;
5738 }
5739