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

*** empty log message ***

Browse Source
This commit is contained in:
hyung-hwan 2006-10-26 08:47:30 +00:00
parent ac39c74c0f
commit c40613c0ba
7 changed files with 327 additions and 212 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ase/lsp/makefile.bcc
View File

@ -1,4 +1,4 @@
SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c \ SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c misc.c \
prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c
OBJS = $(SRCS:.c=.obj) OBJS = $(SRCS:.c=.obj)
OUT = aselsp.lib OUT = aselsp.lib

2
ase/lsp/makefile.cl
View File

@ -1,6 +1,6 @@
OUT = aselsp OUT = aselsp
SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c \ SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c misc.c \
prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c
OBJS = $(SRCS:.c=.obj) OBJS = $(SRCS:.c=.obj)

2
ase/lsp/makefile.in
View File

@ -1,4 +1,4 @@
SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c \ SRCS = lsp.c name.c mem.c env.c err.c read.c eval.c print.c misc.c \
prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c prim.c prim_prog.c prim_let.c prim_compar.c prim_math.c
OBJS = $(SRCS:.c=.o) OBJS = $(SRCS:.c=.o)
OUT = libaselsp.a OUT = libaselsp.a

198
ase/test/lsp/lisp.c
View File

@ -1,198 +0,0 @@
#include <xp/lsp/lsp.h>
#include <xp/bas/stdio.h>
#include <xp/bas/ctype.h>
#include <xp/bas/stdcli.h>
#include <xp/bas/locale.h>
#include <xp/bas/sio.h>
#ifdef __linux
#include <mcheck.h>
#endif
static xp_ssize_t get_input (int cmd, void* arg, xp_char_t* data, xp_size_t size)
{
xp_ssize_t n;
switch (cmd) {
case XP_LSP_IO_OPEN:
case XP_LSP_IO_CLOSE:
return 0;
case XP_LSP_IO_DATA:
if (size < 0) return -1;
n = xp_sio_getc (xp_sio_in, data);
if (n == 0) return 0;
if (n != 1) return -1;
return n;
}
return -1;
}
static xp_ssize_t put_output (int cmd, void* arg, xp_char_t* data, xp_size_t size)
{
switch (cmd) {
case XP_LSP_IO_OPEN:
case XP_LSP_IO_CLOSE:
return 0;
case XP_LSP_IO_DATA:
return xp_sio_putsx (xp_sio_out, data, size);
}
return -1;
}
int to_int (const xp_char_t* str)
{
int r = 0;
while (*str != XP_CHAR('\0')) {
if (!xp_isdigit(*str)) break;
r = r * 10 + (*str - XP_CHAR('0'));
str++;
}
return r;
}
#include <locale.h>
int handle_cli_error (
const xp_cli_t* cli, int code,
const xp_char_t* name, const xp_char_t* value)
{
xp_printf (XP_TEXT("usage: %s /memory=nnn /increment=nnn\n"), cli->verb);
if (code == XP_CLI_ERROR_INVALID_OPTNAME) {
xp_printf (XP_TEXT("unknown option - %s\n"), name);
}
else if (code == XP_CLI_ERROR_MISSING_OPTNAME) {
xp_printf (XP_TEXT("missing option - %s\n"), name);
}
else if (code == XP_CLI_ERROR_REDUNDANT_OPTVAL) {
xp_printf (XP_TEXT("redundant value %s for %s\n"), value, name);
}
else if (code == XP_CLI_ERROR_MISSING_OPTVAL) {
xp_printf (XP_TEXT("missing value for %s\n"), name);
}
else if (code == XP_CLI_ERROR_MEMORY) {
xp_printf (XP_TEXT("memory error in processing %s\n"), name);
}
else {
xp_printf (XP_TEXT("error code: %d\n"), code);
}
return -1;
}
xp_cli_t* parse_cli (int argc, xp_char_t* argv[])
{
static const xp_char_t* optsta[] =
{
XP_TEXT("/"), XP_TEXT("--"), XP_NULL
};
static xp_cliopt_t opts[] =
{
{ XP_TEXT("memory"), XP_CLI_OPTNAME | XP_CLI_OPTVAL },
{ XP_TEXT("increment"), XP_CLI_OPTNAME | XP_CLI_OPTVAL },
{ XP_NULL, 0 }
};
static xp_cli_t cli =
{
handle_cli_error,
optsta,
XP_TEXT("="),
opts
};
if (xp_parsecli (argc, argv, &cli) == -1) return XP_NULL;
return &cli;
}
int xp_main (int argc, xp_char_t* argv[])
{
xp_lsp_t* lsp;
xp_lsp_obj_t* obj;
xp_cli_t* cli;
int mem, inc;
#ifdef __linux
mtrace ();
#endif
if (xp_setlocale () == -1) {
xp_fprintf (xp_stderr,
XP_TEXT("error: cannot set locale\n"));
return -1;
}
if ((cli = parse_cli (argc, argv)) == XP_NULL) return -1;
mem = to_int(xp_getclioptval(cli, XP_TEXT("memory")));
inc = to_int(xp_getclioptval(cli, XP_TEXT("increment")));
xp_clearcli (cli);
if (mem <= 0) {
xp_fprintf (xp_stderr,
XP_TEXT("error: invalid memory size given\n"));
return -1;
}
lsp = xp_lsp_open (XP_NULL, mem, inc);
if (lsp == XP_NULL) {
xp_fprintf (xp_stderr,
XP_TEXT("error: cannot create a lsp instance\n"));
return -1;
}
xp_printf (XP_TEXT("LSP 0.0001\n"));
xp_lsp_attach_input (lsp, get_input, XP_NULL);
xp_lsp_attach_output (lsp, put_output, XP_NULL);
for (;;) {
xp_sio_puts (xp_sio_out, argv[0]);
xp_sio_puts (xp_sio_out, XP_TEXT("> "));
xp_sio_flush (xp_sio_out);
obj = xp_lsp_read (lsp);
if (obj == XP_NULL) {
if (lsp->errnum != XP_LSP_ERR_END &&
lsp->errnum != XP_LSP_ERR_ABORT) {
xp_fprintf (xp_stderr,
XP_TEXT("error while reading: %d\n"), lsp->errnum);
}
if (lsp->errnum < XP_LSP_ERR_SYNTAX) break;
continue;
}
if ((obj = xp_lsp_eval (lsp, obj)) != XP_NULL) {
xp_lsp_print (lsp, obj);
xp_sio_puts (xp_sio_out, XP_TEXT("\n"));
}
else {
int errnum;
xp_char_t errstr[256];
errnum = xp_lsp_error (lsp, errstr, xp_countof(errstr));
if (errnum == XP_LSP_ERR_ABORT) break;
xp_fprintf (xp_stderr,
XP_TEXT("error: [%d] %s\n"),
errnum, errstr);
}
}
xp_lsp_close (lsp);
#ifdef __linux
muntrace ();
#endif
return 0;
}

