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) 1996-2020, University of Amsterdam 7 CWI, Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34 */ 35 36 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 37 Aim 38 === 39 40 Flexibel adaption to different memory model. Possible to make `clean' 41 programs, i.e. programs that donot make assumptions on the memory model. 42 The latter appears necessary on some systems to put Prolog into a DLL. 43 44 Fast comparison and checking. The hope is that the result will have 45 comparable or better speed. 46 47 Approach 48 ======== 49 50 * No direct pointers in Prolog machine words anymore 51 52 * Tags in the low bits to exploit SPARC and possible other 53 machines fixed-width instruction, so masks can be loaded 54 in one instead of two instructions. 55 56 * Explicit encoding of the `user' data-types in the word, 57 so PL_term_type() can be much faster. 58 59 * Explicit encoding of the storage regime used, so more code 60 can be generic. 61 62 Types: 63 ====== 64 65 Sorted to standard order of terms: 66 67 Storage places: 68 69 S Static (global variable) 70 L Local 71 G Global 72 T Trail 73 - Inline 74 75 INDEX STORAGE L G T S - I 76 ------------------------------------------------------------- 77 Var 0 - 00 78 Integer 1 G- 01 00 79 Float 2 G 01 80 Atom 3 S 00 81 String 4 G 01 82 List 5 G 01 83 Term 6 G 01 84 Reference 7 LG 10 01 85 ---------------------------------------------------------------- 86 87 Adding 2 bits for the garbage collector, this adds up to 7-bits tag info, 88 leaving us with 32-7 is 25 bits data, or: 89 90 * Tagged ints from -16M to +16M 91 * 128 MB per memory area, assuming all data is 4-byte aligned. 92 93 Giving this, stacks can be freely shifted! 94 95 Bit layout 96 ========== 97 98 * Value are the top-bits, so extracting the value is just a 99 shift. 100 101 * GC masks follow, so, as they are normally both 0, shifting 102 suffices for this too. 103 104 * Type is the low 3-bits, so a simple mask yields the type. 105 106 * Storage in bits 4 and 5 107 108 Indirect data 109 ============= 110 111 * Using normal tag, but the storage-specifier is 0x3 (11). Tag 112 is only INTEGER, STRING or FLOAT 113 114 * Using value: size in words of the object * 4 115 116 * String uses the low-order 2 bits for specifying the amount of 117 padding bytes (0-3, 0 means 4). 118 119 NOTE: the tag-numbers are mapped to public constants (PL_*) in the 120 type_map array in pl-fli.c. Make sure this is consistent with the 121 definitions below. Also the tagtypeex[] array defined in pl-setup.c must 122 be kept consistent. 123 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 124 125 #include "os/pl-buffer.h" 126 127 #define LMASK_BITS 7 /* total # mask bits */ 128 129 #define TAG_MASK 0x00000007L /* mask for tag */ 130 #define TAG_VAR 0x00000000L /* tag for variable (= 0L) */ 131 #define TAG_ATTVAR 0x00000001L /* tag for attributed variable */ 132 #define TAG_FLOAT 0x00000002L /* Floating point number */ 133 #define TAG_INTEGER 0x00000003L /* Tagged or indirect integer */ 134 #define TAG_STRING 0x00000004L /* String */ 135 #define TAG_ATOM 0x00000005L /* an atom */ 136 #define TAG_COMPOUND 0x00000006L /* Compound term */ 137 #define TAG_REFERENCE 0x00000007L /* Reference pointer */ 138 139 /* Trail tag-bits */ 140 #define TAG_TRAILMASK 0x00000001L /* mask for tag */ 141 #define TAG_TRAILADDR 0x00000000L /* Trail-only: address */ 142 #define TAG_TRAILVAL 0x00000001L /* Trail-only: value */ 143 #define tagTrailPtr(p) ((Word)((uintptr_t)(p)|TAG_TRAILVAL)) 144 #define isTrailVal(p) ((uintptr_t)(p)&TAG_TRAILVAL) 145 #define trailValP(p) ((Word)((uintptr_t)(p)&~TAG_TRAILMASK)) 146 #define trailVal(p) (*trailValP(p)) 147 148 #define STG_MASK (0x3<<3) 149 #define STG_STATIC (0x0<<3) /* storage masks */ 150 #define STG_GLOBAL (0x1<<3) /* global stack */ 151 #define STG_LOCAL (0x2<<3) /* local stack */ 152 #define STG_RESERVED (0x3<<3) 153 154 #define STG_INLINE STG_STATIC 155 #define STG_TRAIL STG_STATIC 156 157 #define MARK_MASK (0x1<<5) /* GC mark */ 158 #define FIRST_MASK (0x2<<5) /* GC first mark */ 159 160 #define set_marked(p) do { *(p) |= MARK_MASK; } while(0) 161 #define set_first(p) do { *(p) |= FIRST_MASK; } while(0) 162 #define clear_marked(p) do { *(p) &= ~MARK_MASK; } while(0) 163 #define clear_first(p) do { *(p) &= ~FIRST_MASK; } while(0) 164 #define clear_both(p) do { *(p) &= ~(FIRST_MASK|MARK_MASK); } while(0) 165 #define is_marked(p) (*(p) & MARK_MASK) 166 #define is_first(p) (*(p) & FIRST_MASK) 167 #define is_marked_or_first(p) (*(p) & (MARK_MASK|FIRST_MASK)) 168 169 #define tag(w) ((w) & TAG_MASK) 170 #define storage(w) ((w) & STG_MASK) 171 #define valPtr2(w, s) ((Word)(((w) >> 5) + base_addresses[s])) 172 #define valPtr(w) valPtr2(w, storage(w)) 173 #define valInt(w) ((intptr_t)(w) >> LMASK_BITS) 174 #define valUInt(w) ((uintptr_t)(w) >> LMASK_BITS) 175 176 /******************************* 177 * EXTENDED TAG * 178 *******************************/ 179 180 #define EXBIT(w) (1<<(w)) 181 #define INDIRECT_BM ( EXBIT(STG_GLOBAL|TAG_INTEGER) | \ 182 EXBIT(STG_LOCAL|TAG_INTEGER) | \ 183 EXBIT(STG_GLOBAL|TAG_FLOAT) | \ 184 EXBIT(STG_LOCAL|TAG_FLOAT) | \ 185 EXBIT(STG_GLOBAL|TAG_STRING) | \ 186 EXBIT(STG_LOCAL|TAG_STRING) \ 187 ) 188 189 #define tagex(w) ((w) & (TAG_MASK|STG_MASK)) 190 #define isIndirect(w) (EXBIT(tagex(w)) & INDIRECT_BM) 191 192 193 /******************************* 194 * BASIC TYPE TESTS * 195 *******************************/ 196 197 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 198 For atom, we use tagex() to avoid detecting functor_t on stacks. This is 199 only important for the atom-garbage collector that must make this 200 distinction while scanning the global stack as well as for record-keys 201 and while loading .wic files. It comes at no price. 202 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 203 204 /*#define isVar(w) (tag(w) == TAG_VAR)*/ 205 #define isVar(w) ((w) == (word)0) 206 #define isAtom(w) (tagex(w) == (TAG_ATOM|STG_STATIC)) 207 #define isFunctor(w) (tagex(w) == (TAG_ATOM|STG_GLOBAL)) 208 #define isTextAtom(w) (isAtom(w) && true(atomValue(w)->type, PL_BLOB_TEXT)) 209 #define isCallableAtom(w) (isTextAtom(w) || (w == ATOM_nil)) 210 #define isRational(w) (tag(w) == TAG_INTEGER) 211 #define isFloat(w) (tag(w) == TAG_FLOAT) 212 #define isString(w) (tag(w) == TAG_STRING) 213 #define isTerm(w) (tag(w) == TAG_COMPOUND) 214 #define isConst(w) (isAtom(w) || isTaggedInt(w)) /* H_ATOM, B_ATOM, H_SMALLINT, B_SMALLINT */ 215 216 #ifdef O_GMP 217 #define isInteger(w) ( isTaggedInt(w) || \ 218 ((tag(w) == TAG_INTEGER) && !isMPQNum(w)) ) 219 #else 220 #define isInteger(w) isRational(w) 221 #endif 222 223 /******************************* 224 * REFERENCES * 225 *******************************/ 226 227 #define isRef(w) (tag(w) == TAG_REFERENCE) 228 #define isRefL(w) (tagex(w) == (TAG_REFERENCE|STG_LOCAL)) 229 #define unRef(w) ((Word)valPtr(w)) 230 #define unRefL(w) ((Word)valPtr2(w, STG_LOCAL)) 231 #define deRef(p) { while(isRef(*(p))) (p) = unRef(*(p)); } 232 #define deRef2(p, d) { (d) = (p); deRef(d); } 233 #define makeRefL(p) consPtr(p, TAG_REFERENCE|STG_LOCAL) 234 #define makeRefG(p) consPtr(p, TAG_REFERENCE|STG_GLOBAL) 235 #define makeRef(p) ((void*)(p) >= (void*)lBase ? makeRefL(p) : makeRefG(p)) 236 #ifdef O_ATTVAR 237 #define needsRef(w) (tag(w) <= TAG_ATTVAR) 238 #else 239 #define needsRef(w) isVar(w) 240 #endif 241 242 243 /******************************* 244 * COMPOUNDS AND LISTS * 245 *******************************/ 246 247 #define functorTerm(w) valueTerm(w)->definition 248 #define arityTerm(w) arityFunctor(valueTerm(w)->definition) 249 #define valueTerm(w) ((Functor)valPtr2(w, STG_GLOBAL)) 250 #define hasFunctor(w,f) (isTerm(w) && valueTerm(w)->definition == (f)) 251 #define argTerm(w, n) (valueTerm(w)->arguments[n]) 252 #define argTermP(w, n) (&argTerm(w, n)) 253 254 #define isList(w) hasFunctor(w, FUNCTOR_dot2) 255 #define isNil(w) ((w) == ATOM_nil) 256 257 /******************************* 258 * ATTRIBUTED VARIABLES * 259 *******************************/ 260 261 #define isAttVar(w) (tag(w) == TAG_ATTVAR) 262 #define valPAttVar(w) ((Word)valPtr2(w, STG_GLOBAL)) 263 264 #define canBind(w) needsRef(w) 265 266 267 /******************************* 268 * INDIRECTS * 269 *******************************/ 270 271 #if SIZEOF_VOIDP == 4 /* extend as needed */ 272 #define PADBITS 2 273 #else 274 #if SIZEOF_VOIDP == 8 275 #define PADBITS 3 276 #endif 277 #endif 278 279 #define PADMASK (sizeof(word)-1) 280 281 #define mkIndHdr(n, t) (((n)<<(LMASK_BITS+PADBITS)) | (t) | STG_LOCAL) 282 #define wsizeofInd(iw) ((iw)>>(LMASK_BITS+PADBITS)) 283 #define addressIndirect(w) valPtr(w) 284 #define valIndirectP(w) (((Word)valPtr(w))+1) 285 286 #define padHdr(iw) (((iw)>>LMASK_BITS & PADMASK) ? \ 287 ((iw)>>LMASK_BITS & PADMASK) : sizeof(intptr_t)) 288 #define mkPadHdr(n) (((n)&PADMASK) << LMASK_BITS) 289 #define mkStrHdr(n,p) (mkIndHdr(n, TAG_STRING)|mkPadHdr(pad)) 290 #define wsizeofIndirect(w) (wsizeofInd(*addressIndirect(w))) 291 292 #define isTaggedInt(w) (tagex(w) == (TAG_INTEGER|STG_INLINE)) 293 #define isBignum(w) (tagex(w) == (TAG_INTEGER|STG_GLOBAL) && \ 294 wsizeofIndirect(w) == sizeof(int64_t)/sizeof(word)) 295 296 #define MP_RAT_MASK (0x1) 297 #define isMPQNum(w) isMPQNum__LD(w PASS_LD) 298 #define isMPZNum(w) isMPZNum__LD(w PASS_LD) 299 300 #if ALIGNOF_INT64_T == ALIGNOF_VOIDP 301 #define valBignum(w) (*(int64_t *)valIndirectP(w)) 302 #else 303 #define valBignum(w) valBignum__LD(w PASS_LD) 304 #endif 305 #if ALIGNOF_DOUBLE == ALIGNOF_VOIDP 306 #define valFloat(w) (*(double *)valIndirectP(w)) 307 #else 308 #define valFloat(w) valFloat__LD(w PASS_LD) 309 #endif 310 311 #define isBString(w) (isString(w) && ((char *)valIndirectP(w))[0] == 'B') 312 #define isWString(w) (isString(w) && ((char *)valIndirectP(w))[0] == 'W') 313 314 /******************************* 315 * VALUES * 316 *******************************/ 317 318 #define indexAtom(w) ((w)>>LMASK_BITS) 319 #define atomValue(w) fetchAtomArray(indexAtom(w)) 320 #define stringAtom(w) (atomValue(w)->name) 321 #define valInteger(w) (storage(w) == STG_INLINE ? valInt(w) : valBignum(w)) 322 323 /******************************* 324 * FUNCTORS * 325 *******************************/ 326 327 #define F_ARITY_BITS 5 /* upto 32 inlined arity */ 328 #define F_ARITY_MASK ((1<<F_ARITY_BITS)-1) 329 #define MK_FUNCTOR(n, a) (functor_t)(((((n)<<F_ARITY_BITS)|(a))<<LMASK_BITS) | \ 330 TAG_ATOM|STG_GLOBAL) 331 #define functorHashValue(f, n) ((f)>>(LMASK_BITS) & ((n)-1)) 332 #define indexFunctor(w) ((w)>>(LMASK_BITS+F_ARITY_BITS)) 333 #define valueFunctor(w) fetchFunctorArray(indexFunctor(w)) 334 #define _arityFunc_(w) ((size_t)(((w) >> LMASK_BITS) & F_ARITY_MASK)) 335 #define arityFunctor(w) (unlikely(_arityFunc_(w) == F_ARITY_MASK) \ 336 ? valueFunctor(w)->arity \ 337 : _arityFunc_(w) ) 338 #define isAtomFunctor(w) (arityFunctor(w) == 0) 339 #define nameFunctor(w) (valueFunctor(w)->name) 340 341 /******************************* 342 * DERIVED TESTS * 343 *******************************/ 344 345 #define nonvar(w) (!isVar(w)) 346 #define isNumber(w) (isRational(w) || isFloat(w)) 347 #define isAtomic(w) (!canBind(w) && !isTerm(w)) 348 349 350 /******************************* 351 * CREATING WORDS * 352 *******************************/ 353 354 #define MAXTAGGEDPTR (((word)1<<((8*sizeof(word))-5)) - 1) 355 356 #define consInt(n) (((word)(n)<<LMASK_BITS) | TAG_INTEGER) 357 #define consUInt(n) (((word)(n)<<LMASK_BITS) | TAG_INTEGER) 358 359 360