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