1 /* Common operations. 2 3 Copyright (C) 2015, 2016, 2017, 2018, 2023 Paul Boddie <paul@boddie.org.uk> 4 5 This program is free software; you can redistribute it and/or modify it under 6 the terms of the GNU General Public License as published by the Free Software 7 Foundation; either version 3 of the License, or (at your option) any later 8 version. 9 10 This program is distributed in the hope that it will be useful, but WITHOUT 11 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 13 details. 14 15 You should have received a copy of the GNU General Public License along with 16 this program. If not, see <http://www.gnu.org/licenses/>. 17 */ 18 19 #include "gc.h" /* GC_MALLOC, GC_REALLOC */ 20 #include "types.h" 21 #include "ops.h" 22 #include "progops.h" /* for raising errors */ 23 #include "progconsts.h" 24 #include "progtypes.h" 25 26 /* Get object reference from attribute. */ 27 28 __ref __VALUE(__attr attr) 29 { 30 if (!__INTEGER(attr)) 31 return attr.value; 32 else 33 return (__ref) &__common_integer_obj; 34 } 35 36 /* Basic structure tests. */ 37 38 static inline int __HASATTR(__ref obj, int pos, int code) 39 { 40 return (pos < obj->table->size) && (obj->table->attrs[pos] == code); 41 } 42 43 /* Direct access and manipulation of static objects. */ 44 45 __attr __load_static_ignore(__ref obj) 46 { 47 return __ATTRVALUE(obj); 48 } 49 50 __attr __load_static_replace(__attr context, __ref obj) 51 { 52 return __update_context(context, __ATTRVALUE(obj)); 53 } 54 55 __attr __load_static_test(__attr context, __ref obj) 56 { 57 return __test_context(context, __ATTRVALUE(obj)); 58 } 59 60 /* Direct retrieval operations, returning attribute locations. */ 61 62 __attr *__get_class_attr_ref__(__ref obj, int pos) 63 { 64 return __get_object_attr_ref__(__get_class(obj), pos); 65 } 66 67 /* Direct retrieval operations, returning and setting attributes. */ 68 69 __attr __load_via_object__(__ref obj, int pos) 70 { 71 return __load_via_attr_ref(__get_object_attr_ref__(obj, pos)); 72 } 73 74 __attr __load_via_class__(__ref obj, int pos) 75 { 76 return __load_via_object__(__get_class(obj), pos); 77 } 78 79 __attr __get_class_and_load__(__ref obj, int pos) 80 { 81 if (__is_instance(obj)) 82 return __load_via_class__(obj, pos); 83 else 84 return __load_via_object__(obj, pos); 85 } 86 87 /* Introspection. */ 88 89 int __is_instance(__ref obj) 90 { 91 return obj->pos == __INSTANCEPOS; 92 } 93 94 int __is_subclass(__ref obj, __attr cls) 95 { 96 return __HASATTR(obj, __TYPEPOS(__VALUE(cls)), __TYPECODE(__VALUE(cls))); 97 } 98 99 int __is_instance_subclass(__ref obj, __attr cls) 100 { 101 return __is_instance(obj) && __HASATTR(__get_class(obj), __TYPEPOS(__VALUE(cls)), __TYPECODE(__VALUE(cls))); 102 } 103 104 int __is_type_instance(__ref obj) 105 { 106 return __HASATTR(__get_class(obj), __TYPE_CLASS_POS, __TYPE_CLASS_CODE); 107 } 108 109 __ref __get_class(__ref obj) 110 { 111 return __VALUE(__load_via_object(obj, __class__)); 112 } 113 114 __attr __get_class_attr(__ref obj) 115 { 116 return __load_via_object(obj, __class__); 117 } 118 119 /* Attribute testing operations. */ 120 121 __ref __test_specific_instance(__ref obj, __ref type) 122 { 123 return __get_class(obj) == type ? obj : 0; 124 } 125 126 __ref __test_specific_object(__ref obj, __ref type) 127 { 128 return __test_specific_type(obj, type) || __test_specific_instance(obj, type) ? obj : 0; 129 } 130 131 __ref __test_specific_type(__ref obj, __ref type) 132 { 133 return obj == type ? obj : 0; 134 } 135 136 __ref __test_common_instance__(__ref obj, int pos, int code) 137 { 138 return __HASATTR(__get_class(obj), pos, code) ? obj : 0; 139 } 140 141 __ref __test_common_object__(__ref obj, int pos, int code) 142 { 143 return __test_common_type__(obj, pos, code) || __test_common_instance__(obj, pos, code) ? obj : 0; 144 } 145 146 __ref __test_common_type__(__ref obj, int pos, int code) 147 { 148 return __HASATTR(obj, pos, code) ? obj : 0; 149 } 150 151 /* Attribute testing and location operations, returning the address of the 152 attribute as opposed to its value. */ 153 154 __attr *__check_and_get_object_attr_ref_null(__ref obj, int pos, int code) 155 { 156 if (__HASATTR(obj, pos, code)) 157 return __get_object_attr_ref__(obj, pos); 158 else 159 return NULL; 160 } 161 162 __attr *__check_and_get_object_attr_ref__(__ref obj, int pos, int code) 163 { 164 if (__HASATTR(obj, pos, code)) 165 return __get_object_attr_ref__(obj, pos); 166 167 __raise_type_error(); 168 return NULL; 169 } 170 171 /* Attribute testing and retrieval operations. */ 172 173 __attr __check_and_load_via_object_null(__ref obj, int pos, int code) 174 { 175 __attr *attr = __check_and_get_object_attr_ref_null(obj, pos, code); 176 177 if (attr == NULL) 178 return __NULL; 179 else 180 return __load_via_attr_ref(attr); 181 } 182 183 __attr __check_and_load_via_class__(__ref obj, int pos, int code) 184 { 185 return __check_and_load_via_object__(__get_class(obj), pos, code); 186 } 187 188 __attr __check_and_load_via_object__(__ref obj, int pos, int code) 189 { 190 __attr attr = __check_and_load_via_object_null(obj, pos, code); 191 192 if (__ISNULL(attr)) 193 __raise_type_error(); 194 195 return attr; 196 } 197 198 __attr __check_and_load_via_any__(__ref obj, int pos, int code) 199 { 200 __attr attr = __check_and_load_via_object_null(obj, pos, code); 201 202 if (__ISNULL(attr)) 203 attr = __check_and_load_via_class__(obj, pos, code); 204 205 return attr; 206 } 207 208 /* Context-related operations. */ 209 210 int __test_context_update(__attr context, __attr attr, int invoke) 211 { 212 /* Return whether the context should be updated for the attribute. */ 213 214 __attr attrcontext = __CONTEXT_AS_VALUE(attr); 215 __ref attrcontextvalue = __VALUE(attrcontext); 216 217 /* Preserve any existing null or instance context. */ 218 219 if (__ISNULL(attrcontext) || __is_instance(attrcontextvalue)) 220 return 0; 221 222 /* Test any instance context against the context employed by the 223 attribute. */ 224 225 if (__is_instance(__VALUE(context))) 226 { 227 /* Obtain the special class attribute position and code identifying the 228 attribute context's class, inspecting the context instance for 229 compatibility. */ 230 231 if (__test_common_instance__(__VALUE(context), __TYPEPOS(attrcontextvalue), __TYPECODE(attrcontextvalue))) 232 return 1; 233 else 234 __raise_type_error(); 235 } 236 237 /* Without a null or instance context, an invocation cannot be performed. */ 238 239 if (invoke) 240 __raise_unbound_method_error(); 241 242 /* Test for access to a type class attribute using a type instance. */ 243 244 if (__test_specific_type(attrcontextvalue, &__TYPE_CLASS_TYPE) && __is_type_instance(__VALUE(context))) 245 return 1; 246 247 /* Otherwise, preserve the attribute as retrieved. */ 248 249 return 0; 250 } 251 252 __attr __test_context(__attr context, __attr attr) 253 { 254 /* Update the context or return the unchanged attribute. */ 255 256 if (__test_context_update(context, attr, 0)) 257 return __update_context(context, attr); 258 else 259 return attr; 260 } 261 262 __attr __update_context(__attr context, __attr attr) 263 { 264 return __new_wrapper(context, attr); 265 } 266 267 __attr __test_context_revert(int target, __attr context, __attr attr, __attr contexts[]) 268 { 269 /* Revert the local context to that employed by the attribute if the 270 supplied context is not appropriate. */ 271 272 if (!__test_context_update(context, attr, 1)) 273 contexts[target] = __CONTEXT_AS_VALUE(attr); 274 return attr; 275 } 276 277 __attr __test_context_static(int target, __attr context, __ref value, __attr contexts[]) 278 { 279 /* Set the local context to the specified context if appropriate. */ 280 281 if (__test_context_update(context, __ATTRVALUE(value), 1)) 282 contexts[target] = context; 283 return __ATTRVALUE(value); 284 } 285 286 /* Context testing for invocations. */ 287 288 int __type_method_invocation(__attr context, __attr target) 289 { 290 __attr targetcontext = __CONTEXT_AS_VALUE(target); 291 292 /* Require instances, not classes, where methods are function instances. */ 293 294 if (!__is_instance(__VALUE(target))) 295 return 0; 296 297 /* Access the context of the callable and test if it is the type object. */ 298 299 return (!__ISNULL(targetcontext) && __test_specific_type(__VALUE(targetcontext), &__TYPE_CLASS_TYPE) && __is_type_instance(__VALUE(context))); 300 } 301 302 __attr __unwrap_callable(__attr callable) 303 { 304 __attr value = __check_and_load_via_object_null(__VALUE(callable), __ATTRPOS(__value__), __ATTRCODE(__value__)); 305 return __VALUE(value) ? value : callable; 306 } 307 308 __attr (*__get_function_unchecked(__attr target))() 309 { 310 return __load_via_object(__VALUE(__unwrap_callable(target)), __fn__).fn; 311 } 312 313 __attr (*__get_function(__attr context, __attr target))() 314 { 315 return __get_function_unwrapped(context, __unwrap_callable(target)); 316 } 317 318 __attr (*__get_function_unwrapped(__attr context, __attr target))() 319 { 320 /* Require null or instance contexts for functions and methods respectively, 321 or type instance contexts for type methods. */ 322 323 if (__ISNULL(context) || __is_instance(__VALUE(context)) || __type_method_invocation(context, target)) 324 return __get_function_member(target); 325 else 326 return __unbound_method; 327 } 328 329 __attr (*__get_function_member(__attr target))() 330 { 331 return __load_via_object(__VALUE(target), __fn__).fn; 332 } 333 334 __attr (*__check_and_get_function(__attr context, __attr target))() 335 { 336 return __check_and_get_function_unwrapped(context, __unwrap_callable(target)); 337 } 338 339 __attr (*__check_and_get_function_unwrapped(__attr context, __attr target))() 340 { 341 /* Require null or instance contexts for functions and methods respectively, 342 or type instance contexts for type methods. */ 343 344 if (__ISNULL(context) || __is_instance(__VALUE(context)) || __type_method_invocation(context, target)) 345 return __check_and_load_via_object__(__VALUE(target), __ATTRPOS(__fn__), __ATTRCODE(__fn__)).fn; 346 else 347 return __unbound_method; 348 } 349 350 /* Parameter position operations. */ 351 352 int __HASPARAM(const __ptable *ptable, int ppos, int pcode) 353 { 354 __param param; 355 356 if (ppos < ptable->size) 357 { 358 param = ptable->params[ppos]; 359 if (param.code == pcode) 360 return param.pos; 361 } 362 363 return -1; 364 } 365 366 /* Conversions. */ 367 368 __attr __CONTEXT_AS_VALUE(__attr attr) 369 { 370 return __check_and_load_via_object_null(__VALUE(attr), __ATTRPOS(__context__), __ATTRCODE(__context__)); 371 } 372 373 /* Type testing. */ 374 375 __ref __ISFUNC(__ref obj) 376 { 377 return __test_specific_instance(obj, &__FUNCTION_TYPE); 378 } 379 380 /* Attribute codes and positions for type objects. */ 381 382 unsigned int __TYPECODE(__ref obj) 383 { 384 return obj->table->attrs[obj->pos]; 385 } 386 387 unsigned int __TYPEPOS(__ref obj) 388 { 389 return obj->pos; 390 } 391 392 /* Memory allocation. */ 393 394 void *__ALLOCATE(size_t nmemb, size_t size) 395 { 396 void *ptr = GC_MALLOC(nmemb * size); /* sets memory to zero */ 397 if (ptr == NULL) 398 __raise_memory_error(); 399 return ptr; 400 } 401 402 void *__ALLOCATEIM(size_t nmemb, size_t size) 403 { 404 void *ptr = GC_MALLOC_ATOMIC(nmemb * size); 405 if (ptr == NULL) 406 __raise_memory_error(); 407 return ptr; 408 } 409 410 void *__REALLOCATE(void *ptr, size_t size) 411 { 412 void *nptr = GC_REALLOC(ptr, size); 413 if (nptr == NULL) 414 __raise_memory_error(); 415 return nptr; 416 } 417 418 /* Copying of structures. */ 419 420 __ref __COPY(__ref obj, int size) 421 { 422 __ref copy = (__ref) __ALLOCATE(1, size); 423 memcpy(copy, obj, size); 424 return copy; 425 } 426 427 /* Store an attribute in a target location. For targets that support value 428 replacement, a copied object is assigned when initialising the target. 429 NOTE: Only floats are currently supported for value replacement. */ 430 431 __attr __set_attr(volatile __attr *target, __attr attr) 432 { 433 __ref obj; 434 435 /* Value already replaced in target by an operation. */ 436 437 if (__REPLACING(attr)) 438 return __REPLACED(attr); 439 440 obj = __VALUE(attr); 441 442 /* Value is replaceable and should be copied to avoid inadvertent 443 sharing. */ 444 445 if ((obj != NULL) && __is_instance(obj) && (__get_class(obj) == &__builtins___float_float)) 446 attr = __ATTRVALUE(__COPY(obj, sizeof(__obj___builtins___float_float))); 447 448 /* Set and return the attribute. */ 449 450 *target = attr; 451 return attr; 452 }