types.h

Go to the documentation of this file.

/* 
 * Cyclone Scheme
 * Copyright (c) 2014, Justin Ethier
 * All rights reserved.
 *
 * This file contains C types used by compiled programs.
 */
 
#ifndef CYCLONE_TYPES_H
#define CYCLONE_TYPES_H
 
#include <math.h>
#include <complex.h>
#include <setjmp.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <pthread.h>
#include <stdint.h>
#include <dlfcn.h>
#include "cyclone/bignum.h"
 
#ifdef CYC_HIGH_RES_TIMERS
 
long long hrt_get_current();
long long hrt_cmp_current(long long tstamp);
void hrt_log_delta(const char *label, long long tstamp);
#endif
 
typedef void *object;
 
enum object_tag {
        closure0_tag    = 0
      , closure1_tag    = 1
      , closureN_tag    = 2
      , macro_tag       = 3 // Keep closures here for quick type checking
      , boolean_tag     = 4
      , bytevector_tag  = 5
      , c_opaque_tag    = 6
      , cond_var_tag    = 7
      , cvar_tag        = 8
      , double_tag      = 9
      , eof_tag         = 10
      , forward_tag     = 11
      , integer_tag     = 12
      , bignum_tag      = 13
      , mutex_tag       = 14
      , pair_tag        = 15
      , port_tag        = 16 
      , primitive_tag   = 17
      , string_tag      = 18
      , symbol_tag      = 19
      , vector_tag      = 20
      , complex_num_tag = 21
      , atomic_tag      = 22
      , void_tag        = 23
      , record_tag      = 24
};
 
#define obj_is_not_closure(obj) \
  ((obj == NULL) || is_value_type(obj) || (type_of(obj) > macro_tag))
 
typedef unsigned char tag_type;
 
#define type_of(obj) (((pair_type *) obj)->tag)
 
// Parameters for size of a "page" on the heap (the second generation GC), in bytes.
 
#define GROW_HEAP_BY_SIZE (2 * 1024 * 1024)    
 
#define INITIAL_HEAP_SIZE (3 * 1024 * 1024)     
 
#define HEAP_SIZE (8 * 1024 * 1024)    
 
// End heap page size parameters
 
// Major GC tuning parameters
 
#define GC_COLLECTION_THRESHOLD 0.0125 //0.05
 
#define GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT 3
 
#define GC_FREE_THRESHOLD 0.40
// END GC tuning
 
#define MAX_STACK_TRACES 10
 
#define DEBUG_SHOW_DIAG 0
 
#define GC_DEBUG_SHOW_SWEEP_DIAG 0
 
#define GC_DEBUG_TRACE 0
 
#define GC_DEBUG_VERBOSE 0
 
#define GC_SAFETY_CHECKS 0
 
#define NANOSECONDS_PER_MILLISECOND 1000000
 
/* GC data structures */
 
typedef enum { 
    HEAP_SM = 0  // 32 byte objects (min gc_heap_align)
  , HEAP_64
  , HEAP_96
  , HEAP_REST    // Everything else
  , HEAP_HUGE    // Huge objects, 1 per page
} gc_heap_type;
 
#if INTPTR_MAX == INT64_MAX
#define LAST_FIXED_SIZE_HEAP_TYPE HEAP_96
#else
#define LAST_FIXED_SIZE_HEAP_TYPE HEAP_64
#endif
 
#define NUM_HEAP_TYPES (HEAP_HUGE + 1)
 
typedef struct gc_free_list_t gc_free_list;
struct gc_free_list_t {
  unsigned int size;
  gc_free_list *next;
};
 
typedef struct gc_heap_t gc_heap;
struct gc_heap_t {
  gc_heap_type type;
  unsigned int size;
  unsigned int ttl; 
  unsigned int remaining;
  unsigned block_size;
  unsigned int free_size; 
  unsigned char is_full; 
  unsigned char is_unswept;
  int num_unswept_children;
  unsigned int last_alloc_size;
  gc_heap *next_free;
  gc_free_list *free_list;
  gc_heap *next;                // TBD, linked list is not very efficient, but easy to work with as a start
  char *data;
  char *data_end;
};
 
typedef struct gc_heap_root_t gc_heap_root;
struct gc_heap_root_t {
  gc_heap **heap;
};
 
typedef struct gc_header_type_t gc_header_type;
struct gc_header_type_t {
  unsigned char mark;      // mark bits 
  unsigned char grayed:1;    // stack object to be grayed when moved to heap
  unsigned char immutable:1; // Flag normally mutable obj (EG: pair) as read-only
};
 
#define mark(x) (((list) x)->hdr.mark)
 
#define grayed(x) (((list) x)->hdr.grayed)
 
//** Access an object's "immutable" field */
#define immutable(x) (((list) x)->hdr.immutable)
 
typedef enum { STATUS_ASYNC, STATUS_SYNC1, STATUS_SYNC2
} gc_status_type;
 
