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) 1996-2006 Cisco Systems, Inc. All Rights Reserved. 18 * 19 * Contributor(s): 20 * 21 * END LICENSE BLOCK */ 22 23/*---------------------------------------------------------------------- 24 * System: ECLiPSe Constraint Logic Programming System 25 * Version: $Id: bip_heapevents.c,v 1.1 2008/06/30 17:43:51 jschimpf Exp $ 26 * 27 * Contents: Built-ins for the heap-event-primitives 28 * 29 * This file has been factored out of bip_record.c in 05/2006 30 *----------------------------------------------------------------------*/ 31 32#include "config.h" 33#include "sepia.h" 34#include "types.h" 35#include "embed.h" 36#include "mem.h" 37#include "error.h" 38#include "dict.h" 39 40#include <stdio.h> /* for sprintf() */ 41 42static dident d_defers0_; 43 44/*---------------------------------------------------------------------- 45 * Prolog heap events 46 *----------------------------------------------------------------------*/ 47 48/* INSTANCE TYPE DECLARATION */ 49 50/* ****** See types.h ****** */ 51 52/* METHODS */ 53 54static void _free_heap_event(t_heap_event *event); 55static t_heap_event * _copy_heap_event(t_heap_event *event); 56static void _mark_heap_event(t_heap_event *obj); 57static int _heap_event_set(t_ext_ptr h, int i, pword pw); 58static pword _heap_event_get(t_ext_ptr h, int i); 59static int _tostr_heap_event(t_heap_event *event, char *buf, int quoted); 60static int _strsz_heap_event(t_heap_event *event, int quoted); 61 62 63/* CLASS DESCRIPTOR (method table) */ 64 65t_ext_type heap_event_tid = { 66 (void (*)(t_ext_ptr)) _free_heap_event, 67 (t_ext_ptr (*)(t_ext_ptr)) _copy_heap_event, 68 (void (*)(t_ext_ptr)) _mark_heap_event, 69 (int (*)(t_ext_ptr,int)) _strsz_heap_event, 70 (int (*)(t_ext_ptr,char *,int)) _tostr_heap_event, 71 0, /* equal */ 72 (t_ext_ptr (*)(t_ext_ptr)) _copy_heap_event, 73 0, /* get */ 74 0 /* set */ 75}; 76 77 78static void 79_free_heap_event(t_heap_event *event) /* event != NULL */ 80{ 81 /* It is possible for the reference count to drop to -1 82 * when freeing an embedded self-reference. The equality 83 * test ensures the event is freed once and once only. 84 */ 85 if (--event->ref_ctr == 0) 86 { 87 free_heapterm(&event->goal); 88 hg_free_size(event, sizeof(t_heap_event)); 89#ifdef DEBUG_RECORD 90 p_fprintf(current_err_, "\n_free_heap_event(0x%x)", event); 91 ec_flush(current_err_); 92#endif 93 } 94} 95 96static t_heap_event * 97_copy_heap_event(t_heap_event *event) /* event != NULL */ 98{ 99 ++event->ref_ctr; 100 return event; 101} 102 103static void 104_mark_heap_event(t_heap_event *event) /* event != NULL */ 105{ 106 /* 107 * Since the heap event may contain embedded handles of itself, 108 * we have to avoid looping: overwrite event->goal with nil for 109 * the duration of the marking, and set it back afterwards. 110 * This is safe because dictionary GC is atomic. 111 */ 112 pword pw = event->goal; 113 Make_Nil(&event->goal); 114 mark_dids_from_heapterm(&pw); 115 event->goal = pw; 116 117 mark_dids_from_pwords(&event->module, &event->module + 1); 118} 119 120static int 121_tostr_heap_event(t_heap_event *event, char *buf, int quoted) /* event != NULL */ 122{ 123#define STRSZ_EVENT 20 124 sprintf(buf, "'EVENT'(16'%08x)", (int)(word) event); /* possibly truncated */ 125 return STRSZ_EVENT; 126} 127 128static int 129_strsz_heap_event(t_heap_event *event, int quoted) /* event != NULL */ 130{ 131 return STRSZ_EVENT; 132} 133 134 135/* PROLOG INTERFACE */ 136 137/* 138 * event_create(+Goal, +Options, -EventHandle, +Module) 139 * event_retrieve(+EventHandle, -Goal, -Module) 140 * event_enable(+Handle) 141 * event_disable(+Handle) 142 */ 143 144 145static int 146p_event_create4(value vevent, type tevent, value vopt, type topt, value vhandle, type thandle, value vmodule, type tmodule) 147{ 148 t_heap_event *event; 149 pword hevent; 150 int defers = 0; 151 int res = PSUCCEED; 152 153 Check_Ref(thandle); 154 Check_Goal(tevent); 155 Check_List(topt); 156 157 while (IsList(topt)) 158 { 159 pword *pw = vopt.ptr++; 160 Dereference_(pw); 161 Check_Atom(pw->tag); 162 if (pw->val.did == d_defers0_) 163 defers = 1; 164 else 165 { Bip_Error(RANGE_ERROR); } 166 Dereference_(vopt.ptr); 167 topt.all = vopt.ptr->tag.all; 168 vopt.ptr = vopt.ptr->val.ptr; 169 Check_List(topt); 170 } 171 172 /* Disable interrupts - this safeguards our Tom-foolery with 173 * the reference counts and guards the event allocation from 174 * aborts. 175 */ 176 Disable_Int(); 177 178 event = (t_heap_event *)hg_alloc_size( sizeof(t_heap_event) ); 179 event->ref_ctr = 1; 180 event->enabled = 1; 181 event->defers = defers; 182 event->module.tag = tmodule; 183 event->module.val = vmodule; 184 185 hevent = ec_handle(&heap_event_tid, (t_ext_ptr) event); 186 187 /* Unify the handle before the heap copy in case it is embedded within 188 * the event 189 */ 190 res = Unify_Pw(vhandle, thandle, hevent.val, hevent.tag); 191 res = res == PSUCCEED ? create_heapterm(&event->goal, vevent, tevent) : res; 192 193 if (res != PSUCCEED) { 194 hg_free_size(event, sizeof(t_heap_event)); 195 Enable_Int(); 196 Bip_Error(res); 197 } 198 199 /* The goal *may* have an embedded reference to the handle, 200 * the heap copy will have incremented the reference count to two. 201 * As a result we reset it back to one here to ensure we avoid liveness 202 * maintained by the embedded internal reference. 203 */ 204 event->ref_ctr = 1; 205 206 Enable_Int(); 207 208 Succeed_; 209} 210 211 212static int 213p_event_create(value vevent, type tevent, value vhandle, type thandle, value vmodule, type tmodule) 214{ 215 pword opt; 216 Make_Nil(&opt); 217 return p_event_create4(vevent, tevent, opt.val, opt.tag, vhandle, thandle, vmodule, tmodule); 218} 219 220 221static int 222p_event_retrieve(value vhandle, type thandle, value vgoal, type tgoal, value vmodule, type tmodule) 223{ 224 t_heap_event *event; 225 pword goal; 226 227 Prepare_Requests; 228 229 Get_Typed_Object(vhandle, thandle, &heap_event_tid, event); 230 231 get_heapterm(&event->goal, &goal); 232 233 /* Is the event enabled or disabled? */ 234 if (event->enabled) { 235 Request_Unify_Pw(vgoal, tgoal, goal.val, goal.tag); 236 } else { 237 /* Event disabled, just return the goal as 'true' */ 238 Request_Unify_Atom(vgoal, tgoal, d_.true0) 239 } 240 241 Request_Unify_Pw(vmodule, tmodule, event->module.val, event->module.tag); 242 243 Return_Unify; 244} 245 246 247static int 248p_event_enable(value vhandle, type thandle) 249{ 250 t_heap_event *event; 251 252 Get_Typed_Object(vhandle, thandle, &heap_event_tid, event); 253 254 /* If an event is in the event queue but has been disabled 255 * then it must be removed before the event is re-enabled. 256 */ 257 if (!event->enabled) 258 { 259 purge_disabled_dynamic_events(event); 260 } 261 262 event->enabled = 1; 263 264 Succeed_; 265} 266 267 268static int 269p_event_disable(value vhandle, type thandle) 270{ 271 t_heap_event *event; 272 273 Get_Typed_Object(vhandle, thandle, &heap_event_tid, event); 274 275 event->enabled = 0; 276 277 Succeed_; 278} 279 280 281/*---------------------------------------------------------------------- 282 * Initialisation 283 *----------------------------------------------------------------------*/ 284 285void 286bip_heapevent_init(int flags) 287{ 288 d_defers0_ = in_dict("defers", 0); 289 290 if (flags & INIT_SHARED) 291 { 292 (void) built_in(in_dict("event_create_", 3), p_event_create, B_SAFE|U_SIMPLE); 293 (void) built_in(in_dict("event_create_", 4), p_event_create4, B_SAFE|U_SIMPLE); 294 (void) built_in(in_dict("event_retrieve", 3), p_event_retrieve, B_UNSAFE|U_FRESH); 295 (void) built_in(in_dict("event_enable", 1), p_event_enable, B_SAFE|U_NONE); 296 (void) built_in(in_dict("event_disable", 1), p_event_disable, B_SAFE|U_NONE); 297 } 298} 299 300