Beispiel #1
0
//## Complex Complex.ccos();
static KMETHOD Complex_ccos(KonohaContext *kctx, KonohaStack *sfp)
{
	kComplex *kc = (kComplex *) sfp[0].asObject;
	double _Complex z = kc->z;
	double ret = ccos(z);
	KReturnFloatValue(ret);
}
Beispiel #2
0
char *proobraz(char* input)
{
input = registr(input);

input=  ficha(input);
for (int i=0;i<strlen(input);i++)
    {
       ssin(i,input);
       ccos(i,input);
       aasin(i,input);
       aacos(i,input);
       aatan(i,input);
       cceil(i,input);
       cch(i,input);
       eexp(i,input);
       aabs(i,input);
       ffloor(i,input);
       lln(i,input);
       llog(i,input);
       ssh(i,input);
       ssqrt(i,input);
       ttan(i,input);
       tth(i,input);
       cctg(i,input);
	aactg(i,input);
	ccth(i,input);
    }
    return input;
}
Beispiel #3
0
//## Complex Complex.ccosl();
static KMETHOD Complex_ccosl(KonohaContext *kctx, KonohaStack *sfp)
{
	kComplex *kc = (kComplex *) sfp[0].asObject;
	long double _Complex zl = (long double _Complex)kc->z;
#if !defined(__CYGWIN__)
	long double ret = ccosl(zl);
#else
	long double ret = ccos(zl);
#endif
	KReturnFloatValue(ret);
}
Beispiel #4
0
int main()
{
    double complex v, z;
    double a = 0.0, b = 0.0;

    puts("Calculate the arc cosine of a complex number, cacos(z)\n");
    puts("Enter the real and imaginary parts of a complex number:");
    if (scanf("%lf %lf", &a, &b) == 2)
    {
        z = a + b * I;
        printf("z = %.2f %+.2f*I.\n", creal(z), cimag(z));

        v = cacos(z);
        printf("The cacos(z) function yields %.2f %+.2f*I.\n",
                creal(v), cimag(v));
        printf("The inverse function, ccos(cacos(z)), yields %.2f %+.2f*I.\n",
                creal(ccos(v)), cimag(ccos(v)));
    }
    else
        printf("Invalid input. \n");

    return 0;
}
Beispiel #5
0
int main() {
    _Complex double *c1, *c2, *sum, *prod, *c1csin, *c2csin, *c1ccos, *c2ccos;
    c1 = (_Complex double *) malloc (sizeof(_Complex double));
    c2 = (_Complex double *) malloc (sizeof(_Complex double));
    sum = (_Complex double *) malloc (sizeof(_Complex double));
    prod = (_Complex double *) malloc (sizeof(_Complex double));
    c1csin = (_Complex double *) malloc (sizeof(_Complex double));
    c2csin = (_Complex double *) malloc (sizeof(_Complex double));
    c1ccos = (_Complex double *) malloc (sizeof(_Complex double));
    c2ccos = (_Complex double *) malloc (sizeof(_Complex double));

    *c1 = 1.3 + 2.5i;
    *c2 = -2.7 + 0.3i;
    
    printf("c1 = %g + %gi\n", creal(*c1), cimag(*c1));
    printf("c2 = %g + %gi\n", creal(*c2), cimag(*c2));
    
    *sum = *c1 + *c2;
    *prod = *c1 * (*c2);
    
    printf("c1 + c2 = %g + %gi\n", creal(*sum), cimag(*sum));
    printf("c1 * c2 = %g + %gi\n", creal(*prod), cimag(*prod));
    
    *c1csin = csin(*c1);
    *c2csin = csin(*c1);
    
    printf("csin(c1) = %g + %gi\n", creal(*c1csin), cimag(*c1csin));
    printf("csin(c2) = %g + %gi\n", creal(*c1csin), cimag(*c1csin));

    *c1ccos = ccos(*c1);
    *c2ccos = ccos(*c1);
    
    printf("ccos(c1) = %g + %gi\n", creal(*c1ccos), cimag(*c1ccos));
    printf("ccos(c2) = %g + %gi\n", creal(*c1ccos), cimag(*c1ccos));
    
    return 0;
}
Beispiel #6
0
void
cmplx (double _Complex z)
{
  cabs (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 129 } */
  cacos (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 131 } */
  cacosh (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 133 } */
  carg (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 135 } */
  casin (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 137 } */
  casinh (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 139 } */
  catan (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 141 } */
  catanh (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 143 } */
  ccos (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 145 } */
  ccosh (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 147 } */
  cexp (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 149 } */
  cimag (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 151 } */
  clog (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 153 } */
  conj (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 155 } */
  cpow (z, z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 157 } */
  cproj (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 159 } */
  creal (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 161 } */
  csin (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 163 } */
  csinh (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 165 } */
  csqrt (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 167 } */
  ctan (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 169 } */
  ctanh (z); /* { dg-warning "incompatible implicit" } */
  /* { dg-message "include ..complex.h.." "" { target *-*-* } 171 } */
}
Beispiel #7
0
void test06 ( )

