kobject.h (34592B)
1 /* 2 ** kobject.h 3 ** Type definitions for Kernel Objects 4 ** See Copyright Notice in klisp.h 5 */ 6 7 /* 8 ** SOURCE NOTE: While the tagging system comes from Mozilla TraceMonkey, 9 ** no code from TraceMonkey was used. 10 ** The general structure, names and comments of this file follow the 11 ** scheme of Lua. 12 */ 13 14 /* 15 ** TODO: 16 ** 17 ** - #ifdef for little/big endian (for now, only little endian) 18 ** Should be careful with endianness of floating point numbers too, 19 ** as they don't necessarily match the endianness of other values 20 ** - #ifdef of 32/64 bits (for now, only 32 bits) 21 ** See TraceMonkey and _funderscore comments on reddit 22 ** for 64 bits implementation ideas 23 ** 47 bits should be enough for pointers (see Canonical Form Addresses) 24 ** - #ifdef for alignment/packing info (for now, only gcc) 25 ** 26 */ 27 28 #ifndef kobject_h 29 #define kobject_h 30 31 #include <stdbool.h> 32 #include <stdint.h> 33 #include <stdio.h> 34 #include <math.h> 35 #include <pthread.h> 36 37 #include "klimits.h" 38 #include "klispconf.h" 39 #include "klisp.h" 40 41 /* 42 ** Union of all collectible objects 43 */ 44 typedef union GCObject GCObject; 45 46 /* 47 ** Common Header for all collectible objects (in macro form, to be 48 ** included in other objects) 49 */ 50 #define CommonHeader GCObject *next; uint8_t tt; uint8_t kflags; \ 51 uint16_t gct; GCObject *si; GCObject *gclist 52 53 /* NOTE: the gc flags are called marked in lua, but we reserve that them 54 for marks used in cycle traversal. The field kflags is also missing 55 from lua, they serve as compact bool fields for certain types */ 56 57 /* 58 ** NOTE: this is next pointer comes from lua. This is a byproduct of the 59 ** lua allocator. Because objects come from an arbitrary allocator, they 60 ** can't be assumed to be contiguous; but in the sweep phase of garbage 61 ** collection there has to be a way to iterate over all allocated objects 62 ** and that is the function of the next pointer: for storing the white 63 ** list. Upon allocation objects are added to this white list, all linked 64 ** together by a succession of next pointers starting in a field of the 65 ** state struct. Likewise, during the tracing phase, gray objects are linked 66 ** by means of the gclist pointer. Technically this is necessary only for 67 ** objects that have references, but in klisp all objects except strings 68 ** have them so it is easier to just put it here. 69 */ 70 71 /* 72 ** MAYBE/REFACTOR: other way to do it would be to have a packed GCHeader 73 ** struct inside each object, but would have to change all references to 74 ** header objects from 'obj.*' to 'obj.h.*', or something like that. I 75 ** think the next C standard (C1X at this point) allows the use of 76 ** anonymous inner struct and unions for this use case 77 */ 78 79 /* 80 ** Common header in struct form 81 */ 82 typedef struct __attribute__ ((__packed__)) GCheader { 83 CommonHeader; 84 } GCheader; 85 86 /* 87 ** Tags: Types & Flags 88 ** 89 ** Nan Boxing: Tagged values in 64 bits (for 32 bit systems) 90 ** All Values except doubles are encoded as double precision NaNs 91 ** There is one canonical NaN(?maybe none?) that is used through the 92 ** interpreter and all remaining NaNs are used to encode the rest of 93 ** the types (other than double) 94 ** Canonical NaN(?): (0)(111 1111 1111) 1000 0000 0000 0000 0000 32(0) 95 ** Infinities(?): s(111 1111 1111) 0000 0000 0000 0000 0000 32(0) 96 ** Tagged values: (0)(111 1111 1111) 1111 tttt tttt tttt tttt 32(v) 97 ** So all tags start with 0x7fff which leaves us 16 bits for the 98 ** tag proper. 99 ** The tag consist of an 8 bit flag part and an 8 bit type part 100 ** so tttt tttt tttt tttt is actually ffff ffff tttt tttt 101 ** This gives us 256 types and as many as 8 flags per type. 102 */ 103 104 /* TODO eliminate flags */ 105 106 /* 107 ** Macros for manipulating tags directly 108 */ 109 #define K_TAG_TAGGED 0x7fff0000 110 #define K_TAG_BASE_MASK 0x7fff0000 111 #define K_TAG_BASE_TYPE_MASK 0x7fff00ff 112 113 #define K_TAG_FLAG(t) (((t) >> 8) & 0xff) 114 #define K_TAG_TYPE(t) ((t) & 0xff) 115 #define K_TAG_BASE(t) ((t) & K_TAG_BASE_MASK) 116 #define K_TAG_BASE_TYPE(t) ((t) & K_TAG_BASE_TYPE_MASK) 117 118 /* 119 ** RATIONALE: 120 ** Number types are first and ordered to allow easy switch statements 121 ** in arithmetic operators. The ones marked with (?) are still in 122 ** consideration for separate type tags. 123 ** They are in order: fixed width integers, arbitrary integers, 124 ** fixed width rationals, arbitrary rationals, exact infinities, 125 ** inexact reals (doubles) and infinities(?) and real with no primary 126 ** values(NaN)(?), bounded reals (heap allocated), inexact infinities(?), 127 ** real with no primary value (?), 128 ** complex numbers (heap allocated) 129 */ 130 131 /* LUA NOTE: In Lua the corresponding defines are in lua.h */ 132 /* 133 ** The name strings for all TValue types are in kobject.c 134 ** Thoseshould be updated if types here are modified 135 */ 136 #define K_TFIXINT 0 137 #define K_TBIGINT 1 138 #define K_TFIXRAT 2 139 #define K_TBIGRAT 3 140 #define K_TDOUBLE 4 141 #define K_TBDOUBLE 5 142 #define K_TEINF 6 143 #define K_TIINF 7 144 #define K_TRWNPV 8 145 #define K_TCOMPLEX 9 146 #define K_TUNDEFINED 10 147 148 #define K_TNIL 20 149 #define K_TIGNORE 21 150 #define K_TINERT 22 151 #define K_TEOF 23 152 #define K_TBOOLEAN 24 153 #define K_TCHAR 25 154 #define K_TFREE 26 /* this is used instead of lua nil in tables */ 155 /* user pointer */ 156 #define K_TUSER 29 157 158 #define K_TPAIR 30 159 #define K_TSTRING 31 160 #define K_TSYMBOL 32 161 #define K_TENVIRONMENT 33 162 #define K_TCONTINUATION 34 163 #define K_TOPERATIVE 35 164 #define K_TAPPLICATIVE 36 165 #define K_TENCAPSULATION 37 166 #define K_TPROMISE 38 167 #define K_TTABLE 39 168 #define K_TERROR 40 169 #define K_TBYTEVECTOR 41 170 #define K_TFPORT 42 171 #define K_TMPORT 43 172 #define K_TVECTOR 44 173 #define K_TKEYWORD 45 174 #define K_TLIBRARY 46 175 #define K_TTHREAD 47 176 #define K_TMUTEX 48 177 #define K_TCONDVAR 49 178 179 /* for tables */ 180 #define K_TDEADKEY 60 181 182 /* this is used to test for numbers, as returned by ttype */ 183 #define K_LAST_NUMBER_TYPE K_TUNDEFINED 184 185 /* this is used to if the object is collectable */ 186 #define K_FIRST_GC_TYPE K_TPAIR 187 188 #define K_MAKE_VTAG(t) (K_TAG_TAGGED | (t)) 189 190 /* 191 ** TODO: 192 ** 193 ** - decide if inexact infinities and reals with no 194 ** primary values are included in K_TDOUBLE 195 ** - All types except complexs, bounded reals and fixrats 196 */ 197 #define K_TAG_FIXINT K_MAKE_VTAG(K_TFIXINT) 198 #define K_TAG_BIGINT K_MAKE_VTAG(K_TBIGINT) 199 #define K_TAG_BIGRAT K_MAKE_VTAG(K_TBIGRAT) 200 #define K_TAG_EINF K_MAKE_VTAG(K_TEINF) 201 #define K_TAG_IINF K_MAKE_VTAG(K_TIINF) 202 #define K_TAG_RWNPV K_MAKE_VTAG(K_TRWNPV) 203 #define K_TAG_UNDEFINED K_MAKE_VTAG(K_TUNDEFINED) 204 205 #define K_TAG_NIL K_MAKE_VTAG(K_TNIL) 206 #define K_TAG_IGNORE K_MAKE_VTAG(K_TIGNORE) 207 #define K_TAG_INERT K_MAKE_VTAG(K_TINERT) 208 #define K_TAG_EOF K_MAKE_VTAG(K_TEOF) 209 #define K_TAG_BOOLEAN K_MAKE_VTAG(K_TBOOLEAN) 210 #define K_TAG_CHAR K_MAKE_VTAG(K_TCHAR) 211 #define K_TAG_FREE K_MAKE_VTAG(K_TFREE) 212 #define K_TAG_DEADKEY K_MAKE_VTAG(K_TDEADKEY) 213 214 #define K_TAG_USER K_MAKE_VTAG(K_TUSER) 215 216 #define K_TAG_PAIR K_MAKE_VTAG(K_TPAIR) 217 #define K_TAG_STRING K_MAKE_VTAG(K_TSTRING) 218 #define K_TAG_SYMBOL K_MAKE_VTAG(K_TSYMBOL) 219 220 #define K_TAG_SYMBOL K_MAKE_VTAG(K_TSYMBOL) 221 #define K_TAG_ENVIRONMENT K_MAKE_VTAG(K_TENVIRONMENT) 222 #define K_TAG_CONTINUATION K_MAKE_VTAG(K_TCONTINUATION) 223 #define K_TAG_OPERATIVE K_MAKE_VTAG(K_TOPERATIVE) 224 #define K_TAG_APPLICATIVE K_MAKE_VTAG(K_TAPPLICATIVE) 225 #define K_TAG_ENCAPSULATION K_MAKE_VTAG(K_TENCAPSULATION) 226 #define K_TAG_PROMISE K_MAKE_VTAG(K_TPROMISE) 227 #define K_TAG_TABLE K_MAKE_VTAG(K_TTABLE) 228 #define K_TAG_ERROR K_MAKE_VTAG(K_TERROR) 229 #define K_TAG_BYTEVECTOR K_MAKE_VTAG(K_TBYTEVECTOR) 230 #define K_TAG_FPORT K_MAKE_VTAG(K_TFPORT) 231 #define K_TAG_MPORT K_MAKE_VTAG(K_TMPORT) 232 #define K_TAG_VECTOR K_MAKE_VTAG(K_TVECTOR) 233 #define K_TAG_KEYWORD K_MAKE_VTAG(K_TKEYWORD) 234 #define K_TAG_LIBRARY K_MAKE_VTAG(K_TLIBRARY) 235 #define K_TAG_THREAD K_MAKE_VTAG(K_TTHREAD) 236 #define K_TAG_MUTEX K_MAKE_VTAG(K_TMUTEX) 237 #define K_TAG_CONDVAR K_MAKE_VTAG(K_TCONDVAR) 238 239 /* 240 ** Macros to test types 241 */ 242 243 /* NOTE: This is intended for use in switch statements */ 244 #define ttype(o) ({ TValue tto_ = (o); \ 245 ttisdouble(tto_)? K_TDOUBLE : ttype_(tto_); }) 246 247 /* This is intended for internal use below. DON'T USE OUTSIDE THIS FILE */ 248 #define ttag(o) ((o).tv.t) 249 #define ttype_(o) (K_TAG_TYPE(ttag(o))) 250 /* NOTE: not used for now */ 251 #define tflag_(o) (K_TAG_FLAG(ttag(o))) 252 #define tbasetype_(o) (K_TAG_BASE_TYPE(ttag(o))) 253 254 /* Simple types (value in TValue struct) */ 255 #define ttisfixint(o) (tbasetype_(o) == K_TAG_FIXINT) 256 #define ttisbigint(o) (tbasetype_(o) == K_TAG_BIGINT) 257 #define ttiseinteger(o_) ({ int32_t t_ = tbasetype_(o_); \ 258 t_ == K_TAG_FIXINT || t_ == K_TAG_BIGINT;}) 259 /* for items in bytevectors */ 260 #define ttisu8(o) ({ \ 261 TValue o__ = (o); \ 262 (ttisfixint(o__) && ivalue(o__) >= 0 && ivalue(o__) < 256); }) 263 /* for radixes in string<->number */ 264 #define ttisradix(o) ({ \ 265 TValue o__ = (o); \ 266 (ttisfixint(o__) && \ 267 (ivalue(o__) == 2 || ivalue(o__) == 8 || \ 268 ivalue(o__) == 10 || ivalue(o__) == 16)); }) 269 /* for bases in char->digit and related functions */ 270 #define ttisbase(o) ({ \ 271 TValue o__ = (o); \ 272 (ttisfixint(o__) && ivalue(o__) >= 2 && ivalue(o__) <= 36); }) 273 #define ttisinteger(o) ({ TValue o__ = (o); \ 274 (ttiseinteger(o__) || \ 275 (ttisdouble(o__) && (floor(dvalue(o__)) == dvalue(o__))));}) 276 #define ttisbigrat(o) (tbasetype_(o) == K_TAG_BIGRAT) 277 #define ttisrational(o_) \ 278 ({ TValue t_ = o_; \ 279 (ttype(t_) <= K_TBIGRAT) || ttisdouble(t_); }) 280 #define ttisdouble(o) ((ttag(o) & K_TAG_BASE_MASK) != K_TAG_TAGGED) 281 #define ttisreal(o) (ttype(o) < K_TCOMPLEX) 282 #define ttisexact(o_) \ 283 ({ TValue t_ = o_; \ 284 (ttiseinf(t_) || ttype(t_) <= K_TBIGRAT); }) 285 /* MAYBE this is ugly..., maybe add exact/inexact flag, real, rational flag */ 286 #define ttisinexact(o_) \ 287 ({ TValue t_ = o_; \ 288 (ttisundef(t_) || ttisdouble(t_) || ttisrwnpv(t_) || ttisiinf(t_)); }) 289 /* For now, all inexact numbers are not robust and have -inf & +inf bounds */ 290 #define ttisrobust(o) (ttisexact(o)) 291 #define ttisnumber(o) (ttype(o) <= K_LAST_NUMBER_TYPE) 292 #define ttiseinf(o) (tbasetype_(o) == K_TAG_EINF) 293 #define ttisiinf(o) (tbasetype_(o) == K_TAG_IINF) 294 #define ttisinf(o_) \ 295 ({ TValue t_ = o_; \ 296 (ttiseinf(t_) || ttisiinf(t_)); }) 297 #define ttisrwnpv(o) (tbasetype_(o) == K_TAG_RWNPV) 298 #define ttisundef(o) (tbasetype_(o) == K_TAG_UNDEFINED) 299 #define ttisnwnpv(o_) \ 300 ({ TValue t_ = o_; \ 301 (ttisundef(t_) || ttisrwnpv(t_)); }) 302 303 #define ttisnil(o) (tbasetype_(o) == K_TAG_NIL) 304 #define ttisignore(o) (tbasetype_(o) == K_TAG_IGNORE) 305 #define ttisinert(o) (tbasetype_(o) == K_TAG_INERT) 306 #define ttiseof(o) (tbasetype_(o) == K_TAG_EOF) 307 #define ttisboolean(o) (tbasetype_(o) == K_TAG_BOOLEAN) 308 #define ttischar(o) (tbasetype_(o) == K_TAG_CHAR) 309 #define ttisuser(o) (tbasetype_(o) == K_TAG_USER) 310 #define ttisfree(o) (tbasetype_(o) == K_TAG_FREE) 311 312 /* Complex types (value in heap), 313 (bigints, rationals, etc could be collectable) 314 maybe we should use a better way for this, to speed up checks, maybe use 315 a flag? */ 316 #define iscollectable(o) ({ uint8_t t = ttype(o); \ 317 (t == K_TBIGINT || t == K_TBIGRAT || t >= K_FIRST_GC_TYPE); }) 318 319 #define ttisstring(o) (tbasetype_(o) == K_TAG_STRING) 320 #define ttissymbol(o) (tbasetype_(o) == K_TAG_SYMBOL) 321 #define ttispair(o) (tbasetype_(o) == K_TAG_PAIR) 322 #define ttisoperative(o) (tbasetype_(o) == K_TAG_OPERATIVE) 323 #define ttisapplicative(o) (tbasetype_(o) == K_TAG_APPLICATIVE) 324 #define ttiscombiner(o_) ({ int32_t t_ = tbasetype_(o_); \ 325 t_ == K_TAG_OPERATIVE || t_ == K_TAG_APPLICATIVE;}) 326 #define ttisenvironment(o) (tbasetype_(o) == K_TAG_ENVIRONMENT) 327 #define ttiscontinuation(o) (tbasetype_(o) == K_TAG_CONTINUATION) 328 #define ttisencapsulation(o) (tbasetype_(o) == K_TAG_ENCAPSULATION) 329 #define ttispromise(o) (tbasetype_(o) == K_TAG_PROMISE) 330 #define ttistable(o) (tbasetype_(o) == K_TAG_TABLE) 331 #define ttiserror(o) (tbasetype_(o) == K_TAG_ERROR) 332 #define ttisbytevector(o) (tbasetype_(o) == K_TAG_BYTEVECTOR) 333 #define ttisfport(o) (tbasetype_(o) == K_TAG_FPORT) 334 #define ttismport(o) (tbasetype_(o) == K_TAG_MPORT) 335 #define ttisport(o_) ({ int32_t t_ = tbasetype_(o_); \ 336 t_ == K_TAG_FPORT || t_ == K_TAG_MPORT;}) 337 #define ttisvector(o) (tbasetype_(o) == K_TAG_VECTOR) 338 #define ttiskeyword(o) (tbasetype_(o) == K_TAG_KEYWORD) 339 #define ttislibrary(o) (tbasetype_(o) == K_TAG_LIBRARY) 340 #define ttisthread(o) (tbasetype_(o) == K_TAG_THREAD) 341 #define ttismutex(o) (tbasetype_(o) == K_TAG_MUTEX) 342 #define ttiscondvar(o) (tbasetype_(o) == K_TAG_CONDVAR) 343 344 /* macros to easily check boolean values */ 345 #define kis_true(o_) (tv_equal((o_), KTRUE)) 346 #define kis_false(o_) (tv_equal((o_), KFALSE)) 347 /* unsafe, doesn't check type */ 348 #define knegp(o_) (kis_true(o_)? KFALSE : KTRUE) 349 350 /* 351 ** Union of all Kernel non heap-allocated values (except doubles) 352 */ 353 typedef union { 354 bool b; 355 int32_t i; 356 char ch; 357 GCObject *gc; 358 void *p; 359 /* ... */ 360 } Value; 361 362 /* 363 ** All Kernel non heap-allocated values (except doubles) tagged 364 */ 365 typedef struct __attribute__ ((__packed__)) InnerTV { 366 Value v; 367 uint32_t t; 368 } InnerTV; 369 370 /* 371 ** Union of all Kernel non heap-allocated values 372 */ 373 typedef __attribute__((aligned (8))) union { 374 double d; 375 InnerTV tv; 376 int64_t raw; 377 } TValue; 378 379 /* 380 ** Individual heap-allocated values 381 */ 382 383 typedef struct __attribute__ ((__packed__)) { 384 CommonHeader; 385 /* These are all from IMath (XXX: find a way to use mp_types directly) */ 386 uint32_t single; 387 uint32_t *digits; 388 uint32_t alloc; 389 uint32_t used; 390 unsigned char sign; 391 } Bigint; 392 393 /* NOTE: Notice that both num and den aren't pointers, so, in general, to get 394 the denominator or numerator we have to make a copy, this comes from IMath. 395 If written for klisp I would have put pointers. Maybe I'll later change it 396 but for now minimal ammount of modification to IMath is desired */ 397 typedef struct __attribute__ ((__packed__)) { 398 CommonHeader; 399 /* This is from IMath */ 400 Bigint num; /* Numerator */ 401 Bigint den; /* Denominator, <> 0 */ 402 } Bigrat; 403 404 /* REFACTOR: move these macros somewhere else */ 405 /* NOTE: The use of the intermediate KCONCAT is needed to allow 406 expansion of the __LINE__ macro. */ 407 #define KCONCAT_(a, b) a ## b 408 #define KCONCAT(a, b) KCONCAT_(a, b) 409 #define KUNIQUE_NAME(prefix) KCONCAT(prefix, __LINE__ ) 410 411 typedef struct __attribute__ ((__packed__)) { 412 CommonHeader; 413 TValue mark; /* for cycle/sharing aware algorithms */ 414 TValue car; 415 TValue cdr; 416 } Pair; 417 418 typedef struct __attribute__ ((__packed__)) { 419 CommonHeader; /* symbols are marked via their strings */ 420 TValue str; /* could use String * here, but for now... */ 421 uint32_t hash; /* this is different from the str hash to 422 avoid having both the string and the symbol 423 from always falling in the same bucket */ 424 } Symbol; 425 426 typedef struct __attribute__ ((__packed__)) { 427 CommonHeader; 428 TValue mark; /* for cycle/sharing aware algorithms */ 429 TValue parents; /* may be (), a list, or a single env */ 430 TValue bindings; /* alist of (binding . value) or table */ 431 /* for keyed static vars */ 432 TValue keyed_node; /* (key . value) pair or KNIL */ 433 /* this is a different field from parents to jump over non keyed 434 envs in the search */ 435 TValue keyed_parents; /* maybe (), a list, or a single env */ 436 } Environment; 437 438 typedef struct __attribute__ ((__packed__)) { 439 CommonHeader; 440 TValue mark; /* for guarding continuation */ 441 TValue parent; /* may be () for root continuation */ 442 TValue comb; /* combiner that created the cont (or #inert) */ 443 klisp_CFunction fn; /* the function that does the work */ 444 int32_t extra_size; 445 TValue extra[]; 446 } Continuation; 447 448 typedef struct __attribute__ ((__packed__)) { 449 CommonHeader; 450 klisp_CFunction fn; /* the function that does the work */ 451 int32_t extra_size; 452 TValue extra[]; 453 } Operative; 454 455 typedef struct __attribute__ ((__packed__)) { 456 CommonHeader; 457 TValue underlying; /* underlying operative/applicative */ 458 } Applicative; 459 460 typedef struct __attribute__ ((__packed__)) { 461 CommonHeader; 462 TValue key; /* unique pair identifying this type of encapsulation */ 463 TValue value; /* encapsulated object */ 464 } Encapsulation; 465 466 typedef struct __attribute__ ((__packed__)) { 467 CommonHeader; 468 TValue node; /* pair (exp . maybe-env) */ 469 /* if maybe-env is nil, then the promise has determined exp, 470 otherwise the promise should eval exp in maybe-env when forced 471 It has to be a pair to allow sharing between different promises 472 So that determining one determines all the promises that are 473 sharing the pair */ 474 } Promise; 475 476 /* common fields for all types of ports */ 477 /* TEMP: for now source code info is in fixints */ 478 #define PortCommonFields TValue filename; int32_t row; int32_t col 479 480 typedef struct __attribute__ ((__packed__)) { 481 CommonHeader; 482 PortCommonFields; 483 } Port; 484 485 /* input/output direction and open/close status are in kflags */ 486 typedef struct __attribute__ ((__packed__)) { 487 CommonHeader; 488 PortCommonFields; 489 FILE *file; 490 } FPort; 491 492 /* input/output direction and open/close status are in kflags */ 493 typedef struct __attribute__ ((__packed__)) { 494 CommonHeader; 495 PortCommonFields; 496 TValue buf; 497 uint32_t off; 498 } MPort; 499 500 501 /* 502 ** Hashtables 503 */ 504 505 typedef union TKey { 506 struct { 507 TValue this; /* different from lua because of the tagging scheme */ 508 struct Node *next; /* for chaining */ 509 } nk; 510 TValue tvk; 511 } TKey; 512 513 typedef struct Node { 514 TValue i_val; 515 TKey i_key; 516 } Node; 517 518 typedef struct __attribute__ ((__packed__)) { 519 CommonHeader; 520 uint8_t lsizenode; /* log2 of size of `node' array */ 521 uint8_t t1padding; 522 uint16_t t2padding; /* to avoid disturbing the alignment */ 523 TValue *array; /* array part */ 524 Node *node; 525 Node *lastfree; /* any free position is before this position */ 526 int32_t sizearray; /* size of `array' array */ 527 } Table; 528 529 /* The weak flags are in kflags */ 530 531 /* Errors */ 532 typedef struct __attribute__ ((__packed__)) { 533 CommonHeader; 534 TValue who; /* either #inert or creating combiner/continuation */ 535 TValue cont; /* continuation context */ 536 TValue msg; /* string msg */ 537 TValue irritants; /* list of extra objs */ 538 } Error; 539 540 /* Bytevectors */ 541 typedef struct __attribute__ ((__packed__)) { 542 CommonHeader; 543 TValue mark; /* for cycle/sharing aware algorithms */ 544 uint32_t size; 545 uint32_t hash; /* only used for immutable strings */ 546 uint8_t b[]; /* buffer */ 547 } Bytevector; 548 549 /* Vectors (heterogenous arrays) */ 550 typedef struct __attribute__ ((__packed__)) { 551 CommonHeader; 552 TValue mark; /* for cycle/sharing aware algorithms */ 553 uint32_t sizearray; /* number of elements in array[] */ 554 TValue array[]; /* array of elements */ 555 } Vector; 556 557 /* Unlike symbols, keywords can be marked because they don't record 558 source info */ 559 typedef struct __attribute__ ((__packed__)) { 560 CommonHeader; /* symbols are marked via their strings */ 561 TValue mark; /* for cycle/sharing aware algorithms */ 562 TValue str; /* could use String * here, but for now... */ 563 uint32_t hash; /* this is different from the symbol & string hash 564 to avoid having the string, the symbol, and the 565 keyword always falling in the same bucket */ 566 } Keyword; 567 568 typedef struct __attribute__ ((__packed__)) { 569 CommonHeader; /* symbols are marked via their strings */ 570 TValue env; /* this is inherited and a child is returned */ 571 TValue exp_list; /* this is an immutable list of symbols */ 572 } Library; 573 574 #define KMUTEX_NO_OWNER (KINERT) 575 576 typedef struct __attribute__ ((__packed__)) { 577 CommonHeader; /* symbols are marked via their strings */ 578 TValue owner; /* KINERT/thread currently holding this mutex */ 579 pthread_mutex_t mutex; 580 uint32_t count; /* count for recursive mutex */ 581 } Mutex; 582 583 typedef struct __attribute__ ((__packed__)) { 584 CommonHeader; /* symbols are marked via their strings */ 585 TValue mutex; 586 pthread_cond_t cond; 587 } Condvar; 588 589 /* 590 ** `module' operation for hashing (size is always a power of 2) 591 */ 592 #define lmod(s,size) \ 593 (check_exp((size&(size-1))==0, (cast(int32_t, (s) & ((size)-1))))) 594 595 596 #define twoto(x) (1<<(x)) 597 #define sizenode(t) (twoto((t)->lsizenode)) 598 599 #define ceillog2(x) (klispO_log2((x)-1) + 1) 600 601 int32_t klispO_log2 (uint32_t x); 602 603 /* 604 ** RATIONALE: 605 ** 606 ** Storing size allows embedded '\0's. 607 ** Note, however, that there are actually size + 1 bytes allocated 608 ** and that b[size] = '\0'. This is useful for printing strings 609 ** 610 */ 611 typedef struct __attribute__ ((__packed__)) { 612 CommonHeader; 613 TValue mark; /* for cycle/sharing aware algorithms */ 614 uint32_t size; 615 uint32_t hash; /* only used for immutable strings */ 616 char b[]; /* buffer */ 617 } String; 618 619 /* MAYBE: mark fields could be replaced by a hashtable or a bit + a hashtable */ 620 621 /* 622 ** Common header for markable objects 623 */ 624 typedef struct __attribute__ ((__packed__)) { 625 CommonHeader; 626 TValue mark; 627 } MGCheader; 628 629 /* 630 ** Some constants 631 */ 632 #define KNIL_ {.tv = {.t = K_TAG_NIL, .v = { .i = 0 }}} 633 #define KINERT_ {.tv = {.t = K_TAG_INERT, .v = { .i = 0 }}} 634 #define KIGNORE_ {.tv = {.t = K_TAG_IGNORE, .v = { .i = 0 }}} 635 #define KEOF_ {.tv = {.t = K_TAG_EOF, .v = { .i = 0 }}} 636 #define KTRUE_ {.tv = {.t = K_TAG_BOOLEAN, .v = { .b = true }}} 637 #define KFALSE_ {.tv = {.t = K_TAG_BOOLEAN, .v = { .b = false }}} 638 #define KEPINF_ {.tv = {.t = K_TAG_EINF, .v = { .i = 1 }}} 639 #define KEMINF_ {.tv = {.t = K_TAG_EINF, .v = { .i = -1 }}} 640 #define KIPINF_ {.tv = {.t = K_TAG_IINF, .v = { .i = 1 }}} 641 #define KIMINF_ {.tv = {.t = K_TAG_IINF, .v = { .i = -1 }}} 642 #define KRWNPV_ {.tv = {.t = K_TAG_RWNPV, .v = { .i = 0 }}} 643 #define KUNDEF_ {.tv = {.t = K_TAG_UNDEFINED, .v = { .i = 0 }}} 644 #define KFREE_ {.tv = {.t = K_TAG_FREE, .v = { .i = 0 }}} 645 /* named character */ 646 /* N.B. don't confuse with KNULL_ with KNIL!!! */ 647 #define KNULL_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\0' }}} 648 #define KALARM_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\a' }}} 649 #define KBACKSPACE_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\b' }}} 650 #define KTAB_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\t' }}} 651 #define KNEWLINE_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\n' }}} 652 #define KRETURN_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\r' }}} 653 #define KESCAPE_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\x1b' }}} 654 #define KSPACE_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = ' ' }}} 655 #define KDELETE_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\x7f' }}} 656 #define KVTAB_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\v' }}} 657 #define KFORMFEED_ {.tv = {.t = K_TAG_CHAR, .v = { .ch = '\f' }}} 658 659 /* RATIONALE: the ones above can be used in initializers */ 660 #define KNIL ((TValue) KNIL_) 661 #define KINERT ((TValue) KINERT_) 662 #define KIGNORE ((TValue) KIGNORE_) 663 #define KEOF ((TValue) KEOF_) 664 #define KTRUE ((TValue) KTRUE_) 665 #define KFALSE ((TValue) KFALSE_) 666 #define KEPINF ((TValue) KEPINF_) 667 #define KEMINF ((TValue) KEMINF_) 668 #define KIPINF ((TValue) KIPINF_) 669 #define KIMINF ((TValue) KIMINF_) 670 #define KRWNPV ((TValue) KRWNPV_) 671 #define KUNDEF ((TValue) KUNDEF_) 672 #define KSPACE ((TValue) KSPACE_) 673 #define KNEWLINE ((TValue) KNEWLINE_) 674 #define KFREE ((TValue) KFREE_) 675 676 /* The same constants as global const variables */ 677 const TValue knil; 678 const TValue kignore; 679 const TValue kinert; 680 const TValue keof; 681 const TValue ktrue; 682 const TValue kfalse; 683 const TValue kepinf; 684 const TValue keminf; 685 const TValue kipinf; 686 const TValue kiminf; 687 const TValue krwnpv; 688 const TValue kundef; 689 const TValue kspace; 690 const TValue knewline; 691 const TValue kfree; 692 693 /* Macros to create TValues of non-heap allocated types (for initializers) */ 694 #define ch2tv_(ch_) {.tv = {.t = K_TAG_CHAR, .v = { .ch = (ch_) }}} 695 #define i2tv_(i_) {.tv = {.t = K_TAG_FIXINT, .v = { .i = (i_) }}} 696 #define b2tv_(b_) {.tv = {.t = K_TAG_BOOLEAN, .v = { .b = (b_) }}} 697 #define p2tv_(p_) {.tv = {.t = K_TAG_USER, .v = { .p = (p_) }}} 698 #define d2tv_(d_) {.d = d_} 699 #define ktag_double(d_) \ 700 ({ double d__ = d_; \ 701 TValue res__; \ 702 if (isnan(d__)) res__ = KRWNPV; \ 703 else if (isinf(d__)) res__ = (d__ == INFINITY)? \ 704 KIPINF : KIMINF; \ 705 /* +0.0 == -0.0 too, but that doesn't hurt */ \ 706 else if (d__ == -0.0) res__ = d2tv(+0.0); \ 707 else res__ = d2tv(d__); \ 708 res__;}) 709 710 /* Macros to create TValues of non-heap allocated types */ 711 #define ch2tv(ch_) ((TValue) ch2tv_(ch_)) 712 #define i2tv(i_) ((TValue) i2tv_(i_)) 713 #define b2tv(b_) ((TValue) b2tv_(b_)) 714 #define p2tv(p_) ((TValue) p2tv_(p_)) 715 #define d2tv(d_) ((TValue) d2tv_(d_)) 716 717 /* Macros to convert a GCObject * into a tagged value */ 718 /* TODO: add assertions */ 719 /* REFACTOR: change names to bigint2tv, pair2tv, etc */ 720 /* LUA NOTE: the corresponding defines are in lstate.h */ 721 #define gc2tv(t_, o_) ((TValue) {.tv = {.t = (t_), \ 722 .v = { .gc = obj2gco(o_)}}}) 723 #define gc2bigint(o_) (gc2tv(K_TAG_BIGINT, o_)) 724 #define gc2bigrat(o_) (gc2tv(K_TAG_BIGRAT, o_)) 725 #define gc2pair(o_) (gc2tv(K_TAG_PAIR, o_)) 726 #define gc2str(o_) (gc2tv(K_TAG_STRING, o_)) 727 #define gc2sym(o_) (gc2tv(K_TAG_SYMBOL, o_)) 728 #define gc2env(o_) (gc2tv(K_TAG_ENVIRONMENT, o_)) 729 #define gc2cont(o_) (gc2tv(K_TAG_CONTINUATION, o_)) 730 #define gc2op(o_) (gc2tv(K_TAG_OPERATIVE, o_)) 731 #define gc2app(o_) (gc2tv(K_TAG_APPLICATIVE, o_)) 732 #define gc2enc(o_) (gc2tv(K_TAG_ENCAPSULATION, o_)) 733 #define gc2prom(o_) (gc2tv(K_TAG_PROMISE, o_)) 734 #define gc2fport(o_) (gc2tv(K_TAG_FPORT, o_)) 735 #define gc2mport(o_) (gc2tv(K_TAG_MPORT, o_)) 736 #define gc2table(o_) (gc2tv(K_TAG_TABLE, o_)) 737 #define gc2error(o_) (gc2tv(K_TAG_ERROR, o_)) 738 #define gc2bytevector(o_) (gc2tv(K_TAG_BYTEVECTOR, o_)) 739 #define gc2vector(o_) (gc2tv(K_TAG_VECTOR, o_)) 740 #define gc2keyw(o_) (gc2tv(K_TAG_KEYWORD, o_)) 741 #define gc2lib(o_) (gc2tv(K_TAG_LIBRARY, o_)) 742 #define gc2th(o_) (gc2tv(K_TAG_THREAD, o_)) 743 #define gc2mutex(o_) (gc2tv(K_TAG_MUTEX, o_)) 744 #define gc2condvar(o_) (gc2tv(K_TAG_CONDVAR, o_)) 745 #define gc2deadkey(o_) (gc2tv(K_TAG_DEADKEY, o_)) 746 747 /* Macro to convert a TValue into a specific heap allocated object */ 748 #define tv2bigint(v_) ((Bigint *) gcvalue(v_)) 749 #define tv2bigrat(v_) ((Bigrat *) gcvalue(v_)) 750 #define tv2pair(v_) ((Pair *) gcvalue(v_)) 751 #define tv2str(v_) ((String *) gcvalue(v_)) 752 #define tv2sym(v_) ((Symbol *) gcvalue(v_)) 753 #define tv2env(v_) ((Environment *) gcvalue(v_)) 754 #define tv2cont(v_) ((Continuation *) gcvalue(v_)) 755 #define tv2op(v_) ((Operative *) gcvalue(v_)) 756 #define tv2app(v_) ((Applicative *) gcvalue(v_)) 757 #define tv2enc(v_) ((Encapsulation *) gcvalue(v_)) 758 #define tv2prom(v_) ((Promise *) gcvalue(v_)) 759 #define tv2table(v_) ((Table *) gcvalue(v_)) 760 #define tv2error(v_) ((Error *) gcvalue(v_)) 761 #define tv2bytevector(v_) ((Bytevector *) gcvalue(v_)) 762 #define tv2vector(v_) ((Vector *) gcvalue(v_)) 763 #define tv2fport(v_) ((FPort *) gcvalue(v_)) 764 #define tv2mport(v_) ((MPort *) gcvalue(v_)) 765 #define tv2port(v_) ((Port *) gcvalue(v_)) 766 #define tv2keyw(v_) ((Keyword *) gcvalue(v_)) 767 #define tv2lib(v_) ((Library *) gcvalue(v_)) 768 #define tv2th(v_) ((klisp_State *) gcvalue(v_)) 769 #define tv2mutex(v_) ((Mutex *) gcvalue(v_)) 770 #define tv2condvar(v_) ((Condvar *) gcvalue(v_)) 771 772 #define tv2gch(v_) ((GCheader *) gcvalue(v_)) 773 #define tv2mgch(v_) ((MGCheader *) gcvalue(v_)) 774 775 /* Macro to convert any Kernel object into a GCObject */ 776 #define obj2gco(v_) ((GCObject *) (v_)) 777 778 #define obj2gch(v_) ((GCheader *) (v_)) 779 780 /* Macros to access innertv values */ 781 /* TODO: add assertions */ 782 #define ivalue(o_) ((o_).tv.v.i) 783 #define bvalue(o_) ((o_).tv.v.b) 784 #define chvalue(o_) ((o_).tv.v.ch) 785 #define gcvalue(o_) ((o_).tv.v.gc) 786 #define pvalue(o_) ((o_).tv.v.p) 787 #define dvalue(o_) ((o_).d) 788 789 /* Macro to obtain a string describing the type of a TValue */# 790 #define ttname(tv_) (ktv_names[ttype(tv_)]) 791 792 extern char *ktv_names[]; 793 794 /* Macros to handle marks */ 795 /* TODO add assertions to check that symbols aren't marked with these */ 796 797 /* NOTE: this only works in markable objects, but not in symbols */ 798 #define kget_mark(p_) (tv2mgch(p_)->mark) 799 800 #ifdef KTRACK_MARKS 801 /* XXX: marking macros should take a klisp_State parameter and 802 keep track of marks in the klisp_State */ 803 int32_t kmark_count; 804 #define kset_mark(p_, m_) ({ TValue new_mark_ = (m_); \ 805 TValue obj_ = (p_); \ 806 TValue old_mark_ = kget_mark(p_); \ 807 if (kis_false(old_mark_) && !kis_false(new_mark_)) \ 808 ++kmark_count; \ 809 else if (kis_false(new_mark_) && !kis_false(old_mark_)) \ 810 --kmark_count; \ 811 kget_mark(obj_) = new_mark_; }) 812 #define kcheck_mark_balance() (assert(kmark_count == 0)) 813 #else 814 #define kset_mark(p_, m_) (kget_mark(p_) = (m_)) 815 #define kcheck_mark_balance() 816 #endif 817 818 /* simple boolean #t mark */ 819 #define kmark(p_) (kset_mark(p_, KTRUE)) 820 #define kunmark(p_) (kset_mark(p_, KFALSE)) 821 822 #define kis_marked(p_) (!kis_unmarked(p_)) 823 #define kis_unmarked(p_) (tv_equal(kget_mark(p_), KFALSE)) 824 825 /* Symbols marking */ 826 /* NOTE: it's different because symbols mark their strings */ 827 #define kget_symbol_mark(s_) (kget_mark(tv2sym(s_)->str)) 828 #define kset_symbol_mark(s_, m_) (kget_mark(tv2sym(s_)->str) = (m_)) 829 #define kmark_symbol(s_) (kset_mark(tv2sym(s_)->str, KTRUE)) 830 #define kunmark_symbol(s_) (kset_mark(tv2sym(s_)->str, KFALSE)) 831 #define kis_symbol_marked(s_) (kis_marked(tv2sym(s_)->str)) 832 #define kis_symbol_unmarked(s_) (kis_unmarked(tv2sym(s_)->str)) 833 834 /* Macros to access kflags & type in GCHeader */ 835 /* TODO: 1 should always be reserved for mutability flag */ 836 #define gch_get_type(o_) (obj2gch(o_)->tt) 837 #define gch_get_kflags(o_) (obj2gch(o_)->kflags) 838 #define tv_get_kflags(o_) (gch_get_kflags(tv2gch(o_))) 839 840 /* General KFlags */ 841 /* TODO use bittricks from kgc.h */ 842 /* MAYBE make flags 16 bits, make gc flags 8 bits */ 843 /* for now only used in pairs and strings */ 844 845 #define K_FLAG_CAN_HAVE_NAME 0x80 846 #define K_FLAG_HAS_NAME 0x40 847 848 /* evaluates o_ more than once */ 849 #define kcan_have_name(o_) \ 850 (iscollectable(o_) && ((tv_get_kflags(o_)) & K_FLAG_CAN_HAVE_NAME) != 0) 851 852 #define khas_name(o_) \ 853 (iscollectable(o_) && (tv_get_kflags(o_)) & K_FLAG_HAS_NAME) 854 855 #define K_FLAG_HAS_SI 0x20 856 857 #define kcan_have_si(o_) (iscollectable(o_)) 858 #define khas_si(o_) ((iscollectable(o_) && \ 859 (tv_get_kflags(o_)) & K_FLAG_HAS_SI)) 860 861 #define K_FLAG_IMMUTABLE 0x10 862 863 #define kis_mutable(o_) ((tv_get_kflags(o_) & K_FLAG_IMMUTABLE) == 0) 864 #define kis_immutable(o_) (!kis_mutable(o_)) 865 866 /* KFlags for marking continuations */ 867 #define K_FLAG_OUTER 0x01 868 #define K_FLAG_INNER 0x02 869 #define K_FLAG_DYNAMIC 0x04 870 #define K_FLAG_BOOL_CHECK 0x08 871 /* this is the same as immutable, but there is no problem 872 with continuations */ 873 #define K_FLAG_INERT_RET 0x10 874 875 /* evaluate c_ more than once */ 876 #define kset_inner_cont(c_) (tv_get_kflags(c_) |= K_FLAG_INNER) 877 #define kset_outer_cont(c_) (tv_get_kflags(c_) |= K_FLAG_OUTER) 878 #define kset_dyn_cont(c_) (tv_get_kflags(c_) |= K_FLAG_DYNAMIC) 879 #define kset_bool_check_cont(c_) (tv_get_kflags(c_) |= K_FLAG_BOOL_CHECK) 880 #define kset_inert_ret_cont(c_) (tv_get_kflags(c_) |= K_FLAG_INERT_RET) 881 882 #define kis_inner_cont(c_) ((tv_get_kflags(c_) & K_FLAG_INNER) != 0) 883 #define kis_outer_cont(c_) ((tv_get_kflags(c_) & K_FLAG_OUTER) != 0) 884 #define kis_dyn_cont(c_) ((tv_get_kflags(c_) & K_FLAG_DYNAMIC) != 0) 885 #define kis_bool_check_cont(c_) ((tv_get_kflags(c_) & K_FLAG_BOOL_CHECK) != 0) 886 #define kis_inert_ret_cont(c_) ((tv_get_kflags(c_) & K_FLAG_INERT_RET) != 0) 887 888 #define K_FLAG_OUTPUT_PORT 0x01 889 #define K_FLAG_INPUT_PORT 0x02 890 #define K_FLAG_CLOSED_PORT 0x04 891 /* At least for now ports are either binary or textual */ 892 #define K_FLAG_BINARY_PORT 0x08 893 894 #define kport_set_input(o_) (tv_get_kflags(o_) |= K_FLAG_INPUT_PORT) 895 #define kport_set_output(o_) (tv_get_kflags(o_) |= K_FLAG_INPUT_PORT) 896 #define kport_set_closed(o_) (tv_get_kflags(o_) |= K_FLAG_CLOSED_PORT) 897 #define kport_set_binary(o_) (tv_get_kflags(o_) |= K_FLAG_BINARY_PORT) 898 899 #define kport_is_input(o_) ((tv_get_kflags(o_) & K_FLAG_INPUT_PORT) != 0) 900 #define kport_is_output(o_) ((tv_get_kflags(o_) & K_FLAG_OUTPUT_PORT) != 0) 901 #define kport_is_open(o_) ((tv_get_kflags(o_) & K_FLAG_CLOSED_PORT) == 0) 902 #define kport_is_closed(o_) ((tv_get_kflags(o_) & K_FLAG_CLOSED_PORT) != 0) 903 #define kport_is_binary(o_) ((tv_get_kflags(o_) & K_FLAG_BINARY_PORT) != 0) 904 #define kport_is_textual(o_) ((tv_get_kflags(o_) & K_FLAG_BINARY_PORT) == 0) 905 906 #define K_FLAG_WEAK_KEYS 0x01 907 #define K_FLAG_WEAK_VALUES 0x02 908 #define K_FLAG_WEAK_NOTHING 0x00 909 910 #define ktable_has_weak_keys(o_) \ 911 ((tv_get_kflags(o_) & K_FLAG_WEAK_KEYS) != 0) 912 #define ktable_has_weak_values(o_) \ 913 ((tv_get_kflags(o_) & K_FLAG_WEAK_VALUES) != 0) 914 915 /* Macro to test the most basic equality on TValues */ 916 #define tv_equal(tv1_, tv2_) ((tv1_).raw == (tv2_).raw) 917 918 /* Symbols could be eq? but not tv_equal? because of source info */ 919 #define tv_sym_equal(sym1_, sym2_) \ 920 (tv_equal(tv2sym(sym1_)->str, tv2sym(sym2_)->str)) 921 922 /* 923 ** for internal debug only 924 */ 925 #define checkconsistency(obj) \ 926 klisp_assert(!iscollectable(obj) || (ttype_(obj) == gcvalue(obj)->gch.tt)) 927 928 #define checkliveness(g,obj) \ 929 klisp_assert(!iscollectable(obj) || \ 930 ((ttype_(obj) == gcvalue(obj)->gch.tt) && !isdead(g, gcvalue(obj)))) 931 932 933 #endif