typedef enum { STAGE_CLEAR_OR_MARKING, STAGE_TRACING
      //, STAGE_REF_PROCESSING 
  , STAGE_SWEEPING, STAGE_RESTING
} gc_stage_type;
 
// Constant colors are defined here.
// The mark/clear colors are defined in the gc module because
// the collector swaps their values as an optimization.
 
#define gc_color_red  0         
 
#define gc_color_blue 2         
 
typedef struct mark_buffer_t mark_buffer;
struct mark_buffer_t {
  void **buf;
  unsigned buf_len;
  mark_buffer *next;
};
 
typedef enum { CYC_THREAD_STATE_NEW, CYC_THREAD_STATE_RUNNABLE,
  CYC_THREAD_STATE_BLOCKED, CYC_THREAD_STATE_BLOCKED_COOPERATING,
  CYC_THREAD_STATE_TERMINATED
} cyc_thread_state_type;
 
typedef struct gc_thread_data_t gc_thread_data;
struct gc_thread_data_t {
  char **stack_traces;
  int stack_trace_idx;
  char *stack_prev_frame;
  cyc_thread_state_type thread_state;
  char *stack_start;
  char *stack_limit;
  void **mutations;
  int mutation_buflen;
  int mutation_count;
  unsigned char globals_changed;
  void **moveBuf;
  int moveBufLen;
  unsigned char gc_alloc_color;
  unsigned char gc_trace_color;
  uint8_t gc_done_tracing;
  int gc_status;
  int last_write;
  int last_read;
  int pending_writes;
  mark_buffer *mark_buffer;
  int mark_buffer_len;
  pthread_mutex_t lock;
  pthread_t thread_id;
  gc_heap_root *heap;
  uintptr_t *cached_heap_free_sizes;
  uintptr_t *cached_heap_total_sizes;
  int heap_num_huge_allocations;
  int num_minor_gcs;
  object exception_handler_stack;
  object param_objs;
  jmp_buf *jmp_start;
  object gc_cont;
  object *gc_args;
  short gc_num_args;
  object scm_thread_obj;
};
 
/* GC prototypes */
void gc_initialize(void);
void gc_add_new_unrunning_mutator(gc_thread_data * thd);
void gc_add_mutator(gc_thread_data * thd);
void gc_remove_mutator(gc_thread_data * thd);
int gc_is_mutator_active(gc_thread_data *thd);
int gc_is_mutator_new(gc_thread_data *thd);
void gc_sleep_ms(int ms);
gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data *thd);
gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page);
void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc);
void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src);
void gc_print_stats(gc_heap * h);
gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data *thd);
char *gc_copy_obj(object hp, char *obj, gc_thread_data * thd);
void *gc_try_alloc(gc_heap * h, size_t size, char *obj,
                   gc_thread_data * thd);
void *gc_try_alloc_slow(gc_heap *h_passed, gc_heap *h, size_t size, char *obj, gc_thread_data *thd);
void *gc_alloc(gc_heap_root * h, size_t size, char *obj, gc_thread_data * thd,
               int *heap_grown);
void *gc_alloc_bignum(gc_thread_data *data);
size_t gc_allocated_bytes(object obj, gc_free_list * q, gc_free_list * r);
gc_heap *gc_heap_last(gc_heap * h);
 
void gc_heap_create_rest(gc_heap *h, gc_thread_data *thd);
void *gc_try_alloc_rest(gc_heap * h, size_t size, char *obj, gc_thread_data * thd);
void *gc_alloc_rest(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd, int *heap_grown);
void gc_init_fixed_size_free_list(gc_heap *h);
 
//size_t gc_heap_total_size(gc_heap * h);
//size_t gc_heap_total_free_size(gc_heap *h);
//size_t gc_collect(gc_heap *h, size_t *sum_freed);
//void gc_mark(gc_heap *h, object obj);
void gc_request_mark_globals(void);
void gc_mark_globals(object globals, object global_table);
//size_t gc_sweep(gc_heap * h, size_t * sum_freed_ptr, gc_thread_data *thd);
gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd);
void gc_thr_grow_move_buffer(gc_thread_data * d);
void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
                         long stack_size);
void gc_thread_data_free(gc_thread_data * thd);
// Prototypes for mutator/collector:
#define gc_is_stack_obj(low_limit, thd, obj) \
 (stack_overflow(((object)low_limit), ((object)obj)) && \
  stack_overflow(((object)obj), ((object)((gc_thread_data *)thd)->stack_start)))
