conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Squashed 'extlib/benz/' changes from 569b1ac..414f790 

414f790 Merge pull request #54 from KeenS/add-ops
f0ffe28 Merge pull request #53 from KeenS/compact-gc-header
17e1ad1 Merge pull request #233 from KeenS/restore-config
311fb62 optimize `equal?`. Don't initialize xhash until it is really needed.
c611258 safer names for utility macros
e7dc381 Merge commit '2440372c16fd1e479ad8aa346f6006dbf795a74c' into restore-config
99de906 rm miscommitted file
b85a3b7 (ref #50) add OP_SYMBOL_P and OP_PAIR_P
8048008 reduce gc header alignment for performance (both speed and space)

git-subtree-dir: extlib/benz
git-subtree-split: 414f790eef76a6a48e8100a162f6fdc8648e7513
This commit is contained in:
Yuichi Nishiwaki 2015-01-17 18:36:23 +09:00
parent 569b1ace02
commit 536d59c7d4
22 changed files with 142 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
bool.c
View File

@ -32,7 +32,7 @@ blob_equal_p(struct pic_blob *blob1, struct pic_blob *blob2)
} }
static bool static bool
internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *ht) internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *xh, bool xh_initted_p)
{ {
pic_value local = pic_nil_value(); pic_value local = pic_nil_value();
size_t c; size_t c;
@ -42,10 +42,15 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
pic_errorf(pic, "Stack overflow in equal\n"); pic_errorf(pic, "Stack overflow in equal\n");
} }
if (pic_pair_p(x) || pic_vec_p(x)) { if (pic_pair_p(x) || pic_vec_p(x)) {
if (xh_get_ptr(ht, pic_obj_ptr(x)) != NULL) { if (! xh_initted_p) {
xh_init_ptr(xh, 0);
xh_initted_p = true;
}
if (xh_get_ptr(xh, pic_obj_ptr(x)) != NULL) {
return true; /* `x' was seen already. */ return true; /* `x' was seen already. */
} else { } else {
xh_put_ptr(ht, pic_obj_ptr(x), NULL); xh_put_ptr(xh, pic_obj_ptr(x), NULL);
} }
} }
} }
@ -71,7 +76,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
if (pic_nil_p(local)) { if (pic_nil_p(local)) {
local = x; local = x;
} }
if (internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, ht)) { if (internal_equal_p(pic, pic_car(pic, x), pic_car(pic, y), depth + 1, xh, xh_initted_p)) {
x = pic_cdr(pic, x); x = pic_cdr(pic, x);
y = pic_cdr(pic, y); y = pic_cdr(pic, y);
@ -100,7 +105,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
return false; return false;
} }
for (i = 0; i < u->len; ++i) { for (i = 0; i < u->len; ++i) {
if (! internal_equal_p(pic, u->data[i], v->data[i], depth + 1, ht)) if (! internal_equal_p(pic, u->data[i], v->data[i], depth + 1, xh, xh_initted_p))
return false; return false;
} }
return true; return true;
@ -111,12 +116,11 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, size_t depth, xhash *
} }
bool bool
pic_equal_p(pic_state *pic, pic_value x, pic_value y){ pic_equal_p(pic_state *pic, pic_value x, pic_value y)
{
xhash ht; xhash ht;
xh_init_ptr(&ht, 0); return internal_equal_p(pic, x, y, 0, &ht, false);
return internal_equal_p(pic, x, y, 0, &ht);
} }
static pic_value static pic_value

25
codegen.c
View File

