From 690845fa1e9332ca11b8a431de23189d903f58bc Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Wed, 11 Jun 2025 16:12:35 +0200
Subject: [PATCH] Convert tc16_catch_handler to be subrs

* libguile/throw.c (call_catch_handler): Rework to expect closure to be
program.
(scm_i_make_catch_handler): Rework to make closures.
(scm_init_throw): Rework to allocate trampoline code.
---
 libguile/throw.c | 39 ++++++++++++++++++++++++---------------
 1 file changed, 24 insertions(+), 15 deletions(-)

diff --git a/libguile/throw.c b/libguile/throw.c
index e837abe89..28ea04c1b 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2009-2014,2017-2019
+/* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2009-2014,2017-2019,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -34,7 +34,8 @@
 #include "eval.h"
 #include "exceptions.h"
 #include "fluids.h"
-#include "gsubr.h"
+#include "foreign.h"
+#include "gsubr-internal.h"
 #include "init.h"
 #include "list.h"
 #include "modules.h"
@@ -42,7 +43,7 @@
 #include "pairs.h"
 #include "ports.h"
 #include "private-options.h"
-#include "smob.h"
+#include "programs.h"
 #include "stackchk.h"
 #include "stacks.h"
 #include "strings.h"
@@ -268,20 +269,27 @@ scm_throw (SCM key, SCM args)
 
 /* Now some support for C bodies and catch handlers */
 
-static scm_t_bits tc16_catch_handler;
+static const uint32_t *call_catch_handler_code;
+
+static SCM
+call_catch_handler (SCM clo, SCM key, SCM args)
+{
+  struct scm_program *p = scm_to_program (clo);
+  scm_t_catch_handler handler =
+    scm_to_pointer (scm_program_free_variable_ref (p, 0));
+  void *data = scm_to_pointer (scm_program_free_variable_ref (p, 1));
+  return handler (data, key, args);
+}
 
 SCM
 scm_i_make_catch_handler (scm_t_catch_handler handler, void *data)
 {
-  SCM_RETURN_NEWSMOB2 (tc16_catch_handler, handler, data);
-}
-
-static SCM
-apply_catch_handler (SCM clo, SCM args)
-{
-  scm_t_catch_handler handler = (void*)SCM_SMOB_DATA (clo);
-  void *data = (void*)SCM_SMOB_DATA_2 (clo);
-  return handler (data, scm_car (args), scm_cdr (args));
+  struct scm_program *ret =
+    scm_make_subr_from_code (SCM_I_CURRENT_THREAD, call_catch_handler_code,
+                             SCM_F_PROGRAM_IS_PRIMITIVE, 2);
+  scm_program_free_variable_set_x (ret, 0, scm_from_pointer (handler, NULL));
+  scm_program_free_variable_set_x (ret, 1, scm_from_pointer (data, NULL));
+  return scm_from_program (ret);
 }
 
 
@@ -460,8 +468,9 @@ scm_ithrow (SCM key, SCM args, int no_return SCM_UNUSED)
 void
 scm_init_throw ()
 {
-  tc16_catch_handler = scm_make_smob_type ("catch-handler", 0);
-  scm_set_smob_apply (tc16_catch_handler, apply_catch_handler, 0, 0, 1);
+  call_catch_handler_code =
+    scm_allocate_subr_code (scm_from_utf8_symbol ("exception-handler"), 1, 0, 1,
+                            call_catch_handler, SCM_F_SUBR_CLOSURE);
 
   throw_var = scm_c_define ("throw", SCM_BOOL_F);