void gc_mut_update(gc_thread_data * thd, object old_obj, object value);
void gc_mut_cooperate(gc_thread_data * thd, int buf_len);
void gc_mark_gray(gc_thread_data * thd, object obj);
void gc_mark_gray2(gc_thread_data * thd, object obj);
void gc_collector_trace();
void gc_empty_collector_stack();
void gc_handshake(gc_status_type s);
void gc_post_handshake(gc_status_type s);
void gc_wait_handshake();
void gc_start_collector();
void gc_mutator_thread_blocked(gc_thread_data * thd, object cont);
void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object maybe_copied);
void Cyc_make_shared_object(void *data, object k, object obj);
#define set_thread_blocked(d, c) \
  gc_mutator_thread_blocked(((gc_thread_data *)d), (c))
 
#define return_thread_runnable(d, r) \
  gc_mutator_thread_runnable(((gc_thread_data *)d), (r), NULL)
 
#define return_thread_runnable_with_obj(d, r, maybe_copied) \
  gc_mutator_thread_runnable(((gc_thread_data *)d), (r), maybe_copied)
/*
//#define do_with_blocked_thread(data, cont, result, body) \
//  set_thread_blocked((data), (cont)); \
//  body \
//  return_thread_runnable((data), (result));
*/
 
#define NUM_GC_ARGS 128
 
#define STACK_GROWTH_IS_DOWNWARD 1
 
#define STACK_SIZE 500000
 
#define MAX_STACK_OBJ (STACK_SIZE * 2)
 
#if STACK_GROWTH_IS_DOWNWARD
#define stack_overflow(x,y) ((x) < (y))
#else
#define stack_overflow(x,y) ((x) > (y))
#endif
 
#define forward(obj) (((pair_type *) obj)->pair_car)
 
 
void add_mutation(void *data, object var, int index, object value);
void clear_mutations(void *data);
object transport_stack_value(gc_thread_data *data, object var, object value, int *run_gc);
// END GC section
object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *args);
object Cyc_scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg);
#define CYC_FIXNUM_MAX 1073741823
 
#define CYC_FIXNUM_MIN -1073741824
 
typedef uint32_t char_type;
 
#define obj_is_int(x)  ((unsigned long)(x) & (unsigned long)1)
 
//#define obj_obj2int(n)   (((long)((ulong)(n) & ~1))/(long)(1uL<<1))
#define obj_obj2int(x) ((long)((uintptr_t)x)>>1)
 
//#define obj_int2obj(n) ((void *) ((((long)(n))*(long)(1uL<<1)) | 1))
#define obj_int2obj(c) ((void *)((((long)c)*2) | 1))
 
#define obj_is_char(x)  (((unsigned long)(x) & (unsigned long)3) == 2)
 
#define obj_obj2char(x) (char_type)((uintptr_t)(x)>>2)
 
#define obj_char2obj(c) ((void *)((((uintptr_t)c)<<2) | 2))
 
#define is_value_type(x) ((unsigned long)(x) & (unsigned long)3)
 
#define is_object_type(x) ((x != NULL) && !is_value_type(x))
 
typedef void (*function_type) (void *data, object clo, int argc, object *args);
 
typedef void (*primitive_function_type)(void *data, object cont, object args);
 
typedef object (*inline_function_type) ();
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  object *pvar;
} cvar_type;
typedef cvar_type *cvar;
 
#define make_cvar(n,v) \
  cvar_type n; \
  n.hdr.mark = gc_color_red; \
  n.hdr.grayed = 0; \
  n.hdr.immutable = 0; \
  n.tag = cvar_tag; \
  n.pvar = v;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  unsigned char collect_ptr;
  void *ptr;
} c_opaque_type;
typedef c_opaque_type *c_opaque;
 
#define make_c_opaque(var, p) \
  c_opaque_type var; \
  var.hdr.mark = gc_color_red; \
  var.hdr.grayed = 0; \
  var.hdr.immutable = 0; \
  var.tag = c_opaque_tag; \
  var.collect_ptr = 0; \
  var.ptr = p;
 
#define opaque_ptr(x) (((c_opaque)x)->ptr)
 
#define opaque_collect_ptr(x) (((c_opaque)x)->collect_ptr)
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  pthread_mutex_t lock;
} mutex_type;
typedef mutex_type *mutex;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  pthread_cond_t cond;
} cond_var_type;
typedef cond_var_type *cond_var;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  object obj;
} atomic_type;
typedef atomic_type *atomic;
 
typedef struct {
  gc_header_type hdr;
  const tag_type tag;
  const char *desc;
} boolean_type;
typedef boolean_type *boolean;
 
#define boolean_desc(x) (((boolean_type *) x)->desc)
 
#define make_boolean(x) (x ? boolean_t : boolean_f)
 
typedef struct {
  gc_header_type hdr;
  const tag_type tag;
  const char *desc;
} symbol_type;
typedef symbol_type *symbol;
 
#define symbol_desc(x) (((symbol_type *) x)->desc)
 
#define defsymbol(name) \
static object quote_##name = NULL;
 
/* Define numeric types */
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  int value;
  int padding;                  // Prevent mem corruption if sizeof(int) < sizeof(ptr)
} integer_type;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  mp_int bn;
} bignum_type;
 
