/*!# Otus Lisp
 * ```
 *                     small,
 *         `___`           embeddable
 *         (O,O)               and
 *         \)  )            purely
 *       ---"-"---       functional!
 * 
 * Copyright(c) 2014 - 2026 Yuriy Chumak
 * ```
 * *Based on Aki Helin's [Owl-Lisp](https://gitlab.com/owl-lisp/owl)*
 * - - -
 *
 * ## LICENSES
 * You are free to choose an MIT or LGPLv3 license.
 * 
 * * MIT:  
 *   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 *   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 *   OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 *   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
 *   ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 *   TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 *   SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 * 
 * * LGPLv3:  
 *   This program is free software;  you can redistribute it and/or
 *   modify it under the terms of the GNU General Public License as
 *   published by the Free Software Foundation; either version 3 of
 *   the License, or (at your option) any later version.
 *
 *   This program is distributed in the hope that it will be useful,
 *   but WITHOUT ANY WARRANTY; without even the implied warranty of
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 *
 * ## BUILD
 * `make; make install`
 *
 * ## THE PROJECT
 * - https://github.com/yuriy-chumak/ol
 * - https://yuriy-chumak.github.io/ol/
 */

#ifndef __OLVM_H__
#define __OLVM_H__


/*!- - -
 * ## Otus Lisp Virtual Machine
 * ### Source file: src/olvm.c
 */
#include <stdlib.h>

#include <stdint.h>

// unsigned int that is capable of storing a pointer
// основной data type, зависит от разрядности машины
typedef uintptr_t word;

// arm, armv7-a, armv8-a: 4; aarch64: 8;
// risc-v 32: 4;           risc-v 64: 8;
// wasm:      4;
// x86:       4;              x86-64: 8;
// mips:      4;              mips64: 8;
// ppc:       4;      ppc64, ppc64le: 8;

// raspberty pi: armv8
// apple m1: aarch64


// OL Virtual Machine type
typedef struct olvm_t olvm_t;

// -----------------------------------------------------
// PUBLIC API:

olvm_t* OLVM_new(unsigned char* bootstrap);
void OLVM_delete(olvm_t* ol);
word OLVM_run(olvm_t* ol, int argc, char** argv);
word OLVM_evaluate(olvm_t* ol, word function, int argc, word* argv);

void*OLVM_userdata(olvm_t* ol, void* userdata);
void*OLVM_allocate(olvm_t* ol, unsigned words);

// pinned objects support functions
#ifndef OLVM_NOPINS
# ifndef OLVM_PIN_PROTOTYPES
size_t OLVM_pin(olvm_t* ol, word ref); // pin can realloc RPS (Register and Pin Set)
word OLVM_deref(olvm_t* ol, size_t p);
word OLVM_unpin(olvm_t* ol, size_t p);
# else
typedef size_t (*olvm_pin_t)(olvm_t* ol, word ref); extern olvm_pin_t   OLVM_pin;
typedef word (*olvm_deref_t)(olvm_t* ol, size_t p); extern olvm_deref_t OLVM_deref;
typedef word (*olvm_unpin_t)(olvm_t* ol, size_t p); extern olvm_unpin_t OLVM_unpin;
# endif
#endif

// ffi callbacks support
word OLVM_apply(olvm_t* ol, word function, word args);

// embed type conversion helpers
# ifndef OLVM_FCONV_PROTOTYPES
float OL2F(word arg);
double OL2D(word arg);
# else
typedef float (*ol2f_t)(word arg);                  extern ol2f_t OL2F;
typedef double (*ol2d_t)(word arg);                 extern ol2d_t OL2D;
#endif

// -=( OLVM Description )=----------------------------------------------------
//
// descriptor format
// заголовок объекта, находится по адресу 0 (ob[0], *ob):
//  [s...sss ????rppp tttttt10] // bit 2 у заголовков всегда выставлен в 1 (используется GC)
//   '-----| '--||'-| '----|
//         |    ||  |      '-----> tttttt,  object type
//         |    ||  '------------> ppp,     number of padding (unused) bytes at the end of object, if raw (0-(wordsize-1))
//         |    |'---------------> r,       rawness bit (raw objects have no references(pointers) in them)
//         |    '----------------> ????,    your tags here! e.g. tag for closing file descriptors in gc, etc. not used for now
//         '---------------------> s...sss, object size in words
//
// а это то, что лежит в объектах (ob[1], ob[2], ...) - либо непосредственные значения, либо указатели на другие объекты:
//                       .------------> value, if 'v' is set
//                       |      .-----> type, if 'v' is set
//                       |      |.----> 'value' bit
//   .-------------------| .----||.---> mark bit (can be 1 only during gc process)
//  [... pppppppp pppppppp ttttttv0]
//   '----------------------------|
//                                '-----> word aligned pointer if not a value ('v' cleared) (4- or 8-byte)
//      младшие 2 нулевые бита для указателя (mark бит снимается при работе) позволяют работать только с выравненными
//       внутренними указателями - таким образом, ВСЕ объекты в куче выравнены по границе слова
//
//
// todo: вот те 4 бита можно использовать для кастомных типов,
// например, в спецполя складывать id функции, что вызывает mark для подпоинтеров,
//	         и ptr на функцию, что делает финализацию.
// todo: move "r" bit left to allow 128-bit machines

