From 946284c05d1a0e7a50fd652edbbdb1138113fd9e Mon Sep 17 00:00:00 2001 From: ManDude <7569514+ManDude@users.noreply.github.com> Date: Tue, 10 Aug 2021 00:18:53 +0100 Subject: [PATCH] add goal enum utils to standard libs (#740) * add goal enum utils to standard libs * Update .gitattributes --- .gitattributes | 2 + decompiler/config/all-types.gc | 2 +- goal_src/engine/dma/dma-disasm.gc | 38 +------ goal_src/engine/game/fact-h.gc | 14 +-- goal_src/engine/game/game-info-h.gc | 14 +-- goal_src/engine/game/game-info.gc | 121 +--------------------- goal_src/engine/game/game-save.gc | 50 +-------- goal_src/engine/game/task/task-control.gc | 12 +-- goal_src/engine/gfx/hw/gs.gc | 17 +-- goal_src/engine/gfx/tfrag/subdivide.gc | 21 +--- goal_src/engine/sound/gsound.gc | 27 +---- goal_src/engine/target/pat-h.gc | 45 +------- goal_src/goal-lib.gc | 37 ++++++- goal_src/goos-lib.gs | 80 ++++++++++++++ goal_src/kernel/gkernel.gc | 79 +------------- 15 files changed, 138 insertions(+), 421 deletions(-) diff --git a/.gitattributes b/.gitattributes index 641330f89d..f8b81361a2 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,4 +1,6 @@ third-party/**/* linguist-vendored +test/decompiler/reference/** linguist-vendored *.gc linguist-language=lisp *.gd linguist-language=lisp *.gs linguist-language=Scheme +goal_src/engine/gfx/ocean/ocean-tables.gc linguist-vendored diff --git a/decompiler/config/all-types.gc b/decompiler/config/all-types.gc index e4ba043f56..21fd41fcbe 100644 --- a/decompiler/config/all-types.gc +++ b/decompiler/config/all-types.gc @@ -782,7 +782,7 @@ (leaving-misty 114) (assistant-village3 115) (max 116) - (*unknown* 255)) + ) (defenum game-text-id diff --git a/goal_src/engine/dma/dma-disasm.gc b/goal_src/engine/dma/dma-disasm.gc index fd233a0e7d..1b5d06e2ad 100644 --- a/goal_src/engine/dma/dma-disasm.gc +++ b/goal_src/engine/dma/dma-disasm.gc @@ -343,43 +343,7 @@ (defun disasm-dma-tag ((arg0 dma-tag) (arg1 symbol)) (format arg1 "(dma-tag ") - ;; this is a case statement. - (let ((t9-1 format) - (a0-2 arg1) - (a1-2 "~s") - (v1-1 (-> arg0 id)) - ) - (t9-1 a0-2 a1-2 (cond - ((= v1-1 (dma-tag-id end)) - "end" - ) - ((= v1-1 (dma-tag-id ret)) - "ret" - ) - ((= v1-1 (dma-tag-id call)) - "call" - ) - ((= v1-1 (dma-tag-id refs)) - "refs" - ) - ((= v1-1 (dma-tag-id ref)) - "ref" - ) - ((= v1-1 (dma-tag-id next)) - "next" - ) - ((= v1-1 (dma-tag-id cnt)) - "cnt" - ) - ((zero? v1-1) - "refe" - ) - (else - "*unknown*" - ) - ) - ) - ) + (format arg1 "~s" (enum->string dma-tag-id (-> arg0 id))) (if (> (the-as uint (-> arg0 addr)) 0) (format arg1 " :addr #x~8x" (-> arg0 addr)) ) diff --git a/goal_src/engine/game/fact-h.gc b/goal_src/engine/game/fact-h.gc index 5c44304a10..dde05b17ab 100644 --- a/goal_src/engine/game/fact-h.gc +++ b/goal_src/engine/game/fact-h.gc @@ -62,19 +62,7 @@ ) (defun pickup-type->string ((arg0 pickup-type)) - (case arg0 - (((pickup-type eco-pill-random)) "eco-pill-random") - (((pickup-type buzzer)) "buzzer") - (((pickup-type eco-pill)) "eco-pill") - (((pickup-type fuel-cell)) "fuel-cell") - (((pickup-type money)) "money") - (((pickup-type eco-green)) "eco-green") - (((pickup-type eco-blue)) "eco-blue") - (((pickup-type eco-red)) "eco-red") - (((pickup-type eco-yellow)) "eco-yellow") - (((pickup-type none)) "none") - (else "*unknown*") - ) + (enum->string pickup-type arg0) ) ;; Each individual enemy and pickup process will allocate a fact-info on its process heap diff --git a/goal_src/engine/game/game-info-h.gc b/goal_src/engine/game/game-info-h.gc index 9d29a57721..3067bfe43c 100644 --- a/goal_src/engine/game/game-info-h.gc +++ b/goal_src/engine/game/game-info-h.gc @@ -126,11 +126,11 @@ (leaving-misty 114) (assistant-village3 115) (max 116) - (*unknown* 255)) + ) ;; Game parameters. (deftype game-bank (basic) - ((life-max-default float :offset-assert 4) + ((life-max-default float :offset-assert 4) ;; yes this life system works, but does nothing (life-start-default float :offset-assert 8) (life-single-inc float :offset-assert 12) (money-task-inc float :offset-assert 16) @@ -142,11 +142,11 @@ ) (define *GAME-bank* (new 'static 'game-bank - :life-max-default 99.000000 - :life-start-default 5.000000 - :life-single-inc 1.000000 - :money-task-inc 90.000000 - :money-oracle-inc 120.000000 + :life-max-default 99.0 + :life-start-default 5.0 + :life-single-inc 1.0 + :money-task-inc 90.0 + :money-oracle-inc 120.0 ) ) diff --git a/goal_src/engine/game/game-info.gc b/goal_src/engine/game/game-info.gc index e171917912..ae81eeb8b6 100644 --- a/goal_src/engine/game/game-info.gc +++ b/goal_src/engine/game/game-info.gc @@ -708,126 +708,7 @@ ) (defun-debug game-task->string ((arg0 game-task)) - (case arg0 - (((game-task max)) "max") - (((game-task assistant-village3)) "assistant-village3") - (((game-task leaving-misty)) "leaving-misty") - (((game-task plunger-lurker-hit)) "plunger-lurker-hit") - (((game-task finalboss-movies)) "finalboss-movies") - (((game-task village4-button)) "village4-button") - (((game-task ogre-secret)) "ogre-secret") - (((game-task intro)) "intro") - (((game-task lavatube-start)) "lavatube-start") - (((game-task lavatube-balls)) "lavatube-balls") - (((game-task red-eggtop)) "red-eggtop") - (((game-task village3-button)) "village3-button") - (((game-task swamp-arm)) "swamp-arm") - (((game-task village2-levitator)) "village2-levitator") - (((game-task firecanyon-assistant)) "firecanyon-assistant") - (((game-task village3-oracle-money2)) "village3-oracle-money2") - (((game-task village3-oracle-money1)) "village3-oracle-money1") - (((game-task village3-miner-money4)) "village3-miner-money4") - (((game-task village3-miner-money3)) "village3-miner-money3") - (((game-task village3-miner-money2)) "village3-miner-money2") - (((game-task village3-miner-money1)) "village3-miner-money1") - (((game-task training-buzzer)) "training-buzzer") - (((game-task training-climb)) "training-climb") - (((game-task training-door)) "training-door") - (((game-task training-gimmie)) "training-gimmie") - (((game-task citadel-buzzer)) "citadel-buzzer") - (((game-task lavatube-buzzer)) "lavatube-buzzer") - (((game-task lavatube-end)) "lavatube-end") - (((game-task ogre-buzzer)) "ogre-buzzer") - (((game-task ogre-end)) "ogre-end") - (((game-task ogre-boss)) "ogre-boss") - (((game-task cave-buzzer)) "cave-buzzer") - (((game-task cave-platforms)) "cave-platforms") - (((game-task cave-spider-tunnel)) "cave-spider-tunnel") - (((game-task cave-swing-poles)) "cave-swing-poles") - (((game-task cave-robot-climb)) "cave-robot-climb") - (((game-task cave-dark-climb)) "cave-dark-climb") - (((game-task cave-dark-crystals)) "cave-dark-crystals") - (((game-task cave-gnawers)) "cave-gnawers") - (((game-task village3-buzzer)) "village3-buzzer") - (((game-task village2-buzzer)) "village2-buzzer") - (((game-task village1-buzzer)) "village1-buzzer") - (((game-task village3-extra1)) "village3-extra1") - (((game-task citadel-sage-yellow)) "citadel-sage-yellow") - (((game-task citadel-sage-red)) "citadel-sage-red") - (((game-task citadel-sage-blue)) "citadel-sage-blue") - (((game-task citadel-sage-green)) "citadel-sage-green") - (((game-task firecanyon-end)) "firecanyon-end") - (((game-task firecanyon-buzzer)) "firecanyon-buzzer") - (((game-task snow-cage)) "snow-cage") - (((game-task snow-bumpers)) "snow-bumpers") - (((game-task snow-buzzer)) "snow-buzzer") - (((game-task snow-bunnies)) "snow-bunnies") - (((game-task snow-ball)) "snow-ball") - (((game-task snow-fort)) "snow-fort") - (((game-task snow-ram)) "snow-ram") - (((game-task snow-eggtop)) "snow-eggtop") - (((game-task rolling-ring-chase-2)) "rolling-ring-chase-2") - (((game-task rolling-ring-chase-1)) "rolling-ring-chase-1") - (((game-task rolling-buzzer)) "rolling-buzzer") - (((game-task rolling-lake)) "rolling-lake") - (((game-task rolling-plants)) "rolling-plants") - (((game-task rolling-moles)) "rolling-moles") - (((game-task rolling-robbers)) "rolling-robbers") - (((game-task rolling-race)) "rolling-race") - (((game-task sunken-spinning-room)) "sunken-spinning-room") - (((game-task sunken-top-of-helix)) "sunken-top-of-helix") - (((game-task sunken-buzzer)) "sunken-buzzer") - (((game-task sunken-sharks)) "sunken-sharks") - (((game-task sunken-room)) "sunken-room") - (((game-task sunken-slide)) "sunken-slide") - (((game-task sunken-pipe)) "sunken-pipe") - (((game-task sunken-platforms)) "sunken-platforms") - (((game-task swamp-buzzer)) "swamp-buzzer") - (((game-task swamp-tether-4)) "swamp-tether-4") - (((game-task swamp-tether-3)) "swamp-tether-3") - (((game-task swamp-tether-2)) "swamp-tether-2") - (((game-task swamp-tether-1)) "swamp-tether-1") - (((game-task swamp-battle)) "swamp-battle") - (((game-task swamp-flutflut)) "swamp-flutflut") - (((game-task swamp-billy)) "swamp-billy") - (((game-task village2-oracle-money2)) "village2-oracle-money2") - (((game-task village2-oracle-money1)) "village2-oracle-money1") - (((game-task village2-warrior-money)) "village2-warrior-money") - (((game-task village2-geologist-money)) "village2-geologist-money") - (((game-task village2-gambler-money)) "village2-gambler-money") - (((game-task misty-eco-challenge)) "misty-eco-challenge") - (((game-task misty-bike-jump)) "misty-bike-jump") - (((game-task misty-buzzer)) "misty-buzzer") - (((game-task misty-bike)) "misty-bike") - (((game-task misty-cannon)) "misty-cannon") - (((game-task misty-warehouse)) "misty-warehouse") - (((game-task misty-boat)) "misty-boat") - (((game-task misty-muse)) "misty-muse") - (((game-task beach-sentinel)) "beach-sentinel") - (((game-task beach-gimmie)) "beach-gimmie") - (((game-task beach-buzzer)) "beach-buzzer") - (((game-task beach-cannon)) "beach-cannon") - (((game-task beach-seagull)) "beach-seagull") - (((game-task beach-flutflut)) "beach-flutflut") - (((game-task beach-pelican)) "beach-pelican") - (((game-task beach-ecorocks)) "beach-ecorocks") - (((game-task village1-oracle-money2)) "village1-oracle-money2") - (((game-task village1-oracle-money1)) "village1-oracle-money1") - (((game-task village1-uncle-money)) "village1-uncle-money") - (((game-task village1-mayor-money)) "village1-mayor-money") - (((game-task village1-yakow)) "village1-yakow") - (((game-task jungle-temple-door)) "jungle-temple-door") - (((game-task jungle-canyon-end)) "jungle-canyon-end") - (((game-task jungle-buzzer)) "jungle-buzzer") - (((game-task jungle-plant)) "jungle-plant") - (((game-task jungle-fishgame)) "jungle-fishgame") - (((game-task jungle-tower)) "jungle-tower") - (((game-task jungle-lurkerm)) "jungle-lurkerm") - (((game-task jungle-eggtop)) "jungle-eggtop") - (((game-task complete)) "complete") - (((game-task none)) "none") - (else "*unknown*") - ) + (enum->string game-task arg0) ) (defmethod debug-print game-info ((obj game-info) (arg0 symbol)) diff --git a/goal_src/engine/game/game-save.gc b/goal_src/engine/game/game-save.gc index d44cad1752..7ec03313f1 100644 --- a/goal_src/engine/game/game-save.gc +++ b/goal_src/engine/game/game-save.gc @@ -131,55 +131,7 @@ ) (defun-debug game-save-elt->string ((arg0 game-save-elt)) - "Convert a game-save-elt to a string" - (let ((v1-0 arg0)) - (cond - ((= v1-0 (game-save-elt aspect-ratio)) "aspect-ratio") - ((= v1-0 (game-save-elt video-mode)) "video-mode") - ((= v1-0 (game-save-elt play-hints)) "play-hints") - ((= v1-0 (game-save-elt vibration)) "vibration") - ((= v1-0 (game-save-elt screeny)) "screeny") - ((= v1-0 (game-save-elt screenx)) "screenx") - ((= v1-0 (game-save-elt language)) "language") - ((= v1-0 (game-save-elt dialog-volume)) "dialog-volume") - ((= v1-0 (game-save-elt music-volume)) "music-volume") - ((= v1-0 (game-save-elt sfx-volume)) "sfx-volume") - ((= v1-0 (game-save-elt in-level-time)) "in-level-time") - ((= v1-0 (game-save-elt auto-save-count)) "auto-save-count") - ((= v1-0 (game-save-elt death-pos)) "death-pos") - ((= v1-0 (game-save-elt deaths-per-level)) "deaths-per-level") - ((= v1-0 (game-save-elt enter-level-time)) "enter-level-time") - ((= v1-0 (game-save-elt fuel-cell-time)) "fuel-cell-time") - ((= v1-0 (game-save-elt continue-time)) "continue-time") - ((= v1-0 (game-save-elt fuel-cell-pickup-time)) "fuel-cell-pickup-time") - ((= v1-0 (game-save-elt hit-time)) "hit-time") - ((= v1-0 (game-save-elt death-time)) "death-time") - ((= v1-0 (game-save-elt continue-timke)) "continue-timke") - ((= v1-0 (game-save-elt game-start-time)) "game-start-time") - ((= v1-0 (game-save-elt fuel-cell-deaths)) "fuel-cell-deaths") - ((= v1-0 (game-save-elt continue-deaths)) "continue-deaths") - ((= v1-0 (game-save-elt total-deaths)) "total-deaths") - ((= v1-0 (game-save-elt level-open-list)) "level-open-list") - ((= v1-0 (game-save-elt text-list)) "text-list") - ((= v1-0 (game-save-elt hint-list)) "hint-list") - ((= v1-0 (game-save-elt perm-list)) "perm-list") - ((= v1-0 (game-save-elt task-list)) "task-list") - ((= v1-0 (game-save-elt death-movie-tick)) "death-movie-tick") - ((= v1-0 (game-save-elt fuel-cell)) "fuel-cell") - ((= v1-0 (game-save-elt buzzer-total)) "buzzer-total") - ((= v1-0 (game-save-elt moeny-per-level)) "money-per-level") - ((= v1-0 (game-save-elt money-total)) "money-total") - ((= v1-0 (game-save-elt money)) "money") - ((= v1-0 (game-save-elt life)) "life") - ((= v1-0 (game-save-elt continue)) "continue") - ((= v1-0 (game-save-elt integral-time)) "integral-time") - ((= v1-0 (game-save-elt game-time)) "game-time") - ((= v1-0 (game-save-elt real-time)) "real-time") - ((= v1-0 (game-save-elt base-time)) "base-time") - ((= v1-0 (game-save-elt name)) "name") - (else "*unknown*") - ) - ) + (enum->string game-save-elt arg0) ) (defun progress-level-index->string ((arg0 int)) diff --git a/goal_src/engine/game/task/task-control.gc b/goal_src/engine/game/task/task-control.gc index 078b793596..d3da1d2900 100644 --- a/goal_src/engine/game/task/task-control.gc +++ b/goal_src/engine/game/task/task-control.gc @@ -6,17 +6,7 @@ ;; dgos: GAME, ENGINE (defun-debug task-status->string ((arg0 task-status)) - (case arg0 - (((task-status need-resolution)) "need-resolution") - (((task-status need-reward-speech)) "need-reward-speech") - (((task-status need-reminder)) "need-reminder") - (((task-status need-reminder-a)) "need-reminder-a") - (((task-status need-introduction)) "need-introduction") - (((task-status need-hint)) "need-hint") - (((task-status unknown)) "unknown") - (((task-status invalid)) "invalid") - (else "*unknown*") - ) + (enum->string task-status arg0) ) (defmethod get-game-task task-cstage ((obj task-cstage)) diff --git a/goal_src/engine/gfx/hw/gs.gc b/goal_src/engine/gfx/hw/gs.gc index 9243a9e2d1..071432c04b 100644 --- a/goal_src/engine/gfx/hw/gs.gc +++ b/goal_src/engine/gfx/hw/gs.gc @@ -98,22 +98,7 @@ (defun psm->string ((arg0 gs-psm)) "Get the name of a texture format." - (case arg0 - (((gs-psm mz16s)) "mz16s") - (((gs-psm mz16)) "mz16") - (((gs-psm mz24)) "mz24") - (((gs-psm mz32)) "mz32") - (((gs-psm mt4hh)) "mt4hh") - (((gs-psm mt4hl)) "mt4hl") - (((gs-psm mt8h)) "mt8h") - (((gs-psm mt4)) "mt4") - (((gs-psm mt8)) "mt8") - (((gs-psm ct16s)) "ct16s") - (((gs-psm ct16)) "ct16") - (((gs-psm ct24)) "ct24") - (((gs-psm ct32)) "ct32") - (else "*unknown*") - ) + (enum->string gs-psm arg0) ) diff --git a/goal_src/engine/gfx/tfrag/subdivide.gc b/goal_src/engine/gfx/tfrag/subdivide.gc index 4dc38e8416..eb59533552 100644 --- a/goal_src/engine/gfx/tfrag/subdivide.gc +++ b/goal_src/engine/gfx/tfrag/subdivide.gc @@ -224,26 +224,7 @@ (camera 16)) (defun-debug perf-stat-bucket->string ((arg0 perf-stat-bucket)) - (case arg0 - (((perf-stat-bucket camera)) "camera") - (((perf-stat-bucket collide)) "collide") - (((perf-stat-bucket nav)) "nav") - (((perf-stat-bucket bones)) "bones") - (((perf-stat-bucket proto-tie-n)) "proto-tie-n") - (((perf-stat-bucket proto-tie)) "proto-tie") - (((perf-stat-bucket proto-tie-g)) "proto-tie-g") - (((perf-stat-bucket inst-tie)) "inst-tie") - (((perf-stat-bucket proto-shrub)) "proto-shrub") - (((perf-stat-bucket inst-shrub)) "inst-shrub") - (((perf-stat-bucket tfrag-near)) "tfrag-near") - (((perf-stat-bucket tfrag)) "tfrag") - (((perf-stat-bucket drawable)) "drawable") - (((perf-stat-bucket background)) "background") - (((perf-stat-bucket tie-generic)) "tie-generic") - (((perf-stat-bucket mercneric)) "mercneric") - (((perf-stat-bucket all-code)) "all-code") - (else "*unknown*") - ) + (enum->string perf-stat-bucket arg0) ) diff --git a/goal_src/engine/sound/gsound.gc b/goal_src/engine/sound/gsound.gc index d3c269c4b9..76c6b515d5 100644 --- a/goal_src/engine/sound/gsound.gc +++ b/goal_src/engine/sound/gsound.gc @@ -182,32 +182,7 @@ ) (defun-debug sound-command->string ((cmd sound-command)) - (case cmd - (((sound-command unload-music)) "unload-music") - (((sound-command list-sounds)) "list-sounds") - (((sound-command shutdown)) "shutdown") - (((sound-command set-ear-trans)) "set-ear-trans") - (((sound-command set-reverb)) "set-reverb") - (((sound-command set-flava)) "set-flava") - (((sound-command set-language)) "set-language") - (((sound-command reload-info)) "reload-info") - (((sound-command set-sound-falloff)) "set-sound-falloff") - (((sound-command set-falloff-curve)) "set-falloff-curve") - (((sound-command get-irx-version)) "get-irx-version") - (((sound-command continue-group)) "continue-group") - (((sound-command stop-group)) "stop-group") - (((sound-command pause-group)) "pause-group") - (((sound-command set-master-volume)) "set-master-volume") - (((sound-command set-param)) "set-param") - (((sound-command continue-sound)) "continue-sound") - (((sound-command stop-sound)) "stop-sound") - (((sound-command pause-sound)) "pause-sound") - (((sound-command play)) "play") - (((sound-command unload-bank)) "unload-bank") - (((sound-command load-music)) "load-music") - (((sound-command load-bank)) "load-bank") - (else "*unknown*") - ) + (enum->string sound-command cmd) ) (defun sound-buffer-dump () diff --git a/goal_src/engine/target/pat-h.gc b/goal_src/engine/target/pat-h.gc index 11ca7157e8..5e97b0dd92 100644 --- a/goal_src/engine/target/pat-h.gc +++ b/goal_src/engine/target/pat-h.gc @@ -70,54 +70,15 @@ ) (defun-debug pat-material->string ((pat pat-surface)) - (case (-> pat material) - (((pat-material neutral)) "neutral") - (((pat-material rotate)) "rotate") - (((pat-material stopproj)) "stopproj") - (((pat-material swamp)) "swamp") - (((pat-material tube)) "tube") - (((pat-material straw)) "straw") - (((pat-material metal)) "metal") - (((pat-material dirt)) "dirt") - (((pat-material gravel)) "gravel") - (((pat-material crwood)) "crwood") - (((pat-material lava)) "lava") - (((pat-material hotcoals)) "hotcoals") - (((pat-material deepsnow)) "deepsnow") - (((pat-material snow)) "snow") - (((pat-material pcmetal)) "pcmetal") - (((pat-material grass)) "grass") - (((pat-material wood)) "wood") - (((pat-material sand)) "sand") - (((pat-material tar)) "tar") - (((pat-material waterbottom)) "waterbottom") - (((pat-material quicksand)) "quicksand") - (((pat-material ice)) "ice") - (((pat-material stone)) "stone") - (else "*unknown*") - ) + (enum->string pat-material (-> pat material)) ) (defun-debug pat-mode->string ((pat pat-surface)) - (case (-> pat mode) - (((pat-mode obstacle)) "obstacle") - (((pat-mode wall)) "wall") - (((pat-mode ground)) "ground") - (else "*unknown*") - ) + (enum->string pat-mode (-> pat mode)) ) (defun-debug pat-event->string ((pat pat-surface)) - (case (-> pat event) - (((pat-event melt)) "melt") - (((pat-event burnup)) "burnup") - (((pat-event deadlyup)) "deadlyup") - (((pat-event burn)) "burn") - (((pat-event endlessfall)) "endlessfall") - (((pat-event deadly)) "deadly") - (((pat-event none)) "none") - (else "*unknown*") - ) + (enum->string pat-event (-> pat event)) ) (deftype pat-mode-info (structure) diff --git a/goal_src/goal-lib.gc b/goal_src/goal-lib.gc index 552d3cd7eb..f856373911 100644 --- a/goal_src/goal-lib.gc +++ b/goal_src/goal-lib.gc @@ -524,7 +524,7 @@ (defmacro logtesta? (a b) "does a have ALL of the bits in b?" - `(= (logand ,a ,b) ,b) + `(= (logand ,b ,a) ,b) ) (defmacro deref (t addr &rest fields) @@ -707,3 +707,38 @@ ;; load the default project (load-project "goal_src/game.gp") + + +;;;;;;;;;;;;;;;;;;; +;; enum stuff +;;;;;;;;;;;;;;;;;;; + +(defmacro enum->string (enum input) + "return the name of an enum value" + + `(case ,input + ,@(apply (lambda (x) `(((,enum ,(car x) )) ,(symbol->string (car x) ) )) (reverse (get-enum-vals enum))) + (else "*unknown*") + ) + ) + +(defmacro bit-enum->string (enum input stream) + "print the enum bits in input to stream" + + (with-gensyms (val str) + `(let ((,val ,input) + (,str ,stream)) + + ,@(apply (lambda (x) + `(if (logtesta? ,val (,enum ,(car x))) + (format ,str ,(fmt #f "{} " (car x))) + ) + + ) (reverse (get-enum-vals enum))) + + ) + ) + ) + + + diff --git a/goal_src/goos-lib.gs b/goal_src/goos-lib.gs index a48e27ab09..639907a3b0 100644 --- a/goal_src/goos-lib.gs +++ b/goal_src/goos-lib.gs @@ -62,6 +62,9 @@ (defsmacro cddr (x) `(cdr (cdr ,x))) +(defsmacro cdddr (x) + `(cdr (cdr (cdr ,x)))) + (desfun first (x) (car x)) @@ -116,6 +119,40 @@ ) ) +(desfun reverse (lst) + (if (null? lst) + '() + (let ((old-lst lst) + (new-lst '())) + (while (not (null? old-lst)) + (set! new-lst (cons (car old-lst) new-lst)) + (set! old-lst (cdr old-lst)) + ) + new-lst + ) + ) + ) + +(desfun reverse-recursive (lst) + (if (null? lst) + '() + (let ((old-lst lst) + (new-lst '())) + (while (not (null? old-lst)) + (let ((cur-obj (car old-lst))) + (set! new-lst (cons (if (pair? cur-obj) + (reverse-recursive cur-obj) + cur-obj + ) + new-lst)) + (set! old-lst (cdr old-lst)) + ) + ) + new-lst + ) + ) + ) + (defsmacro let (bindings &rest body) `((lambda ,(apply first bindings) ,@body) ,@(apply second bindings))) @@ -239,6 +276,49 @@ ) +;;;;;;;;;;;;;;;;;;; +;; enum stuff +;;;;;;;;;;;;;;;;;;; + +(desfun enum-length (enum) + (length (get-enum-vals enum)) + ) + +(defsmacro doenum (bindings &rest body) + ;; (doenum (name-var val-var 'enum &rest result) &rest body) + + (with-gensyms (enum-vals) + `(let ((,enum-vals (get-enum-vals ,(third bindings)))) + + (while (not (null? ,enum-vals)) + (let ((,(first bindings) (caar ,enum-vals)) ;; name + (,(second bindings) (cdar ,enum-vals)) ;; value + ) + ,@body + ) + + (set! ,enum-vals (cdr ,enum-vals)) + ) + + ,@(cdddr bindings) + + ) + ) + + ) + +(desfun enum-max (enum) + "get the highest value in an enum" + + (let ((max-val -999999999)) + (doenum (name val enum) + (when (> val max-val) + (set! max-val val)) + ) + + max-val + ) + ) ;; shortcut to quit GOOS diff --git a/goal_src/kernel/gkernel.gc b/goal_src/kernel/gkernel.gc index 8d604fa6fc..093c1ef46a 100644 --- a/goal_src/kernel/gkernel.gc +++ b/goal_src/kernel/gkernel.gc @@ -279,84 +279,7 @@ ;; Each process-tree element has a process-mask which indicates what type of node it is. (defun-debug stream<-process-mask ((arg0 object) (arg1 process-mask)) - (let ((s4-0 arg1)) - (if (= (logand #x1000000 (the-as int s4-0)) (process-mask death)) - (format arg0 "death ") - ) - (if (= (logand #x800000 (the-as int s4-0)) (process-mask attackable)) - (format arg0 "attackable ") - ) - (if (= (logand #x400000 (the-as int s4-0)) (process-mask projectile)) - (format arg0 "projectile ") - ) - (if (= (logand #x200000 (the-as int s4-0)) (process-mask entity)) - (format arg0 "entity ") - ) - (if (= (logand #x100000 (the-as int s4-0)) (process-mask ambient)) - (format arg0 "ambient ") - ) - (if (= (logand #x80000 (the-as int s4-0)) (process-mask platform)) - (format arg0 "platform ") - ) - (if (= (logand #x40000 (the-as int s4-0)) (process-mask camera)) - (format arg0 "camera ") - ) - (if (= (logand #x20000 (the-as int s4-0)) (process-mask enemy)) - (format arg0 "enemy ") - ) - (if (= (logand #x10000 (the-as int s4-0)) (process-mask collectable)) - (format arg0 "collectable ") - ) - (if (= (logand s4-0 (process-mask crate)) (process-mask crate)) - (format arg0 "crate ") - ) - (if (= (logand s4-0 (process-mask sidekick)) (process-mask sidekick)) - (format arg0 "sidekick ") - ) - (if (= (logand s4-0 (process-mask target)) (process-mask target)) - (format arg0 "target ") - ) - (if - (= (logand s4-0 (process-mask movie-subject)) (process-mask movie-subject)) - (format arg0 "movie-subject ") - ) - (if (= (logand s4-0 (process-mask movie)) (process-mask movie)) - (format arg0 "movie ") - ) - (if (= (logand s4-0 (process-mask going)) (process-mask going)) - (format arg0 "going ") - ) - (if (= (logand s4-0 (process-mask heap-shrunk)) (process-mask heap-shrunk)) - (format arg0 "heap-shrunk ") - ) - (if (= (logand s4-0 (process-mask process-tree)) (process-mask process-tree)) - (format arg0 "process-tree ") - ) - (if (= (logand s4-0 (process-mask sleep-code)) (process-mask sleep-code)) - (format arg0 "sleep-code ") - ) - (if (= (logand s4-0 (process-mask sleep)) (process-mask sleep)) - (format arg0 "sleep ") - ) - (if (= (logand s4-0 (process-mask actor-pause)) (process-mask actor-pause)) - (format arg0 "actor-pause ") - ) - (if (= (logand s4-0 (process-mask progress)) (process-mask progress)) - (format arg0 "progress ") - ) - (if (= (logand s4-0 (process-mask menu)) (process-mask menu)) - (format arg0 "menu ") - ) - (if (= (logand s4-0 (process-mask pause)) (process-mask pause)) - (format arg0 "pause ") - ) - (if (= (logand s4-0 (process-mask draw)) (process-mask draw)) - (format arg0 "draw ") - ) - (if (= (logand s4-0 (process-mask execute)) (process-mask execute)) - (format arg0 "execute ") - ) - ) + (bit-enum->string process-mask arg1 arg0) arg1 )