static char rcsid[] = "$Id: omniIntr.c,v 1.3 2003/09/17 17:58:30 msato Exp $";
/* 
 * $RWC_Release: Omni-1.6 $
 * $RWC_Copyright:
 *  Omni Compiler Software Version 1.5-1.6
 *  Copyright (C) 2002 PC Cluster Consortium
 *  
 *  This software is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU Lesser General Public License version
 *  2.1 published by the Free Software Foundation.
 *  
 *  Omni Compiler Software Version 1.0-1.4
 *  Copyright (C) 1999, 2000, 2001.
 *   Tsukuba Research Center, Real World Computing Partnership, Japan.
 *  
 *  Please check the Copyright and License information in the files named
 *  COPYRIGHT and LICENSE under the top  directory of the Omni Compiler
 *  Software release kit.
 *  
 *  
 *  $
 */
#include <stdio.h>
#include "f2c.h"

#ifdef NO_IEEEFP_H
# define isnand(x) isnan(x)
# define isnanf(x) isnan(((double)(x)))
#endif /* NO_IEEEFP_H */

#ifdef OMNI_OS_CYGWIN32
# define isnand(x) isnan(x)
# ifdef isnanf
#  undef isnanf
# endif /* isnanf */
#endif /* OMNI_OS_CYGWIN32 */

void
_to_str(dst, src, len)
     char *dst;
     char *src;
     int len;
{
    memcpy(dst, src, len);
    dst[len] = '\0';
}

void
_str_copy(dst, src, dstLen, srcLen)
     char *dst;
     char *src;
     int dstLen;
     int srcLen;
{
    int minLen = (dstLen > srcLen) ? srcLen : dstLen;
    (void)memcpy(dst, src, minLen);
    if (dstLen > minLen) {
	memset(dst + minLen, DEFAULT_UNINITED_CHAR, dstLen - minLen);
    }
}

/* NOTE: dst_len is the length of destination part! */
void
_str_subcopy(dst,dst_base,dst_len,dst_off,src,src_base,src_len)
    char *dst,*src;
    int dst_base,dst_len,dst_off,src_base,src_len;
{
    int fill_len;

    if (dst_len <= 0 || dst == NULL) return;

    fill_len = dst_len - dst_off;
    if (src == NULL) {		/* "fill the rest" mode */
	if (fill_len > 0)
	    (void)memset(dst+dst_base+dst_off, 
			 DEFAULT_UNINITED_CHAR, fill_len);
    } else {
	if(fill_len > src_len) fill_len = src_len;
	if(fill_len > 0)
	    (void)memcpy(dst+dst_base+dst_off, src + src_base, fill_len);
    }
}

/*
 * Complex basic runtime 
 */

#if 0
complex
C_const(re, im)
     float re;
     float im;
{
    complex c;
    c.r = re;
    c.i = im;
    return c;
}

doublecomplex
Z_const(re, im)
     double re;
     double im;
{
    doublecomplex z;
    z.r = re;
    z.i = im;
    return z;
}

complex
C_add(a, b)
     complex a;
     complex b;
{
    complex c;
    c.r = a.r + b.r;
    c.i = a.i + b.i;
    return c;
}

doublecomplex
Z_add(a, b)
     doublecomplex a;
     doublecomplex b;
{
    doublecomplex c;
    c.r = a.r + b.r;
    c.i = a.i + b.i;
    return c;
}

complex
C_sub(a, b)
     complex a;
     complex b;
{
    complex c;
    c.r = a.r - b.r;
    c.i = a.i - b.i;
    return c;
}

doublecomplex
Z_sub(a, b)
     doublecomplex a;
     doublecomplex b;
{
    doublecomplex c;
    c.r = a.r - b.r;
    c.i = a.i - b.i;
    return c;
}

complex
C_neg(a)
     complex a;
{
    complex c;
    c.r = -a.r;
    c.i = -a.i;
    return c;
}

doublecomplex
Z_neg(a)
     doublecomplex a;
{
    doublecomplex c;
    c.r = -a.r;
    c.i = -a.i;
    return c;
}

complex
C_mul(a, b)
     complex a;
     complex b;
{
    complex c;
    c.r = a.r*b.r - a.i*b.i;
    c.i = a.r*b.i + a.i*b.r;
    return c;
}

doublecomplex
Z_mul(a, b)
     doublecomplex a;
     doublecomplex b;
{
    doublecomplex c;
    c.r = a.r*b.r - a.i*b.i;
    c.i = a.r*b.i + a.i*b.r;
    return c;
}

complex
C_div(a, b)
     complex a;
     complex b;
{
    complex c;
    double d;

    d = b.r*b.r + b.i*b.i;
    c.r = (a.r*b.r+a.i*b.i)/d;
    c.i = (a.i*b.r-a.r*b.i)/d;
    return c;
}

doublecomplex
Z_div(a, b)
     doublecomplex a;
     doublecomplex b;
{
    doublecomplex c;
    double d;

    d = b.r*b.r + b.i*b.i;
    c.r = (a.r*b.r+a.i*b.i)/d;
    c.i = (a.i*b.r-a.r*b.i)/d;
    return c;
}
#endif


