fix boot_call and the invoke code object to handle multiple values

original commit: 7fd080903d96a1ef9ab79780bf73aa1619f33894

LOG

@@ -988,4 +988,6 @@
 - add generate-procedure-source-information
     cmacros.ss, compile.ss, cpnanopass.ss, inspect.ss,
     primdata.ss, prims.ss, misc.ms,
-    system.stex, release_notes.tex
+    system.stex, release_notes.stex
+- fix boot_call and the invoke code object to handle multiple values
+    scheme.c, cpnanopass.ss, 7.ms, release_notes.stex, system.stex

c/scheme.c

@@ -340,7 +340,7 @@ static ptr boot_call(tc, p, n) ptr tc; ptr p; INT n; {
             p = Svoid;
             break;
         default:
-            p = S_get_scheme_arg(tc, 0);
+            p = S_get_scheme_arg(tc, 1);
             break;
     }
     return p;

csug/system.stex

@@ -3541,8 +3541,8 @@ If the current caf\'e is the original caf\'e, or if \scheme{exit}
 is called from a script, \scheme{exit} exits from Scheme.
 In this case, the exit code for the Scheme process is 0 if
 no arguments were supplied or if the first argument is void,
-the value of the first argument
+the value of the first argument cast to a C int if
-if it is a 32-bit exact integer, and -1 otherwise.
+it is an exact integer of the host machine's bit width, and 1 otherwise.
 
 %----------------------------------------------------------------------------
 \entryheader

mats/7.ms

@@ -3619,6 +3619,35 @@ evaluating module init
   (error? ; unexpected return from handler
     (parameterize ([exit-handler values])
       (exit 5)))
+  (begin
+    (define (exit-code expr)
+      (if (windows?)
+          (system (format "echo ~s | ~a -q" expr (patch-exec-path *scheme*)))
+          (system (format "echo '~s' | ~a -q" expr *scheme*))))
+    #t)
+  (eqv? (exit-code '(exit)) 0)
+  (eqv? (exit-code '(exit 15)) 15)
+  (eqv? (exit-code '(exit 0)) 0)
+  (eqv? (exit-code '(exit 24 7)) 24)
+  (eqv? (exit-code '(exit 0 1 2)) 0)
+  (eqv? (exit-code '(exit 3.14)) 1)
+  (eqv? (exit-code '(exit 9.8 3.14)) 1)
+  (begin
+    (with-output-to-file "testfile-exit.ss"
+      (lambda ()
+        (for-each pretty-print
+          '((import (scheme))
+            (apply exit (map string->number (command-line-arguments))))))
+      'replace)
+    #t)
+  (eqv? (system (format "~a --script testfile-exit.ss" (patch-exec-path *scheme*))) 0)
+  (eqv? (system (format "~a --script testfile-exit.ss 5" (patch-exec-path *scheme*))) 5)
+  (eqv? (system (format "~a --script testfile-exit.ss 0 1 2" (patch-exec-path *scheme*))) 0)
+  (eqv? (system (format "~a --script testfile-exit.ss 3 4 5" (patch-exec-path *scheme*))) 3)
+  (eqv? (system (format "~a --program testfile-exit.ss" (patch-exec-path *scheme*))) 0)
+  (eqv? (system (format "~a --program testfile-exit.ss 2" (patch-exec-path *scheme*))) 2)
+  (eqv? (system (format "~a --program testfile-exit.ss 0 1 2" (patch-exec-path *scheme*))) 0)
+  (eqv? (system (format "~a --program testfile-exit.ss 6 7 8" (patch-exec-path *scheme*))) 6)
  )
 
 (mat abort

release_notes/release_notes.stex

@@ -1592,6 +1592,11 @@ in fasl files does not generally make sense.
 %-----------------------------------------------------------------------------
 \section{Bug Fixes}\label{section:bugfixes}
 
+\subsection{Incorrect return code when \protect\scheme{exit} is called with multiple arguments}
+
+A bug in the implementation of the default exit handler with multiple
+values has been fixed.
+
 \subsection{Boot files containing compiled library code fail to load}
 
 Compiled library code may now appear within fasl objects loaded during

s/cpnanopass.ss

@@ -12269,13 +12269,16 @@
                     (label ,Lret)
                     (rp-header ,Lmvreturn ,(* 2 (constant ptr-bytes)) 1) ; cchain is live at sfp[ptr-bytes]
                     (set! ,(ref-reg %ac1) (immediate 1)) ; single-value as expected
-                    (label ,Lexit)
                     ,(save-scheme-state
                        (in %ac0 %ac1)
                        (out %cp %xp %yp %ts %td scheme-args extra-regs))
+                    (label ,Lexit)
                     (inline ,(make-info-c-simple-call #f (lookup-c-entry Sreturn)) ,%c-simple-call)
                     (label ,Lmvreturn)
                     (set! ,(ref-reg %ac1) ,%ac0)
+                    ,(save-scheme-state
+                       (in %ac0 %ac1 scheme-args)
+                       (out %cp %xp %yp %ts %td extra-regs))
                     (goto ,Lexit))))]
            [else ($oops who "unrecognized hand-coded name ~s" sym)])]))