313
ase/test/lsp/lsp.c Normal file
View File

@ -0,0 +1,313 @@
#include <ase/lsp/lsp.h>
#include <xp/bas/stdio.h>
#include <xp/bas/ctype.h>
#include <xp/bas/stdcli.h>
#include <xp/bas/locale.h>
#include <xp/bas/sio.h>
#ifdef __linux
#include <mcheck.h>
#endif
static xp_ssize_t get_input (int cmd, void* arg, xp_char_t* data, xp_size_t size)
{
xp_ssize_t n;
switch (cmd) {
case ASE_LSP_IO_OPEN:
case ASE_LSP_IO_CLOSE:
return 0;
case ASE_LSP_IO_READ:
if (size < 0) return -1;
n = xp_sio_getc (xp_sio_in, data);
if (n == 0) return 0;
if (n != 1) return -1;
return n;
}
return -1;
}
static xp_ssize_t put_output (int cmd, void* arg, xp_char_t* data, xp_size_t size)
{
switch (cmd) {
case ASE_LSP_IO_OPEN:
case ASE_LSP_IO_CLOSE:
return 0;
case ASE_LSP_IO_WRITE:
return xp_sio_putsx (xp_sio_out, data, size);
}
return -1;
}
int to_int (const xp_char_t* str)
{
int r = 0;
while (*str != XP_CHAR('\0')) {
if (!xp_isdigit(*str)) break;
r = r * 10 + (*str - XP_CHAR('0'));
str++;
}
return r;
}
#include <locale.h>
int handle_cli_error (
const xp_cli_t* cli, int code,
const xp_char_t* name, const xp_char_t* value)
{
xp_printf (XP_T("usage: %s /memory=nnn /increment=nnn\n"), cli->verb);
if (code == XP_CLI_ERROR_INVALID_OPTNAME) {
xp_printf (XP_T("unknown option - %s\n"), name);
}
else if (code == XP_CLI_ERROR_MISSING_OPTNAME) {
xp_printf (XP_T("missing option - %s\n"), name);
}
else if (code == XP_CLI_ERROR_REDUNDANT_OPTVAL) {
xp_printf (XP_T("redundant value %s for %s\n"), value, name);
}
else if (code == XP_CLI_ERROR_MISSING_OPTVAL) {
xp_printf (XP_T("missing value for %s\n"), name);
}
else if (code == XP_CLI_ERROR_MEMORY) {
xp_printf (XP_T("memory error in processing %s\n"), name);
}
else {
xp_printf (XP_T("error code: %d\n"), code);
}
return -1;
}
xp_cli_t* parse_cli (int argc, xp_char_t* argv[])
{
static const xp_char_t* optsta[] =
{
XP_T("/"), XP_T("--"), XP_NULL
};
static xp_cliopt_t opts[] =
{
{ XP_T("memory"), XP_CLI_OPTNAME | XP_CLI_OPTVAL },
{ XP_T("increment"), XP_CLI_OPTNAME | XP_CLI_OPTVAL },
{ XP_NULL, 0 }
};
static xp_cli_t cli =
{
handle_cli_error,
optsta,
XP_T("="),
opts
};
if (xp_parsecli (argc, argv, &cli) == -1) return XP_NULL;
return &cli;
}
#ifdef _WIN32
typedef struct syscas_data_t syscas_data_t;
struct syscas_data_t
{
HANDLE heap;
};
#endif
static void* __lsp_malloc (xp_size_t n, void* custom_data)
{
#ifdef _WIN32
return HeapAlloc (((syscas_data_t*)custom_data)->heap, 0, n);
#else
return malloc (n);
#endif
}
static void* __lsp_realloc (void* ptr, xp_size_t n, void* custom_data)
{
#ifdef _WIN32
/* HeapReAlloc behaves differently from realloc */
if (ptr == NULL)
return HeapAlloc (((syscas_data_t*)custom_data)->heap, 0, n);
else
return HeapReAlloc (((syscas_data_t*)custom_data)->heap, 0, ptr, n);
#else
return realloc (ptr, n);
#endif
}
static void __lsp_free (void* ptr, void* custom_data)
{
#ifdef _WIN32
HeapFree (((syscas_data_t*)custom_data)->heap, 0, ptr);
#else
free (ptr);
#endif
}
static int __dprintf (const xp_char_t* fmt, ...)
{
int n;
va_list ap;
#ifdef _WIN32
xp_char_t buf[1024];
#endif
va_start (ap, fmt);
#ifdef _WIN32
n = xp_vsprintf (buf, xp_countof(buf), fmt, ap);
#if defined(_MSC_VER) && (_MSC_VER>=1400)
MessageBox (NULL, buf, ASE_T("\uD655\uC778\uC2E4\uD328 Assertion Failure"), MB_OK | MB_ICONERROR);
#else
MessageBox (NULL, buf, ASE_T("Assertion Failure"), MB_OK | MB_ICONERROR);
#endif
#else
n = xp_vprintf (fmt, ap);
#endif
va_end (ap);
return n;
}
int xp_main (int argc, xp_char_t* argv[])
{
ase_lsp_t* lsp;
ase_lsp_obj_t* obj;
xp_cli_t* cli;
int mem, inc;
ase_lsp_syscas_t syscas;
#ifdef __linux
mtrace ();
#endif
if (xp_setlocale () == -1) {
xp_fprintf (xp_stderr,
XP_T("error: cannot set locale\n"));
return -1;
}
if ((cli = parse_cli (argc, argv)) == XP_NULL) return -1;
mem = to_int(xp_getclioptval(cli, XP_T("memory")));
inc = to_int(xp_getclioptval(cli, XP_T("increment")));
xp_clearcli (cli);
if (mem <= 0)
{
xp_fprintf (xp_stderr,
XP_T("error: invalid memory size given\n"));
return -1;
}
memset (&syscas, 0, sizeof(syscas));
syscas.malloc = __lsp_malloc;
syscas.realloc = __lsp_realloc;
syscas.free = __lsp_free;
#ifdef ASE_CHAR_IS_MCHAR
syscas.is_upper = isupper;
syscas.is_lower = islower;
syscas.is_alpha = isalpha;
syscas.is_digit = isdigit;
syscas.is_xdigit = isxdigit;
syscas.is_alnum = isalnum;
syscas.is_space = isspace;
syscas.is_print = isprint;
syscas.is_graph = isgraph;
syscas.is_cntrl = iscntrl;
syscas.is_punct = ispunct;
syscas.to_upper = toupper;
syscas.to_lower = tolower;
#else
syscas.is_upper = iswupper;
syscas.is_lower = iswlower;
syscas.is_alpha = iswalpha;
syscas.is_digit = iswdigit;
syscas.is_xdigit = iswxdigit;
syscas.is_alnum = iswalnum;
syscas.is_space = iswspace;
syscas.is_print = iswprint;
syscas.is_graph = iswgraph;
syscas.is_cntrl = iswcntrl;
syscas.is_punct = iswpunct;
syscas.to_upper = towupper;
syscas.to_lower = towlower;
#endif
syscas.memcpy = memcpy;
syscas.memset = memset;
syscas.sprintf = xp_sprintf;
syscas.dprintf = __dprintf;
syscas.abort = abort;
lsp = ase_lsp_open (&syscas, mem, inc);
if (lsp == XP_NULL)
{
xp_fprintf (xp_stderr,
XP_T("error: cannot create a lsp instance\n"));
return -1;
}
xp_printf (XP_T("LSP 0.0001\n"));
ase_lsp_attach_input (lsp, get_input, XP_NULL);
ase_lsp_attach_output (lsp, put_output, XP_NULL);
while (1)
{
xp_sio_puts (xp_sio_out, argv[0]);
xp_sio_puts (xp_sio_out, XP_T("> "));
xp_sio_flush (xp_sio_out);
obj = ase_lsp_read (lsp);
if (obj == XP_NULL)
{
int errnum = ase_lsp_geterrnum(lsp);
if (errnum != ASE_LSP_ERR_END &&
errnum != ASE_LSP_ERR_ABORT)
{
xp_fprintf (xp_stderr,
XP_T("error while reading: %d\n"), errnum);
}
if (errnum < ASE_LSP_ERR_SYNTAX) break;
continue;
}
if ((obj = ase_lsp_eval (lsp, obj)) != XP_NULL) {
ase_lsp_print (lsp, obj);
xp_sio_puts (xp_sio_out, XP_T("\n"));
}
else {
int errnum;
const xp_char_t* errstr;
errnum = ase_lsp_geterrnum(lsp);
if (errnum == ASE_LSP_ERR_ABORT) break;
errstr = ase_lsp_geterrstr(errnum);
xp_fprintf (xp_stderr,
XP_T("error: [%d] %s\n"), errnum, errstr);
}
}
ase_lsp_close (lsp);
#ifdef __linux
muntrace ();
#endif
return 0;
}

