;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "kernel-defs.gc")

;; DECOMP BEGINS

;; this file is debug only
(declare-file (debug))

;; The memory-usage system accumulates debug statistics into fixed category
;; slots. The same structure is used for renderer DMA, static level data, and
;; process-heap accounting. A type's mem-usage method recursively adds its
;; allocation to the supplied block.

;; Statistics for one category. used is the requested payload size, while total
;; includes the allocator alignment or storage granularity. count is the number
;; of objects or logical items contributing to the category.
(deftype memory-usage-info (structure)
  ((name  string)
   (count int32)
   (used  int32)
   (total int32)))

;; Memory information for all categories. length is one past the highest slot
;; currently in use. work-bsp records the BSP being traversed.
(deftype memory-usage-block (basic)
  ((work-bsp basic)
   (length   int32)
   (data     memory-usage-info 109 :inline))
  (:methods
   (reset! (_type_) _type_)
   (calculate-total (_type_) int)
   (print-mem-usage (_type_ level object) none)))

;; The main RAM usage memory info
(define *mem-usage* (new 'debug 'memory-usage-block))

;; The DMA memory usage info
(define *dma-mem-usage* (new 'debug 'memory-usage-block))

;; Shared callback context while walking process trees.
(define *temp-mem-usage* (the-as memory-usage-block #f))

;; mem-usage traversal flags:
;; #x001 - count prototype-owned data separately from instance-owned data
;; #x002 - count only an instance's per-prototype color data
;; #x004 - the color data belongs to TIE geometry override 1
;; #x008 - the color data belongs to TIE geometry override 2
;; #x010 - the color data belongs to TIE geometry override 3
;; #x020 - include objects resident in the process dead pools
;; #x040 - classify resource lumps as entity data
;; #x080 - classify resource lumps as ambient data
;; #x100 - classify resource lumps as camera data
;; #x200 - classify an art object's extra resource as joint geometry

;; Category-to-slot mapping for memory-usage-block.data. Gaps are unnamed
;; categories that are included in aggregate debug totals.
(defenum mem-usage-id
  :bitfield #f
  :type uint32
  (drawable-group 0)
  (tfragment 1)
  (tfragment-base 2)
  (tfragment-common 3)
  (tfragment-level0 4)
  (tfragment-level1 5)
  (tfragment-color 6)
  (tfragment-debug 7)
  (tfragment-pal 8)
  (tie-fragment 9)
  (tie-gif 10)
  (tie-points 11)
  (tie-colors 12)
  (tie-draw-points 13)
  (tie-debug 14)
  (tie-near 15)
  (tie-pal 16)
  (tie-generic 17)
  (instance-tie 18)
  (instance-tie-colors0 19)
  (instance-tie-colors1 20)
  (instance-tie-colors2 21)
  (instance-tie-colors3 22)
  (instance-tie-colors* 23)
  (prototype-bucket-shrub 24)
  (generic-shrub 25)
  (generic-shrub-data 26)
  (shrubbery 27)
  (shrubbery-object 28)
  (shrubbery-vertex 29)
  (shrubbery-color 30)
  (shrubbery-stq 31)
  (shrubbery-pal 32)
  (billboard 33)
  (instance-shrubbery 34)
  (pris-fragment 35)
  ;; ??
  (entity 43)
  (camera 44)
  (nav-mesh 45)
  ;; ??
  (res 48)
  (ambient 49)
  (collide-fragment-0 50)
  (collision-poly-0 51)
  (collision-vertex-0 52)
  (collide-fragment-1 53)
  (collision-poly-1 54)
  (collision-vertex-1 55)
  (bsp-main 56)
  (bsp-misc 57)
  (bsp-node 58)
  (bsp-leaf-vis-self 59)
  (bsp-leaf-vis-adj 60)
  (draw-node 61)
  (pat 62)
  (level-code 63)
  (entity-links 64) ;; shared slot for entity and ambient link arrays
  (joint 65)
  (joint-anim-compressed 66)
  (joint-anim-compressed-control 67)
  (joint-anim-fixed 68)
  (joint-anim-frame 69)
  (art-group 70)
  (art-mesh-anim 71)
  (art-mesh-geo 72)
  (art-joint-geo 73)
  (art-joint-anim 74)
  (merc-ctrl 75)
  (joint-anim-drawable 76)
  (blend-shape 77)
  (collide-mesh 78)
  (texture 79)
  (string 80)
  (array 81)
  (sprite 82)
  (depth-cue 83)
  (debug 84)
  (sky 85)
  (pris-generic 86)
  (4k-dead-pool 87)
  (8k-dead-pool 88)
  (16k-dead-pool 89)
  (nk-dead-pool 90)
  (target-dead-pool 91)
  (camera-dead-pool 92)
  (debug-dead-pool 93)
  (process-active 94)
  (heap-total 95)
  (heap-process 96)
  (heap-header 97)
  (heap-thread 98)
  (heap-root 99)
  (heap-draw-control 100)
  (heap-joint-control 101)
  (heap-cspace 102)
  (heap-bone 103)
  (heap-part 104)
  (heap-collide-prim 105)
  (heap-misc 106)
  (shadow-geo 107)
  (eye-anim 108))

;; get a memory usage id as an integer.
(defmacro mem-usage-id-int (kind)
  `(the int (mem-usage-id ,kind)))

;; Record one aligned allocation in a named memory-usage category. This variant embeds the category
;; name as a static string, matching the common form of the original macro.
(defmacro mem-usage-add! (usage kind count size)
  (with-gensyms (bytes)
    `(begin
      (set! (-> ,usage length) (max (+ 1 (mem-usage-id-int ,kind)) (-> ,usage length)))
      (set! (-> ,usage data (mem-usage-id ,kind) name) ,(symbol->string kind))
      (+! (-> ,usage data (mem-usage-id ,kind) count) ,count)
      (let ((,bytes ,size))
        (+! (-> ,usage data (mem-usage-id ,kind) used) ,bytes)
        (+! (-> ,usage data (mem-usage-id ,kind) total) (align16 ,bytes))))))

;; The drawable-container methods use the symbol's runtime string instead. Keep that distinct from
;; the static-string variant above: the text is the same, but the original expression and resulting
;; string object are not.
(defmacro mem-usage-add-symbol! (usage kind count size)
  (with-gensyms (bytes)
    `(begin
      (set! (-> ,usage length) (max (+ 1 (mem-usage-id-int ,kind)) (-> ,usage length)))
      (set! (-> ,usage data (mem-usage-id ,kind) name) (symbol->string ',kind))
      (+! (-> ,usage data (mem-usage-id ,kind) count) ,count)
      (let ((,bytes ,size))
        (+! (-> ,usage data (mem-usage-id ,kind) used) ,bytes)
        (+! (-> ,usage data (mem-usage-id ,kind) total) (align16 ,bytes))))))

(defun-extern mem-size basic symbol mem-usage-flags int)