/* fixnum.c -- UMB Scheme, implementation of specific fixnum procedures. 

UMB Scheme Interpreter  				$Revision: 1.1 $
Copyright (C) 1988, 1996 William R Campbell

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

UMB Scheme was written by Bill Campbell with help from Karl Berry,
Barbara Dixey, Ira Gerstein, Mary Glaser, Kathy Hargreaves, Bill McCabe,
Long Nguyen, Susan Quina, Jeyashree Sivasubram, Bela Sohoni, John Tam 
and Thang Quoc Tran.

For additional information about UMB Scheme, contact the author:

	Bill Campbell
	Department of Mathematics and Computer Science
	University of Massachusetts at Boston
	Harbor Campus
	Boston, MA 02125

	Telephone: 617-287-6449		Internet: bill@cs.umb.edu

*/



#include "portable.h"
#include "eval.h"
#include "object.h"
#include "architecture.h"
#include "number.h"
#include "fixnum.h"
#include "bignum.h"
#include "rational.h"
#include "real.h"
#include "complex.h"
#include "steering.h"
#include "io.h"
#include <math.h>
#include <errno.h>

#include <stdlib.h>


/* Predicates. */
Boolean 
Is_Fixnum_Zero (void)
{
	return ( Get_Number_Fixnum_Value(Top(1)) == 0 );
}



Boolean 
Is_Fixnum_Positive (void)
{
	return ( Get_Number_Fixnum_Value(Top(1)) > 0);
}



Boolean 
Is_Fixnum_Negative (void)
{
	return ( Get_Number_Fixnum_Value(Top(1)) < 0 );
}



Boolean 
Is_Fixnum_Odd (void)
{
	return ( Get_Number_Fixnum_Value(Top(1)) % 2 != 0 );
}



Boolean 
Is_Fixnum_Even (void)
{
	return ( Get_Number_Fixnum_Value(Top(1)) % 2 == 0 );
}



Boolean 
Is_Fixnum_Exact (void)
{
	return TRUE;
}



Boolean 
Is_Fixnum_Inexact (void)
{
	return FALSE;
}




/* Comparisons. */
Boolean 
Fixnum_Less_Than (void)
{
	return ( Get_Number_Fixnum_Value(Top(2)) <
		 Get_Number_Fixnum_Value(Top(1)) );
}



Boolean 
Fixnum_Greater_Than (void)
{
	return ( Get_Number_Fixnum_Value(Top(2)) > 
		 Get_Number_Fixnum_Value(Top(1)) );
}



Boolean 
Fixnum_Equal (void)
{
	return ( Get_Number_Fixnum_Value(Top(2)) == 
		 Get_Number_Fixnum_Value(Top(1)));
}



Boolean 
Fixnum_Less_Than_Or_Equal (void)
{
	return ( Get_Number_Fixnum_Value(Top(2)) <= 
		 Get_Number_Fixnum_Value(Top(1)));
}



Boolean 
Fixnum_Greater_Than_Or_Equal (void)
{
	return ( Get_Number_Fixnum_Value(Top(2)) >= 
		 Get_Number_Fixnum_Value(Top(1)));
}




/* Arithmetic. */
Public void 
Fixnum_Add (void)
{
	Integer result =  ( Get_Number_Fixnum_Value(Top(2)) +
			  Get_Number_Fixnum_Value(Top(1)) );

	if (abs(result) >= RADIX)
	{
		Make_Small_Bignum(result);
	}
	else
	{
		Make_Fixnum_Number( (Short) result);
	}
}



Public void 
Fixnum_Subtract (void)
{
	Integer result =  ( Get_Number_Fixnum_Value(Top(2)) -
			  Get_Number_Fixnum_Value(Top(1)) );

	if (abs(result) >= RADIX)
	{
		Make_Small_Bignum(result);
	}
	else
	{
		Make_Fixnum_Number( (Short) result);
	}
}



Public void 
Fixnum_Multiply (void)
{
	Integer result =  ( Get_Number_Fixnum_Value(Top(2)) *
			  Get_Number_Fixnum_Value(Top(1)) );

	if (abs(result) >= RADIX)
	{
		Make_Small_Bignum(result);
	}
	else
	{
		Make_Fixnum_Number( (Short) result);
	}
}



Public void 
Fixnum_Divide (void)
{
	Integer remainder = Get_Number_Fixnum_Value(Top(2)) % 
			  Get_Number_Fixnum_Value(Top(1));

	if (remainder)
	{
		Make_Rational_Number();
	}
	else
	{
		Make_Fixnum_Number( (Short) (Get_Number_Fixnum_Value(Top(2)) /
		    Get_Number_Fixnum_Value(Top(1))));
	}
}



