mirror of
https://github.com/open-goal/jak-project
synced 2026-09-09 04:10:23 -04:00
[decompiler] clean up if/when/cond and recognize define-perm (#472)
* clean up if and when and cond decisions * recognize define perm
This commit is contained in:
@@ -625,108 +625,110 @@
|
||||
;; Used lq/sq
|
||||
(defmethod print array ((obj array))
|
||||
(format #t "#(")
|
||||
(if (type-type? (-> obj content-type) integer)
|
||||
(let ((content-type-sym (-> obj content-type symbol)))
|
||||
(cond
|
||||
((= content-type-sym 'int32)
|
||||
(dotimes (s5-0 (-> obj length))
|
||||
(format #t (if (zero? s5-0)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int32) obj) s5-0)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint32)
|
||||
(dotimes (s5-1 (-> obj length))
|
||||
(format #t (if (zero? s5-1)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array uint32) obj) s5-1)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'int64)
|
||||
(dotimes (s5-2 (-> obj length))
|
||||
(format #t (if (zero? s5-2)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int64) obj) s5-2)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint64)
|
||||
(dotimes (s5-3 (-> obj length))
|
||||
(format #t (if (zero? s5-3)
|
||||
"#x~X"
|
||||
" #x~X"
|
||||
)
|
||||
(-> (the-as (array uint64) obj) s5-3)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'int8)
|
||||
(dotimes (s5-4 (-> obj length))
|
||||
(format #t (if (zero? s5-4)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int8) obj) s5-4)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint8)
|
||||
(dotimes (s5-5 (-> obj length))
|
||||
(format #t (if (zero? s5-5)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array uint8) obj) s5-5)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'int16)
|
||||
(dotimes (s5-6 (-> obj length))
|
||||
(format #t (if (zero? s5-6)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int16) obj) s5-6)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint16)
|
||||
(dotimes (s5-7 (-> obj length))
|
||||
(format #t (if (zero? s5-7)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array uint16) obj) s5-7)
|
||||
)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(cond
|
||||
((or (= content-type-sym 'uint128) (= content-type-sym 'int128))
|
||||
(dotimes (s5-8 (-> obj length))
|
||||
(format #t (if (zero? s5-8)
|
||||
"#x~X"
|
||||
" #x~X"
|
||||
)
|
||||
(-> (the-as (array uint128) obj) s5-8)
|
||||
)
|
||||
(cond
|
||||
((type-type? (-> obj content-type) integer)
|
||||
(let ((content-type-sym (-> obj content-type symbol)))
|
||||
(cond
|
||||
((= content-type-sym 'int32)
|
||||
(dotimes (s5-0 (-> obj length))
|
||||
(format #t (if (zero? s5-0)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int32) obj) s5-0)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(dotimes (s5-9 (-> obj length))
|
||||
(format #t (if (zero? s5-9)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int32) obj) s5-9)
|
||||
)
|
||||
((= content-type-sym 'uint32)
|
||||
(dotimes (s5-1 (-> obj length))
|
||||
(format #t (if (zero? s5-1)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array uint32) obj) s5-1)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'int64)
|
||||
(dotimes (s5-2 (-> obj length))
|
||||
(format #t (if (zero? s5-2)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int64) obj) s5-2)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint64)
|
||||
(dotimes (s5-3 (-> obj length))
|
||||
(format #t (if (zero? s5-3)
|
||||
"#x~X"
|
||||
" #x~X"
|
||||
)
|
||||
(-> (the-as (array uint64) obj) s5-3)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'int8)
|
||||
(dotimes (s5-4 (-> obj length))
|
||||
(format #t (if (zero? s5-4)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int8) obj) s5-4)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint8)
|
||||
(dotimes (s5-5 (-> obj length))
|
||||
(format #t (if (zero? s5-5)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array uint8) obj) s5-5)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'int16)
|
||||
(dotimes (s5-6 (-> obj length))
|
||||
(format #t (if (zero? s5-6)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int16) obj) s5-6)
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint16)
|
||||
(dotimes (s5-7 (-> obj length))
|
||||
(format #t (if (zero? s5-7)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array uint16) obj) s5-7)
|
||||
)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(cond
|
||||
((or (= content-type-sym 'uint128) (= content-type-sym 'int128))
|
||||
(dotimes (s5-8 (-> obj length))
|
||||
(format #t (if (zero? s5-8)
|
||||
"#x~X"
|
||||
" #x~X"
|
||||
)
|
||||
(-> (the-as (array uint128) obj) s5-8)
|
||||
)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(dotimes (s5-9 (-> obj length))
|
||||
(format #t (if (zero? s5-9)
|
||||
"~D"
|
||||
" ~D"
|
||||
)
|
||||
(-> (the-as (array int32) obj) s5-9)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -734,20 +736,22 @@
|
||||
)
|
||||
)
|
||||
)
|
||||
(cond
|
||||
((= (-> obj content-type) float)
|
||||
(dotimes (s5-10 (-> obj length))
|
||||
(if (zero? s5-10)
|
||||
(format #t "~f" (-> (the-as (array float) obj) s5-10))
|
||||
(format #t " ~f" (-> (the-as (array float) obj) s5-10))
|
||||
(else
|
||||
(cond
|
||||
((= (-> obj content-type) float)
|
||||
(dotimes (s5-10 (-> obj length))
|
||||
(if (zero? s5-10)
|
||||
(format #t "~f" (-> (the-as (array float) obj) s5-10))
|
||||
(format #t " ~f" (-> (the-as (array float) obj) s5-10))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(dotimes (s5-11 (-> obj length))
|
||||
(if (zero? s5-11)
|
||||
(format #t "~A" (-> (the-as (array basic) obj) s5-11))
|
||||
(format #t " ~A" (-> (the-as (array basic) obj) s5-11))
|
||||
(else
|
||||
(dotimes (s5-11 (-> obj length))
|
||||
(if (zero? s5-11)
|
||||
(format #t "~A" (-> (the-as (array basic) obj) s5-11))
|
||||
(format #t " ~A" (-> (the-as (array basic) obj) s5-11))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -765,79 +769,83 @@
|
||||
(format #t "~Tlength: ~D~%" (-> obj length))
|
||||
(format #t "~Tcontent-type: ~A~%" (-> obj content-type))
|
||||
(format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data))
|
||||
(if (type-type? (-> obj content-type) integer)
|
||||
(let ((content-type-sym (-> obj content-type symbol)))
|
||||
(cond
|
||||
((= content-type-sym 'int32)
|
||||
(dotimes (s5-0 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-0 (-> (the-as (array int32) obj) s5-0))
|
||||
(cond
|
||||
((type-type? (-> obj content-type) integer)
|
||||
(let ((content-type-sym (-> obj content-type symbol)))
|
||||
(cond
|
||||
((= content-type-sym 'int32)
|
||||
(dotimes (s5-0 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-0 (-> (the-as (array int32) obj) s5-0))
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint32)
|
||||
(dotimes (s5-1 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-1 (-> (the-as (array uint32) obj) s5-1))
|
||||
((= content-type-sym 'uint32)
|
||||
(dotimes (s5-1 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-1 (-> (the-as (array uint32) obj) s5-1))
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'int64)
|
||||
(dotimes (s5-2 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-2 (-> (the-as (array int64) obj) s5-2))
|
||||
((= content-type-sym 'int64)
|
||||
(dotimes (s5-2 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-2 (-> (the-as (array int64) obj) s5-2))
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint64)
|
||||
(dotimes (s5-3 (-> obj length))
|
||||
(format #t "~T [~D] #x~X~%" s5-3 (-> (the-as (array uint64) obj) s5-3))
|
||||
((= content-type-sym 'uint64)
|
||||
(dotimes (s5-3 (-> obj length))
|
||||
(format #t "~T [~D] #x~X~%" s5-3 (-> (the-as (array uint64) obj) s5-3))
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'int8)
|
||||
(dotimes (s5-4 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-4 (-> (the-as (array int8) obj) s5-4))
|
||||
((= content-type-sym 'int8)
|
||||
(dotimes (s5-4 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-4 (-> (the-as (array int8) obj) s5-4))
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint8)
|
||||
(dotimes (s5-5 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-5 (-> (the-as (array int8) obj) s5-5))
|
||||
((= content-type-sym 'uint8)
|
||||
(dotimes (s5-5 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-5 (-> (the-as (array int8) obj) s5-5))
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'int16)
|
||||
(dotimes (s5-6 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-6 (-> (the-as (array int16) obj) s5-6))
|
||||
((= content-type-sym 'int16)
|
||||
(dotimes (s5-6 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-6 (-> (the-as (array int16) obj) s5-6))
|
||||
)
|
||||
)
|
||||
)
|
||||
((= content-type-sym 'uint16)
|
||||
(dotimes (s5-7 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-7 (-> (the-as (array uint16) obj) s5-7))
|
||||
((= content-type-sym 'uint16)
|
||||
(dotimes (s5-7 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-7 (-> (the-as (array uint16) obj) s5-7))
|
||||
)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(cond
|
||||
((or (= content-type-sym 'int128) (= content-type-sym 'uint128))
|
||||
(dotimes (s5-8 (-> obj length))
|
||||
(format
|
||||
#t
|
||||
"~T [~D] #x~X~%"
|
||||
s5-8
|
||||
(-> (the-as (array uint128) obj) s5-8)
|
||||
(else
|
||||
(cond
|
||||
((or (= content-type-sym 'int128) (= content-type-sym 'uint128))
|
||||
(dotimes (s5-8 (-> obj length))
|
||||
(format
|
||||
#t
|
||||
"~T [~D] #x~X~%"
|
||||
s5-8
|
||||
(-> (the-as (array uint128) obj) s5-8)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(dotimes (s5-9 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-9 (-> (the-as (array int32) obj) s5-9))
|
||||
(else
|
||||
(dotimes (s5-9 (-> obj length))
|
||||
(format #t "~T [~D] ~D~%" s5-9 (-> (the-as (array int32) obj) s5-9))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(cond
|
||||
((= (-> obj content-type) float)
|
||||
(dotimes (s5-10 (-> obj length))
|
||||
(format #t "~T [~D] ~f~%" s5-10 (-> (the-as (array float) obj) s5-10))
|
||||
(else
|
||||
(cond
|
||||
((= (-> obj content-type) float)
|
||||
(dotimes (s5-10 (-> obj length))
|
||||
(format #t "~T [~D] ~f~%" s5-10 (-> (the-as (array float) obj) s5-10))
|
||||
)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(dotimes (s5-11 (-> obj length))
|
||||
(format #t "~T [~D] ~A~%" s5-11 (-> (the-as (array basic) obj) s5-11))
|
||||
(else
|
||||
(dotimes (s5-11 (-> obj length))
|
||||
(format #t "~T [~D] ~A~%" s5-11 (-> (the-as (array basic) obj) s5-11))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -1291,4 +1299,3 @@
|
||||
;; failed to figure out what this is:
|
||||
(let ((v0-3 0))
|
||||
)
|
||||
|
||||
|
||||
@@ -289,26 +289,30 @@
|
||||
;; WARN: Unsupported inline assembly instruction kind - [sllv a2, v1, r0]
|
||||
(defmethod print handle ((obj handle))
|
||||
(local-vars (r0-0 none) (a2-0 int) (a2-2 (pointer process)) (s7-0 none))
|
||||
(if (nonzero? obj)
|
||||
(let ((t9-0 format)
|
||||
(a0-1 #t)
|
||||
(a1-0 "#<handle :process ~A :pid ~D>")
|
||||
(v1-0 obj)
|
||||
)
|
||||
(.subu a2-0 v1-0 s7-0)
|
||||
(t9-0 a0-1 a1-0 (and (nonzero? a2-0) (begin
|
||||
(.sllv a2-2 v1-0 r0-0)
|
||||
(let ((a3-0 (-> a2-2 0)))
|
||||
(if (= (-> v1-0 pid) (-> a3-0 pid))
|
||||
a3-0
|
||||
(cond
|
||||
((nonzero? obj)
|
||||
(let ((t9-0 format)
|
||||
(a0-1 #t)
|
||||
(a1-0 "#<handle :process ~A :pid ~D>")
|
||||
(v1-0 obj)
|
||||
)
|
||||
(.subu a2-0 v1-0 s7-0)
|
||||
(t9-0 a0-1 a1-0 (and (nonzero? a2-0) (begin
|
||||
(.sllv a2-2 v1-0 r0-0)
|
||||
(let ((a3-0 (-> a2-2 0)))
|
||||
(if (= (-> v1-0 pid) (-> a3-0 pid))
|
||||
a3-0
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(-> obj pid)
|
||||
)
|
||||
(-> obj pid)
|
||||
)
|
||||
)
|
||||
)
|
||||
(format #t "#<handle :process 0 :pid 0>")
|
||||
(else
|
||||
(format #t "#<handle :process 0 :pid 0>")
|
||||
)
|
||||
)
|
||||
obj
|
||||
)
|
||||
@@ -370,5 +374,3 @@
|
||||
;; failed to figure out what this is:
|
||||
(let ((v0-11 0))
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -157,30 +157,34 @@
|
||||
(arg2 int)
|
||||
(arg3 pointer)
|
||||
)
|
||||
(let ((obj (the-as cpu-thread (if (-> arg0 top-thread)
|
||||
(&+ arg3 -7164)
|
||||
(let
|
||||
((v1-2
|
||||
(logand
|
||||
-16
|
||||
(the-as int (&+ (-> arg0 heap-cur) 15))
|
||||
)
|
||||
)
|
||||
)
|
||||
(set!
|
||||
(-> arg0 heap-cur)
|
||||
(the-as
|
||||
pointer
|
||||
(+
|
||||
(+
|
||||
v1-2
|
||||
(the-as int (-> type-to-make size))
|
||||
(let ((obj (the-as cpu-thread (cond
|
||||
((-> arg0 top-thread)
|
||||
(&+ arg3 -7164)
|
||||
)
|
||||
(else
|
||||
(let
|
||||
((v1-2
|
||||
(logand
|
||||
-16
|
||||
(the-as int (&+ (-> arg0 heap-cur) 15))
|
||||
)
|
||||
arg2
|
||||
)
|
||||
)
|
||||
(set!
|
||||
(-> arg0 heap-cur)
|
||||
(the-as
|
||||
pointer
|
||||
(+
|
||||
(+
|
||||
v1-2
|
||||
(the-as int (-> type-to-make size))
|
||||
)
|
||||
arg2
|
||||
)
|
||||
)
|
||||
)
|
||||
(+ v1-2 4)
|
||||
)
|
||||
(+ v1-2 4)
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -209,7 +213,7 @@
|
||||
;; definition for function remove-exit
|
||||
(defun remove-exit ()
|
||||
(local-vars (pp process))
|
||||
(if (-> pp stack-frame-top)
|
||||
(when (-> pp stack-frame-top)
|
||||
(let ((v0-0 (-> pp stack-frame-top next)))
|
||||
(set! (-> pp stack-frame-top) v0-0)
|
||||
v0-0
|
||||
@@ -591,7 +595,7 @@
|
||||
(!= obj *debug-dead-pool*)
|
||||
)
|
||||
(set! s4-0 (get-process *debug-dead-pool* arg0 arg1))
|
||||
(if (the-as process s4-0)
|
||||
(when (the-as process s4-0)
|
||||
(let ((t9-1 format)
|
||||
(a0-2 0)
|
||||
(a1-2
|
||||
@@ -720,26 +724,30 @@
|
||||
gap-size
|
||||
dead-pool-heap
|
||||
((obj dead-pool-heap) (arg0 dead-pool-heap-rec))
|
||||
(if (-> arg0 process)
|
||||
(let
|
||||
((v1-3
|
||||
(&+
|
||||
(&+ (the-as pointer (-> arg0 process)) (-> process size))
|
||||
(-> arg0 process allocated-length)
|
||||
(cond
|
||||
((-> arg0 process)
|
||||
(let
|
||||
((v1-3
|
||||
(&+
|
||||
(&+ (the-as pointer (-> arg0 process)) (-> process size))
|
||||
(-> arg0 process allocated-length)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (-> arg0 next)
|
||||
(&- (the-as pointer (-> arg0 next process)) (the-as uint v1-3))
|
||||
(&- (-> obj heap top) (the-as uint (&+ v1-3 4)))
|
||||
(if (-> arg0 next)
|
||||
(&- (the-as pointer (-> arg0 next process)) (the-as uint v1-3))
|
||||
(&- (-> obj heap top) (the-as uint (&+ v1-3 4)))
|
||||
)
|
||||
)
|
||||
)
|
||||
(if (-> arg0 next)
|
||||
(&-
|
||||
(the-as pointer (-> arg0 next process))
|
||||
(the-as uint (&+ (-> obj heap base) 4))
|
||||
(else
|
||||
(if (-> arg0 next)
|
||||
(&-
|
||||
(the-as pointer (-> arg0 next process))
|
||||
(the-as uint (&+ (-> obj heap base) 4))
|
||||
)
|
||||
(&- (-> obj heap top) (the-as uint (-> obj heap base)))
|
||||
)
|
||||
(&- (-> obj heap top) (the-as uint (-> obj heap base)))
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -973,7 +981,7 @@
|
||||
)
|
||||
(when (= (-> obj first-shrink) s5-1)
|
||||
(set! (-> obj first-shrink) (the-as dead-pool-heap-rec (-> s5-1 1)))
|
||||
(when (not (-> obj first-shrink process))
|
||||
(if (not (-> obj first-shrink process))
|
||||
(set! (-> obj first-shrink) #f)
|
||||
)
|
||||
)
|
||||
@@ -993,7 +1001,7 @@
|
||||
|
||||
;; definition for method 17 of type dead-pool-heap
|
||||
(defmethod shrink-heap dead-pool-heap ((obj dead-pool-heap) (arg0 process))
|
||||
(if arg0
|
||||
(when arg0
|
||||
(let ((s5-0 (-> arg0 ppointer)))
|
||||
(when
|
||||
(not
|
||||
@@ -1058,7 +1066,7 @@
|
||||
)
|
||||
)
|
||||
(let ((s4-1 (-> obj first-gap)))
|
||||
(if (-> s4-1 next)
|
||||
(when (-> s4-1 next)
|
||||
(let ((s3-0 (-> s4-1 next process))
|
||||
(s2-0 (gap-size obj s4-1))
|
||||
)
|
||||
@@ -1101,7 +1109,7 @@
|
||||
)
|
||||
(when (= (-> obj first-shrink) s4-0)
|
||||
(set! (-> obj first-shrink) (-> s4-0 prev))
|
||||
(when (not (-> obj first-shrink process))
|
||||
(if (not (-> obj first-shrink process))
|
||||
(set! (-> obj first-shrink) #f)
|
||||
)
|
||||
)
|
||||
@@ -1323,7 +1331,7 @@
|
||||
(defun
|
||||
search-process-tree
|
||||
((arg0 process-tree) (arg1 (function process-tree object)))
|
||||
(if (zero? (logand (-> arg0 mask) (process-mask process-tree)))
|
||||
(when (zero? (logand (-> arg0 mask) (process-mask process-tree)))
|
||||
(if (arg1 arg0)
|
||||
(return arg0)
|
||||
)
|
||||
@@ -1562,7 +1570,7 @@
|
||||
;; definition for function change-parent
|
||||
(defun change-parent ((arg0 process-tree) (arg1 process-tree))
|
||||
(let ((a2-0 (-> arg0 parent)))
|
||||
(if a2-0
|
||||
(when a2-0
|
||||
(let* ((v1-2 (-> a2-0 0 child))
|
||||
(a3-0 v1-2)
|
||||
)
|
||||
@@ -1601,9 +1609,9 @@
|
||||
|
||||
;; definition for function change-brother
|
||||
(defun change-brother ((arg0 process-tree) (arg1 process-tree))
|
||||
(if (and arg0 (!= (-> arg0 brother) arg1) (!= arg0 arg1))
|
||||
(when (and arg0 (!= (-> arg0 brother) arg1) (!= arg0 arg1))
|
||||
(let ((a2-1 (-> arg0 parent)))
|
||||
(if a2-1
|
||||
(when 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))
|
||||
@@ -1651,11 +1659,15 @@
|
||||
)
|
||||
(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
|
||||
((or (not a3-1) (not v1-4))
|
||||
(return 0)
|
||||
)
|
||||
(else
|
||||
(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
|
||||
@@ -1741,13 +1753,9 @@
|
||||
(set! (-> obj event-hook) #f)
|
||||
(set! (-> obj state) #f)
|
||||
(set! (-> obj next-state) #f)
|
||||
(cond
|
||||
((nonzero? (logand (-> arg0 mask) (process-mask process-tree)))
|
||||
(set! (-> obj entity) #f)
|
||||
)
|
||||
(else
|
||||
(set! (-> obj entity) (-> (the-as process arg0) entity))
|
||||
)
|
||||
(if (nonzero? (logand (-> arg0 mask) (process-mask process-tree)))
|
||||
(set! (-> obj entity) #f)
|
||||
(set! (-> obj entity) (-> (the-as process arg0) entity))
|
||||
)
|
||||
(set! (-> obj connection-list next1) #f)
|
||||
(set! (-> obj connection-list prev1) #f)
|
||||
@@ -2004,4 +2012,3 @@
|
||||
(set! *default-pool* a0-63)
|
||||
(gp-5 a0-63 *active-pool*)
|
||||
)
|
||||
|
||||
|
||||
@@ -106,13 +106,9 @@
|
||||
(set! (-> pp mask) (logand (lognot (process-mask going)) (-> pp mask)))
|
||||
(let ((s0-2 (-> pp state)))
|
||||
(set! (-> pp event-hook) (-> s0-2 event))
|
||||
(cond
|
||||
((-> s0-2 exit)
|
||||
(set! (-> pp stack-frame-top) s0-2)
|
||||
)
|
||||
(else
|
||||
(set! (-> pp stack-frame-top) #f)
|
||||
)
|
||||
(if (-> s0-2 exit)
|
||||
(set! (-> pp stack-frame-top) s0-2)
|
||||
(set! (-> pp stack-frame-top) #f)
|
||||
)
|
||||
(set! (-> pp post-hook) (-> s0-2 post))
|
||||
(set! (-> pp trans-hook) (-> s0-2 trans))
|
||||
@@ -139,7 +135,7 @@
|
||||
(else
|
||||
(set! (-> pp trans-hook) #f)
|
||||
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
|
||||
(if (!= (-> pp top-thread name) 'post)
|
||||
(when (!= (-> pp top-thread name) 'post)
|
||||
(let ((v0-2 (the-as object return-from-thread)))
|
||||
(.sw (the-as (function none) v0-2) 0 sp-0)
|
||||
v0-2
|
||||
@@ -151,7 +147,7 @@
|
||||
|
||||
;; definition for function send-event-function
|
||||
(defun send-event-function ((arg0 process) (arg1 event-message-block))
|
||||
(if (and arg0 (!= (-> arg0 type) process-tree) (-> arg0 event-hook))
|
||||
(when (and arg0 (!= (-> arg0 type) process-tree) (-> arg0 event-hook))
|
||||
(let ((gp-0 pp))
|
||||
(let ((s6-1 arg0))
|
||||
)
|
||||
@@ -181,4 +177,3 @@
|
||||
)
|
||||
(the-as symbol #f)
|
||||
)
|
||||
|
||||
|
||||
@@ -39,30 +39,34 @@
|
||||
new
|
||||
string
|
||||
((allocation symbol) (type-to-make type) (arg0 int) (arg1 string))
|
||||
(if arg1
|
||||
(let* ((s2-1 (max ((method-of-type string length) arg1) arg0))
|
||||
(a0-4
|
||||
(object-new
|
||||
allocation
|
||||
type-to-make
|
||||
(+ (+ s2-1 1) (the-as int (-> type-to-make size)))
|
||||
(cond
|
||||
(arg1
|
||||
(let* ((s2-1 (max ((method-of-type string length) arg1) arg0))
|
||||
(a0-4
|
||||
(object-new
|
||||
allocation
|
||||
type-to-make
|
||||
(+ (+ s2-1 1) (the-as int (-> type-to-make size)))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(set! (-> a0-4 allocated-length) s2-1)
|
||||
(copy-string<-string a0-4 arg1)
|
||||
(set! (-> a0-4 allocated-length) s2-1)
|
||||
(copy-string<-string a0-4 arg1)
|
||||
)
|
||||
)
|
||||
(let
|
||||
((v0-2
|
||||
(object-new
|
||||
allocation
|
||||
type-to-make
|
||||
(+ (+ arg0 1) (the-as int (-> type-to-make size)))
|
||||
(else
|
||||
(let
|
||||
((v0-2
|
||||
(object-new
|
||||
allocation
|
||||
type-to-make
|
||||
(+ (+ arg0 1) (the-as int (-> type-to-make size)))
|
||||
)
|
||||
)
|
||||
)
|
||||
(set! (-> v0-2 allocated-length) arg0)
|
||||
v0-2
|
||||
)
|
||||
(set! (-> v0-2 allocated-length) arg0)
|
||||
v0-2
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -562,35 +566,38 @@
|
||||
(>= (the-as uint 102) (-> next-char-2 0))
|
||||
)
|
||||
)
|
||||
(if
|
||||
(and
|
||||
(>= (-> next-char-2 0) (the-as uint 65))
|
||||
(>= (the-as uint 70) (-> next-char-2 0))
|
||||
)
|
||||
(set!
|
||||
result
|
||||
(the-as
|
||||
int
|
||||
(+ (+ (-> next-char-2 0) -55) (the-as uint (shl result 4)))
|
||||
)
|
||||
)
|
||||
(if
|
||||
(and
|
||||
(>= (-> next-char-2 0) (the-as uint 97))
|
||||
(>= (the-as uint 102) (-> next-char-2 0))
|
||||
(cond
|
||||
((and
|
||||
(>= (-> next-char-2 0) (the-as uint 65))
|
||||
(>= (the-as uint 70) (-> next-char-2 0))
|
||||
)
|
||||
(set!
|
||||
result
|
||||
(the-as
|
||||
int
|
||||
(+ (+ (-> next-char-2 0) -87) (the-as uint (shl result 4)))
|
||||
(+ (+ (-> next-char-2 0) -55) (the-as uint (shl result 4)))
|
||||
)
|
||||
)
|
||||
(set!
|
||||
result
|
||||
(the-as
|
||||
int
|
||||
(+ (+ (-> next-char-2 0) -48) (the-as uint (shl result 4)))
|
||||
)
|
||||
(else
|
||||
(if
|
||||
(and
|
||||
(>= (-> next-char-2 0) (the-as uint 97))
|
||||
(>= (the-as uint 102) (-> next-char-2 0))
|
||||
)
|
||||
(set!
|
||||
result
|
||||
(the-as
|
||||
int
|
||||
(+ (+ (-> next-char-2 0) -87) (the-as uint (shl result 4)))
|
||||
)
|
||||
)
|
||||
(set!
|
||||
result
|
||||
(the-as
|
||||
int
|
||||
(+ (+ (-> next-char-2 0) -48) (the-as uint (shl result 4)))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -687,20 +694,24 @@
|
||||
(first-flag string)
|
||||
(second-flag string)
|
||||
)
|
||||
(if (string-get-arg!! *string-tmp-str* in)
|
||||
(cond
|
||||
((or
|
||||
(string= *string-tmp-str* first-flag)
|
||||
(string= *string-tmp-str* second-flag)
|
||||
(cond
|
||||
((string-get-arg!! *string-tmp-str* in)
|
||||
(cond
|
||||
((or
|
||||
(string= *string-tmp-str* first-flag)
|
||||
(string= *string-tmp-str* second-flag)
|
||||
)
|
||||
(set! (-> result 0) (string= *string-tmp-str* first-flag))
|
||||
#t
|
||||
)
|
||||
(else
|
||||
#f
|
||||
)
|
||||
(set! (-> result 0) (string= *string-tmp-str* first-flag))
|
||||
#t
|
||||
)
|
||||
(else
|
||||
#f
|
||||
)
|
||||
)
|
||||
#f
|
||||
(else
|
||||
#f
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -718,5 +729,3 @@
|
||||
|
||||
;; definition for symbol *temp-string*, type string
|
||||
(define *temp-string* (new 'global 'string 256 (the-as string #f)))
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user