From dd7939ab1a7c1801dea2c6f8b65021895ee8ce82 Mon Sep 17 00:00:00 2001 From: marting Date: Thu, 23 Sep 1999 00:43:13 +0000 Subject: [PATCH] start scsh-toplevel by dump-scsh, scsh's init are not yet done --- scheme/interfaces.scm | 4 +- scheme/more-interfaces.scm | 13 +++++- scsh/scsh-package.scm | 31 ++++++++++---- scsh/startup.scm | 25 ++++++++--- scsh/top.scm | 86 +++++++++++++++++++++++++------------- 5 files changed, 113 insertions(+), 46 deletions(-) diff --git a/scheme/interfaces.scm b/scheme/interfaces.scm index 6e616b5..c1bfd15 100644 --- a/scheme/interfaces.scm +++ b/scheme/interfaces.scm @@ -594,7 +594,7 @@ (define-interface interrupts-interface (export initialize-interrupts! ;init.scm - with-interrupts ;JMG: For scsh +; with-interrupts ;JMG: no longer for scsh all-interrupts no-interrupts ;reset-timer-interrupts! @@ -611,7 +611,7 @@ call-after-gc! call-before-heap-overflow! (interrupt :syntax) - interrupt-handlers-vector ;JMG: blatantly for scsh. +; interrupt-handlers-vector ;JMG: blatantly for scsh. )) (define-interface writing-interface diff --git a/scheme/more-interfaces.scm b/scheme/more-interfaces.scm index eb840c7..1596699 100644 --- a/scheme/more-interfaces.scm +++ b/scheme/more-interfaces.scm @@ -13,7 +13,10 @@ command-continuation command-threads command-loop + real-command-loop ;JMG: for scsh + command-loop-condition-handler + command-level-condition command-processor error-form ;foo @@ -31,7 +34,9 @@ run-sentinels set-focus-object! showing-focus-object ;inspect - with-new-session ;scsh + + with-new-session ;JMG: for scsh + start-command-processor restart-command-processor value->expression ;foo @@ -64,7 +69,11 @@ user-context-accessor user-context-modifier - start-new-session ;JMG: for scsh + start-new-session ;JMG: 4 for scsh + really-push-command-level + ignore-further-interrupts + notify-on-interrupts + push-command-levels? command-input diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm index 5725fe7..eac2e7d 100644 --- a/scsh/scsh-package.scm +++ b/scsh/scsh-package.scm @@ -78,6 +78,11 @@ $current-error-port) (open ports i/o)) +(define-structure signal-handler signal-handler-interface + (open scheme + scsh + scsh-level-0) + (files (scsh sighandlers))) ;;; The scsh-level-0 package is for implementation convenience. ;;; The scsh startup and top-level modules need access to scsh ;;; procedures, but they export procedures that are themselves @@ -125,7 +130,7 @@ (open ;scheme define-foreign-syntax defrec-package receiving ascii enumerated - externals + external-calls ;JMG new FFI structure-refs cig-aux receiving @@ -161,10 +166,12 @@ interrupts ; signal handler code scheme - + + i/o i/o-internal channels channel-i/o + low-channels code-vectors threads threads-internal locks placeholders primitives @@ -203,8 +210,8 @@ pty ; New in release 0.4. sighandlers ; New in release 0.5. scsh - re - rdelim + ; re + ; rdelim )) (define-structure defrec-package (export (define-record :syntax)) @@ -233,6 +240,7 @@ command-processor ; command-output filenames ; translate usual-resumer ; usual-resumer + fluids-internal ; JMG: get-dynamic-env scsh-utilities interrupts primitives @@ -249,6 +257,10 @@ evaluation extended-ports interfaces + + fluids-internal ; JMG: get-dynamic-env + handle ; JMG: with-handler + interrupts i/o package-commands-internal @@ -298,11 +310,12 @@ (define-structure scsh (compound-interface (interface-of scsh-level-0) (interface-of scsh-startup-package) - scsh-regexp-interface - scsh-field-reader-interface ; new in 0.3 + ;JMG scsh-regexp-interface + ;JMG scsh-field-reader-interface ; new in 0.3 ; scsh-dbm-interface (export repl) - awk-interface) + ; JMG:awk-interface + ) (open structure-refs scsh-level-0 @@ -310,8 +323,8 @@ scsh-regexp-package scsh-startup-package ; dbm - awk-package - field-reader-package +; awk-package +; field-reader-package scheme) (access scsh-top-package) diff --git a/scsh/startup.scm b/scsh/startup.scm index d1fe051..c4f505b 100644 --- a/scsh/startup.scm +++ b/scsh/startup.scm @@ -8,6 +8,8 @@ (define (make-scsh-starter) (let ((context (user-context))) (lambda (args) + (display "off we go") + (display context) (parse-switches-and-execute args context)))) (define holding-interrupt-handlers #f) @@ -27,7 +29,8 @@ (display (string-append "Writing " filename) (command-output)) (newline (command-output)) (set! holding-interrupt-handlers (copy-vector (interrupt-handlers-vector))) - (flush-the-symbol-table!) ;Gets restored at next use of string->symbol + ;JMG: it is set to # in the vm, so I omit it now +;;;(flush-the-symbol-table!) ;Gets restored at next use of string->symbol (write-image filename (scsh-stand-alone-resumer start) "Scsh 0.6") @@ -38,14 +41,21 @@ ;;; to decide whether to do the scsh-var inits quietly or with warnings. (define (dump-scsh fname) - (really-dump-scsh-program (make-scsh-starter) fname)) + (really-dump-scsh-program + (make-scsh-starter) +; (display "hiii") +; (let ((d (make-scsh-starter))) +; (display "hiiiiiiiiiiii") +; d) + + fname)) ;;; Init the scsh run-time's vars quietly before running the program. ;;; This is what we export to the user for his programs. (define (dump-scsh-program start filename) (really-dump-scsh-program (lambda (args) - (init-scsh-vars #t) ; Do it quietly. + (init-scsh-vars #f) ; Do it quietly. (start args)) filename)) @@ -53,17 +63,22 @@ (define (scsh-stand-alone-resumer start) (usual-resumer ;sets up exceptions, interrupts, and current input & output (lambda (args) ; VM gives us our args, but not our program. - (init-scsh-hindbrain #t) ; Whatever. Relink & install scsh's I/O system. + ;JMG (init-scsh-hindbrain #t) ; Whatever. Relink & install scsh's I/O system. (call-with-current-continuation (lambda (halt) + (display "start" (current-error-port)) (set! %vm-prog-args (cons "scsh" args)) ; WRONG -- use image. + (display "start1" (current-error-port)) (set-command-line-args! %vm-prog-args) + (display "start2" (current-error-port)) (let ((len (vector-length holding-interrupt-handlers))) (do ((i 0 (+ i 1))) - ((eq? i len)) + ((eq? i (- len 1))) (set-interrupt-handler i (vector-ref holding-interrupt-handlers i)))) + (display "start3" (current-error-port)) (set! holding-interrupt-handlers #f) + (display "start4" (current-error-port)) (with-handler (simple-condition-handler halt (current-error-port)) (lambda () (let ((exit-val (start (command-line)))) diff --git a/scsh/top.scm b/scsh/top.scm index 5bd3cb2..2b7787b 100644 --- a/scsh/top.scm +++ b/scsh/top.scm @@ -1,5 +1,5 @@ ;;; The scsh argv switch parser. -;;; Copyright (c) 1995 by Olin Shivers. +;;; Copyright (c) 1995 by Olin Shivers. See file COPYING. ;;; Imports: ;;; COMMAND-PROCESSOR: set-batch-mode?! command-loop @@ -28,11 +28,6 @@ (cond ((structure? s) s) (else (error "not a structure" s struct-name))))) -(define load-quietly - (lambda args - (let ((p (car args))) - (apply (if (string? p) load load-port) args)))) - ;;; The switches: ;;; -o Open the structure in current package. ;;; -n Create new package, make it current package. @@ -176,8 +171,7 @@ (let ((struct-name (cdr switch)) (cp (config-package))) ;; Should not be necessary to do this ensure-loaded, but it is. - (silently (lambda () - (ensure-loaded (get-struct cp struct-name)))) + (really-ensure-loaded #f (get-struct cp struct-name)) (package-open! (interaction-environment) (lambda () (get-struct cp struct-name))) ; (format #t "Opened ~s~%" struct-name) @@ -200,7 +194,7 @@ (let ((pack (structure-package struct))) ; (format #t "package ~s~%" pack) (set-interaction-environment! pack) - (silently (lambda () (ensure-loaded struct))) + (really-ensure-loaded #f struct) ; (format #t "Switched to ~s~%" pack) (lp switches script-loaded?)))) @@ -220,14 +214,39 @@ (define (parse-switches-and-execute all-args context) (receive (switches term-switch term-val top-entry args) (parse-scsh-args (cdr all-args)) - ((with-new-session context ; "Log in" user. - (current-input-port) (current-output-port) + (begin + + (display "hey there.." (current-error-port)) +; (display context (current-error-port)) + ; (display (config-package)) + ; (display (user-environment)) + ((with-handler ; taken from command.scm + command-loop-condition-handler + (lambda () + (notify-on-interrupts (current-thread)) + (start-new-session context + (current-input-port) + (current-output-port) (current-error-port) args - term-switch ; batch? (or interactive?) - (lambda () - (with-interaction-environment (user-environment) - (lambda () + term-switch) + (display "bye" (current-error-port)) + (display (config-package) (current-error-port)) + (display "ups" (current-error-port)) + + ; (let ((commands usual-commands) +; (build-in built-in-structures) +; (meta-structs more-structures)) +; (call-with-values +; (lambda () +; (make-user-envs commands build-in meta-structs)) +; (lambda (env init-thunk) + (with-interaction-environment + (user-environment) + (display "okay, but now ?" (current-error-port)) + (begin + ;(with-interaction-environment (user-environment) ; <-- from CONTEXT. + (begin ;; Have to do these before calling DO-SWITCHES, because actions ;; performed while processing the switches may use these guys. (set-command-line-args! @@ -249,15 +268,26 @@ (interaction-environment))) (cond ((not term-switch) ; -- interactive -; (interrupt-before-heap-overflow!) -; (command-loop #f)) -; Let's try this - (start-command-processor - #f context - (lambda () - (display "Scsh ") - (display scsh-version-string) - (newline)))) + (display "scsh is up" (current-error-port)) + + ; (interrupt-before-heap-overflow!) + (let ((repl-data #f) ;no condition + (repl-thunk real-command-loop) + (start-thunk (lambda () + (display "i am start thunk")))) + (let ((thunk (really-push-command-level repl-thunk + repl-data + (get-dynamic-env) + '()))) + (ignore-further-interrupts) + (thunk)))) + ; + (command-loop + ;(lambda () + ; (display "Scsh ") + ; (display scsh-version-string) + ; (newline)) + ; #f)) ;; COMMAND-LOOP returns a continuation when it exits, ;; which gets invoked outside the W-N-S above. I.e., ;; we "log out" and start over. @@ -276,7 +306,7 @@ ;; Otherwise, the script executed as it loaded, ;; so we're done. (else (exit 0)) - ))))))))) + )))))))))))) (define (read-exactly-one-sexp-from-string s) @@ -287,7 +317,7 @@ (define (bad-arg . msg) - (with-current-output-port (current-error-port) + (with-current-output-port (error-output-port) (for-each (lambda (x) (display x) (write-char #\space)) msg) (newline) (display "Useage: scsh [meta-arg] [switch ..] [end-option arg ...] @@ -315,5 +345,5 @@ end-option: -s