2013-10-10 03:15:41 -04:00
|
|
|
#include <stdlib.h>
|
|
|
|
|
|
|
|
#include "picrin.h"
|
2013-10-13 02:14:15 -04:00
|
|
|
#include "picrin/gc.h"
|
2013-10-15 08:53:45 -04:00
|
|
|
#include "picrin/proc.h"
|
2013-10-22 09:22:35 -04:00
|
|
|
#include "xhash/xhash.h"
|
2013-10-11 04:36:51 -04:00
|
|
|
|
2013-10-15 08:14:33 -04:00
|
|
|
void pic_init_core(pic_state *);
|
|
|
|
|
2013-10-10 03:15:41 -04:00
|
|
|
pic_state *
|
2013-10-20 22:51:02 -04:00
|
|
|
pic_open(int argc, char *argv[], char **envp)
|
2013-10-10 03:15:41 -04:00
|
|
|
{
|
2013-11-09 00:14:25 -05:00
|
|
|
pic_value t;
|
|
|
|
|
2013-10-10 03:15:41 -04:00
|
|
|
pic_state *pic;
|
2013-10-20 22:44:23 -04:00
|
|
|
int ai;
|
2013-10-10 03:15:41 -04:00
|
|
|
|
2013-10-11 04:36:51 -04:00
|
|
|
pic = (pic_state *)malloc(sizeof(pic_state));
|
2013-10-11 11:20:53 -04:00
|
|
|
|
2013-10-20 22:51:02 -04:00
|
|
|
/* command line */
|
|
|
|
pic->argc = argc;
|
|
|
|
pic->argv = argv;
|
|
|
|
pic->envp = envp;
|
|
|
|
|
2013-11-11 04:04:21 -05:00
|
|
|
/* 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;
|
2013-11-14 21:51:58 -05:00
|
|
|
pic->blk->refcnt = 1;
|
2013-11-11 04:04:21 -05:00
|
|
|
|
2013-10-11 11:20:53 -04:00
|
|
|
/* prepare VM stack */
|
2013-11-22 06:28:09 -05:00
|
|
|
pic->stbase = pic->sp = (pic_value *)calloc(PIC_STACK_SIZE, sizeof(pic_value));
|
2013-10-15 10:28:23 -04:00
|
|
|
pic->stend = pic->stbase + PIC_STACK_SIZE;
|
2013-10-11 11:20:53 -04:00
|
|
|
|
2013-10-15 10:29:34 -04:00
|
|
|
/* callinfo */
|
2013-11-22 06:28:09 -05:00
|
|
|
pic->cibase = pic->ci = (pic_callinfo *)calloc(PIC_STACK_SIZE, sizeof(pic_callinfo));
|
2013-11-09 00:11:54 -05:00
|
|
|
pic->ciend = pic->cibase + PIC_STACK_SIZE;
|
2013-10-15 10:29:34 -04:00
|
|
|
|
2013-11-17 02:02:58 -05:00
|
|
|
/* exception handlers */
|
2013-11-22 06:28:09 -05:00
|
|
|
pic->rescue = (struct pic_proc **)calloc(PIC_RESCUE_SIZE, sizeof(struct pic_proc *));
|
2013-11-17 02:02:58 -05:00
|
|
|
pic->ridx = 0;
|
|
|
|
pic->rlen = PIC_RESCUE_SIZE;
|
|
|
|
|
2013-10-13 02:14:15 -04:00
|
|
|
/* memory heap */
|
2013-11-22 10:19:31 -05:00
|
|
|
pic->heap = (struct pic_heap *)calloc(1, sizeof(struct pic_heap));
|
|
|
|
init_heap(pic->heap);
|
2013-10-13 02:14:15 -04:00
|
|
|
|
2013-10-20 01:05:35 -04:00
|
|
|
/* symbol table */
|
2013-10-28 13:11:31 -04:00
|
|
|
pic->sym_tbl = xh_new();
|
2013-11-22 06:28:09 -05:00
|
|
|
pic->sym_pool = (const char **)calloc(PIC_SYM_POOL_SIZE, sizeof(const char *));
|
2013-10-28 13:11:31 -04:00
|
|
|
pic->slen = 0;
|
|
|
|
pic->scapa = pic->slen + PIC_SYM_POOL_SIZE;
|
2013-11-26 02:38:39 -05:00
|
|
|
pic->uniq_sym_count = 0;
|
2013-10-20 01:05:35 -04:00
|
|
|
|
2013-10-15 22:53:25 -04:00
|
|
|
/* irep */
|
2013-11-22 06:28:09 -05:00
|
|
|
pic->irep = (struct pic_irep **)calloc(PIC_IREP_SIZE, sizeof(struct pic_irep *));
|
2013-10-15 22:53:25 -04:00
|
|
|
pic->ilen = 0;
|
|
|
|
pic->icapa = PIC_IREP_SIZE;
|
|
|
|
|
2013-10-17 11:15:15 -04:00
|
|
|
/* globals */
|
2013-10-22 09:22:35 -04:00
|
|
|
pic->global_tbl = xh_new();
|
2013-11-22 06:28:09 -05:00
|
|
|
pic->globals = (pic_value *)calloc(PIC_GLOBALS_SIZE, sizeof(pic_value));
|
2013-10-17 11:15:15 -04:00
|
|
|
pic->glen = 0;
|
|
|
|
pic->gcapa = PIC_GLOBALS_SIZE;
|
2013-11-22 06:28:09 -05:00
|
|
|
pic->macros = (struct pic_proc **)calloc(PIC_MACROS_SIZE, sizeof(struct pic_proc *));
|
2013-10-30 03:37:43 -04:00
|
|
|
pic->mlen = 0;
|
|
|
|
pic->mcapa = PIC_MACROS_SIZE;
|
2013-10-17 11:15:15 -04:00
|
|
|
|
2013-10-20 20:29:56 -04:00
|
|
|
/* pool */
|
2013-11-22 06:28:09 -05:00
|
|
|
pic->pool = (pic_value *)calloc(PIC_POOL_SIZE, sizeof(pic_value));
|
2013-10-20 20:29:56 -04:00
|
|
|
pic->plen = 0;
|
|
|
|
pic->pcapa = PIC_POOL_SIZE;
|
|
|
|
|
2013-10-20 05:17:12 -04:00
|
|
|
/* error handling */
|
|
|
|
pic->jmp = NULL;
|
|
|
|
pic->errmsg = NULL;
|
|
|
|
|
2013-10-13 04:02:29 -04:00
|
|
|
/* GC arena */
|
|
|
|
pic->arena_idx = 0;
|
|
|
|
|
2013-11-09 00:14:25 -05:00
|
|
|
/* native stack marker */
|
|
|
|
pic->native_stack_start = &t;
|
|
|
|
|
2013-10-20 22:44:23 -04:00
|
|
|
ai = pic_gc_arena_preserve(pic);
|
2013-10-14 05:28:52 -04:00
|
|
|
pic->sDEFINE = pic_intern_cstr(pic, "define");
|
2013-10-15 22:32:30 -04:00
|
|
|
pic->sLAMBDA = pic_intern_cstr(pic, "lambda");
|
2013-10-16 04:42:47 -04:00
|
|
|
pic->sIF = pic_intern_cstr(pic, "if");
|
2013-10-17 04:54:28 -04:00
|
|
|
pic->sBEGIN = pic_intern_cstr(pic, "begin");
|
2013-10-23 14:14:32 -04:00
|
|
|
pic->sSETBANG = pic_intern_cstr(pic, "set!");
|
2013-10-20 20:29:56 -04:00
|
|
|
pic->sQUOTE = pic_intern_cstr(pic, "quote");
|
2013-10-22 23:39:48 -04:00
|
|
|
pic->sQUASIQUOTE = pic_intern_cstr(pic, "quasiquote");
|
|
|
|
pic->sUNQUOTE = pic_intern_cstr(pic, "unquote");
|
|
|
|
pic->sUNQUOTE_SPLICING = pic_intern_cstr(pic, "unquote-splicing");
|
2013-10-30 03:37:43 -04:00
|
|
|
pic->sDEFINE_SYNTAX = pic_intern_cstr(pic, "define-syntax");
|
|
|
|
pic->sDEFINE_MACRO = pic_intern_cstr(pic, "define-macro");
|
2013-10-14 05:28:52 -04:00
|
|
|
pic->sCONS = pic_intern_cstr(pic, "cons");
|
2013-10-19 14:48:06 -04:00
|
|
|
pic->sCAR = pic_intern_cstr(pic, "car");
|
|
|
|
pic->sCDR = pic_intern_cstr(pic, "cdr");
|
2013-10-19 14:53:02 -04:00
|
|
|
pic->sNILP = pic_intern_cstr(pic, "null?");
|
2013-10-15 08:29:07 -04:00
|
|
|
pic->sADD = pic_intern_cstr(pic, "+");
|
|
|
|
pic->sSUB = pic_intern_cstr(pic, "-");
|
|
|
|
pic->sMUL = pic_intern_cstr(pic, "*");
|
|
|
|
pic->sDIV = pic_intern_cstr(pic, "/");
|
2013-10-24 08:10:13 -04:00
|
|
|
pic->sEQ = pic_intern_cstr(pic, "=");
|
|
|
|
pic->sLT = pic_intern_cstr(pic, "<");
|
|
|
|
pic->sLE = pic_intern_cstr(pic, "<=");
|
|
|
|
pic->sGT = pic_intern_cstr(pic, ">");
|
|
|
|
pic->sGE = pic_intern_cstr(pic, ">=");
|
2013-10-20 22:44:23 -04:00
|
|
|
pic_gc_arena_restore(pic, ai);
|
2013-10-15 08:14:33 -04:00
|
|
|
|
2013-10-22 09:22:35 -04:00
|
|
|
pic_init_core(pic);
|
|
|
|
|
2013-10-10 03:15:41 -04:00
|
|
|
return pic;
|
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
pic_close(pic_state *pic)
|
|
|
|
{
|
|
|
|
free(pic);
|
|
|
|
}
|