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 =
libelk_LTLIBRARIES = \
libbitstring.la \
libelk-eval.la \
libhack.la \
libnewhandler.la \
libregexp.la \
libdebug.la \
libgdbm.la \
libmonitor.la \
librecord.la \
libstruct.la \
pkglib_LTLIBRARIES = \
bitstring.la \
elk-eval.la \
hack.la \
newhandler.la \
regexp.la \
debug.la \
gdbm.la \
monitor.la \
record.la \
struct.la \
$(NULL)
libelkdir = /usr/lib/elk
libbitstring_la_SOURCES = bitstring.c
libbitstring_la_LIBADD = $(top_builddir)/src/libelk.la
bitstring_la_SOURCES = bitstring.c
bitstring_la_LDFLAGS = -module -avoid-version
bitstring_la_LIBADD = $(top_builddir)/src/libelk.la
libelk_eval_la_SOURCES = elk-eval.c
libelk_eval_la_LIBADD = $(top_builddir)/src/libelk.la
elk_eval_la_SOURCES = elk-eval.c
elk_eval_la_LDFLAGS = -module -avoid-version
elk_eval_la_LIBADD = $(top_builddir)/src/libelk.la
libhack_la_SOURCES = hack.c
libhack_la_LIBADD = $(top_builddir)/src/libelk.la
hack_la_SOURCES = hack.c
hack_la_LDFLAGS = -module -avoid-version
hack_la_LIBADD = $(top_builddir)/src/libelk.la
libnewhandler_la_SOURCES = newhandler.c
libnewhandler_la_LIBADD = $(top_builddir)/src/libelk.la
newhandler_la_SOURCES = newhandler.cpp
newhandler_la_LDFLAGS = -module -avoid-version
newhandler_la_LIBADD = $(top_builddir)/src/libelk.la
libregexp_la_SOURCES = regexp.c
libregexp_la_LIBADD = $(top_builddir)/src/libelk.la
regexp_la_SOURCES = regexp.c
regexp_la_LDFLAGS = -module -avoid-version
regexp_la_LIBADD = $(top_builddir)/src/libelk.la
libdebug_la_SOURCES = debug.c
libdebug_la_LIBADD = $(top_builddir)/src/libelk.la
debug_la_SOURCES = debug.c
debug_la_LDFLAGS = -module -avoid-version
debug_la_LIBADD = $(top_builddir)/src/libelk.la
libgdbm_la_SOURCES = gdbm.c
libgdbm_la_LIBADD = $(top_builddir)/src/libelk.la -lgdbm
gdbm_la_SOURCES = gdbm.c
gdbm_la_LDFLAGS = -module -avoid-version
gdbm_la_LIBADD = $(top_builddir)/src/libelk.la -lgdbm
libmonitor_la_SOURCES = monitor.c
libmonitor_la_LIBADD = $(top_builddir)/src/libelk.la
monitor_la_SOURCES = monitor.c
monitor_la_LDFLAGS = -module -avoid-version
monitor_la_LIBADD = $(top_builddir)/src/libelk.la
librecord_la_SOURCES = record.c
librecord_la_LIBADD = $(top_builddir)/src/libelk.la
record_la_SOURCES = record.c
record_la_LDFLAGS = -module -avoid-version
record_la_LIBADD = $(top_builddir)/src/libelk.la
libstruct_la_SOURCES = struct.c
libstruct_la_LIBADD = $(top_builddir)/src/libelk.la
struct_la_SOURCES = struct.c
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"
#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;
}
static Bitstring_Equal(Object b1, Object b2) {
static int Bitstring_Equal(Object b1, Object b2) {
struct S_Bitstring *a = BITSTRING(b1), *b = BITSTRING(b2);
if (a->len != b->len)
@ -47,7 +50,8 @@ static char *Digits(unsigned char c, int n) {
/* 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;
struct S_Bitstring *b = BITSTRING(x);
GC_Node2;
@ -55,11 +59,13 @@ static Bitstring_Print(Object x, Object port, int raw, int depth, int length) {
GC_Link2(x, port);
Printf(port, "#*");
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));
for ( ; i >= 0; i--)
Printf(port, Digits(b->data[i], 8));
GC_Unlink;
return 0;
}
static Object Make_Bitstring(unsigned int len) {
@ -112,10 +118,10 @@ static int Ulong_Size(ul) unsigned long ul; {
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;
struct S_Bitstring *b;
int i, siz = Ulong_Size(ul);
unsigned int i, siz = Ulong_Size(ul);
char buf[50];
ret = Make_Bitstring(len);
@ -129,17 +135,17 @@ static Object Ulong_To_Bitstring(ul, len) unsigned long ul; unsigned len; {
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]) +
(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];
Object ret;
struct S_Bitstring *b;
struct S_Bignum *bn;
int k, i, n;
unsigned int k, i, n;
GC_Node;
if (Bigbits(BIGNUM(big)) > len) {
@ -220,7 +226,8 @@ static Object P_Bitstring_Ref(bs, inx) Object bs, inx; {
Check_Type(bs, T_Bitstring);
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);
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(val, T_Boolean);
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);
j = 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);\
}\
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--] &= masks2[rem];\
}\
@ -339,9 +348,9 @@ static Object P_Substring_Move(b1, from, to, b2, dst)
if (start1 < 0 || start1 > end1)
Range_Error(from);
if (end1 > a->len)
if (end1 > (int)a->len)
Range_Error(to);
if (start2 < 0 || end2 > b->len)
if (start2 < 0 || end2 > (int)b->len)
Range_Error(dst);
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 < 7) {
if (len <= off1)
mask = masks2[len] << off1-len+1;
mask = masks2[len] << (off1-len+1);
else
mask = masks2[off1+1];
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)
b->data[j--] = a->data[i--];
if (len > 0) {
mask = masks2[len] << 8 - len;
mask = masks2[len] << (8 - len);
b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask);
}
} else {
@ -436,7 +445,7 @@ static Object P_Substring_Move(b1, from, to, b2, dst)
n = off1 + 1;
mask = masks2[n];
if (len < n) {
mask = masks2[len] << n-len;
mask = masks2[len] << (n-len);
n = len;
}
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 */
n = off2 + 1;
mask = masks2[n] << off1-n+1;
mask = masks2[n] << (off1-n+1);
dmask = mask >> shift;
b->data[j] = (b->data[j] & ~dmask) |
(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
elk_init_lib_bitstring() {
void elk_init_lib_bitstring() {
T_Bitstring = Define_Type(0, "bitstring", Bitstring_Size, 0,
Bitstring_Equal, Bitstring_Equal, Bitstring_Print, NOFUNC);
Define_Reader('*', Bitstring_Read);

2
lib/misc/debug.c
View File

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

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

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

8
lib/misc/gdbm.c
View File

@ -69,6 +69,7 @@
#include "scheme.h"
#include <gdbm.h>
#include <errno.h>
#include <string.h>
extern gdbm_error gdbm_errno;
extern int errno;
@ -104,9 +105,10 @@ int Gdbm_fh_Equal (a, b) Object a, b; {
}
/*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; {
Printf (port, "#[gdbm-file %lu]", GDBM_FH(fh)->fptr);
return 0;
}
Object P_Gdbm_filep (x) Object x; {
@ -138,7 +140,7 @@ Object P_Gdbm_Open (argc, argv) Object *argv; {
return Gdbm_fh;
}
GDBM_FILE Check_Fh (fh) Object fh; {
void Check_Fh (fh) Object fh; {
Check_Type (fh, T_Gdbm_fh);
if (GDBM_FH(fh)->free)
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));
}
elk_init_lib_gdbm () {
void elk_init_lib_gdbm () {
Define_Primitive (P_Gdbm_Open, "gdbm-open", 3, 4, VARARGS);
Define_Primitive (P_Gdbm_filep, "gdbm-file?", 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;
}
elk_init_lib_hack () {
void elk_init_lib_hack () {
Define_Primitive (P_Hack_Procedure_Environment,
"hack-procedure-environment!", 2, 2, EVAL);
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;
}
elk_init_lib_monitor () {
void elk_init_lib_monitor () {
Define_Primitive (P_Monitor, "monitor", 1, 1, EVAL);
}
elk_finit_lib_monitor () {
void elk_finit_lib_monitor () {
if (monitoring) {
monitoring = 0;
printf ("[writing mon.out]\n");

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

@ -1,5 +1,7 @@
#include "scheme.h"
#include <new>
#ifdef USE_ATTC_PLUS_PLUS
# define set_new_handler set_new_handler__FPFv_v
#endif
@ -19,9 +21,9 @@ static Object P_Set_New_Handler (Object p) {
return old;
}
elk_init_lib_cplusplus () {
extern "C" void elk_init_lib_cplusplus () {
New_Handler = Null;
Global_GC_Link (New_Handler);
set_new_handler (New_Handler_Proc);
Define_Primitive (P_Set_New_Handler, "set-c++-new-handler!", 1, 1, EVAL);
std::new_handler (New_Handler_Proc);
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;
}
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
static Rtd_Equal (a, b) Object a, b; {
static int Rtd_Equal (Object a, Object b) {
return EQ(RTD(a)->name, RTD(b)->name) &&
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) &&
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);
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);
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)->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)->values);
return 0;
}
#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),
Rtd_Eqv, Rtd_Equal, Rtd_Print, Rtd_Visit);
Def_Prim (P_Rtdp, "record-type?", 1, 1, EVAL);

36
lib/misc/regexp.c
View File

@ -7,6 +7,8 @@
#include "scheme.h"
#include <string.h>
#ifdef HAVE_REGCOMP
#include <sys/types.h>
@ -51,17 +53,17 @@ static Object P_Matchp(x) Object x; {
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)
&& 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)
&& 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;
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);
}
static Regexp_Visit(p, f) Object *p; int (*f)(); {
static int Regexp_Visit(Object *p, int (*f)()) {
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);
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));
return 0;
}
static Object Terminate_Regexp(r) Object r; {
static Object Terminate_Regexp(Object r) {
regfree(&REGEXP(r)->r);
return Void;
}
static Object P_Make_Regexp(argc, argv) Object *argv; {
static Object P_Make_Regexp(int argc, Object *argv) {
Object r;
char *s;
char msg[256];
int flags = 0, ret;
@ -121,17 +125,17 @@ static Object P_Make_Regexp(argc, argv) Object *argv; {
return r;
}
static Object P_Regexp_Pattern(r) Object r; {
static Object P_Regexp_Pattern(Object r) {
Check_Type(r, T_Regexp);
return REGEXP(r)->pattern;
}
static Object P_Regexp_Flags(r) Object r; {
static Object P_Regexp_Flags(Object r) {
Check_Type(r, T_Regexp);
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];
Object r, m;
size_t num;
@ -171,12 +175,12 @@ static Object P_Regexp_Exec(argc, argv) Object *argv; {
/*NOTREACHED*/
}
static Object P_Match_Number(m) Object m; {
static Object P_Match_Number(Object m) {
Check_Type(m, T_Match);
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;
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);
}
static Object P_Match_End(m, n) Object m, n; {
static Object P_Match_End(Object m, Object n) {
size_t i;
Check_Type(m, T_Match);
@ -201,7 +205,7 @@ static Object P_Match_End(m, n) Object m, n; {
#endif /* HAVE_REGCOMP */
elk_init_lib_regexp() {
void elk_init_lib_regexp() {
#ifdef HAVE_REGCOMP
T_Regexp = Define_Type(0, "regexp", 0, sizeof(struct S_Regexp),
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);
}
elk_init_lib_struct () {
void elk_init_lib_struct () {
T_Struct = Define_Type (0, "structure", NOFUNC, sizeof (struct S_Struct),
Structure_Eqv, Structure_Equal, Structure_Print, Structure_Visit);
Define_Primitive (P_Structurep, "structure?", 1, 1, EVAL);