Eliminate case where over-long literal was being emitted.
authorChris Hanson <org/chris-hanson/cph>
Sat, 16 Jul 1994 21:12:36 +0000 (21:12 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 16 Jul 1994 21:12:36 +0000 (21:12 +0000)
v7/src/runtime/cpress.scm

index 7b0955b042db704fd9910a2de951fdb4c02a050a..ae6937178126ce262bd28b1174490b9ca4e6c7a5 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: cpress.scm,v 1.5 1994/07/16 20:48:50 cph Exp $
+$Id: cpress.scm,v 1.6 1994/07/16 21:12:36 cph Exp $
 
 Copyright (c) 1992-94 Massachusetts Institute of Technology
 
@@ -539,11 +539,13 @@ MIT in each case. |#
   (let ((bp command-bp)
        (ptr (bb-ptr byte-buffer)))
     (if (not (fix:= ptr bp))
-       (write-literal
-        (fix:- (if (fix:< bp ptr)
-                   ptr
-                   (fix:+ ptr buffer-size))
-               bp))))
+       (let loop
+           ((nb (fix:- (if (fix:< bp ptr) ptr (fix:+ ptr buffer-size)) bp)))
+         (if (fix:<= nb literal-max)
+             (write-literal nb)
+             (begin
+               (write-literal literal-max)
+               (loop (fix:- nb literal-max)))))))
   (compress-continuation unspecific))
 
 (define (input-port/read-substring port string start end)