← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/c/alloc.d

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-06-21 09:21:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060621092121-txz1f21lj0wh0f67
Tags: 0.9h-20060617-1
* New upstream version
* Updated standards version without real changes. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/c/alloc.d
297
297
          obj->array.elttype = (short)aet_object;
298
298
          obj->array.self.t = NULL;
299
299
          break;
 
300
#ifdef ECL_UNICODE
 
301
        case t_string:
 
302
#endif
300
303
        case t_vector:
301
304
          obj->array.displaced = Cnil;
302
305
          obj->array.elttype = (short)aet_object;
303
306
          obj->array.self.t = NULL;
304
307
          break;
305
 
        case t_string:
306
 
          obj->string.displaced = Cnil;
307
 
          obj->string.self = NULL;
 
308
        case t_base_string:
 
309
          obj->base_string.displaced = Cnil;
 
310
          obj->base_string.self = NULL;
308
311
          break;
309
312
        case t_bitvector:
310
313
          obj->vector.displaced = Cnil;
417
420
                goto ONCE_MORE;
418
421
        }
419
422
        GC_disable();
420
 
        { cl_object s = make_simple_string(tm_table[(int)t].tm_name+1);
 
423
        { cl_object s = make_simple_base_string(tm_table[(int)t].tm_name+1);
421
424
        GC_enable();
422
425
        CEerror("The storage for ~A is exhausted.~%\
423
426
Currently, ~D pages are allocated.~%\
689
692
        init_tm(t_longfloat, "LLONG-FLOAT", /* 16 */
690
693
                sizeof(struct ecl_longfloat), 1);
691
694
        init_tm(t_bytecodes, "bBYTECODES", sizeof(struct ecl_bytecodes), 64);
692
 
        init_tm(t_string, "\"STRING", sizeof(struct ecl_string), 64); /* 20 */
 
695
        init_tm(t_base_string, "\"BASE-STRING", sizeof(struct ecl_base_string), 64); /* 20 */
 
696
#ifdef ECL_UNICODE
 
697
        init_tm(t_string, "\"STRING", sizeof(struct ecl_string), 64);
 
698
#endif
693
699
        init_tm(t_array, "aARRAY", sizeof(struct ecl_array), 64); /* 24 */
694
700
        init_tm(t_pathname, "pPATHNAME", sizeof(struct ecl_pathname), 1); /* 28 */
695
701
        init_tm(t_symbol, "|SYMBOL", sizeof(struct ecl_symbol), 64); /* 32 */
735
741
   for (t = (int)t_start ; t < (int)t_end ; t++) {
736
742
     struct typemanager *tm = &tm_table[t];
737
743
     if (tm->tm_name &&
738
 
         strncmp((tm->tm_name)+1, type->string.self, type->string.fillp) == 0)
 
744
         strncmp((tm->tm_name)+1, type->base_string.self, type->base_string.fillp) == 0)
739
745
       return(t);
740
746
   }
741
747
   FEerror("Unrecognized type", 0);
755
761
        if (available_pages() < tm->tm_maxpage - tm->tm_npage ||
756
762
            (pp = alloc_page(tm->tm_maxpage - tm->tm_npage)) == NULL)
757
763
          FEerror("Can't allocate ~D pages for ~A.", 2, type,
758
 
                  make_constant_string(tm->tm_name+1));
 
764
                  make_constant_base_string(tm->tm_name+1));
759
765
        for (;  tm->tm_npage < tm->tm_maxpage;  pp += LISP_PAGESIZE)
760
766
          add_page_to_freelist(pp, tm);
761
767
        @(return Ct)
849
855
  if (!GC_enabled() && !alloc_initialized)
850
856
    init_alloc();
851
857
 
852
 
  x = alloc_simple_string(size-1);
853
 
  x->string.self = (char *)cl_alloc(size);
 
858
  x = alloc_simple_base_string(size-1);
 
859
  x->base_string.self = (char *)cl_alloc(size);
854
860
  malloc_list = make_cons(x, malloc_list);
855
 
  return(x->string.self);
 
861
  return(x->base_string.self);
856
862
}
857
863
 
858
864
void
862
868
 
863
869
  if (ptr) {
864
870
    for (p = &malloc_list;  !endp(*p);  p = &(CDR((*p))))
865
 
      if ((CAR((*p)))->string.self == ptr) {
866
 
        cl_dealloc(CAR((*p))->string.self, CAR((*p))->string.dim+1);
867
 
        CAR((*p))->string.self = NULL;
 
871
      if ((CAR((*p)))->base_string.self == ptr) {
 
872
        cl_dealloc(CAR((*p))->base_string.self, CAR((*p))->base_string.dim+1);
 
873
        CAR((*p))->base_string.self = NULL;
868
874
        *p = CDR((*p));
869
875
        return;
870
876
      }
881
887
  if (ptr == NULL)
882
888
    return malloc(size);
883
889
  for (x = malloc_list;  !endp(x);  x = CDR(x))
884
 
    if (CAR(x)->string.self == ptr) {
 
890
    if (CAR(x)->base_string.self == ptr) {
885
891
      x = CAR(x);
886
 
      if (x->string.dim >= size) {
887
 
        x->string.fillp = size;
 
892
      if (x->base_string.dim >= size) {
 
893
        x->base_string.fillp = size;
888
894
        return(ptr);
889
895
      } else {
890
 
        j = x->string.dim;
891
 
        x->string.self = (char *)cl_alloc(size);
892
 
        x->string.fillp = x->string.dim = size;
893
 
        memcpy(x->string.self, ptr, j);
 
896
        j = x->base_string.dim;
 
897
        x->base_string.self = (char *)cl_alloc(size);
 
898
        x->base_string.fillp = x->base_string.dim = size;
 
899
        memcpy(x->base_string.self, ptr, j);
894
900
        cl_dealloc(ptr, j);
895
 
        return(x->string.self);
 
901
        return(x->base_string.self);
896
902
      }
897
903
    }
898
904
  FEerror("realloc(3) error.", 0);
925
931
 
926
932
void *
927
933
memalign(size_t align, size_t size)
928
 
{ cl_object x = alloc_simple_string(size);
 
934
{ cl_object x = alloc_simple_base_string(size);
929
935
  malloc_list = make_cons(x, malloc_list);
930
 
  return x->string.self;
 
936
  return x->base_string.self;
931
937
}
932
938
 
933
939
# ifdef WANT_VALLOC