Public void 
Fixnum_Quotient (void)
{
	Make_Fixnum_Number( (Short) ( Get_Number_Fixnum_Value(Top(2)) /
	    Get_Number_Fixnum_Value(Top(1)) ) );
}



Public void 
Fixnum_Remainder (void)
{
	Make_Fixnum_Number( (Short) ( Get_Number_Fixnum_Value(Top(2)) %
	    Get_Number_Fixnum_Value(Top(1)) ) );
}



Public void 
Fixnum_Modulo (void)
{
	Short dividend = Get_Number_Fixnum_Value(Top(2));
	Short divisor = Get_Number_Fixnum_Value(Top(1));

	Integer remainder = dividend % divisor;

	if( (divisor*dividend) >= 0 )
	{
		Make_Fixnum_Number( (Short) remainder );
	}

	else
	{
		Make_Fixnum_Number( (Short) (remainder + divisor) );	
	}
}


 

Public void 
Fixnum_Negate (void)
{
	Value_Register = Copy_Object(Top(1), Fixnum_Size);

	Get_Number_Fixnum_Value(Value_Register) = 
 	    - Get_Number_Fixnum_Value(Value_Register);
}		


	
Public void 
Fixnum_Abs (void)
{
	if (Is_Fixnum_Negative())
	{
		Fixnum_Negate();
	}
	else
	{
		Value_Register = Top(1);
	}
}



Public void 
Fixnum_Numerator (void)
{
	Value_Register = Top(1);
}


 
Public void 
Fixnum_Denominator (void)
{
	Make_Fixnum_Number(1);
}


 
Public void 
Fixnum_Rationalize (void)
{
	Error("Rationalize makes no sense on fixnums");
}




Public void 
Fixnum_Max (void)
{
	Make_Fixnum_Number( 
	    (Get_Number_Fixnum_Value(Top(2)) > Get_Number_Fixnum_Value(Top(1))
	    ? Get_Number_Fixnum_Value(Top(2))
	    : Get_Number_Fixnum_Value(Top(1))) );
}



Public void 
Fixnum_Min (void)
{
	Make_Fixnum_Number( 
	    (Get_Number_Fixnum_Value(Top(2)) < Get_Number_Fixnum_Value(Top(1))
	    ? Get_Number_Fixnum_Value(Top(2))
	    : Get_Number_Fixnum_Value(Top(1))) );
}



Public void 
Fixnum_GCD (void)
{
	
	/* make arguments positive since GCD is always positive */

	Push(Top(2));
	Fixnum_Abs();
	Replace( 1 , Value_Register );

	Push(Top(2));
	Fixnum_Abs();
	Replace( 1 , Value_Register );

	while (! Is_Fixnum_Zero() )
	{
		Fixnum_Remainder();
		Top(2) = Top(1);
		Top(1) = Value_Register;
	}

	Value_Register  = Top(2);
	Pop(2);
}


 
Public void 
Fixnum_LCM (void)
{
	/*  LCM(a,b) = (a*b)/GCD(a,b)  */
	
	Fixnum_Multiply();
	Push(Value_Register);

	Push(Top(3));
	Push(Top(3));

	Fixnum_GCD();
	Push(Value_Register);

	Top(2) = Top(4);
	Number_Divide();

	Push(Value_Register);
	Number_Abs();

	Pop(5);

}


 

Public void 
Fixnum_Floor (void)
{
	Value_Register = Top(1);
}


 
Public void 
Fixnum_Ceiling (void)
{
	Value_Register = Top(1);
}


 
Public void 
Fixnum_Truncate (void)
{
	Value_Register = Top(1);
}


 
Public void 
Fixnum_Round (void)
{
	Value_Register = Top(1);
}




Public void 
Fixnum_Sqrt (void)
{
	Promote(1, REAL_LEVEL);
	
	if( Get_Number_Real_Value(Top(1)) < 0 )
	{
		Make_Complex_Number( (Double) 0.0 ,
				     sqrt( - Get_Number_Real_Value(Top(1))) );
        }
	else
	{
		Make_Real_Number( sqrt (Get_Number_Real_Value(Top(1))) );
	}
}


 
Public void 
Fixnum_Exp (void)
{
	Promote(1, REAL_LEVEL);

	Make_Real_Number( exp (Get_Number_Real_Value(Top(1))) );
}


 
Public void 
Fixnum_Log (void)
{
	if(Get_Number_Fixnum_Value(Top(1)) <= 0 )
	{
		Error("Argument of log must be positive");
	}
		
	Promote(1, REAL_LEVEL);

	Make_Real_Number( log (Get_Number_Real_Value(Top(1))) );
}


 
Public void 
Fixnum_Expt (void)
{
	Push( Top(2) );
	Is_Number_Zero();
	Pop(1);

	if((Value_Register == The_True_Object) &&
		(Get_Number_Fixnum_Value(Top(1)) <  0))
	{
		Error("Domain error for expt");
	}
	else if (Get_Number_Fixnum_Value(Top(1)) >= 0 )
	{
		Integer index = Get_Number_Fixnum_Value( Top(1) );
		
		Make_Fixnum_Number( 1 );

		while (index--)
		{
			Push( Top(2) );
			Push( Value_Register );
			Number_Multiply();
			Pop(2);
		}
	}
	else
	{
		/* Negative Exponent */

		Promote(1, REAL_LEVEL);
		Promote(2, REAL_LEVEL);


		Make_Real_Number( pow (Get_Number_Real_Value(Top(2)),
					Get_Number_Real_Value(Top(1))) );

	}
}
 
