## little-endian-pseudo-ops-g.pkg
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.lib# We are invoked from:
#
# src/lib/compiler/back/low/intel32/mcg/gas-pseudo-ops-intel32-g.pkg# Subset of pseudo-ops functions that are little endian sensitive
#
stipulate
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 (only) in:
#
# src/lib/compiler/back/low/intel32/mcg/gas-pseudo-ops-intel32-g.pkg #
generic package little_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 no-op.
)
: (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;
stipulate
package tce = tce; # "tce" == "treecode_eval".
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 ("little_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 => if (pad <= m) pad;
else 0;
fi;
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;
fun put_byte' n
=
put_byte (one_byte_unt::from_large_unt (unt::to_large_unt n));
fun put_unt n
=
{ put_byte' (n & 0u255);
put_byte' ((n >> 0u8) & 0u255);
};
fun put_long_x n
=
{
w = itow n;
put_unt (w & 0u65535);
put_unt (w >>> 0u16);
};
stipulate
nop -> { size, en };
#
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 ("emitNop: size = " + int::to_string n);
esac;
fun insert_nops 0
=>
();
insert_nops n
=>
if (n >= size)
put_nop();
insert_nops (n-size);
else
error "insertNops";
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_value: 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_value: FLOAT - not implemented";
pb::EXT _ => error "put_value: EXT";
pb::SPACE _ => error "put_value: SPACE";
_ => ();
esac;
}; # fun put_value
end;
};
end;
## COPYRIGHT (c) 2001 Lucent Technologies, Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.