[CM] Port output function receives string 1 char at a time

vladimir florentino optimusvlad at gmail.com
Sat Nov 19 15:36:17 PST 2022

Please find attached a patch to have the output function callback
receive the entire string in one call, as opposed to receiving the
string 1 character at a time.

I wrote this code myself. I hereby release it into the public domain.

Vlad F

On Sat, Nov 19, 2022 at 5:27 PM vladimir florentino
<optimusvlad at gmail.com> wrote:
> Please, allow me to submit a patch for this.
> The patch doesn't have to be used but, at least, could serve as a
> reference point. Might save you a few minutes of work.
> I'll be sending it over in a few.
> On Sat, Nov 19, 2022 at 5:21 PM <bil at ccrma.stanford.edu> wrote:
> >
> > That was the way Rick Taube wanted it back around 2010 (he
> > was writing Grace, a GUI version of his CommonMusic).  I
> > can probably add a string output choice -- will look at it
> > later.
> >
-------------- next part --------------
From 5c65ddf35b838f6a208966d5aae17a35e54473b3 Mon Sep 17 00:00:00 2001
From: vlad <optimusvlad at gmail.com>
Date: Sat, 19 Nov 2022 18:27:45 -0500
Subject: [PATCH] Changes to support receiving the entire string in S7 output
 and err-output callbacks.

 Source/ThirdParty/scheme/s7.cpp | 35 +++++++++++++++++++++++++++++++++
 Source/ThirdParty/scheme/s7.h   |  6 ++++++
 2 files changed, 41 insertions(+)

diff --git a/Source/ThirdParty/scheme/s7.cpp b/Source/ThirdParty/scheme/s7.cpp
index a74de88b..4ef5896a 100644
--- a/Source/ThirdParty/scheme/s7.cpp
+++ b/Source/ThirdParty/scheme/s7.cpp
@@ -577,7 +577,12 @@ typedef struct {
   s7_pointer orig_str;    /* GC protection for string port string */
   const port_functions_t *pf;
   s7_pointer (*input_function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port);
+  void (*output_function)(s7_scheme *sc, const char* str, s7_int len, s7_pointer port);
   void (*output_function)(s7_scheme *sc, uint8_t c, s7_pointer port);
 } port_t;
 typedef enum {o_d_v, o_d_vd, o_d_vdd, o_d_vid, o_d_id, o_d_7pi, o_d_7pii, o_d_7piid, o_d_7piii, o_d_7piiid,
@@ -28526,7 +28531,14 @@ static void stderr_write_char(s7_scheme *sc, uint8_t c, s7_pointer port) {fputc(
 static void function_write_char(s7_scheme *sc, uint8_t c, s7_pointer port)
   push_stack_no_let_no_code(sc, OP_NO_VALUES, sc->nil);
+  char buf[2];
+  buf[0] = c;
+  buf[1] = '\0';
+  (*(port_output_function(port)))(sc, buf, 1, port);
   (*(port_output_function(port)))(sc, c, port);
   unstack_with(sc, OP_NO_VALUES);
@@ -28668,14 +28680,24 @@ static void file_display(s7_scheme *sc, const char *s, s7_pointer port)
 static void function_display(s7_scheme *sc, const char *s, s7_pointer port)
   if (s)
+  {
+	  (*(port_output_function(port)))(sc, s, strlen(s), port);
+	#else
     for (; *s; s++)
       (*(port_output_function(port)))(sc, *s, port);
+	#endif
+  }
 static void function_write_string(s7_scheme *sc, const char *str, s7_int len, s7_pointer pt)
+	(*(port_output_function(pt)))(sc, str, len, pt);
   for (s7_int i = 0; i < len; i++)
     (*(port_output_function(pt)))(sc, str[i], pt);
 static void stdout_display(s7_scheme *sc, const char *s, s7_pointer port) {if (s) fputs(s, stdout);}
@@ -29628,7 +29650,11 @@ static void close_output_function(s7_scheme *sc, s7_pointer p)
 static const port_functions_t output_function_functions =
   {output_read_char, function_write_char, function_write_string, NULL, NULL, NULL, NULL, output_read_line, function_display, close_output_function};
+s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, const char* str, s7_int len, s7_pointer port))
 s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, uint8_t c, s7_pointer port))
   s7_pointer x;
   block_t *b = mallocate_port(sc);
@@ -29643,10 +29669,19 @@ s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc
+static void output_scheme_function_wrapper(s7_scheme* sc, const char* str, s7_int len, s7_pointer port)
+  for (s7_int i = 0; i < len; i++)
+    s7_apply_function(sc, port_string_or_function(port), set_plist_1(sc, make_integer(sc, str[i])));
 static void output_scheme_function_wrapper(s7_scheme *sc, uint8_t c, s7_pointer port)
   s7_apply_function(sc, port_string_or_function(port), set_plist_1(sc, make_integer(sc, c)));
 static s7_pointer g_open_output_function(s7_scheme *sc, s7_pointer args)
diff --git a/Source/ThirdParty/scheme/s7.h b/Source/ThirdParty/scheme/s7.h
index 7cd4c826..2cb7b249 100644
--- a/Source/ThirdParty/scheme/s7.h
+++ b/Source/ThirdParty/scheme/s7.h
@@ -400,7 +400,13 @@ S7_EXPORT s7_pointer s7_output_string(s7_scheme *sc, s7_pointer p);
 S7_EXPORT bool s7_flush_output_port(s7_scheme *sc, s7_pointer p);                     /* (flush-output-port port) */
+S7_EXPORT s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, const char* str, s7_int len, s7_pointer port));
 S7_EXPORT s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, uint8_t c, s7_pointer port));
 S7_EXPORT s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port));
 S7_EXPORT s7_pointer s7_read_char(s7_scheme *sc, s7_pointer port);                    /* (read-char port) */

More information about the Cmdist mailing list