/******************************************************************************/
/*
  Purpose:

    TEST06: intrinsic functions for double complex variables.

  Licensing:

    This code is distributed under the GNU LGPL license.

  Modified:

    07 November 2010

  Author:

    John Burkardt
*/
{
    double complex a = {1.0 + 2.0 * I};

    printf ( "\n" );
    printf ( "TEST06\n" );
    printf ( "  Apply intrinsic functions to DOUBLE COMPLEX variables\n" );
    /*
      Print them.
    */
    printf ( "\n" );
    /*
      Note that "I" by itself is NOT a complex number, nor is it the
      imaginary unit.  You have to cast it to ( complex ) or ( double complex )
      or multiply it by a float or double before it results in a numerical
      result.
    */
    printf ( "  ( double complex ) I =  (%14.6g,%14.6g)\n", ( double complex ) I );
    printf ( "  a =                     (%14.6g,%14.6g)\n", a );
    printf ( "  - a =                   (%14.6g,%14.6g)\n", - a );
    printf ( "  a + 3 =                 (%14.6g,%14.6g)\n", a + 3 );
    printf ( "  a + (0,5) =             (%14.6g,%14.6g)\n", a + ( 0, 5 ) );
    printf ( "  4 * a =                 (%14.6g,%14.6g)\n", 4 * a );
    printf ( "  a / 8 =                 (%14.6g,%14.6g)\n", a / 8 );
    printf ( "  a * a =                 (%14.6g,%14.6g)\n", a * a );
    printf ( "  cpow ( a, 2 ) =         (%14.6g,%14.6g)\n", cpow ( a, 2 ) );
    printf ( "  cpow ( 2, a ) =         (%14.6g,%14.6g)\n", cpow ( 2, a ) );
    printf ( "  cpow ( a, a ) =         (%14.6g,%14.6g)\n", cpow ( a, a ) );
    printf ( "  1/a =                   (%14.6g,%14.6g)\n", 1.0 / a );
    printf ( "\n" );
    printf ( "  cabs(a) =                %14.6g\n",         cabs ( a ) );
    printf ( "  cacos(a) =              (%14.6g,%14.6g)\n", cacos ( a ) );
    printf ( "  cacosh(a) =             (%14.6g,%14.6g)\n", cacosh ( a ) );
    printf ( "  carg(a) =                %14.6g\n",         carg ( a ) );
    printf ( "  casin(a) =              (%14.6g,%14.6g)\n", casin ( a ) );
    printf ( "  casinh(a) =             (%14.6g,%14.6g)\n", casinh ( a ) );
    printf ( "  catan(a) =              (%14.6g,%14.6g)\n",
             creal ( catan ( a ) ), cimag ( catan ( a ) ) );
    printf ( "  catanh(a) =             (%14.6g,%14.6g)\n",
             creal ( catanh ( a ) ), cimag ( catanh ( a ) ) );
    printf ( "  ccos(a) =               (%14.6g,%14.6g)\n",
             creal ( ccos ( a ) ), cimag ( ccos ( a ) ) );
    printf ( "  ccosh(a) =              (%14.6g,%14.6g)\n",
             creal ( ccosh ( a ) ), cimag ( ccosh ( a ) ) );
    printf ( "  cexp(a) =               (%14.6g,%14.6g)\n",
             creal ( cexp ( a ) ), cimag ( cexp ( a ) ) );
    printf ( "  cimag(a) =               %14.6g\n",         cimag ( a ) );
    printf ( "  clog(a) =               (%14.6g,%14.6g)\n",
             creal ( clog ( a ) ), cimag ( clog ( a ) ) );
    printf ( "  (double complex)(1) =   (%14.6g,%14.6g)\n",
             creal ( ( double complex ) ( 1 ) ), cimag ( ( double complex ) ( 1 ) ) );
    printf ( "  (double complex)(4.0) = (%14.6g,%14.6g)\n",
             creal ( ( double complex ) ( 4.0 ) ), cimag ( ( double complex ) ( 4.0 ) ) );
    printf ( "  conj(a) =               (%14.6g,%14.6g)\n",
             creal ( conj ( a ) ), cimag ( conj ( a ) ) );
    printf ( "  cproj(a) =              (%14.6g,%14.6g)\n",
             creal ( cproj ( a ) ), cimag ( cproj ( a ) ) );
    printf ( "  creal(a) =               %14.6g\n",         creal ( a ) );
    printf ( "  csin(a) =               (%14.6g,%14.6g)\n",
             creal ( csin ( a ) ), cimag ( csin ( a ) ) );
    printf ( "  csinh(a) =              (%14.6g,%14.6g)\n",
             creal ( csinh ( a ) ), cimag ( csinh ( a ) ) );
    printf ( "  csqrt(a) =              (%14.6g,%14.6g)\n",
             creal ( csqrt ( a ) ), cimag ( csqrt ( a ) ) );
    printf ( "  ctan(a) =               (%14.6g,%14.6g)\n",
             creal ( ctan ( a ) ), cimag ( ctan ( a ) ) );
    printf ( "  ctanh(a) =              (%14.6g,%14.6g)\n",
             creal ( ctanh ( a ) ), cimag ( ctanh ( a ) ) );
    printf ( "  (int)(a) =               %10d\n",           ( int ) ( a ) );

    return;
}
Beispiel #8
0
static double complex ccosh(double complex z)
{
    return ccos(z * I); /* A&S 4.5.8 */
}
Beispiel #9
0
void
docomplex  (void)
{
#ifndef NO_DOUBLE
  complex double ca, cb, cc;
  double f1;

  ca = 1.0 + 1.0 * I;
  cb = 1.0 - 1.0 * I;

  f1 = cabs  (ca);
  fprintf (stdout, "cabs   : %f\n", f1);

  cc = cacos  (ca);
  fprintf (stdout, "cacos  : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = cacosh  (ca);
  fprintf (stdout, "cacosh : %f %fi\n", creal  (cc),
	   cimag  (cc));

  f1 = carg  (ca);
  fprintf (stdout, "carg   : %f\n", f1);

  cc = casin  (ca);
  fprintf (stdout, "casin  : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = casinh  (ca);
  fprintf (stdout, "casinh : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = catan  (ca);
  fprintf (stdout, "catan  : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = catanh  (ca);
  fprintf (stdout, "catanh : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = ccos  (ca);
  fprintf (stdout, "ccos   : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = ccosh  (ca);
  fprintf (stdout, "ccosh  : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = cexp  (ca);
  fprintf (stdout, "cexp   : %f %fi\n", creal  (cc),
	   cimag  (cc));

  f1 = cimag  (ca);
  fprintf (stdout, "cimag  : %f\n", f1);

  cc = clog  (ca);
  fprintf (stdout, "clog   : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = conj  (ca);
  fprintf (stdout, "conj   : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = cpow  (ca, cb);
  fprintf (stdout, "cpow   : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = cproj  (ca);
  fprintf (stdout, "cproj  : %f %fi\n", creal  (cc),
	   cimag  (cc));

  f1 = creal  (ca);
  fprintf (stdout, "creal  : %f\n", f1);

  cc = csin  (ca);
  fprintf (stdout, "csin   : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = csinh  (ca);
  fprintf (stdout, "csinh  : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = csqrt  (ca);
  fprintf (stdout, "csqrt  : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = ctan  (ca);
  fprintf (stdout, "ctan   : %f %fi\n", creal  (cc),
	   cimag  (cc));

  cc = ctanh  (ca);
  fprintf (stdout, "ctanh  : %f %fi\n", creal  (cc),
	   cimag  (cc));
#endif
}
void test2(double x, double y)
{
  if (-tan(x-y) != tan(y-x))
    link_error ();

  if (-sin(x-y) != sin(y-x))
    link_error ();

  if (cos(-x*y) != cos(x*y))
    link_error ();

  if (cos(x*-y) != cos(x*y))
    link_error ();

  if (cos(-x/y) != cos(x/y))
    link_error ();

  if (cos(x/-y) != cos(x/y))
    link_error ();

  if (cos(-fabs(tan(x/-y))) != cos(tan(x/y)))
    link_error ();

  if (cos(y<10 ? -x : y) != cos(y<10 ? x : y))
    link_error ();

  if (cos(y<10 ? x : -y) != cos(y<10 ? x : y))
    link_error ();

  if (cos(y<10 ? -fabs(x) : tan(x<20 ? -x : -fabs(y)))
      != cos(y<10 ? x : tan(x<20 ? x : y)))
    link_error ();

  if (cos((y*=3, -x)) != cos((y*=3,x)))
    link_error ();

  if (cos((y*=2, -fabs(tan(x/-y)))) != cos((y*=2,tan(x/y))))
    link_error ();

  if (cos(copysign(x,y)) != cos(x))
    link_error ();

  if (cos(copysign(-fabs(x),y*=2)) != cos((y*=2,x)))
    link_error ();

  if (hypot (x, 0) != fabs(x))
    link_error ();

  if (hypot (0, x) != fabs(x))
    link_error ();

  if (hypot (x, x) != fabs(x) * __builtin_sqrt(2))
    link_error ();

  if (hypot (-x, y) != hypot (x, y))
    link_error ();

  if (hypot (x, -y) != hypot (x, y))
    link_error ();

  if (hypot (-x, -y) != hypot (x, y))
    link_error ();

  if (hypot (fabs(x), y) != hypot (x, y))
    link_error ();

  if (hypot (x, fabs(y)) != hypot (x, y))
    link_error ();

  if (hypot (fabs(x), fabs(y)) != hypot (x, y))
    link_error ();

  if (hypot (-fabs(-x), -fabs(fabs(fabs(-y)))) != hypot (x, y))
    link_error ();

  if (hypot (-x, 0) != fabs(x))
    link_error ();

  if (hypot (-x, x) != fabs(x) * __builtin_sqrt(2))
    link_error ();

  if (hypot (pure(x), -pure(x)) != fabs(pure(x)) * __builtin_sqrt(2))
    link_error ();

  if (hypot (tan(-x), tan(-fabs(y))) != hypot (tan(x), tan(y)))
    link_error ();

  if (fmin (fmax(x,y),y) != y)
    link_error ();

  if (fmin (fmax(y,x),y) != y)
    link_error ();

  if (fmin (x,fmax(x,y)) != x)
    link_error ();
  
  if (fmin (x,fmax(y,x)) != x)
    link_error ();
  
  if (fmax (fmin(x,y),y) != y)
    link_error ();

  if (fmax (fmin(y,x),y) != y)
    link_error ();

  if (fmax (x,fmin(x,y)) != x)
    link_error ();
  
  if (fmax (x,fmin(y,x)) != x)
    link_error ();

  if ((__complex__ double) x != -(__complex__ double) (-x))
    link_error ();

  if (x*1i != -(-x*1i))
    link_error ();

  if (x+(x-y)*1i != -(-x+(y-x)*1i))
    link_error ();

  if (x+(x-y)*1i != -(-x-(x-y)*1i))
    link_error ();

  if (ccos(tan(x)+sin(y)*1i) != ccos(-tan(-x)+-sin(-y)*1i))
    link_error ();

  if (ccos(tan(x)+sin(x-y)*1i) != ccos(-tan(-x)-sin(y-x)*1i))
    link_error ();

  if (-5+x*1i != -~(5+x*1i))
    link_error ();

  if (tan(x)+tan(y)*1i != -~(tan(-x)+tan(y)*1i))
    link_error ();
}
void test3(__complex__ double x, __complex__ double y, int i)
{
  if (carg(x) != atan2(__imag__ x, __real__ x))
    link_error ();

  if (ccos(x) != ccos(-x))
    link_error();

  if (ccos(ctan(x)) != ccos(ctan(-x)))
    link_error();

  if (ctan(x-y) != -ctan(y-x))
    link_error();

  if (ccos(x/y) != ccos(-x/y))
    link_error();

  if (ccos(x/y) != ccos(x/-y))
    link_error();

  if (ccos(x/ctan(y)) != ccos(-x/ctan(-y)))
    link_error();

  if (ccos(x*y) != ccos(-x*y))
    link_error();

  if (ccos(x*y) != ccos(x*-y))
    link_error();

  if (ccos(ctan(x)*y) != ccos(ctan(-x)*-y))
    link_error();

  if (ccos(ctan(x/y)) != ccos(-ctan(x/-y)))
    link_error();

  if (ccos(i ? x : y) != ccos(i ? -x : y))
    link_error();

  if (ccos(i ? x : y) != ccos(i ? x : -y))
    link_error();

  if (ccos(i ? x : ctan(y/x)) != ccos(i ? -x : -ctan(-y/x)))
    link_error();

  if (~x != -~-x)
    link_error();

  if (ccos(~x) != ccos(-~-x))
    link_error();

  if (ctan(~(x-y)) != -ctan(~(y-x)))
    link_error();

  if (ctan(~(x/y)) != -ctan(~(x/-y)))
    link_error();
}
Beispiel #12
0
 long double complex ld = I;
 TEST_RESOLVED(MIPS, "http://ellcc.org/bugzilla/show_bug.cgi?id=59") {
 TEST_TRACE(C99 7.3.5.1)
     d = cacos(d);
     f = cacosf(f);
     ld = cacosl(ld);
     TEST_TRACE(C99 7.3.5.2)
     d = casin(d);
     f = casinf(f);
     ld = casinl(ld);
     TEST_TRACE(C99 7.3.5.3)
     d = catan(d);
     f = catanf(f);
     ld = catanl(ld);
     TEST_TRACE(C99 7.3.5.4)
     d = ccos(d);
     f = ccosf(f);
     ld = ccosl(ld);
     TEST_TRACE(C99 7.3.5.5)
     d = csin(d);
     f = csinf(f);
     ld = csinl(ld);
     TEST_TRACE(C99 7.3.5.6)
     d = ctan(d);
     f = ctanf(f);
     ld = ctanl(ld);
     TEST_TRACE(C99 7.3.6.1)
     d = cacosh(d);
     f = cacoshf(f);
     ld = cacoshl(ld);
     TEST_TRACE(C99 7.3.6.2)
Beispiel #13
0
CAMLprim value math_ccos(value x) {
  CAMLparam1(x);
  CAMLreturn(caml_copy_complex(ccos(Complex_val(x))));
}
Beispiel #14
0
 void z_cos(doublecomplex *r, doublecomplex *z)
 {
     double _Complex ret_val = ccos(z->r + I*z->i);
     r->r = creal(ret_val);
     r->i = cimag(ret_val);
 }
Beispiel #15
0
static status_t
uforth_execute_step(uforth_context_t *uf_ctx,
                    simulation_context_t *sc,
                    simulation_t *simulation,
                    uforth_heap_t *heap,
                    yana_complex_t *resultp,
                    int i)
{
    uforth_token_t *l_stack[16];
    int l_stack_pos = 0;
    status_t status = SUCCESS;
    uforth_token_t *token;
    yana_real_t r1, r2, r3;
    yana_complex_t c1, c2;
    yana_real_t f = sc?simulation_context_get_f(sc, i):0.L;
    int s = sc?simulation_context_get_n_samples(sc):0;
    uforth_token_type_t head_type;
    bool printed = false;
    bool end = false;
    bool free_heap = false;
    if ( NULL == heap )
    {
        free_heap = true;
        heap = uforth_heap_new();
    }
    for ( token = uf_ctx->first ;
            token && !end;
            token = token->next )
    {
        switch (token->type)
        {
        case UF_FREEAIR:
            POP_REAL("( x X -- x ) FREEAIR", r2);
            POP_REAL("( X x -- x ) FREEAIR", r1);
            PUSH_COMPLEX("FREEAIR", free_air_impedance(f, r1, r2));
            break;
        case UF_DIRIMP:
            POP_REAL("( x x X -- x ) FREEAIR", r3); // theta
            POP_REAL("( x X x -- x ) FREEAIR", r2); // r
            POP_REAL("( X x x -- x ) FREEAIR", r1); // Sd
            PUSH_COMPLEX("FREEAIR", free_air_dir_impedance(f, r2, r1, r3));
            break;
        case UF_MUL:
            POP_COMPLEX("( x X -- x ) MUL", c2);
            POP_COMPLEX("( X x -- x ) MUL", c1);
            PUSH_COMPLEX("MUL", c1*c2);
            break;
        case UF_DIV:
            POP_COMPLEX("( x X -- x ) DIV", c2);
            POP_COMPLEX("( X x -- x ) DIV", c1);
            PUSH_COMPLEX("DIV", c1/c2);
            break;
        case UF_ADD:
            POP_COMPLEX("( x X -- x ) ADD", c2);
            POP_COMPLEX("( X x -- x ) ADD", c1);
            PUSH_COMPLEX("ADD", c1+c2);
            break;
        case UF_SUB:
            POP_COMPLEX("( x X -- x ) SUB", c2);
            POP_COMPLEX("( X x -- x ) SUB", c1);
            PUSH_COMPLEX("SUB", c1-c2);
            break;
        case UF_NEG:
            POP_COMPLEX("( X -- x ) NEG", c1);
            PUSH_COMPLEX("NEG", -c1);
            break;
        case UF_EXP:
            POP_COMPLEX("( X -- x ) EXP", c1);
            PUSH_COMPLEX("EXP", cexp(c1));
            break;
        case UF_POW:
            POP_COMPLEX("( x X -- x ) POW", c2);
            POP_COMPLEX("( X x -- x ) POW", c1);
            PUSH_COMPLEX("POW", cpow(c1, c2));
            break;
        case UF_SQRT:
            POP_COMPLEX("( X -- x ) SQRT", c1);
            PUSH_COMPLEX("SQRT", csqrt(c1));
            break;
        case UF_LN:
            POP_COMPLEX("( X -- x ) LN", c1);
            PUSH_COMPLEX("LN", clog(c1));
            break;

        case UF_COS:
            POP_COMPLEX("( X -- x ) COS", c1);
            PUSH_COMPLEX("COS", ccos(c1));
            break;
        case UF_SIN:
            POP_COMPLEX("( X -- x ) SIN", c1);
            PUSH_COMPLEX("SIN", csin(c1));
            break;
        case UF_TAN:
            POP_COMPLEX("( X -- x ) TAN", c1);
            PUSH_COMPLEX("TAN", ctan(c1));
            break;
        case UF_ACOS:
            POP_COMPLEX("( X -- x ) ACOS", c1);
            PUSH_COMPLEX("ACOS", cacos(c1));
            break;
        case UF_ASIN:
            POP_COMPLEX("( X -- x ) ASIN", c1);
            PUSH_COMPLEX("ASIN", casin(c1));
            break;
        case UF_ATAN:
            POP_COMPLEX("( X -- x ) ATAN", c1);
            PUSH_COMPLEX("ATAN", catan(c1));
            break;
        case UF_LOG:
            POP_COMPLEX("( X -- x ) LOG", c1);
            PUSH_COMPLEX("LOG", clog10(c1));
            break;
        case UF_PAR:
            POP_COMPLEX("( x X -- x ) PAR", c2);
            POP_COMPLEX("( X x -- x ) PAR", c1);
            PUSH_COMPLEX("PAR", (c1*c2)/(c1+c2) );
            break;
        case UF_ABS:
            POP_COMPLEX("( X -- x ) ABS", c1);
            PUSH_REAL("ABS", cabs(c1));
            break;
        case UF_ARG:
            POP_COMPLEX("( X -- x ) ARG", c1);
            PUSH_REAL("ARG", carg(c1));
            break;
        case UF_DEG:
            POP_REAL("( X -- x ) DEG", r1);
            PUSH_REAL("DEG", 180. * r1 / M_PI );
            break;
        case UF_ANGLE:
            POP_REAL("( x X -- x ) ANGLE", r2);
            POP_REAL("( X x -- x ) ANGLE", r1);
            if ( fabs(r1-r2-2.*M_PI) > fabs(r1-r2) )
            {
                if ( fabs(r1-r2+2.*M_PI) > fabs(r1-r2) )
                    PUSH_REAL("ANGLE", r1-r2);
                else
                    PUSH_REAL("ANGLE", r1-r2+2.*M_PI);
            }
            else
            {
                if ( fabs(r1-r2+2.*M_PI) > fabs(r1-r2-2.*M_PI) )
                    PUSH_REAL("ANGLE", r1-r2-2.*M_PI);
                else
                    PUSH_REAL("ANGLE", r1-r2+2.*M_PI);
            }
            break;
        case UF_PDELAY:
            POP_REAL("( X -- x ) PDELAY", r1);
            PUSH_REAL("PDELAY",  - r1 /( 2. * M_PI * f ) );
            break;
        case UF_PREV_STEP:
            if ( 0 == i )
            {
                end = true;
                break;
            }
            --i;
            f = simulation_context_get_f(sc, i);
            break;
        case UF_NEXT_STEP:
            if ( s-1 == i )
            {
                end = true;
                break;
            }
            ++i;
            f = simulation_context_get_f(sc, i);
            break;
        case UF_IMAG:
            POP_COMPLEX("( X -- x ) IMAG", c1);
            PUSH_REAL("IMAG", cimag(c1));
            break;
        case UF_REAL:
            POP_COMPLEX("( X -- x ) REAL", c1);
            PUSH_REAL("REAL", creal(c1));
            break;
        case UF_PI:
            PUSH_REAL("PI", M_PI);
            break;
        case UF_RHO:
            PUSH_REAL("PI", YANA_RHO);
            break;
        case UF_C:
            PUSH_REAL("PI", YANA_C);
            break;
        case UF_MU:
            PUSH_REAL("PI", YANA_MU);
            break;
        case UF_F:
            PUSH_REAL("F", f);
            break;
        case UF_S:
            PUSH_REAL("F", i);
            break;
        case UF_I:
            PUSH_COMPLEX("I", 0. + I * 1.);
            break;
        case UF_DB:
            POP_COMPLEX("( X -- x ) DB", c1);
            PUSH_REAL("DB", 20. * log10(cabs(c1)));
            break;
        case UF_DBSPL:
            POP_COMPLEX("( X -- x ) DB", c1);
            PUSH_REAL("DB", 20. * log10(cabs(c1)/20e-6));
            break;
        case UF_DOT:
            HEAD_TYPE(head_type);
            if ( UF_VALUE_REAL == head_type )
            {
                POP_REAL("( X -- ) DOT", r1);
                fprintf(stdout, "%1.12g\t", (double)r1);
            }
            else if ( UF_VALUE_COMPLEX == head_type )
            {
                POP_COMPLEX("( X -- ) DOT", c1);
                fprintf(stdout, "%1.12g\t", (double)cabs(c1));
            }
            printed=true;
            break;
        case UF_DUP:
            POP_COMPLEX("( X -- x x ) DUP", c1);
            PUSH_COMPLEX("DUP", c1);
            PUSH_COMPLEX("DUP", c1);
            break;
        case UF_TO:
            token=token->next;
            if ( NULL == token )
            {
                ERROR("TO: end of instructions stream");
                status = FAILURE;
                goto loop_exit;
            }
            if ( token->type != UF_VALUE_SIMULATION )
            {
                ERROR("TO: %s is not a valid word to be set", token->symbol);
                status = FAILURE;
                goto loop_exit;
            }
            POP_COMPLEX("(X -- ) TO", c1);
            uforth_heap_set(heap, token->symbol, c1);
            break;
        case UF_SWAP:
            if ( uf_ctx->stack_pos < 2 )
            {
                ERROR("SWAP: Stack underflow");
                status = FAILURE;
                goto loop_exit;
            }
            token_swap(&uf_ctx->stack[uf_ctx->stack_pos-1],
                       &uf_ctx->stack[uf_ctx->stack_pos-2]);
            break;
        case UF_DROP:
            POP_COMPLEX("(X -- ) DROP", c1);
            break;
        case UF_IF:
            POP_COMPLEX("(X -- ) IF", c1);
            if ( 0. == c1 )
            {
                int depth=-1;
                uforth_token_t *orig_position = token;
                while ( ( token->type != UF_ELSE && token->type != UF_THEN ) || depth != 0 )
                {
                    if ( token->type == UF_IF ) ++depth;
                    if ( token->type == UF_THEN ) --depth;
                    token = token->next;
                    if ( NULL == token )
                    {
                        ERROR("IF: no matching ELSE or THEN found");
                        token = orig_position;
                        status = FAILURE;
                        goto loop_exit;
                    }
                }
            }
            break;
        case UF_ELSE:
        {
            int depth=0;
            uforth_token_t *orig_position = token;
            while ( token->type != UF_THEN || depth != 0 )
            {
                if ( token->type == UF_IF ) ++depth;
                if ( token->type == UF_THEN ) --depth;
                token = token->next;
                if ( NULL == token )
                {
                    ERROR("ELSE: no matching THEN found");
                    token = orig_position;
                    status = FAILURE;
                    goto loop_exit;
                }
            }
        }
        break;
        case UF_THEN:
            //noop
            break;
        case UF_BEGIN:
            L_PUSH(token);
            break;
        case UF_WHILE:
            POP_COMPLEX("(X -- ) WHILE", c1);
            if ( 0. == c1 )
            {
                L_DROP();
                int depth=0;
                uforth_token_t *orig_position = token;
                while ( token->type != UF_REPEAT || 0 != depth)
                {
                    if ( token->type == UF_BEGIN ) ++depth;
                    if ( token->type == UF_UNTIL ) --depth;
                    if ( token->type == UF_REPEAT ) --depth;
                    if ( token->type == UF_AGAIN ) --depth;
                    token=token->next;
                    if ( NULL == token )
                    {
                        ERROR("WHILE: no matching REPEAT found");
                        token = orig_position;
                        status = FAILURE;
                        goto loop_exit;
                    }
                }
            }
            break;
        case UF_REPEAT:
            L_HEAD(token);
            break;
        case UF_UNTIL:
            POP_COMPLEX("(X -- ) UNTIL", c1);
            if ( 0. == c1 )
                L_HEAD(token);
            else
                L_DROP();
            break;
        case UF_AGAIN:
            L_HEAD(token);
            break;
        case UF_LEAVE:
        {
            int depth = 0;
            L_DROP();
            uforth_token_t *orig_position = token;
            while ( ! ( ( token->type == UF_UNTIL ||
                          token->type == UF_REPEAT ||
                          token->type == UF_AGAIN ) && depth == 0 ) )
            {
                if ( token->type == UF_BEGIN ) ++depth;
                if ( token->type == UF_UNTIL ) --depth;
                if ( token->type == UF_REPEAT ) --depth;
                if ( token->type == UF_AGAIN ) --depth;
                token = token->next;
                if ( NULL == token )
                {
                    ERROR("LEAVE: no matching UNTIL|REPEAT|AGAIN found");
                    token = orig_position;
                    status = FAILURE;
                    goto loop_exit;
                }
            }
        }
        break;
        case UF_DEPTH:
            PUSH_REAL("DEPTH", uf_ctx->stack_pos);
            break;
        case UF_LT:
        case UF_LE:
        case UF_EQ:
        case UF_NE:
        case UF_GE:
        case UF_GT:
            POP_COMPLEX("(x X -- ) IF", c2);
            POP_COMPLEX("(X x -- ) IF", c1);
            if ( cimag(c1) != 0.L || cimag(c2) != 0.L )
            {
                ERROR("comparison between complex numbers");
                status = FAILURE;
                goto loop_exit;
            }
            r1=creal(c1);
            r2=creal(c2);
            PUSH_REAL("comparison",
                      UF_LT == token->type ? ( r1<r2)
                      : UF_LE == token->type ? (r1<=r2)
                      : UF_EQ == token->type ? (r1==r2)
                      : UF_NE == token->type ? (r1!=r2)
                      : UF_GE == token->type ? (r1>=r2)
                      : UF_GT == token->type ? (r1>r2)
                      : 0);
            break;
        case UF_VALUE_REAL:
            PUSH_REAL("real literal", token->r);
            break;
        case UF_VALUE_COMPLEX:
            assert(!"not possible");
            PUSH_REAL("complex literal", token->c);
            break;
        case UF_VALUE_SIMULATION:
        {
            yana_complex_t *sim_array;
            const uforth_token_t *heap_token = heap_token = uforth_heap_get(heap, token->symbol);
            if ( NULL != heap_token )
            {
                PUSH_COMPLEX("heap word", heap_token->c);
            }
            else
            {
                if ( token->symbol[0] != 'v'  &&  token->symbol[0] != 'I' )
                {
                    ERROR("Unknown symbol '%s'\n", token->symbol);
                    if ( sc )
                        HINT("dipoles start with 'I' and nodes start with 'v'");
                    status = FAILURE;
                    goto loop_exit;
                }
                sim_array = simulation_result(simulation, token->symbol+1);
                if ( NULL == sim_array )
                {
                    ERROR("Unknown symbol '%s'", token->symbol);
                    status = FAILURE;
                    goto loop_exit;
                }
                PUSH_COMPLEX("sim", sim_array[i]);
            }
        }
        break;
        }
    }
loop_exit:

    if (printed)
        fprintf(stdout, "\n");

    if ( SUCCESS != status && NULL != token )
    {
        fputs("ERROR: is here: ", stderr);
        uforth_token_t *t;
        for ( t = uf_ctx->first ;
                t != NULL ;
                t = t->next )
        {
            if ( t == token )
            {
                fprintf(stderr, ">>>%s<<<", t->symbol);
                break;
            }
            else
            {
                fprintf(stderr, "%s ", t->symbol);
            }
        }
        fputs("\n", stderr);
    }
    else if ( l_stack_pos != 0 )
    {
        ERROR("loop stack not empty at the end of the processing");
        status = FAILURE;
    }
    else if ( uf_ctx->stack_pos != 0 && NULL == resultp )
    {
        if ( !end )
            WARNING("stack not empty at the end of the processing");
        uf_ctx->stack_pos = 0;
    }

    if ( SUCCESS == status && NULL != resultp)
    {
        if ( uf_ctx->stack_pos != 1 )
        {
            ERROR("one result was expected and stack size is %d",
                  uf_ctx->stack_pos);
            status = FAILURE;
        }
        else
            POP_COMPLEX("RESULT", *resultp);
    }
    if ( free_heap )
        uforth_heap_free(heap);

    return status;
}
TEST(complex, ccos) {
  ASSERT_EQ(1.0, ccos(0));
}
Beispiel #17
0
long double complex ccosl(long double complex z)
{
	return ccos(z);
}