//efine IPOS      8  // === bits offset of (struct value_t, value), deprecated name
#define VPOS      8  // === bits offset of (struct value_t, value)

#define TPOS      2  // === bits offset of (struct header_t, type) and (struct value_t, type)
#define PPOS      8  // === bits offset of (struct header_t, padding)
#define RPOS     11  // === bits offset of (struct header_t, rawness)
#define SPOS     16  // === bits offset of (struct header_t, size)

// ---==( value_t )==---
// immediate value
struct __attribute__ ((aligned(sizeof(word)), packed))
value_t
{
	unsigned char mark : 1;    // always 0, (1 only during GC) =
	unsigned char v    : 1;    // always 1                      } 8 bits
	unsigned char type : 6;    // value type                   =

	unsigned char value[sizeof(word) - 1];
};

// some critical vm limitations:
//static_assert(sizeof(struct value_t) == sizeof(word), "Size of value_t structure should be equal to size of virtual machine word");


// ---==( reference_t )==---
// pointer to the object_t
struct __attribute__ ((aligned(sizeof(word)), packed))
reference_t
{
	union {
		struct {
			unsigned mark : 1;    // always 0, (1 only during GC)
			unsigned v    : 1;    // always 0
		};
		uintptr_t ptr; // btw, normally lower two bits is always 0, so this pointer always word-aligned
	};
};

// some critical vm limitations:
//static_assert(sizeof(struct reference_t) == sizeof(word), "Size of reference_t structure should be equal to size of virtual machine word");


// ---==( object_t )==---
struct __attribute__ ((aligned(sizeof(word)), packed))
object_t
{
	union {
		struct header_t {
			unsigned char mark : 1;    // always 0, (1 only during GC) =
			unsigned char i    : 1;    // always 1, (0 only during GC) = 8 bits
			unsigned char type : 6;    // object type                  =

			unsigned char padding : 3; // number of padding (empty) bytes after the end of reasonable object data
			unsigned char rawness : 1; // 1 for raw stream, 0 for vectors (tuples)
				               // : 4; // reserved bits bits

			unsigned char size[sizeof(word) - 2]; // object size in words, including header one
		} header;
		word ref[1]; // we don't like empty objects
	};
};

// some critical vm limitations:
//static_assert(sizeof(struct object_t) == sizeof(word), "Minimal size of object_t structure should be equal to size of virtual machine word");


// ------------------------------------------------------
// ANSI integers - 
#ifndef OLVM_ANSI_INT_LIMITS
#define OLVM_ANSI_INT_LIMITS 1
#endif

// floating point numbers (inexact numbers in terms of Scheme) support
#ifndef OLVM_INEXACTS
#define OLVM_INEXACTS 1
#endif

#ifndef OLVM_INEXACT_TYPE
#	define inexact_t double
#else
#	define inexact_t OLVM_INEXACT_TYPE
#endif

#include <limits.h>
#include <assert.h>

// only 32- and 64-bit machines supported.
// https://gcc.gnu.org/onlinedocs/gccint/Machine-Modes.html
// define internal math types based on sizeof(size_t):
#if __UINTPTR_MAX__ == 0xffffffffU
	typedef signed int_t __attribute__ ((mode (SI))); // four-byte integer (32 bits)
	typedef unsigned big_t __attribute__ ((mode (DI))); // eight-byte integer (64 bits)
#elif __UINTPTR_MAX__ == 0xffffffffffffffffU
	typedef signed int_t __attribute__ ((mode (DI))); // eight-byte integer (64 bits)
	//typedef unsigned big_t __attribute__ ((mode (TI))); (is not supported everywhere)
	#define big_t __int128                        // sixteen-byte integer (128 bits)
#else
#	error Unsupported platform bitness, only 32- and 64-bit versions are supported!
#endif

// ------------------------------------------------------

#define VBITS                       ((sizeof (word) * 8) - 8) // bits in Value (short number aka 'enum')
#define VSIZE                       ((sizeof (word) * 8) - 8) // bits in Value (short number aka 'enum')
#define HIGHBIT                     ((int_t)1 << VSIZE) // maximum Value value + 1
#define VMAX                        (HIGHBIT - 1)       // maximum Value value (and most negative value)

#define RAWBIT                      (1 << RPOS) // todo: rename to BSBIT (rawstream bit)
#define BINARY                      (RAWBIT >> TPOS)

// create a value
#define make_value(type, value)     (2 | ((type) << TPOS) | ((word)(value) << VPOS))

