mirror of
https://github.com/open-goal/jak-project
synced 2026-08-10 03:06:18 -04:00
[jak2] decomp gkernel, setup offline tests (#1638)
* add comments * oops * format' * spelling is hard
This commit is contained in:
water111
+557
@@ -0,0 +1,557 @@
|
||||
;; This file should contain an implementation for all macros that the decompiler uses in its output.
|
||||
|
||||
(defun ash ((value int) (shift-amount int))
|
||||
"Arithmetic shift value by shift-amount.
|
||||
A positive shift-amount will shift to the left and a negative will shift to the right.
|
||||
"
|
||||
;; OpenGOAL does not support ash in the compiler, so we implement it here as an inline function.
|
||||
(declare (inline))
|
||||
(if (> shift-amount 0)
|
||||
(shl value shift-amount)
|
||||
(sar value (- shift-amount))
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro suspend ()
|
||||
'(none)
|
||||
)
|
||||
|
||||
(defmacro empty-form ()
|
||||
'(none)
|
||||
)
|
||||
|
||||
(defmacro .sync.l ()
|
||||
`(none))
|
||||
|
||||
(defmacro make-u128 (upper lower)
|
||||
`(rlet ((result :class i128)
|
||||
(upper-xmm :class i128)
|
||||
(lower-xmm :class i128))
|
||||
(.mov upper-xmm ,upper)
|
||||
(.mov lower-xmm ,lower)
|
||||
(.pcpyld result upper-xmm lower-xmm)
|
||||
(the uint result)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro init-vf0-vector ()
|
||||
"Initializes the VF0 vector which is a constant vector in the VU set to <0,0,0,1>"
|
||||
`(.lvf vf0 (new 'static 'vector :x 0.0 :y 0.0 :z 0.0 :w 1.0))
|
||||
)
|
||||
|
||||
(defconstant SYM_TO_STRING_OFFSET #xff38)
|
||||
(defmacro symbol->string (sym)
|
||||
"Convert a symbol to a goal string."
|
||||
`(-> (the-as (pointer string) (+ SYM_TO_STRING_OFFSET (the-as int ,sym))))
|
||||
)
|
||||
|
||||
(defmacro new-stack-matrix0 ()
|
||||
"Get a new matrix on the stack that's set to zero."
|
||||
`(let ((mat (new 'stack-no-clear 'matrix)))
|
||||
(set! (-> mat quad 0) (the-as uint128 0))
|
||||
(set! (-> mat quad 1) (the-as uint128 0))
|
||||
(set! (-> mat quad 2) (the-as uint128 0))
|
||||
(set! (-> mat quad 3) (the-as uint128 0))
|
||||
mat
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro new-stack-vector0 ()
|
||||
"Get a stack vector that's set to 0.
|
||||
This is more efficient than (new 'stack 'vector) because
|
||||
this doesn't call the constructor."
|
||||
`(let ((vec (new 'stack-no-clear 'vector)))
|
||||
(set! (-> vec quad) (the-as uint128 0))
|
||||
vec
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro new-stack-quaternion0 ()
|
||||
"Get a stack quaternion that's set to 0.
|
||||
This is more efficient than (new 'stack 'quaternion) because
|
||||
this doesn't call the constructor."
|
||||
`(let ((q (new 'stack-no-clear 'quaternion)))
|
||||
(set! (-> q quad) (the-as uint128 0))
|
||||
q
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(defmacro with-pp (&rest body)
|
||||
`(rlet ((pp :reg r13 :reset-here #t :type process))
|
||||
,@body)
|
||||
)
|
||||
|
||||
(defmacro fabs (x)
|
||||
`(if (< (the float ,x) 0)
|
||||
(- (the float ,x))
|
||||
(the float ,x))
|
||||
)
|
||||
|
||||
(defconstant PI (the-as float #x40490fda))
|
||||
(defconstant MINUS_PI (the-as float #xc0490fda))
|
||||
|
||||
(defmacro handle->process (handle)
|
||||
;; the actual implementation is more clever than this.
|
||||
;; Checks PID.
|
||||
`(let ((the-handle (the-as handle ,handle)))
|
||||
(if (-> the-handle process)
|
||||
(let ((proc (-> (-> the-handle process))))
|
||||
(if (= (-> the-handle pid) (-> proc pid))
|
||||
proc
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro ppointer->process (ppointer)
|
||||
;; convert a (pointer process) to a process.
|
||||
;; this uses the self field, which seems to always just get set to the object.
|
||||
;; perhaps when deleting a process you could have it set self to #f?
|
||||
;; I don't see this happen anywhere though, so it's not clear.
|
||||
`(let ((the-pp ,ppointer))
|
||||
(the process-tree (if the-pp (-> the-pp 0 self)))
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro process->ppointer (proc)
|
||||
;"safely get a (pointer process) from a process, returning #f if invalid."
|
||||
`(let ((the-proc ,proc))
|
||||
(if the-proc (-> the-proc ppointer))
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro ppointer->handle (pproc)
|
||||
`(let ((the-process (the-as (pointer process) ,pproc)))
|
||||
(new 'static 'handle :process the-process :pid (-> the-process 0 pid))
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro process->handle (proc)
|
||||
`(ppointer->handle (process->ppointer ,proc))
|
||||
)
|
||||
|
||||
|
||||
(defmacro defbehavior (name process-type bindings &rest body)
|
||||
(if (and
|
||||
(> (length body) 1) ;; more than one thing in function
|
||||
(string? (first body)) ;; first thing is a string
|
||||
)
|
||||
;; then it's a docstring and we ignore it.
|
||||
`(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@(cdr body)))
|
||||
;; otherwise don't ignore it.
|
||||
`(define ,name (lambda :name ,name :behavior ,process-type ,bindings ,@body))
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro b! (pred destination &key (delay '()) &key (likely-delay '()))
|
||||
"Branch!"
|
||||
;; evaluate the predicate
|
||||
`(let ((should-branch ,pred))
|
||||
;; normal delay slot:
|
||||
,delay
|
||||
(when should-branch
|
||||
,likely-delay
|
||||
(goto ,destination)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
;; meters are stored as (usually) a float, scaled by 4096.
|
||||
;; this gives you reasonable accuracy as an integer.
|
||||
(defglobalconstant METER_LENGTH 4096.0)
|
||||
|
||||
(defmacro meters (x)
|
||||
"Convert number to meters.
|
||||
If the input is a constant float or integer, the result will be a
|
||||
compile time constant float. Otherwise, it will not be constant.
|
||||
Returns float."
|
||||
|
||||
;; we don't have enough constant propagation for the compiler to figure this out.
|
||||
(cond
|
||||
((float? x)
|
||||
(* METER_LENGTH x)
|
||||
)
|
||||
((integer? x)
|
||||
(* METER_LENGTH x)
|
||||
)
|
||||
(#t
|
||||
`(* METER_LENGTH ,x)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; rotations are stored in 65,536ths of a full rotation.
|
||||
;; like with meters, you get a reasonable accuracy as an integer.
|
||||
;; additionally, it is a power-of-two, so wrapping rotations can be done
|
||||
;; quickly by converting to an int, masking, and back to float
|
||||
(defglobalconstant DEGREES_PER_ROT 65536.0)
|
||||
|
||||
;; this was deg in GOAL
|
||||
(defmacro degrees (x)
|
||||
"Convert number to degrees unit.
|
||||
Will keep a constant float/int constant."
|
||||
(cond
|
||||
((or (float? x) (integer? x))
|
||||
(* DEGREES_PER_ROT (/ (+ 0.0 x) 360.0))
|
||||
)
|
||||
(#t
|
||||
`(* (/ (the float ,x) 360.0)
|
||||
DEGREES_PER_ROT
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; times are stored in 300ths of a second.
|
||||
;; this divides evenly into frames at both 50 and 60 fps.
|
||||
;; typically these are stored as integers as more precision is not useful.
|
||||
;; an unsigned 32-bit integer can store about 150 days
|
||||
(defglobalconstant TICKS_PER_SECOND 300) ;; 5 t/frame @ 60fps, 6 t/frame @ 50fps
|
||||
|
||||
;; this was usec in GOAL
|
||||
(defmacro seconds (x)
|
||||
"Convert number to seconds unit.
|
||||
Returns uint."
|
||||
(cond
|
||||
((integer? x)
|
||||
(* TICKS_PER_SECOND x)
|
||||
)
|
||||
((float? x)
|
||||
(* 1 (* 1.0 x TICKS_PER_SECOND))
|
||||
)
|
||||
(#t
|
||||
`(the uint (* TICKS_PER_SECOND ,x))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro fsec (x)
|
||||
"Convert number to seconds unit.
|
||||
Returns float."
|
||||
(cond
|
||||
((or (integer? x) (float? x))
|
||||
(* 1.0 TICKS_PER_SECOND x)
|
||||
)
|
||||
(#t
|
||||
`(* 1.0 TICKS_PER_SECOND ,x)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(fake-asm .sync.l)
|
||||
(fake-asm .sync.p)
|
||||
(fake-asm .mfc0 dest src)
|
||||
(fake-asm .mtc0 dest src)
|
||||
(fake-asm .mtpc dest src)
|
||||
(fake-asm .mfpc dest src)
|
||||
(fake-asm .mtdab src)
|
||||
(fake-asm .mtdabm src)
|
||||
|
||||
;; maybe rename to "velocity"?
|
||||
(defmacro vel-tick (vel)
|
||||
"turn a velocity value into a per-tick value"
|
||||
`(* (/ 1.0 ,TICKS_PER_SECOND) ,vel)
|
||||
)
|
||||
|
||||
(defmacro copy-and-set-field (original field-name field-value)
|
||||
`(let ((temp-copy ,original))
|
||||
(set! (-> temp-copy ,field-name) ,field-value)
|
||||
temp-copy
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro set-vector! (v xv yv zv wv)
|
||||
"Set all fields in a vector"
|
||||
(with-gensyms (vec)
|
||||
`(let ((,vec ,v))
|
||||
(set! (-> ,vec x) ,xv)
|
||||
(set! (-> ,vec y) ,yv)
|
||||
(set! (-> ,vec z) ,zv)
|
||||
(set! (-> ,vec w) ,wv)
|
||||
,vec
|
||||
))
|
||||
)
|
||||
|
||||
;; cause the current process to change state
|
||||
(defmacro go (next-state &rest args)
|
||||
`(with-pp
|
||||
(go-hook pp ,next-state ,@args)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro go-virtual (state-name &key (proc self) &rest args)
|
||||
"Change the current process to the virtual state of the given process."
|
||||
`(go (method-of-object ,proc ,state-name) ,@args)
|
||||
)
|
||||
|
||||
(defmacro static-sound-name (str)
|
||||
"Convert a string constant to a static sound-name."
|
||||
|
||||
;; all this is done at compile-time so we can come up with 2
|
||||
;; 64-bit constants to use
|
||||
(when (> (string-length str) 16)
|
||||
(error "static-sound-name got a string that is too long")
|
||||
)
|
||||
(let ((lo-val 0)
|
||||
(hi-val 0)
|
||||
)
|
||||
(dotimes (i (string-length str))
|
||||
(if (>= i 8)
|
||||
(+! hi-val (ash (string-ref str i) (* 8 (- i 8))))
|
||||
(+! lo-val (ash (string-ref str i) (* 8 i)))
|
||||
)
|
||||
)
|
||||
`(new 'static 'sound-name :lo ,lo-val :hi ,hi-val)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro vftoi4.xyzw (dst src)
|
||||
"convert to 28.4 integer. This does the multiply while the number is still
|
||||
a float. This will have issues for very large floats, but it seems like this
|
||||
is how PCSX2 does it as well, so maybe it's right?
|
||||
NOTE: this is the only version of the instruction used in Jak 1, so we
|
||||
don't need to worry about masks."
|
||||
|
||||
`(begin
|
||||
(rlet ((temp :class vf))
|
||||
(set! temp 16.0)
|
||||
(.mul.x.vf temp ,src temp)
|
||||
(.ftoi.vf ,dst temp)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro vftoi12.xyzw (dst src)
|
||||
"convert to 20.12 integer. This does the multiply while the number is still
|
||||
a float. This will have issues for very large floats, but it seems like this
|
||||
is how PCSX2 does it as well, so maybe it's right?
|
||||
NOTE: this is the only version of the instruction used in Jak 1, so we
|
||||
don't need to worry about masks."
|
||||
|
||||
`(begin
|
||||
(rlet ((temp :class vf))
|
||||
(set! temp 4096.0)
|
||||
(.mul.x.vf temp ,src temp)
|
||||
(.ftoi.vf ,dst temp)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro vftoi15.xyzw (dst src)
|
||||
"convert to 17.15 integer. This does the multiply while the number is still
|
||||
a float. This will have issues for very large floats, but it seems like this
|
||||
is how PCSX2 does it as well, so maybe it's right?
|
||||
NOTE: this is the only version of the instruction used in Jak 1, so we
|
||||
don't need to worry about masks."
|
||||
|
||||
`(begin
|
||||
(rlet ((temp :class vf))
|
||||
(set! temp 32768.0)
|
||||
(.mul.x.vf temp ,src temp)
|
||||
(.ftoi.vf ,dst temp)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro vitof4.xyzw (dst src)
|
||||
"convert from a 28.4 integer. This does the multiply while the number is still
|
||||
a float. This will have issues for very large floats, but it seems like this
|
||||
is how PCSX2 does it as well, so maybe it's right?
|
||||
NOTE: this is the only version of the instruction used in Jak 1, so we
|
||||
don't need to worry about masks."
|
||||
|
||||
`(begin
|
||||
(rlet ((temp :class vf))
|
||||
(set! temp 0.0625)
|
||||
(.mul.x.vf temp ,src temp)
|
||||
(.ftoi.vf ,dst temp)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro vitof12.xyzw (dst src)
|
||||
"convert from a 20.12 integer. This does the multiply while the number is still
|
||||
a float. This will have issues for very large floats, but it seems like this
|
||||
is how PCSX2 does it as well, so maybe it's right?
|
||||
NOTE: this is the only version of the instruction used in Jak 1, so we
|
||||
don't need to worry about masks."
|
||||
|
||||
`(begin
|
||||
(rlet ((temp :class vf))
|
||||
(set! temp 0.000244140625)
|
||||
(.mul.x.vf temp ,src temp)
|
||||
(.ftoi.vf ,dst temp)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro vitof15.xyzw (dst src)
|
||||
"convert from a 17.15 integer. This does the multiply while the number is still
|
||||
a float. This will have issues for very large floats, but it seems like this
|
||||
is how PCSX2 does it as well, so maybe it's right?
|
||||
NOTE: this is the only version of the instruction used in Jak 1, so we
|
||||
don't need to worry about masks."
|
||||
|
||||
`(begin
|
||||
(rlet ((temp :class vf))
|
||||
(set! temp 0.000030517578125)
|
||||
(.mul.x.vf temp ,src temp)
|
||||
(.ftoi.vf ,dst temp)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; use a compile-time list to keep track of the type of an anonymous behavior.
|
||||
(seval (define *defstate-type-stack* '()))
|
||||
(desfun def-state-check-behavior (beh-form beh-type)
|
||||
"check if code block is an anonymous behavior. needed for anonymous behaviors on defstate."
|
||||
|
||||
(when (and (pair? beh-form) (eq? (first beh-form) 'behavior))
|
||||
(push! *defstate-type-stack* beh-type)
|
||||
)
|
||||
)
|
||||
(defmacro clear-def-state-stack ()
|
||||
(set! *defstate-type-stack* '())
|
||||
`(none)
|
||||
)
|
||||
;; *no-state* is just used for the compiler to know whether a handler was actually set or not
|
||||
(defmacro defstate (state-name parents
|
||||
&key (virtual #f)
|
||||
&key (event *no-state*)
|
||||
&key (enter *no-state*)
|
||||
&key (trans *no-state*)
|
||||
&key (exit *no-state*)
|
||||
&key (code *no-state*)
|
||||
&key (post *no-state*)
|
||||
)
|
||||
"Define a new state!"
|
||||
|
||||
(with-gensyms (new-state)
|
||||
(let ((defstate-type (first parents)))
|
||||
(when (not (null? *defstate-type-stack*))
|
||||
(fmt #t "*defstate-type-stack* leaked! An error probably happened in a previous defstate. stack is: {}"
|
||||
*defstate-type-stack*)
|
||||
)
|
||||
(set! *defstate-type-stack* '())
|
||||
;; check for default handlers
|
||||
(let ((default-handlers (assoc defstate-type *default-state-handlers*)))
|
||||
(when (not (null? default-handlers))
|
||||
;;(fmt #t "found default-handlers for {}: {}\n" defstate-type default-handlers)
|
||||
;; event
|
||||
(set! default-handlers (cadr default-handlers))
|
||||
(when (and (eq? event '*no-state*) (car default-handlers))
|
||||
(set! event (car default-handlers)))
|
||||
;; enter
|
||||
(set! default-handlers (cdr default-handlers))
|
||||
(when (and (eq? enter '*no-state*) (car default-handlers))
|
||||
(set! enter (car default-handlers)))
|
||||
;; trans
|
||||
(set! default-handlers (cdr default-handlers))
|
||||
(when (and (eq? trans '*no-state*) (car default-handlers))
|
||||
(set! trans (car default-handlers)))
|
||||
;; exit
|
||||
(set! default-handlers (cdr default-handlers))
|
||||
(when (and (eq? exit '*no-state*) (car default-handlers))
|
||||
(set! exit (car default-handlers)))
|
||||
;; code
|
||||
(set! default-handlers (cdr default-handlers))
|
||||
(when (and (eq? code '*no-state*) (car default-handlers))
|
||||
(set! code (car default-handlers)))
|
||||
;; post
|
||||
(set! default-handlers (cdr default-handlers))
|
||||
(when (and (eq? post '*no-state*) (car default-handlers))
|
||||
(set! post (car default-handlers)))
|
||||
|
||||
(set! default-handlers (cdr default-handlers))
|
||||
)
|
||||
)
|
||||
(def-state-check-behavior event defstate-type)
|
||||
(def-state-check-behavior enter defstate-type)
|
||||
(def-state-check-behavior trans defstate-type)
|
||||
(def-state-check-behavior exit defstate-type)
|
||||
(def-state-check-behavior code defstate-type)
|
||||
(def-state-check-behavior post defstate-type)
|
||||
`(let ((,new-state (new 'static 'state
|
||||
:name (quote ,state-name)
|
||||
:next #f
|
||||
:exit #f
|
||||
:code #f
|
||||
:trans #f
|
||||
:post #f
|
||||
:enter #f
|
||||
:event #f
|
||||
)
|
||||
))
|
||||
;; the compiler will set the fields of the given state and define the symbol.
|
||||
;; This way it can check the individual function types, make sure they make sense, and create
|
||||
;; a state with the appropriate type.
|
||||
,(if virtual
|
||||
`(define-virtual-state-hook ,state-name ,defstate-type ,new-state ,(eq? virtual 'override) :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
|
||||
`(define-state-hook ,state-name ,defstate-type ,new-state :event ,event :enter ,enter :trans ,trans :exit ,exit :code ,code :post ,post)
|
||||
)
|
||||
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro behavior (bindings &rest body)
|
||||
"Define an anonymous behavior for a process state. This may only be used inside a defstate!"
|
||||
|
||||
(let ((behavior-type (first *defstate-type-stack*)))
|
||||
(pop! *defstate-type-stack*)
|
||||
`(lambda :behavior ,behavior-type ,bindings ,@body)
|
||||
)
|
||||
)
|
||||
|
||||
;; set the default handler functions for a process's state handlers
|
||||
(seval (define *default-state-handlers* '()))
|
||||
(defmacro defstatehandler (proc
|
||||
&key (event #f)
|
||||
&key (enter #f)
|
||||
&key (trans #f)
|
||||
&key (exit #f)
|
||||
&key (code #f)
|
||||
&key (post #f))
|
||||
(let ((old (assoc proc *default-state-handlers*))
|
||||
(new (list proc (list event enter trans exit code post))))
|
||||
(if (null? old)
|
||||
(append!! *default-state-handlers* new) ;; add new set of default handlers
|
||||
(dolist (hnd *default-state-handlers*) ;; replace old handlers with new ones
|
||||
(if (eq? (car hnd) old)
|
||||
(set-car! hnd new)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
`(none)
|
||||
)
|
||||
|
||||
(defmacro sext32 (in)
|
||||
`(sar (shl ,in 32) 32)
|
||||
)
|
||||
|
||||
(defmacro .sra (result in sa)
|
||||
`(set! ,result (sext32 (sar (logand #xffffffff (the-as int ,in)) ,sa)))
|
||||
)
|
||||
|
||||
(defmacro .movn (result value check original)
|
||||
`(if (!= ,check 0)
|
||||
(set! ,result (the-as int ,value))
|
||||
(set! ,result (the-as int ,original))
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro .movz (result value check original)
|
||||
`(if (= ,check 0)
|
||||
(set! ,result (the-as int ,value))
|
||||
(set! ,result (the-as int ,original))
|
||||
)
|
||||
)
|
||||
|
||||
(defmacro .mfc0 (&rest stuff)
|
||||
`(empty)
|
||||
)
|
||||
+59
@@ -0,0 +1,59 @@
|
||||
;;-*-Lisp-*-
|
||||
(in-package goal)
|
||||
|
||||
;; definition of type dgo-entry
|
||||
(deftype dgo-entry (structure)
|
||||
((offset uint32 :offset-assert 0)
|
||||
(length uint32 :offset-assert 4)
|
||||
)
|
||||
:method-count-assert 9
|
||||
:size-assert #x8
|
||||
:flag-assert #x900000008
|
||||
)
|
||||
|
||||
;; definition for method 3 of type dgo-entry
|
||||
(defmethod inspect dgo-entry ((obj dgo-entry))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj 'dgo-entry)
|
||||
(format #t "~1Toffset: ~D~%" (-> obj offset))
|
||||
(format #t "~1Tlength: ~D~%" (-> obj length))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type dgo-file
|
||||
(deftype dgo-file (basic)
|
||||
((num-go-files uint32 :offset-assert 4)
|
||||
(total-length uint32 :offset-assert 8)
|
||||
(rsvd uint32 :offset-assert 12)
|
||||
(data uint8 :dynamic :offset-assert 16)
|
||||
)
|
||||
:method-count-assert 9
|
||||
:size-assert #x10
|
||||
:flag-assert #x900000010
|
||||
)
|
||||
|
||||
;; definition for method 3 of type dgo-file
|
||||
(defmethod inspect dgo-file ((obj dgo-file))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tnum-go-files: ~D~%" (-> obj num-go-files))
|
||||
(format #t "~1Ttotal-length: ~D~%" (-> obj total-length))
|
||||
(format #t "~1Trsvd: ~D~%" (-> obj rsvd))
|
||||
(format #t "~1Tdata[0] @ #x~X~%" (-> obj data))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; failed to figure out what this is:
|
||||
0
|
||||
|
||||
|
||||
|
||||
|
||||
+1190
File diff suppressed because it is too large
Load Diff
+756
@@ -0,0 +1,756 @@
|
||||
;;-*-Lisp-*-
|
||||
(in-package goal)
|
||||
|
||||
;; definition of type kernel-context
|
||||
(deftype kernel-context (basic)
|
||||
((prevent-from-run process-mask :offset-assert 4)
|
||||
(require-for-run process-mask :offset-assert 8)
|
||||
(allow-to-run process-mask :offset-assert 12)
|
||||
(next-pid int32 :offset-assert 16)
|
||||
(fast-stack-top pointer :offset-assert 20)
|
||||
(current-process process :offset-assert 24)
|
||||
(relocating-process basic :offset-assert 28)
|
||||
(relocating-min int32 :offset-assert 32)
|
||||
(relocating-max int32 :offset-assert 36)
|
||||
(relocating-offset int32 :offset-assert 40)
|
||||
(relocating-level level :offset-assert 44)
|
||||
(low-memory-message symbol :offset-assert 48)
|
||||
(login-object basic :offset-assert 52)
|
||||
)
|
||||
:method-count-assert 9
|
||||
:size-assert #x38
|
||||
:flag-assert #x900000038
|
||||
)
|
||||
|
||||
;; definition for method 3 of type kernel-context
|
||||
(defmethod inspect kernel-context ((obj kernel-context))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tprevent-from-run: ~D~%" (-> obj prevent-from-run))
|
||||
(format #t "~1Trequire-for-run: ~D~%" (-> obj require-for-run))
|
||||
(format #t "~1Tallow-to-run: ~D~%" (-> obj allow-to-run))
|
||||
(format #t "~1Tnext-pid: ~D~%" (-> obj next-pid))
|
||||
(format #t "~1Tfast-stack-top: #x~X~%" (-> obj fast-stack-top))
|
||||
(format #t "~1Tcurrent-process: ~A~%" (-> obj current-process))
|
||||
(format #t "~1Trelocating-process: ~A~%" (-> obj relocating-process))
|
||||
(format #t "~1Trelocating-min: #x~X~%" (-> obj relocating-min))
|
||||
(format #t "~1Trelocating-max: #x~X~%" (-> obj relocating-max))
|
||||
(format #t "~1Trelocating-offset: ~D~%" (-> obj relocating-offset))
|
||||
(format #t "~1Trelocating-level: ~A~%" (-> obj relocating-level))
|
||||
(format #t "~1Tlow-memory-message: ~A~%" (-> obj low-memory-message))
|
||||
(format #t "~1Tlogin-object: ~A~%" (-> obj login-object))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type time-frame
|
||||
(deftype time-frame (int64)
|
||||
()
|
||||
:method-count-assert 9
|
||||
:size-assert #x8
|
||||
:flag-assert #x900000008
|
||||
)
|
||||
|
||||
;; definition of type clock
|
||||
(deftype clock (basic)
|
||||
((index int32 :offset-assert 4)
|
||||
(mask process-mask :offset-assert 8)
|
||||
(clock-ratio float :offset-assert 12)
|
||||
(accum float :offset-assert 16)
|
||||
(integral-accum float :offset-assert 20)
|
||||
(frame-counter time-frame :offset-assert 24)
|
||||
(old-frame-counter time-frame :offset-assert 32)
|
||||
(integral-frame-counter uint64 :offset-assert 40)
|
||||
(old-integral-frame-counter uint64 :offset-assert 48)
|
||||
(sparticle-data vector :inline :offset-assert 64)
|
||||
(seconds-per-frame float :offset-assert 80)
|
||||
(frames-per-second float :offset-assert 84)
|
||||
(time-adjust-ratio float :offset-assert 88)
|
||||
)
|
||||
:method-count-assert 15
|
||||
:size-assert #x5c
|
||||
:flag-assert #xf0000005c
|
||||
(:methods
|
||||
(new (symbol type int) _type_ 0)
|
||||
(update-rates! (_type_ float) float 9)
|
||||
(advance-by! (_type_ float) clock 10)
|
||||
(tick! (_type_) clock 11)
|
||||
(save! (_type_ (pointer uint64)) int 12)
|
||||
(load! (_type_ (pointer uint64)) int 13)
|
||||
(reset! (_type_) none 14)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 3 of type clock
|
||||
(defmethod inspect clock ((obj clock))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tindex: ~D~%" (-> obj index))
|
||||
(format #t "~1Tmask: ~D~%" (-> obj mask))
|
||||
(format #t "~1Tclock-ratio: ~f~%" (-> obj clock-ratio))
|
||||
(format #t "~1Taccum: ~f~%" (-> obj accum))
|
||||
(format #t "~1Tintegral-accum: ~f~%" (-> obj integral-accum))
|
||||
(format #t "~1Tframe-counter: ~D~%" (-> obj frame-counter))
|
||||
(format #t "~1Told-frame-counter: ~D~%" (-> obj old-frame-counter))
|
||||
(format #t "~1Tintegral-frame-counter: ~D~%" (-> obj integral-frame-counter))
|
||||
(format #t "~1Told-integral-frame-counter: ~D~%" (-> obj old-integral-frame-counter))
|
||||
(format #t "~1Tsparticle-data: ~`vector`P~%" (-> obj sparticle-data))
|
||||
(format #t "~1Tseconds-per-frame: ~f~%" (-> obj seconds-per-frame))
|
||||
(format #t "~1Tframes-per-second: ~f~%" (-> obj frames-per-second))
|
||||
(format #t "~1Ttime-adjust-ratio: ~f~%" (-> obj time-adjust-ratio))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition for method 0 of type clock
|
||||
(defmethod new clock ((allocation symbol) (type-to-make type) (arg0 int))
|
||||
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
|
||||
(set! (-> gp-0 index) arg0)
|
||||
(set! (-> gp-0 frame-counter) (seconds 1000))
|
||||
(set! (-> gp-0 integral-frame-counter) (the-as uint #x493e0))
|
||||
(set! (-> gp-0 old-frame-counter) (+ (-> gp-0 frame-counter) -1))
|
||||
(set! (-> gp-0 old-integral-frame-counter) (+ (-> gp-0 integral-frame-counter) -1))
|
||||
(update-rates! gp-0 1.0)
|
||||
gp-0
|
||||
)
|
||||
)
|
||||
|
||||
;; definition of type thread
|
||||
(deftype thread (basic)
|
||||
((name symbol :offset-assert 4)
|
||||
(process process :offset-assert 8)
|
||||
(previous thread :offset-assert 12)
|
||||
(suspend-hook (function cpu-thread none) :offset-assert 16)
|
||||
(resume-hook (function cpu-thread none) :offset-assert 20)
|
||||
(pc pointer :offset-assert 24)
|
||||
(sp pointer :offset-assert 28)
|
||||
(stack-top pointer :offset-assert 32)
|
||||
(stack-size int32 :offset-assert 36)
|
||||
)
|
||||
:method-count-assert 12
|
||||
:size-assert #x28
|
||||
:flag-assert #xc00000028
|
||||
(:methods
|
||||
(stack-size-set! (_type_ int) none 9)
|
||||
(thread-suspend (_type_) none 10)
|
||||
(thread-resume (_type_) none 11)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 3 of type thread
|
||||
(defmethod inspect thread ((obj thread))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tname: ~A~%" (-> obj name))
|
||||
(format #t "~1Tprocess: ~A~%" (-> obj process))
|
||||
(format #t "~1Tprevious: ~A~%" (-> obj previous))
|
||||
(format #t "~1Tsuspend-hook: ~A~%" (-> obj suspend-hook))
|
||||
(format #t "~1Tresume-hook: ~A~%" (-> obj resume-hook))
|
||||
(format #t "~1Tpc: #x~X~%" (-> obj pc))
|
||||
(format #t "~1Tsp: #x~X~%" (-> obj sp))
|
||||
(format #t "~1Tstack-top: #x~X~%" (-> obj stack-top))
|
||||
(format #t "~1Tstack-size: ~D~%" (-> obj stack-size))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type cpu-thread
|
||||
(deftype cpu-thread (thread)
|
||||
((rreg uint64 7 :offset-assert 40)
|
||||
(freg float 8 :offset-assert 96)
|
||||
(stack uint8 :dynamic :offset-assert 128)
|
||||
)
|
||||
:method-count-assert 12
|
||||
:size-assert #x80
|
||||
:flag-assert #xc00000080
|
||||
(:methods
|
||||
(new (symbol type process symbol int pointer) _type_ 0)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 3 of type cpu-thread
|
||||
(defmethod inspect cpu-thread ((obj cpu-thread))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tname: ~A~%" (-> obj name))
|
||||
(format #t "~1Tprocess: ~A~%" (-> obj process))
|
||||
(format #t "~1Tprevious: ~A~%" (-> obj previous))
|
||||
(format #t "~1Tsuspend-hook: ~A~%" (-> obj suspend-hook))
|
||||
(format #t "~1Tresume-hook: ~A~%" (-> obj resume-hook))
|
||||
(format #t "~1Tpc: #x~X~%" (-> obj pc))
|
||||
(format #t "~1Tsp: #x~X~%" (-> obj sp))
|
||||
(format #t "~1Tstack-top: #x~X~%" (-> obj stack-top))
|
||||
(format #t "~1Tstack-size: ~D~%" (-> obj stack-size))
|
||||
(format #t "~1Trreg[8] @ #x~X~%" (-> obj rreg))
|
||||
(format #t "~1Tfreg[6] @ #x~X~%" (&-> obj freg 2))
|
||||
(format #t "~1Tstack[0] @ #x~X~%" (-> obj stack))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type dead-pool
|
||||
(deftype dead-pool (process-tree)
|
||||
()
|
||||
:method-count-assert 16
|
||||
:size-assert #x24
|
||||
:flag-assert #x1000000024
|
||||
(:methods
|
||||
(new (symbol type int int string) _type_ 0)
|
||||
(get-process (_type_ type int) process 14)
|
||||
(return-process (_type_ process) none 15)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 3 of type dead-pool
|
||||
(defmethod inspect dead-pool ((obj dead-pool))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-68)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tname: ~A~%" (-> obj name))
|
||||
(format #t "~1Tmask: #x~X : (process-mask " (-> obj mask))
|
||||
(let ((s5-0 (-> obj mask)))
|
||||
(if (= (logand s5-0 (process-mask process-tree)) (process-mask process-tree))
|
||||
(format #t "process-tree ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask target)) (process-mask target))
|
||||
(format #t "target ")
|
||||
)
|
||||
(if (= (logand (process-mask collectable) s5-0) (process-mask collectable))
|
||||
(format #t "attackable ")
|
||||
)
|
||||
(if (= (logand (process-mask bit18) s5-0) (process-mask bit18))
|
||||
(format #t "collectable ")
|
||||
)
|
||||
(if (= (logand (process-mask projectile) s5-0) (process-mask projectile))
|
||||
(format #t "projectile ")
|
||||
)
|
||||
(if (= (logand (process-mask no-track) s5-0) (process-mask no-track))
|
||||
(format #t "no-track ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask sleep-code)) (process-mask sleep-code))
|
||||
(format #t "sleep-code ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask actor-pause)) (process-mask actor-pause))
|
||||
(format #t "actor-pause ")
|
||||
)
|
||||
(if (= (logand (process-mask bot) s5-0) (process-mask bot))
|
||||
(format #t "bot ")
|
||||
)
|
||||
(if (= (logand (process-mask vehicle) s5-0) (process-mask vehicle))
|
||||
(format #t "vehicle ")
|
||||
)
|
||||
(if (= (logand (process-mask enemy) s5-0) (process-mask enemy))
|
||||
(format #t "enemy ")
|
||||
)
|
||||
(if (= (logand (process-mask entity) s5-0) (process-mask entity))
|
||||
(format #t "entity ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask heap-shrunk)) (process-mask heap-shrunk))
|
||||
(format #t "heap-shrunk ")
|
||||
)
|
||||
(if (= (logand (process-mask sidekick) s5-0) (process-mask sidekick))
|
||||
(format #t "sidekick ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask going)) (process-mask going))
|
||||
(format #t "going ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask execute)) (process-mask execute))
|
||||
(format #t "execute ")
|
||||
)
|
||||
(if (= (logand (process-mask civilian) s5-0) (shl #x8000 16))
|
||||
(format #t "civilian ")
|
||||
)
|
||||
(if (= (logand (process-mask death) s5-0) (process-mask death))
|
||||
(format #t "death ")
|
||||
)
|
||||
(if (= (logand (process-mask guard) s5-0) (process-mask guard))
|
||||
(format #t "guard ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask no-kill)) (process-mask no-kill))
|
||||
(format #t "no-kill ")
|
||||
)
|
||||
(if (= (logand (process-mask platform) s5-0) (process-mask platform))
|
||||
(format #t "platform ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask freeze)) (process-mask freeze))
|
||||
(format #t "freeze ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask sleep)) (process-mask sleep))
|
||||
(format #t "sleep ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask progress)) (process-mask progress))
|
||||
(format #t "progress ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask menu)) (process-mask menu))
|
||||
(format #t "menu ")
|
||||
)
|
||||
(if (= (logand (process-mask camera) s5-0) (process-mask camera))
|
||||
(format #t "camera ")
|
||||
)
|
||||
(if (= (logand (process-mask ambient) s5-0) (process-mask ambient))
|
||||
(format #t "ambient ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask dark-effect)) (process-mask dark-effect))
|
||||
(format #t "dark-effect ")
|
||||
)
|
||||
(if (= (logand (process-mask crate) s5-0) (process-mask crate))
|
||||
(format #t "crate ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask kernel-run)) (process-mask kernel-run))
|
||||
(format #t "kernel-run ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask movie)) (process-mask movie))
|
||||
(format #t "movie ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask pause)) (process-mask pause))
|
||||
(format #t "pause ")
|
||||
)
|
||||
)
|
||||
(format #t ")~%")
|
||||
(format #t "~1Tclock: ~A~%" (-> obj clock))
|
||||
(format #t "~1Tparent: #x~X~%" (-> obj parent))
|
||||
(format #t "~1Tbrother: #x~X~%" (-> obj brother))
|
||||
(format #t "~1Tchild: #x~X~%" (-> obj child))
|
||||
(format #t "~1Tppointer: #x~X~%" (-> obj ppointer))
|
||||
(format #t "~1Tself: ~A~%" (-> obj self))
|
||||
(label cfg-68)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type dead-pool-heap-rec
|
||||
(deftype dead-pool-heap-rec (structure)
|
||||
((process process :offset-assert 0)
|
||||
(prev dead-pool-heap-rec :offset-assert 4)
|
||||
(next dead-pool-heap-rec :offset-assert 8)
|
||||
)
|
||||
:pack-me
|
||||
:method-count-assert 9
|
||||
:size-assert #xc
|
||||
:flag-assert #x90000000c
|
||||
)
|
||||
|
||||
;; definition for method 3 of type dead-pool-heap-rec
|
||||
(defmethod inspect dead-pool-heap-rec ((obj dead-pool-heap-rec))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj 'dead-pool-heap-rec)
|
||||
(format #t "~1Tprocess: ~A~%" (-> obj process))
|
||||
(format #t "~1Tprev: #<dead-pool-heap-rec @ #x~X>~%" (-> obj prev))
|
||||
(format #t "~1Tnext: #<dead-pool-heap-rec @ #x~X>~%" (-> obj next))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type dead-pool-heap
|
||||
(deftype dead-pool-heap (dead-pool)
|
||||
((allocated-length int32 :offset-assert 36)
|
||||
(compact-time uint32 :offset-assert 40)
|
||||
(compact-count-targ uint32 :offset-assert 44)
|
||||
(compact-count uint32 :offset-assert 48)
|
||||
(fill-percent float :offset-assert 52)
|
||||
(first-gap dead-pool-heap-rec :offset-assert 56)
|
||||
(first-shrink dead-pool-heap-rec :offset-assert 60)
|
||||
(heap kheap :inline :offset-assert 64)
|
||||
(alive-list dead-pool-heap-rec :inline :offset-assert 80)
|
||||
(last dead-pool-heap-rec :offset 84)
|
||||
(dead-list dead-pool-heap-rec :inline :offset-assert 92)
|
||||
(process-list dead-pool-heap-rec :inline :dynamic :offset-assert 104)
|
||||
)
|
||||
:method-count-assert 28
|
||||
:size-assert #x68
|
||||
:flag-assert #x1c00000068
|
||||
(:methods
|
||||
(new (symbol type string int int) _type_ 0)
|
||||
(init (_type_ symbol int) none 16)
|
||||
(compact (dead-pool-heap int) none 17)
|
||||
(shrink-heap (dead-pool-heap process) dead-pool-heap 18)
|
||||
(churn (dead-pool-heap int) none 19)
|
||||
(memory-used (_type_) int 20)
|
||||
(memory-total (_type_) int 21)
|
||||
(memory-free (dead-pool-heap) int 22)
|
||||
(compact-time (dead-pool-heap) uint 23)
|
||||
(gap-size (dead-pool-heap dead-pool-heap-rec) int 24)
|
||||
(gap-location (dead-pool-heap dead-pool-heap-rec) pointer 25)
|
||||
(find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec 26)
|
||||
(find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec 27)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 3 of type dead-pool-heap
|
||||
;; INFO: this function exists in multiple non-identical object files
|
||||
(defmethod inspect dead-pool-heap ((obj dead-pool-heap))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-68)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tname: ~A~%" (-> obj name))
|
||||
(format #t "~1Tmask: #x~X : (process-mask " (-> obj mask))
|
||||
(let ((s5-0 (-> obj mask)))
|
||||
(if (= (logand s5-0 (process-mask process-tree)) (process-mask process-tree))
|
||||
(format #t "process-tree ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask target)) (process-mask target))
|
||||
(format #t "target ")
|
||||
)
|
||||
(if (= (logand (process-mask collectable) s5-0) (process-mask collectable))
|
||||
(format #t "attackable ")
|
||||
)
|
||||
(if (= (logand (process-mask bit18) s5-0) (process-mask bit18))
|
||||
(format #t "collectable ")
|
||||
)
|
||||
(if (= (logand (process-mask projectile) s5-0) (process-mask projectile))
|
||||
(format #t "projectile ")
|
||||
)
|
||||
(if (= (logand (process-mask no-track) s5-0) (process-mask no-track))
|
||||
(format #t "no-track ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask sleep-code)) (process-mask sleep-code))
|
||||
(format #t "sleep-code ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask actor-pause)) (process-mask actor-pause))
|
||||
(format #t "actor-pause ")
|
||||
)
|
||||
(if (= (logand (process-mask bot) s5-0) (process-mask bot))
|
||||
(format #t "bot ")
|
||||
)
|
||||
(if (= (logand (process-mask vehicle) s5-0) (process-mask vehicle))
|
||||
(format #t "vehicle ")
|
||||
)
|
||||
(if (= (logand (process-mask enemy) s5-0) (process-mask enemy))
|
||||
(format #t "enemy ")
|
||||
)
|
||||
(if (= (logand (process-mask entity) s5-0) (process-mask entity))
|
||||
(format #t "entity ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask heap-shrunk)) (process-mask heap-shrunk))
|
||||
(format #t "heap-shrunk ")
|
||||
)
|
||||
(if (= (logand (process-mask sidekick) s5-0) (process-mask sidekick))
|
||||
(format #t "sidekick ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask going)) (process-mask going))
|
||||
(format #t "going ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask execute)) (process-mask execute))
|
||||
(format #t "execute ")
|
||||
)
|
||||
(if (= (logand (process-mask civilian) s5-0) (shl #x8000 16))
|
||||
(format #t "civilian ")
|
||||
)
|
||||
(if (= (logand (process-mask death) s5-0) (process-mask death))
|
||||
(format #t "death ")
|
||||
)
|
||||
(if (= (logand (process-mask guard) s5-0) (process-mask guard))
|
||||
(format #t "guard ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask no-kill)) (process-mask no-kill))
|
||||
(format #t "no-kill ")
|
||||
)
|
||||
(if (= (logand (process-mask platform) s5-0) (process-mask platform))
|
||||
(format #t "platform ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask freeze)) (process-mask freeze))
|
||||
(format #t "freeze ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask sleep)) (process-mask sleep))
|
||||
(format #t "sleep ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask progress)) (process-mask progress))
|
||||
(format #t "progress ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask menu)) (process-mask menu))
|
||||
(format #t "menu ")
|
||||
)
|
||||
(if (= (logand (process-mask camera) s5-0) (process-mask camera))
|
||||
(format #t "camera ")
|
||||
)
|
||||
(if (= (logand (process-mask ambient) s5-0) (process-mask ambient))
|
||||
(format #t "ambient ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask dark-effect)) (process-mask dark-effect))
|
||||
(format #t "dark-effect ")
|
||||
)
|
||||
(if (= (logand (process-mask crate) s5-0) (process-mask crate))
|
||||
(format #t "crate ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask kernel-run)) (process-mask kernel-run))
|
||||
(format #t "kernel-run ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask movie)) (process-mask movie))
|
||||
(format #t "movie ")
|
||||
)
|
||||
(if (= (logand s5-0 (process-mask pause)) (process-mask pause))
|
||||
(format #t "pause ")
|
||||
)
|
||||
)
|
||||
(format #t ")~%")
|
||||
(format #t "~1Tclock: ~A~%" (-> obj clock))
|
||||
(format #t "~1Tparent: #x~X~%" (-> obj parent))
|
||||
(format #t "~1Tbrother: #x~X~%" (-> obj brother))
|
||||
(format #t "~1Tchild: #x~X~%" (-> obj child))
|
||||
(format #t "~1Tppointer: #x~X~%" (-> obj ppointer))
|
||||
(format #t "~1Tself: ~A~%" (-> obj self))
|
||||
(format #t "~1Tallocated-length: ~D~%" (-> obj allocated-length))
|
||||
(format #t "~1Tcompact-time: ~D~%" (-> obj compact-time))
|
||||
(format #t "~1Tcompact-count-targ: ~D~%" (-> obj compact-count-targ))
|
||||
(format #t "~1Tcompact-count: ~D~%" (-> obj compact-count))
|
||||
(format #t "~1Tfill-percent: ~f~%" (-> obj fill-percent))
|
||||
(format #t "~1Tfirst-gap: #<dead-pool-heap-rec @ #x~X>~%" (-> obj first-gap))
|
||||
(format #t "~1Tfirst-shrink: #<dead-pool-heap-rec @ #x~X>~%" (-> obj first-shrink))
|
||||
(format #t "~1Theap: #<kheap @ #x~X>~%" (-> obj heap))
|
||||
(format #t "~1Talive-list: #<dead-pool-heap-rec @ #x~X>~%" (-> obj alive-list))
|
||||
(format #t "~1Tlast: #<dead-pool-heap-rec @ #x~X>~%" (-> obj alive-list prev))
|
||||
(format #t "~1Tdead-list: #<dead-pool-heap-rec @ #x~X>~%" (-> obj dead-list))
|
||||
(format #t "~1Tprocess-list[0] @ #x~X~%" (-> obj process-list))
|
||||
(label cfg-68)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type catch-frame
|
||||
(deftype catch-frame (stack-frame)
|
||||
((sp int32 :offset-assert 12)
|
||||
(ra int32 :offset-assert 16)
|
||||
(freg float 6 :offset-assert 20)
|
||||
(rreg uint128 8 :offset-assert 48)
|
||||
)
|
||||
:method-count-assert 9
|
||||
:size-assert #xb0
|
||||
:flag-assert #x9000000b0
|
||||
(:methods
|
||||
(new (symbol type symbol function (pointer uint64)) object 0)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 3 of type catch-frame
|
||||
(defmethod inspect catch-frame ((obj catch-frame))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tname: ~A~%" (-> obj name))
|
||||
(format #t "~1Tnext: ~A~%" (-> obj next))
|
||||
(format #t "~1Tsp: #x~X~%" (-> obj sp))
|
||||
(format #t "~1Tra: #x~X~%" (-> obj ra))
|
||||
(format #t "~1Tfreg[6] @ #x~X~%" (-> obj freg))
|
||||
(format #t "~1Trreg[8] @ #x~X~%" (-> obj rreg))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type protect-frame
|
||||
(deftype protect-frame (stack-frame)
|
||||
((exit (function none) :offset-assert 12)
|
||||
)
|
||||
:method-count-assert 9
|
||||
:size-assert #x10
|
||||
:flag-assert #x900000010
|
||||
(:methods
|
||||
(new (symbol type (function none)) protect-frame 0)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 3 of type protect-frame
|
||||
(defmethod inspect protect-frame ((obj protect-frame))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tname: ~A~%" (-> obj name))
|
||||
(format #t "~1Tnext: ~A~%" (-> obj next))
|
||||
(format #t "~1Texit: ~A~%" (-> obj exit))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type handle
|
||||
(deftype handle (uint64)
|
||||
((process (pointer process) :offset 0 :size 32)
|
||||
(pid int32 :offset 32 :size 32)
|
||||
(u64 uint64 :offset 0 :size 64)
|
||||
)
|
||||
:method-count-assert 9
|
||||
:size-assert #x8
|
||||
:flag-assert #x900000008
|
||||
)
|
||||
|
||||
;; definition for method 3 of type handle
|
||||
(defmethod inspect handle ((obj handle))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj 'handle)
|
||||
(format #t "~1Tprocess: #x~X~%" (-> obj process))
|
||||
(format #t "~1Tpid: ~D~%" (-> obj pid))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition for method 2 of type handle
|
||||
(defmethod print handle ((obj handle))
|
||||
(if (nonzero? obj)
|
||||
(format #t "#<handle :process ~A :pid ~D>" (handle->process obj) (-> obj pid))
|
||||
(format #t "#<handle :process 0 :pid 0>")
|
||||
)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type state
|
||||
(deftype state (protect-frame)
|
||||
((code function :offset-assert 16)
|
||||
(trans (function none) :offset-assert 20)
|
||||
(post function :offset-assert 24)
|
||||
(enter function :offset-assert 28)
|
||||
(event (function process int symbol event-message-block object) :offset-assert 32)
|
||||
)
|
||||
:method-count-assert 9
|
||||
:size-assert #x24
|
||||
:flag-assert #x900000024
|
||||
(:methods
|
||||
(new (symbol type symbol function (function none) function (function none) (function process int symbol event-message-block object)) _type_ 0)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 3 of type state
|
||||
(defmethod inspect state ((obj state))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tname: ~A~%" (-> obj name))
|
||||
(format #t "~1Tnext: ~A~%" (-> obj next))
|
||||
(format #t "~1Texit: ~A~%" (-> obj exit))
|
||||
(format #t "~1Tcode: ~A~%" (-> obj code))
|
||||
(format #t "~1Ttrans: ~A~%" (-> obj trans))
|
||||
(format #t "~1Tpost: ~A~%" (-> obj post))
|
||||
(format #t "~1Tenter: ~A~%" (-> obj enter))
|
||||
(format #t "~1Tevent: ~A~%" (-> obj event))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type event-message-block
|
||||
(deftype event-message-block (structure)
|
||||
((to-handle handle :offset-assert 0)
|
||||
(to (pointer process) :offset 0)
|
||||
(form-handle handle :offset-assert 8)
|
||||
(from (pointer process) :offset 8)
|
||||
(param uint64 6 :offset-assert 16)
|
||||
(message symbol :offset-assert 64)
|
||||
(num-params int32 :offset-assert 68)
|
||||
)
|
||||
:method-count-assert 9
|
||||
:size-assert #x48
|
||||
:flag-assert #x900000048
|
||||
)
|
||||
|
||||
;; definition for method 3 of type event-message-block
|
||||
(defmethod inspect event-message-block ((obj event-message-block))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-8)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj 'event-message-block)
|
||||
(format #t "~1Tto-handle: ~D~%" (-> obj to-handle))
|
||||
(format #t "~1Tto: ~A~%" (ppointer->process (-> obj to)))
|
||||
(format #t "~1Tfrom-handle: ~D~%" (-> obj form-handle))
|
||||
(format #t "~1Tfrom: ~A~%" (ppointer->process (-> obj from)))
|
||||
(format #t "~1Tparam[6] @ #x~X~%" (-> obj param))
|
||||
(format #t "~1Tmessage: ~A~%" (-> obj message))
|
||||
(format #t "~1Tnum-params: ~D~%" (-> obj num-params))
|
||||
(label cfg-8)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition of type event-message-block-array
|
||||
(deftype event-message-block-array (inline-array-class)
|
||||
((data event-message-block :inline :dynamic :offset-assert 16)
|
||||
)
|
||||
:method-count-assert 10
|
||||
:size-assert #x10
|
||||
:flag-assert #xa00000010
|
||||
(:methods
|
||||
(send-all! (_type_) none 9)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 3 of type event-message-block-array
|
||||
(defmethod inspect event-message-block-array ((obj event-message-block-array))
|
||||
(when (not obj)
|
||||
(set! obj obj)
|
||||
(goto cfg-4)
|
||||
)
|
||||
(format #t "[~8x] ~A~%" obj (-> obj type))
|
||||
(format #t "~1Tlength: ~D~%" (-> obj length))
|
||||
(format #t "~1Tallocated-length: ~D~%" (-> obj allocated-length))
|
||||
(format #t "~1Tdata[0] @ #x~X~%" (-> obj data))
|
||||
(label cfg-4)
|
||||
obj
|
||||
)
|
||||
|
||||
;; failed to figure out what this is:
|
||||
(set! (-> event-message-block-array heap-base) (the-as uint 80))
|
||||
|
||||
;; definition of type sql-result
|
||||
(deftype sql-result (basic)
|
||||
((len int32 :offset-assert 4)
|
||||
(allocated-length uint32 :offset-assert 8)
|
||||
(error symbol :offset-assert 12)
|
||||
(data symbol :dynamic :offset-assert 16)
|
||||
)
|
||||
:method-count-assert 9
|
||||
:size-assert #x10
|
||||
:flag-assert #x900000010
|
||||
(:methods
|
||||
(new (symbol type uint) _type_ 0)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 0 of type sql-result
|
||||
(defmethod new sql-result ((allocation symbol) (type-to-make type) (arg0 uint))
|
||||
(let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* arg0 4))))))
|
||||
(set! (-> v0-0 allocated-length) arg0)
|
||||
(set! (-> v0-0 error) 'error)
|
||||
v0-0
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 2 of type sql-result
|
||||
(defmethod print sql-result ((obj sql-result))
|
||||
(format #t "#(~A" (-> obj error))
|
||||
(dotimes (s5-0 (-> obj len))
|
||||
(format #t " ~A" (-> obj data s5-0))
|
||||
)
|
||||
(format #t ")")
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition for symbol *sql-result*, type sql-result
|
||||
(define *sql-result* (the-as sql-result #f))
|
||||
|
||||
;; failed to figure out what this is:
|
||||
0
|
||||
|
||||
|
||||
|
||||
|
||||
+1692
File diff suppressed because it is too large
Load Diff
+180
@@ -0,0 +1,180 @@
|
||||
;;-*-Lisp-*-
|
||||
(in-package goal)
|
||||
|
||||
;; definition for method 0 of type state
|
||||
(defmethod new state ((allocation symbol)
|
||||
(type-to-make type)
|
||||
(arg0 symbol)
|
||||
(arg1 function)
|
||||
(arg2 (function none))
|
||||
(arg3 function)
|
||||
(arg4 (function none))
|
||||
(arg5 (function process int symbol event-message-block object))
|
||||
)
|
||||
(let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
|
||||
(set! (-> v0-0 name) arg0)
|
||||
(set! (-> v0-0 next) #f)
|
||||
(set! (-> v0-0 exit) arg4)
|
||||
(set! (-> v0-0 code) arg1)
|
||||
(set! (-> v0-0 trans) arg2)
|
||||
(set! (-> v0-0 post) #f)
|
||||
(set! (-> v0-0 enter) arg3)
|
||||
(set! (-> v0-0 event) arg5)
|
||||
v0-0
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function inherit-state
|
||||
(defun inherit-state ((arg0 state) (arg1 state))
|
||||
(set! (-> arg0 exit) (-> arg1 exit))
|
||||
(set! (-> arg0 code) (-> arg1 code))
|
||||
(set! (-> arg0 trans) (-> arg1 trans))
|
||||
(set! (-> arg0 post) (-> arg1 post))
|
||||
(set! (-> arg0 enter) (-> arg1 enter))
|
||||
(set! (-> arg0 event) (-> arg1 event))
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for method 2 of type state
|
||||
(defmethod print state ((obj state))
|
||||
(format #t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj)
|
||||
obj
|
||||
)
|
||||
|
||||
;; definition for function enter-state
|
||||
;; WARN: Unsupported inline assembly instruction kind - [lwu sp, 28(v1)]
|
||||
;; WARN: Unsupported inline assembly instruction kind - [lw ra, return-from-thread-dead(s7)]
|
||||
;; WARN: Unsupported inline assembly instruction kind - [jr t9]
|
||||
;; WARN: Unsupported inline assembly instruction kind - [sw v1, 0(sp)]
|
||||
(defun enter-state ((arg0 object) (arg1 object) (arg2 object) (arg3 object) (arg4 object) (arg5 object))
|
||||
(local-vars (s7-0 none) (sp-0 int) (ra-0 int) (sv-0 none))
|
||||
(with-pp
|
||||
(logclear! (-> pp mask) (process-mask sleep sleep-code))
|
||||
(logior! (-> pp mask) (process-mask going))
|
||||
(cond
|
||||
((= (-> pp status) 'initialize)
|
||||
(set! (-> pp trans-hook) #f)
|
||||
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
|
||||
(set! (-> pp status) 'initialize-go)
|
||||
(throw 'initialize #t)
|
||||
#t
|
||||
)
|
||||
((!= (-> *kernel-context* current-process) pp)
|
||||
(let ((s0-0 (-> pp status)))
|
||||
(set! (-> pp trans-hook) #f)
|
||||
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
|
||||
(set! (-> pp status) s0-0)
|
||||
)
|
||||
#t
|
||||
)
|
||||
((= (-> pp main-thread) (-> pp top-thread))
|
||||
(set! (-> pp state) (-> pp next-state))
|
||||
(let ((s0-1 (-> pp stack-frame-top)))
|
||||
(while s0-1
|
||||
(case (-> s0-1 type)
|
||||
((protect-frame state)
|
||||
((-> (the-as protect-frame s0-1) exit))
|
||||
)
|
||||
)
|
||||
(set! s0-1 (-> s0-1 next))
|
||||
)
|
||||
)
|
||||
(logclear! (-> pp mask) (process-mask going))
|
||||
(let ((s0-2 (-> pp state)))
|
||||
(set! (-> pp event-hook) (-> s0-2 event))
|
||||
(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))
|
||||
(let ((t9-4 (-> s0-2 enter)))
|
||||
(if t9-4
|
||||
((the-as (function object object object object object object none) t9-4) arg0 arg1 arg2 arg3 arg4 arg5)
|
||||
)
|
||||
)
|
||||
(let ((t9-5 (-> s0-2 trans)))
|
||||
(if t9-5
|
||||
(t9-5)
|
||||
)
|
||||
)
|
||||
(let ((v1-28 (-> pp main-thread)))
|
||||
(.lwu sp-0 28 v1-28)
|
||||
)
|
||||
(let ((t9-6 (-> s0-2 code)))
|
||||
(.lw ra-0 return-from-thread-dead s7-0)
|
||||
(.jr t9-6)
|
||||
)
|
||||
)
|
||||
arg4
|
||||
)
|
||||
(else
|
||||
(set! (-> pp trans-hook) #f)
|
||||
(set-to-run (-> pp main-thread) enter-state arg0 arg1 arg2 arg3 arg4 arg5)
|
||||
(when (!= (-> pp top-thread name) 'post)
|
||||
(let ((v1-31 return-from-thread))
|
||||
(.sw v1-31 0 (the-as none sp-0))
|
||||
)
|
||||
)
|
||||
#t
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; failed to figure out what this is:
|
||||
(kmemopen global "event-queue")
|
||||
|
||||
;; failed to figure out what this is:
|
||||
(let ((v1-3 (new 'global 'event-message-block-array 64)))
|
||||
(set! (-> v1-3 length) 0)
|
||||
(set! *event-queue* v1-3)
|
||||
)
|
||||
|
||||
;; failed to figure out what this is:
|
||||
(kmemclose)
|
||||
|
||||
;; definition for function send-event-function
|
||||
(defun send-event-function ((arg0 process-tree) (arg1 event-message-block))
|
||||
(with-pp
|
||||
(when (and arg0 (!= (-> arg0 type) process-tree) (-> (the-as process arg0) event-hook) (-> arg1 from))
|
||||
(let ((gp-0 pp))
|
||||
(set! pp (the-as process arg0))
|
||||
(let ((v0-0 ((-> (the-as process arg0) event-hook) (-> arg1 from 0) (-> arg1 num-params) (-> arg1 message) arg1)))
|
||||
(set! pp gp-0)
|
||||
v0-0
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 9 of type event-message-block-array
|
||||
;; INFO: Return type mismatch int vs none.
|
||||
(defmethod send-all! event-message-block-array ((obj event-message-block-array))
|
||||
(dotimes (s5-0 (-> obj length))
|
||||
(let* ((a1-0 (-> obj data s5-0))
|
||||
(a0-2 (handle->process (-> a1-0 to-handle)))
|
||||
)
|
||||
(if (and a0-2 (handle->process (-> a1-0 form-handle)))
|
||||
(send-event-function a0-2 a1-0)
|
||||
)
|
||||
)
|
||||
)
|
||||
(set! (-> obj length) 0)
|
||||
0
|
||||
(none)
|
||||
)
|
||||
|
||||
;; definition for function looping-code
|
||||
;; WARN: new jak 2 until loop case, check carefully
|
||||
(defun looping-code ()
|
||||
(until #f
|
||||
(suspend)
|
||||
)
|
||||
#f
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
+9
@@ -0,0 +1,9 @@
|
||||
;;-*-Lisp-*-
|
||||
(in-package goal)
|
||||
|
||||
;; failed to figure out what this is:
|
||||
0
|
||||
|
||||
|
||||
|
||||
|
||||
+760
@@ -0,0 +1,760 @@
|
||||
;;-*-Lisp-*-
|
||||
(in-package goal)
|
||||
|
||||
;; definition for method 4 of type string
|
||||
(defmethod length string ((obj string))
|
||||
(let ((v1-0 (-> obj data)))
|
||||
(while (nonzero? (-> v1-0 0))
|
||||
(nop!)
|
||||
(nop!)
|
||||
(nop!)
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
)
|
||||
(&- v1-0 (the-as uint (-> obj data)))
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for method 5 of type string
|
||||
(defmethod asize-of string ((obj string))
|
||||
(+ (-> obj allocated-length) 1 (-> string size))
|
||||
)
|
||||
|
||||
;; definition for function copy-string<-string
|
||||
(defun copy-string<-string ((arg0 string) (arg1 string))
|
||||
(let ((v1-0 (-> arg0 data)))
|
||||
(let ((a1-1 (-> arg1 data)))
|
||||
(while (nonzero? (-> a1-1 0))
|
||||
(set! (-> v1-0 0) (-> a1-1 0))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
(set! a1-1 (&-> a1-1 1))
|
||||
)
|
||||
)
|
||||
(set! (-> v1-0 0) (the-as uint 0))
|
||||
)
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for method 0 of type string
|
||||
(defmethod new string ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string))
|
||||
(cond
|
||||
(arg1
|
||||
(let* ((s2-1 (max (length arg1) arg0))
|
||||
(a0-4 (object-new allocation type-to-make (+ s2-1 1 (-> type-to-make size))))
|
||||
)
|
||||
(set! (-> a0-4 allocated-length) s2-1)
|
||||
(copy-string<-string a0-4 arg1)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(let ((v0-2 (object-new allocation type-to-make (+ arg0 1 (-> type-to-make size)))))
|
||||
(set! (-> v0-2 allocated-length) arg0)
|
||||
v0-2
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function string=
|
||||
(defun string= ((arg0 string) (arg1 string))
|
||||
(let ((a2-0 (-> arg0 data))
|
||||
(v1-0 (-> arg1 data))
|
||||
)
|
||||
(if (or (zero? arg0) (zero? arg1))
|
||||
(return #f)
|
||||
)
|
||||
(while (and (nonzero? (-> a2-0 0)) (nonzero? (-> v1-0 0)))
|
||||
(if (!= (-> a2-0 0) (-> v1-0 0))
|
||||
(return #f)
|
||||
)
|
||||
(set! a2-0 (&-> a2-0 1))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
)
|
||||
(and (zero? (-> a2-0 0)) (zero? (-> v1-0 0)))
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function string-prefix=
|
||||
(defun string-prefix= ((arg0 string) (arg1 string))
|
||||
(let ((v1-0 (-> arg0 data)))
|
||||
(let ((a2-0 (-> arg1 data)))
|
||||
(if (or (zero? arg0) (zero? arg1))
|
||||
(return #f)
|
||||
)
|
||||
(while (and (nonzero? (-> v1-0 0)) (nonzero? (-> a2-0 0)))
|
||||
(if (!= (-> v1-0 0) (-> a2-0 0))
|
||||
(return #f)
|
||||
)
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
(set! a2-0 (&-> a2-0 1))
|
||||
)
|
||||
)
|
||||
(zero? (-> v1-0 0))
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function charp-prefix=
|
||||
(defun charp-prefix= ((arg0 (pointer uint8)) (arg1 (pointer uint8)))
|
||||
(while (and (nonzero? (-> arg0 0)) (nonzero? (-> arg1 0)))
|
||||
(if (!= (-> arg0 0) (-> arg1 0))
|
||||
(return #f)
|
||||
)
|
||||
(set! arg0 (&-> arg0 1))
|
||||
(set! arg1 (&-> arg1 1))
|
||||
)
|
||||
(zero? (-> arg0 0))
|
||||
)
|
||||
|
||||
;; definition for function string-suffix=
|
||||
(defun string-suffix= ((arg0 string) (arg1 string))
|
||||
(let ((s5-0 (-> arg0 data))
|
||||
(gp-0 (-> arg1 data))
|
||||
)
|
||||
(if (or (zero? arg0) (zero? arg1))
|
||||
(return #f)
|
||||
)
|
||||
(let ((s4-0 (length arg0))
|
||||
(v1-5 (length arg1))
|
||||
)
|
||||
(if (< s4-0 v1-5)
|
||||
(return #f)
|
||||
)
|
||||
(let ((v1-7 (&+ s5-0 (- s4-0 v1-5))))
|
||||
(while (and (nonzero? (-> v1-7 0)) (nonzero? (-> gp-0 0)))
|
||||
(if (!= (-> v1-7 0) (-> gp-0 0))
|
||||
(return #f)
|
||||
)
|
||||
(set! v1-7 (&-> v1-7 1))
|
||||
(set! gp-0 (&-> gp-0 1))
|
||||
)
|
||||
(zero? (-> v1-7 0))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function string-position
|
||||
(defun string-position ((arg0 string) (arg1 string))
|
||||
(let ((s5-0 0)
|
||||
(s4-0 (-> arg1 data))
|
||||
)
|
||||
(while (nonzero? (-> s4-0 0))
|
||||
(if (charp-prefix= (-> arg0 data) s4-0)
|
||||
(return s5-0)
|
||||
)
|
||||
(+! s5-0 1)
|
||||
(set! s4-0 (&-> s4-0 1))
|
||||
)
|
||||
)
|
||||
-1
|
||||
)
|
||||
|
||||
;; definition for function string-charp=
|
||||
(defun string-charp= ((arg0 string) (arg1 (pointer uint8)))
|
||||
(let ((v1-0 (-> arg0 data)))
|
||||
(while (and (nonzero? (-> v1-0 0)) (nonzero? (-> arg1 0)))
|
||||
(if (!= (-> v1-0 0) (-> arg1 0))
|
||||
(return #f)
|
||||
)
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
(set! arg1 (&-> arg1 1))
|
||||
)
|
||||
(and (zero? (-> v1-0 0)) (zero? (-> arg1 0)))
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function name=
|
||||
;; ERROR: function was not converted to expressions. Cannot decompile.
|
||||
|
||||
;; definition for function copyn-string<-charp
|
||||
(defun copyn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int))
|
||||
(let ((v1-0 (-> arg0 data)))
|
||||
(dotimes (a3-0 arg2)
|
||||
(set! (-> v1-0 0) (-> arg1 0))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
(set! arg1 (&-> arg1 1))
|
||||
)
|
||||
(set! (-> v1-0 0) (the-as uint 0))
|
||||
)
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for function string<-charp
|
||||
(defun string<-charp ((arg0 string) (arg1 (pointer uint8)))
|
||||
(let ((v1-0 (-> arg0 data)))
|
||||
(while (nonzero? (-> arg1 0))
|
||||
(set! (-> v1-0 0) (-> arg1 0))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
(set! arg1 (&-> arg1 1))
|
||||
)
|
||||
(set! (-> v1-0 0) (the-as uint 0))
|
||||
)
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for function charp<-string
|
||||
(defun charp<-string ((arg0 (pointer uint8)) (arg1 string))
|
||||
(let ((v1-0 (-> arg1 data)))
|
||||
(while (nonzero? (-> v1-0 0))
|
||||
(set! (-> arg0 0) (-> v1-0 0))
|
||||
(set! arg0 (&-> arg0 1))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
)
|
||||
)
|
||||
(set! (-> arg0 0) (the-as uint 0))
|
||||
0
|
||||
)
|
||||
|
||||
;; definition for function copyn-charp<-string
|
||||
;; INFO: Return type mismatch int vs none.
|
||||
(defun copyn-charp<-string ((arg0 (pointer uint8)) (arg1 string) (arg2 int))
|
||||
(let ((v1-0 (-> arg1 data)))
|
||||
(while (and (nonzero? (-> v1-0 0)) (< 1 arg2))
|
||||
(set! (-> arg0 0) (-> v1-0 0))
|
||||
(set! arg0 (&-> arg0 1))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
(set! arg2 (+ arg2 -1))
|
||||
)
|
||||
)
|
||||
(while (> arg2 0)
|
||||
(set! (-> arg0 0) (the-as uint 0))
|
||||
(set! arg0 (&-> arg0 1))
|
||||
(set! arg2 (+ arg2 -1))
|
||||
)
|
||||
0
|
||||
(none)
|
||||
)
|
||||
|
||||
;; definition for function copy-charp<-charp
|
||||
(defun copy-charp<-charp ((arg0 (pointer uint8)) (arg1 (pointer uint8)))
|
||||
(while (nonzero? (-> arg1 0))
|
||||
(set! (-> arg0 0) (-> arg1 0))
|
||||
(set! arg0 (&-> arg0 1))
|
||||
(set! arg1 (&-> arg1 1))
|
||||
)
|
||||
(set! (-> arg0 0) (the-as uint 0))
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for function cat-string<-string
|
||||
(defun cat-string<-string ((arg0 string) (arg1 string))
|
||||
(let ((v1-0 (-> arg0 data)))
|
||||
(let ((a1-1 (-> arg1 data)))
|
||||
(while (nonzero? (-> v1-0 0))
|
||||
(nop!)
|
||||
(nop!)
|
||||
(nop!)
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
)
|
||||
(while (nonzero? (-> a1-1 0))
|
||||
(set! (-> v1-0 0) (-> a1-1 0))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
(set! a1-1 (&-> a1-1 1))
|
||||
)
|
||||
)
|
||||
(set! (-> v1-0 0) (the-as uint 0))
|
||||
)
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for function catn-string<-charp
|
||||
(defun catn-string<-charp ((arg0 string) (arg1 (pointer uint8)) (arg2 int))
|
||||
(let ((v1-0 (-> arg0 data)))
|
||||
(while (nonzero? (-> v1-0 0))
|
||||
(nop!)
|
||||
(nop!)
|
||||
(nop!)
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
)
|
||||
(dotimes (a3-2 arg2)
|
||||
(set! (-> v1-0 0) (-> arg1 0))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
(set! arg1 (&-> arg1 1))
|
||||
)
|
||||
(set! (-> v1-0 0) (the-as uint 0))
|
||||
)
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for function cat-string<-string_to_charp
|
||||
(defun cat-string<-string_to_charp ((arg0 string) (arg1 string) (arg2 (pointer uint8)))
|
||||
(let ((v1-0 (-> arg1 data))
|
||||
(v0-0 (-> arg0 data))
|
||||
)
|
||||
(while (nonzero? (-> v0-0 0))
|
||||
(nop!)
|
||||
(nop!)
|
||||
(nop!)
|
||||
(set! v0-0 (&-> v0-0 1))
|
||||
)
|
||||
(while (and (>= (the-as int arg2) (the-as int v1-0)) (nonzero? (-> v1-0 0)))
|
||||
(set! (-> v0-0 0) (-> v1-0 0))
|
||||
(set! v0-0 (&-> v0-0 1))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
)
|
||||
(set! (-> v0-0 0) (the-as uint 0))
|
||||
v0-0
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function append-character-to-string
|
||||
(defun append-character-to-string ((arg0 string) (arg1 uint8))
|
||||
(let ((v1-0 (-> arg0 data)))
|
||||
(while (nonzero? (-> v1-0 0))
|
||||
(nop!)
|
||||
(nop!)
|
||||
(nop!)
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
)
|
||||
(set! (-> v1-0 0) (the-as uint arg1))
|
||||
(set! (-> v1-0 1) (the-as uint 0))
|
||||
)
|
||||
0
|
||||
0
|
||||
)
|
||||
|
||||
;; definition for function charp-basename
|
||||
(defun charp-basename ((arg0 (pointer uint8)))
|
||||
(let ((v1-0 arg0))
|
||||
(while (nonzero? (-> v1-0 0))
|
||||
(set! v1-0 (&-> v1-0 1))
|
||||
)
|
||||
(while (< (the-as int arg0) (the-as int v1-0))
|
||||
(set! v1-0 (&-> v1-0 -1))
|
||||
(if (or (= (-> v1-0 0) 47) (= (-> v1-0 0) 92))
|
||||
(return (&-> v1-0 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for function clear
|
||||
(defun clear ((arg0 string))
|
||||
(set! (-> arg0 data 0) (the-as uint 0))
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for function string<?
|
||||
(defun string<? ((arg0 string) (arg1 string))
|
||||
(let ((s4-1 (min (length arg0) (length arg1))))
|
||||
(dotimes (v1-4 s4-1)
|
||||
(cond
|
||||
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
|
||||
(return #t)
|
||||
)
|
||||
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
|
||||
(return #f)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
#f
|
||||
)
|
||||
|
||||
;; definition for function string>?
|
||||
(defun string>? ((arg0 string) (arg1 string))
|
||||
(let ((s4-1 (min (length arg0) (length arg1))))
|
||||
(dotimes (v1-4 s4-1)
|
||||
(cond
|
||||
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
|
||||
(return #f)
|
||||
)
|
||||
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
|
||||
(return #t)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
#f
|
||||
)
|
||||
|
||||
;; definition for function string<=?
|
||||
(defun string<=? ((arg0 string) (arg1 string))
|
||||
(let ((s4-1 (min (length arg0) (length arg1))))
|
||||
(dotimes (v1-4 s4-1)
|
||||
(cond
|
||||
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
|
||||
(return #t)
|
||||
)
|
||||
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
|
||||
(return #f)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
#t
|
||||
)
|
||||
|
||||
;; definition for function string>=?
|
||||
(defun string>=? ((arg0 string) (arg1 string))
|
||||
(let ((s4-1 (min (length arg0) (length arg1))))
|
||||
(dotimes (v1-4 s4-1)
|
||||
(cond
|
||||
((< (-> arg0 data v1-4) (-> arg1 data v1-4))
|
||||
(return #f)
|
||||
)
|
||||
((< (-> arg1 data v1-4) (-> arg0 data v1-4))
|
||||
(return #t)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
#t
|
||||
)
|
||||
|
||||
;; definition for symbol *string-tmp-str*, type string
|
||||
(define *string-tmp-str* (new 'global 'string 128 (the-as string #f)))
|
||||
|
||||
;; definition for function string-skip-to-char
|
||||
(defun string-skip-to-char ((arg0 (pointer uint8)) (arg1 uint))
|
||||
(while (and (nonzero? (-> arg0 0)) (!= (-> arg0 0) arg1))
|
||||
(set! arg0 (&-> arg0 1))
|
||||
)
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for function string-cat-to-last-char
|
||||
(defun string-cat-to-last-char ((arg0 string) (arg1 string) (arg2 uint))
|
||||
(let ((s4-0 (&-> (the-as (pointer uint8) arg1) 3)))
|
||||
(let ((v1-0 (string-skip-to-char (-> arg1 data) arg2)))
|
||||
(when (= (-> v1-0 0) arg2)
|
||||
(until (!= (-> v1-0 0) arg2)
|
||||
(set! s4-0 v1-0)
|
||||
(set! v1-0 (string-skip-to-char (&-> v1-0 1) arg2))
|
||||
)
|
||||
)
|
||||
)
|
||||
(cat-string<-string_to_charp arg0 arg1 s4-0)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function string-skip-whitespace
|
||||
(defun string-skip-whitespace ((arg0 (pointer uint8)))
|
||||
(while (and (nonzero? (-> arg0 0)) (or (= (-> arg0 0) 32) (= (-> arg0 0) 9) (= (-> arg0 0) 13) (= (-> arg0 0) 10)))
|
||||
(set! arg0 (&-> arg0 1))
|
||||
)
|
||||
arg0
|
||||
)
|
||||
|
||||
;; definition for function string-suck-up!
|
||||
(defun string-suck-up! ((arg0 string) (arg1 (pointer uint8)))
|
||||
(when (!= arg1 (-> arg0 data))
|
||||
(let ((v1-2 (-> arg0 data)))
|
||||
(while (nonzero? (-> arg1 0))
|
||||
(set! (-> v1-2 0) (-> arg1 0))
|
||||
(set! v1-2 (&-> v1-2 1))
|
||||
(set! arg1 (&-> arg1 1))
|
||||
)
|
||||
(set! (-> v1-2 0) (the-as uint 0))
|
||||
)
|
||||
0
|
||||
)
|
||||
#f
|
||||
)
|
||||
|
||||
;; definition for function string-strip-leading-whitespace!
|
||||
(defun string-strip-leading-whitespace! ((arg0 string))
|
||||
(let ((a1-0 (string-skip-whitespace (-> arg0 data))))
|
||||
(string-suck-up! arg0 a1-0)
|
||||
)
|
||||
#f
|
||||
)
|
||||
|
||||
;; definition for function string-strip-trailing-whitespace!
|
||||
(defun string-strip-trailing-whitespace! ((arg0 string))
|
||||
(when (nonzero? (length arg0))
|
||||
(let ((v1-6 (&+ (-> arg0 data) (+ (length arg0) -1))))
|
||||
(while (and (>= (the-as int v1-6) (the-as int (-> arg0 data)))
|
||||
(or (= (-> v1-6 0) 32) (= (-> v1-6 0) 9) (= (-> v1-6 0) 13) (= (-> v1-6 0) 10))
|
||||
)
|
||||
(set! v1-6 (&-> v1-6 -1))
|
||||
)
|
||||
(set! (-> v1-6 1) (the-as uint 0))
|
||||
)
|
||||
0
|
||||
)
|
||||
#f
|
||||
)
|
||||
|
||||
;; definition for function string-strip-whitespace!
|
||||
(defun string-strip-whitespace! ((arg0 string))
|
||||
(string-strip-trailing-whitespace! arg0)
|
||||
(string-strip-leading-whitespace! arg0)
|
||||
#f
|
||||
)
|
||||
|
||||
;; definition for function string-upcase
|
||||
;; INFO: Return type mismatch int vs none.
|
||||
(defun string-upcase ((arg0 string) (arg1 string))
|
||||
(let* ((a0-1 (-> arg0 data))
|
||||
(a3-0 (-> a0-1 0))
|
||||
(a2-0 1)
|
||||
(v1-0 0)
|
||||
)
|
||||
(while (nonzero? a3-0)
|
||||
(if (and (>= a3-0 (the-as uint 97)) (>= (the-as uint 122) a3-0))
|
||||
(+! a3-0 -32)
|
||||
)
|
||||
(set! (-> arg1 data v1-0) a3-0)
|
||||
(set! a3-0 (-> a0-1 a2-0))
|
||||
(+! a2-0 1)
|
||||
(+! v1-0 1)
|
||||
)
|
||||
(set! (-> arg1 data v1-0) (the-as uint 0))
|
||||
)
|
||||
0
|
||||
(none)
|
||||
)
|
||||
|
||||
;; definition for function string-get-arg!!
|
||||
(defun string-get-arg!! ((arg0 string) (arg1 string))
|
||||
(let ((s4-0 (string-skip-whitespace (-> arg1 data))))
|
||||
(cond
|
||||
((= (-> s4-0 0) 34)
|
||||
(let ((s4-1 (&-> s4-0 1)))
|
||||
(let ((v1-3 s4-1))
|
||||
(while (and (nonzero? (-> s4-1 0)) (!= (-> s4-1 0) 34))
|
||||
(set! s4-1 (&-> s4-1 1))
|
||||
)
|
||||
(copyn-string<-charp arg0 v1-3 (&- s4-1 (the-as uint v1-3)))
|
||||
)
|
||||
(if (= (-> s4-1 0) 34)
|
||||
(set! s4-1 (&-> s4-1 1))
|
||||
)
|
||||
(let ((a1-3 (string-skip-whitespace s4-1)))
|
||||
(string-suck-up! arg1 a1-3)
|
||||
)
|
||||
)
|
||||
(return #t)
|
||||
)
|
||||
((nonzero? (-> s4-0 0))
|
||||
(let ((v1-11 s4-0))
|
||||
(while (and (nonzero? (-> s4-0 0)) (!= (-> s4-0 0) 32) (!= (-> s4-0 0) 9) (!= (-> s4-0 0) 13) (!= (-> s4-0 0) 10))
|
||||
(set! s4-0 (&-> s4-0 1))
|
||||
)
|
||||
(copyn-string<-charp arg0 v1-11 (&- s4-0 (the-as uint v1-11)))
|
||||
)
|
||||
(let ((a1-9 (string-skip-whitespace s4-0)))
|
||||
(string-suck-up! arg1 a1-9)
|
||||
)
|
||||
(return #t)
|
||||
)
|
||||
)
|
||||
)
|
||||
#f
|
||||
)
|
||||
|
||||
;; definition for function string->int
|
||||
(defun string->int ((arg0 string))
|
||||
(let ((a0-1 (-> arg0 data))
|
||||
(v0-0 0)
|
||||
(v1-0 #f)
|
||||
)
|
||||
(cond
|
||||
((= (-> a0-1 0) 35)
|
||||
(let ((a0-2 (&-> a0-1 1)))
|
||||
(cond
|
||||
((or (= (-> a0-2 0) 120) (= (-> a0-2 0) 88))
|
||||
(let ((a0-3 (&-> a0-2 1)))
|
||||
(when (= (-> a0-3 1) 45)
|
||||
(set! v1-0 #t)
|
||||
(set! a0-3 (&-> a0-3 1))
|
||||
)
|
||||
(while (or (and (>= (-> a0-3 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-3 0)))
|
||||
(and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0)))
|
||||
(and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0)))
|
||||
)
|
||||
(cond
|
||||
((and (>= (-> a0-3 0) (the-as uint 65)) (>= (the-as uint 70) (-> a0-3 0)))
|
||||
(set! v0-0 (the-as int (+ (-> a0-3 0) -55 (* v0-0 16))))
|
||||
)
|
||||
((and (>= (-> a0-3 0) (the-as uint 97)) (>= (the-as uint 102) (-> a0-3 0)))
|
||||
(set! v0-0 (the-as int (+ (-> a0-3 0) -87 (* v0-0 16))))
|
||||
)
|
||||
(else
|
||||
(set! v0-0 (the-as int (+ (-> a0-3 0) -48 (* v0-0 16))))
|
||||
)
|
||||
)
|
||||
(set! a0-3 (&-> a0-3 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
((or (= (-> a0-2 0) 98) (= (-> a0-2 0) 66))
|
||||
(let ((a0-4 (&-> a0-2 1)))
|
||||
(while (and (>= (-> a0-4 0) (the-as uint 48)) (>= (the-as uint 49) (-> a0-4 0)))
|
||||
(set! v0-0 (the-as int (+ (-> a0-4 0) -48 (* v0-0 2))))
|
||||
(set! a0-4 (&-> a0-4 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(when (= (-> a0-1 1) 45)
|
||||
(set! v1-0 #t)
|
||||
(set! a0-1 (&-> a0-1 1))
|
||||
)
|
||||
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
|
||||
(set! v0-0 (the-as int (+ (-> a0-1 0) -48 (* 10 v0-0))))
|
||||
(set! a0-1 (&-> a0-1 1))
|
||||
)
|
||||
)
|
||||
)
|
||||
(cond
|
||||
(v1-0
|
||||
(- v0-0)
|
||||
)
|
||||
(else
|
||||
(empty)
|
||||
v0-0
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function string->float
|
||||
(defun string->float ((arg0 string))
|
||||
(let ((a0-1 (-> arg0 data))
|
||||
(f0-0 0.0)
|
||||
(v1-0 #f)
|
||||
)
|
||||
(when (= (-> a0-1 0) 45)
|
||||
(set! v1-0 #t)
|
||||
(set! a0-1 (&-> a0-1 1))
|
||||
)
|
||||
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
|
||||
(set! f0-0 (+ (* 10.0 f0-0) (the float (+ (-> a0-1 0) -48))))
|
||||
(set! a0-1 (&-> a0-1 1))
|
||||
)
|
||||
(when (= (-> a0-1 0) 46)
|
||||
(set! a0-1 (&-> a0-1 1))
|
||||
(let ((a2-4 #xf4240)
|
||||
(a1-12 0)
|
||||
)
|
||||
(while (and (>= (-> a0-1 0) (the-as uint 48)) (>= (the-as uint 57) (-> a0-1 0)))
|
||||
(+! a1-12 (* (+ (-> a0-1 0) -48) (the-as uint a2-4)))
|
||||
(set! a2-4 (/ a2-4 10))
|
||||
(set! a0-1 (&-> a0-1 1))
|
||||
)
|
||||
(+! f0-0 (* 0.0000001 (the float a1-12)))
|
||||
)
|
||||
)
|
||||
(when (= (-> a0-1 0) 101)
|
||||
(let ((a1-16 (&-> a0-1 1))
|
||||
(f1-5 0.0)
|
||||
(a0-2 #f)
|
||||
)
|
||||
(cond
|
||||
((= (-> a1-16 0) 45)
|
||||
(set! a0-2 #t)
|
||||
(set! a1-16 (&-> a1-16 1))
|
||||
)
|
||||
((= (-> a1-16 0) 43)
|
||||
(set! a1-16 (&-> a1-16 1))
|
||||
)
|
||||
)
|
||||
(while (and (>= (-> a1-16 0) (the-as uint 48)) (>= (the-as uint 57) (-> a1-16 0)))
|
||||
(set! f1-5 (+ (* 10.0 f1-5) (the float (+ (-> a1-16 0) -48))))
|
||||
(set! a1-16 (&-> a1-16 1))
|
||||
)
|
||||
(when (!= f1-5 0.0)
|
||||
(let ((f2-6 1.0))
|
||||
(cond
|
||||
(a0-2
|
||||
(dotimes (a0-3 (the int f1-5))
|
||||
(set! f2-6 (* 0.1 f2-6))
|
||||
(nop!)
|
||||
(nop!)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(dotimes (a0-6 (the int f1-5))
|
||||
(set! f2-6 (* 10.0 f2-6))
|
||||
(nop!)
|
||||
(nop!)
|
||||
)
|
||||
)
|
||||
)
|
||||
(set! f0-0 (* f0-0 f2-6))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(if v1-0
|
||||
(- f0-0)
|
||||
f0-0
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function string-get-int32!!
|
||||
(defun string-get-int32!! ((arg0 (pointer int32)) (arg1 string))
|
||||
(cond
|
||||
((string-get-arg!! *string-tmp-str* arg1)
|
||||
(set! (-> arg0 0) (string->int *string-tmp-str*))
|
||||
#t
|
||||
)
|
||||
(else
|
||||
#f
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function string-get-float!!
|
||||
(defun string-get-float!! ((arg0 (pointer float)) (arg1 string))
|
||||
(cond
|
||||
((string-get-arg!! *string-tmp-str* arg1)
|
||||
(set! (-> arg0 0) (string->float *string-tmp-str*))
|
||||
#t
|
||||
)
|
||||
(else
|
||||
#f
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; definition for function string-get-flag!!
|
||||
(defun string-get-flag!! ((arg0 (pointer symbol)) (arg1 string) (arg2 string) (arg3 string))
|
||||
(cond
|
||||
((string-get-arg!! *string-tmp-str* arg1)
|
||||
(cond
|
||||
((or (string= *string-tmp-str* arg2) (string= *string-tmp-str* arg3))
|
||||
(set! (-> arg0 0) (string= *string-tmp-str* arg2))
|
||||
#t
|
||||
)
|
||||
(else
|
||||
#f
|
||||
)
|
||||
)
|
||||
)
|
||||
(else
|
||||
#f
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; failed to figure out what this is:
|
||||
(kmemopen global "gstring-globals")
|
||||
|
||||
;; definition for symbol *debug-draw-pauseable*, type symbol
|
||||
(define *debug-draw-pauseable* #f)
|
||||
|
||||
;; definition for symbol *stdcon0*, type string
|
||||
(define *stdcon0* (new 'global 'string #x4000 (the-as string #f)))
|
||||
|
||||
;; definition for symbol *stdcon1*, type string
|
||||
(define *stdcon1* (new 'global 'string #x4000 (the-as string #f)))
|
||||
|
||||
;; definition for symbol *stdcon*, type string
|
||||
(define *stdcon* *stdcon0*)
|
||||
|
||||
;; definition for symbol *temp-string*, type string
|
||||
(define *temp-string* (new 'global 'string 2048 (the-as string #f)))
|
||||
|
||||
;; failed to figure out what this is:
|
||||
(kmemclose)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -961,6 +961,14 @@ TEST(Jak1TypeConsistency, TypeConsistency) {
|
||||
compiler.run_test_no_load("test/goalc/source_templates/with_game/test-build-all-code.gc");
|
||||
}
|
||||
|
||||
TEST(Jak2TypeConsistency, TypeConsistency) {
|
||||
Compiler compiler(GameVersion::Jak2);
|
||||
compiler.enable_throw_on_redefines();
|
||||
add_expected_type_mismatches(compiler);
|
||||
compiler.run_test_no_load("decompiler/config/jak2/all-types.gc");
|
||||
compiler.run_test_no_load("test/goalc/source_templates/with_game/test-build-all-code.gc");
|
||||
}
|
||||
|
||||
struct VectorFloatRegister {
|
||||
float x = 0;
|
||||
float y = 0;
|
||||
|
||||
@@ -1,9 +1,22 @@
|
||||
{
|
||||
"dgos": [],
|
||||
"dgos": [
|
||||
"CGO/KERNEL.CGO",
|
||||
"CGO/ENGINE.CGO"
|
||||
],
|
||||
|
||||
"skip_compile_files": [],
|
||||
|
||||
"skip_compile_functions": [],
|
||||
"skip_compile_functions": [
|
||||
// GCOMMON
|
||||
// inline assembly
|
||||
"valid?",
|
||||
/// GKERNEL
|
||||
// asm
|
||||
"(method 10 process)",
|
||||
"(method 14 dead-pool)",
|
||||
/// GSTATE
|
||||
"enter-state" // stack pointer asm
|
||||
],
|
||||
|
||||
"skip_compile_states": {}
|
||||
}
|
||||
|
||||
@@ -96,7 +96,7 @@ Decompiler setup_decompiler(const std::vector<DecompilerFile>& files,
|
||||
}
|
||||
|
||||
if (db_files.size() != files.size() + art_files.size()) {
|
||||
lg::error("DB file error.");
|
||||
lg::error("DB file error: {} {} {}", db_files.size(), files.size(), art_files.size());
|
||||
for (auto& f : files) {
|
||||
if (!db_files.count(f.unique_name)) {
|
||||
lg::error("didn't find {}\n", f.unique_name);
|
||||
@@ -431,7 +431,11 @@ int main(int argc, char* argv[]) {
|
||||
if (max_files > 0 && max_files < files.size()) {
|
||||
files.erase(files.begin() + max_files, files.end());
|
||||
}
|
||||
auto art_files = find_art_files(game_name, config->dgos);
|
||||
|
||||
std::vector<DecompilerArtFile> art_files;
|
||||
if (game_name == "jak1") {
|
||||
art_files = find_art_files(game_name, config->dgos);
|
||||
}
|
||||
|
||||
lg::info("Setting up decompiler and loading files...");
|
||||
auto decompiler =
|
||||
|
||||
Reference in New Issue
Block a user