Algol 68 Genie

genie-assign.c

     
   1  //! @file genie-assign.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 assignations.
  25  
  26  #include "a68g.h"
  27  #include "a68g-genie.h"
  28  #include "a68g-frames.h"
  29  #include "a68g-prelude.h"
  30  
  31  //! @brief Assign a value to a name and voiden.
  32  
  33  PROP_T genie_voiding_assignation_constant (NODE_T * p)
  34  {
  35    NODE_T *dst = SUB (p);
  36    NODE_T *src = SOURCE (&PROP (GINFO (NEXT_NEXT (dst))));
  37    ADDR_T pop_sp = A68G_SP;
  38    A68G_REF *z = (A68G_REF *) STACK_TOP;
  39    PROP_T self;
  40    UNIT (&self) = genie_voiding_assignation_constant;
  41    SOURCE (&self) = p;
  42    GENIE_UNIT (dst);
  43    CHECK_REF (p, *z, MOID (p));
  44    COPY (ADDRESS (z), CONSTANT (GINFO (src)), SIZE (GINFO (src)));
  45    A68G_SP = pop_sp;
  46    return self;
  47  }
  48  
  49  //! @brief Assign a value to a name and voiden.
  50  
  51  PROP_T genie_voiding_assignation (NODE_T * p)
  52  {
  53    NODE_T *dst = SUB (p);
  54    NODE_T *src = NEXT_NEXT (dst);
  55    MOID_T *src_mode = SUB_MOID (dst);
  56    ADDR_T pop_sp = A68G_SP, pop_fp = FRAME_DNS (A68G_FP);
  57    A68G_REF z;
  58    PROP_T self;
  59    UNIT (&self) = genie_voiding_assignation;
  60    SOURCE (&self) = p;
  61    GENIE_UNIT (dst);
  62    POP_OBJECT (p, &z, A68G_REF);
  63    CHECK_REF (p, z, MOID (p));
  64    FRAME_DNS (A68G_FP) = REF_SCOPE (&z);
  65    GENIE_UNIT (src);
  66    STACK_DNS (src, src_mode, REF_SCOPE (&z));
  67    FRAME_DNS (A68G_FP) = pop_fp;
  68    A68G_SP = pop_sp;
  69    if (HAS_ROWS (src_mode)) {
  70      genie_clone_stack (p, src_mode, &z, &z);
  71    } else {
  72      COPY_ALIGNED (ADDRESS (&z), STACK_TOP, SIZE (src_mode));
  73    }
  74    return self;
  75  }
  76  
  77  //! @brief Assign a value to a name and push the name.
  78  
  79  PROP_T genie_assignation_constant (NODE_T * p)
  80  {
  81    NODE_T *dst = SUB (p);
  82    NODE_T *src = SOURCE (&PROP (GINFO (NEXT_NEXT (dst))));
  83    A68G_REF *z = (A68G_REF *) STACK_TOP;
  84    PROP_T self;
  85    UNIT (&self) = genie_assignation_constant;
  86    SOURCE (&self) = p;
  87    GENIE_UNIT (dst);
  88    CHECK_REF (p, *z, MOID (p));
  89    COPY (ADDRESS (z), CONSTANT (GINFO (src)), SIZE (GINFO (src)));
  90    return self;
  91  }
  92  
  93  //! @brief Assign a value to a name and push the name.
  94  
  95  PROP_T genie_assignation_quick (NODE_T * p)
  96  {
  97    NODE_T *dst = SUB (p);
  98    NODE_T *src = NEXT_NEXT (dst);
  99    MOID_T *src_mode = SUB_MOID (dst);
 100    size_t size = SIZE (src_mode);
 101    ADDR_T pop_fp = FRAME_DNS (A68G_FP);
 102    A68G_REF *z = (A68G_REF *) STACK_TOP;
 103    GENIE_UNIT (dst);
 104    CHECK_REF (p, *z, MOID (p));
 105    FRAME_DNS (A68G_FP) = REF_SCOPE (z);
 106    GENIE_UNIT (src);
 107    STACK_DNS (src, src_mode, REF_SCOPE (z));
 108    FRAME_DNS (A68G_FP) = pop_fp;
 109    DECREMENT_STACK_POINTER (p, size);
 110    if (HAS_ROWS (src_mode)) {
 111      genie_clone_stack (p, src_mode, z, z);
 112    } else {
 113      COPY (ADDRESS (z), STACK_TOP, size);
 114    }
 115    PROP_T self;
 116    UNIT (&self) = genie_assignation_quick;
 117    SOURCE (&self) = p;
 118    return self;
 119  }
 120  
 121  //! @brief Assign a value to a name and push the name.
 122  
 123  PROP_T genie_assignation (NODE_T * p)
 124  {
 125    PROP_T self, srp;
 126    NODE_T *dst = SUB (p);
 127    NODE_T *src = NEXT_NEXT (dst);
 128    MOID_T *src_mode = SUB_MOID (dst);
 129    size_t size = SIZE (src_mode);
 130    ADDR_T pop_fp = FRAME_DNS (A68G_FP);
 131    A68G_REF *z = (A68G_REF *) STACK_TOP;
 132    GENIE_UNIT (dst);
 133    CHECK_REF (p, *z, MOID (p));
 134    FRAME_DNS (A68G_FP) = REF_SCOPE (z);
 135    GENIE_UNIT_KEEP (src, srp);
 136    STACK_DNS (src, src_mode, REF_SCOPE (z));
 137    FRAME_DNS (A68G_FP) = pop_fp;
 138    DECREMENT_STACK_POINTER (p, size);
 139    if (HAS_ROWS (src_mode)) {
 140      genie_clone_stack (p, src_mode, z, z);
 141      UNIT (&self) = genie_assignation;
 142    } else {
 143      COPY (ADDRESS (z), STACK_TOP, size);
 144      if (UNIT (&srp) == genie_constant) {
 145        UNIT (&self) = genie_assignation_constant;
 146      } else {
 147        UNIT (&self) = genie_assignation_quick;
 148      }
 149    }
 150    SOURCE (&self) = p;
 151    return self;
 152  }