diff --git a/btl/runtime.c b/btl/runtime.c index d8ac61c..7732ddd 100644 --- a/btl/runtime.c +++ b/btl/runtime.c @@ -17,6 +17,11 @@ struct tigerarray { int64_t data[1]; }; +struct tigerrecord { + char *tag; + int64_t data[1]; +}; + /* Main function generated by compiler that will be linked with the runtime * library. */ extern int tigermain(int); @@ -65,12 +70,19 @@ struct tigerarray *initArray(int64_t size, int64_t init, int64_t is_ptr) { return a; } -int64_t *allocRecord(int size) { - int64_t *p, *a; - p = a = (int64_t *)malloc(size); +struct tigerrecord *allocRecord(char *tag) { + int size = strlen(tag); + struct tigerrecord *a = malloc(sizeof(char *) + size * sizeof(int64_t)); + + if (a == NULL) { + fprintf(stderr, "Failed to allocate memory for `allocRecord`.\n"); + exit(1); + } - for (int i = 0; i < size; i += sizeof(int)) - *p++ = 0; + a->tag = tag; + + for (int i = 0; i < size; i++) + a->data[i] = 0; return a; } diff --git a/lib/codegen.ml b/lib/codegen.ml index 770c60e..42cfe4c 100644 --- a/lib/codegen.ml +++ b/lib/codegen.ml @@ -372,7 +372,8 @@ module RiscVGen : CODEGEN = struct let generateFrag = function | Frame.PROC { body; frame } -> generateFunctionStm body frame - | Frame.STRING (lab, str) -> Frame.string lab str + | Frame.STRING (lab, str) -> Frame.string_obj lab str + | Frame.STRING_LIT (lab, str) -> Frame.string_lit lab str let%test_unit "test_codegen_test_files" = let test_dir = "../../../tests/codegen/" in diff --git a/lib/driver.ml b/lib/driver.ml index ec0ceb3..74d725f 100644 --- a/lib/driver.ml +++ b/lib/driver.ml @@ -23,7 +23,8 @@ let generateFrag f = in match f with | Frame.PROC { body; frame } -> generateFunctionStm body frame - | Frame.STRING (lab, str) -> Frame.string lab str + | Frame.STRING (lab, str) -> Frame.string_obj lab str + | Frame.STRING_LIT (lab, str) -> Frame.string_lit lab str let compile_channel ?filename chan = let absyn = Parser.parse_channel ?filename chan in diff --git a/lib/frame.ml b/lib/frame.ml index ef42083..bf0254b 100644 --- a/lib/frame.ml +++ b/lib/frame.ml @@ -17,6 +17,7 @@ module type FRAME = sig type frag = | PROC of { body : Tree.stm; frame : frame } | STRING of Temp.label * string + | STRING_LIT of Temp.label * string val new_frame : new_frame_args -> frame val name : frame -> Temp.label @@ -76,7 +77,8 @@ module type FRAME = sig val fn_prolog_epilog_to_string : fn_prolog_epilog -> register_map:register Temp.tbl -> string - val string : Symbol.symbol -> string -> string + val string_obj : Symbol.symbol -> string -> string + val string_lit : Symbol.symbol -> string -> string end (* TODO: Implement this if we really want to target the x86 architecture *) @@ -192,6 +194,7 @@ module RiscVFrame : FRAME = struct type frag = | PROC of { body : Tree.stm; frame : frame } | STRING of Temp.label * string + | STRING_LIT of Temp.label * string let word_size = 8 @@ -445,11 +448,17 @@ module RiscVFrame : FRAME = struct in { prolog; body; epilog } - (* Instruction to generate a string with a label. *) - let string label str = + (* Instruction to generate a string literal with a label. *) + let string_lit label str = + Printf.sprintf "\t.section\t.rodata\n\t.align\t3\n%s:\n\t.string\t\"%s\"\n" + (Symbol.name label) str + + (* Instruction to generate a string object with a label. *) + let string_obj label str = let label = Symbol.name label in - let new_label = Symbol.name @@ Temp.new_label () in + let tag_label = Temp.new_label () in let char_list = String.to_list @@ Stdlib.Scanf.unescaped str in + let tag_code = string_lit tag_label "!s" in let strlen = List.length char_list in (* We are aligning this to 8, i.e. .align 3 (power of 2) *) let padding = 8 - (strlen % 8) in @@ -460,21 +469,17 @@ module RiscVFrame : FRAME = struct literal, though this should be optimised for sure. *) let preamble = Printf.sprintf - " \t.globl\t%s\n\ - \t.section\t.rodata\n\ - \t.align\t3\n\ - %s:\n\ - \t.string\t\"!s\"\n\ - \t.data\n\ + "\t.globl\t%s\n\ + %s\t.data\n\ \t.align\t3\n\ \t.type\t%s, @object\n\ \t.size\t%s, %d\n\ %s:\n\ \t.dword\t%s\n\ \t.dword\t%d\n" - label new_label label label + label tag_code label label (8 + 8 + strlen + padding) - label new_label strlen + label (Symbol.name tag_label) strlen in let body = List.map char_list ~f:(fun c -> diff --git a/lib/semant.ml b/lib/semant.ml index dbd9b64..0ecfec6 100644 --- a/lib/semant.ml +++ b/lib/semant.ml @@ -195,8 +195,11 @@ module Semant : SEMANT = struct ~init:[] fields |> List.rev in + let is_ptr_list = + List.map ~f:(fun (_, ty) -> Types.is_ptr ty) fields + in { - exp = Translate.recordExp input_field_exps; + exp = Translate.recordExp input_field_exps is_ptr_list; ty = record_type; } | _ -> diff --git a/lib/translate.ml b/lib/translate.ml index 4d6c6cc..4e98ffc 100644 --- a/lib/translate.ml +++ b/lib/translate.ml @@ -102,7 +102,8 @@ module Translate = struct let alloc_local l escape = (l, Frame.alloc_local l.frame escape) let default_exp = Ex (Tree.CONST 0) let frags : Frame.frag list ref = ref [] - let str_labels : Temp.label StringMap.t ref = ref StringMap.empty + let str_obj_labels : Temp.label StringMap.t ref = ref StringMap.empty + let str_lit_labels : Temp.label StringMap.t ref = ref StringMap.empty let rec seq = function | [ a ] -> a @@ -164,16 +165,27 @@ module Translate = struct (* Create a new label and attach a string with this label to the fragment list *) let lab = - match StringMap.find_opt s !str_labels with + match StringMap.find_opt s !str_obj_labels with | Some l -> l | None -> let lab = Temp.new_label () in frags := Frame.STRING (lab, s) :: !frags; - str_labels := StringMap.add s lab !str_labels; + str_obj_labels := StringMap.add s lab !str_obj_labels; lab in Ex (T.NAME lab) + (* Generate label for a string literal, this generates an actual literal + in assembly and not a tiger string object. *) + let stringLiteral s = + match StringMap.find_opt s !str_lit_labels with + | Some l -> l + | None -> + let lab = Temp.new_label () in + frags := Frame.STRING_LIT (lab, s) :: !frags; + str_obj_labels := StringMap.add s lab !str_lit_labels; + lab + let binOpPlus e1 e2 = Tree.BINOP (Tree.PLUS, e1, e2) let binOpMul e1 e2 = Tree.BINOP (Tree.MUL, e1, e2) @@ -256,8 +268,10 @@ module Translate = struct (* TODO: We manually did the constant folding here, though it wouldn't been necessary if the compiler implemented constant folding as an optimisation. *) + (* +1 because the first slot is used for the tag *) T.MEM - (binOpPlus (T.TEMP r) (T.CONST (Frame.word_size * field_index))) )) + (binOpPlus (T.TEMP r) + (T.CONST (Frame.word_size * (field_index + 1)))) )) let assignExp (var, exp) = Nx (T.MOVE (unEx var, unEx exp)) @@ -341,10 +355,12 @@ module Translate = struct T.LABEL end_label; ]) - let recordExp fields = - let num_fields = List.length fields in - let record_size = num_fields * Frame.word_size in + let recordExp field_exps is_ptr_list = let r = Temp.new_temp () in + let tag_label = + List.map (fun e -> if e then "p" else "n") is_ptr_list + |> String.concat "" |> stringLiteral + in let _, processed_fields = List.fold_left (fun (idx, fs) field -> @@ -353,8 +369,9 @@ module Translate = struct ( T.MEM (binOpPlus (T.TEMP r) (T.CONST (idx * Frame.word_size))), unEx field ) :: fs )) - (0, []) fields + (1, []) field_exps (* Start from 1 as the first slot is for the tag *) in + Ex (T.ESEQ ( seq @@ -362,7 +379,8 @@ module Translate = struct T.MOVE ( T.TEMP r, unEx - @@ callStdlibExp ("malloc", [ Ex (T.CONST record_size) ]) ); + @@ callStdlibExp ("allocRecord", [ Ex (T.NAME tag_label) ]) + ); ] @ processed_fields), T.TEMP r )) @@ -460,5 +478,6 @@ module Translate = struct let init () = frags := []; - str_labels := StringMap.empty + str_obj_labels := StringMap.empty; + str_lit_labels := StringMap.empty end