mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-21 07:37:45 -04:00
1332 lines
28 KiB
Common Lisp
1332 lines
28 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; definition for function identity
|
|
(defun identity ((obj object))
|
|
obj
|
|
)
|
|
|
|
;; 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))
|
|
(let ((v0-0 x)) (abs v0-0))
|
|
)
|
|
|
|
;; 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)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x10
|
|
:flag-assert #x900000010
|
|
)
|
|
|
|
|
|
;; definition for method of type vec4s
|
|
;; INFO: Return type mismatch int vs vec4s.
|
|
(defmethod inspect vec4s ((obj vec4s))
|
|
(local-vars
|
|
(r0-0 none)
|
|
(v0-5 int)
|
|
(v1-0 int)
|
|
(v1-1 int)
|
|
(a2-0 int)
|
|
(a2-1 int)
|
|
(a2-3 int)
|
|
(gp-0 int)
|
|
)
|
|
(.por gp-0 obj r0-0)
|
|
(let
|
|
((t9-0 format) (a0-1 #t) (a1-0 "[~8x] ~A~%"))
|
|
(.por a2-0 gp-0 r0-0)
|
|
(t9-0 a0-1 a1-0 a2-0 'vec4s)
|
|
)
|
|
(let
|
|
((t9-1 format) (a0-2 #t) (a1-1 "~Tx: ~f~%"))
|
|
(.sllv a2-1 gp-0 r0-0)
|
|
(t9-1 a0-2 a1-1 a2-1)
|
|
)
|
|
(format #t "~Ty: ~f~%" (sar gp-0 32))
|
|
(let
|
|
((t9-3 format) (a0-4 #t) (a1-3 "~Tz: ~f~%"))
|
|
(.pcpyud v1-0 gp-0 r0-0)
|
|
(.sllv a2-3 v1-0 r0-0)
|
|
(t9-3 a0-4 a1-3 a2-3)
|
|
)
|
|
(let
|
|
((t9-4 format) (a0-5 #t) (a1-4 "~Tw: ~f~%"))
|
|
(.pcpyud v1-1 gp-0 r0-0)
|
|
(t9-4 a0-5 a1-4 (sar v1-1 32))
|
|
)
|
|
(.por v0-5 gp-0 r0-0)
|
|
(the-as vec4s v0-5)
|
|
)
|
|
|
|
;; definition for method of type vec4s
|
|
;; INFO: Return type mismatch int vs vec4s.
|
|
(defmethod print vec4s ((obj vec4s))
|
|
(local-vars
|
|
(r0-0 none)
|
|
(v0-1 int)
|
|
(v1-0 int)
|
|
(v1-1 int)
|
|
(a2-0 int)
|
|
(t0-0 int)
|
|
(t2-0 int)
|
|
(gp-0 int)
|
|
)
|
|
(.por gp-0 obj r0-0)
|
|
(let
|
|
((t9-0 format) (a0-1 #t) (a1-0 "#<vector ~F ~F ~F ~F @ #x~X>"))
|
|
(.sllv a2-0 gp-0 r0-0)
|
|
(let
|
|
((a3-0 (sar gp-0 32)))
|
|
(.pcpyud v1-0 gp-0 r0-0)
|
|
(.sllv t0-0 v1-0 r0-0)
|
|
(.pcpyud v1-1 gp-0 r0-0)
|
|
(let
|
|
((t1-0 (sar v1-1 32)))
|
|
(.por t2-0 gp-0 r0-0)
|
|
(t9-0 a0-1 a1-0 a2-0 a3-0 t0-0 t1-0 t2-0)
|
|
)
|
|
)
|
|
)
|
|
(.por v0-1 gp-0 r0-0)
|
|
(the-as vec4s v0-1)
|
|
)
|
|
|
|
;; definition of type bfloat
|
|
(deftype bfloat (basic)
|
|
((data float :offset-assert 4)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x8
|
|
:flag-assert #x900000008
|
|
)
|
|
|
|
|
|
;; definition for method of type bfloat
|
|
(defmethod inspect bfloat ((obj bfloat))
|
|
(format #t "[~8x] ~A~%" obj (-> obj type))
|
|
(format #t "~Tdata: ~f~%" (-> obj data))
|
|
obj
|
|
)
|
|
|
|
;; definition for method of type bfloat
|
|
(defmethod print bfloat ((obj bfloat))
|
|
(format #t "~f" (-> obj data))
|
|
obj
|
|
)
|
|
|
|
;; definition for method of type type
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of type ((obj type))
|
|
(the-as int (logand #xfffffff0 (+ (shl (-> obj allocated-length) 2) 43)))
|
|
)
|
|
|
|
;; definition for function basic-type?
|
|
(defun basic-type? ((obj basic) (parent-type type))
|
|
(let
|
|
((obj-type (-> obj type)) (end-type object))
|
|
(until
|
|
(begin (set! obj-type (-> obj-type parent)) (= obj-type end-type))
|
|
(if (= obj-type parent-type) (return #t))
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
;; definition for function type-type?
|
|
(defun type-type? ((child-type type) (parent-type type))
|
|
(let
|
|
((end-type object))
|
|
(until
|
|
(begin
|
|
(set! child-type (-> child-type parent))
|
|
(or (= child-type end-type) (zero? child-type))
|
|
)
|
|
(if (= child-type parent-type) (return #t))
|
|
)
|
|
)
|
|
#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))
|
|
(let
|
|
((count 0))
|
|
(while (< count index) (nop!) (nop!) (set! lst (cdr lst)) (+! count 1))
|
|
)
|
|
(car lst)
|
|
)
|
|
|
|
;; definition for method of type pair
|
|
(defmethod length pair ((obj pair))
|
|
(local-vars (result int))
|
|
(cond
|
|
((= obj '()) (set! result 0))
|
|
(else
|
|
(let
|
|
((iter (cdr obj)))
|
|
(set! result 1)
|
|
(while
|
|
(and (!= iter '()) (< (shl (the-as int iter) 62) 0))
|
|
(+! result 1)
|
|
(set! iter (cdr iter))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
result
|
|
)
|
|
|
|
;; definition for method of type pair
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of pair ((obj pair))
|
|
(the-as int (-> pair size))
|
|
)
|
|
|
|
;; definition for function last
|
|
(defun last ((lst object))
|
|
(let
|
|
((iter lst))
|
|
(while (!= (cdr iter) '()) (nop!) (nop!) (set! iter (cdr iter)))
|
|
iter
|
|
)
|
|
)
|
|
|
|
;; definition for function member
|
|
(defun member ((obj object) (lst object))
|
|
(let
|
|
((iter lst))
|
|
(while (not (or (= iter '()) (= (car iter) obj))) (set! iter (cdr iter)))
|
|
(if (!= iter '()) iter)
|
|
)
|
|
)
|
|
|
|
;; definition for function nmember
|
|
(defun nmember ((obj basic) (lst object))
|
|
(while
|
|
(not (or (= lst '()) (name= (the-as basic (car lst)) obj)))
|
|
(set! lst (cdr lst))
|
|
)
|
|
(if (!= lst '()) lst)
|
|
)
|
|
|
|
;; definition for function assoc
|
|
(defun assoc ((item object) (alist object))
|
|
(let
|
|
((iter alist))
|
|
(while
|
|
(not (or (= iter '()) (= (car (car iter)) item)))
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (!= iter '()) (car iter))
|
|
)
|
|
)
|
|
|
|
;; definition for function assoce
|
|
(defun assoce ((item object) (alist object))
|
|
(let
|
|
((iter alist))
|
|
(while
|
|
(not (or (= iter '()) (= (car (car iter)) item) (= (car (car iter)) 'else)))
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (!= iter '()) (car iter))
|
|
)
|
|
)
|
|
|
|
;; definition for function nassoc
|
|
(defun nassoc ((item-name string) (alist object))
|
|
(while
|
|
(not
|
|
(or
|
|
(= 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 (!= alist '()) (car alist))
|
|
)
|
|
|
|
;; definition for function nassoce
|
|
(defun nassoce ((item-name string) (alist object))
|
|
(while
|
|
(not
|
|
(or
|
|
(= 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 (!= alist '()) (car alist))
|
|
)
|
|
|
|
;; definition for function append!
|
|
(defun append! ((front object) (back object))
|
|
(cond
|
|
((= front '()) back)
|
|
(else
|
|
(let
|
|
((iter front))
|
|
(while (!= (cdr iter) '()) (nop!) (nop!) (set! iter (cdr iter)))
|
|
(if (!= 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 (= iter '()) (= (car iter) item)))
|
|
(set! iter-prev iter)
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (!= 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 (= iter '()) (= (car (car iter)) item)))
|
|
(set! iter-prev iter)
|
|
(set! iter (cdr iter))
|
|
)
|
|
(if (!= 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 object) (compare-func (function object object object)))
|
|
(let
|
|
((unsorted-count -1))
|
|
(while
|
|
(nonzero? unsorted-count)
|
|
(set! unsorted-count 0)
|
|
(let
|
|
((iter lst))
|
|
(while
|
|
(not (or (= (cdr iter) '()) (>= (shl (the-as int (cdr iter)) 62) 0)))
|
|
(let*
|
|
((first-elt (car iter))
|
|
(seoncd-elt (car (cdr iter)))
|
|
(compare-result (compare-func first-elt seoncd-elt))
|
|
)
|
|
(when
|
|
(and
|
|
(or (not compare-result) (> (the-as int compare-result) 0))
|
|
(!= compare-result #t)
|
|
)
|
|
(+! unsorted-count 1)
|
|
(set! (car iter) seoncd-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 :offset-assert 4)
|
|
(allocated-length int32 :offset-assert 8)
|
|
(data uint8 :dynamic :offset-assert 12)
|
|
(_pad uint8 4 :offset-assert 12)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x10
|
|
:flag-assert #x900000010
|
|
(:methods
|
|
(new (symbol type int) _type_ 0)
|
|
)
|
|
)
|
|
|
|
|
|
;; definition for method of type inline-array-class
|
|
(defmethod inspect inline-array-class ((obj inline-array-class))
|
|
(format #t "[~8x] ~A~%" obj (-> obj type))
|
|
(format #t "~Tlength: ~D~%" (-> obj length))
|
|
(format #t "~Tallocated-length: ~D~%" (-> obj allocated-length))
|
|
obj
|
|
)
|
|
|
|
;; definition for method of type inline-array-class
|
|
(defmethod
|
|
new
|
|
inline-array-class
|
|
((allocation symbol) (type-to-make type) (size int))
|
|
(let
|
|
((obj
|
|
(object-new
|
|
allocation
|
|
type-to-make
|
|
(the-as
|
|
int
|
|
(+
|
|
(-> type-to-make size)
|
|
(* (the-as uint size) (-> type-to-make heap-base))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when
|
|
(nonzero? obj)
|
|
(set! (-> obj length) size)
|
|
(set! (-> obj allocated-length) size)
|
|
)
|
|
obj
|
|
)
|
|
)
|
|
|
|
;; definition for method of type inline-array-class
|
|
(defmethod length inline-array-class ((obj inline-array-class))
|
|
(-> obj length)
|
|
)
|
|
|
|
;; definition for method of type inline-array-class
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of inline-array-class ((obj inline-array-class))
|
|
(the-as
|
|
int
|
|
(+
|
|
(-> obj type size)
|
|
(the-as
|
|
uint
|
|
(* (-> obj allocated-length) (the-as int (-> obj type heap-base)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for method of type array
|
|
(defmethod
|
|
new
|
|
array
|
|
((allocation symbol) (type-to-make type) (content-type type) (len int))
|
|
(let
|
|
((obj
|
|
(object-new
|
|
allocation
|
|
type-to-make
|
|
(the-as
|
|
int
|
|
(+
|
|
(-> type-to-make size)
|
|
(the-as
|
|
uint
|
|
(* len (if (type-type? content-type number) (-> content-type size) 4))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> obj allocated-length) len)
|
|
(set! (-> obj length) len)
|
|
(set! (-> obj content-type) content-type)
|
|
obj
|
|
)
|
|
)
|
|
|
|
;; definition for method of type array
|
|
(defmethod print array ((obj array))
|
|
(local-vars
|
|
(a2-8 int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
)
|
|
(format #t "#(")
|
|
(if
|
|
(type-type? (-> obj content-type) integer)
|
|
(let
|
|
((content-type-sym (-> obj content-type symbol)))
|
|
(cond
|
|
((= content-type-sym 'int32)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t (if (zero? i) "~D" " ~D") (-> (the-as (array int32) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'uint32)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t (if (zero? i) "~D" " ~D") (-> (the-as (array uint32) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'int64)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t (if (zero? i) "~D" " ~D") (-> (the-as (array int64) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'uint64)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format
|
|
#t
|
|
(if (zero? i) "#x~X" " #x~X")
|
|
(-> (the-as (array uint64) obj) i)
|
|
)
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'int8)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t (if (zero? i) "~D" " ~D") (-> (the-as (array int8) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'uint8)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t (if (zero? i) "~D" " ~D") (-> (the-as (array uint8) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'int16)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t (if (zero? i) "~D" " ~D") (-> (the-as (array int16) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'uint16)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t (if (zero? i) "~D" " ~D") (-> (the-as (array uint16) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
(else
|
|
(cond
|
|
((or (= content-type-sym 'uint128) (= content-type-sym 'int128))
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(let
|
|
((t9-10 format) (a0-21 #t) (a1-11 (if (zero? i) "#x~X" " #x~X")))
|
|
(let
|
|
((v1-42 (+ (shl i 4) (the-as int (the-as (array uint128) obj)))))
|
|
(.lq a2-8 12 v1-42)
|
|
)
|
|
(t9-10 a0-21 a1-11 a2-8)
|
|
)
|
|
(+! i 1)
|
|
)
|
|
)
|
|
(else
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t (if (zero? i) "~D" " ~D") (-> (the-as (array int32) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(cond
|
|
((= (-> obj content-type) float)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(if
|
|
(zero? i)
|
|
(format #t "~f" (-> (the-as (array float) obj) i))
|
|
(format #t " ~f" (-> (the-as (array float) obj) i))
|
|
)
|
|
(+! i 1)
|
|
)
|
|
)
|
|
(else
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(if
|
|
(zero? i)
|
|
(format #t "~A" (-> (the-as (array basic) obj) i))
|
|
(format #t " ~A" (-> (the-as (array basic) obj) i))
|
|
)
|
|
(+! i 1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(format #t ")")
|
|
obj
|
|
)
|
|
|
|
;; definition for method of type array
|
|
(defmethod inspect array ((obj array))
|
|
(local-vars
|
|
(a3-10 int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
(i int)
|
|
)
|
|
(format #t "[~8x] ~A~%" obj (-> obj type))
|
|
(format #t "~Tallocated-length: ~D~%" (-> obj allocated-length))
|
|
(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)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~D~%" i (-> (the-as (array int32) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'uint32)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~D~%" i (-> (the-as (array uint32) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'int64)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~D~%" i (-> (the-as (array int64) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'uint64)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] #x~X~%" i (-> (the-as (array uint64) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'int8)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~D~%" i (-> (the-as (array int8) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'uint8)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~D~%" i (-> (the-as (array int8) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'int16)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~D~%" i (-> (the-as (array int16) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
((= content-type-sym 'uint16)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~D~%" i (-> (the-as (array uint16) obj) i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
(else
|
|
(cond
|
|
((or (= content-type-sym 'int128) (= content-type-sym 'uint128))
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(let
|
|
((t9-14 format) (a0-25 #t) (a1-15 "~T [~D] #x~X~%") (a2-13 i))
|
|
(let ((v1-42 (+ (shl i 4) (the-as int obj)))) (.lq a3-10 12 v1-42))
|
|
(t9-14 a0-25 a1-15 a2-13 a3-10)
|
|
)
|
|
(+! i 1)
|
|
)
|
|
)
|
|
(else
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~D~%" i (-> obj i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(cond
|
|
((= (-> obj content-type) float)
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~f~%" i (-> obj i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
(else
|
|
(set! i 0)
|
|
(while
|
|
(< i (-> obj length))
|
|
(format #t "~T [~D] ~A~%" i (-> obj i))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
obj
|
|
)
|
|
|
|
;; definition for method of type array
|
|
(defmethod length array ((obj array))
|
|
(-> obj length)
|
|
)
|
|
|
|
;; definition for method of type array
|
|
;; INFO: Return type mismatch uint vs int.
|
|
(defmethod asize-of array ((obj array))
|
|
(the-as
|
|
int
|
|
(+
|
|
(-> array size)
|
|
(the-as
|
|
uint
|
|
(*
|
|
(-> obj allocated-length)
|
|
(if
|
|
(type-type? (-> obj content-type) number)
|
|
(-> obj content-type size)
|
|
4
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function mem-copy!
|
|
(defun mem-copy! ((dst pointer) (src pointer) (size int))
|
|
(let
|
|
((result dst))
|
|
(let
|
|
((i 0))
|
|
(while
|
|
(< i size)
|
|
(set! (-> (the-as (pointer int8) dst)) (-> (the-as (pointer uint8) src)))
|
|
(&+! dst 1)
|
|
(&+! src 1)
|
|
(+! i 1)
|
|
)
|
|
)
|
|
result
|
|
)
|
|
)
|
|
|
|
;; definition for function qmem-copy<-!
|
|
(defun qmem-copy<-! ((dst pointer) (src pointer) (size int))
|
|
(local-vars (value int))
|
|
(let
|
|
((result dst))
|
|
(let
|
|
((qwc (sar (+ size 15) 4)))
|
|
(while
|
|
(nonzero? qwc)
|
|
(+! qwc -1)
|
|
(.lq value 0 src)
|
|
(.sq value 0 dst)
|
|
(&+! dst 16)
|
|
(&+! src 16)
|
|
)
|
|
)
|
|
result
|
|
)
|
|
)
|
|
|
|
;; definition for function qmem-copy->!
|
|
(defun qmem-copy->! ((dst pointer) (src pointer) (size int))
|
|
(local-vars (src-ptr pointer) (dst-ptr pointer) (value int))
|
|
(let
|
|
((result dst))
|
|
(let
|
|
((qwc (sar (+ size 15) 4)))
|
|
(&+! dst (shl qwc 4))
|
|
(&+! src (shl qwc 4))
|
|
(while
|
|
(nonzero? qwc)
|
|
(+! qwc -1)
|
|
(&+! src-ptr -16)
|
|
(&+! dst-ptr -16)
|
|
(.lq value 0 dst-ptr)
|
|
(.sq value 0 src-ptr)
|
|
)
|
|
)
|
|
result
|
|
)
|
|
)
|
|
|
|
;; definition for function mem-set32!
|
|
(defun mem-set32! ((dst pointer) (size int) (value int))
|
|
(let
|
|
((result dst))
|
|
(let
|
|
((i 0))
|
|
(while
|
|
(< i size)
|
|
(set! (-> (the-as (pointer int32) dst)) value)
|
|
(&+! dst 4)
|
|
(nop!)
|
|
(+! i 1)
|
|
)
|
|
)
|
|
result
|
|
)
|
|
)
|
|
|
|
;; definition for function mem-or!
|
|
(defun mem-or! ((dst pointer) (src pointer) (size int))
|
|
(let
|
|
((result dst))
|
|
(let
|
|
((i 0))
|
|
(while
|
|
(< i size)
|
|
(set!
|
|
(-> (the-as (pointer int8) dst))
|
|
(logior
|
|
(-> (the-as (pointer uint8) dst))
|
|
(-> (the-as (pointer uint8) src))
|
|
)
|
|
)
|
|
(&+! dst 1)
|
|
(&+! src 1)
|
|
(+! i 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
|
|
(defun print ((arg0 object))
|
|
((method-of-type (rtype-of arg0) print) arg0)
|
|
)
|
|
|
|
;; definition for function printl
|
|
(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
|
|
(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))
|
|
(let
|
|
((current-qword 0))
|
|
(while
|
|
(< current-qword (sar word-count 2))
|
|
(format
|
|
0
|
|
"~X: ~X ~X ~X ~X~%"
|
|
(&-> data (shl current-qword 2))
|
|
(-> data (shl current-qword 2))
|
|
(-> data (+ (shl current-qword 2) 1))
|
|
(-> data (+ (shl current-qword 2) 2))
|
|
(-> data (+ (shl current-qword 2) 3))
|
|
)
|
|
(+! current-qword 1)
|
|
)
|
|
)
|
|
#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))
|
|
(let
|
|
((i 0))
|
|
(while
|
|
(< i count)
|
|
(if (zero? (logand bits 1)) (format #t " ") (format #t "| "))
|
|
(set! bits (shr bits 1))
|
|
(+! i 1)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
;; definition for function breakpoint-range-set!
|
|
(defun breakpoint-range-set! ((arg0 uint) (arg1 uint) (arg2 uint))
|
|
(.mtc0 Debug arg0)
|
|
(.mtdab arg1)
|
|
(.mtdabm arg2)
|
|
0
|
|
)
|
|
|
|
;; definition for function valid?
|
|
(defun
|
|
valid?
|
|
((obj 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 obj) (the-as uint __START-OF-TABLE__))
|
|
(< (the-as uint obj) (the-as uint #x8000000))
|
|
)
|
|
)
|
|
)
|
|
(cond
|
|
((not expected-type)
|
|
(cond
|
|
((nonzero? (logand (the-as int obj) 3))
|
|
(if
|
|
name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object (misaligned)~%"
|
|
obj
|
|
name
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((not in-goal-mem)
|
|
(if
|
|
name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object (bad address)~%"
|
|
obj
|
|
name
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else #t)
|
|
)
|
|
)
|
|
((and allow-false (not obj)) #t)
|
|
(else
|
|
(cond
|
|
((= expected-type structure)
|
|
(cond
|
|
((nonzero? (logand (the-as int obj) 15))
|
|
(if
|
|
name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((or
|
|
(not in-goal-mem)
|
|
(begin
|
|
(let ((v1-10 #x8000)) (.daddu v1-11 v1-10 s7-0))
|
|
(< (the-as uint obj) (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)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else #t)
|
|
)
|
|
)
|
|
((= expected-type pair)
|
|
(cond
|
|
((!= (logand (the-as int obj) 7) 2)
|
|
(if
|
|
name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%"
|
|
obj
|
|
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)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else #t)
|
|
)
|
|
)
|
|
((= expected-type binteger)
|
|
(cond
|
|
((zero? (logand (the-as int obj) 7)) #t)
|
|
(else
|
|
(if
|
|
name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
)
|
|
)
|
|
((!= (logand (the-as int obj) 7) 4)
|
|
(if
|
|
name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (misaligned)~%"
|
|
obj
|
|
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)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((and (= expected-type type) (!= (rtype-of obj) type))
|
|
(if
|
|
name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (invalid type #x~X)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
(rtype-of obj)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else
|
|
(cond
|
|
((and
|
|
(!= expected-type type)
|
|
(not (valid? (rtype-of obj) 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)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
(rtype-of obj)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((not (type-type? (rtype-of obj) expected-type))
|
|
(if
|
|
name
|
|
(format
|
|
print-dest
|
|
"ERROR: object #x~X ~S is not a valid object of type '~A' (is type '~A' instead)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
(rtype-of obj)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
((= expected-type symbol)
|
|
(let ((v1-43 #x8000)) (.daddu v1-44 v1-43 s7-0))
|
|
(cond
|
|
((>= (the-as uint obj) (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)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else #t)
|
|
)
|
|
)
|
|
((begin
|
|
(let ((v1-47 #x8000)) (.daddu v1-48 v1-47 s7-0))
|
|
(< (the-as uint obj) (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)~%"
|
|
obj
|
|
name
|
|
expected-type
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
(else #t)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; failed to figure out what this is:
|
|
(let ((v0-3 0)))
|