// header making macro
#define header3(type, size, padding)(2 | ((type) << TPOS) | ((word) (size) << SPOS) | RAWBIT | ((padding) << PPOS))
#define header2(type, size)         (2 | ((type) << TPOS) | ((word) (size) << SPOS))

#define HEADER_MACRO(_1, _2, _3, NAME, ...) NAME
#define make_header(...)            HEADER_MACRO(__VA_ARGS__, header3, header2, NOTHING, NOTHING)(__VA_ARGS__)


// three main classes:
#define is_value(x)                 (((V)(x)) & 2)
#define is_reference(x)             (!is_value(x))
#define is_rawstream(x)             ((*(R)(x)) & RAWBIT) //((struct object_t*)(x))->rawness // ((*(word*)(x)) & RAWBIT)

#define W                           (sizeof (word))

#define WORDS(x)                    (((x) + W - 1) / W)
#define WPADS(x)                    (WORDS (x) * W - x) // (W - (x % W));

// V means Value
typedef word V;
// makes positive olvm integer value from int
#define I(val) \
		(make_value(TENUMP, val)) // === (value << VPOS) | 2

#define I0 I(0)
#define I1 I(1)
#define I2 I(2)
#define I3 I(3)
#define I4 I(4)
#define I5 I(5)

// R means Reference
typedef word* R;
// makes olvm reference from system pointer (and do sanity check in DEBUG mode)
#define reference(v) ({\
		word _reference = (word)(v);\
		assert (!(_reference & (W-1)) && "olvm references must be aligned to word boundary");\
		(word*) _reference; })

// всякая всячина:
#define header_size(x)              (((word)(x)) >> SPOS) // header_t(x).size
#define header_pads(x)              (unsigned) ((((word)(x)) >> VPOS) & 7) // header_t(x).padding

#define value_type(x)               (unsigned) ((((word)(x)) >> TPOS) & 0x3F)
#define reference_type(x)           (value_type (*reference(x)))

#define object_size(x)              ({ word* _o = (word*)(x); header_size(*_o); })
#define object_pads(x)              ({ word* _o = (word*)(x); header_pads(*_o); })
#define reference_size(x)           ({ word* _r = (word*)(x); header_size(*_r) - 1; })
#define rawstream_size(x)           ({ word* _r = (word*)(x);(header_size(*_r) - 1) * sizeof(word) - header_pads(*_r); })
#define payload_offset(x)           (((word)(x)) + 1)


// types. 6 bits for type:
// octal: -----------------------------------------------
//         0, 1, 2, 3, 4, 5,  ,  ,  ,  ,  ,  ,12,13,  ,  ;
//        16,17,18,19,  ,21,  ,  ,24,25,26,27,  ,  ,  ,31;
//        32,  ,  ,  ,  ,  ,  ,  ,40,41,42,43,44,  , F, F;  46,47=floats
//        48,49, F, F, F, F, F, F, F, F, F, F, F,  , F,63.  48=void,49=void*(vptr), 63=constructor/any
//        -----------------------------------------------
//  40+ lisp numeric types
//  50+ ffi numeric types
#define TPAIR                       (1)  // type-pair
#define TVECTOR                     (2)  // type-vector
#define TSTRING                     (3)  // type-string
#define TSYMBOL                     (4)  // type-symbol
#define TSTRINGWIDE                 (5)  // type-string-wide
#define TNAME                       (9)  // type-name // experimental type

#define TPORT                       (12) // type-port
#define TCONST                      (13) // type-const

#define TBYTECODE                   (16) // type-bytecode
#define TPROCEDURE                  (17) // type-procedure
#define TCLOSURE                    (18) // type-closure
#define TCONSTRUCTOR                (63) // type-constructor

#define TFF                         (24) // 25, 26 are same
#	define TRIGHT                     1  // flags for TFF
#	define TRED                       2
// static_assert (TFF & ~3 == TFF);

#define TBYTEVECTOR                 (19) // type-bytevector
#define TSTRINGSUPER                (21) // type-superstring

#define TVECTORLEAF                 (11) // type-vector-leaf
#define TVECTORDISPATCH             (15) // type-vector-dispatch

#define TTHREAD                     (31) // type-thread-state

// numbers (value type)
// An ENUM is an exact integer that is small enough to fit in a machine word.
// todo: rename TINT to TLARGE or TLARGEINT
// TODO: rename TENUM to TINT, and TINT to TLONG
#define TENUMP                       (0) // type-value+ // small integer(s)
#define TENUMN                      (32) // type-value-
// numbers (reference type)
#define TINTP                       (40) // type-integer+ // large integer(s)
#define TINTN                       (41) // type-integer-
#define TRATIONAL                   (42) // type-rational
#define TCOMPLEX                    (43) // type-complex
#define TINEXACT                    (44) // type-inexact, IEEE-754

#define TVPTR                       (49) // void*, only RAW
#define TCALLABLE                   (61) // type-callable, receives '(description . callable-lambda)
#define TDLSYM                      (62) // type-dlsym, temp name

//#define likely(x)                   __builtin_expect((x), 1)
//#define unlikely(x)                 __builtin_expect((x), 0)

#define is_enump(ob)                (is_value(ob)     && value_type (ob) == TENUMP)
#define is_enumn(ob)                (is_value(ob)     && value_type (ob) == TENUMN)
#define is_enum(ob)                 (is_enump(ob) || is_enumn(ob))
#define is_const(ob)                (is_value(ob)     && value_type (ob) == TCONST)
#define is_pair(ob)                 (is_reference(ob) && (*(word*) (ob)) == make_header(TPAIR,     3))
#define is_npairp(ob)               (is_reference(ob) && (*(word*) (ob)) == make_header(TINTP,     3))
#define is_npairn(ob)               (is_reference(ob) && (*(word*) (ob)) == make_header(TINTN,     3))
#define is_rational(ob)             (is_reference(ob) && (*(word*) (ob)) == make_header(TRATIONAL, 3))
#define is_complex(ob)              (is_reference(ob) && (*(word*) (ob)) == make_header(TCOMPLEX,  3))
#define is_inexact(ob)              (is_reference(ob) && (*(word*) (ob)) == make_header(TINEXACT,  1 + WORDS(sizeof(inexact_t)), WPADS(sizeof(inexact_t))))

#define is_string(ob)               (is_reference(ob) && reference_type (ob) == TSTRING)
#define is_vector(ob)               (is_reference(ob) && reference_type (ob) == TVECTOR)
#define is_thread(ob)               (is_reference(ob) && reference_type (ob) == TTHREAD)

#define is_vptr(ob)                 (is_reference(ob) && (*(word*) (ob)) == make_header(TVPTR,     2, 0))
#define is_callable(ob)             (is_reference(ob) && (*(word*) (ob)) == make_header(TCALLABLE, 2, 0))
#define is_dlsym(ob)                (is_reference(ob) && (*(word*) (ob)) == make_header(TDLSYM,    3, 0))

#define is_numberp(ob)              (is_enump(ob) || is_npairp(ob))
#define is_numbern(ob)              (is_enumn(ob) || is_npairn(ob))
#define is_number(ob)               (is_numberp(ob) || is_numbern(ob))
#define is_integer(ob)              (is_numberp(ob) || is_numbern(ob))

#define is_boolean(ob)              ((ob == ITRUE) || (ob == IFALSE))

// взять значение аргумента:
#define value(v)                    ({ word x = (word)(v); /*assert(is_value(x));*/     (((word)(x)) >> VPOS); })
#define deref(v)                    ({ word x = (word)(v); assert(is_reference(x)); *(word*)(x); })

#define ref(ob, n)                  ((reference(ob))[n])
#define car(ob)                     (ref(ob, 1))
#define cdr(ob)                     (ref(ob, 2))
#define payload(o)                  &car(o)

#define caar(o)                     car(car (o))
#define cadr(o)                     car(cdr (o))
#define cdar(o)                     cdr(car (o))
#define cddr(o)                     cdr(cdr (o))

// constants:
#define IFALSE    make_value(TCONST, 0)  // #false, false value
#define ITRUE     make_value(TCONST, 1)  // #true, non false value
#define INULL     make_value(TCONST, 2)  // #null, empty list, '()
#define IEMPTY    make_value(TCONST, 3)  // #empty, empty ff, {}
#define IEOF      make_value(TCONST, 4)  // #eof, end of file
// olvm internal, not exposed to the ol
#define IEXIT     make_value(TCONST, 5)  // end of thread/program
#define IRETURN   make_value(TCONST, 6)  // end of thunk, return value

#define RFALSE    ((R)IFALSE)
#define RTRUE     ((R)ITRUE)
#define RNULL     ((R)INULL)
#define REMPTY    ((R)IEMPTY)
#define REOF      ((R)IEOF)

// ------- service functions ------------------
void E(char* format, ...);
#ifdef NDEBUG
#	define D(...)
#else
#	define D(...) E(__VA_ARGS__)
#endif

// --------- memory ---------------------------
// -----------------------------------------------------//--------------------
// -=( GC )=------------------------------------------------------------------

/*** Garbage Collector,
 * based on "Efficient Garbage Compaction Algorithm" by Johannes Martin (1982)
 **/
// "на почитать" по теме GC:
// shamil.free.fr/comp/ocaml/html/book011.html

// память машины, управляемая сборщиком мусора
// TODO?: усложнить, разделив на две - кучу больших объектов и кучу маленьких
struct heap_t
{
	// new (size) === { *(size*)fp; fp += size; }
	word *fp;        // allocation pointer

	// always: begin <= genstart <= end
	word *begin;     // begin of heap
	word *end;       // end of heap
	word *genstart;  // young generation begin pointer

	size_t padding;  // safe padding area
	size_t minimal;  // minimal memory space data

