code.c 23.1 KB
Newer Older
1
2
#include <stdio.h>
#include <stdlib.h>
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
3
#include <stdbool.h>
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
4
#include <strings.h>
5

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
6
#include "debug.h"
7
#include "code.h"
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
8
#include "mem.h"
9
#include "desc.h"
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
10
#include "gc.h"
11

12
13
// For compressing the source code a bit

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
14
15
#define instackb(addr) ((char*)addr >= (char*) &stack_b[0] && (char*)addr < (char*) &stack_b[STACK_SIZE_B])

16
17
18
19
#define follow_thunk(thunk) if (thunk->desc == (Desc*) __FORWARD_PTR__) thunk = thunk->_forward_ptr;

#define forward_thunk(thunk, frame_ptr) \
        Thunk* dst = get_dst(frame_ptr); \
20
        if(dst != NULL){ \
21
        dst->desc = (Desc*) __FORWARD_PTR__; \
22
23
        dst->_forward_ptr = thunk; \
        }
24

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
25
#define placeholder() \
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
26
        push_a(alloc_b());
27

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
28
#define arg_from_code(descarg, arg) \
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
29
        if(((FunEntry*) (descarg))->boxing & argmask) \
30
        { \
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
31
            placeholder(); \
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
32
            exec(arg, frame_ptr, stack_top_a); \
33
        } \
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
34
35
36
37
38
        else if(((FunEntry*) (descarg))->strictness & argmask) \
        { \
            push_a(NULL); \
            exec(arg, frame_ptr, stack_top_a); \
        } \
39
40
        else \
        { \
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
41
            arg->create_thunk(arg, &stack_a[stack_top_a++], frame_ptr); \
42
43
44
        } \
        argmask <<= 1;

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
45
void create_thunk_app_static(Code* expr, Thunk** target, int frame_ptr)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
46
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
47
    Thunk* thunk = (Thunk*) alloc_heap(((AppEntry*) expr)->f->thunk_size);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
48
    *target = thunk;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
49
    thunk->desc = ((AppEntry*) expr)->f;
50

51
    assert(thunk->desc->arity == expr->nr_args);
52

53
    for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
54
55
         ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], &thunk->_args[i], frame_ptr);
    }                     
56
}
57

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
58
void create_thunk_app_dyn(Code* expr, Thunk** target, int frame_ptr)
59
{
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
60
    push_a(local(frame_ptr, ((AppEntry*)expr)->var.index));
61

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
62
63
64
65
66
67
68
    int tmp = gc_enabled;
    gc_enabled = 0;
    peek_a()->desc->eval();
    gc_enabled = tmp;
    
    Thunk* basethunk = pop_a();
    
69
70
71
    Desc* slice =
            get_slice(basethunk->desc->type == FT_SLICE ?
                      ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
72

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
73
74
    Thunk* thunk = (Thunk*) alloc_heap(slice->thunk_size);
    thunk->desc = slice;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
75
76
    *target = thunk;
    
77
78
79
80
81
    assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);            

    memcpy(&thunk->_args, &basethunk->_args, sizeof(Thunk*) * basethunk->desc->arity);

    for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
82
83
        ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], &thunk->_args[basethunk->desc->arity + i], frame_ptr);
    } 
84
85
}

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
86
void create_thunk_var(Code* expr, Thunk** target, int frame_ptr)
87
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
88
    *target = local(frame_ptr, ((VarEntry*) expr)->index);    
89
90
}

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
91
void create_thunk_var_unboxed(Code* expr, Thunk** target, int frame_ptr)
92
93
94
{
    Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
95
96
97
    if(instackb(arg))
    {
        // The likely case
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
98
99
100
        Thunk* newthunk = (Thunk*) alloc_heap(sizeof (Thunk));
        memcpy(newthunk, arg, sizeof(Thunk));
        *target = newthunk;        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
101
102
103
    }
    else
    {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
104
        *target = arg;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
105
    }
106
107
}

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
108
void create_thunk_thunk(Code* expr, Thunk** target, int frame_ptr)
109
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
110
    *target = &((ThunkEntry*) expr)->thunk;
111
112
}

