CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutSign UpSign In

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.

| Download

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it

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