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) 1997-2006 Cisco Systems, Inc. All Rights Reserved. 18 * 19 * Contributor(s): 20 * 21 * END LICENSE BLOCK */ 22 23/* 24 * ECLiPSe Kernel Module 25 * 26 * $Id: handle.c,v 1.2 2012/02/11 17:09:31 jschimpf Exp $ 27 * 28 * Author: Stefano Novello, IC-Parc 29 * Joachim Schimpf, IC-Parc 30 * 31 * Contents: Module to deal with generic handles 32 * from Prolog to external objects 33 * 34 * Description: 35 * 36 * |------------| 37 * | THANDLE | |-----------| 38 * | --------+ | | 39 * |------------| | |-----------| | | 40 * ... | | TPTR | | <data> | |----------| 41 * | | ---------> | | | .... | 42 * |------------| | | - - - - - | |-----------| | mark() | 43 * | THANDLE | +-> | TEXTERN | | copy() | 44 * | ----------> | ----------------------------> | free() | 45 * |------------| |-----------| |----------| 46 * unique anchor data type desc 47 * on global 48 * 49 * A module that uses handles will associate a data structure with the 50 * handle, as well as a type descriptor (method table). 51 * 52 * Handles to external data are implemented using a unique "anchor" 53 * on the global stack. The Prolog code references the anchor via 54 * THANDLE pointers. 55 * 56 * The anchor has two components: 57 * 58 * t_ext_type *ExternalClass(p) points to a method table (class) 59 * t_ext_ptr ExternalData(p) points to the external data 60 * 61 * The ExternalData() field can point to arbitrary external data. 62 * The ExternalClass() field points to a user-supplied descriptor 63 * which is a table of methods for standard operations on the data. 64 * 65 * When the last THANDLE referring to an anchor disappears it will 66 * eventually be garbage collected. When the anchor disappears, 67 * the external object's free() method gets invoked. 68 * 69 * If the object is manually freed before the anchor disappears, the 70 * anchor becomes stale. This is marked by overwriting ExternalData() 71 * with NULL. Since the anchor is never copied, all accesses via 72 * any THANDLE will see that this handle is stale. 73 * 74 * If an anchor gets physically copied, e.g. by setval, record, etc, 75 * the copy() or remote_copy() method is used to inform the external object. 76 * 77 * Other methods for comparing, printing and gc can be specified. 78 */ 79 80#include "config.h" 81#include "sepia.h" 82#include "types.h" 83#include "embed.h" 84#include "mem.h" 85#include "error.h" 86#include "ec_io.h" 87#include "dict.h" 88#include "database.h" 89#include "emu_export.h" 90 91 92/* 93 * Call cleanup method (if any) and mark handle as stale (of not already) 94 * (pw)[1].val.ptr is ExternalData(pw) expansion to satisfy gcc-4.x 95 */ 96#define AnchorFree(pw) { \ 97 if (ExternalData(pw)) { \ 98 if (ExternalClass(pw)->free) \ 99 ExternalClass(pw)->free(ExternalData(pw)); \ 100 (pw)[1].val.ptr = (pword *) NULL; \ 101 } \ 102} 103 104 105/* 106 * Function to free the handle on untrailing 107 */ 108/*ARGSUSED*/ 109static void 110_handle_cleanup(pword *pw, 111 word *pdata, 112 int size, /* unused (untrail calling convention) */ 113 int flags) /* unused (untrail calling convention) */ 114{ 115 if (!pw || DifferTypeC(pw->tag, TEXTERN)) 116 { 117 p_fprintf(current_err_, "ECLiPSe: handle_cleanup: invalid handle\n"); 118 return; 119 } 120 AnchorFree(pw); 121} 122 123 124/* 125 * Construct a new handle 126 */ 127pword Winapi 128ec_handle(const t_ext_type *class, const t_ext_ptr data) 129{ 130 pword handle; 131 pword *pw; 132 133 /* push global stack anchor */ 134 pw = TG; 135 TG += HANDLE_ANCHOR_SIZE; 136 Check_Gc; 137 pw[0].tag.kernel = TEXTERN; 138 pw[0].val.ptr = (pword *) class; 139 pw[1].tag.kernel = TPTR; 140 pw[1].val.ptr = (pword *) data; 141 142 /* Make handle */ 143 handle.tag.kernel = THANDLE; 144 handle.val.ptr = pw; 145 146 /* Trail cleanup */ 147 ec_trail_undo(_handle_cleanup, pw, NULL, NULL, 0, 0); 148 149 return handle; 150} 151 152 153/* 154 * Get the data pointer from a handle (expect the given type) 155 */ 156int Winapi 157ec_get_handle(const pword handle, const t_ext_type *cl, t_ext_ptr *data) 158{ 159 const pword * pw = &handle; 160 Dereference_(pw); 161 Get_Typed_Object(pw->val, pw->tag, cl, *data); 162 Succeed_; 163} 164 165 166/* 167 * Free the handle eagerly (expect the given type) 168 */ 169int Winapi 170ec_free_handle(const pword handle, const t_ext_type *cl) 171{ 172 const pword * pw = &handle; 173 Dereference_(pw); 174 Check_Typed_Object_Handle(pw->val,pw->tag,(t_ext_type *) cl); 175 AnchorFree(pw->val.ptr); 176 Succeed_; 177} 178 179 180/* 181 * Free the handle eagerly (generic) 182 */ 183int 184p_handle_free(value v_handle, type t_handle) 185{ 186 Check_Type(t_handle, THANDLE); 187 Check_Type(v_handle.ptr->tag, TEXTERN); 188 AnchorFree(v_handle.ptr); 189 Succeed_; 190} 191 192 193/* 194 * Arrange for the handle to get freed on cut 195 */ 196int 197p_handle_free_on_cut(value v_handle, type t_handle) 198{ 199 Check_Type(t_handle, THANDLE); 200 Check_Type(v_handle.ptr->tag, TEXTERN); 201 202 schedule_cut_fail_action((void (*)(value,type)) p_handle_free,v_handle,t_handle); 203 Succeed_; 204} 205 206 207/* 208 * Copy an anchor 209 */ 210void 211handle_copy_anchor( 212 pword *from, /* a heap or global stack location */ 213 pword *to, /* a heap or global stack location */ 214 int trail) /* should be true if *to is a global stack location */ 215{ 216 to[0] = from[0]; 217 if (ExternalClass(from)->copy && ExternalData(from)) 218 to[1].val.ptr = (pword *) ExternalClass(from)->copy(ExternalData(from)); 219 else 220 to[1].val.ptr = (pword *) ExternalData(from); 221 to[1].tag.kernel = from[1].tag.kernel; 222 223 /* Trail cleanup */ 224 if (trail) 225 ec_trail_undo(_handle_cleanup, to, NULL, NULL, 0, 0); 226} 227 228