113
void set_create_thunk_fun(Code* code)
114
{
115
116
117
118
    switch(code->type)
    {
        case CT_APP_PRIM1:
        case CT_APP_PRIM2:
119
        case CT_APP_PRIM:            
120
        case CT_APP_FUN:
121
        case CT_APP_FUN_TR:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
122
123
        case CT_APP_FUN1:
        case CT_APP_FUN2:
124
125
126
127
128
129
130
        case CT_APP_THUNK:
            code->create_thunk = create_thunk_app_static;
            break;
        case CT_APP_DYN:
            code->create_thunk = create_thunk_app_dyn;
            break;
        case CT_VAR:
131
        case CT_VAR_STRICT:            
132
133
            code->create_thunk = create_thunk_var;
            break;
134
135
        case CT_VAR_UNBOXED:
            code->create_thunk = create_thunk_var_unboxed;
136
137
138
139
            break;
        case CT_THUNK:
            code->create_thunk = create_thunk_thunk;
            break;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
140
141
        case CT_SELECT_ADT:
        case CT_SELECT_LIT:    
142
        case CT_IF:
143
        case CT_LET:
144
145
146
            code->create_thunk = NULL;
            break;            
    }
147
148
}

149
150
151
152
153
154
155
// eval: frame_ptr, frame_ptr
// start: stack_top_a, stack_top_a
// otherwise: frame_ptr, stack_top_a

// frame_ptr: first arguments
// root_frame_ptr: place of the result

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
156
void exec(Code* expr, int frame_ptr, int root_frame_ptr)
157
{
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
158
159
    if(heap_curr > gc_trigger) gc();
    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
160
161
    int root_frame_ptr_b = stack_top_b;    
    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
162
    while(1)
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
163
    {        
164
        assert(expr != NULL);
165
        assert(stack_top_a < STACK_SIZE_A);
166
        assert(stack_top_b < STACK_SIZE_B);
167
168
169

        // TODO: check over application
        // TODO: enforce strictness in ADT/Record
170
        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
171
        switch (expr->type) {
172
173
        case CT_APP_PRIM1:
        {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
174
175
            switch(expr->arg_pattern)
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
176
177
178
179
180
181
182
183
184
185
            case 1:
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));  
                break;
            case 2:
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[0])->thunk);            
                break;
            default:
                placeholder();                        
                exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
                break;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
186
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
187
            
188
189
190
191
192
193
194
            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                        
        }
        case CT_APP_PRIM2:
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
195
        {           
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
196
197
198
            
            // careful, "exec" may trigger garbage collection
            // read local variables only after the last exec            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
199
200
            switch(expr->arg_pattern)
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
            case 1:
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));  
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[1])->thunk);
                break;
            case 2:
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[0])->thunk);            
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[1])->index));                        
                break;
            case 3:
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[1])->index));
                break;                    
            case 4:
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[0])->thunk);            
                placeholder();                       
                exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);                    
                break;                    
            case 5:
                placeholder();                     
                exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[1])->thunk);                                
                break;                    
            case 6:
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));
                placeholder();                       
                exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);
                break;                    
            case 7:
                placeholder();                        
                exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[1])->index));
                break;                    
            default:
                placeholder();                       
                exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
                placeholder();                        
                exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
238
            }
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
239
            
240
            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);
241

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
242
243
244
245
            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;            
        }
246
247
248
249
250
        case CT_APP_PRIM:
        {           
            // TODO
            abort("not implemented");
        }        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