	// вызвать GC если в памяти мало места (в словах)
	// для безусловного вызова передать 0
	// возвращает 1, если была проведена сборка
	int (*gc)(struct olvm_t* ol, long ws);
};
typedef struct heap_t heap_t;


// -= new =--------------------------------------------
// выделить блок памяти, unsafe
// size is a payload size, not a size of whole object
// so in fact we'r allocating (size+1) words
#define NEW(size) ({ \
	word* _addr = fp;\
	fp += (size) + 1;\
	/*return*/ _addr;\
})

// аллоцировать новый объект (указанного типа)
#define NEW_OBJECT(type, size) ({\
word*_o = NEW (size);\
	*_o = make_header(type, 1+(size));\
	/*return*/ _o;\
})

// аллоцировать новый "бинарный" объект (указанного типа),
//  данные объекта не проверяются сборщиком мусора и не
//  могут содержать другие объекты!
#define NEW_BINARY(type, size, pads) ({\
word*_b = NEW (size);\
	*_b = make_header(type, 1+(size), pads);\
	/*return*/ _b;\
})

// new(size) - allocate memory, without type;
//             size is payload size, not whole object with header size
//             so, we can't create real 0-sized invalid objects
// new(type, size) - allocate object, with type
// new(type, size, pads) - allocate binary, with type, size in words and pads
#define NEW_MACRO(_1, _2, _3, NAME, ...) NAME
#define new(...) NEW_MACRO(__VA_ARGS__, NEW_BINARY, NEW_OBJECT, NEW, NOTHING)(__VA_ARGS__)

// allocate raw memory block
#define new_alloc(type, length) ({\
	int _size = (length);\
	int _words = WORDS(_size);\
	int _pads = WPADS(_size);\
	\
word* p = new (type, _words, _pads);\
	/*return*/ p;\
})

// -= ports =-------------------------------------------
// создает порт, возможно аллоцирует память

// it's safe (posix uses int as io handles)
#define is_port(ob)  ((is_value(ob)     && value_type(ob)     == TPORT) ||\
                      (is_reference(ob) && reference_type(ob) == TPORT))
#define make_port(a) ({ word _p = (word)a; assert (((word)_p << VPOS) >> VPOS == (word)_p); make_value(TPORT, _p); })
#define port(o)      ({ word _p = (word)o; is_value(_p) ? value(_p) : car(_p); })

#define new_port(arg1) ({ \
	word _arg1 = (word) (arg1);\
	/* точка следования */\
word*_port = new (TPORT, 1, 0);\
	_port[1] = _arg1;\
	/*return*/ _port;\
})


// -= new_pair =----------------------------------------

// предвычисляем a1 и a2 перед тем, как выделим память, так
// как они в свою очередь могут быть аллоцируемыми объектами.
#define NEW_TYPED_PAIR(type, a1, a2) ({\
	word data1 = (word) a1;\
	word data2 = (word) a2;\
	/* точка следования */ \
word*p = NEW_OBJECT (type, 2);\
	p[1] = data1;\
	p[2] = data2;\
	/*return*/ p;\
})

#define NEW_PAIR(a1, a2) NEW_TYPED_PAIR(TPAIR, a1, a2)

#define NEW_PAIR_MACRO(_1, _2, _3, NAME, ...) NAME
#define new_pair(...) NEW_PAIR_MACRO(__VA_ARGS__, NEW_TYPED_PAIR, NEW_PAIR, NOTHING, NOTHING)(__VA_ARGS__)

#define cons(a, b) new_pair(a, b)

// -= new_list =----------------------------------------
// аллокаторы списоков (ставить в качестве типа частей TPAIR! так как часть списка - список)

#define new_list2(type, a1) \
	new_pair (type, a1, INULL)
#define new_list3(type, a1, a2) \
	new_pair (type,\
		a1, new_pair (TPAIR,\
			a2, INULL))
#define new_list4(type, a1, a2, a3) \
	new_pair (type,\
		a1, new_pair (TPAIR,\
			a2, new_pair (TPAIR,\
				a3, INULL)))
#define new_list5(type, a1, a2, a3, a4) \
	new_pair (type,\
		a1, new_pair (TPAIR,\
			a2, new_pair (TPAIR,\
				a3, new_pair (TPAIR,\
					a4, INULL))))
#define new_list6(type, a1, a2, a3, a4, a5) \
	new_pair (type,\
		a1, new_pair (TPAIR,\
			a2, new_pair (TPAIR,\
				a3, new_pair (TPAIR,\
					a4, new_pair (TPAIR,\
						a5, INULL)))))

#define NEW_LIST(_1, _2, _3, _4, _5, _6, NAME, ...) NAME
#define new_list(...) NEW_LIST(__VA_ARGS__, new_list6, new_list5, new_list4, new_list3, new_list2, NOTHING, NOTHING)(__VA_ARGS__)

// -= vector =---------------------------------------

