From dfc2da108e226ca6c189c629025ba1a758f06437 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 21 Dec 2007 13:27:04 +0000 Subject: [PATCH] change --main to print its results, add scheme_detach_multiple_values svn: r8092 --- collects/scribblings/inside/eval.scrbl | 38 +++++++++++++------- collects/scribblings/reference/startup.scrbl | 8 +++-- src/mzscheme/cmdline.inc | 28 +++++++++++++-- src/mzscheme/include/mzscheme.exp | 1 + src/mzscheme/include/mzscheme3m.exp | 1 + src/mzscheme/include/mzwin.def | 1 + src/mzscheme/include/mzwin3m.def | 1 + src/mzscheme/src/eval.c | 2 +- src/mzscheme/src/fun.c | 8 +++++ src/mzscheme/src/schemef.h | 2 ++ src/mzscheme/src/schemex.h | 1 + src/mzscheme/src/schemex.inc | 1 + src/mzscheme/src/schemexm.h | 1 + 13 files changed, 74 insertions(+), 19 deletions(-) diff --git a/collects/scribblings/inside/eval.scrbl b/collects/scribblings/inside/eval.scrbl index 14bc141fc8..2350c91014 100644 --- a/collects/scribblings/inside/eval.scrbl +++ b/collects/scribblings/inside/eval.scrbl @@ -94,21 +94,30 @@ potentially return multiple values; all other evaluation and applications procedures return a single value or raise an exception. Multiple return values are represented by the -@cppi{scheme_multiple_values} ``value''. This quasi-value has the type -@cpp{Scheme_Object *}, but it is not a pointer or a fixnum. When the +@cppi{scheme_multiple_values} ``value.'' This quasi-value has the type +@cpp{Scheme_Object*}, but it is not a pointer or a fixnum. When the result of an evaluation or application is @cppi{scheme_multiple_values}, the number of actual values can be -obtained as @cppi{scheme_multiple_count} and the array of -@cpp{Scheme_Object*} values as @cppi{scheme_multiple_array}. If any -application or evaluation procedure is called, the -@cpp{scheme_multiple_count} and @cpp{scheme_multiple_array} variables -may be modified, but the array previously referenced by -@cpp{scheme_multiple_array} is never re-used and should never be -modified. +obtained as @cppi{scheme_multiple_count}, and the array of +@cpp{Scheme_Object*} values as @cppi{scheme_multiple_array}. (Both of +those identifiers are actually macros.) -The @cpp{scheme_multiple_count} and @cpp{scheme_multiple_array} -variables only contain meaningful values when -@cpp{scheme_multiple_values} is returned. +A garbage collection must not occur between the return of a +@cppi{scheme_multiple_values} ``value'' and the receipt of the values +through @cppi{scheme_multiple_count} @cppi{scheme_multiple_array}. +Furthermore, if @cpp{scheme_multiple_array} is to be used across a +potential garbage collection, then it must be specifically received by +calling @cpp{scheme_detach_multiple_array}; otherwise, a garbage +collection or further evaluation may change the content of the array. +Otherwise, if any application or evaluation procedure is called, the +@cpp{scheme_multiple_count} and @cpp{scheme_multiple_array} variables +may be modified (but the array previously referenced by +@cpp{scheme_multiple_array} is never re-used if +@cpp{scheme_detatch_multiple_array} is called). + +The @cpp{scheme_multiple_count} and +@cpp{scheme_multiple_array} variables only contain meaningful values +when @cpp{scheme_multiple_values} is returned. @; ---------------------------------------------------------------------- @@ -286,3 +295,8 @@ namespace.} Returns the given values together as multiple return values. Unless @var{n} is @cpp{1}, the result will always be @cpp{scheme_multiple_values}.} + +@function[(void scheme_detach_multiple_array + [Scheme_Object** args])]{ + +Called to receive multiple-value results; see @secref["multiple"].} diff --git a/collects/scribblings/reference/startup.scrbl b/collects/scribblings/reference/startup.scrbl index 3e17080d8f..dc792cb1f9 100644 --- a/collects/scribblings/reference/startup.scrbl +++ b/collects/scribblings/reference/startup.scrbl @@ -98,7 +98,8 @@ flags: @itemize{ @item{@FlagFirst{e} @nonterm{expr} or @DFlagFirst{eval} - @nonterm{expr} : @scheme[eval]s @nonterm{expr}.} + @nonterm{expr} : @scheme[eval]s @nonterm{expr}. The results of + the evaluation are printed via @scheme[current-print].} @item{@FlagFirst{f} @nonterm{file} or @DFlagFirst{load} @nonterm{file} : @scheme[load]s @nonterm{file}.} @@ -137,8 +138,9 @@ flags: @scheme[main] in the top-level environment. All of the command-line arguments that are not processed as options (i.e., the arguments put into - @scheme[current-command-line-args]) are passed as arguments to - @scheme[main].} + @scheme[current-command-line-arguments]) are passed as arguments to + @scheme[main]. The results of the call are printed via + @scheme[current-print].} }} diff --git a/src/mzscheme/cmdline.inc b/src/mzscheme/cmdline.inc index 8c2078dde1..c5ee7a07a1 100644 --- a/src/mzscheme/cmdline.inc +++ b/src/mzscheme/cmdline.inc @@ -292,7 +292,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) save = p->error_buf; p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { - Scheme_Object *e, *a[2], *d2s, *nsi, *idb, *b; + Scheme_Object *e, *a[2], *d2s, *nsi, *idb, *b, *cp; d2s = scheme_builtin_value("datum->syntax"); a[0] = scheme_make_false(); @@ -317,7 +317,29 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) e = scheme_make_pair(e, scheme_vector_to_list(fa->main_args)); e = scheme_datum_to_kernel_stx(e); - (void)scheme_eval_with_prompt(e, fa->global_env); + e = scheme_eval_multi_with_prompt(e, fa->global_env); + + if (SAME_OBJ(e, SCHEME_MULTIPLE_VALUES)) { + Scheme_Object **mv; + int cnt; + mv = p->ku.multiple.array; + cnt = p->ku.multiple.count; + scheme_detach_multple_array(mv); + e = scheme_null; + while (cnt--) { + e = scheme_make_pair(mv[cnt], e); + } + } else { + e = scheme_make_pair(e, scheme_make_null()); + } + + cp = scheme_get_param(scheme_current_config(), MZCONFIG_PRINT_HANDLER); + + while (!SCHEME_NULLP(e)) { + a[0] = SCHEME_CAR(e); + scheme_apply_multi(cp, 1, a); + e = SCHEME_CDR(e); + } } else { exit_val = 1; p->error_buf = save; @@ -1066,7 +1088,7 @@ static int run_from_cmd_line(int argc, char *_argv[], " -r , --script : Same as -f -N --\n" " -u , --require-script : Same as -t -N --\n" " -k : Load executable-embedded code from file offset to \n" - " -m, --main : Call `main' with command-line arguments\n" + " -m, --main : Call `main' with command-line arguments, print results\n" " Interaction options:\n" " -i, --repl : Run interactive read-eval-print loop; implies -v\n" # ifdef CMDLINE_STDIO_FLAG diff --git a/src/mzscheme/include/mzscheme.exp b/src/mzscheme/include/mzscheme.exp index 76ef47574b..cd8331e171 100644 --- a/src/mzscheme/include/mzscheme.exp +++ b/src/mzscheme/include/mzscheme.exp @@ -158,6 +158,7 @@ scheme_load_compiled_stx_string scheme_compiled_stx_symbol scheme_eval_compiled_sized_string scheme_eval_compiled_sized_string_with_magic +scheme_detach_multple_array GC_malloc GC_malloc_atomic GC_malloc_stubborn diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp index f928966583..ad23db8746 100644 --- a/src/mzscheme/include/mzscheme3m.exp +++ b/src/mzscheme/include/mzscheme3m.exp @@ -158,6 +158,7 @@ scheme_load_compiled_stx_string scheme_compiled_stx_symbol scheme_eval_compiled_sized_string scheme_eval_compiled_sized_string_with_magic +scheme_detach_multple_array GC_malloc GC_malloc_atomic GC_malloc_one_tagged diff --git a/src/mzscheme/include/mzwin.def b/src/mzscheme/include/mzwin.def index 0670b6beac..add58ef73f 100644 --- a/src/mzscheme/include/mzwin.def +++ b/src/mzscheme/include/mzwin.def @@ -150,6 +150,7 @@ EXPORTS scheme_compiled_stx_symbol scheme_eval_compiled_sized_string scheme_eval_compiled_sized_string_with_magic + scheme_detach_multple_array scheme_malloc_eternal scheme_end_stubborn_change scheme_calloc diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def index 924fb92a17..d25ca4a4a0 100644 --- a/src/mzscheme/include/mzwin3m.def +++ b/src/mzscheme/include/mzwin3m.def @@ -150,6 +150,7 @@ EXPORTS scheme_compiled_stx_symbol scheme_eval_compiled_sized_string scheme_eval_compiled_sized_string_with_magic + scheme_detach_multple_array GC_malloc GC_malloc_atomic GC_malloc_one_tagged diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 89582106f4..3e94629f43 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -7780,7 +7780,7 @@ top_introduce_stx(int argc, Scheme_Object **argv) Scheme_Object *scheme_datum_to_kernel_stx(Scheme_Object *e) { - scheme_datum_to_syntax(e, scheme_false, scheme_sys_wraps(NULL), 0, 0); + return scheme_datum_to_syntax(e, scheme_false, scheme_sys_wraps(NULL), 0, 0); } static Scheme_Object * diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index 1398b88898..d9e879ab04 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -3702,6 +3702,14 @@ Scheme_Object *scheme_values(int argc, Scheme_Object *argv[]) return SCHEME_MULTIPLE_VALUES; } +void scheme_detach_multple_array(Scheme_Object **values) +{ + Scheme_Thread *t = scheme_current_thread; + + if (SAME_OBJ(values, t->values_buffer)) + t->values_buffer = NULL; +} + /*========================================================================*/ /* continuations */ /*========================================================================*/ diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index e839ee55e9..1efa2ca8b7 100644 --- a/src/mzscheme/src/schemef.h +++ b/src/mzscheme/src/schemef.h @@ -319,6 +319,8 @@ MZ_EXTERN Scheme_Object *scheme_eval_compiled_sized_string_with_magic(const char Scheme_Object *magic_symbol, Scheme_Object *magic_val, int multi_ok); +MZ_EXTERN void scheme_detach_multple_array(Scheme_Object **a); + /*========================================================================*/ /* memory management */ /*========================================================================*/ diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h index c2128da7a9..8acd0b72f4 100644 --- a/src/mzscheme/src/schemex.h +++ b/src/mzscheme/src/schemex.h @@ -257,6 +257,7 @@ Scheme_Object *(*scheme_eval_compiled_sized_string)(const char *str, int len, Sc Scheme_Object *(*scheme_eval_compiled_sized_string_with_magic)(const char *str, int len, Scheme_Env *env, Scheme_Object *magic_symbol, Scheme_Object *magic_val, int multi_ok); +void (*scheme_detach_multple_array)(Scheme_Object **a); /*========================================================================*/ /* memory management */ /*========================================================================*/ diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc index 82e9f7b402..798dbaa20d 100644 --- a/src/mzscheme/src/schemex.inc +++ b/src/mzscheme/src/schemex.inc @@ -166,6 +166,7 @@ scheme_extension_table->scheme_compiled_stx_symbol = scheme_compiled_stx_symbol; scheme_extension_table->scheme_eval_compiled_sized_string = scheme_eval_compiled_sized_string; scheme_extension_table->scheme_eval_compiled_sized_string_with_magic = scheme_eval_compiled_sized_string_with_magic; + scheme_extension_table->scheme_detach_multple_array = scheme_detach_multple_array; #ifndef SCHEME_NO_GC # ifndef SCHEME_NO_GC_PROTO scheme_extension_table->GC_malloc = GC_malloc; diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h index e8fba70094..7688b9a5b9 100644 --- a/src/mzscheme/src/schemexm.h +++ b/src/mzscheme/src/schemexm.h @@ -166,6 +166,7 @@ #define scheme_compiled_stx_symbol (scheme_extension_table->scheme_compiled_stx_symbol) #define scheme_eval_compiled_sized_string (scheme_extension_table->scheme_eval_compiled_sized_string) #define scheme_eval_compiled_sized_string_with_magic (scheme_extension_table->scheme_eval_compiled_sized_string_with_magic) +#define scheme_detach_multple_array (scheme_extension_table->scheme_detach_multple_array) #ifndef SCHEME_NO_GC # ifndef SCHEME_NO_GC_PROTO #define GC_malloc (scheme_extension_table->GC_malloc)