[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:
water111
2021-05-12 19:46:17 -04:00
committed by GitHub
parent 3897258753
commit 129ab54fd4
24 changed files with 1304 additions and 1144 deletions
+176 -169
View File
@@ -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))
)
+65 -58
View File
@@ -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*)
)
+5 -10
View File
@@ -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)
)
+62 -53
View File
@@ -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)))