251
252
253
254
255
256
257
258
259
260
261
262
263
264
        case CT_APP_FUN1:
        {
            Desc* slice = ((AppEntry*) expr)->f;

            int argmask = 1;            
            arg_from_code(slice, ((AppEntry*) expr)->args[0]);
              
            expr = ((FunEntry*) slice)->body;
            frame_ptr = stack_top_a - 1;
            continue;                        
        }        
        case CT_APP_FUN2:
        {
            Desc* slice = ((AppEntry*) expr)->f;
265
                        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
266
267
268
269
270
271
272
273
274
            int argmask = 1;
            
            arg_from_code(slice, ((AppEntry*) expr)->args[0]);
            arg_from_code(slice, ((AppEntry*) expr)->args[1]);
              
            expr = ((FunEntry*) slice)->body;
            frame_ptr = stack_top_a - 2;
            continue;                        
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
275
        case CT_APP_FUN:
276
        {            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
277
            Desc* slice = ((AppEntry*) expr)->f;
278

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
279
280
            int new_frame_ptr = stack_top_a;
            int argmask = 1;
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
281
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
282
283
            for (int i = 0; i < expr->nr_args; i++) {
                arg_from_code(slice, ((AppEntry*) expr)->args[i]);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
284
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
285

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
286
287
288
289
            expr = ((FunEntry*) slice)->body;
            frame_ptr = new_frame_ptr;
            continue;            
        }
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
        case CT_APP_FUN_TR:
        {            
            Desc* slice = ((AppEntry*) expr)->f;
            
            // TODO: B stack?
            int new_frame_ptr = stack_top_a;
            int argmask = 1;
                        
            for (int i = 0; i < expr->nr_args; i++) {
                arg_from_code(slice, ((AppEntry*) expr)->args[i]);
            }

            memcpy(&stack_a[frame_ptr], &stack_a[new_frame_ptr], sizeof(void*) * expr->nr_args);
            stack_top_a = frame_ptr + expr->nr_args;
            
            expr = ((FunEntry*) slice)->body;
            continue;            
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
308
309
310
        case CT_APP_THUNK:
        {
            Desc* slice = ((AppEntry*) expr)->f;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
311
312
313
            Thunk* thunk = get_dst(root_frame_ptr);
            int newsize = slice->thunk_size;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
314
315
316
317
318
            if (thunk == NULL)
            {
                thunk = (Thunk*) alloc_heap(newsize);
                set_return(root_frame_ptr, thunk);
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
319
            else if (thunk->desc->thunk_size < newsize) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
320
321
322
                Thunk* target = thunk;
                thunk = (Thunk*) alloc_heap(newsize);
                target->desc = (Desc*) __FORWARD_PTR__;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
323
324
                target->_forward_ptr = thunk;
                set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
325
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
326

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
327
328
            thunk->desc = slice;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
329
            assert(thunk->desc->arity == expr->nr_args);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
330
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
331
332
            for (int i = 0; i < expr->nr_args; i++) {  
                ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], &thunk->_args[i], frame_ptr);
333
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
334
335
336
337
338

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                                
        }
339
        case CT_APP_DYN:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
340
        {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
341
342
343
344
345
            push_a(local(frame_ptr, ((AppEntry*)expr)->var.index));

            Thunk** bt = &peek_a();
            (*bt)->desc->eval();
            
346
347
348
349
350
351
352
353
354
355
356
            
            Desc* baseDesc = (*bt)->desc->type == FT_SLICE ?
                              ((SliceEntry*) (*bt)->desc)->forward_ptr : (*bt)->desc;
            
            int newArity = (*bt)->desc->arity + expr->nr_args;
            
            if(newArity > baseDesc->arity)
            {
                
            }
            
357
            Desc* slice =
358
359
                    get_slice(baseDesc, newArity);
            
360
            switch(slice->type) {
361
            case FT_PRIM:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
362
            {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
363
364
365
366
                for (int i = 0; i < (*bt)->desc->arity; i++) {
                    push_a((*bt)->_args[i]);
                    /*if(!basethunk->_args[i]->desc->hnf)*/ (*bt)->_args[i]->desc->eval();
                    
367
                }
368

369
                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
370
                    placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
371
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
372
373
374
                } 

                ((PrimEntry*) slice)->exec(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
375
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
376
                destroy_stack_frame_b(root_frame_ptr_b);                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
377
378
                return;                    
            }
379
380
381
382
383
            case FT_FUN:
            {
                int new_frame_ptr = stack_top_a;                    
                int argmask = 1;

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
384
385
386
387
388
389
390
                for (int i = 0; i < (*bt)->desc->arity; i++) {                    
                    push_a((*bt)->_args[i]);
                    if(((FunEntry*) (slice))->strictness & argmask /*&& !arg->desc->hnf*/) 
                    { 
                        (*bt)->_args[i]->desc->eval(); 
                    } 
                    argmask <<= 1;
391
392
393
394
395
                }

                for (int i = 0; i < expr->nr_args; i++) {
                    arg_from_code(slice, ((AppEntry*) expr)->args[i]);    
                } 
396

397
398
399
400
401
402
403
404
                expr = ((FunEntry*) slice)->body;
                frame_ptr = new_frame_ptr;
                continue;                    
            }
            case FT_SLICE:
            case FT_ADT:
            case FT_RECORD:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
405
406
407
                Thunk* thunk = get_dst(root_frame_ptr);
                int newsize = slice->thunk_size;

Laszlo Domoszlai's avatar
fix bug    
Laszlo Domoszlai committed
408
409
410
411
412
413
                if (thunk == NULL)
                {
                    thunk = (Thunk*) alloc_heap(newsize);
                    set_return(root_frame_ptr, thunk);
                }
                else if (thunk->desc->thunk_size < newsize) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
414
415
416
                    Thunk* target = thunk;
                    thunk = (Thunk*) alloc_heap(newsize);
                    target->desc = (Desc*) __FORWARD_PTR__;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
417
418
                    target->_forward_ptr = thunk;
                    set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
419
                }
Laszlo Domoszlai's avatar
fix bug    
Laszlo Domoszlai committed
420
                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
421
422
                thunk->desc = slice;
                
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
423
                assert(thunk->desc->arity == (*bt)->desc->arity + expr->nr_args);            
424

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
425
                memcpy(&thunk->_args, &(*bt)->_args, sizeof(Thunk*) * (*bt)->desc->arity);
426
427

                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
428
                    ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], &thunk->_args[(*bt)->desc->arity + i], frame_ptr);
429
430
431
                }

                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
432
                destroy_stack_frame_b(root_frame_ptr_b);
433
                return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
434
            }
