Removed mentions of PowerPC Macintosh.

README-FIRST.txt

@@ -5,7 +5,6 @@ Currently, this software is distributed for:
  - Linux on Intel x86 machines (native IA32 and C backends)
  - Linux on little-endian ARMv7 machines (native ARM-32 backend)
  - Mac OS X (>= 10.4) on Intel x86 machines (native IA32 backend)
- - Mac OS X (>= 10.2) on PowerPC machines (C backend)
 
 The current version of Larceny always runs in 32-bit mode, but the
 native IA32 variety of Larceny is known to work on x86-64 hardware
@@ -104,7 +103,7 @@ and is online at http://larceny.ccs.neu.edu/doc/
 NOTES
 
 [1] You may be able to make Petit Larceny work on other platforms
-(e.g. Linux/PowerPC or Solaris/IA32 with the C backend) but we do
+(e.g. MacOSX/PowerPC or Linux/PowerPC with the C backend) but we do
 not support those systems.
 
 [2] http://larceny.ccs.neu.edu/doc/CommonLarceny/user-manual.html

doc/UserManual/intro.txt

@@ -16,8 +16,7 @@ for Intel x86 microprocessors running Linux, Apple OS X,
 or Windows operating systems.
 
 Petit Larceny compiles to C instead of machine code. It
-runs on most Unix machines, including PowerPC Macintoshes
-with MacOS X.
+can be made to run on most Unix machines.
 
 ////////////////////////////////////////////////////////////////////////
 Common Larceny compiles to JIT-compiled IL on Microsoft's
@@ -39,9 +38,8 @@ on 64-bit machines provided the appropriate 32-bit
 libraries have been installed.
 
 Binary distributions of Petit Larceny are available for
-x86 machines running Linux and for PowerPC machines running
-MacOS X. Petit Larceny requires the `gcc` compiler as well
-as the appropriate 32-bit libraries.
+x86 machines running Linux. Petit Larceny requires the `gcc`
+compiler as well as the appropriate 32-bit libraries.
 
 ////////////////////////////////////////////////////////////////
 To use some features of the FFI, you'll need the appropriate

test/Benchmarking/R7RS/summarize.sch

