conservatory
/
elk
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Fixed warnings. 

* Renamed newhandler.c into newhandler.cpp.
  * Use the -module flag for plugins so that their name doesn't need to
    start with "lib". This is partly because libtool fucks up when a module
    is called "libgdbm.so" and there is also a lib with this name.


git-svn-id: svn://svn.zoy.org/elk/trunk@42 55e467fa-43c5-0310-a8a2-de718669efc6
This commit is contained in:
sam 2003-08-25 15:59:18 +00:00
parent fd9e7337f5
commit 15acde4d28
11 changed files with 120 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
lib/misc/Makefile.am
View File

@ -1,46 +1,55 @@
NULL = NULL =
libelk_LTLIBRARIES = \ pkglib_LTLIBRARIES = \
libbitstring.la \ bitstring.la \
libelk-eval.la \ elk-eval.la \
libhack.la \ hack.la \
libnewhandler.la \ newhandler.la \
libregexp.la \ regexp.la \
libdebug.la \ debug.la \
libgdbm.la \ gdbm.la \
libmonitor.la \ monitor.la \
librecord.la \ record.la \
libstruct.la \ struct.la \
$(NULL) $(NULL)
libelkdir = /usr/lib/elk
libbitstring_la_SOURCES = bitstring.c bitstring_la_SOURCES = bitstring.c
libbitstring_la_LIBADD = $(top_builddir)/src/libelk.la bitstring_la_LDFLAGS = -module -avoid-version
bitstring_la_LIBADD = $(top_builddir)/src/libelk.la
libelk_eval_la_SOURCES = elk-eval.c elk_eval_la_SOURCES = elk-eval.c
libelk_eval_la_LIBADD = $(top_builddir)/src/libelk.la elk_eval_la_LDFLAGS = -module -avoid-version
elk_eval_la_LIBADD = $(top_builddir)/src/libelk.la
libhack_la_SOURCES = hack.c hack_la_SOURCES = hack.c
libhack_la_LIBADD = $(top_builddir)/src/libelk.la hack_la_LDFLAGS = -module -avoid-version
hack_la_LIBADD = $(top_builddir)/src/libelk.la
libnewhandler_la_SOURCES = newhandler.c newhandler_la_SOURCES = newhandler.cpp
libnewhandler_la_LIBADD = $(top_builddir)/src/libelk.la newhandler_la_LDFLAGS = -module -avoid-version
newhandler_la_LIBADD = $(top_builddir)/src/libelk.la
libregexp_la_SOURCES = regexp.c regexp_la_SOURCES = regexp.c
libregexp_la_LIBADD = $(top_builddir)/src/libelk.la regexp_la_LDFLAGS = -module -avoid-version
regexp_la_LIBADD = $(top_builddir)/src/libelk.la
libdebug_la_SOURCES = debug.c debug_la_SOURCES = debug.c
libdebug_la_LIBADD = $(top_builddir)/src/libelk.la debug_la_LDFLAGS = -module -avoid-version
debug_la_LIBADD = $(top_builddir)/src/libelk.la
libgdbm_la_SOURCES = gdbm.c gdbm_la_SOURCES = gdbm.c
libgdbm_la_LIBADD = $(top_builddir)/src/libelk.la -lgdbm gdbm_la_LDFLAGS = -module -avoid-version
gdbm_la_LIBADD = $(top_builddir)/src/libelk.la -lgdbm
libmonitor_la_SOURCES = monitor.c monitor_la_SOURCES = monitor.c
libmonitor_la_LIBADD = $(top_builddir)/src/libelk.la monitor_la_LDFLAGS = -module -avoid-version
monitor_la_LIBADD = $(top_builddir)/src/libelk.la
librecord_la_SOURCES = record.c record_la_SOURCES = record.c
librecord_la_LIBADD = $(top_builddir)/src/libelk.la record_la_LDFLAGS = -module -avoid-version
record_la_LIBADD = $(top_builddir)/src/libelk.la
libstruct_la_SOURCES = struct.c struct_la_SOURCES = struct.c
libstruct_la_LIBADD = $(top_builddir)/src/libelk.la struct_la_LDFLAGS = -module -avoid-version
struct_la_LIBADD = $(top_builddir)/src/libelk.la

45
lib/misc/bitstring.c
View File

