PreviousUpNext

15.4.168  src/lib/c-glue-lib/ram/memaccess-a4s2i4l4f4d8.pkg

# memaccess-a4s2i4l4f4d8.pkg
#
#   Primitives for "raw" memory access.
#
#   intel32/Sparc32/pwrpc32 version:
#       address char short  int  long float double
#       4    1    2      4    4    4     8       (bytes)
#
#   (C) 2004 The Fellowship of SML/NJ
#
# author: Matthias Blume (blume@tti-c.org)

# Compiled by:
#     src/lib/c-glue-lib/ram/memory.lib

stipulate
    package f8b =  eight_byte_float;                                    # eight_byte_float      is from   src/lib/std/eight-byte-float.pkg
herein

    package cmem_access: (weak)  Cmemaccess {                           # Cmemaccess            is from   src/lib/c-glue-lib/ram/memaccess.api
        #
        Addr = one_word_unt::Unt;

        null = 0u0:  Addr;

        fun is_null a
            =
            a == null;


        infix my +++ --- ;

        # Rely on 2's-complement for the following... 
        fun (a: Addr) +++ i
            =
            a + one_word_unt::from_int i;

        compare = one_word_unt::compare;

        fun a1 --- a2
            =
            one_word_unt::to_int_x (a1 - a2);

        char_size  = 0u1;
        short_size = 0u2;

        addr_size  = 0u4;
        int_size   = 0u4;
        long_size  = 0u4;
        float_size = 0u4;

        longlong_size = 0u8;
        double_size   = 0u8;


        load_uchar  = raw_mem_inline_t::w8l;
        load_schar  = raw_mem_inline_t::i8l;

        load_ushort = raw_mem_inline_t::w16l;
        load_sshort = raw_mem_inline_t::i16l;

        load_addr   = raw_mem_inline_t::w32l;
        load_uint   = raw_mem_inline_t::w32l;
        load_ulong  = raw_mem_inline_t::w32l;
        load_sint   = raw_mem_inline_t::i32l;
        load_slong  = raw_mem_inline_t::i32l;

        load_ulonglong = inline_t::u2::intern o mem_access64::load2;                    # "u2" == "two-word unsigned int": 64-bit on 32-bit architectures, 128-bit on 64-bit architectures.
        load_slonglong = inline_t::i2::intern o mem_access64::load2;                    # "i2" == "two-word   signed int": 64-bit on 32-bit architectures, 128-bit on 64-bit architectures.

        load_float  = raw_mem_inline_t::f32l;
        load_double = raw_mem_inline_t::f64l;

        store_uchar  = raw_mem_inline_t::w8s;
        store_schar  = raw_mem_inline_t::i8s;

        store_ushort = raw_mem_inline_t::w16s;
        store_sshort = raw_mem_inline_t::i16s;

        store_addr   = raw_mem_inline_t::w32s;
        store_uint   = raw_mem_inline_t::w32s;
        store_sint   = raw_mem_inline_t::i32s;

        store_ulong  = raw_mem_inline_t::w32s;
        store_slong  = raw_mem_inline_t::i32s;

        fun store_ulonglong (a, x) =   mem_access64::store2 (a, inline_t::u2::extern x);
        fun store_slonglong (a, x) =   mem_access64::store2 (a, inline_t::i2::extern x);

        store_float = raw_mem_inline_t::f32s;
        store_double = raw_mem_inline_t::f64s;

        int_bits = unt::from_int one_word_unt::unt_size;

        # This needs to be severely optimized:          XXX BUGGO FIXME
        #
        fun bcopy { from: Addr, to: Addr, bytes: Unt }
            =
            if   (bytes > 0u0)

                 store_uchar (to, load_uchar from);

                 bcopy { from  => from  + 0u1,
                         to    => to    + 0u1,
                         bytes => bytes - 0u1
                       } ;
            fi;



        # Types used in C calling convention:

        Cc_Addr   = one_word_unt::Unt;

        Cc_Schar  = one_word_int::Int;
        Cc_Uchar  = one_word_unt::Unt;

        Cc_Sint   = one_word_int::Int;
        Cc_Uint   = one_word_unt::Unt;

        Cc_Sshort = one_word_int::Int;
        Cc_Ushort = one_word_unt::Unt;

        Cc_Slong  = one_word_int::Int;
        Cc_Ulong  = one_word_unt::Unt;

        Cc_Slonglong = two_word_int::Int;
        Cc_Ulonglong = two_word_unt::Unt;

        Cc_Float  =  f8b::Float;
        Cc_Double =  f8b::Float;



        # Wrapping and unwrapping for cc types:

        fun wrap_addr   (x:  Addr)                  = x:  Cc_Addr;

        fun wrap_schar  (x:  mlrep::signed::Int   ) = x:  Cc_Schar;
        fun wrap_uchar  (x:  mlrep::unsigned::Unt) = x:  Cc_Uchar;

        fun wrap_sint   (x:  mlrep::signed::Int   ) = x:  Cc_Sint;
        fun wrap_uint   (x:  mlrep::unsigned::Unt) = x:  Cc_Uint;

        fun wrap_sshort (x:  mlrep::signed::Int   ) = x:  Cc_Sshort;
        fun wrap_ushort (x:  mlrep::unsigned::Unt) = x:  Cc_Ushort;

        fun wrap_slong  (x:  mlrep::signed::Int   ) = x:  Cc_Slong;
        fun wrap_ulong  (x:  mlrep::unsigned::Unt) = x:  Cc_Ulong;

        fun wrap_slonglong (x: mlrep::long_long_signed::Int   ) = x:  Cc_Slonglong;
        fun wrap_ulonglong (x: mlrep::long_long_unsigned::Unt) = x:  Cc_Ulonglong;

        fun wrap_float  (x:  mlrep::float::Float) = x:  Cc_Float;
        fun wrap_double (x:  mlrep::float::Float) = x:  Cc_Double;

        fun unwrap_addr (x:  Cc_Addr ) = x:  Addr;

        fun unwrap_schar (x:  Cc_Schar) = x:  mlrep::signed::Int;
        fun unwrap_uchar (x:  Cc_Uchar) = x:  mlrep::unsigned::Unt;

        fun unwrap_sint (x:  Cc_Sint ) = x:  mlrep::signed::Int;
        fun unwrap_uint (x:  Cc_Uint ) = x:  mlrep::unsigned::Unt;

        fun unwrap_sshort (x:  Cc_Sshort) = x:  mlrep::signed::Int;
        fun unwrap_ushort (x:  Cc_Ushort) = x:  mlrep::unsigned::Unt;

        fun unwrap_slong (x:  Cc_Slong) = x:  mlrep::signed::Int;
        fun unwrap_ulong (x:  Cc_Ulong) = x:  mlrep::unsigned::Unt;

        fun unwrap_slonglong (x:  Cc_Slonglong) = x:  mlrep::long_long_signed::Int;
        fun unwrap_ulonglong (x:  Cc_Ulonglong) = x:  mlrep::long_long_unsigned::Unt;

        fun unwrap_float  (x:  Cc_Float ) = x:  mlrep::float::Float;
        fun unwrap_double (x:  Cc_Double) = x:  mlrep::float::Float;

        fun p2i (x:  Addr) = x:  mlrep::unsigned::Unt;
        fun i2p (x:  mlrep::unsigned::Unt) = x:  Addr;
    };
end;



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext