From: Arthur Gleckler Date: Fri, 3 May 1991 17:54:29 +0000 (+0000) Subject: Move command-line-processing code from (RUNTIME SAVE/RESTORE) package X-Git-Tag: 20090517-FFI~10693 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a4ce6357311d9ced29471757dca86a805fe91c82;p=mit-scheme.git Move command-line-processing code from (RUNTIME SAVE/RESTORE) package to (RUNTIME LOAD) package. Change INITIALIZE-PACKAGE! so that Scheme initialization file is loaded before command line is processed. This allows initialization file to add command-line options. --- diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm index 301dacde2..9f8f63dc4 100644 --- a/v7/src/runtime/load.scm +++ b/v7/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.21 1991/04/15 20:47:37 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.22 1991/05/03 17:54:29 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -38,13 +38,17 @@ MIT in each case. |# (declare (usual-integrations)) (define (initialize-package!) + (set! hook/process-command-line default/process-command-line) (set! load-noisily? false) (set! load/loading? false) (set! load/suppress-loading-message? false) (set! load/default-types '("com" "bin" "scm")) (set! load/default-find-pathname-with-type search-types-in-order) (set! fasload/default-types '("com" "bin")) - (add-event-receiver! event:after-restart load-init-file)) + (add-event-receiver! event:after-restart + (lambda () + (load-init-file) + (process-command-line)))) (define load-noisily?) (define load/loading?) @@ -287,4 +291,20 @@ MIT in each case. |# (write value) (loop (stream-car stream) (stream-cdr stream))) value)) - unspecific)) \ No newline at end of file + unspecific)) + +(define-primitives + (get-unused-command-line 0)) + +(define (process-command-line) + (let ((unused-command-line + (and (implemented-primitive-procedure? get-unused-command-line) + (get-unused-command-line)))) + (if unused-command-line + (hook/process-command-line unused-command-line)))) + +(define hook/process-command-line) + +(define (default/process-command-line unused-command-line) + (if (positive? (vector-length unused-command-line)) + (warn "unused command-line arguments" unused-command-line))) \ No newline at end of file diff --git a/v7/src/runtime/savres.scm b/v7/src/runtime/savres.scm index f9cec06e1..00fbe3ebc 100644 --- a/v7/src/runtime/savres.scm +++ b/v7/src/runtime/savres.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/savres.scm,v 14.17 1990/11/15 23:45:22 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/savres.scm,v 14.18 1991/05/03 17:54:09 arthur Exp $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -51,9 +51,7 @@ MIT in each case. |# (define (initialize-package!) (set! disk-save (setup-image disk-save/kernel)) - (set! dump-world (setup-image dump-world/kernel)) - (set! hook/process-command-line default/process-command-line) - (add-event-receiver! event:after-restart process-command-line)) + (set! dump-world (setup-image dump-world/kernel))) (define disk-save) (define dump-world) @@ -87,22 +85,6 @@ MIT in each case. |# (else (event-distributor/invoke! event:after-restart) true))))))) - -(define-primitives - (get-unused-command-line 0)) - -(define (process-command-line) - (let ((unused-command-line - (and (implemented-primitive-procedure? get-unused-command-line) - (get-unused-command-line)))) - (if unused-command-line - (hook/process-command-line unused-command-line)))) - -(define hook/process-command-line) - -(define (default/process-command-line unused-command-line) - (if (positive? (vector-length unused-command-line)) - (warn "unused command-line arguments" unused-command-line))) (define (disk-save/kernel filename after-suspend after-restore) ((without-interrupts diff --git a/v8/src/runtime/load.scm b/v8/src/runtime/load.scm index 09c8beab4..acbbc6f7f 100644 --- a/v8/src/runtime/load.scm +++ b/v8/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.21 1991/04/15 20:47:37 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.22 1991/05/03 17:54:29 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -38,13 +38,17 @@ MIT in each case. |# (declare (usual-integrations)) (define (initialize-package!) + (set! hook/process-command-line default/process-command-line) (set! load-noisily? false) (set! load/loading? false) (set! load/suppress-loading-message? false) (set! load/default-types '("com" "bin" "scm")) (set! load/default-find-pathname-with-type search-types-in-order) (set! fasload/default-types '("com" "bin")) - (add-event-receiver! event:after-restart load-init-file)) + (add-event-receiver! event:after-restart + (lambda () + (load-init-file) + (process-command-line)))) (define load-noisily?) (define load/loading?) @@ -287,4 +291,20 @@ MIT in each case. |# (write value) (loop (stream-car stream) (stream-cdr stream))) value)) - unspecific)) \ No newline at end of file + unspecific)) + +(define-primitives + (get-unused-command-line 0)) + +(define (process-command-line) + (let ((unused-command-line + (and (implemented-primitive-procedure? get-unused-command-line) + (get-unused-command-line)))) + (if unused-command-line + (hook/process-command-line unused-command-line)))) + +(define hook/process-command-line) + +(define (default/process-command-line unused-command-line) + (if (positive? (vector-length unused-command-line)) + (warn "unused command-line arguments" unused-command-line))) \ No newline at end of file