Algol 68 Genie

a68g-conversion.c

     
   1  //! @file a68g-conversion.c
   2  //! @author J. Marcel van der Veer
   3  
   4  //! @section Copyright
   5  //!
   6  //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
   7  //! Copyright 2001-2024 J. Marcel van der Veer [algol68g@xs4all.nl].
   8  
   9  //! @section License
  10  //!
  11  //! This program is free software; you can redistribute it and/or modify it 
  12  //! under the terms of the GNU General Public License as published by the 
  13  //! Free Software Foundation; either version 3 of the License, or 
  14  //! (at your option) any later version.
  15  //!
  16  //! This program is distributed in the hope that it will be useful, but 
  17  //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
  18  //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
  19  //! more details. You should have received a copy of the GNU General Public 
  20  //! License along with this program. If not, see [http://www.gnu.org/licenses/].
  21  
  22  //! @section Synopsis
  23  //!
  24  //! Conversion tables for IEEE platforms.
  25  
  26  #include "a68g.h"
  27  #include "a68g-prelude.h"
  28  
  29  // A list of 10 ^ 2 ^ n for conversion purposes on IEEE 754 platforms.
  30  
  31  #if (A68_LEVEL >= 3)
  32  
  33  //! @brief 10 ** expo
  34  
  35  DOUBLE_T ten_up_double (int expo)
  36  {
  37    static DOUBLE_T pow_10_double[] = {
  38      10.0q, 100.0q, 1.0e4q, 1.0e8q, 1.0e16q, 1.0e32q, 1.0e64q, 1.0e128q, 1.0e256q, 1.0e512q, 1.0e1024q, 1.0e2048q, 1.0e4096q
  39    };
  40  // This appears sufficiently accurate.
  41    if (expo == 0) {
  42      return 1.0q;
  43    }
  44    BOOL_T neg_expo = (BOOL_T) (expo < 0);
  45    if (neg_expo) {
  46      expo = -expo;
  47    }
  48    if (expo > MAX_DOUBLE_EXPO) {
  49      expo = 0;
  50      errno = EDOM;
  51    }
  52    ABEND (expo > MAX_DOUBLE_EXPO, ERROR_INVALID_VALUE, __func__);
  53    DOUBLE_T dbl_expo = 1.0q;
  54    for (DOUBLE_T *dep = pow_10_double; expo != 0; expo >>= 1, dep++) {
  55      if (expo & 0x1) {
  56        dbl_expo *= *dep;
  57      }
  58    }
  59    return neg_expo ? 1.0q / dbl_expo : dbl_expo;
  60  }
  61  
  62  #endif
  63  
  64  //! @brief 10 ** expo
  65  
  66  REAL_T ten_up (int expo)
  67  {
  68    static REAL_T pow_10[] = {
  69      10.0, 100.0, 1.0e4, 1.0e8, 1.0e16, 1.0e32, 1.0e64, 1.0e128, 1.0e256
  70    };
  71  // This appears sufficiently accurate.
  72    BOOL_T neg_expo = (BOOL_T) (expo < 0);
  73    if (neg_expo) {
  74      expo = -expo;
  75    }
  76    ABEND (expo > MAX_REAL_EXPO, ERROR_INVALID_VALUE, __func__);
  77    REAL_T dbl_expo = 1.0;
  78    for (REAL_T *dep = pow_10; expo != 0; expo >>= 1, dep++) {
  79      if (expo & 0x1) {
  80        dbl_expo *= *dep;
  81      }
  82    }
  83    return neg_expo ? 1 / dbl_expo : dbl_expo;
  84  }