From 31ae7440a5c3129a5806043bfcfe377e2b63b963 Mon Sep 17 00:00:00 2001
From: hyung-hwan <hyunghwan.chung@gmail.com>
Date: Sat, 26 Feb 2011 09:26:16 +0000
Subject: [PATCH] writing reading and printing functions

---
 qse/ac/ltmain.sh          |   4 +-
 qse/cmd/scm/scm.c         |   2 +
 qse/configure             |  42 +-
 qse/configure.ac          |  43 +--
 qse/include/qse/scm/scm.h |   4 +-
 qse/include/qse/types.h   |  14 +-
 qse/lib/scm/Makefile.am   |   2 +-
 qse/lib/scm/Makefile.in   |   5 +-
 qse/lib/scm/err.c         |   4 +-
 qse/lib/scm/print.c       | 180 +++++++++
 qse/lib/scm/scm.c         | 791 +++++++++++++++++++++++++++++---------
 qse/lib/scm/scm.h         |  55 ++-
 12 files changed, 866 insertions(+), 280 deletions(-)
 create mode 100644 qse/lib/scm/print.c

diff --git a/qse/ac/ltmain.sh b/qse/ac/ltmain.sh
index d88da2c2..7ed280bc 100755
--- a/qse/ac/ltmain.sh
+++ b/qse/ac/ltmain.sh
@@ -65,7 +65,7 @@
 #       compiler:		$LTCC
 #       compiler flags:		$LTCFLAGS
 #       linker:		$LD (gnu? $with_gnu_ld)
-#       $progname:		(GNU libtool) 2.2.6b Debian-2.2.6b-2
+#       $progname:		(GNU libtool) 2.2.6b Debian-2.2.6b-2ubuntu1
 #       automake:		$automake_version
 #       autoconf:		$autoconf_version
 #
@@ -73,7 +73,7 @@
 
 PROGRAM=ltmain.sh
 PACKAGE=libtool
-VERSION="2.2.6b Debian-2.2.6b-2"
+VERSION="2.2.6b Debian-2.2.6b-2ubuntu1"
 TIMESTAMP=""
 package_revision=1.3017
 
diff --git a/qse/cmd/scm/scm.c b/qse/cmd/scm/scm.c
index 59c5f053..3de434c9 100644
--- a/qse/cmd/scm/scm.c
+++ b/qse/cmd/scm/scm.c
@@ -164,6 +164,8 @@ int scm_main (int argc, qse_char_t* argv[])
 		qse_scm_attachio (scm, &io);
 	}
 
