## treecode-pith.pkg
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.lib### "The wise man doesn't give the right answers,
### he poses the right questions."
###
### -- Claude Levi-Strauss
stipulate
package lem = lowhalf_error_message; # lowhalf_error_message is from src/lib/compiler/back/low/control/lowhalf-error-message.pkgherein
package treecode_pith
: (weak) Treecode_Pith # Treecode_Pith is from src/lib/compiler/back/low/treecode/treecode-pith.api {
Attributes = Unt;
Misc_Op # Never used; support for the RTL system that was never completed.
=
{ name: String,
hash: Unt,
attributes: Ref(Attributes)
};
# Integer conditions. For docs see
# src/lib/compiler/back/low/treecode/treecode-pith.api #
Cond = LT | LTU | LE | LEU | EQ | NE | GE | GEU | GT | GTU
| SETCC
| MISC_COND { name: String,
hash: Unt,
attributes: Ref(Attributes)
}
;
# Floating-point conditions. For docs see
# src/lib/compiler/back/low/treecode/treecode-pith.api #
Fcond
= FEQ | FNEU | FGT | FGE | FLT | FLE | FUO | FNE | FGLE
| FGTU | FGEU | FLTU | FLEU | FEQU
| SETFCC
| MISC_FCOND { name: String, hash: Unt, attributes: Ref( Unt ) }
;
Ext = DO_SIGN_EXTEND
| DO_ZERO_EXTEND
;
Rounding_Mode = ROUND_TO_NEAREST
| ROUND_TO_NEGINF
| ROUND_TO_POSINF
| ROUND_TO_ZERO
;
package d {
#
Div_Rounding_Mode = ROUND_TO_NEGINF # Wrapped in private package 'd' to keep this ROUND_TO_ZERO and ROUND_TO_NEGINF from conflicting with preceding ones.
| ROUND_TO_ZERO
;
};
fun error (msg, op)
=
lem::error("treecode_pith", msg + ": " + op);
nonfix my FGTLT FLT FGT FGE FLE;
# These should be sumtypes, but highcode
# does not optimize them well: # XXX BUGGO FIXME
#
Int_Bitsize = Int;
Float_Bitsize = Int;
fun cond_to_string cond
=
case cond
#
LT => "LT";
LTU => "LTU";
LE => "LE";
LEU => "LEU";
EQ => "EQ";
NE => "NE";
GE => "GE";
GEU => "GEU";
GT => "GT";
GTU => "GTU";
SETCC => "SETCC";
MISC_COND { name, ... } => name;
esac;
fun fcond_to_string fcond
=
case fcond
#
FEQ => "FEQ";
FNEU => "FNEU";
FGT => "FGT";
FGE => "FGE";
FLT => "FLT";
FLE => "FLE";
FUO => "FUO";
FNE => "FNE";
FGLE => "FGLE";
FGTU => "FGTU";
FGEU => "FGEU";
FLTU => "FLTU";
FLEU => "FLEU";
FEQU => "FEQU";
SETFCC => "SETFCC";
MISC_FCOND { name, ... } => name;
esac;
fun swap_cond cond
=
case cond
#
LT => GT;
LTU => GTU;
LE => GE;
LEU => GEU;
EQ => EQ;
NE => NE;
GE => LE;
GEU => LEU;
GT => LT;
GTU => LTU;
#
cond => error("swap_cond", cond_to_string cond);
esac;
# Swap order of arguments
#
fun swap_fcond fcond
=
case fcond
#
FUO => FUO;
FEQ => FEQ;
FEQU => FEQU;
FLT => FGT;
FLTU => FGTU;
FLE => FGE;
FLEU => FGEU;
FGT => FLT;
FGTU => FLTU;
FGE => FLE;
FGEU => FLEU;
FNE => FNE;
FGLE => FGLE;
FNEU => FNEU;
#
fcond => error("swap_fcond", fcond_to_string fcond);
esac;
fun negate_cond cond
=
case cond
#
LT => GE;
LTU => GEU;
LE => GT;
LEU => GTU;
EQ => NE;
NE => EQ;
GE => LT;
GEU => LTU;
GT => LE;
GTU => LEU;
#
cond => error("negate_cond", cond_to_string cond);
esac;
fun negate_fcond fcond
=
case fcond
#
FEQ => FNEU;
FNEU => FEQ;
FUO => FGLE;
FGLE => FUO;
FGT => FLEU;
FGE => FLTU;
FGTU => FLE;
FGEU => FLT;
FLT => FGEU;
FLE => FGTU;
FLTU => FGE;
FLEU => FGT;
FNE => FEQU;
FEQU => FNE;
#
_ => error("negate_fcond", fcond_to_string fcond);
esac;
fun hash_cond cond
=
case cond
#
LT => 0u123;
LTU => 0u758;
LE => 0u81823;
LEU => 0u1231;
EQ => 0u987;
NE => 0u8819;
GE => 0u88123;
GEU => 0u975;
GT => 0u1287;
GTU => 0u2457;
SETCC => 0u23;
MISC_COND { hash, ... } => hash;
esac;
fun hash_fcond fcond
=
case fcond
#
FUO => 0u123;
FEQ => 0u12345;
FEQU => 0u123456;
FLT => 0u23456;
FLTU => 0u345;
FLE => 0u456;
FLEU => 0u4567;
FGT => 0u5678;
FGTU => 0u56789;
FGE => 0u67890;
FGEU => 0u789;
FNE => 0u890;
FGLE => 0u991;
FNEU => 0u391;
SETFCC => 0u94;
MISC_FCOND { hash, ... } => hash;
esac;
fun hash_rounding_mode m
=
case m
#
ROUND_TO_NEAREST => 0u1;
ROUND_TO_NEGINF => 0u10;
ROUND_TO_POSINF => 0u100;
ROUND_TO_ZERO => 0u1000;
esac;
fun rounding_mode_to_string m
=
case m
#
ROUND_TO_NEAREST => "ROUND_TO_NEAREST";
ROUND_TO_NEGINF => "ROUND_TO_NEGINF";
ROUND_TO_POSINF => "ROUND_TO_POSINF";
ROUND_TO_ZERO => "ROUND_TO_ZERO";
esac;
}; # treecode_pith
end;