# 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.libstipulate
package f8b = eight_byte_float; # eight_byte_float is from
src/lib/std/eight-byte-float.pkgherein
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;