scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

start scsh-toplevel by dump-scsh, scsh's init are not yet done

This commit is contained in:
marting 1999-09-23 00:43:13 +00:00
parent d3638eec28
commit dd7939ab1a
5 changed files with 113 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
scheme/interfaces.scm
View File

@ -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

13
scheme/more-interfaces.scm
View File

@ -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

31
scsh/scsh-package.scm
View File

@ -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)

25
scsh/startup.scm
View File

@ -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))))

86
scsh/top.scm
View File

@ -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 <struct> Open the structure in current package.
;;; -n <package> 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 <script> Specify script.
(define (repl)
; (lambda () (set-batch-mode?! #f))
(command-loop #f))
(command-loop (lambda () (set-batch-mode?! #f))
#f))