/[guile]/guile/guile-core/libguile/sort.c
ViewVC logotype

Diff of /guile/guile-core/libguile/sort.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.42 by xxhanwen, Sat Jul 20 14:08:34 2002 UTC revision 1.43 by xxhanwen, Sun Jul 21 17:46:23 2002 UTC
# Line 437  SCM_DEFINE (scm_restricted_vector_sort_x Line 437  SCM_DEFINE (scm_restricted_vector_sort_x
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; */
# Line 784  SCM_DEFINE (scm_sort, "sort", 2, 0, 0, Line 783  SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
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,
# Line 860  SCM_DEFINE (scm_stable_sort_x, "stable-s Line 871  SCM_DEFINE (scm_stable_sort_x, "stable-s
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,
# Line 886  SCM_DEFINE (scm_stable_sort_x, "stable-s Line 895  SCM_DEFINE (scm_stable_sort_x, "stable-s
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"
# Line 894  SCM_DEFINE (scm_stable_sort, "stable-sor Line 902  SCM_DEFINE (scm_stable_sort, "stable-sor
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);
# Line 909  SCM_DEFINE (scm_stable_sort, "stable-sor Line 918  SCM_DEFINE (scm_stable_sort, "stable-sor
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,

Legend:
Removed from v.1.42  
changed lines
  Added in v.1.43

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26