From 916c406a8fedea3c6730edbbb56ad960cfd84dbc Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 18 Jan 1991 19:10:09 +0000
Subject: [PATCH] Initial revision

---
 v7/src/rcs/format.scm | 114 ++++++++++++++++++++
 v7/src/rcs/logmer.scm | 236 ++++++++++++++++++++++++++++++++++++++++++
 v7/src/rcs/make.scm   |  40 +++++++
 v7/src/rcs/mklogs.scm |  20 ++++
 v7/src/rcs/object.scm | 166 +++++++++++++++++++++++++++++
 v7/src/rcs/rcs.pkg    |  60 +++++++++++
 v7/src/rcs/rcs.sf     |  45 ++++++++
 v7/src/rcs/scheme.scm |  44 ++++++++
 8 files changed, 725 insertions(+)
 create mode 100644 v7/src/rcs/format.scm
 create mode 100644 v7/src/rcs/logmer.scm
 create mode 100644 v7/src/rcs/make.scm
 create mode 100644 v7/src/rcs/mklogs.scm
 create mode 100644 v7/src/rcs/object.scm
 create mode 100644 v7/src/rcs/rcs.pkg
 create mode 100644 v7/src/rcs/rcs.sf
 create mode 100644 v7/src/rcs/scheme.scm

diff --git a/v7/src/rcs/format.scm b/v7/src/rcs/format.scm
new file mode 100644
index 000000000..bfeca9b14
--- /dev/null
+++ b/v7/src/rcs/format.scm
@@ -0,0 +1,114 @@
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/format.scm,v 1.1 1991/01/18 19:07:22 cph Exp $
+
+Copyright (c) 1987 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  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. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; RCS Format
+
+(declare (usual-integrations))
+(declare (integrate-external "object"))
+
+(define (rcs/format rcstext)
+  (let ((head (rcstext/head rcstext)))
+    (write-string "head:            ")
+    (write-string (delta/number head))
+    (write-string "\nlocks:         ")
+    (if (null? (rcstext/locks rcstext))
+	(write-string "  ")
+	(for-each format/lock (rcstext/locks rcstext)))
+    (write-string ";")
+    (if (rcstext/strict? rcstext)
+	(write-string "  strict"))
+    (write-string "\naccess list:   ")
+    (for-each format/user (rcstext/access rcstext))
+    (write-string "\nsymbolic names:")
+    (for-each format/symbol (rcstext/symbols rcstext))
+    (write-string "\ncomment leader:  \"")
+    (write-string (rcstext/comment rcstext))
+    (write-string "\"")
+    (write-string "\ndescription:\n")
+    (format/delta-trunk head)
+    (format/delta-tree head)
+    (write-string "=============================================================================\n")))
+
+(define (format/lock lock)
+  (write-string "  ")
+  (write (car lock))
+  (write-string ": ")
+  (write-string (delta/number (cdr lock))))
+
+(define (format/user user)
+  (write-string "  ")
+  (write user))
+
+(define (format/symbol symbol)
+  (write-string "  ")
+  (write (car symbol))
+  (write-string ": ")
+  (write-string (delta/number (cdr symbol))))
+
+(define (format/delta-trunk head)
+  (let loop ((delta head))
+    (if delta
+	(begin (format/delta delta)
+	       (loop (delta/next delta))))))
+
+(define (format/delta-tree head)
+  (if head
+      (begin (format/delta-tree (delta/next head))
+	     (format/delta-forest (delta/branches head)))))
+
+(define (format/delta-forest branches)
+  (if (not (null? branches))
+      (begin (format/delta-forest (cdr branches))
+	     (format/delta-branch (car branches))
+	     (format/delta-tree (car branches)))))
+
+(define (format/delta-branch branch)
+  (if branch
+      (begin (format/delta-branch (delta/next branch))
+	     (format/delta branch))))
+
+(define (format/delta delta)
+  (write-string "----------------------------\nrevision ")
+  (write-string (delta/number delta))
+  (write-string "\ndate: ")
+  (format/date (delta/date delta))
+  (write-string ";  author: ")
+  (write (delta/author delta))
+  (write-string ";  state: ")
+  (write (delta/state delta))
+  (newline)
+  (write-string (delta/log delta)))
+
+(define (format/date date)
+  (write-string (date->string date)))
\ No newline at end of file
diff --git a/v7/src/rcs/logmer.scm b/v7/src/rcs/logmer.scm
new file mode 100644
index 000000000..fa19136dd
--- /dev/null
+++ b/v7/src/rcs/logmer.scm
@@ -0,0 +1,236 @@
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/logmer.scm,v 1.1 1991/01/18 19:07:39 cph Exp $
+
+Copyright (c) 1988 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  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. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; RCS Log Merge
+
+(declare (usual-integrations))
+(declare (integrate-external "object"))
+
+(define trace-port false)
+
+(define (rcs-directory-log output-file . directories)
+  (format-to-file
+   output-file
+   (fluid-let ((trace-port (cmdl/output-port (nearest-cmdl))))
+     (let ((entries
+	    (sort-entries
+	     (let ((entries
+		    (read-entries
+		     (let ((pathnames (mapcan rcs-directory-read directories)))
+		       (newline trace-port)
+		       (write-string "total files: " trace-port)
+		       (write (length pathnames) trace-port)
+		       pathnames))))
+	       (newline trace-port)
+	       (write-string "total entries: " trace-port)
+	       (write (length entries) trace-port)
+	       entries))))
+       (newline trace-port)
+       (write-string "sorting finished" trace-port)
+       entries))))
+
+(define (format-to-file output-file entries)
+  (with-output-to-file output-file
+    (lambda ()
+      (format/entries entries))))
+
+(define (format/entries entries)
+  (let ((groups (compress-entries entries)))
+    (if (not (null? groups))
+	(begin
+	  (format/group (car groups))
+	  (for-each (lambda (group)
+		      (write-string "----------------------------")
+		      (newline)
+		      (format/group group))
+		    (cdr groups))))))
+
+(define (format/group group)
+  (for-each (lambda (entry)
+	      (format/entry (cdr entry) (car entry)))
+	    group)
+  (newline)
+  (write-string (delta/log (car (car group))))
+  (newline))
+
+(define (format/entry filename delta)
+  (write-string "file: ")
+  (write-string filename)
+  (write-string ";  revision: ")
+  (write-string (delta/number delta))
+  (write-string "\ndate: ")
+  (write-string (date->string (delta/date delta)))
+  (write-string ";  author: ")
+  (write (delta/author delta))
+  (write-string ";  state: ")
+  (write (delta/state delta))
+  (newline))
+
+(define (compress-entries entries)
+  (if (null? entries)
+      '()
+      (let ((entry (car entries)))
+	(let loop
+	    ((entries (cdr entries))
+	     (receiver
+	      (lambda (similar entries)
+		(cons (cons entry similar)
+		      (compress-entries entries)))))
+	  (if (or (null? entries)
+		  (not (string=? (delta/log (car entry))
+				 (delta/log (car (car entries))))))
+	      (receiver '() entries)
+	      (loop (cdr entries)
+		    (lambda (similar entries*)
+		      (receiver (cons (car entries) similar)
+				entries*))))))))
+
+(define (read-entries pathnames)
+  (mapcan (let ((prefix (length (greatest-common-prefix pathnames))))
+	    (lambda (pathname)
+	      (map (let ((filename (working-file-string pathname prefix)))
+		     (lambda (delta)
+		       (cons delta filename)))
+		   (read-file pathname))))
+	  pathnames))
+
+(define (working-file-string pathname prefix)
+  (let ((filename
+	 (pathname->string
+	  (pathname-new-directory
+	   pathname
+	   (let ((directory (list-tail (pathname-directory pathname) prefix)))
+	     (if (and (not (null? directory))
+		      (equal? (car (last-pair directory)) "RCS"))
+		 (except-last-pair directory)
+		 directory))))))
+    (if (string-suffix? ",v" filename)
+	(substring filename 0 (- (string-length filename) 2))
+	filename)))
+
+(define (sort-entries entries)
+  (sort entries
+	(lambda (x y)
+	  (date<? (delta/date (car y)) (delta/date (car x))))))
+
+(define (read-file pathname)
+  (if trace-port
+      (begin
+	(newline trace-port)
+	(write-string "read-file " trace-port)
+	(write-string (pathname->string pathname) trace-port)))
+  (let ((deltas (rcstext->deltas (rcs/read-file pathname 'LOG-ONLY))))
+    (for-each (lambda (delta)
+		(delta/set-log! delta
+				(let ((log (string-trim (delta/log delta))))
+				  (if (string-null? log)
+				      empty-log-message
+				      log))))
+	      deltas)
+    (list-transform-negative deltas delta/trivial-log?)))
+
+(define (delta/trivial-log? delta)
+  (string=? (delta/log delta) "Initial revision"))
+
+(define empty-log-message "*** empty log message ***")
+
+(define (rcstext->deltas rcstext)
+  (let ((head (rcstext/head rcstext)))
+    (if (not head)
+	'()
+	(let loop ((input (list head)) (output '()))
+	  (if (null? input)
+	      output
+	      (let ((input* (append (delta/branches (car input)) (cdr input))))
+		(loop (if (delta/next (car input))
+			  (cons (delta/next (car input)) input*)
+			  input*)
+		      (cons (car input) output))))))))
+
+(define (rcs-directory-read filename)
+  (let ((pathname
+	 (pathname->absolute-pathname
+	  (pathname-as-directory (->pathname filename)))))
+    (map (let ((directory-path (pathname-directory-path pathname)))
+	   (lambda (filename)
+	     (merge-pathnames directory-path (string->pathname filename))))
+	 (list-transform-positive
+	     (generate-filenames (pathname-directory-string pathname))
+	   (lambda (filename)
+	     (string-suffix? ",v" filename))))))
+
+(define (string-suffix? string1 string2)
+  (substring-suffix? string1 0 (string-length string1)
+		     string2 0 (string-length string2)))
+
+(define (substring-suffix? string1 start1 end1 string2 start2 end2)
+  (let ((length (- end1 start1)))
+    (and (<= length (- end2 start2))
+	 (= (substring-match-backward string1 start1 end1
+				      string2 start2 end2)
+	    length))))
+
+(define (generate-filenames directory-string)
+  (let loop ((name (open-directory directory-string)))
+    (if name
+	(cons name (loop (directory-read)))
+	'())))
+
+(define open-directory
+  (make-primitive-procedure 'OPEN-DIRECTORY))
+
+(define directory-read
+  (make-primitive-procedure 'DIRECTORY-READ))
+
+(define (greatest-common-prefix pathnames)
+  (if (null? pathnames)
+      '()
+      (let ((prefix 'NONE))
+	(for-each (lambda (pathname)
+		    (let ((directory (pathname-directory pathname)))
+		      (set! prefix
+			    (if (eq? prefix 'NONE)
+				directory
+				(let common-prefix ((x prefix) (y directory))
+				  (if (or (null? x)
+					  (null? y)
+					  (not (equal? (car x) (car y))))
+				      '()
+				      (cons (car x)
+					    (common-prefix (cdr x)
+							   (cdr y)))))))))
+		  pathnames)
+	(if (equal? prefix '(ROOT))
+	    '()
+	    prefix))))
\ No newline at end of file
diff --git a/v7/src/rcs/make.scm b/v7/src/rcs/make.scm
new file mode 100644
index 000000000..72ec18ddf
--- /dev/null
+++ b/v7/src/rcs/make.scm
@@ -0,0 +1,40 @@
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/make.scm,v 1.1 1991/01/18 19:07:51 cph Exp $
+
+Copyright (c) 1988 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  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. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; Release Control System
+
+(declare (usual-integrations))
+
+(package/system-loader "rcs" '() 'QUERY)
+(add-identification! "RCS" 1 0)
\ No newline at end of file
diff --git a/v7/src/rcs/mklogs.scm b/v7/src/rcs/mklogs.scm
new file mode 100644
index 000000000..764cb5684
--- /dev/null
+++ b/v7/src/rcs/mklogs.scm
@@ -0,0 +1,20 @@
+;;; -*-Scheme-*-
+(let ((rcs-directory-log (access rcs-directory-log (->environment '(RCS)))))
+  (define (make-log directory . subdirectories)
+    (with-working-directory-pathname directory
+      (lambda ()
+	(apply rcs-directory-log
+	       "RCS.log"
+	       (cons "RCS"
+		     (map (lambda (subdirectory)
+			    (string-append subdirectory "/RCS"))
+			  subdirectories))))))
+  (make-log "/scheme/microcode" "m" "s")
+  (make-log "/scheme/runtime")
+  (make-log "/scheme/sf")
+  (make-log "/scheme/cref")
+  (make-log "/scheme/edwin")
+  (make-log "/scheme/sicp")
+  (make-log "/scheme/compiler" "back" "base" "documentation" "etc" "fggen"
+	    "fgopt" "rtlbase" "rtlgen" "rtlopt" "machines/bobcat"
+	    "machines/mips" "machines/spectrum" "machines/vax"))
\ No newline at end of file
diff --git a/v7/src/rcs/object.scm b/v7/src/rcs/object.scm
new file mode 100644
index 000000000..b8d928b69
--- /dev/null
+++ b/v7/src/rcs/object.scm
@@ -0,0 +1,166 @@
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/object.scm,v 1.1 1991/01/18 19:08:04 cph Exp $
+
+Copyright (c) 1988 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  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. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; RCS Data Structures
+
+(declare (usual-integrations))
+
+(define-integrable (rcstext/make head access symbols locks strict? comment
+				 description)
+  (vector rcstext/tag head access symbols locks strict? comment description))
+
+(define rcstext/tag
+  "rcstext")
+
+(define-integrable (rcstext/head rcstext) (vector-ref rcstext 1))
+(define-integrable (rcstext/access rcstext) (vector-ref rcstext 2))
+(define-integrable (rcstext/symbols rcstext) (vector-ref rcstext 3))
+(define-integrable (rcstext/locks rcstext) (vector-ref rcstext 4))
+(define-integrable (rcstext/strict? rcstext) (vector-ref rcstext 5))
+(define-integrable (rcstext/comment rcstext) (vector-ref rcstext 6))
+(define-integrable (rcstext/description rcstext) (vector-ref rcstext 7))
+
+(define-integrable (rcstext/set-head! rcstext head)
+  (vector-set! rcstext 1 head))
+
+(define-integrable (rcstext/set-access! rcstext access)
+  (vector-set! rcstext 2 access))
+
+(define-integrable (rcstext/set-symbols! rcstext symbols)
+  (vector-set! rcstext 3 symbols))
+
+(define-integrable (rcstext/set-locks! rcstext locks)
+  (vector-set! rcstext 4 locks))
+
+(define-integrable (rcstext/set-strict?! rcstext strict?)
+  (vector-set! rcstext 5 strict?))
+
+(define-integrable (rcstext/set-comment! rcstext comment)
+  (vector-set! rcstext 6 comment))
+
+(define-integrable (rcstext/set-description! rcstext description)
+  (vector-set! rcstext 7 description))
+
+(define-integrable (delta/make number)
+  (vector delta/tag number false false false false false false false))
+
+(define delta/tag
+  "delta")
+
+(define-integrable (delta/number delta) (vector-ref delta 1))
+(define-integrable (delta/date delta) (vector-ref delta 2))
+(define-integrable (delta/author delta) (vector-ref delta 3))
+(define-integrable (delta/state delta) (vector-ref delta 4))
+(define-integrable (delta/branches delta) (vector-ref delta 5))
+(define-integrable (delta/next delta) (vector-ref delta 6))
+(define-integrable (delta/log delta) (vector-ref delta 7))
+(define-integrable (delta/text delta) (vector-ref delta 8))
+
+(define-integrable (delta/set-number! delta number)
+  (vector-set! delta 1 number))
+
+(define-integrable (delta/set-date! delta date)
+  (vector-set! delta 2 date))
+
+(define-integrable (delta/set-author! delta author)
+  (vector-set! delta 3 author))
+
+(define-integrable (delta/set-state! delta state)
+  (vector-set! delta 4 state))
+
+(define-integrable (delta/set-branches! delta branches)
+  (vector-set! delta 5 branches))
+
+(define-integrable (delta/set-next! delta next)
+  (vector-set! delta 6 next))
+
+(define-integrable (delta/set-log! delta log)
+  (vector-set! delta 7 log))
+
+(define-integrable (delta/set-text! delta text)
+  (vector-set! delta 8 text))
+
+(unparser/set-tagged-vector-method!
+ delta/tag
+ (unparser/standard-method "DELTA"
+   (lambda (state delta)
+     (unparse-string state (delta/number delta)))))
+
+(define (date/make year month day hour minute second)
+  (vector
+   year month day hour minute second
+   (+ second
+      (* 60
+	 (+ minute
+	    (* 60
+	       (+ hour
+		  (* 24
+		     (+ (-1+ day)
+			(vector-ref
+			 (if (zero? (remainder year 4))
+			     '#(0 31 60 91 121 152 182 213 244 274 305 335)
+			     '#(0 31 59 90 120 151 181 212 243 273 304 334))
+			 (-1+ month))
+			(* 365 year)
+			(quotient year 4))))))))))
+
+(define-integrable (date/year date) (vector-ref date 0))
+(define-integrable (date/month date) (vector-ref date 1))
+(define-integrable (date/day date) (vector-ref date 2))
+(define-integrable (date/hour date) (vector-ref date 3))
+(define-integrable (date/minute date) (vector-ref date 4))
+(define-integrable (date/second date) (vector-ref date 5))
+(define-integrable (date/total-seconds date) (vector-ref date 6))
+
+(define (date->string date)
+  (string-append (date-component->string (date/year date))
+		 "/"
+		 (date-component->string (date/month date))
+		 "/"
+		 (date-component->string (date/day date))
+		 " "
+		 (date-component->string (date/hour date))
+		 ":"
+		 (date-component->string (date/minute date))
+		 ":"
+		 (date-component->string (date/second date))
+		 " GMT"))
+
+(define (date-component->string number)
+  (cond ((zero? number) "00")
+	((< number 10) (string-append "0" (write-to-string number)))
+	(else (write-to-string number))))
+
+(define-integrable (date<? x y)
+  (< (date/total-seconds x) (date/total-seconds y)))
\ No newline at end of file
diff --git a/v7/src/rcs/rcs.pkg b/v7/src/rcs/rcs.pkg
new file mode 100644
index 000000000..ce98044c0
--- /dev/null
+++ b/v7/src/rcs/rcs.pkg
@@ -0,0 +1,60 @@
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/rcs.pkg,v 1.1 1991/01/18 19:09:56 cph Exp $
+
+Copyright (c) 1988 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  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. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+;;;; RCS Packaging
+
+(global-definitions "/scheme/runtime/runtim")
+
+(define-package (rcs)
+  (files "object")
+  (parent ()))
+
+(define-package (rcs format)
+  (files "format")
+  (parent (rcs))
+  (export (rcs)
+	  rcs/format))
+
+(define-package (rcs parser)
+  (files "parser")
+  (parent (rcs))
+  (export (rcs)
+	  rcs/read-file
+	  rcs/read-head))
+
+(define-package (rcs log-merge)
+  (files "logmer")
+  (parent (rcs))
+  (export (rcs)
+	  rcs-directory-log))
\ No newline at end of file
diff --git a/v7/src/rcs/rcs.sf b/v7/src/rcs/rcs.sf
new file mode 100644
index 000000000..446e9a4d2
--- /dev/null
+++ b/v7/src/rcs/rcs.sf
@@ -0,0 +1,45 @@
+#| -*-Scheme-*-
+
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/rcs.sf,v 1.1 1991/01/18 19:10:09 cph Exp $
+
+Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+
+This material was developed by the Scheme project at the Massachusetts
+Institute of Technology, Department of Electrical Engineering and
+Computer Science.  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. Users of this software agree to make their best efforts (a) to
+return to the MIT Scheme project any improvements or extensions that
+they make, so that these may be included in future releases; and (b)
+to inform MIT of noteworthy uses of this software.
+
+3. All materials developed as a consequence of the use of this
+software shall duly acknowledge such use, in accordance with the usual
+standards of acknowledging credit in academic research.
+
+4. MIT has made no warrantee or representation that the operation of
+this software will be error-free, and MIT is under no obligation to
+provide any services, by way of maintenance, update, or otherwise.
+
+5. In conjunction with products arising from the use of this material,
+there shall be no use of the name of the Massachusetts Institute of
+Technology nor of any adaptation thereof in any advertising,
+promotional, or sales literature without prior written consent from
+MIT in each case. |#
+
+(fluid-let ((sf/default-syntax-table system-global-syntax-table))
+  (sf-conditionally "object")
+  (sf-directory "."))
+
+;; Guarantee that the package modeller is loaded.
+(if (not (name->package '(CROSS-REFERENCE)))
+    (with-working-directory-pathname "/scheme/cref" (lambda () (load "make"))))
+
+(cref/generate-all "rcs")
+(sf "rcs.con" "rcs.bcon")
+(sf "rcs.ldr" "rcs.bldr")
\ No newline at end of file
diff --git a/v7/src/rcs/scheme.scm b/v7/src/rcs/scheme.scm
new file mode 100644
index 000000000..632ee786b
--- /dev/null
+++ b/v7/src/rcs/scheme.scm
@@ -0,0 +1,44 @@
+(define (make-bind-script symbol output-file)
+  (let ((read-head (access rcs/read-head (->environment '(RCS)))))
+    (with-output-to-file output-file
+      (lambda ()
+	(for-each (lambda (pathname)
+		    (let ((head (read-head pathname)))
+		      (write-string
+		       (string-append "rcs -n" symbol ":" head
+				      " -sRel:" head " "
+				      (pathname->string pathname)
+				      "\n"))))
+		  (apply append!
+			 (map (lambda (pathname)
+				(list-transform-negative
+				    (directory-read pathname)
+				  (lambda (pathname)
+				    (zero? (string-match-backward
+					    (pathname->string pathname)
+					    ",v")))))
+			      (map (lambda (directory)
+				     (string-append directory "/RCS/"))
+				   '("microcode"
+				     "microcode/m"
+				     "microcode/s"
+				     "runtime"
+				     "cref"
+				     "sf"
+				     "compiler"
+				     "compiler/back"
+				     "compiler/base"
+				     "compiler/etc"
+				     "compiler/fggen"
+				     "compiler/fgopt"
+				     "compiler/machines/bobcat"
+				     "compiler/machines/mips"
+				     "compiler/machines/spectrum"
+				     "compiler/machines/vax"
+				     "compiler/rtlbase"
+				     "compiler/rtlgen"
+				     "compiler/rtlopt"
+				     "edwin"
+				     ;; "documentation"
+				     ;; "etc"
+				     )))))))))
\ No newline at end of file
-- 
2.25.1