mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-09-10 20:29:51 -04:00
Code Issues Packages Projects Releases Wiki Activity

the kernel does things other than crash

Browse Source
This commit is contained in:
water
2022-07-09 13:13:01 -04:00
parent 5e23057ed1
commit 02b30ce5da
21 changed files with 4907 additions and 223 deletions
Download Patch File Download Diff File Expand all files Collapse all files
decompiler/IR2/FormExpressionAnalysis.cpp
+12
View File
@@ -97,6 +97,18 @@ Form* try_cast_simplify(Form* in,
return in;
}
if (env.version == GameVersion::Jak2) {
if (new_type == TypeSpec("float")) {
auto ic = get_goal_integer_constant(in, env);
if (ic) {
ASSERT(*ic <= UINT32_MAX);
float f;
memcpy(&f, &ic.value(), sizeof(float));
return pool.form<ConstantFloatElement>(f);
}
}
}
if (new_type == TypeSpec("meters")) {
auto fc = get_goal_float_constant(in);
decompiler/config/jak2/all-types.gc
+264 -195
View File
@@ -14,6 +14,7 @@
(define-extern integer type)
(define-extern float type)
(define-extern boolean type) ;; not actually added as a runtime type in jak2, but valid? supports it.
(define-extern uint32 type)
(define-extern int64 type)
(define-extern uint64 type)
(define-extern process-tree type)
@@ -162,7 +163,7 @@
(define-extern *trace-list* pair)
(define-extern print-tree-bitmask (function int int symbol))
(define-extern breakpoint-range-set! (function uint uint uint int))
(define-extern valid? (function object type basic basic object symbol))
(define-extern valid? (function object type symbol symbol object symbol))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gstring-h ;;
@@ -231,7 +232,7 @@
(self process-tree :offset-assert 32)
)
(:methods
(new (symbol type basic) _type_ 0)
(new (symbol type string) _type_ 0)
(activate (_type_ process-tree basic pointer) process-tree 9)
(deactivate (_type_) none 10)
(init-from-entity! (_type_ entity-actor) none 11) ;; todo check
@@ -254,7 +255,7 @@
(relocating-min int32 :offset-assert 32)
(relocating-max int32 :offset-assert 36)
(relocating-offset int32 :offset-assert 40)
(relocating-level object :offset-assert 44) ;; guessing here
(relocating-level level :offset-assert 44) ;; guessing here
(low-memory-message symbol :offset-assert 48) ;; guessed by decompiler
(login-object basic :offset-assert 52)
)
@@ -271,37 +272,37 @@
(deftype clock (basic)
((index int32 :offset-assert 4)
(mask uint32 :offset-assert 8)
(clock-ratio float :offset-assert 12)
(accum float :offset-assert 16)
(integral-accum float :offset-assert 20)
(frame-counter uint64 :offset-assert 24)
(old-frame-counter uint64 :offset-assert 32)
(integral-frame-counter uint64 :offset-assert 40)
(old-integral-frame-counter uint64 :offset-assert 48)
(sparticle-data vector :inline :offset-assert 64)
(seconds-per-frame float :offset-assert 80)
(frames-per-second float :offset-assert 84)
(time-adjust-ratio float :offset-assert 88)
((index int32 :offset-assert 4) ;; which clock we are, in *display*
(mask process-mask :offset-assert 8) ;; mask for ticking
(clock-ratio float :offset-assert 12) ;; how fast to run. 1.0 = realtime.
(accum float :offset-assert 16) ;; fractional time for frame-counter (time-frame units)
(integral-accum float :offset-assert 20) ;; fractional time for integral (time-frame untis)
(frame-counter time-frame :offset-assert 24) ;; how much time has gone by since reset (time-frame units)
(old-frame-counter time-frame :offset-assert 32) ;; the frame-counter on the last engine iteration
(integral-frame-counter uint64 :offset-assert 40) ;; how many vsyncs have gone by since reset
(old-integral-frame-counter uint64 :offset-assert 48) ;; the integral-frame-counter on the last engine iteration
(sparticle-data vector :inline :offset-assert 64) ;; sparticle timescale info
(seconds-per-frame float :offset-assert 80) ;; how many seconds (not time-frames) should go by in 1 vsync
(frames-per-second float :offset-assert 84) ;; inverse of above
(time-adjust-ratio float :offset-assert 88) ;; 1, if the game runs at 60fps NTSC with clock-ratio = 1.
)
:method-count-assert 15
:size-assert #x5c
:flag-assert #xf0000005c
(:methods
(new (symbol type int) _type_ 0)
(dummy-9 (_type_ float) none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(update-rates! (_type_ float) none 9)
(advance-by! (_type_ float) none 10)
(tick! (_type_) none 11)
(save! (_type_ (pointer uint64)) int 12)
(load! (_type_ (pointer uint64)) int 13)
(reset! (_type_) none 14)
)
)
(deftype thread (basic)
((name basic :offset-assert 4)
((name symbol :offset-assert 4)
(process process :offset-assert 8) ;; guessed by decompiler
(previous thread :offset-assert 12) ;; guessed by decompiler
(suspend-hook (function cpu-thread none) :offset-assert 16) ;; guessed by decompiler
@@ -349,7 +350,7 @@
:flag-assert #x1000000024
;; Failed to read fields.
(:methods
(new (symbol type int int basic) _type_ 0)
(new (symbol type int int string) _type_ 0)
(dummy-13 () none 13)
(get-process (_type_ type int) process 14)
(return-process (_type_ process) none 15)
@@ -388,7 +389,7 @@
:flag-assert #x1c00000068
;; Failed to read fields.
(:methods
(new (symbol type basic int int) _type_ 0)
(new (symbol type string int int) _type_ 0)
(init (_type_ symbol int) none 16)
(compact (dead-pool-heap int) none 17)
(shrink-heap (dead-pool-heap process) dead-pool-heap 18)
@@ -404,8 +405,6 @@
)
)
(deftype stack-frame (basic)
((name symbol :offset 4)
(next stack-frame :offset 8) ;; which way does this point?
@@ -500,7 +499,7 @@
(deftype process (process-tree)
((pool dead-pool)
(status basic :offset-assert 40)
(status symbol :offset-assert 40)
(pid int32)
(main-thread cpu-thread :offset-assert 48)
(top-thread cpu-thread :offset-assert 52)
@@ -518,28 +517,10 @@
(heap-cur pointer :offset-assert 104)
(stack-frame-top stack-frame :offset-assert 108)
(connection-list connectable :inline :offset-assert 112)
; (pool dead-pool :offset-assert 36)
; (status basic :offset-assert 40)
; (pid int32 :offset-assert 44)
; (main-thread cpu-thread :offset-assert 48)
; (top-thread thread :offset-assert 52)
; (entity entity-actor :offset-assert 56)
; (state state :offset-assert 60)
; (trans-hook function :offset-assert 64)
; (post-hook function :offset-assert 68)
; (event-hook (function process int symbol event-message-block object) :offset-assert 72)
; (allocated-length int32 :offset-assert 76)
; (next-state state :offset-assert 80)
; (heap-base pointer :offset-assert 84)
; (heap-top pointer :offset-assert 88)
; (heap-cur pointer :offset-assert 92)
; (stack-frame-top stack-frame :offset-assert 96)
; (connection-list connectable :inline :offset-assert 112) ;; can be a connection
(stack uint8 :dynamic :offset-assert 128)
)
(:methods
(new (symbol type basic int) _type_ 0)
(new (symbol type string int) _type_ 0)
)
(:states
dead-state
@@ -592,7 +573,7 @@
(define-extern *global-search-name* basic)
(define-extern *global-search-count* int)
(define-extern process-by-name (function string process-tree process))
(define-extern process-not-name (function object process-tree process))
(define-extern process-not-name (function string process-tree process))
(define-extern process-count (function process-tree int))
(define-extern kill-by-name (function string process-tree symbol))
(define-extern kill-by-type (function type process-tree symbol))
@@ -617,7 +598,7 @@
(define-extern entity-deactivate-handler (function process entity-actor none))
(define-extern *listener-process* process)
(define-extern *null-process* process)
(define-extern *vis-boot* basic)
(define-extern *vis-boot* symbol)
(define-extern *kernel-clock* clock)
(define-extern *16k-dead-pool* dead-pool)
(define-extern *8k-dead-pool* dead-pool)
@@ -780,6 +761,16 @@
;; math ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftype rgba (uint32)
((r uint8 :offset 0)
(g uint8 :offset 8)
(b uint8 :offset 16)
(a uint8 :offset 24)
)
:flag-assert #x900000004
:no-runtime-type
)
#|
(deftype random-generator (basic)
((seed uint32 :offset-assert 4)
@@ -2275,42 +2266,66 @@
;; timer-h ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#|
(defenum timer-clock-selection
:type uint8
(busclk 0)
(busclk/16 1)
(busclk/256 2)
(hblank 3)
)
(deftype timer-mode (uint32)
((clks timer-clock-selection :offset 0 :size 2)
(gate uint8 :offset 2 :size 1) ;; gate function enable
(gats uint8 :offset 3 :size 1) ;; gate selection: 0 = hblank, 1 = vblank
;; gate mode:
;; 0: count while gate signal is low
;; 1: start when gate signal rises
;; 2: start when gate signal falls
;; 3: start when gate signal rises/falls
(gatm uint8 :offset 4 :size 2)
(zret uint8 :offset 6 :size 1) ;; zero return: clear counter when equal to reference value
(cue uint8 :offset 7 :size 1) ;; count-up enable
(cmpe uint8 :offset 8 :size 1) ;; compare-interrupt enable
(ovfe uint8 :offset 9 :size 1) ;; overflow-interrupt enable
(equf uint8 :offset 10 :size 1) ;; equal-flag
(ovff uint8 :offset 11 :size 1) ;; overflow-flag
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype timer-bank (structure)
((count uint32 :offset-assert 0)
(mode timer-mode :offset-assert 16) ;; guessed by decompiler
(comp uint32 :offset-assert 32)
(mode timer-mode :offset 16)
(comp uint32 :offset 32)
)
:method-count-assert 9
:size-assert #x24
:flag-assert #x900000024
)
|#
#|
(deftype timer-hold-bank (timer-bank)
((hold uint32 :offset-assert 48)
((hold uint32 :offset 48)
)
:method-count-assert 9
:size-assert #x34
:flag-assert #x900000034
)
|#
#|
(deftype stopwatch (basic)
((prev-time-elapsed uint64 :offset-assert 8) ;; time-frame
(start-time uint64 :offset-assert 16) ;; time-frame
(begin-level int32 :offset-assert 24)
((prev-time-elapsed time-frame :offset-assert 8)
(start-time time-frame :offset-assert 16)
(begin-level int32 :offset-assert 24)
)
:method-count-assert 9
:size-assert #x1c
:flag-assert #x90000001c
)
|#
;; (define-extern *ticks-per-frame* object) ;; int
;; (define-extern timer-init object) ;; (function timer-bank timer-mode int)
(define-extern *ticks-per-frame* int)
(define-extern timer-init (function timer-bank timer-mode int))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; vif-h ;;
@@ -2447,41 +2462,107 @@
)
|#
#|
(defenum dma-tag-id
:bitfield #f
:type uint8
(refe 0) ;; addr=ADDR, ends after this transfer
(cnt 1) ;; addr=after tag, next-tag=after data
(next 2) ;; addr=after tag, next-tag=ADDR
(ref 3) ;; addr=ADDR, next-tag=after tag
(refs 4) ;; ref, but stall controled
(call 5) ;;
(ret 6) ;;
(end 7) ;; next, but ends.
)
(deftype dma-tag (uint64)
()
((qwc uint16 :offset 0) ;; quadword count
(pce uint8 :offset 26 :size 2) ;; priority (source mode)
(id dma-tag-id :offset 28 :size 3) ;; ID (what the tag means)
(irq uint8 :offset 31 :size 1) ;; interrupt at the end?
(addr uint32 :offset 32 :size 31) ;; address (31 bits)
(spr uint8 :offset 63 :size 1) ;; spr or not flag.
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
;; Failed to read some fields.
)
|#
#|
(deftype dma-bucket (structure)
((tag uint64 :offset-assert 0) ;; dma-tag
(last (pointer dma-tag) :offset-assert 8) ;; guessed by decompiler
((tag dma-tag :offset-assert 0)
(last (pointer dma-tag) :offset-assert 8)
(dummy uint32 :offset-assert 12)
(next uint32 :offset-assert 4)
(clear uint64 :offset-assert 8)
(vif0 uint32 :offset-assert 8)
(vif1 uint32 :offset-assert 12)
(next uint32 :offset 4)
(clear uint64 :offset 8)
(vif0 uint32 :offset 8)
(vif1 uint32 :offset 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
|#
#|
;; all these have mask (only applies to unpacks) and interrupt not set.
(defenum vif-cmd
:bitfield #f
:type uint8
(nop 0) ;; no-op, can still have irq set.
(stcycl 1) ;; set write recycle register
(offset 2) ;; set offset register
(base 3) ;; set base register
(itop 4) ;; set data pointer register (itops)
(stmod 5) ;; set mode register
(mskpath3 6) ;; set path 3 mask
(mark 7) ;; set mark register
(pc-port 8) ;; special tag for PC Port data.
(flushe 16) ;; wait for end of microprogram
(flush 17) ;; wait for end of microprogram and transfer (path1/path2)
(flusha 19) ;; wait for end of microprogram and transfer (path1/path2/path3)
(mscal 20) ;; activate microprogram (call)
(mscalf 21) ;; flushe and activate (call)
(mscnt 23) ;; activate microprogram (continue)
(stmask 32) ;; set MASK register.
(strow 48) ;; set filling data
(stcol 49) ;; set filling data
(mpg 74) ;; transfer microprogram
(direct 80) ;; straight to GIF.
(directhl 81)
(unpack-s-32 96)
(unpack-s-16 97)
(unpack-s-8 98)
;; 99 is invalid
(unpack-v2-32 100)
(unpack-v2-16 101)
(unpack-v2-8 102)
;; 103 is invalid
(unpack-v3-32 104)
(unpack-v3-16 105)
(unpack-v3-8 106)
;; 107 is invalid
(unpack-v4-32 108)
(unpack-v4-16 109)
(unpack-v4-8 110)
(unpack-v4-5 111)
(cmd-mask 239) ;; not sure what this is
)
(defenum vif-cmd-32
:bitfield #f
:type uint32
:copy-entries vif-cmd
)
(deftype vif-tag (uint32)
()
((imm uint16 :offset 0 :size 16)
(num uint8 :offset 16 :size 8)
(cmd vif-cmd :offset 24 :size 7)
(irq uint8 :offset 31 :size 1)
(msk uint8 :offset 28 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
;; Failed to read some fields.
)
|#
;; (define-extern dma-sync-fast object) ;; (function dma-bank none)
;; (define-extern dma-send-no-scratch object) ;; (function dma-bank uint32 uint32 none)
@@ -2555,7 +2636,6 @@
;; profile-h ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#|
(deftype profile-segment (structure)
((name basic :offset-assert 0)
(start-time int16 :offset-assert 4)
@@ -2564,50 +2644,49 @@
(vu-count uint8 :offset-assert 9)
(depth uint16 :offset-assert 10)
(color uint32 :offset-assert 12)
(code-time uint16 :offset-assert 4)
(vu-time uint16 :offset-assert 6)
(code-time uint16 :offset 4)
(vu-time uint16 :offset 6)
)
:allow-misaligned
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
|#
#|
(deftype profile-collapse (structure)
((count int32 :offset-assert 0)
(data UNKNOWN 48 :offset-assert 4)
(data profile-segment 48 :inline :offset-assert 4)
)
:method-count-assert 9
:size-assert #x304
:flag-assert #x900000304
)
|#
#|
(deftype profile-segment-array (basic)
((count int16 :offset-assert 4)
(depth int8 :offset-assert 6)
(max-depth int8 :offset-assert 7)
(base-time int16 :offset-assert 8)
(segment UNKNOWN 9 :offset-assert 12)
(data UNKNOWN 512 :offset-assert 48)
(segment basic 9 :offset-assert 12) ;; todo
(data profile-segment 512 :inline :offset-assert 48)
)
:method-count-assert 13
:size-assert #x2030
:flag-assert #xd00002030
(:methods
(dummy-9 () none 9)
(get-total-time (_type_) int 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
)
)
|#
#|
(deftype profile-array (structure)
((data UNKNOWN 2 :offset-assert 0)
((data profile-segment-array 2 :offset-assert 0) ;; guess
)
:method-count-assert 12
:size-assert #x8
@@ -2618,45 +2697,45 @@
(dummy-11 () none 11)
)
)
|#
;; (define-extern *profile-gap-color* object)
;; (define-extern *profile-all-color* object)
;; (define-extern *profile-particles-color* object)
;; (define-extern *profile-target-color* object)
;; (define-extern *profile-target-post-color* object)
;; (define-extern *profile-joints-color* object)
;; (define-extern *profile-debug-color* object)
;; (define-extern *profile-draw-hook-color* object)
;; (define-extern *profile-sky-color* object)
;; (define-extern *profile-ocean-color* object)
;; (define-extern *profile-background-color* object)
;; (define-extern *profile-bsp-color* object)
;; (define-extern *profile-foreground-color* object)
;; (define-extern *profile-tfrag-color* object)
;; (define-extern *profile-instance-tie-color* object)
;; (define-extern *profile-instance-shrubbery-color* object)
;; (define-extern *profile-generic-tie-color* object)
;; (define-extern *profile-bones-color* object)
;; (define-extern *profile-generic-merc-color* object)
;; (define-extern *profile-shadow-color* object)
;; (define-extern *profile-update-actors-color* object)
;; (define-extern *profile-menu-hook-color* object)
;; (define-extern *profile-texture-color* object)
;; (define-extern *profile-effects-color* object)
;; (define-extern *profile-sprite-color* object)
;; (define-extern *profile-merc-color* object)
;; (define-extern *profile-actors-color* object)
;; (define-extern *profile-collide-color* object)
;; (define-extern *profile-nav-color* object)
;; (define-extern *profile-camera-color* object)
;; (define-extern *profile-blit-color* object)
;; (define-extern *profile-hud-color* object)
;; (define-extern *profile-emerc-color* object)
;; (define-extern *profile-array* object)
;; (define-extern *profile-collapse* object)
;; (define-extern *profile-interrupt-segment* object)
;; (define-extern *profile-interrupt-start* object)
(define-extern *profile-gap-color* rgba)
(define-extern *profile-all-color* rgba)
(define-extern *profile-particles-color* rgba)
(define-extern *profile-target-color* rgba)
(define-extern *profile-target-post-color* rgba)
(define-extern *profile-joints-color* rgba)
(define-extern *profile-debug-color* rgba)
(define-extern *profile-draw-hook-color* rgba)
(define-extern *profile-sky-color* rgba)
(define-extern *profile-ocean-color* rgba)
(define-extern *profile-background-color* rgba)
(define-extern *profile-bsp-color* rgba)
(define-extern *profile-foreground-color* rgba)
(define-extern *profile-tfrag-color* rgba)
(define-extern *profile-instance-tie-color* rgba)
(define-extern *profile-instance-shrubbery-color* rgba)
(define-extern *profile-generic-tie-color* rgba)
(define-extern *profile-bones-color* rgba)
(define-extern *profile-generic-merc-color* rgba)
(define-extern *profile-shadow-color* rgba)
(define-extern *profile-update-actors-color* rgba)
(define-extern *profile-menu-hook-color* rgba)
(define-extern *profile-texture-color* rgba)
(define-extern *profile-effects-color* rgba)
(define-extern *profile-sprite-color* rgba)
(define-extern *profile-merc-color* rgba)
(define-extern *profile-actors-color* rgba)
(define-extern *profile-collide-color* rgba)
(define-extern *profile-nav-color* rgba)
(define-extern *profile-camera-color* rgba)
(define-extern *profile-blit-color* rgba)
(define-extern *profile-hud-color* rgba)
(define-extern *profile-emerc-color* rgba)
(define-extern *profile-array* profile-array)
(define-extern *profile-collapse* profile-collapse)
(define-extern *profile-interrupt-segment* profile-segment-array)
(define-extern *profile-interrupt-start* symbol)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; dma ;;
@@ -2686,18 +2765,17 @@
;; dma-buffer ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#|
(deftype dma-packet (structure)
((dma uint64 :offset-assert 0) ;; dma-tag
(vif0 vif-tag :offset-assert 8) ;; guessed by decompiler
(vif1 vif-tag :offset-assert 12) ;; guessed by decompiler
(quad uint128 :offset-assert 0)
((dma dma-tag :offset-assert 0)
(vif0 vif-tag :offset-assert 8)
(vif1 vif-tag :offset-assert 12)
(quad uint128 :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
|#
#|
(deftype dma-packet-array (inline-array-class)
@@ -2709,41 +2787,37 @@
)
|#
#|
(deftype dma-gif (structure)
((gif UNKNOWN 2 :offset-assert 0)
(quad uint128 :offset-assert 0)
((gif uint64 2 :offset-assert 0)
(quad uint128 :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
|#
#|
(deftype dma-gif-packet (structure)
((dma-vif dma-packet :inline :offset-assert 0)
(gif uint64 2 :offset-assert 16) ;; guessed by decompiler
(quad uint128 2 :offset-assert 0) ;; guessed by decompiler
(gif uint64 2 :offset-assert 16)
(quad uint128 2 :offset 0)
)
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
|#
#|
(deftype dma-buffer (basic)
((allocated-length int32 :offset-assert 4)
(base pointer :offset-assert 8) ;; guessed by decompiler
(end pointer :offset-assert 12) ;; guessed by decompiler
(data uint64 1 :offset-assert 16) ;; guessed by decompiler
(base pointer :offset-assert 8)
(end pointer :offset-assert 12)
(data uint64 1 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x18
:flag-assert #x900000018
)
|#
;; (define-extern dma-buffer-inplace-new object) ;; (function dma-buffer int dma-buffer)
;; (define-extern dma-buffer-length object) ;; (function dma-buffer int)
@@ -3140,14 +3214,13 @@
;; display-h ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#|
(deftype display-frame (basic)
((buffer dma-buffer 11 :offset-assert 4) ;; guessed by decompiler
(calc-buf dma-buffer :offset-assert 8) ;; guessed by decompiler
(vu1-buf dma-buffer :offset-assert 8) ;; guessed by decompiler
(debug-buf dma-buffer :offset-assert 36) ;; guessed by decompiler
(global-buf dma-buffer :offset-assert 40) ;; guessed by decompiler
(bucket-group dma-bucket :offset-assert 44) ;; (inline-array dma-bucket)
(calc-buf dma-buffer :offset 8)
(vu1-buf dma-buffer :offset 8)
(debug-buf dma-buffer :offset 36)
(global-buf dma-buffer :offset 40)
(bucket-group dma-bucket :offset 44) ;; (inline-array dma-bucket)
(profile-array profile-array :inline :offset-assert 48)
(start-time uint64 :offset-assert 56)
(run-time uint64 :offset-assert 64) ;; int64
@@ -3156,32 +3229,30 @@
:size-assert #x48
:flag-assert #x900000048
)
|#
#|
(deftype display (basic)
((on-screen int32 :offset-assert 4)
(last-screen int32 :offset-assert 8)
(frames virtual-frame 2 :offset-assert 12) ;; guessed by decompiler
(frames display-frame 2 :offset-assert 12)
(bgcolor uint64 :offset-assert 24)
(pmode uint64 :offset-assert 32)
(clock UNKNOWN 13 :offset-assert 40)
(session-clock basic :offset-assert 40)
(game-clock basic :offset-assert 44)
(base-clock basic :offset-assert 48)
(real-clock basic :offset-assert 52)
(frame-clock basic :offset-assert 56)
(real-frame-clock basic :offset-assert 60)
(target-clock basic :offset-assert 64)
(entity-clock basic :offset-assert 68)
(part-clock basic :offset-assert 72)
(bg-clock basic :offset-assert 76)
(camera-clock basic :offset-assert 80)
(user0-clock basic :offset-assert 84)
(total-game-clock basic :offset-assert 88)
(clock clock 13 :offset-assert 40)
(session-clock clock :offset 40)
(game-clock clock :offset 44)
(base-clock clock :offset 48)
(real-clock clock :offset 52)
(frame-clock clock :offset 56)
(real-frame-clock clock :offset 60)
(target-clock clock :offset 64)
(entity-clock clock :offset 68)
(part-clock clock :offset 72)
(bg-clock clock :offset 76)
(camera-clock clock :offset 80)
(user0-clock clock :offset 84)
(total-game-clock clock :offset 88)
(time-factor float :offset-assert 92)
(dog-ratio float :offset-assert 96)
(vblank-start-time UNKNOWN 2 :offset-assert 104)
(vblank-start-time uint64 2 :offset-assert 104)
(total-run-time uint64 :offset-assert 120)
(run-half-speed basic :offset-assert 128)
(dog-count float :offset-assert 132)
@@ -3197,7 +3268,6 @@
(dummy-9 () none 9) ;; (set-time-ratios (_type_ float) float 9)
)
)
|#
;; (define-extern *pre-draw-hook* object) ;; (function object none)
;; (define-extern *post-draw-hook* object) ;; (function dma-buffer none)
@@ -3264,17 +3334,17 @@
;; timer ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (define-extern timer-count object) ;; (function timer-bank uint)
;; (define-extern disable-irq object) ;; (function none)
;; (define-extern enable-irq object) ;; (function none)
;; (define-extern stopwatch-init object) ;; (function stopwatch int)
;; (define-extern stopwatch-reset object) ;; (function stopwatch int)
;; (define-extern stopwatch-start object) ;; (function stopwatch int)
;; (define-extern stopwatch-stop object) ;; (function stopwatch none)
;; (define-extern stopwatch-begin object) ;; (function stopwatch int)
;; (define-extern stopwatch-end object) ;; (function stopwatch none)
;; (define-extern stopwatch-elapsed-ticks object) ;; (function stopwatch time-frame)
;; (define-extern stopwatch-elapsed-seconds object) ;; (function stopwatch float)
(define-extern timer-count (function timer-bank uint))
(define-extern disable-irq (function none))
(define-extern enable-irq (function none))
(define-extern stopwatch-init (function stopwatch int))
(define-extern stopwatch-reset (function stopwatch int))
(define-extern stopwatch-start (function stopwatch int))
(define-extern stopwatch-stop (function stopwatch none))
(define-extern stopwatch-begin (function stopwatch int))
(define-extern stopwatch-end (function stopwatch none))
(define-extern stopwatch-elapsed-ticks (function stopwatch time-frame))
(define-extern stopwatch-elapsed-seconds (function stopwatch float))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; vector ;;
@@ -4823,7 +4893,7 @@
;; profile ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#|
(deftype profile-work (structure)
((sprite-tmpl dma-gif-packet :inline :offset-assert 0)
(line-tmpl dma-gif-packet :inline :offset-assert 32)
@@ -4833,14 +4903,13 @@
:size-assert #x44
:flag-assert #x900000044
)
|#
;; (define-extern *profile-work* object)
;; (define-extern *profile-x* object) ;; int
;; (define-extern *profile-y* object) ;; int
;; (define-extern *profile-w* object) ;; int
;; (define-extern *profile-h* object) ;; int
;; (define-extern *profile-ticks* object) ;; symbol
(define-extern *profile-work* profile-work)
(define-extern *profile-x* int)
(define-extern *profile-y* int)
(define-extern *profile-w* int)
(define-extern *profile-h* int)
(define-extern *profile-ticks* symbol)
;; (define-extern profile-texture-test object)
;; (define-extern profile-tfrag-test object)
;; (define-extern profile-tie-test object)
@@ -4868,7 +4937,7 @@
;; (define-extern set-display-gs-state-offset object) ;; (function dma-buffer int int int int int int int dma-buffer)
;; (define-extern reset-display-gs-state object) ;; (function display dma-buffer int display)
;; (define-extern *vu0-dma-list* object) ;; dma-buffer
;; (define-extern *display* object) ;; display
(define-extern *display* display)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; connect ;;
decompiler/config/jak2/label_types.jsonc
+5 -1
View File
@@ -1 +1,5 @@
{}
{
"profile": [
["L14", "profile-work"]
]
}
goal_src/jak2/dgos/kernel.gd
+10
View File
@@ -0,0 +1,10 @@
("KERNEL.CGO"
("gcommon.o" "gcommon")
("gstring-h.o" "gstring-h")
("gkernel-h.o" "gkernel-h")
("gkernel.o" "gkernel")
("pskernel.o" "pskernel")
("gstring.o" "gstring")
("dgo-h.o" "dgo-h")
("gstate.o" "gstate")
)
goal_src/jak2/engine/ps2/timer-h.gc
+86
View File
@@ -5,3 +5,89 @@
;; name in dgo: timer-h
;; dgos: ENGINE, GAME
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PC Port Timer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro get-cpu-clock ()
"Read the 300 MHz clock."
;; __read-ee-timer is a 300 MHz timer from the C Kernel.
;; it's a real timer.
`(the uint (logand #xffffffff (__read-ee-timer)))
)
(defmacro get-bus-clock/256 ()
"Read the 150 MHz / 256 clock."
;; 300 MHz / (2^9)
`(the uint (logand #xffffffff (shr (__read-ee-timer) 9)))
)
(#when PC_PORT
;; the bus clock can be reset, which just stores the current count here.
(define *timer-reset-value* (the uint 0))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Timer HW
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftype timer-mode (uint32)
((clks timer-clock-selection :offset 0 :size 2)
(gate uint8 :offset 2 :size 1)
(gats uint8 :offset 3 :size 1)
(gatm uint8 :offset 4 :size 2)
(zret uint8 :offset 6 :size 1)
(cue uint8 :offset 7 :size 1)
(cmpe uint8 :offset 8 :size 1)
(ovfe uint8 :offset 9 :size 1)
(equf uint8 :offset 10 :size 1)
(ovff uint8 :offset 11 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype timer-bank (structure)
((count uint32 :offset-assert 0)
(mode timer-mode :offset 16)
(comp uint32 :offset 32)
)
:method-count-assert 9
:size-assert #x24
:flag-assert #x900000024
)
(deftype timer-hold-bank (timer-bank)
((hold uint32 :offset 48)
)
:method-count-assert 9
:size-assert #x34
:flag-assert #x900000034
)
(deftype stopwatch (basic)
((prev-time-elapsed time-frame :offset-assert 8)
(start-time time-frame :offset-assert 16)
(begin-level int32 :offset-assert 24)
)
:method-count-assert 9
:size-assert #x1c
:flag-assert #x90000001c
)
(define *ticks-per-frame* 9765)
(defun timer-init ((arg0 timer-bank) (arg1 timer-mode))
(set! (-> arg0 mode) arg1)
(set! (-> arg0 count) (the-as uint 0))
0
)
(#unless PC_PORT
(timer-init
(the-as timer-bank #x10000800)
(new 'static 'timer-mode :clks (timer-clock-selection busclk/256) :cue #x1)
)
)
goal_src/jak2/game.gp
+6 -1
View File
@@ -173,4 +173,9 @@
,@(reverse *all-mus*)
,@(reverse *all-vag*)
,@(reverse *all-cgos*))
)
)
;; used for the type consistency test.
(group-list "all-code"
`(,@(reverse *all-gc*))
)
goal_src/jak2/kernel-defs.gc
+25 -18
View File
@@ -5,6 +5,26 @@
;;;; kscheme - InitHeapAndSymbol
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defenum kmalloc-flags
:bitfield #t
(align-16 4)
(align-64 6)
(align-256 8)
(memset 12)
(top 13)
)
(defenum link-flag
:bitfield #t
:type int32
(output-load-msg 0)
(output-load-true-msg 1)
(execute-login 2)
(print-login 3)
(force-debug 4)
(fast-link 5)
)
;; fixed symbols
(define-extern #f symbol)
(define-extern #t symbol)
@@ -59,32 +79,19 @@
;; InitHeapAndSymbol
(define-extern _format (function _varargs_ object))
(define-extern method-set! (function type int object none)) ;; may actually return function.
(define-extern kmemopen (function kheap string none))
(define-extern kmemclose (function none))
(define-extern *enable-method-set* int)
(define-extern *listener-function* (function object))
(define-extern *debug-segment* symbol)
(define-extern dgo-load (function string kheap link-flag int none))
(define-extern malloc (function symbol int pointer))
(defenum kmalloc-flags
:bitfield #t
(align-16 4)
(align-64 6)
(align-256 8)
(memset 12)
(top 13)
)
(defenum link-flag
:bitfield #t
:type int32
(output-load-msg 0)
(output-load-true-msg 1)
(execute-login 2)
(print-login 3)
(force-debug 4)
(fast-link 5)
)
;; PC stuff
goal_src/jak2/kernel/dgo-h.gc
+20
View File
@@ -5,3 +5,23 @@
;; name in dgo: dgo-h
;; dgos: KERNEL
(deftype dgo-entry (structure)
((offset uint32 :offset-assert 0)
(length uint32 :offset-assert 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype dgo-file (basic)
((num-go-files uint32 :offset-assert 4)
(total-length uint32 :offset-assert 8)
(rsvd uint32 :offset-assert 12)
(data uint8 :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
goal_src/jak2/kernel/gcommon.gc
+232
View File
@@ -24,6 +24,23 @@
;; GOAL code to the frame profiler in C++.
(defglobalconstant PC_PROFILER_ENABLE #t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GOAL language constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; distance from a symbol pointer to a (pointer string)
;; this relies on the memory layout of the symbol table
;; this must match SYM_TO_STRING_OFFSET in goal_constants.h
(defconstant SYM_TO_STRING_OFFSET #xff37)
(defmacro symbol->string (sym)
"Convert a symbol to a goal string."
`(-> (the-as (pointer string) (+ SYM_TO_STRING_OFFSET (the-as int ,sym))))
)
;; pointers larger than this are invalid by valid?
(defconstant END_OF_MEMORY #x8000000)
(defun identity ((arg0 object))
arg0
)
@@ -170,6 +187,19 @@
obj
)
(deftype vector (structure)
((data float 4 :offset-assert 0)
(x float :offset 0)
(y float :offset 4)
(z float :offset 8)
(w float :offset 12)
(quad uint128 :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(defmacro print128 (value &key (stream #t))
"Print a 128-bit value"
`(let ((temp (new 'stack-no-clear 'array 'uint64 2)))
@@ -911,6 +941,208 @@
(break!)
)
(defmacro start-of-symbol-table ()
`(rlet ((st :reg r14 :reset-here #t :type uint))
(the uint (- st 32768))
)
)
(defmacro end-of-symbol-table ()
`(rlet ((st :reg r14 :reset-here #t :type uint))
(the uint (+ st 32768))
)
)
(define-extern boolean type) ;; not really... but they use it here as if it was one.
(define-extern valid? (function object type symbol symbol object symbol))
(defun valid? ((arg0 object) (arg1 type) (arg2 symbol) (arg3 symbol) (arg4 object))
(let ((v1-1
(and (>= (the-as uint arg0) (start-of-symbol-table)) (< (the-as uint arg0) END_OF_MEMORY))
)
)
(cond
((not arg1)
(cond
((logtest? (the-as int arg0) 3)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object (misaligned)~%" arg0 arg2)
)
#f
)
((not v1-1)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object (bad address)~%" arg0 arg2)
)
#f
)
(else
#t
)
)
)
((and arg3 (not arg0))
#t
)
((= arg1 structure)
(cond
((logtest? (the-as int arg0) 15)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
((or (not v1-1) (< (the-as uint arg0) (end-of-symbol-table)))
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1)
)
#f
)
(else
#t
)
)
)
((= arg1 pair)
(cond
((not (pair? arg0))
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
((not v1-1)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1)
)
#f
)
(else
#t
)
)
)
((= arg1 binteger)
(cond
((zero? (logand (the-as int arg0) 7))
#t
)
(else
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
)
)
((or (= arg1 symbol) (= arg1 boolean))
(cond
((zero? (logand (the-as int arg0) 1))
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
((or (not v1-1) (< (the-as int arg0) (start-of-symbol-table))(>= (the-as int arg0) (end-of-symbol-table)))
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1)
)
#f
)
(else
#t
)
)
)
((!= (logand (the-as int arg0) 7) 4)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%" arg0 arg2 arg1)
)
#f
)
((not v1-1)
(if arg2
(format arg4 "ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%" arg0 arg2 arg1)
)
#f
)
((and (= arg1 type) (!= (rtype-of arg0) type))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%"
arg0
arg2
arg1
(rtype-of arg0)
)
)
#f
)
((and (!= arg1 type) (not (valid? (rtype-of arg0) type #f #t 0)))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%"
arg0
arg2
arg1
(rtype-of arg0)
)
)
#f
)
((not (type? arg0 arg1))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (is type '~A' instead)~%"
arg0
arg2
arg1
(rtype-of arg0)
)
)
#f
)
((= arg1 symbol)
(cond
((>= (the-as uint arg0) (end-of-symbol-table))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (not in symbol table)~%"
arg0
arg2
arg1
)
)
#f
)
(else
#t
)
)
)
((< (the-as uint arg0) (end-of-symbol-table))
(if arg2
(format
arg4
"ERROR: object #x~X ~S is not a valid object of type '~A' (inside symbol table)~%"
arg0
arg2
arg1
)
)
#f
)
(else
#t
)
)
)
)
;;;;;;;;;;;;;;;;;;;;
;; Profiler Macros
;;;;;;;;;;;;;;;;;;;;
goal_src/jak2/kernel/gkernel-h.gc
+684 -1
View File
@@ -6,4 +6,687 @@
;; dgos: KERNEL
(defconstant *kernel-major-version* 2)
(defconstant *kernel-minor-version* 0)
(defconstant *kernel-minor-version* 0)
(defconstant DPROCESS_STACK_SIZE (#if PC_PORT #x8000 #x3800))
(defconstant PROCESS_STACK_SIZE (#if PC_PORT #x6000 #x1c00))
(defconstant *tab-size* (the binteger 8))
(defconstant *gtype-basic-offset* 4)
;; if set, will attempt to detect memory corruption and stack overflow bugs
;; to some extent.
(defglobalconstant KERNEL_DEBUG #t)
(defconstant *scratch-memory-top* (the pointer #x70004000))
;; Each process has a bitmask.
;; The kernel can be configured to skip processes with certain mask bits set.
(defenum process-mask
:type uint32
:bitfield #t
(execute 0)
(freeze 1)
(pause 2)
(menu 3)
(progress 4)
(actor-pause 5)
(sleep 6)
(sleep-code 7)
(process-tree 8)
(heap-shrunk 9)
(going 10)
(kernel-run 11)
(no-kill 12)
(movie 13)
(dark-effect 14)
(target 15)
(sidekick 16)
(crate 17)
(bit18 18) ;; unused?
(enemy 19)
(camera 20)
(platform 21)
(ambient 22)
(entity 23)
(projectile 24)
(bot 25)
(collectable 26)
(death 27)
(no-track 28)
(guard 29)
(vehicle 30)
(civilian 31)
)
;; forward declarations
(declare-type process-tree basic)
(declare-type process process-tree)
(declare-type entity basic)
(declare-type entity-actor entity)
(declare-type dead-pool basic)
(declare-type level basic)
(declare-type state basic)
(declare-type event-message-block structure)
(declare-type stack-frame basic)
(declare-type cpu-thread basic)
;; The state of the kernel, containing the masks to allow/deny certain processes,
;; the currently running process, and the currently relocating process.
(deftype kernel-context (basic)
((prevent-from-run process-mask :offset-assert 4)
(require-for-run process-mask :offset-assert 8)
(allow-to-run process-mask :offset-assert 12)
(next-pid int32 :offset-assert 16)
(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)
(relocating-level level :offset-assert 44)
(low-memory-message symbol :offset-assert 48)
(login-object basic :offset-assert 52)
)
:method-count-assert 9
:size-assert #x38
:flag-assert #x900000038
)
;; The usual "time" type.
(deftype time-frame (int64)
()
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
;; times are stored in 300ths of a second.
;; this divides evenly into frames at both 50 and 60 fps.
;; typically these are stored as integers as more precision is not useful.
;; an unsigned 32-bit integer can store about 150 days
(defglobalconstant TICKS_PER_SECOND 300) ;; 5 t/frame @ 60fps, 6 t/frame @ 50fps
;; this was usec in GOAL
(defmacro seconds (x)
"Convert number to seconds unit.
Returns uint."
(cond
((integer? x)
(* TICKS_PER_SECOND x)
)
((float? x)
(* 1 (* 1.0 x TICKS_PER_SECOND))
)
(#t
`(the uint (* TICKS_PER_SECOND ,x))
)
)
)
;; Each clock counts in 3 different ways:
;;
;; 1). A "frame counter", which, confusingly, doesn't count frames.
;; It counts elapsed time, in 1/300ths of a second.
;; This counts in real-time, even if the game is lagging.
;;
;; 2). A "integral-frame-counter", which counts the number of vsyncs.
;; This doens't count the number of frames the game actually manages to draw,
;; just the number of vsyncs. It counts at different rates in NTSC/PAL.
;; NOTE: changing clock-ratio will make this count faster/slower. This only counts real
;; vsyncs if clock-ratio is 1.0.
;;
;; 3). The "time ratio", which adjusts based on the actual achieved framerate.
;; Unlock the others, this isn't a incrementing counter, but instead ratios:
;; time-adjust-ratio, frames-per-second, seconds-per-frame.
;;
;;
;; The clock won't tick if its process-mask is prevent-from-run in the kernel.
;; A clock can change the rate it runs at with clock-ratio.
;; Note: both integral-frame-counter and seconds-per-frame/frames-per-second are affected by
;; clock-ratio, which is somewhat weird.
;; Changing clock-ratio will make integral-frame-counter not count actual vsyncs
(deftype clock (basic)
((index int32 :offset-assert 4) ;; which clock we are, in *display*
(mask process-mask :offset-assert 8) ;; mask for ticking
(clock-ratio float :offset-assert 12) ;; how fast to run. 1.0 = realtime.
(accum float :offset-assert 16) ;; fractional time for frame-counter (time-frame units)
(integral-accum float :offset-assert 20) ;; fractional time for integral (time-frame untis)
(frame-counter time-frame :offset-assert 24) ;; how much time has gone by since reset (time-frame units)
(old-frame-counter time-frame :offset-assert 32) ;; the frame-counter on the last engine iteration
(integral-frame-counter uint64 :offset-assert 40) ;; how many vsyncs have gone by since reset
(old-integral-frame-counter uint64 :offset-assert 48) ;; the integral-frame-counter on the last engine iteration
(sparticle-data vector :inline :offset-assert 64) ;; sparticle timescale info
(seconds-per-frame float :offset-assert 80) ;; how many seconds (not time-frames) should go by in 1 vsync
(frames-per-second float :offset-assert 84) ;; inverse of above
(time-adjust-ratio float :offset-assert 88) ;; 1, if the game runs at 60fps NTSC with clock-ratio = 1.
)
:method-count-assert 15
:size-assert #x5c
:flag-assert #xf0000005c
(:methods
(new (symbol type int) _type_ 0)
(update-rates! (_type_ float) none 9)
(advance-by! (_type_ float) none 10)
(tick! (_type_) none 11)
(save! (_type_ (pointer uint64)) int 12)
(load! (_type_ (pointer uint64)) int 13)
(reset! (_type_) none 14)
)
)
(defmethod new clock ((allocation symbol) (type-to-make type) (arg0 int))
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> gp-0 index) arg0)
(set! (-> gp-0 frame-counter) (seconds 1000))
(set! (-> gp-0 integral-frame-counter) (the-as uint 300000))
(set! (-> gp-0 old-frame-counter) (+ (-> gp-0 frame-counter) -1))
(set! (-> gp-0 old-integral-frame-counter) (+ (-> gp-0 integral-frame-counter) -1))
(update-rates! gp-0 1.0)
gp-0
)
)
;; The basic node used to organize processes into a tree.
;; The process types themselves are children of the process-tree type
;; Typically, each instance of a game object is a process.
(deftype process-tree (basic)
((name string :offset-assert 4)
(mask process-mask :offset-assert 8)
(clock clock :offset-assert 12)
(parent (pointer process-tree) :offset-assert 16)
(brother (pointer process-tree) :offset-assert 20)
(child (pointer process-tree) :offset-assert 24)
(ppointer (pointer process) :offset-assert 28)
(self process-tree :offset-assert 32)
)
(:methods
(new (symbol type string) _type_ 0)
(activate (_type_ process-tree basic pointer) process-tree 9)
(deactivate (_type_) none 10)
(init-from-entity! (_type_ entity-actor) none 11) ;; todo check
(run-logic? (_type_) symbol 12)
(dummy-13 () none 13)
)
:size-assert #x24
:method-count-assert 14
:no-runtime-type
)
;; Each process has a single "main" thread that is suspended and resumed.
;; The "thread" object is what holds the needed state to start, suspend, and resume execution.
;; Additionally, the kernel creates various temporary threads to run single functions.
;; These "temporary" threads are never suspended.
;; unlike modern implementations, the "thread" objects store small "backup" stacks (often only 100's of bytes).
;; when a thread is suspended, it copies the stack from the execution stack to the backup stack.
;; this seems silly, but it has an advantage to reduce memory - typically threads suspend without a very deep call
;; stack, so the backup stack can be much, much smaller than a single large, shared execution stack.
(deftype thread (basic)
((name symbol :offset-assert 4)
(process process :offset-assert 8)
(previous thread :offset-assert 12)
(suspend-hook (function cpu-thread none) :offset-assert 16) ;; called by user to suspend
(resume-hook (function cpu-thread none) :offset-assert 20) ;; called by kernel to resume
(pc pointer :offset-assert 24) ;; pc (x86 rip) to resume to
(sp pointer :offset-assert 28) ;; stack pointer of thread
(stack-top pointer :offset-assert 32) ;; stack to execute on
(stack-size int32 :offset-assert 36) ;; size of _suspend_ stack
)
:method-count-assert 12
:size-assert #x28
:flag-assert #xc00000028
(:methods
(stack-size-set! (_type_ int) none 9)
(thread-suspend (_type_) none 10)
(thread-resume (_type_) none 11)
)
)
;; additional information to context switch
(deftype cpu-thread (thread)
((rreg uint64 7 :offset-assert 40) ;; GPRs
(freg float 8 :offset-assert 96) ;; FPRs
(stack uint8 :dynamic :offset-assert 128) ;; backup stack (dynamically sized)
)
:method-count-assert 12
:size-assert #x80
:flag-assert #xc00000080
(:methods
(new (symbol type process symbol int pointer) _type_ 0)
)
)
;; Base type for all actual processes.
;; this can be used directly, or child types can be made.
(deftype process (process-tree)
((pool dead-pool ) ;; where to return us when we die
(status symbol :offset-assert 40) ;; used by kernel to track init/death
(pid int32 ) ;; globally unique ID, never reused for another
(main-thread cpu-thread :offset-assert 48) ;; suspendable main thread
(top-thread cpu-thread :offset-assert 52) ;; currently running thread
(entity entity :offset-assert 56) ;; if we were spawned from an entity, that entity
(level level :offset-assert 60) ;; if we're associated with a level, that level
(state state :offset-assert 64) ;; current state, if we're in one
(next-state state :offset-assert 68) ;; set if we have a pending (go)
(trans-hook function :offset-assert 72) ;; function to run before resuming
(post-hook function :offset-assert 76) ;; function to run after suspending
;; function to run if we receive an event
(event-hook (function process int symbol event-message-block object) :offset-assert 80)
;; process heap size
(allocated-length int32 :offset-assert 84)
;; ??
(pad0 uint32 2)
;; process heap
(heap-base pointer :offset-assert 96)
(heap-top pointer :offset-assert 100)
(heap-cur pointer :offset-assert 104)
;; linked list of stack frames that have been created.
;; note that these aren't created on every function call, only
;; if the user explicitly creates a catch block or similar
(stack-frame-top stack-frame :offset-assert 108)
;; list of engines this process is connected to
(connection-list connectable :inline :offset-assert 112)
;; the process memory: contains child fields, then the process heap.
(stack uint8 :dynamic :offset-assert 128)
)
(:methods
(new (symbol type string int) _type_ 0)
)
(:states
dead-state
empty-state)
:size-assert #x80
:method-count-assert 14
:no-runtime-type ;; already defined by kscheme. Don't do it again.
)
;; dead-pool simplest way to store dead processes - it's just a tree of processes that
;; are inactive.
(deftype dead-pool (process-tree)
()
:method-count-assert 16
:size-assert #x24
:flag-assert #x1000000024
(:methods
(new (symbol type int int string) _type_ 0)
(get-process (_type_ type int) process 14)
(return-process (_type_ process) none 15)
)
)
;; todo inspect
;; dead-pool-heap is a special thing - it pretends to be a dead-pool, but secretly
;; creates and destroys processes on demand, as they are requested/returned.
;; to do this, it has a single large heap and memory allocator.
;; to prevent fragmentation of this heap, it has a relocate/compaction system
;; that moves processes in memory.
;; A dead-pool-heap-rec is a record for a process used by the handle system.
;; The kernel will make sure that:
;; - the dead-pool-heap-rec for a process will continue to point to that process until the process
;; is killed.
;; - the dead-pool-heap-rec itself is never moved in memory, and it always points to some process, or #f.
;; (it is always safe to do (-> rec process pid) and see if it still points to your process)
(deftype dead-pool-heap-rec (structure)
((process process :offset-assert 0)
(prev dead-pool-heap-rec :offset-assert 4)
(next dead-pool-heap-rec :offset-assert 8)
)
:pack-me
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
;; the actual pool implementation
(deftype dead-pool-heap (dead-pool)
((allocated-length int32 :offset-assert 36)
(compact-time uint32 :offset-assert 40)
(compact-count-targ uint32 :offset-assert 44)
(compact-count uint32 :offset-assert 48)
(fill-percent float :offset-assert 52)
(first-gap dead-pool-heap-rec :offset-assert 56)
(first-shrink dead-pool-heap-rec :offset-assert 60)
(heap kheap :inline :offset-assert 64)
(alive-list dead-pool-heap-rec :inline :offset-assert 80)
(last dead-pool-heap-rec :offset 84)
(dead-list dead-pool-heap-rec :inline :offset-assert 92)
(process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104)
)
:method-count-assert 28
:size-assert #x68
:flag-assert #x1c00000068
(:methods
(new (symbol type string int int) _type_ 0)
(init (_type_ symbol int) none 16)
(compact (dead-pool-heap int) none 17)
(shrink-heap (dead-pool-heap process) dead-pool-heap 18)
(churn (dead-pool-heap int) none 19)
(memory-used (_type_) int 20)
(memory-total (_type_) int 21)
(memory-free (dead-pool-heap) int 22)
(compact-time (dead-pool-heap) uint 23)
(gap-size (dead-pool-heap dead-pool-heap-rec) int 24)
(gap-location (dead-pool-heap dead-pool-heap-rec) pointer 25)
(find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec 26)
(find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec 27)
)
)
;; todo inspect
;; parent type for all kinds of stack-frames.
;; at least for jak 1, these are only used internally by the kernel
;; "next" brings you "up" the stack (toward the caller)
(deftype stack-frame (basic)
((name symbol :offset 4)
(next stack-frame :offset 8)
)
:size-assert #xc
:method-count-assert 9
:flag-assert #x90000000c
)
;; a "catch" frame is a frame that can be "thrown" to.
;; the "throw" is a nonlocal control flow back to the state befor the "catch" block.
(deftype catch-frame (stack-frame)
((sp int32 :offset-assert 12)
(ra int32 :offset-assert 16)
(freg float 6 :offset-assert 20)
(rreg uint128 8 :offset-assert 48)
)
:method-count-assert 9
:size-assert #xb0
:flag-assert #x9000000b0
(:methods
(new (symbol type symbol function (pointer uint64)) object 0)
)
)
;; a "protect" frame is a way to indicate there's a "exit" function that should
;; run if there's a "throw" or "abandon".
(deftype protect-frame (stack-frame)
((exit (function none) :offset-assert 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
(:methods
(new (symbol type (function none)) protect-frame 0)
)
)
;; a handle is a safe way to refer to a process. It solves two problems:
;; - it allows you to find a process that moves in memory
;; - it allows you to tell if the original process has died. otherwise you may get confused
;; because there could be another process located at the exact same address.
(deftype handle (uint64)
((process (pointer process) :offset 0 :size 32) ;; additional level of indirection to support moving processes
(pid int32 :offset 32 :size 32) ;; unique pid to check if it's the same process or not.
(u64 uint64 :offset 0 :size 64)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(defmethod inspect handle ((obj handle))
(when (not obj)
(return obj)
)
(format #t "[~8x] ~A~%" obj 'handle)
(format #t "~1Tprocess: #x~X~%" (-> obj process))
(format #t "~1Tpid: ~D~%" (-> obj pid))
obj
)
(defmacro handle->process (handle)
"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))))
(if (= (-> the-handle pid) (-> proc pid)) ;; make sure it's the same process
proc
)
)
)
)
)
(defmacro ppointer->process (ppointer)
"convert a (pointer process) to a process."
;; this uses the self field, which seems to always just get set to the object.
;; confirmed in Jak 1 that using self here is useless, not sure...
`(let ((the-pp ,ppointer))
(the process-tree (if the-pp (-> the-pp 0 self)))
)
)
(defmacro process->ppointer (proc)
"safely get a (pointer process) from a process, returning #f if invalid."
`(let ((the-proc ,proc))
(if the-proc (-> the-proc ppointer))
)
)
(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))
(if (nonzero? obj)
(format #t "#<handle :process ~A :pid ~D>" (handle->process obj) (-> obj pid))
(format #t "#<handle :process 0 :pid 0>")
)
obj
)
;; A "state" defines functions that a process should run when it is in that state.
;; the "code" function is executed by the main thread and can suspend/resume.
;; the "trans" function is executed before code is resumed
;; the "post" function is executed after code is suspended
;; the "enter" function is executed when the process first transitions to the state
;; the "exit" function is executed when the process exits the state (or dies)
;; the "event" function is executed when the process receives an event.
;; See gstate.gc for a lot more details on how this all works.
;; This type is just a container to hold those functions.
(deftype state (protect-frame)
((code function :offset-assert 16)
(trans (function none) :offset-assert 20)
(post function :offset-assert 24)
(enter function :offset-assert 28)
(event (function process int symbol event-message-block object) :offset-assert 32)
)
:method-count-assert 9
:size-assert #x24
:flag-assert #x900000024
(:methods
(new (symbol
type
symbol
function
(function none)
function
(function none)
(function process int symbol event-message-block object))
_type_ 0)
)
)
;; data contained in an "event" sent from one process to another
;; in jak2, the events may be queued and sent at a later time, so the block
;; contains handles, to see if the to/from processes are still alive.
(deftype event-message-block (structure)
((to-handle handle :offset-assert 0) ;; who to send to
(to (pointer process) :offset 0)
(form-handle handle :offset-assert 8) ;; who is doing the sending
(from (pointer process) :offset 8)
(param uint64 6 :offset-assert 16) ;; the data being sent
(message symbol :offset-assert 64) ;; the message name
(num-params int32 :offset-assert 68)
)
:method-count-assert 9
:size-assert #x48
:flag-assert #x900000048
)
;; a queue of messages.
(deftype event-message-block-array (inline-array-class)
((data event-message-block :inline :dynamic :offset-assert 16)
)
:method-count-assert 10
:size-assert #x10
:flag-assert #xa00000010
(:methods
(send-all! (_type_) none 9)
)
)
(set! (-> event-message-block-array heap-base) (the-as uint 80))
;; the type returned by the C Kernel, contains the result of a SQL Query.
(deftype sql-result (basic)
((len int32 :offset-assert 4)
(allocated-length uint32 :offset-assert 8)
(error symbol :offset-assert 12)
(data symbol :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
(:methods
(new (symbol type uint) _type_ 0)
)
)
(defmethod new sql-result ((allocation symbol) (type-to-make type) (arg0 uint))
"Allocate a new sql-result with enough room for arg0 entries in data."
(let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* arg0 4))))))
(set! (-> v0-0 allocated-length) arg0)
(set! (-> v0-0 error) 'error)
v0-0
)
)
(defmethod print sql-result ((obj sql-result))
"Print a sql-result as an array of symbols."
(format #t "#(~A" (-> obj error))
(dotimes (s5-0 (-> obj len))
(format #t " ~A" (-> obj data s5-0))
)
(format #t ")")
obj
)
;; the result that the C Kernel will send us.
(define *sql-result* (the-as sql-result #f))
(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
)
;; then it's a docstring and we ignore it.
`(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@(cdr body)))
;; otherwise don't ignore it.
`(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@body))
)
)
(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 break ()
`(/ 0 0)
)
(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 process-mask? (mask enum-value)
`(!= 0 (logand ,mask (process-mask ,enum-value)))
)
(defmacro process-mask-set! (mask &rest enum-value)
;; sets the given bits in the process mask (with or)
`(set! ,mask (logior ,mask (process-mask ,@enum-value)))
)
(defmacro process-mask-clear! (mask &rest enum-value)
;; sets the given bits in the process mask (with or)
`(set! ,mask (logand ,mask (lognot (process-mask ,@enum-value))))
)
(defmacro suspend ()
"suspend the current process, to be resumed on the next frame."
`(rlet ((pp :reg r13 :reset-here #t))
;; 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))
(stack-top-goal (-> (the process pp) top-thread stack-top))
(stack-used (&- stack-top-goal sp-goal))
(stack-size (-> (the process pp) top-thread stack-size))
)
(when (> stack-used stack-size)
(format 0 "ERROR: suspend called without enough stack in proc:~%~A~%Stack: ~D/~D~%" pp stack-used stack-size)
)
)
)
)
;; set to the current thread
(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, if we've been relocated) on resume.
)
)
goal_src/jak2/kernel/gkernel.gc
+2330 -2
View File
File diff suppressed because it is too large Load Diff
goal_src/jak2/kernel/gstate.gc
+502 -1
View File
@@ -1,7 +1,508 @@
;;-*-Lisp-*-
;-*-Lisp-*-
(in-package goal)
;; name: gstate.gc
;; name in dgo: gstate
;; dgos: KERNEL
#|
Summary of state system:
A process can be put into a state, using enter-state, or the go macro.
This will set up the process to run the appropriate handler functions defined by the state.
The state handlers are:
- enter : gets run before trans on the first time the state is used. Can be #f. Must return.
- trans : gets run before code each time the code is run. Can be #f. Must return.
- code : main thread. Can suspend. If it returns, the process dies
- exit : gets run when leaving a state. must return.
- event : not sure of the details here yet.
You can use "go" to change the state of a process. This causes the process main thread execution to be abandoned.
If the main thread has exits/protects on the stack frame, they will be run first to clean up.
There are several ways to "go"
- go during init: when a process is being initialized with run-function-in-process, you can "go".
this causes the run-function-in-process to return immediately, and the next time the process is dispatched
it will go into the other state. This will automatically set the process to waiting-to-run,
and shrink the process heap, if appropriate
- go from outside the process. You can temporarily set pp to another process, and have that
process go to another state. The actual go will occur the next time the process is scheduled.
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 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.
- go from the main thread of the main process. This causes the (-> pp state) to change, the stack frames
to be cleaned up, and the old state's exit to be called. It will reset the stack, then run the code.
Unlike the others, this means you "go" immediately.
The compiler has two special hooks related to states: go-hook and define-state-hook.
These take care of doing a go and a state definition and properly checking types.
The define-state-hook takes a state object and handlers and defines a global symbol
with the appropriate state type.
The go-hook calls enter state and sets (-> proc next-state) for the given process.
It type checks the arguments for the entry function.
|#
(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)
"Same as go, but use a virtual state."
`(go (method-of-object ,proc ,state-name) ,@args)
)
(defmacro go-process (proc next-state &rest args)
"Make another process go."
`(with-pp
(protect (pp)
(set! pp ,proc)
(go-hook pp ,next-state ,@args)
)
)
)
;; run the given function in a process right now.
;; will return to here when:
;; - you return
;; - you deactivate
;; - 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
)
)
;; 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
)
)
(defmacro process-spawn-function (proc-type func &key (from *default-dead-pool*) &key (to *default-pool*) &key (name #f) &key (stack-size #x4000) &key (stack *scratch-memory-top*) &rest args)
"Start a new process that runs a function on its main thread.
Returns a pointer to the new process (or #f? on error)."
(with-gensyms (new-proc)
`(let ((,new-proc (the-as ,proc-type (get-process ,from ,proc-type ,stack-size))))
(when ,new-proc
((method-of-type ,proc-type activate) ,new-proc ,to ,(if name name (symbol->string proc-type)) ,stack)
(run-next-time-in-process ,new-proc ,func ,@args)
(the (pointer ,proc-type) (-> ,new-proc ppointer))
)
)
)
)
(defmacro process-spawn (proc-type &key (init #f) &key (from *default-dead-pool*) &key (to *default-pool*) &key (name #f) &key (stack-size #x4000) &key (stack *scratch-memory-top*) &rest args)
"Start a new process and run an init function on it.
Returns a pointer to the new process, or #f (or is it 0?) if something goes wrong."
(with-gensyms (new-proc)
`(let ((,new-proc (the-as ,proc-type (get-process ,from ,proc-type ,stack-size))))
(when ,new-proc
((method-of-type ,proc-type activate) ,new-proc ,to ,(if name name `(quote ,proc-type)) ,stack)
(run-now-in-process ,new-proc ,(if init init (string->symbol (fmt #f "{}-init-by-other" proc-type))) ,@args)
(the (pointer ,proc-type) (-> ,new-proc ppointer))
)
)
)
)
;; display a listing of active processes.
(defmacro ps (&key (detail #f))
`(inspect-process-tree *active-pool* 0 0 ,detail)
)
;; use a compile-time list to keep track of the type of an anonymous behavior.
(seval (define *defstate-type-stack* '()))
(desfun def-state-check-behavior (beh-form beh-type)
"check if code block is an anonymous behavior. needed for anonymous behaviors on defstate."
(when (and (pair? beh-form) (eq? (first beh-form) 'behavior))
(push! *defstate-type-stack* beh-type)
)
)
(defmacro clear-def-state-stack ()
(set! *defstate-type-stack* '())
`(none)
)
;; *no-state* is just used for the compiler to know whether a handler was actually set or not
(defmacro defstate (state-name parents
&key (virtual #f)
&key (event *no-state*)
&key (enter *no-state*)
&key (trans *no-state*)
&key (exit *no-state*)
&key (code *no-state*)
&key (post *no-state*)
)
"Define a new state!"
(with-gensyms (new-state)
(let ((defstate-type (first parents)))
(when (not (null? *defstate-type-stack*))
(fmt #t "*defstate-type-stack* leaked! An error probably happened in a previous defstate. stack is: {}"
*defstate-type-stack*)
)
(set! *defstate-type-stack* '())
;; check for default handlers
(let ((default-handlers (assoc defstate-type *default-state-handlers*)))
(when (not (null? default-handlers))
;;(fmt #t "found default-handlers for {}: {}\n" defstate-type default-handlers)
;; event
(set! default-handlers (cadr default-handlers))
(when (and (eq? event '*no-state*) (car default-handlers))
(set! event (car default-handlers)))
;; enter
(set! default-handlers (cdr default-handlers))
(when (and (eq? enter '*no-state*) (car default-handlers))
(set! enter (car default-handlers)))
;; trans
(set! default-handlers (cdr default-handlers))
(when (and (eq? trans '*no-state*) (car default-handlers))
(set! trans (car default-handlers)))
;; exit
(set! default-handlers (cdr default-handlers))
(when (and (eq? exit '*no-state*) (car default-handlers))
(set! exit (car default-handlers)))
;; code
(set! default-handlers (cdr default-handlers))
(when (and (eq? code '*no-state*) (car default-handlers))
(set! code (car default-handlers)))
;; post
(set! default-handlers (cdr default-handlers))
(when (and (eq? post '*no-state*) (car default-handlers))
(set! post (car default-handlers)))
(set! default-handlers (cdr default-handlers))
)
)
(def-state-check-behavior event defstate-type)
(def-state-check-behavior enter defstate-type)
(def-state-check-behavior trans defstate-type)
(def-state-check-behavior exit defstate-type)
(def-state-check-behavior code defstate-type)
(def-state-check-behavior post defstate-type)
`(let ((,new-state (new 'static 'state
:name (quote ,state-name)
:next #f
:exit #f
:code #f
:trans #f
:post #f
:enter #f
:event #f
)
))
;; the compiler will set the fields of the given state and define the symbol.
;; This way it can check the individual function types, make sure they make sense, and create
;; a state with the appropriate type.
,(if virtual
`(define-virtual-state-hook ,state-name ,defstate-type ,new-state ,(eq? virtual 'override) :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
`(define-state-hook ,state-name ,defstate-type ,new-state :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
)
)
)
)
)
(defmacro behavior (bindings &rest body)
"Define an anonymous behavior for a process state. This may only be used inside a defstate!"
(let ((behavior-type (first *defstate-type-stack*)))
(pop! *defstate-type-stack*)
`(lambda :behavior ,behavior-type ,bindings ,@body)
)
)
;; set the default handler functions for a process's state handlers
(seval (define *default-state-handlers* '()))
(defmacro defstatehandler (proc
&key (event #f)
&key (enter #f)
&key (trans #f)
&key (exit #f)
&key (code #f)
&key (post #f))
(let ((old (assoc proc *default-state-handlers*))
(new (list proc (list event enter trans exit code post))))
(if (null? old)
(append!! *default-state-handlers* new) ;; add new set of default handlers
(dolist (hnd *default-state-handlers*) ;; replace old handlers with new ones
(when (eq? (car hnd) old)
(set-car! hnd new)
)
)
)
)
`(none)
)
(defmethod new state
((allocation symbol)
(type-to-make type)
(name symbol)
(code function)
(trans (function none))
(enter function)
(exit (function none))
(event (function process int symbol event-message-block object)))
"Allocate a new state. It seems like this isn't really used much and most states are
statically allocated and as a result don't have the constructor called."
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> obj name) name)
(set! (-> obj next) #f)
(set! (-> obj exit) exit)
(set! (-> obj code) code)
(set! (-> obj trans) trans)
(set! (-> obj post) #f)
(set! (-> obj enter) enter)
(set! (-> obj event) event)
obj
)
)
(defun inherit-state ((child state) (parent state))
"Copy handler functions from parent to child"
(cond
((nonzero? parent)
(set! (-> child exit) (-> parent exit))
(set! (-> child code) (-> parent code))
(set! (-> child trans) (-> parent trans))
(set! (-> child post) (-> parent post))
(set! (-> child enter) (-> parent enter))
(set! (-> child event) (-> parent event))
)
(else
;; Note: this is added to let us defstate on a child before the parent.
;; The child won't be usable like this, but it will prevent a crash.
(format 0 "[STATE ERROR] inherit-state got a null parent state. Child is ~A~%" (-> child name))
)
)
child
)
(defmethod print state ((obj state))
"Print a state."
(format '#t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj)
obj
)
(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"
(with-pp
;; unsleep us
(process-mask-clear! (-> pp mask) sleep sleep-code)
;; mark as going
(process-mask-set! (-> pp mask) going)
(cond
((= (-> pp status) 'initialize)
;; 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)
;; abandon this thread, go back to what initialized us!
(throw 'initialize #t)
#t
)
((!= (-> *kernel-context* current-process) pp)
;; we aren't actually in process pp right now.
;; so set us up to go in the next run
(let ((status-backup (-> pp status)))
(set! (-> pp trans-hook) #f)
;; will set waiting-to-run
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
;; restore the old status.
(set! (-> pp status) status-backup)
#t
)
)
((= (-> pp main-thread) (-> pp top-thread))
;; we are in the right process, and in the main thread!
;; 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))
;; do exits
(let ((frame (-> pp stack-frame-top)))
(while frame
(case (-> frame type)
((protect-frame state)
((-> (the-as protect-frame frame) exit))
)
)
(set! frame (-> frame next))
)
)
;; done with going, clear the mask
(process-mask-clear! (-> pp mask) going)
;; now, update the process:
(let ((new-state (-> pp state)))
;; event hook from the current state
(set! (-> pp event-hook) (-> new-state event))
;; if we have an exit, push it onto the stack frame
;; and also blow away the old stack frame
(if (-> new-state exit)
(set! (-> pp stack-frame-top) new-state)
(set! (-> pp stack-frame-top) #f)
)
(set! (-> pp post-hook) (-> new-state post))
(set! (-> pp trans-hook) (-> new-state trans))
;; 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)
)
)
;; 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)
(off :reg r15 :type uint)
(carg0 :reg rdi)
(carg1 :reg rsi)
(carg2 :reg rdx)
(carg3 :reg rcx))
;; prepare args
;; compiler will likely have these on the stack, we need to get them in regs
;; before messing with the stack.
(.mov carg0 arg0)
(.mov carg1 arg1)
(.mov carg2 arg2)
(.mov carg3 arg3)
;; get the main code as an x86-64 pointer
(.mov func (-> new-state code))
(.add func off)
;; reset the stack (scary)
(.mov sp (-> pp main-thread stack-top))
(.add sp off)
;; push the return trampoline for when code returns.
(.mov temp return-from-thread-dead) ;; will deactivate
(.add temp off)
(.push temp)
;; and call!
(.jr func)
;; stupid hack so the compiler doesn't throw away these registers.
(.add carg0 carg1)
(.add carg2 carg3)
#f ;; can't get here
)
)
)
(else
;; not in the main-thread.
;; so we set up the main thread to try again.
(set! (-> pp trans-hook) #f)
(set-to-run (-> pp main-thread)
enter-state arg0 arg1 arg2 arg3 arg4 arg5)
(when (!= (-> pp top-thread name) 'post)
;; abandon this one too.
;; NOTE - this is different from GOAL.
;; GOAL installs this as the return address for this function and returns normally.
;; but we don't because I don't have an easy way to find where to stick this.
;; I can't see how this makes a difference, as all non-main threads seem
;; 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) ;; could probably just call this...
(.add temp off)
(.push temp)
(.ret)
#f ;; can't get here
)
)
)
)
)
)
(kmemopen global "event-queue")
(let ((v1-3 (new 'global 'event-message-block-array 64)))
(set! (-> v1-3 length) 0)
(define *event-queue* v1-3)
)
(kmemclose)
(defun send-event-function ((arg0 process-tree) (arg1 event-message-block))
(with-pp
(when (and arg0 (!= (-> arg0 type) process-tree) (-> (the-as process arg0) event-hook) (-> arg1 from))
(let ((gp-0 pp))
(set! pp (the-as process arg0))
(let ((v0-0 ((-> (the-as process arg0) event-hook) (-> arg1 from 0) (-> arg1 num-params) (-> arg1 message) arg1)))
(set! pp gp-0)
v0-0
)
)
)
)
)
(defmethod send-all! event-message-block-array ((obj event-message-block-array))
(dotimes (s5-0 (-> obj length))
(let* ((a1-0 (-> obj data s5-0))
(a0-2 (handle->process (-> a1-0 to-handle)))
)
(if (and a0-2 (handle->process (-> a1-0 form-handle)))
(send-event-function a0-2 a1-0)
)
)
)
(set! (-> obj length) 0)
0
(none)
)
(defun looping-code ()
(until #f
(suspend)
)
#f
)
goal_src/jak2/kernel/gstring-h.gc
+7
View File
@@ -5,3 +5,10 @@
;; name in dgo: gstring-h
;; dgos: KERNEL
(define-extern *string-tmp-str* string)
(define-extern *temp-string* string)
(define-extern *stdcon0* string)
(define-extern *stdcon1* string)
(define-extern *stdcon* string)
(define-extern *debug-draw-pauseable* symbol)
(define-extern string= (function string string symbol))
goal_src/jak2/kernel/gstring.gc
+705
View File
@@ -5,3 +5,708 @@
;; name in dgo: gstring
;; dgos: KERNEL
(defmethod length string ((obj string))
(let ((v1-0 (-> obj data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(&- v1-0 (the-as uint (-> obj data)))
)
)
(defmethod asize-of string ((obj string))
(+ (-> obj allocated-length) 1 (-> string size))
)
(defun copy-string<-string ((arg0 string) (arg1 string))
(let ((v1-0 (-> arg0 data)))
(let ((a1-1 (-> arg1 data)))
(while (nonzero? (-> a1-1 0))
(set! (-> v1-0 0) (-> a1-1 0))
(set! v1-0 (&-> v1-0 1))
(set! a1-1 (&-> a1-1 1))
)
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defmethod new string ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string))
(cond
(arg1
(let* ((s2-1 (max (length arg1) arg0))
(a0-4 (object-new allocation type-to-make (+ s2-1 1 (-> type-to-make size))))
)
(set! (-> a0-4 allocated-length) s2-1)
(copy-string<-string a0-4 arg1)
)
)
(else
(let ((v0-2 (object-new allocation type-to-make (+ arg0 1 (-> type-to-make size)))))
(set! (-> v0-2 allocated-length) arg0)
v0-2
)
)
)
)
(defun string= ((arg0 string) (arg1 string))
(let ((a2-0 (-> arg0 data))
(v1-0 (-> arg1 data))
)
(if (or (zero? arg0) (zero? arg1))
(return #f)
)
(while (and (nonzero? (-> a2-0 0)) (nonzero? (-> v1-0 0)))
(if (!= (-> a2-0 0) (-> v1-0 0))
(return #f)
)
(set! a2-0 (&-> a2-0 1))
(set! v1-0 (&-> v1-0 1))
)
(and (zero? (-> a2-0 0)) (zero? (-> v1-0 0)))
)
)
(defun string-prefix= ((arg0 string) (arg1 string))
(let ((v1-0 (-> arg0 data)))
(let ((a2-0 (-> arg1 data)))
(if (or (zero? arg0) (zero? arg1))
(return #f)
)
(while (and (nonzero? (-> v1-0 0)) (nonzero? (-> a2-0 0)))
(if (!= (-> v1-0 0) (-> a2-0 0))
(return #f)
)
(set! v1-0 (&-> v1-0 1))
(set! a2-0 (&-> a2-0 1))
)
)
(zero? (-> v1-0 0))
)
)
(defun charp-prefix= ((arg0 (pointer uint8)) (arg1 (pointer uint8)))
(while (and (nonzero? (-> arg0 0)) (nonzero? (-> arg1 0)))
(if (!= (-> arg0 0) (-> arg1 0))
(return #f)
)
(set! arg0 (&-> arg0 1))
(set! arg1 (&-> arg1 1))
)
(zero? (-> arg0 0))
)
(defun string-suffix= ((arg0 string) (arg1 string))
(let ((s5-0 (-> arg0 data))
(gp-0 (-> arg1 data))
)
(if (or (zero? arg0) (zero? arg1))
(return #f)
)
(let ((s4-0 (length arg0))
(v1-5 (length arg1))
)
(if (< s4-0 v1-5)
(return #f)
)
(let ((v1-7 (&+ s5-0 (- s4-0 v1-5))))
(while (and (nonzero? (-> v1-7 0)) (nonzero? (-> gp-0 0)))
(if (!= (-> v1-7 0) (-> gp-0 0))
(return #f)
)
(set! v1-7 (&-> v1-7 1))
(set! gp-0 (&-> gp-0 1))
)
(zero? (-> v1-7 0))
)
)
)
)
(defun string-position ((arg0 string) (arg1 string))
(let ((s5-0 0)
(s4-0 (-> arg1 data))
)
(while (nonzero? (-> s4-0 0))
(if (charp-prefix= (-> arg0 data) s4-0)
(return s5-0)
)
(+! s5-0 1)
(set! s4-0 (&-> s4-0 1))
)
)
-1
)
(defun string-charp= ((arg0 string) (arg1 (pointer uint8)))
(let ((v1-0 (-> arg0 data)))
(while (and (nonzero? (-> v1-0 0)) (nonzero? (-> arg1 0)))
(if (!= (-> v1-0 0) (-> arg1 0))
(return #f)
)
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(and (zero? (-> v1-0 0)) (zero? (-> arg1 0)))
)
)
;; definition for function name=
;; ERROR: function was not converted to expressions. Cannot decompile.
(defun copyn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int))
(let ((v1-0 (-> arg0 data)))
(dotimes (a3-0 arg2)
(set! (-> v1-0 0) (-> arg1 0))
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defun string<-charp ((arg0 string) (arg1 (pointer uint8)))
(let ((v1-0 (-> arg0 data)))
(while (nonzero? (-> arg1 0))
(set! (-> v1-0 0) (-> arg1 0))
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defun charp<-string ((arg0 (pointer uint8)) (arg1 string))
(let ((v1-0 (-> arg1 data)))
(while (nonzero? (-> v1-0 0))
(set! (-> arg0 0) (-> v1-0 0))
(set! arg0 (&-> arg0 1))
(set! v1-0 (&-> v1-0 1))
)
)
(set! (-> arg0 0) (the-as uint 0))
0
)
(defun copyn-charp<-string ((arg0 (pointer uint8)) (arg1 string) (arg2 int))
(let ((v1-0 (-> arg1 data)))
(while (and (nonzero? (-> v1-0 0)) (< 1 arg2))
(set! (-> arg0 0) (-> v1-0 0))
(set! arg0 (&-> arg0 1))
(set! v1-0 (&-> v1-0 1))
(set! arg2 (+ arg2 -1))
)
)
(while (> arg2 0)
(set! (-> arg0 0) (the-as uint 0))
(set! arg0 (&-> arg0 1))
(set! arg2 (+ arg2 -1))
)
0
(none)
)
(defun copy-charp<-charp ((arg0 (pointer uint8)) (arg1 (pointer uint8)))
(while (nonzero? (-> arg1 0))
(set! (-> arg0 0) (-> arg1 0))
(set! arg0 (&-> arg0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> arg0 0) (the-as uint 0))
arg0
)
(defun cat-string<-string ((arg0 string) (arg1 string))
(let ((v1-0 (-> arg0 data)))
(let ((a1-1 (-> arg1 data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(while (nonzero? (-> a1-1 0))
(set! (-> v1-0 0) (-> a1-1 0))
(set! v1-0 (&-> v1-0 1))
(set! a1-1 (&-> a1-1 1))
)
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defun catn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int))
(let ((v1-0 (-> arg0 data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(dotimes (a3-2 arg2)
(set! (-> v1-0 0) (-> arg1 0))
(set! v1-0 (&-> v1-0 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-0 0) (the-as uint 0))
)
arg0
)
(defun cat-string<-string_to_charp ((arg0 string) (arg1 string) (arg2 (pointer uint8)))
(let ((v1-0 (-> arg1 data))
(v0-0 (-> arg0 data))
)
(while (nonzero? (-> v0-0 0))
(nop!)
(nop!)
(nop!)
(set! v0-0 (&-> v0-0 1))
)
(while (and (>= (the-as int arg2) (the-as int v1-0)) (nonzero? (-> v1-0 0)))
(set! (-> v0-0 0) (-> v1-0 0))
(set! v0-0 (&-> v0-0 1))
(set! v1-0 (&-> v1-0 1))
)
(set! (-> v0-0 0) (the-as uint 0))
v0-0
)
)
(defun append-character-to-string ((arg0 string) (arg1 uint8))
(let ((v1-0 (-> arg0 data)))
(while (nonzero? (-> v1-0 0))
(nop!)
(nop!)
(nop!)
(set! v1-0 (&-> v1-0 1))
)
(set! (-> v1-0 0) (the-as uint arg1))
(set! (-> v1-0 1) (the-as uint 0))
)
0
0
)
(defun charp-basename ((arg0 (pointer uint8)))
(let ((v1-0 arg0))
(while (nonzero? (-> v1-0 0))
(set! v1-0 (&-> v1-0 1))
)
(while (< (the-as int arg0) (the-as int v1-0))
(set! v1-0 (&-> v1-0 -1))
(if (or (= (-> v1-0 0) 47) (= (-> v1-0 0) 92))
(return (&-> v1-0 1))
)
)
)
arg0
)
(defun clear ((arg0 string))
(set! (-> arg0 data 0) (the-as uint 0))
arg0
)
(defun string<? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #t)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #f)
)
)
)
)
#f
)
(defun string>? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #f)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #t)
)
)
)
)
#f
)
(defun string<=? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #t)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #f)
)
)
)
)
#t
)
(defun string>=? ((arg0 string) (arg1 string))
(let ((s4-1 (min (length arg0) (length arg1))))
(dotimes (v1-4 s4-1)
(cond
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
(return #f)
)
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
(return #t)
)
)
)
)
#t
)
(define *string-tmp-str* (new 'global 'string 128 (the-as string #f)))
(defun string-skip-to-char ((arg0 (pointer uint8)) (arg1 uint))
(while (and (nonzero? (-> arg0 0)) (!= (-> arg0 0) arg1))
(set! arg0 (&-> arg0 1))
)
arg0
)
(defun string-cat-to-last-char ((arg0 string) (arg1 string) (arg2 uint))
(let ((s4-0 (&-> (the-as (pointer uint8) arg1) 3)))
(let ((v1-0 (string-skip-to-char (-> arg1 data) arg2)))
(when (= (-> v1-0 0) arg2)
(until (!= (-> v1-0 0) arg2)
(set! s4-0 v1-0)
(set! v1-0 (string-skip-to-char (&-> v1-0 1) arg2))
)
)
)
(cat-string<-string_to_charp arg0 arg1 s4-0)
)
)
(defun string-skip-whitespace ((arg0 (pointer uint8)))
(while (and (nonzero? (-> arg0 0)) (or (= (-> arg0 0) 32) (= (-> arg0 0) 9) (= (-> arg0 0) 13) (= (-> arg0 0) 10)))
(set! arg0 (&-> arg0 1))
)
arg0
)
(defun string-suck-up! ((arg0 string) (arg1 (pointer uint8)))
(when (!= arg1 (-> arg0 data))
(let ((v1-2 (-> arg0 data)))
(while (nonzero? (-> arg1 0))
(set! (-> v1-2 0) (-> arg1 0))
(set! v1-2 (&-> v1-2 1))
(set! arg1 (&-> arg1 1))
)
(set! (-> v1-2 0) (the-as uint 0))
)
0
)
#f
)
(defun string-strip-leading-whitespace! ((arg0 string))
(let ((a1-0 (string-skip-whitespace (-> arg0 data))))
(string-suck-up! arg0 a1-0)
)
#f
)
(defun string-strip-trailing-whitespace! ((arg0 string))
(when (nonzero? (length arg0))
(let ((v1-6 (&+ (-> arg0 data) (+ (length arg0) -1))))
(while (and (>= (the-as int v1-6) (the-as int (-> arg0 data)))
(or (= (-> v1-6 0) 32) (= (-> v1-6 0) 9) (= (-> v1-6 0) 13) (= (-> v1-6 0) 10))
)
(set! v1-6 (&-> v1-6 -1))
)
(set! (-> v1-6 1) (the-as uint 0))
)
0
)
#f
)
(defun string-strip-whitespace! ((arg0 string))
(string-strip-trailing-whitespace! arg0)
(string-strip-leading-whitespace! arg0)
#f
)
(defun string-upcase ((arg0 string) (arg1 string))
(let* ((a0-1 (-> arg0 data))
(a3-0 (-> a0-1 0))
(a2-0 1)
(v1-0 0)
)
(while (nonzero? a3-0)
(if (and (>= a3-0 (the-as uint 97)) (>= (the-as uint 122) a3-0))
(+! a3-0 -32)
)
(set! (-> arg1 data v1-0) a3-0)
(set! a3-0 (-> a0-1 a2-0))
(+! a2-0 1)
(+! v1-0 1)
)
(set! (-> arg1 data v1-0) (the-as uint 0))
)
0
(none)
)
(defun string-get-arg!! ((arg0 string) (arg1 string))
(let ((s4-0 (string-skip-whitespace (-> arg1 data))))
(cond
((= (-> s4-0 0) 34)
(let ((s4-1 (&-> s4-0 1)))
(let ((v1-3 s4-1))
(while (and (nonzero? (-> s4-1 0)) (!= (-> s4-1 0) 34))
(set! s4-1 (&-> s4-1 1))
)
(copyn-string<-charp arg0 v1-3 (&- s4-1 (the-as uint v1-3)))
)
(if (= (-> s4-1 0) 34)
(set! s4-1 (&-> s4-1 1))
)
(let ((a1-3 (string-skip-whitespace s4-1)))
(string-suck-up! arg1 a1-3)
)
)
(return #t)
)
((nonzero? (-> s4-0 0))
(let ((v1-11 s4-0))
(while (and (nonzero? (-> s4-0 0)) (!= (-> s4-0 0) 32) (!= (-> s4-0 0) 9) (!= (-> s4-0 0) 13) (!= (-> s4-0 0) 10))
(set! s4-0 (&-> s4-0 1))
)
(copyn-string<-charp arg0 v1-11 (&- s4-0 (the-as uint v1-11)))
)
(let ((a1-9 (string-skip-whitespace s4-0)))
(string-suck-up! arg1 a1-9)
)
(return #t)
)
)
)
#f
)
(defun string->int ((arg0 string))
(let ((a0-1 (-> arg0 data))
(v0-0 0)
(v1-0 #f)
)
(cond
((= (-> a0-1 0) 35)
(let ((a0-2 (&-> a0-1 1)))
(cond
((or (= (-> a0-2 0) 120) (= (-> a0-2 0) 88))
(let ((a0-3 (&-> a0-2 1)))
(when (= (-> a0-3 1) 45)
(set! v1-0 #t)
(set! a0-3 (&-> a0-3 1))
)
(while (or (and (>= (-> a0-3 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-3 0)))
(and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0)))
(and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0)))
)
(cond
((and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0)))
(set! v0-0 (the-as int (+ (-> a0-3 0) -55 (* v0-0 16))))
)
((and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0)))
(set! v0-0 (the-as int (+ (-> a0-3 0) -87 (* v0-0 16))))
)
(else
(set! v0-0 (the-as int (+ (-> a0-3 0) -48 (* v0-0 16))))
)
)
(set! a0-3 (&-> a0-3 1))
)
)
)
((or (= (-> a0-2 0) 98) (= (-> a0-2 0) 66))
(let ((a0-4 (&-> a0-2 1)))
(while (and (>= (-> a0-4 0) (the-as uint 48)) (>= (the-as uint 49) (-> a0-4 0)))
(set! v0-0 (the-as int (+ (-> a0-4 0) -48 (* v0-0 2))))
(set! a0-4 (&-> a0-4 1))
)
)
)
)
)
)
(else
(when (= (-> a0-1 1) 45)
(set! v1-0 #t)
(set! a0-1 (&-> a0-1 1))
)
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
(set! v0-0 (the-as int (+ (-> a0-1 0) -48 (* 10 v0-0))))
(set! a0-1 (&-> a0-1 1))
)
)
)
(cond
(v1-0
(- v0-0)
)
(else
(empty)
v0-0
)
)
)
)
(defun string->float ((arg0 string))
(let ((a0-1 (-> arg0 data))
(f0-0 0.0)
(v1-0 #f)
)
(when (= (-> a0-1 0) 45)
(set! v1-0 #t)
(set! a0-1 (&-> a0-1 1))
)
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
(set! f0-0 (+ (* 10.0 f0-0) (the float (+ (-> a0-1 0) -48))))
(set! a0-1 (&-> a0-1 1))
)
(when (= (-> a0-1 0) 46)
(set! a0-1 (&-> a0-1 1))
(let ((a2-4 #xf4240)
(a1-12 0)
)
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
(+! a1-12 (* (+ (-> a0-1 0) -48) (the-as uint a2-4)))
(set! a2-4 (/ a2-4 10))
(set! a0-1 (&-> a0-1 1))
)
(+! f0-0 (* 0.0000001 (the float a1-12)))
)
)
(when (= (-> a0-1 0) 101)
(let ((a1-16 (&-> a0-1 1))
(f1-5 0.0)
(a0-2 #f)
)
(cond
((= (-> a1-16 0) 45)
(set! a0-2 #t)
(set! a1-16 (&-> a1-16 1))
)
((= (-> a1-16 0) 43)
(set! a1-16 (&-> a1-16 1))
)
)
(while (and (>= (-> a1-16 0) (the-as uint 48)) (>= (the-as uint 57) (-> a1-16 0)))
(set! f1-5 (+ (* 10.0 f1-5) (the float (+ (-> a1-16 0) -48))))
(set! a1-16 (&-> a1-16 1))
)
(when (!= f1-5 0.0)
(let ((f2-6 1.0))
(cond
(a0-2
(dotimes (a0-3 (the int f1-5))
(set! f2-6 (* 0.1 f2-6))
(nop!)
(nop!)
)
)
(else
(dotimes (a0-6 (the int f1-5))
(set! f2-6 (* 10.0 f2-6))
(nop!)
(nop!)
)
)
)
(set! f0-0 (* f0-0 f2-6))
)
)
)
)
(if v1-0
(- f0-0)
f0-0
)
)
)
(defun string-get-int32!! ((arg0 (pointer int32)) (arg1 string))
(cond
((string-get-arg!! *string-tmp-str* arg1)
(set! (-> arg0 0) (string->int *string-tmp-str*))
#t
)
(else
#f
)
)
)
(defun string-get-float!! ((arg0 (pointer float)) (arg1 string))
(cond
((string-get-arg!! *string-tmp-str* arg1)
(set! (-> arg0 0) (string->float *string-tmp-str*))
#t
)
(else
#f
)
)
)
(defun string-get-flag!! ((arg0 (pointer symbol)) (arg1 string) (arg2 string) (arg3 string))
(cond
((string-get-arg!! *string-tmp-str* arg1)
(cond
((or (string= *string-tmp-str* arg2) (string= *string-tmp-str* arg3))
(set! (-> arg0 0) (string= *string-tmp-str* arg2))
#t
)
(else
#f
)
)
)
(else
#f
)
)
)
(kmemopen global "gstring-globals")
(define *debug-draw-pauseable* #f)
(define *stdcon0* (new 'global 'string #x4000 (the-as string #f)))
(define *stdcon1* (new 'global 'string #x4000 (the-as string #f)))
(define *stdcon* *stdcon0*)
(define *temp-string* (new 'global 'string 2048 (the-as string #f)))
(kmemclose)
goalc/compiler/Compiler.h
+1
View File
@@ -220,6 +220,7 @@ class Compiler {
bool is_structure(const TypeSpec& ts);
bool is_bitfield(const TypeSpec& ts);
bool is_pair(const TypeSpec& ts);
bool is_symbol(const TypeSpec& ts);
std::vector<goos::Object> get_list_as_vector(const goos::Object& o,
goos::Object* rest_out = nullptr,
int max_length = -1);
goalc/compiler/Util.cpp
+4
View File
@@ -336,6 +336,10 @@ bool Compiler::is_pair(const TypeSpec& ts) {
return m_ts.tc(m_ts.make_typespec("pair"), ts);
}
bool Compiler::is_symbol(const TypeSpec& ts) {
return m_ts.tc(m_ts.make_typespec("symbol"), ts);
}
bool Compiler::get_true_or_false(const goos::Object& form, const goos::Object& boolean) {
// todo try other things.
if (boolean.is_symbol()) {
goalc/compiler/compilation/Atoms.cpp
+1 -1
View File
@@ -380,7 +380,7 @@ Val* Compiler::compile_get_symbol_value(const goos::Object& form,
}
auto ts = existing_symbol->second;
auto sext = m_ts.lookup_type(ts)->get_load_signed();
auto sext = m_ts.lookup_type_allow_partial_def(ts)->get_load_signed();
auto fe = env->function_env();
auto sym = fe->alloc_val<SymbolVal>(name, m_ts.make_typespec("symbol"));
auto re = fe->alloc_val<SymbolValueVal>(sym, ts, sext);
goalc/compiler/compilation/Static.cpp
+2 -1
View File
@@ -139,7 +139,8 @@ void Compiler::compile_static_structure_inline(const goos::Object& form,
deref_info.sign_extend);
}
} else if (is_structure(field_info.type) || is_pair(field_info.type)) {
} else if (is_structure(field_info.type) || is_pair(field_info.type) ||
is_symbol(field_info.type)) {
if (is_pair(field_info.type)) {
ASSERT(!field_info.field.is_inline());
}
goalc/compiler/compilation/Type.cpp
+2 -1
View File
@@ -162,7 +162,8 @@ void Compiler::generate_field_description(const goos::Object& form,
format_args.push_back(get_field_of_structure(type, reg, f.name(), env)->to_gpr(form, env));
} else if (m_ts.tc(m_ts.make_typespec("basic"), f.type()) ||
m_ts.tc(m_ts.make_typespec("binteger"), f.type()) ||
m_ts.tc(m_ts.make_typespec("pair"), f.type())) {
m_ts.tc(m_ts.make_typespec("pair"), f.type()) ||
m_ts.tc(m_ts.make_typespec("symbol"), f.type())) {
// basic, binteger, pair
str_template += fmt::format("{}{}: ~A~%", tabs, f.name());
format_args.push_back(get_field_of_structure(type, reg, f.name(), env)->to_gpr(form, env));
scripts/decomp_progress.py
+1 -1
View File
@@ -50,7 +50,7 @@ def main():
file_stats = []
total_gc_files = 0
excluded_files = {"game_dgos.gc", "all_files.gc", "goal-lib.gc", "ocean-trans-tables.gc", "ocean-frames.gc",
"ocean-tables.gc"}
"ocean-tables.gc", "kernel-defs.gc", "compiler-setup.gc"}
modified = set()
for fn in all_files:
test/goalc/test_with_game.cpp
+8
View File
@@ -961,6 +961,14 @@ TEST(Jak1TypeConsistency, TypeConsistency) {
compiler.run_test_no_load("test/goalc/source_templates/with_game/test-build-all-code.gc");
}
TEST(Jak2TypeConsistency, TypeConsistency) {
Compiler compiler(GameVersion::Jak2);
compiler.enable_throw_on_redefines();
add_expected_type_mismatches(compiler);
compiler.run_test_no_load("decompiler/config/jak2/all-types.gc");
compiler.run_test_no_load("test/goalc/source_templates/with_game/test-build-all-code.gc");
}
struct VectorFloatRegister {
float x = 0;
float y = 0;