@ -1,3 +1,6 @@
#include <string.h>
#include <stdlib.h>
#include "scheme.h" #include "scheme.h"
#define BITSTRING(x) ((struct S_Bitstring *)POINTER(x)) #define BITSTRING(x) ((struct S_Bitstring *)POINTER(x))
@ -23,7 +26,7 @@ static int Bitstring_Size(Object b) {
return sizeof(struct S_Bitstring) + bits_to_bytes(BITSTRING(b)->len) - 1; return sizeof(struct S_Bitstring) + bits_to_bytes(BITSTRING(b)->len) - 1;
} }
static Bitstring_Equal(Object b1, Object b2) { static int Bitstring_Equal(Object b1, Object b2) {
struct S_Bitstring *a = BITSTRING(b1), *b = BITSTRING(b2); struct S_Bitstring *a = BITSTRING(b1), *b = BITSTRING(b2);
if (a->len != b->len) if (a->len != b->len)
@ -47,7 +50,8 @@ static char *Digits(unsigned char c, int n) {
/* Print starting with MSB /* Print starting with MSB
*/ */
static Bitstring_Print(Object x, Object port, int raw, int depth, int length) { static int Bitstring_Print(Object x, Object port, int raw, int depth,
int length) {
int i, rem; int i, rem;
struct S_Bitstring *b = BITSTRING(x); struct S_Bitstring *b = BITSTRING(x);
GC_Node2; GC_Node2;
@ -55,11 +59,13 @@ static Bitstring_Print(Object x, Object port, int raw, int depth, int length) {
GC_Link2(x, port); GC_Link2(x, port);
Printf(port, "#*"); Printf(port, "#*");
i = bits_to_bytes(b->len) - 1; i = bits_to_bytes(b->len) - 1;
if (rem = b->len % 8) rem = b->len;
if (rem % 8)
Printf(port, Digits(b->data[i--], rem)); Printf(port, Digits(b->data[i--], rem));
for ( ; i >= 0; i--) for ( ; i >= 0; i--)
Printf(port, Digits(b->data[i], 8)); Printf(port, Digits(b->data[i], 8));
GC_Unlink; GC_Unlink;
return 0;
} }
static Object Make_Bitstring(unsigned int len) { static Object Make_Bitstring(unsigned int len) {
@ -112,10 +118,10 @@ static int Ulong_Size(ul) unsigned long ul; {
return n; return n;
} }
static Object Ulong_To_Bitstring(ul, len) unsigned long ul; unsigned len; { static Object Ulong_To_Bitstring(unsigned long ul, unsigned int len) {
Object ret; Object ret;
struct S_Bitstring *b; struct S_Bitstring *b;
int i, siz = Ulong_Size(ul); unsigned int i, siz = Ulong_Size(ul);
char buf[50]; char buf[50];
ret = Make_Bitstring(len); ret = Make_Bitstring(len);
@ -129,17 +135,17 @@ static Object Ulong_To_Bitstring(ul, len) unsigned long ul; unsigned len; {
return ret; return ret;
} }
static int Bigbits(b) struct S_Bignum *b; { static unsigned int Bigbits(b) struct S_Bignum *b; {
return b->usize ? (Ulong_Size((unsigned long)b->data[b->usize-1]) + return b->usize ? (Ulong_Size((unsigned long)b->data[b->usize-1]) +
(b->usize-1) * sizeof(gran_t) * 8) : 0; (b->usize-1) * sizeof(gran_t) * 8) : 0;
} }
static Object Bignum_To_Bitstring(big, len) Object big; unsigned len; { static Object Bignum_To_Bitstring(Object big, unsigned int len) {
char buf[50]; char buf[50];
Object ret; Object ret;
struct S_Bitstring *b; struct S_Bitstring *b;
struct S_Bignum *bn; struct S_Bignum *bn;
int k, i, n; unsigned int k, i, n;
GC_Node; GC_Node;
if (Bigbits(BIGNUM(big)) > len) { if (Bigbits(BIGNUM(big)) > len) {
@ -220,7 +226,8 @@ static Object P_Bitstring_Ref(bs, inx) Object bs, inx; {
Check_Type(bs, T_Bitstring); Check_Type(bs, T_Bitstring);
b = BITSTRING(bs); b = BITSTRING(bs);
if ((i = Get_Integer(inx)) < 0 || i >= b->len) i = Get_Integer(inx);
if (i < 0 || i >= (int)b->len)
Range_Error(inx); Range_Error(inx);
return b->data[i/8] & 1 << i % 8 ? True : False; return b->data[i/8] & 1 << i % 8 ? True : False;
} }
@ -232,7 +239,8 @@ static Object P_Bitstring_Set(bs, inx, val) Object bs, inx, val; {
Check_Type(bs, T_Bitstring); Check_Type(bs, T_Bitstring);
Check_Type(val, T_Boolean); Check_Type(val, T_Boolean);
b = BITSTRING(bs); b = BITSTRING(bs);
if ((i = Get_Integer(inx)) < 0 || i >= b->len) i = Get_Integer(inx);
if (i < 0 || i >= (int)b->len)
Range_Error(inx); Range_Error(inx);
j = i/8; j = i/8;
mask = 1 << i%8; mask = 1 << i%8;
@ -269,7 +277,8 @@ static Object P_Bitstring_Fill(bs, fill) Object bs, fill; {
printf("bitstrings must be of same length\n"); exit(1);\ printf("bitstrings must be of same length\n"); exit(1);\
}\ }\
i = bits_to_bytes(a->len) - 1;\ i = bits_to_bytes(a->len) - 1;\
if (rem = a->len % 8) {\ rem = a->len % 8;\
if (rem % 8) {\
a->data[i] op b->data[i];\ a->data[i] op b->data[i];\
a->data[i--] &= masks2[rem];\ a->data[i--] &= masks2[rem];\
}\ }\
@ -339,9 +348,9 @@ static Object P_Substring_Move(b1, from, to, b2, dst)
if (start1 < 0 || start1 > end1) if (start1 < 0 || start1 > end1)
Range_Error(from); Range_Error(from);
if (end1 > a->len) if (end1 > (int)a->len)
Range_Error(to); Range_Error(to);
if (start2 < 0 || end2 > b->len) if (start2 < 0 || end2 > (int)b->len)
Range_Error(dst); Range_Error(dst);
if (a == b && start2 < start1) { /* copy forward (LSB to MSB) */ if (a == b && start2 < start1) { /* copy forward (LSB to MSB) */
@ -413,7 +422,7 @@ static Object P_Substring_Move(b1, from, to, b2, dst)
if (off1 == off2) { if (off1 == off2) {
if (off1 < 7) { if (off1 < 7) {
if (len <= off1) if (len <= off1)
mask = masks2[len] << off1-len+1; mask = masks2[len] << (off1-len+1);
else else
mask = masks2[off1+1]; mask = masks2[off1+1];
b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask);
@ -422,7 +431,7 @@ static Object P_Substring_Move(b1, from, to, b2, dst)
for (; len >= 8; len -= 8) for (; len >= 8; len -= 8)
b->data[j--] = a->data[i--]; b->data[j--] = a->data[i--];
if (len > 0) { if (len > 0) {
mask = masks2[len] << 8 - len; mask = masks2[len] << (8 - len);
b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask);
} }
} else { } else {
@ -436,7 +445,7 @@ static Object P_Substring_Move(b1, from, to, b2, dst)
n = off1 + 1; n = off1 + 1;
mask = masks2[n]; mask = masks2[n];
if (len < n) { if (len < n) {
mask = masks2[len] << n-len; mask = masks2[len] << (n-len);
n = len; n = len;
} }
if (off2 + 1 >= n) { /* rest of src byte fits into dst byte */ if (off2 + 1 >= n) { /* rest of src byte fits into dst byte */
@ -453,7 +462,7 @@ static Object P_Substring_Move(b1, from, to, b2, dst)
} else { /* nope, copy as many bits as fit into dst bye */ } else { /* nope, copy as many bits as fit into dst bye */
n = off2 + 1; n = off2 + 1;
mask = masks2[n] << off1-n+1; mask = masks2[n] << (off1-n+1);
dmask = mask >> shift; dmask = mask >> shift;
b->data[j] = (b->data[j] & ~dmask) | b->data[j] = (b->data[j] & ~dmask) |
(unsigned int)(a->data[i] & mask) >> shift; (unsigned int)(a->data[i] & mask) >> shift;
@ -501,7 +510,7 @@ static Object Bitstring_Read(port, chr, konst) Object port; int chr, konst; {
#define Def_Prim Define_Primitive #define Def_Prim Define_Primitive
elk_init_lib_bitstring() { void elk_init_lib_bitstring() {
T_Bitstring = Define_Type(0, "bitstring", Bitstring_Size, 0, T_Bitstring = Define_Type(0, "bitstring", Bitstring_Size, 0,
Bitstring_Equal, Bitstring_Equal, Bitstring_Print, NOFUNC); Bitstring_Equal, Bitstring_Equal, Bitstring_Print, NOFUNC);
Define_Reader('*', Bitstring_Read); Define_Reader('*', Bitstring_Read);

2
lib/misc/debug.c
View File

@ -6,6 +6,6 @@ static Object P_Debug (on) Object on; {
return Void; return Void;
} }
elk_init_lib_debug () { void elk_init_lib_debug () {
Define_Primitive (P_Debug, "debug", 1, 1, EVAL); Define_Primitive (P_Debug, "debug", 1, 1, EVAL);
} }

4
lib/misc/elk-eval.c
View File

@ -12,6 +12,8 @@
* arguments. * arguments.
*/ */
#include <string.h>
#include "scheme.h" #include "scheme.h"
static Object in, out; static Object in, out;
@ -50,7 +52,7 @@ char *Elk_Eval(expr) char *expr; {
return String_Eval(expr); return String_Eval(expr);
} }
elk_init_eval() { void elk_init_eval() {
in = P_Open_Input_String(Make_String("", 0)); in = P_Open_Input_String(Make_String("", 0));
Global_GC_Link(in); Global_GC_Link(in);
out = P_Open_Output_String(); out = P_Open_Output_String();

8
lib/misc/gdbm.c
View File

@ -69,6 +69,7 @@
#include "scheme.h" #include "scheme.h"
#include <gdbm.h> #include <gdbm.h>
#include <errno.h> #include <errno.h>
#include <string.h>
extern gdbm_error gdbm_errno; extern gdbm_error gdbm_errno;
extern int errno; extern int errno;
@ -104,9 +105,10 @@ int Gdbm_fh_Equal (a, b) Object a, b; {
} }
/*ARGSUSED*/ /*ARGSUSED*/
Gdbm_fh_Print (fh, port, raw, depth, len) Object fh, port; int Gdbm_fh_Print (fh, port, raw, depth, len) Object fh, port;
int /*Bool*/ raw; int depth, len; { int /*Bool*/ raw; int depth, len; {
Printf (port, "#[gdbm-file %lu]", GDBM_FH(fh)->fptr); Printf (port, "#[gdbm-file %lu]", GDBM_FH(fh)->fptr);
return 0;
} }
Object P_Gdbm_filep (x) Object x; { Object P_Gdbm_filep (x) Object x; {
@ -138,7 +140,7 @@ Object P_Gdbm_Open (argc, argv) Object *argv; {
return Gdbm_fh; return Gdbm_fh;
} }
GDBM_FILE Check_Fh (fh) Object fh; { void Check_Fh (fh) Object fh; {
Check_Type (fh, T_Gdbm_fh); Check_Type (fh, T_Gdbm_fh);
if (GDBM_FH(fh)->free) if (GDBM_FH(fh)->free)
Primitive_Error ("invalid gdbm-file: ~s", fh); Primitive_Error ("invalid gdbm-file: ~s", fh);
@ -243,7 +245,7 @@ Object P_Gdbm_Error_Text () {
return Make_String (gdbm_error_message, strlen (gdbm_error_message)); return Make_String (gdbm_error_message, strlen (gdbm_error_message));
} }
elk_init_lib_gdbm () { void elk_init_lib_gdbm () {
Define_Primitive (P_Gdbm_Open, "gdbm-open", 3, 4, VARARGS); Define_Primitive (P_Gdbm_Open, "gdbm-open", 3, 4, VARARGS);
Define_Primitive (P_Gdbm_filep, "gdbm-file?", 1, 1, EVAL); Define_Primitive (P_Gdbm_filep, "gdbm-file?", 1, 1, EVAL);
Define_Primitive (P_Gdbm_Close, "gdbm-close", 1, 1, EVAL); Define_Primitive (P_Gdbm_Close, "gdbm-close", 1, 1, EVAL);

2
lib/misc/hack.c
View File

@ -7,7 +7,7 @@ static Object P_Hack_Procedure_Environment (p, e) Object p, e; {
return p; return p;
} }
elk_init_lib_hack () { void elk_init_lib_hack () {
Define_Primitive (P_Hack_Procedure_Environment, Define_Primitive (P_Hack_Procedure_Environment,
"hack-procedure-environment!", 2, 2, EVAL); "hack-procedure-environment!", 2, 2, EVAL);
P_Provide (Intern ("hack.so")); P_Provide (Intern ("hack.so"));

4
lib/misc/monitor.c
View File

@ -52,11 +52,11 @@ static Object P_Monitor (on) Object on; {
return Void; return Void;
} }
elk_init_lib_monitor () { void elk_init_lib_monitor () {
Define_Primitive (P_Monitor, "monitor", 1, 1, EVAL); Define_Primitive (P_Monitor, "monitor", 1, 1, EVAL);
} }
elk_finit_lib_monitor () { void elk_finit_lib_monitor () {
if (monitoring) { if (monitoring) {
monitoring = 0; monitoring = 0;
printf ("[writing mon.out]\n"); printf ("[writing mon.out]\n");

8
lib/misc/newhandler.c → lib/misc/newhandler.cpp
View File

@ -1,5 +1,7 @@
#include "scheme.h" #include "scheme.h"
#include <new>
#ifdef USE_ATTC_PLUS_PLUS #ifdef USE_ATTC_PLUS_PLUS
# define set_new_handler set_new_handler__FPFv_v # define set_new_handler set_new_handler__FPFv_v
#endif #endif
@ -19,9 +21,9 @@ static Object P_Set_New_Handler (Object p) {
return old; return old;
} }
elk_init_lib_cplusplus () { extern "C" void elk_init_lib_cplusplus () {
New_Handler = Null; New_Handler = Null;
Global_GC_Link (New_Handler); Global_GC_Link (New_Handler);
set_new_handler (New_Handler_Proc); std::new_handler (New_Handler_Proc);
Define_Primitive (P_Set_New_Handler, "set-c++-new-handler!", 1, 1, EVAL); Define_Primitive ((Object (*)(...))P_Set_New_Handler, "set-c++-new-handler!", 1, 1, EVAL);
} }

22
lib/misc/record.c
View File

@ -82,42 +82,48 @@ static Object P_Make_Record (rtd, values) Object rtd, values; {
return s; return s;
} }
static Rtd_Eqv (a, b) Object a, b; { return EQ(a,b); } static int Rtd_Eqv (Object a, Object b) {
return EQ(a,b);
}
#define Record_Eqv Rtd_Eqv #define Record_Eqv Rtd_Eqv
static Rtd_Equal (a, b) Object a, b; { static int Rtd_Equal (Object a, Object b) {
return EQ(RTD(a)->name, RTD(b)->name) && return EQ(RTD(a)->name, RTD(b)->name) &&
Equal (RTD(a)->fields, RTD(b)->fields); Equal (RTD(a)->fields, RTD(b)->fields);
} }
static Record_Equal (a, b) Object a, b; { static int Record_Equal (Object a, Object b) {
return EQ(RECORD(a)->rtd, RECORD(b)->rtd) && return EQ(RECORD(a)->rtd, RECORD(b)->rtd) &&
Equal (RECORD(a)->values, RECORD(b)->values); Equal (RECORD(a)->values, RECORD(b)->values);
} }
static Rtd_Print (x, port, raw, depth, length) Object x, port; { static int Rtd_Print (x, port, raw, depth, length) Object x, port; {
struct S_String *s = STRING(RTD(x)->name); struct S_String *s = STRING(RTD(x)->name);
Printf (port, "#[%.*s-record-type %lu]", s->size, s->data, POINTER(x)); Printf (port, "#[%.*s-record-type %lu]", s->size, s->data, POINTER(x));
return 0;
} }
static Record_Print (x, port, raw, depth, length) Object x, port; { static int Record_Print (x, port, raw, depth, length) Object x, port; {
struct S_String *s = STRING(RTD(RECORD(x)->rtd)->name); struct S_String *s = STRING(RTD(RECORD(x)->rtd)->name);
Printf (port, "#[%.*s-record-type %lu]", s->size, s->data, POINTER(x)); Printf (port, "#[%.*s-record-type %lu]", s->size, s->data, POINTER(x));
return 0;
} }
static Rtd_Visit (sp, f) register Object *sp; register (*f)(); { static int Rtd_Visit (register Object *sp, register int (*f)()) {
(*f)(&RTD(*sp)->name); (*f)(&RTD(*sp)->name);
(*f)(&RTD(*sp)->fields); (*f)(&RTD(*sp)->fields);
return 0;
} }
static Record_Visit (sp, f) register Object *sp; register (*f)(); { static int Record_Visit (register Object *sp, register int (*f)()) {
(*f)(&RECORD(*sp)->rtd); (*f)(&RECORD(*sp)->rtd);
(*f)(&RECORD(*sp)->values); (*f)(&RECORD(*sp)->values);
return 0;
} }
#define Def_Prim Define_Primitive #define Def_Prim Define_Primitive
elk_init_lib_record () { void elk_init_lib_record () {
T_Rtd = Define_Type (0, "record-type", NOFUNC, sizeof (struct S_Rtd), T_Rtd = Define_Type (0, "record-type", NOFUNC, sizeof (struct S_Rtd),
Rtd_Eqv, Rtd_Equal, Rtd_Print, Rtd_Visit); Rtd_Eqv, Rtd_Equal, Rtd_Print, Rtd_Visit);
Def_Prim (P_Rtdp, "record-type?", 1, 1, EVAL); Def_Prim (P_Rtdp, "record-type?", 1, 1, EVAL);

36
lib/misc/regexp.c
View File

@ -7,6 +7,8 @@
#include "scheme.h" #include "scheme.h"
#include <string.h>
#ifdef HAVE_REGCOMP #ifdef HAVE_REGCOMP
#include <sys/types.h> #include <sys/types.h>
@ -51,17 +53,17 @@ static Object P_Matchp(x) Object x; {
return TYPE(x) == T_Match ? True : False; return TYPE(x) == T_Match ? True : False;
} }
static Regexp_Eqv(a, b) Object a, b; { static int Regexp_Eqv(Object a, Object b) {
return EQ(REGEXP(a)->pattern, REGEXP(b)->pattern) return EQ(REGEXP(a)->pattern, REGEXP(b)->pattern)
&& REGEXP(a)->flags == REGEXP(b)->flags; && REGEXP(a)->flags == REGEXP(b)->flags;
} }
static Regexp_Equal(a, b) Object a, b; { static int Regexp_Equal(Object a, Object b) {
return Equal(REGEXP(a)->pattern, REGEXP(b)->pattern) return Equal(REGEXP(a)->pattern, REGEXP(b)->pattern)
&& REGEXP(a)->flags == REGEXP(b)->flags; && REGEXP(a)->flags == REGEXP(b)->flags;
} }
static Match_Equal(a, b) Object a, b; { static int Match_Equal(Object a, Object b) {
size_t i; size_t i;
struct S_Match *ap = MATCH(a), *bp = MATCH(b); struct S_Match *ap = MATCH(a), *bp = MATCH(b);
@ -79,26 +81,28 @@ static int Match_Size(m) Object m; {
return sizeof(struct S_Match) + (MATCH(m)->num - 1) * sizeof(regmatch_t); return sizeof(struct S_Match) + (MATCH(m)->num - 1) * sizeof(regmatch_t);
} }
static Regexp_Visit(p, f) Object *p; int (*f)(); { static int Regexp_Visit(Object *p, int (*f)()) {
f(&REGEXP(*p)->pattern); f(&REGEXP(*p)->pattern);
return 0;
} }
static Regexp_Print(x, port, raw, depth, length) Object x, port; { static int Regexp_Print(Object x, Object port, int raw, int depth, int length) {
Format(port, "#[regexp ~s]", 12, 1, &REGEXP(x)->pattern); Format(port, "#[regexp ~s]", 12, 1, &REGEXP(x)->pattern);
return 0;
} }
static Match_Print(x, port, raw, depth, length) Object x, port; { static int Match_Print(Object x, Object port, int raw, int depth, int length) {
Printf(port, "#[regexp-match %lu]", POINTER(x)); Printf(port, "#[regexp-match %lu]", POINTER(x));
return 0;
} }
static Object Terminate_Regexp(r) Object r; { static Object Terminate_Regexp(Object r) {
regfree(&REGEXP(r)->r); regfree(&REGEXP(r)->r);
return Void; return Void;
} }
static Object P_Make_Regexp(argc, argv) Object *argv; { static Object P_Make_Regexp(int argc, Object *argv) {
Object r; Object r;
char *s;
char msg[256]; char msg[256];
int flags = 0, ret; int flags = 0, ret;
@ -121,17 +125,17 @@ static Object P_Make_Regexp(argc, argv) Object *argv; {
return r; return r;
} }
static Object P_Regexp_Pattern(r) Object r; { static Object P_Regexp_Pattern(Object r) {
Check_Type(r, T_Regexp); Check_Type(r, T_Regexp);
return REGEXP(r)->pattern; return REGEXP(r)->pattern;
} }
static Object P_Regexp_Flags(r) Object r; { static Object P_Regexp_Flags(Object r) {
Check_Type(r, T_Regexp); Check_Type(r, T_Regexp);
return Bits_To_Symbols((unsigned long)REGEXP(r)->flags, 1, Compile_Syms); return Bits_To_Symbols((unsigned long)REGEXP(r)->flags, 1, Compile_Syms);
} }
static Object P_Regexp_Exec(argc, argv) Object *argv; { static Object P_Regexp_Exec(int argc, Object *argv) {
char *str, msg[256]; char *str, msg[256];
Object r, m; Object r, m;
size_t num; size_t num;
@ -171,12 +175,12 @@ static Object P_Regexp_Exec(argc, argv) Object *argv; {
/*NOTREACHED*/ /*NOTREACHED*/
} }
static Object P_Match_Number(m) Object m; { static Object P_Match_Number(Object m) {
Check_Type(m, T_Match); Check_Type(m, T_Match);
return Make_Unsigned_Long((unsigned long)MATCH(m)->num); return Make_Unsigned_Long((unsigned long)MATCH(m)->num);
} }
static Object P_Match_Start(m, n) Object m, n; { static Object P_Match_Start(Object m, Object n) {
size_t i; size_t i;
Check_Type(m, T_Match); Check_Type(m, T_Match);
@ -186,7 +190,7 @@ static Object P_Match_Start(m, n) Object m, n; {
return Make_Unsigned_Long((unsigned long)MATCH(m)->matches[i].rm_so); return Make_Unsigned_Long((unsigned long)MATCH(m)->matches[i].rm_so);
} }
static Object P_Match_End(m, n) Object m, n; { static Object P_Match_End(Object m, Object n) {
size_t i; size_t i;
Check_Type(m, T_Match); Check_Type(m, T_Match);
@ -201,7 +205,7 @@ static Object P_Match_End(m, n) Object m, n; {
#endif /* HAVE_REGCOMP */ #endif /* HAVE_REGCOMP */
elk_init_lib_regexp() { void elk_init_lib_regexp() {
#ifdef HAVE_REGCOMP #ifdef HAVE_REGCOMP
T_Regexp = Define_Type(0, "regexp", 0, sizeof(struct S_Regexp), T_Regexp = Define_Type(0, "regexp", 0, sizeof(struct S_Regexp),
Regexp_Eqv, Regexp_Equal, Regexp_Print, Regexp_Visit); Regexp_Eqv, Regexp_Equal, Regexp_Print, Regexp_Visit);

2
lib/misc/struct.c
View File

@ -96,7 +96,7 @@ static Structure_Visit (sp, f) register Object *sp; register (*f)(); {
(*f)(&STRUCT(*sp)->values); (*f)(&STRUCT(*sp)->values);
} }
elk_init_lib_struct () { void elk_init_lib_struct () {
T_Struct = Define_Type (0, "structure", NOFUNC, sizeof (struct S_Struct), T_Struct = Define_Type (0, "structure", NOFUNC, sizeof (struct S_Struct),
Structure_Eqv, Structure_Equal, Structure_Print, Structure_Visit); Structure_Eqv, Structure_Equal, Structure_Print, Structure_Visit);
Define_Primitive (P_Structurep, "structure?", 1, 1, EVAL); Define_Primitive (P_Structurep, "structure?", 1, 1, EVAL);