Considerable tuning of the group insert/delete operations.

* Eliminate buffer-modification-daemon; change group insert/delete
  operations to set the GROUP-MODIFIED? flag directly, and change the
  auto-save code to work around that flag.  Now, buffers that are not
  visible have no insert or delete daemons, and the group
  insert/delete operations notice this to eliminate a procedure call.

* The editor now has a GC daemon that cleans the marks list of every
  known buffer.  The allows FOR-EACH-MARK to be inline-coded in the
  group insert/delete operations.

* Eliminate bug in GROUP-DELETE!: when the gap exceeded
  GAP-MAXIMUM-EXTRA, it was being reduced to GAP-MAXIMUM-EXTRA.  Thus
  a series of deletions would cause the gap to reach that size, then
  each subsequent deletion in the series would pay for a gap
  reduction, which can be thousands (or even millions) of
  instructions, depending on the size of the buffer.  Now when the gap
  reaches maximum size, it is reduced to GAP-ALLOCATION-EXTRA,
  allowing the gap reduction to be amortized over many deletions.

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 743de22cf653a1561b090d1d5cc7594e57650275..94736e7d8cf27a547dfa046ac2368feaf33fe6d1 100644 (file)
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.152 1992/02/10 21:57:09 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.153 1992/04/04 13:07:05 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -62,7 +62,7 @@
   local-bindings-installed?
   initializations
   auto-save-pathname
-  auto-save-state
+  auto-saved?
   save-length
   backed-up?
   modification-time
@@ -85,9 +85,6 @@ The buffer is guaranteed to be deselected at that time."
     (let ((group (make-group (string-copy "") buffer)))
       (vector-set! buffer buffer-index:name name)
       (vector-set! buffer buffer-index:group group)
-      (let ((daemon (buffer-modification-daemon buffer)))
-       (add-group-insert-daemon! group daemon)
-       (add-group-delete-daemon! group daemon))
       (add-group-clip-daemon! group (buffer-clip-daemon buffer))
       (if (not (minibuffer? buffer))
          (enable-group-undo! group))
@@ -109,7 +106,7 @@ The buffer is guaranteed to be deselected at that time."
                   buffer-index:initializations
                   (list (mode-initialization mode)))
       (vector-set! buffer buffer-index:auto-save-pathname false)
