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-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  //! 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  // LONG LONG BITS in software, vintage
  44    a68_mode (2, "BITS", &M_LONG_LONG_BITS);
  45  // REF LONG LONG BITS
  46    MODE (REF_LONG_LONG_BITS) = add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_BITS, NO_PACK);
  47  // [] LONG LONG BITS
  48    M_ROW_LONG_LONG_BITS = add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_LONG_LONG_BITS, NO_PACK);
  49    HAS_ROWS (M_ROW_LONG_LONG_BITS) = A68_TRUE;
  50    SLICE (M_ROW_LONG_LONG_BITS) = M_LONG_LONG_BITS;
  51    a68_idf (A68_STD, "longlongbitswidth", M_INT, genie_long_mp_bits_width);
  52    a68_idf (A68_STD, "longlongmaxbits", M_LONG_LONG_BITS, genie_long_mp_max_bits);
  53    MOID_T *m = a68_proc (M_LONG_LONG_BITS, M_ROW_BOOL, NO_MOID);
  54    a68_idf (A68_STD, "longlongbitspack", m, genie_long_bits_pack);
  55    A68C_DEFIO (longlongbits, long_mp_bits, LONG_LONG_BITS);
  56    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  57    a68_op (A68_STD, "LENG", m, genie_idle);
  58    m = a68_proc (M_LONG_LONG_BITS, M_LONG_BITS, NO_MOID);
  59    a68_op (A68_STD, "LENG", m, genie_lengthen_mp_to_long_mp);
  60    m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_BITS, NO_MOID);
  61    a68_op (A68_STD, "ABS", m, genie_idle);
  62    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_INT, NO_MOID);
  63    a68_op (A68_STD, "BIN", m, genie_bin_mp);
  64    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  65    a68_op (A68_STD, "NOT", m, genie_not_mp);
  66    a68_op (A68_STD, "~", m, genie_not_mp);
  67    m = a68_proc (M_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  68    a68_op (A68_STD, "SHORTEN", m, genie_shorten_long_mp_to_mp);
  69    m = a68_proc (M_BOOL, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  70    a68_op (A68_STD, "=", m, genie_eq_mp);
  71    a68_op (A68_STD, "EQ", m, genie_eq_mp);
  72    a68_op (A68_STD, "/=", m, genie_ne_mp);
  73    a68_op (A68_STD, "~=", m, genie_ne_mp);
  74    a68_op (A68_STD, "^=", m, genie_ne_mp);
  75    a68_op (A68_STD, "NE", m, genie_ne_mp);
  76    a68_op (A68_STD, "<=", m, genie_le_mp);
  77    a68_op (A68_STD, "LE", m, genie_le_mp);
  78    a68_op (A68_STD, ">=", m, genie_ge_mp);
  79    a68_op (A68_STD, "GE", m, genie_ge_mp);
  80    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
  81    a68_op (A68_STD, "AND", m, genie_and_mp);
  82    a68_op (A68_STD, "&", m, genie_and_mp);
  83    a68_op (A68_STD, "OR", m, genie_or_mp);
  84    a68_op (A68_EXT, "XOR", m, genie_xor_mp);
  85    m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_INT, NO_MOID);
  86    a68_op (A68_STD, "SHL", m, genie_shl_mp);
  87    a68_op (A68_STD, "UP", m, genie_shl_mp);
  88    a68_op (A68_STD, "SHR", m, genie_shr_mp);
  89    a68_op (A68_STD, "DOWN", m, genie_shr_mp);
  90    m = a68_proc (M_BOOL, M_INT, M_LONG_LONG_BITS, NO_MOID);
  91    a68_op (A68_STD, "ELEM", m, genie_elem_long_mp_bits);
  92    m = a68_proc (M_LONG_LONG_BITS, M_INT, M_LONG_LONG_BITS, NO_MOID);
  93    a68_op (A68_STD, "SET", m, genie_set_long_mp_bits);
  94    a68_op (A68_STD, "CLEAR", m, genie_clear_long_mp_bits);
  95  }
  96  
  97  #endif