improve macro detection

common/CMakeLists.txt

@@ -36,6 +36,7 @@ add_library(common
         cross_sockets/XSocketServer.cpp
         custom_data/pack_helpers.cpp
         custom_data/TFrag3Data.cpp
+        demacro/demacro.cpp
         dma/dma_copy.cpp
         dma/dma.cpp
         dma/gs.cpp

common/demacro/demacro.cpp

@@ -0,0 +1,689 @@
+#include "demacro.h"
+
+#include <algorithm>
+#include <memory>
+#include <mutex>
+#include <optional>
+#include <stdexcept>
+#include <unordered_map>
+
+#include "common/formatter/formatter.h"
+#include "common/util/FileUtil.h"
+#include "common/util/json_util.h"
+#include "common/util/string_util.h"
+
+#include "fmt/format.h"
+#include "third-party/json.hpp"
+#include "tree_sitter/api.h"
+
+extern "C" {
+extern const TSLanguage* tree_sitter_opengoal();
+}
+
+namespace demacro {
+namespace {
+
+struct Node {
+  bool is_list = false;
+  uint32_t start = 0;
+  uint32_t end = 0;
+  std::string atom;
+  std::vector<Node> children;
+};
+
+struct Comment {
+  uint32_t start = 0;
+  uint32_t end = 0;
+};
+
+struct ParsedSource {
+  Node root;
+  std::vector<Comment> comments;
+};
+
+struct Captures {
+  std::unordered_map<std::string, const Node*> single;
+  std::unordered_map<std::string, std::vector<const Node*>> sequence;
+};
+
+struct CompiledRule {
+  std::string name;
+  std::vector<Node> match;
+  std::vector<Node> rewrite;
+  size_t index = 0;
+};
+
+struct Candidate {
+  uint32_t start = 0;
+  uint32_t end = 0;
+  size_t rule_index = 0;
+  Captures captures;
+};
+
+struct Edit {
+  uint32_t start = 0;
+  uint32_t end = 0;
+  size_t rule_index = 0;
+  std::string replacement;
+};
+
+bool is_comment_node(const TSNode& node) {
+  const std::string_view type = ts_node_type(node);
+  return type == "comment" || type == "block_comment";
+}
+
+bool is_gap_node(const TSNode& node) {
+  const std::string_view type = ts_node_type(node);
+  return type == "(" || type == ")" || type == "_ws" || type == "ERROR" ||
+         is_comment_node(node);
+}
+
+std::string node_text(const std::string& source, const TSNode& node) {
+  const auto start = ts_node_start_byte(node);
+  const auto end = ts_node_end_byte(node);
+  return source.substr(start, end - start);
+}
+
+void collect_comments(const TSNode& node, std::vector<Comment>* comments) {
+  if (is_comment_node(node)) {
+    comments->push_back({ts_node_start_byte(node), ts_node_end_byte(node)});
+    return;
+  }
+  for (uint32_t i = 0; i < ts_node_child_count(node); ++i) {
+    collect_comments(ts_node_child(node, i), comments);
+  }
+}
+
+std::optional<Node> convert_node(const std::string& source, const TSNode& node) {
+  if (is_gap_node(node)) {
+    return {};
+  }
+
+  Node result;
+  result.start = ts_node_start_byte(node);
+  result.end = ts_node_end_byte(node);
+
+  const std::string_view type = ts_node_type(node);
+  if (type == "list_lit" || type == "source") {
+    result.is_list = true;
+    for (uint32_t i = 0; i < ts_node_child_count(node); ++i) {
+      auto child = convert_node(source, ts_node_child(node, i));
+      if (child) {
+        result.children.push_back(std::move(*child));
+      }
+    }
+  } else {
+    // Reader forms and strings are deliberately atomic. Demacro is interested in the shape of
+    // ordinary lists, and retaining their exact spelling avoids damaging quoted data or strings.
+    result.atom = node_text(source, node);
+  }
+  return result;
+}
+
+ParsedSource parse_source(const std::string& source, const std::string& source_name) {
+  std::shared_ptr<TSParser> parser(ts_parser_new(), formatter::TreeSitterParserDeleter());
+  ts_parser_set_language(parser.get(), tree_sitter_opengoal());
+  std::shared_ptr<TSTree> tree(
+      ts_parser_parse_string(parser.get(), nullptr, source.c_str(), source.size()),
+      formatter::TreeSitterTreeDeleter());
+
+  auto root = ts_tree_root_node(tree.get());
+  if (ts_node_is_null(root) || ts_node_has_error(root)) {
+    throw std::runtime_error(fmt::format("Unable to parse OpenGOAL forms in {}", source_name));
+  }
+  ParsedSource result;
+  auto converted = convert_node(source, root);
+  if (!converted) {
+    throw std::runtime_error(
+        fmt::format("OpenGOAL parser returned an empty tree for {}", source_name));
+  }
+  result.root = std::move(*converted);
+  collect_comments(root, &result.comments);
+  return result;
+}
+
+std::vector<std::string> json_string_or_array(const nlohmann::json& value,
+                                              const std::string& rule_name,
+                                              const std::string& field_name) {
+  if (value.is_string()) {
+    return {value.get<std::string>()};
+  }
+  if (value.is_array()) {
+    std::vector<std::string> result;
+    for (const auto& entry : value) {
+      if (!entry.is_string()) {
+        throw std::runtime_error(
+            fmt::format("Demacro rule '{}' field '{}' must contain only strings", rule_name,
+                        field_name));
+      }
+      result.push_back(entry.get<std::string>());
+    }
+    return result;
+  }
+  throw std::runtime_error(
+      fmt::format("Demacro rule '{}' field '{}' must be a string or array", rule_name, field_name));
+}
+
+std::string substitute_row_values(
+    std::string text,
+    const std::unordered_map<std::string, std::string>& substitutions,
+    const std::string& rule_name) {
+  for (const auto& [key, value] : substitutions) {
+    const auto placeholder = "{{" + key + "}}";
+    size_t cursor = 0;
+    while ((cursor = text.find(placeholder, cursor)) != std::string::npos) {
+      text.replace(cursor, placeholder.size(), value);
+      cursor += value.size();
+    }
+  }
+  if (text.find("{{") != std::string::npos) {
+    throw std::runtime_error(
+        fmt::format("Demacro rule '{}' contains an unresolved table placeholder", rule_name));
+  }
+  return text;
+}
+
+Rule parse_rule(const nlohmann::json& entry,
+                const std::unordered_map<std::string, std::string>& substitutions,
+                const std::string& name_suffix) {
+  Rule rule;
+  const auto base_name = entry.at("name").get<std::string>();
+  rule.name = substitute_row_values(base_name, substitutions, base_name) + name_suffix;
+  rule.match = json_string_or_array(entry.at("match"), rule.name, "match");
+  rule.rewrite = json_string_or_array(entry.at("rewrite"), rule.name, "rewrite");
+  for (auto& form : rule.match) {
+    form = substitute_row_values(std::move(form), substitutions, rule.name);
+  }
+  for (auto& form : rule.rewrite) {
+    form = substitute_row_values(std::move(form), substitutions, rule.name);
+  }
+  return rule;
+}
+
+std::vector<Node> parse_form_sequence(const std::vector<std::string>& forms,
+                                      const std::string& description) {
+  std::vector<Node> result;
+  for (const auto& form : forms) {
+    auto parsed = parse_source(form, description);
+    if (parsed.root.children.size() != 1) {
+      throw std::runtime_error(
+          fmt::format("{} must contain exactly one OpenGOAL form", description));
+    }
+    result.push_back(std::move(parsed.root.children.front()));
+  }
+  return result;
+}
+
+bool is_capture(const Node& node, std::string* name) {
+  if (node.is_list || node.atom.size() < 2 || node.atom.front() != '$' || node.atom[1] == '*') {
+    return false;
+  }
+  *name = node.atom.substr(1);
+  return true;
+}
+
+bool is_sequence_capture(const Node& node, std::string* name) {
+  if (node.is_list || node.atom.size() < 3 || !str_util::starts_with(node.atom, "$*")) {
+    return false;
+  }
+  *name = node.atom.substr(2);
+  return true;
+}
+
+bool structurally_equal(const Node& a, const Node& b) {
+  if (a.is_list != b.is_list) {
+    return false;
+  }
+  if (!a.is_list) {
+    return a.atom == b.atom;
+  }
+  if (a.children.size() != b.children.size()) {
+    return false;
+  }
+  for (size_t i = 0; i < a.children.size(); ++i) {
+    if (!structurally_equal(a.children.at(i), b.children.at(i))) {
+      return false;
+    }
+  }
+  return true;
+}
+
+std::vector<Captures> match_node_all(const Node& pattern,
+                                     const Node& input,
+                                     const Captures& captures);
+
+bool sequence_equal(const std::vector<const Node*>& a, const std::vector<const Node*>& b) {
+  if (a.size() != b.size()) {
+    return false;
+  }
+  for (size_t i = 0; i < a.size(); ++i) {
+    if (!structurally_equal(*a.at(i), *b.at(i))) {
+      return false;
+    }
+  }
+  return true;
+}
+
+std::vector<Captures> match_children_all(const std::vector<Node>& patterns,
+                                         size_t pattern_idx,
+                                         const std::vector<Node>& inputs,
+                                         size_t input_idx,
+                                         const Captures& captures) {
+  if (pattern_idx == patterns.size()) {
+    return input_idx == inputs.size() ? std::vector<Captures>{captures}
+                                      : std::vector<Captures>{};
+  }
+
+  std::string sequence_name;
+  if (is_sequence_capture(patterns.at(pattern_idx), &sequence_name)) {
+    std::vector<Captures> results;
+    for (size_t count = 0; input_idx + count <= inputs.size(); ++count) {
+      std::vector<const Node*> captured;
+      captured.reserve(count);
+      for (size_t i = 0; i < count; ++i) {
+        captured.push_back(&inputs.at(input_idx + i));
+      }
+
+      auto next = captures;
+      const auto previous = next.sequence.find(sequence_name);
+      if (previous != next.sequence.end() && !sequence_equal(previous->second, captured)) {
+        continue;
+      }
+      next.sequence[sequence_name] = std::move(captured);
+      auto matches =
+          match_children_all(patterns, pattern_idx + 1, inputs, input_idx + count, next);
+      results.insert(results.end(), std::make_move_iterator(matches.begin()),
+                     std::make_move_iterator(matches.end()));
+    }
+    return results;
+  }
+
+  if (input_idx == inputs.size()) {
+    return {};
+  }
+  std::vector<Captures> results;
+  for (auto& node_match :
+       match_node_all(patterns.at(pattern_idx), inputs.at(input_idx), captures)) {
+    auto matches =
+        match_children_all(patterns, pattern_idx + 1, inputs, input_idx + 1, node_match);
+    results.insert(results.end(), std::make_move_iterator(matches.begin()),
+                   std::make_move_iterator(matches.end()));
+  }
+  return results;
+}
+
+std::vector<Captures> match_node_all(const Node& pattern,
+                                     const Node& input,
+                                     const Captures& captures) {
+  std::string capture_name;
+  if (is_capture(pattern, &capture_name)) {
+    const auto previous = captures.single.find(capture_name);
+    if (previous != captures.single.end()) {
+      return structurally_equal(*previous->second, input) ? std::vector<Captures>{captures}
+                                                         : std::vector<Captures>{};
+    }
+    auto result = captures;
+    result.single[capture_name] = &input;
+    return {std::move(result)};
+  }
+
+  if (pattern.is_list != input.is_list) {
+    return {};
+  }
+  if (!pattern.is_list) {
+    return pattern.atom == input.atom ? std::vector<Captures>{captures}
+                                      : std::vector<Captures>{};
+  }
+  return match_children_all(pattern.children, 0, input.children, 0, captures);
+}
+
+bool match_sibling_sequence(const std::vector<Node>& patterns,
+                            const std::vector<Node>& inputs,
+                            size_t start,
+                            Captures* captures,
+                            size_t* count) {
+  if (start > inputs.size()) {
+    return false;
+  }
+
+  // A top-level rule sequence intentionally has a fixed number of forms. Variable-length captures
+  // belong inside a form, where their surrounding list gives them an unambiguous boundary.
+  if (start + patterns.size() > inputs.size()) {
+    return false;
+  }
+  std::vector<Captures> matches{*captures};
+  for (size_t i = 0; i < patterns.size(); ++i) {
+    std::vector<Captures> next;
+    for (const auto& current : matches) {
+      auto node_matches = match_node_all(patterns.at(i), inputs.at(start + i), current);
+      next.insert(next.end(), std::make_move_iterator(node_matches.begin()),
+                  std::make_move_iterator(node_matches.end()));
+    }
+    if (next.empty()) {
+      return false;
+    }
+    matches = std::move(next);
+  }
+  *captures = std::move(matches.front());
+  *count = patterns.size();
+  return true;
+}
+
+std::string original_text(const Node& node, const std::string& source) {
+  return source.substr(node.start, node.end - node.start);
+}
+
+std::string render_template(const Node& node,
+                            const Captures& captures,
+                            const std::string& source);
+
+std::string render_template_children(const std::vector<Node>& nodes,
+                                     const Captures& captures,
+                                     const std::string& source) {
+  std::string result;
+  for (const auto& child : nodes) {
+    std::string sequence_name;
+    if (is_sequence_capture(child, &sequence_name)) {
+      const auto found = captures.sequence.find(sequence_name);
+      if (found == captures.sequence.end()) {
+        throw std::runtime_error(
+            fmt::format("Unknown demacro sequence capture '$*{}'", sequence_name));
+      }
+      for (const auto* captured : found->second) {
+        if (!result.empty()) {
+          result += " ";
+        }
+        result += original_text(*captured, source);
+      }
+    } else {
+      if (!result.empty()) {
+        result += " ";
+      }
+      result += render_template(child, captures, source);
+    }
+  }
+  return result;
+}
+
+std::string render_template(const Node& node,
+                            const Captures& captures,
+                            const std::string& source) {
+  std::string capture_name;
+  if (is_capture(node, &capture_name)) {
+    const auto found = captures.single.find(capture_name);
+    if (found == captures.single.end()) {
+      throw std::runtime_error(fmt::format("Unknown demacro capture '${}'", capture_name));
+    }
+    return original_text(*found->second, source);
+  }
+  if (!node.is_list) {
+    return node.atom;
+  }
+  return "(" + render_template_children(node.children, captures, source) + ")";
+}
+
+std::string indentation_at(const std::string& source, uint32_t offset) {
+  const auto line_start = source.rfind('\n', offset == 0 ? 0 : offset - 1);
+  const auto start = line_start == std::string::npos ? 0 : line_start + 1;
+  size_t cursor = start;
+  while (cursor < offset && (source.at(cursor) == ' ' || source.at(cursor) == '\t')) {
+    ++cursor;
+  }
+  return source.substr(start, cursor - start);
+}
+
+std::string indent_after_newlines(std::string text, const std::string& indentation) {
+  size_t cursor = 0;
+  while ((cursor = text.find('\n', cursor)) != std::string::npos) {
+    ++cursor;
+    if (cursor < text.size()) {
+      text.insert(cursor, indentation);
+      cursor += indentation.size();
+    }
+  }
+  return text;
+}
+
+std::string render_rewrite(const CompiledRule& rule,
+                           const Candidate& candidate,
+                           const ParsedSource& parsed,
+                           const std::string& source) {
+  const auto indentation = indentation_at(source, candidate.start);
+  std::string replacement;
+  for (const auto& form : rule.rewrite) {
+    if (!replacement.empty()) {
+      replacement += "\n" + indentation;
+    }
+    replacement += indent_after_newlines(
+        render_template(form, candidate.captures, source), indentation);
+  }
+
+  // Comments are not part of semantic matching. Retain any comment which would otherwise be
+  // swallowed by replacing a multi-form expansion. Comments already inside a raw captured form are
+  // present in replacement and are not duplicated.
+  std::string saved_comments;
+  for (const auto& comment : parsed.comments) {
+    if (comment.start < candidate.start || comment.end > candidate.end) {
+      continue;
+    }
+    const auto text = source.substr(comment.start, comment.end - comment.start);
+    if (replacement.find(text) == std::string::npos) {
+      if (!saved_comments.empty()) {
+        saved_comments += "\n" + indentation;
+      }
+      saved_comments += text;
+    }
+  }
+  if (!saved_comments.empty()) {
+    replacement = saved_comments + "\n" + indentation + replacement;
+  }
+  return replacement;
+}
+
+void find_candidates(const Node& parent,
+                     const std::vector<CompiledRule>& rules,
+                     std::vector<Candidate>* result) {
+  if (!parent.is_list) {
+    return;
+  }
+
+  for (size_t child_idx = 0; child_idx < parent.children.size(); ++child_idx) {
+    for (const auto& rule : rules) {
+      Captures captures;
+      size_t match_count = 0;
+      if (match_sibling_sequence(rule.match, parent.children, child_idx, &captures, &match_count)) {
+        result->push_back({parent.children.at(child_idx).start,
+                           parent.children.at(child_idx + match_count - 1).end, rule.index,
+                           std::move(captures)});
+      }
+    }
+  }
+
+  for (const auto& child : parent.children) {
+    find_candidates(child, rules, result);
+  }
+}
+
+std::vector<Candidate> select_non_overlapping(std::vector<Candidate> candidates) {
+  std::sort(candidates.begin(), candidates.end(), [](const Candidate& a, const Candidate& b) {
+    if (a.start != b.start) {
+      return a.start < b.start;
+    }
+    if (a.rule_index != b.rule_index) {
+      return a.rule_index < b.rule_index;
+    }
+    return a.end < b.end;
+  });
+
+  std::vector<Candidate> result;
+  uint32_t last_end = 0;
+  bool have_last = false;
+  for (auto& candidate : candidates) {
+    if (have_last && candidate.start < last_end) {
+      continue;
+    }
+    last_end = candidate.end;
+    have_last = true;
+    result.push_back(std::move(candidate));
+  }
+  return result;
+}
+
+std::vector<CompiledRule> compile_rules(const RuleSet& rules) {
+  std::vector<CompiledRule> result;
+  for (size_t i = 0; i < rules.rules.size(); ++i) {
+    const auto& rule = rules.rules.at(i);
+    if (rule.match.empty()) {
+      throw std::runtime_error(fmt::format("Demacro rule '{}' has an empty match", rule.name));
+    }
+    if (rule.rewrite.empty()) {
+      throw std::runtime_error(fmt::format("Demacro rule '{}' has an empty rewrite", rule.name));
+    }
+    result.push_back({rule.name,
+                      parse_form_sequence(rule.match, "match for demacro rule " + rule.name),
+                      parse_form_sequence(rule.rewrite, "rewrite for demacro rule " + rule.name),
+                      i});
+  }
+  return result;
+}
+
+RewriteResult rewrite_compiled(const std::string& source,
+                               const RuleSet& rules,
+                               const std::vector<CompiledRule>& compiled) {
+  RewriteResult result;
+  result.source = source;
+  for (const auto& rule : rules.rules) {
+    result.stats.push_back({rule.name, 0});
+  }
+
+  // Reparse after each batch so patterns created by another rewrite can be recognized, while a
+  // malformed or cyclic rule file cannot loop forever.
+  constexpr int kMaxPasses = 100;
+  for (int pass = 0; pass < kMaxPasses; ++pass) {
+    const auto parsed = parse_source(result.source, "<OpenGOAL source>");
+    std::vector<Candidate> candidates;
+    find_candidates(parsed.root, compiled, &candidates);
+    auto selected = select_non_overlapping(std::move(candidates));
+    if (selected.empty()) {
+      return result;
+    }
+
+    std::vector<Edit> edits;
+    edits.reserve(selected.size());
+    for (const auto& candidate : selected) {
+      edits.push_back({candidate.start, candidate.end, candidate.rule_index,
+                       render_rewrite(compiled.at(candidate.rule_index), candidate, parsed,
+                                      result.source)});
+      result.stats.at(candidate.rule_index).rewrites++;
+    }
+    for (auto edit = edits.rbegin(); edit != edits.rend(); ++edit) {
+      result.source.replace(edit->start, edit->end - edit->start, edit->replacement);
+    }
+  }
+
+  throw std::runtime_error("Demacro exceeded 100 rewrite passes; the rule set is probably cyclic");
+}
+
+struct CachedRuleSet {
+  RuleSet rules;
+  std::vector<CompiledRule> compiled;
+};
+
+const CachedRuleSet& load_cached_rules(const fs::path& path) {
+  static std::mutex cache_mutex;
+  static std::unordered_map<std::string, std::unique_ptr<CachedRuleSet>> cache;
+
+  const auto key = fs::absolute(path).lexically_normal().string();
+  std::lock_guard<std::mutex> lock(cache_mutex);
+  const auto existing = cache.find(key);
+  if (existing != cache.end()) {
+    return *existing->second;
+  }
+
+  auto loaded = std::make_unique<CachedRuleSet>();
+  loaded->rules = load_rules(path);
+  loaded->compiled = compile_rules(loaded->rules);
+  return *cache.emplace(key, std::move(loaded)).first->second;
+}
+
+}  // namespace
+
+int RewriteResult::rewrite_count() const {
+  int result = 0;
+  for (const auto& stat : stats) {
+    result += stat.rewrites;
+  }
+  return result;
+}
+
+RuleSet parse_rules(const std::string& contents, const std::string& source_name) {
+  const auto json = parse_commented_json(contents, source_name);
+  if (!json.is_object() || !json.contains("rules") || !json.at("rules").is_array()) {
+    throw std::runtime_error(fmt::format("{} must contain a 'rules' array", source_name));
+  }
+
+  std::unordered_map<std::string, std::vector<std::unordered_map<std::string, std::string>>> tables;
+  if (json.contains("tables")) {
+    if (!json.at("tables").is_object()) {
+      throw std::runtime_error(fmt::format("{} field 'tables' must be an object", source_name));
+    }
+    for (const auto& [table_name, rows] : json.at("tables").items()) {
+      if (!rows.is_array()) {
+        throw std::runtime_error(
+            fmt::format("{} table '{}' must be an array", source_name, table_name));
+      }
+      for (const auto& row : rows) {
+        if (!row.is_object()) {
+          throw std::runtime_error(
+              fmt::format("{} table '{}' contains a non-object row", source_name, table_name));
+        }
+        std::unordered_map<std::string, std::string> values;
+        for (const auto& [key, value] : row.items()) {
+          if (!value.is_string()) {
+            throw std::runtime_error(fmt::format(
+                "{} table '{}' row values must be strings", source_name, table_name));
+          }
+          values[key] = value.get<std::string>();
+        }
+        tables[table_name].push_back(std::move(values));
+      }
+    }
+  }
+
+  RuleSet result;
+  for (const auto& entry : json.at("rules")) {
+    if (!entry.is_object()) {
+      throw std::runtime_error(fmt::format("{} contains a non-object rule", source_name));
+    }
+    if (entry.contains("for_each")) {
+      const auto table_name = entry.at("for_each").get<std::string>();
+      const auto table = tables.find(table_name);
+      if (table == tables.end()) {
+        throw std::runtime_error(fmt::format("Demacro rule '{}' refers to unknown table '{}'",
+                                             entry.at("name").get<std::string>(), table_name));
+      }
+      for (size_t i = 0; i < table->second.size(); ++i) {
+        result.rules.push_back(parse_rule(entry, table->second.at(i),
+                                          fmt::format("[{}:{}]", table_name, i)));
+      }
+    } else {
+      result.rules.push_back(parse_rule(entry, {}, ""));
+    }
+  }
+  return result;
+}
+
+RuleSet load_rules(const fs::path& path) {
+  return parse_rules(file_util::read_text_file(path), path.string());
+}
+
+RewriteResult rewrite(const std::string& source, const RuleSet& rules) {
+  return rewrite_compiled(source, rules, compile_rules(rules));
+}
+
+RewriteResult rewrite(const std::string& source, const fs::path& rule_path) {
+  const auto& cached = load_cached_rules(rule_path);
+  return rewrite_compiled(source, cached.rules, cached.compiled);
+}
+
+}  // namespace demacro

common/demacro/demacro.h

@@ -0,0 +1,38 @@
+#pragma once
+
+#include <string>
+#include <vector>
+
+#include "common/util/FileUtil.h"
+
+namespace demacro {
+
+struct Rule {
+  std::string name;
+  std::vector<std::string> match;
+  std::vector<std::string> rewrite;
+};
+
+struct RuleSet {
+  std::vector<Rule> rules;
+};
+
+struct RuleStat {
+  std::string name;
+  int rewrites = 0;
+};
+
+struct RewriteResult {
+  std::string source;
+  std::vector<RuleStat> stats;
+
+  int rewrite_count() const;
+};
+
+RuleSet parse_rules(const std::string& contents, const std::string& source_name = "<rules>");
+RuleSet load_rules(const fs::path& path);
+
+RewriteResult rewrite(const std::string& source, const RuleSet& rules);
+RewriteResult rewrite(const std::string& source, const fs::path& rule_path);
+
+}  // namespace demacro

common/type_system/TypeSystem.cpp

@@ -1151,6 +1151,21 @@ void TypeSystem::add_builtin_types(GameVersion version) {
   auto uint_type = add_builtin_value_type("uinteger", "uint", 8, false, false);
   uint_type->disallow_in_runtime();
 
+  // Jak 1's built-in mem-usage method takes these traversal/classification flags. The method is
+  // declared before any GOAL source is loaded, so its argument enum must also be a built-in type.
+  if (version == GameVersion::Jak1) {
+    const std::unordered_map<std::string, s64> mem_usage_flag_entries = {
+        {"prototype-data", 0},    {"instance-colors", 1},   {"tie-geometry-1", 2},
+        {"tie-geometry-2", 3},    {"tie-geometry-3", 4},    {"include-dead-pools", 5},
+        {"resource-entity", 6},   {"resource-ambient", 7},  {"resource-camera", 8},
+        {"resource-joint-geo", 9}};
+    auto* parent = get_type_of_type<ValueType>("uint32");
+    auto flags =
+        std::make_unique<EnumType>(parent, "mem-usage-flags", true, mem_usage_flag_entries);
+    flags->set_runtime_type(parent->get_runtime_name());
+    add_type("mem-usage-flags", std::move(flags));
+  }
+
   // Methods and Fields
   forward_declare_type_as("memory-usage-block", "basic");
 
@@ -1169,7 +1184,11 @@ void TypeSystem::add_builtin_types(GameVersion version) {
   declare_method(obj_type, "relocate", {}, false,
                  make_function_typespec({"_type_", "int"}, "_type_"), false);
   declare_method(obj_type, "mem-usage", {}, false,
-                 make_function_typespec({"_type_", "memory-usage-block", "int"}, "_type_"), false);
+                 make_function_typespec(
+                     {"_type_", "memory-usage-block",
+                      version == GameVersion::Jak1 ? "mem-usage-flags" : "int"},
+                     "_type_"),
+                 false);
 
   // STRUCTURE
   // structure new doesn't support dynamic sizing, which is kinda weird - it grabs the size from

decompiler/IR2/FormExpressionAnalysis.cpp

@@ -3150,7 +3150,8 @@ bool try_to_rewrite_vector_inline_ctor(const Env& env,
 }
 
 bool try_to_rewrite_matrix_inline_copy(const Env& env, FormPool& pool, FormStack& stack) {
-  if (env.func->name() == "(method 63 collide-shape-moving)") {
+  if (env.func->name() == "matrix-copy!" ||
+      env.func->name() == "(method 63 collide-shape-moving)") {
     return false;
   }
   auto matrix_entries =
@@ -3158,13 +3159,21 @@ bool try_to_rewrite_matrix_inline_copy(const Env& env, FormPool& pool, FormStack
   if (matrix_entries) {
     // first, check the loads. they should be something like source = (-> MAT vec quad)
     // MAT should always be a variable
-    const char* names[] = {"rvec", "uvec", "fvec", "trans"};
-
     std::vector<RegisterAccess> load_src_ras, store_dest_ras, store_src_ras;
     for (int i = 0; i < 4; i++) {
-      auto deref_matcher =
-          Matcher::deref(Matcher::any_reg(0), false,
-                         {DerefTokenMatcher::string(names[i]), DerefTokenMatcher::string("quad")});
+      Matcher deref_matcher;
+      if (env.version == GameVersion::Jak1) {
+        deref_matcher = Matcher::deref(
+            Matcher::any_reg(0), false,
+            {DerefTokenMatcher::string("vector"), DerefTokenMatcher::integer(i),
+             DerefTokenMatcher::string("quad")});
+      } else {
+        const char* names[] = {"rvec", "uvec", "fvec", "trans"};
+        deref_matcher =
+            Matcher::deref(Matcher::any_reg(0), false,
+                           {DerefTokenMatcher::string(names[i]),
+                            DerefTokenMatcher::string("quad")});
+      }
       auto mr = match(deref_matcher, matrix_entries->at(i).source, &env);
       if (!mr.matched) {
         return false;
@@ -3174,10 +3183,20 @@ bool try_to_rewrite_matrix_inline_copy(const Env& env, FormPool& pool, FormStack
 
     // check the stores
     for (int i = 4; i < 8; i++) {
-      Matcher matcher = Matcher::set(Matcher::deref(Matcher::any_reg(0), false,
-                                                    {DerefTokenMatcher::string(names[i - 4]),
-                                                     DerefTokenMatcher::string("quad")}),
-                                     Matcher::any_reg(1));
+      Matcher dst_matcher;
+      if (env.version == GameVersion::Jak1) {
+        dst_matcher = Matcher::deref(
+            Matcher::any_reg(0), false,
+            {DerefTokenMatcher::string("vector"), DerefTokenMatcher::integer(i - 4),
+             DerefTokenMatcher::string("quad")});
+      } else {
+        const char* names[] = {"rvec", "uvec", "fvec", "trans"};
+        dst_matcher =
+            Matcher::deref(Matcher::any_reg(0), false,
+                           {DerefTokenMatcher::string(names[i - 4]),
+                            DerefTokenMatcher::string("quad")});
+      }
+      Matcher matcher = Matcher::set(dst_matcher, Matcher::any_reg(1));
       auto mr = match(matcher, matrix_entries->at(i).elt, &env);
       if (!mr.matched) {
         return false;
@@ -3356,6 +3375,8 @@ bool try_to_rewrite_matrix_inline_ctor(const Env& env, FormPool& pool, FormStack
           }
         }
       } break;
+      case GameVersion::JakX:
+        return false;
     }
 
     // success!
@@ -3380,6 +3401,50 @@ bool is_deref_to_quad(DerefElement* deref) {
          deref->tokens().back().is_field_name("quad");
 }
 
+struct DerefContainerInfo {
+  TypeSpec type;
+  bool is_matrix_row = false;
+};
+
+std::optional<DerefContainerInfo> deref_container_info(DerefElement* deref, const Env& env) {
+  if (!is_deref_to_quad(deref)) {
+    return {};
+  }
+
+  auto base = deref->base()->try_as_element<SimpleExpressionElement>();
+  if (!base || base->expr().kind() != SimpleExpression::Kind::IDENTITY ||
+      !base->expr().get_arg(0).is_var()) {
+    return {};
+  }
+
+  TypeSpec current = env.get_variable_type(base->expr().get_arg(0).var(), true);
+  bool is_matrix_row = current == TypeSpec("matrix") || current == TypeSpec("matrix3");
+  for (size_t i = 0; i + 1 < deref->tokens().size(); ++i) {
+    const auto& token = deref->tokens().at(i);
+    if (token.kind() == DerefToken::Kind::FIELD_NAME) {
+      try {
+        current = env.dts->ts.lookup_field_info(current.base_type(), token.field_name()).type;
+      } catch (const std::exception&) {
+        return {};
+      }
+    } else if (token.kind() == DerefToken::Kind::INTEGER_CONSTANT ||
+               token.kind() == DerefToken::Kind::INTEGER_EXPRESSION) {
+      if (!current.has_single_arg()) {
+        return {};
+      }
+      // get_single_arg() refers into current, so copy it before assignment destroys the argument
+      // storage.
+      const auto element_type = current.get_single_arg();
+      current = element_type;
+    } else {
+      return {};
+    }
+    is_matrix_row =
+        is_matrix_row || current == TypeSpec("matrix") || current == TypeSpec("matrix3");
+  }
+  return DerefContainerInfo{current, is_matrix_row};
+}
+
 Form* pop_last_deref_token(Form* form) {
   auto deref = form->try_as_element<DerefElement>();
   ASSERT(deref);
@@ -3392,9 +3457,7 @@ Form* pop_last_deref_token(Form* form) {
 }
 
 FormElement* try_to_rewrite_vector_copy(Form* dst,
-                                        const TypeSpec& dst_type,
                                         Form* src,
-                                        const TypeSpec& src_type,
                                         FormPool& pool,
                                         const Env& env) {
   if (env.func->name() == "vector-copy!") {
@@ -3402,16 +3465,6 @@ FormElement* try_to_rewrite_vector_copy(Form* dst,
   }
 
   if (dst && src) {
-    // check types
-    if (dst_type != TypeSpec("vector")) {
-      return nullptr;
-    }
-
-    // kinda sus - we really want to check the place where this was loaded...
-    if (src_type != TypeSpec("uint128")) {
-      return nullptr;
-    }
-
     auto* dst_deref = dst->try_as_element<DerefElement>();
     auto* src_deref = src->try_as_element<DerefElement>();
     if (!dst_deref) {
@@ -3422,11 +3475,17 @@ FormElement* try_to_rewrite_vector_copy(Form* dst,
       return nullptr;
     }
 
-    if (!is_deref_to_quad(dst_deref)) {
+    const auto dst_info = deref_container_info(dst_deref, env);
+    const auto src_info = deref_container_info(src_deref, env);
+    if (!dst_info || !src_info ||
+        !env.dts->ts.tc(TypeSpec("vector"), dst_info->type) ||
+        !env.dts->ts.tc(TypeSpec("vector"), src_info->type)) {
       return nullptr;
     }
 
-    if (!is_deref_to_quad(src_deref)) {
+    // A matrix row is represented by an inline vector, but folding its individual quadword copy
+    // would prevent the four-row matrix-copy! recognizer from seeing the complete operation.
+    if (dst_info->is_matrix_row || src_info->is_matrix_row) {
       return nullptr;
     }
 
@@ -3439,6 +3498,39 @@ FormElement* try_to_rewrite_vector_copy(Form* dst,
   return nullptr;
 }
 
+FormElement* try_to_rewrite_vector_zero(Form* dst,
+                                        Form* value,
+                                        FormPool& pool,
+                                        const Env& env) {
+  if (env.func->name() == "vector-zero!") {
+    return nullptr;
+  }
+
+  auto dst_deref = dst ? dst->try_as_element<DerefElement>() : nullptr;
+  const auto dst_info = dst_deref ? deref_container_info(dst_deref, env) : std::nullopt;
+  if (!dst_info || !env.dts->ts.tc(TypeSpec("vector"), dst_info->type) ||
+      dst_info->is_matrix_row) {
+    return nullptr;
+  }
+  if (!match(Matcher::cast("uint128", Matcher::integer(0)), value, &env).matched) {
+    return nullptr;
+  }
+
+  return pool.alloc_element<GenericElement>(
+      GenericOperator::make_function(pool.form<ConstantTokenElement>("vector-zero!")),
+      std::vector<Form*>{pop_last_deref_token(dst)});
+}
+
+bool is_pending_stack_vector_ctor(const FormStack& stack, RegisterAccess destination) {
+  auto entries = stack.try_getting_active_stack_entries({true});
+  if (!entries || !entries->front().destination ||
+      entries->front().destination->reg() != destination.reg()) {
+    return false;
+  }
+  auto stack_value = entries->front().source->try_as_element<StackStructureDefElement>();
+  return stack_value && stack_value->type() == TypeSpec("vector");
+}
+
 }  // namespace
 
 void StorePlainDeref::push_to_stack(const Env& env, FormPool& pool, FormStack& stack) {
@@ -3462,11 +3554,9 @@ void StorePlainDeref::push_to_stack(const Env& env, FormPool& pool, FormStack& s
 
     FormElement* fr = nullptr;
 
-    // hack: for now only do this on Jak 3
-    if (size() == 16 && env.version == GameVersion::Jak3) {
-      fr = try_to_rewrite_vector_copy(
-          m_dst, env.get_variable_type(m_base_var, true), popped.at(0),
-          m_src_cast_type.value_or(env.get_variable_type(m_expr.var(), true)), pool, env);
+    if (size() == 16 &&
+        (env.version == GameVersion::Jak1 || env.version == GameVersion::Jak3)) {
+      fr = try_to_rewrite_vector_copy(m_dst, popped.at(0), pool, env);
     }
 
     if (!fr) {
@@ -3486,10 +3576,19 @@ void StorePlainDeref::push_to_stack(const Env& env, FormPool& pool, FormStack& s
     m_dst->try_as_element<DerefElement>()->inline_nested();
     auto val = pool.form<SimpleExpressionElement>(m_expr, m_my_idx);
     val->mark_popped();
-    auto fr = pool.alloc_element<SetFormFormElement>(
-        m_dst, make_optional_cast(m_src_cast_type, val, pool, env));
-    fr->mark_popped();
-    stack.push_form_element(fr, true);
+    auto typed_value = make_optional_cast(m_src_cast_type, val, pool, env);
+    FormElement* fr = nullptr;
+    if (size() == 16 && env.version == GameVersion::Jak1 &&
+        !is_pending_stack_vector_ctor(stack, m_base_var)) {
+      fr = try_to_rewrite_vector_zero(m_dst, typed_value, pool, env);
+    }
+    if (!fr) {
+      fr = pool.alloc_element<SetFormFormElement>(m_dst, typed_value);
+      fr->mark_popped();
+      stack.push_form_element(fr, true);
+    } else {
+      fr->push_to_stack(env, pool, stack);
+    }
   }
 
   if (!try_to_rewrite_matrix_inline_ctor(env, pool, stack)) {

decompiler/ObjectFile/ObjectFileDB_IR2.cpp

@@ -5,6 +5,7 @@
 
 #include "ObjectFileDB.h"
 
+#include "common/demacro/demacro.h"
 #include "common/formatter/formatter.h"
 #include "common/goos/PrettyPrinter.h"
 #include "common/link_types.h"
@@ -880,6 +881,10 @@ void ObjectFileDB::ir2_write_results(const fs::path& output_dir,
     file_util::write_text_file(file_name, file_text);
 
     auto unformatted_code = ir2_final_out(obj, imports, {});
+    if (!config.demacro_file.empty()) {
+      unformatted_code =
+          demacro::rewrite(unformatted_code, file_util::get_file_path({config.demacro_file})).source;
+    }
     auto final_name = output_dir / (obj.to_unique_name() + "_disasm.gc");
     if (config.format_code) {
       const auto formatted_code = formatter::format_code(unformatted_code);

decompiler/config.cpp

@@ -46,6 +46,9 @@ Config make_config_via_json(nlohmann::json& json) {
     config.expected_elf_name = json.at("expected_elf_name").get<std::string>();
   }
   config.all_types_file = json.at("all_types_file").get<std::string>();
+  if (json.contains("demacro_file")) {
+    config.demacro_file = json.at("demacro_file").get<std::string>();
+  }
 
   auto inputs_json = read_json_file_from_config(json, "inputs_file");
   config.dgo_names = json.contains("dgo_names")

decompiler/config.h

@@ -106,6 +106,7 @@ struct Config {
 
   std::string obj_file_name_map_file;
   std::string all_types_file;
+  std::string demacro_file;
 
   bool disassemble_code = false;
   bool dump_function_metadata = false;

decompiler/config/jak1/all-types.gc

@@ -19576,10 +19576,15 @@ the original scratchpad decompressor remains available through the development s
 (define-extern mem-size
   "Collect value's memory categories using flags, optionally print the complete category table,
    and return the sum of aligned total bytes."
-  (function basic symbol int int))
+  (function basic symbol mem-usage-flags int))
 (define-extern jacc-mem-usage
   "Account for a compressed animation control block, its fixed data, and each compressed frame."
-  (function joint-anim-compressed-control memory-usage-block int joint-anim-compressed-control))
+  (function
+    joint-anim-compressed-control
+    memory-usage-block
+    mem-usage-flags
+    joint-anim-compressed-control
+    ))
 (define-extern joint-anim-inspect-elt
   "Inspect the payload element selected by rounding index to an integer. Matrix and transformq
 animations have specialized displays; other animation payload types are left unchanged."
@@ -19722,7 +19727,7 @@ under label, then add those totals into the aggregate collision statistics."
 (define-extern mem-usage-bsp-tree
   "Recursively count the 32-byte internal nodes reachable from node in the BSP-node memory
 category. Nonpositive terminal children are not followed; header and flags are unused."
-  (function bsp-header bsp-node memory-usage-block int none))
+  (function bsp-header bsp-node memory-usage-block mem-usage-flags none))
 (define-extern bsp-camera-asm
   "Traverse the BSP for camera-position. At each split, select front when
 dot(camera-position, plane.xyz) - plane.w is nonnegative. Store the terminal leaf index and that
@@ -21384,7 +21389,7 @@ instance distance to the level."
 (define-extern mem-usage-shrub-walk
   "Recursively account for node storage and leaf instance-shrubbery records across node-count
    contiguous shrub BVH roots. flags is forwarded for the memory-usage traversal."
-  (function draw-node int memory-usage-block int draw-node))
+  (function draw-node int memory-usage-block mem-usage-flags draw-node))
 (define-extern shrub-make-perspective-matrix
   "Copy the current camera transform to out, divide its homogeneous coefficients by pfog0, and fold
    the horizontal, vertical, depth, and fog offsets into the first three components."

decompiler/config/jak1/demacro.jsonc

@@ -0,0 +1,407 @@
+{
+  // Patterns are matched against LISP forms after type analysis, expression construction, and
+  // let insertion have finished. A `$name` atom captures one form; repeated captures must match
+  // structurally. `$*name` captures zero or more forms within a list, which lets a rule tolerate
+  // unrelated bindings merged into a compiler-generated let.
+  //
+  // `match` and `rewrite` may be either one form string or an array of adjacent form strings.
+  // Rules are tried in file order. Keep rules conservative: this pass intentionally has no type
+  // information with which to disambiguate structurally identical operations.
+  "tables": {
+    // Mirrors memory-usage-h.gc. `next` is the one-past category index stored in
+    // memory-usage-block.length.
+    "mem-usage-id": [
+      {"value": "0", "next": "1", "symbol": "drawable-group"},
+      {"value": "1", "next": "2", "symbol": "tfragment"},
+      {"value": "2", "next": "3", "symbol": "tfragment-base"},
+      {"value": "3", "next": "4", "symbol": "tfragment-common"},
+      {"value": "4", "next": "5", "symbol": "tfragment-level0"},
+      {"value": "5", "next": "6", "symbol": "tfragment-level1"},
+      {"value": "6", "next": "7", "symbol": "tfragment-color"},
+      {"value": "7", "next": "8", "symbol": "tfragment-debug"},
+      {"value": "8", "next": "9", "symbol": "tfragment-pal"},
+      {"value": "9", "next": "10", "symbol": "tie-fragment"},
+      {"value": "10", "next": "11", "symbol": "tie-gif"},
+      {"value": "11", "next": "12", "symbol": "tie-points"},
+      {"value": "12", "next": "13", "symbol": "tie-colors"},
+      {"value": "13", "next": "14", "symbol": "tie-draw-points"},
+      {"value": "14", "next": "15", "symbol": "tie-debug"},
+      {"value": "15", "next": "16", "symbol": "tie-near"},
+      {"value": "16", "next": "17", "symbol": "tie-pal"},
+      {"value": "17", "next": "18", "symbol": "tie-generic"},
+      {"value": "18", "next": "19", "symbol": "instance-tie"},
+      {"value": "19", "next": "20", "symbol": "instance-tie-colors0"},
+      {"value": "20", "next": "21", "symbol": "instance-tie-colors1"},
+      {"value": "21", "next": "22", "symbol": "instance-tie-colors2"},
+      {"value": "22", "next": "23", "symbol": "instance-tie-colors3"},
+      {"value": "23", "next": "24", "symbol": "instance-tie-colors*"},
+      {"value": "24", "next": "25", "symbol": "prototype-bucket-shrub"},
+      {"value": "25", "next": "26", "symbol": "generic-shrub"},
+      {"value": "26", "next": "27", "symbol": "generic-shrub-data"},
+      {"value": "27", "next": "28", "symbol": "shrubbery"},
+      {"value": "28", "next": "29", "symbol": "shrubbery-object"},
+      {"value": "29", "next": "30", "symbol": "shrubbery-vertex"},
+      {"value": "30", "next": "31", "symbol": "shrubbery-color"},
+      {"value": "31", "next": "32", "symbol": "shrubbery-stq"},
+      {"value": "32", "next": "33", "symbol": "shrubbery-pal"},
+      {"value": "33", "next": "34", "symbol": "billboard"},
+      {"value": "34", "next": "35", "symbol": "instance-shrubbery"},
+      {"value": "35", "next": "36", "symbol": "pris-fragment"},
+      {"value": "43", "next": "44", "symbol": "entity"},
+      {"value": "44", "next": "45", "symbol": "camera"},
+      {"value": "45", "next": "46", "symbol": "nav-mesh"},
+      {"value": "48", "next": "49", "symbol": "res"},
+      {"value": "49", "next": "50", "symbol": "ambient"},
+      {"value": "50", "next": "51", "symbol": "collide-fragment-0"},
+      {"value": "51", "next": "52", "symbol": "collision-poly-0"},
+      {"value": "52", "next": "53", "symbol": "collision-vertex-0"},
+      {"value": "53", "next": "54", "symbol": "collide-fragment-1"},
+      {"value": "54", "next": "55", "symbol": "collision-poly-1"},
+      {"value": "55", "next": "56", "symbol": "collision-vertex-1"},
+      {"value": "56", "next": "57", "symbol": "bsp-main"},
+      {"value": "57", "next": "58", "symbol": "bsp-misc"},
+      {"value": "58", "next": "59", "symbol": "bsp-node"},
+      {"value": "59", "next": "60", "symbol": "bsp-leaf-vis-self"},
+      {"value": "60", "next": "61", "symbol": "bsp-leaf-vis-adj"},
+      {"value": "61", "next": "62", "symbol": "draw-node"},
+      {"value": "62", "next": "63", "symbol": "pat"},
+      {"value": "63", "next": "64", "symbol": "level-code"},
+      {"value": "64", "next": "65", "symbol": "entity-links"},
+      {"value": "65", "next": "66", "symbol": "joint"},
+      {"value": "66", "next": "67", "symbol": "joint-anim-compressed"},
+      {"value": "67", "next": "68", "symbol": "joint-anim-compressed-control"},
+      {"value": "68", "next": "69", "symbol": "joint-anim-fixed"},
+      {"value": "69", "next": "70", "symbol": "joint-anim-frame"},
+      {"value": "70", "next": "71", "symbol": "art-group"},
+      {"value": "71", "next": "72", "symbol": "art-mesh-anim"},
+      {"value": "72", "next": "73", "symbol": "art-mesh-geo"},
+      {"value": "73", "next": "74", "symbol": "art-joint-geo"},
+      {"value": "74", "next": "75", "symbol": "art-joint-anim"},
+      {"value": "75", "next": "76", "symbol": "merc-ctrl"},
+      {"value": "76", "next": "77", "symbol": "joint-anim-drawable"},
+      {"value": "77", "next": "78", "symbol": "blend-shape"},
+      {"value": "78", "next": "79", "symbol": "collide-mesh"},
+      {"value": "79", "next": "80", "symbol": "texture"},
+      {"value": "80", "next": "81", "symbol": "string"},
+      {"value": "81", "next": "82", "symbol": "array"},
+      {"value": "82", "next": "83", "symbol": "sprite"},
+      {"value": "83", "next": "84", "symbol": "depth-cue"},
+      {"value": "84", "next": "85", "symbol": "debug"},
+      {"value": "85", "next": "86", "symbol": "sky"},
+      {"value": "86", "next": "87", "symbol": "pris-generic"},
+      {"value": "87", "next": "88", "symbol": "4k-dead-pool"},
+      {"value": "88", "next": "89", "symbol": "8k-dead-pool"},
+      {"value": "89", "next": "90", "symbol": "16k-dead-pool"},
+      {"value": "90", "next": "91", "symbol": "nk-dead-pool"},
+      {"value": "91", "next": "92", "symbol": "target-dead-pool"},
+      {"value": "92", "next": "93", "symbol": "camera-dead-pool"},
+      {"value": "93", "next": "94", "symbol": "debug-dead-pool"},
+      {"value": "94", "next": "95", "symbol": "process-active"},
+      {"value": "95", "next": "96", "symbol": "heap-total"},
+      {"value": "96", "next": "97", "symbol": "heap-process"},
+      {"value": "97", "next": "98", "symbol": "heap-header"},
+      {"value": "98", "next": "99", "symbol": "heap-thread"},
+      {"value": "99", "next": "100", "symbol": "heap-root"},
+      {"value": "100", "next": "101", "symbol": "heap-draw-control"},
+      {"value": "101", "next": "102", "symbol": "heap-joint-control"},
+      {"value": "102", "next": "103", "symbol": "heap-cspace"},
+      {"value": "103", "next": "104", "symbol": "heap-bone"},
+      {"value": "104", "next": "105", "symbol": "heap-part"},
+      {"value": "105", "next": "106", "symbol": "heap-collide-prim"},
+      {"value": "106", "next": "107", "symbol": "heap-misc"},
+      {"value": "107", "next": "108", "symbol": "shadow-geo"},
+      {"value": "108", "next": "109", "symbol": "eye-anim"}
+    ],
+    "scratchpad-object-type": [
+      {"type": "terrain-context"},
+      {"type": "cam-dbg-scratch"},
+      {"type": "terrain-bsp"},
+      {"type": "collide-puss-work"},
+      {"type": "vector"},
+      {"type": "vector4w"},
+      {"type": "bone-memory"},
+      {"type": "joint"},
+      {"type": "bone"},
+      {"type": "vu-lights"},
+      {"type": "bone-regs"},
+      {"type": "matrix"},
+      {"type": "generic-tie-shadow"},
+      {"type": "generic-tie-calls"},
+      {"type": "collide-probe-stack"},
+      {"type": "ambient-list"},
+      {"type": "adgif-shader"},
+      {"type": "(inline-array ocean-vertex)"}
+    ],
+    "scratchpad-pointer-type": [
+      {"type": "rgba"},
+      {"type": "uint128"},
+      {"type": "process-drawable"}
+    ]
+  },
+  "rules": [
+    {
+      "name": "current-frame",
+      "match": "(-> *display* frames (-> *display* on-screen) frame)",
+      "rewrite": "(current-frame)"
+    },
+    {
+      // Let insertion can merge consecutive traversals which reuse the same node and cached-next
+      // locals. Peel off the first traversal and rebuild the remaining let; repeated rule passes
+      // then recover every traversal in the chain.
+      "name": "iterate-engine-connections-merged-let",
+      "match":
+        "(let (($node (-> $engine alive-list next0))) $engine (let (($next (-> $node next0))) (while (!= $node (-> $engine alive-list-end)) $*body (set! $node $next) $engine (set! $next (-> $next next0))) (set! $node (-> $next-engine alive-list next0)) $next-engine (set! $next (-> $node next0)) $*remaining))",
+      "rewrite": [
+        "(iterate-engine-connections ($node $engine) $*body)",
+        "(let (($node (-> $next-engine alive-list next0))) $next-engine (let (($next (-> $node next0))) $*remaining))"
+      ]
+    },
+    {
+      // Function-scoped locals produce assignments instead of let bindings around the traversal.
+      "name": "iterate-engine-connections-set-locals",
+      "match": [
+        "(set! $node (-> $engine alive-list next0))",
+        "$engine",
+        "(set! $next (-> $node next0))",
+        "(while (!= $node (-> $engine alive-list-end)) $*body (set! $node $next) $engine (set! $next (-> $next next0)))"
+      ],
+      "rewrite": "(iterate-engine-connections ($node $engine) $*body)"
+    },
+    {
+      // Constant engine globals sometimes survive as no-op forms around the cached-next traversal.
+      "name": "iterate-engine-connections-with-engine-forms",
+      "match":
+        "(let (($node (-> $engine alive-list next0))) $engine (let (($next (-> $node next0))) (while (!= $node (-> $engine alive-list-end)) $*body (set! $node $next) $engine (set! $next (-> $next next0)))))",
+      "rewrite": "(iterate-engine-connections ($node $engine) $*body)"
+    },
+    {
+      "name": "iterate-engine-connections-nested-let",
+      "match":
+        "(let (($node (-> $engine alive-list next0))) (let (($next (-> $node next0))) (while (!= $node (-> $engine alive-list-end)) $*body (set! $node $next) (set! $next (-> $next next0)))))",
+      "rewrite": "(iterate-engine-connections ($node $engine) $*body)"
+    },
+    {
+      "name": "iterate-engine-connections-let-star",
+      "match":
+        "(let* (($node (-> $engine alive-list next0)) ($next (-> $node next0))) (while (!= $node (-> $engine alive-list-end)) $*body (set! $node $next) (set! $next (-> $next next0))))",
+      "rewrite": "(iterate-engine-connections ($node $engine) $*body)"
+    },
+    {
+      // Preserve unrelated bindings which let insertion combined with the traversal's node local.
+      // Exact single-binding lets are handled above so this fallback never emits an empty let.
+      "name": "iterate-engine-connections-merged-bindings",
+      "match":
+        "(let ($*before ($node (-> $engine alive-list next0)) $*after) $engine (let (($next (-> $node next0))) (while (!= $node (-> $engine alive-list-end)) $*body (set! $node $next) $engine (set! $next (-> $next next0)))))",
+      "rewrite": "(let ($*before $*after) (iterate-engine-connections ($node $engine) $*body))"
+    },
+    {
+      "name": "with-dma-buffer-add-bucket",
+      "match":
+        "(let* (($buf $buffer) ($start (-> $buf base))) $*body (let (($edge (-> $buf base))) (let (($packet (the-as dma-packet (-> $buf base)))) (set! (-> $packet dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> $packet vif0) (new 'static 'vif-tag)) (set! (-> $packet vif1) (new 'static 'vif-tag)) (set! (-> $buf base) (&+ (the-as pointer $packet) 16))) (dma-bucket-insert-tag $bucket-group $bucket-id $start (the-as (pointer dma-tag) $edge))))",
+      "rewrite":
+        "(with-dma-buffer-add-bucket (($buf $buffer) $bucket-id) :bucket-group $bucket-group $*body)"
+    },
+    {
+      "name": "with-dma-buffer-add-bucket-pointer-add-cast",
+      "match":
+        "(let* (($buf $buffer) ($start (-> $buf base))) $*body (let (($edge (-> $buf base))) (let (($packet (the-as dma-packet (-> $buf base)))) (set! (-> $packet dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> $packet vif0) (new 'static 'vif-tag)) (set! (-> $packet vif1) (new 'static 'vif-tag)) (set! (-> $buf base) (the-as pointer (&+ $packet 16)))) (dma-bucket-insert-tag $bucket-group $bucket-id $start (the-as (pointer dma-tag) $edge))))",
+      "rewrite":
+        "(with-dma-buffer-add-bucket (($buf $buffer) $bucket-id) :bucket-group $bucket-group $*body)"
+    },
+    {
+      "name": "with-dma-buffer-add-bucket-object-packet",
+      "match":
+        "(let* (($buf $buffer) ($start (-> $buf base))) $*body (let (($edge (-> $buf base))) (let (($packet (the-as object (-> $buf base)))) (set! (-> (the-as dma-packet $packet) dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> (the-as dma-packet $packet) vif0) (new 'static 'vif-tag)) (set! (-> (the-as dma-packet $packet) vif1) (new 'static 'vif-tag)) (set! (-> $buf base) (&+ (the-as pointer $packet) 16))) (dma-bucket-insert-tag $bucket-group $bucket-id $start (the-as (pointer dma-tag) $edge))))",
+      "rewrite":
+        "(with-dma-buffer-add-bucket (($buf $buffer) $bucket-id) :bucket-group $bucket-group $*body)"
+    },
+    {
+      // The font setters are methods rather than macros, but Jak 1 inlines them. The enum
+      // constructors make these two field stores structurally unambiguous without type data.
+      "name": "font-set-color-conditional-aliased",
+      "match":
+        "(let (($alias $font)) (set! (-> $alias color) (if $condition (font-color $*true-colors) (font-color $*false-colors))))",
+      "rewrite":
+        "(set-color! $font (if $condition (font-color $*true-colors) (font-color $*false-colors)))"
+    },
+    {
+      "name": "font-set-color-aliased",
+      "match":
+        "(let (($alias $font)) (set! (-> $alias color) (font-color $*colors)))",
+      "rewrite": "(set-color! $font (font-color $*colors))"
+    },
+    {
+      "name": "font-set-color",
+      "match": "(set! (-> $font color) (font-color $*colors))",
+      "rewrite": "(set-color! $font (font-color $*colors))"
+    },
+    {
+      "name": "font-set-flags-aliased",
+      "match":
+        "(let (($alias $font)) (set! (-> $alias flags) (font-flags $*flags)))",
+      "rewrite": "(set-flags! $font (font-flags $*flags))"
+    },
+    {
+      "name": "font-set-flags",
+      "match": "(set! (-> $font flags) (font-flags $*flags))",
+      "rewrite": "(set-flags! $font (font-flags $*flags))"
+    },
+    {
+      "name": "mem-usage-add-{{symbol}}",
+      "for_each": "mem-usage-id",
+      "match": [
+        "(set! (-> $usage length) (max {{next}} (-> $usage length)))",
+        "(set! (-> $usage data {{value}} name) \"{{symbol}}\")",
+        "(+! (-> $usage data {{value}} count) $count)",
+        "(let (($temp $bytes)) (+! (-> $usage data {{value}} used) $temp) (+! (-> $usage data {{value}} total) (logand -16 (+ $temp 15))))"
+      ],
+      "rewrite": "(mem-usage-add! $usage {{symbol}} $count $bytes)"
+    },
+    {
+      "name": "mem-usage-add-enum-index-{{symbol}}",
+      "for_each": "mem-usage-id",
+      "match": [
+        "(set! (-> $usage length) (max {{next}} (-> $usage length)))",
+        "(set! (-> $usage data (mem-usage-id {{symbol}}) name) \"{{symbol}}\")",
+        "(+! (-> $usage data (mem-usage-id {{symbol}}) count) $count)",
+        "(let (($temp $bytes)) (+! (-> $usage data (mem-usage-id {{symbol}}) used) $temp) (+! (-> $usage data (mem-usage-id {{symbol}}) total) (logand -16 (+ $temp 15))))"
+      ],
+      "rewrite": "(mem-usage-add! $usage {{symbol}} $count $bytes)"
+    },
+    {
+      "name": "mem-usage-add-runtime-name-{{symbol}}",
+      "for_each": "mem-usage-id",
+      "match": [
+        "(set! (-> $usage length) (max {{next}} (-> $usage length)))",
+        "(set! (-> $usage data {{value}} name) (symbol->string '{{symbol}}))",
+        "(+! (-> $usage data {{value}} count) $count)",
+        "(let (($temp $bytes)) (+! (-> $usage data {{value}} used) $temp) (+! (-> $usage data {{value}} total) (logand -16 (+ $temp 15))))"
+      ],
+      "rewrite": "(mem-usage-add-symbol! $usage {{symbol}} $count $bytes)"
+    },
+    {
+      "name": "mem-usage-add-enum-index-runtime-name-{{symbol}}",
+      "for_each": "mem-usage-id",
+      "match": [
+        "(set! (-> $usage length) (max {{next}} (-> $usage length)))",
+        "(set! (-> $usage data (mem-usage-id {{symbol}}) name) (symbol->string '{{symbol}}))",
+        "(+! (-> $usage data (mem-usage-id {{symbol}}) count) $count)",
+        "(let (($temp $bytes)) (+! (-> $usage data (mem-usage-id {{symbol}}) used) $temp) (+! (-> $usage data (mem-usage-id {{symbol}}) total) (logand -16 (+ $temp 15))))"
+      ],
+      "rewrite": "(mem-usage-add-symbol! $usage {{symbol}} $count $bytes)"
+    },
+    {
+      "name": "mem-usage-add-flattened-let-{{symbol}}",
+      "for_each": "mem-usage-id",
+      "match": [
+        "(set! (-> $usage length) (max {{next}} (-> $usage length)))",
+        "(set! (-> $usage data {{value}} name) \"{{symbol}}\")",
+        "(+! (-> $usage data {{value}} count) $count)",
+        "(+! (-> $usage data {{value}} used) $bytes)",
+        "(+! (-> $usage data {{value}} total) (logand -16 (+ $bytes 15)))"
+      ],
+      "rewrite": "(mem-usage-add! $usage {{symbol}} $count $bytes)"
+    },
+    {
+      "name": "mem-usage-add-enum-index-flattened-let-{{symbol}}",
+      "for_each": "mem-usage-id",
+      "match": [
+        "(set! (-> $usage length) (max {{next}} (-> $usage length)))",
+        "(set! (-> $usage data (mem-usage-id {{symbol}}) name) \"{{symbol}}\")",
+        "(+! (-> $usage data (mem-usage-id {{symbol}}) count) $count)",
+        "(+! (-> $usage data (mem-usage-id {{symbol}}) used) $bytes)",
+        "(+! (-> $usage data (mem-usage-id {{symbol}}) total) (logand -16 (+ $bytes 15)))"
+      ],
+      "rewrite": "(mem-usage-add! $usage {{symbol}} $count $bytes)"
+    },
+    {
+      "name": "mem-usage-add-runtime-name-flattened-let-{{symbol}}",
+      "for_each": "mem-usage-id",
+      "match": [
+        "(set! (-> $usage length) (max {{next}} (-> $usage length)))",
+        "(set! (-> $usage data {{value}} name) (symbol->string '{{symbol}}))",
+        "(+! (-> $usage data {{value}} count) $count)",
+        "(+! (-> $usage data {{value}} used) $bytes)",
+        "(+! (-> $usage data {{value}} total) (logand -16 (+ $bytes 15)))"
+      ],
+      "rewrite": "(mem-usage-add-symbol! $usage {{symbol}} $count $bytes)"
+    },
+    {
+      "name": "mem-usage-add-enum-index-runtime-name-flattened-let-{{symbol}}",
+      "for_each": "mem-usage-id",
+      "match": [
+        "(set! (-> $usage length) (max {{next}} (-> $usage length)))",
+        "(set! (-> $usage data (mem-usage-id {{symbol}}) name) (symbol->string '{{symbol}}))",
+        "(+! (-> $usage data (mem-usage-id {{symbol}}) count) $count)",
+        "(+! (-> $usage data (mem-usage-id {{symbol}}) used) $bytes)",
+        "(+! (-> $usage data (mem-usage-id {{symbol}}) total) (logand -16 (+ $bytes 15)))"
+      ],
+      "rewrite": "(mem-usage-add-symbol! $usage {{symbol}} $count $bytes)"
+    },
+    {
+      // A zero increment is sometimes decompiled as a self-assignment instead of `(+! ... 0)`.
+      "name": "mem-usage-add-zero-count-{{symbol}}",
+      "for_each": "mem-usage-id",
+      "match": [
+        "(set! (-> $usage length) (max {{next}} (-> $usage length)))",
+        "(set! (-> $usage data {{value}} name) \"{{symbol}}\")",
+        "(set! (-> $usage data {{value}} count) (-> $usage data {{value}} count))",
+        "(let (($temp $bytes)) (+! (-> $usage data {{value}} used) $temp) (+! (-> $usage data {{value}} total) (logand -16 (+ $temp 15))))"
+      ],
+      "rewrite": "(mem-usage-add! $usage {{symbol}} 0 $bytes)"
+    },
+    {
+      // These adjacent calls share the larger one-past length after decompilation.
+      "name": "mem-usage-add-generic-shrub-pair",
+      "match": [
+        "(set! (-> $usage length) (max 27 (-> $usage length)))",
+        "(set! (-> $usage data 25 name) \"generic-shrub\")",
+        "(+! (-> $usage data 25 count) $header-count)",
+        "(let (($header-temp $header-bytes)) (+! (-> $usage data 25 used) $header-temp) (+! (-> $usage data 25 total) (logand -16 (+ $header-temp 15))))",
+        "(set! (-> $usage data 26 name) \"generic-shrub-data\")",
+        "(+! (-> $usage data 26 count) $stream-count)",
+        "(let (($stream-temp $stream-bytes)) (+! (-> $usage data 26 used) $stream-temp) (+! (-> $usage data 26 total) (logand -16 (+ $stream-temp 15))))"
+      ],
+      "rewrite": [
+        "(mem-usage-add! $usage generic-shrub $header-count $header-bytes)",
+        "(mem-usage-add! $usage generic-shrub-data $stream-count $stream-bytes)"
+      ]
+    },
+    {
+      "name": "scratchpad-object-direct-{{type}}",
+      "for_each": "scratchpad-object-type",
+      "match": "(the-as {{type}} #x70000000)",
+      "rewrite": "(scratchpad-object {{type}})"
+    },
+    {
+      "name": "scratchpad-object-offset-{{type}}",
+      "for_each": "scratchpad-object-type",
+      "match": "(the-as {{type}} (+ $offset #x70000000))",
+      "rewrite": "(scratchpad-object {{type}} :offset $offset)"
+    },
+    {
+      "name": "scratchpad-object-reversed-offset-{{type}}",
+      "for_each": "scratchpad-object-type",
+      "match": "(the-as {{type}} (+ #x70000000 $offset))",
+      "rewrite": "(scratchpad-object {{type}} :offset $offset)"
+    },
+    {
+      "name": "scratchpad-pointer-direct-{{type}}",
+      "for_each": "scratchpad-pointer-type",
+      "match": "(the-as (pointer {{type}}) #x70000000)",
+      "rewrite": "(scratchpad-ptr {{type}})"
+    },
+    {
+      "name": "scratchpad-pointer-offset-{{type}}",
+      "for_each": "scratchpad-pointer-type",
+      "match": "(the-as (pointer {{type}}) (+ $offset #x70000000))",
+      "rewrite": "(scratchpad-ptr {{type}} :offset $offset)"
+    },
+    {
+      "name": "scratchpad-pointer-reversed-offset-{{type}}",
+      "for_each": "scratchpad-pointer-type",
+      "match": "(the-as (pointer {{type}}) (+ #x70000000 $offset))",
+      "rewrite": "(scratchpad-ptr {{type}} :offset $offset)"
+    }
+  ]
+}

decompiler/config/jak1/jak1_config.jsonc

@@ -101,6 +101,7 @@
   "art_info_file": "decompiler/config/jak1/ntsc_v1/art_info.jsonc",
   "import_deps_file": "decompiler/config/jak1/ntsc_v1/import_deps.jsonc",
   "all_types_file": "decompiler/config/jak1/all-types.gc",
+  "demacro_file": "decompiler/config/jak1/demacro.jsonc",
   "art_group_dump_file": "decompiler/config/jak1/ntsc_v1/art-group-info.min.json",
   "joint_node_dump_file": "decompiler/config/jak1/ntsc_v1/joint-node-info.min.json",
   "tex_dump_file": "decompiler/config/jak1/ntsc_v1/tex-info.min.json",

goal_src/jak1/engine/anim/aligner.gc

@@ -53,7 +53,7 @@
     ;; Shift the decomposed transform and source matrix into the previous-sample slots.
     (mem-copy! (the-as pointer (-> this transform 1)) (the-as pointer (-> this transform)) 48)
     (quaternion-copy! (-> this transform 1 quat) (-> this align quat))
-    (set! (-> this transform 1 scale quad) (-> this align scale quad))
+    (vector-copy! (-> this transform 1 scale) (-> this align scale))
     (matrix-copy! (-> this matrix 1) (-> this matrix 0))
 
     ;; Evaluate the alignment joint, copy its bone matrix, and apply the process root scale to its

goal_src/jak1/engine/anim/joint-exploder.gc

@@ -161,8 +161,8 @@
       ((-> joint-list bbox-valid?) (add-point! (-> joint-list bbox) (the-as vector3s joint-position)))
       (else
        (set! (-> joint-list bbox-valid?) #t)
-       (set! (-> joint-list bbox min quad) (-> joint-position quad))
-       (set! (-> joint-list bbox max quad) (-> joint-position quad)))))
+       (vector-copy! (-> joint-list bbox min) joint-position)
+       (vector-copy! (-> joint-list bbox max) joint-position))))
   (add-point! (-> joint-list bbox) (the-as vector3s (-> joint-data prev-pos)))
   (none))
 
@@ -339,8 +339,8 @@
           (+! i 1))
         (let ((combined-bounds (new 'stack-no-clear 'bounding-box)))
           (let ((root-position (-> self root trans)))
-            (set! (-> combined-bounds min quad) (-> root-position quad))
-            (set! (-> combined-bounds max quad) (-> root-position quad)))
+            (vector-copy! (-> combined-bounds min) root-position)
+            (vector-copy! (-> combined-bounds max) root-position))
           (set! i 0)
           (while (< i 5)
             (set! joint-list (-> self lists i))
@@ -368,13 +368,6 @@
 (defmethod init-joints! ((this joint-exploder))
   "Build each fragment's base transform, spin matrix, linked-list indices, and launch velocity
    from the static joint table and selected explosion style, then seed the main list and bounds."
-  (local-vars
-    (basis-x uint128)
-    (basis-y uint128)
-    (basis-z uint128)
-    (fragment-matrix matrix)
-    (source-matrix matrix)
-    (translation uint128))
   (let ((joint-array (-> this joints))
         (i 0))
     (while (< i (-> joint-array num-joints))
@@ -388,28 +381,10 @@
           (cond
             ((>= parent-index 0)
              (if (zero? parent-index) (set! parent-index (-> static-joint joint-index)))
-             (set! source-matrix (-> this parent-override 0 node-list data parent-index bone transform))
-             (set! fragment-matrix (-> joint-data mat))
-             (set! basis-x (-> source-matrix vector 0 quad))
-             (set! basis-y (-> source-matrix vector 1 quad))
-             (set! basis-z (-> source-matrix vector 2 quad))
-             (set! translation (-> source-matrix vector 3 quad))
-             (set! (-> fragment-matrix vector 0 quad) basis-x)
-             (set! (-> fragment-matrix vector 1 quad) basis-y)
-             (set! (-> fragment-matrix vector 2 quad) basis-z)
-             (set! (-> fragment-matrix vector 3 quad) translation)
+             (matrix-copy! (-> joint-data mat) (-> this parent-override 0 node-list data parent-index bone transform))
              (matrix-identity! (-> joint-data rmat)))
             (else
-             (set! source-matrix (-> this node-list data (-> static-joint joint-index) bone transform))
-             (set! fragment-matrix (-> joint-data mat))
-             (set! basis-x (-> source-matrix vector 0 quad))
-             (set! basis-y (-> source-matrix vector 1 quad))
-             (set! basis-z (-> source-matrix vector 2 quad))
-             (set! translation (-> source-matrix vector 3 quad))
-             (set! (-> fragment-matrix vector 0 quad) basis-x)
-             (set! (-> fragment-matrix vector 1 quad) basis-y)
-             (set! (-> fragment-matrix vector 2 quad) basis-z)
-             (set! (-> fragment-matrix vector 3 quad) translation)
+             (matrix-copy! (-> joint-data mat) (-> this node-list data (-> static-joint joint-index) bone transform))
              (matrix-identity! (-> joint-data rmat)))))
         (case (-> this tuning explosion)
           ((1)
@@ -465,9 +440,9 @@
       (set! (-> joint-list pre-moved?) #f)))
   (logior! (-> self mask) (process-mask enemy))
   (set! (-> self root) (new 'process 'trsqv))
-  (set! (-> self root trans quad) (-> self parent-override 0 root trans quad))
+  (vector-copy! (-> self root trans) (-> self parent-override 0 root trans))
   (quaternion-copy! (-> self root quat) (-> self parent-override 0 root quat))
-  (set! (-> self root scale quad) (-> self parent-override 0 root scale quad))
+  (vector-copy! (-> self root scale) (-> self parent-override 0 root scale))
   (initialize-skeleton self exploder-sg '())
   (logior! (-> self skel status) (janim-status inited))
   (set! (-> self anim) (the-as art-joint-anim (-> self draw art-group data animation-index)))

goal_src/jak1/engine/anim/joint-mod-h.gc

@@ -170,9 +170,9 @@
 
 (defmethod set-trs! ((this joint-mod) (trans vector) (rot quaternion) (scale vector))
   "Replace any nonfalse translation, rotation, and scale override components."
-  (if trans (set! (-> this trans quad) (-> trans quad)))
+  (if trans (vector-copy! (-> this trans) trans))
   (if rot (quaternion-copy! (-> this quat) rot))
-  (if scale (set! (-> this scale quad) (-> scale quad)))
+  (if scale (vector-copy! (-> this scale) scale))
   0
   (none))
 
@@ -183,7 +183,7 @@
   ;; how far are we from the target?
   (let ((distance (vector-vector-distance (-> this process root trans) target-trans)))
     (set! (-> this shutting-down?) #f)
-    (set! (-> this target quad) (-> target-trans quad))
+    (vector-copy! (-> this target) target-trans)
     (if (< distance (-> this max-dist)) (set! (-> this blend) 1.0) (set! (-> this blend) 0.0)))
   0
   (none))
@@ -227,7 +227,7 @@
                    (or (< dist (vector-vector-distance (-> this process root trans) (-> this target))) (= option 'force)))
                (< dist (-> this max-dist)))
       (if (= (-> this mode) (joint-mod-handler-mode reset)) (set-mode! this (joint-mod-handler-mode look-at)))
-      (set! (-> this target quad) (-> target-trans quad))
+      (vector-copy! (-> this target) target-trans)
       (set! (-> this blend) 1.0)
       (set! (-> this shutting-down?) #f)))
   0
@@ -366,9 +366,9 @@
 (defun joint-mod-joint-set-handler ((node cspace) (local-transform transformq))
   "Replace the joint's local translation, rotation, and scale with the configured transform."
   (let ((s4-0 (the-as joint-mod (-> node param1))))
-    (set! (-> local-transform trans quad) (-> s4-0 trans quad))
+    (vector-copy! (-> local-transform trans) (-> s4-0 trans))
     (quaternion-copy! (-> local-transform quat) (-> s4-0 quat))
-    (set! (-> local-transform scale quad) (-> s4-0 scale quad)))
+    (vector-copy! (-> local-transform scale) (-> s4-0 scale)))
   (cspace<-parented-transformq-joint! node local-transform)
   0
   (none))
@@ -461,9 +461,9 @@
   (let ((v1-0 (the-as joint-mod-set-local (-> node param1))))
     (cond
       ((-> v1-0 enable)
-       (if (not (-> v1-0 set-translation)) (set! (-> v1-0 transform trans quad) (-> local-transform trans quad)))
+       (if (not (-> v1-0 set-translation)) (vector-copy! (-> v1-0 transform trans) (-> local-transform trans)))
        (if (not (-> v1-0 set-rotation)) (set! (-> v1-0 transform quat vec quad) (-> local-transform quat vec quad)))
-       (if (not (-> v1-0 set-scale)) (set! (-> v1-0 transform scale quad) (-> local-transform scale quad)))
+       (if (not (-> v1-0 set-scale)) (vector-copy! (-> v1-0 transform scale) (-> local-transform scale)))
        (cspace<-parented-transformq-joint! node (-> v1-0 transform)))
       (else (cspace<-parented-transformq-joint! node local-transform))))
   (none))

goal_src/jak1/engine/anim/joint.gc

@@ -449,12 +449,9 @@
   (format #t "#<~A ~S ~D @ #x~X>" (-> this type) (-> this name) (-> this number) this)
   this)
 
-(defmethod mem-usage ((this joint) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this joint) (usage memory-usage-block) (flags mem-usage-flags))
   "Add this skeleton joint descriptor to the joint memory-usage category."
-  (set! (-> usage length) (max 66 (-> usage length)))
-  (set! (-> usage data 65 name) "joint")
-  (+! (-> usage data 65 count) 1)
-  (let ((v1-6 (asize-of this))) (+! (-> usage data 65 used) v1-6) (+! (-> usage data 65 total) (logand -16 (+ v1-6 15))))
+  (mem-usage-add! usage joint 1 (asize-of this))
   this)
 
 (defmethod print ((this joint-anim))
@@ -509,37 +506,19 @@
      (format #t "~`transform`P~%" (-> (the-as joint-anim-transformq animation) data (the int index)))))
   animation)
 
-(defmethod mem-usage ((this joint-anim-drawable) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this joint-anim-drawable) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this animation and recursively account for every drawable payload."
-  (set! (-> usage length) (max 77 (-> usage length)))
-  (set! (-> usage data 76 name) "joint-anim-drawable")
-  (+! (-> usage data 76 count) 1)
-  (let ((v1-6 (asize-of this))) (+! (-> usage data 76 used) v1-6) (+! (-> usage data 76 total) (logand -16 (+ v1-6 15))))
+  (mem-usage-add! usage joint-anim-drawable 1 (asize-of this))
   (dotimes (s3-0 (-> this length))
     (mem-usage (-> this data s3-0) usage flags))
   this)
 
-(defun jacc-mem-usage ((compressed joint-anim-compressed-control) (usage memory-usage-block) (flags int))
+(defun jacc-mem-usage ((compressed joint-anim-compressed-control) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for a compressed animation control block, its fixed data, and each compressed frame."
-  (set! (-> usage length) (max 68 (-> usage length)))
-  (set! (-> usage data 67 name) "joint-anim-compressed-control")
-  (+! (-> usage data 67 count) 1)
-  (let ((control-size (+ (* (-> compressed num-frames) 4) 16)))
-    (+! (-> usage data 67 used) control-size)
-    (+! (-> usage data 67 total) (logand -16 (+ control-size 15))))
-  (set! (-> usage length) (max 69 (-> usage length)))
-  (set! (-> usage data 68 name) "joint-anim-fixed")
-  (+! (-> usage data 68 count) 1)
-  (let ((fixed-size (+ (-> compressed fixed-qwc) 16)))
-    (+! (-> usage data 68 used) fixed-size)
-    (+! (-> usage data 68 total) (logand -16 (+ fixed-size 15))))
+  (mem-usage-add! usage joint-anim-compressed-control 1 (+ (* (-> compressed num-frames) 4) 16))
+  (mem-usage-add! usage joint-anim-fixed 1 (+ (-> compressed fixed-qwc) 16))
   (dotimes (i (the-as int (-> compressed num-frames)))
-    (set! (-> usage length) (max 70 (-> usage length)))
-    (set! (-> usage data 69 name) "joint-anim-frame")
-    (+! (-> usage data 69 count) 1)
-    (let ((frame-size (* (-> compressed frame-qwc) 16)))
-      (+! (-> usage data 69 used) frame-size)
-      (+! (-> usage data 69 total) (logand -16 (+ frame-size 15)))))
+    (mem-usage-add! usage joint-anim-frame 1 (* (-> compressed frame-qwc) 16)))
   compressed)
 
 (defmethod print ((this joint-control-channel))
@@ -639,40 +618,24 @@
     (set! (-> this extra tag) (&+ (the-as (pointer res-tag) (-> this extra)) 28)))
   this)
 
-(defmethod mem-usage ((this art-mesh-anim) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this art-mesh-anim) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this mesh animation, its resource lump, and every payload object."
-  (set! (-> usage length) (max 72 (-> usage length)))
-  (set! (-> usage data 71 name) "art-mesh-anim")
-  (+! (-> usage data 71 count) 1)
-  (let ((v1-6 (asize-of this))) (+! (-> usage data 71 used) v1-6) (+! (-> usage data 71 total) (logand -16 (+ v1-6 15))))
-  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags 512)))
+  (mem-usage-add! usage art-mesh-anim 1 (asize-of this))
+  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags (mem-usage-flags resource-joint-geo))))
   (dotimes (s3-0 (-> this length))
     (mem-usage (-> this data s3-0) usage flags))
   this)
 
-(defmethod mem-usage ((this art-joint-anim) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this art-joint-anim) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this animation group, compressed frame storage, eye animation data, and resource
    lump."
-  (set! (-> usage length) (max 75 (-> usage length)))
-  (set! (-> usage data 74 name) "art-joint-anim")
-  (+! (-> usage data 74 count) 1)
-  (let ((v1-6 (asize-of this))) (+! (-> usage data 74 used) v1-6) (+! (-> usage data 74 total) (logand -16 (+ v1-6 15))))
-  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags 512)))
+  (mem-usage-add! usage art-joint-anim 1 (asize-of this))
+  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags (mem-usage-flags resource-joint-geo))))
   (jacc-mem-usage (-> this frames) usage flags)
   (dotimes (s4-1 (-> this length))
-    (set! (-> usage length) (max 67 (-> usage length)))
-    (set! (-> usage data 66 name) "joint-anim-compressed")
-    (+! (-> usage data 66 count) 1)
-    (let ((v1-22 (asize-of (-> this data s4-1))))
-      (+! (-> usage data 66 used) v1-22)
-      (+! (-> usage data 66 total) (logand -16 (+ v1-22 15)))))
+    (mem-usage-add! usage joint-anim-compressed 1 (asize-of (-> this data s4-1))))
   (when (and (nonzero? (-> this eye-anim-data)) (-> this eye-anim-data))
-    (set! (-> usage length) (max 109 (-> usage length)))
-    (set! (-> usage data 108 name) "eye-anim")
-    (+! (-> usage data 108 count) 1)
-    (let ((v1-41 (* (* (+ (-> this eye-anim-data max-frame) 1) 2) 8)))
-      (+! (-> usage data 108 used) v1-41)
-      (+! (-> usage data 108 total) (logand -16 (+ v1-41 15)))))
+    (mem-usage-add! usage eye-anim 1 (* (* (+ (-> this eye-anim-data max-frame) 1) 2) 8)))
   this)
 
 (defmethod asize-of ((this art-joint-anim))
@@ -705,7 +668,7 @@
   (format #t "~Tdata[~D]: @ #x~X~%" (-> this length) (-> this data))
   (dotimes (s5-0 (-> this length))
     (if (-> this data s5-0)
-      (format #t "~T  [~D] ~A  (~D bytes)~%" s5-0 (-> this data s5-0) (mem-size (-> this data s5-0) #f 0))
+      (format #t "~T  [~D] ~A  (~D bytes)~%" s5-0 (-> this data s5-0) (mem-size (-> this data s5-0) #f (mem-usage-flags)))
       (format #t "~T  [~D] ~A  (~D bytes)~%" s5-0 (-> this data s5-0) 0)))
   this)
 
@@ -759,13 +722,10 @@
     (if (-> this data s5-0) (set! (-> this data s5-0) (login (-> this data s5-0)))))
   this)
 
-(defmethod mem-usage ((this art-group) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this art-group) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this art group, its resource lump, and every populated art entry."
-  (set! (-> usage length) (max 71 (-> usage length)))
-  (set! (-> usage data 70 name) "art-group")
-  (+! (-> usage data 70 count) 1)
-  (let ((v1-6 (asize-of this))) (+! (-> usage data 70 used) v1-6) (+! (-> usage data 70 total) (logand -16 (+ v1-6 15))))
-  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags 512)))
+  (mem-usage-add! usage art-group 1 (asize-of this))
+  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags (mem-usage-flags resource-joint-geo))))
   (dotimes (s3-0 (-> this length))
     (if (-> this data s3-0) (mem-usage (-> this data s3-0) usage flags)))
   this)
@@ -792,13 +752,10 @@
   "Return the art header size plus one pointer-sized mesh payload entry."
   (the-as int (+ (-> art size) (* (-> this length) 4))))
 
-(defmethod mem-usage ((this art-mesh-geo) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this art-mesh-geo) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this mesh geometry, its resource lump, and every payload object."
-  (set! (-> usage length) (max 73 (-> usage length)))
-  (set! (-> usage data 72 name) "art-mesh-geo")
-  (+! (-> usage data 72 count) 1)
-  (let ((v1-6 (asize-of this))) (+! (-> usage data 72 used) v1-6) (+! (-> usage data 72 total) (logand -16 (+ v1-6 15))))
-  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags 512)))
+  (mem-usage-add! usage art-mesh-geo 1 (asize-of this))
+  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags (mem-usage-flags resource-joint-geo))))
   (dotimes (s3-0 (-> this length))
     (mem-usage (-> this data s3-0) usage flags))
   this)
@@ -845,13 +802,10 @@
      (the-as int #f))
     (else (dotimes (s4-1 (-> this length)) (if (name= joint-name (-> this data s4-1 name)) (return s4-1))) (the-as int #f))))
 
-(defmethod mem-usage ((this art-joint-geo) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this art-joint-geo) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this joint geometry, its resource lump, and every joint descriptor."
-  (set! (-> usage length) (max 74 (-> usage length)))
-  (set! (-> usage data 73 name) "art-joint-geo")
-  (+! (-> usage data 73 count) 1)
-  (let ((v1-6 (asize-of this))) (+! (-> usage data 73 used) v1-6) (+! (-> usage data 73 total) (logand -16 (+ v1-6 15))))
-  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags 512)))
+  (mem-usage-add! usage art-joint-geo 1 (asize-of this))
+  (if (-> this extra) (mem-usage (-> this extra) usage (logior flags (mem-usage-flags resource-joint-geo))))
   (dotimes (s3-0 (-> this length))
     (mem-usage (-> this data s3-0) usage flags))
   this)
@@ -1119,15 +1073,9 @@
            (frame-check clamped-frame))
       (cond
         ((= (the float (the int frame-check)) frame-check)
-         (let* ((source-matrix (matrix-from-joint-anim-frame (-> animation-group frames) matrix-index (the int clamped-frame)))
-                (row0 (-> source-matrix vector 0 quad))
-                (row1 (-> source-matrix vector 1 quad))
-                (row2 (-> source-matrix vector 2 quad))
-                (row3 (-> source-matrix vector 3 quad)))
-           (set! (-> destination vector 0 quad) row0)
-           (set! (-> destination vector 1 quad) row1)
-           (set! (-> destination vector 2 quad) row2)
-           (set! (-> destination vector 3 quad) row3))
+         (matrix-copy!
+           destination
+           (matrix-from-joint-anim-frame (-> animation-group frames) matrix-index (the int clamped-frame)))
          destination)
         (else
          (let ((first-matrix (matrix-from-joint-anim-frame (-> animation-group frames) matrix-index (the int clamped-frame)))
@@ -1162,16 +1110,7 @@
                                        channel))
         ((and (= mode 'no-push) (= command 'stack))
          (set! (-> stack top) (the-as matrix (&- (the-as pointer (-> stack top)) (the-as uint matrix-size))))
-         (let* ((previous-matrix (the-as matrix (&- (the-as pointer (-> stack top)) (the-as uint matrix-size))))
-                (top-matrix (-> stack top))
-                (row0 (-> top-matrix vector 0 quad))
-                (row1 (-> top-matrix vector 1 quad))
-                (row2 (-> top-matrix vector 2 quad))
-                (row3 (-> top-matrix vector 3 quad)))
-           (set! (-> previous-matrix vector 0 quad) row0)
-           (set! (-> previous-matrix vector 1 quad) row1)
-           (set! (-> previous-matrix vector 2 quad) row2)
-           (set! (-> previous-matrix vector 3 quad) row3)))
+         (matrix-copy! (the-as matrix (&- (the-as pointer (-> stack top)) (the-as uint matrix-size))) (-> stack top)))
         ((= command 'push)
          (matrix-from-control-channel! (-> stack top) skeleton-joint channel)
          (set! (-> stack top) (the-as matrix (+ (the-as uint (-> stack top)) matrix-size))))
@@ -1208,15 +1147,7 @@
 (defun cspace<-cspace! ((destination cspace) (source cspace))
   "Copy source's bone transform into destination."
   (let ((destination-matrix (-> destination bone transform)))
-    (let* ((source-matrix (-> source bone transform))
-           (row0 (-> source-matrix vector 0 quad))
-           (row1 (-> source-matrix vector 1 quad))
-           (row2 (-> source-matrix vector 2 quad))
-           (row3 (-> source-matrix vector 3 quad)))
-      (set! (-> destination-matrix vector 0 quad) row0)
-      (set! (-> destination-matrix vector 1 quad) row1)
-      (set! (-> destination-matrix vector 2 quad) row2)
-      (set! (-> destination-matrix vector 3 quad) row3))
+    (matrix-copy! destination-matrix (-> source bone transform))
     destination-matrix))
 
 (defun cspace<-rot-yxy! ((destination cspace) (xform transform))
@@ -1261,28 +1192,13 @@
                                             control
                                             'no-push))
         (destination-matrix (-> space bone transform)))
-    (let ((row0 (-> input-matrix vector 0 quad))
-          (row1 (-> input-matrix vector 1 quad))
-          (row2 (-> input-matrix vector 2 quad))
-          (row3 (-> input-matrix vector 3 quad)))
-      (set! (-> destination-matrix vector 0 quad) row0)
-      (set! (-> destination-matrix vector 1 quad) row1)
-      (set! (-> destination-matrix vector 2 quad) row2)
-      (set! (-> destination-matrix vector 3 quad) row3))
+    (matrix-copy! destination-matrix input-matrix)
     destination-matrix))
 
 (defun cspace<-matrix-joint! ((space cspace) (input-matrix matrix))
   "Copy a matrix joint directly into this coordinate space's bone transform."
   (let ((destination-matrix (-> space bone transform)))
-    (let* ((source-matrix input-matrix)
-           (row0 (-> source-matrix vector 0 quad))
-           (row1 (-> source-matrix vector 1 quad))
-           (row2 (-> source-matrix vector 2 quad))
-           (row3 (-> source-matrix vector 3 quad)))
-      (set! (-> destination-matrix vector 0 quad) row0)
-      (set! (-> destination-matrix vector 1 quad) row1)
-      (set! (-> destination-matrix vector 2 quad) row2)
-      (set! (-> destination-matrix vector 3 quad) row3))
+    (matrix-copy! destination-matrix input-matrix)
     destination-matrix))
 
 (defun cspace<-parented-matrix-joint! ((space cspace) (input-matrix matrix))
@@ -3125,101 +3041,101 @@
   ;;   7 -> nothing               15 -> nothing         (straight to fixed-next-transform)
   ;; frm-jmp-table and pair-jmp-table take the set bits, so their tables are the same list read
   ;; the other way round: 0 and 8 are the nothing case and 15 is all three with wide translation.
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 0)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 0)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 108 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 1)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 1)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 199 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 2)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 2)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 233 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 3)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 3)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 286 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 4)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 4)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 301 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 5)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 5)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 366 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 6)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 6)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 387 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 7)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 7)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 100 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 8)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 8)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 155 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 9)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 9)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 199 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 10)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 10)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 261 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 11)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 11)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 286 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 12)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 12)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 335 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 13)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 13)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 366 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 14)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 14)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 402 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work fix-jmp-table 15)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work fix-jmp-table 15)
         (the-as (function none) (+ (the-as uint decompress-fixed-data-to-accumulator) (* 100 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 0)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 0)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 84 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 1)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 1)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 92 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 2)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 2)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 119 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 3)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 3)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 140 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 4)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 4)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 205 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 5)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 5)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 220 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 6)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 6)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 273 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 7)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 7)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 307 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 8)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 8)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 84 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 9)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 9)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 107 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 10)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 10)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 119 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 11)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 11)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 174 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 12)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 12)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 205 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 13)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 13)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 248 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 14)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 14)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 273 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work frm-jmp-table 15)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work frm-jmp-table 15)
         (the-as (function none) (+ (the-as uint decompress-frame-data-to-accumulator) (* 354 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 0)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 0)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 117 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 1)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 1)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 125 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 2)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 2)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 169 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 3)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 3)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 197 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 4)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 4)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 293 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 5)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 5)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 318 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 6)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 6)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 408 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 7)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 7)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 459 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 8)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 8)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 117 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 9)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 9)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 150 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 10)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 10)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 169 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 11)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 11)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 248 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 12)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 12)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 293 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 13)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 13)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 366 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 14)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 14)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 408 4))))
-  (set! (-> (the-as terrain-context #x70000000) work foreground joint-work pair-jmp-table 15)
+  (set! (-> (scratchpad-object terrain-context) work foreground joint-work pair-jmp-table 15)
         (the-as (function none) (+ (the-as uint decompress-frame-data-pair-to-accumulator) (* 533 4))))
   0)
 

goal_src/jak1/engine/camera/cam-combiner.gc

@@ -29,7 +29,7 @@
          (cond
            ((-> block param 0)
             (set! (-> self tracking use-point-of-interest) #t)
-            (set! (-> self tracking point-of-interest quad) (-> (the-as vector (-> block param 0)) quad))
+            (vector-copy! (-> self tracking point-of-interest) (the-as vector (-> block param 0)))
             (set! (-> self tracking point-of-interest-blend target) 1.0))
            (else (set! (-> self tracking use-point-of-interest) #f) (set! (-> self tracking point-of-interest-blend target) 0.0))))
         (('set-interpolation)
@@ -64,7 +64,7 @@
               (copy-cam-float-seeker (-> self tracking tilt-adjust) (-> source-slave tracking tilt-adjust))
               (copy-cam-float-seeker (-> self tracking underwater-blend) (-> source-slave tracking underwater-blend))
               (set! (-> self tracking use-point-of-interest) (-> source-slave tracking use-point-of-interest))
-              (set! (-> self tracking point-of-interest quad) (-> source-slave tracking point-of-interest quad))
+              (vector-copy! (-> self tracking point-of-interest) (-> source-slave tracking point-of-interest))
               (copy-cam-float-seeker (-> self tracking point-of-interest-blend) (-> source-slave tracking point-of-interest-blend))
               (let ((source-position (-> source-slave trans)))
                 (cam-calc-follow! (-> self tracking) source-position #f)
@@ -93,20 +93,11 @@
               (set! (-> self tracking no-follow) (-> source-slave tracking no-follow))
               (copy-cam-float-seeker (-> self tracking tilt-adjust) (-> source-slave tracking tilt-adjust))
               (copy-cam-float-seeker (-> self tracking underwater-blend) (-> source-slave tracking underwater-blend))
-              (set! (-> self tracking follow-off quad) (-> source-slave tracking follow-off quad))
-              (set! (-> self tracking follow-pt quad) (-> source-slave tracking follow-pt quad))
-              (let* ((destination-tracker (-> self tracking))
-                     (source-tracker (-> source-slave tracking))
-                     (row-0 (-> source-tracker inv-mat vector 0 quad))
-                     (row-1 (-> source-tracker inv-mat vector 1 quad))
-                     (row-2 (-> source-tracker inv-mat vector 2 quad))
-                     (row-3 (-> source-tracker inv-mat vector 3 quad)))
-                (set! (-> destination-tracker inv-mat vector 0 quad) row-0)
-                (set! (-> destination-tracker inv-mat vector 1 quad) row-1)
-                (set! (-> destination-tracker inv-mat vector 2 quad) row-2)
-                (set! (-> destination-tracker inv-mat vector 3 quad) row-3))
+              (vector-copy! (-> self tracking follow-off) (-> source-slave tracking follow-off))
+              (vector-copy! (-> self tracking follow-pt) (-> source-slave tracking follow-pt))
+              (matrix-copy! (-> self tracking inv-mat) (-> source-slave tracking inv-mat))
               (set! (-> self tracking use-point-of-interest) (-> source-slave tracking use-point-of-interest))
-              (set! (-> self tracking point-of-interest quad) (-> source-slave tracking point-of-interest quad))
+              (vector-copy! (-> self tracking point-of-interest) (-> source-slave tracking point-of-interest))
               (copy-cam-float-seeker (-> self tracking point-of-interest-blend) (-> source-slave tracking point-of-interest-blend))))))))
   :code
     (behavior ()
@@ -132,16 +123,7 @@
                    ((= (-> self tracking-status) 1)
                     (cam-calc-follow! (-> self tracking) (-> self trans) #t)
                     (slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self tracking-options)) (-> self fov) #t)
-                    (let* ((output-matrix (-> self inv-camera-rot))
-                           (combined-tracker (-> self tracking))
-                           (row-0 (-> combined-tracker inv-mat vector 0 quad))
-                           (row-1 (-> combined-tracker inv-mat vector 1 quad))
-                           (row-2 (-> combined-tracker inv-mat vector 2 quad))
-                           (row-3 (-> combined-tracker inv-mat vector 3 quad)))
-                      (set! (-> output-matrix vector 0 quad) row-0)
-                      (set! (-> output-matrix vector 1 quad) row-1)
-                      (set! (-> output-matrix vector 2 quad) row-2)
-                      (set! (-> output-matrix vector 3 quad) row-3)))
+                    (matrix-copy! (-> self inv-camera-rot) (-> self tracking inv-mat)))
                    (else
                     (set! source-tracker (-> source-slave 0 tracking))
                     (let ((source-position (-> source-slave 0 trans))
@@ -262,27 +244,9 @@
                    ((= (-> self tracking-status) 1)
                     (cam-calc-follow! (-> self tracking) (-> self trans) #t)
                     (slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self tracking-options)) (-> self fov) #t)
-                    (let* ((output-matrix (-> self inv-camera-rot))
-                           (combined-tracker (-> self tracking))
-                           (row-0 (-> combined-tracker inv-mat vector 0 quad))
-                           (row-1 (-> combined-tracker inv-mat vector 1 quad))
-                           (row-2 (-> combined-tracker inv-mat vector 2 quad))
-                           (row-3 (-> combined-tracker inv-mat vector 3 quad)))
-                      (set! (-> output-matrix vector 0 quad) row-0)
-                      (set! (-> output-matrix vector 1 quad) row-1)
-                      (set! (-> output-matrix vector 2 quad) row-2)
-                      (set! (-> output-matrix vector 3 quad) row-3)))
+                    (matrix-copy! (-> self inv-camera-rot) (-> self tracking inv-mat)))
                    (else
-                    (let* ((output-matrix (-> self inv-camera-rot))
-                           (source-tracker (-> source-slave 0 tracking))
-                           (row-0 (-> source-tracker inv-mat vector 0 quad))
-                           (row-1 (-> source-tracker inv-mat vector 1 quad))
-                           (row-2 (-> source-tracker inv-mat vector 2 quad))
-                           (row-3 (-> source-tracker inv-mat vector 3 quad)))
-                      (set! (-> output-matrix vector 0 quad) row-0)
-                      (set! (-> output-matrix vector 1 quad) row-1)
-                      (set! (-> output-matrix vector 2 quad) row-2)
-                      (set! (-> output-matrix vector 3 quad) row-3)))))))
+                    (matrix-copy! (-> self inv-camera-rot) (-> source-slave 0 tracking inv-mat)))))))
             (vector-! (-> self velocity) (-> self trans) previous-position)))
         (if (and *dproc* *debug-segment*)
           (add-frame (-> *display* frames (-> *display* on-screen) frame profile-bar 0) 'camera (new 'static 'rgba :b #xff :a #x80)))

goal_src/jak1/engine/camera/cam-debug.gc

@@ -127,61 +127,49 @@
 (defun cam-line-dma ()
   "Append the current transformed debug-line endpoints and color to the
    no-depth-test debug DMA bucket."
-  (let* ((debug-buffer (-> *display* frames (-> *display* on-screen) frame debug-buf))
-         (packet-start (-> debug-buffer base)))
-    (let ((cnt-tag (the-as object (-> debug-buffer base))))
-      (let* ((write-buffer debug-buffer)
-             (dma-header (the-as object (-> write-buffer base))))
-        (set! (-> (the-as dma-packet dma-header) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
-        (set! (-> (the-as dma-packet dma-header) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet dma-header) vif1) (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1))
-        (set! (-> write-buffer base) (&+ (the-as pointer dma-header) 16)))
-      (let* ((write-buffer debug-buffer)
-             (gif-header (the-as object (-> write-buffer base))))
-        (set! (-> (the-as gs-gif-tag gif-header) tag)
-              (new 'static
-                   'gif-tag64
-                   :nloop #x1
-                   :eop #x1
-                   :pre #x1
-                   :prim
-                   (new 'static 'gs-prim :prim (gs-prim-type line) :iip #x1 :abe #x1)
-                   :nreg #x4))
-        (set! (-> (the-as gs-gif-tag gif-header) regs)
-              (new 'static
-                   'gif-tag-regs
-                   :regs0 (gif-reg-id rgbaq)
-                   :regs1 (gif-reg-id xyzf2)
-                   :regs2 (gif-reg-id rgbaq)
-                   :regs3 (gif-reg-id xyzf2)))
-        (set! (-> write-buffer base) (&+ (the-as pointer gif-header) 16)))
-      (let* ((write-buffer debug-buffer)
-             (vertex-packet (-> write-buffer base)))
-        (set! (-> (the-as (pointer uint128) vertex-packet) 0) (-> (the-as vector (+ 32 (scratchpad-object int))) quad))
-        (set! (-> (the-as (pointer uint128) vertex-packet) 1)
-              (-> (the-as vector (-> (scratchpad-object cam-dbg-scratch) linevec4w)) quad))
-        (set! (-> write-buffer base) (&+ vertex-packet 32)))
-      (let* ((write-buffer debug-buffer)
-             (vertex-packet (-> write-buffer base)))
-        (set! (-> (the-as (pointer uint128) vertex-packet) 0) (-> (the-as vector (+ 32 (scratchpad-object int))) quad))
-        (set! (-> (the-as (pointer uint128) vertex-packet) 1) (-> (the-as vector (+ 16 (scratchpad-object int))) quad))
-        (set! (-> write-buffer base) (&+ vertex-packet 32)))
-      (let ((qwc (/ (the-as int (+ (- -16 (the-as int cnt-tag)) (the-as int (-> debug-buffer base)))) 16)))
-        (cond
-          ((nonzero? qwc)
-           (logior! (-> (the-as dma-packet cnt-tag) dma) (shr (shl qwc 48) 48))
-           (logior! (-> (the-as (pointer uint64) cnt-tag) 1) (shl (shr (shl qwc 48) 48) 32)))
-          (else (set! (-> debug-buffer base) (the-as (pointer uint64) cnt-tag))))))
-    (let ((next-tag (-> debug-buffer base)))
-      (let ((next-header (the-as object (-> debug-buffer base))))
-        (set! (-> (the-as dma-packet next-header) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-        (set! (-> (the-as dma-packet next-header) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet next-header) vif1) (new 'static 'vif-tag))
-        (set! (-> debug-buffer base) (&+ (the-as pointer next-header) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id debug-no-zbuf)
-                             packet-start
-                             (the-as (pointer dma-tag) next-tag)))))
+  (with-dma-buffer-add-bucket ((debug-buffer (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug-no-zbuf)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((cnt-tag (the-as object (-> debug-buffer base))))
+        (let* ((write-buffer debug-buffer)
+               (dma-header (the-as object (-> write-buffer base))))
+          (set! (-> (the-as dma-packet dma-header) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
+          (set! (-> (the-as dma-packet dma-header) vif0) (new 'static 'vif-tag))
+          (set! (-> (the-as dma-packet dma-header) vif1) (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1))
+          (set! (-> write-buffer base) (&+ (the-as pointer dma-header) 16)))
+        (let* ((write-buffer debug-buffer)
+               (gif-header (the-as object (-> write-buffer base))))
+          (set! (-> (the-as gs-gif-tag gif-header) tag)
+                (new 'static
+                     'gif-tag64
+                     :nloop #x1
+                     :eop #x1
+                     :pre #x1
+                     :prim
+                     (new 'static 'gs-prim :prim (gs-prim-type line) :iip #x1 :abe #x1)
+                     :nreg #x4))
+          (set! (-> (the-as gs-gif-tag gif-header) regs)
+                (new 'static
+                     'gif-tag-regs
+                     :regs0 (gif-reg-id rgbaq)
+                     :regs1 (gif-reg-id xyzf2)
+                     :regs2 (gif-reg-id rgbaq)
+                     :regs3 (gif-reg-id xyzf2)))
+          (set! (-> write-buffer base) (&+ (the-as pointer gif-header) 16)))
+        (let* ((write-buffer debug-buffer)
+               (vertex-packet (-> write-buffer base)))
+          (set! (-> (the-as (pointer uint128) vertex-packet) 0) (-> (the-as vector (+ 32 (scratchpad-object int))) quad))
+          (set! (-> (the-as (pointer uint128) vertex-packet) 1)
+                (-> (the-as vector (-> (scratchpad-object cam-dbg-scratch) linevec4w)) quad))
+          (set! (-> write-buffer base) (&+ vertex-packet 32)))
+        (let* ((write-buffer debug-buffer)
+               (vertex-packet (-> write-buffer base)))
+          (set! (-> (the-as (pointer uint128) vertex-packet) 0) (-> (the-as vector (+ 32 (scratchpad-object int))) quad))
+          (set! (-> (the-as (pointer uint128) vertex-packet) 1) (-> (the-as vector (+ 16 (scratchpad-object int))) quad))
+          (set! (-> write-buffer base) (&+ vertex-packet 32)))
+        (let ((qwc (/ (the-as int (+ (- -16 (the-as int cnt-tag)) (the-as int (-> debug-buffer base)))) 16)))
+          (cond
+            ((nonzero? qwc)
+             (logior! (-> (the-as dma-packet cnt-tag) dma) (shr (shl qwc 48) 48))
+             (logior! (-> (the-as (pointer uint64) cnt-tag) 1) (shl (shr (shl qwc 48) 48) 32)))
+            (else (set! (-> debug-buffer base) (the-as (pointer uint64) cnt-tag))))))))
 
 (defun camera-line2d ((start vector4w) (end vector4w))
   "Draw a line between two screen-space points. Convert pixels to GS 12.4
@@ -914,15 +902,15 @@
    camera-slave state needed to reproduce and inspect the probe."
   (when *record-cam-collide-history*
     (let ((record (the-as cam-collision-record (+ (+ (* 176 *cam-collision-record-last*) 12) (the-as int *cam-collision-record*)))))
-      (set! (-> record pos quad) (-> position quad))
-      (set! (-> record vel quad) (-> velocity quad))
-      (set! (-> record view-flat quad) (-> slave view-flat quad))
-      (set! (-> record desired-pos quad) (-> slave desired-pos quad))
-      (set! (-> record cam-tpos-cur quad) (-> *camera* tpos-curr-adj quad))
-      (set! (-> record cam-tpos-old quad) (-> *camera* tpos-old-adj quad))
-      (set! (-> record string-min-val quad) (-> slave string-min-val quad))
-      (set! (-> record string-max-val quad) (-> slave string-max-val quad))
-      (set! (-> record view-off quad) (-> slave view-off quad))
+      (vector-copy! (-> record pos) position)
+      (vector-copy! (-> record vel) velocity)
+      (vector-copy! (-> record view-flat) (-> slave view-flat))
+      (vector-copy! (-> record desired-pos) (-> slave desired-pos))
+      (vector-copy! (-> record cam-tpos-cur) (-> *camera* tpos-curr-adj))
+      (vector-copy! (-> record cam-tpos-old) (-> *camera* tpos-old-adj))
+      (vector-copy! (-> record string-min-val) (-> slave string-min-val))
+      (vector-copy! (-> record string-max-val) (-> slave string-max-val))
+      (vector-copy! (-> record view-off) (-> slave view-off))
       (set! (-> record frame) (the-as int (-> *display* base-frame-counter)))
       (set! (-> record iteration) iteration)
       (set! (-> record move-type) move-kind)
@@ -1061,16 +1049,8 @@
    to the fixed state. Return position."
   (when (and *camera* *camera-combiner*)
     (send-event *camera* 'change-state cam-free-floating 0)
-    (set! (-> *camera-combiner* trans quad) (-> position quad))
-    (let ((destination-rotation (-> *camera-combiner* inv-camera-rot))
-          (row-0 (-> inverse-rotation vector 0 quad))
-          (row-1 (-> inverse-rotation vector 1 quad))
-          (row-2 (-> inverse-rotation vector 2 quad))
-          (row-3 (-> inverse-rotation vector 3 quad)))
-      (set! (-> destination-rotation vector 0 quad) row-0)
-      (set! (-> destination-rotation vector 1 quad) row-1)
-      (set! (-> destination-rotation vector 2 quad) row-2)
-      (set! (-> destination-rotation vector 3 quad) row-3))
+    (vector-copy! (-> *camera-combiner* trans) position)
+    (matrix-copy! (-> *camera-combiner* inv-camera-rot) inverse-rotation)
     (send-event *camera* 'change-state cam-fixed 0))
   position)
 
@@ -1080,16 +1060,7 @@
   (vector-reset! (-> *math-camera* trans))
   (matrix-identity! (-> *math-camera* inv-camera-rot))
   (when *camera-combiner*
-    (let* ((destination-rotation (-> *math-camera* inv-camera-rot))
-           (source-rotation (-> *camera-combiner* inv-camera-rot))
-           (row-0 (-> source-rotation vector 0 quad))
-           (row-1 (-> source-rotation vector 1 quad))
-           (row-2 (-> source-rotation vector 2 quad))
-           (row-3 (-> source-rotation vector 3 quad)))
-      (set! (-> destination-rotation vector 0 quad) row-0)
-      (set! (-> destination-rotation vector 1 quad) row-1)
-      (set! (-> destination-rotation vector 2 quad) row-2)
-      (set! (-> destination-rotation vector 3 quad) row-3))
-    (set! (-> *math-camera* trans quad) (-> *camera-combiner* trans quad)))
+    (matrix-copy! (-> *math-camera* inv-camera-rot) (-> *camera-combiner* inv-camera-rot))
+    (vector-copy! (-> *math-camera* trans) (-> *camera-combiner* trans)))
   0
   (none))

goal_src/jak1/engine/camera/cam-interface.gc

@@ -54,7 +54,7 @@
    orientation and the position stored in the scale vector of its extra transform, then send it to
    the camera master as an immediate teleport."
   (let ((teleport-transform (new 'stack 'transformq)))
-    (set! (-> teleport-transform trans quad) (-> (the-as transform (-> start-entity extra)) scale quad))
+    (vector-copy! (-> teleport-transform trans) (-> (the-as transform (-> start-entity extra)) scale))
     (quaternion-copy! (-> teleport-transform quat) (-> start-entity quat))
     (vector-identity! (-> teleport-transform scale))
     (send-event *camera* 'teleport-to-transformq teleport-transform))

goal_src/jak1/engine/camera/cam-layout.gc

@@ -109,19 +109,7 @@
 (defun cam-layout-print ((x int) (y int) (text string))
   "Draw debug text at screen coordinates x and y, terminate its DMA chain, and insert the result in
    the current frame's debug bucket."
-  (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame debug-buf))
-         (packet-start (-> dma-buf base)))
-    (draw-string-xy text dma-buf x y (font-color white) (font-flags shadow kerning))
-    (let ((tail-tag (-> dma-buf base)))
-      (let ((packet (the-as object (-> dma-buf base))))
-        (set! (-> (the-as dma-packet packet) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-        (set! (-> (the-as dma-packet packet) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet packet) vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buf base) (&+ (the-as pointer packet) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id debug)
-                             packet-start
-                             (the-as (pointer dma-tag) tail-tag)))))
+  (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy text dma-buf x y (font-color white) (font-flags shadow kerning))))
 
 (defun cam-layout-intersect-dist ((plane vector) (point vector) (direction vector))
   "Return the signed distance along direction from point to plane, or a large sentinel when the
@@ -210,7 +198,7 @@
                          (set! segment-distance 0.0)
                          (set! clip-count 0)
                          (set! clip-plane (new-stack-vector0))
-                         (set! (-> segment-start quad) (-> candidate-point quad))
+                         (vector-copy! segment-start candidate-point)
                          (set! clip-plane-index 0)
                          (while (< clip-plane-index (the-as int (-> tag elt-count)))
                            (when (and (!= clip-plane-index plane-index) (!= clip-plane-index other-plane-index))
@@ -751,30 +739,22 @@
   (while (< (-> self cur-entity) 0)
     (+! (-> self cur-entity) (-> self num-entities)))
   (set! *last-cur-entity* (-> self cur-entity))
-  (let ((entities-left (-> self cur-entity))
-        (node (-> *camera-engine* alive-list next0)))
-    *camera-engine*
-    (let ((next-node (-> node next0)))
-      (while (!= node (-> *camera-engine* alive-list-end))
-        (let ((camera (-> (the-as connection node) param1)))
-          (cond
-            ((zero? entities-left)
-             (set! (-> self cam-entity) (the-as entity-camera camera))
-             (set! *volume-descriptor-current* 0)
-             (set! *volume-point-current* 0)
-             (set! *volume-normal-current* 0)
-             (set! (-> self num-volumes) 0)
-             (cam-layout-entity-volume-info-create (-> self cam-entity) 'vol)
-             (set! (-> self first-pvol) (-> self num-volumes))
-             (cam-layout-entity-volume-info-create (-> self cam-entity) 'pvol)
-             (set! (-> self first-cutoutvol) (-> self num-volumes))
-             (cam-layout-entity-volume-info-create (-> self cam-entity) 'cutoutvol)
-             (set! (-> *CAM_LAYOUT-bank* intro-step) (cam-slave-get-intro-step (-> self cam-entity)))
-             (return #f))
-            (else (+! entities-left -1))))
-        (set! node next-node)
-        *camera-engine*
-        (set! next-node (-> next-node next0)))))
+  (let ((entities-left (-> self cur-entity))) (iterate-engine-connections (node *camera-engine*) (let ((camera (-> (the-as connection node) param1)))
+            (cond
+              ((zero? entities-left)
+               (set! (-> self cam-entity) (the-as entity-camera camera))
+               (set! *volume-descriptor-current* 0)
+               (set! *volume-point-current* 0)
+               (set! *volume-normal-current* 0)
+               (set! (-> self num-volumes) 0)
+               (cam-layout-entity-volume-info-create (-> self cam-entity) 'vol)
+               (set! (-> self first-pvol) (-> self num-volumes))
+               (cam-layout-entity-volume-info-create (-> self cam-entity) 'pvol)
+               (set! (-> self first-cutoutvol) (-> self num-volumes))
+               (cam-layout-entity-volume-info-create (-> self cam-entity) 'cutoutvol)
+               (set! (-> *CAM_LAYOUT-bank* intro-step) (cam-slave-get-intro-step (-> self cam-entity)))
+               (return #f))
+              (else (+! entities-left -1))))))
   #t)
 
 (defbehavior clmf-to-vol-attr cam-layout ()
@@ -820,7 +800,7 @@
    and enable it for ten frames."
   (set! (-> *camera-other-fov* data) (cam-slave-get-fov (-> self cam-entity)))
   (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) *camera-other-trans* 'trans)
-  (set! (-> *camera-other-root* quad) (-> *camera-other-trans* quad))
+  (vector-copy! *camera-other-root* *camera-other-trans*)
   (cam-slave-get-rot (the-as entity-actor (-> self cam-entity)) *camera-other-matrix*)
   (set! *camera-look-through-other* 10)
   (set! *camera-read-analog* #f)
@@ -1566,15 +1546,8 @@
   (let ((print? (logtest? (the-as int options) 8))
         (named-file? (logtest? (the-as int options) 16)))
     (if print? (format #t "~%~%~%=================================~%"))
-    (let ((node (-> *camera-engine* alive-list next0)))
-      *camera-engine*
-      (let ((next-node (-> node next0)))
-        (while (!= node (-> *camera-engine* alive-list-end))
-          (let ((camera (-> (the-as connection node) param1)))
-            (clmf-save-single (the-as entity-camera camera) print? named-file?))
-          (set! node next-node)
-          *camera-engine*
-          (set! next-node (-> next-node next0)))))
+    (iterate-engine-connections (node *camera-engine*) (let ((camera (-> (the-as connection node) param1)))
+                (clmf-save-single (the-as entity-camera camera) print? named-file?)))
     (if print? (format #t "===============================~%~%~%~%"))
     (if named-file? (format #t "camera save all completed~%")))
   #t)
@@ -2858,15 +2831,7 @@
    and enter the active camera-layout state."
   (set! (-> self res-key) -1000000000.0)
   (set! (-> self num-entities) 0)
-  (let ((node (-> *camera-engine* alive-list next0)))
-    *camera-engine*
-    (let ((next-node (-> node next0)))
-      (while (!= node (-> *camera-engine* alive-list-end))
-        (-> (the-as connection node) param1)
-        (+! (-> self num-entities) 1)
-        (set! node next-node)
-        *camera-engine*
-        (set! next-node (-> next-node next0)))))
+  (iterate-engine-connections (node *camera-engine*) (-> (the-as connection node) param1) (+! (-> self num-entities) 1))
   (set! (-> self cur-entity) *last-cur-entity*)
   (clmf-next-entity 0)
   (set! *clm* *clm-select*)

goal_src/jak1/engine/camera/cam-master.gc

@@ -43,22 +43,22 @@
 (defbehavior reset-follow camera-master ()
   "Reset the tracked player position and vertical speed without
    rebuilding the rest of the tracking state."
-  (set! (-> self tpos-old quad) (-> (target-cam-pos) quad))
-  (set! (-> self tpos-curr quad) (-> self tpos-old quad))
-  (set! (-> self tpos-old-adj quad) (-> self tpos-old quad))
-  (set! (-> self tpos-curr-adj quad) (-> self tpos-old quad))
-  (set! (-> self tpos-tgt quad) (-> self tpos-old quad))
+  (vector-copy! (-> self tpos-old) (target-cam-pos))
+  (vector-copy! (-> self tpos-curr) (-> self tpos-old))
+  (vector-copy! (-> self tpos-old-adj) (-> self tpos-old))
+  (vector-copy! (-> self tpos-curr-adj) (-> self tpos-old))
+  (vector-copy! (-> self tpos-tgt) (-> self tpos-old))
   (set! (-> self upspeed) 0.0))
 
 (defbehavior reset-target-tracking camera-master ()
   "Reset all target tracking state from the player, including
    position and facing, attack-aware string limits, water state, vertical offsets, and the target
    trail."
-  (set! (-> self tpos-old quad) (-> (target-cam-pos) quad))
-  (set! (-> self tpos-curr quad) (-> self tpos-old quad))
-  (set! (-> self tpos-old-adj quad) (-> self tpos-old quad))
-  (set! (-> self tpos-curr-adj quad) (-> self tpos-old quad))
-  (set! (-> self tpos-tgt quad) (-> self tpos-old quad))
+  (vector-copy! (-> self tpos-old) (target-cam-pos))
+  (vector-copy! (-> self tpos-curr) (-> self tpos-old))
+  (vector-copy! (-> self tpos-old-adj) (-> self tpos-old))
+  (vector-copy! (-> self tpos-curr-adj) (-> self tpos-old))
+  (vector-copy! (-> self tpos-tgt) (-> self tpos-old))
   (quaternion->matrix (-> self tgt-rot-mat) (-> *target* control dir-targ))
   (quaternion->matrix (-> self tgt-face-mat) (-> *target* control quat-for-control))
   (vector-reset! (-> self pitch-off))
@@ -101,10 +101,10 @@
   (let ((tracked-target (the-as target (-> self drawable-target process 0))))
     (if (nonzero? (-> tracked-target node-list))
       (vector<-cspace! (-> self tpos-old) (-> tracked-target node-list data (-> self which-bone)))
-      (set! (-> self tpos-old quad) (-> tracked-target control trans quad))))
-  (set! (-> self tpos-curr quad) (-> self tpos-old quad))
-  (set! (-> self tpos-old-adj quad) (-> self tpos-old quad))
-  (set! (-> self tpos-curr-adj quad) (-> self tpos-old quad))
+      (vector-copy! (-> self tpos-old) (-> tracked-target control trans))))
+  (vector-copy! (-> self tpos-curr) (-> self tpos-old))
+  (vector-copy! (-> self tpos-old-adj) (-> self tpos-old))
+  (vector-copy! (-> self tpos-curr-adj) (-> self tpos-old))
   (set! (-> self upspeed) 0.0))
 
 (defbehavior reset-drawable-tracking camera-master ()
@@ -114,43 +114,16 @@
     (cond
       ((nonzero? (-> tracked-target node-list))
        (vector<-cspace! (-> self tpos-old) (-> tracked-target node-list data (-> self which-bone)))
-       (let* ((target-rotation (-> self tgt-rot-mat))
-              (bone-matrix (-> tracked-target node-list data (-> self which-bone) bone transform))
-              (row-0 (-> bone-matrix vector 0 quad))
-              (row-1 (-> bone-matrix vector 1 quad))
-              (row-2 (-> bone-matrix vector 2 quad))
-              (row-3 (-> bone-matrix vector 3 quad)))
-         (set! (-> target-rotation vector 0 quad) row-0)
-         (set! (-> target-rotation vector 1 quad) row-1)
-         (set! (-> target-rotation vector 2 quad) row-2)
-         (set! (-> target-rotation vector 3 quad) row-3))
+       (matrix-copy! (-> self tgt-rot-mat) (-> tracked-target node-list data (-> self which-bone) bone transform))
        (set! (-> self tgt-rot-mat vector 3 quad) (the-as uint128 0))
-       (let* ((target-facing (-> self tgt-face-mat))
-              (rotation-source (-> self tgt-rot-mat))
-              (row-0 (-> rotation-source vector 0 quad))
-              (row-1 (-> rotation-source vector 1 quad))
-              (row-2 (-> rotation-source vector 2 quad))
-              (row-3 (-> rotation-source vector 3 quad)))
-         (set! (-> target-facing vector 0 quad) row-0)
-         (set! (-> target-facing vector 1 quad) row-1)
-         (set! (-> target-facing vector 2 quad) row-2)
-         (set! (-> target-facing vector 3 quad) row-3)))
+       (matrix-copy! (-> self tgt-face-mat) (-> self tgt-rot-mat)))
       (else
-       (set! (-> self tpos-old quad) (-> tracked-target control trans quad))
+       (vector-copy! (-> self tpos-old) (-> tracked-target control trans))
        (quaternion->matrix (-> self tgt-rot-mat) (-> tracked-target control quat))
-       (let* ((target-facing (-> self tgt-face-mat))
-              (rotation-source (-> self tgt-rot-mat))
-              (row-0 (-> rotation-source vector 0 quad))
-              (row-1 (-> rotation-source vector 1 quad))
-              (row-2 (-> rotation-source vector 2 quad))
-              (row-3 (-> rotation-source vector 3 quad)))
-         (set! (-> target-facing vector 0 quad) row-0)
-         (set! (-> target-facing vector 1 quad) row-1)
-         (set! (-> target-facing vector 2 quad) row-2)
-         (set! (-> target-facing vector 3 quad) row-3)))))
-  (set! (-> self tpos-curr quad) (-> self tpos-old quad))
-  (set! (-> self tpos-old-adj quad) (-> self tpos-old quad))
-  (set! (-> self tpos-curr-adj quad) (-> self tpos-old quad))
+       (matrix-copy! (-> self tgt-face-mat) (-> self tgt-rot-mat)))))
+  (vector-copy! (-> self tpos-curr) (-> self tpos-old))
+  (vector-copy! (-> self tpos-old-adj) (-> self tpos-old))
+  (vector-copy! (-> self tpos-curr-adj) (-> self tpos-old))
   (vector-reset! (-> self pitch-off))
   (set! (-> self upspeed) 0.0)
   (set! (-> self foot-offset) (-> *CAMERA_MASTER-bank* onscreen-foot-height))
@@ -182,44 +155,18 @@
     ((and (logtest? (-> self master-options) 2) (handle->process (-> self drawable-target)))
      (let ((tracked-target (-> self drawable-target process 0)))
        (if (paused?) (return (the-as symbol #f)))
-       (set! (-> self tpos-old quad) (-> self tpos-curr quad))
-       (set! (-> self tpos-old-adj quad) (-> self tpos-curr-adj quad))
+       (vector-copy! (-> self tpos-old) (-> self tpos-curr))
+       (vector-copy! (-> self tpos-old-adj) (-> self tpos-curr-adj))
        (cond
          ((nonzero? (-> (the-as target tracked-target) node-list))
-          (let* ((target-rotation (-> self tgt-rot-mat))
-                 (bone-matrix (-> (the-as target tracked-target) node-list data (-> self which-bone) bone transform))
-                 (row-0 (-> bone-matrix vector 0 quad))
-                 (row-1 (-> bone-matrix vector 1 quad))
-                 (row-2 (-> bone-matrix vector 2 quad))
-                 (row-3 (-> bone-matrix vector 3 quad)))
-            (set! (-> target-rotation vector 0 quad) row-0)
-            (set! (-> target-rotation vector 1 quad) row-1)
-            (set! (-> target-rotation vector 2 quad) row-2)
-            (set! (-> target-rotation vector 3 quad) row-3))
+          (matrix-copy! (-> self tgt-rot-mat)
+                        (-> (the-as target tracked-target) node-list data (-> self which-bone) bone transform))
           (set! (-> self tgt-rot-mat vector 3 quad) (the-as uint128 0))
-          (let* ((target-facing (-> self tgt-face-mat))
-                 (rotation-source (-> self tgt-rot-mat))
-                 (row-0 (-> rotation-source vector 0 quad))
-                 (row-1 (-> rotation-source vector 1 quad))
-                 (row-2 (-> rotation-source vector 2 quad))
-                 (row-3 (-> rotation-source vector 3 quad)))
-            (set! (-> target-facing vector 0 quad) row-0)
-            (set! (-> target-facing vector 1 quad) row-1)
-            (set! (-> target-facing vector 2 quad) row-2)
-            (set! (-> target-facing vector 3 quad) row-3))
+          (matrix-copy! (-> self tgt-face-mat) (-> self tgt-rot-mat))
           (vector<-cspace! (-> self tpos-curr) (-> (the-as target tracked-target) node-list data (-> self which-bone))))
          (else
           (quaternion->matrix (-> self tgt-rot-mat) (-> (the-as target tracked-target) control quat))
-          (let* ((target-facing (-> self tgt-face-mat))
-                 (rotation-source (-> self tgt-rot-mat))
-                 (row-0 (-> rotation-source vector 0 quad))
-                 (row-1 (-> rotation-source vector 1 quad))
-                 (row-2 (-> rotation-source vector 2 quad))
-                 (row-3 (-> rotation-source vector 3 quad)))
-            (set! (-> target-facing vector 0 quad) row-0)
-            (set! (-> target-facing vector 1 quad) row-1)
-            (set! (-> target-facing vector 2 quad) row-2)
-            (set! (-> target-facing vector 3 quad) row-3)))))
+          (matrix-copy! (-> self tgt-face-mat) (-> self tgt-rot-mat)))))
      (let ((ground-adjust (new-stack-vector0)))
        0.0
        (vector-! ground-adjust (-> self tpos-curr-adj) (-> self tpos-curr))
@@ -255,8 +202,8 @@
                      (not (logtest? (-> *target* water flag) (water-flag swim-ground))))
                 (set! (-> self under-water) 2))
                ((> (-> self under-water) 0) (+! (-> self under-water) -1)))
-             (set! (-> self tpos-old quad) (-> self tpos-curr quad))
-             (set! (-> self tpos-old-adj quad) (-> self tpos-curr-adj quad))
+             (vector-copy! (-> self tpos-old) (-> self tpos-curr))
+             (vector-copy! (-> self tpos-old-adj) (-> self tpos-curr-adj))
              (quaternion->matrix (-> self tgt-rot-mat) (-> *target* control dir-targ))
              (quaternion->matrix (-> self tgt-face-mat) (-> *target* control quat-for-control))
              ;; A newly selected target eases from its saved position.  The optional destination
@@ -271,7 +218,7 @@
                   (else
                    (vector-lerp! (-> self tpos-curr) (-> self ease-from) (target-cam-pos) (parameter-ease-sin-clamp (-> self ease-t)))))
                 (+! (-> self ease-t) (-> self ease-step)))
-               (else (set! (-> self tpos-curr quad) (-> (target-cam-pos) quad))))
+               (else (vector-copy! (-> self tpos-curr) (target-cam-pos))))
              ;; During an edge grab, sweep a broad sphere along the target-facing axis and back the
              ;; tracked position away from any camera-blocking surface encountered before the end.
              (when (logtest? (-> *target* control root-prim prim-core action) (collide-action edgegrab-cam))
@@ -333,7 +280,7 @@
                       ((logtest? (-> *target* water flag) (water-flag touch-water)) (set! (-> self upspeed) 0.0))
                       ((< 0.0 ground-vertical-delta) (set! (-> self upspeed) 0.0))
                       (else (set! (-> self upspeed) ground-vertical-delta))))
-                  (set! (-> self tpos-tgt quad) (-> self tpos-curr quad))
+                  (vector-copy! (-> self tpos-tgt) (-> self tpos-curr))
                   (vector-! tracking-delta (-> self tpos-curr-adj) (-> self tpos-curr))
                   (let* ((ground-adjust-delta (vector-dot tracking-delta (-> self local-down)))
                          (ground-pitch-adjust (if (< 0.0 ground-adjust-delta)
@@ -567,17 +514,11 @@
                          *res-static-buf*)))))
      #f)
     (else
-     (let ((connection (-> *camera-engine* alive-list next0)))
-       *camera-engine*
-       (let ((next-connection (-> connection next0)))
-         (while (!= connection (-> *camera-engine* alive-list-end))
-           (let ((region (-> (the-as connection connection) param1)))
-             (when (and (not (in-cam-entity-volume? (target-pos 0) (the-as entity region) 1024.0 'cutoutvol))
-                        (in-cam-entity-volume? (target-pos 0) (the-as entity region) 0.0 'vol))
-               (if (master-switch-to-entity (the-as entity region)) (return #t))))
-           (set! connection next-connection)
-           *camera-engine*
-           (set! next-connection (-> next-connection next0)))))
+     (iterate-engine-connections (connection *camera-engine*)
+                                 (let ((region (-> (the-as connection connection) param1)))
+                                   (when (and (not (in-cam-entity-volume? (target-pos 0) (the-as entity region) 1024.0 'cutoutvol))
+                                              (in-cam-entity-volume? (target-pos 0) (the-as entity region) 0.0 'vol))
+                                     (if (master-switch-to-entity (the-as entity region)) (return #t)))))
      (master-unset-region))))
 
 ;; The master owns at most two camera slaves.  A change-state event may name a state to instantiate
@@ -626,7 +567,7 @@
                      (send-event self 'teleport))))
             ((= event-type 'teleport-to-other-start-string)
              (let ((aim-direction (new 'stack-no-clear 'vector)))
-               (set! (-> *camera-combiner* trans quad) (-> *camera-other-trans* quad))
+               (vector-copy! (-> *camera-combiner* trans) *camera-other-trans*)
                (vector-! aim-direction (-> self tpos-curr-adj) *camera-other-trans*)
                (vector-normalize! aim-direction 1.0)
                (forward-down->inv-matrix (-> *camera-combiner* inv-camera-rot) aim-direction (new 'static 'vector :y -1.0)))
@@ -644,7 +585,7 @@
                    (when (> argc 0)
                      (let ((start-position (the-as object (-> block param 0)))
                            (aim-direction (new 'stack-no-clear 'vector)))
-                       (set! (-> *camera-combiner* trans quad) (-> (the-as vector start-position) quad))
+                       (vector-copy! (-> *camera-combiner* trans) (the-as vector start-position))
                        (vector-! aim-direction (-> self tpos-curr-adj) (the-as vector start-position))
                        (vector-normalize! aim-direction 1.0)
                        (forward-down->inv-matrix (-> *camera-combiner* inv-camera-rot) aim-direction (new 'static 'vector :y -1.0)))
@@ -684,7 +625,7 @@
              (set! result #f))
             ((= event-type 'reset-root)
              (dotimes (i (-> self num-slaves))
-               (set! (-> self slave i 0 trans quad) (the-as uint128 0))
+               (vector-zero! (-> self slave i 0 trans))
                (matrix-identity! (-> self slave i 0 tracking inv-mat)))
              (vector-reset! (-> *camera-combiner* trans))
              (set! result (matrix-identity! (-> *camera-combiner* tracking inv-mat))))
@@ -897,11 +838,11 @@
                 (logand! (-> self master-options) -33))
                (else
                 (if (< (the-as float (-> block param 0)) (-> self ease-t)) (set! (-> self ease-t) (the-as float (-> block param 0))))
-                (set! (-> self ease-to quad) (-> (the-as vector (-> block param 1)) quad))
+                (vector-copy! (-> self ease-to) (the-as vector (-> block param 1)))
                 (logior! (-> self master-options) 32)))
              (set! (-> self ease-step) 0.033333335)
              (set! result (-> self ease-from))
-             (set! (-> (the-as vector result) quad) (-> self tpos-curr-adj quad)))
+             (vector-copy! (the-as vector result) (-> self tpos-curr-adj)))
             ((= event-type 'damp-up) (let ((zero-speed 0.0)) (set! (-> self upspeed) zero-speed) (set! result zero-speed)))
             ((= event-type 'reset-follow)
              (set! result (if (handle->process (-> self drawable-target)) (reset-drawable-follow) (reset-follow))))

goal_src/jak1/engine/camera/cam-states.gc

@@ -24,7 +24,7 @@
   :enter
     (behavior ()
       (when (not (-> self enter-has-run))
-        (set! (-> self saved-pt quad) (-> self trans quad))
+        (vector-copy! (-> self saved-pt) (-> self trans))
         (set! (-> self blend-from-type) (the-as uint 1))
         (set! (-> self blend-to-type) (the-as uint 0))
         0))
@@ -33,7 +33,7 @@
       (loop
         (when (not (paused?))
           (let ((curve-forward (new 'stack-no-clear 'vector)))
-            (set! (-> self trans quad) (-> self saved-pt quad))
+            (vector-copy! (-> self trans) (-> self saved-pt))
             (cam-curve-pos (-> self trans) curve-forward (the-as curve #f) #f)
             (when (!= (-> curve-forward w) 0.0)
               (vector-normalize! curve-forward (the-as float 1.0))
@@ -92,16 +92,9 @@
         (when (not (paused?))
           (vector<-cspace! (-> self trans)
                            (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone)))
-          (let* ((tracking (-> self tracking))
-                 (bone-transform (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone) bone transform))
-                 (row-0 (-> bone-transform vector 0 quad))
-                 (row-1 (-> bone-transform vector 1 quad))
-                 (row-2 (-> bone-transform vector 2 quad))
-                 (row-3 (-> bone-transform vector 3 quad)))
-            (set! (-> tracking inv-mat vector 0 quad) row-0)
-            (set! (-> tracking inv-mat vector 1 quad) row-1)
-            (set! (-> tracking inv-mat vector 2 quad) row-2)
-            (set! (-> tracking inv-mat vector 3 quad) row-3))
+          (matrix-copy!
+            (-> self tracking inv-mat)
+            (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone) bone transform))
           (vector-reset! (-> self tracking inv-mat vector 3)))
         (suspend))))
 
@@ -143,7 +136,7 @@
                       (cond
                         ((and (< (vector-vector-distance position previous-position) 40960.0)
                               (< (cos (the-as float 3640.889)) (vector-dot previous-forward forward)))
-                         (set! (-> self trans quad) (-> position quad))
+                         (vector-copy! (-> self trans) position)
                          (vector-negate! (the-as vector (-> self tracking)) (-> bone-transform vector 0))
                          (set! (-> self tracking inv-mat vector 1 quad) (-> bone-transform vector 1 quad))
                          (vector-negate! (-> self tracking inv-mat vector 2) (-> bone-transform vector 2))
@@ -153,8 +146,8 @@
                          (if first-valid-frame? (set! first-valid-frame? #f))
                          first-valid-frame?)
                         (else #t)))
-                (set! (-> previous-position quad) (-> position quad)))
-              (set! (-> previous-forward quad) (-> forward quad))))
+                (vector-copy! previous-position position))
+              (vector-copy! previous-forward forward)))
           (suspend)))))
 
 (defstate cam-pov-track (camera-slave)
@@ -463,7 +456,7 @@
          (vector-negate! (-> self saved-pt) (-> self spline-offset))
          (let ((spline-offset-data (res-lump-struct (-> self cam-entity) 'spline-offset structure :time (the-as float -1000000000.0))))
            (if spline-offset-data (vector+! (-> self spline-offset) (-> self spline-offset) (the-as vector spline-offset-data))))
-         (set! (-> self trans quad) (-> self saved-pt quad))
+         (vector-copy! (-> self trans) (-> self saved-pt))
          (cam-calc-follow! (-> self tracking) (-> self trans) #f)
          (set! (-> self spline-follow-dist) (cam-slave-get-float (-> self cam-entity) 'spline-follow-dist (the-as float 0.0)))
          (cond
@@ -503,7 +496,7 @@
         (when (not (paused?))
           (cam-calc-follow! (-> self tracking) (-> self trans) #t)
           (new 'stack 'curve)
-          (set! (-> self trans quad) (-> self saved-pt quad))
+          (vector-copy! (-> self trans) (-> self saved-pt))
           (cam-curve-pos (-> self trans) (the-as vector #f) (the-as curve #f) #t))
         (suspend))))
 
@@ -517,7 +510,7 @@
         (else (cam-standard-event-handler proc argc message block))))
   :enter
     (behavior ()
-      (if (not (-> self enter-has-run)) (set! (-> self saved-pt quad) (-> self trans quad))))
+      (if (not (-> self enter-has-run)) (vector-copy! (-> self saved-pt) (-> self trans))))
   :code
     (behavior ()
       (loop
@@ -558,16 +551,16 @@
             (vertical-speed (-> self velocity y)))
         (let ((horizontal-position (new 'stack-no-clear 'vector))
               (horizontal-velocity (new 'stack-no-clear 'vector)))
-          (set! (-> horizontal-position quad) (-> self trans quad))
+          (vector-copy! horizontal-position (-> self trans))
           (set! (-> horizontal-position y) 0.0)
-          (set! (-> horizontal-velocity quad) (-> self velocity quad))
+          (vector-copy! horizontal-velocity (-> self velocity))
           (set! (-> horizontal-velocity y) 0.0)
           (init! horizontal-seeker
                  horizontal-position
                  (the-as float 81.92)
                  (fmax 819.2 (vector-length horizontal-velocity))
                  (the-as float 0.75))
-          (set! (-> horizontal-seeker vel quad) (-> horizontal-velocity quad)))
+          (vector-copy! (-> horizontal-seeker vel) horizontal-velocity))
         (loop
           (when (not (paused?))
             (set! (-> horizontal-seeker target x) (-> (target-pos 0) x))
@@ -640,7 +633,7 @@
                              (* (fmin 1.0 (* approach-scale (-> *display* time-adjust-ratio))) (- (-> self max-angle-curr) angle))))
        (vector-matrix*! current-direction ideal-direction rotation))
       (else
-       (set! (-> current-direction quad) (-> ideal-direction quad))
+       (vector-copy! current-direction ideal-direction)
        (if (logtest? (-> self options) 2048) (set! (-> self max-angle-curr) angle)))))
   (vector-normalize! current-direction (-> self pivot-rad)))
 
@@ -669,7 +662,7 @@
 (defbehavior cam-circular-code camera-slave ()
   "Update the authored pivot, smoothly follow the target around it,
    constrain the camera to its orbit, and apply an optional position-driven focal pull."
-  (set! (-> self pivot-pt quad) (-> self saved-pt quad))
+  (vector-copy! (-> self pivot-pt) (-> self saved-pt))
   (cam-curve-pos (-> self pivot-pt) (the-as vector #f) (the-as curve #f) #f)
   (let ((target-from-pivot (new-stack-vector0)))
     (vector-! target-from-pivot (-> *camera* tpos-curr-adj) (-> self pivot-pt))
@@ -701,7 +694,7 @@
     (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
       (case message
         (('teleport) #f)
-        (('outro-done) (set! (-> self trans quad) (-> *camera-combiner* trans quad)) (cam-circular-position #f))
+        (('outro-done) (vector-copy! (-> self trans) (-> *camera-combiner* trans)) (cam-circular-position #f))
         (else (cam-standard-event-handler proc argc message block))))
   :enter
     (behavior ()
@@ -711,7 +704,7 @@
          (let ((authored-offset (new-stack-vector0)))
            (set! (-> (new 'stack-no-clear 'vector) quad) (the-as uint128 0))
            (set! (-> self view-off-param) 1.0)
-           (set! (-> self circular-follow quad) (-> *camera* tpos-curr-adj quad))
+           (vector-copy! (-> self circular-follow) (-> *camera* tpos-curr-adj))
            (set! (-> self max-angle-offset) 0.0)
            (cond
              ((-> self cam-entity)
@@ -733,21 +726,21 @@
                        (lerp-clamp (-> self fov0) (-> self fov1) (point->parameter (-> self fov-index) (-> *camera* tpos-curr-adj)))))
                 (else (set! (-> self fov1) 0.0)))
               (cam-curve-setup (-> self saved-pt))
-              (set! (-> self pivot-pt quad) (-> self saved-pt quad))
+              (vector-copy! (-> self pivot-pt) (-> self saved-pt))
               (cam-curve-pos (-> self pivot-pt) (the-as vector #f) (the-as curve #f) #f))
              ((logtest? (-> self options) 128)
               (vector-! (-> self pivot-pt) (-> *camera* tpos-curr-adj) (-> self trans))
               (vector-flatten! (-> self pivot-pt) (-> self pivot-pt) (-> *camera* local-down))
               (set! (-> self pivot-rad) (vector-length (-> self pivot-pt)))
-              (set! (-> self pivot-pt quad) (-> self trans quad))
-              (set! (-> self saved-pt quad) (-> self pivot-pt quad)))
+              (vector-copy! (-> self pivot-pt) (-> self trans))
+              (vector-copy! (-> self saved-pt) (-> self pivot-pt)))
              (else
               (vector-! (-> self pivot-pt) (-> *camera* tpos-curr-adj) (-> self trans))
               (vector-float*! (-> self pivot-pt) (-> self pivot-pt) 0.5)
               (vector-flatten! (-> self pivot-pt) (-> self pivot-pt) (-> *camera* local-down))
               (set! (-> self pivot-rad) (vector-length (-> self pivot-pt)))
               (vector+! (-> self pivot-pt) (-> self trans) (-> self pivot-pt))
-              (set! (-> self saved-pt quad) (-> self pivot-pt quad)))))
+              (vector-copy! (-> self saved-pt) (-> self pivot-pt)))))
          (cam-circular-position #f)
          (set! (-> self blend-from-type) (the-as uint 2))
          (set! (-> self blend-to-type) (the-as uint 2))))
@@ -799,7 +792,7 @@
     (if (= (vector-normalize-ret-len! default-offset (- (+ 1024.0 (-> *CAMERA-bank* default-string-min-z)))) 0.0)
       (set! (-> default-offset z) (+ 1024.0 (-> *CAMERA-bank* default-string-min-z))))
     (vector--float*! default-offset default-offset (-> *camera* local-down) (-> *CAMERA-bank* default-string-min-y))
-    (set! (-> out-offset quad) (-> default-offset quad))
+    (vector-copy! out-offset default-offset)
     (loop
       (vector--float*! target-offset out-offset (-> *camera* local-down) (-> *camera* target-height))
       (if (< (fill-and-probe-using-line-sphere *collide-cache*
@@ -816,7 +809,7 @@
             (cond
               ((>= -32768.0 search-angle)
                (format #t "cam-string didn't find a spot~%")
-               (set! (-> out-offset quad) (-> default-offset quad))
+               (vector-copy! out-offset default-offset)
                (return #f)
                search-angle)
               ((< 0.0 search-angle) (- search-angle))
@@ -831,7 +824,7 @@
   (vector-flatten! (-> self view-flat) relative-offset (-> *camera* local-down))
   (set! (-> self min-z-override) (vector-length (-> self view-flat)))
   (vector+! (-> self desired-pos) relative-offset (-> *camera* tpos-curr-adj))
-  (set! (-> self string-trans quad) (-> self desired-pos quad))
+  (vector-copy! (-> self string-trans) (-> self desired-pos))
   (reset! (-> self position-spline) (-> self desired-pos))
   (vector-reset! (-> self velocity))
   (let ((options-without-jump (logand -4097 (-> self options))))
@@ -1247,14 +1240,14 @@
        (set! (-> self los-tgt-spline-pt) (-> *camera* target-spline used-point))
        (set! (-> self los-tgt-spline-pt-incarnation) (-> *camera* target-spline point (-> self los-tgt-spline-pt) incarnation))
        (logior! (-> self options) 4096)
-       (set! (-> self good-point quad) (-> *camera* target-spline point (-> *camera* target-spline used-point) position quad))
-       (set! (-> self los-last-pos quad) (-> self good-point quad))
+       (vector-copy! (-> self good-point) (-> *camera* target-spline point (-> *camera* target-spline used-point) position))
+       (vector-copy! (-> self los-last-pos) (-> self good-point))
        (when *debug-segment*
          (let ((jump-displacement (new 'stack-no-clear 'vector)))
            (vector-! jump-displacement (-> self good-point) (-> self string-trans))
            (cam-collision-record-save (-> self string-trans) jump-displacement -3 'jump self)))
-       (set! (-> self desired-pos quad) (-> self good-point quad))
-       (set! (-> self string-trans quad) (-> self good-point quad))
+       (vector-copy! (-> self desired-pos) (-> self good-point))
+       (vector-copy! (-> self string-trans) (-> self good-point))
        (vector-! (-> self view-flat) (-> self string-trans) (-> *camera* tpos-curr-adj))
        (vector-flatten! (-> self view-flat) (-> self view-flat) (-> *camera* local-down))
        (vector-reset! (-> self velocity))
@@ -1269,7 +1262,7 @@
             (if *display-cam-los-debug* (format *stdcon* "good ~f~%" trail-hit-fraction))
             (set! (-> self los-tgt-spline-pt) (-> *camera* target-spline end-point))
             (set! (-> self los-tgt-spline-pt-incarnation) (-> *camera* target-spline point (-> self los-tgt-spline-pt) incarnation))
-            (set! (-> self los-last-pos quad) (-> camera-position quad)))
+            (vector-copy! (-> self los-last-pos) camera-position))
            ((begin
               (if *display-cam-los-debug*
                 (format *stdcon*
@@ -1296,14 +1289,14 @@
             (set! (-> self los-tgt-spline-pt) (-> *camera* target-spline point trail-index next))
             (set! (-> self los-tgt-spline-pt-incarnation) (-> *camera* target-spline point (-> self los-tgt-spline-pt) incarnation))
             (logior! (-> self options) 4096)
-            (set! (-> self good-point quad) (-> *camera* target-spline point trail-index position quad))
-            (set! (-> self los-last-pos quad) (-> self good-point quad))
+            (vector-copy! (-> self good-point) (-> *camera* target-spline point trail-index position))
+            (vector-copy! (-> self los-last-pos) (-> self good-point))
             (when *debug-segment*
               (let ((jump-displacement (new 'stack-no-clear 'vector)))
                 (vector-! jump-displacement (-> self good-point) (-> self string-trans))
                 (cam-collision-record-save (-> self string-trans) jump-displacement -3 'jump self)))
-            (set! (-> self desired-pos quad) (-> self good-point quad))
-            (set! (-> self string-trans quad) (-> self good-point quad))
+            (vector-copy! (-> self desired-pos) (-> self good-point))
+            (vector-copy! (-> self string-trans) (-> self good-point))
             (vector-! (-> self view-flat) (-> self string-trans) (-> *camera* tpos-curr-adj))
             (vector-flatten! (-> self view-flat) (-> self view-flat) (-> *camera* local-down))
             (vector-reset! (-> self velocity))
@@ -1313,7 +1306,7 @@
             (if *display-cam-los-debug* (format *stdcon* " ok~%"))
             (set! (-> self los-tgt-spline-pt) last-clear-index)
             (set! (-> self los-tgt-spline-pt-incarnation) (-> *camera* target-spline point (-> self los-tgt-spline-pt) incarnation))
-            (set! (-> self los-last-pos quad) (-> camera-position quad)))
+            (vector-copy! (-> self los-last-pos) camera-position))
            (else
             (if *display-cam-los-debug*
               (format *stdcon*
@@ -1356,7 +1349,7 @@
                     (vector+! (-> self good-point)
                               (-> self good-point)
                               (the-as vector (+ (the-as uint (-> *camera* target-spline)) (* 48 (-> self los-tgt-spline-pt)))))
-                    (set! (-> self los-last-pos quad) (-> self good-point quad))
+                    (vector-copy! (-> self los-last-pos) (-> self good-point))
                     (when *display-cam-los-debug*
                       (format 0 "going because u(~f) > 0 frame ~D~%" recovery-fraction (current-time))
                       (format *stdcon* " going because u(~f) > 0 frame ~D~%" recovery-fraction (current-time)))
@@ -1721,7 +1714,7 @@
          (vector-! jump-displacement (-> self good-point) (-> self string-trans))
          (cam-collision-record-save (-> self string-trans) jump-displacement -2 'jump self)))
      (logand! (-> self options) -4097)
-     (set! (-> self desired-pos quad) (-> self good-point quad))
+     (vector-copy! (-> self desired-pos) (-> self good-point))
      (cam-string-move)
      (vector-! (-> self view-flat) (-> self string-trans) (-> *camera* tpos-curr-adj))
      (vector-flatten! (-> self view-flat) (-> self view-flat) (-> *camera* local-down))
@@ -1742,9 +1735,9 @@
   "Refresh the string camera's minimum and maximum offset vectors
    from the camera master unless the values are locked."
   (when (not (-> self string-val-locked))
-    (set! (-> self string-min-val quad) (-> *camera* string-min value quad))
+    (vector-copy! (-> self string-min-val) (-> *camera* string-min value))
     (let ((maximum-values (-> self string-max-val)))
-      (set! (-> maximum-values quad) (-> *camera* string-max value quad))
+      (vector-copy! maximum-values (-> *camera* string-max value))
       maximum-values)))
 
 ;; Main third-person camera.  view-flat is the horizontal target-to-camera string.  Each frame it
@@ -1768,8 +1761,8 @@
          (cond
            ((-> block param 0)
             (set! (-> self string-val-locked) #t)
-            (set! (-> self string-min-val quad) (-> (the-as vector (-> block param 0)) quad))
-            (set! (-> self string-max-val quad) (-> (the-as vector (-> block param 1)) quad))
+            (vector-copy! (-> self string-min-val) (the-as vector (-> block param 0)))
+            (vector-copy! (-> self string-max-val) (the-as vector (-> block param 1)))
             (set! (-> self string-max-val x) (fmax (-> self string-max-val x) (-> self string-min-val x)))
             (set! (-> self string-max-val y) (fmax (-> self string-max-val y) (-> self string-min-val y)))
             (set! (-> self string-max-val z) (fmax (-> self string-max-val z) (-> self string-min-val z))))
@@ -1823,7 +1816,7 @@
                          (-> *camera* local-down)
                          (+ (-> *camera* target-height) (-> self view-off y)))
         (vector+! (-> self desired-pos) (-> self desired-pos) (-> *camera* tpos-curr-adj))
-        (set! (-> self string-trans quad) (-> self desired-pos quad))
+        (vector-copy! (-> self string-trans) (-> self desired-pos))
         (vector-reset! (-> self velocity))
         (let ((probe-result (new 'stack-no-clear 'collide-tri-result))
               (target-head (new 'stack-no-clear 'vector))
@@ -1861,10 +1854,10 @@
                                     (-> *camera* local-down)
                                     (+ (-> *camera* target-height) (-> self view-off y)))
                    (vector+! (-> self desired-pos) (-> self desired-pos) (-> *camera* tpos-curr-adj))
-                   (set! (-> self string-trans quad) (-> self desired-pos quad))
+                   (vector-copy! (-> self string-trans) (-> self desired-pos))
                    (vector-reset! (-> self velocity))))))))
-        (set! (-> self trans quad) (-> self string-trans quad))
-        (set! (-> self los-last-pos quad) (-> self string-trans quad))
+        (vector-copy! (-> self trans) (-> self string-trans))
+        (vector-copy! (-> self los-last-pos) (-> self string-trans))
         (reset! (-> self position-spline) (-> self string-trans))
         (set! (-> self blend-from-type) (the-as uint 2))
         (set! (-> self blend-to-type) (the-as uint 2))))
@@ -1974,7 +1967,7 @@
         (vector-normalize! (-> self view-flat) (-> self view-off z))
         (vector--float*! (-> self desired-pos) (-> self view-flat) (-> *camera* local-down) (-> self view-off y))
         (vector+! (-> self desired-pos) (-> self desired-pos) (-> self tracking follow-pt))
-        (set! (-> self trans quad) (-> self desired-pos quad))
+        (vector-copy! (-> self trans) (-> self desired-pos))
         (vector-reset! (-> self velocity))
         (set! (-> self blend-from-type) (the-as uint 2))
         (set! (-> self blend-to-type) (the-as uint 2))
@@ -2139,7 +2132,7 @@
         (vector-normalize! (-> self view-flat) (-> self view-off z))
         (vector--float*! (-> self desired-pos) (-> self view-flat) (-> *camera* local-down) (-> self view-off y))
         (vector+! (-> self desired-pos) (-> self desired-pos) (-> *camera* tpos-curr-adj))
-        (set! (-> self trans quad) (-> self desired-pos quad))
+        (vector-copy! (-> self trans) (-> self desired-pos))
         (vector-reset! (-> self velocity))
         (set! (-> self blend-from-type) (the-as uint 0))
         (set! (-> self blend-to-type) (the-as uint 1))

goal_src/jak1/engine/camera/cam-update.gc

@@ -185,16 +185,7 @@
         (if (= (vector-length up) 0.0) (set! (-> up y) -1.0))
         (if (logtest? *external-cam-options* (external-cam-option allow-z)) (set! up (the-as vector #f)))
         (cam-free-floating-move *save-camera-inv-rot* (-> camera trans) up controller-index))))
-  (let* ((destination-matrix (-> *math-camera* inv-camera-rot))
-         (source-matrix *save-camera-inv-rot*)
-         (row-0 (-> source-matrix vector 0 quad))
-         (row-1 (-> source-matrix vector 1 quad))
-         (row-2 (-> source-matrix vector 2 quad))
-         (row-3 (-> source-matrix vector 3 quad)))
-    (set! (-> destination-matrix vector 0 quad) row-0)
-    (set! (-> destination-matrix vector 1 quad) row-1)
-    (set! (-> destination-matrix vector 2 quad) row-2)
-    (set! (-> destination-matrix vector 3 quad) row-3))
+  (matrix-copy! (-> *math-camera* inv-camera-rot) *save-camera-inv-rot*)
   camera)
 
 ;; og:preserve-this PAL patch here (moved from cam-debug)
@@ -204,17 +195,8 @@
   (vector-reset! (-> *math-camera* trans))
   (matrix-identity! (-> *math-camera* inv-camera-rot))
   (when *camera-combiner*
-    (let* ((destination-matrix (-> *math-camera* inv-camera-rot))
-           (source-matrix (-> *camera-combiner* inv-camera-rot))
-           (row-0 (-> source-matrix vector 0 quad))
-           (row-1 (-> source-matrix vector 1 quad))
-           (row-2 (-> source-matrix vector 2 quad))
-           (row-3 (-> source-matrix vector 3 quad)))
-      (set! (-> destination-matrix vector 0 quad) row-0)
-      (set! (-> destination-matrix vector 1 quad) row-1)
-      (set! (-> destination-matrix vector 2 quad) row-2)
-      (set! (-> destination-matrix vector 3 quad) row-3))
-    (set! (-> *math-camera* trans quad) (-> *camera-combiner* trans quad)))
+    (matrix-copy! (-> *math-camera* inv-camera-rot) (-> *camera-combiner* inv-camera-rot))
+    (vector-copy! (-> *math-camera* trans) (-> *camera-combiner* trans)))
   0
   (none))
 
@@ -251,7 +233,7 @@
               (-> *target* control trans x)
               (-> *target* control trans y)
               (-> *target* control trans z))
-      (set! (-> *start-pos* quad) (-> *target* control trans quad)))
+      (vector-copy! *start-pos* (-> *target* control trans)))
     (when (= *timer-value* 480)
       (format #t
               "Player pos = ~F ~F ~F~%"
@@ -299,52 +281,16 @@
     (*external-cam-mode* (move-camera-from-pad *math-camera*))
     ((nonzero? *camera-look-through-other*)
      (set! (-> *math-camera* fov) (-> *camera-other-fov* data))
-     (set! (-> *math-camera* trans quad) (-> *camera-other-trans* quad))
+     (vector-copy! (-> *math-camera* trans) *camera-other-trans*)
      (+! (-> *math-camera* trans y) (get-no-update *camera-smush-control*))
-     (let* ((destination-matrix (-> *math-camera* inv-camera-rot))
-            (source-matrix *camera-other-matrix*)
-            (row-0 (-> source-matrix vector 0 quad))
-            (row-1 (-> source-matrix vector 1 quad))
-            (row-2 (-> source-matrix vector 2 quad))
-            (row-3 (-> source-matrix vector 3 quad)))
-       (set! (-> destination-matrix vector 0 quad) row-0)
-       (set! (-> destination-matrix vector 1 quad) row-1)
-       (set! (-> destination-matrix vector 2 quad) row-2)
-       (set! (-> destination-matrix vector 3 quad) row-3))
-     (let* ((destination-matrix *save-camera-inv-rot*)
-            (source-matrix *camera-other-matrix*)
-            (row-0 (-> source-matrix vector 0 quad))
-            (row-1 (-> source-matrix vector 1 quad))
-            (row-2 (-> source-matrix vector 2 quad))
-            (row-3 (-> source-matrix vector 3 quad)))
-       (set! (-> destination-matrix vector 0 quad) row-0)
-       (set! (-> destination-matrix vector 1 quad) row-1)
-       (set! (-> destination-matrix vector 2 quad) row-2)
-       (set! (-> destination-matrix vector 3 quad) row-3)))
+     (matrix-copy! (-> *math-camera* inv-camera-rot) *camera-other-matrix*)
+     (matrix-copy! *save-camera-inv-rot* *camera-other-matrix*))
     ((and *camera-combiner* (not *external-cam-mode*))
      (set! (-> *math-camera* fov) (-> *camera-combiner* fov))
-     (set! (-> *math-camera* trans quad) (-> *camera-combiner* trans quad))
+     (vector-copy! (-> *math-camera* trans) (-> *camera-combiner* trans))
      (+! (-> *math-camera* trans y) (get-no-update *camera-smush-control*))
-     (let* ((destination-matrix (-> *math-camera* inv-camera-rot))
-            (source-matrix (-> *camera-combiner* inv-camera-rot))
-            (row-0 (-> source-matrix vector 0 quad))
-            (row-1 (-> source-matrix vector 1 quad))
-            (row-2 (-> source-matrix vector 2 quad))
-            (row-3 (-> source-matrix vector 3 quad)))
-       (set! (-> destination-matrix vector 0 quad) row-0)
-       (set! (-> destination-matrix vector 1 quad) row-1)
-       (set! (-> destination-matrix vector 2 quad) row-2)
-       (set! (-> destination-matrix vector 3 quad) row-3))
-     (let* ((destination-matrix *save-camera-inv-rot*)
-            (source-matrix (-> *camera-combiner* inv-camera-rot))
-            (row-0 (-> source-matrix vector 0 quad))
-            (row-1 (-> source-matrix vector 1 quad))
-            (row-2 (-> source-matrix vector 2 quad))
-            (row-3 (-> source-matrix vector 3 quad)))
-       (set! (-> destination-matrix vector 0 quad) row-0)
-       (set! (-> destination-matrix vector 1 quad) row-1)
-       (set! (-> destination-matrix vector 2 quad) row-2)
-       (set! (-> destination-matrix vector 3 quad) row-3)))
+     (matrix-copy! (-> *math-camera* inv-camera-rot) (-> *camera-combiner* inv-camera-rot))
+     (matrix-copy! *save-camera-inv-rot* (-> *camera-combiner* inv-camera-rot)))
     (else (move-camera-from-pad *math-camera*)))
   (matrix-transpose! (-> *math-camera* camera-rot) (-> *math-camera* inv-camera-rot))
   ;; 11650.845 GOAL angle units is 64 degrees.  Narrower fields of view
@@ -369,31 +315,13 @@
                           (-> *math-camera* smooth-t))
        (quaternion->matrix (-> *math-camera* inv-camera-rot-smooth) smooth-rotation)))
     (else
-     (let* ((destination-matrix (-> *math-camera* inv-camera-rot-smooth))
-            (source-matrix (-> *math-camera* inv-camera-rot))
-            (row-0 (-> source-matrix vector 0 quad))
-            (row-1 (-> source-matrix vector 1 quad))
-            (row-2 (-> source-matrix vector 2 quad))
-            (row-3 (-> source-matrix vector 3 quad)))
-       (set! (-> destination-matrix vector 0 quad) row-0)
-       (set! (-> destination-matrix vector 1 quad) row-1)
-       (set! (-> destination-matrix vector 2 quad) row-2)
-       (set! (-> destination-matrix vector 3 quad) row-3))))
+     (matrix-copy! (-> *math-camera* inv-camera-rot-smooth) (-> *math-camera* inv-camera-rot))))
   (if (and (!= *master-mode* 'menu) *display-camera-info*)
     (format *stdcon* "cam pos ~M ~M ~M~%" (-> *math-camera* trans x) (-> *math-camera* trans y) (-> *math-camera* trans z)))
   ;; Preserve the old view-projection before rebuilding it.  A reset instead
   ;; copies the new matrix afterward, suppressing one frame of camera motion.
   (when (zero? (-> *math-camera* reset))
-    (let* ((previous-view-projection (-> *math-camera* prev-camera-temp))
-           (view-projection (-> *math-camera* camera-temp))
-           (row-0 (-> view-projection vector 0 quad))
-           (row-1 (-> view-projection vector 1 quad))
-           (row-2 (-> view-projection vector 2 quad))
-           (row-3 (-> view-projection vector 3 quad)))
-      (set! (-> previous-view-projection vector 0 quad) row-0)
-      (set! (-> previous-view-projection vector 1 quad) row-1)
-      (set! (-> previous-view-projection vector 2 quad) row-2)
-      (set! (-> previous-view-projection vector 3 quad) row-3)))
+    (matrix-copy! (-> *math-camera* prev-camera-temp) (-> *math-camera* camera-temp)))
   (let ((view-projection (-> *math-camera* camera-temp))
         (view-matrix (-> *math-camera* camera-rot))
         (inverse-view-matrix (-> *math-camera* inv-camera-rot))
@@ -410,16 +338,7 @@
     (matrix*! view-projection view-matrix (-> *math-camera* perspective))
     (set! (-> inverse-view-matrix vector 3 quad) (-> camera-position quad)))
   (when (nonzero? (-> *math-camera* reset))
-    (let* ((previous-view-projection (-> *math-camera* prev-camera-temp))
-           (view-projection (-> *math-camera* camera-temp))
-           (row-0 (-> view-projection vector 0 quad))
-           (row-1 (-> view-projection vector 1 quad))
-           (row-2 (-> view-projection vector 2 quad))
-           (row-3 (-> view-projection vector 3 quad)))
-      (set! (-> previous-view-projection vector 0 quad) row-0)
-      (set! (-> previous-view-projection vector 1 quad) row-1)
-      (set! (-> previous-view-projection vector 2 quad) row-2)
-      (set! (-> previous-view-projection vector 3 quad) row-3))
+    (matrix-copy! (-> *math-camera* prev-camera-temp) (-> *math-camera* camera-temp))
     (set! (-> *math-camera* reset) 0)
     0)
   ;; Publish the per-frame fog, homogeneous clipping, screen-offset, and
@@ -448,14 +367,14 @@
   ;; guard planes give TIE and shrub generation room around the visible area.
   (update-view-planes *math-camera* (-> *math-camera* plane) 1.0)
   (update-view-planes *math-camera* (-> *math-camera* guard-plane) 4.0)
-  (set! (-> *instance-shrub-work* guard-plane 0 quad) (-> *math-camera* guard-plane 0 quad))
-  (set! (-> *instance-shrub-work* guard-plane 1 quad) (-> *math-camera* guard-plane 1 quad))
-  (set! (-> *instance-shrub-work* guard-plane 2 quad) (-> *math-camera* guard-plane 2 quad))
-  (set! (-> *instance-shrub-work* guard-plane 3 quad) (-> *math-camera* guard-plane 3 quad))
-  (set! (-> *instance-tie-work* guard-plane 0 quad) (-> *math-camera* guard-plane 0 quad))
-  (set! (-> *instance-tie-work* guard-plane 1 quad) (-> *math-camera* guard-plane 1 quad))
-  (set! (-> *instance-tie-work* guard-plane 2 quad) (-> *math-camera* guard-plane 2 quad))
-  (set! (-> *instance-tie-work* guard-plane 3 quad) (-> *math-camera* guard-plane 3 quad))
+  (vector-copy! (-> *instance-shrub-work* guard-plane 0) (-> *math-camera* guard-plane 0))
+  (vector-copy! (-> *instance-shrub-work* guard-plane 1) (-> *math-camera* guard-plane 1))
+  (vector-copy! (-> *instance-shrub-work* guard-plane 2) (-> *math-camera* guard-plane 2))
+  (vector-copy! (-> *instance-shrub-work* guard-plane 3) (-> *math-camera* guard-plane 3))
+  (vector-copy! (-> *instance-tie-work* guard-plane 0) (-> *math-camera* guard-plane 0))
+  (vector-copy! (-> *instance-tie-work* guard-plane 1) (-> *math-camera* guard-plane 1))
+  (vector-copy! (-> *instance-tie-work* guard-plane 2) (-> *math-camera* guard-plane 2))
+  (vector-copy! (-> *instance-tie-work* guard-plane 3) (-> *math-camera* guard-plane 3))
   (update-visible *math-camera*)
   (if (not (paused?)) (update-wind *wind-work* *wind-scales*))
   #f)

goal_src/jak1/engine/camera/camera-h.gc

@@ -234,7 +234,7 @@
   "Initialize target and value from initial-value, or zero when it is false;
    clear velocity and set the acceleration and speed limits."
   (cond
-    (initial-value (set! (-> this target quad) (-> initial-value quad)) (set! (-> this value quad) (-> initial-value quad)))
+    (initial-value (vector-copy! (-> this target) initial-value) (vector-copy! (-> this value) initial-value))
     (else (vector-reset! (-> this target)) (vector-reset! (-> this value))))
   (vector-reset! (-> this vel))
   (set! (-> this accel) accel)

goal_src/jak1/engine/camera/camera.gc

@@ -36,7 +36,7 @@
                                        *res-static-buf*)))
       (cond
         ((and base-value offset-value) (vector+! out (the-as vector base-value) (the-as vector offset-value)) #t)
-        ((the-as vector base-value) (set! (-> out quad) (-> (the-as vector base-value) quad)) #t)
+        ((the-as vector base-value) (vector-copy! out (the-as vector base-value)) #t)
         (else #f)))))
 
 (defun cam-slave-get-flags ((source-entity entity) (prop-name symbol))
@@ -244,8 +244,8 @@
             (set! (-> this vec 0 quad) (-> (the-as (pointer uint128) (&+ points-data 0))))
             (set! (-> this vec 1 quad) (-> (the-as (pointer uint128) (&+ points-data 16)))))))
         (fallback-curve
-         (set! (-> this vec 0 quad) (-> fallback-curve cverts 0 quad))
-         (set! (-> this vec 1 quad) (-> fallback-curve cverts (+ (-> fallback-curve num-cverts) -1) quad)))
+         (vector-copy! (-> this vec 0) (-> fallback-curve cverts 0))
+         (vector-copy! (-> this vec 1) (-> fallback-curve cverts (+ (-> fallback-curve num-cverts) -1))))
         (else (return #f)))))
   (let ((tmp-vec (new-stack-vector0)))
     0.0
@@ -256,14 +256,14 @@
        (vector-! tmp-vec (-> this vec 0) cam-pos)
        (set! (-> this vec 1 x) (vector-length tmp-vec))
        (set! (-> this vec 1 w) (- (-> this vec 1 w) (-> this vec 1 x)))
-       (set! (-> this vec 0 quad) (-> cam-pos quad)))
+       (vector-copy! (-> this vec 0) cam-pos))
       ((logtest? (-> this flags) (cam-index-options RADIAL))
        (vector-! tmp-vec (-> this vec 1) cam-pos)
        (set! (-> this vec 1 w) (vector-length tmp-vec))
        (vector-! tmp-vec (-> this vec 0) cam-pos)
        (set! (-> this vec 1 x) (vector-length tmp-vec))
        (set! (-> this vec 1 w) (- (-> this vec 1 w) (-> this vec 1 x)))
-       (set! (-> this vec 0 quad) (-> cam-pos quad)))
+       (vector-copy! (-> this vec 0) cam-pos))
       (else
        (vector-! (-> this vec 1) (-> this vec 1) (-> this vec 0))
        (set! (-> this vec 1 w) (vector-normalize-ret-len! (-> this vec 1) 1.0)))))
@@ -302,7 +302,7 @@
 (defmethod reset! ((this tracking-spline) (start-pos vector))
   "Reset the trail to start-pos and rebuild the free chain over the
    remaining slots."
-  (set! (-> this point 0 position quad) (-> start-pos quad))
+  (vector-copy! (-> this point 0 position) start-pos)
   (set! (-> this point 0 next) -134250495)
   (set! (-> this summed-len) 0.0)
   (set! (-> this free-point) 1)
@@ -313,7 +313,7 @@
   (set! (-> this max-move) 0.0)
   (set! (-> this sample-len) 0.0)
   (set! (-> this used-count) 1)
-  (set! (-> this old-position quad) (-> start-pos quad))
+  (vector-copy! (-> this old-position) start-pos)
   (let ((i 1)) (while (!= i 31) (set! (-> this point i next) (+ i 1)) (+! i 1)) (set! (-> this point i next) -134250495))
   0
   (none))
@@ -452,7 +452,7 @@
        (set! (-> this end-point) free-pt)
        (set! (-> this next-to-last-point) tail-pt)
        (set! (-> this point free-pt next) -134250495)
-       (set! (-> this point free-pt position quad) (-> new-pos quad))
+       (vector-copy! (-> this point free-pt position) new-pos)
        (+! (-> this used-count) 1)
        (if (< 0.0 prune-budget) (prune-shallow-points! this prune-budget)))))
   0)
@@ -579,12 +579,12 @@
       (let ((cursor-pt (-> sampler cur-pt)))
         (set! (-> this debug-last-point) cursor-pt)
         (let ((delta (new 'stack-no-clear 'vector)))
-          (set! (-> this debug-old-position quad) (-> this old-position quad))
-          (set! (-> this debug-out-position quad) (-> pos quad))
+          (vector-copy! (-> this debug-old-position) (-> this old-position))
+          (vector-copy! (-> this debug-out-position) pos)
           (vector-! delta pos (-> this old-position))
           (apply-trail-correction! this delta cursor-pt)
           (vector+! pos (-> this old-position) delta)))))
-  (set! (-> this old-position quad) (-> pos quad))
+  (vector-copy! (-> this old-position) pos)
   pos)
 
 (defmethod trim-to-length! ((this tracking-spline) (max-len float))
@@ -643,30 +643,12 @@
      (set! (-> self change-event-from) (the-as (pointer process-drawable) #f))))
   (cond
     (*camera-combiner*
-     (set! (-> self trans quad) (-> *camera-combiner* trans quad))
-     (let* ((tracker (-> self tracking))
-            (combiner-matrix (-> *camera-combiner* inv-camera-rot))
-            (matrix-row-0 (-> combiner-matrix vector 0 quad))
-            (matrix-row-1 (-> combiner-matrix vector 1 quad))
-            (matrix-row-2 (-> combiner-matrix vector 2 quad))
-            (matrix-row-3 (-> combiner-matrix vector 3 quad)))
-       (set! (-> tracker inv-mat vector 0 quad) matrix-row-0)
-       (set! (-> tracker inv-mat vector 1 quad) matrix-row-1)
-       (set! (-> tracker inv-mat vector 2 quad) matrix-row-2)
-       (set! (-> tracker inv-mat vector 3 quad) matrix-row-3))
+     (vector-copy! (-> self trans) (-> *camera-combiner* trans))
+     (matrix-copy! (-> self tracking inv-mat) (-> *camera-combiner* inv-camera-rot))
      (when *camera-init-mat*
-       (let* ((init-tracker (-> self tracking))
-              (init-matrix *camera-init-mat*)
-              (init-row-0 (-> init-matrix vector 0 quad))
-              (init-row-1 (-> init-matrix vector 1 quad))
-              (init-row-2 (-> init-matrix vector 2 quad))
-              (init-row-3 (-> init-matrix vector 3 quad)))
-         (set! (-> init-tracker inv-mat vector 0 quad) init-row-0)
-         (set! (-> init-tracker inv-mat vector 1 quad) init-row-1)
-         (set! (-> init-tracker inv-mat vector 2 quad) init-row-2)
-         (set! (-> init-tracker inv-mat vector 3 quad) init-row-3)))
+       (matrix-copy! (-> self tracking inv-mat) *camera-init-mat*))
      (set! (-> self fov) (-> *camera-combiner* fov))
-     (set! (-> self velocity quad) (-> *camera-combiner* velocity quad)))
+     (vector-copy! (-> self velocity) (-> *camera-combiner* velocity)))
     (else
      (vector-reset! (-> self trans))
      (matrix-identity! (-> self tracking inv-mat))
@@ -754,7 +736,7 @@
      (cond
        ((-> message param 0)
         (set! (-> self tracking use-point-of-interest) #t)
-        (set! (-> self tracking point-of-interest quad) (-> (the-as vector (-> message param 0)) quad))
+        (vector-copy! (-> self tracking point-of-interest) (the-as vector (-> message param 0)))
         (set! (-> self tracking point-of-interest-blend target) 1.0))
        (else (set! (-> self tracking use-point-of-interest) #f) (set! (-> self tracking point-of-interest-blend target) 0.0))))
     (('teleport)
@@ -800,8 +782,8 @@
        (let ((reference-pos (new 'stack-no-clear 'vector)))
          (curve-length (-> self spline-curve))
          (if use-follow-point?
-           (set! (-> reference-pos quad) (-> self tracking follow-pt quad))
-           (set! (-> reference-pos quad) (-> *camera* tpos-curr-adj quad)))
+           (vector-copy! reference-pos (-> self tracking follow-pt))
+           (vector-copy! reference-pos (-> *camera* tpos-curr-adj)))
          (set! (-> self spline-tt)
                (curve-closest-point (-> self spline-curve) reference-pos (-> self spline-tt) 1024.0 10 (-> self spline-follow-dist))))
        (curve-get-pos! curve-offset (-> self spline-tt) (-> self spline-curve))
@@ -881,7 +863,7 @@
             (vector-float*! desired-offset desired-offset blend-factor))
           (+! (-> tracker follow-blend) (/ (-> *display* time-adjust-ratio) 60))
           (vector+! (-> tracker follow-off) (-> tracker follow-off) desired-offset))
-         (else (set! (-> tracker follow-off quad) (-> desired-offset quad)))))
+         (else (vector-copy! (-> tracker follow-off) desired-offset))))
      (vector+! (-> tracker follow-pt) (-> *camera* tpos-curr-adj) (-> tracker follow-off))
      (vector--float*! (-> tracker follow-pt)
                       (-> tracker follow-pt)
@@ -1123,16 +1105,7 @@
       (cond
         (smooth? (slave-matrix-blend-2 (-> tracker inv-mat) options-bits aim-vector target-matrix))
         (else
-         (let* ((output-matrix (-> tracker inv-mat))
-                (source-matrix target-matrix)
-                (row-0 (-> source-matrix vector 0 quad))
-                (row-1 (-> source-matrix vector 1 quad))
-                (row-2 (-> source-matrix vector 2 quad))
-                (row-3 (-> source-matrix vector 3 quad)))
-           (set! (-> output-matrix vector 0 quad) row-0)
-           (set! (-> output-matrix vector 1 quad) row-1)
-           (set! (-> output-matrix vector 2 quad) row-2)
-           (set! (-> output-matrix vector 3 quad) row-3)))))
+         (matrix-copy! (-> tracker inv-mat) target-matrix))))
     (mat-remove-z-rot (-> tracker inv-mat) (-> *camera* local-down))
     0
     (none)))
@@ -1182,7 +1155,7 @@
            (if (< axis-side 0.0) (vector-negate! rotation-axis rotation-axis))))
         (else
          (set! (-> from-direction quad) (-> from-vector quad))
-         (set! (-> to-direction quad) (-> to-vector quad))
+         (vector-copy! to-direction to-vector)
          (set! from-length (vector-normalize-ret-len! from-direction 1.0))
          (set! to-length (vector-normalize-ret-len! to-direction 1.0))
          (vector-normalize! (vector-cross! rotation-axis to-vector from-vector) 1.0)))
@@ -1232,7 +1205,7 @@
              (if (< axis-side 0.0) (vector-negate! rotation-axis rotation-axis))))
           (else
            (set! (-> from-direction quad) (-> from-vector quad))
-           (set! (-> to-direction quad) (-> to-vector quad))
+           (vector-copy! to-direction to-vector)
            (set! from-length (vector-normalize-ret-len! from-direction 1.0))
            (set! to-length (vector-normalize-ret-len! to-direction 1.0))
            (vector-normalize! (vector-cross! rotation-axis to-vector from-vector) 1.0)))

goal_src/jak1/engine/camera/pov-camera.gc

@@ -147,7 +147,7 @@
   (set-time! (-> self debounce-start-time))
   (logclear! (-> self mask) (process-mask actor-pause movie enemy platform projectile))
   (set! (-> self root) (new 'process 'trsqv))
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (when (logtest? (-> self flags) (pov-camera-flag inherit-orientation))
     (let ((orientation-source (if (and (nonzero? owner) (type-type? (-> owner type) process-drawable)) owner)))
       (quaternion-copy! (-> self root quat) (-> orientation-source root quat))))

goal_src/jak1/engine/collide/collide-cache.gc

@@ -3554,156 +3554,132 @@ integer bounds overlap collide-work.collide-box4w."
           (s3-0 (-> obj collide-box4w max quad)))
       (let ((v1-1 (the-as uint128 (make-u128 0 16)))) (.pand v1-2 v1-1 s5-0))
       (when (nonzero? (the-as int v1-2))
-        (let ((v1-5 (-> *collide-player-list* alive-list next0)))
-          *collide-player-list*
-          (let ((s2-0 (-> v1-5 next0)))
-            (while (!= v1-5 (-> *collide-player-list* alive-list-end))
-              (let* ((v1-6 (the-as collide-shape (-> (the-as connection v1-5) param1)))
-                     (a0-3 (-> v1-6 root-prim)))
-                (let ((a1-0 (the-as uint128 (-> a0-3 prim-core collide-as)))) (.pand a1-1 s5-0 a1-0))
-                (b! (zero? (the-as int a1-1)) cfg-7)
-                (nop!)
-                (.lvf vf1 (&-> a0-3 prim-core world-sphere quad))
-                (.sub.w.vf vf2 vf1 vf1)
-                (nop!)
-                (.add.w.vf vf3 vf1 vf1)
-                (nop!)
-                (.ftoi.vf vf4 vf2)
-                (nop!)
-                (.ftoi.vf vf5 vf3)
-                (nop!)
-                (.mov a2-0 vf4)
-                (let ((v1-7 (-> v1-6 process)))
-                  (.mov a3-0 vf5)
-                  (let ((a1-3 (-> obj proc)))
-                    (.pcgtw a2-1 a2-0 s3-0)
-                    (.pcgtw a3-1 s4-0 a3-0)
-                    (.por a2-2 a2-1 a3-1)
-                    (.ppach a2-3 zero a2-2)
-                    (let ((a2-4 (shl (the-as int a2-3) 16))) (nop!) (b! (nonzero? a2-4) cfg-6 :delay (nop!)))
-                    (b! (= a1-3 v1-7) cfg-6 :delay (nop!))))
-                (add-fg-prim-using-box a0-3 obj))
-              (label cfg-6)
-              0
-              (label cfg-7)
-              (set! v1-5 s2-0)
-              *collide-player-list*
-              (set! s2-0 (-> s2-0 next0))))))
+        (iterate-engine-connections (v1-5 *collide-player-list*)
+                                    (let* ((v1-6 (the-as collide-shape (-> (the-as connection v1-5) param1)))
+                                           (a0-3 (-> v1-6 root-prim)))
+                                      (let ((a1-0 (the-as uint128 (-> a0-3 prim-core collide-as)))) (.pand a1-1 s5-0 a1-0))
+                                      (b! (zero? (the-as int a1-1)) cfg-7)
+                                      (nop!)
+                                      (.lvf vf1 (&-> a0-3 prim-core world-sphere quad))
+                                      (.sub.w.vf vf2 vf1 vf1)
+                                      (nop!)
+                                      (.add.w.vf vf3 vf1 vf1)
+                                      (nop!)
+                                      (.ftoi.vf vf4 vf2)
+                                      (nop!)
+                                      (.ftoi.vf vf5 vf3)
+                                      (nop!)
+                                      (.mov a2-0 vf4)
+                                      (let ((v1-7 (-> v1-6 process)))
+                                        (.mov a3-0 vf5)
+                                        (let ((a1-3 (-> obj proc)))
+                                          (.pcgtw a2-1 a2-0 s3-0)
+                                          (.pcgtw a3-1 s4-0 a3-0)
+                                          (.por a2-2 a2-1 a3-1)
+                                          (.ppach a2-3 zero a2-2)
+                                          (let ((a2-4 (shl (the-as int a2-3) 16))) (nop!) (b! (nonzero? a2-4) cfg-6 :delay (nop!)))
+                                          (b! (= a1-3 v1-7) cfg-6 :delay (nop!))))
+                                      (add-fg-prim-using-box a0-3 obj))
+                                    (label cfg-6)
+                                    0
+                                    (label cfg-7)))
       (let ((v1-14 (the-as uint128 (make-u128 0 14)))) (.pand v1-15 v1-14 s5-0))
       (when (nonzero? (the-as int v1-15))
         (let ((v1-17 (the-as uint128 (make-u128 0 2)))) (.pand v1-18 v1-17 s5-0))
         (when (nonzero? (the-as int v1-18))
-          (let ((v1-21 (-> *collide-hit-by-player-list* alive-list next0)))
-            *collide-hit-by-player-list*
-            (let ((s2-1 (-> v1-21 next0)))
-              (while (!= v1-21 (-> *collide-hit-by-player-list* alive-list-end))
-                (let* ((v1-22 (the-as collide-shape (-> (the-as connection v1-21) param1)))
-                       (a0-10 (-> v1-22 root-prim)))
-                  (let ((a1-5 (the-as uint128 (-> a0-10 prim-core collide-as)))) (.pand a1-6 s5-0 a1-5))
-                  (b! (zero? (the-as int a1-6)) cfg-18)
-                  (nop!)
-                  (.lvf vf1 (&-> a0-10 prim-core world-sphere quad))
-                  (.sub.w.vf vf2 vf1 vf1)
-                  (nop!)
-                  (.add.w.vf vf3 vf1 vf1)
-                  (nop!)
-                  (.ftoi.vf vf4 vf2)
-                  (nop!)
-                  (.ftoi.vf vf5 vf3)
-                  (nop!)
-                  (.mov a2-5 vf4)
-                  (let ((v1-23 (-> v1-22 process)))
-                    (.mov a3-2 vf5)
-                    (let ((a1-8 (-> obj proc)))
-                      (.pcgtw a2-6 a2-5 s3-0)
-                      (.pcgtw a3-3 s4-0 a3-2)
-                      (.por a2-7 a2-6 a3-3)
-                      (.ppach a2-8 zero a2-7)
-                      (let ((a2-9 (shl (the-as int a2-8) 16))) (nop!) (b! (nonzero? a2-9) cfg-17 :delay (nop!)))
-                      (b! (= a1-8 v1-23) cfg-17 :delay (nop!))))
-                  (add-fg-prim-using-box a0-10 obj))
-                (label cfg-17)
-                0
-                (label cfg-18)
-                (set! v1-21 s2-1)
-                *collide-hit-by-player-list*
-                (set! s2-1 (-> s2-1 next0))))))
+          (iterate-engine-connections (v1-21 *collide-hit-by-player-list*)
+                                      (let* ((v1-22 (the-as collide-shape (-> (the-as connection v1-21) param1)))
+                                             (a0-10 (-> v1-22 root-prim)))
+                                        (let ((a1-5 (the-as uint128 (-> a0-10 prim-core collide-as)))) (.pand a1-6 s5-0 a1-5))
+                                        (b! (zero? (the-as int a1-6)) cfg-18)
+                                        (nop!)
+                                        (.lvf vf1 (&-> a0-10 prim-core world-sphere quad))
+                                        (.sub.w.vf vf2 vf1 vf1)
+                                        (nop!)
+                                        (.add.w.vf vf3 vf1 vf1)
+                                        (nop!)
+                                        (.ftoi.vf vf4 vf2)
+                                        (nop!)
+                                        (.ftoi.vf vf5 vf3)
+                                        (nop!)
+                                        (.mov a2-5 vf4)
+                                        (let ((v1-23 (-> v1-22 process)))
+                                          (.mov a3-2 vf5)
+                                          (let ((a1-8 (-> obj proc)))
+                                            (.pcgtw a2-6 a2-5 s3-0)
+                                            (.pcgtw a3-3 s4-0 a3-2)
+                                            (.por a2-7 a2-6 a3-3)
+                                            (.ppach a2-8 zero a2-7)
+                                            (let ((a2-9 (shl (the-as int a2-8) 16))) (nop!) (b! (nonzero? a2-9) cfg-17 :delay (nop!)))
+                                            (b! (= a1-8 v1-23) cfg-17 :delay (nop!))))
+                                        (add-fg-prim-using-box a0-10 obj))
+                                      (label cfg-17)
+                                      0
+                                      (label cfg-18)))
         (let ((v1-30 (the-as uint128 (make-u128 0 4)))) (.pand v1-31 v1-30 s5-0))
         (when (nonzero? (the-as int v1-31))
-          (let ((v1-34 (-> *collide-usually-hit-by-player-list* alive-list next0)))
-            *collide-usually-hit-by-player-list*
-            (let ((s2-2 (-> v1-34 next0)))
-              (while (!= v1-34 (-> *collide-usually-hit-by-player-list* alive-list-end))
-                (let* ((v1-35 (the-as collide-shape (-> (the-as connection v1-34) param1)))
-                       (a0-17 (-> v1-35 root-prim)))
-                  (let ((a1-10 (the-as uint128 (-> a0-17 prim-core collide-as)))) (.pand a1-11 s5-0 a1-10))
-                  (b! (zero? (the-as int a1-11)) cfg-28)
-                  (nop!)
-                  (nop!)
-                  (.lvf vf1 (&-> a0-17 prim-core world-sphere quad))
-                  (.sub.w.vf vf2 vf1 vf1)
-                  (nop!)
-                  (.add.w.vf vf3 vf1 vf1)
-                  (nop!)
-                  (.ftoi.vf vf4 vf2)
-                  (nop!)
-                  (.ftoi.vf vf5 vf3)
-                  (nop!)
-                  (.mov a2-10 vf4)
-                  (let ((v1-36 (-> v1-35 process)))
-                    (.mov a3-4 vf5)
-                    (let ((a1-13 (-> obj proc)))
-                      (.pcgtw a2-11 a2-10 s3-0)
-                      (.pcgtw a3-5 s4-0 a3-4)
-                      (.por a2-12 a2-11 a3-5)
-                      (.ppach a2-13 zero a2-12)
-                      (let ((a2-14 (shl (the-as int a2-13) 16))) (nop!) (b! (nonzero? a2-14) cfg-27 :delay (nop!)))
-                      (b! (= a1-13 v1-36) cfg-27 :delay (nop!))))
-                  (add-fg-prim-using-box a0-17 obj))
-                (label cfg-27)
-                0
-                (label cfg-28)
-                (set! v1-34 s2-2)
-                *collide-usually-hit-by-player-list*
-                (set! s2-2 (-> s2-2 next0))))))
+          (iterate-engine-connections (v1-34 *collide-usually-hit-by-player-list*)
+                                      (let* ((v1-35 (the-as collide-shape (-> (the-as connection v1-34) param1)))
+                                             (a0-17 (-> v1-35 root-prim)))
+                                        (let ((a1-10 (the-as uint128 (-> a0-17 prim-core collide-as)))) (.pand a1-11 s5-0 a1-10))
+                                        (b! (zero? (the-as int a1-11)) cfg-28)
+                                        (nop!)
+                                        (nop!)
+                                        (.lvf vf1 (&-> a0-17 prim-core world-sphere quad))
+                                        (.sub.w.vf vf2 vf1 vf1)
+                                        (nop!)
+                                        (.add.w.vf vf3 vf1 vf1)
+                                        (nop!)
+                                        (.ftoi.vf vf4 vf2)
+                                        (nop!)
+                                        (.ftoi.vf vf5 vf3)
+                                        (nop!)
+                                        (.mov a2-10 vf4)
+                                        (let ((v1-36 (-> v1-35 process)))
+                                          (.mov a3-4 vf5)
+                                          (let ((a1-13 (-> obj proc)))
+                                            (.pcgtw a2-11 a2-10 s3-0)
+                                            (.pcgtw a3-5 s4-0 a3-4)
+                                            (.por a2-12 a2-11 a3-5)
+                                            (.ppach a2-13 zero a2-12)
+                                            (let ((a2-14 (shl (the-as int a2-13) 16))) (nop!) (b! (nonzero? a2-14) cfg-27 :delay (nop!)))
+                                            (b! (= a1-13 v1-36) cfg-27 :delay (nop!))))
+                                        (add-fg-prim-using-box a0-17 obj))
+                                      (label cfg-27)
+                                      0
+                                      (label cfg-28)))
         (let ((v1-43 (the-as uint128 (make-u128 0 8)))) (.pand v1-44 v1-43 s5-0))
         (when (nonzero? (the-as int v1-44))
-          (let ((v1-46 (-> *collide-hit-by-others-list* alive-list next0)))
-            *collide-hit-by-others-list*
-            (let ((s2-3 (-> v1-46 next0)))
-              (while (!= v1-46 (-> *collide-hit-by-others-list* alive-list-end))
-                (let* ((v1-47 (the-as collide-shape (-> (the-as connection v1-46) param1)))
-                       (a0-24 (-> v1-47 root-prim)))
-                  (let ((a1-15 (the-as uint128 (-> a0-24 prim-core collide-as)))) (.pand a1-16 s5-0 a1-15))
-                  (b! (zero? (the-as int a1-16)) cfg-38)
-                  (nop!)
-                  (nop!)
-                  (.lvf vf1 (&-> a0-24 prim-core world-sphere quad))
-                  (.sub.w.vf vf2 vf1 vf1)
-                  (nop!)
-                  (.add.w.vf vf3 vf1 vf1)
-                  (nop!)
-                  (.ftoi.vf vf4 vf2)
-                  (nop!)
-                  (.ftoi.vf vf5 vf3)
-                  (nop!)
-                  (.mov a2-15 vf4)
-                  (let ((v1-48 (-> v1-47 process)))
-                    (.mov a3-6 vf5)
-                    (let ((a1-18 (-> obj proc)))
-                      (.pcgtw a2-16 a2-15 s3-0)
-                      (.pcgtw a3-7 s4-0 a3-6)
-                      (.por a2-17 a2-16 a3-7)
-                      (.ppach a2-18 zero a2-17)
-                      (let ((a2-19 (shl (the-as int a2-18) 16))) (nop!) (b! (nonzero? a2-19) cfg-37 :delay (nop!)))
-                      (b! (= a1-18 v1-48) cfg-37 :delay (nop!))))
-                  (add-fg-prim-using-box a0-24 obj))
-                (label cfg-37)
-                0
-                (label cfg-38)
-                (set! v1-46 s2-3)
-                *collide-hit-by-others-list*
-                (set! s2-3 (-> s2-3 next0))))))))
+          (iterate-engine-connections (v1-46 *collide-hit-by-others-list*)
+                                      (let* ((v1-47 (the-as collide-shape (-> (the-as connection v1-46) param1)))
+                                             (a0-24 (-> v1-47 root-prim)))
+                                        (let ((a1-15 (the-as uint128 (-> a0-24 prim-core collide-as)))) (.pand a1-16 s5-0 a1-15))
+                                        (b! (zero? (the-as int a1-16)) cfg-38)
+                                        (nop!)
+                                        (nop!)
+                                        (.lvf vf1 (&-> a0-24 prim-core world-sphere quad))
+                                        (.sub.w.vf vf2 vf1 vf1)
+                                        (nop!)
+                                        (.add.w.vf vf3 vf1 vf1)
+                                        (nop!)
+                                        (.ftoi.vf vf4 vf2)
+                                        (nop!)
+                                        (.ftoi.vf vf5 vf3)
+                                        (nop!)
+                                        (.mov a2-15 vf4)
+                                        (let ((v1-48 (-> v1-47 process)))
+                                          (.mov a3-6 vf5)
+                                          (let ((a1-18 (-> obj proc)))
+                                            (.pcgtw a2-16 a2-15 s3-0)
+                                            (.pcgtw a3-7 s4-0 a3-6)
+                                            (.por a2-17 a2-16 a3-7)
+                                            (.ppach a2-18 zero a2-17)
+                                            (let ((a2-19 (shl (the-as int a2-18) 16))) (nop!) (b! (nonzero? a2-19) cfg-37 :delay (nop!)))
+                                            (b! (= a1-18 v1-48) cfg-37 :delay (nop!))))
+                                        (add-fg-prim-using-box a0-24 obj))
+                                      (label cfg-37)
+                                      0
+                                      (label cfg-38)))))
     (none)))
 
 (defmethod add-fg-prim-using-box ((obj collide-shape-prim) (cache collide-cache))
@@ -3859,151 +3835,127 @@ integer bounds overlap collide-work.collide-box4w."
           (s3-0 (-> obj collide-box4w max quad)))
       (let ((v1-1 (the-as uint128 (make-u128 0 16)))) (.pand v1-2 v1-1 s5-0))
       (when (nonzero? (the-as int v1-2))
-        (let ((v1-5 (-> *collide-player-list* alive-list next0)))
-          *collide-player-list*
-          (let ((s2-0 (-> v1-5 next0)))
-            (while (!= v1-5 (-> *collide-player-list* alive-list-end))
-              (let* ((v1-6 (the-as collide-shape (-> (the-as connection v1-5) param1)))
-                     (a0-3 (-> v1-6 root-prim)))
-                (let ((a1-0 (the-as uint128 (-> a0-3 prim-core collide-as)))) (.pand a1-1 s5-0 a1-0))
-                (b! (zero? (the-as int a1-1)) cfg-7)
-                (.lvf vf1 (&-> a0-3 prim-core world-sphere quad))
-                (.sub.w.vf vf2 vf1 vf1)
-                (.add.w.vf vf3 vf1 vf1)
-                (.ftoi.vf vf4 vf2)
-                (.ftoi.vf vf5 vf3)
-                (.mov a2-0 vf4)
-                (let ((v1-7 (-> v1-6 process)))
-                  (.mov a3-0 vf5)
-                  (let ((a1-3 (-> obj proc)))
-                    (.pcgtw a2-1 a2-0 s3-0)
-                    (.pcgtw a3-1 s4-0 a3-0)
-                    (.por a2-2 a2-1 a3-1)
-                    (.ppach a2-3 zero a2-2)
-                    (let ((a2-4 (shl (the-as int a2-3) 16))) (nop!) (b! (nonzero? a2-4) cfg-6 :delay (nop!)))
-                    (b! (= a1-3 v1-7) cfg-6 :delay (nop!))))
-                (add-fg-prim-using-y-probe a0-3 obj))
-              (label cfg-6)
-              0
-              (label cfg-7)
-              (set! v1-5 s2-0)
-              *collide-player-list*
-              (set! s2-0 (-> s2-0 next0))))))
+        (iterate-engine-connections (v1-5 *collide-player-list*)
+                                    (let* ((v1-6 (the-as collide-shape (-> (the-as connection v1-5) param1)))
+                                           (a0-3 (-> v1-6 root-prim)))
+                                      (let ((a1-0 (the-as uint128 (-> a0-3 prim-core collide-as)))) (.pand a1-1 s5-0 a1-0))
+                                      (b! (zero? (the-as int a1-1)) cfg-7)
+                                      (.lvf vf1 (&-> a0-3 prim-core world-sphere quad))
+                                      (.sub.w.vf vf2 vf1 vf1)
+                                      (.add.w.vf vf3 vf1 vf1)
+                                      (.ftoi.vf vf4 vf2)
+                                      (.ftoi.vf vf5 vf3)
+                                      (.mov a2-0 vf4)
+                                      (let ((v1-7 (-> v1-6 process)))
+                                        (.mov a3-0 vf5)
+                                        (let ((a1-3 (-> obj proc)))
+                                          (.pcgtw a2-1 a2-0 s3-0)
+                                          (.pcgtw a3-1 s4-0 a3-0)
+                                          (.por a2-2 a2-1 a3-1)
+                                          (.ppach a2-3 zero a2-2)
+                                          (let ((a2-4 (shl (the-as int a2-3) 16))) (nop!) (b! (nonzero? a2-4) cfg-6 :delay (nop!)))
+                                          (b! (= a1-3 v1-7) cfg-6 :delay (nop!))))
+                                      (add-fg-prim-using-y-probe a0-3 obj))
+                                    (label cfg-6)
+                                    0
+                                    (label cfg-7)))
       (let ((v1-14 (the-as uint128 (make-u128 0 14)))) (.pand v1-15 v1-14 s5-0))
       (when (nonzero? (the-as int v1-15))
         (let ((v1-17 (the-as uint128 (make-u128 0 2)))) (.pand v1-18 v1-17 s5-0))
         (when (nonzero? (the-as int v1-18))
-          (let ((v1-21 (-> *collide-hit-by-player-list* alive-list next0)))
-            *collide-hit-by-player-list*
-            (let ((s2-1 (-> v1-21 next0)))
-              (while (!= v1-21 (-> *collide-hit-by-player-list* alive-list-end))
-                (let* ((v1-22 (the-as collide-shape (-> (the-as connection v1-21) param1)))
-                       (a0-10 (-> v1-22 root-prim)))
-                  (let ((a1-5 (the-as uint128 (-> a0-10 prim-core collide-as)))) (.pand a1-6 s5-0 a1-5))
-                  (b! (zero? (the-as int a1-6)) cfg-18)
-                  (nop!)
-                  (.lvf vf1 (&-> a0-10 prim-core world-sphere quad))
-                  (.sub.w.vf vf2 vf1 vf1)
-                  (nop!)
-                  (.add.w.vf vf3 vf1 vf1)
-                  (nop!)
-                  (.ftoi.vf vf4 vf2)
-                  (nop!)
-                  (.ftoi.vf vf5 vf3)
-                  (nop!)
-                  (.mov a2-5 vf4)
-                  (let ((v1-23 (-> v1-22 process)))
-                    (.mov a3-2 vf5)
-                    (let ((a1-8 (-> obj proc)))
-                      (.pcgtw a2-6 a2-5 s3-0)
-                      (.pcgtw a3-3 s4-0 a3-2)
-                      (.por a2-7 a2-6 a3-3)
-                      (.ppach a2-8 zero a2-7)
-                      (let ((a2-9 (shl (the-as int a2-8) 16))) (nop!) (b! (nonzero? a2-9) cfg-17 :delay (nop!)))
-                      (b! (= a1-8 v1-23) cfg-17 :delay (nop!))))
-                  (add-fg-prim-using-y-probe a0-10 obj))
-                (label cfg-17)
-                0
-                (label cfg-18)
-                (set! v1-21 s2-1)
-                *collide-hit-by-player-list*
-                (set! s2-1 (-> s2-1 next0))))))
+          (iterate-engine-connections (v1-21 *collide-hit-by-player-list*)
+                                      (let* ((v1-22 (the-as collide-shape (-> (the-as connection v1-21) param1)))
+                                             (a0-10 (-> v1-22 root-prim)))
+                                        (let ((a1-5 (the-as uint128 (-> a0-10 prim-core collide-as)))) (.pand a1-6 s5-0 a1-5))
+                                        (b! (zero? (the-as int a1-6)) cfg-18)
+                                        (nop!)
+                                        (.lvf vf1 (&-> a0-10 prim-core world-sphere quad))
+                                        (.sub.w.vf vf2 vf1 vf1)
+                                        (nop!)
+                                        (.add.w.vf vf3 vf1 vf1)
+                                        (nop!)
+                                        (.ftoi.vf vf4 vf2)
+                                        (nop!)
+                                        (.ftoi.vf vf5 vf3)
+                                        (nop!)
+                                        (.mov a2-5 vf4)
+                                        (let ((v1-23 (-> v1-22 process)))
+                                          (.mov a3-2 vf5)
+                                          (let ((a1-8 (-> obj proc)))
+                                            (.pcgtw a2-6 a2-5 s3-0)
+                                            (.pcgtw a3-3 s4-0 a3-2)
+                                            (.por a2-7 a2-6 a3-3)
+                                            (.ppach a2-8 zero a2-7)
+                                            (let ((a2-9 (shl (the-as int a2-8) 16))) (nop!) (b! (nonzero? a2-9) cfg-17 :delay (nop!)))
+                                            (b! (= a1-8 v1-23) cfg-17 :delay (nop!))))
+                                        (add-fg-prim-using-y-probe a0-10 obj))
+                                      (label cfg-17)
+                                      0
+                                      (label cfg-18)))
         (let ((v1-30 (the-as uint128 (make-u128 0 4)))) (.pand v1-31 v1-30 s5-0))
         (when (nonzero? (the-as int v1-31))
-          (let ((v1-34 (-> *collide-usually-hit-by-player-list* alive-list next0)))
-            *collide-usually-hit-by-player-list*
-            (let ((s2-2 (-> v1-34 next0)))
-              (while (!= v1-34 (-> *collide-usually-hit-by-player-list* alive-list-end))
-                (let* ((v1-35 (the-as collide-shape (-> (the-as connection v1-34) param1)))
-                       (a0-17 (-> v1-35 root-prim)))
-                  (let ((a1-10 (the-as uint128 (-> a0-17 prim-core collide-as)))) (.pand a1-11 s5-0 a1-10))
-                  (b! (zero? (the-as int a1-11)) cfg-28)
-                  (nop!)
-                  (nop!)
-                  (.lvf vf1 (&-> a0-17 prim-core world-sphere quad))
-                  (.sub.w.vf vf2 vf1 vf1)
-                  (nop!)
-                  (.add.w.vf vf3 vf1 vf1)
-                  (nop!)
-                  (.ftoi.vf vf4 vf2)
-                  (nop!)
-                  (.ftoi.vf vf5 vf3)
-                  (nop!)
-                  (.mov a2-10 vf4)
-                  (let ((v1-36 (-> v1-35 process)))
-                    (.mov a3-4 vf5)
-                    (let ((a1-13 (-> obj proc)))
-                      (.pcgtw a2-11 a2-10 s3-0)
-                      (.pcgtw a3-5 s4-0 a3-4)
-                      (.por a2-12 a2-11 a3-5)
-                      (.ppach a2-13 zero a2-12)
-                      (let ((a2-14 (shl (the-as int a2-13) 16))) (nop!) (b! (nonzero? a2-14) cfg-27 :delay (nop!)))
-                      (b! (= a1-13 v1-36) cfg-27 :delay (nop!))))
-                  (add-fg-prim-using-y-probe a0-17 obj))
-                (label cfg-27)
-                0
-                (label cfg-28)
-                (set! v1-34 s2-2)
-                *collide-usually-hit-by-player-list*
-                (set! s2-2 (-> s2-2 next0))))))
+          (iterate-engine-connections (v1-34 *collide-usually-hit-by-player-list*)
+                                      (let* ((v1-35 (the-as collide-shape (-> (the-as connection v1-34) param1)))
+                                             (a0-17 (-> v1-35 root-prim)))
+                                        (let ((a1-10 (the-as uint128 (-> a0-17 prim-core collide-as)))) (.pand a1-11 s5-0 a1-10))
+                                        (b! (zero? (the-as int a1-11)) cfg-28)
+                                        (nop!)
+                                        (nop!)
+                                        (.lvf vf1 (&-> a0-17 prim-core world-sphere quad))
+                                        (.sub.w.vf vf2 vf1 vf1)
+                                        (nop!)
+                                        (.add.w.vf vf3 vf1 vf1)
+                                        (nop!)
+                                        (.ftoi.vf vf4 vf2)
+                                        (nop!)
+                                        (.ftoi.vf vf5 vf3)
+                                        (nop!)
+                                        (.mov a2-10 vf4)
+                                        (let ((v1-36 (-> v1-35 process)))
+                                          (.mov a3-4 vf5)
+                                          (let ((a1-13 (-> obj proc)))
+                                            (.pcgtw a2-11 a2-10 s3-0)
+                                            (.pcgtw a3-5 s4-0 a3-4)
+                                            (.por a2-12 a2-11 a3-5)
+                                            (.ppach a2-13 zero a2-12)
+                                            (let ((a2-14 (shl (the-as int a2-13) 16))) (nop!) (b! (nonzero? a2-14) cfg-27 :delay (nop!)))
+                                            (b! (= a1-13 v1-36) cfg-27 :delay (nop!))))
+                                        (add-fg-prim-using-y-probe a0-17 obj))
+                                      (label cfg-27)
+                                      0
+                                      (label cfg-28)))
         (let ((v1-43 (the-as uint128 (make-u128 0 8)))) (.pand v1-44 v1-43 s5-0))
         (when (nonzero? (the-as int v1-44))
-          (let ((v1-46 (-> *collide-hit-by-others-list* alive-list next0)))
-            *collide-hit-by-others-list*
-            (let ((s2-3 (-> v1-46 next0)))
-              (while (!= v1-46 (-> *collide-hit-by-others-list* alive-list-end))
-                (let* ((v1-47 (the-as collide-shape (-> (the-as connection v1-46) param1)))
-                       (a0-24 (-> v1-47 root-prim)))
-                  (let ((a1-15 (the-as uint128 (-> a0-24 prim-core collide-as)))) (.pand a1-16 s5-0 a1-15))
-                  (b! (zero? (the-as int a1-16)) cfg-38)
-                  (nop!)
-                  (nop!)
-                  (.lvf vf1 (&-> a0-24 prim-core world-sphere quad))
-                  (.sub.w.vf vf2 vf1 vf1)
-                  (nop!)
-                  (.add.w.vf vf3 vf1 vf1)
-                  (nop!)
-                  (.ftoi.vf vf4 vf2)
-                  (nop!)
-                  (.ftoi.vf vf5 vf3)
-                  (nop!)
-                  (.mov a2-15 vf4)
-                  (let ((v1-48 (-> v1-47 process)))
-                    (.mov a3-6 vf5)
-                    (let ((a1-18 (-> obj proc)))
-                      (.pcgtw a2-16 a2-15 s3-0)
-                      (.pcgtw a3-7 s4-0 a3-6)
-                      (.por a2-17 a2-16 a3-7)
-                      (.ppach a2-18 zero a2-17)
-                      (let ((a2-19 (shl (the-as int a2-18) 16))) (nop!) (b! (nonzero? a2-19) cfg-37 :delay (nop!)))
-                      (b! (= a1-18 v1-48) cfg-37 :delay (nop!))))
-                  (add-fg-prim-using-y-probe a0-24 obj))
-                (label cfg-37)
-                0
-                (label cfg-38)
-                (set! v1-46 s2-3)
-                *collide-hit-by-others-list*
-                (set! s2-3 (-> s2-3 next0))))))))
+          (iterate-engine-connections (v1-46 *collide-hit-by-others-list*)
+                                      (let* ((v1-47 (the-as collide-shape (-> (the-as connection v1-46) param1)))
+                                             (a0-24 (-> v1-47 root-prim)))
+                                        (let ((a1-15 (the-as uint128 (-> a0-24 prim-core collide-as)))) (.pand a1-16 s5-0 a1-15))
+                                        (b! (zero? (the-as int a1-16)) cfg-38)
+                                        (nop!)
+                                        (nop!)
+                                        (.lvf vf1 (&-> a0-24 prim-core world-sphere quad))
+                                        (.sub.w.vf vf2 vf1 vf1)
+                                        (nop!)
+                                        (.add.w.vf vf3 vf1 vf1)
+                                        (nop!)
+                                        (.ftoi.vf vf4 vf2)
+                                        (nop!)
+                                        (.ftoi.vf vf5 vf3)
+                                        (nop!)
+                                        (.mov a2-15 vf4)
+                                        (let ((v1-48 (-> v1-47 process)))
+                                          (.mov a3-6 vf5)
+                                          (let ((a1-18 (-> obj proc)))
+                                            (.pcgtw a2-16 a2-15 s3-0)
+                                            (.pcgtw a3-7 s4-0 a3-6)
+                                            (.por a2-17 a2-16 a3-7)
+                                            (.ppach a2-18 zero a2-17)
+                                            (let ((a2-19 (shl (the-as int a2-18) 16))) (nop!) (b! (nonzero? a2-19) cfg-37 :delay (nop!)))
+                                            (b! (= a1-18 v1-48) cfg-37 :delay (nop!))))
+                                        (add-fg-prim-using-y-probe a0-24 obj))
+                                      (label cfg-37)
+                                      0
+                                      (label cfg-38)))))
     (none)))
 
 (defmethod add-fg-prim-using-y-probe ((obj collide-shape-prim) (cache collide-cache))
@@ -4205,180 +4157,156 @@ integer bounds overlap collide-work.collide-box4w."
       (.mov v1-1 vf31)
       (let ((v1-3 (the-as uint128 (make-u128 0 16)))) (.pand v1-4 v1-3 s3-0))
       (when (nonzero? (the-as int v1-4))
-        (let ((v1-7 (-> *collide-player-list* alive-list next0)))
-          *collide-player-list*
-          (let ((s2-0 (-> v1-7 next0)))
-            (while (!= v1-7 (-> *collide-player-list* alive-list-end))
-              (let* ((v1-8 (the-as collide-shape (-> (the-as connection v1-7) param1)))
-                     (a0-3 (-> v1-8 root-prim)))
-                (let ((a1-0 (the-as uint128 (-> a0-3 prim-core collide-as)))) (.pand a1-1 s3-0 a1-0))
-                (b! (zero? (the-as int a1-1)) cfg-7)
-                (.mul.w.vf acc vf31 vf0)
-                (.lvf vf1 (&-> a0-3 prim-core world-sphere quad))
-                (.add.mul.x.vf acc vf28 vf1 acc)
-                (nop!)
-                (.add.mul.y.vf acc vf29 vf1 acc)
-                (nop!)
-                (.add.mul.z.vf vf6 vf30 vf1 acc)
-                (nop!)
-                (.sub.w.vf.xyz vf2 vf6 vf1)
-                (nop!)
-                (.add.w.vf.xyz vf3 vf6 vf1)
-                (nop!)
-                (.ftoi.vf vf4 vf2)
-                (nop!)
-                (.ftoi.vf vf5 vf3)
-                (nop!)
-                (.mov a2-0 vf4)
-                (let ((v1-9 (-> v1-8 process)))
-                  (.mov a3-0 vf5)
-                  (let ((a1-3 (-> obj proc)))
-                    (.pcgtw a2-1 a2-0 s4-0)
-                    (.pcgtw a3-1 s5-0 a3-0)
-                    (.por a2-2 a2-1 a3-1)
-                    (.ppach a2-3 zero a2-2)
-                    (let ((a2-4 (shl (the-as int a2-3) 16))) (nop!) (b! (nonzero? a2-4) cfg-6 :delay (nop!)))
-                    (b! (= a1-3 v1-9) cfg-6 :delay (nop!))))
-                (add-fg-prim-using-line-sphere a0-3 obj))
-              (label cfg-6)
-              0
-              (label cfg-7)
-              (set! v1-7 s2-0)
-              *collide-player-list*
-              (set! s2-0 (-> s2-0 next0))))))
+        (iterate-engine-connections (v1-7 *collide-player-list*)
+                                    (let* ((v1-8 (the-as collide-shape (-> (the-as connection v1-7) param1)))
+                                           (a0-3 (-> v1-8 root-prim)))
+                                      (let ((a1-0 (the-as uint128 (-> a0-3 prim-core collide-as)))) (.pand a1-1 s3-0 a1-0))
+                                      (b! (zero? (the-as int a1-1)) cfg-7)
+                                      (.mul.w.vf acc vf31 vf0)
+                                      (.lvf vf1 (&-> a0-3 prim-core world-sphere quad))
+                                      (.add.mul.x.vf acc vf28 vf1 acc)
+                                      (nop!)
+                                      (.add.mul.y.vf acc vf29 vf1 acc)
+                                      (nop!)
+                                      (.add.mul.z.vf vf6 vf30 vf1 acc)
+                                      (nop!)
+                                      (.sub.w.vf.xyz vf2 vf6 vf1)
+                                      (nop!)
+                                      (.add.w.vf.xyz vf3 vf6 vf1)
+                                      (nop!)
+                                      (.ftoi.vf vf4 vf2)
+                                      (nop!)
+                                      (.ftoi.vf vf5 vf3)
+                                      (nop!)
+                                      (.mov a2-0 vf4)
+                                      (let ((v1-9 (-> v1-8 process)))
+                                        (.mov a3-0 vf5)
+                                        (let ((a1-3 (-> obj proc)))
+                                          (.pcgtw a2-1 a2-0 s4-0)
+                                          (.pcgtw a3-1 s5-0 a3-0)
+                                          (.por a2-2 a2-1 a3-1)
+                                          (.ppach a2-3 zero a2-2)
+                                          (let ((a2-4 (shl (the-as int a2-3) 16))) (nop!) (b! (nonzero? a2-4) cfg-6 :delay (nop!)))
+                                          (b! (= a1-3 v1-9) cfg-6 :delay (nop!))))
+                                      (add-fg-prim-using-line-sphere a0-3 obj))
+                                    (label cfg-6)
+                                    0
+                                    (label cfg-7)))
       (let ((v1-16 (the-as uint128 (make-u128 0 14)))) (.pand v1-17 v1-16 s3-0))
       (when (nonzero? (the-as int v1-17))
         (let ((v1-19 (the-as uint128 (make-u128 0 2)))) (.pand v1-20 v1-19 s3-0))
         (when (nonzero? (the-as int v1-20))
-          (let ((v1-23 (-> *collide-hit-by-player-list* alive-list next0)))
-            *collide-hit-by-player-list*
-            (let ((s2-1 (-> v1-23 next0)))
-              (while (!= v1-23 (-> *collide-hit-by-player-list* alive-list-end))
-                (let* ((v1-24 (the-as collide-shape (-> (the-as connection v1-23) param1)))
-                       (a0-10 (-> v1-24 root-prim)))
-                  (let ((a1-5 (the-as uint128 (-> a0-10 prim-core collide-as)))) (.pand a1-6 s3-0 a1-5))
-                  (b! (zero? (the-as int a1-6)) cfg-18)
-                  (.mul.w.vf acc vf31 vf0)
-                  (.lvf vf1 (&-> a0-10 prim-core world-sphere quad))
-                  (.add.mul.x.vf acc vf28 vf1 acc)
-                  (nop!)
-                  (.add.mul.y.vf acc vf29 vf1 acc)
-                  (nop!)
-                  (.add.mul.z.vf vf6 vf30 vf1 acc)
-                  (nop!)
-                  (.sub.w.vf.xyz vf2 vf6 vf1)
-                  (nop!)
-                  (.add.w.vf.xyz vf3 vf6 vf1)
-                  (nop!)
-                  (.ftoi.vf vf4 vf2)
-                  (nop!)
-                  (.ftoi.vf vf5 vf3)
-                  (nop!)
-                  (.mov a2-5 vf4)
-                  (let ((v1-25 (-> v1-24 process)))
-                    (.mov a3-2 vf5)
-                    (let ((a1-8 (-> obj proc)))
-                      (.pcgtw a2-6 a2-5 s4-0)
-                      (.pcgtw a3-3 s5-0 a3-2)
-                      (.por a2-7 a2-6 a3-3)
-                      (.ppach a2-8 zero a2-7)
-                      (let ((a2-9 (shl (the-as int a2-8) 16))) (nop!) (b! (nonzero? a2-9) cfg-17 :delay (nop!)))
-                      (b! (= a1-8 v1-25) cfg-17 :delay (nop!))))
-                  (add-fg-prim-using-line-sphere a0-10 obj))
-                (label cfg-17)
-                0
-                (label cfg-18)
-                (set! v1-23 s2-1)
-                *collide-hit-by-player-list*
-                (set! s2-1 (-> s2-1 next0))))))
+          (iterate-engine-connections (v1-23 *collide-hit-by-player-list*)
+                                      (let* ((v1-24 (the-as collide-shape (-> (the-as connection v1-23) param1)))
+                                             (a0-10 (-> v1-24 root-prim)))
+                                        (let ((a1-5 (the-as uint128 (-> a0-10 prim-core collide-as)))) (.pand a1-6 s3-0 a1-5))
+                                        (b! (zero? (the-as int a1-6)) cfg-18)
+                                        (.mul.w.vf acc vf31 vf0)
+                                        (.lvf vf1 (&-> a0-10 prim-core world-sphere quad))
+                                        (.add.mul.x.vf acc vf28 vf1 acc)
+                                        (nop!)
+                                        (.add.mul.y.vf acc vf29 vf1 acc)
+                                        (nop!)
+                                        (.add.mul.z.vf vf6 vf30 vf1 acc)
+                                        (nop!)
+                                        (.sub.w.vf.xyz vf2 vf6 vf1)
+                                        (nop!)
+                                        (.add.w.vf.xyz vf3 vf6 vf1)
+                                        (nop!)
+                                        (.ftoi.vf vf4 vf2)
+                                        (nop!)
+                                        (.ftoi.vf vf5 vf3)
+                                        (nop!)
+                                        (.mov a2-5 vf4)
+                                        (let ((v1-25 (-> v1-24 process)))
+                                          (.mov a3-2 vf5)
+                                          (let ((a1-8 (-> obj proc)))
+                                            (.pcgtw a2-6 a2-5 s4-0)
+                                            (.pcgtw a3-3 s5-0 a3-2)
+                                            (.por a2-7 a2-6 a3-3)
+                                            (.ppach a2-8 zero a2-7)
+                                            (let ((a2-9 (shl (the-as int a2-8) 16))) (nop!) (b! (nonzero? a2-9) cfg-17 :delay (nop!)))
+                                            (b! (= a1-8 v1-25) cfg-17 :delay (nop!))))
+                                        (add-fg-prim-using-line-sphere a0-10 obj))
+                                      (label cfg-17)
+                                      0
+                                      (label cfg-18)))
         (let ((v1-32 (the-as uint128 (make-u128 0 4)))) (.pand v1-33 v1-32 s3-0))
         (when (nonzero? (the-as int v1-33))
-          (let ((v1-36 (-> *collide-usually-hit-by-player-list* alive-list next0)))
-            *collide-usually-hit-by-player-list*
-            (let ((s2-2 (-> v1-36 next0)))
-              (while (!= v1-36 (-> *collide-usually-hit-by-player-list* alive-list-end))
-                (let* ((v1-37 (the-as collide-shape (-> (the-as connection v1-36) param1)))
-                       (a0-17 (-> v1-37 root-prim)))
-                  (let ((a1-10 (the-as uint128 (-> a0-17 prim-core collide-as)))) (.pand a1-11 s3-0 a1-10))
-                  (b! (zero? (the-as int a1-11)) cfg-28)
-                  (nop!)
-                  (.mul.w.vf acc vf31 vf0)
-                  (.lvf vf1 (&-> a0-17 prim-core world-sphere quad))
-                  (.add.mul.x.vf acc vf28 vf1 acc)
-                  (nop!)
-                  (.add.mul.y.vf acc vf29 vf1 acc)
-                  (nop!)
-                  (.add.mul.z.vf vf6 vf30 vf1 acc)
-                  (nop!)
-                  (.sub.w.vf.xyz vf2 vf6 vf1)
-                  (nop!)
-                  (.add.w.vf.xyz vf3 vf6 vf1)
-                  (nop!)
-                  (.ftoi.vf vf4 vf2)
-                  (nop!)
-                  (.ftoi.vf vf5 vf3)
-                  (nop!)
-                  (.mov a2-10 vf4)
-                  (let ((v1-38 (the-as basic (-> v1-37 process))))
-                    (.mov a3-4 vf5)
-                    (let ((a1-13 (-> obj proc)))
-                      (.pcgtw a2-11 a2-10 s4-0)
-                      (.pcgtw a3-5 s5-0 a3-4)
-                      (.por a2-12 a2-11 a3-5)
-                      (.ppach a2-13 zero a2-12)
-                      (let ((a2-14 (shl (the-as int a2-13) 16))) (nop!) (b! (nonzero? a2-14) cfg-27 :delay (nop!)))
-                      (b! (= a1-13 (the-as process-drawable v1-38)) cfg-27 :delay (nop!))))
-                  (add-fg-prim-using-line-sphere a0-17 obj))
-                (label cfg-27)
-                0
-                (label cfg-28)
-                (set! v1-36 s2-2)
-                *collide-usually-hit-by-player-list*
-                (set! s2-2 (-> s2-2 next0))))))
+          (iterate-engine-connections (v1-36 *collide-usually-hit-by-player-list*)
+                                      (let* ((v1-37 (the-as collide-shape (-> (the-as connection v1-36) param1)))
+                                             (a0-17 (-> v1-37 root-prim)))
+                                        (let ((a1-10 (the-as uint128 (-> a0-17 prim-core collide-as)))) (.pand a1-11 s3-0 a1-10))
+                                        (b! (zero? (the-as int a1-11)) cfg-28)
+                                        (nop!)
+                                        (.mul.w.vf acc vf31 vf0)
+                                        (.lvf vf1 (&-> a0-17 prim-core world-sphere quad))
+                                        (.add.mul.x.vf acc vf28 vf1 acc)
+                                        (nop!)
+                                        (.add.mul.y.vf acc vf29 vf1 acc)
+                                        (nop!)
+                                        (.add.mul.z.vf vf6 vf30 vf1 acc)
+                                        (nop!)
+                                        (.sub.w.vf.xyz vf2 vf6 vf1)
+                                        (nop!)
+                                        (.add.w.vf.xyz vf3 vf6 vf1)
+                                        (nop!)
+                                        (.ftoi.vf vf4 vf2)
+                                        (nop!)
+                                        (.ftoi.vf vf5 vf3)
+                                        (nop!)
+                                        (.mov a2-10 vf4)
+                                        (let ((v1-38 (the-as basic (-> v1-37 process))))
+                                          (.mov a3-4 vf5)
+                                          (let ((a1-13 (-> obj proc)))
+                                            (.pcgtw a2-11 a2-10 s4-0)
+                                            (.pcgtw a3-5 s5-0 a3-4)
+                                            (.por a2-12 a2-11 a3-5)
+                                            (.ppach a2-13 zero a2-12)
+                                            (let ((a2-14 (shl (the-as int a2-13) 16))) (nop!) (b! (nonzero? a2-14) cfg-27 :delay (nop!)))
+                                            (b! (= a1-13 (the-as process-drawable v1-38)) cfg-27 :delay (nop!))))
+                                        (add-fg-prim-using-line-sphere a0-17 obj))
+                                      (label cfg-27)
+                                      0
+                                      (label cfg-28)))
         (let ((v1-45 (the-as uint128 (make-u128 0 8)))) (.pand v1-46 v1-45 s3-0))
         (when (nonzero? (the-as int v1-46))
-          (let ((v1-48 (-> *collide-hit-by-others-list* alive-list next0)))
-            *collide-hit-by-others-list*
-            (let ((s2-3 (-> v1-48 next0)))
-              (while (!= v1-48 (-> *collide-hit-by-others-list* alive-list-end))
-                (let* ((v1-49 (the-as collide-shape (-> (the-as connection v1-48) param1)))
-                       (a0-24 (-> v1-49 root-prim)))
-                  (let ((a1-15 (the-as uint128 (-> a0-24 prim-core collide-as)))) (.pand a1-16 s3-0 a1-15))
-                  (b! (zero? (the-as int a1-16)) cfg-38)
-                  (nop!)
-                  (.mul.w.vf acc vf31 vf0)
-                  (.lvf vf1 (&-> a0-24 prim-core world-sphere quad))
-                  (.add.mul.x.vf acc vf28 vf1 acc)
-                  (nop!)
-                  (.add.mul.y.vf acc vf29 vf1 acc)
-                  (nop!)
-                  (.add.mul.z.vf vf6 vf30 vf1 acc)
-                  (nop!)
-                  (.sub.w.vf.xyz vf2 vf6 vf1)
-                  (nop!)
-                  (.add.w.vf.xyz vf3 vf6 vf1)
-                  (nop!)
-                  (.ftoi.vf vf4 vf2)
-                  (nop!)
-                  (.ftoi.vf vf5 vf3)
-                  (nop!)
-                  (.mov a2-15 vf4)
-                  (let ((v1-50 (-> v1-49 process)))
-                    (.mov a3-6 vf5)
-                    (let ((a1-18 (-> obj proc)))
-                      (.pcgtw a2-16 a2-15 s4-0)
-                      (.pcgtw a3-7 s5-0 a3-6)
-                      (.por a2-17 a2-16 a3-7)
-                      (.ppach a2-18 zero a2-17)
-                      (let ((a2-19 (shl (the-as int a2-18) 16))) (nop!) (b! (nonzero? a2-19) cfg-37 :delay (nop!)))
-                      (b! (= a1-18 v1-50) cfg-37 :delay (nop!))))
-                  (add-fg-prim-using-line-sphere a0-24 obj))
-                (label cfg-37)
-                0
-                (label cfg-38)
-                (set! v1-48 s2-3)
-                *collide-hit-by-others-list*
-                (set! s2-3 (-> s2-3 next0))))))))
+          (iterate-engine-connections (v1-48 *collide-hit-by-others-list*)
+                                      (let* ((v1-49 (the-as collide-shape (-> (the-as connection v1-48) param1)))
+                                             (a0-24 (-> v1-49 root-prim)))
+                                        (let ((a1-15 (the-as uint128 (-> a0-24 prim-core collide-as)))) (.pand a1-16 s3-0 a1-15))
+                                        (b! (zero? (the-as int a1-16)) cfg-38)
+                                        (nop!)
+                                        (.mul.w.vf acc vf31 vf0)
+                                        (.lvf vf1 (&-> a0-24 prim-core world-sphere quad))
+                                        (.add.mul.x.vf acc vf28 vf1 acc)
+                                        (nop!)
+                                        (.add.mul.y.vf acc vf29 vf1 acc)
+                                        (nop!)
+                                        (.add.mul.z.vf vf6 vf30 vf1 acc)
+                                        (nop!)
+                                        (.sub.w.vf.xyz vf2 vf6 vf1)
+                                        (nop!)
+                                        (.add.w.vf.xyz vf3 vf6 vf1)
+                                        (nop!)
+                                        (.ftoi.vf vf4 vf2)
+                                        (nop!)
+                                        (.ftoi.vf vf5 vf3)
+                                        (nop!)
+                                        (.mov a2-15 vf4)
+                                        (let ((v1-50 (-> v1-49 process)))
+                                          (.mov a3-6 vf5)
+                                          (let ((a1-18 (-> obj proc)))
+                                            (.pcgtw a2-16 a2-15 s4-0)
+                                            (.pcgtw a3-7 s5-0 a3-6)
+                                            (.por a2-17 a2-16 a3-7)
+                                            (.ppach a2-18 zero a2-17)
+                                            (let ((a2-19 (shl (the-as int a2-18) 16))) (nop!) (b! (nonzero? a2-19) cfg-37 :delay (nop!)))
+                                            (b! (= a1-18 v1-50) cfg-37 :delay (nop!))))
+                                        (add-fg-prim-using-line-sphere a0-24 obj))
+                                      (label cfg-37)
+                                      0
+                                      (label cfg-38)))))
     (none)))
 
 (defmethod add-fg-prim-using-line-sphere ((obj collide-shape-prim) (cache collide-cache))
@@ -4744,7 +4672,7 @@ integer bounds overlap collide-work.collide-box4w."
           (closest-point (new 'stack-no-clear 'vector))
           (normal (new 'stack-no-clear 'vector))
           (triangles-left (-> cache num-tris)))
-      (set! (-> target-position quad) (-> (target-pos 0) quad))
+      (vector-copy! target-position (target-pos 0))
       (while (nonzero? triangles-left)
         (+! triangles-left -1)
         (normal-of-plane normal
@@ -4755,6 +4683,6 @@ integer bounds overlap collide-work.collide-box4w."
         (let ((distance-squared (vector-vector-distance-squared closest-point target-position)))
           (when (or (< best-distance-squared 0.0) (< distance-squared best-distance-squared))
             (set! best-distance-squared distance-squared)
-            (set! (-> nearest-point quad) (-> closest-point quad))))
+            (vector-copy! nearest-point closest-point)))
         (set! tri (-> (the-as (inline-array collide-cache-tri) tri) 1)))))
   #f)

goal_src/jak1/engine/collide/collide-edge-grab.gc

@@ -1075,7 +1075,7 @@
               (let ((distance (vector-segment-distance-point! test-point (-> edge vertex-ptr 0 0) (-> edge vertex-ptr 1 0) closest-point)))
                 (when (or (< best-distance 0.0) (< distance best-distance))
                   (set! best-distance distance)
-                  (set! (-> output quad) (-> closest-point quad)))))))))
+                  (vector-copy! output closest-point))))))))
     best-distance))
 
 (defmethod should-add-to-list? ((this collide-edge-work) (hold-item collide-edge-hold-item) (edge collide-edge-edge))
@@ -1306,7 +1306,7 @@
         (item-count 0))
     (let ((marker (new 'stack-no-clear 'vector))
           (first-item? #t))
-      (set! (-> marker quad) (-> *target* control midpoint-of-hands quad))
+      (vector-copy! marker (-> *target* control midpoint-of-hands))
       (while item
         (+! item-count 1)
         (set! (-> marker y) (-> item center-pt y))

goal_src/jak1/engine/collide/collide-frag.gc

@@ -46,11 +46,11 @@
   0
   (none))
 
-(defmethod mem-usage ((this collide-fragment) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this collide-fragment) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the fragment and mesh headers, packed polygon stream and PAT indices, and packed
    vertex quadwords. Bit 0 of flags selects the prototype categories instead of the ordinary
    background-collision categories."
-  (let ((category (if (logtest? flags 1) (mem-usage-id collide-fragment-1) (mem-usage-id collide-fragment-0)))
+  (let ((category (if (logtest? flags (mem-usage-flags prototype-data)) (mem-usage-id collide-fragment-1) (mem-usage-id collide-fragment-0)))
         (mesh (-> this mesh)))
     (set! (-> usage data category name) (symbol->string 'collide-fragment))
     (+! (-> usage data category count) 1)
@@ -124,15 +124,10 @@
   0
   (none))
 
-(defmethod mem-usage ((this drawable-inline-array-collide-fragment) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-inline-array-collide-fragment) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the inline-array header and delegate memory accounting to every collision
    fragment."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((header-bytes 32))
-    (+! (-> usage data 0 used) header-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ header-bytes 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 32)
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   this)

goal_src/jak1/engine/collide/collide-mesh.gc

@@ -12,21 +12,11 @@
    array. The separately allocated vertex-data buffer is not part of this size."
   (the-as int (+ (-> collide-mesh size) (* (+ (-> this num-tris) -1) 8))))
 
-(defmethod mem-usage ((this collide-mesh) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this collide-mesh) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the mesh-and-triangle allocation and the separate sixteen-byte-per-vertex
    buffer as two allocations in the collide-mesh category."
-  (set! (-> usage length) (max 79 (-> usage length)))
-  (set! (-> usage data (mem-usage-id collide-mesh) name) "collide-mesh")
-  (+! (-> usage data (mem-usage-id collide-mesh) count) 1)
-  (let ((mesh-allocation-bytes (asize-of this)))
-    (+! (-> usage data (mem-usage-id collide-mesh) used) mesh-allocation-bytes)
-    (+! (-> usage data (mem-usage-id collide-mesh) total) (logand -16 (+ mesh-allocation-bytes 15))))
-  (set! (-> usage length) (max 79 (-> usage length)))
-  (set! (-> usage data (mem-usage-id collide-mesh) name) "collide-mesh")
-  (+! (-> usage data (mem-usage-id collide-mesh) count) 1)
-  (let ((vertex-buffer-bytes (* (-> this num-verts) 16)))
-    (+! (-> usage data (mem-usage-id collide-mesh) used) vertex-buffer-bytes)
-    (+! (-> usage data (mem-usage-id collide-mesh) total) (logand -16 (+ vertex-buffer-bytes 15))))
+  (mem-usage-add! usage collide-mesh 1 (asize-of this))
+  (mem-usage-add! usage collide-mesh 1 (* (-> this num-verts) 16))
   (the-as collide-mesh 0))
 
 (defmethod debug-draw-tris ((this collide-mesh) (draw-owner process-drawable) (joint-index int))

goal_src/jak1/engine/collide/collide-shape-rider.gc

@@ -83,11 +83,11 @@
              (set! (-> overlap-result best-dist) separation)
              (set! (-> overlap-result best-from-prim) this)
              (set! (-> overlap-result best-to-prim) other-prim)
-             (set! (-> overlap-result best-from-tri vertex 0 quad) (-> tri-result vertex 0 quad))
-             (set! (-> overlap-result best-from-tri vertex 1 quad) (-> tri-result vertex 1 quad))
-             (set! (-> overlap-result best-from-tri vertex 2 quad) (-> tri-result vertex 2 quad))
-             (set! (-> overlap-result best-from-tri intersect quad) (-> tri-result intersect quad))
-             (set! (-> overlap-result best-from-tri normal quad) (-> tri-result normal quad))
+             (vector-copy! (-> overlap-result best-from-tri vertex 0) (-> tri-result vertex 0))
+             (vector-copy! (-> overlap-result best-from-tri vertex 1) (-> tri-result vertex 1))
+             (vector-copy! (-> overlap-result best-from-tri vertex 2) (-> tri-result vertex 2))
+             (vector-copy! (-> overlap-result best-from-tri intersect) (-> tri-result intersect))
+             (vector-copy! (-> overlap-result best-from-tri normal) (-> tri-result normal))
              (set! (-> overlap-result best-from-tri pat) (-> tri-result pat))))))))
   (none))
 
@@ -124,110 +124,86 @@
       0
       (let ((with-mask (-> this root-prim collide-with)))
         (when (logtest? with-mask (collide-kind target))
-          (let ((node (-> *collide-player-list* alive-list next0)))
-            *collide-player-list*
-            (let ((next-node (-> node next0)))
-              (while (!= node (-> *collide-player-list* alive-list-end))
-                (let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
-                       (candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
-                  (when (logtest? with-mask (-> candidate-root prim-core collide-as))
-                    (when (and (logtest? (-> candidate-root prim-core action) (collide-action rider-target))
-                               (!= (-> this process) (-> (the-as collide-shape candidate-shape) process)))
-                      (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
-                        (when (on-platform this (the-as collide-shape candidate-shape) overlap-result)
-                          (let ((rider-entry (add-rider! rider-group (the-as process-drawable (process->handle (-> (the-as collide-shape candidate-shape) process))))))
-                            (when rider-entry
-                              (let ((platform-prim (-> overlap-result best-from-prim)))
-                                (set! (-> rider-entry sticky-prim) platform-prim)
-                                (let ((bone-transform (-> (the-as process-drawable (-> this process)) node-list data (-> platform-prim transform-index) bone transform)))
-                                  (set! (-> rider-entry prim-ry) (matrix-y-angle bone-transform))
-                                  (let ((inverse-transform (new 'stack-no-clear 'matrix)))
-                                    (matrix-4x4-inverse! inverse-transform bone-transform)
-                                    (vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
-                              (send-event (-> this process) 'ridden rider-entry)))
-                          (set! with-mask (-> this root-prim collide-with)))))))
-                (set! node next-node)
-                *collide-player-list*
-                (set! next-node (-> next-node next0))))))
+          (iterate-engine-connections (node *collide-player-list*)
+                                      (let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
+                                             (candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
+                                        (when (logtest? with-mask (-> candidate-root prim-core collide-as))
+                                          (when (and (logtest? (-> candidate-root prim-core action) (collide-action rider-target))
+                                                     (!= (-> this process) (-> (the-as collide-shape candidate-shape) process)))
+                                            (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
+                                              (when (on-platform this (the-as collide-shape candidate-shape) overlap-result)
+                                                (let ((rider-entry (add-rider! rider-group (the-as process-drawable (process->handle (-> (the-as collide-shape candidate-shape) process))))))
+                                                  (when rider-entry
+                                                    (let ((platform-prim (-> overlap-result best-from-prim)))
+                                                      (set! (-> rider-entry sticky-prim) platform-prim)
+                                                      (let ((bone-transform (-> (the-as process-drawable (-> this process)) node-list data (-> platform-prim transform-index) bone transform)))
+                                                        (set! (-> rider-entry prim-ry) (matrix-y-angle bone-transform))
+                                                        (let ((inverse-transform (new 'stack-no-clear 'matrix)))
+                                                          (matrix-4x4-inverse! inverse-transform bone-transform)
+                                                          (vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
+                                                    (send-event (-> this process) 'ridden rider-entry)))
+                                                (set! with-mask (-> this root-prim collide-with)))))))))
         (when (logtest? with-mask (collide-kind cak-1 cak-2 cak-3))
           (when (logtest? with-mask (collide-kind cak-1))
-            (let ((node (-> *collide-hit-by-player-list* alive-list next0)))
-              *collide-hit-by-player-list*
-              (let ((next-node (-> node next0)))
-                (while (!= node (-> *collide-hit-by-player-list* alive-list-end))
-                  (let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
-                         (candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
-                    (when (logtest? with-mask (-> candidate-root prim-core collide-as))
-                      (when (and (logtest? (-> candidate-root prim-core action) (collide-action rider-target))
-                                 (!= (-> this process) (-> (the-as collide-shape candidate-shape) process)))
-                        (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
-                          (when (on-platform this (the-as collide-shape candidate-shape) overlap-result)
-                            (let ((rider-entry (add-rider! rider-group (the-as process-drawable (process->handle (-> (the-as collide-shape candidate-shape) process))))))
-                              (when rider-entry
-                                (let ((platform-prim (-> overlap-result best-from-prim)))
-                                  (set! (-> rider-entry sticky-prim) platform-prim)
-                                  (let ((bone-transform (-> this process node-list data (-> platform-prim transform-index) bone transform)))
-                                    (set! (-> rider-entry prim-ry) (matrix-y-angle bone-transform))
-                                    (let ((inverse-transform (new 'stack-no-clear 'matrix)))
-                                      (matrix-4x4-inverse! inverse-transform bone-transform)
-                                      (vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
-                                (send-event (-> this process) 'ridden rider-entry)))
-                            (set! with-mask (-> this root-prim collide-with)))))))
-                  (set! node next-node)
-                  *collide-hit-by-player-list*
-                  (set! next-node (-> next-node next0))))))
+            (iterate-engine-connections (node *collide-hit-by-player-list*)
+                                        (let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
+                                               (candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
+                                          (when (logtest? with-mask (-> candidate-root prim-core collide-as))
+                                            (when (and (logtest? (-> candidate-root prim-core action) (collide-action rider-target))
+                                                       (!= (-> this process) (-> (the-as collide-shape candidate-shape) process)))
+                                              (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
+                                                (when (on-platform this (the-as collide-shape candidate-shape) overlap-result)
+                                                  (let ((rider-entry (add-rider! rider-group (the-as process-drawable (process->handle (-> (the-as collide-shape candidate-shape) process))))))
+                                                    (when rider-entry
+                                                      (let ((platform-prim (-> overlap-result best-from-prim)))
+                                                        (set! (-> rider-entry sticky-prim) platform-prim)
+                                                        (let ((bone-transform (-> this process node-list data (-> platform-prim transform-index) bone transform)))
+                                                          (set! (-> rider-entry prim-ry) (matrix-y-angle bone-transform))
+                                                          (let ((inverse-transform (new 'stack-no-clear 'matrix)))
+                                                            (matrix-4x4-inverse! inverse-transform bone-transform)
+                                                            (vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
+                                                      (send-event (-> this process) 'ridden rider-entry)))
+                                                  (set! with-mask (-> this root-prim collide-with)))))))))
           (when (logtest? with-mask (collide-kind cak-2))
-            (let ((node (-> *collide-usually-hit-by-player-list* alive-list next0)))
-              *collide-usually-hit-by-player-list*
-              (let ((next-node (-> node next0)))
-                (while (!= node (-> *collide-usually-hit-by-player-list* alive-list-end))
-                  (let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
-                         (candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
-                    (when (logtest? with-mask (-> candidate-root prim-core collide-as))
-                      (when (and (logtest? (-> candidate-root prim-core action) (collide-action rider-target))
-                                 (!= (-> this process) (-> (the-as collide-shape candidate-shape) process)))
-                        (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
-                          (when (on-platform this (the-as collide-shape candidate-shape) overlap-result)
-                            (let ((rider-entry (add-rider! rider-group (the-as process-drawable (process->handle (-> (the-as collide-shape candidate-shape) process))))))
-                              (when rider-entry
-                                (let ((platform-prim (-> overlap-result best-from-prim)))
-                                  (set! (-> rider-entry sticky-prim) platform-prim)
-                                  (let ((bone-transform (-> this process node-list data (-> platform-prim transform-index) bone transform)))
-                                    (set! (-> rider-entry prim-ry) (matrix-y-angle bone-transform))
-                                    (let ((inverse-transform (new 'stack-no-clear 'matrix)))
-                                      (matrix-4x4-inverse! inverse-transform bone-transform)
-                                      (vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
-                                (send-event (-> this process) 'ridden rider-entry)))
-                            (set! with-mask (-> this root-prim collide-with)))))))
-                  (set! node next-node)
-                  *collide-usually-hit-by-player-list*
-                  (set! next-node (-> next-node next0))))))
+            (iterate-engine-connections (node *collide-usually-hit-by-player-list*)
+                                        (let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
+                                               (candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
+                                          (when (logtest? with-mask (-> candidate-root prim-core collide-as))
+                                            (when (and (logtest? (-> candidate-root prim-core action) (collide-action rider-target))
+                                                       (!= (-> this process) (-> (the-as collide-shape candidate-shape) process)))
+                                              (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
+                                                (when (on-platform this (the-as collide-shape candidate-shape) overlap-result)
+                                                  (let ((rider-entry (add-rider! rider-group (the-as process-drawable (process->handle (-> (the-as collide-shape candidate-shape) process))))))
+                                                    (when rider-entry
+                                                      (let ((platform-prim (-> overlap-result best-from-prim)))
+                                                        (set! (-> rider-entry sticky-prim) platform-prim)
+                                                        (let ((bone-transform (-> this process node-list data (-> platform-prim transform-index) bone transform)))
+                                                          (set! (-> rider-entry prim-ry) (matrix-y-angle bone-transform))
+                                                          (let ((inverse-transform (new 'stack-no-clear 'matrix)))
+                                                            (matrix-4x4-inverse! inverse-transform bone-transform)
+                                                            (vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
+                                                      (send-event (-> this process) 'ridden rider-entry)))
+                                                  (set! with-mask (-> this root-prim collide-with)))))))))
           (when (logtest? with-mask (collide-kind cak-3))
-            (let ((node (-> *collide-hit-by-others-list* alive-list next0)))
-              *collide-hit-by-others-list*
-              (let ((next-node (-> node next0)))
-                (while (!= node (-> *collide-hit-by-others-list* alive-list-end))
-                  (let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
-                         (candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
-                    (when (logtest? with-mask (-> candidate-root prim-core collide-as))
-                      (when (and (logtest? (-> candidate-root prim-core action) (collide-action rider-target))
-                                 (!= (-> this process) (-> (the-as collide-shape candidate-shape) process)))
-                        (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
-                          (when (on-platform this (the-as collide-shape candidate-shape) overlap-result)
-                            (let ((rider-entry (add-rider! rider-group (the-as process-drawable (process->handle (-> (the-as collide-shape candidate-shape) process))))))
-                              (when rider-entry
-                                (let ((platform-prim (-> overlap-result best-from-prim)))
-                                  (set! (-> rider-entry sticky-prim) platform-prim)
-                                  (let ((bone-transform (-> this process node-list data (-> platform-prim transform-index) bone transform)))
-                                    (set! (-> rider-entry prim-ry) (matrix-y-angle bone-transform))
-                                    (let ((inverse-transform (new 'stack-no-clear 'matrix)))
-                                      (matrix-4x4-inverse! inverse-transform bone-transform)
-                                      (vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
-                                (send-event (-> this process) 'ridden rider-entry)))
-                            (set! with-mask (-> this root-prim collide-with)))))))
-                  (set! node next-node)
-                  *collide-hit-by-others-list*
-                  (set! next-node (-> next-node next0)))))
+            (iterate-engine-connections (node *collide-hit-by-others-list*)
+                                        (let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
+                                               (candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
+                                          (when (logtest? with-mask (-> candidate-root prim-core collide-as))
+                                            (when (and (logtest? (-> candidate-root prim-core action) (collide-action rider-target))
+                                                       (!= (-> this process) (-> (the-as collide-shape candidate-shape) process)))
+                                              (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
+                                                (when (on-platform this (the-as collide-shape candidate-shape) overlap-result)
+                                                  (let ((rider-entry (add-rider! rider-group (the-as process-drawable (process->handle (-> (the-as collide-shape candidate-shape) process))))))
+                                                    (when rider-entry
+                                                      (let ((platform-prim (-> overlap-result best-from-prim)))
+                                                        (set! (-> rider-entry sticky-prim) platform-prim)
+                                                        (let ((bone-transform (-> this process node-list data (-> platform-prim transform-index) bone transform)))
+                                                          (set! (-> rider-entry prim-ry) (matrix-y-angle bone-transform))
+                                                          (let ((inverse-transform (new 'stack-no-clear 'matrix)))
+                                                            (matrix-4x4-inverse! inverse-transform bone-transform)
+                                                            (vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
+                                                      (send-event (-> this process) 'ridden rider-entry)))
+                                                  (set! with-mask (-> this root-prim collide-with))))))))
             #f))))))
 
 (defmethod pull-riders! ((this collide-shape))
@@ -269,7 +245,7 @@
     (let ((rider-shape (-> pull-info rider-cshape)))
       (let ((move-delta (new 'stack-no-clear 'vector))
             (old-position (new 'stack-no-clear 'vector)))
-        (set! (-> old-position quad) (-> rider-shape trans quad))
+        (vector-copy! old-position (-> rider-shape trans))
         (vector-! move-delta (-> pull-info rider-dest) old-position)
         (cond
           ((logtest? (-> this root-prim prim-core action) (collide-action rider-plat))
@@ -278,7 +254,7 @@
              (fill-cache-for-shape! rider-shape (+ 8192.0 (vector-length move-delta)) (-> rider-shape root-prim collide-with))
              (set! (-> this root-prim prim-core collide-as) saved-platform-collide-as))
            (let ((rider-velocity (new 'stack-no-clear 'vector)))
-             (set! (-> rider-velocity quad) (-> move-delta quad))
+             (vector-copy! rider-velocity move-delta)
              (let ((velocity-output rider-velocity))
                (.lvf vf1 (&-> rider-velocity quad))
                (let ((frames-per-second (-> *display* frames-per-second))) (.mov frames-per-second-bits frames-per-second))

goal_src/jak1/engine/collide/collide-target-h.gc

@@ -205,12 +205,12 @@
   "Record a collision-history sample, including the contact point, final position,
    incoming and outgoing velocity, contact normals, collision state, reaction flags, surface
    properties, and the current time."
-  (set! (-> this intersect quad) (-> intersect quad))
-  (set! (-> this transv quad) (-> incoming-velocity quad))
-  (set! (-> this transv-out quad) (-> outgoing-velocity quad))
-  (set! (-> this trans quad) (-> shape trans quad))
-  (set! (-> this local-normal quad) (-> shape local-normal quad))
-  (set! (-> this surface-normal quad) (-> shape surface-normal quad))
+  (vector-copy! (-> this intersect) intersect)
+  (vector-copy! (-> this transv) incoming-velocity)
+  (vector-copy! (-> this transv-out) outgoing-velocity)
+  (vector-copy! (-> this trans) (-> shape trans))
+  (vector-copy! (-> this local-normal) (-> shape local-normal))
+  (vector-copy! (-> this surface-normal) (-> shape surface-normal))
   (set-time! (-> this time))
   (set! (-> this status) (-> shape status))
   (set! (-> this reaction-flag) (-> shape reaction-flag))

goal_src/jak1/engine/common-obs/babak.gc

@@ -24,9 +24,15 @@
   :code
     (behavior ()
       (cond
+        ;; Preserve the special handoff only when the hop is the animation currently driving Babak.
         ((ja-group? babak-give-up-hop-ja)
+         ;; Keep the end of the hop under the walk for 0.15 seconds, softening the change of gait.
          (ja-channel-push! 1 (seconds 0.15))
+         ;; Join the walk at artist frame 12 and seek through the remainder before normal patrol
+         ;; takes over.  `ja-aframe` keeps this join tied to the animator's timeline numbering.
          (ja-play :group! babak-walk-ja :num! (seek!) :frame-num (ja-aframe 12.0 0)))
+        ;; All other entries get a slightly gentler 0.2-second blend for the patrol animation
+        ;; selected by the shared nav-enemy state.
         (else (ja-channel-push! 1 (seconds 0.2))))
       ((the-as (function none) (-> (method-of-type nav-enemy nav-enemy-patrol) code)))))
 
@@ -37,20 +43,30 @@
       ;; Blend the landing pose into a fresh run cycle; otherwise start the run directly.
       (let ((animation-speed (nav-enemy-rnd-float-range 0.9 1.1)))
         (cond
+          ;; The landing has a deliberate run handoff; other incoming poses use the ordinary start.
           ((ja-group? babak-jump-land-ja)
+           ;; Finish configuring the landing seek without evaluating it again before it is stacked.
            (ja-no-eval :num! (seek!))
+           ;; Retain the landing beneath the new run for a short, responsive cross-fade.
            (ja-channel-push! 1 (seconds 0.17))
+           ;; Run once from frame zero to the end at this creature's chosen speed.  Evaluating the
+           ;; lower stack each tick lets the landing continue naturally while its influence fades.
            (ja-play :group!
                     (-> self draw art-group data (-> self nav-info run-anim))
                     :num! (seek! max animation-speed)
                     :frame-num 0.0
                     (ja-blend-eval)))
           (else
+           ;; Give an arbitrary incoming pose a little more time to blend into locomotion.
            (ja-channel-push! 1 (seconds 0.2))
+           ;; Select the run group first, without advancing it, so its opening pose is available.
            (ja :group! (-> self draw art-group data (-> self nav-info run-anim)))
+           ;; Hold that opening pose at frame zero until the chase loop begins advancing the run.
            (ja :num-func num-func-identity :frame-num 0.0)))
         (loop
           (suspend)
+          ;; Advance and wrap the established run every game tick, with a small per-Babak speed
+          ;; variation to keep a group of creatures from moving in mechanical lockstep.
           (ja :num! (loop! animation-speed))))))
 
 ;; Face the player, idle, and celebrate after a landed attack or occasional vulnerable opening.
@@ -62,24 +78,41 @@
       (let ((animation-speed (nav-enemy-rnd-float-range 0.8 1.2)))
         (when (or (logtest? (-> self nav-enemy-flags) (nav-enemy-flags attack-landed))
                   (and (nav-enemy-player-vulnerable?) (nav-enemy-rnd-percent? 0.5)))
+          ;; Blend quickly into the celebratory gesture so a successful attack reads immediately.
           (ja-channel-push! 1 (seconds 0.1))
+          ;; Play from frame zero through artist frame 68, converting that authored beat to the
+          ;; internal timeline and stopping there rather than running into the clip's recovery.
           (ja-play :group! babak-win-ja :num! (seek! (ja-aframe 68.0 0) animation-speed) :frame-num 0.0))
         (loop
           (when (not (nav-enemy-facing-player? 2730.6667))
             (logior! (-> self nav-enemy-flags) (nav-enemy-flags enable-travel))
+            ;; Leave the outgoing pose on a looping rule without evaluating it yet; it will remain
+            ;; alive underneath the turn while the blend is in progress.
             (ja-no-eval :num! (loop!))
+            ;; Stack one turn channel over the outgoing motion with a relaxed 0.2-second fade.
             (ja-channel-push! 1 (seconds 0.2))
+            ;; Install the turn animation without advancing it so the first pose can be held cleanly.
             (ja :group! babak-turn-ja)
+            ;; Pin the turn to frame zero until steering has entered the tighter facing tolerance.
             (ja :num-func num-func-identity :frame-num 0.0)
             (until (nav-enemy-facing-player? 1820.4445)
+              ;; Keep the pose below the turn current; otherwise the cross-fade would blend against
+              ;; a frozen outgoing frame.
               (ja-blend-eval)
               (suspend)
+              ;; Advance and wrap the turn at three-quarter speed while navigation rotates Babak.
               (ja :num! (loop! 0.75)))
             (logclear! (-> self nav-enemy-flags) (nav-enemy-flags enable-travel)))
+          ;; Do not stack an identical idle over itself.  Any other pose gets a smooth 0.2-second
+          ;; transition before the idle is selected.
           (if (not (ja-group? babak-idle-ja)) (ja-channel-push! 1 (seconds 0.2)))
+          ;; Play one complete idle pass at the chosen personality speed, starting from frame zero.
           (ja-play :group! babak-idle-ja :num! (seek! max animation-speed) :frame-num 0.0)
           (when (nav-enemy-rnd-percent? 0.3)
+            ;; The optional flourish should snap into the rhythm, so use a brisk 0.1-second blend.
             (ja-channel-push! 1 (seconds 0.1))
+            ;; Repeat the same authored celebration beat, stopping at artist frame 68 before the
+            ;; stare loop returns to idle.
             (ja-play :group! babak-win-ja :num! (seek! (ja-aframe 68.0 0) animation-speed) :frame-num 0.0))))))
 
 (defstate nav-enemy-give-up (babak)
@@ -88,6 +121,7 @@
     (behavior ()
       (set! (-> self rotate-speed) 218453.33)
       (set! (-> self turn-time) (seconds 0.5))
+      ;; Establish one blended action channel for the optional gesture and the hop that follows it.
       (ja-channel-push! 1 (seconds 0.15))
       ;; Only play the give-up gesture when the player is within 70 degrees of Babak's facing.
       (let ((collision (-> self collide-info))
@@ -95,9 +129,12 @@
         (if (< (fabs (deg-diff (y-angle collision)
                                (vector-y-angle (vector-! (new 'stack-no-clear 'vector) player-position (-> collision trans)))))
                12743.111)
+          ;; Seek the give-up gesture from frame zero to its natural end as a complete one-shot.
           (ja-play :group! babak-give-up-ja :num! (seek!) :frame-num 0.0)))
       (logclear! (-> self nav flags) (nav-control-flags blocked reached-destination))
       (nav-enemy-get-new-patrol-point)
+      ;; Play the hop from beginning to end.  The body steers toward the new patrol point every
+      ;; frame, keeping the authored hop and the navigation turn visibly locked together.
       (ja-play :group!
                babak-give-up-hop-ja
                :num! (seek!)
@@ -113,8 +150,12 @@
   :virtual #t
   :code
     (behavior ()
+      ;; Put the outgoing jump on its final-frame seek without evaluating it before the blend.
       (ja-no-eval :num! (seek!))
+      ;; The landing needs a short blend so its contact remains sharp instead of looking slippery.
       (ja-channel-push! 1 (seconds 0.075))
+      ;; Play only the first 32 artist frames of the landing at half speed.  While waiting, update
+      ;; the jump below it so the blend has a live source pose all the way through the contact.
       (ja-play :group!
                (-> self draw art-group data (-> self nav-info jump-land-anim))
                :num!

goal_src/jak1/engine/common-obs/basebutton.gc

@@ -48,8 +48,8 @@
    component of the current root transform."
   (set! (-> this move-to?) #t)
   (if position
-    (set! (-> this move-to-pos quad) (-> position quad))
-    (set! (-> this move-to-pos quad) (-> this root trans quad)))
+    (vector-copy! (-> this move-to-pos) position)
+    (vector-copy! (-> this move-to-pos) (-> this root trans)))
   (if rotation
     (quaternion-copy! (-> this move-to-quat) rotation)
     (quaternion-copy! (-> this move-to-quat) (-> this root quat))))
@@ -84,7 +84,7 @@
     (behavior ()
       (when (-> self move-to?)
         (set! (-> self move-to?) #f)
-        (set! (-> self root trans quad) (-> self move-to-pos quad))
+        (vector-copy! (-> self root trans) (-> self move-to-pos))
         (quaternion-copy! (-> self root quat) (-> self move-to-quat))
         (rider-post))))
 
@@ -108,7 +108,7 @@
     (behavior ()
       (when (-> self move-to?)
         (set! (-> self move-to?) #f)
-        (set! (-> self root trans quad) (-> self move-to-pos quad))
+        (vector-copy! (-> self root trans) (-> self move-to-pos))
         (quaternion-copy! (-> self root quat) (-> self move-to-quat)))
       (rider-post)))
 
@@ -140,7 +140,7 @@
     (behavior ()
       (when (-> self move-to?)
         (set! (-> self move-to?) #f)
-        (set! (-> self root trans quad) (-> self move-to-pos quad))
+        (vector-copy! (-> self root trans) (-> self move-to-pos))
         (quaternion-copy! (-> self root quat) (-> self move-to-quat))
         (rider-post))))
 
@@ -164,7 +164,7 @@
     (behavior ()
       (when (-> self move-to?)
         (set! (-> self move-to?) #f)
-        (set! (-> self root trans quad) (-> self move-to-pos quad))
+        (vector-copy! (-> self root trans) (-> self move-to-pos))
         (quaternion-copy! (-> self root quat) (-> self move-to-quat)))
       (rider-post)))
 
@@ -316,7 +316,7 @@
   (set! (-> self timeout) timeout)
   (if source-entity (set! (-> self entity) source-entity))
   (setup-collision! self)
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (quaternion-copy! (-> self root quat) rotation)
   (set-vector! (-> self root scale) 1.0 1.0 1.0 1.0)
   (arm-trigger-event! self)
@@ -357,7 +357,7 @@
         (set! (-> event-block message) 'change-state)
         (set! (-> event-block param 0) (the-as uint target-warp-out))
         (let ((gate-position (new 'static 'vector)))
-          (set! (-> gate-position quad) (-> self root trans quad))
+          (vector-copy! gate-position (-> self root trans))
           (set! (-> event-block param 1) (the-as uint gate-position)))
         (set! (-> event-block param 2) (the-as uint (target-pos 0)))
         (send-event-function *target* event-block))
@@ -426,13 +426,13 @@
       (set-time! (-> self state-time))
       (logclear! (-> self control status) (collide-status on-surface on-ground touch-surface))
       (set! (-> self control mod-surface) *warp-jump-mods*)
-      (set! (-> self control state-vector0 quad) (-> gate-position quad))
-      (set! (-> self control state-vector1 quad) (-> camera-position quad))
+      (vector-copy! (-> self control state-vector0) gate-position)
+      (vector-copy! (-> self control state-vector1) camera-position)
       (+! (-> self control state-vector0 y) -4096.0)
       (set! (-> self control state-var0) (the-as uint #f))
       (vector-reset! (-> self control transv))
       (logior! (-> self state-flags) (state-flags use-alt-cam-pos))
-      (set! (-> self alt-cam-pos quad) (-> camera-position quad)))
+      (vector-copy! (-> self alt-cam-pos) camera-position))
   :exit
     (behavior ()
       (logclear! (-> self state-flags) (state-flags use-alt-cam-pos)))

goal_src/jak1/engine/common-obs/baseplat.gc

@@ -61,7 +61,7 @@
   "Mark the skeleton initialized, save the collision root's current translation as the
    platform's resting transform, and clear the bounce state."
   (logior! (-> this skel status) (janim-status inited))
-  (set! (-> this basetrans quad) (-> this root trans quad))
+  (vector-copy! (-> this basetrans) (-> this root trans))
   (set! (-> this bouncing) #f)
   0
   (none))
@@ -100,7 +100,7 @@
   (cond
     ((-> self bouncing)
      (let ((bounce-transform (new 'stack-no-clear 'vector)))
-       (set! (-> bounce-transform quad) (-> self basetrans quad))
+       (vector-copy! bounce-transform (-> self basetrans))
        (+! (-> bounce-transform y) (* 819.2 (update! (-> self smush))))
        (move-to-point! (-> self root) bounce-transform))
      (if (not (!= (-> self smush amp) 0.0)) (set! (-> self bouncing) #f)))

goal_src/jak1/engine/common-obs/collectables-part.gc

@@ -72,7 +72,7 @@
                             (-> tracker root trans)
                             (vector<-cspace! (new 'stack-no-clear 'vector) (-> target-process node-list data 5))))
          (tracker-position (-> tracker root trans)))
-    (set! (-> tracker-position quad) (-> target-position quad))
+    (vector-copy! tracker-position target-position)
     tracker-position))
 
 (defpartgroup group-eco-blue

goal_src/jak1/engine/common-obs/collectables.gc

@@ -70,8 +70,8 @@
     (set! (-> this fadeout-timeout) fadeout-time))
   (set! (-> this collect-timeout) (seconds 0.33))
   (set-time! (-> this birth-time))
-  (set! (-> this base quad) (-> this root trans quad))
-  (set! (-> this old-base quad) (-> this root trans quad))
+  (vector-copy! (-> this base) (-> this root trans))
+  (vector-copy! (-> this old-base) (-> this root trans))
   (set! (-> this pickup-handle) (the-as handle #f))
   (case (-> this fact pickup-type)
     (((pickup-type eco-pill) (pickup-type eco-green) (pickup-type money) (pickup-type eco-blue))
@@ -180,8 +180,8 @@
     (set! (-> self fact pickup-type) kind)
     (set! (-> self fact pickup-amount) amount))
   (set! (-> self fact options) (-> pickup-info options))
-  (set! (-> self root trans quad) (-> position quad))
-  (set! (-> self root transv quad) (-> velocity quad))
+  (vector-copy! (-> self root trans) position)
+  (vector-copy! (-> self root transv) velocity)
   (initialize-effect self (-> self fact pickup-type))
   (set! (-> self notify-parent) #f)
   (case (-> self fact pickup-type)
@@ -203,7 +203,7 @@
   (set! (-> this pickup-amount) amount)
   (set! (-> this pickup-type) kind)
   (initialize this)
-  (set! (-> this root trans quad) (-> source-entity extra trans quad))
+  (vector-copy! (-> this root trans) (-> source-entity extra trans))
   (initialize-effect this (-> this fact pickup-type))
   (initialize-params this 0 (the-as float 1024.0))
   (update-transforms! (-> this root))
@@ -312,8 +312,8 @@
           (animate self)
           (suspend)
           (if (nonzero? (-> self skel)) (ja :num! (loop! 0.5)))))
-      (set! (-> self root trans quad) (-> self jump-pos quad))
-      (set! (-> self base quad) (-> self root trans quad))
+      (vector-copy! (-> self root trans) (-> self jump-pos))
+      (vector-copy! (-> self base) (-> self root trans))
       (vector-reset! (-> self root transv))
       (update-transforms! (-> self root))
       (logclear! (-> self flags) (collectable-flags trans))
@@ -345,12 +345,12 @@
            (logclear! (-> self mask) (process-mask actor-pause))
            (go-virtual notice-blue (process->handle proc))))
         ((= message 'trans)
-         (set! (-> self root trans quad) (-> (the-as vector (-> block param 0)) quad))
+         (vector-copy! (-> self root trans) (the-as vector (-> block param 0)))
          (update-transforms! (-> self root))
          (ja-post))
         ((= message 'jump)
          (logclear! (-> self mask) (process-mask actor-pause))
-         (set! (-> self jump-pos quad) (-> (the-as vector (-> block param 0)) quad))
+         (vector-copy! (-> self jump-pos) (the-as vector (-> block param 0)))
          (go-virtual jump))
         ((= message 'pickup)
          (when (!= (-> self next-state name) 'pickup)
@@ -395,7 +395,7 @@
               (logclear! (-> self flags) (collectable-flags trans))
               (logior! (-> self flags) (collectable-flags can-collect))
               (if (-> self actor-pause) (logior! (-> self mask) (process-mask actor-pause)))
-              (set! (-> self base quad) (-> self root trans quad))
+              (vector-copy! (-> self base) (-> self root trans))
               (if (and (logtest? (-> self fact options) (fact-options can-collect))
                        (not (logtest? (-> self flags) (collectable-flags ignore-blue))))
                 (go-virtual notice-blue (process->handle *target*)))
@@ -438,7 +438,7 @@
   :enter
     (behavior ((target-handle handle))
       (set! (-> self target) target-handle)
-      (set! (-> self speed quad) (the-as uint128 0))
+      (vector-zero! (-> self speed))
       (set! (-> self speed z) (the-as float (if (rand-vu-percent? (the-as float 0.5)) 1.0 -1.0)))
       (set! (-> self suck-y-offset) 0.0)
       (logclear! (-> self mask) (process-mask actor-pause)))
@@ -458,7 +458,7 @@
   :code
     (behavior ((target-handle handle))
       (loop
-        (set! (-> self root trans quad) (-> self base quad))
+        (vector-copy! (-> self root trans) (-> self base))
         (add-blue-motion #t #f #t #f)
         (update-transforms! (-> self root))
         (if (nonzero? (-> self draw)) (ja-post))
@@ -602,8 +602,8 @@
         (else
          (while (let ((zero 0.0)) (< zero (the-as float (send-event *target* 'query 'pickup (-> self fact pickup-type)))))
            (suspend))))
-      (set! (-> self base quad) (-> self old-base quad))
-      (set! (-> self root trans quad) (-> self base quad))
+      (vector-copy! (-> self base) (-> self old-base))
+      (vector-copy! (-> self root trans) (-> self base))
       (restore-collide-with-as (-> self root))
       (go-virtual wait)))
 
@@ -758,7 +758,7 @@
     (behavior ((target-handle handle))
       (loop
         (quaternion-rotate-y! (-> self root quat) (-> self root quat) (* 91022.22 (seconds-per-frame)))
-        (set! (-> self root trans quad) (-> self base quad))
+        (vector-copy! (-> self root trans) (-> self base))
         (add-blue-motion #t #t #t #f)
         (let ((bob-amount (-> self bob-amount)))
           (if (< 0.0 bob-amount)
@@ -839,10 +839,10 @@
     (set! (-> self fact pickup-amount) amount))
   (set! (-> self fact options) (-> pickup-info options))
   (set! (-> self notify-parent) #t)
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (quaternion-identity! (-> self root quat))
   (vector-identity! (-> self root scale))
-  (set! (-> self root transv quad) (-> velocity quad))
+  (vector-copy! (-> self root transv) velocity)
   (initialize-params self (seconds 15) (the-as float 1024.0))
   (update-transforms! (-> self root))
   (set! (-> self event-hook) (-> (method-of-object self wait) event))
@@ -859,10 +859,10 @@
   (set! (-> self fact pickup-type) kind)
   (set! (-> self fact pickup-amount) amount)
   (set! (-> self notify-parent) #t)
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (quaternion-identity! (-> self root quat))
   (vector-identity! (-> self root scale))
-  (set! (-> self root transv quad) (-> velocity quad))
+  (vector-copy! (-> self root transv) velocity)
   (initialize-params self (seconds 15) (the-as float 0.0))
   (logior! (-> self flags) (collectable-flags ignore-blue))
   (update-transforms! (-> self root))
@@ -956,8 +956,8 @@
         (go-virtual pickup #f (process->handle proc)))
       (cond
         ((= message 'trans)
-         (set! (-> self root trans quad) (-> (the-as vector (-> block param 0)) quad))
-         (set! (-> self base quad) (-> self root trans quad))
+         (vector-copy! (-> self root trans) (the-as vector (-> block param 0)))
+         (vector-copy! (-> self base) (-> self root trans))
          (update-transforms! (-> self root)))
         ((= message 'pickup)
          (when (!= (-> self next-state name) 'pickup)
@@ -1191,8 +1191,8 @@
   (set! (-> this notify-parent) #f)
   (set! (-> this fact) (new 'process 'fact-info this (pickup-type fuel-cell) (the-as float 0.0)))
   (initialize-skeleton this *fuel-cell-sg* '())
-  (set! (-> this base quad) (-> this root trans quad))
-  (set! (-> this old-base quad) (-> this root trans quad))
+  (vector-copy! (-> this base) (-> this root trans))
+  (vector-copy! (-> this old-base) (-> this root trans))
   (set! (-> this part) (create-launch-control group-fuel-cell-starburst this))
   (set! (-> this sound) (new 'process 'ambient-sound (static-sound-spec "powercell-idle" :fo-max 40) (-> this root trans)))
   (set! (-> this victory-anim) (fuel-cell-pick-anim this))
@@ -1223,24 +1223,24 @@
     (set! (-> self fact pickup-amount) amount))
   (set! (-> self fact options) (-> pickup-info options))
   (set! (-> self notify-parent) #t)
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (quaternion-identity! (-> self root quat))
   (vector-identity! (-> self root scale))
-  (set! (-> self root transv quad) (-> velocity quad))
+  (vector-copy! (-> self root transv) velocity)
   (initialize-params self 0 (the-as float 1024.0))
   (logclear! (-> self fact options) (fact-options can-collect))
   (update-transforms! (-> self root))
   (let ((movie-position (res-lump-struct (-> self entity) 'movie-pos structure :time (the-as float -1000000000.0))))
     (cond
       ((and *debug-segment* (< (-> *fuel-cell-tune-pos* w) 1000000000.0))
-       (set! (-> self jump-pos quad) (-> *fuel-cell-tune-pos* quad))
+       (vector-copy! (-> self jump-pos) *fuel-cell-tune-pos*)
        (+! (-> self jump-pos y) 4096.0)
        (go-virtual jump))
       ((and movie-position
             (not (logtest? (res-lump-value (-> self entity) 'options fact-options :time (the-as float -1000000000.0))
                            (fact-options skip-jump-anim)))
             (not (logtest? (-> self fact options) (fact-options skip-jump-anim))))
-       (set! (-> self jump-pos quad) (-> (the-as vector movie-position) quad))
+       (vector-copy! (-> self jump-pos) (the-as vector movie-position))
        (+! (-> self jump-pos y) 4096.0)
        (go-virtual jump))))
   (set! (-> self event-hook) (-> (method-of-object self wait) event))
@@ -1257,12 +1257,12 @@
            (logclear! (-> self mask) (process-mask actor-pause))
            (go-virtual pickup #f (the-as handle #f))))
         (('trans)
-         (set! (-> self root trans quad) (-> (the-as vector (-> block param 0)) quad))
-         (set! (-> self base quad) (-> self root trans quad))
+         (vector-copy! (-> self root trans) (the-as vector (-> block param 0)))
+         (vector-copy! (-> self base) (-> self root trans))
          (update-transforms! (-> self root)))
         (('stop-cloning 'notify)
-         (set! (-> self root trans quad) (-> self draw origin quad))
-         (set! (-> self base quad) (-> self root trans quad))
+         (vector-copy! (-> self root trans) (-> self draw origin))
+         (vector-copy! (-> self base) (-> self root trans))
          (ja-channel-set! 1)
          (ja :group! fuel-cell-idle-ja)
          (logclear! (-> self draw status) (draw-status hidden))
@@ -1448,10 +1448,10 @@
     (set! (-> self fact pickup-amount) amount))
   (set! (-> self fact options) (-> pickup-info options))
   (set! (-> self notify-parent) #t)
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (quaternion-identity! (-> self root quat))
   (vector-identity! (-> self root scale))
-  (set! (-> self root transv quad) (-> velocity quad))
+  (vector-copy! (-> self root transv) velocity)
   (initialize-params self 0 (the-as float 1024.0))
   (update-transforms! (-> self root))
   (update-trans! (-> self sound) (-> self root trans))
@@ -1649,7 +1649,7 @@
                  (+ (rand-vu-float-range (the-as float 3.0) (+ 5.0 amount)) (the float amount-bonus)))
                 (else (+ (rand-vu-float-range (the-as float 2.0) (+ 3.0 amount)) (the float amount-bonus)))))))
     (let ((spawn-position (new 'stack-no-clear 'vector)))
-      (set! (-> spawn-position quad) (-> this process root trans quad))
+      (vector-copy! spawn-position (-> this process root trans))
       (+! (-> spawn-position y) 12288.0)
       (let ((ground-hit (new 'stack-no-clear 'collide-tri-result)))
         (if (>= (fill-and-probe-using-y-probe *collide-cache*
@@ -1660,8 +1660,8 @@
                                               ground-hit
                                               (new 'static 'pat-surface :noentity #x1))
                 0.0)
-          (set! (-> spawn-position quad) (-> ground-hit intersect quad))
-          (set! (-> spawn-position quad) (-> this process root trans quad))))
+          (vector-copy! spawn-position (-> ground-hit intersect))
+          (vector-copy! spawn-position (-> this process root trans))))
       (if (= (the-as int kind) 6) (+! (-> spawn-position y) 6144.0))
       (birth-pickup-at-point spawn-position (the-as pickup-type kind) amount radial-velocity? destination-pool this))))
 
@@ -1720,11 +1720,11 @@
   (if (and *target* (logtest? (-> *target* control root-prim prim-core action) (collide-action racer)))
     (clear-collide-with-as (-> self root)))
   (set! (-> self block-func) block-fn)
-  (set! (-> self root trans quad) (-> (the-as process-drawable (-> self parent 0)) root trans quad))
+  (vector-copy! (-> self root trans) (-> (the-as process-drawable (-> self parent 0)) root trans))
   (set-vector! (-> self offset-target) 0.0 -2252.8 0.0 1.0)
   (if (not ((-> self block-func) (the-as vent (ppointer->process (-> self parent)))))
     (set-vector! (-> self offset-target) 0.0 0.0 0.0 1.0))
-  (set! (-> self offset quad) (-> self offset-target quad))
+  (vector-copy! (-> self offset) (-> self offset-target))
   (initialize-skeleton self *ecovalve-sg* '())
   (move-to-point! (-> self root)
                   (vector+! (new 'stack-no-clear 'vector) (-> (the-as process-drawable (-> self parent 0)) root trans) (-> self offset)))
@@ -1762,7 +1762,7 @@
     (set! (-> collision-shape nav-radius) (* 0.75 (-> collision-shape root-prim local-sphere w)))
     (backup-collide-with-as collision-shape)
     (set! (-> this root) collision-shape))
-  (set! (-> this root trans quad) (-> source-entity extra trans quad))
+  (vector-copy! (-> this root trans) (-> source-entity extra trans))
   (update-transforms! (-> this root))
   (set! (-> this root pause-adjust-distance) 409600.0)
   (set! (-> this fact) (new 'process 'fact-info this kind (-> *FACT-bank* eco-full-inc)))

goal_src/jak1/engine/common-obs/crates.gc

@@ -590,7 +590,7 @@
                     (go-virtual die #f 0))
                   (when (rand-vu-percent? 0.5)
                     (let ((glow-position (new 'stack-no-clear 'vector)))
-                      (set! (-> glow-position quad) (-> crate-core world-sphere quad))
+                      (vector-copy! glow-position (-> crate-core world-sphere))
                       (dotimes (i 3)
                         (+! (-> glow-position data i) (rand-vu-float-range -5324.8 5324.8)))
                       (eco-blue-glow glow-position)))
@@ -762,7 +762,7 @@
   "Initialize a spawned crate from entity, place it at position, use crate-type for both its look
    and defense, initialize its art, and enter its saved-dead or ordinary wait state."
   (params-init self entity-record)
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (set! (-> self look) crate-type)
   (set! (-> self defense) crate-type)
   (art-init self)
@@ -863,7 +863,7 @@
      (set! (-> this root root-prim prim-core offense) (collide-offense normal-attack)))
     ((logtest? (-> this fact options) (fact-options touch))
      (set! (-> this root root-prim prim-core offense) (collide-offense touch))))
-  (set! (-> this base quad) (-> this root trans quad))
+  (vector-copy! (-> this base) (-> this root trans))
   (crate-post)
   (nav-mesh-connect this (-> this root) (the-as nav-control #f))
   this)

goal_src/jak1/engine/common-obs/generic-obs.gc

@@ -54,7 +54,7 @@
                 (collision-root (if (and (nonzero? root) (type-type? (-> root type) collide-shape)) (the-as collide-shape root))))
            (if collision-root
              (move-to-point! collision-root (-> (the-as process-drawable source) root trans))
-             (set! (-> self root trans quad) (-> (the-as process-drawable source) root trans quad))))
+             (vector-copy! (-> self root trans) (-> (the-as process-drawable source) root trans))))
          (quaternion-copy! (-> self root quat) (-> (the-as process-drawable source) root quat)))
        (if (logtest? (-> (the-as process-drawable source) skel status) (janim-status spool))
          (logior! (-> self skel status) (janim-status spool)))
@@ -114,7 +114,7 @@
   (stack-size-set! (-> this main-thread) 128)
   (logior! (-> this mask) (process-mask actor-pause))
   (set! (-> this root) (new 'process 'trsq))
-  (set! (-> this root trans quad) (-> source-entity extra trans quad))
+  (vector-copy! (-> this root trans) (-> source-entity extra trans))
   (quaternion-copy! (-> this root quat) (-> source-entity quat))
   (vector-identity! (-> this root scale))
   (vector-y-quaternion! (-> this dir) (-> this root quat))
@@ -201,7 +201,7 @@
          (let ((grabbed-process (handle->process (-> self cur-grab-handle))))
            (when grabbed-process
              (set! result (-> self old-grab-pos))
-             (set! (-> (the-as vector result) quad) (-> (the-as process-drawable grabbed-process) root trans quad))
+             (vector-copy! (the-as vector result) (-> (the-as process-drawable grabbed-process) root trans))
              result)))
         (('target)
          (set! result (process->handle (the-as process (-> block param 0))))
@@ -213,7 +213,7 @@
             (move-to-point! (the-as collide-shape (-> self root)) (the-as vector (-> block param 0))))
            (else
             (set! result (-> self root trans))
-            (set! (-> (the-as vector result) quad) (-> (the-as vector (-> block param 0)) quad))
+            (vector-copy! (the-as vector result) (the-as vector (-> block param 0)))
             result)))
         (('rot)
          (let ((rotation-matrix (new 'stack-no-clear 'matrix)))
@@ -270,7 +270,7 @@
               (vector+! (-> self root trans)
                         (-> self root trans)
                         (vector-! (new 'stack-no-clear 'vector) grabbed-position (-> self old-grab-pos))))
-            (set! (-> self old-grab-pos quad) (-> grabbed-position quad)))))
+            (vector-copy! (-> self old-grab-pos) grabbed-position))))
       ((-> self cur-trans-hook)))
   :code
     (behavior ()
@@ -344,7 +344,7 @@
        (backup-collide-with-as collectable-root)
        (set! (-> self root) collectable-root)))
     (else (set! (-> self root) (new 'process 'trsqv))))
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (initialize-skeleton self skel-group '())
   (if (type-type? (-> self root type) collide-shape) (update-transforms! (the-as collide-shape (-> self root))))
   (set! (-> self shadow-backup) (-> self draw shadow))
@@ -423,8 +423,8 @@
    group's duration when duration is not positive, invoking callback each frame when supplied."
   (stack-size-set! (-> self main-thread) 128)
   (set! (-> self root) (new 'process 'trsqv))
-  (set! (-> self root trans quad) (-> origin world-sphere quad))
-  (set! (-> self offset quad) (-> origin world-sphere quad))
+  (vector-copy! (-> self root trans) (-> origin world-sphere))
+  (vector-copy! (-> self offset) (-> origin world-sphere))
   (set! (-> self callback) (the-as (function part-tracker vector) frame-callback))
   (set! (-> self linger-callback) #f)
   (set! (-> self userdata) (the-as uint userdata))
@@ -1187,7 +1187,7 @@
           (vector--float*! (-> self trans) (-> *camera* tpos-curr) (-> *camera* local-down) 28672.0)
           (vector-flatten! level-forward (-> self tracking inv-mat vector 2) (-> *camera* local-down))
           (vector-normalize! level-forward 1.0)
-          (set! (-> self pivot-pt quad) (-> level-forward quad))
+          (vector-copy! (-> self pivot-pt) level-forward)
           (vector+float*! level-forward level-forward (-> *camera* local-down) 1000.0)
           (vector-normalize-copy! (-> self tracking inv-mat vector 2) level-forward 1.0))
         (vector-cross! (-> self tracking inv-mat vector 1)
@@ -1416,7 +1416,7 @@
     (set! (-> root-shape nav-radius) (* 0.75 (-> root-shape root-prim local-sphere w)))
     (backup-collide-with-as root-shape)
     (set! (-> self root) root-shape))
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (set-vector! (-> self root scale) 1.0 1.0 1.0 1.0)
   (set-vector! (-> self root quat) 0.0 0.0 0.0 1.0)
   (update-transforms! (-> self root))
@@ -1518,7 +1518,7 @@
             (let* ((target-root (-> (the-as process-drawable target-drawable) root))
                    (target-shape (if (and (nonzero? target-root) (type-type? (-> target-root type) collide-shape)) target-root)))
               (if target-shape
-                (set! (-> self root trans quad) (-> (the-as collide-shape target-shape) root-prim prim-core world-sphere quad))))))
+                (vector-copy! (-> self root trans) (-> (the-as collide-shape target-shape) root-prim prim-core world-sphere))))))
         (if (-> self callback) ((-> self callback) self))
         (update-transforms! (-> self root))
         (let ((overlap-params (new 'stack-no-clear 'overlaps-others-params)))
@@ -1548,7 +1548,7 @@
     (backup-collide-with-as tracker-shape)
     (set! (-> tracker-shape event-self) 'touched)
     (set! (-> self root) tracker-shape))
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (set! (-> self duration) duration)
   (set! (-> self target) (the-as handle #f))
   (set! (-> self event) #f)

goal_src/jak1/engine/common-obs/nav-enemy.gc

@@ -160,13 +160,13 @@
      (go-virtual nav-enemy-die))
     (('jump)
      (when (!= (-> self next-state name) 'nav-enemy-jump-land)
-       (set! (-> self event-param-point quad) (-> (the-as vector (-> block param 0)) quad))
+       (vector-copy! (-> self event-param-point) (the-as vector (-> block param 0)))
        (set! (-> self nav user-poly) (the-as nav-poly (-> block param 1)))
        (set! (-> self jump-return-state) (the-as (state process) (-> self state)))
        (go-virtual nav-enemy-jump)))
     (('cue-jump-to-point)
      (when (logtest? (-> self nav-enemy-flags) (nav-enemy-flags waiting-for-cue))
-       (set! (-> self event-param-point quad) (-> (the-as vector (-> block param 0)) quad))
+       (vector-copy! (-> self event-param-point) (the-as vector (-> block param 0)))
        (let ((new-flags (the-as object (logclear (-> self nav-enemy-flags) (nav-enemy-flags waiting-for-cue)))))
          (set! (-> self nav-enemy-flags) (the-as nav-enemy-flags new-flags))
          new-flags)))
@@ -415,7 +415,7 @@ nav-enemy-default-event-handler
   "Return true when the enemy's horizontal facing is within angle-tolerance of direction."
   (let ((facing-direction (vector-z-quaternion! (new 'stack-no-clear 'vector) (-> self collide-info quat)))
         (test-direction (new 'stack-no-clear 'vector)))
-    (set! (-> test-direction quad) (-> direction quad))
+    (vector-copy! test-direction direction)
     (set! (-> test-direction y) 0.0)
     (vector-normalize! test-direction 1.0)
     (>= (vector-dot facing-direction test-direction) (cos angle-tolerance))))
@@ -480,7 +480,7 @@ nav-enemy-default-event-handler
   (let* ((hit-direction (-> self hit-from-dir))
          (attacker-process source)
          (attacker (if (and (nonzero? attacker-process) (type-type? (-> attacker-process type) process-drawable)) attacker-process)))
-    (set! (-> hit-direction quad) (-> *null-vector* quad))
+    (vector-copy! hit-direction *null-vector*)
     (when attacker
       (vector-! hit-direction (-> self collide-info trans) (-> (the-as process-drawable attacker) root trans))
       (set! (-> hit-direction y) 0.0)
@@ -728,7 +728,7 @@ nav-enemy-default-event-handler
   "Clear frustrated, record the player's current shadow position, and restart the frustration
    timer."
   (logclear! (-> self nav-enemy-flags) (nav-enemy-flags frustrated))
-  (if *target* (set! (-> self frustration-point quad) (-> *target* control shadow-pos quad)))
+  (if *target* (vector-copy! (-> self frustration-point) (-> *target* control shadow-pos)))
   (set-time! (-> self frustration-time))
   0
   (none))
@@ -834,7 +834,7 @@ nav-enemy-default-event-handler
                       (the int (+ (lerp-scale 3000.0 0.0 distance-to-player 12288.0 122880.0) (nav-enemy-rnd-float-range 0.0 900.0))))))
       (set! (-> self rotate-speed) (-> self nav-info run-rotate-speed))
       (set! (-> self turn-time) (-> self nav-info run-turn-time))
-      (set! (-> self collide-info transv quad) (-> *null-vector* quad)))
+      (vector-copy! (-> self collide-info transv) *null-vector*))
   :exit
     (behavior ()
       (logior! (-> self nav-enemy-flags) (nav-enemy-flags enable-travel)))
@@ -897,7 +897,7 @@ nav-enemy-default-event-handler
   :event nav-enemy-default-event-handler
   :enter
     (behavior ()
-      (set! (-> self collide-info transv quad) (-> *null-vector* quad)))
+      (vector-copy! (-> self collide-info transv) *null-vector*))
   :code
     (behavior ()
       (ja-channel-push! 1 (seconds 0.075))
@@ -984,7 +984,7 @@ nav-enemy-default-event-handler
 (defbehavior nav-enemy-initialize-custom-jump nav-enemy ((destination vector) (use-drop-arc? symbol) (minimum-height float) (height-factor float) (gravity float))
   "Solve a ballistic jump to destination from minimum height, distance height factor, and gravity.
    Classify standing and drop jumps and reserve the destination as an extra navigation sphere."
-  (set! (-> self jump-dest quad) (-> destination quad))
+  (vector-copy! (-> self jump-dest) destination)
   (let* ((start-position (-> self collide-info trans))
          (horizontal-distance (vector-vector-xz-distance start-position destination))
          (arc-height (fmax minimum-height (* height-factor horizontal-distance))))
@@ -1059,7 +1059,7 @@ nav-enemy-default-event-handler
     (suspend)
     (ja :num! (seek!))
     (ja-blend-eval))
-  (set! (-> self collide-info trans quad) (-> self jump-dest quad))
+  (vector-copy! (-> self collide-info trans) (-> self jump-dest))
   (set! (-> self collide-info transv y) 0.0)
   (logclear! (-> self collide-info nav-flags) (nav-flags avoid-extra-sphere))
   0
@@ -1147,7 +1147,7 @@ nav-enemy-default-event-handler
       (set-time! (-> self state-time))
       (logclear! (-> self nav flags) (nav-control-flags reached-destination))
       (let ((flat-velocity (new 'stack-no-clear 'vector)))
-        (set! (-> flat-velocity quad) (-> self collide-info transv quad))
+        (vector-copy! flat-velocity (-> self collide-info transv))
         (set! (-> flat-velocity y) 0.0)
         (set! (-> self target-speed) (vector-length flat-velocity))
         (set! (-> self momentum-speed) (-> self target-speed))
@@ -1305,8 +1305,8 @@ nav-enemy-default-event-handler
    normal notice-distance gating, and enter the controller cue state."
   (initialize-collision self)
   (logior! (-> self mask) (process-mask actor-pause))
-  (set! (-> self collide-info trans quad) (-> spawn-position quad))
-  (set! (-> self event-param-point quad) (-> cue-point quad))
+  (vector-copy! (-> self collide-info trans) spawn-position)
+  (vector-copy! (-> self event-param-point) cue-point)
   (let ((facing-direction (vector-! (new 'stack-no-clear 'vector) cue-point spawn-position)))
     (set! (-> facing-direction y) 0.0)
     (vector-normalize! facing-direction 1.0)
@@ -1350,11 +1350,11 @@ nav-enemy-default-event-handler
   "Return true when a proposed jump destination lies inside an occupied navigation sphere
    relative to this enemy."
   (let ((saved-position (new 'stack-no-clear 'vector)))
-    (set! (-> saved-position quad) (-> this collide-info trans quad))
-    (set! (-> this collide-info trans quad) (-> point quad))
+    (vector-copy! saved-position (-> this collide-info trans))
+    (vector-copy! (-> this collide-info trans) point)
     (let ((navigation (-> this nav)))
       (gather-nav-spheres! navigation (the-as collide-kind -1))
-      (set! (-> this collide-info trans quad) (-> saved-position quad))
+      (vector-copy! (-> this collide-info trans) saved-position)
       (let* ((mesh-origin (-> navigation mesh origin))
              (point-offset-x (- (-> point x) (-> mesh-origin x)))
              (point-offset-z (- (-> point z) (-> mesh-origin z))))

goal_src/jak1/engine/common-obs/orb-cache.gc

@@ -119,8 +119,7 @@
         (seek! (-> this basetrans y) (+ (-> this root-pos) target-platform-offset) (* 40960.0 (seconds-per-frame)))
         (if (not (= (-> this basetrans y) (+ (-> this root-pos) target-platform-offset))) (set! at-target? #f)))
       (dotimes (orb-index (-> this money))
-        (set! (-> orb-position quad)
-              (-> (the-as process-drawable (handle->process (-> this money-list orb-index))) root trans quad))
+        (vector-copy! orb-position (-> (the-as process-drawable (handle->process (-> this money-list orb-index))) root trans))
         (seek! (-> this money-pos-actual orb-index) (-> this money-pos-list orb-index) (* 40960.0 (seconds-per-frame)))
         (if (not (= (-> this money-pos-actual orb-index) (-> this money-pos-list orb-index))) (set! at-target? #f))
         (if (>= (-> this money-pos-actual orb-index) (+ -8192.0 (-> this root-pos)))
@@ -146,7 +145,7 @@
       (if initial? (set! (-> self basetrans y) (-> self platform-pos)) (sound-play "open-orb-cash"))
       (dotimes (i (-> self money))
         (let ((spawn-position (new 'stack-no-clear 'vector)))
-          (set! (-> spawn-position quad) (-> self basetrans quad))
+          (vector-copy! spawn-position (-> self basetrans))
           (set! (-> spawn-position y) (-> self money-pos-list i))
           (set! (-> self money-pos-actual i) (-> spawn-position y))
           (set! (-> self money-list i)

goal_src/jak1/engine/common-obs/plat-button.gc

@@ -331,7 +331,7 @@
   (logclear! (-> this mask) (process-mask actor-pause))
   (setup-skeleton! this)
   (logior! (-> this skel status) (janim-status inited))
-  (set! (-> this spawn-pos quad) (-> this root trans quad))
+  (vector-copy! (-> this spawn-pos) (-> this root trans))
   (set! (-> this path) (new 'process 'curve-control this 'path -1000000000.0))
   (logior! (-> this path flags) (path-control-flag display draw-line draw-point draw-text))
   (set! (-> this path-pos) 0.0)

goal_src/jak1/engine/common-obs/plat-eco.gc

@@ -108,7 +108,7 @@
                        (tracker-distance (vector-vector-distance (-> platform-prim world-sphere) (-> tracker-prim world-sphere))))
                   (when (rand-vu-percent? 0.5)
                     (let ((glow-position (new 'stack-no-clear 'vector)))
-                      (set! (-> glow-position quad) (-> platform-prim world-sphere quad))
+                      (vector-copy! glow-position (-> platform-prim world-sphere))
                       (dotimes (i 3)
                         (+! (-> glow-position data i) (rand-vu-float-range -5324.8 5324.8)))
                       (eco-blue-glow glow-position)))

goal_src/jak1/engine/common-obs/process-drawable-h.gc

@@ -112,6 +112,64 @@
 
 (define-extern process-entity-status! (function process entity-perm-status symbol int))
 
+#|
+Joint-animation recipe for creatures
+------------------------------------
+
+The `ja` helpers operate on `self`'s joint controller.  A channel has an animation group, an
+internal frame, a frame interpolation value, and a frame-number function.  Channel zero is the
+ordinary whole-creature animation; use another channel only when the creature's skeleton and art
+were authored for a layered animation.
+
+Choose the animation with `:group!`, and choose how its frame changes with `:num!`:
+
+  (+! speed)             advance once without wrapping
+  (-! speed)             run backward
+  (loop! speed)          advance and wrap at the end
+  (seek! frame speed)    approach a frame and stop there
+  (identity frame)       hold an exact frame
+  (chan source-channel)  follow another channel's frame
+  min / max              hold the first / last frame
+
+The speed defaults to 1.0.  `seek!` also defaults its target to the animation's last internal
+frame, so `(seek!)` is the usual one-shot.  `ja-aframe` converts an artist's timeline frame to the
+internal frame used by `seek!`; use it for authored contacts, anticipation poses, and handoffs.
+
+`ja` applies the requested changes and, when `:num!` selects a frame rule, evaluates the channel
+immediately.  Direct field changes such as `:group!`, `:num-func`, and `:frame-num` can be combined
+to prepare a pose without advancing it.  `ja-no-eval` also suppresses the evaluation attached to
+`:num!`; that is useful immediately before pushing a blend, or when the caller needs to evaluate
+the old stack explicitly with `ja-blend-eval`.
+
+`ja-play` is the standard blocking one-shot: it installs the group and frame rule without an
+initial evaluation, then suspends once per frame and advances until a seek reaches its target.
+Forms in its body run before each suspension, which is where a creature should steer, align root
+motion, or evaluate the channels underneath a blend.
+
+For a clean transition, call `ja-channel-push!` before selecting the new group.  It keeps the old
+pose below a new root group and fades it out over the supplied time.  During a hand-authored
+transition, call `ja-blend-eval` while the new animation plays so the retained pose stays current.
+Use `ja-group?` to select animation-specific handoffs rather than restarting a generic pose.
+
+Typical creature loops are:
+
+  ;; A looping locomotion cycle.
+  (ja-channel-push! 1 (seconds 0.15))
+  (ja :group! creature-run-ja :num! min)
+  (loop
+    (suspend)
+    (ja :num! (loop! run-speed)))
+
+  ;; A one-shot action with steering while it plays.
+  (ja-channel-push! 1 (seconds 0.1))
+  (ja-play :group! creature-attack-ja :num! (seek!) :frame-num 0.0
+    (turn-toward-target! self))
+
+Keep `:frame-num 0.0` on a newly selected one-shot unless the action deliberately joins at a
+specific authored pose.  A polished creature should blend into new groups, use artist frames for
+visual beats, and make its locomotion speed explicit so motion and animation remain in step.
+|#
+
 (defmacro ja-group (&key (chan 0))
   "Return self's frame group on chan, or #f when the channel is inactive.
    Channel zero is the base channel."

goal_src/jak1/engine/common-obs/process-drawable.gc

@@ -458,13 +458,13 @@
           (set! (-> control-data shadow) #f)
           (set! (-> control-data shadow-ctrl) #f)
           (set! (-> control-data data-format) (the-as uint 1))
-          (set! (-> control-data color-mult quad) (-> (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 1.0) quad))
-          (set! (-> control-data color-emissive quad) (-> (new 'static 'vector) quad))
+          (vector-copy! (-> control-data color-mult) (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 1.0))
+          (vector-copy! (-> control-data color-emissive) (new 'static 'vector))
           (set! (-> control-data level-index)
                 (the-as uint (-> (if (-> this entity) (-> this entity extra level) (-> *level* level-default)) index)))
           (set! (-> control-data longest-edge) (-> skeleton-group-data longest-edge))
           (set! (-> control-data ripple) #f))
-        (set! (-> control bounds quad) (-> skeleton-group-data bounds quad))
+        (vector-copy! (-> control bounds) (-> skeleton-group-data bounds))
         (let ((shadow-index (-> skeleton-group-data shadow)))
           (when (and (> shadow-index 0) (< shadow-index art-element-count))
             (let ((shadow-geometry (-> art-group-data data shadow-index))
@@ -897,8 +897,8 @@
         (spawn-position (new 'stack-no-clear 'vector)))
     (if (not spawn-entity) (set! spawn-entity (-> self entity)))
     (if position
-      (set! (-> spawn-position quad) (-> position quad))
-      (set! (-> spawn-position quad) (-> spawn-entity extra trans quad)))
+      (vector-copy! spawn-position position)
+      (vector-copy! spawn-position (-> spawn-entity extra trans)))
     (let ((task (-> spawn-entity extra perm task))
           (pickup-options (new 'static 'fact-info)))
       (set! (-> pickup-options options) (fact-options))

goal_src/jak1/engine/common-obs/process-taskable.gc

@@ -56,7 +56,7 @@
         (set-width! message-font (- 512 (-> this x-position)))
         (set-height! message-font 40)
         (set-scale! message-font 0.9)
-        (set! (-> message-font flags) (font-flags shadow kerning middle-vert large))
+        (set-flags! message-font (font-flags shadow kerning middle-vert large))
         (print-game-text (-> this message) message-font #f 128 22)))
     ;; og:preserve-this PAL patch here
     (cond
@@ -74,7 +74,7 @@
                                    (font-flags shadow kerning))))
            (let ((v1-15 response-font)) (set! (-> v1-15 width) (the float 400)))
            (let ((v1-16 response-font)) (set! (-> v1-16 height) (the float 100)))
-           (set! (-> response-font flags) (font-flags shadow kerning large))
+           (set-flags! response-font (font-flags shadow kerning large))
            (print-game-text *temp-string* response-font #f 128 22))))
       (else
        (let ((response-font (new 'stack
@@ -87,7 +87,7 @@
                                  (font-flags shadow kerning))))
          (let ((v1-22 response-font)) (set! (-> v1-22 width) (the float 400)))
          (let ((v1-23 response-font)) (set! (-> v1-23 height) (the float 100)))
-         (set! (-> response-font flags) (font-flags shadow kerning large))
+         (set-flags! response-font (font-flags shadow kerning large))
          (print-game-text (lookup-text! *common-text* (text-id confirm) #f) response-font #f 128 22))))
     (cond
       ((!= (-> this decision) 'undecided))
@@ -554,7 +554,7 @@
       (logclear! (-> self skel status) (janim-status blerc spool))
       (logior! (-> self mask) (process-mask actor-pause))
       (let ((entity-transform (-> self entity extra trans)))
-        (if entity-transform (set! (-> self root trans quad) (-> entity-transform quad))))
+        (if entity-transform (vector-copy! (-> self root trans) entity-transform)))
       (ja-channel-set! 0))
   :trans
     (behavior ()
@@ -643,7 +643,7 @@
                   (set-width! gp-1 440)
                   (set-height! gp-1 60)
                   (set-scale! gp-1 0.9)
-                  (set! (-> gp-1 flags) (font-flags shadow kerning middle-vert large))
+                  (set-flags! gp-1 (font-flags shadow kerning middle-vert large))
                   (print-game-text (lookup-text! *common-text* (-> self talk-message) #f) gp-1 #f 128 22))
                 (when (and (cpad-pressed? 0 circle) (process-grab? *target*))
                   (logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons circle))
@@ -837,7 +837,7 @@
           (when (not parent)
             (format #t "ERROR<GMJ>: othercam parent invalid~%")
             (deactivate self))
-          (set! (-> *camera-other-root* quad) (-> (the-as process-taskable parent) root trans quad))
+          (vector-copy! *camera-other-root* (-> (the-as process-taskable parent) root trans))
           (let ((joint-transform (-> (the-as process-taskable parent) node-list data (-> self cam-joint-index) bone transform))
                 (joint-scale (-> (the-as process-taskable parent) node-list data (-> self cam-joint-index) bone scale))
                 (camera-forward (new 'stack-no-clear 'vector))
@@ -848,10 +848,10 @@
             (when frame-ready?
               (when (not (-> self had-valid-frame))
                 (set! (-> self had-valid-frame) #t)
-                (set! (-> self old-pos quad) (-> camera-position quad))
-                (set! (-> self old-mat-z quad) (-> camera-forward quad)))
+                (vector-copy! (-> self old-pos) camera-position)
+                (vector-copy! (-> self old-mat-z) camera-forward))
               (when #t
-                (set! (-> *camera-other-trans* quad) (-> camera-position quad))
+                (vector-copy! *camera-other-trans* camera-position)
                 (vector-normalize-copy! (-> *camera-other-matrix* vector 0) (-> joint-transform vector 0) -1.0)
                 (set! (-> *camera-other-matrix* vector 0 w) 0.0)
                 (vector-normalize-copy! (-> *camera-other-matrix* vector 1) (-> joint-transform vector 1) 1.0)
@@ -861,8 +861,8 @@
                 (vector-reset! (-> *camera-other-matrix* vector 3))
                 (othercam-calc (-> joint-scale x)))
               (set! *camera-look-through-other* 2)
-              (set! (-> self old-pos quad) (-> camera-position quad))
-              (set! (-> self old-mat-z quad) (-> camera-forward quad)))))
+              (vector-copy! (-> self old-pos) camera-position)
+              (vector-copy! (-> self old-mat-z) camera-forward))))
         (suspend)
         (let ((parent (-> self hand process 0)))
           (when (or (-> self die?) (and (not (-> self survive-anim-end?)) (ja-anim-done? parent)))

goal_src/jak1/engine/common-obs/rigid-body.gc

@@ -11,15 +11,15 @@
 
 (defmethod clear-force-torque! ((this rigid-body))
   "Clear the accumulated world-space force and torque for the next simulation step."
-  (set! (-> this force quad) (-> *null-vector* quad))
-  (set! (-> this torque quad) (-> *null-vector* quad))
+  (vector-copy! (-> this force) *null-vector*)
+  (vector-copy! (-> this torque) *null-vector*)
   0
   (none))
 
 (defmethod clear-momentum! ((this rigid-body))
   "Clear both linear and angular momentum."
-  (set! (-> this lin-momentum quad) (-> *null-vector* quad))
-  (set! (-> this ang-momentum quad) (-> *null-vector* quad))
+  (vector-copy! (-> this lin-momentum) *null-vector*)
+  (vector-copy! (-> this ang-momentum) *null-vector*)
   0
   (none))
 
@@ -43,8 +43,8 @@
   (set! (-> this lin-momentum-damping-factor) linear-damping)
   (set! (-> this ang-momentum-damping-factor) angular-damping)
   (update-matrix! this)
-  (set! (-> this lin-velocity quad) (-> *null-vector* quad))
-  (set! (-> this ang-velocity quad) (-> *null-vector* quad))
+  (vector-copy! (-> this lin-velocity) *null-vector*)
+  (vector-copy! (-> this ang-velocity) *null-vector*)
   (set! (-> this inv-i-world vector 0 quad) (the-as uint128 0))
   (set! (-> this inv-i-world vector 1 quad) (the-as uint128 0))
   (set! (-> this inv-i-world vector 2 quad) (the-as uint128 0))
@@ -367,10 +367,10 @@
   "Detect riders, sample player velocity, accumulate elapsed game time, and run fixed physics
    steps until less than half a step remains. Clear the per-frame contact marker afterward."
   (if (-> this info platform) (detect-riders! (-> this root-overlay)))
-  (set! (-> this player-velocity-prev quad) (-> this player-velocity quad))
+  (vector-copy! (-> this player-velocity-prev) (-> this player-velocity))
   (if *target*
-    (set! (-> this player-velocity quad) (-> *target* control transv quad))
-    (set! (-> this player-velocity quad) (-> *null-vector* quad)))
+    (vector-copy! (-> this player-velocity) (-> *target* control transv))
+    (vector-copy! (-> this player-velocity) *null-vector*))
   (+! (-> this sim-time-remaining) (* 0.0033333334 (the float (- (current-time) (-> *display* old-base-frame-counter)))))
   (let ((fixed-step (* DISPLAY_FPS_RATIO 0.016666668)) ;; og:preserve-this changed for high fps
         (simulation-time (* 0.0033333334 (the float (logand #xffffff (current-time))))))
@@ -394,7 +394,7 @@
               (bonk-drawable (if (and (nonzero? bonk-source) (type-type? (-> bonk-source type) process-drawable)) bonk-source)))
          (when bonk-drawable
            (set! (-> self player-impulse) #t)
-           (set! (-> self player-force-position quad) (-> (the-as process-drawable bonk-drawable) root trans quad))
+           (vector-copy! (-> self player-force-position) (-> (the-as process-drawable bonk-drawable) root trans))
            (let ((bonk-force (fmin (* 0.00012207031 (the-as float (-> block param 1)) (-> self info player-bonk-factor) (-> self info player-weight))
                                    (-> self info player-force-clamp))))
              (vector-float*! (-> self player-force) *y-vector* (- bonk-force)))))))
@@ -410,7 +410,7 @@
                      (flop-drawable (if (and (nonzero? flop-source) (type-type? (-> flop-source type) process-drawable)) flop-source)))
                 (when flop-drawable
                   (set! (-> self player-impulse) #t)
-                  (set! (-> self player-force-position quad) (-> (the-as process-drawable flop-drawable) root trans quad))
+                  (vector-copy! (-> self player-force-position) (-> (the-as process-drawable flop-drawable) root trans))
                   (let ((flop-force (fmin (* 16.0 (-> self info player-weight) (-> self info player-dive-factor)) (-> self info player-force-clamp))))
                     (vector-float*! (-> self player-force) *y-vector* (- flop-force)))))))
            ((= (-> block param 1) 'explode)
@@ -418,7 +418,7 @@
                    (explosion-drawable (if (and (nonzero? explosion-source) (type-type? (-> explosion-source type) process-drawable)) explosion-source)))
               (when explosion-drawable
                 (set! (-> self player-impulse) #t)
-                (set! (-> self player-force-position quad) (-> (the-as process-drawable explosion-drawable) root trans quad))
+                (vector-copy! (-> self player-force-position) (-> (the-as process-drawable explosion-drawable) root trans))
                 (vector-! (-> self player-force) (-> self rbody position) (-> (the-as process-drawable explosion-drawable) root trans))
                 (vector-normalize! (-> self player-force) (-> self info explosion-force)))))
            (else (the-as vector #f))))))
@@ -426,15 +426,15 @@
      (let ((impulse-source source))
        (when (if (and (nonzero? impulse-source) (type-type? (-> impulse-source type) process-drawable)) impulse-source)
          (set! (-> self player-impulse) #t)
-         (set! (-> self player-force-position quad) (-> self rbody position quad))
+         (vector-copy! (-> self player-force-position) (-> self rbody position))
          (let ((force-vector (-> self player-force)))
-           (set! (-> force-vector quad) (-> (the-as vector (-> block param 0)) quad))
+           (vector-copy! force-vector (the-as vector (-> block param 0)))
            force-vector))))
     (('edge-grabbed)
      (let ((edge-grab-data (-> block param 0)))
        (when (not (-> self player-impulse))
          (set! (-> self player-contact) #t)
-         (set! (-> self player-force-position quad) (-> (the-as vector (+ edge-grab-data 32)) quad))
+         (vector-copy! (-> self player-force-position) (the-as vector (+ edge-grab-data 32)))
          (vector-float*! (-> self player-force) *y-vector* (* -1.0 (-> self info player-weight))))))
     (('ridden)
      (let ((rider-handle-reference (the-as object (-> block param 0))))
@@ -443,8 +443,8 @@
            (when (and rider-process (= rider-process *target*) (!= (-> *target* control mod-surface mode) 'swim))
              (when (not (-> self player-impulse))
                (set! (-> self player-contact) #t)
-               (set! (-> self player-force-position quad) (-> (the-as process-drawable rider-process) root trans quad))
-               (set! (-> self player-force quad) (-> *null-vector* quad))
+               (vector-copy! (-> self player-force-position) (-> (the-as process-drawable rider-process) root trans))
+               (vector-copy! (-> self player-force) *null-vector*)
                (vector+*! (-> self player-force) (-> self player-force) *y-vector* (* -1.0 (-> self info player-weight)))))))))))
 
 (defbehavior rigid-body-platform-post rigid-body-platform ()
@@ -515,9 +515,9 @@
   (set! (-> this player-impulse) #f)
   (set! (-> this player-contact) #f)
   (set-time! (-> this player-bonk-timeout))
-  (set! (-> this player-force quad) (-> *null-vector* quad))
-  (set! (-> this player-velocity quad) (-> *null-vector* quad))
-  (set! (-> this player-velocity-prev quad) (-> *null-vector* quad))
+  (vector-copy! (-> this player-force) *null-vector*)
+  (vector-copy! (-> this player-velocity) *null-vector*)
+  (vector-copy! (-> this player-velocity-prev) *null-vector*)
   (set! (-> this water-anim) (the-as water-anim (entity-actor-lookup (-> this entity) 'water-actor 0)))
   0
   (none))

goal_src/jak1/engine/common-obs/ropebridge.gc

@@ -642,7 +642,7 @@
   "Clear the per-step external force on every spring point."
   (let ((spring-point (the-as ropebridge-spring-point (-> this spring-point))))
     (countdown (i (-> this tuning num-spring-points))
-      (set! (-> spring-point extra-force quad) (the-as uint128 0))
+      (vector-zero! (-> spring-point extra-force))
       (nop!)
       (nop!)
       (&+! spring-point 48)))

goal_src/jak1/engine/common-obs/sharkey.gc

@@ -125,7 +125,7 @@ nav-enemy-default-event-handler
     (let ((current-y (-> this collide-info trans y)))
       (when (or (and (< water-height current-y) (>= water-height (-> this last-y)))
                 (and (>= water-height current-y) (< water-height (-> this last-y))))
-        (set! (-> splash-position quad) (-> this collide-info trans quad))
+        (vector-copy! splash-position (-> this collide-info trans))
         (set! (-> splash-position y) water-height)
         (create-splash (-> this water) 1.0 splash-position 1 (-> this collide-info transv)))
       (set! (-> this last-y) current-y)))
@@ -143,13 +143,13 @@ nav-enemy-default-event-handler
 
 (defun sharkey-get-player-position ((destination vector))
   "Copy the player target point at joint slot 5 into destination."
-  (set! (-> destination quad) (-> (target-pos 5) quad))
+  (vector-copy! destination (target-pos 5))
   0
   (none))
 
 (defbehavior sharkey-reset-position sharkey ()
   "Restore the Sharkey's position from its entity transform."
-  (set! (-> self collide-info trans quad) (-> self entity extra trans quad))
+  (vector-copy! (-> self collide-info trans) (-> self entity extra trans))
   0
   (none))
 
@@ -163,21 +163,21 @@ nav-enemy-default-event-handler
         (desired-spawn-position (new 'stack-no-clear 'vector)))
     (let ((player-position (-> *target* control trans)))
       (let ((best-distance 4096000.0))
-        (set! (-> candidate-position quad) (-> self entity extra trans quad))
-        (set! (-> closest-path-position quad) (-> self collide-info trans quad))
+        (vector-copy! candidate-position (-> self entity extra trans))
+        (vector-copy! closest-path-position (-> self collide-info trans))
         (dotimes (i (-> self path curve num-cverts))
           (eval-path-curve-div! (-> self path) candidate-position (the float i) 'interp)
           (let ((candidate-distance (vector-vector-xz-distance player-position candidate-position)))
             (when (< candidate-distance best-distance)
               (set! best-distance candidate-distance)
-              (set! (-> closest-path-position quad) (-> candidate-position quad))))))
+              (vector-copy! closest-path-position candidate-position)))))
       (vector-! (-> self dir) player-position closest-path-position)
       (vector-normalize! (-> self dir) 1.0)
       (vector+*! desired-spawn-position player-position (-> self dir) (- (-> self spawn-distance))))
     (project-onto-nav-mesh (-> self nav) desired-spawn-position desired-spawn-position)
     (set! (-> desired-spawn-position y) (-> self y-min))
-    (set! (-> self spawn-point quad) (-> desired-spawn-position quad)))
-  (set! (-> self collide-info trans quad) (-> self spawn-point quad))
+    (vector-copy! (-> self spawn-point) desired-spawn-position))
+  (vector-copy! (-> self collide-info trans) (-> self spawn-point))
   (forward-up->quaternion (-> self collide-info quat) (-> self dir) *up-vector*)
   (set! (-> self momentum-speed) 0.0))
 
@@ -284,7 +284,7 @@ nav-enemy-default-event-handler
         (current-time)
         (sound-play "bigshark-bite")
         (set-time! (-> self state-time))
-        (set! (-> attack-start-position quad) (-> self collide-info trans quad))
+        (vector-copy! attack-start-position (-> self collide-info trans))
         (ja-channel-push! 1 (seconds 0.1))
         (ja-play :group!
                  sharkey-chomp-ja
@@ -515,7 +515,7 @@ nav-enemy-default-event-handler
   (set! (-> this water flags) (water-flag active part-rings part-water))
   (set! (-> this water height) (res-lump-float (-> this entity) 'water-height))
   (set! (-> this water ripple-size) 20480.0)
-  (set! (-> this spawn-point quad) (-> this collide-info trans quad))
+  (vector-copy! (-> this spawn-point) (-> this collide-info trans))
   (set! (-> this collide-info nav-radius) 8192.0)
   (set! (-> this nav nearest-y-threshold) 4096000.0)
   (set! (-> this y-max) (- (-> this water height) (* 2048.0 (-> this scale))))

goal_src/jak1/engine/common-obs/voicebox.gc

@@ -45,8 +45,8 @@
    the model from full size to zero as it enters the backpack."
   (let ((camera-position (new 'stack-no-clear 'vector))
         (target-position (new 'stack-no-clear 'vector)))
-    (set! (-> camera-position quad) (-> self parent-override 0 trans quad))
-    (set! (-> target-position quad) (-> (target-pos (joint-node-index eichar-lod0-jg packStrapMid)) quad))
+    (vector-copy! camera-position (-> self parent-override 0 trans))
+    (vector-copy! target-position (target-pos (joint-node-index eichar-lod0-jg packStrapMid)))
     (when *target*
       (let ((target-forward (vector-z-quaternion! (new-stack-vector0) (-> *target* control quat-for-control))))
         ;; The offset vanishes at both endpoints: blend ignores the target position at zero, and the
@@ -166,8 +166,8 @@
    speaker skeleton with blend at the target-side endpoint, and enter the appearance state."
   (set! (-> self root) (new 'process 'trsqv))
   (set! (-> self hint) hint)
-  (set! (-> self root trans quad) (-> position quad))
-  (set! (-> self base-trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
+  (vector-copy! (-> self base-trans) position)
   (initialize-skeleton self *voicebox-sg* '())
   (set! (-> self blend) 1.0)
   (go-virtual enter)

goal_src/jak1/engine/common-obs/water-anim.gc

@@ -584,7 +584,7 @@
     (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
       (case message
         (('move-to)
-         (set! (-> self root trans quad) (-> (the-as vector (-> block param 0)) quad))
+         (vector-copy! (-> self root trans) (the-as vector (-> block param 0)))
          (set! (-> self water-height) (-> self root trans y))
          (if (nonzero? (-> self sound)) (update-trans! (-> self sound) (-> self root trans)))
          (let ((updated-mask (logclear (-> self mask) (process-mask sleep-code))))

goal_src/jak1/engine/common-obs/water.gc

@@ -594,11 +594,11 @@
         ((begin
            ;; Track the root and selected top joint, retaining last frame's positions for surface
            ;; crossings.
-           (set! (-> this top 1 quad) (-> this top 0 quad))
+           (vector-copy! (-> this top 1) (-> this top 0))
            (vector<-cspace! (-> this top 0) (-> this process node-list data (-> this joint-index)))
            (+! (-> this top 0 y) (-> this top-y-offset))
-           (set! (-> this bottom 1 quad) (-> this bottom 0 quad))
-           (set! (-> this bottom 0 quad) (-> this process root trans quad))
+           (vector-copy! (-> this bottom 1) (-> this bottom 0))
+           (vector-copy! (-> this bottom 0) (-> this process root trans))
            (logclear! (-> this flag) (water-flag wading swimming under-water head-under-water bouncing))
            (set! (-> this bob-offset) (update! (-> this bob)))
            ;; Keep the raw sample for particles, but smooth the classification surface while the
@@ -619,7 +619,7 @@
                   (set! (-> this ocean-offset) (lerp (-> this ocean-offset) (-> this real-ocean-offset) 0.2)))
                 ;; TODO: ripple-position is prepared here but not consumed.
                 (let ((ripple-position (new 'stack-no-clear 'vector)))
-                  (set! (-> ripple-position quad) (-> this bottom 0 quad))
+                  (vector-copy! ripple-position (-> this bottom 0))
                   (set! (-> ripple-position y) ripple-height))))
              (else (set! (-> this real-ocean-offset) 0.0) (set! (-> this ocean-offset) 0.0)))
            (if (logtest? (-> (the-as collide-shape-moving (-> this process root)) root-prim prim-core action) (collide-action racer))
@@ -639,7 +639,7 @@
          (cond
            ((>= (-> this top 0 y) (-> this height))
             (let ((surface-position (new 'stack-no-clear 'vector)))
-              (set! (-> surface-position quad) (-> this bottom 0 quad))
+              (vector-copy! surface-position (-> this bottom 0))
               (vector-xz-length (-> this process root transv))
               (set! (-> surface-position y) (-> this surface-height))
               (when (and (logtest? (-> this process draw status) (draw-status was-drawn))
@@ -708,7 +708,7 @@
                         (logtest? (-> (the-as collide-shape-moving (-> this process root)) status) (collide-status touch-surface))
                         (not (logtest? (water-flag jump-out) (-> this flag))))
                    (let ((float-position (new 'stack-no-clear 'vector)))
-                     (set! (-> float-position quad) (-> this bottom 0 quad))
+                     (vector-copy! float-position (-> this bottom 0))
                      (set! (-> float-position y) (- (-> this height) (-> this swim-height)))
                      (let ((floating-shape (-> this process root)))
                        (when (and (not (logtest? (-> (the-as collide-shape-moving floating-shape) status) (collide-status touch-background)))
@@ -738,7 +738,7 @@
                       (and (< swim-line-y (-> this bottom 0 y)) (logtest? old-flags (water-flag under-water))))
              (logior! (-> this flag) (water-flag swimming))
              (let ((snap-position (new 'stack-no-clear 'vector)))
-               (set! (-> snap-position quad) (-> this bottom 0 quad))
+               (vector-copy! snap-position (-> this bottom 0))
                (let ((surfacing-shape (-> this process root)))
                  (set! (-> snap-position y) swim-line-y)
                  (when (not (logtest? (-> (the-as collide-shape-moving surfacing-shape) root-prim prim-core action) (collide-action racer)))
@@ -806,7 +806,7 @@
            (when (and (< (- (-> candidate-position y) (-> this process root trans y)) (-> this drip-height))
                       (< (-> this height) (-> candidate-position y)))
              (set! (-> this drip-joint-index) candidate-joint-index)
-             (set! (-> this drip-old-pos quad) (-> candidate-position quad))
+             (vector-copy! (-> this drip-old-pos) candidate-position)
              (logior! (-> this flag) (water-flag spawn-drip)))))))
     0
     (none)))

goal_src/jak1/engine/debug/anim-tester.gc

@@ -231,24 +231,12 @@
         (if (< (-> *DISP_LIST-bank* MAX_LINES) (-> ctrl numlines)) (-> *DISP_LIST-bank* MAX_LINES) (-> ctrl numlines)))
   ;; result unused
   (if (> (-> ctrl lines-to-disp) 0) (-> ctrl lines-to-disp) 1)
-  (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-         (packet-start (-> dma-buff base)))
-    (draw-sprite2d-xy dma-buff
-                      (-> ctrl left)
-                      (-> ctrl top)
-                      (+ (* (-> ctrl charswide) (-> *DISP_LIST-bank* CHAR_WIDTH)) (* (-> *DISP_LIST-bank* BORDER_WIDTH) 2))
-                      (+ (* (+ (-> ctrl lines-to-disp) 1) (-> *DISP_LIST-bank* TV_SPACING)) (* (-> *DISP_LIST-bank* BORDER_WIDTH) 2))
-                      (new 'static 'rgba :a #x40))
-    (let ((packet-end (-> dma-buff base)))
-      (let ((packet (the-as dma-packet (-> dma-buff base))))
-        (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-        (set! (-> packet vif0) (new 'static 'vif-tag))
-        (set! (-> packet vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id debug)
-                             packet-start
-                             (the-as (pointer dma-tag) packet-end))))
+  (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-sprite2d-xy dma-buff
+                        (-> ctrl left)
+                        (-> ctrl top)
+                        (+ (* (-> ctrl charswide) (-> *DISP_LIST-bank* CHAR_WIDTH)) (* (-> *DISP_LIST-bank* BORDER_WIDTH) 2))
+                        (+ (* (+ (-> ctrl lines-to-disp) 1) (-> *DISP_LIST-bank* TV_SPACING)) (* (-> *DISP_LIST-bank* BORDER_WIDTH) 2))
+                        (new 'static 'rgba :a #x40)))
   (set! (-> ctrl xpos) (+ (-> ctrl left) (-> *DISP_LIST-bank* BORDER_WIDTH)))
   (set! (-> ctrl ypos) (+ (-> ctrl top) (-> *DISP_LIST-bank* BORDER_HEIGHT)))
   ((-> ctrl listfunc) (list-control-cmd draw-title) ctrl)
@@ -312,24 +300,12 @@
        (+! (-> ctrl the-index) 1)
        (let ((node (-> ctrl the-node))) "return the next node in the list" (set! (-> ctrl the-node) (-> node next)))))
     (else
-     (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-            (packet-start (-> dma-buff base)))
-       (draw-string-xy "**NONE**"
-                       dma-buff
-                       (+ (-> ctrl left) (-> *DISP_LIST-bank* BORDER_WIDTH))
-                       (+ (-> ctrl top) (-> *DISP_LIST-bank* BORDER_HEIGHT) (-> *DISP_LIST-bank* TV_SPACING))
-                       (font-color menu)
-                       (font-flags shadow kerning))
-       (let ((packet-end (-> dma-buff base)))
-         (let ((packet (the-as dma-packet (-> dma-buff base))))
-           (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-           (set! (-> packet vif0) (new 'static 'vif-tag))
-           (set! (-> packet vif1) (new 'static 'vif-tag))
-           (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-         (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                (bucket-id debug)
-                                packet-start
-                                (the-as (pointer dma-tag) packet-end))))))
+     (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "**NONE**"
+                            dma-buff
+                            (+ (-> ctrl left) (-> *DISP_LIST-bank* BORDER_WIDTH))
+                            (+ (-> ctrl top) (-> *DISP_LIST-bank* BORDER_HEIGHT) (-> *DISP_LIST-bank* TV_SPACING))
+                            (font-color menu)
+                            (font-flags shadow kerning)))))
   (none))
 
 ;; Where each of the four lists sits, and how narrow it is allowed to get. X, Y
@@ -694,27 +670,15 @@
   ;; this function does not work
   (return (the pointer #f))
   (local-vars (fmt-func (function _varargs_ object)))
-  (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-         (packet-start (-> dma-buff base)))
-    (cond
-      ((= frame -1.0)
-       (let ((draw-adv draw-string-adv)) (format (clear *temp-string*) "~Smin" prefix) (draw-adv *temp-string* dma-buff ctx)))
-      ((= frame -2.0)
-       (let ((draw-adv draw-string-adv)) (format (clear *temp-string*) "~Smax" prefix) (draw-adv *temp-string* dma-buff ctx)))
-      (else
-       (let ((draw-adv draw-string-adv))
-         (format (clear *temp-string*) "~S~3,,0f" prefix (+ frame artist-base))
-         (draw-adv *temp-string* dma-buff ctx))))
-    (let ((packet-end (-> dma-buff base)))
-      (let ((packet (the-as dma-packet (-> dma-buff base))))
-        (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-        (set! (-> packet vif0) (new 'static 'vif-tag))
-        (set! (-> packet vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id debug)
-                             packet-start
-                             (the-as (pointer dma-tag) packet-end)))))
+  (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (cond
+        ((= frame -1.0)
+         (let ((draw-adv draw-string-adv)) (format (clear *temp-string*) "~Smin" prefix) (draw-adv *temp-string* dma-buff ctx)))
+        ((= frame -2.0)
+         (let ((draw-adv draw-string-adv)) (format (clear *temp-string*) "~Smax" prefix) (draw-adv *temp-string* dma-buff ctx)))
+        (else
+         (let ((draw-adv draw-string-adv))
+           (format (clear *temp-string*) "~S~3,,0f" prefix (+ frame artist-base))
+           (draw-adv *temp-string* dma-buff ctx))))))
 
 (defbehavior anim-tester-standard-event-handler anim-tester ((proc process) (argc int) (message symbol) (block event-message-block))
   "Handle the debug menu's requests.
@@ -753,30 +717,18 @@
     (cond
       ;; (list-control-cmd draw-line)
       ((zero? op)
-       (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-              (packet-start (-> dma-buff base)))
-         (let ((draw-xy draw-string-xy))
-           (format (clear *temp-string*)
-                   "~S~S~S"
-                   (if (= (-> ctrl the-index) (-> ctrl highlight-index)) ">" " ")
-                   (if (logtest? (-> obj flags) (anim-test-obj-flags edited)) "*" " ")
-                   (-> obj privname))
-           (draw-xy *temp-string*
-                    dma-buff
-                    (-> ctrl xpos)
-                    (-> ctrl ypos)
-                    (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
-                    (font-flags shadow kerning)))
-         (let ((packet-end (-> dma-buff base)))
-           (let ((packet (the-as dma-packet (-> dma-buff base))))
-             (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-             (set! (-> packet vif0) (new 'static 'vif-tag))
-             (set! (-> packet vif1) (new 'static 'vif-tag))
-             (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-           (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                  (bucket-id debug)
-                                  packet-start
-                                  (the-as (pointer dma-tag) packet-end)))))
+       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
+                  (format (clear *temp-string*)
+                          "~S~S~S"
+                          (if (= (-> ctrl the-index) (-> ctrl highlight-index)) ">" " ")
+                          (if (logtest? (-> obj flags) (anim-test-obj-flags edited)) "*" " ")
+                          (-> obj privname))
+                  (draw-xy *temp-string*
+                           dma-buff
+                           (-> ctrl xpos)
+                           (-> ctrl ypos)
+                           (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
+                           (font-flags shadow kerning)))))
       ((= op (list-control-cmd visible?)) (return #t))
       ((= op (list-control-cmd input))
        (cond
@@ -805,24 +757,12 @@
                  (else (-> *ANIM_TESTER-bank* OBJECT_LIST_MIN_WIDTH))))
          (set! (-> ctrl return-int) width)))
       ((= op (list-control-cmd draw-title))
-       (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-              (packet-start (-> dma-buff base)))
-         (draw-string-xy "----pick-object---"
-                         dma-buff
-                         (-> ctrl xpos)
-                         (-> ctrl ypos)
-                         (font-color menu)
-                         (font-flags shadow kerning))
-         (let ((packet-end (-> dma-buff base)))
-           (let ((packet (the-as dma-packet (-> dma-buff base))))
-             (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-             (set! (-> packet vif0) (new 'static 'vif-tag))
-             (set! (-> packet vif1) (new 'static 'vif-tag))
-             (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-           (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                  (bucket-id debug)
-                                  packet-start
-                                  (the-as (pointer dma-tag) packet-end)))))))
+       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "----pick-object---"
+                                dma-buff
+                                (-> ctrl xpos)
+                                (-> ctrl ypos)
+                                (font-color menu)
+                                (font-flags shadow kerning))))))
   #f)
 
 (defun anim-test-anim-list-handler ((cmd list-control-cmd) (ctrl list-control))
@@ -836,26 +776,14 @@
     (cond
       ;; (list-control-cmd draw-line)
       ((zero? cmd)
-       (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-              (packet-start (-> dma-buff base)))
-         (let ((draw-xy draw-string-xy))
-           (format (clear *temp-string*) "~S~S" (if (= (-> ctrl the-index) (-> ctrl highlight-index)) "> " "  ") (-> seq privname))
-           (draw-xy *temp-string*
-                    dma-buff
-                    (-> ctrl xpos)
-                    (-> ctrl ypos)
-                    (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
-                    (font-flags shadow kerning)))
-         (let ((packet-end (-> dma-buff base)))
-           (let ((packet (the-as dma-packet (-> dma-buff base))))
-             (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-             (set! (-> packet vif0) (new 'static 'vif-tag))
-             (set! (-> packet vif1) (new 'static 'vif-tag))
-             (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-           (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                  (bucket-id debug)
-                                  packet-start
-                                  (the-as (pointer dma-tag) packet-end)))))
+       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
+                  (format (clear *temp-string*) "~S~S" (if (= (-> ctrl the-index) (-> ctrl highlight-index)) "> " "  ") (-> seq privname))
+                  (draw-xy *temp-string*
+                           dma-buff
+                           (-> ctrl xpos)
+                           (-> ctrl ypos)
+                           (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
+                           (font-flags shadow kerning)))))
       ((= cmd (list-control-cmd visible?)) (return (not (logtest? (-> seq flags) (anim-test-seq-flags sequence)))))
       ((= cmd (list-control-cmd input))
        (cond
@@ -910,24 +838,12 @@
                  (else (-> *ANIM_TESTER-bank* ANIM_LIST_MIN_WIDTH))))
          (set! (-> ctrl return-int) width)))
       ((= cmd (list-control-cmd draw-title))
-       (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-              (packet-start (-> dma-buff base)))
-         (draw-string-xy "----pick-joint-anim----"
-                         dma-buff
-                         (-> ctrl xpos)
-                         (-> ctrl ypos)
-                         (font-color menu)
-                         (font-flags shadow kerning))
-         (let ((packet-end (-> dma-buff base)))
-           (let ((packet (the-as dma-packet (-> dma-buff base))))
-             (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-             (set! (-> packet vif0) (new 'static 'vif-tag))
-             (set! (-> packet vif1) (new 'static 'vif-tag))
-             (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-           (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                  (bucket-id debug)
-                                  packet-start
-                                  (the-as (pointer dma-tag) packet-end)))))))
+       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "----pick-joint-anim----"
+                                dma-buff
+                                (-> ctrl xpos)
+                                (-> ctrl ypos)
+                                (font-color menu)
+                                (font-flags shadow kerning))))))
   #f)
 
 (defun anim-test-sequence-list-handler ((cmd list-control-cmd) (ctrl list-control))
@@ -939,30 +855,18 @@
     (cond
       ;; (list-control-cmd draw-line)
       ((zero? cmd)
-       (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-              (packet-start (-> dma-buff base)))
-         (let ((draw-xy draw-string-xy))
-           (format (clear *temp-string*)
-                   "~S~S~S"
-                   (if (= (-> ctrl the-index) (-> ctrl highlight-index)) ">" " ")
-                   (if (logtest? (-> seq flags) (anim-test-seq-flags from-file)) "*" " ")
-                   (-> seq privname))
-           (draw-xy *temp-string*
-                    dma-buff
-                    (-> ctrl xpos)
-                    (-> ctrl ypos)
-                    (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
-                    (font-flags shadow kerning)))
-         (let ((packet-end (-> dma-buff base)))
-           (let ((packet (the-as dma-packet (-> dma-buff base))))
-             (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-             (set! (-> packet vif0) (new 'static 'vif-tag))
-             (set! (-> packet vif1) (new 'static 'vif-tag))
-             (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-           (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                  (bucket-id debug)
-                                  packet-start
-                                  (the-as (pointer dma-tag) packet-end)))))
+       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
+                  (format (clear *temp-string*)
+                          "~S~S~S"
+                          (if (= (-> ctrl the-index) (-> ctrl highlight-index)) ">" " ")
+                          (if (logtest? (-> seq flags) (anim-test-seq-flags from-file)) "*" " ")
+                          (-> seq privname))
+                  (draw-xy *temp-string*
+                           dma-buff
+                           (-> ctrl xpos)
+                           (-> ctrl ypos)
+                           (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
+                           (font-flags shadow kerning)))))
       ((= cmd (list-control-cmd visible?)) (return (logtest? (-> seq flags) (anim-test-seq-flags sequence))))
       ((= cmd (list-control-cmd input))
        (cond
@@ -1014,24 +918,12 @@
                  (else (-> *ANIM_TESTER-bank* PICK_LIST_MIN_WIDTH))))
          (set! (-> ctrl return-int) width)))
       ((= cmd (list-control-cmd draw-title))
-       (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-              (packet-start (-> dma-buff base)))
-         (draw-string-xy "----pick-sequence---"
-                         dma-buff
-                         (-> ctrl xpos)
-                         (-> ctrl ypos)
-                         (font-color menu)
-                         (font-flags shadow kerning))
-         (let ((packet-end (-> dma-buff base)))
-           (let ((packet (the-as dma-packet (-> dma-buff base))))
-             (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-             (set! (-> packet vif0) (new 'static 'vif-tag))
-             (set! (-> packet vif1) (new 'static 'vif-tag))
-             (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-           (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                  (bucket-id debug)
-                                  packet-start
-                                  (the-as (pointer dma-tag) packet-end)))))))
+       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "----pick-sequence---"
+                                dma-buff
+                                (-> ctrl xpos)
+                                (-> ctrl ypos)
+                                (font-color menu)
+                                (font-flags shadow kerning))))))
   #f)
 
 ;; Where each editor column starts and how wide it is, in characters. The first
@@ -1165,86 +1057,60 @@
                                         (bucket-id debug)
                                         packet-start
                                         (the-as (pointer dma-tag) packet-end))))))
-         (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-                (packet-start (-> dma-buff base)))
-           (let ((draw-xy draw-string-xy))
-             (let ((fmt format))
-               (fmt (clear *temp-string*)
-                    "~S~S~-27S"
-                    (if (= (-> ctrl the-index) (-> ctrl highlight-index)) ">" " ")
-                    (if (= (-> ctrl the-index) (-> seq playing-item)) "*" " ")
-                    (-> item privname)))
-             (draw-xy *temp-string*
-                      dma-buff
-                      (-> ctrl xpos)
-                      (-> ctrl ypos)
-                      (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
-                      (font-flags shadow kerning)))
-           (let ((packet-end (-> dma-buff base)))
-             (let ((packet (the-as dma-packet (-> dma-buff base))))
-               (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-               (set! (-> packet vif0) (new 'static 'vif-tag))
-               (set! (-> packet vif1) (new 'static 'vif-tag))
-               (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-             (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                    (bucket-id debug)
-                                    packet-start
-                                    (the-as (pointer dma-tag) packet-end))))
+         (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
+                      (let ((fmt format))
+                        (fmt (clear *temp-string*)
+                             "~S~S~-27S"
+                             (if (= (-> ctrl the-index) (-> ctrl highlight-index)) ">" " ")
+                             (if (= (-> ctrl the-index) (-> seq playing-item)) "*" " ")
+                             (-> item privname)))
+                      (draw-xy *temp-string*
+                               dma-buff
+                               (-> ctrl xpos)
+                               (-> ctrl ypos)
+                               (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
+                               (font-flags shadow kerning))))
          (when (not picking?)
-           (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-                  (packet-start (-> dma-buff base)))
-             (when (not (logtest? (-> item flags) (anim-test-item-flags end)))
-               (set-origin! font-ctx
-                            (+ (-> ctrl xpos) (* (-> *ANIM_TESTER-bank* EDIT_STATS_X) (-> *DISP_LIST-bank* CHAR_WIDTH)))
-                            (-> ctrl ypos))
-               (cond
-                 ((and (< (-> item speed) 0) (< -100 (-> item speed)))
-                  (let ((draw-adv draw-string-adv))
-                    (let ((fmt format)
-                          (str (clear *temp-string*))
-                          (fmt-str "-0.~1d")
-                          (speed (abs (-> item speed))))
-                      (fmt str fmt-str (/ (mod speed 100) 10)))
-                    (draw-adv *temp-string* dma-buff font-ctx)))
-                 (else
-                  (let ((draw-adv draw-string-adv))
-                    (let ((fmt format)
-                          (str (clear *temp-string*))
-                          (fmt-str "~2d.~1d")
-                          (whole-speed (/ (-> item speed) 100))
-                          (speed (abs (-> item speed))))
-                      (fmt str fmt-str whole-speed (/ (mod speed 100) 10)))
-                    (draw-adv *temp-string* dma-buff font-ctx))))
-               (let ((draw-adv draw-string-adv))
-                 (format (clear *temp-string*) " ~4d" (-> item blend))
-                 (draw-adv *temp-string* dma-buff font-ctx))
-               (anim-tester-disp-frame-num " " (-> item first-frame) (-> item artist-base) font-ctx)
-               (anim-tester-disp-frame-num " " (-> item last-frame) (-> item artist-base) font-ctx)
-               (let ((draw-adv draw-string-adv))
-                 (format (clear *temp-string*)
-                         " ~S~S~S~S"
-                         (if (logtest? (-> item flags) (anim-test-item-flags wait-for-blend)) "B" "-")
-                         "-"
-                         "-"
-                         "-")
-                 (draw-adv *temp-string* dma-buff font-ctx)))
-             (let* ((field-left (-> anim-test-field-highlight-lw 9 left))
-                    (ctx font-ctx)
-                    (x (+ (-> ctrl xpos) (* field-left (-> *DISP_LIST-bank* CHAR_WIDTH))))
-                    (y (-> ctrl ypos)))
-               (set! (-> ctx origin x) (the float x))
-               (set! (-> ctx origin y) (the float y)))
-             (draw-string-adv "MID" dma-buff font-ctx)
-             (let ((packet-end (-> dma-buff base)))
-               (let ((packet (the-as dma-packet (-> dma-buff base))))
-                 (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                 (set! (-> packet vif0) (new 'static 'vif-tag))
-                 (set! (-> packet vif1) (new 'static 'vif-tag))
-                 (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-               (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                      (bucket-id debug)
-                                      packet-start
-                                      (the-as (pointer dma-tag) packet-end)))))))
+           (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (when (not (logtest? (-> item flags) (anim-test-item-flags end)))
+                          (set-origin! font-ctx
+                                       (+ (-> ctrl xpos) (* (-> *ANIM_TESTER-bank* EDIT_STATS_X) (-> *DISP_LIST-bank* CHAR_WIDTH)))
+                                       (-> ctrl ypos))
+                          (cond
+                            ((and (< (-> item speed) 0) (< -100 (-> item speed)))
+                             (let ((draw-adv draw-string-adv))
+                               (let ((fmt format)
+                                     (str (clear *temp-string*))
+                                     (fmt-str "-0.~1d")
+                                     (speed (abs (-> item speed))))
+                                 (fmt str fmt-str (/ (mod speed 100) 10)))
+                               (draw-adv *temp-string* dma-buff font-ctx)))
+                            (else
+                             (let ((draw-adv draw-string-adv))
+                               (let ((fmt format)
+                                     (str (clear *temp-string*))
+                                     (fmt-str "~2d.~1d")
+                                     (whole-speed (/ (-> item speed) 100))
+                                     (speed (abs (-> item speed))))
+                                 (fmt str fmt-str whole-speed (/ (mod speed 100) 10)))
+                               (draw-adv *temp-string* dma-buff font-ctx))))
+                          (let ((draw-adv draw-string-adv))
+                            (format (clear *temp-string*) " ~4d" (-> item blend))
+                            (draw-adv *temp-string* dma-buff font-ctx))
+                          (anim-tester-disp-frame-num " " (-> item first-frame) (-> item artist-base) font-ctx)
+                          (anim-tester-disp-frame-num " " (-> item last-frame) (-> item artist-base) font-ctx)
+                          (let ((draw-adv draw-string-adv))
+                            (format (clear *temp-string*)
+                                    " ~S~S~S~S"
+                                    (if (logtest? (-> item flags) (anim-test-item-flags wait-for-blend)) "B" "-")
+                                    "-"
+                                    "-"
+                                    "-")
+                            (draw-adv *temp-string* dma-buff font-ctx))) (let* ((field-left (-> anim-test-field-highlight-lw 9 left))
+                               (ctx font-ctx)
+                               (x (+ (-> ctrl xpos) (* field-left (-> *DISP_LIST-bank* CHAR_WIDTH))))
+                               (y (-> ctrl ypos)))
+                          (set! (-> ctx origin x) (the float x))
+                          (set! (-> ctx origin y) (the float y))) (draw-string-adv "MID" dma-buff font-ctx)))))
       ((= cmd (list-control-cmd visible?)) (return #t))
       ((= cmd (list-control-cmd input))
        (cond
@@ -1397,42 +1263,18 @@
                           0)))))))))))))
       ((= cmd (list-control-cmd measure)) (set! (-> ctrl return-int) (-> *ANIM_TESTER-bank* EDIT_LIST_MIN_WIDTH)))
       ((= cmd (list-control-cmd draw-title))
-       (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-              (packet-start (-> dma-buff base)))
-         (let ((draw-xy draw-string-xy))
-           (format (clear *temp-string*) "--Seq--(~-17S)--" (-> seq privname))
-           (draw-xy *temp-string* dma-buff (-> ctrl xpos) (-> ctrl ypos) (font-color menu) (font-flags shadow kerning)))
-         (let ((packet-end (-> dma-buff base)))
-           (let ((packet (the-as dma-packet (-> dma-buff base))))
-             (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-             (set! (-> packet vif0) (new 'static 'vif-tag))
-             (set! (-> packet vif1) (new 'static 'vif-tag))
-             (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-           (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                  (bucket-id debug)
-                                  packet-start
-                                  (the-as (pointer dma-tag) packet-end))))
+       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
+                  (format (clear *temp-string*) "--Seq--(~-17S)--" (-> seq privname))
+                  (draw-xy *temp-string* dma-buff (-> ctrl xpos) (-> ctrl ypos) (font-color menu) (font-flags shadow kerning))))
        (cond
          (picking? (display-list-control (-> *anim-tester* 0 pick-con)))
          (else
-          (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-                 (packet-start (-> dma-buff base)))
-            (draw-string-xy "-spd-blnd-1st-lst-flgs-mov-"
-                            dma-buff
-                            (+ (-> ctrl xpos) (* (-> *ANIM_TESTER-bank* EDIT_STATS_X) (-> *DISP_LIST-bank* CHAR_WIDTH)))
-                            (-> ctrl ypos)
-                            (font-color menu)
-                            (font-flags shadow kerning))
-            (let ((packet-end (-> dma-buff base)))
-              (let ((packet (the-as dma-packet (-> dma-buff base))))
-                (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                (set! (-> packet vif0) (new 'static 'vif-tag))
-                (set! (-> packet vif1) (new 'static 'vif-tag))
-                (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-              (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                     (bucket-id debug)
-                                     packet-start
-                                     (the-as (pointer dma-tag) packet-end)))))))))
+          (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "-spd-blnd-1st-lst-flgs-mov-"
+                                      dma-buff
+                                      (+ (-> ctrl xpos) (* (-> *ANIM_TESTER-bank* EDIT_STATS_X) (-> *DISP_LIST-bank* CHAR_WIDTH)))
+                                      (-> ctrl ypos)
+                                      (font-color menu)
+                                      (font-flags shadow kerning))))))))
   #f)
 
 (defbehavior anim-tester-interface anim-tester ()
@@ -1457,24 +1299,12 @@
             (set! (-> obj anim-index) (-> obj list-con current-index))
             (set! (-> obj anim-hindex) (-> obj list-con highlight-index)))
            (else
-            (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-                   (packet-start (-> dma-buff base)))
-              (draw-string-xy "ERROR: current object not found"
-                              dma-buff
-                              (-> *ANIM_TESTER-bank* ANIM_LIST_X)
-                              (-> *ANIM_TESTER-bank* ANIM_LIST_Y)
-                              (font-color menu-func-bad)
-                              (font-flags shadow kerning))
-              (let ((packet-end (-> dma-buff base)))
-                (let ((packet (the-as dma-packet (-> dma-buff base))))
-                  (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                  (set! (-> packet vif0) (new 'static 'vif-tag))
-                  (set! (-> packet vif1) (new 'static 'vif-tag))
-                  (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-                (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                       (bucket-id debug)
-                                       packet-start
-                                       (the-as (pointer dma-tag) packet-end))))))))
+            (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "ERROR: current object not found"
+                                          dma-buff
+                                          (-> *ANIM_TESTER-bank* ANIM_LIST_X)
+                                          (-> *ANIM_TESTER-bank* ANIM_LIST_Y)
+                                          (font-color menu-func-bad)
+                                          (font-flags shadow kerning)))))))
       ((= mode (anim-tester-edit-mode pick-sequence))
        (let ((obj (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))))
          (cond
@@ -1486,24 +1316,12 @@
             (set! (-> obj seq-index) (-> obj list-con current-index))
             (set! (-> obj seq-hindex) (-> obj list-con highlight-index)))
            (else
-            (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-                   (packet-start (-> dma-buff base)))
-              (draw-string-xy "ERROR: current object not found"
-                              dma-buff
-                              (-> *ANIM_TESTER-bank* ANIM_LIST_X)
-                              (-> *ANIM_TESTER-bank* ANIM_LIST_Y)
-                              (font-color menu-func-bad)
-                              (font-flags shadow kerning))
-              (let ((packet-end (-> dma-buff base)))
-                (let ((packet (the-as dma-packet (-> dma-buff base))))
-                  (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                  (set! (-> packet vif0) (new 'static 'vif-tag))
-                  (set! (-> packet vif1) (new 'static 'vif-tag))
-                  (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-                (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                       (bucket-id debug)
-                                       packet-start
-                                       (the-as (pointer dma-tag) packet-end))))))))
+            (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "ERROR: current object not found"
+                                          dma-buff
+                                          (-> *ANIM_TESTER-bank* ANIM_LIST_X)
+                                          (-> *ANIM_TESTER-bank* ANIM_LIST_Y)
+                                          (font-color menu-func-bad)
+                                          (font-flags shadow kerning)))))))
       ((= mode (anim-tester-edit-mode edit-sequence))
        (let ((obj (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))))
          (cond
@@ -1512,43 +1330,19 @@
               (cond
                 (seq (display-list-control (-> seq list-con)))
                 (else
-                 (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-                        (packet-start (-> dma-buff base)))
-                   (draw-string-xy "ERROR: current sequence not found"
-                                   dma-buff
-                                   (-> *ANIM_TESTER-bank* EDIT_LIST_X)
-                                   (-> *ANIM_TESTER-bank* EDIT_LIST_Y)
-                                   (font-color menu-func-bad)
-                                   (font-flags shadow kerning))
-                   (let ((packet-end (-> dma-buff base)))
-                     (let ((packet (the-as dma-packet (-> dma-buff base))))
-                       (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                       (set! (-> packet vif0) (new 'static 'vif-tag))
-                       (set! (-> packet vif1) (new 'static 'vif-tag))
-                       (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-                     (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                            (bucket-id debug)
-                                            packet-start
-                                            (the-as (pointer dma-tag) packet-end))))))))
+                 (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "ERROR: current sequence not found"
+                                                    dma-buff
+                                                    (-> *ANIM_TESTER-bank* EDIT_LIST_X)
+                                                    (-> *ANIM_TESTER-bank* EDIT_LIST_Y)
+                                                    (font-color menu-func-bad)
+                                                    (font-flags shadow kerning)))))))
            (else
-            (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-                   (packet-start (-> dma-buff base)))
-              (draw-string-xy "ERROR: current object not found"
-                              dma-buff
-                              (-> *ANIM_TESTER-bank* EDIT_LIST_X)
-                              (-> *ANIM_TESTER-bank* EDIT_LIST_Y)
-                              (font-color menu-func-bad)
-                              (font-flags shadow kerning))
-              (let ((packet-end (-> dma-buff base)))
-                (let ((packet (the-as dma-packet (-> dma-buff base))))
-                  (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                  (set! (-> packet vif0) (new 'static 'vif-tag))
-                  (set! (-> packet vif1) (new 'static 'vif-tag))
-                  (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-                (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                       (bucket-id debug)
-                                       packet-start
-                                       (the-as (pointer dma-tag) packet-end))))))))))
+            (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "ERROR: current object not found"
+                                          dma-buff
+                                          (-> *ANIM_TESTER-bank* EDIT_LIST_X)
+                                          (-> *ANIM_TESTER-bank* EDIT_LIST_Y)
+                                          (font-color menu-func-bad)
+                                          (font-flags shadow kerning)))))))))
   (set! (-> self old-mode) (-> self edit-mode))
   (none))
 

goal_src/jak1/engine/debug/debug.gc

@@ -298,8 +298,8 @@
        (let ((line (get-debug-line)))
          (when line
            (set! (-> line bucket) bucket)
-           (set! (-> line v1 quad) (-> p0 quad))
-           (set! (-> line v2 quad) (-> p1 quad))
+           (vector-copy! (-> line v1) p0)
+           (vector-copy! (-> line v2) p1)
            (set! (-> line color) color)
            (set! (-> line color2) color2)
            (set! (-> line mode) mode))))
@@ -403,7 +403,7 @@
          (when buffered-text
            (set! (-> buffered-text flags) 0)
            (set! (-> buffered-text bucket) bucket)
-           (set! (-> buffered-text pos quad) (-> location quad))
+           (vector-copy! (-> buffered-text pos) location)
            (cond
              (offset (set! (-> buffered-text offset x) (-> offset x)) (set! (-> buffered-text offset y) (-> offset y)))
              (else (set! (-> buffered-text offset x) 0) (set! (-> buffered-text offset y) 0) 0))
@@ -653,20 +653,7 @@
   "Draw a 255-pixel background bar and a ten-pixel-high colored fill at screen position x,y. The
    fill width is 255 times fraction."
   (if (not enable-draw) (return #f))
-  (let* ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
-         (packet-start (-> dma-buff base)))
-    (draw-sprite2d-xy dma-buff x y 255 14 (new 'static 'rgba :a #x40))
-    (draw-sprite2d-xy dma-buff x (+ y 2) (the int (* 255.0 fraction)) 10 color)
-    (let ((packet-end (-> dma-buff base)))
-      (let ((packet (the-as dma-packet (-> dma-buff base))))
-        (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-        (set! (-> packet vif0) (new 'static 'vif-tag))
-        (set! (-> packet vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             bucket
-                             packet-start
-                             (the-as (pointer dma-tag) packet-end))))
+  (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) bucket) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-sprite2d-xy dma-buff x y 255 14 (new 'static 'rgba :a #x40)) (draw-sprite2d-xy dma-buff x (+ y 2) (the int (* 255.0 fraction)) 10 color))
   #f)
 
 (defun-debug debug-pad-display ((pad cpad-info))
@@ -801,7 +788,7 @@
   (if (and draw-enabled (not (-> history points)))
     (set! (-> history points) (the-as (inline-array vector) (malloc 'debug (* (-> history num-points) 16)))))
   (when (-> history points)
-    (set! (-> history points (-> history h-first) quad) (-> position quad))
+    (vector-copy! (-> history points (-> history h-first)) position)
     (+! (-> history h-first) 1)
     (when (>= (-> history h-first) (-> history num-points))
       (set! (-> history h-first) 0)

goal_src/jak1/engine/debug/default-menu.gc

@@ -2714,7 +2714,7 @@
                                                                            ,(lambda ()
                                                                              (when *target*
                                                                                (position-in-front-of-camera! (target-pos 0) (meters 10) (meters 1))
-                                                                               (set! (-> *target* control transv quad) (the-as uint128 0))
+                                                                               (vector-zero! (-> *target* control transv))
                                                                                (quaternion-identity! (-> *target* control quat))
                                                                                (quaternion-identity! (-> *target* control quat-for-control))
                                                                                (quaternion-identity! (-> *target* control dir-targ)))))
@@ -2723,7 +2723,7 @@
                                                                            ,(lambda ()
                                                                              (when *target*
                                                                                (set-vector! (-> *target* control trans) 0.0 (meters 40) 0.0 1.0)
-                                                                               (set! (-> *target* control transv quad) (the-as uint128 0))
+                                                                               (vector-zero! (-> *target* control transv))
                                                                                (quaternion-identity! (-> *target* control quat))
                                                                                (quaternion-identity! (-> *target* control quat-for-control))
                                                                                (quaternion-identity! (-> *target* control dir-targ)))))

goal_src/jak1/engine/debug/memory-usage-h.gc

@@ -136,9 +136,9 @@
   (array 81)
   (sprite 82)
   (depth-cue 83)
-  (debug-dma 84)
-  (sky-dma 85)
-  (pris-generic)
+  (debug 84)
+  (sky 85)
+  (pris-generic 86)
   (4k-dead-pool 87)
   (8k-dead-pool 88)
   (16k-dead-pool 89)
@@ -166,4 +166,29 @@
 (defmacro mem-usage-id-int (kind)
   `(the int (mem-usage-id ,kind)))
 
-(defun-extern mem-size basic symbol int int)
+;; Record one aligned allocation in a named memory-usage category. This variant embeds the category
+;; name as a static string, matching the common form of the original macro.
+(defmacro mem-usage-add! (usage kind count size)
+  (with-gensyms (bytes)
+    `(begin
+      (set! (-> ,usage length) (max (+ 1 (mem-usage-id-int ,kind)) (-> ,usage length)))
+      (set! (-> ,usage data (mem-usage-id ,kind) name) ,(symbol->string kind))
+      (+! (-> ,usage data (mem-usage-id ,kind) count) ,count)
+      (let ((,bytes ,size))
+        (+! (-> ,usage data (mem-usage-id ,kind) used) ,bytes)
+        (+! (-> ,usage data (mem-usage-id ,kind) total) (align16 ,bytes))))))
+
+;; The drawable-container methods use the symbol's runtime string instead. Keep that distinct from
+;; the static-string variant above: the text is the same, but the original expression and resulting
+;; string object are not.
+(defmacro mem-usage-add-symbol! (usage kind count size)
+  (with-gensyms (bytes)
+    `(begin
+      (set! (-> ,usage length) (max (+ 1 (mem-usage-id-int ,kind)) (-> ,usage length)))
+      (set! (-> ,usage data (mem-usage-id ,kind) name) (symbol->string ',kind))
+      (+! (-> ,usage data (mem-usage-id ,kind) count) ,count)
+      (let ((,bytes ,size))
+        (+! (-> ,usage data (mem-usage-id ,kind) used) ,bytes)
+        (+! (-> ,usage data (mem-usage-id ,kind) total) (align16 ,bytes))))))
+
+(defun-extern mem-size basic symbol mem-usage-flags int)

goal_src/jak1/engine/debug/memory-usage.gc

@@ -24,7 +24,7 @@
   (format #t "-------------------------------------------------------------~%")
   this)
 
-(defmethod mem-usage ((this object) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this object) (usage memory-usage-block) (flags mem-usage-flags))
   "Warn when a nonfalse object reaches this generic fallback. Leave usage unchanged and return the object."
   (if this (format #t "WARNING: mem-usage called on object, probably not what was wanted for ~A~%" this))
   this)
@@ -42,7 +42,7 @@
     (set! (-> this data i count) 0))
   this)
 
-(defun mem-size ((value basic) (print? symbol) (flags int))
+(defun mem-size ((value basic) (print? symbol) (flags mem-usage-flags))
   "Collect value's memory categories using flags, optionally print the complete category table,
    and return the sum of aligned total bytes."
   (let ((usage (new 'stack 'memory-usage-block)))
@@ -56,11 +56,11 @@
   (if (zero? (-> this mem-usage-block)) (set! (-> this mem-usage-block) (new 'debug 'memory-usage-block)))
   (set! force? (or (zero? (-> this mem-usage-block length)) force?))
   (when force?
-    (mem-usage this (reset! (-> this mem-usage-block)) 0)
+    (mem-usage this (reset! (-> this mem-usage-block)) (mem-usage-flags))
     (set! (-> this mem-usage) (calculate-total (-> this mem-usage-block))))
   (-> this mem-usage-block))
 
-(defmethod mem-usage ((this process-tree) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this process-tree) (usage memory-usage-block) (flags mem-usage-flags))
   "Name and optionally count the process dead pools, then account for every active process and
    its heap header, thread, drawable controllers, and other major heap-owned allocations.
    flags bit #x20 also counts objects currently resident in the dead pools."
@@ -75,7 +75,7 @@
     (set! (-> usage length) (max (-> usage length) name-category)))
   (set! (-> usage data 93 name) "*debug-dead-pool*")
   (set! *temp-mem-usage* usage)
-  (when (logtest? flags 32)
+  (when (logtest? flags (mem-usage-flags include-dead-pools))
     (let* ((dead-category 87)
            (dead-pool-list *dead-pool-list*)
            (dead-pool-symbol (car dead-pool-list)))
@@ -106,107 +106,32 @@
                                                    (else 87))))
                               (+! (-> usage data pool-category count) 1)
                               (+! (-> usage data pool-category total) (logand -16 (+ (asize-of proc) 15))))
-                            (set! (-> usage length) (max 95 (-> usage length)))
-                            (set! (-> usage data 94 name) "process-active")
-                            (+! (-> usage data 94 count) 1)
-                            (let ((process-size (asize-of proc)))
-                              (+! (-> usage data 94 used) process-size)
-                              (+! (-> usage data 94 total) (logand -16 (+ process-size 15))))
-                            (set! (-> usage length) (max 96 (-> usage length)))
-                            (set! (-> usage data 95 name) "heap-total")
-                            (+! (-> usage data 95 count) 1)
-                            (let ((heap-used (+ (the-as uint (- -4 (the-as int proc))) (the-as uint (-> proc heap-cur)))))
-                              (+! (-> usage data 95 used) heap-used)
-                              (+! (-> usage data 95 total) (logand -16 (+ heap-used 15))))
-                            (set! (-> usage length) (max 97 (-> usage length)))
-                            (set! (-> usage data 96 name) "heap-process")
-                            (+! (-> usage data 96 count) 1)
-                            (let ((process-data-size (- (-> proc type size) (-> proc type heap-base))))
-                              (+! (-> usage data 96 used) process-data-size)
-                              (+! (-> usage data 96 total) (logand -16 (+ process-data-size 15))))
-                            (set! (-> usage length) (max 98 (-> usage length)))
-                            (set! (-> usage data 97 name) "heap-header")
-                            (+! (-> usage data 97 count) 1)
-                            (let ((heap-header-size (-> proc type heap-base)))
-                              (+! (-> usage data 97 used) heap-header-size)
-                              (+! (-> usage data 97 total) (logand -16 (+ heap-header-size 15))))
-                            (set! (-> usage length) (max 99 (-> usage length)))
-                            (set! (-> usage data 98 name) "heap-thread")
-                            (+! (-> usage data 98 count) 1)
-                            (let ((thread-size (asize-of (-> proc main-thread))))
-                              (+! (-> usage data 98 used) thread-size)
-                              (+! (-> usage data 98 total) (logand -16 (+ thread-size 15))))
+                            (mem-usage-add! usage process-active 1 (asize-of proc))
+                            (mem-usage-add! usage heap-total 1 (+ (the-as uint (- -4 (the-as int proc))) (the-as uint (-> proc heap-cur))))
+                            (mem-usage-add! usage heap-process 1 (- (-> proc type size) (-> proc type heap-base)))
+                            (mem-usage-add! usage heap-header 1 (-> proc type heap-base))
+                            (mem-usage-add! usage heap-thread 1 (asize-of (-> proc main-thread)))
                             (when (type-type? (-> proc type) process-drawable)
                               (when (nonzero? (-> (the-as process-drawable proc) root))
-                                (set! (-> usage length) (max 100 (-> usage length)))
-                                (set! (-> usage data 99 name) "heap-root")
-                                (+! (-> usage data 99 count) 1)
-                                (let ((root-size (asize-of (-> (the-as process-drawable proc) root))))
-                                  (+! (-> usage data 99 used) root-size)
-                                  (+! (-> usage data 99 total) (logand -16 (+ root-size 15))))
+                                (mem-usage-add! usage heap-root 1 (asize-of (-> (the-as process-drawable proc) root)))
                                 (when (type-type? (-> (the-as process-drawable proc) root type) collide-shape)
-                                  (set! (-> usage length) (max 106 (-> usage length)))
-                                  (set! (-> usage data 105 name) "heap-collide-prim")
-                                  (+! (-> usage data 105 count) 1)
-                                  (let ((root-prim-size (asize-of (-> (the-as collide-shape (-> (the-as process-drawable proc) root)) root-prim))))
-                                    (+! (-> usage data 105 used) root-prim-size)
-                                    (+! (-> usage data 105 total) (logand -16 (+ root-prim-size 15))))))
+                                  (mem-usage-add! usage heap-collide-prim 1 (asize-of (-> (the-as collide-shape (-> (the-as process-drawable proc) root)) root-prim)))))
                               (when (nonzero? (-> (the-as process-drawable proc) node-list))
-                                (set! (-> usage length) (max 103 (-> usage length)))
-                                (set! (-> usage data 102 name) "heap-cspace")
-                                (+! (-> usage data 102 count) 1)
-                                (let ((cspace-size (asize-of (-> (the-as process-drawable proc) node-list))))
-                                  (+! (-> usage data 102 used) cspace-size)
-                                  (+! (-> usage data 102 total) (logand -16 (+ cspace-size 15)))))
+                                (mem-usage-add! usage heap-cspace 1 (asize-of (-> (the-as process-drawable proc) node-list))))
                               (when (nonzero? (-> (the-as process-drawable proc) draw))
-                                (set! (-> usage length) (max 101 (-> usage length)))
-                                (set! (-> usage data 100 name) "heap-draw-control")
-                                (+! (-> usage data 100 count) 1)
-                                (let ((draw-control-size (asize-of (-> (the-as process-drawable proc) draw))))
-                                  (+! (-> usage data 100 used) draw-control-size)
-                                  (+! (-> usage data 100 total) (logand -16 (+ draw-control-size 15))))
+                                (mem-usage-add! usage heap-draw-control 1 (asize-of (-> (the-as process-drawable proc) draw)))
                                 (when (nonzero? (-> (the-as process-drawable proc) draw skeleton))
-                                  (set! (-> usage length) (max 104 (-> usage length)))
-                                  (set! (-> usage data 103 name) "heap-bone")
-                                  (+! (-> usage data 103 count) 1)
-                                  (let ((skeleton-size (asize-of (-> (the-as process-drawable proc) draw skeleton))))
-                                    (+! (-> usage data 103 used) skeleton-size)
-                                    (+! (-> usage data 103 total) (logand -16 (+ skeleton-size 15))))))
+                                  (mem-usage-add! usage heap-bone 1 (asize-of (-> (the-as process-drawable proc) draw skeleton)))))
                               (when (nonzero? (-> (the-as process-drawable proc) skel))
-                                (set! (-> usage length) (max 102 (-> usage length)))
-                                (set! (-> usage data 101 name) "heap-joint-control")
-                                (+! (-> usage data 101 count) 1)
-                                (let ((joint-control-size (asize-of (-> (the-as process-drawable proc) skel))))
-                                  (+! (-> usage data 101 used) joint-control-size)
-                                  (+! (-> usage data 101 total) (logand -16 (+ joint-control-size 15)))))
+                                (mem-usage-add! usage heap-joint-control 1 (asize-of (-> (the-as process-drawable proc) skel))))
                               (when (nonzero? (-> (the-as process-drawable proc) part))
-                                (set! (-> usage length) (max 105 (-> usage length)))
-                                (set! (-> usage data 104 name) "heap-part")
-                                (+! (-> usage data 104 count) 1)
-                                (let ((particle-control-size (asize-of (-> (the-as process-drawable proc) part))))
-                                  (+! (-> usage data 104 used) particle-control-size)
-                                  (+! (-> usage data 104 total) (logand -16 (+ particle-control-size 15)))))
+                                (mem-usage-add! usage heap-part 1 (asize-of (-> (the-as process-drawable proc) part))))
                               (when (nonzero? (-> (the-as process-drawable proc) nav))
-                                (set! (-> usage length) (max 107 (-> usage length)))
-                                (set! (-> usage data 106 name) "heap-misc")
-                                (+! (-> usage data 106 count) 1)
-                                (let ((nav-size (asize-of (-> (the-as process-drawable proc) nav))))
-                                  (+! (-> usage data 106 used) nav-size)
-                                  (+! (-> usage data 106 total) (logand -16 (+ nav-size 15)))))
+                                (mem-usage-add! usage heap-misc 1 (asize-of (-> (the-as process-drawable proc) nav))))
                               (when (nonzero? (-> (the-as process-drawable proc) path))
-                                (set! (-> usage length) (max 107 (-> usage length)))
-                                (set! (-> usage data 106 name) "heap-misc")
-                                (+! (-> usage data 106 count) 1)
-                                (let ((path-size (asize-of (-> (the-as process-drawable proc) path))))
-                                  (+! (-> usage data 106 used) path-size)
-                                  (+! (-> usage data 106 total) (logand -16 (+ path-size 15)))))
+                                (mem-usage-add! usage heap-misc 1 (asize-of (-> (the-as process-drawable proc) path))))
                               (when (nonzero? (-> (the-as process-drawable proc) vol))
-                                (set! (-> usage length) (max 107 (-> usage length)))
-                                (set! (-> usage data 106 name) "heap-misc")
-                                (+! (-> usage data 106 count) 1)
-                                (let ((volume-size (asize-of (-> (the-as process-drawable proc) vol))))
-                                  (+! (-> usage data 106 used) volume-size)
-                                  (+! (-> usage data 106 total) (logand -16 (+ volume-size 15)))))))
+                                (mem-usage-add! usage heap-misc 1 (asize-of (-> (the-as process-drawable proc) vol))))))
                           #t)
                         *null-kernel-context*)
   this)

goal_src/jak1/engine/debug/part-tester.gc

@@ -51,8 +51,8 @@
           (when ent
             (let ((proc (-> ent extra process)))
               (if (and proc (type-type? (-> proc type) process-drawable) (nonzero? (-> (the-as process-drawable proc) root)))
-                (set! (-> self root trans quad) (-> (the-as process-drawable proc) root trans quad))
-                (set! (-> self root trans quad) (-> ent extra trans quad))))))
+                (vector-copy! (-> self root trans) (-> (the-as process-drawable proc) root trans))
+                (vector-copy! (-> self root trans) (-> ent extra trans))))))
         (add-debug-x #t
                      (bucket-id debug-no-zbuf)
                      (-> self root trans)
@@ -88,7 +88,7 @@
    process-drawable because part-tester's root sits where a process-drawable's
    does, even though part-tester is a plain process."
   (set! (-> self root) (new 'process 'trsqv))
-  (set! (-> self root trans quad) (-> pos quad))
+  (vector-copy! (-> self root trans) pos)
   (set! *part-tester* (the-as part-tester (process->ppointer self)))
   (go part-tester-idle)
   (none))

goal_src/jak1/engine/debug/viewer.gc

@@ -142,7 +142,7 @@
    encoded source of optional -ja-NAME and -geo-NAME selectors."
   (set! *viewer* self)
   (set! (-> self root) (new 'process 'trsqv))
-  (set! (-> self root trans quad) (-> position quad))
+  (vector-copy! (-> self root trans) position)
   (quaternion-identity! (-> self root quat))
   (set-vector! (-> self root scale) 1.0 1.0 1.0 1.0)
   (actor-get-arg! viewer-ja-name "ja" art-name)

goal_src/jak1/engine/draw/draw-node.gc

@@ -71,15 +71,10 @@
     (format #t "~T  [~D] ~A~%" i (-> this data i)))
   this)
 
-(defmethod mem-usage ((this drawable-inline-array-node) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-inline-array-node) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this inline array's draw-node storage without counting memory owned by the
    nodes' children."
-  (set! (-> usage length) (max 62 (-> usage length)))
-  (set! (-> usage data 61 name) "draw-node")
-  (+! (-> usage data 61 count) (-> this length))
-  (let ((byte-size (asize-of this)))
-    (+! (-> usage data 61 used) byte-size)
-    (+! (-> usage data 61 total) (logand -16 (+ byte-size 15))))
+  (mem-usage-add! usage draw-node (-> this length) (asize-of this))
   this)
 
 (defmethod asize-of ((this drawable-inline-array-node))

goal_src/jak1/engine/draw/drawable-group.gc

@@ -35,15 +35,10 @@
   "Return the allocation size of this variable-length drawable group."
   (the-as int (+ (-> drawable-group size) (* (+ (-> this length) -1) 4))))
 
-(defmethod mem-usage ((this drawable-group) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-group) (usage memory-usage-block) (flags mem-usage-flags))
   "Record this group's allocation in usage, then recursively collect memory use from every
    child. flags is forwarded unchanged to each child."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) "drawable-group")
-  (+! (-> usage data 0 count) 1)
-  (let ((allocated-size (asize-of this)))
-    (+! (-> usage data 0 used) allocated-size)
-    (+! (-> usage data 0 total) (logand -16 (+ allocated-size 15))))
+  (mem-usage-add! usage drawable-group 1 (asize-of this))
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   this)

goal_src/jak1/engine/draw/drawable.gc

@@ -371,14 +371,15 @@
                             (v1-16 s4-1))
                        (t9-3 a0-4
                              a1-0
-                             (logior (cond
-                                       ((= v1-16 1) 4)
-                                       ((= v1-16 2) 8)
-                                       ((= v1-16 3) 16)
-                                       (else 0))
-                                     2)))))
+                             (the-as mem-usage-flags
+                                     (logior (cond
+                                               ((= v1-16 1) 4)
+                                               ((= v1-16 2) 8)
+                                               ((= v1-16 3) 16)
+                                               (else 0))
+                                             2))))))
                  (set! geometry-bytes (+ (calculate-total *instance-mem-usage*) 580))))
-              (mem-usage prototype (reset! *instance-mem-usage*) 0)
+              (mem-usage prototype (reset! *instance-mem-usage*) (mem-usage-flags))
               (let ((prototype-bytes (calculate-total *instance-mem-usage*)))
                 (format output
                         "~%~A ~A b @ #x~X ~,,2fK/~,,2fK~%"
@@ -712,13 +713,13 @@
   (when (not (logtest? (-> control status) (draw-status hidden no-anim no-skeleton-update)))
     (let ((scratch-lights (the-as vu-lights (+ 64 (scratchpad-object int))))
           (hud-lights *hud-lights*))
-      (set! (-> scratch-lights direction 0 quad) (-> hud-lights direction 0 quad))
-      (set! (-> scratch-lights direction 1 quad) (-> hud-lights direction 1 quad))
-      (set! (-> scratch-lights direction 2 quad) (-> hud-lights direction 2 quad))
-      (set! (-> scratch-lights color 0 quad) (-> hud-lights color 0 quad))
-      (set! (-> scratch-lights color 1 quad) (-> hud-lights color 1 quad))
-      (set! (-> scratch-lights color 2 quad) (-> hud-lights color 2 quad))
-      (set! (-> scratch-lights ambient quad) (-> hud-lights ambient quad)))
+      (vector-copy! (-> scratch-lights direction 0) (-> hud-lights direction 0))
+      (vector-copy! (-> scratch-lights direction 1) (-> hud-lights direction 1))
+      (vector-copy! (-> scratch-lights direction 2) (-> hud-lights direction 2))
+      (vector-copy! (-> scratch-lights color 0) (-> hud-lights color 0))
+      (vector-copy! (-> scratch-lights color 1) (-> hud-lights color 1))
+      (vector-copy! (-> scratch-lights color 2) (-> hud-lights color 2))
+      (vector-copy! (-> scratch-lights ambient) (-> hud-lights ambient)))
     (lod-set! control 0)
     (logior! (-> control status) (draw-status was-drawn))
     (draw-bones-hud control dma-buf))
@@ -944,7 +945,7 @@
   ;; draw the background!
   (with-profiler "background"
     (init-background)
-    (execute-connections *background-draw-engine* (-> *display* frames (-> *display* on-screen) frame))
+    (execute-connections *background-draw-engine* (current-frame))
     ;; finish bg (most of the work is here)
     (reset! (-> *perf-stats* data 3))
     (finish-background)
@@ -964,11 +965,11 @@
   ;; draw the foreground engines.
   (with-profiler "foreground-engines"
     (foreground-engine-execute (-> *level* level-default foreground-draw-engine 0)
-                               (-> *display* frames (-> *display* on-screen) frame)
+                               (current-frame)
                                2
                                0)
     (foreground-engine-execute (-> *level* level-default foreground-draw-engine 1)
-                               (-> *display* frames (-> *display* on-screen) frame)
+                               (current-frame)
                                2
                                1))
   ;; handle extra processing for foreground
@@ -1017,33 +1018,19 @@
   ;; The packet sends three qwords through VIF DIRECT: an A+D GIF tag followed by ZBUF_1 and
   ;; TEST_1 register writes. Its NEXT tail is inserted into the selected debug bucket so later
   ;; debug geometry inherits these depth settings.
-  (let* ((global-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-         (segment-start (-> global-buf base)))
-    (let ((packet-head (the-as object (-> global-buf base))))
-      (set! (-> (the-as dma-packet packet-head) dma) (new 'static 'dma-tag :qwc #x3 :id (dma-tag-id cnt)))
-      (set! (-> (the-as dma-packet packet-head) vif0) (new 'static 'vif-tag))
-      (set! (-> (the-as dma-packet packet-head) vif1) (new 'static 'vif-tag :imm #x3 :cmd (vif-cmd direct) :msk #x1))
-      (set! (-> global-buf base) (&+ (the-as pointer packet-head) 16)))
-    (let ((gif-head (the-as object (-> global-buf base))))
-      (set! (-> (the-as gs-gif-tag gif-head) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x2))
-      (set! (-> (the-as gs-gif-tag gif-head) regs) GIF_REGS_ALL_AD)
-      (set! (-> global-buf base) (&+ (the-as pointer gif-head) 16)))
-    (let ((register-data (-> global-buf base)))
-      (set! (-> (the-as (pointer gs-zbuf) register-data) 0) zbuf)
-      (set! (-> (the-as (pointer gs-reg64) register-data) 1) (gs-reg64 zbuf-1))
-      (set! (-> (the-as (pointer gs-test) register-data) 2) test)
-      (set! (-> (the-as (pointer gs-reg64) register-data) 3) (gs-reg64 test-1))
-      (set! (-> global-buf base) (&+ register-data 32)))
-    (let ((tail-tag (-> global-buf base)))
-      (let ((tail-packet (the-as object (-> global-buf base))))
-        (set! (-> (the-as dma-packet tail-packet) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-        (set! (-> (the-as dma-packet tail-packet) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet tail-packet) vif1) (new 'static 'vif-tag))
-        (set! (-> global-buf base) (&+ (the-as pointer tail-packet) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             debug-bucket
-                             segment-start
-                             (the-as (pointer dma-tag) tail-tag))))
+  (with-dma-buffer-add-bucket ((global-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) debug-bucket) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((packet-head (the-as object (-> global-buf base))))
+        (set! (-> (the-as dma-packet packet-head) dma) (new 'static 'dma-tag :qwc #x3 :id (dma-tag-id cnt)))
+        (set! (-> (the-as dma-packet packet-head) vif0) (new 'static 'vif-tag))
+        (set! (-> (the-as dma-packet packet-head) vif1) (new 'static 'vif-tag :imm #x3 :cmd (vif-cmd direct) :msk #x1))
+        (set! (-> global-buf base) (&+ (the-as pointer packet-head) 16))) (let ((gif-head (the-as object (-> global-buf base))))
+        (set! (-> (the-as gs-gif-tag gif-head) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x2))
+        (set! (-> (the-as gs-gif-tag gif-head) regs) GIF_REGS_ALL_AD)
+        (set! (-> global-buf base) (&+ (the-as pointer gif-head) 16))) (let ((register-data (-> global-buf base)))
+        (set! (-> (the-as (pointer gs-zbuf) register-data) 0) zbuf)
+        (set! (-> (the-as (pointer gs-reg64) register-data) 1) (gs-reg64 zbuf-1))
+        (set! (-> (the-as (pointer gs-test) register-data) 2) test)
+        (set! (-> (the-as (pointer gs-reg64) register-data) 3) (gs-reg64 test-1))
+        (set! (-> global-buf base) (&+ register-data 32))))
   (none))
 
 (define *screen-shot* #f)
@@ -1184,26 +1171,14 @@
     ;; one rendering stage into the following stage.
     ;; iterate through all buckets and append a final GS state reset.
     (dotimes (bucket-idx BUCKET_COUNT)
-      (let* ((this-global-buf (-> this-frame global-buf))
-             (a2-0 (-> this-global-buf base)))
-        ;; clear GS state after the bucket
-        (let* ((a0-3 this-global-buf)
-               (t0-0 *default-regs-buffer*)
-               (a1-0 (the-as object (-> a0-3 base))))
-          (set! (-> (the-as dma-packet a1-0) dma) (new 'static 'dma-tag :id (dma-tag-id call) :addr (the-as int (-> t0-0 data))))
-          (set! (-> (the-as dma-packet a1-0) vif0) (new 'static 'vif-tag :irq #x1))
-          (set! (-> (the-as dma-packet a1-0) vif1) (new 'static 'vif-tag))
-          (set! (-> a0-3 base) (&+ (the-as pointer a1-0) 16)))
-        (let ((a3-4 (-> this-global-buf base)))
-          (let ((a0-4 (the-as object (-> this-global-buf base))))
-            (set! (-> (the-as dma-packet a0-4) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-            (set! (-> (the-as dma-packet a0-4) vif0) (new 'static 'vif-tag))
-            (set! (-> (the-as dma-packet a0-4) vif1) (new 'static 'vif-tag))
-            (set! (-> this-global-buf base) (&+ (the-as pointer a0-4) 16)))
-          (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                 (the-as bucket-id bucket-idx)
-                                 a2-0
-                                 (the-as (pointer dma-tag) a3-4)))))
+      ;; clear GS state after the bucket
+      (with-dma-buffer-add-bucket ((this-global-buf (-> this-frame global-buf)) (the-as bucket-id bucket-idx)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let* ((a0-3 this-global-buf)
+                     (t0-0 *default-regs-buffer*)
+                     (a1-0 (the-as object (-> a0-3 base))))
+                (set! (-> (the-as dma-packet a1-0) dma) (new 'static 'dma-tag :id (dma-tag-id call) :addr (the-as int (-> t0-0 data))))
+                (set! (-> (the-as dma-packet a1-0) vif0) (new 'static 'vif-tag :irq #x1))
+                (set! (-> (the-as dma-packet a1-0) vif1) (new 'static 'vif-tag))
+                (set! (-> a0-3 base) (&+ (the-as pointer a1-0) 16)))))
     ;; append a FLUSHE and IRQ to end the calc-buf
     (let* ((v1-14 this-calc-buf)
            (a0-10 (the-as object (-> v1-14 base))))

goal_src/jak1/engine/engine/connect.gc

@@ -169,6 +169,17 @@
   "Return node's next link in an engine list."
   (-> node next0))
 
+;; Walk an engine's live connections in forward order. Cache next before running body so body may
+;; unlink the current connection without breaking the traversal.
+(defmacro iterate-engine-connections (bindings &rest body)
+  (with-gensyms (next)
+    `(let* ((,(car bindings) (-> ,(cadr bindings) alive-list next0))
+           (,next (-> ,(car bindings) next0)))
+      (while (!= ,(car bindings) (-> ,(cadr bindings) alive-list-end))
+        ,@body
+        (set! ,(car bindings) ,next)
+        (set! ,next (-> ,next next0))))))
+
 (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))
@@ -251,13 +262,8 @@
 
 (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."
-  (let* ((current (-> this alive-list next0))
-         ;; Save this before the callback in case it removes current.
-         (next (-> current next0)))
-    (while (!= current (-> this alive-list-end))
-      (f current)
-      (set! current next)
-      (set! next (-> next next0))))
+  ;; Save this before the callback in case it removes current.
+  (iterate-engine-connections (current this) (f current))
   0)
 
 (defmethod apply-to-connections-reverse ((this engine) (f (function connectable none)))
@@ -403,22 +409,14 @@
 
 (defmethod remove-by-param1 ((this engine) (p1-value object))
   "Move every live connection whose param1 equals value to the dead list."
-  (let* ((current (-> this alive-list next0))
-         (next (-> current next0)))
-    (while (!= current (-> this alive-list-end))
-      (if (= (-> (the-as connection current) param1) p1-value)
-        ((method-of-type connection move-to-dead) (the-as connection current)))
-      (set! current next)
-      (set! next (-> next next0))))
+  (iterate-engine-connections (current this)
+                              (if (= (-> (the-as connection current) param1) p1-value)
+                                ((method-of-type connection move-to-dead) (the-as connection current))))
   0)
 
 (defmethod remove-by-param2 ((this engine) (p2-value int))
   "Move every live connection whose param2 equals value to the dead list."
-  (let* ((current (-> this alive-list next0))
-         (next (-> current next0)))
-    (while (!= current (-> this alive-list-end))
-      (if (= (-> (the-as connection current) param2) p2-value)
-        ((method-of-type connection move-to-dead) (the-as connection current)))
-      (set! current next)
-      (set! next (-> next next0))))
+  (iterate-engine-connections (current this)
+                              (if (= (-> (the-as connection current) param2) p2-value)
+                                ((method-of-type connection move-to-dead) (the-as connection current))))
   0)

goal_src/jak1/engine/entity/ambient.gc

@@ -11,25 +11,15 @@
 
 ;; DECOMP BEGINS
 
-(defmethod mem-usage ((this drawable-ambient) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-ambient) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this wrapper and its referenced ambient entity in the ambient memory category."
-  (set! (-> usage length) (max 50 (-> usage length)))
-  (set! (-> usage data 49 name) "ambient")
-  (+! (-> usage data 49 count) 1)
-  (let ((object-size (asize-of this)))
-    (+! (-> usage data 49 used) object-size)
-    (+! (-> usage data 49 total) (logand -16 (+ object-size 15))))
-  (mem-usage (-> this ambient) usage (logior flags 128))
+  (mem-usage-add! usage ambient 1 (asize-of this))
+  (mem-usage (-> this ambient) usage (logior flags (mem-usage-flags resource-ambient)))
   (the-as drawable-ambient 0))
 
-(defmethod mem-usage ((this drawable-inline-array-ambient) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-inline-array-ambient) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this array header and each inline ambient wrapper it contains."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((header-size 32))
-    (+! (-> usage data 0 used) header-size)
-    (+! (-> usage data 0 total) (logand -16 (+ header-size 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 32)
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   (the-as drawable-inline-array-ambient 0))
@@ -242,7 +232,7 @@
     (let ((text-context (new 'stack 'font-context *font-default-matrix* 56 160 0.0 (font-color default) (font-flags shadow kerning))))
       (set-width! text-context 400)
       (set-height! text-context 96)
-      (set! (-> text-context flags) (font-flags shadow kerning middle large))
+      (set-flags! text-context (font-flags shadow kerning middle large))
       (print-game-text (lookup-text! *common-text* (-> this text-id-to-display) #f) text-context #f 128 22)))
   0
   (none))
@@ -428,7 +418,7 @@
           (let ((text-context (new 'stack 'font-context *font-default-matrix* 56 160 0.0 (font-color default) (font-flags shadow kerning))))
             (set-width! text-context 400)
             (set-height! text-context 96)
-            (set! (-> text-context flags) (font-flags shadow kerning middle))
+            (set-flags! text-context (font-flags shadow kerning middle))
             (let ((draw-text print-game-text))
               (format (clear *temp-string*) "~S~S" prefix suffix)
               (draw-text *temp-string* text-context #f 128 22)))))
@@ -476,7 +466,7 @@
            (let ((text-context (new 'stack 'font-context *font-default-matrix* 56 160 0.0 (font-color default) (font-flags shadow kerning))))
              (set-width! text-context 400)
              (set-height! text-context 96)
-             (set! (-> text-context flags) (font-flags shadow kerning middle large))
+             (set-flags! text-context (font-flags shadow kerning middle large))
              (print-game-text "AS: UNKNOWN ID" text-context #f 128 22))))
         ((!= resolved-text-id -1)
          (kill-current-level-hint '() '() 'exit)

goal_src/jak1/engine/entity/entity.gc

@@ -24,26 +24,16 @@
 ;; entity basic methods
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod mem-usage ((this drawable-actor) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-actor) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this drawable wrapper and delegate to its entity actor in the entity category."
-  (set! (-> usage length) (max 44 (-> usage length)))
-  (set! (-> usage data 43 name) "entity")
-  (+! (-> usage data 43 count) 1)
-  (let ((allocation-size (asize-of this)))
-    (+! (-> usage data 43 used) allocation-size)
-    (+! (-> usage data 43 total) (logand -16 (+ allocation-size 15))))
+  (mem-usage-add! usage entity 1 (asize-of this))
   ;; Attribute the actor's resource lump and referenced data to the entity category.
-  (mem-usage (-> this actor) usage (logior flags 64))
+  (mem-usage (-> this actor) usage (logior flags (mem-usage-flags resource-entity)))
   (the-as drawable-actor 0))
 
-(defmethod mem-usage ((this drawable-inline-array-actor) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-inline-array-actor) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the drawable-group header and every active inline actor wrapper."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((header-size 32))
-    (+! (-> usage data 0 used) header-size)
-    (+! (-> usage data 0 total) (logand -16 (+ header-size 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 32)
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   (the-as drawable-inline-array-actor 0))
@@ -962,7 +952,7 @@
   "Mark proc as actor-pausable and initialize its root translation, rotation, and unit scale from
    actor."
   (logior! (-> proc mask) (process-mask actor-pause))
-  (set! (-> proc root trans quad) (-> actor extra trans quad))
+  (vector-copy! (-> proc root trans) (-> actor extra trans))
   (quaternion-copy! (-> proc root quat) (-> actor quat))
   (vector-identity! (-> proc root scale))
   (none))

goal_src/jak1/engine/entity/res.gc

@@ -506,16 +506,16 @@ This system grew out of the Crash 2 entity resource system.
 
 (declare-type collide-mesh basic)
 
-(defmethod mem-usage ((this res-lump) (block memory-usage-block) (flags int))
+(defmethod mem-usage ((this res-lump) (block memory-usage-block) (flags mem-usage-flags))
   "Add the lump and its referenced objects to the selected memory-usage category."
   ;; get the name and ID
   (let ((mem-use-id (mem-usage-id res))
         (mem-use-name "res"))
     (cond
-      ((logtest? flags 256) (set! mem-use-id (mem-usage-id camera)) (set! mem-use-name "camera"))
-      ((logtest? flags 64) (set! mem-use-id (mem-usage-id entity)) (set! mem-use-name "entity"))
-      ((logtest? flags 128) (set! mem-use-id (mem-usage-id ambient)) (set! mem-use-name "ambient"))
-      ((logtest? flags 512) (set! mem-use-id (mem-usage-id art-joint-geo)) (set! mem-use-name "art-joint-geo")))
+      ((logtest? flags (mem-usage-flags resource-camera)) (set! mem-use-id (mem-usage-id camera)) (set! mem-use-name "camera"))
+      ((logtest? flags (mem-usage-flags resource-entity)) (set! mem-use-id (mem-usage-id entity)) (set! mem-use-name "entity"))
+      ((logtest? flags (mem-usage-flags resource-ambient)) (set! mem-use-id (mem-usage-id ambient)) (set! mem-use-name "ambient"))
+      ((logtest? flags (mem-usage-flags resource-joint-geo)) (set! mem-use-id (mem-usage-id art-joint-geo)) (set! mem-use-name "art-joint-geo")))
     ;; set up the block
     (set! (-> block length) (max (-> block length) (+ mem-use-id 1)))
     (set! (-> block data mem-use-id name) mem-use-name)

goal_src/jak1/engine/game/game-save.gc

@@ -847,7 +847,7 @@
     (let ((debug-context (new 'stack 'font-context *font-default-matrix* 32 160 0.0 (font-color default) (font-flags shadow kerning))))
       (set-width! debug-context 440)
       (set-height! debug-context 80)
-      (set! (-> debug-context flags) (font-flags shadow kerning))
+      (set-flags! debug-context (font-flags shadow kerning))
       (format (clear *temp-string*) "~S / ~S ~D~%" (-> self mode) (-> self state name) (-> self which))
       (print-game-text *temp-string* debug-context #f 128 22)))
   ;; auto-save drawing
@@ -856,7 +856,7 @@
       (set-scale! save-context 0.8)
       (set-width! save-context 472)
       (set-height! save-context 20)
-      (set! (-> save-context flags) (font-flags shadow kerning middle middle-vert large))
+      (set-flags! save-context (font-flags shadow kerning middle middle-vert large))
       ;; if this is the first time saving, display a warning.
       (when (zero? (-> *game-info* auto-save-count))
         (print-game-text (lookup-text! *common-text* (text-id saving-data) #f) save-context #f 128 22)

goal_src/jak1/engine/game/projectiles.gc

@@ -39,13 +39,13 @@
    angle-range of 65536 disables the cone test."
   (let ((search *search-info*))
     (set! (-> search match) #f)
-    (set! (-> search point quad) (-> search-point quad))
+    (vector-copy! (-> search point) search-point)
     (set! (-> search radius) search-radius)
     (set! (-> search best) search-radius)
     (set! (-> search rating) (the-as uint 0))
     (set! (-> search require) required-rating)
     (set! (-> search mask) rating-mask)
-    (set! (-> search rot-base quad) (-> forward-direction quad))
+    (vector-copy! (-> search rot-base) forward-direction)
     (set! (-> search rot-range) (if (= angle-range 65536.0) -2.0 (cos angle-range)))
     (iterate-process-tree *entity-pool*
                           (lambda ((candidate-process process))
@@ -102,7 +102,7 @@
       (let ((separation (vector-float*! (new 'stack-no-clear 'vector) contact-normal 32.0)))
         (move-by-vector! cshape separation)))
     (set! (-> cshape surface-normal quad) (-> contact-normal quad))
-    (set! (-> cshape poly-normal quad) (-> isect best-tri normal quad))
+    (vector-copy! (-> cshape poly-normal) (-> isect best-tri normal))
     (set! (-> cshape surface-angle) (vector-dot contact-normal (-> cshape dynam gravity-normal)))
     (set! (-> cshape poly-angle) (vector-dot (-> cshape poly-normal) (-> cshape dynam gravity-normal)))
     (set! (-> cshape touch-angle)
@@ -122,10 +122,10 @@
       (vector-reflect-flat-above! vel-out (the-as vector velocity-copy) contact-normal)
       (when (and (not wall?) (>= (-> cshape coverage) 0.9))
         (logior! status-mask (collide-status on-ground))
-        (set! (-> cshape ground-poly-normal quad) (-> cshape poly-normal quad))
+        (vector-copy! (-> cshape ground-poly-normal) (-> cshape poly-normal))
         (when (!= (-> cshape poly-pat mode) (pat-mode wall))
           (set! (-> cshape ground-pat) (-> cshape poly-pat))
-          (set! (-> cshape ground-touch-point quad) (-> isect best-tri intersect quad)))))
+          (vector-copy! (-> cshape ground-touch-point) (-> isect best-tri intersect)))))
     (logior! (-> cshape status) status-mask)
     (the-as collide-status status-mask)))
 
@@ -582,7 +582,7 @@
                     ((< target-distance 20480.0) (seek! (-> self tween) 1.0 (* 3.0 (seconds-per-frame))))
                     ((< target-distance 40960.0) (seek! (-> self tween) 1.0 (seconds-per-frame))))))
               (let ((previous-position (new 'stack-no-clear 'vector)))
-                (set! (-> previous-position quad) (-> self root trans quad))
+                (vector-copy! previous-position (-> self root trans))
                 (fill-cache-integrate-and-collide! (-> self root) (-> self root transv) (-> self root root-prim collide-with))
                 (set! (-> self old-dist (-> self old-dist-count))
                       (* 0.0625 (vector-vector-distance previous-position (-> self root trans)))))
@@ -744,16 +744,16 @@
   (set! (-> self root dynam gravity y) 1228800.0)
   (set! (-> self root dynam gravity-length) 1228800.0)
   (set! (-> self root dynam gravity-max) 1228800.0)
-  (set! (-> self root trans quad) (-> launch-position quad))
-  (set! (-> self base-trans quad) (-> launch-position quad))
-  (set! (-> self parent-base quad) (-> launch-position quad))
+  (vector-copy! (-> self root trans) launch-position)
+  (vector-copy! (-> self base-trans) launch-position)
+  (vector-copy! (-> self parent-base) launch-position)
   (quaternion-copy! (-> self root quat) (-> (the-as process-drawable (-> self parent 0)) root quat))
   (quaternion-copy! (-> self parent-quat) (-> (the-as process-drawable (-> self parent 0)) root quat))
   (vector-identity! (-> self root scale))
-  (set! (-> self root transv quad) (-> initial-velocity quad))
+  (vector-copy! (-> self root transv) initial-velocity)
   (vector-normalize-copy! (-> self base-vector) initial-velocity 1.0)
   (vector+float*! (-> self target) (-> self root trans) (-> self root transv) 2.0)
-  (set! (-> self target-base quad) (-> self target quad))
+  (vector-copy! (-> self target-base) (-> self target))
   (init-projectile-settings! self)
   (update-projectile-effects! self)
   (when (not (type-type? (-> self type) projectile-blue))
@@ -778,10 +778,10 @@
   (set! (-> this tween) 0.05)
   (logior! (-> this options) 2)
   (let ((launcher-position (new 'stack-no-clear 'vector)))
-    (set! (-> launcher-position quad) (-> this root trans quad))
+    (vector-copy! launcher-position (-> this root trans))
     (+! (-> this root trans y) -5324.8)
     (vector+float*! (-> this target) (-> this root trans) (-> this root transv) 2.0)
-    (set! (-> this target-base quad) (-> this target quad))
+    (vector-copy! (-> this target-base) (-> this target))
     (let ((launch-angle (the float (sar (shl (the int (y-angle (-> this root))) 48) 48))))
       (set! (-> this mask) (the-as process-mask (logior (process-mask projectile) (-> this mask))))
       (if (logtest? (-> this options) 16) (set! (-> this max-hits) 1))
@@ -902,12 +902,12 @@
             (if near-match (set! best-match near-match)))
           (set! (-> this last-target) (process->handle best-match))
           (when best-match
-            (set! (-> this target quad) (-> (the-as collide-shape (-> best-match root)) root-prim prim-core world-sphere quad))
+            (vector-copy! (-> this target) (-> (the-as collide-shape (-> best-match root)) root-prim prim-core world-sphere))
             (if (= (-> best-match type symbol) 'mother-spider) (logand! (-> this options) -2)))))
-       (else (set! (-> this target quad) (-> this target-base quad)))))
+       (else (vector-copy! (-> this target) (-> this target-base)))))
     (else
      (let ((target-process (handle->process (-> this last-target))))
-       (set! (-> this target quad) (-> (the-as target target-process) control root-prim prim-core world-sphere quad)))
+       (vector-copy! (-> this target) (-> (the-as target target-process) control root-prim prim-core world-sphere)))
      (if (and (< (vector-vector-xz-distance (-> this root trans) (-> this target)) 20480.0)
               (< 24576.0 (fabs (- (-> this target y) (-> this root trans y)))))
        (set! (-> this last-target) (the-as handle #f)))))
@@ -926,7 +926,7 @@
   (set! (-> this update-velocity) projectile-update-velocity-space-wars)
   (+! (-> this root trans y) -5324.8)
   (vector+float*! (-> this target) (-> this root trans) (-> this root transv) 2.0)
-  (set! (-> this target-base quad) (-> this target quad))
+  (vector-copy! (-> this target-base) (-> this target))
   (set! (-> this mask) (the-as process-mask (logior (process-mask ambient) (-> this mask))))
   (set! (-> this part) (create-launch-control group-eco-blue this))
   (set! (-> this root root-prim collide-with) (collide-kind background))

goal_src/jak1/engine/geometry/cylinder.gc

@@ -161,12 +161,12 @@
       (let ((origin-cap-fraction (ray-arbitrary-circle-intersect probe-origin probe-displacement (-> this origin) (-> this axis) (-> this radius))))
         (when (and (>= origin-cap-fraction 0.0) (or (< contact-fraction 0.0) (< origin-cap-fraction contact-fraction)))
           (set! contact-fraction origin-cap-fraction)
-          (set! (-> axis-point quad) (-> this origin quad))))
+          (vector-copy! axis-point (-> this origin))))
       (vector+float*! end-center (-> this origin) (-> this axis) (-> this length))
       (let ((end-cap-fraction (ray-arbitrary-circle-intersect probe-origin probe-displacement end-center (-> this axis) (-> this radius))))
         (when (and (>= end-cap-fraction 0.0) (or (< contact-fraction 0.0) (< end-cap-fraction contact-fraction)))
           (set! contact-fraction end-cap-fraction)
-          (set! (-> axis-point quad) (-> end-center quad))))
+          (vector-copy! axis-point end-center)))
       contact-fraction)))
 
 ;; debug draw for cylinder flat.
@@ -211,7 +211,7 @@
           (vector+! (-> vertices vert (+ i 1)) (-> this origin) radial)
           (vector+float*! (-> vertices vert (+ i 1)) (-> vertices vert (+ i 1)) axis-step (the float i))
           (+! i 1))
-        (set! (-> vertices vert 0 quad) (-> this origin quad))
+        (vector-copy! (-> vertices vert 0) (-> this origin))
         (vector+float*! (-> vertices vert 9) (-> this origin) (-> this axis) (-> this length))
         (dotimes (rotation-index 16)
           (dotimes (vertex-index 10)

goal_src/jak1/engine/geometry/geometry.gc

@@ -568,8 +568,8 @@
    copies to's whole quad and so is discontinuous with the interior unless the two magnitudes
    already agree. dst may alias either input."
   (cond
-    ((>= 0.0 t) (set! (-> dst quad) (-> from quad)) dst)
-    ((>= t 1.0) (set! (-> dst quad) (-> to quad)) dst)
+    ((>= 0.0 t) (vector-copy! dst from) dst)
+    ((>= t 1.0) (vector-copy! dst to) dst)
     (else
      (let ((step (new-stack-matrix0)))
        (let ((from-unit (vector-normalize-copy! (new 'stack-no-clear 'vector) from 1.0))
@@ -584,8 +584,8 @@
    the endpoints. dst may alias any input."
   (local-vars (lerp-fn (function float float float float)))
   (cond
-    ((>= 0.0 t) (set! (-> dst quad) (-> from quad)))
-    ((>= t 1.0) (set! (-> dst quad) (-> to quad)))
+    ((>= 0.0 t) (vector-copy! dst from))
+    ((>= t 1.0) (vector-copy! dst to))
     (else
      (let* ((from-unit (vector-normalize-copy! (new 'stack-no-clear 'vector) from 1.0))
             (to-unit (vector-normalize-copy! (new 'stack-no-clear 'vector) to 1.0))
@@ -764,7 +764,7 @@
     (let ((first-distance (vector-segment-distance-point! point (-> triangle vector 1) (the-as vector (-> triangle vector)) dst))
           (second-point (new 'stack-no-clear 'vector)))
       (if (< (vector-segment-distance-point! point (-> triangle vector 1) (-> triangle vector 2) second-point) first-distance)
-        (set! (-> dst quad) (-> second-point quad))))
+        (vector-copy! dst second-point)))
     (goto closest-point-done)
     (label test-edge-20)
     (b! (nonzero? mask-minus-4) test-vertex-0 :delay (set! mask-minus-5 (the-as uint (+ mask-minus-4 -1))))
@@ -775,13 +775,13 @@
     (let ((first-distance (vector-segment-distance-point! point (the-as vector (-> triangle vector)) (-> triangle vector 1) dst))
           (second-point (new 'stack-no-clear 'vector)))
       (if (< (vector-segment-distance-point! point (the-as vector (-> triangle vector)) (-> triangle vector 2) second-point) first-distance)
-        (set! (-> dst quad) (-> second-point quad))))
+        (vector-copy! dst second-point)))
     (goto closest-point-done)
     (label vertex-2-region)
     (let ((first-distance (vector-segment-distance-point! point (-> triangle vector 2) (the-as vector (-> triangle vector)) dst))
           (second-point (new 'stack-no-clear 'vector)))
       (if (< (vector-segment-distance-point! point (-> triangle vector 2) (-> triangle vector 1) second-point) first-distance)
-        (set! (-> dst quad) (-> second-point quad))))
+        (vector-copy! dst second-point)))
     (label closest-point-done)
     0
     (none)))

goal_src/jak1/engine/geometry/path.gc

@@ -98,7 +98,7 @@
       (else
        (format #t "WARNING: method get-random-point called on a path-control object with no vertices.~%")
        (if pp (format #t "current process is ~A~%" (-> pp name)))
-       (set! (-> result quad) (-> *null-vector* quad))))
+       (vector-copy! result *null-vector*)))
     result))
 
 (defmethod eval-path-curve! ((this path-control) (result vector) (percent float) (mode symbol))
@@ -205,12 +205,12 @@
         (closest-distance 4096000000.0)
         (closest-progress 0.0))
     (let ((closest-point (new 'stack-no-clear 'vector)))
-      (set! (-> target-point quad) (-> (target-pos 0) quad))
+      (vector-copy! target-point (target-pos 0))
       (set! (-> target-point y) 0.0)
       (eval-path-curve-div! this segment-end 0.0 'interp)
       (set! (-> segment-end y) 0.0)
       (dotimes (i (+ (-> this curve num-cverts) -1))
-        (set! (-> segment-start quad) (-> segment-end quad))
+        (vector-copy! segment-start segment-end)
         (eval-path-curve-div! this segment-end (the float (+ i 1)) 'interp)
         (set! (-> segment-end y) 0.0)
         (let ((distance (vector-segment-distance-point! target-point segment-start segment-end closest-point)))

goal_src/jak1/engine/gfx/background/prototype.gc

@@ -36,70 +36,41 @@
         (let ((geometry (-> prototype geometry geometry-index))) (if (nonzero? geometry) (login geometry))))))
   this)
 
-(defmethod mem-usage ((this prototype-array-tie) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this prototype-array-tie) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this array in the drawable-group category, then account for every TIE prototype
    it contains."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((array-bytes (asize-of this)))
-    (+! (-> usage data 0 used) array-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ array-bytes 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 (asize-of this))
   (dotimes (i (-> this length))
     (mem-usage (-> this array-data i) usage flags))
   this)
 
-(defmethod mem-usage ((this prototype-bucket-tie) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this prototype-bucket-tie) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this TIE prototype's four populated geometry slots as prototype-owned data, its
    name string, optional time-of-day palette, and optional collision fragments."
   (dotimes (geometry-index 4)
     (let ((geometry (-> this geometry geometry-index)))
-      (if (nonzero? geometry) (mem-usage geometry usage (logior flags 1)))))
-  (set! (-> usage length) (max 81 (-> usage length)))
-  (set! (-> usage data 80 name) "string")
-  (+! (-> usage data 80 count) 1)
-  (let ((name-bytes (asize-of (-> this name))))
-    (+! (-> usage data 80 used) name-bytes)
-    (+! (-> usage data 80 total) (logand -16 (+ name-bytes 15))))
+      (if (nonzero? geometry) (mem-usage geometry usage (logior flags (mem-usage-flags prototype-data))))))
+  (mem-usage-add! usage string 1 (asize-of (-> this name)))
   (when (nonzero? (-> this tie-colors))
-    (set! (-> usage length) (max 17 (-> usage length)))
-    (set! (-> usage data 16 name) "tie-pal")
-    (+! (-> usage data 16 count) 1)
-    (let ((palette-bytes (asize-of (-> this tie-colors))))
-      (+! (-> usage data 16 used) palette-bytes)
-      (+! (-> usage data 16 total) (logand -16 (+ palette-bytes 15)))))
-  (if (nonzero? (-> this collide-frag)) (mem-usage (-> this collide-frag) usage (logior flags 1)))
+    (mem-usage-add! usage tie-pal 1 (asize-of (-> this tie-colors))))
+  (if (nonzero? (-> this collide-frag))
+    (mem-usage (-> this collide-frag) usage (logior flags (mem-usage-flags prototype-data))))
   this)
 
-(defmethod mem-usage ((this prototype-inline-array-shrub) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this prototype-inline-array-shrub) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this inline prototype array in the drawable-group category, then account for
    every shrub prototype it contains."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((array-bytes (asize-of this)))
-    (+! (-> usage data 0 used) array-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ array-bytes 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 (asize-of this))
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   this)
 
-(defmethod mem-usage ((this prototype-bucket-shrub) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this prototype-bucket-shrub) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this 112-byte shrub prototype, its four populated geometry slots as
    prototype-owned data, and its name string."
-  (set! (-> usage length) (max 25 (-> usage length)))
-  (set! (-> usage data 24 name) "prototype-bucket-shrub")
-  (+! (-> usage data 24 count) 1)
-  (let ((prototype-bytes 112))
-    (+! (-> usage data 24 used) prototype-bytes)
-    (+! (-> usage data 24 total) (logand -16 (+ prototype-bytes 15))))
+  (mem-usage-add! usage prototype-bucket-shrub 1 112)
   (dotimes (geometry-index 4)
     (let ((geometry (-> this geometry geometry-index)))
-      (if (nonzero? geometry) (mem-usage geometry usage (logior flags 1)))))
-  (set! (-> usage length) (max 81 (-> usage length)))
-  (set! (-> usage data 80 name) "string")
-  (+! (-> usage data 80 count) 1)
-  (let ((name-bytes (asize-of (-> this name))))
-    (+! (-> usage data 80 used) name-bytes)
-    (+! (-> usage data 80 total) (logand -16 (+ name-bytes 15))))
+      (if (nonzero? geometry) (mem-usage geometry usage (logior flags (mem-usage-flags prototype-data))))))
+  (mem-usage-add! usage string 1 (asize-of (-> this name)))
   this)

goal_src/jak1/engine/gfx/foreground/eye.gc

@@ -647,152 +647,107 @@
   ;; offset at (32, 32) and depth writes off. The alpha test is then set to pass everything, because
   ;; the pupil pass inside render-eyes leaves it configured to fail and each bucket has to start from
   ;; a known state. These three blocks are identical apart from the bucket they land in.
-  (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-         (bucket-start (-> dma-buf base)))
-    (set-display-gs-state-offset dma-buf *eyes-base-page* 64 352 0 0 32 32)
-    (let* ((buf dma-buf)
-           (dma-out (the-as object (-> buf base))))
-      (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
-      (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-      (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
-      (set! (-> buf base) (&+ (the-as pointer dma-out) 16)))
-    (let* ((buf dma-buf)
-           (gif-out (the-as object (-> buf base))))
-      (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
-      (set! (-> (the-as gs-gif-tag gif-out) regs)
-            (new 'static
-                 'gif-tag-regs
-                 :regs0 (gif-reg-id a+d)
-                 :regs1 (gif-reg-id a+d)
-                 :regs2 (gif-reg-id a+d)
-                 :regs3 (gif-reg-id a+d)
-                 :regs4 (gif-reg-id a+d)
-                 :regs5 (gif-reg-id a+d)
-                 :regs6 (gif-reg-id a+d)
-                 :regs7 (gif-reg-id a+d)
-                 :regs8 (gif-reg-id a+d)
-                 :regs9 (gif-reg-id a+d)
-                 :regs10 (gif-reg-id a+d)
-                 :regs11 (gif-reg-id a+d)
-                 :regs12 (gif-reg-id a+d)
-                 :regs13 (gif-reg-id a+d)
-                 :regs14 (gif-reg-id a+d)
-                 :regs15 (gif-reg-id a+d)))
-      (set! (-> buf base) (&+ (the-as pointer gif-out) 16)))
-    (let* ((buf dma-buf)
-           (reg-out (-> buf base)))
-      (set! (-> (the-as (pointer gs-test) reg-out) 0)
-            (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
-      (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 test-1))
-      (set! (-> buf base) (&+ reg-out 16)))
-    (let ((next-tag (-> dma-buf base)))
-      (let ((dma-out (the-as object (-> dma-buf base))))
-        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
+  (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id pris-tex0)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set-display-gs-state-offset dma-buf *eyes-base-page* 64 352 0 0 32 32) (let* ((buf dma-buf)
+             (dma-out (the-as object (-> buf base))))
+        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
         (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buf base) (&+ (the-as pointer dma-out) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id pris-tex0)
-                             bucket-start
-                             (the-as (pointer dma-tag) next-tag))))
+        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
+        (set! (-> buf base) (&+ (the-as pointer dma-out) 16))) (let* ((buf dma-buf)
+             (gif-out (the-as object (-> buf base))))
+        (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
+        (set! (-> (the-as gs-gif-tag gif-out) regs)
+              (new 'static
+                   'gif-tag-regs
+                   :regs0 (gif-reg-id a+d)
+                   :regs1 (gif-reg-id a+d)
+                   :regs2 (gif-reg-id a+d)
+                   :regs3 (gif-reg-id a+d)
+                   :regs4 (gif-reg-id a+d)
+                   :regs5 (gif-reg-id a+d)
+                   :regs6 (gif-reg-id a+d)
+                   :regs7 (gif-reg-id a+d)
+                   :regs8 (gif-reg-id a+d)
+                   :regs9 (gif-reg-id a+d)
+                   :regs10 (gif-reg-id a+d)
+                   :regs11 (gif-reg-id a+d)
+                   :regs12 (gif-reg-id a+d)
+                   :regs13 (gif-reg-id a+d)
+                   :regs14 (gif-reg-id a+d)
+                   :regs15 (gif-reg-id a+d)))
+        (set! (-> buf base) (&+ (the-as pointer gif-out) 16))) (let* ((buf dma-buf)
+             (reg-out (-> buf base)))
+        (set! (-> (the-as (pointer gs-test) reg-out) 0)
+              (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
+        (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 test-1))
+        (set! (-> buf base) (&+ reg-out 16))))
   ;; Setup GS for level 1 eyes
-  (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-         (bucket-start (-> dma-buf base)))
-    (set-display-gs-state-offset dma-buf *eyes-base-page* 64 352 0 0 32 32)
-    (let* ((buf dma-buf)
-           (dma-out (the-as object (-> buf base))))
-      (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
-      (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-      (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
-      (set! (-> buf base) (&+ (the-as pointer dma-out) 16)))
-    (let* ((buf dma-buf)
-           (gif-out (the-as object (-> buf base))))
-      (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
-      (set! (-> (the-as gs-gif-tag gif-out) regs)
-            (new 'static
-                 'gif-tag-regs
-                 :regs0 (gif-reg-id a+d)
-                 :regs1 (gif-reg-id a+d)
-                 :regs2 (gif-reg-id a+d)
-                 :regs3 (gif-reg-id a+d)
-                 :regs4 (gif-reg-id a+d)
-                 :regs5 (gif-reg-id a+d)
-                 :regs6 (gif-reg-id a+d)
-                 :regs7 (gif-reg-id a+d)
-                 :regs8 (gif-reg-id a+d)
-                 :regs9 (gif-reg-id a+d)
-                 :regs10 (gif-reg-id a+d)
-                 :regs11 (gif-reg-id a+d)
-                 :regs12 (gif-reg-id a+d)
-                 :regs13 (gif-reg-id a+d)
-                 :regs14 (gif-reg-id a+d)
-                 :regs15 (gif-reg-id a+d)))
-      (set! (-> buf base) (&+ (the-as pointer gif-out) 16)))
-    (let* ((buf dma-buf)
-           (reg-out (-> buf base)))
-      (set! (-> (the-as (pointer gs-test) reg-out) 0)
-            (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
-      (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 test-1))
-      (set! (-> buf base) (&+ reg-out 16)))
-    (let ((next-tag (-> dma-buf base)))
-      (let ((dma-out (the-as object (-> dma-buf base))))
-        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
+  (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id pris-tex1)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set-display-gs-state-offset dma-buf *eyes-base-page* 64 352 0 0 32 32) (let* ((buf dma-buf)
+             (dma-out (the-as object (-> buf base))))
+        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
         (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buf base) (&+ (the-as pointer dma-out) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id pris-tex1)
-                             bucket-start
-                             (the-as (pointer dma-tag) next-tag))))
+        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
+        (set! (-> buf base) (&+ (the-as pointer dma-out) 16))) (let* ((buf dma-buf)
+             (gif-out (the-as object (-> buf base))))
+        (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
+        (set! (-> (the-as gs-gif-tag gif-out) regs)
+              (new 'static
+                   'gif-tag-regs
+                   :regs0 (gif-reg-id a+d)
+                   :regs1 (gif-reg-id a+d)
+                   :regs2 (gif-reg-id a+d)
+                   :regs3 (gif-reg-id a+d)
+                   :regs4 (gif-reg-id a+d)
+                   :regs5 (gif-reg-id a+d)
+                   :regs6 (gif-reg-id a+d)
+                   :regs7 (gif-reg-id a+d)
+                   :regs8 (gif-reg-id a+d)
+                   :regs9 (gif-reg-id a+d)
+                   :regs10 (gif-reg-id a+d)
+                   :regs11 (gif-reg-id a+d)
+                   :regs12 (gif-reg-id a+d)
+                   :regs13 (gif-reg-id a+d)
+                   :regs14 (gif-reg-id a+d)
+                   :regs15 (gif-reg-id a+d)))
+        (set! (-> buf base) (&+ (the-as pointer gif-out) 16))) (let* ((buf dma-buf)
+             (reg-out (-> buf base)))
+        (set! (-> (the-as (pointer gs-test) reg-out) 0)
+              (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
+        (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 test-1))
+        (set! (-> buf base) (&+ reg-out 16))))
   ;; Setup GS for common eyes
-  (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-         (bucket-start (-> dma-buf base)))
-    (set-display-gs-state-offset dma-buf *eyes-base-page* 64 352 0 0 32 32)
-    (let* ((buf dma-buf)
-           (dma-out (the-as object (-> buf base))))
-      (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
-      (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-      (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
-      (set! (-> buf base) (&+ (the-as pointer dma-out) 16)))
-    (let* ((buf dma-buf)
-           (gif-out (the-as object (-> buf base))))
-      (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
-      (set! (-> (the-as gs-gif-tag gif-out) regs)
-            (new 'static
-                 'gif-tag-regs
-                 :regs0 (gif-reg-id a+d)
-                 :regs1 (gif-reg-id a+d)
-                 :regs2 (gif-reg-id a+d)
-                 :regs3 (gif-reg-id a+d)
-                 :regs4 (gif-reg-id a+d)
-                 :regs5 (gif-reg-id a+d)
-                 :regs6 (gif-reg-id a+d)
-                 :regs7 (gif-reg-id a+d)
-                 :regs8 (gif-reg-id a+d)
-                 :regs9 (gif-reg-id a+d)
-                 :regs10 (gif-reg-id a+d)
-                 :regs11 (gif-reg-id a+d)
-                 :regs12 (gif-reg-id a+d)
-                 :regs13 (gif-reg-id a+d)
-                 :regs14 (gif-reg-id a+d)
-                 :regs15 (gif-reg-id a+d)))
-      (set! (-> buf base) (&+ (the-as pointer gif-out) 16)))
-    (let* ((buf dma-buf)
-           (reg-out (-> buf base)))
-      (set! (-> (the-as (pointer gs-test) reg-out) 0)
-            (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
-      (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 test-1))
-      (set! (-> buf base) (&+ reg-out 16)))
-    (let ((next-tag (-> dma-buf base)))
-      (let ((dma-out (the-as object (-> dma-buf base))))
-        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
+  (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id eyes)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set-display-gs-state-offset dma-buf *eyes-base-page* 64 352 0 0 32 32) (let* ((buf dma-buf)
+             (dma-out (the-as object (-> buf base))))
+        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
         (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buf base) (&+ (the-as pointer dma-out) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id eyes)
-                             bucket-start
-                             (the-as (pointer dma-tag) next-tag))))
+        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
+        (set! (-> buf base) (&+ (the-as pointer dma-out) 16))) (let* ((buf dma-buf)
+             (gif-out (the-as object (-> buf base))))
+        (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
+        (set! (-> (the-as gs-gif-tag gif-out) regs)
+              (new 'static
+                   'gif-tag-regs
+                   :regs0 (gif-reg-id a+d)
+                   :regs1 (gif-reg-id a+d)
+                   :regs2 (gif-reg-id a+d)
+                   :regs3 (gif-reg-id a+d)
+                   :regs4 (gif-reg-id a+d)
+                   :regs5 (gif-reg-id a+d)
+                   :regs6 (gif-reg-id a+d)
+                   :regs7 (gif-reg-id a+d)
+                   :regs8 (gif-reg-id a+d)
+                   :regs9 (gif-reg-id a+d)
+                   :regs10 (gif-reg-id a+d)
+                   :regs11 (gif-reg-id a+d)
+                   :regs12 (gif-reg-id a+d)
+                   :regs13 (gif-reg-id a+d)
+                   :regs14 (gif-reg-id a+d)
+                   :regs15 (gif-reg-id a+d)))
+        (set! (-> buf base) (&+ (the-as pointer gif-out) 16))) (let* ((buf dma-buf)
+             (reg-out (-> buf base)))
+        (set! (-> (the-as (pointer gs-test) reg-out) 0)
+              (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
+        (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 test-1))
+        (set! (-> buf base) (&+ reg-out 16))))
   ;; rendering of eyes.
   (dotimes (slot 11)
     ;; grab the eye and the process
@@ -835,177 +790,108 @@
           (cond
             ((>= (the-as uint 1) (-> ctrl level))
              ;; level eyes
-             (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                    (bucket-start (-> dma-buf base)))
-               (render-eyes dma-buf ctrl slot)
-               (let ((next-tag (-> dma-buf base)))
-                 (let ((dma-out (the-as object (-> dma-buf base))))
-                   (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                   (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-                   (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag))
-                   (set! (-> dma-buf base) (&+ (the-as pointer dma-out) 16)))
-                 (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                        (the-as bucket-id (if (zero? (-> ctrl level)) (bucket-id pris-tex0) (bucket-id pris-tex1)))
-                                        bucket-start
-                                        (the-as (pointer dma-tag) next-tag)))))
+             (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (the-as bucket-id (if (zero? (-> ctrl level)) (bucket-id pris-tex0) (bucket-id pris-tex1)))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (render-eyes dma-buf ctrl slot)))
             (else
-             (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                    (bucket-start (-> dma-buf base)))
-               (render-eyes dma-buf ctrl slot)
-               (let ((next-tag (-> dma-buf base)))
-                 (let ((dma-out (the-as object (-> dma-buf base))))
-                   (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                   (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-                   (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag))
-                   (set! (-> dma-buf base) (&+ (the-as pointer dma-out) 16)))
-                 (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                        (bucket-id eyes)
-                                        bucket-start
-                                        (the-as (pointer dma-tag) next-tag))))))))))
+             (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id eyes)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (render-eyes dma-buf ctrl slot))))))))
   ;; Restore the game framebuffer at the tail of each of the same three buckets. reset-display-gs-state
   ;; does not touch ALPHA_1, which the eyelid pass repointed, so the ordinary source-over equation is
   ;; written back by hand. These three blocks are identical apart from the bucket.
-  (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-         (bucket-start (-> dma-buf base)))
-    (reset-display-gs-state *display* dma-buf *oddeven*)
-    (let* ((buf dma-buf)
-           (dma-out (the-as object (-> buf base))))
-      (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
-      (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-      (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
-      (set! (-> buf base) (&+ (the-as pointer dma-out) 16)))
-    (let* ((buf dma-buf)
-           (gif-out (the-as object (-> buf base))))
-      (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
-      (set! (-> (the-as gs-gif-tag gif-out) regs)
-            (new 'static
-                 'gif-tag-regs
-                 :regs0 (gif-reg-id a+d)
-                 :regs1 (gif-reg-id a+d)
-                 :regs2 (gif-reg-id a+d)
-                 :regs3 (gif-reg-id a+d)
-                 :regs4 (gif-reg-id a+d)
-                 :regs5 (gif-reg-id a+d)
-                 :regs6 (gif-reg-id a+d)
-                 :regs7 (gif-reg-id a+d)
-                 :regs8 (gif-reg-id a+d)
-                 :regs9 (gif-reg-id a+d)
-                 :regs10 (gif-reg-id a+d)
-                 :regs11 (gif-reg-id a+d)
-                 :regs12 (gif-reg-id a+d)
-                 :regs13 (gif-reg-id a+d)
-                 :regs14 (gif-reg-id a+d)
-                 :regs15 (gif-reg-id a+d)))
-      (set! (-> buf base) (&+ (the-as pointer gif-out) 16)))
-    (let* ((buf dma-buf)
-           (reg-out (-> buf base)))
-      (set! (-> (the-as (pointer gs-alpha) reg-out) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
-      (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 alpha-1))
-      (set! (-> buf base) (&+ reg-out 16)))
-    (let ((next-tag (-> dma-buf base)))
-      (let ((dma-out (the-as object (-> dma-buf base))))
-        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
+  (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id pris-tex0)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (reset-display-gs-state *display* dma-buf *oddeven*) (let* ((buf dma-buf)
+             (dma-out (the-as object (-> buf base))))
+        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
         (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buf base) (&+ (the-as pointer dma-out) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id pris-tex0)
-                             bucket-start
-                             (the-as (pointer dma-tag) next-tag))))
-  (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-         (bucket-start (-> dma-buf base)))
-    (reset-display-gs-state *display* dma-buf *oddeven*)
-    (let* ((buf dma-buf)
-           (dma-out (the-as object (-> buf base))))
-      (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
-      (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-      (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
-      (set! (-> buf base) (&+ (the-as pointer dma-out) 16)))
-    (let* ((buf dma-buf)
-           (gif-out (the-as object (-> buf base))))
-      (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
-      (set! (-> (the-as gs-gif-tag gif-out) regs)
-            (new 'static
-                 'gif-tag-regs
-                 :regs0 (gif-reg-id a+d)
-                 :regs1 (gif-reg-id a+d)
-                 :regs2 (gif-reg-id a+d)
-                 :regs3 (gif-reg-id a+d)
-                 :regs4 (gif-reg-id a+d)
-                 :regs5 (gif-reg-id a+d)
-                 :regs6 (gif-reg-id a+d)
-                 :regs7 (gif-reg-id a+d)
-                 :regs8 (gif-reg-id a+d)
-                 :regs9 (gif-reg-id a+d)
-                 :regs10 (gif-reg-id a+d)
-                 :regs11 (gif-reg-id a+d)
-                 :regs12 (gif-reg-id a+d)
-                 :regs13 (gif-reg-id a+d)
-                 :regs14 (gif-reg-id a+d)
-                 :regs15 (gif-reg-id a+d)))
-      (set! (-> buf base) (&+ (the-as pointer gif-out) 16)))
-    (let* ((buf dma-buf)
-           (reg-out (-> buf base)))
-      (set! (-> (the-as (pointer gs-alpha) reg-out) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
-      (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 alpha-1))
-      (set! (-> buf base) (&+ reg-out 16)))
-    (let ((next-tag (-> dma-buf base)))
-      (let ((dma-out (the-as object (-> dma-buf base))))
-        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
+        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
+        (set! (-> buf base) (&+ (the-as pointer dma-out) 16))) (let* ((buf dma-buf)
+             (gif-out (the-as object (-> buf base))))
+        (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
+        (set! (-> (the-as gs-gif-tag gif-out) regs)
+              (new 'static
+                   'gif-tag-regs
+                   :regs0 (gif-reg-id a+d)
+                   :regs1 (gif-reg-id a+d)
+                   :regs2 (gif-reg-id a+d)
+                   :regs3 (gif-reg-id a+d)
+                   :regs4 (gif-reg-id a+d)
+                   :regs5 (gif-reg-id a+d)
+                   :regs6 (gif-reg-id a+d)
+                   :regs7 (gif-reg-id a+d)
+                   :regs8 (gif-reg-id a+d)
+                   :regs9 (gif-reg-id a+d)
+                   :regs10 (gif-reg-id a+d)
+                   :regs11 (gif-reg-id a+d)
+                   :regs12 (gif-reg-id a+d)
+                   :regs13 (gif-reg-id a+d)
+                   :regs14 (gif-reg-id a+d)
+                   :regs15 (gif-reg-id a+d)))
+        (set! (-> buf base) (&+ (the-as pointer gif-out) 16))) (let* ((buf dma-buf)
+             (reg-out (-> buf base)))
+        (set! (-> (the-as (pointer gs-alpha) reg-out) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
+        (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 alpha-1))
+        (set! (-> buf base) (&+ reg-out 16))))
+  (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id pris-tex1)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (reset-display-gs-state *display* dma-buf *oddeven*) (let* ((buf dma-buf)
+             (dma-out (the-as object (-> buf base))))
+        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
         (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buf base) (&+ (the-as pointer dma-out) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id pris-tex1)
-                             bucket-start
-                             (the-as (pointer dma-tag) next-tag))))
-  (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-         (bucket-start (-> dma-buf base)))
-    (reset-display-gs-state *display* dma-buf *oddeven*)
-    (let* ((buf dma-buf)
-           (dma-out (the-as object (-> buf base))))
-      (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
-      (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-      (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
-      (set! (-> buf base) (&+ (the-as pointer dma-out) 16)))
-    (let* ((buf dma-buf)
-           (gif-out (the-as object (-> buf base))))
-      (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
-      (set! (-> (the-as gs-gif-tag gif-out) regs)
-            (new 'static
-                 'gif-tag-regs
-                 :regs0 (gif-reg-id a+d)
-                 :regs1 (gif-reg-id a+d)
-                 :regs2 (gif-reg-id a+d)
-                 :regs3 (gif-reg-id a+d)
-                 :regs4 (gif-reg-id a+d)
-                 :regs5 (gif-reg-id a+d)
-                 :regs6 (gif-reg-id a+d)
-                 :regs7 (gif-reg-id a+d)
-                 :regs8 (gif-reg-id a+d)
-                 :regs9 (gif-reg-id a+d)
-                 :regs10 (gif-reg-id a+d)
-                 :regs11 (gif-reg-id a+d)
-                 :regs12 (gif-reg-id a+d)
-                 :regs13 (gif-reg-id a+d)
-                 :regs14 (gif-reg-id a+d)
-                 :regs15 (gif-reg-id a+d)))
-      (set! (-> buf base) (&+ (the-as pointer gif-out) 16)))
-    (let* ((buf dma-buf)
-           (reg-out (-> buf base)))
-      (set! (-> (the-as (pointer gs-alpha) reg-out) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
-      (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 alpha-1))
-      (set! (-> buf base) (&+ reg-out 16)))
-    (let ((next-tag (-> dma-buf base)))
-      (let ((dma-out (the-as object (-> dma-buf base))))
-        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
+        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
+        (set! (-> buf base) (&+ (the-as pointer dma-out) 16))) (let* ((buf dma-buf)
+             (gif-out (the-as object (-> buf base))))
+        (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
+        (set! (-> (the-as gs-gif-tag gif-out) regs)
+              (new 'static
+                   'gif-tag-regs
+                   :regs0 (gif-reg-id a+d)
+                   :regs1 (gif-reg-id a+d)
+                   :regs2 (gif-reg-id a+d)
+                   :regs3 (gif-reg-id a+d)
+                   :regs4 (gif-reg-id a+d)
+                   :regs5 (gif-reg-id a+d)
+                   :regs6 (gif-reg-id a+d)
+                   :regs7 (gif-reg-id a+d)
+                   :regs8 (gif-reg-id a+d)
+                   :regs9 (gif-reg-id a+d)
+                   :regs10 (gif-reg-id a+d)
+                   :regs11 (gif-reg-id a+d)
+                   :regs12 (gif-reg-id a+d)
+                   :regs13 (gif-reg-id a+d)
+                   :regs14 (gif-reg-id a+d)
+                   :regs15 (gif-reg-id a+d)))
+        (set! (-> buf base) (&+ (the-as pointer gif-out) 16))) (let* ((buf dma-buf)
+             (reg-out (-> buf base)))
+        (set! (-> (the-as (pointer gs-alpha) reg-out) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
+        (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 alpha-1))
+        (set! (-> buf base) (&+ reg-out 16))))
+  (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id eyes)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (reset-display-gs-state *display* dma-buf *oddeven*) (let* ((buf dma-buf)
+             (dma-out (the-as object (-> buf base))))
+        (set! (-> (the-as dma-packet dma-out) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
         (set! (-> (the-as dma-packet dma-out) vif0) (new 'static 'vif-tag))
-        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag))
-        (set! (-> dma-buf base) (&+ (the-as pointer dma-out) 16)))
-      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                             (bucket-id eyes)
-                             bucket-start
-                             (the-as (pointer dma-tag) next-tag))))
+        (set! (-> (the-as dma-packet dma-out) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
+        (set! (-> buf base) (&+ (the-as pointer dma-out) 16))) (let* ((buf dma-buf)
+             (gif-out (the-as object (-> buf base))))
+        (set! (-> (the-as gs-gif-tag gif-out) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
+        (set! (-> (the-as gs-gif-tag gif-out) regs)
+              (new 'static
+                   'gif-tag-regs
+                   :regs0 (gif-reg-id a+d)
+                   :regs1 (gif-reg-id a+d)
+                   :regs2 (gif-reg-id a+d)
+                   :regs3 (gif-reg-id a+d)
+                   :regs4 (gif-reg-id a+d)
+                   :regs5 (gif-reg-id a+d)
+                   :regs6 (gif-reg-id a+d)
+                   :regs7 (gif-reg-id a+d)
+                   :regs8 (gif-reg-id a+d)
+                   :regs9 (gif-reg-id a+d)
+                   :regs10 (gif-reg-id a+d)
+                   :regs11 (gif-reg-id a+d)
+                   :regs12 (gif-reg-id a+d)
+                   :regs13 (gif-reg-id a+d)
+                   :regs14 (gif-reg-id a+d)
+                   :regs15 (gif-reg-id a+d)))
+        (set! (-> buf base) (&+ (the-as pointer gif-out) 16))) (let* ((buf dma-buf)
+             (reg-out (-> buf base)))
+        (set! (-> (the-as (pointer gs-alpha) reg-out) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
+        (set! (-> (the-as (pointer gs-reg64) reg-out) 1) (gs-reg64 alpha-1))
+        (set! (-> buf base) (&+ reg-out 16))))
   0
   (none))
 

goal_src/jak1/engine/gfx/generic/generic-effect.gc

@@ -183,19 +183,13 @@
    sink. The Generic VU0 block is loaded at program address zero."
   (upload-vu0-program generic-vu0-block (the-as pointer #x70000064))
   (let (;(a2-0 (+ #x2e20 (the-as int (the-as terrain-context #x70000000))))
-        (work-matrix (-> (scratchpad-object terrain-context) work foreground generic-work fx-buf work consts matrix))
-        (right (-> camera-transform vector 0 quad))
-        (up (-> camera-transform vector 1 quad))
-        (forward (-> camera-transform vector 2 quad))
-        (translation (-> camera-transform vector 3 quad)))
+        (work-matrix (-> (scratchpad-object terrain-context) work foreground generic-work fx-buf work consts matrix)))
     ;;(set! (-> (the-as (pointer uint128) work-matrix)) right)
-    (set! (-> work-matrix vector 0 quad) right)
+    (matrix-copy! work-matrix camera-transform)
     ;;(s.q! (+ work-matrix 16) up)
-    (set! (-> work-matrix vector 1 quad) up)
     ;; (s.q! (+ work-matrix 32) forward)
-    (set! (-> work-matrix vector 2 quad) forward)
     ;;(s.q! (+ work-matrix 48) translation)
-    (set! (-> work-matrix vector 3 quad) translation))
+    )
   (if lights
     ;;(quad-copy! (the-as pointer (+ #x3190 #x70000000)) (the-as pointer lights) 7)
     (quad-copy! (the pointer (-> (scratchpad-object terrain-context) work foreground generic-work fx-buf work lights))
@@ -210,15 +204,7 @@
   (generic-work-init sink)
   (generic-upload-vu0)
   ;;(let ((a2-1 (+ #x2e20 (the-as int #x70000000)))
-  (let ((work-matrix (-> (scratchpad-object terrain-context) work foreground generic-work fx-buf work consts matrix))
-        (right (-> camera-transform vector 0 quad))
-        (up (-> camera-transform vector 1 quad))
-        (forward (-> camera-transform vector 2 quad))
-        (translation (-> camera-transform vector 3 quad)))
-    (set! (-> work-matrix vector 0 quad) right)
-    (set! (-> work-matrix vector 1 quad) up)
-    (set! (-> work-matrix vector 2 quad) forward)
-    (set! (-> work-matrix vector 3 quad) translation))
+  (matrix-copy! (-> (scratchpad-object terrain-context) work foreground generic-work fx-buf work consts matrix) camera-transform)
   (if lights
     (quad-copy! (the-as pointer (-> (scratchpad-object terrain-context) work foreground generic-work fx-buf work lights))
                 (the-as pointer lights)

goal_src/jak1/engine/gfx/generic/generic-merc.gc

@@ -3309,44 +3309,29 @@
         (set! *merc-globals* (-> *merc-global-array* globals i))
         (let ((sink (-> *merc-globals* sink)))
           (when (nonzero? (-> *merc-globals* first))
-            (let* ((global-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                   (chain-start (-> global-buf base)))
-              (generic-work-init sink)
-              (set! (-> (scratchpad-object terrain-context) work foreground generic-work saves basep)
-                    (the-as uint (-> global-buf base)))
-              (generic-merc-execute-asm)
-              (set! (-> global-buf base)
-                    (the-as pointer
-                            (-> (scratchpad-object terrain-context) work foreground generic-work saves basep)))
-              ;; todo: this part might be important...
-              ; (let ((v1-36 (the-as object #x1000d000))
-              ;       (a0-19 (the-as object #x7000006c))
-              ;       )
-              ;   (b! (zero? (logand (-> (the-as terrain-context v1-36) bsp lev-index) 256)) cfg-9 :delay (nop!))
-              ;   (let ((a1-6 (-> (the-as generic-envmap-saves a0-19) index-mask x)))
-              ;     (nop!)
-              ;     (let ((a2-1 (-> (the-as (pointer int32) v1-36) 0)))
-              ;       (nop!)
-              ;       (let ((a2-2 (logand a2-1 256))
-              ;             (a1-7 (+ a1-6 1))
-              ;             )
-              ;         (b! (nonzero? a2-2) cfg-8 :delay (s.w! (the-as int a0-19) a1-7))
-              ;         )
-              ;       )
-              ;     )
-              ;   )
-              ; (label cfg-9)
-              ; 0
-              (let ((chain-tail (-> global-buf base)))
-                (let ((next-tag (the-as dma-packet (-> global-buf base))))
-                  (set! (-> next-tag dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                  (set! (-> next-tag vif0) (new 'static 'vif-tag))
-                  (set! (-> next-tag vif1) (new 'static 'vif-tag))
-                  (set! (-> global-buf base) (&+ (the-as pointer next-tag) 16)))
-                (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                       (-> sink bucket)
-                                       chain-start
-                                       (the-as (pointer dma-tag) chain-tail))))
+            ;; todo: this part might be important...
+            ; (let ((v1-36 (the-as object #x1000d000))
+            ;       (a0-19 (the-as object #x7000006c))
+            ;       )
+            ;   (b! (zero? (logand (-> (the-as terrain-context v1-36) bsp lev-index) 256)) cfg-9 :delay (nop!))
+            ;   (let ((a1-6 (-> (the-as generic-envmap-saves a0-19) index-mask x)))
+            ;     (nop!)
+            ;     (let ((a2-1 (-> (the-as (pointer int32) v1-36) 0)))
+            ;       (nop!)
+            ;       (let ((a2-2 (logand a2-1 256))
+            ;             (a1-7 (+ a1-6 1))
+            ;             )
+            ;         (b! (nonzero? a2-2) cfg-8 :delay (s.w! (the-as int a0-19) a1-7))
+            ;         )
+            ;       )
+            ;     )
+            ;   )
+            ; (label cfg-9)
+            ; 0
+            (with-dma-buffer-add-bucket ((global-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (-> sink bucket)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (generic-work-init sink) (set! (-> (scratchpad-object terrain-context) work foreground generic-work saves basep)
+                                (the-as uint (-> global-buf base))) (generic-merc-execute-asm) (set! (-> global-buf base)
+                                (the-as pointer
+                                        (-> (scratchpad-object terrain-context) work foreground generic-work saves basep))))
             ; (let ((v1-44 (-> dma-buf base)))
             ;   (.sync.l)
             ;   (.cache dxwbin v1-44 0)

goal_src/jak1/engine/gfx/generic/generic-vu1.gc

@@ -1345,10 +1345,10 @@
                   :abe alpha-blend)))
   (set! (-> constants giftag regs)
         (new 'static 'gif-tag-regs :regs0 (gif-reg-id st) :regs1 (gif-reg-id rgbaq) :regs2 (gif-reg-id xyzf2)))
-  (set! (-> constants hvdf-offset quad) (-> *math-camera* hvdf-off quad))
-  (set! (-> constants hmge-scale quad) (-> *math-camera* hmge-scale quad))
-  (set! (-> constants invh-scale quad) (-> *math-camera* inv-hmge-scale quad))
-  (set! (-> constants guard quad) (-> *math-camera* guard quad))
+  (vector-copy! (-> constants hvdf-offset) (-> *math-camera* hvdf-off))
+  (vector-copy! (-> constants hmge-scale) (-> *math-camera* hmge-scale))
+  (vector-copy! (-> constants invh-scale) (-> *math-camera* inv-hmge-scale))
+  (vector-copy! (-> constants guard) (-> *math-camera* guard))
   (set! (-> constants adnop dword 0) (the-as uint #x5026b))
   (set! (-> constants adnop dword 1) (the-as uint 71))
   (set! (-> constants flush dword 0) (the-as uint #x3f80000080808080))

goal_src/jak1/engine/gfx/math-camera.gc

@@ -215,7 +215,7 @@
           (set-vector! (-> math-cam sprite-2d vector 1) 0.0 (- (* (/ persp-yy persp-xx) persp-x)) 0.0 0.0)
           (set-vector! (-> math-cam sprite-2d vector 2) 0.0 0.0 (- persp-x) 0.0)
           (set-vector! (-> math-cam sprite-2d vector 3) 0.0 0.0 (* 500000000.0 persp-x) (* 60.0 persp-x (-> math-cam pfog0))))
-        (set! (-> math-cam sprite-2d-hvdf quad) (-> math-cam hvdf-off quad))
+        (vector-copy! (-> math-cam sprite-2d-hvdf) (-> math-cam hvdf-off))
         (set! (-> math-cam sprite-2d-hvdf x) 2048.0)
         (set! (-> math-cam sprite-2d-hvdf y) 2048.0)
         (set! (-> math-cam sprite-2d-hvdf z) (-> math-cam hvdf-off z))

goal_src/jak1/engine/gfx/merc/merc.gc

@@ -118,7 +118,7 @@
     (inspect (-> this effect effect-index)))
   this)
 
-(defmethod mem-usage ((this merc-ctrl) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this merc-ctrl) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the base art data, packed fragment control and geometry, blend targets, and eye
    animation owned by this MERC asset."
   ;; do extra
@@ -135,11 +135,7 @@
                    (* (-> fctrl fp-qwc) 16)
                    (asize-of fctrl)))
           (set! fctrl (the-as merc-fragment-control (&+ (the-as pointer fctrl) (asize-of fctrl)))))))
-    (set! (-> usage length) (max 76 (-> usage length)))
-    (set! (-> usage data 75 name) "merc-ctrl")
-    (+! (-> usage data 75 count) 1)
-    (+! (-> usage data 75 used) ctrl-mem)
-    (+! (-> usage data 75 total) (logand -16 (+ ctrl-mem 15))))
+    (mem-usage-add! usage merc-ctrl 1 ctrl-mem))
   ;; do effect blend shapes
   (let ((effect-mem 0))
     (dotimes (effect-idx2 (the-as int (-> this header effect-count)))
@@ -153,20 +149,11 @@
               (set! effect-mem (the-as int (+ (-> this header blend-target-count) 2 size-through-target-data))))
             (set! bctrl (the-as merc-blend-ctrl (&+ (the-as pointer bctrl) (+ (-> this header blend-target-count) 2))))))))
     (when (nonzero? effect-mem)
-      (set! (-> usage length) (max 78 (-> usage length)))
-      (set! (-> usage data 77 name) "blend-shape")
-      (+! (-> usage data 77 count) 1)
-      (+! (-> usage data 77 used) effect-mem)
-      (+! (-> usage data 77 total) (logand -16 (+ effect-mem 15)))))
+      (mem-usage-add! usage blend-shape 1 effect-mem)))
   ;; do eyes.
   (when (nonzero? (-> this header eye-ctrl))
     (let ((eye-ctrl (-> this header eye-ctrl)))
-      (set! (-> usage length) (max 109 (-> usage length)))
-      (set! (-> usage data 108 name) "eye-anim")
-      (+! (-> usage data 108 count) 1)
-      (let ((eye-bytes (asize-of eye-ctrl)))
-        (+! (-> usage data 108 used) eye-bytes)
-        (+! (-> usage data 108 total) (logand -16 (+ eye-bytes 15))))))
+      (mem-usage-add! usage eye-anim 1 (asize-of eye-ctrl))))
   this)
 
 (defmethod login ((this merc-ctrl))
@@ -315,7 +302,7 @@
       (set! (-> low-memory tri-strip-gif word 3) (shr (make-u128 0 (shl #x303e4000 32)) 32))
       (set! (-> low-memory ad-gif tag) (new 'static 'gif-tag64 :nloop #x5 :nreg #x1))
       (set! (-> low-memory ad-gif regs) (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)))
-      (set! (-> low-memory hvdf-offset quad) (-> *math-camera* hvdf-off quad))
+      (vector-copy! (-> low-memory hvdf-offset) (-> *math-camera* hvdf-off))
       (quad-copy! (-> low-memory perspective) (the-as pointer (-> *math-camera* perspective)) 4)
       (set-vector! (-> low-memory fog) (-> *math-camera* pfog0) (-> *math-camera* fog-min) (-> *math-camera* fog-max) 0.0))
     ;; Run the per-frame initialization entry after the constants arrive.

goal_src/jak1/engine/gfx/mood/mood.gc

@@ -18,7 +18,7 @@
 
 (defun update-light-kit ((group light-group) (source-light light) (level float))
   "Copy source-light's color into group's ambient light and apply level to its intensity."
-  (set! (-> group ambi color quad) (-> source-light color quad))
+  (vector-copy! (-> group ambi color) (-> source-light color))
   (set! (-> group ambi levels x) (* (-> source-light levels x) level))
   (none))
 
@@ -264,7 +264,7 @@
     (set! (-> context current-prt-color w)
           (* 0.5 (+ (-> ambient-color w) (* 0.5 (+ (-> ambient-color w) (-> directional-color w)))))))
   (let ((shadow-color (-> context current-shadow-color)))
-    (set! (-> shadow-color quad) (-> context current-prt-color quad))
+    (vector-copy! shadow-color (-> context current-prt-color))
     shadow-color))
 
 (defun update-mood-palette ((context mood-context) (hour float) (level-index int))
@@ -291,10 +291,10 @@
       ((= snapshot-a-index snapshot-b-index)
        (let ((snapshot (-> context mood-lights-table data snapshot-a-index)))
          (set! (-> context times snapshot-a-index w) 1.0)
-         (set! (-> context current-prt-color quad) (-> snapshot prt-color quad))
+         (vector-copy! (-> context current-prt-color) (-> snapshot prt-color))
          (set! (-> groups 0 ambi color quad) (-> snapshot amb-color quad))
          (set! (-> groups 0 ambi levels x) 1.0)
-         (set! (-> context current-shadow quad) (-> snapshot shadow quad))
+         (vector-copy! (-> context current-shadow) (-> snapshot shadow))
          (let ((color-level (+ (* 2.0 (-> snapshot lgt-color x)) (* 4.0 (-> snapshot lgt-color y)) (-> snapshot lgt-color z))))
            (set! (-> groups 0 dir0 direction quad) (-> snapshot direction quad))
            (set! (-> groups 0 dir0 color quad) (-> snapshot lgt-color quad))
@@ -352,7 +352,7 @@
     (cond
       ((= snapshot-a-index snapshot-b-index)
        (set! (-> context sky-times snapshot-a-index) 1.0)
-       (set! (-> context current-sun sun-color quad) (-> context mood-sun-table data snapshot-a-index sun-color quad))
+       (vector-copy! (-> context current-sun sun-color) (-> context mood-sun-table data snapshot-a-index sun-color))
        (let ((environment-color (-> context current-sun env-color)))
          (set! (-> environment-color quad)
                (-> (the-as (pointer uint128) (+ (the-as uint (-> context mood-sun-table data 0 env-color)) (* snapshot-a-index 32)))))
@@ -394,14 +394,14 @@
    sky-index, and light-index select their respective tables; level-index selects the active
    level's time-of-day mask."
   (let ((groups (-> context light-group)))
-    (set! (-> context current-fog fog-color quad) (-> context mood-fog-table data fog-index fog-color quad))
+    (vector-copy! (-> context current-fog fog-color) (-> context mood-fog-table data fog-index fog-color))
     (set! (-> context current-fog fog-dists quad)
           (-> (the-as (pointer uint128) (+ (the-as uint (-> context mood-fog-table data 0 fog-dists)) (* 48 fog-index)))))
     (set! (-> context current-fog erase-color quad)
           (-> (the-as (pointer uint128) (+ (the-as uint (-> context mood-fog-table data 0 erase-color)) (* 48 fog-index)))))
     (set! (-> context current-prt-color quad)
           (-> (the-as (pointer uint128) (+ (the-as uint (-> context mood-lights-table data 0 prt-color)) (* 80 light-index)))))
-    (set! (-> context current-sun sun-color quad) (-> context mood-sun-table data sky-index sun-color quad))
+    (vector-copy! (-> context current-sun sun-color) (-> context mood-sun-table data sky-index sun-color))
     (set! (-> context current-sun env-color quad)
           (-> (the-as (pointer uint128) (+ (the-as uint (-> context mood-sun-table data 0 env-color)) (* sky-index 32)))))
     (set! (-> context current-shadow quad)
@@ -429,24 +429,24 @@
    writing result. Exact endpoints are copied directly."
   (cond
     ((= blend 0.0)
-     (set! (-> result current-fog fog-color quad) (-> context-a current-fog fog-color quad))
-     (set! (-> result current-fog fog-dists quad) (-> context-a current-fog fog-dists quad))
-     (set! (-> result current-fog erase-color quad) (-> context-a current-fog erase-color quad))
-     (set! (-> result current-prt-color quad) (-> context-a current-prt-color quad))
-     (set! (-> result current-sun sun-color quad) (-> context-a current-sun sun-color quad))
-     (set! (-> result current-sun env-color quad) (-> context-a current-sun env-color quad))
-     (set! (-> result current-shadow quad) (-> context-a current-shadow quad))
-     (set! (-> result current-shadow-color quad) (-> context-a current-shadow-color quad))
+     (vector-copy! (-> result current-fog fog-color) (-> context-a current-fog fog-color))
+     (vector-copy! (-> result current-fog fog-dists) (-> context-a current-fog fog-dists))
+     (vector-copy! (-> result current-fog erase-color) (-> context-a current-fog erase-color))
+     (vector-copy! (-> result current-prt-color) (-> context-a current-prt-color))
+     (vector-copy! (-> result current-sun sun-color) (-> context-a current-sun sun-color))
+     (vector-copy! (-> result current-sun env-color) (-> context-a current-sun env-color))
+     (vector-copy! (-> result current-shadow) (-> context-a current-shadow))
+     (vector-copy! (-> result current-shadow-color) (-> context-a current-shadow-color))
      (quad-copy! (the-as pointer (-> result light-group)) (the-as pointer (-> context-a light-group)) 12))
     ((= blend 1.0)
-     (set! (-> result current-fog fog-color quad) (-> context-b current-fog fog-color quad))
-     (set! (-> result current-fog fog-dists quad) (-> context-b current-fog fog-dists quad))
-     (set! (-> result current-fog erase-color quad) (-> context-b current-fog erase-color quad))
-     (set! (-> result current-prt-color quad) (-> context-b current-prt-color quad))
-     (set! (-> result current-sun sun-color quad) (-> context-b current-sun sun-color quad))
-     (set! (-> result current-sun env-color quad) (-> context-b current-sun env-color quad))
-     (set! (-> result current-shadow quad) (-> context-b current-shadow quad))
-     (set! (-> result current-shadow-color quad) (-> context-b current-shadow-color quad))
+     (vector-copy! (-> result current-fog fog-color) (-> context-b current-fog fog-color))
+     (vector-copy! (-> result current-fog fog-dists) (-> context-b current-fog fog-dists))
+     (vector-copy! (-> result current-fog erase-color) (-> context-b current-fog erase-color))
+     (vector-copy! (-> result current-prt-color) (-> context-b current-prt-color))
+     (vector-copy! (-> result current-sun sun-color) (-> context-b current-sun sun-color))
+     (vector-copy! (-> result current-sun env-color) (-> context-b current-sun env-color))
+     (vector-copy! (-> result current-shadow) (-> context-b current-shadow))
+     (vector-copy! (-> result current-shadow-color) (-> context-b current-shadow-color))
      (quad-copy! (the-as pointer (-> result light-group)) (the-as pointer (-> context-b light-group)) 12))
     (else
      (vector4-lerp! (-> result current-fog fog-color)
@@ -644,8 +644,8 @@
                   (let* ((snapshot (-> context mood-lights-table data light-slot))
                          (directional (-> context light-group 0 dir2))
                          (color-level (* (+ (* 2.0 (-> snapshot lgt-color x)) (* 4.0 (-> snapshot lgt-color y)) (-> snapshot lgt-color z)) brightness)))
-                    (set! (-> directional direction quad) (-> snapshot direction quad))
-                    (set! (-> directional color quad) (-> snapshot lgt-color quad))
+                    (vector-copy! (-> directional direction) (-> snapshot direction))
+                    (vector-copy! (-> directional color) (-> snapshot lgt-color))
                     (set! (-> directional levels x) brightness)
                     (set! (-> directional levels y) color-level))
                   (set! *lightning-realtime-done* #t))))
@@ -871,8 +871,8 @@
   (let ((group (-> context light-group 1))) (update-light-kit group (-> context light-group 0 ambi) 0.9))
   (let ((group (-> context light-group 2)))
     (update-light-kit group (-> context light-group 0 ambi) 1.0)
-    (set! (-> group dir2 direction quad) (-> context light-group 0 dir2 direction quad))
-    (set! (-> group dir2 color quad) (-> context light-group 0 dir2 color quad))
+    (vector-copy! (-> group dir2 direction) (-> context light-group 0 dir2 direction))
+    (vector-copy! (-> group dir2 color) (-> context light-group 0 dir2 color))
     (set! (-> group dir2 levels x) (-> context light-group 0 dir2 levels x)))
   (let ((group (-> context light-group 3)))
     (update-light-kit group (-> context light-group 0 ambi) 1.0)
@@ -891,13 +891,13 @@
     (set-vector! direction 1212416.0 110592.0 -6680576.0 0.0)
     (vector-! direction direction target-position)
     (vector-normalize! direction 1.0)
-    (set! (-> local-group dir0 direction quad) (-> direction quad))
+    (vector-copy! (-> local-group dir0 direction) direction)
     (set! (-> local-group dir0 levels x) (+ 0.666 (* 0.333 (-> context times 4 w))))
     (set-vector! direction 1384448.0 (-> target-position y) -6688768.0 0.0)
     (let ((distance (vector-vector-distance direction target-position)))
       (vector-! direction direction target-position)
       (vector-normalize! direction 1.0)
-      (set! (-> local-group dir1 direction quad) (-> direction quad))
+      (vector-copy! (-> local-group dir1 direction) direction)
       (when (< distance 180224.0)
         (new 'stack-no-clear 'vector)
         (let ((fade (* 0.0000110973015 (+ -90112.0 distance))))
@@ -1122,7 +1122,7 @@
   (update-mood-quick context 0 0 0 level-index)
   (let ((group (-> context light-group 1)))
     (quad-copy! (the-as pointer group) (the-as pointer (-> context light-group)) 12)
-    (set! (-> group dir2 color quad) (the-as uint128 0))
+    (vector-zero! (-> group dir2 color))
     (set! (-> group dir2 levels x) 0.0))
   (let ((group (-> context light-group 2)))
     (quad-copy! (the-as pointer group) (the-as pointer (-> context light-group)) 12)
@@ -1477,7 +1477,7 @@
               (warm-ambient (new 'static 'vector :y 1.0 :z 0.5 :w 1.0))
               (base-ambient (new 'static 'vector :x 0.3 :y 0.4 :z 0.5 :w 1.0)))
           (vector-lerp! (-> context mood-lights-table data 0 amb-color) base-ambient warm-ambient ambient-blend))
-        (set! (-> context mood-lights-table data 0 prt-color quad) (-> context mood-lights-table data 0 amb-color quad))
+        (vector-copy! (-> context mood-lights-table data 0 prt-color) (-> context mood-lights-table data 0 amb-color))
         (vector-normalize! light-direction 1.0)
         (let ((shadow-direction (-> context mood-lights-table data 0 shadow)))
           (set! (-> shadow-direction x) (- (-> light-direction x)))
@@ -1778,7 +1778,7 @@
                   (set! (-> groups 0 ambi direction quad) (-> phase-groups 0 ambi direction quad))
                   (set! (-> groups 0 ambi color quad) (-> phase-groups 0 ambi color quad))
                   (set! (-> groups 0 ambi levels quad) (-> phase-groups 0 ambi levels quad))
-                  (set! (-> context current-shadow quad) (-> *ogre2-mood* current-shadow quad)))
+                  (vector-copy! (-> context current-shadow) (-> *ogre2-mood* current-shadow)))
                  (else
                   (vector4-lerp! (the-as vector (-> groups 0))
                                  (the-as vector (-> phase-groups 0))
@@ -1816,10 +1816,10 @@
                     (set! (-> groups 0 ambi direction quad) (-> phase-groups 0 ambi direction quad))
                     (set! (-> groups 0 ambi color quad) (-> phase-groups 0 ambi color quad))
                     (set! (-> groups 0 ambi levels quad) (-> phase-groups 0 ambi levels quad))
-                    (set! (-> context current-shadow quad) (-> *ogre3-mood* current-shadow quad))
-                    (set! (-> context current-fog fog-color quad) (-> *ogre3-mood* current-fog fog-color quad))
-                    (set! (-> context current-fog fog-dists quad) (-> *ogre3-mood* current-fog fog-dists quad))
-                    (set! (-> context current-fog erase-color quad) (-> *ogre3-mood* current-fog erase-color quad)))
+                    (vector-copy! (-> context current-shadow) (-> *ogre3-mood* current-shadow))
+                    (vector-copy! (-> context current-fog fog-color) (-> *ogre3-mood* current-fog fog-color))
+                    (vector-copy! (-> context current-fog fog-dists) (-> *ogre3-mood* current-fog fog-dists))
+                    (vector-copy! (-> context current-fog erase-color) (-> *ogre3-mood* current-fog erase-color)))
                    (else
                     (vector4-lerp! (the-as vector (-> groups 0))
                                    (the-as vector (-> phase-groups 0))

goal_src/jak1/engine/gfx/mood/time-of-day.gc

@@ -658,14 +658,14 @@
           ;; Exact endpoints can copy the complete mood directly.
           ((= current-blend 0.0)
            (let ((level0-fog (-> context moods 0 current-fog)))
-             (set! (-> current-fog fog-color quad) (-> level0-fog fog-color quad))
-             (set! (-> current-fog fog-dists quad) (-> level0-fog fog-dists quad))
-             (set! (-> current-fog erase-color quad) (-> level0-fog erase-color quad)))
-           (set! (-> context current-prt-color quad) (-> context moods 0 current-prt-color quad))
-           (set! (-> context current-sun sun-color quad) (-> context moods 0 current-sun sun-color quad))
-           (set! (-> context current-sun env-color quad) (-> context moods 0 current-sun env-color quad))
-           (set! (-> context current-shadow quad) (-> context moods 0 current-shadow quad))
-           (set! (-> context current-shadow-color quad) (-> context moods 0 current-shadow-color quad))
+             (vector-copy! (-> current-fog fog-color) (-> level0-fog fog-color))
+             (vector-copy! (-> current-fog fog-dists) (-> level0-fog fog-dists))
+             (vector-copy! (-> current-fog erase-color) (-> level0-fog erase-color)))
+           (vector-copy! (-> context current-prt-color) (-> context moods 0 current-prt-color))
+           (vector-copy! (-> context current-sun sun-color) (-> context moods 0 current-sun sun-color))
+           (vector-copy! (-> context current-sun env-color) (-> context moods 0 current-sun env-color))
+           (vector-copy! (-> context current-shadow) (-> context moods 0 current-shadow))
+           (vector-copy! (-> context current-shadow-color) (-> context moods 0 current-shadow-color))
            (dotimes (group-index 8)
              (quad-copy! (the-as pointer (-> context light-group group-index))
                          (the-as pointer (-> context moods 0 light-group group-index))
@@ -674,14 +674,14 @@
            (set! (-> context sun-fade) (-> *level* level0 info sun-fade)))
           ((= current-blend 1.0)
            (let ((level1-fog (-> context moods 1 current-fog)))
-             (set! (-> current-fog fog-color quad) (-> level1-fog fog-color quad))
-             (set! (-> current-fog fog-dists quad) (-> level1-fog fog-dists quad))
-             (set! (-> current-fog erase-color quad) (-> level1-fog erase-color quad)))
-           (set! (-> context current-prt-color quad) (-> context moods 1 current-prt-color quad))
-           (set! (-> context current-sun sun-color quad) (-> context moods 1 current-sun sun-color quad))
-           (set! (-> context current-sun env-color quad) (-> context moods 1 current-sun env-color quad))
-           (set! (-> context current-shadow quad) (-> context moods 1 current-shadow quad))
-           (set! (-> context current-shadow-color quad) (-> context moods 1 current-shadow-color quad))
+             (vector-copy! (-> current-fog fog-color) (-> level1-fog fog-color))
+             (vector-copy! (-> current-fog fog-dists) (-> level1-fog fog-dists))
+             (vector-copy! (-> current-fog erase-color) (-> level1-fog erase-color)))
+           (vector-copy! (-> context current-prt-color) (-> context moods 1 current-prt-color))
+           (vector-copy! (-> context current-sun sun-color) (-> context moods 1 current-sun sun-color))
+           (vector-copy! (-> context current-sun env-color) (-> context moods 1 current-sun env-color))
+           (vector-copy! (-> context current-shadow) (-> context moods 1 current-shadow))
+           (vector-copy! (-> context current-shadow-color) (-> context moods 1 current-shadow-color))
            (dotimes (group-index 8)
              (quad-copy! (the-as pointer (-> context light-group group-index))
                          (the-as pointer (-> context moods 1 light-group group-index))
@@ -762,18 +762,18 @@
         ;; the current erase color so it meets the clear without a seam.
         (dotimes (i 2)
           (make-sky-textures context i))
-        (set! (-> sky-base-polygons 0 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 1 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 2 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 3 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 4 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 5 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 6 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 7 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 8 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 9 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 10 col quad) (-> current-fog erase-color quad))
-        (set! (-> sky-base-polygons 11 col quad) (-> current-fog erase-color quad)))))
+        (vector-copy! (-> sky-base-polygons 0 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 1 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 2 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 3 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 4 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 5 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 6 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 7 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 8 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 9 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 10 col) (-> current-fog erase-color))
+        (vector-copy! (-> sky-base-polygons 11 col) (-> current-fog erase-color)))))
 
   ;; The GS treats 128 as a 1.0 texture-modulation component. Convert the authored 0..255
   ;; environment color into that scale before it is packed for rendering.
@@ -859,7 +859,7 @@
     ((and (>= index 0) (< index 8))
      (let ((control (-> this control index)))
        (when (< actor-distance (-> control actor-dist))
-         (if trans (set! (-> control trans quad) (-> trans quad)))
+         (if trans (vector-copy! (-> control trans) trans))
          (set! (-> control fade) (fmax 0.0 (fmin 1.993 fade)))
          (set! (-> control actor-dist) actor-distance))))
     (else (format 0 "ERROR: Bogus palette-fade-control index!~%"))))

goal_src/jak1/engine/gfx/ocean/ocean-mid.gc

@@ -163,9 +163,9 @@
    wireframe and 2 draws untextured Gouraud shading."
   ;; the usual camera math
   (let ((math-cam *math-camera*))
-    (set! (-> dst hmge-scale quad) (-> math-cam hmge-scale quad))
-    (set! (-> dst inv-hmge-scale quad) (-> math-cam inv-hmge-scale quad))
-    (set! (-> dst hvdf-offset quad) (-> math-cam hvdf-off quad))
+    (vector-copy! (-> dst hmge-scale) (-> math-cam hmge-scale))
+    (vector-copy! (-> dst inv-hmge-scale) (-> math-cam inv-hmge-scale))
+    (vector-copy! (-> dst hvdf-offset) (-> math-cam hvdf-off))
     (set-vector! (-> dst fog) (-> math-cam pfog0) (-> math-cam fog-min) (-> math-cam fog-max) 3072.0))
   ;; xy scale and offset for the environment-map texture coordinates, and the cell size the
   ;; microprogram steps the corner lattice by.
@@ -376,7 +376,7 @@
                   :nreg #x3)))))
   (set! (-> dst env-strip regs)
         (new 'static 'gif-tag-regs :regs0 (gif-reg-id st) :regs1 (gif-reg-id rgbaq) :regs2 (gif-reg-id xyzf2)))
-  (set! (-> dst env-color quad) (-> *time-of-day-context* current-sun env-color quad))
+  (vector-copy! (-> dst env-color) (-> *time-of-day-context* current-sun env-color))
   ;; Per-row VU addresses for the eight strips of a block, ordered from the last row back to the
   ;; first.  The middle lane steps by the twelve-quadword color row.
   (set-vector! (-> dst index-table 0) 63 84 66 0)
@@ -504,16 +504,7 @@
                  qwc))
       (set! (-> buf base) (&+ (the-as pointer packet) 16)))
     (let ((rot-dst (-> dma-buf base)))
-      (let* ((rot-mat (the-as object rot-dst))
-             (cam-rot (-> *math-camera* camera-rot))
-             (row0 (-> cam-rot vector 0 quad))
-             (row1 (-> cam-rot vector 1 quad))
-             (row2 (-> cam-rot vector 2 quad))
-             (row3 (-> cam-rot vector 3 quad)))
-        (set! (-> (the-as matrix rot-mat) vector 0 quad) row0)
-        (set! (-> (the-as matrix rot-mat) vector 1 quad) row1)
-        (set! (-> (the-as matrix rot-mat) vector 2 quad) row2)
-        (set! (-> (the-as matrix rot-mat) vector 3 quad) row3))
+      (matrix-copy! (the-as matrix rot-dst) (-> *math-camera* camera-rot))
       ;; only xyz of the translation row is replaced; its w stays as the camera rotation had it.
       (let ((rot-trans (the-as object (&+ rot-dst 48))))
         (vector-matrix*! origin-cam origin (-> *math-camera* camera-rot))

goal_src/jak1/engine/gfx/ocean/ocean-near.gc

@@ -97,9 +97,9 @@
    addresses come from *ocean-base-page* and *ocean-base-block*, so the ocean's VRAM
    must already be allocated."
   (let ((camera *math-camera*))
-    (set! (-> consts hmge-scale quad) (-> camera hmge-scale quad))
-    (set! (-> consts inv-hmge-scale quad) (-> camera inv-hmge-scale quad))
-    (set! (-> consts hvdf-offset quad) (-> camera hvdf-off quad))
+    (vector-copy! (-> consts hmge-scale) (-> camera hmge-scale))
+    (vector-copy! (-> consts inv-hmge-scale) (-> camera inv-hmge-scale))
+    (vector-copy! (-> consts hvdf-offset) (-> camera hvdf-off))
     (set-vector! (-> consts fog) (-> camera pfog0) (-> camera fog-min) (-> camera fog-max) 3072.0))
   ;; w is 1 / (meters 24): a position inside a cell as a fraction of the cell.
   (set-vector! (-> consts constants) 0.5 0.5 0.0 0.000010172526)
@@ -308,7 +308,7 @@
                     :nreg #x3)))))
     (set! (-> consts env-strip regs)
           (new 'static 'gif-tag-regs :regs0 (gif-reg-id st) :regs1 (gif-reg-id rgbaq) :regs2 (gif-reg-id xyzf2)))
-    (set! (-> consts env-color quad) (-> *time-of-day-context* current-sun env-color quad))
+    (vector-copy! (-> consts env-color) (-> *time-of-day-context* current-sun env-color))
     (set! (-> consts drw2-adgif tag) (new 'static 'gif-tag64 :nloop #x2 :eop #x1 :nreg #x1))
     (set! (-> consts drw2-adgif regs) (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)))
     ;; The second draw pass writes only the framebuffer alpha, so its TEX0 and FRAME
@@ -429,16 +429,7 @@
       (set! (-> (the-as dma-packet packet) vif1) (new 'static 'vif-tag :imm #x8000 :cmd (vif-cmd unpack-v4-32) :num qwc))
       (set! (-> buf base) (the-as pointer (&+ (the-as vector packet) 16))))
     (let ((rot (the-as object (-> dma-buf base))))
-      (let* ((rot-rows (the-as matrix rot))
-             (camera-rot (-> *math-camera* camera-rot))
-             (row0 (-> camera-rot vector 0 quad))
-             (row1 (-> camera-rot vector 1 quad))
-             (row2 (-> camera-rot vector 2 quad))
-             (row3 (-> camera-rot vector 3 quad)))
-        (set! (-> rot-rows vector 0 quad) row0)
-        (set! (-> rot-rows vector 1 quad) row1)
-        (set! (-> rot-rows vector 2 quad) row2)
-        (set! (-> rot-rows vector 3 quad) row3))
+      (matrix-copy! (the-as matrix rot) (-> *math-camera* camera-rot))
       (let ((rot-trans (the-as object (&+ (the-as pointer rot) 48))))
         (vector-matrix*! origin-in-camera cell-origin (-> *math-camera* camera-rot))
         (set! (-> (the-as vector rot-trans) x) (-> origin-in-camera x))

goal_src/jak1/engine/gfx/ocean/ocean-transition.gc

@@ -412,10 +412,10 @@
     (let ((vu-data (the-as (inline-array vector) (-> buf base))))
       ;; A strip spans the whole mid cell, so it takes the unit square and the cell's four
       ;; corner colors unblended; the weight list interpolates them.
-      (set! (-> vu-data 0 quad) (-> *ocean-trans-st-table* 0 quad))
-      (set! (-> vu-data 1 quad) (-> *ocean-trans-st-table* 1 quad))
-      (set! (-> vu-data 2 quad) (-> *ocean-trans-st-table* 2 quad))
-      (set! (-> vu-data 3 quad) (-> *ocean-trans-st-table* 3 quad))
+      (vector-copy! (-> vu-data 0) (-> *ocean-trans-st-table* 0))
+      (vector-copy! (-> vu-data 1) (-> *ocean-trans-st-table* 1))
+      (vector-copy! (-> vu-data 2) (-> *ocean-trans-st-table* 2))
+      (vector-copy! (-> vu-data 3) (-> *ocean-trans-st-table* 3))
       (let ((corner-color-0 (the-as uint128 (-> *ocean-map* ocean-colors colors (+ (* OCEAN-COLOR-ROW-STRIDE (the-as int mid-z)) mid-x))))
             (corner-color-1 (the-as uint128 (-> *ocean-map* ocean-colors colors (+ mid-x 1 (* OCEAN-COLOR-ROW-STRIDE (the-as int mid-z))))))
             (corner-color-2 (the-as uint128 (-> *ocean-map* ocean-colors colors (+ (* OCEAN-COLOR-ROW-STRIDE (the-as int (+ mid-z 1))) mid-x))))

goal_src/jak1/engine/gfx/ocean/ocean.gc

@@ -575,42 +575,12 @@
         (else (set! (-> *ocean-map* start-corner y) (meters -24)))))
     (when (not *ocean-off*)
       (when (logtest? *vu1-enable-user* (vu1-renderer-mask ocean))
-        (let* ((mid-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-               (mid-chain-start (-> mid-buf base)))
-          (draw-ocean-texture mid-buf *ocean-verts* #t)
-          (ocean-init-buffer mid-buf)
-          (draw-ocean-far mid-buf)
-          (when (not *ocean-mid-off*)
-            (draw-ocean-mid mid-buf))
-          (ocean-end-buffer mid-buf)
-          (let ((mid-chain-end (-> mid-buf base)))
-            (let ((next-tag (the-as object (-> mid-buf base))))
-              (set! (-> (the-as dma-packet next-tag) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-              (set! (-> (the-as dma-packet next-tag) vif0) (new 'static 'vif-tag))
-              (set! (-> (the-as dma-packet next-tag) vif1) (new 'static 'vif-tag))
-              (set! (-> mid-buf base) (&+ (the-as pointer next-tag) 16)))
-            (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                   (bucket-id ocean-mid-and-far)
-                                   mid-chain-start
-                                   (the-as (pointer dma-tag) mid-chain-end))))
+        (with-dma-buffer-add-bucket ((mid-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id ocean-mid-and-far)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-ocean-texture mid-buf *ocean-verts* #t) (ocean-init-buffer mid-buf) (draw-ocean-far mid-buf) (when (not *ocean-mid-off*)
+                    (draw-ocean-mid mid-buf)) (ocean-end-buffer mid-buf))
         ;; The near grid is only worth building from close to the surface, and it inherits the mid
         ;; grid's suppression masks, so it also goes away when the mid grid is off.
         (when (not (or *ocean-near-off* (or *ocean-mid-off* (< (meters 48) (fabs (-> *math-camera* trans y))))))
-          (let* ((near-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                 (near-chain-start (-> near-buf base)))
-            (draw-ocean-texture near-buf *ocean-verts* #f)
-            (draw-ocean-near near-buf)
-            (ocean-end-buffer near-buf)
-            (let ((near-chain-end (-> near-buf base)))
-              (let ((next-tag (the-as object (-> near-buf base))))
-                (set! (-> (the-as dma-packet next-tag) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                (set! (-> (the-as dma-packet next-tag) vif0) (new 'static 'vif-tag))
-                (set! (-> (the-as dma-packet next-tag) vif1) (new 'static 'vif-tag))
-                (set! (-> near-buf base) (&+ (the-as pointer next-tag) 16)))
-              (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                     (bucket-id ocean-near)
-                                     near-chain-start
-                                     (the-as (pointer dma-tag) near-chain-end))))))))
+          (with-dma-buffer-add-bucket ((near-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id ocean-near)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-ocean-texture near-buf *ocean-verts* #f) (draw-ocean-near near-buf) (ocean-end-buffer near-buf))))))
   (when (not (paused?))
     (set! *ocean-off* #f)
     (set! *ocean-mid-off* #f)

goal_src/jak1/engine/gfx/shadow/shadow-cpu.gc

@@ -162,14 +162,9 @@
   "Return the complete packed shadow geometry size."
   (the-as int (-> this total-size)))
 
-(defmethod mem-usage ((this shadow-geo) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this shadow-geo) (usage memory-usage-block) (flags mem-usage-flags))
   "Charge this packed shadow geometry's used and 16-byte-aligned sizes to usage."
-  (set! (-> usage length) (max 108 (-> usage length)))
-  (set! (-> usage data 107 name) "shadow-geo")
-  (+! (-> usage data 107 count) 1)
-  (let ((byte-size (-> this total-size)))
-    (+! (-> usage data 107 used) byte-size)
-    (+! (-> usage data 107 total) (logand -16 (+ byte-size 15))))
+  (mem-usage-add! usage shadow-geo 1 (-> this total-size))
   this)
 
 (define *shadow-data*
@@ -2926,32 +2921,14 @@
           (if (nonzero? (-> queue run i first)) (set! has-shadow? #t)))
         (when has-shadow?
           (shadow-vu0-upload)
-          (let* ((global-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                 (chain-start (-> global-buf base)))
-            (shadow-vu1-init-buffer global-buf)
-            (flush-cache 0)
-            (let ((workspace (the-as shadow-dcache *gsf-buffer*)))
-              (set! (-> workspace stats num-single-tris) (the-as uint 0))
-              (set! (-> workspace stats num-double-tris) (the-as uint 0))
-              (set! (-> workspace stats num-single-edges) (the-as uint 0))
-              (set! (-> workspace stats num-double-edges) (the-as uint 0)))
-            0
-            (shadow-dma-init global-buf)
-            (dotimes (i (the-as int (-> queue cur-run)))
-              (let ((run (-> queue run i)))
-                (if (nonzero? (-> run first))
-                  (set! (-> global-buf base) (shadow-execute (the-as shadow-dma-packet (-> run first)) (-> global-buf base))))))
-            (shadow-dma-end global-buf)
-            (let ((chain-tail (-> global-buf base)))
-              (let ((next-tag (the-as object (-> global-buf base))))
-                (set! (-> (the-as dma-packet next-tag) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                (set! (-> (the-as dma-packet next-tag) vif0) (new 'static 'vif-tag))
-                (set! (-> (the-as dma-packet next-tag) vif1) (new 'static 'vif-tag))
-                (set! (-> global-buf base) (&+ (the-as pointer next-tag) 16)))
-              (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                     (bucket-id shadow)
-                                     chain-start
-                                     (the-as (pointer dma-tag) chain-tail))))))
+          (with-dma-buffer-add-bucket ((global-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id shadow)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (shadow-vu1-init-buffer global-buf) (flush-cache 0) (let ((workspace (the-as shadow-dcache *gsf-buffer*)))
+                        (set! (-> workspace stats num-single-tris) (the-as uint 0))
+                        (set! (-> workspace stats num-double-tris) (the-as uint 0))
+                        (set! (-> workspace stats num-single-edges) (the-as uint 0))
+                        (set! (-> workspace stats num-double-edges) (the-as uint 0))) 0 (shadow-dma-init global-buf) (dotimes (i (the-as int (-> queue cur-run)))
+                        (let ((run (-> queue run i)))
+                          (if (nonzero? (-> run first))
+                            (set! (-> global-buf base) (shadow-execute (the-as shadow-dma-packet (-> run first)) (-> global-buf base)))))) (shadow-dma-end global-buf))))
       (when #f
         (let ((workspace (the-as structure *gsf-buffer*)))
           (format *stdcon* "#single tris : ~4d~%" (-> (the-as shadow-dcache workspace) stats num-single-tris))
@@ -2982,7 +2959,7 @@
     (let ((hit (new 'stack-no-clear 'collide-tri-result))
           (ray-start (new 'stack-no-clear 'vector))
           (ray (new 'stack-no-clear 'vector)))
-      (set! (-> ray-start quad) (-> origin quad))
+      (vector-copy! ray-start origin)
       (set! (-> ray-start y) (+ 4096.0 (-> ray-start y)))
       (set-vector! ray 0.0 (- cast-length) 0.0 1.0)
       (cond

goal_src/jak1/engine/gfx/shadow/shadow-vu1.gc

@@ -1097,14 +1097,14 @@
         (camera *math-camera*)
         (shadow-state *shadow-data*)
         (tri-template *shadow-vu1-tri-template*))
-    (set! (-> (the-as shadow-vu1-constants constants) hmgescale quad) (-> camera hmge-scale quad))
-    (set! (-> (the-as shadow-vu1-constants constants) invhscale quad) (-> camera inv-hmge-scale quad))
-    (set! (-> (the-as shadow-vu1-constants constants) texoffset quad) (-> shadow-state texoffset quad))
-    (set! (-> (the-as shadow-vu1-constants constants) texscale quad) (-> shadow-state texscale quad))
-    (set! (-> (the-as shadow-vu1-constants constants) hvdfoff quad) (-> camera hvdf-off quad))
+    (vector-copy! (-> (the-as shadow-vu1-constants constants) hmgescale) (-> camera hmge-scale))
+    (vector-copy! (-> (the-as shadow-vu1-constants constants) invhscale) (-> camera inv-hmge-scale))
+    (vector-copy! (-> (the-as shadow-vu1-constants constants) texoffset) (-> shadow-state texoffset))
+    (vector-copy! (-> (the-as shadow-vu1-constants constants) texscale) (-> shadow-state texscale))
+    (vector-copy! (-> (the-as shadow-vu1-constants constants) hvdfoff) (-> camera hvdf-off))
     (set! (-> (the-as shadow-vu1-constants constants) fog x) (-> camera pfog0))
-    (set! (-> (the-as shadow-vu1-constants constants) clrs 0 quad) (-> shadow-state clrs 0 quad))
-    (set! (-> (the-as shadow-vu1-constants constants) clrs 1 quad) (-> shadow-state clrs 1 quad))
+    (vector-copy! (-> (the-as shadow-vu1-constants constants) clrs 0) (-> shadow-state clrs 0))
+    (vector-copy! (-> (the-as shadow-vu1-constants constants) clrs 1) (-> shadow-state clrs 1))
     (set! (-> (the-as shadow-vu1-constants constants) adgif qword) (-> tri-template adgif qword))
     (set! (-> (the-as shadow-vu1-constants constants) texflush quad) (-> tri-template ad quad))
     (set! (-> (the-as shadow-vu1-constants constants) flush quad) (-> tri-template flush quad))
@@ -1151,14 +1151,7 @@
       (set! (-> (the-as dma-packet upload-packet) vif1) (new 'static 'vif-tag :cmd (vif-cmd unpack-v4-32) :num qwc))
       (set! (-> packet-buffer base) (the-as pointer (&+ (the-as dma-packet upload-packet) 16)))))
   (let ((matrix-out (the-as object (-> dma-buf base))))
-    (let ((right (-> camera perspective vector 0 quad))
-          (up (-> camera perspective vector 1 quad))
-          (forward (-> camera perspective vector 2 quad))
-          (translation (-> camera perspective vector 3 quad)))
-      (set! (-> (the-as matrix matrix-out) vector 0 quad) right)
-      (set! (-> (the-as matrix matrix-out) vector 1 quad) up)
-      (set! (-> (the-as matrix matrix-out) vector 2 quad) forward)
-      (set! (-> (the-as matrix matrix-out) vector 3 quad) translation))
+    (matrix-copy! (the-as matrix matrix-out) (-> camera perspective))
     (set! (-> dma-buf base) (the-as pointer (&+ (the-as matrix matrix-out) 64))))
   (none))
 

goal_src/jak1/engine/gfx/shadow/shadow.gc

@@ -142,7 +142,7 @@
    a caster over water keeps the reference point it already had, and it is placed at the bottom of
    the probe range when nothing was hit at all."
   (let ((probe-origin (new 'stack-no-clear 'vector)))
-    (set! (-> probe-origin quad) (-> pos quad))
+    (vector-copy! probe-origin pos)
     ;; a second stack vector is reserved here and never used
     (new 'stack-no-clear 'vector)
     (+! (-> probe-origin y) probe-y-offset)
@@ -164,7 +164,7 @@
                                     probe-length
                                     (the-as float 0)))
          (if (and ground-pos (!= (-> hit pat material) (pat-material waterbottom)))
-           (set! (-> ground-pos quad) (-> hit intersect quad))))
+           (vector-copy! ground-pos (-> hit intersect))))
         (else (if ground-pos (vector+float*! ground-pos pos (-> *standard-dynamics* gravity-normal) (- probe-length)))))))
   0
   (none))
@@ -179,7 +179,7 @@
            (!= (-> self control mod-surface mode) 'dive)
            (!= (-> self next-state name) 'target-flop)
            (not (logtest? (-> self draw status) (draw-status hidden no-anim skip-bones))))
-    (set! (-> self control shadow-pos quad) (-> self control trans quad))
+    (vector-copy! (-> self control shadow-pos) (-> self control trans))
     (find-ground-and-draw-shadow (-> self control trans)
                                  (-> self control shadow-pos)
                                  0.0

goal_src/jak1/engine/gfx/shrub/shrub-work.gc

@@ -525,16 +525,7 @@
     (set! (-> (the-as dma-packet matrix-packet) vif1)
           (new 'static 'vif-tag :num #x6 :cmd (vif-cmd unpack-v4-32) :imm (shr (shl matrix-vu-address 54) 54)))
     (set! (-> dma-state base) (&+ (the-as pointer matrix-packet) 16)))
-  (let* ((matrix-dst (the-as matrix (-> dma-buf base)))
-         (camera-temp (-> *math-camera* camera-temp))
-         (row-0 (-> camera-temp vector 0 quad))
-         (row-1 (-> camera-temp vector 1 quad))
-         (row-2 (-> camera-temp vector 2 quad))
-         (row-3 (-> camera-temp vector 3 quad)))
-    (set! (-> matrix-dst vector 0 quad) row-0)
-    (set! (-> matrix-dst vector 1 quad) row-1)
-    (set! (-> matrix-dst vector 2 quad) row-2)
-    (set! (-> matrix-dst vector 3 quad) row-3))
+  (matrix-copy! (the-as matrix (-> dma-buf base)) (-> *math-camera* camera-temp))
   (&+! (-> dma-buf base) 64)
   ;; Entry 10 expects the camera rows followed by (1, 1, 1, 128) and
   ;; (vertex-count, 0, 0, 0).

goal_src/jak1/engine/gfx/shrub/shrubbery.gc

@@ -99,25 +99,15 @@
   (adgif-shader-login (-> this flat))
   this)
 
-(defmethod mem-usage ((this billboard) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this billboard) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this billboard's inline storage."
-  (set! (-> usage length) (max 34 (-> usage length)))
-  (set! (-> usage data 33 name) "billboard")
-  (+! (-> usage data 33 count) 1)
-  (let ((byte-size (asize-of this)))
-    (+! (-> usage data 33 used) byte-size)
-    (+! (-> usage data 33 total) (logand -16 (+ byte-size 15))))
+  (mem-usage-add! usage billboard 1 (asize-of this))
   this)
 
-(defun-recursive mem-usage-shrub-walk draw-node ((nodes draw-node) (node-count int) (usage memory-usage-block) (flags int))
+(defun-recursive mem-usage-shrub-walk draw-node ((nodes draw-node) (node-count int) (usage memory-usage-block) (flags mem-usage-flags))
   "Recursively account for node storage and leaf instance-shrubbery records across node-count
    contiguous shrub BVH roots. flags is forwarded for the memory-usage traversal."
-  (set! (-> usage length) (max 62 (-> usage length)))
-  (set! (-> usage data 61 name) "draw-node")
-  (+! (-> usage data 61 count) node-count)
-  (let ((node-bytes (* node-count 32)))
-    (+! (-> usage data 61 used) node-bytes)
-    (+! (-> usage data 61 total) (logand -16 (+ node-bytes 15))))
+  (mem-usage-add! usage draw-node node-count (* node-count 32))
   (let ((node nodes))
     (dotimes (i node-count)
       (let ((child-count (-> node child-count)))
@@ -125,38 +115,23 @@
           ((logtest? (-> node flags) (draw-node-flags children-are-draw-nodes))
            (mem-usage-shrub-walk (the-as draw-node (-> node child)) (the-as int child-count) usage flags))
           (else
-           (set! (-> usage length) (max 35 (-> usage length)))
-           (set! (-> usage data 34 name) "instance-shrubbery")
-           (+! (-> usage data 34 count) child-count)
-           (let ((instance-bytes (* (the-as uint 80) child-count)))
-             (+! (-> usage data 34 used) instance-bytes)
-             (+! (-> usage data 34 total) (logand -16 (+ instance-bytes 15)))))))
+           (mem-usage-add! usage instance-shrubbery child-count (* (the-as uint 80) child-count)))))
       (&+! node 32)))
   nodes)
 
-(defmethod mem-usage ((this drawable-tree-instance-shrub) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-tree-instance-shrub) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the tree header, optional time-of-day palette, recursive draw-node hierarchy,
    and prototype array."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((tree-header-bytes 32))
-    (+! (-> usage data 0 used) tree-header-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ tree-header-bytes 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 32)
   ;; Time-of-day colors are allocated separately from the tree.
   (when (nonzero? (-> this colors-added))
-    (set! (-> usage length) (max 33 (-> usage length)))
-    (set! (-> usage data 32 name) "shrubbery-pal")
-    (+! (-> usage data 32 count) 1)
-    (let ((palette-bytes (asize-of (-> this colors-added))))
-      (+! (-> usage data 32 used) palette-bytes)
-      (+! (-> usage data 32 total) (logand -16 (+ palette-bytes 15)))))
+    (mem-usage-add! usage shrubbery-pal 1 (asize-of (-> this colors-added))))
   ;; Account recursively for the instance hierarchy, then for its prototype geometry.
   (mem-usage-shrub-walk (the-as draw-node (&+ (-> this data 0) 32))
                         (-> (the-as drawable-group (-> this data 0)) length)
                         usage
                         flags)
-  (mem-usage (-> this info prototype-inline-array-shrub) usage (logior flags 1))
+  (mem-usage (-> this info prototype-inline-array-shrub) usage (logior flags (mem-usage-flags prototype-data)))
   this)
 
 (defmethod login ((this generic-shrub-fragment))
@@ -166,21 +141,12 @@
       (adgif-shader-login-no-remap (-> this textures i))))
   this)
 
-(defmethod mem-usage ((this generic-shrub-fragment) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this generic-shrub-fragment) (usage memory-usage-block) (flags mem-usage-flags))
   "Account separately for this fragment header and its referenced control, vertex, color, and
    texture-coordinate streams."
-  (set! (-> usage length) (max 27 (-> usage length)))
-  (set! (-> usage data 25 name) "generic-shrub")
-  (+! (-> usage data 25 count) 1)
   ;; The fragment header and referenced packed streams are separate allocations.
-  (let ((header-bytes (asize-of this)))
-    (+! (-> usage data 25 used) header-bytes)
-    (+! (-> usage data 25 total) (logand -16 (+ header-bytes 15))))
-  (set! (-> usage data 26 name) "generic-shrub-data")
-  (+! (-> usage data 26 count) 1)
-  (let ((stream-bytes (* (+ (-> this cnt-qwc) (-> this vtx-qwc) (-> this col-qwc) (-> this stq-qwc)) 16)))
-    (+! (-> usage data 26 used) stream-bytes)
-    (+! (-> usage data 26 total) (logand -16 (+ stream-bytes 15))))
+  (mem-usage-add! usage generic-shrub 1 (asize-of this))
+  (mem-usage-add! usage generic-shrub-data 1 (* (+ (-> this cnt-qwc) (-> this vtx-qwc) (-> this col-qwc) (-> this stq-qwc)) 16))
   this)
 
 (defmethod inspect ((this prototype-shrubbery))
@@ -191,14 +157,9 @@
     (format #t "~T  [~D] ~A~%" i (-> this data i)))
   this)
 
-(defmethod mem-usage ((this prototype-shrubbery) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this prototype-shrubbery) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the prototype-array header and each inline shrubbery fragment."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((header-bytes 32))
-    (+! (-> usage data 0 used) header-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ header-bytes 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 32)
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   this)
@@ -227,39 +188,14 @@
   (shrubbery-login-post-texture this)
   this)
 
-(defmethod mem-usage ((this shrubbery) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this shrubbery) (usage memory-usage-block) (flags mem-usage-flags))
   "Account separately for the shrub header and its object, vertex, color, and
    texture-coordinate streams."
-  (set! (-> usage length) (max 28 (-> usage length)))
-  (set! (-> usage data 27 name) "shrubbery")
-  (+! (-> usage data 27 count) 1)
-  (let ((header-bytes (asize-of this)))
-    (+! (-> usage data 27 used) header-bytes)
-    (+! (-> usage data 27 total) (logand -16 (+ header-bytes 15))))
-  (set! (-> usage length) (max 30 (-> usage length)))
-  (set! (-> usage data 29 name) "shrubbery-vertex")
-  (+! (-> usage data 29 count) 1)
-  (let ((vertex-bytes (* (-> this vtx-qwc) 16)))
-    (+! (-> usage data 29 used) vertex-bytes)
-    (+! (-> usage data 29 total) (logand -16 (+ vertex-bytes 15))))
-  (set! (-> usage length) (max 31 (-> usage length)))
-  (set! (-> usage data 30 name) "shrubbery-color")
-  (+! (-> usage data 30 count) 1)
-  (let ((color-bytes (* (-> this col-qwc) 16)))
-    (+! (-> usage data 30 used) color-bytes)
-    (+! (-> usage data 30 total) (logand -16 (+ color-bytes 15))))
-  (set! (-> usage length) (max 29 (-> usage length)))
-  (set! (-> usage data 28 name) "shrubbery-object")
-  (+! (-> usage data 28 count) 1)
-  (let ((object-bytes (* (-> this obj-qwc) 16)))
-    (+! (-> usage data 28 used) object-bytes)
-    (+! (-> usage data 28 total) (logand -16 (+ object-bytes 15))))
-  (set! (-> usage length) (max 32 (-> usage length)))
-  (set! (-> usage data 31 name) "shrubbery-stq")
-  (+! (-> usage data 31 count) 1)
-  (let ((stq-bytes (* (-> this stq-qwc) 16)))
-    (+! (-> usage data 31 used) stq-bytes)
-    (+! (-> usage data 31 total) (logand -16 (+ stq-bytes 15))))
+  (mem-usage-add! usage shrubbery 1 (asize-of this))
+  (mem-usage-add! usage shrubbery-vertex 1 (* (-> this vtx-qwc) 16))
+  (mem-usage-add! usage shrubbery-color 1 (* (-> this col-qwc) 16))
+  (mem-usage-add! usage shrubbery-object 1 (* (-> this obj-qwc) 16))
+  (mem-usage-add! usage shrubbery-stq 1 (* (-> this stq-qwc) 16))
   this)
 
 (defmethod login ((this drawable-tree-instance-shrub))
@@ -1134,16 +1070,7 @@
 (defun shrub-make-perspective-matrix ((out matrix))
   "Copy the current camera transform to out, divide its homogeneous coefficients by pfog0, and fold
    the horizontal, vertical, depth, and fog offsets into the first three components."
-  (let* ((out-matrix out)
-         (camera-temp (-> *math-camera* camera-temp))
-         (row-0 (-> camera-temp vector 0 quad))
-         (row-1 (-> camera-temp vector 1 quad))
-         (row-2 (-> camera-temp vector 2 quad))
-         (row-3 (-> camera-temp vector 3 quad)))
-    (set! (-> out-matrix vector 0 quad) row-0)
-    (set! (-> out-matrix vector 1 quad) row-1)
-    (set! (-> out-matrix vector 2 quad) row-2)
-    (set! (-> out-matrix vector 3 quad) row-3))
+  (matrix-copy! out (-> *math-camera* camera-temp))
   (let ((inverse-pfog0 (/ 1.0 (-> *math-camera* pfog0))))
     (set! (-> out vector 0 w) (* (-> out vector 0 w) inverse-pfog0))
     (set! (-> out vector 1 w) (* (-> out vector 1 w) inverse-pfog0))
@@ -2491,51 +2418,35 @@
     (when (logtest? *vu1-enable-user* (vu1-renderer-mask shrub-near))
       (when (nonzero? (-> *instance-shrub-work* near-count))
         (let ((dma-start (-> *display* frames (-> *display* on-screen) frame global-buf base)))
-          (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                 (chain-start (-> dma-buf base)))
-            (generic-init-buf dma-buf 0 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24)))
-            (let* ((dma-state dma-buf)
-                   (direct-packet (the-as object (-> dma-state base))))
-              (set! (-> (the-as dma-packet direct-packet) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
-              (set! (-> (the-as dma-packet direct-packet) vif0) (new 'static 'vif-tag))
-              (set! (-> (the-as dma-packet direct-packet) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
-              (set! (-> dma-state base) (&+ (the-as pointer direct-packet) 16)))
-            (let* ((dma-state dma-buf)
-                   (giftag (the-as object (-> dma-state base))))
-              (set! (-> (the-as gs-gif-tag giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
-              (set! (-> (the-as gs-gif-tag giftag) regs) GIF_REGS_ALL_AD)
-              (set! (-> dma-state base) (&+ (the-as pointer giftag) 16)))
-            (let* ((dma-state dma-buf)
-                   (test-packet (-> dma-state base)))
-              (set! (-> (the-as (pointer gs-test) test-packet) 0)
-                    (new 'static 'gs-test :ate #x1 :atst (gs-atest greater-equal) :aref #x26 :zte #x1 :ztst (gs-ztest greater-equal)))
-              (set! (-> (the-as (pointer gs-reg64) test-packet) 1) (gs-reg64 test-1))
-              (set! (-> dma-state base) (&+ test-packet 16)))
-            (let ((near-packet (+ (+ (-> *instance-shrub-work* current-shrub-near-packet) 5152) (the-as uint *instance-shrub-work*)))
-                  (output-matrix (the-as object (-> dma-buf base)))
-                  (near-chain-tail (+ (-> *instance-shrub-work* near-last) 176)))
-              (let ((patched-init-tag (logior (logand (l.d (+ near-packet 96)) (the-as uint #x80000000ffffffff))
-                                              (shr (shl (-> *instance-shrub-work* near-next) 33) 1))))
-                (s.d! (+ near-packet 96) patched-init-tag))
-              (let ((init-tag (l.q (+ near-packet 96)))
-                    (init-data-0 (l.q (+ near-packet 112)))
-                    (init-data-1 (l.q (+ near-packet 128))))
-                (set! (-> (the-as matrix3 output-matrix) vector 0 quad) init-tag)
-                (set! (-> (the-as matrix3 output-matrix) vector 1 quad) init-data-0)
-                (set! (-> (the-as matrix3 output-matrix) vector 2 quad) init-data-1))
-              (let ((after-matrix (&+ (the-as pointer output-matrix) 48)))
-                (s.w! (+ near-chain-tail 4) after-matrix)
-                (set! (-> dma-buf base) after-matrix)))
-            (let ((chain-end (-> dma-buf base)))
-              (let ((end-packet (the-as object (-> dma-buf base))))
-                (set! (-> (the-as dma-packet end-packet) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                (set! (-> (the-as dma-packet end-packet) vif0) (new 'static 'vif-tag))
-                (set! (-> (the-as dma-packet end-packet) vif1) (new 'static 'vif-tag))
-                (set! (-> dma-buf base) (&+ (the-as pointer end-packet) 16)))
-              (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                     (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index)) (bucket-id shrub-generic0) (bucket-id shrub-generic1))
-                                     chain-start
-                                     (the-as (pointer dma-tag) chain-end))))
+          (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id shrub-generic0) (bucket-id shrub-generic1))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (generic-init-buf dma-buf 0 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24))) (let* ((dma-state dma-buf)
+                             (direct-packet (the-as object (-> dma-state base))))
+                        (set! (-> (the-as dma-packet direct-packet) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
+                        (set! (-> (the-as dma-packet direct-packet) vif0) (new 'static 'vif-tag))
+                        (set! (-> (the-as dma-packet direct-packet) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
+                        (set! (-> dma-state base) (&+ (the-as pointer direct-packet) 16))) (let* ((dma-state dma-buf)
+                             (giftag (the-as object (-> dma-state base))))
+                        (set! (-> (the-as gs-gif-tag giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
+                        (set! (-> (the-as gs-gif-tag giftag) regs) GIF_REGS_ALL_AD)
+                        (set! (-> dma-state base) (&+ (the-as pointer giftag) 16))) (let* ((dma-state dma-buf)
+                             (test-packet (-> dma-state base)))
+                        (set! (-> (the-as (pointer gs-test) test-packet) 0)
+                              (new 'static 'gs-test :ate #x1 :atst (gs-atest greater-equal) :aref #x26 :zte #x1 :ztst (gs-ztest greater-equal)))
+                        (set! (-> (the-as (pointer gs-reg64) test-packet) 1) (gs-reg64 test-1))
+                        (set! (-> dma-state base) (&+ test-packet 16))) (let ((near-packet (+ (+ (-> *instance-shrub-work* current-shrub-near-packet) 5152) (the-as uint *instance-shrub-work*)))
+                            (output-matrix (the-as object (-> dma-buf base)))
+                            (near-chain-tail (+ (-> *instance-shrub-work* near-last) 176)))
+                        (let ((patched-init-tag (logior (logand (l.d (+ near-packet 96)) (the-as uint #x80000000ffffffff))
+                                                        (shr (shl (-> *instance-shrub-work* near-next) 33) 1))))
+                          (s.d! (+ near-packet 96) patched-init-tag))
+                        (let ((init-tag (l.q (+ near-packet 96)))
+                              (init-data-0 (l.q (+ near-packet 112)))
+                              (init-data-1 (l.q (+ near-packet 128))))
+                          (set! (-> (the-as matrix3 output-matrix) vector 0 quad) init-tag)
+                          (set! (-> (the-as matrix3 output-matrix) vector 1 quad) init-data-0)
+                          (set! (-> (the-as matrix3 output-matrix) vector 2 quad) init-data-1))
+                        (let ((after-matrix (&+ (the-as pointer output-matrix) 48)))
+                          (s.w! (+ near-chain-tail 4) after-matrix)
+                          (set! (-> dma-buf base) after-matrix))))
           (let ((usage *dma-mem-usage*))
             (when (nonzero? usage)
               (set! (-> usage length) (max 28 (-> usage length)))
@@ -2549,40 +2460,27 @@
     ;; fragment once, then CALL the instance chain accumulated for that prototype.
     (when (logtest? *vu1-enable-user* (vu1-renderer-mask shrubbery))
       (let ((dma-start (-> *display* frames (-> *display* on-screen) frame global-buf base)))
-        (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-               (chain-start (-> dma-buf base)))
-          (shrub-init-frame dma-buf
-                            (new 'static 'gs-test :ate #x1 :atst (gs-atest greater-equal) :aref #x26 :zte #x1 :ztst (gs-ztest greater-equal)))
-          (let ((bucket (the-as prototype-bucket-shrub buckets)))
-            (countdown (i prototype-count)
-              (when (nonzero? (-> bucket count 1))
-                (let ((geometry (-> bucket geometry 1)))
-                  (set! opaque-chain (-> bucket next 1))
-                  (set! opaque-fragment (&+ geometry 32))
-                  (set! opaque-fragments-left (-> (the-as drawable-group geometry) length)))
-                (while (nonzero? opaque-fragments-left)
-                  (+! opaque-fragments-left -1)
-                  (shrub-upload-model (the-as shrubbery opaque-fragment)
-                                      dma-buf
-                                      (the-as int (-> *instance-shrub-work* start-bank (-> bucket mod-count 1))))
-                  (let* ((dma-state dma-buf)
-                         (call-packet (the-as object (-> dma-state base))))
-                    (set! (-> (the-as dma-packet call-packet) dma) (new 'static 'dma-tag :id (dma-tag-id call) :addr opaque-chain))
-                    (set! (-> (the-as dma-packet call-packet) vif0) (new 'static 'vif-tag))
-                    (set! (-> (the-as dma-packet call-packet) vif1) (new 'static 'vif-tag))
-                    (set! (-> dma-state base) (&+ (the-as pointer call-packet) 16)))
-                  (&+! opaque-fragment 32)))
-              (&+! bucket 112)))
-          (let ((chain-end (-> dma-buf base)))
-            (let ((end-packet (the-as object (-> dma-buf base))))
-              (set! (-> (the-as dma-packet end-packet) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-              (set! (-> (the-as dma-packet end-packet) vif0) (new 'static 'vif-tag))
-              (set! (-> (the-as dma-packet end-packet) vif1) (new 'static 'vif-tag))
-              (set! (-> dma-buf base) (&+ (the-as pointer end-packet) 16)))
-            (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                   (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index)) (bucket-id shrub0) (bucket-id shrub1))
-                                   chain-start
-                                   (the-as (pointer dma-tag) chain-end))))
+        (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id shrub0) (bucket-id shrub1))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (shrub-init-frame dma-buf
+                                    (new 'static 'gs-test :ate #x1 :atst (gs-atest greater-equal) :aref #x26 :zte #x1 :ztst (gs-ztest greater-equal))) (let ((bucket (the-as prototype-bucket-shrub buckets)))
+                    (countdown (i prototype-count)
+                      (when (nonzero? (-> bucket count 1))
+                        (let ((geometry (-> bucket geometry 1)))
+                          (set! opaque-chain (-> bucket next 1))
+                          (set! opaque-fragment (&+ geometry 32))
+                          (set! opaque-fragments-left (-> (the-as drawable-group geometry) length)))
+                        (while (nonzero? opaque-fragments-left)
+                          (+! opaque-fragments-left -1)
+                          (shrub-upload-model (the-as shrubbery opaque-fragment)
+                                              dma-buf
+                                              (the-as int (-> *instance-shrub-work* start-bank (-> bucket mod-count 1))))
+                          (let* ((dma-state dma-buf)
+                                 (call-packet (the-as object (-> dma-state base))))
+                            (set! (-> (the-as dma-packet call-packet) dma) (new 'static 'dma-tag :id (dma-tag-id call) :addr opaque-chain))
+                            (set! (-> (the-as dma-packet call-packet) vif0) (new 'static 'vif-tag))
+                            (set! (-> (the-as dma-packet call-packet) vif1) (new 'static 'vif-tag))
+                            (set! (-> dma-state base) (&+ (the-as pointer call-packet) 16)))
+                          (&+! opaque-fragment 32)))
+                      (&+! bucket 112))))
         (let ((usage *dma-mem-usage*))
           (when (nonzero? usage)
             (set! (-> usage length) (max 28 (-> usage length)))
@@ -2593,47 +2491,34 @@
             (set! (-> usage data 27 total) (-> usage data 27 used))))))
     (when (logtest? *vu1-enable-user* (vu1-renderer-mask trans-shrubbery))
       (let ((dma-start (-> *display* frames (-> *display* on-screen) frame global-buf base)))
-        (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-               (chain-start (-> dma-buf base)))
-          (shrub-init-frame dma-buf
-                            (new 'static
-                                 'gs-test
-                                 :ate #x1
-                                 :atst (gs-atest greater-equal)
-                                 :aref #x26
-                                 :afail #x1
-                                 :zte #x1
-                                 :ztst (gs-ztest greater-equal)))
-          (let ((bucket (the-as prototype-bucket-shrub buckets)))
-            (countdown (i prototype-count)
-              (when (nonzero? (-> bucket count 2))
-                (let ((geometry (-> bucket geometry 2)))
-                  (set! translucent-chain (-> bucket next 2))
-                  (set! translucent-fragment (&+ geometry 32))
-                  (set! translucent-fragments-left (-> (the-as drawable-group geometry) length)))
-                (while (nonzero? translucent-fragments-left)
-                  (+! translucent-fragments-left -1)
-                  (shrub-upload-model (the-as shrubbery translucent-fragment)
-                                      dma-buf
-                                      (the-as int (-> *instance-shrub-work* start-bank (-> bucket mod-count 2))))
-                  (let* ((dma-state dma-buf)
-                         (call-packet (the-as object (-> dma-state base))))
-                    (set! (-> (the-as dma-packet call-packet) dma) (new 'static 'dma-tag :id (dma-tag-id call) :addr translucent-chain))
-                    (set! (-> (the-as dma-packet call-packet) vif0) (new 'static 'vif-tag))
-                    (set! (-> (the-as dma-packet call-packet) vif1) (new 'static 'vif-tag))
-                    (set! (-> dma-state base) (&+ (the-as pointer call-packet) 16)))
-                  (&+! translucent-fragment 32)))
-              (&+! bucket 112)))
-          (let ((chain-end (-> dma-buf base)))
-            (let ((end-packet (the-as object (-> dma-buf base))))
-              (set! (-> (the-as dma-packet end-packet) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-              (set! (-> (the-as dma-packet end-packet) vif0) (new 'static 'vif-tag))
-              (set! (-> (the-as dma-packet end-packet) vif1) (new 'static 'vif-tag))
-              (set! (-> dma-buf base) (&+ (the-as pointer end-packet) 16)))
-            (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                   (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index)) (bucket-id shrub-trans0) (bucket-id shrub-trans1))
-                                   chain-start
-                                   (the-as (pointer dma-tag) chain-end))))
+        (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id shrub-trans0) (bucket-id shrub-trans1))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (shrub-init-frame dma-buf
+                                    (new 'static
+                                         'gs-test
+                                         :ate #x1
+                                         :atst (gs-atest greater-equal)
+                                         :aref #x26
+                                         :afail #x1
+                                         :zte #x1
+                                         :ztst (gs-ztest greater-equal))) (let ((bucket (the-as prototype-bucket-shrub buckets)))
+                    (countdown (i prototype-count)
+                      (when (nonzero? (-> bucket count 2))
+                        (let ((geometry (-> bucket geometry 2)))
+                          (set! translucent-chain (-> bucket next 2))
+                          (set! translucent-fragment (&+ geometry 32))
+                          (set! translucent-fragments-left (-> (the-as drawable-group geometry) length)))
+                        (while (nonzero? translucent-fragments-left)
+                          (+! translucent-fragments-left -1)
+                          (shrub-upload-model (the-as shrubbery translucent-fragment)
+                                              dma-buf
+                                              (the-as int (-> *instance-shrub-work* start-bank (-> bucket mod-count 2))))
+                          (let* ((dma-state dma-buf)
+                                 (call-packet (the-as object (-> dma-state base))))
+                            (set! (-> (the-as dma-packet call-packet) dma) (new 'static 'dma-tag :id (dma-tag-id call) :addr translucent-chain))
+                            (set! (-> (the-as dma-packet call-packet) vif0) (new 'static 'vif-tag))
+                            (set! (-> (the-as dma-packet call-packet) vif1) (new 'static 'vif-tag))
+                            (set! (-> dma-state base) (&+ (the-as pointer call-packet) 16)))
+                          (&+! translucent-fragment 32)))
+                      (&+! bucket 112))))
         (let ((usage *dma-mem-usage*))
           (when (nonzero? usage)
             (set! (-> usage length) (max 28 (-> usage length)))
@@ -2688,7 +2573,7 @@
             (set! (-> end-packet vif1) (new 'static 'vif-tag))
             (set! (-> dma-buf base) (the-as pointer (&+ end-packet 16))))
           (let ((insert-result (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                                      (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index)) (bucket-id shrub-billboard0) (bucket-id shrub-billboard1))
+                                                      (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id shrub-billboard0) (bucket-id shrub-billboard1))
                                                       chain-start
                                                       (the-as (pointer dma-tag) chain-end))))
             (let ((usage *dma-mem-usage*))
@@ -2739,20 +2624,8 @@
             ;; NOTE: this part is completely rewritten for PC
             ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
             (when (logtest? *vu1-enable-user* (vu1-renderer-mask shrubbery))
-              (let* ((pc-dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                     (pc-chain-start (-> pc-dma-buf base)))
-                (add-pc-tfrag3-data pc-dma-buf (-> *level* data (-> (scratchpad-object terrain-context) bsp lev-index)))
-                (let ((pc-chain-end (-> pc-dma-buf base)))
-                  (let ((end-packet (the-as object (-> pc-dma-buf base))))
-                    (set! (-> (the-as dma-packet end-packet) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                    (set! (-> (the-as dma-packet end-packet) vif0) (new 'static 'vif-tag))
-                    (set! (-> (the-as dma-packet end-packet) vif1) (new 'static 'vif-tag))
-                    (set! (-> pc-dma-buf base) (&+ (the-as pointer end-packet) 16)))
-                  (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                         (the-as bucket-id
-                                                 (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id shrub0) (bucket-id shrub1)))
-                                         pc-chain-start
-                                         (the-as (pointer dma-tag) pc-chain-end)))))
+              (with-dma-buffer-add-bucket ((pc-dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (the-as bucket-id
+                                                               (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id shrub0) (bucket-id shrub1)))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (add-pc-tfrag3-data pc-dma-buf (-> *level* data (-> (scratchpad-object terrain-context) bsp lev-index)))))
             (read! (-> *perf-stats* data (perf-stat-bucket inst-shrub)))
             (reset! (-> *perf-stats* data (perf-stat-bucket proto-shrub)))
             ; (draw-prototype-inline-array-shrub prototype-count buckets)

goal_src/jak1/engine/gfx/sky/sky-tng.gc

@@ -1451,138 +1451,119 @@
                  'draw
                  (new 'static 'rgba :r #x40 :b #x40 :a #x80)))
     (let ((usage-start (-> *display* frames (-> *display* on-screen) frame global-buf base)))
-      (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-             (bucket-start (-> dma-buf base)))
-        (let* ((state-buffer dma-buf)
-               (state-header (the-as object (-> state-buffer base))))
-          (set! (-> (the-as dma-packet state-header) dma) (new 'static 'dma-tag :qwc #x4 :id (dma-tag-id cnt)))
-          (set! (-> (the-as dma-packet state-header) vif0) (new 'static 'vif-tag))
-          (set! (-> (the-as dma-packet state-header) vif1) (new 'static 'vif-tag :imm #x4 :cmd (vif-cmd direct) :msk #x1))
-          (set! (-> state-buffer base) (&+ (the-as pointer state-header) 16)))
-        (let* ((state-buffer dma-buf)
-               (state-giftag (the-as object (-> state-buffer base))))
-          (set! (-> (the-as gs-gif-tag state-giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x3))
-          (set! (-> (the-as gs-gif-tag state-giftag) regs) GIF_REGS_ALL_AD)
-          (set! (-> state-buffer base) (&+ (the-as pointer state-giftag) 16)))
-        (let* ((state-buffer dma-buf)
-               (state-registers (-> state-buffer base)))
-          (set! (-> (the-as (pointer gs-zbuf) state-registers) 0) (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24)))
-          (set! (-> (the-as (pointer gs-reg64) state-registers) 1) (gs-reg64 zbuf-1))
-          (set! (-> (the-as (pointer gs-test) state-registers) 2)
-                (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
-          (set! (-> (the-as (pointer gs-reg64) state-registers) 3) (gs-reg64 test-1))
-          (set! (-> (the-as (pointer gs-alpha) state-registers) 4) (new 'static 'gs-alpha :b #x1 :d #x1))
-          (set! (-> (the-as (pointer gs-reg64) state-registers) 5) (gs-reg64 alpha-1))
-          (set! (-> state-buffer base) (&+ state-registers 48)))
-        (init-sky-regs)
-        (#unless PC_PORT
-          (m! vf27 (-> *sky-tng-data* giftag-roof qword)))
-        (#when PC_PORT
-          (set-sky-vf27 (&-> *sky-tng-data* giftag-roof qword)))
-        (when *sky-drawn*
-          (let* ((roof-buffer dma-buf)
-                 (roof-header (the-as object (-> roof-buffer base))))
-            (set! (-> (the-as dma-packet roof-header) dma) (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt)))
-            (set! (-> (the-as dma-packet roof-header) vif0) (new 'static 'vif-tag))
-            (set! (-> (the-as dma-packet roof-header) vif1) (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1))
-            (set! (-> roof-buffer base) (&+ (the-as pointer roof-header) 16)))
-          (let* ((roof-buffer dma-buf)
-                 (roof-giftag (the-as object (-> roof-buffer base))))
-            (set! (-> (the-as gs-gif-tag roof-giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x4))
-            (set! (-> (the-as gs-gif-tag roof-giftag) regs) GIF_REGS_ALL_AD)
-            (set! (-> roof-buffer base) (&+ (the-as pointer roof-giftag) 16)))
-          (let* ((roof-state-buffer dma-buf)
-                 (roof-state (-> roof-state-buffer base)))
-            (set! (-> (the-as (pointer gs-tex0) roof-state) 0)
-                  (new 'static 'gs-tex0 :tbw #x1 :th (log2 32) :tw (log2 32) :tbp0 *sky-base-block*))
-            (set! (-> (the-as (pointer gs-reg64) roof-state) 1) (gs-reg64 tex0-1))
-            (set! (-> (the-as (pointer gs-tex1) roof-state) 2) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
-            (set! (-> (the-as (pointer gs-reg64) roof-state) 3) (gs-reg64 tex1-1))
-            (set! (-> (the-as (pointer gs-clamp) roof-state) 4)
-                  (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
-            (set! (-> (the-as (pointer gs-reg64) roof-state) 5) (gs-reg64 clamp-1))
-            (set! (-> (the-as (pointer uint64) roof-state) 6) (the-as uint 0))
-            (set! (-> (the-as (pointer gs-reg64) roof-state) 7) (gs-reg64 texflush))
-            (set! (-> roof-state-buffer base) (&+ roof-state 64)))
-          (let ((roof-packet-start (the-as object (-> dma-buf base))))
-            (&+! (-> dma-buf base) 16)
-            (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-roof-polygons 0)) dma-buf)
-            (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-roof-polygons 3)) dma-buf)
-            (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-roof-polygons 6)) dma-buf)
-            (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-roof-polygons 9)) dma-buf)
-            (close-sky-buffer dma-buf)
-            (let ((roof-qwc (/ (the-as int (+ (- -16 (the-as int roof-packet-start)) (the-as int (-> dma-buf base)))) 16)))
-              (set! (-> (the-as dma-packet roof-packet-start) dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc roof-qwc))
-              (set! (-> (the-as dma-packet roof-packet-start) vif0) (new 'static 'vif-tag))
-              (set! (-> (the-as dma-packet roof-packet-start) vif1) (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1 :imm roof-qwc)))))
-        (when *cloud-drawn*
-          (let* ((cloud-buffer dma-buf)
-                 (cloud-header (the-as object (-> cloud-buffer base))))
-            (set! (-> (the-as dma-packet cloud-header) dma) (new 'static 'dma-tag :qwc #x6 :id (dma-tag-id cnt)))
-            (set! (-> (the-as dma-packet cloud-header) vif0) (new 'static 'vif-tag))
-            (set! (-> (the-as dma-packet cloud-header) vif1) (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1))
-            (set! (-> cloud-buffer base) (&+ (the-as pointer cloud-header) 16)))
-          (let* ((cloud-buffer dma-buf)
-                 (cloud-giftag (the-as object (-> cloud-buffer base))))
-            (set! (-> (the-as gs-gif-tag cloud-giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x5))
-            (set! (-> (the-as gs-gif-tag cloud-giftag) regs) GIF_REGS_ALL_AD)
-            (set! (-> cloud-buffer base) (&+ (the-as pointer cloud-giftag) 16)))
-          (let* ((cloud-state-buffer dma-buf)
-                 (cloud-state (-> cloud-state-buffer base)))
-            (set! (-> (the-as (pointer gs-alpha) cloud-state) 0) (new 'static 'gs-alpha :b #x2 :d #x1))
-            (set! (-> (the-as (pointer gs-reg64) cloud-state) 1) (gs-reg64 alpha-1))
-            (set! (-> (the-as (pointer gs-tex0) cloud-state) 2)
-                  (new 'static 'gs-tex0 :tbw #x1 :th (log2 64) :tw (log2 64) :tbp0 (+ *sky-base-block* 32)))
-            (set! (-> (the-as (pointer gs-reg64) cloud-state) 3) (gs-reg64 tex0-1))
-            (set! (-> (the-as (pointer gs-tex1) cloud-state) 4) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
-            (set! (-> (the-as (pointer gs-reg64) cloud-state) 5) (gs-reg64 tex1-1))
-            (set! (-> (the-as (pointer gs-clamp) cloud-state) 6) (new 'static 'gs-clamp))
-            (set! (-> (the-as (pointer gs-reg64) cloud-state) 7) (gs-reg64 clamp-1))
-            (set! (-> (the-as (pointer int64) cloud-state) 8) 0)
-            (set! (-> (the-as (pointer gs-reg64) cloud-state) 9) (gs-reg64 texflush))
-            (set! (-> cloud-state-buffer base) (&+ cloud-state 80)))
-          (let ((cloud-packet-start (the-as object (-> dma-buf base))))
-            (&+! (-> dma-buf base) 16)
-            (init-sky-regs)
-            (let ((vertices (the-as object (-> sky-cloud-polygons 0))))
-              (set-tex-offset (the-as int (-> *sky-tng-data* off-s-0)) (the-as int (-> *sky-tng-data* off-t-0)))
-              ;; first cloud layer
-              (dotimes (i 9)
-                (render-sky-quad (the-as (inline-array sky-vertex) vertices) dma-buf)
-                (set! vertices (-> (the-as (inline-array sky-vertex) vertices) 4)))
-              (set-tex-offset (the-as int (-> *sky-tng-data* off-s-1)) (the-as int (-> *sky-tng-data* off-t-1)))
-              ;; second cloud layer
-              (dotimes (i 9)
-                (render-sky-quad (the-as (inline-array sky-vertex) vertices) dma-buf)
-                (set! vertices (-> (the-as (inline-array sky-vertex) vertices) 4))))
-            ;; The untextured base triangles fill the region below the roof at GS layer depth 256.
-            (#unless PC_PORT
-              (m! vf27 (-> *sky-tng-data* giftag-base qword))
-              (let ((base-depth-bits #x43800000)) (m vf23 base-depth-bits))
-              (m base-depth vf23))
-            (#when PC_PORT
-              (set-sky-vf27 (&-> *sky-tng-data* giftag-base qword))
-              (set-sky-vf23-value #x43800000))
-            (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-base-polygons 0)) dma-buf)
-            (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-base-polygons 3)) dma-buf)
-            (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-base-polygons 6)) dma-buf)
-            (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-base-polygons 9)) dma-buf)
-            (close-sky-buffer dma-buf)
-            (let ((cloud-qwc (/ (the-as int (+ (- -16 (the-as int cloud-packet-start)) (the-as int (-> dma-buf base)))) 16)))
-              (set! (-> (the-as dma-packet cloud-packet-start) dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc cloud-qwc))
-              (set! (-> (the-as dma-packet cloud-packet-start) vif0) (new 'static 'vif-tag))
-              (set! (-> (the-as dma-packet cloud-packet-start) vif1)
-                    (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1 :imm cloud-qwc)))))
-        (let ((end-tag (-> dma-buf base)))
-          (let ((next-tag (the-as object (-> dma-buf base))))
-            (set! (-> (the-as dma-packet next-tag) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-            (set! (-> (the-as dma-packet next-tag) vif0) (new 'static 'vif-tag))
-            (set! (-> (the-as dma-packet next-tag) vif1) (new 'static 'vif-tag))
-            (set! (-> dma-buf base) (&+ (the-as pointer next-tag) 16)))
-          (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                 (bucket-id sky-draw)
-                                 bucket-start
-                                 (the-as (pointer dma-tag) end-tag))))
+      (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (bucket-id sky-draw)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let* ((state-buffer dma-buf)
+                     (state-header (the-as object (-> state-buffer base))))
+                (set! (-> (the-as dma-packet state-header) dma) (new 'static 'dma-tag :qwc #x4 :id (dma-tag-id cnt)))
+                (set! (-> (the-as dma-packet state-header) vif0) (new 'static 'vif-tag))
+                (set! (-> (the-as dma-packet state-header) vif1) (new 'static 'vif-tag :imm #x4 :cmd (vif-cmd direct) :msk #x1))
+                (set! (-> state-buffer base) (&+ (the-as pointer state-header) 16))) (let* ((state-buffer dma-buf)
+                     (state-giftag (the-as object (-> state-buffer base))))
+                (set! (-> (the-as gs-gif-tag state-giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x3))
+                (set! (-> (the-as gs-gif-tag state-giftag) regs) GIF_REGS_ALL_AD)
+                (set! (-> state-buffer base) (&+ (the-as pointer state-giftag) 16))) (let* ((state-buffer dma-buf)
+                     (state-registers (-> state-buffer base)))
+                (set! (-> (the-as (pointer gs-zbuf) state-registers) 0) (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24)))
+                (set! (-> (the-as (pointer gs-reg64) state-registers) 1) (gs-reg64 zbuf-1))
+                (set! (-> (the-as (pointer gs-test) state-registers) 2)
+                      (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
+                (set! (-> (the-as (pointer gs-reg64) state-registers) 3) (gs-reg64 test-1))
+                (set! (-> (the-as (pointer gs-alpha) state-registers) 4) (new 'static 'gs-alpha :b #x1 :d #x1))
+                (set! (-> (the-as (pointer gs-reg64) state-registers) 5) (gs-reg64 alpha-1))
+                (set! (-> state-buffer base) (&+ state-registers 48))) (init-sky-regs) (#unless PC_PORT
+                (m! vf27 (-> *sky-tng-data* giftag-roof qword))) (#when PC_PORT
+                (set-sky-vf27 (&-> *sky-tng-data* giftag-roof qword))) (when *sky-drawn*
+                (let* ((roof-buffer dma-buf)
+                       (roof-header (the-as object (-> roof-buffer base))))
+                  (set! (-> (the-as dma-packet roof-header) dma) (new 'static 'dma-tag :qwc #x5 :id (dma-tag-id cnt)))
+                  (set! (-> (the-as dma-packet roof-header) vif0) (new 'static 'vif-tag))
+                  (set! (-> (the-as dma-packet roof-header) vif1) (new 'static 'vif-tag :imm #x5 :cmd (vif-cmd direct) :msk #x1))
+                  (set! (-> roof-buffer base) (&+ (the-as pointer roof-header) 16)))
+                (let* ((roof-buffer dma-buf)
+                       (roof-giftag (the-as object (-> roof-buffer base))))
+                  (set! (-> (the-as gs-gif-tag roof-giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x4))
+                  (set! (-> (the-as gs-gif-tag roof-giftag) regs) GIF_REGS_ALL_AD)
+                  (set! (-> roof-buffer base) (&+ (the-as pointer roof-giftag) 16)))
+                (let* ((roof-state-buffer dma-buf)
+                       (roof-state (-> roof-state-buffer base)))
+                  (set! (-> (the-as (pointer gs-tex0) roof-state) 0)
+                        (new 'static 'gs-tex0 :tbw #x1 :th (log2 32) :tw (log2 32) :tbp0 *sky-base-block*))
+                  (set! (-> (the-as (pointer gs-reg64) roof-state) 1) (gs-reg64 tex0-1))
+                  (set! (-> (the-as (pointer gs-tex1) roof-state) 2) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
+                  (set! (-> (the-as (pointer gs-reg64) roof-state) 3) (gs-reg64 tex1-1))
+                  (set! (-> (the-as (pointer gs-clamp) roof-state) 4)
+                        (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
+                  (set! (-> (the-as (pointer gs-reg64) roof-state) 5) (gs-reg64 clamp-1))
+                  (set! (-> (the-as (pointer uint64) roof-state) 6) (the-as uint 0))
+                  (set! (-> (the-as (pointer gs-reg64) roof-state) 7) (gs-reg64 texflush))
+                  (set! (-> roof-state-buffer base) (&+ roof-state 64)))
+                (let ((roof-packet-start (the-as object (-> dma-buf base))))
+                  (&+! (-> dma-buf base) 16)
+                  (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-roof-polygons 0)) dma-buf)
+                  (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-roof-polygons 3)) dma-buf)
+                  (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-roof-polygons 6)) dma-buf)
+                  (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-roof-polygons 9)) dma-buf)
+                  (close-sky-buffer dma-buf)
+                  (let ((roof-qwc (/ (the-as int (+ (- -16 (the-as int roof-packet-start)) (the-as int (-> dma-buf base)))) 16)))
+                    (set! (-> (the-as dma-packet roof-packet-start) dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc roof-qwc))
+                    (set! (-> (the-as dma-packet roof-packet-start) vif0) (new 'static 'vif-tag))
+                    (set! (-> (the-as dma-packet roof-packet-start) vif1) (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1 :imm roof-qwc))))) (when *cloud-drawn*
+                (let* ((cloud-buffer dma-buf)
+                       (cloud-header (the-as object (-> cloud-buffer base))))
+                  (set! (-> (the-as dma-packet cloud-header) dma) (new 'static 'dma-tag :qwc #x6 :id (dma-tag-id cnt)))
+                  (set! (-> (the-as dma-packet cloud-header) vif0) (new 'static 'vif-tag))
+                  (set! (-> (the-as dma-packet cloud-header) vif1) (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1))
+                  (set! (-> cloud-buffer base) (&+ (the-as pointer cloud-header) 16)))
+                (let* ((cloud-buffer dma-buf)
+                       (cloud-giftag (the-as object (-> cloud-buffer base))))
+                  (set! (-> (the-as gs-gif-tag cloud-giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x5))
+                  (set! (-> (the-as gs-gif-tag cloud-giftag) regs) GIF_REGS_ALL_AD)
+                  (set! (-> cloud-buffer base) (&+ (the-as pointer cloud-giftag) 16)))
+                (let* ((cloud-state-buffer dma-buf)
+                       (cloud-state (-> cloud-state-buffer base)))
+                  (set! (-> (the-as (pointer gs-alpha) cloud-state) 0) (new 'static 'gs-alpha :b #x2 :d #x1))
+                  (set! (-> (the-as (pointer gs-reg64) cloud-state) 1) (gs-reg64 alpha-1))
+                  (set! (-> (the-as (pointer gs-tex0) cloud-state) 2)
+                        (new 'static 'gs-tex0 :tbw #x1 :th (log2 64) :tw (log2 64) :tbp0 (+ *sky-base-block* 32)))
+                  (set! (-> (the-as (pointer gs-reg64) cloud-state) 3) (gs-reg64 tex0-1))
+                  (set! (-> (the-as (pointer gs-tex1) cloud-state) 4) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
+                  (set! (-> (the-as (pointer gs-reg64) cloud-state) 5) (gs-reg64 tex1-1))
+                  (set! (-> (the-as (pointer gs-clamp) cloud-state) 6) (new 'static 'gs-clamp))
+                  (set! (-> (the-as (pointer gs-reg64) cloud-state) 7) (gs-reg64 clamp-1))
+                  (set! (-> (the-as (pointer int64) cloud-state) 8) 0)
+                  (set! (-> (the-as (pointer gs-reg64) cloud-state) 9) (gs-reg64 texflush))
+                  (set! (-> cloud-state-buffer base) (&+ cloud-state 80)))
+                (let ((cloud-packet-start (the-as object (-> dma-buf base))))
+                  (&+! (-> dma-buf base) 16)
+                  (init-sky-regs)
+                  (let ((vertices (the-as object (-> sky-cloud-polygons 0))))
+                    (set-tex-offset (the-as int (-> *sky-tng-data* off-s-0)) (the-as int (-> *sky-tng-data* off-t-0)))
+                    ;; first cloud layer
+                    (dotimes (i 9)
+                      (render-sky-quad (the-as (inline-array sky-vertex) vertices) dma-buf)
+                      (set! vertices (-> (the-as (inline-array sky-vertex) vertices) 4)))
+                    (set-tex-offset (the-as int (-> *sky-tng-data* off-s-1)) (the-as int (-> *sky-tng-data* off-t-1)))
+                    ;; second cloud layer
+                    (dotimes (i 9)
+                      (render-sky-quad (the-as (inline-array sky-vertex) vertices) dma-buf)
+                      (set! vertices (-> (the-as (inline-array sky-vertex) vertices) 4))))
+                  ;; The untextured base triangles fill the region below the roof at GS layer depth 256.
+                  (#unless PC_PORT
+                    (m! vf27 (-> *sky-tng-data* giftag-base qword))
+                    (let ((base-depth-bits #x43800000)) (m vf23 base-depth-bits))
+                    (m base-depth vf23))
+                  (#when PC_PORT
+                    (set-sky-vf27 (&-> *sky-tng-data* giftag-base qword))
+                    (set-sky-vf23-value #x43800000))
+                  (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-base-polygons 0)) dma-buf)
+                  (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-base-polygons 3)) dma-buf)
+                  (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-base-polygons 6)) dma-buf)
+                  (render-sky-tri (the-as (inline-array sky-vertex) (-> sky-base-polygons 9)) dma-buf)
+                  (close-sky-buffer dma-buf)
+                  (let ((cloud-qwc (/ (the-as int (+ (- -16 (the-as int cloud-packet-start)) (the-as int (-> dma-buf base)))) 16)))
+                    (set! (-> (the-as dma-packet cloud-packet-start) dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc cloud-qwc))
+                    (set! (-> (the-as dma-packet cloud-packet-start) vif0) (new 'static 'vif-tag))
+                    (set! (-> (the-as dma-packet cloud-packet-start) vif1)
+                          (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1 :imm cloud-qwc))))))
       (let ((usage *dma-mem-usage*))
         (when (nonzero? usage)
           (set! (-> usage length) (max 86 (-> usage length)))
@@ -1671,39 +1652,21 @@
         (let ((blend-bucket (if (zero? level-index) (the-as bucket-id (bucket-id tfrag-trans-0)) (the-as bucket-id (bucket-id tfrag-trans-1))))
               (adgifs (-> *level* level level-index bsp adgifs)))
           (when (nonzero? adgifs)
-            (let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                   (packet-start (-> dma-buf base)))
-              (set-display-gs-state dma-buf *sky-base-page* 64 96 0 0)
-              (dotimes (texture-index 8)
-                (let ((texture-weight (* (-> context moods level-index sky-times texture-index) level-weight)))
-                  (if (!= texture-weight 0.0) (copy-sky-texture dma-buf (-> adgifs data texture-index) texture-weight))))
-              (copy-cloud-texture dma-buf (-> adgifs data 8) level-weight)
-              (let* ((finish-buffer dma-buf)
-                     (finish-header (the-as object (-> finish-buffer base))))
-                (set! (-> (the-as dma-packet finish-header) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
-                (set! (-> (the-as dma-packet finish-header) vif0) (new 'static 'vif-tag))
-                (set! (-> (the-as dma-packet finish-header) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
-                (set! (-> finish-buffer base) (&+ (the-as pointer finish-header) 16)))
-              (let* ((finish-buffer dma-buf)
-                     (finish-giftag (the-as object (-> finish-buffer base))))
-                (set! (-> (the-as gs-gif-tag finish-giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
-                (set! (-> (the-as gs-gif-tag finish-giftag) regs) GIF_REGS_ALL_AD)
-                (set! (-> finish-buffer base) (&+ (the-as pointer finish-giftag) 16)))
-              (let* ((finish-buffer dma-buf)
-                     (finish-alpha (-> finish-buffer base)))
-                (set! (-> (the-as (pointer gs-alpha) finish-alpha) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
-                (set! (-> (the-as (pointer gs-reg64) finish-alpha) 1) (gs-reg64 alpha-1))
-                (set! (-> finish-buffer base) (&+ finish-alpha 16)))
-              (reset-display-gs-state *display* dma-buf *oddeven*)
-              (let ((end-tag (-> dma-buf base)))
-                (let ((next-tag (the-as object (-> dma-buf base))))
-                  (set! (-> (the-as dma-packet next-tag) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                  (set! (-> (the-as dma-packet next-tag) vif0) (new 'static 'vif-tag))
-                  (set! (-> (the-as dma-packet next-tag) vif1) (new 'static 'vif-tag))
-                  (set! (-> dma-buf base) (&+ (the-as pointer next-tag) 16)))
-                (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                       (the-as bucket-id blend-bucket)
-                                       packet-start
-                                       (the-as (pointer dma-tag) end-tag)))))))))
+            (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (the-as bucket-id blend-bucket)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set-display-gs-state dma-buf *sky-base-page* 64 96 0 0) (dotimes (texture-index 8)
+                            (let ((texture-weight (* (-> context moods level-index sky-times texture-index) level-weight)))
+                              (if (!= texture-weight 0.0) (copy-sky-texture dma-buf (-> adgifs data texture-index) texture-weight)))) (copy-cloud-texture dma-buf (-> adgifs data 8) level-weight) (let* ((finish-buffer dma-buf)
+                                 (finish-header (the-as object (-> finish-buffer base))))
+                            (set! (-> (the-as dma-packet finish-header) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
+                            (set! (-> (the-as dma-packet finish-header) vif0) (new 'static 'vif-tag))
+                            (set! (-> (the-as dma-packet finish-header) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
+                            (set! (-> finish-buffer base) (&+ (the-as pointer finish-header) 16))) (let* ((finish-buffer dma-buf)
+                                 (finish-giftag (the-as object (-> finish-buffer base))))
+                            (set! (-> (the-as gs-gif-tag finish-giftag) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
+                            (set! (-> (the-as gs-gif-tag finish-giftag) regs) GIF_REGS_ALL_AD)
+                            (set! (-> finish-buffer base) (&+ (the-as pointer finish-giftag) 16))) (let* ((finish-buffer dma-buf)
+                                 (finish-alpha (-> finish-buffer base)))
+                            (set! (-> (the-as (pointer gs-alpha) finish-alpha) 0) (new 'static 'gs-alpha :b #x1 :d #x1))
+                            (set! (-> (the-as (pointer gs-reg64) finish-alpha) 1) (gs-reg64 alpha-1))
+                            (set! (-> finish-buffer base) (&+ finish-alpha 16))) (reset-display-gs-state *display* dma-buf *oddeven*)))))))
   0
   (none))

goal_src/jak1/engine/gfx/sprite/sparticle/sparticle-launcher.gc

@@ -615,7 +615,7 @@
     (let ((entry (-> queue queue (-> queue in-use))))
       (set! (-> entry sp-system) sys)
       (set! (-> entry sp-launcher) launcher)
-      (set! (-> entry pos quad) (-> pos quad)))
+      (vector-copy! (-> entry pos) pos))
     (let ((new-count (+ (-> queue in-use) 1))) (set! (-> queue in-use) new-count) new-count)))
 
 (defun sp-adjust-launch ((launchinfo sparticle-launchinfo) (cpuinfo sparticle-cpuinfo) (init-specs (inline-array sp-field-init-spec)))
@@ -1668,7 +1668,7 @@
    For periodic items (period != 0), [offset .. offset+length) within each period is the active
    window; the periodic path computes how much of the elapsed interval overlapped that window. Items are
    suppressed by hour-mask (time of day) and by fade-after (camera distance)."
-  (set! (-> this center quad) (-> pos quad))
+  (vector-copy! (-> this center) pos)
   ;; og:preserve-this
   ;; check if we are visible (remove this check to force particles to be drawn.)
   (if (not (or (is-visible? this pos) (logtest? (-> this group flags) (sp-group-flag always-draw screen-space))))

goal_src/jak1/engine/gfx/sprite/sparticle/sparticle.gc

@@ -23,10 +23,10 @@
   (let ((color (-> src sprite color quad))) (set! (-> dst sprite color quad) color))
   (dotimes (i 10)
     (set! (-> dst adgif prims i) (-> src adgif prims i)))
-  (set! (-> dst vel-sxvel quad) (-> src vel-sxvel quad))
-  (set! (-> dst rot-syvel quad) (-> src rot-syvel quad))
-  (set! (-> dst fade quad) (-> src fade quad))
-  (set! (-> dst acc quad) (-> src acc quad))
+  (vector-copy! (-> dst vel-sxvel) (-> src vel-sxvel))
+  (vector-copy! (-> dst rot-syvel) (-> src rot-syvel))
+  (vector-copy! (-> dst fade) (-> src fade))
+  (vector-copy! (-> dst acc) (-> src acc))
   (set! (-> dst friction) (-> src friction))
   (set! (-> dst timer) (-> src timer))
   (set! (-> dst flags) (-> src flags))

goal_src/jak1/engine/gfx/sprite/sprite.gc

@@ -190,8 +190,8 @@
 (defun sprite-setup-frame-data ((data sprite-frame-data) (tbp-offset int))
   "Build the VU1 sprite constants for this frame: GIF tags, texture state, sine and cosine
    coefficients, camera scales, unit-quad templates, perspective correction, color, and fog."
-  (set! (-> data hmge-scale quad) (-> *math-camera* hmge-scale quad))
-  (set! (-> data inv-hmge-scale quad) (-> *math-camera* inv-hmge-scale quad))
+  (vector-copy! (-> data hmge-scale) (-> *math-camera* hmge-scale))
+  (vector-copy! (-> data inv-hmge-scale) (-> *math-camera* inv-hmge-scale))
   (set! (-> data pfog0) (-> *math-camera* pfog0))
   (set! (-> data deg-to-rad) 0.000095873795)
   ;; the adgif-giftag sets GS registers according to the adgif shader using
@@ -336,12 +336,12 @@
   (set! (-> data sincos-67 w) -0.0013636408)
   (set! (-> data sincos-89 w) 0.000020170546)
   ;; math camera stuff
-  (set! (-> data basis-x quad) (the-as uint128 0))
+  (vector-zero! (-> data basis-x))
   (set! (-> data basis-x x) (- (-> *math-camera* perspective vector 0 x)))
   (with-pc
     (when (pc-cheats? (-> *pc-settings* cheats) mirror)
       (*! (-> data basis-x x) -1.0)))
-  (set! (-> data basis-y quad) (the-as uint128 0))
+  (vector-zero! (-> data basis-y))
   (set! (-> data basis-y y) (- (-> *math-camera* perspective vector 1 y)))
   (set! (-> data min-scale) (sqrtf (* (/ 1.0 (-> data basis-x x)) (/ 1.0 (-> data basis-y y)))))
   (set! (-> data inv-area) (/ 1.0 (* (-> data min-scale) (-> data min-scale))))
@@ -493,16 +493,7 @@
                                      (new 'static 'vif-unpack-imm :addr vu-address)))
        ;; sent the camera-temp matrix
        ;; these weren't done through the usual macros which is strange
-       (let* ((mtx (the-as matrix (-> dma-buff base)))
-              (camera-matrix (-> *math-camera* camera-temp))
-              (camera-row-0 (-> camera-matrix vector 0 quad))
-              (camera-row-1 (-> camera-matrix vector 1 quad))
-              (camera-row-2 (-> camera-matrix vector 2 quad))
-              (camera-row-3 (-> camera-matrix vector 3 quad)))
-         (set! (-> mtx vector 0 quad) camera-row-0)
-         (set! (-> mtx vector 1 quad) camera-row-1)
-         (set! (-> mtx vector 2 quad) camera-row-2)
-         (set! (-> mtx vector 3 quad) camera-row-3))
+       (matrix-copy! (the-as matrix (-> dma-buff base)) (-> *math-camera* camera-temp))
        (&+! (-> dma-buff base) 64)
        ;; The fifth quadword is the camera's homogeneous divide and fog offset.
        (let ((v1-1 (+ vu-address 4)))
@@ -544,7 +535,7 @@
        (&+! (-> dma-buff base) 64)
        (let ((v1-2 (+ vu-address 4)))
          (let ((screen-offset (the-as vector (-> dma-buff base))))
-           (set! (-> screen-offset quad) (-> *math-camera* hvdf-off quad))
+           (vector-copy! screen-offset (-> *math-camera* hvdf-off))
            (set! (-> screen-offset x) 2048.0)
            (set! (-> screen-offset y) 2048.0)
            (set! (-> screen-offset z) (-> *math-camera* hvdf-off z)))

goal_src/jak1/engine/gfx/texture/texture.gc

@@ -121,7 +121,7 @@
   "Get the size in memory of a texture page object, not including the actual texture objects or texture data"
   (the-as int (+ (-> this type size) (the-as uint (shl (-> this length) 2)))))
 
-(defmethod mem-usage ((this texture-page) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this texture-page) (usage memory-usage-block) (flags mem-usage-flags))
   "Charge this page's texture records and retained image data to texture memory usage."
   ;; some setup for texture memory usage.
   (set! (-> usage length) (max (+ 1 (mem-usage-id-int texture)) (-> usage length)))

goal_src/jak1/engine/gfx/tfrag/tfrag-methods.gc

@@ -65,8 +65,8 @@
                    (child-array (-> tree arrays (+ depth-index 1)))
                    (parent-vis-byte-index (/ (-> (the-as drawable-inline-array-node parent-array) data 0 id) 8))
                    (child-vis-byte-index (/ (-> (the-as drawable-inline-array-node child-array) data 0 id) 8))
-                   (parent-visibility (&-> (the-as terrain-context #x70000000) work background vis-list parent-vis-byte-index))
-                   (child-visibility (&-> (the-as terrain-context #x70000000) work background vis-list child-vis-byte-index)))
+                   (parent-visibility (&-> (scratchpad-object terrain-context) work background vis-list parent-vis-byte-index))
+                   (child-visibility (&-> (scratchpad-object terrain-context) work background vis-list child-vis-byte-index)))
               (draw-node-cull child-visibility
                               parent-visibility
                               (-> (the-as drawable-inline-array-node parent-array) data)
@@ -74,13 +74,13 @@
         (let* ((fragment-array (the-as drawable-inline-array-tfrag (-> tree arrays last-array-index)))
                (fragments (-> fragment-array data))
                (fragment-count (-> fragment-array length)))
-          (set! visibility-bits (&-> (the-as terrain-context #x70000000) work background vis-list (/ (-> fragments 0 id) 8)))
+          (set! visibility-bits (&-> (scratchpad-object terrain-context) work background vis-list (/ (-> fragments 0 id) 8)))
           (let ((dma-start (-> (current-frame) global-buf base)))
             ;; Far and near are two passes over the same fragment array into two buckets. Both open a
             ;; chain in the global buffer, end it with a next tag and hand the span to the bucket
             ;; system, which patches the chains together before the DMA goes out.
             (with-dma-buffer-add-bucket ((far-dma-buf (-> (current-frame) global-buf))
-                                         (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index))
+                                         (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index))
                                            (bucket-id tfrag-0)
                                            (bucket-id tfrag-1)))
               (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0))
@@ -97,7 +97,7 @@
                                  (-> *tfrag-work* wait-from-spr))
               (tfrag-end-buffer far-dma-buf))
             (with-dma-buffer-add-bucket ((near-dma-buf (-> (current-frame) global-buf))
-                                         (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index))
+                                         (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index))
                                            (bucket-id tfrag-near-0)
                                            (bucket-id tfrag-near-1)))
               (set! (-> *tfrag-work* near-wait-to-spr) (the-as uint 0))
@@ -166,40 +166,22 @@
           (let ((s5-1 (-> *display* frames (-> *display* on-screen) frame global-buf base)))
             ;; (format *stdcon* " #x~X~%" s5-1)
             ;; DMA for TFRAG
-            (let* ((s1-0 (-> *display* frames (-> *display* on-screen) frame global-buf))
-                   (s2-0 (-> s1-0 base)))
-              ;; clear stats
-              (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0))
-              (set! (-> *tfrag-work* wait-from-spr) (the-as uint 0))
-              ;; initialize dma buffer
-              (tfrag-init-buffer s1-0
-                                 (new 'static 'gs-test :ate #x1 :atst (gs-atest greater-equal) :aref #x26 :zte #x1 :ztst (gs-ztest greater-equal))
-                                 0
-                                 lev)
-              ;; do the draw!
-              (reset! (-> *perf-stats* data 5))
-              ;;(format 0 "DRAW: ~D~%" s3-0)
-              ;; (draw-inline-array-tfrag sv-16 (the-as drawable-inline-array s4-1) s3-0 s1-0)
-              (read! (-> *perf-stats* data 5))
-              ;; update stats for the draw
-              (update-wait-stats (-> *perf-stats* data 5)
-                                 (the-as uint 0)
-                                 (-> *tfrag-work* wait-to-spr)
-                                 (-> *tfrag-work* wait-from-spr))
-              ;; finish dma buffer
-              (tfrag-end-buffer s1-0)
-              ;; close dma packet
-              (let ((a3-3 (-> s1-0 base)))
-                (let ((v1-38 (the-as object (-> s1-0 base))))
-                  (set! (-> (the-as dma-packet v1-38) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                  (set! (-> (the-as dma-packet v1-38) vif0) (new 'static 'vif-tag))
-                  (set! (-> (the-as dma-packet v1-38) vif1) (new 'static 'vif-tag))
-                  (set! (-> s1-0 base) (&+ (the-as pointer v1-38) 16)))
-                (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                       (the-as bucket-id
-                                               (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id tfrag-0) (bucket-id tfrag-1)))
-                                       s2-0
-                                       (the-as (pointer dma-tag) a3-3))))
+            ;; clear stats
+            ;; initialize dma buffer
+            ;; do the draw!
+            ;;(format 0 "DRAW: ~D~%" s3-0)
+            ;; (draw-inline-array-tfrag sv-16 (the-as drawable-inline-array s4-1) s3-0 s1-0)
+            ;; update stats for the draw
+            ;; finish dma buffer
+            ;; close dma packet
+            (with-dma-buffer-add-bucket ((s1-0 (-> *display* frames (-> *display* on-screen) frame global-buf)) (the-as bucket-id
+                                                           (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id tfrag-0) (bucket-id tfrag-1)))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0)) (set! (-> *tfrag-work* wait-from-spr) (the-as uint 0)) (tfrag-init-buffer s1-0
+                                             (new 'static 'gs-test :ate #x1 :atst (gs-atest greater-equal) :aref #x26 :zte #x1 :ztst (gs-ztest greater-equal))
+                                             0
+                                             lev) (reset! (-> *perf-stats* data 5)) (read! (-> *perf-stats* data 5)) (update-wait-stats (-> *perf-stats* data 5)
+                                             (the-as uint 0)
+                                             (-> *tfrag-work* wait-to-spr)
+                                             (-> *tfrag-work* wait-from-spr)) (tfrag-end-buffer s1-0))
             ;; (format *stdcon* " #x~X~%" (-> *display* frames (-> *display* on-screen) frame global-buf base))
             ;; DMA for TFRAG NEAR
             ; (let* ((s1-1 (-> *display* frames (-> *display* on-screen) frame global-buf))
@@ -260,8 +242,8 @@
                    (child-array (-> tree arrays (+ depth-index 1)))
                    (parent-vis-byte-index (/ (-> (the-as drawable-inline-array-node parent-array) data 0 id) 8))
                    (child-vis-byte-index (/ (-> (the-as drawable-inline-array-node child-array) data 0 id) 8))
-                   (parent-visibility (&-> (the-as terrain-context #x70000000) work background vis-list parent-vis-byte-index))
-                   (child-visibility (&-> (the-as terrain-context #x70000000) work background vis-list child-vis-byte-index)))
+                   (parent-visibility (&-> (scratchpad-object terrain-context) work background vis-list parent-vis-byte-index))
+                   (child-visibility (&-> (scratchpad-object terrain-context) work background vis-list child-vis-byte-index)))
               (draw-node-cull child-visibility
                               parent-visibility
                               (-> (the-as drawable-inline-array-node parent-array) data)
@@ -269,9 +251,9 @@
         (let* ((fragment-array (-> tree arrays last-array-index))
                (fragments (&+ fragment-array 32))
                (fragment-count (-> fragment-array length)))
-          (set! visibility-bits (&-> (the-as terrain-context #x70000000) work background vis-list (/ (-> fragments id) 8)))
+          (set! visibility-bits (&-> (scratchpad-object terrain-context) work background vis-list (/ (-> fragments id) 8)))
           (with-dma-buffer-add-bucket ((far-dma-buf (-> (current-frame) global-buf))
-                                       (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index))
+                                       (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index))
                                          (bucket-id tfrag-trans-0)
                                          (bucket-id tfrag-trans-1)))
             (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0))
@@ -295,7 +277,7 @@
             (read! (-> *perf-stats* data 5))
             (tfrag-end-buffer far-dma-buf))
           (with-dma-buffer-add-bucket ((near-dma-buf (-> (current-frame) global-buf))
-                                       (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index))
+                                       (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index))
                                          (bucket-id tfrag-trans-near-0)
                                          (bucket-id tfrag-trans-near-1)))
             (set! (-> *tfrag-work* near-wait-to-spr) (the-as uint 0))
@@ -351,40 +333,22 @@
                (s5-1 (&+ v1-13 32))
                (s4-1 (-> v1-13 length)))
           (set! sv-16 (&-> (scratchpad-object terrain-context) work background vis-list (/ (-> s5-1 id) 8)))
-          (let* ((s2-0 (-> *display* frames (-> *display* on-screen) frame global-buf))
-                 (s3-0 (-> s2-0 base)))
-            (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0))
-            (set! (-> *tfrag-work* wait-from-spr) (the-as uint 0))
-            (tfrag-init-buffer s2-0
-                               (new 'static
-                                    'gs-test
-                                    :ate #x1
-                                    :atst (gs-atest greater-equal)
-                                    :aref #x7e
-                                    :afail #x1
-                                    :zte #x1
-                                    :ztst (gs-ztest greater-equal))
-                               1
-                               lev)
-            (reset! (-> *perf-stats* data 5))
-            ;; (draw-inline-array-tfrag sv-16 s5-1 s4-1 s2-0)
-            (update-wait-stats (-> *perf-stats* data 5)
-                               (the-as uint 0)
-                               (-> *tfrag-work* wait-to-spr)
-                               (-> *tfrag-work* wait-from-spr))
-            (read! (-> *perf-stats* data 5))
-            (tfrag-end-buffer s2-0)
-            (let ((a3-3 (-> s2-0 base)))
-              (let ((v1-34 (the-as object (-> s2-0 base))))
-                (set! (-> (the-as dma-packet v1-34) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                (set! (-> (the-as dma-packet v1-34) vif0) (new 'static 'vif-tag))
-                (set! (-> (the-as dma-packet v1-34) vif1) (new 'static 'vif-tag))
-                (set! (-> s2-0 base) (&+ (the-as pointer v1-34) 16)))
-              (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                     (the-as bucket-id
-                                             (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id tfrag-trans-0) (bucket-id tfrag-trans-1)))
-                                     s3-0
-                                     (the-as (pointer dma-tag) a3-3))))
+          ;; (draw-inline-array-tfrag sv-16 s5-1 s4-1 s2-0)
+          (with-dma-buffer-add-bucket ((s2-0 (-> *display* frames (-> *display* on-screen) frame global-buf)) (the-as bucket-id
+                                                       (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id tfrag-trans-0) (bucket-id tfrag-trans-1)))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0)) (set! (-> *tfrag-work* wait-from-spr) (the-as uint 0)) (tfrag-init-buffer s2-0
+                                         (new 'static
+                                              'gs-test
+                                              :ate #x1
+                                              :atst (gs-atest greater-equal)
+                                              :aref #x7e
+                                              :afail #x1
+                                              :zte #x1
+                                              :ztst (gs-ztest greater-equal))
+                                         1
+                                         lev) (reset! (-> *perf-stats* data 5)) (update-wait-stats (-> *perf-stats* data 5)
+                                         (the-as uint 0)
+                                         (-> *tfrag-work* wait-to-spr)
+                                         (-> *tfrag-work* wait-from-spr)) (read! (-> *perf-stats* data 5)) (tfrag-end-buffer s2-0))
           #|
    TODO
        (let*
@@ -486,8 +450,8 @@
                    (child-array (-> tree arrays (+ depth-index 1)))
                    (parent-vis-byte-index (/ (-> (the-as drawable-inline-array-node parent-array) data 0 id) 8))
                    (child-vis-byte-index (/ (-> (the-as drawable-inline-array-node child-array) data 0 id) 8))
-                   (parent-visibility (&-> (the-as terrain-context #x70000000) work background vis-list parent-vis-byte-index))
-                   (child-visibility (&-> (the-as terrain-context #x70000000) work background vis-list child-vis-byte-index)))
+                   (parent-visibility (&-> (scratchpad-object terrain-context) work background vis-list parent-vis-byte-index))
+                   (child-visibility (&-> (scratchpad-object terrain-context) work background vis-list child-vis-byte-index)))
               (draw-node-cull child-visibility
                               parent-visibility
                               (-> (the-as drawable-inline-array-node parent-array) data)
@@ -495,9 +459,9 @@
         (let* ((fragment-array (-> tree arrays last-array-index))
                (fragments (&+ fragment-array 32))
                (fragment-count (-> fragment-array length)))
-          (set! visibility-bits (&-> (the-as terrain-context #x70000000) work background vis-list (/ (-> fragments id) 8)))
+          (set! visibility-bits (&-> (scratchpad-object terrain-context) work background vis-list (/ (-> fragments id) 8)))
           (with-dma-buffer-add-bucket ((far-dma-buf (-> (current-frame) global-buf))
-                                       (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index))
+                                       (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index))
                                          (bucket-id tfrag-dirt-0)
                                          (bucket-id tfrag-dirt-1)))
             (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0))
@@ -512,7 +476,7 @@
             (read! (-> *perf-stats* data 5))
             (tfrag-end-buffer far-dma-buf))
           (with-dma-buffer-add-bucket ((near-dma-buf (-> (current-frame) global-buf))
-                                       (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index))
+                                       (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index))
                                          (bucket-id tfrag-dirt-near-0)
                                          (bucket-id tfrag-dirt-near-1)))
             (set! (-> *tfrag-work* near-wait-to-spr) (the-as uint 0))
@@ -575,29 +539,11 @@
                (s5-1 (&+ v1-13 32))
                (s4-1 (-> v1-13 length)))
           (set! sv-16 (&-> (scratchpad-object terrain-context) work background vis-list (/ (-> s5-1 id) 8)))
-          (let* ((s2-0 (-> *display* frames (-> *display* on-screen) frame global-buf))
-                 (s3-0 (-> s2-0 base)))
-            (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0))
-            (set! (-> *tfrag-work* wait-from-spr) (the-as uint 0))
-            (tfrag-init-buffer s2-0 (new 'static 'gs-test :ate #x1 :afail #x1 :zte #x1 :ztst (gs-ztest greater-equal)) 1 lev)
-            (reset! (-> *perf-stats* data 5))
-            ;; (draw-inline-array-tfrag sv-16 s5-1 s4-1 s2-0)
-            (update-wait-stats (-> *perf-stats* data 5)
-                               (the-as uint 0)
-                               (-> *tfrag-work* wait-to-spr)
-                               (-> *tfrag-work* wait-from-spr))
-            (read! (-> *perf-stats* data 5))
-            (tfrag-end-buffer s2-0)
-            (let ((a3-3 (-> s2-0 base)))
-              (let ((v1-34 (the-as object (-> s2-0 base))))
-                (set! (-> (the-as dma-packet v1-34) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                (set! (-> (the-as dma-packet v1-34) vif0) (new 'static 'vif-tag))
-                (set! (-> (the-as dma-packet v1-34) vif1) (new 'static 'vif-tag))
-                (set! (-> s2-0 base) (&+ (the-as pointer v1-34) 16)))
-              (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                     (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id tfrag-dirt-0) (bucket-id tfrag-dirt-1))
-                                     s3-0
-                                     (the-as (pointer dma-tag) a3-3))))
+          ;; (draw-inline-array-tfrag sv-16 s5-1 s4-1 s2-0)
+          (with-dma-buffer-add-bucket ((s2-0 (-> *display* frames (-> *display* on-screen) frame global-buf)) (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) (bucket-id tfrag-dirt-0) (bucket-id tfrag-dirt-1))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0)) (set! (-> *tfrag-work* wait-from-spr) (the-as uint 0)) (tfrag-init-buffer s2-0 (new 'static 'gs-test :ate #x1 :afail #x1 :zte #x1 :ztst (gs-ztest greater-equal)) 1 lev) (reset! (-> *perf-stats* data 5)) (update-wait-stats (-> *perf-stats* data 5)
+                                         (the-as uint 0)
+                                         (-> *tfrag-work* wait-to-spr)
+                                         (-> *tfrag-work* wait-from-spr)) (read! (-> *perf-stats* data 5)) (tfrag-end-buffer s2-0))
           #|
        (let*
         ((s2-1 (-> *display* frames (-> *display* on-screen) frame global-buf))
@@ -696,8 +642,8 @@
                    (child-array (-> tree arrays (+ depth-index 1)))
                    (parent-vis-byte-index (/ (-> (the-as drawable-inline-array-node parent-array) data 0 id) 8))
                    (child-vis-byte-index (/ (-> (the-as drawable-inline-array-node child-array) data 0 id) 8))
-                   (parent-visibility (&-> (the-as terrain-context #x70000000) work background vis-list parent-vis-byte-index))
-                   (child-visibility (&-> (the-as terrain-context #x70000000) work background vis-list child-vis-byte-index)))
+                   (parent-visibility (&-> (scratchpad-object terrain-context) work background vis-list parent-vis-byte-index))
+                   (child-visibility (&-> (scratchpad-object terrain-context) work background vis-list child-vis-byte-index)))
               (draw-node-cull child-visibility
                               parent-visibility
                               (-> (the-as drawable-inline-array-node parent-array) data)
@@ -705,9 +651,9 @@
         (let* ((fragment-array (-> tree arrays last-array-index))
                (fragments (&+ fragment-array 32))
                (fragment-count (-> fragment-array length)))
-          (set! visibility-bits (&-> (the-as terrain-context #x70000000) work background vis-list (/ (-> fragments id) 8)))
+          (set! visibility-bits (&-> (scratchpad-object terrain-context) work background vis-list (/ (-> fragments id) 8)))
           (with-dma-buffer-add-bucket ((far-dma-buf (-> (current-frame) global-buf))
-                                       (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index))
+                                       (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index))
                                          (bucket-id tfrag-ice-0)
                                          (bucket-id tfrag-ice-1)))
             (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0))
@@ -724,7 +670,7 @@
             (read! (-> *perf-stats* data 5))
             (tfrag-end-buffer far-dma-buf))
           (with-dma-buffer-add-bucket ((near-dma-buf (-> (current-frame) global-buf))
-                                       (if (zero? (-> (the-as terrain-context #x70000000) bsp lev-index))
+                                       (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index))
                                          (bucket-id tfrag-ice-near-0)
                                          (bucket-id tfrag-ice-near-1)))
             (set! (-> *tfrag-work* near-wait-to-spr) (the-as uint 0))
@@ -773,32 +719,14 @@
                (s5-1 (&+ v1-13 32))
                (s4-1 (-> v1-13 length)))
           (set! sv-16 (&-> (scratchpad-object terrain-context) work background vis-list (/ (-> s5-1 id) 8)))
-          (let* ((s2-0 (-> *display* frames (-> *display* on-screen) frame global-buf))
-                 (s3-0 (-> s2-0 base)))
-            (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0))
-            (set! (-> *tfrag-work* wait-from-spr) (the-as uint 0))
-            (tfrag-init-buffer s2-0
-                               (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :afail #x1 :zte #x1 :ztst (gs-ztest greater-equal))
-                               1
-                               lev)
-            (reset! (-> *perf-stats* data 5))
-            ;; (draw-inline-array-tfrag sv-16 s5-1 s4-1 s2-0)
-            (update-wait-stats (-> *perf-stats* data 5)
-                               (the-as uint 0)
-                               (-> *tfrag-work* wait-to-spr)
-                               (-> *tfrag-work* wait-from-spr))
-            (read! (-> *perf-stats* data 5))
-            (tfrag-end-buffer s2-0)
-            (let ((a3-3 (-> s2-0 base)))
-              (let ((v1-34 (the-as object (-> s2-0 base))))
-                (set! (-> (the-as dma-packet v1-34) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                (set! (-> (the-as dma-packet v1-34) vif0) (new 'static 'vif-tag))
-                (set! (-> (the-as dma-packet v1-34) vif1) (new 'static 'vif-tag))
-                (set! (-> s2-0 base) (&+ (the-as pointer v1-34) 16)))
-              (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                     (the-as bucket-id (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) 36 43))
-                                     s3-0
-                                     (the-as (pointer dma-tag) a3-3))))
+          ;; (draw-inline-array-tfrag sv-16 s5-1 s4-1 s2-0)
+          (with-dma-buffer-add-bucket ((s2-0 (-> *display* frames (-> *display* on-screen) frame global-buf)) (the-as bucket-id (if (zero? (-> (scratchpad-object terrain-context) bsp lev-index)) 36 43))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set! (-> *tfrag-work* wait-to-spr) (the-as uint 0)) (set! (-> *tfrag-work* wait-from-spr) (the-as uint 0)) (tfrag-init-buffer s2-0
+                                         (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :afail #x1 :zte #x1 :ztst (gs-ztest greater-equal))
+                                         1
+                                         lev) (reset! (-> *perf-stats* data 5)) (update-wait-stats (-> *perf-stats* data 5)
+                                         (the-as uint 0)
+                                         (-> *tfrag-work* wait-to-spr)
+                                         (-> *tfrag-work* wait-from-spr)) (read! (-> *perf-stats* data 5)) (tfrag-end-buffer s2-0))
           #|
        (let*
         ((s2-1 (-> *display* frames (-> *display* on-screen) frame global-buf))

goal_src/jak1/engine/gfx/tfrag/tfrag.gc

@@ -113,12 +113,12 @@
     (adgif-shader-login-no-remap (-> this shader i)))
   this)
 
-(defmethod mem-usage ((this tfragment) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this tfragment) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the fragment header, overlapping base/common/LOD DMA streams, colors, and debug
    data. With the color-only flag, record only the packed per-LOD colors; the separate-prototype-data
    flag excludes those colors from the ordinary total."
   ;; The color-only pass keeps its packed-color total in category 19.
-  (when (logtest? flags 2)
+  (when (logtest? flags (mem-usage-flags instance-colors))
     (+! (-> usage data 19 count) 1)
     (let ((color-bytes (+ (-> this num-base-colors) (-> this num-level0-colors) (-> this num-level1-colors))))
       (+! (-> usage data 19 used) color-bytes)
@@ -166,7 +166,7 @@
     ;; Packed time-of-day colors.
     (set! (-> usage data (+ category 5) name) "tfragment-color")
     (+! (-> usage data (+ category 5) count) 1)
-    (let ((packed-color-bytes (if (logtest? flags 1)
+    (let ((packed-color-bytes (if (logtest? flags (mem-usage-flags prototype-data))
                                 0
                                 (the-as int (* (+ (-> this num-base-colors) (-> this num-level0-colors) (-> this num-level1-colors)) 2)))))
       (+! (-> usage data (+ category 5) used) packed-color-bytes)
@@ -193,33 +193,18 @@
     (login (-> this data i)))
   this)
 
-(defmethod mem-usage ((this drawable-inline-array-tfrag) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-inline-array-tfrag) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the inline-array header and delegate to every terrain fragment."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((header-bytes 32))
-    (+! (-> usage data 0 used) header-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ header-bytes 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 32)
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   this)
 
-(defmethod mem-usage ((this drawable-tree-tfrag) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-tree-tfrag) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the tree header, optional time-of-day palette, and every inline fragment array."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) "drawable-group")
-  (+! (-> usage data 0 count) 1)
-  (let ((header-bytes (asize-of this)))
-    (+! (-> usage data 0 used) header-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ header-bytes 15))))
+  (mem-usage-add! usage drawable-group 1 (asize-of this))
   (when (nonzero? (-> this time-of-day-pal))
-    (set! (-> usage length) (max 9 (-> usage length)))
-    (set! (-> usage data 8 name) "tfragment-pal")
-    (+! (-> usage data 8 count) 1)
-    (let ((palette-bytes (asize-of (-> this time-of-day-pal))))
-      (+! (-> usage data 8 used) palette-bytes)
-      (+! (-> usage data 8 total) (logand -16 (+ palette-bytes 15)))))
+    (mem-usage-add! usage tfragment-pal 1 (asize-of (-> this time-of-day-pal))))
   (dotimes (i (-> this length))
     (mem-usage (-> this arrays i) usage flags))
   this)
@@ -3035,10 +3020,10 @@
           (new 'static 'gif-tag-regs :regs0 (gif-reg-id st) :regs1 (gif-reg-id rgbaq) :regs2 (gif-reg-id xyzf2)))
     (set! (-> data adgif tag) (new 'static 'gif-tag64 :nloop #x5 :nreg #x1))
     (set! (-> data adgif regs) (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)))
-    (set! (-> data hvdf-offset quad) (-> camera hvdf-off quad))
-    (set! (-> data hmge-scale quad) (-> camera hmge-scale quad))
-    (set! (-> data invh-scale quad) (-> camera inv-hmge-scale quad))
-    (set! (-> data guard quad) (-> camera guard quad)))
+    (vector-copy! (-> data hvdf-offset) (-> camera hvdf-off))
+    (vector-copy! (-> data hmge-scale) (-> camera hmge-scale))
+    (vector-copy! (-> data invh-scale) (-> camera inv-hmge-scale))
+    (vector-copy! (-> data guard) (-> camera guard)))
   (set-tfrag-dists! (-> data dists))
   (none))
 

goal_src/jak1/engine/gfx/tie/tie-methods.gc

@@ -2369,7 +2369,7 @@
               (set! (-> prototype generic-next-clear) (the-as uint128 0)))
             0)
           (let* ((instances (-> (the-as drawable-inline-array-instance-tie instance-array) data))
-                 (visibility (&-> (the-as terrain-context #x70000000) work background vis-list (/ (-> instances 0 id) 8)))
+                 (visibility (&-> (scratchpad-object terrain-context) work background vis-list (/ (-> instances 0 id) 8)))
                  (dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)))
             (set! instance-count (-> (the-as drawable-inline-array-node instance-array) length))
             (when (nonzero? instance-count)
@@ -2424,27 +2424,10 @@
               (when (logtest? *vu1-enable-user* (vu1-renderer-mask tie))
                 (let ((tie-dma-start (-> *display* frames (-> *display* on-screen) frame global-buf base)))
                   (when (logtest? *vu1-enable-user* (vu1-renderer-mask tie))
-                    (let* ((tie-dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                           (tie-packet-start (-> tie-dma-buf base)))
-                      (set! (-> *prototype-tie-work* wait-to-spr) (the-as uint 0))
-                      (set! (-> *prototype-tie-work* wait-from-spr) (the-as uint 0))
-                      (reset! (-> *perf-stats* data 11))
-                      (draw-inline-array-prototype-tie-asm tie-dma-buf prototype-count prototypes)
-                      (read! (-> *perf-stats* data 11))
-                      (update-wait-stats (-> *perf-stats* data 11)
-                                         (the-as uint 0)
-                                         (-> *prototype-tie-work* wait-to-spr)
-                                         (-> *prototype-tie-work* wait-from-spr))
-                      (let ((tie-packet-end (-> tie-dma-buf base)))
-                        (let ((tie-next-packet (the-as object (-> tie-dma-buf base))))
-                          (set! (-> (the-as dma-packet tie-next-packet) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                          (set! (-> (the-as dma-packet tie-next-packet) vif0) (new 'static 'vif-tag))
-                          (set! (-> (the-as dma-packet tie-next-packet) vif1) (new 'static 'vif-tag))
-                          (set! (-> tie-dma-buf base) (&+ (the-as pointer tie-next-packet) 16)))
-                        (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                               (if (zero? (-> lev index)) (bucket-id tie-0) (bucket-id tie-1))
-                                               tie-packet-start
-                                               (the-as (pointer dma-tag) tie-packet-end)))))
+                    (with-dma-buffer-add-bucket ((tie-dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (if (zero? (-> lev index)) (bucket-id tie-0) (bucket-id tie-1))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set! (-> *prototype-tie-work* wait-to-spr) (the-as uint 0)) (set! (-> *prototype-tie-work* wait-from-spr) (the-as uint 0)) (reset! (-> *perf-stats* data 11)) (draw-inline-array-prototype-tie-asm tie-dma-buf prototype-count prototypes) (read! (-> *perf-stats* data 11)) (update-wait-stats (-> *perf-stats* data 11)
+                                                             (the-as uint 0)
+                                                             (-> *prototype-tie-work* wait-to-spr)
+                                                             (-> *prototype-tie-work* wait-from-spr))))
                   (let ((usage *dma-mem-usage*))
                     (when (nonzero? usage)
                       (set! (-> usage length) (max 10 (-> usage length)))
@@ -2455,27 +2438,10 @@
                       (set! (-> usage data 9 total) (-> usage data 9 used))))))
               (when (logtest? *vu1-enable-user* (vu1-renderer-mask tie-near))
                 (let ((near-dma-start (-> *display* frames (-> *display* on-screen) frame global-buf base)))
-                  (let* ((near-dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                         (near-packet-start (-> near-dma-buf base)))
-                    (set! (-> *prototype-tie-work* near-wait-to-spr) (the-as uint 0))
-                    (set! (-> *prototype-tie-work* near-wait-from-spr) (the-as uint 0))
-                    (reset! (-> *perf-stats* data 12))
-                    (draw-inline-array-prototype-tie-near-asm near-dma-buf prototype-count prototypes)
-                    (read! (-> *perf-stats* data 12))
-                    (update-wait-stats (-> *perf-stats* data 12)
-                                       (the-as uint 0)
-                                       (-> *prototype-tie-work* near-wait-to-spr)
-                                       (-> *prototype-tie-work* near-wait-from-spr))
-                    (let ((near-packet-end (-> near-dma-buf base)))
-                      (let ((near-next-packet (the-as object (-> near-dma-buf base))))
-                        (set! (-> (the-as dma-packet near-next-packet) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                        (set! (-> (the-as dma-packet near-next-packet) vif0) (new 'static 'vif-tag))
-                        (set! (-> (the-as dma-packet near-next-packet) vif1) (new 'static 'vif-tag))
-                        (set! (-> near-dma-buf base) (&+ (the-as pointer near-next-packet) 16)))
-                      (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                             (if (zero? (-> lev index)) (bucket-id tie-near-0) (bucket-id tie-near-1))
-                                             near-packet-start
-                                             (the-as (pointer dma-tag) near-packet-end))))
+                  (with-dma-buffer-add-bucket ((near-dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (if (zero? (-> lev index)) (bucket-id tie-near-0) (bucket-id tie-near-1))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set! (-> *prototype-tie-work* near-wait-to-spr) (the-as uint 0)) (set! (-> *prototype-tie-work* near-wait-from-spr) (the-as uint 0)) (reset! (-> *perf-stats* data 12)) (draw-inline-array-prototype-tie-near-asm near-dma-buf prototype-count prototypes) (read! (-> *perf-stats* data 12)) (update-wait-stats (-> *perf-stats* data 12)
+                                                         (the-as uint 0)
+                                                         (-> *prototype-tie-work* near-wait-to-spr)
+                                                         (-> *prototype-tie-work* near-wait-from-spr)))
                   (let ((usage *dma-mem-usage*))
                     (when (nonzero? usage)
                       (set! (-> usage length) (max 16 (-> usage length)))
@@ -2614,31 +2580,12 @@
               (when (logtest? *vu1-enable-user* (vu1-renderer-mask tie))
                 (let ((tie-dma-start (-> *display* frames (-> *display* on-screen) frame global-buf base)))
                   (when (logtest? *vu1-enable-user* (vu1-renderer-mask tie))
-                    (let* ((tie-dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
-                           (tie-packet-start (-> tie-dma-buf base)))
-                      (set! (-> *prototype-tie-work* wait-to-spr) (the-as uint 0))
-                      (set! (-> *prototype-tie-work* wait-from-spr) (the-as uint 0))
-                      (reset! (-> *perf-stats* data 11))
-                      ;;(draw-inline-array-prototype-tie-asm tie-dma-buf prototype-count prototypes)
-                      (add-pc-tfrag3-data tie-dma-buf (-> *level* data (-> (scratchpad-object terrain-context) bsp lev-index)))
-                      (add-pc-wind-data tie-dma-buf)
-                      (pc-add-tie-envmap-info tie-dma-buf)
-                      (read! (-> *perf-stats* data 11))
-                      (update-wait-stats (-> *perf-stats* data 11)
-                                         (the-as uint 0)
-                                         (-> *prototype-tie-work* wait-to-spr)
-                                         (-> *prototype-tie-work* wait-from-spr))
-                      ;; this actually generates real drawing DMA, so add it to the appropriate bucket.
-                      (let ((tie-packet-end (-> tie-dma-buf base)))
-                        (let ((tie-next-packet (the-as object (-> tie-dma-buf base))))
-                          (set! (-> (the-as dma-packet tie-next-packet) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
-                          (set! (-> (the-as dma-packet tie-next-packet) vif0) (new 'static 'vif-tag))
-                          (set! (-> (the-as dma-packet tie-next-packet) vif1) (new 'static 'vif-tag))
-                          (set! (-> tie-dma-buf base) (&+ (the-as pointer tie-next-packet) 16)))
-                        (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
-                                               (if (zero? (-> lev index)) (bucket-id tie-0) (bucket-id tie-1))
-                                               tie-packet-start
-                                               (the-as (pointer dma-tag) tie-packet-end)))))
+                    ;;(draw-inline-array-prototype-tie-asm tie-dma-buf prototype-count prototypes)
+                    ;; this actually generates real drawing DMA, so add it to the appropriate bucket.
+                    (with-dma-buffer-add-bucket ((tie-dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) (if (zero? (-> lev index)) (bucket-id tie-0) (bucket-id tie-1))) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (set! (-> *prototype-tie-work* wait-to-spr) (the-as uint 0)) (set! (-> *prototype-tie-work* wait-from-spr) (the-as uint 0)) (reset! (-> *perf-stats* data 11)) (add-pc-tfrag3-data tie-dma-buf (-> *level* data (-> (scratchpad-object terrain-context) bsp lev-index))) (add-pc-wind-data tie-dma-buf) (pc-add-tie-envmap-info tie-dma-buf) (read! (-> *perf-stats* data 11)) (update-wait-stats (-> *perf-stats* data 11)
+                                                             (the-as uint 0)
+                                                             (-> *prototype-tie-work* wait-to-spr)
+                                                             (-> *prototype-tie-work* wait-from-spr))))
                   (let ((usage *dma-mem-usage*))
                     (when (nonzero? usage)
                       (set! (-> usage length) (max 10 (-> usage length)))

goal_src/jak1/engine/gfx/tie/tie-near.gc

@@ -2148,9 +2148,9 @@
   (set! (-> consts clrbufs vector4w z) 198)
   (set! (-> consts clrbufs vector4w w) 242)
   (let ((camera *math-camera*))
-    (set! (-> consts invhscale quad) (-> camera inv-hmge-scale quad))
-    (set! (-> consts hvdfoffs quad) (-> camera hvdf-off quad))
-    (set! (-> consts guard quad) (-> camera guard quad)))
+    (vector-copy! (-> consts invhscale) (-> camera inv-hmge-scale))
+    (vector-copy! (-> consts hvdfoffs) (-> camera hvdf-off))
+    (vector-copy! (-> consts guard) (-> camera guard)))
   (none))
 
 (defun tie-near-init-engine ((dma-buf dma-buffer) (test-state gs-test) (alpha-blend int))

goal_src/jak1/engine/gfx/tie/tie.gc

@@ -164,31 +164,26 @@
     (login (-> this data i)))
   this)
 
-(defmethod mem-usage ((this drawable-tree-instance-tie) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-tree-instance-tie) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the tree header, its child drawables, and its prototype array. The prototype
    pass is marked so fragments are not charged as independent allocations a second time."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((header-bytes 32))
-    (+! (-> usage data 0 used) header-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ header-bytes 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 32)
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   ;; Bit 0 marks the prototype walk. Bits 1 through 4 are passed through to select instance-color
   ;; accounting and its geometry category.
-  (mem-usage (-> this prototypes prototype-array-tie) usage (logior flags 1))
+  (mem-usage (-> this prototypes prototype-array-tie) usage (logior flags (mem-usage-flags prototype-data)))
   this)
 
-(defmethod mem-usage ((this tie-fragment) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this tie-fragment) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this prototype's header and referenced shader, point, draw-point, generic, and
    debug data. With the instance-color flag, account only for one instance's packed color table in
    the geometry-selected color category."
-  (when (logtest? flags 2)
+  (when (logtest? flags (mem-usage-flags instance-colors))
     (let ((color-bytes (* (-> this color-count) 4))
           (color-category (cond
-                            ((logtest? flags 4) 20)
-                            ((logtest? flags 8) 21)
+                            ((logtest? flags (mem-usage-flags tie-geometry-1)) 20)
+                            ((logtest? flags (mem-usage-flags tie-geometry-2)) 21)
                             (else 22))))
       (+! (-> usage data color-category count) 1)
       (+! (-> usage data color-category used) color-bytes)
@@ -235,15 +230,10 @@
   (label cfg-13)
   this)
 
-(defmethod mem-usage ((this instance-tie) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this instance-tie) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for this instance and, when it owns color overrides, ask each available geometry
    prototype to account for the corresponding packed instance-color table."
-  (set! (-> usage length) (max 19 (-> usage length)))
-  (set! (-> usage data 18 name) "instance-tie")
-  (+! (-> usage data 18 count) 1)
-  (let ((instance-bytes (asize-of this)))
-    (+! (-> usage data 18 used) instance-bytes)
-    (+! (-> usage data 18 total) (logand -16 (+ instance-bytes 15))))
+  (mem-usage-add! usage instance-tie 1 (asize-of this))
   (when (nonzero? (-> this error))
     (set! (-> usage length) (max 24 (-> usage length)))
     (set! (-> usage data 23 name) "instance-tie-colors*")
@@ -263,35 +253,27 @@
                   (geometry-index i))
               (t9-1 geometry
                     a1-2
-                    (logior (logior (cond
-                                      ((= geometry-index 1) 4)
-                                      ((= geometry-index 2) 8)
-                                      ((= geometry-index 3) 16)
-                                      (else 0))
-                                    2)
-                            flags))))))))
+                    (the-as mem-usage-flags
+                            (logior (the-as mem-usage-flags
+                                            (logior (cond
+                                                      ((= geometry-index 1) 4)
+                                                      ((= geometry-index 2) 8)
+                                                      ((= geometry-index 3) 16)
+                                                      (else 0))
+                                                    2))
+                                    flags)))))))))
   this)
 
-(defmethod mem-usage ((this drawable-inline-array-instance-tie) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this drawable-inline-array-instance-tie) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the inline-array header and every active TIE instance."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((header-bytes 32))
-    (+! (-> usage data 0 used) header-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ header-bytes 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 32)
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   this)
 
-(defmethod mem-usage ((this prototype-tie) (usage memory-usage-block) (flags int))
+(defmethod mem-usage ((this prototype-tie) (usage memory-usage-block) (flags mem-usage-flags))
   "Account for the prototype-array header and every inline TIE fragment."
-  (set! (-> usage length) (max 1 (-> usage length)))
-  (set! (-> usage data 0 name) (symbol->string 'drawable-group))
-  (+! (-> usage data 0 count) 1)
-  (let ((header-bytes 32))
-    (+! (-> usage data 0 used) header-bytes)
-    (+! (-> usage data 0 total) (logand -16 (+ header-bytes 15))))
+  (mem-usage-add-symbol! usage drawable-group 1 32)
   (dotimes (i (-> this length))
     (mem-usage (-> this data i) usage flags))
   this)

goal_src/jak1/engine/level/bsp.gc

@@ -13,7 +13,7 @@
 ;; memory use
 ;;;;;;;;;;;;;;;
 
-(defun-recursive mem-usage-bsp-tree none ((header bsp-header) (node bsp-node) (mem-use memory-usage-block) (flags int))
+(defun-recursive mem-usage-bsp-tree none ((header bsp-header) (node bsp-node) (mem-use memory-usage-block) (flags mem-usage-flags))
   "Recursively count the 32-byte internal nodes reachable from node in the BSP-node memory
    category. Nonpositive terminal children are not followed; header and flags are unused."
   (cond
@@ -27,19 +27,14 @@
      (if (> (-> node back) 0) (mem-usage-bsp-tree header (the-as bsp-node (-> node back)) mem-use flags))))
   (none))
 
-(defmethod mem-usage ((this bsp-header) (mem-use memory-usage-block) (flags int))
+(defmethod mem-usage ((this bsp-header) (mem-use memory-usage-block) (flags mem-usage-flags))
   "Account for this header's owned level data and delegate memory accounting to its drawable
    trees and cameras."
   ;; start off by setting the current bsp
   (set! (-> mem-use work-bsp) this)
   ;; this seems slightly wrong, we count the file-info toward array.
   (when (nonzero? (-> this info))
-    (set! (-> mem-use length) (max 82 (-> mem-use length)))
-    (set! (-> mem-use data 81 name) "array")
-    (+! (-> mem-use data 81 count) 1)
-    (let ((file-info-bytes (asize-of (-> this info))))
-      (+! (-> mem-use data 81 used) file-info-bytes)
-      (+! (-> mem-use data 81 total) (logand -16 (+ file-info-bytes 15)))))
+    (mem-usage-add! mem-use array 1 (asize-of (-> this info))))
   ;; measure the drawable trees.
   (if (nonzero? (-> this drawable-trees)) (mem-usage (-> this drawable-trees) mem-use flags))
   ;; add stuff
@@ -48,75 +43,30 @@
   (set! (-> mem-use data 44 name) "camera")
   (set! (-> mem-use data 62 name) "pat")
   (set! (-> mem-use data 58 name) "bsp-node")
-  (set! (-> mem-use length) (max 57 (-> mem-use length)))
   ;; add the bsp-header itself
-  (set! (-> mem-use data 56 name) "bsp-main")
-  (+! (-> mem-use data 56 count) 1)
-  (let ((header-bytes 400))
-    (+! (-> mem-use data 56 used) header-bytes)
-    (+! (-> mem-use data 56 total) (logand -16 (+ header-bytes 15))))
+  (mem-usage-add! mem-use bsp-main 1 400)
   ;; add the visible list
-  (set! (-> mem-use length) (max 60 (-> mem-use length)))
-  (set! (-> mem-use data 59 name) "bsp-leaf-vis-self")
-  (+! (-> mem-use data 59 count) 1)
-  (let ((visibility-bytes (-> this visible-list-length)))
-    (+! (-> mem-use data 59 used) visibility-bytes)
-    (+! (-> mem-use data 59 total) (logand -16 (+ visibility-bytes 15))))
+  (mem-usage-add! mem-use bsp-leaf-vis-self 1 (-> this visible-list-length))
   ;; add the unk-data-0
-  (set! (-> mem-use length) (max 58 (-> mem-use length)))
-  (set! (-> mem-use data 57 name) "bsp-misc")
-  (+! (-> mem-use data 57 count) 1)
-  (let ((texture-remap-bytes (* (-> this texture-remap-table-len) 8)))
-    (+! (-> mem-use data 57 used) texture-remap-bytes)
-    (+! (-> mem-use data 57 total) (logand -16 (+ texture-remap-bytes 15))))
+  (mem-usage-add! mem-use bsp-misc 1 (* (-> this texture-remap-table-len) 8))
   ;; add the unk-data-1
-  (set! (-> mem-use length) (max 58 (-> mem-use length)))
-  (set! (-> mem-use data 57 name) "bsp-misc")
-  (+! (-> mem-use data 57 count) 1)
-  (let ((texture-id-bytes (* (-> this texture-page-count) 4)))
-    (+! (-> mem-use data 57 used) texture-id-bytes)
-    (+! (-> mem-use data 57 total) (logand -16 (+ texture-id-bytes 15))))
+  (mem-usage-add! mem-use bsp-misc 1 (* (-> this texture-page-count) 4))
   ;; add unk-zero-0
   (when (nonzero? (-> this unk-zero-0))
-    (set! (-> mem-use length) (max 58 (-> mem-use length)))
-    (set! (-> mem-use data 57 name) "bsp-misc")
-    (+! (-> mem-use data 57 count) 1)
-    (let ((unknown-array-bytes (asize-of (-> this unk-zero-0))))
-      (+! (-> mem-use data 57 used) unknown-array-bytes)
-      (+! (-> mem-use data 57 total) (logand -16 (+ unknown-array-bytes 15)))))
+    (mem-usage-add! mem-use bsp-misc 1 (asize-of (-> this unk-zero-0))))
   ;; add adgifs
   (when (nonzero? (-> this adgifs))
-    (set! (-> mem-use length) (max 58 (-> mem-use length)))
-    (set! (-> mem-use data 57 name) "bsp-misc")
-    (+! (-> mem-use data 57 count) 1)
-    (let ((adgif-bytes (asize-of (-> this adgifs))))
-      (+! (-> mem-use data 57 used) adgif-bytes)
-      (+! (-> mem-use data 57 total) (logand -16 (+ adgif-bytes 15)))))
+    (mem-usage-add! mem-use bsp-misc 1 (asize-of (-> this adgifs))))
   ;; add boxes
   (when (nonzero? (-> this boxes))
-    (set! (-> mem-use length) (max 58 (-> mem-use length)))
-    (set! (-> mem-use data 57 name) "bsp-misc")
-    (+! (-> mem-use data 57 count) 1)
-    (let ((box-bytes (asize-of (-> this boxes))))
-      (+! (-> mem-use data 57 used) box-bytes)
-      (+! (-> mem-use data 57 total) (logand -16 (+ box-bytes 15))))
+    (mem-usage-add! mem-use bsp-misc 1 (asize-of (-> this boxes)))
     ;; add box indices
     (when (nonzero? (-> this split-box-indices))
-      (set! (-> mem-use length) (max 58 (-> mem-use length)))
-      (set! (-> mem-use data 57 name) "bsp-misc")
-      (+! (-> mem-use data 57 count) 1)
-      (let ((split-box-index-bytes (* (-> this boxes length) 2)))
-        (+! (-> mem-use data 57 used) split-box-index-bytes)
-        (+! (-> mem-use data 57 total) (logand -16 (+ split-box-index-bytes 15))))))
+      (mem-usage-add! mem-use bsp-misc 1 (* (-> this boxes length) 2))))
   ;; add actor-birth-order
   (when (nonzero? (-> this actor-birth-order))
-    (set! (-> mem-use length) (max 58 (-> mem-use length)))
-    (set! (-> mem-use data 57 name) "bsp-misc")
-    (+! (-> mem-use data 57 count) 1)
     ;; add actors
-    (let ((actor-index-bytes (* (-> this actors length) 4)))
-      (+! (-> mem-use data 57 used) actor-index-bytes)
-      (+! (-> mem-use data 57 total) (logand -16 (+ actor-index-bytes 15)))))
+    (mem-usage-add! mem-use bsp-misc 1 (* (-> this actors length) 4)))
   ;; add pat
   (+! (-> mem-use data 62 count) (-> this pat-length))
   (let ((pat-bytes (* (-> this pat-length) 4)))
@@ -126,7 +76,7 @@
   (let ((cameras (-> this cameras)))
     (when (nonzero? cameras)
       (dotimes (i (-> cameras length))
-        (mem-usage (-> cameras i) mem-use (logior flags 256)))))
+        (mem-usage (-> cameras i) mem-use (logior flags (mem-usage-flags resource-camera))))))
   ;; add the tree itself
   (mem-usage-bsp-tree this (the-as bsp-node (-> this nodes)) mem-use flags)
   this)
@@ -220,7 +170,7 @@
                  (new 'static 'rgba :r #x80 :g #xc0 :a #x80))))
   ;; run the foreground system (0 check added)
   (when (nonzero? foreground-engine-execute)
-    (let ((frame (-> *display* frames (-> *display* on-screen) frame)))
+    (let ((frame (current-frame)))
       ;; 0
       (foreground-engine-execute (-> this level foreground-draw-engine 0)
                                  frame