static int _heap_arr_set(t_ext_ptr h, int i, pword pw) /* expected to be dereferenced */ { pword copy_pw; pword *pheap; int err, arity; pheap = ((t_heap_array*)h)->array; arity = DidArity(pheap[0].val.did); if (i >= 1 && i <= arity) { if ((err = create_heapterm(©_pw, pw.val, pw.tag)) != PSUCCEED) { Bip_Error(err); } a_mutex_lock(&SharedDataLock); free_heapterm(&pheap[i]); move_heapterm(©_pw, &pheap[i]); a_mutex_unlock(&SharedDataLock); } else if (i == 0) { if (IsStructure(pw.tag) && pw.val.ptr->val.did == pheap[0].val.did) { pword *aux = TG; Push_Struct_Frame(pheap[0].val.did); for (i=1; i<=arity; ++i) { pword *parg = &pw.val.ptr[i]; Dereference_(parg); if ((err = create_heapterm(aux+i, parg->val, parg->tag)) != PSUCCEED) { TG = aux; Bip_Error(err); } } a_mutex_lock(&SharedDataLock); for (i=1; i<=arity; ++i) { free_heapterm(&pheap[i]); move_heapterm(aux+i, &pheap[i]); } a_mutex_unlock(&SharedDataLock); TG = aux; } else { Bip_Error(RANGE_ERROR); } } else { Bip_Error(RANGE_ERROR); } Succeed_; }
static void _free_heap_array(t_heap_array *obj) /* obj != NULL */ { if (--obj->ref_ctr <= 0) { pword *p = obj->array; int arity = DidArity(p[0].val.did); int i; for (i = arity; i > 0; --i) { free_heapterm(&p[i]); } hg_free_size(obj, sizeof(t_heap_array) + arity*sizeof(pword)); #ifdef DEBUG_RECORD p_fprintf(current_err_, "\n_free_heap_array(0x%x)", obj); ec_flush(current_err_); #endif } }
static void free_prop_value(int prop_name, pword *prop_value) { switch(prop_name) { case GLOBVAR_PROP: if (IsGlobalPrologRef(prop_value)) { ec_ref_destroy((ec_ref) prop_value->val.wptr); prop_value->val.wptr = NULL; } /* If we are erasing the last global ref, decrement the global index */ else if (IsGlobalPrologRefIndex(prop_value) && prop_value->val.nint == (GlobalVarIndex - 1)) { GlobalVarIndex--; } else { free_heapterm(prop_value); } break; case ARRAY_PROP: free_array(prop_value); break; case IDB_PROP: { extern t_ext_type heap_rec_header_tid; heap_rec_header_tid.free((t_ext_ptr)prop_value->val.wptr); break; } case HTABLE_PROP: { extern t_ext_type heap_htable_tid; heap_htable_tid.free((t_ext_ptr)prop_value->val.wptr); break; } case SHELF_PROP: { extern t_ext_type heap_array_tid; heap_array_tid.free((t_ext_ptr)prop_value->val.wptr); break; } case MODULE_PROP: case TRANS_PROP: case WRITE_TRANS_PROP: case GOAL_TRANS_PROP: case WRITE_GOAL_TRANS_PROP: case CLAUSE_TRANS_PROP: case WRITE_CLAUSE_TRANS_PROP: hg_free((generic_ptr)prop_value->val.ptr); break; case EVENT_PROP: case STREAM_PROP: case PREFIX_PROP: case INFIX_PROP: case POSTFIX_PROP: case SYSCALL_PROP: break; default: p_fprintf(current_err_, "Unknown property type %d in free_prop_value()\n", prop_name); ec_flush(current_err_); break; } }