clean up to joint-h

This commit is contained in:
water111
2026-08-09 00:01:57 -07:00
parent 6a9f5e540f
commit 14762d74c3
45 changed files with 44056 additions and 31528 deletions
+14 -13
View File
@@ -5798,8 +5798,18 @@ better than the current candidate. SPOOL_PRIORITY_RECALC derives priority from r
;; - Symbols
(define-extern *texture-enable-user-menu* int)
(define-extern *texture-enable-user* int)
(defenum texture-enable-mask
:bitfield #t
:type int32
(tfrag-tie 0)
(pris 1)
(shrub 2)
(alpha 3)
(water 4)
)
(define-extern *texture-enable-user-menu* texture-enable-mask)
(define-extern *texture-enable-user* texture-enable-mask)
(define-extern *texture-relocate-later* texture-relocate-later)
(define-extern *texture-page-dir* texture-page-dir)
(define-extern *sky-base-vram-word* int)
@@ -6176,6 +6186,8 @@ better than the current candidate. SPOOL_PRIORITY_RECALC derives priority from r
;; - Types
(deftype vis-gif-tag (structure)
((fog0 uint32 :offset-assert 0)
(strip uint32 :offset-assert 4)
@@ -30382,17 +30394,6 @@ from the entity name, then load the art group named by the entity type."))
;; Containing DGOs - ['GAME', 'ENGINE']
;; Version - 3
;; Texture categories the debug menu can stop uploading.
(defenum texture-enable-mask
:type uint64
:bitfield #t
(tfrag 0)
(pris 1)
(shrub 2)
(alpha 3)
(water 4)
)
;; Debug edge, strip, and collision overlays selected by *display-strip-lines*.
(defenum strip-lines-controls
:type int64
+5
View File
@@ -158,6 +158,11 @@
]
},
"rules": [
{
"name": "unwrap-angle",
"match": "(the float (sar (shl (the int $angle) 48) 48))",
"rewrite": "(unwrap-angle $angle)"
},
{
"name": "current-frame",
"match": "(-> *display* frames (-> *display* on-screen) frame)",
@@ -477,7 +477,6 @@
[[157, 200], "s0", "(array object)"],
[235, "s0", "basic"]
],
"(method 10 shadow-control)": [[1, "v1", "int"]],
"(method 0 fact-info-enemy)": [[[3, 92], "gp", "fact-info-enemy"]],
"(method 0 fact-info)": [
["_stack_", 16, "res-tag"],
File diff suppressed because it is too large Load Diff
+8 -8
View File
@@ -63,8 +63,7 @@
(matrix-bits joint-anim-matrix-flags)))
;; Constant components shared by every frame. The offsets split the payload into the streams read
;; at 64-, 32-, and 16-bit widths; this lets each value use its compact representation without
;; padding every sample to the widest type.
;; at 64-, 32-, and 16-bit widths.
(deftype joint-anim-compressed-fixed (structure)
((hdr joint-anim-compressed-hdr :inline)
(offset-64 uint32)
@@ -83,7 +82,7 @@
(data vector 133 :inline)))
;; One fixed block followed by num-frames variable blocks. The qwc fields are the exact DMA and
;; pointer strides; data has a nominal element only so the dynamic frame table has an address.
;; pointer strides.
(deftype joint-anim-compressed-control (structure)
((num-frames uint32)
(fixed-qwc uint32)
@@ -95,8 +94,9 @@
;; ART
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Common header for a complete art group and for each element stored inside it. length is
;; interpreted by the concrete art type, while extra carries the asset's resource properties.
;; Common header for a complete art group and for each individual art element stored inside it.
;; length is interpreted by the concrete art type
;; extra carries named properties.
(declare-type res-lump basic)
(deftype art (basic)
@@ -152,9 +152,9 @@
;; Static recipe for constructing a drawable from an art-group. jgeo, janim, mgeo, and shadow are
;; element indices in that group. mgeo and lod-dist are parallel arrays; max-lod is their last
;; valid index, so larger indices contain progressively less detailed geometry. setup-lods! may
;; valid index, and larger indices contain progressively less detailed geometry. setup-lods! may
;; replace the authored distances with lod-dist resource data attached to the joint geometry.
;; bounds is the model-space culling sphere. longest-edge controls the near-camera clipping choice
;; bounds is the model-space culling sphere. longest-edge controls the clipping choice
;; for MERC geometry.
(deftype skeleton-group (basic)
((art-group-name string)
@@ -181,7 +181,7 @@
(declare-type merc-ctrl basic)
;; One MERC geometry level and the camera-distance threshold at which it gives way to the next.
;; One MERC geometry level and the camera-distance threshold.
(deftype lod-group (structure)
((geo merc-ctrl)
(dist meters))
+1 -1
View File
@@ -297,7 +297,7 @@
"Replace *texture-enable-user-menu* outright, for the all textures on and off entries. Shifted
the same way as dm-texture-user-toggle-pick-func, so all textures on leaves the tfrag, pris and
shrub bits clear."
(if (= msg (debug-menu-msg press)) (set! *texture-enable-user-menu* mask))
(if (= msg (debug-menu-msg press)) (set! *texture-enable-user-menu* (the texture-enable-mask mask)))
(= *texture-enable-user-menu* mask))
(defun dm-strip-lines-toggle-pick-func ((id int) (msg debug-menu-msg))
+3 -5
View File
@@ -54,8 +54,7 @@
;; #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.
;; Category-to-slot mapping for memory-usage-block.data.
(defenum mem-usage-id
:bitfield #f
:type uint32
@@ -178,9 +177,8 @@
(+! (-> ,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.
;; The drawable-container methods use the symbol's runtime string instead, useful
;; if the name isn't known at compile time.
(defmacro mem-usage-add-symbol! (usage kind count size)
(with-gensyms (bytes)
`(begin
+3 -4
View File
@@ -5,9 +5,8 @@
;; DMA buckets let renderers build chains in any order while the final transfer visits them in a
;; fixed draw order. Each 16-byte header owns no payload. A NEXT tag transfers QWC quadwords stored
;; immediately after itself, then fetches the following DMA tag from the address in ADDR. It does
;; not continue to the tag after its inline payload; CNT has that behavior. These headers have QWC
;; zero, so they transfer nothing and act only as pointers to the DMA tag in ADDR.
;; immediately after itself, then fetches the following DMA tag from the address in ADDR.
;; A NEXT with QWC zero transfers nothing and acts only as a pointer to the DMA tag in ADDR.
;;
;; last points to a QWC-zero NEXT tag whose ADDR has not yet been linked onward. An empty bucket uses
;; its header NEXT tag as this tail. Every added chain must also end in a QWC-zero NEXT tag. Insertion
@@ -37,7 +36,7 @@
(dotimes (i count)
(set! (-> buckets 0 last 0 addr) (the-as int (the-as pointer (-> buckets 1))))
(set! (-> buckets 0 last) (the-as (pointer dma-tag) 0))
(set! buckets (the-as (inline-array dma-bucket) (-> buckets 1)))))
(set! buckets (&-> buckets 1))))
buckets)
(defun dma-bucket-insert-tag ((buckets (inline-array dma-bucket)) (bucket-index bucket-id) (tag-start pointer) (tag-end (pointer dma-tag)))
+1 -1
View File
@@ -6,7 +6,7 @@
;; DECOMP BEGINS
;; DMA buffers are linear write cursors over storage that will be submitted to a DMA channel.
;; Graphics buffers usually contain linked dma-buckets rather than one plain transfer.
;; Graphics buffers contain linked dma-buckets rather than one plain transfer.
;; The main display list uses a "chain transfer". In this mode, the DMA system reads dma-tags which
;; tell it what to transfer next. This can be used to construct linked lists of DMA data.
+25 -42
View File
@@ -15,13 +15,14 @@
;; - dma-buffer is memory management for the data to be sent
;; - dma-bucket is organization of all the frame's DMA data in the correct order
;; DMA submission is synchronous on PC, so the caller has no hardware transfer to wait for.
;; When this flag is set, all DMA syncs complete immediately.
(defglobalconstant INSTANT_DMA #t)
;; Some DMA sync functions return a count for how long it took.
;; When INSTANT_DMA is enabled, these functions will return this value.
(defglobalconstant INSTANT_DMA_COUNT 123)
;; In the PC Port, we handle DMA in three ways:
;; - The game generates a single, massive DMA transfer to drive all rendering in a frame.
;; this chain is built and read by the C++ Renderer.
;; - Simple uses of DMA to copy is replaced with plain memcpy.
;; - Highly optimized code will use a double-buffered work area in scratchpad.
;; One buffer is used for computation while the other is being loaded/stored from
;; main memory over DMA. This code is handled on a case-by-case basis, but we
;; avoid ever doing transfers "in the background"
;; DMA Channel Control Register. This starts the DMA and can be checked to see if it's done.
;; There is one CHCR per DMA channel.
@@ -34,12 +35,12 @@
(str uint8 :offset 8 :size 1) ;; start!
(tag uint16 :offset 16)))
;; Assembly cannot use the bitfield, so the two chcr values it writes and tests get names. STR reads
;; as "still running" and writes as "go"; the chain-mode start value is what a builder stores to hand
;; a channel a source chain: chain mode, transfer the tags, start.
(defconstant DMA-CHCR-STR 256)
(defconstant DMA-CHCR-START-CHAIN-TTE 324)
;; Two common values for dma-chcr to start transfer
;; Plain memory copy
(defconstant DMA-CHCR-STR (new 'static 'dma-chcr :str 1))
;; Copy, then follow tags. TTE enables copying the upper 64-bits of the DMAtag quadword,
;; and is often used to stash VIFtags when transferring to VIF.
(defconstant DMA-CHCR-START-CHAIN-TTE (new 'static 'dma-chcr :str 1 :tte 1 :mod 1))
(defmethod inspect ((obj dma-chcr))
(format #t "~Tdir: ~D~%" (-> obj dir))
@@ -116,18 +117,12 @@
;; These addresses are the location of DMA banks for each channel.
;; These addresses name EE hardware registers and are not dereferenced on PC.
(defconstant VIF0_DMA_BANK (the dma-bank-vif #x10008000))
(defconstant VIF1_DMA_BANK (the dma-bank-vif #x10009000))
(defconstant GIF_DMA_BANK (the dma-bank #x1000a000))
;; ipuFrom, ipTop, sif0, sif1, sif2 believed unused.
(defconstant SPR_FROM_BANK (the dma-bank-spr #x1000d000))
(defconstant SPR_TO_BANK (the dma-bank-spr #x1000d400))
(defconstant VU0_DATA_MEM_MAP (the (pointer uint32) #x11004000))
(defconstant VU1_DATA_MEM_MAP (the (pointer uint32) #x1100c000))
;; The DMA system also has some shared control registers that
@@ -172,7 +167,7 @@
(size int32)
(dest-address uint32)))
;; Unused placeholder for a VU status value. No fields were needed.
;; Unused placeholder for a VU status value.
(deftype vu-stat (uint64) ())
(defenum dma-tag-id
@@ -394,6 +389,7 @@
;; These unused helpers were written as inline EE assembly. The empty instructions in the polling
;; loops deliberately space accesses to the DMA registers: reading them continuously would consume
;; the same main bus bandwidth as the transfer being awaited.
;; There is actually a better way by waiting on COP interrupts, but ND never did this.
(#unless PC_PORT
(defun dma-sync-fast ((bank dma-bank))
@@ -429,12 +425,8 @@
(#when PC_PORT
(defun dma-sync-fast ((bank dma-bank))
"Wait for a DMA channel's start bit to clear. The PC submits DMA synchronously."
(declare (inline))
(#cond
(INSTANT_DMA 0)
(#t (while (nonzero? (-> bank chcr str)) (nop!))))
(none)))
(#unless PC_PORT
(defun dma-send-no-scratch ((bank dma-bank) (memory-address uint32) (quadword-count uint32))
"Wait for a DMA channel, flush the cache, and start a normal-mode transfer from main memory.
@@ -442,20 +434,18 @@
((inline dma-sync-fast) bank)
(flush-cache 0)
(sync.l)
(rlet ((start #x100)) (s.w memory-address bank 16) (s.w quadword-count bank 32) (sync.l) (s.w start bank) (sync.l))
(rlet ((start DMA-CHCR-STR))
(s.w memory-address (-> bank madr))
(s.w quadword-count (-> bank qwc))
(sync.l)
(s.w start (-> bank chcr))
(sync.l))
(none)))
(#when PC_PORT
(defun dma-send-no-scratch ((bank dma-bank) (memory-address uint32) (quadword-count uint32))
"Wait for a DMA channel, flush the cache, and start a normal-mode transfer from main memory.
All channel-control fields except the start bit are cleared. This function is unused."
((inline dma-sync-fast) bank)
(flush-cache 0)
(.sync.l)
(set! (-> bank madr) memory-address)
(set! (-> bank qwc) quadword-count)
(.sync.l)
(set! (-> bank chcr) (new 'static 'dma-chcr :str 1))
(none)))
(#unless PC_PORT
@@ -483,12 +473,7 @@
(defun dma-sync-with-count ((bank dma-bank) (poll-count (pointer int32)))
"If a DMA channel is active, wait for it to finish and increment the caller's polling count
once per sample. This function is unused."
(#cond
(INSTANT_DMA (set! (-> poll-count) INSTANT_DMA_COUNT) 0)
(#t
(when (nonzero? (-> bank chcr str))
(let ((count (-> poll-count))) (while (nonzero? (-> bank chcr str)) (+! count 1) (set! (-> poll-count) count))))
0))))
(none)))
(#unless PC_PORT
(defun dma-count-until-done ((bank dma-bank) (poll-count (pointer int32)))
@@ -511,6 +496,4 @@
(defun dma-count-until-done ((bank dma-bank) (poll-count (pointer int32)))
"Wait for a DMA channel to finish and increment the caller's polling count for every sample,
including the final inactive sample. This function is unused."
(#cond
(INSTANT_DMA (set! (-> poll-count) INSTANT_DMA_COUNT) 0)
(#t (while (nonzero? (-> bank chcr str)) (set! (-> poll-count) (+ 1 (-> poll-count))))))))
(none)))
+38 -46
View File
@@ -217,69 +217,61 @@
"Fill all 4 KiB of VU0 data memory with #xabadbeef through the EE memory map."
(#when PC_PORT
(return 0))
(let ((memory VU0_DATA_MEM_MAP)) (dotimes (i 1024) (set! (-> memory i) #xabadbeef)))
(let ((memory VU0_DATA_MEM_MAP))
(dotimes (i 1024) (set! (-> memory i) #xabadbeef)))
(none))
(defun clear-vu1-mem ()
"Fill all 16 KiB of VU1 data memory with #xabadbeef through the EE memory map."
(#when PC_PORT
(return 0))
(let ((memory VU1_DATA_MEM_MAP)) (dotimes (i 4096) (set! (-> memory i) #xabadbeef)))
(let ((memory VU1_DATA_MEM_MAP))
(dotimes (i 4096) (set! (-> memory i) #xabadbeef)))
(none))
(defun dump-vu1-mem ()
"Print all 1024 quadwords of VU1 data memory as hexadecimal words and floats."
(local-vars (i int) (memory (pointer uint32)))
(#when PC_PORT
(return 0))
(set! memory (the (pointer uint32) #x1100c000))
(set! i 0)
(while (< i 1024)
(format 0
"~4,'0X: ~8,'0X ~8,'0X ~8,'0X ~8,'0X"
i
(-> memory (shl i 2))
(-> memory (+ (shl i 2) 1))
(-> memory (+ (shl i 2) 2))
(-> memory (+ (shl i 2) 3)))
(format 0
" ~F ~F ~F ~F ~%"
(-> memory (shl i 2))
(-> memory (+ (shl i 2) 1))
(-> memory (+ (shl i 2) 2))
(-> memory (+ (shl i 2) 3)))
(+! i 1))
(let ((memory (the-as (pointer uint32) #x1100c000)))
(dotimes (i 1024)
(format 0
"~4,'0X: ~8,'0X ~8,'0X ~8,'0X ~8,'0X"
i
(-> memory (* i 4))
(-> memory (+ (* i 4) 1))
(-> memory (+ (* i 4) 2))
(-> memory (+ (* i 4) 3)))
(format 0
" ~F ~F ~F ~F ~%"
(-> memory (* i 4))
(-> memory (+ (* i 4) 1))
(-> memory (+ (* i 4) 2))
(-> memory (+ (* i 4) 3)))))
(none))
(defun dump-vu1-range ((start-quadword uint) (quadword-count uint))
"Print a range of VU1 data-memory quadwords as hexadecimal words and floats."
(local-vars (i int) (quadword-index int) (memory (pointer uint32)))
(#when PC_PORT
(return #f))
(set! memory (the (pointer uint32) #x1100c000))
(set! i 0)
(while (< i (the-as int quadword-count))
(set! quadword-index (+ i (the-as int start-quadword)))
(format 0
"~4,'0X: ~8x ~8x ~8x ~8x"
quadword-index
(-> memory (shl quadword-index 2))
(-> memory (+ (shl quadword-index 2) 1))
(-> memory (+ (shl quadword-index 2) 2))
(-> memory (+ (shl quadword-index 2) 3)))
(format 0
" ~F ~F ~F ~F ~%"
(-> memory (shl quadword-index 2))
(-> memory (+ (shl quadword-index 2) 1))
(-> memory (+ (shl quadword-index 2) 2))
(-> memory (+ (shl quadword-index 2) 3)))
(+! i 1))
'#f)
(let ((memory (the-as (pointer uint32) #x1100c000)))
(dotimes (i (the-as int quadword-count))
(let ((quadword-index (+ i start-quadword)))
(format 0
"~4,'0X: ~8x ~8x ~8x ~8x"
quadword-index
(-> memory (* quadword-index 4))
(-> memory (+ (* quadword-index 4) 1))
(-> memory (+ (* quadword-index 4) 2))
(-> memory (+ (* quadword-index 4) 3)))
(format 0
" ~F ~F ~F ~F ~%"
(-> memory (* quadword-index 4))
(-> memory (+ (* quadword-index 4) 1))
(-> memory (+ (* quadword-index 4) 2))
(-> memory (+ (* quadword-index 4) 3))))))
#f)
;; if we send junk DMA data due to an engine bug, the PS2 will eventually time out the transfer.
;; in this case, the main loop will attempt to reset everything to hopefully recover.
;; this value is the PAL/NTSC constant for the Sony reset functions.
;; if we switch PAL/NTSC during runtime, we should update this.
;; The game uses a sony-provided C library function to reset, which needs a parameter
;; to pick between PAL/NTSC, stored below
(define *video-reset-parm* 2)
(defun reset-vif1-path ()
+4 -1
View File
@@ -9,7 +9,10 @@
;; broad-phase collision. Child points directly at the first element of a
;; contiguous drawable span, not at a drawable-inline-array wrapper; child-count
;; supplies the span length. Depending on flags, the span contains more
;; draw-nodes or renderer-specific leaves. Shrub uses bit 0 to mark node children.
;; draw-nodes or renderer-specific leaves.
;; Typically child and child-count represent a small section of a much larger
;; array. Some renderers will have a large array of all nodes of a given depth,
;; others may have arbitrary tree structures.
;;
;; Most terrain and collision trees have one to eight roots, one to eight
;; children per node, equal-depth leaves, and visibility IDs on nodes and leaves.
+54 -87
View File
@@ -5,8 +5,7 @@
;; The connection system lets a process register one or more entries with any
;; number of engines. An engine can iterate or execute its registered entries,
;; and destroying a process removes all of its entries from every engine. A
;; process may connect to the same engine more than once.
;; and destroying a process removes all of its entries from every engine.
;; Some example uses:
;; - a "foreground-engine" has connections to all foreground objects that need to be drawn on each frame.
@@ -65,19 +64,6 @@
(belongs-to-process? (connection process) symbol)
(move-to-dead (connection) connection)))
(defmethod inspect ((this connection))
(format #t "[~8x] ~A~%" this 'connection)
(format #t "~Tnext0: ~`connectable`P~%" (-> this next0))
(format #t "~Tprev0: ~`connectable`P~%" (-> this prev0))
(format #t "~Tnext1: ~`connectable`P~%" (-> this next1))
(format #t "~Tprev1: ~`connectable`P~%" (-> this prev1))
(format #t "~Tparam0: ~A~%" (-> this param0))
(format #t "~Tparam1: ~A~%" (-> this param1))
(format #t "~Tparam2: ~A~%" (-> this param2))
(format #t "~Tparam3: ~A~%" (-> this param3))
(format #t "~Tquad[2] @ #x~X~%" (&-> this next0))
this)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; engine
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -118,7 +104,7 @@
(defmethod belongs-to-process? ((this connection) (proc process))
"Check whether this live connection belongs to proc."
(= proc ((method-of-type connection get-process) this)))
(= proc (get-process this)))
(defmethod print ((this connection))
"Print a connection and its parameters"
@@ -182,41 +168,39 @@
(defmethod new engine ((allocation symbol) (type-to-make type) (name basic) (capacity int))
"Allocate a fixed-capacity engine and link every connection slot into its dead list."
(local-vars (this engine) (i int) (last-interior-index int))
(set! this
(object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (the-as uint (shl (+ capacity -1) 5))))))
(set! (-> this allocated-length) capacity)
(set! (-> this length) 0)
(set! (-> this name) name)
;; Start with an empty alive list.
(set! (-> this alive-list next0) (-> this alive-list-end))
(set! (-> this alive-list prev0) #f)
(set! (-> this alive-list next1) #f)
(set! (-> this alive-list prev1) #f)
(set! (-> this alive-list-end next0) #f)
(set! (-> this alive-list-end prev0) (-> this alive-list))
(set! (-> this alive-list-end next1) #f)
(set! (-> this alive-list-end prev1) #f)
;; Link every data slot between the dead-list sentinels.
(set! (-> this dead-list next0) (-> this data 0))
(set! (-> this dead-list prev0) #f)
(set! (-> this dead-list next1) #f)
(set! (-> this dead-list prev1) #f)
(set! (-> this dead-list-end next0) #f)
(set! (-> this dead-list-end prev0) (-> this data (+ capacity -1)))
(set! (-> this dead-list-end next1) #f)
(set! (-> this dead-list-end prev1) #f)
(set! (-> this data 0 prev0) (-> this dead-list))
(set! (-> this data 0 next0) (the connectable (&+ this 124)))
(set! i 1)
(set! last-interior-index (+ capacity -2))
(while (>= last-interior-index i)
(set! (-> this data i prev0) (-> this data (+ i -1)))
(set! (-> this data i next0) (-> this data (+ i 1)))
(+! i 1))
(set! (-> this data (+ capacity -1) prev0) (-> this data (+ capacity -2)))
(set! (-> this data (+ capacity -1) next0) (-> this dead-list-end))
this)
(let ((this (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (+ capacity -1) 32))))))
(set! (-> this allocated-length) capacity)
(set! (-> this length) 0)
(set! (-> this name) name)
;; Start with an empty alive list.
(set! (-> this alive-list next0) (-> this alive-list-end))
(set! (-> this alive-list prev0) #f)
(set! (-> this alive-list next1) #f)
(set! (-> this alive-list prev1) #f)
(set! (-> this alive-list-end next0) #f)
(set! (-> this alive-list-end prev0) (-> this alive-list))
(set! (-> this alive-list-end next1) #f)
(set! (-> this alive-list-end prev1) #f)
;; Link every data slot between the dead-list sentinels.
(set! (-> this dead-list next0) (the-as connectable (-> this data)))
(set! (-> this dead-list prev0) #f)
(set! (-> this dead-list next1) #f)
(set! (-> this dead-list prev1) #f)
(set! (-> this dead-list-end next0) #f)
(set! (-> this dead-list-end prev0) (-> this data (+ capacity -1)))
(set! (-> this dead-list-end next1) #f)
(set! (-> this dead-list-end prev1) #f)
(set! (-> this data 0 prev0) (-> this dead-list))
(set! (-> this data 0 next0) (the-as connectable (&+ (the-as pointer this) 124)))
(let ((i 1)
(last-interior-index (+ capacity -2)))
(while (>= last-interior-index i)
(set! (-> this data i prev0) (-> this data (+ i -1)))
(set! (-> this data i next0) (-> this data (+ i 1)))
(+! i 1)))
(set! (-> this data (+ capacity -1) prev0) (-> this data (+ capacity -2)))
(set! (-> this data (+ capacity -1) next0) (-> this dead-list-end))
this))
(defmethod print ((this engine))
"Print an engine and its name"
@@ -262,7 +246,6 @@
(defmethod apply-to-connections ((this engine) (f (function connectable none)))
"Apply f to every live connection in forward order, caching the next node so f may remove the current one."
;; Save this before the callback in case it removes current.
(iterate-engine-connections (current this) (f current))
0)
@@ -319,21 +302,14 @@
(apply-to-connections this (the (function connection none) (method-of-type connection inspect)))
this))
(defmethod add-connection ((this engine)
(proc process)
(func object) ;; not always a function, you can technically put whatever
(p1 object)
(p2 object)
(p3 object))
(defmethod add-connection ((this engine) (proc process) (func object) (p1 object) (p2 object) (p3 object))
"Take one dead slot, initialize its parameters, and link it into both this engine and proc."
(local-vars (slot connectable))
(set! slot (-> this dead-list next0))
(when (not (or (not proc) (= slot (-> this dead-list-end))))
(let ((slot (the connection slot)))
(set! (-> slot param0) (the basic func))
(set! (-> slot param1) (the int p1))
(set! (-> slot param2) (the int p2))
(set! (-> slot param3) (the int p3))
(let ((slot (the-as connection (-> this dead-list next0))))
(when (not (or (not proc) (= slot (-> this dead-list-end))))
(set! (-> slot param0) (the-as basic func))
(set! (-> slot param1) (the-as int p1))
(set! (-> slot param2) (the-as int p2))
(set! (-> slot param3) (the-as int p3))
;; Move the slot from the dead list to the front of the alive list.
(set! (-> this dead-list next0) (-> slot next0))
(set! (-> slot next0 prev0) (-> this dead-list))
@@ -343,11 +319,11 @@
(set! (-> this alive-list next0) slot)
;; Also prepend it to this process's connection list.
(set! (-> slot next1) (-> proc connection-list next1))
(when (-> slot next1)
(set! (-> slot next1 prev1) slot))
(if (-> slot next1)
(set! (-> slot next1 prev1) slot))
(set! (-> slot prev1) (-> proc connection-list))
(set! (-> proc connection-list next1) slot)
(set! (-> this length) (+ (-> this length) 1))
(+! (-> this length) 1)
slot)))
(defmethod move-to-dead ((this connection))
@@ -387,36 +363,27 @@
(defmethod remove-matching ((this engine) (predicate (function connection engine symbol)))
"Move every live connection for which predicate returns true to the dead list."
(local-vars (current connectable) (next connectable))
(set! current (-> this alive-list next0))
(set! next (-> current next0))
(while (!= current (-> this alive-list-end))
(if (predicate (the-as connection current) this) ((method-of-type connection move-to-dead) (the-as connection current)))
(set! current next)
(set! next (-> next next0)))
(iterate-engine-connections (current this)
(if (predicate current this)
((method-of-type connection move-to-dead) current)))
0)
(defmethod remove-all ((this engine))
"Move every live connection to the dead list."
(local-vars (current connectable) (next connectable))
(set! current (-> this alive-list next0))
(set! next (-> current next0))
(while (!= current (-> this alive-list-end))
((method-of-type connection move-to-dead) (the-as connection current))
(set! current next)
(set! next (-> next next0)))
(iterate-engine-connections (current this)
((method-of-type connection move-to-dead) current))
0)
(defmethod remove-by-param1 ((this engine) (p1-value object))
"Move every live connection whose param1 equals value to the dead list."
(iterate-engine-connections (current this)
(if (= (-> (the-as connection current) param1) p1-value)
((method-of-type connection move-to-dead) (the-as connection current))))
(if (= (-> current param1) p1-value)
((method-of-type connection move-to-dead) current)))
0)
(defmethod remove-by-param2 ((this engine) (p2-value int))
"Move every live connection whose param2 equals value to the dead list."
(iterate-engine-connections (current this)
(if (= (-> (the-as connection current) param2) p2-value)
((method-of-type connection move-to-dead) (the-as connection current))))
(if (= (-> current param2) p2-value)
((method-of-type connection move-to-dead) current)))
0)
+1 -84
View File
@@ -7,170 +7,88 @@
;; Global engine settings:
(define *stats-poly* #f)
(define *stats-memory* #f)
(define *stats-memory-short* #f)
(define *stats-collide* #f)
(define *stats-bsp* #f)
(define *stats-buffer* #f)
(define *stats-target* #f)
(define *stats-dma-test* #f)
(define *artist-all-visible* #f)
(define *artist-flip-visible* #f)
(define *artist-fix-visible* #f)
(define *artist-fix-frustum* #f)
(define *artist-error-spheres* #f)
(define *artist-use-menu-subdiv* #f)
(define *display-profile* #t)
(define *display-sidekick-stats* #f)
(define *display-quad-stats* #f)
(define *display-tri-stats* #f)
(define *display-perf-stats* #f)
(define *display-ground-stats* #f)
(define *display-collision-marks* #f)
(define *display-collide-cache* #f)
(define *display-render-collision* #f)
(define *display-hipri-collision-marks* #f)
(define *display-edge-collision-marks* #f)
(define *display-geo-marks* #f)
(define *display-target-marks* #f)
(define *display-collide-history* 0)
(define *display-xyz-axes* #f)
(define *display-cam-collide-history* #f)
(define *record-cam-collide-history* #f)
(define *display-cam-master-marks* #f)
(define *display-cam-other* #f)
(define *display-camera-marks* #f)
(define *camera-no-mip-correction* #f)
(define *display-cam-los-info* #f)
(define *display-cam-los-debug* #f)
(define *display-cam-los-marks* #f)
(define *display-cam-coll-marks* #f)
(define *display-camera-info* #f)
(define *display-camera-old-stats* #f)
(define *display-camera-last-attacker* #f)
(define *display-file-info* #f)
(define *display-actor-marks* #f)
(define *display-ambient-hint-marks* #f)
(define *display-ambient-sound-marks* #f)
(define *display-ambient-poi-marks* #f)
(define *display-ambient-light-marks* #f)
(define *display-ambient-dark-marks* #f)
(define *display-ambient-weather-off-marks* #f)
(define *display-ambient-ocean-off-marks* #f)
(define *display-ambient-ocean-near-off-marks* #f)
(define *display-ambient-music-marks* #f)
(define *display-sprite-info* #f)
(define *display-entity-errors* #t)
(define *display-lights* #f)
(define *display-instance-info* #f)
(define *display-deci-count* #f)
(define *sync-dma* #f)
;; Bit mask selecting the terrain strip groups whose edges are drawn.
(define *display-strip-lines* 0)
(define *display-nav-marks* #f)
(define *display-path-marks* #f)
(define *display-vol-marks* #f)
(define *display-water-marks* #f)
(define *display-actor-anim* (the string #f))
(define *display-process-anim* (the-as (pointer process) #f))
(define *display-actor-vis* #f)
(define *display-actor-graph* #f)
(define *display-level-border* #f)
(define *display-load-boundaries* #f)
(define *display-memcard-info* #f)
(define *display-split-boxes* #f)
(define *display-split-box-info* #f)
(define *display-texture-download* #f)
(define *display-art-control* #f)
(define *display-level-spheres* #f)
(define *time-of-day-effects* #t)
(define *time-of-day-fast* #t)
(define *display-iop-info* #f)
(define *ambient-sound-class* #t)
(define *slow-frame-rate* #f)
(define *weather-off* #f)
(define *debug-pause* #f)
;; Subdivision debug display: 0 is normal textured rendering, 1 draws wireframe,
@@ -224,8 +142,7 @@
(define *frame-stats* (new 'static 'frame-stats))
;; Full-screen filter drawn as a single screen-sized quad. The draw? flag lets
;; callers retain the configured color while temporarily suppressing the pass.
;; Full-screen filter drawn as a single screen-sized quad.
(deftype screen-filter (basic)
((draw? basic)
(color rgba))
+12 -26
View File
@@ -9,7 +9,7 @@
;; The generic renderer is the slow but general renderer. The EE expands compact
;; model data into GSF vertices, applies lighting, environment mapping, level of
;; detail, and skeletal animation, then streams the result through VU0 and VU1.
;; detail, and skeletal animation, then streams the result through VU1.
;; On the VU side, it has no effects, other than scissoring.
@@ -33,10 +33,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry points of the generic VU1 program. A converter selects one by patching the immediate of
;; consts.mscal-tag; nothing else about the packet changes.
;; The program opens with a dispatch table of two instruction pairs per entry - a branch and its delay
;; pair - so an entry's address is twice its position in that table. Deriving them says so; a column of
;; even numbers does not.
;; consts.mscal-tag.
;; Each entry is 2 instructions long.
(defmacro generic-vu1-entry (index)
`(* 2 ,index))
@@ -61,21 +59,15 @@
(defconstant GENERIC-VU1-INBUF-LAST (+ GENERIC-VU1-INBUF-FIRST (* 2 GENERIC-VU1-INBUF-STEP)))
(defconstant GENERIC-VU1-HEADER-A 837)
(defconstant GENERIC-VU1-HEADER-QWC 30) ;; a header buffer: seven header quadwords plus its shaders
;; Keep the folded value because static structure initializers require an immediate here.
(defconstant GENERIC-VU1-HEADER-B 867) ;; GENERIC-VU1-HEADER-A + GENERIC-VU1-HEADER-QWC
(defconstant GENERIC-VU1-HEADER-FLIP (logxor GENERIC-VU1-HEADER-A GENERIC-VU1-HEADER-B))
(defconstant GENERIC-VU1-CONSTANTS (+ GENERIC-VU1-HEADER-B GENERIC-VU1-HEADER-QWC))
;; The two scratchpad output buffers, flipped after every packet. The value is not the buffer size:
;; generic-effect-buffer puts the shared work area between the two halves so that both stay within a
;; signed 16-bit displacement of the constants and lights every vertex needs, which makes the distance
;; 3552 + 1056. generic-saves.xor-outbufs is the stored copy.
;; constant to toggle output buffers with xor.
(defconstant GENERIC-OUTBUF-FLIP
(logxor (offset-of generic-effect-buffer outbuf-0) (offset-of generic-effect-buffer outbuf-1)))
;; The generic work area starts one quadword into the scratchpad page, so an address relative to the
;; page register is sixteen more than the field's offset inside generic-work. Assembly that keeps
;; the page in a register uses this instead of a bare number.
;; The generic work area starts one quadword into the scratchpad page.
(defconstant GENERIC-WORK-BASE 16)
(defmacro generic-work-offset (&rest path)
@@ -84,13 +76,11 @@
;; DECOMP BEGINS
;; The 32-byte working vertex format shared by the generic EE and VU programs.
;; "GSF" is retained as the format's original name; its expansion is not known.
;; The overlays expose the two input layouts used by the pipeline: position,
;; texture, normal, and color, or position plus delta texture/color data.
;;
;; The two readings of the second quadword are why the effect processors come in plain and "dproc"
;; flavors. A dproc fills dtex/dclr - the draw-point attribute lanes - where an ordinary processor
;; would have left a normal and a color.
;; The GSF acronym is unknown. Maybe Generic Strip Format?
;; There are two possible uses:
;; (pos, tex, nrm, clr)
;; (pos, tex, dtex, dclr, clr)
;; The "dproc" processors fill "d" values, used for second passes like environment mapping.
(deftype gsf-vertex (structure)
((data uint32 8)
(byte uint8 32 :overlay-at (-> data 0))
@@ -162,9 +152,6 @@
((pos uint16)
(len uint16)))
;; Where the environment-map pass parks the records it is working on. It runs four vertices at a
;; time through VU0 and has to keep the lanes VU0 does not touch alive across the call, so it saves
;; the records themselves rather than reloading them from the vertex array.
(deftype generic-envmap-saves (structure)
((index-mask vector4w :inline)
(verts uint128 12)
@@ -211,7 +198,7 @@
(inbuf-adr uint32) ;; VU1 input bank, rotating through three
(fade-val uint32)
(time-of-day-color rgba)
(to-vu0-waits uint32) ;; busy polls, charged to the timing display
(to-vu0-waits uint32) ;; busy poll counts
(to-spr-waits uint32)
(from-spr-waits uint32)
(envmap generic-envmap-saves :inline)))
@@ -228,8 +215,7 @@
(num-strips uint32 :overlay-at (-> data 3))))
(deftype ad-cmd (structure)
;; One GIF A+D payload. The overlays permit whole-qword copying or individual
;; GS register/data construction without changing the packet representation.
;; One GIF A+D payload.
((word uint32 4)
(quad uint128 :overlay-at (-> word 0))
(data uint64 :overlay-at (-> word 0))
@@ -6,7 +6,7 @@
;; DECOMP BEGINS
;; One 128-byte foreground skinning record. t-mtx transforms positions into camera space and
;; n-mtx carries the inverse-transpose basis used for normals. The eighth vector is available as
;; n-mtx carries the inverse-transpose matrix used for normals. The eighth vector is available as
;; per-matrix scale data without changing the eight-qword upload layout.
;;
;; Positions and normals need different matrices because a non-uniform scale or a shear does not
@@ -19,8 +19,7 @@
(n-mtx matrix3 :inline :overlay-at (-> data 16))
(scale vector :inline :overlay-at (-> vector 7))))
;; Three skinning records for one joint: where it is, where its parent is, and the difference. The
;; blend-shape and interpolation passes want the difference without recomputing it per vertex.
;; Unused.
(deftype generic-pris-mtx-save (structure)
((loc-mtx pris-mtx :inline)
(par-mtx pris-mtx :inline)
@@ -34,9 +33,7 @@
;; them, so this block is uploaded once per bucket rather than once per packet. guard is the
;; guard-band scale: the clipper multiplies a triangle's clip flags by it first, and if all three
;; vertices fall outside the same widened plane the triangle is rejected without being clipped at all.
;; stores is scratch, not a constant - the program keeps its output cursor and its two buffer
;; selectors there so a clipped draw can be resumed after the clipper has saved and restored the
;; register file.
;; stores is scratch, not a constant.
(deftype generic-constants (structure)
((fog vector :inline)
(adgif gs-gif-tag :inline)
@@ -49,10 +46,6 @@
(flush qword :inline)
(stores qword :inline)))
;; The block's field order is its upload order - it arrives as one ten-quadword V4-32 unpack - so a
;; field's quadword index inside it is simply its byte offset over sixteen. The microprogram keeps the
;; block's base in an integer register and addresses fields relative to that, so what it needs is the
;; index rather than the absolute VU address; GENERIC-VU1-CONSTANTS is the base itself.
(defmacro generic-const-qword (&rest path)
`(/ (offset-of generic-constants ,@path) 16))
@@ -23,8 +23,7 @@
;; DECOMP BEGINS
;; The arrival area for whichever renderer is feeding generic. MERC and TIE never convert at the same
;; time, so their working sets share the same 472 quadwords rather than each reserving their own. The
;; raw view exists because the DMA that fills it does not know or care which overlay is live.
;; time, so their working sets share the same 472 quadwords rather than each reserving their own.
(deftype generic-input-buffer (structure)
((merc generic-merc-work :inline :offset 0)
(tie generic-tie-work :inline :offset 0)
@@ -74,8 +73,7 @@
;; The two output buffers the converter alternates, with the work area deliberately between them
;; rather than before them: both halves then sit within a signed 16-bit displacement of the constants
;; and lights that every vertex needs. The price is that the flip is not the buffer size - it is
;; 3552 + 1056 = 4608 - which is what generic-saves.xor-outbufs holds.
;; and lights that every vertex needs.
(deftype generic-effect-buffer (structure)
((outbuf-0 uint8 3552)
(work generic-effect-work :inline)
+1 -3
View File
@@ -48,11 +48,9 @@
(defun put-draw-env ((packet (pointer gif-tag)))
"Send the GIF packet beginning at packet as a direct GS draw-environment transfer."
;; this is a workaround for OpenGOAL not supporting 128-bitfield access yet.
(#when PC_PORT
(return #f))
(let ((packet64 (the-as (pointer gif-tag64) packet)))
(dma-send GIF_DMA_BANK (the-as uint packet) (the-as uint (+ (the-as uint (-> packet64 0 nloop)) (the-as uint 1)))))
(dma-send (the-as dma-bank #x1000a000) (the-as uint packet) (+ (-> packet 0 nloop) 1))
(none))
;; Per frame data that is used by the renderers.
+15 -4
View File
@@ -13,6 +13,18 @@
(* 8 1024 1024) ;; 8M
(* 16 1024 1024))) ;; 16M
;; Display controls low-level frame presentation and timing.
;; The "display env" is the context for low-level hardware display settings like
;; resolution and pixel format, it forwards these settings to Sony Functions that
;; know how to configure low-level analog video hardware.
;; The "draw env" is a very simple context for drawing settings,
;; including low-level settings like framebuffer address and memory layout,
;; but also blending settings. The renderers are free to mess with blending settings
;; outside of the draw-env but if they mess with framebuffer settings,
;; they are responsible for restoring them.
;; DECOMP BEGINS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -155,7 +167,9 @@
(defun put-display-alpha-env ((env display-env))
"Write DISPFB1 and DISPLAY1 immediately from env."
(let ((gs (the-as gs-bank #x12000000))) (set! (-> gs dspfb1) (-> env dspfb)) (set! (-> gs display1) (-> env display)))
(let ((gs (the-as gs-bank #x12000000)))
(set! (-> gs dspfb1) (-> env dspfb))
(set! (-> gs display1) (-> env display)))
(none))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -291,11 +305,8 @@
;; location and size
(define *profile-x* 1808)
(define *profile-y* (+ (-> *video-parms* screen-miny) 8))
(define *profile-w* 416)
(define *profile-h* 8)
;; ticks or percent?
-4
View File
@@ -46,13 +46,9 @@
:relative-x-scale-reciprical 1.0))
(define-extern get-video-mode (function symbol))
(define-extern get-aspect-ratio (function symbol))
(define-extern set-hud-aspect-ratio (function symbol symbol none))
(define-extern set-aspect-ratio (function symbol none))
(define-extern set-video-mode (function symbol none))
(defmacro correct-x-int (pos)
+4 -4
View File
@@ -4,15 +4,15 @@
(require "kernel/gcommon.gc")
;; Foreground lighting has two representations. light-group is the editable EE
;; form; vu-lights is its transposed, tightly packed VU input. The volume types
;; describe the spatial-light selection system.
;; form; vu-lights is its transposed, tightly packed VU input. The light volumes
;; aren't used - foreground lighting is pretty simple.
;; DECOMP BEGINS
;; Three directional lights plus ambient color in the layout consumed by merc and
;; generic VU programs. direction is transposed: its three vectors contain the
;; x, y, and z components of all three light directions. color retains one
;; scaled color vector per light. The unused w lanes do not carry lighting input.
;; x, y, and z components of all three light directions.
;; The w component isn't used for light and can hold magic flags for renderers.
(deftype vu-lights (structure)
((direction vector 3 :inline)
(color vector 3 :inline)
@@ -7,11 +7,6 @@
;; from the position of the in-game camera. It also computes some other common camera info.
;; See cam-update.gc for how the game camera updates the math-camera.
;; It also carries four compact legacy visibility GIF template slots. The setup code initializes
;; gifgr once and rewrites giftex three times; init-for-transform consumes the final giftex value.
;; The projection, screen-space scale/offset, fog, and clipping state here is shared by
;; nearly every renderer.
;; DECOMP BEGINS
(deftype vis-gif-tag (structure)
+259 -434
View File
@@ -11,19 +11,23 @@
;; math camera basics
;;;;;;;;;;;;;;;;;;;;;;
;; the math camera computes the perspective matrix, hvdf offset, and hmge scale.
;; the math camera computes the perspective matrix, hvdf offset, and hmge scale used by renderers.
;; Multiplying a point by the perspective matrix, dividing HVD by the homogeneous Q scale, then
;; adding hvdf-off gives:
;; H : horizontal position (in GS coordinates)
;; V : vertical position (in GS coordinates)
;; D : reversed, nonlinear depth in the GS 24-bit z-buffer range
;; F : linear fog, carried in the undivided fourth lane
;; To render a point, renderers will:
;; - multiply by `camera-temp` matrix to produce p0
;; - elementwise-multiply p0 by `hmge-scale` to produce `homogenous-pt`
;; - check for clipping with frustum and near/far planes by comparing `abs(homogenous-pt.xyz)` with `.w`
;; - perspective divide `p0.xyz / homogenous-pt.w`
;; - convert to GS format by adding `hvdf-offset` and converting to 4-bit fractional values.
;; Multiplying the four matrix outputs by hmge-scale puts them in the VU clip volume and makes its
;; fourth lane z*fov-scale/d. Q is the reciprocal of that value, so multiplying HVD by Q performs
;; the perspective divide. The unscaled fourth matrix lane is retained for fog instead of being
;; multiplied by Q.
;; the resulting integers are HVDF:
;; H - horizontal pixel (in fixed-point 28.4)
;; V - vertical pixel (in fixed-point 28.4)
;; D - depth (for 24-bit depth buffer)
;; F - fog value
;; For renderers which know they won't clip, computation of `homogenous-pt.w` is typically
;; computed with p0.w / pfog0.
;; camera-temp combines the perspective and camera transformations for renderers that want one matrix.
@@ -34,8 +38,7 @@
;; The math-camera matrices are used to compute fogging values, which are a per-vertex uint8 that
;; tells the GS how "foggy" the color should be. This should be proportional to how far away the vertex
;; is. There is a scaling factor applied so the fog intensity isn't affected by the field of view angle.
;; Fog is not perspective-divided: its matrix lane remains linear in camera-space depth. Scaling the
;; fog endpoints by the same FOV correction used by the matrix makes that lane independent of zoom.
;; Fog is not perspective-divided: its matrix lane remains linear in camera-space depth.
;; DECOMP BEGINS
@@ -57,8 +60,8 @@
(defun update-math-camera ((math-cam math-camera) (video-mode symbol) (aspect symbol))
"Rebuild the camera's projection and culling constants. The projection maps positive camera-space
depth d..f nonlinearly onto the reversed 24-bit GS depth interval 16760631..100, while its
undivided fourth lane carries linear fog. video-mode is retained but unused."
depth d..f nonlinearly onto the reversed 24-bit GS depth interval 16760631..100.
video-mode is unused."
;; the x/y ratio are frustum slopes
(set! (-> math-cam x-ratio) (tan (* 0.5 (-> math-cam fov))))
(if (= aspect 'aspect4x3)
@@ -221,9 +224,9 @@
(set! (-> math-cam sprite-2d-hvdf z) (-> math-cam hvdf-off z))
(set! (-> math-cam pfog0) fog-slope)
(set! (-> math-cam pfog1) hvdf-w))))
;; Set up the legacy visibility templates. This sequence really does initialize gifgr once,
;; then write giftex three times; the final two stores do not address the two -trans slots.
0
;; Set up the legacy visibility templates. It seems like this code is no longer in use,
;; and has some bugs/typos/type issues.
;; debug.gc does consume the fog0 in giftex
(make-u128 0 (shl #x301ec000 32))
(make-u128 0 (shl #x303ec000 32))
(let ((pfog (-> math-cam pfog0)))
@@ -285,7 +288,7 @@
(matrix->quaternion (-> *math-camera* inv-camera-rot-smooth-from) (-> *math-camera* inv-camera-rot-smooth)))
(defun move-target-from-pad ((trans transform) (pad-idx int))
"Adjust a legacy Euler camera transform from the selected controller's held buttons."
"Adjust a legacy Euler transform from the selected controller's held buttons."
;; local-trans is the translation in the camera frame.
(let ((local-trans (new-stack-vector0)))
;; circle/square move camera relative x (left and right)
@@ -326,431 +329,253 @@
(if (cpad-hold? pad-idx right) (+! (-> trans rot y) -546.13336))
trans)
(#when PC_PORT
(defun transform-point-vector! ((out vector) (point vector))
"Transform point to floating-point GS horizontal, vertical, depth, and fog coordinates in out;
return true when it is inside all six clip planes."
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf))
(init-vf0-vector)
0
(.lvf vf24 (&-> *math-camera* camera-temp vector 0 quad))
(.lvf vf25 (&-> *math-camera* camera-temp vector 1 quad))
(.lvf vf26 (&-> *math-camera* camera-temp vector 2 quad))
(.lvf vf27 (&-> *math-camera* camera-temp vector 3 quad))
(.lvf vf29 (&-> *math-camera* hmge-scale quad))
(.lvf vf30 (&-> *math-camera* hvdf-off quad))
(.lvf vf28 (&-> point quad))
(.mul.x.vf acc vf24 vf28)
(.add.mul.y.vf acc vf25 vf28 acc)
(.add.mul.z.vf acc vf26 vf28 acc)
(.add.mul.w.vf vf28 vf27 vf0 acc)
(.add.w.vf vf23 vf0 vf0)
(.mul.vf vf31 vf28 vf29)
;;(TODO.VCLIP vf31 vf31)
(let ((clip (vu-clip vf31 0)))
(.div.vf Q vf0 vf31 :fsf #b11 :ftf #b11)
(.wait.vf)
;;(.cfc2.i v1-7 Clipping)
(.mul.vf.xyz vf28 vf28 Q)
(.mul.vf vf23 vf23 Q)
(.add.vf vf28 vf28 vf30)
(.max.x.vf.w vf28 vf28 vf0)
(.svf (&-> out quad) vf28)
(zero? (logand clip 63))))))
(#when PC_PORT
(defun transform-point-qword! ((out vector4w) (point vector))
"Transform point to signed 28.4 GS horizontal, vertical, depth, and fog coordinates in out;
return true when it is inside all six clip planes."
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf))
(init-vf0-vector)
(let ((v1-0 0)))
;; this camera matrix has both the projection and camera translation/rotation
(.lvf vf24 (&-> *math-camera* camera-temp vector 0 quad))
(.lvf vf25 (&-> *math-camera* camera-temp vector 1 quad))
(.lvf vf26 (&-> *math-camera* camera-temp vector 2 quad))
(.lvf vf27 (&-> *math-camera* camera-temp vector 3 quad))
;; scaling
(.lvf vf29 (&-> *math-camera* hmge-scale quad))
;; offset
(.lvf vf30 (&-> *math-camera* hvdf-off quad))
;; input point
(.lvf vf28 (&-> point quad))
;; matrix multiply, result in vf28
(.mul.x.vf acc vf24 vf28)
(.add.mul.y.vf acc vf25 vf28 acc)
(.add.mul.z.vf acc vf26 vf28 acc)
(.add.mul.w.vf vf28 vf27 vf0 acc)
(.add.w.vf vf23 vf0 vf0) ;; set w = 1.0
;; apply hmge scaling. the result of this multiply sets clipping flags appropriately
(.mul.vf vf31 vf28 vf29) ;; scale.
;;(TODO.VCLIP vf31 vf31)
(let ((clip (vu-clip vf31 0))) ;; clip!
;; perspective divide
(.div.vf Q vf0 vf31 :fsf #b11 :ftf #b11)
(.wait.vf)
;;(.cfc2.i v1-7 Clipping)
;; perspective
(.mul.vf.xyz vf28 vf28 Q)
;; compute scale factor (w was 1.0)
(.mul.vf vf23 vf23 Q)
;; apply hvdf offsets
(.add.vf vf28 vf28 vf30)
;; Clamp negative fog to vf0.x (zero).
(.max.x.vf.w vf28 vf28 vf0)
;; convert to GS fixed point
(vftoi4.xyzw vf28 vf28)
;; store result!
(.svf (&-> out quad) vf28)
;; return result of clipping.
(zero? (logand clip 63))))))
(#when PC_PORT
(defun transform-point-vector-scale! ((out vector) (point vector))
"Transform point to floating-point GS coordinates in out and return the homogeneous
perspective-divide scale."
(local-vars (perspective-scale float))
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf))
(init-vf0-vector)
(let ((v1-0 0)))
(.lvf vf24 (&-> *math-camera* camera-temp vector 0 quad))
(.lvf vf25 (&-> *math-camera* camera-temp vector 1 quad))
(.lvf vf26 (&-> *math-camera* camera-temp vector 2 quad))
(.lvf vf27 (&-> *math-camera* camera-temp vector 3 quad))
(.lvf vf29 (&-> *math-camera* hmge-scale quad))
(.lvf vf30 (&-> *math-camera* hvdf-off quad))
(.lvf vf28 (&-> point quad))
(.mul.x.vf acc vf24 vf28)
(.add.mul.y.vf acc vf25 vf28 acc)
(.add.mul.z.vf acc vf26 vf28 acc)
(.add.mul.w.vf vf28 vf27 vf0 acc)
(.add.w.vf vf23 vf0 vf0)
(.mul.vf vf31 vf28 vf29)
;;(TODO.VCLIP vf31 vf31) clip result was unused
(defun transform-point-vector! ((out vector) (point vector))
"Transform point to floating-point GS horizontal, vertical, depth, and fog coordinates in out;
return true when it is inside all six clip planes.
Note that this is before int to float conversion so depth / fog will be effectively divided by 16"
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf))
(init-vf0-vector)
(.lvf vf24 (&-> *math-camera* camera-temp vector 0 quad))
(.lvf vf25 (&-> *math-camera* camera-temp vector 1 quad))
(.lvf vf26 (&-> *math-camera* camera-temp vector 2 quad))
(.lvf vf27 (&-> *math-camera* camera-temp vector 3 quad))
(.lvf vf29 (&-> *math-camera* hmge-scale quad))
(.lvf vf30 (&-> *math-camera* hvdf-off quad))
(.lvf vf28 (&-> point quad))
;; multiply by camera-temp, store result in vf28
(.mul.x.vf acc vf24 vf28)
(.add.mul.y.vf acc vf25 vf28 acc)
(.add.mul.z.vf acc vf26 vf28 acc)
(.add.mul.w.vf vf28 vf27 vf0 acc)
;; unused vf23
(.add.w.vf vf23 vf0 vf0)
;; vf31 = homogenous coordinates
(.mul.vf vf31 vf28 vf29)
;; set clipping flags
;; (TODO.VCLIP vf31 vf31)
(let ((clip (vu-clip vf31 0)))
;; compute 1 / homogenous.w
(.div.vf Q vf0 vf31 :fsf #b11 :ftf #b11)
(.wait.vf)
;;(.cfc2.i v1-7 Clipping)
;; apply perspective divide
(.mul.vf.xyz vf28 vf28 Q)
;; unused
(.mul.vf vf23 vf23 Q)
;; add hvdf offset
(.add.vf vf28 vf28 vf30)
;; clamp fog
(.max.x.vf.w vf28 vf28 vf0)
(.svf (&-> out quad) vf28)
;;(let ((a0-2 (zero? (logand v1-7 63))))
;; )
(.mov perspective-scale vf23)
perspective-scale)))
(zero? (logand clip 63)))))
(#unless PC_PORT
(defun transform-point-vector! ((out vector) (point vector))
"Transform point to floating-point GS horizontal, vertical, depth, and fog coordinates in out;
return true when it is inside all six clip planes."
;; Keep the fixed register schedule: these short helpers avoid a stack frame and feed VU0
;; directly from the shared camera state.
(rlet ((camera)
(row-0 :reg vf24)
(row-1 :reg vf25)
(row-2 :reg vf26)
(row-3 :reg vf27)
(divide-scale :reg vf23)
(point-vf :reg vf28)
(homogeneous-scale :reg vf29)
(hvdf-offset :reg vf30)
(clip-coordinates :reg vf31)
(vf0 :reg vf0)
(Q :reg Q)
(clip-flags))
0
(m! camera *math-camera*)
(l.vf row-0 camera 572)
(m! camera *math-camera*)
(l.vf row-1 camera 588)
(m! camera *math-camera*)
(l.vf row-2 camera 604)
(m! camera *math-camera*)
(l.vf row-3 camera 620)
(m! camera *math-camera*)
(l.vf homogeneous-scale camera 700)
(m! camera *math-camera*)
(l.vf hvdf-offset camera 732)
(l.vf point-vf point)
(mula.x.vf row-0 point-vf)
(madda.y.vf row-1 point-vf)
(madda.z.vf row-2 point-vf)
(madd.w.vf point-vf row-3 vf0)
(add.w.vf divide-scale vf0 vf0)
(mul.vf clip-coordinates point-vf homogeneous-scale)
(clip.vf.xyz clip-coordinates clip-coordinates)
(div.w.w Q vf0 clip-coordinates)
(waitq)
(m clip-flags Clipping)
;; The perspective divide applies only to HVD. Fog remains linear in camera depth.
(mulq.vf.xyz point-vf point-vf Q)
(mulq.vf divide-scale divide-scale Q)
(add.vf point-vf point-vf hvdf-offset)
(max.x.vf.w point-vf point-vf vf0)
(s.vf point-vf out)
(zero? (logand clip-flags 63)))))
(defun transform-point-qword! ((out vector4w) (point vector))
"Transform point to signed 28.4 GS horizontal, vertical, depth, and fog coordinates in out;
return true when it is inside all six clip planes."
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf))
(init-vf0-vector)
(let ((v1-0 0)))
;; this camera matrix has both the projection and camera translation/rotation
(.lvf vf24 (&-> *math-camera* camera-temp vector 0 quad))
(.lvf vf25 (&-> *math-camera* camera-temp vector 1 quad))
(.lvf vf26 (&-> *math-camera* camera-temp vector 2 quad))
(.lvf vf27 (&-> *math-camera* camera-temp vector 3 quad))
(.lvf vf29 (&-> *math-camera* hmge-scale quad))
(.lvf vf30 (&-> *math-camera* hvdf-off quad))
(.lvf vf28 (&-> point quad))
;; multiply by camera-temp, store result in vf28
(#unless PC_PORT
(defun transform-point-qword! ((out vector4w) (point vector))
"Transform point to signed 28.4 GS horizontal, vertical, depth, and fog coordinates in out;
return true when it is inside all six clip planes."
(rlet ((camera)
(row-0 :reg vf24)
(row-1 :reg vf25)
(row-2 :reg vf26)
(row-3 :reg vf27)
(divide-scale :reg vf23)
(point-vf :reg vf28)
(homogeneous-scale :reg vf29)
(hvdf-offset :reg vf30)
(clip-coordinates :reg vf31)
(vf0 :reg vf0)
(Q :reg Q)
(clip-flags))
0
(m! camera *math-camera*)
(l.vf row-0 camera 572)
(m! camera *math-camera*)
(l.vf row-1 camera 588)
(m! camera *math-camera*)
(l.vf row-2 camera 604)
(m! camera *math-camera*)
(l.vf row-3 camera 620)
(m! camera *math-camera*)
(l.vf homogeneous-scale camera 700)
(m! camera *math-camera*)
(l.vf hvdf-offset camera 732)
(l.vf point-vf point)
(mula.x.vf row-0 point-vf)
(madda.y.vf row-1 point-vf)
(madda.z.vf row-2 point-vf)
(madd.w.vf point-vf row-3 vf0)
(add.w.vf divide-scale vf0 vf0)
(mul.vf clip-coordinates point-vf homogeneous-scale)
(clip.vf.xyz clip-coordinates clip-coordinates)
(div.w.w Q vf0 clip-coordinates)
(waitq)
(m clip-flags Clipping)
(mulq.vf.xyz point-vf point-vf Q)
(mulq.vf divide-scale divide-scale Q)
(add.vf point-vf point-vf hvdf-offset)
;; vf0.x is zero, so only negative fog values are saturated.
(max.x.vf.w point-vf point-vf vf0)
(ftoi.vf point-vf point-vf :fixed 4)
(s.vf point-vf out)
(zero? (logand clip-flags 63)))))
(.mul.x.vf acc vf24 vf28)
(.add.mul.y.vf acc vf25 vf28 acc)
(.add.mul.z.vf acc vf26 vf28 acc)
(.add.mul.w.vf vf28 vf27 vf0 acc)
(.add.w.vf vf23 vf0 vf0) ;; unused
;; vf31 = homogenous coordinates
(.mul.vf vf31 vf28 vf29)
;;(TODO.VCLIP vf31 vf31)
(let ((clip (vu-clip vf31 0))) ;; clip!
;; perspective divide: 1/homogenous.w
(.div.vf Q vf0 vf31 :fsf #b11 :ftf #b11)
(.wait.vf)
;;(.cfc2.i v1-7 Clipping)
;; perspective
(.mul.vf.xyz vf28 vf28 Q)
;; unused
(.mul.vf vf23 vf23 Q)
;; apply hvdf offsets
(.add.vf vf28 vf28 vf30)
;; Clamp negative fog to 0.
(.max.x.vf.w vf28 vf28 vf0)
;; convert to GS fixed point
(vftoi4.xyzw vf28 vf28)
;; store result!
(.svf (&-> out quad) vf28)
;; return result of clipping.
(zero? (logand clip 63)))))
(#unless PC_PORT
(defun transform-point-vector-scale! ((out vector) (point vector))
"Transform point to floating-point GS coordinates in out and return the homogeneous
perspective-divide scale."
(rlet ((camera)
(row-0 :reg vf24)
(row-1 :reg vf25)
(row-2 :reg vf26)
(row-3 :reg vf27)
(divide-scale :reg vf23)
(point-vf :reg vf28)
(homogeneous-scale :reg vf29)
(hvdf-offset :reg vf30)
(clip-coordinates :reg vf31)
(vf0 :reg vf0)
(Q :reg Q)
(clip-flags)
(perspective-scale))
0
(m! camera *math-camera*)
(l.vf row-0 camera 572)
(m! camera *math-camera*)
(l.vf row-1 camera 588)
(m! camera *math-camera*)
(l.vf row-2 camera 604)
(m! camera *math-camera*)
(l.vf row-3 camera 620)
(m! camera *math-camera*)
(l.vf homogeneous-scale camera 700)
(m! camera *math-camera*)
(l.vf hvdf-offset camera 732)
(l.vf point-vf point)
(mula.x.vf row-0 point-vf)
(madda.y.vf row-1 point-vf)
(madda.z.vf row-2 point-vf)
(madd.w.vf point-vf row-3 vf0)
(add.w.vf divide-scale vf0 vf0)
(mul.vf clip-coordinates point-vf homogeneous-scale)
;; This routine returns Q instead of visibility, but the original still updates and reads
;; the clip history before transferring Q through vf23.
(clip.vf.xyz clip-coordinates clip-coordinates)
(div.w.w Q vf0 clip-coordinates)
(waitq)
(m clip-flags Clipping)
(mulq.vf.xyz point-vf point-vf Q)
(mulq.vf divide-scale divide-scale Q)
(add.vf point-vf point-vf hvdf-offset)
(max.x.vf.w point-vf point-vf vf0)
(s.vf point-vf out)
(zero? (logand clip-flags 63))
(m perspective-scale divide-scale)
perspective-scale)))
(defun transform-point-vector-scale! ((out vector) (point vector))
"Transform point to floating-point GS coordinates in out and return the homogeneous
perspective-divide scale."
(local-vars (perspective-scale float))
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf))
(init-vf0-vector)
(let ((v1-0 0)))
(.lvf vf24 (&-> *math-camera* camera-temp vector 0 quad))
(.lvf vf25 (&-> *math-camera* camera-temp vector 1 quad))
(.lvf vf26 (&-> *math-camera* camera-temp vector 2 quad))
(.lvf vf27 (&-> *math-camera* camera-temp vector 3 quad))
(.lvf vf29 (&-> *math-camera* hmge-scale quad))
(.lvf vf30 (&-> *math-camera* hvdf-off quad))
(.lvf vf28 (&-> point quad))
;; multiply by camera-temp, store in vf28
(.mul.x.vf acc vf24 vf28)
(.add.mul.y.vf acc vf25 vf28 acc)
(.add.mul.z.vf acc vf26 vf28 acc)
(.add.mul.w.vf vf28 vf27 vf0 acc)
;; set vf23.x = 1
(.add.w.vf vf23 vf0 vf0)
;; compute homogenous coordinates
(.mul.vf vf31 vf28 vf29)
;;(TODO.VCLIP vf31 vf31) clip result was unused, no need to clip.
;; Q = 1 / homogenous.w
(.div.vf Q vf0 vf31 :fsf #b11 :ftf #b11)
(.wait.vf)
;;(.cfc2.i v1-7 Clipping)
;; perspective divide
(.mul.vf.xyz vf28 vf28 Q)
;; get the 1 / homogenous.w == scale!
(.mul.vf vf23 vf23 Q)
;; add hvdf offset
(.add.vf vf28 vf28 vf30)
;; clamp fog to 0
(.max.x.vf.w vf28 vf28 vf0)
;; store
(.svf (&-> out quad) vf28)
;; unused clipping result
;;(let ((a0-2 (zero? (logand v1-7 63))))
;; )
;; return the perspective scale
(.mov perspective-scale vf23)
perspective-scale))
(#when PC_PORT
(defun init-for-transform ((object-matrix matrix))
"Populate the persistent VU0 transform-register convention for object-matrix and the current camera."
(rlet ((vf1 :class vf)
(vf17 :class vf)
(vf18 :class vf)
(vf19 :class vf)
(vf2 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf))
(let ((normal-matrix (new-stack-matrix0))
(transform-matrix (new-stack-matrix0))
(constant-vectors (new 'stack 'vector4s-3))
(ambient-vector (new-stack-vector0))
(basis-vectors (new 'stack 'vector4s-3)))
(matrix*! transform-matrix object-matrix (-> *math-camera* camera-temp))
(matrix-3x3-inverse-transpose! normal-matrix object-matrix)
(set-vector! ambient-vector 0.4 0.4 0.4 1.0)
(set-vector! (-> constant-vectors vector 0) 1.0 1.0 1.0 1.0)
(set-vector! (-> constant-vectors vector 1) 0.0 0.0 0.0 1.0)
(set-vector! (-> constant-vectors vector 2) 0.0 0.0 0.0 1.0)
(set-vector! (-> basis-vectors vector 0) 1.0 0.0 0.0 1.0)
(set-vector! (-> basis-vectors vector 1) 0.0 1.0 0.0 1.0)
(set-vector! (-> basis-vectors vector 2) 0.0 0.0 1.0 1.0)
(.lvf vf7 (&-> *math-camera* hmge-scale quad))
(.lvf vf8 (&-> *math-camera* hvdf-off quad))
(.lvf vf9 (&-> *math-camera* giftex))
(let ((v1-13 255)) (.mov vf6 v1-13))
;;(.mov v1-14 vf6)
(.itof.vf vf6 vf6)
(.svf (&-> *transform-regs* vf7) vf7)
(.svf (&-> *transform-regs* vf8) vf8)
(.svf (&-> *transform-regs* vf9) vf9)
(.svf (&-> *transform-regs* vf6) vf6)
(set! (-> *transform-regs* vf1) (-> transform-matrix vector 0 quad))
(set! (-> *transform-regs* vf2) (-> transform-matrix vector 1 quad))
(set! (-> *transform-regs* vf3) (-> transform-matrix vector 2 quad))
(set! (-> *transform-regs* vf4) (-> transform-matrix vector 3 quad))
(set! (-> *transform-regs* vf17) (-> normal-matrix vector 0 quad))
(set! (-> *transform-regs* vf18) (-> normal-matrix vector 1 quad))
(set! (-> *transform-regs* vf19) (-> normal-matrix vector 2 quad))
(set! (-> *transform-regs* vf23) (-> basis-vectors quad 0))
(set! (-> *transform-regs* vf24) (-> basis-vectors quad 1))
(set! (-> *transform-regs* vf25) (-> basis-vectors quad 2))
(set! (-> *transform-regs* vf27) (-> constant-vectors quad 0))
(set! (-> *transform-regs* vf28) (-> constant-vectors quad 1))
(set! (-> *transform-regs* vf29) (-> constant-vectors quad 2))
(set! (-> *transform-regs* vf26) (-> ambient-vector quad)))
(none))))
;; Old VU0 Register Convention
;; (mostly unused at this point, but was likely used in early rendering)
;; model matrix is OBJECT_MATRIX * CAMERA_TEMP, allowing you to render points in a model's local space.
;; normal matrix is the inverse transpose of the upper 3x3 of model matrix, for transforming normals
;; vf1, vf2, vf3, vf4 : model matrix
;; vf5 unused
;; vf6 : 255.0 floating point
;; vf7 : hmge-scale
;; vf8 : hvdf-off
;; vf9 : "giftex": [fog0, <some GS constants that appear wrong>]
;; vf10 - vf16 : unused
;; vf17, vf18, vf19 : normal matrix
;; vf23, vf24, vf25 : identiy matrix (why do they need this lol)
;; vf26 : [0.4, 0.4, 0.4, 1.0]
;; vf27 : [1, 1, 1, 1]
;; vf28 : [0, 0, 0, 1]
;; vf29 : [0, 0, 0, 1]
(defun init-for-transform ((object-matrix matrix))
"Populate the persistent VU0 transform-register convention for object-matrix and the current camera."
(rlet ((vf1 :class vf)
(vf17 :class vf)
(vf18 :class vf)
(vf19 :class vf)
(vf2 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf))
(let ((normal-matrix (new-stack-matrix0))
(transform-matrix (new-stack-matrix0))
(constant-vectors (new 'stack 'vector4s-3))
(ambient-vector (new-stack-vector0))
(basis-vectors (new 'stack 'vector4s-3)))
(matrix*! transform-matrix object-matrix (-> *math-camera* camera-temp))
(matrix-3x3-inverse-transpose! normal-matrix object-matrix)
(set-vector! ambient-vector 0.4 0.4 0.4 1.0)
(set-vector! (-> constant-vectors vector 0) 1.0 1.0 1.0 1.0)
(set-vector! (-> constant-vectors vector 1) 0.0 0.0 0.0 1.0)
(set-vector! (-> constant-vectors vector 2) 0.0 0.0 0.0 1.0)
(set-vector! (-> basis-vectors vector 0) 1.0 0.0 0.0 1.0)
(set-vector! (-> basis-vectors vector 1) 0.0 1.0 0.0 1.0)
(set-vector! (-> basis-vectors vector 2) 0.0 0.0 1.0 1.0)
(.lvf vf7 (&-> *math-camera* hmge-scale quad))
(.lvf vf8 (&-> *math-camera* hvdf-off quad))
(.lvf vf9 (&-> *math-camera* giftex))
(let ((v1-13 255)) (.mov vf6 v1-13))
;;(.mov v1-14 vf6)
(.itof.vf vf6 vf6)
(.svf (&-> *transform-regs* vf7) vf7)
(.svf (&-> *transform-regs* vf8) vf8)
(.svf (&-> *transform-regs* vf9) vf9)
(.svf (&-> *transform-regs* vf6) vf6)
(set! (-> *transform-regs* vf1) (-> transform-matrix vector 0 quad))
(set! (-> *transform-regs* vf2) (-> transform-matrix vector 1 quad))
(set! (-> *transform-regs* vf3) (-> transform-matrix vector 2 quad))
(set! (-> *transform-regs* vf4) (-> transform-matrix vector 3 quad))
(set! (-> *transform-regs* vf17) (-> normal-matrix vector 0 quad))
(set! (-> *transform-regs* vf18) (-> normal-matrix vector 1 quad))
(set! (-> *transform-regs* vf19) (-> normal-matrix vector 2 quad))
(set! (-> *transform-regs* vf23) (-> basis-vectors quad 0))
(set! (-> *transform-regs* vf24) (-> basis-vectors quad 1))
(set! (-> *transform-regs* vf25) (-> basis-vectors quad 2))
(set! (-> *transform-regs* vf27) (-> constant-vectors quad 0))
(set! (-> *transform-regs* vf28) (-> constant-vectors quad 1))
(set! (-> *transform-regs* vf29) (-> constant-vectors quad 2))
(set! (-> *transform-regs* vf26) (-> ambient-vector quad)))
(none)))
(#unless PC_PORT
(defun init-for-transform ((object-matrix matrix))
"Populate the persistent VU0 transform-register convention for object-matrix and the current camera."
;; These physical VU0 registers form an ABI with the legacy transform routines. They deliberately
;; remain live after this function returns.
(rlet ((transform-row-0 :reg vf1)
(transform-row-1 :reg vf2)
(transform-row-2 :reg vf3)
(transform-row-3 :reg vf4)
(max-fog :reg vf6)
(homogeneous-scale :reg vf7)
(hvdf-offset :reg vf8)
(visibility-template :reg vf9)
(normal-row-0 :reg vf17)
(normal-row-1 :reg vf18)
(normal-row-2 :reg vf19)
(basis-x :reg vf23)
(basis-y :reg vf24)
(basis-z :reg vf25)
(ambient :reg vf26)
(constant-0 :reg vf27)
(constant-1 :reg vf28)
(constant-2 :reg vf29)
(camera)
(max-fog-bits)
(unused-copy))
(let ((normal-matrix (new-stack-matrix0))
(transform-matrix (new-stack-matrix0))
(constant-vectors (new 'stack 'vector4s-3))
(ambient-vector (new-stack-vector0))
(basis-vectors (new 'stack 'vector4s-3)))
(matrix*! transform-matrix object-matrix (-> *math-camera* camera-temp))
(matrix-3x3-inverse-transpose! normal-matrix object-matrix)
(set-vector! ambient-vector 0.4 0.4 0.4 1.0)
(set-vector! (-> constant-vectors vector 0) 1.0 1.0 1.0 1.0)
(set-vector! (-> constant-vectors vector 1) 0.0 0.0 0.0 1.0)
(set-vector! (-> constant-vectors vector 2) 0.0 0.0 0.0 1.0)
(set-vector! (-> basis-vectors vector 0) 1.0 0.0 0.0 1.0)
(set-vector! (-> basis-vectors vector 1) 0.0 1.0 0.0 1.0)
(set-vector! (-> basis-vectors vector 2) 0.0 0.0 1.0 1.0)
(m! camera *math-camera*)
(l.vf homogeneous-scale camera 700)
(m! camera *math-camera*)
(l.vf hvdf-offset camera 732)
(m! camera *math-camera*)
(l.vf visibility-template camera 764)
(m! max-fog-bits 255)
(m max-fog max-fog-bits)
;; Preserve the original EE/VU crossing even though this copy is not subsequently used.
(m unused-copy max-fog)
(itof.vf max-fog max-fog)
(l.vf transform-row-0 transform-matrix)
(l.vf transform-row-1 transform-matrix 16)
(l.vf transform-row-2 transform-matrix 32)
(l.vf transform-row-3 transform-matrix 48)
(l.vf normal-row-0 normal-matrix)
(l.vf normal-row-1 normal-matrix 16)
(l.vf normal-row-2 normal-matrix 32)
(l.vf basis-x basis-vectors)
(l.vf basis-y basis-vectors 16)
(l.vf basis-z basis-vectors 32)
(l.vf constant-0 constant-vectors)
(l.vf constant-1 constant-vectors 16)
(l.vf constant-2 constant-vectors 32)
(l.vf ambient ambient-vector))
(none))))
@@ -6,24 +6,17 @@
;; The "generic merc" renderer converts merc data to be used by generic.
;; It is used for environment mapping and scissoring in the original game.
;; Which fragments take this path is decided in bones.gc, not here: a fragment that failed the
;; screen-edge test needs a clipper MERC's own microprogram does not have, and a fragment with an
;; environment map needs a second attribute set it cannot produce. Either way the fragment is marked
;; use-mercneric and arrives here instead, in the same compact form MERC would have received.
;; Which fragments take this path is decided in bones.gc. The game prefers merc,
;; but falls back to generic when clipping or environment mapping is needed.
;; DECOMP BEGINS
;; One bone's transform on its way to VU0, with the DMA tag that carried it sharing the first
;; quadword. Eight quadwords whether or not all eight are used, because the converter stages them in
;; fixed-size slots.
;; One bone's transform and DMA tag.
(deftype merc-matrix (structure)
((quad uint128 8)
(vector vector 8 :inline :overlay-at (-> quad 0))
(tag uint64 :overlay-at (-> quad 0))))
;; A DMA tag whose address and size words are read back as ordinary data: the converter walks the
;; chain itself rather than letting the DMA controller follow it, so it needs the link in a form it
;; can load.
(deftype generic-merc-tag (dma-packet)
((next-ptr uint32 :overlay-at vif1)
(size uint32 :overlay-at vif0)))
@@ -107,8 +100,6 @@
(hsr-xmult vector :inline)
(hsr-ymult vector :inline)))
;; The mercneric working set, overlaid on generic-input-buffer at offset zero. MERC and TIE never
;; convert at the same time, so they share those 472 quadwords rather than each reserving their own.
(deftype generic-merc-work (structure)
((input-a generic-merc-input :inline)
(input-b generic-merc-input :inline)
+1 -2
View File
@@ -42,8 +42,7 @@
(mat-slot uint8 10) ;; which matrices to upload where for this fragment
))
;; A MERC VU fragment. rest marks the start of variable packed data that continues beyond the
;; nominal 24-byte type; header.mm-quadword-size gives the complete allocation size.
;; A MERC VU fragment.
(deftype merc-fragment (structure)
((header merc-byte-header :inline)
(rest uint8 1))
+1 -6
View File
@@ -52,12 +52,7 @@
;; One level's authored tables, time-of-day schedules, and evaluated outputs.
;; times holds eight floating-point palette weights in the w lanes. Its xyz
;; lanes stay at 1 so update-mood-itimes can multiply them by w, producing four
;; identical lanes per weight. VFTOI12 followed by a six-bit shift converts
;; each weight to signed fixed point with six fractional bits; ppach packs each
;; pair of replicated weights into one of the four itimes quadwords. Tfragment
;; and palette interpolation code can then apply the eight weights four color
;; channels at a time. sky-times is the unconverted counterpart used when
;; compositing sky textures.
;; identical lanes per weight.
;;
;; state is level-specific animation storage overlaid with flames-state,
;; lightning-state, lava-state, and the other mood effect types.
@@ -3,7 +3,7 @@
(bundles "ENGINE.CGO" "GAME.CGO")
(require "kernel-defs.gc")
;; The clock evaluates each active level's mood, blends the two level results,
;; The process evaluates each active level's mood, blends the two level results,
;; and exposes the resulting lighting state to the renderers.
(declare-type time-of-day-proc process)
@@ -72,8 +72,7 @@
;; Palette interpolation rounds height up to 32 colors. Its final 1024-byte
;; input DMA can therefore read as many as 31 colors beyond the nominal object,
;; and it writes the same complete block to a generously sized work buffer.
;; Resource storage after the object must remain accessible; consumers ignore
;; the generated colors beyond height.
;; Resource storage after the object must remain accessible.
(deftype time-of-day-palette (basic)
((width int32)
(height int32)
+4 -7
View File
@@ -30,8 +30,7 @@
;; and a fine near grid displaced by the animated wave field. It does not draw
;; the river in Forbidden Jungle or the pond beside the farmer.
;; Every table in an ocean-map is addressed through one subdivision of the map, so the sizes
;; below are all consequences of these four steps:
;; Ocean map cell sizes:
;;
;; coarse block (meters 768) 6x6 blocks cover the map, one visibility sphere each
;; mid cell (meters 96) 8x8 cells per block, 48x48 over the map
@@ -39,12 +38,10 @@
;; near cell (meters 3) 8x8 near cells per subcell, so 32x32 per mid cell
;;
;; The wave field is 32x32 samples spaced (meters 3) apart, which makes its period exactly one
;; mid cell: the near cells of a mid cell line up with the field one for one, and any world
;; position folds into it with a mask instead of a modulo. ocean-mid-mask is reused at two of
;; these levels, once for the 8x8 mid cells under a coarse block and once for the 8x8 near
;; cells under a transition subcell.
;; mid cell: the near cells of a mid cell line up with the field one for one. This makes
;; it possible to index by cell with masking.
;;
;; The map therefore spans (meters 4608) on a side and is placed by start-corner.
;; The map spans (meters 4608) on a side and is placed by start-corner.
;; Value space of *ocean-facing*: which cardinal direction the camera looks along, taken from
;; the dominant axis of its forward vector. draw-ocean-far uses it to leave out the far strip
@@ -13,7 +13,7 @@
;;
;; Nothing here is computed at load time, and none of it changes while a level is running. The
;; only field of ocean-map the engine writes is start-corner y, which draw-ocean moves to sink
;; the water plane near the swamp marker and during movies.
;; the water plane.
;; og:ignore-from-loc
@@ -50,15 +50,15 @@
(defmethod clear-offset-bit ((this shadow-control))
"Clear the disable-draw flag."
(set! (-> this settings center w)
(the-as float (logand (lognot #x20) (the-as int (-> this settings center w)))))
0)
(logclear! (-> this settings flags) (shadow-flags disable-draw))
0
)
(defmethod set-offset-bit ((this shadow-control))
"Set the disable-draw flag."
(set! (-> this settings center w)
(the-as float (logior (the-as int (-> this settings center w)) #x20)))
0)
(logior! (-> this settings flags) (shadow-flags disable-draw))
0
)
(defmethod set-bottom-plane-offset ((this shadow-control) (y float))
"Set the horizontal bottom clipping plane to the given Y coordinate."
@@ -142,8 +142,7 @@
;; One triangle, three vertex indices into the mesh's vertex table. faces is spare space in the
;; packed data that the CPU classifier writes its answer into: for a single-sided mesh a one means the
;; face turns toward the light and belongs on the cap list, and for a double-sided mesh it means the
;; authored winding already faces the light and does not have to be reversed. It ships as zero and the
;; classifier only ever writes a one, so the edge passes can read it back as a plain flag.
;; authored winding already faces the light and does not have to be reversed.
(deftype shadow-tri (structure)
((ind-0 uint8)
(ind-1 uint8)
@@ -162,8 +161,8 @@
;; The packed shadow mesh. Every offset is measured from this header, and the whole block including the
;; header is qwc-data quadwords long -- the DMA tag that fetches it uses that count directly.
;;
;; Vertices come in two runs: num-verts - num-twos of them name a single joint, and the last num-twos
;; name two joints and carry a blend weight, so skinning is two loops rather than a test per vertex.
;; Vertices come in two runs: (num-verts - num-twos) of them name a single joint, and the last num-twos
;; name two joints and carry a blend weight.
;; Triangles and edges are likewise split into single-sided and double-sided runs, which is the
;; distinction that decides whether a face can be rejected for facing away from the light at all.
(deftype shadow-header (structure)
@@ -4,8 +4,7 @@
(require "kernel-defs.gc")
;; VU1 data memory for the shadow renderer. The EE packet builders unpack straight into these
;; addresses and the microprogram reads them off vi00, so both sides have to agree; that is why the
;; map lives in the header rather than in either implementation.
;; addresses and the microprogram reads them off vi00, so both sides have to agree.
;;
;; 0 .. 3 the camera's perspective matrix, one row per quadword
;; 4 .. 173 the caster's skinned vertices
+13 -3
View File
@@ -22,16 +22,26 @@
:bitfield #f
(tfrag 0) ;; background
(pris 1) ;; foreground
(shrub 2) ;; shrubs/sprites
(shrub 2) ;; shrubs
(alpha 3) ;; effects
(water 4) ;; non-ocean water (fj rivers, water near farmer)
)
(defenum texture-enable-mask
:bitfield #t
:type int32
(tfrag-tie 0)
(pris 1)
(shrub 2)
(alpha 3)
(water 4)
)
;; bitmask for enabled tpage-kinds (changed in debug menu)
(define *texture-enable-user-menu* #x1f)
(define *texture-enable-user-menu* (texture-enable-mask tfrag-tie pris shrub alpha water))
;; enabled textures (drawable.gc updates this from reading *texture-enable-user-menu*)
(define *texture-enable-user* 0)
(define *texture-enable-user* (texture-enable-mask))
;; Any individual texture can be uniquely identified with a texture-id.
(deftype texture-id (uint32)
+18 -10
View File
@@ -95,10 +95,15 @@
;; texture-page = file on DVD containing a bunch of textures.
;; they are designed so that you upload the TFRAG page, do TFRAG rendering,
;; upload the PRIS page, do PRIS rendering, etc.
;; However, layouts are done in a clever way allowing some uploads to be skipped sometimes,
;; and allowing some textures to remain only in VRAM and never need upload.
;; Textures are never moved in memory: meshes therefore can calculate texture addresses once
;; at initialization and never update them.
;; they also contain records of textures. The texture system will update these records
;; texture-pages also contain records of textures. The texture system will update these records
;; to reflect where the textures are actually placed in VRAM.
;; However, it is possible that multiple texture are assigned to the same destination.
;; However, it is possible that multiple texture are assigned to the same destination and
;; texture will upload the correct texture at the correct time.
;; You can check for this by looking at the texture-pool ids.
;; Or, use the upload-vram-pages function which will add uploads to a DMA chain only if needed.
@@ -154,8 +159,9 @@
(else 32)))
(defun texture-qwc ((width int) (height int) (texture-format gs-psm))
"Get the number of quadwords in a texture. Round up."
(let ((bits-per-pixel (texture-bpp texture-format))) (sar (+ (* (* width height) bits-per-pixel) 127) 7)))
"Return the quadword count needed for an image of the given dimensions and format, rounded up."
(let ((bits-per-pixel (texture-bpp texture-format)))
(/ (+ (* (* width height) bits-per-pixel) 127) 128)))
(defun physical-address ((address pointer))
"Convert a pointer to a physical address than can be used for DMA"
@@ -630,8 +636,10 @@
(initialize! (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(defmethod allocate-vram-words! ((this texture-pool) (word-count int))
"Allocate words in vram. Returns the index of the first word."
(let ((start (-> this cur))) (set! (-> this cur) (+ (-> this cur) word-count)) start))
"Reserve consecutive VRAM words and return the first word index."
(let ((start (-> this cur)))
(+! (-> this cur) word-count)
start))
;; boot common textures are "common" textures that are loaded at boot, but will live in RAM
;; and be uploaded to VRAM as needed.
@@ -687,7 +695,6 @@
;; reset allocator
(set! (-> this cur) 0)
;; top is the pool's base (lowest address); allocations grow upward from it.
;; The name comes from the visual orientation of VRAM rather than address order.
(set! (-> this top) (-> this cur))
;; by default, use the default allocator.
(set! (-> this allocate-func) texture-page-default-allocate)
@@ -1424,7 +1431,8 @@
(none))
(defmethod upload-one-common! ((this texture-pool) (lev level))
"Upload the first common texture page that's in in the common-page-mask."
"Upload the first common texture page that's in in the common-page-mask.
Users of common textures should call this to ensure their texture is loaded."
(dotimes (i 32)
(let ((page (-> this common-page i)))
(when (and (nonzero? page) ;; known common texture page
@@ -2272,7 +2280,7 @@
"Initialize a simple clamped texture shader, optionally filling its texture registers."
(set! (-> shader tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
(set! (-> shader tex0 tfx) 0)
#|
(set!
(-> shader tex0)
(the-as
@@ -2280,7 +2288,7 @@
(logand (the-as uint (-> shader tex0)) (the-as uint #xffffffe7ffffffff))
)
)
|#
(if tex (adgif-shader<-texture! shader tex))
(set! (-> shader clamp) (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
(set! (-> shader alpha) (new 'static 'gs-alpha :b #x1 :d #x1))
+6 -29
View File
@@ -70,14 +70,7 @@
;; is fixed point, and d0 and d1 are the vertex's output slots -- which is how the render pipeline avoids
;; keeping a write cursor at all.
;;
;; This describes the compact block tie-fragment.generic-ref points at, the converter's own copy of the
;; geometry, which is separate data from the V4-16 point stream at point-ref that TIE's VU1 program
;; unpacks. The two look like the same layout: sixteen bytes is exactly the two quadwords TIE expands a
;; base point into, and d0 and d1 sit in the lanes TIE uses as output slots. But nothing in the source
;; declares a type for TIE's stream, so that correspondence is observed rather than stated.
;;
;; The overlays exist because the converter moves these around by quadword and by doubleword rather than
;; field by field.
;; This describes the compact block tie-fragment.generic-ref points at.
(deftype generic-tie-base-point (structure)
((x int16)
(y int16)
@@ -103,27 +96,12 @@
;; scales the displacement by the instance's morph weight and adds it. At full collapse the surface is
;; exactly the next-coarser tessellation, so the triangles that disappear are degenerate by then rather
;; than popping. The color side of the same blend always uses a plain 50/50 average of the edge's two
;; endpoints, so the intended collapse target is the edge midpoint -- though only the color is pinned
;; there, the displacement being authored data.
;; endpoints, so the intended collapse target is the edge midpoint.
;;
;; d0 is the output slot, the unused lane sits where the loop reads only xyz, and d1 is the second slot.
;;
;; Which of the two vectors is which is genuinely unsettled, and the names do not settle it. In TIE's own
;; stream the first vector is demonstrably the displacement: the render loop scales it by the morph weight
;; and adds the second, and the coarsest geometry uses far-morph, whose x is 1, alongside a fully averaged
;; color -- so weight 1 is the collapsed end and weight 0, full detail, leaves only the second vector.
;; Read against that, x/y/z and dx/dy/dz are the wrong way round.
;;
;; The Generic converter agrees about the operation and adds nothing about the naming. It stages the two
;; vectors in declaration order into a VU0 pair, its transform computes first * morph.x + second, and it
;; has a second entry -- taken once the weight reaches zero -- which reads only the second vector. So both
;; consumers of this type treat the first vector as the one that is scaled; which end of the LOD band that
;; corresponds to is a fact about the instance pass, not about either of them.
;;
;; These are real field names out of the game's own type information, not something reconstructed, so
;; they stay exactly as they are. Either they are simply backwards -- which happens -- or this type was
;; written for the Generic converter alone and its block orders the two vectors the other way. Nothing
;; here decides between those, and there is no separate type for TIE's stream to compare against.
;; The naming here between xyz and dx,dy,dz seem backward. It's backward in generic and VU1 TIE paths,
;; so probably this type was just named wrong.
(deftype generic-tie-interp-point (structure)
((x int16) ;; the vector that gets scaled by the morph weight
(y int16)
@@ -184,7 +162,7 @@
(morph vector :inline)
(fog qword :inline)))
;; One packed vertex normal. Four bytes, so a normal costs as much as a palette index.
;; One packed vertex normal.
(deftype generic-tie-normal (structure)
((x int8)
(y int8)
@@ -192,8 +170,7 @@
(dummy int8)))
;; The converter's cursor block: where it is in every one of the parallel streams that make up a
;; fragment. Advancing a fragment means advancing all of these together, which is why they live in one
;; structure rather than in registers.
;; fragment.
(deftype generic-tie-control (structure)
((ptr-palette uint32)
(ptr-shaders uint32)
+4 -3
View File
@@ -4,7 +4,8 @@
(require "kernel-defs.gc")
;; Per-renderer enables for the VU1 drawing pass. The debug menu edits the menu mask, which is
;; copied to the active mask at the start of each frame.
;; copied to the active mask at the start of each frame to avoid switching on/off renderers
;; in the middle of the frame, which could skip set-up or cleanup code.
(defenum vu1-renderer-mask
:bitfield #t
@@ -58,6 +59,7 @@
(define *vu1-enable-user* (the-as vu1-renderer-mask 0))
;; A DMA sink identifies the bucket and texture-page context used by a foreground renderer.
;; the page/level/bucket indices are into the level's bucket arrays, not absolute bucket indices.
(deftype dma-foreground-sink (basic)
((bucket bucket-id)
(foreground-texture-page int8)
@@ -74,10 +76,9 @@
(deftype generic-dma-foreground-sink (dma-foreground-sink)
((state generic-bucket-state :inline)))
;; Three foreground sink references share one array. The named aliases select the merc slot at
;; index zero and the generic slot at index one without storing duplicate references.
(declare-type level basic)
;; DMA sinks for a level's foreground rendering, divided by renderer.
(deftype dma-foreground-sink-group (basic)
((sink dma-foreground-sink 3)
(merc-sink dma-foreground-sink :overlay-at (-> sink 0))
+5 -1
View File
@@ -214,6 +214,11 @@
(debug-print-splitbox (_type_ vector string) none)
(art-group-get-by-name (_type_ string) art-group)))
;; Array of levels and manager of level loading.
;; There's 2 normal gameplay levels and a "deafult level"
;; which handles things that don't belong to a gameplay level,
;; like Jak's model. The "default level" doesn't have an
;; associated BSP and is mostly used for renderer book-keeping.
(deftype level-group (basic)
((length int32)
(log-in-level-bsp bsp-header)
@@ -256,7 +261,6 @@
;; Initialize the level structure. This assigns DMA buckets to each level.
;; there are 3 foreground sinks per texture bucket: merc, generic, and an unused one.
;; TODO: figure out exactly which buckets are used for what.
(define-extern *level* level-group)
(if (zero? *level*)
+1 -1
View File
@@ -59,7 +59,7 @@
(length stream)))
destination)
;; A common file header found in GOAL files.
;; A common file header found in data files.
(deftype file-info (basic)
((file-type symbol)
(file-name basic)
+320 -480
View File
@@ -38,6 +38,10 @@
(defconstant TWO_PI (the-as float #x40c90fda))
(defmacro unwrap-angle (angle)
`(the float (sar (shl (the int ,angle) 48) 48))
)
;; DECOMP BEGINS
(defun radmod ((angle float))
@@ -71,17 +75,19 @@
(the float (sar target-int 48))))
(defun deg-seek-smooth ((in float) (target float) (max-diff float) (amount float))
"Move amount of the shortest wrapped difference toward target, capped by max-diff."
"Move a fraction toward a rotation-unit target, capped by max-diff."
(let ((step (* (deg- target in) amount)))
(if (< max-diff (fabs step)) (set! step (if (>= step 0.0) max-diff (- max-diff))))
(if (< max-diff (fabs step))
(set! step (if (>= step 0.0) max-diff (- max-diff))))
(+ in step)))
(defun deg-lerp-clamp ((min-val float) (max-val float) (in float))
"Interpolate along the shortest wrapped rotation-unit arc, clamping in to the endpoints."
"Interpolate along the shortest wrapped rotation-unit arc with a clamped amount."
(cond
((>= 0.00000000 in) min-val)
((>= in 1.00000000) max-val)
(else (the float (sar (shl (the int (+ min-val (* in (deg-diff min-val max-val)))) 48) 48)))))
((>= 0.0 in) min-val)
((>= in 1.0) max-val)
(else
(unwrap-angle (+ min-val (* in (deg-diff min-val max-val)))))))
;; create a static array with the given values, interpreted as floats.
(defmacro make-float-table (name size vals)
@@ -89,428 +95,262 @@
;; table[x] = 1/(2^x)
;; unused?
(make-float-table binary-table
32
(#x3f800000 ;; 1.0
#x3f000000 ;; 0.5
#x3e800000 ;; 0.25
#x3e000000 ;; ...
#x3d800000
#x3d000000
#x3c800000
#x3c000000
#x3b800000
#x3b000000
#x3a800000
#x3a000000
#x39800000
#x39000000
#x38800000
#x38000000
#x37800000
#x37000000
#x36800000
#x36000000
#x35800000
#x35000000
#x34800000
#x34000000
#x33800000
#x33000000
#x32800000
#x32000000
#x31800000
#x31000000
#x30800000
#x30000000))
(define binary-table
(new 'static
'boxed-array
:type
float
1.0
0.5
0.25
0.125
0.0625
0.03125
0.015625
0.0078125
0.00390625
0.001953125
0.0009765625
0.00048828125
0.00024414062
0.00012207031
0.000061035156
0.000030517578
0.000015258789
0.0000076293945
0.0000038146973
0.0000019073486
0.0000009536743
0.00000047683716
0.00000023841858
0.00000011920929
0.000000059604645
0.000000029802322
0.000000014901161
0.000000007450581
0.0000000037252903
0.0000000018626451
0.0000000009313226
0.0000000004656613))
;; CORDIC angle table: sincos-table[i] = atan(2^-i) radians. From entry 12 onward,
;; atan(x) rounds to x in single precision, so the tail matches binary-table. The shipping
;; trigonometric routines use polynomials instead; both tables are retained dead data from
;; an earlier shift-and-add implementation.
(make-float-table sincos-table
32
(#x3f490fdb
#x3eed6338
#x3e7adbb0
#x3dfeadd5
#x3d7faade
#x3cffeaae
#x3c7ffaab
#x3bfffeab
#x3b7fffab
#x3affffeb
#x3a7ffffb
#x39fffffe
#x39800000
#x39000000
#x38800000
#x38000000
#x37800000
#x37000000
#x36800000
#x36000000
#x35800000
#x35000000
#x34800000
#x34000000
#x33800000
#x33000000
#x32800000
#x32000000
#x31800000
#x31000000
#x30800000
#x30000000))
;; CORDIC angle table: sincos-table[i] = atan(2^-i) radians.
;; Unused, actual sine/cosines all use polynomials instead of CORDIC.
(define sincos-table
(new 'static
'boxed-array
:type
float
0.7853982
0.4636476
0.24497867
0.124354996
0.06241881
0.031239834
0.015623729
0.007812341
0.0039062302
0.0019531226
0.0009765622
0.0004882812
0.00024414062
0.00012207031
0.000061035156
0.000030517578
0.000015258789
0.0000076293945
0.0000038146973
0.0000019073486
0.0000009536743
0.00000047683716
0.00000023841858
0.00000011920929
0.000000059604645
0.000000029802322
0.000000014901161
0.000000007450581
0.0000000037252903
0.0000000018626451
0.0000000009313226
0.0000000004656613))
(defun sin ((angle float))
"Return sine for an angle in rotation units after wrapping it to a signed half-turn."
;; Sign-extend the low 16 bits, then convert rotation units to radians before evaluating
;; the degree-nine odd minimax polynomial.
(let ((f2-0 (* 0.000095873795 (the float (sar (shl (the int angle) 48) 48)))))
(let ((f0-1 f2-0)))
(let* ((f1-4 (* 0.999998 f2-0))
(f0-3 (* f2-0 f2-0))
(f2-1 (* f2-0 f0-3))
(f1-5 (+ f1-4 (* -0.16666014 f2-1)))
(f2-2 (* f2-1 f0-3))
(f1-6 (+ f1-5 (* 0.008326521 f2-2)))
(f2-3 (* f2-2 f0-3))
(f1-7 (+ f1-6 (* -0.0001956241 f2-3)))
(f0-4 (* f2-3 f0-3)))
(+ f1-7 (* 0.0000023042373 f0-4)))))
;; 9-th degree polynomial
(let ((x (* 0.000095873795 (unwrap-angle angle))))
x
(let* ((y1 (* 0.999998 x))
(x2 (square x))
(x3 (* x x2))
(y3 (+ y1 (* -0.16666014 x3)))
(x5 (* x3 x2))
(y5 (+ y3 (* 0.008326521 x5)))
(x7 (* x5 x2))
(y7 (+ y5 (* -0.0001956241 x7)))
(x9 (* x7 x2)))
(+ y7 (* 0.0000023042373 x9)))))
(defun sin-rad ((angle float))
"Return sine for a radian angle in the supported -pi to pi interval with a degree-nine odd minimax polynomial."
(local-vars
(f1-0 float)
(f2-0 float)
(f3-0 float)
(f4-0 float)
(f5-0 float)
(f6-0 float)
(f7-0 float)
(f8-0 float)
(f9-0 float)
(f10-0 float)
(f11-0 float)
(result float)
(acc float))
(set! f1-0 (* angle angle))
(set! f7-0 (the-as float #x3f7fffde))
(set! f8-0 (the-as float #xbe2aa8f5))
(set! f2-0 (* angle f1-0))
(set! f3-0 (* f1-0 f1-0))
(set! f9-0 (the-as float #x3c086bf6))
(set! f4-0 (* f2-0 f1-0))
(set! f5-0 (* f3-0 f2-0))
(set! f10-0 (the-as float #xb94d2072))
(set! f6-0 (* f4-0 f3-0))
(set! f11-0 (the-as float #x361aa27f))
(#unless PC_PORT
(mula.s angle f7-0)
(madda.s f2-0 f8-0)
(madda.s f4-0 f9-0)
(madda.s f5-0 f10-0)
(madd.s result f6-0 f11-0))
(#when PC_PORT
(set! acc (* angle f7-0))
(set! acc (+ acc (* f2-0 f8-0)))
(set! acc (+ acc (* f4-0 f9-0)))
(set! acc (+ acc (* f5-0 f10-0)))
(set! result (+ acc (* f6-0 f11-0))))
result)
(defun sin-rad ((x float))
"Return sine for a radian angle in the supported interval with a degree-nine odd minimax polynomial."
(let* ((x2 (square x))
(c1 0.999998)
(c3 -0.16666014)
(x3 (* x x2))
(x4 (square x2))
(c5 0.008326521)
(x5 (* x3 x2))
(x7 (* x4 x3))
(c7 -0.0001956241)
(x9 (* x5 x4))
(c9 0.0000023042373))
(+ (* x c1)
(* x3 c3)
(* x5 c5)
(* x7 c7)
(* x9 c9))
;; (.mula.s x c1)
;; (.madda.s x3 c3)
;; (.madda.s x5 c5)
;; (.madda.s x7 c7)
;; (.madd.s result x9 c9)
))
;; Minimax coefficients for the odd sine approximation.
(define *sin-poly-vec*
(new 'static
'vector
:x
(the-as float #xbe2aa8f5) ;; -1/3!
:y
(the-as float #x3c086bf6) ;; 1/5!
:z
(the-as float #xb94d2072) ;; -1/7!
:w
(the-as float #x361aa27f) ;; approximately 1/9!
))
(define *sin-poly-vec* (new 'static 'vector :x -0.16666014 :y 0.008326521 :z -0.0001956241 :w 0.0000023042373))
(define *sin-poly-vec2* (new 'static 'vector :x 0.999998))
;;
(define *sin-poly-vec2* (new 'static 'vector :x (the-as float #x3f7fffde) :y 0.0 :z 0.0 :w 0.0))
(#unless PC_PORT
(defun vector-sin-rad! ((dst vector) (src vector))
"Compute per-lane sine for radian inputs in the supported -pi to pi interval.
The degree-nine odd polynomial uses minimax-adjusted coefficients near the Taylor values."
(rlet ((input :class vf)
(result :class vf)
(input-squared :class vf)
(input-cubed :class vf)
(input-fourth :class vf)
(input-fifth :class vf)
(input-seventh :class vf)
(input-ninth :class vf)
(coefficients :class vf)
(linear-coefficient :class vf)
(coefficient-address)
(acc :class vf))
(.lvf input src)
(.mul.vf input-squared input input)
(m! coefficient-address *sin-poly-vec2*)
(.lvf linear-coefficient coefficient-address)
(m! coefficient-address *sin-poly-vec*)
(.lvf coefficients coefficient-address)
(.mul.vf input-cubed input-squared input)
(.mul.vf input-fourth input-squared input-squared)
(.mul.x.vf acc input linear-coefficient)
(.mul.vf input-fifth input-cubed input-squared)
(.mul.vf input-seventh input-fourth input-cubed)
(.add.mul.x.vf acc input-cubed coefficients acc)
(.mul.vf input-ninth input-fifth input-fourth)
(.add.mul.y.vf acc input-fifth coefficients acc)
(.add.mul.z.vf acc input-seventh coefficients acc)
(.add.mul.w.vf result input-ninth coefficients acc)
(.svf dst result)
dst)))
(defun vector-sin-rad! ((dst vector) (src vector))
"Compute per-lane sine for radian inputs in the supported -pi to pi interval.
The degree-nine odd polynomial uses minimax-adjusted coefficients near the Taylor values."
(rlet ((input :class vf)
(result :class vf)
(input-squared :class vf)
(input-cubed :class vf)
(input-fourth :class vf)
(input-fifth :class vf)
(input-seventh :class vf)
(input-ninth :class vf)
(coefficients :class vf)
(linear-coefficient :class vf)
(acc :class vf))
(.lvf input src)
(.mul.vf input-squared input input)
(.lvf linear-coefficient *sin-poly-vec2*)
(.lvf coefficients *sin-poly-vec*)
(.mul.vf input-cubed input-squared input)
(.mul.vf input-fourth input-squared input-squared)
(.mul.x.vf acc input linear-coefficient)
(.mul.vf input-fifth input-cubed input-squared)
(.mul.vf input-seventh input-fourth input-cubed)
(.add.mul.x.vf acc input-cubed coefficients acc)
(.mul.vf input-ninth input-fifth input-fourth)
(.add.mul.y.vf acc input-fifth coefficients acc)
(.add.mul.z.vf acc input-seventh coefficients acc)
(.add.mul.w.vf result input-ninth coefficients acc)
(.svf dst result)
dst))
(#when PC_PORT
(defun vector-sin-rad! ((dst vector) (src vector))
"Compute per-lane sine for radian inputs in the supported -pi to pi interval.
The degree-nine odd polynomial uses minimax-adjusted coefficients near the Taylor values."
(rlet ((input :class vf)
(result :class vf)
(input-squared :class vf)
(input-cubed :class vf)
(input-fourth :class vf)
(input-fifth :class vf)
(input-seventh :class vf)
(input-ninth :class vf)
(coefficients :class vf)
(linear-coefficient :class vf)
(acc :class vf))
(.lvf input src)
(.mul.vf input-squared input input)
(.lvf linear-coefficient *sin-poly-vec2*)
(.lvf coefficients *sin-poly-vec*)
(.mul.vf input-cubed input-squared input)
(.mul.vf input-fourth input-squared input-squared)
(.mul.x.vf acc input linear-coefficient)
(.mul.vf input-fifth input-cubed input-squared)
(.mul.vf input-seventh input-fourth input-cubed)
(.add.mul.x.vf acc input-cubed coefficients acc)
(.mul.vf input-ninth input-fifth input-fourth)
(.add.mul.y.vf acc input-fifth coefficients acc)
(.add.mul.z.vf acc input-seventh coefficients acc)
(.add.mul.w.vf result input-ninth coefficients acc)
(.svf dst result)
dst)))
(defun cos-rad ((x float))
"Return cosine for a radian angle in the supported interval with a degree-eight even minimax polynomial."
(let* ((x2 (square x))
(c0 1.0)
(c2 -0.49998003)
(x4 (square x2))
(c4 0.041620404)
(c6 -0.0013636408)
(x6 (* x4 x2))
(x8 (square x4))
(c8 0.000020170546))
(+ c0
(* x2 c2)
(* x4 c4)
(* x6 c6)
(* x8 c8))
;; (.mula.s c0 c0)
;; (.madda.s c2 x2)
;; (.madda.s c4 x4)
;; (.madda.s c6 x6)
;; (.madd.s result c8 x8)
))
(defun cos-rad ((angle float))
"Return cosine for a radian angle in the supported -pi to pi interval with a degree-eight even minimax polynomial."
(local-vars
(f1-0 float)
(f3-0 float)
(f4-0 float)
(f5-0 float)
(f7-0 float)
(f8-0 float)
(f9-0 float)
(f10-0 float)
(f11-0 float)
(result float)
(acc float))
(set! f1-0 (* angle angle))
(set! f7-0 1.000000)
(set! f8-0 (the-as float #xbefffd62))
(set! f3-0 (* f1-0 f1-0))
(set! f9-0 (the-as float #x3d2a7a28))
(set! f10-0 (the-as float #xbab2bc31))
(set! f4-0 (* f3-0 f1-0))
(set! f5-0 (* f3-0 f3-0))
(set! f11-0 (the-as float #x37a933eb))
(#unless PC_PORT
(mula.s f7-0 f7-0)
(madda.s f8-0 f1-0)
(madda.s f9-0 f3-0)
(madda.s f10-0 f4-0)
(madd.s result f11-0 f5-0))
(#when PC_PORT
(set! acc (* f7-0 f7-0))
(set! acc (+ acc (* f8-0 f1-0)))
(set! acc (+ acc (* f9-0 f3-0)))
(set! acc (+ acc (* f10-0 f4-0)))
(set! result (+ acc (* f11-0 f5-0))))
result)
(define *cos-poly-vec* (new 'static 'vector :x -0.49998003 :y 0.041620404 :z -0.0013636408 :w 0.000020170546))
(define *cos-poly-vec*
(new 'static
'vector
:x
(the-as float #xbefffd62)
:y
(the-as float #x3d2a7a28)
:z
(the-as float #xbab2bc31)
:w
(the-as float #x37a933eb)))
(defun vector-cos-rad! ((dst vector) (src vector))
"Compute per-lane cosine for radian inputs in the supported -pi to pi interval."
(rlet ((vf0 :class vf)
(input :class vf)
(result :class vf)
(input-squared :class vf)
(input-fourth :class vf)
(input-sixth :class vf)
(input-eighth :class vf)
(coefficients :class vf)
(acc :class vf))
(init-vf0-vector)
(.lvf input src)
;; Subtracting an uninitialized host SIMD register from itself can propagate NaNs.
;; (.sub.vf result result result)
(.xor.vf result result result) ;; og:preserve
(.lvf coefficients *cos-poly-vec*)
(.mul.vf input-squared input input)
(.add.w.vf acc result vf0)
(.mul.vf input-fourth input-squared input-squared)
(.add.mul.x.vf acc input-squared coefficients acc)
(.mul.vf input-sixth input-fourth input-squared)
(.add.mul.y.vf acc input-fourth coefficients acc)
(.mul.vf input-eighth input-fourth input-fourth)
(.add.mul.z.vf acc input-sixth coefficients acc)
(.add.mul.w.vf result input-eighth coefficients acc)
(.svf dst result)
dst))
(#unless PC_PORT
(defun vector-cos-rad! ((dst vector) (src vector))
"Compute per-lane cosine for radian inputs in the supported -pi to pi interval."
(rlet ((vf0 :reg vf0)
(input :class vf)
(result :class vf)
(input-squared :class vf)
(input-fourth :class vf)
(input-sixth :class vf)
(input-eighth :class vf)
(coefficients :class vf)
(coefficient-address)
(acc :class vf))
(.lvf input src)
;; The original VU register is deliberately cleared by subtracting it from itself.
(.sub.vf result result result)
(m! coefficient-address *cos-poly-vec*)
(.lvf coefficients coefficient-address)
(.mul.vf input-squared input input)
(.add.w.vf acc result vf0)
(.mul.vf input-fourth input-squared input-squared)
(.add.mul.x.vf acc input-squared coefficients acc)
(.mul.vf input-sixth input-fourth input-squared)
(.add.mul.y.vf acc input-fourth coefficients acc)
(.mul.vf input-eighth input-fourth input-fourth)
(.add.mul.z.vf acc input-sixth coefficients acc)
(.add.mul.w.vf result input-eighth coefficients acc)
(.svf dst result)
dst)))
(#when PC_PORT
(defun vector-cos-rad! ((dst vector) (src vector))
"Compute per-lane cosine for radian inputs in the supported -pi to pi interval."
(rlet ((vf0 :class vf)
(input :class vf)
(result :class vf)
(input-squared :class vf)
(input-fourth :class vf)
(input-sixth :class vf)
(input-eighth :class vf)
(coefficients :class vf)
(acc :class vf))
(init-vf0-vector)
(.lvf input src)
;; Subtracting an uninitialized host SIMD register from itself can propagate NaNs.
(.xor.vf result result result) ;; og:preserve
(.lvf coefficients *cos-poly-vec*)
(.mul.vf input-squared input input)
(.add.w.vf acc result vf0)
(.mul.vf input-fourth input-squared input-squared)
(.add.mul.x.vf acc input-squared coefficients acc)
(.mul.vf input-sixth input-fourth input-squared)
(.add.mul.y.vf acc input-fourth coefficients acc)
(.mul.vf input-eighth input-fourth input-fourth)
(.add.mul.z.vf acc input-sixth coefficients acc)
(.add.mul.w.vf result input-eighth coefficients acc)
(.svf dst result)
dst)))
(#unless PC_PORT
(defun vector-sincos-rad! ((dst-sin vector) (dst-cos vector) (src vector))
"Compute per-lane sine and cosine for radian inputs in the supported -pi to pi interval."
(rlet ((vf0 :reg vf0)
(input :class vf)
(input-squared :class vf)
(input-cubed :class vf)
(input-fourth :class vf)
(input-fifth :class vf)
(input-sixth :class vf)
(input-seventh :class vf)
(input-eighth :class vf)
(input-ninth :class vf)
(sin-coefficients :class vf)
(sin-linear-coefficient :class vf)
(sin-result :class vf)
(cos-coefficients :class vf)
(cos-result :class vf)
(coefficient-address)
(acc :class vf))
(.lvf input src)
;; The original VU register is deliberately cleared by subtracting it from itself.
(.sub.vf cos-result cos-result cos-result)
(m! coefficient-address *sin-poly-vec2*)
(.lvf sin-linear-coefficient coefficient-address)
(.mul.vf input-squared input input)
(m! coefficient-address *sin-poly-vec*)
(.lvf sin-coefficients coefficient-address)
(m! coefficient-address *cos-poly-vec*)
(.lvf cos-coefficients coefficient-address)
(.mul.x.vf acc input sin-linear-coefficient)
(.mul.vf input-cubed input-squared input)
(.mul.vf input-fourth input-squared input-squared)
(.mul.vf input-fifth input-cubed input-squared)
(.mul.vf input-sixth input-cubed input-cubed)
(.mul.vf input-seventh input-fourth input-cubed)
(.mul.vf input-eighth input-fourth input-fourth)
(.mul.vf input-ninth input-fifth input-fourth)
(.add.mul.x.vf acc input-cubed sin-coefficients acc)
(.add.mul.y.vf acc input-fifth sin-coefficients acc)
(.add.mul.z.vf acc input-seventh sin-coefficients acc)
(.add.mul.w.vf sin-result input-ninth sin-coefficients acc)
(.add.w.vf acc cos-result vf0)
(.add.mul.x.vf acc input-squared cos-coefficients acc)
(.add.mul.y.vf acc input-fourth cos-coefficients acc)
(.add.mul.z.vf acc input-sixth cos-coefficients acc)
(.add.mul.w.vf cos-result input-eighth cos-coefficients acc)
(.svf dst-sin sin-result)
(.svf dst-cos cos-result)
0)))
(#when PC_PORT
(defun vector-sincos-rad! ((dst-sin vector) (dst-cos vector) (src vector))
"Compute per-lane sine and cosine for radian inputs in the supported -pi to pi interval."
(rlet ((vf0 :class vf)
(input :class vf)
(input-squared :class vf)
(input-cubed :class vf)
(input-fourth :class vf)
(input-fifth :class vf)
(input-sixth :class vf)
(input-seventh :class vf)
(input-eighth :class vf)
(input-ninth :class vf)
(sin-coefficients :class vf)
(sin-linear-coefficient :class vf)
(sin-result :class vf)
(cos-coefficients :class vf)
(cos-result :class vf)
(acc :class vf))
(init-vf0-vector)
(.lvf input src)
;; Subtracting an uninitialized host SIMD register from itself can propagate NaNs.
(.xor.vf cos-result cos-result cos-result) ;; og:preserve
(.lvf sin-linear-coefficient *sin-poly-vec2*)
(.mul.vf input-squared input input)
(.lvf sin-coefficients *sin-poly-vec*)
(.lvf cos-coefficients *cos-poly-vec*)
(.mul.x.vf acc input sin-linear-coefficient)
(.mul.vf input-cubed input-squared input)
(.mul.vf input-fourth input-squared input-squared)
(.mul.vf input-fifth input-cubed input-squared)
(.mul.vf input-sixth input-cubed input-cubed)
(.mul.vf input-seventh input-fourth input-cubed)
(.mul.vf input-eighth input-fourth input-fourth)
(.mul.vf input-ninth input-fifth input-fourth)
(.add.mul.x.vf acc input-cubed sin-coefficients acc)
(.add.mul.y.vf acc input-fifth sin-coefficients acc)
(.add.mul.z.vf acc input-seventh sin-coefficients acc)
(.add.mul.w.vf sin-result input-ninth sin-coefficients acc)
(.add.w.vf acc cos-result vf0)
(.add.mul.x.vf acc input-squared cos-coefficients acc)
(.add.mul.y.vf acc input-fourth cos-coefficients acc)
(.add.mul.z.vf acc input-sixth cos-coefficients acc)
(.add.mul.w.vf cos-result input-eighth cos-coefficients acc)
(.svf dst-sin sin-result)
(.svf dst-cos cos-result)
0)))
(defun vector-sincos-rad! ((dst-sin vector) (dst-cos vector) (src vector))
"Compute per-lane sine and cosine for radian inputs in the supported -pi to pi interval."
(rlet ((vf0 :class vf)
(input :class vf)
(input-squared :class vf)
(input-cubed :class vf)
(input-fourth :class vf)
(input-fifth :class vf)
(input-sixth :class vf)
(input-seventh :class vf)
(input-eighth :class vf)
(input-ninth :class vf)
(sin-coefficients :class vf)
(sin-linear-coefficient :class vf)
(sin-result :class vf)
(cos-coefficients :class vf)
(cos-result :class vf)
(acc :class vf))
(init-vf0-vector)
(.lvf input src)
;; Subtracting an uninitialized host SIMD register from itself can propagate NaNs.
;; (.sub.vf cos-result cos-result cos-result)
(.xor.vf cos-result cos-result cos-result) ;; og:preserve
(.lvf sin-linear-coefficient *sin-poly-vec2*)
(.mul.vf input-squared input input)
(.lvf sin-coefficients *sin-poly-vec*)
(.lvf cos-coefficients *cos-poly-vec*)
(.mul.x.vf acc input sin-linear-coefficient)
(.mul.vf input-cubed input-squared input)
(.mul.vf input-fourth input-squared input-squared)
(.mul.vf input-fifth input-cubed input-squared)
(.mul.vf input-sixth input-cubed input-cubed)
(.mul.vf input-seventh input-fourth input-cubed)
(.mul.vf input-eighth input-fourth input-fourth)
(.mul.vf input-ninth input-fifth input-fourth)
(.add.mul.x.vf acc input-cubed sin-coefficients acc)
(.add.mul.y.vf acc input-fifth sin-coefficients acc)
(.add.mul.z.vf acc input-seventh sin-coefficients acc)
(.add.mul.w.vf sin-result input-ninth sin-coefficients acc)
(.add.w.vf acc cos-result vf0)
(.add.mul.x.vf acc input-squared cos-coefficients acc)
(.add.mul.y.vf acc input-fourth cos-coefficients acc)
(.add.mul.z.vf acc input-sixth cos-coefficients acc)
(.add.mul.w.vf cos-result input-eighth cos-coefficients acc)
(.svf dst-sin sin-result)
(.svf dst-cos cos-result)
0))
(defmacro sincos-rad-asm (out x)
"Emit the shared scalar sine/cosine polynomial and store sine followed by cosine."
@@ -892,76 +732,76 @@
'array
float
32
(the-as float #x3f800000)
(the-as float #x3f82cd80)
(the-as float #x3f85aac0)
(the-as float #x3f889800)
(the-as float #x3f8b95c0)
(the-as float #x3f8ea400)
(the-as float #x3f91c3c0)
(the-as float #x3f94f4c0)
(the-as float #x3f9837c0)
(the-as float #x3f9b8d00)
(the-as float #x3f9ef500)
(the-as float #x3fa27040)
(the-as float #x3fa5fec0)
(the-as float #x3fa9a140)
(the-as float #x3fad5800)
(the-as float #x3fb123c0)
(the-as float #x3fb504c0)
(the-as float #x3fb8fb80)
(the-as float #x3fbd0880)
(the-as float #x3fc12c40)
(the-as float #x3fc56700)
(the-as float #x3fc9b980)
(the-as float #x3fce2480)
(the-as float #x3fd2a800)
(the-as float #x3fd744c0)
(the-as float #x3fdbfb80)
(the-as float #x3fe0ccc0)
(the-as float #x3fe5b900)
(the-as float #x3feac0c0)
(the-as float #x3fefe480)
(the-as float #x3ff52540)
(the-as float #x3ffa8380)))
1.0
1.0218964
1.0442734
1.0671387
1.0905075
1.1143799
1.1387863
1.1637192
1.1892014
1.2152405
1.2418518
1.2690506
1.2968369
1.3252335
1.354248
1.3839035
1.4142075
1.4451752
1.4768219
1.5091629
1.5422058
1.5759735
1.6104889
1.645752
1.6817856
1.7186127
1.7562485
1.7947083
1.8340073
1.8741608
1.9151993
1.9571381))
(define exp-strail
(new 'static
'array
float
32
(the-as float #x0)
(the-as float #x35531585)
(the-as float #x34d9f312)
(the-as float #x35e8092e)
(the-as float #x3471f546)
(the-as float #x36e62d17)
(the-as float #x361b9d59)
(the-as float #x36bea3fc)
(the-as float #x36c14637)
(the-as float #x36e6e755)
(the-as float #x36c98247)
(the-as float #x34c0c312)
(the-as float #x36354d8b)
(the-as float #x3655a754)
(the-as float #x36fba90b)
(the-as float #x36d6074b)
(the-as float #x36cccfe7)
(the-as float #x36bd1d8c)
(the-as float #x368e7d60)
(the-as float #x35cca667)
(the-as float #x36a84554)
(the-as float #x36f619b9)
(the-as float #x35c151f8)
(the-as float #x366c8f89)
(the-as float #x36f32b5a)
(the-as float #x36de5f6c)
(the-as float #x36776155)
(the-as float #x355cef90)
(the-as float #x355cfba5)
(the-as float #x36e66f73)
(the-as float #x36f45492)
(the-as float #x36cb6dc9)))
0.0
0.0000007863494
0.00000040596257
0.0000017288019
0.00000022534104
0.0000068597833
0.0000023188388
0.0000056815315
0.0000057600223
0.0000068814647
0.000006005433
0.0000003590472
0.0000027016238
0.000003183687
0.000007500062
0.000006378546
0.000006103877
0.0000056360786
0.0000042465254
0.0000015247614
0.000005014861
0.000007334366
0.0000014403477
0.000003525029
0.000007247011
0.000006627224
0.0000036862523
0.00000082304996
0.0000008232258
0.0000068675085
0.000007281612
0.000006062652))
(defun exp ((value float))
"Approximate e^value with Tang-style range reduction.
@@ -1101,7 +941,7 @@
"Return inverse cosine in rotation units."
(let ((result (- 16384.000000 (asin value))))
(#when PC_PORT
;; Host rounding can produce exact zero here and trigger a punch-animation discontinuity.
;; Host rounding can produce exact zero here and this triggers punch glitch.
;; Keep the PC result positive without changing the global floating-point rounding mode.
(when (= result 0.0)
(set! result 0.00000000001))) ;; og:preserve
+62 -32
View File
@@ -335,14 +335,18 @@
"Move vec toward target in yz by alpha times the error, limiting the step length to max-step."
(let ((y-diff (- (-> target y) (-> vec y)))
(z-diff (- (-> target z) (-> vec z))))
(if (or (!= y-diff 0.0) (!= z-diff 0.0))
(when (or (!= y-diff 0.0) (!= z-diff 0.0))
(let* ((y-step (* y-diff alpha))
(z-step (* z-diff alpha))
(step-len (sqrtf (+ (square y-step) (square z-step)))))
(cond
((>= max-step step-len) (+! (-> vec y) y-step) (+! (-> vec z) z-step))
((>= max-step step-len)
(+! (-> vec y) y-step)
(+! (-> vec z) z-step))
(else
(let ((step-scale (/ max-step step-len))) (+! (-> vec y) (* step-scale y-step)) (+! (-> vec z) (* step-scale z-step))))))))
(let ((step-scale (/ max-step step-len)))
(+! (-> vec y) (* step-scale y-step))
(+! (-> vec z) (* step-scale z-step))))))))
vec)
(defun vector-seek-3d-smooth! ((vec vector) (target vector) (max-step float) (alpha float))
@@ -350,13 +354,16 @@
(let ((x-diff (- (-> target x) (-> vec x)))
(y-diff (- (-> target y) (-> vec y)))
(z-diff (- (-> target z) (-> vec z))))
(if (or (!= x-diff 0.0) (!= y-diff 0.0) (!= z-diff 0.0))
(when (or (!= x-diff 0.0) (!= y-diff 0.0) (!= z-diff 0.0))
(let* ((x-step (* x-diff alpha))
(y-step (* y-diff alpha))
(z-step (* z-diff alpha))
(step-len (sqrtf (+ (+ (square x-step) (square y-step)) (square z-step)))))
(step-len (sqrtf (+ (square x-step) (square y-step) (square z-step)))))
(cond
((>= max-step step-len) (+! (-> vec x) x-step) (+! (-> vec y) y-step) (+! (-> vec z) z-step))
((>= max-step step-len)
(+! (-> vec x) x-step)
(+! (-> vec y) y-step)
(+! (-> vec z) z-step))
(else
(let ((step-scale (/ max-step step-len)))
(+! (-> vec x) (* step-scale x-step))
@@ -378,10 +385,7 @@
(defun vector-identity! ((value vector))
"Set all four lanes of value to 1."
(set! (-> value x) 1.0)
(set! (-> value y) 1.0)
(set! (-> value z) 1.0)
(set! (-> value w) 1.0)
(set-vector! value 1.0 1.0 1.0 1.0)
value)
(defun vector-seconds ((out vector) (seconds vector))
@@ -400,31 +404,31 @@
(defun vector-v! ((velocity vector))
"Convert a per-second velocity to displacement per frame in place."
(vector-float*! velocity velocity (-> *display* seconds-per-frame))
(vector-float*! velocity velocity (seconds-per-frame))
velocity)
(defun vector-v+! ((result vector) (position vector) (velocity vector))
"Advance position by one frame of velocity and write result."
(vector+float*! result position velocity (-> *display* seconds-per-frame))
(vector+float*! result position velocity (seconds-per-frame))
result)
(defun vector-v*float+! ((result vector) (position vector) (velocity vector) (velocity-scale float))
"Advance position by one frame of scaled velocity and write result."
(vector+float*! result position velocity (* velocity-scale (-> *display* seconds-per-frame)))
(vector+float*! result position velocity (* velocity-scale (seconds-per-frame)))
result)
(defun vector-v++! ((position vector) (velocity vector))
"Advance position in place by two frame displacements of velocity."
(vector+float*! position position velocity (-> *display* seconds-per-frame))
(vector+float*! position position velocity (seconds-per-frame))
position)
(defun vector-v*float! ((delta-p vector) (velocity vector) (scale float))
"Convert velocity to a scaled displacement per frame and write delta-p."
(vector-float*! delta-p velocity (* scale (-> *display* seconds-per-frame))))
(vector-float*! delta-p velocity (* scale (seconds-per-frame))))
(defun vector-v*float++! ((position vector) (velocity vector) (scale float))
"Advance position in place by one frame of scaled velocity."
(vector+float*! position position velocity (* scale (-> *display* seconds-per-frame)))
(vector+float*! position position velocity (* scale (seconds-per-frame)))
position)
(defun vector-to-ups! ((out vector) (per-frame vector))
@@ -717,11 +721,19 @@
(defun vector-cvt.w.s! ((out vector) (value vector))
"Truncate four floating-point lanes to signed 32-bit integers."
(rlet ((vf1 :class vf)) (.lvf vf1 (&-> value quad)) (.ftoi.vf vf1 vf1) (.svf (&-> out quad) vf1) out))
(rlet ((vf1 :class vf))
(.lvf vf1 (&-> value quad))
(.ftoi.vf vf1 vf1)
(.svf (&-> out quad) vf1)
out))
(defun vector-cvt.s.w! ((out vector) (value vector))
"Convert four signed 32-bit integer lanes to floating point."
(rlet ((vf1 :class vf)) (.lvf vf1 (&-> value quad)) (.itof.vf vf1 vf1) (.svf (&-> out quad) vf1) out))
(rlet ((vf1 :class vf))
(.lvf vf1 (&-> value quad))
(.itof.vf vf1 vf1)
(.svf (&-> out quad) vf1)
out))
(defun rot-zxy-from-vector! ((out vector) (forward vector))
"Compute yaw and pitch that orient a forward vector along forward using ZXY rotation order; roll is zero."
@@ -778,11 +790,17 @@
(vf4 :class vf))
(init-vf0-vector)
(cond
((>= 0.0 alpha) (vector-copy! out a))
((>= alpha 1.0) (vector-copy! out b))
((>= 0.0 alpha)
(vector-copy! out a))
((>= alpha 1.0)
(vector-copy! out b))
(else
(let ((v1-2 out))
(let ((f0-2 alpha)) (.lvf vf1 (&-> a quad)) (.lvf vf2 (&-> b quad)) (let ((a1-1 f0-2)) (.mov vf4 a1-1)))
(let ((f0-2 alpha))
(.lvf vf1 (&-> a quad))
(.lvf vf2 (&-> b quad))
(let ((a1-1 f0-2))
(.mov vf4 a1-1)))
(.add.x.vf.w vf3 vf0 vf0)
(.sub.vf vf2 vf2 vf1)
(.mul.x.vf vf2 vf2 vf4)
@@ -812,11 +830,17 @@
(vf3 :class vf)
(vf4 :class vf))
(cond
((>= 0.0 alpha) (vector-copy! out a))
((>= alpha 1.0) (vector-copy! out b))
((>= 0.0 alpha)
(vector-copy! out a))
((>= alpha 1.0)
(vector-copy! out b))
(else
(let ((v1-2 out))
(let ((f0-2 alpha)) (.lvf vf1 (&-> a quad)) (.lvf vf2 (&-> b quad)) (let ((a1-1 f0-2)) (.mov vf4 a1-1)))
(let ((f0-2 alpha))
(.lvf vf1 (&-> a quad))
(.lvf vf2 (&-> b quad))
(let ((a1-1 f0-2))
(.mov vf4 a1-1)))
(.sub.vf vf2 vf2 vf1)
(.mul.x.vf vf2 vf2 vf4)
(.add.vf vf3 vf1 vf2)
@@ -838,7 +862,8 @@
"Arithmetic-shift packed angle words right 16 bits and convert them to rotation-unit floats."
(local-vars (v1-1 uint128))
(rlet ((vf1 :class vf))
(let ((v1-0 (-> packed-angles quad))) (.pw.sra v1-1 v1-0 16))
(let ((v1-0 (-> packed-angles quad)))
(.pw.sra v1-1 v1-0 16))
(.mov vf1 v1-1)
(.itof.vf vf1 vf1)
(.svf (&-> out quad) vf1)
@@ -885,13 +910,16 @@
(defun vector-deg-lerp-clamp! ((out vector) (minimum vector) (maximum vector) (amount float))
"Apply clamped shortest-angle interpolation to three lanes and set out.w to 1."
(cond
((>= 0.0 amount) (vector-copy! out minimum))
((>= amount 1.0) (vector-copy! out maximum))
((>= 0.0 amount)
(vector-copy! out minimum))
((>= amount 1.0)
(vector-copy! out maximum))
(else
(set! (-> out x) (deg-lerp-clamp (-> minimum x) (-> maximum x) amount))
(set! (-> out y) (deg-lerp-clamp (-> minimum y) (-> maximum y) amount))
(set! (-> out z) (deg-lerp-clamp (-> minimum z) (-> maximum z) amount))
(set! (-> out w) 1.0)))
(set-vector! out
(deg-lerp-clamp (-> minimum x) (-> maximum x) amount)
(deg-lerp-clamp (-> minimum y) (-> maximum y) amount)
(deg-lerp-clamp (-> minimum z) (-> maximum z) amount)
1.0)))
out)
;; The weird docstrings for the next 4 functions were left behind in the game.
@@ -955,7 +983,9 @@
(defun sphere<-vector! ((out sphere) (center vector))
"Copy center.xyz into out while preserving its radius."
(let ((f0-0 (-> out w))) (vector-copy! out center) (set! (-> out w) f0-0))
(let ((r (-> out w)))
(vector-copy! out center)
(set! (-> out w) r))
out)
(defun sphere<-vector+r! ((out sphere) (center vector) (radius float))
+7 -3
View File
@@ -42,9 +42,13 @@
(defun mc-sync ()
"Wait for the current memory-card read or write to finish by advancing the memory-card
state machine until it reports a result. Return that result. This blocks the entire
game, so it is intended only for debugging."
(let ((result 0)) (while (zero? result) (mc-run) (set! result (mc-check-result))) result))
state machine until it reports a result. Return that result. This blocks the entire game, so it is
intended only for debugging."
(let ((result 0))
(while (zero? result)
(mc-run)
(set! result (mc-check-result)))
result))
(defun show-mc-info ((dma-buf dma-buffer))
"Draw the current status of both memory-card slots."
-2
View File
@@ -10,9 +10,7 @@
;; Use the service-cpads functions once per frame to update the data and vibration control
;; The cpad-set-buzz! function can be used for vibration.
;; in display, but we haven't gotten to display-h.gc yet.
(define-extern get-current-time (function time-frame))
(define-extern get-integral-current-time (function time-frame))
(#when PC_PORT
+14 -13
View File
@@ -11,7 +11,7 @@
(defun timer-reset ((timer timer-bank))
"Clear an EE hardware timer counter."
(#when PC_PORT
;; The host timer cannot be reset, so retain its current value as the new origin.
;; The host timer cannot be reset, just store the value at reset time.
(if (= timer TIMER1_BANK) (set! *timer-reset-value* (get-bus-clock/256)) (format 0 "Unknown timer #x~X in timer-reset~%"))
(return (the uint 0)))
(#unless PC_PORT
@@ -41,28 +41,29 @@
(#unless PC_PORT
(defun disable-irq ()
"Clear the global interrupt-enable bit."
(rlet ((status :type uint)) (m status Status) (logand! status (lognot COP0_STATUS_IE)) (m Status status) (sync.p))))
(rlet ((status :type uint))
(m status Status)
(logand! status (lognot COP0_STATUS_IE))
(m Status status) (sync.p))))
(#when PC_PORT
(defun disable-irq ()
"Clear the global interrupt-enable bit."
;; These assembly helpers are no-ops because host interrupts are not controlled by EE status.
(rlet ((status :type uint))
(.mfc0 status Status)
(logand! status (lognot COP0_STATUS_IE))
(.mtc0 Status status)
(.sync.p))))
"Clear the global interrupt-enable bit. Does nothing on PC."
(none)))
(#unless PC_PORT
(defun enable-irq ()
"Set the global interrupt-enable bit."
(rlet ((status :type uint)) (m status Status) (logior! status COP0_STATUS_IE) (m Status status) (sync.p))))
(rlet ((status :type uint))
(m status Status)
(logior! status COP0_STATUS_IE)
(m Status status) (sync.p))))
(#when PC_PORT
(defun enable-irq ()
"Set the global interrupt-enable bit."
;; These assembly helpers are no-ops because host interrupts are not controlled by EE status.
(rlet ((status :type uint)) (.mfc0 status Status) (logior! status COP0_STATUS_IE) (.mtc0 Status status) (.sync.p))))
"Set the global interrupt-enable bit. Does nothing on PC."
(none)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Stopwatch (CPU clock cycle counting)
+2 -2
View File
@@ -3,8 +3,8 @@
(bundles "ENGINE.CGO" "GAME.CGO")
(require "kernel-defs.gc")
;; Each vector unit has a Vector Interface for command and data transfer. VIF streams normally
;; arrive through DMA; direct register access is rare because DMA owns the gameplay schedule.
;; Each vector unit has a Vector Interface (VIF) for command and data transfer. VIF streams normally
;; arrive through DMA; direct register access is rare and only used for initial setup.
;; DECOMP BEGINS
+2 -3
View File
@@ -4,7 +4,7 @@
(require "kernel-defs.gc")
;; Sound is handled by OVERLORD on the IOP. The EE sends these RPC packets to load banks, play
;; sounds, and update playback parameters. Per-frame status replies use a separate interface.
;; sounds, and update playback parameters.
;; DECOMP BEGINS
@@ -26,8 +26,7 @@
(deftype sound-bank-id (uint32) ())
;; Sound and DGO names sent to the IOP occupy one 16-byte value. Named halves make constants and
;; host-side access straightforward without changing the packet layout.
;; Sound and DGO names sent to the IOP occupy one 16-byte value.
(deftype sound-name (uint128)
((lo uint64 :offset 0 :size 64)
(hi uint64 :offset 64 :size 64)))
+3 -4
View File
@@ -4,10 +4,9 @@
(require "kernel/gkernel-h.gc")
;; Each game string has a language-independent text-id. A linked text object
;; supplies the string for the selected language, so code and data refer to the
;; same numeric ID in every localization. The IDs are also shared with short
;; spoken clips such as Daxter hints; an audio ID does not necessarily have a
;; corresponding displayed string.
;; supplies the string for the selected language. The IDs are also shared with short
;; spoken clips such as Daxter hints, which don't have displayed text.
;; It's possible that these hints had text at some point.
(defenum text-id
:type uint32