15.4.1150  src/lib/std/src/pack-big-endian-unt16.pkg

## pack-big-endian-unt16.pkg

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

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

###                   "For the strength of the Pack is the Wolf,
###                    and the strength of the Wolf is the Pack."
###
###                                      -- Rudyard Kipling



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_big_endian_unt16: (weak)  Pack_Unt     {       # Pack_Unt              is from   src/lib/std/src/pack-unt.api


        bytes_per_element = 2;
        is_big_endian = TRUE;

        # Convert the byte length into word16
        # length (n div 2), and check the index:
        #
        fun check_index (len, i)
            =
            {   len = unt::to_int_x (unt::(>>) (unt::from_int len, 0u1));

                if (inline_t::default_int::ltu (i, len))  (); else raise exception INDEX_OUT_OF_BOUNDS;fi;
            };

        fun make_word (b1, b2)
            =
            lun::bitwise_or (lun::(<<) (one_byte_unt::to_large_unt b1, 0u8), one_byte_unt::to_large_unt b2);

        fun sign_ext w
            =
            lun::(-) (lun::bitwise_xor (0ux8000, w), 0ux8000);

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

                make_word (
                    w8v::get (vec, k  ),
                    w8v::get (vec, k+1)
                );
            };

        fun get_vec_x (vec, i)
            =
            sign_ext (get_vec (vec, i));

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

                k = i+i;

                make_word (
                    w8a::get (arr, k  ),
                    w8a::get (arr, k+1)
                );
            };

        fun get_rw_vec_x (arr, i)
            =
            sign_ext (get_rw_vec (arr, i));

        fun set (arr, i, w)
            =
            {
                check_index (w8a::length arr, i);
                k = i+i;

                w8a::set (arr, k,   w8::from_large_unt (lun::(>>) (w, 0u8)));
                w8a::set (arr, k+1, w8::from_large_unt w);
            };

    };
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.