1/* BEGIN LICENSE BLOCK 2 * Version: CMPL 1.1 3 * 4 * The contents of this file are subject to the Cisco-style Mozilla Public 5 * License Version 1.1 (the "License"); you may not use this file except 6 * in compliance with the License. You may obtain a copy of the License 7 * at www.eclipse-clp.org/license. 8 * 9 * Software distributed under the License is distributed on an "AS IS" 10 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11 * the License for the specific language governing rights and limitations 12 * under the License. 13 * 14 * The Original Code is The ECLiPSe Constraint Logic Programming System. 15 * The Initial Developer of the Original Code is Cisco Systems, Inc. 16 * Portions created by the Initial Developer are 17 * Copyright (C) 1989-2006 Cisco Systems, Inc. All Rights Reserved. 18 * 19 * Contributor(s): 20 * 21 * END LICENSE BLOCK */ 22 23/* 24 * VERSION $Id: property.c,v 1.9 2013/09/28 00:25:39 jschimpf Exp $ 25 * 26 * IDENTIFICATION: property.c 27 * 28 * DESCRIPTION: property list handling 29 * 30 * CONTENTS: 31 * set_property() 32 * get_property() 33 * get_simple_property() 34 * erase_property() 35 * set_modular_property() 36 * get_modular_property() 37 * erase_modular_property() 38 * erase_module_props() 39 * mark_dids_from_properties() 40 * 41 * AUTHOR: bruno, joachim 42 * 43 * This version implements the following semantics of property lists: 44 * - There is no difference between module independent properties 45 * and module dependent global properties. 46 * Therefore the same routines can be used for both. 47 * - Independent/global properties can be created, accessed, modified 48 * and erased from everywhere. We always work on the visible property 49 * (except when a local is created it may hide a global one). 50 * - When a module is erased, its local properties are erased as well. 51 */ 52 53 54#include "config.h" 55#include "sepia.h" 56#include "types.h" 57#include "embed.h" 58#include "error.h" 59#include "mem.h" 60#include "dict.h" 61#include "module.h" 62#include "property.h" 63 64 65static void free_prop_value(int, pword*); 66 67extern void mark_dids_from_array(pword *prop_value), 68 mark_dids_from_pwords(pword *from, register pword *to), 69 mark_dids_from_heapterm(pword *root); 70 71 72#define Property_Error(err_ptr, err_no) \ 73 *err_ptr = err_no; \ 74 return 0; 75 76static void 77_rem_from_module_entry(property *m, module_item *pm) 78{ 79 register property *p, **prev; 80 prev = &(pm->properties); 81 p = *prev; 82 while (p != m) 83 { 84 if (!p) return; /* should not happen, but ... */ 85 prev = &p->next_prop; 86 p = *prev; 87 } 88 *prev = p->next_prop; 89} 90 91/* 92 * create a new module-independent property descriptor 93 */ 94 95pword * 96set_property(dident functor, int property_name) 97{ 98 int err; 99 /* the module is not used */ 100 return set_modular_property(functor, property_name, 101 d_.default_module, tdict, GLOBAL_PROP, &err); 102} 103 104 105/* 106 * create a new property descriptor 107 * 108 * flag is one of {GLOBAL_PROP, LOCAL_PROP}. 109 * the module is not important, but must de different from D_UNKNOWN. 110 * If a descriptor already exists, NULL is returned, else 111 * the return value is a pointer to the property value of the new descriptor. 112 * A local definition hides an existing global one. 113 * 114 * A global descriptor is always created, even when only local properties 115 * exist. It is the one in the property chain. If no global property 116 * exists, its module field contains D_UNKNOWN, otherwise it holds the 117 * definition module (which is not further used for globals). 118 * The global descriptor is the head of a circular list of local properties. 119 * The property_value field of any descriptor is initialised with a TEND tag. 120 * 121 * If an error occurs, nil is returned and the integer referenced by 122 * err_ref is set to the error number. If the value returned is non nil, 123 * it points to a valid property and *err_ref is not changed. 124 * It is guaranty that err_ref will not be accessed if there is no 125 * error (i.e. 0 can be passed if it shure there is no property and 126 * that the module access is ok) 127 * 128 * Since this function returns a pointer into a property descriptor, 129 * it must only be called inside an interrupt protected area !!! 130 */ 131 132pword * 133set_modular_property(dident functor, int property_name, dident module, type mod_tag, int flag, int *err_ref) 134{ 135 register property *p, *head; 136 module_item *pm; 137 138 if (flag == LOCAL_PROP && IsLocked(module) 139 && !IsModuleTag(module, mod_tag)) 140 { 141 Property_Error(err_ref, LOCKED); 142 } 143 144 /* get pointer to property list from atom */ 145 a_mutex_lock(&PropListLock); 146 head = p = DidProperties(functor); 147 148 while (p && p->name != property_name) /* find the right one */ 149 { 150 head = p; 151 p = p->next_prop; 152 } 153 154 if (!p) /* no such property yet */ 155 { 156 p = (property *) hg_alloc_size(sizeof(property)); 157 p->name = property_name; 158 p->next_prop = (property *) NULL; 159 p->next_mod = p; 160 p->module = D_UNKNOWN; 161 if (head) 162 head->next_prop = p; 163 else 164 DidProperties(functor) = p; 165 } 166 167 if (flag == GLOBAL_PROP) 168 { 169 if (p->module == D_UNKNOWN) 170 { 171 p->module = module; /* fill unused descriptor */ 172 p->property_value.tag.kernel = TEND; 173 a_mutex_unlock(&PropListLock); 174 return &p->property_value; 175 } 176 else 177 { 178 a_mutex_unlock(&PropListLock); 179 Property_Error(err_ref, PERROR)/* global exists already */ 180 } 181 } 182 183 /* else if (flag == LOCAL_PROP) */ 184 head = p; 185 for(p = head->next_mod; p != head; p = p->next_mod) 186 { 187 if (p->module == module) 188 { 189 a_mutex_unlock(&PropListLock); 190 Property_Error(err_ref, PERROR); /* a local exists */ 191 } 192 } 193 194 /* insert a new descriptor at the beginning */ 195 p = (property *) hg_alloc_size(sizeof(property)); 196 p->name = property_name; 197 p->module = module; 198 p->property_value.tag.kernel = TEND; 199 p->next_mod = head->next_mod; 200 head->next_mod = p; 201 a_mutex_unlock(&PropListLock); 202 203 a_mutex_lock(&ModuleLock); 204 pm = (module_item *) (get_property(module, MODULE_PROP))->val.ptr; 205 p->next_prop = pm->properties; 206 pm->properties = p; 207 a_mutex_unlock(&ModuleLock); 208 209 return &p->property_value; 210} 211 212 213/* 214 * get a module independent or the global property 215 */ 216 217pword * 218get_property(dident functor, int property_name) 219{ 220 int err; 221 222 return get_modular_property(functor, property_name, 223 D_UNKNOWN, tdict, GLOBAL_PROP, &err); 224} 225 226 227/* 228 * get a property 229 * flag is one of {VISIBLE_PROP, GLOBAL_PROP, LOCAL_PROP}. 230 * 231 * If an error occurs, nil is returned and the integer referenced by 232 * err_ref is set to the error number. If the value returned is non nil, 233 * it points to a valid property and *err_ref indicates which property 234 * was returned (GLOBAL_PROP or LOCAL_PROP). 235 * 236 * Since this function returns a pointer into a property descriptor, 237 * it must only be called inside an interrupt protected area !!! 238 */ 239 240pword * 241get_modular_property(dident functor, int property_name, dident module, type mod_tag, int which, int *res) 242{ 243 register property *p, *m; 244 245 if (which != GLOBAL_PROP && IsLocked(module) 246 && !IsModuleTag(module, mod_tag)) 247 { 248 Property_Error(res, LOCKED); 249 } 250 251 /* scan property list until an entry for property is found or end */ 252 a_mutex_lock(&PropListLock); 253 for (p = DidProperties(functor); p; p = p->next_prop) 254 { 255 if (p->name == property_name) 256 { 257 if (which != GLOBAL_PROP) 258 for (m = p->next_mod; m != p; m = m->next_mod) 259 { 260 if (m->module == module) { 261 *res = LOCAL_PROP; 262 a_mutex_unlock(&PropListLock); 263 return(&m->property_value); /* return the local */ 264 } 265 } 266 267 a_mutex_unlock(&PropListLock); 268 if (which != LOCAL_PROP && p->module != D_UNKNOWN) { 269 *res = GLOBAL_PROP; 270 return(&p->property_value); /* return the global */ 271 } 272 else 273 { 274 Property_Error(res, PERROR); /* no global */ 275 } 276 } 277 } 278 a_mutex_unlock(&PropListLock); 279 Property_Error(res, PERROR); 280} 281 282 283/* 284 * Quick routine to get a module-independent property. 285 * Does not return a pointer into the property, therefore no lock 286 * necessary around call. 287 */ 288int 289get_simple_property(dident functor, int property_name, pword *result) 290{ 291 property *p; 292 293 a_mutex_lock(&PropListLock); 294 for (p = DidProperties(functor); p; p = p->next_prop) 295 { 296 if (p->name == property_name) 297 { 298 a_mutex_unlock(&PropListLock); 299 *result = p->property_value; 300 return PSUCCEED; 301 } 302 } 303 a_mutex_unlock(&PropListLock); 304 return PFAIL; 305} 306 307 308/* 309 * erase a module independent or the global property 310 */ 311 312int 313erase_property(dident functor, int property_name) 314{ 315 return erase_modular_property(functor, property_name, 316 D_UNKNOWN, tdict, GLOBAL_PROP); 317} 318 319 320/* 321 * erase a property 322 * flag is one of {VISIBLE_PROP, GLOBAL_PROP, LOCAL_PROP}. 323 * This function can return a valid Prolog error code. 324 * a successful erase may return PSUCCEED or PFAIL. The later 325 * is return if the property has been completely removed for functor 326 * i.e the global and all locals. 327 */ 328 329int 330erase_modular_property(dident functor, int property_name, dident module, type mod_tag, int which) 331{ 332 register property *p, **prev_p; 333 int res; 334 module_item *pm; 335 336 if (which != GLOBAL_PROP && IsLocked(module) 337 && !IsModuleTag(module, mod_tag)) 338 { 339 return LOCKED; 340 } 341 342 /* this lookup must be before the lock */ 343 if (which != GLOBAL_PROP) 344 pm = (module_item *) (get_property(module, MODULE_PROP))->val.ptr; 345 346 a_mutex_lock(&PropListLock); 347 /* get pointer to property list from atom */ 348 prev_p = &(DidProperties(functor)); 349 p = *prev_p; 350 351 /* scan property list until an entry for property is found or end */ 352 while (p) 353 { 354 if (p->name == property_name) 355 { 356 if (which != GLOBAL_PROP) 357 { 358 register property *m, **prev_m; 359 360 prev_m = &(p->next_mod); 361 m = *prev_m; 362 363 while (m != p) /* scan module list */ 364 { 365 if (m->module == module) 366 { /* erase the local */ 367 *prev_m = m->next_mod; 368 369 _rem_from_module_entry(m, pm); 370 free_prop_value(property_name, &m->property_value); 371 hg_free_size((generic_ptr) m, sizeof(property)); 372 373 if (p->next_mod == p && p->module == D_UNKNOWN) 374 { /* all erased, remove head descriptor */ 375 *prev_p = p->next_prop; 376 hg_free_size((generic_ptr) p, sizeof(property)); 377 /* this is not an error, it is a message 378 to notify that the property is erased 379 completely */ 380 res = PFAIL; 381 goto _unlock_return_; 382 } 383 res = PSUCCEED; 384 goto _unlock_return_; 385 } 386 prev_m = &(m->next_mod); 387 m = *prev_m; 388 } 389 } 390 if (which != LOCAL_PROP && p->module != D_UNKNOWN) 391 { /* erase the global */ 392 free_prop_value(property_name, &p->property_value); 393 if (p->next_mod == p) 394 { /* no locals: remove global descriptor */ 395 *prev_p = p->next_prop; 396 hg_free_size((generic_ptr) p, sizeof(property)); 397 /* this is not an error, it is a message to notify 398 that the property is erased completely */ 399 res = PFAIL; 400 goto _unlock_return_; 401 } 402 else 403 p->module = D_UNKNOWN; /* just mark it unused */ 404 res = PSUCCEED; 405 goto _unlock_return_; 406 } 407 res = PERROR; 408 goto _unlock_return_; /* should give a warning */ 409 } 410 prev_p = &(p->next_prop); 411 p = *prev_p; 412 } 413 res = PERROR; 414_unlock_return_: 415 a_mutex_unlock(&PropListLock); 416 return(res); 417} 418 419 420/* 421 * this is to be called from erase_module 422 * prop_list is a list of module dependent (local) property descriptors 423 * linked with the next_prop field 424 */ 425 426void 427erase_module_props(property *prop_list) 428{ 429 register property *p; 430 431 while(prop_list) 432 { 433 p = prop_list->next_mod; 434 435 while (p->next_mod != prop_list) 436 p = p->next_mod; 437 p->next_mod = prop_list->next_mod; 438 439 p = prop_list; 440 prop_list = prop_list->next_prop; 441 free_prop_value((int) p->name, &p->property_value); 442 hg_free_size((generic_ptr) p, sizeof(property)); 443 } 444} 445 446 447/* 448 * free all space associated to the property value 449 */ 450 451static void 452free_prop_value(int prop_name, pword *prop_value) 453{ 454 switch(prop_name) 455 { 456 case GLOBVAR_PROP: 457 if (IsGlobalPrologRef(prop_value)) { 458 ec_ref_destroy((ec_ref) prop_value->val.wptr); 459 prop_value->val.wptr = NULL; 460 } 461 /* If we are erasing the last global ref, decrement the global index */ 462 else if (IsGlobalPrologRefIndex(prop_value) && 463 prop_value->val.nint == (GlobalVarIndex - 1)) 464 { 465 GlobalVarIndex--; 466 } 467 else 468 { 469 free_heapterm(prop_value); 470 } 471 break; 472 473 case ARRAY_PROP: 474 free_array(prop_value); 475 break; 476 477 case IDB_PROP: 478 { 479 extern t_ext_type heap_rec_header_tid; 480 heap_rec_header_tid.free((t_ext_ptr)prop_value->val.wptr); 481 break; 482 } 483 484 case HTABLE_PROP: 485 { 486 extern t_ext_type heap_htable_tid; 487 heap_htable_tid.free((t_ext_ptr)prop_value->val.wptr); 488 break; 489 } 490 491 case SHELF_PROP: 492 { 493 extern t_ext_type heap_array_tid; 494 heap_array_tid.free((t_ext_ptr)prop_value->val.wptr); 495 break; 496 } 497 498 case MODULE_PROP: 499 case TRANS_PROP: 500 case WRITE_TRANS_PROP: 501 case GOAL_TRANS_PROP: 502 case WRITE_GOAL_TRANS_PROP: 503 case CLAUSE_TRANS_PROP: 504 case WRITE_CLAUSE_TRANS_PROP: 505 hg_free((generic_ptr)prop_value->val.ptr); 506 break; 507 508 case EVENT_PROP: 509 case STREAM_PROP: 510 case PREFIX_PROP: 511 case INFIX_PROP: 512 case POSTFIX_PROP: 513 case SYSCALL_PROP: 514 break; 515 516 default: 517 p_fprintf(current_err_, "Unknown property type %d in free_prop_value()\n", prop_name); 518 ec_flush(current_err_); 519 break; 520 } 521} 522 523 524/* 525 * Support function for the dictionary garbage collector. 526 * Mark all DIDs that occur in the given property list 527 * (ie. treat all the properties a single functor). 528 */ 529 530void 531mark_dids_from_properties(property *prop_list) 532{ 533 for (; prop_list; prop_list = prop_list->next_prop) 534 { 535 register property *p = prop_list; 536 do 537 { 538 if (p->module != D_UNKNOWN) 539 { 540 switch (p->name) 541 { 542 case ARRAY_PROP: 543 mark_dids_from_array(&p->property_value); 544 break; 545 546 case GLOBVAR_PROP: 547 mark_dids_from_heapterm(&p->property_value); 548 break; 549 550 case HTABLE_PROP: 551 { 552 extern t_ext_type heap_htable_tid; 553 heap_htable_tid.mark_dids((t_ext_ptr)p->property_value.val.wptr); 554 } 555 break; 556 557 case SHELF_PROP: 558 { 559 extern t_ext_type heap_array_tid; 560 heap_array_tid.mark_dids((t_ext_ptr)p->property_value.val.wptr); 561 } 562 break; 563 564 case IDB_PROP: 565 { 566 extern t_ext_type heap_rec_header_tid; 567 heap_rec_header_tid.mark_dids((t_ext_ptr)p->property_value.val.wptr); 568 } 569 break; 570 571 case TRANS_PROP: 572 case WRITE_TRANS_PROP: 573 case GOAL_TRANS_PROP: 574 case WRITE_GOAL_TRANS_PROP: 575 case CLAUSE_TRANS_PROP: 576 case WRITE_CLAUSE_TRANS_PROP: 577 { 578 macro_desc *md = (macro_desc *) p->property_value.val.ptr; 579 Mark_Did(md->trans_function); 580 Mark_Did(md->module); 581 } 582 break; 583 584 case MODULE_PROP: 585 { 586 module_item *m = (module_item *) p->property_value.val.ptr; 587 register didlist *scan; 588 for (scan = m->imports; scan; scan = scan->next) 589 { 590 Mark_Did(scan->name); 591 } 592 } 593 break; 594 595 case STREAM_PROP: /* just an integer */ 596 break; 597 598 case PREFIX_PROP: /* did */ 599 case INFIX_PROP: /* did */ 600 case POSTFIX_PROP: /* did */ 601 case SYSCALL_PROP: /* did or integer */ 602 case EVENT_PROP: /* pri */ 603 mark_dids_from_pwords(&p->property_value, &p->property_value + 1); 604 break; 605 606 default: 607 p_fprintf(current_err_, "Unknown property type %d in mark_dids_from_properties()\n", p->name); 608 ec_flush(current_err_); 609 break; 610 } 611 } 612 p = p->next_mod; 613 } while (p != prop_list); 614 } 615} 616 617