From 789c57916e3f51aa4329d88b09891ea10049efed Mon Sep 17 00:00:00 2001 From: water111 <48171810+water111@users.noreply.github.com> Date: Sun, 17 Apr 2022 21:12:24 -0400 Subject: [PATCH] Add timeline style profiler (#1312) * small speedups to extractor * faster extraction * add profiler * spellin * guess at windows includes * windows nominmax garbage --- common/CMakeLists.txt | 2 +- common/global_profiler/GlobalProfiler.cpp | 181 +++++++++ common/global_profiler/GlobalProfiler.h | 46 +++ common/global_profiler/readme.md | 32 ++ game/graphics/opengl_renderer/Profiler.h | 5 +- game/graphics/opengl_renderer/debug_gui.cpp | 6 + game/graphics/opengl_renderer/debug_gui.h | 2 + game/graphics/pipelines/opengl.cpp | 57 ++- game/kernel/kmachine.cpp | 8 + game/main.cpp | 19 +- game/runtime.cpp | 1 - goal_src/engine/draw/drawable.gc | 360 +++++++++-------- goal_src/engine/game/main.gc | 173 +++++---- goal_src/engine/ps2/timer-h.gc | 1 - goal_src/kernel-defs.gc | 8 + goal_src/kernel/gcommon.gc | 59 ++- goal_src/kernel/gkernel.gc | 406 +++++++++++--------- goal_src/pc/pckernel.gc | 2 +- 18 files changed, 896 insertions(+), 472 deletions(-) create mode 100644 common/global_profiler/GlobalProfiler.cpp create mode 100644 common/global_profiler/GlobalProfiler.h create mode 100644 common/global_profiler/readme.md diff --git a/common/CMakeLists.txt b/common/CMakeLists.txt index 8a586fd037..c11ce8d6f2 100644 --- a/common/CMakeLists.txt +++ b/common/CMakeLists.txt @@ -6,7 +6,7 @@ add_library(common dma/dma.cpp dma/dma_copy.cpp dma/gs.cpp - + global_profiler/GlobalProfiler.cpp goos/Interpreter.cpp goos/Object.cpp goos/ParseHelpers.cpp diff --git a/common/global_profiler/GlobalProfiler.cpp b/common/global_profiler/GlobalProfiler.cpp new file mode 100644 index 0000000000..c2c509d43d --- /dev/null +++ b/common/global_profiler/GlobalProfiler.cpp @@ -0,0 +1,181 @@ +#include "GlobalProfiler.h" + +#include +#include +#include +#include "third-party/fmt/core.h" +#include "third-party/json.hpp" +#include "common/util/Assert.h" +#include "common/util/FileUtil.h" + +#ifdef __linux__ +u32 get_current_tid() { + return (u32)pthread_self(); +} +#else +#define NOMINMAX +#include +#include "Processthreadsapi.h" +u32 get_current_tid() { + return (u32)GetCurrentThreadId(); +} +#endif + +u64 get_current_ts() { + return std::chrono::steady_clock::now().time_since_epoch().count(); +} + +GlobalProfiler::GlobalProfiler() { + m_t0 = get_current_ts(); + set_max_events(65536); +} + +void GlobalProfiler::set_max_events(size_t event_count) { + ASSERT(!m_enabled); + m_nodes.resize(event_count); +} + +void GlobalProfiler::event(const char* name, ProfNode::Kind kind) { + if (!m_enabled) { + return; + } + size_t my_idx = (m_next_idx++ % m_nodes.size()); + auto& node = m_nodes[my_idx]; + node.ts = get_current_ts() - m_t0; + node.tid = get_current_tid(); + node.kind = kind; + strncpy(node.name, name, sizeof(node.name)); + node.name[sizeof(node.name) - 1] = '\0'; +} + +void GlobalProfiler::instant_event(const char* name) { + event(name, ProfNode::INSTANT); +} + +void GlobalProfiler::begin_event(const char* name) { + event(name, ProfNode::BEGIN); +} + +void GlobalProfiler::end_event() { + if (!m_enabled) { + return; + } + size_t my_idx = (m_next_idx++ % m_nodes.size()); + auto& node = m_nodes[my_idx]; + node.ts = get_current_ts() - m_t0; + node.tid = get_current_tid(); + node.kind = ProfNode::END; + node.name[0] = '\0'; +} + +void GlobalProfiler::clear() { + m_next_idx = 0; +} + +void GlobalProfiler::set_enable(bool en) { + m_enabled = en; +} + +void GlobalProfiler::dump_to_json(const std::string& path) { + ASSERT(!m_enabled); + + nlohmann::json json; + auto& trace_events = json["traceEvents"]; + json["displayTimeUnit"] = "ms"; + + u64 lowest_ts = UINT64_MAX; + struct ThreadInfo { + size_t lowest_at_target = UINT64_MAX; + size_t highest_at_target = 0; + size_t debug = 0; + u32 short_id = 0; + }; + std::unordered_map info_per_thread; + + // first, find all the threads + std::string kRootName = "ROOT"; + for (size_t offset = m_nodes.size(); offset-- > 0;) { + size_t idx = (m_next_idx + offset) % m_nodes.size(); + const auto& event = m_nodes[idx]; + + if (event.kind != ProfNode::UNUSED) { + lowest_ts = std::min(event.ts, lowest_ts); + } + if (event.kind == ProfNode::INSTANT && kRootName == event.name) { + auto& info = info_per_thread[event.tid]; + info.lowest_at_target = std::min(info.lowest_at_target, offset); + info.highest_at_target = std::max(info.highest_at_target, offset); + } + } + + u32 i = 0; + for (auto& info : info_per_thread) { + info.second.short_id = i++; + } + + for (size_t event_idx = 0; event_idx < m_nodes.size(); event_idx++) { + auto& event = m_nodes[(event_idx + m_next_idx) % m_nodes.size()]; + if (event.kind == ProfNode::UNUSED) { + continue; + } + auto& info = info_per_thread.at(event.tid); + if (event_idx < info.lowest_at_target || event_idx > info.highest_at_target) { + continue; + } + + auto& json_event = trace_events.emplace_back(); + // name + if (event.kind != ProfNode::END) { + json_event["name"] = event.name; + } + + // cat + // json_event["cat"] = "a"; // ?? + // ph BEi + switch (event.kind) { + case ProfNode::END: + json_event["ph"] = "E"; + break; + case ProfNode::BEGIN: + json_event["ph"] = "B"; + break; + case ProfNode::INSTANT: + json_event["ph"] = "i"; + break; + default: + ASSERT(false); + } + // pid + json_event["pid"] = 1; + // tid + json_event["tid"] = info.short_id; + // ts + json_event["ts"] = (event.ts - lowest_ts) / 1000.f; + if (event.ts < info.debug) { + fmt::print("out of order: {} {} {} ms\n", event.ts / 1000.f, info.debug / 1000.f, + (info.debug - event.ts) / 1000000.f); + fmt::print(" idx: {}, range {} {}\n", event_idx, info.lowest_at_target, + info.highest_at_target); + fmt::print(" now: {}\n", m_next_idx); + } + info.debug = event.ts; + } + + for (auto& t : info_per_thread) { + fmt::print("thread: {}: {} -> {}\n", t.first, t.second.lowest_at_target, + t.second.highest_at_target); + } + + file_util::write_text_file(path, json.dump()); +} + +GlobalProfiler gprof; +GlobalProfiler& prof() { + return gprof; +} + +ScopedEvent scoped_prof(const char* name) { + auto& p = prof(); + p.begin_event(name); + return {&p}; +} diff --git a/common/global_profiler/GlobalProfiler.h b/common/global_profiler/GlobalProfiler.h new file mode 100644 index 0000000000..b96d9611e2 --- /dev/null +++ b/common/global_profiler/GlobalProfiler.h @@ -0,0 +1,46 @@ +#pragma once + +#include "common/common_types.h" +#include +#include +#include + +struct ProfNode { + u64 ts; + char name[32]; + enum Kind : u8 { BEGIN, END, INSTANT, UNUSED } kind = UNUSED; + u32 tid; +}; + +class GlobalProfiler { + public: + GlobalProfiler(); + void set_max_events(size_t event_count); + void instant_event(const char* name); + void begin_event(const char* name); + void event(const char* name, ProfNode::Kind kind); + void end_event(); + void clear(); + void set_enable(bool en); + void dump_to_json(const std::string& path); + + private: + std::atomic_bool m_enabled = false; + u64 m_t0 = 0; + std::atomic_size_t m_next_idx = 0; + std::vector m_nodes; +}; + +struct ScopedEvent { + ScopedEvent(const ScopedEvent&) = delete; + ScopedEvent& operator=(const ScopedEvent&) = delete; + GlobalProfiler* prof = nullptr; + ~ScopedEvent() { + if (prof) { + prof->end_event(); + } + } +}; + +GlobalProfiler& prof(); +ScopedEvent scoped_prof(const char* name); diff --git a/common/global_profiler/readme.md b/common/global_profiler/readme.md new file mode 100644 index 0000000000..5c9d1afcf9 --- /dev/null +++ b/common/global_profiler/readme.md @@ -0,0 +1,32 @@ +# Event Profiler +The event profiler is a tool to analyze timing of multiple frames. Unlike sampling-based profilers, this profile captures an exact timeline of what happens of what happens when. + +## Capturing a profile +In the OpenGOAL window, click "Profiler" and check "Record" to start recording. The buffer has a fixed maximum size and it will automatically overwrite old data once it is full. + +When something interesting happens, click the "dump to file" button to save the buffer (currently a few seconds) to `prof.json` in `jak-project`. + +The idea is that you can leave this running as you play, and then when the game stutters or does something interesting, you can click the dump button and get the result. + +## Viewing a profile +Open Google Chrome and go to `chrome://tracing`. Then click load and open the json file. Or, just drag and drop the file into chrome. + +Press `1` for a box drawing tool. This lets you select a region of the flame chart and get a list of events inside the box. + +Press `2` for panning. + +Press `3` for zooming. + +## Adding an event +The GOAL kernel automatically adds events for each process. If you want to add another event, you can use `(with-profiler "name-of-event" )`. Do not call `suspend` or do a `return` inside of this. If you need more control over stopping/starting, there are functions in `gcommon.gc` to explicitly start/stop events. But you must match them up correctly yourself! + +In C++, the graphics profiler automatically adds a profiler nodes as events. To add an event, you can use + +```auto p = scoped_prof("name-of-event");``` + +The event is active from this call until the destruction of `p`. + +## Multiple threads +The event profiler currently works on both the graphics and EE threads. Adding the events can safely be done from any thread, but enable/disable/dump should be done from a single thread at a time. + +Each thread should periodically insert a `ROOT` instant event when there are no active range events. This is required to make the retroactive dump feature work properly as the event buffer does not capture the tree structure fully, and it must be able to find a point in time when no events are active. \ No newline at end of file diff --git a/game/graphics/opengl_renderer/Profiler.h b/game/graphics/opengl_renderer/Profiler.h index eade3f690d..0a9adff14a 100644 --- a/game/graphics/opengl_renderer/Profiler.h +++ b/game/graphics/opengl_renderer/Profiler.h @@ -6,6 +6,7 @@ #include "common/common_types.h" #include "common/util/Timer.h" +#include "common/global_profiler/GlobalProfiler.h" #include "game/graphics/opengl_renderer/buckets.h" @@ -53,7 +54,8 @@ class ProfilerNode { class ScopedProfilerNode { public: - ScopedProfilerNode(ProfilerNode* node) : m_node(node) {} + ScopedProfilerNode(ProfilerNode* node) + : m_node(node), m_global_event(scoped_prof(node->name().c_str())) {} ScopedProfilerNode(const ScopedProfilerNode& other) = delete; ScopedProfilerNode& operator=(const ScopedProfilerNode& other) = delete; ProfilerNode* make_child(const std::string& name) { return m_node->make_child(name); } @@ -68,6 +70,7 @@ class ScopedProfilerNode { private: ProfilerNode* m_node; + ScopedEvent m_global_event; }; class Profiler { diff --git a/game/graphics/opengl_renderer/debug_gui.cpp b/game/graphics/opengl_renderer/debug_gui.cpp index 5f07ae118e..12f757dfc1 100644 --- a/game/graphics/opengl_renderer/debug_gui.cpp +++ b/game/graphics/opengl_renderer/debug_gui.cpp @@ -116,6 +116,12 @@ void OpenGlDebugGui::draw(const DmaStats& dma_stats) { ImGui::Checkbox("Sleep in Frame Limiter", &sleep_in_frame_limiter); ImGui::EndMenu(); } + + if (ImGui::BeginMenu("Event Profiler")) { + ImGui::Checkbox("Record", &record_events); + ImGui::MenuItem("Dump to file", nullptr, &dump_events); + ImGui::EndMenu(); + } } ImGui::EndMainMenuBar(); diff --git a/game/graphics/opengl_renderer/debug_gui.h b/game/graphics/opengl_renderer/debug_gui.h index 49eca5c228..92837a5996 100644 --- a/game/graphics/opengl_renderer/debug_gui.h +++ b/game/graphics/opengl_renderer/debug_gui.h @@ -64,6 +64,8 @@ class OpenGlDebugGui { bool experimental_accurate_lag = false; bool sleep_in_frame_limiter = true; bool small_profiler = false; + bool record_events = false; + bool dump_events = false; private: FrameTimeRecorder m_frame_timer; diff --git a/game/graphics/pipelines/opengl.cpp b/game/graphics/pipelines/opengl.cpp index 414aa0eecc..52830dfbe8 100644 --- a/game/graphics/pipelines/opengl.cpp +++ b/game/graphics/pipelines/opengl.cpp @@ -28,6 +28,7 @@ #include "common/util/FileUtil.h" #include "common/util/compress.h" #include "common/util/FrameLimiter.h" +#include "common/global_profiler/GlobalProfiler.h" namespace { @@ -222,6 +223,7 @@ void render_game_frame(int width, int height, int lbox_width, int lbox_height) { // wait for a copied chain. bool got_chain = false; { + auto p = scoped_prof("wait-for-dma"); std::unique_lock lock(g_gfx_data->dma_mutex); // note: there's a timeout here. If the engine is messed up and not sending us frames, // we still want to run the glfw loop. @@ -248,6 +250,7 @@ void render_game_frame(int width, int height, int lbox_width, int lbox_height) { auto& chain = g_gfx_data->dma_copier.get_last_result(); g_gfx_data->ogl_renderer.render(DmaFollower(chain.data.data(), chain.start_offset), options); } else { + auto p = scoped_prof("ogl-render"); g_gfx_data->ogl_renderer.render(DmaFollower(g_gfx_data->dma_copier.get_last_input_data(), g_gfx_data->dma_copier.get_last_input_offset()), options); @@ -351,18 +354,36 @@ static void gl_screen_size(GfxDisplay* display, } } +void update_global_profiler() { + if (g_gfx_data->debug_gui.dump_events) { + prof().set_enable(false); + g_gfx_data->debug_gui.dump_events = false; + prof().dump_to_json((file_util::get_jak_project_dir() / "prof.json").string()); + } + prof().set_enable(g_gfx_data->debug_gui.record_events); +} + +/*! + * Main function called to render graphics frames. This is called in a loop. + */ static void gl_render_display(GfxDisplay* display) { GLFWwindow* window = display->window_glfw; // poll events - glfwPollEvents(); - glfwMakeContextCurrent(window); - Pad::update_gamepads(); + { + auto p = scoped_prof("poll-gamepads"); + glfwPollEvents(); + glfwMakeContextCurrent(window); + Pad::update_gamepads(); + } // imgui start of frame - ImGui_ImplOpenGL3_NewFrame(); - ImGui_ImplGlfw_NewFrame(); - ImGui::NewFrame(); + { + auto p = scoped_prof("imgui-init"); + ImGui_ImplOpenGL3_NewFrame(); + ImGui_ImplGlfw_NewFrame(); + ImGui::NewFrame(); + } // window size int width = Gfx::g_global_settings.lbox_w; @@ -388,17 +409,25 @@ static void gl_render_display(GfxDisplay* display) { // render game! if (g_gfx_data->debug_gui.should_advance_frame()) { + auto p = scoped_prof("game-render"); render_game_frame(width, height, lbox_w, lbox_h); } if (g_gfx_data->debug_gui.should_gl_finish()) { + auto p = scoped_prof("gl-finish"); glFinish(); } - // render imgui - g_gfx_data->debug_gui.draw(g_gfx_data->dma_copier.get_last_result().stats); - ImGui::Render(); - ImGui_ImplOpenGL3_RenderDrawData(ImGui::GetDrawData()); + // render debug + { + auto p = scoped_prof("debug-gui"); + g_gfx_data->debug_gui.draw(g_gfx_data->dma_copier.get_last_result().stats); + } + { + auto p = scoped_prof("imgui-render"); + ImGui::Render(); + ImGui_ImplOpenGL3_RenderDrawData(ImGui::GetDrawData()); + } // switch vsync modes, if requested bool req_vsync = g_gfx_data->debug_gui.get_vsync_flag(); @@ -409,13 +438,19 @@ static void gl_render_display(GfxDisplay* display) { // actual vsync g_gfx_data->debug_gui.finish_frame(); - glfwSwapBuffers(window); + { + auto p = scoped_prof("swap-buffers"); + glfwSwapBuffers(window); + } if (g_gfx_data->debug_gui.framelimiter) { + auto p = scoped_prof("frame-limiter"); g_gfx_data->frame_limiter.run( g_gfx_data->debug_gui.target_fps, g_gfx_data->debug_gui.experimental_accurate_lag, g_gfx_data->debug_gui.sleep_in_frame_limiter, g_gfx_data->last_engine_time); } g_gfx_data->debug_gui.start_frame(); + prof().instant_event("ROOT"); + update_global_profiler(); if (display->fullscreen_pending()) { display->fullscreen_flush(); diff --git a/game/kernel/kmachine.cpp b/game/kernel/kmachine.cpp index 477bf40882..39ecd64cfd 100644 --- a/game/kernel/kmachine.cpp +++ b/game/kernel/kmachine.cpp @@ -40,6 +40,7 @@ #include "game/sce/libscf.h" #include "common/util/Assert.h" #include "game/discord.h" +#include "common/global_profiler/GlobalProfiler.h" #include "svnrev.h" @@ -866,6 +867,10 @@ void mkdir_path(u32 filepath) { file_util::create_dir_if_needed_for_file(filepath_str); } +void prof_event(u32 name, u32 kind) { + prof().event(Ptr(name).c()->data(), (ProfNode::Kind)kind); +} + u32 get_fullscreen() { switch (Gfx::get_fullscreen()) { default: @@ -926,6 +931,9 @@ void InitMachine_PCPort() { make_function_symbol_from_c("pc-discord-rpc-set", (void*)set_discord_rpc); make_function_symbol_from_c("pc-discord-rpc-update", (void*)update_discord_rpc); + // profiler + make_function_symbol_from_c("pc-prof", (void*)prof_event); + // init ps2 VM if (VM::use) { make_function_symbol_from_c("vm-ptr", (void*)VM::get_vm_ptr); diff --git a/game/main.cpp b/game/main.cpp index d46027fcc0..481961272b 100644 --- a/game/main.cpp +++ b/game/main.cpp @@ -14,6 +14,10 @@ // Discord RPC extern int64_t gStartTime; +/*! + * Set up logging system to log to file. + * @param verbose : should we print debug-level messages to stdout? + */ void setup_logging(bool verbose) { lg::set_file(file_util::get_file_path({"log/game.txt"})); if (verbose) { @@ -21,22 +25,26 @@ void setup_logging(bool verbose) { lg::set_stdout_level(lg::level::debug); lg::set_flush_level(lg::level::debug); } else { - lg::set_file_level(lg::level::warn); + lg::set_file_level(lg::level::debug); lg::set_stdout_level(lg::level::warn); lg::set_flush_level(lg::level::warn); } lg::initialize(); } +/*! + * Entry point for the game. + */ int main(int argc, char** argv) { - // do this as soon as possible - stuff like memcpy might use AVX instructions and we want to - // warn the user instead of just crashing. + // Figure out if the CPU has AVX2 to enable higher performance AVX2 versions of functions. setup_cpu_info(); + // If the CPU doesn't have AVX, GOAL code won't work and we exit. if (!get_cpu_info().has_avx) { printf("Your CPU does not support AVX, which is required for OpenGOAL.\n"); return -1; } + // parse arguments bool verbose = false; bool disable_avx2 = false; std::optional project_path_override = std::nullopt; @@ -55,11 +63,14 @@ int main(int argc, char** argv) { } } + // set up file paths for resources. This is the full repository when developing, and the data + // directory (a subset of the full repo) in release versions if (!file_util::setup_project_path(project_path_override)) { return 1; } - gStartTime = time(0); + // set up discord stuff + gStartTime = time(nullptr); init_discord_rpc(); if (disable_avx2) { diff --git a/game/runtime.cpp b/game/runtime.cpp index f8f6a6cf37..bcd433eccd 100644 --- a/game/runtime.cpp +++ b/game/runtime.cpp @@ -324,7 +324,6 @@ u32 exec_runtime(int argc, char** argv) { // step 4: wait for EE to signal a shutdown. meanwhile, run video loop on main thread. // TODO relegate this to its own function - // TODO also sync this up with how the game actually renders things (this is just a placeholder) if (enable_display) { Gfx::Loop([]() { return !MasterExit; }); Gfx::Exit(); diff --git a/goal_src/engine/draw/drawable.gc b/goal_src/engine/draw/drawable.gc index ff2deab428..9dd7338f3a 100644 --- a/goal_src/engine/draw/drawable.gc +++ b/goal_src/engine/draw/drawable.gc @@ -116,7 +116,7 @@ "Is this thing visible? By draw-node id." ;; todo #t - + #| (let* ((addr (scratchpad-ptr int8 :offset (+ #x3b80 (/ id 8)))) ;; address of the vis data (vis-byte (-> addr 0)) ;; vis byte @@ -920,11 +920,11 @@ ) ) "Function to be executed to set up for engine dma" - + ;; update render enables from the debug menu (set! *vu1-enable-user* *vu1-enable-user-menu*) (set! *texture-enable-user* *texture-enable-user-menu*) - + ;; reset and display dma memory stats. (when *debug-segment* (when (or *stats-memory* *stats-memory-short*) @@ -938,138 +938,141 @@ ) (reset! *dma-mem-usage*) ) - + ;; todo shrub matrix - + ;; initialize dma buckets that are generic sinks. ;; other renderers may output to these, so do them first. (generic-init-buffers) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; texture uploads ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - + ;; next we use the texture system to build DMA commands to load texture. ;; internally, add-tex-to-dma! has special logic to avoid loading textures ;; that won't be used. (though it's pretty basic, it doesn't actually track per-texture usage) - + ;; level tfrag's upload if the level is running. - (when (logtest? *texture-enable-user* 1) - (dotimes (gp-1 (-> *level* length)) - (let ((a1-2 (-> *level* level gp-1))) - (if (= (-> a1-2 status) 'active) - (add-tex-to-dma! *texture-pool* a1-2 0) + (with-profiler "texture-upload" + (when (logtest? *texture-enable-user* 1) + (dotimes (gp-1 (-> *level* length)) + (let ((a1-2 (-> *level* level gp-1))) + (if (= (-> a1-2 status) 'active) + (add-tex-to-dma! *texture-pool* a1-2 0) + ) + ) + ) + ) + ;; level pris's upload if the level is running. + (when (logtest? *texture-enable-user* 2) + (dotimes (gp-2 (-> *level* length)) + (let ((a1-3 (-> *level* level gp-2))) + (if (= (-> a1-3 status) 'active) + (add-tex-to-dma! *texture-pool* a1-3 1) + ) + ) + ) + ) + + ;; level shrubs upload if the level is loading. + (when (logtest? *texture-enable-user* 4) + (dotimes (gp-3 (-> *level* length)) + (let ((a1-4 (-> *level* level gp-3))) + (if (= (-> a1-4 status) 'active) + (add-tex-to-dma! *texture-pool* a1-4 2) + ) + ) + ) + ) + + ;; alpha and common. + (when (logtest? *texture-enable-user* 8) + (let ((uploaded-common #f)) + (dotimes (gp-4 (-> *level* length)) + (let ((a1-5 (-> *level* level gp-4))) + (when (= (-> a1-5 status) 'active) + (add-tex-to-dma! *texture-pool* a1-5 3) + (when (not uploaded-common) + (upload-one-common! *texture-pool* (-> *level* level0)) + (set! uploaded-common #t) + ) + ) ) + ) + (when (not uploaded-common) + (upload-one-common! *texture-pool* (-> *level* level0)) + #t + ) + ) + ) + + ;; water. + (when (logtest? *texture-enable-user* 16) + (dotimes (gp-5 (-> *level* length)) + (let ((a1-8 (-> *level* level gp-5))) + (if (= (-> a1-8 status) 'active) + (add-tex-to-dma! *texture-pool* a1-8 4) + ) + ) ) ) ) - ;; level pris's upload if the level is running. - (when (logtest? *texture-enable-user* 2) - (dotimes (gp-2 (-> *level* length)) - (let ((a1-3 (-> *level* level gp-2))) - (if (= (-> a1-3 status) 'active) - (add-tex-to-dma! *texture-pool* a1-3 1) - ) + + ;;;;;;;;;;;;; + ;; sky + ;;;;;;;;;;;;; + (with-profiler "sky" + (when (zero? (logand *vu1-enable-user* (vu1-renderer-mask sky))) + ;; the sky is disabled. Just draw a solid gradient on the whole screen. + (with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf)) (bucket-id sky-draw)) + (dma-buffer-add-gs-set dma-buf + (zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24))) + (test-1 (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always))) + (alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1)) + ) + (screen-gradient + dma-buf + (-> *display* bg-clear-color 0) + (-> *display* bg-clear-color 1) + (-> *display* bg-clear-color 2) + (-> *display* bg-clear-color 3) + ) ) ) - ) - - ;; level shrubs upload if the level is loading. - (when (logtest? *texture-enable-user* 4) - (dotimes (gp-3 (-> *level* length)) - (let ((a1-4 (-> *level* level gp-3))) - (if (= (-> a1-4 status) 'active) - (add-tex-to-dma! *texture-pool* a1-4 2) - ) - ) - ) - ) - - ;; alpha and common. - (when (logtest? *texture-enable-user* 8) - (let ((uploaded-common #f)) - (dotimes (gp-4 (-> *level* length)) - (let ((a1-5 (-> *level* level gp-4))) - (when (= (-> a1-5 status) 'active) - (add-tex-to-dma! *texture-pool* a1-5 3) - (when (not uploaded-common) - (upload-one-common! *texture-pool* (-> *level* level0)) - (set! uploaded-common #t) + (when (logtest? *vu1-enable-user* (vu1-renderer-mask sky)) + ;; check if we want the sky, and if we actually have textures ready. + ;; we generate sky textures on the previous frame and they sit in vram (8160) until the next frame. + ;; on the first frame after we request sky, we draw the textures, but they aren't ready until the next frame. + (cond + ((and (-> *time-of-day-context* sky) *sky-drawn*) + (render-sky-tng *time-of-day-context*) + ) + (else + ;; todo + (with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf)) (bucket-id sky-draw)) + (dma-buffer-add-gs-set dma-buf + (zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24))) + (test-1 (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always))) + (alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1)) + ) + (screen-gradient + dma-buf + (-> *time-of-day-context* erase-color) + (-> *time-of-day-context* erase-color) + (-> *time-of-day-context* erase-color) + (-> *time-of-day-context* erase-color) ) ) ) ) - (when (not uploaded-common) - (upload-one-common! *texture-pool* (-> *level* level0)) - #t - ) ) ) - - ;; water. - (when (logtest? *texture-enable-user* 16) - (dotimes (gp-5 (-> *level* length)) - (let ((a1-8 (-> *level* level gp-5))) - (if (= (-> a1-8 status) 'active) - (add-tex-to-dma! *texture-pool* a1-8 4) - ) - ) - ) - ) - - ;;;;;;;;;;;;; - ;; sky - ;;;;;;;;;;;;; - - (when (zero? (logand *vu1-enable-user* (vu1-renderer-mask sky))) - ;; the sky is disabled. Just draw a solid gradient on the whole screen. - (with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf)) (bucket-id sky-draw)) - (dma-buffer-add-gs-set dma-buf - (zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24))) - (test-1 (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always))) - (alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1)) - ) - (screen-gradient - dma-buf - (-> *display* bg-clear-color 0) - (-> *display* bg-clear-color 1) - (-> *display* bg-clear-color 2) - (-> *display* bg-clear-color 3) - ) - ) - ) - (when (logtest? *vu1-enable-user* (vu1-renderer-mask sky)) - ;; check if we want the sky, and if we actually have textures ready. - ;; we generate sky textures on the previous frame and they sit in vram (8160) until the next frame. - ;; on the first frame after we request sky, we draw the textures, but they aren't ready until the next frame. - (cond - ((and (-> *time-of-day-context* sky) *sky-drawn*) - (render-sky-tng *time-of-day-context*) - ) - (else - ;; todo - (with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf)) (bucket-id sky-draw)) - (dma-buffer-add-gs-set dma-buf - (zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24))) - (test-1 (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always))) - (alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1)) - ) - (screen-gradient - dma-buf - (-> *time-of-day-context* erase-color) - (-> *time-of-day-context* erase-color) - (-> *time-of-day-context* erase-color) - (-> *time-of-day-context* erase-color) - ) - ) - ) - ) - ) - - + + ;; update mood lighting, draw sky textures. - (update-time-of-day *time-of-day-context*) - + (with-profiler "time-of-day" (update-time-of-day *time-of-day-context*)) + ;; reset the closest object and desired texture masks for all levels. ; (dotimes (v1-150 (-> *level* length)) ; (let ((a0-59 (-> *level* level v1-150))) @@ -1084,87 +1087,106 @@ (add-ee-profile-frame 'draw :r #x40 :b #x40 :a #x80) ;;;;;;; OCEAN - (update-ocean) ;; ocean map update - (draw-ocean) ;; far, mid, near, transition, and texture. + (with-profiler "ocean" + (update-ocean) ;; ocean map update + (draw-ocean) ;; far, mid, near, transition, and texture. + ) (add-ee-profile-frame 'draw :b #xff :a #x80) ;; reset MERC - (set! (-> *merc-global-array* count) (the-as uint 0)) - (set! *merc-globals* (the-as merc-globals (-> *merc-global-array* globals))) - (set! (-> *shadow-queue* cur-run) (the-as uint 0)) + (with-profiler "merc" + (set! (-> *merc-global-array* count) (the-as uint 0)) + (set! *merc-globals* (the-as merc-globals (-> *merc-global-array* globals))) + (set! (-> *shadow-queue* cur-run) (the-as uint 0)) + ) ;; draw the background! - (init-background) - (execute-connections *background-draw-engine* (-> *display* frames (-> *display* on-screen) frame)) + (with-profiler "background" + (init-background) + (execute-connections *background-draw-engine* (-> *display* frames (-> *display* on-screen) frame)) - ;; finish bg (most of the work is here) - (reset! (-> *perf-stats* data 3)) - (finish-background) - (read! (-> *perf-stats* data 3)) - (update-wait-stats (-> *perf-stats* data 3) (-> *background-work* wait-to-vu0) (the-as uint 0) (the-as uint 0)) - - ;; perf stats are printed and restarted here, for some reason. - (end-perf-stat-collection) - (when (not (paused?)) - (when *stats-poly* - (dotimes (gp-8 (-> *level* length)) - (let ((v1-193 (-> *level* level gp-8))) - (if (= (-> v1-193 status) 'active) - (collect-stats (-> v1-193 bsp)) - ) - ) - ) - (print-terrain-stats) - ) - (if *display-perf-stats* - (print-perf-stats) - ) + ;; finish bg (most of the work is here) + (reset! (-> *perf-stats* data 3)) + (finish-background) + (read! (-> *perf-stats* data 3)) + (update-wait-stats (-> *perf-stats* data 3) (-> *background-work* wait-to-vu0) (the-as uint 0) (the-as uint 0)) + ) + + ;; perf stats are printed and restarted here, for some reason. + (with-profiler "stats" + (end-perf-stat-collection) + (when (not (paused?)) + (when *stats-poly* + (dotimes (gp-8 (-> *level* length)) + (let ((v1-193 (-> *level* level gp-8))) + (if (= (-> v1-193 status) 'active) + (collect-stats (-> v1-193 bsp)) + ) + ) + ) + (print-terrain-stats) + ) + (if *display-perf-stats* + (print-perf-stats) + ) + ) + (start-perf-stat-collection) ) - (start-perf-stat-collection) ;; draw the foreground engines. - (foreground-engine-execute - (-> *level* level-default foreground-draw-engine 0) - (-> *display* frames (-> *display* on-screen) frame) - 2 - 0 + (with-profiler "foreground-engines" + (foreground-engine-execute + (-> *level* level-default foreground-draw-engine 0) + (-> *display* frames (-> *display* on-screen) frame) + 2 + 0 + ) + (foreground-engine-execute + (-> *level* level-default foreground-draw-engine 1) + (-> *display* frames (-> *display* on-screen) frame) + 2 + 1 + ) ) - (foreground-engine-execute - (-> *level* level-default foreground-draw-engine 1) - (-> *display* frames (-> *display* on-screen) frame) - 2 - 1 - ) - + ;; handle extra processing for foreground + (let ((gp-9 (-> *display* frames (-> *display* on-screen) frame global-buf))) - (bones-mtx-calc-execute) ;; skinning matrix calculation - (generic-merc-execute-all gp-9) ;; mercneric conversion. - (shadow-execute-all gp-9 *shadow-queue*) - (update-eyes) + (with-profiler "bones" (bones-mtx-calc-execute)) ;; skinning matrix calculation + (with-profiler "gmerc" (generic-merc-execute-all gp-9)) ;; mercneric conversion. + (with-profiler "shadow" (shadow-execute-all gp-9 *shadow-queue*)) + (with-profiler "eyes" (update-eyes)) ) ;; sprite draw (when (logtest? (vu1-renderer-mask sprite) *vu1-enable-user*) - (swap-fake-shadow-buffers) - (sprite-draw *display*) + (with-profiler "sprite" + (swap-fake-shadow-buffers) + (sprite-draw *display*) + ) ) ;; debug drawing - (when *debug-segment* - (debug-draw-actors *level* *display-actor-marks*) - (collide-shape-draw-debug-marks) + (with-profiler "debug-draw" + (when *debug-segment* + (debug-draw-actors *level* *display-actor-marks*) + (collide-shape-draw-debug-marks) + ) + (render-boundaries) ) - (render-boundaries) - + ;; for some reason we clear the touching list here... - (send-events-for-touching-shapes *touching-list*) - (free-all-prim-nodes *touching-list*) - + (with-profiler "touching" + (send-events-for-touching-shapes *touching-list*) + (free-all-prim-nodes *touching-list*) + ) + (add-ee-profile-frame 'draw :r #x40 :b #x40 :a #x80) ;; spawn actors, compact heaps, etc. - (actors-update *level*) + (with-profiler "actors-update" + (actors-update *level*) + ) (add-ee-profile-frame 'draw :r #x80 :a #x80) - + (when (not (paused?)) (if *stats-collide* (print-collide-stats) diff --git a/goal_src/engine/game/main.gc b/goal_src/engine/game/main.gc index 106794de10..892b655337 100644 --- a/goal_src/engine/game/main.gc +++ b/goal_src/engine/game/main.gc @@ -583,7 +583,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Pre loop initialization ;;;;;;;;;;;;;;;;;;;;;;;;;;;; - + ;; the size is 0, so this doesn't actually do anything. ;; (dma-send-to-spr (the-as uint #x70000000) (the-as uint *terrain-context*) (the-as uint 0) #t) (set! *teleport* #t) @@ -595,104 +595,113 @@ (blerc-init) ;; collide dma (suspend) - - + + (while *run* ;; start immediately after all process updates finish. - + (profiler-instant-event "display-loop-top") + ;; drawing effects to be used in foreground drawing. - (blerc-execute) - (blerc-init) - (texscroll-execute) - (ripple-execute) - + (with-profiler "foreground-effects" + (blerc-execute) + (blerc-init) + (texscroll-execute) + (ripple-execute) + ) + ;;;;;;;;;;;;;;;;;;;; ;; AMBIENT ;;;;;;;;;;;;;;;;;;;; - + ;; set defaults for weather/music/flava. - (set! *weather-off* #f) - (let ((v1-13 (-> *game-info* current-continue level))) - (dotimes (a0-8 (-> *level* length)) - (let ((a1-6 (-> *level* level a0-8))) - (when (= (-> a1-6 status) 'active) - (if (and (= (-> a1-6 name) v1-13) (-> *level* play?)) - (set! (-> *setting-control* default music) (-> a1-6 info music-bank)) - ) + (with-profiler "ambients" + (set! *weather-off* #f) + (let ((v1-13 (-> *game-info* current-continue level))) + (dotimes (a0-8 (-> *level* length)) + (let ((a1-6 (-> *level* level a0-8))) + (when (= (-> a1-6 status) 'active) + (if (and (= (-> a1-6 name) v1-13) (-> *level* play?)) + (set! (-> *setting-control* default music) (-> a1-6 info music-bank)) + ) + ) ) ) ) - ) - - (set! (-> *setting-control* default sound-flava) (the-as uint 49)) - (set! (-> *setting-control* default sound-flava-priority) 0.0) - - ;; find any ambients, and execute them. - (when (and *execute-ambients* (not (paused?))) - (if *target* - (set! (-> *target* draw secondary-interp) 0.0) - ) - (let ((s5-1 (sphere<-vector+r! (new 'stack 'sphere) (ear-trans) 0.0))) - (let ((v1-28 (scratchpad-object terrain-context))) - (set! (-> v1-28 work ambient ambient-list num-items) 0) - ) - (dotimes (s4-1 (-> *level* length)) - (let ((v1-32 (-> *level* level s4-1))) - (when (= (-> v1-32 status) 'active) - (collect-ambients (-> v1-32 bsp) s5-1 0 (-> (scratchpad-object terrain-context) work ambient ambient-list)) - ) + + (set! (-> *setting-control* default sound-flava) (the-as uint 49)) + (set! (-> *setting-control* default sound-flava-priority) 0.0) + + ;; find any ambients, and execute them. + (when (and *execute-ambients* (not (paused?))) + (if *target* + (set! (-> *target* draw secondary-interp) 0.0) + ) + (let ((s5-1 (sphere<-vector+r! (new 'stack 'sphere) (ear-trans) 0.0))) + (let ((v1-28 (scratchpad-object terrain-context))) + (set! (-> v1-28 work ambient ambient-list num-items) 0) + ) + (dotimes (s4-1 (-> *level* length)) + (let ((v1-32 (-> *level* level s4-1))) + (when (= (-> v1-32 status) 'active) + (collect-ambients (-> v1-32 bsp) s5-1 0 (-> (scratchpad-object terrain-context) work ambient ambient-list)) + ) + ) + ) + + (countdown (s4-2 (-> (scratchpad-object terrain-context) work ambient ambient-list num-items)) + (execute-ambient (-> (scratchpad-object terrain-context) work ambient ambient-list items s4-2) s5-1) ) - ) - - (countdown (s4-2 (-> (scratchpad-object terrain-context) work ambient ambient-list num-items)) - (execute-ambient (-> (scratchpad-object terrain-context) work ambient ambient-list items s4-2) s5-1) ) ) ) (add-ee-profile-frame 'draw :r #x40 :b #x40) ;; actor update - + ;; do math, before drawing - (execute-math-engine) + (with-profiler "math-engine" (execute-math-engine)) ;; DEBUG PROF (add-ee-profile-frame 'draw :r #x80) (add-ee-profile-frame 'draw :r #x40 :b #x40) ;; debug hook - (*debug-hook*) - (main-cheats) + (with-profiler "debug" (*debug-hook*) (main-cheats)) (add-ee-profile-frame 'draw :r #x20 :g #x20) - (update-camera) + (with-profiler "camera" (update-camera)) (add-ee-profile-frame 'draw :r #x40 :b #x40) - (*draw-hook*) + (with-profiler "draw-hook" (*draw-hook*)) (add-ee-profile-frame 'draw :g #x80) - (with-pc - (if (-> *pc-settings* display-sha) - (draw-build-revision))) + (with-profiler "menu" + (with-pc + (if (-> *pc-settings* display-sha) + (draw-build-revision))) - (*menu-hook*) - (add-ee-profile-frame 'draw :g #x40) + (*menu-hook*) + (add-ee-profile-frame 'draw :g #x40) - ;; finally, update hints/text - (make-current-level-available-to-progress) - (update-task-hints) - (load-level-text-files -1) + ;; finally, update hints/text + (make-current-level-available-to-progress) + (update-task-hints) + (load-level-text-files -1) - (add-ee-profile-frame 'unknown-cpu-time) - ;; collect perf stats - (read! (-> *perf-stats* data (perf-stat-bucket all-code))) - - (when (nonzero? (sync-path 0 0)) - (*dma-timeout-hook*) - (reset-vif1-path) - (if *debug-segment* - (format 0 "profile bar at ~D.~%" (-> (current-frame) profile-bar 1 profile-frame-count)) - ) + (add-ee-profile-frame 'unknown-cpu-time) + ;; collect perf stats + (read! (-> *perf-stats* data (perf-stat-bucket all-code))) + ) + + (with-profiler "dma-sync" + (when (nonzero? (sync-path 0 0)) + (*dma-timeout-hook*) + (reset-vif1-path) + (if *debug-segment* + (format 0 "profile bar at ~D.~%" (-> (current-frame) profile-bar 1 profile-frame-count)) + ) + ) + (reset! (-> *perf-stats* data (perf-stat-bucket all-code))) ) - (reset! (-> *perf-stats* data (perf-stat-bucket all-code))) ;; depth cue ;; screen filter + (with-profiler "post-sync-draw" ;; add letterbox effect (when (or (movie?) (< (-> *display* base-frame-counter) (-> *game-info* letterbox-time))) (if (< (-> *game-info* letterbox-time) (-> *display* base-frame-counter)) @@ -882,12 +891,13 @@ ;; console buffers (set! *stdcon* (clear *stdcon0*)) + ) ;; <--------------------------- SWAP DISPLAY! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (swap-display disp) + (with-profiler "swap-display" (swap-display disp)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - + (set! (-> *time-of-day-context* title-updated) #f) (set! *teleport* #f) (when (nonzero? *teleport-count*) @@ -897,21 +907,26 @@ ;; perf stats - (process-particles) - + (with-profiler "process-particles" (process-particles)) ;; vif0 collide ;; swap sound ;; str play - (swap-sound-buffers (ear-trans) (camera-pos) (camera-angle)) - (str-play-kick) - (level-update *level*) ;; also updates settings. - (mc-run) - (auto-save-check) + (with-profiler "sound-update" + (swap-sound-buffers (ear-trans) (camera-pos) (camera-angle)) + (str-play-kick) + ) + + (with-profiler "level-and-save" + (level-update *level*) ;; also updates settings. + (mc-run) + (auto-save-check) + + (#when PC_PORT + (update *pc-settings*) + ) + ) - (#when PC_PORT - (update *pc-settings*) - ) ;; suspend (suspend) diff --git a/goal_src/engine/ps2/timer-h.gc b/goal_src/engine/ps2/timer-h.gc index 97e17a81c5..e264d4011d 100644 --- a/goal_src/engine/ps2/timer-h.gc +++ b/goal_src/engine/ps2/timer-h.gc @@ -181,7 +181,6 @@ ) ) ) - ;; tentative name (defmethod get-last-frame-time-stamp profile-bar ((obj profile-bar)) diff --git a/goal_src/kernel-defs.gc b/goal_src/kernel-defs.gc index 2fa9b2d728..074df3a928 100644 --- a/goal_src/kernel-defs.gc +++ b/goal_src/kernel-defs.gc @@ -340,6 +340,14 @@ (define-extern pc-filepath-exists? (function string symbol)) (define-extern pc-mkdir-file-path (function string none)) +(defenum pc-prof-event + (begin 0) + (end 1) + (instant 2) + ) + +(define-extern pc-prof (function string pc-prof-event none)) + ;; Constants generated within the C++ runtime (define-extern *pc-user-dir-base-path* string) (define-extern *pc-settings-folder* string) diff --git a/goal_src/kernel/gcommon.gc b/goal_src/kernel/gcommon.gc index 4bc63263d7..2793b221cf 100644 --- a/goal_src/kernel/gcommon.gc +++ b/goal_src/kernel/gcommon.gc @@ -24,6 +24,9 @@ ;; are monitored in the runtime for debugging. (defglobalconstant USE_VM #t) +(defglobalconstant PC_PROFILER_ENABLE #t) + + (defmacro get-vm-ptr (ptr) "Turn an EE register address into a valid PS2 VM address" `(#cond @@ -119,7 +122,7 @@ ) (defun ash ((value int) (shift-amount int)) - "Arithmetic shift value by shift-amount. + "Arithmetic shift value by shift-amount. A positive shift-amount will shift to the left and a negative will shift to the right. " ;; OpenGOAL does not support ash in the compiler, so we implement it here as an inline function. @@ -133,7 +136,7 @@ (defun mod ((a int) (b int)) "Compute mod. It does what you expect for positive numbers. For negative numbers, nobody knows what to expect. This is a 32-bit operation. It uses an idiv on x86 and gets the remainder." - + ;; The original implementation is div, mfhi ;; todo - verify this is exactly the same as the PS2. (mod a b) @@ -142,7 +145,7 @@ (defun rem ((a int) (b int)) "Compute remainder (32-bit). It is identical to mod. It uses a idiv and gets the remainder" - + ;; The original implementation is div, mfhi ;; todo - verify this is exactly the same as the PS2. (mod a b) @@ -150,9 +153,9 @@ (defun abs ((a int)) "Take the absolute value of an integer" - + (declare (inline)) - + ;; OpenGOAL doesn't support abs, so we implement it here. (if (> a 0) ;; condition is "a > 0" a ;; true case, return a @@ -162,7 +165,7 @@ (defun min ((a int) (b int)) "Compute minimum." - + ;; The original implementation was inline assembly, to take advantage of branch delay slots: ;; (or v0 a0 r0) ;; move first arg to output (case of second arg being min) ;; (or v1 a1 r0) ;; move second arg to v1 (likely strange coloring) @@ -307,7 +310,7 @@ (defmethod asize-of type ((obj type)) "Get the size in memory of a type" - ;; The 28 is 8 bytes too large. It's also strange that types have a 16-byte aligned size always, + ;; The 28 is 8 bytes too large. It's also strange that types have a 16-byte aligned size always, ;; but this matches what the runtime does as well. There's no reason that I can see for this, ;; as other basics don't require 16-byte aligned sizes. ;; - maybe the 16-byte aligned size was a requirement if types were stored in the symbol table? @@ -486,7 +489,7 @@ ) (defun nassoc ((item-name string) (alist object)) - "Is there an entry named item-name in the association list alist? + "Is there an entry named item-name in the association list alist? Checks name with nmember or name= so you can have multiple keys. Returns the ([key|(key..)] . value) pair." (while (not (or (null? alist) @@ -670,9 +673,9 @@ ;; children of inline-array-class should define their own data which overlays this one. (_data uint8 :dynamic :offset 16) ) - + (:methods (new (symbol type int) _type_ 0)) - + :method-count-assert 9 :size-assert #x10 :flag-assert #x900000010 @@ -760,7 +763,7 @@ (format #t "#(") (cond ((type-type? (-> obj content-type) integer) - (case (-> obj content-type symbol) + (case (-> obj content-type symbol) (('int32) (dotimes (s5-0 (-> obj length)) (format #t (if (zero? s5-0) @@ -894,7 +897,7 @@ (format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data)) (cond ((type-type? (-> obj content-type) integer) - (case (-> obj content-type symbol) + (case (-> obj content-type symbol) (('int32) (dotimes (s5-0 (-> obj length)) (format #t "~T [~D] ~D~%" s5-0 (-> (the-as (array int32) obj) s5-0)) @@ -1425,3 +1428,35 @@ (defmacro empty-form () `(none) ) + +(defmacro profiler-instant-event (name) + `(#when PC_PROFILER_ENABLE + (pc-prof ,name (pc-prof-event instant)) + ) + ) + +(defmacro profiler-start-event (name) + `(#when PC_PROFILER_ENABLE + (pc-prof ,name (pc-prof-event begin)) + ) + ) + +(defmacro profiler-end-event () + `(#when PC_PROFILER_ENABLE + (pc-prof "" (pc-prof-event end)) + ) + ) + +(defmacro with-profiler (name &rest body) + `(#if PC_PROFILER_ENABLE + (begin + (pc-prof ,name (pc-prof-event begin)) + ,@body + (pc-prof ,name (pc-prof-event end)) + ) + + (begin + ,@body + ) + ) + ) \ No newline at end of file diff --git a/goal_src/kernel/gkernel.gc b/goal_src/kernel/gkernel.gc index 45a1f4637e..2d5cbf47ac 100644 --- a/goal_src/kernel/gkernel.gc +++ b/goal_src/kernel/gkernel.gc @@ -32,7 +32,7 @@ ;; Can be 'boot, 'listener, or 'debug-boot ;; set to 'boot when DiskBooting. -(define *kernel-boot-mode* 'listener) +(define *kernel-boot-mode* 'listener) ;; DebugBootLevel in C Kernel (define *kernel-boot-level* (the symbol #f)) @@ -117,21 +117,21 @@ ;; without executing anything, to find a process for instance. (define *null-kernel-context* (new 'static 'kernel-context)) -(#cond +(#cond (PC_PORT - + ;; make sure the scratchpad is 16kb aligned, and make it 32 kB so we can big stacks on it. (let* ((mem (new 'global 'array 'uint8 (* (+ 16 32) 1024))) ) (define *fake-scratchpad-data* (the pointer (align-n mem (* 16 1024)))) ) - + ;; We will move stacks on the scratchpad to here. ;; it might be possible to also throw them on the *dram-stack*, but they might depend on these ;; not overlapping. We can spare the 16k of memory. (define *fake-scratchpad-stack* *fake-scratchpad-data*) ;;(define *fake-scratchpad-stack* (new 'global 'array 'uint8 (* 16 1024))) - + (defmacro scratchpad-start() '*fake-scratchpad-data* @@ -149,12 +149,12 @@ ) (defmacro in-scratchpad? (x) - `(and + `(and (>= (the-as int ,x) (scratchpad-start)) (< (the-as int ,x) (scratchpad-end)) ) ) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -178,13 +178,13 @@ ;; Perhaps the thread was the public interface and cpu-thread is internal to the kernel? (defmethod delete thread ((obj thread)) - "Clean up a temporary thread after it is done being used. + "Clean up a temporary thread after it is done being used. This assumes it's the top-thread of the process and restores the previous top thread." (when (eq? obj (-> obj process main-thread)) ;; We have attempted to delete the main thread, which is bad. (break) ) - + ;; restore the old top-thread. (set! (-> obj process top-thread) (-> obj previous)) (none) @@ -198,7 +198,7 @@ (defmethod stack-size-set! thread ((this thread) (stack-size int)) "Set the backup stack size of a thread. This should only be done on the main-thread. This should be done immediately after allocating the main-thread." - + (let ((proc (-> this process))) (cond ((neq? this (-> proc main-thread)) @@ -206,11 +206,11 @@ (msg-err "illegal attempt change stack size of ~A when the main-thread is not the top-thread.~%" proc) (break) ;; ADDED ) - + ((= (-> this stack-size) stack-size) ;; we already have this size. Don't do anything. ) - + ((eq? (-> proc heap-cur) (&+ this (-> this type size) (- *gtype-basic-offset*) (-> this stack-size))) ;; our heap cur point to right after us. So we can safely bump it forward to give us more space. (set! (-> proc heap-cur) (the pointer (&+ this (-> this type size) (- *gtype-basic-offset*) stack-size))) @@ -232,7 +232,7 @@ This is a special new method which ignores the allocation symbol. The stack-top is for the execution stack. The stack-size is for the backup stack (applicable for main thread only)" - + ;; first, let's see if we're doing the main or temp thread (let* ((obj (cond ((-> parent-process top-thread) @@ -245,7 +245,7 @@ )) ) (else - ;; the main thread. We need the main thread's cpu-thread to stick around, so we put it in the + ;; the main thread. We need the main thread's cpu-thread to stick around, so we put it in the ;; process heap. (let ((alloc (align16 (-> parent-process heap-cur)))) ;; start at heap cur, aligned ;; bump heap to include our thread + its stack @@ -254,10 +254,10 @@ ) ) ))) - + ;; set up the type manually, as we allocated the memory manually (set! (-> obj type) type-to-make) - + ;; set up thread (set! (-> obj name) name) (set! (-> obj process) parent-process) @@ -268,12 +268,12 @@ (set! (-> obj previous) (-> parent-process top-thread)) ;; and make us the top! (set! (-> parent-process top-thread) obj) - + ;; set up our suspend/resume hooks. By default just use the thread's methods. ;; but something else could install a different hook if needed. (set! (-> obj suspend-hook) (method-of-object obj thread-suspend)) (set! (-> obj resume-hook) (method-of-object obj thread-resume)) - + ;; remember how much space we have for the backup stack. (set! (-> obj stack-size) stack-size) obj @@ -325,7 +325,7 @@ (set! (-> obj parent) #f) (set! (-> obj brother) #f) (set! (-> obj child) #f) - + (set! (-> obj self) obj) (set! (-> obj ppointer) (the (pointer process) (&-> obj self))) obj @@ -350,7 +350,7 @@ (let ((obj (if (eq? (-> allocation type) symbol) (object-new allocation type-to-make (the int (+ (-> process size) stack-size))) ;; symbol, allocate on heap (the process (&+ allocation *gtype-basic-offset*))))) ;; treat as address. - + ;; initialize (set! (-> obj name) name) (set! (-> obj status) 'dead) @@ -359,11 +359,11 @@ (set! (-> obj allocated-length) stack-size) (set! (-> obj top-thread) #f) (set! (-> obj main-thread) #f) - + ;; set up the heap to start at the stack (set! (-> obj heap-cur) (-> obj stack)) (set! (-> obj heap-base) (-> obj stack)) - + ;; and end at the end of the stack. (set! (-> obj heap-top) (&-> (-> obj stack) (-> obj allocated-length))) ;;;;;;;;;;;;;;;;;;;;;;;;; @@ -373,13 +373,13 @@ ;; but this overlaps with the stack-frame-top and did nothing. ;; this is likely because they added the concept of heap "top" to kheaps in ;; general, but not to process heaps. - + ;; setup state stuff (set! (-> obj stack-frame-top) #f) (set! (-> obj state) #f) (set! (-> obj next-state) #f) (set! (-> obj entity) #f) - + ;; setup handlers (set! (-> obj trans-hook) #f) (set! (-> obj post-hook) #f) @@ -389,12 +389,12 @@ (set! (-> obj parent) #f) (set! (-> obj brother) #f) (set! (-> obj child) #f) - + ;; setup reference stuff. (set! (-> obj self) obj) (set! (-> obj ppointer) (the (pointer process) (&-> obj self))) obj - ) + ) ) (defun inspect-process-heap ((obj process)) @@ -450,12 +450,12 @@ ) (defmethod print process ((obj process)) - (format #t "#<~A ~S ~A :state ~S " - (-> obj type) - (-> obj name) - (-> obj status) + (format #t "#<~A ~S ~A :state ~S " + (-> obj type) + (-> obj name) + (-> obj status) (when (-> obj state) (-> obj state name))) - + (format #t ":stack ~D/~D :heap ~D/~D @ #x~X>" (process-stack-used obj) (process-stack-size obj) @@ -501,7 +501,7 @@ (.load-sym :sext #f sp *kernel-sp*) ;; convert it back to a real pointer (.add sp off) - + ;; restore saved registers... ;; without coloring system because this is "cheating" and modifying saved registers without backing up. (.pop :color #f s4) @@ -530,14 +530,14 @@ (s3 :reg r11 :type uint) (s4 :reg r12 :type uint) ) - + ;; first call the deactivate method. (todo - is the stack properly aligned for this?) (deactivate pp) ;; get the kernel stack pointer as a GOAL pointer (.load-sym :sext #f sp *kernel-sp*) ;; convert it back to a real pointer (.add sp off) - + ;; restore saved registers... ;; without coloring system because this is "cheating". (.pop :color #f s4) @@ -559,7 +559,7 @@ (declare (asm-func object) ;(print-asm) ) - + (rlet ((pp :reg r13 :type process) (sp :reg rsp :type uint) (off :reg r15 :type uint) @@ -570,29 +570,29 @@ (s4 :reg r12 :type uint) (temp :reg rax :type uint) ) - + ;; set up the process pointer (set! pp (-> obj process)) ;; mark the process as running and set its top thread (set! (-> pp status) 'running) (set! (-> pp top-thread) obj) - + ;; save the current kernel regs (.push :color #f s0) (.push :color #f s1) (.push :color #f s2) (.push :color #f s3) (.push :color #f s4) - + ;; make rsp a GOAL pointer (.sub sp off) ;; and store it (set! *kernel-sp* (the pointer sp)) ;; todo, asm form here? - + ;; setup the rsp for the new thread (set! sp (the uint (-> obj stack-top))) (.add sp off) - + ;; push the return trampoline to the stack for the user code to return to (set! temp (the uint return-from-thread)) (.add temp off) @@ -612,9 +612,9 @@ (defmethod thread-suspend cpu-thread ((unused cpu-thread)) "Suspend the thread and return to the kernel." - + (declare (asm-func none)) - + ;; we begin this function with the thread object in pp. ;; not sure why we do this, maybe at one point suspending didn't clobber ;; temp registers? @@ -627,7 +627,7 @@ (s2 :reg r10 :type uint) (s3 :reg r11 :type uint) (s4 :reg r12 :type uint) - + (xmm8 :reg xmm8 :class fpr) (xmm9 :reg xmm9 :class fpr) (xmm10 :reg xmm10 :class fpr) @@ -637,19 +637,19 @@ (xmm14 :reg xmm14 :class fpr) (xmm15 :reg xmm15 :class fpr) ) - + ;; get the return address pushed by "call" in the suspend. (.pop temp) ;; convert to a GOAL address (.sub temp off) ;; store return address in thread (set! (-> obj pc) (the pointer temp)) - + ;; convert our stack pointer to a GOAL address (.sub sp off) ;; store in thread. (set! (-> obj sp) (the pointer sp)) - + ;; back up registers (.mov :color #f temp s0) (set! (-> obj rreg 0) temp) @@ -661,7 +661,7 @@ (set! (-> obj rreg 3) temp) (.mov :color #f temp s4) (set! (-> obj rreg 4) temp) - + ;; back up fprs (.mov :color #f temp xmm8) (set! (-> obj freg 0) (the-as float temp)) @@ -680,8 +680,8 @@ (.mov :color #f temp xmm15) (set! (-> obj freg 7) (the-as float temp)) - - + + ;; get our process (let ((proc (-> obj process))) (when (> (process-stack-used proc) (-> obj stack-size)) @@ -689,7 +689,7 @@ ;; if you hit this, try with DEBUG_PRINT_SUSPEND_FAIL set to #t (see gkernel-h.gc) ;; it will print more info before reaching here. ) - + ;; mark the process as suspended and copy the stack (set! (-> proc status) 'suspended) (let ((cur (the (pointer uint64) (-> obj stack-top))) @@ -702,15 +702,15 @@ ) ) ) - + ;; actually setting pp to 0 (set! obj (the cpu-thread 0)) - + ;; get the kernel stack pointer as a GOAL pointer (.load-sym :sext #f sp *kernel-sp*) ;; convert it back to a real pointer (.add sp off) - + ;; restore saved registers... ;; without coloring system because this is "cheating". (.pop :color #f s4) @@ -732,7 +732,7 @@ (declare (asm-func none) ;;(print-asm) ) - + (rlet ((obj :reg r13 :type cpu-thread) (temp :reg rax :type uint) (off :reg r15 :type uint) @@ -754,26 +754,26 @@ (xmm13 :reg xmm13 :class fpr) (xmm14 :reg xmm14 :class fpr) (xmm15 :reg xmm15 :class fpr) - ) - + ) + ;; save the current kernel regs (.push :color #f s0) (.push :color #f s1) (.push :color #f s2) (.push :color #f s3) (.push :color #f s4) - + ;; make rsp a GOAL pointer (.sub sp off) ;; and store it (set! *kernel-sp* (the pointer sp)) ;; todo, asm form here? - + ;; temp, stash thread in process-pointer (set! obj thread-to-resume) - + ;; set stack pointer for the thread. leave it as a GOAL pointer for now.. (set! sp (the uint (-> obj sp))) - + ;; restore the stack (sp is a GOAL pointer) (let ((cur (the (pointer uint64) (-> obj stack-top))) (restore (&+ (the (pointer uint64) (-> obj stack)) (-> obj stack-size))) @@ -784,14 +784,14 @@ (set! (-> cur) (-> restore)) ) ) - + ;; offset sp after we're done using it as a GOAL pointer. (.add sp off) - + ;; setup process (set! (-> (-> obj process) top-thread) obj) (set! (-> (-> obj process) status) 'running) - + ;; restore reg (set! temp (-> obj rreg 0)) (.mov :color #f s0 temp) @@ -819,26 +819,26 @@ (.mov :color #f xmm14 temp-float) (set! temp-float (-> obj freg 7)) (.mov :color #f xmm15 temp-float) - + ;; hack for set-to-run-bootstrap. The set-to-run-bootstrap in MIPS ;; expects to receive 7 values from the cpu thread's rregs. ;; usually rreg holds saved registers, but on the first resume after ;; a set-to-run, they hold arguments, and set-to-run-bootstrap copies them. - + ;; We only have 5 saved regs, so we need to cheat and directly pass ;; two values in other registers ;; so we load the a4/a5 argument registers with rreg 5 and rreg 6 - ;; In the case where we are doing a normal resume, the + ;; In the case where we are doing a normal resume, the ;; compiler should assume that these registers are overwritten anyway. (set! temp (-> obj rreg 5)) (.mov a4 temp) (set! temp (-> obj rreg 6)) (.mov a5 temp) - + ;; get the resume address (set! temp (the uint (-> obj pc))) (.add temp off) - + ;; setup the process (set! obj (the cpu-thread (-> obj process))) ;; resume! @@ -871,7 +871,7 @@ ;; setup ref (set! (-> obj self) obj) (set! (-> obj ppointer) (the (pointer process) (&-> obj self))) - + (dotimes (i count) ;; create each process (let ((old-bro (-> obj child)) @@ -887,9 +887,9 @@ ) (defmethod get-process dead-pool ((obj dead-pool) (type-to-make type) (stack-size int)) - "Get a process from this dead pool of the given type." + "Get a process from this dead pool of the given type." (let ((proc (-> obj child))) - + (when (and (not proc) *debug-segment* (neq? obj *debug-dead-pool*)) ;; we failed, but we're in debug mode and not looking at the debug pool ;; try again from the debug pool and warn if this works @@ -901,9 +901,9 @@ ;; there's a bug here. proc is a process here, but will be used as a process pointer. ;; let's just kill the program here. ;; this is likely a copy-paste bug from get-process dead-pool-heap. - (break) + (break) ) - + (cond (proc ;; success! set our type and return. @@ -952,10 +952,10 @@ (set! (-> obj parent) #f) (set! (-> obj brother) #f) (set! (-> obj child) #f) - + (set! (-> obj self) obj) (set! (-> obj ppointer) (the (pointer process) (&-> obj self))) - + ;; initialize each process handle ;; build them into a linked list of null-process (countdown (i allocated-length) @@ -964,19 +964,19 @@ (set! (-> rec next) (-> obj process-list (+ i 1))) ) ) - + ;; set up the dead-list (set! (-> obj dead-list next) (-> obj process-list 0)) (set! (-> obj alive-list process) #f) ;; likely typo here, should be dead-list (set! (-> obj process-list (- allocated-length 1) next) #f) - - ;; nothing is alive + + ;; nothing is alive (set! (-> obj last) (-> obj alive-list)) (set! (-> obj alive-list next) #f) (set! (-> obj alive-list process) #f) (set! (-> obj first-gap) (-> obj alive-list)) (set! (-> obj first-shrink) #f) - + ;; setup the heap. It just begins after the process records. (set! (-> obj heap base) (the pointer (align16 (-> obj process-list allocated-length)))) (set! (-> obj heap current) (-> obj heap base)) @@ -987,7 +987,7 @@ ) (defmethod gap-location dead-pool-heap ((obj dead-pool-heap) (rec dead-pool-heap-rec)) - "Get the gap after the given process. + "Get the gap after the given process. If root of the alive list is given, will give the first gap between the heap and the first process. If there is no gap, may point to the next process. Not 16-byte aligned." (cond @@ -1054,7 +1054,7 @@ (format #t "~Talive-list: #~%" (-> obj alive-list)) (format #t "~Tlast: #~%" (-> obj last)) (format #t "~Tdead-list: #~%" (-> obj dead-list)) - + ;; here we consider the free memory to be all of the stuff after the last process. ;; we don't consider random gaps to be "free". ;; this means you can do a single allocation of free bytes and it will always succeed. @@ -1065,7 +1065,7 @@ ) (format #t "~Tprocess-list[0] @ #x~X ~D/~D bytes used~%" (-> obj process-list) (- total free) total) ) - + (let ((rec (-> obj alive-list)) (i 0) ) @@ -1081,7 +1081,7 @@ (+! i 1) ) ) - + obj) (defmethod asize-of dead-pool-heap ((obj dead-pool-heap)) @@ -1138,7 +1138,7 @@ (defmethod get-process dead-pool-heap ((obj dead-pool-heap) (type-to-make type) (stack-size int)) "Allocate a process" - + ;; get a record for the new process (let ((rec (-> obj dead-list next)) ;; will eventually hold our new process @@ -1146,48 +1146,48 @@ ;; find the rec which has a big enough gap (insert (find-gap-by-size obj (+ (the int (-> process size)) stack-size))) ) - + (cond ;; check we got both a record and a gap ((and rec insert) - + ;; pop the record off of the list (set! (-> obj dead-list next) (-> rec next)) - + ;; splice it into the alive list in the right spot (let ((next (-> insert next))) ;; after the gap rec (set! (-> insert next) rec) ;; us to the process after the gap (set! (-> rec next) next) - + ;; link the proc after us back (when next (set! (-> next prev) rec) ) ;; and us back to the proc before the gap (set! (-> rec prev) insert) - + ;; if we are inserting after the last process, we should update the last. (when (eq? insert (-> obj last)) (set! (-> obj last) rec) ) - + ;; get the gap (set! proc (the process (gap-location obj insert))) ;; and allocate! The method new does the offset for us. (set! proc ((method-of-type process new) (the symbol proc) process 'process stack-size)) - + ;; update our rec to contain this process. (set! (-> rec process) proc) ;; and the ppointer should point to the rec, not the processs, so we can track the process if it moves. (set! (-> proc ppointer) (&-> rec process)) - + ;; if we used the first gap, update first gap (when (eq? (-> obj first-gap) insert) (set! (-> obj first-gap) (find-gap obj rec)) ) - + ;; we haven't shrunk yet. If we don't have a first-shrink, or we are before it, ;; mark us as first shrink. (when (or (not (-> obj first-shrink)) @@ -1195,13 +1195,13 @@ ) (set! (-> obj first-shrink) rec) ) - + ;; update tree stuff. (set! (-> proc parent) (-> obj ppointer)) (set! (-> proc pool) obj) (set! (-> obj child) (&-> rec process)) ) - + ) (else ;; allocation failed! try again on the debug heap if we're debugging. @@ -1210,10 +1210,10 @@ (when (and proc *vis-boot*) (format 0 "WARNING: ~A ~A had to be allocated from the debug pool, because ~A was empty.~%" type-to-make proc (-> obj name))) ) - + ) ) - + (cond (proc ;; success! set type and return. @@ -1224,44 +1224,44 @@ (format 0 "WARNING: ~A ~A could not be allocated, because ~A was empty.~%" type-to-make proc (-> obj name)) ) ) - + proc) ) (defmethod return-process dead-pool-heap ((obj dead-pool-heap) (proc process)) "Return a process to a dead pool heap" - + ;; check we are returning to the correct pool (unless (eq? obj (-> proc pool)) (format 0 "ERROR: process ~A does not belong to dead-pool-heap ~A.~%" proc obj) ) - + ;; reclaim us. (change-parent proc obj) - + ;; we don't maintain a real tree for a dead-pool-heap, so undo any change to child ;; done by change-parent (set! (-> obj child) #f) - + ;; we know our ppointer is really a rec for a dead-pool-heap process, so we can use ;; this trick to quickly find our rec. (let ((rec (the dead-pool-heap-rec (-> proc ppointer)))) - + ;; if we are at or below the first gap, update first gap. (when (or (eq? (-> obj first-gap) rec) (< (the int (gap-location obj rec)) (the int (gap-location obj (-> obj first-gap)))) ) (set! (-> obj first-gap) (-> rec prev)) ) - - + + ;; update the first-shrink. We aren't smart about this and just move it backward. (when (eq? (-> obj first-shrink) rec) (set! (-> obj first-shrink) (-> rec prev)) (when (not (-> obj first-shrink process)) (set! (-> obj first-shrink) #f)) ) - + ;; remove us from list (set! (-> rec prev next) (-> rec next)) (cond @@ -1274,18 +1274,18 @@ (set! (-> obj last) (-> rec prev)) ) ) - + ;; insert at the front of the dead list. (set! (-> rec next) (-> obj dead-list next)) (set! (-> obj dead-list next) rec) (set! (-> rec process) *null-process*) - + (none) ) ) (defmethod shrink-heap dead-pool-heap ((obj dead-pool-heap) (proc process)) - "Shrink the heap of a process. + "Shrink the heap of a process. This resizes the process heap to be the exact size it is currently using." (when proc ;; get our rec. @@ -1298,16 +1298,16 @@ ;; shrink! (set! (-> proc allocated-length) (the int (&- (-> proc heap-cur) (-> proc stack)))) (set! (-> proc heap-top) (&-> (-> proc stack) (-> proc allocated-length))) - + ;; update first gap (when (< (the int proc) (the int (gap-location obj (-> obj first-gap)))) (set! (-> obj first-gap) (find-gap obj rec)) ) - + ;; mark us as shrunk (process-mask-set! (-> proc mask) heap-shrunk) ) - + ;; update first shrink (when (eq? (-> obj first-shrink) rec) (set! (-> obj first-shrink) (-> rec next)) @@ -1320,7 +1320,7 @@ (defmethod compact dead-pool-heap ((obj dead-pool-heap) (count int)) "Do heap compaction. The count argument tells us how much work to do. If the heap is very full we will automatically do more work than requested." - + ;; first we see how much memory is in use. (let ((free (memory-free obj)) (total (memory-total obj)) @@ -1345,14 +1345,14 @@ ) ) ) - + ;; update stats (set! (-> obj compact-count-targ) count) (set! (-> obj compact-count) 0) - + ;; and do compaction! (countdown (ii count) - + ;; first try to shrink a heap. (let ((shrink (-> obj first-shrink))) (when (not shrink) @@ -1364,7 +1364,7 @@ (shrink-heap obj (-> shrink process)) ) ) - + ;; now find the first gap (let ((gap (-> obj first-gap))) ;; and the thing after it @@ -1377,7 +1377,7 @@ ;; bug! (break) ) - + ;; try shrinking before relocating. (shrink-heap obj proc) ;; relocate! @@ -1391,13 +1391,13 @@ ) ) ) - + (none) ) (defmethod churn dead-pool-heap ((obj dead-pool-heap) (count int)) "Mess with the heap" - + (countdown (ii count) (let ((rec (-> obj alive-list next))) (when rec @@ -1405,14 +1405,14 @@ (< (the int (gap-location obj rec)) (the int (gap-location obj (-> obj first-gap)))) ) (set! (-> obj first-gap) (-> rec prev))) - + (when (eq? (-> obj first-shrink) rec) (set! (-> obj first-shrink) (-> rec prev)) (when (not (-> obj first-shrink process)) (set! (-> obj first-shrink) #f)) ) - + (set! (-> rec prev next) (-> rec next)) (cond ((-> rec next) @@ -1422,25 +1422,25 @@ (set! (-> obj last) (-> rec prev)) ) ) - + (let* ((insert (-> obj last)) (next (-> insert next)) ) - + (set! (-> insert next) rec) (set! (-> rec next) next) (when next (set! (-> next prev) rec)) (set! (-> rec prev) insert) - + (set! (-> obj last) rec) - (set! (-> rec process) (relocate (-> rec process) (the int (&- (gap-location obj insert) + (set! (-> rec process) (relocate (-> rec process) (the int (&- (gap-location obj insert) (the int (&- (-> rec process) *gtype-basic-offset*)))))) ) ) ) ) - + (none) ) @@ -1473,7 +1473,7 @@ (defun process-count ((this process-tree)) "Count number of processes in the given tree using iterate-process-tree" (set! *global-search-count* 0) - (iterate-process-tree this + (iterate-process-tree this (lambda ((obj process)) (+! *global-search-count* 1) #t) @@ -1561,14 +1561,14 @@ (defun execute-process-tree ((obj process-tree) (func (function object object)) (context kernel-context)) "Like iterate, but also requires that prevent-from-run's mask doesn't block, and that run-logic? is true in order to call the function." - + ;; check mask for tree, mask for prevent, run-logic?, then run! (let ((ret (or (process-mask? (-> obj mask) process-tree) (not (and (or (zero? (logand (-> context prevent-from-run) (-> obj mask)))) (run-logic? obj))) (func obj) ))) - + ;; run on our children (cond ((eq? ret 'dead) @@ -1588,7 +1588,7 @@ (defun search-process-tree ((obj process-tree) (func (function process-tree object))) "Find the first process which func return true on. Won't find process-tree's (by mask)" - + ;; reject process-tree (unless (process-mask? (-> obj mask) process-tree) ;; is this a match? @@ -1596,7 +1596,7 @@ (return-from #f obj) ) ) - + ;; not a match, check out children (let ((brother (-> obj child))) (while brother @@ -1617,12 +1617,28 @@ ;; Kernel Dispatcher ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defmacro process-name-as-string (proc) + `(let ((proc-type (-> ,proc name type))) + (cond + ((= proc-type string) + (the string (-> ,proc name)) + ) + ((= proc-type symbol) + (symbol->string (-> ,proc name)) + ) + (else + "??" + ) + ) + ) + ) + (define-extern *listener-process* process) (define-extern *active-pool* process-tree) (defun kernel-dispatcher () "Run the kernel!" - + (profiler-instant-event "ROOT") (when *listener-function* (let ((result (reset-and-call (-> *listener-process* main-thread) *listener-function*))) (if *use-old-listener-print* @@ -1633,21 +1649,22 @@ (set! *listener-function* #f) (+! *enable-method-set* -1) ) - - - (execute-process-tree - *active-pool* + + + (execute-process-tree + *active-pool* (lambda ((obj process)) ;(format 0 "Call to dispatcher lambda!~%") (let ((context *kernel-context*)) (cond ((or (eq? (-> obj status) 'waiting-to-run) (eq? (-> obj status) 'suspended)) - + (profiler-start-event (process-name-as-string obj)) + ;; we should run! ;; set current process to us (set! (-> context current-process) obj) - + ;; update pause junk for this run (cond ((process-mask? (-> obj mask) pause) @@ -1660,7 +1677,7 @@ (set! *debug-draw-pauseable* #f) ) ) - + ;; TRANS (cond ((-> obj trans-hook) @@ -1669,7 +1686,7 @@ (let ((trans (new 'process 'cpu-thread obj 'trans PROCESS_STACK_SAVE_SIZE (-> obj main-thread stack-top)))) ;; call the function in the thread. (reset-and-call trans (-> obj trans-hook)) - + (#when KERNEL_DEBUG (when (!= (-> trans type) cpu-thread) (format 0 "corrupted stack after trans for ~A~%" obj) @@ -1680,12 +1697,13 @@ ;; check for deadness (when (eq? (-> obj status) 'dead) (set! (-> context current-process) #f) + (profiler-end-event) (return 'dead) ) ) ) ) - + ;; MAIN CODE (if (process-mask? (-> obj mask) sleep-code) ;; we're sleeping. Move us to suspended, in case we were in waiting to run. @@ -1693,13 +1711,14 @@ ;; not sleeping. call resume hook ((-> obj main-thread resume-hook) (-> obj main-thread)) - + ) ;; check for deadness (cond ((eq? (-> obj status) 'dead) ;; oops we died. return 'dead (set! (-> context current-process) #f) + (profiler-end-event) 'dead ) (else @@ -1713,6 +1732,7 @@ (when (eq? (-> obj status) 'dead) ;; oops we died. (set! (-> context current-process) #f) + (profiler-end-event) (return 'dead) ) (set! (-> obj status) 'suspended) @@ -1720,11 +1740,13 @@ ) ) (set! (-> context current-process) #f) + (profiler-end-event) #f ) ) + ) - + ((eq? (-> obj status) 'dead) 'dead) ) @@ -1738,7 +1760,7 @@ (defun inspect-process-tree ((obj process-tree) (level int) (mask int) (detail symbol)) "Debug print a pocess-tree" (print-tree-bitmask mask (+ 0 level)) - + ;; print us (cond (detail @@ -1754,7 +1776,7 @@ (format #t "~S~A~%" (if (zero? level) "" "+---") obj) ) ) - + ;; print our children (let ((child (-> obj child))) (while child @@ -1795,7 +1817,7 @@ (declare (asm-func object) (allow-saved-regs) ;; very dangerous! ) - + (rlet ((pp :reg r13 :type process) (temp :reg rax :type uint) (off :reg r15 :type uint) @@ -1814,8 +1836,8 @@ (xmm13 :reg xmm13 :class fpr) (xmm14 :reg xmm14 :class fpr) (xmm15 :reg xmm15 :class fpr) - ) - + ) + ;; we treat the allocation as an address. (let ((obj (the catch-frame (&+ allocation *gtype-basic-offset*)))) ;; setup catch frame @@ -1828,13 +1850,13 @@ (.sub temp off) ;; store it (set! (-> obj ra) (the int temp)) - + ;; todo, do we need a stack offset here? ;; remember the stack pointer (set! temp sp) (.sub temp off) (set! (-> obj sp) (the int temp)) - + ;; back up registers we care about (.mov :color #f temp s0) (set-u128-as-u64! (-> obj rreg 0) temp) @@ -1863,18 +1885,18 @@ (set! (-> obj freg 6) (the-as float temp)) (.mov :color #f temp xmm15) (set! (-> obj freg 7) (the-as float temp)) - + ;; push this stack frame (set! (-> obj next) (-> pp stack-frame-top)) (set! (-> pp stack-frame-top) obj) - + ;; help coloring, it isn't smart enough to realize it's "safe" to use these registers. (.push :color #f s3) (.push :color #f s2) (.push :color #f s2) (set! s3 (the uint func)) (set! s2 param-block) - + ;; todo - are we aligned correctly here? (let ((ret ((the-super-u64-fucntion s3) (-> s2 0) @@ -1901,7 +1923,7 @@ "Throw the given value to the catch frame. Only can throw a 64-bit value. The original could throw 128 bits." (declare (asm-func none)) - + (rlet ((pp :reg r13 :type process) (temp :reg rax :type uint) (off :reg r15 :type uint) @@ -1922,10 +1944,10 @@ (xmm14 :reg xmm14 :class fpr) (xmm15 :reg xmm15 :class fpr) ) - + ;; pop everything we threw past (set! (-> pp stack-frame-top) (-> obj next)) - + ;; restore regs we care about. (set-u64-from-u128! temp (-> obj rreg 0)) (.mov :color #f s0 temp) @@ -1954,17 +1976,17 @@ (.mov :color #f xmm14 temp-float) (set! temp-float (-> obj freg 7)) (.mov :color #f xmm15 temp-float) - + ;; set stack pointer (set! sp (the uint (-> obj sp))) (.add sp off) - + ;; overwrite our return address (.pop temp) (set! temp (the uint (-> obj ra))) (.add temp off) (.push temp) - + ;; load the return register (.mov temp value) (.ret) @@ -1978,10 +2000,10 @@ (while cur (when (and (eq? (-> cur name) name) (eq? (-> cur type) catch-frame)) ;; match! - + (throw-dispatch (the catch-frame cur) value) ) - + (if (eq? (-> cur type) protect-frame) ;; call the cleanup function ((-> (the protect-frame cur) exit)) @@ -1999,7 +2021,7 @@ (set! (-> obj type) type-to-make) (set! (-> obj name) 'protect-frame) (set! (-> obj exit) func) - + (rlet ((pp :reg r13 :type process)) (set! (-> obj next) (-> pp stack-frame-top)) (set! (-> pp stack-frame-top) obj) @@ -2040,7 +2062,7 @@ "Make obj a child of new-parent" (let ((parent (-> obj parent))) ;; parent is a ppointer. - + ;; need to remove obj from its current parent (when parent (let ((proc (-> (-> parent) child))) @@ -2058,7 +2080,7 @@ ) ) ) - + ;; add to new parent (set! (-> obj parent) (-> new-parent ppointer)) (set! (-> obj brother) (-> new-parent child)) @@ -2187,7 +2209,7 @@ (set! stack-top (&+ *fake-scratchpad-stack* (* 32 1024))) ) ) - + (set! (-> obj mask) (logand (-> dest mask) PROCESS_CLEAR_MASK)) (set! (-> obj status) 'ready) (let ((pid (-> *kernel-context* next-pid))) @@ -2199,7 +2221,7 @@ (set! (-> obj heap-base) (set! (-> obj heap-cur) (&+ (-> obj stack) (-> obj type heap-base)))) (set! (-> obj stack-frame-top) #f) (mem-set32! (-> obj stack) (the int (/ (-> obj type heap-base) 4)) 0) - + (set! (-> obj trans-hook) #f) (set! (-> obj post-hook) #f) (set! (-> obj event-hook) #f) @@ -2209,10 +2231,10 @@ (set! (-> obj entity) #f) (set! (-> obj entity) (-> (the process dest) entity)) ) - + (set! (-> obj connection-list next1) #f) (set! (-> obj connection-list prev1) #f) - + (let ((thread (new 'process 'cpu-thread obj 'code PROCESS_STACK_SAVE_SIZE stack-top))) (set! (-> obj main-thread) thread) ) @@ -2226,18 +2248,18 @@ this function will return. The idea is that you use this when you want to initialize a process NOW. This will then return the value of the function you called!" (rlet ((pp :reg r13 :type process)) - + (let ((param-array (new 'stack-no-clear 'array 'uint64 6)) ) ;; copy params to the stack. - + (set! (-> param-array 0) (the uint64 a0)) (set! (-> param-array 1) (the uint64 a1)) (set! (-> param-array 2) (the uint64 a2)) (set! (-> param-array 3) (the uint64 a3)) (set! (-> param-array 4) (the uint64 a4)) (set! (-> param-array 5) (the uint64 a5)) - + (let* ((old-pp pp) (func-val (begin ;; set the process @@ -2286,14 +2308,14 @@ (declare (asm-func none) ;;(print-asm) ) - + (rlet ((s0 :reg rbx :type uint) (s1 :reg rbp :type uint) (s2 :reg r10 :type uint) (s3 :reg r11 :type uint) (s4 :reg r12 :type uint) (a0 :reg rdi :type uint) ; ok - (a1 :reg rsi :type uint) ; ok + (a1 :reg rsi :type uint) ; ok (a2 :reg rdx :type uint) ; ok (a3 :reg rcx :type uint) ; ok (off :reg r15 :type uint) @@ -2302,25 +2324,25 @@ (temp :reg rax) ) - + (.mov temp return-from-thread-dead) (.add temp off) (.push temp) - + ;; stack is 16 + 8 aligned now - + (.mov :color #f a0 s1) (.mov :color #f a1 s2) (.mov :color #f a2 s3) (.mov :color #f a3 s4) - + (.add :color #f s0 off) (.jr :color #f s0) (.add a4 a4) (.add a5 a5) ) - + ) @@ -2330,7 +2352,7 @@ Once the function returns, the process deactivates." (let ((proc (-> thread process))) (set! (-> proc status) 'waiting-to-run) - + ;; we store arguments and the function to call in saved registers (set! (-> thread rreg 0) (the uint func)) (set! (-> thread rreg 1) (the uint a0)) @@ -2339,9 +2361,9 @@ (set! (-> thread rreg 4) (the uint a3)) (set! (-> thread rreg 5) (the uint a4)) (set! (-> thread rreg 6) (the uint a5)) - + ;; and have the thread first call set-to-run-bootstrap, which will properly call - ;; the function with the arguments and install a return trampoline for + ;; the function with the arguments and install a return trampoline for ;; deactivating and returning to the kernel on return. (set! (-> thread pc) (the pointer set-to-run-bootstrap)) ;; reset sp. @@ -2358,7 +2380,7 @@ ) ;; The defstate macro isn't defined yet, so we do it manually. -(define dead-state +(define dead-state (the (state process) (new 'static 'state :name #f :next #f @@ -2387,16 +2409,16 @@ All protects/states will be cleaned up, with pp set correctly for the process. But you might not have the stack of your main thread, so don't reference stack vars from within your exit handlers." - + ;; don't do anything if we already died. (unless (eq? (-> obj status) 'dead) (set! (-> obj next-state) dead-state) - + ;; call entity handler (when (-> obj entity) (entity-deactivate-handler obj (-> obj entity)) ) - + ;; clean up stack frames the process is in. ;; first, set pp so the cleanup code thinks its running in the right process. (rlet ((pp :reg r13 :type process)) @@ -2404,7 +2426,7 @@ (set! pp obj) (let ((cur (-> pp stack-frame-top))) (while cur - (case (-> cur type) + (case (-> cur type) ((protect-frame state) ;; we're a state or protect-frame, we can exit. ((-> (the-as protect-frame cur) exit)) @@ -2416,12 +2438,12 @@ (set! pp old-pp) ) ) - + ;; hack - if this isn't defined yet, don't try it. (if (!= 0 (the uint process-disconnect)) (process-disconnect obj) ) - + ;; kill our child and their brothers (let ((bro (-> obj child))) (while bro @@ -2431,14 +2453,14 @@ ) ) ) - + ;; return ourself to the pool (return-process (-> obj pool) obj) (set! (-> obj state) #f) (set! (-> obj next-state) #f) (set! (-> obj entity) #f) (set! (-> obj pid) 0) - + ;; deal with getting out of here. (cond ;; first case - we deactivated the running process @@ -2459,7 +2481,7 @@ ;; second case - we deactivated while initializing. ((eq? (-> obj status) 'initialize) ;; added this - + ; (if (!= pp obj) ; (format 0 "ERROR: deactivated a non-current initializing process!") ; (break) diff --git a/goal_src/pc/pckernel.gc b/goal_src/pc/pckernel.gc index 3bddc81056..16b6fa19d1 100644 --- a/goal_src/pc/pckernel.gc +++ b/goal_src/pc/pckernel.gc @@ -171,7 +171,7 @@ (set! (-> info status) "Playing Jak and Daxter: The Precursor Legacy™") (set! (-> info level) (symbol->string (-> (level-get-target-inside *level*) name))) ;; grab the name of level we're in (set! (-> info cutscene?) (-> obj movie?)) - (pc-discord-rpc-update info) + (with-profiler "discord-update" (pc-discord-rpc-update info)) ) (when (not (-> obj use-vis?))