hyung-hwan/qse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

abandoned unmaintained directories

Browse Source
This commit is contained in:
hyung-hwan 2011-09-27 23:08:25 +00:00
parent 9fb0bc1628
commit 84cb2b81d8
17 changed files with 5 additions and 4127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
qse/cmd/Makefile.am
View File

@ -1,2 +1,2 @@
SUBDIRS = awk cut sed stx
SUBDIRS = awk cut sed
DIST_SUBDIRS = $(SUBDIRS)

2
qse/cmd/Makefile.in
View File

@ -230,7 +230,7 @@ target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
SUBDIRS = awk cut sed stx
SUBDIRS = awk cut sed
DIST_SUBDIRS = $(SUBDIRS)
all: all-recursive

13
qse/cmd/scm/Makefile.am
View File

@ -1,13 +0,0 @@
AUTOMAKE_OPTIONS = nostdinc
AM_CPPFLAGS = \
-I$(top_builddir)/include \
-I$(top_srcdir)/include \
-I$(includedir)
bin_PROGRAMS = qsescm
qsescm_SOURCES = scm.c
qsescm_LDFLAGS = -L../../lib/scm -L$(libdir)
qsescm_LDADD = -lqsescm $(LIBM)

543
qse/cmd/scm/Makefile.in
View File

