Import Upstream version 2a6upstream/2a6

1 files changed, 1466 insertions, 0 deletions

diff --git a/mitcomp.pat b/mitcomp.pat
new file mode 100644
index 0000000..78cb9b9
--- /dev/null
+++ b/mitcomp.pat
@@ -0,0 +1,1466 @@
+;"mitcomp.pat", patch file of definitions for compiling SLIB with MitScheme.
+;;; Copyright (C) 1993 Matthew McDonald.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+From: mafm@cs.uwa.edu.au (Matthew MCDONALD)
+
+	Added declarations to files providing these:
+dynamic alist hash hash-table logical random random-inexact modular
+prime charplot common-list-functions format generic-write pprint-file
+pretty-print-to-string object->string string-case printf line-i/o
+synchk priority-queue process red-black-tree sort
+
+(for-each cf
+ '("dynamic.scm" "alist.scm" "hash.scm" "hashtab.scm" "logical.scm"
+   "random.scm" "randinex.scm" "modular.scm" "prime.scm" "charplot.scm"
+   "comlist.scm" "format.scm" "genwrite.scm" "ppfile.scm" "pp2str.scm"
+   "obj2str.scm" "strcase.scm" "printf.scm" "lineio.scm" "synchk.scm"
+   "priorque.scm" "process.scm" "rbtree.scm" "sort.scm))
+
+while in the SLIB directory will compile all of these.
+
+	They all appear to still be working... They should be
+everything CScheme currently uses (except [1] below.)
+
+NOTES:
+
+[1] Not altered:
+	debug		   Not worth optimising
+	test		   "   "     "
+	fluid-let          compiler chokes over
+				(lambda () . body)
+	scmacro		   Fails when compiled, not immediately obvious why
+	synclo             " " "
+	r4rsyn		   " " "
+	yasos              requires the macros
+	collect		   "        "   "
+
+[2] removed 'sort from list of MIT features. The library version is
+more complete (and needed for charplot.)
+
+[3] Remember that mitscheme.init gets the .bin put in the wrong place
+by the compiler and thus doesn't get recognised by LOAD.
+======================================================================
+diff -c slib/alist.scm nlib/alist.scm
+*** slib/alist.scm	Thu Jan 21 00:01:34 1993
+--- nlib/alist.scm	Tue Feb  9 00:21:07 1993
+***************
+*** 44,50 ****
+  ;(define rem (alist-remover string-ci=?))
+  ;(set! alist (rem alist "fOO"))
+  
+! (define (predicate->asso pred)
+    (cond ((eq? eq? pred) assq)
+  	((eq? = pred) assv)
+  	((eq? eqv? pred) assv)
+--- 44,53 ----
+  ;(define rem (alist-remover string-ci=?))
+  ;(set! alist (rem alist "fOO"))
+  
+! ;;; Declarations for CScheme
+! (declare (usual-integrations))
+! 
+! (define-integrable (predicate->asso pred)
+    (cond ((eq? eq? pred) assq)
+  	((eq? = pred) assv)
+  	((eq? eqv? pred) assv)
+***************
+*** 57,69 ****
+  			((pred key (caar al)) (car al))
+  			(else (l (cdr al)))))))))
+  
+! (define (alist-inquirer pred)
+    (let ((assofun (predicate->asso pred)))
+      (lambda (alist key)
+        (let ((pair (assofun key alist)))
+  	(and pair (cdr pair))))))
+  
+! (define (alist-associator pred)
+    (let ((assofun (predicate->asso pred)))
+      (lambda (alist key val)
+        (let* ((pair (assofun key alist)))
+--- 60,72 ----
+  			((pred key (caar al)) (car al))
+  			(else (l (cdr al)))))))))
+  
+! (define-integrable (alist-inquirer pred)
+    (let ((assofun (predicate->asso pred)))
+      (lambda (alist key)
+        (let ((pair (assofun key alist)))
+  	(and pair (cdr pair))))))
+  
+! (define-integrable (alist-associator pred)
+    (let ((assofun (predicate->asso pred)))
+      (lambda (alist key val)
+        (let* ((pair (assofun key alist)))
+***************
+*** 71,77 ****
+  		    alist)
+  	      (else (cons (cons key val) alist)))))))
+  
+! (define (alist-remover pred)
+    (lambda (alist key)
+      (cond ((null? alist) alist)
+  	  ((pred key (caar alist)) (cdr alist))
+--- 74,80 ----
+  		    alist)
+  	      (else (cons (cons key val) alist)))))))
+  
+! (define-integrable (alist-remover pred)
+    (lambda (alist key)
+      (cond ((null? alist) alist)
+  	  ((pred key (caar alist)) (cdr alist))
+diff -c slib/charplot.scm nlib/charplot.scm
+*** slib/charplot.scm	Sat Nov 14 21:50:54 1992
+--- nlib/charplot.scm	Tue Feb  9 00:21:07 1993
+***************
+*** 7,12 ****
+--- 7,24 ----
+  ;are strings with names to label the x and y axii with.
+  
+  ;;;;---------------------------------------------------------------
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "sort"))
++ (declare (integrate
++ 	  rows
++ 	  columns
++ 	  charplot:height
++ 	  charplot:width
++ 	  charplot:plot
++ 	  plot!))
++ 
+  (require 'sort)
+  
+  (define rows 24)
+***************
+*** 27,39 ****
+  	 (write-char char)
+  	 (charplot:printn! (+ n -1) char))))
+  
+! (define (charplot:center-print! str width)
+    (let ((lpad (quotient (- width (string-length str)) 2)))
+      (charplot:printn! lpad #\ )
+      (display str)
+      (charplot:printn! (- width (+ (string-length  str) lpad)) #\ )))
+  
+! (define (scale-it z scale)
+    (if (and (exact? z) (integer? z))
+        (quotient (* z (car scale)) (cadr scale))
+        (inexact->exact (round (/ (* z (car scale)) (cadr scale))))))
+--- 39,51 ----
+  	 (write-char char)
+  	 (charplot:printn! (+ n -1) char))))
+  
+! (define-integrable (charplot:center-print! str width)
+    (let ((lpad (quotient (- width (string-length str)) 2)))
+      (charplot:printn! lpad #\ )
+      (display str)
+      (charplot:printn! (- width (+ (string-length  str) lpad)) #\ )))
+  
+! (define-integrable (scale-it z scale)
+    (if (and (exact? z) (integer? z))
+        (quotient (* z (car scale)) (cadr scale))
+        (inexact->exact (round (/ (* z (car scale)) (cadr scale))))))
+diff -c slib/comlist.scm nlib/comlist.scm
+*** slib/comlist.scm	Wed Jan 27 11:08:44 1993
+--- nlib/comlist.scm	Tue Feb  9 00:21:08 1993
+***************
+*** 6,11 ****
+--- 6,14 ----
+  
+  ;;;; LIST FUNCTIONS FROM COMMON LISP
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
+  ;;;From: hugh@ear.mit.edu (Hugh Secker-Walker)
+  (define (make-list k . init)
+    (set! init (if (pair? init) (car init)))
+***************
+*** 13,21 ****
+         (result '() (cons init result)))
+        ((<= k 0) result)))
+  
+! (define (copy-list lst) (append lst '()))
+  
+! (define (adjoin e l) (if (memq e l) l (cons e l)))
+  
+  (define (union l1 l2)
+    (cond ((null? l1) l2)
+--- 16,24 ----
+         (result '() (cons init result)))
+        ((<= k 0) result)))
+  
+! (define-integrable (copy-list lst) (append lst '()))
+  
+! (define-integrable (adjoin e l) (if (memq e l) l (cons e l)))
+  
+  (define (union l1 l2)
+    (cond ((null? l1) l2)
+***************
+*** 33,39 ****
+  	((memv (car l1) l2) (set-difference (cdr l1) l2))
+  	(else (cons (car l1) (set-difference (cdr l1) l2)))))
+  
+! (define (position obj lst)
+    (letrec ((pos (lambda (n lst)
+  		  (cond ((null? lst) #f)
+  			((eqv? obj (car lst)) n)
+--- 36,42 ----
+  	((memv (car l1) l2) (set-difference (cdr l1) l2))
+  	(else (cons (car l1) (set-difference (cdr l1) l2)))))
+  
+! (define-integrable (position obj lst)
+    (letrec ((pos (lambda (n lst)
+  		  (cond ((null? lst) #f)
+  			((eqv? obj (car lst)) n)
+***************
+*** 45,51 ****
+        init
+        (reduce-init p (p init (car l)) (cdr l))))
+  
+! (define (reduce p l)
+    (cond ((null? l) l)
+  	((null? (cdr l)) (car l))
+  	(else (reduce-init p (car l) (cdr l)))))
+--- 48,54 ----
+        init
+        (reduce-init p (p init (car l)) (cdr l))))
+  
+! (define-integrable (reduce p l)
+    (cond ((null? l) l)
+  	((null? (cdr l)) (car l))
+  	(else (reduce-init p (car l) (cdr l)))))
+***************
+*** 58,64 ****
+    (or (null? l)
+        (and (pred (car l)) (every pred (cdr l)))))
+  
+! (define (notevery pred l) (not (every pred l)))
+  
+  (define (find-if t l)
+    (cond ((null? l) #f)
+--- 61,67 ----
+    (or (null? l)
+        (and (pred (car l)) (every pred (cdr l)))))
+  
+! (define-integrable (notevery pred l) (not (every pred l)))
+  
+  (define (find-if t l)
+    (cond ((null? l) #f)
+***************
+*** 121,141 ****
+  (define (nthcdr n lst)
+    (if (zero? n) lst (nthcdr (+ -1 n) (cdr lst))))
+  
+! (define (last lst n)
+    (nthcdr (- (length lst) n) lst))
+  
+  ;;;; CONDITIONALS
+  
+! (define (and? . args)
+    (cond ((null? args) #t)
+  	((car args) (apply and? (cdr args)))
+  	(else #f)))
+  
+! (define (or? . args)
+    (cond ((null? args) #f)
+  	((car args) #t)
+  	(else (apply or? (cdr args)))))
+  
+! (define (identity x) x)
+  
+  (require 'rev3-procedures)
+--- 124,144 ----
+  (define (nthcdr n lst)
+    (if (zero? n) lst (nthcdr (+ -1 n) (cdr lst))))
+  
+! (define-integrable (last lst n)
+    (nthcdr (- (length lst) n) lst))
+  
+  ;;;; CONDITIONALS
+  
+! (define-integrable (and? . args)
+    (cond ((null? args) #t)
+  	((car args) (apply and? (cdr args)))
+  	(else #f)))
+  
+! (define-integrable (or? . args)
+    (cond ((null? args) #f)
+  	((car args) #t)
+  	(else (apply or? (cdr args)))))
+  
+! (define-integrable (identity x) x)
+  
+  (require 'rev3-procedures)
+diff -c slib/dynamic.scm nlib/dynamic.scm
+*** slib/dynamic.scm	Thu Sep 17 23:35:46 1992
+--- nlib/dynamic.scm	Tue Feb  9 00:21:08 1993
+***************
+*** 31,36 ****
+--- 31,43 ----
+  ;
+  ;There was also a DYNAMIC-BIND macro which I haven't implemented.
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate-external "record"))
++ (declare (integrate-external "dynwind"))
++ (declare (integrate dynamic:errmsg))
++ 
+  (require 'record)
+  (require 'dynamic-wind)
+  
+***************
+*** 48,60 ****
+    (record-accessor dynamic-environment-rtd 'parent))
+  
+  (define *current-dynamic-environment* #f)
+! (define (extend-current-dynamic-environment dynamic obj)
+    (set! *current-dynamic-environment*
+  	(make-dynamic-environment dynamic obj
+  				  *current-dynamic-environment*)))
+  
+  (define dynamic-rtd (make-record-type "dynamic" '()))
+! (define make-dynamic
+    (let ((dynamic-constructor (record-constructor dynamic-rtd)))
+      (lambda (obj)
+        (let ((dynamic (dynamic-constructor)))
+--- 55,69 ----
+    (record-accessor dynamic-environment-rtd 'parent))
+  
+  (define *current-dynamic-environment* #f)
+! 
+! (define-integrable (extend-current-dynamic-environment dynamic obj)
+    (set! *current-dynamic-environment*
+  	(make-dynamic-environment dynamic obj
+  				  *current-dynamic-environment*)))
+  
+  (define dynamic-rtd (make-record-type "dynamic" '()))
+! 
+! (define-integrable make-dynamic
+    (let ((dynamic-constructor (record-constructor dynamic-rtd)))
+      (lambda (obj)
+        (let ((dynamic (dynamic-constructor)))
+***************
+*** 61,68 ****
+  	(extend-current-dynamic-environment dynamic obj)
+  	dynamic))))
+  
+! (define dynamic? (record-predicate dynamic-rtd))
+! (define (guarantee-dynamic dynamic)
+    (or (dynamic? dynamic)
+        (slib:error "Not a dynamic" dynamic)))
+  
+--- 70,78 ----
+  	(extend-current-dynamic-environment dynamic obj)
+  	dynamic))))
+  
+! (define-integrable dynamic? (record-predicate dynamic-rtd))
+! 
+! (define-integrable (guarantee-dynamic dynamic)
+    (or (dynamic? dynamic)
+        (slib:error "Not a dynamic" dynamic)))
+  
+***************
+*** 69,75 ****
+  (define dynamic:errmsg
+    "No value defined for this dynamic in the current dynamic environment")
+  
+! (define (dynamic-ref dynamic)
+    (guarantee-dynamic dynamic)
+    (let loop ((env *current-dynamic-environment*))
+      (cond ((not env)
+--- 79,85 ----
+  (define dynamic:errmsg
+    "No value defined for this dynamic in the current dynamic environment")
+  
+! (define-integrable (dynamic-ref dynamic)
+    (guarantee-dynamic dynamic)
+    (let loop ((env *current-dynamic-environment*))
+      (cond ((not env)
+***************
+*** 79,85 ****
+  	  (else
+  	   (loop (dynamic-environment:parent env))))))
+  
+! (define (dynamic-set! dynamic obj)
+    (guarantee-dynamic dynamic)
+    (let loop ((env *current-dynamic-environment*))
+      (cond ((not env)
+--- 89,95 ----
+  	  (else
+  	   (loop (dynamic-environment:parent env))))))
+  
+! (define-integrable (dynamic-set! dynamic obj)
+    (guarantee-dynamic dynamic)
+    (let loop ((env *current-dynamic-environment*))
+      (cond ((not env)
+diff -c slib/format.scm nlib/format.scm
+*** slib/format.scm	Tue Jan  5 14:56:48 1993
+--- nlib/format.scm	Tue Feb  9 00:21:09 1993
+***************
+*** 78,84 ****
+  ;   * removed C-style padding support
+  ;
+  
+! ;;; SCHEME IMPLEMENTATION DEPENDENCIES ---------------------------------------
+  
+  ;; To configure the format module for your scheme system, set the variable
+  ;; format:scheme-system to one of the symbols of (slib elk any). You may add
+--- 78,88 ----
+  ;   * removed C-style padding support
+  ;
+  
+! ;;; SCHEME IMPLEMENTATION DEPENDENCIES
+! ;;; ---------------------------------------
+! 
+! ;;; (minimal) Declarations for CScheme
+! (declare (usual-integrations))
+  
+  ;; To configure the format module for your scheme system, set the variable
+  ;; format:scheme-system to one of the symbols of (slib elk any). You may add
+diff -c slib/genwrite.scm nlib/genwrite.scm
+*** slib/genwrite.scm	Mon Oct 19 14:49:06 1992
+--- nlib/genwrite.scm	Tue Feb  9 00:21:10 1993
+***************
+*** 26,31 ****
+--- 26,34 ----
+  ;
+  ; where display-string = (lambda (s) (for-each write-char (string->list s)) #t)
+  
++ ;;; (minimal) Declarations for CScheme
++ (declare (usual-integrations))
++ 
+  (define (generic-write obj display? width output)
+  
+    (define (read-macro? l)
+diff -c slib/hash.scm nlib/hash.scm
+*** slib/hash.scm	Thu Sep 10 00:05:52 1992
+--- nlib/hash.scm	Tue Feb  9 00:21:10 1993
+***************
+*** 23,35 ****
+  ;the equality predicate pred.  Pred should be EQ?, EQV?, EQUAL?, =,
+  ;CHAR=?, CHAR-CI=?, STRING=?, or STRING-CI=?.
+   
+! (define (hash:hash-char char n)
+    (modulo (char->integer char) n))
+  
+! (define (hash:hash-char-ci char n)
+    (modulo (char->integer (char-downcase char)) n))
+  
+! (define (hash:hash-symbol sym n)
+    (hash:hash-string (symbol->string sym) n))
+  
+  ;;; I am trying to be careful about overflow and underflow here.
+--- 23,40 ----
+  ;the equality predicate pred.  Pred should be EQ?, EQV?, EQUAL?, =,
+  ;CHAR=?, CHAR-CI=?, STRING=?, or STRING-CI=?.
+   
+! 
+! ;;; Declarations for CScheme
+! (declare (usual-integrations))
+! (declare (integrate hash))
+! 
+! (define-integrable (hash:hash-char char n)
+    (modulo (char->integer char) n))
+  
+! (define-integrable (hash:hash-char-ci char n)
+    (modulo (char->integer (char-downcase char)) n))
+  
+! (define-integrable (hash:hash-symbol sym n)
+    (hash:hash-string (symbol->string sym) n))
+  
+  ;;; I am trying to be careful about overflow and underflow here.
+***************
+*** 173,179 ****
+  
+  (define hashq hashv)
+  
+! (define (predicate->hash pred)
+    (cond ((eq? pred eq?) hashq)
+  	((eq? pred eqv?) hashv)
+  	((eq? pred equal?) hash)
+--- 178,184 ----
+  
+  (define hashq hashv)
+  
+! (define-integrable (predicate->hash pred)
+    (cond ((eq? pred eq?) hashq)
+  	((eq? pred eqv?) hashv)
+  	((eq? pred equal?) hash)
+diff -c slib/hashtab.scm nlib/hashtab.scm
+*** slib/hashtab.scm	Mon Oct 19 14:49:44 1992
+--- nlib/hashtab.scm	Tue Feb  9 00:21:11 1993
+***************
+*** 36,47 ****
+  ;Returns a procedure of 2 arguments, hashtab and key, which modifies
+  ;hashtab so that the association whose key is key removed.
+  
+  (require 'hash)
+  (require 'alist)
+  
+! (define (make-hash-table k) (make-vector k '()))
+  
+! (define (predicate->hash-asso pred)
+    (let ((hashfun (predicate->hash pred))
+  	(asso (predicate->asso pred)))
+      (lambda (key hashtab)
+--- 36,53 ----
+  ;Returns a procedure of 2 arguments, hashtab and key, which modifies
+  ;hashtab so that the association whose key is key removed.
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate-external "hash"))
++ (declare (integrate-external "alist"))
++ 
+  (require 'hash)
+  (require 'alist)
+  
+! (define-integrable (make-hash-table k) (make-vector k '()))
+  
+! (define-integrable (predicate->hash-asso pred)
+    (let ((hashfun (predicate->hash pred))
+  	(asso (predicate->asso pred)))
+      (lambda (key hashtab)
+***************
+*** 48,54 ****
+        (asso key
+  	    (vector-ref hashtab (hashfun key (vector-length hashtab)))))))
+  
+! (define (hash-inquirer pred)
+    (let ((hashfun (predicate->hash pred))
+  	(ainq (alist-inquirer pred)))
+      (lambda (hashtab key)
+--- 54,60 ----
+        (asso key
+  	    (vector-ref hashtab (hashfun key (vector-length hashtab)))))))
+  
+! (define-integrable (hash-inquirer pred)
+    (let ((hashfun (predicate->hash pred))
+  	(ainq (alist-inquirer pred)))
+      (lambda (hashtab key)
+***************
+*** 55,61 ****
+        (ainq (vector-ref hashtab (hashfun key (vector-length hashtab)))
+  	    key))))
+  
+! (define (hash-associator pred)
+    (let ((hashfun (predicate->hash pred))
+  	(asso (alist-associator pred)))
+      (lambda (hashtab key val)
+--- 61,67 ----
+        (ainq (vector-ref hashtab (hashfun key (vector-length hashtab)))
+  	    key))))
+  
+! (define-integrable (hash-associator pred)
+    (let ((hashfun (predicate->hash pred))
+  	(asso (alist-associator pred)))
+      (lambda (hashtab key val)
+***************
+*** 64,70 ****
+  		     (asso (vector-ref hashtab num) key val)))
+        hashtab)))
+  
+! (define (hash-remover pred)
+    (let ((hashfun (predicate->hash pred))
+  	(arem (alist-remover pred)))
+      (lambda (hashtab key)
+--- 70,76 ----
+  		     (asso (vector-ref hashtab num) key val)))
+        hashtab)))
+  
+! (define-integrable (hash-remover pred)
+    (let ((hashfun (predicate->hash pred))
+  	(arem (alist-remover pred)))
+      (lambda (hashtab key)
+diff -c slib/lineio.scm nlib/lineio.scm
+*** slib/lineio.scm	Sun Oct 25 01:40:38 1992
+--- nlib/lineio.scm	Tue Feb  9 00:21:11 1993
+***************
+*** 28,33 ****
+--- 28,36 ----
+  ;unspecified value.  Port may be ommited, in which case it defaults to
+  ;the value returned by current-input-port.
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
+  (define (read-line . arg)
+    (let* ((char (apply read-char arg)))
+      (if (eof-object? char)
+***************
+*** 56,61 ****
+  			(+ 1 i) #f))))
+  	  (string-set! str i char)))))
+  
+! (define (write-line str . arg)
+    (apply display str arg)
+    (apply newline arg))
+--- 59,64 ----
+  			(+ 1 i) #f))))
+  	  (string-set! str i char)))))
+  
+! (define-integrable (write-line str . arg)
+    (apply display str arg)
+    (apply newline arg))
+diff -c slib/logical.scm nlib/logical.scm
+*** slib/logical.scm	Mon Feb  1 22:22:04 1993
+--- nlib/logical.scm	Tue Feb  9 00:21:11 1993
+***************
+*** 48,53 ****
+--- 48,66 ----
+  ;
+  ;;;;------------------------------------------------------------------
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate logand		; Exported functions
++ 		    logor
++ 		    logxor
++ 		    lognot
++ 		    ash
++ 		    logcount
++ 		    integer-length
++ 		    bit-extract
++ 		    ipow-by-squaring
++ 		    integer-expt))
++ 
+  (define logical:integer-expt
+    (if (provided? 'inexact)
+        expt
+***************
+*** 61,67 ****
+  					(quotient k 2)
+  					(if (even? k) acc (proc acc x))
+  					proc))))
+- 
+  (define (logical:logand n1 n2)
+    (cond ((= n1 n2) n1)
+  	((zero? n1) 0)
+--- 74,79 ----
+***************
+*** 90,102 ****
+  	    (vector-ref (vector-ref logical:boole-xor (modulo n1 16))
+  			(modulo n2 16))))))
+  
+! (define (logical:lognot n) (- -1 n))
+  
+! (define (logical:bit-extract n start end)
+    (logical:logand (- (logical:integer-expt 2 (- end start)) 1)
+  		  (logical:ash n (- start))))
+  
+! (define (logical:ash int cnt)
+    (if (negative? cnt)
+        (let ((n (logical:integer-expt 2 (- cnt))))
+  	(if (negative? int)
+--- 102,114 ----
+  	    (vector-ref (vector-ref logical:boole-xor (modulo n1 16))
+  			(modulo n2 16))))))
+  
+! (define-integrable (logical:lognot n) (- -1 n))
+  
+! (define-integrable (logical:bit-extract n start end)
+    (logical:logand (- (logical:integer-expt 2 (- end start)) 1)
+  		  (logical:ash n (- start))))
+  
+! (define-integrable (logical:ash int cnt)
+    (if (negative? cnt)
+        (let ((n (logical:integer-expt 2 (- cnt))))
+  	(if (negative? int)
+***************
+*** 104,110 ****
+  	    (quotient int n)))
+        (* (logical:integer-expt 2 cnt) int)))
+  
+! (define (logical:ash-4 x)
+    (if (negative? x)
+        (+ -1 (quotient (+ 1 x) 16))
+        (quotient x 16)))
+--- 116,122 ----
+  	    (quotient int n)))
+        (* (logical:integer-expt 2 cnt) int)))
+  
+! (define-integrable (logical:ash-4 x)
+    (if (negative? x)
+        (+ -1 (quotient (+ 1 x) 16))
+        (quotient x 16)))
+diff -c slib/mitscheme.init nlib/mitscheme.init
+*** slib/mitscheme.init	Fri Jan 22 00:52:04 1993
+--- nlib/mitscheme.init	Tue Feb  9 00:21:12 1993
+***************
+*** 48,55 ****
+  
+  ;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+  ;;; use this definition if your system doesn't have such a procedure.
+! ;(define (force-output . arg) #t)
+! (define force-output flush-output)
+  
+  ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+  ;;; be returned by CHAR->INTEGER.  It is defined by MITScheme.
+--- 47,54 ----
+  
+  ;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+  ;;; use this definition if your system doesn't have such a procedure.
+! (define (force-output . arg) #t)
+! ;(define force-output flush-output)
+  
+  ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+  ;;; be returned by CHAR->INTEGER.  It is defined by MITScheme.
+diff -c slib/modular.scm nlib/modular.scm
+*** slib/modular.scm	Sun Feb  2 12:53:26 1992
+--- nlib/modular.scm	Tue Feb  9 00:21:13 1993
+***************
+*** 36,41 ****
+--- 36,48 ----
+  ;Returns (k2 ^ k3) mod k1.
+  ;
+  ;;;;--------------------------------------------------------------
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate-external "logical"))
++ (declare (integrate modular:negate  extended-euclid))
++ 
+  (require 'logical)
+  
+  ;;; from:
+***************
+*** 51,57 ****
+  	      (caddr res)
+  	      (- (cadr res) (* (quotient a b) (caddr res)))))))
+  
+! (define (modular:invert m a)
+    (let ((d (modular:extended-euclid a m)))
+      (if (= 1 (car d))
+  	(modulo (cadr d) m)
+--- 58,64 ----
+  	      (caddr res)
+  	      (- (cadr res) (* (quotient a b) (caddr res)))))))
+  
+! (define-integrable (modular:invert m a)
+    (let ((d (modular:extended-euclid a m)))
+      (if (= 1 (car d))
+  	(modulo (cadr d) m)
+***************
+*** 59,67 ****
+  
+  (define modular:negate -)
+  
+! (define (modular:+ m a b) (modulo (+ (- a m) b) m))
+  
+! (define (modular:- m a b) (modulo (- a b) m))
+  
+  ;;; See: L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
+  ;;; with Splitting Facilities." ACM Transactions on Mathematical
+--- 66,74 ----
+  
+  (define modular:negate -)
+  
+! (define-integrable (modular:+ m a b) (modulo (+ (- a m) b) m))
+  
+! (define-integrable (modular:- m a b) (modulo (- a b) m))
+  
+  ;;; See: L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
+  ;;; with Splitting Facilities." ACM Transactions on Mathematical
+***************
+*** 98,104 ****
+  	  (modulo (+ (if (positive? p) (- p m) p)
+  		     (* a0 (modulo b q))) m)))))
+  
+! (define (modular:expt m a b)
+    (cond ((= a 1) 1)
+  	((= a (- m 1)) (if (odd? b) a 1))
+  	((zero? a) 0)
+--- 105,111 ----
+  	  (modulo (+ (if (positive? p) (- p m) p)
+  		     (* a0 (modulo b q))) m)))))
+  
+! (define-integrable (modular:expt m a b)
+    (cond ((= a 1) 1)
+  	((= a (- m 1)) (if (odd? b) a 1))
+  	((zero? a) 0)
+diff -c slib/obj2str.scm nlib/obj2str.scm
+*** slib/obj2str.scm	Mon Oct 19 14:49:08 1992
+--- nlib/obj2str.scm	Tue Feb  9 00:21:13 1993
+***************
+*** 2,13 ****
+  
+  (require 'generic-write)
+  
+  ; (object->string obj) returns the textual representation of 'obj' as a
+  ; string.
+  ;
+  ; Note: (write obj) = (display (object->string obj))
+  
+! (define (object->string obj)
+    (let ((result '()))
+      (generic-write obj #f #f (lambda (str) (set! result (cons str result)) #t))
+      (reverse-string-append result)))
+--- 2,17 ----
+  
+  (require 'generic-write)
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "genwrite"))
++ 
+  ; (object->string obj) returns the textual representation of 'obj' as a
+  ; string.
+  ;
+  ; Note: (write obj) = (display (object->string obj))
+  
+! (define-integrable (object->string obj)
+    (let ((result '()))
+      (generic-write obj #f #f (lambda (str) (set! result (cons str result)) #t))
+      (reverse-string-append result)))
+diff -c slib/pp2str.scm nlib/pp2str.scm
+*** slib/pp2str.scm	Mon Oct 19 14:49:08 1992
+--- nlib/pp2str.scm	Tue Feb  9 00:21:13 1993
+***************
+*** 2,11 ****
+  
+  (require 'generic-write)
+  
+  ; (pretty-print-to-string obj) returns a string with the pretty-printed
+  ; textual representation of 'obj'.
+  
+! (define (pp:pretty-print-to-string obj)
+    (let ((result '()))
+      (generic-write obj #f 79 (lambda (str) (set! result (cons str result)) #t))
+      (reverse-string-append result)))
+--- 2,16 ----
+  
+  (require 'generic-write)
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "genwrite"))
++ (declare (integrate pretty-print-to-string))
++ 
+  ; (pretty-print-to-string obj) returns a string with the pretty-printed
+  ; textual representation of 'obj'.
+  
+! (define-integrable (pp:pretty-print-to-string obj)
+    (let ((result '()))
+      (generic-write obj #f 79 (lambda (str) (set! result (cons str result)) #t))
+      (reverse-string-append result)))
+diff -c slib/ppfile.scm nlib/ppfile.scm
+*** slib/ppfile.scm	Mon Oct 19 14:49:08 1992
+--- nlib/ppfile.scm	Tue Feb  9 00:21:14 1993
+***************
+*** 10,15 ****
+--- 10,19 ----
+  ;
+  (require 'pretty-print)
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "pp"))
++ 
+  (define (pprint-file ifile . optarg)
+    (let ((lst (call-with-input-file ifile
+  	       (lambda (iport)
+diff -c slib/prime.scm nlib/prime.scm
+*** slib/prime.scm	Mon Feb  8 20:49:46 1993
+--- nlib/prime.scm	Tue Feb  9 00:24:16 1993
+***************
+*** 24,29 ****
+--- 24,39 ----
+  ;(sort! (factor k) <)
+  
+  ;;;;--------------------------------------------------------------
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "random"))
++ (declare (integrate-external "modular"))
++ (declare (integrate
++ 	  jacobi-symbol 
++ 	  prime?
++ 	  factor))
++ 
++ 
+  (require 'random)
+  (require 'modular)
+  
+***************
+*** 56,62 ****
+  ;;;     choosing prime:trials=30 should be enough
+  (define prime:trials 30)
+  ;;; prime:product is a product of small primes.
+! (define prime:product
+    (let ((p 210))
+      (for-each (lambda (s) (set! p (or (string->number s) p)))
+        '("2310" "30030" "510510" "9699690" "223092870"
+--- 66,72 ----
+  ;;;     choosing prime:trials=30 should be enough
+  (define prime:trials 30)
+  ;;; prime:product is a product of small primes.
+! (define-integrable prime:product
+    (let ((p 210))
+      (for-each (lambda (s) (set! p (or (string->number s) p)))
+        '("2310" "30030" "510510" "9699690" "223092870"
+***************
+*** 86,92 ****
+  ;                  |  f(u,v,2b,n/2) or f(u+b,v+b,2b,(n-u-v-b)/2) if n even
+  
+  ;Thm: f(1,1,2,(m-1)/2) = (p,q) iff pq=m for odd m.
+!  
+  ;It may be illuminating to consider the relation of the Lankinen function in
+  ;a `computational hierarchy' of other factoring functions.*  Assumptions are
+  ;made herein on the basis of conventional digital (binary) computers.  Also,
+--- 96,102 ----
+  ;                  |  f(u,v,2b,n/2) or f(u+b,v+b,2b,(n-u-v-b)/2) if n even
+  
+  ;Thm: f(1,1,2,(m-1)/2) = (p,q) iff pq=m for odd m.
+! 
+  ;It may be illuminating to consider the relation of the Lankinen function in
+  ;a `computational hierarchy' of other factoring functions.*  Assumptions are
+  ;made herein on the basis of conventional digital (binary) computers.  Also,
+***************
+*** 94,100 ****
+  ;be factored is prime).  However, all algorithms would probably perform to
+  ;the same constant multiple of the given orders for complete composite
+  ;factorizations.
+!  
+  ;Thm: Eratosthenes' Sieve is very roughtly O(ln(n)/n) in time and
+  ;     O(n*log2(n)) in space.
+  ;Pf: It works with all prime factors less than n (about ln(n)/n by the prime
+--- 104,110 ----
+  ;be factored is prime).  However, all algorithms would probably perform to
+  ;the same constant multiple of the given orders for complete composite
+  ;factorizations.
+! 
+  ;Thm: Eratosthenes' Sieve is very roughtly O(ln(n)/n) in time and
+  ;     O(n*log2(n)) in space.
+  ;Pf: It works with all prime factors less than n (about ln(n)/n by the prime
+diff -c slib/priorque.scm nlib/priorque.scm
+*** slib/priorque.scm	Mon Oct 19 14:49:42 1992
+--- nlib/priorque.scm	Tue Feb  9 00:21:15 1993
+***************
+*** 22,41 ****
+  ;;; 1989 MIT Press.
+  
+  (require 'record)
+  (define heap-rtd (make-record-type "heap" '(array size heap<?)))
+! (define make-heap
+    (let ((cstr (record-constructor heap-rtd)))
+      (lambda (pred<?)
+        (cstr (make-vector 4) 0 pred<?))))
+! (define heap-ref
+    (let ((ra (record-accessor heap-rtd 'array)))
+      (lambda (a i)
+        (vector-ref (ra a) (+ -1 i)))))
+! (define heap-set!
+    (let ((ra (record-accessor heap-rtd 'array)))
+      (lambda (a i v)
+        (vector-set! (ra a) (+ -1 i) v))))
+! (define heap-exchange
+    (let ((aa (record-accessor heap-rtd 'array)))
+      (lambda (a i j)
+        (set! i (+ -1 i))
+--- 22,53 ----
+  ;;; 1989 MIT Press.
+  
+  (require 'record)
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate
++ 	  heap-size
++ 	  heap<?))
++ 
+  (define heap-rtd (make-record-type "heap" '(array size heap<?)))
+! 
+! (define-integrable make-heap
+    (let ((cstr (record-constructor heap-rtd)))
+      (lambda (pred<?)
+        (cstr (make-vector 4) 0 pred<?))))
+! 
+! (define-integrable heap-ref
+    (let ((ra (record-accessor heap-rtd 'array)))
+      (lambda (a i)
+        (vector-ref (ra a) (+ -1 i)))))
+! 
+! (define-integrable heap-set!
+    (let ((ra (record-accessor heap-rtd 'array)))
+      (lambda (a i v)
+        (vector-set! (ra a) (+ -1 i) v))))
+! 
+! (define-integrable heap-exchange
+    (let ((aa (record-accessor heap-rtd 'array)))
+      (lambda (a i j)
+        (set! i (+ -1 i))
+***************
+*** 44,51 ****
+--- 56,66 ----
+  	     (tmp (vector-ref ra i)))
+  	(vector-set! ra i (vector-ref ra j))
+  	(vector-set! ra j tmp)))))
++ 
+  (define heap-size (record-accessor heap-rtd 'size))
++ 
+  (define heap<? (record-accessor heap-rtd 'heap<?))
++ 
+  (define heap-set-size
+    (let ((aa (record-accessor heap-rtd 'array))
+  	(am (record-modifier heap-rtd 'array))
+***************
+*** 59,68 ****
+  		(vector-set! nra i (vector-ref ra i)))))
+  	(sm a s)))))
+  
+! (define (heap-parent i) (quotient i 2))
+! (define (heap-left i) (* 2 i))
+! (define (heap-right i) (+ 1 (* 2 i)))
+  
+  (define (heapify a i)
+    (define l (heap-left i))
+    (define r (heap-right i))
+--- 74,85 ----
+  		(vector-set! nra i (vector-ref ra i)))))
+  	(sm a s)))))
+  
+! (define-integrable (heap-parent i) (quotient i 2))
+  
++ (define-integrable (heap-left i) (* 2 i))
++ 
++ (define-integrable (heap-right i) (+ 1 (* 2 i)))
++ 
+  (define (heapify a i)
+    (define l (heap-left i))
+    (define r (heap-right i))
+***************
+*** 99,104 ****
+--- 116,122 ----
+      max))
+  
+  (define heap #f)
++ 
+  (define (heap-test)
+    (set! heap (make-heap char>?))
+    (heap-insert! heap #\A)
+diff -c slib/process.scm nlib/process.scm
+*** slib/process.scm	Wed Nov  4 12:26:50 1992
+--- nlib/process.scm	Tue Feb  9 00:21:15 1993
+***************
+*** 21,30 ****
+  ;
+  ;;;;----------------------------------------------------------------------
+  
+  (require 'full-continuation)
+  (require 'queue)
+  
+! (define (add-process! thunk1)
+    (cond ((procedure? thunk1)
+  	 (defer-ints)
+  	 (enqueue! process:queue thunk1)
+--- 21,33 ----
+  ;
+  ;;;;----------------------------------------------------------------------
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
+  (require 'full-continuation)
+  (require 'queue)
+  
+! (define-integrable (add-process! thunk1)
+    (cond ((procedure? thunk1)
+  	 (defer-ints)
+  	 (enqueue! process:queue thunk1)
+***************
+*** 55,63 ****
+  (define ints-disabled #f)
+  (define alarm-deferred #f)
+  
+! (define (defer-ints) (set! ints-disabled #t))
+  
+! (define (allow-ints)
+    (set! ints-disabled #f)
+    (cond (alarm-deferred
+  	  (set! alarm-deferred #f)
+--- 58,66 ----
+  (define ints-disabled #f)
+  (define alarm-deferred #f)
+  
+! (define-integrable (defer-ints) (set! ints-disabled #t))
+  
+! (define-integrable (allow-ints)
+    (set! ints-disabled #f)
+    (cond (alarm-deferred
+  	  (set! alarm-deferred #f)
+***************
+*** 66,72 ****
+  ;;; Make THE process queue.
+  (define process:queue (make-queue))
+  
+! (define (alarm-interrupt)
+    (alarm 1)
+    (if ints-disabled (set! alarm-deferred #t)
+        (process:schedule!)))
+--- 69,75 ----
+  ;;; Make THE process queue.
+  (define process:queue (make-queue))
+  
+! (define-integrable (alarm-interrupt)
+    (alarm 1)
+    (if ints-disabled (set! alarm-deferred #t)
+        (process:schedule!)))
+diff -c slib/randinex.scm nlib/randinex.scm
+*** slib/randinex.scm	Wed Nov 18 22:59:20 1992
+--- nlib/randinex.scm	Tue Feb  9 00:21:16 1993
+***************
+*** 47,52 ****
+--- 47,59 ----
+  ;For an exponential distribution with mean U use (* U (random:exp)).
+  ;;;;-----------------------------------------------------------------
+  
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "random"))
++ (declare (integrate
++ 	  random:float-radix))
++ 
+  (define random:float-radix
+    (+ 1 (exact->inexact random:MASK)))
+  
+***************
+*** 56,61 ****
+--- 63,69 ----
+    (if (= 1.0 (+ 1 x))
+        l
+        (random:size-float (+ l 1) (/ x random:float-radix))))
++ 
+  (define random:chunks/float (random:size-float 1 1.0))
+  
+  (define (random:uniform-chunk n state)
+***************
+*** 67,73 ****
+  	 random:float-radix)))
+  
+  ;;; Generate an inexact real between 0 and 1.
+! (define (random:uniform state)
+    (random:uniform-chunk random:chunks/float state))
+  
+  ;;; If x and y are independent standard normal variables, then with
+--- 75,81 ----
+  	 random:float-radix)))
+  
+  ;;; Generate an inexact real between 0 and 1.
+! (define-integrable (random:uniform state)
+    (random:uniform-chunk random:chunks/float state))
+  
+  ;;; If x and y are independent standard normal variables, then with
+***************
+*** 89,95 ****
+  	  (do! n (* r (cos t)))
+  	  (if (positive? n) (do! (- n 1) (* r (sin t)))))))))
+  
+! (define random:normal
+    (let ((vect (make-vector 1)))
+      (lambda args 
+        (apply random:normal-vector! vect args)
+--- 97,103 ----
+  	  (do! n (* r (cos t)))
+  	  (if (positive? n) (do! (- n 1) (* r (sin t)))))))))
+  
+! (define-integrable random:normal
+    (let ((vect (make-vector 1)))
+      (lambda args 
+        (apply random:normal-vector! vect args)
+***************
+*** 98,104 ****
+  ;;; For the uniform distibution on the hollow sphere, pick a normal
+  ;;; family and scale.
+  
+! (define (random:hollow-sphere! vect . args)
+    (let ((ms (sqrt (apply random:normal-vector! vect args))))
+      (do ((n (- (vector-length vect) 1) (- n 1)))
+  	((negative? n))
+--- 106,112 ----
+  ;;; For the uniform distibution on the hollow sphere, pick a normal
+  ;;; family and scale.
+  
+! (define-integrable (random:hollow-sphere! vect . args)
+    (let ((ms (sqrt (apply random:normal-vector! vect args))))
+      (do ((n (- (vector-length vect) 1) (- n 1)))
+  	((negative? n))
+***************
+*** 117,123 ****
+  	((negative? n))
+        (vector-set! vect n (* r (vector-ref vect n))))))
+  
+! (define (random:exp . args)
+    (let ((state (if (null? args) *random-state* (car args))))
+      (- (log (random:uniform state)))))
+  
+--- 125,131 ----
+  	((negative? n))
+        (vector-set! vect n (* r (vector-ref vect n))))))
+  
+! (define-integrable (random:exp . args)
+    (let ((state (if (null? args) *random-state* (car args))))
+      (- (log (random:uniform state)))))
+  
+diff -c slib/random.scm nlib/random.scm
+*** slib/random.scm	Tue Feb  2 00:02:58 1993
+--- nlib/random.scm	Tue Feb  9 00:21:18 1993
+***************
+*** 35,40 ****
+--- 35,50 ----
+  ;procedures for generating inexact distributions.
+  ;;;;------------------------------------------------------------------
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "logical"))
++ (declare (integrateb
++ 	  random:tap-1
++ 	  random:size
++ 	  random:chunk-size
++ 	  random:MASK
++ 	  random))
++ 
+  (require 'logical)
+  
+  (define random:tap 24)
+***************
+*** 45,50 ****
+--- 55,61 ----
+    (if (and (exact? trial) (>= most-positive-fixnum trial))
+        l
+        (random:size-int (- l 1)))))
++ 
+  (define random:chunk-size (* 4 (random:size-int 8)))
+  
+  (define random:MASK
+***************
+*** 107,113 ****
+  ;;;random:uniform is in randinex.scm.  It is needed only if inexact is
+  ;;;supported.
+  
+! (define (random:make-random-state . args)
+    (let ((state (if (null? args) *random-state* (car args))))
+      (list->vector (vector->list state))))
+  
+--- 118,124 ----
+  ;;;random:uniform is in randinex.scm.  It is needed only if inexact is
+  ;;;supported.
+  
+! (define-integrable (random:make-random-state . args)
+    (let ((state (if (null? args) *random-state* (car args))))
+      (list->vector (vector->list state))))
+  
+diff -c slib/rbtree.scm nlib/rbtree.scm
+*** slib/rbtree.scm	Sat Jan  9 13:40:56 1993
+--- nlib/rbtree.scm	Tue Feb  9 00:21:18 1993
+***************
+*** 5,11 ****
+--- 5,24 ----
+  ;;;; PGS, 6 Jul 1990
+  ;;; jaffer@ai.mit.edu Ported to SLIB, 1/6/93
+  
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate 
++ 	  rb-tree-root
++ 	  set-rb-tree-root!
++ 	  rb-tree-left-rotation-field-maintainer
++ 	  rb-tree-right-rotation-field-maintainer
++ 	  rb-tree-insertion-field-maintainer
++ 	  rb-tree-deletion-field-maintainer
++ 	  rb-tree-prior?))
++ 
+  (require 'record)
++ 
+  (define rb-tree
+    (make-record-type
+     "rb-tree"
+***************
+*** 227,233 ****
+  	   y)
+  	(set! x y)
+  	(set! y (rb-node-parent y)))))
+- 
+  
+  ;;;; Deletion.  We do not entirely follow Cormen, Leiserson and Rivest's lead
+  ;;;; here, because their use of sentinels is in rather obscenely poor taste.
+--- 240,245 ----
+diff -c slib/sort.scm nlib/sort.scm
+*** slib/sort.scm	Wed Nov  6 00:50:38 1991
+--- nlib/sort.scm	Tue Feb  9 00:22:03 1993
+***************
+*** 118,123 ****
+--- 118,125 ----
+  ;   in Scheme.
+  ;;; --------------------------------------------------------------------
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))		; Honestly, nothing defined here clashes!
+  
+  ;;; (sorted? sequence less?)
+  ;;; is true when sequence is a list (x0 x1 ... xm) or a vector #(x0 ... xm)
+diff -c slib/printf.scm nlib/printf.scm
+*** slib/printf.scm	Mon Oct 19 14:48:58 1992
+--- nlib/printf.scm	Tue Feb  9 00:22:03 1993
+***************
+*** 3,8 ****
+--- 3,19 ----
+  
+  ;;; Floating point is not handled yet.  It should not be hard to do.
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate 
++ 	  printf
++ 	  fprintf
++ 	  sprintf
++ 	  stdin
++ 	  stdout
++ 	  stderr))
++ 
+  (define (stdio:iprintf out format . args)
+    (let loop ((pos 0) (args args))
+      (if (< pos (string-length format))
+***************
+*** 96,105 ****
+  	  (else (out (string-ref format pos))
+  		(loop (+ pos 1) args))))))
+  
+! (define (stdio:printf format . args)
+    (apply stdio:iprintf display format args))
+  
+! (define (stdio:fprintf port format . args)
+    (if (equal? port (current-output-port))
+        (apply stdio:iprintf display format args)
+        (apply stdio:iprintf (lambda (x) (display x port)) format args)))
+--- 107,116 ----
+  	  (else (out (string-ref format pos))
+  		(loop (+ pos 1) args))))))
+  
+! (define-integrable (stdio:printf format . args)
+    (apply stdio:iprintf display format args))
+  
+! (define-integrable (stdio:fprintf port format . args)
+    (if (equal? port (current-output-port))
+        (apply stdio:iprintf display format args)
+        (apply stdio:iprintf (lambda (x) (display x port)) format args)))
+diff -c slib/strcase.scm nlib/strcase.scm
+*** slib/strcase.scm	Wed Nov 18 14:15:18 1992
+--- nlib/strcase.scm	Tue Feb  9 00:22:03 1993
+***************
+*** 8,27 ****
+  ;string-upcase!, string-downcase!, string-capitalize!
+  ; are destructive versions.
+  
+! (define (string-upcase! str)
+    (do ((i (- (string-length str) 1) (- i 1)))
+        ((< i 0) str)
+      (string-set! str i (char-upcase (string-ref str i)))))
+  
+! (define (string-upcase str)
+    (string-upcase! (string-copy str)))
+    
+! (define (string-downcase! str)
+    (do ((i (- (string-length str) 1) (- i 1)))
+        ((< i 0) str)
+      (string-set! str i (char-downcase (string-ref str i)))))
+  
+! (define (string-downcase str)
+    (string-downcase! (string-copy str)))
+  
+  (define (string-capitalize! str)	; "hello" -> "Hello"
+--- 8,30 ----
+  ;string-upcase!, string-downcase!, string-capitalize!
+  ; are destructive versions.
+  
+! ;;; Declarations for CScheme
+! (declare (usual-integrations))
+! 
+! (define-integrable (string-upcase! str)
+    (do ((i (- (string-length str) 1) (- i 1)))
+        ((< i 0) str)
+      (string-set! str i (char-upcase (string-ref str i)))))
+  
+! (define-integrable (string-upcase str)
+    (string-upcase! (string-copy str)))
+    
+! (define-integrable (string-downcase! str)
+    (do ((i (- (string-length str) 1) (- i 1)))
+        ((< i 0) str)
+      (string-set! str i (char-downcase (string-ref str i)))))
+  
+! (define-integrable (string-downcase str)
+    (string-downcase! (string-copy str)))
+  
+  (define (string-capitalize! str)	; "hello" -> "Hello"
+***************
+*** 38,42 ****
+  		  (string-set! str i (char-upcase c))))
+  	    (set! non-first-alpha #f))))))
+  
+! (define (string-capitalize str)
+    (string-capitalize! (string-copy str)))
+--- 41,45 ----
+  		  (string-set! str i (char-upcase c))))
+  	    (set! non-first-alpha #f))))))
+  
+! (define-integrable (string-capitalize str)
+    (string-capitalize! (string-copy str)))
+diff -c slib/synchk.scm nlib/synchk.scm
+*** slib/synchk.scm	Mon Jan 27 09:28:48 1992
+--- nlib/synchk.scm	Tue Feb  9 00:22:03 1993
+***************
+*** 35,45 ****
+  ;;; written by Alan Bawden
+  ;;; modified by Chris Hanson
+  
+! (define (syntax-check pattern form)
+    (if (not (syntax-match? (cdr pattern) (cdr form)))
+        (syntax-error "ill-formed special form" form)))
+  
+! (define (ill-formed-syntax form)
+    (syntax-error "ill-formed special form" form))
+  
+  (define (syntax-match? pattern object)
+--- 35,48 ----
+  ;;; written by Alan Bawden
+  ;;; modified by Chris Hanson
+  
+! ;;; Declarations for CScheme
+! (declare (usual-integrations))
+! 
+! (define-integrable (syntax-check pattern form)
+    (if (not (syntax-match? (cdr pattern) (cdr form)))
+        (syntax-error "ill-formed special form" form)))
+  
+! (define-integrable (ill-formed-syntax form)
+    (syntax-error "ill-formed special form" form))
+  
+  (define (syntax-match? pattern object)