prelude-bits.c

     
   1  //! @file prelude-bits.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-2023 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  //! Multiple precision BITS.
  25  
  26  #include "a68g.h"
  27  
  28  #if (A68_LEVEL <= 2)
  29  
  30  #include "a68g-optimiser.h"
  31  #include "a68g-prelude.h"
  32  #include "a68g-transput.h"
  33  #include "a68g-mp.h"
  34  #include "a68g-parser.h"
  35  #include "a68g-physics.h"
  36  #include "a68g-double.h"
  37  
  38  #define A68_STD A68_TRUE
  39  #define A68_EXT A68_FALSE
  40  
  41  void stand_longlong_bits (void)
  42  {
  43    MOID_T *m;
  44  // LONG LONG BITS in software, vintage
  45    a68_mode (2, "BITS", &M_LONG_LONG_BITS);
  46  // REF LONG LONG BITS
  47    MODE (REF_LONG_LONG_BITS) = add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_BITS, NO_PACK);
  48  // [] LONG LONG BITS
  49    M_ROW_LONG_LONG_BITS = add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_LONG_LONG_BITS, NO_PACK);
  50    HAS_ROWS (M_ROW_LONG_LONG_BITS) = A68_TRUE;
  51    SLICE (M_ROW_LONG_LONG_BITS) = M_LONG_LONG_BITS;
  52  //
  53    a68_idf (A68_STD, "longlongbitswidth", M_INT, genie_long_mp_bits_width);
  54    a68_idf (A68_STD, "longlongmaxbits", M_LONG_LONG_BITS, genie_long_mp_max_bits);
  55  //
  56    m = a68_proc (M_LONG_LONG_BITS, M_ROW_BOOL, NO_MOID);
  57    a68_idf (A68_STD, "longlongbitspack", m, genie_long_bits_pack);
  58    A68C_DEFIO (longlongbits, long_mp_bits, LONG_LONG_BITS);
  59  //
  60    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  61    a68_op (A68_STD, "LENG", m, genie_idle);
  62    m = a68_proc (M_LONG_LONG_BITS, M_LONG_BITS, NO_MOID);
  63    a68_op (A68_STD, "LENG", m, genie_lengthen_mp_to_long_mp);
  64    m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_BITS, NO_MOID);
  65    a68_op (A68_STD, "ABS", m, genie_idle);
  66    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_INT, NO_MOID);
  67    a68_op (A68_STD, "BIN", m, genie_bin_mp);
  68    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  69    a68_op (A68_STD, "NOT", m, genie_not_mp);
  70    a68_op (A68_STD, "~", m, genie_not_mp);
  71    m = a68_proc (M_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  72    a68_op (A68_STD, "SHORTEN", m, genie_shorten_long_mp_to_mp);
  73    m = a68_proc (M_BOOL, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  74    a68_op (A68_STD, "=", m, genie_eq_mp);
  75    a68_op (A68_STD, "EQ", m, genie_eq_mp);
  76    a68_op (A68_STD, "/=", m, genie_ne_mp);
  77    a68_op (A68_STD, "~=", m, genie_ne_mp);
  78    a68_op (A68_STD, "^=", m, genie_ne_mp);
  79    a68_op (A68_STD, "NE", m, genie_ne_mp);
  80    a68_op (A68_STD, "<=", m, genie_le_mp);
  81    a68_op (A68_STD, "LE", m, genie_le_mp);
  82    a68_op (A68_STD, ">=", m, genie_ge_mp);
  83    a68_op (A68_STD, "GE", m, genie_ge_mp);
  84    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  85    a68_op (A68_STD, "AND", m, genie_and_mp);
  86    a68_op (A68_STD, "&", m, genie_and_mp);
  87    a68_op (A68_STD, "OR", m, genie_or_mp);
  88    a68_op (A68_EXT, "XOR", m, genie_xor_mp);
  89    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_INT, NO_MOID);
  90    a68_op (A68_STD, "SHL", m, genie_shl_mp);
  91    a68_op (A68_STD, "UP", m, genie_shl_mp);
  92    a68_op (A68_STD, "SHR", m, genie_shr_mp);
  93    a68_op (A68_STD, "DOWN", m, genie_shr_mp);
  94    m = a68_proc (M_BOOL, M_INT, M_LONG_LONG_BITS, NO_MOID);
  95    a68_op (A68_STD, "ELEM", m, genie_elem_long_mp_bits);
  96    m = a68_proc (M_LONG_LONG_BITS, M_INT, M_LONG_LONG_BITS, NO_MOID);
  97    a68_op (A68_STD, "SET", m, genie_set_long_mp_bits);
  98    a68_op (A68_STD, "CLEAR", m, genie_clear_long_mp_bits);
  99  }
 100  
 101  #endif