From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 1 Nov 1999 03:40:23 +0000 (+0000)
Subject: Eliminate macro DEFINE-NAMED-STRUCTURE.
X-Git-Tag: 20090517-FFI~4426
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e6c2828bd14909ba66216b4edb657a5ab3395efe;p=mit-scheme.git

Eliminate macro DEFINE-NAMED-STRUCTURE.
---

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 779da478f..70bcb4991 100644
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: buffer.scm,v 1.171 1999/01/02 06:11:34 cph Exp $
+;;; $Id: buffer.scm,v 1.172 1999/11/01 03:40:08 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -22,32 +22,37 @@
 
 (declare (usual-integrations))
 
-(define-named-structure "Buffer"
-  name
+(define-structure (buffer
+		   (constructor %make-buffer (%name %default-directory)))
+  %name
   group
   mark-ring
   modes
   comtabs
   windows
   display-start
-  default-directory
-  pathname
-  truename
+  %default-directory
+  %pathname
+  %truename
   alist
   local-bindings
   local-bindings-installed?
   auto-save-pathname
   auto-saved?
-  save-length
+  %save-length
   backed-up?
-  modification-time
-  )
-
-(unparser/set-tagged-vector-method!
- %buffer-tag
- (unparser/standard-method 'BUFFER
-   (lambda (state buffer)
-     (unparse-object state (buffer-name buffer)))))
+  modification-time)
+
+(let-syntax
+    ((rename
+      (macro (slot-name)
+	`(DEFINE-INTEGRABLE ,(symbol-append 'BUFFER- slot-name)
+	   ,(symbol-append 'BUFFER-% slot-name)))))
+  (rename name)
+  (rename default-directory)
+  (rename pathname)
+  (rename truename)
+  (rename save-length))
 
 (define-variable buffer-creation-hook
   "An event distributor that is invoked when a new buffer is created.
@@ -56,17 +61,16 @@ The buffer is guaranteed to be deselected at that time."
   (make-event-distributor))
 
 (define (make-buffer name mode directory)
-  (let ((buffer (%make-buffer)))
+  (let ((buffer (%make-buffer name directory)))
     (let ((group (make-group buffer)))
-      (vector-set! buffer buffer-index:name name)
-      (vector-set! buffer buffer-index:group group)
+      (set-buffer-group! buffer group)
       (add-group-clip-daemon! group (buffer-clip-daemon buffer))
       (%buffer-reset! buffer)
-      (vector-set! buffer buffer-index:windows '())
-      (vector-set! buffer buffer-index:display-start #f)
-      (vector-set! buffer buffer-index:default-directory directory)
-      (vector-set! buffer buffer-index:local-bindings '())
-      (vector-set! buffer buffer-index:local-bindings-installed? #f)
+      (set-buffer-windows! buffer '())
+      (set-buffer-display-start! buffer #f)
+      (set-buffer-default-directory! buffer directory)
+      (set-buffer-local-bindings! buffer '())
+      (set-buffer-local-bindings-installed?! buffer #f)
       (%set-buffer-major-mode! buffer mode)
       (event-distributor/invoke!
        (variable-default-value (ref-variable-object buffer-creation-hook))
@@ -78,20 +82,19 @@ The buffer is guaranteed to be deselected at that time."
     (disable-group-undo! group)
     (if (not (minibuffer? buffer))
 	(enable-group-undo! group)))
-  (vector-set!
+  (set-buffer-mark-ring!
    buffer
-   buffer-index:mark-ring
    (make-ring
     (variable-default-value (ref-variable-object mark-ring-maximum))))
   (ring-push! (buffer-mark-ring buffer) (buffer-start buffer))
-  (vector-set! buffer buffer-index:pathname #f)
-  (vector-set! buffer buffer-index:truename #f)
-  (vector-set! buffer buffer-index:auto-save-pathname #f)
-  (vector-set! buffer buffer-index:auto-saved? #f)
-  (vector-set! buffer buffer-index:save-length 0)
-  (vector-set! buffer buffer-index:backed-up? #f)
-  (vector-set! buffer buffer-index:modification-time #f)
-  (vector-set! buffer buffer-index:alist '()))
+  (set-buffer-%pathname! buffer #f)
+  (set-buffer-%truename! buffer #f)
+  (set-buffer-auto-save-pathname! buffer #f)
+  (set-buffer-auto-saved?! buffer #f)
+  (set-buffer-%save-length! buffer 0)
+  (set-buffer-backed-up?! buffer #f)
+  (set-buffer-modification-time! buffer #f)
+  (set-buffer-alist! buffer '()))
 
 (define (buffer-modeline-event! buffer type)
   (let loop ((windows (buffer-windows buffer)))
@@ -126,38 +129,24 @@ The buffer is guaranteed to be deselected at that time."
      (buffer-modeline-event! buffer 'BUFFER-RESET))))
 
 (define (set-buffer-name! buffer name)
-  (vector-set! buffer buffer-index:name name)
+  (set-buffer-%name! buffer name)
   (buffer-modeline-event! buffer 'BUFFER-NAME))
 
 (define (set-buffer-default-directory! buffer directory)
-  (vector-set! buffer
-	       buffer-index:default-directory
-	       (pathname-simplify directory)))
+  (set-buffer-%default-directory! buffer (pathname-simplify directory)))
 
 (define (set-buffer-pathname! buffer pathname)
-  (vector-set! buffer buffer-index:pathname pathname)
+  (set-buffer-%pathname! buffer pathname)
   (if pathname
       (set-buffer-default-directory! buffer (directory-pathname pathname)))
   (buffer-modeline-event! buffer 'BUFFER-PATHNAME))
 
 (define (set-buffer-truename! buffer truename)
-  (vector-set! buffer buffer-index:truename truename)
+  (set-buffer-%truename! buffer truename)
   (buffer-modeline-event! buffer 'BUFFER-TRUENAME))
 
-(define-integrable (set-buffer-auto-save-pathname! buffer pathname)
-  (vector-set! buffer buffer-index:auto-save-pathname pathname))
-
 (define-integrable (set-buffer-save-length! buffer)
-  (vector-set! buffer buffer-index:save-length (buffer-length buffer)))
-
-(define-integrable (set-buffer-backed-up?! buffer flag)
-  (vector-set! buffer buffer-index:backed-up? flag))
-
-(define-integrable (set-buffer-modification-time! buffer time)
-  (vector-set! buffer buffer-index:modification-time time))
-
-(define-integrable (set-buffer-comtabs! buffer comtabs)
-  (vector-set! buffer buffer-index:comtabs comtabs))
+  (set-buffer-%save-length! buffer (buffer-length buffer)))
 
 (define (buffer-point buffer)
   (cond ((current-buffer? buffer)
@@ -204,17 +193,10 @@ The buffer is guaranteed to be deselected at that time."
   (group-absolute-end (buffer-group buffer)))
 
 (define (add-buffer-window! buffer window)
-  (vector-set! buffer
-	       buffer-index:windows
-	       (cons window (vector-ref buffer buffer-index:windows))))
+  (set-buffer-windows! buffer (cons window (buffer-windows buffer))))
 
 (define (remove-buffer-window! buffer window)
-  (vector-set! buffer
-	       buffer-index:windows
-	       (delq! window (vector-ref buffer buffer-index:windows))))
-
-(define-integrable (set-buffer-display-start! buffer mark)
-  (vector-set! buffer buffer-index:display-start mark))
+  (set-buffer-windows! buffer (delq! window (buffer-windows buffer))))
 
 (define (buffer-visible? buffer)
   (there-exists? (buffer-windows buffer) window-visible?))
@@ -242,13 +224,12 @@ The buffer is guaranteed to be deselected at that time."
       (let ((entry (assq key (buffer-alist buffer))))
 	(if entry
 	    (set-cdr! entry value)
-	    (vector-set! buffer buffer-index:alist
-			 (cons (cons key value) (buffer-alist buffer)))))
+	    (set-buffer-alist! buffer
+			       (cons (cons key value) (buffer-alist buffer)))))
       (buffer-remove! buffer key)))
 
 (define (buffer-remove! buffer key)
-  (vector-set! buffer buffer-index:alist
-	       (del-assq! key (buffer-alist buffer))))
+  (set-buffer-alist! buffer (del-assq! key (buffer-alist buffer))))
 
 (define (remove-impermanent-bindings! alist)
   ((list-deletor!
@@ -275,7 +256,7 @@ The buffer is guaranteed to be deselected at that time."
 	   (begin
 	     (set-group-modified?! group #f)
 	     (buffer-modeline-event! buffer 'BUFFER-MODIFIED)
-	     (vector-set! buffer buffer-index:auto-saved? #f)))))))
+	     (set-buffer-auto-saved?! buffer #f)))))))
 
 (define (buffer-modified! buffer)
   (without-editor-interrupts
@@ -287,7 +268,7 @@ The buffer is guaranteed to be deselected at that time."
 	     (buffer-modeline-event! buffer 'BUFFER-MODIFIED)))))))
 
 (define (set-buffer-auto-saved! buffer)
-  (vector-set! buffer buffer-index:auto-saved? #t)
+  (set-buffer-auto-saved?! buffer #t)
   (set-group-modified?! (buffer-group buffer) 'AUTO-SAVED))
 
 (define-integrable (buffer-auto-save-modified? buffer)
@@ -333,10 +314,10 @@ The buffer is guaranteed to be deselected at that time."
        (let ((binding (search-local-bindings buffer variable)))
 	 (if binding
 	     (set-cdr! binding value)
-	     (vector-set! buffer
-			  buffer-index:local-bindings
-			  (cons (cons variable value)
-				(buffer-local-bindings buffer)))))
+	     (set-buffer-local-bindings!
+	      buffer
+	      (cons (cons variable value)
+		    (buffer-local-bindings buffer)))))
        (if (buffer-local-bindings-installed? buffer)
 	   (set-variable-%value! variable value))
        (invoke-variable-assignment-daemons! buffer variable)))))
@@ -347,9 +328,9 @@ The buffer is guaranteed to be deselected at that time."
      (let ((binding (search-local-bindings buffer variable)))
        (if binding
 	   (begin
-	     (vector-set! buffer
-			  buffer-index:local-bindings
-			  (delq! binding (buffer-local-bindings buffer)))
+	     (set-buffer-local-bindings!
+	      buffer
+	      (delq! binding (buffer-local-bindings buffer)))
 	     (if (buffer-local-bindings-installed? buffer)
 		 (set-variable-%value! variable
 				       (variable-default-value variable)))
@@ -409,8 +390,9 @@ The buffer is guaranteed to be deselected at that time."
 	    ((null? bindings))
 	  (set-variable-%value! (caar bindings)
 				(variable-default-value (caar bindings)))))
-    (vector-set! buffer buffer-index:local-bindings
-		 (if all? '() (remove-impermanent-bindings! bindings)))
+    (set-buffer-local-bindings!
+     buffer
+     (if all? '() (remove-impermanent-bindings! bindings)))
     (do ((bindings bindings (cdr bindings)))
 	((null? bindings))
       (invoke-variable-assignment-daemons! buffer (caar bindings)))))
@@ -432,14 +414,14 @@ The buffer is guaranteed to be deselected at that time."
   (do ((bindings (buffer-local-bindings buffer) (cdr bindings)))
       ((null? bindings))
     (set-variable-%value! (caar bindings) (cdar bindings)))
-  (vector-set! buffer buffer-index:local-bindings-installed? #t))
+  (set-buffer-local-bindings-installed?! buffer #t))
 
 (define (uninstall-buffer-local-bindings! buffer)
   (do ((bindings (buffer-local-bindings buffer) (cdr bindings)))
       ((null? bindings))
     (set-variable-%value! (caar bindings)
 			  (variable-default-value (caar bindings))))
-  (vector-set! buffer buffer-index:local-bindings-installed? #f))
+  (set-buffer-local-bindings-installed?! buffer #f))
 
 (define (set-variable-value! variable value)
   (if within-editor?
@@ -486,8 +468,8 @@ The buffer is guaranteed to be deselected at that time."
 
 
 (define (%set-buffer-major-mode! buffer mode)
-  (vector-set! buffer buffer-index:modes (list mode))
-  (vector-set! buffer buffer-index:comtabs (mode-comtabs mode))
+  (set-buffer-modes! buffer (list mode))
+  (set-buffer-comtabs! buffer (mode-comtabs mode))
   (set-variable-local-value! buffer
 			     (ref-variable-object mode-name)
 			     (mode-display-name mode))
diff --git a/v7/src/edwin/grpops.scm b/v7/src/edwin/grpops.scm
index dfea9607e..6099c9397 100644
--- a/v7/src/edwin/grpops.scm
+++ b/v7/src/edwin/grpops.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: grpops.scm,v 1.24 1999/01/02 06:11:34 cph Exp $
+;;; $Id: grpops.scm,v 1.25 1999/11/01 03:40:17 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -129,8 +129,8 @@
 			     (group-gap-start group)
 			     (group-text group)
 			     new-end)
-	   (vector-set! group group-index:gap-start new-start)
-	   (vector-set! group group-index:gap-end new-end)))
+	   (set-group-gap-start! group new-start)
+	   (set-group-gap-end! group new-end)))
 	((fix:> new-start (group-gap-start group))
 	 (let ((new-end (fix:+ new-start (group-gap-length group))))
 	   (%substring-move! (group-text group)
@@ -138,12 +138,12 @@
 			     new-end
 			     (group-text group)
 			     (group-gap-start group))
-	   (vector-set! group group-index:gap-start new-start)
-	   (vector-set! group group-index:gap-end new-end)))))
+	   (set-group-gap-start! group new-start)
+	   (set-group-gap-end! group new-end)))))
 
 (define (finish-group-insert! group index n)
-  (vector-set! group group-index:gap-start (fix:+ index n))
-  (vector-set! group group-index:gap-length (fix:- (group-gap-length group) n))
+  (set-group-gap-start! group (fix:+ index n))
+  (set-group-gap-length! group (fix:- (group-gap-length group) n))
   (if (group-start-changes-index group)
       (begin
 	(if (fix:< index (group-start-changes-index group))
@@ -164,8 +164,7 @@
 		      (mark-left-inserting? (system-pair-car marks)))))
 	(set-mark-index! (system-pair-car marks)
 			 (fix:+ (mark-index (system-pair-car marks)) n))))
-  (vector-set! group group-index:modified-tick
-	       (fix:+ (group-modified-tick group) 1))
+  (set-group-modified-tick! group (fix:+ (group-modified-tick group) 1))
   (undo-record-insertion! group index (fix:+ index n))
   ;; The MODIFIED? bit must be set *after* the undo recording.
   (set-group-modified?! group true)
@@ -208,9 +207,9 @@
 	  ;; The undo recording must occur *before* the deletion.
 	  (undo-record-deletion! group start end)
 	  (let ((gap-end (fix:+ end gap-length)))
-	    (vector-set! group group-index:gap-start start)
-	    (vector-set! group group-index:gap-end gap-end)
-	    (vector-set! group group-index:gap-length (fix:- gap-end start))
+	    (set-group-gap-start! group start)
+	    (set-group-gap-end! group gap-end)
+	    (set-group-gap-length! group (fix:- gap-end start))
 	    (if (and (group-shrink-length group)
 		     (fix:<= (fix:- (string-length text)
 				    (fix:- gap-end start))
@@ -240,8 +239,7 @@
 		   (set-mark-index!
 		    (system-pair-car marks)
 		    (fix:- (mark-index (system-pair-car marks)) n))))))
-	(vector-set! group group-index:modified-tick
-		     (fix:+ (group-modified-tick group) 1))
+	(set-group-modified-tick! group (fix:+ (group-modified-tick group) 1))
 	;; The MODIFIED? bit must be set *after* the undo recording.
 	(set-group-modified?! group true)
 	(if (group-text-properties group)
@@ -255,14 +253,14 @@
   (let ((text (group-text group))
 	(gap-start (group-gap-start group))
 	(gap-end (group-gap-end group))
-	(reallocation-factor (group-reallocation-factor group)))
+	(realloc-factor (group-reallocation-factor group)))
     (let ((text-length (string-length text))
 	  (gap-delta (- new-gap-start gap-start)))
       (let ((n-chars (- text-length (group-gap-length group))))
 	(let ((new-text-length
 	       (let ((minimum-text-length (+ n-chars n)))
 		 (let loop ((length (if (= text-length 0) 1 text-length)))
-		   (let ((length (ceiling (* length reallocation-factor))))
+		   (let ((length (ceiling (* length realloc-factor))))
 		     (if (< length minimum-text-length)
 			 (loop length)
 			 length))))))
@@ -285,26 +283,25 @@
 		       (%substring-move! text gap-end ngsp new-text gap-start)
 		       (%substring-move! text ngsp text-length
 					 new-text new-gap-end))))
-	      (vector-set! group group-index:text new-text)
-	      (vector-set! group group-index:gap-start new-gap-start)
-	      (vector-set! group group-index:gap-end new-gap-end)
-	      (vector-set! group group-index:gap-length new-gap-length))))))
-    (memoize-shrink-length! group reallocation-factor)))
+	      (set-group-text! group new-text)
+	      (set-group-gap-start! group new-gap-start)
+	      (set-group-gap-end! group new-gap-end)
+	      (set-group-gap-length! group new-gap-length))))))
+    (memoize-shrink-length! group realloc-factor)))
 
 (define (shrink-group! group)
   (let ((text (group-text group))
 	(gap-length (group-gap-length group))
-	(reallocation-factor (group-reallocation-factor group)))
+	(realloc-factor (group-reallocation-factor group)))
     (let ((text-length (string-length text)))
       (let ((n-chars (- text-length gap-length)))
 	(let ((new-text-length
 	       (if (= n-chars 0)
 		   0
 		   (let loop ((length text-length))
-		     (let ((length (floor (/ length reallocation-factor))))
+		     (let ((length (floor (/ length realloc-factor))))
 		       (let ((sl
-			      (compute-shrink-length length
-						     reallocation-factor)))
+			      (compute-shrink-length length realloc-factor)))
 			 (if (< sl n-chars)
 			     length
 			     (loop length)))))))
@@ -312,18 +309,18 @@
 	  (let ((delta (- text-length new-text-length)))
 	    (let ((new-gap-end (- gap-end delta)))
 	      (%substring-move! text gap-end text-length text new-gap-end)
-	      (vector-set! group group-index:gap-end new-gap-end)
-	      (vector-set! group group-index:gap-length (- gap-length delta))))
+	      (set-group-gap-end! group new-gap-end)
+	      (set-group-gap-length! group (- gap-length delta))))
 	  (set-string-maximum-length! text new-text-length))))
-    (memoize-shrink-length! group reallocation-factor)))
+    (memoize-shrink-length! group realloc-factor)))
 
-(define (memoize-shrink-length! group reallocation-factor)
-  (vector-set! group group-index:shrink-length
-	       (compute-shrink-length (string-length (group-text group))
-				      reallocation-factor)))
+(define (memoize-shrink-length! group realloc-factor)
+  (set-group-shrink-length!
+   group
+   (compute-shrink-length (string-length (group-text group)) realloc-factor)))
 
-(define (compute-shrink-length length reallocation-factor)
-  (floor (/ (floor (/ length reallocation-factor)) reallocation-factor)))
+(define (compute-shrink-length length realloc-factor)
+  (floor (/ (floor (/ length realloc-factor)) realloc-factor)))
 
 (define (group-reallocation-factor group)
   ;; We assume the result satisfies (LAMBDA (G) (AND (REAL? G) (> G 1)))
diff --git a/v7/src/edwin/macros.scm b/v7/src/edwin/macros.scm
index 4820090cc..32648f08e 100644
--- a/v7/src/edwin/macros.scm
+++ b/v7/src/edwin/macros.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: macros.scm,v 1.64 1999/01/28 03:54:36 cph Exp $
+;;; $Id: macros.scm,v 1.65 1999/11/01 03:40:23 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -25,45 +25,6 @@
 (define edwin-syntax-table
   (make-syntax-table syntax-table/system-internal))
 
-;;; DEFINE-NAMED-STRUCTURE is a simple alternative to DEFSTRUCT,
-;;; which defines a vector-based tagged data structure.  The first
-;;; argument is a string, which will be stored in the structure's 0th
-;;; slot.  The remaining arguments are symbols, which should be the
-;;; names of the slots.  Do not use the slot names %TAG or %SIZE.
-
-(syntax-table-define edwin-syntax-table 'DEFINE-NAMED-STRUCTURE
-  (lambda (name . slots)
-    (let ((name (if (symbol? name) name (intern name)))
-	  (indexes
-	   (let loop ((slots slots) (index 1))
-	     (if (null? slots)
-		 '()
-		 (cons index (loop (cdr slots) (+ index 1)))))))
-      (let ((tag-name (symbol-append '% name '-TAG)))
-	`(BEGIN
-	   (DEFINE ,tag-name
-	     (MAKE-DEFINE-STRUCTURE-TYPE 'VECTOR
-					 ',name
-					 ',slots
-					 ',indexes
-					 (UNPARSER/STANDARD-METHOD ',name)))
-	   (DEFINE (,(symbol-append '%MAKE- name))
-	     (LET ((,name (MAKE-VECTOR ,(+ (length slots) 1) '())))
-	       (VECTOR-SET! ,name 0 ,tag-name)
-	       ,name))
-	   (DEFINE (,(symbol-append name '?) OBJECT)
-	     (AND (VECTOR? OBJECT)
-		  (NOT (ZERO? (VECTOR-LENGTH OBJECT)))
-		  (EQ? ,tag-name (VECTOR-REF OBJECT 0))))
-	   ,@(append-map
-	      (lambda (slot index)
-		`((DEFINE-INTEGRABLE (,(symbol-append name '- slot) ,name)
-		    (VECTOR-REF ,name ,index))
-		  (DEFINE-INTEGRABLE ,(symbol-append name '-INDEX: slot)
-		    ,index)))
-	      slots
-	      indexes))))))
-
 (syntax-table-define edwin-syntax-table 'DEFINE-COMMAND
   (lambda (name description interactive procedure)
     (let ((name (canonicalize-name name)))
diff --git a/v7/src/edwin/struct.scm b/v7/src/edwin/struct.scm
index 9b1534381..1d3842479 100644
--- a/v7/src/edwin/struct.scm
+++ b/v7/src/edwin/struct.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: struct.scm,v 1.91 1999/01/02 06:11:34 cph Exp $
+;;; $Id: struct.scm,v 1.92 1999/11/01 03:40:13 cph Exp $
 ;;;
 ;;; Copyright (c) 1985, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -62,95 +62,47 @@
 
 ;;;; Groups
 
-(define-named-structure "Group"
-  ;; The microcode file "edwin.h" depends on the fields TEXT,
-  ;; GAP-START, GAP-LENGTH, GAP-END, START-MARK, and END-MARK.
-  text
-  gap-start
-  gap-length
-  gap-end
-  marks
+(define-structure (group
+		   (type vector)
+		   (named)
+		   (constructor %make-group (buffer)))
+  ;; The microcode file "edwin.h" depends on this structure being a
+  ;; named vector, and knows the indexes of the fields TEXT,
+  ;; GAP-START, GAP-LENGTH, GAP-END, START-MARK, END-MARK, and
+  ;; MODIFIED?.
+  (text (string-allocate 0))
+  (gap-start 0)
+  (gap-length 0)
+  (gap-end 0)
+  (marks '())
   start-mark
   end-mark
-  writable?
+  (writable? #t)
   display-start
   display-end
-  start-changes-index
-  end-changes-index
-  modified-tick
-  clip-daemons
-  undo-data
-  modified?
-  point
+  (start-changes-index #f)
+  (end-changes-index #f)
+  (modified-tick 0)
+  (clip-daemons '())
+  (undo-data #f)
+  (modified? #f)
+  %point
   buffer
-  shrink-length
-  text-properties
-  %hash-number)
+  (shrink-length 0)
+  (text-properties #f)
+  (%hash-number #f))
 
-(define-integrable (set-group-marks! group marks)
-  (vector-set! group group-index:marks marks))
-
-(define-integrable (set-group-start-mark! group start)
-  (vector-set! group group-index:start-mark start))
-
-(define-integrable (set-group-end-mark! group end)
-  (vector-set! group group-index:end-mark end))
-
-(define-integrable (set-group-writable?! group writable?)
-  (vector-set! group group-index:writable? writable?))
-
-(define-integrable (set-group-display-start! group start)
-  (vector-set! group group-index:display-start start))
-
-(define-integrable (set-group-display-end! group end)
-  (vector-set! group group-index:display-end end))
-
-(define-integrable (set-group-start-changes-index! group start)
-  (vector-set! group group-index:start-changes-index start))
-
-(define-integrable (set-group-end-changes-index! group end)
-  (vector-set! group group-index:end-changes-index end))
-
-(define-integrable (set-group-modified-tick! group tick)
-  (vector-set! group group-index:modified-tick tick))
-
-(define-integrable (set-group-undo-data! group undo-data)
-  (vector-set! group group-index:undo-data undo-data))
-
-(define-integrable (set-group-modified?! group sense)
-  (vector-set! group group-index:modified? sense))
-
-(define-integrable (set-group-text-properties! group properties)
-  (vector-set! group group-index:text-properties properties))
-
-(define-integrable (set-group-%hash-number! group n)
-  (vector-set! group group-index:%hash-number n))
+(define-integrable group-point group-%point)
 
 (define (make-group buffer)
-  (let ((group (%make-group)))
-    (vector-set! group group-index:text (string-allocate 0))
-    (vector-set! group group-index:gap-start 0)
-    (vector-set! group group-index:gap-length 0)
-    (vector-set! group group-index:gap-end 0)
-    (vector-set! group group-index:marks '())
-    (let ((start (make-permanent-mark group 0 false)))
-      (vector-set! group group-index:start-mark start)
-      (vector-set! group group-index:display-start start))
-    (let ((end (make-permanent-mark group 0 true)))
-      (vector-set! group group-index:end-mark end)
-      (vector-set! group group-index:display-end end))
-    (vector-set! group group-index:writable? #t)
-    (vector-set! group group-index:start-changes-index false)
-    (vector-set! group group-index:end-changes-index false)
-    (vector-set! group group-index:modified-tick 0)
-    (vector-set! group group-index:clip-daemons '())
-    (vector-set! group group-index:undo-data false)
-    (vector-set! group group-index:modified? false)
-    (vector-set! group group-index:point (make-permanent-mark group 0 true))
-    (vector-set! group group-index:buffer buffer)
-    (vector-set! group group-index:shrink-length 0)
-    (vector-set! group group-index:text-properties false)
-    (vector-set! group group-index:%hash-number #f)
+  (let ((group (%make-group buffer)))
+    (let ((start (make-permanent-mark group 0 #f)))
+      (set-group-start-mark! group start)
+      (set-group-display-start! group start))
+    (let ((end (make-permanent-mark group 0 #t)))
+      (set-group-end-mark! group end)
+      (set-group-display-end! group end))
+    (set-group-%point! group (make-permanent-mark group 0 #t))
     group))
 
 (define (group-length group)
@@ -218,13 +170,13 @@
 	 (group-gap-start group))))
 
 (define-integrable (set-group-point! group point)
-  (vector-set! group group-index:point (mark-left-inserting-copy point)))
+  (set-group-%point! group (mark-left-inserting-copy point)))
 
 (define (group-absolute-start group)
-  (make-temporary-mark group 0 false))
+  (make-temporary-mark group 0 #f))
 
 (define (group-absolute-end group)
-  (make-temporary-mark group (group-length group) true))
+  (make-temporary-mark group (group-length group) #t))
 
 (define (group-hash-number group)
   (or (group-%hash-number group)
@@ -253,25 +205,25 @@
 (define (with-group-text-clipped! group start end thunk)
   (let ((old-text-start)
 	(old-text-end)
-	(new-text-start (make-permanent-mark group start false))
-	(new-text-end (make-permanent-mark group end true)))
+	(new-text-start (make-permanent-mark group start #f))
+	(new-text-end (make-permanent-mark group end #t)))
     (unwind-protect (lambda ()
 		      (set! old-text-start (group-start-mark group))
 		      (set! old-text-end (group-end-mark group))
-		      (vector-set! group group-index:start-mark new-text-start)
-		      (vector-set! group group-index:end-mark new-text-end))
+		      (set-group-start-mark! group new-text-start)
+		      (set-group-end-mark! group new-text-end))
 		    thunk
 		    (lambda ()
 		      (set! new-text-start (group-start-mark group))
 		      (set! new-text-end (group-end-mark group))
-		      (vector-set! group group-index:start-mark old-text-start)
-		      (vector-set! group group-index:end-mark old-text-end)))))
+		      (set-group-start-mark! group old-text-start)
+		      (set-group-end-mark! group old-text-end)))))
 
 (define (group-text-clip group start end)
-  (let ((start (make-permanent-mark group start false))
-	(end (make-permanent-mark group end true)))
-    (vector-set! group group-index:start-mark start)
-    (vector-set! group group-index:end-mark end)))
+  (let ((start (make-permanent-mark group start #f))
+	(end (make-permanent-mark group end #t)))
+    (set-group-start-mark! group start)
+    (set-group-end-mark! group end)))
 
 (define (record-clipping! group start end)
   (let ((buffer (group-buffer group)))
@@ -281,7 +233,7 @@
 		    (let ((display-start (mark-index display-start)))
 		      (or (fix:< display-start start)
 			  (fix:> display-start end))))))
-	(set-buffer-display-start! buffer false)))
+	(set-buffer-display-start! buffer #f)))
   (invoke-group-daemons! (group-clip-daemons group) group start end))
 
 (define (invoke-group-daemons! daemons group start end)
@@ -292,14 +244,10 @@
 	  (loop (cdr daemons))))))
 
 (define (add-group-clip-daemon! group daemon)
-  (vector-set! group
-	       group-index:clip-daemons
-	       (cons daemon (vector-ref group group-index:clip-daemons))))
+  (set-group-clip-daemons! group (cons daemon (group-clip-daemons group))))
 
 (define (remove-group-clip-daemon! group daemon)
-  (vector-set! group
-	       group-index:clip-daemons
-	       (delq! daemon (vector-ref group group-index:clip-daemons))))
+  (set-group-clip-daemons! group (delq! daemon (group-clip-daemons group))))
 
 (define (group-local-ref group variable)
   (variable-local-value (let ((buffer (group-buffer group)))
@@ -339,16 +287,16 @@
 					    " right"))))))
   ;; The microcode file "edwin.h" depends on the definition of this
   ;; structure.
-  (group false read-only true)
-  (index false)
-  (left-inserting? false read-only true))
+  (group #f read-only #t)
+  (index #f)
+  (left-inserting? #f read-only #t))
 
 (define (guarantee-mark mark)
   (if (not (mark? mark)) (error "not a mark" mark))
   mark)
 
 (define-integrable (make-mark group index)
-  (make-temporary-mark group index true))
+  (make-temporary-mark group index #t))
 
 (define (move-mark-to! mark target)
   (set-mark-index! mark (mark-index target)))
@@ -363,19 +311,19 @@
 
 (define (mark-right-inserting mark)
   (if (mark-left-inserting? mark)
-      (make-permanent-mark (mark-group mark) (mark-index mark) false)
+      (make-permanent-mark (mark-group mark) (mark-index mark) #f)
       (mark-permanent! mark)))
 
 (define (mark-right-inserting-copy mark)
-  (make-permanent-mark (mark-group mark) (mark-index mark) false))
+  (make-permanent-mark (mark-group mark) (mark-index mark) #f))
 
 (define (mark-left-inserting mark)
   (if (mark-left-inserting? mark)
       (mark-permanent! mark)
-      (make-permanent-mark (mark-group mark) (mark-index mark) true)))
+      (make-permanent-mark (mark-group mark) (mark-index mark) #t)))
 
 (define (mark-left-inserting-copy mark)
-  (make-permanent-mark (mark-group mark) (mark-index mark) true))
+  (make-permanent-mark (mark-group mark) (mark-index mark) #t))
 
 (define (make-permanent-mark group index left-inserting?)
   (let ((mark (make-temporary-mark group index left-inserting?)))
@@ -547,7 +495,7 @@
     (if (null? marks)
 	(begin
 	  (set-group-marks! group '())
-	  false)
+	  #f)
 	(let ((mark (system-pair-car marks)))
 	  (cond ((not mark)
 		 (scan-head (system-pair-cdr marks)))
@@ -577,7 +525,7 @@
     (if (null? marks)
 	(begin
 	  (system-pair-set-cdr! previous '())
-	  false)
+	  #f)
 	(let ((mark (system-pair-car marks)))
 	  (if (not mark)
 	      (skip-nulls previous (system-pair-cdr marks))