Example #1
0
static cl_fixnum
scale(float_approx *approx)
{
        cl_fixnum k = 0;
        cl_object x = ecl_plus(approx->r, approx->mp);
        int sign;
        do {
                sign = ecl_number_compare(x, approx->s);
                if (approx->high_ok) {
                        if (sign < 0)
                                break;
                } else {
                        if (sign <= 0)
                                break;
                }
                approx->s = ecl_times(approx->s, PRINT_BASE);
                k++;
        } while(1);
        do {
                x = ecl_times(x, PRINT_BASE);
                sign = ecl_number_compare(x, approx->s);
                if (approx->high_ok) {
                        if (sign >= 0)
                                break;
                } else {
                        if (sign > 0)
                                break;
                }
                k--;
                approx->r = ecl_times(approx->r, PRINT_BASE);
                approx->mm = ecl_times(approx->mm, PRINT_BASE);
                approx->mp = ecl_times(approx->mp, PRINT_BASE);
        } while(1);
        return k;
}
Example #2
0
/*	optimize speed 3, debug 3, space 0, safety 2                  */
static cl_object L1seq(cl_narg narg, ...)
{
 cl_object T0;
 struct ecl_ihs_frame ihs;
 const cl_object _ecl_debug_env = ECL_NIL;
 const cl_env_ptr cl_env_copy = ecl_process_env();
 cl_object value0;
 ecl_cs_check(cl_env_copy,value0);
 {
  cl_object V1;
  cl_object V2;
  cl_object V3;
  ecl_va_list args; ecl_va_start(args,narg,narg,0);
  {
   ecl_ihs_push(cl_env_copy,&ihs,VV[0],_ecl_debug_env);
   {
    cl_object keyvars[6];
    cl_parse_key(args,3,L1seqkeys,keyvars,NULL,FALSE);
    ecl_va_end(args);
    if (Null(keyvars[3])) {
     V1 = ecl_make_fixnum(0);
    } else {
     V1 = keyvars[0];
    }
    if (Null(keyvars[4])) {
     V2 = ecl_make_fixnum(10);
    } else {
     V2 = keyvars[1];
    }
    if (Null(keyvars[5])) {
     V3 = ecl_make_fixnum(1);
    } else {
     V3 = keyvars[2];
    }
   }
   {
    cl_object V4;                                 /*  I               */
    cl_object V5;
    cl_object V6;
    {
     T0 = cl_realp(V1);
     if (ecl_unlikely(!((T0)!=ECL_NIL)))
         FEwrong_type_argument(ECL_SYM("REAL",703),V1);
     V4 = V1;
    }
    {
     T0 = cl_realp(V2);
     if (ecl_unlikely(!((T0)!=ECL_NIL)))
         FEwrong_type_argument(ECL_SYM("REAL",703),V2);
     V5 = V2;
    }
    {
     T0 = cl_realp(V3);
     if (ecl_unlikely(!((T0)!=ECL_NIL)))
         FEwrong_type_argument(ECL_SYM("REAL",703),V3);
     V6 = V3;
    }
    {
     static const struct ecl_var_debug_info _ecl_descriptors[]={
     {"#:LOOP-STEP-BY1",_ecl_object_loc}
     ,{"#:LOOP-LIMIT0",_ecl_object_loc}
     ,{"COMMON-LISP-USER::I",_ecl_object_loc}};
     const cl_index _ecl_debug_info_raw[]={
     (cl_index)(_ecl_debug_env),(cl_index)(_ecl_descriptors),(cl_index)(&V6),(cl_index)(&V5),(cl_index)(&V4)};
     ecl_def_ct_vector(_ecl_debug_env,ecl_aet_index,_ecl_debug_info_raw,5,,);
     ihs.lex_env = _ecl_debug_env;
     {
      cl_object V7;
      cl_object V8;
      V7 = ecl_list1(ECL_NIL);
      V8 = V7;
      {
       static const struct ecl_var_debug_info _ecl_descriptors[]={
       {"#:LOOP-LIST-TAIL3",_ecl_object_loc}
       ,{"#:LOOP-LIST-HEAD2",_ecl_object_loc}};
       const cl_index _ecl_debug_info_raw[]={
       (cl_index)(_ecl_debug_env),(cl_index)(_ecl_descriptors),(cl_index)(&V8),(cl_index)(&V7)};
       ecl_def_ct_vector(_ecl_debug_env,ecl_aet_index,_ecl_debug_info_raw,4,,);
       ihs.lex_env = _ecl_debug_env;
L12:;
       if (!(ecl_number_compare(V4,V5)>0)) { goto L14; }
       goto L13;
L14:;
       T0 = V8;
       V8 = ecl_list1(V4);
       cl_rplacd(T0, V8);
       V4 = ecl_plus(V4,V6);
       goto L12;
L13:;
       value0 = ecl_cdr(V7);
       cl_env_copy->nvalues = 1;
       ecl_ihs_pop(cl_env_copy);
       return value0;
      }
      ihs.lex_env = _ecl_debug_env;
     }
    }
    ihs.lex_env = _ecl_debug_env;
   }
  }
 }
}