@ -1,543 +0,0 @@
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,
# Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
bin_PROGRAMS = qsescm$(EXEEXT)
subdir = cmd/scm
DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/libtool.m4 \
$(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \
$(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \
$(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_HEADER = $(top_builddir)/include/qse/config.h
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am__installdirs = "$(DESTDIR)$(bindir)"
PROGRAMS = $(bin_PROGRAMS)
am_qsescm_OBJECTS = scm.$(OBJEXT)
qsescm_OBJECTS = $(am_qsescm_OBJECTS)
am__DEPENDENCIES_1 =
qsescm_DEPENDENCIES = $(am__DEPENDENCIES_1)
qsescm_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
--mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(qsescm_LDFLAGS) \
$(LDFLAGS) -o $@
DEFAULT_INCLUDES =
depcomp = $(SHELL) $(top_srcdir)/ac/depcomp
am__depfiles_maybe = depfiles
am__mv = mv -f
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
LTCOMPILE = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
--mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
CCLD = $(CC)
LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
--mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \
$(LDFLAGS) -o $@
SOURCES = $(qsescm_SOURCES)
DIST_SOURCES = $(qsescm_SOURCES)
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AR = @AR@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BUILD_MODE = @BUILD_MODE@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CHAR_MODE = @CHAR_MODE@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CXX = @CXX@
CXXCPP = @CXXCPP@
CXXDEPMODE = @CXXDEPMODE@
CXXFLAGS = @CXXFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO = @ECHO@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
FGREP = @FGREP@
GREP = @GREP@
HAVE_CXX = @HAVE_CXX@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBM = @LIBM@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIBTOOL_DEPS = @LIBTOOL_DEPS@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAKEINFO = @MAKEINFO@
MKDIR_P = @MKDIR_P@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
QSE_PROJECT_AUTHOR = @QSE_PROJECT_AUTHOR@
QSE_PROJECT_URL = @QSE_PROJECT_URL@
QSE_SIZEOF_CHAR = @QSE_SIZEOF_CHAR@
QSE_SIZEOF_DOUBLE = @QSE_SIZEOF_DOUBLE@
QSE_SIZEOF_FLOAT = @QSE_SIZEOF_FLOAT@
QSE_SIZEOF_INT = @QSE_SIZEOF_INT@
QSE_SIZEOF_LONG = @QSE_SIZEOF_LONG@
QSE_SIZEOF_LONG_DOUBLE = @QSE_SIZEOF_LONG_DOUBLE@
QSE_SIZEOF_LONG_LONG = @QSE_SIZEOF_LONG_LONG@
QSE_SIZEOF_SHORT = @QSE_SIZEOF_SHORT@
QSE_SIZEOF_VOID_P = @QSE_SIZEOF_VOID_P@
QSE_SIZEOF_WCHAR_T = @QSE_SIZEOF_WCHAR_T@
RANLIB = @RANLIB@
RM = @RM@
RMDIR = @RMDIR@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
TRUE = @TRUE@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_CC = @ac_ct_CC@
ac_ct_CXX = @ac_ct_CXX@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
lt_ECHO = @lt_ECHO@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
AUTOMAKE_OPTIONS = nostdinc
AM_CPPFLAGS = \
-I$(top_builddir)/include \
-I$(top_srcdir)/include \
-I$(includedir)
qsescm_SOURCES = scm.c
qsescm_LDFLAGS = -L../../lib/scm -L$(libdir)
qsescm_LDADD = -lqsescm $(LIBM)
all: all-am
.SUFFIXES:
.SUFFIXES: .c .lo .o .obj
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign cmd/scm/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign cmd/scm/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
install-binPROGRAMS: $(bin_PROGRAMS)
@$(NORMAL_INSTALL)
test -z "$(bindir)" || $(MKDIR_P) "$(DESTDIR)$(bindir)"
@list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \
for p in $$list; do echo "$$p $$p"; done | \
sed 's/$(EXEEXT)$$//' | \
while read p p1; do if test -f $$p || test -f $$p1; \
then echo "$$p"; echo "$$p"; else :; fi; \
done | \
sed -e 'p;s,.*/,,;n;h' -e 's|.*|.|' \
-e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \
sed 'N;N;N;s,\n, ,g' | \
$(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \
{ d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \
if ($$2 == $$4) files[d] = files[d] " " $$1; \
else { print "f", $$3 "/" $$4, $$1; } } \
END { for (d in files) print "f", d, files[d] }' | \
while read type dir files; do \
if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \
test -z "$$files" || { \
echo " $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \
$(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \
} \
; done
uninstall-binPROGRAMS:
@$(NORMAL_UNINSTALL)
@list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \
files=`for p in $$list; do echo "$$p"; done | \
sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \
-e 's/$$/$(EXEEXT)/' `; \
test -n "$$list" || exit 0; \
echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \
cd "$(DESTDIR)$(bindir)" && rm -f $$files
clean-binPROGRAMS:
@list='$(bin_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
qsescm$(EXEEXT): $(qsescm_OBJECTS) $(qsescm_DEPENDENCIES)
@rm -f qsescm$(EXEEXT)
$(qsescm_LINK) $(qsescm_OBJECTS) $(qsescm_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/scm.Po@am__quote@
.c.o:
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(COMPILE) -c $<
.c.obj:
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'`
.c.lo:
@am__fastdepCC_TRUE@ $(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in files) print i; }; }'`; \
mkid -fID $$unique
tags: TAGS
TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
$(TAGS_FILES) $(LISP)
set x; \
here=`pwd`; \
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in files) print i; }; }'`; \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: CTAGS
CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
$(TAGS_FILES) $(LISP)
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in files) print i; }; }'`; \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(PROGRAMS)
installdirs:
for dir in "$(DESTDIR)$(bindir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
`test -z '$(STRIP)' || \
echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-binPROGRAMS clean-generic clean-libtool mostlyclean-am
distclean: distclean-am
-rm -rf ./$(DEPDIR)
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am: install-binPROGRAMS
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -rf ./$(DEPDIR)
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am: uninstall-binPROGRAMS
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS all all-am check check-am clean clean-binPROGRAMS \
clean-generic clean-libtool ctags distclean distclean-compile \
distclean-generic distclean-libtool distclean-tags distdir dvi \
dvi-am html html-am info info-am install install-am \
install-binPROGRAMS install-data install-data-am install-dvi \
install-dvi-am install-exec install-exec-am install-html \
install-html-am install-info install-info-am install-man \
install-pdf install-pdf-am install-ps install-ps-am \
install-strip installcheck installcheck-am installdirs \
maintainer-clean maintainer-clean-generic mostlyclean \
mostlyclean-compile mostlyclean-generic mostlyclean-libtool \
pdf pdf-am ps ps-am tags uninstall uninstall-am \
uninstall-binPROGRAMS
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:

404
qse/cmd/scm/scm.c
View File

@ -1,404 +0,0 @@
/*
* $Id: scm.c,v 1.5 2007/05/16 09:15:14 bacon Exp $
*/
#include <qse/scm/scm.h>
#include <qse/cmn/mem.h>
#include <qse/cmn/chr.h>
#include <qse/cmn/str.h>
#include <qse/cmn/opt.h>
#include <qse/cmn/stdio.h>
#include <qse/cmn/main.h>
#include <string.h>
#include <stdlib.h>
static qse_ssize_t get_input (
qse_scm_t* scm, qse_scm_io_cmd_t cmd,
qse_scm_io_arg_t* arg, qse_char_t* data, qse_size_t size)
{
switch (cmd)
{
case QSE_SCM_IO_OPEN:
arg->handle = stdin;
return 1;
case QSE_SCM_IO_CLOSE:
return 0;
case QSE_SCM_IO_READ:
{
qse_cint_t c;
if (size <= 0) return -1;
c = qse_fgetc ((FILE*)arg->handle);
if (c == QSE_CHAR_EOF)
{
if (ferror((FILE*)arg->handle)) return -1;
return 0;
}
data[0] = c;
return 1;
}
default:
return -1;
}
}
static qse_ssize_t put_output (
qse_scm_t* scm, qse_scm_io_cmd_t cmd,
qse_scm_io_arg_t* arg, qse_char_t* data, qse_size_t size)
{
switch (cmd)
{
case QSE_SCM_IO_OPEN:
arg->handle = stdout;
return 1;
case QSE_SCM_IO_CLOSE:
return 0;
case QSE_SCM_IO_WRITE:
{
int n = qse_fprintf (
(FILE*)arg->handle, QSE_T("%.*s"), size, data);
if (n < 0) return -1;
return size;
}
default:
return -1;
}
}
static int opt_memsize = 1000;
static int opt_meminc = 1000;
static void print_usage (const qse_char_t* argv0)
{
qse_fprintf (QSE_STDERR,
QSE_T("Usage: %s [options]\n"), argv0);
qse_fprintf (QSE_STDERR,
QSE_T(" -h print this message\n"));
qse_fprintf (QSE_STDERR,
QSE_T(" -m integer number of memory cells\n"));
qse_fprintf (QSE_STDERR,
QSE_T(" -i integer number of memory cell increments\n"));
}
static int handle_args (int argc, qse_char_t* argv[])
{
qse_opt_t opt;
qse_cint_t c;
qse_memset (&opt, 0, QSE_SIZEOF(opt));
opt.str = QSE_T("hm:i:");
while ((c = qse_getopt (argc, argv, &opt)) != QSE_CHAR_EOF)
{
switch (c)
{
case QSE_T('h'):
print_usage (argv[0]);
return -1;
case QSE_T('m'):
opt_memsize = qse_strtoi(opt.arg);
break;
case QSE_T('i'):
opt_meminc = qse_strtoi(opt.arg);
break;
case QSE_T('?'):
qse_fprintf (QSE_STDERR, QSE_T("ERROR: illegal option - %c\n"), opt.opt);
print_usage (argv[0]);
return -1;
case QSE_T(':'):
qse_fprintf (QSE_STDERR, QSE_T("ERROR: missing argument for %c\n"), opt.opt);
print_usage (argv[0]);
return -1;
}
}
if (opt.ind < argc)
{
qse_printf (QSE_T("ERROR: redundant argument - %s\n"), argv[opt.ind]);
print_usage (argv[0]);
return -1;
}
if (opt_memsize <= 0)
{
qse_printf (QSE_T("ERROR: invalid memory size given\n"));
return -1;
}
return 0;
}
#include <qse/cmn/pio.h>
static int pio1 (const qse_char_t* cmd, int oflags, qse_pio_hid_t rhid)
{
qse_pio_t* pio;
int x;
pio = qse_pio_open (
QSE_NULL,
0,
cmd,
oflags
);
if (pio == QSE_NULL)
{
qse_printf (QSE_T("cannot open program through pipe\n"));
return -1;
}
while (1)
{
qse_byte_t buf[128];
qse_ssize_t i;
/*qse_pio_canread (pio, QSE_PIO_ERR, 1000)*/
qse_ssize_t n = qse_pio_read (pio, buf, sizeof(buf), rhid);
if (n == 0) break;
if (n <= -1)
{
qse_printf (
QSE_T("qse_pio_read() returned error - %s\n"),
qse_pio_geterrmsg(pio)
);
break;
}
qse_printf (QSE_T("N===> %d buf => ["), (int)n);
for (i = 0; i < n; i++)
{
#ifdef QSE_CHAR_IS_MCHAR
qse_printf (QSE_T("%c"), buf[i]);
#else
qse_printf (QSE_T("%C"), buf[i]);
#endif
}
qse_printf (QSE_T("]\n"));
}
x = qse_pio_wait (pio);
qse_printf (QSE_T("qse_pio_wait returns %d\n"), x);
if (x <= -1)
{
qse_printf (QSE_T("error code : %d, error string: %s\n"),
(int)qse_pio_geterrnum(pio), qse_pio_geterrmsg(pio));
}
qse_pio_close (pio);
return 0;
}
int scm_main (int argc, qse_char_t* argv[])
{
qse_scm_t* scm;
qse_scm_ent_t* obj;
if (handle_args (argc, argv) == -1) return -1;
scm = qse_scm_open (QSE_NULL, 0, opt_memsize, opt_meminc);
if (scm == QSE_NULL)
{
qse_printf (QSE_T("ERROR: cannot create a scm instance\n"));
return -1;
}
qse_printf (QSE_T("QSESCM 0.0001\n"));
{
qse_scm_io_t io = { get_input, put_output };
qse_scm_attachio (scm, &io);
}
{
int i;
for (i = 0; i<2; i++)
#if defined(_WIN32)
pio1 (QSE_T("c:\\winnt\\system32\\netstat.exe -an"), QSE_PIO_READOUT|QSE_PIO_WRITEIN|/*QSE_PIO_SHELL|*/QSE_PIO_DROPERR, QSE_PIO_OUT);
#elif defined(__OS2__)
pio1 (QSE_T("pstat.exe /c"), QSE_PIO_READOUT|QSE_PIO_WRITEIN|/*QSE_PIO_SHELL|*/QSE_PIO_DROPERR, QSE_PIO_OUT);
#else
pio1 (QSE_T("ls -laF"), QSE_PIO_READOUT|QSE_PIO_WRITEIN|/*QSE_PIO_SHELL|*/QSE_PIO_DROPERR, QSE_PIO_OUT);
#endif
}
{
qse_printf (QSE_T("%d\n"), (int)qse_strspn (QSE_T("abcdefg"), QSE_T("cdab")));
qse_printf (QSE_T("%d\n"), (int)qse_strcspn (QSE_T("abcdefg"), QSE_T("fg")));
qse_printf (QSE_T("%s\n"), qse_strpbrk (QSE_T("abcdefg"), QSE_T("fb")));
qse_printf (QSE_T("%s\n"), qse_strrcasestr (QSE_T("fbFBFBFBxyz"), QSE_T("fb")));
qse_printf (QSE_T("%s\n"), qse_strcasestr (QSE_T("fbFBFBFBxyz"), QSE_T("fb")));
qse_printf (QSE_T("%s\n"), qse_strword (QSE_T("ilove lov LOVE love"), QSE_T("love")));
qse_printf (QSE_T("%s\n"), qse_strcaseword (QSE_T("ilove lov LOVE love"), QSE_T("love")));
qse_printf (QSE_T("%s\n"), qse_strxword (QSE_T("ilove love you"), 14, QSE_T("love")));
}
{
qse_char_t str[256];
qse_size_t len;
qse_strcpy (str, QSE_T("what a Wonderful WORLD"));
len = qse_strlwr(str);
qse_printf (QSE_T("%d %s\n"), (int)len, str);
len = qse_strupr(str);
qse_printf (QSE_T("%d %s\n"), (int)len, str);
}
{
qse_printf (QSE_T("sizeof(int) = %d\n"), (int)sizeof(int));
qse_printf (QSE_T("sizeof(long) = %d\n"), (int)sizeof(long));
#if QSE_SIZEOF_LONG_LONG>0
qse_printf (QSE_T("sizeof(long long) = %d\n"), (int)sizeof(long long));
#endif
qse_printf (QSE_T("sizeof(float) = %d\n"), (int)sizeof(float));
qse_printf (QSE_T("sizeof(double) = %d\n"), (int)sizeof(double));
qse_printf (QSE_T("sizeof(long double) = %d\n"), (int)sizeof(long double));
qse_printf (QSE_T("sizeof(void*) = %d\n"), (int)sizeof(void*));
qse_printf (QSE_T("sizeof(wchar_t) = %d\n"), (int)sizeof(wchar_t));
}
{
const qse_char_t* x = QSE_T("rate:num,burst:num,mode:abc,name:xxx,size:num,max:num,expire:num,gcinterval:num");
const qse_char_t* p = x;
qse_cstr_t tok;
while (p)
{
p = qse_strtok (p, QSE_T(","), &tok);
qse_printf (QSE_T("[%.*s]\n"), (int)tok.len, tok.ptr);
}
}
{
qse_char_t abc[100];
qse_strcpy (abc, QSE_T("abcdefghilklmn"));
qse_strrev (abc);
qse_printf (QSE_T("<%s>\n"), abc);
qse_strrot (abc, -1, 5);
qse_printf (QSE_T("<%s>\n"), abc);
}
{
qse_char_t abc[100];
qse_strcpy (abc, QSE_T("abcdefghilklmnabcdefghik"));
qse_printf (QSE_T("ORIGINAL=><%s>\n"), abc);
qse_strexcl (abc, QSE_T("adfikl"));
qse_printf (QSE_T("AFTER EXCL<%s>\n"), abc);
qse_strincl (abc, QSE_T("bcmn"));
qse_printf (QSE_T("AFTER INCL<%s>\n"), abc);
}
{
qse_scm_ent_t* x1, * x2;
qse_printf (QSE_T("QSESCM> "));
x1 = qse_scm_read (scm);
if (x1 == QSE_NULL)
{
qse_printf (QSE_T("ERROR: %s\n"), qse_scm_geterrmsg(scm));
}
else
{
x2 = qse_scm_eval (scm, x1);
if (x2 == QSE_NULL)
{
qse_printf (QSE_T("ERROR: %s ...\n "), qse_scm_geterrmsg(scm));
qse_scm_print (scm, x1);
qse_printf (QSE_T("\n"));
}
else
{
qse_printf (QSE_T("Evaluated...\n "));
qse_scm_print (scm, x1);
qse_printf (QSE_T("\nTo...\n "));
qse_scm_print (scm, x2);
qse_printf (QSE_T("\n"));
}
}
}
#if 0
while (1)
{
qse_printf (QSE_T("QSESCM $ "));
qse_fflush (stdout);
qse_scm_gc (scm);
obj = qse_scm_read (scm);
if (obj == QSE_NULL)
{
qse_scm_errnum_t errnum;
qse_scm_loc_t errloc;
const qse_char_t* errmsg;
qse_scm_geterror (scm, &errnum, &errmsg, &errloc);
if (errnum != QSE_SCM_EEND &&
errnum != QSE_SCM_EEXIT)
{
qse_printf (
QSE_T("error in read: [%d] %s at line %d column %d\n"),
errnum, errmsg, (int)errloc.line, (int)errloc.colm);
}
/* TODO: change the following check */
if (errnum < QSE_SCM_ESYNTAX) break;
continue;
}
if ((obj = qse_scm_eval (scm, obj)) != QSE_NULL)
{
qse_scm_print (scm, obj);
qse_printf (QSE_T("\n"));
}
else
{
qse_scm_errnum_t errnum;
qse_scm_loc_t errloc;
const qse_char_t* errmsg;
qse_scm_geterror (scm, &errnum, &errmsg, &errloc);
if (errnum == QSE_SCM_EEXIT) break;
qse_printf (
QSE_T("error in eval: [%d] %s at line %d column %d\n"),
errnum, errmsg, (int)errloc.line, (int)errloc.colm);
}
}
#endif
qse_scm_close (scm);
return 0;
}
int qse_main (int argc, qse_achar_t* argv[])
{
return qse_runmain (argc, argv, scm_main);
}

2
qse/lib/Makefile.am
View File

@ -1,2 +1,2 @@
SUBDIRS = cmn awk cut sed net stx
SUBDIRS = cmn awk cut sed
DIST_SUBDIRS = $(SUBDIRS)

2
qse/lib/Makefile.in
View File

@ -230,7 +230,7 @@ target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
SUBDIRS = cmn awk cut sed net stx
SUBDIRS = cmn awk cut sed
DIST_SUBDIRS = $(SUBDIRS)
all: all-recursive

13
qse/lib/scm/Makefile.am
View File

@ -1,13 +0,0 @@
AUTOMAKE_OPTIONS = nostdinc
AM_CPPFLAGS = \
-I$(top_builddir)/include \
-I$(top_srcdir)/include \
-I$(includedir)
lib_LTLIBRARIES = libqsescm.la
libqsescm_la_SOURCES = scm.h scm.c mem.c read.c eval.c print.c err.c
libqsescm_la_LDFLAGS = -L../cmn -L$(libdir) -version-info 1:0:0 -no-undefined
libqsescm_la_LIBADD = -lqsecmn

557
qse/lib/scm/Makefile.in
View File

@ -1,557 +0,0 @@
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,
# Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = lib/scm
DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/libtool.m4 \
$(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \
$(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \
$(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_HEADER = $(top_builddir)/include/qse/config.h
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__installdirs = "$(DESTDIR)$(libdir)"
LTLIBRARIES = $(lib_LTLIBRARIES)
libqsescm_la_DEPENDENCIES =
am_libqsescm_la_OBJECTS = scm.lo mem.lo read.lo eval.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) \
$(libqsescm_la_LDFLAGS) $(LDFLAGS) -o $@
DEFAULT_INCLUDES =
depcomp = $(SHELL) $(top_srcdir)/ac/depcomp
am__depfiles_maybe = depfiles
am__mv = mv -f
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
LTCOMPILE = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
--mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
CCLD = $(CC)
LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
--mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \
$(LDFLAGS) -o $@
SOURCES = $(libqsescm_la_SOURCES)
DIST_SOURCES = $(libqsescm_la_SOURCES)
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AR = @AR@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BUILD_MODE = @BUILD_MODE@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CHAR_MODE = @CHAR_MODE@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CXX = @CXX@
CXXCPP = @CXXCPP@
CXXDEPMODE = @CXXDEPMODE@
CXXFLAGS = @CXXFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO = @ECHO@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
FGREP = @FGREP@
GREP = @GREP@
HAVE_CXX = @HAVE_CXX@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBM = @LIBM@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIBTOOL_DEPS = @LIBTOOL_DEPS@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAKEINFO = @MAKEINFO@
MKDIR_P = @MKDIR_P@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
QSE_PROJECT_AUTHOR = @QSE_PROJECT_AUTHOR@
QSE_PROJECT_URL = @QSE_PROJECT_URL@
QSE_SIZEOF_CHAR = @QSE_SIZEOF_CHAR@
QSE_SIZEOF_DOUBLE = @QSE_SIZEOF_DOUBLE@
QSE_SIZEOF_FLOAT = @QSE_SIZEOF_FLOAT@
QSE_SIZEOF_INT = @QSE_SIZEOF_INT@
QSE_SIZEOF_LONG = @QSE_SIZEOF_LONG@
QSE_SIZEOF_LONG_DOUBLE = @QSE_SIZEOF_LONG_DOUBLE@
QSE_SIZEOF_LONG_LONG = @QSE_SIZEOF_LONG_LONG@
QSE_SIZEOF_SHORT = @QSE_SIZEOF_SHORT@
QSE_SIZEOF_VOID_P = @QSE_SIZEOF_VOID_P@
QSE_SIZEOF_WCHAR_T = @QSE_SIZEOF_WCHAR_T@
RANLIB = @RANLIB@
RM = @RM@
RMDIR = @RMDIR@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
TRUE = @TRUE@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_CC = @ac_ct_CC@
ac_ct_CXX = @ac_ct_CXX@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
lt_ECHO = @lt_ECHO@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
AUTOMAKE_OPTIONS = nostdinc
AM_CPPFLAGS = \
-I$(top_builddir)/include \
-I$(top_srcdir)/include \
-I$(includedir)
lib_LTLIBRARIES = libqsescm.la
libqsescm_la_SOURCES = scm.h scm.c mem.c read.c eval.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
.SUFFIXES:
.SUFFIXES: .c .lo .o .obj
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign lib/scm/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign lib/scm/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
install-libLTLIBRARIES: $(lib_LTLIBRARIES)
@$(NORMAL_INSTALL)
test -z "$(libdir)" || $(MKDIR_P) "$(DESTDIR)$(libdir)"
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
list2=; for p in $$list; do \
if test -f $$p; then \
list2="$$list2 $$p"; \
else :; fi; \
done; \
test -z "$$list2" || { \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(libdir)'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(libdir)"; \
}
uninstall-libLTLIBRARIES:
@$(NORMAL_UNINSTALL)
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
for p in $$list; do \
$(am__strip_dir) \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$f'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$f"; \
done
clean-libLTLIBRARIES:
-test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES)
@list='$(lib_LTLIBRARIES)'; for p in $$list; do \
dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \
test "$$dir" != "$$p" || dir=.; \
echo "rm -f \"$${dir}/so_locations\""; \
rm -f "$${dir}/so_locations"; \
done
libqsescm.la: $(libqsescm_la_OBJECTS) $(libqsescm_la_DEPENDENCIES)
$(libqsescm_la_LINK) -rpath $(libdir) $(libqsescm_la_OBJECTS) $(libqsescm_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/err.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eval.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mem.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/print.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/read.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/scm.Plo@am__quote@
.c.o:
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(COMPILE) -c $<
.c.obj:
@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'`
.c.lo:
@am__fastdepCC_TRUE@ $(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in files) print i; }; }'`; \
mkid -fID $$unique
tags: TAGS
TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
$(TAGS_FILES) $(LISP)
set x; \
here=`pwd`; \
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in files) print i; }; }'`; \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: CTAGS
CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
$(TAGS_FILES) $(LISP)
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) '{ files[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in files) print i; }; }'`; \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(LTLIBRARIES)
installdirs:
for dir in "$(DESTDIR)$(libdir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
`test -z '$(STRIP)' || \
echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libLTLIBRARIES clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -rf ./$(DEPDIR)
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am: install-libLTLIBRARIES
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -rf ./$(DEPDIR)
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am: uninstall-libLTLIBRARIES
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \
clean-libLTLIBRARIES clean-libtool ctags distclean \
distclean-compile distclean-generic distclean-libtool \
distclean-tags distdir dvi dvi-am html html-am info info-am \
install install-am install-data install-data-am install-dvi \
install-dvi-am install-exec install-exec-am install-html \
install-html-am install-info install-info-am \
install-libLTLIBRARIES install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags uninstall uninstall-am uninstall-libLTLIBRARIES
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:

132
qse/lib/scm/err.c
View File

@ -1,132 +0,0 @@
/*
* $Id$
*
Copyright 2006-2011 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"
const qse_char_t* qse_scm_dflerrstr (qse_scm_t* scm, qse_scm_errnum_t errnum)
{
static const qse_char_t* errstr[] =
{
QSE_T("no error"),
QSE_T("out of memory"),
QSE_T("internal error"),
QSE_T("exit"),
QSE_T("end of source"),
QSE_T("I/O error"),
QSE_T("unexpected end of string"),
QSE_T("bad sharp expression"),
QSE_T("wrong use of dot"),
QSE_T("left parenthesis expected"),
QSE_T("right parenthesis expected"),
QSE_T("list too deep"),
QSE_T("bad variable"),
QSE_T("bad arguments"),
QSE_T("too few arguments"),
QSE_T("too many arguments"),
QSE_T("undefined function '${0}'"),
QSE_T("bad function"),
QSE_T("duplicate formal"),
QSE_T("bad symbol"),
QSE_T("undefined symbol '${0}'"),
QSE_T("empty body"),
QSE_T("bad value"),
QSE_T("divide by zero")
};
return (errnum >= 0 && errnum < QSE_COUNTOF(errstr))?
errstr[errnum]: QSE_T("unknown error");
}
qse_scm_errstr_t qse_scm_geterrstr (qse_scm_t* scm)
{
return scm->err.str;
}
void qse_scm_seterrstr (qse_scm_t* scm, qse_scm_errstr_t errstr)
{
scm->err.str = errstr;
}
qse_scm_errnum_t qse_scm_geterrnum (qse_scm_t* scm)
{
return scm->err.num;
}
const qse_scm_loc_t* qse_scm_geterrloc (qse_scm_t* scm)
{
return &scm->err.loc;
}
const qse_char_t* qse_scm_geterrmsg (qse_scm_t* scm)
{
return (scm->err.msg[0] == QSE_T('\0'))?
qse_scm_geterrstr(scm)(scm,scm->err.num): scm->err.msg;
}
void qse_scm_geterror (
qse_scm_t* scm, qse_scm_errnum_t* errnum,
const qse_char_t** errmsg, qse_scm_loc_t* errloc)
{
if (errnum != QSE_NULL) *errnum = scm->err.num;
if (errmsg != QSE_NULL)
{
*errmsg = (scm->err.msg[0] == QSE_T('\0'))?
qse_scm_geterrstr(scm)(scm,scm->err.num):
scm->err.msg;
}
if (errloc != QSE_NULL) *errloc = scm->err.loc;
}
void qse_scm_seterrnum (
qse_scm_t* scm, qse_scm_errnum_t errnum, const qse_cstr_t* errarg)
{
qse_scm_seterror (scm, errnum, errarg, QSE_NULL);
}
void qse_scm_seterrmsg (
qse_scm_t* scm, qse_scm_errnum_t errnum,
const qse_char_t* errmsg, const qse_scm_loc_t* errloc)
{
scm->err.num = errnum;
qse_strxcpy (scm->err.msg, QSE_COUNTOF(scm->err.msg), errmsg);
if (errloc != QSE_NULL) scm->err.loc = *errloc;
else QSE_MEMSET (&scm->err.loc, 0, QSE_SIZEOF(scm->err.loc));
}
void qse_scm_seterror (
qse_scm_t* scm, qse_scm_errnum_t errnum,
const qse_cstr_t* errarg, const qse_scm_loc_t* errloc)
{
const qse_char_t* errfmt;
scm->err.num = errnum;
errfmt = qse_scm_geterrstr(scm)(scm,scm->err.num);
QSE_ASSERT (errfmt != QSE_NULL);
qse_strxfncpy (scm->err.msg, QSE_COUNTOF(scm->err.msg), errfmt, errarg);
if (errloc != QSE_NULL) scm->err.loc = *errloc;
else QSE_MEMSET (&scm->err.loc, 0, QSE_SIZEOF(scm->err.loc));
}

209
qse/lib/scm/eval.c
View File

@ -1,209 +0,0 @@
/*
* $Id$
*
Copyright 2006-2011 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"
static int eval_entity (qse_scm_t* scm);
#if 0
static int save (qse_scm_t* scm, qse_scm_ent_t* )
{
}
static int leave (qse_scm_t* scm)
{
}
#endif
int qse_scm_dolambda (qse_scm_t* scm)
{
qse_scm_ent_t* obj;
obj = qse_scm_makeclosent (scm, scm->e.cod, scm->e.env);
if (obj == QSE_NULL) return -1;
scm->e.out = obj;
return 0;
}
int qse_scm_doquote (qse_scm_t* scm)
{
/* For the expression (quote 10),
* scm.e.cod is (10).
* PAIR_CAR(scm.e.cod) is 10
*/
scm->e.out = PAIR_CAR(scm->e.cod);
return 0;
}
static int define_finish (qse_scm_t* scm)
{
// qse_scm_ent_t* var = scm->e.cod;
//set var in the environemtn....
//leave (scm);
return 0;
}
int qse_scm_dodefine (qse_scm_t* scm)
{
qse_scm_ent_t* car, * cdr;
car = PAIR_CAR(scm->e.cod);
cdr = PAIR_CDR(scm->e.cod);
/* TODO: support function defintion - (define (f x y) (+ x y) (* x y))
-> support it by converting it to lambda expression
-> (define f (lambda (x y) (+ x y) (* x y))
*/
if (IS_SMALLINT(scm,cdr) || TYPE(cdr) != QSE_SCM_ENT_PAIR)
{
/* (define x . 10) */
/* TODO: change error code ... */
qse_scm_seterror (scm, QSE_SCM_EARGBAD, QSE_NULL, QSE_NULL);
return -1;
}
if (!IS_NIL(scm,PAIR_CDR(cdr)))
{
/* (define x 10 . 20)
* (define x 10 20) */
qse_scm_seterror (scm, QSE_SCM_EARGMANY, QSE_NULL, QSE_NULL);
return -1;
}
if (IS_SMALLINT(scm,car) || TYPE(car) != QSE_SCM_ENT_SYM)
{
/* check if the variable is a symbol
* (define 20 10)
*/
qse_scm_seterror (scm, QSE_SCM_EVARBAD, QSE_NULL, QSE_NULL);
return -1;
}
// save car...
// let it jump to EVAL and come back to DEFINE_FINISH...
scm->e.cod = PAIR_CAR(cdr);
scm->e.op = eval_entity;
return 0;
}
int qse_scm_dobegin (qse_scm_t* scm)
{
/*
(begin
(print "hello")
(print "world")
)
*/
qse_scm_ent_t* car, * cdr;
if (IS_SMALLINT(scm, scm->e.cod) || TYPE(scm->e.cod) != QSE_SCM_ENT_PAIR)
{
/* (begin (+ x y) . 30) */
qse_scm_seterror (scm, QSE_SCM_EARGBAD, QSE_NULL, QSE_NULL);
return -1;
}
car = PAIR_CAR(scm->e.cod);
cdr = PAIR_CDR(scm->e.cod);
if (!IS_NIL(scm,cdr))
{
//save (BEGIN... cdr);
}
scm->e.cod = car;
scm->e.op = eval_entity;
return 0;
}
int qse_scm_doif (qse_scm_t* scm)
{
return 0;
}
static int eval_entity (qse_scm_t* scm)
{
if (IS_SMALLINT(scm,scm->e.cod))
{
}
else if (TYPE(scm->e.cod) == QSE_SCM_ENT_PAIR)
{
qse_scm_ent_t* car, * cdr;
/* the first item in the list */
car = PAIR_CAR(scm->e.cod);
if (SYNT(car))
{
/* the first item in the list is a syntax symbol */
cdr = PAIR_CDR(scm->e.cod);
if (IS_SMALLINT(scm,cdr) || TYPE(cdr) != QSE_SCM_ENT_PAIR)
{
/* check if the cdr part ends the list with a dot
* as in (quote . 10) */
qse_scm_seterror (scm, QSE_SCM_EARGBAD, 0, 0);
return -1;
}
/* go on to the syntax function */
scm->e.cod = cdr;
scm->e.op = SYNT_UPTR(car);
}
else
{
/*
push E1_ARG.... NIL, PAIR_CDR(code)
scm->e.cod = car;
goback to eval...
*/
}
}
else if (TYPE(scm->e.cod) == QSE_SCM_ENT_SYM)
{
/* resolve the symbol from the environment */
}
else
{
}
return 0;
}
qse_scm_ent_t* qse_scm_eval (qse_scm_t* scm, qse_scm_ent_t* obj)
{
scm->e.dmp = scm->nil;
scm->e.env = scm->gloenv;
scm->e.cod = obj;
scm->e.in = obj;
scm->e.out = scm->nil;
scm->e.op = eval_entity;
do
{
if (scm->e.op (scm) <= -1) return QSE_NULL;
break;
}
while (scm->e.op);
return scm->e.out;
}

