code.c 14.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
10
#include "desc.h"

11
12
13
14
15
16
// For compressing the source code a bit

#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); \
17
18
        dst->desc = (Desc*) __FORWARD_PTR__; \
        dst->_forward_ptr = thunk; 
19

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
20
21
#define arg_from_thunk(descarg, arg) \
        if(((FunEntry*) (descarg))->strictness & argmask && !arg->desc->hnf) \
22
23
24
25
26
27
28
29
30
        { \
            push_a(eval(arg)); \
        } \
        else \
        { \
            push_a(arg); \
        } \
        argmask <<= 1;

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
31
32
#define arg_from_code(descarg, arg) \
        if(((FunEntry*) (descarg))->strictness & argmask) \
33
        { \
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
34
35
36
            Thunk* phl = alloc_b(); \
            phl->desc = (Desc*) __STACK_PLACEHOLDER__; \
            push_a(phl); \
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
37
            exec(arg, frame_ptr, stack_top_a); \
38
39
40
        } \
        else \
        { \
41
            push_a(arg->create_thunk(arg, frame_ptr)); \
42
43
44
        } \
        argmask <<= 1;

45
struct Thunk* create_thunk_app_static(Code* expr, int frame_ptr)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
46
{
47
    Thunk* thunk = createF(((AppEntry*) expr)->f);
48

49
    assert(thunk->desc->arity == expr->nr_args);
50

51
    for (int i = 0; i < expr->nr_args; i++) {
52
        thunk->_args[i] = ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
53
    }
54

55
56
    return thunk;                        
}
57

58
59
60
61
struct Thunk* create_thunk_app_dyn(Code* expr, int frame_ptr)
{
    Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
    if(!basethunk->desc->hnf) basethunk = eval(basethunk);
62

63
64
65
    Desc* slice =
            get_slice(basethunk->desc->type == FT_SLICE ?
                      ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
66

67
    Thunk* thunk = createF(slice);
68

69
70
71
72
73
74
    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++) {
        thunk->_args[basethunk->desc->arity + i] 
75
                = ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
76
    }
77
78
79
80
81
82
83
84
85
86
87
88
89
90

    return thunk;    
}

struct Thunk* create_thunk_var(Code* expr, int frame_ptr)
{
    return local(frame_ptr, ((VarEntry*) expr)->index);    
}

struct Thunk* create_thunk_var_strict(Code* expr, int frame_ptr)
{
    Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);

    if(arg->desc->unboxable)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
91
    {
92
93
94
95
96
        return createT(arg);
    }
    else
    {
        return arg;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
97
    }
98
99
100
101
102
103
104
}

struct Thunk* create_thunk_thunk(Code* expr, int frame_ptr)
{
    return &((ThunkEntry*) expr)->thunk;
}

105
Thunk* (*create_thunk_funs[10]) (Code* expr, int frame_ptr);
106

107
108
109
110
111
void init_code()
{
    create_thunk_funs[CT_VAR] = create_thunk_var;
    create_thunk_funs[CT_VAR_STRICT] = create_thunk_var_strict;
    create_thunk_funs[CT_APP_THUNK] = create_thunk_app_static;
112
113
    create_thunk_funs[CT_APP_PRIM1] = create_thunk_app_static;
    create_thunk_funs[CT_APP_PRIM2] = create_thunk_app_static;
114
115
116
117
118
    create_thunk_funs[CT_APP_FUN] = create_thunk_app_static;
    create_thunk_funs[CT_APP_DYN] = create_thunk_app_dyn;
    create_thunk_funs[CT_SELECT] = NULL;
    create_thunk_funs[CT_IF] = NULL;
    create_thunk_funs[CT_THUNK] = create_thunk_thunk;
119
}
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
120

121
122
123
124
125
create_thunk_fun get_create_thunk_fun(CodeType type)
{
    return  create_thunk_funs[type];
}

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
126
void exec(Code* expr, int frame_ptr, int root_frame_ptr)
127
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
128
129
    int root_frame_ptr_b = stack_top_b;    
    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
