Algol 68 Genie

genie-misc.c

     
   1  //! @file genie-misc.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  //! Miscellaneous interpreter routines.
  25  
  26  #include "a68g.h"
  27  #include "a68g-genie.h"
  28  #include "a68g-prelude.h"
  29  
  30  #define VECTOR_SIZE 512
  31  #define FD_READ 0
  32  #define FD_WRITE 1
  33  
  34  //! @brief Nop for the genie, for instance '+' for INT or REAL.
  35  
  36  void genie_idle (NODE_T * p)
  37  {
  38    (void) p;
  39  }
  40  
  41  //! @brief Unimplemented feature handler.
  42  
  43  void genie_unimplemented (NODE_T * p)
  44  {
  45    diagnostic (A68_RUNTIME_ERROR, p, ERROR_UNIMPLEMENTED);
  46    exit_genie (p, A68_RUNTIME_ERROR);
  47  }
  48  
  49  //! @brief PROC sleep = (INT) INT
  50  
  51  void genie_sleep (NODE_T * p)
  52  {
  53    A68_INT secs;
  54    POP_OBJECT (p, &secs, A68_INT);
  55    int wait = VALUE (&secs);
  56    PRELUDE_ERROR (wait < 0, p, ERROR_INVALID_ARGUMENT, M_INT);
  57    while (wait > 0) {
  58      wait = (int) sleep ((unt) wait);
  59    }
  60    PUSH_VALUE (p, (INT_T) 0, A68_INT);
  61  }
  62  
  63  //! @brief PROC system = (STRING) INT
  64  
  65  void genie_system (NODE_T * p)
  66  {
  67    A68_REF cmd;
  68    POP_REF (p, &cmd);
  69    CHECK_INIT (p, INITIALISED (&cmd), M_STRING);
  70    int size = 1 + a68_string_size (p, cmd);
  71    A68_REF ref_z = heap_generator (p, M_C_STRING, 1 + size);
  72    PUSH_VALUE (p, system (a_to_c_string (p, DEREF (char, &ref_z), cmd)), A68_INT);
  73  }
  74  
  75  //! @brief PROC (PROC VOID) VOID on gc event
  76  
  77  void genie_on_gc_event (NODE_T * p)
  78  {
  79    POP_PROCEDURE (p, &A68 (on_gc_event));
  80  }
  81  
  82  //! @brief Generic procedure for OP AND BECOMES (+:=, -:=, ...).
  83  
  84  void genie_f_and_becomes (NODE_T * p, MOID_T * ref, GPROC * f)
  85  {
  86    MOID_T *mode = SUB (ref);
  87    int size = SIZE (mode);
  88    BYTE_T *src = STACK_OFFSET (-size), *addr;
  89    A68_REF *dst = (A68_REF *) STACK_OFFSET (-size - A68_REF_SIZE);
  90    CHECK_REF (p, *dst, ref);
  91    addr = ADDRESS (dst);
  92    PUSH (p, addr, size);
  93    genie_check_initialisation (p, STACK_OFFSET (-size), mode);
  94    PUSH (p, src, size);
  95    (*f) (p);
  96    POP (p, addr, size);
  97    DECREMENT_STACK_POINTER (p, size);
  98  }
  99  
 100  //! @brief INT system heap pointer
 101  
 102  void genie_system_heap_pointer (NODE_T * p)
 103  {
 104    PUSH_VALUE (p, (int) (A68_HP), A68_INT);
 105  }
 106  
 107  //! @brief INT system stack pointer
 108  
 109  void genie_system_stack_pointer (NODE_T * p)
 110  {
 111    BYTE_T stack_offset;
 112    PUSH_VALUE (p, (int) (A68 (system_stack_offset) - &stack_offset), A68_INT);
 113  }