src/object.h

   1 /*
   2 Copyright (C) 2017-2018 Keziah Wesley
   3
   4 You can redistribute and/or modify this file under the terms of the
   5 GNU Affero General Public License as published by the Free Software
   6 Foundation, either version 3 of the License, or (at your option) any
   7 later version.
   8
   9 This file is distributed in the hope that it will be useful, but
  10 WITHOUT ANY WARRANTY; without even the implied warranty of
  11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  12 Affero General Public License for more details.
  13
  14 You should have received a copy of the GNU Affero General Public
  15 License along with this file. If not, see
  16 <http://www.gnu.org/licenses/>.
  17 */
  18
  19 #ifndef OBJECT_H
  20 #define OBJECT_H
  21
  22 #include "alloc.h"
  23
  24 #include <assert.h>
  25 #include <stdalign.h>
  26 #include <stdbool.h>
  27 #include <stdint.h>
  28
  29 typedef uint32_t evaltype;
  30
  31 enum
  32 {
  33 // pool OK
  34   TYPEPRIM_LOSE = 0x00000000,
  35   TYPEPRIM_FIX32 = 0x00010000,
  36   TYPEPRIM_FIX64 = 0x00020000,
  37   TYPEPRIM_LIST = 0x00030000,
  38   TYPEPRIM_VECTOR = 0x00040000,
  39   TYPEPRIM_UVECTOR = 0x00050000,
  40   TYPEPRIM_SUBR = 0x00060000,
  41   TYPEPRIM_ATOM = 0x00070000,
  42
  43 // can't be in pool
  44   TYPEPRIM_NOPOOL_MASK = 0x70000000,
  45   TYPEPRIM_VECTOR_BODY = 0x70000000,
  46   TYPEPRIM_TUPLE = 0x70010000,
  47
  48 // TYPEPRIM is half of EVALTYPE
  49   TYPEPRIM_MASK = 0x7fff0000
  50 };
  51
  52 enum
  53 {
  54   EVALTYPE_LOSE = TYPEPRIM_LOSE,
  55
  56   EVALTYPE_FIX32 = TYPEPRIM_FIX32,
  57
  58   EVALTYPE_FIX64 = TYPEPRIM_FIX64,
  59
  60   EVALTYPE_LIST = TYPEPRIM_LIST,
  61   EVALTYPE_FORM,
  62   EVALTYPE_FALSE,
  63
  64   EVALTYPE_VECTOR = TYPEPRIM_VECTOR,
  65
  66   EVALTYPE_UVECTOR = TYPEPRIM_UVECTOR,
  67   EVALTYPE_OBLIST,
  68
  69   EVALTYPE_SUBR = TYPEPRIM_SUBR,
  70
  71   EVALTYPE_ATOM = TYPEPRIM_ATOM,
  72
  73   EVALTYPE_VECTOR_BODY = TYPEPRIM_VECTOR_BODY,
  74   EVALTYPE_ATOM_BODY,
  75
  76   EVALTYPE_TUPLE = TYPEPRIM_TUPLE,
  77 };
  78
  79 static inline uint32_t
  80 TYPEPRIM (evaltype x)
  81 {
  82   return x & TYPEPRIM_MASK;
  83 }
  84
  85 static inline bool
  86 TYPEPRIM_EQ (evaltype a, evaltype b)
  87 {
  88   return !((a ^ b) & TYPEPRIM_MASK);
  89 }
  90
  91 typedef struct
  92 {
  93   uint32_t _dummy;
  94 } opaque32;
  95 typedef struct
  96 {
  97   uint64_t _dummy;
  98 } opaque64;
  99
 100 /**
 101 Object types.
 102
 103 An Object's value is accessed through a concrete `foo_object`
 104 type.
 105
 106 `object` can be used to refer to Objects of unspecified type, which
 107 are opaque except for their `type` field. Checked downcasts can be
 108 performed via the `as_foo` functions; unchecked downcasts via
 109 `object.foo` (use only when type information is locally
 110 obvious). Some objects can be upcast to more specific supertypes,
 111 such as `pool_object` for objects that are known to be storeable in
 112 the pool.
 113
 114 The generic `object` type should not be used to accept parameters
 115 that have constraints on their type, and should not be used to
 116 return objects that are of a statically-known type. Encoding type
 117 information in function signatures allows strictly local reasoning
 118 about types.
 119 */
 120
 121 typedef union object object;
 122
 123 typedef struct
 124 {
 125   alignas (8)
 126     // layout so that value can be upcast by reinterpreting as a fix64
 127 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
 128   int32_t n;
 129   uint32_t _pad;
 130 #elif __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
 131   uint32_t _pad;
 132   int32_t n;
 133 #else
 134 #error Unusual endianness?
 135 #endif
 136 } fix32_val;
 137 typedef struct
 138 {
 139   alignas (16) evaltype type;
 140   pool_ptr rest;
 141   fix32_val val;
 142 } fix32_object;
 143
 144 typedef struct
 145 {
 146   alignas (8) int64_t n;
 147 } fix64_val;
 148 typedef struct
 149 {
 150   alignas (16) evaltype type;
 151   pool_ptr rest;
 152   fix64_val val;
 153 } fix64_object;
 154
 155 typedef struct
 156 {
 157   alignas (8) uint32_t _pad;
 158   pool_ptr head;
 159 } list_val;
 160 typedef struct
 161 {
 162   alignas (16) evaltype type;
 163   pool_ptr rest;
 164   list_val val;
 165 } list_object;
 166
 167 typedef struct
 168 {
 169   alignas (8) uint32_t len;
 170   heap_ptr body;
 171 } vector_val;
 172 typedef struct
 173 {
 174   alignas (16) evaltype type;
 175   pool_ptr rest;
 176   vector_val val;
 177 } vector_object;
 178
 179 typedef struct
 180 {
 181   alignas (8) uint32_t len;
 182   heap_ptr body;
 183 } uvector_val;
 184 typedef struct
 185 {
 186   alignas (16) evaltype type;
 187   pool_ptr rest;
 188   uvector_val val;
 189 } uvector_object;
 190
 191 typedef struct
 192 {
 193   alignas (8) void (*fn) ();
 194 } subr_val;
 195 typedef struct
 196 {
 197   alignas (16) evaltype type;
 198   pool_ptr rest;
 199   subr_val val;
 200 } subr_object;
 201
 202 typedef struct
 203 {
 204   alignas (8) uint32_t namelen;
 205   heap_ptr body;
 206 } atom_val;
 207 typedef struct
 208 {
 209   alignas (16) evaltype type;
 210   pool_ptr rest;
 211   atom_val val;
 212 } atom_object;
 213
 214 typedef struct
 215 {
 216   alignas (16)
 217     /// no rest; is a NOPOOL type
 218   evaltype type;
 219   uint32_t len;
 220   /// allocation can be anywhere
 221   object *body;
 222   // uniq_id uid ??
 223 } tuple_object;
 224
 225 typedef struct
 226 {
 227   alignas (16) evaltype type;
 228   uint32_t grow;
 229   uint32_t len;
 230   uint32_t gc;
 231 } dope_object;
 232
 233 /// Value half of a poolable object, for storage in a uvector.
 234 typedef union uv_val
 235 {
 236   fix32_val fix32;
 237   fix64_val fix64;
 238   list_val list;
 239   vector_val vector;
 240   uvector_val uvector;
 241   subr_val subr;
 242   atom_val atom;
 243 } uv_val;
 244
 245 /// Object of a type that can be stored in the pool.
 246 /// NB. a pool_object* can point outside the pool; contrast with pool_ptr.
 247 typedef union pool_object
 248 {
 249   /// any pool object has a type and a rest
 250   struct
 251   {
 252     // NB. never take the address of these type-punned fields!
 253     alignas (16) evaltype type;
 254     pool_ptr rest;
 255     uv_val val;
 256   };
 257   /// objects of statically known type
 258   fix32_object fix32;
 259   fix64_object fix64;
 260   list_object list;
 261   vector_object vector;
 262   uvector_object uvector;
 263   atom_object atom;
 264   subr_object subr;
 265 } pool_object;
 266
 267 union object
 268 {
 269   /// any object has a type
 270   struct
 271   {
 272     // NB. never take the address of these type-punned fields!
 273     alignas (16) evaltype type;
 274     opaque32 _unknown0;
 275     union
 276     {
 277       opaque64 _unknown1;
 278       uv_val uv_val;
 279     };
 280   };
 281   /// objects of statically known type
 282   /// use as_X() for checked downcast
 283   pool_object pool;
 284   fix32_object fix32;
 285   fix64_object fix64;
 286   list_object list;
 287   vector_object vector;
 288   uvector_object uvector;
 289   atom_object atom;
 290   tuple_object tuple;
 291   subr_object subr;
 292 };
 293
 294 /**
 295 Initialization helpers.
 296 */
 297
 298 static inline fix32_object
 299 new_fix32 (int32_t n)
 300 {
 301   return (fix32_object)
 302   {
 303     .type = EVALTYPE_FIX32,.rest = 0,.val = (fix32_val)
 304     {
 305     .n = n}
 306   };
 307 }
 308
 309 static inline fix64_object
 310 new_fix64 (int64_t n)
 311 {
 312   return (fix64_object)
 313   {
 314     .type = EVALTYPE_FIX64,.rest = 0,.val = (fix64_val)
 315     {
 316     .n = n}
 317   };
 318 }
 319
 320 static inline list_object
 321 new_list (pool_ptr head)
 322 {
 323   return (list_object)
 324   {
 325     .type = EVALTYPE_LIST,.rest = 0,.val = (list_val)
 326     {
 327     .head = head}
 328   ,};
 329 }
 330
 331 static inline vector_object
 332 new_vector (heap_ptr body, uint32_t length)
 333 {
 334   return (vector_object)
 335   {
 336     .type = EVALTYPE_VECTOR,.rest = 0,.val = (vector_val)
 337     {
 338     .len = length,.body = body}
 339   ,};
 340 }
 341
 342 static inline uvector_object
 343 new_uvector (heap_ptr body, uint32_t length)
 344 {
 345   return (uvector_object)
 346   {
 347     .type = EVALTYPE_UVECTOR,.rest = 0,.val = (uvector_val)
 348     {
 349     .len = length,.body = body}
 350   };
 351 }
 352
 353 static inline tuple_object
 354 new_tuple (object * body, uint32_t length)
 355 {
 356   return (tuple_object)
 357   {
 358   .type = EVALTYPE_TUPLE,.len = length,.body = body};
 359 }
 360
 361 static inline subr_object
 362 new_subr (void (*fn) ())
 363 {
 364   return (subr_object)
 365   {
 366     .type = EVALTYPE_SUBR,.rest = 0,.val = (subr_val)
 367     {
 368     .fn = fn}
 369   };
 370 }
 371
 372 static inline atom_object
 373 new_atom (pool_ptr body, uint32_t namelen)
 374 {
 375   return (atom_object)
 376   {
 377     .type = EVALTYPE_ATOM,.rest = 0,.val = (atom_val)
 378     {
 379     .body = body,.namelen = namelen}
 380   };
 381 }
 382
 383 static inline dope_object
 384 new_dope (uint32_t len, evaltype type)
 385 {
 386   return (dope_object)
 387   {
 388   .type = type,.grow = 0,.len = len,.gc = 0};
 389 }
 390
 391 /**
 392 Common object operations.
 393 */
 394
 395 uint32_t list_length (const list_object * o);
 396
 397 dope_object *vec_dope (const vector_object * o);
 398
 399 dope_object *uv_dope (const uvector_object * o);
 400
 401 static inline evaltype
 402 utype (const uvector_object * o)
 403 {
 404   return uv_dope (o)->type;
 405 }
 406
 407 object
 408 uv_get (const uvector_object * o, uint32_t i);
 409
 410
 411 // Change the EVALTYPE of an object. New type must have same PRIMTYPE.
 412 static inline void
 413 chtype (object * o, evaltype type)
 414 {
 415   assert (TYPEPRIM_EQ (o->type, type));
 416   o->type = type;
 417 }
 418
 419 // Allocate an vector of LOSEs and return a handle with length=0.
 420 vector_object vector_create (uint32_t capacity);
 421
 422 // Stack-like interface to a VECTOR (with automatic GROW!)
 423 object *stack_push (vector_object * v);
 424
 425 /**
 426 Checked downcasts.
 427 */
 428
 429 static inline fix32_object *
 430 as_fix32 (object * o)
 431 {
 432   assert (TYPEPRIM_EQ (o->type, TYPEPRIM_FIX32));
 433   return &o->fix32;
 434 }
 435
 436 static inline list_object *
 437 as_list (object * o)
 438 {
 439   assert (TYPEPRIM_EQ (o->type, EVALTYPE_LIST));
 440   return &o->list;
 441 }
 442
 443 static inline vector_object *
 444 as_vector (object * o)
 445 {
 446   assert (TYPEPRIM_EQ (o->type, EVALTYPE_VECTOR));
 447   return &o->vector;
 448 }
 449
 450 static inline uvector_object *
 451 as_uvector (object * o)
 452 {
 453   assert (TYPEPRIM_EQ (o->type, EVALTYPE_UVECTOR));
 454   return &o->uvector;
 455 }
 456
 457 static inline pool_object *
 458 as_pool (object * p)
 459 {
 460   assert (!(TYPEPRIM (p->type) & TYPEPRIM_NOPOOL_MASK));
 461   return (pool_object *) p;
 462 }
 463
 464 static inline atom_object *
 465 as_atom (object * o)
 466 {
 467   assert (TYPEPRIM_EQ (o->type, EVALTYPE_ATOM));
 468   return &o->atom;
 469 }
 470
 471 #endif // OBJECT_H