First version of libscsh.

Makefile.in

@@ -131,13 +131,14 @@ SCSHOBJS = \
 	scsh/time1.o \
 	scsh/tty1.o \
 	scsh/userinfo1.o \
-	scsh/sighandlers1.o
+	scsh/sighandlers1.o \
+	scsh/libscsh.o
 
 SCSH_INITIALIZERS = s48_init_syslog s48_init_posix_regexp \
 	s48_init_userinfo s48_init_sighandlers \
 	s48_init_syscalls s48_init_network s48_init_flock \
 	s48_init_dirstuff s48_init_time s48_init_tty \
-	s48_init_cig
+	s48_init_cig s48_init_libscsh
 
 UNIX_OBJS = c/unix/misc.o c/unix/io.o c/unix/fd-io.o c/unix/event.o
 
@@ -779,6 +780,7 @@ SCHEME =scsh/awk.scm \
 	scsh/glob.scm \
 	scsh/dot-locking.scm \
 	scsh/here.scm \
+	scsh/libscsh.scm \
 	scsh/machine/bufpol.scm \
 	scsh/machine/errno.scm \
 	scsh/machine/fdflags.scm \

scheme/vm/interp.scm

@@ -639,6 +639,7 @@
 	  ((and (false? cont)
 		(fixnum? *val*))			  ; VM returns here
 	   (set! s48-*callback-return-stack-block* false) ; not from a callback
+	   (reset-stack-pointer false)                    ; for libscsh
 	   (extract-fixnum *val*))
 	  (else
 	   (set-current-continuation! false)

scsh/libscsh.c

@@ -0,0 +1,46 @@
+/* This file is part of scsh.
+ * Copyright (c) 2002 by Martin Gasbichler and Richard Kelsey. See file COPYING.
+ */
+
+#include <stdarg.h>
+#include <stdio.h>
+#include "scheme48.h"
+#include "libscsh.h"
+
+s48_value s48_command_binding;
+s48_value s48_to_string_binding;
+
+s48_value s48_command (char* fmt, ...)
+{
+  va_list ap;
+  va_start (ap, fmt);
+  return s48_vcommand (fmt, ap);
+}
+
+s48_value s48_vcommand (char* fmt, va_list ap)
+{
+  char* command;
+  s48_value ret;
+
+ if (vasprintf(&command, fmt, ap) == -1){
+   fprintf(stderr, "error in vasprintf\n");
+   exit(1);
+   }
+  fprintf (stderr,"The command is: %s\n", command);
+  S48_SHARED_BINDING_CHECK (s48_command_binding);
+
+  ret = s48_call_scheme (S48_SHARED_BINDING_REF (s48_command_binding),
+			 1,
+  			 s48_enter_string (command));
+
+  free (command);
+  va_end (ap);
+  return ret;
+}
+
+
+s48_value s48_init_libscsh(void)
+{
+  s48_command_binding = s48_get_imported_binding ("s48-command");
+  return S48_UNSPECIFIC;
+}

scsh/libscsh.h

@@ -0,0 +1,15 @@
+/* This file is part of scsh.
+ * Copyright (c) 2002 by Martin Gasbichler. See file COPYING.
+ * Interface to libscsh
+ */
+
+#ifndef LIBSCSH_H
+#define LIBSCSH_H
+#include <stdarg.h>
+
+
+s48_value s48_command (char* format, ...);
+s48_value s48_vcommand (char* format, va_list ap);
+s48_value s48_init_libscsh(void);
+
+#endif

scsh/libscsh.scm

@@ -0,0 +1,63 @@
+;;; 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)
+

scsh/scsh-package.scm

@@ -481,3 +481,17 @@
 	bitwise)
   (files syslog))
 
+(define-structure libscsh (export startup
+				  save-user-envs!)
+  (open scheme
+ 	external-calls 
+ 	(subset i/o (current-error-port))
+ 	(subset extended-ports (make-string-input-port))
+ 	(subset handle (with-handler))
+ 	(subset escapes (with-continuation))
+	(subset environments (with-interaction-environment))
+ 	(subset package-commands-internal (user-environment))
+ 	(subset command-levels (user-context start-new-session))
+ 	(subset command-processor (user-command-environment))
+	(subset scsh-startup-package (dump-scsh-program)))
+  (files libscsh))