Add features for gkernel 2 (#89)

* in progress

* format

common/type_system/TypeSystem.cpp

@@ -247,7 +247,6 @@ Type* TypeSystem::lookup_type(const std::string& name) const {
   } else {
     fmt::print("[TypeSystem] The type {} is not defined.\n", name);
   }
-
   throw std::runtime_error("lookup_type failed");
 }
 
@@ -719,8 +718,14 @@ void TypeSystem::add_builtin_types() {
   add_field_to_type(pair_type, "car", make_typespec("object"));
   add_field_to_type(pair_type, "cdr", make_typespec("object"));
 
-  // todo, with kernel
-  (void)connectable_type;
+  // this type is very strange, as the compiler knows about it in gkernel-h, yet it is
+  // defined inside of connect.
+  add_field_to_type(connectable_type, "next0", make_typespec("connectable"));
+  add_field_to_type(connectable_type, "prev0", make_typespec("connectable"));
+  add_field_to_type(connectable_type, "next1", make_typespec("connectable"));
+  add_field_to_type(connectable_type, "prev1", make_typespec("connectable"));
+
+  // todo
   (void)file_stream_type;
 }
 
@@ -1010,6 +1015,10 @@ std::string TypeSystem::lca_base(const std::string& a, const std::string& b) {
     return a;
   }
 
+  if (a == "none" || b == "none") {
+    return "none";
+  }
+
   auto a_up = get_path_up_tree(a);
   auto b_up = get_path_up_tree(b);
 

doc/changelog.md

@@ -35,3 +35,8 @@
 - Defining a type with `deftype` will auto-generate an inspect method.
 - The `new` operator can now create static structures and basics and set fields to integers or symbols.
 - The `neq?` operator now works when used outside of a branch condition (previously it generated a syntax error)
+- Methods which do not return a value no longer cause the compiler to abort
+- The `&+` form now accepts more than two arguments.
+- The `&+` form now works on `inline-array` and `structure`.
+- In the case where the type system would use a result type of `lca(none, x)`, the result type is now `none` instead of compiler abort.
+- The "none value" is now `(none)` instead of `none`

goal_src/kernel/gkernel-h.gc

@@ -48,6 +48,8 @@
 ;; tab size for printing.
 (defconstant *tab-size* (the binteger 8))
 
+(defconstant *gtype-basic-offset* 4)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ENUMS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -108,6 +110,7 @@
 ; optionally, threads may know how to suspend/resume themselves.
 
 (declare-type process basic)
+(declare-type stack-frame basic)
 
 ; DANGER - this type is created in kscheme.cpp. It has room for 12 methods and size 0x28 bytes.
 (deftype thread (basic)
@@ -124,7 +127,7 @@
   
   (:methods
     ;; todo, triple check these method numbers.
-    (stack-size-set! ((this thread) (stack-size integer)) none 9)
+    (stack-size-set! ((this thread) (stack-size int)) none 9)
     (thread-suspend ((this _type_)) none 10)       ;; only safe on a cpu-thread, but slot exists for thread
     (thread-resume  ((to-resume _type_)) none 11)  ;; only safe on a cpu-thread, but slot exists for thread
     )
@@ -166,10 +169,10 @@
    )
   
   (:methods
-    (activate ((obj process-tree) (dest process-tree) (name basic) (stack-top pointer)) basic 9)
-    (deactivate  ((obj process-tree)) basic 10)
+    (activate ((obj _type_) (dest process-tree) (name basic) (stack-top pointer)) basic 9)
+    (deactivate  ((obj _type_)) basic 10)
     (dummy-method-11 () none 11)
-    (run-logic? ((obj process-tree)) symbol 12)
+    (run-logic? ((obj _type_)) symbol 12)
     (dummy-method () none 13)
     )  
   
@@ -178,6 +181,42 @@
   :no-runtime-type ;; already defined by kscheme. Don't do it again.
   )
 
