#ifdef DEBUGOPS
#include <stdio.h>
#endif
/*
 *	High Precision Math Library
 *
 *	Written by Dave Barrett					2/23/83
 *	Translated from modcal to pascal			4/30/84
 *	Mod portability fixed; removed floor function		5/14/84
 *	Fixed numerous bugs and improved robustness		5/21/84
 *	Translated to C						6/14/84
 *	Changed precision to be determined at run-time		5/19/85
 *	Added dynamic allocation				7/21/85
 *	Combined unsigned math and integer math			8/01/85
 *	Fixed Bug in pcmp					7/20/87 
 *	Fixed handling of dynamic storage (refcount added)	7/20/87
 *	Final debugging of current version             		8/22/87
 *	Fixed many bugs in various routines, wrote atop		2/07/89
 *	Tuned for speed, fixed overflow problems		3/01/89
 *	Removed refcounts, more tuning, removed pcreate		3/16/89
 *	Added cmp macros, change name of pzero, added pshift	4/29/89
 *	Repaired operation order bugs in pdiv, calc.c		5/15/91
 *      Added pdiv macro, split out pcmp, pabs, much cleanup	5/21/91
 *
 *	warning! The mod operation with negative arguments not portable.
 *		 I have therefore avoided it completely with much pain.
 *	
 *	The following identities have proven useful:
 *
 *	given:	a %  b = a - floor(a/b) * b
 *	then : -a % -b = -(a % b)
 *	       -a %  b = -( a % -b) = b - a % b (a % b != 0)
 *		a % -b = -(-a % b) = a % b - b	(a % b != 0)
 *
 *	given:	a %  b =  a - a / b * b
 *	then : -a % -b = -a % b = -(a % b)
 *		a % -b =  a % b
 *
 *	Also, be very careful of computations in the inner loops.  Much
 *	work has been done to make sure the compiler does not re-arrange
 *	expressions to cause an overflow. The compiler may still be doing
 *	unnecessary type conversions.
 *  
 * NOTES:
 *
 *	The ptoa routine creates storage which is likely to be forgotton.
 *
 *	A function returning a result must use the result.  If it doesn't
 *	the storage is never freed.  For example: itop(2); by itself
 *	You must make sure to pdestroy the result.
 *
 *	An error (out of storage) fails to deallocate u and v.
 *
 *	psub, pcmp, pdiv, and pmul all assume normalized arguments.
 *
 * This file contains the storage management-specific code:
 *     palloc, pfree, pset -- together these account for 45% of execution time
 */
#include <string.h>
#include "pdefs.h"	/* private include file */
#include "precision.h"	/* public include file for forward refs */

cacheType pcache[CACHESIZE];
static char ident[] = 
   " @(#) libprecision.a version 2.00  3-May-91 by Dave Barrett\n";

/*
 * normalize (used by div and sub)
 *   remove all leading zero's 
 *   force positive sign if result is zero
 */
void pnorm(u)
   register precision u;
{
   register digitPtr uPtr;

   uPtr = u->value + u->size;
   do {
      if (*--uPtr != 0) break;
   } while (uPtr > u->value);

   if (uPtr == u->value && *uPtr == 0) u->sign = false;

   u->size = (uPtr - u->value) + 1;		/* normalize */
}

/*
 * Create a number with the given size (private) (very heavily used)
 */
precision palloc(size)
   register posit size;
{
   register precision w;
   register cacheType *kludge = pcache + size;	/* for shitty compilers */

#if !(defined(NOMEMOPT) || defined(BWGC))
   if (size < CACHESIZE && (w = kludge->next) != pUndef) {
      kludge->next = ((cacheType *) w)->next;
      --kludge->count;
   } else {
#endif
      w = (precision) allocate(PrecisionSize + sizeof(digit) * size);
      if (w == pUndef)  {
	 w = errorp(PNOMEM, "palloc", "out of memory");
	 return w;
      }
#if !(defined(NOMEMOPT) || defined(BWGC))
   }
#endif
#ifndef BWGC
   w->refcount = 1;
#endif
   w->size     = w->alloc = size;
#ifdef DEBUGOPS
   printf("alloc %.8x\n", w); 
   fflush(stdout);
#endif
   return w;
}

/*
 * (Very heavily used: Called conditionally pdestroy)
 * (should be void, but some compilers can't handle it with the macro)
 */
int pfree(u)
   register precision u;
{
   register posit size;
   register cacheType *kludge; 	/* for shitty compilers */

#ifdef DEBUGOPS
   printf("free  %.8x\n", u); 
   fflush(stdout);
#endif

   size = u->alloc;

   kludge = pcache + size;
#if !(defined(NOMEMOPT) || defined(BWGC))
   if (size < CACHESIZE && kludge->count < CACHELIMIT) {
      ((cacheType *) u)->next = kludge->next;
      kludge->next = u;
      kludge->count++;
   } else {
#endif
      deallocate(u);
#if !(defined(NOMEMOPT) || defined(BWGC))
   }
#endif
   return 0;
}

