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
.PRECIOUS: %.c
# install configuration
CC ?= cc
PREFIX ?= /usr/local
BINDIR ?= $(PREFIX)/bin
@ -16,6 +18,9 @@ DESTDIR ?=
GENSTUBS ?= ./tools/genstubs.scm
# system configuration - if not using GNU make, set PLATFORM and the
# following flags as necessary.
ifndef PLATFORM
ifeq ($(shell uname),Darwin)
PLATFORM=macosx
@ -34,23 +39,45 @@ ifeq ($(PLATFORM),macosx)
SO = .dylib
EXE =
CLIBFLAGS = -dynamiclib
STATICFLAGS = -static-libgcc -DUSE_DL=0
STATICFLAGS = -static-libgcc -DSEXP_USE_DL=0
else
ifeq ($(PLATFORM),mingw)
SO = .dll
EXE = .exe
CC = gcc
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
else
SO = .so
EXE =
CLIBFLAGS = -fPIC -shared
STATICFLAGS = -static -DUSE_DL=0
STATICFLAGS = -static -DSEXP_USE_DL=0
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
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)
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
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)
#endif
#if USE_GLOBAL_HEAP
#if SEXP_USE_GLOBAL_HEAP
static sexp_heap sexp_global_heap;
#endif
#if USE_DEBUG_GC
#if SEXP_USE_DEBUG_GC
static sexp* stack_base;
#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) {
sexp *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 res;
#if USE_GLOBAL_SYMBOLS
#if SEXP_USE_GLOBAL_SYMBOLS
int i;
for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
sexp_mark(sexp_symbol_table[i]);
@ -232,13 +232,13 @@ void* sexp_alloc (sexp ctx, size_t size) {
}
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);
#endif
#if USE_GLOBAL_HEAP
#if SEXP_USE_GLOBAL_HEAP
sexp_global_heap = sexp_make_heap(size);
#endif
#if USE_DEBUG_GC
#if SEXP_USE_DEBUG_GC
/* the +32 is a hack, but this is just for debugging anyway */
stack_base = ((sexp*)&size) + 32;
#endif

View file

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

View file

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

View file

