103 lines
2.7 KiB
C
103 lines
2.7 KiB
C
#ifndef GYEHOEK_H
|
||
#define GYEHOEK_H
|
||
|
||
#include <stddef.h>
|
||
#include <stdint.h>
|
||
|
||
|
||
|
||
typedef uintptr_t scm_t_bits;
|
||
|
||
typedef union SCM { struct { scm_t_bits n; } n; } SCM;
|
||
|
||
#define SCM_UNPACK(x) ((x).n.n)
|
||
#define SCM_PACK(x) ((SCM) { { (scm_t_bits) (x) } })
|
||
#define SCM_IMP(x) (6 & SCM_UNPACK (x))
|
||
#define SCM_NIMP(x) (!SCM_IMP (x))
|
||
#define SCM_HEAP_OBJECT_P(x) (SCM_NIMP (x))
|
||
|
||
#define SCM_UNPACK_POINTER(x) ((scm_t_bits *) (SCM_UNPACK (x)))
|
||
#define SCM_PACK_POINTER(x) (SCM_PACK ((scm_t_bits) (x)))
|
||
|
||
#define SCM_FALSE 0b00100
|
||
#define SCM_TRUE 0b01100
|
||
#define SCM_EOL 0b10100
|
||
|
||
#if (-1 >> 2 == -1) && (-4 >> 2 == -1) && (-5 >> 2 == -2) && (-8 >> 2 == -2)
|
||
# define SCM_SRS(x, y) ((x) >> (y))
|
||
#else
|
||
# define SCM_SRS(x, y) \
|
||
((x) < 0 \
|
||
? -1 - (scm_t_signed_bits) (~(scm_t_bits)(x) >> (y)) \
|
||
: ((x) >> (y)))
|
||
#endif
|
||
|
||
#define SCM_MAKE_SMALL_INT(x) (SCM_SRS ((SCM_PACK (x)), 2) + 2)
|
||
#define SCM_GET_SMALL_INT(x) (SCM_UNPACK (x) >> 2)
|
||
|
||
/* Checking if a SCM variable holds a pair (for historical reasons, in
|
||
Guile also known as a cons-cell): This is done by first checking that
|
||
the SCM variable holds a heap object, and second, by checking that
|
||
tc1==0 holds for the SCM_CELL_TYPE of the SCM variable. */
|
||
#define SCM_CONSP(x) (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
|
||
|
||
|
||
|
||
#define scm_tc2_int 2
|
||
|
||
|
||
|
||
#define SCM_ITAG3(x) (7 & SCM_UNPACK (x))
|
||
#define SCM_TYP3(x) (7 & SCM_CELL_TYPE (x))
|
||
|
||
/* #define scm_tc3_cons 0 */
|
||
extern const long scm_tc3_cons;
|
||
|
||
SCM scm_cons (SCM car, SCM cdr);
|
||
SCM scm_car (SCM x);
|
||
SCM scm_cdr (SCM x);
|
||
|
||
|
||
|
||
#define SCM_UNPACK_POINTER(x) ((scm_t_bits *) (SCM_UNPACK (x)))
|
||
#define SCM_PACK_POINTER(x) (SCM_PACK ((scm_t_bits) (x)))
|
||
|
||
#define SCM_CELL_OBJECT(x, n) (((SCM *)SCM_UNPACK_POINTER (x)) [n])
|
||
#define SCM_CELL_WORD(x, n) (SCM_UNPACK (SCM_CELL_OBJECT ((x), (n))))
|
||
|
||
#define SCM_SET_CELL_OBJECT(x, n, v) \
|
||
((((SCM *)SCM_UNPACK_POINTER (x)) [n]) = (v))
|
||
#define SCM_SET_CELL_WORD(x, n, v) \
|
||
(SCM_SET_CELL_OBJECT ((x), (n), SCM_PACK (v)))
|
||
|
||
#define SCM_CELL_TYPE(x) SCM_CELL_WORD (x, 0)
|
||
#define SCM_TYP7(x) (0x7f & SCM_CELL_TYPE (x))
|
||
#define SCM_HAS_HEAP_TYPE(x, type, tag) \
|
||
(SCM_NIMP (x) && type (x) == (tag))
|
||
#define SCM_HAS_TYP7(x, tag) (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
|
||
|
||
extern const long scm_tc7_obarray;
|
||
extern const long scm_tc7_symbol;
|
||
extern const long scm_tc7_string;
|
||
|
||
|
||
|
||
#define SCM_STRINGP(x) (SCM_TYP7 (x) == scm_tc7_string)
|
||
|
||
|
||
|
||
SCM scm_words (scm_t_bits word_0, uint32_t n_words);
|
||
|
||
/* Construct a Scheme string. */
|
||
SCM scm_from_utf8_string (const char *str, size_t len);
|
||
|
||
/* Intern a symbol with a UTF-8 string name. */
|
||
SCM scm_from_utf8_symbol (const char *s, size_t len);
|
||
|
||
|
||
|
||
SCM scm_write (SCM);
|
||
|
||
|
||
#endif /* GYEHOEK_H */
|