130
131
    while(1)
    {
132
        assert(expr != NULL);
133
        assert(stack_top_a < STACK_SIZE_A);
134
        assert(stack_top_b < STACK_SIZE_B);
135
136
137

        // TODO: check over application
        // TODO: enforce strictness in ADT/Record
138
        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
139
        switch (expr->type) {
140
141
142
143
        case CT_APP_PRIM1:
        {
            push_a(alloc_b());                        
            exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
144
            
145
146
147
148
149
150
151
152
153
154
155
156
157
158
            ((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:
        {            
            push_a(alloc_b());                        
            exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
            push_a(alloc_b());                        
            exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);

            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);
159

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
160
161
162
163
164
            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;            
        }
        case CT_APP_FUN:
165
        {            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
166
            Desc* slice = ((AppEntry*) expr)->f;
167

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
168
169
170
171
172
            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]);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
173
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
174

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
175
176
177
178
179
180
181
            expr = ((FunEntry*) slice)->body;
            frame_ptr = new_frame_ptr;
            continue;            
        }
        case CT_APP_THUNK:
        {
            Desc* slice = ((AppEntry*) expr)->f;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
182

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
183
            Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
184

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
185
186
187
188
            assert(thunk->desc->arity == expr->nr_args);

            for (int i = 0; i < expr->nr_args; i++) {
                thunk->_args[i]  
189
                        = ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
190
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
191
192
193
194
195
196

            set_return(root_frame_ptr, thunk);
            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                                
        }
197
        case CT_APP_DYN:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
198
        {
199
            Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
200
            if(!basethunk->desc->hnf) basethunk = eval(basethunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
201

202
203
204
205
206
            Desc* slice =
                    get_slice(basethunk->desc->type == FT_SLICE ?
                              ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);

            switch(slice->type) {
207
208
            case FT_PRIM1:
            case FT_PRIM2:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
209
            {
210
                for (int i = 0; i < basethunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
211
212
213
214
215
216
217
218
                    if(basethunk->_args[i]->desc->hnf)
                    {
                        push_a(basethunk->_args[i]);
                    }
                    else
                    {
                        push_a(eval(basethunk->_args[i]));   
                    }
219
                }
220

221
                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
222
                    push_a(alloc_b());
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
223
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
224
225
226
                } 

                ((PrimEntry*) slice)->exec(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
227
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
228
                destroy_stack_frame_b(root_frame_ptr_b);                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
229
230
                return;                    
            }
231
232
233
234
235
236
237
238
239
240
241
242
            case FT_FUN:
            {
                int new_frame_ptr = stack_top_a;                    
                int argmask = 1;

                for (int i = 0; i < basethunk->desc->arity; i++) {
                    arg_from_thunk(slice, basethunk->_args[i])
                }

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

244
245
246
247
248
249
250
251
252
253
254
255
                expr = ((FunEntry*) slice)->body;
                frame_ptr = new_frame_ptr;
                continue;                    
            }
            case FT_SLICE:
            case FT_ADT:
            case FT_RECORD:
            {
                Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);

                assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);            

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
256
                memcpy(&thunk->_args, &basethunk->_args, sizeof(Thunk*) * basethunk->desc->arity);
257
258
259

                for (int i = 0; i < expr->nr_args; i++) {
                    thunk->_args[basethunk->desc->arity + i] 
260
                            = ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
261
262
263
264
                }

                set_return(root_frame_ptr, thunk);
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
265
                destroy_stack_frame_b(root_frame_ptr_b);
266
                return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
267
            }
268
269
270
271
272
273
274
275
276
            case FT_BOXED_LIT:
                abort("Literal unexpected here");                
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");
            }
        }
        case CT_VAR_STRICT:
        {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
277
            Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
278
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
279
            assert(is_hnf(arg));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
280

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
281
282
283
284
285
286
287
288
289
290
            if(arg->desc->unboxable)
            {
                arg = updateT(get_dst(root_frame_ptr), arg);
            }
            else
            {
                forward_thunk(arg, root_frame_ptr);
            }
            
            set_return(root_frame_ptr, arg);
291
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
292
            destroy_stack_frame_b(root_frame_ptr_b);            
293
294
295
296
297
            return;                    
        }
        case CT_VAR:
        {
            Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
298

299
300
301
            follow_thunk(thunk);
            forward_thunk(thunk, root_frame_ptr);            
            set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
302

303
304
305
            switch(thunk->desc->type) {
            case FT_FUN:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
306
307
                // Destroy stack frame before eval, it is not needed any more
                // Greatly reduces stack usage
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
308
309
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);  
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
310
311
312
313
                frame_ptr = stack_top_a;
                // Here frame_ptr == root_frame_ptr

                int argmask = 1;
314

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
315
                for (int i = 0; i < thunk->desc->arity; i++) {
316
                    arg_from_thunk(thunk->desc, thunk->_args[i]);
317
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
318
319
320

                expr = ((FunEntry*) thunk->desc)->body;
                continue;
321
            }
322
323
            case FT_PRIM1:
            case FT_PRIM2:
324
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
325
326
327
328
329
330

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

                ((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
331
332
                
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
333
                destroy_stack_frame_b(root_frame_ptr_b);
334
335
336
337
338
339
340
341
342
343
                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
344
                destroy_stack_frame_b(root_frame_ptr_b);
345
346
                return;
            }            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
347
348
349
        }
        case CT_THUNK:
        {
350
351
            Thunk* thunk = &((ThunkEntry*) expr)->thunk;            
            forward_thunk(thunk, root_frame_ptr);            
352
            set_return(root_frame_ptr, thunk);
353
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
354
            destroy_stack_frame_b(root_frame_ptr_b);
355
            return;               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
356
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
357
358
        case CT_SELECT:
        {
359
360
361
            Thunk* pattern = alloc_b();
            pattern->desc = (Desc*) __STACK_PLACEHOLDER__;
            push_a(pattern);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
362
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
363
            pattern = pop_a();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
364

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
365
366
            assert(is_hnf(pattern));
            assert(pattern->desc->type == FT_ADT);            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
367

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
368
369
370
371
            bool handled = false;
            
            for (int i = 0; i < expr->nr_cases; i++) {
                SelectCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];
372
                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
373
374
375
376
377
378
379
                if (caseEntry->type == SC_CONS) {
                    // Pattern match
                    if ((Desc*) caseEntry->cons != pattern->desc) continue;

                    // Put the constructor arguments to the stack if matches
                    for (int i = 0; i < pattern->desc->arity; i++) {
                        push_a(pattern->_args[i]);
380
                    }                  
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
381
382
383
384
385
386
387
388
389
390
                }
                else if (caseEntry->type == SC_LIT) {
                    printf("Exec: Unhandled entry type in CT_SELECT (SC_LIT)");
                    exit(-1);
                }
                
                // must be SC_DEFAULT now
                handled = true;
                expr = caseEntry->body;
                break;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
391
392
            }

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
393
394
395
396
397
398
399
400
            if(handled) continue;
            
            printf("Exec: no select cases matches");
            print(pattern, false);
            exit(-1);
        }
        case CT_IF:
        {        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
401
            push_a(alloc_b());
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
402
            exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a);
403
            Thunk* cond = pop_a();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
404
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
405
406
407
408
409
410
411
412
            if (readB(cond)) {
                expr = ((IfEntry*) expr)->texpr;
                continue;                
            }
            else {
                expr = ((IfEntry*) expr)->fexpr;
                continue;     
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
413
        }
414
415
416
417
418
419
        }
    }
}

