437 |
len = SCM_INUM (endpos) - spos; |
len = SCM_INUM (endpos) - spos; |
438 |
|
|
439 |
quicksort (&vp[spos], len, size, scm_cmp_function (less), less); |
quicksort (&vp[spos], len, size, scm_cmp_function (less), less); |
|
SCM_GC_FLAG_OBJECT_WRITE(vec); |
|
440 |
|
|
441 |
return SCM_UNSPECIFIED; |
return SCM_UNSPECIFIED; |
442 |
/* return vec; */ |
/* return vec; */ |
783 |
#undef FUNC_NAME |
#undef FUNC_NAME |
784 |
|
|
785 |
static void |
static void |
786 |
scm_merge_vector_x (void *const vecbase, |
scm_merge_vector_x (SCM vec, |
787 |
void *const tempbase, |
SCM * temp, |
788 |
cmp_fun_t cmp, |
cmp_fun_t cmp, |
789 |
SCM less, |
SCM less, |
790 |
long low, |
long low, |
791 |
long mid, |
long mid, |
792 |
long high) |
long high) |
793 |
{ |
{ |
|
register SCM *vp = (SCM *) vecbase; |
|
|
register SCM *temp = (SCM *) tempbase; |
|
794 |
long it; /* Index for temp vector */ |
long it; /* Index for temp vector */ |
795 |
long i1 = low; /* Index for lower vector segment */ |
long i1 = low; /* Index for lower vector segment */ |
796 |
long i2 = mid + 1; /* Index for upper vector segment */ |
long i2 = mid + 1; /* Index for upper vector segment */ |
797 |
|
|
798 |
/* Copy while both segments contain more characters */ |
/* Copy while both segments contain more characters */ |
799 |
for (it = low; (i1 <= mid) && (i2 <= high); ++it) |
for (it = low; (i1 <= mid) && (i2 <= high); ++it) |
800 |
if ((*cmp) (less, &vp[i2], &vp[i1])) |
{ |
801 |
temp[it] = vp[i2++]; |
/* |
802 |
else |
Every call of LESS might invoke GC. For full correctness, we |
803 |
temp[it] = vp[i1++]; |
should reset the generation of vecbase and tempbase between |
804 |
|
every call of less. |
805 |
/* Copy while first segment contains more characters */ |
|
806 |
while (i1 <= mid) |
*/ |
807 |
temp[it++] = vp[i1++]; |
register SCM *vp = SCM_WRITABLE_VELTS(vec); |
808 |
|
|
809 |
/* Copy while second segment contains more characters */ |
if ((*cmp) (less, &vp[i2], &vp[i1])) |
810 |
while (i2 <= high) |
temp[it] = vp[i2++]; |
811 |
temp[it++] = vp[i2++]; |
else |
812 |
|
temp[it] = vp[i1++]; |
813 |
/* Copy back from temp to vp */ |
} |
814 |
for (it = low; it <= high; ++it) |
|
815 |
vp[it] = temp[it]; |
{ |
816 |
} /* scm_merge_vector_x */ |
register SCM *vp = SCM_WRITABLE_VELTS(vec); |
817 |
|
|
818 |
|
/* Copy while first segment contains more characters */ |
819 |
|
while (i1 <= mid) |
820 |
|
temp[it++] = vp[i1++]; |
821 |
|
|
822 |
|
/* Copy while second segment contains more characters */ |
823 |
|
while (i2 <= high) |
824 |
|
temp[it++] = vp[i2++]; |
825 |
|
|
826 |
|
/* Copy back from temp to vp */ |
827 |
|
for (it = low; it <= high; ++it) |
828 |
|
vp[it] = temp[it]; |
829 |
|
} |
830 |
|
} /* scm_merge_vector_x */ |
831 |
|
|
832 |
static void |
static void |
833 |
scm_merge_vector_step (void *const vp, |
scm_merge_vector_step (SCM vp, |
834 |
void *const temp, |
SCM * temp, |
835 |
cmp_fun_t cmp, |
cmp_fun_t cmp, |
836 |
SCM less, |
SCM less, |
837 |
long low, |
long low, |
871 |
} |
} |
872 |
else if (SCM_VECTORP (items)) |
else if (SCM_VECTORP (items)) |
873 |
{ |
{ |
874 |
SCM *temp, *vp; |
SCM *temp; |
875 |
len = SCM_VECTOR_LENGTH (items); |
len = SCM_VECTOR_LENGTH (items); |
|
temp = malloc (len * sizeof(SCM)); |
|
876 |
|
|
|
|
|
|
vp = SCM_WRITABLE_VELTS (items); |
|
877 |
/* |
/* |
878 |
This routine modifies VP |
the following array does not contain any new references to |
879 |
*/ |
SCM objects, so we can get away with allocing it on the heap. |
880 |
|
*/ |
881 |
|
temp = malloc (len * sizeof(SCM)); |
882 |
|
|
883 |
SCM_GC_FLAG_OBJECT_WRITE(items); |
scm_merge_vector_step (items, |
|
scm_merge_vector_step (vp, |
|
884 |
temp, |
temp, |
885 |
scm_cmp_function (less), |
scm_cmp_function (less), |
886 |
less, |
less, |
895 |
#undef FUNC_NAME |
#undef FUNC_NAME |
896 |
|
|
897 |
/* stable_sort manages lists and vectors */ |
/* stable_sort manages lists and vectors */ |
|
|
|
898 |
SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, |
SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, |
899 |
(SCM items, SCM less), |
(SCM items, SCM less), |
900 |
"Sort the sequence @var{items}, which may be a list or a\n" |
"Sort the sequence @var{items}, which may be a list or a\n" |
902 |
"This is a stable sort.") |
"This is a stable sort.") |
903 |
#define FUNC_NAME s_scm_stable_sort |
#define FUNC_NAME s_scm_stable_sort |
904 |
{ |
{ |
905 |
long len; /* list/vector length */ |
|
906 |
if (SCM_NULL_OR_NIL_P (items)) |
if (SCM_NULL_OR_NIL_P (items)) |
907 |
return items; |
return items; |
908 |
|
|
909 |
SCM_VALIDATE_NIM (2, less); |
SCM_VALIDATE_NIM (2, less); |
910 |
if (SCM_CONSP (items)) |
if (SCM_CONSP (items)) |
911 |
{ |
{ |
912 |
|
long len; /* list/vector length */ |
913 |
SCM_VALIDATE_LIST_COPYLEN (1, items, len); |
SCM_VALIDATE_LIST_COPYLEN (1, items, len); |
914 |
items = scm_list_copy (items); |
items = scm_list_copy (items); |
915 |
return scm_merge_list_step (&items, scm_cmp_function (less), less, len); |
return scm_merge_list_step (&items, scm_cmp_function (less), less, len); |
918 |
/* support ordinary vectors even if arrays not available? */ |
/* support ordinary vectors even if arrays not available? */ |
919 |
else if (SCM_VECTORP (items)) |
else if (SCM_VECTORP (items)) |
920 |
{ |
{ |
921 |
SCM retvec; |
long len = SCM_VECTOR_LENGTH (items); |
922 |
SCM *temp, *vp; |
SCM *temp = malloc (len * sizeof (SCM)); |
923 |
len = SCM_VECTOR_LENGTH (items); |
SCM retvec = scm_make_uve (len, scm_array_prototype (items)); |
|
retvec = scm_make_uve (len, scm_array_prototype (items)); |
|
924 |
scm_array_copy_x (items, retvec); |
scm_array_copy_x (items, retvec); |
|
temp = malloc (len * sizeof (SCM)); |
|
|
|
|
|
/* |
|
|
don't worry about write barrier: retvec is new anyway. |
|
|
*/ |
|
|
vp = SCM_WRITABLE_VELTS (retvec); |
|
925 |
|
|
926 |
scm_merge_vector_step (vp, |
scm_merge_vector_step (retvec, |
927 |
temp, |
temp, |
928 |
scm_cmp_function (less), |
scm_cmp_function (less), |
929 |
less, |
less, |