Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-10 22:47:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

49
Makefile
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
View file

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

162
include/chibi/config.h
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

190
include/chibi/eval.h
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);

32
include/chibi/sexp.h
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);

4
lib/chibi/posix.module
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"))

6
lib/chibi/posix.stub
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)))

4
lib/srfi/27/rand.c
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);

26
lib/srfi/33/bit.c
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))

2
lib/srfi/69/hash.c
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

52
opt/debug.c
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);

20
opt/plan9.c
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) {

2
opt/simplify.c
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

2
tools/genstubs.scm
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)