struct Thunk* eval(Thunk* thunk) {
    assert(thunk != NULL);    
420
        
421
422
423
424
425
426
427
428
429
430
431
432
433
    follow_thunk(thunk);
    
    switch(thunk->desc->type) {
    case FT_FUN:
    {
        push_a(thunk);
        int frame_ptr = stack_top_a;
        int argmask = 1;
        
        for (int i = 0; i < thunk->desc->arity; i++) {
            arg_from_thunk(thunk->desc, thunk->_args[i]);
        }
        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
434
        exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr);
435
436
437
        thunk = pop_a();
        return thunk;
    }
438
439
    case FT_PRIM1:
    case FT_PRIM2:
440
441
442
443
444
    {
        push_a(thunk);
        int frame_ptr = stack_top_a;

        for (int i = 0; i < thunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
445
446
447
448
449
450
451
452
            if(thunk->_args[i]->desc->hnf)
            {
                push_a(thunk->_args[i]);
            }
            else
            {
                push_a(eval(thunk->_args[i]));
            }
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
        }

        ((PrimEntry*) thunk->desc)->exec(frame_ptr);        
        
        stack_top_a = frame_ptr;        
        thunk = pop_a();
        return thunk;
    }
    case FT_CAF:
    case FT_CAF_REDUCED:
        not_implemented("CAF");            
    case FT_SLICE:
    case FT_ADT:
    case FT_RECORD:
    case FT_BOXED_LIT:
        return thunk;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
469
    }
470
}