+qse_scm_read (scm);
+
 #if 0
 	while (1)
 	{
diff --git a/qse/configure b/qse/configure
index 5466ec75..867eeb2b 100755
--- a/qse/configure
+++ b/qse/configure
@@ -15004,37 +15004,26 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
 
 
 
-#dnl overrides the default CFLAGS setting
-#if test "$ac_test_CFLAGS" = "set"
-#then
-#	CFLAGS=$ac_save_CFLAGS
-#else
-#	if test "$GCC" = "yes"
-#	then
-#		CFLAGS="-O2"
-#	else
-#		CFLAGS=
-#	fi
-#fi
+if test "$ac_test_CFLAGS" != "set"
+then
+	if test "$GCC" = "yes"
+	then
+		CFLAGS="$CFLAGS -Wall"
+	fi
+fi
 
-#if test "$ac_test_CXXFLAGS" = "set"
-#then
-#	CXXFLAGS=$ac_save_CXXFLAGS
-#else
-#	if test "$GCC" = "yes"
-#	then
-#		CXXFLAGS="-O2"
-#	else
-#		CXXFLAGS=
-#	fi
-#fi
+if test "$ac_test_CXXFLAGS" != "set"
+then
+	if test "$GCC" = "yes"
+	then
+		CXXFLAGS="$CXXFLAGS -Wall"
+	fi
+fi
 
 CFLAGS="$CFLAGS -DQSE_HAVE_CONFIG_H"
-OBJCFLAGS="$OBJCFLAGS -DQSE_HAVE_CONFIG_H"
 CXXFLAGS="$CXXFLAGS -DQSE_HAVE_CONFIG_H"
 
 CFLAGS="$CFLAGS -D_LARGEFILE64_SOURCE"
-OBJCFLAGS="$OBJCFLAGS -D_LARGEFILE64_SOURCE"
 CXXFLAGS="$CXXFLAGS -D_LARGEFILE64_SOURCE"
 
 case "$host" in
@@ -16624,13 +16613,11 @@ fi
 if test "$enable_debug_is" = "yes"
 then
 	CFLAGS="$CFLAGS -g -D_DEBUG -UNDEBUG -DQSE_BUILD_DEBUG"
-	OBJCFLAGS="$OBJCFLAGS -g -D_DEBUG -UNDEBUG -DQSE_BUILD_DEBUG"
 	CXXFLAGS="$CXXFLAGS -g -D_DEBUG -UNDEBUG -DQSE_BUILD_DEBUG"
 	BUILD_MODE="debug"
 
 else
 	CFLAGS="$CFLAGS -DNDEBUG -U_DEBUG -DQSE_BUILD_RELEASE"
-	OBJCFLAGS="$OBJCFLAGS -DNDEBUG -U_DEBUG -DQSE_BUILD_RELEASE"
 	CXXFLAGS="$CXXFLAGS -DNDEBUG -U_DEBUG -DQSE_BUILD_RELEASE"
 	BUILD_MODE="release"
 
@@ -16664,7 +16651,6 @@ fi
 if test "$enable_reentrant_is" = "yes"
 then
 	CFLAGS="$CFLAGS -D_REENTRANT -D_THREAD_SAFE"
-	OBJCFLAGS="$OBJCFLAGS -D_REENTRANT -D_THREAD_SAFE"
 	CXXFLAGS="$CXXFLAGS -D_REENTRANT -D_THREAD_SAFE"
 fi
 
diff --git a/qse/configure.ac b/qse/configure.ac
index 7283553e..0db36788 100644
--- a/qse/configure.ac
+++ b/qse/configure.ac
@@ -39,39 +39,29 @@ dnl initialize libtool
 AC_PROG_LIBTOOL
 AC_SUBST(LIBTOOL_DEPS)
 
-#dnl overrides the default CFLAGS setting
-#if test "$ac_test_CFLAGS" = "set"
-#then
-#	CFLAGS=$ac_save_CFLAGS
-#else
-#	if test "$GCC" = "yes"
-#	then
-#		CFLAGS="-O2"
-#	else
-#		CFLAGS=
-#	fi
-#fi
+dnl overrides the default CFLAGS setting
+if test "$ac_test_CFLAGS" != "set"
+then
+	if test "$GCC" = "yes"
+	then
+		CFLAGS="$CFLAGS -Wall"
+	fi
+fi
 
-#if test "$ac_test_CXXFLAGS" = "set"
-#then
-#	CXXFLAGS=$ac_save_CXXFLAGS
-#else
-#	if test "$GCC" = "yes"
-#	then
-#		CXXFLAGS="-O2"
-#	else
-#		CXXFLAGS=
-#	fi
-#fi
+if test "$ac_test_CXXFLAGS" != "set"
+then
+	if test "$GCC" = "yes"
+	then
+		CXXFLAGS="$CXXFLAGS -Wall"
+	fi
+fi
 
 dnl indicate the existence of config.h
 CFLAGS="$CFLAGS -DQSE_HAVE_CONFIG_H"
-OBJCFLAGS="$OBJCFLAGS -DQSE_HAVE_CONFIG_H"
 CXXFLAGS="$CXXFLAGS -DQSE_HAVE_CONFIG_H"
 
 dnl make visible the 64-bit interface to the file system
 CFLAGS="$CFLAGS -D_LARGEFILE64_SOURCE"
-OBJCFLAGS="$OBJCFLAGS -D_LARGEFILE64_SOURCE"
 CXXFLAGS="$CXXFLAGS -D_LARGEFILE64_SOURCE"
 
 dnl define the WIN32 conditional if necessary
@@ -203,12 +193,10 @@ AC_ARG_ENABLE([debug], [AC_HELP_STRING([--enable-debug],
 if test "$enable_debug_is" = "yes"
 then
 	[CFLAGS="$CFLAGS -g -D_DEBUG -UNDEBUG -DQSE_BUILD_DEBUG"]
-	[OBJCFLAGS="$OBJCFLAGS -g -D_DEBUG -UNDEBUG -DQSE_BUILD_DEBUG"]
 	[CXXFLAGS="$CXXFLAGS -g -D_DEBUG -UNDEBUG -DQSE_BUILD_DEBUG"]
 	AC_SUBST(BUILD_MODE, "debug")
 else
 	[CFLAGS="$CFLAGS -DNDEBUG -U_DEBUG -DQSE_BUILD_RELEASE"]
-	[OBJCFLAGS="$OBJCFLAGS -DNDEBUG -U_DEBUG -DQSE_BUILD_RELEASE"]
 	[CXXFLAGS="$CXXFLAGS -DNDEBUG -U_DEBUG -DQSE_BUILD_RELEASE"]
 	AC_SUBST(BUILD_MODE, "release")
 fi
@@ -226,7 +214,6 @@ AC_ARG_ENABLE([reentrant], [AC_HELP_STRING([--enable-reentrant],
 if test "$enable_reentrant_is" = "yes"
 then
 	[CFLAGS="$CFLAGS -D_REENTRANT -D_THREAD_SAFE"]
-	[OBJCFLAGS="$OBJCFLAGS -D_REENTRANT -D_THREAD_SAFE"]
 	[CXXFLAGS="$CXXFLAGS -D_REENTRANT -D_THREAD_SAFE"]
 fi
 
diff --git a/qse/include/qse/scm/scm.h b/qse/include/qse/scm/scm.h
index 09c2f75f..3889b8ab 100644
--- a/qse/include/qse/scm/scm.h
+++ b/qse/include/qse/scm/scm.h
@@ -98,10 +98,12 @@ enum qse_scm_errnum_t
 
 	QSE_SCM_EIO,
 	QSE_SCM_EENDSTR,
+	QSE_SCM_ESHARP,
+	QSE_SCM_EDOT,
 
 	QSE_SCM_EINTERN,
-	QSE_SCM_ESYNTAX,
 	QSE_SCM_ELSTDEEP,
+	QSE_SCM_ELPAREN,
 	QSE_SCM_ERPAREN,
 	QSE_SCM_EARGBAD,
 	QSE_SCM_EARGFEW,
diff --git a/qse/include/qse/types.h b/qse/include/qse/types.h
index f4d05e99..a37fe40e 100644
--- a/qse/include/qse/types.h
+++ b/qse/include/qse/types.h
@@ -1,5 +1,5 @@
 /*
- * $Id: types.h 384 2011-02-04 15:47:53Z hyunghwan.chung $
+ * $Id: types.h 389 2011-02-25 15:26:16Z hyunghwan.chung $
  *
     Copyright 2006-2009 Chung, Hyung-Hwan.
     This file is part of QSE.
@@ -288,6 +288,18 @@ typedef qse_int_t qse_ssize_t;
  */
 typedef qse_uint_t qse_word_t;
 
+/**
+ * The qse_uintptr_t redefines qse_uint_t to indicate that you are dealing
+ * with a pointer.
+ */
+typedef qse_uint_t qse_uintptr_t;
+
+/**
+ * The qse_untptr_t redefines qse_int_t to indicate that you are dealing
+ * with a pointer.
+ */
+typedef qse_int_t qse_intptr_t;
+
 /** @typedef qse_real_t
  * The qse_real_t type defines the largest floating-pointer number type
  * supported.
diff --git a/qse/lib/scm/Makefile.am b/qse/lib/scm/Makefile.am
index b591ce63..fe9427c4 100644
--- a/qse/lib/scm/Makefile.am
+++ b/qse/lib/scm/Makefile.am
@@ -8,6 +8,6 @@ AM_CPPFLAGS = \
 
 lib_LTLIBRARIES = libqsescm.la 
 
-libqsescm_la_SOURCES = scm.h scm.c err.c 
+libqsescm_la_SOURCES = scm.h scm.c print.c err.c
 libqsescm_la_LDFLAGS = -L../cmn -L$(libdir) -version-info 1:0:0 -no-undefined
 libqsescm_la_LIBADD = -lqsecmn
diff --git a/qse/lib/scm/Makefile.in b/qse/lib/scm/Makefile.in
index f2be2aad..39001dd0 100644
--- a/qse/lib/scm/Makefile.in
+++ b/qse/lib/scm/Makefile.in
@@ -71,7 +71,7 @@ am__base_list = \
 am__installdirs = "$(DESTDIR)$(libdir)"
 LTLIBRARIES = $(lib_LTLIBRARIES)
 libqsescm_la_DEPENDENCIES =
-am_libqsescm_la_OBJECTS = scm.lo err.lo
+am_libqsescm_la_OBJECTS = scm.lo print.lo err.lo
 libqsescm_la_OBJECTS = $(am_libqsescm_la_OBJECTS)
 libqsescm_la_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) \
 	$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
@@ -238,7 +238,7 @@ AM_CPPFLAGS = \
 	-I$(includedir)
 
 lib_LTLIBRARIES = libqsescm.la 
-libqsescm_la_SOURCES = scm.h scm.c err.c 
+libqsescm_la_SOURCES = scm.h scm.c print.c err.c
 libqsescm_la_LDFLAGS = -L../cmn -L$(libdir) -version-info 1:0:0 -no-undefined
 libqsescm_la_LIBADD = -lqsecmn
 all: all-am
@@ -316,6 +316,7 @@ distclean-compile:
 	-rm -f *.tab.c
 
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/err.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/print.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/scm.Plo@am__quote@
 
 .c.o:
diff --git a/qse/lib/scm/err.c b/qse/lib/scm/err.c
index 71cc9e4c..65f2cf92 100644
--- a/qse/lib/scm/err.c
+++ b/qse/lib/scm/err.c
@@ -32,10 +32,12 @@ const qse_char_t* qse_scm_dflerrstr (qse_scm_t* scm, qse_scm_errnum_t errnum)
 
 		QSE_T("I/O error"),
 		QSE_T("unexpected end of string"),
+		QSE_T("bad sharp expression"),
+		QSE_T("wrong use of dot"),
 
 		QSE_T("internal error"),
-		QSE_T("syntax"),
 		QSE_T("list too deep"),
+		QSE_T("left parenthesis expected"),
 		QSE_T("right parenthesis expected"),
 		QSE_T("bad arguments"),
 		QSE_T("too few arguments"),
diff --git a/qse/lib/scm/print.c b/qse/lib/scm/print.c
new file mode 100644
index 00000000..f6d52ee7
--- /dev/null
+++ b/qse/lib/scm/print.c
@@ -0,0 +1,180 @@
+/*
+ * $Id$
+ *
+    Copyright 2006-2009 Chung, Hyung-Hwan.
+    This file is part of QSE.
+
+    QSE is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as 
+    published by the Free Software Foundation, either version 3 of 
+    the License, or (at your option) any later version.
+
+    QSE is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public 
+    License along with QSE. If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include "scm.h"
+
+#define OUTPUT_STR(scm,str) QSE_BLOCK (\
+	if (scm->io.fns.out(scm, QSE_SCM_IO_WRITE, &scm->io.arg.out, (qse_char_t*)str, qse_strlen(str)) == -1) \
+	{ \
+		qse_scm_seterror (scm, QSE_SCM_EIO, QSE_NULL, 0); \
+		return -1; \
+	} \
+)
+
+#define OUTPUT_STRX(scm,str,len) QSE_BLOCK ( \
+	if (scm->io.fns.out(scm, QSE_SCM_IO_WRITE, &scm->io.arg.out, (qse_char_t*)str, qse_strlen(str)) == -1) \
+	{ \
+		qse_scm_seterror (scm, QSE_SCM_EIO, QSE_NULL, 0); \
+		return -1; \
+	} \
+)
+
+static int print_entity (
+	qse_scm_t* scm, const qse_scm_ent_t* obj, int prt_cons_par)
+{
+	qse_char_t buf[256];
+
+	if (IS_SMALLINT(obj))
+	{
+	}
+
+	switch (TYPE(obj)) 
+	{
+		case QSE_SCM_ENT_NIL:
+			OUTPUT_STR (scm, QSE_T("()"));
+			break;
+
+		case QSE_SCM_ENT_T:
+			OUTPUT_STR (scm, QSE_T("#t"));
+			break;
+
+		case QSE_SCM_ENT_F:
+			OUTPUT_STR (scm, QSE_T("#f"));
+			break;
+
+		case QSE_SCM_ENT_NUM:
+		#if QSE_SIZEOF_LONG_LONG > 0
+			scm->prm.sprintf (
+				scm->prm.udd,
+				buf, QSE_COUNTOF(buf), 
+				QSE_T("%lld"), (long long)NUM_VALUE(obj));
+		#elif QSE_SIZEOF___INT64 > 0
+			scm->prm.sprintf (
+				scm->prm.udd,
+				buf, QSE_COUNTOF(buf), 
+				QSE_T("%I64d"), (__int64)NUM_VALUE(obj));
+		#elif QSE_SIZEOF_LONG > 0
+			scm->prm.sprintf (
+				scm->prm.udd,
+				buf, QSE_COUNTOF(buf), 
+				QSE_T("%ld"), (long)NUM_VALUE(obj));
+		#elif QSE_SIZEOF_INT > 0
+			scm->prm.sprintf (
+				scm->prm.udd,
+				buf, QSE_COUNTOF(buf), 
+				QSE_T("%d"), (int)NUM_VALUE(obj));
+		#else
+			#error unsupported size		
+		#endif
+			OUTPUT_STR (scm, buf);
+			break;
+
+#if 0
+		case QSE_SCM_ENT_REAL:
+			scm->prm.sprintf (
+				scm->prm.udd,
+				buf, QSE_COUNTOF(buf), 
+				QSE_T("%Lf"), 
+			#ifdef __MINGW32__
+				(double)QSE_SCM_RVAL(obj)
+			#else
+				(long double)QSE_SCM_RVAL(obj)
+			#endif
+			);
+
+			OUTPUT_STR (scm, buf);
+			break;
+#endif
+
+		case QSE_SCM_ENT_SYM:
+			OUTPUT_STR (scm, LAB_PTR(SYM_NAME(obj)));
+			break;
+
+		case QSE_SCM_ENT_STR:
+			OUTPUT_STR (scm, QSE_T("\""));
+			/* TODO: deescaping */
+			OUTPUT_STRX (scm, STR_PTR(obj), STR_LEN(obj));
+			OUTPUT_STR (scm, QSE_T("\""));
+			break;
+
+		case QSE_SCM_ENT_PAIR:
+		{
+			const qse_scm_ent_t* p = obj;
+			if (prt_cons_par) OUTPUT_STR (scm, QSE_T("("));
+			do 
+			{
+				qse_scm_print (scm, PAIR_CAR(p));
+				p = PAIR_CDR(p);
+				if (!IS_NIL(p))
+				{
+					OUTPUT_STR (scm, QSE_T(" "));
+					if (TYPE(p) != QSE_SCM_ENT_PAIR) 
+					{
+						OUTPUT_STR (scm, QSE_T(". "));
+						qse_scm_print (scm, p);
+					}
+				}
+			} 
+			while (p != scm->nil && TYPE(p) == QSE_SCM_ENT_PAIR);
+			if (prt_cons_par) OUTPUT_STR (scm, QSE_T(")"));
+
+			break;
+		}
+
+#if 0
+		case QSE_SCM_ENT_FUNC:
+			/*OUTPUT_STR (scm, QSE_T("func"));*/
+			OUTPUT_STR (scm, QSE_T("(lambda "));
+			if (print_entity (scm, QSE_SCM_FFORMAL(obj), 1) == -1) return -1;
+			OUTPUT_STR (scm, QSE_T(" "));
+			if (print_entity (scm, QSE_SCM_FBODY(obj), 0) == -1) return -1;
+			OUTPUT_STR (scm, QSE_T(")"));
+			break;
+
+		case QSE_SCM_ENT_MACRO:
+			OUTPUT_STR (scm, QSE_T("(macro "));
+			if (print_entity (scm, QSE_SCM_FFORMAL(obj), 1) == -1) return -1;
+			OUTPUT_STR (scm, QSE_T(" "));
+			if (print_entity (scm, QSE_SCM_FBODY(obj), 0) == -1) return -1;
+			OUTPUT_STR (scm, QSE_T(")"));
+			break;
+		case QSE_SCM_ENT_PRIM:
+			OUTPUT_STR (scm, QSE_T("prim"));
+			break;
+#endif
+
+		default:
+			QSE_ASSERT (!"should never happen - unknown entity type");
+			qse_scm_seterror (scm, QSE_SCM_EINTERN, QSE_NULL, QSE_NULL);
+			return -1;
+	}
+
+	return 0;
+}
+
+int qse_scm_print (qse_scm_t* scm, const qse_scm_ent_t* obj)
+{
+	QSE_ASSERTX (
+		scm->io.fns.out != QSE_NULL, 
+		"Specify output function before calling qse_scm_print()"
+	);	
+
+	return print_entity (scm, obj, 1);
+}
diff --git a/qse/lib/scm/scm.c b/qse/lib/scm/scm.c
index 47ed1012..98ede098 100644
--- a/qse/lib/scm/scm.c
+++ b/qse/lib/scm/scm.c
@@ -24,6 +24,16 @@ QSE_IMPLEMENT_COMMON_FUNCTIONS (scm)
 
 #define IS_NIL(x) ((x) == scm->nil)
 
+#define IS_SMALLINT(x)   ((qse_uintptr_t)(x) & 1)
+#define TO_SMALLINT(x)   ((qse_scm_ent_t*)(qse_uintptr_t)(((x) << 1) | 1))
+/* TODO: need more typecasting to something like int? how to i determine 
+ *       the best type for the range in CAN_BE_SMALLINT()? 
+#define FROM_SMALLINT(x) ((int)((qse_uintptr_t)(x) >> 1))
+ */
+#define FROM_SMALLINT(x) ((qse_uintptr_t)(x) >> 1)
+/* TODO: change the smallint range... */
+#define CAN_BE_SMALLINT(x) (((x) >= -16384) && ((x) <= 16383))
+
 static qse_scm_t* qse_scm_init (
 	qse_scm_t*  scm,
 	qse_mmgr_t* mmgr,
@@ -83,7 +93,7 @@ static QSE_INLINE void delete_all_entity_blocks (qse_scm_t* scm)
 	{
 		qse_scm_enb_t* enb = scm->mem.ebl;
 		scm->mem.ebl = scm->mem.ebl->next;
-		QSE_MMGR_FREE (scm->mmgr, enb);
+		QSE_MMGR_FREE (scm->mmgr, ((void**)enb)[-1]);
 	}
 }
 
@@ -139,33 +149,77 @@ int qse_scm_attachio (qse_scm_t* scm, qse_scm_io_t* io)
 static qse_scm_enb_t* new_entity_block (qse_scm_t* scm, qse_size_t len)
 {
 	/* 
-	 * create a new value block containing as many slots as len
+	 * Create a new value block containing as 'len' slots.
 	 */
 
+	void* raw;
 	qse_scm_enb_t* blk;
 	qse_scm_ent_t* v;
 	qse_size_t i;
 
-	blk = (qse_scm_enb_t*) QSE_MMGR_ALLOC (
+	/* Let me assume that an aligned memory pointer is an even address.
+	 * malloc() returns an aligned memory pointer on most systems.
+	 * However, I can't simply ignore oddball systems that returns
+	 * an unaligned memory pointer. (Is there any?) A user may provide 
+	 * a custom memory allocator that does not return unaligned memory
+	 * pointer. I make the pointer to an entity block 2-byte aligned 
+	 * hoping that the entity pointer alloc_entity() returns is also an
+	 * even number. This, of couurse, requires that the size of 
+	 * qse_scm_enb_t and qse_scm_ent_t is the multiple of 2.
+	 * I do this for SMALLINT, not for memory alignemnt.The test for 
+	 * SMALLINT can simply check the lowest bit. Am i doing too much?
+	 */ 
+	QSE_ASSERTX (
+		QSE_SIZEOF(qse_scm_enb_t) % 2 == 0, 
+		"This function is written assuming the size of qse_scm_enb_t is even"
+	);
+	QSE_ASSERTX (
+		QSE_SIZEOF(qse_scm_ent_t) % 2 == 0, 
+		"This function is written assuming the size of qse_scm_ent_t is even"
+	);
+
+	/* The actual memory block size is calculated as shown here:
+	 *   QSE_SIZEOF(void*) to store the actual memory block pointer
+	 *   1 to secure extra 1 byte required for 2-byte alignement.
+	 *   QSE_SIZEOF(qse_scm_enb_t) to store the block header.
+	 *   QSE_SIZEOF(qse_Scm_ent_t) * len to store the actual entities.
+	 */
+	raw = (qse_scm_enb_t*) QSE_MMGR_ALLOC (
 		scm->mmgr, 
+		QSE_SIZEOF(void*) + 1 + 
 		QSE_SIZEOF(qse_scm_enb_t) + 
 		QSE_SIZEOF(qse_scm_ent_t) * len
 	);
-	if (blk == QSE_NULL)
+	if (raw == QSE_NULL)
 	{
 		qse_scm_seterror (scm, QSE_SCM_ENOMEM, QSE_NULL, QSE_NULL);
 		return QSE_NULL;
 	}
 
-	/* initialize the block fields */
+	/* The entity block begins after the memory block pointer. */
+	blk = (qse_scm_enb_t*)((qse_byte_t*)raw + QSE_SIZEOF(void*) + 1);
+
+	/* Adjust the block pointer to an even number. 
+	 * the resulting address is:
+	 *     either the old address
+	 *     or the old address - 1
+	 */
+	blk = (qse_scm_enb_t*)((qse_uintptr_t)blk & ~(qse_uintptr_t)1);
+
+	/* Remember the raw block pointer.
+	 * ((void**)blk)[-1] gets naturally aligned as blk is aligned. 
+	 * It can be raw + 1 or the same as raw. */
+	((void**)blk)[-1] = raw;
+
+	/* Initialize the block fields */
 	blk->ptr = (qse_scm_ent_t*)(blk + 1);
 	blk->len = len;
 
-	/* chain the value block to the block list */
+	/* Chain the value block to the block list */
 	blk->next = scm->mem.ebl;
 	scm->mem.ebl = blk;
 
-	/* chain each slot to the free slot list using 
+	/* Chain each slot to the free slot list using 
 	 * the CDR field of an entity */
 	v = &blk->ptr[0];
 	for (i = 0; i < len -1; i++) 
@@ -182,14 +236,16 @@ static qse_scm_enb_t* new_entity_block (qse_scm_t* scm, qse_size_t len)
 static void mark (qse_scm_t* scm, qse_scm_ent_t* v)
 {
 	/* 
-	 * mark values non-recursively with Deutsch-Schorr-Waite(DSW) algorithm 
-	 * this algorithm builds backtraces directly into the value chain
+	 * Mark values non-recursively with Deutsch-Schorr-Waite(DSW) algorithm.
+	 * This algorithm builds backtraces directly into the value chain
 	 * with the help of additional variables.
 	 */
 
 	qse_scm_ent_t* parent, * me;
 
-	/* initialization */
+	if (IS_SMALLINT(v)) return;
+
+	/* Initialization */
 	parent = QSE_NULL;
 	me = v;
 
@@ -201,123 +257,68 @@ static void mark (qse_scm_t* scm, qse_scm_ent_t* v)
 		if (ATOM(me) || DSWCOUNT(me) >= QSE_COUNTOF(me->u.ref.ent))
 		{
 			/* 
-			 * backtrack to the parent node 
+			 * Backtrack to the parent node 
 			 */
 			qse_scm_ent_t* child;
 
-			/* nothing more to backtrack? end of marking */
+			/* Nothing more to backtrack? end of marking */
 			if (parent == QSE_NULL) return;
 
-			/* remember me temporarily for restoration below */
+			/* Remember me temporarily for restoration below */
 			child = me;
 
-			/* the current parent becomes me */
+			/* The current parent becomes me */
 			me = parent;
 
-			/* change the parent to the parent of parent */
+			/* Change the parent to the parent of parent */
 			parent = me->u.ref.ent[DSWCOUNT(me)];
 			
-			/* restore the cell contents */
+			/* Restore the cell contents */
 			me->u.ref.ent[DSWCOUNT(me)] = child;
 
-			/* increment the counter to indicate that the 
+			/* Increment the counter to indicate that the 
 			 * 'count'th field has been processed. */
 			DSWCOUNT(me)++;
 		}
 		else 
 		{
 			/* 
-			 * move on to an unprocessed child 
+			 * Move on to an unprocessed child 
 			 */
 			qse_scm_ent_t* child;
 
 			child = me->u.ref.ent[DSWCOUNT(me)];
 
-			/* process the field */
-			if (child && !MARK(child))
+			/* Process the field */
+			QSE_ASSERT (child != QSE_NULL);
+
+			if (IS_SMALLINT(child) || MARK(child))
 			{
-				/* change the contents of the child chosen
+				/* Already marked. Increment the count */
+				DSWCOUNT(me)++;
+			}
+			else
+			{
+				/* Change the contents of the child chosen
 				 * to point to the current parent */
 				me->u.ref.ent[DSWCOUNT(me)] = parent;
 
-				/* link me to the head of parent list */
+				/* Link me to the head of parent list */
 				parent = me;
 
-				/* let me point to the child chosen */
+				/* Let me point to the child chosen */
 				me = child;
 
 				MARK(me) = 1;
 				/*if (!ATOM(me))*/ DSWCOUNT(me) = 0;
 			}
-			else
-			{
-				/* increment the count */
-				DSWCOUNT(me)++;
-			}
 		}
 	}
 }
 
-
-#if 0
-static void mark (qse_scm_t* scm, qse_scm_ent_t* v)
-{
-	qse_scm_ent_t* t, * p, * q;
-
-	t = QSE_NULL;
-	p = v;
-
-E2:
-	setmark (p);
-
-E3:
-	if (isatom(p)) goto E6;
-
-E4:
-	q = p->u.cons.car;
-	if (q && !ismark(q))
-	{
-		setatom (p);
-		p->u.cons.car = t;
-		t = p;
-		p = q;
-		goto E2;
-	}
-
-E5:
-	q = p->u.cons.cdr;
-	if (q && !ismark(q))
-	{
-		p->u.cons.cdr = t;
-		t = p;
-		p = q;
-		goto E2;
-	}
-
-E6:
-	if (!t) return;
-	q = t;
-	if (isatom(q))
-	{
-		clratom (q);
-		t = q->u.cons.car;
-		q->u.cons.car = p;
-		p = q;
-		goto E5;
-	}
-	else
-	{
-		t = q->u.cons.cdr;
-		q->u.cons.cdr = p;
-		p = q;
-		goto E6;
-	}
-}
-#endif
-
 static void gc (qse_scm_t* scm, qse_scm_ent_t* x, qse_scm_ent_t* y)
 {
-/* TODO: how can i GC away those symbols not actually meaningful?
+/* TODO: How can i GC away those symbols not actually meaningful?
  *       marking objects referenced in symbol table prevent me from
  *       finding unused symbols... you keep on evaluating expressions
  *       with different symbols. you'll get out of memory. */
@@ -341,7 +342,7 @@ static void gc (qse_scm_t* scm, qse_scm_ent_t* x, qse_scm_ent_t* y)
 
 rsr4 
 
-the following identifiers are syntatic keywors and should not be	
+the following identifiers are syntactic keywors and should not be	
 used as variables.
 
  =>           do            or
@@ -405,11 +406,11 @@ static qse_scm_ent_t* alloc_entity (
 
 	qse_scm_ent_t* v;
 
-	if (scm->mem.free == scm->nil)
+	if (IS_NIL(scm->mem.free))
 	{
 		/* if no free slot is available */
 		gc (scm, x, y); /* perform garbage collection */
-		if (scm->mem.free == scm->nil)
+		if (IS_NIL(scm->mem.free))
 		{
 			/* if no free slot is available after garbage collection,
 			 * make new value blocks containing more free slots */
@@ -442,6 +443,36 @@ static qse_scm_ent_t* make_pair_entity (
 	return v;
 }
 
+static qse_scm_ent_t* make_number_entity (qse_scm_t* scm, qse_long_t val)
+{
+	qse_scm_ent_t* v;
+
+	if (CAN_BE_SMALLINT(val)) return TO_SMALLINT(val);
+
+	v = alloc_entity (scm, QSE_NULL, QSE_NULL);
+	if (v == QSE_NULL) return QSE_NULL;
+
+	TYPE(v) = QSE_SCM_ENT_NUM;
+	ATOM(v) = 1;
+	NUM_VALUE(v) = val;
+
+	return v;
+}
+
+static qse_scm_ent_t* make_real_entity (qse_scm_t* scm, qse_long_t val)
+{
+	qse_scm_ent_t* v;
+
+	v = alloc_entity (scm, QSE_NULL, QSE_NULL);
+	if (v == QSE_NULL) return QSE_NULL;
+
+	TYPE(v) = QSE_SCM_ENT_REAL;
+	ATOM(v) = 1;
+	REAL_VALUE(v) = val;
+
+	return v;
+}
+
 static qse_scm_ent_t* make_string_entity (
 	qse_scm_t* scm, const qse_char_t* str, qse_size_t len)
 {
@@ -573,7 +604,7 @@ static qse_scm_ent_t* make_procedure_entity (
 
 	/* A procedure entity is a built-in function that can be
 	 * overridden by a user while a syntax entity represents a 
-	 * lower-level syntatic function that can't be overridden.
+	 * lower-level syntactic function that can't be overridden.
 	 * 
 	 * (define lambda 10) is legal but does not change the
 	 *    meaning of lambda when used as a function name. 	
@@ -642,7 +673,6 @@ static int build_syntax_entities (qse_scm_t* scm)
 	if (v == QSE_NULL) return -1;
 	scm->quote = v;
 
-
 	MAKE_SYNTAX_ENTITY (scm, QSE_T("define"), 3);
 	MAKE_SYNTAX_ENTITY (scm, QSE_T("if"),     4);
 	MAKE_SYNTAX_ENTITY (scm, QSE_T("begin"),  5);
@@ -661,9 +691,9 @@ static qse_scm_t* qse_scm_init (
 		/* nil */
 		{ 0, 1, 1, QSE_SCM_ENT_NIL },
 		/* f */
-		{ 0, 1, 1, QSE_SCM_ENT_T }, 
+		{ 0, 1, 1, QSE_SCM_ENT_T | QSE_SCM_ENT_BOOL }, 
 		/* t */
-		{ 0, 1, 1, QSE_SCM_ENT_F }
+		{ 0, 1, 1, QSE_SCM_ENT_F | QSE_SCM_ENT_BOOL }
 	};
 
 	if (mmgr == QSE_NULL) mmgr = QSE_MMGR_GETDFL();
@@ -684,16 +714,17 @@ static qse_scm_t* qse_scm_init (
 	scm->r.curloc.colm = 0;
 	if (qse_str_init(&scm->r.t.name, mmgr, 256) == QSE_NULL) return QSE_NULL;
 
-	scm->mem.ebl = QSE_NULL;
-	scm->mem.free = scm->nil;
 
 	/* initialize common values */
-	scm->nil = &static_values[0];
-	scm->f   = &static_values[1];
-	scm->t   = &static_values[2];
-
+	scm->nil    = &static_values[0];
+	scm->f      = &static_values[1];
+	scm->t      = &static_values[2];
 	scm->lambda = scm->nil;
-	scm->quote = scm->nil;
+	scm->quote  = scm->nil;
+
+	/* initialize entity block list */
+	scm->mem.ebl = QSE_NULL;
+	scm->mem.free = scm->nil;
 
 	/* initialize all the key data to nil before make_pair_entity()
 	 * below. make_pair_entity() calls alloc_entity() that invokes
@@ -706,7 +737,8 @@ static qse_scm_t* qse_scm_init (
 
 	scm->symtab = scm->nil;
 	scm->gloenv = scm->nil;
-	scm->rstack = scm->nil;
+	scm->r.s    = scm->nil;
+	scm->r.e    = scm->nil;
 
 	/* build the global environment entity as a pair */
 	scm->gloenv = make_pair_entity (scm, scm->nil, scm->nil);
@@ -745,29 +777,51 @@ enum list_flag_t
 enum tok_type_t
 {
 	TOK_END     = 0,
-	TOK_INT     = 1,
-	TOK_REAL    = 2,
-	TOK_STRING  = 3,
-	TOK_LPAREN  = 4,
-	TOK_RPAREN  = 5,
-	TOK_IDENT   = 6,
-	TOK_DOT     = 7,
-	TOK_QUOTE   = 8,
-	TOK_QQUOTE  = 9, /* quasiquote */
-	TOK_COMMA   = 10,
-	TOK_COMMAAT = 11,
+	TOK_T       = 1,
+	TOK_F       = 2,
+	TOK_INT     = 3,
+	TOK_REAL    = 4,
+	TOK_SYMBOL  = 5,
+	TOK_STRING  = 6,
+	TOK_LPAREN  = 7,
+	TOK_RPAREN  = 8,
+	TOK_DOT     = 9,
+	TOK_QUOTE   = 10,
+	TOK_QQUOTE  = 11, /* quasiquote */
+	TOK_COMMA   = 12,
+	TOK_COMMAAT = 13,
+#if 0
 	TOK_INVALID = 50
+#endif
 };
 
-#define TOK_CLEAR(scm) qse_str_clear(&(scm)->r.t.name)
-#define TOK_TYPE(scm)  (scm)->r.t.type
-#define TOK_IVAL(scm)  (scm)->r.t.ival
-#define TOK_RVAL(scm)  (scm)->r.t.rval
-#define TOK_STR(scm)   (scm)->r.t.name
-#define TOK_SPTR(scm)  (scm)->r.t.name.ptr
-#define TOK_SLEN(scm)  (scm)->r.t.name.len
-#define TOK_LOC(scm) (scm)->r.t.loc
+#define TOK_CLR(scm)      qse_str_clear(&(scm)->r.t.name)
+#define TOK_TYPE(scm)     (scm)->r.t.type
+#define TOK_IVAL(scm)     (scm)->r.t.ival
+#define TOK_RVAL(scm)     (scm)->r.t.rval
+#define TOK_NAME(scm)     (&(scm)->r.t.name)
+#define TOK_NAME_PTR(scm) TOK_NAME(scm)->ptr
+#define TOK_NAME_LEN(scm) TOK_NAME(scm)->len
+#define TOK_LOC(scm)      (scm)->r.t.loc
+
+#define TOK_ADD_CHAR(scm,ch) QSE_BLOCK (\
+	if (qse_str_ccat(TOK_NAME(scm), ch) == -1) \
+	{ \
+		qse_scm_seterror (scm, QSE_SCM_ENOMEM, QSE_NULL, &scm->r.curloc); \
+		return -1; \
+	} \
+)
+
+#define IS_DIGIT(ch) ((ch) >= QSE_T('0') && (ch) <= QSE_T('9'))
+#define IS_SPACE(ch) ((ch) == QSE_T(' ') || (ch) == QSE_T('\t'))
+#define IS_NEWLINE(ch) ((ch) == QSE_T('\n') || (ch) == QSE_T('\r'))
+#define IS_WHSPACE(ch) IS_SPACE(ch) || IS_NEWLINE(ch)
+#define IS_DELIM(ch) \
+	(IS_WHSPACE(ch) || (ch) == QSE_T('(') || (ch) == QSE_T(')') || \
+	 (ch) == QSE_T('\"') || (ch) == QSE_T(';') || (ch) == QSE_CHAR_EOF)
+
 #define READ_CHAR(scm) QSE_BLOCK(if (read_char(scm) <= -1) return -1;)
+#define READ_TOKEN(scm) QSE_BLOCK(if (read_token(scm) <= -1) return -1;)
 
 static int read_char (qse_scm_t* scm)
 {
@@ -803,15 +857,279 @@ static int read_char (qse_scm_t* scm)
 	return 0;
 }
 
+static int read_string_token (qse_scm_t* scm)
+{
+	qse_cint_t c;
+	int escaped = 0;
+	int digit_count = 0;
+	qse_cint_t c_acc = 0;
+
+	while (1)
+	{
+		READ_CHAR (scm);
+		c = scm->r.curc;
+
+		if (c == QSE_CHAR_EOF)
+		{
+			qse_scm_seterror (
+				scm, QSE_SCM_EENDSTR,
+				QSE_NULL, &scm->r.curloc);
+			return -1;
+		}
+
+		if (escaped == 3)
+		{
+			if (c >= QSE_T('0') && c <= QSE_T('7'))
+			{
+				c_acc = c_acc * 8 + c - QSE_T('0');
+				digit_count++;
+				if (digit_count >= escaped) 
+				{
+					TOK_ADD_CHAR (scm, c_acc);
+					escaped = 0;
+				}
+				continue;
+			}
+			else
+			{
+				TOK_ADD_CHAR (scm, c_acc);
+				escaped = 0;
+			}
+		}
+		else if (escaped == 2 || escaped == 4 || escaped == 8)
+		{
+			if (c >= QSE_T('0') && c <= QSE_T('9'))
+			{
+				c_acc = c_acc * 16 + c - QSE_T('0');
+				digit_count++;
+				if (digit_count >= escaped) 
+				{
+					TOK_ADD_CHAR (scm, c_acc);
+					escaped = 0;
+				}
+				continue;
+			}
+			else if (c >= QSE_T('A') && c <= QSE_T('F'))
+			{
+				c_acc = c_acc * 16 + c - QSE_T('A') + 10;
+				digit_count++;
+				if (digit_count >= escaped) 
+				{
+					TOK_ADD_CHAR (scm, c_acc);
+					escaped = 0;
+				}
+				continue;
+			}
+			else if (c >= QSE_T('a') && c <= QSE_T('f'))
+			{
+				c_acc = c_acc * 16 + c - QSE_T('a') + 10;
+				digit_count++;
+				if (digit_count >= escaped) 
+				{
+					TOK_ADD_CHAR (scm, c_acc);
+					escaped = 0;
+				}
+				continue;
+			}
+			else
+			{
+				qse_char_t rc;
+
+				rc = (escaped == 2)? QSE_T('x'):
+				     (escaped == 4)? QSE_T('u'): QSE_T('U');
+
+				if (digit_count == 0) TOK_ADD_CHAR (scm, rc);
+				else TOK_ADD_CHAR (scm, c_acc);
+
+				escaped = 0;
+			}
+		}
+
+		if (escaped == 0 && c == QSE_T('\"'))
+		{
+			/* terminating quote */
+			/*NEXT_CHAR_TO (scm, c);*/
+			READ_CHAR (scm);
+			break;
+		}
+
+		if (escaped == 0 && c == QSE_T('\\'))
+		{
+			escaped = 1;
+			continue;
+		}
+
+		if (escaped == 1)
+		{
+			if (c == QSE_T('n')) c = QSE_T('\n');
+			else if (c == QSE_T('r')) c = QSE_T('\r');
+			else if (c == QSE_T('t')) c = QSE_T('\t');
+			else if (c == QSE_T('f')) c = QSE_T('\f');
+			else if (c == QSE_T('b')) c = QSE_T('\b');
+			else if (c == QSE_T('v')) c = QSE_T('\v');
+			else if (c == QSE_T('a')) c = QSE_T('\a');
+			else if (c >= QSE_T('0') && c <= QSE_T('7')) 
+			{
+				escaped = 3;
+				digit_count = 1;
+				c_acc = c - QSE_T('0');
+				continue;
+			}
+			else if (c == QSE_T('x')) 
+			{
+				escaped = 2;
+				digit_count = 0;
+				c_acc = 0;
+				continue;
+			}
+		#ifdef QSE_CHAR_IS_WCHAR
+			else if (c == QSE_T('u') && QSE_SIZEOF(qse_char_t) >= 2) 
+			{
+				escaped = 4;
+				digit_count = 0;
+				c_acc = 0;
+				continue;
+			}
+			else if (c == QSE_T('U') && QSE_SIZEOF(qse_char_t) >= 4) 
+			{
+				escaped = 8;
+				digit_count = 0;
+				c_acc = 0;
+				continue;
+			}
+		#endif
+
+			escaped = 0;
+		}
+
+		TOK_ADD_CHAR (scm, c);
+	}
+
+	TOK_TYPE(scm) = TOK_STRING;
+	return 0;
+}
+
+
+enum read_number_token_flag_t
+{
+	RNT_NEGATIVE         = (1 << 0),
+	RNT_SKIP_TO_FRACTION = (1 << 1)
+};
+
+static int read_number_token (qse_scm_t* scm, int flags)
+{
+	qse_long_t ival = 0;
+	qse_real_t rval = .0;
+	qse_real_t fraction;
+
+	if (flags & RNT_SKIP_TO_FRACTION) goto fraction_part;
+
+	do
+	{
+		ival = ival * 10 + (scm->r.curc - QSE_T('0'));
+		TOK_ADD_CHAR (scm, scm->r.curc);
+		READ_CHAR (scm);
+	}
+	while (IS_DIGIT(scm->r.curc));
+
+/* TODO: extend parsing floating point number  */
+	if (scm->r.curc == QSE_T('.'))
+	{
+	fraction_part:
+		fraction = 0.1;
+
+		TOK_ADD_CHAR (scm, scm->r.curc);
+		READ_CHAR (scm);
+		rval = (qse_real_t)ival;
+
+		while (IS_DIGIT(scm->r.curc))
+		{
+			rval += (qse_real_t)(scm->r.curc - QSE_T('0')) * fraction;
+			fraction *= 0.1;
+			TOK_ADD_CHAR (scm, scm->r.curc);
+			READ_CHAR (scm);
+		}
+
+		TOK_RVAL(scm) = rval;
+		TOK_TYPE(scm) = TOK_REAL;
+		if (flags & RNT_NEGATIVE) rval *= -1;
+	}
+	else
+	{
+		TOK_IVAL(scm) = ival;
+		TOK_TYPE(scm) = TOK_INT;
+		if (flags & RNT_NEGATIVE) ival *= -1;
+	}
+
+	return 0;
+}
+
+static int read_sharp_token (qse_scm_t* scm)
+{
+/* TODO: read a token beginning with #.*/
+
+	TOK_ADD_CHAR (scm, scm->r.curc); /* add # to the token name */
+
+	READ_CHAR (scm);
+	switch (scm->r.curc)
+	{
+		case QSE_T('t'):
+			TOK_ADD_CHAR (scm, scm->r.curc);
+			READ_CHAR (scm);
+			if (!IS_DELIM(scm->r.curc)) goto charname;
+			TOK_TYPE(scm) = TOK_T;
+			break;
+
+		case QSE_T('f'):
+			TOK_ADD_CHAR (scm, scm->r.curc);
+			READ_CHAR (scm);
+			if (!IS_DELIM(scm->r.curc)) goto charname;
+			TOK_TYPE(scm) = TOK_F;
+			break;
+
+		case QSE_T('\\'):
+			break;
+
+		case QSE_T('b'):
+			break;
+
+		case QSE_T('o'):
+			break;
+
+		case QSE_T('d'):
+			break;
+
+		case QSE_T('x'):
+			break;
+	}
+
+	return 0;
+
+
+charname:
+	do
+	{
+		TOK_ADD_CHAR (scm, scm->r.curc);
+		READ_CHAR (scm);	
+	}
+	while (!IS_DELIM(scm->r.curc));
+
+/* TODO: character name comparison... */
+	qse_scm_seterror (scm, QSE_SCM_ESHARP, QSE_NULL, &scm->r.curloc);
+	return -1;
+}
+
 static int read_token (qse_scm_t* scm)
 {
-	TOK_CLEAR (scm);
+	int flags = 0;
+
+	TOK_CLR (scm);
 
 	/* skip a series of white spaces and comment lines */
 	do
 	{
 		/* skip white spaces */
-		while (QSE_SCM_ISSPACE(scm,scm->r.curc)) READ_CHAR (scm);
+		while (IS_WHSPACE(scm->r.curc)) READ_CHAR (scm);
 
 		if (scm->r.curc != QSE_T(';')) break;
 
@@ -845,8 +1163,13 @@ static int read_token (qse_scm_t* scm)
 
 		case QSE_T('.'):
 			TOK_ADD_CHAR (scm, scm->r.curc);
-			TOK_TYPE(scm) = TOK_DOT;
 			READ_CHAR (scm);	
+			if (!IS_DELIM(scm->r.curc)) 
+			{
+				flags |= RNT_SKIP_TO_FRACTION;
+				goto try_number;
+			}
+			TOK_TYPE(scm) = TOK_DOT;
 			return 0;
 
 		case QSE_T('\''):
@@ -870,46 +1193,88 @@ static int read_token (qse_scm_t* scm)
 				TOK_TYPE(scm) = TOK_COMMAAT;
 				READ_CHAR (scm);	
 			}
-			else
-			{
-
-				TOK_TYPE(scm) = TOK_COMMA;
-			}
-
+			else TOK_TYPE(scm) = TOK_COMMA;
 			return 0;
 
 		case QSE_T('#'):
-			return 0;
+			return read_sharp_token (scm);
 
 		case QSE_T('\"'):
 			return read_string_token (scm);
 	}
 
+	if (scm->r.curc == QSE_T('+') || scm->r.curc == QSE_T('-')) 
+	{
+		/* a number can begin with + or -. we don't know
+		 * if it is the part of a number or not yet. 
+		 * let's set the NEGATIVE bit in 'flags' if the sign is 
+		 * negative for later use in case it is followed by a digit.
+		 * we also add the sign character to the token name 
+		 * so that we can form a complete symbol if the word turns
+		 * out to be a symbol eventually.
+		 */
+		if (scm->r.curc == QSE_T('-')) flags |= RNT_NEGATIVE;
+		TOK_ADD_CHAR (scm, scm->r.curc);
+		READ_CHAR (scm);
+	}
+
+	if (IS_DIGIT(scm->r.curc))
+	{
+	try_number:
+		/* we got a digit, maybe or maybe not following a sign.
+		 * call read_number_token() to read the current token 
+		 * as a number. */
+		if (read_number_token (scm, flags) <= -1) return -1;
+
+		/* the read_number() function exits once it sees a character
+		 * that can not compose a number. if it is a delimiter,
+		 * the token is numeric. */
+		if (IS_DELIM(scm->r.curc)) return 0;
+
+		/* otherwise, we carry on reading trailing characters to
+		 * compose a symbol token */
+	}
+
+	/* we got here as the current token does not begin with special
+	 * token characters. treat it as a symbol token. */
+	do 
+	{
+		TOK_ADD_CHAR (scm, scm->r.curc);	
+		READ_CHAR (scm);
+	} 
+	while (!IS_DELIM(scm->r.curc));
+	TOK_TYPE(scm) = TOK_SYMBOL; 
+
+	return 0;
+	
+
+#if 0
 	TOK_TYPE(scm) = TOK_INVALID;
 	READ_CHAR (scm); /* consume */
 	return 0;
+#endif
 }
 
 static QSE_INLINE qse_scm_ent_t* push (qse_scm_t* scm, qse_scm_ent_t* obj)
 {
 	qse_scm_ent_t* pair;
 
-	pair = make_pair_entity (scm, obj, scm->rstack);
+	pair = make_pair_entity (scm, obj, scm->r.s);
 	if (pair == QSE_NULL) return QSE_NULL;
 
-	scm->rstack = pair;
+	scm->r.s = pair;
 
-	/* return the top of the staich which is the containing pair */
+	/* return the top of the stack which is the containing pair */
 	return pair;
 }
 
 static QSE_INLINE_ALWAYS void pop (qse_scm_t* scm)
 {
 	QSE_ASSERTX (
-		scm->rstack != scm->nil,
-		"You've called pop() more than push()"
+		!IS_NIL(scm->r.s),
+		"You've called pop() more times than push()"
 	);
-	scm->rstack = PAIR_CDR(scm->rstack);
+	scm->r.s = PAIR_CDR(scm->r.s);
 }
 
 static QSE_INLINE qse_scm_ent_t* enter_list (qse_scm_t* scm, int flagv)
@@ -939,9 +1304,9 @@ static QSE_INLINE qse_scm_ent_t* enter_list (qse_scm_t* scm, int flagv)
 	 * nil#2 to store the last element in the list.
 	 * both to be updated in chain_to_list() as items are added.
 	 */
-	return (push (scm, scm->mem.num[flagv]) == QSE_NULL ||
+	return (push (scm, TO_SMALLINT(flagv)) == QSE_NULL ||
 	        push (scm, scm->nil) == QSE_NULL ||
-	        push (scm, scm->nil) == QSE_NULL)? QSE_NULL: scm->rstack;
+	        push (scm, scm->nil) == QSE_NULL)? QSE_NULL: scm->r.s;
 }
 
 static QSE_INLINE_ALWAYS qse_scm_ent_t* leave_list (qse_scm_t* scm, int* flagv)
@@ -949,17 +1314,20 @@ static QSE_INLINE_ALWAYS qse_scm_ent_t* leave_list (qse_scm_t* scm, int* flagv)
 	qse_scm_ent_t* head;
 
 	/* the stack must not be empty */
-	QSE_ASSERT (scm->rstack != scm->nil);
+	QSE_ASSERTX (
+		!IS_NIL(scm->r.s), 
+		"You cannot leave a list without entering it"
+	);
 
 	/* remember the current list head */
-	head = PAIR_CAR(PAIR_CDR(scm->rstack));
+	head = PAIR_CAR(PAIR_CDR(scm->r.s));
 
 	/* upon leaving a list, it pops the three cells off the stack */
 	pop (scm);
 	pop (scm);
 	pop (scm);
 
-	if (scm->rstack == scm->nil)
+	if (IS_NIL(scm->r.s))
 	{
 		/* the stack is empty after popping. 
 		 * it is back to the top level. 
@@ -969,9 +1337,9 @@ static QSE_INLINE_ALWAYS qse_scm_ent_t* leave_list (qse_scm_t* scm, int* flagv)
 	else
 	{
 		/* restore the flag for the outer returning level */
-		qse_scm_ent_t* flag = PAIR_CDR(PAIR_CDR(scm->rstack));
-		QSE_ASSERT (QSE_SCM_TYPE(PAIR_CAR(flag)) == QSE_SCM_ENT_INT);
-		*flagv = QSE_SCM_IVAL(PAIR_CAR(flag));
+		qse_scm_ent_t* flag = PAIR_CDR(PAIR_CDR(scm->r.s));
+		QSE_ASSERT (TYPE(PAIR_CAR(flag)) == QSE_SCM_ENT_NUM);
+		*flagv = NUM_VALUE(PAIR_CAR(flag));
 	}
 
 	/* return the head of the list being left */
@@ -980,12 +1348,15 @@ static QSE_INLINE_ALWAYS qse_scm_ent_t* leave_list (qse_scm_t* scm, int* flagv)
 
 static QSE_INLINE_ALWAYS void dot_list (qse_scm_t* scm)
 {
-	qse_scm_ent_t* cell;
+	qse_scm_ent_t* pair;
+	int flagv;
+
+	QSE_ASSERT (!IS_NIL(scm->r.s));
 
 	/* mark the state that a dot has appeared in the list */
-	QSE_ASSERT (scm->rstack != scm->nil);
-	cell = PAIR_CDR(PAIR_CDR(scm->rstack));
-	PAIR_CAR(cell) = scm->mem.num[QSE_SCM_IVAL(PAIR_CAR(cell)) | DOTTED];
+	pair = PAIR_CDR(PAIR_CDR(scm->r.s));
+	flagv = FROM_SMALLINT(PAIR_CAR(pair));
+	PAIR_CAR(pair) = TO_SMALLINT(flagv | DOTTED);
 }
 
 static qse_scm_ent_t* chain_to_list (qse_scm_t* scm, qse_scm_ent_t* obj)
@@ -994,21 +1365,21 @@ static qse_scm_ent_t* chain_to_list (qse_scm_t* scm, qse_scm_ent_t* obj)
 	int flagv;
 
 	/* the stack top is the pair pointing to the list tail */
-	tail = scm->rstack;
-	QSE_ASSERT (tail != scm->nil);
+	tail = scm->r.s;
+	QSE_ASSERT (!IS_NIL(tail));
 
 	/* the pair pointing to the list head is below the tail cell
 	 * connected via cdr. */
 	head = PAIR_CDR(tail);
-	QSE_ASSERT (head != scm->nil);
+	QSE_ASSERT (!IS_NIL(head));
 
 	/* the pair pointing to the flag is below the head cell
 	 * connected via cdr */
 	flag = PAIR_CDR(head);
 
 	/* retrieve the numeric flag value */
-	QSE_ASSERT(QSE_SCM_TYPE(PAIR_CAR(flag)) == QSE_SCM_ENT_INT);
-	flagv = (int)QSE_SCM_IVAL(PAIR_CAR(flag));
+	QSE_ASSERT(IS_SMALLINT(PAIR_CAR(flag)));
+	flagv = (int)FROM_SMALLINT(PAIR_CAR(flag));
 
 	if (flagv & CLOSED)
 	{
@@ -1019,13 +1390,14 @@ static qse_scm_ent_t* chain_to_list (qse_scm_t* scm, qse_scm_ent_t* obj)
 	else if (flagv & DOTTED)
 	{
 		/* the list must not be empty to have reached the dotted state */
-		QSE_ASSERT (PAIR_CAR(tail) != scm->nil);
+		QSE_ASSERT (!IS_NIL(PAIR_CAR(tail)));
 
 		/* chain the object via 'cdr' of the tail cell */
 		PAIR_CDR(PAIR_CAR(tail)) = obj;
 
-		/* update the flag to CLOSED */
-		PAIR_CAR(flag) = scm->mem.num[flagv | CLOSED];
+		/* update the flag to CLOSED so that you can have more than
+		 * one item after the dot. */
+		PAIR_CAR(flag) = TO_SMALLINT(flagv | CLOSED);
 	}
 	else
 	{
@@ -1057,20 +1429,20 @@ static QSE_INLINE_ALWAYS int is_list_empty (qse_scm_t* scm)
 {
 	/* the stack must not be empty */
 	QSE_ASSERTX (
-		!IS_NIL(scm->rstack), 
+		!IS_NIL(scm->r.s), 
 		"You can not call this function while the stack is empty"		
 	);
 
 	/* if the tail pointer is pointing to nil, the list is empty */
-	return IS_NIL(PAIR_CAR(scm->rstack));
+	return IS_NIL(PAIR_CAR(scm->r.s));
 }
 
-static qse_scm_ent_t* read_entity (qse_scm_t* scm)
+static int read_entity (qse_scm_t* scm)
 {
 	/* this function read an s-expression non-recursively
 	 * by manipulating its own stack. */
 
-	int level = 0, flag = 0; 
+	int level = 0, flagv = 0; 
 	qse_scm_ent_t* obj;
 
 	while (1)
@@ -1081,19 +1453,21 @@ static qse_scm_ent_t* read_entity (qse_scm_t* scm)
 			default:
 				QSE_ASSERT (!"should never happen - invalid token type");
 				qse_scm_seterror (scm, QSE_SCM_EINTERN, QSE_NULL, QSE_NULL);
-				return QSE_NULL;
+				return -1;
 
+#if 0
 			case TOK_INVALID:
 				qse_scm_seterror (
 					scm, QSE_SCM_ESYNTAX,
 					QSE_NULL, &TOK_LOC(scm));
-				return QSE_NULL;
+				return -1;
+#endif
 			
 			case TOK_END:
 				qse_scm_seterror (
 					scm, QSE_SCM_EEND,
 					QSE_NULL, &TOK_LOC(scm));
-				return QSE_NULL;
+				return -1;
 
 			case TOK_QUOTE:
 				if (level >= QSE_TYPE_MAX(int))
@@ -1102,16 +1476,16 @@ static qse_scm_ent_t* read_entity (qse_scm_t* scm)
 					qse_scm_seterror (
 						scm, QSE_SCM_ELSTDEEP,
 						QSE_NULL, &TOK_LOC(scm));
-					return QSE_NULL;
+					return -1;
 				}
 
 				/* enter a quoted string */
-				flag |= QUOTED;
-				if (enter_list (scm, flag) == QSE_NULL) return QSE_NULL;
+				flagv |= QUOTED;
+				if (enter_list (scm, flagv) == QSE_NULL) return -1;
 				level++;
 
 				/* force-chain the quote symbol to the new list entered */
-				if (chain_to_list (scm, scm->mem.quote) == QSE_NULL) return QSE_NULL;
+				if (chain_to_list (scm, scm->quote) == QSE_NULL) return -1;
 
 				/* read the next token */
 				READ_TOKEN (scm);
@@ -1124,12 +1498,12 @@ static qse_scm_ent_t* read_entity (qse_scm_t* scm)
 					qse_scm_seterror (
 						scm, QSE_SCM_ELSTDEEP,
 						QSE_NULL, &TOK_LOC(scm));
-					return QSE_NULL;
+					return -1;
 				}
 
 				/* enter a normal string */
-				flag = 0;
-				if (enter_list (scm, flag) == QSE_NULL) return QSE_NULL;
+				flagv = 0;
+				if (enter_list (scm, flagv) == QSE_NULL) return -1;
 				level++;
 
 				/* read the next token */
@@ -1139,8 +1513,10 @@ static qse_scm_ent_t* read_entity (qse_scm_t* scm)
 			case TOK_DOT:
 				if (level <= 0 || is_list_empty (scm))
 				{
-					qse_scm_seterror (scm, QSE_SCM_ESYNTAX, QSE_NULL, &TOK_LOC(scm));
-					return QSE_NULL;
+					qse_scm_seterror (
+						scm, QSE_SCM_EDOT, 
+						QSE_NULL, &TOK_LOC(scm));
+					return -1;
 				}
 
 				dot_list (scm);
@@ -1148,7 +1524,7 @@ static qse_scm_ent_t* read_entity (qse_scm_t* scm)
 				goto redo;
 		
 			case TOK_RPAREN:
-				if ((flag & QUOTED) || level <= 0)
+				if ((flagv & QUOTED) || level <= 0)
 				{
 					/* the right parenthesis can never appear while 
 					 * 'quoted' is true. 'quoted' is set to false when 
@@ -1168,45 +1544,53 @@ static qse_scm_ent_t* read_entity (qse_scm_t* scm)
 					 * indicated by level<=0.
 					 */
 					qse_scm_seterror (
-						scm, QSE_SCM_ESYNTAX, 
+						scm, QSE_SCM_ELPAREN, 
 						QSE_NULL, &TOK_LOC(scm));
-					return QSE_NULL;
+					return -1;
 				}
 
-				obj = leave_list (scm, &flag);
+				obj = leave_list (scm, &flagv);
 
 				level--;
 				break;
 
+			case TOK_T:
+				obj = scm->t;
+				break;
+
+			case TOK_F:
+				obj = scm->f;
+				break;
+
 			case TOK_INT:
-				obj = qse_scm_makeint (&scm->mem, TOK_IVAL(scm));
+				obj = make_number_entity (scm, TOK_IVAL(scm));
 				break;
 
 			case TOK_REAL:
-				obj = qse_scm_makereal (&scm->mem, TOK_RVAL(scm));
+				obj = make_real_entity (scm, TOK_RVAL(scm));
 				break;
 	
 			case TOK_STRING:
 				obj = make_string_entity (
-					&scm->mem, TOK_SPTR(scm), TOK_SLEN(scm));
+					scm, TOK_NAME_PTR(scm), TOK_NAME_LEN(scm));
 				break;
 
-			case TOK_IDENT:
-				obj = make_symbol_entity (scm, TOK_SPTR(scm));
+			case TOK_SYMBOL:
+				obj = make_symbol_entity (scm, TOK_NAME_PTR(scm));
 				break;
 		}
 
 		/* check if the element is read for a quoted list */
-		while (flag & QUOTED)
+		while (flagv & QUOTED)
 		{
 			QSE_ASSERT (level > 0);
 
 			/* if so, append the element read into the quote list */
-			if (chain_to_list (scm, obj) == QSE_NULL) return QSE_NULL;
+			if (chain_to_list (scm, obj) == QSE_NULL) return -1;
 
 			/* exit out of the quoted list. the quoted list can have 
 			 * one element only. */
-			obj = leave_list (scm, &flag);
+			obj = leave_list (scm, &flagv);
 
 			/* one level up toward the top */
 			level--;
@@ -1217,7 +1601,7 @@ static qse_scm_ent_t* read_entity (qse_scm_t* scm)
 
 		/* if not, append the element read into the current list.
 		 * if we are not at the top level, we must be in a list */
-		if (chain_to_list (scm, obj) == QSE_NULL) return QSE_NULL;
+		if (chain_to_list (scm, obj) == QSE_NULL) return -1;
 
 		/* read the next token */
 		READ_TOKEN (scm);
@@ -1226,8 +1610,10 @@ static qse_scm_ent_t* read_entity (qse_scm_t* scm)
 	/* upon exit, we must be at the top level */
 	QSE_ASSERT (level == 0);
 
-	return obj;
+	scm->r.e = obj; 
+	return 0;
 }	
+
 qse_scm_ent_t* qse_scm_read (qse_scm_t* scm)
 {
 	QSE_ASSERTX (
@@ -1235,9 +1621,38 @@ qse_scm_ent_t* qse_scm_read (qse_scm_t* scm)
 		"Specify input function before calling qse_scm_read()"
 	);
 
-	while (1)
+	if (read_char(scm) <= -1) return QSE_NULL;
+	if (read_token(scm) <= -1) return QSE_NULL;
+
+#if 0
+	scm.r.state = READ_NORMAL;
+	do 
 	{
+		if (func[scm.r.state] (scm) <= -1) return QSE_NULL;
 	}
-	return QSE_NULL;
+	while (scm.r.state != READ_DONE)
+#endif
+
+#if 0
+	do
+	{
+		qse_printf (QSE_T("TOKEN: [%s]\n"), TOK_NAME_PTR(scm));
+		if (read_token(scm) <= -1) return QSE_NULL;
+	}
+	while (TOK_TYPE(scm) != TOK_END);
+#endif
+
+	if (read_entity (scm) <= -1) return QSE_NULL;
+
+#if 0
+{
+	int i;
+	for (i = 0; i < 100; i++)
+	{
+		qse_printf (QSE_T("%p\n"), alloc_entity(scm, QSE_NULL, QSE_NULL));
+	}
+}
+#endif
+	return scm->r.e;
 }
 
diff --git a/qse/lib/scm/scm.h b/qse/lib/scm/scm.h
index 1c9a6a4a..ae5f0ad0 100644
--- a/qse/lib/scm/scm.h
+++ b/qse/lib/scm/scm.h
@@ -26,36 +26,27 @@
 #include <qse/cmn/str.h>
 #include <qse/scm/scm.h>
 
-#define QSE_SCM_ISUPPER(scm,c)  QSE_ISUPPER(c)
-#define QSE_SCM_ISLOWER(scm,c)  QSE_ISLOWER(c)
-#define QSE_SCM_ISALPHA(scm,c)  QSE_ISALPHA(c)
-#define QSE_SCM_ISDIGIT(scm,c)  QSE_ISDIGIT(c)
-#define QSE_SCM_ISXDIGIT(scm,c) QSE_ISXDIGIT(c)
-#define QSE_SCM_ISALNUM(scm,c)  QSE_ISALNUM(c)
-#define QSE_SCM_ISSPACE(scm,c)  QSE_ISSPACE(c)
-#define QSE_SCM_ISPRINT(scm,c)  QSE_ISPRINT(c)
-#define QSE_SCM_ISGRAPH(scm,c)  QSE_ISGRAPH(c)
-#define QSE_SCM_ISCNTRL(scm,c)  QSE_ISCNTRL(c)
-#define QSE_SCM_ISPUNCT(scm,c)  QSE_ISPUNCT(c)
-#define QSE_SCM_TOUPPER(scm,c)  QSE_TOUPPER(c)
-#define QSE_SCM_TOLOWER(scm,c)  QSE_TOLOWER(c)
-
 /* Note that not all these values can be ORed with each other.
- * each value represents its own type except that QSE_SCM_ENT_SYNT
- * can be ORed with QSE_SCM_ENT_SYM.
+ * each value represents its own type except the following combinations.
+ *
+ *   QSE_SCM_ENT_T | QSE_SCM_ENT_BOOL
+ *   QSE_SCM_ENT_F | QSE_SCM_ENT_BOOL
+ *   QSE_SCM_ENT_SYM | QSE_SCM_ENT_SYNT
  */
 enum qse_scm_ent_type_t
 {
 	QSE_SCM_ENT_NIL     = (1 << 0),
 	QSE_SCM_ENT_T       = (1 << 1),
 	QSE_SCM_ENT_F       = (1 << 2),
-	QSE_SCM_ENT_NUM     = (1 << 3),
-	QSE_SCM_ENT_STR     = (1 << 4), 
-	QSE_SCM_ENT_NAM     = (1 << 5),
-	QSE_SCM_ENT_SYM     = (1 << 6),
-	QSE_SCM_ENT_PAIR    = (1 << 7),
-	QSE_SCM_ENT_PROC    = (1 << 8),
-	QSE_SCM_ENT_SYNT    = (1 << 9)
+	QSE_SCM_ENT_BOOL    = (1 << 3),
+	QSE_SCM_ENT_NUM     = (1 << 4),
+	QSE_SCM_ENT_REAL    = (1 << 5),
+	QSE_SCM_ENT_STR     = (1 << 6), 
+	QSE_SCM_ENT_NAM     = (1 << 7),
+	QSE_SCM_ENT_SYM     = (1 << 8),
+	QSE_SCM_ENT_PAIR    = (1 << 9),
+	QSE_SCM_ENT_PROC    = (1 << 10),
+	QSE_SCM_ENT_SYNT    = (1 << 11)
 
 };
 
@@ -72,10 +63,10 @@ enum qse_scm_ent_type_t
  */
 struct qse_scm_ent_t
 {
-	qse_uint16_t dswcount: 2;
-	qse_uint16_t mark:     1;
-	qse_uint16_t atom:     1;
-	qse_uint16_t type:     12;
+	qse_uint32_t dswcount: 2;
+	qse_uint32_t mark:     1;
+	qse_uint32_t atom:     1;
+	qse_uint32_t type:     28;
 
 	union
 	{
@@ -84,6 +75,11 @@ struct qse_scm_ent_t
 			qse_long_t val;
 		} num; /* number */
 
+		struct
+		{
+			qse_real_t val;
+		} real;
+
 		struct
 		{
 			/* a string doesn't need to be null-terminated 
@@ -115,6 +111,7 @@ struct qse_scm_ent_t
 #define TYPE(v)           ((v)->type)
 #define ATOM(v)           ((v)->atom)
 #define NUM_VALUE(v)      ((v)->u.num.val)
+#define REAL_VALUE(v)     ((v)->u.real.val)
 #define STR_PTR(v)        ((v)->u.str.ptr)
 #define STR_LEN(v)        ((v)->u.str.len)
 #define LAB_PTR(v)        ((v)->u.lab.ptr)
@@ -178,6 +175,9 @@ struct qse_scm_t
 			qse_real_t    rval;
 			qse_str_t     name;
 		} t;
+
+		qse_scm_ent_t* s; /* stack for reading */
+		qse_scm_ent_t* e; /* last entity read */
 	} r;
 
 	/* common values */
@@ -189,7 +189,6 @@ struct qse_scm_t
 
 	qse_scm_ent_t* gloenv; /* global environment */
 	qse_scm_ent_t* symtab; /* symbol table */
-	qse_scm_ent_t* rstack; /* stack for reading */
 
 	/* registers */
 	struct