src/vm/class.c

   1 /* src/vm/class.c - class related functions
   2
   3    Copyright (C) 1996-2005 R. Grafl, A. Krall, C. Kruegel, C. Oates,
   4    R. Obermaisser, M. Platter, M. Probst, S. Ring, E. Steiner,
   5    C. Thalinger, D. Thuernbeck, P. Tomsich, C. Ullrich, J. Wenninger,
   6    Institut f. Computersprachen - TU Wien
   7
   8    This file is part of CACAO.
   9
  10    This program is free software; you can redistribute it and/or
  11    modify it under the terms of the GNU General Public License as
  12    published by the Free Software Foundation; either version 2, or (at
  13    your option) any later version.
  14
  15    This program is distributed in the hope that it will be useful, but
  16    WITHOUT ANY WARRANTY; without even the implied warranty of
  17    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18    General Public License for more details.
  19
  20    You should have received a copy of the GNU General Public License
  21    along with this program; if not, write to the Free Software
  22    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  23    02111-1307, USA.
  24
  25    Contact: cacao@complang.tuwien.ac.at
  26
  27    Authors: Reinhard Grafl
  28
  29    Changes: Mark Probst
  30             Andreas Krall
  31             Christian Thalinger
  32
  33    $Id: class.c 2181 2005-04-01 16:53:33Z edwin $
  34
  35 */
  36
  37 #include <assert.h>
  38 #include <string.h>
  39
  40 #include "vm/global.h"
  41 #include "mm/memory.h"
  42
  43 #if defined(USE_THREADS)
  44 # if defined(NATIVE_THREADS)
  45 #  include "threads/native/threads.h"
  46 # else
  47 #  include "threads/green/threads.h"
  48 #  include "threads/green/locks.h"
  49 # endif
  50 #endif
  51
  52 #include "toolbox/logging.h"
  53 #include "vm/class.h"
  54 #include "vm/options.h"
  55 #include "vm/resolve.h"
  56 #include "vm/statistics.h"
  57 #include "vm/tables.h"
  58 #include "vm/utf8.h"
  59 #include "vm/loader.h"
  60
  61
  62 /******************************************************************************/
  63 /* DEBUG HELPERS                                                              */
  64 /******************************************************************************/
  65
  66 #ifndef NDEBUG
  67 #define CLASS_DEBUG
  68 #endif
  69
  70 #ifdef CLASS_DEBUG
  71 #define CLASS_ASSERT(cond)  assert(cond)
  72 #else
  73 #define CLASS_ASSERT(cond)
  74 #endif
  75
  76
  77 /* global variables ***********************************************************/
  78
  79 hashtable class_hash;                   /* hashtable for classes              */
  80
  81 list unlinkedclasses;                   /* this is only used for eager class  */
  82                                         /* loading                            */
  83
  84
  85 /* frequently used classes ****************************************************/
  86
  87 /* important system classes */
  88
  89 classinfo *class_java_lang_Object;
  90 classinfo *class_java_lang_Class;
  91 classinfo *class_java_lang_ClassLoader;
  92 classinfo *class_java_lang_Cloneable;
  93 classinfo *class_java_lang_SecurityManager;
  94 classinfo *class_java_lang_String;
  95 classinfo *class_java_lang_System;
  96 classinfo *class_java_io_Serializable;
  97
  98
  99 /* system exception classes required in cacao */
 100
 101 classinfo *class_java_lang_Throwable;
 102 classinfo *class_java_lang_VMThrowable;
 103 classinfo *class_java_lang_Exception;
 104 classinfo *class_java_lang_Error;
 105 classinfo *class_java_lang_OutOfMemoryError;
 106 classinfo *class_java_lang_NoClassDefFoundError;
 107
 108 classinfo *class_java_lang_Void;
 109 classinfo *class_java_lang_Boolean;
 110 classinfo *class_java_lang_Byte;
 111 classinfo *class_java_lang_Character;
 112 classinfo *class_java_lang_Short;
 113 classinfo *class_java_lang_Integer;
 114 classinfo *class_java_lang_Long;
 115 classinfo *class_java_lang_Float;
 116 classinfo *class_java_lang_Double;
 117
 118 /* some classes which may be used more often */
 119
 120 classinfo *class_java_util_Vector;
 121
 122
 123 /* pseudo classes for the typechecker */
 124
 125 classinfo *pseudo_class_Arraystub;
 126 classinfo *pseudo_class_Null;
 127 classinfo *pseudo_class_New;
 128
 129
 130 /* class_init ******************************************************************
 131
 132    Initialize the class subsystem.
 133
 134 *******************************************************************************/
 135
 136 void class_init_foo(void)
 137 {
 138         class_java_lang_Object          = class_new_intern(utf_java_lang_Object);
 139
 140         class_java_lang_Class           = class_new(utf_java_lang_Class);
 141         class_java_lang_ClassLoader     = class_new(utf_java_lang_ClassLoader);
 142         class_java_lang_Cloneable       = class_new(utf_java_lang_Cloneable);
 143         class_java_lang_SecurityManager = class_new(utf_java_lang_SecurityManager);
 144         class_java_lang_String          = class_new(utf_java_lang_String);
 145         class_java_lang_System          = class_new(utf_java_lang_System);
 146         class_java_io_Serializable      = class_new(utf_java_io_Serializable);
 147
 148         class_java_lang_Throwable       = class_new(utf_java_lang_Throwable);
 149         class_java_lang_VMThrowable     = class_new(utf_java_lang_VMThrowable);
 150         class_java_lang_Exception       = class_new(utf_java_lang_Exception);
 151         class_java_lang_Error           = class_new(utf_java_lang_Error);
 152
 153         class_java_lang_OutOfMemoryError =
 154                 class_new(utf_java_lang_OutOfMemoryError);
 155
 156         class_java_lang_NoClassDefFoundError =
 157                 class_new(utf_java_lang_NoClassDefFoundError);
 158
 159         class_java_lang_Void            = class_new(utf_java_lang_Void);
 160         class_java_lang_Boolean         = class_new(utf_java_lang_Boolean);
 161         class_java_lang_Byte            = class_new(utf_java_lang_Byte);
 162         class_java_lang_Character       = class_new(utf_java_lang_Character);
 163         class_java_lang_Short           = class_new(utf_java_lang_Short);
 164         class_java_lang_Integer         = class_new(utf_java_lang_Integer);
 165         class_java_lang_Long            = class_new(utf_java_lang_Long);
 166         class_java_lang_Float           = class_new(utf_java_lang_Float);
 167         class_java_lang_Double          = class_new(utf_java_lang_Double);
 168
 169         class_java_util_Vector          = class_new(utf_java_util_Vector);
 170
 171     pseudo_class_Arraystub = class_new_intern(utf_new_char("$ARRAYSTUB$"));
 172         pseudo_class_Null      = class_new_intern(utf_new_char("$NULL$"));
 173         pseudo_class_New       = class_new_intern(utf_new_char("$NEW$"));
 174 }
 175
 176
 177 /* class_new *******************************************************************
 178
 179    Searches for the class with the specified name in the classes
 180    hashtable, if there is no such class a new classinfo structure is
 181    created and inserted into the list of classes to be loaded.
 182
 183 *******************************************************************************/
 184
 185 classinfo *class_new(utf *classname)
 186 {
 187     classinfo *c;
 188
 189 #if defined(USE_THREADS) && defined(NATIVE_THREADS)
 190     tables_lock();
 191 #endif
 192
 193     c = class_new_intern(classname);
 194
 195         /* we support eager class loading and linking on demand */
 196
 197         if (opt_eager) {
 198                 classinfo *tc;
 199                 classinfo *tmp;
 200
 201                 list_init(&unlinkedclasses, OFFSET(classinfo, listnode));
 202
 203                 if (!c->loaded) {
 204                         if (!load_class_bootstrap(c)) {
 205 #if defined(USE_THREADS) && defined(NATIVE_THREADS)
 206                                 tables_unlock();
 207 #endif
 208                                 return c;
 209                         }
 210                 }
 211
 212                 /* link all referenced classes */
 213
 214                 tc = list_first(&unlinkedclasses);
 215
 216                 while (tc) {
 217                         /* skip the current loaded/linked class */
 218                         if (tc != c) {
 219                                 if (!link_class(tc)) {
 220 #if defined(USE_THREADS) && defined(NATIVE_THREADS)
 221                                         tables_unlock();
 222 #endif
 223                                         return c;
 224                                 }
 225                         }
 226
 227                         /* we need a tmp variable here, because list_remove sets prev and
 228                            next to NULL */
 229                         tmp = list_next(&unlinkedclasses, tc);
 230                         list_remove(&unlinkedclasses, tc);
 231                         tc = tmp;
 232                 }
 233
 234                 if (!c->linked) {
 235                         if (!link_class(c)) {
 236 #if defined(USE_THREADS) && defined(NATIVE_THREADS)
 237                                 tables_unlock();
 238 #endif
 239                                 return c;
 240                         }
 241                 }
 242         }
 243
 244 #if defined(USE_THREADS) && defined(NATIVE_THREADS)
 245     tables_unlock();
 246 #endif
 247
 248     return c;
 249 }
 250
 251
 252 classinfo *class_new_intern(utf *classname)
 253 {
 254         classinfo *c;     /* hashtable element */
 255         u4 key;           /* hashkey computed from classname */
 256         u4 slot;          /* slot in hashtable */
 257         u2 i;
 258
 259         key  = utf_hashkey(classname->text, classname->blength);
 260         slot = key & (class_hash.size - 1);
 261         c    = class_hash.ptr[slot];
 262
 263         /* search external hash chain for the class */
 264         while (c) {
 265                 if (c->name->blength == classname->blength) {
 266                         for (i = 0; i < classname->blength; i++)
 267                                 if (classname->text[i] != c->name->text[i]) goto nomatch;
 268
 269                         /* class found in hashtable */
 270                         return c;
 271                 }
 272
 273         nomatch:
 274                 c = c->hashlink; /* next element in external chain */
 275         }
 276
 277         /* location in hashtable found, create new classinfo structure */
 278
 279 #if defined(STATISTICS)
 280         if (opt_stat)
 281                 count_class_infos += sizeof(classinfo);
 282 #endif
 283
 284         if (initverbose) {
 285                 char logtext[MAXLOGTEXT];
 286                 sprintf(logtext, "Creating class: ");
 287                 utf_sprint_classname(logtext + strlen(logtext), classname);
 288                 log_text(logtext);
 289         }
 290
 291         c = GCNEW(classinfo, 1); /*JOWENN: NEW*/
 292         /*c=NEW(classinfo);*/
 293         c->vmClass = 0;
 294         c->flags = 0;
 295         c->name = classname;
 296         c->packagename = NULL;
 297         c->cpcount = 0;
 298         c->cptags = NULL;
 299         c->cpinfos = NULL;
 300         c->classrefs = NULL;
 301         c->extclassrefs = NULL;
 302         c->classrefcount = 0;
 303         c->parseddescs = NULL;
 304         c->parseddescsize = 0;
 305         c->super = NULL;
 306         c->sub = NULL;
 307         c->nextsub = NULL;
 308         c->interfacescount = 0;
 309         c->interfaces = NULL;
 310         c->fieldscount = 0;
 311         c->fields = NULL;
 312         c->methodscount = 0;
 313         c->methods = NULL;
 314         c->linked = false;
 315         c->loaded = false;
 316         c->index = 0;
 317         c->instancesize = 0;
 318         c->header.vftbl = NULL;
 319         c->innerclasscount = 0;
 320         c->innerclass = NULL;
 321         c->vftbl = NULL;
 322         c->initialized = false;
 323         c->initializing = false;
 324         c->classvftbl = false;
 325     c->classUsed = 0;
 326     c->impldBy = NULL;
 327         c->classloader = NULL;
 328         c->sourcefile = NULL;
 329
 330         /* insert class into the hashtable */
 331         c->hashlink = class_hash.ptr[slot];
 332         class_hash.ptr[slot] = c;
 333
 334         /* update number of hashtable-entries */
 335         class_hash.entries++;
 336
 337         if (class_hash.entries > (class_hash.size * 2)) {
 338
 339                 /* reorganization of hashtable, average length of
 340                    the external chains is approx. 2                */
 341
 342                 u4 i;
 343                 classinfo *c;
 344                 hashtable newhash;  /* the new hashtable */
 345
 346                 /* create new hashtable, double the size */
 347                 init_hashtable(&newhash, class_hash.size * 2);
 348                 newhash.entries = class_hash.entries;
 349
 350                 /* transfer elements to new hashtable */
 351                 for (i = 0; i < class_hash.size; i++) {
 352                         c = (classinfo *) class_hash.ptr[i];
 353                         while (c) {
 354                                 classinfo *nextc = c->hashlink;
 355                                 u4 slot = (utf_hashkey(c->name->text, c->name->blength)) & (newhash.size - 1);
 356
 357                                 c->hashlink = newhash.ptr[slot];
 358                                 newhash.ptr[slot] = c;
 359
 360                                 c = nextc;
 361                         }
 362                 }
 363
 364                 /* dispose old table */
 365                 MFREE(class_hash.ptr, void*, class_hash.size);
 366                 class_hash = newhash;
 367         }
 368
 369         /* Array classes need further initialization. */
 370         if (c->name->text[0] == '[') {
 371                 /* Array classes are not loaded from classfiles. */
 372                 c->loaded = true;
 373                 class_new_array(c);
 374                 c->packagename = array_packagename;
 375
 376         } else {
 377                 /* Find the package name */
 378                 /* Classes in the unnamed package keep packagename == NULL. */
 379                 char *p = utf_end(c->name) - 1;
 380                 char *start = c->name->text;
 381                 for (;p > start; --p) {
 382                         if (*p == '/') {
 383                                 c->packagename = utf_new (start, p - start);
 384                                 break;
 385                         }
 386                 }
 387         }
 388
 389 #if defined(USE_THREADS) && defined(NATIVE_THREADS)
 390         initObjectLock(&c->header);
 391 #endif
 392
 393         return c;
 394 }
 395
 396
 397 /* class_get *******************************************************************
 398
 399    Searches for the class with the specified name in the classes
 400    hashtable if there is no such class NULL is returned.
 401
 402 *******************************************************************************/
 403
 404 classinfo *class_get(utf *classname)
 405 {
 406         classinfo *c;  /* hashtable element */
 407         u4 key;        /* hashkey computed from classname */
 408         u4 slot;       /* slot in hashtable */
 409         u2 i;
 410
 411         key  = utf_hashkey(classname->text, classname->blength);
 412         slot = key & (class_hash.size-1);
 413         c    = class_hash.ptr[slot];
 414
 415         /* search external hash-chain */
 416         while (c) {
 417                 if (c->name->blength == classname->blength) {
 418                         /* compare classnames */
 419                         for (i = 0; i < classname->blength; i++)
 420                                 if (classname->text[i] != c->name->text[i])
 421                                         goto nomatch;
 422
 423                         /* class found in hashtable */
 424                         return c;
 425                 }
 426
 427         nomatch:
 428                 c = c->hashlink;
 429         }
 430
 431         /* class not found */
 432         return NULL;
 433 }
 434
 435
 436 /* class_remove ****************************************************************
 437
 438    Removes the class entry wth the specified name in the classes
 439    hashtable, furthermore the class' resources are freed if there is
 440    no such class false is returned.
 441
 442 *******************************************************************************/
 443
 444 bool class_remove(classinfo *c)
 445 {
 446         classinfo *tc;                      /* hashtable element                  */
 447         classinfo *pc;
 448         u4 key;                             /* hashkey computed from classname    */
 449         u4 slot;                            /* slot in hashtable                  */
 450         u2 i;
 451
 452         key  = utf_hashkey(c->name->text, c->name->blength);
 453         slot = key & (class_hash.size - 1);
 454         tc   = class_hash.ptr[slot];
 455         pc   = NULL;
 456
 457         /* search external hash-chain */
 458         while (tc) {
 459                 if (tc->name->blength == c->name->blength) {
 460
 461                         /* compare classnames */
 462                         for (i = 0; i < c->name->blength; i++)
 463                                 if (tc->name->text[i] != c->name->text[i])
 464                                         goto nomatch;
 465
 466                         /* class found in hashtable */
 467                         if (!pc)
 468                                 class_hash.ptr[slot] = tc->hashlink;
 469                         else
 470                                 pc->hashlink = tc->hashlink;
 471
 472                         class_free(tc);
 473
 474                         return true;
 475                 }
 476
 477         nomatch:
 478                 pc = tc;
 479                 tc = tc->hashlink;
 480         }
 481
 482         /* class not found */
 483         return false;
 484 }
 485
 486
 487 /* class_freepool **************************************************************
 488
 489         Frees all resources used by this classes Constant Pool.
 490
 491 *******************************************************************************/
 492
 493 static void class_freecpool(classinfo *c)
 494 {
 495         u4 idx;
 496         u4 tag;
 497         voidptr info;
 498
 499         if (c->cptags && c->cpinfos) {
 500                 for (idx = 0; idx < c->cpcount; idx++) {
 501                         tag = c->cptags[idx];
 502                         info = c->cpinfos[idx];
 503
 504                         if (info != NULL) {
 505                                 switch (tag) {
 506                                 case CONSTANT_Fieldref:
 507                                 case CONSTANT_Methodref:
 508                                 case CONSTANT_InterfaceMethodref:
 509                                         FREE(info, constant_FMIref);
 510                                         break;
 511                                 case CONSTANT_Integer:
 512                                         FREE(info, constant_integer);
 513                                         break;
 514                                 case CONSTANT_Float:
 515                                         FREE(info, constant_float);
 516                                         break;
 517                                 case CONSTANT_Long:
 518                                         FREE(info, constant_long);
 519                                         break;
 520                                 case CONSTANT_Double:
 521                                         FREE(info, constant_double);
 522                                         break;
 523                                 case CONSTANT_NameAndType:
 524                                         FREE(info, constant_nameandtype);
 525                                         break;
 526                                 }
 527                         }
 528                 }
 529         }
 530
 531         if (c->cptags)
 532                 MFREE(c->cptags, u1, c->cpcount);
 533
 534         if (c->cpinfos)
 535                 MFREE(c->cpinfos, voidptr, c->cpcount);
 536 }
 537
 538
 539 /* class_free ******************************************************************
 540
 541    Frees all resources used by the class.
 542
 543 *******************************************************************************/
 544
 545 void class_free(classinfo *c)
 546 {
 547         s4 i;
 548         vftbl_t *v;
 549
 550         class_freecpool(c);
 551
 552         if (c->interfaces)
 553                 MFREE(c->interfaces, classinfo*, c->interfacescount);
 554
 555         if (c->fields) {
 556                 for (i = 0; i < c->fieldscount; i++)
 557                         field_free(&(c->fields[i]));
 558 /*      MFREE(c->fields, fieldinfo, c->fieldscount); */
 559         }
 560
 561         if (c->methods) {
 562                 for (i = 0; i < c->methodscount; i++)
 563                         method_free(&(c->methods[i]));
 564                 MFREE(c->methods, methodinfo, c->methodscount);
 565         }
 566
 567         if ((v = c->vftbl) != NULL) {
 568                 if (v->arraydesc)
 569                         mem_free(v->arraydesc,sizeof(arraydescriptor));
 570
 571                 for (i = 0; i < v->interfacetablelength; i++) {
 572                         MFREE(v->interfacetable[-i], methodptr, v->interfacevftbllength[i]);
 573                 }
 574                 MFREE(v->interfacevftbllength, s4, v->interfacetablelength);
 575
 576                 i = sizeof(vftbl_t) + sizeof(methodptr) * (v->vftbllength - 1) +
 577                     sizeof(methodptr*) * (v->interfacetablelength -
 578                                          (v->interfacetablelength > 0));
 579                 v = (vftbl_t*) (((methodptr*) v) -
 580                                                 (v->interfacetablelength - 1) * (v->interfacetablelength > 1));
 581                 mem_free(v, i);
 582         }
 583
 584         if (c->innerclass)
 585                 MFREE(c->innerclass, innerclassinfo, c->innerclasscount);
 586
 587         /*      if (c->classvftbl)
 588                 mem_free(c->header.vftbl, sizeof(vftbl) + sizeof(methodptr)*(c->vftbl->vftbllength-1)); */
 589
 590 /*      GCFREE(c); */
 591 }
 592
 593
 594 /* class_array_of **************************************************************
 595
 596    Returns an array class with the given component class. The array
 597    class is dynamically created if neccessary.
 598
 599 *******************************************************************************/
 600
 601 classinfo *class_array_of(classinfo *component)
 602 {
 603     s4 namelen;
 604     char *namebuf;
 605         classinfo *c;
 606
 607     /* Assemble the array class name */
 608     namelen = component->name->blength;
 609
 610     if (component->name->text[0] == '[') {
 611         /* the component is itself an array */
 612         namebuf = DMNEW(char, namelen + 1);
 613         namebuf[0] = '[';
 614         MCOPY(namebuf + 1, component->name->text, char, namelen);
 615         namelen++;
 616
 617     } else {
 618         /* the component is a non-array class */
 619         namebuf = DMNEW(char, namelen + 3);
 620         namebuf[0] = '[';
 621         namebuf[1] = 'L';
 622         MCOPY(namebuf + 2, component->name->text, char, namelen);
 623         namebuf[2 + namelen] = ';';
 624         namelen += 3;
 625     }
 626
 627         c = class_new(utf_new(namebuf, namelen));
 628
 629         /* load this class and link it */
 630
 631         c->loaded = true;
 632
 633         if (!c->linked)
 634                 if (!link_class(c))
 635                         return NULL;
 636
 637     return c;
 638 }
 639
 640
 641 /* class_multiarray_of *********************************************************
 642
 643    Returns an array class with the given dimension and element class.
 644    The array class is dynamically created if neccessary.
 645
 646 *******************************************************************************/
 647
 648 classinfo *class_multiarray_of(s4 dim, classinfo *element)
 649 {
 650     s4 namelen;
 651     char *namebuf;
 652
 653         if (dim < 1)
 654                 panic("Invalid array dimension requested");
 655
 656     /* Assemble the array class name */
 657     namelen = element->name->blength;
 658
 659     if (element->name->text[0] == '[') {
 660         /* the element is itself an array */
 661         namebuf = DMNEW(char, namelen + dim);
 662         memcpy(namebuf + dim, element->name->text, namelen);
 663         namelen += dim;
 664     }
 665     else {
 666         /* the element is a non-array class */
 667         namebuf = DMNEW(char, namelen + 2 + dim);
 668         namebuf[dim] = 'L';
 669         memcpy(namebuf + dim + 1, element->name->text, namelen);
 670         namelen += (2 + dim);
 671         namebuf[namelen - 1] = ';';
 672     }
 673         memset(namebuf, '[', dim);
 674
 675     return class_new(utf_new(namebuf, namelen));
 676 }
 677
 678 /* class_lookup_classref *******************************************************
 679
 680    Looks up the constant_classref for a given classname in the classref
 681    tables of a class.
 682
 683    IN:
 684        cls..............the class containing the reference
 685            name.............the name of the class refered to
 686
 687     RETURN VALUE:
 688            a pointer to a constant_classref, or
 689            NULL if the reference was not found
 690
 691 *******************************************************************************/
 692
 693 constant_classref *class_lookup_classref(classinfo *cls,utf *name)
 694 {
 695         constant_classref *ref;
 696         extra_classref *xref;
 697         int count;
 698
 699         CLASS_ASSERT(cls);
 700         CLASS_ASSERT(name);
 701         CLASS_ASSERT(!cls->classrefcount || cls->classrefs);
 702
 703         /* first search the main classref table */
 704         count = cls->classrefcount;
 705         ref = cls->classrefs;
 706         for (; count; --count, ++ref)
 707                 if (ref->name == name)
 708                         return ref;
 709
 710         /* next try the list of extra classrefs */
 711         for (xref=cls->extclassrefs; xref; xref=xref->next) {
 712                 if (xref->classref.name == name)
 713                         return &(xref->classref);
 714         }
 715
 716         /* not found */
 717         return NULL;
 718 }
 719
 720
 721 /* class_get_classref **********************************************************
 722
 723    Returns the constant_classref for a given classname.
 724
 725    IN:
 726        cls..............the class containing the reference
 727            name.............the name of the class refered to
 728
 729    RETURN VALUE:
 730        a pointer to a constant_classref (never NULL)
 731
 732    NOTE:
 733        The given name is not checked for validity!
 734
 735 *******************************************************************************/
 736
 737 constant_classref *class_get_classref(classinfo *cls,utf *name)
 738 {
 739         constant_classref *ref;
 740         extra_classref *xref;
 741
 742         CLASS_ASSERT(cls);
 743         CLASS_ASSERT(name);
 744
 745         ref = class_lookup_classref(cls,name);
 746         if (ref)
 747                 return ref;
 748
 749         xref = NEW(extra_classref);
 750         CLASSREF_INIT(xref->classref,cls,name);
 751
 752         xref->next = cls->extclassrefs;
 753         cls->extclassrefs = xref;
 754
 755         return &(xref->classref);
 756 }
 757
 758 /* class_get_classref_multiarray_of ********************************************
 759
 760    Returns an array type reference with the given dimension and element class
 761    reference.
 762
 763    IN:
 764        dim..............the requested dimension
 765                             dim must be in [1;255]. This is NOT checked!
 766            ref..............the component class reference
 767
 768    RETURN VALUE:
 769        a pointer to the class reference for the array type
 770
 771    NOTE:
 772        The referer of `ref` is used as the referer for the new classref.
 773
 774 *******************************************************************************/
 775
 776 constant_classref *class_get_classref_multiarray_of(s4 dim,constant_classref *ref)
 777 {
 778     s4 namelen;
 779     char *namebuf;
 780
 781         CLASS_ASSERT(ref);
 782         CLASS_ASSERT(dim >= 1 && dim <= 255);
 783
 784     /* Assemble the array class name */
 785     namelen = ref->name->blength;
 786
 787     if (ref->name->text[0] == '[') {
 788         /* the element is itself an array */
 789         namebuf = DMNEW(char, namelen + dim);
 790         memcpy(namebuf + dim, ref->name->text, namelen);
 791         namelen += dim;
 792     }
 793     else {
 794         /* the element is a non-array class */
 795         namebuf = DMNEW(char, namelen + 2 + dim);
 796         namebuf[dim] = 'L';
 797         memcpy(namebuf + dim + 1, ref->name->text, namelen);
 798         namelen += (2 + dim);
 799         namebuf[namelen - 1] = ';';
 800     }
 801         memset(namebuf, '[', dim);
 802
 803     return class_get_classref(ref->referer,utf_new(namebuf, namelen));
 804 }
 805
 806 /* class_get_classref_component_of *********************************************
 807
 808    Returns the component classref of a given array type reference
 809
 810    IN:
 811        ref..............the array type reference
 812
 813    RETURN VALUE:
 814        a reference to the component class, or
 815            NULL if `ref` is not an object array type reference
 816
 817    NOTE:
 818        The referer of `ref` is used as the referer for the new classref.
 819
 820 *******************************************************************************/
 821
 822 constant_classref *class_get_classref_component_of(constant_classref *ref)
 823 {
 824         s4 namelen;
 825         char *name;
 826
 827         CLASS_ASSERT(ref);
 828
 829         name = ref->name->text;
 830         if (*name++ != '[')
 831                 return NULL;
 832
 833         namelen = ref->name->blength - 1;
 834         if (*name == 'L') {
 835                 name++;
 836                 namelen -= 2;
 837         }
 838         else if (*name != '[') {
 839                 return NULL;
 840         }
 841
 842     return class_get_classref(ref->referer,utf_new(name, namelen));
 843 }
 844
 845
 846 /*
 847  * These are local overrides for various environment variables in Emacs.
 848  * Please do not remove this and leave it at the end of the file, where
 849  * Emacs will automagically detect them.
 850  * ---------------------------------------------------------------------
 851  * Local variables:
 852  * mode: c
 853  * indent-tabs-mode: t
 854  * c-basic-offset: 4
 855  * tab-width: 4
 856  * End:
 857  */