Skip to content

Commit

Permalink
Add tags to records
Browse files Browse the repository at this point in the history
- Also add support for generating string literals (as opposed to string
  objects) in the output code
  • Loading branch information
jamestjw committed Jun 21, 2024
1 parent 85a41b2 commit 98ddd85
Show file tree
Hide file tree
Showing 6 changed files with 71 additions and 30 deletions.
22 changes: 17 additions & 5 deletions btl/runtime.c
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down Expand Up @@ -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;
}
Expand Down
3 changes: 2 additions & 1 deletion lib/codegen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion lib/driver.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
29 changes: 17 additions & 12 deletions lib/frame.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 *)
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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 ->
Expand Down
5 changes: 4 additions & 1 deletion lib/semant.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}
| _ ->
Expand Down
39 changes: 29 additions & 10 deletions lib/translate.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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))

Expand Down Expand Up @@ -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 ->
Expand All @@ -353,16 +369,18 @@ 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
([
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 ))
Expand Down Expand Up @@ -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

0 comments on commit 98ddd85

Please sign in to comment.