Add basic features for types and objects (#52)

* started adding simple functions in gcommon

* more tests and features

* more tests, debug windows

* debug prints for windows

* back up some regs for windows

* remove debugging prints

common/type_system/TypeSystem.cpp

@@ -569,7 +569,7 @@ void TypeSystem::add_builtin_types() {
   add_method(obj_type, "inspect", make_function_typespec({"_type_"}, "_type_"));
   add_method(obj_type, "length",
              make_function_typespec({"_type_"}, "int32"));  // todo - this integer type?
-  add_method(obj_type, "asize-of", make_function_typespec({"_type_"}, "int32"));
+  add_method(obj_type, "asize-of", make_function_typespec({"_type_"}, "int"));
   add_method(obj_type, "copy", make_function_typespec({"_type_", "symbol"}, "_type_"));
   add_method(obj_type, "relocate", make_function_typespec({"_type_", "int32"}, "_type_"));
   add_method(obj_type, "mem-usage",
@@ -600,12 +600,12 @@ void TypeSystem::add_builtin_types() {
   add_method(type_type, "new", make_function_typespec({"symbol", "type", "int"}, "_type_"));
   add_field_to_type(type_type, "symbol", make_typespec("symbol"));
   add_field_to_type(type_type, "parent", make_typespec("type"));
-  add_field_to_type(type_type, "allocated-size", make_typespec("uint16"));  // todo, u16 or s16?
+  add_field_to_type(type_type, "size", make_typespec("uint16"));  // actually u16
   add_field_to_type(type_type, "psize",
                     make_typespec("uint16"));  // todo, u16 or s16. what really is this?
-  add_field_to_type(type_type, "heap-base", make_typespec("uint16"));     // todo
-  add_field_to_type(type_type, "method-count", make_typespec("uint16"));  // todo
-  add_field_to_type(type_type, "vtable", make_typespec("function"), false, true);
+  add_field_to_type(type_type, "heap-base", make_typespec("uint16"));         // todo
+  add_field_to_type(type_type, "allocated-length", make_typespec("uint16"));  // todo
+  add_field_to_type(type_type, "method-table", make_typespec("function"), false, true);
 
   // STRING
   builtin_structure_inherit(string_type);
@@ -640,6 +640,8 @@ void TypeSystem::add_builtin_types() {
 
   // pair
   pair_type->override_offset(2);
+  add_method(pair_type, "new",
+             make_function_typespec({"symbol", "type", "object", "object"}, "_type_"));
   add_field_to_type(pair_type, "car", make_typespec("object"));
   add_field_to_type(pair_type, "cdr", make_typespec("object"));
 

game/kernel/kscheme.cpp

@@ -361,22 +361,26 @@ Ptr<Function> make_function_from_c_win32(void* func) {
   }
 
   /*
-   * push rdi
-   * push rsi
-   * push rdx
-   * push rcx
-   * pop r9
-   * pop r8
-   * pop rdx
-   * pop rcx
-   *
-   * sub rsp, 40
-   * call rax
-   * add rsp, 40
-   * ret
+push rdi
+push rsi
+push rdx
+push rcx
+pop r9
+pop r8
+pop rdx
+pop rcx
+push r10
+push r11
+sub rsp, 40
+call rax
+add rsp, 40
+pop r11
+pop r10
+ret
    */
-  for (auto x : {0x57, 0x56, 0x52, 0x51, 0x41, 0x59, 0x41, 0x58, 0x5A, 0x59, 0x48,
-                 0x83, 0xEC, 0x28, 0xFF, 0xD0, 0x48, 0x83, 0xC4, 0x28, 0xC3}) {
+  for (auto x :
+       {0x57, 0x56, 0x52, 0x51, 0x41, 0x59, 0x41, 0x58, 0x5A, 0x59, 0x41, 0x52, 0x41, 0x53, 0x48,
+        0x83, 0xEC, 0x28, 0xFF, 0xD0, 0x48, 0x83, 0xC4, 0x28, 0x41, 0x5B, 0x41, 0x5A, 0xC3}) {
     mem.c()[i++] = x;
   }
 

goal_src/goal-lib.gc

@@ -138,6 +138,26 @@
     )
   )
 
+(defmacro until (test &rest body)
+  (with-gensyms (reloop)
+    `(begin
+       (label ,reloop)
+       ,@body
+       (when-goto (not ,test) ,reloop)
+       )
+    )
+  )
+
+(defmacro dotimes (var &rest body)
+  `(let (( ,(first var) 0))
+     (while (< ,(first var) ,(second var))
+            ,@body
+            (+1! ,(first var))
+            )
+     ,@(cddr var)
+     )
+  )
+
 ;; Backup some values, and restore after executing body.
 ;; Non-dynamic (nonlocal jumps out of body will skip restore)
 (defmacro protect (defs &rest body)
@@ -175,6 +195,50 @@
     )
   )
 
+;; TODO - these work but aren't very efficient.
+
+(defmacro and (&rest args)
+  (with-gensyms (result end)
+    `(begin
+       (let ((,result (the object #f)))
+         ,@(apply (lambda (x)
+                    `(begin
+                      (set! ,result ,x)
+                      (if (eq? ,result #f)
+                        (goto ,end)
+                        )
+                      )
+                    )
+                  args
+                  )
+         (label ,end)
+         ,result
+         )
+       )
+    )
+  )
+
+(defmacro or (&rest args)
+  (with-gensyms (result end)
+    `(begin
+       (let ((,result (the object #f)))
+         ,@(apply (lambda (x)
+                    `(begin
+                       (set! ,result ,x)
+                       (if (not (eq? ,result #f))
+                         (goto ,end)
+                         )
+                       )
+                    )
+                  args
+                  )
+         (label ,end)
+         ,result
+         )
+       )
+    )
+  )
+
 ;;;;;;;;;;;;;;;;;;;
 ;; Math Macros
 ;;;;;;;;;;;;;;;;;;;
