Renaming all USE_ settings and all OP_, OPC_ and CORE_ enums

to have an SEXP_ prefix.  Now all values from the headers
are prefixed with either sexp_ or SEXP_, important for ease
of embedding.  "make USE_BOEHM=1" still works as an alias
for "make SEXP_USE_BOEHM=1".

Sorry if this patch breaks your code, it had to be done
sooner or later.
This commit is contained in:
Alex Shinn 2009-12-18 15:58:23 +09:00
parent 9c77070888
commit 6fe11ffcd1
19 changed files with 607 additions and 581 deletions

View file

@ -3,6 +3,8 @@
.PHONY: all libs doc dist clean cleaner test install uninstall .PHONY: all libs doc dist clean cleaner test install uninstall
.PRECIOUS: %.c .PRECIOUS: %.c
# install configuration
CC ?= cc CC ?= cc
PREFIX ?= /usr/local PREFIX ?= /usr/local
BINDIR ?= $(PREFIX)/bin BINDIR ?= $(PREFIX)/bin
@ -16,6 +18,9 @@ DESTDIR ?=
GENSTUBS ?= ./tools/genstubs.scm GENSTUBS ?= ./tools/genstubs.scm
# system configuration - if not using GNU make, set PLATFORM and the
# following flags as necessary.
ifndef PLATFORM ifndef PLATFORM
ifeq ($(shell uname),Darwin) ifeq ($(shell uname),Darwin)
PLATFORM=macosx PLATFORM=macosx
@ -34,23 +39,45 @@ ifeq ($(PLATFORM),macosx)
SO = .dylib SO = .dylib
EXE = EXE =
CLIBFLAGS = -dynamiclib CLIBFLAGS = -dynamiclib
STATICFLAGS = -static-libgcc -DUSE_DL=0 STATICFLAGS = -static-libgcc -DSEXP_USE_DL=0
else else
ifeq ($(PLATFORM),mingw) ifeq ($(PLATFORM),mingw)
SO = .dll SO = .dll
EXE = .exe EXE = .exe
CC = gcc CC = gcc
CLIBFLAGS = -shared CLIBFLAGS = -shared
CPPFLAGS += -DUSE_STRING_STREAMS=0 -DBUILDING_DLL -DUSE_DEBUG=0 CPPFLAGS += -DSEXP_USE_STRING_STREAMS=0 -DBUILDING_DLL -DSEXP_USE_DEBUG=0
LDFLAGS += -Wl,--out-implib,libchibi-scheme$(SO).a LDFLAGS += -Wl,--out-implib,libchibi-scheme$(SO).a
else else
SO = .so SO = .so
EXE = EXE =
CLIBFLAGS = -fPIC -shared CLIBFLAGS = -fPIC -shared
STATICFLAGS = -static -DUSE_DL=0 STATICFLAGS = -static -DSEXP_USE_DL=0
endif endif
endif endif
ifeq ($(USE_BOEHM),1)
SEXP_USE_BOEHM = 1
endif
ifeq ($(SEXP_USE_BOEHM),1)
GCLDFLAGS := -lgc
XCPPFLAGS := $(CPPFLAGS) -Iinclude -DSEXP_USE_BOEHM=1
else
GCLDFLAGS :=
XCPPFLAGS := $(CPPFLAGS) -Iinclude
endif
ifeq ($(SEXP_USE_DL),0)
XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -lm
XCFLAGS := -Wall -DSEXP_USE_DL=0 -g3 $(CFLAGS)
else
XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -ldl -lm
XCFLAGS := -Wall -g3 $(CFLAGS)
endif
########################################################################
all: chibi-scheme$(EXE) libs all: chibi-scheme$(EXE) libs
COMPILED_LIBS := lib/srfi/27/rand$(SO) lib/srfi/33/bit$(SO) \ COMPILED_LIBS := lib/srfi/27/rand$(SO) lib/srfi/33/bit$(SO) \
@ -60,22 +87,6 @@ COMPILED_LIBS := lib/srfi/27/rand$(SO) lib/srfi/33/bit$(SO) \
libs: $(COMPILED_LIBS) libs: $(COMPILED_LIBS)
ifeq ($(USE_BOEHM),1)
GCLDFLAGS := -lgc
XCPPFLAGS := $(CPPFLAGS) -Iinclude -DUSE_BOEHM=1
else
GCLDFLAGS :=
XCPPFLAGS := $(CPPFLAGS) -Iinclude
endif
ifeq ($(USE_DL),0)
XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -lm
XCFLAGS := -Wall -DUSE_DL=0 -g3 $(CFLAGS)
else
XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -ldl -lm
XCFLAGS := -Wall -g3 $(CFLAGS)
endif
INCLUDES = include/chibi/sexp.h include/chibi/config.h include/chibi/install.h INCLUDES = include/chibi/sexp.h include/chibi/config.h include/chibi/install.h
include/chibi/install.h: Makefile include/chibi/install.h: Makefile

398
eval.c

File diff suppressed because it is too large Load diff

14
gc.c
View file

