294 lines
6.7 KiB
C
294 lines
6.7 KiB
C
/**
|
|
* See Copyright Notice in picrin.h
|
|
*/
|
|
|
|
#ifndef PICRIN_OBJECT_H
|
|
#define PICRIN_OBJECT_H
|
|
|
|
#if defined(__cplusplus)
|
|
extern "C" {
|
|
#endif
|
|
|
|
#include "khash.h"
|
|
|
|
#if PIC_BITMAP_GC
|
|
# define OBJECT_HEADER \
|
|
unsigned char tt;
|
|
#else
|
|
# define OBJECT_HEADER \
|
|
unsigned char tt; \
|
|
char gc_mark;
|
|
#endif
|
|
|
|
struct object; /* defined in gc.c */
|
|
|
|
struct basic {
|
|
OBJECT_HEADER
|
|
};
|
|
|
|
struct identifier {
|
|
OBJECT_HEADER
|
|
union {
|
|
struct string *str;
|
|
struct identifier *id;
|
|
} u;
|
|
struct env *env;
|
|
};
|
|
|
|
typedef struct identifier symbol;
|
|
|
|
KHASH_DECLARE(env, struct identifier *, symbol *)
|
|
|
|
struct env {
|
|
OBJECT_HEADER
|
|
khash_t(env) map;
|
|
struct env *up;
|
|
struct string *lib;
|
|
};
|
|
|
|
struct pair {
|
|
OBJECT_HEADER
|
|
pic_value car;
|
|
pic_value cdr;
|
|
};
|
|
|
|
struct blob {
|
|
OBJECT_HEADER
|
|
unsigned char *data;
|
|
int len;
|
|
};
|
|
|
|
struct string {
|
|
OBJECT_HEADER
|
|
struct rope *rope;
|
|
};
|
|
|
|
KHASH_DECLARE(dict, symbol *, pic_value)
|
|
|
|
struct dict {
|
|
OBJECT_HEADER
|
|
khash_t(dict) hash;
|
|
};
|
|
|
|
KHASH_DECLARE(weak, struct object *, pic_value)
|
|
|
|
struct weak {
|
|
OBJECT_HEADER
|
|
khash_t(weak) hash;
|
|
struct weak *prev; /* for GC */
|
|
};
|
|
|
|
struct vector {
|
|
OBJECT_HEADER
|
|
pic_value *data;
|
|
int len;
|
|
};
|
|
|
|
struct data {
|
|
OBJECT_HEADER
|
|
const pic_data_type *type;
|
|
void *data;
|
|
};
|
|
|
|
struct context {
|
|
OBJECT_HEADER
|
|
pic_value *regs;
|
|
int regc;
|
|
struct context *up;
|
|
pic_value storage[1];
|
|
};
|
|
|
|
struct proc {
|
|
OBJECT_HEADER
|
|
union {
|
|
struct {
|
|
pic_func_t func;
|
|
int localc;
|
|
} f;
|
|
struct {
|
|
struct irep *irep;
|
|
struct context *cxt;
|
|
} i;
|
|
} u;
|
|
pic_value locals[1];
|
|
};
|
|
|
|
struct record {
|
|
OBJECT_HEADER
|
|
pic_value type;
|
|
pic_value datum;
|
|
};
|
|
|
|
struct error {
|
|
OBJECT_HEADER
|
|
symbol *type;
|
|
struct string *msg;
|
|
pic_value irrs;
|
|
struct string *stack;
|
|
};
|
|
|
|
enum {
|
|
FILE_READ = 01,
|
|
FILE_WRITE = 02,
|
|
FILE_UNBUF = 04,
|
|
FILE_EOF = 010,
|
|
FILE_ERR = 020,
|
|
FILE_LNBUF = 040
|
|
};
|
|
|
|
struct port {
|
|
OBJECT_HEADER
|
|
struct file {
|
|
/* buffer */
|
|
char buf[1]; /* fallback buffer */
|
|
long cnt; /* characters left */
|
|
char *ptr; /* next character position */
|
|
char *base; /* location of the buffer */
|
|
/* operators */
|
|
void *cookie;
|
|
const pic_port_type *vtable;
|
|
int flag; /* mode of the file access */
|
|
} file;
|
|
};
|
|
|
|
struct checkpoint {
|
|
OBJECT_HEADER
|
|
struct proc *in;
|
|
struct proc *out;
|
|
int depth;
|
|
struct checkpoint *prev;
|
|
};
|
|
|
|
#define TYPENAME_int "integer"
|
|
#define TYPENAME_blob "bytevector"
|
|
#define TYPENAME_char "character"
|
|
#define TYPENAME_sym "symbol"
|
|
#define TYPENAME_error "error"
|
|
#define TYPENAME_proc "procedure"
|
|
#define TYPENAME_str "string"
|
|
#define TYPENAME_id "identifier"
|
|
#define TYPENAME_env "environment"
|
|
#define TYPENAME_vec "vector"
|
|
|
|
#define TYPE_CHECK(pic, v, type) do { \
|
|
if (! pic_##type##_p(pic, v)) \
|
|
pic_error(pic, TYPENAME_##type " required", 1, v); \
|
|
} while (0)
|
|
|
|
#define VALID_INDEX(pic, len, i) do { \
|
|
if (i < 0 || len <= i) pic_error(pic, "index out of range", 1, pic_int_value(pic, i)); \
|
|
} while (0)
|
|
#define VALID_RANGE(pic, len, s, e) do { \
|
|
if (s < 0 || len < s) pic_error(pic, "invalid start index", 1, pic_int_value(pic, s)); \
|
|
if (e < s || len < e) pic_error(pic, "invalid end index", 1, pic_int_value(pic, e)); \
|
|
} while (0)
|
|
#define VALID_ATRANGE(pic, tolen, at, fromlen, s, e) do { \
|
|
VALID_INDEX(pic, tolen, at); \
|
|
VALID_RANGE(pic, fromlen, s, e); \
|
|
if (tolen - at < e - s) pic_error(pic, "invalid range", 0); \
|
|
} while (0)
|
|
|
|
PIC_STATIC_INLINE int obj_tt(void *ptr) {
|
|
return ((struct basic *)ptr)->tt;
|
|
}
|
|
|
|
#if !PIC_NAN_BOXING
|
|
|
|
PIC_STATIC_INLINE struct object *
|
|
obj_ptr(pic_value v)
|
|
{
|
|
return (struct object *)(v.u.data);
|
|
}
|
|
|
|
PIC_STATIC_INLINE bool
|
|
obj_p(pic_state *PIC_UNUSED(pic), pic_value v)
|
|
{
|
|
return v.type > PIC_IVAL_END;
|
|
}
|
|
|
|
PIC_STATIC_INLINE pic_value
|
|
obj_value(void *ptr)
|
|
{
|
|
pic_value v = pic_make_value(obj_tt(ptr));
|
|
v.u.data = ptr;
|
|
return v;
|
|
}
|
|
|
|
#else /* NAN_BOXING */
|
|
|
|
PIC_STATIC_INLINE struct object *
|
|
obj_ptr(pic_value v)
|
|
{
|
|
return (struct object *)((0x3ffffffffffful & v.v) << 2);
|
|
}
|
|
|
|
PIC_STATIC_INLINE bool
|
|
obj_p(pic_state *PIC_UNUSED(pic), pic_value v)
|
|
{
|
|
return v.v > ((0x3ffC0ul + (0x3f & PIC_IVAL_END)) << 46);
|
|
}
|
|
|
|
PIC_STATIC_INLINE pic_value
|
|
obj_value(void *ptr)
|
|
{
|
|
pic_value v = pic_make_value(obj_tt(ptr));
|
|
v.v |= 0x3ffffffffffful & ((uint64_t)ptr >> 2);
|
|
return v;
|
|
}
|
|
|
|
#endif /* NAN_BOXING */
|
|
|
|
#define DEFPTR(name,type) \
|
|
PIC_STATIC_INLINE type *name(pic_state *PIC_UNUSED(pic), pic_value o) { \
|
|
return (type *) obj_ptr(o); \
|
|
}
|
|
|
|
DEFPTR(pic_id_ptr, struct identifier)
|
|
DEFPTR(pic_sym_ptr, symbol)
|
|
DEFPTR(pic_str_ptr, struct string)
|
|
DEFPTR(pic_blob_ptr, struct blob)
|
|
DEFPTR(pic_pair_ptr, struct pair)
|
|
DEFPTR(pic_vec_ptr, struct vector)
|
|
DEFPTR(pic_dict_ptr, struct dict)
|
|
DEFPTR(pic_weak_ptr, struct weak)
|
|
DEFPTR(pic_data_ptr, struct data)
|
|
DEFPTR(pic_proc_ptr, struct proc)
|
|
DEFPTR(pic_env_ptr, struct env)
|
|
DEFPTR(pic_port_ptr, struct port)
|
|
DEFPTR(pic_error_ptr, struct error)
|
|
DEFPTR(pic_rec_ptr, struct record)
|
|
DEFPTR(pic_cp_ptr, struct checkpoint)
|
|
|
|
struct object *pic_obj_alloc(pic_state *, size_t, int type);
|
|
|
|
pic_value pic_make_identifier(pic_state *, pic_value id, pic_value env);
|
|
pic_value pic_make_proc(pic_state *, pic_func_t, int, pic_value *);
|
|
pic_value pic_make_proc_irep(pic_state *, struct irep *, struct context *);
|
|
pic_value pic_make_env(pic_state *, pic_value env);
|
|
pic_value pic_make_record(pic_state *, pic_value type, pic_value datum);
|
|
|
|
pic_value pic_add_identifier(pic_state *, pic_value id, pic_value env);
|
|
void pic_put_identifier(pic_state *, pic_value id, pic_value uid, pic_value env);
|
|
pic_value pic_find_identifier(pic_state *, pic_value id, pic_value env);
|
|
pic_value pic_id_name(pic_state *, pic_value id);
|
|
|
|
struct rope *pic_rope_incref(struct rope *);
|
|
void pic_rope_decref(pic_state *, struct rope *);
|
|
|
|
struct cont *pic_alloca_cont(pic_state *);
|
|
pic_value pic_make_cont(pic_state *, struct cont *);
|
|
void pic_save_point(pic_state *, struct cont *, PIC_JMPBUF *);
|
|
void pic_exit_point(pic_state *);
|
|
void pic_wind(pic_state *, struct checkpoint *, struct checkpoint *);
|
|
pic_value pic_dynamic_wind(pic_state *, pic_value in, pic_value thunk, pic_value out);
|
|
|
|
pic_value pic_dynamic_bind(pic_state *, pic_value var, pic_value val, pic_value thunk);
|
|
|
|
pic_value pic_library_environment(pic_state *, const char *);
|
|
|
|
#if defined(__cplusplus)
|
|
}
|
|
#endif
|
|
|
|
#endif
|