+scm_bits_t scm_tc16_port_with_ps;
+
+/* Print exactly as the port itself would */
+
+static int
+port_with_ps_print (SCM obj, SCM port, scm_print_state *pstate)
+{
+ obj = SCM_PORT_WITH_PS_PORT (obj);
+ return scm_ptobs[SCM_PTOBNUM (obj)].print (obj, port, pstate);
+}
+
+SCM
+scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *pstate)
+{
+ SCM pwps;
+ SCM pair = scm_cons (port, pstate->handle);
+ SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (pair));
+ pstate->revealed = 1;
+ return scm_apply (proc, exp, scm_cons (pwps, scm_listofnull));
+}
+
+SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 2, 0, 0,
+ (SCM port, SCM pstate),
+ "Create a new port which behaves like @var{port}, but with an\n"
+ "included print state @var{pstate}.")
+#define FUNC_NAME s_scm_port_with_print_state
+{
+ SCM pwps;
+ SCM_VALIDATE_OPORT_VALUE (1,port);
+ SCM_VALIDATE_PRINTSTATE (2,pstate);
+ port = SCM_COERCE_OUTPORT (port);
+ SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (scm_cons (port, pstate)));
+ return pwps;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_print_state, "get-print-state", 1, 0, 0,
+ (SCM port),
+ "Return the print state of the port @var{port}. If @var{port}\n"
+ "has no associated print state, @code{#f} is returned.")
+#define FUNC_NAME s_scm_get_print_state
+{
+ if (SCM_PORT_WITH_PS_P (port))
+ return SCM_PORT_WITH_PS_PS (port);
+ if (SCM_OUTPUT_PORT_P (port))
+ return SCM_BOOL_F;
+ SCM_WRONG_TYPE_ARG (1, port);
+}
+#undef FUNC_NAME