/*
 * User inteface:
 *
 * Rules:
 *    a precision must be initialized to pUndef or to result of pnew.
 *    a precision pointer must point to a precision or be pNull
 *    pUndef may not be passed as an rvalue into a function
 *    pNull  may not be passed as an lvalue into a function
 *   
 *    presult and pdestroy are the only functions which may be passed pUndef
 */

/*
 * assignment with verification (slower, but helpful for bug detect)
 * It would be nice if this routine could detect pointers to incorrect
 * or non-living areas of memory.
 *
 * We can't check for undefined rvalue because we want to allow functions
 * to return pUndef, and then let the application check for it after assigning
 * it to a variable.
 *
 * usage: pset(&i, j);
 */
precision psetv(up, v)
   register precision *up, v;
{
   register precision u;

#ifdef DEBUGOPS
   printf("psetv %.8x %.8x ", up, v);
#endif
#ifdef DEBUGOPS
#ifndef BWGC
   printf("->%u", v->refcount);
#endif
#endif
   if (up == pNull) {
      errorp(PDOMAIN, "pset", "lvalue is pNull");
   }
   u = *up;
#ifdef DEBUGOPS
   printf(" %.8x", u);
#endif
   *up = v;
   if (v != pUndef) {
#ifndef BWGC
      v->refcount++;
#endif
   }
   if (u != pUndef) { 
      if (u->sign & ~1) {		/* a minimal check */
	 errorp(PDOMAIN, "pset", "invalid precision");
      }
#ifndef BWGC
      if (--(u->refcount) == 0) {
#ifdef DEBUGOPS
	 printf("->%u", u->refcount);
#endif
	 pfree(u);
      }
#endif
   }
#ifdef DEBUGOPS
   putchar('\n');
   fflush(stdout);
#endif
   return v;
}

precision pparmv(u)
   register precision u;
{
#ifdef DEBUGOPS
   printf("pparm %.8x\n", u);
   fflush(stdout);
#endif
   if (u == pUndef) {
      errorp(PDOMAIN, "pparm", "undefined function argument");
   }
   if (u->sign & ~1) {		/* a minimal check */
      errorp(PDOMAIN, "pparm", "invalid precision");
   }
#ifndef BWGC
   u->refcount++;
#endif
   return u;
}

/*
 * Function version of unsafe pparmq macro
 */
precision pparmf(u)
   register precision u;
{
#ifndef BWGC
   if (u != pUndef) {
      u->refcount++;
   }
#endif
   return u;
}

/*
 * Function version of pdestroy macro
 */
void pdestroyf(u)
   register precision u;
{
#ifndef BWGC
   if (u != pUndef && --u->refcount == 0) {
      pfree(u);
   }
#endif
}

/* LLVM - No inlining */
//#ifndef __GNUC__		/* inline in header file */
/*
 * We cannot allow this to be a macro because of the probability that it's
 * argument will be a function (e.g. utop(2))
 */
precision pnew(u) 
   register precision u;
{
#ifndef BWGC
   u->refcount++;
#endif
   return u;
}

/*
 * Cannot be a macro because of function argument possibility
 */
precision presult(u)
   register precision u;
{
#ifndef BWGC
   if (u != pUndef) {
      --(u->refcount);
   }
#endif
   return u;
}

/*
 * Quick but dangerous assignment
 *
 * Assumes: target not pNull and source not pUndef
 */
precision psetq(up, v) 
   register precision *up, v;
{
   register precision u = *up;		/* up may NOT be pNULL! */

   *up = v;				/* up may be &v, OK */
#ifndef BWGC
   if (v != pUndef) { 		/* to allow:  x=func(); if (x==pUndef) ... */
      v->refcount++;
   }
   if (u != pUndef && --(u->refcount) == 0) {
      pfree(u);
   }
#endif
   return v;
}
/* LLVM - No Inlining */
//#endif

#if 0			/* original assignment code */
precision pset(up, v)
   register precision *up, v;
{
   register precision u;

#ifndef BWGC
   if (v != pUndef) v->refcount++;
#endif
   if (up == pNull) {		/* useful voiding parameters (pdiv) */
      pdestroy(v);
      return pUndef;
   }
   u = *up;
   if (u != pUndef) {		/* useful to force initial creation */
      pdestroy(u);
   }
   *up = v;		/* notice that v may be pUndef which is OK! */
   return v;			  /* no presult! This is a variable */
}
#endif