hextet.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand        --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------


immutable class HEXTET < $BIT_PATTERN{HEXTET}

immutable class HEXTET < $BIT_PATTERN{HEXTET} is -- This class is a primitive immutable class which has sixteen bits, -- but otherwise may have any meaning. Only equality and bit operations -- are specified in addition to string representation conversions. -- It is intended for use when using codes of sixteen bits (UCS2 in -- oarticular) and for accessing hardware devices of this 'width'. -- Version 1.1 Jul 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 19 Dec 96 kh Original -- 22 Jul 98 kh Added $BINARY features include AVAL{BIT} asize-> ; include COMPARABLE ; include BINARY ; const asize : CARD := 16 ; const Hextet_Bits : CARD := asize ; const Hextet_Max : CARD := 65535 ; -- It IS sixteen bits only! const maxnum : CARD := Hextet_Max ; const Octets_in_Hextet : CARD := 2 ; -- This is the largest unsigned exact number representable using the -- number of bits contained. private const Masks : ARRAY{SAME} := | create(1), create(3), create(7), create(15), create(31), create(63), create(127), create(255), create(511), create(1023), create(2047), create(4095), create(8191), create(16383), create(32767), create(65535) | ; create : SAME pre true post (result.card = 0) is -- This creates with all bits zero! me : SAME := void ; return me end ; null : SAME is -- Merely a renamed version of create above! return create end ; create( val : CARD ) : SAME pre (val <= Hextet_Max) post (result.card = val) is -- This produces a new object which takes the value val as a bit-pattern -- provided that the pre-condition is met. It relies on the built-in -- conversion CARD_HEXTET operation builtin CARD_HEXTET end ; create(val : CHAR) : SAME pre (val.code.card <= Hextet_Max) post (result.card = val.digit_value) is -- This routine produces a new character object which takes the value -- val as a bit-pattern. It is implemented in this implementation using -- a compiler built-in operation. builtin CHAR_HEXTET end ; build( cursor : BIN_CURSOR ) : SAME pre (cursor.remaining >= (asize / OCTET::Octet_Bits)) post true -- beware initial side-effects! is -- This routine creates a new hextet from the string (which is stored -- MS octet first!) and returns its 'value'. return ((cursor.get_item).hextet.left(OCTET::Octet_Bits)).bit_or( cursor.get_item.hextet) end ; code_value : ARRAY{SAME} is -- This routine yields an array of hextets - which in this case has -- length one! res : ARRAY{SAME} := ARRAY{SAME}::create(1) ; res.aset(0,self) ; return res end ; binstr : BINSTR pre true post create(result) = self is -- This routine 'converts' the value of self into a two-element binary -- string 'representation' - MS octet first. return BINSTR::create + self.right(OCTET::Octet_Bits).octet + octet end ; octet : OCTET pre true post create(result.card) = self is -- This routine returns the octet object which contains the low eight -- bits of self. builtin HEXTET_OCTET end ; hextet : SAME pre true post create(result.card) = self is -- This routine returns a copy of self. This is included here for -- symmetry with the other bit-pattern classes. return self end ; quad : QUADBITS pre true post (CARD::create(result.binstr.head(2)) = 0) -- two MS octets and (create(result.binstr.tail(2)) = self) is -- This routine returns the four octet object which contains self in -- the lower sixteen bits. builtin HEXTET_QUADBITS end ; char : CHAR pre true post create(result) = self is -- This routine creates a character from the bit-pattern which is self. builtin HEXTET_CHAR end ; card : CARD pre true post create(result) = self is -- This routine converts self into a number-sized exact unsigned numeric -- value. builtin HEXTET_CARD end ; bool : BOOL is -- This feature converts the hextet into a truth value where no bits set -- is the value false. return ~card.is_zero end ; hash : CARD pre true post true is -- This routine returns a hash value composed from the bit-pattern -- contained. return NUM_BITS::create(card).hash end ; int : INT pre true post create(result.card) = self is -- This converts self into a number-sized exact numeric signed value. return card.int end ; is_eq( other : SAME ) : BOOL is -- This and its inverse are the only two relational operations valid -- on a hextet. builtin HEXTET_IS_EQ end ; bit( index : CARD ) : BIT pre (index < Hextet_Bits) post (result = aget(index)) is -- This routine returns the value of the individual bit indicated. return aget(index) end ; alter( index : CARD, val : BIT ) : SAME pre (index < Hextet_Bits) post (result[index] = val) is -- This routine sets the value of the individual bit indicated. res : SAME := self ; res.aset(index,val) ; return res end ; slice( lsb : CARD, count : CARD ) : SAME pre lsb < Hextet_Bits and count > 0 and (lsb + count) <= Hextet_Bits post true is -- This routine returns the octet containing the indicated slice in the -- lowest count bits. loc_mask : SAME := Masks[count - 1].left(lsb) ; return self.bit_and(loc_mask).right(lsb) end ; slice( lsb : CARD, count : CARD, val : SAME ) : SAME pre lsb < Hextet_Bits and count > 0 and (lsb + count) <= Hextet_Bits post true is -- This routine returns the hextet containing the indicated slice in the -- bits starting at lsb. loc_chunk : SAME := val.bit_and(Masks[count - 1]).left(lsb) ; loc_mask : SAME := Masks[count - 1].left(lsb).bit_invert ; return self.bit_and(loc_mask).bit_or(loc_chunk) end ; set( index : CARD ) : BOOL pre (index < Hextet_Bits) post (result = ([index] = setbit)) is -- This returns true if and only if the indexed bit of this hextet is -- set. If the value of index is greater than or equal to Hextet_Bits -- then false is returned -- since the bit does not exist. return bit(index).set end ; clear( index : CARD ) : BOOL pre (index < Hextet_Bits) post (result = ([index] = clearbit)) is -- This returns true if and only if the indexed bit of this hextet is -- clear. If the value of index is greater than or equal to Hextet_Bits -- then false is returned -- since the bit does not exist. return bit(index).clear end ; bit_and( other : SAME ) : SAME is -- This built-in primitive returns the result of anding together each bit -- of self and other builtin HEXTET_AND -- compiler primitive end ; bit_or( other : SAME ) : SAME is -- This built-in primitive returns the result of oring together each bit -- of self and other builtin HEXTET_OR -- compiler primitive end ; bit_invert : SAME is -- This built-in primitive returns the result of inverting all -- individual bits of self. builtin HEXTET_INVERT -- compiler primitive end ; bit_xor( other : SAME ) : SAME is -- This built-in primitive returns the result of xoring together each bit -- of self and other builtin HEXTET_XOR -- compiler primitive end ; private shift( places : INT ) : SAME is -- This built-in primitive returns the result of shifting the bits in -- self by the specified number of places (left if +ve). Any necessary -- pre-conditions are satisfied by the public routines right and left. builtin HEXTET_SHIFT -- compiler primitive end ; left( places : CARD ) : SAME pre true post ((places.abs.card = Hextet_Bits) and (result = create)) or (result[places] = initial([0])) is -- This built-in primitive returns the result of shifting the bits in -- self left by the specified number of places. if (places = Hextet_Bits) then return create else return shift(places.int) end end ; right( places : CARD ) : SAME pre true post ((places = Hextet_Bits) and (result = create)) or (result[Hextet_Bits - 1 - places] = initial([Hextet_Bits - 1])) is -- This built-in primitive returns the result of shifting the bits in -- self right by the specified number of places (which may not be -ve). if (places = Hextet_Bits) then return create else return shift(-(places.int)) end end ; highest( val : BIT ) : CARD pre true post (result = CARD::nil) or (result < Hextet_Bits) is -- This routine returns the index of the highest bit in the hextet which -- has the value val. If no bits are set then the value CARD::nil is -- returned. loop index : CARD := (Hextet_Bits - 1).downto!(0) ; if ([index] = val) then return index end end ; return CARD::nil end ; lowest( val : BIT ) : CARD pre true post (result = CARD::nil) or (result < Hextet_Bits) is -- This routine returns the index of the lowest bit which has the same -- value as val - or CARD::nil if there are no such bits. loop index : CARD := 0.upto!(Hextet_Bits - 1) ; if ([index] = val) then return index end end ; return CARD::nil end ; highest : CARD pre true post (result = CARD::nil) or (result < Hextet_Bits) is -- This routine returns the index of the highest set bit in the hextet. -- This is used in logarithmic and exponential routines for numbers. If -- no bits are set then the value CARD::nil is returned. loop index : CARD := (Hextet_Bits - 1).downto!(0) ; if set(index) then return index end end ; return CARD::nil end ; lowest : CARD pre true post (result = CARD::nil) or (result < Hextet_Bits) is -- This routine returns the index of the lowest set bit in the hextet. -- This is used in logarithmic and exponential routines for numbers. If -- no bits are set then the value CARD::nil is returned. loop index : CARD := 0.upto!(Hextet_Bits - 1) ; if set(index) then return index end end ; return CARD::nil end ; octet! : OCTET pre true post (result.card <= OCTET::Octet_Max) is -- This iter yields successive octets of self starting with the least -- significant bits. loc_val : SAME := self ; loop Octets_in_Hextet.times! ; yield loc_val.octet ; loc_val := loc_val.right(OCTET::Octet_Bits) end end ; hex_str( lib : LIBCHARS ) : STR pre ~void(lib) post create(CARD::build_based(result.cursor,16)) = self is -- This routine yields a hexadecimal string representation of the hextet -- using the specified encoding and repertoire. return self.card.hex_str(lib,4) end ; hex_str : STR pre true post create(CARD::build_based(result.cursor,16)) = self is -- This routine yields a hexadecimal string representation of the hextet -- using the default encoding and repertoire. return self.card.hex_str(LIBCHARS::default,4) end ; str( lib : LIBCHARS ) : STR pre ~void(lib) post result.size = hex_str.size + 2 is -- This routine yields a string representation of the hextet in -- hexadecimal form using the given encoding and repertoire. return STR::create(lib) + lib.digit(0).char + lib.Hex_Prefix.char + hex_str(lib) end ; str : STR pre true post result.size = hex_str.size + 2 is -- This routine yields a string representation of the hextet -- in the default encoding and repertoire. return str(LIBCHARS::default) end ; end ; -- HEXTET