@@ -0,0 +1,297 @@
+;;; Extraction of benchmark results.
+;;;
+;;; The R7RS (scheme time) library has greatly simplified this.
+;;; The only outputs we need to recognize look like this:
+;;;
+;;; Elapsed time: 3.019585 seconds (3.0) for sum:10000:200000
+;;;
+;;; where the first time was computed using (current-jiffy),
+;;; the second time was computed using (current-second) and
+;;; rounded to milliseconds, and the name of the benchmark
+;;; follows the " for ". The benchmark name will always be
+;;; a legal symbol in Scheme, so the components of that line
+;;; can be read using the read procedure.
+
+
+(define (summarize-usual-suspects)
+ ((summarize r7rs-results) "results.Chibi" "summary.Chibi")
+ ((summarize r7rs-results) "results.Chicken" "summary.Chicken")
+ ((summarize r7rs-results) "results.Foment" "summary.Foment")
+ ((summarize r7rs-results) "results.Gauche" "summary.Gauche")
+ ((summarize r7rs-results) "results.Kawa" "summary.Kawa")
+ ((summarize r7rs-results) "results.Larceny" "summary.Larceny")
+ ((summarize r7rs-results) "results.Petit" "summary.Petit"))
+
+(define (decode-usual-suspects)
+ (map decode-summary
+ '("summary.Larceny"
+ "summary.Petit"
+ "summary.Chibi"
+ "summary.Chicken"
+ "summary.Foment"
+ "summary.Gauche"
+ "summary.Kawa")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; Help procedures.
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (readline port)
+ (do ((c (read-char port) (read-char port))
+ (chars '() (cons c chars)))
+ ((or (eof-object? c)
+ (char=? c #\newline))
+ (list->string (reverse chars)))))
+
+(define (readlines port)
+ (do ((c (peek-char port) (peek-char port))
+ (lines '() (cons (readline port) lines)))
+ ((eof-object? c)
+ (reverse lines))))
+
+; If s1 is a substring of s2, then returns the least integer m
+; such that (string=? s1 (substring s2 m (+ m (string-length s1)))).
+; Otherwise returns #f.
+
+(define (substring? s1 s2)
+ (let ((n1 (string-length s1))
+ (n2 (string-length s2)))
+ (let ((n (- n2 n1)))
+ (let loop ((m 0))
+ (if (<= m n)
+ (if (substring=? s1 s2 m (+ m n1))
+ m
+ (loop (+ m 1)))
+ #f)))))
+
+(define (substring=? s1 s2 m n)
+ (and (<= (string-length s1) (- n m))
+ (<= n (string-length s2))
+ (do ((i 0 (+ i 1))
+ (m m (+ m 1)))
+ ((or (= m n)
+ (not (char=? (string-ref s1 i)
+ (string-ref s2 m))))
+ (= m n)))))
+
+(define (right-justify x n . port)
+ (let ((p (open-output-string))
+ (port (if (null? port) (current-output-port) (car port))))
+ (display x p)
+ (let* ((s (get-output-string p))
+ (m (string-length s)))
+ (if (< m n)
+ (display (string-append (make-string (- n m) #\space) s) port)
+ (display (substring s 0 n) port)))))
+
+(define (left-justify x n . port)
+ (let ((p (open-output-string))
+ (port (if (null? port) (current-output-port) (car port))))
+ (display x p)
+ (let* ((s (get-output-string p))
+ (m (string-length s)))
+ (if (< m n)
+ (display (string-append s (make-string (- n m) #\space)) port)
+ (display (substring s 0 n) port)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; Summarizing the results.* files that are created by the bench
+; script.
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (summarize f)
+ (define (summarize in . rest)
+ (define (bad-arguments)
+ (error "Bad arguments to summarize-results"
+ (cons in rest)))
+ (cond ((string? in)
+ (call-with-input-file
+ in
+ (lambda (in) (apply summarize in rest))))
+ ((input-port? in)
+ (cond ((null? rest)
+ (summarize in (current-output-port)))
+ ((string? (car rest))
+ (call-with-output-file
+ (car rest)
+ (lambda (out)
+ (summarize in out))))
+ ((output-port? (car rest))
+ (f (readlines in) (car rest)))
+ (else
+ (bad-arguments))))
+ (else
+ (bad-arguments))))
+ summarize)
+
+;;; For results displayed in the standard form:
+;;;
+;;; Elapsed time: 3.019585 seconds (3.0) for sum:10000:200000
+
+(define (r7rs-results lines out)
+
+ (define (round3 secs)
+ (let* ((msec (exact (round (* 1000.0 secs))))
+ (secs (quotient msec 1000))
+ (msec (remainder msec 1000)))
+ (string-append (number->string secs)
+ "."
+ (substring (number->string (+ 1000 msec)) 1 4))))
+
+ (let ((system-key "Benchmarking ")
+ (test-key "Elapsed time: "))
+ (let ((n-system-key (string-length system-key))
+ (n-test-key (string-length test-key))
+ (name-width 40)
+ (timing-width 10))
+ (let loop ((lines lines))
+ (if (null? lines)
+ (newline out)
+ (let ((line (car lines)))
+ (cond ((substring=? system-key line 0 n-system-key)
+ ;; so we won't do this more than once
+ (set! system-key
+ (make-string n-system-key #\!))
+ (display line out)
+ (newline out)
+ (newline out)
+ (display
+ "benchmark real"
+ out)
+ (newline out))
+ ((substring=? test-key line 0 n-test-key)
+ (newline out)
+ (let* ((p (open-input-string line))
+ (Elapsed (read p))
+ (time: (read p))
+ (secs (read p))
+ (seconds (read p))
+ (rounded (read p))
+ (for (read p))
+ (name (read p)))
+ (assert (and (number? secs)
+ (list? rounded)
+ (= 1 (length rounded))
+ (number? (car rounded))
+ (symbol? name)))
+ (left-justify name name-width out)
+ (right-justify (round3 secs) timing-width out))))
+ (loop (cdr lines))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; Conversion of the summaries into Scheme-readable data.
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; Given a file name or input port containing a summary
+; produced by the summarize procedure above,
+; returns a decoded summary of the form
+;
+; (<system> ; a string, e.g. "Larceny"
+; (<hostname> <date> ...) ; strings
+; ((<benchmark> ; a symbol, e.g. fib
+; <realtime>) ; a number, in seconds
+; ...))
+
+(define make-summary list)
+(define make-timing list)
+
+(define summary:system car)
+(define summary:hostetc cadr)
+(define summary:timings caddr)
+(define timing:benchmark car)
+(define timing:real cadr)
+
+(define (decode-summary in)
+ (define (bad-arguments)
+ (error "Bad arguments to summarize-results" in))
+ (cond ((string? in)
+ (call-with-input-file
+ in
+ (lambda (in) (decode-summary in))))
+ ((input-port? in)
+ (let skip ((lines (readlines in))
+ (decoded-summaries '()))
+ (cond
+ ((null? lines) (apply values (reverse decoded-summaries)))
+ ((decode-lines lines) => 
+ (lambda (decoded+remainder)
+ (let* ((rev (reverse decoded+remainder))
+ (remainder (car rev))
+ (decoded (reverse (cdr rev))))
+ (skip remainder (cons decoded decoded-summaries)))))
+ (else
+ (skip (cdr lines) decoded-summaries)))))
+ (else
+ (bad-arguments))))
+
+; Given the summary as a list of lines,
+; returns the decoded summary as for decode-summary,
+; with remaining lines snoc'd on the end
+
+(define (decode-lines lines)
+ (let ((system-key "Benchmarking ")
+ (date-key " on ")
+ (header-key "benchmark"))
+ (let ((n-system-key (string-length system-key))
+ (n-date-key (string-length date-key))
+ (n-header-key (string-length header-key)))
+ (define header-line? 
+ (lambda (line) (substring=? system-key line 0 n-system-key)))
+ (and (not (null? lines))
+ (header-line? (car lines))
+ (let* ((line0 (car lines))
+ (n0 (string-length line0))
+ (n1 (substring? date-key line0))
+ (system (substring line0 n-system-key n1))
+ (hostname "unknown")
+ (date (substring line0 (+ n1 n-date-key) n0))
+ (benchmark+remaining-lines
+ (let loop ((lines (cdr lines))
+ (bmark-lines '()))
+ (cond ((or (null? lines)
+ (header-line? (car lines)))
+ (list (reverse bmark-lines) lines))
+ (else
+ (loop (cdr lines) 
+ (cons (car lines) bmark-lines))))))
+ (benchmark-lines (car benchmark+remaining-lines))
+ (remaining-lines (cadr benchmark+remaining-lines))
+ (benchmarks
+ (map (lambda (line)
+ (let* ((padding " #f #f #f #f")
+ (in (open-input-string
+ (string-append line padding)))
+ (name (read in)))
+ (call-with-current-continuation 
+ (lambda (ret)
+ (let loop ((tot-real 0)
+ (count 0))
+ (let ((real (read in)))
+ (cond ((not (number? real))
+ (cond ((= count 0)
+ (list name real))
+ (else
+ (list name
+ (/ tot-real count)))))
+ (else
+ (loop (+ tot-real real)
+ (+ count 1))))))))))
+ benchmark-lines))
+ (benchmarks
+ (filter (lambda (x)
+ (and (car x)
+ (symbol? (car x))
+ (not (eq? (car x) 'benchmark))
+ (number? (cadr x))
+ (positive? (cadr x))))
+ benchmarks)))
+ (list system
+ (list hostname date)
+ benchmarks
+ remaining-lines))))))