Algol 68 Genie

genie-formula.c

     
   1  //! @file genie-formula.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 formulas.
  25  
  26  #include "a68g.h"
  27  #include "a68g-genie.h"
  28  #include "a68g-frames.h"
  29  #include "a68g-prelude.h"
  30  
  31  //! @brief Push equality of two REFs.
  32  
  33  PROP_T genie_identity_relation (NODE_T * p)
  34  {
  35    NODE_T *lhs = SUB (p), *rhs = NEXT_NEXT (lhs);
  36    A68_REF x, y;
  37    GENIE_UNIT (lhs);
  38    POP_REF (p, &y);
  39    GENIE_UNIT (rhs);
  40    POP_REF (p, &x);
  41    if (IS (NEXT_SUB (p), IS_SYMBOL)) {
  42      PUSH_VALUE (p, (BOOL_T) (ADDRESS (&x) == ADDRESS (&y)), A68_BOOL);
  43    } else {
  44      PUSH_VALUE (p, (BOOL_T) (ADDRESS (&x) != ADDRESS (&y)), A68_BOOL);
  45    }
  46    PROP_T self;
  47    UNIT (&self) = genie_identity_relation;
  48    SOURCE (&self) = p;
  49    return self;
  50  }
  51  
  52  //! @brief Push result of ANDF or THEF.
  53  
  54  PROP_T genie_and_function (NODE_T * p)
  55  {
  56    A68_BOOL x;
  57    GENIE_UNIT (SUB (p));
  58    POP_OBJECT (p, &x, A68_BOOL);
  59    if (VALUE (&x) == A68_TRUE) {
  60      GENIE_UNIT (NEXT_NEXT (SUB (p)));
  61    } else {
  62      PUSH_VALUE (p, A68_FALSE, A68_BOOL);
  63    }
  64    PROP_T self;
  65    UNIT (&self) = genie_and_function;
  66    SOURCE (&self) = p;
  67    return self;
  68  }
  69  
  70  //! @brief Push result of ORF or ELSF.
  71  
  72  PROP_T genie_or_function (NODE_T * p)
  73  {
  74    A68_BOOL x;
  75    GENIE_UNIT (SUB (p));
  76    POP_OBJECT (p, &x, A68_BOOL);
  77    if (VALUE (&x) == A68_FALSE) {
  78      GENIE_UNIT (NEXT_NEXT (SUB (p)));
  79    } else {
  80      PUSH_VALUE (p, A68_TRUE, A68_BOOL);
  81    }
  82    PROP_T self;
  83    UNIT (&self) = genie_or_function;
  84    SOURCE (&self) = p;
  85    return self;
  86  }
  87  
  88  //! @brief Call operator.
  89  
  90  void genie_call_operator (NODE_T * p, ADDR_T pop_sp)
  91  {
  92    ADDR_T pop_fp = A68_FP;
  93    MOID_T *pr_mode = MOID (TAX (p));
  94    A68_PROCEDURE *z;
  95    FRAME_GET (z, A68_PROCEDURE, p);
  96    genie_call_procedure (p, pr_mode, MOID (z), pr_mode, z, pop_sp, pop_fp);
  97    STACK_DNS (p, SUB (pr_mode), A68_FP);
  98  }
  99  
 100  //! @brief Push result of monadic formula OP "u".
 101  
 102  PROP_T genie_monadic (NODE_T * p)
 103  {
 104    NODE_T *op = SUB (p);
 105    NODE_T *u = NEXT (op);
 106    ADDR_T pop_sp = A68_SP;
 107    GENIE_UNIT (u);
 108    STACK_DNS (u, MOID (u), A68_FP);
 109    if (PROCEDURE (TAX (op)) != NO_GPROC) {
 110      (void) ((*(PROCEDURE (TAX (op)))) (op));
 111    } else {
 112      genie_call_operator (op, pop_sp);
 113    }
 114    PROP_T self;
 115    UNIT (&self) = genie_monadic;
 116    SOURCE (&self) = p;
 117    return self;
 118  }
 119  
 120  //! @brief Push result of formula.
 121  
 122  PROP_T genie_dyadic_quick (NODE_T * p)
 123  {
 124    NODE_T *u = SUB (p);
 125    NODE_T *op = NEXT (u);
 126    NODE_T *v = NEXT (op);
 127    GENIE_UNIT (u);
 128    STACK_DNS (u, MOID (u), A68_FP);
 129    GENIE_UNIT (v);
 130    STACK_DNS (v, MOID (v), A68_FP);
 131    (void) ((*(PROCEDURE (TAX (op)))) (op));
 132    return GPROP (p);
 133  }
 134  
 135  //! @brief Push result of formula.
 136  
 137  PROP_T genie_dyadic (NODE_T * p)
 138  {
 139    NODE_T *u = SUB (p);
 140    NODE_T *op = NEXT (u);
 141    NODE_T *v = NEXT (op);
 142    ADDR_T pop_sp = A68_SP;
 143    GENIE_UNIT (u);
 144    STACK_DNS (u, MOID (u), A68_FP);
 145    GENIE_UNIT (v);
 146    STACK_DNS (v, MOID (v), A68_FP);
 147    if (PROCEDURE (TAX (op)) != NO_GPROC) {
 148      (void) ((*(PROCEDURE (TAX (op)))) (op));
 149    } else {
 150      genie_call_operator (op, pop_sp);
 151    }
 152    return GPROP (p);
 153  }
 154  
 155  //! @brief Push result of formula.
 156  
 157  PROP_T genie_formula (NODE_T * p)
 158  {
 159    NODE_T *u = SUB (p);
 160    NODE_T *op = NEXT (u);
 161    ADDR_T pop_sp = A68_SP;
 162    PROP_T self, lhs, rhs;
 163    UNIT (&self) = genie_formula;
 164    SOURCE (&self) = p;
 165    GENIE_UNIT_2 (u, lhs);
 166    STACK_DNS (u, MOID (u), A68_FP);
 167    if (op != NO_NODE) {
 168      NODE_T *v = NEXT (op);
 169      GPROC *proc = PROCEDURE (TAX (op));
 170      GENIE_UNIT_2 (v, rhs);
 171      STACK_DNS (v, MOID (v), A68_FP);
 172      UNIT (&self) = genie_dyadic;
 173      if (proc != NO_GPROC) {
 174        (void) ((*(proc)) (op));
 175        UNIT (&self) = genie_dyadic_quick;
 176      } else {
 177        genie_call_operator (op, pop_sp);
 178      }
 179      return self;
 180    } else if (UNIT (&lhs) == genie_monadic) {
 181      return lhs;
 182    }
 183    (void) rhs;
 184    return self;
 185  }
Deze website is gearchiveerd door de KB, nationale bibliotheek.

This website is archived by the National Library of the Netherlands.