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 *
20 * Contributor(s): Joachim Schimpf, Stefano Novello, IC-Parc
21 *                 Kish Shen, CrossCore Optimization
22 *
23 * END LICENSE BLOCK */
24
25/*
26 *
27 * ECLiPSe LIBRARY MODULE
28 *
29 * $Header: /cvsroot/eclipse-clp/Eclipse/Oci/dbi.c,v 1.4 2007/07/03 20:42:47 kish_shen Exp $
30 *
31 *
32 * IDENTIFICATION:	dbi.c
33 *
34 * AUTHOR:		Joachim Schimpf
35 * AUTHOR:		Stefano Novello
36 * AUTHOR:              Kish Shen
37 *
38 * DESCRIPTION:
39 */
40
41/*
42 *
43 * Contents:	Prolog wrappers around DB Interface
44 *              taken from oci.c
45 *
46 * Author:	Stefano Novello
47 * Author:      Kish Shen, Generalised and updated from original OCI code,
48 *              intially for MySQL, Jan - Feb 2006.
49 *
50 *
51 */
52
53#include <stdio.h>
54#include "external.h"	/* ECLiPSe definitions */
55#include "dbi.h"	/* Oracle call interface */
56
57#ifdef _WIN32
58#define EXPORT __declspec(dllexport)
59#else
60#define EXPORT
61#endif
62
63static int dbi_errno = 0;
64
65#define CURSOR_HANDLE   1 /* argument index for cursor handle in
66                             the cursor handle structure. Must
67                             correspond to the ECLiPSe level code
68			  */
69/* if a `dbi' error occur, the return code is -1; otherwise it is the bip error */
70#define Error_Code(E) (E == -1 ? dbi_errno : E)
71/* ----------------------------------------------------------------------
72 *  Forward declarations
73 * ---------------------------------------------------------------------- */
74EXPORT int
75p_session_init(
76		/* - */ value v_session, type t_session
77              );
78
79EXPORT int
80p_session_start(
81                /* + */ value v_session, type t_session,
82		/* + */ value v_username, type t_username,
83		/* + */ value v_host, type t_host,
84		/* + */ value v_password, type t_password,
85		/* + */ value v_opts, type t_opts
86		);
87
88EXPORT int
89p_session_close(
90		/* + */ value v_session, type t_session
91                );
92
93EXPORT int
94p_session_error_value(
95		/* + */ value v_session, type t_session,
96		/* + */ value v_code, type t_code,
97		/* + */ value v_message, type t_message
98		);
99
100EXPORT int
101p_session_commit(
102		/* + */ value v_session, type t_session
103		);
104
105EXPORT int
106p_session_rollback(
107		/* + */ value v_session, type t_session
108		);
109
110EXPORT int
111p_session_sql_dml(
112		/* + */ value v_session, type t_session,
113		/* + */ value v_SQL, type t_SQL,
114		/* - */ value v_rows, type t_rows
115		);
116
117EXPORT int
118p_session_sql_query(
119		/* + */ value v_session, type t_session,
120		/* + */ value v_template, type t_template,
121		/* + */ value v_SQL, type t_SQL,
122		/* + */ value v_N, type t_N,
123		/* + */ value v_opts, type t_opts,
124		/* - */ value v_cursor, type t_cursor
125		);
126
127EXPORT int
128p_session_sql_prepare(
129		/* + */ value v_session, type t_session,
130		/* + */ value v_template, type t_template,
131		/* + */ value v_SQL, type t_SQL,
132		/* + */ value v_N, type t_N,
133		/* - */ value v_cursor, type t_cursor
134		);
135
136EXPORT int
137p_session_sql_prepare_query(
138		/* + */ value v_session, type t_session,
139		/* + */ value v_ptemplate, type t_ptemplate,
140		/* + */ value v_qtemplate, type t_qtemplate,
141		/* + */ value v_SQL, type t_SQL,
142		/* + */ value v_N, type t_N,
143		/* - */ value v_cursor, type t_cursor
144		);
145
146EXPORT int
147p_session_is_in_transaction(
148		/* + */ value v_session, type t_session
149                );
150
151EXPORT int
152p_session_set_in_transaction(
153                /* + */ value v_session, type t_session,
154		/* + */ value v_in, type t_in
155                );
156
157EXPORT int
158p_cursor_N_execute(
159		/* + */ value v_cursor, type t_cursor,
160		/* + */ value v_N, type t_N,
161		/* + */ value v_tuples, type t_tuples,
162		/* ? */ value v_tail, type t_tail
163		);
164
165EXPORT int
166p_cursor_next_execute(
167		/* + */ value v_cursor, type t_cursor,
168		/* + */ value v_tuple, type t_tuple,
169		/* + */ value v_opts, type t_opts
170		);
171
172EXPORT int
173p_cursor_next_tuple(
174		/* + */ value v_cursor, type t_cursor,
175		/* - */ value v_tuple, type t_tuple
176		);
177
178EXPORT int
179p_cursor_N_tuples(
180		/* + */ value v_cursor, type t_cursor,
181		/* + */ value v_N, type t_N,
182		/* - */ value v_tuples, type t_tuples,
183		/* ? */ value v_tail, type t_tail
184		);
185
186EXPORT int
187p_cursor_free(
188		/* + */ value v_cursorh, type t_cursorh
189		);
190
191EXPORT int
192p_cursor_field_value(
193		/* + */ value v_cursor, type t_cursor,
194		/* + */ value v_item, type t_item,
195		/* - */ value v_value, type t_value
196		);
197
198EXPORT int
199p_handle_free_eagerly(value v_handle, type t_handle);
200
201
202/* max. number of digits for a printed address - 2 digits per byte */
203#define MAX_ADDRESS_DIGITS 2*sizeof(void *)
204
205#define CURSOR_STRSZ MAX_ADDRESS_DIGITS+20
206
207/* define the strsz methods here -- assume at most an extra 20 characters
208   will be used for the printed handle in addition to the address
209*/
210static int
211cursor_strsz(cursor_t * cursor, int quoted)
212{
213    return CURSOR_STRSZ;
214}
215
216
217t_ext_type cursor_handle_tid = {
218    (void (*)(t_ext_ptr)) cursor_free,  /* free */
219    NULL,  /* copy */
220    NULL,  /* mark_dids */
221    (int (*)(t_ext_ptr,int)) cursor_strsz,  /* string_size */
222    (int (*)(t_ext_ptr,char *,int)) cursor_tostr,  /* to_string */
223    NULL,  /* equal */
224    NULL,  /* remote_copy */
225    NULL,  /* get */
226    NULL   /* set */
227};
228
229
230#define SESSION_STRSZ MAX_ADDRESS_DIGITS+20
231
232static int
233session_strsz(session_t * session, int quoted)
234{
235    return CURSOR_STRSZ;
236}
237
238t_ext_type session_handle_tid = {
239    (void (*)(t_ext_ptr)) session_free,  /* free */
240    (t_ext_ptr (*)(t_ext_ptr)) session_copy,  /* copy */
241    NULL,  /* mark_dids */
242    (int (*)(t_ext_ptr,int)) session_strsz,  /* string_size */
243    (int (*)(t_ext_ptr,char *,int)) session_tostr,  /* to_string */
244    NULL,  /* equal */
245    NULL,  /* remote_copy */
246    NULL,  /* get */
247    NULL   /* set */
248};
249
250/* ----------------------------------------------------------------------
251 *  Initialization and finalization
252 * ---------------------------------------------------------------------- */
253
254EXPORT int
255p_dbi_init(
256		/* + */ value v_errno, type t_errno
257		)
258{
259    static int initialized = 0;
260
261    if (initialized) Succeed_;
262
263    Check_Integer(t_errno);
264    /*
265     * In C error codes are negative while in Prolog they are positive !
266     */
267    dbi_errno = - v_errno.nint;
268
269    dbi_init();  /* do any DB specific initialisation */
270    initialized = 1;
271    Succeed_;
272}
273
274EXPORT int
275p_dbi_final()
276{
277    dbi_final(); /* do any DB specific finalization */
278    Succeed_;
279}
280
281
282/* ----------------------------------------------------------------------
283 *  handler support
284 * ---------------------------------------------------------------------- */
285
286static void
287get_cursor_handlepw(cursor_t *cursor, pword * cursor_handle)
288{
289    session_t * session = cursor->session;
290
291    *cursor_handle = ec_handle(&cursor_handle_tid, cursor);
292
293}
294
295void
296session_free(session_t * session)
297{
298
299    if (session == NULL) return;
300
301    if (--(session->refs) == 0)
302    {
303	if (!session->closed)
304	{
305
306#ifdef DEBUG
307	    fprintf(stderr,"session close\n");
308#endif
309
310	    session_close(session);
311	}
312	free(session);
313    }
314#ifdef DEBUG
315    fprintf(stderr,"session free\n");
316#endif
317
318    return;
319}
320
321session_t *
322session_copy(session_t * session)
323{
324
325    if (session == NULL) return NULL;
326
327    session->refs++;
328
329    return session;
330}
331
332/* ----------------------------------------------------------------------
333 *  Prolog Interface
334 * ---------------------------------------------------------------------- */
335
336int
337p_session_init(
338		/* - */ value v_session, type t_session
339		)
340{
341	session_t * session;
342	pword p_session;
343
344	session_init( &session);
345
346	if (session == NULL)
347	{
348	    Bip_Error(dbi_errno);
349	}
350	session->refs = 1;
351	p_session = ec_handle(&session_handle_tid, session);
352
353	Return_Unify_Pw(v_session, t_session, p_session.val, p_session.tag );
354}
355
356int
357p_session_start(
358 	        /* + */ value v_session, type t_session,
359		/* + */ value v_username, type t_username,
360		/* + */ value v_host, type t_host,
361		/* + */ value v_password, type t_password,
362		/* + */ value v_opts, type t_opts
363		)
364{
365        session_t * session;
366
367	Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
368
369	Check_String(t_username);
370	Check_String(t_host);
371	Check_String(t_password);
372	Check_Structure(t_opts);
373
374	if ( session_start( session,
375			    StringStart(v_username),
376			    StringStart(v_host),
377			    StringStart(v_password),
378			    v_opts) )
379	    Bip_Error(dbi_errno);
380
381	Succeed;
382
383}
384
385int
386p_session_close(value v_session, type t_session)
387{
388    pword handle;
389    handle.val.all = v_session.all;
390    handle.tag.all = t_session.all;
391    session_t * session;
392
393    Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
394
395    session_close(session);
396    return ec_free_handle(handle, &session_handle_tid);
397}
398
399
400int
401p_session_error_value(
402		/* + */ value v_session, type t_session,
403		/* + */ value v_code, type t_code,
404		/* + */ value v_message, type t_message
405		)
406{
407	int code;
408	char * message;
409	pword p;
410	session_t * session;
411	Prepare_Requests;
412
413	Check_Output_Integer(t_code);
414	Check_Output_String(t_message);
415	Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
416
417	session_error_value(session, &code, &message);
418
419	Make_String(&p,message);
420	Request_Unify_Integer(v_code, t_code, code);
421	Request_Unify_Pw(v_message, t_message, p.val, p.tag);
422	Succeed;
423}
424
425int
426p_session_commit(
427		/* + */ value v_session, type t_session
428		)
429{
430	session_t * session;
431
432	Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
433
434	if (session_commit(session))
435		Bip_Error(dbi_errno);
436
437	Succeed;
438}
439
440int
441p_session_rollback(
442		/* + */ value v_session, type t_session
443		)
444{
445	session_t * session;
446	int res;
447
448	Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
449
450	if (res = session_rollback(session))
451	    Bip_Error(Error_Code(res));
452
453	Succeed;
454}
455
456
457int
458p_session_sql_dml(
459		/* + */ value v_session, type t_session,
460		/* + */ value v_SQL, type t_SQL,
461		/* - */ value v_rows, type t_rows
462		)
463{
464	session_t * session;
465	cursor_t * cursor;
466	char * SQL;
467	word rows, *prows;
468	int res;
469
470	Check_String(t_SQL);
471	Check_Output_Integer(t_rows);
472	Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
473
474
475	cursor = session_sql_prepare(session, StringStart(v_SQL), StringLength(v_SQL), 0);
476	if (NULL == cursor)
477	    Bip_Error(dbi_errno);
478
479	if (res = cursor_sql_execute(cursor, 1))
480	{
481	    cursor_free(cursor);
482	    Bip_Error(Error_Code(res));
483	}
484
485	cursor_field_value(cursor, rows_processed_count, (void **)&prows);
486	rows = *prows;
487
488	cursor_free(cursor);
489
490	Return_Unify_Integer(v_rows, t_rows, rows);
491}
492
493int
494p_session_sql_query(
495		/* + */ value v_session, type t_session,
496		/* + */ value v_template, type t_template,
497		/* + */ value v_SQL, type t_SQL,
498		/* + */ value v_N, type t_N,
499		/* + */ value v_opts, type t_opts,
500		/* - */ value v_cursor, type t_cursor
501		)
502{
503	session_t * session;
504	pword p_cursor;
505	char * SQL;
506	template_t * template;
507	cursor_t * cursor;
508	int res;
509	word N;
510
511	Check_Integer(t_N);
512	N = v_N.nint;
513	Check_String(t_SQL);
514	Check_Structure(t_opts);
515	Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
516
517	if (res = template_get(v_template, t_template, &template))
518	{
519	    Bip_Error(Error_Code(res));
520	}
521
522	cursor = ready_session_sql_cursor(session, NULL, template, StringStart(v_SQL), StringLength(v_SQL),  N, 0);
523	if (NULL == cursor ) {  Bip_Error(dbi_errno); }
524
525	if (res = cursor_set_options(cursor, v_opts))
526	{
527	    Bip_Error(Error_Code(res));
528	}
529
530	if (res = cursor_sql_execute(cursor, 0))
531	{
532	    cursor_free(cursor);
533	    Bip_Error(Error_Code(res));
534	}
535
536
537	get_cursor_handlepw(cursor, &p_cursor);
538	Return_Unify_Pw(v_cursor, t_cursor, p_cursor.val, p_cursor.tag);
539}
540
541int
542p_session_sql_prepare(
543		/* + */ value v_session, type t_session,
544		/* + */ value v_template, type t_template,
545		/* + */ value v_SQL, type t_SQL,
546		/* + */ value v_N, type t_N,
547		/* - */ value v_cursor, type t_cursor
548		)
549{
550	session_t * session;
551	pword p_cursor;
552	char * SQL;
553	template_t * template;
554	cursor_t * cursor;
555	int res;
556	word N;
557
558	Check_Integer(t_N);
559	N = v_N.nint;
560	Check_String(t_SQL);
561        Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
562
563	if (res = template_get(v_template, t_template, &template))
564	{
565	    Bip_Error(Error_Code(res));
566	}
567	cursor = session_sql_prep(session,
568				template, StringStart(v_SQL), StringLength(v_SQL), N);
569	if (NULL == cursor)
570	{
571	    Bip_Error(dbi_errno);
572	}
573
574
575	get_cursor_handlepw(cursor, &p_cursor);
576	Return_Unify_Pw(v_cursor, t_cursor, p_cursor.val, p_cursor.tag);
577}
578
579int
580p_session_sql_prepare_query(
581		/* + */ value v_session, type t_session,
582		/* + */ value v_ptemplate, type t_ptemplate,
583		/* + */ value v_qtemplate, type t_qtemplate,
584		/* + */ value v_SQL, type t_SQL,
585		/* + */ value v_N, type t_N,
586		/* - */ value v_cursor, type t_cursor
587		)
588{
589	session_t * session;
590	pword p_cursor;
591	char * SQL;
592	template_t *ptemplate, *qtemplate;
593	cursor_t * cursor;
594	int res;
595	word N;
596
597	Check_Integer(t_N);
598	N = v_N.nint;
599	Check_String(t_SQL);
600	Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
601
602	if (res = template_get(v_ptemplate, t_ptemplate, &ptemplate))
603	{
604	    Bip_Error(Error_Code(res));
605	}
606	if (res = template_get(v_qtemplate, t_qtemplate, &qtemplate))
607	{
608	    Bip_Error(Error_Code(res));
609	}
610
611	cursor = ready_session_sql_cursor(session, ptemplate, qtemplate,
612		     StringStart(v_SQL), StringLength(v_SQL),N,1);
613	if (NULL == cursor)
614	{
615	    Bip_Error(dbi_errno);
616	}
617
618	get_cursor_handlepw(cursor, &p_cursor);
619	Return_Unify_Pw(v_cursor, t_cursor, p_cursor.val, p_cursor.tag);
620}
621
622
623int
624p_session_is_in_transaction(
625		/* + */ value v_session, type t_session
626                )
627{
628	session_t * session;
629
630	Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
631	if (session->in_transaction == 0) Fail;
632
633	Succeed;
634}
635
636
637static void _dbi_reset_in_transaction ARGS((pword*,word*,int,int));
638
639static void _dbi_reset_in_transaction(pword * pw, word * pdata, int size, int flags)
640{
641    session_t * session = ExternalData(pw->val.ptr);
642
643    if (session == NULL) return; /* stale handle */
644    session->in_transaction = 0;
645}
646
647
648p_session_set_in_transaction(
649                /* + */ value v_session, type t_session,
650		/* + */ value v_in, type t_in
651                )
652{
653    session_t * session;
654    pword * pw;
655
656    Check_Integer(t_in);
657    Get_Typed_Object(v_session,t_session,&session_handle_tid,session);
658
659    switch (v_in.nint)
660    {
661    case 1:
662	if (session->in_transaction == 1) { Fail; }
663
664	session->in_transaction = 1;
665
666	ec_trail_undo(_dbi_reset_in_transaction, v_session.ptr, NULL, NULL, 0, 0);
667	break;
668    case 0:
669	session->in_transaction = 0;
670	break;
671    default:
672	Bip_Error(RANGE_ERROR);
673	break;
674    }
675    Succeed;
676}
677
678
679int
680p_cursor_next_execute(
681		/* + */ value v_cursor, type t_cursor,
682		/* + */ value v_tuple, type t_tuple,
683		/* + */ value v_opts, type t_opts
684		)
685{
686    cursor_t * cursor;
687    int res;
688    pword tuple, * argp;
689
690    tuple.val = v_tuple;
691    tuple.tag = t_tuple;
692    Check_Structure(t_opts);
693    Check_Structure(t_cursor);
694    argp = &v_cursor.ptr[CURSOR_HANDLE];
695    Dereference_(argp);
696    Get_Typed_Object(argp->val, argp->tag,&cursor_handle_tid,cursor);
697
698    if (res = cursor_set_options(cursor, v_opts))
699    {
700	Bip_Error(Error_Code(res));
701    }
702
703    if (res = template_bind(0, cursor->param_template,
704		  cursor->param_buffer, cursor->param_datalengths,&tuple))
705    {
706	Bip_Error(Error_Code(res));
707    }
708
709    if (res = cursor_sql_execute(cursor, 0))
710    {
711	Bip_Error(Error_Code(res));
712    }
713
714
715    Succeed;
716}
717
718int
719p_cursor_N_execute(
720		/* + */ value v_cursor, type t_cursor,
721		/* - */ value v_N, type t_N,
722		/* + */ value v_tuples, type t_tuples,
723		/* ? */ value v_tail, type t_tail
724		)
725{
726    cursor_t * cursor;
727    pword * car; pword * cdr, * argp;
728    int res;
729    word tuple;
730    Prepare_Requests;
731
732    Check_Output_Integer(t_N);
733    Check_Structure(t_cursor);
734    Check_Pair(t_tuples);
735    argp = &v_cursor.ptr[CURSOR_HANDLE];
736    Dereference_(argp);
737    Get_Typed_Object(argp->val, argp->tag,&cursor_handle_tid,cursor);
738
739    if (! cursor->param_template)
740	    Bip_Error(TYPE_ERROR);
741
742    if (res = cursor_N_execute(cursor, &tuple, v_tuples, t_tuples, &cdr))
743    {
744	Bip_Error(Error_Code(res));
745    }
746
747    Request_Unify_Integer(v_N, t_N, tuple );
748    Request_Unify_Pw(v_tail, t_tail, cdr->val, cdr->tag);
749    Return_Unify;
750}
751
752int
753p_cursor_next_tuple(
754		/* + */ value v_cursor, type t_cursor,
755		/* - */ value v_tuple, type t_tuple
756		)
757{
758    cursor_t * cursor;
759    int res;
760    template_t * t;
761    pword p_tuple, * argp;
762
763    Check_Structure(t_cursor);
764    argp = &v_cursor.ptr[CURSOR_HANDLE];
765    Dereference_(argp);
766    Get_Typed_Object(argp->val, argp->tag,&cursor_handle_tid,cursor);
767
768    if (res = cursor_one_tuple(cursor))
769    {
770	Bip_Error(Error_Code(res));
771    }
772
773    t = cursor->tuple_template;
774    if (t->to == t->from)
775	Fail;
776
777    if (res = template_put(t->from , t, cursor->sql_type, cursor->tuple_buffer, cursor->tuple_datalengths, &p_tuple))
778    {
779	Bip_Error(Error_Code(res));
780    }
781
782    t->from++;
783    Return_Unify_Pw(v_tuple, t_tuple, p_tuple.val, p_tuple.tag);
784
785}
786
787
788int
789p_cursor_N_tuples(
790		/* + */ value v_cursor, type t_cursor,
791		/* - */ value v_N, type t_N,
792		/* - */ value v_tuples, type t_tuples,
793		/* ? */ value v_tail, type t_tail
794		)
795{
796    cursor_t * cursor;
797    word n;
798    int res;
799    pword tuple_list, * argp;
800    pword * tail;
801    Prepare_Requests;
802
803    Check_Structure(t_cursor);
804    argp = &v_cursor.ptr[CURSOR_HANDLE];
805    Dereference_(argp);
806    Get_Typed_Object(argp->val, argp->tag,&cursor_handle_tid,cursor);
807
808    Check_Output_Integer(t_N);
809    Check_Output_List(t_tuples);
810
811    if (res = cursor_N_tuples(cursor, &n, &tuple_list, &tail))
812    {
813	Bip_Error(Error_Code(res));
814    }
815
816    Request_Unify_Integer(v_N, t_N, n);
817    if (tail == &tuple_list)
818    {
819	Request_Unify_Pw(v_tuples, t_tuples, v_tail, t_tail);
820    }
821    else
822    {
823	Request_Unify_Pw(v_tuples, t_tuples, tuple_list.val, tuple_list.tag);
824	Request_Unify_Pw(v_tail, t_tail, tail->val, tail->tag);
825    }
826    Return_Unify;
827}
828
829int
830p_cursor_free(value v_cursorh, type t_cursorh)
831{
832    pword handle;
833
834    handle.val.all = v_cursorh.all;
835    handle.tag.all = t_cursorh.all;
836
837    return ec_free_handle(handle, &cursor_handle_tid);
838
839
840}
841
842int
843p_cursor_field_value(
844		/* + */ value v_cursor, type t_cursor,
845		/* + */ value v_item, type t_item,
846		/* - */ value v_value, type t_value
847		)
848{
849    cursor_t * cursor;
850    field_t item;
851    void * value;
852    int res;
853    pword * argp;
854
855    Check_Integer(t_item);
856    item = (field_t) v_item.nint;
857    if (item < FIELD_FIRST || item > FIELD_LAST)
858    {
859	Bip_Error(TYPE_ERROR);
860    }
861    if (item == return_code_as_string)
862    {
863	Check_Output_String(t_value);
864    }
865    else
866    {
867	Check_Output_Integer(t_value);
868    }
869    Check_Structure(t_cursor);
870    argp = &v_cursor.ptr[CURSOR_HANDLE];
871    Dereference_(argp);
872    Get_Typed_Object(argp->val, argp->tag,&cursor_handle_tid,cursor);
873
874    if (res = cursor_field_value(cursor, item, &value))
875    {
876	Bip_Error(Error_Code(res));
877    }
878
879    if (item == return_code_as_string)
880    {
881	pword pw;
882
883	Make_String(&pw,*(char **)value);
884	Return_Unify_Pw(v_value, t_value, pw.val, pw.tag);
885    }
886    else
887    {
888	Return_Unify_Integer(v_value, t_value, * (word *)value);
889    }
890
891
892}
893
894
895int
896p_handle_free_eagerly(value v_handle, type t_handle)
897{
898	Check_Type(t_handle, THANDLE);
899	Check_Type(v_handle.ptr->tag, TPTR);
900
901	schedule_cut_fail_action(p_handle_free,v_handle,t_handle);
902	Succeed;
903}
904
905