mirror of
git://git.gnupg.org/gnupg.git
synced 2025-07-02 22:46:30 +02:00
tests/gpgscm: Verbatim import of latest TinySCHEME.
Revision 110 from svn://svn.code.sf.net/p/tinyscheme/code/trunk * tests/gpgscm/COPYING: New file. * tests/gpgscm/Manual.txt: Likewise. * tests/gpgscm/init.scm: Likewise. * tests/gpgscm/opdefines.h: Likewise. * tests/gpgscm/scheme-private.h: Likewise. * tests/gpgscm/scheme.c: Likewise. * tests/gpgscm/scheme.h: Likewise. Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
parent
4e41745b3e
commit
cb989504cd
7 changed files with 6917 additions and 0 deletions
220
tests/gpgscm/scheme-private.h
Normal file
220
tests/gpgscm/scheme-private.h
Normal file
|
@ -0,0 +1,220 @@
|
|||
/* scheme-private.h */
|
||||
|
||||
#ifndef _SCHEME_PRIVATE_H
|
||||
#define _SCHEME_PRIVATE_H
|
||||
|
||||
#include "scheme.h"
|
||||
/*------------------ Ugly internals -----------------------------------*/
|
||||
/*------------------ Of interest only to FFI users --------------------*/
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
enum scheme_port_kind {
|
||||
port_free=0,
|
||||
port_file=1,
|
||||
port_string=2,
|
||||
port_srfi6=4,
|
||||
port_input=16,
|
||||
port_output=32,
|
||||
port_saw_EOF=64
|
||||
};
|
||||
|
||||
typedef struct port {
|
||||
unsigned char kind;
|
||||
union {
|
||||
struct {
|
||||
FILE *file;
|
||||
int closeit;
|
||||
#if SHOW_ERROR_LINE
|
||||
int curr_line;
|
||||
char *filename;
|
||||
#endif
|
||||
} stdio;
|
||||
struct {
|
||||
char *start;
|
||||
char *past_the_end;
|
||||
char *curr;
|
||||
} string;
|
||||
} rep;
|
||||
} port;
|
||||
|
||||
/* cell structure */
|
||||
struct cell {
|
||||
unsigned int _flag;
|
||||
union {
|
||||
struct {
|
||||
char *_svalue;
|
||||
int _length;
|
||||
} _string;
|
||||
num _number;
|
||||
port *_port;
|
||||
foreign_func _ff;
|
||||
struct {
|
||||
struct cell *_car;
|
||||
struct cell *_cdr;
|
||||
} _cons;
|
||||
} _object;
|
||||
};
|
||||
|
||||
struct scheme {
|
||||
/* arrays for segments */
|
||||
func_alloc malloc;
|
||||
func_dealloc free;
|
||||
|
||||
/* return code */
|
||||
int retcode;
|
||||
int tracing;
|
||||
|
||||
|
||||
#ifndef CELL_SEGSIZE
|
||||
#define CELL_SEGSIZE 5000 /* # of cells in one segment */
|
||||
#endif
|
||||
#ifndef CELL_NSEGMENT
|
||||
#define CELL_NSEGMENT 10 /* # of segments for cells */
|
||||
#endif
|
||||
char *alloc_seg[CELL_NSEGMENT];
|
||||
pointer cell_seg[CELL_NSEGMENT];
|
||||
int last_cell_seg;
|
||||
|
||||
/* We use 4 registers. */
|
||||
pointer args; /* register for arguments of function */
|
||||
pointer envir; /* stack register for current environment */
|
||||
pointer code; /* register for current code */
|
||||
pointer dump; /* stack register for next evaluation */
|
||||
|
||||
int interactive_repl; /* are we in an interactive REPL? */
|
||||
|
||||
struct cell _sink;
|
||||
pointer sink; /* when mem. alloc. fails */
|
||||
struct cell _NIL;
|
||||
pointer NIL; /* special cell representing empty cell */
|
||||
struct cell _HASHT;
|
||||
pointer T; /* special cell representing #t */
|
||||
struct cell _HASHF;
|
||||
pointer F; /* special cell representing #f */
|
||||
struct cell _EOF_OBJ;
|
||||
pointer EOF_OBJ; /* special cell representing end-of-file object */
|
||||
pointer oblist; /* pointer to symbol table */
|
||||
pointer global_env; /* pointer to global environment */
|
||||
pointer c_nest; /* stack for nested calls from C */
|
||||
|
||||
/* global pointers to special symbols */
|
||||
pointer LAMBDA; /* pointer to syntax lambda */
|
||||
pointer QUOTE; /* pointer to syntax quote */
|
||||
|
||||
pointer QQUOTE; /* pointer to symbol quasiquote */
|
||||
pointer UNQUOTE; /* pointer to symbol unquote */
|
||||
pointer UNQUOTESP; /* pointer to symbol unquote-splicing */
|
||||
pointer FEED_TO; /* => */
|
||||
pointer COLON_HOOK; /* *colon-hook* */
|
||||
pointer ERROR_HOOK; /* *error-hook* */
|
||||
pointer SHARP_HOOK; /* *sharp-hook* */
|
||||
pointer COMPILE_HOOK; /* *compile-hook* */
|
||||
|
||||
pointer free_cell; /* pointer to top of free cells */
|
||||
long fcells; /* # of free cells */
|
||||
|
||||
pointer inport;
|
||||
pointer outport;
|
||||
pointer save_inport;
|
||||
pointer loadport;
|
||||
|
||||
#ifndef MAXFIL
|
||||
#define MAXFIL 64
|
||||
#endif
|
||||
port load_stack[MAXFIL]; /* Stack of open files for port -1 (LOADing) */
|
||||
int nesting_stack[MAXFIL];
|
||||
int file_i;
|
||||
int nesting;
|
||||
|
||||
char gc_verbose; /* if gc_verbose is not zero, print gc status */
|
||||
char no_memory; /* Whether mem. alloc. has failed */
|
||||
|
||||
#ifndef LINESIZE
|
||||
#define LINESIZE 1024
|
||||
#endif
|
||||
char linebuff[LINESIZE];
|
||||
#ifndef STRBUFFSIZE
|
||||
#define STRBUFFSIZE 256
|
||||
#endif
|
||||
char strbuff[STRBUFFSIZE];
|
||||
|
||||
FILE *tmpfp;
|
||||
int tok;
|
||||
int print_flag;
|
||||
pointer value;
|
||||
int op;
|
||||
|
||||
void *ext_data; /* For the benefit of foreign functions */
|
||||
long gensym_cnt;
|
||||
|
||||
struct scheme_interface *vptr;
|
||||
void *dump_base; /* pointer to base of allocated dump stack */
|
||||
int dump_size; /* number of frames allocated for dump stack */
|
||||
};
|
||||
|
||||
/* operator code */
|
||||
enum scheme_opcodes {
|
||||
#define _OP_DEF(A,B,C,D,E,OP) OP,
|
||||
#include "opdefines.h"
|
||||
OP_MAXDEFINED
|
||||
};
|
||||
|
||||
|
||||
#define cons(sc,a,b) _cons(sc,a,b,0)
|
||||
#define immutable_cons(sc,a,b) _cons(sc,a,b,1)
|
||||
|
||||
int is_string(pointer p);
|
||||
char *string_value(pointer p);
|
||||
int is_number(pointer p);
|
||||
num nvalue(pointer p);
|
||||
long ivalue(pointer p);
|
||||
double rvalue(pointer p);
|
||||
int is_integer(pointer p);
|
||||
int is_real(pointer p);
|
||||
int is_character(pointer p);
|
||||
long charvalue(pointer p);
|
||||
int is_vector(pointer p);
|
||||
|
||||
int is_port(pointer p);
|
||||
|
||||
int is_pair(pointer p);
|
||||
pointer pair_car(pointer p);
|
||||
pointer pair_cdr(pointer p);
|
||||
pointer set_car(pointer p, pointer q);
|
||||
pointer set_cdr(pointer p, pointer q);
|
||||
|
||||
int is_symbol(pointer p);
|
||||
char *symname(pointer p);
|
||||
int hasprop(pointer p);
|
||||
|
||||
int is_syntax(pointer p);
|
||||
int is_proc(pointer p);
|
||||
int is_foreign(pointer p);
|
||||
char *syntaxname(pointer p);
|
||||
int is_closure(pointer p);
|
||||
#ifdef USE_MACRO
|
||||
int is_macro(pointer p);
|
||||
#endif
|
||||
pointer closure_code(pointer p);
|
||||
pointer closure_env(pointer p);
|
||||
|
||||
int is_continuation(pointer p);
|
||||
int is_promise(pointer p);
|
||||
int is_environment(pointer p);
|
||||
int is_immutable(pointer p);
|
||||
void setimmutable(pointer p);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
Local variables:
|
||||
c-file-style: "k&r"
|
||||
End:
|
||||
*/
|
Loading…
Add table
Add a link
Reference in a new issue