#define alloc_bignum(data, p) \
  bignum_type *p = gc_alloc_bignum((gc_thread_data *)data);
 
#define BIGNUM_CALL(x) { \
  int __bn_mp_rv; \
  if ((__bn_mp_rv = (x)) != MP_OKAY) { \
    fprintf(stderr, "Error calling bignum function: %s\n", \
      mp_error_to_string(__bn_mp_rv)); \
    exit(1); \
  } \
}
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  double complex value;
} complex_num_type;
 
#define make_complex_num(n,r,i) \
  complex_num_type n; \
  n.hdr.mark = gc_color_red; \
  n.hdr.grayed = 0; \
  n.tag = complex_num_tag; \
  n.value = (r + (i * I));
 
#define alloca_complex_num(n,r,i) \
  complex_num_type *n = alloca(sizeof(complex_num_type)); \
  n->hdr.mark = gc_color_red; \
  n->hdr.grayed = 0; \
  n->tag = complex_num_tag; \
  n->value = (r + (i * I));
 
#define assign_complex_num(pobj,v) \
  ((complex_num_type *)pobj)->hdr.mark = gc_color_red; \
  ((complex_num_type *)pobj)->hdr.grayed = 0; \
  ((complex_num_type *)pobj)->tag = complex_num_tag; \
  complex_num_value(pobj) = v;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  double value;
} double_type;
 
#define make_double(n,v) \
  double_type n; \
  n.hdr.mark = gc_color_red; \
  n.hdr.grayed = 0; \
  n.tag = double_tag; \
  n.value = v;
 
#define alloca_double(n,v) \
  double_type *n = alloca(sizeof(double_type)); \
  n->hdr.mark = gc_color_red; \
  n->hdr.grayed = 0; \
  n->tag = double_tag; \
  n->value = v;
 
#define assign_double(pobj,v) \
  ((double_type *)pobj)->hdr.mark = gc_color_red; \
  ((double_type *)pobj)->hdr.grayed = 0; \
  ((double_type *)pobj)->tag = double_tag; \
  double_value(pobj) = v;
 
#define integer_value(x) (((integer_type *) x)->value)
 
#define double_value(x) (((double_type *) x)->value)
 
#define bignum_value(x) (((bignum_type *) x)->bn)
 
#define complex_num_value(x) (((complex_num_type *) x)->value)
 
typedef enum {
    CYC_BN_LTE = -2
  , CYC_BN_LT = MP_LT
  , CYC_BN_EQ = MP_EQ
  , CYC_BN_GT = MP_GT
  , CYC_BN_GTE = 2
} bn_cmp_type;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  int num_cp;
  int len;
  char *str;
} string_type;
 
// TODO: below macros are obsolete, need new ones that populate num_cp and
// raise an error if an invalid UTF-8 char is detected
 
#define make_string(cs, s) string_type cs; \
{ int len = strlen(s); \
  cs.hdr.mark = gc_color_red; \
  cs.hdr.grayed = 0; \
  cs.hdr.immutable = 0; \
  cs.tag = string_tag; \
  cs.num_cp = len; \
  cs.len = len; \
  cs.str = alloca(sizeof(char) * (len + 1)); \
  memcpy(cs.str, s, len + 1);}
 
#define make_string_with_len(cs, s, length) string_type cs;  \
{ int len = length; \
  cs.hdr.mark = gc_color_red; \
  cs.hdr.grayed = 0; \
  cs.hdr.immutable = 0; \
  cs.tag = string_tag; cs.len = len; \
  cs.num_cp = len; \
  cs.str = alloca(sizeof(char) * (len + 1)); \
  memcpy(cs.str, s, len); \
  cs.str[len] = '\0';}
 
#define make_string_noalloc(cs, s, length) string_type cs; \
{ cs.hdr.mark = gc_color_red; cs.hdr.grayed = 0; cs.hdr.immutable = 0; \
  cs.tag = string_tag; cs.len = length; \
  cs.num_cp = length; \
  cs.str = s; }
 
#define make_utf8_string(data, cs, s) string_type cs; \
{ int len = strlen(s); \
  cs.hdr.mark = gc_color_red; \
  cs.hdr.grayed = 0; \
  cs.hdr.immutable = 0; \
  cs.tag = string_tag; \
  cs.num_cp = Cyc_utf8_count_code_points((uint8_t *)s); \
  if (cs.num_cp < 0) { \
    Cyc_rt_raise_msg(data, "Invalid UTF-8 characters in string"); \
  } \
  cs.len = len; \
  cs.str = alloca(sizeof(char) * (len + 1)); \
  memcpy(cs.str, s, len + 1);}
 
#define make_utf8_string_with_len(cs, s, length, num_code_points) string_type cs;  \
{ int len = length; \
  cs.hdr.mark = gc_color_red; \
  cs.hdr.grayed = 0; \
  cs.hdr.immutable = 0; \
  cs.tag = string_tag; cs.len = len; \
  cs.num_cp = num_code_points; \
  cs.str = alloca(sizeof(char) * (len + 1)); \
  memcpy(cs.str, s, len); \
  cs.str[len] = '\0';}
 
