/* Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org Copyright (c) 1996-2020, University of Amsterdam CWI, Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Aim === Flexibel adaption to different memory model. Possible to make `clean' programs, i.e. programs that donot make assumptions on the memory model. The latter appears necessary on some systems to put Prolog into a DLL. Fast comparison and checking. The hope is that the result will have comparable or better speed. Approach ======== * No direct pointers in Prolog machine words anymore * Tags in the low bits to exploit SPARC and possible other machines fixed-width instruction, so masks can be loaded in one instead of two instructions. * Explicit encoding of the `user' data-types in the word, so PL_term_type() can be much faster. * Explicit encoding of the storage regime used, so more code can be generic. Types: ====== Sorted to standard order of terms: Storage places: S Static (global variable) L Local G Global T Trail - Inline INDEX STORAGE L G T S - I ------------------------------------------------------------- Var 0 - 00 Integer 1 G- 01 00 Float 2 G 01 Atom 3 S 00 String 4 G 01 List 5 G 01 Term 6 G 01 Reference 7 LG 10 01 ---------------------------------------------------------------- Adding 2 bits for the garbage collector, this adds up to 7-bits tag info, leaving us with 32-7 is 25 bits data, or: * Tagged ints from -16M to +16M * 128 MB per memory area, assuming all data is 4-byte aligned. Giving this, stacks can be freely shifted! Bit layout ========== * Value are the top-bits, so extracting the value is just a shift. * GC masks follow, so, as they are normally both 0, shifting suffices for this too. * Type is the low 3-bits, so a simple mask yields the type. * Storage in bits 4 and 5 Indirect data ============= * Using normal tag, but the storage-specifier is 0x3 (11). Tag is only INTEGER, STRING or FLOAT * Using value: size in words of the object * 4 * String uses the low-order 2 bits for specifying the amount of padding bytes (0-3, 0 means 4). NOTE: the tag-numbers are mapped to public constants (PL_*) in the type_map array in pl-fli.c. Make sure this is consistent with the definitions below. Also the tagtypeex[] array defined in pl-setup.c must be kept consistent. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #include "os/pl-buffer.h" #define LMASK_BITS 7 /* total # mask bits */ #define TAG_MASK 0x00000007L /* mask for tag */ #define TAG_VAR 0x00000000L /* tag for variable (= 0L) */ #define TAG_ATTVAR 0x00000001L /* tag for attributed variable */ #define TAG_FLOAT 0x00000002L /* Floating point number */ #define TAG_INTEGER 0x00000003L /* Tagged small int, 64-bit indirect, */ /* GMP mpz or mpq (rational) */ #define TAG_STRING 0x00000004L /* String */ #define TAG_ATOM 0x00000005L /* an atom */ #define TAG_COMPOUND 0x00000006L /* Compound term */ #define TAG_REFERENCE 0x00000007L /* Reference pointer */ /* Trail tag-bits */ #define TAG_TRAILMASK 0x00000001L /* mask for tag */ #define TAG_TRAILADDR 0x00000000L /* Trail-only: address */ #define TAG_TRAILVAL 0x00000001L /* Trail-only: value */ #define tagTrailPtr(p) ((Word)((uintptr_t)(p)|TAG_TRAILVAL)) #define isTrailVal(p) ((uintptr_t)(p)&TAG_TRAILVAL) #define trailValP(p) ((Word)((uintptr_t)(p)&~TAG_TRAILMASK)) #define trailVal(p) (*trailValP(p)) #define STG_MASK (0x3<<3) #define STG_STATIC (0x0<<3) /* storage masks */ #define STG_GLOBAL (0x1<<3) /* global stack */ #define STG_LOCAL (0x2<<3) /* local stack */ #define STG_RESERVED (0x3<<3) #define STG_INLINE STG_STATIC #define STG_TRAIL STG_STATIC #define MARK_MASK (0x1<<5) /* GC mark */ #define FIRST_MASK (0x2<<5) /* GC first mark */ #define set_marked(p) do { *(p) |= MARK_MASK; } while(0) #define set_first(p) do { *(p) |= FIRST_MASK; } while(0) #define clear_marked(p) do { *(p) &= ~MARK_MASK; } while(0) #define clear_first(p) do { *(p) &= ~FIRST_MASK; } while(0) #define clear_both(p) do { *(p) &= ~(FIRST_MASK|MARK_MASK); } while(0) #define is_marked(p) (*(p) & MARK_MASK) #define is_first(p) (*(p) & FIRST_MASK) #define is_marked_or_first(p) (*(p) & (MARK_MASK|FIRST_MASK)) #define tag(w) ((w) & TAG_MASK) #define storage(w) ((w) & STG_MASK) #define valPtrB(w, b) ((Word)(((w) >> 5) + (b))) #define valPtr2(w, s) valPtrB(w, LD->bases[s]) #define valPtr(w) valPtr2(w, storage(w)) #define valInt(w) ((intptr_t)(w) >> LMASK_BITS) #define valUInt(w) ((uintptr_t)(w) >> LMASK_BITS) /******************************* * EXTENDED TAG * *******************************/ #define EXBIT(w) (1<<(w)) #define INDIRECT_BM ( EXBIT(STG_GLOBAL|TAG_INTEGER) | \ EXBIT(STG_LOCAL|TAG_INTEGER) | \ EXBIT(STG_GLOBAL|TAG_FLOAT) | \ EXBIT(STG_LOCAL|TAG_FLOAT) | \ EXBIT(STG_GLOBAL|TAG_STRING) | \ EXBIT(STG_LOCAL|TAG_STRING) \ ) #define tagex(w) ((w) & (TAG_MASK|STG_MASK)) #define isIndirect(w) (EXBIT(tagex(w)) & INDIRECT_BM) /******************************* * BASIC TYPE TESTS * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - For atom, we use tagex() to avoid detecting functor_t on stacks. This is only important for the atom-garbage collector that must make this distinction while scanning the global stack as well as for record-keys and while loading .wic files. It comes at no price. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /*#define isVar(w) (tag(w) == TAG_VAR)*/ #define isVar(w) ((w) == (word)0) #define isAtom(w) (tagex(w) == (TAG_ATOM|STG_STATIC)) #define isFunctor(w) (tagex(w) == (TAG_ATOM|STG_GLOBAL)) #define isTextAtom(w) (isAtom(w) && true(atomValue(w)->type, PL_BLOB_TEXT)) #define isCallableAtom(w) (isTextAtom(w) || (w == ATOM_nil)) #define isRational(w) (tag(w) == TAG_INTEGER) #define isFloat(w) (tag(w) == TAG_FLOAT) #define isString(w) (tag(w) == TAG_STRING) #define isTerm(w) (tag(w) == TAG_COMPOUND) #define isConst(w) (isAtom(w) || isTaggedInt(w)) /* H_ATOM, B_ATOM, H_SMALLINT, B_SMALLINT */ #if O_BIGNUM #define isInteger(w) ( isTaggedInt(w) || \ ((tag(w) == TAG_INTEGER) && !isMPQNum(w)) ) #else #define isInteger(w) isRational(w) #endif /******************************* * REFERENCES * *******************************/ #define isRef(w) (tag(w) == TAG_REFERENCE) #define unRef(w) ((Word)valPtr2(w, STG_GLOBAL)) #define deRef(p) { while(isRef(*(p))) (p) = unRef(*(p)); } #define deRef2(p, d) { (d) = (p); deRef(d); } #define makeRefG(p) consPtr(p, TAG_REFERENCE|STG_GLOBAL) #ifdef O_ATTVAR #define needsRef(w) (tag(w) <= TAG_ATTVAR) #else #define needsRef(w) isVar(w) #endif /* We use local references during GC and shift */ #define makeRefLok(p) consPtr(p, TAG_REFERENCE|STG_LOCAL) #define makeRefLG(p) ((void*)(p) >= (void*)lBase ? makeRefLok(p) : makeRefG(p)) #define unRefLG(w) ((Word)valPtr(w)) /******************************* * COMPOUNDS AND LISTS * *******************************/ #define functorTerm(w) valueTerm(w)->definition #define arityTerm(w) arityFunctor(valueTerm(w)->definition) #define valueTerm(w) ((Functor)valPtr2(w, STG_GLOBAL)) #define hasFunctor(w,f) (isTerm(w) && valueTerm(w)->definition == (f)) #define argTerm(w, n) (valueTerm(w)->arguments[n]) #define argTermP(w, n) (&argTerm(w, n)) #define isList(w) hasFunctor(w, FUNCTOR_dot2) #define isNil(w) ((w) == ATOM_nil) /******************************* * ATTRIBUTED VARIABLES * *******************************/ #define isAttVar(w) (tag(w) == TAG_ATTVAR) #define valPAttVar(w) ((Word)valPtr2(w, STG_GLOBAL)) #define canBind(w) needsRef(w) /******************************* * INDIRECTS * *******************************/ #if SIZEOF_VOIDP == 4 /* extend as needed */ #define PADBITS 2 #else #if SIZEOF_VOIDP == 8 #define PADBITS 3 #endif #endif #define PADMASK (sizeof(word)-1) #define mkIndHdr(n, t) (((n)<<(LMASK_BITS+PADBITS)) | (t) | STG_LOCAL) #define wsizeofInd(iw) ((iw)>>(LMASK_BITS+PADBITS)) #define addressIndirect(w) valPtr(w) #define valIndirectP(w) (((Word)valPtr(w))+1) #define padHdr(iw) (((iw)>>LMASK_BITS & PADMASK) ? \ ((iw)>>LMASK_BITS & PADMASK) : sizeof(intptr_t)) #define mkPadHdr(n) (((n)&PADMASK) << LMASK_BITS) #define mkStrHdr(n,p) (mkIndHdr(n, TAG_STRING)|mkPadHdr(pad)) #define wsizeofIndirect(w) (wsizeofInd(*addressIndirect(w))) #define isTaggedInt(w) (tagex(w) == (TAG_INTEGER|STG_INLINE)) #define isBignum(w) (tagex(w) == (TAG_INTEGER|STG_GLOBAL) && \ wsizeofIndirect(w) == sizeof(int64_t)/sizeof(word)) #define MP_RAT_MASK (0x1) /* valBignum(w) and valFloat(w) moved to pl-inline.h */ #define isBString(w) (isString(w) && ((char *)valIndirectP(w))[0] == 'B') #define isWString(w) (isString(w) && ((char *)valIndirectP(w))[0] == 'W') /******************************* * VALUES * *******************************/ /* TODO: putting a prototype here to satisfy the compiler, but fetchAtomArray() * may want to be moved somewhere else. */ static inline Atom fetchAtomArray(size_t index); #define indexAtom(w) ((w)>>LMASK_BITS) #define atomValue(w) fetchAtomArray(indexAtom(w)) #define stringAtom(w) (atomValue(w)->name) #define valInteger(w) (storage(w) == STG_INLINE ? valInt(w) : valBignum(w)) /******************************* * FUNCTORS * *******************************/ #define F_ARITY_BITS 5 /* upto 32 inlined arity */ #define F_ARITY_MASK ((1<>(LMASK_BITS) & ((n)-1)) #define indexFunctor(w) ((w)>>(LMASK_BITS+F_ARITY_BITS)) #define valueFunctor(w) fetchFunctorArray(indexFunctor(w)) #define _arityFunc_(w) ((size_t)(((w) >> LMASK_BITS) & F_ARITY_MASK)) #define arityFunctor(w) (unlikely(_arityFunc_(w) == F_ARITY_MASK) \ ? valueFunctor(w)->arity \ : _arityFunc_(w) ) #define isAtomFunctor(w) (arityFunctor(w) == 0) #define nameFunctor(w) (valueFunctor(w)->name) /******************************* * DERIVED TESTS * *******************************/ #define nonvar(w) (!isVar(w)) #define isNumber(w) (isRational(w) || isFloat(w)) #define isAtomic(w) (!canBind(w) && !isTerm(w)) /******************************* * CREATING WORDS * *******************************/ #define MAXTAGGEDPTR (((word)1<<((8*sizeof(word))-5)) - 1) #define consInt(n) (((word)(n)<