mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-30 00:40:20 +02:00
1997-10-03 Mikael Djurfeldt <mdj@nada.kth.se>
* print.h (SCM_PRINT_STATE_P): Removed SCM_NIMP test. (NIMP macros should by convention not test for NIMPness.) (SCM_COERCE_OPORT): Adjust indentation. * print.c (scm_valid_oport_value_p): Adjusted indentation; Added SCM_NIMP test before SCM_PRINT_STATE_P. * struct.c, struct.h, gc.c: Renamed: scm_struct_i_layout --> scm_vtable_index_layout scm_struct_i_vcell --> scm_vtable_index_vcell scm_struct_i_vtable --> scm_vtable_index_vtable scm_struct_i_printer --> scm_vtable_index_printer scm_struct_i_vtable_offset --> scm_vtable_offset_user * struct.c (scm_print_struct): Use new printer slot; Default printing: Also output hex code of vtable so that type identity will be indicated as well. (scm_init_struct): Updated required_vtable_fields to "pruosrpw"; Removed struct_printer_var; Removed struct-vtable-offset; (vtable-index-layout, vtable-index-vtable, vtable-index-printer, vtable-offset-user): New constants. * struct.h (scm_struct_i_vtable_offset): Bumped from 3 to 4. (scm_struct_i_printer, SCM_STRUCT_PRINTER): New slot in vtables. If this slot contains a procedure, use that to print structures of the type represented by this vtable. * print.c (scm_iprin1): Don't print arguments of macro transformers. (They are always: exp env.); Bugfix: Unmemoize transformer source with correct environment.
This commit is contained in:
Mikael Djurfeldt
parent
f44dd64b76
commit
4bfdf1584d
6 changed files with 99 additions and 36 deletions
|
|
@ -1,4 +1,31 @@
|
|||
Thu Oct 2 19:33:38 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
|
||||
1997-10-03 Mikael Djurfeldt <mdj@nada.kth.se>
|
||||
|
||||
* print.h (SCM_PRINT_STATE_P): Removed SCM_NIMP test. (NIMP
|
||||
macros should by convention not test for NIMPness.)
|
||||
(SCM_COERCE_OPORT): Adjust indentation.
|
||||
|
||||
* print.c (scm_valid_oport_value_p): Adjusted indentation; Added
|
||||
SCM_NIMP test before SCM_PRINT_STATE_P.
|
||||
|
||||
* struct.c, struct.h, gc.c: Renamed:
|
||||
scm_struct_i_layout --> scm_vtable_index_layout
|
||||
scm_struct_i_vcell --> scm_vtable_index_vcell
|
||||
scm_struct_i_vtable --> scm_vtable_index_vtable
|
||||
scm_struct_i_printer --> scm_vtable_index_printer
|
||||
scm_struct_i_vtable_offset --> scm_vtable_offset_user
|
||||
|
||||
* struct.c (scm_print_struct): Use new printer slot; Default
|
||||
printing: Also output hex code of vtable so that type identity
|
||||
will be indicated as well.
|
||||
(scm_init_struct): Updated required_vtable_fields to "pruosrpw";
|
||||
Removed struct_printer_var; Removed struct-vtable-offset;
|
||||
(vtable-index-layout, vtable-index-vtable, vtable-index-printer,
|
||||
vtable-offset-user): New constants.
|
||||
|
||||
* struct.h (scm_struct_i_vtable_offset): Bumped from 3 to 4.
|
||||
(scm_struct_i_printer, SCM_STRUCT_PRINTER): New slot in vtables.
|
||||
If this slot contains a procedure, use that to print structures of
|
||||
the type represented by this vtable.
|
||||
|
||||
* print.c (scm_iprin1): Don't print arguments of macro
|
||||
transformers. (They are always: exp env.); Bugfix: Unmemoize
|
||||
|
|
|
|||
|
|
@ -628,7 +628,7 @@ gc_mark_nimp:
|
|||
register int x;
|
||||
|
||||
vtable_data = (SCM *)vcell;
|
||||
layout = vtable_data[scm_struct_i_layout];
|
||||
layout = vtable_data[scm_vtable_index_layout];
|
||||
len = SCM_LENGTH (layout);
|
||||
fields_desc = SCM_CHARS (layout);
|
||||
/* We're using SCM_GCCDR here like STRUCT_DATA, except
|
||||
|
|
@ -652,7 +652,7 @@ gc_mark_nimp:
|
|||
if (!SCM_CDR (vcell))
|
||||
{
|
||||
SCM_SETGCMARK (vcell);
|
||||
ptr = vtable_data[scm_struct_i_vtable];
|
||||
ptr = vtable_data[scm_vtable_index_vtable];
|
||||
goto gc_mark_loop;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -205,6 +205,29 @@ scm_make_print_state ()
|
|||
return answer ? answer : make_print_state ();
|
||||
}
|
||||
|
||||
static char s_print_state_printer[] = "print-state-printer";
|
||||
static SCM
|
||||
print_state_printer (obj, port)
|
||||
SCM obj;
|
||||
SCM port;
|
||||
{
|
||||
/* This function can be made visible by means of struct-ref, so
|
||||
we need to make sure that it gets what it wants. */
|
||||
SCM_ASSERT (SCM_NIMP (obj) && SCM_PRINT_STATE_P (obj),
|
||||
obj,
|
||||
SCM_ARG1,
|
||||
s_print_state_printer);
|
||||
SCM_ASSERT (scm_valid_oport_value_p (port),
|
||||
port,
|
||||
SCM_ARG2,
|
||||
s_print_state_printer);
|
||||
port = SCM_COERCE_OPORT (port);
|
||||
scm_gen_puts (scm_regular_string, "#<print-state ", port);
|
||||
scm_intprint (obj, 16, port);
|
||||
scm_gen_putc ('>', port);
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
void
|
||||
scm_free_print_state (print_state)
|
||||
SCM print_state;
|
||||
|
|
@ -836,10 +859,13 @@ circref:
|
|||
int
|
||||
scm_valid_oport_value_p (SCM val)
|
||||
{
|
||||
return SCM_NIMP (val) &&
|
||||
(SCM_OPOUTPORTP (val) || (SCM_CONSP (val) && SCM_NIMP (SCM_CAR (val)) &&
|
||||
SCM_OPOUTPORTP (SCM_CAR (val)) &&
|
||||
SCM_PRINT_STATE_P (SCM_CDR (val))));
|
||||
return (SCM_NIMP (val)
|
||||
&& (SCM_OPOUTPORTP (val)
|
||||
|| (SCM_CONSP (val)
|
||||
&& SCM_NIMP (SCM_CAR (val))
|
||||
&& SCM_OPOUTPORTP (SCM_CAR (val))
|
||||
&& SCM_NIMP (SCM_CDR (val))
|
||||
&& SCM_PRINT_STATE_P (SCM_CDR (val)))));
|
||||
}
|
||||
|
||||
SCM_PROC(s_write, "write", 1, 1, 0, scm_write);
|
||||
|
|
@ -958,14 +984,18 @@ scm_printer_apply (proc, exp, port, pstate)
|
|||
void
|
||||
scm_init_print ()
|
||||
{
|
||||
SCM vtable, type;
|
||||
|
||||
SCM vtable, layout, printer, type;
|
||||
|
||||
scm_init_opts (scm_print_options, scm_print_opts, SCM_N_PRINT_OPTIONS);
|
||||
vtable = scm_make_vtable_vtable (scm_make_struct_layout (scm_nullstr), SCM_INUM0, SCM_EOL);
|
||||
type = scm_make_struct (vtable,
|
||||
SCM_INUM0,
|
||||
scm_cons (scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT)),
|
||||
SCM_EOL));
|
||||
vtable = scm_make_vtable_vtable (scm_make_struct_layout (scm_nullstr),
|
||||
SCM_INUM0,
|
||||
SCM_EOL);
|
||||
layout = scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT));
|
||||
printer = scm_make_subr_opt (s_print_state_printer,
|
||||
scm_tc7_subr_2,
|
||||
(SCM (*) ()) print_state_printer,
|
||||
0 /* Don't bind the name. */);
|
||||
type = scm_make_struct (vtable, SCM_INUM0, SCM_LIST2 (layout, printer));
|
||||
print_state_pool = scm_permanent_object (scm_cons (type, SCM_EOL));
|
||||
|
||||
scm_print_state_vtable = type;
|
||||
|
|
|
|||
|
|
@ -56,9 +56,9 @@ extern scm_option scm_print_opts[];
|
|||
|
||||
/* State information passed around during printing.
|
||||
*/
|
||||
#define SCM_PRINT_STATE_P(obj) (SCM_NIMP(obj) && SCM_STRUCTP(obj) && \
|
||||
SCM_STRUCT_VTABLE(obj) == \
|
||||
scm_print_state_vtable)
|
||||
#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) \
|
||||
|
|
@ -70,8 +70,9 @@ extern scm_option scm_print_opts[];
|
|||
#define SCM_WRITINGP(pstate) ((pstate)->writingp)
|
||||
#define SCM_SET_WRITINGP(pstate, x) { (pstate)->writingp = (x); }
|
||||
|
||||
#define SCM_COERCE_OPORT(p) ((SCM_NIMP(p) && SCM_PRINT_STATE_P(SCM_CDR (p)))? \
|
||||
SCM_CAR(p) : p)
|
||||
#define SCM_COERCE_OPORT(p) ((SCM_NIMP (p) && SCM_PRINT_STATE_P (SCM_CDR (p))) \
|
||||
? SCM_CAR (p) \
|
||||
: p)
|
||||
|
||||
#define SCM_PRINT_STATE_LAYOUT "sruwuwuwuwuwpwuwuwuruopr"
|
||||
typedef struct scm_print_state {
|
||||
|
|
|
|||
|
|
@ -56,7 +56,6 @@
|
|||
|
||||
static SCM required_vtable_fields = SCM_BOOL_F;
|
||||
static int struct_num = 0;
|
||||
static SCM struct_printer_var;
|
||||
|
||||
|
||||
SCM_PROC (s_struct_make_layout, "make-struct-layout", 1, 0, 0, scm_make_struct_layout);
|
||||
|
|
@ -357,7 +356,7 @@ scm_make_struct (vtable, tail_array_size, init)
|
|||
SCM_ASSERT (SCM_INUMP (tail_array_size), tail_array_size, SCM_ARG2,
|
||||
s_make_struct);
|
||||
|
||||
layout = SCM_STRUCT_DATA (vtable)[scm_struct_i_layout];
|
||||
layout = SCM_STRUCT_DATA (vtable)[scm_vtable_index_layout];
|
||||
basic_size = SCM_LENGTH (layout) / 2;
|
||||
tail_elts = SCM_INUM (tail_array_size);
|
||||
SCM_NEWCELL (handle);
|
||||
|
|
@ -604,12 +603,14 @@ scm_print_struct (exp, port, pstate)
|
|||
SCM port;
|
||||
scm_print_state *pstate;
|
||||
{
|
||||
SCM prt = SCM_CDR (struct_printer_var);
|
||||
if (SCM_FALSEP(prt) ||
|
||||
SCM_FALSEP(scm_printer_apply (prt, exp, port, pstate)))
|
||||
if (SCM_NFALSEP (scm_procedure_p (SCM_STRUCT_PRINTER (exp))))
|
||||
scm_printer_apply (SCM_STRUCT_PRINTER (exp), exp, port, pstate);
|
||||
else
|
||||
{
|
||||
scm_gen_write (scm_regular_string, "#<struct ", sizeof ("#<struct ") - 1,
|
||||
port);
|
||||
scm_intprint (SCM_STRUCT_VTABLE (exp), 16, port);
|
||||
scm_gen_putc (':', port);
|
||||
scm_intprint (exp, 16, port);
|
||||
scm_gen_putc ('>', port);
|
||||
}
|
||||
|
|
@ -618,9 +619,11 @@ scm_print_struct (exp, port, pstate)
|
|||
void
|
||||
scm_init_struct ()
|
||||
{
|
||||
required_vtable_fields = SCM_CAR (scm_intern_obarray ("pruosr", sizeof ("pruosr") - 1, SCM_BOOL_F));
|
||||
required_vtable_fields = SCM_CAR (scm_intern_obarray ("pruosrpw", sizeof ("pruosrpw") - 1, SCM_BOOL_F));
|
||||
scm_permanent_object (required_vtable_fields);
|
||||
scm_sysintern ("struct-vtable-offset", SCM_MAKINUM (scm_struct_i_vtable_offset));
|
||||
struct_printer_var = scm_sysintern("*struct-printer*", SCM_BOOL_F);
|
||||
scm_sysintern ("vtable-index-layout", SCM_MAKINUM (scm_vtable_index_layout));
|
||||
scm_sysintern ("vtable-index-vtable", SCM_MAKINUM (scm_vtable_index_vtable));
|
||||
scm_sysintern ("vtable-index-printer", SCM_MAKINUM (scm_vtable_index_printer));
|
||||
scm_sysintern ("vtable-offset-user", SCM_MAKINUM (scm_vtable_offset_user));
|
||||
#include "struct.x"
|
||||
}
|
||||
|
|
|
|||
|
|
@ -53,20 +53,22 @@
|
|||
#define scm_struct_n_extra_words 3
|
||||
|
||||
/* These are how the initial words of a vtable are allocated. */
|
||||
#define scm_struct_i_ptr -3 /* start of block (see alloc_struct) */
|
||||
#define scm_struct_i_n_words -2 /* How many words allocated to this struct? */
|
||||
#define scm_struct_i_tag -1 /* A unique tag for this type.. */
|
||||
#define scm_struct_i_layout 0 /* A symbol describing the physical arrangement of this type. */
|
||||
#define scm_struct_i_vcell 1 /* An opaque word, managed by the garbage collector. */
|
||||
#define scm_struct_i_vtable 2 /* A pointer to the handle for this vtable. */
|
||||
#define scm_struct_i_vtable_offset 3 /* Where do user fields start? */
|
||||
#define scm_struct_i_ptr -3 /* start of block (see alloc_struct) */
|
||||
#define scm_struct_i_n_words -2 /* How many words allocated to this struct? */
|
||||
#define scm_struct_i_tag -1 /* A unique tag for this type.. */
|
||||
#define scm_vtable_index_layout 0 /* A symbol describing the physical arrangement of this type. */
|
||||
#define scm_vtable_index_vcell 1 /* An opaque word, managed by the garbage collector. */
|
||||
#define scm_vtable_index_vtable 2 /* A pointer to the handle for this vtable. */
|
||||
#define scm_vtable_index_printer 3 /* A printer for this struct type. */
|
||||
#define scm_vtable_offset_user 4 /* Where do user fields start? */
|
||||
|
||||
|
||||
#define SCM_STRUCTP(X) (SCM_TYP3(X) == scm_tc3_cons_gloc)
|
||||
#define SCM_STRUCT_DATA(X) ((SCM*)(SCM_CDR(X)))
|
||||
#define SCM_STRUCT_VTABLE_DATA(X) ((SCM *)(SCM_CAR(X) - 1))
|
||||
#define SCM_STRUCT_LAYOUT(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_struct_i_layout])
|
||||
#define SCM_STRUCT_VTABLE(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_struct_i_vtable])
|
||||
#define SCM_STRUCT_LAYOUT(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_vtable_index_layout])
|
||||
#define SCM_STRUCT_VTABLE(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_vtable_index_vtable])
|
||||
#define SCM_STRUCT_PRINTER(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_vtable_index_printer])
|
||||
/* Efficiency is important in the following macro, since it's used in GC */
|
||||
#define SCM_LAYOUT_TAILP(X) (((X) & 32) == 0) /* R, W or O */
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue