From 0ff8e32e5574e2373ced9bd23494a1dab3b4c365 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 17 Mar 2010 00:24:51 -0700 Subject: [PATCH] Fix over-long lines; remove trailing whitespace. --- src/runtime/apply.scm | 2 +- src/runtime/arith.scm | 4 ++-- src/runtime/boot.scm | 6 +++-- src/runtime/cpress.scm | 2 +- src/runtime/defstr.scm | 2 +- src/runtime/dosdir.scm | 2 +- src/runtime/dosprm.scm | 2 +- src/runtime/dosproc.scm | 2 +- src/runtime/dospth.scm | 4 ++-- src/runtime/dragon4.scm | 2 +- src/runtime/gc.scm | 2 +- src/runtime/gcnote.scm | 4 ++-- src/runtime/genio.scm | 22 ++++++++--------- src/runtime/graphics.scm | 4 ++-- src/runtime/hash.scm | 2 +- src/runtime/histry.scm | 2 +- src/runtime/http-syntax.scm | 2 +- src/runtime/infutl.scm | 8 +++---- src/runtime/keyword.scm | 13 ++++++---- src/runtime/krypt.scm | 4 ++-- src/runtime/list.scm | 47 +++++++++++++++++++++++-------------- src/runtime/make.scm | 2 +- src/runtime/mime-codec.scm | 2 +- src/runtime/numint.scm | 4 ++-- src/runtime/numpar.scm | 7 +++--- src/runtime/optiondb.scm | 2 +- src/runtime/os2winp.scm | 2 +- src/runtime/parse.scm | 2 +- src/runtime/pgsql.scm | 4 ++-- src/runtime/port.scm | 2 +- src/runtime/prgcop.scm | 6 ++--- src/runtime/qsort.scm | 2 +- src/runtime/rgxcmp.scm | 2 +- src/runtime/runtime.pkg | 4 ++-- src/runtime/udata.scm | 2 +- src/runtime/unpars.scm | 2 +- src/runtime/unsyn.scm | 4 ++-- src/runtime/uproc.scm | 2 -- src/runtime/version.scm | 2 +- src/runtime/wttree.scm | 10 ++++---- src/runtime/x11graph.scm | 10 ++++---- 41 files changed, 113 insertions(+), 98 deletions(-) diff --git a/src/runtime/apply.scm b/src/runtime/apply.scm index 18d4496df..fa1699b5a 100644 --- a/src/runtime/apply.scm +++ b/src/runtime/apply.scm @@ -76,7 +76,7 @@ USA. (v7 (f v0 v1 v2 v3 v4 v5 v6)) |# (else ((ucode-primitive apply) f a0)))))) - + (define (apply-entity-procedure self f . args) self ; ignored (apply-2 f diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm index 64d9a60ae..37d105033 100644 --- a/src/runtime/arith.scm +++ b/src/runtime/arith.scm @@ -492,7 +492,7 @@ USA. (if (< sl 10) (print-medium value split-factor split-digits) (make-power-stack value split-factor '() split-digits))))) - + (cond ((not (int:integer? number)) (error:wrong-type-argument number #f 'NUMBER->STRING)) ((int:negative? number) @@ -850,7 +850,7 @@ USA. (lambda (n e) (flo:denormalize (integer->flonum n #b11) e)))) (step1 n d)))) - + (define (slow-method n d) (if (int:positive? n) (n>0 n d) diff --git a/src/runtime/boot.scm b/src/runtime/boot.scm index 4f59a1213..3d90a3395 100644 --- a/src/runtime/boot.scm +++ b/src/runtime/boot.scm @@ -125,7 +125,7 @@ USA. ((ucode-primitive with-interrupt-mask) (fix:and limit-mask (get-interrupt-enables)) procedure)) - + (define (object-constant? object) ((ucode-primitive constant?) object)) @@ -160,7 +160,9 @@ USA. (define (run-boot-inits! environment) (and (not (lexical-unreferenceable? environment saved-boot-inits)) (let ((inits - ((ucode-primitive lexical-reference) environment saved-boot-inits))) + ((ucode-primitive lexical-reference) + environment + saved-boot-inits))) ((ucode-primitive unbind-variable) environment saved-boot-inits) (for-each (lambda (init) (init)) inits)))) diff --git a/src/runtime/cpress.scm b/src/runtime/cpress.scm index 873b3a0f0..ce5d98c22 100644 --- a/src/runtime/cpress.scm +++ b/src/runtime/cpress.scm @@ -99,7 +99,7 @@ USA. (call-with-binary-input-file (merge-pathnames ifile) (lambda (input) (call-with-binary-output-file (merge-pathnames ofile) - (lambda (output) + (lambda (output) (write-string "Compressed-B1-1.00" output) (compress-ports input output)))))) diff --git a/src/runtime/defstr.scm b/src/runtime/defstr.scm index 75e2d44e0..ece048be9 100644 --- a/src/runtime/defstr.scm +++ b/src/runtime/defstr.scm @@ -28,7 +28,7 @@ USA. (declare (usual-integrations)) -#| +#| This macro works like the Common Lisp `defstruct' with the following differences: diff --git a/src/runtime/dosdir.scm b/src/runtime/dosdir.scm index 855682923..aa5f08261 100644 --- a/src/runtime/dosdir.scm +++ b/src/runtime/dosdir.scm @@ -247,7 +247,7 @@ USA. (lambda (instance) (and (string? instance) (>= (string-length instance) totlen) - (substring? middle instance))))) + (substring? middle instance))))) (else (let* ((prelen (string-length prefix)) diff --git a/src/runtime/dosprm.scm b/src/runtime/dosprm.scm index 15a91de80..63cc5d765 100644 --- a/src/runtime/dosprm.scm +++ b/src/runtime/dosprm.scm @@ -404,7 +404,7 @@ USA. (close-port port) (set! port #f) unspecific)))))))) - + (define console-channel-descriptor) (define (cache-console-channel-descriptor!) diff --git a/src/runtime/dosproc.scm b/src/runtime/dosproc.scm index cc2e0897a..d40e007af 100644 --- a/src/runtime/dosproc.scm +++ b/src/runtime/dosproc.scm @@ -71,7 +71,7 @@ USA. (lambda (port*) (recvr (channel-descriptor - (port/input-channel port*)))))))) + (port/input-channel port*)))))))) (define (with-output-channel in out) (cond ((default-object? stderr) diff --git a/src/runtime/dospth.scm b/src/runtime/dospth.scm index 59c116f01..1fbcdf435 100644 --- a/src/runtime/dospth.scm +++ b/src/runtime/dospth.scm @@ -35,7 +35,7 @@ USA. ;; must be quoted by another. (char-set #\\ #\/)) -(define sub-directory-delimiter-string +(define sub-directory-delimiter-string "\\") (define init-file-name "scheme.ini") @@ -206,7 +206,7 @@ USA. "") ((pair? directory) (string-append - (if (eq? (car directory) 'ABSOLUTE) + (if (eq? (car directory) 'ABSOLUTE) sub-directory-delimiter-string "") (let loop ((directory (cdr directory))) diff --git a/src/runtime/dragon4.scm b/src/runtime/dragon4.scm index 7e45c0b1f..8d5eb1972 100644 --- a/src/runtime/dragon4.scm +++ b/src/runtime/dragon4.scm @@ -351,6 +351,6 @@ not much different to numbers within a few orders of magnitude of 1. (try 0.00499 '(absolute -3 normal) "0.") - (display "\n\nSuccesses: ") (display successes) + (display "\n\nSuccesses: ") (display successes) (display " Failures: ") (display failures)) |# diff --git a/src/runtime/gc.scm b/src/runtime/gc.scm index a574003c9..58d88da29 100644 --- a/src/runtime/gc.scm +++ b/src/runtime/gc.scm @@ -165,7 +165,7 @@ USA. (hook/gc-finish start-value space-remaining)) (define gc-boot-loading?) - + (define gc-boot-death-message "\n;; Aborting boot-load: Not enough memory to load -- Use -large option.\n") diff --git a/src/runtime/gcnote.scm b/src/runtime/gcnote.scm index 566a02d86..528e4f9dc 100644 --- a/src/runtime/gcnote.scm +++ b/src/runtime/gcnote.scm @@ -47,7 +47,7 @@ USA. default/record-statistic!) (error "Can't grab GC statistics hook")))) unspecific)) - + (define (with-gc-notification! notify? thunk) (fluid-let ((hook/record-statistic! (if notify? gc-notification default/record-statistic!))) @@ -126,7 +126,7 @@ USA. #d10)) "%)") 7)))))) - + (string-append ";GC #" (number->string (gc-statistic/meter statistic)) ": took: " diff --git a/src/runtime/genio.scm b/src/runtime/genio.scm index 456552989..9d64ca66c 100644 --- a/src/runtime/genio.scm +++ b/src/runtime/genio.scm @@ -1222,11 +1222,11 @@ USA. #x0127 #x00B2 #x00B3 #x00B4 #x00B5 #x0125 #x00B7 #x00B8 #x0131 #x015F #x011F #x0135 #x00BD #f #x017C #x00C0 #x00C1 #x00C2 #f #x00C4 #x010A #x0108 #x00C7 #x00C8 - #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF #f + #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF #f #x00D1 #x00D2 #x00D3 #x00D4 #x0120 #x00D6 #x00D7 #x011C #x00D9 #x00DA #x00DB #x00DC #x016C #x015C #x00DF #x00E0 #x00E1 #x00E2 #f #x00E4 #x010B #x0109 #x00E7 #x00E8 - #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF #f + #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF #f #x00F1 #x00F2 #x00F3 #x00F4 #x0121 #x00F6 #x00F7 #x011D #x00F9 #x00FA #x00FB #x00FC #x016D #x015D #x02D9) @@ -1268,17 +1268,17 @@ USA. '(ISO_8859-5:1988 ISO-IR-144 ISO_8859-5 CYRILLIC CSISOLATINCYRILLIC)) (define-8-bit-codecs iso-8859-6 #xA1 - #f #f #f #x00A4 #f #f #f #f - #f #f #f #x060C #x00AD #f #f #f - #f #f #f #f #f #f #f #f - #f #f #x061B #f #f #f #x061F #f + #f #f #f #x00A4 #f #f #f #f + #f #f #f #x060C #x00AD #f #f #f + #f #f #f #f #f #f #f #f + #f #f #x061B #f #f #f #x061F #f #x0621 #x0622 #x0623 #x0624 #x0625 #x0626 #x0627 #x0628 #x0629 #x062A #x062B #x062C #x062D #x062E #x062F #x0630 #x0631 #x0632 #x0633 #x0634 #x0635 #x0636 #x0637 #x0638 #x0639 #x063A #f #f #f #f #f #x0640 #x0641 #x0642 #x0643 #x0644 #x0645 #x0646 #x0647 #x0648 #x0649 #x064A #x064B #x064C #x064D #x064E #x064F #x0650 - #x0651 #x0652 #f #f #f #f #f #f + #x0651 #x0652 #f #f #f #f #f #f #f #f #f #f #f #f #f) (define-coding-aliases 'ISO-8859-6 @@ -1307,10 +1307,10 @@ USA. #f #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7 #x00A8 #x00A9 #x00D7 #x00AB #x00AC #x00AD #x00AE #x00AF #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7 #x00B8 - #x00B9 #x00F7 #x00BB #x00BC #x00BD #x00BE #f #f - #f #f #f #f #f #f #f #f - #f #f #f #f #f #f #f #f - #f #f #f #f #f #f #f #f + #x00B9 #x00F7 #x00BB #x00BC #x00BD #x00BE #f #f + #f #f #f #f #f #f #f #f + #f #f #f #f #f #f #f #f + #f #f #f #f #f #f #f #f #f #f #f #f #f #f #x2017 #x05D0 #x05D1 #x05D2 #x05D3 #x05D4 #x05D5 #x05D6 #x05D7 #x05D8 #x05D9 #x05DA #x05DB #x05DC #x05DD #x05DE #x05DF #x05E0 diff --git a/src/runtime/graphics.scm b/src/runtime/graphics.scm index 8597116cd..b0d17568e 100644 --- a/src/runtime/graphics.scm +++ b/src/runtime/graphics.scm @@ -452,8 +452,8 @@ USA. (fill-from-byte-vector (operation 'fill-from-byte-vector))) (if (not (null? operations)) (error "Extra image type operations: " operations) - (%make-image-type create destroy - width height + (%make-image-type create destroy + width height draw draw-subimage fill-from-byte-vector)))))) (define-structure (image (conc-name image/) (constructor %make-image)) diff --git a/src/runtime/hash.scm b/src/runtime/hash.scm index 3f0c9f568..9c35f6f09 100644 --- a/src/runtime/hash.scm +++ b/src/runtime/hash.scm @@ -149,7 +149,7 @@ USA. (or (eq? x #f) (object-hash x (if (default-object? table) default-hash-table table) - #f))) + #f))) ;;; This can cons a bit when interpreted. diff --git a/src/runtime/histry.scm b/src/runtime/histry.scm index 15a1d4d15..04ecb3a19 100644 --- a/src/runtime/histry.scm +++ b/src/runtime/histry.scm @@ -205,7 +205,7 @@ USA. (define (dummy-reduction? reduction) (and (false? (reduction-expression reduction)) (eq? (ucode-return-address pop-from-compiled-code) - (reduction-environment reduction)))) + (reduction-environment reduction)))) (define (record-dummy-reduction-in-history! history) (record-evaluation-in-history! diff --git a/src/runtime/http-syntax.scm b/src/runtime/http-syntax.scm index 52cc0b8cd..25ec64358 100644 --- a/src/runtime/http-syntax.scm +++ b/src/runtime/http-syntax.scm @@ -1189,7 +1189,7 @@ USA. params-are-expectation?) write-parameters) -#; +#; (define-header "From" ;; parser is completely different -- it's a mail address. ... diff --git a/src/runtime/infutl.scm b/src/runtime/infutl.scm index 7d0a3b13b..84cd154f8 100644 --- a/src/runtime/infutl.scm +++ b/src/runtime/infutl.scm @@ -596,7 +596,7 @@ USA. (define (refill-input-buffer-and-retry needed) (short-substring-move! input-buffer ip ip-end input-buffer 0) (let* ((left (fix:- ip-end ip)) - (count (read-substring input-port input-buffer + (count (read-substring input-port input-buffer left input-size)) (total (fix:+ count left))) (if (fix:= count 0) @@ -609,7 +609,7 @@ USA. (define (finished) (output-port/write-substring output-port buffer 0 bp) bp) - + (define (literal-command byte) (let ((length (fix:+ byte 1)) (ip* (fix:+ ip 1))) @@ -712,7 +712,7 @@ USA. (define (uncompress-internal ifile ofile if-fail) (call-with-binary-input-file (merge-pathnames ifile) - (lambda (input) + (lambda (input) (let* ((file-marker "Compressed-B1-1.00") (marker-size (string-length file-marker)) (actual-marker (make-string marker-size))) @@ -722,7 +722,7 @@ USA. marker-size) (string=? file-marker actual-marker)) (call-with-binary-output-file (merge-pathnames ofile) - (lambda (output) + (lambda (output) (uncompress-ports input output (fix:* (file-length ifile) 2)))) (if-fail "Not a recognized compressed file:" ifile)))))) diff --git a/src/runtime/keyword.scm b/src/runtime/keyword.scm index be8fca217..2ced2298b 100644 --- a/src/runtime/keyword.scm +++ b/src/runtime/keyword.scm @@ -1,6 +1,8 @@ #| -*-Scheme-*- -Copyright (C) 2010 Massachusetts Institute of Technology +Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, + 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, + 2006, 2007, 2008, 2009, 2010 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -27,7 +29,8 @@ USA. (declare (usual-integrations)) (define (initialize-package!) - (set! *keyword-intern-table* (make-string-hash-table))) + (set! *keyword-intern-table* (make-string-hash-table)) + unspecific) (define *keyword-intern-table*) @@ -51,7 +54,7 @@ USA. ((BOTH CL) (write-char #\: port) (write (keyword/name object) port)) - ((DSSSL SRFI-88) + ((DSSSL SRFI-88) (write (keyword/name object) port) (write-char #\: port)) (else @@ -67,5 +70,7 @@ USA. (guarantee-string string 'string->keyword) (or (hash-table/get *keyword-intern-table* string #f) (let ((new-keyword (%make-keyword (string->symbol string)))) - (hash-table/put! *keyword-intern-table* (string-copy string) new-keyword) + (hash-table/put! *keyword-intern-table* + (string-copy string) + new-keyword) new-keyword))) \ No newline at end of file diff --git a/src/runtime/krypt.scm b/src/runtime/krypt.scm index 5043708ba..4fba494dc 100644 --- a/src/runtime/krypt.scm +++ b/src/runtime/krypt.scm @@ -92,7 +92,7 @@ USA. (fix:xor (vector-8b-ref buf k) (vector-ref s (inc-mod (fix:+ (fix:1+ (vector-ref s i)) - (vector-ref s j)) + (vector-ref s j)) ts)))) (loop (fix:1+ k) i j))) (begin @@ -107,7 +107,7 @@ USA. (vector-ref '#("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") (decoded-time/day-of-week the-time)) " " - (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun" + (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") (-1+ (decoded-time/month the-time))) " " diff --git a/src/runtime/list.scm b/src/runtime/list.scm index 9de53428f..72fde39ad 100644 --- a/src/runtime/list.scm +++ b/src/runtime/list.scm @@ -236,7 +236,7 @@ USA. description (if (default-object? caller) #f caller))) n)) - + (define (length list) (guarantee-list->length list 'LENGTH)) @@ -248,25 +248,36 @@ USA. (else (error:not-list list 'length=?)))) (define (%same-length left right) - (cond ((pair? left) (cond ((pair? right) (%same-length (cdr left) (cdr right))) - ((null? right) #f) - (else (error:not-list right 'length=?)))) - ((null? left) (cond ((pair? right) #f) - ((null? right) #t) - (else (error:not-list right 'length=?)))) - (else (error:not-list left 'length=?)))) + (cond ((pair? left) + (cond ((pair? right) (%same-length (cdr left) (cdr right))) + ((null? right) #f) + (else (error:not-list right 'length=?)))) + ((null? left) + (cond ((pair? right) #f) + ((null? right) #t) + (else (error:not-list right 'length=?)))) + (else + (error:not-list left 'length=?)))) ;; Take arguments in either order to make this easy to use. - (cond ((pair? left) (cond ((pair? right) (%same-length (cdr left) (cdr right))) - ((index-fixnum? right) (%length=? right left)) - ((null? right) #F) - (else (error:wrong-type-argument right "index fixnum or list" 'length=?)))) - ((index-fixnum? left) (%length=? left right)) - ((null? left) (cond ((pair? right) #f) - ((index-fixnum? right) (fix:zero? right)) - ((null? right) #t) - (else (error:wrong-type-argument right "index fixnum or list" 'length=?)))) - (else (error:wrong-type-argument left "index fixnum or list" 'length=?)))) + (cond ((pair? left) + (cond ((pair? right) (%same-length (cdr left) (cdr right))) + ((index-fixnum? right) (%length=? right left)) + ((null? right) #f) + (else + (error:wrong-type-argument right "index fixnum or list" + 'length=?)))) + ((index-fixnum? left) + (%length=? left right)) + ((null? left) + (cond ((pair? right) #f) + ((index-fixnum? right) (fix:zero? right)) + ((null? right) #t) + (else + (error:wrong-type-argument right "index fixnum or list" + 'length=?)))) + (else + (error:wrong-type-argument left "index fixnum or list" 'length=?)))) (define (not-pair? x) (not (pair? x))) diff --git a/src/runtime/make.scm b/src/runtime/make.scm index 4cf3a4ca5..d3b62d822 100644 --- a/src/runtime/make.scm +++ b/src/runtime/make.scm @@ -487,7 +487,7 @@ USA. (RUNTIME TRANSCRIPT) (RUNTIME STRING-I/O-PORT) (RUNTIME USER-INTERFACE) - ;; These MUST be done before (RUNTIME PATHNAME) + ;; These MUST be done before (RUNTIME PATHNAME) ;; Typically only one of them is loaded. (RUNTIME PATHNAME UNIX) (RUNTIME PATHNAME DOS) diff --git a/src/runtime/mime-codec.scm b/src/runtime/mime-codec.scm index eb06fa5ff..60c737f40 100644 --- a/src/runtime/mime-codec.scm +++ b/src/runtime/mime-codec.scm @@ -691,7 +691,7 @@ USA. (define binhex40-header-regexp "[\r\n\t ]*(This file must be converted with BinHex.*[\r\n][\r\n\t ]*:") -(define (decode-binhex40-decoding context string start end) +(define (decode-binhex40-decoding context string start end) (let ((buffer (binhex40-decoding-context/input-buffer context))) (let loop ((start start) diff --git a/src/runtime/numint.scm b/src/runtime/numint.scm index 2dd884c71..814077f8d 100644 --- a/src/runtime/numint.scm +++ b/src/runtime/numint.scm @@ -62,7 +62,7 @@ USA. (define (make-<=-operator <) (make-comparison-operator (lambda (x y) (not (< y x))) 'make-<=-operator)) - + (define (make->=-operator <) (make-comparison-operator (lambda (x y) (not (< x y))) 'make->=-operator)) @@ -125,7 +125,7 @@ USA. binary-invert-op)) -(define (make-arithmetic-package package-name . operations) +(define (make-arithmetic-package package-name . operations) (lambda (m . opt) (cond ((eq? m 'bound-names) (map car operations)) ((eq? m 'package-name) package-name) diff --git a/src/runtime/numpar.scm b/src/runtime/numpar.scm index 52c20f09f..e86a0013c 100644 --- a/src/runtime/numpar.scm +++ b/src/runtime/numpar.scm @@ -182,7 +182,7 @@ USA. (parse-digits string start end 0 exactness radix (lambda (start* integer exactness sharp?) sharp? - (and (> start* start) ; >0 denominator digits + (and (> start* start) ; >0 denominator digits (parse-complex string start* end (finish integer exactness sign) exactness radix sign)))))) @@ -254,8 +254,7 @@ USA. (finish-real integer exponent exactness sign) (parse-decimal-5 string start end integer exponent exactness sign)))) - - + (and (fix:< start end) (let ((esign (string-ref string start))) (if (sign? esign) @@ -345,7 +344,7 @@ USA. (apply-exactness exactness (* (apply-sign sign integer) (expt 10 exponent)))) - + (if (or (eq? 'INEXACT exactness) (eq? 'IMPLICIT-INEXACT exactness)) (let ((abs-exponent (if (< exponent 0) (- exponent) exponent)) (powers-of-10 exact-flonum-powers-of-10)) diff --git a/src/runtime/optiondb.scm b/src/runtime/optiondb.scm index f75d4b466..41f1ef263 100644 --- a/src/runtime/optiondb.scm +++ b/src/runtime/optiondb.scm @@ -43,7 +43,7 @@ USA. ;; $MITSCHEME_LIBRARY_PATH/runtime/) into the environment of the ;; package named PACKAGE-NAME, and then evaluates EXPR in that load ;; environment. If EXPR is #F of course evaluating it has no effect. -;; +;; ;; (FURTHER-LOAD-OPTIONS EXPR) ;; EXPR is the place to look next for the load options. Useful objects ;; are STANDARD-LOAD-OPTIONS (load options supplied with the diff --git a/src/runtime/os2winp.scm b/src/runtime/os2winp.scm index 28211be5e..6c63fe9cf 100644 --- a/src/runtime/os2winp.scm +++ b/src/runtime/os2winp.scm @@ -419,7 +419,7 @@ USA. (define-integrable ROP_DSTINVERT #x55) (define-integrable ROP_ZERO #x00) (define-integrable ROP_ONE #xFF) - + ;; Constants for OS2PS-BITBLT options argument (define-integrable BBO_OR 0) (define-integrable BBO_AND 1) diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm index 1c911958f..aa0155329 100644 --- a/src/runtime/parse.scm +++ b/src/runtime/parse.scm @@ -233,7 +233,7 @@ USA. (string->symbol string) (or (check-for-keyword string (db-keyword-style db)) (string->symbol string))))) - + ;; It'd be nice to have keyword objects work as part of the ;; parser-table, but not everyone does keywords the same way ;; (leading vs. trailing), so we'll just to check at the diff --git a/src/runtime/pgsql.scm b/src/runtime/pgsql.scm index c06e325e9..6232450e5 100644 --- a/src/runtime/pgsql.scm +++ b/src/runtime/pgsql.scm @@ -64,7 +64,7 @@ USA. (pq-tty 1) (pq-unescape-bytea 1) (pq-user 1)) - + (define-syntax define-enum (sc-macro-transformer (lambda (form environment) @@ -262,7 +262,7 @@ USA. (define (poll-pgsql-reset connection) (index->name (pq-reset-poll (connection->handle connection)) postgres-polling-status)) - + (define-syntax define-connection-accessor (sc-macro-transformer (lambda (form environment) diff --git a/src/runtime/port.scm b/src/runtime/port.scm index 8bbe22e20..11cfd4a13 100644 --- a/src/runtime/port.scm +++ b/src/runtime/port.scm @@ -438,7 +438,7 @@ USA. (define (port/operation port name) (guarantee-port port 'port/operation) (port/%operation port name)) - + (define-syntax define-port-operation (sc-macro-transformer (lambda (form environment) diff --git a/src/runtime/prgcop.scm b/src/runtime/prgcop.scm index 6227df186..cd5db29cb 100644 --- a/src/runtime/prgcop.scm +++ b/src/runtime/prgcop.scm @@ -150,13 +150,13 @@ USA. (len (vector-length new))) ((ucode-primitive declare-compiled-code-block 1) typed) (add-association! obj typed) - (do ((i (fix:+ (object-datum (vector-ref new 0)) 1) (fix:+ 1 i))) + (do ((i (fix:+ (object-datum (vector-ref new 0)) 1) (fix:+ 1 i))) ((not (fix:< i len))) (vector-set! new i (copy-object (vector-ref new i)))) typed)) (define-integrable (atomically thunk) - (with-absolutely-no-interrupts thunk)) + (with-absolutely-no-interrupts thunk)) (define ((%copy-pair type) obj) (%%copy-pair type obj)) @@ -264,7 +264,7 @@ USA. (define (copy-VARIABLE-object obj) (let ((var (make-variable (variable-name obj)))) (add-association! obj var) - var)) + var)) (define (copy-COMMENT-object obj) (let ((the-text (comment-text obj))) diff --git a/src/runtime/qsort.scm b/src/runtime/qsort.scm index d8e73c9b1..237066926 100644 --- a/src/runtime/qsort.scm +++ b/src/runtime/qsort.scm @@ -36,7 +36,7 @@ USA. (define (quick-sort! vector predicate) (define (outer-loop l r) (if (fix:> r l) - (if (fix:= r (fix:+ l 1)) + (if (fix:= r (fix:+ l 1)) (if (predicate (vector-ref vector r) (vector-ref vector l)) (exchange! l r)) diff --git a/src/runtime/rgxcmp.scm b/src/runtime/rgxcmp.scm index 63565d205..1f8c2fff0 100644 --- a/src/runtime/rgxcmp.scm +++ b/src/runtime/rgxcmp.scm @@ -191,7 +191,7 @@ USA. (if (fix:zero? n) (make-compiled-regexp string case-fold?) (let ((result - (string-allocate + (string-allocate (let ((qr (integer-divide n 255))) (fix:+ (fix:* 257 (integer-divide-quotient qr)) (let ((r (integer-divide-remainder qr))) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 0937485f1..28fb7de1a 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -2911,7 +2911,7 @@ USA. (initialization (initialize-package!))) (define-package (runtime primitive-io) - (files "io") + (files "io") (parent (runtime)) (export () all-dld-handles @@ -5048,7 +5048,7 @@ USA. rexp-line-end rexp-line-start rexp-n* - rexp-n*m + rexp-n*m rexp-n*n rexp-not-syntax-char rexp-not-word-char diff --git a/src/runtime/udata.scm b/src/runtime/udata.scm index c2b66a8fe..d79fd9696 100644 --- a/src/runtime/udata.scm +++ b/src/runtime/udata.scm @@ -158,7 +158,7 @@ contains constants derived from the source program. (compiled-code-address->block (fasload filename))) (define (compiled-code-block/manifest-closure? block) - (object-type? + (object-type? (ucode-type manifest-closure) ;; This combination returns an unsafe object, but since it ;; is used as an argument to a primitive, I can get away diff --git a/src/runtime/unpars.scm b/src/runtime/unpars.scm index 9a9fb28d0..4c0e5c100 100644 --- a/src/runtime/unpars.scm +++ b/src/runtime/unpars.scm @@ -368,7 +368,7 @@ USA. (define (looks-like-keyword? string) (case (environment-lookup *environment* '*KEYWORD-STYLE*) - ((BOTH) + ((BOTH) (or (char=? (string-ref string 0) #\:) (char=? (string-ref string (- (string-length string) 1)) #\:))) ((CL) diff --git a/src/runtime/unsyn.scm b/src/runtime/unsyn.scm index 44d29fa7f..00564a5cd 100644 --- a/src/runtime/unsyn.scm +++ b/src/runtime/unsyn.scm @@ -83,7 +83,7 @@ USA. (set-cdr! bound old) value)) (action argument))) - + (define (unsyntax scode) (fluid-let ((bound (list #F '()))) (unsyntax-object (if (procedure? scode) (procedure-lambda scode) scode)))) @@ -241,7 +241,7 @@ USA. unexpand-disjunction (lambda (predicate alternative) (list (unsyntax-object predicate) - (unsyntax-object alternative))))))) + (unsyntax-object alternative))))))) (define (unexpand-disjunction predicate alternative) `(,(unsyntax-object predicate) diff --git a/src/runtime/uproc.scm b/src/runtime/uproc.scm index 90e26c380..9674ee2bb 100644 --- a/src/runtime/uproc.scm +++ b/src/runtime/uproc.scm @@ -425,6 +425,4 @@ USA. #f))))) (else (loop (entity-procedure p1)))) - - #f)))) \ No newline at end of file diff --git a/src/runtime/version.scm b/src/runtime/version.scm index 044be52bf..1c41f1eef 100644 --- a/src/runtime/version.scm +++ b/src/runtime/version.scm @@ -174,7 +174,7 @@ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.") (define (write-words words line-prefix indentation port) (let ((wrap-column (- (output-port/x-size port) 5)) (space " ")) - + (define (write-first-word words indent?) (write-string line-prefix port) (if indent? (write-string indentation port)) diff --git a/src/runtime/wttree.scm b/src/runtime/wttree.scm index 0d62def31..4a5618f30 100644 --- a/src/runtime/wttree.scm +++ b/src/runtime/wttree.scm @@ -64,7 +64,7 @@ reference: (difference #F read-only true) (subset? #F read-only true) (rank #F read-only true) -) +) ;;; Tree representation ;;; @@ -243,7 +243,7 @@ reference: (define (node/rank k node rank) (cond ((empty? node) #f) ((key? k (node/k node)) + ((key>? k (node/k node)) (node/rank k (node/r node) (fix:+ 1 (fix:+ rank (node/size (node/l node)))))) (else (fix:+ rank (node/size (node/l node)))))) @@ -305,7 +305,7 @@ reference: ((keytree)))) (%make-wt-tree my-type (loop alist empty))) @@ -468,7 +468,7 @@ reference: )) my-type) - + ;;; diff --git a/src/runtime/x11graph.scm b/src/runtime/x11graph.scm index e8dd71879..e1cdd684a 100644 --- a/src/runtime/x11graph.scm +++ b/src/runtime/x11graph.scm @@ -485,7 +485,7 @@ USA. (let ((xw (x-graphics-open-window (x-display/xd display) - (if (default-object? geometry) + (if (default-object? geometry) x-graphics-default-geometry geometry) (vector #f resource class)))) @@ -669,7 +669,7 @@ USA. (->flonum angle-start) (->flonum angle-sweep) fill?)) - + (define (x-graphics/draw-circle device x y radius) (x-graphics-draw-arc (x-graphics-device/xw device) (->flonum x) @@ -679,7 +679,7 @@ USA. 0. 360. #f)) - + (define (x-graphics/fill-circle device x y radius) (x-graphics-draw-arc (x-graphics-device/xw device) (->flonum x) @@ -689,11 +689,11 @@ USA. 0. 360. #t)) - + (define (x-graphics/fill-polygon device point-vector) (x-graphics-fill-polygon (x-graphics-device/xw device) (vector-map ->flonum point-vector))) - + (define (x-graphics/copy-area device source-x-left source-y-top width height destination-x-left destination-y-top) (let ((xw (x-graphics-device/xw device))) -- 2.25.1