public static void op1_round(SObject arg)
{
if (arg is SFixnum)
{
return;
}
else if (arg is SVL)
{
SVL a = (SVL)arg;
if (a.tag == Tags.RatnumTag)
{
Call.callMillicodeSupport1(Constants.MS_RATNUM_ROUND, arg);
return;
}
}
else if (arg is SByteVL)
{
SByteVL a = (SByteVL)arg;
if (a.tag == Tags.FlonumTag)
{
double d = a.unsafeAsDouble(0);
Reg.Result = Factory.makeFlonum(System.Math.Round(d));
return;
}
else if (a.tag == Tags.BignumTag)
{
return;
}
}
Exn.fault(Constants.EX_ROUND, "round: expected real number");
}
public static SObject op3_string_set_trusted(SObject arg1, SObject arg2, SObject arg3)
{
SByteVL a = (SByteVL)arg1;
a.elements[((SFixnum)arg2).value] = (byte)((SChar)arg3).val;
return(Factory.Unspecified);
}
public static void op1_exact2inexact(SObject arg)
{
if (arg is SFixnum)
{
int a = ((SFixnum)arg).value;
Reg.Result = Factory.makeFlonum((double)a);
return;
}
else if (arg is SByteVL)
{
SByteVL a = (SByteVL)arg;
if (a.tag == Tags.BignumTag)
{
; // fallthrough
}
else if (a.tag == Tags.FlonumTag)
{
return;
}
else if (a.tag == Tags.CompnumTag)
{
return;
}
}
Call.callMillicodeSupport1(Constants.MS_GENERIC_EXACT2INEXACT, arg);
return;
}
public static SObject op1_imag_part(SObject arg)
{
if (arg is SFixnum)
{
return(Factory.makeFixnum(0));
}
else if (arg is SVL)
{
SVL a = (SVL)arg;
if (a.tag == Tags.BignumTag
| a.tag == Tags.RatnumTag)
{
return(Factory.makeFixnum(0));
}
else if (a.tag == Tags.RectnumTag)
{
return(Number.rectImagPart(a));
}
}
else if (arg is SByteVL)
{
SByteVL a = (SByteVL)arg;
if (a.tag == Tags.FlonumTag)
{
return(Factory.makeFixnum(0));
}
else if (a.tag == Tags.CompnumTag)
{
return(Number.compImagPart(a));
}
}
Exn.fault(Constants.EX_IMAGPART,
"not a number");
return(Factory.Unspecified);
}
public static void setBignumLengthInBigits(SByteVL b, int bigitc)
{
byte sign = getBignumSign(b) ? BIGNUM_POSITIVE : BIGNUM_NEGATIVE;
int wordc = (bigitc + 1) >> 1;
uint meta = (((uint)sign) << BIGNUM_SIGN_SHIFT) | (uint)wordc;
b.setUInt32(BIGNUM_LENGTH_OFFSET, meta);
}
public static SByteVL allocBignum(int bigitc)
{
int length = (bigitc * BYTES_PER_BIGIT + 3) & ~(int)3;
SByteVL b = new SByteVL(Tags.BignumTag, length + 4, 0);
setBignumLengthInBigits(b, bigitc);
return(b);
}
private static void flonum_tan()
{
double arg = ((SByteVL)Reg.Register2).unsafeAsDouble(0);
SByteVL dst = (SByteVL)Reg.Register3;
dst.unsafeSetDouble(0, Math.Tan(arg));
Reg.Result = dst;
}
public static void op2_minus(SObject arg1, SObject arg2)
{
if (arg1 is SFixnum & arg2 is SFixnum)
{
int a = ((SFixnum)arg1).value;
int b = ((SFixnum)arg2).value;
Reg.Result = Factory.makeNumber(a - b);
return;
}
else if (arg1 is SVL & arg2 is SVL)
{
SVL a = (SVL)arg1;
SVL b = (SVL)arg2;
if (a.tag == Tags.RatnumTag & b.tag == Tags.RatnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RATNUM_SUB, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.RectnumTag & b.tag == Tags.RectnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RECTNUM_SUB, a, b);
return; // TAIL CALL
}
}
else if (arg1 is SByteVL & arg2 is SByteVL)
{
SByteVL a = (SByteVL)arg1;
SByteVL b = (SByteVL)arg2;
if (a.tag == Tags.BignumTag & b.tag == Tags.BignumTag)
{
Call.callMillicodeSupport2(Constants.MS_BIGNUM_SUB, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.FlonumTag & b.tag == Tags.FlonumTag)
{
double av = a.unsafeAsDouble(0);
double bv = b.unsafeAsDouble(0);
double result = av - bv;
Reg.Result = Factory.makeFlonum(result);
return;
}
else if (a.tag == Tags.CompnumTag & b.tag == Tags.CompnumTag)
{
double ar = a.unsafeAsDouble(0);
double ai = a.unsafeAsDouble(1);
double br = b.unsafeAsDouble(0);
double bi = b.unsafeAsDouble(1);
Reg.Result = Factory.makeCompnum(ar - br, ai - bi);
return;
}
}
Procedure generic
= Call.getSupportProcedure(Constants.MS_GENERIC_SUB);
Call.contagion(arg1, arg2, generic);
return; // TAIL CALL
}
private static void flonum_atan2()
{
double arg1 = ((SByteVL)Reg.Register2).unsafeAsDouble(0);
double arg2 = ((SByteVL)Reg.Register3).unsafeAsDouble(0);
SByteVL dst = (SByteVL)Reg.Register4;
dst.unsafeSetDouble(0, Math.Atan2(arg1, arg2));
Reg.Result = dst;
}
public static void op2_numeric_equals(SObject arg1, SObject arg2)
{
if (arg1 is SFixnum & arg2 is SFixnum)
{
bool result = ((SFixnum)arg1).value == ((SFixnum)arg2).value;
Reg.Result = Factory.makeBoolean(result);
return;
}
else if (arg1 is SVL & arg2 is SVL)
{
SVL a = (SVL)arg1;
SVL b = (SVL)arg2;
if (a.tag == Tags.RatnumTag & b.tag == Tags.RatnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RATNUM_EQUAL, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.RectnumTag & b.tag == Tags.RectnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RECTNUM_EQUAL, a, b);
return; // TAIL CALL
}
}
else if (arg1 is SByteVL & arg2 is SByteVL)
{
SByteVL a = (SByteVL)arg1;
SByteVL b = (SByteVL)arg2;
if (a.tag == Tags.BignumTag &
b.tag == Tags.BignumTag)
{
Call.callMillicodeSupport2(Constants.MS_BIGNUM_EQUAL, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.FlonumTag & b.tag == Tags.FlonumTag)
{
double av = a.unsafeAsDouble(0);
double bv = b.unsafeAsDouble(0);
Reg.Result = Factory.makeBoolean(av == bv);
return;
}
else if (a.tag == Tags.CompnumTag & b.tag == Tags.CompnumTag)
{
double ar = a.unsafeAsDouble(0);
double ai = a.unsafeAsDouble(1);
double br = b.unsafeAsDouble(0);
double bi = b.unsafeAsDouble(1);
Reg.Result = Factory.makeBoolean(ar == br & ai == bi);
return;
}
}
Procedure generic
= Call.getSupportProcedure(Constants.MS_GENERIC_EQUAL);
Call.econtagion(arg1, arg2, generic);
return; // TAIL CALL
}
// ===========================
// Strings, UStrings, ByteVL
// ===========================
// FIXME: Nothing should use Factory.makeString any more.
// public static SByteVL makeString(int length, byte fill) {
// return new SByteVL(Tags.StringTag, length, (byte)fill);
// }
// public static SByteVL makeString(string s) {
// // byte [] chars = new byte [SByteVL.stringEncoding.GetByteCount (s)];
// // SByteVL.stringEncoding.GetBytes (s, 0, s.Length, chars, 0);
// // return new SByteVL (Tags.StringTag, chars);
// byte[] chars = new byte[s.Length];
// for (int i = 0; i < chars.Length; i++) {
// chars[i] = (byte)s[i];
// }
// return new SByteVL(Tags.StringTag, chars);
// }
// public static SByteVL makeString(byte[] elements) {
// return new SByteVL(Tags.StringTag, elements);
// }
public static SByteVL makeUString(string s)
{
SByteVL ustring = new SByteVL(Tags.UStringTag, s.Length * 4, 0);
for (int i = 0; i < s.Length; ++i)
{
makeFixnum(i).op_reversed_ustring_set(ustring, makeChar(s[i]));
}
return(ustring);
}
public static SObject op3_string_set(SObject arg1, SObject arg2, SObject arg3)
{
expect3(arg1.isString(), arg1, arg2.isFixnum(), arg2, arg3.isChar(), arg3,
Constants.EX_STRING_SET);
rangeCheckBVL(arg1, arg2, arg3, Constants.EX_STRING_SET);
SByteVL a = (SByteVL)arg1;
a.elements[((SFixnum)arg2).value] = (byte)((SChar)arg3).val;
return(Factory.Unspecified);
}
public static SByteVL makeUString(int length, int fill)
{
SByteVL ustring = new SByteVL(Tags.UStringTag, length * 4, 0);
SChar c = makeChar(fill);
for (int i = 0; i < length; ++i)
{
makeFixnum(i).op_reversed_ustring_set(ustring, c);
}
return(ustring);
}
public static void op2_greater_or_equal(SObject arg1, SObject arg2)
{
if (arg1 is SFixnum & arg2 is SFixnum)
{
bool result =
((SFixnum)arg1).value >= ((SFixnum)arg2).value;
Reg.Result = Factory.makeBoolean(result);
return;
}
else if (arg1 is SVL & arg2 is SVL)
{
SVL a = (SVL)arg1;
SVL b = (SVL)arg2;
if (a.tag == Tags.RatnumTag & b.tag == Tags.RatnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RATNUM_GREATEREQ, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.RectnumTag & b.tag == Tags.RectnumTag)
{
Exn.fault(Constants.EX_GREATEREQP, ">= cannot compare rectnums");
return; // TAIL CALL
}
}
else if (arg1 is SByteVL & arg2 is SByteVL)
{
SByteVL a = (SByteVL)arg1;
SByteVL b = (SByteVL)arg2;
if (a.tag == Tags.BignumTag & b.tag == Tags.BignumTag)
{
Call.callMillicodeSupport2(Constants.MS_BIGNUM_GREATEREQ, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.FlonumTag & b.tag == Tags.FlonumTag)
{
double av = a.unsafeAsDouble(0);
double bv = b.unsafeAsDouble(0);
Reg.Result = Factory.makeBoolean(av >= bv);
return;
}
else if (a.tag == Tags.CompnumTag & b.tag == Tags.CompnumTag)
{
Exn.fault(Constants.EX_GREATEREQP, ">= cannot compare compnums");
return;
}
}
Procedure generic
= Call.getSupportProcedure(Constants.MS_GENERIC_GREATEREQ);
Call.pcontagion(arg1, arg2, generic);
return; // TAIL CALL
}
public static void rangeCheckBVL(SObject arg1, SObject arg2, SObject arg3, int blame)
{
SByteVL bv = (SByteVL)arg1;
int index = ((SFixnum)arg2).value;
if (index >= 0 && index < bv.elements.Length)
{
}
else
{
Exn.fault(blame, "index out of range", arg1, arg2, arg3);
}
}
// big endian
public static void bignumSet(SByteVL b, int index, ushort value)
{
int x;
if ((index & 1) == 0)
{
x = index + 3;
}
else
{
x = index + 1;
}
b.setUInt16(x, value);
}
public static ushort bignumRef(SByteVL b, int index)
{
int x;
if ((index & 1) == 0)
{
x = index + 3;
}
else
{
x = index + 1;
}
return(b.getUInt16(x));
}
public static void op1_negative(SObject arg)
{
if (arg is SFixnum)
{
int a = ((SFixnum)arg).value;
Reg.Result = Factory.makeNumber(-a);
return;
}
else if (arg is SVL)
{
SVL a = (SVL)arg;
if (a.tag == Tags.RatnumTag)
{
Call.callMillicodeSupport1(Constants.MS_RATNUM_NEGATE, a);
return; // TAIL CALL
}
else if (a.tag == Tags.RectnumTag)
{
Call.callMillicodeSupport1(Constants.MS_RECTNUM_NEGATE, a);
return;
}
}
else if (arg is SByteVL)
{
SByteVL a = (SByteVL)arg;
if (a.tag == Tags.BignumTag)
{
Call.callMillicodeSupport1(Constants.MS_BIGNUM_NEGATE, a);
return;
}
else if (a.tag == Tags.FlonumTag)
{
Reg.Result = Factory.makeFlonum(-a.unsafeAsDouble(0));
return;
}
else if (a.tag == Tags.CompnumTag)
{
double real = a.unsafeAsDouble(0);
double imag = a.unsafeAsDouble(1);
Reg.Result = Factory.makeCompnum(-real, -imag);
return;
}
}
Exn.fault(Constants.EX_NEG, "not a number");
return;
}
public static SByteVL makeBignum(short[] bigits, bool positive)
{
int bigitc = bigits.Length;
if (bigitc > MAX_BIGNUM_BIGITS)
{
throw new Exception("Internal error: bignum too large");
}
else
{
SByteVL b = allocBignum(bigitc);
setBignumSign(b, positive);
// Bignums use a sign + magnitude representation,
// so the digits in a bignum are positive numbers in the
// half-open interval [0, 65536)
// But someone, somewhere wants to send us the digits in
// a vector of signed shorts (in two's complement), which
// lie in the open interval [-32768, 32767) so we have to convert.
// For digits in the range [0, 32767), the two's complement
// and the unsigned magnitude are the same, but the digits in the
// range [32768, 65536) are negative numbers in two's complement.
// We cannot simply add 65536 to the digit because the types don't
// match, and we cannot simply negate the digit and subtract because
// the negative number -32768 has no positive number in the range
// of representable shorts. Therefore, we add one to the digit before
// negating it, convert that to a unsigned short, then subtract it
// from the Max unsigned short.
// Why not simply cast the thing? That isn't a technically correct
// operation because it *assumes* that the underlying representation
// of shorts is two's complement of the appropriate width. The way we
// do it here doesn't depend on the machine representation.
for (int i = 0; i < bigitc; ++i)
{
short bigit = bigits[i];
bignumSet(b, i, (bigit < 0) ? (ushort)(UInt16.MaxValue - ((ushort)(-(bigit + 1)))) : (ushort)bigit);
}
return(b);
}
}
/* Comparison Operations */
/* --------------------- */
public static void op1_zerop(SObject arg)
{
if (arg is SFixnum)
{
Reg.Result = Factory.makeBoolean(((SFixnum)arg).value == 0);
return;
}
else if (arg is SVL)
{
SVL a = (SVL)arg;
if (a.tag == Tags.RatnumTag)
{
Reg.Result = Factory.False; // FIXME???
}
else if (a.tag == Tags.RectnumTag)
{
op2_numeric_equals(arg, Factory.makeFixnum(0));
return;
}
}
else if (arg is SByteVL)
{
SByteVL a = (SByteVL)arg;
if (a.tag == Tags.BignumTag)
{
Reg.Result = Factory.makeBoolean(Number.getBignumLength(a) == 0);
return;
}
else if (a.tag == Tags.FlonumTag)
{
Reg.Result = Factory.makeBoolean(a.unsafeAsDouble(0) == 0.0);
return;
}
else if (a.tag == Tags.CompnumTag)
{
Reg.Result = Factory.makeBoolean
(a.unsafeAsDouble(0) == 0.0 &
a.unsafeAsDouble(1) == 0.0);
return;
}
}
Reg.Result = Factory.makeBoolean(false);
return;
}
public static void op2_quotient(SObject arg1, SObject arg2)
{
if (arg1 is SFixnum & arg2 is SFixnum)
{
int a = ((SFixnum)arg1).value;
int b = ((SFixnum)arg2).value;
if (b != 0)
{
int result = a / b;
Reg.Result = Factory.makeFixnum(result);
return;
}
else
{
Exn.fault(Constants.EX_QUOTIENT, "division by zero", arg1, arg2);
return;
}
}
else if (arg1 is SByteVL & arg2 is SFixnum)
{
SByteVL a = (SByteVL)arg1;
int b = ((SFixnum)arg2).value;
if (b == 0)
{
Exn.fault(Constants.EX_QUOTIENT, "division by zero", arg1, arg2);
return;
}
if (b > 0 &&
a.tag == Tags.BignumTag &&
Number.getBignumLength(a) == 1 &&
Number.getBignumSign(a) == Number.BIGNUM_POSITIVE)
{
// Exn.msg.WriteLine("++++ doing bignum quotient in millicode");
uint av = a.getUInt32(1);
uint result = av / (uint)b;
Reg.Result = Factory.makeNumber(result);
return;
}
}
Call.callMillicodeSupport2(Constants.MS_HEAVY_QUOTIENT, arg1, arg2);
return; // TAIL CALL
}
public static SByteVL makeBignum(ulong value, bool positive)
{
int bigitc = 0;
for (ulong v = value; v != 0; v = v >> BIGIT_BITS)
{
bigitc++;
}
SByteVL b = allocBignum(bigitc);
setBignumSign(b, positive);
for (int i = 0; i < bigitc; ++i)
{
bignumSet(b, i, (ushort)(value & BIGIT_MASK));
value = value >> BIGIT_BITS;
}
return(b);
}
public static void op1_truncate(SObject arg)
{
if (arg is SFixnum)
{
Reg.Result = arg;
return;
}
else if (arg is SVL)
{
SVL a = (SVL)arg;
if (a.tag == Tags.RatnumTag)
{
Call.callMillicodeSupport1(Constants.MS_RATNUM_TRUNCATE, arg);
return;
}
}
else if (arg is SByteVL)
{
SByteVL a = (SByteVL)arg;
if (a.tag == Tags.FlonumTag)
{
double d = a.unsafeAsDouble(0);
if (d < 0)
{
Reg.Result = Factory.makeFlonum(System.Math.Ceiling(d));
return;
}
else
{
Reg.Result = Factory.makeFlonum(System.Math.Floor(d));
return;
}
}
else if (a.tag == Tags.BignumTag)
{
return;
}
}
Exn.fault(Constants.EX_TRUNC, "truncate: expected real number");
}
public static void op1_inexact2exact(SObject arg)
{
if (arg is SFixnum)
{
return;
}
else if (arg is SVL)
{
SVL a = (SVL)arg;
}
else if (arg is SByteVL)
{
SByteVL a = (SByteVL)arg;
if (a.tag == Tags.FlonumTag
| a.tag == Tags.CompnumTag)
{
Call.callMillicodeSupport1(Constants.MS_GENERIC_INEXACT2EXACT, arg);
return;
}
else if (a.tag == Tags.BignumTag)
{
return;
}
}
else if (arg is SVL)
{
SVL a = (SVL)arg;
if (a.tag == Tags.RatnumTag)
{
return;
}
else if (a.tag == Tags.RectnumTag)
{
return;
}
}
Exn.fault(Constants.EX_I2E, "not a number");
return;
}
public static SByteVL allocBignum(int bigitc) {
int length = (bigitc*BYTES_PER_BIGIT + 3) & ~(int)3;
SByteVL b = new SByteVL(Tags.BignumTag, length + 4, 0);
setBignumLengthInBigits(b, bigitc);
return b;
}
// getBignumLength returns the number of data words in the bignum
public static int getBignumLength(SByteVL b) {
return BIGNUM_LENGTH_MASK & (int) b.getUInt32(BIGNUM_LENGTH_OFFSET);
}
public static ushort bignumRef(SByteVL b, int index) {
int x;
if ((index & 1) == 0) {
x = index + 3;
} else {
x = index + 1;
}
return b.getUInt16(x);
}
public static SObject compImagPart(SByteVL n) {
return Factory.makeFlonum(n.unsafeAsDouble(1));
}
public static ushort bignumRef(SByteVL b, int index) {
return b.getUInt16(index + BIGNUM_DATA_OFFSET);
}
// big endian
public static void bignumSet(SByteVL b, int index, ushort value) {
int x;
if ((index & 1) == 0) {
x = index + 3;
} else {
x = index + 1;
}
b.setUInt16(x, value);
}
public static bool isZeroBignum(SByteVL b) {
return getBignumLength(b) == 0;
}
// little endian
public static void bignumSet(SByteVL b, int index, ushort value) {
b.setUInt16(index + BIGNUM_DATA_OFFSET, value);
}
public static bool getBignumSign(SByteVL b) {
return b.getByte(BIGNUM_SIGN_OFFSET) == BIGNUM_POSITIVE;
}
public static void setBignumSign(SByteVL b, bool sign) {
b.setByte(BIGNUM_SIGN_OFFSET, sign ? BIGNUM_POSITIVE : BIGNUM_NEGATIVE);
}
public static SObject compImagPart(SByteVL n)
{
return(Factory.makeFlonum(n.unsafeAsDouble(1)));
}
public static ushort bignumRef(SByteVL b, int index)
{
return(b.getUInt16(index + BIGNUM_DATA_OFFSET));
}
public static void op2_multiply(SObject arg1, SObject arg2)
{
if (arg1 is SFixnum & arg2 is SFixnum)
{
long a = ((SFixnum)arg1).value;
long b = ((SFixnum)arg2).value;
Reg.Result = Factory.makeNumber(a * b);
return;
}
else if (arg1 is SVL & arg2 is SVL)
{
SVL a = (SVL)arg1;
SVL b = (SVL)arg2;
if (a.tag == Tags.RatnumTag &
b.tag == Tags.RatnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RATNUM_MUL, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.RectnumTag & b.tag == Tags.RectnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RECTNUM_MUL, a, b);
return; // TAIL CALL
}
}
else if (arg1 is SByteVL & arg2 is SByteVL)
{
SByteVL a = (SByteVL)arg1;
SByteVL b = (SByteVL)arg2;
if (a.tag == Tags.BignumTag & b.tag == Tags.BignumTag)
{
Call.callMillicodeSupport2(Constants.MS_BIGNUM_MUL, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.FlonumTag & b.tag == Tags.FlonumTag)
{
double av = a.unsafeAsDouble(0);
double bv = b.unsafeAsDouble(0);
double result = av * bv;
Reg.Result = Factory.makeFlonum(result);
return;
}
else if (a.tag == Tags.CompnumTag)
{
double ar = a.unsafeAsDouble(0);
double ai = a.unsafeAsDouble(1);
if (b.tag == Tags.CompnumTag)
{
double br = b.unsafeAsDouble(0);
double bi = b.unsafeAsDouble(1);
// We have to consider separately the case where one
// of the imaginary parts is 0 in order to avoid
// getting NaN.
if (ai == 0)
{
double real = ar * br;
double imag = ar * bi;
Reg.Result = Factory.makeCompnum(real, imag);
}
else if (bi == 0)
{
double real = ar * br;
double imag = ai * br;
Reg.Result = Factory.makeCompnum(real, imag);
}
else
{
double real = ar * br - ai * bi;
double imag = ar * bi + ai * br;
Reg.Result = Factory.makeCompnum(real, imag);
}
return;
}
else if (b.tag == Tags.FlonumTag & ai == 0.0)
{
double br = b.unsafeAsDouble(0);
Reg.Result = Factory.makeFlonum(ar * br);
return;
}
}
}
Procedure generic
= Call.getSupportProcedure(Constants.MS_GENERIC_MUL);
Call.contagion(arg1, arg2, generic);
return; // TAIL CALL
}
private static SObject datum2foreign(int conversion, SObject obj)
{
// datum->foreign : conversion value -> F
// Always returns a foreign box. Contents of the box is controlled
// by the conversion switch.
switch (conversion)
{
// No conversion. Scheme object is placed in the box.
case 0:
{
return(Factory.makeForeignBox(obj));
}
// String.
case 1:
{
return(Factory.makeForeignBox
(((SByteVL)obj).asString()));
}
// various integer forms
case 2:
{
return(Factory.makeForeignBox
((Byte)((SFixnum)obj).value));
}
case 3:
{
return(Factory.makeForeignBox
((UInt16)((SFixnum)obj).value));
}
case 4:
{
return(Factory.makeForeignBox
((UInt32)((SFixnum)obj).value));
}
case 5:
{
return(Factory.makeForeignBox
((SByte)((SFixnum)obj).value));
}
case 6:
{
return(Factory.makeForeignBox
((Int16)((SFixnum)obj).value));
}
case 7:
{
return(Factory.makeForeignBox
((Int32)((SFixnum)obj).value));
}
case 8: // message filter
{
#if HAS_WINDOWS_FORMS
return(Factory.makeForeignBox
(new FFI_message_filter((Procedure)obj)));
#else
Exn.error("datum->foreign (message_filter) not supported in this version");
return(Factory.Impossible);
#endif
}
case 10: // single precision float
{
return(Factory.makeForeignBox
((float)((SByteVL)obj).unsafeAsDouble(0)));
}
case 11: //double precision float
{
return(Factory.makeForeignBox
((double)((SByteVL)obj).unsafeAsDouble(0)));
}
case 12: // character
{
return(Factory.makeForeignBox((Char)((SChar)obj).val));
}
case 13: // bytevector-like
{
object copy = ((SByteVL)obj).elements.Clone();
return(Factory.makeForeignBox((byte[])copy));
}
#if NEVER
case 0: // object
{
if (obj is SFixnum || obj is ForeignBox)
{
return(obj);
}
else
{
Exn.error("datum->foreign (object) expected F");
return(Factory.Impossible);
}
}
case 1: // schemeobject
{
return(Factory.makeForeignBox(obj));
}
case 2: // string
{
if (obj is SByteVL)
{
string value = ((SByteVL)obj).asString();
return(Factory.makeForeignBox(value));
}
else
{
Exn.error("datum->foreign (string) expected string");
return(Factory.Impossible);
}
}
case 3: // symbol
{
Exn.error
("datum->foreign (symbol) not implemented in runtime");
return(Factory.Impossible);
}
case 4: // bytes
{
if (obj is SByteVL)
{
return(Factory.makeForeignBox
(((SByteVL)obj).elements));
}
else
{
Exn.error
("datum->foreign (bytes) expected bytevector");
return(Factory.Impossible);
}
}
case 5: // int
{
if (obj is SFixnum)
{
return(obj);
}
else if (obj.isBignum())
{
SByteVL n = (SByteVL)obj;
if (Number.getBignumLength(n) == 1)
{
uint magn = (uint)(Number.bignumRef(n, 1) << 16)
+ (uint)Number.bignumRef(n, 0);
int val = magn;
if (!(Number.getBignumSign(n)))
{
magn = -magn;
}
return(Factory.makeForeignBox(val));
}
}
Exn.error("datum->foreign (int) expected small integer");
return(Factory.Impossible);
}
case 6: // float
{
if (obj.isFlonum())
{
double value = ((SByteVL)obj).unsafeAsDouble(0);
return(Factory.makeForeignBox((float)value));
}
else
{
Exn.error("datum->foreign (float) expected flonum");
return(Factory.Impossible);
}
}
case 7: // double
{
if (obj.isFlonum())
{
double value = ((SByteVL)obj).unsafeAsDouble(0);
return(Factory.makeForeignBox(value));
}
else
{
Exn.error("datum->foreign (float) expected flonum");
return(Factory.Impossible);
}
}
case 8: // void
{
Exn.error("datum->foreign (void) not allowed");
return(Factory.Impossible);
}
case 9: // message filter
{
if (obj is Procedure)
{
return(Factory.makeForeignBox
(new FFI_message_filter((Procedure)obj)));
}
else
{
Exn.error
("datum->foreign (message filter) expected procedure");
return(Factory.Impossible);
}
}
#endif
}
Exn.error("datum->foreign: unknown conversion");
return(Factory.Impossible);
}
public static SByteVL makeUString(byte[] bytes) {
SByteVL ustring = new SByteVL(Tags.UStringTag,
bytes.Length * 4, 0);
for (int i = 0; i < bytes.Length; ++i) {
makeFixnum(i).op_reversed_ustring_set(ustring,
makeChar((char)bytes[i]));
}
return ustring;
}
public static void setBignumLengthInBigits(SByteVL b, int bigitc) {
byte sign = getBignumSign(b) ? BIGNUM_POSITIVE : BIGNUM_NEGATIVE;
int wordc = (bigitc + 1) >> 1;
uint meta = (((uint) sign) << BIGNUM_SIGN_SHIFT) | (uint) wordc;
b.setUInt32(BIGNUM_LENGTH_OFFSET, meta);
}
public static void op2_eqvp(SObject arg1, SObject arg2)
{
// EQ test first, get that out of the way.
if (arg1 == arg2)
{
Reg.Result = Factory.True;
return;
}
else if (arg1 is SChar & arg2 is SChar)
{
Reg.Result = Factory.wrap(((SChar)arg1).val == ((SChar)arg2).val);
return;
}
else if (arg1 is SFixnum & arg2 is SFixnum)
{
bool result =
((SFixnum)arg1).value == ((SFixnum)arg2).value;
Reg.Result = Factory.makeBoolean(result);
return;
}
else if (arg1 is SVL & arg2 is SVL)
{
SVL a = (SVL)arg1;
SVL b = (SVL)arg2;
if (a.tag == Tags.RatnumTag & b.tag == Tags.RatnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RATNUM_EQUAL, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.RectnumTag & b.tag == Tags.RectnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RECTNUM_EQUAL, a, b);
return; // TAIL CALL
}
else
{
Reg.Result = Factory.False;
return;
}
}
else if (arg1 is SByteVL & arg2 is SByteVL)
{
SByteVL a = (SByteVL)arg1;
SByteVL b = (SByteVL)arg2;
if (a.tag == Tags.BignumTag & b.tag == Tags.BignumTag)
{
Call.callMillicodeSupport2(Constants.MS_BIGNUM_EQUAL, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.FlonumTag & b.tag == Tags.FlonumTag)
{
double av = a.unsafeAsDouble(0);
double bv = b.unsafeAsDouble(0);
Reg.Result = Factory.makeBoolean(av == bv);
return;
}
else if (a.tag == Tags.CompnumTag & b.tag == Tags.CompnumTag)
{
double ar = a.unsafeAsDouble(0);
double ai = a.unsafeAsDouble(1);
double br = b.unsafeAsDouble(0);
double bi = b.unsafeAsDouble(1);
Reg.Result = Factory.makeBoolean(ar == br & ai == bi);
return;
}
else
{
Reg.Result = Factory.False;
return;
}
}
else
{
Reg.Result = Factory.False;
return;
}
}
public static void op2_divide(SObject arg1, SObject arg2)
{
if (arg1 is SFixnum & arg2 is SFixnum)
{
int a = ((SFixnum)arg1).value;
int b = ((SFixnum)arg2).value;
if (b != 0)
{
int result = a / b;
if (result * b == a)
{
Reg.Result = Factory.makeFixnum(result);
return;
}
}
else
{
Exn.fault(Constants.EX_DIV, "division by zero", arg1, arg2);
return;
}
Call.callMillicodeSupport2(Constants.MS_FIXNUM2RATNUM_DIV,
arg1, arg2);
return; // TAIL CALL
}
else if (arg1 is SVL & arg2 is SVL)
{
SVL a = (SVL)arg1;
SVL b = (SVL)arg2;
if (a.tag == Tags.RatnumTag & b.tag == Tags.RatnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RATNUM_DIV, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.RectnumTag & b.tag == Tags.RectnumTag)
{
Call.callMillicodeSupport2(Constants.MS_RECTNUM_DIV, a, b);
return; // TAIL CALL
}
}
else if (arg1 is SByteVL & arg2 is SByteVL)
{
SByteVL a = (SByteVL)arg1;
SByteVL b = (SByteVL)arg2;
if (a.tag == Tags.BignumTag & b.tag == Tags.BignumTag)
{
Call.callMillicodeSupport2(Constants.MS_BIGNUM_DIV, a, b);
return; // TAIL CALL
}
else if (a.tag == Tags.FlonumTag & b.tag == Tags.FlonumTag)
{
double av = a.unsafeAsDouble(0);
double bv = b.unsafeAsDouble(0);
double result = av / bv;
Reg.Result = Factory.makeFlonum(result);
return;
}
else if (a.tag == Tags.CompnumTag & b.tag == Tags.CompnumTag)
{
double ar = a.unsafeAsDouble(0);
double ai = a.unsafeAsDouble(1);
double br = b.unsafeAsDouble(0);
double bi = b.unsafeAsDouble(1);
double denom = br * br + bi * bi;
Reg.Result = Factory.makeCompnum
((ar * br + ai * bi) / denom,
(ai * br - ar * bi) / denom);
return;
}
}
Procedure generic
= Call.getSupportProcedure(Constants.MS_GENERIC_DIV);
Call.contagion(arg1, arg2, generic);
return; // TAIL CALL
}
public static SByteVL makeUString(int length, int fill) {
SByteVL ustring = new SByteVL(Tags.UStringTag, length * 4, 0);
SChar c = makeChar(fill);
for (int i = 0; i < length; ++i) {
makeFixnum(i).op_reversed_ustring_set(ustring, c);
}
return ustring;
}