544
qse/lib/scm/mem.c
View File

@ -1,544 +0,0 @@
/*
* $Id$
*
Copyright 2006-2011 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"
static qse_scm_enb_t* new_entity_block (qse_scm_t* scm, qse_size_t 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;
/* 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 (raw == QSE_NULL)
{
qse_scm_seterror (scm, QSE_SCM_ENOMEM, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
/* 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 */
blk->next = scm->mem.ebl;
scm->mem.ebl = blk;
/* 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++)
{
qse_scm_ent_t* tmp = v++;
PAIR_CDR(tmp) = v;
}
PAIR_CDR(v) = scm->mem.free;
scm->mem.free = &blk->ptr[0];
return blk;
};
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
* with the help of additional variables.
*/
qse_scm_ent_t* parent, * me;
if (IS_SMALLINT(scm,v)) return;
/* Initialization */
parent = QSE_NULL;
me = v;
MARK(me) = 1;
/*if (!ATOM(me))*/ DSWCOUNT(me) = 0;
while (1)
{
if (ATOM(me) || DSWCOUNT(me) >= QSE_COUNTOF(me->u.ref.ent))
{
/*
* Backtrack to the parent node
*/
qse_scm_ent_t* child;
/* Nothing more to backtrack? end of marking */
if (parent == QSE_NULL) return;
/* Remember me temporarily for restoration below */
child = me;
/* The current parent becomes me */
me = parent;
/* Change the parent to the parent of parent */
parent = me->u.ref.ent[DSWCOUNT(me)];
/* Restore the cell contents */
me->u.ref.ent[DSWCOUNT(me)] = child;
/* Increment the counter to indicate that the
* 'count'th field has been processed. */
DSWCOUNT(me)++;
}
else
{
/*
* Move on to an unprocessed child
*/
qse_scm_ent_t* child;
child = me->u.ref.ent[DSWCOUNT(me)];
/* Process the field */
QSE_ASSERT (child != QSE_NULL);
if (IS_SMALLINT(scm,child) || MARK(child))
{
/* 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 */
parent = me;
/* Let me point to the child chosen */
me = child;
MARK(me) = 1;
/*if (!ATOM(me))*/ DSWCOUNT(me) = 0;
}
}
}
}
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?
* 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. */
mark (scm, scm->symtab);
mark (scm, scm->gloenv);
mark (scm, scm->r.s);
mark (scm, scm->r.e);
mark (scm, scm->p.s);
mark (scm, scm->p.e);
mark (scm, scm->e.arg);
mark (scm, scm->e.env);
mark (scm, scm->e.cod);
mark (scm, scm->e.dmp);
/* mark the temporaries */
if (x) mark (scm, x);
if (y) mark (scm, y);
/* scan the allocated values */
}
/*
rsr4
the following identifiers are syntactic keywors and should not be
used as variables.
=> do or
and else quasiquote
begin if quote
case lambda set!
cond let unquote
define let* unquote-splicing
delay letrec
however, you can allow for these keywords to be used as variables...
biniding, unbound...
environment.. a set of visible bindings at some point in a program.
type atom cons
number NUMBER Y
string STRING Y
symbol SYMBOL name,NIL
syntax SYNTAX|SYMBOL name,NIL
proc PROC Y
pair PAIR Y
closure
continuation
an atom does not reference any other values.
a symbol can be assoicated with property list
(put 'a 'name "brian")
(put 'a 'city "daegu")
-------------------------
(define a1 'a)
(put a1 'name "brian")
(put a1 'city "daegu")
-------------------------
(get a1 'name)
(get a1 'city)
a procedure is a privimitive routine built-in to scheme.
a closure is an anonymous routine defined with lambda.
both can be bound to a variable in the environment.
a syntax is more primitive than a procedure.
a syntax is created as if it is a symbol but not registerd
into an environment
car cdr
| STR | PTR CHR ARR | -1 |
| PROC | PROCNUM | |
| SYM | REF STR | REF PROP LIST |
| SYN | REF STR | REF PROP LIST |
*/
static qse_scm_ent_t* alloc_entity (
qse_scm_t* scm, qse_scm_ent_t* x, qse_scm_ent_t* y)
{
/* find a free value slot and return it.
* two parameters x and y are saved from garbage collection */
qse_scm_ent_t* v;
if (IS_NIL(scm,scm->mem.free))
{
/* if no free slot is available */
gc (scm, x, y); /* perform garbage collection */
if (IS_NIL(scm,scm->mem.free))
{
/* if no free slot is available after garbage collection,
* make new value blocks containing more free slots */
/* TODO: make the value block size configurable */
if (new_entity_block (scm, 1000) == QSE_NULL) return QSE_NULL;
QSE_ASSERT (scm->mem.free != scm->nil);
}
}
v = scm->mem.free;
scm->mem.free = PAIR_CDR(v);
return v;
}
qse_scm_ent_t* qse_scm_makepairent (
qse_scm_t* scm, qse_scm_ent_t* car, qse_scm_ent_t* cdr)
{
qse_scm_ent_t* v;
v = alloc_entity (scm, car, cdr);
if (v == QSE_NULL) return QSE_NULL;
TYPE(v) = QSE_SCM_ENT_PAIR;
ATOM(v) = 0; /* a pair is not an atom as it references other entities */
PAIR_CAR(v) = car;
PAIR_CDR(v) = cdr;
return v;
}
qse_scm_ent_t* qse_scm_makenument (qse_scm_t* scm, qse_long_t val)
{
qse_scm_ent_t* v;
if (CAN_BE_SMALLINT(scm,val)) return TO_SMALLINT(scm,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;
}
qse_scm_ent_t* qse_scm_makerealent (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;
}
qse_scm_ent_t* qse_scm_makestrent (
qse_scm_t* scm, const qse_char_t* str, qse_size_t len)
{
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_STR;
ATOM(v) = 1;
/* TODO: allocate a string from internal managed region .
Calling strdup is not an option as it is not managed...
*/
STR_PTR(v) = qse_strxdup (str, len, QSE_MMGR(scm));
if (STR_PTR(v) == QSE_NULL)
{
qse_scm_seterror (scm, QSE_SCM_ENOMEM, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
STR_LEN(v) = len;
return v;
}
qse_scm_ent_t* qse_scm_makenamentity (qse_scm_t* scm, const qse_char_t* str)
{
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_NAM;
ATOM(v) = 1;
/* TODO: allocate a string from internal managed region .
Calling strdup is not an option as it is not managed...
*/
LAB_PTR(v) = qse_strdup (str, QSE_MMGR(scm));
if (LAB_PTR(v) == QSE_NULL)
{
qse_scm_seterror (scm, QSE_SCM_ENOMEM, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
LAB_UPTR(v) = QSE_NULL;
return v;
}
qse_scm_ent_t* qse_scm_makesyment (qse_scm_t* scm, const qse_char_t* name)
{
qse_scm_ent_t* pair, * sym, * nam;
/* TODO: use a hash table, red-black tree to maintain symbol table
* The current linear search algo is not performance friendly...
*/
/* find if the symbol already exists by traversing the pair list
* and inspecting the symbol name pointed to by CAR of each pair.
*
* the symbol table is a list of pairs whose CAR points to a symbol
* and CDR is used for chaining.
*
* +-----+-----+
* | | |
* +-----+-----+
* car | | cdr +-----+-----+
* | +----------> | | |
* V +-----+-----+
* +--------+ car |
* | symbol | V
* +--------+ +--------+
* | symbol |
* +--------+
*/
for (pair = scm->symtab; !IS_NIL(scm,pair); pair = PAIR_CDR(pair))
{
sym = PAIR_CAR(pair);
if (qse_strcmp(name, LAB_PTR(SYM_NAME(sym))) == 0) return sym;
}
/* no existing symbol with such a name is found.
* let's create a new symbol. the first step is to create a
* string entity to contain the symbol name */
nam = qse_scm_makenamentity (scm, name);
if (nam == QSE_NULL) return QSE_NULL;
/* let's allocate the actual symbol entity that references the
* the symbol name entity created above */
sym = alloc_entity (scm, nam, QSE_NULL);
if (sym == QSE_NULL) return QSE_NULL;
TYPE(sym) = QSE_SCM_ENT_SYM;
ATOM(sym) = 0;
SYM_NAME(sym) = nam;
SYM_PROP(sym) = scm->nil; /* no properties yet */
/* chain the symbol entity to the symbol table for lookups later */
pair = qse_scm_makepairent (scm, sym, scm->symtab);
if (pair == QSE_NULL) return QSE_NULL;
scm->symtab = pair;
return sym;
}
qse_scm_ent_t* qse_scm_makesyntent (
qse_scm_t* scm, const qse_char_t* name, void* uptr)
{
qse_scm_ent_t* v;
QSE_ASSERTX (uptr != QSE_NULL, "Syntax uptr must not be null");
v = qse_scm_makesyment (scm, name);
if (v == QSE_NULL) return QSE_NULL;
SYNT(v) = 1;
SYNT_UPTR(v) = uptr;
return v;
}
qse_scm_ent_t* qse_scm_makeprocent (
qse_scm_t* scm, const qse_char_t* name, int code)
{
qse_scm_ent_t* sym, * proc, * pair;
/* A procedure entity is a built-in function that can be
* overridden by a user while a syntax entity represents a
* 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.
*
* (define tail 10) changes the meaning of eval totally.
* (tail '(1 2 3)) is not legal from now on.
*
* (define x lambda) is illegal as the lambda symbol
*
* (define lambda 10) followed by (define x lambda) lets the x symbol
* to be associated with 10 but you still can use lambda to create
* a closure as in ((lambda (x) (+ x 10)) 50)
*
* (define x tail) lets the 'x' symbol point to the eval procedure.
* (x '(1 2 3)) returns (2 3).
*
* We implement the syntax entity as a symbol itself by ORing
* the TYPE field with QSE_SCM_ENT_SYNT and setting the syntax
* code in the symbol label entity.
*
* A procedure entity is an independent entity unlike the syntax
* entity. We explicitly create a symbol entity for the procedure name
* and associate it with the procedure entity in the global environment.
* If you redefine the symbol name to be something else, you won't be
* able to reference the procedure entity with the name. Worst case,
* it may be GCed out.
*/
/* create a symbol containing the name */
sym = qse_scm_makesyment (scm, name);
if (sym == QSE_NULL) return QSE_NULL;
/* create an actual procedure value which is a number containing
* the opcode for the procedure */
proc = alloc_entity (scm, sym, QSE_NULL);
if (proc == QSE_NULL) return QSE_NULL;
TYPE(proc) = QSE_SCM_ENT_PROC;
ATOM(proc) = 1;
PROC_CODE(proc) = code;
/* create a pair containing the name symbol and the procedure value */
pair = qse_scm_makepairent (scm, sym, proc);
if (pair == QSE_NULL) return QSE_NULL;
/* link it to the global environment */
pair = qse_scm_makepairent (scm, pair, PAIR_CAR(scm->gloenv));
if (pair == QSE_NULL) return QSE_NULL;
PAIR_CAR(scm->gloenv) = pair;
return proc;
}
qse_scm_ent_t* qse_scm_makeclosent (
qse_scm_t* scm, qse_scm_ent_t* code, qse_scm_ent_t* env)
{
qse_scm_ent_t* clos;
clos = alloc_entity (scm, code, env);
if (clos == QSE_NULL) return QSE_NULL;
TYPE(clos) = QSE_SCM_ENT_CLOS;
CLOS_CODE(clos) = code;
CLOS_ENV(clos) = env;
return clos;
}

313
qse/lib/scm/print.c
View File

@ -1,313 +0,0 @@
/*
* $Id$
*
Copyright 2006-2011 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 qse_size_t long_to_str (
qse_long_t value, int radix,
const qse_char_t* prefix, qse_char_t* buf, qse_size_t size)
{
qse_long_t t, rem;
qse_size_t len, ret, i;
qse_size_t prefix_len;
prefix_len = (prefix != QSE_NULL)? qse_strlen(prefix): 0;
t = value;
if (t == 0)
{
/* zero */
if (buf == QSE_NULL)
{
/* if buf is not given,
* return the number of bytes required */
return prefix_len + 1;
}
if (size < prefix_len+1)
{
/* buffer too small */
return (qse_size_t)-1;
}
for (i = 0; i < prefix_len; i++) buf[i] = prefix[i];
buf[prefix_len] = QSE_T('0');
if (size > prefix_len+1) buf[prefix_len+1] = QSE_T('\0');
return prefix_len+1;
}
/* non-zero values */
len = prefix_len;
if (t < 0) { t = -t; len++; }
while (t > 0) { len++; t /= radix; }
if (buf == QSE_NULL)
{
/* if buf is not given, return the number of bytes required */
return len;
}
if (size < len) return (qse_size_t)-1; /* buffer too small */
if (size > len) buf[len] = QSE_T('\0');
ret = len;
t = value;
if (t < 0) t = -t;
while (t > 0)
{
rem = t % radix;
if (rem >= 10)
buf[--len] = (qse_char_t)rem + QSE_T('a') - 10;
else
buf[--len] = (qse_char_t)rem + QSE_T('0');
t /= radix;
}
if (value < 0)
{
for (i = 1; i <= prefix_len; i++)
{
buf[i] = prefix[i-1];
len--;
}
buf[--len] = QSE_T('-');
}
else
{
for (i = 0; i < prefix_len; i++) buf[i] = prefix[i];
}
return ret;
}
static QSE_INLINE int push (qse_scm_t* scm, qse_scm_ent_t* obj)
{
qse_scm_ent_t* top;
top = qse_scm_makepairent (scm, obj, scm->p.s);
if (top == QSE_NULL) return -1;
scm->p.s = top;
return 0;
}
static QSE_INLINE qse_scm_ent_t* pop (qse_scm_t* scm)
{
qse_scm_ent_t* top = scm->p.s;
scm->p.s = PAIR_CDR(scm->p.s);
return PAIR_CAR(top);
}
static QSE_INLINE int print_num (qse_scm_t* scm, qse_long_t nval)
{
qse_char_t tmp[QSE_SIZEOF(qse_long_t)*8+2];
qse_size_t len;
len = long_to_str (nval, 10, QSE_NULL, tmp, QSE_COUNTOF(tmp));
OUTPUT_STRX (scm, tmp, len);
return 0;
}
static int print_entity (qse_scm_t* scm, const qse_scm_ent_t* obj)
{
const qse_scm_ent_t* cur;
next:
if (IS_SMALLINT(scm,obj))
{
if (print_num (scm, FROM_SMALLINT(scm,obj)) <= -1) return -1;
goto done;
}
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 (print_num (scm, NUM_VALUE(obj)) <= -1) return -1;
break;
}
#if 0
case QSE_SCM_ENT_REAL:
{
qse_char_t buf[256];
scm->prm.sprintf (
scm->prm.ctx,
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:
/* Any needs for special action if SYNT(obj) is true?
* I simply treat the syntax symbol as a normal symbol
* for printing currently. */
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:
{
OUTPUT_STR (scm, QSE_T("("));
cur = obj;
do
{
/* Push what to print next on to the stack
* the variable p is */
if (push (scm, PAIR_CDR(cur)) <= -1) return -1;
obj = PAIR_CAR(cur);
/* Jump to the 'next' label so that the entity
* pointed to by 'obj' is printed. Once it
* ends, a jump back to the 'resume' label
* is made at the at of this function. */
goto next;
resume:
cur = pop (scm); /* Get back the CDR pushed */
if (IS_NIL(scm,cur))
{
/* The CDR part points to a NIL entity, which
* indicates the end of a list. break the loop */
break;
}
if (IS_SMALLINT(scm,cur) || TYPE(cur) != QSE_SCM_ENT_PAIR)
{
/* The CDR part does not point to a pair. */
OUTPUT_STR (scm, QSE_T(" . "));
/* Push NIL so that the IS_NIL(scm,p) test in
* the 'if' statement above breaks the loop
* after the jump is maded back to the 'resume'
* label. */
if (push (scm, scm->nil) <= -1) return -1;
/* Make a jump to 'next' to print the CDR part */
obj = cur;
goto next;
}
/* The CDR part points to a pair. proceed to it */
OUTPUT_STR (scm, QSE_T(" "));
}
while (1);
OUTPUT_STR (scm, QSE_T(")"));
break;
}
case QSE_SCM_ENT_PROC:
OUTPUT_STR (scm, QSE_T("#<PROC>"));
break;
case QSE_SCM_ENT_CLOS:
OUTPUT_STR (scm, QSE_T("#<CLOSURE>"));
break;
default:
QSE_ASSERTX (
0,
"Unknown entity type - buggy!!"
);
qse_scm_seterror (scm, QSE_SCM_EINTERN, QSE_NULL, QSE_NULL);
return -1;
}
done:
/* if the printing stack is not empty, we still got more to print */
if (!IS_NIL(scm,scm->p.s)) goto resume;
return 0;
}
int qse_scm_print (qse_scm_t* scm, qse_scm_ent_t* obj)
{
int n;
QSE_ASSERTX (
scm->io.fns.out != QSE_NULL,
"Specify output function before calling qse_scm_print()"
);
QSE_ASSERTX (
IS_NIL(scm,scm->p.s),
"The printing stack is not empty before printing - buggy!!"
);
scm->p.e = obj; /* remember the head of the entity to print */
n = print_entity (scm, obj); /* call the actual printing routine */
scm->p.e = scm->nil; /* reset what's remembered */
/* clear the printing stack if an error has occurred for GC not to keep
* the entities in the stack */
if (n <= -1) scm->p.s = scm->nil;
QSE_ASSERTX (
IS_NIL(scm,scm->p.s),
"The printing stack is not empty after printing - buggy!!"
);
return n;
}

912
qse/lib/scm/read.c
View File

@ -1,912 +0,0 @@
/*
* $Id$
*
Copyright 2006-2011 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"
enum list_flag_t
{
QUOTED = (1 << 0),
DOTTED = (1 << 1),
CLOSED = (1 << 2)
};
enum tok_type_t
{
TOK_END = 0,
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_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) QSE_STR_PTR(TOK_NAME(scm))
#define TOK_NAME_LEN(scm) QSE_STR_LEN(TOK_NAME(scm))
#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)
{
qse_ssize_t n;
qse_char_t c;
/* TODO: do bufferring */
scm->err.num = QSE_SCM_ENOERR;
n = scm->io.fns.in (scm, QSE_SCM_IO_READ, &scm->io.arg.in, &c, 1);
if (n <= -1)
{
if (scm->err.num == QSE_SCM_ENOERR)
qse_scm_seterror (scm, QSE_SCM_EIO, QSE_NULL, QSE_NULL);
return -1;
}
/* TODO: handle the case when a new file is included or loaded ...
* stacking of curloc is needed??? see qseawk for reference
*/
if (n == 0) scm->r.curc = QSE_CHAR_EOF;
else
{
scm->r.curc = c;
if (c == QSE_T('\n'))
{
scm->r.curloc.colm = 0;
scm->r.curloc.line++;
}
else scm->r.curloc.colm++;
}
/*qse_printf (QSE_T("[%c]\n"), scm->r.curc);*/
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)
{
int flags = 0;
TOK_CLR (scm);
/* skip a series of white spaces and comment lines */
do
{
/* skip white spaces */
while (IS_WHSPACE(scm->r.curc)) READ_CHAR (scm);
if (scm->r.curc != QSE_T(';')) break;
/* skip a comment line */
do { READ_CHAR (scm); }
while (scm->r.curc != QSE_T('\n') &&
scm->r.curc != QSE_CHAR_EOF);
}
while (1);
TOK_LOC(scm) = scm->r.curloc;
if (scm->r.curc == QSE_CHAR_EOF)
{
TOK_TYPE(scm) = TOK_END;
return 0;
}
switch (scm->r.curc)
{
case QSE_T('('):
TOK_ADD_CHAR (scm, scm->r.curc);
TOK_TYPE(scm) = TOK_LPAREN;
READ_CHAR (scm);
return 0;
case QSE_T(')'):
TOK_ADD_CHAR (scm, scm->r.curc);
TOK_TYPE(scm) = TOK_RPAREN;
READ_CHAR (scm);
return 0;
case QSE_T('.'):
TOK_ADD_CHAR (scm, scm->r.curc);
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('\''):
TOK_ADD_CHAR (scm, scm->r.curc);
TOK_TYPE(scm) = TOK_QUOTE;
READ_CHAR (scm);
return 0;
case QSE_T('`'):
TOK_ADD_CHAR (scm, scm->r.curc);
TOK_TYPE(scm) = TOK_QQUOTE;
READ_CHAR (scm);
return 0;
case QSE_T(','):
TOK_ADD_CHAR (scm, scm->r.curc);
READ_CHAR (scm);
if (scm->r.curc == QSE_T('@'))
{
TOK_TYPE(scm) = TOK_COMMAAT;
READ_CHAR (scm);
}
else TOK_TYPE(scm) = TOK_COMMA;
return 0;
case QSE_T('#'):
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 = qse_scm_makepairent (scm, obj, scm->r.s);
if (pair == QSE_NULL) return QSE_NULL;
scm->r.s = 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 (
!IS_NIL(scm,scm->r.s),
"You've called pop() more times than push()"
);
scm->r.s = PAIR_CDR(scm->r.s);
}
static QSE_INLINE qse_scm_ent_t* enter_list (qse_scm_t* scm, int flagv)
{
/* upon entering a list, it pushes three cells into a stack.
*
* rstack -------+
* V
* +---cons--+
* +------ | -------+
* car| +---------+ |cdr
* V |
* nil#1 V
* +---cons--+
* +------ | --------+
* car| +---------+ |cdr
* v |
* nil#2 V
* +---cons--+
* +------ | --------+
* car| +---------+ |cdr
* V |
* flag number V
* previous stack top
*
* nil#1 to store the first element in the list.
* 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, TO_SMALLINT(scm,flagv)) == QSE_NULL ||
push (scm, scm->nil) == QSE_NULL ||
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)
{
qse_scm_ent_t* head;
/* the stack must not be empty */
QSE_ASSERTX (
!IS_NIL(scm,scm->r.s),
"You cannot leave a list without entering it"
);
/* remember the current list head */
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 (IS_NIL(scm,scm->r.s))
{
/* the stack is empty after popping.
* it is back to the top level.
* the top level can never be quoted. */
*flagv = 0;
}
else
{
/* restore the flag for the outer returning level */
qse_scm_ent_t* flag = PAIR_CDR(PAIR_CDR(scm->r.s));
QSE_ASSERT (IS_SMALLINT(scm,PAIR_CAR(flag)));
*flagv = FROM_SMALLINT(scm,PAIR_CAR(flag));
}
/* return the head of the list being left */
return head;
}
static QSE_INLINE_ALWAYS void dot_list (qse_scm_t* scm)
{
qse_scm_ent_t* pair;
int flagv;
QSE_ASSERT (!IS_NIL(scm,scm->r.s));
/* mark the state that a dot has appeared in the list */
pair = PAIR_CDR(PAIR_CDR(scm->r.s));
flagv = FROM_SMALLINT(scm,PAIR_CAR(pair));
PAIR_CAR(pair) = TO_SMALLINT(scm,flagv|DOTTED);
}
static qse_scm_ent_t* chain_to_list (qse_scm_t* scm, qse_scm_ent_t* obj)
{
qse_scm_ent_t* cell, * head, * tail, *flag;
int flagv;
/* the stack top is the pair pointing to the list tail */
tail = scm->r.s;
QSE_ASSERT (!IS_NIL(scm,tail));
/* the pair pointing to the list head is below the tail cell
* connected via cdr. */
head = PAIR_CDR(tail);
QSE_ASSERT (!IS_NIL(scm,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(IS_SMALLINT(scm,PAIR_CAR(flag)));
flagv = (int)FROM_SMALLINT(scm,PAIR_CAR(flag));
if (flagv & CLOSED)
{
/* the list has already been closed. cannot add more items. */
qse_scm_seterror (scm, QSE_SCM_ERPAREN, QSE_NULL, &TOK_LOC(scm));
return QSE_NULL;
}
else if (flagv & DOTTED)
{
/* the list must not be empty to have reached the dotted state */
QSE_ASSERT (!IS_NIL(scm,PAIR_CAR(tail)));
/* chain the object via 'cdr' of the tail cell */
PAIR_CDR(PAIR_CAR(tail)) = obj;
/* update the flag to CLOSED so that you can have more than
* one item after the dot. */
PAIR_CAR(flag) = TO_SMALLINT(scm,flagv|CLOSED);
}
else
{
cell = qse_scm_makepairent (scm, obj, scm->nil);
if (cell == QSE_NULL) return QSE_NULL;
if (PAIR_CAR(head) == scm->nil)
{
/* the list head is not set yet. it is the first
* element added to the list. let both head and tail
* point to the new cons cell */
QSE_ASSERT (PAIR_CAR(tail) == scm->nil);
PAIR_CAR(head) = cell;
PAIR_CAR(tail) = cell;
}
else
{
/* the new cons cell is not the first element.
* append it to the list */
PAIR_CDR(PAIR_CAR(tail)) = cell;
PAIR_CAR(tail) = cell;
}
}
return obj;
}
static QSE_INLINE_ALWAYS int is_list_empty (qse_scm_t* scm)
{
/* the stack must not be empty */
QSE_ASSERTX (
!IS_NIL(scm,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(scm,PAIR_CAR(scm->r.s));
}
static int read_entity (qse_scm_t* scm)
{
/* this function read an s-expression non-recursively
* by manipulating its own stack. */
int level = 0, flagv = 0;
qse_scm_ent_t* obj;
while (1)
{
redo:
switch (TOK_TYPE(scm))
{
default:
QSE_ASSERT (!"should never happen - invalid token type");
qse_scm_seterror (scm, QSE_SCM_EINTERN, QSE_NULL, QSE_NULL);
return -1;
#if 0
case TOK_INVALID:
qse_scm_seterror (
scm, QSE_SCM_ESYNTAX,
QSE_NULL, &TOK_LOC(scm));
return -1;
#endif
case TOK_END:
qse_scm_seterror (
scm, QSE_SCM_EEND,
QSE_NULL, &TOK_LOC(scm));
return -1;
case TOK_QUOTE:
if (level >= QSE_TYPE_MAX(int))
{
/* the nesting level has become too deep */
qse_scm_seterror (
scm, QSE_SCM_ELSTDEEP,
QSE_NULL, &TOK_LOC(scm));
return -1;
}
/* enter a quoted string */
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->quote) == QSE_NULL) return -1;
/* read the next token */
READ_TOKEN (scm);
goto redo;
case TOK_LPAREN:
if (level >= QSE_TYPE_MAX(int))
{
/* the nesting level has become too deep */
qse_scm_seterror (
scm, QSE_SCM_ELSTDEEP,
QSE_NULL, &TOK_LOC(scm));
return -1;
}
/* enter a normal string */
flagv = 0;
if (enter_list (scm, flagv) == QSE_NULL) return -1;
level++;
/* read the next token */
READ_TOKEN (scm);
goto redo;
case TOK_DOT:
if (level <= 0 || is_list_empty (scm))
{
qse_scm_seterror (
scm, QSE_SCM_EDOT,
QSE_NULL, &TOK_LOC(scm));
return -1;
}
dot_list (scm);
READ_TOKEN (scm);
goto redo;
case TOK_RPAREN:
if ((flagv & QUOTED) || level <= 0)
{
/* the right parenthesis can never appear while
* 'quoted' is true. 'quoted' is set to false when
* entering a normal list. 'quoted' is set to true
* when entering a quoted list. a quoted list does
* not have an explicit right parenthesis.
* so the right parenthesis can only pair up with
* the left parenthesis for the normal list.
*
* For example, '(1 2 3 ') 5 6)
*
* this condition is triggerred when the first ) is
* met after the second quote.
*
* also it is illegal to have the right parenthesis
* with no opening(left) parenthesis, which is
* indicated by level<=0.
*/
qse_scm_seterror (
scm, QSE_SCM_ELPAREN,
QSE_NULL, &TOK_LOC(scm));
return -1;
}
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_makenument (scm, TOK_IVAL(scm));
break;
case TOK_REAL:
obj = qse_scm_makerealent (scm, TOK_RVAL(scm));
break;
case TOK_STRING:
obj = qse_scm_makestrent (
scm, TOK_NAME_PTR(scm), TOK_NAME_LEN(scm));
break;
case TOK_SYMBOL:
obj = qse_scm_makesyment (scm, TOK_NAME_PTR(scm));
break;
}
/* check if the element is read for a quoted list */
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 -1;
/* exit out of the quoted list. the quoted list can have
* one element only. */
obj = leave_list (scm, &flagv);
/* one level up toward the top */
level--;
}
/* check if we are at the top level */
if (level <= 0) break; /* yes */
/* 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 -1;
/* read the next token */
READ_TOKEN (scm);
}
/* upon exit, we must be at the top level */
QSE_ASSERT (level == 0);
scm->r.e = obj;
return 0;
}
qse_scm_ent_t* qse_scm_read (qse_scm_t* scm)
{
QSE_ASSERTX (
scm->io.fns.in != QSE_NULL,
"Specify input function before calling qse_scm_read()"
);
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;
}
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;
}

237
qse/lib/scm/scm.c
View File

@ -1,237 +0,0 @@
/*
* $Id$
*
Copyright 2006-2011 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"
QSE_IMPLEMENT_COMMON_FUNCTIONS (scm)
static int qse_scm_init (
qse_scm_t* scm,
qse_mmgr_t* mmgr,
qse_size_t mem_ubound,
qse_size_t mem_ubound_inc
);
static void qse_scm_fini (
qse_scm_t* scm
);
qse_scm_t* qse_scm_open (
qse_mmgr_t* mmgr, qse_size_t xtnsize,
qse_size_t mem_ubound, qse_size_t mem_ubound_inc)
{
qse_scm_t* scm;
if (mmgr == QSE_NULL)
{
mmgr = QSE_MMGR_GETDFL();
QSE_ASSERTX (mmgr != QSE_NULL,
"Set the memory manager with QSE_MMGR_SETDFL()");
if (mmgr == QSE_NULL) return QSE_NULL;
}
scm = (qse_scm_t*) QSE_MMGR_ALLOC (
mmgr, QSE_SIZEOF(qse_scm_t) + xtnsize
);
if (scm == QSE_NULL) return QSE_NULL;
if (qse_scm_init (scm, mmgr, mem_ubound, mem_ubound_inc) <= -1)
{
QSE_MMGR_FREE (scm->mmgr, scm);
return QSE_NULL;
}
return scm;
}
void qse_scm_close (qse_scm_t* scm)
{
qse_scm_fini (scm);
QSE_MMGR_FREE (scm->mmgr, scm);
}
static QSE_INLINE void delete_all_entity_blocks (qse_scm_t* scm)
{
while (scm->mem.ebl)
{
qse_scm_enb_t* enb = scm->mem.ebl;
scm->mem.ebl = scm->mem.ebl->next;
QSE_MMGR_FREE (scm->mmgr, ((void**)enb)[-1]);
}
}
void qse_scm_detachio (qse_scm_t* scm)
{
if (scm->io.fns.out)
{
scm->io.fns.out (scm, QSE_SCM_IO_CLOSE, &scm->io.arg.out, QSE_NULL, 0);
scm->io.fns.out = QSE_NULL;
}
if (scm->io.fns.in)
{
scm->io.fns.in (scm, QSE_SCM_IO_CLOSE, &scm->io.arg.in, QSE_NULL, 0);
scm->io.fns.in = QSE_NULL;
scm->r.curc = QSE_CHAR_EOF; /* TODO: needed??? */
}
}
int qse_scm_attachio (qse_scm_t* scm, qse_scm_io_t* io)
{
qse_scm_detachio(scm);
QSE_ASSERT (scm->io.fns.in == QSE_NULL);
QSE_ASSERT (scm->io.fns.out == QSE_NULL);
scm->err.num = QSE_SCM_ENOERR;
if (io->in (scm, QSE_SCM_IO_OPEN, &scm->io.arg.in, QSE_NULL, 0) <= -1)
{
if (scm->err.num == QSE_SCM_ENOERR)
qse_scm_seterror (scm, QSE_SCM_EIO, QSE_NULL, QSE_NULL);
return -1;
}
scm->err.num = QSE_SCM_ENOERR;
if (io->out (scm, QSE_SCM_IO_OPEN, &scm->io.arg.out, QSE_NULL, 0) <= -1)
{
if (scm->err.num == QSE_SCM_ENOERR)
qse_scm_seterror (scm, QSE_SCM_EIO, QSE_NULL, QSE_NULL);
io->in (scm, QSE_SCM_IO_CLOSE, &scm->io.arg.in, QSE_NULL, 0);
return -1;
}
scm->io.fns = *io;
scm->r.curc = QSE_CHAR_EOF;
scm->r.curloc.line = 1;
scm->r.curloc.colm = 0;
return 0;
}
#define MAKE_SYNTAX_ENTITY(scm,name,uptr) QSE_BLOCK( \
if (qse_scm_makesyntent (scm, name, uptr) == QSE_NULL) return -1; \
)
static int build_syntax_entities (qse_scm_t* scm)
{
qse_scm_ent_t* v;
v = qse_scm_makesyntent (scm, QSE_T("lambda"), qse_scm_dolambda);
if (v == QSE_NULL) return -1;
scm->lambda = v;
v = qse_scm_makesyntent (scm, QSE_T("quote"), qse_scm_doquote);
if (v == QSE_NULL) return -1;
scm->quote = v;
MAKE_SYNTAX_ENTITY (scm, QSE_T("define"), qse_scm_dodefine);
MAKE_SYNTAX_ENTITY (scm, QSE_T("begin"), qse_scm_dobegin);
MAKE_SYNTAX_ENTITY (scm, QSE_T("if"), qse_scm_doif);
return 0;
}
static qse_scm_t* qse_scm_init (
qse_scm_t* scm, qse_mmgr_t* mmgr,
qse_size_t mem_ubound, qse_size_t mem_ubound_inc)
{
static qse_scm_ent_t static_values[3] =
{
/* dswcount, mark, atom, synt, type */
/* nil */
{ 0, 1, 1, 0, QSE_SCM_ENT_NIL },
/* f */
{ 0, 1, 1, 0, QSE_SCM_ENT_T },
/* t */
{ 0, 1, 1, 0, QSE_SCM_ENT_F }
};
if (mmgr == QSE_NULL) mmgr = QSE_MMGR_GETDFL();
QSE_MEMSET (scm, 0, QSE_SIZEOF(*scm));
scm->mmgr = mmgr;
/* set the default error string function */
scm->err.str = qse_scm_dflerrstr;
/* initialize error data */
scm->err.num = QSE_SCM_ENOERR;
scm->err.msg[0] = QSE_T('\0');
/* initialize read data */
scm->r.curc = QSE_CHAR_EOF;
scm->r.curloc.line = 1;
scm->r.curloc.colm = 0;
if (qse_str_init(&scm->r.t.name, mmgr, 256) <= -1) return -1;
/* initialize common values */
scm->nil = &static_values[0];
scm->t = &static_values[1];
scm->f = &static_values[2];
scm->lambda = 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 qse_scm_makepairent()
* below. qse_scm_makepairent() calls alloc_entity() that invokes
* gc() as this is the first time. As gc() marks all the key data,
* we need to initialize these to nil. */
scm->symtab = scm->nil;
scm->gloenv = scm->nil;
scm->r.s = scm->nil;
scm->r.e = scm->nil;
scm->p.s = scm->nil;
scm->p.e = scm->nil;
scm->e.arg = scm->nil;
scm->e.dmp = scm->nil;
scm->e.cod = scm->nil;
scm->e.env = scm->nil;
/* build the global environment entity as a pair */
scm->gloenv = qse_scm_makepairent (scm, scm->nil, scm->nil);
if (scm->gloenv == QSE_NULL) goto oops;
/* update the current environment to the global environment */
scm->e.env = scm->gloenv;
if (build_syntax_entities (scm) <= -1) goto oops;
return 0;
oops:
delete_all_entity_blocks (scm);
qse_str_fini (&scm->r.t.name);
return -1;
}
static void qse_scm_fini (qse_scm_t* scm)
{
delete_all_entity_blocks (scm);
qse_str_fini (&scm->r.t.name);
}

