diff --git a/include/xo/procedure2/GcPrimitives.hpp b/include/xo/procedure2/GcPrimitives.hpp index 9b64eca..b52b12c 100644 --- a/include/xo/procedure2/GcPrimitives.hpp +++ b/include/xo/procedure2/GcPrimitives.hpp @@ -27,6 +27,10 @@ namespace xo { static DPrimitive_gco_0 * make_report_gc_object_types_pm(obj mm, StringTable * stbl); + /** create primitive: report gc object-age statistics **/ + static DPrimitive_gco_0 * make_report_gc_object_ages_pm(obj mm, + StringTable * stbl); + /** create primitive: report gc location of a value **/ static DPrimitive_gco_1_gco * make_gc_location_of_pm(obj mm, StringTable * stbl); diff --git a/src/procedure2/GcPrimitives.cpp b/src/procedure2/GcPrimitives.cpp index f693bd0..261a8c6 100644 --- a/src/procedure2/GcPrimitives.cpp +++ b/src/procedure2/GcPrimitives.cpp @@ -78,6 +78,34 @@ namespace xo { } + // ----- report-gc-object-ages ----- + + obj + xfer_report_gc_object_ages(obj rcx) + { + if (rcx.collector()) { + obj stats; + bool ok = rcx.collector().report_object_ages(rcx.allocator(), rcx.error_allocator(), &stats); + + if (ok && stats) + return stats; + } + + return DBoolean::box(rcx.allocator(), false); + } + + DPrimitive_gco_0 * + GcPrimitives::make_report_gc_object_ages_pm(obj mm, + StringTable * stbl) + { + (void)stbl; + + auto any_ty = DAtomicType::make(mm, Metatype::t_any()); + auto pm_ty = obj(DFunctionType::_make(mm, any_ty)); + + return DPrimitive_gco_0::_make(mm, "report-gc-object-ages", pm_ty, &xfer_report_gc_object_ages); + } + // ----- gc-location-of ----- obj diff --git a/src/procedure2/SetupProcedure2.cpp b/src/procedure2/SetupProcedure2.cpp index 44d9b3e..3ab0b52 100644 --- a/src/procedure2/SetupProcedure2.cpp +++ b/src/procedure2/SetupProcedure2.cpp @@ -142,6 +142,11 @@ namespace xo { GcPrimitives::make_report_gc_object_types_pm(mm, stbl), flags & InstallFlags::f_generalpurpose)); + ok = ok & (PrimitiveRegistry::install_aux + (sink, + GcPrimitives::make_report_gc_object_ages_pm(mm, stbl), + flags & InstallFlags::f_generalpurpose)); + ok = ok & (PrimitiveRegistry::install_aux (sink, GcPrimitives::make_gc_location_of_pm(mm, stbl),