DataMuseum.dk

top - download

    Length: 9816 (0x2658)
    Types: TextFile
    Names: »bitops.c«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/gnu-31mar87/scheme/microcode/bitops.c« 

TextFile

/*          Hey EMACS, this is -*- C -*- code!                 */

/****************************************************************
*                                                               *
*                         Copyright (c) 1984                    *
*               Massachusetts Institute of Technology           *
*                                                               *
* This material was developed by the Scheme project at the      *
* Massachusetts Institute of Technology, Department of          *
* Electrical Engineering and Computer Science.  Permission to   *
* copy this software, to redistribute it, and to use it for any *
* purpose is granted, subject to the following restrictions and *
* understandings.                                               *
*                                                               *
* 1. Any copy made of this software must include this copyright *
* notice in full.                                               *
*                                                               *
* 2. Users of this software agree to make their best efforts (a)*
* to return to the MIT Scheme project any improvements or       *
* extensions that they make, so that these may be included in   *
* future releases; and (b) to inform MIT of noteworthy uses of  *
* this software.                                                *
*                                                               *
* 3.  All materials developed as a consequence of the use of    *
* this software shall duly acknowledge such use, in accordance  *
* with the usual standards of acknowledging credit in academic  *
* research.                                                     *
*                                                               *
* 4. MIT has made no warrantee or representation that the       *
* operation of this software will be error-free, and MIT is     *
* under no obligation to provide any services, by way of        *
* maintenance, update, or otherwise.                            *
*                                                               *
* 5.  In conjunction with products arising from the use of this *
* material, there shall be no use of the name of the            *
* Massachusetts Institute of Technology nor of any adaptation   *
* thereof in any advertising, promotional, or sales literature  *
* without prior written consent from MIT in each case.          *
*                                                               *
****************************************************************/
\f


/* File: BITOPS.C 
 *  
 * Additional bit string support
 */

/* This file extends C-SCHEME's bit string representation to represent
    infinite length bit strings; in this representation, virtual bits
    off the edge of the actual bit string are treated as zero or false.
    Logical operations can be performed on bit strings; one may take 
    bitwise AND or OR of two bit strings.   These procedures return new
    bit strings.
   All operations on bit strings are functional; they construct new bit 
    strings rather than modifying existing bit strings.  
*/

#include "scheme.h"
#include "primitive.h"

\f


/*(BIT-STRING-CHECK bitstring index)
   Treats <bitstring> as an infinite bitstring and
   extracts the <index>th bit of it; this will be either
   TRUE or FALSE;  if <index> is off the edge of the
   implemented bitstring, FALSE is returned.
*/

/* Assumes bits off the end of the bit string are zero. */
Define_Primitive(Prim_BSt_Check, 2, "BIT-STRING-CHECK")
{ long  Word_No, Offset, Mask, *Data_Start;
  Primitive_2_Args();
  Arg_1_Type(TC_BIT_STRING);
  Arg_2_Type(TC_FIXNUM);
  Offset=Get_Integer(Arg2);
  if (Offset > Vector_Ref(Arg1,NM_ENTRY_COUNT)) return NIL;
     else {Data_Start = (long *) Nth_Vector_Loc(Arg1,NM_DATA);
	   Word_No = Offset/POINTER_LENGTH;
	   Mask = 1 << Offset % POINTER_LENGTH;
	   if ((Data_Start[Word_No] & Mask) != 0) return TRUTH;
	   else return NIL;
	 }
}

\f


/*(BIT-STRING-AND bitstring1 bitstring2)
   Returns a new bitstring which is the logical 
   bitwise AND of <bitstring1> and <bitstring2>. 
   The length of this bitstrings actual representation
   is the shorter of the lengths of the two input 
   bitstrings.
*/

Define_Primitive(Prim_BSt_And, 2, "BIT-STRING-AND")
{ fast Pointer short_string, long_string;
  long bit_count, new_vec_size, *bits1, *bits2, i;
  Primitive_2_Args();
  Arg_1_Type(TC_BIT_STRING);
  Arg_2_Type(TC_BIT_STRING);
  if (Vector_Ref(Arg1,NM_ENTRY_COUNT) > Vector_Ref(Arg2,NM_ENTRY_COUNT))
    {long_string=Arg1;short_string=Arg2;}
  else {long_string=Arg2; short_string=Arg1;}
  bit_count=Vector_Ref(short_string,NM_ENTRY_COUNT);
  new_vec_size=(bit_count+POINTER_LENGTH-1)/POINTER_LENGTH;
  Primitive_GC_If_Needed(Free+NM_HEADER_LENGTH+new_vec_size+1);
  Free[NM_VECTOR_HEADER]=Make_Non_Pointer(TC_MANIFEST_NM_VECTOR,new_vec_size+NM_HEADER_LENGTH-1);
  Free[NM_ENTRY_COUNT]=bit_count;
  Free=Free+NM_HEADER_LENGTH;
  bits1= (long *) Nth_Vector_Loc(long_string, NM_DATA);
  bits2= (long *) Nth_Vector_Loc(short_string, NM_DATA);
  for (i=0; i < new_vec_size; i++) *Free++ = bits1[i]&bits2[i];
  return Make_Pointer(TC_BIT_STRING, Free-(new_vec_size+NM_HEADER_LENGTH));
}

\f


/*(BIT-STRING-OR bitstring1 bitstring2)
   Returns a new bitstring which is the logical 
   bitwise OR of <bitstring1> and <bitstring2>. 
   The length of this bitstrings actual representation
   is the shorter of the lengths of the two input 
   bitstrings.
*/

Define_Primitive(Prim_BSt_Or, 2, "BIT-STRING-OR")
{ fast Pointer short_string, long_string;
  long bit_count, new_vec_size;
  long short_count, short_vec_size;
  long *bits1, *bits2, i;
  Primitive_2_Args();
  Arg_1_Type(TC_BIT_STRING);
  Arg_2_Type(TC_BIT_STRING);
  if (Vector_Ref(Arg1,NM_ENTRY_COUNT) > Vector_Ref(Arg2,NM_ENTRY_COUNT))
    {long_string=Arg1;short_string=Arg2;}
  else {long_string=Arg2; short_string=Arg1;}
  bit_count=Vector_Ref(long_string,NM_ENTRY_COUNT);
  new_vec_size=(bit_count+POINTER_LENGTH-1)/POINTER_LENGTH;
  short_count=Vector_Ref(short_string,NM_ENTRY_COUNT);
  short_vec_size=(short_count+POINTER_LENGTH-1)/POINTER_LENGTH;
  Primitive_GC_If_Needed(Free+NM_HEADER_LENGTH+new_vec_size+1);
  Free[NM_VECTOR_HEADER]=Make_Non_Pointer(TC_MANIFEST_NM_VECTOR,new_vec_size+NM_HEADER_LENGTH-1);
  Free[NM_ENTRY_COUNT]=bit_count;
  Free=Free+NM_HEADER_LENGTH;
  bits1= (long *) Nth_Vector_Loc(long_string, NM_DATA);
  bits2= (long *) Nth_Vector_Loc(short_string, NM_DATA);
  for (i=0; i < short_vec_size; i++) *Free++ = bits1[i]|bits2[i];
  for (i=i; i < new_vec_size; i++) *Free++ = bits1[i];
  return Make_Pointer(TC_BIT_STRING, Free-(new_vec_size+NM_HEADER_LENGTH));
}

\f


/*(SAME-BIT-STRING? string1 string2)
  Returns true if string1 and string2 are identical infinite bit
  strings (with infinite false extent).
*/

Define_Primitive(Prim_Compare_Bit_String,2,"SAME-BIT-STRING?")
{ Pointer long_string, short_string;
  long i, long_length, short_length, *long_data, *short_data;
  Primitive_3_Args();
  Arg_1_Type(TC_BIT_STRING);
  Arg_2_Type(TC_BIT_STRING);
  if (Vector_Ref(Arg1,NM_ENTRY_COUNT) > Vector_Ref(Arg2,NM_ENTRY_COUNT))
    {long_string=Arg1;short_string=Arg2;}
  else {long_string=Arg2; short_string=Arg1;}
  long_length=(Vector_Ref(long_string,NM_ENTRY_COUNT)+POINTER_LENGTH-1)/POINTER_LENGTH;
  short_length=(Vector_Ref(short_string,NM_ENTRY_COUNT)+POINTER_LENGTH-1)/POINTER_LENGTH;
  short_data= (long *) Nth_Vector_Loc(short_string, NM_DATA); 
  long_data=  (long *) Nth_Vector_Loc(long_string, NM_DATA); 
  for (i=0; i < short_length; i++)
    if (long_data[i] != short_data[i]) return NIL;
  for (i=i; i < long_length; i++)
    if (long_data[i] != 0) return NIL;
  return TRUTH;
}
     

\f


/*(BIT-STRING-MODIFY bitstring index value)
  Returns a bitstring which is a copy of <bitstring>
  with the <index>th element set to <value> (which
  must be boolean).
*/
 
Define_Primitive(Prim_BSt_Mod, 3, "BIT-STRING-MODIFY")
{ Boolean value_to_set;
  long Offset, Word_No, Mask, size, *Vector_Start, *Copy_Start;
  Pointer result;
  Primitive_3_Args();
  Arg_1_Type(TC_BIT_STRING);
  Arg_2_Type(TC_FIXNUM);
  if (Arg3 == NIL) value_to_set=false;
  else value_to_set=true;
  Offset=Get_Integer(Arg2);
  Word_No = Offset/POINTER_LENGTH;
  Mask = 1 << Offset % POINTER_LENGTH;
  size = Vector_Ref(Arg1,NM_ENTRY_COUNT);
  if (Offset < size) 
    {Vector_Start = (long *) Nth_Vector_Loc(Arg1,NM_DATA);
     if ((Vector_Start[Word_No] & Mask) != 0)
       if (value_to_set) return Arg1; else result=extend_bit_string(Arg1,size);
     else
       if (value_to_set) result=extend_bit_string(Arg1,size); else return Arg1;
   }
  else
    if (value_to_set) result=extend_bit_string(Arg1,Offset+1);
    else return Arg1;
  Copy_Start= (long *) Nth_Vector_Loc(result,NM_DATA);
  if (value_to_set)
    Copy_Start[Word_No] = Copy_Start[Word_No] | Mask;
  else Copy_Start[Word_No] = Copy_Start[Word_No] & ~Mask;
  return result;
}

\f


/* Support for BIT-STRING-MODIFY */

#define EMPTY_POINTER	((Pointer) 0)

extend_bit_string(string,to_size)
Pointer string; long to_size;
{ long vec_size, i, copy_size;
  long zero_pointer, *copy_data;
  vec_size=(to_size+POINTER_LENGTH-1)/POINTER_LENGTH;
  Primitive_GC_If_Needed(Free+vec_size+NM_HEADER_LENGTH+1);
  Free[NM_VECTOR_HEADER]=
    Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, vec_size+NM_HEADER_LENGTH-1);
  Free[NM_ENTRY_COUNT]=to_size;
  copy_size= (Vector_Ref(string,NM_ENTRY_COUNT)+POINTER_LENGTH-1)/POINTER_LENGTH;
  copy_data= (long *) Nth_Vector_Loc(string, NM_DATA);
  zero_pointer= EMPTY_POINTER;
  Free=Free+NM_HEADER_LENGTH;
  for (i=0; ((i < vec_size) && (i < copy_size)); i++) *Free++=copy_data[i];
  for (i=i; i < vec_size ; i++) *Free++= zero_pointer;
  return Make_Pointer(TC_BIT_STRING, Free-(vec_size+NM_HEADER_LENGTH));
}