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