code.c 22.5 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
119
    switch(code->type)
    {
        case CT_APP_PRIM1:
        case CT_APP_PRIM2:
        case CT_APP_FUN:
120
        case CT_APP_FUN_TR:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
121
122
        case CT_APP_FUN1:
        case CT_APP_FUN2:
123
124
125
126
127
128
129
        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:
130
        case CT_VAR_STRICT:            
131
132
            code->create_thunk = create_thunk_var;
            break;
133
134
        case CT_VAR_UNBOXED:
            code->create_thunk = create_thunk_var_unboxed;
135
136
137
138
            break;
        case CT_THUNK:
            code->create_thunk = create_thunk_thunk;
            break;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
139
140
        case CT_SELECT_ADT:
        case CT_SELECT_LIT:    
141
        case CT_IF:
142
        case CT_LET:
143
144
145
            code->create_thunk = NULL;
            break;            
    }
146
147
}

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
148
void exec(Code* expr, int frame_ptr, int root_frame_ptr)
149
{
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
150
151
    if(heap_curr > gc_trigger) gc();
    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
152
153
    int root_frame_ptr_b = stack_top_b;    
    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
154
    while(1)
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
155
    {        
156
        assert(expr != NULL);
157
        assert(stack_top_a < STACK_SIZE_A);
158
        assert(stack_top_b < STACK_SIZE_B);
159
160
161

        // TODO: check over application
        // TODO: enforce strictness in ADT/Record
162
        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
163
        switch (expr->type) {
164
165
        case CT_APP_PRIM1:
        {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
166
167
            switch(expr->arg_pattern)
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
168
169
170
171
172
173
174
175
176
177
            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
178
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
179
            
180
181
182
183
184
185
186
            ((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
187
        {           
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
188
189
190
            
            // careful, "exec" may trigger garbage collection
            // read local variables only after the last exec            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
191
192
            switch(expr->arg_pattern)
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
193
194
195
196
197
198
199
200
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
            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
230
            }
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
231
            
232
            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);
233

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
234
235
236
237
            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;            
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
238
239
240
241
242
243
244
245
246
247
248
249
250
251
        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;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
252
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
253
254
255
256
257
258
259
260
261
            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
262
        case CT_APP_FUN:
263
        {            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
264
            Desc* slice = ((AppEntry*) expr)->f;
265

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
266
267
            int new_frame_ptr = stack_top_a;
            int argmask = 1;
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
268
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
269
270
            for (int i = 0; i < expr->nr_args; i++) {
                arg_from_code(slice, ((AppEntry*) expr)->args[i]);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
271
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
272

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
273
274
275
276
            expr = ((FunEntry*) slice)->body;
            frame_ptr = new_frame_ptr;
            continue;            
        }
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
        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
295
296
297
        case CT_APP_THUNK:
        {
            Desc* slice = ((AppEntry*) expr)->f;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
298
299
300
            Thunk* thunk = get_dst(root_frame_ptr);
            int newsize = slice->thunk_size;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
301
302
303
304
305
            if (thunk == NULL)
            {
                thunk = (Thunk*) alloc_heap(newsize);
                set_return(root_frame_ptr, thunk);
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
306
            else if (thunk->desc->thunk_size < newsize) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
307
308
309
                Thunk* target = thunk;
                thunk = (Thunk*) alloc_heap(newsize);
                target->desc = (Desc*) __FORWARD_PTR__;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
310
311
                target->_forward_ptr = thunk;
                set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
312
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
313

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
314
315
            thunk->desc = slice;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
316
            assert(thunk->desc->arity == expr->nr_args);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
317
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
318
319
            for (int i = 0; i < expr->nr_args; i++) {  
                ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], &thunk->_args[i], frame_ptr);
320
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
321
322
323
324
325

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                                
        }
326
        case CT_APP_DYN:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
327
        {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
328
329
330
331
332
            push_a(local(frame_ptr, ((AppEntry*)expr)->var.index));

            Thunk** bt = &peek_a();
            (*bt)->desc->eval();
            
333
            Desc* slice =
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
334
335
                    get_slice((*bt)->desc->type == FT_SLICE ?
                              ((SliceEntry*) (*bt)->desc)->forward_ptr : (*bt)->desc, (*bt)->desc->arity + expr->nr_args);
336
337

            switch(slice->type) {
338
339
            case FT_PRIM1:
            case FT_PRIM2:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
340
            {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
341
342
343
344
                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();
                    
345
                }
346

347
                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
348
                    placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
349
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
350
351
352
                } 

                ((PrimEntry*) slice)->exec(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
353
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
354
                destroy_stack_frame_b(root_frame_ptr_b);                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
355
356
                return;                    
            }
357
358
359
360
361
            case FT_FUN:
            {
                int new_frame_ptr = stack_top_a;                    
                int argmask = 1;

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
362
363
364
365
366
367
368
                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;
369
370
371
372
373
                }

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

375
376
377
378
379
380
381
382
                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
383
384
385
                Thunk* thunk = get_dst(root_frame_ptr);
                int newsize = slice->thunk_size;

Laszlo Domoszlai's avatar
fix bug    
Laszlo Domoszlai committed
386
387
388
389
390
391
                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
392
393
394
                    Thunk* target = thunk;
                    thunk = (Thunk*) alloc_heap(newsize);
                    target->desc = (Desc*) __FORWARD_PTR__;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
395
396
                    target->_forward_ptr = thunk;
                    set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
397
                }
Laszlo Domoszlai's avatar
fix bug    
Laszlo Domoszlai committed
398
                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
399
400
                thunk->desc = slice;
                
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
401
                assert(thunk->desc->arity == (*bt)->desc->arity + expr->nr_args);            
402

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
403
                memcpy(&thunk->_args, &(*bt)->_args, sizeof(Thunk*) * (*bt)->desc->arity);
404
405

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

                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
410
                destroy_stack_frame_b(root_frame_ptr_b);
411
                return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
412
            }
413
414
415
416
417
418
419
420
            case FT_BOXED_LIT:
                abort("Literal unexpected here");                
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");
            }
        }
        case CT_VAR_STRICT:
421
        case CT_VAR_UNBOXED:            
422
        {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
423
            Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
424
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
425
            assert(is_hnf(arg));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
426

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
427
            if(get_dst(root_frame_ptr) != NULL && arg->desc->thunk_size <= sizeof(Thunk))
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
428
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
429
                memcpy(get_dst(root_frame_ptr), arg, sizeof(Thunk));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
430
431
432
433
            }
            else
            {
                forward_thunk(arg, root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
434
                set_return(root_frame_ptr, arg);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
435
436
            }
            
437
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
438
            destroy_stack_frame_b(root_frame_ptr_b);            
439
440
441
442
443
            return;                    
        }
        case CT_VAR:
        {
            Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
444

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
445
446
            assert(!instackb(thunk));
            
447
448
449
            follow_thunk(thunk);
            forward_thunk(thunk, root_frame_ptr);            
            set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
450

451
452
453
            switch(thunk->desc->type) {
            case FT_FUN:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
454
455
                // Destroy stack frame before eval, it is not needed any more
                // Greatly reduces stack usage
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
456
457
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);  
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
458
                                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
459
460
461
462
                frame_ptr = stack_top_a;
                // Here frame_ptr == root_frame_ptr

                int argmask = 1;
463

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
464
                for (int i = 0; i < thunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
465
466
467
468
469
470
471
                    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;
472
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
473
474
475

                expr = ((FunEntry*) thunk->desc)->body;
                continue;
476
            }
477
478
            case FT_PRIM1:
            case FT_PRIM2:
479
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
480
481

                for (int i = 0; i < thunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
482
483
484
                    push_a(thunk->_args[i]);
                    thunk->_args[i]->desc->eval();
                    thunk = stack_a[root_frame_ptr-1];
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
485
486
487
                }

                ((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
488
489
                
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
490
                destroy_stack_frame_b(root_frame_ptr_b);                
491
492
493
494
495
496
497
498
499
500
                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
501
                destroy_stack_frame_b(root_frame_ptr_b);
502
503
                return;
            }            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
504
505
506
        }
        case CT_THUNK:
        {
507
            Thunk* thunk = &((ThunkEntry*) expr)->thunk;            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
            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);
            }

524
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
525
            destroy_stack_frame_b(root_frame_ptr_b);
526
            return;               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
527
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
528
529
        case CT_SELECT_LIT:
        {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
530
            placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
531
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
532
            Thunk* lit = pop_a();
533
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
534
535
536
537
            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
538

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
539
540
                // NULL means "default", we accept it anyway
                if(caseEntry->lit != NULL)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
541
                {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
542
543
544
                    assert(caseEntry->lit->thunk.desc != (Desc*) __INT__);
 
                    if(caseEntry->lit->thunk._int != lit->_int) continue;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
545
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
546
547
548
549
550
551
552
553
554
                
                // must be SC_DEFAULT now
                handled = true;
                expr = caseEntry->body;
                break;
            }
            
            if(handled) continue;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
555
556
557
558
559
560
561
562
563
            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
564
565
566
        }
        case CT_SELECT_ADT:
        {                        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
567
568
            SelectEntry* select = (SelectEntry*) expr;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
569
            push_a(NULL);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
570
            exec(select->expr, frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
571
            Thunk* cons = pop_a();            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
572
573
            
            expr = select->bodies[((ADTEntry*)cons->desc)->idx];
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
574
575
576
577
578
579
580
581
582
            
            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
583
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
584
585
586
587
588
589
590
591
592
            if(select->fallback != NULL)
            {
                stack_top_a -= select->fallback_nrargs;
                expr = select->fallback;
                
                continue;
            }
            
            abort("no match");
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
593
594
595
        }
        case CT_IF:
        {        
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
596
            placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
597
            exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a);
598
            Thunk* cond = pop_a();
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
599
               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
600
601
602
603
604
605
606
607
            if (readB(cond)) {
                expr = ((IfEntry*) expr)->texpr;
                continue;                
            }
            else {
                expr = ((IfEntry*) expr)->fexpr;
                continue;     
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
608
        }
609
610
611
612
613
614
615
616
617
        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
618
                    binding->body->create_thunk(binding->body, &stack_a[stack_top_a++], frame_ptr);
619
620
621
622
623
624
625
626
627
628
629
                }
                else // strict (including unboxed))
                {
                    push_a(NULL);
                    exec(binding->body, frame_ptr, stack_top_a);
                }
            }
            
            expr = ((LetEntry*) expr)->body;
            continue;
        }
630
631
632
633
        }
    }
}

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
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 
652
653
        }
        
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
654
        argmask <<= 1;
655
656
    }

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
657
658
    exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr);
}
659

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
660
661
662
663
664
665
666
667
668
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 
669
    }
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708

    ((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;
        case FT_PRIM1:
        case FT_PRIM2:
            desc->eval = eval_prim;
            break;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
709
    }
710
}