@ -35,6 +35,7 @@ typedef struct analyze_state {
pic_state *pic; pic_state *pic;
analyze_scope *scope; analyze_scope *scope;
pic_sym rCONS, rCAR, rCDR, rNILP; pic_sym rCONS, rCAR, rCDR, rNILP;
pic_sym rSYMBOL_P, rPAIR_P;
pic_sym rADD, rSUB, rMUL, rDIV; pic_sym rADD, rSUB, rMUL, rDIV;
pic_sym rEQ, rLT, rLE, rGT, rGE, rNOT; pic_sym rEQ, rLT, rLE, rGT, rGE, rNOT;
pic_sym rVALUES, rCALL_WITH_VALUES; pic_sym rVALUES, rCALL_WITH_VALUES;
@ -73,6 +74,8 @@ new_analyze_state(pic_state *pic)
register_renamed_symbol(pic, state, rCAR, pic->PICRIN_BASE, "car"); register_renamed_symbol(pic, state, rCAR, pic->PICRIN_BASE, "car");
register_renamed_symbol(pic, state, rCDR, pic->PICRIN_BASE, "cdr"); register_renamed_symbol(pic, state, rCDR, pic->PICRIN_BASE, "cdr");
register_renamed_symbol(pic, state, rNILP, pic->PICRIN_BASE, "null?"); register_renamed_symbol(pic, state, rNILP, pic->PICRIN_BASE, "null?");
register_renamed_symbol(pic, state, rSYMBOL_P, pic->PICRIN_BASE, "symbol?");
register_renamed_symbol(pic, state, rPAIR_P, pic->PICRIN_BASE, "pair?");
register_renamed_symbol(pic, state, rADD, pic->PICRIN_BASE, "+"); register_renamed_symbol(pic, state, rADD, pic->PICRIN_BASE, "+");
register_renamed_symbol(pic, state, rSUB, pic->PICRIN_BASE, "-"); register_renamed_symbol(pic, state, rSUB, pic->PICRIN_BASE, "-");
register_renamed_symbol(pic, state, rMUL, pic->PICRIN_BASE, "*"); register_renamed_symbol(pic, state, rMUL, pic->PICRIN_BASE, "*");
@ -492,7 +495,7 @@ analyze_if(analyze_state *state, pic_value obj, bool tailpos)
pic_errorf(pic, "syntax error"); pic_errorf(pic, "syntax error");
case 4: case 4:
if_false = pic_list_ref(pic, obj, 3); if_false = pic_list_ref(pic, obj, 3);
FALLTHROUGH; PIC_FALLTHROUGH;
case 3: case 3:
if_true = pic_list_ref(pic, obj, 2); if_true = pic_list_ref(pic, obj, 2);
} }
@ -788,6 +791,14 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos)
ARGC_ASSERT(1); ARGC_ASSERT(1);
return CONSTRUCT_OP1(pic->sNILP); return CONSTRUCT_OP1(pic->sNILP);
} }
else if (sym == state->rSYMBOL_P) {
ARGC_ASSERT(1);
return CONSTRUCT_OP1(pic->sSYMBOL_P);
}
else if (sym == state->rPAIR_P) {
ARGC_ASSERT(1);
return CONSTRUCT_OP1(pic->sPAIR_P);
}
else if (sym == state->rADD) { else if (sym == state->rADD) {
return analyze_add(state, obj, tailpos); return analyze_add(state, obj, tailpos);
} }
@ -1299,6 +1310,18 @@ codegen(codegen_state *state, pic_value obj)
cxt->clen++; cxt->clen++;
return; return;
} }
else if (sym == pic->sSYMBOL_P) {
codegen(state, pic_list_ref(pic, obj, 1));
cxt->code[cxt->clen].insn = OP_SYMBOL_P;
cxt->clen++;
return;
}
else if (sym == pic->sPAIR_P) {
codegen(state, pic_list_ref(pic, obj, 1));
cxt->code[cxt->clen].insn = OP_PAIR_P;
cxt->clen++;
return;
}
else if (sym == pic->sADD) { else if (sym == pic->sADD) {
codegen(state, pic_list_ref(pic, obj, 1)); codegen(state, pic_list_ref(pic, obj, 1));
codegen(state, pic_list_ref(pic, obj, 2)); codegen(state, pic_list_ref(pic, obj, 2));

2
cont.c
View File

@ -93,7 +93,7 @@ pic_load_point(pic_state *pic, struct pic_escape *escape)
escape->valid = false; escape->valid = false;
} }
noreturn static pic_value static pic_value
escape_call(pic_state *pic) escape_call(pic_state *pic)
{ {
size_t argc; size_t argc;

8
dict.c
View File

@ -14,7 +14,7 @@ xh_value_hash(const void *key, void *data)
pic_value val = *(pic_value *)key; pic_value val = *(pic_value *)key;
int hash, vtype; int hash, vtype;
UNUSED(data); PIC_UNUSED(data);
vtype = pic_vtype(val); vtype = pic_vtype(val);
@ -96,7 +96,7 @@ pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_value key)
void void
pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_value key, pic_value val) pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_value key, pic_value val)
{ {
UNUSED(pic); PIC_UNUSED(pic);
xh_put_value(&dict->hash, key, &val); xh_put_value(&dict->hash, key, &val);
} }
@ -104,7 +104,7 @@ pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_value key, pic_value val
size_t size_t
pic_dict_size(pic_state *pic, struct pic_dict *dict) pic_dict_size(pic_state *pic, struct pic_dict *dict)
{ {
UNUSED(pic); PIC_UNUSED(pic);
return dict->hash.count; return dict->hash.count;
} }
@ -112,7 +112,7 @@ pic_dict_size(pic_state *pic, struct pic_dict *dict)
bool bool
pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_value key) pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_value key)
{ {
UNUSED(pic); PIC_UNUSED(pic);
return xh_get_value(&dict->hash, key) != NULL; return xh_get_value(&dict->hash, key) != NULL;
} }

