mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-10 14:37:34 +02:00
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
parent
9c77070888
commit
6fe11ffcd1
19 changed files with 607 additions and 581 deletions
49
Makefile
49
Makefile
|
|
@ -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
|
||||
|
|
|
|||
14
gc.c
14
gc.c
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
6
main.c
|
|
@ -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
3
mkfile
|
|
@ -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
136
opcodes.c
|
|
@ -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
|
||||
|
|
|
|||
52
opt/debug.c
52
opt/debug.c
|
|
@ -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);
|
||||
|
|
|
|||
20
opt/plan9.c
20
opt/plan9.c
|
|
@ -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) {
|
||||
|
|
|
|||
|
|
@ -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
80
sexp.c
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue