mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

Fixed some SCM/scm_bits_t mixups and initialization problems.

Browse source
This commit is contained in:
Dirk Herrmann 2000-04-18 07:24:24 +00:00
parent c8045e8dbd
commit 230d095fc5
3 changed files with 23 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

11
libguile/ChangeLog
View file

@ -1,3 +1,14 @@
2000-04-18 Dirk Herrmann <D.Herrmann@tu-bs.de>
* print.c (ENTER_NESTED_DATA, print_circref, scm_iprlist):
Compare SCM's with SCM_EQ_P.
* print.c (scm_make_print_state), srcprop.c
(scm_source_properties): Use valid scheme object to initialize
SCM variable.
* print.c (scm_iprin1): Remove redundant calls to SCM_UNPACK.
2000-04-17 Dirk Herrmann <D.Herrmann@tu-bs.de> 2000-04-17 Dirk Herrmann <D.Herrmann@tu-bs.de>
* struct.c (scm_alloc_struct, scm_struct_free_0, * struct.c (scm_alloc_struct, scm_struct_free_0,

19
libguile/print.c
View file

@ -166,7 +166,7 @@ do { \
do { \ do { \
register unsigned long i; \ register unsigned long i; \
for (i = 0; i < pstate->top; ++i) \ for (i = 0; i < pstate->top; ++i) \
if (pstate->ref_stack[i] == (obj)) \ if (SCM_EQ_P (pstate->ref_stack[i], (obj))) \
goto label; \ goto label; \
if (pstate->fancyp) \ if (pstate->fancyp) \
{ \ { \
@ -218,7 +218,7 @@ make_print_state (void)
SCM SCM
scm_make_print_state () scm_make_print_state ()
{ {
SCM answer = 0; SCM answer = SCM_BOOL_F;
/* First try to allocate a print state from the pool */ /* First try to allocate a print state from the pool */
SCM_DEFER_INTS; SCM_DEFER_INTS;
@ -229,7 +229,7 @@ scm_make_print_state ()
} }
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return answer ? answer : make_print_state (); return SCM_FALSEP (answer) ? make_print_state () : answer;
} }
void void
@ -273,14 +273,15 @@ print_circref (SCM port,scm_print_state *pstate,SCM ref)
while (i > 0) while (i > 0)
{ {
if (SCM_NCONSP (pstate->ref_stack[i - 1]) if (SCM_NCONSP (pstate->ref_stack[i - 1])
|| SCM_CDR (pstate->ref_stack[i - 1]) != pstate->ref_stack[i]) || !SCM_EQ_P (SCM_CDR (pstate->ref_stack[i - 1]),
pstate->ref_stack[i]))
break; break;
--i; --i;
} }
self = i; self = i;
} }
for (i = pstate->top - 1; 1; --i) for (i = pstate->top - 1; 1; --i)
if (pstate->ref_stack[i] == ref) if (SCM_EQ_P (pstate->ref_stack[i], ref))
break; break;
scm_putc ('#', port); scm_putc ('#', port);
scm_intprint (i - self, 10, port); scm_intprint (i - self, 10, port);
@ -327,9 +328,9 @@ taloop:
else if (SCM_ILOCP (exp)) else if (SCM_ILOCP (exp))
{ {
scm_puts ("#@", port); scm_puts ("#@", port);
scm_intprint (SCM_UNPACK (SCM_IFRAME (exp)), 10, port); scm_intprint (SCM_IFRAME (exp), 10, port);
scm_putc (SCM_ICDRP (exp) ? '-' : '+', port); scm_putc (SCM_ICDRP (exp) ? '-' : '+', port);
scm_intprint (SCM_UNPACK (SCM_IDIST (exp)), 10, port); scm_intprint (SCM_IDIST (exp), 10, port);
} }
else else
goto idef; goto idef;
@ -819,7 +820,7 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
if (SCM_NECONSP (exp)) if (SCM_NECONSP (exp))
break; break;
for (i = floor; i >= 0; --i) for (i = floor; i >= 0; --i)
if (pstate->ref_stack[i] == exp) if (SCM_EQ_P (pstate->ref_stack[i], exp))
goto circref; goto circref;
PUSH_REF (pstate, exp); PUSH_REF (pstate, exp);
scm_putc (' ', port); scm_putc (' ', port);
@ -850,7 +851,7 @@ fancy_printing:
if (SCM_NECONSP (exp)) if (SCM_NECONSP (exp))
break; break;
for (i = 0; i < pstate->top; ++i) for (i = 0; i < pstate->top; ++i)
if (pstate->ref_stack[i] == exp) if (SCM_EQ_P (pstate->ref_stack[i], exp))
goto fancy_circref; goto fancy_circref;
if (pstate->fancyp) if (pstate->fancyp)
{ {

4
libguile/srcprop.c
View file

@ -177,8 +177,8 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
else if (SCM_NCONSP (obj)) else if (SCM_NCONSP (obj))
SCM_WRONG_TYPE_ARG (1, obj); SCM_WRONG_TYPE_ARG (1, obj);
#endif #endif
p = scm_hashq_ref (scm_source_whash, obj, (SCM) NULL); p = scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F);
if (p != (SCM) NULL && SRCPROPSP (p)) if (SRCPROPSP (p))
return scm_srcprops_to_plist (p); return scm_srcprops_to_plist (p);
return SCM_EOL; return SCM_EOL;
} }