custom-ports.c 6.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206
  1. /* Copyright 2023
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. #ifdef HAVE_CONFIG_H
  16. #include <config.h>
  17. #endif
  18. #include "boolean.h"
  19. #include "eval.h"
  20. #include "extensions.h"
  21. #include "gsubr.h"
  22. #include "modules.h"
  23. #include "numbers.h"
  24. #include "ports-internal.h"
  25. #include "syscalls.h"
  26. #include "values.h"
  27. #include "variable.h"
  28. #include "version.h"
  29. #include "custom-ports.h"
  30. #define FOR_EACH_METHOD_EXCEPT_READ_WRITE(M) \
  31. M(print, "print") \
  32. M(read_wait_fd, "read-wait-fd") \
  33. M(write_wait_fd, "write-wait-fd") \
  34. M(seek, "seek") \
  35. M(close, "close") \
  36. M(get_natural_buffer_sizes, "get-natural-buffer-sizes") \
  37. M(random_access_p, "random-access?") \
  38. M(input_waiting, "input-waiting?") \
  39. M(truncate, "truncate")
  40. #define FOR_EACH_METHOD(M) \
  41. FOR_EACH_METHOD_EXCEPT_READ_WRITE(M) \
  42. M(read, "read") \
  43. M(write, "write")
  44. #define DEF_VAR(c_name, scm_name) static SCM c_name##_var;
  45. FOR_EACH_METHOD (DEF_VAR)
  46. #undef DEF_VAR
  47. static int custom_port_print (SCM exp, SCM port,
  48. scm_print_state * pstate)
  49. {
  50. SCM data = SCM_PACK (SCM_STREAM (exp));
  51. scm_call_3 (scm_variable_ref (print_var), exp, data, port);
  52. return 1;
  53. }
  54. static int
  55. custom_port_read_wait_fd (SCM port)
  56. {
  57. SCM data = SCM_PACK (SCM_STREAM (port));
  58. SCM res = scm_call_2 (scm_variable_ref (read_wait_fd_var), port, data);
  59. return scm_is_false (res) ? -1 : scm_to_signed_integer (res, 0, INT_MAX);
  60. }
  61. static int
  62. custom_port_write_wait_fd (SCM port)
  63. {
  64. SCM data = SCM_PACK (SCM_STREAM (port));
  65. SCM res = scm_call_2 (scm_variable_ref (write_wait_fd_var), port, data);
  66. return scm_is_false (res) ? -1 : scm_to_signed_integer (res, 0, INT_MAX);
  67. }
  68. static scm_t_off
  69. custom_port_seek (SCM port, scm_t_off offset, int whence)
  70. {
  71. SCM data = SCM_PACK (SCM_STREAM (port));
  72. return scm_to_off_t (scm_call_4 (scm_variable_ref (seek_var), port, data,
  73. scm_from_off_t (offset),
  74. scm_from_int (whence)));
  75. }
  76. static void
  77. custom_port_close (SCM port)
  78. {
  79. SCM data = SCM_PACK (SCM_STREAM (port));
  80. scm_call_2 (scm_variable_ref (close_var), port, data);
  81. }
  82. static void
  83. custom_port_get_natural_buffer_sizes (SCM port, size_t *read_size,
  84. size_t *write_size)
  85. {
  86. SCM data = SCM_PACK (SCM_STREAM (port));
  87. SCM res = scm_call_4 (scm_variable_ref (get_natural_buffer_sizes_var),
  88. port, data, scm_from_size_t (*read_size),
  89. scm_from_size_t (*write_size));
  90. *read_size = scm_to_size_t (scm_c_value_ref (res, 0));
  91. *write_size = scm_to_size_t (scm_c_value_ref (res, 1));
  92. }
  93. static int
  94. custom_port_random_access_p (SCM port)
  95. {
  96. SCM data = SCM_PACK (SCM_STREAM (port));
  97. return scm_to_bool (scm_call_2 (scm_variable_ref (random_access_p_var),
  98. port, data));
  99. }
  100. static int
  101. custom_port_input_waiting (SCM port)
  102. {
  103. SCM data = SCM_PACK (SCM_STREAM (port));
  104. return scm_to_bool (scm_call_2 (scm_variable_ref (input_waiting_var),
  105. port, data));
  106. }
  107. static void
  108. custom_port_truncate (SCM port, scm_t_off length)
  109. {
  110. SCM data = SCM_PACK (SCM_STREAM (port));
  111. scm_call_3 (scm_variable_ref (truncate_var), port, data,
  112. scm_from_off_t (length));
  113. }
  114. static scm_t_port_type *custom_port_type;
  115. static scm_t_port_type *custom_port_type_with_close_on_gc;
  116. SCM_DEFINE_STATIC (make_custom_port, "%make-custom-port", 6, 0, 0,
  117. (SCM input_p, SCM output_p, SCM stream, SCM encoding,
  118. SCM conversion_strategy, SCM close_on_gc_p), "")
  119. {
  120. long mode_bits = 0;
  121. if (scm_is_true (input_p))
  122. mode_bits |= SCM_RDNG;
  123. if (scm_is_true (output_p))
  124. mode_bits |= SCM_WRTNG;
  125. scm_t_port_type *pt = scm_is_true (close_on_gc_p) ?
  126. custom_port_type_with_close_on_gc : custom_port_type;
  127. return scm_c_make_port_with_encoding (pt, mode_bits, encoding,
  128. conversion_strategy,
  129. SCM_UNPACK (stream));
  130. }
  131. SCM_DEFINE_STATIC (custom_port_data, "%custom-port-data", 1, 0, 0,
  132. (SCM port), "")
  133. #define FUNC_NAME s_custom_port_data
  134. {
  135. SCM_ASSERT (SCM_PORT_TYPE (port) == custom_port_type
  136. || SCM_PORT_TYPE (port) == custom_port_type_with_close_on_gc,
  137. port, SCM_ARG1, "custom port");
  138. return SCM_PACK (SCM_STREAM (port));
  139. }
  140. #undef FUNC_NAME
  141. static void
  142. scm_init_custom_ports (void)
  143. {
  144. #define RESOLVE_VAR(c_name, scm_name) \
  145. c_name##_var = scm_c_lookup ("custom-port-" scm_name);
  146. FOR_EACH_METHOD (RESOLVE_VAR);
  147. #undef RESOlVE_VAR
  148. custom_port_type = scm_make_port_type ("custom-port", NULL, NULL);
  149. custom_port_type_with_close_on_gc =
  150. scm_make_port_type ("custom-port", NULL, NULL);
  151. #define INIT_PORT_TYPE(c_name, scm_name) \
  152. scm_set_port_##c_name (custom_port_type, custom_port_##c_name); \
  153. scm_set_port_##c_name (custom_port_type_with_close_on_gc, \
  154. custom_port_##c_name);
  155. FOR_EACH_METHOD_EXCEPT_READ_WRITE (INIT_PORT_TYPE);
  156. #undef INIT_PORT_TYPE
  157. scm_set_port_scm_read (custom_port_type, scm_variable_ref (read_var));
  158. scm_set_port_scm_write (custom_port_type, scm_variable_ref (write_var));
  159. scm_set_port_scm_read (custom_port_type_with_close_on_gc,
  160. scm_variable_ref (read_var));
  161. scm_set_port_scm_write (custom_port_type_with_close_on_gc,
  162. scm_variable_ref (write_var));
  163. scm_set_port_needs_close_on_gc (custom_port_type_with_close_on_gc, 1);
  164. #include "custom-ports.x"
  165. }
  166. void
  167. scm_register_custom_ports (void)
  168. {
  169. scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
  170. "scm_init_custom_ports",
  171. (scm_t_extension_init_func) scm_init_custom_ports,
  172. NULL);
  173. }