From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Mon, 17 Aug 1987 19:33:01 +0000 (+0000)
Subject: Fix bug in read/write-bits! and make them work on the VAX.
X-Git-Tag: 20090517-FFI~13151
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=733bbadbfbee9b042fd61391cc3b81ef5416fff5;p=mit-scheme.git

Fix bug in read/write-bits! and make them work on the VAX.
---

diff --git a/v7/src/microcode/bitstr.c b/v7/src/microcode/bitstr.c
index 9c1f81da8..520691a50 100644
--- a/v7/src/microcode/bitstr.c
+++ b/v7/src/microcode/bitstr.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bitstr.c,v 9.32 1987/08/06 19:58:57 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bitstr.c,v 9.33 1987/08/17 19:31:42 jinx Exp $
 
    Bit string primitives. 
 
@@ -786,12 +786,16 @@ Built_In_Primitive( Prim_bit_string_to_unsigned, 1,
 
 #define read_bits_initialize()						\
   long end, end_mod, offset;						\
+  Pointer *start;							\
   Primitive_3_Args ();							\
 									\
   CHECK_ARG (3, BIT_STRING_P);						\
   end = (bit_string_length (Arg3));					\
   end_mod = (end % POINTER_LENGTH);					\
-  offset = (arg_nonnegative_integer (2))
+  offset = (arg_nonnegative_integer (2));				\
+  start = read_bits_ptr(Arg1, offset, end);				\
+  compute_read_bits_offset(offset, end)
+
 
 /* (READ-BITS! pointer offset bit-string)
    Read the contents of memory at the address (POINTER,OFFSET)
@@ -801,7 +805,7 @@ Built_In_Primitive (Prim_read_bits_x, 3, "READ-BITS!", 0xDF)
 {
   read_bits_initialize();
 
-  copy_bits ((object_msw_ptr(Arg1, (offset + end))),
+  copy_bits (start,
 	     offset,
 	     (Nth_Vector_Loc (Arg3, (index_to_word (Arg3, (end - 1))))),
 	     ((end_mod == 0) ? 0 : (POINTER_LENGTH - end_mod)),
@@ -819,7 +823,7 @@ Built_In_Primitive (Prim_write_bits_x, 3, "WRITE-BITS!", 0xE0)
 
   copy_bits ((Nth_Vector_Loc (Arg3, (index_to_word (Arg3, (end - 1))))),
 	     ((end_mod == 0) ? 0 : (POINTER_LENGTH - end_mod)),
-	     (object_msw_ptr(Arg1, (offset + end))),
+	     start,
 	     offset,
 	     end);
   PRIMITIVE_RETURN( NIL);
diff --git a/v7/src/microcode/bitstr.h b/v7/src/microcode/bitstr.h
index c8977aaaf..c01329058 100644
--- a/v7/src/microcode/bitstr.h
+++ b/v7/src/microcode/bitstr.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bitstr.h,v 1.3 1987/08/06 05:03:44 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bitstr.h,v 1.4 1987/08/17 19:32:28 jinx Rel $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -37,28 +37,28 @@ MIT in each case. */
 #define BIT_STRING_LENGTH_OFFSET	1
 #define BIT_STRING_FIRST_WORD		2			     
 
-#define bits_to_pointers(bits)					\
+#define bits_to_pointers(bits)						\
 (((bits) + (POINTER_LENGTH - 1)) / POINTER_LENGTH)
 
 #define low_mask(nbits) ((1 << (nbits)) - 1)
 #define any_mask(nbits, offset) ((low_mask (nbits)) << (offset))
 
-#define bit_string_length(bit_string)				\
+#define bit_string_length(bit_string)					\
 (Fast_Vector_Ref (bit_string, BIT_STRING_LENGTH_OFFSET))
 
-#define bit_string_start_ptr(bit_string)			\
+#define bit_string_start_ptr(bit_string)				\
 (Nth_Vector_Loc (bit_string, BIT_STRING_FIRST_WORD))
 
-#define bit_string_end_ptr(bit_string)				\
+#define bit_string_end_ptr(bit_string)					\
 (Nth_Vector_Loc (bit_string, ((Vector_Length (bit_string)) + 1)))
 
-#define bit_string_msw(bit_string)				\
+#define bit_string_msw(bit_string)					\
 (bit_string_word(bit_string_high_ptr(bit_string)))
 
-#define bit_string_lsw(bit_string)				\
+#define bit_string_lsw(bit_string)					\
 (bit_string_word(Nth_Vector_Loc(bit_string, index_to_word(bit_string, 0))))
 
-#define index_pair_to_bit_fixnum(string, word, bit)		\
+#define index_pair_to_bit_fixnum(string, word, bit)			\
 (Make_Unsigned_Fixnum (index_pair_to_bit_number (string, word, bit)))
 
 /* Byte order dependencies. */
@@ -102,17 +102,24 @@ The "size in bits" is a C "long" integer.
 
 #define inc_bit_string_ptr(ptr)		((ptr)++)
 
-#define object_msw_ptr(object, length)				\
-(Get_Pointer(object) + bits_to_pointers(length - 1))
-
 /* This is off by one so bit_string_word will get the correct word. */
 
-#define index_to_word(bit_string, index)			\
+#define index_to_word(bit_string, index)				\
 ((BIT_STRING_FIRST_WORD + 1) + (index / POINTER_LENGTH))
 
-#define index_pair_to_bit_number(string, word, bit)		\
+#define index_pair_to_bit_number(string, word, bit)			\
 (((word) * POINTER_LENGTH) + (bit))
 
+#define read_bits_ptr(object, offset, end)				\
+(Nth_Vector_Loc(object, bits_to_pointers((offset + end) - 1)))
+
+#define compute_read_bits_offset(offset, end)				\
+{									\
+  offset = ((offset + end) % POINTER_LENGTH);				\
+  if (offset != 0)							\
+    offset = (POINTER_LENGTH - offset);					\
+}
+
 
 
 #else /* not VAX_BYTE_ORDER */
@@ -153,18 +160,24 @@ The "size in bits" is a C "long" integer.
 
 #define inc_bit_string_ptr(ptr)		(--(ptr))
 
-#define object_msw_ptr(object, length)	(Get_Pointer(object))
-
 /* This is especially clever.  To understand it, note that the index
    of the last pointer of a vector is also the GC length of the
    vector, so that all we need do is subtract the zero-based word
    index from the GC length. */
 
-#define index_to_word(bit_string, index)			\
+#define index_to_word(bit_string, index)				\
 ((Vector_Length (bit_string)) - (index / POINTER_LENGTH))
 
-#define index_pair_to_bit_number(string, word, bit)		\
+#define index_pair_to_bit_number(string, word, bit)			\
 ((((Vector_Length (string)) - (word)) * POINTER_LENGTH) + (bit))
 
+#define read_bits_ptr(object, offset, end)				\
+(Nth_Vector_Loc((object), ((offset) / POINTER_LENGTH)))
+
+#define compute_read_bits_offset(offset, end)				\
+{									\
+  offset = (offset % POINTER_LENGTH);					\
+}
+
 
 #endif /* VAX_BYTE_ORDER */
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 8e6b0baf7..fadf04b61 100644
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.97 1987/08/12 21:22:33 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.98 1987/08/17 19:33:01 jinx Exp $
 
 This file contains version information for the microcode. */
 
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION		9
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	97
+#define SUBVERSION	98
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index c3aaae907..cfc7757d1 100644
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.97 1987/08/12 21:22:33 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.98 1987/08/17 19:33:01 jinx Exp $
 
 This file contains version information for the microcode. */
 
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION		9
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	97
+#define SUBVERSION	98
 #endif
 
 #ifndef UCODE_TABLES_FILENAME