#define new_vector1(a1) ({\
	word data1 = (word) (a1);\
	/* точка следования */ \
word*p = new (TVECTOR, 1);\
	p[1] = data1;\
	/*return*/ p;\
})
#define new_vector2(a1,a2) ({\
	word data1 = (word) (a1);\
	word data2 = (word) (a2);\
	/* точка следования */ \
word*p = new (TVECTOR, 2);\
	p[1] = data1;\
	p[2] = data2;\
	/*return*/ p;\
})
#define new_vector3(a1,a2,a3) ({\
	word data1 = (word) (a1);\
	word data2 = (word) (a2);\
	word data3 = (word) (a3);\
	/* точка следования */ \
word*p = new (TVECTOR, 3);\
	p[1] = data1;\
	p[2] = data2;\
	p[3] = data3;\
	/*return*/ p;\
})
#define new_vector5(a1,a2,a3,a4,a5) ({\
	word data1 = (word) (a1);\
	word data2 = (word) (a2);\
	word data3 = (word) (a3);\
	word data4 = (word) (a4);\
	word data5 = (word) (a5);\
	/* точка следования */ \
word*p = new (TVECTOR, 5);\
	p[1] = data1;\
	p[2] = data2;\
	p[3] = data3;\
	p[4] = data4;\
	p[5] = data5;\
	/*return*/ p;\
})
#define new_vector9(a1,a2,a3,a4,a5,a6,a7,a8,a9) ({\
	word data1 = (word) a1;\
	word data2 = (word) a2;\
	word data3 = (word) a3;\
	word data4 = (word) a4;\
	word data5 = (word) a5;\
	word data6 = (word) a6;\
	word data7 = (word) a7;\
	word data8 = (word) a8;\
	word data9 = (word) a9;\
	/* точка следования */ \
word*p = new (TVECTOR, 9);\
	p[1] = data1;\
	p[2] = data2;\
	p[3] = data3;\
	p[4] = data4;\
	p[5] = data5;\
	p[6] = data6;\
	p[7] = data7;\
	p[8] = data8;\
	p[9] = data9;\
	/*return*/ p;\
})
#define new_vector13(a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13) ({\
	word data1 = (word) a1;\
	word data2 = (word) a2;\
	word data3 = (word) a3;\
	word data4 = (word) a4;\
	word data5 = (word) a5;\
	word data6 = (word) a6;\
	word data7 = (word) a7;\
	word data8 = (word) a8;\
	word data9 = (word) a9;\
	word data10 = (word) a10;\
	word data11 = (word) a11;\
	word data12 = (word) a12;\
	word data13 = (word) a13;\
	/* точка следования */ \
word*p = new (TVECTOR, 13);\
	p[1] = data1;\
	p[2] = data2;\
	p[3] = data3;\
	p[4] = data4;\
	p[5] = data5;\
	p[6] = data6;\
	p[7] = data7;\
	p[8] = data8;\
	p[9] = data9;\
	p[10] = data10;\
	p[11] = data11;\
	p[12] = data12;\
	p[13] = data13;\
	/*return*/ p;\
})

#define NEW_TUPLE(_1, _2, _3, _4, _5, _6, _7, _8, _9, _10, _11, _12, _13, NAME, ...) NAME
#define new_vector(...) NEW_TUPLE(__VA_ARGS__, new_vector13, new_vector12, new_vector11,\
			new_vector10, new_vector9, new_vector8, new_vector7, new_vector6, new_vector5,\
			new_vector4, new_vector3, new_vector2, new_vector1, NOTHING)(__VA_ARGS__)


// -= числа =------------------------
// todo: потом переделать в трюк
// ! трюк, в общем, не нужен. gcc вполне неплохо сам оптимизирует код (на x64, например, использует cmov)
// алгоритмические трюки:
// (-1)^t*x === (x xor t) - t, где t - y >>(s) 31 (все 1, или все 0)

// i - machine integer
// ui - unsigned, si - signed
// v - value number (internal, that fits in one register), type-enum
//  or small numbers,
//  or short numbers
// uv, sv - unsigned/signed respectively.
// Z - mножество целых чисел.

// работа с numeric value типами

// todo: check this automation - ((struct value)(v).sign) ? -uvtoi (v) : uvtoi (v);
#define enum(v) \
	({  word _x1 = (word)(v);    \
		assert(is_enum(_x1));     \
		int_t y1 = (_x1 >> VPOS);\
		value_type (_x1) == TENUMN ? -y1 : y1; \
	})//(x1 & 0x80) ? -y1 : y1;
#define make_enum(v) \
	(word)({ int_t x4 = (int_t)(v);  (x4 < 0) ? (-x4 << VPOS) | 0x82 : (x4 << VPOS) | 2/*make_value(-x4, TENUMN) : make_value(x4, TENUMP)*/; })
#define make_enump(v) I(v)
// todo: check this automation - ((struct value)(v).sign) ? -uvtoi (v) : uvtoi (v);