@ -31,11 +31,11 @@
#define sexp_heap_align(n) sexp_align(n, 4) #define sexp_heap_align(n) sexp_align(n, 4)
#endif #endif
#if USE_GLOBAL_HEAP #if SEXP_USE_GLOBAL_HEAP
static sexp_heap sexp_global_heap; static sexp_heap sexp_global_heap;
#endif #endif
#if USE_DEBUG_GC #if SEXP_USE_DEBUG_GC
static sexp* stack_base; static sexp* stack_base;
#endif #endif
@ -76,7 +76,7 @@ void sexp_mark (sexp x) {
} }
} }
#if USE_DEBUG_GC #if SEXP_USE_DEBUG_GC
int stack_references_pointer_p (sexp ctx, sexp x) { int stack_references_pointer_p (sexp ctx, sexp x) {
sexp *p; sexp *p;
for (p=(&x)+1; p<stack_base; p++) for (p=(&x)+1; p<stack_base; p++)
@ -156,7 +156,7 @@ sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
sexp sexp_gc (sexp ctx, size_t *sum_freed) { sexp sexp_gc (sexp ctx, size_t *sum_freed) {
sexp res; sexp res;
#if USE_GLOBAL_SYMBOLS #if SEXP_USE_GLOBAL_SYMBOLS
int i; int i;
for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++) for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
sexp_mark(sexp_symbol_table[i]); sexp_mark(sexp_symbol_table[i]);
@ -232,13 +232,13 @@ void* sexp_alloc (sexp ctx, size_t size) {
} }
void sexp_gc_init (void) { void sexp_gc_init (void) {
#if USE_GLOBAL_HEAP || USE_DEBUG_GC #if SEXP_USE_GLOBAL_HEAP || SEXP_USE_DEBUG_GC
sexp_uint_t size = sexp_heap_align(SEXP_INITIAL_HEAP_SIZE); sexp_uint_t size = sexp_heap_align(SEXP_INITIAL_HEAP_SIZE);
#endif #endif
#if USE_GLOBAL_HEAP #if SEXP_USE_GLOBAL_HEAP
sexp_global_heap = sexp_make_heap(size); sexp_global_heap = sexp_make_heap(size);
#endif #endif
#if USE_DEBUG_GC #if SEXP_USE_DEBUG_GC
/* the +32 is a hack, but this is just for debugging anyway */ /* the +32 is a hack, but this is just for debugging anyway */
stack_base = ((sexp*)&size) + 32; stack_base = ((sexp*)&size) + 32;
#endif #endif

View file

@ -5,21 +5,27 @@
/* uncomment this to disable the module system */ /* uncomment this to disable the module system */
/* Currently this just loads the config.scm from main and */ /* Currently this just loads the config.scm from main and */
/* sets up an (import (module name)) macro. */ /* sets up an (import (module name)) macro. */
/* #define USE_MODULES 0 */ /* #define SEXP_USE_MODULES 0 */
/* uncomment this to disable dynamic loading */ /* uncomment this to disable dynamic loading */
/* If enabled, you can LOAD .so files with a */ /* If enabled, you can LOAD .so files with a */
/* sexp_init_library(ctx, env) function provided. */ /* sexp_init_library(ctx, env) function provided. */
/* #define USE_DL 0 */ /* #define SEXP_USE_DL 0 */
/* uncomment this to disable a simplifying optimization pass */ /* uncomment this to disable a simplifying optimization pass */
/* #define USE_SIMPLIFY 0 */ /* This performs some simple optimizations such as dead-code */
/* elimination, constant-folding, and directly propagating */
/* non-mutated let values bound to constants or non-mutated */
/* references. More than performance, this is aimed at reducing the */
/* size of the compiled code, especially as the result of macro */
/* expansions, so it's a good idea to leave it enabled. */
/* #define SEXP_USE_SIMPLIFY 0 */
/* uncomment this to disable dynamic type definitions */ /* uncomment this to disable dynamic type definitions */
/* This enables register-simple-type and related */ /* This enables register-simple-type and related */
/* opcodes for defining types, needed by the default */ /* opcodes for defining types, needed by the default */
/* implementation of (srfi 9). */ /* implementation of (srfi 9). */
/* #define USE_TYPE_DEFS 0 */ /* #define SEXP_USE_TYPE_DEFS 0 */
/* uncomment this to use the Boehm conservative GC */ /* uncomment this to use the Boehm conservative GC */
/* Conservative GCs make it easier to write extensions, */ /* Conservative GCs make it easier to write extensions, */
@ -28,100 +34,100 @@
/* very large library to link in. You may want to */ /* very large library to link in. You may want to */
/* enable this when debugging your own extensions, or */ /* enable this when debugging your own extensions, or */
/* if you suspect a bug in the native GC. */ /* if you suspect a bug in the native GC. */
/* #define USE_BOEHM 1 */ /* #define SEXP_USE_BOEHM 1 */
/* uncomment this to just malloc manually instead of any GC */ /* uncomment this to just malloc manually instead of any GC */
/* Mostly for debugging purposes, this is the no GC option. */ /* Mostly for debugging purposes, this is the no GC option. */
/* You can use just the read/write API and */ /* You can use just the read/write API and */
/* explicitly free sexps, though. */ /* explicitly free sexps, though. */
/* #define USE_MALLOC 1 */ /* #define SEXP_USE_MALLOC 1 */
/* uncomment this to add conservative checks to the native GC */ /* uncomment this to add conservative checks to the native GC */
/* Please mail the author if enabling this makes a bug */ /* Please mail the author if enabling this makes a bug */
/* go away and you're not working on your own C extension. */ /* go away and you're not working on your own C extension. */
/* #define USE_DEBUG_GC 1 */ /* #define SEXP_USE_DEBUG_GC 1 */
/* uncomment this to make the heap common to all contexts */ /* uncomment this to make the heap common to all contexts */
/* By default separate contexts can have separate heaps, */ /* By default separate contexts can have separate heaps, */
/* and are thus thread-safe and independant. */ /* and are thus thread-safe and independant. */
/* #define USE_GLOBAL_HEAP 1 */ /* #define SEXP_USE_GLOBAL_HEAP 1 */
/* uncomment this to make the symbol table common to all contexts */ /* uncomment this to make the symbol table common to all contexts */
/* Will still be restricted to all contexts sharing the same */ /* Will still be restricted to all contexts sharing the same */
/* heap, of course. */ /* heap, of course. */
/* #define USE_GLOBAL_SYMBOLS 1 */ /* #define SEXP_USE_GLOBAL_SYMBOLS 1 */
/* uncomment this if you don't need flonum support */ /* uncomment this if you don't need flonum support */
/* This is only for EVAL - you'll still be able to read */ /* This is only for EVAL - you'll still be able to read */
/* and write flonums directly through the sexp API. */ /* and write flonums directly through the sexp API. */
/* #define USE_FLONUMS 0 */ /* #define SEXP_USE_FLONUMS 0 */
/* uncomment this to disable reading/writing IEEE infinities */ /* uncomment this to disable reading/writing IEEE infinities */
/* By default you can read/write +inf.0, -inf.0 and +nan.0 */ /* By default you can read/write +inf.0, -inf.0 and +nan.0 */
/* #define USE_INFINITIES 0 */ /* #define SEXP_USE_INFINITIES 0 */
/* uncomment this if you want immediate flonums */ /* uncomment this if you want immediate flonums */
/* This is experimental, enable at your own risk. */ /* This is experimental, enable at your own risk. */
/* #define USE_IMMEDIATE_FLONUMS 1 */ /* #define SEXP_USE_IMMEDIATE_FLONUMS 1 */
/* uncomment this if you don't want bignum support */ /* uncomment this if you don't want bignum support */
/* Bignums are implemented with a small, custom library */ /* Bignums are implemented with a small, custom library */
/* in opt/bignum.c. */ /* in opt/bignum.c. */
/* #define USE_BIGNUMS 0 */ /* #define SEXP_USE_BIGNUMS 0 */
/* uncomment this if you don't need extended math operations */ /* uncomment this if you don't need extended math operations */
/* This includes the trigonometric and expt functions. */ /* This includes the trigonometric and expt functions. */
/* Automatically disabled if you've disabled flonums. */ /* Automatically disabled if you've disabled flonums. */
/* #define USE_MATH 0 */ /* #define SEXP_USE_MATH 0 */
/* uncomment this to disable warning about references to undefined variables */ /* uncomment this to disable warning about references to undefined variables */
/* This is something of a hack, but can be quite useful. */ /* This is something of a hack, but can be quite useful. */
/* It's very fast and doesn't involve any separate analysis */ /* It's very fast and doesn't involve any separate analysis */
/* passes. */ /* passes. */
/* #define USE_WARN_UNDEFS 0 */ /* #define SEXP_USE_WARN_UNDEFS 0 */
/* uncomment this to disable huffman-coded immediate symbols */ /* uncomment this to disable huffman-coded immediate symbols */
/* By default (this may change) small symbols are represented */ /* By default (this may change) small symbols are represented */
/* as immediates using a simple huffman encoding. This keeps */ /* as immediates using a simple huffman encoding. This keeps */
/* the symbol table small, and minimizes hashing when doing a */ /* the symbol table small, and minimizes hashing when doing a */
/* lot of reading. */ /* lot of reading. */
/* #define USE_HUFF_SYMS 0 */ /* #define SEXP_USE_HUFF_SYMS 0 */
/* uncomment this to just use a single list for hash tables */ /* uncomment this to just use a single list for hash tables */
/* You can trade off some space in exchange for longer read */ /* You can trade off some space in exchange for longer read */
/* times by disabling hashing and just putting all */ /* times by disabling hashing and just putting all */
/* non-immediate symbols in a single list. */ /* non-immediate symbols in a single list. */
/* #define USE_HASH_SYMS 0 */ /* #define SEXP_USE_HASH_SYMS 0 */
/* uncomment this to disable string ports */ /* uncomment this to disable string ports */
/* If disabled some basic functionality such as number->string */ /* If disabled some basic functionality such as number->string */
/* will not be available by default. */ /* will not be available by default. */
/* #define USE_STRING_STREAMS 0 */ /* #define SEXP_USE_STRING_STREAMS 0 */
/* uncomment this to disable automatic closing of ports */ /* uncomment this to disable automatic closing of ports */
/* If enabled, the underlying FILE* for file ports will be */ /* If enabled, the underlying FILE* for file ports will be */
/* automatically closed when they're garbage collected. Doesn't */ /* automatically closed when they're garbage collected. Doesn't */
/* apply to stdin/stdout/stderr. */ /* apply to stdin/stdout/stderr. */
/* #define USE_AUTOCLOSE_PORTS 0 */ /* #define SEXP_USE_AUTOCLOSE_PORTS 0 */
/* uncomment this to use the normal 1970 unix epoch */ /* uncomment this to use the normal 1970 unix epoch */
/* By default chibi uses an datetime epoch starting at */ /* By default chibi uses an datetime epoch starting at */
/* 2010/01/01 00:00:00 in order to be able to represent */ /* 2010/01/01 00:00:00 in order to be able to represent */
/* more common times as fixnums. */ /* more common times as fixnums. */
/* #define USE_2010_EPOCH 0 */ /* #define SEXP_USE_2010_EPOCH 0 */
/* uncomment this to disable stack overflow checks */ /* uncomment this to disable stack overflow checks */
/* By default stacks are fairly small, so it's good to leave */ /* By default stacks are fairly small, so it's good to leave */
/* this enabled. */ /* this enabled. */
/* #define USE_CHECK_STACK 0 */ /* #define SEXP_USE_CHECK_STACK 0 */
/* uncomment this to disable debugging utilities */ /* uncomment this to disable debugging utilities */
/* By default there's a `disasm' procedure you can use to */ /* By default there's a `disasm' procedure you can use to */
/* view the compiled VM instructions of a procedure. You can */ /* view the compiled VM instructions of a procedure. You can */
/* disable this if you don't need it. */ /* disable this if you don't need it. */
/* #define USE_DEBUG 0 */ /* #define SEXP_USE_DEBUG 0 */
/* #define USE_DEBUG_VM 0 */ /* #define SEXP_USE_DEBUG_VM 0 */
/* Experts only. */ /* Experts only. */
/* For *very* verbose output on every VM operation. */ /* For *very* verbose output on every VM operation. */
@ -144,130 +150,131 @@
#define _GNU_SOURCE #define _GNU_SOURCE
#endif #endif
#ifndef USE_MODULES #ifndef SEXP_USE_MODULES
#define USE_MODULES 1 #define SEXP_USE_MODULES 1
#endif #endif
#ifndef USE_TYPE_DEFS #ifndef SEXP_USE_TYPE_DEFS
#define USE_TYPE_DEFS 1 #define SEXP_USE_TYPE_DEFS 1
#endif #endif
#ifndef SEXP_MAXIMUM_TYPES #ifndef SEXP_MAXIMUM_TYPES
#define SEXP_MAXIMUM_TYPES ((sexp_tag_t)-1) #define SEXP_MAXIMUM_TYPES ((sexp_tag_t)-1)
#endif #endif
#ifndef USE_DL #ifndef SEXP_USE_DL
#ifdef PLAN9 #ifdef PLAN9
#define USE_DL 0 #define SEXP_USE_DL 0
#else #else
#define USE_DL 1 #define SEXP_USE_DL 1
#endif #endif
#endif #endif
#ifndef USE_SIMPLIFY #ifndef SEXP_USE_SIMPLIFY
#define USE_SIMPLIFY 1 #define SEXP_USE_SIMPLIFY 1
#endif #endif
#ifndef USE_BOEHM #ifndef SEXP_USE_BOEHM
#define USE_BOEHM 0 #define SEXP_USE_BOEHM 0
#endif #endif
#ifndef USE_MALLOC #ifndef SEXP_USE_MALLOC
#define USE_MALLOC 0 #define SEXP_USE_MALLOC 0
#endif #endif
#ifndef USE_DEBUG_GC #ifndef SEXP_USE_DEBUG_GC
#define USE_DEBUG_GC 0 #define SEXP_USE_DEBUG_GC 0
#endif #endif
#ifndef USE_GLOBAL_HEAP #ifndef SEXP_USE_GLOBAL_HEAP
#if USE_BOEHM || USE_MALLOC #if SEXP_USE_BOEHM || SEXP_USE_MALLOC
#define USE_GLOBAL_HEAP 1 #define SEXP_USE_GLOBAL_HEAP 1
#else #else
#define USE_GLOBAL_HEAP 0 #define SEXP_USE_GLOBAL_HEAP 0
#endif #endif
#endif #endif
#ifndef USE_GLOBAL_SYMBOLS #ifndef SEXP_USE_GLOBAL_SYMBOLS
#if USE_BOEHM || USE_MALLOC #if SEXP_USE_BOEHM || SEXP_USE_MALLOC
#define USE_GLOBAL_SYMBOLS 1 #define SEXP_USE_GLOBAL_SYMBOLS 1
#else #else
#define USE_GLOBAL_SYMBOLS 0 #define SEXP_USE_GLOBAL_SYMBOLS 0
#endif #endif
#endif #endif
#ifndef USE_FLONUMS #ifndef SEXP_USE_FLONUMS
#define USE_FLONUMS 1 #define SEXP_USE_FLONUMS 1
#endif #endif
#ifndef USE_INFINITIES #ifndef SEXP_USE_INFINITIES
#if defined(PLAN9) || ! USE_FLONUMS #if defined(PLAN9) || ! SEXP_USE_FLONUMS
#define USE_INFINITIES 0 #define SEXP_USE_INFINITIES 0
#else #else
#define USE_INFINITIES 1 #define SEXP_USE_INFINITIES 1
#endif #endif
#endif #endif
#ifndef USE_IMMEDIATE_FLONUMS #ifndef SEXP_USE_IMMEDIATE_FLONUMS
#define USE_IMMEDIATE_FLONUMS 0 #define SEXP_USE_IMMEDIATE_FLONUMS 0
#endif #endif
#ifndef USE_BIGNUMS #ifndef SEXP_USE_BIGNUMS
#define USE_BIGNUMS 1 #define SEXP_USE_BIGNUMS 1
#endif #endif
#ifndef USE_MATH #ifndef SEXP_USE_MATH
#define USE_MATH USE_FLONUMS #define SEXP_USE_MATH SEXP_USE_FLONUMS
#endif #endif
#ifndef USE_WARN_UNDEFS #ifndef SEXP_USE_WARN_UNDEFS
#define USE_WARN_UNDEFS 1 #define SEXP_USE_WARN_UNDEFS 1
#endif #endif
#ifndef USE_HUFF_SYMS #ifndef SEXP_USE_HUFF_SYMS
#define USE_HUFF_SYMS 1 #define SEXP_USE_HUFF_SYMS 1
#endif #endif
#ifndef USE_HASH_SYMS #ifndef SEXP_USE_HASH_SYMS
#define USE_HASH_SYMS 1 #define SEXP_USE_HASH_SYMS 1
#endif #endif
#ifndef USE_DEBUG #ifndef SEXP_USE_DEBUG
#define USE_DEBUG 1 #define SEXP_USE_DEBUG 1
#endif #endif
#ifndef USE_DEBUG_VM #ifndef SEXP_USE_DEBUG_VM
#define USE_DEBUG_VM 0 #define SEXP_USE_DEBUG_VM 0
#endif #endif
#ifndef USE_STRING_STREAMS #ifndef SEXP_USE_STRING_STREAMS
#define USE_STRING_STREAMS 1 #define SEXP_USE_STRING_STREAMS 1
#endif #endif
#ifndef USE_AUTOCLOSE_PORTS #ifndef SEXP_USE_AUTOCLOSE_PORTS
#define USE_AUTOCLOSE_PORTS 1 #define SEXP_USE_AUTOCLOSE_PORTS 1
#endif #endif
#ifndef USE_2010_EPOCH #ifndef SEXP_USE_2010_EPOCH
#define USE_2010_EPOCH 1 #define SEXP_USE_2010_EPOCH 1
#endif #endif
#ifndef SEXP_EPOCH_OFFSET #ifndef SEXP_EPOCH_OFFSET
#if USE_2010_EPOCH #if SEXP_USE_2010_EPOCH
#define SEXP_EPOCH_OFFSET 1262271600 #define SEXP_EPOCH_OFFSET 1262271600
#else #else
#define SEXP_EPOCH_OFFSET 0 #define SEXP_EPOCH_OFFSET 0
#endif #endif
#endif #endif
#ifndef USE_CHECK_STACK #ifndef SEXP_USE_CHECK_STACK
#define USE_CHECK_STACK 1 #define SEXP_USE_CHECK_STACK 1
#endif #endif
#ifdef PLAN9 #ifdef PLAN9
#define errx(code, msg, ...) exits(msg) #define errx(code, msg, ...) exits(msg)
#define exit_normally() exits(NULL) #define exit_normally() exits(NULL)
#define exit_failure() exits("ERROR")
#define strcasecmp cistrcmp #define strcasecmp cistrcmp
#define strncasecmp cistrncmp #define strncasecmp cistrncmp
#define round(x) floor((x)+0.5) #define round(x) floor((x)+0.5)
@ -276,6 +283,7 @@
#else #else
#define exit_normally() exit(0) #define exit_normally() exit(0)
#define exit_failure() exit(EXIT_FAILURE)
#if HAVE_ERR_H #if HAVE_ERR_H
#include <err.h> #include <err.h>
#else #else

View file

@ -16,106 +16,106 @@
#define sexp_config_file "config.scm" #define sexp_config_file "config.scm"
enum sexp_core_form_names { enum sexp_core_form_names {
CORE_DEFINE = 1, SEXP_CORE_DEFINE = 1,
CORE_SET, SEXP_CORE_SET,
CORE_LAMBDA, SEXP_CORE_LAMBDA,
CORE_IF, SEXP_CORE_IF,
CORE_BEGIN, SEXP_CORE_BEGIN,
CORE_QUOTE, SEXP_CORE_QUOTE,
CORE_SYNTAX_QUOTE, SEXP_CORE_SYNTAX_QUOTE,
CORE_DEFINE_SYNTAX, SEXP_CORE_DEFINE_SYNTAX,
CORE_LET_SYNTAX, SEXP_CORE_LET_SYNTAX,
CORE_LETREC_SYNTAX SEXP_CORE_LETREC_SYNTAX
}; };
enum sexp_opcode_classes { enum sexp_opcode_classes {
OPC_GENERIC = 1, SEXP_OPC_GENERIC = 1,
OPC_TYPE_PREDICATE, SEXP_OPC_TYPE_PREDICATE,
OPC_PREDICATE, SEXP_OPC_PREDICATE,
OPC_ARITHMETIC, SEXP_OPC_ARITHMETIC,
OPC_ARITHMETIC_INV, SEXP_OPC_ARITHMETIC_INV,
OPC_ARITHMETIC_CMP, SEXP_OPC_ARITHMETIC_CMP,
OPC_IO, SEXP_OPC_IO,
OPC_CONSTRUCTOR, SEXP_OPC_CONSTRUCTOR,
OPC_ACCESSOR, SEXP_OPC_ACCESSOR,
OPC_PARAMETER, SEXP_OPC_PARAMETER,
OPC_FOREIGN, SEXP_OPC_FOREIGN,
OPC_NUM_OP_CLASSES SEXP_OPC_NUM_OP_CLASSES
}; };
enum sexp_opcode_names { enum sexp_opcode_names {
OP_NOOP, SEXP_OP_NOOP,
OP_RAISE, SEXP_OP_RAISE,
OP_RESUMECC, SEXP_OP_RESUMECC,
OP_CALLCC, SEXP_OP_CALLCC,
OP_APPLY1, SEXP_OP_APPLY1,
OP_TAIL_CALL, SEXP_OP_TAIL_CALL,
OP_CALL, SEXP_OP_CALL,
OP_FCALL0, SEXP_OP_FCALL0,
OP_FCALL1, SEXP_OP_FCALL1,
OP_FCALL2, SEXP_OP_FCALL2,
OP_FCALL3, SEXP_OP_FCALL3,
OP_FCALL4, SEXP_OP_FCALL4,
OP_FCALL5, SEXP_OP_FCALL5,
OP_FCALL6, SEXP_OP_FCALL6,
OP_JUMP_UNLESS, SEXP_OP_JUMP_UNLESS,
OP_JUMP, SEXP_OP_JUMP,
OP_PUSH, SEXP_OP_PUSH,
OP_DROP, SEXP_OP_DROP,
OP_GLOBAL_REF, SEXP_OP_GLOBAL_REF,
OP_GLOBAL_KNOWN_REF, SEXP_OP_GLOBAL_KNOWN_REF,
OP_STACK_REF, SEXP_OP_STACK_REF,
OP_LOCAL_REF, SEXP_OP_LOCAL_REF,
OP_LOCAL_SET, SEXP_OP_LOCAL_SET,
OP_CLOSURE_REF, SEXP_OP_CLOSURE_REF,
OP_VECTOR_REF, SEXP_OP_VECTOR_REF,
OP_VECTOR_SET, SEXP_OP_VECTOR_SET,
OP_VECTOR_LENGTH, SEXP_OP_VECTOR_LENGTH,
OP_STRING_REF, SEXP_OP_STRING_REF,
OP_STRING_SET, SEXP_OP_STRING_SET,
OP_STRING_LENGTH, SEXP_OP_STRING_LENGTH,
OP_MAKE_PROCEDURE, SEXP_OP_MAKE_PROCEDURE,
OP_MAKE_VECTOR, SEXP_OP_MAKE_VECTOR,
OP_AND, SEXP_OP_AND,
OP_NULLP, SEXP_OP_NULLP,
OP_FIXNUMP, SEXP_OP_FIXNUMP,
OP_SYMBOLP, SEXP_OP_SYMBOLP,
OP_CHARP, SEXP_OP_CHARP,
OP_EOFP, SEXP_OP_EOFP,
OP_TYPEP, SEXP_OP_TYPEP,
OP_MAKE, SEXP_OP_MAKE,
OP_SLOT_REF, SEXP_OP_SLOT_REF,
OP_SLOT_SET, SEXP_OP_SLOT_SET,
OP_CAR, SEXP_OP_CAR,
OP_CDR, SEXP_OP_CDR,
OP_SET_CAR, SEXP_OP_SET_CAR,
OP_SET_CDR, SEXP_OP_SET_CDR,
OP_CONS, SEXP_OP_CONS,
OP_ADD, SEXP_OP_ADD,
OP_SUB, SEXP_OP_SUB,
OP_MUL, SEXP_OP_MUL,
OP_DIV, SEXP_OP_DIV,
OP_QUOTIENT, SEXP_OP_QUOTIENT,
OP_REMAINDER, SEXP_OP_REMAINDER,
OP_NEGATIVE, SEXP_OP_NEGATIVE,
OP_INVERSE, SEXP_OP_INVERSE,
OP_LT, SEXP_OP_LT,
OP_LE, SEXP_OP_LE,
OP_EQN, SEXP_OP_EQN,
OP_EQ, SEXP_OP_EQ,
OP_FIX2FLO, SEXP_OP_FIX2FLO,
OP_FLO2FIX, SEXP_OP_FLO2FIX,
OP_CHAR2INT, SEXP_OP_CHAR2INT,
OP_INT2CHAR, SEXP_OP_INT2CHAR,
OP_CHAR_UPCASE, SEXP_OP_CHAR_UPCASE,
OP_CHAR_DOWNCASE, SEXP_OP_CHAR_DOWNCASE,
OP_WRITE_CHAR, SEXP_OP_WRITE_CHAR,
OP_NEWLINE, SEXP_OP_NEWLINE,
OP_READ_CHAR, SEXP_OP_READ_CHAR,
OP_PEEK_CHAR, SEXP_OP_PEEK_CHAR,
OP_RET, SEXP_OP_RET,
OP_DONE, SEXP_OP_DONE,
OP_NUM_OPCODES SEXP_OP_NUM_OPCODES
}; };
/**************************** prototypes ******************************/ /**************************** prototypes ******************************/
@ -142,7 +142,7 @@ SEXP_API sexp sexp_define_foreign_aux (sexp ctx, sexp env, char *name, int num_a
#define sexp_define_foreign(c,e,s,n,f) sexp_define_foreign_aux(c,e,s,n,0,(sexp_proc1)f,NULL) #define sexp_define_foreign(c,e,s,n,f) sexp_define_foreign_aux(c,e,s,n,0,(sexp_proc1)f,NULL)
#define sexp_define_foreign_opt(c,e,s,n,f,d) sexp_define_foreign_aux(c,e,s,n,1,(sexp_proc1)f,d) #define sexp_define_foreign_opt(c,e,s,n,f,d) sexp_define_foreign_aux(c,e,s,n,1,(sexp_proc1)f,d)
#if USE_TYPE_DEFS #if SEXP_USE_TYPE_DEFS
SEXP_API sexp sexp_make_type_predicate (sexp ctx, sexp name, sexp type); SEXP_API sexp sexp_make_type_predicate (sexp ctx, sexp name, sexp type);
SEXP_API sexp sexp_make_constructor (sexp ctx, sexp name, sexp type); SEXP_API sexp sexp_make_constructor (sexp ctx, sexp name, sexp type);
SEXP_API sexp sexp_make_getter (sexp ctx, sexp name, sexp type, sexp index); SEXP_API sexp sexp_make_getter (sexp ctx, sexp name, sexp type, sexp index);

View file

@ -11,7 +11,7 @@
#include <ctype.h> #include <ctype.h>
#include <stdio.h> #include <stdio.h>
#if USE_DL #if SEXP_USE_DL
#include <dlfcn.h> #include <dlfcn.h>
#endif #endif
@ -56,7 +56,7 @@ typedef unsigned long size_t;
#define SEXP_CHAR_TAG 6 #define SEXP_CHAR_TAG 6
#define SEXP_EXTENDED_TAG 14 #define SEXP_EXTENDED_TAG 14
#if USE_HASH_SYMS #if SEXP_USE_HASH_SYMS
#define SEXP_SYMBOL_TABLE_SIZE 389 #define SEXP_SYMBOL_TABLE_SIZE 389
#else #else
#define SEXP_SYMBOL_TABLE_SIZE 1 #define SEXP_SYMBOL_TABLE_SIZE 1
@ -278,7 +278,7 @@ struct sexp_struct {
#define SEXP_CLOSE SEXP_MAKE_IMMEDIATE(6) /* internal use */ #define SEXP_CLOSE SEXP_MAKE_IMMEDIATE(6) /* internal use */
#define SEXP_RAWDOT SEXP_MAKE_IMMEDIATE(7) /* internal use */ #define SEXP_RAWDOT SEXP_MAKE_IMMEDIATE(7) /* internal use */
#if USE_BOEHM #if SEXP_USE_BOEHM
#define sexp_gc_var(ctx, x, y) sexp x; #define sexp_gc_var(ctx, x, y) sexp x;
#define sexp_gc_preserve(ctx, x, y) #define sexp_gc_preserve(ctx, x, y)
@ -307,7 +307,7 @@ struct sexp_struct {
#define sexp_gc_release(ctx, x, y) (sexp_context_saves(ctx) = y.next) #define sexp_gc_release(ctx, x, y) (sexp_context_saves(ctx) = y.next)
#if USE_MALLOC #if SEXP_USE_MALLOC
#define sexp_alloc(ctx, size) malloc(size) #define sexp_alloc(ctx, size) malloc(size)
#define sexp_alloc_atomic(ctx, size) malloc(size) #define sexp_alloc_atomic(ctx, size) malloc(size)
#define sexp_realloc(ctx, x, size) realloc(x, size) #define sexp_realloc(ctx, x, size) realloc(x, size)
@ -358,7 +358,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
#define sexp_alloc_type(ctx, type, tag) sexp_alloc_tagged(ctx, sexp_sizeof(type), tag) #define sexp_alloc_type(ctx, type, tag) sexp_alloc_tagged(ctx, sexp_sizeof(type), tag)
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
#include "chibi/bignum.h" #include "chibi/bignum.h"
#endif #endif
@ -402,7 +402,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
#define sexp_slot_ref(x,i) (((sexp*)&((x)->value))[i]) #define sexp_slot_ref(x,i) (((sexp*)&((x)->value))[i])
#define sexp_slot_set(x,i,v) (((sexp*)&((x)->value))[i] = (v)) #define sexp_slot_set(x,i,v) (((sexp*)&((x)->value))[i] = (v))
#if USE_IMMEDIATE_FLONUMS #if SEXP_USE_IMMEDIATE_FLONUMS
union sexp_flonum_conv { union sexp_flonum_conv {
float flonum; float flonum;
sexp_uint_t bits; sexp_uint_t bits;
@ -466,14 +466,14 @@ sexp sexp_make_flonum(sexp ctx, double f);
#define sexp_fixnum_to_double(x) ((double)sexp_unbox_fixnum(x)) #define sexp_fixnum_to_double(x) ((double)sexp_unbox_fixnum(x))
#if USE_FLONUMS #if SEXP_USE_FLONUMS
#define sexp_fp_integerp(x) (sexp_flonum_value(x) == trunc(sexp_flonum_value(x))) #define sexp_fp_integerp(x) (sexp_flonum_value(x) == trunc(sexp_flonum_value(x)))
#define _or_integer_flonump(x) || (sexp_flonump(x) && sexp_fp_integerp(x)) #define _or_integer_flonump(x) || (sexp_flonump(x) && sexp_fp_integerp(x))
#else #else
#define _or_integer_flonump(x) #define _or_integer_flonump(x)
#endif #endif
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x); SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
#define sexp_exact_integerp(x) (sexp_fixnump(x) || sexp_bignump(x)) #define sexp_exact_integerp(x) (sexp_fixnump(x) || sexp_bignump(x))
#else #else
@ -483,13 +483,13 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
#define sexp_integerp(x) (sexp_exact_integerp(x) _or_integer_flonump(x)) #define sexp_integerp(x) (sexp_exact_integerp(x) _or_integer_flonump(x))
#if USE_FLONUMS #if SEXP_USE_FLONUMS
#define sexp_fixnum_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_fixnum(x))) #define sexp_fixnum_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_fixnum(x)))
#else #else
#define sexp_fixnum_to_flonum(ctx, x) (x) #define sexp_fixnum_to_flonum(ctx, x) (x)
#endif #endif
#if USE_FLONUMS || USE_BIGNUMS #if SEXP_USE_FLONUMS || SEXP_USE_BIGNUMS
#define sexp_uint_value(x) ((sexp_uint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignum_data(x)[0])) #define sexp_uint_value(x) ((sexp_uint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignum_data(x)[0]))
#define sexp_sint_value(x) ((sexp_sint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignum_sign(x)*sexp_bignum_data(x)[0])) #define sexp_sint_value(x) ((sexp_sint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignum_sign(x)*sexp_bignum_data(x)[0]))
#else #else
@ -627,13 +627,13 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
#define sexp_global(ctx,x) (sexp_vector_data(sexp_context_globals(ctx))[x]) #define sexp_global(ctx,x) (sexp_vector_data(sexp_context_globals(ctx))[x])
#if USE_GLOBAL_HEAP #if SEXP_USE_GLOBAL_HEAP
#define sexp_context_heap(ctx) sexp_global_heap #define sexp_context_heap(ctx) sexp_global_heap
#else #else
#define sexp_context_heap(ctx) ((ctx)->value.context.heap) #define sexp_context_heap(ctx) ((ctx)->value.context.heap)
#endif #endif
#if USE_GLOBAL_SYMBOLS #if SEXP_USE_GLOBAL_SYMBOLS
#define sexp_context_symbols(ctx) sexp_symbol_table #define sexp_context_symbols(ctx) sexp_symbol_table
#else #else
#define sexp_context_symbols(ctx) sexp_vector_data(sexp_global(ctx, SEXP_G_SYMBOLS)) #define sexp_context_symbols(ctx) sexp_vector_data(sexp_global(ctx, SEXP_G_SYMBOLS))
@ -676,7 +676,7 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
/****************************** utilities *****************************/ /****************************** utilities *****************************/
enum sexp_context_globals { enum sexp_context_globals {
#if ! USE_GLOBAL_SYMBOLS #if ! SEXP_USE_GLOBAL_SYMBOLS
SEXP_G_SYMBOLS, SEXP_G_SYMBOLS,
#endif #endif
SEXP_G_OOM_ERROR, /* out of memory exception object */ SEXP_G_OOM_ERROR, /* out of memory exception object */
@ -724,7 +724,7 @@ enum sexp_context_globals {
/***************************** general API ****************************/ /***************************** general API ****************************/
#if USE_STRING_STREAMS #if SEXP_USE_STRING_STREAMS
#define sexp_read_char(x, p) (getc(sexp_port_stream(p))) #define sexp_read_char(x, p) (getc(sexp_port_stream(p)))
#define sexp_push_char(x, c, p) (ungetc(c, sexp_port_stream(p))) #define sexp_push_char(x, c, p) (ungetc(c, sexp_port_stream(p)))
@ -795,13 +795,13 @@ SEXP_API sexp sexp_range_exception(sexp ctx, sexp obj, sexp start, sexp end);
SEXP_API sexp sexp_print_exception(sexp ctx, sexp exn, sexp out); SEXP_API sexp sexp_print_exception(sexp ctx, sexp exn, sexp out);
SEXP_API void sexp_init(void); SEXP_API void sexp_init(void);
#if USE_GLOBAL_HEAP #if SEXP_USE_GLOBAL_HEAP
#define sexp_destroy_context(ctx) #define sexp_destroy_context(ctx)
#else #else
SEXP_API void sexp_destroy_context(sexp ctx); SEXP_API void sexp_destroy_context(sexp ctx);
#endif #endif
#if USE_TYPE_DEFS #if SEXP_USE_TYPE_DEFS
SEXP_API sexp sexp_register_type (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2); SEXP_API sexp sexp_register_type (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2);
SEXP_API sexp sexp_register_simple_type (sexp ctx, sexp name, sexp slots); SEXP_API sexp sexp_register_simple_type (sexp ctx, sexp name, sexp slots);
SEXP_API sexp sexp_register_c_type (sexp ctx, sexp name); SEXP_API sexp sexp_register_c_type (sexp ctx, sexp name);

View file

@ -3,7 +3,9 @@
(export open-input-fd open-output-fd (export open-input-fd open-output-fd
delete-file link-file symbolic-link rename-file delete-file link-file symbolic-link rename-file
directory-files create-directory delete-directory directory-files create-directory delete-directory
current-seconds) current-seconds
exit
)
(import (scheme)) (import (scheme))
(include-shared "posix") (include-shared "posix")
(include "posix.scm")) (include "posix.scm"))

View file

@ -29,10 +29,10 @@
(define-c pid_t fork ()) (define-c pid_t fork ())
;; (define-c pid_t wait ((result pointer int))) ;; (define-c pid_t wait ((result pointer int)))
;; (define-c void exit (int)) (define-c void exit (int))
;; (define-c int (execute execvp) (string (array string null))) ;;(define-c int (execute execvp) (string (array string null)))
;;(define-c errno pipe ((result array int 2))) ;;(define-c errno pipe ((result (array int 2))))
(define-c time_t (current-seconds time) ((value NULL))) (define-c time_t (current-seconds time) ((value NULL)))

View file

@ -42,7 +42,7 @@ static sexp sexp_rs_random_integer (sexp ctx, sexp rs, sexp bound) {
if (sexp_fixnump(bound)) { if (sexp_fixnump(bound)) {
sexp_call_random(rs, n); sexp_call_random(rs, n);
res = sexp_make_fixnum(n % sexp_unbox_fixnum(bound)); res = sexp_make_fixnum(n % sexp_unbox_fixnum(bound));
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(bound)) { } else if (sexp_bignump(bound)) {
hi = sexp_bignum_hi(bound); hi = sexp_bignum_hi(bound);
len = hi * sizeof(sexp_uint_t) / sizeof(int32_t); len = hi * sizeof(sexp_uint_t) / sizeof(int32_t);
@ -100,7 +100,7 @@ static sexp sexp_random_source_state_set (sexp ctx, sexp rs, sexp state) {
return sexp_type_exception(ctx, "not a random-source", rs); return sexp_type_exception(ctx, "not a random-source", rs);
else if (sexp_fixnump(state)) else if (sexp_fixnump(state))
*sexp_random_data(rs) = sexp_unbox_fixnum(state); *sexp_random_data(rs) = sexp_unbox_fixnum(state);
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
else if (sexp_bignump(state)) else if (sexp_bignump(state))
*sexp_random_data(rs) *sexp_random_data(rs)
= sexp_bignum_data(state)[0]*sexp_bignum_sign(state); = sexp_bignum_data(state)[0]*sexp_bignum_sign(state);

View file

@ -2,7 +2,7 @@
#include <chibi/eval.h> #include <chibi/eval.h>
#include <limits.h> #include <limits.h>
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
#include <chibi/bignum.h> #include <chibi/bignum.h>
#endif #endif
@ -12,13 +12,13 @@ static sexp sexp_bit_and (sexp ctx, sexp x, sexp y) {
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
if (sexp_fixnump(y)) if (sexp_fixnump(y))
res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y); res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y);
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
else if (sexp_bignump(y)) else if (sexp_bignump(y))
res = sexp_bit_and(ctx, y, x); res = sexp_bit_and(ctx, y, x);
#endif #endif
else else
res = sexp_type_exception(ctx, "bitwise-and: not an integer", y); res = sexp_type_exception(ctx, "bitwise-and: not an integer", y);
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) { } else if (sexp_bignump(x)) {
if (sexp_fixnump(y)) { if (sexp_fixnump(y)) {
res = sexp_make_fixnum(sexp_unbox_fixnum(y) & sexp_bignum_data(x)[0]); res = sexp_make_fixnum(sexp_unbox_fixnum(y) & sexp_bignum_data(x)[0]);
@ -46,13 +46,13 @@ static sexp sexp_bit_ior (sexp ctx, sexp x, sexp y) {
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
if (sexp_fixnump(y)) if (sexp_fixnump(y))
res = (sexp) ((sexp_uint_t)x | (sexp_uint_t)y); res = (sexp) ((sexp_uint_t)x | (sexp_uint_t)y);
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
else if (sexp_bignump(y)) else if (sexp_bignump(y))
res = sexp_bit_ior(ctx, y, x); res = sexp_bit_ior(ctx, y, x);
#endif #endif
else else
res = sexp_type_exception(ctx, "bitwise-ior: not an integer", y); res = sexp_type_exception(ctx, "bitwise-ior: not an integer", y);
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) { } else if (sexp_bignump(x)) {
if (sexp_fixnump(y)) { if (sexp_fixnump(y)) {
res = sexp_copy_bignum(ctx, NULL, x, 0); res = sexp_copy_bignum(ctx, NULL, x, 0);
@ -84,13 +84,13 @@ static sexp sexp_bit_xor (sexp ctx, sexp x, sexp y) {
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
if (sexp_fixnump(y)) if (sexp_fixnump(y))
res = sexp_make_fixnum(sexp_unbox_fixnum(x) ^ sexp_unbox_fixnum(y)); res = sexp_make_fixnum(sexp_unbox_fixnum(x) ^ sexp_unbox_fixnum(y));
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
else if (sexp_bignump(y)) else if (sexp_bignump(y))
res = sexp_bit_xor(ctx, y, x); res = sexp_bit_xor(ctx, y, x);
#endif #endif
else else
res = sexp_type_exception(ctx, "bitwise-xor: not an integer", y); res = sexp_type_exception(ctx, "bitwise-xor: not an integer", y);
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) { } else if (sexp_bignump(x)) {
if (sexp_fixnump(y)) { if (sexp_fixnump(y)) {
res = sexp_copy_bignum(ctx, NULL, x, 0); res = sexp_copy_bignum(ctx, NULL, x, 0);
@ -131,12 +131,12 @@ static sexp sexp_arithmetic_shift (sexp ctx, sexp i, sexp count) {
res = sexp_make_fixnum(sexp_unbox_fixnum(i) >> -c); res = sexp_make_fixnum(sexp_unbox_fixnum(i) >> -c);
} else { } else {
tmp = (sexp_uint_t)sexp_unbox_fixnum(i) << c; tmp = (sexp_uint_t)sexp_unbox_fixnum(i) << c;
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
if (((tmp >> c) == sexp_unbox_fixnum(i)) if (((tmp >> c) == sexp_unbox_fixnum(i))
&& (tmp < SEXP_MAX_FIXNUM) && (tmp > SEXP_MIN_FIXNUM)) { && (tmp < SEXP_MAX_FIXNUM) && (tmp > SEXP_MIN_FIXNUM)) {
#endif #endif
res = sexp_make_fixnum(tmp); res = sexp_make_fixnum(tmp);
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else { } else {
sexp_gc_preserve1(ctx, res); sexp_gc_preserve1(ctx, res);
res = sexp_fixnum_to_bignum(ctx, i); res = sexp_fixnum_to_bignum(ctx, i);
@ -145,7 +145,7 @@ static sexp sexp_arithmetic_shift (sexp ctx, sexp i, sexp count) {
} }
#endif #endif
} }
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(i)) { } else if (sexp_bignump(i)) {
len = sexp_bignum_hi(i); len = sexp_bignum_hi(i);
if (c < 0) { if (c < 0) {
@ -198,7 +198,7 @@ static sexp sexp_bit_count (sexp ctx, sexp x) {
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
i = sexp_unbox_fixnum(x); i = sexp_unbox_fixnum(x);
res = sexp_make_fixnum(bit_count(i<0 ? ~i : i)); res = sexp_make_fixnum(bit_count(i<0 ? ~i : i));
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) { } else if (sexp_bignump(x)) {
for (i=count=0; i<sexp_bignum_length(x); i++) for (i=count=0; i<sexp_bignum_length(x); i++)
count += bit_count(sexp_bignum_data(x)[i]); count += bit_count(sexp_bignum_data(x)[i]);
@ -233,7 +233,7 @@ static sexp sexp_integer_length (sexp ctx, sexp x) {
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
tmp = sexp_unbox_fixnum(x); tmp = sexp_unbox_fixnum(x);
return sexp_make_fixnum(integer_log2(tmp < 0 ? -tmp-1 : tmp)); return sexp_make_fixnum(integer_log2(tmp < 0 ? -tmp-1 : tmp));
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) { } else if (sexp_bignump(x)) {
hi = sexp_bignum_hi(x); hi = sexp_bignum_hi(x);
return sexp_make_fixnum(integer_log2(sexp_bignum_data(x)[hi]) return sexp_make_fixnum(integer_log2(sexp_bignum_data(x)[hi])
@ -250,7 +250,7 @@ static sexp sexp_bit_set_p (sexp ctx, sexp i, sexp x) {
return sexp_type_exception(ctx, "bit-set?: not an integer", i); return sexp_type_exception(ctx, "bit-set?: not an integer", i);
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
return sexp_make_boolean(sexp_unbox_fixnum(x) & (1<<sexp_unbox_fixnum(i))); return sexp_make_boolean(sexp_unbox_fixnum(x) & (1<<sexp_unbox_fixnum(i)));
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) { } else if (sexp_bignump(x)) {
pos = sexp_unbox_fixnum(i) / (sizeof(sexp_uint_t)*CHAR_BIT); pos = sexp_unbox_fixnum(i) / (sizeof(sexp_uint_t)*CHAR_BIT);
return sexp_make_boolean((pos < sexp_bignum_length(x)) return sexp_make_boolean((pos < sexp_bignum_length(x))

View file

@ -42,7 +42,7 @@ static sexp_uint_t hash_one (sexp obj, sexp_uint_t bound, sexp_sint_t depth) {
sexp t, *p; sexp t, *p;
char *p0; char *p0;
loop: loop:
#if USE_FLONUMS #if SEXP_USE_FLONUMS
if (sexp_flonump(obj)) if (sexp_flonump(obj))
acc ^= (sexp_sint_t) sexp_flonum_value(obj); acc ^= (sexp_sint_t) sexp_flonum_value(obj);
else else

6
main.c
View file

@ -75,7 +75,7 @@ sexp sexp_init_environments (sexp ctx) {
env = sexp_context_env(ctx); env = sexp_context_env(ctx);
sexp_env_define(ctx, env, sexp_intern(ctx, "*command-line-arguments*"), SEXP_NULL); sexp_env_define(ctx, env, sexp_intern(ctx, "*command-line-arguments*"), SEXP_NULL);
res = sexp_load_module_file(ctx, sexp_init_file, env); res = sexp_load_module_file(ctx, sexp_init_file, env);
#if USE_MODULES #if SEXP_USE_MODULES
if (! sexp_exceptionp(res)) { if (! sexp_exceptionp(res)) {
res = SEXP_UNDEF; res = SEXP_UNDEF;
sexp_gc_preserve1(ctx, confenv); sexp_gc_preserve1(ctx, confenv);
@ -115,7 +115,7 @@ void repl (sexp ctx) {
if (sexp_exceptionp(res)) { if (sexp_exceptionp(res)) {
sexp_print_exception(ctx, res, err); sexp_print_exception(ctx, res, err);
} else { } else {
#if USE_WARN_UNDEFS #if SEXP_USE_WARN_UNDEFS
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, err); sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, err);
#endif #endif
if (res != SEXP_VOID) { if (res != SEXP_VOID) {
@ -133,7 +133,7 @@ sexp check_exception (sexp ctx, sexp res) {
sexp_print_exception(ctx, res, sexp_print_exception(ctx, res,
sexp_eval_string(ctx, "(current-error-port)", sexp_eval_string(ctx, "(current-error-port)",
sexp_context_env(ctx))); sexp_context_env(ctx)));
exit(EXIT_FAILURE); exit_failure();
} }
return res; return res;
} }

3
mkfile
View file

@ -4,7 +4,7 @@ BIN=/$objtype/bin
TARG=chibi-scheme TARG=chibi-scheme
MODDIR=/sys/lib/chibi-scheme MODDIR=/sys/lib/chibi-scheme
CPPFLAGS= -Iinclude -DPLAN9 '-DUSE_STRING_STREAMS=0' '-DUSE_DEBUG=0' CPPFLAGS= -Iinclude -DPLAN9 '-DSEXP_USE_STRING_STREAMS=0' '-DSEXP_USE_DEBUG=0' '-DSEXP_USE_MODULES=0'
CFLAGS= -p $CPPFLAGS CFLAGS= -p $CPPFLAGS
OFILES=sexp.$O eval.$O main.$O OFILES=sexp.$O eval.$O main.$O
@ -14,6 +14,7 @@ HFILES=include/chibi/sexp.h include/chibi/eval.h include/chibi/config.h include/
include/chibi/install.h: mkfile include/chibi/install.h: mkfile
echo '#define sexp_module_dir "'$MODDIR'"' > include/chibi/install.h echo '#define sexp_module_dir "'$MODDIR'"' > include/chibi/install.h
echo '#define sexp_platform "plan9"' >> include/chibi/install.h
install:V: $BIN/$TARG install:V: $BIN/$TARG
test -d $MODDIR || mkdir -p $MODDIR test -d $MODDIR || mkdir -p $MODDIR

136
opcodes.c
View file

@ -2,73 +2,73 @@
#define _OP(c,o,n,m,t,u,i,s,d,f) \ #define _OP(c,o,n,m,t,u,i,s,d,f) \
{.tag=SEXP_OPCODE, \ {.tag=SEXP_OPCODE, \
.value={.opcode={c, o, n, m, t, u, i, s, d, NULL, NULL, f}}} .value={.opcode={c, o, n, m, t, u, i, s, d, NULL, NULL, f}}}
#define _FN(o,n,m,t,u,s,d,f) _OP(OPC_FOREIGN, o, n, m, t, u, 0, s, d, (sexp_proc1)f) #define _FN(o,n,m,t,u,s,d,f) _OP(SEXP_OPC_FOREIGN, o, n, m, t, u, 0, s, d, (sexp_proc1)f)
#define _FN0(s, d, f) _FN(OP_FCALL0, 0, 0, 0, 0, s, d, f) #define _FN0(s, d, f) _FN(SEXP_OP_FCALL0, 0, 0, 0, 0, s, d, f)
#define _FN1(t, s, d, f) _FN(OP_FCALL1, 1, 0, t, 0, s, d, f) #define _FN1(t, s, d, f) _FN(SEXP_OP_FCALL1, 1, 0, t, 0, s, d, f)
#define _FN1OPT(t, s, d, f) _FN(OP_FCALL1, 0, 1, t, u, s, d, f) #define _FN1OPT(t, s, d, f) _FN(SEXP_OP_FCALL1, 0, 1, t, u, s, d, f)
#define _FN1OPTP(t, s, d, f) _FN(OP_FCALL1, 0, 3, t, 0, s, d, f) #define _FN1OPTP(t, s, d, f) _FN(SEXP_OP_FCALL1, 0, 3, t, 0, s, d, f)
#define _FN2(t, u, s, d, f) _FN(OP_FCALL2, 2, 0, t, u, s, d, f) #define _FN2(t, u, s, d, f) _FN(SEXP_OP_FCALL2, 2, 0, t, u, s, d, f)
#define _FN2OPT(t, u, s, d, f) _FN(OP_FCALL2, 1, 1, t, u, s, d, f) #define _FN2OPT(t, u, s, d, f) _FN(SEXP_OP_FCALL2, 1, 1, t, u, s, d, f)
#define _FN2OPTP(t, u, s, d, f) _FN(OP_FCALL2, 1, 3, t, u, s, d, f) #define _FN2OPTP(t, u, s, d, f) _FN(SEXP_OP_FCALL2, 1, 3, t, u, s, d, f)
#define _FN3(t, u, s, d, f) _FN(OP_FCALL3, 3, 0, t, u, s, d, f) #define _FN3(t, u, s, d, f) _FN(SEXP_OP_FCALL3, 3, 0, t, u, s, d, f)
#define _FN4(t, u, s, d, f) _FN(OP_FCALL4, 4, 0, t, u, s, d, f) #define _FN4(t, u, s, d, f) _FN(SEXP_OP_FCALL4, 4, 0, t, u, s, d, f)
#define _FN5(t, u, s, d, f) _FN(OP_FCALL5, 5, 0, t, u, s, d, f) #define _FN5(t, u, s, d, f) _FN(SEXP_OP_FCALL5, 5, 0, t, u, s, d, f)
#define _FN6(t, u, s, d, f) _FN(OP_FCALL6, 6, 0, t, u, s, d, f) #define _FN6(t, u, s, d, f) _FN(SEXP_OP_FCALL6, 6, 0, t, u, s, d, f)
#define _PARAM(n, a, t) _OP(OPC_PARAMETER, OP_NOOP, 0, 3, t, 0, 0, n, a, 0) #define _PARAM(n, a, t) _OP(SEXP_OPC_PARAMETER, SEXP_OP_NOOP, 0, 3, t, 0, 0, n, a, 0)
static struct sexp_struct opcodes[] = { static struct sexp_struct opcodes[] = {
_OP(OPC_ACCESSOR, OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", 0, NULL),
_OP(OPC_ACCESSOR, OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", 0, NULL),
_OP(OPC_ACCESSOR, OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", 0, NULL),
_OP(OPC_ACCESSOR, OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", 0, NULL),
_OP(OPC_ACCESSOR, OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", 0, NULL),
_OP(OPC_ACCESSOR, OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", 0, NULL),
_OP(OPC_ACCESSOR, OP_VECTOR_LENGTH,1,0, SEXP_VECTOR, 0, 0,"vector-length", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_LENGTH,1,0, SEXP_VECTOR, 0, 0,"vector-length", 0, NULL),
_OP(OPC_ACCESSOR, OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", 0, NULL),
_OP(OPC_ACCESSOR, OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", 0, NULL),
_OP(OPC_ACCESSOR, OP_STRING_LENGTH,1,0, SEXP_STRING, 0, 0,"string-length", 0, NULL), _OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_LENGTH,1,0, SEXP_STRING, 0, 0,"string-length", 0, NULL),
_OP(OPC_GENERIC, OP_FIX2FLO, 1, 0, 0, 0, 0, "exact->inexact", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_FIX2FLO, 1, 0, 0, 0, 0, "exact->inexact", 0, NULL),
_OP(OPC_GENERIC, OP_FLO2FIX, 1, 0, 0, 0, 0, "inexact->exact", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_FLO2FIX, 1, 0, 0, 0, 0, "inexact->exact", 0, NULL),
_OP(OPC_GENERIC, OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", 0, NULL),
_OP(OPC_GENERIC, OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", 0, NULL),
_OP(OPC_GENERIC, OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", 0, NULL),
_OP(OPC_GENERIC, OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", 0, NULL),
_OP(OPC_ARITHMETIC, OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_fixnum(0), NULL), _OP(SEXP_OPC_ARITHMETIC, SEXP_OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_fixnum(0), NULL),
_OP(OPC_ARITHMETIC, OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_fixnum(1), NULL), _OP(SEXP_OPC_ARITHMETIC, SEXP_OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_fixnum(1), NULL),
_OP(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, OP_NEGATIVE, "-", 0, NULL), _OP(SEXP_OPC_ARITHMETIC_INV, SEXP_OP_SUB, 0, 1, SEXP_FIXNUM, 0, SEXP_OP_NEGATIVE, "-", 0, NULL),
_OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, OP_INVERSE, "/", 0, NULL), _OP(SEXP_OPC_ARITHMETIC_INV, SEXP_OP_DIV, 0, 1, SEXP_FIXNUM, 0, SEXP_OP_INVERSE, "/", 0, NULL),
_OP(OPC_ARITHMETIC, OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", 0, NULL), _OP(SEXP_OPC_ARITHMETIC, SEXP_OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", 0, NULL),
_OP(OPC_ARITHMETIC, OP_REMAINDER, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "remainder", 0, NULL), _OP(SEXP_OPC_ARITHMETIC, SEXP_OP_REMAINDER, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "remainder", 0, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LT, 2, 1, SEXP_FIXNUM, 0, 0, "<", 0, NULL), _OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LT, 2, 1, SEXP_FIXNUM, 0, 0, "<", 0, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LE, 2, 1, SEXP_FIXNUM, 0, 0, "<=", 0, NULL), _OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LE, 2, 1, SEXP_FIXNUM, 0, 0, "<=", 0, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LT, 2, 1, SEXP_FIXNUM, 0, 1, ">", 0, NULL), _OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LT, 2, 1, SEXP_FIXNUM, 0, 1, ">", 0, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LE, 2, 1, SEXP_FIXNUM, 0, 1, ">=", 0, NULL), _OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LE, 2, 1, SEXP_FIXNUM, 0, 1, ">=", 0, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_EQN, 2, 1, SEXP_FIXNUM, 0, 0, "=", 0, NULL), _OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_EQN, 2, 1, SEXP_FIXNUM, 0, 0, "=", 0, NULL),
_OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL), _OP(SEXP_OPC_PREDICATE, SEXP_OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL),
_OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL), _OP(SEXP_OPC_CONSTRUCTOR, SEXP_OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL),
_OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_VOID, NULL), _OP(SEXP_OPC_CONSTRUCTOR, SEXP_OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_VOID, NULL),
_OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL), _OP(SEXP_OPC_CONSTRUCTOR, SEXP_OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL),
_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, 0),
_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, 0),
_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, 0),
_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, 0),
_OP(OPC_TYPE_PREDICATE, OP_FIXNUMP, 1, 0, 0, 0, 0, "fixnum?", NULL, 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_FIXNUMP, 1, 0, 0, 0, 0, "fixnum?", NULL, 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_fixnum(SEXP_PAIR), 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_fixnum(SEXP_PAIR), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", sexp_make_fixnum(SEXP_STRING), 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "string?", sexp_make_fixnum(SEXP_STRING), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", sexp_make_fixnum(SEXP_VECTOR), 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "vector?", sexp_make_fixnum(SEXP_VECTOR), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", sexp_make_fixnum(SEXP_FLONUM), 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", sexp_make_fixnum(SEXP_FLONUM), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "bignum?", sexp_make_fixnum(SEXP_BIGNUM), 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "bignum?", sexp_make_fixnum(SEXP_BIGNUM), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "closure?", sexp_make_fixnum(SEXP_PROCEDURE), 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "closure?", sexp_make_fixnum(SEXP_PROCEDURE), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", sexp_make_fixnum(SEXP_OPCODE), 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", sexp_make_fixnum(SEXP_OPCODE), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", sexp_make_fixnum(SEXP_IPORT), 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", sexp_make_fixnum(SEXP_IPORT), 0),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", sexp_make_fixnum(SEXP_OPORT), 0), _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", sexp_make_fixnum(SEXP_OPORT), 0),
_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL),
_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL),
_OP(OPC_GENERIC, OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL), _OP(SEXP_OPC_GENERIC, SEXP_OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL),
_OP(OPC_IO, OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL), _OP(SEXP_OPC_IO, SEXP_OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_NEWLINE, 0, 3, 0, SEXP_OPORT, 0, "newline", (sexp)"*current-output-port*", NULL), _OP(SEXP_OPC_IO, SEXP_OP_NEWLINE, 0, 3, 0, SEXP_OPORT, 0, "newline", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL), _OP(SEXP_OPC_IO, SEXP_OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL),
_OP(OPC_IO, OP_PEEK_CHAR, 0, 3, 0, SEXP_IPORT, 0, "peek-char", (sexp)"*current-input-port*", NULL), _OP(SEXP_OPC_IO, SEXP_OP_PEEK_CHAR, 0, 3, 0, SEXP_IPORT, 0, "peek-char", (sexp)"*current-input-port*", NULL),
_FN1OPTP(SEXP_IPORT, "read", (sexp)"*current-input-port*", sexp_read), _FN1OPTP(SEXP_IPORT, "read", (sexp)"*current-input-port*", sexp_read),
_FN2OPTP(0, SEXP_OPORT, "write", (sexp)"*current-output-port*", sexp_write), _FN2OPTP(0, SEXP_OPORT, "write", (sexp)"*current-output-port*", sexp_write),
_FN2OPTP(0, SEXP_OPORT, "display", (sexp)"*current-output-port*", sexp_display), _FN2OPTP(0, SEXP_OPORT, "display", (sexp)"*current-output-port*", sexp_display),
@ -113,7 +113,7 @@ _PARAM("interaction-environment", (sexp)"*interaction-environment*", SEXP_ENV),
_FN0("open-output-string", 0, sexp_make_output_string_port), _FN0("open-output-string", 0, sexp_make_output_string_port),
_FN1(SEXP_STRING, "open-input-string", 0, sexp_make_input_string_port), _FN1(SEXP_STRING, "open-input-string", 0, sexp_make_input_string_port),
_FN1(SEXP_OPORT, "get-output-string", 0, sexp_get_output_string), _FN1(SEXP_OPORT, "get-output-string", 0, sexp_get_output_string),
#if USE_MATH #if SEXP_USE_MATH
_FN1(0, "exp", 0, sexp_exp), _FN1(0, "exp", 0, sexp_exp),
_FN1(0, "log", 0, sexp_log), _FN1(0, "log", 0, sexp_log),
_FN1(0, "sin", 0, sexp_sin), _FN1(0, "sin", 0, sexp_sin),
@ -129,14 +129,14 @@ _FN1(0, "floor", 0, sexp_floor),
_FN1(0, "ceiling", 0, sexp_ceiling), _FN1(0, "ceiling", 0, sexp_ceiling),
_FN2(0, 0, "expt", 0, sexp_expt), _FN2(0, 0, "expt", 0, sexp_expt),
#endif #endif
#if USE_TYPE_DEFS #if SEXP_USE_TYPE_DEFS
_FN2(SEXP_STRING, SEXP_FIXNUM, "register-simple-type", 0, sexp_register_simple_type), _FN2(SEXP_STRING, SEXP_FIXNUM, "register-simple-type", 0, sexp_register_simple_type),
_FN2(SEXP_STRING, SEXP_FIXNUM, "make-type-predicate", 0, sexp_make_type_predicate), _FN2(SEXP_STRING, SEXP_FIXNUM, "make-type-predicate", 0, sexp_make_type_predicate),
_FN2(SEXP_STRING, SEXP_FIXNUM, "make-constructor", 0, sexp_make_constructor), _FN2(SEXP_STRING, SEXP_FIXNUM, "make-constructor", 0, sexp_make_constructor),
_FN3(SEXP_STRING, SEXP_FIXNUM, "make-getter", 0, sexp_make_getter), _FN3(SEXP_STRING, SEXP_FIXNUM, "make-getter", 0, sexp_make_getter),
_FN3(SEXP_STRING, SEXP_FIXNUM, "make-setter", 0, sexp_make_setter), _FN3(SEXP_STRING, SEXP_FIXNUM, "make-setter", 0, sexp_make_setter),
#endif #endif
#if USE_DEBUG #if SEXP_USE_DEBUG
_FN2OPTP(SEXP_PROCEDURE, SEXP_OPORT, "disasm", (sexp)"*current-error-port*", sexp_disasm), _FN2OPTP(SEXP_PROCEDURE, SEXP_OPORT, "disasm", (sexp)"*current-error-port*", sexp_disasm),
#endif #endif
#if PLAN9 #if PLAN9

View file

@ -57,45 +57,45 @@ static sexp disasm (sexp ctx, sexp bc, sexp out, int depth) {
sexp_printf(ctx, out, " <unknown> %d ", opcode); sexp_printf(ctx, out, " <unknown> %d ", opcode);
} }
switch (opcode) { switch (opcode) {
case OP_STACK_REF: case SEXP_OP_STACK_REF:
case OP_LOCAL_REF: case SEXP_OP_LOCAL_REF:
case OP_LOCAL_SET: case SEXP_OP_LOCAL_SET:
case OP_CLOSURE_REF: case SEXP_OP_CLOSURE_REF:
case OP_JUMP: case SEXP_OP_JUMP:
case OP_JUMP_UNLESS: case SEXP_OP_JUMP_UNLESS:
case OP_TYPEP: case SEXP_OP_TYPEP:
case OP_FCALL0: case SEXP_OP_FCALL0:
case OP_FCALL1: case SEXP_OP_FCALL1:
case OP_FCALL2: case SEXP_OP_FCALL2:
case OP_FCALL3: case SEXP_OP_FCALL3:
case OP_FCALL4: case SEXP_OP_FCALL4:
case OP_FCALL5: case SEXP_OP_FCALL5:
case OP_FCALL6: case SEXP_OP_FCALL6:
sexp_printf(ctx, out, "%ld", (sexp_sint_t) ((sexp*)ip)[0]); sexp_printf(ctx, out, "%ld", (sexp_sint_t) ((sexp*)ip)[0]);
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
case OP_SLOT_REF: case SEXP_OP_SLOT_REF:
case OP_SLOT_SET: case SEXP_OP_SLOT_SET:
case OP_MAKE: case SEXP_OP_MAKE:
ip += sizeof(sexp)*2; ip += sizeof(sexp)*2;
break; break;
case OP_GLOBAL_REF: case SEXP_OP_GLOBAL_REF:
case OP_GLOBAL_KNOWN_REF: case SEXP_OP_GLOBAL_KNOWN_REF:
case OP_TAIL_CALL: case SEXP_OP_TAIL_CALL:
case OP_CALL: case SEXP_OP_CALL:
case OP_PUSH: case SEXP_OP_PUSH:
tmp = ((sexp*)ip)[0]; tmp = ((sexp*)ip)[0];
if (((opcode == OP_GLOBAL_REF) || (opcode == OP_GLOBAL_KNOWN_REF)) if (((opcode == SEXP_OP_GLOBAL_REF) || (opcode == SEXP_OP_GLOBAL_KNOWN_REF))
&& sexp_pairp(tmp)) && sexp_pairp(tmp))
tmp = sexp_car(tmp); tmp = sexp_car(tmp);
else if ((opcode == OP_PUSH) && (sexp_pairp(tmp) || sexp_idp(tmp))) else if ((opcode == SEXP_OP_PUSH) && (sexp_pairp(tmp) || sexp_idp(tmp)))
sexp_write_char(ctx, '\'', out); sexp_write_char(ctx, '\'', out);
sexp_write(ctx, tmp, out); sexp_write(ctx, tmp, out);
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
} }
sexp_write_char(ctx, '\n', out); sexp_write_char(ctx, '\n', out);
if ((opcode == OP_PUSH) && (depth < SEXP_DISASM_MAX_DEPTH) if ((opcode == SEXP_OP_PUSH) && (depth < SEXP_DISASM_MAX_DEPTH)
&& (sexp_bytecodep(tmp) || sexp_procedurep(tmp))) && (sexp_bytecodep(tmp) || sexp_procedurep(tmp)))
disasm(ctx, tmp, out, depth+1); disasm(ctx, tmp, out, depth+1);
if (ip - sexp_bytecode_data(bc) < sexp_bytecode_length(bc)) if (ip - sexp_bytecode_data(bc) < sexp_bytecode_length(bc))
@ -107,7 +107,7 @@ static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) {
return disasm(ctx, bc, out, 0); return disasm(ctx, bc, out, 0);
} }
#if USE_DEBUG_VM #if SEXP_USE_DEBUG_VM
static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) { static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) {
int i; int i;
if (! sexp_oport(out)) out = sexp_current_error_port(ctx); if (! sexp_oport(out)) out = sexp_current_error_port(ctx);

View file

@ -186,7 +186,7 @@ void sexp_run_9p_handler (Req *r, sexp handler) {
sexp_gc_var(ctx, args, s_args); sexp_gc_var(ctx, args, s_args);
sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, ptr, s_ptr);
sexp_gc_preserve(ctx, args, s_args); sexp_gc_preserve(ctx, args, s_args);
ptr = sexp_make_cpointer(ctx, r); ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, r, SEXP_FALSE, 0);
args = sexp_cons(ctx, ptr, SEXP_NULL); args = sexp_cons(ctx, ptr, SEXP_NULL);
sexp_apply(ctx, handler, args); sexp_apply(ctx, handler, args);
sexp_gc_release(ctx, ptr, s_ptr); sexp_gc_release(ctx, ptr, s_ptr);
@ -216,11 +216,11 @@ char* sexp_9p_walk1 (Fid *fid, char *name, Qid *qid) {
sexp_gc_var(ctx, args, s_args); sexp_gc_var(ctx, args, s_args);
sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, ptr, s_ptr);
sexp_gc_preserve(ctx, args, s_args); sexp_gc_preserve(ctx, args, s_args);
ptr = sexp_make_cpointer(ctx, qid); ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, qid, SEXP_FALSE, 0);
args = sexp_cons(ctx, ptr, SEXP_NULL); args = sexp_cons(ctx, ptr, SEXP_NULL);
ptr = sexp_c_string(ctx, name, -1); ptr = sexp_c_string(ctx, name, -1);
args = sexp_cons(ctx, ptr, args); args = sexp_cons(ctx, ptr, args);
ptr = sexp_make_cpointer(ctx, fid); ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, fid, SEXP_FALSE, 0);
args = sexp_cons(ctx, ptr, args); args = sexp_cons(ctx, ptr, args);
res = sexp_apply(ctx, s->walk1, args); res = sexp_apply(ctx, s->walk1, args);
sexp_gc_release(ctx, ptr, s_ptr); sexp_gc_release(ctx, ptr, s_ptr);
@ -234,9 +234,9 @@ char* sexp_9p_clone (Fid *oldfid, Fid *newfid) {
sexp_gc_var(ctx, args, s_args); sexp_gc_var(ctx, args, s_args);
sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, ptr, s_ptr);
sexp_gc_preserve(ctx, args, s_args); sexp_gc_preserve(ctx, args, s_args);
ptr = sexp_make_cpointer(ctx, oldfid); ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, oldfid, SEXP_FALSE, 0);
args = sexp_cons(ctx, ptr, SEXP_NULL); args = sexp_cons(ctx, ptr, SEXP_NULL);
ptr = sexp_make_cpointer(ctx, newfid); ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, newfid, SEXP_FALSE, 0);
args = sexp_cons(ctx, ptr, args); args = sexp_cons(ctx, ptr, args);
res = sexp_apply(ctx, s->clone, args); res = sexp_apply(ctx, s->clone, args);
sexp_gc_release(ctx, ptr, s_ptr); sexp_gc_release(ctx, ptr, s_ptr);
@ -250,7 +250,7 @@ void sexp_9p_destroyfid (Fid *fid) {
sexp_gc_var(ctx, args, s_args); sexp_gc_var(ctx, args, s_args);
sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, ptr, s_ptr);
sexp_gc_preserve(ctx, args, s_args); sexp_gc_preserve(ctx, args, s_args);
ptr = sexp_make_cpointer(ctx, fid); ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, fid, SEXP_FALSE, 0);
args = sexp_cons(ctx, ptr, SEXP_NULL); args = sexp_cons(ctx, ptr, SEXP_NULL);
sexp_apply(ctx, s->destroyfid, args); sexp_apply(ctx, s->destroyfid, args);
sexp_gc_release(ctx, ptr, s_ptr); sexp_gc_release(ctx, ptr, s_ptr);
@ -263,7 +263,7 @@ void sexp_9p_destroyreq (Req *r) {
sexp_gc_var(ctx, args, s_args); sexp_gc_var(ctx, args, s_args);
sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, ptr, s_ptr);
sexp_gc_preserve(ctx, args, s_args); sexp_gc_preserve(ctx, args, s_args);
ptr = sexp_make_cpointer(ctx, r); ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, r, SEXP_FALSE, 0);
args = sexp_cons(ctx, ptr, SEXP_NULL); args = sexp_cons(ctx, ptr, SEXP_NULL);
sexp_apply(ctx, s->destroyreq, args); sexp_apply(ctx, s->destroyreq, args);
sexp_gc_release(ctx, ptr, s_ptr); sexp_gc_release(ctx, ptr, s_ptr);
@ -276,7 +276,7 @@ void sexp_9p_end (Srv *srv) {
sexp_gc_var(ctx, args, s_args); sexp_gc_var(ctx, args, s_args);
sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, ptr, s_ptr);
sexp_gc_preserve(ctx, args, s_args); sexp_gc_preserve(ctx, args, s_args);
ptr = sexp_make_cpointer(ctx, srv); ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, srv, SEXP_FALSE, 0);
args = sexp_cons(ctx, ptr, SEXP_NULL); args = sexp_cons(ctx, ptr, SEXP_NULL);
sexp_apply(ctx, s->end, args); sexp_apply(ctx, s->end, args);
sexp_gc_release(ctx, ptr, s_ptr); sexp_gc_release(ctx, ptr, s_ptr);
@ -331,11 +331,11 @@ sexp sexp_9p_req_path (sexp ctx, sexp req) {
#endif #endif
sexp sexp_9p_req_fid (sexp ctx, sexp req) { sexp sexp_9p_req_fid (sexp ctx, sexp req) {
return sexp_make_cpointer(ctx, ((Req*)sexp_cpointer_value(req))->fid); return sexp_make_cpointer(ctx, SEXP_CPOINTER, ((Req*)sexp_cpointer_value(req))->fid, SEXP_FALSE, 0);
} }
sexp sexp_9p_req_newfid (sexp ctx, sexp req) { sexp sexp_9p_req_newfid (sexp ctx, sexp req) {
return sexp_make_cpointer(ctx, ((Req*)sexp_cpointer_value(req))->newfid); return sexp_make_cpointer(ctx, SEXP_CPOINTER, ((Req*)sexp_cpointer_value(req))->newfid, SEXP_FALSE, 0);
} }
sexp sexp_9p_respond (sexp ctx, sexp req, sexp err) { sexp sexp_9p_respond (sexp ctx, sexp req, sexp err) {

View file

@ -22,7 +22,7 @@ static sexp simplify (sexp ctx, sexp ast, sexp init_substs, sexp lambda) {
sexp_push(ctx, app, tmp=simplify(ctx, sexp_car(ls1), substs, lambda)); sexp_push(ctx, app, tmp=simplify(ctx, sexp_car(ls1), substs, lambda));
app = sexp_nreverse(ctx, app); app = sexp_nreverse(ctx, app);
if (sexp_opcodep(sexp_car(app))) { if (sexp_opcodep(sexp_car(app))) {
if (sexp_opcode_class(sexp_car(app)) == OPC_ARITHMETIC) { if (sexp_opcode_class(sexp_car(app)) == SEXP_OPC_ARITHMETIC) {
for (check=1, ls1=sexp_cdr(app); sexp_pairp(ls1); ls1=sexp_cdr(ls1)) { for (check=1, ls1=sexp_cdr(app); sexp_pairp(ls1); ls1=sexp_cdr(ls1)) {
if (sexp_pointerp(sexp_car(ls1)) && ! sexp_litp(sexp_car(ls1))) { if (sexp_pointerp(sexp_car(ls1)) && ! sexp_litp(sexp_car(ls1))) {
check = 0; check = 0;

80
sexp.c
View file

@ -10,7 +10,7 @@ struct sexp_huff_entry {
unsigned short bits; unsigned short bits;
}; };
#if USE_HUFF_SYMS #if SEXP_USE_HUFF_SYMS
#include "opt/sexp-hufftabs.c" #include "opt/sexp-hufftabs.c"
static struct sexp_huff_entry huff_table[] = { static struct sexp_huff_entry huff_table[] = {
#include "opt/sexp-huff.c" #include "opt/sexp-huff.c"
@ -43,7 +43,7 @@ static int is_separator(int c) {
return 0<c && c<0x60 && sexp_separators[c]; return 0<c && c<0x60 && sexp_separators[c];
} }
#if USE_GLOBAL_SYMBOLS #if SEXP_USE_GLOBAL_SYMBOLS
sexp sexp_symbol_table[SEXP_SYMBOL_TABLE_SIZE]; sexp sexp_symbol_table[SEXP_SYMBOL_TABLE_SIZE];
#endif #endif
@ -53,7 +53,7 @@ sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
return res; return res;
} }
#if USE_AUTOCLOSE_PORTS #if SEXP_USE_AUTOCLOSE_PORTS
static sexp sexp_finalize_port (sexp ctx, sexp port) { static sexp sexp_finalize_port (sexp ctx, sexp port) {
if (sexp_port_openp(port) && sexp_port_stream(port) if (sexp_port_openp(port) && sexp_port_stream(port)
&& sexp_stringp(sexp_port_name(port))) && sexp_stringp(sexp_port_name(port)))
@ -104,7 +104,7 @@ static struct sexp_struct _sexp_type_specs[] = {
struct sexp_struct *sexp_type_specs = _sexp_type_specs; struct sexp_struct *sexp_type_specs = _sexp_type_specs;
#if USE_TYPE_DEFS #if SEXP_USE_TYPE_DEFS
static sexp_uint_t sexp_num_types = SEXP_NUM_CORE_TYPES; static sexp_uint_t sexp_num_types = SEXP_NUM_CORE_TYPES;
static sexp_uint_t sexp_type_array_size = SEXP_NUM_CORE_TYPES; static sexp_uint_t sexp_type_array_size = SEXP_NUM_CORE_TYPES;
@ -168,20 +168,20 @@ sexp sexp_finalize_c_type (sexp ctx, sexp obj) {
#define sexp_num_types SEXP_NUM_CORE_TYPES #define sexp_num_types SEXP_NUM_CORE_TYPES
#endif #endif
#if ! USE_BOEHM #if ! SEXP_USE_BOEHM
#if ! USE_MALLOC #if ! SEXP_USE_MALLOC
#include "gc.c" #include "gc.c"
#endif #endif
#endif /* ! USE_BOEHM */ #endif /* ! SEXP_USE_BOEHM */
/****************************** contexts ******************************/ /****************************** contexts ******************************/
void sexp_init_context_globals (sexp ctx) { void sexp_init_context_globals (sexp ctx) {
sexp_context_globals(ctx) sexp_context_globals(ctx)
= sexp_make_vector(ctx, sexp_make_fixnum(SEXP_G_NUM_GLOBALS), SEXP_VOID); = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_G_NUM_GLOBALS), SEXP_VOID);
#if ! USE_GLOBAL_SYMBOLS #if ! SEXP_USE_GLOBAL_SYMBOLS
sexp_global(ctx, SEXP_G_SYMBOLS) = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_SYMBOL_TABLE_SIZE), SEXP_NULL); sexp_global(ctx, SEXP_G_SYMBOLS) = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_SYMBOL_TABLE_SIZE), SEXP_NULL);
#endif #endif
sexp_global(ctx, SEXP_G_OOM_ERROR) = sexp_user_exception(ctx, SEXP_FALSE, "out of memory", SEXP_NULL); sexp_global(ctx, SEXP_G_OOM_ERROR) = sexp_user_exception(ctx, SEXP_FALSE, "out of memory", SEXP_NULL);
@ -199,7 +199,7 @@ void sexp_init_context_globals (sexp ctx) {
sexp_vector_length(sexp_global(ctx, SEXP_G_EMPTY_VECTOR)) = 0; sexp_vector_length(sexp_global(ctx, SEXP_G_EMPTY_VECTOR)) = 0;
} }
#if ! USE_GLOBAL_HEAP #if ! SEXP_USE_GLOBAL_HEAP
sexp sexp_bootstrap_context (void) { sexp sexp_bootstrap_context (void) {
sexp dummy_ctx, ctx; sexp dummy_ctx, ctx;
sexp_heap heap = sexp_make_heap(sexp_heap_align(SEXP_INITIAL_HEAP_SIZE)); sexp_heap heap = sexp_make_heap(sexp_heap_align(SEXP_INITIAL_HEAP_SIZE));
@ -218,13 +218,13 @@ sexp sexp_bootstrap_context (void) {
sexp sexp_make_context (sexp ctx) { sexp sexp_make_context (sexp ctx) {
sexp_gc_var1(res); sexp_gc_var1(res);
if (ctx) sexp_gc_preserve1(ctx, res); if (ctx) sexp_gc_preserve1(ctx, res);
#if ! USE_GLOBAL_HEAP #if ! SEXP_USE_GLOBAL_HEAP
if (! ctx) res = sexp_bootstrap_context(); if (! ctx) res = sexp_bootstrap_context();
else else
#endif #endif
{ {
res = sexp_alloc_type(ctx, context, SEXP_CONTEXT); res = sexp_alloc_type(ctx, context, SEXP_CONTEXT);
#if ! USE_BOEHM && ! USE_MALLOC #if ! SEXP_USE_BOEHM && ! SEXP_USE_MALLOC
sexp_context_heap(res) = sexp_context_heap(ctx); sexp_context_heap(res) = sexp_context_heap(ctx);
#endif #endif
} }
@ -245,7 +245,7 @@ sexp sexp_make_context (sexp ctx) {
return res; return res;
} }
#if ! USE_GLOBAL_HEAP #if ! SEXP_USE_GLOBAL_HEAP
void sexp_destroy_context (sexp ctx) { void sexp_destroy_context (sexp ctx) {
sexp_heap heap; sexp_heap heap;
if (sexp_context_heap(ctx)) { if (sexp_context_heap(ctx)) {
@ -486,7 +486,7 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
if (a == b) if (a == b)
return SEXP_TRUE; return SEXP_TRUE;
#if USE_IMMEDIATE_FLONUMS #if SEXP_USE_IMMEDIATE_FLONUMS
if ((! sexp_pointerp(a)) || (! sexp_pointerp(b))) if ((! sexp_pointerp(a)) || (! sexp_pointerp(b)))
return return
sexp_make_boolean((sexp_flonump(a) && sexp_fixnump(b) sexp_make_boolean((sexp_flonump(a) && sexp_fixnump(b)
@ -503,7 +503,7 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
#endif #endif
if (sexp_pointer_tag(a) != sexp_pointer_tag(b)) { if (sexp_pointer_tag(a) != sexp_pointer_tag(b)) {
#if USE_BIGNUMS && ! USE_IMMEDIATE_FLONUMS #if SEXP_USE_BIGNUMS && ! SEXP_USE_IMMEDIATE_FLONUMS
if (sexp_pointer_tag(a) == SEXP_FLONUM) {t=a; a=b; b=t;} if (sexp_pointer_tag(a) == SEXP_FLONUM) {t=a; a=b; b=t;}
if (sexp_pointer_tag(a) == SEXP_BIGNUM) if (sexp_pointer_tag(a) == SEXP_BIGNUM)
return sexp_make_boolean((sexp_pointer_tag(b) == SEXP_FLONUM) return sexp_make_boolean((sexp_pointer_tag(b) == SEXP_FLONUM)
@ -515,11 +515,11 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
} }
/* a and b are both pointers of the same type */ /* a and b are both pointers of the same type */
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
if (sexp_pointer_tag(a) == SEXP_BIGNUM) if (sexp_pointer_tag(a) == SEXP_BIGNUM)
return sexp_make_boolean(!sexp_bignum_compare(a, b)); return sexp_make_boolean(!sexp_bignum_compare(a, b));
#endif #endif
#if USE_FLONUMS && ! USE_IMMEDIATE_FLONUMS #if SEXP_USE_FLONUMS && ! SEXP_USE_IMMEDIATE_FLONUMS
if (sexp_pointer_tag(a) == SEXP_FLONUM) if (sexp_pointer_tag(a) == SEXP_FLONUM)
return sexp_make_boolean(sexp_flonum_value(a) == sexp_flonum_value(b)); return sexp_make_boolean(sexp_flonum_value(a) == sexp_flonum_value(b));
#endif #endif
@ -556,7 +556,7 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
/********************* strings, symbols, vectors **********************/ /********************* strings, symbols, vectors **********************/
#if ! USE_IMMEDIATE_FLONUMS #if ! SEXP_USE_IMMEDIATE_FLONUMS
sexp sexp_make_flonum(sexp ctx, double f) { sexp sexp_make_flonum(sexp ctx, double f) {
sexp x = sexp_alloc_type(ctx, flonum, SEXP_FLONUM); sexp x = sexp_alloc_type(ctx, flonum, SEXP_FLONUM);
if (sexp_exceptionp(x)) return x; if (sexp_exceptionp(x)) return x;
@ -635,7 +635,7 @@ sexp sexp_string_concatenate (sexp ctx, sexp str_ls) {
#define FNV_PRIME 16777619 #define FNV_PRIME 16777619
#define FNV_OFFSET_BASIS 2166136261uL #define FNV_OFFSET_BASIS 2166136261uL
#if USE_HASH_SYMS #if SEXP_USE_HASH_SYMS
static sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc) { static sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc) {
while (*str) {acc *= FNV_PRIME; acc ^= *str++;} while (*str) {acc *= FNV_PRIME; acc ^= *str++;}
@ -651,7 +651,7 @@ sexp sexp_intern(sexp ctx, char *str) {
sexp ls; sexp ls;
sexp_gc_var1(sym); sexp_gc_var1(sym);
#if USE_HUFF_SYMS #if SEXP_USE_HUFF_SYMS
res = 0; res = 0;
for ( ; (c=*p); p++) { for ( ; (c=*p); p++) {
he = huff_table[(unsigned char)c]; he = huff_table[(unsigned char)c];
@ -666,7 +666,7 @@ sexp sexp_intern(sexp ctx, char *str) {
#endif #endif
normal_intern: normal_intern:
#if USE_HASH_SYMS #if SEXP_USE_HASH_SYMS
bucket = (sexp_string_hash(p, res) % SEXP_SYMBOL_TABLE_SIZE); bucket = (sexp_string_hash(p, res) % SEXP_SYMBOL_TABLE_SIZE);
#else #else
bucket = 0; bucket = 0;
@ -731,11 +731,11 @@ sexp sexp_make_cpointer (sexp ctx, sexp_uint_t typeid, void *value, sexp parent,
/************************ reading and writing *************************/ /************************ reading and writing *************************/
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
#include "opt/bignum.c" #include "opt/bignum.c"
#endif #endif
#if USE_STRING_STREAMS #if SEXP_USE_STRING_STREAMS
#define SEXP_INIT_STRING_PORT_SIZE 128 #define SEXP_INIT_STRING_PORT_SIZE 128
@ -743,8 +743,8 @@ sexp sexp_make_cpointer (sexp ctx, sexp_uint_t typeid, void *value, sexp parent,
#define sexp_stream_ctx(vec) sexp_vector_ref((sexp)vec, SEXP_ZERO) #define sexp_stream_ctx(vec) sexp_vector_ref((sexp)vec, SEXP_ZERO)
#define sexp_stream_buf(vec) sexp_vector_ref((sexp)vec, SEXP_ONE) #define sexp_stream_buf(vec) sexp_vector_ref((sexp)vec, SEXP_ONE)
#define sexp_stream_size(vec) sexp_vector_ref((sexp)vec, sexp_make_fixnum(2)) #define sexp_stream_size(vec) sexp_vector_ref((sexp)vec, SEXP_TWO)
#define sexp_stream_pos(vec) sexp_vector_ref((sexp)vec, sexp_make_fixnum(3)) #define sexp_stream_pos(vec) sexp_vector_ref((sexp)vec, SEXP_THREE)
int sstream_read (void *vec, char *dst, int n) { int sstream_read (void *vec, char *dst, int n) {
sexp_uint_t len = sexp_unbox_fixnum(sexp_stream_size(vec)); sexp_uint_t len = sexp_unbox_fixnum(sexp_stream_size(vec));
@ -1011,10 +1011,10 @@ sexp sexp_write (sexp ctx, sexp obj, sexp out) {
sexp_write_char(ctx, ')', out); sexp_write_char(ctx, ')', out);
} }
break; break;
#if ! USE_IMMEDIATE_FLONUMS #if ! SEXP_USE_IMMEDIATE_FLONUMS
case SEXP_FLONUM: case SEXP_FLONUM:
f = sexp_flonum_value(obj); f = sexp_flonum_value(obj);
#if USE_INFINITIES #if SEXP_USE_INFINITIES
if (isinf(f) || isnan(f)) { if (isinf(f) || isnan(f)) {
numbuf[0] = (isinf(f) && f < 0 ? '-' : '+'); numbuf[0] = (isinf(f) && f < 0 ? '-' : '+');
strcpy(numbuf+1, isinf(f) ? "inf.0" : "nan.0"); strcpy(numbuf+1, isinf(f) ? "inf.0" : "nan.0");
@ -1059,7 +1059,7 @@ sexp sexp_write (sexp ctx, sexp obj, sexp out) {
sexp_write_char(ctx, str[0], out); sexp_write_char(ctx, str[0], out);
} }
break; break;
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
case SEXP_BIGNUM: case SEXP_BIGNUM:
sexp_write_bignum(ctx, obj, out, 10); sexp_write_bignum(ctx, obj, out, 10);
break; break;
@ -1077,10 +1077,10 @@ sexp sexp_write (sexp ctx, sexp obj, sexp out) {
} else if (sexp_fixnump(obj)) { } else if (sexp_fixnump(obj)) {
sprintf(numbuf, "%ld", sexp_unbox_fixnum(obj)); sprintf(numbuf, "%ld", sexp_unbox_fixnum(obj));
sexp_write_string(ctx, numbuf, out); sexp_write_string(ctx, numbuf, out);
#if USE_IMMEDIATE_FLONUMS #if SEXP_USE_IMMEDIATE_FLONUMS
} else if (sexp_flonump(obj)) { } else if (sexp_flonump(obj)) {
f = sexp_flonum_value(obj); f = sexp_flonum_value(obj);
#if USE_INFINITIES #if SEXP_USE_INFINITIES
if (isinf(f) || isnan(f)) { if (isinf(f) || isnan(f)) {
numbuf[0] = (isinf(f) && f < 0 ? '-' : '+'); numbuf[0] = (isinf(f) && f < 0 ? '-' : '+');
strcpy(numbuf+1, isinf(f) ? "inf.0" : "nan.0"); strcpy(numbuf+1, isinf(f) ? "inf.0" : "nan.0");
@ -1114,7 +1114,7 @@ sexp sexp_write (sexp ctx, sexp obj, sexp out) {
} }
} else if (sexp_symbolp(obj)) { } else if (sexp_symbolp(obj)) {
#if USE_HUFF_SYMS #if SEXP_USE_HUFF_SYMS
if (((sexp_uint_t)obj&7)==7) { if (((sexp_uint_t)obj&7)==7) {
c = ((sexp_uint_t)obj)>>3; c = ((sexp_uint_t)obj)>>3;
while (c) { while (c) {
@ -1270,7 +1270,7 @@ sexp sexp_read_number(sexp ctx, sexp in, int base) {
if ((digit < 0) || (digit >= base)) if ((digit < 0) || (digit >= base))
break; break;
tmp = res * base + digit; tmp = res * base + digit;
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
if ((tmp < res) || (tmp > SEXP_MAX_FIXNUM)) { if ((tmp < res) || (tmp > SEXP_MAX_FIXNUM)) {
sexp_push_char(ctx, c, in); sexp_push_char(ctx, c, in);
return sexp_read_bignum(ctx, in, res, (negativep ? -1 : 1), base); return sexp_read_bignum(ctx, in, res, (negativep ? -1 : 1), base);
@ -1514,16 +1514,16 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
sexp_push_char(ctx, c2, in); sexp_push_char(ctx, c2, in);
res = sexp_read_number(ctx, in, 10); res = sexp_read_number(ctx, in, 10);
if ((c1 == '-') && ! sexp_exceptionp(res)) { if ((c1 == '-') && ! sexp_exceptionp(res)) {
#if USE_FLONUMS #if SEXP_USE_FLONUMS
if (sexp_flonump(res)) if (sexp_flonump(res))
#if USE_IMMEDIATE_FLONUMS #if SEXP_USE_IMMEDIATE_FLONUMS
res = sexp_make_flonum(ctx, -1 * sexp_flonum_value(res)); res = sexp_make_flonum(ctx, -1 * sexp_flonum_value(res));
#else #else
sexp_flonum_value(res) = -1 * sexp_flonum_value(res); sexp_flonum_value(res) = -1 * sexp_flonum_value(res);
#endif #endif
else else
#endif #endif
#if USE_BIGNUMS #if SEXP_USE_BIGNUMS
if (sexp_bignump(res)) if (sexp_bignump(res))
sexp_bignum_sign(res) = -sexp_bignum_sign(res); sexp_bignum_sign(res) = -sexp_bignum_sign(res);
else else
@ -1533,7 +1533,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
} else { } else {
sexp_push_char(ctx, c2, in); sexp_push_char(ctx, c2, in);
res = sexp_read_symbol(ctx, in, c1, 1); res = sexp_read_symbol(ctx, in, c1, 1);
#if USE_INFINITIES #if SEXP_USE_INFINITIES
if (res == sexp_intern(ctx, "+inf.0")) if (res == sexp_intern(ctx, "+inf.0"))
res = sexp_make_flonum(ctx, 1.0/0.0); res = sexp_make_flonum(ctx, 1.0/0.0);
else if (res == sexp_intern(ctx, "-inf.0")) else if (res == sexp_intern(ctx, "-inf.0"))
@ -1591,21 +1591,21 @@ sexp sexp_write_to_string(sexp ctx, sexp obj) {
} }
void sexp_init(void) { void sexp_init(void) {
#if USE_GLOBAL_SYMBOLS #if SEXP_USE_GLOBAL_SYMBOLS
int i; int i;
#endif #endif
if (! sexp_initialized_p) { if (! sexp_initialized_p) {
sexp_initialized_p = 1; sexp_initialized_p = 1;
#if USE_BOEHM #if SEXP_USE_BOEHM
GC_init(); GC_init();
#if USE_GLOBAL_SYMBOLS #if SEXP_USE_GLOBAL_SYMBOLS
GC_add_roots((char*)&sexp_symbol_table, GC_add_roots((char*)&sexp_symbol_table,
((char*)&sexp_symbol_table)+sizeof(sexp_symbol_table)+1); ((char*)&sexp_symbol_table)+sizeof(sexp_symbol_table)+1);
#endif #endif
#elif ! USE_MALLOC #elif ! SEXP_USE_MALLOC
sexp_gc_init(); sexp_gc_init();
#endif #endif
#if USE_GLOBAL_SYMBOLS #if SEXP_USE_GLOBAL_SYMBOLS
for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++) for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
sexp_symbol_table[i] = SEXP_NULL; sexp_symbol_table[i] = SEXP_NULL;
#endif #endif

View file

@ -147,6 +147,8 @@
type type
(lambda (type free? const? null-ptr? pointer? struct? link? result?) (lambda (type free? const? null-ptr? pointer? struct? link? result?)
(cond (cond
((eq? type 'void)
(cat "((" val "), SEXP_VOID)"))
((memq type '(sexp errno)) ((memq type '(sexp errno))
(cat val)) (cat val))
((eq? type 'time_t) ((eq? type 'time_t)