// return new stream position,
// -1 on error
public static long LSeek(int fd, long offset, int whence_code)
{
SeekOrigin whence = SeekOrigin.Begin;
if (whence_code == 0)
{
whence = SeekOrigin.Begin;
}
else if (whence_code == 1)
{
whence = SeekOrigin.Current;
}
else if (whence_code == 2)
{
whence = SeekOrigin.End;
}
else
{
Exn.fault(Constants.EX_ASSERT, "bad whence_code for lseek");
}
try {
return(fd2stream(fd).Seek(offset, whence));
} catch (Exception) {
return(-1);
}
}
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");
}
/* ===================================================== */
/* Utility */
/* ===================================================== */
public static void expect1(bool b, SObject arg, int blame)
{
if (!b)
{
Exn.fault(blame, "bad argument: " + arg, arg);
}
}
public static SObject op2_procedure_ref(SObject arg1, SObject arg2)
{
expect2(arg1.isProcedure(), arg1, arg2.isFixnum(), arg2, Constants.EX_PROCEDURE_REF);
Procedure p = (Procedure)arg1;
int b = ((SFixnum)arg2).value;
if (b == 0)
{
// Code vector
return(p.getCode());
}
else if (b == 1)
{
// Constant vector
return(p.constantvector);
}
else if (b > 1)
{
b = b - 2;
if (b < p.rib.Length)
{
return(p.rib[b]);
}
}
Exn.fault(Constants.EX_PROCEDURE_REF, "procedure-ref: bad index", arg1, arg2);
return(null);
}
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 CodeAddress fault(int blame, string m,
SObject arg1, SObject arg2, SObject arg3)
{
Reg.Result = arg1;
Reg.Second = arg2;
Reg.Third = arg3;
return(Exn.fault(blame, m));
}
public static SObject op1_fxnegative(SObject arg)
{
expect1(arg.isFixnum(), arg, Constants.EX_FXNEG);
int a = ((SFixnum)arg).value;
if (!SFixnum.inFixnumRange(-a))
{
Exn.fault(Constants.EX_FXNEG, "result not a fixnum", arg);
}
return(Factory.makeNumber(-a));
}
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 SObject op2_fxmul(SObject arg1, SObject arg2)
{
expect2(arg1.isFixnum(), arg1, arg2.isFixnum(), arg2, Constants.EX_FXMUL);
int a = ((SFixnum)arg1).value;
int b = ((SFixnum)arg2).value;
int c = a * b;
if (!SFixnum.inFixnumRange(c))
{
Exn.fault(Constants.EX_FXMUL, "result not a fixnum", arg1, arg2);
}
return(Factory.makeNumber(c));
}
public static void rangeCheckVL(SObject arg1, SObject arg2, SObject arg3, int blame)
{
SVL bv = (SVL)arg1;
int index = ((SFixnum)arg2).value;
if (index >= 0 && index < bv.elements.Length)
{
}
else
{
Exn.fault(blame, "index out of range", arg1, arg2, arg3);
}
}
public static void expect2(bool b1, SObject arg1,
bool b2, SObject arg2,
int blame)
{
if (!b1)
{
Exn.fault(blame, "bad argument 1: " + arg1, arg1, arg2);
}
if (!b2)
{
Exn.fault(blame, "bad argument 2: " + arg2, arg1, arg2);
}
}
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;
}
/* Misc */
/* ---- */
public static void op1_enable_interrupts(SObject arg)
{
Ops.expect1(arg.isFixnum(), arg, Constants.EX_EINTR);
int time = ((SFixnum)arg).value;
if (time > 0)
{
Reg.interruptsEnabled = true;
Reg.timer = time;
}
else
{
Exn.fault(Constants.EX_EINTR,
"enable-interrupts: expected positive value");
}
Reg.Result = Factory.Unspecified;
Exn.checkSignals();
}
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 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 SObject op3_procedure_set(SObject arg1, SObject arg2, SObject arg3)
{
expect3(arg1.isProcedure(), arg1, arg2.isFixnum(), arg2, true, arg3,
Constants.EX_PROCEDURE_SET);
Procedure p = (Procedure)arg1;
int b = ((SFixnum)arg2).value;
// System.Console.WriteLine("** (procedure-set! {0} {1} {2})", arg1, arg2, arg3);
if (b == 0)
{
// "code vector"
p.setCode(arg3);
return(Factory.Unspecified);
}
else if (b == 1)
{
if (arg3.isVector())
{
p.setConstants((SVL)arg3);
return(Factory.Unspecified);
}
else
{
Exn.fault(Constants.EX_PROCEDURE_SET, "not a vector", arg1, arg2, arg3);
return(null);
}
}
else if (b > 1)
{
int bb = b - 2;
if (bb < p.rib.Length)
{
p.rib[bb] = arg3;
return(Factory.Unspecified);
}
}
Exn.fault(Constants.EX_PROCEDURE_SET, "procedure-set!: bad index " + b, arg1, arg2, arg3);
return(null);
}
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 SObject op1_gc_counter(SObject arg)
{
Exn.fault(Constants.EX_UNSUPPORTED);
return(Factory.Unspecified);
}
public static SObject op1_break(SObject arg)
{
Exn.fault(Constants.EX_BREAKPOINT);
return(Factory.Impossible);
}
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 CodeAddress fault(int blame, string m, SObject arg)
{
Reg.Result = arg;
return(Exn.fault(blame, m));
}