/**********************************************************************
 
	Copyright (C) 2003 Hirohisa MORI <joshua@nichibun.ac.jp>
 
	This program is free software; you can redistribute it 
	and/or modify it under the terms of the GLOBALBASE 
	Library General Public License (G-LGPL) as published by 

	http://www.globalbase.org/
 
	This program is distributed in the hope that it will be 
	useful, but WITHOUT ANY WARRANTY; without even the 
	implied warranty of MERCHANTABILITY or FITNESS FOR A 
	PARTICULAR PURPOSE.

**********************************************************************/



#include	"xl.h"
#include	"task.h"
#include	"lock_level.h"
#include	"utils.h"

XL_SEXP * gb_rem();
XL_SEXP * gb_and();
XL_SEXP * gb_or();
XL_SEXP * gb_xor();
XL_SEXP * gb_not();
XL_SEXP * gb_And();
XL_SEXP * gb_Or();
XL_SEXP * gb_Xor();
XL_SEXP * gb_Not();
XL_SEXP * gb_Neq();
XL_SEXP * gb_lt();
XL_SEXP * gb_geq();
XL_SEXP * gb_gt();

extern SEM gb_env_lock;
extern SEM parse_lock,lex_lock;
L_CHAR * gblisp_site;
XL_SEXP *(*break_check)();

int
default_error_handler(int type,XL_SEXP * s)
{
	return 0;
}

XLISP_ENV *	gblisp_top_env0;
XLISP_ENV *	gblisp_top_env1;

int (*error_handler)() = default_error_handler;

/*
void
set_gblisp_site(L_CHAR * s,int port)
{
	gblisp_site = ll_copy_str(s,1482);
}
*/

void
init_gblisp()
{
	gb_env_lock = new_lock(LL_ENV);
	lex_lock = new_lock(LL_LEX);
	init_parse_system();

	gblisp_top_env0 = new_env(0);
	gblisp_top_env1 = new_env(gblisp_top_env0);
	set_env(gblisp_top_env0,l_string(std_cm,"list"),
		get_func_prim(gb_list,FO_NORMAL,0,2,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"/"),
		get_func_prim(gb_div,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"div"),
		get_func_prim(gb_div,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"rem"),
		get_func_prim(gb_rem,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,
		l_string(std_cm,"define"),
		get_func_prim(gb_define,FO_NORMAL,0,3,-1));
	set_env(gblisp_top_env0,
		l_string(std_cm,"while"),
		get_func_prim(gb_while,FO_NORMAL,0,2,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"="),
		get_func_prim(gb_equ,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"Equ"),
		get_func_prim(gb_equ,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"Neq"),
		get_func_prim(gb_Neq,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"<="),
		get_func_prim(gb_leq,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"Lteq"),
		get_func_prim(gb_leq,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"Lt"),
		get_func_prim(gb_lt,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"<"),
		get_func_prim(gb_lt,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,">="),
		get_func_prim(gb_geq,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"Gteq"),
		get_func_prim(gb_geq,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"Gt"),
		get_func_prim(gb_gt,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,">"),
		get_func_prim(gb_gt,FO_APPLICATIVE,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"+"),
		get_func_prim(gb_add,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"add"),
		get_func_prim(gb_add,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"*"),
		get_func_prim(gb_mul,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"mul"),
		get_func_prim(gb_mul,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"-"),
		get_func_prim(gb_sub,FO_APPLICATIVE,0,2,3));
	set_env(gblisp_top_env0,l_string(std_cm,"sub"),
		get_func_prim(gb_sub,FO_APPLICATIVE,0,2,3));
	set_env(gblisp_top_env0,l_string(std_cm,"set"),
		get_func_prim(gb_set,FO_NORMAL,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"quote"),
		get_func_prim(gb_quote_long,FO_NORMAL,0,2,2));
	set_env(gblisp_top_env0,l_string(std_cm,"if"),
		get_func_prim(gb_if,FO_NORMAL,0,4,4));
	set_env(gblisp_top_env0,l_string(std_cm,"append"),
		get_func_prim(gb_append,FO_NORMAL,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"cons"),
		get_func_prim(gb_cons,FO_NORMAL,0,3,3));
	set_env(gblisp_top_env0,l_string(std_cm,"let"),
		get_func_prim(gb_let,FO_NORMAL,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"cdr"),
		get_func_prim(gb_cdr,FO_APPLICATIVE,0,2,2));
	set_env(gblisp_top_env0,l_string(std_cm,"car"),
		get_func_prim(gb_car,FO_APPLICATIVE,0,2,2));

	set_env(gblisp_top_env1,l_string(std_cm,"save"),
		get_func_prim(gb_save,FO_NORMAL,0,6,6));
	set_env(gblisp_top_env1,l_string(std_cm,"shell"),
		get_func_prim(gb_shell,FO_NORMAL,0,2,-1));
	set_env(gblisp_top_env1,l_string(std_cm,"wait"),
		get_func_prim(gb_wait,FO_NORMAL,0,2,2));
	set_env(gblisp_top_env1,l_string(std_cm,"lambda"),
		get_func_prim(gb_lambda,FO_NORMAL,0,2,-1));

	set_env(gblisp_top_env0,l_string(std_cm,"and"),
		get_func_prim(gb_and,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"or"),
		get_func_prim(gb_or,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"xor"),
		get_func_prim(gb_xor,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"not"),
		get_func_prim(gb_not,FO_APPLICATIVE,0,2,2));

	set_env(gblisp_top_env0,l_string(std_cm,"And"),
		get_func_prim(gb_And,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"Or"),
		get_func_prim(gb_Or,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"Xor"),
		get_func_prim(gb_Xor,FO_APPLICATIVE,0,3,-1));
	set_env(gblisp_top_env0,l_string(std_cm,"Not"),
		get_func_prim(gb_Not,FO_APPLICATIVE,0,2,2));

}
