1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
/* classes: h_files */
#ifndef PRINTH
#define PRINTH
/* Copyright (C) 1995,1996,1998 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include "libguile/__scm.h"
#include "libguile/options.h"
extern scm_option scm_print_opts[];
#define SCM_PRINT_CLOSURE ((SCM) scm_print_opts[0].val)
#define SCM_PRINT_SOURCE_P ((int) scm_print_opts[1].val)
#define SCM_N_PRINT_OPTIONS 2
/* State information passed around during printing.
*/
#define SCM_PRINT_STATE_P(obj) (SCM_STRUCTP(obj) \
&& (SCM_STRUCT_VTABLE(obj) \
== scm_print_state_vtable))
#define SCM_PRINT_STATE(obj) ((scm_print_state *) SCM_STRUCT_DATA (obj))
#define RESET_PRINT_STATE(pstate) \
do { \
pstate->list_offset = 0; \
pstate->top = 0; \
} while (0)
#define SCM_WRITINGP(pstate) ((pstate)->writingp)
#define SCM_SET_WRITINGP(pstate, x) { (pstate)->writingp = (x); }
#define SCM_PORT_WITH_PS_P(p) (SCM_NIMP(p) && (SCM_TYP16 (p) == scm_tc16_port_with_ps))
#define SCM_PORT_WITH_PS_PORT(p) SCM_CADR (p)
#define SCM_PORT_WITH_PS_PS(p) SCM_CDDR (p)
#define SCM_COERCE_OUTPORT(p) (SCM_NIMP (p) && SCM_PORT_WITH_PS_P (p) \
? SCM_PORT_WITH_PS_PORT (p) \
: p)
#define SCM_PRINT_STATE_LAYOUT "sruwuwuwuwuwpwuwuwuruopr"
typedef struct scm_print_state {
SCM handle; /* Struct handle */
int revealed; /* Has the state escaped to Scheme? */
unsigned long writingp; /* Writing? */
unsigned long fancyp; /* Fancy printing? */
unsigned long level; /* Max level */
unsigned long length; /* Max number of objects per level */
SCM hot_ref; /* Hot reference */
unsigned long list_offset;
unsigned long top; /* Top of reference stack */
unsigned long ceiling; /* Max size of reference stack */
SCM *ref_stack; /* Stack of references used during
circular reference detection */
SCM ref_vect;
} scm_print_state;
extern SCM scm_print_state_vtable;
// ? scm or long? print.h and print.c disagree
extern long scm_tc16_port_with_ps;
extern SCM scm_print_options (SCM setting);
SCM scm_make_print_state (void);
void scm_free_print_state (SCM print_state);
extern void scm_intprint (long n, int radix, SCM port);
extern void scm_ipruk (char *hdr, SCM ptr, SCM port);
extern void scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate);
extern void scm_prin1 (SCM exp, SCM port, int writingp);
extern void scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate);
extern SCM scm_write (SCM obj, SCM port);
extern SCM scm_display (SCM obj, SCM port);
extern SCM scm_simple_format (SCM port, SCM message, SCM args);
extern SCM scm_newline (SCM port);
extern SCM scm_write_char (SCM chr, SCM port);
extern SCM scm_printer_apply (SCM proc, SCM exp, SCM port,
scm_print_state *);
extern SCM scm_port_with_print_state (SCM port, SCM pstate);
extern SCM scm_get_print_state (SCM port);
extern int scm_valid_oport_value_p (SCM val);
extern void scm_init_print (void);
#ifdef GUILE_DEBUG
extern SCM scm_current_pstate (void);
#endif
#endif /* PRINTH */
|
