aboutsummaryrefslogtreecommitdiffhomepage
path: root/libslang/modules
diff options
context:
space:
mode:
Diffstat (limited to 'libslang/modules')
-rw-r--r--libslang/modules/Makefile.in56
-rw-r--r--libslang/modules/README66
-rw-r--r--libslang/modules/fcntl-module.c117
-rwxr-xr-xlibslang/modules/grep171
-rw-r--r--libslang/modules/newt-module.c91
-rw-r--r--libslang/modules/newt.sl14
-rw-r--r--libslang/modules/pcre-module.c618
-rw-r--r--libslang/modules/select-module.c238
-rw-r--r--libslang/modules/smg-module.c324
-rw-r--r--libslang/modules/smg.sl70
-rw-r--r--libslang/modules/template.c49
-rw-r--r--libslang/modules/termios-module.c440
-rw-r--r--libslang/modules/varray-module.c224
-rw-r--r--libslang/modules/varray.sl37
14 files changed, 2515 insertions, 0 deletions
diff --git a/libslang/modules/Makefile.in b/libslang/modules/Makefile.in
new file mode 100644
index 0000000..3d8a480
--- /dev/null
+++ b/libslang/modules/Makefile.in
@@ -0,0 +1,56 @@
+# -*- sh -*-
+MODULES = smg-module.so termios-module.so select-module.so fcntl-module.so \
+ varray-module.so pcre-module.so
+#---------------------------------------------------------------------------
+CC_SHARED = @CC_SHARED@
+#---------------------------------------------------------------------------
+# Installation location of the slang library
+#---------------------------------------------------------------------------
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+SLANG_INC = -I@includedir@
+SLANG_LIB = -L@libdir@ -lslang
+#---------------------------------------------------------------------------
+# Installation location of the modules
+#---------------------------------------------------------------------------
+MODULE_INSTALL_DIR = @libdir@/slang/modules
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+MKINSDIR = ../autoconf/mkinsdir.sh
+#---------------------------------------------------------------------------
+# DESTDIR is designed to facilitate making packages. Normally it is empty
+#---------------------------------------------------------------------------
+DESTDIR =
+DEST_MODULEDIR = $(DESTDIR)$(MODULE_INSTALL_DIR)
+#---------------------------------------------------------------------------
+RPATH = @RPATH@
+
+LIBS = $(RPATH) $(SLANG_LIB) $(DL_LIB) -lm
+INCS = $(SLANG_INC)
+
+all: $(MODULES)
+
+smg-module.so: smg-module.c
+ $(CC_SHARED) $(INCS) smg-module.c -o smg-module.so $(LIBS)
+newt-module.so: newt-module.c
+ $(CC_SHARED) $(INCS) newt-module.c -o newt-module.so -lnewt $(LIBS)
+termios-module.so: termios-module.c
+ $(CC_SHARED) $(INCS) termios-module.c -o termios-module.so $(LIBS)
+select-module.so: select-module.c
+ $(CC_SHARED) $(INCS) select-module.c -o select-module.so $(LIBS)
+fcntl-module.so: fcntl-module.c
+ $(CC_SHARED) $(INCS) fcntl-module.c -o fcntl-module.so $(LIBS)
+varray-module.so: varray-module.c
+ $(CC_SHARED) $(INCS) varray-module.c -o varray-module.so $(LIBS)
+pcre-module.so: pcre-module.c
+ $(CC_SHARED) $(INCS) pcre-module.c -o pcre-module.so -lpcre $(LIBS)
+
+install: all
+ -$(MKINSDIR) $(DEST_MODULEDIR)
+ @for i in $(MODULES); \
+ do \
+ echo $(INSTALL_DATA) $$i $(DEST_MODULEDIR); \
+ $(INSTALL_DATA) $$i $(DEST_MODULEDIR); \
+ done
+clean:
+ -/bin/rm -f $(MODULES) *~
diff --git a/libslang/modules/README b/libslang/modules/README
new file mode 100644
index 0000000..f6b1292
--- /dev/null
+++ b/libslang/modules/README
@@ -0,0 +1,66 @@
+This directory contains some examples of dynamically loaded modules
+that may be loaded via the `import' intrinsic function. If you choose
+to build these modules, do so only AFTER installing the slang library
+because the Makefile references the installed slang library location.
+
+The default installation location for the modules is in
+$(prefix)/lib/slang/modules.
+
+--------------------------------------------------------------------
+
+This directory contains some examples of dynamically loaded modules
+that may be loaded via the `import' intrinsic function:
+
+ import ("NAME");
+
+This intrinsic function is available to applications that enable it
+via a call to the `SLang_init_import' function. Of course, the OS
+must provide support for dynamic linking.
+
+When a slang script contains a line such as
+
+ import ("NAME");
+
+or
+
+ import ("NAME", "NAMESPACE");
+
+
+slang requests that the operating system dynamically link to a shared
+object called NAME-module.so. Then the slang library will call the
+function `init_NAME_ns' that NAME-module.so must define. This function
+must have the prototype:
+
+ int init_NAME_ns (char *namespace);
+
+and shall return 0 upon success, or -1 if an error occurred. The
+namespace argument corresponds to the second (option) parameter of the
+import intrinsic. This means that the user wishes to import the
+module into the specified namespace. To this end, the module must
+call one of the SLns_* functions to load intrinsics into a namespace.
+
+Optionally, the module may define a function called `deinit_NAME' that
+will be called by the interpreter to deinitialize the module. This
+function must have the prototype:
+
+ void deinit_NAME (void);
+
+To ensure the correct prototypes for these functions, the module
+should include the line:
+
+ SLANG_MODULE(name);
+
+SLANG_MODULE is a macro that expands into function prototypes.
+
+See the examples in this directory for more information.
+
+To run these modules, use the slsh program in ../slsh/.
+slsh.c is a program that embeds the interpreter and may be used to
+test slang scripts. In fact, it may be used to create unix executable
+scripts via, e.g.,
+
+#! /usr/bin/env slsh
+
+as the first line of the script. See ../slsh/scripts subdirectory for
+examples of this approach.
+
diff --git a/libslang/modules/fcntl-module.c b/libslang/modules/fcntl-module.c
new file mode 100644
index 0000000..7b329ab
--- /dev/null
+++ b/libslang/modules/fcntl-module.c
@@ -0,0 +1,117 @@
+/* Copyright (c) 2001 John E. Davis
+ * This file is part of the S-Lang library.
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Perl Artistic License.
+ */
+
+#include <stdio.h>
+#include <slang.h>
+
+#include <unistd.h>
+#include <string.h>
+#include <fcntl.h>
+#include <errno.h>
+
+SLANG_MODULE(fcntl);
+
+static int check_and_set_errno (int e)
+{
+#ifdef EINTR
+ if (e == EINTR)
+ return 0;
+#endif
+ (void) SLerrno_set_errno (e);
+ return -1;
+}
+
+static int do_fcntl_2 (SLFile_FD_Type *f, int cmd)
+{
+ int ret;
+ int fd;
+
+ if (-1 == SLfile_get_fd (f, &fd))
+ return -1;
+
+ while ((-1 == (ret = fcntl (fd, cmd)))
+ && (0 == check_and_set_errno (errno)))
+ ;
+
+ return ret;
+}
+
+static int do_fcntl_3_int (SLFile_FD_Type *f, int cmd, int flags)
+{
+ int ret;
+ int fd;
+
+
+ if (-1 == SLfile_get_fd (f, &fd))
+ return -1;
+
+ while ((-1 == (ret = fcntl (fd, cmd, flags)))
+ && (0 == check_and_set_errno (errno)))
+ ;
+
+ return ret;
+}
+
+static int fcntl_getfd (SLFile_FD_Type *f)
+{
+ return do_fcntl_2 (f, F_GETFD);
+}
+
+static int fcntl_setfd (SLFile_FD_Type *f, int *flags)
+{
+ return do_fcntl_3_int (f, F_SETFD, *flags);
+}
+
+static int fcntl_getfl (SLFile_FD_Type *f)
+{
+ return do_fcntl_2 (f, F_GETFL);
+}
+
+static int fcntl_setfl (SLFile_FD_Type *f, int *flags)
+{
+ return do_fcntl_3_int (f, F_SETFL, *flags);
+}
+
+#define F SLANG_FILE_FD_TYPE
+#define I SLANG_INT_TYPE
+static SLang_Intrin_Fun_Type Fcntl_Intrinsics [] =
+{
+ MAKE_INTRINSIC_1("fcntl_getfd", fcntl_getfd, I, F),
+ MAKE_INTRINSIC_2("fcntl_setfd", fcntl_setfd, I, F, I),
+ MAKE_INTRINSIC_1("fcntl_getfl", fcntl_getfl, I, F),
+ MAKE_INTRINSIC_2("fcntl_setfl", fcntl_setfl, I, F, I),
+
+ SLANG_END_INTRIN_FUN_TABLE
+};
+#undef I
+#undef F
+
+static SLang_IConstant_Type Fcntl_Consts [] =
+{
+ MAKE_ICONSTANT("FD_CLOEXEC", FD_CLOEXEC),
+ SLANG_END_ICONST_TABLE
+};
+
+int init_fcntl_module_ns (char *ns_name)
+{
+ SLang_NameSpace_Type *ns;
+
+ ns = SLns_create_namespace (ns_name);
+ if (ns == NULL)
+ return -1;
+
+ if ((-1 == SLns_add_intrin_fun_table (ns, Fcntl_Intrinsics, "__FCNTL__"))
+ || (-1 == SLns_add_iconstant_table (ns, Fcntl_Consts, NULL)))
+ return -1;
+
+ return 0;
+}
+
+/* This function is optional */
+void deinit_fcntl_module (void)
+{
+}
diff --git a/libslang/modules/grep b/libslang/modules/grep
new file mode 100755
index 0000000..a8f97d6
--- /dev/null
+++ b/libslang/modules/grep
@@ -0,0 +1,171 @@
+#!/usr/bin/env slsh
+
+% This is a simple-minded implementation of a highlighting grep program
+% designed to test the pcre module.
+import ("pcre");
+
+static define usage ()
+{
+ ()=fprintf(stderr, "Usage: %s [-inl] pattern [files...]\n", __argv[0]);
+ exit (1);
+}
+
+static variable MATCH = 1;
+static variable LINENUM = 2;
+static variable FILENAME = 4;
+static variable Output_Format = 0;
+
+static define grep (file, p)
+{
+ variable fp;
+
+ if (file == NULL)
+ fp = stdin;
+ else
+ fp = fopen (file, "r");
+
+ if (fp == NULL)
+ {
+ fprintf (stderr, "*** Unable to open %s\n", file);
+ return;
+ }
+
+ variable linenum = 0;
+ foreach (fp) using ("line")
+ {
+ variable str = ();
+ linenum++;
+
+ if (pcre_exec (p, str, 0))
+ {
+ variable i0, i1, i;
+
+ switch (Output_Format)
+ {
+ case FILENAME:
+ () = fprintf (stdout, "%s\n", file);
+ return;
+ }
+ {
+ case LINENUM:
+ () = fprintf (stdout, "%d\n", linenum);
+ continue;
+ }
+ {
+ case (MATCH|LINENUM):
+
+ () = fprintf (stdout, "%d:", linenum);
+ }
+ {
+ case (LINENUM|FILENAME):
+ () = fprintf (stdout, "%s:%d\n", file, linenum);
+ continue;
+ }
+ {
+ case (LINENUM|FILENAME|MATCH):
+ () = fprintf (stdout, "%s:%d:", file, linenum);
+ }
+ {
+ case (FILENAME|MATCH):
+ () = fprintf (stdout, "%s:", file);
+ }
+
+ do
+ {
+ i = pcre_nth_match (p, 0);
+ i0 = i[0];
+ i1 = i[1];
+ if (i1 <= i0)
+ break;
+ if (i0 > 0)
+ () = fprintf (stdout, "%s", str[[0:i0-1]]);
+ () = fprintf (stdout, "\e[7m%s\e[m", str[[i0:i1-1]]);
+ str = str[[i1:]];
+ }
+ while (pcre_exec (p, str, 0));
+ () = fprintf (stdout, "%s", str);
+ }
+ }
+}
+
+static define main (argc, argv)
+{
+ variable i;
+ variable files, pattern;
+ variable options;
+
+ i = 1;
+ files = NULL;
+ pattern = NULL;
+ options = 0;
+ Output_Format = MATCH;
+
+ while (i < argc)
+ {
+ variable arg = __argv[i];
+ i++;
+
+ if (arg[0] == '-')
+ {
+ foreach (arg[[1:]])
+ {
+ variable ch = ();
+ switch (ch)
+ {
+ case 'i':
+ options |= PCRE_CASELESS;
+ }
+ {
+ case 'l':
+ Output_Format &= ~MATCH;
+ Output_Format |= FILENAME;
+ }
+ {
+ case 'n':
+ Output_Format |= LINENUM;
+ }
+ {
+ () = fprintf (stderr, "Unsupported option: '%c'\n", ch);
+ exit (1);
+ }
+ }
+ continue;
+ }
+
+ pattern = arg;
+ break;
+ }
+
+ if (pattern == NULL)
+ usage ();
+
+ variable p = pcre_compile (pattern, options);
+
+ if (i == __argc)
+ {
+ if (isatty (stdin))
+ usage ();
+
+ Output_Format &= ~FILENAME;
+ grep (NULL, p);
+ return;
+ }
+
+ files = argv[[i:]];
+
+ if (length(files) > 1)
+ Output_Format |= FILENAME;
+
+ foreach (files)
+ {
+ variable f = ();
+ grep (f, p);
+ }
+}
+
+public define slsh_main ()
+{
+ main (__argc, __argv);
+ exit (0);
+}
+
diff --git a/libslang/modules/newt-module.c b/libslang/modules/newt-module.c
new file mode 100644
index 0000000..9788ed1
--- /dev/null
+++ b/libslang/modules/newt-module.c
@@ -0,0 +1,91 @@
+/* This module implements and interface to the Newt library */
+#include <stdio.h>
+#include <slang.h>
+#include <newt.h>
+
+SLANG_MODULE(newt);
+
+static int Ok_To_Draw;
+
+static void init (void)
+{
+ newtInit ();
+ Ok_To_Draw = 1;
+}
+
+static void cls (void)
+{
+ if (Ok_To_Draw)
+ newtCls ();
+}
+
+static void draw_root_text (int *c, int *r, char *s)
+{
+ if (Ok_To_Draw)
+ newtDrawRootText (*c, *r, s);
+}
+
+static void open_window (int *c, int *r, int *dc, int *dr, char *title)
+{
+ if (Ok_To_Draw)
+ newtOpenWindow (*c, *r, *dc, *dr, title);
+}
+
+static void refresh (void)
+{
+ if (Ok_To_Draw)
+ newtRefresh ();
+}
+
+static void finished (void)
+{
+ if (Ok_To_Draw)
+ newtFinished ();
+ Ok_To_Draw = 0;
+}
+
+#define I SLANG_INT_TYPE
+#define S SLANG_STRING_TYPE
+
+static SLang_Intrin_Fun_Type Module_Funs [] =
+{
+ MAKE_INTRINSIC_0("newtInit", init, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("newtCls", cls, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_IIS("newtDrawRootText", draw_root_text, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_5("newtOpenWindow", open_window, SLANG_VOID_TYPE, I,I,I,I,S),
+ MAKE_INTRINSIC_0("newtRefresh", refresh, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("NewtFinished", finished, SLANG_VOID_TYPE),
+
+ SLANG_END_TABLE
+};
+
+static SLang_Intrin_Var_Type Module_Variables [] =
+{
+ SLANG_END_TABLE
+};
+
+static SLang_IConstant_Type Module_Constants [] =
+{
+ SLANG_END_TABLE
+};
+
+
+int init_newt_module_ns (char *ns)
+{
+ if ((-1 == SLns_add_intrin_fun_table (ns, Module_Funs, "__NEWT__"))
+ || (-1 == SLns_add_intrin_var_table (ns, Module_Variables, NULL))
+ || (-1 == SLns_add_iconstant_table (ns, Module_Constants, NULL)))
+ return -1;
+
+ Ok_To_Draw = 0;
+
+ (void) SLang_add_cleanup_function (finished);
+
+ return 0;
+}
+
+/* This function is optional */
+void deinit_newt_module (void)
+{
+ finished ();
+}
diff --git a/libslang/modules/newt.sl b/libslang/modules/newt.sl
new file mode 100644
index 0000000..0864d5e
--- /dev/null
+++ b/libslang/modules/newt.sl
@@ -0,0 +1,14 @@
+import ("newt");
+
+newtInit ();
+%newtCls ();
+newtDrawRootText (0, 0, "Root Text");
+newtOpenWindow (3,4,20, 20, "First Window");
+newtOpenWindow (8, 10,20, 20, "Second Window");
+
+newtRefresh ();
+sleep (5);
+NewtFinished ();
+
+exit (0);
+
diff --git a/libslang/modules/pcre-module.c b/libslang/modules/pcre-module.c
new file mode 100644
index 0000000..926e477
--- /dev/null
+++ b/libslang/modules/pcre-module.c
@@ -0,0 +1,618 @@
+#include <stdio.h>
+#include <slang.h>
+#include <pcre.h>
+
+SLANG_MODULE(pcre);
+
+static int PCRE_Type_Id;
+
+typedef struct
+{
+ pcre *p;
+ pcre_extra *extra;
+ int *ovector;
+ unsigned int ovector_len; /* must be a multiple of 3 */
+ unsigned int num_matches; /* return value of pcre_exec (>= 1)*/
+}
+PCRE_Type;
+
+static void free_pcre_type (PCRE_Type *pt)
+{
+ if (pt->ovector != NULL)
+ SLfree ((char *) pt->ovector);
+
+ SLfree ((char *) pt);
+}
+
+static SLang_MMT_Type *allocate_pcre_type (pcre *p, pcre_extra *extra)
+{
+ PCRE_Type *pt;
+ SLang_MMT_Type *mmt;
+ int ovector_len;
+
+ pt = (PCRE_Type *) SLmalloc (sizeof (PCRE_Type));
+ if (pt == NULL)
+ return NULL;
+ memset ((char *) pt, 0, sizeof (PCRE_Type));
+
+ pt->p = p;
+ pt->extra = extra;
+
+ if (0 != pcre_fullinfo (p, extra, PCRE_INFO_CAPTURECOUNT, &ovector_len))
+ {
+ free_pcre_type (pt);
+ SLang_verror (SL_INTRINSIC_ERROR, "pcre_fullinfo failed");
+ return NULL;
+ }
+
+ ovector_len += 1; /* allow for pattern matched */
+ ovector_len *= 3; /* required to be multiple of 3 */
+ if (NULL == (pt->ovector = (int *)SLmalloc (ovector_len * sizeof (int))))
+ {
+ free_pcre_type (pt);
+ return NULL;
+ }
+ pt->ovector_len = ovector_len;
+
+ if (NULL == (mmt = SLang_create_mmt (PCRE_Type_Id, (VOID_STAR) pt)))
+ {
+ free_pcre_type (pt);
+ return NULL;
+ }
+ return mmt;
+}
+
+static int _pcre_compile_1 (char *pattern, int options)
+{
+ pcre *p;
+ pcre_extra *extra;
+ SLCONST char *err;
+ int erroffset;
+ unsigned char *table;
+ SLang_MMT_Type *mmt;
+
+ table = NULL;
+ p = pcre_compile (pattern, options, &err, &erroffset, table);
+ if (NULL == p)
+ {
+ SLang_verror (SL_INTRINSIC_ERROR, "Error compiling pattern '%s' at offset %d: %s",
+ pattern, erroffset, err);
+ return -1;
+ }
+
+ extra = pcre_study (p, 0, &err);
+ /* apparantly, a NULL return is ok */
+ if (err != NULL)
+ {
+ SLang_verror (SL_INTRINSIC_ERROR, "pcre_study failed: %s", err);
+ pcre_free (p);
+ return -1;
+ }
+
+ if (NULL == (mmt = allocate_pcre_type (p, extra)))
+ {
+ pcre_free ((char *) p);
+ pcre_free ((char *) extra);
+ return -1;
+ }
+
+ if (-1 == SLang_push_mmt (mmt))
+ {
+ SLang_free_mmt (mmt);
+ return -1;
+ }
+ return 0;
+}
+
+static void _pcre_compile (void)
+{
+ char *pattern;
+ int options = 0;
+
+ switch (SLang_Num_Function_Args)
+ {
+ case 2:
+ if (-1 == SLang_pop_integer (&options))
+ return;
+ /* drop */
+ case 1:
+ default:
+ if (-1 == SLang_pop_slstring (&pattern))
+ return;
+ }
+ (void) _pcre_compile_1 (pattern, options);
+ SLang_free_slstring (pattern);
+}
+
+
+
+/* returns number of matches */
+static int _pcre_exec_1 (PCRE_Type *pt, char *str, int pos, int options)
+{
+ int rc;
+ unsigned int len;
+
+ pt->num_matches = 0;
+ len = strlen (str);
+ if ((unsigned int) pos > len)
+ return 0;
+
+ rc = pcre_exec (pt->p, pt->extra, str, len, pos,
+ options, pt->ovector, pt->ovector_len);
+
+ if (rc == PCRE_ERROR_NOMATCH)
+ return 0;
+
+ if (rc <= 0)
+ {
+ SLang_verror (SL_INTRINSIC_ERROR, "pcre_exec returned %d", rc);
+ return -1;
+ }
+ pt->num_matches = (unsigned int) rc;
+ return rc;
+}
+
+static int _pcre_exec (void)
+{
+ PCRE_Type *p;
+ SLang_MMT_Type *mmt;
+ char *str;
+ int pos = 0;
+ int options = 0;
+ int ret = -1;
+
+ switch (SLang_Num_Function_Args)
+ {
+ case 4:
+ if (-1 == SLang_pop_integer (&options))
+ return -1;
+ case 3:
+ if (-1 == SLang_pop_integer (&pos))
+ return -1;
+ default:
+ if (-1 == SLang_pop_slstring (&str))
+ return -1;
+
+ if (NULL == (mmt = SLang_pop_mmt (PCRE_Type_Id)))
+ goto free_and_return;
+ p = SLang_object_from_mmt (mmt);
+ }
+ ret = _pcre_exec_1 (p, str, pos, options);
+
+ free_and_return:
+ SLang_free_slstring (str);
+ SLang_free_mmt (mmt);
+ return ret;
+}
+
+
+static int get_nth_start_stop (PCRE_Type *pt, unsigned int n,
+ unsigned int *a, unsigned int *b)
+{
+ int start, stop;
+
+ if (n >= pt->num_matches)
+ return -1;
+
+ start = pt->ovector[2*n];
+ stop = pt->ovector[2*n+1];
+ if ((start < 0) || (stop < start))
+ return -1;
+
+ *a = (unsigned int) start;
+ *b = (unsigned int) stop;
+ return 0;
+}
+
+static void _pcre_nth_match (PCRE_Type *pt, int *np)
+{
+ unsigned int start, stop;
+ SLang_Array_Type *at;
+ int two = 2;
+ int *data;
+
+ if (-1 == get_nth_start_stop (pt, (unsigned int) *np, &start, &stop))
+ {
+ SLang_push_null ();
+ return;
+ }
+
+ if (NULL == (at = SLang_create_array (SLANG_INT_TYPE, 0, NULL, &two, 1)))
+ return;
+
+ data = (int *)at->data;
+ data[0] = (int)start;
+ data[1] = (int)stop;
+ (void) SLang_push_array (at, 1);
+}
+
+static void _pcre_nth_substr (PCRE_Type *pt, char *str, int *np)
+{
+ unsigned int start, stop;
+ unsigned int len;
+
+ len = strlen (str);
+
+ if ((-1 == get_nth_start_stop (pt, (unsigned int) *np, &start, &stop))
+ || (start > len) || (stop > len))
+ {
+ SLang_push_null ();
+ return;
+ }
+
+ str = SLang_create_nslstring (str + start, stop - start);
+ (void) SLang_push_string (str);
+ SLang_free_slstring (str);
+}
+
+/* This function converts a slang RE to a pcre expression. It performs the
+ * following transformations:
+ * ( --> \(
+ * ) --> \)
+ * # --> \#
+ * | --> \|
+ * { --> \{
+ * } --> \}
+ * \< --> \b
+ * \> --> \b
+ * \C --> (?i)
+ * \c --> (?-i)
+ * \( --> (
+ * \) --> )
+ * \{ --> {
+ * \} --> }
+ * Anything else?
+ */
+static char *_slang_to_pcre (char *slpattern)
+{
+ char *pattern, *p, *s;
+ unsigned int len;
+ int in_bracket;
+ char ch;
+
+ len = strlen (slpattern);
+ pattern = SLmalloc (3*len + 1);
+ if (pattern == NULL)
+ return NULL;
+
+ p = pattern;
+ s = slpattern;
+ in_bracket = 0;
+ while ((ch = *s++) != 0)
+ {
+ switch (ch)
+ {
+ case '{':
+ case '}':
+ case '(':
+ case ')':
+ case '#':
+ case '|':
+ if (0 == in_bracket) *p++ = '\\';
+ *p++ = ch;
+ break;
+
+ case '[':
+ in_bracket = 1;
+ *p++ = ch;
+ break;
+
+ case ']':
+ in_bracket = 0;
+ *p++ = ch;
+ break;
+
+ case '\\':
+ ch = *s++;
+ switch (ch)
+ {
+ case 0:
+ s--;
+ break;
+
+ case '<':
+ case '>':
+ *p++ = '\\'; *p++ = 'b';
+ break;
+
+ case '(':
+ case ')':
+ case '{':
+ case '}':
+ *p++ = ch;
+ break;
+
+ case 'C':
+ *p++ = '('; *p++ = '?'; *p++ = 'i'; *p++ = ')';
+ break;
+ case 'c':
+ *p++ = '('; *p++ = '?'; *p++ = '-'; *p++ = 'i'; *p++ = ')';
+ break;
+
+ default:
+ *p++ = '\\';
+ *p++ = ch;
+ }
+ break;
+
+ default:
+ *p++ = ch;
+ break;
+ }
+ }
+ *p = 0;
+
+ s = SLang_create_slstring (pattern);
+ SLfree (pattern);
+ return s;
+}
+
+static void slang_to_pcre (char *pattern)
+{
+ /* NULL ok in code below */
+ pattern = _slang_to_pcre (pattern);
+ (void) SLang_push_string (pattern);
+ SLang_free_slstring (pattern);
+}
+
+static void destroy_pcre (SLtype type, VOID_STAR f)
+{
+ PCRE_Type *pt;
+ (void) type;
+
+ pt = (PCRE_Type *) f;
+ if (pt->extra != NULL)
+ pcre_free ((char *) pt->extra);
+ if (pt->p != NULL)
+ pcre_free ((char *) pt->p);
+ free_pcre_type (pt);
+}
+
+#define DUMMY_PCRE_TYPE 255
+#define P DUMMY_PCRE_TYPE
+#define I SLANG_INT_TYPE
+#define V SLANG_VOID_TYPE
+#define S SLANG_STRING_TYPE
+static SLang_Intrin_Fun_Type PCRE_Intrinsics [] =
+{
+ MAKE_INTRINSIC_0("pcre_compile", _pcre_compile, V),
+/*%+
+ *\function{pcre_compile}
+ *\synopsis{Compile a regular expression}
+ *\usage{PCRE_Type pcre_compile (String_Type pattern [, Int_Type options])}
+ *\description
+ * The \var{pcre_compile} function compiles a PCRE style regular expression
+ * and returns the result. The optional \var{options} argument may be used
+ * to provide addition information affecting the compilation of the pattern.
+ * Specifically, it is a bit-mapped value formed from the logical-or of zero
+ * or more of the following symbolic constants:
+ *#v+
+ * PCRE_ANCHORED Force the match to be at the start of a string
+ * PCRE_CASELESS Matches are to be case-insensitive
+ * PCRE_DOLLAR_ENDONLY (See PCRE docs for more information)
+ * PCRE_DOTALL The dot pattern matches all characters
+ * PCRE_EXTENDED Ignore whitespace in the pattern
+ * PCRE_EXTRA (See PCRE docs for features this activates)
+ * PCRE_MULTILINE Treat the subject string as multi-lines
+ * PCRE_UNGREEDY Make the matches greedy
+ * PCRE_UTF8 Regard the pattern and subject strings as UTF-8
+ *#v-
+ * Many of these flags may be set within the pattern itself. See the PCRE
+ * library documentation for more information about the precise details
+ * of these flags and the supported regular expressions.
+ *
+ * Upon success, this function returns a \var{PCRE_Type} object representing
+ * the compiled patterned. If compilation fails, an error will be thrown.
+ *\seealso{pcre_exec, pcre_nth_match, pcre_nth_substr}
+ *%-
+ */
+ MAKE_INTRINSIC_0("pcre_exec", _pcre_exec, I),
+/*%+
+ *\function{pcre_exec}
+ *\synopsis{Match a string against a compiled PCRE pattern}
+ *\usage{Int_Type pcre_exec(p, str [,pos [,options]]);
+ *#v+
+ * PCRE_Type p;
+ * String_Type str;
+ * Int_Type pos, options;
+ *#v-
+ *\description
+ * The \var{pcre_exec} function applies a pre-compiled pattern \var{p} to a
+ * string \var{str} and returns the result of the match. The optional third
+ * argument \var{pos} may be used to specify the point, as an offset from the
+ * start of the string, where matching is to start. The fourth argument, if
+ * present, may be used to provide additional information about how matching
+ * is to take place. Its value may be specified as a logical-or of zero or
+ * more of the following flags:
+ *#v+
+ * PCRE_NOTBOL
+ * The first character in the string is not at the beginning of a line.
+ * PCRE_NOTEOL
+ * The last character in the string is not at the end of a line.
+ * PCRE_NOTEMPTY
+ * An empty string is not a valid match.
+ *#v-
+ * See the PCRE library documentation for more information about the meaning
+ * of these flags.
+ *
+ * Upon success, this function returns a positive integer equal to 1 plus the
+ * number of so-called captured substrings. It returns 0 if the pattern
+ * fails to match the string.
+ *\seealso{pcre_compile, pcre_nth_match, pcre_nth_substr}
+ *%-
+ */
+ MAKE_INTRINSIC_2("pcre_nth_match", _pcre_nth_match, V, P, I),
+/*%+
+ *\function{pcre_nth_match}
+ *\synopsis{Return the location of the nth match of a PCRE}
+ *\usage{Int_Type[2] pcre_nth_match (PCRE_Type p, Int_Type nth)}
+ *\description
+ * The \var{pcre_nth_match} function returns an integer array whose values
+ * specify the locations of the beginning and end of the \var{nth} captured
+ * substrings of the most recent call to \var{pcre_exec} with the compiled
+ * pattern. A value of \var{nth} equal to 0 represents the substring
+ * representing the entire match of the pattern.
+ *
+ * If the \var{nth} match did not take place, the function returns \var{NULL}.
+ *\example
+ * After the execution of:
+ *#v+
+ * str = "Error in file foo.c, line 127, column 10";
+ * pattern = "file ([^,]+), line (\\d+)";
+ * p = pcre_compile (pattern);
+ * if (pcre_exec (p, str))
+ * {
+ * match_pos = pcre_nth_match (p, 0);
+ * file_pos = pcre_nth_match (p, 1);
+ * line_pos = pcre_nth_match (p, 2);
+ * }
+ *#v-
+ * \exmp{match_pos} will be set to \exmp{[9,29]}, \exmp{file_pos} to \exmp{[14,19,]}
+ * and \exmp{line_pos} to \exmp{[26,29]}. These integer arrays may be used to
+ * extract the substrings matched by the pattern, e.g.,
+ *#v+
+ * file = substr (str, file_pos[0]+1, file_pos[1]-file_pos[0]);
+ *#v-
+ * Alternatively, the function \var{pcre_nth_substr} may be used to get the
+ * matched substrings:
+ *#v+
+ * file = pcre_nth_substr (p, str, 0);
+ *#v-
+ *\seealso{pcre_compile, pcre_exec, pcre_nth_substr}
+ *%-
+ */
+ MAKE_INTRINSIC_3("pcre_nth_substr", _pcre_nth_substr, V, P, S, I),
+/*%+
+ *\function{pcre_nth_substr}
+ *\synopsis{Extract the nth substring from a PCRE match}
+ *\usage{String_Type pcre_nth_substr (PCRE_Type p, String_Type str, Int_Type nth)}
+ *\description
+ * This function may be used to extract the \var{nth} captured substring
+ * resulting from the most recent use of the compiled pattern \var{p} by the
+ * \var{pcre_exec} function. Unlike \var{pcre_nth_match}, this function returns
+ * the specified captured substring itself and not the position of the substring.
+ * For this reason, the subject string of the pattern is a required argument.
+ *\seealso{pcre_compile, pcre_exec, pcre_nth_match}
+ *%-
+ */
+ MAKE_INTRINSIC_1("slang_to_pcre", slang_to_pcre, V, S),
+/*%+
+ *\function{slang_to_pcre}
+ *\synopsis{Convert a S-Lang regular expression to a PCRE one}
+ *\usage{String_Type slang_to_pcre (String_Type pattern)}
+ *\description
+ * This function may be used to convert a slang regular expression to a PCRE
+ * compatible one. The converted is returned.
+ *\seealso{pcre_compile, string_match}
+ *%-
+ */
+ SLANG_END_INTRIN_FUN_TABLE
+};
+
+static SLang_IConstant_Type PCRE_Consts [] =
+{
+ /* compile options */
+ MAKE_ICONSTANT("PCRE_ANCHORED", PCRE_ANCHORED),
+ MAKE_ICONSTANT("PCRE_CASELESS", PCRE_CASELESS),
+ MAKE_ICONSTANT("PCRE_DOLLAR_ENDONLY", PCRE_DOLLAR_ENDONLY),
+ MAKE_ICONSTANT("PCRE_DOTALL", PCRE_DOTALL),
+ MAKE_ICONSTANT("PCRE_EXTENDED", PCRE_EXTENDED),
+ MAKE_ICONSTANT("PCRE_EXTRA", PCRE_EXTRA),
+ MAKE_ICONSTANT("PCRE_MULTILINE", PCRE_MULTILINE),
+ MAKE_ICONSTANT("PCRE_UNGREEDY", PCRE_UNGREEDY),
+ MAKE_ICONSTANT("PCRE_UTF8", PCRE_UTF8),
+
+ /* exec options */
+ MAKE_ICONSTANT("PCRE_NOTBOL", PCRE_NOTBOL),
+ MAKE_ICONSTANT("PCRE_NOTEOL", PCRE_NOTEOL),
+ MAKE_ICONSTANT("PCRE_NOTEMPTY", PCRE_NOTEMPTY),
+ SLANG_END_ICONST_TABLE
+};
+
+#undef P
+#undef I
+#undef V
+#undef S
+
+static void patchup_intrinsic_table (SLang_Intrin_Fun_Type *table,
+ unsigned char dummy, unsigned char type)
+{
+ while (table->name != NULL)
+ {
+ unsigned int i, nargs;
+ unsigned char *args;
+
+ nargs = table->num_args;
+ args = table->arg_types;
+ for (i = 0; i < nargs; i++)
+ {
+ if (args[i] == dummy)
+ args[i] = type;
+ }
+
+ /* For completeness */
+ if (table->return_type == dummy)
+ table->return_type = type;
+
+ table++;
+ }
+}
+
+
+static int register_pcre_type (void)
+{
+ SLang_Class_Type *cl;
+
+ if (NULL == (cl = SLclass_allocate_class ("PCRE_Type")))
+ return -1;
+
+ if (-1 == SLclass_set_destroy_function (cl, destroy_pcre))
+ return -1;
+
+ /* By registering as SLANG_VOID_TYPE, slang will dynamically allocate a
+ * type.
+ */
+ if (-1 == SLclass_register_class (cl, SLANG_VOID_TYPE, sizeof (PCRE_Type), SLANG_CLASS_TYPE_MMT))
+ return -1;
+
+ PCRE_Type_Id = SLclass_get_class_id (cl);
+ patchup_intrinsic_table (PCRE_Intrinsics, DUMMY_PCRE_TYPE, PCRE_Type_Id);
+
+ return 0;
+}
+
+static void *do_malloc (size_t n)
+{
+ return (void *) SLmalloc (n);
+}
+
+static void do_free (void *x)
+{
+ SLfree ((char *) x);
+}
+
+int init_pcre_module_ns (char *ns_name)
+{
+ SLang_NameSpace_Type *ns = SLns_create_namespace (ns_name);
+ if (ns == NULL)
+ return -1;
+
+ if (-1 == register_pcre_type ())
+ return -1;
+
+ pcre_malloc = do_malloc;
+ pcre_free = do_free;
+
+ if ((-1 == SLns_add_intrin_fun_table (ns, PCRE_Intrinsics, "__PCRE__"))
+ || (-1 == SLns_add_iconstant_table (ns, PCRE_Consts, NULL)))
+ return -1;
+
+ return 0;
+}
+
+
+/* This function is optional */
+void deinit_pcre_module (void)
+{
+}
+
diff --git a/libslang/modules/select-module.c b/libslang/modules/select-module.c
new file mode 100644
index 0000000..f085152
--- /dev/null
+++ b/libslang/modules/select-module.c
@@ -0,0 +1,238 @@
+/* Copyright (c) 2001 John E. Davis
+ * This file is part of the S-Lang library.
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Perl Artistic License.
+ */
+#include <stdio.h>
+#include <slang.h>
+
+#include <sys/time.h>
+#include <sys/types.h>
+#include <unistd.h>
+#include <string.h>
+#include <errno.h>
+
+SLANG_MODULE(select);
+
+static int pop_fd_set (SLang_Array_Type **ats,
+ fd_set **fd_set_p, fd_set *fd_set_buf,
+ int *max_n)
+{
+ unsigned int num, i;
+ SLang_Array_Type *at;
+ SLFile_FD_Type **f;
+
+ *ats = NULL;
+ *fd_set_p = NULL;
+
+ if (SLang_peek_at_stack () == SLANG_NULL_TYPE)
+ return SLang_pop_null ();
+
+ if (-1 == SLang_pop_array_of_type (&at, SLANG_FILE_FD_TYPE))
+ return -1;
+
+ FD_ZERO(fd_set_buf);
+ *fd_set_p = fd_set_buf;
+
+ *ats = at;
+ num = at->num_elements;
+ f = (SLFile_FD_Type **) at->data;
+
+ for (i = 0; i < num; i++)
+ {
+ int fd;
+
+ if (-1 == SLfile_get_fd (f[i], &fd))
+ continue;
+
+ if (fd > *max_n)
+ *max_n = fd;
+
+ FD_SET(fd, fd_set_buf);
+ }
+
+ return 0;
+}
+
+static SLang_Array_Type *do_fdisset (int nready, SLang_Array_Type *fds, fd_set *fdset)
+{
+ SLang_Array_Type *at;
+ unsigned int i, num;
+ SLFile_FD_Type **f;
+
+ if (fds == NULL)
+ nready = 0;
+
+ if (nready)
+ {
+ nready = 0;
+ num = fds->num_elements;
+ f = (SLFile_FD_Type **) fds->data;
+ for (i = 0; i < num; i++)
+ {
+ int fd;
+
+ if (-1 == SLfile_get_fd (f[i], &fd))
+ continue;
+
+ if (FD_ISSET(fd, fdset))
+ nready++;
+ }
+ }
+
+ at = SLang_create_array (SLANG_INT_TYPE, 0, NULL, &nready, 1);
+ if (at == NULL)
+ return NULL;
+
+ if (nready)
+ {
+ int *indx = (int *) at->data;
+ f = (SLFile_FD_Type **) fds->data;
+ num = fds->num_elements;
+ for (i = 0; i < num; i++)
+ {
+ int fd;
+
+ if (-1 == SLfile_get_fd (f[i], &fd))
+ continue;
+
+ if (FD_ISSET(fd, fdset))
+ *indx++ = (int) i;
+ }
+ }
+
+ return at;
+}
+
+static int push_select_struct (int num,
+ SLang_Array_Type *at_read,
+ SLang_Array_Type *at_write,
+ SLang_Array_Type *at_except,
+ fd_set *readfs, fd_set *writefds, fd_set *exceptfds)
+{
+ char *field_names [4];
+ unsigned char field_types[4];
+ VOID_STAR field_values [4];
+ SLang_Array_Type *iread, *iwrite, *iexcept;
+
+ iread = iwrite = iexcept = NULL;
+
+ field_names[0] = "nready";
+ field_names[1] = "iread";
+ field_names[2] = "iwrite";
+ field_names[3] = "iexcept";
+ field_types[0] = SLANG_INT_TYPE;
+ field_types[1] = SLANG_ARRAY_TYPE;
+ field_types[2] = SLANG_ARRAY_TYPE;
+ field_types[3] = SLANG_ARRAY_TYPE;
+ field_values[0] = &num;
+
+ if ((NULL == (iread = do_fdisset (num, at_read, readfs)))
+ || (NULL == (iwrite = do_fdisset (num, at_write, writefds)))
+ || (NULL == (iexcept = do_fdisset (num, at_except, exceptfds))))
+ {
+ SLang_free_array (iread);
+ SLang_free_array (iwrite);
+ return -1;
+ }
+
+ field_values[1] = &iread;
+ field_values[2] = &iwrite;
+ field_values[3] = &iexcept;
+
+ /* Note: This function call pushes the struct and frees it upon error. */
+ return SLstruct_create_struct (4, field_names, field_types, field_values);
+}
+
+
+/* Usage: Struct_Type select (R[],W[],E[],TIME) */
+
+static void select_intrin (double *secsp)
+{
+ SLang_Array_Type *at_read, *at_write, *at_except;
+ fd_set readfs_buf, writefds_buf, exceptfds_buf;
+ fd_set readfs_save_buf, writefds_save_buf, exceptfds_save_buf;
+ fd_set *readfs, *writefds, *exceptfds;
+ struct timeval tv, *tv_ptr;
+ double secs;
+ int ret, n;
+
+ secs = *secsp;
+ if (secs < 0.0) tv_ptr = NULL;
+ else
+ {
+ tv.tv_sec = (unsigned long) secs;
+ tv.tv_usec = (unsigned long) ((secs - tv.tv_sec) * 1e6);
+ tv_ptr = &tv;
+ }
+
+ n = 0;
+ if (-1 == pop_fd_set (&at_except, &exceptfds, &exceptfds_buf, &n))
+ return;
+ if (-1 == pop_fd_set (&at_write, &writefds, &writefds_buf, &n))
+ {
+ SLang_free_array (at_except);
+ return;
+ }
+ if (-1 == pop_fd_set (&at_read, &readfs, &readfs_buf, &n))
+ goto free_return;
+
+ readfs_save_buf = readfs_buf;
+ writefds_save_buf = writefds_buf;
+ exceptfds_save_buf = exceptfds_buf;
+
+ n += 1;
+ while (-1 == (ret = select (n, readfs, writefds, exceptfds, tv_ptr)))
+ {
+#ifdef EINTR
+ if (errno == EINTR)
+ {
+ readfs_buf = readfs_save_buf;
+ writefds_buf = writefds_save_buf;
+ exceptfds_buf = exceptfds_save_buf;
+ continue;
+ }
+#endif
+ (void) SLerrno_set_errno (errno);
+ break;
+ }
+
+ if (ret == -1)
+ (void) SLang_push_null ();
+ else
+ (void) push_select_struct (ret, at_read, at_write, at_except,
+ readfs, writefds, exceptfds);
+
+
+ free_return:
+ SLang_free_array (at_read);
+ SLang_free_array (at_write);
+ SLang_free_array (at_except);
+}
+
+static SLang_Intrin_Fun_Type Select_Intrinsics [] =
+{
+ MAKE_INTRINSIC_1("select", select_intrin, SLANG_VOID_TYPE, SLANG_DOUBLE_TYPE),
+ SLANG_END_INTRIN_FUN_TABLE
+};
+
+
+int init_select_module_ns (char *ns_name)
+{
+ SLang_NameSpace_Type *ns;
+
+ ns = SLns_create_namespace (ns_name);
+ if (ns == NULL)
+ return -1;
+
+ if (-1 == SLns_add_intrin_fun_table (ns, Select_Intrinsics, "__SELECT__"))
+ return -1;
+
+ return 0;
+}
+
+/* This function is optional */
+void deinit_select_module (void)
+{
+}
diff --git a/libslang/modules/smg-module.c b/libslang/modules/smg-module.c
new file mode 100644
index 0000000..12a1d90
--- /dev/null
+++ b/libslang/modules/smg-module.c
@@ -0,0 +1,324 @@
+/* This module implements and interface to the SLang SMG routines */
+#include <stdio.h>
+#include <slang.h>
+
+SLANG_MODULE(smg);
+
+/* If this is +1, the then it is ok to call the SLsmg routines. If it is
+ * 0, then only SLsmg_init_smg may be called. If it is -1, then SLsmg is
+ * suspended and one must call SLsmg_resume_smg.
+ */
+
+static int Smg_Initialized;
+
+static void smg_write_to_status_line (char *s)
+{
+ if (Smg_Initialized <= 0)
+ return;
+
+ (void) SLtt_write_to_status_line (s, 0);
+}
+
+
+static void smg_suspend_smg (void)
+{
+ if (Smg_Initialized <= 0)
+ return;
+
+ (void) SLsmg_suspend_smg ();
+ Smg_Initialized = -1;
+}
+
+static void smg_resume_smg (void)
+{
+ if (Smg_Initialized != -1)
+ return;
+
+ (void) SLsmg_resume_smg ();
+ Smg_Initialized = 1;
+}
+
+static void smg_erase_eol (void)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsmg_erase_eol ();
+}
+
+static void smg_gotorc (int *r, int *c)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsmg_gotorc (*r, *c);
+}
+
+static void smg_erase_eos (void)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsmg_erase_eos ();
+}
+
+static void smg_reverse_video (void)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsmg_reverse_video ();
+}
+
+static void smg_set_color (int *c)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsmg_set_color (*c);
+}
+
+static void smg_normal_video (void)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsmg_normal_video ();
+}
+
+static void smg_write_string (char *s)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsmg_write_string (s);
+}
+
+static void smg_write_nstring (char *s, int *len)
+{
+ if ((Smg_Initialized <= 0)
+ || (*len < 0))
+ return;
+
+ SLsmg_write_nstring (s, (unsigned int) *len);
+}
+
+static void smg_write_wrapped_string (char *s, int *r, int *c, int *dr, int *dc,
+ int *fill)
+{
+ if (Smg_Initialized <= 0)
+ return;
+
+ SLsmg_write_wrapped_string (s, *r, *c, *dr, *dc, *fill);
+}
+
+static int smg_char_at (void)
+{
+ if (Smg_Initialized <= 0) return -1;
+ return (int) SLsmg_char_at ();
+}
+
+static void smg_set_screen_start (int *rp, int *cp)
+{
+ int r, c;
+
+ if (Smg_Initialized <= 0) return;
+ r = *rp;
+ c = *cp;
+ SLsmg_set_screen_start (&r, &c);
+}
+
+static void smg_draw_hline (int *dn)
+{
+ if (Smg_Initialized <= 0)
+ return;
+
+ SLsmg_draw_hline (*dn);
+}
+
+static void smg_draw_vline (int *dn)
+{
+ if (Smg_Initialized <= 0)
+ return;
+
+ SLsmg_draw_vline (*dn);
+}
+
+static void smg_draw_object (int *r, int *c, int *obj)
+{
+ if (Smg_Initialized <= 0) return;
+ SLsmg_draw_object (*r, *c, *obj);
+}
+
+static void smg_draw_box (int *r, int *c,int *dr, int *dc)
+{
+ if (Smg_Initialized <= 0) return;
+ SLsmg_draw_box (*r, *c, *dr, *dc);
+}
+
+static int smg_get_column (void)
+{
+ if (Smg_Initialized <= 0) return -1;
+ return SLsmg_get_column();
+}
+
+static int smg_get_row (void)
+{
+ if (Smg_Initialized <= 0) return -1;
+ return SLsmg_get_row();
+}
+
+static void smg_forward (int *n)
+{
+ if (Smg_Initialized <= 0) return;
+ SLsmg_forward (*n);
+}
+
+static void smg_set_color_in_region (int *color, int *r, int *c, int *dr, int *dc)
+{
+ if (Smg_Initialized <= 0) return;
+ SLsmg_set_color_in_region (*color, *r, *c, *dr, *dc);
+}
+
+
+static void smg_cls (void)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsmg_cls ();
+}
+
+static void smg_refresh (void)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsig_block_signals ();
+ SLsmg_refresh ();
+ SLsig_unblock_signals ();
+}
+
+static void smg_reset_smg (void)
+{
+ if (Smg_Initialized <= 0)
+ return;
+ SLsig_block_signals ();
+ SLsmg_reset_smg ();
+ SLsig_unblock_signals ();
+ Smg_Initialized = 0;
+}
+
+static void smg_init_smg (void)
+{
+ if (Smg_Initialized != 0)
+ return;
+ SLsig_block_signals ();
+ (void) SLsmg_init_smg ();
+ SLsig_unblock_signals ();
+ Smg_Initialized = 1;
+}
+
+static void smg_define_color (int *obj, char *fg, char *bg)
+{
+ SLtt_set_color (*obj, NULL, fg, bg);
+}
+
+#define I SLANG_INT_TYPE
+#define S SLANG_STRING_TYPE
+static SLang_Intrin_Fun_Type Smg_Intrinsics [] =
+{
+ MAKE_INTRINSIC_0("smg_suspend_smg", smg_suspend_smg, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("smg_resume_smg", smg_resume_smg, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("smg_erase_eol", smg_erase_eol, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_II("smg_gotorc", smg_gotorc, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("smg_erase_eos", smg_erase_eos, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("smg_reverse_video", smg_reverse_video, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_I("smg_set_color", smg_set_color, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("smg_normal_video", smg_normal_video, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_S("smg_write_string", smg_write_string, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("smg_cls", smg_cls, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("smg_refresh", smg_refresh, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("smg_reset_smg", smg_reset_smg, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_0("smg_init_smg", smg_init_smg, SLANG_VOID_TYPE),
+
+ MAKE_INTRINSIC_SI("smg_write_nstring", smg_write_nstring, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_6("smg_write_wrapped_string", smg_write_wrapped_string, SLANG_VOID_TYPE, S,I,I,I,I,I),
+ MAKE_INTRINSIC_0("smg_char_at", smg_char_at, SLANG_INT_TYPE),
+ MAKE_INTRINSIC_II("smg_set_screen_start", smg_set_screen_start, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_I("smg_draw_hline", smg_draw_hline, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_I("smg_draw_vline", smg_draw_vline, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_III("smg_draw_object", smg_draw_object, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_4("smg_draw_box", smg_draw_box, SLANG_VOID_TYPE,I,I,I,I),
+ MAKE_INTRINSIC_0("smg_get_column", smg_get_column, SLANG_INT_TYPE),
+ MAKE_INTRINSIC_0("smg_get_row", smg_get_row, SLANG_INT_TYPE),
+ MAKE_INTRINSIC_I("smg_forward", smg_forward, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_5("smg_set_color_in_region", smg_set_color_in_region, SLANG_VOID_TYPE, I, I, I, I, I),
+
+ MAKE_INTRINSIC_ISS("smg_define_color", smg_define_color, SLANG_VOID_TYPE),
+ MAKE_INTRINSIC_S("smg_write_to_status_line", smg_write_to_status_line, SLANG_VOID_TYPE),
+ SLANG_END_INTRIN_FUN_TABLE
+};
+
+static SLang_Intrin_Var_Type Smg_Variables [] =
+{
+ MAKE_VARIABLE("Smg_Display_Eight_Bit", &SLsmg_Display_Eight_Bit, I, 0),
+ MAKE_VARIABLE("Smg_Tab_Width", &SLsmg_Tab_Width, I, 0),
+ MAKE_VARIABLE("Smg_Newline_Behavior", &SLsmg_Newline_Behavior, I, 0),
+ MAKE_VARIABLE("Smg_Backspace_Moves", &SLsmg_Backspace_Moves, I, 0),
+ MAKE_VARIABLE("Smg_Screen_Rows", &SLtt_Screen_Rows, I, 1),
+ MAKE_VARIABLE("Smg_Screen_Cols", &SLtt_Screen_Cols, I, 1),
+ SLANG_END_INTRIN_VAR_TABLE
+};
+
+static SLang_IConstant_Type Smg_Constants [] =
+{
+ MAKE_ICONSTANT("SMG_NEWLINE_IGNORED", SLSMG_NEWLINE_IGNORED),
+ MAKE_ICONSTANT("SMG_NEWLINE_MOVES", SLSMG_NEWLINE_MOVES),
+ MAKE_ICONSTANT("SMG_NEWLINE_SCROLLS", SLSMG_NEWLINE_SCROLLS),
+ MAKE_ICONSTANT("SMG_NEWLINE_PRINTABLE", SLSMG_NEWLINE_PRINTABLE),
+
+ MAKE_ICONSTANT("SMG_HLINE_CHAR", SLSMG_HLINE_CHAR),
+ MAKE_ICONSTANT("SMG_VLINE_CHAR", SLSMG_VLINE_CHAR),
+ MAKE_ICONSTANT("SMG_ULCORN_CHAR", SLSMG_ULCORN_CHAR),
+ MAKE_ICONSTANT("SMG_URCORN_CHAR", SLSMG_URCORN_CHAR),
+ MAKE_ICONSTANT("SMG_LLCORN_CHAR", SLSMG_LLCORN_CHAR),
+ MAKE_ICONSTANT("SMG_LRCORN_CHAR", SLSMG_LRCORN_CHAR),
+ MAKE_ICONSTANT("SMG_CKBRD_CHAR", SLSMG_CKBRD_CHAR),
+ MAKE_ICONSTANT("SMG_RTEE_CHAR", SLSMG_RTEE_CHAR),
+ MAKE_ICONSTANT("SMG_LTEE_CHAR", SLSMG_LTEE_CHAR),
+ MAKE_ICONSTANT("SMG_UTEE_CHAR", SLSMG_UTEE_CHAR),
+ MAKE_ICONSTANT("SMG_DTEE_CHAR", SLSMG_DTEE_CHAR),
+ MAKE_ICONSTANT("SMG_PLUS_CHAR", SLSMG_PLUS_CHAR),
+
+ SLANG_END_ICONST_TABLE
+};
+#undef I
+#undef S
+
+int init_smg_module_ns (char *ns_name)
+{
+ SLang_NameSpace_Type *ns = SLns_create_namespace (ns_name);
+ if (ns == NULL)
+ return -1;
+
+ if ((-1 == SLns_add_intrin_fun_table (ns, Smg_Intrinsics, "__SMG__"))
+ || (-1 == SLns_add_intrin_var_table (ns, Smg_Variables, NULL))
+ || (-1 == SLns_add_iconstant_table (ns, Smg_Constants, NULL)))
+ return -1;
+
+ SLtt_get_terminfo ();
+ Smg_Initialized = 0;
+ return 0;
+}
+
+#if 0
+int init_smg_module (void)
+{
+ if ((-1 == SLadd_intrin_fun_table (Smg_Intrinsics, "__SMG__"))
+ || (-1 == SLadd_intrin_var_table (Smg_Variables, NULL))
+ || (-1 == SLadd_iconstant_table (Smg_Constants, NULL)))
+ return -1;
+
+ SLtt_get_terminfo ();
+ Smg_Initialized = 0;
+ return 0;
+}
+#endif
+
+/* This function is optional */
+void deinit_smg_module (void)
+{
+ smg_reset_smg ();
+}
diff --git a/libslang/modules/smg.sl b/libslang/modules/smg.sl
new file mode 100644
index 0000000..80f9064
--- /dev/null
+++ b/libslang/modules/smg.sl
@@ -0,0 +1,70 @@
+import ("smg", "Global"); % Global namespace
+
+static variable Button_Color = 3;
+static variable Box_Color = 2;
+static variable Normal_Color = 1;
+
+smg_define_color (Button_Color, "white", "green");
+smg_define_color (Box_Color, "yellow", "blue");
+smg_define_color (Normal_Color, "green", "red");
+
+static define display_button (name, r, c)
+{
+ smg_gotorc (r, c);
+ smg_set_color (Button_Color);
+ smg_write_string (" " + name + " ");
+ smg_set_color (Normal_Color);
+}
+
+static define draw_centered_string (s, r, c, dc)
+{
+ variable len;
+
+ len = strlen (s);
+ smg_gotorc (r, c + (dc - len)/2);
+ smg_write_string (s);
+}
+
+static define get_yes_no_cancel (question)
+{
+ variable r, c, dr, dc;
+
+ dc = strlen (question) + 5;
+ dr = 7;
+
+ % We also need room for the yes-no-cancel buttons
+ if (dc < 32) dc = 36;
+
+ r = (Smg_Screen_Rows - dr)/2;
+ c = (Smg_Screen_Cols - dc)/2;
+
+ smg_set_color (Box_Color);
+ smg_draw_box (r, c, dr, dc);
+ smg_set_color (Normal_Color);
+
+ r += 2;
+
+ draw_centered_string (question + "?", r, c, dc);
+
+ r += 2;
+ display_button ("Yes", r, c + 4);
+ display_button ("No", r, c + 14);
+ display_button ("Cancel", r, c + 24);
+}
+
+
+smg_write_to_status_line ("smg-module demo");
+smg_init_smg ();
+smg_set_color(Normal_Color);
+smg_erase_eos ();
+get_yes_no_cancel ("This demo will exit in 5 seconds");
+
+
+smg_refresh ();
+sleep (5);
+
+smg_write_to_status_line ("");
+
+%smg_reset_smg ();
+
+exit(0);
diff --git a/libslang/modules/template.c b/libslang/modules/template.c
new file mode 100644
index 0000000..b0b7d60
--- /dev/null
+++ b/libslang/modules/template.c
@@ -0,0 +1,49 @@
+#include <stdio.h>
+#include <slang.h>
+
+SLANG_MODULE(<MODULE-NAME>);
+
+#define MODULE_MAJOR_VERSION 0
+#define MODULE_MINOR_VERSION 0
+#define MODULE_PATCH_LEVEL 0
+static char *Module_Version_String = "0.0.0";
+#define MODULE_VERSION_NUMBER \
+ (MODULE_MAJOR_VERSION*10000+MODULE_MINOR_VERSION*100+MODULE_PATCH_LEVEL)
+
+/* Define intrinsics here */
+
+static SLang_Intrin_Fun_Type Module_Intrinsics [] =
+{
+ SLANG_END_INTRIN_FUN_TABLE
+};
+
+static SLang_Intrin_Var_Type Module_Variables [] =
+{
+ MAKE_VARIABLE("_<MODULE-NAME>_module_version_string", &Module_Version_String, SLANG_STRING_TYPE, 1),
+ SLANG_END_INTRIN_VAR_TABLE
+};
+
+static SLang_IConstant_Type Module_Constants [] =
+{
+ MAKE_ICONSTANT("_<MODULE-NAME>_module_version", MODULE_VERSION_NUMBER),
+ SLANG_END_ICONST_TABLE
+};
+
+int init_<MODULE-NAME>_module_ns (char *ns_name)
+{
+ SLang_NameSpace_Type *ns = SLns_create_namespace (ns_name);
+ if (ns == NULL)
+ return -1;
+
+ if ((-1 == SLns_add_intrin_fun_table (ns, Module_Intrinsics, NULL))
+ || (-1 == SLns_add_intrin_var_table (ns, Module_Variables, NULL))
+ || (-1 == SLns_add_iconstant_table (ns, Module_Constants, NULL)))
+ return -1;
+
+ return 0;
+}
+
+/* This function is optional */
+void deinit_<MODULE-NAME>_module (void)
+{
+}
diff --git a/libslang/modules/termios-module.c b/libslang/modules/termios-module.c
new file mode 100644
index 0000000..e853be9
--- /dev/null
+++ b/libslang/modules/termios-module.c
@@ -0,0 +1,440 @@
+/* Copyright (c) 2001 John E. Davis
+ * This file is part of the S-Lang library.
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Perl Artistic License.
+ */
+#include <stdio.h>
+#include <slang.h>
+
+#include <unistd.h>
+#include <string.h>
+#include <termios.h>
+#include <errno.h>
+
+SLANG_MODULE(termios);
+
+static int Termios_Type_Id;
+
+static int check_and_set_errno (int e)
+{
+#ifdef EINTR
+ if (e == EINTR)
+ return 0;
+#endif
+ (void) SLerrno_set_errno (e);
+ return -1;
+}
+
+static int do_syscall_0 (int (*fun)(int), SLFile_FD_Type *f)
+{
+ int fd;
+ int ret;
+
+ if (-1 == SLfile_get_fd (f, &fd))
+ return -1;
+
+ while ((-1 == (ret = (*fun) (fd)))
+ && (0 == check_and_set_errno (errno)))
+ ;
+
+ return ret;
+}
+
+static int do_syscall_1 (int (*fun)(int, int), SLFile_FD_Type *f, int arg)
+{
+ int fd;
+ int ret;
+
+ if (-1 == SLfile_get_fd (f, &fd))
+ return -1;
+
+ while ((-1 == (ret = (*fun) (fd, arg)))
+ && (0 == check_and_set_errno (errno)))
+ ;
+
+ return ret;
+}
+
+static int do_syscall_struct_1 (int (*fun)(int, void *), SLFile_FD_Type *f, void *v)
+{
+ int fd;
+ int ret;
+
+ if (-1 == SLfile_get_fd (f, &fd))
+ return -1;
+
+ while ((-1 == (ret = (*fun) (fd, v)))
+ && (0 == check_and_set_errno (errno)))
+ ;
+
+ return ret;
+}
+
+static int do_syscall_struct_2 (int (*fun)(int, int, void *), SLFile_FD_Type *f, int i, void *v)
+{
+ int fd;
+ int ret;
+
+ if (-1 == SLfile_get_fd (f, &fd))
+ return -1;
+
+ while ((-1 == (ret = (*fun) (fd, i, v)))
+ && (0 == check_and_set_errno (errno)))
+ ;
+
+ return ret;
+}
+
+#define DO_SYSCALL_0(fun, f) do_syscall_0((int(*)(int))(fun),(f))
+#define DO_SYSCALL_1(fun, f, i) do_syscall_1((int(*)(int,int))(fun),(f),(i))
+#define DO_SYSCALL_STRUCT_1(fun, f, s) \
+ do_syscall_struct_1((int(*)(int, void*))(fun), (f), (void*)(s))
+#define DO_SYSCALL_STRUCT_2(fun, f, i, s) \
+ do_syscall_struct_2((int(*)(int, int, void*))(fun), (f), (i), (void*)(s))
+
+
+static int tcdrain_intrin (SLFile_FD_Type *f)
+{
+ return DO_SYSCALL_0 (tcdrain, f);
+}
+
+static int tcflow_intrin (SLFile_FD_Type *f, int *action)
+{
+ return DO_SYSCALL_1 (tcflow, f, *action);
+}
+
+static int tcflush_intrin (SLFile_FD_Type *f, int *action)
+{
+ return DO_SYSCALL_1 (tcflush, f, *action);
+}
+
+static int tcgetpgrp_intrin (SLFile_FD_Type *f)
+{
+ return DO_SYSCALL_0 (tcgetpgrp, f);
+}
+
+static int tcsetpgrp_intrin (SLFile_FD_Type *f, int *id)
+{
+ return DO_SYSCALL_1 (tcgetpgrp, f, *id);
+}
+
+static int tcsendbreak_intrin (SLFile_FD_Type *f, int *action)
+{
+ return DO_SYSCALL_1 (tcsendbreak, f, *action);
+}
+
+static void destroy_termios (unsigned char type, VOID_STAR f)
+{
+ (void) type;
+ SLfree ((char *) f);
+}
+
+static SLang_MMT_Type *allocate_termios (struct termios *s)
+{
+ struct termios *s1;
+ SLang_MMT_Type *mmt;
+
+ s1 = (struct termios *) SLmalloc (sizeof (struct termios));
+ if (s1 == NULL)
+ return NULL;
+
+ memcpy (s1, s, sizeof (struct termios));
+ if (NULL == (mmt = SLang_create_mmt (Termios_Type_Id, (VOID_STAR) s1)))
+ SLfree ((char *) s1);
+ return mmt;
+}
+
+static void tcgetattr_intrin (SLFile_FD_Type *f)
+{
+ struct termios s;
+ SLang_MMT_Type *mmt;
+
+ if (-1 == DO_SYSCALL_STRUCT_1(tcgetattr,f,&s))
+ {
+ SLang_push_null ();
+ return;
+ }
+
+ mmt = allocate_termios (&s); /* NULL ok */
+ if (-1 == SLang_push_mmt (mmt))
+ SLang_free_mmt (mmt);
+}
+
+static int tcsetattr_intrin (SLFile_FD_Type *f, int *when, struct termios *s)
+{
+ return DO_SYSCALL_STRUCT_2(tcsetattr,f,*when,s);
+}
+
+static int termios_get_oflag (struct termios *s)
+{
+ return s->c_oflag;
+}
+static int termios_get_iflag (struct termios *s)
+{
+ return s->c_iflag;
+}
+static int termios_get_cflag (struct termios *s)
+{
+ return s->c_cflag;
+}
+static int termios_get_lflag (struct termios *s)
+{
+ return s->c_lflag;
+}
+
+static void termios_get_cc (struct termios *s)
+{
+ SLang_Array_Type *at;
+ int dims = NCCS;
+ int i;
+ unsigned char *at_data;
+
+ at = SLang_create_array (SLANG_UCHAR_TYPE, 0, NULL, &dims, 1);
+ if (at == NULL)
+ return;
+ at_data = (unsigned char *) at->data;
+
+ for (i = 0; i < NCCS; i++)
+ at_data[i] = (unsigned char) s->c_cc[i];
+
+ (void) SLang_push_array (at, 1);
+}
+
+
+static void termios_set_oflag (struct termios *s, int *flag)
+{
+ s->c_oflag = *flag;
+}
+static void termios_set_iflag (struct termios *s, int *flag)
+{
+ s->c_iflag = *flag;
+}
+static void termios_set_cflag (struct termios *s, int *flag)
+{
+ s->c_cflag = *flag;
+}
+static void termios_set_lflag (struct termios *s, int *flag)
+{
+ s->c_lflag = *flag;
+}
+
+static void termios_set_cc (void)
+{
+ SLang_Array_Type *at;
+ SLang_MMT_Type *mmt;
+ struct termios *s;
+ unsigned char *at_data;
+ int i;
+
+ if (-1 == SLang_pop_array_of_type (&at, SLANG_UCHAR_TYPE))
+ return;
+ if (NULL == (mmt = SLang_pop_mmt (Termios_Type_Id)))
+ goto free_and_return;
+
+ s = SLang_object_from_mmt (mmt);
+ if (at->num_elements != NCCS)
+ {
+ SLang_verror (SL_TYPE_MISMATCH,
+ "Expecting UChar_Type[%d]", NCCS);
+ goto free_and_return;
+ }
+
+ at_data = (unsigned char *) at->data;
+ for (i = 0; i < NCCS; i++)
+ s->c_cc[i] = at_data[i];
+
+ /* drop */
+
+ free_and_return:
+ SLang_free_array (at);
+ SLang_free_mmt (mmt);
+}
+
+
+static int termios_dereference (unsigned char type, VOID_STAR addr)
+{
+ struct termios *s;
+ SLang_MMT_Type *mmt;
+
+ (void) type;
+ mmt = *(SLang_MMT_Type **) addr;
+ if (NULL == (s = SLang_object_from_mmt (mmt)))
+ return -1;
+
+ mmt = allocate_termios (s);
+ if (-1 == SLang_push_mmt (mmt))
+ {
+ SLang_free_mmt (mmt);
+ return -1;
+ }
+
+ return 0;
+}
+
+
+#define DUMMY_TERMIOS_TYPE 255
+#define T DUMMY_TERMIOS_TYPE
+#define F SLANG_FILE_FD_TYPE
+#define I SLANG_INT_TYPE
+#define V SLANG_VOID_TYPE
+static SLang_Intrin_Fun_Type Termios_Intrinsics [] =
+{
+ MAKE_INTRINSIC_1("tcdrain", tcdrain_intrin, I, F),
+ MAKE_INTRINSIC_2("tcflow", tcflow_intrin, I, F, I),
+ MAKE_INTRINSIC_2("tcflush", tcflush_intrin, I, F, I),
+ MAKE_INTRINSIC_1("tcgetpgrp", tcgetpgrp_intrin, I, F),
+ MAKE_INTRINSIC_2("tcsetpgrp", tcsetpgrp_intrin, I, F, I),
+ MAKE_INTRINSIC_2("tcsendbreak", tcsendbreak_intrin, I, F, I),
+ MAKE_INTRINSIC_1("tcgetattr", tcgetattr_intrin, V, F),
+ MAKE_INTRINSIC_3("tcsetattr", tcsetattr_intrin, I, F, I, T),
+ MAKE_INTRINSIC_1("termios_get_oflag", termios_get_oflag, I, T),
+ MAKE_INTRINSIC_1("termios_get_iflag", termios_get_iflag, I, T),
+ MAKE_INTRINSIC_1("termios_get_cflag", termios_get_cflag, I, T),
+ MAKE_INTRINSIC_1("termios_get_lflag", termios_get_lflag, I, T),
+ MAKE_INTRINSIC_1("termios_get_cc", termios_get_cc, V, T),
+ MAKE_INTRINSIC_2("termios_set_oflag", termios_set_oflag, V, T, I),
+ MAKE_INTRINSIC_2("termios_set_iflag", termios_set_iflag, V, T, I),
+ MAKE_INTRINSIC_2("termios_set_cflag", termios_set_cflag, V, T, I),
+ MAKE_INTRINSIC_2("termios_set_lflag", termios_set_lflag, V, T, I),
+ MAKE_INTRINSIC_0("termios_set_cc", termios_set_cc, V),
+
+ SLANG_END_INTRIN_FUN_TABLE
+};
+#undef T
+#undef I
+#undef F
+#undef V
+
+static SLang_IConstant_Type Termios_Consts [] =
+{
+ MAKE_ICONSTANT("TCOOFF", TCOOFF),
+ MAKE_ICONSTANT("TCOON", TCOON),
+ MAKE_ICONSTANT("TCIOFF", TCIOFF),
+ MAKE_ICONSTANT("TCION", TCION),
+ MAKE_ICONSTANT("TCIFLUSH", TCIFLUSH),
+ MAKE_ICONSTANT("TCOFLUSH", TCOFLUSH),
+ MAKE_ICONSTANT("TCIOFLUSH", TCIOFLUSH),
+ MAKE_ICONSTANT("TCSANOW", TCSANOW),
+ MAKE_ICONSTANT("TCSADRAIN", TCSADRAIN),
+ MAKE_ICONSTANT("TCSAFLUSH", TCSAFLUSH),
+ MAKE_ICONSTANT("BRKINT", BRKINT),
+ MAKE_ICONSTANT("IGNBRK", IGNBRK),
+ MAKE_ICONSTANT("IGNPAR", IGNPAR),
+ MAKE_ICONSTANT("PARMRK", PARMRK),
+ MAKE_ICONSTANT("INPCK", INPCK),
+ MAKE_ICONSTANT("ISTRIP", ISTRIP),
+ MAKE_ICONSTANT("INLCR", INLCR),
+ MAKE_ICONSTANT("IGNCR", IGNCR),
+ MAKE_ICONSTANT("ICRNL", ICRNL),
+ MAKE_ICONSTANT("IXON", IXON),
+ MAKE_ICONSTANT("IXOFF", IXOFF),
+ MAKE_ICONSTANT("CLOCAL", CLOCAL),
+ MAKE_ICONSTANT("CREAD", CREAD),
+ MAKE_ICONSTANT("CSIZE", CSIZE),
+ MAKE_ICONSTANT("CSTOPB", CSTOPB),
+ MAKE_ICONSTANT("HUPCL", HUPCL),
+ MAKE_ICONSTANT("PARENB", PARENB),
+ MAKE_ICONSTANT("PARODD", PARODD),
+ MAKE_ICONSTANT("ECHO", ECHO),
+ MAKE_ICONSTANT("ECHOE", ECHOE),
+ MAKE_ICONSTANT("ECHOK", ECHOK),
+ MAKE_ICONSTANT("ECHONL", ECHONL),
+ MAKE_ICONSTANT("ICANON", ICANON),
+ MAKE_ICONSTANT("ISIG", ISIG),
+ MAKE_ICONSTANT("NOFLSH", NOFLSH),
+ MAKE_ICONSTANT("TOSTOP", TOSTOP),
+ MAKE_ICONSTANT("IEXTEN", IEXTEN),
+ MAKE_ICONSTANT("VEOF", VEOF),
+ MAKE_ICONSTANT("VEOL", VEOL),
+ MAKE_ICONSTANT("VERASE", VERASE),
+ MAKE_ICONSTANT("VINTR", VINTR),
+ MAKE_ICONSTANT("VKILL", VKILL),
+ MAKE_ICONSTANT("VQUIT", VQUIT),
+ MAKE_ICONSTANT("VSUSP", VSUSP),
+ MAKE_ICONSTANT("VSTART", VSTART),
+ MAKE_ICONSTANT("VSTOP", VSTOP),
+#ifdef ultrix /* Ultrix gets _POSIX_VDISABLE wrong! */
+# define NULL_VALUE -1
+#else
+# ifdef _POSIX_VDISABLE
+# define NULL_VALUE _POSIX_VDISABLE
+# else
+# define NULL_VALUE 255
+# endif
+#endif
+ MAKE_ICONSTANT("VDISABLE", NULL_VALUE),
+
+ SLANG_END_ICONST_TABLE
+};
+
+static void patchup_intrinsic_table (SLang_Intrin_Fun_Type *table,
+ unsigned char dummy, unsigned char type)
+{
+ while (table->name != NULL)
+ {
+ unsigned int i, nargs;
+ unsigned char *args;
+
+ nargs = table->num_args;
+ args = table->arg_types;
+ for (i = 0; i < nargs; i++)
+ {
+ if (args[i] == dummy)
+ args[i] = type;
+ }
+
+ /* For completeness */
+ if (table->return_type == dummy)
+ table->return_type = type;
+
+ table++;
+ }
+}
+
+
+static int register_termios_type (void)
+{
+ SLang_Class_Type *cl;
+
+ if (NULL == (cl = SLclass_allocate_class ("Termios_Type")))
+ return -1;
+
+ if (-1 == SLclass_set_destroy_function (cl, destroy_termios))
+ return -1;
+ cl->cl_dereference = termios_dereference;
+
+ /* By registering as SLANG_VOID_TYPE, slang will dynamically allocate a
+ * type.
+ */
+ if (-1 == SLclass_register_class (cl, SLANG_VOID_TYPE, sizeof (struct termios), SLANG_CLASS_TYPE_MMT))
+ return -1;
+
+ Termios_Type_Id = SLclass_get_class_id (cl);
+ patchup_intrinsic_table (Termios_Intrinsics, DUMMY_TERMIOS_TYPE, Termios_Type_Id);
+
+ return 0;
+}
+
+int init_termios_module_ns (char *ns_name)
+{
+ SLang_NameSpace_Type *ns;
+
+ ns = SLns_create_namespace (ns_name);
+ if (ns == NULL)
+ return -1;
+
+ if (-1 == register_termios_type ())
+ return -1;
+
+ if ((-1 == SLns_add_intrin_fun_table (ns, Termios_Intrinsics, "__TERMIOS__"))
+ || (-1 == SLns_add_iconstant_table (ns, Termios_Consts, NULL)))
+ return -1;
+
+ return 0;
+}
+
+/* This function is optional */
+void deinit_termios_module (void)
+{
+}
diff --git a/libslang/modules/varray-module.c b/libslang/modules/varray-module.c
new file mode 100644
index 0000000..d9caf3a
--- /dev/null
+++ b/libslang/modules/varray-module.c
@@ -0,0 +1,224 @@
+#include <stdio.h>
+#include <string.h>
+#include <slang.h>
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/mman.h>
+
+#ifndef MAP_FAILED
+# define MAP_FAILED -1
+#endif
+
+SLANG_MODULE(varray);
+
+typedef struct
+{
+ unsigned long size_mmapped;
+ VOID_STAR addr;
+ VOID_STAR data;
+}
+MMap_Type;
+
+static void free_mmap_type (MMap_Type *m)
+{
+ if (m == NULL)
+ return;
+ if (m->addr != NULL)
+ (void) munmap ((char *) m->addr, m->size_mmapped);
+ SLfree ((char *)m);
+}
+
+static void unmmap_array (SLang_Array_Type *at)
+{
+ if (at->client_data != NULL)
+ free_mmap_type ((MMap_Type *) at->client_data);
+
+ at->data = NULL;
+ at->client_data = NULL;
+}
+
+
+static MMap_Type *mmap_file (char *file, unsigned int offset,
+ unsigned long num_bytes)
+{
+ FILE *fp;
+ int fd;
+ struct stat st;
+ VOID_STAR addr;
+ MMap_Type *m;
+
+ fp = fopen (file, "rb");
+ if (fp == NULL)
+ {
+ SLang_verror (SL_OBJ_NOPEN, "mmap_array: unable to open %s for reading", file);
+ return NULL;
+ }
+ fd = fileno (fp);
+
+ if (-1 == fstat (fd, &st))
+ {
+ SLang_verror (SL_INTRINSIC_ERROR, "mmap_array: stat %s failed", file);
+ fclose (fp);
+ return NULL;
+ }
+
+ if (NULL == (m = (MMap_Type *) SLmalloc (sizeof (MMap_Type))))
+ {
+ fclose (fp);
+ return NULL;
+ }
+
+ m->size_mmapped = num_bytes + offset;
+ addr = (VOID_STAR)mmap (NULL, m->size_mmapped, PROT_READ, MAP_SHARED, fd, 0);
+ if (addr == (VOID_STAR)MAP_FAILED)
+ {
+ SLang_verror (SL_INTRINSIC_ERROR, "mmap_array: mmap %s failed", file);
+ SLfree ((char *) m);
+ fclose (fp);
+ return NULL;
+ }
+ m->addr = addr;
+ m->data = (VOID_STAR) ((char *)addr + offset);
+
+ fclose (fp);
+
+ return m;
+}
+
+/* usage:
+ * a = mmap_array (file, offset, type, [dims]);
+ */
+static void mmap_array (void)
+{
+ SLang_Array_Type *a, *a_dims;
+ char *file;
+ unsigned char type;
+ int *dims;
+ unsigned int num_dims;
+ unsigned int i;
+ unsigned int num_elements;
+ unsigned int offset;
+ unsigned int sizeof_type;
+ unsigned long num_bytes;
+ MMap_Type *m;
+ VOID_STAR data;
+
+ a_dims = NULL;
+ file = NULL;
+ data = NULL;
+
+ if (-1 == SLang_pop_array_of_type (&a_dims, SLANG_INT_TYPE))
+ return;
+
+ num_dims = a_dims->num_elements;
+ dims = (int *)a_dims->data;
+
+ if (-1 == SLang_pop_datatype (&type))
+ goto return_error;
+
+ switch (type)
+ {
+ case SLANG_CHAR_TYPE:
+ case SLANG_UCHAR_TYPE:
+ sizeof_type = 1;
+ break;
+
+ case SLANG_SHORT_TYPE:
+ case SLANG_USHORT_TYPE:
+ sizeof_type = sizeof(short);
+ break;
+
+ case SLANG_INT_TYPE:
+ case SLANG_UINT_TYPE:
+ sizeof_type = sizeof (int);
+ break;
+
+ case SLANG_LONG_TYPE:
+ case SLANG_ULONG_TYPE:
+ sizeof_type = sizeof (long);
+ break;
+
+ case SLANG_FLOAT_TYPE:
+ sizeof_type = sizeof (float);
+ break;
+
+ case SLANG_DOUBLE_TYPE:
+ sizeof_type = sizeof (double);
+ break;
+
+ case SLANG_COMPLEX_TYPE:
+ sizeof_type = 2 * sizeof (double);
+ break;
+
+ default:
+ SLang_verror (SL_NOT_IMPLEMENTED, "mmap_array: unsupported data type");
+ goto return_error;
+ }
+
+ num_elements = 1;
+ for (i = 0; i < num_dims; i++)
+ {
+ if (dims[i] < 0)
+ {
+ SLang_verror (SL_USER_ERROR, "mmap_array: dims array must be positive");
+ goto return_error;
+ }
+
+ num_elements *= dims[i];
+ }
+ if (num_dims == 0)
+ num_elements = 0;
+
+ num_bytes = (unsigned long) sizeof_type * (unsigned long) num_elements;
+
+ if (-1 == SLang_pop_uinteger (&offset))
+ goto return_error;
+
+ if (-1 == SLang_pop_slstring (&file))
+ goto return_error;
+
+ if (NULL == (m = mmap_file (file, offset, num_bytes)))
+ goto return_error;
+
+ if (NULL == (a = SLang_create_array (type, 1, m->data, dims, num_dims)))
+ goto return_error;
+
+ a->free_fun = unmmap_array;
+ a->client_data = (VOID_STAR) m;
+
+ m = NULL; /* done with this */
+
+ (void) SLang_push_array (a, 1);
+
+ /* drop */
+
+ return_error:
+ if (m != NULL)
+ free_mmap_type (m);
+ if (a_dims != NULL)
+ SLang_free_array (a_dims);
+ if (file != NULL)
+ SLang_free_slstring (file);
+}
+
+static SLang_Intrin_Fun_Type Module_Intrinsics [] =
+{
+ MAKE_INTRINSIC_0("mmap_array", mmap_array, SLANG_VOID_TYPE),
+ SLANG_END_INTRIN_FUN_TABLE
+};
+
+
+int init_varray_module_ns (char *ns_name)
+{
+ SLang_NameSpace_Type *ns;
+
+ if (NULL == (ns = SLns_create_namespace (ns_name)))
+ return -1;
+
+ if (-1 == SLns_add_intrin_fun_table (ns, Module_Intrinsics, NULL))
+ return -1;
+
+ return 0;
+}
+
diff --git a/libslang/modules/varray.sl b/libslang/modules/varray.sl
new file mode 100644
index 0000000..8b78558
--- /dev/null
+++ b/libslang/modules/varray.sl
@@ -0,0 +1,37 @@
+% This file shows how to use the varray-module to treat a file as an
+% array of objects.
+import ("varray");
+
+% First of all, create an array of doubles
+static variable x = [1:1000.0:1.0];
+
+% and write it to disk
+static variable file = "varray_example.dat";
+static variable fp = fopen (file, "wb");
+if (fp == NULL)
+{
+ () = fprintf (stderr, "failed to open %s\n", file);
+ exit (1);
+}
+if ((-1 == fwrite (x, fp))
+ or (-1 == fclose (fp)))
+{
+ () = fprintf (stderr, "Failed to write x\n");
+ exit (1);
+}
+
+% Now associate an array with the file
+variable y = mmap_array (file, 0, _typeof(x), length(x));
+
+if (length (where (y != x)))
+{
+ fprintf (stderr, "mmap_array has failed\n");
+ exit (1);
+}
+
+y = 0; % remove the map
+
+exit (0);
+
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-10 21:01:38 +0000