15.4.1151  src/lib/std/src/pack-little-endian-unt1.pkg

## pack-little-endian-unt1.pkg

# Compiled by:
#     src/lib/std/src/standard-core.sublib

# This is the non-native implementation of 32-bit big-endian packing
# operations.

###                     "If there were in the world today any large number of people
###                      who desired their own happiness more than they desired the
###                      unhappiness of others, we could have a paradise in a few years."
###
###                                                    -- Bertrand Russell



stipulate
    package unt= unt_guts;                              # unt_guts              is from   src/lib/std/src/bind-unt-guts.pkg
    package large_unt= large_unt_guts;                  # large_unt_guts        is from   src/lib/std/src/bind-largeword-32.pkg
    package one_byte_unt= one_byte_unt_guts;                    # one_byte_unt_guts     is from   src/lib/std/src/one-byte-unt-guts.pkg
    #
    package lun = large_unt;                            # large_unt             is from   src/lib/std/types-only/bind-largest32.pkg
    package w8  = one_byte_unt;                                 # one_byte_unt                  is from   src/lib/std/types-only/basis-structs.pkg
    package w8v = inline_t::vector_of_one_byte_unts;            # inline_t              is from   src/lib/core/init/built-in.pkg
    package w8a = inline_t::rw_vector_of_one_byte_unts;
herein

package pack_little_endian_unt1: (weak)  Pack_Unt {     # Pack_Unt              is from   src/lib/std/src/pack-unt.api
    #

    bytes_per_element = 4;                              # Possible 64-BIT-ISSUE
    is_big_endian     = FALSE;

    # Convert the byte length into one_word_unt length
    # (n div 4), and check the index:
    #
    fun check_index (len, i)
        =
        {   len =   unt::to_int_x  (unt::(>>) (unt::from_int len, 0u2));
          
            if (not (inline_t::default_int::ltu (i, len)))                      # "ltu" == "less-than (unsigned)" 
                #
                raise exception INDEX_OUT_OF_BOUNDS;
            fi;
        };

    fun make_unt (b1, b2, b3, b4)
        =
        lun::bitwise_or (lun::(<<) (one_byte_unt::to_large_unt b4, 0u24),
        lun::bitwise_or (lun::(<<) (one_byte_unt::to_large_unt b3, 0u16),
        lun::bitwise_or (lun::(<<) (one_byte_unt::to_large_unt b2,  0u8),
                                    one_byte_unt::to_large_unt b1      )));

    fun get_vec (vec, i)
        =
        {   check_index (w8v::length vec, i);

            k = unt::to_int_x (unt::(<<) (unt::from_int i, 0u2));
          
            make_unt (
                w8v::get (vec, k  ),
                w8v::get (vec, k+1),
                w8v::get (vec, k+2),
                w8v::get (vec, k+3)
            );
        };

    # Since large_unt is 32-bits,
    # no sign extension is required:
    #
    fun get_vec_x (vec, i)
        =
        get_vec (vec, i);

    fun get_rw_vec (arr, i)
        =
        {   check_index (w8a::length arr, i);

            k = unt::to_int_x (unt::(<<) (unt::from_int i, 0u2));
          
            make_unt (
                w8a::get (arr, k  ),
                w8a::get (arr, k+1),
                w8a::get (arr, k+2),
                w8a::get (arr, k+3)
            );
        };

    # Since large_unt is 32-bits,
    # no sign extension is required:
    #
    fun get_rw_vec_x (arr, i)
        =
        get_rw_vec (arr, i);
                                                                # Possible 64-BIT-ISSUE.
    fun set                                                     # Store a 32-bit unsigned into a byte array.
          ( vector:  rw_vector_of_one_byte_unts::Rw_Vector,                     # Store into this vector.
            index:   Int,                                       # Store starting at this index in vector.
            value:   large_unt::Unt                             # Store this value into vector.
          )
        =
        {   check_index (w8a::length vector, index);

            k = unt::to_int_x (unt::(<<) (unt::from_int index, 0u2));
          
            w8a::set (vector, k,   w8::from_large_unt             value);
            w8a::set (vector, k+1, w8::from_large_unt (lun::(>>) (value,  0u8)));
            w8a::set (vector, k+2, w8::from_large_unt (lun::(>>) (value, 0u16)));
            w8a::set (vector, k+3, w8::from_large_unt (lun::(>>) (value, 0u24)));
        };

};
end;



## Copyright (c) 2005 by The Fellowship of SML/NJ
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.