home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / src / pl-incl.h < prev    next >
C/C++ Source or Header  |  1993-02-23  |  48KB  |  1,305 lines
  1. /*  pl-incl.h,v 1.14 1993/02/23 13:16:34 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: SWI-Prolog general include file
  8. */
  9.  
  10. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  11. Include Machine Desciption (md-*) file.  If -DMD=md-sun.h  or  something
  12. similar  is  passed  as  cpp  flag,  this  machine  description is used.
  13. Otherwise "md.h" is used,  which  is  supposed  to  be  a  link  to  the
  14. appropriate machine description file.
  15. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  16.  
  17. #ifdef MD
  18. #include MD
  19. #else
  20. #include "md.h"
  21. #endif
  22.  
  23. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  24.               PROLOG SYSTEM OPTIONS
  25.  
  26. These are not really options normally.  They are there because I use  to
  27. add  new  features  conditional  using  #if ... #endif.  In many cases I
  28. leave them in for ducumentation purposes.   Notably  O_STRING  might  be
  29. handy for it someone wants to add a data type to the system.
  30.  
  31.   O_STRING
  32.       Include data type string.  This  feature  does  not  rely  on  any
  33.       system  feature.   It  hardly has any consequences for the system.
  34.       Because of its experimental nature it is optional.  The definition
  35.       of the predicates operating on strings might change.
  36.       (NOTE: Currently some of the boot files rely on strings. It is NOT
  37.       suggested to leave them out).
  38.   O_COMPILE_OR
  39.       Compile ->/2, ;/2 and |/2 into WAM.  This  no  longer  is  a  real
  40.       option.   the mechanism to handle cuts without compiling ;/2, etc.
  41.       has been taken out.
  42.   O_COMPILE_ARITH
  43.       Include arithmetic compiler (compiles is/2, >/2, etc. into WAM).
  44.   O_PROLOG_FUNCTIONS
  45.       Include evaluatable Prolog functions into the arithmetic module.
  46.   O_AUTOINDEX
  47.       Include code to guess the best predicate indexing pattern. This is
  48.       not yet very well worked out, neither will be in the near  future.
  49.       just left in for the case I want to return to this subject.
  50.   O_LABEL_ADDRESSES
  51.       Means we can pick up the address of a label in  a function using
  52.       the var  = `&&label' construct  and jump to  it using goto *var;
  53.       This construct is known by the GNU-C compiler gcc version 2.  It
  54.       is buggy in gcc-2.0, but seems to works properly in gcc-2.1.
  55.   O_VMCODE_IS_ADDRESS
  56.       Can only  be set when  O_LABEL_ADDRESSES is  set.  It causes the
  57.       prolog  compiler  to put the  code  (=  label-) addresses in the
  58.       compiled Prolog  code  rather than the  virtual-machine numbers.
  59.       This speeds-up  the vm  instruction dispatching in  interpret().
  60.       See also pl-comp.c
  61. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  62.  
  63. #define PL_KERNEL        1
  64. #define O_COMPILE_OR        1
  65. #define O_COMPILE_ARITH        1
  66. #define O_STRING        1
  67. #define O_AUTOINDEX        0
  68. #define O_PROLOG_FUNCTIONS    1
  69.  
  70. /*
  71.    OS/2 : The excellent EMX port of GCC puts the text segment at address
  72.    0x10000. Since this breaks the 16 bit encoding of VM code addresses, we
  73.    have to explicitly disable O_VMCODE_IS_ADDRESS
  74. */
  75.  
  76. #ifndef O_LABEL_ADDRESSES
  77. #if __GNUC__ == 2
  78. #define O_LABEL_ADDRESSES    1
  79. #ifndef O_VMCODE_IS_ADDRESS
  80. #define O_VMCODE_IS_ADDRESS    1
  81. #endif
  82. #endif
  83. #endif
  84.  
  85. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  86. The macros below try to establish a common basis for various  compilers,
  87. so  we  can  write  most  of the real code without having to worry about
  88. compiler limits and differences.
  89.  
  90. The  current  version  has  prototypes  defined   for   all   functions.
  91. Unfortunately  there  are  still a lot of old compilers around and it is
  92. hard to write and maintain code that runs on both old and new compilers.
  93. This has worked on TURBO_C not very long ago.
  94. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  95.  
  96. #if O_SHORT_SYMBOLS
  97. #include "pl-ssymb.h"        /* Redefine long symbols to avoid clashes */
  98.                 /* Probably out-of-date! */
  99. #endif
  100.  
  101. #include <stdio.h>
  102. #if unix || EMX
  103. #include <sys/types.h>
  104. #include <signal.h>
  105. #endif
  106.  
  107. #include <setjmp.h>
  108. #include <assert.h>
  109.  
  110. #if ANSI
  111. #define PROTO 1
  112. #if !mips
  113. #include <stdlib.h>
  114. #include <string.h>
  115. #include <stddef.h>
  116. #endif
  117. #include <stdarg.h>        /* variable arity handling */
  118. #endif
  119.  
  120. #if !ANSI || AIX        /* AIX stdarg still broken */
  121. #if mips
  122. #include "/usr/include/varargs.h"
  123. #else
  124. #include <varargs.h>
  125. #endif
  126. #endif
  127.  
  128. #if OS2 && EMX
  129. #include <process.h>
  130. #include <io.h>
  131. #include <strings.h>
  132. typedef unsigned short  ushort;
  133. #endif /* OS2 */
  134.  
  135. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  136. A common basis for C keywords.
  137. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  138.  
  139. #if !__GNUC__
  140. #define volatile        /* volatile functions do not return */
  141. #define inline            /* inline functions are integrated in */
  142.                 /* their caller */
  143. #define signed            /* some compilers don't have this. */
  144. #endif
  145.  
  146. #define forwards static        /* forwards function declarations */
  147. #ifndef P
  148. #if PROTO
  149. #define P(type) type
  150. #else
  151. #define P(type) ()
  152. #endif
  153. #endif
  154.  
  155. #ifndef GLOBAL            /* global variables */
  156. #define GLOBAL extern
  157. #endif
  158.  
  159. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  160. Booleans,  addresses,  strings  and other   goodies.   Note that  ANSI
  161. compilers have  `Void'.   This should  be  made part  of  the  general
  162. platform as well.
  163. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  164.  
  165. typedef int            bool;
  166. typedef double            real;
  167. #if O_NO_VOID_POINTER
  168. typedef char *            Void;
  169. #else
  170. typedef void *            Void;
  171. #endif
  172.  
  173. #if unix || EMX
  174. #ifdef SIGNAL_HANDLER_TYPE
  175. typedef SIGNAL_HANDLER_TYPE (*handler_t)();
  176. #else
  177. typedef void (*handler_t)();
  178. #endif
  179. #ifndef SIGNAL_CONTEXT_TYPE
  180. #define SIGNAL_CONTEXT_TYPE struct sigcontext *
  181. #endif
  182. #endif /* unix */
  183.  
  184. #ifndef TRUE
  185. #define TRUE            1
  186. #define FALSE            0
  187. #endif
  188. #define succeed            return TRUE
  189. #define fail            return FALSE
  190. #define TRY(goal)        { if ((goal) == FALSE) fail; }
  191.  
  192. #if !O_ULONG_PREDEFINED
  193. typedef unsigned long        ulong;
  194. #endif
  195. typedef char *            caddress;
  196.  
  197. #define EOS            ('\0')
  198. #define ESC            ((char) 27)
  199. #define streq(s, q)        ((strcmp((s), (q)) == 0))
  200.  
  201. #ifndef abs
  202. #define abs(x)            ((x) < 0 ? -(x) : (x))
  203. #endif
  204.                 /* n is 2^m !!! */
  205. #define ROUND(p, n)        ((((p) + (n) - 1) & ~((n) - 1)))
  206. #define addPointer(p, n)    ((char *)(p) + (long)(n))
  207.  
  208. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  209.                  LIMITS
  210.  
  211. Below are some arbitrary limits on object sizes.  Feel free  to  enlarge
  212. them,  but  be aware of the fact that this increases memory requirements
  213. and  slows  down  for  some  of  these  options.    Also,   MAXARITY   <
  214. MAXVARIABLES, MAXVARIABLES and MAXEXTERNALS must be lower that 64 K. One
  215. day,  I  should  try  to  get  rid  of these limits.  This requires some
  216. redesign of parts of the compiler.
  217. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  218.  
  219. #define LINESIZ            1024    /* size of a data line */
  220. #define MAXARITY        128    /* arity of predicate */
  221. #define MAXVARIABLES        256    /* number of variables/clause */
  222. #define MAXEXTERNALS        512    /* external references of a clause */
  223. #define MAXCODES        20000    /* number of byte codes of a clause */
  224. #define MAXSIGNAL        32    /* highest system signal number */
  225.  
  226.                 /* Prolog's largest int */
  227. #define PLMAXINT        ((1L<<(32 - MASK_BITS - LMASK_BITS - 1)) - 1)
  228.                 /* Prolog's smallest int */
  229. #define PLMININT        (-(1L<<(32 - MASK_BITS - LMASK_BITS - 1)))
  230. #if vax
  231. #define MAXREAL            (1.701411834604692293e+38)
  232. #else                    /* IEEE double */
  233. #define MAXREAL            (1.79769313486231470e+308)
  234. #endif
  235.  
  236. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  237. Macros to handle hash tables.  See pl-table.c for  details.   First  the
  238. sizes  of  the  hash  tables are defined.  Note that these should all be
  239. 2^N.
  240. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  241.  
  242. #define ATOMHASHSIZE        1024    /* global atom table */
  243. #define FUNCTORHASHSIZE        512    /* global functor table */
  244. #define PROCEDUREHASHSIZE    512    /* predicates in module user */
  245. #define MODULEPROCEDUREHASHSIZE 128    /* predicates in other modules */
  246. #define RECORDHASHSIZE        512    /* global recorda/recordz table */
  247. #define MODULEHASHSIZE        64    /* global module table */
  248. #define PUBLICHASHSIZE        32    /* Module export table */
  249. #define OPERATORHASHSIZE    256    /* global operator table */
  250. #define FLAGHASHSIZE        256    /* global flag/3 table */
  251. #define ARITHHASHSIZE        64    /* arithmetic function table */
  252.  
  253. #define pointerHashValue(p, size) ((int)(((long)(p)>>2) & ((size)-1)))
  254.  
  255. #define for_table(s, t) for(s = firstHTable(t); s; s = nextHTable(t, s))
  256. #define return_next_table(t, v) \
  257.     { for((v) = (v)->next; isRef((word)(v)) && (v); (v) = *((t *)unRef(v))) \
  258.       if ( (v) == (t)NULL ) \
  259.         succeed; \
  260.       ForeignRedo(v); \
  261.     }
  262.  
  263. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  264. Foreign language interface definitions.  Note that these macros MUST  be
  265. consistent  with  the  definitions  in  pl-itf.h, which is included with
  266. users foreign language code.
  267. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  268.  
  269. #if O_DATA_AT_0X4
  270. #define FRG_MASK    (0x20000000L)        /* Mask to indicate redo */
  271. #define FRG_BITS    3
  272. #else
  273. #define FRG_MASK    (0x40000000L)        /* Mask to indicate redo */
  274. #define FRG_BITS    2
  275. #endif
  276. #define FRG_CUT     (0x80000000L)        /* highest bit */
  277. #define FRG_MASK_MASK    (FRG_CUT|FRG_MASK)
  278.  
  279. #define FRG_FIRST_CALL    (0)
  280. #define FRG_CUTTED    (1)
  281. #define FRG_REDO    (2)
  282.  
  283. #define FIRST_CALL    (0L)
  284.  
  285. #define ForeignRedo(v)        return (word) (((long)(v) & ~FRG_MASK_MASK) \
  286.                           | FRG_MASK)
  287. #define ForeignControl(h)    ((h) == FIRST_CALL ? FRG_FIRST_CALL : \
  288.                  (h) & FRG_CUT       ? FRG_CUTTED : \
  289.                              FRG_REDO)
  290. #define ForeignContext(h)    (((long)(h) << FRG_BITS) >> FRG_BITS)
  291. #define ForeignContextAddress(h) ((Void)((long)(h) & ~FRG_MASK_MASK))
  292.  
  293. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  294. Virtual machine instruction declarations.  Prefixes:
  295.  
  296.   I_    General instructions
  297.   B_    Body specific version
  298.   H_    Head specific versin
  299.   A_    Arithmetic compilation specific
  300.   C_    Control (compilation of ;/2, etc.)
  301.  
  302. Numbering these things is arbitrary,  but  for  fast  operation  of  the
  303. switch  in  pl-wam.c,  numbering  should start at 0 and be without gaps.
  304. I_HIGHEST must be made equal to the highest  value  of  the  instruction
  305. codes.
  306. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  307.  
  308. #define I_NOP        ((code) 0)        /* nop */
  309. #define I_ENTER        ((code) 1)        /* enter body */
  310. #define I_CALL        ((code) 2)        /* call procedure */
  311. #define I_DEPART    ((code) 3)        /* last call of procedure */
  312. #define I_EXIT        ((code) 4)        /* exit procedure */
  313. #define B_FUNCTOR    ((code) 5)        /* start functor */
  314. #define H_FUNCTOR    ((code) 6)
  315. #define I_POP        ((code) 7)        /* end functor */
  316. #define I_POPN        ((code) 8)        /* end functor */
  317. #define B_VAR        ((code) 9)        /* variable */
  318. #define H_VAR        ((code)10)
  319. #define B_CONST        ((code)11)        /* constant (atomic) */
  320. #define H_CONST        ((code)12)
  321. #define H_REAL        ((code)13)        /* real in the head */
  322. #if O_STRING
  323. #define H_STRING    ((code)14)        /* string in the head */
  324. #endif /* O_STRING */
  325.  
  326. #define B_FIRSTVAR    ((code)15)        /* first occurrence of var */
  327. #define H_FIRSTVAR    ((code)16)
  328. #define B_VOID        ((code)17)        /* anonimous variables */
  329. #define H_VOID        ((code)18)
  330. #define B_ARGFIRSTVAR    ((code)19)        /* body vars nested in functor */
  331. #define B_ARGVAR    ((code)20)
  332.  
  333. #define H_NIL        ((code)21)        /* [] in the head */
  334. #define H_CONST0    ((code)22)        /* H_CONST 0, etc. */
  335. #define H_CONST1    ((code)23)
  336. #define H_CONST2    ((code)24)
  337.  
  338. #define H_LIST        ((code)25)        /* ./2 in the head */
  339. #define H_FUNCTOR0    ((code)26)        /* H_FUNCTOR 0, etc. */
  340. #define H_FUNCTOR1    ((code)27)
  341. #define H_FUNCTOR2    ((code)28)
  342.  
  343. #define B_VAR0        ((code)29)        /* B_VAR 0 */
  344. #define B_VAR1        ((code)30)        /* B_VAR 1 */
  345. #define B_VAR2        ((code)31)        /* B_VAR 2 */
  346.  
  347. #define H_SINT        ((code)32)        /* Small integer in the Head */
  348. #define B_SINT        ((code)33)        /* Small integer in the Body */
  349.  
  350. #define I_USERCALL    ((code)34)        /* variable in body (call/1) */
  351. #define I_CUT        ((code)35)        /* ! */
  352. #define I_APPLY        ((code)36)        /* apply/2 */
  353.  
  354. #if O_COMPILE_ARITH
  355. #define A_FUNC0        ((code)37)        /* nullary arithmic function */
  356. #define A_FUNC1        ((code)38)        /* unary arithmic function */
  357. #define A_FUNC2        ((code)39)        /* binary arithmic function */
  358. #define A_FUNC        ((code)40)        /* n-ary arithmic function */
  359. #define A_LT        ((code)41)        /* < */
  360. #define A_GT        ((code)42)        /* > */
  361. #define A_LE        ((code)43)        /* =< */
  362. #define A_GE        ((code)44)        /* >= */
  363. #define A_EQ        ((code)45)        /* =:= */
  364. #define A_NE        ((code)46)        /* =\= */
  365. #define A_IS        ((code)47)        /* is */
  366. #endif /* O_COMPILE_ARITH */
  367.  
  368. #if O_COMPILE_OR
  369. #define C_OR        ((code)48)        /* In-clause backtract point */
  370. #define C_JMP        ((code)49)        /* Jump over code */
  371. #define C_MARK        ((code)50)        /* Sub-clause cut mark */
  372. #define C_CUT        ((code)51)        /* cut to corresponding mark */
  373. #define C_IFTHENELSE    ((code)52)        /* if-then-else start */
  374. #define C_VAR        ((code)53)        /* make a variable */
  375. #define C_END        ((code)54)        /* dummy to help decompiler */
  376. #define C_NOT        ((code)55)        /* same as C_IFTHENELSE */
  377. #define C_FAIL        ((code)56)        /* fail */
  378. #endif /* O_COMPILE_OR */
  379.  
  380. #define B_REAL        ((code)57)        /* REAL in body */
  381. #define B_STRING    ((code)58)        /* STRING in body */
  382.  
  383. #define I_HIGHEST    ((code)58)        /* largest WAM code !!! */
  384.  
  385. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  386. Arithmetic comparison
  387. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  388.  
  389. #define LT 1
  390. #define GT 2
  391. #define LE 3
  392. #define GE 4
  393. #define NE 5
  394. #define EQ 6
  395.  
  396. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  397. Operator types
  398. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  399.  
  400. #define    OP_FX    0
  401. #define OP_FY    1
  402. #define OP_XF    2
  403. #define OP_YF    3
  404. #define OP_XFX    4
  405. #define OP_XFY    5
  406. #define OP_YFX    6
  407. #define    OP_YFY    7
  408.  
  409. #define OP_PREFIX  1
  410. #define OP_INFIX   2
  411. #define OP_POSTFIX 3
  412.  
  413. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  414. Files and streams
  415. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  416.  
  417. #define F_CLOSED    0        /* closed entry */
  418. #define F_READ        1        /* open for reading */
  419. #define F_WRITE        2        /* open for writing */
  420. #define F_APPEND    6        /* open for append writing */
  421.  
  422. #define streamOutput(stream, goal) \
  423.     { int SOn = streamNo(stream, F_WRITE); \
  424.       int SOout = Output; \
  425.       word SOrval; \
  426.       if ( SOn < 0 ) fail; \
  427.       Output = SOn; \
  428.       SOrval = goal; \
  429.       Output = SOout; \
  430.       return SOrval; \
  431.     }
  432.  
  433. #define streamInput(stream, goal) \
  434.     { int SOn = streamNo(stream, F_READ); \
  435.       int SOin = Input; \
  436.       word SOrval; \
  437.       if ( SOn < 0 ) fail; \
  438.       Input = SOn; \
  439.       SOrval = goal; \
  440.       Input = SOin; \
  441.       return SOrval; \
  442.     }
  443.  
  444. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  445. Type fields.  These codes are  included  in  a  number  of  the  runtime
  446. structures  at  a  fixed  point, so the runtime environment can tell the
  447. difference.
  448. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  449.  
  450. #define ATOM_TYPE    1        /* an atom */
  451. #define FUNCTOR_TYPE    2        /* a Functor */
  452. #define PROCEDURE_TYPE    3        /* a procedure */
  453. #define RECORD_TYPE    4        /* a record list */
  454.  
  455. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  456.               PROLOG DATA REPRESENTATION
  457.  
  458. Prolog data objects live on various places:
  459.  
  460.     - In the variable and argument slots of environment frames.
  461.     - As arguments to complex terms on the global stack.
  462.     - In records (recorda/recorded database) in the heap.
  463.     - In variables in foreign language functions.
  464.  
  465. All Prolog data is packed into a `word'.  A word is  a  32  bit  entity.
  466. The top 3 bits are used to indicate the type; the bottom 2 bits are used
  467. for  the  garbage  collector.   The  bits  for the garbage collector are
  468. always 0 during normal execution.  This implies we do not have  to  care
  469. about  them  for  pointers  and  as  pointers  always  point  to 4 bytes
  470. entities, the range is not harmed by the garbage collection bits.
  471.  
  472. The remaining 27 bits can hold a  unique  representation  of  the  value
  473. itself  or  can be a pointer to the global stack where the real value is
  474. stored.  We call the latter type of data `indirect'.
  475.  
  476. Below is a description of the  representation  used  for  each  type  of
  477. Prolog data:
  478.  
  479. INTEGER
  480.     Integers are stored in the  27  remaining  bits  of  a  word.   This
  481.     implies they are limited to +- 2^26.
  482. REAL
  483.     For a real, the 27 bits are a pointer to a 8 byte unit on the global
  484.     stack.  For both words of the 8 byte unit, the top 3  and  bottom  2
  485.     bits  are  reserved  for identification and garbage collection.  The
  486.     remaining bits hold the exponent and mantisse.  See pack_real()  and
  487.     unpack_real() in pl-alloc.c for details.
  488. ATOM
  489.     For atoms, the 27 bits represent a pointer  to  an  atom  structure.
  490.     Atom  structures are cells of a hash table.  Equality of the pointer
  491.     implies equality of the atoms and visa versa.  Atom  structures  are
  492.     not  collected by the garbage collector and thus live for the entire
  493.     Prolog session.
  494. STRING
  495.     For a string, the 27 bits are a pointer to the  global  stack.   The
  496.     first  word  of  the  string  again reserves  the top 3 and bottom 2
  497.     bits.  The remaining bits indicate the lenght of the  string.   Next
  498.     follows a 0 terminated character string.  Finally a word exactly the
  499.     same  as the header word, to allow the garbage collector to traverse
  500.     the stack downwards and identify the string.
  501. TERM
  502.     For a compound term, the 27 bits are a pointer to the global  stack.
  503.     the  first  word there is a pointer to a functordef structure, which
  504.     determines the name and arity of the  term.   functordef  structures
  505.     are  cells  of  a hash table like atom structures.  They to live for
  506.     the entire Prolog session.  Next, there are just as  many  words  as
  507.     the  arity  of the term, each word representing a normal Prolog data
  508.     object.
  509. VARIABLES
  510.     An unbound variable is represented by NULL.
  511. REFERENCES
  512.     References are the result of sharing variables.   If  two  variables
  513.     must  share,  the one with the shortest livetime is made a reference
  514.     pointer to the other.  This way a tree of reference pointers can  be
  515.     constructed.   The root of the tree is the variable with the longest
  516.     livetime.  To bind the entire tree of variables this root is  bound.
  517.     The  others remain reference pointers.  This implies that ANY prolog
  518.     data object might be a reference  pointer  to  another  Prolog  data
  519.     object,  holding  the  real  value.  To find the real value, a macro
  520.     called deRef() is available.
  521.  
  522.     The direction of reference pointers is critical.  It MUST  point  in
  523.     the direction of the longest living variable.  If not, the reference
  524.     pointer  will  point  into  the  dark  if  the other end dies.  This
  525.     implies that if both cells are part of an environment frame, the one
  526.     in the child function (closest to the top of the stack)  must  point
  527.     to  the  one in the parent function.  If one is on the local and one
  528.     on the global stack, the  pointer  must  point  towards  the  global
  529.     stack.   Inside  the global stack it is irrelevant.  If backtracking
  530.     destroys a variable, it also will reset the reference towards it  if
  531.     there is one.
  532. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  533.  
  534. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  535. Masks.  Currently the top 3 bits of a word are used as  mask.   The  top
  536. bit  is  reserved  for  references,  which  are  represented as negative
  537. numbers.  At least the 68020 is faster in checking for negative  numbers
  538. and  turning  negative  numbers into positive ones.  This trick gives an
  539. overall performance increase of about 5%. The other two  bits  are  used
  540. for  integers, reals and strings.  Both reals and strings are `indirect'
  541. data types (tagged pointers to the real value).  This  has  consequences
  542. in  unification an similar functions.  Therefore a macro `isIndirect(w)'
  543. has been introduced.  If you decide to change things here make sure this
  544. macro  operates  oppropriately  and  is  FAST  (its  used  in   critical
  545. unification code).
  546.  
  547. (The RT under AIX uses a somewhat irregular memory model:
  548.  
  549. 0x10000000 text... 0x20000000 ...data...bss...malloc... ...stack 03fffffff
  550.  
  551. This conflicts with the data representation used for SUN.  So we put the
  552. tag bits on bits 32, 31 and 29 instead of 32, 31 and 30.   This  reduces
  553. the range of integers to +- 2^25.  (Macros have to be rewritten))
  554. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  555.  
  556. #define REF_MASK    0x80000000L    /* Reference (= negative) */
  557. #define MARK_MASK    0x00000001L    /* GC marking bit */
  558.  
  559. #if O_16_BITS
  560. #define INDIRECT_MASK    0x40000000L    /* Indirect constant */
  561. #define INT_MASK    0x20000000L    /* Indirect constant */
  562. #define MASK_BITS    4        /* high order mask bits */
  563. #define LMASK_BITS    1        /* low order mask bits */
  564. #define DMASK_BITS    5        /* DATA_TAG_MASK bits */
  565. #define FIRST_MASK    0x10000000L    /* first member of relocation chain */
  566. #define STRING_MASK    0x60000000L    /* Header mask on global stack */
  567. #define REAL_MASK    0x68000000L    /* Header mask on global stack */
  568. #define MASK_MASK    (INT_MASK|REF_MASK|INDIRECT_MASK|FIRST_MASK)
  569. #define DATA_TAG_MASK    0xf8000000L    /* Indirect data type mask */
  570.  
  571. #else /* !O_16_BITS */
  572.  
  573. #define REAL_MASK    0x70000000L    /* Header mask on global stack */
  574.  
  575. #if O_DATA_AT_0X4
  576. #define INDIRECT_MASK    0x20000000L    /* Indirect constant */
  577. #define INT_MASK    0x10000000L    /* Indirect constant */
  578. #define MASK_BITS    4        /* high order mask bits */
  579. #define STRING_MASK    0x30000000L    /* Header mask on global stack */
  580. #else
  581. #if O_DATA_AT_0X2
  582. #define INDIRECT_MASK    0x40000000L    /* Indirect constant */
  583. #define INT_MASK    0x10000000L    /* Indirect constant */
  584. #define MASK_BITS    4        /* high order mask bits */
  585. #define STRING_MASK    0x50000000L    /* Header mask on global stack */
  586. #else /* 0X1 or lower */
  587. #define INDIRECT_MASK    0x40000000L    /* Indirect constant */
  588. #define INT_MASK    0x20000000L    /* Indirect constant */
  589. #define MASK_BITS    3        /* high order mask bits */
  590. #define STRING_MASK    0x60000000L    /* Header mask on global stack */
  591. #endif /* O_DATA_AT_0X2 */
  592. #endif /* O_DATA_AT_0X4 */
  593.  
  594. #define LMASK_BITS    2        /* low order mask bits */
  595. #define DMASK_BITS    4        /* DATA_TAG_MASK bits */
  596. #define FIRST_MASK    0x00000002L    /* first member of relocation chain */
  597. #define MASK_MASK    (INT_MASK|REF_MASK|INDIRECT_MASK)
  598. #define DATA_TAG_MASK    0xf0000000L    /* Indirect data type mask */
  599.  
  600. #endif /* O_16_BITS */
  601.  
  602. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  603. Common Prolog objects typedefs.
  604. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  605.  
  606. typedef ulong             word;        /* Anonimous 4 byte object */
  607. typedef word *            Word;        /* a pointer to anything */
  608. typedef unsigned short        code;        /* bytes codes */
  609. typedef code *            Code;        /* pointer to byte codes */
  610. typedef int            Char;        /* char that can pass EOF */
  611. typedef word            (*Func)();    /* foreign functions */
  612.  
  613. typedef struct atom *        Atom;        /* atom */
  614. typedef struct functor *    Functor;    /* complex term */
  615. typedef struct functorDef *    FunctorDef;    /* name/arity pair */
  616. typedef struct procedure *    Procedure;    /* predicate */
  617. typedef struct definition *    Definition;    /* predicate definition */
  618. typedef struct clause *        Clause;        /* compiled clause */
  619. typedef struct code_info *    CodeInfo;    /* WAM op-code info */
  620. typedef struct operator *    Operator;    /* see pl-op.c, pl-read.c */
  621. typedef struct record *        Record;        /* recorda/3, etc. */
  622. typedef struct recordList *    RecordList;    /* list of these */
  623. typedef struct module *        Module;        /* predicate modules */
  624. typedef struct sourceFile *    SourceFile;    /* file adminitration */
  625. typedef struct table *        Table;        /* (numeric) hash table */
  626. typedef struct symbol *        Symbol;        /* symbol of hash table */
  627. typedef struct localFrame *    LocalFrame;    /* environment frame */
  628. typedef struct trail_entry *    TrailEntry;    /* Entry of train stack */
  629. typedef struct data_mark    mark;        /* backtrack mark */
  630. typedef struct index *        Index;        /* clause indexing */
  631. typedef struct stack *        Stack;        /* machine stack */
  632. typedef struct lock *        Lock;        /* GC data lock */
  633.  
  634. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  635. Many of the structures have a large number of booleans  associated  with
  636. them.   Early  versions defined these using `unsigned <name> : 1' in the
  637. structure definition.  When I ported SWI-Prolog to a  machine  that  did
  638. not  understand  this  construct  I  decided  to pack all the flags in a
  639. short.  As this allows us to set, clear and test combinations  of  flags
  640. with one operation, it turns out to be faster as well.
  641. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  642.  
  643. #define true(s, a)        ((s)->flags & (a))
  644. #define false(s, a)        (!true((s), (a)))
  645. #define set(s, a)        ((s)->flags |= (a))
  646. #define clear(s, a)        ((s)->flags &= ~(a))
  647. #define clearFlags(s)        ((s)->flags = 0)
  648.  
  649. #define NONDETERMINISTIC    (0x0002)
  650. #define DISCONTIGUOUS        (0x0004)
  651. #define DYNAMIC            (0x0008)
  652. #define ERASED            (0x0010)
  653. #define FOREIGN            (0x0020)
  654. #define HIDE_CHILDS        (0x0040)
  655. #define MULTIFILE        (0x0080)
  656. #define PROFILE_TICKED        (0x0100)
  657. #define SPY_ME            (0x0200)
  658. #define SYSTEM            (0x0400)
  659. #define TRACE_ME        (0x0800)
  660. #define TRANSPARENT        (0x1000)
  661. #define AUTOINDEX        (0x2000)
  662. #define INDEXABLE        (0x4000)
  663. #define UNKNOWN            (0x8000)
  664.  
  665. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  666. Handling environment (or local stack) frames.
  667. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  668.  
  669. #define FR_LEVEL        (0xFFFFFFF0L)
  670. #define FR_CUT            (0x00000001L)
  671. #define FR_NODEBUG        (0x00000002L)
  672. #define FR_SKIPPED        (0x00000004L)
  673. #define FR_MARKED        (0x00000008L)
  674.  
  675. #define ARGOFFSET        ((int) sizeof(struct localFrame))
  676.  
  677. #define setLevelFrame(fr, l)    { (fr)->flags &= ~FR_LEVEL;   \
  678.                   (fr)->flags |= ((l) << 4); \
  679.                 }
  680. #define levelFrame(fr)        (fr->flags >> 4)
  681. #define incLevel(fr)        (fr->flags += 0x10)
  682. #define argFrameP(f, n)        ((Word)((f)+1) + (n))
  683. #define argFrame(f, n)        (*argFrameP((f), (n)) )
  684. #define varFrameP(f, n)        ((Word)(f) + (n))
  685. #define varFrame(f, n)        (*varFrameP((f), (n)) )
  686. #define parentFrame(f)        ((f)->parent ? (f)->parent\
  687.                          : (LocalFrame)varFrame((f), -1))
  688. #define slotsFrame(f)        (true((f)->procedure->definition, FOREIGN) ? \
  689.                       (f)->procedure->functor->arity : \
  690.                       (f)->clause->slots)
  691. #define contextModule(f)    ((f)->context)
  692.  
  693. #define leaveClause(clause) { if ( --clause->references == 0 && \
  694.                    true(clause, ERASED) ) \
  695.                 unallocClause(clause); \
  696.                 }
  697.  
  698. #define leaveFrame(fr) { if ( true(fr->procedure->definition, FOREIGN) ) \
  699.                leaveForeignFrame(fr); \
  700.              else \
  701.              { if ( fr->clause ) \
  702.                  leaveClause(fr->clause); \
  703.              } \
  704.                }
  705.  
  706. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  707. Macros to turn pointers into Prolog integers and  vice-versa.   Used  to
  708. pass  references  for  recorda,  erase, clause/3, etc.  As AIX addresses
  709. range from 0x2000000, which is above the maximum integer value  for  the
  710. AIX  version  we  substract  this value and add it again when converting
  711. integers to pointers.
  712. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  713.  
  714. #if O_DATA_AT_0X4
  715. #  define PTR_TO_NUM_OFFSET    0x40000000L
  716. #else
  717. #  if O_DATA_AT_0X2
  718. #    define PTR_TO_NUM_OFFSET    0x20000000L
  719. #  else
  720. #    if O_DATA_AT_OX1
  721. #      define PTR_TO_NUM_OFFSET 0x10000000L
  722. #    else
  723. #      define PTR_TO_NUM_OFFSET   0x0L
  724. #    endif
  725. #  endif
  726. #endif
  727.  
  728. #define pointerToNum(p)       consNum(((long)(p)-PTR_TO_NUM_OFFSET)/sizeof(int))
  729. #define numToPointer(n)       ((Word)(valNum(n)*sizeof(int)+PTR_TO_NUM_OFFSET))
  730.  
  731.  
  732. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  733. Macros to handle the anonimous types.  'w' implies we expect a word, 'p'
  734. for a pointer.
  735. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  736.  
  737. #define unMask(w)        ((w) & ~MASK_MASK)
  738. #define mask(w)            (w & MASK_MASK)
  739. #define consNum(n)        ((word) (unMask((n)<<LMASK_BITS) | INT_MASK))
  740. #define valNum(w)        ((long) ((w)<<MASK_BITS)>>(MASK_BITS+LMASK_BITS))
  741. #define consNumFromCode(c)    consNum((signed short)(c))
  742. #define valReal(w)        unpack_real((Word)unMask(w))
  743. #if O_STRING
  744. #define allocSizeString(l)    (ROUND(l+1, sizeof(word)) + 2 * sizeof(word))
  745. #define valString(w)        ((char *)((Word)unMask(w)+1))
  746. #define sizeString(w)        (((long)(*(Word)unMask(w))<<DMASK_BITS)>> \
  747.                         (DMASK_BITS+LMASK_BITS))
  748. #define equalString(w1,w2)    (sizeString(w1) == sizeString(w2) && \
  749.                  streq(valString(w1), valString(w2)))
  750. #endif /* O_STRING */
  751.  
  752. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  753. Handling references.
  754. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  755.  
  756. #define makeRef(p)    ((word)(-(long)(p)))
  757. #define unRef(w)    ((Word)(-(long)(w)))
  758. #define isRef(w)    ((long)(w) < 0)
  759. #define deRef(p)    { while(isRef(*(p))) (p) = unRef(*(p)); }
  760. #define deRef2(p, d)    { (d) = (p); deRef((d)); }
  761.  
  762. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  763. Handling dereferenced arbitrary Prolog runtime objects.
  764. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  765.  
  766. #define isMasked(w)    (mask(w) != (word) NULL)
  767. #define isIndirect(w)    ((w) & INDIRECT_MASK)
  768. #define isInteger(w)    ((w) & INT_MASK)
  769. #define isReal(w)    (isIndirect(w) && \
  770.              (*((Word)unMask(w)) & DATA_TAG_MASK) == REAL_MASK)
  771. #if O_STRING
  772. #define isString(w)    (isIndirect(w) && \
  773.              (*((Word)unMask(w)) & DATA_TAG_MASK) == STRING_MASK)
  774. #endif /* O_STRING */
  775. #define isNumber(w)    (isInteger(w) || isReal(w))
  776. #define isVar(w)    ((w) == (word) NULL)
  777. #define nonVar(w)    ((w) != (word) NULL)
  778. #define isPointer(w)    (nonVar(w) && !isMasked(w))
  779. #define pointerIsAtom(w) (((Atom)(w))->type == ATOM_TYPE)
  780. #define pointerIsFunctor(w) (((Functor)(w))->type == FUNCTOR_TYPE)
  781. #define isAtom(w)    (isPointer(w) && pointerIsAtom(w))
  782. #define isFunctor(w)    (isPointer(w) && pointerIsFunctor(w))
  783. #define stringAtom(w)    (((Atom)(w))->name)
  784. #define isPrimitive(w)  (isVar(w) || isAtomic(w))
  785. #define isAtomic(w)    (nonVar(w) && (isMasked(w) || pointerIsAtom(w)))
  786. #define isTerm(w)    (isPointer(w) && !pointerIsAtom(w))
  787. #define isList(w)    (isPointer(w) && functorTerm(w) == FUNCTOR_dot2)
  788. #define functorTerm(w)    (((Functor)(w))->definition)
  789. #define argTerm(w, n)    (*argTermP((w), (n)))
  790. #define argTermP(w, n)    (((Word)(w)+1+(n)))
  791. #define isProcedure(w)    (((Procedure)(w))->type == PROCEDURE_TYPE)
  792. #define isRecordList(w)    (((RecordList)(w))->type == RECORD_TYPE)
  793.  
  794. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  795. Heuristics functions to determine whether an integer reference passed to
  796. erase and assert/2, clause/3, etc.  really points to a clause or record.
  797. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  798.  
  799. #define inCore(a)    ((char *)(a) >= hBase && (char *)(a) <= hTop)
  800. #define isClause(c)    (inCore(((Clause)(c))->procedure) && \
  801.               isProcedure(((Clause)(c))->procedure))
  802. #define isRecord(r)    (inCore(((Record)(r))->list) && \
  803.               isRecordList(((Record)(r))->list))
  804.  
  805. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  806. At times an abort is not allowed because the heap  is  inconsistent  the
  807. programmer  should  call  startCritical  to start such a code region and
  808. endCritical to end it.
  809. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  810.  
  811. #define startCritical { critical++; }
  812. #define endCritical   { if (--critical == 0 && aborted == TRUE) pl_abort(); }
  813.  
  814. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  815. LIST processing macros.
  816.  
  817.     isNil(w)        word is the nil list ([]).
  818.     isList(w)        word is a './2' term.
  819.     HeadList(p)        Pointer to the head of list *p (NOT dereferenced).
  820.     TailList(p)        Pointer to the tail of list *p (NOT dereferenced).
  821.     APPENDLIST(l, p)    Append *p to list *l. l points to the tail afterwards.
  822.     CLOSELIST(l)    Unify the tail of the list with [].
  823. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  824.  
  825. #define isNil(w)    ((w) == (word) ATOM_nil)
  826. #define HeadList(p)    (argTermP(*(p), 0) )
  827. #define TailList(p)    (argTermP(*(p), 1) )
  828.  
  829. #define APPENDLIST(l, p) { TRY(unifyFunctor(l, FUNCTOR_dot2) ); \
  830.                TRY(pl_unify(HeadList(l), p) ); \
  831.                l = TailList(l); deRef(l); \
  832.              }
  833. #define CLOSELIST(l)     { TRY(unifyAtomic(l, ATOM_nil)); }
  834.  
  835.  
  836. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  837. Handling variables: creating a variable, trailing its assignment, making
  838. a snap shot of the runtime environment and backtrack back to it.
  839. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  840.  
  841. #define setVar(w)    ((w) = (word) NULL)
  842. #define Trail(p)    { (tTop++)->address = (p); \
  843.               verifyStack(trail); \
  844.             }
  845. #define Mark(b)        { (b).trailtop = tTop; \
  846.               (b).globaltop = gTop; \
  847.             }
  848. #define Undo(b)        { register TrailEntry tt = tTop; \
  849.               while(tt > (b).trailtop) \
  850.                 setVar(*(--tt)->address); \
  851.               tTop = tt; \
  852.               gTop = (b).globaltop; \
  853.             }
  854.  
  855.  
  856. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  857. Structure declarations that must be shared across multiple files.
  858. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  859.  
  860. struct atom
  861. { Atom        next;        /* next in chain */
  862.   int        type;        /* ATOM_TYPE */
  863.   char *    name;        /* name associated with atom */
  864. };
  865.  
  866. struct index
  867. { ulong        key;        /* key of index */
  868.   ulong        varmask;    /* variable field mask */
  869. };
  870.  
  871. struct functorDef
  872. { FunctorDef    next;        /* next in chain */
  873.   int        type;        /* FUNCTOR_TYPE */
  874.   Atom        name;        /* Name of functor */
  875.   int        arity;        /* arity of functor */
  876. };
  877.  
  878. struct clause
  879. { Procedure    procedure;    /* procedure we belong to */
  880.   Clause    next;        /* next clause of procedure */
  881.   Word        externals;    /* External references */
  882.   Code        codes;        /* byte codes of clause */
  883.   struct index    index;        /* index key of clause */
  884.   unsigned int    references;    /* no of. references from interpreter */
  885.   short        code_size;    /* size of byte code array */
  886.   short        subclauses;    /* number of subclauses in body (decompiler) */
  887.   code        XR_size;    /* size of external reference table */
  888.   code        variables;    /* number of variables */
  889.   code        slots;        /* # variables holding Prolog data */
  890.   ushort    flags;        /* Flag field holding: */
  891.         /* ERASED       Clause is retracted, but referenced */
  892.         /* INDEXABLE       Clause has indexable 1st argument */
  893. };
  894.  
  895. struct code_info
  896. { char        *name;        /* name of the code */
  897.   char        arguments;    /* # arguments code takes */
  898.   code        code;        /* number of the code */
  899. };
  900.  
  901. struct data_mark
  902. { TrailEntry    trailtop;    /* top of the trail stack */
  903.   Word        globaltop;    /* top of the global stack */
  904. };
  905.  
  906. struct functor
  907. { FunctorDef    definition;    /* Name/Arity */
  908.   word        arguments[1];    /* arguments vector */
  909. };
  910.  
  911. struct operator
  912. { Operator    next;        /* next of chain */
  913.   Atom        name;        /* name of operator */
  914.   short        type;        /* OP_FX, ... */
  915.   short        priority;    /* priority of operator */
  916. };
  917.  
  918. struct procedure
  919. { FunctorDef    functor;    /* Name/Arity of procedure */
  920.   int        type;        /* PROCEDURE_TYPE */
  921.   Definition    definition;    /* definition of procedure */
  922. };
  923.  
  924. struct definition
  925. { union
  926.   { Clause    clauses;        /* clause list of procedure */
  927.     Func    function;        /* function pointer of procedure */
  928.   } definition;
  929.   Clause    lastClause;        /* last clause of list */
  930.   Module    module;            /* module of the predicate */
  931.   SourceFile    source;            /* source file of predicate */
  932. #if O_PROFILE
  933.   int        profile_ticks;        /* profiler: call times active */
  934.   int        profile_calls;        /* profiler: number of calls */
  935.   int        profile_redos;        /* profiler: number of redos */
  936.   int        profile_fails;        /* profiler: number of fails */
  937. #endif /* O_PROFILE */
  938.   ulong        indexPattern;        /* indexed argument pattern */
  939.   char        indexCardinality;    /* cardinality of index pattern */
  940. #if O_AUTOINDEX
  941.   int        indexMerit;        /* how badly do we want it? */
  942. #endif
  943.   short        source_count;        /* times (re)consulted */
  944.   ushort    flags;            /* booleans: */
  945.         /*    FOREIGN           foreign predicate? */
  946.         /*    PROFILE_TICKED       has been ticked this time ? */
  947.         /*    TRACE_ME       is my call visible? */
  948.         /*    HIDE_CHILDS       hide childs for the debugger? */
  949.         /*    SPY_ME           spy point set? */
  950.         /*    DYNAMIC           dynamic predicate? */
  951.         /*    MULTIFILE       defined over more files? */
  952.         /*    SYSTEM           system predicate */
  953.         /*    TRANSPARENT       procedure transparent to modules */
  954.         /*    DISCONTIGUOUS       procedure might be discontiguous */
  955.         /*    DETERMINISTIC       deterministic foreign (not used) */
  956.         /*    AUTOINDEX       Apply heuristically best index */
  957. };
  958.  
  959. struct localFrame
  960. { Code        programPointer;    /* pointer into program */
  961.   LocalFrame    parent;        /* parent local frame */
  962.   Clause    clause;        /* Current clause of frame */
  963.   LocalFrame    backtrackFrame;    /* Frame for backtracking */
  964.   Procedure    procedure;    /* Procedure we are running */
  965.   mark        mark;        /* data backtrack mark */
  966.   Module    context;    /* context module of frame */
  967.   ulong        flags;        /* packet long holding: */
  968.         /*    LEVEL       recursion level (28 bits) */
  969.         /*    FR_CUT     has frame been cut ? */
  970.         /*    FR_NODEBUG don't debug this frame ? */
  971. };  
  972.  
  973. struct record
  974. { RecordList    list;        /* list I belong to */
  975.   Record    next;        /* next of chain */
  976.   word        term;        /* term associated */
  977.   int        n_vars;        /* number of variables */
  978.   Word        variables;    /* array of variables */
  979. };
  980.  
  981. struct recordList
  982. { RecordList    next;        /* next record chain with same key */
  983.   int        type;        /* RECORD_TYPE */
  984.   word        key;        /* key of record */
  985.   Record    firstRecord;    /* first record associated with key */
  986.   Record    lastRecord;    /* last record associated with key */
  987. };
  988.  
  989. struct sourceFile
  990. { Atom        name;        /* name of source file */
  991.   SourceFile    next;        /* next of chain */
  992.   int        count;        /* number of times loaded */
  993.   long        time;        /* load time of file */
  994.   bool        system;        /* system sourcefile: do not reload */
  995. };
  996.  
  997. struct module
  998. { Atom        name;        /* name of module */
  999.   SourceFile    file;        /* file from which module is loaded */
  1000.   Table        procedures;    /* predicates associated with module */
  1001.   Table        public;        /* public predicates associated */
  1002.   Module    super;        /* Import predicates from here */
  1003.   ushort    flags;        /* booleans: */
  1004.         /*    SYSTEM       system module */
  1005.         /*    UNKNOWN       trap unknown predicates */
  1006. };
  1007.  
  1008. struct trail_entry
  1009. { Word        address;    /* address of the variable */
  1010. };
  1011.  
  1012. struct table
  1013. { int        size;        /* size of hash table */
  1014.   Symbol    entries[1];    /* array of hash symbols */
  1015. };
  1016.  
  1017. struct symbol
  1018. { Symbol    next;        /* next in chain */
  1019.   word        name;        /* name entry of symbol */
  1020.   word        value;        /* associated value with name */
  1021. };
  1022.  
  1023. struct lock
  1024. { unsigned    type  : 2;    /* Type of lock */
  1025.   unsigned    value : 30;    /* Anonymous value */
  1026. };  
  1027.  
  1028.         /********************************
  1029.         *             STACKS            *
  1030.         *********************************/
  1031.  
  1032. #if O_CAN_MAP || O_SHARED_MEMORY
  1033. #define O_DYNAMIC_STACKS 1
  1034. #endif
  1035.  
  1036. #if O_SHARED_MEMORY
  1037. #define O_SHM_FREE_IMMEDIATE 1
  1038. #define MAX_STACK_SEGMENTS  20
  1039. #define STACK(type) \
  1040.     { type        base;        /* base address of the stack */     \
  1041.       type        top;        /* current top of the stack */      \
  1042.       type        max;        /* allocated maximum */            \
  1043.       long        limit;        /* how big it is allowed to grow */ \
  1044.       long        maxlimit;    /* maximum limit */                 \
  1045.       char        *name;        /* Symbolic name of the stack */    \
  1046.       long        segment_initial;/* initial size */            \
  1047.       int        segment_double;    /* times to double */            \
  1048.       int        segment_top;    /* Next segment to be allocated */  \
  1049.       struct                                \
  1050.       { caddress    base;        /* Base of this segment */        \
  1051.         long    size;        /* Size of this segment */        \
  1052.       } segments[MAX_STACK_SEGMENTS];                    \
  1053.     }
  1054. #else /* !O_SHARED_MEMORY */
  1055. #define STACK(type) \
  1056.     { type        base;        /* base address of the stack */     \
  1057.       type        top;        /* current top of the stack */      \
  1058.       type        min;        /* donot shrink below this value */ \
  1059.       type        max;        /* allocated maximum */            \
  1060.       long        limit;        /* how big it is allowed to grow */ \
  1061.       long        maxlimit;    /* maximum limit */                 \
  1062.       char        *name;        /* Symbolic name of the stack */    \
  1063.     }
  1064. #endif
  1065.  
  1066. struct stack STACK(caddress);        /* Anonymous stack */
  1067.  
  1068. GLOBAL struct
  1069. { struct STACK(LocalFrame) local;    /* local (environment) stack */
  1070.   struct STACK(Word)       global;    /* local (environment) stack */
  1071.   struct STACK(TrailEntry) trail;    /* trail stack */
  1072.   struct STACK(Word *)       argument;    /* argument stack */
  1073.   struct STACK(Lock)       lock;    /* Foreign code locks */
  1074. } stacks;
  1075.  
  1076. #define tBase    (stacks.trail.base)
  1077. #define tTop    (stacks.trail.top)
  1078. #define tMax    (stacks.trail.max)
  1079.  
  1080. #define lBase    (stacks.local.base)
  1081. #define lTop    (stacks.local.top)
  1082. #define lMax    (stacks.local.max)
  1083.  
  1084. #define gBase    (stacks.global.base)
  1085. #define gTop    (stacks.global.top)
  1086. #define gMax    (stacks.global.max)
  1087.  
  1088. #define aBase    (stacks.argument.base)
  1089. #define aTop    (stacks.argument.top)
  1090. #define aMax    (stacks.argument.max)
  1091.  
  1092. #define pBase    (stacks.lock.base)
  1093. #define pTop    (stacks.lock.top)
  1094. #define pMax    (stacks.lock.max)
  1095.  
  1096. GLOBAL char *    hTop;            /* highest allocated heap address */
  1097. GLOBAL char *    hBase;            /* lowest allocated heap address */
  1098.  
  1099. #if O_DYNAMIC_STACKS
  1100. #define STACKVERIFY(g)            /* hardware stack verify */
  1101. #define verifyStack(s)
  1102. #else
  1103. #define STACKVERIFY(g)    { g; }
  1104. #define verifyStack(s)    { if ( stacks.s.top >= stacks.s.max ) \
  1105.                 outOf((Stack)&stacks.s); }
  1106. #endif
  1107.  
  1108.         /********************************
  1109.         *       GLOBAL VARIABLES        *
  1110.         *********************************/
  1111.  
  1112. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1113. General global variables  to  indicate  status  or  communicate  between
  1114. modules.
  1115. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1116.  
  1117. GLOBAL int       critical;        /* in critical code for abort? */
  1118. GLOBAL bool      aborted;        /* have we been aborted */
  1119. GLOBAL char      *cannot_save_program;    /* Program cannot be saved */
  1120. GLOBAL LocalFrame environment_frame;    /* current context frame */
  1121. GLOBAL bool      novice;        /* novice user */
  1122. GLOBAL Atom      source_file_name;    /* Current source file_name */
  1123. GLOBAL int      source_line_no;    /* Current source line_no */
  1124.  
  1125. #define ReadingSource (source_line_no > 0 && source_file_name != NULL)
  1126.  
  1127.         /********************************
  1128.         *        FAST DISPATCHING    *
  1129.         ********************************/
  1130.  
  1131. #if O_VMCODE_IS_ADDRESS
  1132. GLOBAL char  *dewam_table;            /* decoding table */
  1133. GLOBAL code  wam_table[I_HIGHEST+1];        /* code --> address */
  1134. GLOBAL void **interpreter_jmp_table;        /* interpreters table */
  1135.  
  1136. #define encode(wam) (wam_table[wam])        /* WAM --> internal */
  1137. #define decode(c)   ((code) dewam_table[c])    /* internal --> WAM */
  1138. #else /* O_VMCODE_IS_ADDRESS */
  1139. #define encode(wam) (wam)
  1140. #define decode(wam) (wam)
  1141. #endif /* O_VMCODE_IS_ADDRESS */
  1142.  
  1143.         /********************************
  1144.         *            STATUS             *
  1145.         *********************************/
  1146.  
  1147. GLOBAL struct
  1148. { bool        requested;        /* GC is requested by stack expander */
  1149.   int        blocked;        /* GC is blocked now */
  1150.   bool        active;            /* Currently running? */
  1151.   LocalFrame    segment;        /* Collected segment boundary */
  1152.   long        collections;        /* # garbage collections */
  1153.   long        global_gained;        /* global stack bytes collected */
  1154.   long        trail_gained;        /* trail stack bytes collected */
  1155.   real        time;            /* time spent in collections */
  1156. } gc_status;
  1157.  
  1158. GLOBAL struct
  1159. { Atom        symbolfile;        /* current symbol file */
  1160.   Atom        orgsymbolfile;        /* symbol file we started with */
  1161.   Atom        restored_state;        /* -r/restore state restored */
  1162. } loaderstatus;
  1163.  
  1164. #define NO_PROFILING        0
  1165. #define CUMULATIVE_PROFILING    1
  1166. #define PLAIN_PROFILING        2
  1167.  
  1168. /*  statistics information */
  1169.  
  1170. GLOBAL struct
  1171. { long        inferences;        /* logical inferences made */
  1172.   long        heap;            /* heap in use */
  1173.   int        atoms;            /* No. of atoms defined */
  1174.   int        functors;        /* No. of functors defined */
  1175.   int        predicates;        /* No. of predicates defined */
  1176.   int        modules;        /* No. of modules in the system */
  1177.   long        externals;        /* No. of clause external references */
  1178.   long        codes;            /* No. of byte codes generated */
  1179.   long        collections;        /* No. of garbage collections */
  1180.   long        global_gained;        /* No. of cells global stack gained */
  1181.   long        trail_gained;        /* No. of cells trail stack gained */
  1182. #if O_PROFILE
  1183.   int        profiling;        /* profiler is on? */
  1184.   long        profile_ticks;        /* profile ticks total */
  1185. #endif /* O_PROFILE */
  1186. } statistics;
  1187.  
  1188.         /********************************
  1189.         *            MODULES            *
  1190.         *********************************/
  1191.  
  1192. #define MODULE_user    (modules.user)
  1193. #define MODULE_system    (modules.system)
  1194.  
  1195. GLOBAL struct
  1196. { Module    typein;            /* module for type in goals */
  1197.   Module    source;            /* module we are reading clauses in */
  1198.   Module    user;            /* user module */
  1199.   Module    system;            /* system predicate module */
  1200. } modules;
  1201.  
  1202. GLOBAL Table    moduleTable;        /* hash table of available modules */
  1203.  
  1204.         /********************************
  1205.         *         PREDICATES            *
  1206.         *********************************/
  1207.  
  1208. GLOBAL Procedure    PROCEDURE_alt1;    /* $alt/1, see C_OR */
  1209. GLOBAL Procedure    PROCEDURE_garbage_collect0;
  1210.  
  1211. extern struct code_info    codeTable[];
  1212.  
  1213.         /********************************
  1214.         *            DEBUGGER           *
  1215.         *********************************/
  1216.  
  1217. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1218. Tracer communication declarations.
  1219. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1220.  
  1221. #define ACTION_CONTINUE    0
  1222. #define ACTION_RETRY    1
  1223. #define ACTION_FAIL    2
  1224. #define ACTION_IGNORE    3
  1225. #define ACTION_AGAIN    4
  1226.  
  1227. #define CALL_PORT    0x1        /* port masks */
  1228. #define EXIT_PORT    0x2
  1229. #define FAIL_PORT    0x4
  1230. #define REDO_PORT    0x8
  1231. #define UNIFY_PORT    0x10
  1232. #define VERY_DEEP    10000000L    /* deep skiplevel */
  1233.  
  1234. #define LONGATOM_CHECK        0x1        /* read/1: error on long atoms */
  1235. #define SINGLETON_CHECK        0x2        /* read/1: check singleton vars */
  1236. #define DOLLAR_STYLE        0x4        /* dollar is lower case */
  1237. #define DISCONTIGUOUS_STYLE 0x8        /* warn on discontiguous predicates */
  1238. #if O_STRING
  1239. #define O_STRING_STYLE        0x10    /* read ".." as string instead of list */
  1240. #endif /* O_STRING */
  1241. #define MAXNEWLINES        5        /* maximum number of newlines in atom */
  1242. #define SYSTEM_MODE        (debugstatus.styleCheck & DOLLAR_STYLE)
  1243.  
  1244. GLOBAL struct debuginfo
  1245. { long        skiplevel;        /* current skip level */
  1246.   bool        tracing;        /* are we tracing? */
  1247.   bool        debugging;        /* are we debugging? */
  1248.   ulong        leashing;        /* ports we are leashing */
  1249.   ulong        visible;        /* ports that are visible */
  1250.   int        style;            /* print style of tracer */
  1251.   bool        showContext;        /* tracer shows context module */
  1252.   int        styleCheck;        /* source style checking */
  1253.   int        suspendTrace;        /* tracing is suspended now */
  1254. } debugstatus;
  1255.  
  1256. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1257. Administration of loaded intermediate code files  (see  pl-wic.c).  Used
  1258. with the -c option to include all these if necessary.
  1259. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1260.  
  1261. typedef struct state * State;
  1262.  
  1263. struct state
  1264. { char *    name;            /* name of state */
  1265.   State        next;            /* next state loaded */
  1266. };
  1267.  
  1268. GLOBAL State stateList;            /* list of loaded states */
  1269.  
  1270. #if unix || EMX
  1271. GLOBAL struct
  1272. { handler_t os;                /* Os signal handler */
  1273.   handler_t user;            /* User signal handler */
  1274.   bool catched;                /* Prolog catches this one */
  1275. } signalHandlers[MAXSIGNAL];
  1276. #endif
  1277.  
  1278. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1279. Include debugging info to make it (very) verbose.  SECURE adds  code  to
  1280. check  consistency mainly in the WAM interpreter.  Prolog gets VERY slow
  1281. if SECURE is  used.   DEBUG  is  not  too  bad  (about  20%  performance
  1282. decrease).
  1283. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1284.  
  1285. #define REL(a)        ((Word)(a) - (Word)(lBase))
  1286.  
  1287. #if O_DEBUG
  1288. #define DEBUG(n, g) { if (status.debugLevel >= n) { g; fflush(stdout); } }
  1289. #else
  1290. #define DEBUG(a, b) 
  1291. #endif
  1292.  
  1293. /*#define SECURE(g) {g;}*/
  1294. #define SECURE(g)
  1295.  
  1296. #include "pl-os.h"            /* OS dependencies */
  1297. #include "pl-funcs.h"            /* global functions */
  1298. #include "pl-main.h"            /* Declarations needed by pl-main.c */
  1299.  
  1300. extern struct atom atoms[];
  1301. extern struct functorDef functors[];
  1302.  
  1303. #include "pl-atom.ih"
  1304. #include "pl-funct.ih"
  1305.