mirror of
https://github.com/open-goal/jak-project
synced 2026-05-25 07:23:19 -04:00
ManDude
cd68cb671e
Major change to how `deftype` shows up in our code: - the decompiler will no longer emit the `offset-assert`, `method-count-assert`, `size-assert` and `flag-assert` parameters. There are extremely few cases where having this in the decompiled code is helpful, as the types there come from `all-types` which already has those parameters. This also doesn't break type consistency because: - the asserts aren't compared. - the first step of the test uses `all-types`, which has the asserts, which will throw an error if they're bad. - the decompiler won't emit the `heap-base` parameter unless necessary now. - the decompiler will try its hardest to turn a fixed-offset field into an `overlay-at` field. It falls back to the old offset if all else fails. - `overlay-at` now supports field "dereferencing" to specify the offset that's within a field that's a structure, e.g.: ```lisp (deftype foobar (structure) ((vec vector :inline) (flags int32 :overlay-at (-> vec w)) ) ) ``` in this structure, the offset of `flags` will be 12 because that is the final offset of `vec`'s `w` field within this structure. - **removed ID from all method declarations.** IDs are only ever automatically assigned now. Fixes #3068. - added an `:overlay` parameter to method declarations, in order to declare a new method that goes on top of a previously-defined method. Syntax is `:overlay <method-name>`. Please do not ever use this. - added `state-methods` list parameter. This lets you quickly specify a list of states to be put in the method table. Same syntax as the `states` list parameter. The decompiler will try to put as many states in this as it can without messing with the method ID order. Also changes `defmethod` to make the first type definition (before the arguments) optional. The type can now be inferred from the first argument. Fixes #3093. --------- Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
1118 lines
28 KiB
Common Lisp
Vendored
Generated
1118 lines
28 KiB
Common Lisp
Vendored
Generated
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; definition for function identity
|
|
(defun identity ((this object))
|
|
this
|
|
)
|
|
|
|
;; definition for function 1/
|
|
(defun 1/ ((x float))
|
|
(/ 1.0 x)
|
|
)
|
|
|
|
;; definition for function +
|
|
(defun + ((x int) (y int))
|
|
(+ x y)
|
|
)
|
|
|
|
;; definition for function -
|
|
(defun - ((x int) (y int))
|
|
(- x y)
|
|
)
|
|
|
|
;; definition for function *
|
|
(defun * ((x int) (y int))
|
|
(* x y)
|
|
)
|
|
|
|
;; definition for function /
|
|
(defun / ((x int) (y int))
|
|
(/ x y)
|
|
)
|
|
|
|
;; definition for function ash
|
|
(defun ash ((value int) (shift-amount int))
|
|
(ash value shift-amount)
|
|
)
|
|
|
|
;; definition for function mod
|
|
(defun mod ((x int) (y int))
|
|
(mod x y)
|
|
)
|
|
|
|
;; definition for function rem
|
|
(defun rem ((x int) (y int))
|
|
(mod x y)
|
|
)
|
|
|
|
;; definition for function abs
|
|
(defun abs ((x int))
|
|
(abs x)
|
|
)
|
|
|
|
;; definition for function min
|
|
(defun min ((x int) (y int))
|
|
(min x y)
|
|
)
|
|
|
|
;; definition for function max
|
|
(defun max ((x int) (y int))
|
|
(max x y)
|
|
)
|
|
|
|
;; definition for function logior
|
|
(defun logior ((x int) (y int))
|
|
(logior x y)
|
|
)
|
|
|
|
;; definition for function logand
|
|
(defun logand ((x int) (y int))
|
|
(logand x y)
|
|
)
|
|
|
|
;; definition for function lognor
|
|
(defun lognor ((x int) (y int))
|
|
(lognor x y)
|
|
)
|
|
|
|
;; definition for function logxor
|
|
(defun logxor ((x int) (y int))
|
|
(logxor x y)
|
|
)
|
|
|
|
;; definition for function lognot
|
|
(defun lognot ((x int))
|
|
(lognot x)
|
|
)
|
|
|
|
;; definition for function false-func
|
|
(defun false-func ()
|
|
#f
|
|
)
|
|
|
|
;; definition for function true-func
|
|
(defun true-func ()
|
|
#t
|
|
)
|
|
|
|
;; definition for symbol format, type (function _varargs_ object)
|
|
(define format _format)
|
|
|
|
;; definition of type vec4s
|
|
(deftype vec4s (uint128)
|
|
((x float :offset 0 :size 32)
|
|
(y float :offset 32 :size 32)
|
|
(z float :offset 64 :size 32)
|
|
(w float :offset 96 :size 32)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type vec4s
|
|
(defmethod inspect ((this vec4s))
|
|
(format #t "[~8x] ~A~%" this 'vec4s)
|
|
(format #t "~Tx: ~f~%" (-> this x))
|
|
(format #t "~Ty: ~f~%" (-> this y))
|
|
(format #t "~Tz: ~f~%" (-> this z))
|
|
(format #t "~Tw: ~f~%" (-> this w))
|
|
this
|
|
)
|
|
|
|
;; definition for method 2 of type vec4s
|
|
(defmethod print ((this vec4s))
|
|
(format #t "#<vector ~F ~F ~F ~F @ #x~X>" (-> this x) (-> this y) (-> this z) (-> this w) this)
|
|
this
|
|
)
|
|
|
|
;; definition of type bfloat
|
|
(deftype bfloat (basic)
|
|
((data float)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type bfloat
|
|
(defmethod inspect ((this bfloat))
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~Tdata: ~f~%" (-> this data))
|
|
this
|
|
)
|
|
|
|
;; definition for method 2 of type bfloat
|
|
(defmethod print ((this bfloat))
|
|
(format #t "~f" (-> this data))
|
|
this
|
|
)
|
|
|
|
;; definition for method 5 of type type
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of ((this type))
|
|
(the-as int (logand (the-as uint #xfffffff0) (+ (* (-> this allocated-length) 4) 43)))
|
|
)
|
|
|
|
;; definition for function basic-type?
|
|
(defun basic-type? ((this basic) (parent-type type))
|
|
(let ((obj-type (-> this type))
|
|
(end-type object)
|
|
)
|
|
(until (= obj-type end-type)
|
|
(if (= obj-type parent-type)
|
|
(return #t)
|
|
)
|
|
(set! obj-type (-> obj-type parent))
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
;; definition for function type-type?
|
|
(defun type-type? ((child-type type) (parent-type type))
|
|
(let ((end-type object))
|
|
(until (or (= child-type end-type) (zero? child-type))
|
|
(if (= child-type parent-type)
|
|
(return #t)
|
|
)
|
|
(set! child-type (-> child-type parent))
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
;; definition for function find-parent-method
|
|
(defun find-parent-method ((child-type type) (method-id int))
|
|
(local-vars (current-method function))
|
|
(let ((original-method (-> child-type method-table method-id)))
|
|
(until (!= current-method original-method)
|
|
(if (= child-type object)
|
|
(return nothing)
|
|
)
|
|
(set! child-type (-> child-type parent))
|
|
(set! current-method (-> child-type method-table method-id))
|
|
(if (zero? current-method)
|
|
(return nothing)
|
|
)
|
|
)
|
|
)
|
|
current-method
|
|
)
|
|
|
|
;; definition for function ref
|
|
(defun ref ((lst object) (index int))
|
|
(dotimes (count index)
|
|
(nop!)
|
|
(nop!)
|
|
(set! lst (cdr lst))
|
|
)
|
|
(car lst)
|
|
)
|
|
|
|
;; definition for method 4 of type pair
|
|
(defmethod length ((this pair))
|
|
(local-vars (result int))
|
|
(cond
|
|
((null? this)
|
|
(set! result 0)
|
|
)
|
|
(else
|
|
(let ((iter (cdr this)))
|
|
(set! result 1)
|
|
(while (and (not (null? iter)) (pair? iter))
|
|
(+! result 1)
|
|
(set! iter (cdr iter))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
result
|
|
)
|
|
|
|
;; definition for method 5 of type pair
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of ((this pair))
|
|
(the-as int (-> pair size))
|
|
)
|
|
|
|
;; definition for function last
|
|
(defun last ((lst object))
|
|
(let ((iter lst))
|
|
(while (not (null? (cdr iter)))
|
|
(nop!)
|
|
(nop!)
|
|
(set! iter (cdr iter))
|
|
)
|
|
iter
|
|
)
|
|
)
|
|
|
|
;; definition for function member
|
|
(defun member ((this object) (lst object))
|
|
(let ((iter lst))
|
|
(while (not (or (null? iter) (= (car iter) this)))
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (not (null? iter))
|
|
iter
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function nmember
|
|
(defun nmember ((this basic) (lst object))
|
|
(while (not (or (null? lst) (name= (the-as basic (car lst)) this)))
|
|
(set! lst (cdr lst))
|
|
)
|
|
(if (not (null? lst))
|
|
lst
|
|
)
|
|
)
|
|
|
|
;; definition for function assoc
|
|
(defun assoc ((item object) (alist object))
|
|
(let ((iter alist))
|
|
(while (not (or (null? iter) (= (car (car iter)) item)))
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (not (null? iter))
|
|
(car iter)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function assoce
|
|
(defun assoce ((item object) (alist object))
|
|
(let ((iter alist))
|
|
(while (not (or (null? iter) (= (car (car iter)) item) (= (car (car iter)) 'else)))
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (not (null? iter))
|
|
(car iter)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function nassoc
|
|
(defun nassoc ((item-name string) (alist object))
|
|
(while (not (or (null? alist) (let ((key (car (car alist))))
|
|
(if (pair? key)
|
|
(nmember item-name key)
|
|
(name= (the-as basic key) item-name)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! alist (cdr alist))
|
|
)
|
|
(if (not (null? alist))
|
|
(car alist)
|
|
)
|
|
)
|
|
|
|
;; definition for function nassoce
|
|
(defun nassoce ((item-name string) (alist object))
|
|
(while (not (or (null? alist) (let ((key (car (car alist))))
|
|
(if (pair? key)
|
|
(nmember item-name key)
|
|
(or (name= (the-as basic key) item-name) (= key 'else))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! alist (cdr alist))
|
|
)
|
|
(if (not (null? alist))
|
|
(car alist)
|
|
)
|
|
)
|
|
|
|
;; definition for function append!
|
|
(defun append! ((front object) (back object))
|
|
(cond
|
|
((null? front)
|
|
back
|
|
)
|
|
(else
|
|
(let ((iter front))
|
|
(while (not (null? (cdr iter)))
|
|
(nop!)
|
|
(nop!)
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (not (null? iter))
|
|
(set! (cdr iter) back)
|
|
)
|
|
)
|
|
front
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function delete!
|
|
;; INFO: Return type mismatch object vs pair.
|
|
(defun delete! ((item object) (lst object))
|
|
(the-as pair (cond
|
|
((= item (car lst))
|
|
(cdr lst)
|
|
)
|
|
(else
|
|
(let ((iter-prev lst)
|
|
(iter (cdr lst))
|
|
)
|
|
(while (not (or (null? iter) (= (car iter) item)))
|
|
(set! iter-prev iter)
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (not (null? iter))
|
|
(set! (cdr iter-prev) (cdr iter))
|
|
)
|
|
)
|
|
lst
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function delete-car!
|
|
(defun delete-car! ((item object) (lst object))
|
|
(cond
|
|
((= item (car (car lst)))
|
|
(cdr lst)
|
|
)
|
|
(else
|
|
(let ((iter-prev lst)
|
|
(iter (cdr lst))
|
|
)
|
|
(while (not (or (null? iter) (= (car (car iter)) item)))
|
|
(set! iter-prev iter)
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (not (null? iter))
|
|
(set! (cdr iter-prev) (cdr iter))
|
|
)
|
|
)
|
|
lst
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function insert-cons!
|
|
(defun insert-cons! ((kv object) (alist object))
|
|
(let ((updated-list (delete-car! (car kv) alist)))
|
|
(cons kv updated-list)
|
|
)
|
|
)
|
|
|
|
;; definition for function sort
|
|
(defun sort ((lst pair) (compare-func (function object object object)))
|
|
(let ((unsorted-count -1))
|
|
(while (nonzero? unsorted-count)
|
|
(set! unsorted-count 0)
|
|
(let ((iter lst))
|
|
(while (not (or (null? (cdr iter)) (not (pair? (cdr iter)))))
|
|
(let* ((first-elt (car iter))
|
|
(second-elt (car (cdr iter)))
|
|
(compare-result (compare-func first-elt second-elt))
|
|
)
|
|
(when (and (or (not compare-result) (> (the-as int compare-result) 0)) (!= compare-result #t))
|
|
(+! unsorted-count 1)
|
|
(set! (car iter) second-elt)
|
|
(set! (car (cdr iter)) first-elt)
|
|
)
|
|
)
|
|
(set! iter (cdr iter))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
lst
|
|
)
|
|
|
|
;; definition of type inline-array-class
|
|
(deftype inline-array-class (basic)
|
|
((length int32)
|
|
(allocated-length int32)
|
|
(_data uint8 :dynamic :offset 16)
|
|
)
|
|
(:methods
|
|
(new (symbol type int) _type_)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type inline-array-class
|
|
(defmethod inspect ((this inline-array-class))
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~Tlength: ~D~%" (-> this length))
|
|
(format #t "~Tallocated-length: ~D~%" (-> this allocated-length))
|
|
this
|
|
)
|
|
|
|
;; definition for method 0 of type inline-array-class
|
|
(defmethod new inline-array-class ((allocation symbol) (type-to-make type) (size int))
|
|
(let ((this (object-new
|
|
allocation
|
|
type-to-make
|
|
(the-as int (+ (-> type-to-make size) (* (the-as uint size) (-> type-to-make heap-base))))
|
|
)
|
|
)
|
|
)
|
|
(when (nonzero? this)
|
|
(set! (-> this length) size)
|
|
(set! (-> this allocated-length) size)
|
|
)
|
|
this
|
|
)
|
|
)
|
|
|
|
;; definition for method 4 of type inline-array-class
|
|
(defmethod length ((this inline-array-class))
|
|
(-> this length)
|
|
)
|
|
|
|
;; definition for method 5 of type inline-array-class
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of ((this inline-array-class))
|
|
(the-as int (+ (-> this type size) (* (-> this allocated-length) (the-as int (-> this type heap-base)))))
|
|
)
|
|
|
|
;; definition for method 0 of type array
|
|
(defmethod new array ((allocation symbol) (type-to-make type) (content-type type) (len int))
|
|
(let ((this (object-new
|
|
allocation
|
|
type-to-make
|
|
(the-as int (+ (-> type-to-make size) (* len (if (type-type? content-type number)
|
|
(the-as int (-> content-type size))
|
|
4
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> this allocated-length) len)
|
|
(set! (-> this length) len)
|
|
(set! (-> this content-type) content-type)
|
|
this
|
|
)
|
|
)
|
|
|
|
;; definition for method 2 of type array
|
|
;; INFO: Used lq/sq
|
|
(defmethod print ((this array))
|
|
(format #t "#(")
|
|
(cond
|
|
((type-type? (-> this content-type) integer)
|
|
(case (-> this content-type symbol)
|
|
(('int32)
|
|
(dotimes (s5-0 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-0)
|
|
"~D"
|
|
" ~D"
|
|
)
|
|
(-> (the-as (array int32) this) s5-0)
|
|
)
|
|
)
|
|
)
|
|
(('uint32)
|
|
(dotimes (s5-1 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-1)
|
|
"~D"
|
|
" ~D"
|
|
)
|
|
(-> (the-as (array uint32) this) s5-1)
|
|
)
|
|
)
|
|
)
|
|
(('int64)
|
|
(dotimes (s5-2 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-2)
|
|
"~D"
|
|
" ~D"
|
|
)
|
|
(-> (the-as (array int64) this) s5-2)
|
|
)
|
|
)
|
|
)
|
|
(('uint64)
|
|
(dotimes (s5-3 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-3)
|
|
"#x~X"
|
|
" #x~X"
|
|
)
|
|
(-> (the-as (array uint64) this) s5-3)
|
|
)
|
|
)
|
|
)
|
|
(('int8)
|
|
(dotimes (s5-4 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-4)
|
|
"~D"
|
|
" ~D"
|
|
)
|
|
(-> (the-as (array int8) this) s5-4)
|
|
)
|
|
)
|
|
)
|
|
(('uint8)
|
|
(dotimes (s5-5 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-5)
|
|
"~D"
|
|
" ~D"
|
|
)
|
|
(-> (the-as (array uint8) this) s5-5)
|
|
)
|
|
)
|
|
)
|
|
(('int16)
|
|
(dotimes (s5-6 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-6)
|
|
"~D"
|
|
" ~D"
|
|
)
|
|
(-> (the-as (array int16) this) s5-6)
|
|
)
|
|
)
|
|
)
|
|
(('uint16)
|
|
(dotimes (s5-7 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-7)
|
|
"~D"
|
|
" ~D"
|
|
)
|
|
(-> (the-as (array uint16) this) s5-7)
|
|
)
|
|
)
|
|
)
|
|
(('uint128 'int128)
|
|
(dotimes (s5-8 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-8)
|
|
"#x~X"
|
|
" #x~X"
|
|
)
|
|
(-> (the-as (array uint128) this) s5-8)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(dotimes (s5-9 (-> this length))
|
|
(format
|
|
#t
|
|
(if (zero? s5-9)
|
|
"~D"
|
|
" ~D"
|
|
)
|
|
(-> (the-as (array int32) this) s5-9)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= (-> this content-type) float)
|
|
(dotimes (s5-10 (-> this length))
|
|
(if (zero? s5-10)
|
|
(format #t "~f" (-> (the-as (array float) this) s5-10))
|
|
(format #t " ~f" (-> (the-as (array float) this) s5-10))
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(dotimes (s5-11 (-> this length))
|
|
(if (zero? s5-11)
|
|
(format #t "~A" (-> (the-as (array basic) this) s5-11))
|
|
(format #t " ~A" (-> (the-as (array basic) this) s5-11))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(format #t ")")
|
|
this
|
|
)
|
|
|
|
;; definition for method 3 of type array
|
|
;; INFO: Used lq/sq
|
|
(defmethod inspect ((this array))
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~Tallocated-length: ~D~%" (-> this allocated-length))
|
|
(format #t "~Tlength: ~D~%" (-> this length))
|
|
(format #t "~Tcontent-type: ~A~%" (-> this content-type))
|
|
(format #t "~Tdata[~D]: @ #x~X~%" (-> this allocated-length) (-> this data))
|
|
(cond
|
|
((type-type? (-> this content-type) integer)
|
|
(case (-> this content-type symbol)
|
|
(('int32)
|
|
(dotimes (s5-0 (-> this length))
|
|
(format #t "~T [~D] ~D~%" s5-0 (-> (the-as (array int32) this) s5-0))
|
|
)
|
|
)
|
|
(('uint32)
|
|
(dotimes (s5-1 (-> this length))
|
|
(format #t "~T [~D] ~D~%" s5-1 (-> (the-as (array uint32) this) s5-1))
|
|
)
|
|
)
|
|
(('int64)
|
|
(dotimes (s5-2 (-> this length))
|
|
(format #t "~T [~D] ~D~%" s5-2 (-> (the-as (array int64) this) s5-2))
|
|
)
|
|
)
|
|
(('uint64)
|
|
(dotimes (s5-3 (-> this length))
|
|
(format #t "~T [~D] #x~X~%" s5-3 (-> (the-as (array uint64) this) s5-3))
|
|
)
|
|
)
|
|
(('int8)
|
|
(dotimes (s5-4 (-> this length))
|
|
(format #t "~T [~D] ~D~%" s5-4 (-> (the-as (array int8) this) s5-4))
|
|
)
|
|
)
|
|
(('uint8)
|
|
(dotimes (s5-5 (-> this length))
|
|
(format #t "~T [~D] ~D~%" s5-5 (-> (the-as (array int8) this) s5-5))
|
|
)
|
|
)
|
|
(('int16)
|
|
(dotimes (s5-6 (-> this length))
|
|
(format #t "~T [~D] ~D~%" s5-6 (-> (the-as (array int16) this) s5-6))
|
|
)
|
|
)
|
|
(('uint16)
|
|
(dotimes (s5-7 (-> this length))
|
|
(format #t "~T [~D] ~D~%" s5-7 (-> (the-as (array uint16) this) s5-7))
|
|
)
|
|
)
|
|
(('int128 'uint128)
|
|
(dotimes (s5-8 (-> this length))
|
|
(format #t "~T [~D] #x~X~%" s5-8 (-> (the-as (array uint128) this) s5-8))
|
|
)
|
|
)
|
|
(else
|
|
(dotimes (s5-9 (-> this length))
|
|
(format #t "~T [~D] ~D~%" s5-9 (-> (the-as (array int32) this) s5-9))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= (-> this content-type) float)
|
|
(dotimes (s5-10 (-> this length))
|
|
(format #t "~T [~D] ~f~%" s5-10 (-> (the-as (array float) this) s5-10))
|
|
)
|
|
)
|
|
(else
|
|
(dotimes (s5-11 (-> this length))
|
|
(format #t "~T [~D] ~A~%" s5-11 (-> (the-as (array basic) this) s5-11))
|
|
)
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition for method 4 of type array
|
|
(defmethod length ((this array))
|
|
(-> this length)
|
|
)
|
|
|
|
;; definition for method 5 of type array
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of ((this array))
|
|
(the-as int (+ (-> array size) (* (-> this allocated-length) (if (type-type? (-> this content-type) number)
|
|
(the-as int (-> this content-type size))
|
|
4
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function mem-copy!
|
|
(defun mem-copy! ((dst pointer) (src pointer) (size int))
|
|
(let ((result dst))
|
|
(dotimes (i size)
|
|
(set! (-> (the-as (pointer uint8) dst)) (-> (the-as (pointer uint8) src)))
|
|
(&+! dst 1)
|
|
(&+! src 1)
|
|
)
|
|
result
|
|
)
|
|
)
|
|
|
|
;; definition for function qmem-copy<-!
|
|
;; INFO: Used lq/sq
|
|
(defun qmem-copy<-! ((dst pointer) (src pointer) (size int))
|
|
(let ((result dst))
|
|
(countdown (qwc (/ (+ size 15) 16))
|
|
(set! (-> (the-as (pointer uint128) dst)) (-> (the-as (pointer uint128) src)))
|
|
(&+! dst 16)
|
|
(&+! src 16)
|
|
)
|
|
result
|
|
)
|
|
)
|
|
|
|
;; definition for function qmem-copy->!
|
|
;; INFO: Used lq/sq
|
|
(defun qmem-copy->! ((dst pointer) (src pointer) (size int))
|
|
(let ((result dst))
|
|
(let* ((qwc (/ (+ size 15) 16))
|
|
(dst-ptr (&+ dst (* qwc 16)))
|
|
(src-ptr (&+ src (* qwc 16)))
|
|
)
|
|
(while (nonzero? qwc)
|
|
(+! qwc -1)
|
|
(&+! dst-ptr -16)
|
|
(&+! src-ptr -16)
|
|
(set! (-> (the-as (pointer uint128) dst-ptr)) (-> (the-as (pointer uint128) src-ptr)))
|
|
)
|
|
)
|
|
result
|
|
)
|
|
)
|
|
|
|
;; definition for function mem-set32!
|
|
(defun mem-set32! ((dst pointer) (size int) (value int))
|
|
(let ((result dst))
|
|
(dotimes (i size)
|
|
(set! (-> (the-as (pointer int32) dst)) value)
|
|
(&+! dst 4)
|
|
(nop!)
|
|
)
|
|
result
|
|
)
|
|
)
|
|
|
|
;; definition for function mem-or!
|
|
(defun mem-or! ((dst pointer) (src pointer) (size int))
|
|
(let ((result dst))
|
|
(dotimes (i size)
|
|
(logior! (-> (the-as (pointer uint8) dst)) (-> (the-as (pointer uint8) src)))
|
|
(&+! dst 1)
|
|
(&+! src 1)
|
|
)
|
|
result
|
|
)
|
|
)
|
|
|
|
;; definition for function quad-copy!
|
|
;; ERROR: function was not converted to expressions. Cannot decompile.
|
|
|
|
;; definition for function fact
|
|
(defun fact ((x int))
|
|
(if (= x 1)
|
|
1
|
|
(* x (fact (+ x -1)))
|
|
)
|
|
)
|
|
|
|
;; definition for symbol *print-column*, type binteger
|
|
(define *print-column* (the-as binteger 0))
|
|
|
|
;; definition for function print
|
|
;; ERROR: Failed load: (set! v1-1 (l.wu (+ a0-0 -4))) at op 5
|
|
(defun print ((arg0 object))
|
|
((method-of-type (rtype-of arg0) print) arg0)
|
|
)
|
|
|
|
;; definition for function printl
|
|
;; ERROR: Failed load: (set! v1-1 (l.wu (+ a0-1 -4))) at op 7
|
|
(defun printl ((arg0 object))
|
|
(let ((a0-1 arg0))
|
|
((method-of-type (rtype-of a0-1) print) a0-1)
|
|
)
|
|
(format #t "~%")
|
|
arg0
|
|
)
|
|
|
|
;; definition for function inspect
|
|
;; ERROR: Failed load: (set! v1-1 (l.wu (+ a0-0 -4))) at op 5
|
|
(defun inspect ((arg0 object))
|
|
((method-of-type (rtype-of arg0) inspect) arg0)
|
|
)
|
|
|
|
;; definition (debug) for function mem-print
|
|
(defun-debug mem-print ((data (pointer uint32)) (word-count int))
|
|
(dotimes (current-qword (/ word-count 4))
|
|
(format
|
|
0
|
|
"~X: ~X ~X ~X ~X~%"
|
|
(&-> data (* current-qword 4))
|
|
(-> data (* current-qword 4))
|
|
(-> data (+ (* current-qword 4) 1))
|
|
(-> data (+ (* current-qword 4) 2))
|
|
(-> data (+ (* current-qword 4) 3))
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
;; definition for symbol *trace-list*, type pair
|
|
(define *trace-list* '())
|
|
|
|
;; definition for function print-tree-bitmask
|
|
(defun print-tree-bitmask ((bits int) (count int))
|
|
(dotimes (i count)
|
|
(if (not (logtest? bits 1))
|
|
(format #t " ")
|
|
(format #t "| ")
|
|
)
|
|
(set! bits (shr bits 1))
|
|
)
|
|
#f
|
|
)
|
|
|
|
;; definition for function breakpoint-range-set!
|
|
;; ERROR: Unsupported inline assembly instruction kind - [mtdab a1]
|
|
;; ERROR: Unsupported inline assembly instruction kind - [mtdabm a2]
|
|
(defun breakpoint-range-set! ((arg0 uint) (arg1 uint) (arg2 uint))
|
|
(.mtc0 Debug arg0)
|
|
(.mtdab arg1)
|
|
(.mtdabm arg2)
|
|
0
|
|
)
|
|
|
|
;; definition for function valid?
|
|
;; ERROR: Failed load: (set! a0-23 (l.wu (+ a0-0 -4))) at op 190
|
|
;; ERROR: Unsupported inline assembly instruction kind - [daddu v1, v1, s7]
|
|
;; ERROR: Unsupported inline assembly instruction kind - [daddu v1, v1, s7]
|
|
;; ERROR: Unsupported inline assembly instruction kind - [daddu v1, v1, s7]
|
|
(defun valid? ((this object) (expected-type type) (name basic) (allow-false basic) (print-dest object))
|
|
(local-vars (v1-11 int) (v1-44 int) (v1-48 int) (s7-0 none))
|
|
(let ((in-goal-mem
|
|
(and (>= (the-as uint this) (the-as uint __START-OF-TABLE__)) (< (the-as uint this) (the-as uint #x8000000)))
|
|
)
|
|
)
|
|
(cond
|
|
((not expected-type)
|
|
(cond
|
|
((logtest? (the-as int this) 3)
|
|
(if name
|
|
(format print-dest "ERROR: object #x~X ~S is not a valid object (misaligned)~%" this name)
|
|
)
|
|
#f
|
|
)
|
|
((not in-goal-mem)
|
|
(if name
|
|
(format print-dest "ERROR: object #x~X ~S is not a valid object (bad address)~%" this name)
|
|
)
|
|
#f
|
|
)
|
|
(else
|
|
#t
|
|
)
|
|
)
|
|
)
|
|
((and allow-false (not this))
|
|
#t
|
|
)
|
|
((= expected-type structure)
|
|
(cond
|
|
((logtest? (the-as int this) 15)
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((or (not in-goal-mem) (begin
|
|
(let ((v1-10 #x8000))
|
|
(.daddu v1-11 v1-10 s7-0)
|
|
)
|
|
(< (the-as uint this) (the-as uint v1-11))
|
|
)
|
|
)
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else
|
|
#t
|
|
)
|
|
)
|
|
)
|
|
((= expected-type pair)
|
|
(cond
|
|
((!= (logand (the-as int this) 7) 2)
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((not in-goal-mem)
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else
|
|
#t
|
|
)
|
|
)
|
|
)
|
|
((= expected-type binteger)
|
|
(cond
|
|
((not (logtest? (the-as int this) 7))
|
|
#t
|
|
)
|
|
(else
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
)
|
|
)
|
|
((!= (logand (the-as int this) 7) 4)
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((not in-goal-mem)
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (bad address)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((and (= expected-type type) (!= (rtype-of this) type))
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
(rtype-of this)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((and (!= expected-type type) (not (valid? (rtype-of this) type #f #t 0)))
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
(rtype-of this)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((not (type-type? (rtype-of this) expected-type))
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (is type '~A' instead)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
(rtype-of this)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((= expected-type symbol)
|
|
(let ((v1-43 #x8000))
|
|
(.daddu v1-44 v1-43 s7-0)
|
|
)
|
|
(cond
|
|
((>= (the-as uint this) (the-as uint v1-44))
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (not in symbol table)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else
|
|
#t
|
|
)
|
|
)
|
|
)
|
|
((begin
|
|
(let ((v1-47 #x8000))
|
|
(.daddu v1-48 v1-47 s7-0)
|
|
)
|
|
(< (the-as uint this) (the-as uint v1-48))
|
|
)
|
|
(if name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (inside symbol table)~%"
|
|
this
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else
|
|
#t
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; failed to figure out what this is:
|
|
0
|