// MATH
// todo: потом переделать в трюк
// ! трюк, в общем, не нужен. gcc вполне неплохо сам оптимизирует код (на x64, например, использует cmov)
// алгоритмические трюки:
// x = (x xor t) - t, где t - y >>(s) 31 (все 1, или все 0)
// signed enum to int

// i - machine integer
// ui - unsigned, si - signed
// v - value number (internal, that fits in one register), type-enum
//  or small numbers,
//  or short numbers
// uv, sv - unsigned/signed respectively.
// Z - mножество целых чисел.

// арифметика целых (возможно больших)

// something wrong?: looks like __builtin_choose_expr doesn't work as expected!
#ifndef __GNUC__
#define __builtin_choose_expr(const_exp, exp1, exp2) (const_exp) ? (exp1) : (exp2)
#endif

// olvm numbers management:
// if value size less than word size then we no need to alloc memory in heap
// if value size equal to word size then we need only two words in memory in worst case
// if value size greater to word size then we need only three words in memory in worst case

#define new_unumber(val)  ({ \
	__builtin_choose_expr(sizeof(val) < sizeof(word), \
		(word*)make_enump(val), \
	__builtin_choose_expr(sizeof(val) > sizeof(word), \
		(word*)({ \
			big_t _x = (val); \
			(_x < (big_t)HIGHBIT) ? \
					(word)make_enump(_x): \
			(_x < (big_t)HIGHBIT*(big_t)HIGHBIT) ? \
					(word)new_list(TINTP, \
							make_enump(_x & VMAX), \
							make_enump(_x >> VBITS)): \
					(word)new_list(TINTP, \
							make_enump(_x & VMAX), \
							make_enump((_x >> VBITS) & VMAX), \
							make_enump((_x >> VBITS) >> VBITS)); \
		}), \
	/* else: sizeof(val) == sizeof(word) */ \
		(word*)({ \
			word _x = (word)(val); \
			(_x < HIGHBIT) ? \
					(word)make_enump(_x): \
					(word)new_list(TINTP, \
							make_enump(_x & VMAX), \
							make_enump(_x >> VBITS)); \
		})\
	));})

// special case (_v == INT_?_MIN) if OLVM_ANSI_INT_LIMITS:
//   val == minimal applicable integer for selected word width (INT_?_MIN value)
//   that is equal to -2147483648 for 32-bit and -9223372036854775807 for 64-bit
// in this case -val cenverts into "0" by machine math and we got invalid value
//   so we need to compare val with INT_T_MIN and use a longer converter
//
// Stupid clang generates warnings just after preprocessor and
//   before __builtin_types_compatible_p() / sizeof() preprocessor,
//   and founds a "-Wtautological-constant-out-of-range-compare" warnings
//   in places that definitely will not compile.
// I don't want to make a code completely unreadable to satisfy it.

#if OLVM_ANSI_INT_LIMITS
#	define IS_THE_MIN_INT(i) \
		__builtin_choose_expr(\
			__builtin_types_compatible_p(typeof(i), int32_t),\
				(i == INT32_MIN),\
		__builtin_choose_expr(\
			__builtin_types_compatible_p(typeof(i), int64_t),\
				(i == INT64_MIN),\
				0))

// ansi int_max = -(int_min)+1
# if UINTPTR_MAX == UINT32_MAX
#	define new_intmin() ({\
				(word)new_list(TINTN, \
						make_enump(0), \
						make_enump((INT32_MAX >> VBITS) + 1)); \
})
# else
#	define new_intmin() ({\
				(word)new_list(TINTN, \
						make_enump(0), \
						make_enump((INT64_MAX >> VBITS) + 1)); \
})
# endif

#else
#	define IS_THE_MIN_INT(i) (0)
#	define new_intmin() IFALSE
#endif


#define new_snumber(val)  ({ \
	__builtin_choose_expr(sizeof(val) < sizeof(word), \
		(word*)make_enum(val), \
	__builtin_choose_expr(sizeof(val) > sizeof(word), \
		(word*)({ \
			typeof(val) _v = (val); \
			big_t _x = _v < 0 ? (big_t)(-_v) : (big_t)_v; \
			(_x < (big_t)HIGHBIT) ? \
					(word)make_value(_v < 0 ? TENUMN : TENUMP, (word)_x): \
			(_x < (big_t)HIGHBIT*(big_t)HIGHBIT) ? \
					(word)new_list(_v < 0 ? TINTN : TINTP, \
							make_enump(_x & VMAX), \
							make_enump(_x >> VBITS)): \
					(word)new_list(_v < 0 ? TINTN : TINTP, \
							make_enump(_x & VMAX), \
							make_enump((_x >> VBITS) & VMAX), \
							make_enump((_x >> VBITS) >> VBITS)); \
		}), \
	/* else: sizeof(val) == sizeof(word) */ \
		(word*)({ \
			typeof(val) _v = (val); \
			IS_THE_MIN_INT(_v) ? new_intmin() : ({ \
				word _x = (_v < 0) ? (word)(-_v) : (word)_v; \
				(_x < (word)HIGHBIT) \
						? (word)make_value(_v < 0 ? TENUMN : TENUMP, _x) \
						: (word)new_list(_v < 0 ? TINTN : TINTP, \
									make_enump(_x & VMAX), \
									make_enump(_x >> VBITS)); }); \
		})\
	));})

#ifndef __CHAR_UNSIGNED__
#define CHAR_SIGNED 1
#define CHAR_UNSIGNED 0
#else
#define CHAR_SIGNED 0
#define CHAR_UNSIGNED 1
#endif

// todo: add size_t
#define new_number(val) \
	__builtin_choose_expr (\
		 __builtin_types_compatible_p (typeof(val), int8_t) ||\
		 __builtin_types_compatible_p (typeof(val), int16_t) ||\
		 __builtin_types_compatible_p (typeof(val), int32_t) ||\
		 __builtin_types_compatible_p (typeof(val), int64_t) ||\
		 __builtin_types_compatible_p (typeof(val), signed) ||\
		(__builtin_types_compatible_p (typeof(val), char) && CHAR_SIGNED) ||\
		 __builtin_types_compatible_p (typeof(val), signed char) ||\
		 __builtin_types_compatible_p (typeof(val), signed short) ||\
		 __builtin_types_compatible_p (typeof(val), signed int) ||\
		 __builtin_types_compatible_p (typeof(val), signed long) ||\
		 __builtin_types_compatible_p (typeof(val), signed long long),\
			new_snumber(val),\
	__builtin_choose_expr (\
		 __builtin_types_compatible_p (typeof(val), uint8_t) ||\
		 __builtin_types_compatible_p (typeof(val), uint16_t) ||\
		 __builtin_types_compatible_p (typeof(val), uint32_t) ||\
		 __builtin_types_compatible_p (typeof(val), uint64_t) ||\
		 __builtin_types_compatible_p (typeof(val), unsigned) ||\
		(__builtin_types_compatible_p (typeof(val), char) && CHAR_UNSIGNED) ||\
		 __builtin_types_compatible_p (typeof(val), unsigned char) ||\
		 __builtin_types_compatible_p (typeof(val), unsigned short) ||\
		 __builtin_types_compatible_p (typeof(val), unsigned int) ||\
		 __builtin_types_compatible_p (typeof(val), unsigned long) ||\
		 __builtin_types_compatible_p (typeof(val), unsigned long long),\
			new_unumber(val),\
	({ assert(0); (word*)IFALSE; })))

// get unsigned/signed number
//  в числовой паре надо сначала положить старшую часть, и только потом младшую!
#define unumber(num)  ({ word* n = (word*) (num); is_value(n) ? value(n) : value(car(n)) | value(cadr(n)) << VBITS; })
#define numberp(num)  unumber(num) // deprecated
#define number(num)  ({\
	word* x = (word*) (num);\
	is_numberp(x) ?  unumber(x) :\
	is_numbern(x) ? -unumber(x) :\
	0; })

// -= остальные аллокаторы =----------------------------

#define new_bytevector(length) new_alloc(TBYTEVECTOR, length)

#define NEW_STRING2(string, length) ({\
	char* _st2 = string;\
	int _strl2 = length;\
word* p = new_alloc(TSTRING, _strl2);\
	char* _ptr = (char*)&p[1];\
	while (_strl2--)\
		*_ptr++ = *_st2++;\
	/*return*/ p;\
})

#define NEW_STRING(string) ({\
	char* _st1 = string;\
	int strl1 = strlen(_st1);\
	NEW_STRING2(_st1, strl1);\
})

#define NEW_STRING_MACRO(_1, _2, NAME, ...) NAME
#define new_string(...) NEW_STRING_MACRO(__VA_ARGS__, NEW_STRING2, NEW_STRING, NOTHING)(__VA_ARGS__)

#define string(o)   ({ word p = (word)o; assert (is_string(p)); (char*) ((word*)p + 1); })


#define new_vptr(a) ({\
word _data = (word) a;\
	word* _me = new (TVPTR, 1, 0);\
	_me[1] = _data;\
	/*return*/ _me;\
})

#define new_callable(a) ({\
word _data = (word) a;\
	word* _me = new (TCALLABLE, 1, 0);\
	_me[1] = _data;\
	/*return*/ _me;\
})

// unused, but should be.
#define new_dlsym(a, b) ({\
	new_pair (TDLSYM, new_vptr(a), b);\
})

#if OLVM_INEXACTS
#define new_inexact(a) ({\
inexact_t f = (inexact_t) a;\
	word* me = new_alloc (TINEXACT, sizeof(f));\
	*(inexact_t*)&me[1] = f;\
	/*return*/me;\
})
#endif


/****************************************************************/
#endif//__OLVM_H__