#define make_utf8_string_noalloc(cs, s, length) string_type cs; \
{ cs.hdr.mark = gc_color_red; cs.hdr.grayed = 0; cs.hdr.immutable = 0; \
  cs.tag = string_tag; cs.len = length; \
  cs.num_cp = length; \
  cs.str = s; }
 
#define alloc_string(_data, _s, _len, _num_cp) \
  if (_len >= MAX_STACK_OBJ) { \
    int heap_grown; \
    _s = gc_alloc(((gc_thread_data *)data)->heap,  \
                 sizeof(string_type) + _len + 1, \
                 boolean_f, /* OK to populate manually over here */ \
                 (gc_thread_data *)data,  \
                 &heap_grown); \
    ((string_type *) _s)->hdr.mark = ((gc_thread_data *)data)->gc_alloc_color; \
    ((string_type *) _s)->hdr.grayed = 0; \
    ((string_type *) _s)->hdr.immutable = 0; \
    ((string_type *) _s)->tag = string_tag; \
    ((string_type *) _s)->len = _len; \
    ((string_type *) _s)->num_cp = _num_cp; \
    ((string_type *) _s)->str = (((char *)_s) + sizeof(string_type)); \
  } else { \
    _s = alloca(sizeof(string_type)); \
    ((string_type *)_s)->hdr.mark = gc_color_red;  \
    ((string_type *)_s)->hdr.grayed = 0; \
    ((string_type *)_s)->hdr.immutable = 0; \
    ((string_type *)_s)->tag = string_tag;  \
    ((string_type *)_s)->len = _len; \
    ((string_type *)_s)->num_cp = _num_cp; \
    ((string_type *)_s)->str = alloca(sizeof(char) * (_len + 1)); \
  }
 
#define alloc_bytevector(_data, _bv, _len) \
  if (_len >= MAX_STACK_OBJ) { \
    int heap_grown; \
    _bv = gc_alloc(((gc_thread_data *)data)->heap, \
                  sizeof(bytevector_type) + _len, \
                  boolean_f, /* OK to populate manually over here */ \
                  (gc_thread_data *)data, \
                  &heap_grown); \
    ((bytevector) _bv)->hdr.mark = ((gc_thread_data *)data)->gc_alloc_color; \
    ((bytevector) _bv)->hdr.grayed = 0; \
    ((bytevector) _bv)->hdr.immutable = 0; \
    ((bytevector) _bv)->tag = bytevector_tag; \
    ((bytevector) _bv)->len = _len; \
    ((bytevector) _bv)->data = (char *)(((char *)_bv) + sizeof(bytevector_type)); \
  } else { \
    _bv = alloca(sizeof(bytevector_type)); \
    ((bytevector) _bv)->hdr.mark = gc_color_red; \
    ((bytevector) _bv)->hdr.grayed = 0; \
    ((bytevector) _bv)->hdr.immutable = 0; \
    ((bytevector) _bv)->tag = bytevector_tag; \
    ((bytevector) _bv)->len = _len; \
    ((bytevector) _bv)->data = alloca(sizeof(char) * _len); \
  }
 
#define string_num_cp(x) (((string_type *) x)->num_cp)
 
#define string_len(x) (((string_type *) x)->len)
 
#define string_str(x) (((string_type *) x)->str)
 
/* I/O types */
 
// TODO: FILE* may not be good enough
//       consider http://stackoverflow.com/questions/6206893/how-to-implement-char-ready-in-c
// TODO: a simple wrapper around FILE may not be good enough long-term
// TODO: how exactly mode will be used. need to know r/w, bin/txt
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  void *unused; // Protect against forwarding pointer, ideally would not be needed.
  FILE *fp;
  int mode;
  unsigned char flags;
  unsigned int line_num;
  unsigned int col_num;
  unsigned int buf_idx;
  unsigned int tok_start; // Start of token in mem_buf (end is unknown yet)
  unsigned int tok_end; // End of token in tok_buf (start is tok_buf[0])
  char *tok_buf; // Alternative buffer for tokens
  size_t tok_buf_len; 
  char *mem_buf;
  size_t mem_buf_len;
  unsigned short read_len;
  char *str_bv_in_mem_buf;
  size_t str_bv_in_mem_buf_len;
} port_type;
 
#define CYC_BINARY_PORT_FLAG 0x10
 
#define CYC_IO_BUF_LEN 1024
 
