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

implemented a non-recursive s-expression reader

Browse Source
This commit is contained in:
hyung-hwan 2010-08-18 07:15:14 +00:00
parent 1177866b26
commit c0122c72b8
43 changed files with 1326 additions and 1166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
qse/ac/au/config.guess vendored
View File

@ -1,10 +1,10 @@
#! /bin/sh
# Attempt to guess a canonical system name.
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
# Free Software Foundation, Inc.
timestamp='2009-04-27'
timestamp='2009-06-10'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@ -170,7 +170,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
arm*|i386|m68k|ns32k|sh3*|sparc|vax)
eval $set_cc_for_build
if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
| grep __ELF__ >/dev/null
| grep -q __ELF__
then
# Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
# Return netbsd for either. FIX?
@ -656,7 +656,7 @@ EOF
# => hppa64-hp-hpux11.23
if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |
grep __LP64__ >/dev/null
grep -q __LP64__
then
HP_ARCH="hppa2.0w"
else
@ -822,6 +822,9 @@ EOF
[345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
echo i${UNAME_MACHINE}-pc-mks
exit ;;
8664:Windows_NT:*)
echo x86_64-pc-mks
exit ;;
i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
# How do we know it's Interix rather than the generic POSIX subsystem?
# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
@ -882,40 +885,17 @@ EOF
m68*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
mips:Linux:*:*)
mips:Linux:*:* | mips64:Linux:*:*)
eval $set_cc_for_build
sed 's/^ //' << EOF >$dummy.c
#undef CPU
#undef mips
#undef mipsel
#undef ${UNAME_MACHINE}
#undef ${UNAME_MACHINE}el
#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
CPU=mipsel
CPU=${UNAME_MACHINE}el
#else
#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
CPU=mips
#else
CPU=
#endif
#endif
EOF
eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
/^CPU/{
s: ::g
p
}'`"
test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
;;
mips64:Linux:*:*)
eval $set_cc_for_build
sed 's/^ //' << EOF >$dummy.c
#undef CPU
#undef mips64
#undef mips64el
#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
CPU=mips64el
#else
#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
CPU=mips64
CPU=${UNAME_MACHINE}
#else
CPU=
#endif
@ -947,7 +927,7 @@ EOF
EV67) UNAME_MACHINE=alphaev67 ;;
EV68*) UNAME_MACHINE=alphaev68 ;;
esac
objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null
objdump --private-headers /bin/sh | grep -q ld.so.1
if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
exit ;;
@ -1001,14 +981,6 @@ EOF
elf32-i386)
TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"
;;
a.out-i386-linux)
echo "${UNAME_MACHINE}-pc-linux-gnuaout"
exit ;;
"")
# Either a pre-BFD a.out linker (linux-gnuoldld) or
# one that does not give us useful --help.
echo "${UNAME_MACHINE}-pc-linux-gnuoldld"
exit ;;
esac
# Determine whether the default compiler is a.out or elf
eval $set_cc_for_build
@ -1074,7 +1046,7 @@ EOF
i*86:syllable:*:*)
echo ${UNAME_MACHINE}-pc-syllable
exit ;;
i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)
i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*)
echo i386-unknown-lynxos${UNAME_RELEASE}
exit ;;
i*86:*DOS:*:*)
@ -1182,7 +1154,7 @@ EOF
rs6000:LynxOS:2.*:*)
echo rs6000-unknown-lynxos${UNAME_RELEASE}
exit ;;
PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)
PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*)
echo powerpc-unknown-lynxos${UNAME_RELEASE}
exit ;;
SM[BE]S:UNIX_SV:*:*)

15
qse/ac/au/config.sub vendored
View File

@ -1,10 +1,10 @@
#! /bin/sh
# Configuration validation subroutine script.
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
# Free Software Foundation, Inc.
timestamp='2009-04-17'
timestamp='2009-06-11'
# This file is (in principle) common to ALL GNU software.
# The presence of a machine in this file suggests that SOME GNU software
@ -153,6 +153,9 @@ case $os in
os=
basic_machine=$1
;;
-bluegene*)
os=-cnk
;;
-sim | -cisco | -oki | -wec | -winbond)
os=
basic_machine=$1
@ -467,6 +470,10 @@ case $basic_machine in
basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'`
os=-linux
;;
bluegene*)
basic_machine=powerpc-ibm
os=-cnk
;;
c90)
basic_machine=c90-cray
os=-unicos
@ -1260,7 +1267,7 @@ case $os in
# Each alternative MUST END IN A *, to match a version number.
# -sysv* is not here because it comes later, after sysvr4.
-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
| -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\
| -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
| -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
| -kopensolaris* \
| -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
@ -1613,7 +1620,7 @@ case $basic_machine in
-sunos*)
vendor=sun
;;
-aix*)
-cnk*|-aix*)
vendor=ibm
;;
-beos*)

8
qse/ac/au/ltmain.sh
View File

@ -1,6 +1,6 @@
# Generated from ltmain.m4sh.
# ltmain.sh (GNU libtool) 2.2.6
# ltmain.sh (GNU libtool) 2.2.6b
# Written by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007 2008 Free Software Foundation, Inc.
@ -65,7 +65,7 @@
# compiler: $LTCC
# compiler flags: $LTCFLAGS
# linker: $LD (gnu? $with_gnu_ld)
# $progname: (GNU libtool) 2.2.6 Debian-2.2.6a-4
# $progname: (GNU libtool) 2.2.6b Debian-2.2.6b-2ubuntu1
# automake: $automake_version
# autoconf: $autoconf_version
#
@ -73,9 +73,9 @@
PROGRAM=ltmain.sh
PACKAGE=libtool
VERSION="2.2.6 Debian-2.2.6a-4"
VERSION="2.2.6b Debian-2.2.6b-2ubuntu1"
TIMESTAMP=""
package_revision=1.3012
package_revision=1.3017
# Be Bourne compatible
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then

13
qse/ac/m4/libtool.m4 vendored
View File

@ -2445,7 +2445,7 @@ linux*oldld* | linux*aout* | linux*coff*)
;;
# This must be Linux ELF.
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
version_type=linux
need_lib_prefix=no
need_version=no
@ -3084,7 +3084,7 @@ irix5* | irix6* | nonstopux*)
;;
# This must be Linux ELF.
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
lt_cv_deplibs_check_method=pass_all
;;
@ -3705,7 +3705,7 @@ m4_if([$1], [CXX], [
;;
esac
;;
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
KCC*)
# KAI C++ Compiler
@ -3989,7 +3989,7 @@ m4_if([$1], [CXX], [
_LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
;;
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
# old Intel for x86_64 which still supported -KPIC.
ecc*)
@ -4285,6 +4285,7 @@ dnl Note also adjust exclude_expsyms for C++ above.
fi
supports_anon_versioning=no
case `$LD -v 2>&1` in
*GNU\ gold*) supports_anon_versioning=yes ;;
*\ [[01]].* | *\ 2.[[0-9]].* | *\ 2.10.*) ;; # catch versions < 2.11
*\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ...
*\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ...
@ -4376,7 +4377,7 @@ _LT_EOF
_LT_TAGVAR(archive_expsym_cmds, $1)='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
;;
gnu* | linux* | tpf* | k*bsd*-gnu)
gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu)
tmp_diet=no
if test "$host_os" = linux-dietlibc; then
case $cc_basename in
@ -5860,7 +5861,7 @@ if test "$_lt_caught_CXX_error" != yes; then
_LT_TAGVAR(inherit_rpath, $1)=yes
;;
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
KCC*)
# Kuck and Associates, Inc. (KAI) C++ Compiler

10
qse/ac/m4/ltversion.m4 vendored
View File

@ -9,15 +9,15 @@
# Generated from ltversion.in.
# serial 3012 ltversion.m4
# serial 3017 ltversion.m4
# This file is part of GNU Libtool
m4_define([LT_PACKAGE_VERSION], [2.2.6])
m4_define([LT_PACKAGE_REVISION], [1.3012])
m4_define([LT_PACKAGE_VERSION], [2.2.6b])
m4_define([LT_PACKAGE_REVISION], [1.3017])
AC_DEFUN([LTVERSION_VERSION],
[macro_version='2.2.6'
macro_revision='1.3012'
[macro_version='2.2.6b'
macro_revision='1.3017'
_LT_DECL(, macro_version, 0, [Which release of libtool.m4 was used?])
_LT_DECL(, macro_revision, 0)
])

24
qse/cmd/awk/awk.c
View File

@ -1,5 +1,5 @@
/*
* $Id: awk.c 343 2010-08-05 07:31:17Z hyunghwan.chung $
* $Id: awk.c 344 2010-08-17 13:15:14Z hyunghwan.chung $
*
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
@ -270,7 +270,7 @@ static void dprint_return (qse_awk_rtx_t* rtx, qse_awk_val_t* ret)
static void on_statement (
qse_awk_rtx_t* rtx, qse_awk_nde_t* nde, void* data)
{
dprint (L"running %d at line %d\n", (int)nde->type, (int)nde->loc.lin);
dprint (L"running %d at line %d\n", (int)nde->type, (int)nde->loc.line);
}
#endif
@ -659,11 +659,11 @@ static void print_awkerr (qse_awk_t* awk)
print_err (
QSE_T("CODE %d LINE %u COLUMN %u %s%s%s- %s\n"),
qse_awk_geterrnum(awk),
(unsigned int)loc->lin,
(unsigned int)loc->col,
((loc->fil == QSE_NULL)? QSE_T(""): QSE_T("FILE ")),
((loc->fil == QSE_NULL)? QSE_T(""): loc->fil),
((loc->fil == QSE_NULL)? QSE_T(""): QSE_T(" ")),
(unsigned int)loc->line,
(unsigned int)loc->colm,
((loc->file == QSE_NULL)? QSE_T(""): QSE_T("FILE ")),
((loc->file == QSE_NULL)? QSE_T(""): loc->file),
((loc->file == QSE_NULL)? QSE_T(""): QSE_T(" ")),
qse_awk_geterrmsg(awk)
);
}
@ -675,11 +675,11 @@ static void print_rtxerr (qse_awk_rtx_t* rtx)
print_err (
QSE_T("CODE %d LINE %u COLUMN %u %s%s%s- %s\n"),
qse_awk_rtx_geterrnum(rtx),
(unsigned int)loc->lin,
(unsigned int)loc->col,
((loc->fil == QSE_NULL)? QSE_T(""): QSE_T("FILE ")),
((loc->fil == QSE_NULL)? QSE_T(""): loc->fil),
((loc->fil == QSE_NULL)? QSE_T(""): QSE_T(" ")),
(unsigned int)loc->line,
(unsigned int)loc->colm,
((loc->file == QSE_NULL)? QSE_T(""): QSE_T("FILE ")),
((loc->file == QSE_NULL)? QSE_T(""): loc->file),
((loc->file == QSE_NULL)? QSE_T(""): QSE_T(" ")),
qse_awk_rtx_geterrmsg(rtx)
);
}

184
qse/cmd/lsp/lsp.c
View File

@ -15,118 +15,66 @@
#include <string.h>
#include <stdlib.h>
#ifdef _WIN32
#include <windows.h>
#include <tchar.h>
#endif
#if defined(_WIN32) && defined(_MSC_VER) && defined(_DEBUG)
#define _CRTDBG_MAP_ALLOC
#include <crtdbg.h>
#endif
#if defined(__linux) && defined(_DEBUG)
#include <mcheck.h>
#endif
static qse_ssize_t get_input (
int cmd, void* arg, qse_char_t* data, qse_size_t size)
qse_lsp_t* lsp, qse_lsp_io_cmd_t cmd,
qse_lsp_io_arg_t* arg, qse_char_t* data, qse_size_t size)
{
switch (cmd)
{
case QSE_LSP_IO_OPEN:
arg->handle = stdin;
return 1;
case QSE_LSP_IO_CLOSE:
return 0;
case QSE_LSP_IO_READ:
{
/*
if (qse_fgets (data, size, stdin) == QSE_NULL)
{
if (ferror(stdin)) return -1;
return 0;
}
return qse_lsp_strlen(data);
*/
qse_cint_t c;
if (size <= 0) return -1;
c = qse_fgetc (stdin);
c = qse_fgetc ((FILE*)arg->handle);
if (c == QSE_CHAR_EOF)
{
if (ferror(stdin)) return -1;
if (ferror((FILE*)arg->handle)) return -1;
return 0;
}
data[0] = c;
return 1;
}
}
return -1;
default:
return -1;
}
}
static qse_ssize_t put_output (
int cmd, void* arg, qse_char_t* data, qse_size_t size)
qse_lsp_t* lsp, qse_lsp_io_cmd_t cmd,
qse_lsp_io_arg_t* arg, qse_char_t* data, qse_size_t size)
{
switch (cmd)
{
case QSE_LSP_IO_OPEN:
arg->handle = stdout;
return 1;
case QSE_LSP_IO_CLOSE:
return 0;
case QSE_LSP_IO_WRITE:
{
int n = qse_fprintf (
stdout, QSE_T("%.*s"), size, data);
(FILE*)arg->handle, QSE_T("%.*s"), size, data);
if (n < 0) return -1;
return size;
}
default:
return -1;
}
return -1;
}
#ifdef _WIN32
typedef struct prmfns_data_t prmfns_data_t;
struct prmfns_data_t
{
HANDLE heap;
};
#endif
static void* custom_lsp_malloc (void* custom, qse_size_t n)
{
#ifdef _WIN32
return HeapAlloc (((prmfns_data_t*)custom)->heap, 0, n);
#else
return malloc (n);
#endif
}
static void* custom_lsp_realloc (void* custom, void* ptr, qse_size_t n)
{
#ifdef _WIN32
/* HeapReAlloc behaves differently from realloc */
if (ptr == NULL)
return HeapAlloc (((prmfns_data_t*)custom)->heap, 0, n);
else
return HeapReAlloc (((prmfns_data_t*)custom)->heap, 0, ptr, n);
#else
return realloc (ptr, n);
#endif
}
static void custom_lsp_free (void* custom, void* ptr)
{
#ifdef _WIN32
HeapFree (((prmfns_data_t*)custom)->heap, 0, ptr);
#else
free (ptr);
#endif
}
static int custom_lsp_sprintf (
@ -143,15 +91,6 @@ static int custom_lsp_sprintf (
return n;
}
static void custom_lsp_dprintf (void* custom, const qse_char_t* fmt, ...)
{
va_list ap;
va_start (ap, fmt);
qse_vfprintf (stderr, fmt, ap);
va_end (ap);
}
static int opt_memsize = 1000;
static int opt_meminc = 1000;
@ -222,69 +161,49 @@ int lsp_main (int argc, qse_char_t* argv[])
{
qse_lsp_t* lsp;
qse_lsp_obj_t* obj;
qse_lsp_prmfns_t prmfns;
#ifdef _WIN32
prmfns_data_t prmfns_data;
#endif
qse_lsp_prm_t prm;
if (handle_args (argc, argv) == -1) return -1;
qse_memset (&prmfns, 0, QSE_SIZEOF(prmfns));
prm.sprintf = custom_lsp_sprintf;
prm.udd = QSE_NULL;
prmfns.mmgr.alloc = custom_lsp_malloc;
prmfns.mmgr.realloc = custom_lsp_realloc;
prmfns.mmgr.free = custom_lsp_free;
#ifdef _WIN32
prmfns_data.heap = HeapCreate (0, 1000000, 1000000);
if (prmfns_data.heap == NULL)
{
qse_printf (QSE_T("Error: cannot create an lsp heap\n"));
return -1;
}
prmfns.mmgr.udd = &prmfns_data;
#else
prmfns.mmgr.udd = QSE_NULL;
#endif
prmfns.misc.sprintf = custom_lsp_sprintf;
prmfns.misc.dprintf = custom_lsp_dprintf;
prmfns.misc.udd = QSE_NULL;
lsp = qse_lsp_open (&prmfns, opt_memsize, opt_meminc);
lsp = qse_lsp_open (QSE_NULL, 0, &prm, opt_memsize, opt_meminc);
if (lsp == QSE_NULL)
{
#ifdef _WIN32
HeapDestroy (prmfns_data.heap);
#endif
qse_printf (QSE_T("Error: cannot create a lsp instance\n"));
return -1;
}
qse_printf (QSE_T("ASELSP 0.0001\n"));
qse_printf (QSE_T("QSELSP 0.0001\n"));
qse_lsp_attinput (lsp, get_input, QSE_NULL);
qse_lsp_attoutput (lsp, put_output, QSE_NULL);
{
qse_lsp_io_t io = { get_input, put_output };
qse_lsp_attachio (lsp, &io);
}
while (1)
{
qse_printf (QSE_T("ASELSP $ "));
qse_printf (QSE_T("QSELSP $ "));
qse_fflush (stdout);
qse_lsp_gc (lsp);
obj = qse_lsp_read (lsp);
if (obj == QSE_NULL)
{
int errnum;
qse_lsp_errnum_t errnum;
qse_lsp_loc_t errloc;
const qse_char_t* errmsg;
qse_lsp_geterror (lsp, &errnum, &errmsg);
qse_lsp_geterror (lsp, &errnum, &errmsg, &errloc);
if (errnum != QSE_LSP_EEND &&
errnum != QSE_LSP_EEXIT)
{
qse_printf (
QSE_T("error in read: [%d] %s\n"),
errnum, errmsg);
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 */
@ -299,44 +218,25 @@ int lsp_main (int argc, qse_char_t* argv[])
}
else
{
int errnum;
qse_lsp_errnum_t errnum;
qse_lsp_loc_t errloc;
const qse_char_t* errmsg;
qse_lsp_geterror (lsp, &errnum, &errmsg);
qse_lsp_geterror (lsp, &errnum, &errmsg, &errloc);
if (errnum == QSE_LSP_EEXIT) break;
qse_printf (
QSE_T("error in eval: [%d] %s\n"),
errnum, errmsg);
QSE_T("error in eval: [%d] %s at line %d column %d\n"),
errnum, errmsg, (int)errloc.line, (int)errloc.colm);
}
}
qse_lsp_close (lsp);
#ifdef _WIN32
HeapDestroy (prmfns_data.heap);
#endif
return 0;
}
int qse_main (int argc, qse_achar_t* argv[])
{
int n;
#if defined(__linux) && defined(_DEBUG)
mtrace ();
#endif
n = qse_runmain (argc, argv, lsp_main);
#if defined(__linux) && defined(_DEBUG)
muntrace ();
#endif
#if defined(_WIN32) && defined(_MSC_VER) && defined(_DEBUG)
_CrtDumpMemoryLeaks ();
wprintf (L"Press ENTER to quit\n");
getchar ();
#endif
return n;
return qse_runmain (argc, argv, lsp_main);
}

14
qse/cmd/sed/sed.c
View File

@ -308,13 +308,13 @@ int sed_main (int argc, qse_char_t* argv[])
if (qse_sed_comp (sed, g_script, qse_strlen(g_script)) == -1)
{
const qse_sed_loc_t* errloc = qse_sed_geterrloc(sed);
if (errloc->lin > 0 || errloc->col > 0)
if (errloc->line > 0 || errloc->colm > 0)
{
qse_fprintf (QSE_STDERR,
QSE_T("cannot compile - %s at line %lu column %lu\n"),
qse_sed_geterrmsg(sed),
(unsigned long)errloc->lin,
(unsigned long)errloc->col
(unsigned long)errloc->line,
(unsigned long)errloc->colm
);
}
else
@ -330,13 +330,13 @@ int sed_main (int argc, qse_char_t* argv[])
if (qse_sed_exec (sed, in, out) == -1)
{
const qse_sed_loc_t* errloc = qse_sed_geterrloc(sed);
if (errloc->lin > 0 || errloc->col > 0)
if (errloc->line > 0 || errloc->colm > 0)
{
qse_fprintf (QSE_STDERR,
QSE_T("cannot execute - %s at line %lu column %lu\n"),
qse_sed_geterrmsg(sed),
(unsigned long)errloc->lin,
(unsigned long)errloc->col
(unsigned long)errloc->line,
(unsigned long)errloc->colm
);
}
else
@ -359,7 +359,7 @@ oops:
return ret;
}
int qse_main (int argc, char* argv[])
int qse_main (int argc, qse_achar_t* argv[])
{
return qse_runmain (argc, argv, sed_main);
}

35
qse/configure vendored
View File

@ -5929,8 +5929,8 @@ esac
macro_version='2.2.6'
macro_revision='1.3012'
macro_version='2.2.6b'
macro_revision='1.3017'
@ -7073,7 +7073,7 @@ irix5* | irix6* | nonstopux*)
;;
# This must be Linux ELF.
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
lt_cv_deplibs_check_method=pass_all
;;
@ -10039,7 +10039,7 @@ $as_echo_n "checking for $compiler option to produce PIC... " >&6; }
lt_prog_compiler_static='-non_shared'
;;
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
# old Intel for x86_64 which still supported -KPIC.
ecc*)
@ -10512,6 +10512,7 @@ $as_echo_n "checking whether the $compiler linker ($LD) supports shared librarie
fi
supports_anon_versioning=no
case `$LD -v 2>&1` in
*GNU\ gold*) supports_anon_versioning=yes ;;
*\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11
*\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ...
*\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ...
@ -10603,7 +10604,7 @@ _LT_EOF
archive_expsym_cmds='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
;;
gnu* | linux* | tpf* | k*bsd*-gnu)
gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu)
tmp_diet=no
if test "$host_os" = linux-dietlibc; then
case $cc_basename in
@ -12065,7 +12066,7 @@ linux*oldld* | linux*aout* | linux*coff*)
;;
# This must be Linux ELF.
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
version_type=linux
need_lib_prefix=no
need_version=no
@ -12752,7 +12753,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
#line 12755 "configure"
#line 12756 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@ -12848,7 +12849,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
#line 12851 "configure"
#line 12852 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@ -13788,7 +13789,7 @@ if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi
inherit_rpath_CXX=yes
;;
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
KCC*)
# Kuck and Associates, Inc. (KAI) C++ Compiler
@ -14616,7 +14617,7 @@ $as_echo_n "checking for $compiler option to produce PIC... " >&6; }
;;
esac
;;
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
KCC*)
# KAI C++ Compiler
@ -14804,11 +14805,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:14807: $lt_compile\"" >&5)
(eval echo "\"\$as_me:14808: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
echo "$as_me:14811: \$? = $ac_status" >&5
echo "$as_me:14812: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
@ -14903,11 +14904,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:14906: $lt_compile\"" >&5)
(eval echo "\"\$as_me:14907: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
echo "$as_me:14910: \$? = $ac_status" >&5
echo "$as_me:14911: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@ -14955,11 +14956,11 @@ else
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:14958: $lt_compile\"" >&5)
(eval echo "\"\$as_me:14959: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
echo "$as_me:14962: \$? = $ac_status" >&5
echo "$as_me:14963: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
@ -15533,7 +15534,7 @@ linux*oldld* | linux*aout* | linux*coff*)
;;
# This must be Linux ELF.
linux* | k*bsd*-gnu)
linux* | k*bsd*-gnu | kopensolaris*-gnu)
version_type=linux
need_lib_prefix=no
need_version=no