@ -11,7 +11,7 @@
#include <ctype.h>
#include <stdio.h>
#if USE_DL
#if SEXP_USE_DL
#include <dlfcn.h>
#endif
@ -56,7 +56,7 @@ typedef unsigned long size_t;
#define SEXP_CHAR_TAG 6
#define SEXP_EXTENDED_TAG 14
#if USE_HASH_SYMS
#if SEXP_USE_HASH_SYMS
#define SEXP_SYMBOL_TABLE_SIZE 389
#else
#define SEXP_SYMBOL_TABLE_SIZE 1
@ -278,7 +278,7 @@ struct sexp_struct {
#define SEXP_CLOSE SEXP_MAKE_IMMEDIATE(6) /* 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_preserve(ctx, x, y)
@ -307,7 +307,7 @@ struct sexp_struct {
#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_atomic(ctx, size) malloc(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)
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
#include "chibi/bignum.h"
#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_set(x,i,v) (((sexp*)&((x)->value))[i] = (v))
#if USE_IMMEDIATE_FLONUMS
#if SEXP_USE_IMMEDIATE_FLONUMS
union sexp_flonum_conv {
float flonum;
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))
#if USE_FLONUMS
#if SEXP_USE_FLONUMS
#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))
#else
#define _or_integer_flonump(x)
#endif
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
#define sexp_exact_integerp(x) (sexp_fixnump(x) || sexp_bignump(x))
#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))
#if USE_FLONUMS
#if SEXP_USE_FLONUMS
#define sexp_fixnum_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_fixnum(x)))
#else
#define sexp_fixnum_to_flonum(ctx, x) (x)
#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_sint_value(x) ((sexp_sint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignum_sign(x)*sexp_bignum_data(x)[0]))
#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])
#if USE_GLOBAL_HEAP
#if SEXP_USE_GLOBAL_HEAP
#define sexp_context_heap(ctx) sexp_global_heap
#else
#define sexp_context_heap(ctx) ((ctx)->value.context.heap)
#endif
#if USE_GLOBAL_SYMBOLS
#if SEXP_USE_GLOBAL_SYMBOLS
#define sexp_context_symbols(ctx) sexp_symbol_table
#else
#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 *****************************/
enum sexp_context_globals {
#if ! USE_GLOBAL_SYMBOLS
#if ! SEXP_USE_GLOBAL_SYMBOLS
SEXP_G_SYMBOLS,
#endif
SEXP_G_OOM_ERROR, /* out of memory exception object */
@ -724,7 +724,7 @@ enum sexp_context_globals {
/***************************** general API ****************************/
#if USE_STRING_STREAMS
#if SEXP_USE_STRING_STREAMS
#define sexp_read_char(x, p) (getc(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 void sexp_init(void);
#if USE_GLOBAL_HEAP
#if SEXP_USE_GLOBAL_HEAP
#define sexp_destroy_context(ctx)
#else
SEXP_API void sexp_destroy_context(sexp ctx);
#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_simple_type (sexp ctx, sexp name, sexp slots);
SEXP_API sexp sexp_register_c_type (sexp ctx, sexp name);

View file

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

View file

@ -29,10 +29,10 @@
(define-c pid_t fork ())
;; (define-c pid_t wait ((result pointer int)))
;; (define-c void exit (int))
;; (define-c int (execute execvp) (string (array string null)))
(define-c void exit (int))
;;(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)))

View file

@ -42,7 +42,7 @@ static sexp sexp_rs_random_integer (sexp ctx, sexp rs, sexp bound) {
if (sexp_fixnump(bound)) {
sexp_call_random(rs, n);
res = sexp_make_fixnum(n % sexp_unbox_fixnum(bound));
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(bound)) {
hi = sexp_bignum_hi(bound);
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);
else if (sexp_fixnump(state))
*sexp_random_data(rs) = sexp_unbox_fixnum(state);
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
else if (sexp_bignump(state))
*sexp_random_data(rs)
= sexp_bignum_data(state)[0]*sexp_bignum_sign(state);

View file

@ -2,7 +2,7 @@
#include <chibi/eval.h>
#include <limits.h>
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
#include <chibi/bignum.h>
#endif
@ -12,13 +12,13 @@ static sexp sexp_bit_and (sexp ctx, sexp x, sexp y) {
if (sexp_fixnump(x)) {
if (sexp_fixnump(y))
res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y);
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
else if (sexp_bignump(y))
res = sexp_bit_and(ctx, y, x);
#endif
else
res = sexp_type_exception(ctx, "bitwise-and: not an integer", y);
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) {
if (sexp_fixnump(y)) {
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(y))
res = (sexp) ((sexp_uint_t)x | (sexp_uint_t)y);
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
else if (sexp_bignump(y))
res = sexp_bit_ior(ctx, y, x);
#endif
else
res = sexp_type_exception(ctx, "bitwise-ior: not an integer", y);
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) {
if (sexp_fixnump(y)) {
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(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))
res = sexp_bit_xor(ctx, y, x);
#endif
else
res = sexp_type_exception(ctx, "bitwise-xor: not an integer", y);
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) {
if (sexp_fixnump(y)) {
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);
} else {
tmp = (sexp_uint_t)sexp_unbox_fixnum(i) << c;
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
if (((tmp >> c) == sexp_unbox_fixnum(i))
&& (tmp < SEXP_MAX_FIXNUM) && (tmp > SEXP_MIN_FIXNUM)) {
#endif
res = sexp_make_fixnum(tmp);
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
} else {
sexp_gc_preserve1(ctx, res);
res = sexp_fixnum_to_bignum(ctx, i);
@ -145,7 +145,7 @@ static sexp sexp_arithmetic_shift (sexp ctx, sexp i, sexp count) {
}
#endif
}
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(i)) {
len = sexp_bignum_hi(i);
if (c < 0) {
@ -198,7 +198,7 @@ static sexp sexp_bit_count (sexp ctx, sexp x) {
if (sexp_fixnump(x)) {
i = sexp_unbox_fixnum(x);
res = sexp_make_fixnum(bit_count(i<0 ? ~i : i));
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) {
for (i=count=0; i<sexp_bignum_length(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)) {
tmp = sexp_unbox_fixnum(x);
return sexp_make_fixnum(integer_log2(tmp < 0 ? -tmp-1 : tmp));
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
} else if (sexp_bignump(x)) {
hi = sexp_bignum_hi(x);
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);
if (sexp_fixnump(x)) {
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)) {
pos = sexp_unbox_fixnum(i) / (sizeof(sexp_uint_t)*CHAR_BIT);
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;
char *p0;
loop:
#if USE_FLONUMS
#if SEXP_USE_FLONUMS
if (sexp_flonump(obj))
acc ^= (sexp_sint_t) sexp_flonum_value(obj);
else

6
main.c
View file

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

3
mkfile
View file

@ -4,7 +4,7 @@ BIN=/$objtype/bin
TARG=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
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
echo '#define sexp_module_dir "'$MODDIR'"' > include/chibi/install.h
echo '#define sexp_platform "plan9"' >> include/chibi/install.h
install:V: $BIN/$TARG
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) \
{.tag=SEXP_OPCODE, \
.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 _FN0(s, d, f) _FN(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 _FN1OPT(t, s, d, f) _FN(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 _FN2(t, u, s, d, f) _FN(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 _FN2OPTP(t, u, s, d, f) _FN(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 _FN4(t, u, s, d, f) _FN(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 _FN6(t, u, s, d, f) _FN(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 _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(SEXP_OP_FCALL0, 0, 0, 0, 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(SEXP_OP_FCALL1, 0, 1, t, u, 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(SEXP_OP_FCALL2, 2, 0, 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(SEXP_OP_FCALL2, 1, 3, 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(SEXP_OP_FCALL4, 4, 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(SEXP_OP_FCALL6, 6, 0, t, u, s, d, f)
#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[] = {
_OP(OPC_ACCESSOR, 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(OPC_ACCESSOR, 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(OPC_ACCESSOR, 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(OPC_ACCESSOR, 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(OPC_ACCESSOR, 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(OPC_GENERIC, 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(OPC_GENERIC, 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(OPC_GENERIC, 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(OPC_ARITHMETIC, 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(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, OP_NEGATIVE, "-", 0, NULL),
_OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, OP_INVERSE, "/", 0, NULL),
_OP(OPC_ARITHMETIC, 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(OPC_ARITHMETIC_CMP, 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(OPC_ARITHMETIC_CMP, 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(OPC_ARITHMETIC_CMP, OP_EQN, 2, 1, SEXP_FIXNUM, 0, 0, "=", 0, NULL),
_OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL),
_OP(OPC_CONSTRUCTOR, 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(OPC_CONSTRUCTOR, 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(OPC_TYPE_PREDICATE, 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(OPC_TYPE_PREDICATE, 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(OPC_TYPE_PREDICATE, 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(OPC_TYPE_PREDICATE, 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(OPC_TYPE_PREDICATE, 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(OPC_TYPE_PREDICATE, 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(OPC_TYPE_PREDICATE, 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(OPC_GENERIC, 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(OPC_IO, 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(OPC_IO, 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_ACCESSOR, SEXP_OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_LENGTH,1,0, SEXP_VECTOR, 0, 0,"vector-length", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", 0, NULL),
_OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_LENGTH,1,0, SEXP_STRING, 0, 0,"string-length", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_FIX2FLO, 1, 0, 0, 0, 0, "exact->inexact", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_FLO2FIX, 1, 0, 0, 0, 0, "inexact->exact", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", 0, NULL),
_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_fixnum(0), NULL),
_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_fixnum(1), NULL),
_OP(SEXP_OPC_ARITHMETIC_INV, SEXP_OP_SUB, 0, 1, SEXP_FIXNUM, 0, SEXP_OP_NEGATIVE, "-", 0, NULL),
_OP(SEXP_OPC_ARITHMETIC_INV, SEXP_OP_DIV, 0, 1, SEXP_FIXNUM, 0, SEXP_OP_INVERSE, "/", 0, NULL),
_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", 0, NULL),
_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_REMAINDER, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "remainder", 0, NULL),
_OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LT, 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(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LT, 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(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_EQN, 2, 1, SEXP_FIXNUM, 0, 0, "=", 0, NULL),
_OP(SEXP_OPC_PREDICATE, SEXP_OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL),
_OP(SEXP_OPC_CONSTRUCTOR, SEXP_OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL),
_OP(SEXP_OPC_CONSTRUCTOR, SEXP_OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_VOID, NULL),
_OP(SEXP_OPC_CONSTRUCTOR, SEXP_OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_FIXNUMP, 1, 0, 0, 0, 0, "fixnum?", NULL, 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_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, "string?", sexp_make_fixnum(SEXP_STRING), 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_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, "flonum?", sexp_make_fixnum(SEXP_FLONUM), 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_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, "closure?", sexp_make_fixnum(SEXP_PROCEDURE), 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_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, "input-port?", sexp_make_fixnum(SEXP_IPORT), 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", sexp_make_fixnum(SEXP_OPORT), 0),
_OP(SEXP_OPC_GENERIC, SEXP_OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL),
_OP(SEXP_OPC_GENERIC, SEXP_OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL),
_OP(SEXP_OPC_IO, SEXP_OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (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(SEXP_OPC_IO, SEXP_OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-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),
_FN2OPTP(0, SEXP_OPORT, "write", (sexp)"*current-output-port*", sexp_write),
_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),
_FN1(SEXP_STRING, "open-input-string", 0, sexp_make_input_string_port),
_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, "log", 0, sexp_log),
_FN1(0, "sin", 0, sexp_sin),
@ -129,14 +129,14 @@ _FN1(0, "floor", 0, sexp_floor),
_FN1(0, "ceiling", 0, sexp_ceiling),
_FN2(0, 0, "expt", 0, sexp_expt),
#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, "make-type-predicate", 0, sexp_make_type_predicate),
_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-setter", 0, sexp_make_setter),
#endif
#if USE_DEBUG
#if SEXP_USE_DEBUG
_FN2OPTP(SEXP_PROCEDURE, SEXP_OPORT, "disasm", (sexp)"*current-error-port*", sexp_disasm),
#endif
#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);
}
switch (opcode) {
case OP_STACK_REF:
case OP_LOCAL_REF:
case OP_LOCAL_SET:
case OP_CLOSURE_REF:
case OP_JUMP:
case OP_JUMP_UNLESS:
case OP_TYPEP:
case OP_FCALL0:
case OP_FCALL1:
case OP_FCALL2:
case OP_FCALL3:
case OP_FCALL4:
case OP_FCALL5:
case OP_FCALL6:
case SEXP_OP_STACK_REF:
case SEXP_OP_LOCAL_REF:
case SEXP_OP_LOCAL_SET:
case SEXP_OP_CLOSURE_REF:
case SEXP_OP_JUMP:
case SEXP_OP_JUMP_UNLESS:
case SEXP_OP_TYPEP:
case SEXP_OP_FCALL0:
case SEXP_OP_FCALL1:
case SEXP_OP_FCALL2:
case SEXP_OP_FCALL3:
case SEXP_OP_FCALL4:
case SEXP_OP_FCALL5:
case SEXP_OP_FCALL6:
sexp_printf(ctx, out, "%ld", (sexp_sint_t) ((sexp*)ip)[0]);
ip += sizeof(sexp);
break;
case OP_SLOT_REF:
case OP_SLOT_SET:
case OP_MAKE:
case SEXP_OP_SLOT_REF:
case SEXP_OP_SLOT_SET:
case SEXP_OP_MAKE:
ip += sizeof(sexp)*2;
break;
case OP_GLOBAL_REF:
case OP_GLOBAL_KNOWN_REF:
case OP_TAIL_CALL:
case OP_CALL:
case OP_PUSH:
case SEXP_OP_GLOBAL_REF:
case SEXP_OP_GLOBAL_KNOWN_REF:
case SEXP_OP_TAIL_CALL:
case SEXP_OP_CALL:
case SEXP_OP_PUSH:
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))
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(ctx, tmp, out);
ip += sizeof(sexp);
break;
}
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)))
disasm(ctx, tmp, out, depth+1);
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);
}
#if USE_DEBUG_VM
#if SEXP_USE_DEBUG_VM
static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) {
int i;
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_preserve(ctx, ptr, s_ptr);
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);
sexp_apply(ctx, handler, args);
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_preserve(ctx, ptr, s_ptr);
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);
ptr = sexp_c_string(ctx, name, -1);
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);
res = sexp_apply(ctx, s->walk1, args);
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_preserve(ctx, ptr, s_ptr);
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);
ptr = sexp_make_cpointer(ctx, newfid);
ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, newfid, SEXP_FALSE, 0);
args = sexp_cons(ctx, ptr, args);
res = sexp_apply(ctx, s->clone, args);
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_preserve(ctx, ptr, s_ptr);
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);
sexp_apply(ctx, s->destroyfid, args);
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_preserve(ctx, ptr, s_ptr);
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);
sexp_apply(ctx, s->destroyreq, args);
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_preserve(ctx, ptr, s_ptr);
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);
sexp_apply(ctx, s->end, args);
sexp_gc_release(ctx, ptr, s_ptr);
@ -331,11 +331,11 @@ sexp sexp_9p_req_path (sexp ctx, sexp req) {
#endif
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) {
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) {

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));
app = sexp_nreverse(ctx, 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)) {
if (sexp_pointerp(sexp_car(ls1)) && ! sexp_litp(sexp_car(ls1))) {
check = 0;

80
sexp.c
View file

@ -10,7 +10,7 @@ struct sexp_huff_entry {
unsigned short bits;
};
#if USE_HUFF_SYMS
#if SEXP_USE_HUFF_SYMS
#include "opt/sexp-hufftabs.c"
static struct sexp_huff_entry huff_table[] = {
#include "opt/sexp-huff.c"
@ -43,7 +43,7 @@ static int is_separator(int 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];
#endif
@ -53,7 +53,7 @@ sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
return res;
}
#if USE_AUTOCLOSE_PORTS
#if SEXP_USE_AUTOCLOSE_PORTS
static sexp sexp_finalize_port (sexp ctx, sexp port) {
if (sexp_port_openp(port) && sexp_port_stream(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;
#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_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
#endif
#if ! USE_BOEHM
#if ! SEXP_USE_BOEHM
#if ! USE_MALLOC
#if ! SEXP_USE_MALLOC
#include "gc.c"
#endif
#endif /* ! USE_BOEHM */
#endif /* ! SEXP_USE_BOEHM */
/****************************** contexts ******************************/
void sexp_init_context_globals (sexp ctx) {
sexp_context_globals(ctx)
= 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);
#endif
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;
}
#if ! USE_GLOBAL_HEAP
#if ! SEXP_USE_GLOBAL_HEAP
sexp sexp_bootstrap_context (void) {
sexp dummy_ctx, ctx;
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_gc_var1(res);
if (ctx) sexp_gc_preserve1(ctx, res);
#if ! USE_GLOBAL_HEAP
#if ! SEXP_USE_GLOBAL_HEAP
if (! ctx) res = sexp_bootstrap_context();
else
#endif
{
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);
#endif
}
@ -245,7 +245,7 @@ sexp sexp_make_context (sexp ctx) {
return res;
}
#if ! USE_GLOBAL_HEAP
#if ! SEXP_USE_GLOBAL_HEAP
void sexp_destroy_context (sexp ctx) {
sexp_heap heap;
if (sexp_context_heap(ctx)) {
@ -486,7 +486,7 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
if (a == b)
return SEXP_TRUE;
#if USE_IMMEDIATE_FLONUMS
#if SEXP_USE_IMMEDIATE_FLONUMS
if ((! sexp_pointerp(a)) || (! sexp_pointerp(b)))
return
sexp_make_boolean((sexp_flonump(a) && sexp_fixnump(b)
@ -503,7 +503,7 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
#endif
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_BIGNUM)
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 */
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
if (sexp_pointer_tag(a) == SEXP_BIGNUM)
return sexp_make_boolean(!sexp_bignum_compare(a, b));
#endif
#if USE_FLONUMS && ! USE_IMMEDIATE_FLONUMS
#if SEXP_USE_FLONUMS && ! SEXP_USE_IMMEDIATE_FLONUMS
if (sexp_pointer_tag(a) == SEXP_FLONUM)
return sexp_make_boolean(sexp_flonum_value(a) == sexp_flonum_value(b));
#endif
@ -556,7 +556,7 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
/********************* strings, symbols, vectors **********************/
#if ! USE_IMMEDIATE_FLONUMS
#if ! SEXP_USE_IMMEDIATE_FLONUMS
sexp sexp_make_flonum(sexp ctx, double f) {
sexp x = sexp_alloc_type(ctx, flonum, SEXP_FLONUM);
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_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) {
while (*str) {acc *= FNV_PRIME; acc ^= *str++;}
@ -651,7 +651,7 @@ sexp sexp_intern(sexp ctx, char *str) {
sexp ls;
sexp_gc_var1(sym);
#if USE_HUFF_SYMS
#if SEXP_USE_HUFF_SYMS
res = 0;
for ( ; (c=*p); p++) {
he = huff_table[(unsigned char)c];
@ -666,7 +666,7 @@ sexp sexp_intern(sexp ctx, char *str) {
#endif
normal_intern:
#if USE_HASH_SYMS
#if SEXP_USE_HASH_SYMS
bucket = (sexp_string_hash(p, res) % SEXP_SYMBOL_TABLE_SIZE);
#else
bucket = 0;
@ -731,11 +731,11 @@ sexp sexp_make_cpointer (sexp ctx, sexp_uint_t typeid, void *value, sexp parent,
/************************ reading and writing *************************/
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
#include "opt/bignum.c"
#endif
#if USE_STRING_STREAMS
#if SEXP_USE_STRING_STREAMS
#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_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_pos(vec) sexp_vector_ref((sexp)vec, sexp_make_fixnum(3))
#define sexp_stream_size(vec) sexp_vector_ref((sexp)vec, SEXP_TWO)
#define sexp_stream_pos(vec) sexp_vector_ref((sexp)vec, SEXP_THREE)
int sstream_read (void *vec, char *dst, int n) {
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);
}
break;
#if ! USE_IMMEDIATE_FLONUMS
#if ! SEXP_USE_IMMEDIATE_FLONUMS
case SEXP_FLONUM:
f = sexp_flonum_value(obj);
#if USE_INFINITIES
#if SEXP_USE_INFINITIES
if (isinf(f) || isnan(f)) {
numbuf[0] = (isinf(f) && f < 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);
}
break;
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
case SEXP_BIGNUM:
sexp_write_bignum(ctx, obj, out, 10);
break;
@ -1077,10 +1077,10 @@ sexp sexp_write (sexp ctx, sexp obj, sexp out) {
} else if (sexp_fixnump(obj)) {
sprintf(numbuf, "%ld", sexp_unbox_fixnum(obj));
sexp_write_string(ctx, numbuf, out);
#if USE_IMMEDIATE_FLONUMS
#if SEXP_USE_IMMEDIATE_FLONUMS
} else if (sexp_flonump(obj)) {
f = sexp_flonum_value(obj);
#if USE_INFINITIES
#if SEXP_USE_INFINITIES
if (isinf(f) || isnan(f)) {
numbuf[0] = (isinf(f) && f < 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)) {
#if USE_HUFF_SYMS
#if SEXP_USE_HUFF_SYMS
if (((sexp_uint_t)obj&7)==7) {
c = ((sexp_uint_t)obj)>>3;
while (c) {
@ -1270,7 +1270,7 @@ sexp sexp_read_number(sexp ctx, sexp in, int base) {
if ((digit < 0) || (digit >= base))
break;
tmp = res * base + digit;
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
if ((tmp < res) || (tmp > SEXP_MAX_FIXNUM)) {
sexp_push_char(ctx, c, in);
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);
res = sexp_read_number(ctx, in, 10);
if ((c1 == '-') && ! sexp_exceptionp(res)) {
#if USE_FLONUMS
#if SEXP_USE_FLONUMS
if (sexp_flonump(res))
#if USE_IMMEDIATE_FLONUMS
#if SEXP_USE_IMMEDIATE_FLONUMS
res = sexp_make_flonum(ctx, -1 * sexp_flonum_value(res));
#else
sexp_flonum_value(res) = -1 * sexp_flonum_value(res);
#endif
else
#endif
#if USE_BIGNUMS
#if SEXP_USE_BIGNUMS
if (sexp_bignump(res))
sexp_bignum_sign(res) = -sexp_bignum_sign(res);
else
@ -1533,7 +1533,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
} else {
sexp_push_char(ctx, c2, in);
res = sexp_read_symbol(ctx, in, c1, 1);
#if USE_INFINITIES
#if SEXP_USE_INFINITIES
if (res == sexp_intern(ctx, "+inf.0"))
res = sexp_make_flonum(ctx, 1.0/0.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) {
#if USE_GLOBAL_SYMBOLS
#if SEXP_USE_GLOBAL_SYMBOLS
int i;
#endif
if (! sexp_initialized_p) {
sexp_initialized_p = 1;
#if USE_BOEHM
#if SEXP_USE_BOEHM
GC_init();
#if USE_GLOBAL_SYMBOLS
#if SEXP_USE_GLOBAL_SYMBOLS
GC_add_roots((char*)&sexp_symbol_table,
((char*)&sexp_symbol_table)+sizeof(sexp_symbol_table)+1);
#endif
#elif ! USE_MALLOC
#elif ! SEXP_USE_MALLOC
sexp_gc_init();
#endif
#if USE_GLOBAL_SYMBOLS
#if SEXP_USE_GLOBAL_SYMBOLS
for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
sexp_symbol_table[i] = SEXP_NULL;
#endif

View file

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