suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #45 from michaellenaghan/master

Browse Source 
Fix two typos and three minor inconsistencies.
original commit: 19a80e849b1b0f9451b205cd96411c44036cdba6
This commit is contained in:
Andy Keep 2016-05-12 20:08:55 -04:00
commit 0c5d46d1b2
4 changed files with 48 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
c/scheme.c
View File

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

8
configure vendored
View File

@ -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=<pathname> final installation root ($installprefix)"
echo " --installbin=<pathname> lib directory ($installbin)"
echo " --installbin=<pathname> bin directory ($installbin)"
echo " --installlib=<pathname> lib directory ($installlib)"
echo " --installman=<pathname> manpage directory ($installman)"
echo " --temproot=<pathname> staging root ($temproot)"

22
s/io.ss
View File

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

28
s/print.ss
View File

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