245
qse/lib/scm/scm.h
View File

@ -1,245 +0,0 @@
/*
* $Id$
*
Copyright 2006-2011 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/>.
*/
#ifndef _QSE_LIB_SCM_SCM_H_
#define _QSE_LIB_SCM_SCM_H_
#include "../cmn/mem.h"
#include <qse/cmn/chr.h>
#include <qse/cmn/str.h>
#include <qse/scm/scm.h>
/* Note that not all these values can be ORed with each other.
* each value represents its own type except the following combinations.
*
* QSE_SCM_ENT_T
* QSE_SCM_ENT_F
* QSE_SCM_ENT_SYM
*/
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_REAL = (1 << 4),
QSE_SCM_ENT_STR = (1 << 5),
QSE_SCM_ENT_NAM = (1 << 6),
QSE_SCM_ENT_SYM = (1 << 7),
QSE_SCM_ENT_PAIR = (1 << 8),
QSE_SCM_ENT_PROC = (1 << 9),
QSE_SCM_ENT_CLOS = (1 << 10)
};
/**
* The qse_scm_ent_t type defines an entity that represents an individual
* value in scheme.
*/
struct qse_scm_ent_t
{
qse_uint32_t dswcount: 2;
qse_uint32_t mark: 1;
qse_uint32_t atom: 1;
qse_uint32_t synt: 1; /* can be set to 1 if type is QSE_SCM_ENT_SYM */
qse_uint32_t type: 27;
union
{
struct
{
qse_long_t val;
} num; /* number */
struct
{
qse_real_t val;
} real;
struct
{
/* a string doesn't need to be null-terminated
* as the length is remembered */
qse_char_t* ptr;
qse_size_t len;
} str; /* string */
struct
{
qse_char_t* ptr; /* null-terminated string */
void* uptr; /* used for syntax entities only */
} lab; /* label */
struct
{
int code;
} proc;
struct
{
qse_scm_ent_t* ent[2];
} ref;
} u;
};
#define DSWCOUNT(v) ((v)->dswcount)
#define MARK(v) ((v)->mark)
#define ATOM(v) ((v)->atom)
#define SYNT(v) ((v)->synt)
#define TYPE(v) ((v)->type)
#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)
#define LAB_UPTR(v) ((v)->u.lab.uptr)
#define SYM_NAME(v) ((v)->u.ref.ent[0])
#define SYM_PROP(v) ((v)->u.ref.ent[1])
#define SYNT_UPTR(v) LAB_UPTR(SYM_NAME(v))
#define PAIR_CAR(v) ((v)->u.ref.ent[0])
#define PAIR_CDR(v) ((v)->u.ref.ent[1])
#define PROC_CODE(v) ((v)->u.proc.code)
#define CLOS_CODE(v) ((v)->u.ref.ent[0])
#define CLOS_ENV(v) ((v)->u.ref.ent[1])
/**
* The qse_scm_enb_t type defines a value block. A value block is allocated
* when more memory is requested and is chained to existing value blocks.
*/
typedef struct qse_scm_enb_t qse_scm_enb_t;
struct qse_scm_enb_t
{
qse_scm_ent_t* ptr;
qse_size_t len;
qse_scm_enb_t* next;
};
struct qse_scm_t
{
QSE_DEFINE_COMMON_FIELDS (scm)
/** error information */
struct
{
qse_scm_errstr_t str; /**< error string getter */
qse_scm_errnum_t num; /**< stores an error number */
qse_char_t msg[128]; /**< error message holder */
qse_scm_loc_t loc; /**< location of the last error */
} err;
/** I/O functions */
struct
{
qse_scm_io_t fns;
struct
{
qse_scm_io_arg_t in;
qse_scm_io_arg_t out;
} arg;
} io;
/** data for reading */
struct
{
qse_cint_t curc;
qse_scm_loc_t curloc;
/** token */
struct
{
int type;
qse_scm_loc_t loc;
qse_long_t ival;
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;
/** data for printing */
struct
{
qse_scm_ent_t* s; /* stack for printing */
qse_scm_ent_t* e; /* top entity being printed */
} p;
/* data for evaluation */
struct
{
int (*op) (qse_scm_t*);
qse_scm_ent_t* in;
qse_scm_ent_t* out;
qse_scm_ent_t* arg; /* function arguments */
qse_scm_ent_t* env; /* current environment */
qse_scm_ent_t* cod; /* current code */
qse_scm_ent_t* dmp; /* stack register for next evaluation */
} e;
/* common values */
qse_scm_ent_t* nil;
qse_scm_ent_t* t;
qse_scm_ent_t* f;
qse_scm_ent_t* lambda;
qse_scm_ent_t* quote;
qse_scm_ent_t* gloenv; /* global environment */
qse_scm_ent_t* symtab; /* symbol table */
/* fields for entity allocation */
struct
{
qse_scm_enb_t* ebl; /* entity block list */
qse_scm_ent_t* free;
} mem;
};
#define IS_NIL(scm,ent) QSE_SCM_ENT_ISNIL(scm,ent)
#define IS_SMALLINT(scm,ent) QSE_SCM_ENT_ISSMALLINT(scm,ent)
#define FROM_SMALLINT(scm,ent) QSE_SCM_ENT_FROMSMALLINT(scm,ent)
#define TO_SMALLINT(scm,num) QSE_SCM_ENT_TOSMALLINT(scm,num)
#define CAN_BE_SMALLINT(scm,num) QSE_SCM_ENT_CANBESMALLINT(scm,num)
#ifdef __cplusplus
extern "C" {
#endif
/* eval.c */
int qse_scm_dolambda (qse_scm_t* scm);
int qse_scm_doquote (qse_scm_t* scm);
int qse_scm_dodefine (qse_scm_t* scm);
int qse_scm_dobegin (qse_scm_t* scm);
int qse_scm_doif (qse_scm_t* scm);
/* err.c */
const qse_char_t* qse_scm_dflerrstr (qse_scm_t* scm, qse_scm_errnum_t errnum);
#ifdef __cplusplus
}
#endif
#endif

2
qse/samples/Makefile.am
View File

@ -1 +1 @@
SUBDIRS = cmn awk cut sed net
SUBDIRS = cmn awk cut sed