## treecode-extension-sext-compiler-intel32-g.pkg
#
# Background comments may be found in:
#
# src/lib/compiler/back/low/treecode/treecode-extension.api#
# Emit code for extensions to the intel32 instruction set.
# Compiled by:
# src/lib/compiler/back/low/intel32/backend-intel32.libstipulate
package lem = lowhalf_error_message; # lowhalf_error_message is from src/lib/compiler/back/low/control/lowhalf-error-message.pkg package xx = treecode_extension_sext_intel32; # treecode_extension_sext_intel32 is from src/lib/compiler/back/low/intel32/code/treecode-extension-sext-intel32.pkgherein
# We are invoked from:
#
# src/lib/compiler/back/low/main/intel32/treecode-extension-compiler-intel32-g.pkg #
generic package treecode_extension_sext_compiler_intel32_g (
# ========================================
#
package mcf: Machcode_Intel32; # Machcode_Intel32 is from src/lib/compiler/back/low/intel32/code/machcode-intel32.codemade.api package tcs: Treecode_Codebuffer # Treecode_Codebuffer is from src/lib/compiler/back/low/treecode/treecode-codebuffer.api where
tcf == mcf::tcf; # "tcf" == "treecode_form".
package mcg: Machcode_Controlflow_Graph # Machcode_Controlflow_Graph is from src/lib/compiler/back/low/mcg/machcode-controlflow-graph.api where
pop == tcs::cst::pop # "pop" == "pseudo_op".
also mcf == mcf; # "mcf" == "machcode_form" (abstract machine code).
)
: (weak) Treecode_Extension_Compiler_Intel32 # Treecode_Extension_Compiler_Intel32 is from src/lib/compiler/back/low/intel32/code/treecode-extension-compiler-intel32.api {
# Export to client packages:
#
package tcs = tcs; # "tcs" == "treecode_stream".
package mcg = mcg; # "mcg" == "machcode_controlflow_graph".
package mcf = mcf; # "mcf" == "machcode_form" (abstract machine code).
stipulate
# Some local abbreviations:
#
package rgk = mcf::rgk; # "rgk" == "registerkinds".
package tcf = tcs::tcf; # "tcf" == "treecode_form".
herein
Void_Expression
=
xx::Sext( tcf::Void_Expression, tcf::Int_Expression, tcf::Float_Expression, tcf::Flag_Expression );
Reducer = tcs::Reducer
(
mcf::Machine_Op,
rgk::Codetemplists,
mcf::Operand,
mcf::Addressing_Mode,
mcg::Machcode_Controlflow_Graph
);
esp = rgk::esp;
esp_operand = mcf::DIRECT (esp);
fun error msg
=
lem::error("treecode_extension_sext_compiler_intel32_g", msg);
stack_area = mcf::rgn::stack;
fun compile_sext reducer { void_expression: Void_Expression, notes: List( tcf::Note ) }
=
{ reducer -> tcs::REDUCER { operand,
put_op,
reduce_float_expression,
codestream,
reduce_operand,
...
};
codestream -> { put_op=>put_i, ... };
fun fstp (size, fstp_instr, float_expression) # "fstp" might be "float-stack top"...?
=
case float_expression
#
tcf::CODETEMP_INFO_FLOAT (size', f)
=>
if (size != size') error "fstp: size";
else put_i (mcf::BASE_OP (fstp_instr (mcf::FDIRECT f)));
fi;
#
_ => error "fstp: float_expression";
esac;
case void_expression
#
xx::PUSHL (int_expression) => put_op (mcf::pushl (operand int_expression), notes);
xx::POP (int_expression) => put_op (mcf::pop (operand int_expression), notes);
#
xx::FSTPS (float_expression) => fstp (32, mcf::FSTPS, float_expression);
xx::FSTPL (float_expression) => fstp (64, mcf::FSTPL, float_expression);
xx::FSTPT (float_expression) => fstp (80, mcf::FSTPT, float_expression);
#
xx::LEAVE => put_op (mcf::leave, notes);
xx::RET (int_expression) => put_op (mcf::ret (THE (operand int_expression)), notes);
#
xx::LOCK_CMPXCHGL (src, dst)
=>
# src must in a register
put_op (
mcf::cmpxchg
{ lock => TRUE,
size => mcf::INT1,
src => mcf::DIRECT (reduce_operand (operand src)),
dst => operand dst
},
notes
);
esac;
}; # fun compile_sext
end; # stipulate
}; # generic package treecode_extension_sext_compiler_intel32_g
end; # stipulate
## COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.