14
ase/test/lsp/makefile.cl
View File

@ -1,15 +1,15 @@
CC = cl CC = cl
CFLAGS = /nologo /MT /GX /W3 /GR- /D_WIN32_WINNT=0x0400 -I..\..\.. CFLAGS = /nologo /MT /GX /W3 /GR- /D_WIN32_WINNT=0x0400 -I..\..\.. -I$(XPKIT)
LDFLAGS = /libpath:..\..\bas /libpath:..\..\lsp LDFLAGS = /libpath:..\..\lsp /libpath:$(XPKIT)\xp\bas
LIBS = xpbas.lib xplsp.lib LIBS = aselsp.lib xpbas.lib user32.lib
all: lisp all: lsp
lisp: lisp.obj lsp: lsp.obj
link /nologo /out:lisp.exe $(LDFLAGS) $(LIBS) lisp.obj link /nologo /out:lsp.exe $(LDFLAGS) $(LIBS) lsp.obj
clean: clean:
del $(OBJS) *.obj lisp.exe del $(OBJS) *.obj lsp.exe
.SUFFIXES: .c .obj .SUFFIXES: .c .obj
.c.obj: .c.obj:

8
ase/test/lsp/makefile.in
View File

@ -1,10 +1,10 @@
SRCS = lisp.c SRCS = lsp.c
OUTS = $(SRCS:.c=.x) OUTS = $(SRCS:.c=.x)
CC = @CC@ CC = @CC@
CFLAGS = @CFLAGS@ -I@abs_top_builddir@ CFLAGS = @CFLAGS@ -I@abs_top_builddir@/..
LDFLAGS = @LDFLAGS@ -L@abs_top_builddir@/xp/bas -L@abs_top_builddir@/xp/lsp LDFLAGS = @LDFLAGS@ -L@abs_top_builddir@/lsp
LIBS = @LIBS@ -lxpbas -lxplsp LIBS = @LIBS@ -lxpbas -laselsp
all: $(OUTS) all: $(OUTS)