#define make_port(p,f,m) \
  port_type p; \
  p.hdr.mark = gc_color_red; \
  p.hdr.grayed = 0; \
  p.hdr.immutable = 0; \
  p.tag = port_tag; \
  p.fp = f; \
  p.mode = m; \
  p.flags = 0; \
  p.line_num = 1; \
  p.col_num = 1; \
  p.buf_idx = 0; \
  p.tok_start = 0; \
  p.tok_end = 0; \
  p.tok_buf = NULL; \
  p.tok_buf_len = 0; \
  p.mem_buf = NULL; \
  p.mem_buf_len = 0; \
  p.str_bv_in_mem_buf = NULL; \
  p.str_bv_in_mem_buf_len = 0; \
  p.read_len = 1;
 
#define make_input_port(p,f,rl) \
  port_type p; \
  p.hdr.mark = gc_color_red; \
  p.hdr.grayed = 0; \
  p.hdr.immutable = 0; \
  p.tag = port_tag; \
  p.fp = f; \
  p.mode = 1; \
  p.flags = 1; \
  p.line_num = 1; \
  p.col_num = 1; \
  p.buf_idx = 0; \
  p.tok_start = 0; \
  p.tok_end = 0; \
  p.tok_buf = malloc(CYC_IO_BUF_LEN); \
  p.tok_buf_len = CYC_IO_BUF_LEN; \
  p.mem_buf = malloc(CYC_IO_BUF_LEN); \
  p.mem_buf_len = 0; \
  p.str_bv_in_mem_buf = NULL; \
  p.str_bv_in_mem_buf_len = 0; \
  p.read_len = rl;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  int num_elements;
  object *elements;
} vector_type;
typedef vector_type *vector;
 
typedef struct { vector_type v; object arr[2]; } vector_2_type;
typedef struct { vector_type v; object arr[3]; } vector_3_type;
typedef struct { vector_type v; object arr[4]; } vector_4_type;
typedef struct { vector_type v; object arr[5]; } vector_5_type;
 
#define make_empty_vector(v) \
  vector_type v; \
  v.hdr.mark = gc_color_red; \
  v.hdr.grayed = 0; \
  v.hdr.immutable = 0; \
  v.tag = vector_tag; \
  v.num_elements = 0; \
  v.elements = NULL;
 
#define alloca_empty_vector(v) \
  vector_type *v = alloca(sizeof(vector_type)); \
  v->hdr.mark = gc_color_red; \
  v->hdr.grayed = 0; \
  v->hdr.immutable = 0; \
  v->tag = vector_tag; \
  v->num_elements = 0; \
  v->elements = NULL;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  int len;
  char *data;
} bytevector_type;
typedef bytevector_type *bytevector;
 
#define make_empty_bytevector(v) \
  bytevector_type v; \
  v.hdr.mark = gc_color_red; \
  v.hdr.grayed = 0; \
  v.hdr.immutable = 0; \
  v.tag = bytevector_tag; \
  v.len = 0; \
  v.data = NULL;
 
#define alloca_empty_bytevector(v) \
  bytevector_type *v = alloca(sizeof(bytevector_type)); \
  v->hdr.mark = gc_color_red; \
  v->hdr.grayed = 0; \
  v->hdr.immutable = 0; \
  v->tag = bytevector_tag; \
  v->len = 0; \
  v->data = NULL;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  object pair_car;
  object pair_cdr;
} pair_type;
typedef pair_type *list;
typedef pair_type *pair;
 
#define make_pair(n,a,d) \
  pair_type n; \
  n.hdr.mark = gc_color_red; \
  n.hdr.grayed = 0; \
  n.hdr.immutable = 0; \
  n.tag = pair_tag; \
  n.pair_car = a; \
  n.pair_cdr = d;
 
#define alloca_pair(n,a,d) \
  pair_type *n = alloca(sizeof(pair_type)); \
  n->hdr.mark = gc_color_red; \
  n->hdr.grayed = 0; \
  n->hdr.immutable = 0; \
  n->tag = pair_tag; \
  n->pair_car = a; \
  n->pair_cdr = d;
 
#define set_pair(n,a,d) \
  n->hdr.mark = gc_color_red; \
  n->hdr.grayed = 0; \
  n->hdr.immutable = 0; \
  n->tag = pair_tag; \
  n->pair_car = a; \
  n->pair_cdr = d;
 
#define set_pair_as_expr(n,a,d) \
 (((pair)(n))->hdr.mark = gc_color_red, \
  ((pair)(n))->hdr.grayed = 0, \
  ((pair)(n))->hdr.immutable = 0, \
  ((pair)(n))->tag = pair_tag, \
  ((pair)(n))->pair_car = a, \
  ((pair)(n))->pair_cdr = d, \
  (n))
 
//typedef list_1_type pair_type;
typedef struct { pair_type a; pair_type b; } list_2_type;
typedef struct { pair_type a; pair_type b; pair_type c;} list_3_type;
typedef struct { pair_type a; pair_type b; pair_type c; pair_type d;} list_4_type;
 
#define make_cell(n,a) make_pair(n,a,NULL)
#define alloca_cell(n,a) alloca_pair(n,a,NULL)
#define set_cell_as_expr(n,a) set_pair_as_expr(n,a,NULL)
 