435
436
437
438
439
440
441
442
            case FT_BOXED_LIT:
                abort("Literal unexpected here");                
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");
            }
        }
        case CT_VAR_STRICT:
443
        case CT_VAR_UNBOXED:            
444
        {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
445
            Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
446
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
447
            assert(is_hnf(arg));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
448

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
449
            if(get_dst(root_frame_ptr) != NULL && arg->desc->thunk_size <= sizeof(Thunk))
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
450
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
451
                memcpy(get_dst(root_frame_ptr), arg, sizeof(Thunk));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
452
453
454
455
            }
            else
            {
                forward_thunk(arg, root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
456
                set_return(root_frame_ptr, arg);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
457
458
            }
            
459
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
460
            destroy_stack_frame_b(root_frame_ptr_b);            
461
462
463
464
465
            return;                    
        }
        case CT_VAR:
        {
            Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
466

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
467
468
            assert(!instackb(thunk));
            
469
470
471
            follow_thunk(thunk);
            forward_thunk(thunk, root_frame_ptr);            
            set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
472

473
474
475
            switch(thunk->desc->type) {
            case FT_FUN:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
476
477
                // Destroy stack frame before eval, it is not needed any more
                // Greatly reduces stack usage
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
478
479
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);  
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
480
                                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
481
482
483
484
                frame_ptr = stack_top_a;
                // Here frame_ptr == root_frame_ptr

                int argmask = 1;
485

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
486
                for (int i = 0; i < thunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
487
488
489
490
491
492
493
                    push_a(thunk->_args[i]);
                    if(((FunEntry*) (thunk->desc))->strictness & argmask /*&& !arg->desc->hnf*/) 
                    { 
                        thunk->_args[i]->desc->eval(); 
                        thunk = stack_a[root_frame_ptr-1];
                    }
                    argmask <<= 1;
494
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
495
496
497

                expr = ((FunEntry*) thunk->desc)->body;
                continue;
498
            }
499
            case FT_PRIM:
500
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
501
502

                for (int i = 0; i < thunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
503
504
505
                    push_a(thunk->_args[i]);
                    thunk->_args[i]->desc->eval();
                    thunk = stack_a[root_frame_ptr-1];
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
506
507
508
                }

                ((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
509
510
                
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
511
                destroy_stack_frame_b(root_frame_ptr_b);                
512
513
514
515
516
517
518
519
520
521
                return;
            }
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");            
            case FT_SLICE:
            case FT_ADT:
            case FT_RECORD:
            case FT_BOXED_LIT:
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
522
                destroy_stack_frame_b(root_frame_ptr_b);
523
524
                return;
            }            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
525
526
527
        }
        case CT_THUNK:
        {
528
            Thunk* thunk = &((ThunkEntry*) expr)->thunk;            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
            Thunk* dst = get_dst(root_frame_ptr);

            if(dst != NULL)
            {
                memcpy(dst, thunk, sizeof(Thunk));
                
                if(!instackb(dst))
                {
                    set_return(root_frame_ptr, thunk);
                }                
            }
            else
            {
                set_return(root_frame_ptr, thunk);
            }

545
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
546
            destroy_stack_frame_b(root_frame_ptr_b);
547
            return;               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
548
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
549
550
        case CT_SELECT_LIT:
        {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
551
            placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
552
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
553
            Thunk* lit = pop_a();
554
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
555
556
557
558
            bool handled = false;
            
            for (int i = 0; i < expr->nr_cases; i++) {
                SelectLitCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
559

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
560
561
                // NULL means "default", we accept it anyway
                if(caseEntry->lit != NULL)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
562
                {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
563
                    assert(caseEntry->lit->thunk.desc == (Desc*) __INT__);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
564
565
 
                    if(caseEntry->lit->thunk._int != lit->_int) continue;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
566
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
567
568
569
570
571
572
573
574
575
                
                // must be SC_DEFAULT now
                handled = true;
                expr = caseEntry->body;
                break;
            }
            
            if(handled) continue;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
576
577
578
579
580
581
582
583
584
            if(((SelectEntry*) expr)->fallback != NULL)
            {
                stack_top_a -= ((SelectEntry*) expr)->fallback_nrargs;
                expr = ((SelectEntry*) expr)->fallback;
                
                continue;
            }
            
            abort("no match");
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
585
586
587
        }
        case CT_SELECT_ADT:
        {                        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
588
589
            SelectEntry* select = (SelectEntry*) expr;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
590
            push_a(NULL);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
591
            exec(select->expr, frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
592
            Thunk* cons = pop_a();            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
593
594
            
            expr = select->bodies[((ADTEntry*)cons->desc)->idx];
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
595
596
597
598
599
600
601
602
603
            
            if(expr != NULL)
            {
                for (int i = 0; i < cons->desc->arity; i++) {
                    push_a(cons->_args[i]);
                }                  
                
                continue;
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
604
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
605
606
607
608
609
610
611
612
613
            if(select->fallback != NULL)
            {
                stack_top_a -= select->fallback_nrargs;
                expr = select->fallback;
                
                continue;
            }
            
            abort("no match");
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
614
615
616
        }
        case CT_IF:
        {        
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
617
            placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
618
            exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a);
619
            Thunk* cond = pop_a();
620
            
621
            // safe to do it before read as nothing can overwrite it in between
622
623
            stack_top_b--;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
624
625
626
627
628
629
630
631
            if (readB(cond)) {
                expr = ((IfEntry*) expr)->texpr;
                continue;                
            }
            else {
                expr = ((IfEntry*) expr)->fexpr;
                continue;     
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
632
        }
633
634
635
636
637
638
639
640
641
        case CT_LET:
        {
            for(int i=0; i<expr->nr_bindings; i++)
            {
                LetBindingEntry* binding = ((LetEntry*) expr)->bindings[i];
                
                // Normal
                if(binding->type == 0)
                {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
642
                    binding->body->create_thunk(binding->body, &stack_a[stack_top_a++], frame_ptr);
643
644
645
646
647
648
649
650
651
652
653
                }
                else // strict (including unboxed))
                {
                    push_a(NULL);
                    exec(binding->body, frame_ptr, stack_top_a);
                }
            }
            
            expr = ((LetEntry*) expr)->body;
            continue;
        }
654
655
656
657
        }
    }
}

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
void eval_hnf()
{
    return;
}

void eval_fun()
{
    Thunk* thunk = peek_a();    
    int frame_ptr = stack_top_a;
    int argmask = 1;

    for (int i = 0; i < thunk->desc->arity; i++) {
        push_a(thunk->_args[i]);

        if(((FunEntry*) (thunk->desc))->strictness & argmask)
        {
            thunk->_args[i]->desc->eval();
            thunk = stack_a[frame_ptr-1]; // refresh thunk ptr after eval 
676
677
        }
        
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
678
        argmask <<= 1;
679
680
    }

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
681
682
    exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr);
}
683

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
684
685
686
687
688
689
690
691
692
void eval_prim()
{
    Thunk* thunk = peek_a();
    int frame_ptr = stack_top_a;

    for (int i = 0; i < thunk->desc->arity; i++) {
        push_a(thunk->_args[i]);        
        thunk->_args[i]->desc->eval();
        thunk = stack_a[frame_ptr-1]; // refresh thunk ptr after eval 
693
    }
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728

    ((PrimEntry*) thunk->desc)->exec(frame_ptr);        

    stack_top_a = frame_ptr;        
}

void eval_fwd_ptr()
{
    Thunk* thunk = pop_a();
    follow_thunk(thunk);
    push_a(thunk);
    thunk->desc->eval();
}   
   
void set_eval_fun(Desc* desc)
{
    if(desc == (Desc*) __FORWARD_PTR__)
    {
        desc->eval = eval_fwd_ptr;
        return;
    }
    
    switch(desc->type)
    {
        case FT_BOXED_LIT:
        case FT_RECORD:
        case FT_ADT:
        case FT_CAF:
        case FT_CAF_REDUCED:
        case FT_SLICE:
            desc->eval = eval_hnf;
            break;
        case FT_FUN:
            desc->eval = eval_fun;
            break;
729
        case FT_PRIM:
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
730
731
            desc->eval = eval_prim;
            break;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
732
    }
733
}