-
Notifications
You must be signed in to change notification settings - Fork 1
/
llvm_codegen.c
1852 lines (1459 loc) · 57.9 KB
/
llvm_codegen.c
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
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
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
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
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#include <stdlib.h>
#include <unistd.h>
#include <assert.h>
#include <string.h>
#include <stddef.h>
#include <llvm-c/Core.h>
#include <llvm-c/ExecutionEngine.h>
#include <llvm-c/Target.h>
#include <llvm-c/Analysis.h>
#include <llvm-c/BitWriter.h>
#include <llvm-c/DebugInfo.h>
#include "llvm_codegen.h"
#include "sinc.h"
#include "scope.h"
#include "debug.h"
#include "parse.h"
#include "error.h"
#define LLVMDIBuilderFinalise LLVMDIBuilderFinalize
typedef void *(*main_func_t)(void);
static LLVMModuleRef module;
static LLVMValueRef function;
static LLVMBuilderRef builder;
static LLVMContextRef global_context;
static LLVMBasicBlockRef builder_block;
static LLVMTypeRef gc_alloc_t;
static LLVMValueRef gc_alloc_p;
static LLVMTypeRef print_int_t;
static LLVMValueRef print_int_p;
static LLVMTypeRef llvm_str_t;
static LLVMTypeRef boxed_t;
static LLVMDIBuilderRef di_builder;
static LLVMMetadataRef di_file;
static LLVMMetadataRef di_cu;
static LLVMMetadataRef boxed_t_meta;
static LLVMMetadataRef last_func_m;
static optimisation_t *opts;
static scope sc;
void put_builder_at_end(LLVMBuilderRef b, LLVMBasicBlockRef block) {
LLVMPositionBuilderAtEnd(b, block);
if (b == builder) {
builder_block = block;
}
}
LLVMValueRef build_call(LLVMBuilderRef b, LLVMTypeRef t, LLVMValueRef p,
LLVMValueRef *args, uint argc, char *id) {
LLVMValueRef call = LLVMBuildCall2(b, t, p, args, argc, id);
LLVMSetInstructionCallConv(call, LLVMFastCallConv);
return call;
}
LLVMValueRef smart_box_val(LLVMValueRef f, LLVMBuilderRef b, LLVMValueRef val,
LLVMTypeRef type) {
LLVMValueRef size = LLVMSizeOf(type);
LLVMTypeRef ptr_t = LLVMPointerType(type, 0);
LLVMValueRef ptr_size = LLVMSizeOf(ptr_t);
LLVMBasicBlockRef cond_b = LLVMAppendBasicBlock(f, "box_cond");
LLVMBasicBlockRef smol_b = LLVMAppendBasicBlock(f, "box_smol");
LLVMBasicBlockRef beeg_b = LLVMAppendBasicBlock(f, "box_beeg");
LLVMBasicBlockRef done_b = LLVMAppendBasicBlock(f, "box_done");
LLVMBuildBr(b, cond_b);
put_builder_at_end(b, cond_b);
LLVMValueRef cond = LLVMBuildICmp(b, LLVMIntULE, size, ptr_size, "smol?");
LLVMBuildCondBr(b, cond, smol_b, beeg_b);
put_builder_at_end(b, smol_b);
LLVMValueRef cast = LLVMBuildCast(b, LLVMIntToPtr, val, boxed_t, "cast");
LLVMBuildBr(b, done_b);
put_builder_at_end(b, beeg_b);
LLVMValueRef box = build_call(b, gc_alloc_t, gc_alloc_p, &size, 1, "boxed");
LLVMValueRef box_cast = LLVMBuildPointerCast(b, box, ptr_t, "box_uncast");
LLVMBuildStore(b, val, box_cast);
LLVMBuildBr(b, done_b);
put_builder_at_end(b, done_b);
LLVMValueRef phi_vs[] = { cast, box };
LLVMBasicBlockRef phi_bs[] = { smol_b, beeg_b };
LLVMValueRef res = LLVMBuildPhi(b, boxed_t, "box_res");
LLVMAddIncoming(res, phi_vs, phi_bs, 2);
return res;
}
LLVMValueRef box_val(LLVMValueRef f, LLVMBuilderRef b, LLVMValueRef val,
LLVMTypeRef type) {
LLVMValueRef size = LLVMSizeOf(type);
LLVMTypeRef ptr_t = LLVMPointerType(type, 0);
switch (opts->boxing_rule) {
case ALWAYS_BOX: {
LLVMValueRef box = build_call(b, gc_alloc_t, gc_alloc_p, &size, 1,
"boxed");
LLVMValueRef cast = LLVMBuildPointerCast(b, box, ptr_t,
"box_uncast");
LLVMBuildStore(b, val, cast);
return box;
} case NEVER_BOX:
return LLVMBuildCast(b, LLVMIntToPtr, val, boxed_t, "cast");
case SMART_BOX:
return smart_box_val(f, b, val, type);
default:
error(GENERAL_ERROR, "generating unboxing code");
}
}
LLVMValueRef build_gc_alloc(LLVMBuilderRef b, LLVMTypeRef t, char *id) {
LLVMValueRef size = LLVMSizeOf(t);
return LLVMBuildCall2(b, gc_alloc_t, gc_alloc_p, &size, 1, id);
}
LLVMValueRef smart_unbox_val(LLVMValueRef f, LLVMBuilderRef b, LLVMValueRef box,
LLVMTypeRef type) {
LLVMValueRef size = LLVMSizeOf(type);
LLVMTypeRef ptr_type = LLVMPointerType(type, 0);
LLVMValueRef ptr_size = LLVMSizeOf(ptr_type);
LLVMBasicBlockRef cond_b = LLVMAppendBasicBlock(f, "box_cond");
LLVMBasicBlockRef smol_b = LLVMAppendBasicBlock(f, "box_smol");
LLVMBasicBlockRef beeg_b = LLVMAppendBasicBlock(f, "box_beeg");
LLVMBasicBlockRef done_b = LLVMAppendBasicBlock(f, "box_done");
LLVMBuildBr(b, cond_b);
put_builder_at_end(b, cond_b);
LLVMValueRef cond = LLVMBuildICmp(b, LLVMIntULE, size, ptr_size, "smol?");
LLVMBuildCondBr(b, cond, smol_b, beeg_b);
put_builder_at_end(b, smol_b);
LLVMValueRef uncast = LLVMBuildCast(b, LLVMPtrToInt, box, type, "uncast");
LLVMBuildBr(b, done_b);
put_builder_at_end(b, beeg_b);
LLVMValueRef box_uncast = LLVMBuildPointerCast(b, box, ptr_type,
"box_uncast");
LLVMValueRef unbox = LLVMBuildLoad2(b, type, box_uncast, "unboxed");
LLVMBuildBr(b, done_b);
put_builder_at_end(b, done_b);
LLVMValueRef phi_vs[] = { uncast, unbox };
LLVMBasicBlockRef phi_bs[] = { smol_b, beeg_b };
LLVMValueRef res = LLVMBuildPhi(b, type, "box_res");
LLVMAddIncoming(res, phi_vs, phi_bs, 2);
return res;
}
LLVMValueRef unbox_val(LLVMValueRef f, LLVMBuilderRef b, LLVMValueRef box,
LLVMTypeRef type) {
switch (opts->boxing_rule) {
case ALWAYS_BOX: {
LLVMTypeRef ptr_t = LLVMPointerType(type, 0);
LLVMValueRef uncast = LLVMBuildPointerCast(b, box, ptr_t, "uncast");
return LLVMBuildLoad2(b, type, uncast, "unboxed");
} case NEVER_BOX:
return LLVMBuildCast(b, LLVMPtrToInt, box, type, "uncast");
case SMART_BOX:
return smart_unbox_val(f, b, box, type);
}
}
LLVMValueRef codegen_print_int(LLVMValueRef ref) {
LLVMValueRef args[] = { ref };
LLVMValueRef ret =
build_call(builder, print_int_t, print_int_p, args, 1, "");
return ret;
}
LLVMValueRef codegen_default_int(LLVMValueRef f, LLVMBuilderRef b, uint i) {
if (!opts->default_bit_width) error(GENERAL_ERROR, "no bitwidth specified");
LLVMTypeRef int_t = LLVMIntType(opts->default_bit_width);
LLVMValueRef val = LLVMConstInt(int_t, i, 0);
LLVMValueRef box = box_val(f, b, val, int_t);
return box;
}
LLVMValueRef codegen_int(LLVMValueRef f, LLVMBuilderRef b, sexpr *se) {
uint bit_width = se->contents.n.l->contents.i;
/*
* could use strtoull to support huge constants
*/
unsigned long long value = se->contents.n.r->contents.i;
LLVMTypeRef int_t = LLVMIntType(bit_width);
LLVMValueRef val = LLVMConstInt(int_t, value, 0);
return box_val(f, b, val, int_t);
}
LLVMValueRef codegen_string(sexpr *se) {
assert(se->type == STRING);
return LLVMBuildGlobalStringPtr(builder, se->contents.s, "string");
}
LLVMValueRef codegen_id(char *id) {
scope_entry *entry = scope_find(sc, id);
if (!entry) return 0;
LLVMValueRef val = entry->value;
/*
* all uses of this function want a value, and since all values are assumed
* to be boxed right now, it should be safe to cast function pointers to i8*
*/
//if (entry->type == boxed_t) {
val = LLVMBuildPointerCast(builder, val, boxed_t, "func_generic_cast");
//}
return val;
}
LLVMTypeRef make_void_function_type(unsigned param_c, LLVMBool vararg) {
/* FIXME: memory leak */
LLVMTypeRef *boxed_params = malloc((sizeof (LLVMTypeRef)) * param_c);
for (uint i = 0; i < param_c; i++) {
boxed_params[i] = boxed_t;
}
return LLVMFunctionType(LLVMVoidType(), boxed_params, param_c, vararg);
}
LLVMTypeRef make_function_type(unsigned param_c, LLVMBool vararg) {
/* FIXME: memory leak */
LLVMTypeRef *boxed_params = malloc((sizeof (LLVMTypeRef)) * param_c);
for (uint i = 0; i < param_c; i++) {
boxed_params[i] = boxed_t;
}
return LLVMFunctionType(boxed_t, boxed_params, param_c, vararg);
}
LLVMValueRef add_function(LLVMTypeRef func_t, char *func_id) {
LLVMValueRef func_p = LLVMAddFunction(module, func_id, func_t);
LLVMSetFunctionCallConv(func_p, LLVMFastCallConv);
return func_p;
}
LLVMTypeRef make_struct_type(char *id, uint param_c, LLVMBool packed) {
/* FIXME: memory leak */
LLVMTypeRef *boxed_props = malloc((sizeof (LLVMTypeRef)) *param_c);
for (uint i = 0; i < param_c; i++) {
boxed_props[i] = boxed_t;
}
LLVMTypeRef struct_t = LLVMStructCreateNamed(global_context, id);
LLVMStructSetBody(struct_t, boxed_props, param_c, packed);
return struct_t;
}
LLVMValueRef _codegen(sexpr *sexpr, int tail_position);
uint get_args_from_list(sexpr *se, LLVMValueRef *args) {
debug("getting args from list @%p\n", (void *) se);
if (!se) return 0;
assert(se->type == BRANCH);
*args = _codegen(se->contents.n.l, 0);
return 1 + get_args_from_list(se->contents.n.r, args + 1);
}
uint get_args_from_list_except_last(sexpr *se, LLVMValueRef *args) {
if (!se) return 0;
assert(se->type == BRANCH);
if (!se->contents.n.r) return 1;
*args = _codegen(se->contents.n.l, 0);
return 1 + get_args_from_list_except_last(se->contents.n.r, args + 1);
}
uint make_type_params(sexpr *params, char **ids) {
if (!params) return 0;
assert(params->type == BRANCH);
sexpr *l = params->contents.n.l;
sexpr *r = params->contents.n.r;
assert(l->type == ID);
*ids = l->contents.s;
return 1 + make_type_params(r, ids + 1);
}
uint make_func_params(sexpr *params, char **ids, lloc_t **llocs) {
if (!params) return 0;
assert(params->type == BRANCH);
sexpr* l = params->contents.n.l;
sexpr* r = params->contents.n.r;
assert(l->type == ID);
*ids = l->contents.s;
*llocs = &l->lloc;
return 1 + make_func_params(r, ids + 1, llocs + 1);
}
int make_filler_name(char *buf, int n, char *struct_id) {
return snprintf(buf, n, ".%s.filler", struct_id);
}
int make_trmc_inner_name(char *buf, int n, char *outer_id, char *mod) {
return snprintf(buf, n, ".%s.inner.%s", outer_id, mod);
}
void add_enum_attr(LLVMValueRef f, uint index, char *id, size_t n, int val) {
if (!opts->llvm_attributes) return;
if (!n) n = strlen(id);
unsigned kind = LLVMGetEnumAttributeKindForName(id, n);
if (!kind) error(GENERAL_ERROR, "no enum attribute %s", id);
LLVMAttributeRef attr = LLVMCreateEnumAttribute(global_context, kind, val);
LLVMAddAttributeAtIndex(f, index, attr);
}
void add_func_enum_attr(LLVMValueRef f, char *id, size_t n, int val) {
add_enum_attr(f, LLVMAttributeFunctionIndex, id, n, val);
}
LLVMValueRef codegen_type_definition(sexpr *se) {
assert(se);
assert(se->type == BRANCH);
sexpr *title = se->contents.n.l;
sexpr *info = se->contents.n.r;
assert(title);
assert(info);
/* FIXME: magic sizes */
char *prop_ids[50];
uint prop_c = make_type_params(info->contents.n.l, prop_ids);
char *struct_id = title->contents.s;
debug("building struct %s\n", struct_id);
/* last parameter determines if struct is packed */
LLVMTypeRef struct_t = make_struct_type(struct_id, prop_c, 0);
/*
* TODO
* I'm not sure what the second parameter of LLVMPointerType (unsigned
* AddressSpace) is used for:
* https://llvm.org/doxygen/group__LLVMCCoreTypeSequential.html#ga299fe6147083678d0494b1b875f542fa
* I'm guessing it's for restricting the address space the pointer can
* point to, which would be a cool property to expose to front-end
* languages.
*/
LLVMTypeRef struct_ptr_t = LLVMPointerType(struct_t, 0);
/*
* Create a temporary builder for building some extra functions so that the
* main builder doesn't lose its place. Disposed of at end of scope.
*/
LLVMBuilderRef util_b = LLVMCreateBuilder();
/*
* Create a "filler" function: given a pointer as its last argument, fill in
* the space it points to with properties given as the other arguments.
*/
/* FIXME: magic size */
char filler_id[50];
make_filler_name(filler_id, 50, struct_id);
uint filler_param_c = prop_c + 1;
LLVMTypeRef filler_t = make_void_function_type(filler_param_c, 0);
LLVMValueRef filler_p = add_function(filler_t, filler_id);
LLVMBasicBlockRef filler_b = LLVMAppendBasicBlock(filler_p, "entry");
put_builder_at_end(util_b, filler_b);
LLVMValueRef space_cast = LLVMGetParam(filler_p, filler_param_c - 1);
LLVMValueRef space = LLVMBuildPointerCast(util_b, space_cast,
struct_ptr_t, "space_uncast");
for (uint i = 0; i < prop_c; i++) {
LLVMValueRef prop_pos = LLVMBuildStructGEP(util_b, space, i, "pos");
LLVMValueRef param = LLVMGetParam(filler_p, i);
LLVMBuildStore(util_b, param, prop_pos);
}
LLVMBuildRetVoid(util_b);
scope_entry *struct_e = malloc(sizeof(*struct_e));
struct_e->type = struct_t;
struct_e->id = struct_id;
struct_e->value = filler_p;
/*
* Create a wrapper around the filler function for use as a general-purpose
* constructor.
*/
char *ctor_id = struct_id;
uint ctor_param_c = prop_c;
LLVMTypeRef ctor_t = make_function_type(ctor_param_c, 0);
LLVMValueRef ctor_p = add_function(ctor_t, ctor_id);
LLVMBasicBlockRef ctor_b = LLVMAppendBasicBlock(ctor_p, "entry");
put_builder_at_end(util_b, ctor_b);
LLVMValueRef src = build_gc_alloc(util_b, struct_t, struct_id);
assert(src);
LLVMValueRef *args = malloc(filler_param_c * sizeof(*args));
LLVMGetParams(ctor_p, args);
args[filler_param_c - 1] = src;
build_call(util_b, filler_t, filler_p, args, filler_param_c, "");
free(args);
LLVMBuildRet(util_b, src);
scope_entry * ctor_e = scope_add_entry(sc, struct_id, ctor_p, ctor_t);
ctor_e->has_filler = 1;
/* FIXME: memory leak */
ctor_e->filler.id = strdup(filler_id);
ctor_e->filler.value = filler_p;
ctor_e->filler.type = filler_t;
ctor_e->filler.constructs = struct_t;
add_func_enum_attr(filler_p, "alwaysinline", 0, 1);
add_func_enum_attr(filler_p, "norecurse", 0, 1);
add_func_enum_attr(filler_p, "nounwind", 0, 1);
add_func_enum_attr(filler_p, "writeonly", 0, 1);
add_func_enum_attr(filler_p, "argmemonly", 0, 1);
add_enum_attr(filler_p, filler_param_c, "nonnull", 0, 1);
add_func_enum_attr(ctor_p, "alwaysinline", 0, 1);
add_func_enum_attr(ctor_p, "norecurse", 0, 1);
add_func_enum_attr(ctor_p, "nounwind", 0, 1);
/*
* Make functions to retreive each property of the struct.
*/
/* FIXME: magic size */
char prop_func_id[50];
for (uint i = 0; i < prop_c; i++) {
/* TODO: maybe choose a different separator character? */
snprintf(prop_func_id, 50, "%s.%s", struct_id, prop_ids[i]);
LLVMTypeRef prop_func_t = make_function_type(1, 0);
LLVMValueRef prop_func_p =
add_function(prop_func_t, prop_func_id);
LLVMBasicBlockRef prop_func_b =
LLVMAppendBasicBlock(prop_func_p, "entry");
put_builder_at_end(util_b, prop_func_b);
LLVMValueRef param = LLVMGetParam(prop_func_p, 0);
LLVMValueRef uncast =
LLVMBuildPointerCast(util_b, param, struct_ptr_t, "uncast");
LLVMValueRef ptr =
LLVMBuildStructGEP2(util_b, struct_t, uncast, i, "part");
LLVMValueRef val = LLVMBuildLoad(util_b, ptr, "deref");
LLVMBuildRet(util_b, val);
debug("adding %s to scope\n", prop_func_id);
scope_add_entry(sc, prop_func_id, prop_func_p, prop_func_t);
add_func_enum_attr(prop_func_p, "alwaysinline", 0, 1);
add_func_enum_attr(prop_func_p, "norecurse", 0, 1);
add_func_enum_attr(prop_func_p, "nounwind", 0, 1);
add_func_enum_attr(prop_func_p, "readonly", 0, 1);
add_func_enum_attr(prop_func_p, "argmemonly", 0, 1);
add_enum_attr(prop_func_p, 1, "nonnull", 0, 1);
}
LLVMDisposeBuilder(util_b);
return ctor_p;
}
LLVMValueRef codegen_declaration(sexpr *se) {
assert(se);
assert(se->type == BRANCH);
sexpr *title = se->contents.n.l;
sexpr *info = se->contents.n.r;
assert(title);
assert(info);
char *func_id = title->contents.s;
/* FIXME: magic sizes */
char *ids[50];
lloc_t *llocs[50];
uint param_c = make_func_params(info->contents.n.l, ids, llocs);
debug("building function %s\n", func_id);
LLVMTypeRef func_t = make_function_type(param_c, 0);
LLVMValueRef func_p = add_function(func_t, func_id);
scope_add_entry(sc, func_id, func_p, func_t);
return func_p;
}
LLVMMetadataRef debug_make_subprogram(LLVMDIBuilderRef di_builder,
LLVMMetadataRef scope, char *id, LLVMMetadataRef di_file, lloc_t *lloc,
LLVMTypeRef type) {
debug("%p\n", (void *) scope);
LLVMDIFlags flags = 0;
uint param_c = LLVMCountParamTypes(type);
/* FIXME: magic size */
LLVMMetadataRef func_param_types[20];
for (uint i = 0; i <= param_c; i++) {
func_param_types[i] = boxed_t_meta;
}
LLVMMetadataRef type_meta = LLVMDIBuilderCreateSubroutineType(di_builder,
di_file, func_param_types, param_c + 1, flags);
size_t id_len = strlen(id);
uint lineno = lloc->first_line;
int local = 0;
int definition = 1;
uint scope_line = lloc->first_line;
int optimised = 0;
last_func_m = LLVMDIBuilderCreateFunction(di_builder, scope, id, id_len, id,
id_len, di_file, lineno, type_meta, local, definition, scope_line,
flags, optimised);
return last_func_m;
}
LLVMMetadataRef debug_make_parameter(LLVMDIBuilderRef di_builder,
LLVMMetadataRef scope, char *id, uint i, LLVMMetadataRef di_file,
lloc_t *lloc) {
size_t id_len = strlen(id);
uint lineno = lloc->first_line;
LLVMMetadataRef type = boxed_t_meta;
int preserve = 0;
int flags = 0;
return LLVMDIBuilderCreateParameterVariable(di_builder, scope, id, id_len,
i, di_file, lineno, type, preserve, flags);
}
LLVMMetadataRef debug_make_location(LLVMContextRef context, lloc_t *lloc,
LLVMMetadataRef scope) {
uint lineno = lloc->first_line;
uint colno = lloc->first_column;
return LLVMDIBuilderCreateDebugLocation(context, lineno, colno, scope, 0);
}
int looks_inside_final_argument(scope_entry *func_entry) {
/*
* TODO FIXME
* implementing this function will require keeping the AST of a function's
* definition in the entry; just look through the function to see if any
* access functions or operators are applied to the function's final
* argument (this would include checking function calls recursively)
*/
return 0 && func_entry;
}
sexpr *last_list_item(sexpr *list) {
sexpr *last;
sexpr *current = list;
while (current) {
last = current;
current = current->contents.n.r;
}
return last;
}
typedef enum {
NOT_TAIL_RECURSIVE = 0,
TAIL_RECURSIVE,
TAIL_RECURSIVE_MOD_CONS
} tail_recursive_t;
int is_tail_recursive_branch(char *id, sexpr *branch) {
if (branch->type != BRANCH) return 0;
if (branch->contents.n.l->type == INT) return 0;
char *outermost_id = branch->contents.n.l->contents.s;
scope_entry *outermost_e = scope_find(sc, outermost_id);
if (!outermost_e->has_filler) return 0;
sexpr *last_arg = last_list_item(branch)->contents.n.l;
if (last_arg->type != BRANCH) return 0;
char *last_arg_id = last_arg->contents.n.l->contents.s;
return !strcmp(last_arg_id, id);
}
tail_recursive_t is_tail_recursive(char *id, sexpr *ast) {
switch (ast->type) {
case INT:
case ID:
/*
* just an ID here means that the function is returning a constant
* function pointer
*
* an int here means the function is returning a constant
*/
debug("%s is not tail recursive because it returns a literal\n",
id);
return NOT_TAIL_RECURSIVE;
case BRANCH: {
if (ast->contents.n.l->type == INT) {
/*
* an int here means the function is returning a constant
*/
debug("%s is not tail recursive because it returns a literal\n",
id);
return NOT_TAIL_RECURSIVE;
}
char *outermost_id = ast->contents.n.l->contents.s;
if (!strcmp(id, outermost_id)) {
debug("%s is tail recursive\n", id);
return TAIL_RECURSIVE;
}
if (strcmp(outermost_id, "if")) {
debug("%s is not tail recursive mod cons because it does not "
"immediately branch\n", id);
return NOT_TAIL_RECURSIVE;
}
sexpr *cond_node = ast->contents.n.r;
sexpr *then_node = cond_node->contents.n.r;
if (is_tail_recursive_branch(id, then_node->contents.n.l)) {
debug("%s is recursive mod cons on its then branch\n", id);
return TAIL_RECURSIVE_MOD_CONS;
}
sexpr *else_node = then_node->contents.n.r;
if (is_tail_recursive_branch(id, else_node->contents.n.l)) {
debug ("%s is recursive mod cons on its else branch\n", id);
return TAIL_RECURSIVE_MOD_CONS;
}
debug("%s is not tail recursive\n", id);
return NOT_TAIL_RECURSIVE;
}
case NIL:
default:
error(GENERAL_ERROR, "checking if %s is tail-recursive mod cons",
id);
}
}
sexpr *find_tail_recursive_call(char *id, sexpr *ast) {
if (ast->type != BRANCH) {
return 0;
}
sexpr *last_arg = last_list_item(ast);
if (last_arg->type != BRANCH) {
return 0;
}
if (strcmp(last_arg->contents.n.l->contents.n.l->contents.s, id)) {
return 0;
}
return last_arg;
}
void debug_set_builder_location(LLVMBuilderRef b, sexpr *se) {
LLVMMetadataRef loc =
debug_make_location(global_context, &se->lloc, last_func_m);
/*
* LLVM 9 onwards has LLVMSetCurrentDebugLocation2, and this call is
* deprecated
*/
LLVMSetCurrentDebugLocation(b, LLVMMetadataAsValue(global_context,
loc));
}
LLVMValueRef codegen_from_scope(char *func_id, LLVMValueRef *args, uint arg_c,
int tail_position) {
scope_entry *entry = scope_find(sc, func_id);
if (!entry) return 0;
LLVMValueRef func_p = entry->value;
LLVMTypeRef func_t = entry->type;
/*
* in the case that the function being called is passed in as an argument,
* we cast it to the function kind that we're expecting.
*/
if (func_t == boxed_t) {
LLVMTypeRef exp_func_t = make_function_type(arg_c, 0);
LLVMTypeRef exp_func_ptr_t = LLVMPointerType(exp_func_t, 0);
LLVMValueRef casted = LLVMBuildPointerCast(builder, entry->value,
exp_func_ptr_t, "func_cast");
func_t = exp_func_t;
func_p = casted;
}
LLVMValueRef res =
build_call(builder, func_t, func_p, args, arg_c, "");
LLVMSetTailCall(res, tail_position);
return res;
}
void codegen_trmc_inner(char *outer_id, char **outer_param_ids, LLVMValueRef
inner_p, LLVMValueRef then_p, LLVMTypeRef then_t, LLVMValueRef else_p,
LLVMTypeRef else_t, sexpr *body, sexpr* inner_ast) {
sexpr *tail_recursive_call_ast = find_tail_recursive_call(outer_id,
inner_ast);
LLVMBasicBlockRef entry_b = LLVMAppendBasicBlock(inner_p, "entry");
LLVMBasicBlockRef then_b = LLVMAppendBasicBlock(inner_p, "trmc_then");
LLVMBasicBlockRef else_b = LLVMAppendBasicBlock(inner_p, "trmc_else");
put_builder_at_end(builder, entry_b);
sexpr *cond_node = body->contents.n.r;
sexpr *cond_ast = cond_node->contents.n.l;
sexpr *then_node = cond_node->contents.n.r;
sexpr *then_ast = then_node->contents.n.l;
sexpr *else_node = then_node->contents.n.r;
sexpr *else_ast = else_node->contents.n.l;
uint bit_width = opts->default_bit_width;
sexpr *bit_width_node = else_node->contents.n.r;
if (bit_width_node) bit_width = bit_width_node->contents.n.l->contents.i;
if (!bit_width) error(GENERAL_ERROR, "no bitwidth specified");
LLVMTypeRef int_t = LLVMIntType(bit_width);
/* FIXME: magic size */
LLVMValueRef next_args[50];
uint outer_arg_c =
get_args_from_list(tail_recursive_call_ast->contents.n.l->contents.n.r,
next_args);
uint inner_arg_c = outer_arg_c + 1;
/*
* We need to lift the conditional of the next recursive call up into
* this one. To do so, we'll add a new layer to the scope that masks the
* function's variables with the values of those variables the next call
* down.
*/
scope_push_layer(&sc);
for (uint i = 0; i < (inner_arg_c - 1); ++i) {
scope_add_entry(sc, outer_param_ids[i], next_args[i], boxed_t);
}
LLVMValueRef cond_contents = _codegen(cond_ast, 0);
LLVMValueRef cond_res = unbox_val(inner_p, builder, cond_contents, int_t);
LLVMValueRef zero_v = LLVMConstInt(int_t, 0, 0);
LLVMValueRef cond_v = LLVMBuildICmp(builder, LLVMIntNE, cond_res, zero_v,
"neq_0");
LLVMBuildCondBr(builder, cond_v, then_b, else_b);
scope_pop_layer(&sc);
put_builder_at_end(builder, then_b);
if (is_tail_recursive_branch(outer_id, then_ast)) {
scope_entry *cons_e = scope_find(sc,
inner_ast->contents.n.l->contents.s);
LLVMValueRef next_space = build_gc_alloc(builder,
cons_e->filler.constructs, "then_space");
LLVMValueRef space = LLVMGetLastParam(inner_p);
/* FIXME: magic size */
LLVMValueRef filler_args[50];
uint cons_arg_c =
get_args_from_list_except_last(inner_ast->contents.n.r,
filler_args);
uint filler_arg_c = cons_arg_c + 1;
filler_args[cons_arg_c - 1] = next_space;
filler_args[filler_arg_c - 1] = space;
/* FIXME: magic size */
char filler_id[50];
make_filler_name(filler_id, 50, cons_e->id);
scope_entry *filler_e = scope_find(sc, filler_id);
build_call(builder, filler_e->type, filler_e->value, filler_args,
filler_arg_c, "");
next_args[inner_arg_c - 1] = next_space;
LLVMValueRef tail_call = build_call(builder, then_t, then_p,
next_args, inner_arg_c, "");
LLVMSetTailCall(tail_call, 1);
LLVMBuildRetVoid(builder);
} else {
/*
* Codegenning a simple branch requires masking the variables again
*/
scope_push_layer(&sc);
for (uint i = 0; i < (inner_arg_c - 1); ++i) {
scope_add_entry(sc, outer_param_ids[i], next_args[i], boxed_t);
}
LLVMValueRef res = _codegen(then_ast, 0);
scope_pop_layer(&sc);
LLVMValueRef space = LLVMGetLastParam(inner_p);
/* FIXME: magic size */
LLVMValueRef filler_args[50];
uint cons_arg_c =
get_args_from_list_except_last(inner_ast->contents.n.r,
filler_args);
uint filler_arg_c = cons_arg_c + 1;
filler_args[cons_arg_c - 1] = res;
filler_args[filler_arg_c - 1] = space;
char *cons_id = inner_ast->contents.n.l->contents.s;
scope_entry *cons_e = scope_find(sc, cons_id);
build_call(builder, cons_e->filler.type, cons_e->filler.value,
filler_args, filler_arg_c, "");
LLVMBuildRetVoid(builder);
}
put_builder_at_end(builder, else_b);
if (is_tail_recursive_branch(outer_id, else_ast)) {
scope_entry *cons_e = scope_find(sc,
inner_ast->contents.n.l->contents.s);
LLVMValueRef next_space = build_gc_alloc(builder,
cons_e->filler.constructs, "else_space");
LLVMValueRef space = LLVMGetLastParam(inner_p);
/* FIXME: magic size */
LLVMValueRef filler_args[50];
uint cons_arg_c =
get_args_from_list_except_last(inner_ast->contents.n.r,
filler_args);
uint filler_arg_c = cons_arg_c + 1;
filler_args[cons_arg_c - 1] = next_space;
filler_args[filler_arg_c - 1] = space;
/* FIXME: magic size */
char filler_id[50];
make_filler_name(filler_id, 50, cons_e->filler.id);
build_call(builder, cons_e->filler.type, cons_e->filler.value,
filler_args, filler_arg_c, "");
next_args[inner_arg_c - 1] = next_space;
LLVMValueRef tail_call = build_call(builder, else_t, else_p,
next_args, inner_arg_c, "");
LLVMSetTailCall(tail_call, 1);
LLVMBuildRetVoid(builder);
} else {
/*
* Codegenning a simple branch requires masking the variables again
*/
scope_push_layer(&sc);
for (uint i = 0; i < (inner_arg_c - 1); ++i) {
scope_add_entry(sc, outer_param_ids[i], next_args[i], boxed_t);
}
LLVMValueRef res = _codegen(else_ast, 0);
scope_pop_layer(&sc);
LLVMValueRef space = LLVMGetLastParam(inner_p);
/* FIXME: magic size */
LLVMValueRef filler_args[50];
uint cons_arg_c =
get_args_from_list_except_last(inner_ast->contents.n.r,
filler_args);
uint filler_arg_c = cons_arg_c + 1;
filler_args[cons_arg_c - 1] = res;
filler_args[filler_arg_c - 1] = space;
char *cons_id = inner_ast->contents.n.l->contents.s;
scope_entry *cons_e = scope_find(sc, cons_id);
/* FIXME: magic size */
char filler_id[50];
make_filler_name(filler_id, 50, cons_e->filler.id);
scope_entry *filler_e = scope_find(sc, filler_id);
build_call(builder, filler_e->type, filler_e->value, filler_args,
filler_arg_c, "");
LLVMBuildRetVoid(builder);
}
add_func_enum_attr(inner_p, "nounwind", 0, 1);
add_enum_attr(inner_p, inner_arg_c, "nonnull", 0, 1);
}
void codegen_trmc(scope_entry *outer_e, uint outer_param_c, sexpr *body,
char **param_names) {
/*
* making a TRMC function TR requires creating an inner function that is
* called by the outer function, and that calls the cons function with a
* null final argument so that the final function called is the inner
* function itself.
*
* The inner function is given a pointer to space for it to fill alongside
* its usual arguments. It should fill this space, then (as its final
* action) tail-call itself recursively with a new space.
*
* The outer function has to call the cons for the first inner function call
* (of which there will always be at least one), but it needs to pass a
* dummy value in place of the return value of the inner function since it
* hasn't been called yet.
*
* This can be acheived by building two blocks for the outer function:
* 1. Regular code generation, except when the recursive tail-call is
* detected it is replaced by a pointer to empty space.
* 2. Call the previously-omitted tail-call, giving it its regular arguments
* plus a pointer to the space it should fill (rather than allocating
* space itself.
*
* 1 jumps straight into 2; having separate blocks means that 2 can be
* generated as soon as the recursive tail-call is found.
*
* The difficulty is that 1 needs a pointer to space already allocated for
* the right size for the result of 2. If the inner function contains a
* conditional (which it almost certainly does for managing a base case),
* then the size required could be variable. Pushing the conditional up to
* the caller function means it can allocate the correct amount of space.
*
* As an example:
*
* [def map [f xs]
* [if [is_nil xs]
* [nil]
* [cons [f [head xs]]
* [map f [tail xs]]]]]
*
* This definition of map is TRMC, and should become the following
* pseudocode:
*
* map(f, xs):
* if (is_nil(xs)):
* p = allocate_space_for(nil)
* else:
* p = allocate_space_for(cons)
* map_inner(f, xs, p)
* return p
*
* map_inner(f, xs, p):
* if (is_nil(xs)):
* *p = nil()
* else:
* next_xs = tail(xs)
* if (is_nil(next_xs)):
* q = allocate_space(nil)
* else:
* q = allocate_space(cons)