fasl: move uptr continue bit from low to high

Use the high bit of a byte to continue instead of the low bit.
That way, ASCII strings look like themselves in uncompressed fasl
form.

original commit: 89a8d24cc051123a7b2b6818c5c4aef144d48797

c/fasl.c

@@ -393,12 +393,12 @@ static uptr uf_uptrin(unbufFaslFile uf) {
   uptr n, m; octet k;
 
   k = uf_bytein(uf);
-  n = k >> 1;
-  while (k & 1) {
+  n = k & 0x7F;
+  while (k & 0x80) {
     k = uf_bytein(uf);
     m = n << 7;
     if (m >> 7 != n) toolarge(uf->path);
-    n = m | (k >> 1);
+    n = m | (k & 0x7F);
   }
 
   return n;
@@ -571,12 +571,12 @@ static uptr uptrin(faslFile f) {
   uptr n, m; octet k;
 
   k = bytein(f);
-  n = k >> 1;
-  while (k & 1) {
+  n = (k & 0x7F);
+  while (k & 0x80) {
     k = bytein(f);
     m = n << 7;
     if (m >> 7 != n) toolarge(f->uf->path);
-    n = m | (k >> 1);
+    n = m | (k & 0x7F);
   }
 
   return n;

c/scheme.c

@@ -819,13 +819,13 @@ static uptr zget_uptr(glzFile file, uptr *pn) {
 
   if ((c = S_glzgetc(file)) < 0) return -1;
   k = (octet)c;
-  n = k >> 1;
-  while (k & 1) {
+  n = k & 0x7F;
+  while (k & 128) {
     if ((c = S_glzgetc(file)) < 0) return -1;
     k = (octet)c;
     m = n << 7;
     if (m >> 7 != n) return -1;
-    n = m | (k >> 1);
+    n = m | (k  & 0x7F);
   }
   *pn = n;
   return 0;

makefiles/Mf-install.in

@@ -62,7 +62,7 @@ InstallLZ4Target=
 #                 no changes should be needed below this point                #
 ###############################################################################
 
-Version=csv9.5.3.6
+Version=csv9.5.3.7
 Include=boot/$m
 PetiteBoot=boot/$m/petite.boot
 SchemeBoot=boot/$m/scheme.boot

s/7.ss

@@ -124,10 +124,10 @@
     (define $bv-fasl-read (foreign-procedure "(cs)bv_fasl_read" (ptr int uptr uptr ptr) ptr))
     (define (get-uptr p)
       (let ([k (get-u8 p)])
-        (let f ([k k] [n (fxsrl k 1)])
-          (if (fxlogbit? 0 k)
+        (let f ([k k] [n (fxand k #x7F)])
+          (if (fxlogbit? 7 k)
               (let ([k (get-u8 p)])
-                (f k (logor (ash n 7) (fxsrl k 1))))
+                (f k (logor (ash n 7) (fxand k #x7F))))
               n))))
     (define (malformed p) ($oops 'fasl-read "malformed fasl-object header found in ~s" p))
     (define (check-header p)

s/cmacros.ss

@@ -328,7 +328,7 @@
                  [(_ foo e1 e2) e1] ...
                  [(_ bar e1 e2) e2]))))])))
 
-(define-constant scheme-version #x09050306)
+(define-constant scheme-version #x09050307)
 
 (define-syntax define-machine-types
   (lambda (x)

s/fasl-helpers.ss

@@ -127,10 +127,10 @@
         ($oops 'compiler-internal "put-uptr received negative input ~s" n))
       (let f ([n n] [cbit 0])
         (if (and (fixnum? n) (fx<= n 127))
-            (put-u8 p (fxlogor (fxsll n 1) cbit))
+            (put-u8 p (fxlogor n cbit))
             (begin
-              (f (ash n -7) 1)
-              (put-u8 p (fxlogor (fxsll (logand n #x7f) 1) cbit)))))))
+              (f (ash n -7) 128)
+              (put-u8 p (fxlogor (logand n #x7f) cbit)))))))
 )
 
 (define emit-header

s/strip.ss

@@ -87,10 +87,10 @@
     (define read-uptr
       (lambda (p)
         (let ([k (read-byte p)])
-          (let f ([k k] [n (fxsrl k 1)])
-            (if (fxlogbit? 0 k)
+          (let f ([k k] [n (fxand k #x7F)])
+            (if (fxlogbit? 7 k)
                 (let ([k (read-byte p)])
-                  (f k (logor (ash n 7) (fxsrl k 1))))
+                  (f k (logor (ash n 7) (fxand k #x7F))))
                 n)))))
     (define read-byte-or-eof
       (lambda (p)
@@ -663,10 +663,10 @@
           (sorry! "received negative input ~s" n))
         (let f ([n n] [cbit 0])
           (if (and (fixnum? n) (fx<= n 127))
-              (write-byte p (fxlogor (fxsll n 1) cbit))
+              (write-byte p (fxlogor n cbit))
               (begin
-                (f (ash n -7) 1)
-                (write-byte p (fxlogor (fxsll (logand n #x7f) 1) cbit)))))))
+                (f (ash n -7) 128)
+                (write-byte p (fxlogor (logand n #x7f) cbit)))))))
 
     (define write-iptr
       (lambda (p x)