diff --git a/c/scheme.c b/c/scheme.c index 036b4b4ada..049e68f183 100644 --- a/c/scheme.c +++ b/c/scheme.c @@ -1,12 +1,12 @@ /* scheme.c * Copyright 1984-2016 Cisco Systems, Inc. - * + * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. * You may obtain a copy of the License at - * + * * http://www.apache.org/licenses/LICENSE-2.0 - * + * * Unless required by applicable law or agreed to in writing, software * distributed under the License is distributed on an "AS IS" BASIS, * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. @@ -275,7 +275,7 @@ static void idiot_checks() { oops = 1; } } - + if (sizeof(bucket_pointer_list) != sizeof(bucket_list)) { /* gc repurposes bucket_lists for bucket_pointer lists, so they'd better have the same size */ fprintf(stderr, "bucket_pointer_list and bucket_list have different sizes\n"); @@ -370,7 +370,7 @@ void S_generic_invoke(tc, code) ptr tc; ptr code; { } __except(GetExceptionCode() == EXCEPTION_ACCESS_VIOLATION ? EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) - { + { if (S_pants_down) S_error_abort("nonrecoverable invalid memory reference"); else @@ -545,7 +545,7 @@ static IBOOL find_boot(name, ext, errorp) const char *name, *ext; IBOOL errorp; if (S_fixedpathp(name)) { if (strlen(name) >= PATH_MAX) { - fprintf(stderr, "boot-file path is to long %s\n", name); + fprintf(stderr, "boot-file path is too long %s\n", name); S_abnormal_exit(); } @@ -566,10 +566,10 @@ static IBOOL find_boot(name, ext, errorp) const char *name, *ext; IBOOL errorp; if (gzgetc(file) != fasl_type_header || gzgetc(file) != 0 || gzgetc(file) != 0 || - gzgetc(file) != 0 || - gzgetc(file) != 'c' || - gzgetc(file) != 'h' || - gzgetc(file) != 'e' || + gzgetc(file) != 0 || + gzgetc(file) != 'c' || + gzgetc(file) != 'h' || + gzgetc(file) != 'e' || gzgetc(file) != 'z') { fprintf(stderr, "malformed fasl-object header in %s\n", path); S_abnormal_exit(); @@ -632,23 +632,23 @@ static IBOOL find_boot(name, ext, errorp) const char *name, *ext; IBOOL errorp; if (gzgetc(file) != fasl_type_header || gzgetc(file) != 0 || gzgetc(file) != 0 || - gzgetc(file) != 0 || - gzgetc(file) != 'c' || - gzgetc(file) != 'h' || - gzgetc(file) != 'e' || + gzgetc(file) != 0 || + gzgetc(file) != 'c' || + gzgetc(file) != 'h' || + gzgetc(file) != 'e' || gzgetc(file) != 'z') { if (verbose) fprintf(stderr, "malformed fasl-object header in %s\n", path); gzclose(file); continue; } - + /* check version */ if (zget_uptr(file, &n) != 0) { if (verbose) fprintf(stderr, "unexpected end of file on %s\n", path); gzclose(file); continue; } - + if (n != scheme_version) { if (verbose) { fprintf(stderr, "%s is for Version %s; ", path, S_format_scheme_version(n)); @@ -658,14 +658,14 @@ static IBOOL find_boot(name, ext, errorp) const char *name, *ext; IBOOL errorp; gzclose(file); continue; } - + /* check machine type */ if (zget_uptr(file, &n) != 0) { if (verbose) fprintf(stderr, "unexpected end of file on %s\n", path); gzclose(file); continue; } - + if (n != machine_type) { if (verbose) fprintf(stderr, "%s is for machine-type %s; need machine-type %s\n", path, @@ -1181,7 +1181,7 @@ extern void Sscheme_deinit() { p = S_symbol_value(S_intern((const unsigned char *)"$close-files")); S_initframe(tc, 0); boot_call(tc, p, 0); - + S_errors_to_console = 1; current_state = DEINITIALIZED; } diff --git a/configure b/configure index dbba509b20..047856d412 100755 --- a/configure +++ b/configure @@ -2,13 +2,13 @@ # configure # Copyright 1984-2016 Cisco Systems, Inc. -# +# # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at -# +# # http://www.apache.org/licenses/LICENSE-2.0 -# +# # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. @@ -245,7 +245,7 @@ if [ "$help" = "yes" ]; then echo " --threads specify threaded version ($threads)" echo " --32|--64 specify 32/64-bit version ($bits)" echo " --installprefix= final installation root ($installprefix)" - echo " --installbin= lib directory ($installbin)" + echo " --installbin= bin directory ($installbin)" echo " --installlib= lib directory ($installlib)" echo " --installman= manpage directory ($installman)" echo " --temproot= staging root ($temproot)" diff --git a/s/io.ss b/s/io.ss index 7c63c24b21..3c3d711be0 100644 --- a/s/io.ss +++ b/s/io.ss @@ -1,13 +1,13 @@ "io.ss" ;;; io.ss ;;; Copyright 1984-2016 Cisco Systems, Inc. -;;; +;;; ;;; Licensed under the Apache License, Version 2.0 (the "License"); ;;; you may not use this file except in compliance with the License. ;;; You may obtain a copy of the License at -;;; +;;; ;;; http://www.apache.org/licenses/LICENSE-2.0 -;;; +;;; ;;; Unless required by applicable law or agreed to in writing, software ;;; distributed under the License is distributed on an "AS IS" BASIS, ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. @@ -2282,12 +2282,12 @@ implementation notes: (nongenerative) (opaque #t) (fields decode-desc encode-desc)) - + (define $iconv-open (foreign-procedure "(cs)s_iconv_open" (string string) ptr)) (define $iconv-close (foreign-procedure "(cs)s_iconv_close" (uptr) void)) (define $iconv-from-string (foreign-procedure "(cs)s_iconv_from_string" (uptr ptr uptr uptr ptr uptr uptr) ptr)) (define $iconv-to-string (foreign-procedure "(cs)s_iconv_to_string" (uptr ptr uptr uptr ptr uptr uptr) ptr)) - + (define iconv-decode (let () (define (err who tp info i iend bv) @@ -2388,7 +2388,7 @@ implementation notes: [else (err who tp info i iend bv)])] [(fx= n 0) (return 0 i iend info)] [else (loop j 0 (fx+ iend n))])))]))]))))))) - + (define iconv-encode (let () (define (return ans o info) @@ -2459,12 +2459,12 @@ implementation notes: (if (fx= newo o) (return (fx- j start) o info) (loop j newo)))]))]))))))) - + (define iconv-close (lambda (info) (cond [(iconv-info-decode-desc info) => $iconv-close]) (cond [(iconv-info-encode-desc info) => $iconv-close]))) - + (set-who! iconv-codec (lambda (code) (unless (string? code) ($oops who "~s is not a string" code)) @@ -2525,7 +2525,7 @@ implementation notes: ($make-transcoder codec eol-style handling-mode)]))) (set-who! transcoder? (lambda (x) ($transcoder? x))) - + (let ([transcoder (make-transcoder (utf-8-codec))]) (set-who! native-transcoder (lambda () transcoder)) (set-who! current-transcoder @@ -3768,7 +3768,7 @@ implementation notes: (unless (and (input-port? binary-input-port) (binary-port? binary-input-port)) ($oops who "~s is not a binary input port" binary-input-port)) (unless (and (fixnum? count) (fx>= count 0)) - ($oops who "~s is not a non-negative fixnum" count)) + ($oops who "~s is not a nonnegative fixnum" count)) (let ([buffer-size (file-buffer-size)]) (if (not ($fxu< buffer-size count)) (let ([bv (make-bytevector count)]) @@ -3933,7 +3933,7 @@ implementation notes: (unless (and (input-port? textual-input-port) (textual-port? textual-input-port)) ($oops who "~s is not a textual input port" textual-input-port)) (unless (and (fixnum? count) (fx>= count 0)) - ($oops who "~s is not a non-negative fixnum" count)) + ($oops who "~s is not a nonnegative fixnum" count)) (let ([buffer-size (file-buffer-size)]) (if (not ($fxu< buffer-size count)) (let ([st (make-string count)]) diff --git a/s/print.ss b/s/print.ss index 9293c99006..edaa5a7e19 100644 --- a/s/print.ss +++ b/s/print.ss @@ -1,13 +1,13 @@ "print.ss" ;;; print.ss ;;; Copyright 1984-2016 Cisco Systems, Inc. -;;; +;;; ;;; Licensed under the Apache License, Version 2.0 (the "License"); ;;; you may not use this file except in compliance with the License. ;;; You may obtain a copy of the License at -;;; +;;; ;;; http://www.apache.org/licenses/LICENSE-2.0 -;;; +;;; ;;; Unless required by applicable law or agreed to in writing, software ;;; distributed under the License is distributed on an "AS IS" BASIS, ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. @@ -97,7 +97,7 @@ (lambda (x) (if ($immediate? x) (eq? x black-hole) - (and + (and ($object-in-heap? x) (or (pair? x) (vector? x) @@ -422,13 +422,13 @@ floating point returns with (1 0 -1 ...). (fixup k (* r scale) s m- (and m+ (ash m- 1)) ruf))] [else (fixup k r s m- m+ ruf)])))) - + (define fixup (lambda (k r s m- m+ ruf) (if ((if ruf >= >) (+ r (or m+ m-)) s) (cutoffadjust0 (fx+ k 1) r (* s ob) m- m+ ruf) (cutoffadjust0 k r s m- m+ ruf)))) - + (define cutoffadjust0 (lambda (k r s m- m+ ruf) (case cutoffmode @@ -437,7 +437,7 @@ floating point returns with (1 0 -1 ...). (cutoffadjust k r s m- m+ ruf (fx- initialcutoffplace k))] [(relative) (when (fx>= initialcutoffplace 0) - ($oops '$flonum->digits "non-negative relative cutoffplace ~s" + ($oops '$flonum->digits "nonnegative relative cutoffplace ~s" initialcutoffplace)) (cutoffadjust k r s m- m+ ruf initialcutoffplace)] [else @@ -476,7 +476,7 @@ floating point returns with (1 0 -1 ...). (lambda (k r s m- m+ ruf cop) (let ([k (fx- k 1)]) (cons k (generate k r s m- m+ ruf cop))))) - + (define generate (lambda (k r s m- m+ ruf cop) (let* ([rob (* r ob)] @@ -501,7 +501,7 @@ floating point returns with (1 0 -1 ...). (if (fx= d u) (generate1 k (+ r (or m+ m-)) s cop) (generate1 k (- (+ r (or m+ m-)) s) s cop)))])))))) - + ; delta may be zero, in which case all digits are significant, ; even if we've been asked for 1,000,000 of them. This is due to ; our definition of (in)significant: "a digit is insignificant when @@ -510,7 +510,7 @@ floating point returns with (1 0 -1 ...). ; words, a digit is insignificant if incrementing the preceding ; digit does not cause the number to fall outside the rounding ; range of v." For 1e23, which falls exactly midway between two - ; fp numbers and reads as the next one down due to "unbiasd rounding", + ; fp numbers and reads as the next one down due to "unbiasd rounding", ; if we add even a single 1 digit way down, we're pushed to the next ; higher (when read). For example: ; 100000000000000000000000.000000000000000000000000000000000000001 @@ -941,7 +941,7 @@ floating point returns with (1 0 -1 ...). (lambda (x r d? p) (unless (or (fx= r 10) d?) (wrradix r p)) (wrbigits (if (< x 0) (begin (write-char #\- p) (- x)) x) r p))) - + (define wrfixnum (lambda (x r d? p) (unless (or (fx= r 10) d?) (wrradix r p)) @@ -970,7 +970,7 @@ floating point returns with (1 0 -1 ...). (let ([u (car s)]) (when (or (fx>= u 0) (fx>= e 0)) (loop u (cdr s) (fx- e 1))))))) - + (define free-format-exponential (lambda (e s r p) (write-char (flonum-digit->char (car s)) p) @@ -1167,7 +1167,7 @@ floating point returns with (1 0 -1 ...). (wr x (print-radix) lev len #f env p)))) (set-who! write - (case-lambda + (case-lambda [(x p) (unless (and (output-port? p) (textual-port? p)) ($oops 'write "~s is not a textual output port" p)) @@ -1187,7 +1187,7 @@ floating point returns with (1 0 -1 ...). (wr x (print-radix) #f #f #t #f p)) (set-who! display - (case-lambda + (case-lambda [(x p) (unless (and (output-port? p) (textual-port? p)) ($oops 'display "~s is not a textual output port" p))