Implement gkernel: Part 1 (#150)

* start gkernel implementation

* progress

* more of kernel

* swap to new dispatcher, will it work on windows

* update
This commit is contained in:
water111 2020-12-05 17:09:46 -05:00 committed by GitHub
parent 90e5c023f1
commit 06918e1fea
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
30 changed files with 2492 additions and 235 deletions

6
boot_kernel.sh Executable file
View file

@ -0,0 +1,6 @@
#!/bin/bash
# Directory of this script
DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null 2>&1 && pwd )"
$DIR/build/game/gk -fakeiso -debug "$@"

View file

@ -192,22 +192,22 @@ void declare_method(Type* type, TypeSystem* type_system, const goos::Object& def
}
}
std::vector<std::string> arg_types;
TypeSpec function_typespec("function");
for_each_in_list(args, [&](const goos::Object& o) {
if (o.is_symbol()) {
arg_types.emplace_back(symbol_string(o));
function_typespec.add_arg(parse_typespec(type_system, o));
} else {
auto next = cdr(&o);
arg_types.emplace_back(symbol_string(car(next)));
function_typespec.add_arg(parse_typespec(type_system, car(next)));
if (!cdr(next)->is_empty_list()) {
throw std::runtime_error("too many things in method def arg type: " + def.print());
};
}
});
function_typespec.add_arg(parse_typespec(type_system, return_type));
auto info = type_system->add_method(
type, method_name,
type_system->make_function_typespec(arg_types, symbol_string(return_type)));
auto info = type_system->add_method(type, method_name, function_typespec);
// check the method assert
if (id != -1) {

View file

@ -188,14 +188,15 @@
(declare-type process basic)
(declare-type stack-frame basic)
(declare-type cpu-thread basic)
;; gkernel-h
(deftype thread (basic)
((name basic :offset-assert 4)
(process process :offset-assert 8)
(previous thread :offset-assert 12)
(suspend-hook basic :offset-assert 16)
(resume-hook basic :offset-assert 20)
(suspend-hook (function cpu-thread none) :offset-assert 16)
(resume-hook (function cpu-thread none) :offset-assert 20)
(pc pointer :offset-assert 24)
(sp pointer :offset-assert 28)
(stack-top pointer :offset-assert 32)
@ -238,11 +239,12 @@
(parent (pointer process-tree) :offset-assert 12)
(brother (pointer process-tree) :offset-assert 16)
(child (pointer process-tree) :offset-assert 20)
(ppointer pointer :offset-assert 24)
(self basic :offset-assert 28)
(ppointer (pointer process-tree) :offset-assert 24)
(self process-tree :offset-assert 28)
)
(:methods
(new ((allocation symbol) (type-to-make type) (name basic)) _type_ 0)
(activate ((obj _type_) (dest process-tree) (name basic) (stack-top pointer)) basic 9)
(deactivate ((obj _type_)) basic 10)
(dummy-method-11 () none 11)
@ -260,10 +262,10 @@
((pool basic :offset-assert #x20)
(status basic :offset-assert #x24)
(pid int32 :offset-assert #x28)
(main-thread thread :offset-assert #x2c)
(main-thread cpu-thread :offset-assert #x2c)
(top-thread thread :offset-assert #x30)
(entity basic :offset-assert #x34)
(state basic :offset-assert #x38)
(state state :offset-assert #x38)
(trans-hook function :offset-assert #x3c)
(post-hook function :offset-assert #x40)
(event-hook function :offset-assert #x44)
@ -278,6 +280,7 @@
)
(:methods
(new ((allocation symbol) (type-to-make type) (name basic) (stack-size int)) _type_ 0)
(activate ((obj process) (dest process-tree) (name basic) (stack-top pointer)) basic 9)
(deactivate ((obj process)) basic 10)
(dummy-method-11 () none 11)
@ -296,8 +299,9 @@
;; nothing new!
)
(:methods
(get-process ((pool dead-pool) (type-to-make type) (stack-size integer)) process 14)
(return-process ((pool dead-pool) (proc process)) process-tree 15)
(new ((allocation symbol) (type-to-make type) (count int) (stack-size int) (name basic)) _type_ 0)
(get-process ((pool _type_) (type-to-make type) (stack-size int)) process 14)
(return-process ((pool _type_) (proc process)) none 15)
)
:size-assert #x20
:method-count-assert 16
@ -333,17 +337,18 @@
)
(:methods
(compact ((this dead-pool-heap) (count integer)) none 16)
(new ((allocation symbol) (type-to-make type) (name basic) (allocated-length int) (heap-size int)) _type_ 0)
(compact ((this dead-pool-heap) (count int)) none 16)
(shrink-heap ((this dead-pool-heap) (proc process)) dead-pool-heap 17)
(churn ((this dead-pool-heap) (count integer)) none 18)
(memory-used ((this dead-pool-heap)) integer 19)
(memory-total ((this dead-pool-heap)) integer 20)
(gap-size ((this dead-pool-heap) (rec dead-pool-heap-rec)) integer 21)
(churn ((this dead-pool-heap) (count int)) none 18)
(memory-used ((this dead-pool-heap)) int 19)
(memory-total ((this dead-pool-heap)) int 20)
(gap-size ((this dead-pool-heap) (rec dead-pool-heap-rec)) int 21)
(gap-location ((this dead-pool-heap) (rec dead-pool-heap-rec)) pointer 22)
(find-gap ((this dead-pool-heap) (rec dead-pool-heap-rec)) dead-pool-heap-rec 23)
(find-gap-by-size ((this dead-pool-heap) (size integer)) dead-pool-heap-rec 24)
(memory-free ((this dead-pool-heap)) integer 25)
(compact-time ((this dead-pool-heap)) integer 26)
(find-gap-by-size ((this dead-pool-heap) (size int)) dead-pool-heap-rec 24)
(memory-free ((this dead-pool-heap)) int 25)
(compact-time ((this dead-pool-heap)) uint 26)
)
:method-count-assert 27
@ -367,6 +372,11 @@
(freg float 6 :offset-assert 20)
(rreg uint128 8 :offset-assert 48)
)
(:methods
(new ((allocation symbol) (type-to-make type) (name symbol) (func function) (params (pointer uint64))) object 0)
)
:method-count-assert 9
:size-assert #xb0
:flag-assert #x9000000b0
@ -422,10 +432,129 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~;
(define-extern search-process-tree (function process-tree (function symbol object) object))
(define-extern kill-by-name (function object process-tree symbol))
(define-extern *kernel-version* binteger)
(define-extern *irx-version* binteger)
(define-extern *kernel-boot-mode* symbol)
(define-extern *kernel-boot-level* symbol)
(define-extern *deci-count* int)
(define-extern *last-loado-length* int)
(define-extern *last-loado-global-usage* int)
(define-extern *last-loado-debug-usage* int)
(define-extern *kernel-packages* pair)
(define-extern load-package (function string kheap pair))
(define-extern unload-package (function string pair))
(define-extern *kernel-context* kernel-context)
(define-extern *dram-stack* (pointer uint8))
(define-extern *null-kernel-context* kernel-context)
(define-extern remove-exit (function stack-frame))
(define-extern stream<-process-mask (function object int object))
(define-extern *master-mode* symbol)
(define-extern *pause-lock* symbol)
(define-extern inspect-process-heap (function process symbol))
(define-extern *kernel-sp* pointer)
(define-extern return-from-thread (function none))
(define-extern return-from-thread-dead (function none))
(define-extern reset-and-call (function thread function object))
(define-extern *debug-dead-pool* dead-pool-heap)
(define-extern *null-process* process)
(define-extern *vis-boot* basic)
(define-extern *stdcon* basic) ;; todo, more specific
(define-extern *global-search-name* basic)
(define-extern *global-search-count* int)
(define-extern process-by-name (function object process-tree process))
(define-extern process-not-name (function object process-tree process))
(define-extern process-count (function process-tree int))
(define-extern kill-by-name (function object process-tree symbol))
(define-extern kill-by-type (function object process-tree symbol))
(define-extern kill-not-name (function object process-tree symbol))
(define-extern kill-not-type (function object process-tree symbol))
(define-extern iterate-process-tree (function process-tree (function object object) kernel-context object))
(define-extern search-process-tree (function process-tree (function process-tree object) process))
(define-extern execute-process-tree (function process-tree (function object object) kernel-context object))
(define-extern change-parent (function process-tree process-tree process-tree))
(define-extern *active-pool* process-tree)
(define-extern kernel-dispatcher (function (function object)))
(define-extern inspect-process-tree (function process-tree int int symbol process-tree))
;;(define-extern stack-frame object) ;; unknown type
(define-extern state type)
;;(define-extern dead-pool-heap-rec object) ;; unknown type
;;(define-extern dead-pool object) ;; unknown type
;;(define-extern catch-frame object) ;; unknown type
;;(define-extern thread object) ;; unknown type
;;(define-extern handle object) ;; unknown type
;;(define-extern cpu-thread object) ;; unknown type
;;(define-extern dead-pool-heap object) ;; unknown type
(define-extern kernel-context type)
;;(define-extern protect-frame object) ;; unknown type
;;(define-extern event-message-block object) ;; unknown type
;;(define-extern process-tree object) ;; unknown type
;;(define-extern *listener-process* object) ;; unknown type
;;(define-extern *entity-pool* object) ;; unknown type
;;(define-extern *default-pool* object) ;; unknown type
;;(define-extern malloc object) ;; unknown type
;;(define-extern ready object) ;; unknown type
;;(define-extern *camera-pool* object) ;; unknown type
(define-extern throw-dispatch function)
;;(define-extern game object) ;; unknown type
(define-extern run-function-in-process function)
(define-extern throw function)
;;(define-extern *nk-dead-pool* object) ;; unknown type
(define-extern change-to-last-brother function)
;;(define-extern *pickup-dead-pool* object) ;; unknown type
;;(define-extern *camera-master-dead-pool* object) ;; unknown type
(define-extern set-to-run function)
;;(define-extern default-pool object) ;; unknown type
;;(define-extern listener object) ;; unknown type
;;(define-extern target-pool object) ;; unknown type
(define-extern set-to-run-bootstrap function)
;;(define-extern *camera-dead-pool* object) ;; unknown type
;;(define-extern process object) ;; unknown type
(define-extern previous-brother function)
;;(define-extern dead-state object) ;; unknown type
;;(define-extern debug object) ;; unknown type
;;(define-extern *16k-dead-pool* object) ;; unknown type
(define-extern entity-deactivate-handler function)
;;(define-extern *target-pool* object) ;; unknown type
;;(define-extern entity-pool object) ;; unknown type
;;(define-extern main object) ;; unknown type
(define-extern change-brother function)
;;(define-extern *active-pool* object) ;; unknown type
;;(define-extern display-pool object) ;; unknown type
;;(define-extern *target-dead-pool* object) ;; unknown type
;;(define-extern *4k-dead-pool* object) ;; unknown type
;;(define-extern *default-dead-pool* object) ;; unknown type
;;(define-extern *8k-dead-pool* object) ;; unknown type
;;(define-extern *display-pool* object) ;; unknown type
;;(define-extern active-pool object) ;; unknown type
;;(define-extern *dead-pool-list* object) ;; unknown type
;;(define-extern camera-pool object) ;; unknown type
;;(define-extern suspended object) ;; unknown type
;;(define-extern dgo-load object) ;; unknown type
;;(define-extern initialize-dead object) ;; unknown type
;;(define-extern #f object) ;; unknown type
;;(define-extern waiting-to-run object) ;; unknown type
;;(define-extern *stdcon0* object) ;; unknown type
;;(define-extern initialize-go object) ;; unknown type
;;(define-extern trans object) ;; unknown type
;;(define-extern code object) ;; unknown type
;;(define-extern *listener-function* object) ;; unknown type
;;(define-extern *stdcon1* object) ;; unknown type
;;(define-extern initialize object) ;; unknown type
(define-extern process-disconnect function)
;;(define-extern *debug-draw-pauseable* object) ;; unknown type
;;(define-extern _empty_ object) ;; unknown type
;;(define-extern running object) ;; unknown type
;;(define-extern *enable-method-set* object) ;; unknown type
;;(define-extern post object) ;; unknown type
;;(define-extern dead object) ;; unknown type
;; pskernel
(deftype lowmemmap (structure)
@ -31087,119 +31216,8 @@
;; KERNEL
(define-extern *kernel-packages* pair)
;;(define-extern stack-frame object) ;; unknown type
(define-extern state type)
;;(define-extern dead-pool-heap-rec object) ;; unknown type
;;(define-extern dead-pool object) ;; unknown type
;;(define-extern catch-frame object) ;; unknown type
;;(define-extern thread object) ;; unknown type
;;(define-extern handle object) ;; unknown type
;;(define-extern cpu-thread object) ;; unknown type
;;(define-extern dead-pool-heap object) ;; unknown type
(define-extern kernel-context type)
;;(define-extern protect-frame object) ;; unknown type
;;(define-extern event-message-block object) ;; unknown type
;;(define-extern process-tree object) ;; unknown type
;;(define-extern *listener-process* object) ;; unknown type
;;(define-extern *entity-pool* object) ;; unknown type
;;(define-extern *default-pool* object) ;; unknown type
(define-extern iterate-process-tree function)
;;(define-extern malloc object) ;; unknown type
;;(define-extern *deci-count* object) ;; unknown type
;;(define-extern ready object) ;; unknown type
;;(define-extern *camera-pool* object) ;; unknown type
(define-extern throw-dispatch function)
;;(define-extern game object) ;; unknown type
(define-extern run-function-in-process function)
(define-extern throw function)
;;(define-extern *nk-dead-pool* object) ;; unknown type
(define-extern kill-by-type function)
(define-extern change-to-last-brother function)
;;(define-extern *pickup-dead-pool* object) ;; unknown type
;;(define-extern *camera-master-dead-pool* object) ;; unknown type
(define-extern load-package (function string kheap pair))
(define-extern set-to-run function)
;;(define-extern *master-mode* object) ;; unknown type
;;(define-extern default-pool object) ;; unknown type
(define-extern return-from-thread-dead function)
;;(define-extern listener object) ;; unknown type
(define-extern process-count function)
;;(define-extern target-pool object) ;; unknown type
(define-extern set-to-run-bootstrap function)
(define-extern return-from-thread function)
;;(define-extern *camera-dead-pool* object) ;; unknown type
;;(define-extern *last-loado-debug-usage* object) ;; unknown type
;;(define-extern process object) ;; unknown type
(define-extern remove-exit function)
(define-extern previous-brother function)
(define-extern execute-process-tree function)
;;(define-extern dead-state object) ;; unknown type
;;(define-extern debug object) ;; unknown type
;;(define-extern *16k-dead-pool* object) ;; unknown type
(define-extern entity-deactivate-handler function)
;;(define-extern *null-process* object) ;; unknown type
(define-extern inspect-process-heap function)
;;(define-extern *target-pool* object) ;; unknown type
;;(define-extern *global-search-name* object) ;; unknown type
;;(define-extern *kernel-boot-mode* object) ;; unknown type
;;(define-extern entity-pool object) ;; unknown type
(define-extern kill-not-type function)
;;(define-extern *kernel-context* object) ;; unknown type
;;(define-extern *kernel-boot-level* object) ;; unknown type
;;(define-extern main object) ;; unknown type
(define-extern change-brother function)
;;(define-extern *null-kernel-context* object) ;; unknown type
(define-extern kill-not-name function)
;;(define-extern *active-pool* object) ;; unknown type
;;(define-extern *dram-stack* object) ;; unknown type
;;(define-extern *irx-version* object) ;; unknown type
;;(define-extern *pause-lock* object) ;; unknown type
;;(define-extern display-pool object) ;; unknown type
;;(define-extern *target-dead-pool* object) ;; unknown type
;;(define-extern *vis-boot* object) ;; unknown type
;;(define-extern *debug-dead-pool* object) ;; unknown type
;;(define-extern *last-loado-length* object) ;; unknown type
;;(define-extern *4k-dead-pool* object) ;; unknown type
;;(define-extern *default-dead-pool* object) ;; unknown type
(define-extern kernel-dispatcher (function (function object)))
;;(define-extern *8k-dead-pool* object) ;; unknown type
(define-extern unload-package (function string pair))
(define-extern reset-and-call function)
(define-extern process-not-name function)
;;(define-extern *display-pool* object) ;; unknown type
;;(define-extern *kernel-version* object) ;; unknown type
;;(define-extern active-pool object) ;; unknown type
;;(define-extern *dead-pool-list* object) ;; unknown type
;;(define-extern *global-search-count* object) ;; unknown type
;;(define-extern *last-loado-global-usage* object) ;; unknown type
(define-extern stream<-process-mask function)
(define-extern change-parent function)
(define-extern inspect-process-tree function)
;;(define-extern camera-pool object) ;; unknown type
;;(define-extern suspended object) ;; unknown type
;;(define-extern dgo-load object) ;; unknown type
;;(define-extern initialize-dead object) ;; unknown type
;;(define-extern #f object) ;; unknown type
;;(define-extern waiting-to-run object) ;; unknown type
;;(define-extern *stdcon0* object) ;; unknown type
;;(define-extern initialize-go object) ;; unknown type
;;(define-extern *stdcon* object) ;; unknown type
;;(define-extern trans object) ;; unknown type
;;(define-extern code object) ;; unknown type
;;(define-extern *listener-function* object) ;; unknown type
;;(define-extern *stdcon1* object) ;; unknown type
;;(define-extern initialize object) ;; unknown type
;;(define-extern *kernel-sp* object) ;; unknown type
(define-extern process-disconnect function)
;;(define-extern *debug-draw-pauseable* object) ;; unknown type
;;(define-extern _empty_ object) ;; unknown type
;;(define-extern running object) ;; unknown type
;;(define-extern *enable-method-set* object) ;; unknown type
;;(define-extern post object) ;; unknown type
;;(define-extern dead object) ;; unknown type
(define-extern install-default-debug-handler function)
(define-extern return-from-exception function)
;;(define-extern lowmemmap object) ;; unknown type

View file

@ -65,4 +65,12 @@
- Added inline assembly `.ret`, `.sub`, `.push`, and `.pop`.
- Added `rlet` to declare register variables.
- Added `:color #f` option to inline assembly forms to exclude them from the coloring system.
- Added `asm-func` to declare for purely assembly functions.
- Added `asm-func` to declare for purely assembly functions.
- Enum values now work where constant integers are expected.
- The boolean values `#f` and `#t` now are gotten as symbol objects, not values of symbols.
- In a static field initialization, you can use `#f` and `#t` instead of `'#f` and `'#t`
- Added `no-typecheck` option to define.
- Reworked type checking for `set!`. You may now use `#f` for non-numeric types.
- Fixed a bug where arguments to a method were unmodifiable.
- Fixed a bug where multiple anonymous lambda functions in the same file would throw a compiler error related to function name uniqueness.
- Method declarations can now use compound types. Previously they could only use simple types due to a mistake in deftype parser.

View file

@ -827,6 +827,7 @@ u64 new_type(u32 symbol, u32 parent, u64 flags) {
// BUG! This uses the child method count, but should probably use the parent method count.
for (u32 i = 0; i < n_methods; i++) {
// for (u32 i = 0; i < Ptr<Type>(parent)->num_methods; i++) {
child_slots[i] = parent_slots[i];
}

View file

@ -179,6 +179,26 @@
)
)
;; Define a new function, but only if we're debugging.
;; TODO - should place the function in the debug segment!
(defmacro defun-debug (name bindings &rest body)
`(if *debug-segment*
,(if (and
(> (length body) 1) ;; more than one thing in function
(string? (first body)) ;; first thing is a string
)
;; then it's a docstring and we ignore it.
`(define ,name (lambda :name ,name :segment debug ,bindings ,@(cdr body)))
;; otherwise don't ignore it.
`(define ,name (lambda :name ,name :segment debug ,bindings ,@body))
)
;; function not loaded, set function to the nothing function.
;; we don't typecheck this.
(define :no-typecheck #t ,name nothing)
)
)
(defmacro while (test &rest body)
(with-gensyms (reloop test-exit)
`(begin
@ -212,6 +232,15 @@
)
)
(defmacro countdown (var &rest body)
`(let ((,(first var) ,(second var)))
(while (!= ,(first var) 0)
(set! ,(first var) (- ,(first var) 1))
,@body
)
)
)
;; Backup some values, and restore after executing body.
;; Non-dynamic (nonlocal jumps out of body will skip restore)
(defmacro protect (defs &rest body)
@ -340,6 +369,10 @@
`(eq? ,thing 0)
)
(defmacro nonzero? (thing)
`(neq? ,thing 0)
)
(defmacro &+! (val amount)
`(set! ,val (&+ ,val ,amount))
)

View file

@ -104,6 +104,7 @@
(define-extern *listener-function* (function object))
;; kernel-dispatcher
;; kernel-packages
(define-extern *print-column* binteger)
;; *print-column*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View file

@ -592,4 +592,16 @@
)
)
dst
)
(defun print-tree-bitmask ((bitmask int) (len int))
"The purpose of this function is unknown"
(dotimes (i len #f)
(if (zero? (logand bitmask 1))
(format #t " ")
(format #t "| ")
)
(set! bitmask (ash bitmask -1))
)
)

View file

@ -103,6 +103,10 @@
`(format 0 ,@args)
)
(defmacro msg-warn (&rest args)
`(format 0 ,@args)
)
;; todo process pointer
;; todo process memory usage
;; with pp
@ -141,14 +145,16 @@
(declare-type process basic)
(declare-type stack-frame basic)
(declare-type state basic)
(declare-type cpu-thread basic)
; DANGER - this type is created in kscheme.cpp. It has room for 12 methods and size 0x28 bytes.
(deftype thread (basic)
((name basic :offset-assert 4) ;; name of the thread (usually a symbol?)
(process process :offset-assert 8) ;; process that the thread belongs to
(previous thread :offset-assert 12) ;; previous thread that was running in the process
(suspend-hook basic :offset-assert 16) ;; function to suspend this thread
(resume-hook basic :offset-assert 20) ;; function to resume this thread
(suspend-hook (function cpu-thread none) :offset-assert 16) ;; function to suspend this thread
(resume-hook (function cpu-thread none) :offset-assert 20) ;; function to resume this thread
(pc pointer :offset-assert 24) ;; program counter of the thread
(sp pointer :offset-assert 28) ;; stack pointer of the thread (actual stack)
(stack-top pointer :offset-assert 32) ;; top of the thread's stack (actual stack)
@ -195,11 +201,12 @@
(parent (pointer process-tree) :offset-assert 12)
(brother (pointer process-tree) :offset-assert 16)
(child (pointer process-tree) :offset-assert 20)
(ppointer pointer :offset-assert 24)
(self basic :offset-assert 28)
(ppointer (pointer process-tree) :offset-assert 24)
(self process-tree :offset-assert 28)
)
(:methods
(new ((allocation symbol) (type-to-make type) (name basic)) _type_ 0)
(activate ((obj _type_) (dest process-tree) (name basic) (stack-top pointer)) basic 9)
(deactivate ((obj _type_)) basic 10)
(dummy-method-11 () none 11)
@ -218,10 +225,10 @@
((pool basic :offset-assert #x20)
(status basic :offset-assert #x24)
(pid int32 :offset-assert #x28)
(main-thread thread :offset-assert #x2c)
(main-thread cpu-thread :offset-assert #x2c)
(top-thread thread :offset-assert #x30)
(entity basic :offset-assert #x34)
(state basic :offset-assert #x38)
(state state :offset-assert #x38)
(trans-hook function :offset-assert #x3c)
(post-hook function :offset-assert #x40)
(event-hook function :offset-assert #x44)
@ -236,6 +243,7 @@
)
(:methods
(new ((allocation symbol) (type-to-make type) (name basic) (stack-size int)) _type_ 0)
(activate ((obj process) (dest process-tree) (name basic) (stack-top pointer)) basic 9)
(deactivate ((obj process)) basic 10)
(dummy-method-11 () none 11)
@ -255,8 +263,9 @@
;; nothing new!
)
(:methods
(get-process ((pool dead-pool) (type-to-make type) (stack-size integer)) process 14)
(return-process ((pool dead-pool) (proc process)) process-tree 15)
(new ((allocation symbol) (type-to-make type) (count int) (stack-size int) (name basic)) _type_ 0)
(get-process ((pool _type_) (type-to-make type) (stack-size int)) process 14)
(return-process ((pool _type_) (proc process)) none 15)
)
:size-assert #x20
:method-count-assert 16
@ -298,17 +307,18 @@
(process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104)
)
(:methods
(compact ((this dead-pool-heap) (count integer)) none 16)
(new ((allocation symbol) (type-to-make type) (name basic) (allocated-length int) (heap-size int)) _type_ 0)
(compact ((this dead-pool-heap) (count int)) none 16)
(shrink-heap ((this dead-pool-heap) (proc process)) dead-pool-heap 17)
(churn ((this dead-pool-heap) (count integer)) none 18)
(memory-used ((this dead-pool-heap)) integer 19)
(memory-total ((this dead-pool-heap)) integer 20)
(gap-size ((this dead-pool-heap) (rec dead-pool-heap-rec)) integer 21)
(churn ((this dead-pool-heap) (count int)) none 18)
(memory-used ((this dead-pool-heap)) int 19)
(memory-total ((this dead-pool-heap)) int 20)
(gap-size ((this dead-pool-heap) (rec dead-pool-heap-rec)) int 21)
(gap-location ((this dead-pool-heap) (rec dead-pool-heap-rec)) pointer 22)
(find-gap ((this dead-pool-heap) (rec dead-pool-heap-rec)) dead-pool-heap-rec 23)
(find-gap-by-size ((this dead-pool-heap) (size integer)) dead-pool-heap-rec 24)
(memory-free ((this dead-pool-heap)) integer 25)
(compact-time ((this dead-pool-heap)) integer 26)
(find-gap-by-size ((this dead-pool-heap) (size int)) dead-pool-heap-rec 24)
(memory-free ((this dead-pool-heap)) int 25)
(compact-time ((this dead-pool-heap)) uint 26)
)
:size-assert #x68
@ -340,6 +350,10 @@
(freg float 6 :offset-assert 20) ;; saved floating point registers from "catch" statement
(rreg uint128 8 :offset-assert 48) ;; saved GPRs from "catch" statement (ugh they are 128s)
)
(:methods
(new ((allocation symbol) (type-to-make type) (name symbol) (func function) (params (pointer uint64))) object 0)
)
:size-assert #xb0
:method-count-assert 9
:flag-assert #x9000000b0
@ -354,7 +368,46 @@
:flag-assert #x900000010
)
;; handle (todo, need bitfield types)
(deftype handle (uint64)
((process (pointer process) :offset 0) ;; todo, more specific type
(pid int32 :offset 32)
(u64 uint64 :offset 0)
)
:flag-assert #x900000008
)
(defmethod inspect handle ((obj handle))
(format #t "[~8x] ~A~%" 'handle)
(format #t "~Tprocess: #x~x~%" (-> obj process))
(format #t "~Tpid: ~D~%" (-> obj pid))
obj
)
(defmacro get-process-from-handle (handle)
;; the actual implementation is more clever than this.
`(if (-> ,handle process)
(let ((proc (-> (-> ,handle process))))
(if (= (-> ,handle pid)
(-> proc pid))
proc
)
)
)
)
(defmethod print handle ((obj handle))
;; the get-process-from-handle macro can't deal with
;; a 0 in the process field, so we check it manually here.
(if (nonzero? (-> obj u64))
(format #t "#<handle :process ~A :pid ~D>"
(get-process-from-handle obj)
(-> obj pid)
)
(format #t "#<handle :process 0 :pid 0>")
)
obj
)
;; GOAL State. A Process can be in a State.
(deftype state (protect-frame) ; state is a protect frame so we can "exit" it with cleanup
@ -383,4 +436,51 @@
:size-assert #x48
:method-count-assert 9
:flag-assert #x900000048
)
(defmacro as-process (ppointer)
`(if ,ppointer
(-> (-> ,ppointer) self)
)
)
(defmacro as-ppointer (proc)
;"safely get a (pointer process) from a process, returning #f if invalid."
`(if ,proc
(-> ,proc ppointer)
)
)
(defmacro process-stack-used (proc)
;; get how much stack the top thread of a process has used.
`(- (the int (-> ,proc top-thread stack-top))
(the int (-> ,proc top-thread sp))
)
)
(defmacro process-stack-size (proc)
;; get how much stack the top thread of a process has
`(-> ,proc top-thread stack-size)
)
(defmacro process-heap-used (proc)
;; get how much heap a process has used.
`(- (-> ,proc allocated-length)
(- (the int (-> ,proc heap-top))
(the int (-> ,proc heap-cur))
)
)
)
(defmacro process-heap-size (proc)
;; get how much heap a process has
`(the int (-> ,proc allocated-length))
)
(defmacro process-mask? (mask enum-value)
`(!= 0 (logand ,mask (process-mask ,enum-value)))
)
(defmacro process-mask-set! (mask enum-value)
`(set! ,mask (logior ,mask (process-mask ,enum-value)))
)

File diff suppressed because it is too large Load diff

View file

@ -28,7 +28,7 @@ std::vector<u8> CodeGenerator::run() {
if (function_names.find(f->name()) == function_names.end()) {
function_names.insert(f->name());
} else {
printf("Failed to codegen, there are two functions with internal names %s\n",
printf("Failed to codegen, there are two functions with internal names [%s]\n",
f->name().c_str());
throw std::runtime_error("Failed to codegen.");
}

View file

@ -297,5 +297,24 @@ void Compiler::typecheck(const goos::Object& form,
const TypeSpec& actual,
const std::string& error_message) {
(void)form;
m_ts.typecheck(expected, actual, error_message, true, true);
if (!m_ts.typecheck(expected, actual, error_message, true, false)) {
throw_compiler_error(form, "Typecheck failed");
}
}
/*!
* Like typecheck, but will allow Val* to be #f if the destination isn't a number.
* Also will convert to register types for the type checking.
*/
void Compiler::typecheck_reg_type_allow_false(const goos::Object& form,
const TypeSpec& expected,
const Val* actual,
const std::string& error_message) {
if (!m_ts.typecheck(m_ts.make_typespec("number"), expected, "", false, false)) {
auto as_sym_val = dynamic_cast<const SymbolVal*>(actual);
if (as_sym_val && as_sym_val->name() == "#f") {
return;
}
}
typecheck(form, expected, coerce_to_reg_type(actual->type()), error_message);
}

View file

@ -47,7 +47,7 @@ class Compiler {
bool get_true_or_false(const goos::Object& form, const goos::Object& boolean);
bool try_getting_macro_from_goos(const goos::Object& macro_name, goos::Object* dest);
void set_bitfield(const goos::Object& form, BitFieldVal* dst, RegVal* src, Env* env);
Val* do_set(const goos::Object& form, Val* dst, RegVal* src, Env* env);
Val* do_set(const goos::Object& form, Val* dst, RegVal* src_in_reg, Val* src, Env* env);
Val* compile_goos_macro(const goos::Object& o,
const goos::Object& macro_obj,
const goos::Object& rest,
@ -99,6 +99,10 @@ class Compiler {
const TypeSpec& expected,
const TypeSpec& actual,
const std::string& error_message = "");
void typecheck_reg_type_allow_false(const goos::Object& form,
const TypeSpec& expected,
const Val* actual,
const std::string& error_message = "");
TypeSpec parse_typespec(const goos::Object& src);
bool is_local_symbol(const goos::Object& obj, Env* env);
@ -137,6 +141,11 @@ class Compiler {
Val* to_math_type(const goos::Object& form, Val* in, MathMode mode, Env* env);
bool is_none(Val* in);
emitter::Register parse_register(const goos::Object& code);
u64 enum_lookup(const goos::Object& form,
const GoalEnum& e,
const goos::Object& rest,
bool throw_on_error,
bool* success);
Val* compile_enum_lookup(const goos::Object& form,
const GoalEnum& e,
const goos::Object& rest,
@ -231,7 +240,10 @@ class Compiler {
Val* compile_asm_push(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_asm_pop(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_asm_sub(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_asm_add(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_asm_load_sym(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_asm_jr(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_asm_mov(const goos::Object& form, const goos::Object& rest, Env* env);
// Atoms
// Block

View file

@ -159,6 +159,7 @@ std::string FileEnv::print() {
void FileEnv::add_function(std::unique_ptr<FunctionEnv> fe) {
assert(fe->idx_in_file == -1);
fe->idx_in_file = m_functions.size();
assert(!fe->name().empty());
m_functions.push_back(std::move(fe));
}

View file

@ -96,6 +96,9 @@ class FileEnv : public Env {
void debug_print_tl();
const std::vector<std::unique_ptr<FunctionEnv>>& functions() { return m_functions; }
const std::vector<std::unique_ptr<StaticObject>>& statics() { return m_statics; }
std::string get_anon_function_name() {
return "anon-function-" + std::to_string(m_anon_func_counter++);
}
const FunctionEnv& top_level_function() {
assert(m_top_level_func);
return *m_top_level_func;
@ -110,6 +113,7 @@ class FileEnv : public Env {
std::vector<std::unique_ptr<FunctionEnv>> m_functions;
std::vector<std::unique_ptr<StaticObject>> m_statics;
std::unique_ptr<NoEmitEnv> m_no_emit_env = nullptr;
int m_anon_func_counter = 0;
// statics
FunctionEnv* m_top_level_func = nullptr;

View file

@ -1080,4 +1080,143 @@ void IR_AsmSub::do_codegen(emitter::ObjectGenerator* gen,
} else {
gen->add_instr(IGen::sub_gpr64_gpr64(get_no_color_reg(m_dst), get_no_color_reg(m_src)), irec);
}
}
///////////////////////
// AsmAdd
///////////////////////
IR_AsmAdd::IR_AsmAdd(bool use_coloring, const RegVal* dst, const RegVal* src)
: IR_Asm(use_coloring), m_dst(dst), m_src(src) {}
std::string IR_AsmAdd::print() {
return fmt::format(".add{} {}, {}", get_color_suffix_string(), m_dst->print(), m_src->print());
}
RegAllocInstr IR_AsmAdd::to_rai() {
RegAllocInstr rai;
if (m_use_coloring) {
rai.write.push_back(m_dst->ireg());
rai.read.push_back(m_dst->ireg());
rai.read.push_back(m_src->ireg());
}
return rai;
}
void IR_AsmAdd::do_codegen(emitter::ObjectGenerator* gen,
const AllocationResult& allocs,
emitter::IR_Record irec) {
if (m_use_coloring) {
gen->add_instr(
IGen::add_gpr64_gpr64(get_reg(m_dst, allocs, irec), get_reg(m_src, allocs, irec)), irec);
} else {
gen->add_instr(IGen::add_gpr64_gpr64(get_no_color_reg(m_dst), get_no_color_reg(m_src)), irec);
}
}
///////////////////////
// AsmGetSymbolValue
///////////////////////
IR_GetSymbolValueAsm::IR_GetSymbolValueAsm(bool use_coloring,
const RegVal* dest,
std::string sym_name,
bool sext)
: IR_Asm(use_coloring), m_dest(dest), m_sym_name(std::move(sym_name)), m_sext(sext) {}
std::string IR_GetSymbolValueAsm::print() {
return fmt::format(".load-sym{} {} [{}]", get_color_suffix_string(), m_dest->print(), m_sym_name);
}
RegAllocInstr IR_GetSymbolValueAsm::to_rai() {
RegAllocInstr rai;
if (m_use_coloring) {
rai.write.push_back(m_dest->ireg());
}
return rai;
}
void IR_GetSymbolValueAsm::do_codegen(emitter::ObjectGenerator* gen,
const AllocationResult& allocs,
emitter::IR_Record irec) {
auto dst_reg = m_use_coloring ? get_reg(m_dest, allocs, irec) : get_no_color_reg(m_dest);
if (m_sext) {
auto instr =
gen->add_instr(IGen::load32s_gpr64_gpr64_plus_gpr64_plus_s32(
dst_reg, gRegInfo.get_st_reg(), gRegInfo.get_offset_reg(), 0x0badbeef),
irec);
gen->link_instruction_symbol_mem(instr, m_sym_name);
} else {
auto instr =
gen->add_instr(IGen::load32u_gpr64_gpr64_plus_gpr64_plus_s32(
dst_reg, gRegInfo.get_st_reg(), gRegInfo.get_offset_reg(), 0x0badbeef),
irec);
gen->link_instruction_symbol_mem(instr, m_sym_name);
}
}
///////////////////////
// AsmJumpReg
///////////////////////
IR_JumpReg::IR_JumpReg(bool use_coloring, const RegVal* src) : IR_Asm(use_coloring), m_src(src) {}
std::string IR_JumpReg::print() {
return fmt::format(".jr{} {}", get_color_suffix_string(), m_src->print());
}
RegAllocInstr IR_JumpReg::to_rai() {
RegAllocInstr rai;
if (m_use_coloring) {
rai.read.push_back(m_src->ireg());
}
return rai;
}
void IR_JumpReg::do_codegen(emitter::ObjectGenerator* gen,
const AllocationResult& allocs,
emitter::IR_Record irec) {
auto src_reg = m_use_coloring ? get_reg(m_src, allocs, irec) : get_no_color_reg(m_src);
gen->add_instr(IGen::jmp_r64(src_reg), irec);
}
///////////////////////
// AsmRegSet
///////////////////////
IR_RegSetAsm::IR_RegSetAsm(bool use_color, const RegVal* dst, const RegVal* src)
: IR_Asm(use_color), m_dst(dst), m_src(src) {}
std::string IR_RegSetAsm::print() {
return fmt::format(".mov{} {} {}", get_color_suffix_string(), m_dst->print(), m_src->print());
}
RegAllocInstr IR_RegSetAsm::to_rai() {
RegAllocInstr rai;
if (m_use_coloring) {
rai.write.push_back(m_dst->ireg());
rai.read.push_back(m_src->ireg());
}
return rai;
}
void IR_RegSetAsm::do_codegen(emitter::ObjectGenerator* gen,
const AllocationResult& allocs,
emitter::IR_Record irec) {
auto val_reg = m_use_coloring ? get_reg(m_src, allocs, irec) : get_no_color_reg(m_src);
auto dest_reg = m_use_coloring ? get_reg(m_dst, allocs, irec) : get_no_color_reg(m_dst);
if (val_reg == dest_reg) {
gen->add_instr(IGen::null(), irec);
} else if (val_reg.is_gpr() && dest_reg.is_gpr()) {
gen->add_instr(IGen::mov_gpr64_gpr64(dest_reg, val_reg), irec);
} else if (val_reg.is_xmm() && dest_reg.is_gpr()) {
gen->add_instr(IGen::movd_gpr32_xmm32(dest_reg, val_reg), irec);
} else if (val_reg.is_gpr() && dest_reg.is_xmm()) {
gen->add_instr(IGen::movd_xmm32_gpr32(dest_reg, val_reg), irec);
} else if (val_reg.is_xmm() && dest_reg.is_xmm()) {
gen->add_instr(IGen::mov_xmm32_xmm32(dest_reg, val_reg), irec);
} else {
assert(false);
}
}

View file

@ -430,4 +430,60 @@ class IR_AsmSub : public IR_Asm {
const RegVal* m_src = nullptr;
};
class IR_AsmAdd : public IR_Asm {
public:
IR_AsmAdd(bool use_coloring, const RegVal* dst, const RegVal* src);
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_dst = nullptr;
const RegVal* m_src = nullptr;
};
class IR_GetSymbolValueAsm : public IR_Asm {
public:
IR_GetSymbolValueAsm(bool use_coloring, const RegVal* dest, std::string sym_name, bool sext);
std::string print() override;
RegAllocInstr to_rai() override;
void do_codegen(emitter::ObjectGenerator* gen,
const AllocationResult& allocs,
emitter::IR_Record irec) override;
protected:
const RegVal* m_dest = nullptr;
std::string m_sym_name;
bool m_sext = false;
};
class IR_JumpReg : public IR_Asm {
public:
IR_JumpReg(bool use_coloring, const RegVal* src);
std::string print() override;
RegAllocInstr to_rai() override;
void do_codegen(emitter::ObjectGenerator* gen,
const AllocationResult& allocs,
emitter::IR_Record irec) override;
protected:
const RegVal* m_src = nullptr;
};
class IR_RegSetAsm : public IR_Asm {
public:
IR_RegSetAsm(bool use_color, const RegVal* dst, const RegVal* src);
std::string print() override;
RegAllocInstr to_rai() override;
void do_codegen(emitter::ObjectGenerator* gen,
const AllocationResult& allocs,
emitter::IR_Record irec) override;
protected:
const RegVal* m_dst = nullptr;
const RegVal* m_src = nullptr;
};
#endif // JAK_IR_H

View file

@ -161,6 +161,32 @@ bool Compiler::try_getting_constant_integer(const goos::Object& in, int64_t* out
return true;
}
if (in.is_pair()) {
auto head = in.as_pair()->car;
if (head.is_symbol()) {
auto head_sym = head.as_symbol();
auto enum_kv = m_enums.find(head_sym->name);
if (enum_kv != m_enums.end()) {
bool success;
u64 as_enum = enum_lookup(in, enum_kv->second, in.as_pair()->cdr, false, &success);
if (success) {
*out = as_enum;
return true;
}
}
}
}
if (in.is_symbol()) {
auto global_constant = m_global_constants.find(in.as_symbol());
if (global_constant != m_global_constants.end()) {
// recursively get constant integer, so we can have constants set to constants, etc.
if (try_getting_constant_integer(global_constant->second, out, env)) {
return true;
}
}
}
// todo, try more things like constants before giving up.
return false;
}

View file

@ -151,4 +151,79 @@ Val* Compiler::compile_asm_sub(const goos::Object& form, const goos::Object& res
auto src = compile_error_guard(args.unnamed.at(1), env)->to_gpr(env);
env->emit_ir<IR_AsmSub>(color, dest, src);
return get_none();
}
Val* Compiler::compile_asm_add(const goos::Object& form, const goos::Object& rest, Env* env) {
auto args = get_va(form, rest);
va_check(form, args, {{}, {}}, {{"color", {false, goos::ObjectType::SYMBOL}}});
bool color = true;
if (args.has_named("color")) {
color = get_true_or_false(form, args.named.at("color"));
}
auto dest = compile_error_guard(args.unnamed.at(0), env)->to_gpr(env);
if (!dest->settable()) {
throw_compiler_error(form, "Cannot .add this. Got a {}.", dest->print());
}
auto src = compile_error_guard(args.unnamed.at(1), env)->to_gpr(env);
env->emit_ir<IR_AsmAdd>(color, dest, src);
return get_none();
}
Val* Compiler::compile_asm_load_sym(const goos::Object& form, const goos::Object& rest, Env* env) {
auto args = get_va(form, rest);
va_check(
form, args, {{}, {goos::ObjectType::SYMBOL}},
{{"sext", {false, goos::ObjectType::SYMBOL}}, {"color", {false, goos::ObjectType::SYMBOL}}});
auto& sym_name = args.unnamed.at(1).as_symbol()->name;
auto sym_kv = m_symbol_types.find(sym_name);
if (sym_kv == m_symbol_types.end()) {
throw_compiler_error(form, "Cannot find a symbol named {}.", sym_name);
}
auto ts = sym_kv->second;
bool sext = m_ts.lookup_type(ts)->get_load_signed();
if (args.has_named("sext")) {
sext = get_true_or_false(form, args.named.at("sext"));
}
bool color = true;
if (args.has_named("color")) {
color = get_true_or_false(form, args.named.at("color"));
}
auto dest = compile_error_guard(args.unnamed.at(0), env)->to_gpr(env);
if (!dest->settable()) {
throw_compiler_error(form, "Cannot .load-sym this. Got a {}.", dest->print());
}
env->emit_ir<IR_GetSymbolValueAsm>(color, dest, sym_name, sext);
return get_none();
}
Val* Compiler::compile_asm_jr(const goos::Object& form, const goos::Object& rest, Env* env) {
auto args = get_va(form, rest);
va_check(form, args, {{}}, {{"color", {false, goos::ObjectType::SYMBOL}}});
bool color = true;
if (args.has_named("color")) {
color = get_true_or_false(form, args.named.at("color"));
}
auto src = compile_error_guard(args.unnamed.at(0), env)->to_gpr(env);
env->emit_ir<IR_JumpReg>(color, src);
return get_none();
}
Val* Compiler::compile_asm_mov(const goos::Object& form, const goos::Object& rest, Env* env) {
auto args = get_va(form, rest);
va_check(form, args, {{}, {}}, {{"color", {false, goos::ObjectType::SYMBOL}}});
bool color = true;
if (args.has_named("color")) {
color = get_true_or_false(form, args.named.at("color"));
}
auto dest = compile_error_guard(args.unnamed.at(0), env)->to_gpr(env);
if (!dest->settable()) {
throw_compiler_error(form, "Cannot .mov this. Got a {}.", dest->print());
}
auto src = compile_error_guard(args.unnamed.at(1), env)->to_gpr(env);
env->emit_ir<IR_RegSetAsm>(color, dest, src);
return get_none();
}

View file

@ -18,9 +18,11 @@ static const std::unordered_map<
{".push", &Compiler::compile_asm_push},
{".pop", &Compiler::compile_asm_pop},
{"rlet", &Compiler::compile_rlet},
// {".jmp", &Compiler::compile_asm},
{".jr", &Compiler::compile_asm_jr},
{".sub", &Compiler::compile_asm_sub},
// {".ret-reg", &Compiler::compile_asm},
{".add", &Compiler::compile_asm_add},
{".load-sym", &Compiler::compile_asm_load_sym},
{".mov", &Compiler::compile_asm_mov},
// BLOCK FORMS
{"top-level", &Compiler::compile_top_level},
@ -254,6 +256,12 @@ Val* Compiler::compile_get_symbol_value(const goos::Object& form,
Val* Compiler::compile_symbol(const goos::Object& form, Env* env) {
auto name = symbol_string(form);
// optimization to look these up as symbol objects, not getting the value of a symbol.
// so you don't have to type '#f, '#t everywhere to get the best performance.
if (name == "#t" || name == "#f") {
return compile_get_sym_obj(name, env);
}
// 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) {

View file

@ -11,7 +11,8 @@
*/
Val* Compiler::compile_define(const goos::Object& form, const goos::Object& rest, Env* env) {
auto args = get_va(form, rest);
va_check(form, args, {goos::ObjectType::SYMBOL, {}}, {});
va_check(form, args, {goos::ObjectType::SYMBOL, {}},
{{"no-typecheck", {false, goos::ObjectType::SYMBOL}}});
auto& sym = args.unnamed.at(0);
auto& val = args.unnamed.at(1);
@ -43,7 +44,13 @@ Val* Compiler::compile_define(const goos::Object& form, const goos::Object& rest
if (existing_type == m_symbol_types.end()) {
m_symbol_types[sym.as_symbol()->name] = in_gpr->type();
} else {
typecheck(form, existing_type->second, in_gpr->type(), "define on existing symbol");
bool do_typecheck = true;
if (args.has_named("no-typecheck")) {
do_typecheck = !get_true_or_false(form, args.named.at("no-typecheck"));
}
if (do_typecheck) {
typecheck(form, existing_type->second, in_gpr->type(), "define on existing symbol");
}
}
if (!sym_val->settable()) {
@ -122,13 +129,18 @@ void Compiler::set_bitfield(const goos::Object& form, BitFieldVal* dst, RegVal*
}
env->emit(std::make_unique<IR_IntegerMath>(IntegerMathKind::OR_64, original, temp));
do_set(form, dst->parent(), original, env);
do_set(form, dst->parent(), original, original, env);
}
/*!
* The internal "set" logic.
* The source is provided both as the directly Val* from compilation and as a RegVal*.
* This is a bit weird, but is required to do things in exactly the same order as GOAL, but
* makes us able to check if the source is #f, which is allowed to bypass type checking in some
* cases. If the source is unavailable, you can just put the same thing for src_in_reg and src, but
* you'll lose the ability to detect and accept #f as a null reference.
*/
Val* Compiler::do_set(const goos::Object& form, Val* dest, RegVal* source, Env* env) {
Val* Compiler::do_set(const goos::Object& form, Val* dest, RegVal* src_in_reg, Val* src, Env* env) {
if (!dest->settable()) {
throw_compiler_error(form, "Cannot set! {} because it is not settable.", dest->print());
}
@ -140,8 +152,8 @@ Val* Compiler::do_set(const goos::Object& form, Val* dest, RegVal* source, Env*
if (as_mem_deref) {
auto dest_type = coerce_to_reg_type(as_mem_deref->type());
if (dest_type != TypeSpec("uint") || source->type() != TypeSpec("int")) {
typecheck(form, dest_type, source->type(), "set! memory");
if (dest_type != TypeSpec("uint") || coerce_to_reg_type(src->type()) != TypeSpec("int")) {
typecheck_reg_type_allow_false(form, dest_type, src, "set! memory");
}
// setting somewhere in memory
@ -151,31 +163,31 @@ Val* Compiler::do_set(const goos::Object& form, Val* dest, RegVal* source, Env*
// if it is a constant offset, we can use a fancy x86-64 addressing mode to simplify
auto ti = m_ts.lookup_type(as_mem_deref->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;
src_in_reg, base_as_mco->offset, base_as_mco->base->to_gpr(env), ti->get_load_size()));
return src_in_reg;
} else {
// nope, the pointer to dereference is some compliated thing.
auto ti = m_ts.lookup_type(as_mem_deref->type());
env->emit(
std::make_unique<IR_StoreConstOffset>(source, 0, base->to_gpr(env), ti->get_load_size()));
return source;
env->emit(std::make_unique<IR_StoreConstOffset>(src_in_reg, 0, base->to_gpr(env),
ti->get_load_size()));
return src_in_reg;
}
} else if (as_pair) {
// this could probably be part of MemoryDerefVal and not a special case here.
env->emit(std::make_unique<IR_StoreConstOffset>(source, as_pair->is_car ? -2 : 2,
env->emit(std::make_unique<IR_StoreConstOffset>(src_in_reg, as_pair->is_car ? -2 : 2,
as_pair->base->to_gpr(env), 4));
return source;
return src_in_reg;
} else if (as_reg) {
typecheck(form, as_reg->type(), source->type(), "set! lexical variable");
env->emit(std::make_unique<IR_RegSet>(as_reg, source));
return source;
typecheck_reg_type_allow_false(form, as_reg->type(), src, "set! lexical variable");
env->emit(std::make_unique<IR_RegSet>(as_reg, src_in_reg));
return src_in_reg;
} else if (as_sym_val) {
typecheck(form, as_sym_val->type(), source->type(), "set! global symbol");
auto result_in_gpr = source->to_gpr(env);
typecheck_reg_type_allow_false(form, as_sym_val->type(), src, "set! global symbol");
auto result_in_gpr = src_in_reg->to_gpr(env);
env->emit(std::make_unique<IR_SetSymbolValue>(as_sym_val->sym(), result_in_gpr));
return result_in_gpr;
} else if (as_bitfield) {
set_bitfield(form, as_bitfield, source, env);
set_bitfield(form, as_bitfield, src_in_reg, env);
return get_none();
}
@ -195,7 +207,8 @@ Val* Compiler::compile_set(const goos::Object& form, const goos::Object& rest, E
// todo, I don't know if this is the correct order or not. Right now the value is computed
// and to_reg'd first, then the destination is computed, if the destination requires math to
// compute.
auto source = compile_error_guard(args.unnamed.at(1), env)->to_reg(env);
auto source = compile_error_guard(args.unnamed.at(1), env);
auto source_reg = source->to_reg(env);
auto dest = compile_error_guard(destination, env);
return do_set(form, dest, source, env);
return do_set(form, dest, source_reg, source, env);
}

View file

@ -135,9 +135,9 @@ Val* Compiler::compile_lambda(const goos::Object& form, const goos::Object& rest
// compile a function! First create a unique name...
std::string function_name = lambda.debug_name;
if (function_name.empty()) {
function_name = fmt::format("anonymous-function-{}", obj_env->functions().size());
function_name = obj_env->get_anon_function_name();
}
auto new_func_env = std::make_unique<FunctionEnv>(env, lambda.debug_name);
auto new_func_env = std::make_unique<FunctionEnv>(env, function_name);
new_func_env->set_segment(segment);
// set up arguments

View file

@ -67,7 +67,9 @@ Val* Compiler::number_to_binteger(const goos::Object& form, Val* in, Env* env) {
RegVal* input = in->to_reg(env);
auto sa = fe->make_gpr(m_ts.make_typespec("int"));
env->emit(std::make_unique<IR_LoadConstant64>(sa, 3));
return compile_variable_shift(form, input, sa, env, IntegerMathKind::SHLV_64);
auto result = compile_variable_shift(form, input, sa, env, IntegerMathKind::SHLV_64);
result->set_type(m_ts.make_typespec("binteger"));
return result;
}
throw_compiler_error(form, "Cannot convert a {} to a binteger.", in->type().print());
return nullptr;
@ -115,7 +117,8 @@ Val* Compiler::compile_add(const goos::Object& form, const goos::Object& rest, E
auto first_type = first_val->type();
auto math_type = get_math_mode(first_type);
switch (math_type) {
case MATH_INT: {
case MATH_INT:
case MATH_BINT: {
auto result = env->make_gpr(first_type);
env->emit(std::make_unique<IR_RegSet>(result, first_val->to_gpr(env)));

View file

@ -196,6 +196,17 @@ Val* Compiler::compile_new_static_structure_or_basic(const goos::Object& form,
assert(deref_info.can_deref);
assert(deref_info.load_size == 4);
// the linker needs to see a -1 in order to know to insert a symbol pointer
// instead of just the symbol table offset.
u32 linker_val = 0xffffffff;
memcpy(obj->data.data() + field_offset, &linker_val, 4);
} else if (field_value.is_symbol() &&
(field_value.as_symbol()->name == "#t" || field_value.as_symbol()->name == "#f")) {
obj->add_symbol_record(symbol_string(field_value), field_offset);
assert(deref_info.mem_deref);
assert(deref_info.can_deref);
assert(deref_info.load_size == 4);
// the linker needs to see a -1 in order to know to insert a symbol pointer
// instead of just the symbol table offset.
u32 linker_val = 0xffffffff;

View file

@ -289,7 +289,7 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _
} else {
// type of argument is specified
auto param_args = get_va(o, o);
va_check(o, param_args, {goos::ObjectType::SYMBOL, goos::ObjectType::SYMBOL}, {});
va_check(o, param_args, {goos::ObjectType::SYMBOL, {}}, {});
GoalArg parm;
parm.name = symbol_string(param_args.unnamed.at(0));
@ -327,6 +327,7 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _
IRegConstraint constr;
constr.instr_idx = 0; // constraint at function start
auto ireg = new_func_env->make_ireg(lambda.params.at(i).type, emitter::RegKind::GPR);
ireg->mark_as_settable();
constr.ireg = ireg->ireg();
constr.desired_register = emitter::gRegInfo.get_arg_reg(i);
new_func_env->params[lambda.params.at(i).name] = ireg;
@ -855,48 +856,75 @@ Val* Compiler::compile_defenum(const goos::Object& form, const goos::Object& _re
return get_none();
}
Val* Compiler::compile_enum_lookup(const goos::Object& form,
const GoalEnum& e,
const goos::Object& rest,
Env* env) {
u64 Compiler::enum_lookup(const goos::Object& form,
const GoalEnum& e,
const goos::Object& rest,
bool throw_on_error,
bool* success) {
*success = true;
if (e.is_bitfield) {
int64_t value = 0;
uint64_t value = 0;
for_each_in_list(rest, [&](const goos::Object& o) {
auto kv = e.entries.find(symbol_string(o));
if (kv == e.entries.end()) {
throw_compiler_error(form, "The value {} was not found in enum.", o.print());
if (throw_on_error) {
throw_compiler_error(form, "The value {} was not found in enum.", o.print());
} else {
*success = false;
return;
}
}
value |= (1 << kv->second);
});
auto result = compile_integer(value, env);
result->set_type(e.base_type);
return result;
return value;
} else {
int64_t value = 0;
uint64_t value = 0;
bool got = false;
for_each_in_list(rest, [&](const goos::Object& o) {
if (got) {
throw_compiler_error(form, "Invalid enum lookup.");
if (throw_on_error) {
throw_compiler_error(form, "Invalid enum lookup.");
} else {
*success = false;
return;
}
}
auto kv = e.entries.find(symbol_string(o));
if (kv == e.entries.end()) {
throw_compiler_error(form, "The value {} was not found in enum.", o.print());
if (throw_on_error) {
throw_compiler_error(form, "The value {} was not found in enum.", o.print());
} else {
*success = false;
return;
}
}
value = kv->second;
got = true;
});
if (!got) {
throw_compiler_error(form, "Invalid enum lookup.");
if (throw_on_error) {
throw_compiler_error(form, "Invalid enum lookup.");
} else {
*success = false;
}
}
auto result = compile_integer(value, env);
result->set_type(e.base_type);
return result;
return value;
}
}
return get_none();
Val* Compiler::compile_enum_lookup(const goos::Object& form,
const GoalEnum& e,
const goos::Object& rest,
Env* env) {
bool success;
u64 value = enum_lookup(form, e, rest, true, &success);
assert(success);
auto result = compile_integer(value, env);
result->set_type(e.base_type);
return result;
}
bool GoalEnum::operator==(const GoalEnum& other) const {

View file

@ -1281,9 +1281,11 @@ class IGen {
}
/*!
* Call a function stored in a 64-bit gpr
* Jump to an x86-64 address stored in a 64-bit gpr.
*/
static Instruction jmp_r64(uint8_t reg) {
static Instruction jmp_r64(Register reg_) {
assert(reg_.is_gpr());
auto reg = reg_.hw_id();
Instruction instr(0xff);
if (reg >= 8) {
instr.set(REX(false, false, false, true));

View file

@ -0,0 +1,17 @@
(defenum my-bitfield :bitfield #t :type uint32
(zero 0) ; 1
(one 1) ; 2
(two 2) ; 4
(three 3) ; 8
(four 4) ; 16
)
(deftype test-static-bitfield-type (basic)
((a uint32)
(field uint32))
)
(let ((obj (new 'static 'test-static-bitfield-type :a 12 :field (my-bitfield one three))))
(+ (-> obj a ) (-> obj field))
)

View file

@ -4,10 +4,12 @@
((s8 int8)
(s16 int16)
(thing basic)
(thing-2 basic)
(thing-3 basic)
(u64 uint64))
)
(define test-static-basic (new 'static 'static-test-basic-type :s8 -122 :s16 -23123 :u64 434343 :thing 'bean))
(define test-static-basic (new 'static 'static-test-basic-type :s8 -122 :s16 -23123 :u64 434343 :thing 'bean :thing-2 #t :thing-3 #f))
(expect-true (< (the int test-static-basic) (-> debug current))) ;; should be in debug segment?
(expect-true (> (the int test-static-basic) (-> debug base)))
@ -16,6 +18,8 @@
(expect-true (= (-> test-static-basic s16) -23123))
(expect-true (= (-> test-static-basic u64) 434343))
(expect-true (eq? (-> test-static-basic thing) 'bean))
(expect-true (eq? (-> test-static-basic thing-2) #t))
(expect-true (eq? (-> test-static-basic thing-3) #f))
(expect-true (neq? (-> test-static-basic thing) 'not-bean))
(expect-true (eq? (-> test-static-basic type symbol) 'static-test-basic-type))
(expect-true (eq? (-> test-static-basic type) static-test-basic-type))

View file

@ -81,4 +81,8 @@ TEST_F(VariableTests, Bitfields) {
TEST_F(VariableTests, InlineAsm) {
runner.run_static_test(env, testCategory, "inline-asm.static.gc", {"1\n"});
}
TEST_F(VariableTests, StaticBitfieldField) {
runner.run_static_test(env, testCategory, "static-bitfield-field.gc", {"22\n"});
}

View file

@ -259,7 +259,7 @@ TEST_F(WithGameTests, NewStaticStructureIntegers) {
TEST_F(WithGameTests, NewStaticBasic) {
runner.run_static_test(env, testCategory, "test-new-static-basic.gc",
get_test_pass_string("new-static-basic", 9));
get_test_pass_string("new-static-basic", 11));
}
TEST_F(WithGameTests, VectorDot) {