Algol 68 Genie

genie-identifier.c

     
   1  //! @file genie-identifier.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-2026 J. Marcel van der Veer [algol68g@algol68genie.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  //! Interpreter routines for identifiers.
  25  
  26  #include "a68g.h"
  27  #include "a68g-genie.h"
  28  #include "a68g-frames.h"
  29  #include "a68g-prelude.h"
  30  
  31  //! @brief Push a local identifier.
  32  
  33  PROP_T genie_frame_identifier (NODE_T * p)
  34  {
  35    BYTE_T *z;
  36    FRAME_GET (z, BYTE_T, p);
  37    PUSH (p, z, SIZE (MOID (p)));
  38    genie_check_initialisation (p, z, MOID (p));
  39    return GPROP (p);
  40  }
  41  
  42  //! @brief Push standard environ routine as PROC.
  43  
  44  PROP_T genie_identifier_standenv_proc (NODE_T * p)
  45  {
  46    A68G_PROCEDURE z;
  47    TAG_T *q = TAX (p);
  48    STATUS (&z) = (STATUS_MASK_T) (INIT_MASK | STANDENV_PROC_MASK);
  49    PROCEDURE (&(BODY (&z))) = PROCEDURE (q);
  50    ENVIRON (&z) = 0;
  51    LOCALE (&z) = NO_HANDLE;
  52    MOID (&z) = MOID (p);
  53    PUSH_PROCEDURE (p, z);
  54    return GPROP (p);
  55  }
  56  
  57  //! @brief (optimised) push identifier from standard environ
  58  
  59  PROP_T genie_identifier_standenv (NODE_T * p)
  60  {
  61    (void) ((*(PROCEDURE (TAX (p)))) (p));
  62    return GPROP (p);
  63  }
  64  
  65  //! @brief Push identifier onto the stack.
  66  
  67  PROP_T genie_identifier (NODE_T * p)
  68  {
  69    static PROP_T self;
  70    TAG_T *q = TAX (p);
  71    SOURCE (&self) = p;
  72    if (A68G_STANDENV_PROC (q)) {
  73      if (IS (MOID (q), PROC_SYMBOL)) {
  74        (void) genie_identifier_standenv_proc (p);
  75        UNIT (&self) = genie_identifier_standenv_proc;
  76      } else {
  77        (void) genie_identifier_standenv (p);
  78        UNIT (&self) = genie_identifier_standenv;
  79      }
  80    } else if (STATUS_TEST (q, CONSTANT_MASK)) {
  81      size_t size = SIZE (MOID (p));
  82      BYTE_T *sp_0 = STACK_TOP;
  83      (void) genie_frame_identifier (p);
  84      CONSTANT (GINFO (p)) = (void *) get_heap_space ((size_t) size);
  85      SIZE (GINFO (p)) = size;
  86      COPY (CONSTANT (GINFO (p)), (void *) sp_0, size);
  87      UNIT (&self) = genie_constant;
  88    } else {
  89      (void) genie_frame_identifier (p);
  90      UNIT (&self) = genie_frame_identifier;
  91    }
  92    return self;
  93  }