1 /* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 1985-2020, University of Amsterdam, 7 VU University Amsterdam 8 CWI, Amsterdam 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35 */ 36 37 #ifndef _PL_INCLUDE_H 38 #define _PL_INCLUDE_H 39 40 #define PLNAME "swi" 41 42 #ifdef __WINDOWS__ 43 #ifdef WIN64 44 #include "config/win64.h" 45 #define PLHOME "c:/Program Files/swipl" 46 #else 47 #include "config/win32.h" 48 #define PLHOME "c:/Program Files (x86)/swipl" 49 #endif 50 #else /*__WINDOWS__*/ 51 #include <config.h> 52 #endif 53 54 #ifdef _MSC_VER 55 #define C_LIBS "" 56 #define C_STATICLIBS "" 57 #define C_CC "cl" 58 #if (_MSC_VER < 1400) 59 #define C_CFLAGS "/MD /GX" 60 #else 61 #define C_CFLAGS "/MD /EHsc" 62 #endif 63 #define C_LDFLAGS "" 64 #if defined(_DEBUG) 65 #define C_PLLIB "swiplD.lib" 66 #else 67 #define C_PLLIB "swipl.lib" 68 #endif 69 #else /* !_MSC_VER */ 70 #ifdef __WINDOWS__ /* I.e., MinGW */ 71 #define C_LIBS "" 72 #define C_STATICLIBS "" 73 #define C_CC "gcc" 74 #define C_CFLAGS "" 75 #define C_PLLIB "-lswipl" /* Or "libswipl.lib"? */ 76 #define C_LIBPLSO "-lswipl" 77 #define C_LDFLAGS "" 78 #else 79 #include <parms.h> /* pick from the working dir */ 80 #endif 81 #endif 82 83 #define PL_KERNEL 1 84 #include <inttypes.h> 85 #include "pl-builtin.h" 86 87 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 88 PROLOG SYSTEM OPTIONS 89 90 These are not really options normally. They are there because I use to 91 add new features conditional using #if ... #endif. In many cases I 92 leave them in for ducumentation purposes. Notably O_STRING might be 93 handy for it someone wants to add a data type to the system. 94 95 O_STRING 96 Include data type string. This feature does not rely on any 97 system feature. It hardly has any consequences for the system. 98 Because of its experimental nature it is optional. The definition 99 of the predicates operating on strings might change. 100 (NOTE: Currently some of the boot files rely on strings. It is NOT 101 suggested to leave them out). 102 O_QUASIQUOTATIONS 103 Support quasi quoted content in read_term/3 and friends. 104 O_COMPILE_OR 105 Compile ->/2, ;/2 and |/2 into WAM. This no longer is a real 106 option. the mechanism to handle cuts without compiling ;/2, etc. 107 has been taken out. 108 O_COMPILE_ARITH 109 Include arithmetic compiler (compiles is/2, >/2, etc. into WAM). 110 O_COMPILE_IS 111 Compile Var = Value in the body. 112 O_CALL_AT_MODULE 113 Support the Goal@Module control-structure 114 O_LABEL_ADDRESSES 115 Means we can pick up the address of a label in a function using 116 the var = `&&label' construct and jump to it using goto *var; 117 This construct is known by the GNU-C compiler gcc version 2. It 118 is buggy in gcc-2.0, but seems to works properly in gcc-2.1. 119 VMCODE_IS_ADDRESS 120 Can only be set when O_LABEL_ADDRESSES is set. It causes the 121 prolog compiler to put the code (= label-) addresses in the 122 compiled Prolog code rather than the virtual-machine numbers. 123 This speeds-up the vm instruction dispatching in interpret(). 124 See also pl-comp.c 125 O_LOGICAL_UPDATE 126 Use `logical' update-view for dynamic predicates rather then the 127 `immediate' update-view of older Prolog systems. 128 O_PLMT 129 Include support for multi-threading. Too much of the system relies 130 on this now, so it cannot be disabled without significant work. 131 O_LARGEFILES 132 Supports files >2GB on 32-bit systems (if the OS provides it). 133 O_ATTVAR 134 Include support for attributes variables. 135 This option requires O_DESTRUCTIVE_ASSIGNMENT. 136 O_GVAR 137 Include support for backtrackable global variables. This option 138 requires O_DESTRUCTIVE_ASSIGNMENT. 139 O_CYCLIC 140 Provide support for cyclic terms. 141 O_LOCALE 142 Provide locale support on streams. 143 O_GMP 144 Use GNU gmp library for infinite precision arthmetic 145 O_MITIGATE_SPECTRE 146 Reduce spectre security risc. Currently reduces timer resolution. 147 O_PREFER_RATIONALS 148 Default for the `prefer_rationals` flag. 149 O_RATIONAL_SYNTAX 150 Default support for rational syntax (RAT_NATURAL or RAT_COMPAT) 151 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 152 153 #define O_COMPILE_OR 1 154 #define O_SOFTCUT 1 155 #define O_COMPILE_ARITH 1 156 #define O_COMPILE_IS 1 157 #define O_CALL_AT_MODULE 1 158 #define O_STRING 1 159 #define O_RESERVED_SYMBOLS 1 160 #define O_QUASIQUOTATIONS 1 161 #define O_CATCHTHROW 1 162 #define O_DEBUGGER 1 163 #define O_INTERRUPT 1 164 #define O_DESTRUCTIVE_ASSIGNMENT 1 165 #define O_TERMHASH 1 166 #define O_LIMIT_DEPTH 1 167 #define O_INFERENCE_LIMIT 1 168 #define O_SAFE_SIGNALS 1 169 #define O_LOGICAL_UPDATE 1 170 #define O_LOCALE 1 171 #define O_ATOMGC 1 172 #define O_CLAUSEGC 1 173 #define O_ATTVAR 1 174 #define O_CALL_RESIDUE 1 175 #define O_GVAR 1 176 #define O_CYCLIC 1 177 #define O_MITIGATE_SPECTRE 1 178 #ifndef O_PREFER_RATIONALS 179 #define O_PREFER_RATIONALS FALSE 180 #endif 181 #ifndef O_RATIONAL_SYNTAX 182 #define O_RATIONAL_SYNTAX RAT_COMPAT 183 #endif 184 185 #if defined(O_PLMT) 186 #if defined(O_SIGPROF_PROFILE) || defined(__WINDOWS__) 187 #define O_PROFILE 1 188 #endif 189 #endif 190 191 #ifdef HAVE_GMP_H 192 #define O_GMP 1 193 #endif 194 #ifdef __WINDOWS__ 195 #define NOTTYCONTROL TRUE 196 #define O_DDE 1 197 #define O_DLL 1 198 #define O_HASDRIVES 1 199 #define O_HASSHARES 1 200 #define O_XOS 1 201 #define O_RLC 1 202 #endif 203 204 #ifndef DOUBLE_TO_LONG_CAST_RAISES_SIGFPE 205 #ifdef __i386__ 206 #define DOUBLE_TO_LONG_CAST_RAISES_SIGFPE 1 207 #endif 208 #endif 209 210 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 211 The ia64 says setjmp()/longjmp() buffer must be aligned at 128 bits 212 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 213 214 #ifndef JMPBUF_ALIGNMENT 215 #ifdef __ia64__ 216 #define JMPBUF_ALIGNMENT 128 217 #else 218 #if ALIGNOF_DOUBLE != ALIGNOF_VOIDP 219 #define JMPBUF_ALIGNMENT ALIGNOF_DOUBLE 220 #endif 221 #endif 222 #endif 223 224 #ifndef O_LABEL_ADDRESSES 225 #if __GNUC__ == 2 226 #define O_LABEL_ADDRESSES 1 227 #endif 228 #endif 229 230 /* clang as of version 11 performs about 30% worse with this option */ 231 #if O_LABEL_ADDRESSES && !defined(VMCODE_IS_ADDRESS) && !defined(__llvm__) 232 #define VMCODE_IS_ADDRESS 1 233 #endif 234 235 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 236 Runtime version. Uses somewhat less memory and has no tracer. 237 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 238 239 #ifdef O_RUNTIME 240 #undef O_PROFILE /* no profiling */ 241 #undef O_DEBUGGER /* no debugging */ 242 #undef O_INTERRUPT /* no interrupts too */ 243 #endif 244 245 246 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 247 The macros below try to establish a common basis for various compilers, 248 so we can write most of the real code without having to worry about 249 compiler limits and differences. 250 251 The current version has prototypes defined for all functions. If you 252 have a very old compiler, try the unprotoize program that comes with 253 gcc. 254 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 255 256 #ifndef __unix__ 257 #if defined(_AIX) || defined(__APPLE__) || defined(__unix) || defined(__BEOS__) || defined(__NetBSD__) || defined(__HAIKU__) 258 #define __unix__ 1 259 #endif 260 #endif 261 262 /* AIX requires this to be the first thing in the file. */ 263 #ifdef __GNUC__ 264 # ifndef alloca 265 # define alloca __builtin_alloca 266 # endif 267 #else 268 # if HAVE_ALLOCA_H 269 # include <alloca.h> 270 # else 271 # ifdef _AIX 272 #pragma alloca 273 # else 274 # ifndef alloca /* predefined by HP cc +Olibcalls */ 275 void *alloca (); 276 # endif 277 # endif 278 # endif 279 #endif 280 281 #if _FILE_OFFSET_BITS == 64 || defined(_LARGE_FILES) 282 #define O_LARGEFILES 1 /* use for conditional code in Prolog */ 283 #else 284 #undef O_LARGEFILES 285 #endif 286 287 #include <sys/types.h> 288 #if __MINGW32__ 289 typedef _sigset_t sigset_t; 290 #endif 291 #include <setjmp.h> 292 #ifdef ASSERT_H_REQUIRES_STDIO_H 293 #include <stdio.h> 294 #endif /*ASSERT_H_REQUIRES_STDIO_H*/ 295 #ifdef NO_ASSERT_H /* see pl-assert.c */ 296 #define assert(c) (void)0 297 #else 298 #include <assert.h> 299 #endif 300 #include <stdlib.h> 301 #include <string.h> 302 #include <stddef.h> 303 #include <stdarg.h> 304 #include <limits.h> 305 306 #ifdef HAVE_SIGNAL 307 #include <signal.h> 308 #endif 309 #ifdef HAVE_MALLOC_H 310 #include <malloc.h> 311 #else 312 #ifdef HAVE_SYS_MALLOC_H 313 #include <sys/malloc.h> 314 #endif 315 #endif 316 317 #ifdef O_GMP 318 #ifdef _MSC_VER /* ignore warning in gmp 5.0.2 header */ 319 #pragma warning( disable : 4146 ) 320 #endif 321 #include <gmp.h> 322 #ifdef _MSC_VER 323 #pragma warning( default : 4146 ) 324 #endif 325 #endif 326 327 #if defined(STDC_HEADERS) || defined(HAVE_STRING_H) 328 #include <string.h> 329 /* An ANSI string.h and pre-ANSI memory.h might conflict. */ 330 #if !defined(STDC_HEADERS) && defined(HAVE_MEMORY_H) 331 #include <memory.h> 332 #endif /* not STDC_HEADERS and HAVE_MEMORY_H */ 333 #else /* not STDC_HEADERS and not HAVE_STRING_H */ 334 #include <strings.h> 335 /* memory.h and strings.h conflict on some systems. */ 336 #endif /* not STDC_HEADERS and not HAVE_STRING_H */ 337 338 #if OS2 && EMX 339 #include <process.h> 340 #include <io.h> 341 #endif /* OS2 */ 342 343 /* prepare including BeOS types */ 344 #ifdef __BEOS__ 345 #define bool BOOL 346 347 #include <BeBuild.h> 348 #if (B_BEOS_VERSION <= B_BEOS_VERSION_5) 349 # include <socket.h> /* include socket.h to get the fd_set structure */ 350 #else 351 # include <SupportDefs.h> /* not needed for a BONE-based networking stack */ 352 #endif 353 #include <OS.h> 354 355 #undef true 356 #undef false 357 #undef bool 358 #define EMULATE_DLOPEN 1 /* Emulated dlopen() in pl-beos.c */ 359 #endif 360 361 /* MAXPATHLEN is an optional POSIX feature (Bug#63). As SWI-Prolog has 362 no length limits on text except for representing paths, we should 363 rewrite all file handling code to avoid MAXPATHLEN. For now we just 364 define it. 365 */ 366 367 #ifndef MAXPATHLEN 368 #define MAXPATHLEN 1024 369 #endif 370 371 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 372 A common basis for C keywords. 373 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 374 375 #if __GNUC__ && !__STRICT_ANSI__ 376 #define HAVE_INLINE 1 377 #define HAVE_VOLATILE 1 378 #define HAVE___BUILTIN_EXPECT 1 379 #endif 380 381 #if !defined(HAVE_INLINE) && !defined(inline) 382 #define inline 383 #endif 384 385 #if defined(__GNUC__) && !defined(__OPTIMIZE__) 386 #define _DEBUG 1 387 #endif 388 389 #ifndef HAVE_VOLATILE 390 #define volatile 391 #endif 392 393 #if defined(__GNUC__) && !defined(NORETURN) 394 #define NORETURN __attribute__ ((noreturn)) 395 #else 396 #define NORETURN 397 #endif 398 399 #if defined(__GNUC__) && !defined(MAY_ALIAS) 400 #define MAY_ALIAS __attribute__ ((__may_alias__)) 401 #else 402 #define MAY_ALIAS 403 #endif 404 405 #ifdef HAVE___BUILTIN_EXPECT 406 #define likely(x) __builtin_expect((x), 1) 407 #define unlikely(x) __builtin_expect((x), 0) 408 #else 409 #define likely(x) (x) 410 #define unlikely(x) (x) 411 #endif 412 413 #ifdef DMALLOC 414 #include <dmalloc.h> /* Use www.dmalloc.com debugger */ 415 416 #define PL_ALLOC_DONE 1 417 #define DMALLOC_FUNC_CHECK 1 418 #define allocHeap(n) malloc(n) 419 #define allocHeapOrHalt(n) xmalloc(n) 420 #define freeHeap(ptr, n) do { (void)(n); xfree(ptr); } while(0) 421 #endif /*DMALLOC*/ 422 423 #define forwards static /* forwards function declarations */ 424 425 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 426 Booleans, addresses, strings and other goodies. 427 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 428 429 typedef int bool; 430 431 #if __GNUC__ && !__STRICT_ANSI__ 432 #define LocalArray(t, n, s) t n[s] 433 #else 434 #define LocalArray(t, n, s) t *n = (t *) alloca((s)*sizeof(t)) 435 #endif 436 437 #define TermVector(name, s) LocalArray(Word, name, s) 438 439 #ifndef TRUE 440 #define TRUE 1 441 #define FALSE 0 442 #endif 443 #define succeed return TRUE 444 #define fail return FALSE 445 #define TRY(goal) do { if (!(goal)) return FALSE; } while(0) 446 447 #define CL_START ((ClauseRef)1) /* asserta */ 448 #define CL_END ((ClauseRef)2) /* assertz */ 449 450 typedef void * caddress; 451 452 #define EOS ('\0') 453 #define ESC ((char) 27) 454 #define streq(s, q) ((strcmp((s), (q)) == 0)) 455 456 /* n is 2^m !!! */ 457 #define ROUND(p, n) ((((p) + (n) - 1) & ~((n) - 1))) 458 #define addPointer(p, n) ((void *) ((intptr_t)(p) + (intptr_t)(n))) 459 #define diffPointers(p1, p2) ((intptr_t)(p1) - (intptr_t)(p2)) 460 461 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 462 LIMITS 463 464 Below are some arbitrary limits on object sizes. Feel free to enlarge 465 them. Descriptions: 466 467 * LINESIZ 468 Buffer used to store textual info. It is not concerned with 469 critical things, just things like building an error message, 470 reading a command for the tracer, etc. 471 472 * MAXARITY 473 Maximum arity of a predicate. May be enarged further, but 474 wastes stack (4 bytes for each argument) on machines that 475 use malloc() for allocating the stack as the local and global 476 stack need to be apart by this amount. Also, an interrupt 477 skips this amount of stack. 478 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 479 480 #define LINESIZ 1024 /* size of a data line */ 481 #define MAXARITY 1024 /* arity of predicate */ 482 #define MINFOREIGNSIZE 32 /* Minimum term_t in foreign frame */ 483 #define MAXSYMBOLLEN 256 /* max size of foreign symbols */ 484 #define OP_MAXPRIORITY 1200 /* maximum operator priority */ 485 #define SMALLSTACK 32 * 1024 /* GC policy */ 486 #define MAX_PORTRAY_NESTING 100 /* Max recursion in portray */ 487 488 #define LOCAL_MARGIN ((size_t)argFrameP((LocalFrame)NULL, MAXARITY) + \ 489 sizeof(struct choice)) 490 491 #define WORDBITSIZE (8 * sizeof(word)) 492 #define LONGBITSIZE (8 * sizeof(long)) 493 #define INTBITSIZE (8 * sizeof(int)) 494 #define INT64BITSIZE (8 * sizeof(int64_t)) 495 #define WORDS_PER_DOUBLE ((sizeof(double)+sizeof(word)-1)/sizeof(word)) 496 #define WORDS_PER_INT64 (sizeof(int64_t)/sizeof(word)) 497 498 /* Prolog's integer range */ 499 #define PLMINTAGGEDINT (-(intptr_t)((word)1<<(WORDBITSIZE-LMASK_BITS-1))) 500 #define PLMAXTAGGEDINT (-PLMINTAGGEDINT - 1) 501 #define PLMINTAGGEDINT32 (-(intptr_t)((word)1<<(32-LMASK_BITS-1))) 502 #define PLMAXTAGGEDINT32 (-PLMINTAGGEDINT32 - 1) 503 #define inTaggedNumRange(n) (valInt(consInt(n)) == (n)) 504 #define PLMININT (-PLMAXINT - 1) 505 #define PLMAXINT ((int64_t)(((uint64_t)1<<(INT64BITSIZE-1)) - 1)) 506 #if SIZEOF_WCHAR_T == 2 507 #define PLMAXWCHAR (0xffff) 508 #else 509 #define PLMAXWCHAR (0x10ffff) 510 #endif 511 512 #if vax 513 #define MAXREAL (1.701411834604692293e+38) 514 #else /* IEEE double */ 515 #define MAXREAL (1.79769313486231470e+308) 516 #endif 517 518 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 519 Macros to handle hash tables. See pl-table.c for details. First the 520 sizes of the hash tables are defined. Note that these should all be 521 2^N. 522 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 523 524 #define ATOMHASHSIZE 1024 /* global atom table */ 525 #define FUNCTORHASHSIZE 512 /* global functor table */ 526 #define PROCEDUREHASHSIZE 256 /* predicates in module user */ 527 #define MODULEPROCEDUREHASHSIZE 16 /* predicates in other modules */ 528 #define MODULEHASHSIZE 16 /* global module table */ 529 #define PUBLICHASHSIZE 8 /* Module export table */ 530 #define FLAGHASHSIZE 16 /* global flag/3 table */ 531 532 #include "os/pl-table.h" 533 #include "pl-vmi.h" 534 535 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 536 Arithmetic comparison 537 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 538 539 #define LT 1 540 #define GT 2 541 #define LE 3 542 #define GE 4 543 #define NE 5 544 #define EQ 6 545 546 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 547 Operator types. NOTE: if you change OP_*, check operatorTypeToAtom()! 548 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 549 550 #define OP_PREFIX 0 551 #define OP_INFIX 1 552 #define OP_POSTFIX 2 553 #define OP_MASK 0xf 554 555 #define OP_FX (0x10|OP_PREFIX) 556 #define OP_FY (0x20|OP_PREFIX) 557 #define OP_XF (0x30|OP_POSTFIX) 558 #define OP_YF (0x40|OP_POSTFIX) 559 #define OP_XFX (0x50|OP_INFIX) 560 #define OP_XFY (0x60|OP_INFIX) 561 #define OP_YFX (0x70|OP_INFIX) 562 563 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 564 Magic for assertions. 565 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 566 567 #define StackMagic(n) ((n) | 0x98765000) 568 #define QID_MAGIC StackMagic(1) /* Query frame */ 569 570 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 571 PROLOG DATA REPRESENTATION 572 573 Prolog data objects live on various places: 574 575 - In the variable and argument slots of environment frames. 576 - As arguments to complex terms on the global stack. 577 - In records (recorda/recorded database) in the heap. 578 - In variables in foreign language functions. 579 580 All Prolog data is packed into a `word'. A word is a 32 bit entity. 581 The top 3 bits are used to indicate the type; the bottom 2 bits are used 582 for the garbage collector. The bits for the garbage collector are 583 always 0 during normal execution. This implies we do not have to care 584 about them for pointers and as pointers always point to 4 bytes 585 entities, the range is not harmed by the garbage collection bits. 586 587 The remaining 27 bits can hold a unique representation of the value 588 itself or can be a pointer to the global stack where the real value is 589 stored. We call the latter type of data `indirect'. 590 591 Below is a description of the representation used for each type of 592 Prolog data: 593 594 ***TBD*** This is totally out of date. The datatypes are accessed using 595 macros defined in pl-data.h. 596 597 INTEGER 598 Integers are stored in the 27 remaining bits of a word. This 599 implies they are limited to +- 2^26. 600 FLOAT 601 For a real, the 27 bits are a pointer to a 8 byte unit on the global 602 stack. For both words of the 8 byte unit, the top 3 and bottom 2 603 bits are reserved for identification and garbage collection. The 604 remaining bits hold the exponent and mantisse. See pack_real() and 605 unpack_real() in pl-alloc.c for details. 606 ATOM 607 For atoms, the 27 bits represent a pointer to an atom structure. 608 Atom structures are cells of a hash table. Equality of the pointer 609 implies equality of the atoms and visa versa. Atom structures are 610 not collected by the garbage collector and thus live for the entire 611 Prolog session. 612 STRING 613 For a string, the 27 bits are a pointer to the global stack. The 614 first word of the string again reserves the top 3 and bottom 2 615 bits. The remaining bits indicate the lenght of the string. Next 616 follows a 0 terminated character string. Finally a word exactly the 617 same as the header word, to allow the garbage collector to traverse 618 the stack downwards and identify the string. 619 TERM 620 For a compound term, the 27 bits are a pointer to the global stack. 621 the first word there is a pointer to a functordef structure, which 622 determines the name and arity of the term. functordef structures 623 are cells of a hash table like atom structures. They to live for 624 the entire Prolog session. Next, there are just as many words as 625 the arity of the term, each word representing a normal Prolog data 626 object. 627 VARIABLES 628 An unbound variable is represented by NULL. 629 REFERENCES 630 References are the result of sharing variables. If two variables 631 must share, the one with the shortest livetime is made a reference 632 pointer to the other. This way a tree of reference pointers can be 633 constructed. The root of the tree is the variable with the longest 634 livetime. To bind the entire tree of variables this root is bound. 635 The others remain reference pointers. This implies that ANY prolog 636 data object might be a reference pointer to another Prolog data 637 object, holding the real value. To find the real value, a macro 638 called deRef() is available. 639 640 The direction of reference pointers is critical. It MUST point in 641 the direction of the longest living variable. If not, the reference 642 pointer will point into the dark if the other end dies. This 643 implies that if both cells are part of an environment frame, the one 644 in the child function (closest to the top of the stack) must point 645 to the one in the parent function. If one is on the local and one 646 on the global stack, the pointer must point towards the global 647 stack. Inside the global stack it is irrelevant. If backtracking 648 destroys a variable, it also will reset the reference towards it if 649 there is one. 650 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 651 652 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 653 Common Prolog objects typedefs. Note that code is word-aligned for two 654 reasons. First of all, we want to get the maximum speed and second, we 655 must ensure that sizeof(struct clause) is a multiple of sizeof(word) to 656 place them on the stack (see I_USERCALL). 657 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 658 659 #ifdef __GNUC__ 660 #define WORD_ALIGNED __attribute__ ((aligned (sizeof(word)))) 661 #else 662 #define WORD_ALIGNED 663 #endif 664 665 #ifndef PL_HAVE_TERM_T 666 #define PL_HAVE_TERM_T 667 typedef uintptr_t term_t; /* external term-reference */ 668 #endif 669 670 typedef uintptr_t word; /* Anonymous 4 byte object */ 671 typedef word * Word; /* a pointer to anything */ 672 typedef word atom_t; /* encoded atom */ 673 typedef word functor_t; /* encoded functor */ 674 typedef uintptr_t code WORD_ALIGNED; /* bytes codes */ 675 typedef code * Code; /* pointer to byte codes */ 676 typedef int Char; /* char that can pass EOF */ 677 typedef word (*Func)(); /* foreign functions */ 678 typedef int (*ArithF)(); /* arithmetic function */ 679 680 typedef struct atom * Atom; /* atom */ 681 typedef struct functor * Functor; /* complex term */ 682 typedef struct functorDef * FunctorDef; /* name/arity pair */ 683 typedef struct procedure * Procedure; /* predicate */ 684 typedef struct definition * Definition; /* predicate definition */ 685 typedef struct definition_chain *DefinitionChain; /* linked list of defs */ 686 typedef struct clause * Clause; /* compiled clause */ 687 typedef struct clause_ref * ClauseRef; /* reference to a clause */ 688 typedef struct clause_index * ClauseIndex; /* Clause indexing table */ 689 typedef struct clause_bucket * ClauseBucket; /* Bucked in clause-index table */ 690 typedef struct operator * Operator; /* see pl-op.c, pl-read.c */ 691 typedef struct record * Record; /* recorda/3, etc. */ 692 typedef struct recordRef * RecordRef; /* reference to a record */ 693 typedef struct recordList * RecordList; /* list of these */ 694 typedef struct module * Module; /* predicate modules */ 695 typedef struct sourceFile * SourceFile; /* file adminitration */ 696 typedef struct list_cell * ListCell; /* Anonymous list */ 697 typedef struct localFrame * LocalFrame; /* environment frame */ 698 typedef struct local_definitions *LocalDefinitions; /* thread-local preds */ 699 typedef struct choice * Choice; /* Choice-point */ 700 typedef struct clause_choice * ClauseChoice; /* firstClause()/nextClause() */ 701 typedef struct queryFrame * QueryFrame; /* toplevel query frame */ 702 typedef struct fliFrame * FliFrame; /* FLI interface frame */ 703 typedef struct trail_entry * TrailEntry; /* Entry of trail stack */ 704 typedef struct gc_trail_entry * GCTrailEntry; /* Entry of trail stack (GC) */ 705 typedef struct mark mark; /* backtrack mark */ 706 typedef struct stack * Stack; /* machine stack */ 707 typedef struct _varDef * VarDef; /* pl-comp.c */ 708 typedef struct extension_cell * ExtensionCell; /* pl-ext.c */ 709 typedef struct abort_handle * AbortHandle; /* PL_abort_hook() */ 710 typedef struct initialise_handle * InitialiseHandle; 711 typedef struct canonical_dir * CanonicalDir; /* pl-os.c */ 712 typedef struct on_halt * OnHalt; /* pl-os.c */ 713 typedef struct find_data_tag * FindData; /* pl-trace.c */ 714 typedef struct feature * Feature; /* pl-prims.c */ 715 typedef struct dirty_def_info * DirtyDefInfo; 716 717 typedef uintptr_t qid_t; /* external query-id */ 718 typedef uintptr_t PL_fid_t; /* external foreign context-id */ 719 720 #define fid_t PL_fid_t /* avoid AIX name-clash */ 721 722 /******************************* 723 * ARITHMETIC * 724 *******************************/ 725 726 /* the numtype enum requires total ordering. 727 */ 728 729 typedef enum 730 { V_INTEGER, /* integer (64-bit) value */ 731 #ifdef O_GMP 732 V_MPZ, /* mpz_t */ 733 V_MPQ, /* mpq_t */ 734 #endif 735 V_FLOAT /* Floating point number (double) */ 736 } numtype; 737 738 typedef struct 739 { numtype type; /* type of number */ 740 union { double f; /* value as a floating point number */ 741 int64_t i; /* value as integer */ 742 word w[WORDS_PER_DOUBLE]; /* for packing/unpacking the double */ 743 #ifdef O_GMP 744 mpz_t mpz; /* GMP integer */ 745 mpq_t mpq; /* GMP rational */ 746 #endif 747 } value; 748 } number, *Number; 749 750 #define TOINT_CONVERT_FLOAT 0x1 /* toIntegerNumber() */ 751 #define TOINT_TRUNCATE 0x2 752 753 #ifdef O_GMP 754 #define intNumber(n) ((n)->type <= V_MPZ) 755 #define ratNumber(n) ((n)->type <= V_MPQ) 756 #else 757 #define intNumber(n) ((n)->type < V_FLOAT) 758 #define ratNumber(n) ((n)->type < V_FLOAT) 759 #endif 760 #define floatNumber(n) ((n)->type >= V_FLOAT) 761 762 typedef enum 763 { NUM_ERROR = FALSE, /* Syntax error */ 764 NUM_OK = TRUE, /* Ok */ 765 NUM_FUNDERFLOW = -1, /* Float underflow */ 766 NUM_FOVERFLOW = -2, /* Float overflow */ 767 NUM_IOVERFLOW = -3, /* Integer overflow */ 768 NUM_CONSTRANGE = -4 /* numeric constant out of range */ 769 } strnumstat; 770 771 772 773 /******************************* 774 * GET-PROCEDURE * 775 *******************************/ 776 777 #define GP_FIND 0 /* find anywhere */ 778 #define GP_FINDHERE 1 /* find in this module */ 779 #define GP_CREATE 2 /* create (in this module) */ 780 #define GP_DEFINE 4 /* define a procedure */ 781 #define GP_RESOLVE 5 /* find defenition */ 782 783 #define GP_HOW_MASK 0x0ff 784 #define GP_NAMEARITY 0x100 /* or'ed mask */ 785 #define GP_HIDESYSTEM 0x200 /* hide system module */ 786 #define GP_TYPE_QUIET 0x400 /* don't throw errors on wrong types */ 787 #define GP_EXISTENCE_ERROR 0x800 /* throw error if proc is not found */ 788 #define GP_QUALIFY 0x1000 /* Always module-qualify */ 789 #define GP_NOT_QUALIFIED 0x2000 /* Demand unqualified name/arity */ 790 791 /* get_functor() */ 792 #define GF_EXISTING 0x1 793 #define GF_PROCEDURE 0x2 /* check for max arity */ 794 #define GF_NAMEARITY 0x4 /* only accept name/arity */ 795 796 #define SM_NOCREATE 0x1 /* stripModule(): do not create modules */ 797 798 /******************************* 799 * ALERT * 800 *******************************/ 801 802 /* See updateAlerted() 803 */ 804 805 #define ALERT_SIGNAL 0x001 806 #define ALERT_GCREQ 0x002 807 #define ALERT_PROFILE 0x004 808 #define ALERT_EXITREQ 0x008 809 #define ALERT_DEPTHLIMIT 0x010 810 #define ALERT_INFERENCELIMIT 0x020 811 #define ALERT_WAKEUP 0x040 812 #define ALERT_DEBUG 0x080 813 #define ALERT_BUFFER 0x100 814 815 816 /******************************* 817 * CLEANUP * 818 *******************************/ 819 820 typedef enum 821 { CLN_NORMAL = 0, /* Normal mode */ 822 CLN_PROLOG, /* Prolog hooks */ 823 CLN_FOREIGN, /* Foreign hooks */ 824 CLN_IO, /* Cleaning I/O */ 825 CLN_SHARED, /* Unload shared objects */ 826 CLN_DATA /* Remaining data */ 827 } cleanup_status; 828 829 830 /******************************* 831 * FLAGS * 832 *******************************/ 833 834 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 835 Many of the structures have a large number of booleans associated with 836 them. Early versions defined these using `unsigned <name> : 1' in the 837 structure definition. When I ported SWI-Prolog to a machine that did 838 not understand this construct I decided to pack all the flags in a 839 short. As this allows us to set, clear and test combinations of flags 840 with one operation, it turns out to be faster as well. 841 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 842 843 #define true(s, a) ((s)->flags & (a)) 844 #define false(s, a) (!true((s), (a))) 845 #define set(s, a) ATOMIC_OR(&(s)->flags, (a)) 846 #define clear(s, a) ATOMIC_AND(&(s)->flags, ~(a)) 847 #define clearFlags(s) ((s)->flags = 0) 848 849 /* Flags on predicates (packed in unsigned int */ 850 851 #define P_TABLED (0x00000001) /* tabled predicate */ 852 #define P_CLAUSABLE (0x00000002) /* Clause/2 always works */ 853 #define P_QUASI_QUOTATION_SYNTAX (0x00000004) /* {|Type||Quasi Quote|} */ 854 #define P_NON_TERMINAL (0x00000008) /* Grammar rule (Name//Arity) */ 855 #define P_SHRUNKPOW2 (0x00000010) /* See reconsider_index() */ 856 #define P_FOREIGN (0x00000020) /* Implemented in C */ 857 #define P_NONDET (0x00000040) /* Foreign: nondet */ 858 #define P_VARARG (0x00000080) /* Foreign: use alt calling API */ 859 #define P_FOREIGN_CREF (0x00000100) /* Foreign: ndet ctx is clause */ 860 #define P_DYNAMIC (0x00000200) /* Dynamic predicate */ 861 #define P_THREAD_LOCAL (0x00000400) /* Thread local dynamic predicate */ 862 #define P_VOLATILE (0x00000800) /* Clauses are not saved */ 863 #define P_DISCONTIGUOUS (0x00001000) /* Clauses are not together */ 864 #define P_MULTIFILE (0x00002000) /* Clauses are in multiple files */ 865 #define P_PUBLIC (0x00004000) /* Called from somewhere */ 866 #define P_ISO (0x00008000) /* Part of the ISO standard */ 867 #define P_LOCKED (0x00010000) /* Locked as system predicate */ 868 #define P_NOPROFILE (0x00020000) /* Profile children, not me */ 869 #define P_TRANSPARENT (0x00040000) /* Inherit calling module */ 870 #define P_META (0x00080000) /* Has meta_predicate declaration */ 871 #define P_MFCONTEXT (0x00100000) /* Used for Goal@Module */ 872 #define P_DIRTYREG (0x00200000) /* Part of GD->procedures.dirty */ 873 #define P_ERASED (0x00400000) /* Predicate has been destroyed */ 874 #define HIDE_CHILDS (0x00800000) /* Hide children from tracer */ 875 #define SPY_ME (0x01000000) /* Spy point placed */ 876 #define TRACE_ME (0x02000000) /* Can be debugged */ 877 #define P_INCREMENTAL (0x04000000) /* Incremental tabling */ 878 #define P_AUTOLOAD (0x08000000) /* autoload/2 explicit import */ 879 #define P_TSHARED (0x10000000) /* Using a shared table */ 880 #define P_LOCKED_SUPERVISOR (0x20000000) /* Fixed supervisor */ 881 #define FILE_ASSIGNED (0x40000000) /* Is assigned to a file */ 882 #define P_REDEFINED (0x80000000) /* Overrules a definition */ 883 #define PROC_DEFINED (P_DYNAMIC|P_FOREIGN|P_MULTIFILE|\ 884 P_DISCONTIGUOUS|P_LOCKED_SUPERVISOR) 885 /* flags for p_reload data (reconsult) */ 886 #define P_MODIFIED P_DIRTYREG 887 #define P_NEW SPY_ME 888 #define P_NO_CLAUSES TRACE_ME 889 890 /* Flags on clauses (unsigned int) */ 891 892 #define CL_ERASED (0x0001) /* clause was erased */ 893 #define UNIT_CLAUSE (0x0002) /* Clause has no body */ 894 #define HAS_BREAKPOINTS (0x0004) /* Clause has breakpoints */ 895 #define GOAL_CLAUSE (0x0008) /* Dummy for meta-calling */ 896 #define COMMIT_CLAUSE (0x0010) /* This clause will commit */ 897 #define DBREF_CLAUSE (0x0020) /* Clause has db-reference */ 898 #define DBREF_ERASED_CLAUSE (0x0040) /* Deleted while referenced */ 899 #define CL_BODY_CONTEXT (0x0080) /* Module context of body is different */ 900 /* from predicate */ 901 902 /* Flags on a DDI (Dirty Definition Info struct */ 903 904 #define DDI_MARKING 0x0001 /* Actively using the DDI */ 905 #define DDI_INTERVALS 0x0002 /* DDI collects an interval */ 906 907 /* Flags on module. Most of these flags are copied to the read context 908 in pl-read.c. 909 */ 910 911 #define M_SYSTEM (0x00000001) /* system module */ 912 #define M_CHARESCAPE (0x00000002) /* module */ 913 #define DBLQ_CHARS (0x00000004) /* "ab" --> ['a', 'b'] */ 914 #define DBLQ_ATOM (0x00000008) /* "ab" --> 'ab' */ 915 #define DBLQ_STRING (0x00000010) /* "ab" --> "ab" */ 916 #define DBLQ_MASK (DBLQ_CHARS|DBLQ_ATOM|DBLQ_STRING) 917 #define BQ_STRING (0x00000020) /* `ab` --> "ab" */ 918 #define BQ_CODES (0x00000040) /* `ab` --> [97,98] */ 919 #define BQ_CHARS (0x00000080) /* `ab` --> [a,b] */ 920 #define BQ_MASK (BQ_STRING|BQ_CODES|BQ_CHARS) 921 #define RAT_COMPAT (0) 922 #define RAT_NATURAL (0x00000100) /* 1/3 */ 923 #define RAT_MASK (RAT_NATURAL) 924 #define UNKNOWN_FAIL (0x00001000) /* module */ 925 #define UNKNOWN_WARNING (0x00002000) /* module */ 926 #define UNKNOWN_ERROR (0x00004000) /* module */ 927 #define UNKNOWN_MASK (UNKNOWN_ERROR|UNKNOWN_WARNING|UNKNOWN_FAIL) 928 #define M_VARPREFIX (0x00008000) /* _var, Atom */ 929 #define M_DESTROYED (0x00010000) 930 931 /* Flags on functors */ 932 933 #define CONTROL_F (0x0002) /* functor (compiled controlstruct) */ 934 #define ARITH_F (0x0004) /* functor (arithmetic operator) */ 935 #define VALID_F (0x0008) /* functor (fully defined) */ 936 937 /* Flags on record lists (recorded database keys) */ 938 939 #define RL_DIRTY (0x0001) /* recordlist */ 940 941 /* Flags on recorded database records (also PL_record()) */ 942 943 #define R_ERASED (0x0001) /* record: record is erased */ 944 #define R_EXTERNAL (0x0002) /* record: inline atoms */ 945 #define R_DUPLICATE (0x0004) /* record: include references */ 946 #define R_NOLOCK (0x0008) /* record: do not lock atoms */ 947 #define R_DBREF (0x0010) /* record: has DB-reference */ 948 949 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 950 Macros for environment frames (local stack frames) 951 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 952 953 #define FR_HIDE_CHILDS (0x0001) /* flag of pred after I_DEPART */ 954 #define FR_SKIPPED (0x0002) /* We have skipped on this frame */ 955 #define FR_MARKED (0x0004) /* GC */ 956 #define FR_MARKED_PRED (0x0008) /* GC predicates/clauses */ 957 #define FR_DEBUG (0x0010) /* GUI debugger */ 958 #define FR_CATCHED (0x0020) /* Frame caught an exception */ 959 #define FR_INBOX (0x0040) /* Inside box (for REDO in built-in) */ 960 #define FR_CONTEXT (0x0080) /* fr->context is set */ 961 #define FR_CLEANUP (0x0100) /* setup_call_cleanup/4 */ 962 #define FR_INRESET (0x0200) /* Continuations: inside reset/3 */ 963 #define FR_WATCHED (FR_CLEANUP|FR_DEBUG) 964 965 #define FR_MAGIC_MASK (0xfffff000) 966 #define FR_MAGIC_MASK2 (0xffff0000) 967 #define FR_MAGIC (0x549d5000) 968 969 #define isFrame(fr) (((fr)->flags&FR_MAGIC_MASK) == FR_MAGIC) 970 #define wasFrame(fr) (((fr)->flags&FR_MAGIC_MASK2) == \ 971 (FR_MAGIC&FR_MAGIC_MASK2)) 972 #define killFrame(fr) clear(fr, (FR_MAGIC_MASK&~FR_MAGIC_MASK2)) 973 974 #define ARGOFFSET ((int)sizeof(struct localFrame)) 975 #define VAROFFSET(var) ((var)+(ARGOFFSET/(int)sizeof(word))) 976 977 #define setLevelFrame(fr, l) do { (fr)->level = (l); } while(0) 978 #define levelFrame(fr) ((fr)->level) 979 #define argFrameP(f, n) ((Word)((f)+1) + (n)) 980 #define argFrame(f, n) (*argFrameP((f), (n)) ) 981 #define varFrameP(f, n) ((Word)(f) + (n)) 982 #define varFrame(f, n) (*varFrameP((f), (n)) ) 983 #define refFliP(f, n) ((Word)((f)+1) + (n)) 984 #define parentFrame(f) ((f)->parent ? (f)->parent\ 985 : (LocalFrame)varFrame((f), -1)) 986 #define slotsFrame(f) (true((f)->predicate, P_FOREIGN) ? \ 987 (f)->predicate->functor->arity : \ 988 (f)->clause->clause->prolog_vars) 989 990 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 991 Generations must be 64-bit to avoid overflow in realistic scenarios. 992 This makes them the only 64-bit value in struct localFrame. Stack frames 993 mix with variables on the stacks and are thus word-aligned. We have two 994 options here. One is to represent a generation as a struct (used below) 995 or we must align frame at 8-byte boundaries. The latter is probably the 996 best solution, but merely aligning lTop in I_ENTER doesn't seem to be 997 doing the trick: it causes failure of the test suite for which I failed 998 to find the reason. Enabling the structure on x86 causes a slowdown of 999 about 5%. I'd assume the difference is smaller on real 32-bit hardware. 1000 1001 We enable this if the alignment of an int64_t type is not the same as 1002 the alignment of pointers. 1003 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1004 1005 #ifdef O_LOGICAL_UPDATE 1006 typedef uint64_t gen_t; 1007 1008 #define GEN_MAX (~(gen_t)0) 1009 #define GEN_NEW_DIRTY (gen_t)0 1010 1011 #if ALIGNOF_INT64_T != ALIGNOF_VOIDP 1012 typedef struct lgen_t 1013 { uint32_t gen_l; 1014 uint32_t gen_u; 1015 } lgen_t; 1016 1017 #define generationFrame(f) \ 1018 ((gen_t)(f)->generation.gen_u<<32 | (gen_t)(f)->generation.gen_l) 1019 #define setGenerationFrameVal(f, g) \ 1020 do { gen_t __gen = (g); \ 1021 (f)->generation.gen_u = (uint32_t)(__gen>>32); \ 1022 (f)->generation.gen_l = (uint32_t)(__gen); \ 1023 } while(0) 1024 #else 1025 typedef uint64_t lgen_t; 1026 #define generationFrame(f) ((f)->generation) 1027 #define setGenerationFrameVal(f, gen) \ 1028 do { (f)->generation = (gen); } while(0) 1029 #endif 1030 #if defined(HAVE_GCC_ATOMIC_8) || SIZEOF_VOIDP == 8 1031 typedef uint64_t ggen_t; 1032 #else 1033 #define ATOMIC_GENERATION_HACK 1 1034 typedef struct ggen_t 1035 { uint32_t gen_l; 1036 uint32_t gen_u; 1037 } ggen_t; 1038 #endif /*HAVE_GCC_ATOMIC_8 || SIZEOF_VOIDP == 8*/ 1039 #else /*O_LOGICAL_UPDATE*/ 1040 #define global_generation() (0) 1041 #define next_global_generation() (0) 1042 #endif /*O_LOGICAL_UPDATE*/ 1043 1044 #define setGenerationFrame(fr) setGenerationFrame__LD((fr) PASS_LD) 1045 1046 #define FR_CLEAR_NEXT FR_SKIPPED|FR_WATCHED|FR_CATCHED|FR_HIDE_CHILDS|FR_CLEANUP 1047 #define FR_CLEAR_FLAGS (FR_CLEAR_NEXT|FR_CONTEXT) 1048 1049 #define setNextFrameFlags(next, fr) \ 1050 do \ 1051 { (next)->level = (fr)->level+1; \ 1052 (next)->flags = ((fr)->flags) & ~FR_CLEAR_FLAGS; \ 1053 } while(0) 1054 1055 #define setFramePredicate(fr, def) \ 1056 do \ 1057 { (fr)->predicate = (def); \ 1058 } while(0) 1059 1060 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1061 Predicate reference counting. The aim of this mechanism is to avoid 1062 modifying the predicate structure while it has choicepoints or (MT) 1063 other threads running the predicate. For dynamic code we allow to clean 1064 the predicate as the reference-count drops to zero. For static code we 1065 introduce a garbage collector (TBD). 1066 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1067 1068 #define enterDefinition(def) (void)0 1069 #define leaveDefinition(def) (void)0 1070 1071 1072 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1073 At times an abort is not allowed because the heap is inconsistent the 1074 programmer should call startCritical to start such a code region and 1075 endCritical to end it. 1076 1077 MT/TBD: how to handle this gracefully in the multi-threading case. Does 1078 it mean anything? 1079 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1080 1081 #define startCritical (void)(LD->critical++) 1082 #define endCritical ((--(LD->critical) == 0 && LD->alerted) \ 1083 ? endCritical__LD(PASS_LD1) : TRUE) 1084 1085 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1086 LIST processing macros. 1087 1088 isNil(w) word is the nil list ([]). 1089 isList(w) word is a './2' term. 1090 HeadList(p) Pointer to the head of list *p (NOT dereferenced). 1091 TailList(p) Pointer to the tail of list *p (NOT dereferenced). 1092 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1093 1094 #define HeadList(p) (argTermP(*(p), 0) ) 1095 #define TailList(p) (argTermP(*(p), 1) ) 1096 1097 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1098 Doubles. To and from are Word pointers pointing to the data of a double, 1099 but generally not satisfying the double alignment requirements. We 1100 assume 1101 1102 sizeof(*to) == sizeof(*from) && 1103 sizeof(*to) * n == sizeof(*double) 1104 with n == 1 or n == 2. 1105 1106 We assume the compiler will optimise this properly. 1107 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1108 1109 #define cpDoubleData(to, from) \ 1110 { Word _f = (Word)(from); \ 1111 switch(WORDS_PER_DOUBLE) \ 1112 { case 2: \ 1113 *(to)++ = *_f++; \ 1114 case 1: \ 1115 *(to)++ = *_f++; \ 1116 from = (void *)_f; \ 1117 break; \ 1118 default: \ 1119 assert(0); \ 1120 } \ 1121 } 1122 1123 #define cpInt64Data(to, from) \ 1124 { Word _f = (Word)(from); \ 1125 switch(WORDS_PER_INT64) \ 1126 { case 2: \ 1127 *(to)++ = *_f++; \ 1128 case 1: \ 1129 *(to)++ = *_f++; \ 1130 from = (void *)_f; \ 1131 break; \ 1132 default: \ 1133 assert(0); \ 1134 } \ 1135 } 1136 1137 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1138 Structure declarations that must be shared across multiple files. 1139 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1140 1141 struct atom 1142 { Atom next; /* next in chain */ 1143 word atom; /* as appearing on the global stack */ 1144 #ifdef O_TERMHASH 1145 unsigned int hash_value; /* hash-key value */ 1146 #endif 1147 #ifdef O_ATOMGC 1148 unsigned int references; /* reference-count */ 1149 #endif 1150 union 1151 { struct PL_blob_t * type; /* blob-extension */ 1152 uintptr_t next_invalid; /* next invalidated atom */ 1153 }; 1154 size_t length; /* length of the atom */ 1155 char * name; /* name associated with atom */ 1156 }; 1157 1158 1159 typedef struct atom_array 1160 { Atom blocks[8*sizeof(void*)]; 1161 } atom_array; 1162 1163 typedef struct atom_table * AtomTable; 1164 1165 typedef struct atom_table 1166 { AtomTable prev; 1167 int buckets; 1168 Atom * table; 1169 } atom_table; 1170 1171 1172 #ifdef O_ATOMGC 1173 1174 #define ATOM_STATE_MASK ((unsigned int)0xF << (INTBITSIZE-4)) 1175 #define ATOM_RESERVED_REFERENCE ((unsigned int)0x1 << (INTBITSIZE-1)) 1176 #define ATOM_VALID_REFERENCE ((unsigned int)0x1 << (INTBITSIZE-2)) 1177 #define ATOM_MARKED_REFERENCE ((unsigned int)0x1 << (INTBITSIZE-3)) 1178 #define ATOM_DESTROY_REFERENCE ((unsigned int)0x1 << (INTBITSIZE-4)) 1179 1180 #define ATOM_IS_FREE(ref) (((ref) & ATOM_STATE_MASK) == 0) 1181 #define ATOM_IS_RESERVED(ref) ((ref) & ATOM_RESERVED_REFERENCE) 1182 #define ATOM_IS_VALID(ref) ((ref) & ATOM_VALID_REFERENCE) 1183 #define ATOM_IS_MARKED(ref) ((ref) & ATOM_MARKED_REFERENCE) 1184 #define ATOM_IS_DESTROYED(ref) ((ref) & ATOM_DESTROY_REFERENCE) 1185 1186 #define ATOM_REF_COUNT_MASK (~ATOM_STATE_MASK) 1187 #define ATOM_REF_COUNT(ref) ((ref) & ATOM_REF_COUNT_MASK) 1188 1189 #define ATOM_TYPE_INVALID ((PL_blob_t*)0x007) 1190 1191 #ifdef O_DEBUG_ATOMGC 1192 extern IOSTREAM *atomLogFd; 1193 #define PL_register_atom(a) \ 1194 _PL_debug_register_atom(a, __FILE__, __LINE__, __PRETTY_FUNCTION__) 1195 #define PL_unregister_atom(a) \ 1196 _PL_debug_unregister_atom(a, __FILE__, __LINE__, __PRETTY_FUNCTION__) 1197 #endif 1198 #else /*!O_ATOMGC*/ 1199 #define PL_register_atom(a) 1200 #define PL_unregister_atom(a) 1201 #endif 1202 1203 struct functorDef 1204 { FunctorDef next; /* next in chain */ 1205 word functor; /* as appearing on the global stack */ 1206 word name; /* Name of functor */ 1207 size_t arity; /* arity of functor */ 1208 unsigned flags; /* Flag field holding: */ 1209 /* CONTROL_F Compiled control-structure */ 1210 /* ARITH_F Arithmetic function */ 1211 /* VALID_F Fully defined functor */ 1212 }; 1213 1214 1215 typedef struct functor_array 1216 { FunctorDef *blocks[8*sizeof(void*)]; 1217 } functor_array; 1218 1219 typedef struct functor_table * FunctorTable; 1220 1221 typedef struct functor_table 1222 { FunctorTable prev; 1223 int buckets; 1224 FunctorDef * table; 1225 } functor_table; 1226 1227 #define FUNCTOR_IS_VALID(flags) ((flags) & VALID_F) 1228 1229 1230 #ifdef O_LOGICAL_UPDATE 1231 #define VISIBLE_CLAUSE(cl, gen) \ 1232 ( ( (cl)->generation.created <= (gen) && \ 1233 (cl)->generation.erased > (gen) && \ 1234 (cl)->generation.erased != LD->gen_reload \ 1235 ) || \ 1236 ( (cl)->generation.created == LD->gen_reload \ 1237 ) \ 1238 ) 1239 #define GLOBALLY_VISIBLE_CLAUSE(cl, gen) \ 1240 ( (cl)->generation.created <= (gen) && \ 1241 (cl)->generation.erased > (gen) \ 1242 ) 1243 #else 1244 #define VISIBLE_CLAUSE(cl, gen) false(cl, CL_ERASED) 1245 #define GLOBALLY_VISIBLE_CLAUSE(cl, gen) false(cl, CL_ERASED) 1246 #endif 1247 1248 #define visibleClause(cl, gen) visibleClause__LD(cl, gen PASS_LD) 1249 #define visibleClauseCNT(cl, gen) visibleClauseCNT__LD(cl, gen PASS_LD) 1250 1251 #define GEN_INVALID 0 1252 1253 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1254 Struct clause must be a multiple of sizeof(word) for compilation on 1255 behalf of I_USERCALL. This is verified in an assertion in 1256 checkCodeTable(). 1257 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1258 1259 #define sizeofClause(n) ((char *)&((Clause)NULL)->codes[n] - (char *)NULL) 1260 1261 struct clause 1262 { Definition predicate; /* Predicate I belong to */ 1263 #ifdef O_LOGICAL_UPDATE 1264 struct 1265 { gen_t created; /* Generation that created me */ 1266 gen_t erased; /* Generation I was erased */ 1267 } generation; 1268 #endif /*O_LOGICAL_UPDATE*/ 1269 unsigned int variables; /* # of variables for frame */ 1270 unsigned int prolog_vars; /* # real Prolog variables */ 1271 unsigned int flags; /* Flag field holding: */ 1272 unsigned int line_no; /* Source line-number */ 1273 unsigned int source_no; /* Index of source-file */ 1274 unsigned int owner_no; /* Index of owning source-file */ 1275 unsigned int references; /* # ClauseRef pointing at me */ 1276 code code_size; /* size of ->codes */ 1277 code codes[1]; /* VM codes of clause */ 1278 }; 1279 1280 typedef struct arg_info 1281 { float speedup; /* Computed speedup */ 1282 unsigned list : 1; /* Index using lists */ 1283 unsigned ln_buckets : 5; /* lg2(bucket count) */ 1284 unsigned assessed : 1; /* Value was assessed */ 1285 unsigned meta : 4; /* Meta-argument info */ 1286 } arg_info; 1287 1288 typedef struct impl_any 1289 { arg_info *args; /* Meta and indexing info */ 1290 void *defined; /* One of function or first_clause */ 1291 } impl_any, *ImplAny; 1292 1293 typedef struct impl_foreign 1294 { arg_info *args; /* Meta and indexing info */ 1295 Func function; /* Function pointer */ 1296 } impl_foreign, *ImplForeign; 1297 1298 typedef struct impl_wrapped 1299 { arg_info *args; /* Meta and indexing info */ 1300 Definition predicate; /* Wrapped predicate */ 1301 Code supervisor; /* Supervisor to use */ 1302 } impl_wrapped, *ImplWrapped; 1303 1304 typedef struct impl_local 1305 { arg_info *args; /* Meta and indexing info */ 1306 LocalDefinitions local; /* P_THREAD_LOCAL predicates */ 1307 } impl_local, *ImplLocal; 1308 1309 1310 typedef struct clause_list 1311 { arg_info *args; /* Meta and indexing info */ 1312 ClauseRef first_clause; /* clause list of procedure */ 1313 ClauseRef last_clause; /* last clause of list */ 1314 ClauseIndex *clause_indexes; /* Hash index(es) */ 1315 unsigned int number_of_clauses; /* number of associated clauses */ 1316 unsigned int erased_clauses; /* number of erased clauses in set */ 1317 unsigned int number_of_rules; /* number of real rules */ 1318 unsigned int jiti_tried; /* number of times we tried to find */ 1319 } clause_list, *ClauseList; 1320 1321 typedef struct clause_ref 1322 { ClauseRef next; /* Next in list */ 1323 union 1324 { word key; /* Index key */ 1325 ClauseRef gnext; /* Next garbage clause reference */ 1326 } d; 1327 union 1328 { Clause clause; /* Single clause value */ 1329 clause_list clauses; /* Clause list (in hash-tables) */ 1330 } value; 1331 } clause_ref; 1332 1333 #define SIZEOF_CREF_CLAUSE (offsetof(clause_ref, value.clause) + \ 1334 sizeof(Clause)) 1335 #define SIZEOF_CREF_LIST sizeof(clause_ref) 1336 1337 typedef struct cgc_stats 1338 { int threads; /* # threads to scan */ 1339 size_t local_size; /* Summed size of local stacks */ 1340 size_t dirty_pred_clauses; /* # clauses in dirty predicates */ 1341 int64_t erased_skipped; /* # skipped clauses that are erased */ 1342 } cgc_stats; 1343 1344 #define GC_STAT_WINDOW_SIZE 3 1345 #define GC_GLOBAL_OVERFLOW 0x000000000001 1346 #define GC_GLOBAL_REQUEST 0x000000000100 1347 #define GC_TRAIL_OVERFLOW 0x000000010000 1348 #define GC_TRAIL_REQUEST 0x000001000000 1349 #define GC_EXCEPTION 0x000100000000 1350 #define GC_USER 0x010000000000 1351 1352 typedef uint64_t gc_reason_t; 1353 1354 typedef struct gc_stat 1355 { size_t global_before; 1356 size_t global_after; 1357 size_t trail_before; 1358 size_t trail_after; 1359 size_t local; 1360 double gc_time; /* time spent on last GC */ 1361 double prolog_time; /* Real work CPU before this GC */ 1362 gc_reason_t reason; /* why GC was run */ 1363 } gc_stat; 1364 1365 typedef struct gc_stats 1366 { gc_stat last[GC_STAT_WINDOW_SIZE]; 1367 gc_stat aggr[GC_STAT_WINDOW_SIZE]; 1368 int last_index; 1369 int aggr_index; 1370 double thread_cpu; /* Last thread CPU time */ 1371 gc_reason_t request; /* Requesting stack */ 1372 struct 1373 { int64_t collections; 1374 int64_t global_gained; /* global stack bytes collected */ 1375 int64_t trail_gained; /* trail stack bytes collected */ 1376 double time; /* time spent in collections */ 1377 } totals; 1378 } gc_stats; 1379 1380 1381 #define VM_DYNARGC 255 /* compute argcount dynamically */ 1382 1383 #define CA1_PROC 1 /* code arg 1 is procedure */ 1384 #define CA1_FUNC 2 /* code arg 1 is functor */ 1385 #define CA1_DATA 3 /* code arg 2 is prolog data (H_ATOM, H_SMALLINT) */ 1386 #define CA1_INTEGER 4 /* intptr_t value */ 1387 #define CA1_INT64 5 /* int64 value */ 1388 #define CA1_FLOAT 6 /* next WORDS_PER_DOUBLE are double */ 1389 #define CA1_STRING 7 /* inlined string */ 1390 #define CA1_MPZ 8 /* GNU mpz number */ 1391 #define CA1_MPQ 9 /* GNU mpq number */ 1392 #define CA1_MODULE 10 /* a module */ 1393 #define CA1_VAR 11 /* a variable(-offset) */ 1394 #define CA1_FVAR 12 /* a variable(-offset), used as `firstvar' */ 1395 #define CA1_CHP 13 /* ChoicePoint (also variable(-offset)) */ 1396 #define CA1_FOREIGN 14 /* Foreign function pointer */ 1397 #define CA1_CLAUSEREF 15 /* Clause reference */ 1398 #define CA1_JUMP 16 /* Instructions to skip */ 1399 #define CA1_AFUNC 17 /* Number of arithmetic function */ 1400 #define CA1_TRIE_NODE 18 /* Tabling: answer trie node with delays */ 1401 1402 #define VIF_BREAK 0x01 /* Can be a breakpoint */ 1403 1404 typedef enum 1405 { VMI_REPLACE, 1406 VMI_STEP_ARGUMENT 1407 } vmi_merge_type; 1408 1409 typedef struct 1410 { vmi code; /* Code to merge with */ 1411 vmi_merge_type how; /* How to merge? */ 1412 vmi merge_op; /* Opcode of merge */ 1413 int merge_ac; /* #arguments of merged code */ 1414 code merge_av[1]; /* Argument vector */ 1415 } vmi_merge; 1416 1417 typedef struct 1418 { char *name; /* name of the code */ 1419 vmi code; /* number of the code */ 1420 unsigned char flags; /* Addional flags (VIF_*) */ 1421 unsigned char arguments; /* #args code takes (or VM_DYNARGC) */ 1422 char argtype[4]; /* Argument type(s) code takes */ 1423 } code_info; 1424 1425 struct mark 1426 { TrailEntry trailtop; /* top of the trail stack */ 1427 Word globaltop; /* top of the global stack */ 1428 Word saved_bar; /* saved LD->mark_bar */ 1429 }; 1430 1431 struct functor 1432 { word definition; /* Tagged definition pointer */ 1433 word arguments[1]; /* arguments vector */ 1434 }; 1435 1436 struct clause_bucket 1437 { ClauseRef head; 1438 ClauseRef tail; 1439 unsigned int dirty; /* # of garbage clauses */ 1440 }; 1441 1442 #define MAX_MULTI_INDEX 4 1443 #define MAXINDEXARG 254 1444 #define MAXINDEXDEPTH 7 1445 #define END_INDEX_POS 255 1446 1447 typedef unsigned char iarg_t; /* index argument */ 1448 1449 struct clause_index 1450 { unsigned int buckets; /* # entries */ 1451 unsigned int size; /* # clauses */ 1452 unsigned int resize_above; /* consider resize > #clauses */ 1453 unsigned int resize_below; /* consider resize < #clauses */ 1454 unsigned int dirty; /* # chains that are dirty */ 1455 unsigned is_list : 1; /* Index with lists */ 1456 unsigned incomplete : 1; /* Index is incomplete */ 1457 unsigned invalid : 1; /* Index is invalid */ 1458 iarg_t args[MAX_MULTI_INDEX]; /* Indexed arguments */ 1459 iarg_t position[MAXINDEXDEPTH+1]; /* Deep index position */ 1460 float speedup; /* Estimated speedup */ 1461 ClauseBucket entries; /* chains holding the clauses */ 1462 }; 1463 1464 #define MAX_BLOCKS 20 /* allows for 2M threads */ 1465 1466 typedef struct local_definitions 1467 { Definition *blocks[MAX_BLOCKS]; 1468 Definition preallocated[7]; 1469 } local_definitions; 1470 1471 struct definition 1472 { FunctorDef functor; /* Name/Arity of procedure */ 1473 Module module; /* module of the predicate */ 1474 Code codes; /* Executable code */ 1475 union 1476 { impl_any any; /* has some value */ 1477 clause_list clauses; /* (Indexed) list of clauses */ 1478 impl_foreign foreign; /* Foreign implementation */ 1479 impl_wrapped wrapped; /* Wrapped predicate */ 1480 impl_local local; /* P_THREAD_LOCAL predicates */ 1481 } impl; 1482 unsigned int flags; /* booleans (P_*) */ 1483 unsigned int shared; /* #procedures sharing this def */ 1484 struct linger_list *lingering; /* Assocated lingering objects */ 1485 gen_t last_modified; /* Generation I was last modified */ 1486 struct event_list *events; /* Forward update events */ 1487 struct table_props *tabling; /* Extended properties for tabling */ 1488 #ifdef O_PROF_PENTIUM 1489 int prof_index; /* index in profiling */ 1490 char *prof_name; /* name in profiling */ 1491 #endif 1492 }; 1493 1494 struct definition_chain 1495 { Definition definition; /* chain on definition */ 1496 DefinitionChain next; /* next in chain */ 1497 }; 1498 1499 #define PROC_DIRTY_GENS 10 1500 1501 struct dirty_def_info 1502 { unsigned short count; /* # captured generations */ 1503 unsigned short flags; /* DDI_* */ 1504 Definition predicate; /* The dirty predicate */ 1505 gen_t access[PROC_DIRTY_GENS];/* Accessed generations */ 1506 }; 1507 1508 typedef struct definition_ref 1509 { Definition predicate; /* Referenced definition */ 1510 gen_t generation; /* at generation */ 1511 } definition_ref; 1512 1513 typedef struct definition_refs 1514 { definition_ref *blocks[MAX_BLOCKS]; 1515 definition_ref preallocated[7]; 1516 size_t top; 1517 } definition_refs; 1518 1519 #define PROC_WEAK (0x0001) /* implicit import */ 1520 #define PROC_MULTISOURCE (0x0002) /* Assigned to multiple sources */ 1521 #define PROC_IMPORTED (0x0004) /* Procedure is imported */ 1522 1523 struct procedure 1524 { Definition definition; /* definition of procedure */ 1525 unsigned int flags; /* PROC_WEAK */ 1526 unsigned int source_no; /* Source I'm assigned to */ 1527 }; 1528 1529 struct localFrame 1530 { Code programPointer; /* pointer into program */ 1531 LocalFrame parent; /* parent local frame */ 1532 ClauseRef clause; /* Current clause of frame */ 1533 Definition predicate; /* Predicate we are running */ 1534 Module context; /* context module of frame */ 1535 #ifdef O_PROFILE 1536 struct call_node *prof_node; /* Profiling node */ 1537 #endif 1538 #ifdef O_LOGICAL_UPDATE 1539 lgen_t generation; /* generation of the database */ 1540 #endif 1541 unsigned int level; /* recursion level */ 1542 unsigned int flags; /* packed long holding: */ 1543 }; 1544 1545 1546 typedef enum 1547 { CHP_JUMP = 0, /* A jump due to ; */ 1548 CHP_CLAUSE, /* Next clause of predicate */ 1549 CHP_TOP, /* First (toplevel) choice */ 1550 CHP_CATCH, /* $catch initiated choice */ 1551 CHP_DEBUG /* Enable redo */ 1552 } choice_type; 1553 1554 typedef enum 1555 { DBG_OFF = 0, /* no debugging */ 1556 DBG_ON, /* switch on in current environment */ 1557 DBG_ALL /* switch on globally */ 1558 } debug_type; 1559 1560 #define SKIP_VERY_DEEP ((size_t)-1) /* deep skiplevel */ 1561 #define SKIP_REDO_IN_SKIP (SKIP_VERY_DEEP-1) 1562 1563 struct clause_choice 1564 { ClauseRef cref; /* Next clause reference */ 1565 word key; /* Search key */ 1566 }; 1567 1568 #ifdef O_PLMT 1569 #define acquire_def(def) \ 1570 do { DEBUG(CHK_SECURE, assert(!LD->thread.info->access.predicate)); \ 1571 LD->thread.info->access.predicate = def; } while(0) 1572 #define release_def(def) \ 1573 do { LD->thread.info->access.predicate = NULL; } while(0) 1574 #define acquire_def2(def, store) \ 1575 do { store = LD->thread.info->access.predicate; \ 1576 DEBUG(CHK_SECURE, assert(!store || store == def)); \ 1577 LD->thread.info->access.predicate = def; } while(0) 1578 #define release_def2(def, store) \ 1579 do { LD->thread.info->access.predicate = store; } while(0) 1580 1581 #else 1582 #define acquire_def(def) (void)0 1583 #define release_def(def) (void)0 1584 #define acquire_def2(def,store) (void)store 1585 #define release_def2(def,store) (void)store 1586 #endif 1587 1588 struct choice 1589 { choice_type type; /* CHP_* */ 1590 Choice parent; /* Alternative if I fail */ 1591 mark mark; /* data mark for undo */ 1592 LocalFrame frame; /* Frame I am related to */ 1593 #ifdef O_PROFILE 1594 struct call_node *prof_node; /* Profiling node */ 1595 #endif 1596 union 1597 { struct clause_choice clause; /* Next candidate clause */ 1598 Code PC; /* Next candidate program counter */ 1599 word foreign; /* foreign redo handle */ 1600 } value; 1601 }; 1602 1603 1604 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1605 EXCEPTION_GUARDED(code, cleanup) must be used in environments that need 1606 cleanup should a PL_throw() happen. The most commpn reason for 1607 PL_throw() instead of the nicely synchronous PL_raise_exception() is a 1608 stack overflow. 1609 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1610 1611 #define EXCEPTION_GUARDED(code, cleanup) \ 1612 { exception_frame __throw_env; \ 1613 __throw_env.parent = LD->exception.throw_environment; \ 1614 if ( setjmp(__throw_env.exception_jmp_env) != 0 ) \ 1615 { LD->exception.throw_environment = __throw_env.parent; \ 1616 cleanup; \ 1617 } else \ 1618 { __throw_env.magic = THROW_MAGIC; \ 1619 LD->exception.throw_environment = &__throw_env; \ 1620 code; \ 1621 assert(LD->exception.throw_environment == &__throw_env); \ 1622 __throw_env.magic = 41414141; \ 1623 LD->exception.throw_environment = __throw_env.parent; \ 1624 } \ 1625 } 1626 1627 #define THROW_MAGIC 42424242 1628 1629 typedef struct exception_frame /* PL_throw exception environments */ 1630 { struct exception_frame *parent; /* parent frame */ 1631 int magic; /* THROW_MAGIC */ 1632 jmp_buf exception_jmp_env; /* longjmp environment */ 1633 } exception_frame; 1634 1635 1636 #define QF_NODEBUG 0x0001 /* debug-able query */ 1637 #define QF_DETERMINISTIC 0x0002 /* deterministic success */ 1638 #define QF_INTERACTIVE 0x0004 /* interactive goal (prolog()) */ 1639 1640 struct queryFrame 1641 { uintptr_t magic; /* Magic code for security */ 1642 struct /* Interpreter registers */ 1643 { LocalFrame fr; 1644 Word argp; 1645 Code pc; 1646 } registers; 1647 LocalFrame next_environment; /* See D_BREAK and get_vmi_state() */ 1648 #ifdef O_LIMIT_DEPTH 1649 uintptr_t saved_depth_limit; /* saved values of these */ 1650 uintptr_t saved_depth_reached; 1651 #endif 1652 #if O_CATCHTHROW 1653 term_t exception; /* Exception term */ 1654 #endif 1655 struct 1656 { term_t term; /* Handle to exchange data */ 1657 } yield; 1658 fid_t foreign_frame; /* Frame after PL_next_solution() */ 1659 unsigned int flags; 1660 debug_type debugSave; /* saved debugstatus.debugging */ 1661 unsigned int flags_saved; /* Saved boolean Prolog flags */ 1662 int solutions; /* # of solutions produced */ 1663 Word *aSave; /* saved argument-stack */ 1664 Choice saved_bfr; /* Saved choice-point */ 1665 LocalFrame saved_ltop; /* Saved lTop */ 1666 QueryFrame parent; /* Parent queryFrame */ 1667 struct choice choice; /* First (dummy) choice-point */ 1668 LocalFrame saved_environment; /* Parent local-frame */ 1669 /* Do not put anything between */ 1670 /* or check parentFrame() */ 1671 struct localFrame top_frame; /* The (dummy) top local frame */ 1672 struct localFrame frame; /* The initial frame */ 1673 }; 1674 1675 1676 #define FLI_MAGIC 82649821 1677 #define FLI_MAGIC_CLOSED 42424242 1678 1679 struct fliFrame 1680 { int magic; /* Magic code */ 1681 int size; /* # slots on it */ 1682 FliFrame parent; /* parent FLI frame */ 1683 mark mark; /* data-stack mark */ 1684 }; 1685 1686 #ifdef O_MAINTENANCE 1687 #define REC_MAGIC 27473244 1688 #endif 1689 1690 struct record 1691 { int size; /* # bytes of the record */ 1692 unsigned gsize; /* Size on global stack */ 1693 unsigned nvars; /* # variables in the term */ 1694 unsigned flags; /* Flags, holding */ 1695 /* R_ERASED */ 1696 /* R_EXTERNAL */ 1697 /* R_DUPLICATE */ 1698 /* R_NOLOCK */ 1699 /* R_DBREF */ 1700 #ifdef REC_MAGIC 1701 int magic; /* REC_MAGIC */ 1702 #endif 1703 int references; /* PL_duplicate_record() support */ 1704 char buffer[1]; /* array holding codes */ 1705 }; 1706 1707 struct recordList 1708 { RecordRef firstRecord; /* first record associated with key */ 1709 RecordRef lastRecord; /* last record associated with key */ 1710 struct recordList *next; /* Next recordList */ 1711 word key; /* key of record */ 1712 unsigned int flags; /* RL_DIRTY */ 1713 int references; /* choicepoints reference count */ 1714 }; 1715 1716 struct recordRef 1717 { RecordList list; /* list I belong to */ 1718 RecordRef next; /* next in list */ 1719 RecordRef prev; /* previous in list */ 1720 Record record; /* the record itself */ 1721 }; 1722 1723 1724 /******************************* 1725 * EXCEPTION CLASSES * 1726 *******************************/ 1727 1728 typedef enum except_class 1729 { EXCEPT_NONE = 0, /* no exception */ 1730 EXCEPT_OTHER, /* any other exception */ 1731 EXCEPT_ERROR, /* ISO error(Formal,Context) */ 1732 EXCEPT_RESOURCE, /* ISO error(resource_error(_), _) */ 1733 EXCEPT_TIMEOUT, /* time_limit_exceeded */ 1734 EXCEPT_ABORT /* '$aborted' */ 1735 } except_class; 1736 1737 1738 /******************************* 1739 * SOURCE FILE ADMIN * 1740 *******************************/ 1741 1742 #define SF_MAGIC 0x14a3c90f 1743 #define SF_MAGIC_DESTROYING 0x14a3c910 1744 1745 typedef struct p_reload 1746 { Definition predicate; /* definition we are working on */ 1747 gen_t generation; /* generation we update */ 1748 ClauseRef current_clause; /* currently reloading clause */ 1749 arg_info *args; /* Meta info on arguments */ 1750 unsigned flags; /* new flags (P_DYNAMIC, etc.) */ 1751 unsigned number_of_clauses; /* Number of clauses we've seen */ 1752 } p_reload; 1753 1754 typedef struct m_reload 1755 { Module module; 1756 Table public; /* new export list */ 1757 } m_reload; 1758 1759 typedef struct sf_reload 1760 { Table procedures; /* Procedures being reloaded */ 1761 gen_t reload_gen; /* Magic gen for reloading */ 1762 size_t pred_access_count; /* Top of predicate access stack */ 1763 Table modules; /* Modules seen during reload */ 1764 unsigned number_of_clauses; /* reload clause count */ 1765 } sf_reload; 1766 1767 1768 struct sourceFile 1769 { atom_t name; /* name of source file */ 1770 double mtime; /* modification time when loaded */ 1771 ListCell procedures; /* List of associated procedures */ 1772 Procedure current_procedure; /* currently loading one */ 1773 ListCell modules; /* Modules associated to this file */ 1774 sf_reload *reload; /* Reloading context */ 1775 #ifdef O_PLMT 1776 counting_mutex *mutex; /* Mutex to guard procedures */ 1777 #endif 1778 int magic; /* Magic number */ 1779 int count; /* number of times loaded */ 1780 unsigned int number_of_clauses; /* number of clauses */ 1781 unsigned int index; /* index number (1,2,...) */ 1782 unsigned int references; /* Reference count */ 1783 unsigned system : 1; /* system sourcefile: do not reload */ 1784 unsigned from_state : 1; /* Loaded from resource DB state */ 1785 unsigned resource : 1; /* Loaded from resource DB file */ 1786 }; 1787 1788 typedef struct srcfile_array 1789 { SourceFile *blocks[8*sizeof(void*)]; 1790 } srcfile_array; 1791 1792 struct list_cell 1793 { void * value; /* object in the cell */ 1794 ListCell next; /* next in chain */ 1795 }; 1796 1797 1798 /******************************* 1799 * MODULES * 1800 *******************************/ 1801 1802 struct module 1803 { atom_t name; /* name of module */ 1804 atom_t class; /* class of the module */ 1805 SourceFile file; /* file from which module is loaded */ 1806 Table procedures; /* predicates associated with module */ 1807 Table public; /* public predicates associated */ 1808 Table operators; /* local operator declarations */ 1809 ListCell supers; /* Import predicates from here */ 1810 ListCell lingering; /* Lingering definitions */ 1811 size_t code_size; /* #Bytes used for its procedures */ 1812 size_t code_limit; /* Limit for code_size */ 1813 #ifdef O_PLMT 1814 counting_mutex *mutex; /* Mutex to guard module modifications */ 1815 #endif 1816 #ifdef O_PROLOG_HOOK 1817 Procedure hook; /* Hooked module */ 1818 #endif 1819 int level; /* Distance to root (root=0) */ 1820 unsigned int line_no; /* Source line-number */ 1821 unsigned int flags; /* booleans: */ 1822 int references; /* see acquireModule() */ 1823 gen_t last_modified; /* Generation I was last modified */ 1824 }; 1825 1826 #define MENUM_TEMP 0x1 /* Also enumerate temporary modules */ 1827 1828 typedef struct module_enum 1829 { TableEnum tenum; 1830 Module current; 1831 int flags; 1832 } module_enum, *ModuleEnum; 1833 1834 1835 /******************************* 1836 * TRAIL * 1837 *******************************/ 1838 1839 struct trail_entry 1840 { Word address; /* address of the variable */ 1841 }; 1842 1843 struct gc_trail_entry 1844 { word address; /* address of the variable */ 1845 }; 1846 1847 /******************************* 1848 * META PREDICATE * 1849 *******************************/ 1850 1851 /*0..9*/ /* 0..9: `Extra meta arguments' */ 1852 #define MA_META 10 /* : */ 1853 #define MA_VAR 11 /* - */ 1854 #define MA_ANY 12 /* ? */ 1855 #define MA_NONVAR 13 /* + */ 1856 #define MA_HAT 14 /* ^ */ 1857 #define MA_DCG 15 /* // */ 1858 1859 #define MA_NEEDS_TRANSPARENT(m) \ 1860 ((m) < 10 || (m) == MA_META || (m) == MA_HAT || (m) == MA_DCG) 1861 1862 /******************************* 1863 * MARK/UNDO * 1864 *******************************/ 1865 1866 #define setVar(w) ((w) = (word) 0) 1867 1868 #ifdef O_DESTRUCTIVE_ASSIGNMENT 1869 1870 #define Undo(b) do_undo(&b) 1871 1872 #else /*O_DESTRUCTIVE_ASSIGNMENT*/ 1873 1874 #define Undo(b) do { TrailEntry tt = tTop; \ 1875 TrailEntry mt = (b).trailtop; \ 1876 while(tt > mt) \ 1877 { tt--; \ 1878 setVar(*tt->address); \ 1879 } \ 1880 tTop = tt; \ 1881 gTop = (LD->frozen_bar > (b).globaltop ? \ 1882 LD->frozen_bar : (b).globaltop); \ 1883 } while(0) 1884 #endif /*O_DESTRUCTIVE_ASSIGNMENT*/ 1885 1886 #define NO_MARK_BAR (Word)(~(uintptr_t)0) 1887 1888 #define Mark(b) do { (b).trailtop = tTop; \ 1889 (b).saved_bar = LD->mark_bar; \ 1890 DEBUG(CHK_SECURE, \ 1891 assert((b).saved_bar == NO_MARK_BAR || \ 1892 ((b).saved_bar >= gBase && \ 1893 (b).saved_bar <= gTop))); \ 1894 (b).globaltop = gTop; \ 1895 if ( LD->mark_bar != NO_MARK_BAR ) \ 1896 LD->mark_bar = (b).globaltop; \ 1897 } while(0) 1898 #define DiscardMark(b) do { LD->mark_bar = (LD->frozen_bar > (b).saved_bar ? \ 1899 LD->frozen_bar : (b).saved_bar); \ 1900 DEBUG(CHK_SECURE, \ 1901 assert(LD->mark_bar == NO_MARK_BAR || \ 1902 (LD->mark_bar >= gBase && \ 1903 LD->mark_bar <= gTop))); \ 1904 } while(0) 1905 #define NOT_A_MARK (TrailEntry)(~(word)0) 1906 #define NoMark(b) do { (b).trailtop = NOT_A_MARK; \ 1907 } while(0) 1908 #define isRealMark(b) ((b).trailtop != NOT_A_MARK) 1909 1910 1911 /******************************* 1912 * TRAILING * 1913 *******************************/ 1914 1915 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1916 Note that all trail operations demand that the caller ensures there is 1917 at least one free cell on the trail-stack. 1918 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1919 1920 #define Trail(p, w) Trail__LD(p, w PASS_LD) 1921 /* trail local stack pointer */ 1922 #define LTrail(p) \ 1923 (void)((tTop++)->address = p) 1924 /* trail global stack pointer */ 1925 #define GTrail(p) \ 1926 do { if ( p < LD->mark_bar ) \ 1927 (tTop++)->address = p; \ 1928 } while(0) 1929 1930 1931 /******************************* 1932 * SUPERVISORS * 1933 *******************************/ 1934 1935 #define SUPERVISOR(name) (&PL_code_data.supervisors.name[1]) 1936 1937 1938 1939 /******************************* 1940 * FLI INTERNALS * 1941 *******************************/ 1942 1943 #define consTermRef(p) ((Word)(p) - (Word)(lBase)) 1944 #define valTermRef(r) (&((Word)(lBase))[r]) 1945 1946 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1947 Temporary store/restore pointers to make them safe over GC/shift 1948 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1949 1950 #define TMP_PTR_SIZE (4) 1951 #define PushPtr(p) do { int i = LD->tmp.top++; \ 1952 assert(i<TMP_PTR_SIZE); \ 1953 *valTermRef(LD->tmp.h[i]) = makeRef(p); \ 1954 } while(0) 1955 #define PopPtr(p) do { int i = --LD->tmp.top; \ 1956 p = unRef(*valTermRef(LD->tmp.h[i])); \ 1957 setVar(*valTermRef(LD->tmp.h[i])); \ 1958 } while(0) 1959 #define PushVal(w) do { int i = LD->tmp.top++; \ 1960 assert(i<TMP_PTR_SIZE); \ 1961 *valTermRef(LD->tmp.h[i]) = w; \ 1962 } while(0) 1963 #define PopVal(w) do { int i = --LD->tmp.top; \ 1964 w = *valTermRef(LD->tmp.h[i]); \ 1965 setVar(*valTermRef(LD->tmp.h[i])); \ 1966 } while(0) 1967 1968 1969 #define QueryFromQid(qid) ((QueryFrame) valTermRef(qid)) 1970 #define QidFromQuery(f) (consTermRef(f)) 1971 #define QID_EXPORT_WAM_TABLE (qid_t)(-1) 1972 1973 #include "SWI-Prolog.h" 1974 1975 1976 /******************************* 1977 * SIGNALS * 1978 *******************************/ 1979 1980 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1981 SWI-Prolog may be compiled without signal handling. Even in that case we 1982 still have signals that trigger Prolog housekeeping events. These are 1983 not bound to operating system signal handling though. 1984 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 1985 1986 #if HAVE_SIGNAL 1987 #define MAXSIGNAL 64 /* highest system signal number */ 1988 #define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */ 1989 1990 #else /* HAVE_SIGNAL */ 1991 1992 #define MAXSIGNAL 32 /* highest system signal number */ 1993 #define SIG_PROLOG_OFFSET 1 /* Start of Prolog signals */ 1994 1995 #endif /* HAVE_SIGNAL */ 1996 1997 #ifndef RETSIGTYPE 1998 #define RETSIGTYPE void 1999 #endif 2000 typedef RETSIGTYPE (*handler_t)(int); 2001 2002 typedef struct 2003 { handler_t saved_handler; /* Original handler */ 2004 handler_t handler; /* User signal handler */ 2005 predicate_t predicate; /* Prolog handler */ 2006 int flags; /* PLSIG_*, defined in pl-setup.c */ 2007 } sig_handler, *SigHandler; 2008 2009 2010 #ifdef O_ATOMGC 2011 #define SIG_ATOM_GC (SIG_PROLOG_OFFSET+0) 2012 #endif 2013 #define SIG_GC (SIG_PROLOG_OFFSET+1) 2014 #ifdef O_PLMT 2015 #define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET+2) 2016 #endif 2017 #define SIG_CLAUSE_GC (SIG_PROLOG_OFFSET+3) 2018 #define SIG_PLABORT (SIG_PROLOG_OFFSET+4) 2019 #define SIG_TUNE_GC (SIG_PROLOG_OFFSET+5) 2020 2021 2022 /******************************* 2023 * COMPARE * 2024 *******************************/ 2025 2026 /* Results from comparison operations. Mostly used by compareStandard() */ 2027 2028 #define CMP_COMPOUND -3 /* compare_primitive */ 2029 #define CMP_ERROR -2 /* Error (out of memory) */ 2030 #define CMP_LESS -1 /* < */ 2031 #define CMP_EQUAL 0 /* == */ 2032 #define CMP_GREATER 1 /* > */ 2033 #define CMP_NOTEQ 2 /* \== */ 2034 2035 /******************************** 2036 * STACKS * 2037 *********************************/ 2038 2039 #ifdef small /* defined by MSVC++ 2.0 windows.h */ 2040 #undef small 2041 #endif 2042 2043 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2044 If we have access to the virtual memory management of the machine, use 2045 this to enlarge the runtime stacks. Otherwise use the stack-shifter. 2046 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2047 2048 #define GC_FAST_POLICY 0x1 /* not really used yet */ 2049 2050 #define STACK(type) \ 2051 { type base; /* base address of the stack */ \ 2052 type top; /* current top of the stack */ \ 2053 type max; /* allocated maximum */ \ 2054 size_t gced_size; /* size after last GC */ \ 2055 size_t small; /* Do not GC below this size */ \ 2056 size_t spare; /* Current reserved area */ \ 2057 size_t def_spare; /* Desired reserved area */ \ 2058 size_t min_free; /* Free left when trimming */ \ 2059 bool gc; /* Can be GC'ed? */ \ 2060 int factor; /* How eager we are */ \ 2061 int policy; /* Time, memory optimization */ \ 2062 int overflow_id; /* OVERFLOW_* */ \ 2063 const char *name; /* Symbolic name of the stack */ \ 2064 } 2065 2066 struct stack STACK(caddress); /* Anonymous stack */ 2067 2068 typedef struct 2069 { size_t limit; /* Total stack limit */ 2070 struct STACK(LocalFrame) local; /* local (environment) stack */ 2071 struct STACK(Word) global; /* local (environment) stack */ 2072 struct STACK(TrailEntry) trail; /* trail stack */ 2073 struct STACK(Word *) argument; /* argument stack */ 2074 } pl_stacks_t; 2075 2076 #define tBase (LD->stacks.trail.base) 2077 #define tTop (LD->stacks.trail.top) 2078 #define tMax (LD->stacks.trail.max) 2079 2080 #define lBase (LD->stacks.local.base) 2081 #define lTop (LD->stacks.local.top) 2082 #define lMax (LD->stacks.local.max) 2083 2084 #define gBase (LD->stacks.global.base) 2085 #define gTop (LD->stacks.global.top) 2086 #define gMax (LD->stacks.global.max) 2087 2088 #define aBase (LD->stacks.argument.base) 2089 #define aTop (LD->stacks.argument.top) 2090 #define aMax (LD->stacks.argument.max) 2091 2092 #define tSpare (LD->stacks.trail.spare) 2093 2094 #define onStack(name, addr) \ 2095 ((char *)(addr) >= (char *)LD->stacks.name.base && \ 2096 (char *)(addr) < (char *)LD->stacks.name.top) 2097 #define onStackArea(name, addr) \ 2098 ((char *)(addr) >= (char *)LD->stacks.name.base && \ 2099 (char *)(addr) < (char *)LD->stacks.name.max) 2100 #define onTrailArea(addr) \ 2101 ((char *)(addr) >= (char *)tBase && \ 2102 (char *)(addr) < (char *)tMax + tSpare) 2103 #define onGlobalArea(addr) \ 2104 ((char *)(addr) >= (char *)gBase && \ 2105 (char *)(addr) < (char *)lBase) 2106 #define usedStackP(s) ((intptr_t)((char *)(s)->top - (char *)(s)->base)) 2107 #define sizeStackP(s) ((intptr_t)((char *)(s)->max - (char *)(s)->base)) 2108 #define roomStackP(s) ((intptr_t)((char *)(s)->max - (char *)(s)->top)) 2109 #define spaceStackP(s) (limitStackP(s)-usedStackP(s)) 2110 #define narrowStackP(s) (roomStackP(s) < (intptr_t)(s)->minfree) 2111 2112 #define usedStack(name) usedStackP(&LD->stacks.name) 2113 #define sizeStack(name) sizeStackP(&LD->stacks.name) 2114 #define roomStack(name) roomStackP(&LD->stacks.name) 2115 #define spaceStack(name) spaceStackP(&LD->stacks.name) 2116 #define narrowStack(name) narrowStackP(&LD->stacks.name) 2117 2118 #define globalStackLimit() (LD->stacks.limit > (MAXTAGGEDPTR+1) ? \ 2119 (MAXTAGGEDPTR+1) : \ 2120 LD->stacks.limit) 2121 2122 #define GROW_TRIM ((size_t)-1) 2123 #define GROW_TIGHT ((size_t)1) 2124 2125 #define LOCAL_OVERFLOW (-1) 2126 #define GLOBAL_OVERFLOW (-2) 2127 #define TRAIL_OVERFLOW (-3) 2128 #define ARGUMENT_OVERFLOW (-4) 2129 #define STACK_OVERFLOW (-5) /* total stack limit overflow */ 2130 #define MEMORY_OVERFLOW (-6) /* out of malloc()-heap */ 2131 2132 #define ALLOW_NOTHING 0x0 2133 #define ALLOW_GC 0x1 /* allow GC on stack overflow */ 2134 #define ALLOW_SHIFT 0x2 /* allow shift on stack overflow */ 2135 #define ALLOW_CHECKED 0x4 /* we already verified space */ 2136 #define ALLOW_RETCODE 0x8 /* do not allow anything; return status */ 2137 2138 typedef enum 2139 { STACK_OVERFLOW_RAISE, 2140 STACK_OVERFLOW_THROW 2141 } stack_overflow_action; 2142 2143 #define pushArgumentStack(p) \ 2144 do { if ( likely(aTop+1 < aMax) ) \ 2145 *aTop++ = (p); \ 2146 else \ 2147 pushArgumentStack__LD((p) PASS_LD); \ 2148 } while(0) 2149 2150 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2151 hasGlobalSpace(n) is true if we have enough space to create an object of 2152 size N on the global stack AND can use bindConst() to bind it to an 2153 (attributed) variable. 2154 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2155 2156 #define BIND_GLOBAL_SPACE (7) 2157 #define BIND_TRAIL_SPACE (6) 2158 #define hasGlobalSpace(n) \ 2159 hasStackSpace(n,0) 2160 #define hasStackSpace(g, t) \ 2161 (likely(gTop+(g)+BIND_GLOBAL_SPACE <= gMax) && \ 2162 likely(tTop+(t)+BIND_TRAIL_SPACE <= tMax)) 2163 #define overflowCode(n) \ 2164 ( (gTop+(n)+BIND_GLOBAL_SPACE > gMax) ? GLOBAL_OVERFLOW \ 2165 : TRAIL_OVERFLOW ) 2166 #define GLOBAL_TRAIL_RATIO (6) 2167 2168 2169 /******************************* 2170 * NUMBERVARS * 2171 *******************************/ 2172 2173 typedef enum 2174 { AV_BIND, 2175 AV_SKIP, 2176 AV_ERROR 2177 } av_action; 2178 2179 #define NV_ERROR (PLMINTAGGEDINT-1) 2180 2181 typedef struct 2182 { functor_t functor; /* Functor to use ($VAR/1) */ 2183 intptr_t offset; /* offset */ 2184 av_action on_attvar; /* How to handle attvars */ 2185 int singletons; /* Write singletons as $VAR('_') */ 2186 int numbered_check; /* Check for already numbered */ 2187 } nv_options; 2188 2189 #define BEGIN_NUMBERVARS(save) \ 2190 { fid_t _savedf; \ 2191 if ( save ) \ 2192 { _savedf = LD->var_names.numbervars_frame; \ 2193 LD->var_names.numbervars_frame = PL_open_foreign_frame(); \ 2194 } 2195 #define END_NUMBERVARS(save) \ 2196 if ( save ) \ 2197 { PL_discard_foreign_frame(LD->var_names.numbervars_frame); \ 2198 LD->var_names.numbervars_frame = _savedf; \ 2199 } \ 2200 } 2201 2202 2203 /******************************* 2204 * WAKEUP * 2205 *******************************/ 2206 2207 #define WAKEUP_STATE_WAKEUP 0x1 /* State contains a wakeup */ 2208 #define WAKEUP_STATE_EXCEPTION 0x2 /* State contains an exception */ 2209 #define WAKEUP_STATE_SKIP_EXCEPTION 0x4 /* Do not restore exception from state */ 2210 #define WAKEUP_KEEP_URGENT_EXCEPTION 0x8 /* Keep the most urgent exception */ 2211 2212 typedef struct wakeup_state 2213 { fid_t fid; /* foreign frame reference */ 2214 Stack outofstack; /* Stack we are out of */ 2215 int flags; /* WAKEUP_STATE_* */ 2216 } wakeup_state; 2217 2218 2219 2220 2221 /******************************* 2222 * STREAM I/O * 2223 *******************************/ 2224 2225 #define REDIR_MAGIC 0x23a9bef3 2226 2227 typedef struct redir_context 2228 { int magic; /* REDIR_MAGIC */ 2229 IOSTREAM *stream; /* temporary output */ 2230 int is_stream; /* redirect to stream */ 2231 int redirected; /* output is redirected */ 2232 term_t term; /* redirect target */ 2233 int out_format; /* output type */ 2234 int out_arity; /* 2 for difference-list versions */ 2235 size_t size; /* size of I/O buffer */ 2236 char *data; /* data written */ 2237 char buffer[1024]; /* fast temporary buffer */ 2238 } redir_context; 2239 2240 2241 /******************************** 2242 * READ WARNINGS * 2243 *********************************/ 2244 2245 #define ReadingSource (source_line_no >= 0 && \ 2246 source_file_name != NULL_ATOM) 2247 2248 2249 /******************************** 2250 * FAST DISPATCHING * 2251 ********************************/ 2252 2253 #if VMCODE_IS_ADDRESS 2254 #define encode(wam) (wam_table[wam]) /* WAM --> internal */ 2255 /* internal --> WAM */ 2256 #define decode(c) ((code) (dewam_table[(uintptr_t)(c) - \ 2257 dewam_table_offset])) 2258 #else /* VMCODE_IS_ADDRESS */ 2259 #define encode(wam) (wam) 2260 #define decode(wam) (wam) 2261 #endif /* VMCODE_IS_ADDRESS */ 2262 2263 /******************************** 2264 * STATUS * 2265 *********************************/ 2266 2267 typedef struct 2268 { int blocked; /* GC is blocked now */ 2269 bool active; /* Currently running? */ 2270 } pl_gc_status_t; 2271 2272 2273 typedef struct 2274 { int blocked; /* No shifts allowed */ 2275 double time; /* time spent in stack shifts */ 2276 int local_shifts; /* Shifts of the local stack */ 2277 int global_shifts; /* Shifts of the global stack */ 2278 int trail_shifts; /* Shifts of the trail stack */ 2279 } pl_shift_status_t; 2280 2281 2282 /******************************** 2283 * MODULES * 2284 *********************************/ 2285 2286 #define MODULE_user (GD->modules.user) 2287 #define MODULE_system (GD->modules.system) 2288 #define MODULE_parse (ReadingSource ? LD->modules.source \ 2289 : LD->modules.typein) 2290 2291 2292 /******************************** 2293 * PREDICATES * 2294 *********************************/ 2295 2296 #define PROCEDURE_catch3 (GD->procedures.catch3) 2297 #define PROCEDURE_reset3 (GD->procedures.reset3) 2298 #define PROCEDURE_true0 (GD->procedures.true0) 2299 #define PROCEDURE_fail0 (GD->procedures.fail0) 2300 #define PROCEDURE_print_message2 (GD->procedures.print_message2) 2301 #define PROCEDURE_dcall1 (GD->procedures.dcall1) 2302 #define PROCEDURE_setup_call_catcher_cleanup4 \ 2303 (GD->procedures.setup_call_catcher_cleanup4) 2304 #define PROCEDURE_dwakeup1 (GD->procedures.dwakeup1) 2305 #define PROCEDURE_dthread_init0 (GD->procedures.dthread_init0) 2306 #define PROCEDURE_exception_hook4 (GD->procedures.exception_hook4) 2307 #define PROCEDURE_dc_call_prolog (GD->procedures.dc_call_prolog0) 2308 #define PROCEDURE_dinit_goal (GD->procedures.dinit_goal3) 2309 #define PROCEDURE_tune_gc3 (GD->procedures.tune_gc3) 2310 2311 extern const code_info codeTable[]; /* Instruction info (read-only) */ 2312 2313 /******************************* 2314 * TEXT PROCESSING * 2315 *******************************/ 2316 2317 typedef enum 2318 { CVT_ok = 0, /* Conversion ok */ 2319 CVT_wide, /* Conversion needs wide characters */ 2320 CVT_partial, /* Input list is partial */ 2321 CVT_nolist, /* Input list is not a list */ 2322 CVT_nocode, /* List contains a non-code */ 2323 CVT_nochar, /* List contains a non-char */ 2324 CVT_representation /* List contains non-reprentable code */ 2325 } CVT_status; 2326 2327 typedef struct 2328 { CVT_status status; 2329 word culprit; /* for CVT_nocode/CVT_nochar */ 2330 } CVT_result; 2331 2332 2333 /******************************** 2334 * DEBUGGER * 2335 *********************************/ 2336 2337 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2338 Tracer communication declarations. 2339 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2340 2341 #define ACTION_CONTINUE 0 2342 #define ACTION_RETRY 1 2343 #define ACTION_FAIL 2 2344 #define ACTION_IGNORE 3 2345 #define ACTION_AGAIN 4 2346 #define ACTION_ABORT 5 /* only for Prolog interception */ 2347 2348 #define CALL_PORT 0x001 /* port masks */ 2349 #define EXIT_PORT 0x002 2350 #define FAIL_PORT 0x004 2351 #define REDO_PORT 0x008 2352 #define UNIFY_PORT 0x010 2353 #define CUT_CALL_PORT 0x040 2354 #define CUT_EXIT_PORT 0x080 2355 #define EXCEPTION_PORT 0x100 2356 #define CUT_PORT (CUT_CALL_PORT|CUT_EXIT_PORT) 2357 #define PORT_MASK 0x1ff 2358 2359 /* keep in sync with style_name/1 in boot/prims.pl */ 2360 2361 #define SINGLETON_CHECK 0x0002 /* read/1: check singleton vars */ 2362 #define MULTITON_CHECK 0x0004 /* read/1: check multiton vars */ 2363 #define DISCONTIGUOUS_STYLE 0x0008 /* warn on discontiguous predicates */ 2364 /* reserved 0x0010 */ 2365 #define CHARSET_CHECK 0x0020 /* warn on unquoted characters */ 2366 #define SEMSINGLETON_CHECK 0x0040 /* Semantic singleton checking */ 2367 #define NOEFFECT_CHECK 0x0080 /* Check for meaningless statements */ 2368 #define VARBRANCH_CHECK 0x0100 /* warn on unbalanced variables */ 2369 2370 /* checkDataEx() flags */ 2371 2372 #define CHK_DATA_NOATTVAR_CHAIN 0x001 /* attvars might not be on chain */ 2373 2374 typedef struct debuginfo 2375 { size_t skiplevel; /* current skip level */ 2376 bool tracing; /* are we tracing? */ 2377 debug_type debugging; /* are we debugging? */ 2378 int leashing; /* ports we are leashing */ 2379 int visible; /* ports that are visible */ 2380 bool showContext; /* tracer shows context module */ 2381 int styleCheck; /* source style checking */ 2382 int suspendTrace; /* tracing is suspended now */ 2383 intptr_t retryFrame; /* Frame to retry (local stack offset) */ 2384 } pl_debugstatus_t; 2385 2386 #define FT_ATOM 0 /* atom feature */ 2387 #define FT_BOOL 1 /* boolean feature (true, false) */ 2388 #define FT_INTEGER 2 /* integer feature */ 2389 #define FT_FLOAT 3 /* float feature */ 2390 #define FT_TERM 4 /* term feature */ 2391 #define FT_INT64 5 /* passed as int64_t */ 2392 #define FT_FROM_VALUE 0x0f /* Determine type from value */ 2393 #define FT_MASK 0x0f /* mask to get type */ 2394 2395 #define PLFLAG_CHARESCAPE 0x00000001 /* handle \ in atoms */ 2396 #define PLFLAG_GC 0x00000002 /* do GC */ 2397 #define PLFLAG_TRACE_GC 0x00000004 /* verbose gc */ 2398 #define PLFLAG_GCTHREAD 0x00000008 /* Do atom/clause GC in a thread */ 2399 #define PLFLAG_TTY_CONTROL 0x00000010 /* allow for tty control */ 2400 #define PLFLAG_DEBUG_ON_ERROR 0x00000020 /* start tracer on error */ 2401 #define PLFLAG_REPORT_ERROR 0x00000040 /* print error message */ 2402 #define PLFLAG_FILE_CASE 0x00000080 /* file names are case sensitive */ 2403 #define PLFLAG_FILE_CASE_PRESERVING 0x00000100 /* case preserving file names */ 2404 #define PLFLAG_ERROR_AMBIGUOUS_STREAM_PAIR 0x00000200 2405 #define ALLOW_VARNAME_FUNCTOR 0x00000400 /* Read Foo(x) as 'Foo'(x) */ 2406 #define PLFLAG_ISO 0x00000800 /* Strict ISO compliance */ 2407 #define PLFLAG_OPTIMISE 0x00001000 /* -O: optimised compilation */ 2408 #define PLFLAG_FILEVARS 0x00002000 /* Expand $var and ~ in filename */ 2409 #define PLFLAG_AUTOLOAD 0x00004000 /* do autoloading */ 2410 #define PLFLAG_CHARCONVERSION 0x00008000 /* do character-conversion */ 2411 #define PLFLAG_LASTCALL 0x00010000 /* Last call optimization enabled? */ 2412 #define PLFLAG_PORTABLE_VMI 0x00020000 /* Generate portable VMI code */ 2413 #define PLFLAG_SIGNALS 0x00040000 /* Handle signals */ 2414 #define PLFLAG_DEBUGINFO 0x00080000 /* generate debug info */ 2415 #define PLFLAG_FILEERRORS 0x00100000 /* Edinburgh file errors */ 2416 #define PLFLAG_WARN_OVERRIDE_IMPLICIT_IMPORT 0x00200000 /* Warn overriding weak symbols */ 2417 #define PLFLAG_QUASI_QUOTES 0x00400000 /* Support quasi quotes */ 2418 #define PLFLAG_DOT_IN_ATOM 0x00800000 /* Allow atoms a.b.c */ 2419 #define PLFLAG_VARPREFIX 0x01000000 /* Variable must start with _ */ 2420 #define PLFLAG_PROTECT_STATIC_CODE 0x02000000 /* Deny clause/2 on static code */ 2421 #define PLFLAG_MITIGATE_SPECTRE 0x04000000 /* Mitigate spectre attacks */ 2422 #define PLFLAG_TABLE_INCREMENTAL 0x08000000 /* By default incremental tabling */ 2423 #define PLFLAG_TABLE_SHARED 0x10000000 /* By default shared tabling */ 2424 #define PLFLAG_RATIONAL 0x20000000 /* Natural rational numbers */ 2425 2426 typedef struct 2427 { unsigned int flags; /* Fast access to some boolean Prolog flags */ 2428 } pl_features_t; 2429 2430 #define truePrologFlag(flag) true(&LD->prolog_flag.mask, flag) 2431 #define setPrologFlagMask(flag) set(&LD->prolog_flag.mask, flag) 2432 #define clearPrologFlagMask(flag) clear(&LD->prolog_flag.mask, flag) 2433 2434 typedef enum 2435 { OCCURS_CHECK_FALSE = 0, /* allow rational trees */ 2436 OCCURS_CHECK_TRUE, /* fail if rational tree would result */ 2437 OCCURS_CHECK_ERROR /* exception if rational tree would result */ 2438 } occurs_check_t; 2439 2440 typedef enum 2441 { ACCESS_LEVEL_USER = 0, /* Default user view */ 2442 ACCESS_LEVEL_SYSTEM /* Allow low-level access */ 2443 } access_level_t; 2444 2445 #define SYSTEM_MODE (LD->prolog_flag.access_level == ACCESS_LEVEL_SYSTEM) 2446 2447 #ifdef O_LIMIT_DEPTH 2448 #define DEPTH_NO_LIMIT (~(uintptr_t)0x0) /* Highest value */ 2449 #endif 2450 2451 #ifdef O_INFERENCE_LIMIT 2452 #define INFERENCE_NO_LIMIT 0x7fffffffffffffffLL /* Highest value */ 2453 #endif 2454 2455 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2456 Administration of loaded intermediate code files (see pl-wic.c). Used 2457 with the -c option to include all these if necessary. 2458 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2459 2460 typedef struct state * State; 2461 2462 struct state 2463 { char * name; /* name of state */ 2464 State next; /* next state loaded */ 2465 }; 2466 2467 #define QLF_TOPLEVEL 0x1 /* toplevel wic file */ 2468 #define QLF_OPTIONS 0x2 /* only load options */ 2469 #define QLF_EXESTATE 0x4 /* probe qlf exe state */ 2470 2471 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2472 Sourcelocation information (should be used at more places). 2473 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2474 2475 typedef struct 2476 { atom_t file; /* name of the file */ 2477 int line; /* line number */ 2478 } sourceloc, *SourceLoc; 2479 2480 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2481 Include debugging info to make it (very) verbose. SECURE adds code to 2482 check consistency mainly in the WAM interpreter. Prolog gets VERY slow 2483 if SECURE is used. DEBUG is not too bad (about 20% performance 2484 decrease). 2485 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2486 2487 #define REL(a) ((Word)(a) - (Word)(lBase)) 2488 2489 #if defined(_DEBUG) && !defined(O_MAINTENANCE) 2490 #define O_MAINTENANCE 2491 #endif 2492 2493 #include "os/pl-os.h" /* OS dependencies */ 2494 2495 #ifdef SYSLIB_H 2496 #include SYSLIB_H 2497 #endif 2498 2499 #define NULL_ATOM ((atom_t)0) 2500 #define MK_ATOM(n) ((atom_t)((n)<<7|TAG_ATOM|STG_STATIC)) 2501 #include "pl-atom.ih" 2502 #include "pl-funct.ih" 2503 2504 #include "pl-alloc.h" /* Allocation primitives */ 2505 #include "pl-init.h" /* Declarations needed by pl-init.c */ 2506 #include "pl-error.h" /* Exception generation */ 2507 #include "pl-thread.h" /* thread manipulation */ 2508 #include "pl-data.h" /* Access Prolog data */ 2509 #include "pl-segstack.h" /* Segmented stacks */ 2510 #include "pl-gmp.h" /* GNU-GMP support */ 2511 #include "os/pl-locale.h" /* Locale objects */ 2512 #include "os/pl-file.h" /* Stream management */ 2513 #include "pl-global.h" /* global data */ 2514 #include "pl-funcs.h" /* global functions */ 2515 #include "pl-ldpass.h" /* Wrap __LD functions */ 2516 #include "pl-inline.h" /* Inline facilities */ 2517 #include "pl-privitf.h" /* private foreign interface */ 2518 #include "os/pl-text.h" /* text manipulation */ 2519 #include "pl-hash.h" /* Murmurhash function */ 2520 #include "os/pl-option.h" /* Option processing */ 2521 #include "os/pl-files.h" /* File management */ 2522 #include "os/pl-string.h" /* Basic string functions */ 2523 #include "pl-ressymbol.h" /* Meta atom handling */ 2524 2525 #ifdef __DECC /* Dec C-compiler: avoid conflicts */ 2526 #undef leave 2527 #undef except 2528 #undef try 2529 #endif 2530 2531 #endif /*_PL_INCLUDE_H*/ 2532