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));
}
private static SObject wrapF(object o)
{
if (o is Int32 && SFixnum.inFixnumRange((int)o))
{
return(Factory.makeFixnum((int)o));
}
else
{
return(Factory.makeForeignBox(o));
}
}
public static SObject makeNumber(int num)
{
// Bignums are sign + magnitude, so we need to convert
// negative numbers to the positive equivalent.
// We have to be tricky here because simply negating
// the num might fall out of the range of representable
// signed integers. Therefore, we cast it to a long first.
return
(SFixnum.inFixnumRange(num) ? SFixnum.makeFixnum(num)
: (num < 0) ? (SObject)makeBignum((ulong)(-((long)(num))), false)
: (SObject)makeBignum((ulong)num, true));
}
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 SObject makeNumber(long num)
{
// Bignums are sign + magnitude, so we need to convert
// negative numbers to the positive equivalent.
// We have to be tricky here because simply negating
// the num might fall out of the range of representable
// signed longs. We therefore add 1 before negating it
// (effectively subtracting 1 from the magnitude) and
// then add 1 after casting to restore magnitude.
return
(SFixnum.inFixnumRange(num) ? SFixnum.makeFixnum((int)num)
: (num < 0) ? (SObject)makeBignum(((ulong)(-(num + 1))) + 1, false)
: (SObject)makeBignum((ulong)num, true));
}
public static SFixnum makeFixnum(int num)
{
return(SFixnum.makeFixnum(num));
}
public static SFixnum makeFixnum(byte num)
{
return(SFixnum.makeFixnum(num));
}
public static SObject makeNumber(ulong num)
{
return(SFixnum.inFixnumRange(num)
? SFixnum.makeFixnum((int)num)
: (SObject)makeBignum(num, true));
}
public SchemeCallException (Procedure p, int argc) :
base (p.InitialCodeAddress)
{
this.p = p;
this.argc = Factory.makeFixnum (argc);
}
// MainHelper takes the argument vector, executes the body of the caller's
// assembly (should be the assembly corresponding to the compiled scheme
// code) and then executes the "go" procedure, if available.
public static void MainHelper(string[] args)
{
Console.WriteLine("CommonLarceny");
Console.WriteLine("CLR, Version={0}", System.Environment.Version);
Console.WriteLine("{0}",
System.Reflection.Assembly.GetExecutingAssembly());
Console.WriteLine("{0}", System.Reflection.Assembly.GetCallingAssembly());
Console.WriteLine("");
Debug.Listeners.Add(new TextWriterTraceListener(Console.Out));
// Debug.WriteLine ("CLR Version: {0}", System.Environment.Version);
Debug.WriteLine("DEBUG version of Scheme runtime.");
Debug.WriteLine(test_checked()
? "CHECKED arithmetic"
: "UNCHECKED arithmetic");
{ // Establish invariant that LARCENY_ROOT has been set before we
// invoke (interactive-entry-point ...)
string lar_root = Environment.GetEnvironmentVariable("LARCENY_ROOT");
if (lar_root == null)
{
Type[] argtypes = { typeof(string), typeof(string) };
MethodInfo method;
string location = Assembly.GetCallingAssembly().Location;
lar_root = System.IO.Path.GetDirectoryName(location);
// By reflection:
// Environment.SetEnvironmentVariable("LARCENY_ROOT", lar_root);
try {
method = typeof(Environment).GetMethod("SetEnvironmentVariable",
argtypes);
method.Invoke(null, new Object[] { "LARCENY_ROOT", lar_root });
}
catch (Exception e) {
throw new Exception("Couldn't set LARCENY_ROOT; please "
+ "set it and try again: ", e);
}
}
}
// Mono throws a not implemented exception here.
try {
InitializePerformanceCounters();
} catch (Exception) {};
Debug.WriteLine("Initializing fixnum pool.");
SFixnum.Initialize();
Debug.WriteLine("Initializing immediates.");
SImmediate.Initialize();
Debug.WriteLine("Initializing char pool.");
SChar.Initialize();
Debug.WriteLine("Initializing registers.");
Reg.Initialize(Assembly.GetCallingAssembly());
Cont.Initialize();
bool keepRunning = handleAssembly(Reg.programAssembly);
if (keepRunning)
{
handleGo(args);
}
}
public SchemeCallException(Procedure p, int argc) :
base(p.InitialCodeAddress)
{
this.p = p;
this.argc = Factory.makeFixnum(argc);
}
