Removed oldtop.scm since top is now nearly perfect.

scsh/oldtop.scm

@@ -1,133 +0,0 @@
-;;; Scsh top level
-;;; Copyright (c) 1993 by Olin Shivers.
-
-;;; Requires
-;;;   From BUILD: build-image
-;;;   From COMMAND: start-command-processor, user-context,
-;;;                 package-for-commands
-
-(define %internal-full-command-line '())
-(define %internal-command-line-arguments '())
-(define (command-line) (append %internal-command-line-arguments '()))
-
-(define scsh-major-version 0)
-(define scsh-minor-version 5)
-(define scsh-version-string "0.5.1")
-
-;;; A scsh starter takes the command line args, parses them, 
-;;; initialises the scsh system, and either starts up a repl loop
-;;; or executes the -s script.
-(define (make-scsh-starter)
-  (let ((env (environment-for-commands))
-	(context (user-context)))
-    (lambda (args)
-      (receive (script args) (parse-scsh-args args)
-	(set! command-line-arguments (append args '()))
-	(cond (script		;Batch
-	       (set! %internal-command-line-arguments
-		     (cons script args))
-	       (load-quietly1 script env)
-	       0)			; exit code
-
-	      (else		; Interactive
-	       (with-interaction-environment env
-	         (lambda ()
-		   (set-batch-mode?! #t)
-		   (set! %internal-command-line-arguments
-			 (cons "scsh" args))
-		   (start-command-processor ""
-					    context
-					    (lambda ()
-					      (display "Scsh ")
-					      (display scsh-version-string)
-					      (newline)
-					      ))))))))))
-
-;;; Make a different kind of starter. This one initialises the
-;;; scsh run time, then simply calls the user's program.
-;;;
-;;; It should take an arg to determine what kind of a condition
-;;; system you'd like in place. 
-
-(define (make-top-level main)
-  (lambda (args)
-    (set! %internal-full-command-line args)
-    (set! %internal-command-line-arguments (cons "" args))
-    (init-scsh #f #t)
-    (set! command-line-arguments (append args '()))
-    (main)
-    0))
-
-(define (repl)
-  (command-loop (lambda () (set-batch-mode?! #f))
-		#f))
-
-
-(define (bad-args arg-list)
-  (error "Bad argument list to scsh.
-Useage: scsh [<end-option> <arg1> ... <argn>]
-<end-option>: -s <script-file>
-              --  (Terminates option parsing)" arg-list))
-
-(define (parse-scsh-args arg-list)
-  (if (pair? arg-list)
-      (let ((arg1 (car arg-list))
-	    (rest (cdr arg-list)))
-	(cond ((string=? arg1 "-s")
-	       (if (pair? rest)
-		   (values (car rest) (cdr rest))
-		   (bad-args arg-list)))
-	      ((string=? arg1 "--") (values #f rest))
-	      (else (bad-args arg-list))))
-      (values #f '())))
-      
-
-;;; BUILD-IMAGE calls the starter after installing a fatal top-level
-;;; error handler. MAKE-SCSH-STARTER shadows it in the interactive case.
-
-(define (dump-scsh fname)
-  (build-scsh-image (make-scsh-starter) fname))
-
-(define (dump-scsh-program main fname)
-  (build-scsh-image main fname))
-
-;;; Hacked because s48's compiler's scanner insists on echoing the file name.
-
-(define (load-quietly1 fname package)
-  (call-with-input-file fname
-    (lambda (port)
-      (let loop ()
-	(let ((form (read port)))
-	  (if (not (eof-object? form))
-	      (begin (eval form package)
-		     (loop))))))))
-
-;;; Had to define these as the ones in s48's build.scm do not properly
-;;; initialise ERROR-OUTPUT-PORT to stderr -- this is a bug in the vm's
-;;; handoff to the very first Scheme form (it passes two ports -- not three).
-;;; Until Kelsey fixes these, we hack it with these replacements, which
-;;; invoke INIT-SCSH, which re-initialises the I/O system to be what
-;;; you wanted.
-
-(define (build-scsh-image start filename)
-  (let ((filename (translate filename)))
-    (display (string-append "Writing " filename) (command-output))
-    (newline (command-output))
-    (flush-the-symbol-table!)	;Gets restored at next use of string->symbol
-    (write-image filename
-		 (scsh-stand-alone-resumer start)
-		 "")
-    #t))
-
-(define (scsh-stand-alone-resumer start)
-  (usual-resumer  ;sets up exceptions, interrupts, and current input & output
-   (lambda (args)
-     (init-scsh #f #f)	; Whatever. Install scsh's I/O system.
-     (call-with-current-continuation
-       (lambda (halt)
-	 (set! command-line-arguments (append args '()))
-	 (set! %internal-full-command-line args)
-	 (set! %internal-command-line-arguments (cons "" args))	; WRONG
-	 (with-handler (simple-condition-handler halt (current-error-port))
-	   (lambda ()
-	     (start args))))))))