@@ -201,4 +265,56 @@
 
 (defmacro 1- (var)
   `(- ,var 1)
+  )
+
+(defmacro zero? (thing)
+  `(eq? ,thing 0)
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Bit Macros
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro align16 (value)
+  `(logand #xfffffff0 (+ (the-as integer ,value) 15))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TYPE STUFF
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro basic? (obj)
+  ;; todo, make this more efficient
+  `(= 4 (logand (the integer ,obj) #b111))
+  )
+
+(defmacro pair? (obj)
+  ;; todo, make this more efficient
+  `(= 2 (logand (the integer ,obj) #b111))
+  )
+
+(defmacro binteger? (obj)
+  `(zero? (logand (the integer ,obj) #b111))
+  )
+
+(defmacro rtype-of (obj)
+  `(cond ((binteger? ,obj) binteger)
+         ((pair? ,obj) pair)
+         (else (-> (the basic ,obj) type))
+         )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PAIR STUFF
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defmacro cons (a b)
+  `(new 'global 'pair ,a ,b)
+  )
+
+(defmacro list (&rest args)
+  (if (null? args)
+    (quote '())
+    `(cons ,(car args) (list ,@(cdr args)))
+    )
   )

goal_src/kernel/gcommon.gc

@@ -259,8 +259,102 @@
   )
 
 
+;; The "print" method of a type should print out a single line representation of the object.
+;; The default print method for a basic will be something like #<my-type @ #xbeef>
+;; This is used when printing an object with format, using the "~A" format specification.
+;; And of course in functions like print, printl.
 (defmethod print bfloat ((obj bfloat))
   "Override the default print method to print a bfloat like a normal float"
   (format #t "~f" (-> obj data))
   obj
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Type System
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; The asize-of method should return the total size in memory used by an object.
+; It's used for traversing heaps of basics and copying basics.
+; Most basic/structure types are "fixed size", and their default asize-of method will simply
+; return the "size" field of their type, so you don't have to worry about it.
+; However, some types are dynamic (like a string) and require that you provide your own method.
+; A common approach is to have an "allocated-length" field, then have the asize-of method return
+;  (+ (-> obj type size) (* elem-size (-> obj allocated-length)))
+; asize-of returns the actual size, including the type field, and can have any alignment.
+
+;; A "type" object contains some basic information about a type as well as the list of methods.
+;; Some types have more methods than others, so the method table makes "type" a dynamic type.
+;; As a result, we should define an "asize-of" method for type. It's possibly unused because it's wrong.
+
+(defmethod asize-of type ((obj type))
+  "Get the size in memory of a type"
+  ;; The 28 is 8 bytes too large. It's also strange that types have a 16-byte aligned size always, 
+  ;; but this matches what the runtime does as well. There's no reason that I can see for this,
+  ;; as other basics don't require 16-byte aligned sizes.
+  (align16 (+ 28 (* 4 (-> type allocated-length))))
+  )
+
+(defun basic-type? ((obj basic) (input-type type))
+  "Is obj an object of type input-type, or of child type of input-type?
+  Note: checking if a basic is of type object will return #f."
+  (let ((basics-type (-> obj type))
+        (object-type object))
+    (until (eq? (set! basics-type (-> basics-type parent)) object-type)
+           (if (eq? basics-type input-type)
+             ;; return-from #f will return from the function with the value of #t
+             (return-from #f #t)
+             )
+           )
+    )
+  #f ;; didn't find it, return false
+  )
+
+(defun type-type? ((a type) (b type))
+  "is a a type (or child type) of type b?"
+  (until (eq? a object)
+         ;; it's not clear why a might be zero?
+         ;; perhaps if the type system is not yet initialized fully for the type?
+         (if (or (eq? a b) (zero? a))
+           (return-from #f #t)
+           )
+         (set! a (-> a parent))
+         )
+  #f
+  )
+
+(defun find-parent-method ((the-type type) (method-id int))
+  "Find the nearest parent which has a different method, and get that method.
+  Use with extreme caution - if a checked parent has fewer methods than the child, it will
+  access out-of-bounds memory. Returns the nothing function if it gets to the top and
+  the parent has the same type, or if any parent has 0 as a method."
+  (let* ((child-method (-> the-type method-table method-id))
+         (parent-method child-method)
+         )
+
+    ;; keep looking until we find a different parent method
+    (until (not (eq? parent-method child-method))
+           ;; at the top of the type tree.
+           (if (eq? the-type object)
+             (return-from #f nothing)
+             )
+
+           (set! the-type (-> the-type parent))
+           (set! parent-method (-> the-type method-table method-id))
+           (if (eq? 0 (the int parent-method))
+             (return-from #f nothing)
+             )
+           )
+    parent-method
+    )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; pair and list
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun ref ((obj object) (idx int))
+  "Get the nth item from a list.  No type checking or range checking is done, so be careful!"
+  (dotimes (i idx (car obj))
+    (set! obj (cdr obj))
+    )
   )

goal_src/test/test-access-inline-array.gc

@@ -0,0 +1,18 @@
+(let* ((new-method (-> bfloat method-table 0))
+       (print-method (-> bfloat method-table 2))
+       (my-float (the bfloat (new-method 'global bfloat)))
+       )
+  (set! (-> my-float data) 1.23456)
+  (print-method my-float)
+  (format #t "~%")
+  )
+
+#|
+(let ((x 0))
+  (while (< x 9)
+         (format #t "method ~d of ~A is ~A~%" x bfloat (-> bfloat method-table x))
+         (+1! x)
+         )
+  )
+|#
+  0

goal_src/test/test-align16-1.gc

@@ -0,0 +1 @@
+(+ (align16 1) (align16 (* 3 5)) (align16 (/ 32 2)) (align16 (- -17)))

goal_src/test/test-align16-2.gc

@@ -0,0 +1,5 @@
+(defun type-method-check ((obj type))
+  (align16 (+ 28 (* 4 (-> obj allocated-length))))
+  )
+
+(type-method-check integer)

goal_src/test/test-basic-type-check.gc

@@ -0,0 +1,19 @@
+(define-extern hack-bfloat integer)
+(define hack-bfloat (+ #x6000000 4))
+(define-extern hack-bfloat bfloat)
+
+
+(format #t "~A~A~A~A"
+        (basic-type? hack-bfloat integer) ;; #f
+        (basic-type? hack-bfloat structure) ;; #t
+        (basic-type? integer type) ;; #t
+        (basic-type? hack-bfloat object)    ;; #t
+        )
+
+(format #t "~A~A~A~A~%"
+        (basic-type? integer basic) ;; t
+        (basic-type? integer integer) ;; #f
+        (basic-type? #f basic) ;; #t
+        (basic-type? inspect function) ;; #t
+        )
+        0

goal_src/test/test-bfloat.gc

@@ -0,0 +1,10 @@
+;; awful hack to create a bfloat
+(define-extern hack-bfloat integer)
+(define hack-bfloat (+ #x6000000 4))
+(define-extern hack-bfloat bfloat)
+
+(set! (-> hack-bfloat type) bfloat)
+(set! (-> hack-bfloat data) 1.233)
+
+(format #t "data ~f print ~A type ~A~%" (-> hack-bfloat data) hack-bfloat (-> hack-bfloat type))
+0

goal_src/test/test-car-cdr-get.gc

@@ -0,0 +1,4 @@
+(let ((my-pair (cons 'a 'b)))
+  (format #t "~A~A~%" (car my-pair) (cdr my-pair))
+  )
+  0

goal_src/test/test-car-cdr-set.gc

@@ -0,0 +1,6 @@
+(let ((my-pair (cons 'a 'b)))
+  (set! (car my-pair) 'c)
+  (set! (cdr my-pair) 'd)
+  (format #t "~A~%" my-pair)
+  )
+  0

goal_src/test/test-condition-boolean.gc

@@ -0,0 +1,22 @@
+(let ((total 0))
+  (if (true-func)
+    (+! total 1)
+    (+! total 999)
+    )
+
+  (if (false-func)
+    (+! total 999)
+    (+! total 1)
+    )
+
+  (if (not (true-func))
+    (+! total 999)
+    (+! total 1)
+    )
+
+  (if (not (false-func))
+    (+! total 1)
+    (+! total 999)
+    )
+  total
+  )

goal_src/test/test-cons.gc

@@ -0,0 +1,2 @@
+(format #t "~A~%" (cons 'a 'b))
+0

goal_src/test/test-dotimes.gc

@@ -0,0 +1,6 @@
+(let ((sum 0))
+  (dotimes (i 100 7 8 9 sum)
+    (+! sum i)
+    ;;(format #t "iter ~D sum ~D~%" i sum)
+    )
+  )

goal_src/test/test-empty-pair.gc

@@ -0,0 +1,2 @@
+(format #t "~A~%" '())
+0

goal_src/test/test-find-parent-method.gc

@@ -0,0 +1,22 @@
+(let ((test-result "test fail!"))
+
+  ;; first, do one where we get something
+  (if (eq?
+        (-> structure method-table 1)
+        (find-parent-method bfloat 1)
+        )
+    (set! test-result "test pass!")
+    )
+
+  ;; nothing
+  (if (not (eq?
+             (find-parent-method structure 5)
+             nothing
+             )
+           )
+    (format #t "TEST FAIL~%~%")
+    )
+
+  (print test-result)
+  )
+0

goal_src/test/test-inline-array-field.gc

@@ -0,0 +1,6 @@
+(let* ((base (the int integer))
+       (field (the int (-> integer method-table)))
+       (offset (- field base)))
+  ;;(format #t "offset of methods table is ~d~%" offset)
+  offset
+  )

goal_src/test/test-list.gc

@@ -0,0 +1 @@
+(format #t "~A~%" (list 'a 'b 'c 'd))

goal_src/test/test-nested-car-cdr-set.gc

@@ -0,0 +1,9 @@
+(let ((my-pair (cons (cons 'a 'b) (cons 'c 'd))))
+  (set! (car (car my-pair)) 'e)
+  (set! (car (cdr my-pair)) 'f)
+  (set! (cdr (car my-pair)) 'g)
+  (set! (cdr (cdr my-pair)) 'h)
+  (format #t "~A~A~A~A~%" (car (car my-pair)) (car (cdr my-pair)) (cdr (car my-pair)) (cdr (cdr my-pair)))
+  (format #t "~A~%" my-pair)
+  )
+  0

goal_src/test/test-pair-check.gc

@@ -0,0 +1,2 @@
+(format #t "~A~A~%" (pair? '()) (pair? integer))
+0

goal_src/test/test-ref.gc

@@ -0,0 +1 @@
+(ref (list 1 23 5 83 4) 3)

goal_src/test/test-return-from-f-tricky-color.gc

@@ -0,0 +1,27 @@
+(define-extern _format function)
+(define format _format)
+;(db)
+
+;(format #t "running~%")
+
+(defun get-an-integer ()
+  12)
+
+(defun test-function-5 ((x int))
+  (while (> x 20)
+         (set! x (- x 1))
+         ;(format #t " x is now ~d~%" x)
+         (if (> 30 x)
+           (return-from #f 77)
+           )
+
+         (if (= (get-an-integer) 13)
+           (format #t "bad!~%")
+           )
+         987
+         )
+  )
+
+(let ((result (test-function-5 64)))
+  result
+  )

goal_src/test/test-return-from-f.gc

@@ -0,0 +1,14 @@
+(defun test-function-3 ((x int))
+  (while (> x 20)
+         (set! x (- x 1))
+         ;;(format #t " x is now ~d~%" x)
+         (if (> 30 x)
+           (return-from #f 77)
+           )
+         )
+  987
+  )
+
+(let ((result (test-function-3 64)))
+  result
+  )

goal_src/test/test-return-value-of-if.gc

@@ -0,0 +1,7 @@
+(let ((x (if (> 1 2) "a string!"))
+      (y (if (> 2 1) 123)))
+  (if x
+    (format #t "failure!")
+    )
+  y
+  )

goal_src/test/test-signed-int-compare.gc

@@ -0,0 +1,52 @@
+(let ((total 0))
+  (if (> 2 -1)
+    (+! total 1)
+    (+! total 999)
+    )
+  (if (> -20 3)
+    (+! total 999)
+    (+! total 1)
+    )
+  (if (> 1 1)
+    (+! total 999)
+    (+! total 1)
+    )
+  (if (< -1 2)
+    (+! total 1)
+    (+! total 999)
+    )
+  (if (< 2 -1)
+    (+! total 999)
+    (+! total 1)
+    )
+  (if (< 3 3)
+    (+! total 999)
+    (+! total 1)
+    )
+
+  (if (>= 2 -1)
+    (+! total 1)
+    (+! total 999)
+    )
+  (if (>= -20 3)
+    (+! total 999)
+    (+! total 1)
+    )
+  (if (>= 1 1)
+    (+! total 1)
+    (+! total 999)
+    )
+  (if (<= -1 2)
+    (+! total 1)
+    (+! total 999)
+    )
+  (if (<= 2 -1)
+    (+! total 999)
+    (+! total 1)
+    )
+  (if (<= 3 3)
+    (+! total 1)
+    (+! total 999)
+    )
+  total
+  )

goal_src/test/test-type-type.gc

@@ -0,0 +1,2 @@
+(format #t "~A~A~%" (type-type? type structure) (type-type? type integer))
+0

goalc/compiler/Compiler.cpp

@@ -152,12 +152,6 @@ void Compiler::color_object_file(FileEnv* env) {
       input.debug_instruction_names.push_back(i->print());
     }
 
-    // temp hack
-    {
-      for (auto& arg : f->params) {
-        input.instructions.front().write.push_back(arg.second->ireg());
-      }
-    }
     input.max_vars = f->max_vars();
     input.constraints = f->constraints();
 

goalc/compiler/Compiler.h

@@ -65,6 +65,7 @@ class Compiler {
       const std::unordered_map<std::string, std::pair<bool, MatchParam<goos::ObjectType>>>& named);
   std::string as_string(const goos::Object& o);
   std::string symbol_string(const goos::Object& o);
+  std::string quoted_sym_as_string(const goos::Object& o);
   const goos::Object& pair_car(const goos::Object& o);
   const goos::Object& pair_cdr(const goos::Object& o);
   void expect_empty_list(const goos::Object& o);
@@ -172,6 +173,12 @@ class Compiler {
   Val* compile_deftype(const goos::Object& form, const goos::Object& rest, Env* env);
   Val* compile_defmethod(const goos::Object& form, const goos::Object& rest, Env* env);
   Val* compile_deref(const goos::Object& form, const goos::Object& rest, Env* env);
+  Val* compile_the_as(const goos::Object& form, const goos::Object& rest, Env* env);
+  Val* compile_the(const goos::Object& form, const goos::Object& rest, Env* env);
+  Val* compile_print_type(const goos::Object& form, const goos::Object& rest, Env* env);
+  Val* compile_new(const goos::Object& form, const goos::Object& rest, Env* env);
+  Val* compile_car(const goos::Object& form, const goos::Object& rest, Env* env);
+  Val* compile_cdr(const goos::Object& form, const goos::Object& rest, Env* env);
 };
 
 #endif  // JAK_COMPILER_H

goalc/compiler/IR.cpp

@@ -686,7 +686,7 @@ IR_LoadConstOffset::IR_LoadConstOffset(const RegVal* dest,
     : m_dest(dest), m_offset(offset), m_base(base), m_info(info) {}
 
 std::string IR_LoadConstOffset::print() {
-  return fmt::format("mov {}, [{} + {}]\n", m_dest->print(), m_base->print(), m_offset);
+  return fmt::format("mov {}, [{} + {}]", m_dest->print(), m_base->print(), m_offset);
 }
 
 RegAllocInstr IR_LoadConstOffset::to_rai() {
@@ -707,4 +707,86 @@ void IR_LoadConstOffset::do_codegen(emitter::ObjectGenerator* gen,
   } else {
     throw std::runtime_error("IR_LoadConstOffset::do_codegen xmm not supported");
   }
-}
+}
+
+///////////////////////
+// StoreConstantOffset
+///////////////////////
+IR_StoreConstOffset::IR_StoreConstOffset(const RegVal* value,
+                                         int offset,
+                                         const RegVal* base,
+                                         int size)
+    : m_value(value), m_offset(offset), m_base(base), m_size(size) {}
+
+std::string IR_StoreConstOffset::print() {
+  return fmt::format("move [{} + {}], {}", m_base->print(), m_offset, m_value->print());
+}
+
+RegAllocInstr IR_StoreConstOffset::to_rai() {
+  RegAllocInstr rai;
+  rai.read.push_back(m_value->ireg());
+  rai.read.push_back(m_base->ireg());
+  return rai;
+}
+
+void IR_StoreConstOffset::do_codegen(emitter::ObjectGenerator* gen,
+                                     const AllocationResult& allocs,
+                                     emitter::IR_Record irec) {
+  if (m_value->ireg().kind == emitter::RegKind::GPR) {
+    gen->add_instr(
+        IGen::store_goal_gpr(get_reg(m_base, allocs, irec), get_reg(m_value, allocs, irec),
+                             emitter::gRegInfo.get_offset_reg(), m_offset, m_size),
+        irec);
+  } else if (m_value->ireg().kind == emitter::RegKind::XMM && m_size == 4) {
+    gen->add_instr(
+        IGen::store_goal_xmm32(get_reg(m_base, allocs, irec), get_reg(m_value, allocs, irec),
+                               emitter::gRegInfo.get_offset_reg(), m_offset),
+        irec);
+  } else {
+    throw std::runtime_error("IR_StoreConstOffset::do_codegen can't handle this");
+  }
+}
+
+///////////////////////
+// Null
+///////////////////////
+std::string IR_Null::print() {
+  return "null";
+}
+
+RegAllocInstr IR_Null::to_rai() {
+  return {};
+}
+
+void IR_Null::do_codegen(emitter::ObjectGenerator* gen,
+                         const AllocationResult& allocs,
+                         emitter::IR_Record irec) {
+  (void)gen;
+  (void)allocs;
+  (void)irec;
+}
+
+///////////////////////
+// FunctionStart
+///////////////////////
+IR_FunctionStart::IR_FunctionStart(std::vector<RegVal*> args) : m_args(std::move(args)) {}
+
+std::string IR_FunctionStart::print() {
+  return "function-start";
+}
+
+RegAllocInstr IR_FunctionStart::to_rai() {
+  RegAllocInstr rai;
+  for (auto& x : m_args) {
+    rai.write.push_back(x->ireg());
+  }
+  return rai;
+}
+
+void IR_FunctionStart::do_codegen(emitter::ObjectGenerator* gen,
+                                  const AllocationResult& allocs,
+                                  emitter::IR_Record irec) {
+  (void)gen;
+  (void)allocs;
+  (void)irec;
+}

goalc/compiler/IR.h

@@ -286,4 +286,43 @@ class IR_LoadConstOffset : public IR {
   MemLoadInfo m_info;
 };
 
+class IR_StoreConstOffset : public IR {
+ public:
+  IR_StoreConstOffset(const RegVal* value, int offset, const RegVal* base, int size);
+  std::string print() override;
+  RegAllocInstr to_rai() override;
+  void do_codegen(emitter::ObjectGenerator* gen,
+                  const AllocationResult& allocs,
+                  emitter::IR_Record irec) override;
+
+ private:
+  const RegVal* m_value = nullptr;
+  int m_offset = 0;
+  const RegVal* m_base = nullptr;
+  int m_size = 0;
+};
+
+class IR_Null : public IR {
+ public:
+  IR_Null() = default;
+  std::string print() override;
+  RegAllocInstr to_rai() override;
+  void do_codegen(emitter::ObjectGenerator* gen,
+                  const AllocationResult& allocs,
+                  emitter::IR_Record irec) override;
+};
+
+class IR_FunctionStart : public IR {
+ public:
+  IR_FunctionStart(std::vector<RegVal*> args);
+  std::string print() override;
+  RegAllocInstr to_rai() override;
+  void do_codegen(emitter::ObjectGenerator* gen,
+                  const AllocationResult& allocs,
+                  emitter::IR_Record irec) override;
+
+ private:
+  std::vector<RegVal*> m_args;
+};
+
 #endif  // JAK_IR_H

goalc/compiler/Util.cpp

@@ -104,6 +104,15 @@ std::string Compiler::symbol_string(const goos::Object& o) {
   return o.as_symbol()->name;
 }
 
+std::string Compiler::quoted_sym_as_string(const goos::Object& o) {
+  auto args = get_va(o, o);
+  va_check(o, args, {{goos::ObjectType::SYMBOL}, {goos::ObjectType::SYMBOL}}, {});
+  if (symbol_string(args.unnamed.at(0)) != "quote") {
+    throw_compile_error(o, "invalid quoted symbol " + o.print());
+  }
+  return symbol_string(args.unnamed.at(1));
+}
+
 const goos::Object& Compiler::pair_car(const goos::Object& o) {
   return o.as_pair()->car;
 }

goalc/compiler/Val.cpp

@@ -94,9 +94,17 @@ RegVal* FloatConstantVal::to_reg(Env* fe) {
 }
 
 RegVal* MemoryOffsetConstantVal::to_reg(Env* fe) {
-  (void)fe;
-  assert(false);
-  throw std::runtime_error("MemoryOffsetConstantVal::to_reg not yet implemented");
+  auto re = fe->make_gpr(m_ts);
+  fe->emit(std::make_unique<IR_LoadConstant64>(re, int64_t(offset)));
+  fe->emit(std::make_unique<IR_IntegerMath>(IntegerMathKind::ADD_64, re, base->to_gpr(fe)));
+  return re;
+}
+
+RegVal* MemoryOffsetVal::to_reg(Env* fe) {
+  auto re = fe->make_gpr(m_ts);
+  fe->emit(std::make_unique<IR_RegSet>(re, offset->to_gpr(fe)));
+  fe->emit(std::make_unique<IR_IntegerMath>(IntegerMathKind::ADD_64, re, base->to_gpr(fe)));
+  return re;
 }
 
 RegVal* MemoryDerefVal::to_reg(Env* fe) {
@@ -107,7 +115,34 @@ RegVal* MemoryDerefVal::to_reg(Env* fe) {
                                                   base_as_co->base->to_gpr(fe), info));
     return re;
   } else {
-    assert(false);
-    throw std::runtime_error("MemoryDerefVal::to_reg not yet implemented for this case");
+    auto re = fe->make_gpr(m_ts);
+    auto addr = base->to_gpr(fe);
+    fe->emit(std::make_unique<IR_LoadConstOffset>(re, 0, addr, info));
+    return re;
   }
+}
+
+RegVal* AliasVal::to_reg(Env* fe) {
+  auto result = base->to_reg(fe);
+  result->set_type(m_ts);
+  return result;
+}
+
+std::string PairEntryVal::print() const {
+  if (is_car) {
+    return fmt::format("[car of {}]", base->print());
+  } else {
+    return fmt::format("[cdr of {}]", base->print());
+  }
+}
+
+RegVal* PairEntryVal::to_reg(Env* fe) {
+  int offset = is_car ? -2 : 2;
+  auto re = fe->make_gpr(m_ts);
+  MemLoadInfo info;
+  info.reg = RegKind::GPR_64;
+  info.sign_extend = true;
+  info.size = 4;
+  fe->emit(std::make_unique<IR_LoadConstOffset>(re, offset, base->to_gpr(fe), info));
+  return re;
 }

goalc/compiler/Val.h

@@ -152,6 +152,16 @@ class MemoryOffsetConstantVal : public Val {
   int offset = 0;
 };
 
+class MemoryOffsetVal : public Val {
+ public:
+  MemoryOffsetVal(TypeSpec ts, Val* _base, Val* _offset)
+      : Val(std::move(ts)), base(_base), offset(_offset) {}
+  std::string print() const override { return "(" + base->print() + " + " + offset->print() + ")"; }
+  RegVal* to_reg(Env* fe) override;
+  Val* base = nullptr;
+  Val* offset = nullptr;
+};
+
 // MemOffConstant
 // MemOffVar
 
@@ -165,8 +175,23 @@ class MemoryDerefVal : public Val {
   MemLoadInfo info;
 };
 
-// PairEntry
-// Alias
+class PairEntryVal : public Val {
+ public:
+  PairEntryVal(TypeSpec ts, Val* _base, bool _is_car)
+      : Val(std::move(ts)), base(_base), is_car(_is_car) {}
+  std::string print() const override;
+  RegVal* to_reg(Env* fe) override;
+  Val* base = nullptr;
+  bool is_car = false;
+};
+
+class AliasVal : public Val {
+ public:
+  AliasVal(TypeSpec ts, Val* _base) : Val(std::move(ts)), base(_base) {}
+  std::string print() const override { return "alias-of-" + base->print(); }
+  RegVal* to_reg(Env* fe) override;
+  Val* base = nullptr;
+};
 
 class IntegerConstantVal : public Val {
  public:

goalc/compiler/compilation/Atoms.cpp

@@ -61,6 +61,12 @@ static const std::unordered_map<
         //        {"defenum", &Compiler::compile_defenum},
         {"->", &Compiler::compile_deref},
         //        {"&", &Compiler::compile_addr_of},
+        {"the-as", &Compiler::compile_the_as},
+        {"the", &Compiler::compile_the},
+        {"print-type", &Compiler::compile_print_type},
+        {"new", &Compiler::compile_new},
+        {"car", &Compiler::compile_car},
+        {"cdr", &Compiler::compile_cdr},
         //
         //
         //        // LAMBDA
@@ -74,26 +80,16 @@ static const std::unordered_map<
         //
         //
         //        // MACRO
-        //        {"print-type", &Compiler::compile_print_type},
+        //
         {"quote", &Compiler::compile_quote},
         {"mlet", &Compiler::compile_mlet},
         //        {"defconstant", &Compiler::compile_defconstant},
         //
         //        // OBJECT
-        //
-        //        {"the", &Compiler::compile_the},
-        //        {"the-as", &Compiler::compile_the_as},
-        //
-        //
-        //
         //        {"current-method-type", &Compiler::compile_current_method_type},
-        //        {"new", &Compiler::compile_new},
+        //
         //        {"method", &Compiler::compile_method},
-        //
-        //        // PAIR
-        //        {"car", &Compiler::compile_car},
-        //        {"cdr", &Compiler::compile_cdr},
-        //
+
         //        // IT IS MATH
         {"+", &Compiler::compile_add},
         {"-", &Compiler::compile_sub},

goalc/compiler/compilation/Define.cpp

@@ -67,6 +67,7 @@ Val* Compiler::compile_set(const goos::Object& form, const goos::Object& rest, E
   va_check(form, args, {{}, {}}, {});
 
   auto& destination = args.unnamed.at(0);
+  // todo, I don't know if this is the correct order or not.
   auto source = compile_error_guard(args.unnamed.at(1), env)->to_reg(env);
 
   if (destination.is_symbol()) {
@@ -96,7 +97,27 @@ Val* Compiler::compile_set(const goos::Object& form, const goos::Object& rest, E
       }
     }
   } else {
-    throw_compile_error(form, "Set not implemented for this yet");
+    auto dest = compile_error_guard(destination, env);
+    auto as_mem_deref = dynamic_cast<MemoryDerefVal*>(dest);
+    auto as_pair = dynamic_cast<PairEntryVal*>(dest);
+    if (as_mem_deref) {
+      auto base = as_mem_deref->base;
+      auto base_as_mco = dynamic_cast<MemoryOffsetConstantVal*>(base);
+      if (base_as_mco) {
+        auto ti = m_ts.lookup_type(base->type());
+        env->emit(std::make_unique<IR_StoreConstOffset>(
+            source, base_as_mco->offset, base_as_mco->base->to_gpr(env), ti->get_load_size()));
+        return source;
+      } else {
+        throw_compile_error(form, "Set not implemented for this (non-mco) yet");
+      }
+    } else if (as_pair) {
+      env->emit(std::make_unique<IR_StoreConstOffset>(source, as_pair->is_car ? -2 : 2,
+                                                      as_pair->base->to_gpr(env), 4));
+      return source;
+    } else {
+      throw_compile_error(form, "Set not implemented for this yet");
+    }
   }
   throw std::runtime_error("Unexpected error in Set");
 }

goalc/compiler/compilation/Function.cpp

@@ -96,6 +96,7 @@ Val* Compiler::compile_lambda(const goos::Object& form, const goos::Object& rest
 
     // set up arguments
     assert(lambda.params.size() < 8);  // todo graceful error
+    std::vector<RegVal*> args_for_coloring;
     for (u32 i = 0; i < lambda.params.size(); i++) {
       IRegConstraint constr;
       constr.instr_idx = 0;  // constraint at function start
@@ -104,6 +105,7 @@ Val* Compiler::compile_lambda(const goos::Object& form, const goos::Object& rest
       constr.desired_register = emitter::gRegInfo.get_arg_reg(i);
       new_func_env->params[lambda.params.at(i).name] = ireg;
       new_func_env->constrain(constr);
+      args_for_coloring.push_back(ireg);
     }
 
     place->func = new_func_env.get();
@@ -113,6 +115,7 @@ Val* Compiler::compile_lambda(const goos::Object& form, const goos::Object& rest
     auto func_block_env = new_func_env->alloc_env<BlockEnv>(new_func_env.get(), "#f");
     func_block_env->return_value = return_reg;
     func_block_env->end_label = Label(new_func_env.get());
+    func_block_env->emit(std::make_unique<IR_FunctionStart>(args_for_coloring));
 
     // compile the function!
     Val* result = nullptr;
@@ -128,13 +131,13 @@ Val* Compiler::compile_lambda(const goos::Object& form, const goos::Object& rest
     if (result) {
       auto final_result = result->to_gpr(new_func_env.get());
       new_func_env->emit(std::make_unique<IR_Return>(return_reg, final_result));
-      // new_func_env->emit(std::make_unique<IR_Null>())???
-      new_func_env->finish();
       lambda_ts.add_arg(final_result->type());
     } else {
       lambda_ts.add_arg(m_ts.make_typespec("none"));
     }
     func_block_env->end_label.idx = new_func_env->code().size();
+    new_func_env->emit(std::make_unique<IR_Null>());
+    new_func_env->finish();
 
     auto obj_env = get_parent_env_of_type<FileEnv>(new_func_env.get());
     assert(obj_env);

goalc/compiler/compilation/Macro.cpp

@@ -83,6 +83,11 @@ Val* Compiler::compile_quote(const goos::Object& form, const goos::Object& rest,
   switch (thing.type) {
     case goos::ObjectType::SYMBOL:
       return compile_get_sym_obj(thing.as_symbol()->name, env);
+    case goos::ObjectType::EMPTY_LIST: {
+      auto empty_pair = compile_get_sym_obj("_empty_", env);
+      empty_pair->set_type(m_ts.make_typespec("pair"));
+      return empty_pair;
+    }
       // todo...
     default:
       throw_compile_error(form, "Can't quote this");

goalc/compiler/compilation/Type.cpp

@@ -103,6 +103,7 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _
 
   // set up arguments
   assert(lambda.params.size() < 8);  // todo graceful error
+  std::vector<RegVal*> args_for_coloring;
   for (u32 i = 0; i < lambda.params.size(); i++) {
     IRegConstraint constr;
     constr.instr_idx = 0;  // constraint at function start
@@ -111,6 +112,7 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _
     constr.desired_register = emitter::gRegInfo.get_arg_reg(i);
     new_func_env->params[lambda.params.at(i).name] = ireg;
     new_func_env->constrain(constr);
+    args_for_coloring.push_back(ireg);
   }
 
   place->func = new_func_env.get();
@@ -120,6 +122,7 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _
   auto func_block_env = new_func_env->alloc_env<BlockEnv>(new_func_env.get(), "#f");
   func_block_env->return_value = return_reg;
   func_block_env->end_label = Label(new_func_env.get());
+  func_block_env->emit(std::make_unique<IR_FunctionStart>(args_for_coloring));
 
   // compile the function!
   Val* result = nullptr;
@@ -135,13 +138,13 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _
   if (result) {
     auto final_result = result->to_gpr(new_func_env.get());
     new_func_env->emit(std::make_unique<IR_Return>(return_reg, final_result));
-    // new_func_env->emit(std::make_unique<IR_Null>())???
-    new_func_env->finish();
     lambda_ts.add_arg(final_result->type());
   } else {
     lambda_ts.add_arg(m_ts.make_typespec("none"));
   }
   func_block_env->end_label.idx = new_func_env->code().size();
+  new_func_env->emit(std::make_unique<IR_Null>());
+  new_func_env->finish();
 
   auto obj_env = get_parent_env_of_type<FileEnv>(new_func_env.get());
   assert(obj_env);
@@ -209,7 +212,9 @@ Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest
           assert(di.mem_deref);
           result = fe->alloc_val<MemoryDerefVal>(di.result_type, loc, MemLoadInfo(di));
         } else {
-          assert(false);
+          result = fe->alloc_val<MemoryOffsetConstantVal>(field.type, result,
+                                                          field.field.offset() + offset);
+          // assert(false);
         }
         continue;
       }
@@ -217,8 +222,118 @@ Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest
       // todo try bitfield
     }
 
-    // todo array or other
-    assert(false);
+    auto index_value = compile_error_guard(field_obj, env)->to_gpr(env);
+    if (!is_integer(index_value->type())) {
+      throw_compile_error(form, "cannot use -> with " + field_obj.print());
+    }
+
+    if (result->type().base_type() == "inline-array") {
+      assert(false);
+    } else if (result->type().base_type() == "pointer") {
+      auto di = m_ts.get_deref_info(result->type());
+      auto base_type = di.result_type;
+      assert(di.mem_deref);
+      assert(di.can_deref);
+      auto offset = compile_integer(di.stride, env)->to_gpr(env);
+      env->emit(std::make_unique<IR_IntegerMath>(IntegerMathKind::IMUL_32, offset, index_value));
+      auto loc = fe->alloc_val<MemoryOffsetVal>(result->type(), result, offset);
+      result = fe->alloc_val<MemoryDerefVal>(di.result_type, loc, MemLoadInfo(di));
+    } else {
+      throw_compile_error(form, "can't access array of type " + result->type().print());
+    }
   }
   return result;
+}
+
+Val* Compiler::compile_the_as(const goos::Object& form, const goos::Object& rest, Env* env) {
+  auto args = get_va(form, rest);
+  va_check(form, args, {{}, {}}, {});
+  auto desired_ts = parse_typespec(args.unnamed.at(0));
+  auto base = compile_error_guard(args.unnamed.at(1), env);
+  return get_parent_env_of_type<FunctionEnv>(env)->alloc_val<AliasVal>(desired_ts, base);
+}
+
+Val* Compiler::compile_the(const goos::Object& form, const goos::Object& rest, Env* env) {
+  auto args = get_va(form, rest);
+  va_check(form, args, {{}, {}}, {});
+  auto desired_ts = parse_typespec(args.unnamed.at(0));
+  auto base = compile_error_guard(args.unnamed.at(1), env);
+
+  if (is_number(base->type())) {
+    if (m_ts.typecheck(m_ts.make_typespec("binteger"), desired_ts, "", false, false)) {
+      throw std::runtime_error("the convert to binteger not yet supported");
+    }
+
+    if (m_ts.typecheck(m_ts.make_typespec("integer"), desired_ts, "", false, false)) {
+      throw std::runtime_error("the convert to integer not yet supported");
+    }
+
+    if (m_ts.typecheck(m_ts.make_typespec("float"), desired_ts, "", false, false)) {
+      throw std::runtime_error("the convert to float not yet supported");
+    }
+  }
+
+  return get_parent_env_of_type<FunctionEnv>(env)->alloc_val<AliasVal>(desired_ts, base);
+}
+
+Val* Compiler::compile_print_type(const goos::Object& form, const goos::Object& rest, Env* env) {
+  auto args = get_va(form, rest);
+  va_check(form, args, {{}}, {});
+  fmt::print("[TYPE] {}\n", compile(args.unnamed.at(0), env)->type().print());
+  return get_none();
+}
+
+Val* Compiler::compile_new(const goos::Object& form, const goos::Object& _rest, Env* env) {
+  auto allocation = quoted_sym_as_string(pair_car(_rest));
+  auto rest = &pair_cdr(_rest);
+
+  // auto type_of_obj = get_base_typespec(quoted_sym_as_string(pair_car(rest)));
+  auto type_as_string = quoted_sym_as_string(pair_car(*rest));
+  rest = &pair_cdr(*rest);
+
+  if (allocation == "global" || allocation == "debug") {
+    if (type_as_string == "inline-array") {
+      assert(false);
+    } else if (type_as_string == "array") {
+      assert(false);
+    } else {
+      auto type_of_obj = m_ts.make_typespec(type_as_string);
+      std::vector<RegVal*> args;
+      // allocation
+      args.push_back(compile_get_sym_obj(allocation, env)->to_reg(env));
+      // type
+      args.push_back(compile_get_symbol_value(type_of_obj.base_type(), env)->to_reg(env));
+      // the other arguments
+      for_each_in_list(*rest, [&](const goos::Object& o) {
+        args.push_back(compile_error_guard(o, env)->to_reg(env));
+      });
+
+      auto new_method = compile_get_method_of_type(type_of_obj, "new", env);
+
+      auto new_obj = compile_real_function_call(form, new_method, args, env);
+      new_obj->set_type(type_of_obj);
+      return new_obj;
+    }
+  } else if (allocation == "static") {
+    assert(false);
+  }
+
+  throw_compile_error(form, "unsupported new form");
+  return get_none();
+}
+
+Val* Compiler::compile_car(const goos::Object& form, const goos::Object& rest, Env* env) {
+  auto args = get_va(form, rest);
+  va_check(form, args, {{}}, {});
+  auto fe = get_parent_env_of_type<FunctionEnv>(env);
+  return fe->alloc_val<PairEntryVal>(m_ts.make_typespec("object"),
+                                     compile_error_guard(args.unnamed.at(0), env), true);
+}
+
+Val* Compiler::compile_cdr(const goos::Object& form, const goos::Object& rest, Env* env) {
+  auto args = get_va(form, rest);
+  va_check(form, args, {{}}, {});
+  auto fe = get_parent_env_of_type<FunctionEnv>(env);
+  return fe->alloc_val<PairEntryVal>(m_ts.make_typespec("object"),
+                                     compile_error_guard(args.unnamed.at(0), env), false);
 }

goalc/emitter/ObjectFileData.cpp

@@ -14,11 +14,11 @@ std::vector<u8> ObjectFileData::to_vector() const {
   // data (code + static objects, by segment)
   for (int seg = N_SEG; seg-- > 0;) {
     result.insert(result.end(), segment_data[seg].begin(), segment_data[seg].end());
-    //        printf("seg %d data\n", seg);
-    //        for (auto x : segment_data[seg]) {
-    //          printf("%02x ", x);
-    //        }
-    //        printf("\n");
+    //    printf("seg %d data\n", seg);
+    //    for (auto x : segment_data[seg]) {
+    //      printf("%02x ", x);
+    //    }
+    //    printf("\n");
   }
   return result;
 }

test/test_compiler_and_runtime.cpp

@@ -129,6 +129,15 @@ TEST(CompilerAndRuntime, BuildGameAndTest) {
   runner.c = &compiler;
 
   runner.run_test("test-min-max.gc", {"10\n"});
+  runner.run_test("test-bfloat.gc", {"data 1.2330 print 1.2330 type bfloat\n0\n"});
+  runner.run_test("test-basic-type-check.gc", {"#f#t#t#f#t#f#t#t\n0\n"});
+  runner.run_test("test-condition-boolean.gc", {"4\n"});
+  runner.run_test("test-type-type.gc", {"#t#f\n0\n"});
+  runner.run_test("test-access-inline-array.gc", {"1.2345\n0\n"});
+  runner.run_test("test-find-parent-method.gc", {"\"test pass!\"\n0\n"});
+  runner.run_test("test-ref.gc", {"83\n"});
+
+  runner.print_summary();
 
   compiler.shutdown_target();
   runtime_thread.join();
@@ -283,6 +292,21 @@ TEST(CompilerAndRuntime, CompilerTests) {
   runner.run_test("test-nested-float-functions.gc",
                   {"i 1.4400 3.4000\nr 10.1523\ni 1.2000 10.1523\nr 17.5432\n17.543 10.152\n0\n"});
   runner.run_test("test-deref-simple.gc", {"structure\n0\n"});
+  runner.run_test("test-align16-1.gc", {"80\n"});
+  runner.run_test("test-align16-2.gc", {"64\n"});
+  runner.run_test("test-return-from-f.gc", {"77\n"});
+  runner.run_test("test-return-from-f-tricky-color.gc", {"77\n"});
+  runner.run_test("test-signed-int-compare.gc", {"12\n"});
+  runner.run_test("test-return-value-of-if.gc", {"123\n"});
+  runner.run_test("test-inline-array-field.gc", {"16\n"});
+  runner.run_test("test-empty-pair.gc", {"()\n0\n"});
+  runner.run_test("test-pair-check.gc", {"#t#f\n0\n"});
+  runner.run_test("test-cons.gc", {"(a . b)\n0\n"});
+  runner.run_test("test-list.gc", {"(a b c d)\n0\n"});
+  runner.run_test("test-car-cdr-get.gc", {"ab\n0\n"});
+  runner.run_test("test-car-cdr-set.gc", {"(c . d)\n0\n"});
+  runner.run_test("test-nested-car-cdr-set.gc", {"efgh\n((e . g) f . h)\n0\n"});
+  runner.run_test("test-dotimes.gc", {"4950\n"});
 
   compiler.shutdown_target();
   runtime_thread.join();