a68g-mem.c

     
   1  //! @file a68g-mem.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  //! Low-level memory management.
  25  
  26  #include "a68g.h"
  27  #include "a68g-prelude.h"
  28  #include "a68g-mp.h"
  29  #include "a68g-genie.h"
  30  
  31  //! @brief Initialise C and A68 heap management.
  32  
  33  void init_heap (void)
  34  {
  35    unt heap_a_size = A68_ALIGN (A68 (heap_size));
  36    unt handle_a_size = A68_ALIGN (A68 (handle_pool_size));
  37    unt frame_a_size = A68_ALIGN (A68 (frame_stack_size));
  38    unt expr_a_size = A68_ALIGN (A68 (expr_stack_size));
  39    BYTE_T *core;
  40    A68_HEAP = NO_BYTE;
  41    A68_HANDLES = NO_BYTE;
  42    A68_STACK = NO_BYTE;
  43    A68_SP = 0;
  44    A68_FP = 0;
  45    A68_HP = 0;
  46    A68_GLOBALS = 0;
  47    REAL_T /* sic */ total_size = A68_ALIGN (heap_a_size + handle_a_size + frame_a_size + 2 * expr_a_size);
  48    ABEND (OVER_2G (total_size), ERROR_OUT_OF_CORE_2G, __func__);
  49    errno = 0;
  50    core = (BYTE_T *) (A68_ALIGN_T *) a68_alloc ((size_t) total_size, __func__, __LINE__);
  51    ABEND (core == NO_BYTE, ERROR_OUT_OF_CORE, __func__);
  52    A68_HEAP = &(core[0]);
  53    A68_HANDLES = &(A68_HEAP[heap_a_size]);
  54    A68_STACK = &(A68_HANDLES[handle_a_size]);
  55    A68 (fixed_heap_pointer) = A68_ALIGNMENT;
  56    A68 (temp_heap_pointer) = total_size;
  57    A68 (frame_start) = 0;
  58    A68 (frame_end) = A68 (stack_start) = A68 (frame_start) + frame_a_size;
  59    A68 (stack_end) = A68 (stack_start) + expr_a_size;
  60    ABEND (errno != 0, ERROR_ALLOCATION, __func__);
  61  }
  62  
  63  //! @brief aligned allocation.
  64  
  65  void *a68_alloc (size_t len, const char *f, int line)
  66  {
  67  // We need this since malloc aligns to "standard C types".
  68  // __float128 is not a standard type, apparently ...
  69  // Huge chunks cause trouble!
  70    ABEND (len >= 2 * GIGABYTE, ERROR_OUT_OF_CORE, __func__);   
  71    if (len > 0) {
  72      void *p = NULL;
  73      int save = errno;
  74      size_t align = sizeof (A68_ALIGN_T);
  75      errno = 0;
  76  #if defined (BUILD_WIN32)
  77      p = _aligned_malloc (len, align);
  78  #elif defined (HAVE_POSIX_MEMALIGN)
  79      errno = posix_memalign (&p, align, len);
  80      if (errno != 0) {
  81        p = NULL;
  82      }
  83  #elif defined (HAVE_ALIGNED_ALLOC)
  84  // Glibc version of posix_memalign.
  85      if (align < sizeof (void *)) {
  86        errno = EINVAL;
  87      } else {
  88        p = aligned_alloc (align, len);
  89      }
  90  #else
  91  // Aude audenda.
  92      p = malloc (len);
  93  #endif
  94      if (p == (void *) NULL || errno != 0) {
  95        static BUFFER msg;
  96        snprintf (msg, SNPRINTF_SIZE, "cannot allocate %lu bytes; called from function %s, line %d", (long unt) len, f, line);
  97        ABEND (A68_TRUE, ERROR_ALLOCATION, msg);
  98      }
  99      errno = save;
 100      return p;
 101    } else {
 102      return (void *) NULL;
 103    }
 104  }
 105  
 106  void a68_free (void *z)
 107  {
 108    if (z != NULL) {
 109  #if defined (BUILD_WIN32)
 110  // On WIN32, free cannot deallocate _aligned_malloc
 111      _aligned_free (z);
 112  #else
 113      free (z);
 114  #endif
 115    }
 116  }
 117  
 118  //! @brief Give pointer to block of "s" bytes.
 119  
 120  BYTE_T *get_heap_space (size_t s)
 121  {
 122    BYTE_T *z;
 123    ABEND (s == 0, ERROR_INVALID_SIZE, __func__);
 124    z = (BYTE_T *) (A68_ALIGN_T *) a68_alloc (A68_ALIGN (s), __func__, __LINE__);
 125    ABEND (z == NO_BYTE, ERROR_OUT_OF_CORE, __func__);
 126    return z;
 127  }
 128  
 129  //! @brief Make a new copy of concatenated strings.
 130  
 131  char *new_string (char *t, ...)
 132  {
 133    va_list vl;
 134    char *q, *z;
 135    int len = 0;
 136    va_start (vl, t);
 137    q = t;
 138    if (q == NO_TEXT) {
 139      va_end (vl);
 140      return NO_TEXT;
 141    }
 142    while (q != NO_TEXT) {
 143      len += (int) strlen (q);
 144      q = va_arg (vl, char *);
 145    }
 146    va_end (vl);
 147    len++;
 148    z = (char *) get_heap_space ((size_t) len);
 149    z[0] = NULL_CHAR;
 150    q = t;
 151    va_start (vl, t);
 152    while (q != NO_TEXT) {
 153      bufcat (z, q, len);
 154      q = va_arg (vl, char *);
 155    }
 156    va_end (vl);
 157    return z;
 158  }
 159  
 160  //! @brief Make a new copy of "t".
 161  
 162  char *new_fixed_string (char *t)
 163  {
 164    int n = (int) (strlen (t) + 1);
 165    char *z = (char *) get_fixed_heap_space ((size_t) n);
 166    bufcpy (z, t, n);
 167    return z;
 168  }
 169  
 170  //! @brief Make a new copy of "t".
 171  
 172  char *new_temp_string (char *t)
 173  {
 174    int n = (int) (strlen (t) + 1);
 175    char *z = (char *) get_temp_heap_space ((size_t) n);
 176    bufcpy (z, t, n);
 177    return z;
 178  }
 179  
 180  //! @brief Get (preferably fixed) heap space.
 181  
 182  BYTE_T *get_fixed_heap_space (size_t s)
 183  {
 184    BYTE_T *z;
 185    if (A68 (heap_is_fluid)) {
 186      z = HEAP_ADDRESS (A68 (fixed_heap_pointer));
 187      A68 (fixed_heap_pointer) += A68_ALIGN ((int) s);
 188  // Allow for extra storage for diagnostics etcetera 
 189      ABEND (A68 (fixed_heap_pointer) >= (A68 (heap_size) - MIN_MEM_SIZE), ERROR_OUT_OF_CORE, __func__);
 190      ABEND (((unt) A68 (temp_heap_pointer) - (unt) A68 (fixed_heap_pointer)) <= MIN_MEM_SIZE, ERROR_OUT_OF_CORE, __func__);
 191      return z;
 192    } else {
 193      return get_heap_space (s);
 194    }
 195  }
 196  
 197  //! @brief Get (preferably temporary) heap space.
 198  
 199  BYTE_T *get_temp_heap_space (size_t s)
 200  {
 201    BYTE_T *z;
 202    if (A68 (heap_is_fluid)) {
 203      A68 (temp_heap_pointer) -= A68_ALIGN ((int) s);
 204  // Allow for extra storage for diagnostics etcetera.
 205      ABEND (((unt) A68 (temp_heap_pointer) - (unt) A68 (fixed_heap_pointer)) <= MIN_MEM_SIZE, ERROR_OUT_OF_CORE, __func__);
 206      z = HEAP_ADDRESS (A68 (temp_heap_pointer));
 207      return z;
 208    } else {
 209      return get_heap_space (s);
 210    }
 211  }
 212  
 213  //! @brief Get size of stack segment.
 214  
 215  void get_stack_size (void)
 216  {
 217  #if defined (BUILD_WIN32)
 218    A68 (stack_size) = MEGABYTE;  // Guestimate
 219  #else
 220    struct rlimit limits;
 221    errno = 0;
 222  // Some systems do not implement RLIMIT_STACK so if getrlimit fails, we do not abend.
 223    if (!(getrlimit (RLIMIT_STACK, &limits) == 0 && errno == 0)) {
 224      A68 (stack_size) = MEGABYTE;
 225    }
 226    A68 (stack_size) = (unt) (RLIM_CUR (&limits) < RLIM_MAX (&limits) ? RLIM_CUR (&limits) : RLIM_MAX (&limits));
 227  // A heuristic in case getrlimit yields extreme numbers: the frame stack is
 228  // assumed to fill at a rate comparable to the C stack, so the C stack needs
 229  // not be larger than the frame stack. This may not be true.
 230    if (A68 (stack_size) < KILOBYTE || (A68 (stack_size) > 96 * MEGABYTE && A68 (stack_size) > A68 (frame_stack_size))) {
 231      A68 (stack_size) = A68 (frame_stack_size);
 232    }
 233  #endif
 234    A68 (stack_limit) = (A68 (stack_size) > (4 * A68 (storage_overhead)) ? (A68 (stack_size) - A68 (storage_overhead)) : A68 (stack_size) / 2);
 235  }
 236  
 237  //! @brief Free heap allocated by genie.
 238  
 239  void genie_free (NODE_T * p)
 240  {
 241    for (; p != NO_NODE; FORWARD (p)) {
 242      genie_free (SUB (p));
 243      if (GINFO (p) != NO_GINFO) {
 244        a68_free (CONSTANT (GINFO (p)));
 245        CONSTANT (GINFO (p)) = NO_CONSTANT;
 246        a68_free (COMPILE_NAME (GINFO (p)));
 247        COMPILE_NAME (GINFO (p)) = NO_TEXT;
 248      }
 249    }
 250  }
 251  
 252  //! @brief Free heap allocated by genie.
 253  
 254  void free_syntax_tree (NODE_T * p)
 255  {
 256    for (; p != NO_NODE; FORWARD (p)) {
 257      free_syntax_tree (SUB (p));
 258      a68_free (NPRAGMENT (p));
 259      NPRAGMENT (p) = NO_TEXT;
 260      DIAGNOSTIC_T *d = DIAGNOSTICS (LINE (INFO (p)));
 261      while (d != NO_DIAGNOSTIC) {
 262        a68_free (TEXT (d));
 263        DIAGNOSTIC_T *stale = d;
 264        FORWARD (d);
 265        a68_free (stale);
 266      }
 267      DIAGNOSTICS (LINE (INFO (p))) = NO_DIAGNOSTIC;
 268    }
 269  }