16
error.c
View File

@ -17,7 +17,7 @@
void void
pic_panic(pic_state *pic, const char *msg) pic_panic(pic_state *pic, const char *msg)
{ {
UNUSED(pic); PIC_UNUSED(pic);
fprintf(stderr, "abort: %s\n", msg); fprintf(stderr, "abort: %s\n", msg);
abort(); abort();
@ -69,7 +69,7 @@ pic_errmsg(pic_state *pic)
return pic_str_cstr(str); return pic_str_cstr(str);
} }
noreturn static pic_value static pic_value
native_exception_handler(pic_state *pic) native_exception_handler(pic_state *pic)
{ {
pic_value err; pic_value err;
@ -83,7 +83,7 @@ native_exception_handler(pic_state *pic)
pic_apply1(pic, cont, pic_false_value()); pic_apply1(pic, cont, pic_false_value());
UNREACHABLE(); PIC_UNREACHABLE();
} }
void void
@ -166,7 +166,7 @@ pic_raise_continuable(pic_state *pic, pic_value err)
return v; return v;
} }
noreturn void void
pic_raise(pic_state *pic, pic_value err) pic_raise(pic_state *pic, pic_value err)
{ {
pic_value val; pic_value val;
@ -178,7 +178,7 @@ pic_raise(pic_state *pic, pic_value err)
pic_errorf(pic, "error handler returned with ~s on error ~s", val, err); pic_errorf(pic, "error handler returned with ~s on error ~s", val, err);
} }
noreturn void void
pic_throw(pic_state *pic, pic_sym type, const char *msg, pic_value irrs) pic_throw(pic_state *pic, pic_sym type, const char *msg, pic_value irrs)
{ {
struct pic_error *e; struct pic_error *e;
@ -188,7 +188,7 @@ pic_throw(pic_state *pic, pic_sym type, const char *msg, pic_value irrs)
pic_raise(pic, pic_obj_value(e)); pic_raise(pic, pic_obj_value(e));
} }
noreturn void void
pic_error(pic_state *pic, const char *msg, pic_value irrs) pic_error(pic_state *pic, const char *msg, pic_value irrs)
{ {
pic_throw(pic, pic_intern_cstr(pic, ""), msg, irrs); pic_throw(pic, pic_intern_cstr(pic, ""), msg, irrs);
@ -221,7 +221,7 @@ pic_error_with_exception_handler(pic_state *pic)
return val; return val;
} }
noreturn static pic_value static pic_value
pic_error_raise(pic_state *pic) pic_error_raise(pic_state *pic)
{ {
pic_value v; pic_value v;
@ -241,7 +241,7 @@ pic_error_raise_continuable(pic_state *pic)
return pic_raise_continuable(pic, v); return pic_raise_continuable(pic, v);
} }
noreturn static pic_value static pic_value
pic_error_error(pic_state *pic) pic_error_error(pic_state *pic)
{ {
const char *str; const char *str;

2
file.c
View File

@ -6,7 +6,7 @@
#include "picrin/port.h" #include "picrin/port.h"
#include "picrin/error.h" #include "picrin/error.h"
static noreturn void pic_noreturn static void
file_error(pic_state *pic, const char *msg) file_error(pic_state *pic, const char *msg)
{ {
pic_throw(pic, pic->sFILE, msg, pic_nil_value()); pic_throw(pic, pic->sFILE, msg, pic_nil_value());

4
gc.c
View File

@ -30,7 +30,7 @@ union header {
size_t size; size_t size;
unsigned int mark : 1; unsigned int mark : 1;
} s; } s;
long alignment[4]; long alignment[2];
}; };
struct heap_page { struct heap_page {
@ -170,7 +170,7 @@ pic_calloc(pic_state *pic, size_t count, size_t size)
void void
pic_free(pic_state *pic, void *ptr) pic_free(pic_state *pic, void *ptr)
{ {
UNUSED(pic); PIC_UNUSED(pic);
free(ptr); free(ptr);
} }

9
include/picrin.h
View File

@ -89,6 +89,7 @@ typedef struct {
pic_sym sCOND_EXPAND, sAND, sOR, sELSE, sLIBRARY; pic_sym sCOND_EXPAND, sAND, sOR, sELSE, sLIBRARY;
pic_sym sONLY, sRENAME, sPREFIX, sEXCEPT; pic_sym sONLY, sRENAME, sPREFIX, sEXCEPT;
pic_sym sCONS, sCAR, sCDR, sNILP; pic_sym sCONS, sCAR, sCDR, sNILP;
pic_sym sSYMBOL_P, sPAIR_P;
pic_sym sADD, sSUB, sMUL, sDIV, sMINUS; pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT; pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT;
pic_sym sREAD, sFILE; pic_sym sREAD, sFILE;
@ -141,7 +142,7 @@ pic_value pic_gc_protect(pic_state *, pic_value);
size_t pic_gc_arena_preserve(pic_state *); size_t pic_gc_arena_preserve(pic_state *);
void pic_gc_arena_restore(pic_state *, size_t); void pic_gc_arena_restore(pic_state *, size_t);
#define pic_void(exec) \ #define pic_void(exec) \
pic_void_(GENSYM(ai), exec) pic_void_(PIC_GENSYM(ai), exec)
#define pic_void_(ai,exec) do { \ #define pic_void_(ai,exec) do { \
size_t ai = pic_gc_arena_preserve(pic); \ size_t ai = pic_gc_arena_preserve(pic); \
exec; \ exec; \
@ -202,7 +203,7 @@ struct pic_lib *pic_open_library(pic_state *, pic_value);
struct pic_lib *pic_find_library(pic_state *, pic_value); struct pic_lib *pic_find_library(pic_state *, pic_value);
#define pic_deflibrary(pic, spec) \ #define pic_deflibrary(pic, spec) \
pic_deflibrary_helper_(pic, GENSYM(i), GENSYM(prev_lib), spec) pic_deflibrary_helper_(pic, PIC_GENSYM(i), PIC_GENSYM(prev_lib), spec)
#define pic_deflibrary_helper_(pic, i, prev_lib, spec) \ #define pic_deflibrary_helper_(pic, i, prev_lib, spec) \
for (int i = 0; ! i; ) \ for (int i = 0; ! i; ) \
for (struct pic_lib *prev_lib; ! i; ) \ for (struct pic_lib *prev_lib; ! i; ) \
@ -212,8 +213,8 @@ void pic_import(pic_state *, pic_value);
void pic_import_library(pic_state *, struct pic_lib *); void pic_import_library(pic_state *, struct pic_lib *);
void pic_export(pic_state *, pic_sym); void pic_export(pic_state *, pic_sym);
noreturn void pic_panic(pic_state *, const char *); pic_noreturn void pic_panic(pic_state *, const char *);
noreturn void pic_errorf(pic_state *, const char *, ...); pic_noreturn void pic_errorf(pic_state *, const char *, ...);
void pic_warnf(pic_state *, const char *, ...); void pic_warnf(pic_state *, const char *, ...);
const char *pic_errmsg(pic_state *); const char *pic_errmsg(pic_state *);
pic_str *pic_get_backtrace(pic_state *); pic_str *pic_get_backtrace(pic_state *);

6
include/picrin/config.h
View File

@ -58,11 +58,11 @@
#endif #endif
#ifndef PIC_ARENA_SIZE #ifndef PIC_ARENA_SIZE
# define PIC_ARENA_SIZE 1000 # define PIC_ARENA_SIZE (8 * 1024)
#endif #endif
#ifndef PIC_HEAP_PAGE_SIZE #ifndef PIC_HEAP_PAGE_SIZE
# define PIC_HEAP_PAGE_SIZE 10000 # define PIC_HEAP_PAGE_SIZE (2 * 1024 * 1024)
#endif #endif
#ifndef PIC_STACK_SIZE #ifndef PIC_STACK_SIZE
@ -74,7 +74,7 @@
#endif #endif
#ifndef PIC_SYM_POOL_SIZE #ifndef PIC_SYM_POOL_SIZE
# define PIC_SYM_POOL_SIZE 128 # define PIC_SYM_POOL_SIZE (2 * 1024)
#endif #endif
#ifndef PIC_IREP_SIZE #ifndef PIC_IREP_SIZE

8
include/picrin/error.h
View File

@ -27,7 +27,7 @@ struct pic_error *pic_make_error(pic_state *, pic_sym, const char *, pic_list);
/* do not return from try block! */ /* do not return from try block! */
#define pic_try \ #define pic_try \
pic_try_(GENSYM(escape)) pic_try_(PIC_GENSYM(escape))
#define pic_try_(escape) \ #define pic_try_(escape) \
struct pic_escape *escape = pic_alloc(pic, sizeof(struct pic_escape)); \ struct pic_escape *escape = pic_alloc(pic, sizeof(struct pic_escape)); \
pic_save_point(pic, escape); \ pic_save_point(pic, escape); \
@ -43,9 +43,9 @@ void pic_push_try(pic_state *, struct pic_escape *);
void pic_pop_try(pic_state *); void pic_pop_try(pic_state *);
pic_value pic_raise_continuable(pic_state *, pic_value); pic_value pic_raise_continuable(pic_state *, pic_value);
noreturn void pic_raise(pic_state *, pic_value); pic_noreturn void pic_raise(pic_state *, pic_value);
noreturn void pic_throw(pic_state *, pic_sym, const char *, pic_list); pic_noreturn void pic_throw(pic_state *, pic_sym, const char *, pic_list);
noreturn void pic_error(pic_state *, const char *, pic_list); pic_noreturn void pic_error(pic_state *, const char *, pic_list);
#if defined(__cplusplus) #if defined(__cplusplus)
} }

8
include/picrin/irep.h
View File

@ -35,6 +35,8 @@ enum pic_opcode {
OP_CAR, OP_CAR,
OP_CDR, OP_CDR,
OP_NILP, OP_NILP,
OP_SYMBOL_P,
OP_PAIR_P,
OP_ADD, OP_ADD,
OP_SUB, OP_SUB,
OP_MUL, OP_MUL,
@ -149,6 +151,12 @@ pic_dump_code(pic_code c)
case OP_NILP: case OP_NILP:
puts("OP_NILP"); puts("OP_NILP");
break; break;
case OP_SYMBOL_P:
puts("OP_SYMBOL_P");
break;
case OP_PAIR_P:
puts("OP_PAIR_P");
break;
case OP_CDR: case OP_CDR:
puts("OP_CDR"); puts("OP_CDR");
break; break;

6
include/picrin/pair.h
View File

@ -59,9 +59,9 @@ pic_value pic_list7(pic_state *, pic_value, pic_value, pic_value, pic_value, pic
pic_value pic_list_by_array(pic_state *, size_t, pic_value *); pic_value pic_list_by_array(pic_state *, size_t, pic_value *);
pic_value pic_make_list(pic_state *, size_t, pic_value); pic_value pic_make_list(pic_state *, size_t, pic_value);
#define pic_for_each(var, list) \ #define pic_for_each(var, list) \
pic_for_each_helper_(var, GENSYM(tmp), list) pic_for_each_helper_(var, PIC_GENSYM(tmp), list)
#define pic_for_each_helper_(var, tmp, list) \ #define pic_for_each_helper_(var, tmp, list) \
for (pic_value tmp = (list); \ for (pic_value tmp = (list); \
pic_nil_p(tmp) ? false : ((var = pic_car(pic, tmp)), true); \ pic_nil_p(tmp) ? false : ((var = pic_car(pic, tmp)), true); \
tmp = pic_cdr(pic, tmp)) tmp = pic_cdr(pic, tmp))

27
include/picrin/util.h
View File

@ -11,33 +11,34 @@ extern "C" {
#if __STDC_VERSION__ >= 201112L #if __STDC_VERSION__ >= 201112L
# include <stdnoreturn.h> # include <stdnoreturn.h>
# define pic_noreturn noreturn
#elif __GNUC__ || __clang__ #elif __GNUC__ || __clang__
# define noreturn __attribute__((noreturn)) # define pic_noreturn __attribute__((noreturn))
#else #else
# define noreturn # define pic_noreturn
#endif #endif
#define FALLTHROUGH ((void)0) #define PIC_FALLTHROUGH ((void)0)
#define UNUSED(v) ((void)(v)) #define PIC_UNUSED(v) ((void)(v))
#define GENSYM2_(x,y) G##x##_##y##__ #define PIC_GENSYM2_(x,y) PIC_G##x##_##y##_
#define GENSYM1_(x,y) GENSYM2_(x,y) #define PIC_GENSYM1_(x,y) PIC_GENSYM2_(x,y)
#if defined(__COUNTER__) #if defined(__COUNTER__)
# define GENSYM(x) GENSYM1_(__COUNTER__,x) # define PIC_GENSYM(x) PIC_GENSYM1_(__COUNTER__,x)
#else #else
# define GENSYM(x) GENSYM1_(__LINE__,x) # define PIC_GENSYM(x) PIC_GENSYM1_(__LINE__,x)
#endif #endif
#if GCC_VERSION >= 40500 || __clang__ #if GCC_VERSION >= 40500 || __clang__
# define UNREACHABLE() (__builtin_unreachable()) # define PIC_UNREACHABLE() (__builtin_unreachable())
#else #else
# include <assert.h> # include <assert.h>
# define UNREACHABLE() (assert(false)) # define PIC_UNREACHABLE() (assert(false))
#endif #endif
#define SWAP(type,a,b) \ #define PIC_SWAP(type,a,b) \
SWAP_HELPER_(type,GENSYM(tmp),a,b) PIC_SWAP_HELPER_(type, PIC_GENSYM(tmp), a, b)
#define SWAP_HELPER_(type,tmp,a,b) \ #define PIC_SWAP_HELPER_(type,tmp,a,b) \
do { \ do { \
type tmp = (a); \ type tmp = (a); \
(a) = (b); \ (a) = (b); \

4
include/picrin/value.h
View File

@ -225,7 +225,7 @@ pic_type(pic_value v)
return ((struct pic_object *)pic_ptr(v))->tt; return ((struct pic_object *)pic_ptr(v))->tt;
} }
UNREACHABLE(); PIC_UNREACHABLE();
} }
static inline const char * static inline const char *
@ -279,7 +279,7 @@ pic_type_repr(enum pic_tt tt)
case PIC_TT_RECORD: case PIC_TT_RECORD:
return "record"; return "record";
} }
UNREACHABLE(); PIC_UNREACHABLE();
} }
static inline bool static inline bool

4
macro.c
View File

@ -25,7 +25,7 @@ pic_add_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym)
void void
pic_put_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym, pic_sym rename) pic_put_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym, pic_sym rename)
{ {
UNUSED(pic); PIC_UNUSED(pic);
xh_put_int(&senv->map, sym, &rename); xh_put_int(&senv->map, sym, &rename);
} }
@ -35,7 +35,7 @@ pic_find_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym, pic_sym *ren
{ {
xh_entry *e; xh_entry *e;
UNUSED(pic); PIC_UNUSED(pic);
if ((e = xh_get_int(&senv->map, sym)) == NULL) { if ((e = xh_get_int(&senv->map, sym)) == NULL) {
return false; return false;

2
proc.c
View File

@ -43,7 +43,7 @@ pic_proc_name(struct pic_proc *proc)
case PIC_PROC_KIND_IREP: case PIC_PROC_KIND_IREP:
return proc->u.irep->name; return proc->u.irep->name;
} }
UNREACHABLE(); PIC_UNREACHABLE();
} }
static pic_value static pic_value

54
read.c
View File

@ -18,7 +18,7 @@
static pic_value read(pic_state *pic, struct pic_port *port, int c); static pic_value read(pic_state *pic, struct pic_port *port, int c);
static pic_value read_nullable(pic_state *pic, struct pic_port *port, int c); static pic_value read_nullable(pic_state *pic, struct pic_port *port, int c);
static noreturn void pic_noreturn static void
read_error(pic_state *pic, const char *msg) read_error(pic_state *pic, const char *msg)
{ {
pic_throw(pic, pic->sREAD, msg, pic_nil_value()); pic_throw(pic, pic->sREAD, msg, pic_nil_value());
@ -86,8 +86,8 @@ read_comment(pic_state *pic, struct pic_port *port, const char *str)
{ {
int c; int c;
UNUSED(pic); PIC_UNUSED(pic);
UNUSED(str); PIC_UNUSED(str);
do { do {
c = next(port); c = next(port);
@ -102,8 +102,8 @@ read_block_comment(pic_state *pic, struct pic_port *port, const char *str)
int x, y; int x, y;
int i = 1; int i = 1;
UNUSED(pic); PIC_UNUSED(pic);
UNUSED(str); PIC_UNUSED(str);
y = next(port); y = next(port);
@ -124,7 +124,7 @@ read_block_comment(pic_state *pic, struct pic_port *port, const char *str)
static pic_value static pic_value
read_datum_comment(pic_state *pic, struct pic_port *port, const char *str) read_datum_comment(pic_state *pic, struct pic_port *port, const char *str)
{ {
UNUSED(str); PIC_UNUSED(str);
read(pic, port, next(port)); read(pic, port, next(port));
@ -157,7 +157,7 @@ read_eval(pic_state *pic, struct pic_port *port, const char *str)
{ {
pic_value form; pic_value form;
UNUSED(str); PIC_UNUSED(str);
form = read(pic, port, next(port)); form = read(pic, port, next(port));
@ -167,7 +167,7 @@ read_eval(pic_state *pic, struct pic_port *port, const char *str)
static pic_value static pic_value
read_quote(pic_state *pic, struct pic_port *port, const char *str) read_quote(pic_state *pic, struct pic_port *port, const char *str)
{ {
UNUSED(str); PIC_UNUSED(str);
return pic_list2(pic, pic_sym_value(pic->sQUOTE), read(pic, port, next(port))); return pic_list2(pic, pic_sym_value(pic->sQUOTE), read(pic, port, next(port)));
} }
@ -175,7 +175,7 @@ read_quote(pic_state *pic, struct pic_port *port, const char *str)
static pic_value static pic_value
read_quasiquote(pic_state *pic, struct pic_port *port, const char *str) read_quasiquote(pic_state *pic, struct pic_port *port, const char *str)
{ {
UNUSED(str); PIC_UNUSED(str);
return pic_list2(pic, pic_sym_value(pic->sQUASIQUOTE), read(pic, port, next(port))); return pic_list2(pic, pic_sym_value(pic->sQUASIQUOTE), read(pic, port, next(port)));
} }
@ -183,7 +183,7 @@ read_quasiquote(pic_state *pic, struct pic_port *port, const char *str)
static pic_value static pic_value
read_unquote(pic_state *pic, struct pic_port *port, const char *str) read_unquote(pic_state *pic, struct pic_port *port, const char *str)
{ {
UNUSED(str); PIC_UNUSED(str);
return pic_list2(pic, pic_sym_value(pic->sUNQUOTE), read(pic, port, next(port))); return pic_list2(pic, pic_sym_value(pic->sUNQUOTE), read(pic, port, next(port)));
} }
@ -191,7 +191,7 @@ read_unquote(pic_state *pic, struct pic_port *port, const char *str)
static pic_value static pic_value
read_unquote_splicing(pic_state *pic, struct pic_port *port, const char *str) read_unquote_splicing(pic_state *pic, struct pic_port *port, const char *str)
{ {
UNUSED(str); PIC_UNUSED(str);
return pic_list2(pic, pic_sym_value(pic->sUNQUOTE_SPLICING), read(pic, port, next(port))); return pic_list2(pic, pic_sym_value(pic->sUNQUOTE_SPLICING), read(pic, port, next(port)));
} }
@ -354,9 +354,9 @@ read_plus(pic_state *pic, struct pic_port *port, const char *str)
static pic_value static pic_value
read_true(pic_state *pic, struct pic_port *port, const char *str) read_true(pic_state *pic, struct pic_port *port, const char *str)
{ {
UNUSED(pic); PIC_UNUSED(pic);
UNUSED(port); PIC_UNUSED(port);
UNUSED(str); PIC_UNUSED(str);
return pic_true_value(); return pic_true_value();
} }
@ -364,9 +364,9 @@ read_true(pic_state *pic, struct pic_port *port, const char *str)
static pic_value static pic_value
read_false(pic_state *pic, struct pic_port *port, const char *str) read_false(pic_state *pic, struct pic_port *port, const char *str)
{ {
UNUSED(pic); PIC_UNUSED(pic);
UNUSED(port); PIC_UNUSED(port);
UNUSED(str); PIC_UNUSED(str);
return pic_false_value(); return pic_false_value();
} }
@ -376,7 +376,7 @@ read_char(pic_state *pic, struct pic_port *port, const char *str)
{ {
int c; int c;
UNUSED(str); PIC_UNUSED(str);
c = next(port); c = next(port);
@ -418,7 +418,7 @@ read_string(pic_state *pic, struct pic_port *port, const char *name)
size_t size, cnt; size_t size, cnt;
pic_str *str; pic_str *str;
UNUSED(name); PIC_UNUSED(name);
size = 256; size = 256;
buf = pic_alloc(pic, size); buf = pic_alloc(pic, size);
@ -459,7 +459,7 @@ read_pipe(pic_state *pic, struct pic_port *port, const char *str)
size_t i = 0; size_t i = 0;
int c; int c;
UNUSED(str); PIC_UNUSED(str);
size = 256; size = 256;
buf = pic_alloc(pic, size); buf = pic_alloc(pic, size);
@ -504,7 +504,7 @@ read_blob(pic_state *pic, struct pic_port *port, const char *str)
unsigned char *dat; unsigned char *dat;
pic_blob *blob; pic_blob *blob;
UNUSED(str); PIC_UNUSED(str);
nbits = 0; nbits = 0;
@ -631,13 +631,13 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
xh_put_int(&pic->reader->labels, i, &val); xh_put_int(&pic->reader->labels, i, &val);
tmp = pic_vec_ptr(read(pic, port, c)); tmp = pic_vec_ptr(read(pic, port, c));
SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data); PIC_SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data);
SWAP(size_t, tmp->len, pic_vec_ptr(val)->len); PIC_SWAP(size_t, tmp->len, pic_vec_ptr(val)->len);
return val; return val;
} }
FALLTHROUGH; PIC_FALLTHROUGH;
} }
default: default:
{ {
@ -655,7 +655,7 @@ read_label_ref(pic_state *pic, struct pic_port *port, int i)
{ {
xh_entry *e; xh_entry *e;
UNUSED(port); PIC_UNUSED(port);
e = xh_get_int(&pic->reader->labels, i); e = xh_get_int(&pic->reader->labels, i);
if (! e) { if (! e) {
@ -687,8 +687,8 @@ read_label(pic_state *pic, struct pic_port *port, const char *str)
static pic_value static pic_value
read_unmatch(pic_state *pic, struct pic_port *port, const char *str) read_unmatch(pic_state *pic, struct pic_port *port, const char *str)
{ {
UNUSED(port); PIC_UNUSED(port);
UNUSED(str); PIC_UNUSED(str);
read_error(pic, "unmatched parenthesis"); read_error(pic, "unmatched parenthesis");
} }

2
record.c
View File

@ -39,7 +39,7 @@ pic_record_ref(pic_state *pic, struct pic_record *rec, pic_sym slot)
void void
pic_record_set(pic_state *pic, struct pic_record *rec, pic_sym slot, pic_value val) pic_record_set(pic_state *pic, struct pic_record *rec, pic_sym slot, pic_value val)
{ {
UNUSED(pic); PIC_UNUSED(pic);
xh_put_int(&rec->hash, slot, &val); xh_put_int(&rec->hash, slot, &val);
} }

2
state.c
View File

@ -123,6 +123,8 @@ pic_open(int argc, char *argv[], char **envp)
S(sCAR, "car"); S(sCAR, "car");
S(sCDR, "cdr"); S(sCDR, "cdr");
S(sNILP, "null?"); S(sNILP, "null?");
S(sSYMBOL_P, "symbol?");
S(sPAIR_P, "pair?");
S(sADD, "+"); S(sADD, "+");
S(sSUB, "-"); S(sSUB, "-");
S(sMUL, "*"); S(sMUL, "*");

2
var.c
View File

@ -73,7 +73,7 @@ var_call(pic_state *pic)
return val; return val;
} }
} }
UNREACHABLE(); PIC_UNREACHABLE();
} }
struct pic_proc * struct pic_proc *

15
vm.c
View File

@ -693,6 +693,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
&&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_LSET, &&L_OP_CREF, &&L_OP_CSET, &&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_LSET, &&L_OP_CREF, &&L_OP_CSET,
&&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_NOT, &&L_OP_CALL, &&L_OP_TAILCALL, &&L_OP_RET, &&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_NOT, &&L_OP_CALL, &&L_OP_TAILCALL, &&L_OP_RET,
&&L_OP_LAMBDA, &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_NILP, &&L_OP_LAMBDA, &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_NILP,
&&L_OP_SYMBOL_P, &&L_OP_PAIR_P,
&&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_MINUS, &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_MINUS,
&&L_OP_EQ, &&L_OP_LT, &&L_OP_LE, &&L_OP_STOP &&L_OP_EQ, &&L_OP_LT, &&L_OP_LE, &&L_OP_STOP
}; };
@ -1035,6 +1036,20 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
NEXT; NEXT;
} }
CASE(OP_SYMBOL_P) {
pic_value p;
p = POP();
PUSH(pic_bool_value(pic_sym_p(p)));
NEXT;
}
CASE(OP_PAIR_P) {
pic_value p;
p = POP();
PUSH(pic_bool_value(pic_pair_p(p)));
NEXT;
}
#define DEFINE_ARITH_OP(opcode, op, guard) \ #define DEFINE_ARITH_OP(opcode, op, guard) \
CASE(opcode) { \ CASE(opcode) { \
pic_value a, b; \ pic_value a, b; \

2
write.c
View File

@ -164,7 +164,7 @@ write_str(pic_state *pic, struct pic_string *str, xFILE *file)
size_t i; size_t i;
const char *cstr = pic_str_cstr(str); const char *cstr = pic_str_cstr(str);
UNUSED(pic); PIC_UNUSED(pic);
for (i = 0; i < pic_strlen(str); ++i) { for (i = 0; i < pic_strlen(str); ++i) {
if (cstr[i] == '"' || cstr[i] == '\\') { if (cstr[i] == '"' || cstr[i] == '\\') {