pic_state * pic_open(int argc, char *argv[], char **envp) { struct pic_port *pic_make_standard_port(pic_state *, xFILE *, short); char t; pic_state *pic; size_t ai; pic = malloc(sizeof(pic_state)); /* turn off GC */ pic->gc_enable = false; /* root block */ pic->wind = NULL; /* command line */ pic->argc = argc; pic->argv = argv; pic->envp = envp; /* prepare VM stack */ pic->stbase = pic->sp = calloc(PIC_STACK_SIZE, sizeof(pic_value)); pic->stend = pic->stbase + PIC_STACK_SIZE; /* callinfo */ pic->cibase = pic->ci = calloc(PIC_STACK_SIZE, sizeof(pic_callinfo)); pic->ciend = pic->cibase + PIC_STACK_SIZE; /* exception handler */ pic->xpbase = pic->xp = calloc(PIC_RESCUE_SIZE, sizeof(struct pic_proc *)); pic->xpend = pic->xpbase + PIC_RESCUE_SIZE; /* memory heap */ pic->heap = pic_heap_open(); /* symbol table */ xh_init_str(&pic->syms, sizeof(pic_sym *)); /* global variables */ pic->globals = NULL; /* macros */ pic->macros = NULL; /* attributes */ xh_init_ptr(&pic->attrs, sizeof(struct pic_dict *)); /* features */ pic->features = pic_nil_value(); /* libraries */ pic->libs = pic_nil_value(); pic->lib = NULL; /* GC arena */ pic->arena = calloc(PIC_ARENA_SIZE, sizeof(struct pic_object **)); pic->arena_size = PIC_ARENA_SIZE; pic->arena_idx = 0; /* raised error object */ pic->err = pic_undef_value(); /* standard ports */ pic->xSTDIN = NULL; pic->xSTDOUT = NULL; pic->xSTDERR = NULL; /* native stack marker */ pic->native_stack_start = &t; ai = pic_gc_arena_preserve(pic); #define S(slot,name) pic->slot = pic_intern_cstr(pic, name); S(sDEFINE, "define"); S(sLAMBDA, "lambda"); S(sIF, "if"); S(sBEGIN, "begin"); S(sSETBANG, "set!"); S(sQUOTE, "quote"); S(sQUASIQUOTE, "quasiquote"); S(sUNQUOTE, "unquote"); S(sUNQUOTE_SPLICING, "unquote-splicing"); S(sDEFINE_SYNTAX, "define-syntax"); S(sIMPORT, "import"); S(sEXPORT, "export"); S(sDEFINE_LIBRARY, "define-library"); S(sIN_LIBRARY, "in-library"); S(sCOND_EXPAND, "cond-expand"); S(sAND, "and"); S(sOR, "or"); S(sELSE, "else"); S(sLIBRARY, "library"); S(sONLY, "only"); S(sRENAME, "rename"); S(sPREFIX, "prefix"); S(sEXCEPT, "except"); S(sCONS, "cons"); S(sCAR, "car"); S(sCDR, "cdr"); S(sNILP, "null?"); S(sSYMBOLP, "symbol?"); S(sPAIRP, "pair?"); S(sADD, "+"); S(sSUB, "-"); S(sMUL, "*"); S(sDIV, "/"); S(sMINUS, "minus"); S(sEQ, "="); S(sLT, "<"); S(sLE, "<="); S(sGT, ">"); S(sGE, ">="); S(sNOT, "not"); S(sREAD, "read"); S(sFILE, "file"); S(sCALL, "call"); S(sTAILCALL, "tail-call"); S(sGREF, "gref"); S(sLREF, "lref"); S(sCREF, "cref"); S(sRETURN, "return"); S(sCALL_WITH_VALUES, "call-with-values"); S(sTAILCALL_WITH_VALUES, "tailcall-with-values"); pic_gc_arena_restore(pic, ai); #define R(slot,name) pic->slot = pic_gensym(pic, pic_intern_cstr(pic, name)); R(rDEFINE, "define"); R(rLAMBDA, "lambda"); R(rIF, "if"); R(rBEGIN, "begin"); R(rSETBANG, "set!"); R(rQUOTE, "quote"); R(rDEFINE_SYNTAX, "define-syntax"); R(rIMPORT, "import"); R(rEXPORT, "export"); R(rDEFINE_LIBRARY, "define-library"); R(rIN_LIBRARY, "in-library"); R(rCOND_EXPAND, "cond-expand"); pic_gc_arena_restore(pic, ai); /* root tables */ pic->globals = pic_make_dict(pic); pic->macros = pic_make_dict(pic); /* root block */ pic->wind = pic_alloc(pic, sizeof(struct pic_winder)); pic->wind->prev = NULL; pic->wind->depth = 0; pic->wind->in = pic->wind->out = NULL; /* reader */ pic->reader = malloc(sizeof(struct pic_reader)); pic->reader->typecase = PIC_CASE_DEFAULT; pic->reader->trie = pic_make_trie(pic); xh_init_int(&pic->reader->labels, sizeof(pic_value)); /* init readers */ pic_init_reader(pic); /* standard libraries */ pic->PICRIN_BASE = pic_open_library(pic, pic_read_cstr(pic, "(picrin base)")); pic->PICRIN_USER = pic_open_library(pic, pic_read_cstr(pic, "(picrin user)")); pic->lib = pic->PICRIN_USER; /* standard I/O */ pic->xSTDIN = pic_make_standard_port(pic, xstdin, PIC_PORT_IN); pic->xSTDOUT = pic_make_standard_port(pic, xstdout, PIC_PORT_OUT); pic->xSTDERR = pic_make_standard_port(pic, xstderr, PIC_PORT_OUT); pic_gc_arena_restore(pic, ai); /* turn on GC */ pic->gc_enable = true; pic_init_core(pic); return pic; }
pic_state * pic_open(int argc, char *argv[], char **envp) { pic_value t; pic_state *pic; int ai; pic = (pic_state *)malloc(sizeof(pic_state)); /* command line */ pic->argc = argc; pic->argv = argv; pic->envp = envp; /* root block */ pic->blk = (struct pic_block *)malloc(sizeof(struct pic_block)); pic->blk->prev = NULL; pic->blk->depth = 0; pic->blk->in = pic->blk->out = NULL; pic->blk->refcnt = 1; /* prepare VM stack */ pic->stbase = pic->sp = (pic_value *)calloc(PIC_STACK_SIZE, sizeof(pic_value)); pic->stend = pic->stbase + PIC_STACK_SIZE; /* callinfo */ pic->cibase = pic->ci = (pic_callinfo *)calloc(PIC_STACK_SIZE, sizeof(pic_callinfo)); pic->ciend = pic->cibase + PIC_STACK_SIZE; /* exception handlers */ pic->rescue = (struct pic_proc **)calloc(PIC_RESCUE_SIZE, sizeof(struct pic_proc *)); pic->ridx = 0; pic->rlen = PIC_RESCUE_SIZE; /* memory heap */ pic->heap = (struct pic_heap *)calloc(1, sizeof(struct pic_heap)); init_heap(pic->heap); /* symbol table */ pic->sym_tbl = xh_new(); pic->sym_pool = (const char **)calloc(PIC_SYM_POOL_SIZE, sizeof(const char *)); pic->slen = 0; pic->scapa = pic->slen + PIC_SYM_POOL_SIZE; pic->uniq_sym_count = 0; /* global variables */ pic->global_tbl = xh_new(); pic->globals = (pic_value *)calloc(PIC_GLOBALS_SIZE, sizeof(pic_value)); pic->glen = 0; pic->gcapa = PIC_GLOBALS_SIZE; /* libraries */ pic->lib_tbl = pic_nil_value(); pic->lib = NULL; /* error handling */ pic->jmp = NULL; pic->errmsg = NULL; /* GC arena */ pic->arena_idx = 0; /* native stack marker */ pic->native_stack_start = &t; #define register_core_symbol(pic,slot,name) do { \ pic->slot = pic_intern_cstr(pic, name); \ } while (0) ai = pic_gc_arena_preserve(pic); register_core_symbol(pic, sDEFINE, "define"); register_core_symbol(pic, sLAMBDA, "lambda"); register_core_symbol(pic, sIF, "if"); register_core_symbol(pic, sBEGIN, "begin"); register_core_symbol(pic, sSETBANG, "set!"); register_core_symbol(pic, sQUOTE, "quote"); register_core_symbol(pic, sQUASIQUOTE, "quasiquote"); register_core_symbol(pic, sUNQUOTE, "unquote"); register_core_symbol(pic, sUNQUOTE_SPLICING, "unquote-splicing"); register_core_symbol(pic, sDEFINE_SYNTAX, "define-syntax"); register_core_symbol(pic, sDEFINE_MACRO, "define-macro"); register_core_symbol(pic, sDEFINE_LIBRARY, "define-library"); register_core_symbol(pic, sIMPORT, "import"); register_core_symbol(pic, sEXPORT, "export"); register_core_symbol(pic, sCONS, "cons"); register_core_symbol(pic, sCAR, "car"); register_core_symbol(pic, sCDR, "cdr"); register_core_symbol(pic, sNILP, "null?"); register_core_symbol(pic, sADD, "+"); register_core_symbol(pic, sSUB, "-"); register_core_symbol(pic, sMUL, "*"); register_core_symbol(pic, sDIV, "/"); register_core_symbol(pic, sMINUS, "minus"); register_core_symbol(pic, sEQ, "="); register_core_symbol(pic, sLT, "<"); register_core_symbol(pic, sLE, "<="); register_core_symbol(pic, sGT, ">"); register_core_symbol(pic, sGE, ">="); pic_gc_arena_restore(pic, ai); pic_init_core(pic); /* set library */ pic_make_library(pic, pic_parse(pic, "user")); pic_in_library(pic, pic_parse(pic, "user")); return pic; }
pic_state * pic_open(pic_allocf allocf, void *userdata) { pic_state *pic; pic = allocf(userdata, NULL, sizeof(pic_state)); if (! pic) { goto EXIT_PIC; } /* allocator */ pic->allocf = allocf; /* user data */ pic->userdata = userdata; /* context */ pic->default_cxt.ai = 0; pic->default_cxt.pc = NULL; pic->default_cxt.fp = NULL; pic->default_cxt.sp = NULL; pic->default_cxt.irep = NULL; pic->default_cxt.prev = NULL; pic->cxt = &pic->default_cxt; /* arena */ pic->arena = allocf(userdata, NULL, PIC_ARENA_SIZE * sizeof(struct object *)); pic->arena_size = PIC_ARENA_SIZE; pic->ai = 0; if (! pic->arena) { goto EXIT_ARENA; } /* turn off GC */ pic->gc_enable = false; /* memory heap */ pic->heap = pic_heap_open(pic); /* symbol table */ kh_init(oblist, &pic->oblist); /* global variables */ pic->globals = pic_make_dict(pic); /* features */ pic->features = pic_nil_value(pic); /* dynamic environment */ pic->dyn_env = pic_list(pic, 1, pic_make_weak(pic)); /* top continuation */ { static const code_t halt_code[] = { 0x00 }; struct irep *irep; struct proc *proc; irep = (struct irep *)pic_obj_alloc(pic, PIC_TYPE_IREP); irep->argc = 1; irep->flags = IREP_CODE_STATIC; irep->frame_size = 1; irep->irepc = 0; irep->objc = 0; irep->irep = NULL; irep->obj = NULL; irep->code = halt_code; irep->codec = sizeof halt_code / sizeof halt_code[0]; proc = (struct proc *)pic_obj_alloc(pic, PIC_TYPE_PROC_IREP); proc->u.irep = irep; proc->env = NULL; pic->halt = obj_value(pic, proc); } /* panic handler */ pic->panicf = NULL; /* turn on GC */ pic->gc_enable = true; pic_init_core(pic); pic_leave(pic, 0); /* empty arena */ return pic; EXIT_ARENA: allocf(userdata, pic, 0); EXIT_PIC: return NULL; }