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