708 lines
23 KiB
Common Lisp
708 lines
23 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; definition of type kernel-context
|
|
(deftype kernel-context (basic)
|
|
((prevent-from-run process-mask)
|
|
(require-for-run process-mask)
|
|
(allow-to-run process-mask)
|
|
(next-pid int32)
|
|
(fast-stack-top pointer)
|
|
(current-process process)
|
|
(relocating-process basic)
|
|
(relocating-min int32)
|
|
(relocating-max int32)
|
|
(relocating-offset int32)
|
|
(relocating-level level)
|
|
(low-memory-message symbol)
|
|
(login-object basic)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type kernel-context
|
|
(defmethod inspect ((this kernel-context))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tprevent-from-run: ~D~%" (-> this prevent-from-run))
|
|
(format #t "~1Trequire-for-run: ~D~%" (-> this require-for-run))
|
|
(format #t "~1Tallow-to-run: ~D~%" (-> this allow-to-run))
|
|
(format #t "~1Tnext-pid: ~D~%" (-> this next-pid))
|
|
(format #t "~1Tfast-stack-top: #x~X~%" (-> this fast-stack-top))
|
|
(format #t "~1Tcurrent-process: ~A~%" (-> this current-process))
|
|
(format #t "~1Trelocating-process: ~A~%" (-> this relocating-process))
|
|
(format #t "~1Trelocating-min: #x~X~%" (-> this relocating-min))
|
|
(format #t "~1Trelocating-max: #x~X~%" (-> this relocating-max))
|
|
(format #t "~1Trelocating-offset: ~D~%" (-> this relocating-offset))
|
|
(format #t "~1Trelocating-level: ~A~%" (-> this relocating-level))
|
|
(format #t "~1Tlow-memory-message: ~A~%" (-> this low-memory-message))
|
|
(format #t "~1Tlogin-object: ~A~%" (-> this login-object))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; definition of type time-frame
|
|
(deftype time-frame (int64)
|
|
()
|
|
)
|
|
|
|
;; definition of type clock
|
|
(deftype clock (basic)
|
|
((index int32)
|
|
(mask process-mask)
|
|
(clock-ratio float)
|
|
(accum float)
|
|
(integral-accum float)
|
|
(frame-counter time-frame)
|
|
(old-frame-counter time-frame)
|
|
(integral-frame-counter uint64)
|
|
(old-integral-frame-counter uint64)
|
|
(sparticle-data vector :inline)
|
|
(seconds-per-frame float)
|
|
(frames-per-second float)
|
|
(time-adjust-ratio float)
|
|
)
|
|
(:methods
|
|
(new (symbol type int) _type_)
|
|
(update-rates! (_type_ float) float)
|
|
(advance-by! (_type_ float) clock)
|
|
(tick! (_type_) clock)
|
|
(save! (_type_ (pointer uint64)) int)
|
|
(load! (_type_ (pointer uint64)) int)
|
|
(reset! (_type_) none)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type clock
|
|
(defmethod inspect ((this clock))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tindex: ~D~%" (-> this index))
|
|
(format #t "~1Tmask: ~D~%" (-> this mask))
|
|
(format #t "~1Tclock-ratio: ~f~%" (-> this clock-ratio))
|
|
(format #t "~1Taccum: ~f~%" (-> this accum))
|
|
(format #t "~1Tintegral-accum: ~f~%" (-> this integral-accum))
|
|
(format #t "~1Tframe-counter: ~D~%" (-> this frame-counter))
|
|
(format #t "~1Told-frame-counter: ~D~%" (-> this old-frame-counter))
|
|
(format #t "~1Tintegral-frame-counter: ~D~%" (-> this integral-frame-counter))
|
|
(format #t "~1Told-integral-frame-counter: ~D~%" (-> this old-integral-frame-counter))
|
|
(format #t "~1Tsparticle-data: ~`vector`P~%" (-> this sparticle-data))
|
|
(format #t "~1Tseconds-per-frame: ~f~%" (-> this seconds-per-frame))
|
|
(format #t "~1Tframes-per-second: ~f~%" (-> this frames-per-second))
|
|
(format #t "~1Ttime-adjust-ratio: ~f~%" (-> this time-adjust-ratio))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; 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)
|
|
(process process)
|
|
(previous thread)
|
|
(suspend-hook (function cpu-thread none))
|
|
(resume-hook (function cpu-thread none))
|
|
(pc pointer)
|
|
(sp pointer)
|
|
(stack-top pointer)
|
|
(stack-size int32)
|
|
)
|
|
(:methods
|
|
(stack-size-set! (_type_ int) none)
|
|
(thread-suspend (_type_) none)
|
|
(thread-resume (_type_) none)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type thread
|
|
(defmethod inspect ((this thread))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tname: ~A~%" (-> this name))
|
|
(format #t "~1Tprocess: ~A~%" (-> this process))
|
|
(format #t "~1Tprevious: ~A~%" (-> this previous))
|
|
(format #t "~1Tsuspend-hook: ~A~%" (-> this suspend-hook))
|
|
(format #t "~1Tresume-hook: ~A~%" (-> this resume-hook))
|
|
(format #t "~1Tpc: #x~X~%" (-> this pc))
|
|
(format #t "~1Tsp: #x~X~%" (-> this sp))
|
|
(format #t "~1Tstack-top: #x~X~%" (-> this stack-top))
|
|
(format #t "~1Tstack-size: ~D~%" (-> this stack-size))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; definition of type cpu-thread
|
|
(deftype cpu-thread (thread)
|
|
((rreg uint64 7)
|
|
(freg float 8)
|
|
(stack uint8 :dynamic)
|
|
)
|
|
(:methods
|
|
(new (symbol type process symbol int pointer) _type_)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type cpu-thread
|
|
(defmethod inspect ((this cpu-thread))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tname: ~A~%" (-> this name))
|
|
(format #t "~1Tprocess: ~A~%" (-> this process))
|
|
(format #t "~1Tprevious: ~A~%" (-> this previous))
|
|
(format #t "~1Tsuspend-hook: ~A~%" (-> this suspend-hook))
|
|
(format #t "~1Tresume-hook: ~A~%" (-> this resume-hook))
|
|
(format #t "~1Tpc: #x~X~%" (-> this pc))
|
|
(format #t "~1Tsp: #x~X~%" (-> this sp))
|
|
(format #t "~1Tstack-top: #x~X~%" (-> this stack-top))
|
|
(format #t "~1Tstack-size: ~D~%" (-> this stack-size))
|
|
(format #t "~1Trreg[8] @ #x~X~%" (-> this rreg))
|
|
(format #t "~1Tfreg[6] @ #x~X~%" (&-> this freg 2))
|
|
(format #t "~1Tstack[0] @ #x~X~%" (-> this stack))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; definition of type dead-pool
|
|
(deftype dead-pool (process-tree)
|
|
()
|
|
(:methods
|
|
(new (symbol type int int string) _type_)
|
|
(get-process (_type_ type int) process)
|
|
(return-process (_type_ process) none)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type dead-pool
|
|
(defmethod inspect ((this dead-pool))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-68)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tname: ~A~%" (-> this name))
|
|
(format #t "~1Tmask: #x~X : (process-mask " (-> this mask))
|
|
(let ((s5-0 (-> this 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~%" (-> this clock))
|
|
(format #t "~1Tparent: #x~X~%" (-> this parent))
|
|
(format #t "~1Tbrother: #x~X~%" (-> this brother))
|
|
(format #t "~1Tchild: #x~X~%" (-> this child))
|
|
(format #t "~1Tppointer: #x~X~%" (-> this ppointer))
|
|
(format #t "~1Tself: ~A~%" (-> this self))
|
|
(label cfg-68)
|
|
this
|
|
)
|
|
|
|
;; definition of type dead-pool-heap-rec
|
|
(deftype dead-pool-heap-rec (structure)
|
|
((process process)
|
|
(prev dead-pool-heap-rec)
|
|
(next dead-pool-heap-rec)
|
|
)
|
|
:pack-me
|
|
)
|
|
|
|
;; definition for method 3 of type dead-pool-heap-rec
|
|
(defmethod inspect ((this dead-pool-heap-rec))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this 'dead-pool-heap-rec)
|
|
(format #t "~1Tprocess: ~A~%" (-> this process))
|
|
(format #t "~1Tprev: #<dead-pool-heap-rec @ #x~X>~%" (-> this prev))
|
|
(format #t "~1Tnext: #<dead-pool-heap-rec @ #x~X>~%" (-> this next))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; definition of type dead-pool-heap
|
|
(deftype dead-pool-heap (dead-pool)
|
|
((allocated-length int32)
|
|
(compact-time uint32)
|
|
(compact-count-targ uint32)
|
|
(compact-count uint32)
|
|
(fill-percent float)
|
|
(first-gap dead-pool-heap-rec)
|
|
(first-shrink dead-pool-heap-rec)
|
|
(heap kheap :inline)
|
|
(alive-list dead-pool-heap-rec :inline)
|
|
(last dead-pool-heap-rec :overlay-at (-> alive-list prev))
|
|
(dead-list dead-pool-heap-rec :inline)
|
|
(process-list dead-pool-heap-rec :inline :dynamic)
|
|
)
|
|
(:methods
|
|
(new (symbol type string int int) _type_)
|
|
(init (_type_ symbol int) none)
|
|
(compact (dead-pool-heap int) none)
|
|
(shrink-heap (dead-pool-heap process) dead-pool-heap)
|
|
(churn (dead-pool-heap int) none)
|
|
(memory-used (_type_) int)
|
|
(memory-total (_type_) int)
|
|
(memory-free (dead-pool-heap) int)
|
|
(compact-time (dead-pool-heap) uint)
|
|
(gap-size (dead-pool-heap dead-pool-heap-rec) int)
|
|
(gap-location (dead-pool-heap dead-pool-heap-rec) pointer)
|
|
(find-gap (dead-pool-heap dead-pool-heap-rec) dead-pool-heap-rec)
|
|
(find-gap-by-size (dead-pool-heap int) dead-pool-heap-rec)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type dead-pool-heap
|
|
;; INFO: this function exists in multiple non-identical object files
|
|
(defmethod inspect ((this dead-pool-heap))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-68)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tname: ~A~%" (-> this name))
|
|
(format #t "~1Tmask: #x~X : (process-mask " (-> this mask))
|
|
(let ((s5-0 (-> this 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~%" (-> this clock))
|
|
(format #t "~1Tparent: #x~X~%" (-> this parent))
|
|
(format #t "~1Tbrother: #x~X~%" (-> this brother))
|
|
(format #t "~1Tchild: #x~X~%" (-> this child))
|
|
(format #t "~1Tppointer: #x~X~%" (-> this ppointer))
|
|
(format #t "~1Tself: ~A~%" (-> this self))
|
|
(format #t "~1Tallocated-length: ~D~%" (-> this allocated-length))
|
|
(format #t "~1Tcompact-time: ~D~%" (-> this compact-time))
|
|
(format #t "~1Tcompact-count-targ: ~D~%" (-> this compact-count-targ))
|
|
(format #t "~1Tcompact-count: ~D~%" (-> this compact-count))
|
|
(format #t "~1Tfill-percent: ~f~%" (-> this fill-percent))
|
|
(format #t "~1Tfirst-gap: #<dead-pool-heap-rec @ #x~X>~%" (-> this first-gap))
|
|
(format #t "~1Tfirst-shrink: #<dead-pool-heap-rec @ #x~X>~%" (-> this first-shrink))
|
|
(format #t "~1Theap: #<kheap @ #x~X>~%" (-> this heap))
|
|
(format #t "~1Talive-list: #<dead-pool-heap-rec @ #x~X>~%" (-> this alive-list))
|
|
(format #t "~1Tlast: #<dead-pool-heap-rec @ #x~X>~%" (-> this alive-list prev))
|
|
(format #t "~1Tdead-list: #<dead-pool-heap-rec @ #x~X>~%" (-> this dead-list))
|
|
(format #t "~1Tprocess-list[0] @ #x~X~%" (-> this process-list))
|
|
(label cfg-68)
|
|
this
|
|
)
|
|
|
|
;; definition of type catch-frame
|
|
(deftype catch-frame (stack-frame)
|
|
((sp int32)
|
|
(ra int32)
|
|
(freg float 10)
|
|
(rreg uint128 7)
|
|
)
|
|
(:methods
|
|
(new (symbol type symbol function (pointer uint64)) object)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type catch-frame
|
|
(defmethod inspect ((this catch-frame))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tname: ~A~%" (-> this name))
|
|
(format #t "~1Tnext: ~A~%" (-> this next))
|
|
(format #t "~1Tsp: #x~X~%" (-> this sp))
|
|
(format #t "~1Tra: #x~X~%" (-> this ra))
|
|
(format #t "~1Tfreg[6] @ #x~X~%" (-> this freg))
|
|
(format #t "~1Trreg[8] @ #x~X~%" (&-> this freg 7))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; definition of type protect-frame
|
|
(deftype protect-frame (stack-frame)
|
|
((exit (function object))
|
|
)
|
|
(:methods
|
|
(new (symbol type (function object)) protect-frame)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type protect-frame
|
|
(defmethod inspect ((this protect-frame))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tname: ~A~%" (-> this name))
|
|
(format #t "~1Tnext: ~A~%" (-> this next))
|
|
(format #t "~1Texit: ~A~%" (-> this exit))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; 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)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type handle
|
|
(defmethod inspect ((this handle))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this 'handle)
|
|
(format #t "~1Tprocess: #x~X~%" (-> this process))
|
|
(format #t "~1Tpid: ~D~%" (-> this pid))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; definition for method 2 of type handle
|
|
(defmethod print ((this handle))
|
|
(if (nonzero? this)
|
|
(format #t "#<handle :process ~A :pid ~D>" (handle->process this) (-> this pid))
|
|
(format #t "#<handle :process 0 :pid 0>")
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition of type state
|
|
(deftype state (protect-frame)
|
|
((code function)
|
|
(trans (function object))
|
|
(post function)
|
|
(enter function)
|
|
(event (function process int symbol event-message-block object))
|
|
)
|
|
(:methods
|
|
(new (symbol type symbol function (function object) function (function object) (function process int symbol event-message-block object)) _type_)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type state
|
|
(defmethod inspect ((this state))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tname: ~A~%" (-> this name))
|
|
(format #t "~1Tnext: ~A~%" (-> this next))
|
|
(format #t "~1Texit: ~A~%" (-> this exit))
|
|
(format #t "~1Tcode: ~A~%" (-> this code))
|
|
(format #t "~1Ttrans: ~A~%" (-> this trans))
|
|
(format #t "~1Tpost: ~A~%" (-> this post))
|
|
(format #t "~1Tenter: ~A~%" (-> this enter))
|
|
(format #t "~1Tevent: ~A~%" (-> this event))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; definition of type event-message-block
|
|
(deftype event-message-block (structure)
|
|
((to-handle handle)
|
|
(to (pointer process) :overlay-at to-handle)
|
|
(form-handle handle)
|
|
(from (pointer process) :overlay-at form-handle)
|
|
(param uint64 6)
|
|
(message symbol)
|
|
(num-params int32)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type event-message-block
|
|
(defmethod inspect ((this event-message-block))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-8)
|
|
)
|
|
(format #t "[~8x] ~A~%" this 'event-message-block)
|
|
(format #t "~1Tto-handle: ~D~%" (-> this to-handle))
|
|
(format #t "~1Tto: ~A~%" (ppointer->process (-> this to)))
|
|
(format #t "~1Tfrom-handle: ~D~%" (-> this form-handle))
|
|
(format #t "~1Tfrom: ~A~%" (ppointer->process (-> this from)))
|
|
(format #t "~1Tparam[6] @ #x~X~%" (-> this param))
|
|
(format #t "~1Tmessage: ~A~%" (-> this message))
|
|
(format #t "~1Tnum-params: ~D~%" (-> this num-params))
|
|
(label cfg-8)
|
|
this
|
|
)
|
|
|
|
;; definition of type event-message-block-array
|
|
(deftype event-message-block-array (inline-array-class)
|
|
((data event-message-block :inline :dynamic)
|
|
)
|
|
(:methods
|
|
(send-all! (_type_) none)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type event-message-block-array
|
|
(defmethod inspect ((this event-message-block-array))
|
|
(when (not this)
|
|
(set! this this)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~1Tlength: ~D~%" (-> this length))
|
|
(format #t "~1Tallocated-length: ~D~%" (-> this allocated-length))
|
|
(format #t "~1Tdata[0] @ #x~X~%" (-> this data))
|
|
(label cfg-4)
|
|
this
|
|
)
|
|
|
|
;; 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)
|
|
(allocated-length uint32)
|
|
(error symbol)
|
|
(data string :dynamic)
|
|
)
|
|
(:methods
|
|
(new (symbol type uint) _type_)
|
|
)
|
|
)
|
|
|
|
;; 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 ((this sql-result))
|
|
(format #t "#(~A" (-> this error))
|
|
(dotimes (s5-0 (-> this len))
|
|
(format #t " ~A" (-> this data s5-0))
|
|
)
|
|
(format #t ")")
|
|
this
|
|
)
|
|
|
|
;; definition for symbol *sql-result*, type sql-result
|
|
(define *sql-result* (the-as sql-result #f))
|
|
|
|
;; failed to figure out what this is:
|
|
0
|