;;; This file is part of scsh.
;;; Copyright (c) 2002 by Martin Gasbichler and Richard Kelsey.
;;; See file COPYING.

(define (return-from-vm n)
  (with-continuation (if #t #f) (lambda () n)))

(define *user-context*)

;; must be called from a running command processor
(define (save-user-envs!)
  (set! *user-context* (user-context)))

(define (startup args)
  (start-new-session *user-context*
		     (current-input-port)
		     (current-output-port)
		     (current-error-port)
		     args
		     #t) ;batch?
  (with-interaction-environment
   (user-environment)
   (lambda ()
     (return-from-vm 0))))

(define (s48-command command-string)
  (let* ((in (make-string-input-port command-string))
	 (s-exp (read in)))
    (if (and (not (eof-object? s-exp))
	     (eof-object? (read in)))
	(call-with-values
	 (lambda ()
	   (call-with-current-continuation
	    (lambda (k)
	      (with-handler
	       (lambda (cond more)
		 (display "error is "(current-error-port))
		 (display cond (current-error-port))
		 (newline (current-error-port))
		 (k cond))
	       (lambda ()
		 (eval s-exp (user-command-environment)))))))
	 (lambda args
	   (cond ((null? args) 
		  (display "null as result" 
			   (current-error-port)))
		 ((null? (cdr args))
		  (display "evaluated:" (current-error-port))
		  (display (car args)(current-error-port))
		  (newline (current-error-port))
		  (car args))
		 (else
		  (display "multiple return values in s48-command" 
			   (current-error-port))
		  ))))
	(display "s48-command got not exactly one s-exp" 
		 (current-error-port)))))

(define (dump-libscsh-image filename)
  (dump-scsh-program startup filename))

(define-exported-binding "s48-command" s48-command)