Public void 
Fixnum_Sin (void)
{
	Promote(1, REAL_LEVEL);

	Make_Real_Number( sin (Get_Number_Real_Value(Top(1))) );
}


 
Public void 
Fixnum_Cos (void)
{
	Promote(1, REAL_LEVEL);

	Make_Real_Number( cos (Get_Number_Real_Value(Top(1))) );
}


 
Public void 
Fixnum_Tan (void)
{
	Promote(1, REAL_LEVEL);

	Make_Real_Number( tan (Get_Number_Real_Value(Top(1))) );
}


 
Public void 
Fixnum_Asin (void)
{
	if( (Get_Number_Fixnum_Value(Top(1)) < -1) ||
		(Get_Number_Fixnum_Value(Top(1)) > 1) )
	{
		Error("Argument to asin must lie between -1 and 1, inclusive");
	}
	 
	Promote(1, REAL_LEVEL);

	Make_Real_Number( asin (Get_Number_Real_Value(Top(1))) );
}


 
Public void 
Fixnum_Acos (void)
{
	if( (Get_Number_Fixnum_Value(Top(1)) < -1) ||
		(Get_Number_Fixnum_Value(Top(1)) > 1) )
	{
		Error("Argument to acos must lie between -1 and 1, inclusive");
	}
	 
	Promote(1, REAL_LEVEL);

	Make_Real_Number( acos (Get_Number_Real_Value(Top(1))) );
}


 
Public void 
Fixnum_Atan (void)
{
	Promote(1, REAL_LEVEL);

	Make_Real_Number( atan (Get_Number_Real_Value(Top(1))) );
}


 
Public void 
Fixnum_Atan2 (void)
{
	Promote(1, REAL_LEVEL);
	Promote(2, REAL_LEVEL);

	Make_Real_Number( atan2 (Get_Number_Real_Value(Top(2)), 
					Get_Number_Real_Value(Top(1))) );
}
 
/* Transfer functions */


Public void 
Fixnum_Exact_To_Inexact (void)
{
	Make_Real_Number( (double) Get_Number_Fixnum_Value( Top(1) ) );
}


 
Public void 
Fixnum_Inexact_To_Exact (void)
{
	Value_Register = Top(1);
}


 

Public void 
Fixnum_To_String (void)
{
	Character fixed_string[MAX_CHARS_PER_INT];
	Integer	radix = Number_To_Integer( Top(1) );
	Integer	value = Get_Number_Fixnum_Value( Top(2) );

	switch ( radix )
	{
	case 2:
	case 8:
	case 16:
		Make_Constant_String( 
		    Integer_To_Cstring( value , fixed_string , radix , 0 ) );
		return;
	case 10:
		sprintf(fixed_string, "%d", value );
		Make_Constant_String( fixed_string );
		return;
	default:
		Display_Error( "Unknown radix : " , Top(1) );
	}
}

Public void 
Fixnum_Make_Rectangular (void)
{
	Make_Complex_Number( (Double) Get_Number_Fixnum_Value(Top(2)),
			     (Double) Get_Number_Fixnum_Value(Top(1)));
}


 
Public void 
Fixnum_Make_Polar (void)
{
	Double	mag = Get_Number_Real_Value(Top(2));
	Double	ang = Get_Number_Real_Value(Top(1));

	Make_Complex_Number( (mag) * cos(ang) , (mag) * sin(ang) );
}



Public void 
Fixnum_Real_Part (void)
{
	Value_Register = Top(1);
}


 
Public void 
Fixnum_Imaginary_Part (void)
{
	Make_Fixnum_Number(0);
}


 
Public void 
Fixnum_Magnitude (void)
{
	Fixnum_Abs();
}

 

Public void 
Fixnum_Angle (void)
{
	Make_Fixnum_Number(0);
}
