Tag arrays and add their length to the runtime representation

btl/runtime.c

@@ -2,13 +2,21 @@
 #include <stdlib.h>
 #include <string.h>
 
+#define TAG_SIZE sizeof(char *)
+
 struct tigerstr {
   char *tag;
   int64_t length;
   /* This can be infinitely long when we start allocating strings. */
   unsigned char chars[1];
 };
 
+struct tigerarray {
+  char *tag;
+  int64_t length;
+  int64_t data[1];
+};
+
 /* Main function generated by compiler that will be linked with the runtime
  * library. */
 extern int tigermain(int);
@@ -33,18 +41,33 @@ void print(struct tigerstr *s) {
     putchar(*p);
 }
 
-int64_t *initArray(int64_t size, int64_t init) {
-  int64_t *a = (int64_t *)malloc(size * sizeof(int64_t));
+struct tigerarray *initArray(int64_t size, int64_t init, int64_t is_ptr) {
+  /* First slot is the tag, followed by the size of the array and then
+   * the data. */
+  struct tigerarray *a = malloc(TAG_SIZE + (size + 1) * sizeof(int64_t));
+  if (a == NULL) {
+    fprintf(stderr, "Failed to allocate memory for `initArray`.\n");
+    exit(1);
+  }
+
+  if (is_ptr) {
+    a->tag = "ap";
+  } else {
+
+    a->tag = "an";
+  }
+
+  a->length = size;
 
   for (int i = 0; i < size; i++)
-    a[i] = init;
+    a->data[i] = init;
 
   return a;
 }
 
-int *allocRecord(int size) {
-  int *p, *a;
-  p = a = (int *)malloc(size);
+int64_t *allocRecord(int size) {
+  int64_t *p, *a;
+  p = a = (int64_t *)malloc(size);
 
   for (int i = 0; i < size; i += sizeof(int))
     *p++ = 0;
@@ -90,7 +113,7 @@ struct tigerstr *substring(const struct tigerstr *s, int64_t first, int64_t n) {
   if (n == 1)
     return consts + s->chars[first];
   else {
-    struct tigerstr *t = malloc(sizeof(char *) + sizeof(int64_t) + n);
+    struct tigerstr *t = malloc(TAG_SIZE + sizeof(int64_t) + n);
     if (t == NULL) {
       fprintf(stderr, "Failed to allocate memory for `substring`.\n");
       exit(1);
@@ -116,7 +139,7 @@ struct tigerstr *concat(struct tigerstr *a, struct tigerstr *b) {
   else {
     int n = a->length + b->length;
 
-    struct tigerstr *t = malloc(sizeof(char *) + sizeof(int) + n);
+    struct tigerstr *t = malloc(TAG_SIZE + sizeof(int) + n);
     if (t == NULL) {
       fprintf(stderr, "Failed to allocate memory for `substring`.\n");
       exit(1);

lib/semant.ml

@@ -349,7 +349,9 @@ module Semant : SEMANT = struct
                         "array initial value expected to be of type %s"
                         (Types.to_string t) );
                   {
-                    exp = Translate.arrayExp (size_expty.exp, init_expty.exp);
+                    exp =
+                      Translate.arrayExp
+                        (size_expty.exp, init_expty.exp, Types.is_ptr t);
                     ty = ty';
                   }
               | _ -> { exp = Translate.default_exp; ty = Types.INT })

lib/translate.ml

@@ -177,18 +177,51 @@ module Translate = struct
   let binOpPlus e1 e2 = Tree.BINOP (Tree.PLUS, e1, e2)
   let binOpMul e1 e2 = Tree.BINOP (Tree.MUL, e1, e2)
 
+  (* Assume that stdlib functions do not require a static link *)
+  let callStdlibExp (name, args) =
+    Ex (Frame.externalCall (name, List.map unEx args))
+
   (* TODO: Emit code for bounds checking.
      Idea: Use the first word to store the array length
      and use that to carry out bounds checking. *)
   let subscriptVar (var_exp, index_exp) =
-    Ex
-      (T.MEM
-         (binOpPlus (unEx var_exp)
-            (binOpMul (T.CONST Frame.word_size) (unEx index_exp))))
+    (* var_exp + word_size * (2 + index) as the first word is the tag
+       and the second one is the size of the array. *)
 
-  (* Assume that stdlib functions do not require a static link *)
-  let callStdlibExp (name, args) =
-    Ex (Frame.externalCall (name, List.map unEx args))
+    (* Store the record pointer and index in a register so we don't evaluate
+       it twice. *)
+    let r1 = Temp.new_temp () in
+    let r2 = Temp.new_temp () in
+
+    let fail_label = Temp.new_label () in
+    let gte_zero_label = Temp.new_label () in
+    let ok_label = Temp.new_label () in
+    Ex
+      (T.ESEQ
+         ( seq
+             [
+               T.MOVE (T.TEMP r1, unEx var_exp);
+               T.MOVE (T.TEMP r2, unEx index_exp);
+               T.CJUMP (T.LT, T.TEMP r2, T.CONST 0, fail_label, gte_zero_label);
+               T.LABEL gte_zero_label;
+               T.CJUMP
+                 ( T.GE,
+                   T.TEMP r2,
+                   T.MEM (binOpPlus (T.TEMP r1) (T.CONST Frame.word_size)),
+                   fail_label,
+                   ok_label );
+               T.LABEL fail_label;
+               (* If we encounter a null pointer, print a message and exit *)
+               unNx
+                 (callStdlibExp
+                    ("print", [ stringExp "Array access is out of bounds\n" ]));
+               unNx (callStdlibExp ("exit", [ Ex (T.CONST 1) ]));
+               T.LABEL ok_label;
+             ],
+           T.MEM
+             (binOpPlus (T.TEMP r1)
+                (binOpMul (T.CONST Frame.word_size)
+                   (binOpPlus (T.TEMP r2) (T.CONST 2)))) ))
 
   let fieldVar (var_exp, field_index) =
     (* Store the record pointer in a register so we can
@@ -334,7 +367,9 @@ module Translate = struct
              @ processed_fields),
            T.TEMP r ))
 
-  let arrayExp (size, init) = callStdlibExp ("initArray", [ size; init ])
+  let arrayExp (size, init, is_ptr) =
+    let is_ptr = if is_ptr then Ex (T.CONST 1) else Ex (T.CONST 0) in
+    callStdlibExp ("initArray", [ size; init; is_ptr ])
 
   let findFunctionStaticLink (fn_level, call_level) =
     let rec do_one_level curr_level frame_addr =

lib/types.ml

@@ -39,6 +39,8 @@ module Types = struct
     | NIL, RECORD _ -> true
     | RECORD _, NIL -> true
     | _ -> false
+
+  let is_ptr = function RECORD _ | ARRAY _ | STRING -> true | _ -> false
 end
 
 open Base