/*
================================================================================
  RPL/2 (R) version 4.0.24
  Copyright (C) 1989-2011 Dr. BERTRAND Joël

  This file is part of RPL/2.

  RPL/2 is free software; you can redistribute it and/or modify it
  under the terms of the CeCILL V2 License as published by the french
  CEA, CNRS and INRIA.
 
  RPL/2 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 CeCILL V2 License
  for more details.
 
  You should have received a copy of the CeCILL License
  along with RPL/2. If not, write to info@cecill.info.
================================================================================
*/


#include "rpl-conv.h"


/*
================================================================================
  Traitement des dépassements sur les additions entières
================================================================================
  Entrée :
	- les deux opérandes signées 
--------------------------------------------------------------------------------
  Sortie :
	- drapeau d'erreur
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

logical1
depassement_addition(integer8 *a, integer8 *b, integer8 *resultat)
{
	int							decalage;

	unsigned_integer8			ua;
	unsigned_integer8			ub;
	unsigned_integer8			unite;
	unsigned_integer8			ur;

	decalage = (sizeof(unsigned_integer8) * 8) - 1;

	if ((((*a) <= 0) && ((*b) >= 0)) ||
			(((*a) >= 0) && ((*b) <= 0)))
	{
		(*resultat) = (*a) + (*b);
		return(d_absence_erreur);
	}
	else
	{
		ua = abs((*a));
		ub = abs((*b));
		ur = ua + ub;
		unite = 1;

		if ((ur >= ua) && (ur <= ((unite << decalage) - 1)))
		{
			(*resultat) = (*a) + (*b);
			return(d_absence_erreur);
		}
		else
		{
			(*resultat) = 0;
			return(d_erreur);
		}
	}
}


/*
================================================================================
  Traitement des dépassements sur les multiplications entières
================================================================================
  Entrée :
	- les deux opérandes signées 
--------------------------------------------------------------------------------
  Sortie :
	- drapeau d'erreur
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

logical1
depassement_multiplication(integer8 *a, integer8 *b, integer8 *resultat)
{
	int							decalage;

	unsigned_integer8			limite;
	unsigned_integer8			lsba;
	unsigned_integer8			lsbb;
	unsigned_integer8			lsbr;
	unsigned_integer8			msba;
	unsigned_integer8			msbb;
	unsigned_integer8			msbr;
	unsigned_integer8			produit_croise;
	unsigned_integer8			ua;
	unsigned_integer8			ub;
	unsigned_integer8			unite;

	decalage = sizeof(unsigned_integer4) * 8;
	unite = 1;

	ua = abs((*a));
	ub = abs((*b));

	lsba = (ua << decalage) >> decalage;
	lsbb = (ub << decalage) >> decalage;
	msba = ua >> decalage;
	msbb = ub >> decalage;

	if ((msba != 0) && (msbb != 0))
	{
		(*resultat) = 0;
		return(d_erreur);
	}
	else
	{
		produit_croise = (limite = (msba * lsbb)) + (msbb * lsba);

		/*
		 * Traitement du débordement sur produit_croisé
		 */

		if (produit_croise < limite)
		{
			msbr = (msba * msbb) + (produit_croise >> decalage) +
					(unite << (decalage + 1));
		}
		else
		{
			msbr = (msba * msbb) + (produit_croise >> decalage);
		}

		if (msbr != 0)
		{
			(*resultat) = 0;
			return(d_erreur);
		}
		else
		{
			lsbr = (limite = (lsba * lsbb)) + (produit_croise << decalage);

			if ((lsbr >= limite) && (lsbr <= ((unite << ((2 * decalage) - 1))
					- 1)))
			{
				(*resultat) = (*a) * (*b);
				return(d_absence_erreur);
			}
			else
			{
				(*resultat) = 0;
				return(d_erreur);
			}
		}
	}
}


/*
================================================================================
  Traitement des dépassements sur les puissances entières a ** b
================================================================================
  Entrée :
	- a signé, b non signé.
--------------------------------------------------------------------------------
  Sortie :
	- drapeau d'erreur
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

logical1
depassement_puissance(integer8 *a, integer8 *b, integer8 *resultat)
{
	int							decalage;

	integer8					i;

	logical1					depassement;

	unsigned_integer8			r;
	unsigned_integer8			unite;

	if ((*b) < 0)
	{
		(*resultat) = 0;
		return(d_erreur);
	}

	if ((*a) <= 1)
	{
		if ((*a) == 0)
		{
			(*resultat) = 0;
		}
		else
		{
			(*resultat) = 1;
		}

		return(d_absence_erreur);
	}

	depassement = d_faux;
	r = abs(*a);

	for(i = 0; i < (*b); i++)
	{
		if (depassement_multiplication(&r, a, &r) == d_erreur)
		{
			depassement = d_vrai;
			break;
		}
	}

	if (depassement == d_vrai)
	{
		(*resultat) = 0;
		return(d_erreur);
	}
	else
	{
		decalage = (sizeof(unsigned_integer8) * 8) - 1;
		unite = 1;

		if (r <= ((unite << decalage) - 1))
		{
			f77puissanceii_(a, b, resultat);
			return(d_absence_erreur);
		}
		else
		{
			(*resultat) = 0;
			return(d_erreur);
		}
	}
}

// vim: ts=4