26
qse/include/qse/awk/awk.h
View File

@ -1,5 +1,5 @@
/*
* $Id: awk.h 343 2010-08-05 07:31:17Z hyunghwan.chung $
* $Id: awk.h 344 2010-08-17 13:15:14Z hyunghwan.chung $
*
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
@ -119,9 +119,9 @@ typedef struct qse_awk_rtx_t qse_awk_rtx_t;
*/
struct qse_awk_loc_t
{
const qse_char_t* fil; /**< file */
qse_size_t lin; /**< line */
qse_size_t col; /**< column */
const qse_char_t* file; /**< file */
qse_size_t line; /**< line */
qse_size_t colm; /**< column */
};
typedef struct qse_awk_loc_t qse_awk_loc_t;
@ -376,10 +376,10 @@ typedef enum qse_awk_sio_cmd_t qse_awk_sio_cmd_t;
*/
struct qse_awk_sio_lxc_t
{
qse_cint_t c; /**< character */
qse_size_t lin; /**< line */
qse_size_t col; /**< column */
const qse_char_t* fil; /**< file */
qse_cint_t c; /**< character */
qse_size_t line; /**< line */
qse_size_t colm; /**< column */
const qse_char_t* file; /**< file */
};
typedef struct qse_awk_sio_lxc_t qse_awk_sio_lxc_t;
@ -396,8 +396,8 @@ struct qse_awk_sio_arg_t
qse_size_t len;
} b;
qse_size_t lin;
qse_size_t col;
qse_size_t line;
qse_size_t colm;
qse_awk_sio_lxc_t last;
struct qse_awk_sio_arg_t* next;
@ -615,9 +615,9 @@ typedef struct qse_awk_rio_t qse_awk_rio_t;
* statement.
*/
typedef void (*qse_awk_rcb_stm_t) (
qse_awk_rtx_t* rtx, /**< runtime context */
const qse_awk_nde_t* nde, /**< node */
void* udd /**< user-defined data */
qse_awk_rtx_t* rtx, /**< runtime context */
qse_awk_nde_t* nde, /**< node */
void* udd /**< user-defined data */
);
/**

10
qse/include/qse/cut/cut.h
View File

@ -62,7 +62,7 @@ typedef enum qse_cut_errnum_t qse_cut_errnum_t;
* editor with the qse_cut_seterrstr() function to customize an error string.
*/
typedef const qse_char_t* (*qse_cut_errstr_t) (
qse_cut_t* sed, /**< text cutter */
qse_cut_t* cut, /**< text cutter */
qse_cut_errnum_t num /**< an error number */
);
@ -119,8 +119,8 @@ typedef struct qse_cut_io_arg_t qse_cut_io_arg_t;
* I/O handlers to read from and write to a text stream.
*/
typedef qse_ssize_t (*qse_cut_io_fun_t) (
qse_cut_t* sed,
qse_cut_io_cmd_t cmd,
qse_cut_t* cut,
qse_cut_io_cmd_t cmd,
qse_cut_io_arg_t* arg,
qse_char_t* data,
qse_size_t count
@ -223,9 +223,9 @@ void qse_cut_seterrnum (
* message for a given error number.
*/
void qse_cut_seterrmsg (
qse_cut_t* cut, /**< text cutter */
qse_cut_t* cut, /**< text cutter */
qse_cut_errnum_t errnum, /**< error number */
const qse_char_t* errmsg /**< error message */
const qse_char_t* errmsg /**< error message */
);
/**

197
qse/include/qse/lsp/lsp.h
View File

@ -24,50 +24,78 @@
#include <qse/types.h>
#include <qse/macros.h>
/****o* LISP/LISP Interpreter
* DESCRIPTION
* The library includes a LISP interpreter that can be embedded into other
* applications or can run stand-alone.
*
* #include <qse/lsp/lsp.h>
******
/** @file
* The file provides interface to a LISP interpreter.
*/
typedef struct qse_lsp_t qse_lsp_t;
typedef struct qse_lsp_obj_t qse_lsp_obj_t;
typedef struct qse_lsp_prmfns_t qse_lsp_prmfns_t;
typedef struct qse_lsp_prm_t qse_lsp_prm_t;
typedef qse_ssize_t (*qse_lsp_io_t) (
int cmd, void* arg, qse_char_t* data, qse_size_t count);
/**
* The qse_lsp_loc_t defines a structure to store location information.
*/
struct qse_lsp_loc_t
{
const qse_char_t* file; /**< file */
qse_size_t line; /**< line */
qse_size_t colm; /**< column */
};
typedef struct qse_lsp_loc_t qse_lsp_loc_t;
typedef qse_real_t (*qse_lsp_pow_t) (
void* data, qse_real_t x, qse_real_t y);
typedef int (*qse_lsp_sprintf_t) (
void* data, qse_char_t* buf, qse_size_t size,
const qse_char_t* fmt, ...);
typedef void (*qse_lsp_dprintf_t) (void* data, const qse_char_t* fmt, ...);
struct qse_lsp_prmfns_t
struct qse_lsp_prm_t
{
qse_mmgr_t mmgr;
/* utilities */
struct
{
qse_lsp_sprintf_t sprintf;
qse_lsp_dprintf_t dprintf;
void* udd;
} misc;
qse_lsp_sprintf_t sprintf;
void* udd;
};
/* io function commands */
enum
/**
* The qse_lsp_io_cmd_t type defines I/O commands.
*/
enum qse_lsp_io_cmd_t
{
QSE_LSP_IO_OPEN = 0,
QSE_LSP_IO_CLOSE = 1,
QSE_LSP_IO_READ = 2,
QSE_LSP_IO_WRITE = 3
};
typedef enum qse_lsp_io_cmd_t qse_lsp_io_cmd_t;
/**
* The qse_lsp_io_arg_t type defines a data structure for an I/O handler.
*/
struct qse_lsp_io_arg_t
{
void* handle;
const qse_char_t* path;
};
typedef struct qse_lsp_io_arg_t qse_lsp_io_arg_t;
/**
* The qse_lsp_io_fun_t type defines an I/O handler function.
*/
typedef qse_ssize_t (*qse_lsp_io_fun_t) (
qse_lsp_t* lsp,
qse_lsp_io_cmd_t cmd,
qse_lsp_io_arg_t* arg,
qse_char_t* data,
qse_size_t count
);
/**
* The qse_lsp_io_t type defines a I/O handler set.
*/
struct qse_lsp_io_t
{
qse_lsp_io_fun_t in;
qse_lsp_io_fun_t out;
};
typedef struct qse_lsp_io_t qse_lsp_io_t;
/* option code */
enum
@ -75,8 +103,10 @@ enum
QSE_LSP_UNDEFSYMBOL = (1 << 0)
};
/* error code */
enum
/**
* The qse_lsp_errnum_t type defines error numbers.
*/
enum qse_lsp_errnum_t
{
QSE_LSP_ENOERR,
QSE_LSP_ENOMEM,
@ -89,7 +119,9 @@ enum
QSE_LSP_ENOOUTP,
QSE_LSP_EOUTPUT,
QSE_LSP_EINTERN,
QSE_LSP_ESYNTAX,
QSE_LSP_ELSTDEEP,
QSE_LSP_ERPAREN,
QSE_LSP_EARGBAD,
QSE_LSP_EARGFEW,
@ -103,47 +135,116 @@ enum
QSE_LSP_EVALBAD,
QSE_LSP_EDIVBY0
};
typedef enum qse_lsp_errnum_t qse_lsp_errnum_t;
typedef qse_lsp_obj_t* (*qse_lsp_prim_t) (qse_lsp_t* lsp, qse_lsp_obj_t* obj);
typedef const qse_char_t* (*qse_lsp_errstr_t) (
qse_lsp_t* lsp, /**< lisp */
qse_lsp_errnum_t num /**< error number */
);
typedef qse_lsp_obj_t* (*qse_lsp_prim_t) (
qse_lsp_t* lsp,
qse_lsp_obj_t* obj
);
#ifdef __cplusplus
extern "C" {
#endif
QSE_DEFINE_COMMON_FUNCTIONS (lsp)
qse_lsp_t* qse_lsp_open (
const qse_lsp_prmfns_t* prmfns,
qse_size_t mem_ubound, qse_size_t mem_ubound_inc);
qse_mmgr_t* mmgr,
qse_size_t xtnsize,
const qse_lsp_prm_t* prm,
qse_size_t mem_ubound,
qse_size_t mem_ubound_inc
);
void qse_lsp_close (qse_lsp_t* lsp);
void qse_lsp_close (
qse_lsp_t* lsp /**< lisp */
);
/**
* @function qse_lsp_setassocdata
* @brief ssociats the user-specified data with an interpreter
*/
void qse_lsp_setassocdata (qse_lsp_t* lsp, void* data);
/**
* @function qse_lsp_getassocdata
* @brief returns the user-specified data associated with an interpreter
*/
void* qse_lsp_getassocdata (qse_lsp_t* lsp);
qse_lsp_errstr_t qse_lsp_geterrstr (
qse_lsp_t* lsp /**< lisp */
);
void qse_lsp_seterrstr (
qse_lsp_t* lsp, /**< lisp */
qse_lsp_errstr_t errstr /**< an error string getter */
);
qse_lsp_errnum_t qse_lsp_geterrnum (
qse_lsp_t* lsp /**< lisp */
);
const qse_lsp_loc_t* qse_lsp_geterrloc (
qse_lsp_t* lsp /**< lisp */
);
const qse_char_t* qse_lsp_geterrmsg (
qse_lsp_t* lsp /**< lisp */
);
void qse_lsp_geterror (
qse_lsp_t* lsp, int* errnum, const qse_char_t** errmsg);
qse_lsp_t* lsp, /**< lisp */
qse_lsp_errnum_t* errnum, /**< error number */
const qse_char_t** errmsg, /**< error message */
qse_lsp_loc_t* errloc /**< error location */
);
void qse_lsp_seterrnum (
qse_lsp_t* lsp, /**< lisp */
qse_lsp_errnum_t errnum, /**< error number */
const qse_cstr_t* errarg /**< argument for formatting error message */
);
void qse_lsp_seterrmsg (
qse_lsp_t* lsp, /**< lisp */
qse_lsp_errnum_t errnum, /**< error number */
const qse_char_t* errmsg, /**< error message */
const qse_lsp_loc_t* errloc /**< error location */
);
void qse_lsp_seterror (
qse_lsp_t* lsp, int errnum,
const qse_char_t** errarg, qse_size_t argcnt);
qse_lsp_t* lsp, /**< lisp */
qse_lsp_errnum_t errnum, /**< error number */
const qse_cstr_t* errarg, /**< array of arguments for formatting
* an error message */
const qse_lsp_loc_t* errloc /**< error location */
);
int qse_lsp_attinput (qse_lsp_t* lsp, qse_lsp_io_t input, void* arg);
int qse_lsp_detinput (qse_lsp_t* lsp);
/**
* The qse_lsp_attachio() function attaches I/O handlers.
* Upon attachment, it opens input and output streams by calling
* the I/O handlers with the #QSE_LSP_IO_OPEN command.
*/
int qse_lsp_attachio (
qse_lsp_t* lsp, /**< lisp */
qse_lsp_io_t* io /**< I/O handler set */
);
int qse_lsp_attoutput (qse_lsp_t* lsp, qse_lsp_io_t output, void* arg);
int qse_lsp_detoutput (qse_lsp_t* lsp);
/**
* The qse_lsp_detachio() function detaches I/O handlers.
* It closes the streams for both input and output by calling the I/O handlers
* with the #QSE_LSP_IO_CLOSE command.
*/
void qse_lsp_detachio (
qse_lsp_t* lsp /**< lisp */
);
qse_lsp_obj_t* qse_lsp_read (qse_lsp_t* lsp);
qse_lsp_obj_t* qse_lsp_eval (qse_lsp_t* lsp, qse_lsp_obj_t* obj);
int qse_lsp_print (qse_lsp_t* lsp, const qse_lsp_obj_t* obj);
/**
* The qse_lsp_gc() function invokes the garbage collector
*/
void qse_lsp_gc (
qse_lsp_t* lsp /**< lisp */
);
int qse_lsp_addprim (
qse_lsp_t* lsp, const qse_char_t* name, qse_size_t name_len,
qse_lsp_prim_t prim, qse_size_t min_args, qse_size_t max_args);

