* Added $Id and copyright information to all .c files in lib/misc/
* Fixed old shitty K&R syntax. git-svn-id: svn://svn.zoy.org/elk/trunk@65 55e467fa-43c5-0310-a8a2-de718669efc6
This commit is contained in:
sam
parent
b13cf1d931
commit
cd36edfd2a
|
|
@ -1,3 +1,33 @@
|
|||
/* bitstring.c
|
||||
*
|
||||
* $Id$
|
||||
*
|
||||
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
||||
* Copyright 2002, 2003 Sam Hocevar <sam@zoy.org>, Paris
|
||||
*
|
||||
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
||||
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
||||
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
||||
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
||||
*
|
||||
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
||||
* owners or individual owners of copyright in this software, grant to any
|
||||
* person or company a worldwide, royalty free, license to
|
||||
*
|
||||
* i) copy this software,
|
||||
* ii) prepare derivative works based on this software,
|
||||
* iii) distribute copies of this software or derivative works,
|
||||
* iv) perform this software, or
|
||||
* v) display this software,
|
||||
*
|
||||
* provided that this notice is not removed and that neither Oliver Laumann
|
||||
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
||||
* the suitability of this software for any purpose nor are held responsible
|
||||
* for any defects of this software.
|
||||
*
|
||||
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
|
|
@ -105,12 +135,12 @@ static Object P_Make_Bitstring(Object len, Object init) {
|
|||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Length(bs) Object bs; {
|
||||
static Object P_Bitstring_Length(Object bs) {
|
||||
Check_Type(bs, T_Bitstring);
|
||||
return Make_Unsigned(BITSTRING(bs)->len);
|
||||
}
|
||||
|
||||
static int Ulong_Size(ul) unsigned long ul; {
|
||||
static int Ulong_Size(unsigned long ul) {
|
||||
int n;
|
||||
|
||||
for (n = 0; ul; ul >>= 1, n++)
|
||||
|
|
@ -135,7 +165,7 @@ static Object Ulong_To_Bitstring(unsigned long ul, unsigned int len) {
|
|||
return ret;
|
||||
}
|
||||
|
||||
static unsigned int Bigbits(b) struct S_Bignum *b; {
|
||||
static unsigned int Bigbits(struct S_Bignum *b) {
|
||||
return b->usize ? (Ulong_Size((unsigned long)b->data[b->usize-1]) +
|
||||
(b->usize-1) * sizeof(gran_t) * 8) : 0;
|
||||
}
|
||||
|
|
@ -166,7 +196,7 @@ static Object Bignum_To_Bitstring(Object big, unsigned int len) {
|
|||
return ret;
|
||||
}
|
||||
|
||||
static Object P_Int_To_Bitstring(len, i) Object len, i; {
|
||||
static Object P_Int_To_Bitstring(Object len, Object i) {
|
||||
Object isneg;
|
||||
int ilen;
|
||||
|
||||
|
|
@ -181,7 +211,7 @@ static Object P_Int_To_Bitstring(len, i) Object len, i; {
|
|||
return Bignum_To_Bitstring(i, (unsigned)ilen);
|
||||
}
|
||||
|
||||
static Object Bitstring_To_Bignum (bs) Object bs; {
|
||||
static Object Bitstring_To_Bignum (Object bs) {
|
||||
struct S_Bitstring *b;
|
||||
Object big;
|
||||
int i, n, k;
|
||||
|
|
@ -204,7 +234,7 @@ static Object Bitstring_To_Bignum (bs) Object bs; {
|
|||
return big;
|
||||
}
|
||||
|
||||
static Object P_Bitstring_To_Int(bs) Object bs; {
|
||||
static Object P_Bitstring_To_Int(Object bs) {
|
||||
struct S_Bitstring *b;
|
||||
unsigned u = 0;
|
||||
int i;
|
||||
|
|
@ -220,7 +250,7 @@ static Object P_Bitstring_To_Int(bs) Object bs; {
|
|||
return Make_Integer(u);
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Ref(bs, inx) Object bs, inx; {
|
||||
static Object P_Bitstring_Ref(Object bs, Object inx) {
|
||||
struct S_Bitstring *b;
|
||||
int i;
|
||||
|
||||
|
|
@ -232,7 +262,7 @@ static Object P_Bitstring_Ref(bs, inx) Object bs, inx; {
|
|||
return b->data[i/8] & 1 << i % 8 ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Set(bs, inx, val) Object bs, inx, val; {
|
||||
static Object P_Bitstring_Set(Object bs, Object inx, Object val) {
|
||||
int old, i, j, mask;
|
||||
struct S_Bitstring *b;
|
||||
|
||||
|
|
@ -252,7 +282,7 @@ static Object P_Bitstring_Set(bs, inx, val) Object bs, inx, val; {
|
|||
return old ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Zerop(bs) Object bs; {
|
||||
static Object P_Bitstring_Zerop(Object bs) {
|
||||
struct S_Bitstring *b;
|
||||
int i;
|
||||
|
||||
|
|
@ -263,14 +293,15 @@ static Object P_Bitstring_Zerop(bs) Object bs; {
|
|||
return i < 0 ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Fill(bs, fill) Object bs, fill; {
|
||||
static Object P_Bitstring_Fill(Object bs, Object fill) {
|
||||
Check_Type(bs, T_Bitstring);
|
||||
Check_Type(fill, T_Boolean);
|
||||
Fill_Bitstring(bs, Truep(fill));
|
||||
return Void;
|
||||
}
|
||||
|
||||
#define bitop(name, op) static void name(a, b) struct S_Bitstring *a, *b; {\
|
||||
#define bitop(name, op) static void name(struct S_Bitstring *a,\
|
||||
struct S_Bitstring *b) {\
|
||||
int i, rem;\
|
||||
\
|
||||
if (a->len != b->len) {\
|
||||
|
|
@ -293,7 +324,7 @@ bitop(bor, |=)
|
|||
bitop(bandnot, &= ~)
|
||||
bitop(bxor, ^=)
|
||||
|
||||
static Object Bit_Operation(b1, b2, fun) Object b1, b2; void (*fun)(); {
|
||||
static Object Bit_Operation(Object b1, Object b2, void (*fun)()) {
|
||||
struct S_Bitstring *a, *b;
|
||||
|
||||
Check_Type(b1, T_Bitstring);
|
||||
|
|
@ -306,32 +337,32 @@ static Object Bit_Operation(b1, b2, fun) Object b1, b2; void (*fun)(); {
|
|||
return Void;
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Move(a, b) Object a, b; {
|
||||
static Object P_Bitstring_Move(Object a, Object b) {
|
||||
return Bit_Operation(a, b, bmove);
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Not(a, b) Object a, b; {
|
||||
static Object P_Bitstring_Not(Object a, Object b) {
|
||||
return Bit_Operation(a, b, bnot);
|
||||
}
|
||||
|
||||
static Object P_Bitstring_And(a, b) Object a, b; {
|
||||
static Object P_Bitstring_And(Object a, Object b) {
|
||||
return Bit_Operation(a, b, band);
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Or(a, b) Object a, b; {
|
||||
static Object P_Bitstring_Or(Object a, Object b) {
|
||||
return Bit_Operation(a, b, bor);
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Andnot(a, b) Object a, b; {
|
||||
static Object P_Bitstring_Andnot(Object a, Object b) {
|
||||
return Bit_Operation(a, b, bandnot);
|
||||
}
|
||||
|
||||
static Object P_Bitstring_Xor(a, b) Object a, b; {
|
||||
static Object P_Bitstring_Xor(Object a, Object b) {
|
||||
return Bit_Operation(a, b, bxor);
|
||||
}
|
||||
|
||||
static Object P_Substring_Move(b1, from, to, b2, dst)
|
||||
Object b1, from, to, b2, dst; {
|
||||
static Object P_Substring_Move(Object b1, Object from, Object to,
|
||||
Object b2, Object dst) {
|
||||
struct S_Bitstring *a, *b;
|
||||
int start1, end1, start2, end2, len, off1, off2, i, j;
|
||||
unsigned char mask;
|
||||
|
|
@ -480,7 +511,7 @@ static Object P_Substring_Move(b1, from, to, b2, dst)
|
|||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
static Object Bitstring_Read(port, chr, konst) Object port; int chr, konst; {
|
||||
static Object Bitstring_Read(Object port, int chr, int konst) {
|
||||
int c, str, i;
|
||||
FILE *f;
|
||||
char buf[1024], *p = buf;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,36 @@
|
|||
/* debug.c
|
||||
*
|
||||
* $Id$
|
||||
*
|
||||
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
||||
* Copyright 2002, 2003 Sam Hocevar <sam@zoy.org>, Paris
|
||||
*
|
||||
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
||||
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
||||
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
||||
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
||||
*
|
||||
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
||||
* owners or individual owners of copyright in this software, grant to any
|
||||
* person or company a worldwide, royalty free, license to
|
||||
*
|
||||
* i) copy this software,
|
||||
* ii) prepare derivative works based on this software,
|
||||
* iii) distribute copies of this software or derivative works,
|
||||
* iv) perform this software, or
|
||||
* v) display this software,
|
||||
*
|
||||
* provided that this notice is not removed and that neither Oliver Laumann
|
||||
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
||||
* the suitability of this software for any purpose nor are held responsible
|
||||
* for any defects of this software.
|
||||
*
|
||||
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
#include "scheme.h"
|
||||
|
||||
static Object P_Debug (on) Object on; {
|
||||
static Object P_Debug (Object on) {
|
||||
Check_Type (on, T_Boolean);
|
||||
GC_Debug = EQ(on, True);
|
||||
return Void;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,33 @@
|
|||
/* elk-eval.c
|
||||
*
|
||||
* $Id$
|
||||
*
|
||||
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
||||
* Copyright 2002, 2003 Sam Hocevar <sam@zoy.org>, Paris
|
||||
*
|
||||
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
||||
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
||||
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
||||
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
||||
*
|
||||
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
||||
* owners or individual owners of copyright in this software, grant to any
|
||||
* person or company a worldwide, royalty free, license to
|
||||
*
|
||||
* i) copy this software,
|
||||
* ii) prepare derivative works based on this software,
|
||||
* iii) distribute copies of this software or derivative works,
|
||||
* iv) perform this software, or
|
||||
* v) display this software,
|
||||
*
|
||||
* provided that this notice is not removed and that neither Oliver Laumann
|
||||
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
||||
* the suitability of this software for any purpose nor are held responsible
|
||||
* for any defects of this software.
|
||||
*
|
||||
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
/* The function
|
||||
*
|
||||
* char *Elk_Eval(char *expr);
|
||||
|
|
@ -18,7 +48,7 @@
|
|||
|
||||
static Object in, out;
|
||||
|
||||
static char *String_Eval(expr) char *expr; {
|
||||
static char *String_Eval(char *expr) {
|
||||
Object str, res;
|
||||
char *p;
|
||||
GC_Node;
|
||||
|
|
@ -40,7 +70,7 @@ static char *String_Eval(expr) char *expr; {
|
|||
return buf;
|
||||
}
|
||||
|
||||
char *Elk_Eval(expr) char *expr; {
|
||||
char *Elk_Eval(char *expr) {
|
||||
char *s;
|
||||
|
||||
s = String_Eval("\
|
||||
|
|
|
|||
|
|
@ -1,8 +1,35 @@
|
|||
/* Elk/GDBM-interface.
|
||||
*
|
||||
/* gdbm.c: Elk/GDBM-interface.
|
||||
* Original version by Martin Stut <stut@informatik.tu-muenchen.dbp.de>.
|
||||
*
|
||||
* Functions exported:
|
||||
* $Id$
|
||||
*
|
||||
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
||||
* Copyright 2002, 2003 Sam Hocevar <sam@zoy.org>, Paris
|
||||
*
|
||||
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
||||
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
||||
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
||||
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
||||
*
|
||||
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
||||
* owners or individual owners of copyright in this software, grant to any
|
||||
* person or company a worldwide, royalty free, license to
|
||||
*
|
||||
* i) copy this software,
|
||||
* ii) prepare derivative works based on this software,
|
||||
* iii) distribute copies of this software or derivative works,
|
||||
* iv) perform this software, or
|
||||
* v) display this software,
|
||||
*
|
||||
* provided that this notice is not removed and that neither Oliver Laumann
|
||||
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
||||
* the suitability of this software for any purpose nor are held responsible
|
||||
* for any defects of this software.
|
||||
*
|
||||
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
/* Functions exported:
|
||||
*
|
||||
* (gdbm-file? obj)
|
||||
*
|
||||
|
|
@ -99,7 +126,7 @@ struct S_gdbm_fh{
|
|||
|
||||
#define GDBM_FH(obj) ((struct S_gdbm_fh *)POINTER(obj))
|
||||
|
||||
int Gdbm_fh_Equal (a, b) Object a, b; {
|
||||
int Gdbm_fh_Equal (Object a, Object b) {
|
||||
return !GDBM_FH(a)->free && !GDBM_FH(b)->free &&
|
||||
GDBM_FH(a)->fptr == GDBM_FH(b)->fptr;
|
||||
}
|
||||
|
|
@ -111,16 +138,16 @@ int Gdbm_fh_Print (fh, port, raw, depth, len) Object fh, port;
|
|||
return 0;
|
||||
}
|
||||
|
||||
Object P_Gdbm_filep (x) Object x; {
|
||||
Object P_Gdbm_filep (Object x) {
|
||||
return TYPE(x) == T_Gdbm_fh ? True : False;
|
||||
}
|
||||
|
||||
static void Fatal_Func (s) char *s; {
|
||||
static void Fatal_Func (char *s) {
|
||||
gdbm_error_message = s;
|
||||
fprintf (stderr, "gdbm error: %s\n", s);
|
||||
}
|
||||
|
||||
Object P_Gdbm_Open (argc, argv) Object *argv; {
|
||||
Object P_Gdbm_Open (int argc, Object *argv) {
|
||||
Object Gdbm_fh;
|
||||
GDBM_FILE dbf;
|
||||
|
||||
|
|
@ -140,13 +167,13 @@ Object P_Gdbm_Open (argc, argv) Object *argv; {
|
|||
return Gdbm_fh;
|
||||
}
|
||||
|
||||
void Check_Fh (fh) Object fh; {
|
||||
void Check_Fh (Object fh) {
|
||||
Check_Type (fh, T_Gdbm_fh);
|
||||
if (GDBM_FH(fh)->free)
|
||||
Primitive_Error ("invalid gdbm-file: ~s", fh);
|
||||
}
|
||||
|
||||
Object P_Gdbm_Close (fh) Object fh; {
|
||||
Object P_Gdbm_Close (Object fh) {
|
||||
Check_Fh (fh);
|
||||
GDBM_FH(fh)->free = 1;
|
||||
Disable_Interrupts;
|
||||
|
|
@ -174,7 +201,7 @@ Object P_Gdbm_Store (fh, key, content, flag)
|
|||
return Make_Integer (res);
|
||||
}
|
||||
|
||||
static Object Gdbm_Get (fh, key, func) Object fh, key; datum (*func)(); {
|
||||
static Object Gdbm_Get (Object fh, Object key, datum (*func)()) {
|
||||
Object res;
|
||||
datum k, c;
|
||||
|
||||
|
|
@ -192,15 +219,15 @@ static Object Gdbm_Get (fh, key, func) Object fh, key; datum (*func)(); {
|
|||
return res;
|
||||
}
|
||||
|
||||
Object P_Gdbm_Fetch (fh, key) Object fh, key; {
|
||||
Object P_Gdbm_Fetch (Object fh, Object key) {
|
||||
return Gdbm_Get (fh, key, gdbm_fetch);
|
||||
}
|
||||
|
||||
Object P_Gdbm_Nextkey (fh, key) Object fh, key; {
|
||||
Object P_Gdbm_Nextkey (Object fh, Object key) {
|
||||
return Gdbm_Get (fh, key, gdbm_nextkey);
|
||||
}
|
||||
|
||||
Object P_Gdbm_Delete (fh, key) Object fh, key; {
|
||||
Object P_Gdbm_Delete (Object fh, Object key) {
|
||||
int res;
|
||||
datum k;
|
||||
|
||||
|
|
@ -214,7 +241,7 @@ Object P_Gdbm_Delete (fh, key) Object fh, key; {
|
|||
return res == 0 ? True : False;
|
||||
}
|
||||
|
||||
Object P_Gdbm_Firstkey (fh) Object fh; {
|
||||
Object P_Gdbm_Firstkey (Object fh) {
|
||||
Object res;
|
||||
datum k;
|
||||
|
||||
|
|
@ -229,7 +256,7 @@ Object P_Gdbm_Firstkey (fh) Object fh; {
|
|||
return res;
|
||||
}
|
||||
|
||||
Object P_Gdbm_Reorganize (fh) Object fh; {
|
||||
Object P_Gdbm_Reorganize (Object fh) {
|
||||
Check_Fh (fh);
|
||||
Disable_Interrupts;
|
||||
gdbm_reorganize (GDBM_FH(fh)->fptr);
|
||||
|
|
|
|||
|
|
@ -1,6 +1,36 @@
|
|||
/* hack.c
|
||||
*
|
||||
* $Id$
|
||||
*
|
||||
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
||||
* Copyright 2002, 2003 Sam Hocevar <sam@zoy.org>, Paris
|
||||
*
|
||||
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
||||
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
||||
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
||||
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
||||
*
|
||||
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
||||
* owners or individual owners of copyright in this software, grant to any
|
||||
* person or company a worldwide, royalty free, license to
|
||||
*
|
||||
* i) copy this software,
|
||||
* ii) prepare derivative works based on this software,
|
||||
* iii) distribute copies of this software or derivative works,
|
||||
* iv) perform this software, or
|
||||
* v) display this software,
|
||||
*
|
||||
* provided that this notice is not removed and that neither Oliver Laumann
|
||||
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
||||
* the suitability of this software for any purpose nor are held responsible
|
||||
* for any defects of this software.
|
||||
*
|
||||
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
#include "scheme.h"
|
||||
|
||||
static Object P_Hack_Procedure_Environment (p, e) Object p, e; {
|
||||
static Object P_Hack_Procedure_Environment (Object p, Object e) {
|
||||
Check_Type (p, T_Compound);
|
||||
Check_Type (e, T_Environment);
|
||||
COMPOUND(p)->env = e;
|
||||
|
|
|
|||
|
|
@ -1,11 +1,38 @@
|
|||
/* A trivial function to enable and disable execution profiling.
|
||||
/* monitor.c: A trivial function to enable and disable execution profiling.
|
||||
*
|
||||
* Evaluate "(monitor #t)" to enable profiling; "(monitor #f)" to
|
||||
* disable profiling and create a mon.out (this is done automatically
|
||||
* on exit by means of an extension finalization function).
|
||||
*
|
||||
* $Id$
|
||||
*
|
||||
* This extension may not work on some platforms.
|
||||
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
||||
* Copyright 2002, 2003 Sam Hocevar <sam@zoy.org>, Paris
|
||||
*
|
||||
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
||||
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
||||
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
||||
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
||||
*
|
||||
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
||||
* owners or individual owners of copyright in this software, grant to any
|
||||
* person or company a worldwide, royalty free, license to
|
||||
*
|
||||
* i) copy this software,
|
||||
* ii) prepare derivative works based on this software,
|
||||
* iii) distribute copies of this software or derivative works,
|
||||
* iv) perform this software, or
|
||||
* v) display this software,
|
||||
*
|
||||
* provided that this notice is not removed and that neither Oliver Laumann
|
||||
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
||||
* the suitability of this software for any purpose nor are held responsible
|
||||
* for any defects of this software.
|
||||
*
|
||||
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
/* This extension may not work on some platforms.
|
||||
*
|
||||
* On DECstations running Ultrix, you may have to evaluate
|
||||
* (set! load-libraries "/usr/lib/cmplrs/cc/libprof1_G0.a -lc_G0")
|
||||
|
|
@ -30,9 +57,9 @@
|
|||
|
||||
#define MONSTART 2
|
||||
|
||||
static monitoring;
|
||||
static int monitoring;
|
||||
|
||||
static Object P_Monitor (on) Object on; {
|
||||
static Object P_Monitor (Object on) {
|
||||
char *brk;
|
||||
extern char *sbrk();
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,33 @@
|
|||
/* record.c
|
||||
*
|
||||
* $Id$
|
||||
*
|
||||
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
||||
* Copyright 2002, 2003 Sam Hocevar <sam@zoy.org>, Paris
|
||||
*
|
||||
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
||||
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
||||
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
||||
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
||||
*
|
||||
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
||||
* owners or individual owners of copyright in this software, grant to any
|
||||
* person or company a worldwide, royalty free, license to
|
||||
*
|
||||
* i) copy this software,
|
||||
* ii) prepare derivative works based on this software,
|
||||
* iii) distribute copies of this software or derivative works,
|
||||
* iv) perform this software, or
|
||||
* v) display this software,
|
||||
*
|
||||
* provided that this notice is not removed and that neither Oliver Laumann
|
||||
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
||||
* the suitability of this software for any purpose nor are held responsible
|
||||
* for any defects of this software.
|
||||
*
|
||||
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
#include "scheme.h"
|
||||
|
||||
#define RTD(x) ((struct S_Rtd *)POINTER(x))
|
||||
|
|
@ -15,25 +45,25 @@ struct S_Record {
|
|||
|
||||
int T_Rtd, T_Record;
|
||||
|
||||
static Object P_Rtdp (x) Object x; {
|
||||
static Object P_Rtdp (Object x) {
|
||||
return TYPE(x) == T_Rtd ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Recordp (x) Object x; {
|
||||
static Object P_Recordp (Object x) {
|
||||
return TYPE(x) == T_Record ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Rtd_Name (x) Object x; {
|
||||
static Object P_Rtd_Name (Object x) {
|
||||
Check_Type (x, T_Rtd);
|
||||
return RTD(x)->name;
|
||||
}
|
||||
|
||||
static Object P_Rtd_Field_Names (x) Object x; {
|
||||
static Object P_Rtd_Field_Names (Object x) {
|
||||
Check_Type (x, T_Rtd);
|
||||
return RTD(x)->fields;
|
||||
}
|
||||
|
||||
static Object P_Make_Record_Type (name, fields) Object name, fields; {
|
||||
static Object P_Make_Record_Type (Object name, Object fields) {
|
||||
Object s, ismem;
|
||||
GC_Node2;
|
||||
|
||||
|
|
@ -56,17 +86,17 @@ static Object P_Make_Record_Type (name, fields) Object name, fields; {
|
|||
return s;
|
||||
}
|
||||
|
||||
static Object P_Record_Type (x) Object x; {
|
||||
static Object P_Record_Type (Object x) {
|
||||
Check_Type (x, T_Record);
|
||||
return RECORD(x)->rtd;
|
||||
}
|
||||
|
||||
static Object P_Record_Values (x) Object x; {
|
||||
static Object P_Record_Values (Object x) {
|
||||
Check_Type (x, T_Record);
|
||||
return RECORD(x)->values;
|
||||
}
|
||||
|
||||
static Object P_Make_Record (rtd, values) Object rtd, values; {
|
||||
static Object P_Make_Record (Object rtd, Object values) {
|
||||
Object s;
|
||||
GC_Node2;
|
||||
|
||||
|
|
@ -97,13 +127,14 @@ static int Record_Equal (Object a, Object b) {
|
|||
Equal (RECORD(a)->values, RECORD(b)->values);
|
||||
}
|
||||
|
||||
static int Rtd_Print (x, port, raw, depth, length) Object x, port; {
|
||||
static int Rtd_Print (Object x, Object port, int raw, int depth, int length) {
|
||||
struct S_String *s = STRING(RTD(x)->name);
|
||||
Printf (port, "#[%.*s-record-type %lu]", s->size, s->data, POINTER(x));
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int Record_Print (x, port, raw, depth, length) Object x, port; {
|
||||
static int Record_Print (Object x, Object port,
|
||||
int raw, int depth, int length) {
|
||||
struct S_String *s = STRING(RTD(RECORD(x)->rtd)->name);
|
||||
Printf (port, "#[%.*s-record-type %lu]", s->size, s->data, POINTER(x));
|
||||
return 0;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,35 @@
|
|||
/* The regular expression extension. It provides Scheme language
|
||||
/* regexp.c: The regular expression extension. It provides Scheme language
|
||||
* bindings to the POSIX regcomp/regexec functions.
|
||||
*
|
||||
* Inspired by a GNU regular expression extension contributed by
|
||||
* Stephen J. Bevan to an earlier version of Elk.
|
||||
*
|
||||
* $Id$
|
||||
*
|
||||
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
||||
* Copyright 2002, 2003 Sam Hocevar <sam@zoy.org>, Paris
|
||||
*
|
||||
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
||||
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
||||
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
||||
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
||||
*
|
||||
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
||||
* owners or individual owners of copyright in this software, grant to any
|
||||
* person or company a worldwide, royalty free, license to
|
||||
*
|
||||
* i) copy this software,
|
||||
* ii) prepare derivative works based on this software,
|
||||
* iii) distribute copies of this software or derivative works,
|
||||
* iv) perform this software, or
|
||||
* v) display this software,
|
||||
*
|
||||
* provided that this notice is not removed and that neither Oliver Laumann
|
||||
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
||||
* the suitability of this software for any purpose nor are held responsible
|
||||
* for any defects of this software.
|
||||
*
|
||||
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
#include "scheme.h"
|
||||
|
|
@ -45,11 +72,11 @@ static SYMDESCR Exec_Syms[] = {
|
|||
{ 0, 0 }
|
||||
};
|
||||
|
||||
static Object P_Regexpp(x) Object x; {
|
||||
static Object P_Regexpp(Object x) {
|
||||
return TYPE(x) == T_Regexp ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Matchp(x) Object x; {
|
||||
static Object P_Matchp(Object x) {
|
||||
return TYPE(x) == T_Match ? True : False;
|
||||
}
|
||||
|
||||
|
|
@ -77,7 +104,7 @@ static int Match_Equal(Object a, Object b) {
|
|||
return 1;
|
||||
}
|
||||
|
||||
static int Match_Size(m) Object m; {
|
||||
static int Match_Size(Object m) {
|
||||
return sizeof(struct S_Match) + (MATCH(m)->num - 1) * sizeof(regmatch_t);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,33 @@
|
|||
/* The `structure' extension is obsolete and should not be used in
|
||||
* applications any longer; it has been replaced by the more powerful
|
||||
/* struct.c: The `structure' extension is obsolete and should not be used
|
||||
* in applications any longer; it has been replaced by the more powerful
|
||||
* `record' extension.
|
||||
*
|
||||
* $Id$
|
||||
*
|
||||
* Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
|
||||
* Copyright 2002, 2003 Sam Hocevar <sam@zoy.org>, Paris
|
||||
*
|
||||
* This software was derived from Elk 1.2, which was Copyright 1987, 1988,
|
||||
* 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
|
||||
* by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
|
||||
* between TELES and Nixdorf Microprocessor Engineering, Berlin).
|
||||
*
|
||||
* Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
|
||||
* owners or individual owners of copyright in this software, grant to any
|
||||
* person or company a worldwide, royalty free, license to
|
||||
*
|
||||
* i) copy this software,
|
||||
* ii) prepare derivative works based on this software,
|
||||
* iii) distribute copies of this software or derivative works,
|
||||
* iv) perform this software, or
|
||||
* v) display this software,
|
||||
*
|
||||
* provided that this notice is not removed and that neither Oliver Laumann
|
||||
* nor Teles nor Nixdorf are deemed to have made any representations as to
|
||||
* the suitability of this software for any purpose nor are held responsible
|
||||
* for any defects of this software.
|
||||
*
|
||||
* THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
|
||||
*/
|
||||
|
||||
#include "scheme.h"
|
||||
|
|
@ -15,26 +42,26 @@ struct S_Struct {
|
|||
|
||||
int T_Struct;
|
||||
|
||||
static Object P_Structurep (x) Object x; {
|
||||
static Object P_Structurep (Object x) {
|
||||
return TYPE(x) == T_Struct ? True : False;
|
||||
}
|
||||
|
||||
static Object P_Structure_Name (x) Object x; {
|
||||
static Object P_Structure_Name (Object x) {
|
||||
Check_Type (x, T_Struct);
|
||||
return STRUCT(x)->name;
|
||||
}
|
||||
|
||||
static Object P_Structure_Slots (x) Object x; {
|
||||
static Object P_Structure_Slots (Object x) {
|
||||
Check_Type (x, T_Struct);
|
||||
return P_Vector_To_List (STRUCT(x)->slots);
|
||||
}
|
||||
|
||||
static Object P_Structure_Values (x) Object x; {
|
||||
static Object P_Structure_Values (Object x) {
|
||||
Check_Type (x, T_Struct);
|
||||
return P_Vector_To_List (STRUCT(x)->values);
|
||||
}
|
||||
|
||||
static Check_Structure_Type (x, t) Object x, t; {
|
||||
static void Check_Structure_Type (Object x, Object t) {
|
||||
Check_Type (x, T_Struct);
|
||||
Check_Type (t, T_Symbol);
|
||||
if (!EQ(STRUCT(x)->name, t))
|
||||
|
|
@ -42,18 +69,18 @@ static Check_Structure_Type (x, t) Object x, t; {
|
|||
STRUCT(x)->name, t);
|
||||
}
|
||||
|
||||
static Object P_Structure_Ref (x, t, n) Object x, t, n; {
|
||||
static Object P_Structure_Ref (Object x, Object t, Object n) {
|
||||
Check_Structure_Type (x, t);
|
||||
return P_Vector_Ref (STRUCT(x)->values, n);
|
||||
}
|
||||
|
||||
static Object P_Structure_Set (x, t, n, obj) Object x, t, n, obj; {
|
||||
static Object P_Structure_Set (Object x, Object t, Object n, Object obj) {
|
||||
Check_Structure_Type (x, t);
|
||||
return P_Vector_Set (STRUCT(x)->values, n, obj);
|
||||
}
|
||||
|
||||
static Object P_Make_Structure (name, slots) Object name, slots; {
|
||||
register n;
|
||||
static Object P_Make_Structure (Object name, Object slots) {
|
||||
register int n;
|
||||
Object s, vec, *vp;
|
||||
GC_Node3;
|
||||
|
||||
|
|
@ -77,23 +104,28 @@ static Object P_Make_Structure (name, slots) Object name, slots; {
|
|||
return s;
|
||||
}
|
||||
|
||||
static Structure_Eqv (a, b) Object a, b; { return EQ(a,b); }
|
||||
static int Structure_Eqv (Object a, Object b) {
|
||||
return EQ(a,b);
|
||||
}
|
||||
|
||||
static Structure_Equal (a, b) Object a, b; {
|
||||
static int Structure_Equal (Object a, Object b) {
|
||||
return EQ(STRUCT(a)->name,STRUCT(b)->name) &&
|
||||
Equal (STRUCT(a)->slots, STRUCT(b)->slots) &&
|
||||
Equal (STRUCT(a)->values, STRUCT(b)->values);
|
||||
}
|
||||
|
||||
static Structure_Print (x, port, raw, depth, length) Object x, port; {
|
||||
static int Structure_Print (Object x, Object port,
|
||||
int raw, int depth, int length) {
|
||||
struct S_String *s = STRING(SYMBOL(STRUCT(x)->name)->name);
|
||||
Printf (port, "#[%.*s-structure %lu]", s->size, s->data, POINTER(x));
|
||||
return 0;
|
||||
}
|
||||
|
||||
static Structure_Visit (sp, f) register Object *sp; register (*f)(); {
|
||||
static int Structure_Visit (register Object *sp, register int (*f)()) {
|
||||
(*f)(&STRUCT(*sp)->name);
|
||||
(*f)(&STRUCT(*sp)->slots);
|
||||
(*f)(&STRUCT(*sp)->values);
|
||||
return 0;
|
||||
}
|
||||
|
||||
void elk_init_lib_struct () {
|
||||
|
|
|
|||
Loading…
Reference in New Issue