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

(quicksort, scm_merge, scm_merge_list_x,

Browse source 
scm_merge_list_step, scm_merge_vector_step): Inserted SCM_TICKs at
strategic places so that the loops can be interrupted.
This commit is contained in:
Marius Vollmer 2004-10-22 13:17:04 +00:00
parent 6191ccecf1
commit ee1ac75beb
1 changed files with 9 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

10
libguile/sort.c
View file

@ -39,11 +39,11 @@
#include "libguile/feature.h" #include "libguile/feature.h"
#include "libguile/vectors.h" #include "libguile/vectors.h"
#include "libguile/lang.h" #include "libguile/lang.h"
#include "libguile/async.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/sort.h" #include "libguile/sort.h"
/* The routine quicksort was extracted from the GNU C Library qsort.c /* The routine quicksort was extracted from the GNU C Library qsort.c
written by Douglas C. Schmidt (schmidt@ics.uci.edu) written by Douglas C. Schmidt (schmidt@ics.uci.edu)
and adapted to guile by adding an extra pointer less and adapted to guile by adding an extra pointer less
@ -129,6 +129,8 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les
size_t right; size_t right;
SCM pivot; SCM pivot;
SCM_TICK;
/* Select median value from among LO, MID, and HI. Rearrange /* Select median value from among LO, MID, and HI. Rearrange
LO and HI so the three values are sorted. This lowers the LO and HI so the three values are sorted. This lowers the
probability of picking a pathological pivot value and probability of picking a pathological pivot value and
@ -246,6 +248,8 @@ quicksort (SCM *const base_ptr, size_t nr_elems, scm_t_trampoline_2 cmp, SCM les
run = 1; run = 1;
while (++run <= end) while (++run <= end)
{ {
SCM_TICK;
tmp = run - 1; tmp = run - 1;
while (scm_is_true ((*cmp) (less, base_ptr[run], base_ptr[tmp]))) while (scm_is_true ((*cmp) (less, base_ptr[run], base_ptr[tmp])))
{ {
@ -425,6 +429,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0,
last = build; last = build;
while ((alen > 0) && (blen > 0)) while ((alen > 0) && (blen > 0))
{ {
SCM_TICK;
if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
{ {
SCM_SETCDR (last, scm_cons (SCM_CAR (blist), SCM_EOL)); SCM_SETCDR (last, scm_cons (SCM_CAR (blist), SCM_EOL));
@ -477,6 +482,7 @@ scm_merge_list_x (SCM alist, SCM blist,
last = build; last = build;
while ((alen > 0) && (blen > 0)) while ((alen > 0) && (blen > 0))
{ {
SCM_TICK;
if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist)))) if (scm_is_true ((*cmp) (less, SCM_CAR (blist), SCM_CAR (alist))))
{ {
SCM_SETCDR (last, blist); SCM_SETCDR (last, blist);
@ -540,6 +546,7 @@ scm_merge_list_step (SCM * seq, scm_t_trampoline_2 cmp, SCM less, long n)
if (n > 2) if (n > 2)
{ {
long mid = n / 2; long mid = n / 2;
SCM_TICK;
a = scm_merge_list_step (seq, cmp, less, mid); a = scm_merge_list_step (seq, cmp, less, mid);
b = scm_merge_list_step (seq, cmp, less, n - mid); b = scm_merge_list_step (seq, cmp, less, n - mid);
return scm_merge_list_x (a, b, mid, n - mid, cmp, less); return scm_merge_list_x (a, b, mid, n - mid, cmp, less);
@ -704,6 +711,7 @@ scm_merge_vector_step (SCM vp,
if (high > low) if (high > low)
{ {
long mid = (low + high) / 2; long mid = (low + high) / 2;
SCM_TICK;
scm_merge_vector_step (vp, temp, cmp, less, low, mid); scm_merge_vector_step (vp, temp, cmp, less, low, mid);
scm_merge_vector_step (vp, temp, cmp, less, mid+1, high); scm_merge_vector_step (vp, temp, cmp, less, mid+1, high);
scm_merge_vector_x (vp, temp, cmp, less, low, mid, high); scm_merge_vector_x (vp, temp, cmp, less, low, mid, high);