-      (set-buffer-auto-save-state! buffer 'NO-CHANGES)
+      (vector-set! buffer buffer-index:auto-saved? false)
       (vector-set! buffer buffer-index:save-length 0)
       (vector-set! buffer buffer-index:backed-up? false)
       (vector-set! buffer buffer-index:modification-time false)
@@ -138,7 +135,7 @@ The buffer is guaranteed to be deselected at that time."
      (vector-set! buffer buffer-index:truename false)
      (buffer-modeline-event! buffer 'BUFFER-PATHNAME)
      (vector-set! buffer buffer-index:auto-save-pathname false)
-     (set-buffer-auto-save-state! buffer 'NO-CHANGES)
+     (vector-set! buffer buffer-index:auto-saved? false)
      (vector-set! buffer buffer-index:save-length 0))))
 
 (define (set-buffer-name! buffer name)
@@ -163,9 +160,6 @@ The buffer is guaranteed to be deselected at that time."
 (define-integrable (set-buffer-auto-save-pathname! buffer pathname)
   (vector-set! buffer buffer-index:auto-save-pathname pathname))
 
-(define-integrable (set-buffer-auto-save-state! buffer state)
-  (vector-set! buffer buffer-index:auto-save-state state))
-
 (define-integrable (set-buffer-save-length! buffer)
   (vector-set! buffer buffer-index:save-length (buffer-length buffer)))
 
@@ -291,34 +285,23 @@ The buffer is guaranteed to be deselected at that time."
           (begin
             (set-group-modified! group false)
             (buffer-modeline-event! buffer 'BUFFER-MODIFIED)
-            (set-buffer-auto-save-state! buffer 'NO-CHANGES)))))))
+            (vector-set! buffer buffer-index:auto-saved? false)))))))
 
 (define (buffer-modified! buffer)
   (without-interrupts
    (lambda ()
-     (%buffer-modified! buffer (buffer-group buffer)))))
-
-(define (buffer-modification-daemon buffer)
-  (lambda (group start end)
-    start end                          ;ignore
-    (%buffer-modified! buffer group)))
-
-(define-integrable (%buffer-modified! buffer group)
-  (cond ((not (group-modified? group))
-        (set-group-modified! group true)
-        (buffer-modeline-event! buffer 'BUFFER-MODIFIED)
-        (set-buffer-auto-save-state! buffer 'UNSAVED-CHANGES))
-       ((eq? 'AUTO-SAVED (buffer-auto-save-state buffer))
-        (set-buffer-auto-save-state! buffer 'AUTO-SAVED+CHANGES))))
+     (let ((group (buffer-group buffer)))
+       (if (not (group-modified? group))
+          (begin
+            (set-group-modified! group true)
+            (buffer-modeline-event! buffer 'BUFFER-MODIFIED)))))))
 
-(define-integrable (set-buffer-auto-saved! buffer)
-  (set-buffer-auto-save-state! buffer 'AUTO-SAVED))
+(define (set-buffer-auto-saved! buffer)
+  (vector-set! buffer buffer-index:auto-saved? true)
+  (set-group-modified! (buffer-group buffer) 'AUTO-SAVED))
 
 (define-integrable (buffer-auto-save-modified? buffer)
-  (memq (buffer-auto-save-state buffer) '(UNSAVED-CHANGES AUTO-SAVED+CHANGES)))
-
-(define-integrable (buffer-auto-saved? buffer)
-  (memq (buffer-auto-save-state buffer) '(AUTO-SAVED AUTO-SAVED+CHANGES)))
+  (eq? true (group-modified? (buffer-group buffer))))
 
 (define (buffer-clip-daemon buffer)
   (lambda (group start end)

diff --git a/v7/src/edwin/debuge.scm b/v7/src/edwin/debuge.scm
index 7e911613127b6f2adc7f3aaf7efb7746ee91b27e..5c56cb3f2fa7f8a5fc6321019acff7069072b2d8 100644 (file)
--- a/v7/src/edwin/debuge.scm
+++ b/v7/src/edwin/debuge.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/debuge.scm,v 1.44 1992/01/13 19:15:42 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/debuge.scm,v 1.45 1992/04/04 13:07:06 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -105,15 +105,6 @@
                (receiver n-existing (1+ n-gced)))))
        (receiver 0 0))))
 \f
-(define-command debug-clean-marks
-  "Perform a GC, then remove GC'ed marks from all buffers."
-  ()
-  (lambda ()
-    (gc-flip)
-    ((ref-command debug-count-marks))
-    (for-each (lambda (buffer) (clean-group-marks! (buffer-group buffer)))
-             (buffer-list))))
-
 (define-command debug-show-standard-marks
   ""
   ()

diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index 12fa8956f87b8d2d4bb738bd937cfbfff281a4dc..9c23ab050c46183a7d0c7c580c24188f77e6968a 100644 (file)
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.218 1992/03/13 10:08:11 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.219 1992/04/04 13:07:07 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -240,6 +240,16 @@ with the contents of the startup message."
 
 (define recursive-edit-continuation)
 (define recursive-edit-level)
+
+(define (editor-gc-daemon)
+  (let ((editor edwin-editor))
+    (if editor
+       (do ((buffers (bufferset-buffer-list (editor-bufferset editor))
+                     (cdr buffers)))
+           ((null? buffers))
+         (clean-group-marks! (buffer-group (car buffers)))))))
+
+(add-gc-daemon! editor-gc-daemon)
 \f
 (define (internal-error-handler condition)
   (cond (debug-internal-errors?

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 6b23a2e8fafa219959278c8364308da059d4e757..41db2686aa97b1e34aab582a5728d80b67a8efbc 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.82 1992/03/26 00:02:40 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.83 1992/04/04 13:07:07 cph Exp $
 
 Copyright (c) 1989-92 Massachusetts Institute of Technology
 
@@ -159,6 +159,7 @@ MIT in each case. |#
   (export (edwin)
          %group-insert-char!
          %group-insert-substring!
+         finish-group-insert!
          gap-allocation-extra
          group-copy-substring!
          group-delete!
@@ -171,8 +172,7 @@ MIT in each case. |#
          group-insert-substring!
          group-left-char
          group-right-char
-         guarantee-gap-length!
-         move-gap-to!))
+         prepare-gap-for-insert!))
 
 (define-package (edwin comtab)
   (files "comtab")
@@ -739,9 +739,7 @@ MIT in each case. |#
          stack-frame/compiled-code?
          write-restarts)
   (import (runtime error-handler)
-         hook/invoke-restart)
-  (import (runtime unparser)
-         *unparse-primitives-by-name?*))
+         hook/invoke-restart))
 
 (define-package (edwin dired)
   (files "dired")

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index b17ab6bc12f4c0a920756eeb43b49d8ef762952c..ed932bf426b195bbf87a34dc5b48534729b00608 100644 (file)
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.106 1992/02/04 04:03:02 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fileio.scm,v 1.107 1992/04/04 13:07:08 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -125,25 +125,14 @@ Each procedure is called with three arguments:
     (let ((length (file-length channel)))
       (without-interrupts
        (lambda ()
-        (move-gap-to! group index)
-        (guarantee-gap-length! group length)))
+        (prepare-gap-for-insert! group index length)))
       (let ((n
             (channel-read channel (group-text group) index (+ index length))))
        (without-interrupts
         (lambda ()
           (let ((gap-start* (fix:+ index n)))
             (undo-record-insertion! group index gap-start*)
-            (vector-set! group
-                         group-index:gap-length
-                         (fix:- (group-gap-length group) n))
-            (vector-set! group group-index:gap-start gap-start*)
-            (for-each-mark group
-              (lambda (mark)
-                (let ((index* (mark-index mark)))
-                  (if (or (fix:> index* index)
-                          (and (fix:= index* index)
-                               (mark-left-inserting? mark)))
-                      (set-mark-index! mark (fix:+ index* n))))))
+            (finish-group-insert! group index n)
             (record-insertion! group index gap-start*))))
        (channel-close channel)
        n))))

diff --git a/v7/src/edwin/grpops.scm b/v7/src/edwin/grpops.scm
index 6e26bc3ae805006e830b06cbace43582732e1e14..98d5b7b956022d842855a04b08e2bb6e7e1b3581 100644 (file)
--- a/v7/src/edwin/grpops.scm
+++ b/v7/src/edwin/grpops.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.15 1992/01/24 23:02:29 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/grpops.scm,v 1.16 1992/04/04 13:07:09 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -54,11 +54,11 @@
 
 ;;; This parameter controls how much extra space (in characters) is
 ;;; allocated when the gap is too small to contain a given insertion.
-(define gap-allocation-extra 2000)
+(define-integrable gap-allocation-extra 2000)
 
 ;;; This parameter controls how large the gap is allowed to be between
 ;;; operations.  It must be at least `gap-allocation-extra'.
-(define gap-maximum-extra 20000)
+(define-integrable gap-maximum-extra 20000)
 
 ;;;; Extractions
 
@@ -104,7 +104,7 @@
 
 (define (group-left-char group index)
   (string-ref (group-text group)
-             (fix:-1+ (group-index->position-integrable group index false))))
+             (fix:- (group-index->position-integrable group index false) 1)))
 
 (define (group-right-char group index)
   (string-ref (group-text group)
@@ -118,136 +118,68 @@
 ;;;; Insertions
 
 (define (group-insert-char! group index char)
-  (without-interrupts
-   (lambda ()
-     (%group-insert-char! group index char)
-     (record-insertion! group index (group-gap-start group)))))
+  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+    (declare (integrate %group-insert-char!))
+    (%group-insert-char! group index char)
+    (if (not (null? (group-insert-daemons group)))
+       (invoke-group-daemons! (group-insert-daemons group)
+                              group index (group-gap-start group)))
+    (set-interrupt-enables! interrupt-mask)))
 
-(define-integrable (%group-insert-char! group index char)
-  (if (group-read-only? group) (barf-if-read-only))
-  (if (not (group-modified? group)) (check-first-group-modification group))
-  (move-gap-to! group index)
-  (guarantee-gap-length! group 1)
-  (let ((gap-start* (fix:1+ index)))
-    (undo-record-insertion! group index gap-start*)
-    (vector-set! group group-index:gap-start gap-start*))
-  (vector-set! group group-index:gap-length (fix:-1+ (group-gap-length group)))
+(define (%group-insert-char! group index char)
+  (if (group-read-only? group)
+      (barf-if-read-only))
+  (if (not (group-modified? group))
+      (check-first-group-modification group))
+  (if (group-undo-data group)
+      (undo-record-insertion! group index (fix:+ index 1)))
+  (prepare-gap-for-insert! group index 1)
   (string-set! (group-text group) index char)
-  (for-each-mark group
-    (lambda (mark)
-      (let ((index* (mark-index mark)))
-       (if (or (fix:> index* index)
-               (and (fix:= index* index)
-                    (mark-left-inserting? mark)))
-           (set-mark-index! mark (fix:+ index* 1)))))))
+  (finish-group-insert! group index 1))
 
 (define (group-insert-string! group index string)
   (group-insert-substring! group index string 0 (string-length string)))
 
 (define (group-insert-substring! group index string start end)
-  (without-interrupts
-   (lambda ()
-     (%group-insert-substring! group index string start end)
-     (record-insertion! group index (group-gap-start group)))))
+  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+    (declare (integrate %group-insert-substring!))
+    (%group-insert-substring! group index string start end)
+    (if (not (null? (group-insert-daemons group)))
+       (invoke-group-daemons! (group-insert-daemons group)
+                              group index (group-gap-start group)))
+    (set-interrupt-enables! interrupt-mask)))
 
-(define-integrable (%group-insert-substring! group index string start end)
-  (if (group-read-only? group) (barf-if-read-only))
-  (if (not (group-modified? group)) (check-first-group-modification group))
-  (move-gap-to! group index)
+(define (%group-insert-substring! group index string start end)
+  (if (group-read-only? group)
+      (barf-if-read-only))
+  (if (not (group-modified? group))
+      (check-first-group-modification group))
   (let ((n (fix:- end start)))
-    (guarantee-gap-length! group n)
-    (let ((gap-start* (fix:+ index n)))
-      (undo-record-insertion! group index gap-start*)
-      (vector-set! group group-index:gap-start gap-start*))
-    (vector-set! group
-                group-index:gap-length
-                (fix:- (group-gap-length group) n))
+    (if (group-undo-data group)
+       (undo-record-insertion! group index (fix:+ index n)))
+    (prepare-gap-for-insert! group index n)
     (substring-move-right! string start end (group-text group) index)
-    (for-each-mark group
-      (lambda (mark)
-       (let ((index* (mark-index mark)))
-         (if (or (fix:> index* index)
-                 (and (fix:= index* index)
-                      (mark-left-inserting? mark)))
-             (set-mark-index! mark (fix:+ index* n))))))))
+    (finish-group-insert! group index n)))
 \f
-;;;; Deletions
-
-(define (group-delete-left-char! group index)
-  (group-delete! group (fix:-1+ index) index))
-
-(define (group-delete-right-char! group index)
-  (group-delete! group index (fix:1+ index)))
-
-(define (group-delete! group start end)
-  (without-interrupts
-   (lambda ()
-     (if (not (fix:= start end))
-        (begin
-          (if (group-read-only? group) (barf-if-read-only))
-          (if (not (group-modified? group))
-              (check-first-group-modification group))
-          ;; Guarantee that the gap is between START and END.
-          (let ((gap-start (group-gap-start group)))
-            (cond ((fix:< gap-start start) (move-gap-to-right! group start))
-                  ((fix:> gap-start end) (move-gap-to-left! group end))))
-          (undo-record-deletion! group start end)
-          (record-deletion! group start end)
-          (let ((length (fix:- end start)))
-            (for-each-mark group
-              (lambda (mark)
-                (let ((index (mark-index mark)))
-                  (cond ((fix:> index end)
-                         (set-mark-index! mark (fix:- index length)))
-                        ((fix:>= index start)
-                         (set-mark-index! mark start)))))))
-          (vector-set! group group-index:gap-start start)
-          (let ((gap-end (fix:+ end (group-gap-length group)))
-                (max-gap-length gap-maximum-extra))
-            (if (fix:> (fix:- gap-end start) max-gap-length)
-                (let* ((new-gap-end (fix:+ start max-gap-length))
-                       (text (group-text group))
-                       (text-end (string-length text))
-                       (new-text-end
-                        (fix:- text-end
-                               (fix:- (fix:- gap-end start) max-gap-length))))
-                  (substring-move-left! text gap-end text-end
-                                        text new-gap-end)
-                  (set-string-maximum-length! text new-text-end)
-                  (vector-set! group group-index:gap-end new-gap-end)
-                  (vector-set! group group-index:gap-length max-gap-length))
-                (begin
-                  (vector-set! group group-index:gap-end gap-end)
-                  (vector-set! group group-index:gap-length
-                               (fix:- gap-end start))))))))))
-\f
-;;;; The Gap
-
-(define (move-gap-to! group index)
-  (let ((gap-start (group-gap-start group)))
-    (cond ((fix:< index gap-start) (move-gap-to-left! group index))
-         ((fix:> index gap-start) (move-gap-to-right! group index)))))
-
-(define (move-gap-to-left! group new-start)
-  (let ((start (group-gap-start group))
-       (length (group-gap-length group))
-       (text (group-text group)))
-    (let ((new-end (fix:+ new-start length)))
-      (substring-move-right! text new-start start text new-end)
-      (vector-set! group group-index:gap-start new-start)
-      (vector-set! group group-index:gap-end new-end))))
-
-(define (move-gap-to-right! group new-start)
-  (let ((start (group-gap-start group))
-       (end (group-gap-end group))
-       (length (group-gap-length group))
-       (text (group-text group)))
-    (let ((new-end (fix:+ new-start length)))
-      (substring-move-left! text end new-end text start)
-      (vector-set! group group-index:gap-start new-start)
-      (vector-set! group group-index:gap-end new-end))))
-
-(define (guarantee-gap-length! group n)
+(define-integrable (prepare-gap-for-insert! group new-start n)
+  (cond ((fix:< new-start (group-gap-start group))
+        (let ((new-end (fix:+ new-start (group-gap-length group))))
+          (substring-move-right! (group-text group)
+                                 new-start
+                                 (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)))
+       ((fix:> new-start (group-gap-start group))
+        (let ((new-end (fix:+ new-start (group-gap-length group))))
+          (substring-move-left! (group-text group)
+                                (group-gap-end group)
+                                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))))
   (if (fix:< (group-gap-length group) n)
       (let ((n
             (fix:+ (fix:- n (group-gap-length group))
@@ -263,4 +195,89 @@
            (substring-move-right! text end end* text* new-end)
            (vector-set! group group-index:text text*)
            (vector-set! group group-index:gap-end new-end)))
-       (vector-set! group group-index:gap-length (fix:+ length n)))))
\ No newline at end of file
+       (vector-set! group group-index:gap-length (fix:+ length n)))))
+
+(define-integrable (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))
+  (do ((marks (group-marks group) (system-pair-cdr marks)))
+      ((null? marks))
+    (if (and (system-pair-car marks)
+            (or (fix:> (mark-index (system-pair-car marks)) index)
+                (and (fix:= (mark-index (system-pair-car marks)) index)
+                     (mark-left-inserting? (system-pair-car marks)))))
+       (set-mark-index! (system-pair-car marks)
+                        (fix:+ (mark-index (system-pair-car marks)) n))))
+  ;; The MODIFIED? bit must not be set until after the undo record is made.
+  (set-group-modified! group true))
+\f
+;;;; Deletions
+
+(define (group-delete-left-char! group index)
+  (group-delete! group (fix:- index 1) index))
+
+(define (group-delete-right-char! group index)
+  (group-delete! group index (fix:+ index 1)))
+
+(define (group-delete! group start end)
+  (if (not (fix:= start end))
+      (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+       (if (group-read-only? group)
+           (barf-if-read-only))
+       (if (not (group-modified? group))
+           (check-first-group-modification group))
+       (if (group-undo-data group)
+           (undo-record-deletion! group start end))
+       (if (not (null? (group-delete-daemons group)))
+           (invoke-group-daemons! (group-delete-daemons group)
+                                  group start end))
+       ;; The MODIFIED? bit must not be set until after the undo
+       ;; record is made.
+       (set-group-modified! group true)
+       (let ((length (fix:- end start)))
+         (do ((marks (group-marks group) (system-pair-cdr marks)))
+             ((null? marks))
+           (cond ((or (not (system-pair-car marks))
+                      (fix:< (mark-index (system-pair-car marks)) start))
+                  unspecific)
+                 ((fix:<= (mark-index (system-pair-car marks)) end)
+                  (set-mark-index! (system-pair-car marks) start))
+                 (else
+                  (set-mark-index!
+                   (system-pair-car marks)
+                   (fix:- (mark-index (system-pair-car marks)) length))))))
+       ;; Guarantee that the gap is between START and END.
+       (cond ((fix:< (group-gap-start group) start)
+              (let ((text (group-text group))
+                    (new-end (fix:+ start (group-gap-length group))))
+                (do ((index (group-gap-end group) (fix:+ index 1))
+                     (index* (group-gap-start group) (fix:+ index* 1)))
+                    ((not (fix:< index new-end)))
+                  (string-set! text index* (string-ref text index)))))
+             ((fix:> (group-gap-start group) end)
+              (let ((text (group-text group)))
+                (do ((index (group-gap-start group) (fix:- index 1))
+                     (index* (group-gap-end group) (fix:- index* 1)))
+                    ((not (fix:< end index)))
+                  (string-set! text
+                               (fix:- index* 1)
+                               (string-ref text (fix:- index 1)))))))
+       (vector-set! group group-index:gap-start start)
+       (let ((gap-end (fix:+ end (group-gap-length group))))
+         (if (fix:> (fix:- gap-end start) gap-maximum-extra)
+             (let* ((new-gap-end (fix:+ start gap-allocation-extra))
+                    (text (group-text group))
+                    (text-end (string-length text)))
+               (substring-move-left! text gap-end text-end
+                                     text new-gap-end)
+               (set-string-maximum-length! text
+                                           (fix:+ new-gap-end
+                                                  (fix:- text-end gap-end)))
+               (vector-set! group group-index:gap-end new-gap-end)
+               (vector-set! group group-index:gap-length
+                            gap-allocation-extra))
+             (begin
+               (vector-set! group group-index:gap-end gap-end)
+               (vector-set! group group-index:gap-length
+                            (fix:- gap-end start)))))
+       (set-interrupt-enables! interrupt-mask))))
\ No newline at end of file