change --main to print its results, add scheme_detach_multiple_values

svn: r8092

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"].}

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].}
 
  }}
 

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 <file>, --script <file> : Same as -f <file> -N <file> --\n" 
 	 "  -u <file>, --require-script <file> : Same as -t <file> -N <file> --\n" 
 	 "  -k <n> <m> : Load executable-embedded code from file offset <n> to <m>\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

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

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

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

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

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 *

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                              */
 /*========================================================================*/

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                            */
 /*========================================================================*/

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                            */
 /*========================================================================*/

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;

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)