## big-endian-pseudo-ops-g.pkg
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.lib# Subset of pseudo-ops functions that are little endian sensitive
# We get invoked from:
#
# src/lib/compiler/back/low/pwrpc32/mcg/pseudo-ops-pwrpc32-osx-g.pkg# src/lib/compiler/back/low/pwrpc32/mcg/gas-pseudo-ops-pwrpc32-g.pkg# src/lib/compiler/back/low/sparc32/mcg/gas-pseudo-ops-sparc32-g.pkgstipulate
package lbl = codelabel; # codelabel is from src/lib/compiler/back/low/code/codelabel.pkg package lem = lowhalf_error_message; # lowhalf_error_message is from src/lib/compiler/back/low/control/lowhalf-error-message.pkg package unt = unt; # unt is from src/lib/std/unt.pkgherein
# This generic is invoked in:
#
# src/lib/compiler/back/low/pwrpc32/mcg/gas-pseudo-ops-pwrpc32-g.pkg # src/lib/compiler/back/low/pwrpc32/mcg/pseudo-ops-pwrpc32-osx-g.pkg # src/lib/compiler/back/low/sparc32/mcg/gas-pseudo-ops-sparc32-g.pkg #
generic package big_endian_pseudo_op_g (
# ======================
#
package tcf: Treecode_Form; # Treecode_Form is from src/lib/compiler/back/low/treecode/treecode-form.api package tce: Treecode_Eval # Treecode_Eval is from src/lib/compiler/back/low/treecode/treecode-eval.api where
tcf == tcf; # "tcf" == "treecode_form".
icache_alignment: Int; # Cache line size
max_alignment: Null_Or( Int ); # Maximum alignment for internal labels
nop: { size: Int, en: one_word_unt::Unt }; # Encoding for noop
)
: (weak) Endian_Pseudo_Ops # Endian_Pseudo_Ops is from src/lib/compiler/back/low/mcg/pseudo-op-endian.api {
# Export to client packages:
#
package tcf = tcf; # Export generic arg for client packages.
stipulate
package lac = tcf::lac; # "lac" == "late_constant"
package pb = pseudo_op_basis_type; # pseudo_op_basis_type is from src/lib/compiler/back/low/mcg/pseudo-op-basis-type.pkg herein
Pseudo_Op(X)
=
pb::Pseudo_Op( tcf::Label_Expression, X );
fun error msg = lem::error ("big_endian_pseudo_ops.", msg);
my (>>) = unt::(>>);
my (>>>) = unt::(>>>);
my (&) = unt::bitwise_and;
infix my >> >>> & ;
# Return loc aligned at boundary:
#
fun align (loc, boundary)
=
{
mask = unt::from_int boundary - 0u1;
unt::to_int_x (unt::bitwise_and (unt::from_int loc + mask, unt::bitwise_not mask));
};
# Bytes of padding required:
#
fun padding (loc, boundary)
=
align (loc, boundary) - loc;
fun pow2 (x, 0) => x;
pow2 (x, n) => pow2 (x * 2, n - 1);
end;
fun bytes_in size
=
int::quot (size, 8);
fun current_pseudo_op_size_in_bytes (pseudo_op, loc)
=
case pseudo_op
#
pb::ALIGN_SIZE n => padding (loc, pow2 (1, n));
pb::ALIGN_ENTRY => padding (loc, icache_alignment);
pb::ALIGN_LABEL
=>
{
pad = padding (loc, icache_alignment);
case max_alignment
NULL => pad;
THE m => pad <= m ?? pad
:: 0;
esac;
};
pb::INT { size, i }
=>
length i * bytes_in size;
pb::ASCII s => string::length_in_bytes s;
pb::ASCIIZ s => string::length_in_bytes s + 1;
pb::SPACE (size) => size;
pb::FLOAT { size, f } => length (f) * bytes_in size;
pb::EXT _ => error "sizeOf: EXT";
_ => 0;
esac;
fun put_pseudo_op { pseudo_op, loc, put_byte }
=
{
itow = unt::from_int;
tount8 = one_byte_unt::from_large_unt
o unt::to_large_unt
o itow;
fun put_byte' n # Can 'emit' be just 'put'? XXX BUGGO FIXME
=
put_byte (one_byte_unt::from_large_unt (unt::to_large_unt n));
fun put_unt w
=
{ put_byte' ((w >> 0u8) & 0u255);
put_byte' (w & 0u255);
};
fun put_long_x n
=
{ w = itow n;
put_unt (w >>> 0u16);
put_unt (w & 0u65535);
};
stipulate
my { size, en } = nop;
to_unt = unt::from_multiword_int o one_word_unt::to_multiword_int_x;
herein
fun put_nop ()
=
case size
#
1 => put_byte' (to_unt en);
2 => put_unt (to_unt en);
4 => { put_unt (to_unt (one_word_unt::bitwise_and (en, 0u65535)));
put_unt (to_unt (one_word_unt::(>>) (en, 0u16)));
};
n => error ("put_nop: size = " + int::to_string n);
esac;
fun insert_nops 0
=>
();
insert_nops n
=>
if (n >= size)
#
put_nop ();
insert_nops (n-size);
else
error "insert_nops";
fi;
end;
end;
fun align (loc, boundary)
=
{
boundary = unt::from_int boundary;
mask = boundary - 0u1;
case (unt::bitwise_and (itow (loc), mask))
#
0u0 => ();
w => { pad_size = (boundary - w);
insert_nops (unt::to_int pad_size);
};
esac;
};
(tce::make_evaluation_functions
{
late_constant_to_integer => multiword_int::from_int o lac::late_constant_to_int,
label_to_int => lbl::get_codelabel_address
})
->
{ evaluate_int_expression, ... };
case pseudo_op
#
pb::ALIGN_SIZE n => insert_nops (current_pseudo_op_size_in_bytes (pseudo_op, loc));
pb::ALIGN_ENTRY => insert_nops (current_pseudo_op_size_in_bytes (pseudo_op, loc));
pb::ALIGN_LABEL => insert_nops (current_pseudo_op_size_in_bytes (pseudo_op, loc));
pb::INT { size, i }
=>
{ ints = map (multiword_int::to_int o evaluate_int_expression) i;
case size
#
8 => apply (put_byte' o itow) ints;
16 => apply (put_unt o itow) ints;
32 => apply put_long_x ints;
#
_ => error "put_pseudo_op: INT 64";
esac;
};
pb::ASCII s
=>
apply
(put_byte o one_byte_unt::from_int o char::to_int)
(string::explode s);
pb::ASCIIZ s
=>
{ put_pseudo_op { pseudo_op=>pb::ASCII s, loc, put_byte };
put_byte 0u0;
};
pb::FLOAT { size, f } => error "put_pseudo_op: FLOAT - not implemented";
pb::EXT _ => error "put_pseudo_op: EXT";
pb::SPACE _ => error "put_pseudo_op: SPACE";
_ => ();
esac;
}; # fun put_pseudo_op
end; # stipulate
}; # generic package big_endian_pseudo_op_g
end; # stipulate
## COPYRIGHT (c) 2001 Lucent Technologies, Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.