#define car(x)    (((pair_type *) x)->pair_car)
 
#define cdr(x)    (((pair_type *) x)->pair_cdr)
#define caar(x)   (car(car(x)))
#define cadr(x)   (car(cdr(x)))
#define cdar(x)   (cdr(car(x)))
#define cddr(x)   (cdr(cdr(x)))
#define caaar(x)  (car(car(car(x))))
#define caadr(x)  (car(car(cdr(x))))
#define cadar(x)  (car(cdr(car(x))))
#define caddr(x)  (car(cdr(cdr(x))))
#define cdaar(x)  (cdr(car(car(x))))
#define cdadr(x)  (cdr(car(cdr(x))))
#define cddar(x)  (cdr(cdr(car(x))))
#define cdddr(x)  (cdr(cdr(cdr(x))))
#define caaaar(x) (car(car(car(car(x)))))
#define caaadr(x) (car(car(car(cdr(x)))))
#define caadar(x) (car(car(cdr(car(x)))))
#define caaddr(x) (car(car(cdr(cdr(x)))))
#define cadaar(x) (car(cdr(car(car(x)))))
#define cadadr(x) (car(cdr(car(cdr(x)))))
#define caddar(x) (car(cdr(cdr(car(x)))))
#define cadddr(x) (car(cdr(cdr(cdr(x)))))
#define cdaaar(x) (cdr(car(car(car(x)))))
#define cdaadr(x) (cdr(car(car(cdr(x)))))
#define cdadar(x) (cdr(car(cdr(car(x)))))
#define cdaddr(x) (cdr(car(cdr(cdr(x)))))
#define cddaar(x) (cdr(cdr(car(car(x)))))
#define cddadr(x) (cdr(cdr(car(cdr(x)))))
#define cdddar(x) (cdr(cdr(cdr(car(x)))))
#define cddddr(x) (cdr(cdr(cdr(cdr(x)))))
 
#define Cyc_caar(d, x) (Cyc_car(d, Cyc_car(d, x)))
#define Cyc_cadr(d, x) (Cyc_car(d, Cyc_cdr(d, x)))
#define Cyc_cdar(d, x) (Cyc_cdr(d, Cyc_car(d, x)))
#define Cyc_cddr(d, x) (Cyc_cdr(d, Cyc_cdr(d, x)))
#define Cyc_caaar(d, x) (Cyc_car(d, Cyc_car(d, Cyc_car(d, x))))
#define Cyc_caadr(d, x) (Cyc_car(d, Cyc_car(d, Cyc_cdr(d, x))))
#define Cyc_cadar(d, x) (Cyc_car(d, Cyc_cdr(d, Cyc_car(d, x))))
#define Cyc_caddr(d, x) (Cyc_car(d, Cyc_cdr(d, Cyc_cdr(d, x))))
#define Cyc_cdaar(d, x) (Cyc_cdr(d, Cyc_car(d, Cyc_car(d, x))))
#define Cyc_cdadr(d, x) (Cyc_cdr(d, Cyc_car(d, Cyc_cdr(d, x))))
#define Cyc_cddar(d, x) (Cyc_cdr(d, Cyc_cdr(d, Cyc_car(d, x))))
#define Cyc_cdddr(d, x) (Cyc_cdr(d, Cyc_cdr(d, Cyc_cdr(d, x))))
#define Cyc_caaaar(d, x) (Cyc_car(d, Cyc_car(d, Cyc_car(d, Cyc_car(d, x)))))
#define Cyc_caaadr(d, x) (Cyc_car(d, Cyc_car(d, Cyc_car(d, Cyc_cdr(d, x)))))
#define Cyc_caadar(d, x) (Cyc_car(d, Cyc_car(d, Cyc_cdr(d, Cyc_car(d, x)))))
#define Cyc_caaddr(d, x) (Cyc_car(d, Cyc_car(d, Cyc_cdr(d, Cyc_cdr(d, x)))))
#define Cyc_cadaar(d, x) (Cyc_car(d, Cyc_cdr(d, Cyc_car(d, Cyc_car(d, x)))))
#define Cyc_cadadr(d, x) (Cyc_car(d, Cyc_cdr(d, Cyc_car(d, Cyc_cdr(d, x)))))
#define Cyc_caddar(d, x) (Cyc_car(d, Cyc_cdr(d, Cyc_cdr(d, Cyc_car(d, x)))))
#define Cyc_cadddr(d, x) (Cyc_car(d, Cyc_cdr(d, Cyc_cdr(d, Cyc_cdr(d, x)))))
#define Cyc_cdaaar(d, x) (Cyc_cdr(d, Cyc_car(d, Cyc_car(d, Cyc_car(d, x)))))
#define Cyc_cdaadr(d, x) (Cyc_cdr(d, Cyc_car(d, Cyc_car(d, Cyc_cdr(d, x)))))
#define Cyc_cdadar(d, x) (Cyc_cdr(d, Cyc_car(d, Cyc_cdr(d, Cyc_car(d, x)))))
#define Cyc_cdaddr(d, x) (Cyc_cdr(d, Cyc_car(d, Cyc_cdr(d, Cyc_cdr(d, x)))))
#define Cyc_cddaar(d, x) (Cyc_cdr(d, Cyc_cdr(d, Cyc_car(d, Cyc_car(d, x)))))
#define Cyc_cddadr(d, x) (Cyc_cdr(d, Cyc_cdr(d, Cyc_car(d, Cyc_cdr(d, x)))))
#define Cyc_cdddar(d, x) (Cyc_cdr(d, Cyc_cdr(d, Cyc_cdr(d, Cyc_car(d, x)))))
#define Cyc_cddddr(d, x) (Cyc_cdr(d, Cyc_cdr(d, Cyc_cdr(d, Cyc_cdr(d, x)))))
 
/* Closure types */
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  function_type fn;
  int num_args;
} macro_type;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  function_type fn;
  int num_args;
} closure0_type;
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  function_type fn;
  int num_args;
  object element;
} closure1_type;
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  function_type fn;
  int num_args;
  int num_elements;
  object *elements;
} closureN_type;
 
typedef closure0_type *closure0;
typedef closure1_type *closure1;
typedef closureN_type *closureN;
typedef closure0_type *closure;
typedef closure0_type *macro;
 
#define mmacro(c,f) \
  macro_type c; \
  c.hdr.mark = gc_color_red; \
  c.hdr.grayed = 0; \
  c.tag = macro_tag; \
  c.fn = f; \
  c.num_args = -1;
 
#define mclosure0(c, f) \
 static closure0_type c = { .hdr.mark = gc_color_red, .hdr.grayed = 0, .tag = closure0_tag, .fn = f, .num_args = -1 }; /* TODO: need a new macro that initializes num_args */
 
#define maclosure0(c,f,na) \
  closure0_type c; \
  c.hdr.mark = gc_color_red; \
  c.hdr.grayed = 0; \
  c.tag = closure0_tag; \
  c.fn = f; \
  c.num_args = na;
 
#define mclosure1(c,f,a) \
  closure1_type c; \
  c.hdr.mark = gc_color_red; \
  c.hdr.grayed = 0; \
  c.tag = closure1_tag; \
  c.fn = f; \
  c.num_args = -1; \
  c.element = a;
 
typedef struct {
  gc_header_type hdr;
  tag_type tag;
  const char *desc;
  primitive_function_type fn;
} primitive_type;
typedef primitive_type *primitive;
 
#define defprimitive(name, desc, fnc) \
static primitive_type name##_primitive = {primitive_tag, #desc, fnc}; \
static const object primitive_##name = &name##_primitive
 
#define prim(x) (x && ((primitive)x)->tag == primitive_tag)
 
#define prim_name(x) (((primitive_type *) x)->desc)
 
typedef union {
  boolean_type boolean_t;
  pair_type pair_t;
  symbol_type symbol_t;
  primitive_type primitive_t;
  integer_type integer_t;
  double_type double_t;
  bignum_type bignum_t;
  complex_num_type complex_num_t;
} common_type;
 
#define return_copy(ptr, o) \
{ \
  tag_type t; \
  object obj = o; \
  if (!is_object_type(obj)) \
    return obj; \
  t = type_of(obj); \
  if (t == double_tag) { \
    ((common_type *)ptr)->double_t.hdr.mark = gc_color_red; \
    ((common_type *)ptr)->double_t.hdr.grayed = 0; \
    ((common_type *)ptr)->double_t.tag = double_tag; \
    ((common_type *)ptr)->double_t.value = double_value(obj); \
    return ptr; \
  } else { \
    return obj; \
  } \
}
 
typedef struct vpbuffer_t vpbuffer;
struct vpbuffer_t {
  void **buf;
  int len;
  int count;
};
 
vpbuffer *vp_create(void);
void vp_add(vpbuffer *v, void *obj);
 
/* Utility functions */
void **vpbuffer_realloc(void **buf, int *len);
void **vpbuffer_add(void **buf, int *len, int i, void *obj);
void vpbuffer_free(void **buf);
 
/* Bignum utility functions */
int Cyc_bignum_cmp(bn_cmp_type type, object x, int tx, object y, int ty);
void Cyc_int2bignum(int n, mp_int *bn);
 
/* Remaining GC prototypes that require objects to be defined */
void *gc_alloc_from_bignum(gc_thread_data *data, bignum_type *src);
 
int gc_minor(void *data, object low_limit, object high_limit, closure cont,
             object * args, int num_args);
 
void Cyc_import_shared_object(void *data, object cont, object filename, object entry_pt_fnc);
#endif                          /* CYCLONE_TYPES_H */