+
+;; A GOAL process.  A GOAL process contains memory and a suspendable main-thread.
+(deftype process (process-tree)
+  ((pool basic :offset-assert #x20)
+   (status basic :offset-assert #x24)
+   (pid int32 :offset-assert #x28)
+   (main-thread thread :offset-assert #x2c)
+   (top-thread thread :offset-assert #x30)
+   (entity basic :offset-assert #x34)
+   (state basic :offset-assert #x38)
+   (trans-hook function :offset-assert #x3c)
+   (post-hook function :offset-assert #x40)
+   (event-hook function :offset-assert #x44)
+   (allocated-length int32 :offset-assert #x48)
+   (next-state basic :offset-assert #x4c)
+   (heap-base pointer :offset-assert #x50)
+   (heap-top pointer :offset-assert #x54)
+   (heap-cur pointer :offset-assert #x58)
+   (stack-frame-top stack-frame :offset-assert #x5c)
+   (connection-list connectable :inline :offset-assert #x60)
+   (stack uint8 :dynamic :offset-assert #x70)
+   )
+  
+  (:methods
+    (activate ((obj process) (dest process-tree) (name basic) (stack-top pointer)) basic 9)
+    (deactivate  ((obj process)) basic 10)
+    (dummy-method-11 () none 11)
+    (run-logic? ((obj process)) symbol 12)
+    (dummy-method () none 13)
+    )  
+  
+  :size-assert #x70
+  :method-count-assert 14
+  :no-runtime-type ;; already defined by kscheme. Don't do it again.
+  )
+
 ;; A dead pool is simply a process-tree node which contains all dead processes.
 ;; It supports getting and returning processes.
 (deftype dead-pool (process-tree)

goal_src/kernel/gkernel.gc

@@ -116,3 +116,126 @@
     (set! *listener-function* (the (function object) #f))
     )
   )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Thread and CPU Thread
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; A GOAL thread represents the execute of code in a process.
+; Each process has a "main thread", which is suspended and resumed.
+; A process may also execute various temporary threads which always run until completion.
+; The currently executing thread of a process is the "top-thread".
+
+; Some GOAL threads also have the ability to "back up" their stack, while others are "temporary".
+; The main thread of a process can "back up" it's stack, and all others are temporary.
+
+; All threads are actually cpu-threads. It's not clear why there are two separate types.
+; Perhaps the thread was the public interface and cpu-thread is internal to the kernel?
+
+(defmethod delete thread ((obj thread))
+  "Clean up a thread. This assumes it's the top-thread of the process and restores the previous top thread."
+  (when (eq? obj (-> obj process main-thread))
+    ;; We have attempted to delete the main thread, which is bad.
+    (break)
+    )
+  
+  ;; restore the old top-thread.
+  (set! (-> obj process top-thread) (-> obj previous))
+  (none)
+  )
+
+(defmethod print thread ((obj thread))
+  "Print thread."
+  (format #t "#<~A ~S of ~S pc: #x~X @ #x~X>" (-> obj type) (-> obj name) (-> obj process name) (-> obj pc) obj)
+  obj)
+
+(defmethod stack-size-set! thread ((this thread) (stack-size int))
+  "Set the backup stack size of a thread. This should only be done on the main-thread.
+  This should be done immediately after allocating the main-thread"
+  
+  (let ((proc (-> this process)))
+    (cond
+      ((neq? this (-> proc main-thread))
+       ;; oops. can only change the size of a main-thread's stack.
+       (msg-err "illegal attempt change stack size of ~A when the main-thread is not the top-thread.~%" proc)
+       (break) ;; ADDED
+       )
+      
+      ((= (-> this stack-size) stack-size)
+       ;; we already have this size. Don't do anything.
+       )
+      
+      ((eq? (-> proc heap-cur) (&+ this (-> this type size) (- *gtype-basic-offset*) (-> this stack-size)))
+       ;; our heap cur point to right after us. So we can safely bump it forward to give us more space.
+       (set! (-> proc heap-cur) (the pointer (&+ this (-> this type size) (- *gtype-basic-offset*) stack-size)))
+       (set! (-> this stack-size) stack-size)
+       )
+      (else
+        (msg-err "illegal attempt change stack size of ~A after more heap allocation has occured.~%" proc)
+        )
+      )
+    )
+  (none)
+  )
+
+(defmethod new cpu-thread ((allocation symbol) (type-to-make type) (parent-process process) (name symbol) (stack-size int) (stack-top pointer))
+  "Create a new CPU thread. Will allocate the main thread if none exists, otherwise a temp thread.
+  Sets the thread as the top-thread of the process
+  This is a special new method which ignores the allocation symbol.
+  The stack-top is for the execution stack.
+  The stack-size is for the backup stack (applicable for main thread only)"
+  
+  ;; first, let's see if we're doing the main or temp thread
+  (let* ((obj (cond
+                ((-> parent-process top-thread)
+                 ;; temp thread.
+                 (the cpu-thread (&+ stack-top
+                                     (- PROCESS_STACK_SIZE)
+                                     *gtype-basic-offset*
+                                     ))
+                 )
+                (else
+                  ;; the main thread
+                  (let ((alloc (align16 (-> parent-process heap-cur)))) ;; start at heap cur, aligned
+                    ;; bump heap to include our thread + its stack
+                    (set! (-> parent-process heap-cur) (the pointer (+ alloc (-> type-to-make size) stack-size)))
+                    (the cpu-thread (+ alloc *gtype-basic-offset*))
+                    )
+                  )
+                )))
+    
+    ;; set up the type manually, as we allocated the memory manually
+    (set! (-> obj type) type-to-make)
+    
+    ;; set up thread
+    (set! (-> obj name) name)
+    (set! (-> obj process) parent-process)
+    ;; start stack at the top
+    (set! (-> obj sp) stack-top)
+    (set! (-> obj stack-top) stack-top)
+    ;; remember the previous thread, in case we're a temp thread
+    (set! (-> obj previous) (-> parent-process top-thread))
+    ;; and make us the top!
+    (set! (-> parent-process top-thread) obj)
+    
+    ;; set up our suspend/resume hooks. By default just use the thread's methods.
+    ;; but something else could install a different hook if needed.
+    (set! (-> obj suspend-hook) (method obj thread-suspend))
+    (set! (-> obj resume-hook) (method obj thread-resume))
+    
+    ;; remember how much space we have for the backup stack.
+    (set! (-> obj stack-size) stack-size)
+    obj
+    )
+  )
+
+
+(defmethod asize-of cpu-thread ((obj cpu-thread))
+  "Get the size of a cpu-thread"
+  ;; we need this because the cpu-thread is stored in the process stack
+  (the int (+ (-> obj type size) (-> obj stack-size)))
+  )
+
+;; todo remove-exit
+
+;; todo stream<-process-mask

goalc/compiler/Compiler.h

@@ -218,6 +218,7 @@ class Compiler {
   Val* compile_method(const goos::Object& form, const goos::Object& rest, Env* env);
   Val* compile_addr_of(const goos::Object& form, const goos::Object& rest, Env* env);
   Val* compile_declare_type(const goos::Object& form, const goos::Object& rest, Env* env);
+  Val* compile_none(const goos::Object& form, const goos::Object& rest, Env* env);
 };
 
 #endif  // JAK_COMPILER_H

goalc/compiler/compilation/Atoms.cpp

@@ -66,6 +66,7 @@ static const std::unordered_map<
         {"cdr", &Compiler::compile_cdr},
         {"method", &Compiler::compile_method},
         {"declare-type", &Compiler::compile_declare_type},
+        {"none", &Compiler::compile_none},
 
         // LAMBDA
         {"lambda", &Compiler::compile_lambda},
@@ -225,11 +226,6 @@ Val* Compiler::compile_get_symbol_value(const std::string& name, Env* env) {
 Val* Compiler::compile_symbol(const goos::Object& form, Env* env) {
   auto name = symbol_string(form);
 
-  // special case to get "nothing", used as a return value when nothing should be returned.
-  if (name == "none") {
-    return get_none();
-  }
-
   // see if the symbol is defined in any enclosing symbol macro envs (mlet's).
   auto mlet_env = get_parent_env_of_type<SymbolMacroEnv>(env);
   while (mlet_env) {
@@ -313,13 +309,31 @@ Val* Compiler::compile_float(float value, Env* env, int seg) {
 
 Val* Compiler::compile_pointer_add(const goos::Object& form, const goos::Object& rest, Env* env) {
   auto args = get_va(form, rest);
-  va_check(form, args, {{}, {}}, {});
+  if (args.unnamed.size() < 2 || !args.named.empty()) {
+    throw_compile_error(form, "&+ takes at least two arguments");
+  }
   auto first = compile_error_guard(args.unnamed.at(0), env)->to_gpr(env);
-  typecheck(form, m_ts.make_typespec("pointer"), first->type(), "&+ first argument");
-  auto second = compile_error_guard(args.unnamed.at(1), env)->to_gpr(env);
-  typecheck(form, m_ts.make_typespec("integer"), second->type(), "&+ second argument");
+
+  bool ok_type = false;
+  for (auto& type : {"pointer", "structure", "inline-array"}) {
+    if (m_ts.typecheck(m_ts.make_typespec(type), first->type(), "", false, false)) {
+      ok_type = true;
+      break;
+    }
+  }
+
+  if (!ok_type) {
+    throw_compile_error(form, "&+'s first argument must be a pointer, structure, or inline-array");
+  }
+
   auto result = env->make_gpr(first->type());
   env->emit(std::make_unique<IR_RegSet>(result, first));
-  env->emit(std::make_unique<IR_IntegerMath>(IntegerMathKind::ADD_64, result, second));
+
+  for (size_t i = 1; i < args.unnamed.size(); i++) {
+    auto second = compile_error_guard(args.unnamed.at(i), env)->to_gpr(env);
+    typecheck(form, m_ts.make_typespec("integer"), second->type(), "&+ second argument");
+    env->emit(std::make_unique<IR_IntegerMath>(IntegerMathKind::ADD_64, result, second));
+  }
+
   return result;
 }

goalc/compiler/compilation/Type.cpp

@@ -343,7 +343,8 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _
       new_func_env->settings.is_set = true;
     }
   });
-  if (result) {
+
+  if (result && !dynamic_cast<None*>(result)) {
     auto final_result = result->to_gpr(new_func_env.get());
     new_func_env->emit(std::make_unique<IR_Return>(return_reg, final_result));
     lambda_ts.add_arg(final_result->type());
@@ -706,3 +707,10 @@ Val* Compiler::compile_declare_type(const goos::Object& form, const goos::Object
 
   return get_none();
 }
+
+Val* Compiler::compile_none(const goos::Object& form, const goos::Object& rest, Env* env) {
+  (void)env;
+  auto args = get_va(form, rest);
+  va_check(form, args, {}, {});
+  return get_none();
+}