## gnu-assembler-pseudo-ops-g.pkg
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.lib# Implements the string related functions to emit pseudo-ops
# in the standard GAS syntax.
stipulate
package lbl = codelabel; # codelabel is from src/lib/compiler/back/low/code/codelabel.pkg package pbt = pseudo_op_basis_type; # pseudo_op_basis_type is from src/lib/compiler/back/low/mcg/pseudo-op-basis-type.pkgherein
api Gnu_Assembler_Pseudo_Ops {
#
package tcf: Treecode_Form; # Treecode_Form is from src/lib/compiler/back/low/treecode/treecode-form.api #
label_expression_to_string: tcf::Label_Expression -> String;
to_string: pbt::Pseudo_Op( tcf::Label_Expression, X ) -> String;
define_private_label: lbl::Codelabel -> String;
};
end;
# We get invoked from:
#
# 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.pkg# src/lib/compiler/back/low/intel32/mcg/gas-pseudo-ops-intel32-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 pbt = pseudo_op_basis_type; # pseudo_op_basis_type is from src/lib/compiler/back/low/mcg/pseudo-op-basis-type.pkg package ptf = sfprintf; # sfprintf is from src/lib/src/sfprintf.pkgherein
# This generic is invoked from:
#
# src/lib/compiler/back/low/intel32/mcg/gas-pseudo-ops-intel32-g.pkg # 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 gnu_assembler_pseudo_op_g (
# =========================
#
package tcf: Treecode_Form; # Treecode_Form is from src/lib/compiler/back/low/treecode/treecode-form.api #
label_format: { global_symbol_prefix: String,
anonymous_label_prefix: String
};
)
: (weak) Gnu_Assembler_Pseudo_Ops # Gnu_Assembler_Pseudo_Ops is from src/lib/compiler/back/low/mcg/gnu-assembler-pseudo-op-g.pkg {
# Export to client packages:
#
package tcf = tcf; # "tcf" == "treecode_form".
stipulate
package lac = tcf::lac; # "lac" == "late_constant".
herein
fun error msg
=
lem::error ("gnu_assembler_pseudo_ops.", msg);
fun print_integer i
=
if (multiword_int::sign i < 0) "-" + multiword_int::to_string (multiword_int::neg i);
else multiword_int::to_string i;
fi;
fun print_int i
=
if (i < 0) "-" + int::to_string(-i);
else int::to_string( i);
fi;
# Operator precedences.
# Note that these differ from C's precedences:
# 2 MULT, DIV, LSHIFT, RSHIFT
# 1 AND, OR
# 0 PLUS, MINUS
fun parens (string, prec, op_prec)
=
if (prec > op_prec) "(" + string + ")";
else string;
fi;
fun label_expression_to_string le
=
to_string (le, 0)
also
fun to_string (tcf::LABEL lab, _) => lbl::codelabel_format_for_asm label_format lab;
to_string (tcf::LABEL_EXPRESSION le, p) => to_string (le, p);
#
to_string (tcf::NEG(_, tcf::LATE_CONSTANT c), _)
=>
print_int(-(lac::late_constant_to_int c))
except _ = "-" + lac::late_constant_to_string c;
to_string (tcf::NEG(_, tcf::LITERAL i), _) => print_integer(-i);
to_string (tcf::NEG(_, lambda_expression), prec) => parens (to_string (lambda_expression, 3), prec, 3);
to_string (tcf::LATE_CONSTANT c, _)
=>
print_int (lac::late_constant_to_int c)
except
_ = lac::late_constant_to_string c;
to_string (tcf::LITERAL i, _)
=>
print_integer i;
to_string (tcf::MULS(_, lambda_expression1, lambda_expression2), prec)
=>
parens (to_string (lambda_expression1, 2) + "*" + to_string (lambda_expression2, 2), prec, 2);
to_string (tcf::DIVS (tcf::d::ROUND_TO_ZERO, _, lambda_expression1, lambda_expression2), prec)
=>
parens (to_string (lambda_expression1, 2) + "/" + to_string (lambda_expression2, 2), prec, 2);
to_string (tcf::LEFT_SHIFT(_, lambda_expression, count), prec)
=>
parens (to_string (lambda_expression, 2) + "<<" + to_string (count, 2), prec, 2);
to_string (tcf::RIGHT_SHIFT_U(_, lambda_expression, count), prec)
=>
parens (to_string (lambda_expression, 2) + ">>" + to_string (count, 2), prec, 2);
to_string (tcf::BITWISE_AND(_, lambda_expression, mask), prec)
=>
parens (to_string (lambda_expression, 1) + "&" + to_string (mask, 1), prec, 1);
to_string (tcf::BITWISE_OR(_, lambda_expression, mask), prec)
=>
parens (to_string (lambda_expression, 1) + "|" + to_string (mask, 1), prec, 1);
to_string (tcf::ADD(_, lambda_expression1, lambda_expression2), prec)
=>
parens (to_string (lambda_expression1, 0) + "+" + to_string (lambda_expression2, 0), prec, 0);
to_string (tcf::SUB(_, lambda_expression1, lambda_expression2), prec)
=>
parens (to_string (lambda_expression1, 0) + "-" + to_string (lambda_expression2, 0), prec, 0);
to_string _ => error "to_string";
end;
fun define_private_label lab
=
label_expression_to_string (tcf::LABEL lab) + ":";
fun decls (fmt, labs)
=
string::cat
(map (\\ lab = (ptf::sprintf' fmt [ptf::STRING (label_expression_to_string (tcf::LABEL lab))]))
labs
);
fun to_string (pbt::ALIGN_SIZE n) => ptf::sprintf' "\t.align\t%d" [ptf::INT n];
to_string (pbt::ALIGN_ENTRY) => "\t.align\t4"; # 16 byte boundary
to_string (pbt::ALIGN_LABEL) => "\t.p2align\t4, ,7";
to_string (pbt::DATA_LABEL lab) => lbl::codelabel_format_for_asm label_format lab + ":";
to_string (pbt::DATA_READ_ONLY) => "\t.section\t.rodata";
to_string (pbt::DATA) => "\t.data";
to_string (pbt::BSS) => "\t.section\t.bss";
to_string (pbt::TEXT) => "\t.text";
to_string (pbt::SECTION at) => "\t.section\t" + quickstring__premicrothread::to_string at;
to_string (pbt::REORDER) => "";
to_string (pbt::NOREORDER) => "";
to_string (pbt::INT { size, i } )
=>
{
fun join [] => [];
join [lambda_expression] => [label_expression_to_string lambda_expression];
join (lambda_expression ! r) => label_expression_to_string lambda_expression ! ", " ! join r;
end;
pop = case size
8 => "\t.byte\t";
16 => "\t.short\t";
32 => "\t.int\t";
64 => error "INT2";
n => error ("unexpected INT size: " + int::to_string n);
esac;
string::cat (pop ! join i);
};
to_string (pbt::ASCII s)
=>
ptf::sprintf' "\t.ascii\t\"%s\"" [ptf::STRING (string::to_cstring s)];
to_string (pbt::ASCIIZ s)
=>
ptf::sprintf' "\t.asciz \"%s\"" [ptf::STRING (string::to_cstring s)];
to_string (pbt::SPACE size)
=>
ptf::sprintf' "\t.space\t%d" [ptf::INT size];
to_string (pbt::FLOAT { size, f } )
=>
{
fun join [] => [];
join [f] => [f];
join (f ! r) => f ! ", " ! join r;
end;
pop = case size
32 => "\t.single ";
64 => "\t.double ";
128 => "\t.extended ";
n => error ("unexpected FLOAT size: " + int::to_string n);
esac;
string::cat (pop ! join f);
};
to_string (pbt::IMPORT labs) => decls("\t.extern\t%s", labs);
to_string (pbt::EXPORT labs) => decls("\t.global\t%s", labs);
to_string (pbt::COMMENT txt) => ptf::sprintf' "/* %s */" [ptf::STRING txt];
to_string (pbt::EXT _) => error "EXT";
end;
end;
};
end;
## COPYRIGHT (c) 2001 Lucent Technologies, Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.