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