Files
ManDude cd68cb671e deftype and defmethod syntax major changes (#3094)
Major change to how `deftype` shows up in our code:
- the decompiler will no longer emit the `offset-assert`,
`method-count-assert`, `size-assert` and `flag-assert` parameters. There
are extremely few cases where having this in the decompiled code is
helpful, as the types there come from `all-types` which already has
those parameters. This also doesn't break type consistency because:
  - the asserts aren't compared.
- the first step of the test uses `all-types`, which has the asserts,
which will throw an error if they're bad.
- the decompiler won't emit the `heap-base` parameter unless necessary
now.
- the decompiler will try its hardest to turn a fixed-offset field into
an `overlay-at` field. It falls back to the old offset if all else
fails.
- `overlay-at` now supports field "dereferencing" to specify the offset
that's within a field that's a structure, e.g.:
```lisp
(deftype foobar (structure)
  ((vec    vector  :inline)
   (flags  int32   :overlay-at (-> vec w))
   )
  )
```
in this structure, the offset of `flags` will be 12 because that is the
final offset of `vec`'s `w` field within this structure.
- **removed ID from all method declarations.** IDs are only ever
automatically assigned now. Fixes #3068.
- added an `:overlay` parameter to method declarations, in order to
declare a new method that goes on top of a previously-defined method.
Syntax is `:overlay <method-name>`. Please do not ever use this.
- added `state-methods` list parameter. This lets you quickly specify a
list of states to be put in the method table. Same syntax as the
`states` list parameter. The decompiler will try to put as many states
in this as it can without messing with the method ID order.

Also changes `defmethod` to make the first type definition (before the
arguments) optional. The type can now be inferred from the first
argument. Fixes #3093.

---------

Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
2023-10-30 03:20:02 +00:00

847 lines
34 KiB
Common Lisp
Vendored
Generated

;;-*-Lisp-*-
(in-package goal)
;; definition of type level-vis-info
(deftype level-vis-info (basic)
((level level)
(from-level symbol)
(from-bsp bsp-header)
(flags vis-info-flag)
(length uint32)
(allocated-length uint32)
(dictionary-length uint32)
(dictionary uint32)
(string-block uint32)
(ramdisk uint32)
(vis-bits uint32)
(current-vis-string uint32)
(vis-string uint32 :dynamic)
)
)
;; definition for method 3 of type level-vis-info
(defmethod inspect ((this level-vis-info))
(when (not this)
(set! this this)
(goto cfg-68)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Tlevel: ~A~%" (-> this level))
(format #t "~1Tfrom-level: ~A~%" (-> this from-level))
(format #t "~1Tfrom-bsp: ~A~%" (-> this from-bsp))
(format #t "~1Tflags: #x~X : (vis-info-flag " (-> this flags))
(let ((s5-0 (-> this flags)))
(if (= (logand (vis-info-flag dummy22) s5-0) (vis-info-flag dummy22))
(format #t "dummy22 ")
)
(if (= (logand s5-0 (vis-info-flag dummy14)) (vis-info-flag dummy14))
(format #t "dummy14 ")
)
(if (= (logand s5-0 (vis-info-flag dummy9)) (vis-info-flag dummy9))
(format #t "dummy9 ")
)
(if (= (logand s5-0 (vis-info-flag dummy10)) (vis-info-flag dummy10))
(format #t "dummy10 ")
)
(if (= (logand (vis-info-flag dummy23) s5-0) (vis-info-flag dummy23))
(format #t "dummy23 ")
)
(if (= (logand s5-0 (vis-info-flag dummy15)) (vis-info-flag dummy15))
(format #t "dummy15 ")
)
(if (= (logand s5-0 (vis-info-flag dummy5)) (vis-info-flag dummy5))
(format #t "dummy5 ")
)
(if (= (logand s5-0 (vis-info-flag dummy7)) (vis-info-flag dummy7))
(format #t "dummy7 ")
)
(if (= (logand s5-0 (vis-info-flag dummy1)) (vis-info-flag dummy1))
(format #t "dummy1 ")
)
(if (= (logand s5-0 (vis-info-flag dummy11)) (vis-info-flag dummy11))
(format #t "dummy11 ")
)
(if (= (logand (vis-info-flag dummy28) s5-0) (vis-info-flag dummy28))
(format #t "dummy28 ")
)
(if (= (logand (vis-info-flag dummy24) s5-0) (vis-info-flag dummy24))
(format #t "dummy24 ")
)
(if (= (logand s5-0 (vis-info-flag dummy3)) (vis-info-flag dummy3))
(format #t "dummy3 ")
)
(if (= (logand (vis-info-flag dummy16) s5-0) (vis-info-flag dummy16))
(format #t "dummy16 ")
)
(if (= (logand (vis-info-flag dummy17) s5-0) (vis-info-flag dummy17))
(format #t "dummy17 ")
)
(if (= (logand (vis-info-flag dummy20) s5-0) (vis-info-flag dummy20))
(format #t "dummy20 ")
)
(if (= (logand s5-0 (vis-info-flag dummy12)) (vis-info-flag dummy12))
(format #t "dummy12 ")
)
(if (= (logand (vis-info-flag loading) s5-0) (vis-info-flag loading))
(format #t "loading ")
)
(if (= (logand (vis-info-flag dummy25) s5-0) (vis-info-flag dummy25))
(format #t "dummy25 ")
)
(if (= (logand s5-0 (vis-info-flag dummy6)) (vis-info-flag dummy6))
(format #t "dummy6 ")
)
(if (= (logand (vis-info-flag vis-valid) s5-0) (shl #x8000 16))
(format #t "vis-valid ")
)
(if (= (logand (vis-info-flag in-iop) s5-0) (vis-info-flag in-iop))
(format #t "in-iop ")
)
(if (= (logand (vis-info-flag dummy18) s5-0) (vis-info-flag dummy18))
(format #t "dummy18 ")
)
(if (= (logand s5-0 (vis-info-flag dummy8)) (vis-info-flag dummy8))
(format #t "dummy8 ")
)
(if (= (logand s5-0 (vis-info-flag dummy2)) (vis-info-flag dummy2))
(format #t "dummy2 ")
)
(if (= (logand (vis-info-flag dummy21) s5-0) (vis-info-flag dummy21))
(format #t "dummy21 ")
)
(if (= (logand s5-0 (vis-info-flag dummy13)) (vis-info-flag dummy13))
(format #t "dummy13 ")
)
(if (= (logand s5-0 (vis-info-flag dummy4)) (vis-info-flag dummy4))
(format #t "dummy4 ")
)
(if (= (logand (vis-info-flag dummy26) s5-0) (vis-info-flag dummy26))
(format #t "dummy26 ")
)
(if (= (logand (vis-info-flag dummy27) s5-0) (vis-info-flag dummy27))
(format #t "dummy27 ")
)
(if (= (logand (vis-info-flag dummy19) s5-0) (vis-info-flag dummy19))
(format #t "dummy19 ")
)
(if (= (logand s5-0 (vis-info-flag dummy0)) (vis-info-flag dummy0))
(format #t "dummy0 ")
)
)
(format #t ")~%")
(format #t "~1Tlength: ~D~%" (-> this length))
(format #t "~1Tallocated-length: ~D~%" (-> this allocated-length))
(format #t "~1Tdictionary-length: ~D~%" (-> this dictionary-length))
(format #t "~1Tdictionary: #x~X~%" (-> this dictionary))
(format #t "~1Tstring-block: #x~X~%" (-> this string-block))
(format #t "~1Tramdisk: ~D~%" (-> this ramdisk))
(format #t "~1Tvis-bits: #x~X~%" (-> this vis-bits))
(format #t "~1Tcurrent-vis-string: ~D~%" (-> this current-vis-string))
(format #t "~1Tvis-string[0] @ #x~X~%" (-> this vis-string))
(label cfg-68)
this
)
;; definition for method 5 of type level-vis-info
;; WARN: Return type mismatch uint vs int.
(defmethod asize-of ((this level-vis-info))
(the-as int (+ (-> level-vis-info size) (-> this dictionary-length)))
)
;; definition of type level-load-info
(deftype level-load-info (basic)
((name-list symbol 6)
(index int16)
(task-level uint8)
(name symbol :overlay-at (-> name-list 0))
(visname symbol :overlay-at (-> name-list 1))
(nickname symbol :overlay-at (-> name-list 2))
(dbname symbol :overlay-at (-> name-list 3))
(taskname symbol :overlay-at (-> name-list 4))
(other-name-1 symbol :overlay-at (-> name-list 5))
(packages pair)
(memory-mode load-buffer-mode)
(music-bank symbol)
(ambient-sounds symbol)
(sound-reverb float)
(mood-func symbol)
(mood-init symbol)
(ocean symbol)
(sky symbol)
(use-camera-other symbol)
(part-engine-max int32)
(city-map-bits uint64)
(continues pair)
(tasks pair)
(priority int32)
(load-commands pair)
(alt-load-commands pair)
(bsp-mask uint64)
(buzzer int32)
(buttom-height meters)
(run-packages pair)
(prev-level symbol)
(next-level symbol)
(wait-for-load symbol)
(login-func symbol)
(activate-func symbol)
(deactivate-func symbol)
(kill-func symbol)
(borrow-size uint16 2)
(borrow-level symbol 2)
(borrow-display? symbol 2)
(base-task-mask task-mask)
(texture-anim symbol 10)
(texture-anim-tfrag symbol :overlay-at (-> texture-anim 0))
(texture-anim-pris symbol :overlay-at (-> texture-anim 1))
(texture-anim-shrub symbol :overlay-at (-> texture-anim 2))
(texture-anim-alpha symbol :overlay-at (-> texture-anim 3))
(texture-anim-water symbol :overlay-at (-> texture-anim 4))
(texture-anim-twarp symbol :overlay-at (-> texture-anim 5))
(texture-anim-pris2 symbol :overlay-at (-> texture-anim 6))
(texture-anim-sprite symbol :overlay-at (-> texture-anim 7))
(texture-anim-map symbol :overlay-at (-> texture-anim 8))
(texture-anim-sky symbol :overlay-at (-> texture-anim 9))
(draw-priority float)
(level-flags uint32)
(fog-height float)
(bigmap-id bigmap-id)
(ocean-near-translucent? symbol)
(ocean-far? symbol)
(mood-range mood-range :inline)
(max-rain float)
(fog-mult float)
(ocean-alpha float)
(extra-sound-bank pair)
)
:pack-me
)
;; definition for method 3 of type level-load-info
(defmethod inspect ((this level-load-info))
(when (not this)
(set! this this)
(goto cfg-51)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Tname-list[6] @ #x~X~%" (&-> this name))
(format #t "~1Tindex: ~D~%" (-> this index))
(format #t "~1Ttask-level: ~D~%" (-> this task-level))
(format #t "~1Tname: ~A~%" (-> this name))
(format #t "~1Tvisname: ~A~%" (-> this visname))
(format #t "~1Tnickname: ~A~%" (-> this nickname))
(format #t "~1Tdbname: ~A~%" (-> this dbname))
(format #t "~1Ttaskname: ~A~%" (-> this taskname))
(format #t "~1Tpackages: ~A~%" (-> this packages))
(format #t "~1Tmemory-mode: ~D~%" (-> this memory-mode))
(format #t "~1Tmusic-bank: ~A~%" (-> this music-bank))
(format #t "~1Tambient-sounds: ~A~%" (-> this ambient-sounds))
(format #t "~1Tsound-reverb: ~f~%" (-> this sound-reverb))
(format #t "~1Tmood-func: ~A~%" (-> this mood-func))
(format #t "~1Tmood-init: ~A~%" (-> this mood-init))
(format #t "~1Tocean: ~A~%" (-> this ocean))
(format #t "~1Tsky: ~A~%" (-> this sky))
(format #t "~1Tuse-camera-other: ~A~%" (-> this use-camera-other))
(format #t "~1Tpart-engine-max: ~D~%" (-> this part-engine-max))
(format #t "~1Tcity-map-bits: ~D~%" (-> this city-map-bits))
(format #t "~1Tcontinues: ~A~%" (-> this continues))
(format #t "~1Ttasks: ~A~%" (-> this tasks))
(format #t "~1Tpriority: ~D~%" (-> this priority))
(format #t "~1Tload-commands: ~A~%" (-> this load-commands))
(format #t "~1Talt-load-commands: ~A~%" (-> this alt-load-commands))
(format #t "~1Tbsp-mask: ~D~%" (-> this bsp-mask))
(format #t "~1Tbuzzer: ~D~%" (-> this buzzer))
(format #t "~1Tbottom-height: (meters ~m)~%" (-> this buttom-height))
(format #t "~1Trun-packages: ~A~%" (-> this run-packages))
(format #t "~1Tprev-level: ~A~%" (-> this prev-level))
(format #t "~1Tnext-level: ~A~%" (-> this next-level))
(format #t "~1Twait-for-load: ~A~%" (-> this wait-for-load))
(format #t "~1Tlogin-func: ~A~%" (-> this login-func))
(format #t "~1Tactivate-func: ~A~%" (-> this activate-func))
(format #t "~1Tdeactivate-func: ~A~%" (-> this deactivate-func))
(format #t "~1Tkill-func: ~A~%" (-> this kill-func))
(format #t "~1Tborrow-size[2] @ #x~X~%" (-> this borrow-size))
(dotimes (s5-0 2)
(format #t "~T [~D]~1Tborrow-size: ~`integer`P~%" s5-0 (-> this borrow-size s5-0))
)
(format #t "~1Tborrow-level[2] @ #x~X~%" (-> this borrow-level))
(dotimes (s5-1 2)
(format #t "~T [~D]~1Tborrow-level: ~`symbol`P~%" s5-1 (-> this borrow-level s5-1))
)
(format #t "~1Tborrow-display?[2] @ #x~X~%" (-> this borrow-display?))
(dotimes (s5-2 2)
(format #t "~T [~D]~1Tborrow-display?: ~A~%" s5-2 (-> this borrow-display? s5-2))
)
(format #t "~1Tbase-task-mask: #x~X : (task-mask " (-> this base-task-mask))
(let ((s5-3 (-> this base-task-mask)))
(if (= (logand s5-3 (task-mask task0)) (task-mask task0))
(format #t "task0 ")
)
(if (= (logand s5-3 (task-mask task2)) (task-mask task2))
(format #t "task2 ")
)
(if (= (logand s5-3 (task-mask task4)) (task-mask task4))
(format #t "task4 ")
)
(if (= (logand s5-3 (task-mask task6)) (task-mask task6))
(format #t "task6 ")
)
(if (= (logand s5-3 (task-mask ctywide)) (task-mask ctywide))
(format #t "ctywide ")
)
(if (= (logand s5-3 (task-mask never)) (task-mask never))
(format #t "never ")
)
(if (= (logand (task-mask movie1) s5-3) (task-mask movie1))
(format #t "movie1 ")
)
(if (= (logand s5-3 (task-mask dummy1)) (task-mask dummy1))
(format #t "dummy1 ")
)
(if (= (logand s5-3 (task-mask primary0)) (task-mask primary0))
(format #t "primary0 ")
)
(if (= (logand s5-3 (task-mask task1)) (task-mask task1))
(format #t "task1 ")
)
(if (= (logand s5-3 (task-mask task3)) (task-mask task3))
(format #t "task3 ")
)
(if (= (logand s5-3 (task-mask task5)) (task-mask task5))
(format #t "task5 ")
)
(if (= (logand s5-3 (task-mask task7)) (task-mask task7))
(format #t "task7 ")
)
(if (= (logand (task-mask movie2) s5-3) (task-mask movie2))
(format #t "movie2 ")
)
(if (= (logand s5-3 (task-mask dummy2)) (task-mask dummy2))
(format #t "dummy2 ")
)
(if (= (logand s5-3 (task-mask done)) (task-mask done))
(format #t "done ")
)
(if (= (logand s5-3 (task-mask special)) (task-mask special))
(format #t "special ")
)
(if (= (logand (task-mask movie0) s5-3) (task-mask movie0))
(format #t "movie0 ")
)
(if (= (logand s5-3 (task-mask dummy0)) (task-mask dummy0))
(format #t "dummy0 ")
)
)
(format #t ")~%")
(format #t "~1Ttexture-anim[10] @ #x~X~%" (&-> this texture-anim-tfrag))
(format #t "~1Ttexture-anim-tfrag: ~A~%" (-> this texture-anim-tfrag))
(format #t "~1Ttexture-anim-pris: ~A~%" (-> this texture-anim-pris))
(format #t "~1Ttexture-anim-shrub: ~A~%" (-> this texture-anim-shrub))
(format #t "~1Ttexture-anim-alpha: ~A~%" (-> this texture-anim-alpha))
(format #t "~1Ttexture-anim-water: ~A~%" (-> this texture-anim-water))
(format #t "~1Ttexture-anim-warp: ~A~%" (-> this texture-anim-twarp))
(format #t "~1Ttexture-anim-pris2: ~A~%" (-> this texture-anim-pris2))
(format #t "~1Ttexture-anim-sprite: ~A~%" (-> this texture-anim-sprite))
(format #t "~1Ttexture-anim-map: ~A~%" (-> this texture-anim-map))
(format #t "~1Ttexture-anim-sky: ~A~%" (-> this texture-anim-sky))
(format #t "~1Tdraw-priority: ~f~%" (-> this draw-priority))
(format #t "~1Tlevel-flags: ~D~%" (-> this level-flags))
(format #t "~1Tfog-height: ~f~%" (-> this fog-height))
(format #t "~1Tbigmap-id: ~D~%" (-> this bigmap-id))
(format #t "~1Tocean-near-translucent?: ~A~%" (-> this ocean-near-translucent?))
(format #t "~1Tocean-far?: ~A~%" (-> this ocean-far?))
(format #t "~1Tmood-range: #<mood-range @ #x~X>~%" (-> this mood-range))
(format #t "~1Tmax-rain: ~f~%" (-> this max-rain))
(format #t "~1Tfog-mult: ~f~%" (-> this fog-mult))
(format #t "~1Tocean-alpha: ~f~%" (-> this ocean-alpha))
(format #t "~1Textra-sound-bank: ~A~%" (-> this extra-sound-bank))
(label cfg-51)
this
)
;; definition of type login-state
(deftype login-state (basic)
((state int32)
(pos uint32)
(elts uint32)
(elt drawable 16)
)
)
;; definition for method 3 of type login-state
(defmethod inspect ((this login-state))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Tstate: ~D~%" (-> this state))
(format #t "~1Tpos: ~D~%" (-> this pos))
(format #t "~1Telts: ~D~%" (-> this elts))
(format #t "~1Telt[16] @ #x~X~%" (-> this elt))
(label cfg-4)
this
)
;; definition of type level
(deftype level (basic)
((name symbol)
(load-name symbol)
(nickname symbol)
(index int32)
(status symbol)
(borrow-level level 2)
(borrow-from-level level)
(heap kheap :inline)
(borrow-heap kheap 2 :inline)
(bsp bsp-header)
(art-group load-dir-art-group)
(info level-load-info)
(texture-page texture-page 18)
(loaded-texture-page texture-page 16)
(loaded-texture-page-count int32)
(entity entity-links-array)
(closest-object float)
(closest-object-array float 18 :overlay-at closest-object)
(upload-size int32 18 :offset 324)
(inside-boxes symbol)
(display? symbol)
(render? symbol)
(meta-inside? symbol)
(force-inside? symbol)
(mood-context mood-context :inline)
(mood-func (function mood-context float int none))
(mood-init (function mood-context none))
(vis-bits pointer)
(all-visible? symbol)
(force-all-visible? symbol)
(linking symbol)
(vis-info level-vis-info 8)
(vis-self-index int32)
(vis-adj-index int32)
(vis-buffer uint8 2048)
(mem-usage-block memory-usage-block)
(mem-usage int32)
(code-memory-start pointer)
(code-memory-end pointer)
(load-start-time time-frame)
(load-stop-time time-frame)
(load-buffer uint32 2)
(load-buffer-size uint32)
(load-buffer-last uint32)
(load-buffer-mode load-buffer-mode)
(display-start-time time-frame)
(memory-mask uint32)
(task-mask task-mask)
(tfrag-gs-test gs-test)
(texture-dirty-masks texture-mask 10 :inline)
(texture-mask texture-mask 18 :inline)
(sky-mask texture-mask :inline)
(tfrag-masks texture-masks-array)
(tfrag-dists pointer)
(shrub-masks texture-masks-array)
(shrub-dists pointer)
(alpha-masks texture-masks-array)
(alpha-dists pointer)
(water-masks texture-masks-array)
(water-dists pointer)
(tfrag-last-calls int32 6)
(tfrag-last-calls-u32 uint32 6 :overlay-at (-> tfrag-last-calls 0))
(texture-anim-array texture-anim-array 10)
(light-hash light-hash)
(draw-priority float)
(draw-index int32)
(part-engine engine)
(user-object basic 4)
(loaded-text-info-count int32)
(loaded-text-info game-text-info 8)
(level-type type)
(load-order int64)
(pad int8 12)
)
(:methods
(deactivate (_type_) _type_)
(is-object-visible? (_type_ int) symbol)
(level-method-11 () none)
(unload! (_type_) _type_)
(bsp-name (_type_) symbol)
(compute-memory-usage! (_type_ symbol) memory-usage-block)
(inside-boxes-check (_type_ vector) symbol)
(update-vis! (_type_ level-vis-info uint (pointer uint8)) symbol)
(load-continue (_type_) _type_)
(load-begin (_type_) _type_)
(login-begin (_type_) _type_)
(debug-print-region-splitbox (_type_ vector object) none)
(get-art-group-by-name (_type_ string) art-group)
(level-method-22 (_type_ symbol) int)
(lookup-text (_type_ text-id symbol) string)
(level-method-24 () none)
(birth (_type_) _type_)
(level-status-update! (_type_ symbol) _type_)
(load-required-packages (_type_) _type_)
(init-vis-from-bsp (_type_) none)
(vis-clear (_type_) none)
)
)
;; definition for method 3 of type level
(defmethod inspect ((this level))
(when (not this)
(set! this this)
(goto cfg-48)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Tname: ~A~%" (-> this name))
(format #t "~1Tload-name: ~A~%" (-> this load-name))
(format #t "~1Tnickname: ~A~%" (-> this nickname))
(format #t "~1Tindex: ~D~%" (-> this index))
(format #t "~1Tstatus: ~A~%" (-> this status))
(format #t "~1Tborrow-level[2] @ #x~X~%" (-> this borrow-level))
(dotimes (s5-0 2)
(format #t "~T [~D]~1Tborrow-level: ~A~%" s5-0 (-> this borrow-level s5-0))
)
(format #t "~1Tborrow-from-level: ~A~%" (-> this borrow-from-level))
(format #t "~1Theap: #<kheap @ #x~X>~%" (-> this heap))
(format #t "~1Tborrow-heap[2] @ #x~X~%" (-> this borrow-heap))
(format #t "~1Tbsp: ~A~%" (-> this bsp))
(format #t "~1Tart-group: ~A~%" (-> this art-group))
(format #t "~1Tinfo: ~A~%" (-> this info))
(format #t "~1Ttexture-page[18] @ #x~X~%" (-> this texture-page))
(format #t "~1Tloaded-texture-page[16] @ #x~X~%" (-> this loaded-texture-page))
(format #t "~1Tloaded-texture-page-count: ~D~%" (-> this loaded-texture-page-count))
(format #t "~1Tentity: ~A~%" (-> this entity))
(format #t "~1Tclosest-object: (meters ~m)~%" (&-> this closest-object))
(format #t "~1Tupload-size[18] @ #x~X~%" (-> this upload-size))
(format #t "~1Tinside-boxes?: ~A~%" (-> this inside-boxes))
(format #t "~1Tdisplay?: ~A~%" (-> this display?))
(format #t "~1Trender?: ~A~%" (-> this render?))
(format #t "~1Tmeta-inside?: ~A~%" (-> this meta-inside?))
(format #t "~1Tforce-inside?: ~A~%" (-> this force-inside?))
(format #t "~1Tmood-context: #<mood-context @ #x~X>~%" (-> this mood-context))
(format #t "~1Tmood-func: ~A~%" (-> this mood-func))
(format #t "~1Tmood-init: ~A~%" (-> this mood-init))
(format #t "~1Tvis-bits: #x~X~%" (-> this vis-bits))
(format #t "~1Tall-visible?: ~A~%" (-> this all-visible?))
(format #t "~1Tforce-all-visible?: ~A~%" (-> this force-all-visible?))
(format #t "~1Tlinking: ~A~%" (-> this linking))
(format #t "~1Tvis-info[8] @ #x~X~%" (-> this vis-info))
(format #t "~1Tvis-self-index: ~D~%" (-> this vis-self-index))
(format #t "~1Tvis-adj-index: ~D~%" (-> this vis-adj-index))
(format #t "~1Tvis-buffer[2048] @ #x~X~%" (-> this vis-buffer))
(format #t "~1Tmem-usage-block: ~A~%" (-> this mem-usage-block))
(format #t "~1Tmem-usage: ~D~%" (-> this mem-usage))
(format #t "~1Tcode-memory-start: #x~X~%" (-> this code-memory-start))
(format #t "~1Tcode-memory-end: #x~X~%" (-> this code-memory-end))
(format #t "~1Tload-start-time: ~D~%" (-> this load-start-time))
(format #t "~1Tload-stop-time: ~D~%" (-> this load-stop-time))
(format #t "~1Tload-buffer[2] @ #x~X~%" (-> this load-buffer))
(format #t "~1Tload-buffer-size: ~D~%" (-> this load-buffer-size))
(format #t "~1Tload-buffer-last: ~A~%" (-> this load-buffer-last))
(format #t "~1Tload-buffer-mode: ~D~%" (-> this load-buffer-mode))
(format #t "~1Tdisplay-start-time: ~D~%" (-> this display-start-time))
(format #t "~1Tmemory-mask: #b~B~%" (-> this memory-mask))
(format #t "~1Ttask-mask: #x~X : (task-mask " (-> this task-mask))
(let ((s5-1 (-> this task-mask)))
(if (= (logand s5-1 (task-mask task0)) (task-mask task0))
(format #t "task0 ")
)
(if (= (logand s5-1 (task-mask task2)) (task-mask task2))
(format #t "task2 ")
)
(if (= (logand s5-1 (task-mask task4)) (task-mask task4))
(format #t "task4 ")
)
(if (= (logand s5-1 (task-mask task6)) (task-mask task6))
(format #t "task6 ")
)
(if (= (logand s5-1 (task-mask ctywide)) (task-mask ctywide))
(format #t "ctywide ")
)
(if (= (logand s5-1 (task-mask never)) (task-mask never))
(format #t "never ")
)
(if (= (logand (task-mask movie1) s5-1) (task-mask movie1))
(format #t "movie1 ")
)
(if (= (logand s5-1 (task-mask dummy1)) (task-mask dummy1))
(format #t "dummy1 ")
)
(if (= (logand s5-1 (task-mask primary0)) (task-mask primary0))
(format #t "primary0 ")
)
(if (= (logand s5-1 (task-mask task1)) (task-mask task1))
(format #t "task1 ")
)
(if (= (logand s5-1 (task-mask task3)) (task-mask task3))
(format #t "task3 ")
)
(if (= (logand s5-1 (task-mask task5)) (task-mask task5))
(format #t "task5 ")
)
(if (= (logand s5-1 (task-mask task7)) (task-mask task7))
(format #t "task7 ")
)
(if (= (logand (task-mask movie2) s5-1) (task-mask movie2))
(format #t "movie2 ")
)
(if (= (logand s5-1 (task-mask dummy2)) (task-mask dummy2))
(format #t "dummy2 ")
)
(if (= (logand s5-1 (task-mask done)) (task-mask done))
(format #t "done ")
)
(if (= (logand s5-1 (task-mask special)) (task-mask special))
(format #t "special ")
)
(if (= (logand (task-mask movie0) s5-1) (task-mask movie0))
(format #t "movie0 ")
)
(if (= (logand s5-1 (task-mask dummy0)) (task-mask dummy0))
(format #t "dummy0 ")
)
)
(format #t ")~%")
(format #t "~1Ttfrag-gs-test: ~D~%" (-> this tfrag-gs-test))
(format #t "~1Ttexture-dirty-masks[10] @ #x~X~%" (-> this texture-dirty-masks))
(format #t "~1Ttexture-mask[18] @ #x~X~%" (-> this texture-mask))
(format #t "~1Tsky-mask: #<texture-mask @ #x~X>~%" (-> this sky-mask))
(format #t "~1Ttfrag-masks: ~A~%" (-> this tfrag-masks))
(format #t "~1Ttfrag-dists: #x~X~%" (-> this tfrag-dists))
(format #t "~1Tshrub-masks: ~A~%" (-> this shrub-masks))
(format #t "~1Tshrub-dists: #x~X~%" (-> this shrub-dists))
(format #t "~1Talpha-masks: ~A~%" (-> this alpha-masks))
(format #t "~1Talpha-dists: #x~X~%" (-> this alpha-dists))
(format #t "~1Twater-masks: ~A~%" (-> this water-masks))
(format #t "~1Twater-dists: #x~X~%" (-> this water-dists))
(format #t "~1Ttfrag-last-calls[6] @ #x~X~%" (-> this tfrag-last-calls))
(format #t "~1Ttexture-anim-array[10] @ #x~X~%" (-> this texture-anim-array))
(format #t "~1Tlight-hash: ~A~%" (-> this light-hash))
(format #t "~1Tdraw-priority: ~f~%" (-> this draw-priority))
(format #t "~1Tdraw-index: ~D~%" (-> this draw-index))
(format #t "~1Tpart-engine: ~A~%" (-> this part-engine))
(format #t "~1Tuser-object[4] @ #x~X~%" (-> this user-object))
(dotimes (s5-2 4)
(format #t "~T [~D]~1Tuser-object: ~A~%" s5-2 (-> this user-object s5-2))
)
(format #t "~1Tloaded-text-info-count: ~D~%" (-> this loaded-text-info-count))
(format #t "~1Tloaded-text-info[8] @ #x~X~%" (-> this loaded-text-info))
(format #t "~1Tlevel-type: ~A~%" (-> this level-type))
(format #t "~1Tload-order: ~D~%" (-> this load-order))
(label cfg-48)
this
)
;; definition of type level-group
(deftype level-group (basic)
((length int32)
(log-in-level-bsp bsp-header)
(loading-level level)
(entity-link entity-links :offset 16)
(border? symbol)
(vis? symbol)
(want-level basic)
(receiving-level basic)
(load-commands pair)
(play? symbol)
(target-pos vector 2 :inline)
(camera-pos vector 2 :inline)
(heap kheap :inline)
(sound-bank basic 4)
(disk-load-timing? symbol)
(load-level symbol)
(load-size uint32)
(load-time float)
(load-login-time float)
(draw-level-count int32)
(draw-level level 7)
(draw-index-map uint8 7)
(load-order uint64)
(pad uint8 30)
(level level 7 :inline)
(level0 level :inline :overlay-at (-> level 0))
(level1 level :inline :offset 5488)
(level2 level :inline :offset 10720)
(level3 level :inline :offset 15952)
(level4 level :inline :offset 21184)
(level5 level :inline :offset 26416)
(default-level level :inline :offset 31648)
(pad2 uint8 4)
)
(:methods
(level-get (_type_ symbol) level)
(level-get-with-status (_type_ symbol) level)
(get-level-by-heap-ptr-and-status (_type_ pointer symbol) level)
(level-get-for-use (_type_ symbol symbol) level)
(activate-levels! (_type_) int)
(debug-print-entities (_type_ symbol type) none)
(debug-draw-actors (_type_ symbol) none)
(assign-draw-indices (_type_) none)
(actors-update (_type_) none)
(update-nav-meshes-method (_type_) none)
(level-update (_type_) none)
(level-get-target-inside (_type_) level)
(alloc-levels-if-needed (_type_ symbol) none)
(load-commands-set! (_type_ pair) none)
(art-group-get-by-name (_type_ string (pointer uint32)) art-group)
(alt-load-command-get-index (_type_ symbol int) pair)
(update-vis-volumes (_type_) none)
(update-vis-volumes-from-nav-mesh (_type_) none)
(print-volume-sizes (_type_) none)
(level-status (_type_ symbol) symbol)
(load-in-progress? (_type_) symbol)
(level-get-most-disposable (_type_) level)
)
)
;; definition for method 3 of type level-group
(defmethod inspect ((this level-group))
(when (not this)
(set! this this)
(goto cfg-13)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Tlength: ~D~%" (-> this length))
(format #t "~1Tentity-link: ~`entity-links`P~%" (-> this entity-link))
(format #t "~1Tborder?: ~A~%" (-> this border?))
(format #t "~1Tvis?: ~A~%" (-> this vis?))
(format #t "~1Twant-level: ~A~%" (-> this want-level))
(format #t "~1Treceiving-level: ~A~%" (-> this receiving-level))
(format #t "~1Tload-commands: ~A~%" (-> this load-commands))
(format #t "~1Tplay?: ~A~%" (-> this play?))
(format #t "~1Ttarget-pos[2] @ #x~X~%" (-> this target-pos))
(dotimes (s5-0 2)
(format #t "~T [~D]~1Ttarget-pos: ~`vector`P~%" s5-0 (-> this target-pos s5-0))
)
(format #t "~1Tcamera-pos[2] @ #x~X~%" (-> this camera-pos))
(dotimes (s5-1 2)
(format #t "~T [~D]~1Tcamera-pos: ~`vector`P~%" s5-1 (-> this camera-pos s5-1))
)
(format #t "~1Theap: #<kheap @ #x~X>~%" (-> this heap))
(format #t "~1Tsound-bank[4] @ #x~X~%" (-> this sound-bank))
(format #t "~1Tdisk-load-timing?: ~A~%" (-> this disk-load-timing?))
(format #t "~1Tload-level: ~A~%" (-> this load-level))
(format #t "~1Tload-size: ~D~%" (-> this load-size))
(format #t "~1Tload-time: ~f~%" (-> this load-time))
(format #t "~1Tload-login-time: ~f~%" (-> this load-login-time))
(format #t "~1Tdraw-level-count: ~D~%" (-> this draw-level-count))
(format #t "~1Tdraw-level[7] @ #x~X~%" (-> this draw-level))
(dotimes (s5-2 (-> this draw-level-count))
(format #t "~T [~D]~1Tdraw-level: ~`object`P~%" s5-2 (-> this draw-level s5-2))
)
(format #t "~1Tdraw-index-map[7] @ #x~X~%" (-> this draw-index-map))
(format #t "~1Tload-order: ~D~%" (-> this load-order))
(format #t "~1Tlevel[7] @ #x~X~%" (-> this level0))
(format #t "~1Tdata[7] @ #x~X~%" (-> this level0))
(format #t "~1Tlevel0: ~`level`P~%" (-> this level0))
(format #t "~1Tlevel1: ~`level`P~%" (-> this level1))
(format #t "~1Tlevel2: ~`level`P~%" (-> this level2))
(format #t "~1Tlevel3: ~`level`P~%" (-> this level3))
(format #t "~1Tlevel4: ~`level`P~%" (-> this level4))
(format #t "~1Tlevel5: ~`level`P~%" (-> this level5))
(format #t "~1Tlevel-default: ~`level`P~%" (-> this default-level))
(label cfg-13)
this
)
;; failed to figure out what this is:
(when (zero? *level*)
(set! *level* (new 'static 'level-group
:length 6
:log-in-level-bsp #f
:loading-level #f
:entity-link #f
:border? #f
:vis? #f
:want-level #f
:load-commands '()
:play? #f
:sound-bank (new 'static 'array basic 4 #f #f #f #f)
:disk-load-timing? #f
:level0 (new 'static 'level
:name #f
:status 'inactive
:borrow-level (new 'static 'array level 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
:level1 (new 'static 'level
:name #f
:index 1
:status 'inactive
:borrow-level (new 'static 'array level 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
:level2 (new 'static 'level
:name #f
:index 2
:status 'inactive
:borrow-level (new 'static 'array level 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
:level3 (new 'static 'level
:name #f
:index 3
:status 'inactive
:borrow-level (new 'static 'array level 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
:level4 (new 'static 'level
:name #f
:index 4
:status 'inactive
:borrow-level (new 'static 'array level 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
:level5 (new 'static 'level
:name #f
:index 5
:status 'inactive
:borrow-level (new 'static 'array level 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
:default-level (new 'static 'level
:name 'default
:index 6
:status 'reserved
:borrow-level (new 'static 'array level 2 #f #f)
:borrow-from-level #f
:bsp #f
:inside-boxes #f
:display? #f
:force-inside? #f
:linking #f
:level-type #f
)
)
)
(set! *draw-index* 0)
(set! *level-index* 0)
0
)
;; failed to figure out what this is:
0