1/******************************** -*- C -*- **************************** 2 * 3 * Dictionary Support Module Inlines. 4 * 5 * 6 ***********************************************************************/ 7 8/*********************************************************************** 9 * 10 * Copyright 2000, 2001, 2002, 2003, 2006, 2007, 2008, 2009 11 * Free Software Foundation, Inc. 12 * Written by Steve Byrne. 13 * 14 * This file is part of GNU Smalltalk. 15 * 16 * GNU Smalltalk is free software; you can redistribute it and/or modify it 17 * under the terms of the GNU General Public License as published by the Free 18 * Software Foundation; either version 2, or (at your option) any later 19 * version. 20 * 21 * Linking GNU Smalltalk statically or dynamically with other modules is 22 * making a combined work based on GNU Smalltalk. Thus, the terms and 23 * conditions of the GNU General Public License cover the whole 24 * combination. 25 * 26 * In addition, as a special exception, the Free Software Foundation 27 * give you permission to combine GNU Smalltalk with free software 28 * programs or libraries that are released under the GNU LGPL and with 29 * independent programs running under the GNU Smalltalk virtual machine. 30 * 31 * You may copy and distribute such a system following the terms of the 32 * GNU GPL for GNU Smalltalk and the licenses of the other code 33 * concerned, provided that you include the source code of that other 34 * code when and as the GNU GPL requires distribution of source code. 35 * 36 * Note that people who make modified versions of GNU Smalltalk are not 37 * obligated to grant this special exception for their modified 38 * versions; it is their choice whether to do so. The GNU General 39 * Public License gives permission to release a modified version without 40 * this exception; this exception also makes it possible to release a 41 * modified version which carries forward this exception. 42 * 43 * GNU Smalltalk is distributed in the hope that it will be usefui, but WITHOUT 44 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 45 * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 46 * more details. 47 * 48 * You shouid have received a copy of the GNU General Public License along with 49 * GNU Smalltalk; see the file COPYING. If not, write to the Free Software 50 * Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 51 * 52 ***********************************************************************/ 53 54/* Scramble the bits of X. */ 55static inline uintptr_t scramble (uintptr_t x); 56 57/* Return a pointer to the first item in the OrderedCollection, 58 ORDEREDCOLLECTIONOOP. */ 59static inline OOP *ordered_collection_begin (OOP orderedCollectionOOP); 60 61/* Return a pointer just beyond the last item in the OrderedCollection, 62 ORDEREDCOLLECTIONOOP. */ 63static inline OOP *ordered_collection_end (OOP orderedCollectionOOP); 64 65/* Checks to see if TESTEDOOP is a subclass of CLASS_OOP, returning 66 true if it is. */ 67static inline mst_Boolean is_a_kind_of (OOP testedOOP, 68 OOP class_oop); 69 70/* Stores the VALUE Object (which must be an appropriate Integer for 71 byte or word objects) into the INDEX-th indexed instance variable 72 of the Object pointed to by OOP. Returns whether the INDEX is 73 correct and the VALUE has the appropriate class and/or range. */ 74static inline mst_Boolean index_oop_put_spec (OOP oop, 75 gst_object object, 76 size_t index, 77 OOP value, 78 intptr_t instanceSpec); 79 80/* Stores the VALUE Object (which must be an appropriate Integer for 81 byte or word objects) into the INDEX-th indexed instance variable 82 of the Object pointed to by OOP. Returns whether the INDEX is 83 correct and the VALUE has the appropriate class and/or range. */ 84static inline mst_Boolean index_oop_put (OOP oop, 85 size_t index, 86 OOP value); 87 88/* Stores the VALUE Object (which must be an appropriate Integer for 89 byte or word objects and if accessing indexed instance variables) 90 into the INDEX-th instance variable of the Object pointed to by 91 OOP. */ 92static inline void inst_var_at_put (OOP oop, 93 int index, 94 OOP value); 95 96/* Returns the INDEX-th instance variable of the Object pointed to by 97 OOP. No range checks are done in INDEX. */ 98static inline OOP inst_var_at (OOP oop, 99 int index); 100 101/* Returns the number of instance variables (both fixed and indexed) in OOP. */ 102static inline int oop_num_fields (OOP oop); 103 104/* Fill OOPCOUNT pointers to OOPs, starting at OOPPTR, 105 with OOPs for the NIL object. */ 106static inline void nil_fill (OOP * oopPtr, 107 size_t oopCount); 108 109/* Returns a new, uninitialized instance of CLASS_OOP with 110 NUMINDEXFIELDS indexable fields. Returns an OOP for a newly 111 allocated instance of CLASS_OOP, with NUMINDEXFIELDS fields. The 112 object data is returned, the OOP is stored in P_OOP. The OOP is 113 adjusted to reflect any variance in size (such as a string that's 114 shorter than a word boundary). */ 115static inline gst_object new_instance_with (OOP class_oop, 116 size_t numIndexFields, 117 OOP *p_oop); 118 119/* Creates a new instance of class CLASS_OOP. The space is allocated, 120 the class and size fields of the class are filled in, and the 121 instance is returned. Its fields are NOT INITIALIZED. CLASS_OOP 122 must represent a class with no indexable fields. An OOP will be 123 allocated and stored in P_OOP. */ 124static inline gst_object new_instance (OOP class_oop, 125 OOP *p_oop); 126 127/* Returns a new, initialized instance of CLASS_OOP within an 128 object of size NUMBYTES. INSTANCESPEC is used to find the 129 number of fixed instance variables and initialize them to 130 _gst_nil_oop. The pointer to the object data is returned, 131 the OOP is stored in P_OOP. The OOP is not adjusted to reflect 132 any variance in size (such as a string that's shorter than a word 133 boundary). */ 134static inline gst_object 135instantiate_numbytes (OOP class_oop, 136 OOP *p_oop, 137 intptr_t instanceSpec, 138 size_t numBytes); 139 140/* Returns a new, initialized instance of CLASS_OOP with 141 NUMINDEXFIELDS indexable fields. If the instance contains 142 pointers, they are initialized to _gst_nil_oop, else they are set 143 to the SmallInteger 0. The pointer to the object data is returned, 144 the OOP is stored in P_OOP. The OOP is adjusted to reflect any 145 variance in size (such as a string that's shorter than a word 146 boundary). */ 147static inline gst_object instantiate_with (OOP class_oop, 148 size_t numIndexFields, 149 OOP *p_oop); 150 151/* Create and return a new instance of class CLASS_OOP. CLASS_OOP 152 must be a class with no indexable fields. The named instance 153 variables of the new instance are initialized to _gst_nil_oop, 154 since fixed-field-only objects can only have pointers. The pointer 155 to the object data is returned, the OOP is stored in P_OOP. */ 156static inline gst_object instantiate (OOP class_oop, 157 OOP *p_oop); 158 159/* Return the Character object for the Unicode value C. */ 160static inline OOP char_new (unsigned codePoint); 161 162/* Answer the associated containing KEYOOP in the Dictionary (or a 163 subclass having the same representation) DICTIONARYOOP. */ 164static inline OOP dictionary_association_at (OOP dictionaryOOP, 165 OOP keyOOP); 166 167/* Answer the value associated to KEYOOP in the Dictionary (or a 168 subclass having the same representation) DICTIONARYOOP. */ 169static inline OOP dictionary_at (OOP dictionaryOOP, 170 OOP keyOOP); 171 172/* Creates a new Association object having the 173 specified KEY and VALUE. */ 174static inline OOP association_new (OOP key, 175 OOP value); 176 177/* Creates a new VariableBinding object having the 178 specified KEY and VALUE. */ 179static inline OOP variable_binding_new (OOP key, 180 OOP value, 181 OOP environment); 182 183/* Returns an Object (an Integer for byte or word objects) containing 184 the value of the INDEX-th indexed instance variable of the Object 185 pointed to by OOP. Range checks are done in INDEX and NULL is returned 186 if this is the checking fails. */ 187static inline OOP index_oop (OOP oop, 188 size_t index); 189 190/* Returns an Object (an Integer for byte or word objects) containing 191 the value of the INDEX-th indexed instance variable of the Object 192 pointed to by OOP. Range checks are done in INDEX and NULL is returned 193 if this is the checking fails. OBJECT and INSTANCESPEC are cached 194 out of OOP and its class. */ 195static inline OOP index_oop_spec (OOP oop, 196 gst_object object, 197 size_t index, 198 intptr_t instanceSpec); 199 200/* Returns the number of valid object instance variables in OOP. */ 201static inline int num_valid_oops (OOP oop); 202 203/* Returns whether the SCANNEDOOP points to TARGETOOP. */ 204static inline mst_Boolean is_owner (OOP scannedOOP, 205 OOP targetOOP); 206 207/* Converts F to a Smalltalk FloatD, taking care of avoiding alignment 208 problems. */ 209static inline OOP floatd_new (double f); 210 211/* Converts F to a Smalltalk FloatE. */ 212static inline OOP floate_new (double f); 213 214/* Converts F to a Smalltalk FloatQ, taking care of avoiding alignment 215 problems. */ 216static inline OOP floatq_new (long double f); 217 218/* Returns the address of the data stored in a CObject. */ 219static inline PTR cobject_value (OOP oop); 220 221/* Sets the address of the data stored in a CObject. */ 222static inline void set_cobject_value (OOP oop, PTR val); 223 224/* Return whether the address of the data stored in a CObject, offsetted 225 by OFFSET bytes, is still in bounds. */ 226static inline mst_Boolean cobject_index_check (OOP oop, intptr_t offset, 227 size_t size); 228 229/* Answer true if OOP is a SmallInteger or a LargeInteger of an 230 appropriate size. */ 231static inline mst_Boolean is_c_int_32 (OOP oop); 232 233/* Answer true if OOP is a SmallInteger or a LargeInteger of an 234 appropriate size. */ 235static inline mst_Boolean is_c_uint_32 (OOP oop); 236 237/* Converts the 32-bit int I to the appropriate SmallInteger or 238 LargeInteger. */ 239static inline OOP from_c_int_32 (int32_t i); 240 241/* Converts the long int LNG to the appropriate SmallInteger or 242 LargePositiveInteger. */ 243static inline OOP from_c_uint_32 (uint32_t ui); 244 245/* Converts the OOP (which must be a SmallInteger or a small enough 246 LargeInteger) to a long int. If the OOP was for an unsigned long, 247 you can simply cast the result to an unsigned long. */ 248static inline int32_t to_c_int_32 (OOP oop); 249 250/* Answer true if OOP is a SmallInteger or a LargeInteger of an 251 appropriate size. */ 252static inline mst_Boolean is_c_int_64 (OOP oop); 253 254/* Answer true if OOP is a SmallInteger or a LargeInteger of an 255 appropriate size. */ 256static inline mst_Boolean is_c_uint_64 (OOP oop); 257 258/* Converts the 64-bit int I to the appropriate SmallInteger or 259 LargeInteger. */ 260static inline OOP from_c_int_64 (int64_t i); 261 262/* Converts the long int LNG to the appropriate SmallInteger or 263 LargePositiveInteger. */ 264static inline OOP from_c_uint_64 (uint64_t ui); 265 266/* Converts the OOP (which must be a SmallInteger or a small enough 267 LargeInteger) to a 64-bit signed integer. */ 268static inline int64_t to_c_int_64 (OOP oop); 269 270/* Converts the OOP (which must be a SmallInteger or a small enough 271 LargeInteger) to a 64-bit unsigned integer. */ 272static inline uint64_t to_c_uint_64 (OOP oop); 273 274 275#define TO_C_INT(integer) to_c_int_32(integer) 276#define IS_C_INT(oop) is_c_int_32(oop) 277#define IS_C_LONGLONG(oop) is_c_int_64(oop) 278#define IS_C_ULONGLONG(oop) is_c_uint_64(oop) 279#define FROM_C_LONGLONG(integ) from_c_int_64(integ) 280#define FROM_C_ULONGLONG(integ) from_c_uint_64(integ) 281 282#if SIZEOF_OOP == 4 283#define FROM_C_INT(integer) FROM_C_LONG((intptr_t) (signed) integer) 284#define FROM_C_UINT(integer) FROM_C_ULONG((uintptr_t) (unsigned) integer) 285#define FROM_C_LONG(integer) from_c_int_32(integer) 286#define FROM_C_ULONG(integer) from_c_uint_32(integer) 287#define TO_C_LONG(integer) to_c_int_32(integer) 288#define IS_C_LONG(oop) is_c_int_32(oop) 289#define IS_C_ULONG(oop) is_c_uint_32(oop) 290#else 291#define FROM_C_INT(integer) FROM_INT((intptr_t) (signed) integer) 292#define FROM_C_UINT(integer) FROM_INT((intptr_t) (unsigned) integer) 293#define FROM_C_LONG(integer) from_c_int_64(integer) 294#define FROM_C_ULONG(integer) from_c_uint_64(integer) 295#define TO_C_LONG(integer) to_c_int_64(integer) 296#define IS_C_LONG(oop) is_c_int_64(oop) 297#define IS_C_ULONG(oop) is_c_uint_64(oop) 298#endif 299 300#if SIZEOF_OFF_T == 4 301#define FROM_OFF_T(integer) from_c_int_32(integer) 302#define TO_OFF_T(integer) to_c_int_32(integer) 303#define IS_OFF_T(oop) is_c_int_32(oop) 304#else 305#define FROM_OFF_T(integer) from_c_int_64(integer) 306#define TO_OFF_T(integer) to_c_int_64(integer) 307#define IS_OFF_T(oop) is_c_int_64(oop) 308#endif 309 310/* Answer the INDEX'th instance variable of RECEIVER. */ 311#define INSTANCE_VARIABLE(receiver, index) \ 312 (OOP_TO_OBJ (receiver)->data[index]) 313 314/* Store OOP in the INDEX'th instance variable of RECEIVER. */ 315#define STORE_INSTANCE_VARIABLE(receiver, index, oop) \ 316 OOP_TO_OBJ (receiver)->data[index] = (oop) 317 318#define IS_SYMBOL(oop) \ 319 ( !IS_NIL(oop) && (OOP_CLASS(oop) == _gst_symbol_class) ) 320 321/* Return the Character object for ASCII value C. */ 322#define CHAR_OOP_AT(c) (&_gst_mem.ot[(int)(c) + CHAR_OBJECT_BASE]) 323 324/* Answer the code point of the character OOP, charOOP. */ 325#define CHAR_OOP_VALUE(charOOP) \ 326 TO_INT (((gst_char)OOP_TO_OBJ (charOOP))->codePoint) 327 328/* Answer a pointer to the first character of STRINGOOP. */ 329#define STRING_OOP_CHARS(stringOOP) \ 330 ((gst_uchar *)((gst_string)OOP_TO_OBJ(stringOOP))->chars) 331 332/* Answer the selector extracted by the Message, MESSAGEOOP. */ 333#define MESSAGE_SELECTOR(messageOOP) \ 334 (((gst_message)OOP_TO_OBJ(messageOOP))->selector) 335 336/* Answer the array of arguments extracted by the Message, 337 MESSAGEOOP. */ 338#define MESSAGE_ARGS(messageOOP) \ 339 (((gst_message)OOP_TO_OBJ(messageOOP))->args) 340 341/* Answer a new CObject pointing to COBJPTR. */ 342#define COBJECT_NEW(cObjPtr, typeOOP, defaultClassOOP) \ 343 (_gst_c_object_new_base(_gst_nil_oop, (uintptr_t) cObjPtr, \ 344 typeOOP, defaultClassOOP)) 345 346/* Answer the offset component of the a CObject, COBJ (*not* an OOP, 347 but an object pointer). */ 348#define COBJECT_OFFSET_OBJ(cObj) \ 349 ( ((uintptr_t *) cObj) [TO_INT(cObj->objSize) - 1]) 350 351/* Sets to VALUE the offset component of the CObject, COBJ (*not* an 352 OOP, but an object pointer). */ 353#define SET_COBJECT_OFFSET_OBJ(cObj, value) \ 354 ( ((uintptr_t *) cObj) [TO_INT(cObj->objSize) - 1] = (uintptr_t)(value)) 355 356/* Answer the superclass of the Behavior, CLASS_OOP. */ 357#define SUPERCLASS(class_oop) \ 358 (((gst_class)OOP_TO_OBJ(class_oop))->superclass) 359 360/* Answer the number of fixed instance variables in OOP. */ 361#define OOP_FIXED_FIELDS(oop) \ 362 (OOP_INSTANCE_SPEC(oop) >> ISP_NUMFIXEDFIELDS) 363 364/* Answer the number of fixed instance variables in instances of 365 OOP. */ 366#define CLASS_FIXED_FIELDS(oop) \ 367 (CLASS_INSTANCE_SPEC(oop) >> ISP_NUMFIXEDFIELDS) 368 369/* Answer the number of indexed instance variables in OOP (if any). */ 370#define NUM_INDEXABLE_FIELDS(oop) \ 371 (IS_INT(oop) ? 0 : oop_num_fields(oop) - OOP_FIXED_FIELDS(oop)) 372 373/* Answer the INDEX-th indexed instance variable in ARRAYOOP. */ 374#define ARRAY_AT(arrayOOP, index) \ 375 ( OOP_TO_OBJ(arrayOOP)->data[(index)-1] ) 376 377/* Store VALUE as the INDEX-th indexed instance variable of 378 ARRAYOOP. */ 379#define ARRAY_AT_PUT(arrayOOP, index, value) \ 380 ( OOP_TO_OBJ(arrayOOP)->data[index-1] = value ) 381 382/* Answer the number of associations stored in DICTIONARYOOP. */ 383#define DICTIONARY_SIZE(dictionaryOOP) \ 384 (TO_INT(((gst_dictionary)OOP_TO_OBJ(dictionaryOOP))->tally)) 385 386 387/* Adds the key KEYOOP, associated with VALUEOOP, to the 388 Dictionary (or a subclass sharing the same representation) 389 DICTIONARYOOP. */ 390#define DICTIONARY_AT_PUT(dictionaryOOP, keyOOP, valueOOP) \ 391 (_gst_dictionary_add((dictionaryOOP), association_new((keyOOP), (valueOOP)))) 392 393/* Adds the key KEYOOP, associated with VALUEOOP, to the 394 Dictionary (or a subclass sharing the same representation) 395 DICTIONARYOOP. */ 396#define NAMESPACE_AT_PUT(dictionaryOOP, keyOOP, valueOOP) \ 397 (_gst_dictionary_add((dictionaryOOP), \ 398 variable_binding_new((keyOOP), (valueOOP), (dictionaryOOP)))) 399 400/* Adds the key KEYOOP, associated with VALUEOOP, to the 401 Dictionary (or a subclass sharing the same representation) 402 DICTIONARYOOP. */ 403#define DICTIONARY_AT_PUT(dictionaryOOP, keyOOP, valueOOP) \ 404 (_gst_dictionary_add((dictionaryOOP), \ 405 association_new((keyOOP), (valueOOP)))) 406 407/* Answer whether OOP is a metaclass. */ 408#define IS_A_METACLASS(oop) \ 409 (IS_OOP(oop) && OOP_CLASS(oop) == _gst_metaclass_class) 410 411/* Answer whether OOP is a class, that is, the instance of the 412 metaclass. */ 413#define IS_A_CLASS(oop) \ 414 (IS_OOP(oop) && \ 415 IS_OOP(OOP_CLASS(oop)) && \ 416 OOP_CLASS(OOP_CLASS(oop)) == _gst_metaclass_class) 417 418/* Answer the sole instance of the metaclass, METACLASSOOP. */ 419#define METACLASS_INSTANCE(metaclassOOP) \ 420 (((gst_metaclass)OOP_TO_OBJ(metaclassOOP))->instanceClass) 421 422/* Answer the value stored in the Association, ASSOCIATIONOOP. */ 423#define ASSOCIATION_VALUE(associationOOP) \ 424 (((gst_association)OOP_TO_OBJ(associationOOP))->value) 425 426/* Change the value stored in the Association, ASSOCIATIONOOP, to 427 VALUEOOP. */ 428#define SET_ASSOCIATION_VALUE(associationOOP, valueOOP) \ 429 (((gst_association)OOP_TO_OBJ(associationOOP))->value = valueOOP) 430 431/* Set NAMESPACEOOP to be the namespace in which references to globals 432 from methods of CLASS_OOP are resolved. */ 433#define SET_CLASS_ENVIRONMENT(class_oop, namespaceOOP) \ 434 (((gst_class)OOP_TO_OBJ(class_oop))->environment = namespaceOOP) 435 436/* Answer the instance specification for instances of CLASS_OOP. */ 437#define CLASS_INSTANCE_SPEC(class_oop) \ 438 (((gst_class)OOP_TO_OBJ(class_oop))->instanceSpec) 439 440/* Answer the instance specification of the object OBJ (*not* an OOP). */ 441#define GET_INSTANCE_SPEC(obj) \ 442 CLASS_INSTANCE_SPEC((obj)->objClass) 443 444/* Answer the instance specification of OOP. */ 445#define OOP_INSTANCE_SPEC(oop) \ 446 CLASS_INSTANCE_SPEC(OOP_CLASS(oop)) 447 448/* Answer whether INDEX is in-bounds for accessing fixed instance variables 449 of OOP. */ 450#define CHECK_BOUNDS_OF(oop, index) \ 451 (IS_OOP(oop) && (index >= 1 && index <= OOP_FIXED_FIELDS(oop))) 452 453/* Answer whether indexed instance variables for instances of 454 CLASS_OOP are pointers. */ 455#define CLASS_IS_UNALIGNED(class_oop) \ 456 ((CLASS_INSTANCE_SPEC(class_oop) & ISP_ISINDEXABLE) \ 457 && (CLASS_INSTANCE_SPEC(class_oop) & ISP_INDEXEDVARS) <= GST_ISP_LAST_UNALIGNED) 458 459/* Answer whether instances of CLASS_OOP have indexed instance variables. */ 460#define CLASS_IS_INDEXABLE(class_oop) \ 461 (CLASS_INSTANCE_SPEC(class_oop) & ISP_ISINDEXABLE) 462 463/* Answer whether instances of CLASS_OOP have indexed instance variables. */ 464#define CLASS_IS_SCALAR(class_oop) \ 465 ((CLASS_INSTANCE_SPEC(class_oop) & ISP_ISINDEXABLE) \ 466 && (CLASS_INSTANCE_SPEC(class_oop) & ISP_INDEXEDVARS) <= GST_ISP_LAST_SCALAR) 467 468/* Answer the size in bytes of the object data for OOP. */ 469#define OBJECT_SIZE_BYTES(obj) \ 470 (SIZE_TO_BYTES (TO_INT (obj->objSize)) - sizeof (gst_object_header)) 471 472/* Answer the size in bytes of the object data for OOP. */ 473#define OOP_SIZE_BYTES(oop) \ 474 OBJECT_SIZE_BYTES (OOP_TO_OBJ (oop)) 475 476/* Return the number of word-addressed (pointers or words) instance 477 variables, both fixed and indexed), in OOP. Use instead of 478 NUM_OOPS if you know OOP is not a byte object. */ 479#define NUM_WORDS(obj) \ 480 ((size_t) (TO_INT((obj)->objSize) - OBJ_HEADER_SIZE_WORDS)) 481 482/* Return the number of pointer instance variables (both fixed and 483 indexed), in the object OBJ. */ 484#define NUM_OOPS(obj) \ 485 ((size_t) (COMMON (CLASS_IS_SCALAR ((obj)->objClass)) \ 486 ? (CLASS_INSTANCE_SPEC((obj)->objClass) >> ISP_NUMFIXEDFIELDS) \ 487 : NUM_WORDS(obj) \ 488 )) 489 490 491#define FLOATE_OOP_VALUE(floatOOP) \ 492 (((gst_floate)OOP_TO_OBJ(floatOOP))->value) 493 494OOP 495floate_new (double f) 496{ 497 gst_floate floatObject; 498 OOP floatOOP; 499 500 floatObject = (gst_floate) new_instance_with 501 (_gst_floate_class, sizeof (float), &floatOOP); 502 503 floatObject->value = f; 504 MAKE_OOP_READONLY (floatOOP, true); 505 return (floatOOP); 506} 507 508#if (ALIGNOF_DOUBLE <= SIZEOF_OOP) 509#define FLOATD_OOP_VALUE(floatOOP) \ 510 (((gst_floatd)OOP_TO_OBJ(floatOOP))->value) 511 512#else 513#define FLOATD_OOP_VALUE(floatOOP) \ 514 floatd_oop_value(floatOOP) 515 516static inline double 517floatd_oop_value (floatOOP) 518 OOP floatOOP; 519{ 520 gst_object obj; 521 double d; 522 523 /* we may not be aligned properly...fetch things out the hard way */ 524 obj = OOP_TO_OBJ (floatOOP); 525 memcpy (&d, obj->data, sizeof (double)); 526 return (d); 527} 528#endif 529 530OOP 531floatd_new (double f) 532{ 533 OOP floatOOP; 534#if (ALIGNOF_DOUBLE <= SIZEOF_OOP) 535 gst_floatd floatObject; 536 537 floatObject = (gst_floatd) new_instance_with 538 (_gst_floatd_class, sizeof (double), &floatOOP); 539 540 floatObject->value = f; 541#else 542 gst_object obj; 543 544 obj = new_instance_with (_gst_floatd_class, sizeof (double), &floatOOP); 545 546 memcpy (&obj->data, &f, sizeof (double)); 547#endif 548 549 MAKE_OOP_READONLY (floatOOP, true); 550 return (floatOOP); 551} 552 553#if (ALIGNOF_LONG_DOUBLE <= SIZEOF_OOP) 554#define FLOATQ_OOP_VALUE(floatOOP) \ 555 (((gst_floatq)OOP_TO_OBJ(floatOOP))->value) 556 557#else 558#define FLOATQ_OOP_VALUE(floatOOP) \ 559 floatq_oop_value(floatOOP) 560 561static inline long double 562floatq_oop_value (floatOOP) 563 OOP floatOOP; 564{ 565 gst_object obj; 566 long double d; 567 568 /* we may not be aligned properly...fetch things out the hard way */ 569 obj = OOP_TO_OBJ (floatOOP); 570 memcpy (&d, obj->data, sizeof (long double)); 571 return (d); 572} 573#endif 574 575OOP 576floatq_new (long double f) 577{ 578 OOP floatOOP; 579 gst_object obj = new_instance_with (_gst_floatq_class, 16, &floatOOP); 580 581#if defined __i386__ || defined __x86_64__ 582 /* Two bytes (six on x86-64) of 80-bit long doubles are unused. */ 583 memcpy (&obj->data, &f, 10); 584 memset (((char *)obj->data) + 10, 0, 6); 585#else 586 memcpy (&obj->data, &f, sizeof (long double)); 587 memset (((char *)obj->data) + sizeof (long double), 0, 588 16 - sizeof (long double)); 589#endif 590 591 MAKE_OOP_READONLY (floatOOP, true); 592 return (floatOOP); 593} 594 595OOP 596char_new (unsigned codePoint) 597{ 598 gst_char charObject; 599 OOP charOOP; 600 601 if (codePoint <= 127) 602 return CHAR_OOP_AT (codePoint); 603 if UNCOMMON (codePoint > 0x10FFFF) 604 codePoint = 0xFFFD; 605 606 charObject = (gst_char) new_instance (_gst_unicode_character_class, &charOOP); 607 608 charObject->codePoint = FROM_INT (codePoint); 609 MAKE_OOP_READONLY (charOOP, true); 610 return (charOOP); 611} 612 613uintptr_t 614scramble (uintptr_t x) 615{ 616#if SIZEOF_OOP == 8 617 x ^= (x >> 31) | ( x << 33); 618#endif 619 x ^= (x << 10) | (x >> 22); 620 x ^= (x << 6) | (x >> 26); 621 x ^= (x << 16) | (x >> 16); 622 623 return x & MAX_ST_INT; 624} 625 626 627mst_Boolean 628is_a_kind_of (OOP testedOOP, 629 OOP class_oop) 630{ 631 do 632 { 633 if (testedOOP == class_oop) 634 return (true); 635 testedOOP = SUPERCLASS (testedOOP); 636 } 637 while (!IS_NIL (testedOOP)); 638 639 return (false); 640} 641 642 643void 644nil_fill (OOP * oopPtr, 645 size_t oopCount) 646{ 647 REGISTER (3, OOP nilObj); 648 649 nilObj = _gst_nil_oop; 650 while (oopCount >= 8) 651 { 652 oopPtr[0] = oopPtr[1] = oopPtr[2] = oopPtr[3] = 653 oopPtr[4] = oopPtr[5] = oopPtr[6] = oopPtr[7] = nilObj; 654 oopPtr += 8; 655 oopCount -= 8; 656 } 657 658 if (oopCount & 4) 659 { 660 oopPtr[0] = oopPtr[1] = oopPtr[2] = oopPtr[3] = nilObj; 661 oopPtr += 4; 662 } 663 664 if (oopCount & 2) 665 { 666 oopPtr[0] = oopPtr[1] = nilObj; 667 oopPtr += 2; 668 } 669 670 if (oopCount & 1) 671 oopPtr[0] = nilObj; 672} 673 674gst_object 675new_instance_with (OOP class_oop, 676 size_t numIndexFields, 677 OOP *p_oop) 678{ 679 size_t numBytes, alignedBytes; 680 intptr_t instanceSpec; 681 gst_object p_instance; 682 683 instanceSpec = CLASS_INSTANCE_SPEC (class_oop); 684 numBytes = sizeof (gst_object_header) 685 + SIZE_TO_BYTES(instanceSpec >> ISP_NUMFIXEDFIELDS) 686 + (numIndexFields << _gst_log2_sizes[instanceSpec & ISP_SHAPE]); 687 688 alignedBytes = ROUNDED_BYTES (numBytes); 689 p_instance = _gst_alloc_obj (alignedBytes, p_oop); 690 INIT_UNALIGNED_OBJECT (*p_oop, alignedBytes - numBytes); 691 692 p_instance->objClass = class_oop; 693 (*p_oop)->flags |= (class_oop->flags & F_UNTRUSTED); 694 695 return p_instance; 696} 697 698 699gst_object 700new_instance (OOP class_oop, 701 OOP *p_oop) 702{ 703 size_t numBytes; 704 intptr_t instanceSpec; 705 gst_object p_instance; 706 707 instanceSpec = CLASS_INSTANCE_SPEC (class_oop); 708 numBytes = sizeof (gst_object_header) + 709 SIZE_TO_BYTES(instanceSpec >> ISP_NUMFIXEDFIELDS); 710 711 p_instance = _gst_alloc_obj (numBytes, p_oop); 712 p_instance->objClass = class_oop; 713 (*p_oop)->flags |= (class_oop->flags & F_UNTRUSTED); 714 715 return p_instance; 716} 717 718 719gst_object 720instantiate_numbytes (OOP class_oop, 721 OOP *p_oop, 722 intptr_t instanceSpec, 723 size_t numBytes) 724{ 725 gst_object p_instance; 726 int n; 727 OOP src, *dest; 728 729 p_instance = _gst_alloc_obj (numBytes, p_oop); 730 p_instance->objClass = class_oop; 731 (*p_oop)->flags |= (class_oop->flags & F_UNTRUSTED); 732 733 n = instanceSpec >> ISP_NUMFIXEDFIELDS; 734 if UNCOMMON (n == 0) 735 return p_instance; 736 737 src = _gst_nil_oop; 738 dest = p_instance->data; 739 dest[0] = src; 740 if UNCOMMON (n == 1) 741 return p_instance; 742 743 dest[1] = src; 744 if UNCOMMON (n == 2) 745 return p_instance; 746 747 dest[2] = src; 748 if UNCOMMON (n == 3) 749 return p_instance; 750 751 dest += 3; 752 n -= 3; 753 do 754 *dest++ = src; 755 while (--n > 0); 756 return p_instance; 757} 758 759gst_object 760instantiate_with (OOP class_oop, 761 size_t numIndexFields, 762 OOP *p_oop) 763{ 764 size_t numBytes, indexedBytes, alignedBytes; 765 intptr_t instanceSpec; 766 gst_object p_instance; 767 768 instanceSpec = CLASS_INSTANCE_SPEC (class_oop); 769#ifndef OPTIMIZE 770 if (!(instanceSpec & ISP_ISINDEXABLE) && numIndexFields != 0) 771 _gst_errorf 772 ("class without indexed instance variables passed to instantiate_with"); 773#endif 774 775 indexedBytes = numIndexFields << _gst_log2_sizes[instanceSpec & ISP_SHAPE]; 776 numBytes = sizeof (gst_object_header) 777 + SIZE_TO_BYTES(instanceSpec >> ISP_NUMFIXEDFIELDS) 778 + indexedBytes; 779 780 if COMMON ((instanceSpec & ISP_INDEXEDVARS) == GST_ISP_POINTER) 781 { 782 p_instance = _gst_alloc_obj (numBytes, p_oop); 783 p_instance->objClass = class_oop; 784 (*p_oop)->flags |= (class_oop->flags & F_UNTRUSTED); 785 nil_fill (p_instance->data, 786 (instanceSpec >> ISP_NUMFIXEDFIELDS) + numIndexFields); 787 } 788 else 789 { 790 alignedBytes = ROUNDED_BYTES (numBytes); 791 p_instance = instantiate_numbytes (class_oop, 792 p_oop, 793 instanceSpec, 794 alignedBytes); 795 INIT_UNALIGNED_OBJECT (*p_oop, alignedBytes - numBytes); 796 memset (&p_instance->data[instanceSpec >> ISP_NUMFIXEDFIELDS], 0, 797 indexedBytes); 798 } 799 800 return p_instance; 801} 802 803gst_object 804instantiate (OOP class_oop, 805 OOP *p_oop) 806{ 807 size_t numBytes; 808 intptr_t instanceSpec; 809 810 instanceSpec = CLASS_INSTANCE_SPEC (class_oop); 811 numBytes = sizeof (gst_object_header) + 812 SIZE_TO_BYTES(instanceSpec >> ISP_NUMFIXEDFIELDS); 813 return instantiate_numbytes (class_oop, 814 p_oop, 815 instanceSpec, numBytes); 816} 817 818 819OOP * 820ordered_collection_begin (OOP orderedCollectionOOP) 821{ 822 gst_ordered_collection oc; 823 824 oc = (gst_ordered_collection) OOP_TO_OBJ (orderedCollectionOOP); 825 return &oc->data[TO_INT (oc->firstIndex) - 1]; 826} 827 828OOP * 829ordered_collection_end (OOP orderedCollectionOOP) 830{ 831 gst_ordered_collection oc; 832 833 oc = (gst_ordered_collection) OOP_TO_OBJ (orderedCollectionOOP); 834 return &oc->data[TO_INT (oc->lastIndex)]; 835} 836 837 838OOP 839dictionary_association_at (OOP dictionaryOOP, 840 OOP keyOOP) 841{ 842 gst_object dictionary; 843 size_t index, count, numFields, numFixedFields; 844 OOP associationOOP; 845 gst_association association; 846 847 if UNCOMMON (IS_NIL (dictionaryOOP)) 848 return (_gst_nil_oop); 849 850 dictionary = OOP_TO_OBJ (dictionaryOOP); 851 numFixedFields = OOP_FIXED_FIELDS (dictionaryOOP); 852 numFields = NUM_WORDS (dictionary) - numFixedFields; 853 index = scramble (OOP_INDEX (keyOOP)); 854 count = numFields; 855 856 while (count--) 857 { 858 index &= numFields - 1; 859 associationOOP = dictionary->data[numFixedFields + index]; 860 if COMMON (IS_NIL (associationOOP)) 861 return (_gst_nil_oop); 862 863 association = (gst_association) OOP_TO_OBJ (associationOOP); 864 865 if COMMON (association->key == keyOOP) 866 return (associationOOP); 867 868 /* linear reprobe -- it is simple and guaranteed */ 869 index++; 870 } 871 872 _gst_errorf 873 ("Error - searching Dictionary for nil, but it is full!\n"); 874 abort (); 875} 876 877OOP 878dictionary_at (OOP dictionaryOOP, 879 OOP keyOOP) 880{ 881 OOP assocOOP; 882 883 assocOOP = dictionary_association_at (dictionaryOOP, keyOOP); 884 885 if UNCOMMON (IS_NIL (assocOOP)) 886 return (_gst_nil_oop); 887 else 888 return (ASSOCIATION_VALUE (assocOOP)); 889} 890 891OOP 892association_new (OOP key, 893 OOP value) 894{ 895 gst_association association; 896 OOP associationOOP; 897 898 association = (gst_association) new_instance (_gst_association_class, 899 &associationOOP); 900 901 association->key = key; 902 association->value = value; 903 904 return (associationOOP); 905} 906 907OOP 908variable_binding_new (OOP key, 909 OOP value, 910 OOP environment) 911{ 912 gst_variable_binding binding; 913 OOP bindingOOP; 914 915 binding = (gst_variable_binding) 916 new_instance (_gst_variable_binding_class, &bindingOOP); 917 918 binding->key = key; 919 binding->value = value; 920 binding->environment = environment; 921 922 return (bindingOOP); 923} 924 925 926int 927oop_num_fields (OOP oop) 928{ 929 gst_object object; 930 intptr_t instanceSpec; 931 size_t words, dataBytes, fixed; 932 933 object = OOP_TO_OBJ (oop); 934 words = NUM_WORDS (object); 935 936 if COMMON (!(oop->flags & F_BYTE)) 937 return words; 938 939 instanceSpec = GET_INSTANCE_SPEC (object); 940 fixed = instanceSpec >> ISP_NUMFIXEDFIELDS; 941 words -= fixed; 942 dataBytes = SIZE_TO_BYTES (words) - (oop->flags & EMPTY_BYTES); 943 return fixed + (dataBytes >> _gst_log2_sizes[instanceSpec & ISP_SHAPE]); 944} 945 946 947static int 948num_valid_oops (OOP oop) 949{ 950 gst_object object; 951 952 object = OOP_TO_OBJ (oop); 953 if UNCOMMON (oop->flags & F_CONTEXT) 954 { 955 gst_method_context ctx; 956 intptr_t methodSP; 957 ctx = (gst_method_context) object; 958 methodSP = TO_INT (ctx->spOffset); 959 return ctx->contextStack + methodSP + 1 - object->data; 960 } 961 else 962 return NUM_OOPS (object); 963} 964 965 966/* Returns whether the SCANNEDOOP points to TARGETOOP. */ 967mst_Boolean 968is_owner (OOP scannedOOP, 969 OOP targetOOP) 970{ 971 gst_object object; 972 OOP *scanPtr; 973 int n; 974 975 object = OOP_TO_OBJ (scannedOOP); 976 if UNCOMMON (object->objClass == targetOOP) 977 return true; 978 979 n = num_valid_oops (scannedOOP); 980 981 /* Peel a couple of iterations for optimization. */ 982 if (n--) 983 { 984 scanPtr = object->data; 985 if UNCOMMON (*scanPtr++ == targetOOP) 986 return true; 987 988 if (n--) 989 do 990 if UNCOMMON (*scanPtr++ == targetOOP) 991 return true; 992 while (n--); 993 } 994 995 return false; 996} 997 998OOP 999index_oop (OOP oop, 1000 size_t index) 1001{ 1002 gst_object object = OOP_TO_OBJ (oop); 1003 intptr_t instanceSpec = GET_INSTANCE_SPEC (object); 1004 return index_oop_spec (oop, object, index, instanceSpec); 1005} 1006 1007OOP 1008index_oop_spec (OOP oop, 1009 gst_object object, 1010 size_t index, 1011 intptr_t instanceSpec) 1012{ 1013 size_t maxIndex, maxByte; 1014 char *src; 1015 1016 if UNCOMMON (index < 1) 1017 return (NULL); 1018 1019 index--; 1020 1021#define DO_INDEX_OOP(type, dest) \ 1022 /* Find the number of bytes in the object. */ \ 1023 maxByte = NUM_WORDS (object) * sizeof (PTR); \ 1024 if (sizeof (type) <= sizeof (PTR)) \ 1025 maxByte -= (oop->flags & EMPTY_BYTES); \ 1026 \ 1027 index = \ 1028 index * sizeof(type) \ 1029 + (instanceSpec >> ISP_NUMFIXEDFIELDS) * sizeof (PTR); \ 1030 \ 1031 /* Check that we're on bounds. */ \ 1032 if UNCOMMON (index + sizeof(type) > maxByte) \ 1033 return (NULL); \ 1034 \ 1035 /* Use a cast if unaligned accesses are supported, else memcpy. */ \ 1036 src = ((char *) object->data) + index; \ 1037 if (sizeof (type) <= sizeof (PTR)) \ 1038 (dest) = *(type *) src; \ 1039 else \ 1040 memcpy ((char *) &(dest), src, sizeof (type)); 1041 1042 switch (instanceSpec & ISP_INDEXEDVARS) 1043 { 1044 case GST_ISP_SCHAR: { 1045 int8_t i; 1046 DO_INDEX_OOP (int8_t, i); 1047 return FROM_INT (i); 1048 } 1049 1050 case GST_ISP_UCHAR: { 1051 uint8_t i; 1052 DO_INDEX_OOP (uint8_t, i); 1053 return FROM_INT (i); 1054 } 1055 1056 case GST_ISP_CHARACTER: { 1057 uint8_t i; 1058 DO_INDEX_OOP (uint8_t, i); 1059 return CHAR_OOP_AT (i); 1060 } 1061 1062 case GST_ISP_SHORT: { 1063 uint16_t i; 1064 DO_INDEX_OOP (int16_t, i); 1065 return FROM_INT (i); 1066 } 1067 1068 case GST_ISP_USHORT: { 1069 uint16_t i; 1070 DO_INDEX_OOP (uint16_t, i); 1071 return FROM_INT (i); 1072 } 1073 1074 case GST_ISP_INT: { 1075 uint32_t i; 1076 DO_INDEX_OOP (int32_t, i); 1077 return from_c_int_32 (i); 1078 } 1079 1080 case GST_ISP_UINT: { 1081 uint32_t i; 1082 DO_INDEX_OOP (uint32_t, i); 1083 return from_c_uint_32 (i); 1084 } 1085 1086 case GST_ISP_FLOAT: { 1087 float f; 1088 DO_INDEX_OOP (float, f); 1089 return floate_new (f); 1090 } 1091 1092 case GST_ISP_INT64: { 1093 uint64_t i; 1094 DO_INDEX_OOP (int64_t, i); 1095 return from_c_int_64 (i); 1096 } 1097 1098 case GST_ISP_UINT64: { 1099 uint64_t i; 1100 DO_INDEX_OOP (uint64_t, i); 1101 return from_c_uint_64 (i); 1102 } 1103 1104 case GST_ISP_DOUBLE: { 1105 double d; 1106 DO_INDEX_OOP (double, d); 1107 return floatd_new (d); 1108 } 1109 1110 case GST_ISP_UTF32: { 1111 uint32_t i; 1112 DO_INDEX_OOP (uint32_t, i); 1113 return char_new (i); 1114 } 1115 1116 case GST_ISP_POINTER: 1117 maxIndex = NUM_WORDS (object); 1118 index += instanceSpec >> ISP_NUMFIXEDFIELDS; 1119 if UNCOMMON (index >= maxIndex) 1120 return (NULL); 1121 1122 return (object->data[index]); 1123 } 1124#undef DO_INDEX_OOP 1125 1126 return (NULL); 1127} 1128 1129mst_Boolean 1130index_oop_put (OOP oop, 1131 size_t index, 1132 OOP value) 1133{ 1134 gst_object object = OOP_TO_OBJ (oop); 1135 intptr_t instanceSpec = GET_INSTANCE_SPEC (object); 1136 return index_oop_put_spec (oop, object, index, value, instanceSpec); 1137} 1138 1139mst_Boolean 1140index_oop_put_spec (OOP oop, 1141 gst_object object, 1142 size_t index, 1143 OOP value, 1144 intptr_t instanceSpec) 1145{ 1146 size_t maxIndex; 1147 1148 if UNCOMMON (index < 1) 1149 return (false); 1150 1151 index--; 1152 1153#define DO_INDEX_OOP_PUT(type, cond, src) \ 1154 if COMMON (cond) \ 1155 { \ 1156 /* Find the number of bytes in the object. */ \ 1157 size_t maxByte = NUM_WORDS (object) * sizeof (PTR); \ 1158 if (sizeof (type) <= sizeof (PTR)) \ 1159 maxByte -= (oop->flags & EMPTY_BYTES); \ 1160 \ 1161 index = \ 1162 index * sizeof(type) \ 1163 + (instanceSpec >> ISP_NUMFIXEDFIELDS) * sizeof (PTR); \ 1164 \ 1165 /* Check that we're on bounds. */ \ 1166 if UNCOMMON (index + sizeof(type) > maxByte) \ 1167 return (false); \ 1168 \ 1169 /* Use a cast if unaligned accesses are ok, else memcpy. */ \ 1170 if (sizeof (type) <= sizeof (PTR)) \ 1171 { \ 1172 type *destAddr = (type *) (((char *) object->data) + index);\ 1173 *destAddr = (type) (src); \ 1174 } \ 1175 else \ 1176 { \ 1177 char *destAddr = ((char *) object->data) + index; \ 1178 type src_ = (type) (src); \ 1179 memcpy (destAddr, (char *) &src_, sizeof (type)); \ 1180 } \ 1181 return (true); \ 1182 } 1183 1184 switch (instanceSpec & ISP_INDEXEDVARS) 1185 { 1186 case GST_ISP_SCHAR: { 1187 DO_INDEX_OOP_PUT (int8_t, 1188 IS_INT (value) 1189 && TO_INT (value) >= -128 1190 && TO_INT (value) <= 127, 1191 TO_INT (value)); 1192 return (false); 1193 } 1194 1195 case GST_ISP_UCHAR: { 1196 DO_INDEX_OOP_PUT (uint8_t, 1197 IS_INT (value) 1198 && TO_INT (value) >= 0 1199 && TO_INT (value) <= 255, 1200 TO_INT (value)); 1201 return (false); 1202 } 1203 1204 case GST_ISP_CHARACTER: { 1205 DO_INDEX_OOP_PUT (uint8_t, 1206 !IS_INT (value) 1207 && OOP_CLASS (value) == _gst_char_class, 1208 CHAR_OOP_VALUE (value)); 1209 return (false); 1210 } 1211 1212 case GST_ISP_SHORT: { 1213 DO_INDEX_OOP_PUT (uint16_t, 1214 IS_INT (value) 1215 && TO_INT (value) >= -32768 1216 && TO_INT (value) <= 32767, 1217 TO_INT (value)); 1218 return (false); 1219 } 1220 1221 case GST_ISP_USHORT: { 1222 DO_INDEX_OOP_PUT (uint16_t, 1223 IS_INT (value) 1224 && TO_INT (value) >= 0 1225 && TO_INT (value) <= 65535, 1226 TO_INT (value)); 1227 return (false); 1228 } 1229 1230 case GST_ISP_INT: { 1231 DO_INDEX_OOP_PUT (int32_t, is_c_int_32 (value), to_c_int_32 (value)); 1232 return (false); 1233 } 1234 1235 case GST_ISP_UINT: { 1236 DO_INDEX_OOP_PUT (uint32_t, is_c_uint_32 (value), to_c_int_32 (value)); 1237 return (false); 1238 } 1239 1240 case GST_ISP_FLOAT: { 1241 DO_INDEX_OOP_PUT (float, IS_INT (value), TO_INT (value)); 1242 DO_INDEX_OOP_PUT (float, OOP_CLASS (value) == _gst_floate_class, 1243 FLOATE_OOP_VALUE (value)); 1244 DO_INDEX_OOP_PUT (float, OOP_CLASS (value) == _gst_floatd_class, 1245 FLOATD_OOP_VALUE (value)); 1246 DO_INDEX_OOP_PUT (float, OOP_CLASS (value) == _gst_floatq_class, 1247 FLOATQ_OOP_VALUE (value)); 1248 return (false); 1249 } 1250 1251 case GST_ISP_INT64: { 1252 DO_INDEX_OOP_PUT (int64_t, is_c_int_64 (value), to_c_int_64 (value)); 1253 return (false); 1254 } 1255 1256 case GST_ISP_UINT64: { 1257 DO_INDEX_OOP_PUT (uint64_t, is_c_uint_64 (value), to_c_uint_64 (value)); 1258 return (false); 1259 } 1260 1261 case GST_ISP_DOUBLE: { 1262 DO_INDEX_OOP_PUT (double, IS_INT (value), TO_INT (value)); 1263 DO_INDEX_OOP_PUT (double, OOP_CLASS (value) == _gst_floatd_class, 1264 FLOATD_OOP_VALUE (value)); 1265 DO_INDEX_OOP_PUT (double, OOP_CLASS (value) == _gst_floate_class, 1266 FLOATE_OOP_VALUE (value)); 1267 DO_INDEX_OOP_PUT (double, OOP_CLASS (value) == _gst_floatq_class, 1268 FLOATQ_OOP_VALUE (value)); 1269 return (false); 1270 } 1271 1272 case GST_ISP_UTF32: { 1273 DO_INDEX_OOP_PUT (uint32_t, 1274 !IS_INT (value) 1275 && (OOP_CLASS (value) == _gst_unicode_character_class 1276 || (OOP_CLASS (value) == _gst_char_class 1277 && CHAR_OOP_VALUE (value) <= 127)), 1278 CHAR_OOP_VALUE (value)); 1279 return (false); 1280 } 1281 1282 case GST_ISP_POINTER: 1283 maxIndex = NUM_WORDS (object); 1284 index += instanceSpec >> ISP_NUMFIXEDFIELDS; 1285 if UNCOMMON (index >= maxIndex) 1286 return (false); 1287 1288 object->data[index] = value; 1289 return (true); 1290 } 1291#undef DO_INDEX_OOP_PUT 1292 1293 return (false); 1294} 1295 1296OOP 1297inst_var_at (OOP oop, 1298 int index) 1299{ 1300 gst_object object; 1301 1302 object = OOP_TO_OBJ (oop); 1303 return (object->data[index - 1]); 1304} 1305 1306void 1307inst_var_at_put (OOP oop, 1308 int index, 1309 OOP value) 1310{ 1311 gst_object object; 1312 1313 object = OOP_TO_OBJ (oop); 1314 object->data[index - 1] = value; 1315} 1316 1317 1318mst_Boolean 1319is_c_int_32 (OOP oop) 1320{ 1321 gst_byte_array ba; 1322 1323 if COMMON (IS_INT (oop)) 1324#if SIZEOF_OOP == 4 1325 return (true); 1326#else 1327 return (TO_INT (oop) >= INT_MIN && TO_INT (oop) < INT_MAX); 1328#endif 1329 1330 ba = (gst_byte_array) OOP_TO_OBJ (oop); 1331 if (COMMON (ba->objClass == _gst_large_positive_integer_class) 1332 || ba->objClass == _gst_large_negative_integer_class) 1333 return (NUM_INDEXABLE_FIELDS (oop) == 4); 1334 1335 return (false); 1336} 1337 1338mst_Boolean 1339is_c_uint_32 (OOP oop) 1340{ 1341 gst_byte_array ba; 1342 1343 if COMMON (IS_INT (oop)) 1344#if SIZEOF_OOP == 4 1345 return (TO_INT (oop) >= 0); 1346#else 1347 return (TO_INT (oop) >= 0 && TO_INT (oop) < UINT_MAX); 1348#endif 1349 1350 ba = (gst_byte_array) OOP_TO_OBJ (oop); 1351 if COMMON (ba->objClass == _gst_large_positive_integer_class) 1352 { 1353 switch (NUM_INDEXABLE_FIELDS (oop)) 1354 { 1355 case 4: 1356 return (true); 1357 case 5: 1358 return (ba->bytes[4] == 0); 1359 } 1360 } 1361 1362 return (false); 1363} 1364 1365int32_t 1366to_c_int_32 (OOP oop) 1367{ 1368 gst_byte_array ba; 1369 1370 if COMMON (IS_INT (oop)) 1371 return (TO_INT (oop)); 1372 1373 ba = (gst_byte_array) OOP_TO_OBJ (oop); 1374 return ((int32_t) ((((uint32_t) ba->bytes[3]) << 24) + 1375 (((uint32_t) ba->bytes[2]) << 16) + 1376 (((uint32_t) ba->bytes[1]) << 8) + 1377 ((uint32_t) ba->bytes[0]))); 1378} 1379 1380OOP 1381from_c_int_32 (int32_t i) 1382{ 1383 gst_byte_array ba; 1384 OOP oop; 1385 const uint32_t ui = (uint32_t) i; 1386 1387 if COMMON (i >= MIN_ST_INT && i <= MAX_ST_INT) 1388 return (FROM_INT (i)); 1389 1390 if (i < 0) 1391 ba = (gst_byte_array) new_instance_with (_gst_large_negative_integer_class, 1392 4, &oop); 1393 else 1394 ba = (gst_byte_array) new_instance_with (_gst_large_positive_integer_class, 1395 4, &oop); 1396 1397 ba->bytes[0] = (gst_uchar) ui; 1398 ba->bytes[1] = (gst_uchar) (ui >> 8); 1399 ba->bytes[2] = (gst_uchar) (ui >> 16); 1400 ba->bytes[3] = (gst_uchar) (ui >> 24); 1401 return (oop); 1402} 1403 1404OOP 1405from_c_uint_32 (uint32_t ui) 1406{ 1407 gst_byte_array ba; 1408 OOP oop; 1409 1410 if COMMON (ui <= MAX_ST_INT) 1411 return (FROM_INT (ui)); 1412 1413 if UNCOMMON (((intptr_t) ui) < 0) 1414 { 1415 ba = (gst_byte_array) 1416 new_instance_with (_gst_large_positive_integer_class, 1417 5, &oop); 1418 1419 ba->bytes[4] = 0; 1420 } 1421 else 1422 ba = (gst_byte_array) 1423 new_instance_with (_gst_large_positive_integer_class, 1424 4, &oop); 1425 1426 ba->bytes[0] = (gst_uchar) ui; 1427 ba->bytes[1] = (gst_uchar) (ui >> 8); 1428 ba->bytes[2] = (gst_uchar) (ui >> 16); 1429 ba->bytes[3] = (gst_uchar) (ui >> 24); 1430 1431 return (oop); 1432} 1433 1434 1435mst_Boolean 1436is_c_int_64 (OOP oop) 1437{ 1438 gst_byte_array ba; 1439 1440 if COMMON (IS_INT (oop)) 1441 return (true); 1442 1443 ba = (gst_byte_array) OOP_TO_OBJ (oop); 1444 if COMMON (ba->objClass == _gst_large_negative_integer_class 1445 || ba->objClass == _gst_large_positive_integer_class) 1446 { 1447 switch (NUM_INDEXABLE_FIELDS (oop)) 1448 { 1449 case 4: 1450 case 5: 1451 case 6: 1452 case 7: 1453 case 8: 1454 return (true); 1455 } 1456 } 1457 1458 return (false); 1459} 1460 1461mst_Boolean 1462is_c_uint_64 (OOP oop) 1463{ 1464 gst_byte_array ba; 1465 1466 if COMMON (IS_INT (oop)) 1467 return (TO_INT (oop) >= 0); 1468 1469 ba = (gst_byte_array) OOP_TO_OBJ (oop); 1470 if COMMON (ba->objClass == _gst_large_positive_integer_class) 1471 { 1472 switch (NUM_INDEXABLE_FIELDS (oop)) 1473 { 1474 case 4: 1475 case 5: 1476 case 6: 1477 case 7: 1478 case 8: 1479 return (true); 1480 case 9: 1481 return (ba->bytes[8] == 0); 1482 } 1483 } 1484 1485 return (false); 1486} 1487 1488uint64_t 1489to_c_uint_64 (OOP oop) 1490{ 1491 gst_byte_array ba; 1492 uint64_t result, mask; 1493 1494 if COMMON (IS_INT (oop)) 1495 return (TO_INT (oop)); 1496 1497 ba = (gst_byte_array) OOP_TO_OBJ (oop); 1498 mask = (((uint64_t)2) << (NUM_INDEXABLE_FIELDS (oop) * 8 - 1)) - 1; 1499 result = ((int64_t) ( 1500 (((uint64_t) ba->bytes[3]) << 24) + 1501 (((uint64_t) ba->bytes[2]) << 16) + 1502 (((uint64_t) ba->bytes[1]) << 8) + 1503 ((uint64_t) ba->bytes[0]))); 1504 1505 if (NUM_INDEXABLE_FIELDS (oop) > 4) 1506 result |= mask & ((int64_t) ( 1507 (((uint64_t) ba->bytes[7]) << 56) + 1508 (((uint64_t) ba->bytes[6]) << 48) + 1509 (((uint64_t) ba->bytes[5]) << 40) + 1510 (((uint64_t) ba->bytes[4]) << 32))); 1511 1512 return result; 1513} 1514 1515int64_t 1516to_c_int_64 (OOP oop) 1517{ 1518 gst_byte_array ba; 1519 int64_t result, mask; 1520 1521 if COMMON (IS_INT (oop)) 1522 return (TO_INT (oop)); 1523 1524 ba = (gst_byte_array) OOP_TO_OBJ (oop); 1525 mask = (((uint64_t)2) << (NUM_INDEXABLE_FIELDS (oop) * 8 - 1)) - 1; 1526 result = (ba->objClass == _gst_large_negative_integer_class) ? ~mask : 0; 1527 result |= ((int64_t) ( 1528 (((uint64_t) ba->bytes[3]) << 24) + 1529 (((uint64_t) ba->bytes[2]) << 16) + 1530 (((uint64_t) ba->bytes[1]) << 8) + 1531 ((uint64_t) ba->bytes[0]))); 1532 1533 if (NUM_INDEXABLE_FIELDS (oop) > 4) 1534 result |= mask & ((int64_t) ( 1535 (((uint64_t) ba->bytes[7]) << 56) + 1536 (((uint64_t) ba->bytes[6]) << 48) + 1537 (((uint64_t) ba->bytes[5]) << 40) + 1538 (((uint64_t) ba->bytes[4]) << 32))); 1539 1540 return result; 1541} 1542 1543OOP 1544from_c_int_64 (int64_t i) 1545{ 1546 gst_byte_array ba; 1547 OOP oop; 1548 const uint64_t ui = (uint64_t) i; 1549 1550 if COMMON (i >= MIN_ST_INT && i <= MAX_ST_INT) 1551 return (FROM_INT (i)); 1552 1553 if (i < 0) 1554 ba = (gst_byte_array) new_instance_with (_gst_large_negative_integer_class, 1555 8, &oop); 1556 else 1557 ba = (gst_byte_array) new_instance_with (_gst_large_positive_integer_class, 1558 8, &oop); 1559 1560 ba->bytes[0] = (gst_uchar) ui; 1561 ba->bytes[1] = (gst_uchar) (ui >> 8); 1562 ba->bytes[2] = (gst_uchar) (ui >> 16); 1563 ba->bytes[3] = (gst_uchar) (ui >> 24); 1564 ba->bytes[4] = (gst_uchar) (ui >> 32); 1565 ba->bytes[5] = (gst_uchar) (ui >> 40); 1566 ba->bytes[6] = (gst_uchar) (ui >> 48); 1567 ba->bytes[7] = (gst_uchar) (ui >> 56); 1568 1569 return (oop); 1570} 1571 1572OOP 1573from_c_uint_64 (uint64_t ui) 1574{ 1575 gst_byte_array ba; 1576 OOP oop; 1577 1578 if COMMON (ui <= MAX_ST_INT) 1579 return (FROM_INT (ui)); 1580 1581 if UNCOMMON (((int64_t) ui) < 0) 1582 { 1583 ba = (gst_byte_array) 1584 new_instance_with (_gst_large_positive_integer_class, 1585 9, &oop); 1586 1587 ba->bytes[8] = 0; 1588 } 1589 else 1590 ba = (gst_byte_array) 1591 new_instance_with (_gst_large_positive_integer_class, 1592 8, &oop); 1593 1594 ba->bytes[0] = (gst_uchar) ui; 1595 ba->bytes[1] = (gst_uchar) (ui >> 8); 1596 ba->bytes[2] = (gst_uchar) (ui >> 16); 1597 ba->bytes[3] = (gst_uchar) (ui >> 24); 1598 ba->bytes[4] = (gst_uchar) (ui >> 32); 1599 ba->bytes[5] = (gst_uchar) (ui >> 40); 1600 ba->bytes[6] = (gst_uchar) (ui >> 48); 1601 ba->bytes[7] = (gst_uchar) (ui >> 56); 1602 1603 return (oop); 1604} 1605 1606static inline PTR 1607cobject_value (OOP oop) 1608{ 1609 gst_cobject cObj = (gst_cobject) OOP_TO_OBJ (oop); 1610 if (IS_NIL (cObj->storage)) 1611 return (PTR) COBJECT_OFFSET_OBJ (cObj); 1612 else 1613 { 1614 gst_uchar *baseAddr = ((gst_byte_array) OOP_TO_OBJ (cObj->storage))->bytes; 1615 return (PTR) (baseAddr + COBJECT_OFFSET_OBJ (cObj)); 1616 } 1617} 1618 1619/* Sets the address of the data stored in a CObject. */ 1620static inline void 1621set_cobject_value (OOP oop, PTR val) 1622{ 1623 gst_cobject cObj = (gst_cobject) OOP_TO_OBJ (oop); 1624 cObj->storage = _gst_nil_oop; 1625 SET_COBJECT_OFFSET_OBJ (cObj, (uintptr_t) val); 1626} 1627 1628 1629/* Return whether the address of the data stored in a CObject, offsetted 1630 by OFFSET bytes, is still in bounds. */ 1631static inline mst_Boolean cobject_index_check (OOP oop, intptr_t offset, 1632 size_t size) 1633{ 1634 gst_cobject cObj = (gst_cobject) OOP_TO_OBJ (oop); 1635 OOP baseOOP = cObj->storage; 1636 intptr_t maxOffset; 1637 if (IS_NIL (baseOOP)) 1638 return true; 1639 1640 offset += COBJECT_OFFSET_OBJ (cObj); 1641 if (offset < 0) 1642 return false; 1643 1644 maxOffset = SIZE_TO_BYTES (NUM_WORDS (OOP_TO_OBJ (baseOOP))); 1645 if (baseOOP->flags & F_BYTE) 1646 maxOffset -= (baseOOP->flags & EMPTY_BYTES); 1647 1648 return (offset + size - 1 < maxOffset); 1649} 1650