mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-08-18 13:53:01 -04:00
Code Issues Packages Projects Releases Wiki Activity

fix printing and add gstate (#330)

Browse Source
This commit is contained in:
water111
2021-03-22 20:04:00 -04:00
committed by GitHub
parent 123f3b509d
commit 9ffc6014e1
17 changed files with 675 additions and 265 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/decompiler/reference/gkernel_REF.gc
+210 -202
View File
@@ -47,7 +47,8 @@
;; definition for function unload-package
(defun unload-package ((arg0 string))
(let ((v1-0 (nmember arg0 *kernel-packages*)))
(if v1-0 (set! *kernel-packages* (delete! (car v1-0) *kernel-packages*))
(if v1-0
(set! *kernel-packages* (delete! (car v1-0) *kernel-packages*))
)
)
*kernel-packages*
@@ -206,13 +207,13 @@
)
;; definition for function remove-exit
(defun remove-exit () (local-vars (pp process))
(if (-> pp stack-frame-top)
(let ((v0-0 (-> pp stack-frame-top next)))
(set! (-> pp stack-frame-top) v0-0)
v0-0
)
)
(defun remove-exit ()
(local-vars (pp process)) (if (-> pp stack-frame-top)
(let ((v0-0 (-> pp stack-frame-top next)))
(set! (-> pp stack-frame-top) v0-0)
v0-0
)
)
)
;; definition (debug) for function stream<-process-mask
@@ -335,7 +336,8 @@
(a1-3 "~Tparent: ~A~%")
(v1-0 (-> obj parent))
)
(t9-3 a0-4 a1-3 (if v1-0 (-> v1-0 0 self)
(t9-3 a0-4 a1-3 (if v1-0
(-> v1-0 0 self)
)
)
)
@@ -344,7 +346,8 @@
(a1-4 "~Tbrother: ~A~%")
(v1-2 (-> obj brother))
)
(t9-4 a0-5 a1-4 (if v1-2 (-> v1-2 0 self)
(t9-4 a0-5 a1-4 (if v1-2
(-> v1-2 0 self)
)
)
)
@@ -353,7 +356,8 @@
(a1-5 "~Tchild: ~A~%")
(v1-4 (-> obj child))
)
(t9-5 a0-6 a1-5 (if v1-4 (-> v1-4 0 self)
(t9-5 a0-6 a1-5 (if v1-4
(-> v1-4 0 self)
)
)
)
@@ -445,7 +449,8 @@
(a1-12 "~Tparent: ~A~%")
(v1-0 (-> obj parent))
)
(t9-12 a0-13 a1-12 (if v1-0 (-> v1-0 0 self)
(t9-12 a0-13 a1-12 (if v1-0
(-> v1-0 0 self)
)
)
)
@@ -454,7 +459,8 @@
(a1-13 "~Tbrother: ~A~%")
(v1-2 (-> obj brother))
)
(t9-13 a0-14 a1-13 (if v1-2 (-> v1-2 0 self)
(t9-13 a0-14 a1-13 (if v1-2
(-> v1-2 0 self)
)
)
)
@@ -463,7 +469,8 @@
(a1-14 "~Tchild: ~A~%")
(v1-4 (-> obj child))
)
(t9-14 a0-15 a1-14 (if v1-4 (-> v1-4 0 self)
(t9-14 a0-15 a1-14 (if v1-4
(-> v1-4 0 self)
)
)
)
@@ -554,12 +561,14 @@
(v1-5 ((method-of-type process new) allocation process 'dead arg1))
)
(let ((a0-3 v1-5))
(set! (-> s3-0 child) (if a0-3 (-> a0-3 ppointer)
(set! (-> s3-0 child) (if a0-3
(-> a0-3 ppointer)
)
)
)
(let ((a0-4 s3-0))
(set! (-> v1-5 parent) (if a0-4 (-> a0-4 ppointer)
(set! (-> v1-5 parent) (if a0-4
(-> a0-4 ppointer)
)
)
)
@@ -789,15 +798,16 @@
(let ((s5-1 (-> obj alive-list))
(s4-0 0)
)
(while s5-1 (if (-> s5-1 process)
(format
#t
"~T [~3D] #<dead-pool-heap-rec @ #x~X> ~A~%"
s4-0
s5-1
(-> s5-1 process)
)
)
(while s5-1
(if (-> s5-1 process)
(format
#t
"~T [~3D] #<dead-pool-heap-rec @ #x~X> ~A~%"
s4-0
s5-1
(-> s5-1 process)
)
)
(let ((s3-0 (gap-size obj s5-1)))
(if (nonzero? s3-0)
(format #t "~T gap: ~D bytes @ #x~X~%" s3-0 (gap-location obj s5-1))
@@ -875,7 +885,8 @@
(let ((v1-5 (-> s1-0 next)))
(set! (-> s1-0 next) s4-0)
(set! (-> s4-0 next) v1-5)
(when v1-5 (set! (-> v1-5 prev) s4-0)
(when v1-5
(set! (-> v1-5 prev) s4-0)
(let ((v1-6 s4-0))
)
)
@@ -931,7 +942,8 @@
)
)
)
(if s3-0 (set! (-> s3-0 type) arg0)
(if s3-0
(set! (-> s3-0 type) arg0)
(format
0
"WARNING: ~A ~A could not be allocated, because ~A was empty.~%"
@@ -990,41 +1002,30 @@
;; definition for method 17 of type dead-pool-heap
(defmethod shrink-heap dead-pool-heap ((obj dead-pool-heap) (arg0 process))
(if arg0 (let ((s5-0 (-> arg0 ppointer)))
(when
(not
(or
(nonzero? (logand (-> arg0 mask) 512))
(and (not (-> arg0 next-state)) (not (-> arg0 state)))
)
)
(set!
(-> arg0 allocated-length)
(&- (-> arg0 heap-cur) (the-as uint (-> arg0 stack)))
)
(set!
(-> arg0 heap-top)
(&-> arg0 stack (-> arg0 allocated-length))
)
(if
(<
(the-as int arg0)
(the-as int (gap-location obj (-> obj first-gap)))
)
(set!
(-> obj first-gap)
(find-gap obj (the-as dead-pool-heap-rec s5-0))
)
)
(set! (-> arg0 mask) (logior (-> arg0 mask) 512))
)
(if (= (-> obj first-shrink) s5-0)
(set!
(-> obj first-shrink)
(the-as dead-pool-heap-rec (-> s5-0 2))
)
)
)
(if arg0
(let ((s5-0 (-> arg0 ppointer)))
(when
(not
(or
(nonzero? (logand (-> arg0 mask) 512))
(and (not (-> arg0 next-state)) (not (-> arg0 state)))
)
)
(set!
(-> arg0 allocated-length)
(&- (-> arg0 heap-cur) (the-as uint (-> arg0 stack)))
)
(set! (-> arg0 heap-top) (&-> arg0 stack (-> arg0 allocated-length)))
(if
(< (the-as int arg0) (the-as int (gap-location obj (-> obj first-gap))))
(set! (-> obj first-gap) (find-gap obj (the-as dead-pool-heap-rec s5-0)))
)
(set! (-> arg0 mask) (logior (-> arg0 mask) 512))
)
(if (= (-> obj first-shrink) s5-0)
(set! (-> obj first-shrink) (the-as dead-pool-heap-rec (-> s5-0 2)))
)
)
)
obj
)
@@ -1067,7 +1068,8 @@
(let ((a0-5 v1-13))
)
)
(if v1-13 (shrink-heap obj (-> v1-13 process))
(if v1-13
(shrink-heap obj (-> v1-13 process))
)
)
(let ((s4-1 (-> obj first-gap)))
@@ -1101,8 +1103,7 @@
(while (nonzero? arg0)
(+! arg0 -1)
(let ((s4-0 (-> obj alive-list next)))
(when
s4-0
(when s4-0
(if
(or
(= (-> obj first-gap) s4-0)
@@ -1128,7 +1129,8 @@
(let ((v1-19 (-> a1-3 next)))
(set! (-> a1-3 next) s4-0)
(set! (-> s4-0 next) v1-19)
(when v1-19 (set! (-> v1-19 prev) s4-0)
(when v1-19
(set! (-> v1-19 prev) s4-0)
(let ((v1-20 s4-0))
)
)
@@ -1277,10 +1279,11 @@
)
(else
(let ((v1-4 (-> arg0 child)))
(while v1-4 (let ((s3-1 (-> v1-4 0 brother)))
(iterate-process-tree (-> v1-4 0) arg1 arg2)
(set! v1-4 s3-1)
)
(while v1-4
(let ((s3-1 (-> v1-4 0 brother)))
(iterate-process-tree (-> v1-4 0) arg1 arg2)
(set! v1-4 s3-1)
)
(let ((a0-4 v1-4))
)
)
@@ -1314,10 +1317,11 @@
)
(else
(let ((v1-8 (-> arg0 child)))
(while v1-8 (let ((s4-1 (-> v1-8 0 brother)))
(execute-process-tree (-> v1-8 0) arg1 arg2)
(set! v1-8 s4-1)
)
(while v1-8
(let ((s4-1 (-> v1-8 0 brother)))
(execute-process-tree (-> v1-8 0) arg1 arg2)
(set! v1-8 s4-1)
)
(let ((a0-6 v1-8))
)
)
@@ -1339,13 +1343,15 @@
)
)
(let ((v1-5 (-> arg0 child)))
(while v1-5 (let ((s5-1 (-> v1-5 0 brother)))
(let ((v1-6 (search-process-tree (-> v1-5 0) arg1)))
(if v1-6 (return v1-6)
)
)
(set! v1-5 s5-1)
)
(while v1-5
(let ((s5-1 (-> v1-5 0 brother)))
(let ((v1-6 (search-process-tree (-> v1-5 0) arg1)))
(if v1-6
(return v1-6)
)
)
(set! v1-5 s5-1)
)
(let ((a0-5 v1-5))
)
)
@@ -1354,10 +1360,9 @@
)
;; definition for function kernel-dispatcher
(defun
kernel-dispatcher
()
(when *listener-function* (set! *enable-method-set* (+ *enable-method-set* 1))
(defun kernel-dispatcher ()
(when *listener-function*
(set! *enable-method-set* (+ *enable-method-set* 1))
(let
((t1-0
(reset-and-call (-> *listener-process* main-thread) *listener-function*)
@@ -1498,8 +1503,7 @@
)
)
(let ((s2-1 (-> arg0 child)))
(while
s2-1
(while s2-1
(inspect-process-tree (-> s2-1 0) (+ arg1 1) (if (not (-> s2-1 0 brother))
arg2
(let* ((v1-7 1)
@@ -1547,16 +1551,18 @@
;; INFO: Return type mismatch (pointer process-tree) vs object.
(defun previous-brother ((proc process-tree))
(let ((parent (-> proc parent)))
(when parent (let ((child (-> parent 0 child)))
(if (= child proc)
(return #f)
)
(while child (if (= (-> child 0 brother) proc)
(return child)
)
(set! child (-> child 0 brother))
)
)
(when parent
(let ((child (-> parent 0 child)))
(if (= child proc)
(return #f)
)
(while child
(if (= (-> child 0 brother) proc)
(return child)
)
(set! child (-> child 0 brother))
)
)
#f
)
)
@@ -1565,32 +1571,35 @@
;; definition for function change-parent
(defun change-parent ((arg0 process-tree) (arg1 process-tree))
(let ((a2-0 (-> arg0 parent)))
(if a2-0 (let* ((v1-2 (-> a2-0 0 child))
(a3-0 v1-2)
)
(cond
((= (if a3-0 (-> a3-0 0 self)
)
(if a2-0
(let* ((v1-2 (-> a2-0 0 child))
(a3-0 v1-2)
)
(cond
((= (if a3-0
(-> a3-0 0 self)
)
arg0
)
(set! (-> a2-0 0 child) (-> arg0 brother))
)
(else
(while (let ((a2-2 (-> v1-2 0 brother)))
(!= (if a2-2
(-> a2-2 0 self)
)
arg0
)
(set! (-> a2-0 0 child) (-> arg0 brother))
)
(else
(while (let ((a2-2 (-> v1-2 0 brother)))
(!= (if a2-2 (-> a2-2 0 self)
)
arg0
)
)
(nop!)
(nop!)
(nop!)
(set! v1-2 (-> v1-2 0 brother))
)
(set! (-> v1-2 0 brother) (-> arg0 brother))
)
)
)
(nop!)
(nop!)
(nop!)
(set! v1-2 (-> v1-2 0 brother))
)
(set! (-> v1-2 0 brother) (-> arg0 brother))
)
)
)
)
)
(set! (-> arg0 parent) (-> arg1 ppointer))
@@ -1603,81 +1612,80 @@
(defun change-brother ((arg0 process-tree) (arg1 process-tree))
(if (and arg0 (!= (-> arg0 brother) arg1) (!= arg0 arg1))
(let ((a2-1 (-> arg0 parent)))
(if a2-1 (let ((t0-0 (-> a2-1 0 child))
(a3-1 (the-as (pointer process-tree) #f))
(v1-4 (the-as (pointer process-tree) #f))
)
(let ((t1-0 t0-0))
(when (= (if t1-0 (-> t1-0 0 self)
)
arg0
)
(set! a3-1 a2-1)
(let ((t1-3 a3-1))
(if a2-1
(let ((t0-0 (-> a2-1 0 child))
(a3-1 (the-as (pointer process-tree) #f))
(v1-4 (the-as (pointer process-tree) #f))
)
(let ((t1-0 t0-0))
(when (= (if t1-0
(-> t1-0 0 self)
)
)
)
(let ((t1-4 t0-0))
(when (= (if t1-4 (-> t1-4 0 self)
)
arg1
)
(set! v1-4 a2-1)
(let ((t1-7 v1-4))
)
)
)
(while (and (-> t0-0 0 brother) (or (not a3-1) (not v1-4)))
(let ((t1-8 t0-0))
(when (= (-> (if t1-8 (-> t1-8 0 self)
)
brother
)
arg1
)
(set! v1-4 t0-0)
(let ((t1-12 v1-4))
)
)
)
(let ((t1-13 t0-0))
(when (= (-> (if t1-13 (-> t1-13 0 self)
)
brother
)
arg0
)
(set! a3-1 t0-0)
(let ((t1-17 a3-1))
)
)
)
(set! t0-0 (-> t0-0 0 brother))
)
(if (or (not a3-1) (not v1-4))
(return 0)
(if (= a3-1 a2-1)
(set! (-> a3-1 4) (the-as process-tree (-> arg0 brother)))
(set! (-> a3-1 3) (the-as process-tree (-> arg0 brother)))
)
)
(cond
((= v1-4 a2-1)
(set!
(-> arg0 brother)
(the-as (pointer process-tree) (-> v1-4 4))
)
(set! (-> v1-4 4) (the-as process-tree (-> arg0 ppointer)))
)
(else
(set!
(-> arg0 brother)
(the-as (pointer process-tree) (-> v1-4 3))
)
(set! (-> v1-4 3) (the-as process-tree (-> arg0 ppointer)))
)
)
arg0
)
(set! a3-1 a2-1)
(let ((t1-3 a3-1))
)
)
)
(let ((t1-4 t0-0))
(when (= (if t1-4
(-> t1-4 0 self)
)
arg1
)
(set! v1-4 a2-1)
(let ((t1-7 v1-4))
)
)
)
(while (and (-> t0-0 0 brother) (or (not a3-1) (not v1-4)))
(let ((t1-8 t0-0))
(when (= (-> (if t1-8
(-> t1-8 0 self)
)
brother
)
arg1
)
(set! v1-4 t0-0)
(let ((t1-12 v1-4))
)
)
)
(let ((t1-13 t0-0))
(when (= (-> (if t1-13
(-> t1-13 0 self)
)
brother
)
arg0
)
(set! a3-1 t0-0)
(let ((t1-17 a3-1))
)
)
)
(set! t0-0 (-> t0-0 0 brother))
)
(if (or (not a3-1) (not v1-4))
(return 0)
(if (= a3-1 a2-1)
(set! (-> a3-1 4) (the-as process-tree (-> arg0 brother)))
(set! (-> a3-1 3) (the-as process-tree (-> arg0 brother)))
)
)
(cond
((= v1-4 a2-1)
(set! (-> arg0 brother) (the-as (pointer process-tree) (-> v1-4 4)))
(set! (-> v1-4 4) (the-as process-tree (-> arg0 ppointer)))
)
(else
(set! (-> arg0 brother) (the-as (pointer process-tree) (-> v1-4 3)))
(set! (-> v1-4 3) (the-as process-tree (-> arg0 ppointer)))
)
)
)
)
)
)
@@ -1852,12 +1860,13 @@
(let ((v0-2 (process-disconnect obj))
(v1-11 (-> obj child))
)
(while v1-11 (let ((s5-1 (-> v1-11 0 brother)))
(deactivate (-> v1-11 0))
(let ((v1-13 v0-2))
)
(set! v1-11 s5-1)
)
(while v1-11
(let ((s5-1 (-> v1-11 0 brother)))
(deactivate (-> v1-11 0))
(let ((v1-13 v0-2))
)
(set! v1-11 s5-1)
)
(let ((a0-8 v1-11))
)
)
@@ -1931,8 +1940,7 @@
)
;; failed to figure out what this is:
(if
*debug-segment*
(if *debug-segment*
(set!
*debug-dead-pool*
(new 'debug 'dead-pool-heap '*debug-dead-pool* 768 #x100000)
@@ -2011,4 +2019,4 @@
)
;; failed to figure out what this is:
(none)
(none)