/*
 * complex power
 */
complex
C_pow_ci(c, i)
     complex c;
     integer i;
{
    complex ret;
    (void)pow_ci(&ret, &c, &i);
    return ret;
}

complex
C_pow_cd(c, d)
     complex c;
     doublereal d;
{
    complex ret;
    doublecomplex zRet, zA, zB;

    zA.r = (doublereal)c.r;
    zA.i = (doublereal)c.i;
    zB.r = d;
    zB.i = 0.0;
    (void)pow_zz(&zRet, &zA, &zB);
    ret.r = (real)zRet.r;
    ret.i = (real)zRet.i;

    return ret;
}

complex
C_pow_ic(i, c)
     integer i;
     complex c;
{
    complex ret;
    doublecomplex zRet, zA, zB;

    zA.r = (doublereal)i;
    zA.i = 0.0;
    zB.r = (doublereal)c.r;
    zB.i = (doublereal)c.i;
    (void)pow_zz(&zRet, &zA, &zB);
    ret.r = (real)zRet.r;
    ret.i = (real)zRet.i;

    return ret;
}

complex
C_pow_dc(d, c)
     doublereal d;
     complex c;
{
    complex ret;
    doublecomplex zRet, zA, zB;

    zA.r = d;
    zA.i = 0.0;
    zB.r = (doublereal)c.r;
    zB.i = (doublereal)c.i;
    (void)pow_zz(&zRet, &zA, &zB);
    ret.r = (real)zRet.r;
    ret.i = (real)zRet.i;

    return ret;
}


doublecomplex
Z_pow_zi(z, i)
     doublecomplex z;
     integer i;
{
    doublecomplex ret;
    (void)pow_zi(&ret, &z, &i);
    return ret;
}

doublecomplex
Z_pow_zd(z, d)
     doublecomplex z;
     doublereal d;
{
    doublecomplex zRet, zB;

    zB.r = d;
    zB.i = 0.0;
    (void)pow_zz(&zRet, &z, &zB);

    return zRet;
}

doublecomplex
Z_pow_iz(i, z)
     integer i;
     doublecomplex z;
{
    doublecomplex zRet, zA;

    zA.r = (doublereal)i;
    zA.i = 0.0;
    (void)pow_zz(&zRet, &zA, &z);

    return zRet;
}

doublecomplex
Z_pow_dz(d, z)
     doublereal d;
     doublecomplex z;
{
    doublecomplex zRet, zA;

    zA.r = d;
    zA.i = 0.0;
    (void)pow_zz(&zRet, &zA, &z);

    return zRet;
}


doublecomplex
Z_pow_cz(c, z)
     complex c;
     doublecomplex z;
{
    doublecomplex zRet, zA;

    zA.r = (doublereal)c.r;
    zA.i = (doublereal)c.i;
    (void)pow_zz(&zRet, &zA, &z);
    
    return zRet;
}

doublecomplex
Z_pow_zc(z, c)
     doublecomplex z;
     complex c;
{
    doublecomplex zRet, zB;

    zB.r = (doublereal)c.r;
    zB.i = (doublereal)c.i;
    (void)pow_zz(&zRet, &z, &zB);
    
    return zRet;
}

complex
C_pow_cc(cA, cB)
     complex cA;
     complex cB;
{
    complex ret;
    doublecomplex zRet, zA, zB;

    zA.r = (doublereal)cA.r;
    zA.i = (doublereal)cA.i;
    zB.r = (doublereal)cB.r;
    zB.i = (doublereal)cB.i;
    (void)pow_zz(&zRet, &zA, &zB);
    ret.r = (real)zRet.r;
    ret.i = (real)zRet.i;

    return ret;
}

doublecomplex
Z_pow_zz(zA, zB)
     doublecomplex zA;
     doublecomplex zB;
{
    doublecomplex zRet;
    (void)pow_zz(&zRet, &zA, &zB);
    return zRet;
}


char *
i2c(retval, i)
     char *retval;
     int i;
{
    *retval = i % 256;
    return retval;
}


int
c2i(c, len)
     char *c;
     int len;
{
    return c[0];
}


void
#ifdef KR_headers
__checkNaN_real(val, fileName, lineNo, genCore)
     real val;
     char *fileName;
     int lineNo;
     int genCore;
#else
__checkNaN_real(real val, char *fileName, int lineNo, int genCore)
#endif /* KR_headers */
{
    if (isnanf((float)val) != 0) {
	fprintf(stderr, "float NaN at file '%s' line %d.\n",
		fileName, lineNo);
	if (genCore == 1) {
	    abort();
	}
    }
}


void
__checkNaN_dreal(val, fileName, lineNo, genCore)
     doublereal val;
     char *fileName;
     int lineNo;
     int genCore;
{
    if (isnand((double)val) != 0) {
	fprintf(stderr, "double NaN at file '%s' line %d.\n",
		fileName, lineNo);
	if (genCore == 1) {
	    abort();
	}
    }
}

void
__abort_ASGOTO()
{
    fprintf(stderr,"bad assigned GOTO, abort!\n");
    abort();
}