From: Arthur Gleckler Date: Fri, 23 Aug 1991 16:25:14 +0000 (+0000) Subject: Fix bug that caused init file to not be loaded if X-Git-Tag: 20090517-FFI~10319 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=41f0097db82da2804aa2187348bbb9802793a756;p=mit-scheme.git Fix bug that caused init file to not be loaded if GET-UNUSED-COMMAND-LINE returned no command line options. --- diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm index 1814a49aa..3c98c66fc 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.25 1991/08/23 01:27:06 arthur Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.26 1991/08/23 16:25:14 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -296,62 +296,63 @@ MIT in each case. |# (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)))) + (hook/process-command-line + (and (implemented-primitive-procedure? get-unused-command-line) + (get-unused-command-line)))) (define hook/process-command-line) (define (default/process-command-line unused-command-line) - (letrec ((unused-command-line-length (vector-length unused-command-line)) - (unused-for-each - (lambda (proc start end) - (if (< start end) - (begin (proc (vector-ref unused-command-line start)) - (unused-for-each proc (1+ start) end))))) - (find-first-dash - (lambda (index) - (let loop ((index index)) - (if (= index unused-command-line-length) - unused-command-line-length - (let ((first (vector-ref unused-command-line index))) - (cond ((zero? (string-length first)) - (loop (1+ index))) - ((char=? (string-ref first 0) #\-) - index) - (else (loop (1+ index)))))))))) - (let find-no-init-file-option ((index 0)) - (if (= index unused-command-line-length) - (load-init-file) - (or (string=? - "-no-init-file" - (string-downcase (vector-ref unused-command-line index))) - (find-no-init-file-option (1+ index))))) - (let process-next-option ((index 0) - (unhandled-options '())) - (if (= index unused-command-line-length) - (if (not (null? unhandled-options)) - (warn "Unhandled command line options:" - (reverse unhandled-options))) - (let ((option (string-downcase (vector-ref unused-command-line index)))) - (cond ((string=? "-no-init-file" option) - (process-next-option (1+ index) unhandled-options)) - ((string=? "-eval" option) - (let ((next-option (find-first-dash (1+ index)))) - (unused-for-each - (lambda (string) - (eval (with-input-from-string string read) - user-initial-environment)) - (1+ index) - next-option) - (process-next-option next-option unhandled-options))) - ((string=? "-load" option) - (let ((next-option (find-first-dash (1+ index)))) - (unused-for-each load (1+ index) next-option) - (process-next-option next-option unhandled-options))) - (else (process-next-option - (1+ index) - (cons (vector-ref unused-command-line index) - unhandled-options))))))))) \ No newline at end of file + (if unused-command-line + (letrec ((unused-command-line-length (vector-length unused-command-line)) + (unused-for-each + (lambda (proc start end) + (if (< start end) + (begin (proc (vector-ref unused-command-line start)) + (unused-for-each proc (1+ start) end))))) + (find-first-dash + (lambda (index) + (let loop ((index index)) + (if (= index unused-command-line-length) + unused-command-line-length + (let ((first (vector-ref unused-command-line index))) + (cond ((zero? (string-length first)) + (loop (1+ index))) + ((char=? (string-ref first 0) #\-) + index) + (else (loop (1+ index)))))))))) + (let find-no-init-file-option ((index 0)) + (if (= index unused-command-line-length) + (load-init-file) + (or (string=? + "-no-init-file" + (string-downcase (vector-ref unused-command-line index))) + (find-no-init-file-option (1+ index))))) + (let process-next-option ((index 0) + (unhandled-options '())) + (if (= index unused-command-line-length) + (if (not (null? unhandled-options)) + (warn "Unhandled command line options:" + (reverse unhandled-options))) + (let ((option + (string-downcase (vector-ref unused-command-line index)))) + (cond ((string=? "-no-init-file" option) + (process-next-option (1+ index) unhandled-options)) + ((string=? "-eval" option) + (let ((next-option (find-first-dash (1+ index)))) + (unused-for-each + (lambda (string) + (eval (with-input-from-string string read) + user-initial-environment)) + (1+ index) + next-option) + (process-next-option next-option unhandled-options))) + ((string=? "-load" option) + (let ((next-option (find-first-dash (1+ index)))) + (unused-for-each load (1+ index) next-option) + (process-next-option next-option unhandled-options))) + (else (process-next-option + (1+ index) + (cons (vector-ref unused-command-line index) + unhandled-options)))))))) + (load-init-file))) \ No newline at end of file diff --git a/v8/src/runtime/load.scm b/v8/src/runtime/load.scm index 1088bcf6a..8baa7eb33 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.25 1991/08/23 01:27:06 arthur Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.26 1991/08/23 16:25:14 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -296,62 +296,63 @@ MIT in each case. |# (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)))) + (hook/process-command-line + (and (implemented-primitive-procedure? get-unused-command-line) + (get-unused-command-line)))) (define hook/process-command-line) (define (default/process-command-line unused-command-line) - (letrec ((unused-command-line-length (vector-length unused-command-line)) - (unused-for-each - (lambda (proc start end) - (if (< start end) - (begin (proc (vector-ref unused-command-line start)) - (unused-for-each proc (1+ start) end))))) - (find-first-dash - (lambda (index) - (let loop ((index index)) - (if (= index unused-command-line-length) - unused-command-line-length - (let ((first (vector-ref unused-command-line index))) - (cond ((zero? (string-length first)) - (loop (1+ index))) - ((char=? (string-ref first 0) #\-) - index) - (else (loop (1+ index)))))))))) - (let find-no-init-file-option ((index 0)) - (if (= index unused-command-line-length) - (load-init-file) - (or (string=? - "-no-init-file" - (string-downcase (vector-ref unused-command-line index))) - (find-no-init-file-option (1+ index))))) - (let process-next-option ((index 0) - (unhandled-options '())) - (if (= index unused-command-line-length) - (if (not (null? unhandled-options)) - (warn "Unhandled command line options:" - (reverse unhandled-options))) - (let ((option (string-downcase (vector-ref unused-command-line index)))) - (cond ((string=? "-no-init-file" option) - (process-next-option (1+ index) unhandled-options)) - ((string=? "-eval" option) - (let ((next-option (find-first-dash (1+ index)))) - (unused-for-each - (lambda (string) - (eval (with-input-from-string string read) - user-initial-environment)) - (1+ index) - next-option) - (process-next-option next-option unhandled-options))) - ((string=? "-load" option) - (let ((next-option (find-first-dash (1+ index)))) - (unused-for-each load (1+ index) next-option) - (process-next-option next-option unhandled-options))) - (else (process-next-option - (1+ index) - (cons (vector-ref unused-command-line index) - unhandled-options))))))))) \ No newline at end of file + (if unused-command-line + (letrec ((unused-command-line-length (vector-length unused-command-line)) + (unused-for-each + (lambda (proc start end) + (if (< start end) + (begin (proc (vector-ref unused-command-line start)) + (unused-for-each proc (1+ start) end))))) + (find-first-dash + (lambda (index) + (let loop ((index index)) + (if (= index unused-command-line-length) + unused-command-line-length + (let ((first (vector-ref unused-command-line index))) + (cond ((zero? (string-length first)) + (loop (1+ index))) + ((char=? (string-ref first 0) #\-) + index) + (else (loop (1+ index)))))))))) + (let find-no-init-file-option ((index 0)) + (if (= index unused-command-line-length) + (load-init-file) + (or (string=? + "-no-init-file" + (string-downcase (vector-ref unused-command-line index))) + (find-no-init-file-option (1+ index))))) + (let process-next-option ((index 0) + (unhandled-options '())) + (if (= index unused-command-line-length) + (if (not (null? unhandled-options)) + (warn "Unhandled command line options:" + (reverse unhandled-options))) + (let ((option + (string-downcase (vector-ref unused-command-line index)))) + (cond ((string=? "-no-init-file" option) + (process-next-option (1+ index) unhandled-options)) + ((string=? "-eval" option) + (let ((next-option (find-first-dash (1+ index)))) + (unused-for-each + (lambda (string) + (eval (with-input-from-string string read) + user-initial-environment)) + (1+ index) + next-option) + (process-next-option next-option unhandled-options))) + ((string=? "-load" option) + (let ((next-option (find-first-dash (1+ index)))) + (unused-for-each load (1+ index) next-option) + (process-next-option next-option unhandled-options))) + (else (process-next-option + (1+ index) + (cons (vector-ref unused-command-line index) + unhandled-options)))))))) + (load-init-file))) \ No newline at end of file