Commit 5a420188 authored by Kevin Cozens's avatar Kevin Cozens

Initial revision

parent 76d95a10
## Process this file with automake to produce
-I$(top_srcdir) \
noinst_LIBRARIES = libftx.a
libftx_a_SOURCES = ftx.c ftx.h
TinyScheme Extensions (TSX) 1.1 [September, 2002]
(c) 2002 Manuel Heras-Gilsanz (
This software is subject to the license terms contained in the
1.1 (Sept. 2002) Updated to tinyscheme 1.31
1.0 (April 2002) First released version
TinyScheme Extensions is a set of dynamic libraries incorporating
additional funcionality to TinyScheme, a lightweight
implementation of the Scheme programming language. TinyScheme
( is maintained by D. Souflis
(, and is based on MiniSCHEME version 0.85k4.
Scheme is a very nice and powerful programming language, but the
basic language is very minimalistic in terms of library functions;
only basic file input / output functionality is specified.
Different implementations of the language (MIT Scheme, GUILE,
Bigloo...) provide their own extension libraries. TSX attempts to
provide commonly needed functions at a small cost in terms of
additional program footprint. The library is modularized, so that
it is possible (and easy!) to select desired functionality via
#defines in tsx.h.
TSX has been tested on GNU/Linux 2.4.2 with gcc 2.96 and
libc-2.2.2, with TinyScheme 1.31.
To install, copy the distribution file to the directory
where TinyScheme is installed (and where scheme.h lies),
and run make. If building succeeds, a file called
should be created. This file can be loaded as a TinyScheme
extension with
(load-extension "tsx-1.0/tsx")
After loading TSX, you can make use of its functions.
To reduce footprint, you can choose the functionality which
will be included. To do so, have a look at tsx.h and
comment the #defines for unneeded modules.
If you get compiler errors, make sure you have enabled
dynamic modules in your tinyscheme runtime (define USE_DL
somewhere near the top in scheme.h).
Three sample applications are distributed with TSX 1.0.
The code is not particularly elegant, nor written in proper
functional style, but is provided for illustration of the
implemented calls.
Sends an email to the user getting the username from
the USER shell variable, connecting to the SMTP port
on the local machine.
Provides a list of all the files on the user's home
directory (obtained with the HOME environment variable).
Provides a socket-based read-eval-print-loop. It listens
for connections on the 9000 port of the local machines,
and executes the commands received. To test it, run
telnet localhost 9000
after starting the sample application, and type Scheme
expressions. You will get the evaluations. To exit the
session, type "quit" and TinyScheme will exit, closing
the socket. The output of some functions will not
be the same as you would obtain on TinyScheme's
"command line", because standard output is not
redirected to the socket, but most commands work ok.
You should copy these applications to the directory where
TinyScheme is installed (i.e., where the "scheme" binary
file resides), and can be runned with:
./scheme listhome.scm
./scheme smtp.scm
./scheme srepl.scm
The extension functions implemented by TinyScheme Extensions are
documented in the file "tsx-functions.txt".
/* TinyScheme Extensions
* (c) 2002 Visual Tools, S.A.
* Manuel Heras-Gilsanz (
* This software is subject to the terms stated in the
* LICENSE file.
#include <sys/stat.h>
#include <unistd.h>
#include <time.h>
#include <glib.h>
#include "tinyscheme/scheme-private.h"
#undef cons
typedef enum
} FileType;
named_constant {
const char *name;
FileType value;
struct named_constant
file_type_constants[] = {
{ NULL, 0 }
pointer foreign_fileexists(scheme *sc, pointer args)
pointer first_arg;
char *filename;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
filename = sc->vptr->string_value(first_arg);
filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
if (g_file_test(filename, G_FILE_TEST_EXISTS))
return sc->T;
return sc->F;
pointer foreign_filetype(scheme *sc, pointer args)
pointer first_arg;
char *filename;
int retcode;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
filename = sc->vptr->string_value(first_arg);
filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
if (g_file_test(filename, G_FILE_TEST_IS_REGULAR))
retcode = FILE_TYPE_FILE;
else if (g_file_test(filename, G_FILE_TEST_IS_DIR))
retcode = FILE_TYPE_DIR;
else if (g_file_test(filename, G_FILE_TEST_IS_SYMLINK))
retcode = FILE_TYPE_LINK;
return sc->vptr->mk_integer(sc, retcode);
pointer foreign_filesize(scheme *sc, pointer args)
pointer first_arg;
pointer ret;
struct stat buf;
char * filename;
int retcode;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
filename = sc->vptr->string_value(first_arg);
filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
retcode = stat(filename, &buf);
if (retcode == 0)
ret = sc->vptr->mk_integer(sc,buf.st_size);
ret = sc->F;
return ret;
pointer foreign_filedelete(scheme *sc, pointer args)
pointer first_arg;
pointer ret;
char * filename;
int retcode;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg)) {
return sc->F;
filename = sc->vptr->string_value(first_arg);
filename = g_filename_from_utf8 (filename, -1, NULL, NULL, NULL);
retcode = unlink(filename);
if (retcode == 0)
ret = sc->T;
ret = sc->F;
return ret;
pointer foreign_diropenstream(scheme *sc, pointer args)
pointer first_arg;
char *dirpath;
GDir *dir;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_string(first_arg))
return sc->F;
dirpath = sc->vptr->string_value(first_arg);
dirpath = g_filename_from_utf8 (dirpath, -1, NULL, NULL, NULL);
dir = g_dir_open(dirpath, 0, NULL);
if (dir == NULL)
return sc->F;
/* Stuffing a pointer in a long may not always be portable ~~~~~ */
return (sc->vptr->mk_integer(sc, (long) dir));
pointer foreign_dirreadentry(scheme *sc, pointer args)
pointer first_arg;
GDir *dir;
gchar *entry;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_integer(first_arg))
return sc->F;
dir = (GDir *) sc->vptr->ivalue(first_arg);
if (dir == NULL)
return sc->F;
entry = (gchar *)g_dir_read_name(dir);
if (entry == NULL)
return sc->EOF_OBJ;
entry = g_filename_to_utf8 (entry, -1, NULL, NULL, NULL);
return (sc->vptr->mk_string(sc, entry));
pointer foreign_dirrewind(scheme *sc, pointer args)
pointer first_arg;
GDir *dir;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_integer(first_arg))
return sc->F;
dir = (GDir *) sc->vptr->ivalue(first_arg);
if (dir == NULL)
return sc->F;
return sc->T;
pointer foreign_dirclosestream(scheme *sc, pointer args)
pointer first_arg;
GDir *dir;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_integer(first_arg))
return sc->F;
dir = (GDir *) sc->vptr->ivalue(first_arg);
if (dir == NULL)
return sc->F;
return sc->T;
pointer foreign_time(scheme *sc, pointer args)
time_t now;
struct tm *now_tm;
pointer ret;
if (args != sc->NIL)
return sc->F;
#if 1
now_tm = localtime(&now);
GTime time;
GDate date;
g_date_set_time(&date, &now);
g_date_to_struct_tm(&now, &now_tm);
ret = sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_year),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_mon),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_mday),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_hour),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_min),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) now_tm->tm_sec),sc->NIL))))));
return ret;
pointer foreign_gettimeofday(scheme *sc, pointer args)
GTimeVal tv;
pointer ret;
ret = sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) tv.tv_sec),
sc->vptr->cons(sc, sc->vptr->mk_integer(sc,(long) tv.tv_usec),
return ret;
pointer foreign_usleep(scheme *sc, pointer args)
pointer first_arg;
long usec;
if (args == sc->NIL)
return sc->F;
first_arg = sc->vptr->pair_car(args);
if (!sc->vptr->is_integer(first_arg))
return sc->F;
usec = sc->vptr->ivalue(first_arg);
return sc->T;
/* This function gets called when TinyScheme is loading the extension */
void init_ftx (scheme *sc)
int i;
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_time));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_gettimeofday));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_usleep));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_fileexists));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_filetype));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_filesize));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_filedelete));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_diropenstream));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_dirreadentry));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_dirrewind));
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_foreign_func(sc, foreign_dirclosestream));
for (i = 0; file_type_constants[i].name != NULL; ++i)
sc->vptr->scheme_define(sc, sc->global_env,
sc->vptr->mk_symbol(sc, file_type_constants[i].name),
sc->vptr->mk_integer(sc, file_type_constants[i].value));
/* This function gets called when TinyScheme is initializing the extension */
void init_ftx (scheme *sc);
Copyright 1992, 1993, 1994 Henry Spencer. All rights reserved.
This software is not subject to any license of the American Telephone
and Telegraph Company or of the Regents of the University of California.
Permission is granted to anyone to use this software for any purpose on
any computer system, and to alter it and redistribute it, subject
to the following restrictions:
1. The author is not responsible for the consequences of use of this
software, no matter how awful, even if they arise from flaws in it.
2. The origin of this software must not be misrepresented, either by
explicit claim or by omission. Since few users ever read sources,
credits must appear in the documentation.
3. Altered versions must be plainly marked as such, and must not be
misrepresented as being the original software. Since few users
ever read sources, credits must appear in the documentation.
4. This notice may not be removed or altered.
## Process this file with automake to produce
#no_undefined = -no-undefined
#if OS_WIN32
#mwindows = -mwindows
noinst_LIBRARIES = libre.a
libre_a_SOURCES = \
ccass.h \
cname.h \
debug.c \
re.c \
re.h \
regcomp.c \
regerror.c \
regex2.h \
regexec.c \
regex.h \
regfree.c \
split.c \
alpha3.4 release.
Thu Mar 17 23:17:18 EST 1994
See WHATSNEW for change listing.
installation notes:
Read the comments at the beginning of Makefile before running.
Utils.h contains some things that just might have to be modified on
some systems, as well as a nested include (ugh) of <assert.h>.
The "fake" directory contains quick-and-dirty fakes for some header
files and routines that old systems may not have. Note also that
-DUSEBCOPY will make utils.h substitute bcopy() for memmove().
After that, "make r" will build regcomp.o, regexec.o, regfree.o,
and regerror.o (the actual routines), bundle them together into a test
program, and run regression tests on them. No output is good output.
"make lib" builds just the .o files for the actual routines (when
you're happy with testing and have adjusted CFLAGS for production),
and puts them together into libregex.a. You can pick up either the
library or *.o ("make lib" makes sure there are no other .o files left
around to confuse things).
Main.c, debug.c, split.c are used for regression testing but are not part
of the RE routines themselves.
Regex.h goes in /usr/include. All other .h files are internal only.
TinyScheme RE (Regular Expressions) extension
Version 1.2, August 2002
The bulk of this directory is the regular expression library written
by Henry Spencer (see file README and COPYRIGHT).
Two files were added to produce the TinyScheme regular expression
library, re.c and re.makefile. The included re.makefile was contributed
initially by Stephen Gildea and should be adaptable to all Unix systems.
The makefile produces a DLL named For now, it contains just
a single foreign function (re-match <pattern> <string>). It returns
true (string matches pattern) or false. If it is called with an
extra parameter, which should be a vector, overwrites as many elements
of the vector as needed with the strings that matched the corresponding
parenthesized subexpressions inside <pattern>.
It is not fully tested, so use with caution.
Load the extension from inside TinyScheme using
(load-extension "re/re")
assuming that is in the directory "re".
Load "re.scm" if you wish to use v.1.1 behavior.
New in alpha3.4: The complex bug alluded to below has been fixed (in a
slightly kludgey temporary way that may hurt efficiency a bit; this is
another "get it out the door for 4.4" release). The tests at the end of
the tests file have accordingly been uncommented. The primary sign of
the bug was that something like a?b matching ab matched b rather than ab.
(The bug was essentially specific to this exact situation, else it would
have shown up earlier.)
New in alpha3.3: The definition of word boundaries has been altered
slightly, to more closely match the usual programming notion that "_"
is an alphabetic. Stuff used for pre-ANSI systems is now in a subdir,
and the makefile no longer alludes to it in mysterious ways. The
makefile has generally been cleaned up some. Fixes have been made
(again!) so that the regression test will run without -DREDEBUG, at
the cost of weaker checking. A workaround for a bug in some folks'
<assert.h> has been added. And some more things have been added to
tests, including a couple right at the end which are commented out
because the code currently flunks them (complex bug; fix coming).
Plus the usual minor cleanup.
New in alpha3.2: Assorted bits of cleanup and portability improvement
(the development base is now a BSDI system using GCC instead of an ancient
Sun system, and the newer compiler exposed some glitches). Fix for a
serious bug that affected REs using many [] (including REG_ICASE REs
because of the way they are implemented), *sometimes*, depending on
memory-allocation patterns. The header-file prototypes no longer name
the parameters, avoiding possible name conflicts. The possibility that
some clot has defined CHAR_MIN as (say) `-128' instead of `(-128)' is
now handled gracefully. "uchar" is no longer used as an internal type
name (too many people have the same idea). Still the same old lousy
performance, alas.
New in alpha3.1: Basically nothing, this release is just a bookkeeping
convenience. Stay tuned.
New in alpha3.0: Performance is no better, alas, but some fixes have been
made and some functionality has been added. (This is basically the "get
it out the door in time for 4.4" release.) One bug fix: regfree() didn't
free the main internal structure (how embarrassing). It is now possible
to put NULs in either the RE or the target string, using (resp.) a new
REG_PEND flag and the old REG_STARTEND flag. The REG_NOSPEC flag to
regcomp() makes all characters ordinary, so you can match a literal
string easily (this will become more useful when performance improves!).
There are now primitives to match beginnings and ends of words, although
the syntax is disgusting and so is the implementation. The REG_ATOI
debugging interface has changed a bit. And there has been considerable
internal cleanup of various kinds.
New in alpha2.3: Split change list out of README, and moved flags notes
into Makefile. Macro-ized the name of regex(7) in regex(3), since it has
to change for 4.4BSD. Cleanup work in engine.c, and some new regression
tests to catch tricky cases thereof.
New in alpha2.2: Out-of-date manpages updated. Regerror() acquires two
small extensions -- REG_ITOA and REG_ATOI -- which avoid debugging kludges
in my own test program and might be useful to others for similar purposes.
The regression test will now compile (and run) without REDEBUG. The
BRE \$ bug is fixed. Most uses of "uchar" are gone; it's all chars now.
Char/uchar parameters are now written int/unsigned, to avoid possible
portability problems with unpromoted parameters. Some unsigned casts have
been introduced to minimize portability problems with shifting into sign
New in alpha2.1: Lots of little stuff, cleanup and fixes. The one big
thing is that regex.h is now generated, using mkh, rather than being
supplied in the distribution; due to circularities in dependencies,
you have to build regex.h explicitly by "make h". The two known bugs
have been fixed (and the regression test now checks for them), as has a
problem with assertions not being suppressed in the absence of REDEBUG.
No performance work yet.
New in alpha2: Backslash-anything is an ordinary character, not an
error (except, of course, for the handful of backslashed metacharacters
in BREs), which should reduce script breakage. The regression test
checks *where* null strings are supposed to match, and has generally
been tightened up somewhat. Small bug fixes in parameter passing (not
harmful, but technically errors) and some other areas. Debugging
invoked by defining REDEBUG rather than not defining NDEBUG.
New in alpha+3: full prototyping for internal routines, using a little
helper program, mkh, which extracts prototypes given in stylized comments.
More minor cleanup. Buglet fix: it's CHAR_BIT, not CHAR_BITS. Simple
pre-screening of input when a literal string is known to be part of the
RE; this does wonders for performance.
New in alpha+2: minor bits of cleanup. Notably, the number "32" for the
word width isn't hardwired into regexec.c any more, the public header
file prototypes the functions if __STDC__ is defined, and some small typos
in the manpages have been fixed.
New in alpha+1: improvements to the manual pages, and an important
extension, the REG_STARTEND option to regexec().
/* character-class table */
static struct cclass {
char *name;
char *chars;
char *multis;
} cclasses[] = {
{ "alnum", "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
0123456789", "" },
{ "alpha", "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz",
"" },
{ "blank", " \t", "" },
{ "cntrl", "\007\b\t\n\v\f\r\1\2\3\4\5\6\16\17\20\21\22\23\24\
\25\26\27\30\31\32\33\34\35\36\37\177", "" },
{ "digit", "0123456789", "" },
{ "graph", "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
"" },
{ "lower", "abcdefghijklmnopqrstuvwxyz",
"" },
{ "print", "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
0123456789!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~ ",
"" },
{ "punct", "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~",
"" },
{ "space", "\t\n\v\f\r ", "" },
"" },
{ "xdigit", "0123456789ABCDEFabcdef",
"" },
{ NULL, 0, "" }
/* character-name table */
static struct cname {
char *name;
char code;
} cnames[] = {
{ "NUL", '\0' },
{ "SOH", '\001' },
{ "STX", '\002' },
{ "ETX", '\003' },
{ "EOT", '\004' },
{ "ENQ", '\005' },
{ "ACK", '\006' },
{ "BEL", '\007' },
{ "alert", '\007' },
{ "BS", '\010' },
{ "backspace", '\b' },
{ "HT", '\011' },
{ "tab", '\t' },
{ "LF", '\012' },
{ "newline", '\n' },
{ "VT", '\013' },
{ "vertical-tab", '\v' },
{ "FF", '\014' },
{ "form-feed", '\f' },
{ "CR", '\015' },
{ "carriage-return", '\r' },
{ "SO", '\016' },
{ "SI", '\017' },
{ "DLE", '\020' },