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

* environments.c: Don't use '==' to compare SCM objects.

Browse source 
* posix.c (scm_getgroups):  Don't create a redundant string object.
This commit is contained in:
Dirk Herrmann 2000-11-01 17:55:41 +00:00
parent 0f87853a56
commit 66460dfba3
3 changed files with 30 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/ChangeLog
View file

@ -1,3 +1,10 @@
2000-11-01 Dirk Herrmann <D.Herrmann@tu-bs.de>
* environments.c (obarray_replace, obarray_retrieve,
obarray_remove): Don't use '==' to compare SCM objects.
* posix.c (scm_getgroups): Don't create a redundant string.
2000-11-01 Dirk Herrmann <D.Herrmann@tu-bs.de> 2000-11-01 Dirk Herrmann <D.Herrmann@tu-bs.de>
* symbols.c (scm_sym2vcell, scm_sym2ovcell_soft, * symbols.c (scm_sym2vcell, scm_sym2ovcell_soft,

6
libguile/environments.c
View file

@ -545,7 +545,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
for (lsym = SCM_VELTS (obarray)[hash]; !SCM_NULLP (lsym); lsym = SCM_CDR (lsym)) for (lsym = SCM_VELTS (obarray)[hash]; !SCM_NULLP (lsym); lsym = SCM_CDR (lsym))
{ {
SCM old_entry = SCM_CAR (lsym); SCM old_entry = SCM_CAR (lsym);
if (SCM_CAR (old_entry) == symbol) if (SCM_EQ_P (SCM_CAR (old_entry), symbol))
{ {
SCM_SETCAR (lsym, new_entry); SCM_SETCAR (lsym, new_entry);
return old_entry; return old_entry;
@ -571,7 +571,7 @@ obarray_retrieve (SCM obarray, SCM sym)
for (lsym = SCM_VELTS (obarray)[hash]; !SCM_NULLP (lsym); lsym = SCM_CDR (lsym)) for (lsym = SCM_VELTS (obarray)[hash]; !SCM_NULLP (lsym); lsym = SCM_CDR (lsym))
{ {
SCM entry = SCM_CAR (lsym); SCM entry = SCM_CAR (lsym);
if (SCM_CAR (entry) == sym) if (SCM_EQ_P (SCM_CAR (entry), sym))
return entry; return entry;
} }
@ -596,7 +596,7 @@ obarray_remove (SCM obarray, SCM sym)
lsym = *(lsymp = SCM_CDRLOC (lsym))) lsym = *(lsymp = SCM_CDRLOC (lsym)))
{ {
SCM entry = SCM_CAR (lsym); SCM entry = SCM_CAR (lsym);
if (SCM_CAR (entry) == sym) if (SCM_EQ_P (SCM_CAR (entry), sym))
{ {
*lsymp = SCM_CDR (lsym); *lsymp = SCM_CDR (lsym);
return entry; return entry;

40
libguile/posix.c
View file

@ -205,33 +205,27 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
"Returns a vector of integers representing the current supplimentary group IDs.") "Returns a vector of integers representing the current supplimentary group IDs.")
#define FUNC_NAME s_scm_getgroups #define FUNC_NAME s_scm_getgroups
{ {
SCM grps, ans; SCM ans;
int ngroups = getgroups (0, NULL); int ngroups;
if (!ngroups) scm_sizet size;
SCM_SYSERROR;
SCM_NEWCELL(grps);
SCM_DEFER_INTS;
{
GETGROUPS_T *groups; GETGROUPS_T *groups;
int val;
groups = SCM_MUST_MALLOC_TYPE_NUM(GETGROUPS_T,ngroups); ngroups = getgroups (0, NULL);
val = getgroups(ngroups, groups); if (ngroups <= 0)
if (val < 0)
{
int en = errno;
scm_must_free((char *)groups);
errno = en;
SCM_SYSERROR; SCM_SYSERROR;
}
SCM_SETCHARS(grps, groups); /* set up grps as a GC protect */ size = ngroups * sizeof (GETGROUPS_T);
SCM_SETLENGTH(grps, 0L + ngroups * sizeof(GETGROUPS_T), scm_tc7_string); groups = scm_must_malloc (size, FUNC_NAME);
ans = scm_make_vector (SCM_MAKINUM(ngroups), SCM_UNDEFINED); getgroups (ngroups, groups);
while (--ngroups >= 0) SCM_VELTS(ans)[ngroups] = SCM_MAKINUM(groups[ngroups]);
SCM_SETCHARS(grps, groups); /* to make sure grps stays around. */ ans = scm_make_vector (SCM_MAKINUM (ngroups), SCM_UNDEFINED);
SCM_ALLOW_INTS; while (--ngroups >= 0)
SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]);
scm_must_free (groups);
scm_done_free (size);
return ans; return ans;
}
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif #endif