mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-07-11 15:28:58 -04:00
Code Issues Packages Projects Releases Wiki Activity

[decomp] clean up KERNEL.CGO code (#1420)

Browse Source 
* [decomp] clean up KERNEL.CGO code

* spelling is hard
This commit is contained in:
water111
2022-06-05 15:20:33 -04:00
committed by GitHub
parent 0e91709063
commit bf2f785b2a
12 changed files with 333 additions and 227 deletions
Download Patch File Download Diff File Expand all files Collapse all files
decompiler/config/all-types.gc
+2 -2
View File
@@ -994,7 +994,7 @@
(beach-level-name #x221)
(jungle-level-name #x222)
(misty-level-name #x223)
(jungleb-level-name #x225)
(beach-seagull-get #x22e)
@@ -1735,7 +1735,7 @@
(define-extern process-by-name (function object process-tree process))
(define-extern inspect-process-heap (function process symbol))
;; functions defined in C. TODO - this will end up being a duplicate of kernel-defs.gc?
(define-extern dgo-load (function string kheap int int none))
(define-extern dgo-load (function string kheap link-flag int none))
(define-extern load-package (function string kheap pair))
(define-extern unload-package (function string pair))
(define-extern malloc (function symbol int pointer)) ;; from kernel-defs.gc
goal_src/goal-lib.gc
+1 -1
View File
@@ -63,7 +63,7 @@
Uses the blocking dgo-load."
`(begin
(build-game)
(dgo-load "kernel" global #xf #x200000)
(dgo-load "kernel" global (link-flag output-load-msg output-load-true-msg execute-login print-login) #x200000)
(load-package "game" global)
)
)
goal_src/kernel-defs.gc
+5 -5
View File
@@ -98,7 +98,7 @@
(define-extern new-dynamic-structure (function symbol type int structure))
(define-extern method-set! (function type int object none)) ;; may actually return function.
(define-extern link (function pointer pointer int kheap int pointer))
(define-extern dgo-load (function string kheap int int none))
(define-extern dgo-load (function string kheap link-flag int none))
(define-extern link-begin (function pointer (pointer uint8) int kheap link-flag int))
(define-extern link-resume (function int))
@@ -276,7 +276,7 @@
(ppointer (pointer process) :offset-assert 24)
(self process-tree :offset-assert 28)
)
(:methods
(new (symbol type basic) _type_ 0)
(activate (_type_ process-tree basic pointer) process-tree 9)
@@ -284,8 +284,8 @@
(init-from-entity! (_type_ entity-actor) none 11)
(run-logic? (_type_) symbol 12)
(dummy-method () none 13)
)
)
:size-assert #x20
:method-count-assert 14
:no-runtime-type ;; already defined by kscheme. Don't do it again.
@@ -296,7 +296,7 @@
((name symbol :offset 4)
(next stack-frame :offset 8) ;; which way does this point?
)
:size-assert #xc
:method-count-assert 9
:flag-assert #x90000000c
goal_src/kernel/gcommon.gc
+40 -34
View File
@@ -24,36 +24,14 @@
;; are monitored in the runtime for debugging.
(defglobalconstant USE_VM #t)
;; enables the with-profiler statements, which send profiling data from
;; GOAL code to the frame profiler in C++.
(defglobalconstant PC_PROFILER_ENABLE #t)
(defmacro get-vm-ptr (ptr)
"Turn an EE register address into a valid PS2 VM address"
`(#cond
(USE_VM
(vm-ptr ,ptr)
)
(#t
,ptr
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GOAL language constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GOAL built-in method IDs
(defconstant NEW_METHOD_ID 0)
(defconstant DELETE_METHOD_ID 1)
(defconstant PRINT_METHOD_ID 2)
(defconstant INSPECT_METHOD_ID 3)
(defconstant LENGTH_METHOD_ID 4)
(defconstant ASIZE_METHOD_ID 5)
(defconstant COPY_METHOD_ID 6)
(defconstant RELOC_METHOD_ID 7) ;; or login?
(defconstant MEM_USAGE_METHOD_ID 8)
;; distance from a symbol pointer to a (pointer string)
;; this relies on the memory layout of the symbol table
;; this must match SYM_INFO_OFFSET in goal_constants.h + offset of the str field in struct SymUpper.
@@ -68,16 +46,26 @@
(defconstant PAIR_OFFSET 2)
(defconstant BASIC_OFFSET 4)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GOAL language macros
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Macros
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro symbol->string (sym)
"Convert a symbol to a goal string."
`(-> (the-as (pointer string) (+ SYM_TO_STRING_OFFSET (the-as int ,sym))))
)
(defmacro get-vm-ptr (ptr)
"Turn an EE register address into a valid PS2 VM address"
`(#cond
(USE_VM
(vm-ptr ,ptr)
)
(#t
,ptr
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function versions of built-in forms
@@ -85,6 +73,7 @@
;; basic operations like +, - are handled by the compiler.
;; these provide actual functions that wrap these common operations.
;; this allows you to use them as actual function objects
(defun identity ((x object))
"Function which returns its input. The first function of the game!
@@ -138,7 +127,6 @@
This is a 32-bit operation. It uses an idiv on x86 and gets the remainder."
;; The original implementation is div, mfhi
;; todo - verify this is exactly the same as the PS2.
(mod a b)
)
@@ -147,7 +135,6 @@
"Compute remainder (32-bit). It is identical to mod. It uses a idiv and gets the remainder"
;; The original implementation is div, mfhi
;; todo - verify this is exactly the same as the PS2.
(mod a b)
)
@@ -290,6 +277,7 @@
(the-as uint result)
)
)
;; A "boxed float" type. Simply a float with type information.
(deftype bfloat (basic)
((data float :offset-assert 4))
@@ -664,7 +652,7 @@
;; This is used as base class for boxed inline arrays.
;; The heap-base of the _type_ object will be used to store the stride
;; This way, you don't pay the price of storing the stride in each object.
;; however, 250k lines in, we haven't seen anything actually use this...
;; however, as far as we've seen, nothing actually reads the stride.
(deftype inline-array-class (basic)
((length int32 :offset-assert 4)
@@ -887,7 +875,6 @@
obj
)
;; definition for method of type array
(defmethod inspect array ((obj array))
"Inspect an array"
(format #t "[~8x] ~A~%" obj (-> obj type))
@@ -1103,7 +1090,10 @@
)
(defmacro printl (obj)
"Print out a boxed object and a newline"
"Print out a boxed object and a newline.
Note: we define both a macro and a function on purpose.
The compiler will use the macro over the function, which will
allow it to pick the correct print method for non-boxed objects"
`(begin
(print ,obj)
(format #t "~%")
@@ -1429,32 +1419,48 @@
`(none)
)
;;;;;;;;;;;;;;;;;;;;
;; Profiler Macros
;;;;;;;;;;;;;;;;;;;;
(defmacro profiler-instant-event (name)
"Record an 'instant' event in the profile.
This can be used however you'd like, but there should be a
'ROOT' event logged every now and then (like once per frame)
when no timed events are in progress, to allow the profiler
to correctly recover the event stack."
`(#when PC_PROFILER_ENABLE
(pc-prof ,name (pc-prof-event instant))
)
)
(defmacro profiler-start-event (name)
"Start a timed event with the given name."
`(#when PC_PROFILER_ENABLE
(pc-prof ,name (pc-prof-event begin))
)
)
(defmacro profiler-end-event ()
"End the most recently started event that hasn't been stopped yet.
It is up to you to correctly balance the starts/ends, otherwise
the profiling data will be corrupted."
`(#when PC_PROFILER_ENABLE
(pc-prof "" (pc-prof-event end))
)
)
(defmacro with-profiler (name &rest body)
"Execute the body in a named profiler block.
Do not `return` or `go` from inside this block,
otherwise the end will be skipped."
`(#if PC_PROFILER_ENABLE
(begin
(pc-prof ,name (pc-prof-event begin))
,@body
(pc-prof ,name (pc-prof-event end))
)
(begin
,@body
)
goal_src/kernel/gkernel-h.gc
+131 -114
View File
@@ -5,19 +5,27 @@
;; name in dgo: gkernel-h
;; dgos: KERNEL
;; Type definitions and constants for the GOAL Kernel and process pools.
;; The kernel is dispatched from a simple loop in C and runs all GOAL processes.
;; Type definitions and constants for the GOAL Kernel. The GOAL kernel is dipatched
;; from C++ through the *kernel-dispatcher* and is responsible for:
;; - running all GOAL code
;; - handling creation, destruction, and compaction of GOAL processes
;; - managing GOAL threads and the "suspend" keyword
;; - handling stack frames, nonlocal throws used by the state system
;; - process handles.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CONSTANTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; -hardware-
;; if set, will attempt to detect memory corruption and stack overflow bugs
;; to some extent.
(defglobalconstant KERNEL_DEBUG #t)
;; the end of the 16 kB fast "scratchpad" memory of the PS2.
;; this memory is mapped to 0x70000000 in the PS2.
;; -hardware
;; processes can execute using the scratchpad as their stack to get better
;; performance. The scratchpad address is #x70000000 to #x70004000 on PS2.
;; On PC, we'll detect the use of the scratchpad within gkernel.gc and move it elsewhere.
(defconstant *scratch-memory-top* (the pointer #x70004000))
;; -versions-
@@ -34,11 +42,15 @@
;; -memory-
;; the size of the execution stack (14 kB) shared by all threads
;; OpenGOAL NOTE: increased to 32kB
;; in GOAL threads, to save memory, each thread owns a tiny stack to store
;; the stack when suspended, and copies it to and from a larger stack for execution.
;; Attempting to suspend a thread in a deep callstack will fail because the tiny stack won't have
;; enough room. But this strategy saves memory in the end.
;; the size of the single large "DRAM" execution stack (14 kB increased to 32 kB in PC)
(defconstant DPROCESS_STACK_SIZE #x8000)
;; another stack size used as a maximum for temporary threads
;; the size of the execution stack, if not using the big DRAM stack.
;; OpenGOAL NOTE: 7kB -> 24kB
(defconstant PROCESS_STACK_SIZE (#if PC_PORT #x6000 #x1c00))
@@ -64,36 +76,40 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; bitfield enum to indicate properties about a process-tree
;; Some of these bits are used by the kernel for book-keeping, but others
;; can be set by the user to prevent a process from running in certain conditions.
(defenum process-mask
:bitfield #t :type uint32
(execute 0) ;; 1 ?, prevents from running
(draw 1) ;; 2 ?
(pause 2) ;; 4 shouldn't run when game is paused
(menu 3) ;; 8 shouldn't run when debug menu open
(progress 4) ;; 16 shouldn't run when progress menu open
(actor-pause 5) ;; 32 ?, related to the actor system
(sleep 6) ;; 64 do not run this process at all
(sleep-code 7) ;; 128 do not run the code of this process (other stuff runs)
(process-tree 8) ;; 256 not an actual process, just a "tree node" for organization
(heap-shrunk 9) ;; 512 actor heap compactor has already shrunk the heap of this proc
(going 10) ;; 1024 there is a next state set that will be entered next time (pending enter-state)
(movie 11) ;; 2048
(movie-subject 12) ;; 4096
(target 13) ;; 8192
(sidekick 14) ;; 16384
(crate 15) ;; 32768
(collectable 16) ;; 65536
(enemy 17) ;; 131072
(camera 18) ;; 262144
(platform 19) ;; 524288
(ambient 20) ;; 1048576
(entity 21) ;; 2097152
(projectile 22) ;; 4194304
(attackable 23) ;; 8388608
(death 24) ;; 16777216
(execute 0) ;; when set, prevents a process from running, in every case.
(draw 1) ;; unused
(pause 2) ;; when set, the process won't run if the game is paused.
(menu 3) ;; when set, the process won't run if the debug menu system is open
(progress 4) ;; the process won't run if the start menu (progress menu) is open
(actor-pause 5) ;; when set, the entity system will try to pause it automatically if you are far away.
(sleep 6) ;; prevents the process from running, but can be woken up by state changes.
(sleep-code 7) ;; do not run the code (main thread) of this process (other stuff runs)
(process-tree 8) ;; not an actual process, just a "tree node" for organization
(heap-shrunk 9) ;; actor heap compactor has already shrunk the heap of this proc
(going 10) ;; there is a next state set that will be entered next time (pending enter-state)
(movie 11) ;; when set, don't run if we are in a movie
(movie-subject 12) ;; set on silostep, unused otherwise.
(target 13) ;; set on target
(sidekick 14) ;; set on sidekick
(crate 15) ;; set on all crates
(collectable 16) ;; set on all collectables
(enemy 17) ;; set on all enemies (inclues stuff like seagulls)
(camera 18) ;; set on all cameras
(platform 19) ;; set on all platforms
(ambient 20) ;; set on all ambients
(entity 21) ;; set on all processes spawned from entities
(projectile 22) ;; set on all projectiles
(attackable 23) ;; set on all "attackables" that can be targeted by projectiles or similar
(death 24) ;; set on misty-conveyor, appears unused.
)
;; -961
;; these bits are cleared when inheriting the mask from a parent process.
(defconstant PROCESS_CLEAR_MASK
(lognot (process-mask sleep sleep-code process-tree heap-shrunk)))
@@ -107,11 +123,9 @@
)
(defmacro msg-err (&rest args)
;; "Print a message to stdout immediately. This won't appear in the compiler."
`(format 0 ,@args)
)
(defmacro msg-warn (&rest args)
"Print a message to stdout immediately. This won't appear in the compiler.
This is useful if the game is crashing before messages can be flushed
to compiler."
`(format 0 ,@args)
)
@@ -121,19 +135,19 @@
;; this stores the current state of the kernel.
(deftype kernel-context (basic)
((prevent-from-run process-mask :offset-assert 4)
(require-for-run process-mask :offset-assert 8) ;; seems unused
(allow-to-run process-mask :offset-assert 12) ;; seems unused
(next-pid int32 :offset-assert 16)
((prevent-from-run process-mask :offset-assert 4) ;; don't run processes with any of these bits set.
(require-for-run process-mask :offset-assert 8) ;; unused
(allow-to-run process-mask :offset-assert 12) ;; unused
(next-pid int32 :offset-assert 16) ;; next unused unique process ID
(fast-stack-top pointer :offset-assert 20)
(current-process process :offset-assert 24)
(relocating-process basic :offset-assert 28)
(relocating-min int32 :offset-assert 32)
(relocating-max int32 :offset-assert 36)
(relocating-offset int32 :offset-assert 40)
(low-memory-message symbol :offset-assert 44)
(current-process process :offset-assert 24) ;; currently executing process
(relocating-process basic :offset-assert 28) ;; currently relocating process
(relocating-min int32 :offset-assert 32) ;; start of memory being relocated
(relocating-max int32 :offset-assert 36) ;; end of memory being relocated
(relocating-offset int32 :offset-assert 40) ;; how far the memory being relocated is moving
(low-memory-message symbol :offset-assert 44) ;; should we print warnings if low on memory?
)
:size-assert #x30
:method-count-assert 9
:flag-assert #x900000030
@@ -164,13 +178,13 @@
(stack-top pointer :offset-assert 32) ;; top of the thread's stack (actual stack)
(stack-size int32 :offset-assert 36) ;; size of the thread's stack (backup stack)
)
(:methods
(stack-size-set! (_type_ int) none 9)
(thread-suspend (_type_) none 10)
(thread-resume (_type_) none 11)
)
:size-assert #x28
:method-count-assert 12
:flag-assert #xc00000028
@@ -183,48 +197,49 @@
;; This is what GOAL did:
;; (rreg uint64 8 :offset-assert 40) ;; general purpose saved registers
;; (freg float 6 :offset-assert 104) ;; floating point registers
;; OpenGOAL has only 5 saved registers but 8 fregs, so we swap a rreg for 2 fregs.
(rreg uint64 7 :offset-assert 40)
(freg float 8)
;; This is the same between GOAL and OpenGOAL
(stack uint8 :dynamic :offset-assert 128) ;; stack memory (dynamic array)
)
(:methods
(new (symbol type process symbol int pointer) _type_ 0)
(thread-suspend (_type_) none 10)
(thread-resume (_type_) none 11)
)
:size-assert #x80
:method-count-assert 12
:flag-assert #xc00000080
)
;; ppointer system:
;; a process may move in memory, but we need a way to keep track of a process.
;; this is where "ppointer" comes in. It is a GOAL (pointer process), like a C Process**.
;; Each process must contain a ppointer that can be used to find it. The process pointed to by
;; the ppointer must be a valid process or #f at all times.
;; Parent type of all process tree nodes.
;; A process-tree is a left-child right-sibling binary tree
;; A process-tree is a left-child right-sibling binary tree
;; (except GOAL is old and it looks like they called them left-child right-brother trees back then)
(declare-type entity-actor basic)
(deftype process-tree (basic)
((name basic :offset-assert 4)
(mask process-mask :offset-assert 8)
((name basic :offset-assert 4)
(mask process-mask :offset-assert 8)
;; tree
(parent (pointer process-tree) :offset-assert 12)
(brother (pointer process-tree) :offset-assert 16)
(child (pointer process-tree) :offset-assert 20)
;; a process may move in memory. However, an active process must have a ppointer. The value of the ppointer never changes
;; you can dereference this pointer at any time.
;; you will either get: your original process, another process (with a different PID), or #f.
;; NOTE: the ppointer is like a C++ Process**.
(ppointer (pointer process) :offset-assert 24)
(parent (pointer process-tree) :offset-assert 12)
(brother (pointer process-tree) :offset-assert 16)
(child (pointer process-tree) :offset-assert 20)
(ppointer (pointer process) :offset-assert 24)
;; in cases where the process never moves, the kernel will set ppointer to the address of the self field
(self process-tree :offset-assert 28)
(self process-tree :offset-assert 28)
)
(:methods
(new (symbol type basic) _type_ 0)
(activate (_type_ process-tree basic pointer) process-tree 9)
@@ -232,8 +247,8 @@
(init-from-entity! (_type_ entity-actor) none 11)
(run-logic? (_type_) symbol 12)
(dummy-method () none 13)
)
)
:size-assert #x20
:method-count-assert 14
:no-runtime-type ;; already defined by kscheme. Don't do it again.
@@ -246,7 +261,7 @@
(deftype process (process-tree)
((pool dead-pool :offset-assert #x20) ;; the memory pool we came from, and should return to when we die
(status basic :offset-assert #x24)
(pid int32 :offset-assert #x28) ;; unqiue process ID
(pid int32 :offset-assert #x28) ;; unqiue process ID
(main-thread cpu-thread :offset-assert #x2c) ;; our suspendable main thread
(top-thread thread :offset-assert #x30) ;; currently running thread
(entity entity :offset-assert #x34) ;; if we are a process spawned by an entity, our entity
@@ -299,7 +314,7 @@
(prev dead-pool-heap-rec :offset-assert 4) ;; next rec in the linked list
(next dead-pool-heap-rec :offset-assert 8) ;; prev. rec in the linked list
)
:pack-me ; don't worry about aligning me to 16-bytes in arrays and types.
:size-assert #xc
:method-count-assert 9
@@ -311,19 +326,17 @@
;; Alive processes in a dead-pool-heap can be relocated and compacted to reduce heap fragmentation.
(deftype dead-pool-heap (dead-pool)
((allocated-length int32 :offset-assert #x20) ;; size of heap
(compact-time uint32 :offset-assert #x24) ;; ??
(compact-count-targ uint32 :offset-assert #x28) ;; ??
(compact-count uint32 :offset-assert #x2c) ;; ??
(fill-percent float :offset-assert #x30) ;; ??
(first-gap dead-pool-heap-rec :offset-assert #x34) ;; ??
(first-shrink dead-pool-heap-rec :offset-assert #x38) ;; ??
(heap kheap :inline :offset-assert 64) ;; ??
(alive-list dead-pool-heap-rec :inline :offset-assert 80) ;; ??
(compact-time uint32 :offset-assert #x24) ;; unused...
(compact-count-targ uint32 :offset-assert #x28) ;; number of compactions requested
(compact-count uint32 :offset-assert #x2c) ;; number of compactions perfomed
(fill-percent float :offset-assert #x30) ;; unused
(first-gap dead-pool-heap-rec :offset-assert #x34) ;; the lowest process with a gap in the heap
(first-shrink dead-pool-heap-rec :offset-assert #x38) ;; the lowest process that needs shrinking
(heap kheap :inline :offset-assert 64) ;; our shared heap for processes
(alive-list dead-pool-heap-rec :inline :offset-assert 80) ;; records for processes that are alive
(last dead-pool-heap-rec :offset #x54 :offset-assert #x54) ;; overlay of (-> alive-list prev)
;; note - the placement of dead-list at 92 here is used to determine the packing behavior.
;; see TypeSystem::get_size_in_type().
(dead-list dead-pool-heap-rec :inline :offset-assert 92) ;; ??
(process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104)
(dead-list dead-pool-heap-rec :inline :offset-assert 92) ;; unused records
(process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104) ;; array of records
)
(:methods
(new (symbol type basic int int) _type_ 0)
@@ -339,7 +352,7 @@
(memory-free (dead-pool-heap) int 25)
(compact-time (dead-pool-heap) uint 26)
)
:size-assert #x68
:method-count-assert #x1b
:flag-assert #x1b00000068
@@ -352,7 +365,7 @@
((name symbol :offset 4)
(next stack-frame :offset 8) ;; follow this to get to the root frame, away from top.
)
:size-assert #xc
:method-count-assert 9
:flag-assert #x90000000c
@@ -365,16 +378,16 @@
(deftype catch-frame (stack-frame)
((sp int32 :offset 12) ;; where to reset the stack when throwing.
(ra int32 :offset 16) ;; where to jump when throwing
;; In GOAL
;; (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)
;; In OpenGOAL, we swap a rreg for 4 more fregs.
;; In OpenGOAL, we swap a rreg for 4 more fregs.
(freg float 10 :offset-assert 20) ;; only use 8
(rreg uint128 7) ;; only use 5
)
(:methods
(new (symbol type symbol function (pointer uint64)) object 0)
)
@@ -386,7 +399,7 @@
;; A protect frame is a frame which has a cleanup function called on exit.
(deftype protect-frame (stack-frame)
((exit (function none) :offset-assert 12)) ;; function to call to clean up
(:methods
(new (symbol type (function none)) protect-frame)
)
@@ -420,8 +433,7 @@
(defmacro handle->process (handle)
;; the actual implementation is more clever than this.
;; Checks PID.
"Convert a handle to a process. If the process no longer exists, returns #f."
`(let ((the-handle (the-as handle ,handle)))
(if (-> the-handle process) ;; if we don't point to a process, kernel sets this to #f
(let ((proc (-> (-> the-handle process))))
@@ -434,7 +446,7 @@
)
(defmacro ppointer->process (ppointer)
;; convert a (pointer process) to a process.
"convert a (pointer process) to a process."
;; this uses the self field, which seems to always just get set to the object.
;; perhaps when deleting a process you could have it set self to #f?
;; I don't see this happen anywhere though, so it's not clear.
@@ -451,21 +463,22 @@
)
(defmacro ppointer->handle (pproc)
"convert a ppointer to a handle. assumes the ppointer is valid."
`(let ((the-process (the-as (pointer process) ,pproc)))
(new 'static 'handle :process the-process :pid (-> the-process 0 pid))
)
)
(defmacro process->handle (proc)
"convert a process to a handle. if proc is #f, returns a #f handle."
`(ppointer->handle (process->ppointer ,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))
"print a handle"
(if (nonzero? (-> obj u64)) ;; zero-initialized handles can't be derefenced safely.
(format #t "#<handle :process ~A :pid ~D>"
(handle->process obj)
(handle->process obj) ;; actually print the process stored
(-> obj pid)
)
(format #t "#<handle :process 0 :pid 0>")
@@ -491,7 +504,7 @@
)
(:methods
(new (symbol type symbol function
(function none)
(function none)
function
(function none)
(function process int symbol event-message-block object)) _type_ 0)
@@ -510,7 +523,7 @@
(message symbol :offset-assert 12)
(param uint64 7 :offset-assert 16)
)
:size-assert #x48
:method-count-assert 9
:flag-assert #x900000048
@@ -557,14 +570,11 @@
`(set! ,mask (logand ,mask (lognot (process-mask ,@enum-value))))
)
;; set to true to get error prints on suspends out of stack.
(defglobalconstant DEBUG_PRINT_SUSPEND_FAIL #f)
(defmacro suspend ()
;; suspend the current process.
"suspend the current process, to be resumed on the next frame."
`(rlet ((pp :reg r13 :reset-here #t))
(#when (or DEBUG_PRINT_SUSPEND_FAIL KERNEL_DEBUG)
;; debug check for stack overflow here, where we can easily print the process name.
(#when (or KERNEL_DEBUG)
(rlet ((sp :reg rsp :reset-here #t :type int)
(off :reg r15 :type uint))
(let* ((sp-goal (- sp off))
@@ -582,23 +592,25 @@
(set! pp (-> (the process pp) top-thread))
;; call the suspend hook (put nothing as the argument)
((-> (the cpu-thread pp) suspend-hook) (the cpu-thread 0))
;; the kernel will set pp (possibly to a new value) on resume.
;; the kernel will set pp (possibly to a new value, if we've been relocated) on resume.
)
)
(defmacro process-deactivate ()
;; deactivate the current process
"deactivate (kill) the current process"
`(rlet ((pp :reg r13 :reset-here #t :type process))
(deactivate pp)
)
)
(defmacro with-pp (&rest body)
"execute the body with pp bound to the current process register."
`(rlet ((pp :reg r13 :reset-here #t :type process))
,@body)
)
(defmacro with-proc (bindings &rest body)
"execute the body with process register set to the given value and bound to pp."
`(rlet ((pp :reg r13 :reset-here #t :type process))
(protect (pp)
(set! pp ,(car bindings))
@@ -607,6 +619,8 @@
)
(defmacro defbehavior (name process-type bindings &rest body)
"define a new behavior. This is simply a function where self is bound to the process register,
which is assumed to have type process-type."
(if (and
(> (length body) 1) ;; more than one thing in function
(string? (first body)) ;; first thing is a string
@@ -637,9 +651,9 @@
bindings are: (child proc); proc = process we do this on; child = var name for the current child ptr."
`(let ((,(first bindings) (-> ,(second bindings) child)))
(while ,(first bindings)
,@body
(set! ,(first bindings) (-> ,(first bindings) 0 brother))
)
)
@@ -663,6 +677,7 @@
)
(defmacro with-sp (&rest body)
"execute the body with sp bound to the current stack pointer (be careful!)"
`(rlet ((sp :reg rsp :reset-here #t :type pointer))
,@body)
)
@@ -678,8 +693,9 @@
)
;; Some assembly functions in GOAL are ported to C++, then accessed from GOAL using these mips2c macros.
(defmacro def-mips2c (name type)
"Define a mips2c object."
"Define a mips2c object (typically a function)."
`(begin
(define-extern ,name ,type)
(set! ,name (the-as ,type (__pc-get-mips2c ,(symbol->string name))))
@@ -687,5 +703,6 @@
)
(defmacro defmethod-mips2c (name method-id method-type)
"Define a mips2c method."
`(method-set! ,method-type ,method-id (__pc-get-mips2c ,name))
)
goal_src/kernel/gkernel.gc
+104 -50
View File
@@ -32,16 +32,16 @@
;; Can be 'boot, 'listener, or 'debug-boot
;; set to 'boot when DiskBooting.
(define *kernel-boot-mode* 'listener)
(define *kernel-boot-mode* 'listener) ;; mostly unused.
;; DebugBootLevel in C Kernel
(define *kernel-boot-level* (the symbol #f))
(define *kernel-boot-level* (the symbol #f)) ;; doesn't do anything.
;; The number of DECI messages received.
;; The C Kernel increments this.
(define *deci-count* 0)
;; Some debug stats. Unused?
;; Some debug stats. Unused.
(define *last-loado-length* 0)
(define *last-loado-global-usage* 0)
(define *last-loado-debug-usage* 0)
@@ -72,8 +72,7 @@
(defun load-package ((package string) (allocation kheap))
"Load a Package from a CGO/DGO"
(unless (nmember package *kernel-packages*)
;; #xf = OUTPUT_LOAD, OUTPUT_TRUE, EXECUTE, PRINT_LOGIN
(dgo-load package allocation #xf #x200000)
(dgo-load package allocation (link-flag output-load-msg output-load-true-msg execute-login print-login) #x200000)
(set! *kernel-packages* (cons package *kernel-packages*))
)
)
@@ -96,7 +95,7 @@
;; The kernel context is a global which stores the state of the kernel.
(define *kernel-context* (new 'static 'kernel-context
:prevent-from-run (process-mask execute sleep)
:next-pid 2
:next-pid 2 ;; 1 will be listener
:current-process #f
:relocating-process #f
:low-memory-message #t
@@ -117,23 +116,24 @@
;; without executing anything, to find a process for instance.
(define *null-kernel-context* (new 'static 'kernel-context))
;; scratchpad setup
(#cond
(PC_PORT
;; make sure the scratchpad is 16kb aligned, and make it 32 kB so we can big stacks on it.
;; we'll create a fake scratchpad:
;; make sure the scratchpad is 64kb aligned, and make it 32 kB so we can big stacks on it.
;; some (partially buggy) code in generic tie relies on 64 kB alignment.
(let* ((mem (new 'global 'array 'uint8 (* 128 1024)))
)
(define *fake-scratchpad-data* (the pointer (align-n mem (* 64 1024))))
)
;; We will move stacks on the scratchpad to here.
;; it might be possible to also throw them on the *dram-stack*, but they might depend on these
;; not overlapping. We can spare the 16k of memory.
;; use the same memory for the scratchpad stacks.
;; defining it as a separate thing so we can split them for debugging stack corruption easily.
(define *fake-scratchpad-stack* *fake-scratchpad-data*)
;;(define *fake-scratchpad-stack* (new 'global 'array 'uint8 (* 16 1024)))
(defmacro scratchpad-start()
(defmacro scratchpad-start ()
"Get the start of the scratchpad. At least 64kB aligned."
'*fake-scratchpad-data*
)
)
@@ -145,10 +145,12 @@
)
(defmacro scratchpad-end ()
"Get the end of the scratchpad memory"
`(&+ (scratchpad-start) (* 16 1024))
)
(defmacro in-scratchpad? (x)
"Is the given address in the scratchpad?"
`(and
(>= (the-as int ,x) (scratchpad-start))
(< (the-as int ,x) (scratchpad-end))
@@ -197,7 +199,8 @@
(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."
This should be done immediately after allocating the main-thread.
Users can do this if they want a larger or smaller backup stack than the default."
(let ((proc (-> this process)))
(cond
@@ -238,7 +241,7 @@
((-> parent-process top-thread)
;; we're allocating a temporary thread, the main thread already exists.
;; we can stash the cpu-thread structure at the bottom of the stack.
;; we use the smaller PROCESS_STACK_SIZE, which is only half the size of the real stack.
;; we use the smaller PROCESS_STACK_SIZE, in case we're running on the scratchpad.
(the cpu-thread (&+ stack-top
(- PROCESS_STACK_SIZE)
*gtype-basic-offset*
@@ -292,7 +295,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defbehavior remove-exit process ()
"Pops a single stack frame, if there is one."
"Pops a single stack frame, if there is one.
User code can call this before doing a 'go' to avoid running the exit for the current state."
(when (-> self stack-frame-top)
(set! (-> self stack-frame-top) (-> self stack-frame-top next))
)
@@ -312,9 +316,8 @@
arg1
)
;; game state
(define *master-mode* 'game)
(define *pause-lock* #f)
(define *master-mode* 'game) ;; game, process, menu, pause
(define *pause-lock* #f) ;; set to #t when paused and doing a single frame advance with R2.
(defmethod new process-tree ((allocation symbol) (type-to-make type) (name basic))
"Create a process-tree node"
@@ -531,7 +534,7 @@
(s4 :reg r12 :type uint)
)
;; first call the deactivate method. (todo - is the stack properly aligned for this?)
;; first call the deactivate method.
(deactivate pp)
;; get the kernel stack pointer as a GOAL pointer
(.load-sym :sext #f sp *kernel-sp*)
@@ -557,7 +560,6 @@
NOTE: this should only be done from the kernel, running on the
kernel's stack."
(declare (asm-func object)
;(print-asm)
)
(rlet ((pp :reg r13 :type process)
@@ -854,7 +856,8 @@
;; Process Dead Pool
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; a dead-pool is a collection of processes of fixed size that you can get processes from.
;; a dead pool is just a collection of dead processes of a fixed size.
(define-extern *debug-dead-pool* dead-pool-heap)
@@ -1134,6 +1137,9 @@
)
)
;; this will be set to #t if we're using visibility data.
;; if we aren't, there will be many cases where we try to spawn too many actors, and we shouldn't
;; warn when this happens.
(define-extern *vis-boot* basic)
(defmethod get-process dead-pool-heap ((obj dead-pool-heap) (type-to-make type) (stack-size int))
@@ -1527,7 +1533,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod run-logic? process ((obj process))
"Return if the process should be run or not."
"Return if the process should be run or not.
Children of process should override this with more interesting functions"
#t)
;; the following three functions recursively iterate through process trees.
@@ -1571,7 +1578,7 @@
;; run on our children
(cond
((eq? ret 'dead)
((eq? ret 'dead) ;; if dead, don't bother checking children.
)
(else (let ((brother (-> obj child)))
(while brother
@@ -1637,48 +1644,60 @@
(define-extern *active-pool* process-tree)
(defun kernel-dispatcher ()
"Run the kernel!"
"Run the kernel!
This is the entry point from C++ to GOAL."
;; outside of all profiler events, set a ROOT event
(profiler-instant-event "ROOT")
;; execute the listener function, if we got one.
(when *listener-function*
(let ((result (reset-and-call (-> *listener-process* main-thread) *listener-function*)))
(+! *enable-method-set* 1) ;; allow out-of-order method definitions (slower)
(let ((result (reset-and-call (-> *listener-process* main-thread) *listener-function*))) ;; run function!
;; print result.
(if *use-old-listener-print*
(format #t "~D~%" result result result)
(format #t "~D #x~X ~F ~A~%" result result result result)
)
)
;; clear pending function
(set! *listener-function* #f)
(+! *enable-method-set* -1)
)
;; iterate over all processes, running this lambda:
(execute-process-tree
*active-pool*
(lambda ((obj process))
;(format 0 "Call to dispatcher lambda!~%")
(let ((context *kernel-context*))
(cond
((or (eq? (-> obj status) 'waiting-to-run)
(eq? (-> obj status) 'suspended))
;; begin event in profiler.
(profiler-start-event (process-name-as-string obj))
;; we should run!
;; set current process to us
(set! (-> context current-process) obj)
;; update pause junk for this run
;; pause tricks to prevent debug text and drawings from disappearing when pausing:
(cond
((process-mask? (-> obj mask) pause)
;; we're paused.
;; we are a pausable object, so we should put our *stdcon* to the one that isn't cleared during pause:
(set! *stdcon* *stdcon1*)
;; and we should do our debug drawing to a buffer that isn't cleared during pause:
(set! *debug-draw-pauseable* #t)
)
(else
(set! *stdcon* *stdcon0*)
(set! *debug-draw-pauseable* #f)
)
;; non-pausable, use the *stdcon* that's cleared each time
(set! *stdcon* *stdcon0*)
;; and don't debug draw to a buffer
(set! *debug-draw-pauseable* #f)
)
)
;; TRANS
;; this function should run before resuming.
(cond
((-> obj trans-hook)
;; we have a trans hook defined. let's create a thread and run it. we can reuse the stack of the main-thread
@@ -1698,7 +1717,7 @@
(when (eq? (-> obj status) 'dead)
(set! (-> context current-process) #f)
(profiler-end-event)
(return 'dead)
(return 'dead) ;; tells the execute-process-tree function to skip our children.
)
)
)
@@ -1709,7 +1728,7 @@
;; we're sleeping. Move us to suspended, in case we were in waiting to run.
(set! (-> obj status) 'suspended)
;; not sleeping. call resume hook
;; not sleeping. call resume hook. This will return once the main thread suspends again.
((-> obj main-thread resume-hook) (-> obj main-thread))
)
@@ -1726,6 +1745,8 @@
;; POST CODE
(cond
((-> obj post-hook)
;; Note: use dram stack always. This will allow actors to use the scratchpad stack and get a speedup for trans/code
;; but still be able to do joint-animation stuff that uses the scratchpad in post.
(let ((post (new 'process 'cpu-thread obj 'post PROCESS_STACK_SAVE_SIZE *kernel-dram-stack*)))
(reset-and-call post (-> obj post-hook))
(delete post)
@@ -2203,23 +2224,31 @@
(defmethod activate process ((obj process) (dest process-tree) (name basic) (stack-top pointer))
"Activate a process! Put it on the given active tree and set up the main thread."
;; if we got the scratchpad stack, move to the fake scratchpad.
(#when PC_PORT
(when (= stack-top *scratch-memory-top*)
;; (format #t "Process ~A requested a stack on the scratchpad, moving to fake scratch~%")
(set! stack-top (&+ *fake-scratchpad-stack* (* 32 1024)))
)
)
;; inherit mask (minus stuff like sleep)
(set! (-> obj mask) (logand (-> dest mask) PROCESS_CLEAR_MASK))
(set! (-> obj status) 'ready)
;; get a unique pid.
(let ((pid (-> *kernel-context* next-pid)))
(set! (-> obj pid) pid)
(set! (-> *kernel-context* next-pid) (+ 1 pid)))
(set! (-> obj top-thread) #f)
(set! (-> obj main-thread) #f)
(set! (-> obj name) name)
;; set up our heap. Note that we apply an offset of heap-base to leave room for fields of the actual type.
;; unclear why we can't just use the size of our type... but I guess this gives you the option
;; to put some other stuff in between the fields and the heap.
(set! (-> obj heap-base) (set! (-> obj heap-cur) (&+ (-> obj stack) (-> obj type heap-base))))
(set! (-> obj stack-frame-top) #f)
;; heaps should be 0 initialized.
(mem-set32! (-> obj stack) (the int (/ (-> obj type heap-base) 4)) 0)
(set! (-> obj trans-hook) #f)
@@ -2227,14 +2256,18 @@
(set! (-> obj event-hook) #f)
(set! (-> obj state) #f)
(set! (-> obj next-state) #f)
;; inherit entity if our parent is another process
(if (process-mask? (-> dest mask) process-tree)
(set! (-> obj entity) #f)
(set! (-> obj entity) (-> (the process dest) entity))
)
;; reset all connections
(set! (-> obj connection-list next1) #f)
(set! (-> obj connection-list prev1) #f)
;; allocate the main thread (sets everything up.)
(let ((thread (new 'process 'cpu-thread obj 'code PROCESS_STACK_SAVE_SIZE stack-top)))
(set! (-> obj main-thread) thread)
)
@@ -2304,7 +2337,8 @@
To reset a thread to running a new function, we stash the arguments as saved registers.
These are then restored by thread-resume on the next run of the kernel.
This stub remaps these saved registers to argument registers.
It also creates a return trampoline to return-from-thread-dead"
It also creates a return trampoline to return-from-thread-dead, so if the main thread returns, the
process is properly cleaned up by deactivate."
(declare (asm-func none)
;;(print-asm)
)
@@ -2376,6 +2410,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod deactivate process-tree ((obj process-tree))
"Can't deactivate a process-tree"
(none)
)
@@ -2412,19 +2447,22 @@
;; don't do anything if we already died.
(unless (eq? (-> obj status) 'dead)
;; set our state to a dead-state that does nothing.
(set! (-> obj next-state) dead-state)
;; call entity handler
;; call entity handler if we're from an entity.
(when (-> obj entity)
(entity-deactivate-handler obj (-> obj entity))
)
;; clean up stack frames the process is in.
;; first, set pp so the cleanup code thinks its running in the right process.
;; we might be getting deactivated from another process.
(rlet ((pp :reg r13 :type process))
(let ((old-pp pp))
(set! pp obj)
(let ((cur (-> pp stack-frame-top)))
;; loop over frames...
(while cur
(case (-> cur type)
((protect-frame state)
@@ -2439,6 +2477,7 @@
)
)
;; remove our connections.
;; hack - if this isn't defined yet, don't try it.
(if (!= 0 (the uint process-disconnect))
(process-disconnect obj)
@@ -2470,6 +2509,7 @@
;; go straight to dead.
(set! (-> obj status) 'dead)
;; and return (with no deactivate)
;; TODO: replace with abandon.
(let ((temp (the uint return-from-thread)))
(rlet ((off :reg r15 :type uint))
(+! temp off)
@@ -2480,13 +2520,8 @@
)
;; second case - we deactivated while initializing.
((eq? (-> obj status) 'initialize)
;; added this
; (if (!= pp obj)
; (format 0 "ERROR: deactivated a non-current initializing process!")
; (break)
; )
(set! (-> obj status) 'dead)
;; throw back to the place where we started initializing.
(throw 'initialize #f)
)
)
@@ -2500,14 +2535,20 @@
;; Process Globals
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the listener process is used to run functions from the REPL.
(let ((obj (define *listener-process* (new 'global 'process 'listener 2048))))
(set! (-> obj status) 'ready)
(set! (-> obj pid) 1)
(set! (-> obj main-thread) (new 'process 'cpu-thread obj 'main 256 *kernel-dram-stack*))
)
;; these are unknown
;; a dummy process for process records that don't have a process to point to.
;; it has a PID of 0, which matches nothing so the handle->process will return #f if the
;; ppointer points to this
(define *null-process* (new 'global 'process 'listener 16))
;; do we have visibility data? level.gc will set this once we do, and once that happens, we expect
;; actors to fit in the non-debug heap.
(define *vis-boot* #f)
;; a few pools of fixed size processes that are shared.
@@ -2520,31 +2561,44 @@
(define *camera-dead-pool* (new 'global 'dead-pool 7 (* 4 1024) '*camera-dead-pool*))
(define *camera-master-dead-pool* (new 'global 'dead-pool 1 (* 8 1024) '*camera-master-dead-pool*))
;; used if other pools run out of space in debug mode
(if *debug-segment*
(define *debug-dead-pool* (new 'debug 'dead-pool-heap '*debug-dead-pool* 768 (* 1024 1024)))
)
;; variable sized actor pool (most actors go here)
(define *nk-dead-pool* (new 'global 'dead-pool-heap '*nk-dead-pool* (* PROCESS_HEAP_MULT 768) PROCESS_HEAP_SIZE))
;; use the nk-dead-pool in most places
(define *default-dead-pool* (the dead-pool *nk-dead-pool*))
(define *pickup-dead-pool* (the dead-pool *nk-dead-pool*))
;; list of all dead pools held by the kernel.
(define *dead-pool-list* '(*4k-dead-pool* *8k-dead-pool* *16k-dead-pool* *nk-dead-pool* *target-dead-pool* *camera-dead-pool* *camera-master-dead-pool*))
;; main active pool
;; main active pool. All active processes are under here. This is what the kernel-dispatcher looks at.
(define *active-pool* (new 'global 'process-tree 'active-pool))
;; other active pools
;; create pools within *active-pool*
;; the *display-pool* will contain the display process which does rendering, vsync, and many per-frame updates.
(change-parent (define *display-pool* (new 'global 'process-tree 'display-pool)) *active-pool*)
;; the *camera-pool* will contain all cameras
(change-parent (define *camera-pool* (new 'global 'process-tree 'camera-pool)) *active-pool*)
;; all cameras should pause in menus
(set! (-> *camera-pool* mask) (process-mask pause menu progress camera process-tree))
;; the *target-pool* will contain jak
(change-parent (define *target-pool* (new 'global 'process-tree 'target-pool)) *active-pool*)
;; pause in menus
(set! (-> *target-pool* mask) (process-mask pause menu progress process-tree))
;; the *entity-pool* contains all processes spawned from entities.
(change-parent (define *entity-pool* (new 'global 'process-tree 'entity-pool)) *active-pool*)
(set! (-> *entity-pool* mask) (process-mask pause menu progress entity process-tree))
;; the *default-pool* is used for processes that don't fall into the others.
(change-parent (define *default-pool* (new 'global 'process-tree 'default-pool)) *active-pool*)
(set! (-> *default-pool* mask) (process-mask pause menu progress process-tree))
goal_src/kernel/gstate.gc
+26 -12
View File
@@ -31,7 +31,7 @@ There are several ways to "go"
Use the go-process macro to do this.
- go from a non-main thread in the right process. You can do a go from a temporary thread, like trans or post.
If you do it from post, the go returns. If you do it from any other thread, the temporary thread
If you do it from post, the go returns and the rest of the post runs. If you do it from any other thread, the temporary thread
is immediately abandonded. Like the previous two, it will defer the actual go until the next time the
process runs.
@@ -50,20 +50,22 @@ It type checks the arguments for the entry function.
|#
;; cause the current process to change state
(defmacro go (next-state &rest args)
"Change the state of the current process.
This will only return if this is called within the post thread.
Otherwise, execution stops here and the kernel will run the next state next time."
`(with-pp
(go-hook pp ,next-state ,@args)
)
)
(defmacro go-virtual (state-name &key (proc self) &rest args)
"Change the current process to the virtual state of the given process."
"Same as go, but use a virtual state."
`(go (method-of-object ,proc ,state-name) ,@args)
)
;; cause the given process to change state.
(defmacro go-process (proc next-state &rest args)
"Make another process go."
`(with-pp
(protect (pp)
(set! pp ,proc)
@@ -79,6 +81,7 @@ It type checks the arguments for the entry function.
;; - you go
;; - you throw to 'initialize
(defmacro run-now-in-process (proc func &rest args)
"Run a function in another process right now."
`((the (function _varargs_ object) run-function-in-process)
,proc ,func ,@args
)
@@ -87,6 +90,7 @@ It type checks the arguments for the entry function.
;; sets the main thread of the given process to run the given thing.
;; this resets the main thread stack back to the top
(defmacro run-next-time-in-process (proc func &rest args)
"Set up a process to run a function the next time it is scheduled."
`((the (function _varargs_ object) set-to-run)
(-> ,proc main-thread) ,func ,@args
)
@@ -307,7 +311,6 @@ It type checks the arguments for the entry function.
(define-extern enter-state (function object object object object object object object))
(defun enter-state (arg0 arg1 arg2 arg3 arg4 arg5)
"Make the process stored in pp enter the state in pp next-state"
;;(declare (print-asm))
(with-pp
;; unsleep us
(process-mask-clear! (-> pp mask) sleep sleep-code)
@@ -318,6 +321,7 @@ It type checks the arguments for the entry function.
;; did a go during initialize.
;; remove the old trans hook, if there was one
(set! (-> pp trans-hook) #f)
;; set us up to run enter-state again, the next time we're scheduled.
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
;; tell the kernel that we did a go during init
(set! (-> pp status) 'initialize-go)
@@ -339,10 +343,14 @@ It type checks the arguments for the entry function.
)
((= (-> pp main-thread) (-> pp top-thread))
;; we are in the right process, and in the main thread!
;; actually do a go!
;; we will do a nonlocal control transfer to the new state's code.
;; the new state can then suspend and get back to the kernel dispatcher lambda
;; like normal.
;; change state!
(set! (-> pp state) (-> pp next-state))
;; loop through current stack frames
;; do exits
(let ((frame (-> pp stack-frame-top)))
(while frame
(case (-> frame type)
@@ -354,7 +362,7 @@ It type checks the arguments for the entry function.
)
)
;; done with going!
;; done with going, clear the mask
(process-mask-clear! (-> pp mask) going)
;; now, update the process:
@@ -369,19 +377,25 @@ It type checks the arguments for the entry function.
)
(set! (-> pp post-hook) (-> new-state post))
(set! (-> pp trans-hook) (-> new-state trans))
;; now do the enter
;; start up the new state. First run the enter function
(let ((enter-func (-> new-state enter)))
(if enter-func
((the (function _varargs_ none) enter-func) arg0 arg1 arg2 arg3 arg4 arg5)
)
)
;; now do the trans
;; run the trans function before the code.
(let ((trans-func (-> new-state trans)))
(if trans-func
(trans-func)
)
)
;; now we run the code, but in a tricky way.
;; we need to:
;; - make sure that when this code returns, we do a deactivate
;; - reset the stack to the top, so we can't just call the code.
(rlet ((temp)
(func)
(sp :reg rsp :type uint)
@@ -405,7 +419,7 @@ It type checks the arguments for the entry function.
(.mov sp (-> pp main-thread stack-top))
(.add sp off)
;; push the return trampoline for when code returns.
(.mov temp return-from-thread-dead)
(.mov temp return-from-thread-dead) ;; will deactivate
(.add temp off)
(.push temp)
;; and call!
@@ -432,7 +446,7 @@ It type checks the arguments for the entry function.
;; temporary, but if this turns out to be false, we will need to change this.
(rlet ((temp)
(off :reg r15 :type uint :reset-here #t))
(.mov temp return-from-thread)
(.mov temp return-from-thread) ;; could probably just call this...
(.add temp off)
(.push temp)
(.ret)
goal_src/kernel/gstring.gc
+13 -3
View File
@@ -700,13 +700,23 @@
)
)
;; what is this?
;;;;;;;;;;;;;;;;;;;;;
;; Globals
;;;;;;;;;;;;;;;;;;;;;
;; The *stdcon* buffer holds text to be printed to the screen for debugging.
;; Under the hood, there are actually two buffers: *stdcon1* and *stdcon0*
;; The *stdcon0* buffer is the default and is cleared on each frame.
;; The *stdcon1* buffer is cleared only if the game is unpaused. This keeps text
;; on screen for game objects, even when the game is paused and their logic does not run.
;; The kernel takes care of setting *stdcon* to one of these two buffers as needed.
(define *debug-draw-pauseable* #f)
;; console buffers. sometimes console 0 is backed up and the game switches to console 1.
(define *stdcon0* (new 'global 'string 16384 (the string #f)))
(define *stdcon1* (new 'global 'string 16384 (the string #f)))
;; the current onscreen console
(define *stdcon* *stdcon0*)
;; shared temporary string.
test/decompiler/reference/kernel/gkernel_REF.gc
Generated Vendored
+1 -1
View File
@@ -36,7 +36,7 @@
;; definition for function load-package
(defun load-package ((arg0 string) (arg1 kheap))
(when (not (nmember arg0 *kernel-packages*))
(dgo-load arg0 arg1 15 #x200000)
(dgo-load arg0 arg1 (link-flag output-load-msg output-load-true-msg execute-login print-login) #x200000)
(let ((v0-1 (cons arg0 *kernel-packages*)))
(set! *kernel-packages* v0-1)
v0-1
test/decompiler/test_gkernel_decomp.cpp
+2 -1
View File
@@ -62,7 +62,8 @@ TEST_F(FormRegressionTest, ExprLoadPackage) {
std::string expected =
"(when\n"
" (not (nmember arg0 *kernel-packages*))\n"
" (dgo-load arg0 arg1 15 #x200000)\n"
" (dgo-load arg0 arg1 (link-flag output-load-msg output-load-true-msg execute-login "
"print-login) #x200000)\n"
" (let\n"
" ((v0-1 (cons arg0 *kernel-packages*)))\n"
" (set! *kernel-packages* v0-1)\n"
test/goalc/source_templates/with_game/test-load-game.gc
+2 -2
View File
@@ -1,3 +1,3 @@
(set! *use-old-listener-print* #t)
(dgo-load "kernel" global #xf #x200000) ; todo, remove once kernel loads itself.
(dgo-load "engine" global #xf #x200000)
(dgo-load "kernel" global (link-flag output-load-msg output-load-true-msg execute-login print-login) #x200000) ; todo, remove once kernel loads itself.
(dgo-load "engine" global (link-flag output-load-msg output-load-true-msg execute-login print-login) #x200000)
test/goalc/test_with_game.cpp
+6 -2
View File
@@ -84,7 +84,9 @@ class WithMinimalGameTests : public ::testing::Test {
shared_compiler->runtime_thread = std::thread((GoalTest::runtime_with_kernel));
shared_compiler->runner.c = &shared_compiler->compiler;
shared_compiler->compiler.run_test_from_string("(dgo-load \"kernel\" global #xf #x200000)");
shared_compiler->compiler.run_test_from_string(
"(dgo-load \"kernel\" global (link-flag output-load-msg output-load-true-msg execute-login "
"print-login) #x200000)");
const auto minimal_files = {"goal_src/engine/math/vector-h.gc"};
for (auto& file : minimal_files) {
@@ -372,7 +374,9 @@ TEST_F(WithGameTests, GameCount) {
"(asm-data-file game-count \"test/test_data/test_game_counts.txt\")");
shared_compiler->compiler.run_test_from_string(
"(build-dgos \"test/test_data/test_game_count_dgos.txt\")");
shared_compiler->compiler.run_test_from_string("(dgo-load \"engine\" global #xf #x200000)");
shared_compiler->compiler.run_test_from_string(
"(dgo-load \"engine\" global (link-flag output-load-msg output-load-true-msg execute-login "
"print-login) #x200000)");
shared_compiler->runner.run_static_test(env, testCategory, "test-game-count.gc",
get_test_pass_string("game-count", 4));
// don't leave behind a weird version of the game-count file.