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     opaque64 _unknown1;
 276   };
 277   /// objects of statically known type
 278   /// use as_X() for checked downcast
 279   pool_object pool;
 280   fix32_object fix32;
 281   fix64_object fix64;
 282   list_object list;
 283   vector_object vector;
 284   uvector_object uvector;
 285   atom_object atom;
 286   tuple_object tuple;
 287   subr_object subr;
 288 };
 289
 290 /**
 291 Initialization helpers.
 292 */
 293
 294 static inline fix32_object
 295 new_fix32 (int32_t n)
 296 {
 297   return (fix32_object)
 298   {
 299     .type = EVALTYPE_FIX32,.rest = 0,.val = (fix32_val)
 300     {
 301     .n = n}
 302   };
 303 }
 304
 305 static inline fix64_object
 306 new_fix64 (int64_t n)
 307 {
 308   return (fix64_object)
 309   {
 310     .type = EVALTYPE_FIX64,.rest = 0,.val = (fix64_val)
 311     {
 312     .n = n}
 313   };
 314 }
 315
 316 static inline list_object
 317 new_list (pool_ptr head)
 318 {
 319   return (list_object)
 320   {
 321     .type = EVALTYPE_LIST,.rest = 0,.val = (list_val)
 322     {
 323     .head = head}
 324   ,};
 325 }
 326
 327 // TODO: take a dope_object like uvector
 328 static inline vector_object
 329 new_vector (heap_ptr body, uint32_t length)
 330 {
 331   return (vector_object)
 332   {
 333     .type = EVALTYPE_VECTOR,.rest = 0,.val = (vector_val)
 334     {
 335     .len = length,.body = body}
 336   ,};
 337 }
 338
 339 static inline uvector_object
 340 new_uvector (heap_ptr body, uint32_t length)
 341 {
 342   return (uvector_object)
 343   {
 344     .type = EVALTYPE_UVECTOR,.rest = 0,.val = (uvector_val)
 345     {
 346     .len = length,.body = body}
 347   };
 348 }
 349
 350 static inline tuple_object
 351 new_tuple (object * body, uint32_t length)
 352 {
 353   return (tuple_object)
 354   {
 355   .type = EVALTYPE_TUPLE,.len = length,.body = body};
 356 }
 357
 358 static inline subr_object
 359 new_subr (void (*fn) ())
 360 {
 361   return (subr_object)
 362   {
 363     .type = EVALTYPE_SUBR,.rest = 0,.val = (subr_val)
 364     {
 365     .fn = fn}
 366   };
 367 }
 368
 369 static inline atom_object
 370 new_atom (pool_ptr body, uint32_t namelen)
 371 {
 372   return (atom_object)
 373   {
 374     .type = EVALTYPE_ATOM,.rest = 0,.val = (atom_val)
 375     {
 376     .body = body,.namelen = namelen}
 377   };
 378 }
 379
 380 static inline dope_object
 381 new_dope (uint32_t len, evaltype type)
 382 {
 383   return (dope_object)
 384   {
 385   .type = type,.grow = 0,.len = len,.gc = 0};
 386 }
 387
 388 /**
 389 Common object operations.
 390 */
 391
 392 uint32_t list_length (const list_object * o);
 393
 394 dope_object *vec_dope (const vector_object * o);
 395
 396 dope_object *uv_dope (const uvector_object * o);
 397
 398 static inline evaltype
 399 utype (const uvector_object * o)
 400 {
 401   return uv_dope (o)->type;
 402 }
 403
 404 // Change the EVALTYPE of an object. New type must have same PRIMTYPE.
 405 static inline void
 406 chtype (object * o, evaltype type)
 407 {
 408   assert (TYPEPRIM_EQ (o->type, type));
 409   o->type = type;
 410 }
 411
 412 // Allocate an vector of LOSEs and return a handle with length=0.
 413 vector_object vector_create (uint32_t capacity);
 414
 415 // Stack-like interface to a VECTOR (with automatic GROW!)
 416 object *stack_push (vector_object * v);
 417
 418 /**
 419 Checked downcasts.
 420 */
 421
 422 static inline fix32_object *
 423 as_fix32 (object * o)
 424 {
 425   assert (TYPEPRIM_EQ (o->type, TYPEPRIM_FIX32));
 426   return &o->fix32;
 427 }
 428
 429 static inline list_object *
 430 as_list (object * o)
 431 {
 432   assert (TYPEPRIM_EQ (o->type, EVALTYPE_LIST));
 433   return &o->list;
 434 }
 435
 436 static inline vector_object *
 437 as_vector (object * o)
 438 {
 439   assert (TYPEPRIM_EQ (o->type, EVALTYPE_VECTOR));
 440   return &o->vector;
 441 }
 442
 443 static inline uvector_object *
 444 as_uvector (object * o)
 445 {
 446   assert (TYPEPRIM_EQ (o->type, EVALTYPE_UVECTOR));
 447   return &o->uvector;
 448 }
 449
 450 static inline pool_object *
 451 as_pool (object * p)
 452 {
 453   assert (!(TYPEPRIM (p->type) & TYPEPRIM_NOPOOL_MASK));
 454   return (pool_object *) p;
 455 }
 456
 457 static inline atom_object *
 458 as_atom (object * o)
 459 {
 460   assert (TYPEPRIM_EQ (o->type, EVALTYPE_ATOM));
 461   return &o->atom;
 462 }
 463
 464 #endif // OBJECT_H