commit 8c21f6f4a5f6f0864713439f87393739f968a216
parent 5f6d26e873e70f178694158a4e7d89846e005be7
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 24 Nov 2011 21:36:02 -0300
Removed the old script support.
Diffstat:
9 files changed, 7 insertions(+), 306 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -33,7 +33,7 @@ PLATS= generic mingw posix
KRN_A= libklisp.a
CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kwrite.o kstate.o kmem.o kerror.o kauxlib.o kenvironment.o \
- kcontinuation.o koperative.o kapplicative.o keval.o krepl.o kscript.o \
+ kcontinuation.o koperative.o kapplicative.o keval.o krepl.o \
kencapsulation.o kpromise.o kport.o kinteger.o krational.o \
kreal.o ktable.o kgc.o imath.o imrat.o kbytevector.o kvector.o \
kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \
@@ -213,7 +213,7 @@ kgpairs_lists.o: kgpairs_lists.c kstate.h klimits.h klisp.h kobject.h \
kgports.o: kgports.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kport.h kstring.h kbytevector.h kenvironment.h \
kapplicative.h koperative.h kcontinuation.h kpair.h kgc.h kerror.h \
- ksymbol.h kread.h kwrite.h kscript.h kghelpers.h kgports.h \
+ ksymbol.h kread.h kwrite.h kghelpers.h kgports.h \
kgcontinuations.h kgcontrol.h kgkd_vars.h
kgpromises.o: kgpromises.c kstate.h klimits.h klisp.h kobject.h \
klispconf.h ktoken.h kmem.h kpromise.h kpair.h kgc.h kapplicative.h \
@@ -227,7 +227,7 @@ kground.o: kground.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
kgenvironments.h kgenv_mut.h kgcombiners.h kgcontinuations.h \
kgencapsulations.h kgpromises.h kgkd_vars.h kgks_vars.h kgnumbers.h \
kgstrings.h kgchars.h kgports.h kgbytevectors.h kgvectors.h kgsystem.h \
- kgerrors.h kgffi.h ktable.h keval.h krepl.h kscript.h
+ kgerrors.h kgffi.h ktable.h keval.h krepl.h
kgstrings.o: kgstrings.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
ktoken.h kmem.h kapplicative.h koperative.h kcontinuation.h kerror.h \
kpair.h kgc.h ksymbol.h kstring.h kghelpers.h kenvironment.h kgchars.h \
@@ -250,7 +250,7 @@ klisp.o: klisp.c klimits.h klisp.h kobject.h klispconf.h kstate.h \
ktoken.h kmem.h kauxlib.h kstring.h kcontinuation.h koperative.h \
kenvironment.h kport.h kread.h kwrite.h kerror.h kpair.h kgc.h \
kgcontinuations.h kghelpers.h kapplicative.h ksymbol.h kgcontrol.h \
- kscript.h krepl.h
+ krepl.h
kmem.o: kmem.c klisp.h kobject.h klimits.h klispconf.h kstate.h ktoken.h \
kmem.h kerror.h kpair.h kgc.h
kobject.o: kobject.c kobject.h klimits.h klisp.h klispconf.h
@@ -273,14 +273,10 @@ krepl.o: krepl.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
ktoken.h kmem.h kcontinuation.h kenvironment.h kerror.h kpair.h kgc.h \
kread.h kwrite.h kstring.h krepl.h ksymbol.h kport.h kgerrors.h \
kghelpers.h kapplicative.h koperative.h ktable.h kgcontinuations.h
-kscript.o: kscript.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
- ktoken.h kmem.h kcontinuation.h kenvironment.h kerror.h kpair.h kgc.h \
- kread.h kwrite.h kstring.h krepl.h kscript.h ksymbol.h kport.h \
- kgcontrol.h kghelpers.h kapplicative.h koperative.h kgerrors.h ktable.h
kstate.o: kstate.c klisp.h kobject.h klimits.h klispconf.h kstate.h \
ktoken.h kmem.h kstring.h kpair.h kgc.h keval.h koperative.h \
kapplicative.h kcontinuation.h kenvironment.h kground.h krepl.h \
- kscript.h ksymbol.h kport.h ktable.h kbytevector.h kvector.h \
+ ksymbol.h kport.h ktable.h kbytevector.h kvector.h \
kgpairs_lists.h kghelpers.h kerror.h kgerrors.h
kstring.o: kstring.c kstring.h kobject.h klimits.h klisp.h klispconf.h \
kstate.h ktoken.h kmem.h kgc.h
diff --git a/src/kgports.c b/src/kgports.c
@@ -27,8 +27,6 @@
#include "kwrite.h"
#include "kpair.h"
-#include "kscript.h"
-
#include "kghelpers.h"
#include "kgports.h"
#include "kgcontinuations.h" /* for guards */
diff --git a/src/kground.c b/src/kground.c
@@ -49,7 +49,6 @@
#include "kstring.h"
#include "keval.h"
#include "krepl.h"
-#include "kscript.h"
/* for init_cont_names */
#define add_cont_name(K_, t_, c_, n_) \
@@ -74,10 +73,6 @@ void kinit_cont_names(klisp_State *K)
add_cont_name(K, t, do_repl_eval, "repl-eval");
add_cont_name(K, t, do_repl_loop, "repl-loop");
- /* SCRIPT, root-continuation & error-continuation */
- add_cont_name(K, t, do_script_exit, "script-exit");
- add_cont_name(K, t, do_script_error, "script-report-error");
-
/* GROUND ENV */
add_cont_name(K, t, do_eval_ls, "eval-list");
add_cont_name(K, t, do_combine, "eval-combine");
diff --git a/src/kgsystem.c b/src/kgsystem.c
@@ -235,8 +235,8 @@ void get_environment_variables(klisp_State *K)
avoiding taking extra params in main */
/* I think it's defined in unistd, but it needs to have __USE_GNU
defined. The correct way to do that would be to define _GNU_SOURCE
- before including any system files... That's not good for an
- embeddable interpreter... */
+ before including any system files... That's not so good for an
+ embeddable interpreter, but it could be done in the makefile I guess */
extern char **environ;
/* Helper for get-environment-variables */
diff --git a/src/klisp.c b/src/klisp.c
@@ -35,7 +35,6 @@
#include "kghelpers.h" /* for do_return_value */
#include "kgcontinuations.h" /* for do_pass_value */
#include "kgcontrol.h" /* for do_seq */
-#include "kscript.h"
#include "krepl.h"
/* TODO update dependencies in makefile */
diff --git a/src/kscript.c b/src/kscript.c
@@ -1,254 +0,0 @@
-/*
-** kscript.c
-** klisp noninteractive script execution
-** See Copyright Notice in klisp.h
-*/
-#include <stdio.h>
-#include <setjmp.h>
-
-#include "klisp.h"
-#include "kstate.h"
-#include "kobject.h"
-#include "kcontinuation.h"
-#include "kenvironment.h"
-#include "kerror.h"
-#include "kread.h"
-#include "kwrite.h"
-#include "kstring.h"
-#include "krepl.h"
-#include "kscript.h"
-#include "ksymbol.h"
-#include "kport.h"
-#include "kpair.h"
-#include "kgcontrol.h"
-#include "kgerrors.h"
-/* for names */
-#include "ktable.h"
-
-/* Push (v) in GC roots and return (v). */
-static inline TValue krooted_tvs_pass(klisp_State *K, TValue v)
-{
- krooted_tvs_push(K, v);
- return v;
-}
-
-#if KTRACK_SI
-static inline TValue krooted_tvs_pass_si(klisp_State *K, TValue v, TValue si)
-{
- krooted_tvs_push(K, v);
- kset_source_info(K, v, si);
- return v;
-}
-#endif
-
-/* the exit continuation, it exits the loop */
-void do_script_exit(klisp_State *K)
-{
- TValue *xparams = K->next_xparams;
- TValue obj = K->next_value;
- klisp_assert(ttisnil(K->next_env));
- UNUSED(xparams);
-
- /* save exit code */
-
- switch(ttype(obj)) {
- case K_TINERT:
- K->script_exit_code = 0;
- break;
- case K_TFIXINT:
- K->script_exit_code = (int) ivalue(obj);
- break;
- default:
- K->script_exit_code = KSCRIPT_DEFAULT_ERROR_EXIT_CODE;
- /* TODO: print error message here ? */
- break;
- }
-
- /* force the loop to terminate */
- K->next_func = NULL;
- return;
-}
-
-
-/* the underlying function of the error cont */
-void do_script_error(klisp_State *K)
-{
- TValue *xparams = K->next_xparams;
- TValue obj = K->next_value;
- klisp_assert(ttisnil(K->next_env));
- /*
- ** xparams[0]: dynamic environment
- */
- UNUSED(xparams);
- /* FOR NOW used only for irritant list */
- TValue port = kcdr(K->kd_error_port_key);
- klisp_assert(kfport_file(port) == stderr);
-
- /* TEMP: obj should be an error obj */
- if (ttiserror(obj)) {
- Error *err_obj = tv2error(obj);
- TValue who = err_obj->who;
- char *who_str;
- /* TEMP? */
- if (ttiscontinuation(who))
- who = tv2cont(who)->comb;
-
- if (ttisstring(who)) {
- who_str = kstring_buf(who);
-#if KTRACK_NAMES
- } else if (khas_name(who)) {
- TValue name = kget_name(K, who);
- who_str = ksymbol_buf(name);
-#endif
- } else {
- who_str = "?";
- }
- char *msg = kstring_buf(err_obj->msg);
- fprintf(stderr, "\n*ERROR*: \n");
- fprintf(stderr, "%s: %s", who_str, msg);
-
- krooted_tvs_push(K, obj);
-
- /* Msg + irritants */
- /* TODO move to a new function */
- if (!ttisnil(err_obj->irritants)) {
- fprintf(stderr, ": ");
- kwrite_display_to_port(K, port, err_obj->irritants, false);
- }
- kwrite_newline_to_port(K, port);
-
-#if KTRACK_NAMES
-#if KTRACK_SI
- /* Location */
- /* TODO move to a new function */
- /* MAYBE: remove */
- if (khas_name(who) || khas_si(who)) {
- fprintf(stderr, "Location: ");
- kwrite_display_to_port(K, port, who, false);
- kwrite_newline_to_port(K, port);
- }
-
- /* Backtrace */
- /* TODO move to a new function */
- TValue tv_cont = err_obj->cont;
- fprintf(stderr, "Backtrace: \n");
- while(ttiscontinuation(tv_cont)) {
- kwrite_display_to_port(K, port, tv_cont, false);
- kwrite_newline_to_port(K, port);
- Continuation *cont = tv2cont(tv_cont);
- tv_cont = cont->parent;
- }
- /* add extra newline at the end */
- kwrite_newline_to_port(K, port);
-#endif
-#endif
- krooted_tvs_pop(K);
- } else {
- fprintf(stderr, "\n*ERROR*: not an error object passed to "
- "error continuation");
- }
-
- /* Save the exit code to be returned from interpreter
- main(). Terminate the interpreter loop. */
-
- K->script_exit_code = KSCRIPT_DEFAULT_ERROR_EXIT_CODE;
- K->next_func = NULL;
-}
-
-/* convert C style argc-argv pair to list of strings */
-static TValue argv2value(klisp_State *K, int argc, char *argv[])
-{
- TValue dummy = kcons_g(K, false, KINERT, KNIL);
- krooted_tvs_push(K, dummy);
- TValue tail = dummy;
- for (int i = 0; i < argc; i++) {
- TValue next_car = kstring_new_b_imm(K, argv[i]);
- krooted_tvs_push(K, next_car);
- TValue np = kcons_g(K, false, next_car, KNIL);
- krooted_tvs_pop(K);
- kset_cdr_unsafe(K, tail, np);
- tail = np;
- }
- krooted_tvs_pop(K);
- return kcdr(dummy);
-}
-
-/* loader_body(K, ARGV, DENV) returns the value
- *
- * ((load (car ARGV))
- * ($if ($binds? DENV main) (main ARGV) #inert)
- *
- */
-static TValue loader_body(klisp_State *K, TValue argv, TValue denv)
-{
- int32_t rooted_tvs_mark = K->rooted_tvs_top;
-# define S(z) (krooted_tvs_pass(K, ksymbol_new(K, (z), KNIL)))
-# define C(car, cdr) (krooted_tvs_pass(K, kcons_g(K, false, (car), (cdr))))
-# define L(n, ...) (krooted_tvs_pass(K, klist_g(K, false, (n), __VA_ARGS__)))
- TValue main_sym = S("main");
- TValue script_name = krooted_tvs_pass(K, kcar(argv));
- TValue body =
- L(2, L(2, S("load"), script_name),
- L(4, S("$if"), L(3, S("$binds?"), denv, main_sym),
- L(2, main_sym, C(S("list"), argv)),
- KINERT));
-# undef S
-# undef L
- K->rooted_tvs_top = rooted_tvs_mark;
- return body;
-}
-
-/* call this to init the noninteractive mode */
-
-void kinit_script(klisp_State *K, int argc, char *argv[])
-{
-# define R(z) (krooted_tvs_pass(K, (z)))
-# define G(z, sym) \
- do { TValue symbol = ksymbol_new(K, (sym), KNIL); \
- krooted_tvs_push(K, symbol); \
- kadd_binding(K, K->ground_env, symbol, (z)); \
- krooted_tvs_pop(K); \
- } while (0)
-
-#if KTRACK_SI
- TValue str = R(kstring_new_b_imm(K, __FILE__));
- TValue tail = R(kcons(K, i2tv(__LINE__), i2tv(0)));
- TValue si = kcons(K, str, tail);
- krooted_tvs_pop(K);
- krooted_tvs_pop(K);
- krooted_tvs_push(K, si);
-# define RSI(z) (krooted_tvs_pass_si(K, (z), si))
-#else
-# define RSI(z) R(z)
-#endif
-
- TValue std_env = RSI(kmake_environment(K, K->ground_env));
- TValue root_cont = RSI(kmake_continuation(K, KNIL, do_script_exit, 0));
- TValue error_cont = RSI(kmake_continuation(K, root_cont, do_script_error, 1, std_env));
- G(root_cont, "root-continuation");
- G(error_cont, "error-continuation");
- K->root_cont = root_cont;
- K->error_cont = error_cont;
- krooted_tvs_pop(K);
- krooted_tvs_pop(K);
-
- /* Create error continuation hierarchy. */
- kinit_error_hierarchy(K);
-
- TValue argv_value = RSI(argv2value(K, argc, argv));
- TValue loader = RSI(loader_body(K, argv_value, std_env));
- TValue loader_cont = RSI(kmake_continuation(K, root_cont, do_seq, 2, loader, std_env));
- kset_cc(K, loader_cont);
- krooted_tvs_pop(K);
- krooted_tvs_pop(K);
- krooted_tvs_pop(K);
- krooted_tvs_pop(K);
-#if KTRACK_SI
- krooted_tvs_pop(K);
-#endif
- kapply_cc(K, KINERT);
-
-#undef R
-#undef RSI
-#undef G
-}
diff --git a/src/kscript.h b/src/kscript.h
@@ -1,25 +0,0 @@
-/*
-** krepl.h
-** klisp noninteractive script execution
-** See Copyright Notice in klisp.h
-*/
-
-#ifndef kscript_h
-#define kscript_h
-
-#include <stdio.h>
-#include "klisp.h"
-#include "kstate.h"
-#include "kobject.h"
-
-void kinit_script(klisp_State *K, int argc, char *argv[]);
-
-/* continuation functions */
-void do_script_exit(klisp_State *K);
-void do_script_error(klisp_State *K);
-
-/* default exit code in case of error according to SRFI-22 */
-
-#define KSCRIPT_DEFAULT_ERROR_EXIT_CODE 70
-
-#endif
diff --git a/src/kstate.c b/src/kstate.c
@@ -30,7 +30,6 @@
#include "kenvironment.h"
#include "kground.h"
#include "krepl.h"
-#include "kscript.h"
#include "ksymbol.h"
#include "kstring.h"
#include "kport.h"
@@ -196,9 +195,6 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/* initialize writer */
K->write_displayp = false; /* set on each call to write */
- /* initialize script */
- K->script_exit_code = KSCRIPT_DEFAULT_ERROR_EXIT_CODE;
-
/* initialize temp stack */
K->ssize = KS_ISSIZE;
K->stop = 0; /* stack is empty */
diff --git a/src/kstate.h b/src/kstate.h
@@ -151,10 +151,6 @@ struct klisp_State {
/* writer */
bool write_displayp;
- /* script */
- /* REFACTOR rename to exit_code */
- int script_exit_code;
-
/* auxiliary stack */
int32_t ssize; /* total size of array */
int32_t stop; /* top of the stack (all elements are below this index) */
