a

runtime/gyehoek.c

@@ -1,4 +1,5 @@
 #include <stdio.h>
+#include <gc.h>
 #include "gyehoek.h"
 
 SCM scm_newline () {
@@ -14,3 +15,20 @@ SCM scm_write (SCM x) {
   }
   return SCM_PACK(NULL);
 }
+
+SCM scm_words (scm_t_bits word_0, uint32_t n_words) {
+  scm_t_bits *r = GC_malloc (n_words * sizeof (scm_t_bits));
+  r[0] = word_0;
+  return SCM_PACK (r);
+}
+
+SCM scm_from_utf8_string (const char *str, size_t len) {
+  SCM r = scm_words (scm_tc7_string, 3);
+  const char *s = GC_malloc (len);
+  SCM_SET_CELL_WORD (r, 1, len);
+  SCM_SET_CELL_WORD (r, 2, s);
+  return r;
+}
+
+SCM scm_from_utf8_symbol (const char *s) {
+}

runtime/gyehoek.h

@@ -15,6 +15,9 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #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
@@ -22,15 +25,62 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #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))  \
+# 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_I_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
+
+
+
+#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)
+#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))
+
+#define scm_tc7_obarray 0x55
+#define scm_tc7_symbol 0x05
+#define scm_tc7_string 0x15
+
+
+
+SCM scm_words (scm_t_bits word_0, uint32_t n_words);
+
+/* Construct a symbol from a UTF-8 string. */
+SCM scm_from_utf8 (const char *);
+
 
 
 SCM scm_write (SCM);

runtime/obarray.c

@@ -0,0 +1,24 @@
+#include "gyehoek.h"
+#include "obarray.h"
+
+typedef struct {
+  unsigned long hash;
+  scm_t_bits key;
+} scm_t_weak_entry;
+
+struct weak_entry_data {
+  scm_t_weak_entry *in;
+  scm_t_weak_entry *out;
+};
+
+typedef struct {
+  scm_t_weak_entry *entries;    /* the data */
+  scm_i_pthread_mutex_t lock;   /* the lock */
+  unsigned long size;    	/* total number of slots. */
+  unsigned long n_items;	/* number of items in set */
+  unsigned long lower;		/* when to shrink */
+  unsigned long upper;		/* when to grow */
+  int size_index;		/* index into hashset_size */
+  int min_size_index;		/* minimum size_index */
+} scm_t_weak_set;
+

runtime/obarray.h

@@ -0,0 +1,8 @@
+#ifndef OBARRAY_H
+#define OBARRAY_H
+
+#define SCM_OBARRAY_P(x) (SCM_HAS_TYP7 (x, scm_tc7_weak_set))
+
+SCM scm_obarray_insert ()
+
+#endif /* OBARRAY_H */