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) 1989-2006 Cisco Systems, Inc. All Rights Reserved. 18 * 19 * Contributor(s): ECRC GmbH and IC-Parc. 20 * 21 * END LICENSE BLOCK */ 22 23/* 24 * SEPIA INCLUDE FILE 25 * 26 * $Id: sepia.h,v 1.14 2015/05/20 23:55:36 jschimpf Exp $ 27 * 28 * IDENTIFICATION sepia.h 29 * 30 * DESCRIPTION : defines Type Tags, and creates macros for 31 * tesing types; returning to SEPIA; 32 * dictionary macros; backtracking macros. 33 * 34 */ 35 36#ifdef _WIN32 37#ifndef EC_EXTERNAL 38/* For building Eclipse itself: avoid to include windows.h everywhere */ 39/* Just define Winapi for the compiler we use (Microsoft C or gcc) */ 40#define Winapi __stdcall 41#define DLLEXP __declspec(dllexport) 42 43#else 44#ifdef EC_EMBED 45This file must not be included with the embedding interface! 46 47#else 48/* For compiling old-style externals */ 49#include <windows.h> 50#define Winapi WINAPI 51#define DLLEXP __declspec(dllimport) 52#endif 53#endif 54 55#else /* UNIX */ 56#define Winapi 57#define DLLEXP 58 59#endif 60 61 62#include "ec_public.h" 63 64 65#ifndef assert 66#ifdef NDEBUG 67#define assert(p) ((void)0) 68#else 69#define assert(e) ((e) ? (void)0 : p_fprintf(current_err_, \ 70 "\nAssertion failed in %s:%d: %s\n", __FILE__, __LINE__, #e)) 71#endif 72#endif 73 74 75/*****************************************************************/ 76/* */ 77/* P R O L O G T A G S */ 78/* */ 79/*****************************************************************/ 80 81/* The order is important for the grouping: 82 * TLIST pointer compound 83 * TCOMP pointer compound 84 * TSUSP pointer opaque 85 * THANDLE pointer opaque 86 * TSTRG pointer atomic 87 * TBIG pointer atomic 88 * TIVL pointer atomic 89 * TRAT pointer atomic 90 * TDBL pointer/simple atomic (see UNBOXED_DOUBLES) 91 * TNIL simple atomic 92 * TINT simple atomic 93 * TDICT simple atomic 94 * TPTR simple atomic 95 */ 96 97#define TLIST 0 /* list (Ptr to global stack or heap) */ 98#define TCOMP 1 /* structure (Ptr to global stack or heap) */ 99#define TSUSP 2 /* suspension (Ptr to global stack) */ 100#define THANDLE 3 /* handle (Ptr to global stack anchor) */ 101#define TSTRG 4 /* string (Ptr to global stack or heap) */ 102#define TBIG 5 /* bignum (Ptr to global stack or heap) */ 103#define TIVL 6 /* breal (Ptr to global stack or heap) */ 104#define TRAT 7 /* rational (Ptr to global stack or heap) */ 105#define TDBL 8 /* double (or ptr to global/heap on 32 bit) */ 106#define TNIL 9 /* nil, value field does not matter */ 107#define TINT 10 /* integer */ 108#define TDICT 11 /* atom / functor */ 109#define TPTR 12 /* pointer - used for objects, arrays and */ 110 /* other highly illogical stuff */ 111 112/* Keep this definition in ec_public.h up-to-date: */ 113/* #define NTYPES 13 * no. of types + var (for codegen) */ 114 115/* internal tags, not unifiable */ 116 117#define TPROC 13 /* goal tag, val is a (pri *) */ 118#define TEND 14 /* to mark the first unused argument */ 119 120/* tags for identifying special global stack structures */ 121 122#define TDE 15 /* delay environment */ 123#define TGRS 16 /* ground body structure (codegen) */ 124#define TGRL 17 /* ground body list (codegen) */ 125#define TEXTERN 18 /* a stack anchor for external data, */ 126 /* referenced by THANDLE pwords. */ 127 /* Value part is pointer to type desc. */ 128 /* Next pword is TPTR | &data. */ 129#define TBUFFER 19 /* a buffer on the global stack, used */ 130 /* for strings, bignums, doubles etc. */ 131 /* The value part gives the number of */ 132 /* bytes - 1 that follow */ 133#define TVARNUM 20 /* for temporarily numbering variables */ 134 135/* If modifying tags, update tag names in printam.c */ 136 137 138/* 139 * variables and references: 140 * - they all have the TREFBIT set and a variable type in Tag(t) 141 * - if not a self reference, the Tag(t) part is irrelevant 142 * - if a self reference, the Tag(t) part type gives the variable type 143 */ 144 145#define TREFBIT SIGN_BIT 146 147#define TVAR_TAG -1 /* simple variable */ 148#define TNAME -2 /* named variable */ 149#define TMETA -3 /* attributed variable (metaterm) */ 150#define TUNIV -4 /* explictly quantified variable */ 151#define TSTAMP -5 /* time stamp (never self reference) */ 152 153#define TFORWARD -6 /* used internally for heap copying */ 154#define TFORWARD2 -7 /* used internally for heap copying */ 155 156 157/* some aliases */ 158 159#define TCUT TINT /* no special tag necessary */ 160 161 162/* 163 * The next 2 bits are used by the garbage collector. They must be zero 164 * when a garbage collection is invoked and they are guaranteed to be zero 165 * after a collection. 166 * Under certain conditions it is possible to use them otherwise, e.g. 167 * locally in a builtin, if it is made sure that they are reset to zero 168 * after use, and that a GC will never be invoked while the bits are set. 169 */ 170#define MARK (SIGN_BIT >> 1) 171#define LINK (SIGN_BIT >> 2) 172 173 174/* 175 * The PERSISTENT bit can be set in the following pointer tags: 176 * TLIST, TCOMP, TSTRG, TBIG, TIVL, TRAT, TDBL, THANDLE 177 * It indicates that the pointer points to a non-volatile, shareable heap 178 * copy of the object (usually an entry in the table of ground constants). 179 * Losing the bit will disable sharing-based optimizations, but should 180 * otherwise be non-fatal. However, care must be taken not to copy this 181 * bit (along with the rest of the tag) to non-persistent pointer values: 182 * Use new_tag = Tag(old_tag) to copy any (nonvar) pointer tag! 183 */ 184#define PERSISTENT (SIGN_BIT >> 3) 185 186 187/* 188 * Bits that can be set in TBUFFER tags: 189 * IN_DICT a corresponding atom exists (only in TSTRG buffers) 190 * BIGSIGN sign of a bignum (only in TBIG buffers) 191 * RAW_IVL lexer breal, unnormalised (only in TIVL buffers) 192 */ 193#define IN_DICT (SIGN_BIT >> 3) 194#define BIGSIGN (SIGN_BIT >> 3) 195#define RAW_IVL (SIGN_BIT >> 3) 196 197/* 198 * Bit that can be set in a TPROC (event handler property) tag 199 */ 200#define EVENT_DEFERS (SIGN_BIT >> 3) 201 202/* 203 * Bit that can be set in TMETA tag: 204 * HIDE_ATTR suppresses printing of the attribute 205 */ 206#define HIDE_ATTR (SIGN_BIT >> 3) 207 208/* 209 * Variable names are stored as 19-bit field in variable tags 210 */ 211#define TAG_NAME_MASK 0x07ffff00 212 213 214/*****************************************************************/ 215/* */ 216/* TAG CONSTRUCTION */ 217/* */ 218/*****************************************************************/ 219 220/* 221 * construct a non-variable tag from another tag of the same type 222 */ 223#define Tag(t) ((t) & 0xFF) 224 225/* 226 * construct a variable tag: tagtype is TVAR_TAG,TNAME,TMETA etc 227 */ 228#define RefTag(tagtype) (SIGN_BIT|Tag(tagtype)) 229#define TREF RefTag(TVAR_TAG) /* simple var/ref tag */ 230 231/* 232 * the same for a named variable 233 */ 234#define DidTag(tagtype, vdid) (RefTag(tagtype)|DidBitField(vdid)<<8) 235 236 237/*****************************************************************/ 238/* */ 239/* T A G T E S T I N G macros */ 240/* */ 241/*****************************************************************/ 242 243#define TagNameField(t) ((t) & TAG_NAME_MASK) 244#define IsNamed(t) TagNameField(t) 245#define TagDid(t) ((dident) bitfield_did((word)(TagNameField(t)>>8))) 246 247#define TagTypeC(t) ((int8) (t)) 248#define TagType(item_tag) TagTypeC((item_tag).kernel) 249#define SameType(item_tag1,item_tag2)\ 250 (TagType(item_tag1) == TagType(item_tag2)) 251#define SameTypeC(item_tag,c) (TagType(item_tag) == TagTypeC(c)) 252#define DifferType(item_tag1,item_tag2)\ 253 (TagType(item_tag1) != TagType(item_tag2)) 254#define DifferTypeC(item_tag,c) (TagType(item_tag) != TagTypeC(c)) 255 256 /* test for reference, including self reference (all variables) */ 257#define IsRef(item_tag) (item_tag.kernel < 0) 258#define ISRef(t) ((t) < 0) 259 260 /* test for simple variable */ 261#define IsVar(item_tag) SameTypeC(item_tag, Tag(TVAR_TAG)) 262 263#define IsForward(item_tag) SameTypeC(item_tag, Tag(TFORWARD)) 264#define IsPersistent(item_tag) ((item_tag).kernel & PERSISTENT) 265#define IsCompound(d) (IsList(d) || IsStructure(d)) 266#define IsNumber(d) (!IsRef(d) && tag_desc[TagType(d)].numeric) 267#define ISAtomic(tag) (TagTypeC(tag) >= TagTypeC(TSTRG)) 268 269#define IsUniv(item) SameTypeC(item, Tag(TUNIV)) 270#define IsMeta(item) SameTypeC(item, Tag(TMETA)) 271#define IsName(item) SameTypeC(item, Tag(TNAME)) 272#define IsSusp(item) SameTypeC(item, TSUSP) 273#define IsList(item) SameTypeC(item, TLIST) 274#define IsStructure(item) SameTypeC(item, TCOMP) 275#define IsString(item) SameTypeC(item, TSTRG) 276#define IsBignum(item) SameTypeC(item, TBIG) 277#define IsRational(item) SameTypeC(item, TRAT) 278#define IsDouble(item) SameTypeC(item, TDBL) 279#define IsInterval(item) SameTypeC(item, TIVL) 280#define IsNil(item) SameTypeC(item, TNIL) 281#define IsInteger(item) SameTypeC(item, TINT) 282#define IsAtom(item) SameTypeC(item, TDICT) 283#define IsProc(item) SameTypeC(item, TPROC) 284#define IsHandle(item) SameTypeC(item, THANDLE) 285 286#define IsArray(v, t) \ 287 (IsStructure(t) && DidString((v).ptr->val.did) == DidString(d_.nil)) 288 289 290/* 291 * These tag testing macros are similar to the ones above 292 * but they take a 'ktype' as argument rather than a 'type'. 293 */ 294 295#define IsTag(t,c) (TagTypeC(t) == TagTypeC(Tag(c))) 296#define EqTag(t1,t2) (TagTypeC(t1) == TagTypeC(t2)) 297 298 299/* Compare two simple values. For TNIL the value does not matter. 300 * Note that if the value is a float, we still compare it as if it 301 * was an integer, which lets us distinguish -0.0 from 0.0. 302 */ 303 304#define SimpleEq(t,v1,v2) \ 305 ((v1).all == (v2).all \ 306 || IsTag(t,TNIL)) 307 308#ifdef UNBOXED_DOUBLES 309#define ISSimple(t) (TagTypeC(t) >= TagTypeC(TDBL)) 310#else 311#define ISSimple(t) (TagTypeC(t) > TagTypeC(TDBL)) 312#endif 313 314#define IsSimple(item_tag) ISSimple((item_tag).kernel) 315 316 317/* 318 * Used by th GC. It yields true for all pwords whose value part might 319 * be a pointer into the global stack (ie. references and compounds) 320 */ 321#ifdef UNBOXED_DOUBLES 322#define ISPointer(tag) (TagTypeC(tag) < TagTypeC(TDBL)) 323#else 324#define ISPointer(tag) (TagTypeC(tag) <= TagTypeC(TDBL)) 325#endif 326 327 328/* 329 * This one is needed by th GC. A "special" tag occurs only inside 330 * the global stack and is never handled by prolog. 331 */ 332#define ISSpecial(tag) (TagTypeC(tag) > TagTypeC(TEND)) 333 334 335/*****************************************************************/ 336/* */ 337/* E R R O R macros */ 338/* */ 339/*****************************************************************/ 340 341#define Error_If_Ref(tag) if (IsRef(tag)) {\ 342 Bip_Error(INSTANTIATION_FAULT)\ 343 } 344 345#define Bip_Error(errcode) return(errcode); 346 347#define Set_Errno { \ 348 ec_os_errgrp_ = 0 /*ERRNO_UNIX*/ ; \ 349 ec_os_errno_ = errno; \ 350 errno = 0; } 351 352#define Bip_Throw(val, tag) return return_throw(val, tag); 353 354#define Exit_Block(val, tag) longjmp_throw(val, tag); 355 356 357/*****************************************************************/ 358/* */ 359/* S U C C E E D / F A I L macros */ 360/* */ 361/*****************************************************************/ 362 363#define Succeed_ return(PSUCCEED); 364#define Fail_ return(PFAIL); 365#define Succeed_If(cond) return((cond) ? PSUCCEED : PFAIL); 366#define Succeed_Last { Cut_External; Succeed_; } 367 368 369/*****************************************************************/ 370/* */ 371/* C H E C K T Y P E macros */ 372/* */ 373/*****************************************************************/ 374 375#define Check_Type(tag, type) \ 376 if (DifferTypeC(tag, type)) { \ 377 Error_If_Ref(tag); \ 378 Bip_Error(TYPE_ERROR) \ 379 } 380#define Check_Ref(item) \ 381 if (!IsRef(item)) \ 382 { \ 383 Bip_Error(TYPE_ERROR) \ 384 } 385#define Check_List(item) \ 386 if ((!IsList(item)) && (!IsNil(item)))\ 387 { \ 388 Error_If_Ref(item); \ 389 Bip_Error(TYPE_ERROR) \ 390 } 391#define Check_Pair(item) Check_Type(item, TLIST) 392#define Check_Structure(item) Check_Type(item, TCOMP) 393#define Check_String(item) Check_Type(item, TSTRG) 394#define Check_Nil(item) Check_Type(item, TNIL) 395#define Check_Atom(item) Check_Type(item, TDICT) 396#define Check_Double(item) Check_Type(item, TDBL) 397#define Check_Interval(item) Check_Type(item, TIVL) 398/* 399 * The following macros cope with the special representation of [] in Sepia. 400 * It is like Check_Atom except that is succeeds even for nil and sets 401 * the val to the nil DID. It is the responsibility of the caller to 402 * make sure that it will pass to Prolog the TNIL and not (TDICT, d_.nil); 403 */ 404#define Check_Output_Atom_Or_Nil(val, tag) \ 405 if (IsNil(tag)) \ 406 val.did = d_.nil; \ 407 else if (!IsRef(tag) && !IsAtom(tag)) { \ 408 Bip_Error(TYPE_ERROR) \ 409 } 410#define Check_Atom_Or_Nil(val, tag) \ 411 if (IsNil(tag)) \ 412 val.did = d_.nil; \ 413 else if (!IsAtom(tag)) \ 414 { \ 415 Error_If_Ref(tag); \ 416 Bip_Error(TYPE_ERROR) \ 417 } 418 419/* check for short integers, make range error for bignums */ 420 421#define Check_Integer(tag) \ 422 if (DifferTypeC(tag,TINT)) { \ 423 Error_If_Ref(tag); \ 424 if (SameTypeC(tag, TBIG)) \ 425 { Bip_Error(RANGE_ERROR); } \ 426 else if (IsNumber(tag)) \ 427 { Bip_Error(TYPE_ERROR); } \ 428 else { Bip_Error(ARITH_TYPE_ERROR); } \ 429 } 430 431/* check for any kind of integer, including bignums */ 432 433#define Check_Integer_Or_Bignum(tag) \ 434 if (DifferTypeC(tag,TINT)) { \ 435 if (DifferTypeC(tag, TBIG)) { \ 436 Error_If_Ref(tag); \ 437 if (IsNumber(tag)) \ 438 { Bip_Error(TYPE_ERROR); } \ 439 else { Bip_Error(ARITH_TYPE_ERROR); } \ 440 } \ 441 } 442 443/* check for float or double */ 444 445#define Check_Float(tag) \ 446 if (DifferTypeC(tag,TDBL)) { \ 447 Error_If_Ref(tag); \ 448 if (IsNumber(tag)) \ 449 { Bip_Error(TYPE_ERROR); } \ 450 else { Bip_Error(ARITH_TYPE_ERROR); } \ 451 } 452 453/* check for any numeric type */ 454 455#define Check_Number(tag) \ 456 if (!IsNumber(tag)) \ 457 { \ 458 Error_If_Ref(tag); \ 459 Bip_Error(ARITH_TYPE_ERROR) \ 460 } 461 462/* check for potential goal types */ 463 464#define Check_Goal(tag) \ 465 if (!(IsCompound(tag) || IsNil(tag) || IsAtom(tag))) \ 466 { \ 467 Error_If_Ref(tag); \ 468 Bip_Error(TYPE_ERROR) \ 469 } 470 471/*****************************************************************/ 472/* */ 473/* C H E C K O U T P U T T Y P E macros */ 474/* */ 475/*****************************************************************/ 476 477#define Check_Output_Type(tag, type) \ 478 if (!IsRef(tag) && !SameTypeC(tag, type)) { \ 479 Bip_Error(TYPE_ERROR) \ 480 } 481#define Check_Output_List(item) \ 482 if (!IsRef(item) && (!IsList(item)) && (!IsNil(item)))\ 483 { \ 484 Bip_Error(TYPE_ERROR) \ 485 } 486#define Check_Output_Pair(item) Check_Output_Type(item, TLIST) 487#define Check_Output_Structure(item) Check_Output_Type(item, TCOMP) 488#define Check_Output_String(item) Check_Output_Type(item, TSTRG) 489#define Check_Output_Nil(item) Check_Output_Type(item, TNIL) 490#define Check_Output_Atom(item) Check_Output_Type(item, TDICT) 491 492#define Check_Output_Integer(tag) \ 493 if (!IsRef(tag) && !SameTypeC(tag, TINT)) { \ 494 if (SameTypeC(tag, TBIG)) \ 495 { Fail_; } \ 496 else if (IsNumber(tag)) \ 497 { Bip_Error(TYPE_ERROR); } \ 498 else { Bip_Error(ARITH_TYPE_ERROR); } \ 499 } 500 501#define Check_Output_Integer_Or_Bignum(tag) \ 502 if (!IsRef(tag) && !SameTypeC(tag, TINT) && !SameTypeC(tag, TBIG)) { \ 503 if (IsNumber(tag)) \ 504 { Bip_Error(TYPE_ERROR); } \ 505 else { Bip_Error(ARITH_TYPE_ERROR); } \ 506 } 507 508#define Check_Output_Float(tag) \ 509 if (!IsRef(tag) && DifferTypeC(tag,TDBL)) { \ 510 if (IsNumber(tag)) \ 511 { Bip_Error(TYPE_ERROR); } \ 512 else { Bip_Error(ARITH_TYPE_ERROR); } \ 513 } 514 515#define Check_Output_Interval(tag) \ 516 if (!IsRef(tag) && DifferTypeC(tag,TIVL)) { \ 517 if (IsNumber(tag)) \ 518 { Bip_Error(TYPE_ERROR); } \ 519 else { Bip_Error(ARITH_TYPE_ERROR); } \ 520 } 521 522#define Check_Output_Number(tag) \ 523 if (!IsRef(tag) && !IsNumber(tag)) { \ 524 Bip_Error(ARITH_TYPE_ERROR); \ 525 } 526 527/******************************************************************/ 528/* */ 529/* U N I F I C A T I O N macros */ 530/* */ 531/******************************************************************/ 532 533#define Unify_Pw(vx,tx,vy,ty) ec_unify_(vx,tx,vy,ty,&MU) 534 535#define Prepare_Requests int uNiFy_result = PSUCCEED; 536 537#define Request_Unify_Pw(vx,tx,vy,ty) \ 538 uNiFy_result = uNiFy_result == PFAIL ? PFAIL : ec_unify_(vx,tx,vy,ty,&MU); 539 540#define Request_Unify_Type(vx,tx,valytype,v,t) \ 541 { \ 542 pword py; \ 543 py.tag.kernel = (t); \ 544 py.val.valytype = (v); \ 545 Request_Unify_Pw(vx,tx,py.val,py.tag)\ 546 } 547 548 549#define Request_Unify_Integer(vx,tx,vy) Request_Unify_Type(vx,tx,nint,vy,TINT) 550#define Request_Unify_Atom(vx,tx,vy) \ 551 Request_Unify_Type(vx,tx,did,vy,((vy) == d_.nil ? TNIL : TDICT)) 552#define Request_Unify_String(vx,tx,vy) Request_Unify_Type(vx,tx,ptr,vy,TSTRG) 553#define Request_Unify_List(vx,tx,vy) Request_Unify_Type(vx,tx,ptr,vy,TLIST) 554#define Request_Unify_Structure(vx,tx,vy) Request_Unify_Type(vx,tx,ptr,vy,TCOMP) 555#define Request_Unify_Nil(vx,tx) Request_Unify_Type(vx,tx,nint,0,TNIL) 556 557#define Request_Unify_Float(vx,tx,dbl) { \ 558 pword result_pw; \ 559 Make_Checked_Float(&result_pw, dbl); \ 560 Request_Unify_Pw(vx, tx, result_pw.val, result_pw.tag) \ 561 } 562 563#define Request_Unify_Double(vx,tx,dbl) { \ 564 pword result_pw; \ 565 Make_Checked_Double(&result_pw, dbl); \ 566 Request_Unify_Pw(vx, tx, result_pw.val, result_pw.tag) \ 567 } 568 569#define Request_Unify_Interval(vx,tx,from,to) { \ 570 pword result_pw; \ 571 Make_Checked_Interval(&result_pw, from, to); \ 572 Request_Unify_Pw(vx, tx, result_pw.val, result_pw.tag) \ 573 } 574 575 576#define Return_If_Failure if (uNiFy_result == PFAIL) return PFAIL; 577#define Return_If_Not_Success(_err) { if ((_err) != PSUCCEED) return (_err); } 578#define Return_If_Error(_err) { if ((_err) < 0) return (_err); } 579#define Return_Unify return uNiFy_result; 580 581#define Return_Unify_Pw(vx,tx,vy,ty) return ec_unify_(vx,tx,vy,ty,&MU); 582 583#define Return_Unify_Type(vx,tx,valytype,v,t) \ 584 { \ 585 pword py; \ 586 py.tag.kernel = (t); \ 587 py.val.valytype = (v); \ 588 Return_Unify_Pw(vx,tx,py.val,py.tag)\ 589 } 590 591#define Return_Unify_Integer(vx,tx,vy) Return_Unify_Type(vx,tx,nint,vy,TINT) 592#define Return_Unify_Atom(vx,tx,vy) \ 593 Return_Unify_Type(vx,tx,did,vy,((vy) == d_.nil ? TNIL : TDICT)) 594#define Return_Unify_String(vx,tx,vy) Return_Unify_Type(vx,tx,ptr,vy,TSTRG) 595#define Return_Unify_List(vx,tx,vy) Return_Unify_Type(vx,tx,ptr,vy,TLIST) 596#define Return_Unify_Structure(vx,tx,vy) Return_Unify_Type(vx,tx,ptr,vy,TCOMP) 597#define Return_Unify_Nil(vx,tx) Return_Unify_Type(vx,tx,nint,0,TNIL) 598 599#define Return_Unify_Float(vx,tx,dbl) { \ 600 pword result_pw; \ 601 Make_Checked_Float(&result_pw, dbl); \ 602 Return_Unify_Pw(vx, tx, result_pw.val, result_pw.tag) \ 603 } 604 605#define Return_Unify_Double(vx,tx,dbl) { \ 606 pword result_pw; \ 607 Make_Checked_Double(&result_pw, dbl); \ 608 Return_Unify_Pw(vx, tx, result_pw.val, result_pw.tag) \ 609 } 610 611#define Return_Unify_Interval(vx,tx,from,to) { \ 612 pword result_pw; \ 613 Make_Checked_Interval(&result_pw, from, to); \ 614 Return_Unify_Pw(vx, tx, result_pw.val, result_pw.tag) \ 615 } 616 617 618/******************************************************************/ 619/* */ 620/* D E R E F E N C I N G macro */ 621/* */ 622/******************************************************************/ 623 624#define Dereference_(ref) \ 625 while (IsRef(ref->tag) && ref != ref->val.ptr) \ 626 ref = ref->val.ptr; 627 628 629#define IsSelfRef(ref) ((ref)->val.ptr == (ref)) 630 631 632/****************************************************************/ 633/* Backtracking Externals */ 634/****************************************************************/ 635 636#define Remember(n, v, t) \ 637 { \ 638 int code = ec_remember(n, v, t);\ 639 if (code != PSUCCEED) \ 640 { \ 641 Bip_Error(code); \ 642 } \ 643 } 644 645#define Cut_External cut_external(); 646 647 648/******************************************************************/ 649/* Overflow Checks */ 650/******************************************************************/ 651 652#define Check_Trail_Ov if (TT <= TT_LIM) trail_ov(); 653#define Check_Gc if (TG >= TG_LIM) global_ov(); 654#define GlobalStackOverflow (TG >= TG_LIM && final_overflow()) 655#define Check_Available_Pwords(n) \ 656 if ((uword)(n) > (uword)((pword*) TT - TG)) { \ 657 pword exit_tag; \ 658 Make_Atom(&exit_tag, d_.global_trail_overflow); \ 659 Bip_Throw(exit_tag.val, exit_tag.tag); \ 660 } 661 662 663/******************************************************************/ 664/* Term construction */ 665/******************************************************************/ 666 667#define Make_Nil(pw) \ 668 (pw)->tag.kernel = TNIL; 669 670#define Make_Atom(pw, wdid) \ 671 (pw)->tag.kernel = TDICT; \ 672 (pw)->val.did = wdid; 673 674#define Make_Integer(pw, /* word */ n) \ 675 (pw)->tag.kernel = TINT; \ 676 (pw)->val.nint = (word) (n); 677 678#define Make_Double(pw, /* double */ dbl) \ 679 (pw)->tag.kernel = TDBL; \ 680 Make_Double_Val((pw)->val, dbl) 681 682#define Make_Checked_Double(pw, /* double */ dbl) \ 683 (pw)->tag.kernel = TDBL; \ 684 Make_Checked_Double_Val((pw)->val, dbl) 685 686#define Make_Float(pw, /* double */ dbl) \ 687 Make_Double(pw, dbl) 688 689#define Make_Checked_Float(pw, /* double */ dbl) \ 690 Make_Checked_Double(pw, dbl) 691 692#define Make_Interval(pw,from,to) { \ 693 (pw)->tag.kernel = TIVL; \ 694 Push_Interval((pw)->val.ptr,from,to) \ 695} 696 697#define Make_Checked_Interval(pw,from,to) { \ 698 (pw)->tag.kernel = TIVL; \ 699 Push_Checked_Interval((pw)->val.ptr,from,to) \ 700} 701 702#define Make_String(pw, /* char * */ s) \ 703 (pw)->tag.kernel = TSTRG; \ 704 Cstring_To_Prolog(s, (pw)->val) 705 706#define Make_List(pw, plist) \ 707 (pw)->tag.kernel = TLIST; \ 708 (pw)->val.ptr = (plist) 709 710#define Push_List_Frame() \ 711 TG += 2; \ 712 Check_Gc; 713 714#define Make_Struct(pw, pstruct) \ 715 (pw)->tag.kernel = TCOMP; \ 716 (pw)->val.ptr = (pstruct) 717 718#define Push_Struct_Frame(wdid) { \ 719 register pword *_pstruct = TG; \ 720 TG += DidArity(wdid) + 1; \ 721 Check_Gc; \ 722 _pstruct->val.did = (wdid); \ 723 _pstruct->tag.kernel = TDICT; } 724 725#define Make_Susp(pw, p) \ 726 (pw)->tag.kernel = TSUSP; \ 727 (pw)->val.ptr = (p); 728 729#define Make_Ref(pw, p) \ 730 (pw)->tag.kernel = TREF; \ 731 (pw)->val.ptr = (p); 732 733#define Make_Var(pw) \ 734 (pw)->tag.kernel = TREF; \ 735 (pw)->val.ptr = (pw); 736 737#define Make_NamedVar(pw, namedid) \ 738 (pw)->tag.kernel = DidTag(TNAME, namedid); \ 739 (pw)->val.ptr = (pw); 740 741#define Push_Var() \ 742 ++TG; \ 743 Make_Var(TG-1); \ 744 Check_Gc; 745 746#define Push_NamedVar(namedid) \ 747 ++TG; \ 748 Make_NamedVar(TG-1, namedid); \ 749 Check_Gc; 750/* 751 * Global Stack Buffers, used for strings, bignums, rationals, doubles, ... 752 */ 753 754#define Push_Buffer(size_bytes) { \ 755 register pword *_pstruct = TG; \ 756 TG += BufferSizePwords(size_bytes); \ 757 Check_Gc; \ 758 Set_Buffer_Size(_pstruct, size_bytes); \ 759 _pstruct->tag.kernel = TBUFFER; } 760 761#define Trim_Buffer(pw, size_bytes) { \ 762 Set_Buffer_Size(pw, size_bytes); \ 763 TG = (pw) + BufferSizePwords(size_bytes); } 764 765#define Set_Buffer_Size(pw, size_bytes) (pw)->val.nint = (size_bytes) - 1; 766#define BufferSize(pw) ((int) (pw)->val.nint + 1) 767#define BufferStart(pw) ((pw) + 1) 768#define BufferPwords(pw) ((int) (pw)->val.nint / sizeof(pword) + 2) 769#define BufferSizePwords(size_bytes) (((size_bytes) - 1) / sizeof(pword) + 2) 770 771#define BigNegative(pw) ((pw)->tag.kernel & BIGSIGN) 772 773/* 774 * S T R I N G S 775 * 776 * +----------+ 777 * SEPIA strings look | | 778 * like this: | "....\0" | 779 * | | 780 * +---------+ +----------+ 781 * | TSTRG | | TBUFFER | 782 * +---------+ +----------+ 783 * | -----------------> | length | 784 * +---------+ +----------+ 785 * 786 * The string itself may be in the global stack or in the heap. 787 * If it is a non-volatile heap string its tag is TBUFFER|IN_DICT. 788 * Although we have the explicit length information, the strings are 789 * always terminated with a zero character to keep C compatibility. 790 * The length field is the string length in bytes without the terminator. 791 */ 792 793/* get the string length from its value part */ 794 795#define StringLength(v) ((v).ptr->val.nint) 796 797 798/* get a pointer to the string characters from the value part */ 799 800#define StringStart(v) ((char *) BufferStart((v).ptr)) 801 802 803#define StringInDictionary(v) ((v).ptr->tag.kernel & IN_DICT) 804 805 806/* Create an uninitialised string buffer on the global stack. 807 * Assign the value to <v> and the buffer pointer to <start>. 808 * The buffer can hold <len> bytes plus a zero terminator. 809 */ 810#define Make_Stack_String(len, v, start) \ 811 (v).ptr = TG;\ 812 Push_Buffer((len)+1);\ 813 (start) = StringStart(v); 814 815 816/* Build a prolog string from an existing C string (zero terminated). 817 * The C string is copied to the global stack and a length field added. 818 */ 819#define Cstring_To_Prolog(cstring, v) \ 820 { char *neww, *old = (cstring);\ 821 (v).ptr = TG;\ 822 Push_Buffer(1);\ 823 neww = StringStart(v);\ 824 while((*neww++ = *old++))\ 825 if (neww == (char *) TG) {\ 826 TG++; Check_Gc;\ 827 }\ 828 Set_Buffer_Size((v).ptr, neww - StringStart(v));\ 829 } 830 831 832#define Copy_Bytes(dest, source, len) \ 833 { register char *dp = dest;\ 834 register char *sp = source;\ 835 register word ctr = len;\ 836 while (ctr-- > 0) *dp++ = *sp++;\ 837 } 838 839/* 840 * Arrays 841 */ 842 843#define Check_Array_Or_Nil(v, t, psize) \ 844 if (IsArray(v, t)) { \ 845 *(psize) = DidArity((v).ptr->val.did); \ 846 } else if (IsNil(t)) { \ 847 *(psize) = 0; \ 848 } else { \ 849 Error_If_Ref(t) \ 850 Bip_Error(TYPE_ERROR) \ 851 } 852 853#define ArraySize(v) DidArity((v).ptr->val.did) 854 855 856/* 857 * D O U B L E S 858 */ 859 860#ifdef UNBOXED_DOUBLES 861 862#define Dbl(v) ((v).dbl) 863 864#define Make_Double_Val(v, /* double */ dexpr) \ 865 (v).dbl = (dexpr); 866 867#define Make_Checked_Double_Val(v, dexpr) { \ 868 double _d = (dexpr); \ 869 Check_Float_Exception(_d); \ 870 (v).dbl = _d; \ 871 } 872 873#else 874 875#define Dbl(v) (*((double *) (((v).ptr)+1))) 876 877/* CAUTION: read input before storing output - may be same location */ 878#define Make_Double_Val(v, /* double */ dexpr) { \ 879 double _d = (dexpr); \ 880 (v).ptr = TG; \ 881 Push_Buffer(sizeof(double)); \ 882 *((double *) BufferStart((v).ptr)) = _d; \ 883 } 884 885#define Make_Checked_Double_Val(v, dexpr) { \ 886 double _d = (dexpr); \ 887 Check_Float_Exception(_d); \ 888 (v).ptr = TG; \ 889 Push_Buffer(sizeof(double)); \ 890 *((double *) BufferStart((v).ptr)) = _d; \ 891 } 892 893#endif 894 895 896/* 897 * Check a float/double and raise an exception for NaN. 898 * CAUTION: argument may be expanded twice! 899 */ 900#ifdef HAVE_ISNAN 901# ifdef _WIN32 902# define GoodFloat(x) (!_isnan(x)) 903# else 904# define GoodFloat(x) (!isnan(x)) 905# endif 906#else 907# define GoodFloat(x) ((x)==(x)) /* fails for NaN */ 908#endif 909 910#define Check_Float_Exception(x) \ 911 { if (!GoodFloat(x)) {Bip_Error(ARITH_EXCEPTION);} } 912 913 914/* 915 * Portable check for floating-point finite-ness 916 */ 917 918#ifndef HAVE_FINITE 919# ifdef HAVE_ISINF 920# define finite(f) (!isinf(f)) 921# else 922# define finite(f) ((f)==0.0 || (f)+(f)!=(f)) /* arg multiply expanded! */ 923# endif 924#endif 925 926 927/* 928 * Macros for comparing doubles while distinguishing 929 * negative and positive zeros. C's == doesn't do that! 930 */ 931 932#define PedanticEq(d1,d2) \ 933 ((d1) == (d2) && ((d1) != 0.0 || PedanticZeroEq(d1,d2))) 934 935#define PedanticZeroEq(d1,d2) \ 936 (1.0/(d1) == 1.0/(d2)) 937 938#define PedanticLess(d1,d2) \ 939 ((d1) < (d2) || ((d1) == (d2) && (d1 == 0.0) && PedanticZeroLess(d1,d2))) 940 941#define PedanticGreater(d1,d2) \ 942 PedanticLess(d2,d1) 943 944#define PedanticZeroLess(d1,d2) \ 945 (1.0/(d1) < 1.0/(d2)) 946 947 948/* 949 * on Solaris, atan2() gives incorrect results with negative zeros 950 */ 951#ifdef __sun__ 952#define Atan2(y,x) ((x)==0.0 && (y)==0.0 ? atan2(y,1/(x)) : atan2(y,x)) 953#else 954#define Atan2(y,x) atan2(y,x) 955#endif 956 957 958#ifdef HAVE_CEIL_NEGZERO_BUG 959/* workaround for bug that incorrectly returns 0.0 960 instead of -0.0 when argument is >-1.0 and <-0.0 961*/ 962#define Ceil(x) \ 963 ( ceil(x) == 0.0 && x != -0.0 ? ceil(x)*x : ceil(x)) 964 965#else 966 967#define Ceil(x) ceil(x) 968 969#endif 970 971 972/* Use SafePow() if x may be zero and y negative */ 973#ifdef HAVE_POW_ZERO_NEG_BUG 974#define SafePow(x,y) ((x)==0.0 && (y)<0 ? 1.0/Pow(x,-(y)) : Pow(x,y)) 975#else 976#define SafePow(x,y) Pow(x,y) 977#endif 978 979#if defined(i386) && defined(__GNUC__) 980#define Pow (*pow_ptr_to_avoid_buggy_inlining) 981extern double (*pow_ptr_to_avoid_buggy_inlining)(double,double); 982#else 983#define Pow pow 984#endif 985 986 987/* 988 * Double Intervals 989 */ 990 991#define IvlLwb(pw) (*((double *) ((pw)+1))) 992#define IvlUpb(pw) (*((double *) ((pw)+1) + 1)) 993 994#define GoodInterval(pw) (!PedanticGreater(IvlLwb(pw), IvlUpb(pw))) 995#define RawInterval(pw) ((pw)->tag.kernel & RAW_IVL) 996 997#define Check_Interval_Exception(x) \ 998 { if (!GoodInterval(x)) { Bip_Error(ARITH_EXCEPTION);} } 999 1000#define Push_Interval(pw,from,to) { \ 1001 (pw) = TG; \ 1002 Push_Buffer(2*sizeof(double)); \ 1003 IvlLwb(pw) = from; \ 1004 IvlUpb(pw) = to; \ 1005} 1006 1007#define Push_Checked_Interval(pw,from,to) { \ 1008 Push_Interval(pw, from, to); \ 1009 Check_Interval_Exception(pw); \ 1010} 1011 1012#define Mark_Interval_Raw(pw) \ 1013 (pw)->tag.kernel |= RAW_IVL; 1014 1015#define Unmark_Interval_Raw(pw) \ 1016 (pw)->tag.kernel &= ~RAW_IVL; 1017 1018 1019/****************************************************************/ 1020/* Handles to external data */ 1021/****************************************************************/ 1022 1023#define Check_Typed_Object_Handle(v, t, expected_class) { \ 1024 Check_Type((t), THANDLE); \ 1025 Check_Type((v).ptr->tag, TEXTERN); \ 1026 if (ExternalClass((v).ptr) != (expected_class)) \ 1027 { Bip_Error(TYPE_ERROR); } \ 1028} 1029 1030#define Get_Typed_Object(v, t, expected_class, obj) { \ 1031 Check_Typed_Object_Handle(v, t, expected_class); \ 1032 (obj) = ExternalData((v).ptr); \ 1033 if (!(obj)) { Bip_Error(STALE_HANDLE); } \ 1034} 1035 1036#define ExternalClass(h) ((t_ext_type*) (h)[0].val.ptr) 1037#define ExternalData(h) ((generic_ptr) (h)[1].val.ptr) 1038 1039#define HANDLE_ANCHOR_SIZE 2 1040 1041 1042/****************************************************************/ 1043/* Timestamps to optimize trailing */ 1044/****************************************************************/ 1045 1046#define Init_Stamp(p) \ 1047 (p)->val.ptr = TG_ORIG ; (p)->tag.kernel = TREF; 1048 1049#define Make_Stamp(p) \ 1050 (p)->val.ptr = GB ; (p)->tag.kernel = TREF; 1051 1052#define OldStamp(p) \ 1053 ((p)->val.ptr < GB) 1054 1055#define Trail_Needed(p) \ 1056 ((pword *)(p) < GB) 1057 1058 1059/* The context in which an undo function is being called */ 1060 1061#define UNDO_FAIL 0 /* untrail during fail */ 1062#define UNDO_GC 1 /* untrail during gc */ 1063 1064/* Type of trailed data */ 1065 1066#define TRAILED_PWORD 0x0 1067#define TRAILED_REF 0x4 1068#define TRAILED_WORD32 0x8 1069#define TRAILED_COMP 0xc 1070 1071 1072/******************************************************************/ 1073/* */ 1074/* D I C T I O N A R Y macros/function */ 1075/* */ 1076/******************************************************************/ 1077 1078#define Did(string, arity) ec_did(string, arity) 1079#define DidString(d) (((dident)(d))->string) 1080#define DidLength(D) DidString(D)->val.nint 1081 1082/* 1083 * Get the name of v into name. 1084 * Must be instantiated to an atom or string otherwise 1085 * appropriate error is returned. 1086 * value v; 1087 * type t; 1088 * char *name; 1089 */ 1090#define Get_Name(v,t,name) \ 1091 if (IsString(t)) \ 1092 name = StringStart(v); \ 1093 else if (IsAtom(t)) \ 1094 name = DidName(v.did); \ 1095 else if (IsNil(t)) \ 1096 name = DidName(d_.nil); \ 1097 else \ 1098 { \ 1099 Error_If_Ref(t) \ 1100 Bip_Error(TYPE_ERROR) \ 1101 } 1102 1103 1104/* 1105 * This macro converts the procedure ID in the form Name/Arity 1106 * to its DID. It makes all tests. 1107 * value v; 1108 * type t; 1109 * dident wdid; 1110 */ 1111#define Get_Proc_Did(v, t, wdid) \ 1112 if (IsStructure(t) && v.ptr->val.did == d_.quotient)\ 1113 { \ 1114 pword * pw; \ 1115 pw = v.ptr + 1; \ 1116 Dereference_(pw) \ 1117 Check_Atom_Or_Nil(pw->val, pw->tag) \ 1118 wdid = pw->val.did; \ 1119 pw = v.ptr + 2; \ 1120 Dereference_(pw) \ 1121 Check_Integer(pw->tag) \ 1122 if (pw->val.nint < 0 || pw->val.nint > MAXARITY) \ 1123 { Bip_Error(RANGE_ERROR) } \ 1124 wdid = add_dict(wdid, (int) pw->val.nint);\ 1125 } \ 1126 else \ 1127 { \ 1128 Error_If_Ref(t); \ 1129 Bip_Error(TYPE_ERROR); \ 1130 } 1131 1132 1133/* 1134 * Get the did of a term Name/Arity or Name (== Name/0) 1135 */ 1136 1137#define Get_Functor_Did(v, t, wdid) \ 1138 if (IsStructure(t) && v.ptr->val.did == d_.quotient)\ 1139 { \ 1140 pword * pw; \ 1141 pw = v.ptr + 1; \ 1142 Dereference_(pw) \ 1143 Check_Atom_Or_Nil(pw->val, pw->tag) \ 1144 wdid = pw->val.did; \ 1145 pw = v.ptr + 2; \ 1146 Dereference_(pw) \ 1147 Check_Integer(pw->tag) \ 1148 wdid = add_dict(wdid, (int) pw->val.nint);\ 1149 } \ 1150 else if (IsAtom(t)) \ 1151 wdid = v.did; \ 1152 else if (IsNil(t)) \ 1153 wdid = d_.nil; \ 1154 else \ 1155 { \ 1156 Error_If_Ref(t); \ 1157 Bip_Error(TYPE_ERROR); \ 1158 } 1159 1160 1161/* 1162 * Get the did of an atom or structure, else type error 1163 */ 1164 1165#define Get_Key_Did(key,v,t) \ 1166 Error_If_Ref(t) \ 1167 if(IsAtom(t)) key = (v).did; \ 1168 else if(IsStructure(t)) key = (v).ptr->val.did;\ 1169 else if(IsNil(t)) key = d_.nil; \ 1170 else if(IsList(t)) key = d_.list; \ 1171 else { Bip_Error(TYPE_ERROR) } 1172 1173 1174/* 1175 * Get the DID from the name and arity, error if wrong type 1176 * value vname, varity; 1177 * type tname, tarity; 1178 * dident did; 1179 */ 1180#define Get_Did(vname, tname, varity, tarity, d) \ 1181 if (IsRef(tname)) { \ 1182 Bip_Error(INSTANTIATION_FAULT) \ 1183 } \ 1184 Check_Integer(tarity) \ 1185 if (IsNil(tname)) \ 1186 vname.did = d_.nil; \ 1187 else if (!IsAtom(tname)) { \ 1188 Bip_Error(TYPE_ERROR) \ 1189 } \ 1190 d = add_dict(vname.did, (int) varity.nint); 1191 1192 1193/******************************************************************/ 1194/* */ 1195/* Protecting code sequences on C level */ 1196/* */ 1197/******************************************************************/ 1198 1199/* 1200 * Disable interrupts (now in shared_mem.h) 1201 */ 1202 1203/* 1204 * Protect code against being aborted via exit_block/1, i.e. allow 1205 * interrupt handling, but don't allow the handler to abort the 1206 * interrupted execution. 1207 */ 1208 1209#define Disable_Exit() VM_FLAGS |= NO_EXIT; 1210 1211#define Enable_Exit() \ 1212 { if (VM_FLAGS & WAS_EXIT) delayed_exit(); else VM_FLAGS &= ~NO_EXIT; } 1213 1214 1215/****************************************************************/ 1216/* I / O */ 1217/****************************************************************/ 1218 1219#define Current_Input ec_stream_id(0) /* current_input_ */ 1220#define Current_Output ec_stream_id(1) /* current_output_ */ 1221#define Current_Error ec_stream_id(2) /* current_err_ */ 1222#define Current_Null ec_stream_id(3) /* null_ */ 1223 1224 1225/****************************************************************/ 1226/* Global Shared Data */ 1227/****************************************************************/ 1228/* The funny casts like * (type *) &object 1229 * are needed to convince the C compiler that you can use 1230 * these things as a left hand side of an assignment. 1231 */ 1232 1233#define SharedDataLock (shared_data->general_lock) 1234#define ModuleLock (shared_data->mod_desc_lock) 1235#define PropertyLock (shared_data->prop_desc_lock) 1236#define PropListLock (shared_data->prop_list_lock) 1237#define ProcedureLock (shared_data->proc_desc_lock) 1238#define ProcListLock (shared_data->proc_list_lock) 1239#define ProcChainLock (shared_data->proc_chain_lock) 1240#define AssertRetractLock (shared_data->assert_retract_lock) 1241#define GlobalFlags (shared_data->global_flags) 1242#define PrintDepth (shared_data->print_depth) 1243#define LoadReleaseDelay (shared_data->load_release_delay) 1244#define PublishingParam (shared_data->publishing_param) 1245#define OutputModeMask (shared_data->output_mode_mask) 1246#define CompileId (shared_data->compile_id) 1247#define CodeHeapUsed (shared_data->code_heap_used) 1248#define GlobalVarIndex (shared_data->global_var_index) 1249#define SymbolTableVersion (shared_data->symbol_table_version) 1250#define DynGlobalClock (shared_data->dyn_global_clock) 1251#define DynKilledCodeSize (shared_data->dyn_killed_code_size) 1252#define DynNumOfKills (shared_data->dyn_num_of_kills) 1253#define AbolishedDynProcedures (*(proc_duet **) &shared_data->abolished_dynamic_procedures) 1254#define AbolishedProcedures (*(proc_duet **) &shared_data->abolished_procedures) 1255#define DynamicProcedures (*(proc_duet **) &shared_data->dynamic_procedures) 1256#define GlobalProcedures (*(proc_duet **) &shared_data->global_procedures) 1257#define CompiledStructures (*(proc_duet **) &shared_data->compiled_structures) 1258#define NbStreams (shared_data->nbstreams) 1259#define NbStreamsFree (shared_data->nbstreams_free) 1260#define StreamDescriptors (*(stream_id **) &shared_data->stream_descriptors) 1261#define ErrorHandler (*(pri ***) &shared_data->error_handler) 1262#define DefaultErrorHandler (*(pri ***) &shared_data->default_error_handler) 1263#define InterruptHandler (*(pri ***) &shared_data->interrupt_handler) 1264#define InterruptHandlerFlags (*(int **) &shared_data->interrupt_handler_flags) 1265#define InterruptName (*(dident **) &shared_data->interrupt_name) 1266#define UserError (shared_data->user_error) 1267#define ErrorMessage (*(char ***) &shared_data->error_message) 1268#define MaxErrors (shared_data->max_errors) 1269 1270 1271/****************************************************************/ 1272/* Global references */ 1273/****************************************************************/ 1274 1275/* If GLOBALREFS_ARE_ECREFS is defined, global references are implemented 1276 * with ec_refs. They are on the heap and there is no limit on their 1277 * number. This does not work with the parallel system because of 1278 * heap->stack pointers! 1279 */ 1280#define GLOBALREFS_ARE_ECREFS 1281 1282/* Otherwise, the global references are stored in the GLOBVAR array, 1283 accessed by the index. The unused items are linked using 1284 the index, the start of this list is stored in the last 1285 array element. List end is marked by TNIL. 1286*/ 1287#ifdef GLOBALREFS_ARE_ECREFS 1288#define GLOBAL_VARS_NO 10 /* Size of the global variables array */ 1289#else 1290#define GLOBAL_VARS_NO 100 /* Size of the global variables array */ 1291#endif 1292#define GLOBAL_VARS_LAST (GLOBAL_VARS_NO-1) 1293#define GlobalVarFree GLOBVAR[GLOBAL_VARS_NO-1] 1294 1295 1296/****************************************************************/ 1297/* Message passing */ 1298/****************************************************************/ 1299 1300#define HALT1_APORT_NUMBER 0 1301#define HALT2_APORT_NUMBER 1 1302#define WM_APORT_NUMBER 2 1303#define NUM_STD_PORTS 3 1304 1305#define SCH_APORT_NUMBER (NUM_STD_PORTS + 0) 1306#define ENG_APORT_NUMBER (NUM_STD_PORTS + 1) 1307#define IO_APORT_NUMBER (NUM_STD_PORTS + 2) 1308#define IO_REPLY_APORT_NUMBER (NUM_STD_PORTS + 3) 1309 1310#define TOTAL_APORT_NUMBER (NUM_STD_PORTS + 4) 1311 1312 1313/****************************************************************/ 1314/* Abstract machine registers */ 1315/****************************************************************/ 1316 1317#define SP g_emu_.sp 1318#define TT g_emu_.tt 1319#define TG g_emu_.tg 1320#define E g_emu_.e 1321#define EB g_emu_.eb 1322#define GB g_emu_.gb 1323#define S g_emu_.s 1324#define B g_emu_.b 1325#define PPB g_emu_.ppb 1326#define PB g_emu_.pb 1327#define ORA g_emu_.oracle 1328#define NTRY g_emu_.ntry 1329#define LEAF g_emu_.leaf 1330#define LOAD g_emu_.load 1331#define GCTG g_emu_.gctg 1332#define ORC g_emu_.oracle 1333#define PP g_emu_.pp 1334#define LCA g_emu_.lca 1335#define VM_FLAGS g_emu_.vm_flags 1336#define EVENT_FLAGS g_emu_.event_flags 1337#define DE g_emu_.de 1338#define LD g_emu_.ld 1339#define MU g_emu_.mu 1340#define SV g_emu_.sv 1341#define WP g_emu_.wp 1342#define WP_STAMP g_emu_.wp_stamp 1343#define WL g_emu_.wl.val.ptr 1344#define TAGGED_WL g_emu_.wl 1345#define TO g_emu_.oracle 1346#define FO g_emu_.followed_oracle 1347#define PO g_emu_.pending_oracle 1348#define OCB g_emu_.occur_check_boundary 1349#define TCS g_emu_.top_constructed_structure 1350#define TG_SL g_emu_.tg_soft_lim 1351#define TG_SLS g_emu_.tg_soft_lim_shadow 1352#define IFOFLAG g_emu_.irq_faked_overflow 1353#define TG_SEG g_emu_.segment_size 1354#define TG_LIM g_emu_.tg_limit 1355#define TT_LIM g_emu_.tt_limit 1356#define TG_ORIG ((pword *) g_emu_.global_trail[0].start) 1357#define TT_ORIG ((pword **) g_emu_.global_trail[1].start) 1358#define B_ORIG ((pword *) g_emu_.control_local[0].start) 1359#define SP_ORIG ((pword *) g_emu_.control_local[1].start) 1360#define IT_BUF g_emu_.it_buf 1361#define PARSENV g_emu_.parser_env 1362#define POSTED g_emu_.posted 1363#define POSTED_LAST g_emu_.posted_last 1364#define GLOBVAR (g_emu_.global_variable+1) 1365#define A g_emu_.emu_args 1366#define PostponedList g_emu_.postponed_list 1367 1368 1369#define TD g_emu_.trace_data.debug_top.val.ptr 1370#define TAGGED_TD g_emu_.trace_data.debug_top 1371#define NINVOC g_emu_.trace_data.next_invoc 1372#define RLEVEL g_emu_.trace_data.redo_level 1373#define FDROP g_emu_.trace_data.fail_drop 1374#define FCULPRIT g_emu_.trace_data.fail_culprit 1375#define JMININVOC g_emu_.trace_data.min_invoc 1376#define JMAXINVOC g_emu_.trace_data.max_invoc 1377#define JMINLEVEL g_emu_.trace_data.min_level 1378#define JMAXLEVEL g_emu_.trace_data.max_level 1379#define PORTFILTER g_emu_.trace_data.port_filter 1380#define FTRACE g_emu_.trace_data.fail_trace 1381#define TRACEMODE g_emu_.trace_data.trace_mode 1382#define DBG_PRI g_emu_.trace_data.call_proc 1383#define DBG_PORT g_emu_.trace_data.call_port 1384#define DBG_INVOC g_emu_.trace_data.call_invoc 1385#define DBG_DELAY_INVOC g_emu_.trace_data.first_delay_invoc 1386#define DBG_SRCPOS g_emu_.trace_data.source_pos 1387#define DBG_PATH g_emu_.trace_data.source_pos.file 1388#define DBG_LINE g_emu_.trace_data.source_pos.line 1389#define DBG_FROM g_emu_.trace_data.source_pos.from 1390#define DBG_TO g_emu_.trace_data.source_pos.to 1391 1392 1393/* 1394 * The following are obsolete, to be phased out (use macros above instead) 1395 */ 1396 1397#define Gbl_Tg g_emu_.tg 1398#define Gbl_Tt g_emu_.tt 1399 1400 1401/****************************************************************/ 1402/* The bits in GlobalFlags (shared memory flags) */ 1403/* CAUTION: These values also occur in environment.pl */ 1404/****************************************************************/ 1405 1406#define BREAL_EXCEPTIONS 0x00000001 /* undecidable breal comparisons */ 1407#define PREFER_RATIONALS 0x00000002 /* use rationals where possible */ 1408#define HEAP_READY 0X00000004 /* for synchronising worker booting */ 1409#define SCH_TRACE_FLAG 0x00000008 /* parallel scheduler trace */ 1410#define ENG_TRACE_FLAG 0X00000020 /* parallel engine trace */ 1411#define GC_ENABLED 0X00000010 /* the garbage collector is switched on */ 1412#define GC_VERBOSE 0X00000040 /* garbage collections are reported */ 1413#define GC_NO_CHP 0X00000200 /* don't allow the gc to make chps */ 1414#define GC_ADAPTIVE 0X00004000 /* automatically adjust gc intervals */ 1415#define DBGCOMP 0X00000080 /* compiler generates debug instrs */ 1416#define CORTN 0X00000100 /* built-ins delay */ 1417#define MACROEXP 0X00000400 /* macro transformations enabled */ 1418#define GOALEXPAND 0X00000800 /* goal transformation enabled */ 1419#define FULL_COPY 0X00001000 /* disable incremental stack copying */ 1420#define CHECK_COPY 0X00002000 /* stack copying debug facility */ 1421#define SCH_SYNC_ONLY 0X00008000 /* no async scheduler msg handling */ 1422#define DFID_COMPILE 0X01000000 /* depth-first iterative deepening */ 1423#define OCCUR_CHECK 0X02000000 /* occurs check enabled */ 1424#define VARIABLE_NAMES 0X04000000 /* keep variable names */ 1425#define SINGLETON_CHECK 0X08000000 /* compiler warns on singletons */ 1426#define STRIP_VARIABLES 0X10000000 /* print all variables as _g */ 1427 1428 1429/****************************************************************/ 1430/* The bits in EVENT_FLAGS (per engine) */ 1431/* EVENT_FLAGS may be changed by signal handlers and must */ 1432/* only be updated inside interrupt-protected regions */ 1433/****************************************************************/ 1434 1435#define SCH_MSG_PENDING 0X00000001 /* scheduler message pending */ 1436#define ENG_MSG_PENDING 0X00000004 /* engine message pending */ 1437#define SLEEP_REQUEST 0X00000002 /* engine should go to sleep */ 1438#define COUNT_DOWN 0X00000008 /* countdown running */ 1439#define EVENT_POSTED 0X00000010 /* events in posted_events-queue */ 1440#define DEL_IRQ_POSTED 0X00000020 /* maybe delayed irq among events */ 1441#define SYNC_MSG_PENDING (SCH_MSG_PENDING|ENG_MSG_PENDING) 1442 1443 1444/****************************************************************/ 1445/* The bits in VM_FLAGS (per engine) */ 1446/****************************************************************/ 1447 1448#define EVENTS_DEFERRED 0X00000001 /* sync event handling is suppressed */ 1449#define GLOBAL_NO_IT 0X00000002 /* interrupts are disabled at Prolog level */ 1450 /* (only set together with it_disabled_ !) */ 1451#define TRACE 0X00000008 /* we are tracing VM instructions */ 1452#define ORACLES_ENABLED 0X00000010 /* record oracles during execution */ 1453#define STATISTICS 0X00000020 /* we are counting VM instructions */ 1454#define STAT_PAIRS 0X00000800 /* we are counting pairs of VM instr. */ 1455#define PROFILING 0x00001000 1456#define NO_EXIT 0X04000000 /* exit_block is forbidden */ 1457#define WAS_EXIT 0X08000000 /* an exit_block has been delayed */ 1458#define FP_EXCEPTION 0X10000000 /* floating point exception */ 1459#define EXPORTED 0X40000000 /* registers have been globalized */ 1460#define DET 0X80000000 /* no choicepoint */ 1461 1462#define INT_SAFE_BITS 0 /* mask to be saved/restored on interrupts */ 1463 1464 1465/****************************************************************/ 1466/* Values for the interrrupt_handler_flags_ array */ 1467/****************************************************************/ 1468 1469#define IH_UNCHANGED 0 /* (fail) */ 1470#define IH_SYSTEM_DFL 1 /* default/0 */ 1471#define IH_IGNORE 2 /* true/0 */ 1472#define IH_ECLIPSE_DFL 3 /* internal/0 */ 1473#define IH_POST_EVENT 4 /* event/1 */ 1474#define IH_THROW 5 /* throw/1 */ 1475#define IH_ABORT 6 /* abort/0 */ 1476#define IH_HALT 7 /* halt/0 */ 1477#define IH_HANDLE_ASYNC 8 /* other */ 1478 1479 1480/****************************************************************/ 1481/* struct tag_descriptor related definitions */ 1482/****************************************************************/ 1483 1484#define tdict tag_desc[TDICT].tag 1485#define tlist tag_desc[TLIST].tag 1486#define tcomp tag_desc[TCOMP].tag 1487#define tstrg tag_desc[TSTRG].tag 1488#define tint tag_desc[TINT].tag 1489 1490#define ARITH_PLUS 0 1491#define ARITH_NEG 1 1492#define ARITH_ABS 2 1493#define ARITH_ADD 3 1494#define ARITH_SUB 4 1495#define ARITH_MUL 5 1496#define ARITH_DIV 6 1497#define ARITH_IDIV 7 1498#define ARITH_MOD 8 1499#define ARITH_POW 9 1500#define ARITH_MIN 10 1501#define ARITH_MAX 11 1502#define ARITH_FLOOR 12 1503#define ARITH_FIX 13 1504#define ARITH_FLOAT 14 1505#define ARITH_ROUND 15 1506#define ARITH_COM 16 1507#define ARITH_AND 17 1508#define ARITH_OR 18 1509#define ARITH_XOR 19 1510#define ARITH_SHR 20 1511#define ARITH_SHL 21 1512#define ARITH_SIN 22 1513#define ARITH_COS 23 1514#define ARITH_TAN 24 1515#define ARITH_ASIN 25 1516#define ARITH_ACOS 26 1517#define ARITH_ATAN 27 1518#define ARITH_EXP 28 1519#define ARITH_LN 29 1520#define ARITH_SQRT 30 1521#define ARITH_NUM 31 1522#define ARITH_DEN 32 1523#define ARITH_SGN 33 1524#define ARITH_CEIL 34 1525#define ARITH_SETBIT 35 1526#define ARITH_CLRBIT 36 1527#define ARITH_GETBIT 37 1528#define ARITH_CHGSIGN 38 1529#define ARITH_BOXLONGLONG 39 1530#define ARITH_TOCLONGLONG 40 1531#define ARITH_NICERAT 41 1532#define ARITH_GCD 42 1533#define ARITH_LCM 43 1534#define ARITH_POWM 44 1535#define ARITH_NEXT 45 1536#define ARITH_PREV 46 1537#define ARITH_FLOORDIV 47 1538#define ARITH_FLOORREM 48 1539#define ARITH_ATAN2 49 1540#define ARITH_TRUNCATE 50 1541#define ARITH_INT 51 1542#define ARITH_GCD_EXT 52 1543/* Keep this definition in ec_public.h up-to-date: */ 1544/* #define ARITH_OPERATIONS 53 */ 1545 1546 1547/****************************************************************/ 1548/* Shorthands/aliases for global data structures */ 1549/****************************************************************/ 1550 1551#define tag_desc (ec_.td) 1552#define d_ (ec_.d) 1553#define shared_data (ec_.shared) 1554#define g_emu_ (ec_.m) 1555 1556/****************************************************************/ 1557/* Static / Dynamic event queue limits */ 1558/****************************************************************/ 1559 1560#define MAX_STATIC_EVENT_SLOTS 32 1561#define MIN_DYNAMIC_EVENT_SLOTS 32 1562#define DYNAMIC_EVENT_Q_SHRINK_FACTOR 2 1563 1564/****************************************************************/ 1565/* Priorities */ 1566/****************************************************************/ 1567 1568#define PRIORITY_DEBUG 1 1569#define PRIORITY_CHECK 2 1570#define PRIORITY_UNARY 3 1571#define PRIORITY_BINARY 4 1572#define PRIORITY_TERNARY 5 1573#define PRIORITY_LINEAR 6 1574#define PRIORITY_QUADRATIC 7 1575#define PRIORITY_CUBIC 8 1576#define PRIORITY_SLOW 9 1577#define PRIORITY_MOPUP 10 1578#define PRIORITY_NONDET 11 1579#define PRIORITY_MAIN 12 1580 1581#define PRIORITY_DEFAULT PRIORITY_CHECK 1582#define PRIORITY_RUN_DEFAULT PRIORITY_CHECK 1583#define PRIORITY_MIN PRIORITY_DEBUG 1584#define PRIORITY_MAX PRIORITY_MAIN 1585 1586