10
qse/include/qse/sed/sed.h
View File

@ -1,5 +1,5 @@
/*
* $Id: sed.h 340 2010-08-01 13:13:38Z hyunghwan.chung $
* $Id: sed.h 344 2010-08-17 13:15:14Z hyunghwan.chung $
*
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
@ -65,8 +65,8 @@ typedef struct qse_sed_t qse_sed_t;
*/
struct qse_sed_loc_t
{
qse_size_t lin; /**< line */
qse_size_t col; /**< column */
qse_size_t line; /**< line */
qse_size_t colm; /**< column */
};
typedef struct qse_sed_loc_t qse_sed_loc_t;
@ -108,14 +108,14 @@ enum qse_sed_errnum_t
typedef enum qse_sed_errnum_t qse_sed_errnum_t;
/**
* The qse_sed_errstr_t type defines a error string getter. It should return
* The qse_sed_errstr_t type defines an error string getter. It should return
* an error formatting string for an error number requested. A new string
* should contain the same number of positional parameters (${X}) as in the
* default error formatting string. You can set a new getter into a stream
* editor with the qse_sed_seterrstr() function to customize an error string.
*/
typedef const qse_char_t* (*qse_sed_errstr_t) (
qse_sed_t* sed, /**< stream editor */
qse_sed_t* sed, /**< stream editor */
qse_sed_errnum_t num /**< an error number */
);

2
qse/lib/Makefile.am
View File

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

2
qse/lib/Makefile.in
View File

@ -228,7 +228,7 @@ target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
SUBDIRS = cmn sed awk cut lsp utl
SUBDIRS = cmn sed awk cut utl
DIST_SUBDIRS = $(SUBDIRS)
all: all-recursive

30
qse/lib/awk/awk.c
View File

@ -1,5 +1,5 @@
/*
* $Id: awk.c 328 2010-07-08 06:58:44Z hyunghwan.chung $
* $Id: awk.c 344 2010-08-17 13:15:14Z hyunghwan.chung $
*
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
@ -47,9 +47,9 @@ static int init_token (qse_mmgr_t* mmgr, qse_awk_tok_t* tok)
if (tok->name == QSE_NULL) return -1;
tok->type = 0;
tok->loc.fil = QSE_NULL;
tok->loc.lin = 0;
tok->loc.col = 0;
tok->loc.file = QSE_NULL;
tok->loc.line = 0;
tok->loc.colm = 0;
return 0;
}
@ -67,9 +67,9 @@ static void clear_token (qse_awk_tok_t* tok)
{
if (tok->name != QSE_NULL) qse_str_clear (tok->name);
tok->type = 0;
tok->loc.fil = QSE_NULL;
tok->loc.lin = 0;
tok->loc.col = 0;
tok->loc.file = QSE_NULL;
tok->loc.line = 0;
tok->loc.colm = 0;
}
qse_awk_t* qse_awk_open (qse_mmgr_t* mmgr, qse_size_t xtn, qse_awk_prm_t* prm)
@ -180,9 +180,9 @@ qse_awk_t* qse_awk_open (qse_mmgr_t* mmgr, qse_size_t xtn, qse_awk_prm_t* prm)
awk->option = QSE_AWK_CLASSIC;
awk->errinf.num = QSE_AWK_ENOERR;
awk->errinf.loc.lin = 0;
awk->errinf.loc.col = 0;
awk->errinf.loc.fil = QSE_NULL;
awk->errinf.loc.line = 0;
awk->errinf.loc.colm = 0;
awk->errinf.loc.file = QSE_NULL;
awk->errstr = qse_awk_dflerrstr;
awk->stopall = QSE_FALSE;
@ -328,13 +328,13 @@ int qse_awk_clear (qse_awk_t* awk)
*/
awk->sio.last.c = QSE_CHAR_EOF;
awk->sio.last.lin = 0;
awk->sio.last.col = 0;
awk->sio.last.fil = QSE_NULL;
awk->sio.last.line = 0;
awk->sio.last.colm = 0;
awk->sio.last.file = QSE_NULL;
awk->sio.nungots = 0;
awk->sio.arg.lin = 1;
awk->sio.arg.col = 1;
awk->sio.arg.line = 1;
awk->sio.arg.colm = 1;
awk->sio.arg.b.pos = 0;
awk->sio.arg.b.len = 0;

56
qse/lib/awk/parse.c
View File

