From d5cf5324a3a9c8f0202d1bd49aacc98bbe331f55 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Thu, 11 Oct 2001 23:20:52 +0000 Subject: [PATCH] * print.c (scm_print_state_vtable, print_state_pool): Initialize. These variables are now registered as gc roots. (scm_current_pstate): Update documentation. (scm_current_pstate, scm_make_print_state, scm_free_print_state, scm_prin1, scm_init_print): print_state_pool is registered as a gc root and thus does not need to be protected by a surrounding pair any more. (make_print_state): The car of print_state_pool no longer holds the scm_print_state_vtable. (scm_current_pstate, scm_make_print_state, print_circref, scm_iprin1, scm_prin1, scm_iprlist): Prefer !SCM_ over SCM_N. (scm_prin1): When building lists, prefer scm_list_ over scm_cons[2]?. (scm_iprlist): Removed a redundant SCM_IMP test. (scm_simple_format): Use SCM_EQ_P to compare SCM values. --- libguile/ChangeLog | 26 +++++++++++++++++++++ libguile/print.c | 57 +++++++++++++++++++++++----------------------- 2 files changed, 54 insertions(+), 29 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 8c51b00a6..ca9ed8bc6 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,29 @@ +2001-10-12 Dirk Herrmann + + * print.c (scm_print_state_vtable, print_state_pool): + Initialize. These variables are now registered as gc roots. + + (scm_current_pstate): Update documentation. + + (scm_current_pstate, scm_make_print_state, scm_free_print_state, + scm_prin1, scm_init_print): print_state_pool is registered as a + gc root and thus does not need to be protected by a surrounding + pair any more. + + (make_print_state): The car of print_state_pool no longer holds + the scm_print_state_vtable. + + (scm_current_pstate, scm_make_print_state, print_circref, + scm_iprin1, scm_prin1, scm_iprlist): Prefer !SCM_ over + SCM_N. + + (scm_prin1): When building lists, prefer scm_list_ over + scm_cons[2]?. + + (scm_iprlist): Removed a redundant SCM_IMP test. + + (scm_simple_format): Use SCM_EQ_P to compare SCM values. + 2001-10-11 Dirk Herrmann * debug.c (scm_make_iloc): Prefer !SCM_ over SCM_N. diff --git a/libguile/print.c b/libguile/print.c index e207f411a..31b12e5ce 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -185,21 +185,20 @@ do { \ #define EXIT_NESTED_DATA(pstate) { --pstate->top; } -SCM scm_print_state_vtable; - -static SCM print_state_pool; +SCM scm_print_state_vtable = SCM_BOOL_F; +static SCM print_state_pool = SCM_EOL; #ifdef GUILE_DEBUG /* Used for debugging purposes */ SCM_DEFINE (scm_current_pstate, "current-pstate", 0, 0, 0, (), - "Return the current-pstate -- the cadr of the\n" + "Return the current-pstate -- the car of the\n" "@code{print_state_pool}. @code{current-pstate} is only\n" "included in @code{--enable-guile-debug} builds.") #define FUNC_NAME s_scm_current_pstate { - if (SCM_NNULLP (SCM_CDR (print_state_pool))) - return SCM_CADR (print_state_pool); + if (!SCM_NULLP (print_state_pool)) + return SCM_CAR (print_state_pool); else return SCM_BOOL_F; } @@ -212,9 +211,8 @@ SCM_DEFINE (scm_current_pstate, "current-pstate", 0, 0, 0, static SCM make_print_state (void) { - SCM print_state = scm_make_struct (SCM_CAR (print_state_pool), /* pstate type */ - SCM_INUM0, - SCM_EOL); + SCM print_state + = scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL); scm_print_state *pstate = SCM_PRINT_STATE (print_state); pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED); pstate->ref_stack = SCM_VELTS (pstate->ref_vect); @@ -229,10 +227,10 @@ scm_make_print_state () /* First try to allocate a print state from the pool */ SCM_DEFER_INTS; - if (SCM_NNULLP (SCM_CDR (print_state_pool))) + if (!SCM_NULLP (print_state_pool)) { - answer = SCM_CADR (print_state_pool); - SCM_SETCDR (print_state_pool, SCM_CDDR (print_state_pool)); + answer = SCM_CAR (print_state_pool); + print_state_pool = SCM_CDR (print_state_pool); } SCM_ALLOW_INTS; @@ -254,8 +252,8 @@ scm_free_print_state (SCM print_state) SCM_NEWCELL (handle); SCM_DEFER_INTS; SCM_SET_CELL_WORD_0 (handle, print_state); - SCM_SET_CELL_WORD_1 (handle, SCM_CDR (print_state_pool)); - SCM_SETCDR (print_state_pool, handle); + SCM_SET_CELL_WORD_1 (handle, print_state_pool); + print_state_pool = handle; SCM_ALLOW_INTS; } @@ -288,7 +286,7 @@ print_circref (SCM port,scm_print_state *pstate,SCM ref) { while (i > 0) { - if (SCM_NCONSP (pstate->ref_stack[i - 1]) + if (!SCM_CONSP (pstate->ref_stack[i - 1]) || !SCM_EQ_P (SCM_CDR (pstate->ref_stack[i - 1]), pstate->ref_stack[i])) break; @@ -607,7 +605,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) /* Print gsubrs as primitives */ SCM name = scm_procedure_name (exp); scm_puts ("#revealed) { SCM_DEFER_INTS; - SCM_SETCDR (handle, SCM_CDR (print_state_pool)); - SCM_SETCDR (print_state_pool, handle); + SCM_SETCDR (handle, print_state_pool); + print_state_pool = handle; SCM_ALLOW_INTS; } } @@ -764,7 +762,7 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate) if (SCM_EQ_P (hare, tortoise)) goto fancy_printing; hare = SCM_CDR (hare); - if (SCM_IMP (hare) || SCM_NCONSP (hare)) + if (!SCM_CONSP (hare)) break; hare = SCM_CDR (hare); tortoise = SCM_CDR (tortoise); @@ -825,7 +823,7 @@ fancy_printing: scm_iprin1 (SCM_CAR (exp), port, pstate); } } - if (SCM_NNULLP (exp)) + if (!SCM_NULLP (exp)) { scm_puts (" . ", port); scm_iprin1 (exp, port, pstate); @@ -979,7 +977,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, } scm_lfwrite (start, p - start, destination); - if (args != SCM_EOL) + if (!SCM_EQ_P (args, SCM_EOL)) SCM_MISC_ERROR ("FORMAT: ~A superfluous arguments", scm_list_1 (scm_length (args))); @@ -1094,14 +1092,15 @@ void scm_init_print () { SCM vtable, layout, type; - + scm_init_opts (scm_print_options, scm_print_opts, SCM_N_PRINT_OPTIONS); + + scm_gc_register_root (&print_state_pool); + scm_gc_register_root (&scm_print_state_vtable); vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL); layout = scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT)); type = scm_make_struct (vtable, SCM_INUM0, scm_list_1 (layout)); scm_set_struct_vtable_name_x (type, scm_str2symbol ("print-state")); - print_state_pool = scm_permanent_object (scm_cons (type, SCM_EOL)); - scm_print_state_vtable = type; /* Don't want to bind a wrapper class in GOOPS, so pass 0 as arg1. */