@ -1,5 +1,5 @@
/*
* $Id: parse.c 343 2010-08-05 07:31:17Z hyunghwan.chung $
* $Id: parse.c 344 2010-08-17 13:15:14Z hyunghwan.chung $
*
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
@ -446,9 +446,9 @@ static int get_char (qse_awk_t* awk)
if (n == 0)
{
awk->sio.last.c = QSE_CHAR_EOF;
awk->sio.last.lin = awk->sio.inp->lin;
awk->sio.last.col = awk->sio.inp->col;
awk->sio.last.fil = awk->sio.inp->name;
awk->sio.last.line = awk->sio.inp->line;
awk->sio.last.colm = awk->sio.inp->colm;
awk->sio.last.file = awk->sio.inp->name;
return 0;
}
@ -463,14 +463,14 @@ static int get_char (qse_awk_t* awk)
* incrementing it line number here instead of
* updating inp->last causes the line number for
* TOK_EOF to be the same line as the last newline. */
awk->sio.inp->lin++;
awk->sio.inp->col = 1;
awk->sio.inp->line++;
awk->sio.inp->colm = 1;
}
awk->sio.inp->last.c = awk->sio.inp->b.buf[awk->sio.inp->b.pos++];
awk->sio.inp->last.lin = awk->sio.inp->lin;
awk->sio.inp->last.col = awk->sio.inp->col++;
awk->sio.inp->last.fil = awk->sio.inp->name;
awk->sio.inp->last.line = awk->sio.inp->line;
awk->sio.inp->last.colm = awk->sio.inp->colm++;
awk->sio.inp->last.file = awk->sio.inp->name;
awk->sio.last = awk->sio.inp->last;
return 0;
@ -742,8 +742,8 @@ static int begin_include (qse_awk_t* awk)
awk->sio.inp = arg;
awk->parse.depth.cur.incl++;
awk->sio.inp->lin = 1;
awk->sio.inp->col = 1;
awk->sio.inp->line = 1;
awk->sio.inp->colm = 1;
return 0;
@ -4676,8 +4676,8 @@ static qse_awk_nde_t* parse_primary_ident (
else if (awk->option & QSE_AWK_IMPLICIT)
{
if (MATCH(awk,TOK_LPAREN) &&
awk->tok.loc.lin == xloc->lin &&
awk->tok.loc.col == xloc->col + namelen)
awk->tok.loc.line == xloc->line &&
awk->tok.loc.colm == xloc->colm + namelen)
{
qse_awk_nde_t* nde;
@ -5440,9 +5440,9 @@ static int skip_comment (qse_awk_t* awk)
if (c == QSE_CHAR_EOF)
{
qse_awk_loc_t loc;
loc.lin = awk->sio.inp->lin;
loc.col = awk->sio.inp->col;
loc.fil = awk->sio.inp->name;
loc.line = awk->sio.inp->line;
loc.colm = awk->sio.inp->colm;
loc.file = awk->sio.inp->name;
SETERR_LOC (awk, QSE_AWK_ECMTNC, &loc);
return -1;
}
@ -5453,9 +5453,9 @@ static int skip_comment (qse_awk_t* awk)
if (c == QSE_CHAR_EOF)
{
qse_awk_loc_t loc;
loc.lin = awk->sio.inp->lin;
loc.col = awk->sio.inp->col;
loc.fil = awk->sio.inp->name;
loc.line = awk->sio.inp->line;
loc.colm = awk->sio.inp->colm;
loc.file = awk->sio.inp->name;
SETERR_LOC (awk, QSE_AWK_ECMTNC, &loc);
return -1;
}
@ -5593,9 +5593,9 @@ retry:
while (n >= 1);
qse_str_clear (tok->name);
tok->loc.fil = awk->sio.last.fil;
tok->loc.lin = awk->sio.last.lin;
tok->loc.col = awk->sio.last.col;
tok->loc.file = awk->sio.last.file;
tok->loc.line = awk->sio.last.line;
tok->loc.colm = awk->sio.last.colm;
c = awk->sio.last.c;
@ -5695,17 +5695,17 @@ retry:
static int get_token (qse_awk_t* awk)
{
awk->ptok.type = awk->tok.type;
awk->ptok.loc.fil = awk->tok.loc.fil;
awk->ptok.loc.lin = awk->tok.loc.lin;
awk->ptok.loc.col = awk->tok.loc.col;
awk->ptok.loc.file = awk->tok.loc.file;
awk->ptok.loc.line = awk->tok.loc.line;
awk->ptok.loc.colm = awk->tok.loc.colm;
qse_str_swap (awk->ptok.name, awk->tok.name);
if (QSE_STR_LEN(awk->ntok.name) > 0)
{
awk->tok.type = awk->ntok.type;
awk->tok.loc.fil = awk->ntok.loc.fil;
awk->tok.loc.lin = awk->ntok.loc.lin;
awk->tok.loc.col = awk->ntok.loc.col;
awk->tok.loc.file = awk->ntok.loc.file;
awk->tok.loc.line = awk->ntok.loc.line;
awk->tok.loc.colm = awk->ntok.loc.colm;
qse_str_swap (awk->tok.name, awk->ntok.name);
qse_str_clear (awk->ntok.name);

2
qse/lib/lsp/Makefile.am
View File

@ -5,6 +5,6 @@ AM_CPPFLAGS = -I$(top_srcdir)/include
lib_LTLIBRARIES = libqselsp.la
libqselsp_la_SOURCES = lsp.c err.c env.c eval.c mem.c mem.h misc.c name.c prim.c prim_compar.c prim.h prim_let.c prim_math.c prim_prog.c print.c read.c lsp.h env.h misc.h name.h obj.h
libqselsp_la_SOURCES = lsp.c err.c env.c eval.c mem.c mem.h misc.c prim.c prim_compar.c prim.h prim_let.c prim_math.c prim_prog.c print.c read.c lsp.h env.h misc.h obj.h
libqselsp_la_LDFLAGS = -L../cmn -version-info 1:0:0 -no-undefined
libqselsp_la_LIBADD = -lqsecmn

7
qse/lib/lsp/Makefile.in
View File

@ -73,8 +73,8 @@ am__installdirs = "$(DESTDIR)$(libdir)"
LTLIBRARIES = $(lib_LTLIBRARIES)
libqselsp_la_DEPENDENCIES =
am_libqselsp_la_OBJECTS = lsp.lo err.lo env.lo eval.lo mem.lo misc.lo \
name.lo prim.lo prim_compar.lo prim_let.lo prim_math.lo \
prim_prog.lo print.lo read.lo
prim.lo prim_compar.lo prim_let.lo prim_math.lo prim_prog.lo \
print.lo read.lo
libqselsp_la_OBJECTS = $(am_libqselsp_la_OBJECTS)
libqselsp_la_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
@ -239,7 +239,7 @@ top_srcdir = @top_srcdir@
AUTOMAKE_OPTIONS = nostdinc
AM_CPPFLAGS = -I$(top_srcdir)/include
lib_LTLIBRARIES = libqselsp.la
libqselsp_la_SOURCES = lsp.c err.c env.c eval.c mem.c mem.h misc.c name.c prim.c prim_compar.c prim.h prim_let.c prim_math.c prim_prog.c print.c read.c lsp.h env.h misc.h name.h obj.h
libqselsp_la_SOURCES = lsp.c err.c env.c eval.c mem.c mem.h misc.c prim.c prim_compar.c prim.h prim_let.c prim_math.c prim_prog.c print.c read.c lsp.h env.h misc.h obj.h
libqselsp_la_LDFLAGS = -L../cmn -version-info 1:0:0 -no-undefined
libqselsp_la_LIBADD = -lqsecmn
all: all-am
@ -322,7 +322,6 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lsp.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mem.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/misc.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/name.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/prim.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/prim_compar.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/prim_let.Plo@am__quote@

16
qse/lib/lsp/env.c
View File

@ -1,7 +1,21 @@
/*
* $Id: env.c 337 2008-08-20 09:17:25Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#include "lsp.h"

20
qse/lib/lsp/env.h
View File

@ -1,11 +1,25 @@
/*
* $Id: env.h 117 2008-03-03 11:20:05Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef _QSE_LSP_ENV_H_
#define _QSE_LSP_ENV_H_
#ifndef _QSE_LIB_LSP_ENV_H_
#define _QSE_LIB_LSP_ENV_H_
#ifndef _QSE_LSP_LSP_H_
#error Never include this file directly. Include <qse/lsp/lsp.h> instead

163
qse/lib/lsp/err.c
View File

@ -1,14 +1,28 @@
/*
* $Id: err.c 337 2008-08-20 09:17:25Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#include "lsp.h"
static const qse_char_t* __geterrstr (int errnum)
const qse_char_t* qse_lsp_dflerrstr (qse_lsp_t* lsp, qse_lsp_errnum_t errnum)
{
static const qse_char_t* __errstr[] =
static const qse_char_t* errstr[] =
{
QSE_T("no error"),
QSE_T("out of memory"),
@ -19,112 +33,97 @@ static const qse_char_t* __geterrstr (int errnum)
QSE_T("input"),
QSE_T("output not attached"),
QSE_T("output"),
QSE_T("internal error"),
QSE_T("syntax"),
QSE_T("list too deep"),
QSE_T("right parenthesis expected"),
QSE_T("bad arguments"),
QSE_T("too few arguments"),
QSE_T("too many arguments"),
QSE_T("undefined function '%s'"),
QSE_T("undefined function '${0}'"),
QSE_T("bad function"),
QSE_T("duplicate formal"),
QSE_T("bad symbol"),
QSE_T("undefined symbol '%s'"),
QSE_T("undefined symbol '${0}'"),
QSE_T("empty body"),
QSE_T("bad value"),
QSE_T("divide by zero")
};
if (errnum >= 0 && errnum < QSE_COUNTOF(__errstr))
{
return __errstr[errnum];
}
return (errnum >= 0 && errnum < QSE_COUNTOF(errstr))?
errstr[errnum]: QSE_T("unknown error");
}
return QSE_T("unknown error");
qse_lsp_errstr_t qse_lsp_geterrstr (qse_lsp_t* lsp)
{
return lsp->errstr;
}
void qse_lsp_seterrstr (qse_lsp_t* lsp, qse_lsp_errstr_t errstr)
{
lsp->errstr = errstr;
}
qse_lsp_errnum_t qse_lsp_geterrnum (qse_lsp_t* lsp)
{
return lsp->errnum;
}
const qse_lsp_loc_t* qse_lsp_geterrloc (qse_lsp_t* lsp)
{
return &lsp->errloc;
}
const qse_char_t* qse_lsp_geterrmsg (qse_lsp_t* lsp)
{
return (lsp->errmsg[0] == QSE_T('\0'))?
qse_lsp_geterrstr(lsp)(lsp,lsp->errnum): lsp->errmsg;
}
void qse_lsp_geterror (
qse_lsp_t* lsp, int* errnum, const qse_char_t** errmsg)
qse_lsp_t* lsp, qse_lsp_errnum_t* errnum,
const qse_char_t** errmsg, qse_lsp_loc_t* errloc)
{
if (errnum != QSE_NULL) *errnum = lsp->errnum;
if (errmsg != QSE_NULL) *errmsg = lsp->errmsg;
if (errmsg != QSE_NULL)
{
*errmsg = (lsp->errmsg[0] == QSE_T('\0'))?
qse_lsp_geterrstr(lsp)(lsp,lsp->errnum):
lsp->errmsg;
}
if (errloc != QSE_NULL) *errloc = lsp->errloc;
}
void qse_lsp_seterrnum (
qse_lsp_t* lsp, qse_lsp_errnum_t errnum, const qse_cstr_t* errarg)
{
qse_lsp_seterror (lsp, errnum, errarg, QSE_NULL);
}
void qse_lsp_seterrmsg (
qse_lsp_t* lsp, qse_lsp_errnum_t errnum,
const qse_char_t* errmsg, const qse_lsp_loc_t* errloc)
{
lsp->errnum = errnum;
qse_strxcpy (lsp->errmsg, QSE_COUNTOF(lsp->errmsg), errmsg);
if (errloc != QSE_NULL) lsp->errloc = *errloc;
else QSE_MEMSET (&lsp->errloc, 0, QSE_SIZEOF(lsp->errloc));
}
void qse_lsp_seterror (
qse_lsp_t* lsp, int errnum,
const qse_char_t** errarg, qse_size_t argcnt)
qse_lsp_t* lsp, qse_lsp_errnum_t errnum,
const qse_cstr_t* errarg, const qse_lsp_loc_t* errloc)
{
const qse_char_t* errfmt;
QSE_ASSERT (argcnt <= 5);
lsp->errnum = errnum;
errfmt = __geterrstr (errnum);
switch (argcnt)
{
case 0:
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->errmsg,
QSE_COUNTOF(lsp->errmsg),
errfmt);
return;
errfmt = qse_lsp_geterrstr(lsp)(lsp,lsp->errnum);
QSE_ASSERT (errfmt != QSE_NULL);
qse_strxfncpy (lsp->errmsg, QSE_COUNTOF(lsp->errmsg), errfmt, errarg);
case 1:
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->errmsg,
QSE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0]);
return;
case 2:
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->errmsg,
QSE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0],
errarg[1]);
return;
case 3:
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->errmsg,
QSE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0],
errarg[1],
errarg[2]);
return;
case 4:
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->errmsg,
QSE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0],
errarg[1],
errarg[2],
errarg[3]);
return;
case 5:
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->errmsg,
QSE_COUNTOF(lsp->errmsg),
errfmt,
errarg[0],
errarg[1],
errarg[2],
errarg[3],
errarg[4]);
return;
}
if (errloc != QSE_NULL) lsp->errloc = *errloc;
else QSE_MEMSET (&lsp->errloc, 0, QSE_SIZEOF(lsp->errloc));
}

76
qse/lib/lsp/eval.c
View File

@ -1,7 +1,21 @@
/*
* $Id: eval.c 337 2008-08-20 09:17:25Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#include "lsp.h"
@ -44,13 +58,12 @@ qse_lsp_obj_t* qse_lsp_eval (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
{
if (lsp->opt_undef_symbol)
{
const qse_char_t* arg[1];
qse_cstr_t errarg;
arg[0] = QSE_LSP_SYMPTR(obj);
errarg.len = QSE_LSP_SYMLEN(obj);
errarg.ptr = QSE_LSP_SYMPTR(obj);
qse_lsp_seterror (
lsp, QSE_LSP_EUNDEFSYM,
arg, QSE_COUNTOF(arg));
qse_lsp_seterror (lsp, QSE_LSP_EUNDEFSYM, &errarg, QSE_NULL);
return QSE_NULL;
}
return lsp->mem->nil;
@ -68,13 +81,13 @@ static qse_lsp_obj_t* makefn (qse_lsp_t* lsp, qse_lsp_obj_t* cdr, int is_macro)
if (cdr == lsp->mem->nil)
{
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
if (QSE_LSP_TYPE(cdr) != QSE_LSP_OBJ_CONS)
{
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
@ -83,7 +96,7 @@ static qse_lsp_obj_t* makefn (qse_lsp_t* lsp, qse_lsp_obj_t* cdr, int is_macro)
if (body == lsp->mem->nil)
{
qse_lsp_seterror (lsp, QSE_LSP_EEMPBDY, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EEMPBDY, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
@ -95,7 +108,7 @@ static qse_lsp_obj_t* makefn (qse_lsp_t* lsp, qse_lsp_obj_t* cdr, int is_macro)
if (p != lsp->mem->nil)
{
/* like in (lambda (x) (+ x 10) . 4) */
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
@ -137,13 +150,12 @@ static qse_lsp_obj_t* eval_cons (qse_lsp_t* lsp, qse_lsp_obj_t* cons)
if (func == QSE_NULL)
{
/* the symbol's function definition is void */
const qse_char_t* arg[1];
qse_cstr_t errarg;
arg[0] = QSE_LSP_SYMPTR(car);
qse_lsp_seterror (
lsp, QSE_LSP_EUNDEFFN,
arg, QSE_COUNTOF(arg));
errarg.len = QSE_LSP_SYMLEN(car);
errarg.ptr = QSE_LSP_SYMPTR(car);
qse_lsp_seterror (lsp, QSE_LSP_EUNDEFFN, &errarg, QSE_NULL);
return QSE_NULL;
}
@ -159,25 +171,23 @@ static qse_lsp_obj_t* eval_cons (qse_lsp_t* lsp, qse_lsp_obj_t* cons)
}
else
{
const qse_char_t* arg[1];
qse_cstr_t errarg;
arg[0] = QSE_LSP_SYMPTR(car);
qse_lsp_seterror (
lsp, QSE_LSP_EUNDEFFN,
arg, QSE_COUNTOF(arg));
errarg.len = QSE_LSP_SYMLEN(car);
errarg.ptr = QSE_LSP_SYMPTR(car);
qse_lsp_seterror (lsp, QSE_LSP_EUNDEFFN, &errarg, QSE_NULL);
return QSE_NULL;
}
}
else
{
const qse_char_t* arg[1];
qse_cstr_t errarg;
arg[0] = QSE_LSP_SYMPTR(car);
qse_lsp_seterror (
lsp, QSE_LSP_EUNDEFFN,
arg, QSE_COUNTOF(arg));
errarg.len = QSE_LSP_SYMLEN(car);
errarg.ptr = QSE_LSP_SYMPTR(car);
qse_lsp_seterror (lsp, QSE_LSP_EUNDEFFN, &errarg, QSE_NULL);
return QSE_NULL;
}
}
@ -204,7 +214,7 @@ static qse_lsp_obj_t* eval_cons (qse_lsp_t* lsp, qse_lsp_obj_t* cons)
}
}
qse_lsp_seterror (lsp, QSE_LSP_EBADFN, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EBADFN, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
@ -252,7 +262,7 @@ static qse_lsp_obj_t* apply (
mem->brooding_frame = frame->link;
qse_lsp_freeframe (lsp, frame);
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
@ -275,7 +285,7 @@ static qse_lsp_obj_t* apply (
mem->brooding_frame = frame->link;
qse_lsp_freeframe (lsp, frame);
qse_lsp_seterror (lsp, QSE_LSP_EDUPFML, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EDUPFML, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
@ -296,7 +306,7 @@ static qse_lsp_obj_t* apply (
mem->brooding_frame = frame->link;
qse_lsp_freeframe (lsp, frame);
qse_lsp_seterror (lsp, QSE_LSP_EARGMANY, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EARGMANY, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
else if (actual != mem->nil)
@ -304,7 +314,7 @@ static qse_lsp_obj_t* apply (
mem->brooding_frame = frame->link;
qse_lsp_freeframe (lsp, frame);
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
@ -359,19 +369,19 @@ static qse_lsp_obj_t* apply_to_prim (
}
if (obj != lsp->mem->nil)
{
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EARGBAD, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
if (count < QSE_LSP_PMINARGS(func))
{
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EARGFEW, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
if (count > QSE_LSP_PMAXARGS(func))
{
qse_lsp_seterror (lsp, QSE_LSP_EARGMANY, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EARGMANY, QSE_NULL, QSE_NULL);
return QSE_NULL;
}

202
qse/lib/lsp/lsp.c
View File

@ -1,50 +1,79 @@
/*
* $Id: lsp.c 337 2008-08-20 09:17:25Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#if defined(__BORLANDC__)
#pragma hdrstop
#define Library
#endif
#include "lsp.h"
QSE_IMPLEMENT_COMMON_FUNCTIONS (lsp)
static qse_lsp_t* qse_lsp_init (
qse_lsp_t* lsp, qse_mmgr_t* mmgr, const qse_lsp_prm_t* prm,
qse_size_t mem_ubound, qse_size_t mem_ubound_inc);
static void qse_lsp_fini (qse_lsp_t* lsp);
static int __add_builtin_prims (qse_lsp_t* lsp);
qse_lsp_t* qse_lsp_open (
const qse_lsp_prmfns_t* prmfns,
qse_mmgr_t* mmgr, qse_size_t xtnsize, const qse_lsp_prm_t* prm,
qse_size_t mem_ubound, qse_size_t mem_ubound_inc)
{
qse_lsp_t* lsp;
if (prmfns == QSE_NULL) return QSE_NULL;
if (mmgr == QSE_NULL)
{
mmgr = QSE_MMGR_GETDFL();
/*
if (prmfns->mmgr.malloc == QSE_NULL ||
prmfns->mmgr.realloc == QSE_NULL ||
prmfns->mmgr.free == QSE_NULL) return QSE_NULL;
*/
QSE_ASSERTX (mmgr != QSE_NULL,
"Set the memory manager with QSE_MMGR_SETDFL()");
if (prmfns->misc.sprintf == QSE_NULL ||
prmfns->misc.dprintf == QSE_NULL) return QSE_NULL;
if (mmgr == QSE_NULL) return QSE_NULL;
}
#if defined(_WIN32) && defined(_MSC_VER) && defined(_DEBUG)
lsp = (qse_lsp_t*) malloc (QSE_SIZEOF(qse_lsp_t));
#else
lsp = (qse_lsp_t*) prmfns->mmgr.alloc (
prmfns->mmgr.udd, QSE_SIZEOF(qse_lsp_t));
#endif
lsp = (qse_lsp_t*) QSE_MMGR_ALLOC (mmgr, QSE_SIZEOF(qse_lsp_t) + xtnsize);
if (lsp == QSE_NULL) return QSE_NULL;
/* it uses the built-in qse_lsp_memset because lsp is not
* fully initialized yet */
QSE_MEMSET (lsp, 0, QSE_SIZEOF(qse_lsp_t));
QSE_MEMCPY (&lsp->prmfns, prmfns, QSE_SIZEOF(lsp->prmfns));
lsp->assoc_data = QSE_NULL;
if (qse_lsp_init (lsp, mmgr, prm, mem_ubound, mem_ubound_inc) == QSE_NULL)
{
QSE_MMGR_FREE (lsp->mmgr, lsp);
return QSE_NULL;
}
if (qse_lsp_name_open(&lsp->token.name, 0, lsp) == QSE_NULL)
return lsp;
}
void qse_lsp_close (qse_lsp_t* lsp)
{
qse_lsp_fini (lsp);
QSE_LSP_FREE (lsp, lsp);
}
static qse_lsp_t* qse_lsp_init (
qse_lsp_t* lsp, qse_mmgr_t* mmgr, const qse_lsp_prm_t* prm,
qse_size_t mem_ubound, qse_size_t mem_ubound_inc)
{
QSE_MEMSET (lsp, 0, QSE_SIZEOF(*lsp));
lsp->mmgr = mmgr;
lsp->errstr = qse_lsp_dflerrstr;
lsp->prm = *prm;
if (qse_str_init(&lsp->token.name, mmgr, 256) == QSE_NULL)
{
QSE_LSP_FREE (lsp, lsp);
return QSE_NULL;
@ -56,15 +85,13 @@ qse_lsp_t* qse_lsp_open (
/*lsp->opt_undef_symbol = 0;*/
lsp->curc = QSE_CHAR_EOF;
lsp->input_func = QSE_NULL;
lsp->output_func = QSE_NULL;
lsp->input_arg = QSE_NULL;
lsp->output_arg = QSE_NULL;
lsp->curloc.line = 1;
lsp->curloc.colm = 0;
lsp->mem = qse_lsp_openmem (lsp, mem_ubound, mem_ubound_inc);
if (lsp->mem == QSE_NULL)
{
qse_lsp_name_close (&lsp->token.name);
qse_str_fini (&lsp->token.name);
QSE_LSP_FREE (lsp, lsp);
return QSE_NULL;
}
@ -72,7 +99,7 @@ qse_lsp_t* qse_lsp_open (
if (__add_builtin_prims(lsp) == -1)
{
qse_lsp_closemem (lsp->mem);
qse_lsp_name_close (&lsp->token.name);
qse_str_fini (&lsp->token.name);
QSE_LSP_FREE (lsp, lsp);
return QSE_NULL;
}
@ -83,88 +110,51 @@ qse_lsp_t* qse_lsp_open (
return lsp;
}
void qse_lsp_close (qse_lsp_t* lsp)
static void qse_lsp_fini (qse_lsp_t* lsp)
{
qse_lsp_closemem (lsp->mem);
qse_lsp_name_close (&lsp->token.name);
QSE_LSP_FREE (lsp, lsp);
qse_str_fini (&lsp->token.name);
}
void qse_lsp_setassocdata (qse_lsp_t* lsp, void* data)
void qse_lsp_detachio (qse_lsp_t* lsp)
{
lsp->assoc_data = data;
}
void* qse_lsp_getassocdata (qse_lsp_t* lsp)
{
return lsp->assoc_data;
}
int qse_lsp_attinput (qse_lsp_t* lsp, qse_lsp_io_t input, void* arg)
{
if (qse_lsp_detinput(lsp) == -1) return -1;
QSE_ASSERT (lsp->input_func == QSE_NULL);
if (input(QSE_LSP_IO_OPEN, arg, QSE_NULL, 0) == -1)
if (lsp->io.fns.out)
{
/* TODO: set error number */
lsp->io.fns.out (lsp, QSE_LSP_IO_CLOSE, &lsp->io.arg.out, QSE_NULL, 0);
lsp->io.fns.out = QSE_NULL;
}
if (lsp->io.fns.in)
{
lsp->io.fns.in (lsp, QSE_LSP_IO_CLOSE, &lsp->io.arg.in, QSE_NULL, 0);
lsp->io.fns.in = QSE_NULL;
lsp->curc = QSE_CHAR_EOF; /* TODO: needed??? */
}
}
int qse_lsp_attachio (qse_lsp_t* lsp, qse_lsp_io_t* io)
{
qse_lsp_detachio(lsp);
QSE_ASSERT (lsp->io.fns.in == QSE_NULL);
QSE_ASSERT (lsp->io.fns.out == QSE_NULL);
if (io->in (lsp, QSE_LSP_IO_OPEN, &lsp->io.arg.in, QSE_NULL, 0) <= -1)
{
/* TODO: error code if error not set... */
return -1;
}
lsp->input_func = input;
lsp->input_arg = arg;
if (io->out (lsp, QSE_LSP_IO_OPEN, &lsp->io.arg.out, QSE_NULL, 0) <= -1)
{
/* TODO: error code if error not set... */
io->in (lsp, QSE_LSP_IO_CLOSE, &lsp->io.arg.in, QSE_NULL, 0);
return -1;
}
lsp->io.fns = *io;
lsp->curc = QSE_CHAR_EOF;
return 0;
}
int qse_lsp_detinput (qse_lsp_t* lsp)
{
if (lsp->input_func != QSE_NULL)
{
if (lsp->input_func (
QSE_LSP_IO_CLOSE, lsp->input_arg, QSE_NULL, 0) == -1)
{
/* TODO: set error number */
return -1;
}
lsp->input_func = QSE_NULL;
lsp->input_arg = QSE_NULL;
lsp->curc = QSE_CHAR_EOF;
}
return 0;
}
int qse_lsp_attoutput (qse_lsp_t* lsp, qse_lsp_io_t output, void* arg)
{
if (qse_lsp_detoutput(lsp) == -1) return -1;
QSE_ASSERT (lsp->output_func == QSE_NULL);
if (output(QSE_LSP_IO_OPEN, arg, QSE_NULL, 0) == -1)
{
/* TODO: set error number */
return -1;
}
lsp->output_func = output;
lsp->output_arg = arg;
return 0;
}
int qse_lsp_detoutput (qse_lsp_t* lsp)
{
if (lsp->output_func != QSE_NULL)
{
if (lsp->output_func (
QSE_LSP_IO_CLOSE, lsp->output_arg, QSE_NULL, 0) == -1)
{
/* TODO: set error number */
return -1;
}
lsp->output_func = QSE_NULL;
lsp->output_arg = QSE_NULL;
}
lsp->curloc.line = 1;
lsp->curloc.colm = 0;
return 0;
}
@ -195,7 +185,7 @@ static int __add_builtin_prims (qse_lsp_t* lsp)
ADD_PRIM (lsp, QSE_T("setq"), 4, qse_lsp_prim_setq, 1, MAX_ARGS);
ADD_PRIM (lsp, QSE_T("quote"), 5, qse_lsp_prim_quote, 1, 1);
ADD_PRIM (lsp, QSE_T("defun"), 5, qse_lsp_prim_defun, 3, MAX_ARGS);
ADD_PRIM (lsp, QSE_T("demac"), 5, qse_lsp_prim_demac, 3, MAX_ARGS);
ADD_PRIM (lsp, QSE_T("macro"), 5, qse_lsp_prim_demac, 3, MAX_ARGS);
ADD_PRIM (lsp, QSE_T("let"), 3, qse_lsp_prim_let, 1, MAX_ARGS);
ADD_PRIM (lsp, QSE_T("let*"), 4, qse_lsp_prim_letx, 1, MAX_ARGS);
/*ADD_PRIM (lsp, QSE_T("or"), 2, qse_lsp_prim_or, 2, MAX_ARGS);*/

76
qse/lib/lsp/lsp.h
View File

@ -1,7 +1,21 @@
/*
* $Id: lsp_i.h 332 2008-08-18 11:21:48Z baconevi $
* $Id: lsp.h 332 2008-08-18 11:21:48Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef _QSE_LIB_LSP_LSP_H_
@ -17,15 +31,14 @@
#include "mem.h"
#include "misc.h"
#include "prim.h"
#include "name.h"
#ifdef _MSC_VER
#pragma warning (disable: 4996)
#endif
#define QSE_LSP_ALLOC(lsp,size) QSE_MMGR_ALLOC(&(lsp)->prmfns.mmgr,size)
#define QSE_LSP_REALLOC(lsp,ptr,size) QSE_MMGR_REALLOC(&(lsp)->prmfns.mmgr,ptr,size)
#define QSE_LSP_FREE(lsp,ptr) QSE_MMGR_FREE(&(lsp)->prmfns.mmgr,ptr)
#define QSE_LSP_ALLOC(lsp,size) QSE_MMGR_ALLOC((lsp)->mmgr,size)
#define QSE_LSP_REALLOC(lsp,ptr,size) QSE_MMGR_REALLOC((lsp)->mmgr,ptr,size)
#define QSE_LSP_FREE(lsp,ptr) QSE_MMGR_FREE((lsp)->mmgr,ptr)
#define QSE_LSP_ISUPPER(lsp,c) QSE_ISUPPER(c)
#define QSE_LSP_ISLOWER(lsp,c) QSE_ISLOWER(c)
@ -43,32 +56,42 @@
struct qse_lsp_t
{
qse_lsp_prmfns_t prmfns;
/* user-specified data */
void* assoc_data;
QSE_DEFINE_COMMON_FIELDS (lsp)
/* error */
int errnum;
qse_char_t errmsg[256];
qse_lsp_prm_t prm;
qse_lsp_errstr_t errstr; /**< error string getter */
qse_lsp_errnum_t errnum; /**< stores an error number */
qse_char_t errmsg[128]; /**< error message holder */
qse_lsp_loc_t errloc; /**< location of the last error */
/* options */
int opt_undef_symbol;
/* for read */
qse_cint_t curc;
qse_cint_t curc;
qse_lsp_loc_t curloc;
struct
{
int type;
qse_long_t ival;
qse_real_t rval;
qse_lsp_name_t name;
int type;
qse_lsp_loc_t loc;
qse_long_t ival;
qse_real_t rval;
qse_str_t name;
} token;
/* io functions */
qse_lsp_io_t input_func;
qse_lsp_io_t output_func;
void* input_arg;
void* output_arg;
/* io function */
struct
{
qse_lsp_io_t fns;
struct
{
qse_lsp_io_arg_t in;
qse_lsp_io_arg_t out;
} arg;
} io;
/* security options */
qse_size_t max_eval_depth;
@ -78,4 +101,13 @@ struct qse_lsp_t
qse_lsp_mem_t* mem;
};
#ifdef __cplusplus
extern "C" {
#endif
const qse_char_t* qse_lsp_dflerrstr (qse_lsp_t* lsp, qse_lsp_errnum_t errnum);
#ifdef __cplusplus
}
#endif
#endif

242
qse/lib/lsp/mem.c
View File

@ -1,16 +1,35 @@
/*
* $Id: mem.c 337 2008-08-20 09:17:25Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#include "lsp.h"
static qse_lsp_obj_t* makeint (qse_lsp_mem_t* mem, qse_long_t value);
static QSE_INLINE_ALWAYS void collect_garbage (qse_lsp_mem_t* mem);
static void dispose_all (qse_lsp_mem_t* mem);
qse_lsp_mem_t* qse_lsp_openmem (
qse_lsp_t* lsp, qse_size_t ubound, qse_size_t ubound_inc)
{
qse_lsp_mem_t* mem;
qse_size_t i;
int fail = 0;
/* allocate memory */
mem = (qse_lsp_mem_t*) QSE_LSP_ALLOC (lsp, QSE_SIZEOF(qse_lsp_mem_t));
@ -40,7 +59,11 @@ qse_lsp_mem_t* qse_lsp_openmem (
mem->used[i] = QSE_NULL;
mem->free[i] = QSE_NULL;
}
mem->read = QSE_NULL;
/* initialize read registers */
mem->r.obj = QSE_NULL;
mem->r.tmp = QSE_NULL;
mem->r.stack = QSE_NULL;
/* when "ubound" is too small, the garbage collection can
* be performed while making the common objects. */
@ -49,21 +72,35 @@ qse_lsp_mem_t* qse_lsp_openmem (
mem->quote = QSE_NULL;
mem->lambda = QSE_NULL;
mem->macro = QSE_NULL;
for (i = 0; i < QSE_COUNTOF(mem->num); i++) mem->num[i] = QSE_NULL;
/* initialize common object pointers */
mem->nil = qse_lsp_makenil (mem);
mem->t = qse_lsp_maketrue (mem);
mem->quote = qse_lsp_makesym (mem, QSE_T("quote"), 5);
mem->lambda = qse_lsp_makesym (mem, QSE_T("lambda"), 6);
mem->macro = qse_lsp_makesym (mem, QSE_T("macro"), 5);
mem->nil = qse_lsp_makenil (mem);
mem->t = qse_lsp_maketrue (mem);
mem->quote = qse_lsp_makesym (mem, QSE_T("quote"), 5);
mem->lambda = qse_lsp_makesym (mem, QSE_T("lambda"), 6);
mem->macro = qse_lsp_makesym (mem, QSE_T("macro"), 5);
if (mem->nil == QSE_NULL ||
mem->t == QSE_NULL ||
mem->quote == QSE_NULL ||
if (mem->nil == QSE_NULL ||
mem->t == QSE_NULL ||
mem->quote == QSE_NULL ||
mem->lambda == QSE_NULL ||
mem->macro == QSE_NULL)
mem->macro == QSE_NULL)
{
qse_lsp_dispose_all (mem);
fail = 1;
}
else
{
for (i = 0; i < QSE_COUNTOF(mem->num); i++)
{
mem->num[i] = makeint (mem, i);
if (mem->num[i] == QSE_NULL) { fail = 1; break; }
}
}
if (fail)
{
dispose_all (mem);
qse_lsp_freeframe (lsp, mem->frame);
QSE_LSP_FREE (lsp, mem);
return QSE_NULL;
@ -74,6 +111,13 @@ qse_lsp_mem_t* qse_lsp_openmem (
QSE_LSP_PERM(mem->quote) = 1;
QSE_LSP_PERM(mem->lambda) = 1;
QSE_LSP_PERM(mem->macro) = 1;
for (i = 0; i < QSE_COUNTOF(mem->num); i++)
{
QSE_LSP_PERM(mem->num[i]) = 1;
}
/* let the read stack point to nil */
mem->r.stack = mem->nil;
return mem;
}
@ -81,7 +125,7 @@ qse_lsp_mem_t* qse_lsp_openmem (
void qse_lsp_closemem (qse_lsp_mem_t* mem)
{
/* dispose of the allocated objects */
qse_lsp_dispose_all (mem);
dispose_all (mem);
/* dispose of environment frames */
qse_lsp_freeframe (mem->lsp, mem->frame);
@ -90,14 +134,11 @@ void qse_lsp_closemem (qse_lsp_mem_t* mem)
QSE_LSP_FREE (mem->lsp, mem);
}
qse_lsp_obj_t* qse_lsp_alloc (qse_lsp_mem_t* mem, int type, qse_size_t size)
static qse_lsp_obj_t* allocate (qse_lsp_mem_t* mem, int type, qse_size_t size)
{
qse_lsp_obj_t* obj;
/* TODO: remove the following line... */
qse_lsp_gc (mem);
if (mem->count >= mem->ubound) qse_lsp_gc (mem);
if (mem->count >= mem->ubound) collect_garbage (mem);
if (mem->count >= mem->ubound)
{
mem->ubound += mem->ubound_inc;
@ -107,7 +148,7 @@ qse_lsp_gc (mem);
obj = (qse_lsp_obj_t*) QSE_LSP_ALLOC (mem->lsp, size);
if (obj == QSE_NULL)
{
qse_lsp_gc (mem);
collect_garbage (mem);
obj = (qse_lsp_obj_t*) QSE_LSP_ALLOC (mem->lsp, size);
if (obj == QSE_NULL)
@ -121,7 +162,6 @@ qse_lsp_gc (mem);
QSE_LSP_SIZE(obj) = size;
QSE_LSP_MARK(obj) = 0;
QSE_LSP_PERM(obj) = 0;
QSE_LSP_LOCK(obj) = 0;
/* insert the object at the head of the used list */
QSE_LSP_LINK(obj) = mem->used[type];
@ -135,7 +175,7 @@ qse_lsp_gc (mem);
return obj;
}
void qse_lsp_dispose (
static void dispose (
qse_lsp_mem_t* mem, qse_lsp_obj_t* prev, qse_lsp_obj_t* obj)
{
QSE_ASSERT (obj != QSE_NULL);
@ -156,7 +196,7 @@ void qse_lsp_dispose (
QSE_LSP_FREE (mem->lsp, obj);
}
void qse_lsp_dispose_all (qse_lsp_mem_t* mem)
static void dispose_all (qse_lsp_mem_t* mem)
{
qse_lsp_obj_t* obj, * next;
qse_size_t i;
@ -168,96 +208,45 @@ void qse_lsp_dispose_all (qse_lsp_mem_t* mem)
while (obj != QSE_NULL)
{
next = QSE_LSP_LINK(obj);
qse_lsp_dispose (mem, QSE_NULL, obj);
dispose (mem, QSE_NULL, obj);
obj = next;
}
}
}
static void __mark_obj (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
static void mark_obj (qse_lsp_mem_t* mem, qse_lsp_obj_t* obj)
{
QSE_ASSERT (obj != QSE_NULL);
/* TODO: can it be recursive? */
/* TODO: can it be non-recursive? */
if (QSE_LSP_MARK(obj) != 0) return;
QSE_LSP_MARK(obj) = 1;
if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_CONS)
{
__mark_obj (lsp, QSE_LSP_CAR(obj));
__mark_obj (lsp, QSE_LSP_CDR(obj));
mark_obj (mem, QSE_LSP_CAR(obj));
mark_obj (mem, QSE_LSP_CDR(obj));
}
else if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_FUNC)
{
__mark_obj (lsp, QSE_LSP_FFORMAL(obj));
__mark_obj (lsp, QSE_LSP_FBODY(obj));
mark_obj (mem, QSE_LSP_FFORMAL(obj));
mark_obj (mem, QSE_LSP_FBODY(obj));
}
else if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_MACRO)
{
__mark_obj (lsp, QSE_LSP_MFORMAL(obj));
__mark_obj (lsp, QSE_LSP_MBODY(obj));
mark_obj (mem, QSE_LSP_MFORMAL(obj));
mark_obj (mem, QSE_LSP_MBODY(obj));
}
}
/*
* qse_lsp_lockobj and qse_lsp_deepunlockobj are just called by qse_lsp_read.
*/
void qse_lsp_lockobj (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
{
QSE_ASSERTX (obj != QSE_NULL,
"an object pointer should not be QSE_NULL");
if (QSE_LSP_PERM(obj) == 0) QSE_LSP_LOCK(obj)++;
}
void qse_lsp_unlockobj (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
{
QSE_ASSERTX (obj != QSE_NULL,
"an object pointer should not be QSE_NULL");
if (QSE_LSP_PERM(obj) != 0) return;
QSE_ASSERTX (QSE_LSP_LOCK(obj) > 0,
"the lock count should be greater than zero to be unlocked");
QSE_LSP_LOCK(obj)--;
}
void qse_lsp_deepunlockobj (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
{
QSE_ASSERTX (obj != QSE_NULL,
"an object pointer should not be QSE_NULL");
if (QSE_LSP_PERM(obj) == 0)
{
QSE_ASSERTX (QSE_LSP_LOCK(obj) > 0,
"the lock count should be greater than zero to be unlocked");
QSE_LSP_LOCK(obj)--;
}
if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_CONS)
{
qse_lsp_deepunlockobj (lsp, QSE_LSP_CAR(obj));
qse_lsp_deepunlockobj (lsp, QSE_LSP_CDR(obj));
}
else if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_FUNC)
{
qse_lsp_deepunlockobj (lsp, QSE_LSP_FFORMAL(obj));
qse_lsp_deepunlockobj (lsp, QSE_LSP_FBODY(obj));
}
else if (QSE_LSP_TYPE(obj) == QSE_LSP_OBJ_MACRO)
{
qse_lsp_deepunlockobj (lsp, QSE_LSP_MFORMAL(obj));
qse_lsp_deepunlockobj (lsp, QSE_LSP_MBODY(obj));
}
}
static void __mark_objs_in_use (qse_lsp_mem_t* mem)
static void mark_objs_in_use (qse_lsp_mem_t* mem)
{
qse_lsp_frame_t* frame;
qse_lsp_assoc_t* assoc;
qse_lsp_tlink_t* tlink;
/*qse_lsp_arr_t* arr;*/
/*qse_size_t i;*/
qse_size_t i;
#if 0
qse_dprint0 (QSE_T("marking environment frames\n"));
@ -269,12 +258,12 @@ static void __mark_objs_in_use (qse_lsp_mem_t* mem)
assoc = frame->assoc;
while (assoc != QSE_NULL)
{
__mark_obj (mem->lsp, assoc->name);
mark_obj (mem, assoc->name);
if (assoc->value != QSE_NULL)
__mark_obj (mem->lsp, assoc->value);
mark_obj (mem, assoc->value);
if (assoc->func != QSE_NULL)
__mark_obj (mem->lsp, assoc->func);
mark_obj (mem, assoc->func);
assoc = assoc->link;
}
@ -293,12 +282,12 @@ static void __mark_objs_in_use (qse_lsp_mem_t* mem)
assoc = frame->assoc;
while (assoc != QSE_NULL)
{
__mark_obj (mem->lsp, assoc->name);
mark_obj (mem, assoc->name);
if (assoc->value != QSE_NULL)
__mark_obj (mem->lsp, assoc->value);
mark_obj (mem, assoc->value);
if (assoc->func != QSE_NULL)
__mark_obj (mem->lsp, assoc->func);
mark_obj (mem, assoc->func);
assoc = assoc->link;
}
@ -306,28 +295,35 @@ static void __mark_objs_in_use (qse_lsp_mem_t* mem)
frame = frame->link;
}
/* qse_dprint0 (QSE_T("marking the read object\n"));*/
if (mem->read != QSE_NULL) __mark_obj (mem->lsp, mem->read);
/*qse_dprint0 (QSE_T("marking the read object\n"));*/
if (mem->r.obj) mark_obj (mem, mem->r.obj);
if (mem->r.tmp) mark_obj (mem, mem->r.tmp);
if (mem->r.stack) mark_obj (mem, mem->r.stack);
/* qse_dprint0 (QSE_T("marking the temporary objects\n"));*/
for (tlink = mem->tlink; tlink != QSE_NULL; tlink = tlink->link)
{
__mark_obj (mem->lsp, tlink->obj);
mark_obj (mem, tlink->obj);
}
#if 0
qse_dprint0 (QSE_T("marking builtin objects\n"));
#endif
/* mark common objects */
if (mem->t != QSE_NULL) __mark_obj (mem->lsp, mem->t);
if (mem->nil != QSE_NULL) __mark_obj (mem->lsp, mem->nil);
if (mem->quote != QSE_NULL) __mark_obj (mem->lsp, mem->quote);
if (mem->lambda != QSE_NULL) __mark_obj (mem->lsp, mem->lambda);
if (mem->macro != QSE_NULL) __mark_obj (mem->lsp, mem->macro);
if (mem->t) mark_obj (mem, mem->t);
if (mem->nil) mark_obj (mem, mem->nil);
if (mem->quote) mark_obj (mem, mem->quote);
if (mem->lambda) mark_obj (mem, mem->lambda);
if (mem->macro) mark_obj (mem, mem->macro);
for (i = 0; i < QSE_COUNTOF(mem->num); i++)
{
if (mem->num[i]) mark_obj (mem, mem->num[i]);
}
}
//#include <qse/cmn/stdio.h>
static void __sweep_unmarked_objs (qse_lsp_mem_t* mem)
static void sweep_unmarked_objs (qse_lsp_mem_t* mem)
{
qse_lsp_obj_t* obj, * prev, * next;
qse_size_t i;
@ -345,8 +341,7 @@ static void __sweep_unmarked_objs (qse_lsp_mem_t* mem)
{
next = QSE_LSP_LINK(obj);
if (QSE_LSP_LOCK(obj) == 0 &&
QSE_LSP_MARK(obj) == 0 &&
if (QSE_LSP_MARK(obj) == 0 &&
QSE_LSP_PERM(obj) == 0)
{
/* dispose of unused objects */
@ -362,7 +357,7 @@ qse_printf (QSE_T("disposing....%d [%s]\n"), i, QSE_LSP_STRPTR(obj));
else
qse_printf (QSE_T("disposing....%d\n"), i);
*/
qse_lsp_dispose (mem, prev, obj);
dispose (mem, prev, obj);
}
else
{
@ -376,16 +371,21 @@ qse_printf (QSE_T("disposing....%d\n"), i);
}
}
void qse_lsp_gc (qse_lsp_mem_t* mem)
static QSE_INLINE_ALWAYS void collect_garbage (qse_lsp_mem_t* mem)
{
__mark_objs_in_use (mem);
__sweep_unmarked_objs (mem);
mark_objs_in_use (mem);
sweep_unmarked_objs (mem);
}
void qse_lsp_gc (qse_lsp_t* lsp)
{
collect_garbage (lsp->mem);
}
qse_lsp_obj_t* qse_lsp_makenil (qse_lsp_mem_t* mem)
{
if (mem->nil != QSE_NULL) return mem->nil;
mem->nil = qse_lsp_alloc (
mem->nil = allocate (
mem, QSE_LSP_OBJ_NIL, QSE_SIZEOF(qse_lsp_obj_nil_t));
return mem->nil;
}
@ -393,16 +393,16 @@ qse_lsp_obj_t* qse_lsp_makenil (qse_lsp_mem_t* mem)
qse_lsp_obj_t* qse_lsp_maketrue (qse_lsp_mem_t* mem)
{
if (mem->t != QSE_NULL) return mem->t;
mem->t = qse_lsp_alloc (
mem->t = allocate (
mem, QSE_LSP_OBJ_TRUE, QSE_SIZEOF(qse_lsp_obj_true_t));
return mem->t;
}
qse_lsp_obj_t* qse_lsp_makeintobj (qse_lsp_mem_t* mem, qse_long_t value)
static qse_lsp_obj_t* makeint (qse_lsp_mem_t* mem, qse_long_t value)
{
qse_lsp_obj_t* obj;
obj = qse_lsp_alloc (mem,
obj = allocate (mem,
QSE_LSP_OBJ_INT, QSE_SIZEOF(qse_lsp_obj_int_t));
if (obj == QSE_NULL) return QSE_NULL;
@ -411,11 +411,17 @@ qse_lsp_obj_t* qse_lsp_makeintobj (qse_lsp_mem_t* mem, qse_long_t value)
return obj;
}
qse_lsp_obj_t* qse_lsp_makerealobj (qse_lsp_mem_t* mem, qse_real_t value)
qse_lsp_obj_t* qse_lsp_makeint (qse_lsp_mem_t* mem, qse_long_t value)
{
if (value >= 0 && value < QSE_COUNTOF(mem->num)) return mem->num[value];
return makeint (mem, value);
}
qse_lsp_obj_t* qse_lsp_makereal (qse_lsp_mem_t* mem, qse_real_t value)
{
qse_lsp_obj_t* obj;
obj = qse_lsp_alloc (mem,
obj = allocate (mem,
QSE_LSP_OBJ_REAL, QSE_SIZEOF(qse_lsp_obj_real_t));
if (obj == QSE_NULL) return QSE_NULL;
@ -429,6 +435,8 @@ qse_lsp_obj_t* qse_lsp_makesym (
{
qse_lsp_obj_t* obj;
/* TODO: use rbt or htb ... */
/* look for a sysmbol with the given name */
obj = mem->used[QSE_LSP_OBJ_SYM];
while (obj != QSE_NULL)
@ -442,7 +450,7 @@ qse_lsp_obj_t* qse_lsp_makesym (
}
/* no such symbol found. create a new one */
obj = qse_lsp_alloc (mem, QSE_LSP_OBJ_SYM,
obj = allocate (mem, QSE_LSP_OBJ_SYM,
QSE_SIZEOF(qse_lsp_obj_sym_t)+(len + 1)*QSE_SIZEOF(qse_char_t));
if (obj == QSE_NULL) return QSE_NULL;
@ -458,7 +466,7 @@ qse_lsp_obj_t* qse_lsp_makestr (
qse_lsp_obj_t* obj;
/* allocate memory for the string */
obj = qse_lsp_alloc (mem, QSE_LSP_OBJ_STR,
obj = allocate (mem, QSE_LSP_OBJ_STR,
QSE_SIZEOF(qse_lsp_obj_str_t)+(len + 1)*QSE_SIZEOF(qse_char_t));
if (obj == QSE_NULL) return QSE_NULL;
@ -473,7 +481,7 @@ qse_lsp_obj_t* qse_lsp_makecons (
{
qse_lsp_obj_t* obj;
obj = qse_lsp_alloc (mem,
obj = allocate (mem,
QSE_LSP_OBJ_CONS, QSE_SIZEOF(qse_lsp_obj_cons_t));
if (obj == QSE_NULL) return QSE_NULL;
@ -488,7 +496,7 @@ qse_lsp_obj_t* qse_lsp_makefunc (
{
qse_lsp_obj_t* obj;
obj = qse_lsp_alloc (mem,
obj = allocate (mem,
QSE_LSP_OBJ_FUNC, QSE_SIZEOF(qse_lsp_obj_func_t));
if (obj == QSE_NULL) return QSE_NULL;
@ -503,7 +511,7 @@ qse_lsp_obj_t* qse_lsp_makemacro (
{
qse_lsp_obj_t* obj;
obj = qse_lsp_alloc (mem,
obj = allocate (mem,
QSE_LSP_OBJ_MACRO, QSE_SIZEOF(qse_lsp_obj_macro_t));
if (obj == QSE_NULL) return QSE_NULL;
@ -518,7 +526,7 @@ qse_lsp_obj_t* qse_lsp_makeprim (qse_lsp_mem_t* mem,
{
qse_lsp_obj_t* obj;
obj = qse_lsp_alloc (
obj = allocate (
mem, QSE_LSP_OBJ_PRIM, QSE_SIZEOF(qse_lsp_obj_prim_t));
if (obj == QSE_NULL) return QSE_NULL;

46
qse/lib/lsp/mem.h
View File

@ -1,11 +1,25 @@
/*
* $Id: mem.h 117 2008-03-03 11:20:05Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef _QSE_LSP_MEM_H_
#define _QSE_LSP_MEM_H_
#ifndef _QSE_LIB_LSP_MEM_H_
#define _QSE_LIB_LSP_MEM_H_
#ifndef _QSE_LSP_LSP_H_
#error Never include this file directly. Include <qse/lsp/lsp.h> instead
@ -23,7 +37,13 @@ struct qse_lsp_mem_t
qse_size_t count; /* the number of objects currently allocated */
qse_lsp_obj_t* used[QSE_LSP_TYPE_COUNT];
qse_lsp_obj_t* free[QSE_LSP_TYPE_COUNT];
qse_lsp_obj_t* read;
struct
{
qse_lsp_obj_t* obj;
qse_lsp_obj_t* tmp; /* temporary object to protect from gc in read() */
qse_lsp_obj_t* stack;
} r;
/* commonly accessed objects */
qse_lsp_obj_t* nil; /* qse_lsp_obj_nil_t */
@ -31,6 +51,7 @@ struct qse_lsp_mem_t
qse_lsp_obj_t* quote; /* qse_lsp_obj_sym_t */
qse_lsp_obj_t* lambda; /* qse_lsp_obj_sym_t */
qse_lsp_obj_t* macro; /* qse_lsp_obj_sym_t */
qse_lsp_obj_t* num[10]; /* qse_lsp_obj_int_t */
/* run-time environment frame */
qse_lsp_frame_t* frame;
@ -52,20 +73,11 @@ qse_lsp_mem_t* qse_lsp_openmem (
qse_lsp_t* lsp, qse_size_t ubound, qse_size_t ubound_inc);
void qse_lsp_closemem (qse_lsp_mem_t* mem);
qse_lsp_obj_t* qse_lsp_alloc (qse_lsp_mem_t* mem, int type, qse_size_t size);
void qse_lsp_dispose (qse_lsp_mem_t* mem, qse_lsp_obj_t* prev, qse_lsp_obj_t* obj);
void qse_lsp_dispose_all (qse_lsp_mem_t* mem);
void qse_lsp_gc (qse_lsp_mem_t* mem);
void qse_lsp_lockobj (qse_lsp_t* lsp, qse_lsp_obj_t* obj);
void qse_lsp_unlockobj (qse_lsp_t* lsp, qse_lsp_obj_t* obj);
void qse_lsp_deepunlockobj (qse_lsp_t* lsp, qse_lsp_obj_t* obj);
/* object creation of standard types */
qse_lsp_obj_t* qse_lsp_makenil (qse_lsp_mem_t* mem);
qse_lsp_obj_t* qse_lsp_maketrue (qse_lsp_mem_t* mem);
qse_lsp_obj_t* qse_lsp_makeintobj (qse_lsp_mem_t* mem, qse_long_t value);
qse_lsp_obj_t* qse_lsp_makerealobj (qse_lsp_mem_t* mem, qse_real_t value);
qse_lsp_obj_t* qse_lsp_makenil (qse_lsp_mem_t* mem);
qse_lsp_obj_t* qse_lsp_maketrue (qse_lsp_mem_t* mem);
qse_lsp_obj_t* qse_lsp_makeint (qse_lsp_mem_t* mem, qse_long_t value);
qse_lsp_obj_t* qse_lsp_makereal (qse_lsp_mem_t* mem, qse_real_t value);
qse_lsp_obj_t* qse_lsp_makesym (
qse_lsp_mem_t* mem, const qse_char_t* str, qse_size_t len);

16
qse/lib/lsp/misc.c
View File

@ -1,7 +1,21 @@
/*
* $Id: misc.c 337 2008-08-20 09:17:25Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#include "lsp.h"

20
qse/lib/lsp/misc.h
View File

@ -1,11 +1,25 @@
/*
* $Id: misc.h 117 2008-03-03 11:20:05Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef _QSE_LSP_MISC_H_
#define _QSE_LSP_MISC_H_
#ifndef _QSE_LIB_LSP_MISC_H_
#define _QSE_LIB_LSP_MISC_H_
#ifndef _QSE_LSP_LSP_H_
#error Never include this file directly. Include <qse/lsp/lsp.h> instead

125
qse/lib/lsp/name.c
View File

@ -1,125 +0,0 @@
/*
* $Id: name.c 337 2008-08-20 09:17:25Z baconevi $
*
* {License}
*/
#include "lsp.h"
qse_lsp_name_t* qse_lsp_name_open (
qse_lsp_name_t* name, qse_size_t capa, qse_lsp_t* lsp)
{
if (capa == 0) capa = QSE_COUNTOF(name->static_buf) - 1;
if (name == QSE_NULL)
{
name = (qse_lsp_name_t*)
QSE_LSP_ALLOC (lsp, QSE_SIZEOF(qse_lsp_name_t));
if (name == QSE_NULL) return QSE_NULL;
name->__dynamic = QSE_TRUE;
}
else name->__dynamic = QSE_FALSE;
if (capa < QSE_COUNTOF(name->static_buf))
{
name->buf = name->static_buf;
}
else
{
name->buf = (qse_char_t*)
QSE_LSP_ALLOC (lsp, (capa+1)*QSE_SIZEOF(qse_char_t));
if (name->buf == QSE_NULL)
{
if (name->__dynamic) QSE_LSP_FREE (lsp, name);
return QSE_NULL;
}
}
name->size = 0;
name->capa = capa;
name->buf[0] = QSE_T('\0');
name->lsp = lsp;
return name;
}
void qse_lsp_name_close (qse_lsp_name_t* name)
{
if (name->capa >= QSE_COUNTOF(name->static_buf))
{
QSE_ASSERT (name->buf != name->static_buf);
QSE_LSP_FREE (name->lsp, name->buf);
}
if (name->__dynamic) QSE_LSP_FREE (name->lsp, name);
}
int qse_lsp_name_addc (qse_lsp_name_t* name, qse_cint_t c)
{
if (name->size >= name->capa)
{
/* double the capacity */
qse_size_t new_capa = name->capa * 2;
if (new_capa >= QSE_COUNTOF(name->static_buf))
{
qse_char_t* space;
if (name->capa < QSE_COUNTOF(name->static_buf))
{
space = (qse_char_t*) QSE_LSP_ALLOC (
name->lsp, (new_capa+1)*QSE_SIZEOF(qse_char_t));
if (space == QSE_NULL) return -1;
/* don't need to copy up to the terminating null */
QSE_MEMCPY (space, name->buf, name->capa*QSE_SIZEOF(qse_char_t));
}
else
{
space = (qse_char_t*) QSE_LSP_REALLOC (
name->lsp, name->buf,
(new_capa+1)*QSE_SIZEOF(qse_char_t));
if (space == QSE_NULL) return -1;
}
name->buf = space;
}
name->capa = new_capa;
}
name->buf[name->size++] = c;
name->buf[name->size] = QSE_T('\0');
return 0;
}
int qse_lsp_name_adds (qse_lsp_name_t* name, const qse_char_t* s)
{
while (*s != QSE_T('\0'))
{
if (qse_lsp_name_addc(name, *s) == -1) return -1;
s++;
}
return 0;
}
void qse_lsp_name_clear (qse_lsp_name_t* name)
{
name->size = 0;
name->buf[0] = QSE_T('\0');
}
int qse_lsp_name_compare (qse_lsp_name_t* name, const qse_char_t* str)
{
qse_char_t* p = name->buf;
qse_size_t index = 0;
while (index < name->size)
{
if (*p > *str) return 1;
if (*p < *str) return -1;
index++; p++; str++;
}
return (*str == QSE_T('\0'))? 0: -1;
}

42
qse/lib/lsp/name.h
View File

@ -1,42 +0,0 @@
/*
* $Id: name.h 223 2008-06-26 06:44:41Z baconevi $
*
* {License}
*/
#ifndef _QSE_LSP_NAME_H_
#define _QSE_LSP_NAME_H_
#include <qse/types.h>
#include <qse/macros.h>
struct qse_lsp_name_t
{
qse_size_t capa;
qse_size_t size;
qse_char_t* buf;
qse_char_t static_buf[128];
qse_lsp_t* lsp;
qse_bool_t __dynamic;
};
typedef struct qse_lsp_name_t qse_lsp_name_t;
#ifdef __cplusplus
extern "C" {
#endif
qse_lsp_name_t* qse_lsp_name_open (
qse_lsp_name_t* name, qse_size_t capa, qse_lsp_t* lsp);
void qse_lsp_name_close (qse_lsp_name_t* name);
int qse_lsp_name_addc (qse_lsp_name_t* name, qse_cint_t c);
int qse_lsp_name_adds (qse_lsp_name_t* name, const qse_char_t* s);
void qse_lsp_name_clear (qse_lsp_name_t* name);
int qse_lsp_name_compare (qse_lsp_name_t* name, const qse_char_t* str);
#ifdef __cplusplus
}
#endif
#endif

28
qse/lib/lsp/obj.h
View File

@ -1,11 +1,25 @@
/*
* $Id: obj.h 117 2008-03-03 11:20:05Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef _QSE_LSP_OBJ_H_
#define _QSE_LSP_OBJ_H_
#ifndef _QSE_LIB_LSP_OBJ_H_
#define _QSE_LIB_LSP_OBJ_H_
#ifndef _QSE_LSP_LSP_H_
#error Never include this file directly. Include <qse/lsp/lsp.h> instead
@ -42,10 +56,9 @@ typedef struct qse_lsp_obj_prim_t qse_lsp_obj_prim_t;
struct qse_lsp_objhdr_t
{
qse_uint32_t type: 8;
qse_uint32_t mark: 4;
qse_uint32_t perm: 4;
qse_uint32_t lock: 16;
qse_uint16_t type: 8;
qse_uint16_t mark: 4;
qse_uint16_t perm: 4;
qse_size_t size;
qse_lsp_obj_t* link;
};
@ -127,7 +140,6 @@ struct qse_lsp_obj_prim_t
#define QSE_LSP_SIZE(x) (((qse_lsp_obj_t*)x)->hdr.size)
#define QSE_LSP_MARK(x) (((qse_lsp_obj_t*)x)->hdr.mark)
#define QSE_LSP_PERM(x) (((qse_lsp_obj_t*)x)->hdr.perm)
#define QSE_LSP_LOCK(x) (((qse_lsp_obj_t*)x)->hdr.lock)
#define QSE_LSP_LINK(x) (((qse_lsp_obj_t*)x)->hdr.link)
/* value access */

2
qse/lib/lsp/prim.c
View File

@ -422,7 +422,7 @@ qse_lsp_obj_t* qse_lsp_prim_length (qse_lsp_t* lsp, qse_lsp_obj_t* args)
}
QSE_ASSERT (body == lsp->mem->nil);
return qse_lsp_makeintobj (lsp->mem, len);
return qse_lsp_makeint (lsp->mem, len);
}
qse_lsp_obj_t* qse_lsp_prim_set (qse_lsp_t* lsp, qse_lsp_obj_t* args)

20
qse/lib/lsp/prim.h
View File

@ -1,11 +1,25 @@
/*
* $Id: prim.h 117 2008-03-03 11:20:05Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#ifndef _QSE_LSP_PRIM_H_
#define _QSE_LSP_PRIM_H_
#ifndef _QSE_LIB_LSP_PRIM_H_
#define _QSE_LIB_LSP_PRIM_H_
#ifndef _QSE_LSP_LSP_H_
#error Never include this file directly. Include <qse/lsp/lsp.h> instead

18
qse/lib/lsp/prim_math.c
View File

@ -67,8 +67,8 @@ qse_lsp_obj_t* qse_lsp_prim_plus (qse_lsp_t* lsp, qse_lsp_obj_t* args)
QSE_ASSERT (body == lsp->mem->nil);
tmp = (realnum)?
qse_lsp_makerealobj (lsp->mem, rval):
qse_lsp_makeintobj (lsp->mem, ival);
qse_lsp_makereal (lsp->mem, rval):
qse_lsp_makeint (lsp->mem, ival);
if (tmp == QSE_NULL) return QSE_NULL;
return tmp;
@ -136,8 +136,8 @@ qse_lsp_obj_t* qse_lsp_prim_minus (qse_lsp_t* lsp, qse_lsp_obj_t* args)
QSE_ASSERT (body == lsp->mem->nil);
tmp = (realnum)?
qse_lsp_makerealobj (lsp->mem, rval):
qse_lsp_makeintobj (lsp->mem, ival);
qse_lsp_makereal (lsp->mem, rval):
qse_lsp_makeint (lsp->mem, ival);
if (tmp == QSE_NULL) return QSE_NULL;
return tmp;
@ -204,8 +204,8 @@ qse_lsp_obj_t* qse_lsp_prim_mul (qse_lsp_t* lsp, qse_lsp_obj_t* args)
QSE_ASSERT (body == lsp->mem->nil);
tmp = (realnum)?
qse_lsp_makerealobj (lsp->mem, rval):
qse_lsp_makeintobj (lsp->mem, ival);
qse_lsp_makereal (lsp->mem, rval):
qse_lsp_makeint (lsp->mem, ival);
if (tmp == QSE_NULL) return QSE_NULL;
return tmp;
@ -279,8 +279,8 @@ qse_lsp_obj_t* qse_lsp_prim_div (qse_lsp_t* lsp, qse_lsp_obj_t* args)
QSE_ASSERT (body == lsp->mem->nil);
tmp = (realnum)?
qse_lsp_makerealobj (lsp->mem, rval):
qse_lsp_makeintobj (lsp->mem, ival);
qse_lsp_makereal (lsp->mem, rval):
qse_lsp_makeint (lsp->mem, ival);
if (tmp == QSE_NULL) return QSE_NULL;
return tmp;
@ -344,7 +344,7 @@ qse_lsp_obj_t* qse_lsp_prim_mod (qse_lsp_t* lsp, qse_lsp_obj_t* args)
QSE_ASSERT (body == lsp->mem->nil);
tmp = qse_lsp_makeintobj (lsp->mem, ival);
tmp = qse_lsp_makeint (lsp->mem, ival);
if (tmp == QSE_NULL) return QSE_NULL;
return tmp;

30
qse/lib/lsp/print.c
View File

@ -8,7 +8,7 @@
#define OUTPUT_STR(lsp,str) \
do { \
if (lsp->output_func(QSE_LSP_IO_WRITE, lsp->output_arg, (qse_char_t*)str, qse_strlen(str)) == -1) { \
if (lsp->io.fns.out(lsp, QSE_LSP_IO_WRITE, &lsp->io.arg.out, (qse_char_t*)str, qse_strlen(str)) == -1) { \
qse_lsp_seterror (lsp, QSE_LSP_EOUTPUT, QSE_NULL, 0); \
return -1; \
} \
@ -16,7 +16,7 @@
#define OUTPUT_STRX(lsp,str,len) \
do { \
if (lsp->output_func(QSE_LSP_IO_WRITE, lsp->output_arg, (qse_char_t*)str, len) == -1) { \
if (lsp->io.fns.out(lsp, QSE_LSP_IO_WRITE, &lsp->io.arg.out, (qse_char_t*)str, qse_strlen(str)) == -1) { \
qse_lsp_seterror (lsp, QSE_LSP_EOUTPUT, QSE_NULL, 0); \
return -1; \
} \
@ -26,7 +26,7 @@ static int __print (qse_lsp_t* lsp, const qse_lsp_obj_t* obj, qse_bool_t prt_con
{
qse_char_t buf[256];
if (lsp->output_func == QSE_NULL)
if (lsp->io.fns.out == QSE_NULL)
{
qse_lsp_seterror (lsp, QSE_LSP_ENOOUTP, QSE_NULL, 0);
return -1;
@ -44,23 +44,23 @@ static int __print (qse_lsp_t* lsp, const qse_lsp_obj_t* obj, qse_bool_t prt_con
case QSE_LSP_OBJ_INT:
#if QSE_SIZEOF_LONG_LONG > 0
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->prm.sprintf (
lsp->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%lld"), (long long)QSE_LSP_IVAL(obj));
#elif QSE_SIZEOF___INT64 > 0
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->prm.sprintf (
lsp->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%I64d"), (__int64)QSE_LSP_IVAL(obj));
#elif QSE_SIZEOF_LONG > 0
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->prm.sprintf (
lsp->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%ld"), (long)QSE_LSP_IVAL(obj));
#elif QSE_SIZEOF_INT > 0
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->prm.sprintf (
lsp->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%d"), (int)QSE_LSP_IVAL(obj));
#else
@ -70,8 +70,8 @@ static int __print (qse_lsp_t* lsp, const qse_lsp_obj_t* obj, qse_bool_t prt_con
break;
case QSE_LSP_OBJ_REAL:
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->prm.sprintf (
lsp->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("%Lf"),
#ifdef __MINGW32__
@ -140,8 +140,8 @@ static int __print (qse_lsp_t* lsp, const qse_lsp_obj_t* obj, qse_bool_t prt_con
break;
default:
lsp->prmfns.misc.sprintf (
lsp->prmfns.misc.udd,
lsp->prm.sprintf (
lsp->prm.udd,
buf, QSE_COUNTOF(buf),
QSE_T("unknown object type: %d"), QSE_LSP_TYPE(obj));
OUTPUT_STR (lsp, buf);

616
qse/lib/lsp/read.c
View File

@ -1,49 +1,70 @@
/*
* $Id: read.c 337 2008-08-20 09:17:25Z baconevi $
*
* {License}
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
QSE is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
QSE is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with QSE. If not, see <http://www.gnu.org/licenses/>.
*/
#include "lsp.h"
#define IS_IDENT(c) \
((c) == QSE_T('+') || (c) == QSE_T('-') || \
(c) == QSE_T('*') || (c) == QSE_T('/') || \
(c) == QSE_T('%') || (c) == QSE_T('&') || \
(c) == QSE_T('<') || (c) == QSE_T('>') || \
(c) == QSE_T('=') || (c) == QSE_T('_') || \
(c) == QSE_T('?'))
enum list_flag_t
{
QUOTED = (1 << 0),
DOTTED = (1 << 1),
CLOSED = (1 << 2)
};
#define TOKEN_CLEAR(lsp) qse_lsp_name_clear (&(lsp)->token.name)
enum token_type_t
{
TOKEN_END = 0,
TOKEN_INT = 1,
TOKEN_REAL = 2,
TOKEN_STRING = 3,
TOKEN_LPAREN = 4,
TOKEN_RPAREN = 5,
TOKEN_IDENT = 6,
TOKEN_QUOTE = 7,
TOKEN_DOT = 8,
TOKEN_INVALID = 50
};
#define IS_SPECIAL_CHAR(c) \
((c) == QSE_T('(') || (c) == QSE_T(')') || \
(c) == QSE_T('.') || (c) == QSE_T('\'') || (c) == QSE_T('\"'))
#define IS_IDENT_CHAR(lsp,c) \
(c != QSE_T('\0') && !IS_SPECIAL_CHAR(c) && !QSE_LSP_ISSPACE(lsp, c))
#define TOKEN_CLEAR(lsp) qse_str_clear (&(lsp)->token.name)
#define TOKEN_TYPE(lsp) (lsp)->token.type
#define TOKEN_IVAL(lsp) (lsp)->token.ival
#define TOKEN_RVAL(lsp) (lsp)->token.rval
#define TOKEN_SPTR(lsp) (lsp)->token.name.buf
#define TOKEN_SLEN(lsp) (lsp)->token.name.size
#define TOKEN_STR(lsp) (lsp)->token.name
#define TOKEN_SPTR(lsp) (lsp)->token.name.ptr
#define TOKEN_SLEN(lsp) (lsp)->token.name.len
#define TOKEN_LOC(lsp) (lsp)->token.loc
#define TOKEN_ADD_CHAR(lsp,ch) \
do { \
if (qse_lsp_name_addc(&(lsp)->token.name, ch) == -1) { \
qse_lsp_seterror (lsp, QSE_LSP_ENOMEM, QSE_NULL, 0); \
if (qse_str_ccat(&(lsp)->token.name, ch) == -1) { \
qse_lsp_seterror (lsp, QSE_LSP_ENOMEM, QSE_NULL, &lsp->curloc); \
return -1; \
} \
} while (0)
#define TOKEN_COMPARE(lsp,str) \
qse_lsp_name_compare (&(lsp)->token.name, str)
#define TOKEN_END 0
#define TOKEN_INT 1
#define TOKEN_REAL 2
#define TOKEN_STRING 3
#define TOKEN_LPAREN 4
#define TOKEN_RPAREN 5
#define TOKEN_IDENT 6
#define TOKEN_QUOTE 7
#define TOKEN_DOT 8
#define TOKEN_INVALID 50
#define TOKEN_UNTERM_STRING 51
#define NEXT_CHAR(lsp) \
do { if (read_char(lsp) == -1) return -1;} while (0)
@ -57,8 +78,6 @@
do { if (read_token(lsp) == -1) return QSE_NULL; } while (0)
static qse_lsp_obj_t* read_obj (qse_lsp_t* lsp);
static qse_lsp_obj_t* read_list (qse_lsp_t* lsp);
static qse_lsp_obj_t* read_quote (qse_lsp_t* lsp);
static int read_char (qse_lsp_t* lsp);
static int read_token (qse_lsp_t* lsp);
@ -66,213 +85,411 @@ static int read_number (qse_lsp_t* lsp, int negative);
static int read_ident (qse_lsp_t* lsp);
static int read_string (qse_lsp_t* lsp);
static QSE_INLINE_ALWAYS void protect (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
{
/* remember an object for temporary GC protection */
QSE_ASSERT (lsp->mem->r.tmp == QSE_NULL);
lsp->mem->r.tmp = obj;
}
static QSE_INLINE_ALWAYS void unprotect (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
{
/* release an object from temporary GC protection */
QSE_ASSERT (lsp->mem->r.tmp == obj);
lsp->mem->r.tmp = QSE_NULL;
}
qse_lsp_obj_t* qse_lsp_read (qse_lsp_t* lsp)
{
if (lsp->curc == QSE_CHAR_EOF &&
read_char(lsp) == -1) return QSE_NULL;
read_char(lsp) <= -1) return QSE_NULL;
NEXT_TOKEN (lsp);
lsp->mem->read = read_obj (lsp);
if (lsp->mem->read != QSE_NULL)
qse_lsp_deepunlockobj (lsp, lsp->mem->read);
return lsp->mem->read;
lsp->mem->r.obj = read_obj (lsp);
/* clear the stack.
* TODO: better to clear stack elements instead of counting on GC?
*/
lsp->mem->r.stack = lsp->mem->nil;
return lsp->mem->r.obj;
}
static QSE_INLINE qse_lsp_obj_t* makesym (qse_lsp_t* lsp, const qse_str_t* name)
{
QSE_ASSERT (lsp->mem->nil != QSE_NULL && lsp->mem->t != QSE_NULL);
if (qse_strxcmp (name->ptr, name->len, QSE_T("t")) == 0)
return lsp->mem->t;
if (qse_strxcmp (name->ptr, name->len, QSE_T("nil")) == 0)
return lsp->mem->nil;
return qse_lsp_makesym (lsp->mem, name->ptr, name->len);
}
static QSE_INLINE qse_lsp_obj_t* push (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
{
qse_lsp_obj_t* cell;
protect (lsp, obj); /* temporary protection */
cell = qse_lsp_makecons (lsp->mem, obj, lsp->mem->r.stack);
unprotect (lsp, obj); /* ok to unprotected as it is already chained to the stack... */
if (cell == QSE_NULL) return QSE_NULL;
lsp->mem->r.stack = cell;
return cell; /* return the containing cell */
}
static QSE_INLINE_ALWAYS void pop (qse_lsp_t* lsp)
{
QSE_ASSERT (lsp->mem->r.stack != lsp->mem->nil);
lsp->mem->r.stack = QSE_LSP_CDR(lsp->mem->r.stack);
}
static QSE_INLINE qse_lsp_obj_t* enter_list (qse_lsp_t* lsp, int flagv)
{
/* upon entering a list, it pushes three cells into a stack.
*
* r.stack -------+
* 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 (lsp, lsp->mem->num[flagv]) == QSE_NULL ||
push (lsp, lsp->mem->nil) == QSE_NULL ||
push (lsp, lsp->mem->nil) == QSE_NULL)? QSE_NULL: lsp->mem->r.stack;
}
static QSE_INLINE_ALWAYS qse_lsp_obj_t* leave_list (qse_lsp_t* lsp, int* flagv)
{
qse_lsp_obj_t* head;
/* the stack must not be empty */
QSE_ASSERT (lsp->mem->r.stack != lsp->mem->nil);
/* remember the current list head */
head = QSE_LSP_CAR(QSE_LSP_CDR(lsp->mem->r.stack));
/* upon leaving a list, it pops the three cells off the stack */
pop (lsp);
pop (lsp);
pop (lsp);
if (lsp->mem->r.stack == lsp->mem->nil)
{
/* 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_lsp_obj_t* flag = QSE_LSP_CDR(QSE_LSP_CDR(lsp->mem->r.stack));
QSE_ASSERT (QSE_LSP_TYPE(QSE_LSP_CAR(flag)) == QSE_LSP_OBJ_INT);
*flagv = QSE_LSP_IVAL(QSE_LSP_CAR(flag));
}
/* return the head of the list being left */
return head;
}
static QSE_INLINE_ALWAYS void dot_list (qse_lsp_t* lsp)
{
qse_lsp_obj_t* cell;
/* mark the state that a dot has appeared in the list */
QSE_ASSERT (lsp->mem->r.stack != lsp->mem->nil);
cell = QSE_LSP_CDR(QSE_LSP_CDR(lsp->mem->r.stack));
QSE_LSP_CAR(cell) = lsp->mem->num[QSE_LSP_IVAL(QSE_LSP_CAR(cell)) | DOTTED];
}
static qse_lsp_obj_t* chain_to_list (qse_lsp_t* lsp, qse_lsp_obj_t* obj)
{
qse_lsp_obj_t* cell, * head, * tail, *flag;
int flagv;
/* the stack top is the cons cell pointing to the list tail */
tail = lsp->mem->r.stack;
QSE_ASSERT (tail != lsp->mem->nil);
/* the cons cell pointing to the list head is below the tail cell
* connected via cdr. */
head = QSE_LSP_CDR(tail);
QSE_ASSERT (head != lsp->mem->nil);
/* the cons cell pointing to the flag is below the head cell
* connected via cdr */
flag = QSE_LSP_CDR(head);
/* retrieve the numeric flag value */
QSE_ASSERT(QSE_LSP_TYPE(QSE_LSP_CAR(flag)) == QSE_LSP_OBJ_INT);
flagv = (int)QSE_LSP_IVAL(QSE_LSP_CAR(flag));
if (flagv & CLOSED)
{
/* the list has already been closed. cannot add more items. */
qse_lsp_seterror (lsp, QSE_LSP_ERPAREN, QSE_NULL, &TOKEN_LOC(lsp));
return QSE_NULL;
}
else if (flagv & DOTTED)
{
/* the list must not be empty to have reached the dotted state */
QSE_ASSERT (QSE_LSP_CAR(tail) != lsp->mem->nil);
/* chain the object via 'cdr' of the tail cell */
QSE_LSP_CDR(QSE_LSP_CAR(tail)) = obj;
/* update the flag to CLOSED */
QSE_LSP_CAR(flag) = lsp->mem->num[flagv | CLOSED];
}
else
{
protect (lsp, obj); /* in case makecons() fails */
cell = qse_lsp_makecons (lsp->mem, obj, lsp->mem->nil);
unprotect (lsp, obj);
if (cell == QSE_NULL) return QSE_NULL;
if (QSE_LSP_CAR(head) == lsp->mem->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 (QSE_LSP_CAR(tail) == lsp->mem->nil);
QSE_LSP_CAR(head) = cell;
QSE_LSP_CAR(tail) = cell;
}
else
{
/* the new cons cell is not the first element.
* append it to the list */
QSE_LSP_CDR(QSE_LSP_CAR(tail)) = cell;
QSE_LSP_CAR(tail) = cell;
}
}
return obj;
}
static QSE_INLINE_ALWAYS int is_list_empty (qse_lsp_t* lsp)
{
/* the stack must not be empty */
QSE_ASSERT (lsp->mem->r.stack != lsp->mem->nil);
/* if the tail pointer is pointing to nil, the list is empty */
return QSE_LSP_CAR(lsp->mem->r.stack) == lsp->mem->nil;
}
static qse_lsp_obj_t* read_obj (qse_lsp_t* lsp)
{
/* this function read an s-expression non-recursively
* by manipulating its own stack. */
int level = 0, flag = 0;
qse_lsp_obj_t* obj;
switch (TOKEN_TYPE(lsp))
while (1)
{
case TOKEN_END:
qse_lsp_seterror (lsp, QSE_LSP_EEND, QSE_NULL, 0);
return QSE_NULL;
case TOKEN_LPAREN:
NEXT_TOKEN (lsp);
return read_list (lsp);
case TOKEN_QUOTE:
NEXT_TOKEN (lsp);
return read_quote (lsp);
case TOKEN_INT:
obj = qse_lsp_makeintobj (lsp->mem, TOKEN_IVAL(lsp));
if (obj == QSE_NULL) return QSE_NULL;
qse_lsp_lockobj (lsp, obj);
return obj;
case TOKEN_REAL:
obj = qse_lsp_makerealobj (lsp->mem, TOKEN_RVAL(lsp));
if (obj == QSE_NULL) return QSE_NULL;
qse_lsp_lockobj (lsp, obj);
return obj;
case TOKEN_STRING:
obj = qse_lsp_makestr (
lsp->mem, TOKEN_SPTR(lsp), TOKEN_SLEN(lsp));
if (obj == QSE_NULL) return QSE_NULL;
qse_lsp_lockobj (lsp, obj);
return obj;
case TOKEN_IDENT:
QSE_ASSERT (
lsp->mem->nil != QSE_NULL &&
lsp->mem->t != QSE_NULL);
if (TOKEN_COMPARE(lsp,QSE_T("nil")) == 0)
{
obj = lsp->mem->nil;
}
else if (TOKEN_COMPARE(lsp,QSE_T("t")) == 0)
{
obj = lsp->mem->t;
}
else
{
obj = qse_lsp_makesym (
lsp->mem,
TOKEN_SPTR(lsp),
TOKEN_SLEN(lsp));
if (obj == QSE_NULL) return QSE_NULL;
qse_lsp_lockobj (lsp, obj);
}
return obj;
}
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, 0);
return QSE_NULL;
}
static qse_lsp_obj_t* read_list (qse_lsp_t* lsp)
{
qse_lsp_obj_t* obj;
qse_lsp_obj_cons_t* p, * first = QSE_NULL, * prev = QSE_NULL;
while (TOKEN_TYPE(lsp) != TOKEN_RPAREN)
{
if (TOKEN_TYPE(lsp) == TOKEN_END)
redo:
switch (TOKEN_TYPE(lsp))
{
/* unexpected end of input */
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, 0);
return QSE_NULL;
}
if (TOKEN_TYPE(lsp) == TOKEN_DOT)
{
if (prev == QSE_NULL)
{
/* unexpected dot */
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, 0);
default:
QSE_ASSERT (!"should never happen - invalid token type");
qse_lsp_seterror (lsp, QSE_LSP_EINTERN, QSE_NULL, QSE_NULL);
return QSE_NULL;
}
NEXT_TOKEN (lsp);
obj = read_obj (lsp);
if (obj == QSE_NULL)
{
if (lsp->errnum == QSE_LSP_EEND)
case TOKEN_INVALID:
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, &TOKEN_LOC(lsp));
return QSE_NULL;
case TOKEN_END:
qse_lsp_seterror (lsp, QSE_LSP_EEND, QSE_NULL, &TOKEN_LOC(lsp));
return QSE_NULL;
case TOKEN_QUOTE:
if (level >= QSE_TYPE_MAX(int))
{
/* unexpected end of input */
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, 0);
/* the nesting level has become too deep */
qse_lsp_seterror (lsp, QSE_LSP_ELSTDEEP, QSE_NULL, &TOKEN_LOC(lsp));
return QSE_NULL;
}
return QSE_NULL;
}
prev->cdr = obj;
NEXT_TOKEN (lsp);
if (TOKEN_TYPE(lsp) != TOKEN_RPAREN)
{
/* ) expected */
qse_lsp_seterror (lsp, QSE_LSP_ERPAREN, QSE_NULL, 0);
return QSE_NULL;
}
/* enter a quoted string */
flag |= QUOTED;
if (enter_list (lsp, flag) == QSE_NULL) return QSE_NULL;
level++;
break;
/* force-chain the quote symbol to the new list entered */
if (chain_to_list (lsp, lsp->mem->quote) == QSE_NULL) return QSE_NULL;
/* read the next token */
NEXT_TOKEN (lsp);
goto redo;
case TOKEN_LPAREN:
if (level >= QSE_TYPE_MAX(int))
{
/* the nesting level has become too deep */
qse_lsp_seterror (lsp, QSE_LSP_ELSTDEEP, QSE_NULL, &TOKEN_LOC(lsp));
return QSE_NULL;
}
/* enter a normal string */
flag = 0;
if (enter_list (lsp, flag) == QSE_NULL) return QSE_NULL;
level++;
/* read the next token */
NEXT_TOKEN (lsp);
goto redo;
case TOKEN_DOT:
if (level <= 0 || is_list_empty (lsp))
{
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, &TOKEN_LOC(lsp));
return QSE_NULL;
}
dot_list (lsp);
NEXT_TOKEN (lsp);
goto redo;
case TOKEN_RPAREN:
if ((flag & 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_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, &TOKEN_LOC(lsp));
return QSE_NULL;
}
obj = leave_list (lsp, &flag);
level--;
break;
case TOKEN_INT:
obj = qse_lsp_makeint (lsp->mem, TOKEN_IVAL(lsp));
break;
case TOKEN_REAL:
obj = qse_lsp_makereal (lsp->mem, TOKEN_RVAL(lsp));
break;
case TOKEN_STRING:
obj = qse_lsp_makestr (
lsp->mem, TOKEN_SPTR(lsp), TOKEN_SLEN(lsp));
break;
case TOKEN_IDENT:
obj = makesym (lsp, &TOKEN_STR(lsp));
break;
}
obj = read_obj (lsp);
if (obj == QSE_NULL)
/* check if the element is read for a quoted list */
while (flag & QUOTED)
{
if (lsp->errnum == QSE_LSP_EEND)
{
/* unexpected end of input */
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, 0);
}
return QSE_NULL;
QSE_ASSERT (level > 0);
/* if so, append the element read into the quote list */
if (chain_to_list (lsp, obj) == QSE_NULL) return QSE_NULL;
/* exit out of the quoted list. the quoted list can have
* one element only. */
obj = leave_list (lsp, &flag);
/* one level up toward the top */
level--;
}
p = (qse_lsp_obj_cons_t*)qse_lsp_makecons (
lsp->mem, lsp->mem->nil, lsp->mem->nil);
if (p == QSE_NULL) return QSE_NULL;
qse_lsp_lockobj (lsp, (qse_lsp_obj_t*)p);
/* check if we are at the top level */
if (level <= 0) break; /* yes */
if (first == QSE_NULL) first = p;
if (prev != QSE_NULL) prev->cdr = (qse_lsp_obj_t*)p;
p->car = obj;
prev = p;
/* 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 (lsp, obj) == QSE_NULL) return QSE_NULL;
/* read the next token */
NEXT_TOKEN (lsp);
}
return (first == QSE_NULL)? lsp->mem->nil: (qse_lsp_obj_t*)first;
}
static qse_lsp_obj_t* read_quote (qse_lsp_t* lsp)
{
qse_lsp_obj_t* cons, * tmp;
tmp = read_obj (lsp);
if (tmp == QSE_NULL)
{
if (lsp->errnum == QSE_LSP_EEND)
{
/* unexpected end of input */
qse_lsp_seterror (lsp, QSE_LSP_ESYNTAX, QSE_NULL, 0);
}
return QSE_NULL;
}
cons = qse_lsp_makecons (lsp->mem, tmp, lsp->mem->nil);
if (cons == QSE_NULL) return QSE_NULL;
qse_lsp_lockobj (lsp, cons);
/* upon exit, we must be at the top level */
QSE_ASSERT (level == 0);
cons = qse_lsp_makecons (lsp->mem, lsp->mem->quote, cons);
if (cons == QSE_NULL) return QSE_NULL;
qse_lsp_lockobj (lsp, cons);
return cons;
}
return obj;
}
static int read_char (qse_lsp_t* lsp)
{
qse_ssize_t n;
qse_char_t c;
if (lsp->input_func == QSE_NULL)
if (lsp->io.fns.in == QSE_NULL)
{
qse_lsp_seterror (lsp, QSE_LSP_ENOINP, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_ENOINP, QSE_NULL, QSE_NULL);
return -1;
}
n = lsp->input_func(QSE_LSP_IO_READ, lsp->input_arg, &c, 1);
/* TODO: do some bufferring.... */
n = lsp->io.fns.in (lsp, QSE_LSP_IO_READ, &lsp->io.arg.in, &c, 1);
if (n == -1)
{
qse_lsp_seterror (lsp, QSE_LSP_EINPUT, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EINPUT, QSE_NULL, QSE_NULL);
return -1;
}
if (n == 0) lsp->curc = QSE_CHAR_EOF;
else lsp->curc = c;
else
{
lsp->curc = c;
if (c == QSE_T('\n'))
{
lsp->curloc.colm = 0;
lsp->curloc.line++;
}
else lsp->curloc.colm++;
}
return 0;
}
static int read_token (qse_lsp_t* lsp)
{
QSE_ASSERT (lsp->input_func != QSE_NULL);
QSE_ASSERT (lsp->io.fns.in != QSE_NULL);
TOKEN_CLEAR (lsp);
@ -281,19 +498,15 @@ static int read_token (qse_lsp_t* lsp)
/* skip white spaces */
while (QSE_LSP_ISSPACE(lsp, lsp->curc)) NEXT_CHAR (lsp);
/* skip the comments here */
if (lsp->curc == QSE_T(';'))
{
do
{
NEXT_CHAR (lsp);
}
while (lsp->curc != QSE_T('\n') &&
lsp->curc != QSE_CHAR_EOF);
}
else break;
if (lsp->curc != QSE_T(';')) break;
/* skip a comment - ignore all the following text */
do { NEXT_CHAR (lsp); }
while (lsp->curc != QSE_T('\n') &&
lsp->curc != QSE_CHAR_EOF);
}
TOKEN_LOC(lsp) = lsp->curloc;
if (lsp->curc == QSE_CHAR_EOF)
{
TOKEN_TYPE(lsp) = TOKEN_END;
@ -335,7 +548,7 @@ static int read_token (qse_lsp_t* lsp)
{
return read_number (lsp, 1);
}
else if (IS_IDENT(lsp->curc))
else if (IS_IDENT_CHAR(lsp,lsp->curc))
{
return read_ident (lsp);
}
@ -349,7 +562,7 @@ static int read_token (qse_lsp_t* lsp)
{
return read_number (lsp, 0);
}
else if (QSE_LSP_ISALPHA(lsp,lsp->curc) || IS_IDENT(lsp->curc))
else if (IS_IDENT_CHAR(lsp,lsp->curc))
{
return read_ident (lsp);
}
@ -412,7 +625,7 @@ static int read_ident (qse_lsp_t* lsp)
TOKEN_ADD_CHAR (lsp, lsp->curc);
NEXT_CHAR (lsp);
}
while (QSE_LSP_ISALNUM(lsp,lsp->curc) || IS_IDENT(lsp->curc));
while (IS_IDENT_CHAR(lsp,lsp->curc));
TOKEN_TYPE(lsp) = TOKEN_IDENT;
return 0;
}
@ -430,7 +643,7 @@ static int read_string (qse_lsp_t* lsp)
if (c == QSE_CHAR_EOF)
{
qse_lsp_seterror (lsp, QSE_LSP_EENDSTR, QSE_NULL, 0);
qse_lsp_seterror (lsp, QSE_LSP_EENDSTR, QSE_NULL, &lsp->curloc);
return -1;
}
@ -565,3 +778,4 @@ static int read_string (qse_lsp_t* lsp)
TOKEN_TYPE(lsp) = TOKEN_STRING;
return 0;
}

4
qse/lib/sed/Sed.cpp
View File

@ -1,5 +1,5 @@
/*
* $Id: Sed.cpp 319 2009-12-19 03:06:28Z hyunghwan.chung $
* $Id: Sed.cpp 344 2010-08-17 13:15:14Z hyunghwan.chung $
*
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
@ -102,7 +102,7 @@ Sed::loc_t Sed::getErrorLocation () const
if (sed == QSE_NULL)
{
loc_t loc;
loc.lin = 0; loc.col = 0;
loc.line = 0; loc.colm = 0;
return loc;
}
return *qse_sed_geterrloc (sed);

13
qse/lib/sed/sed.c
View File

@ -1,5 +1,5 @@
/*
* $Id: sed.c 334 2010-07-14 12:54:48Z hyunghwan.chung $
* $Id: sed.c 344 2010-08-17 13:15:14Z hyunghwan.chung $
*
Copyright 2006-2009 Chung, Hyung-Hwan.
This file is part of QSE.
@ -148,7 +148,6 @@ static qse_sed_t* qse_sed_init (qse_sed_t* sed, qse_mmgr_t* mmgr)
return sed;
}
static void qse_sed_fini (qse_sed_t* sed)
{
free_all_command_blocks (sed);
@ -209,10 +208,10 @@ static qse_cint_t getnextsc (qse_sed_t* sed)
{
if (sed->src.cc == QSE_T('\n'))
{
sed->src.loc.lin++;
sed->src.loc.col = 1;
sed->src.loc.line++;
sed->src.loc.colm = 1;
}
else sed->src.loc.col++;
else sed->src.loc.colm++;
sed->src.cc = *sed->src.cur++;
/* TODO: support different line end convension */
@ -1236,8 +1235,8 @@ int qse_sed_comp (qse_sed_t* sed, const qse_char_t* sptr, qse_size_t slen)
sed->src.ptr = sptr;
sed->src.end = sptr + slen;
sed->src.cur = sptr;
sed->src.loc.lin = 1;
sed->src.loc.col = 0;
sed->src.loc.line = 1;
sed->src.loc.colm = 0;
sed->src.cc = QSE_CHAR_EOF;
c = NXTSC (sed);

4
qse/samples/awk/awk05.cpp
View File

@ -25,8 +25,8 @@
static void print_error (
const QSE::StdAwk::loc_t& loc, const QSE::StdAwk::char_t* msg)
{
if (loc.lin > 0 || loc.col > 0)
qse_fprintf (QSE_STDERR, QSE_T("ERROR: %s at LINE %lu COLUMN %lu\n"), msg, loc.lin, loc.col);
if (loc.line > 0 || loc.colm > 0)
qse_fprintf (QSE_STDERR, QSE_T("ERROR: %s at LINE %lu COLUMN %lu\n"), msg, loc.line, loc.colm);
else
qse_fprintf (QSE_STDERR, QSE_T("ERROR: %s\n"), msg);

4
qse/samples/awk/awk06.cpp
View File

@ -25,8 +25,8 @@
static void print_error (
const QSE::StdAwk::loc_t& loc, const QSE::StdAwk::char_t* msg)
{
if (loc.lin > 0 || loc.col > 0)
qse_fprintf (QSE_STDERR, QSE_T("ERROR: %s at LINE %lu COLUMN %lu\n"), msg, loc.lin, loc.col);
if (loc.line > 0 || loc.colm > 0)
qse_fprintf (QSE_STDERR, QSE_T("ERROR: %s at LINE %lu COLUMN %lu\n"), msg, loc.line, loc.colm);
else
qse_fprintf (QSE_STDERR, QSE_T("ERROR: %s\n"), msg);

4
qse/samples/awk/awk07.cpp
View File

@ -25,8 +25,8 @@
static void print_error (
const QSE::StdAwk::loc_t& loc, const QSE::StdAwk::char_t* msg)
{
if (loc.lin > 0 || loc.col > 0)
qse_fprintf (QSE_STDERR, QSE_T("ERROR: %s at LINE %lu COLUMN %lu\n"), msg, loc.lin, loc.col);
if (loc.line > 0 || loc.colm > 0)
qse_fprintf (QSE_STDERR, QSE_T("ERROR: %s at LINE %lu COLUMN %lu\n"), msg, loc.line, loc.colm);
else
qse_fprintf (QSE_STDERR, QSE_T("ERROR: %s\n"), msg);

2
qse/samples/awk/awk08.cpp
View File

@ -179,7 +179,7 @@ static void print_error (MyAwk& awk)
print_error (
QSE_T("LINE [%u] %s\n"),
(unsigned)loc.lin,
(unsigned)loc.line,
awk.getErrorMessage()
);
}