Algol 68 Genie

rts-internal.c

     
   1  //! @file rts-internal.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  //! Transput routines.
  25  
  26  #include "a68g.h"
  27  #include "a68g-genie.h"
  28  #include "a68g-prelude.h"
  29  #include "a68g-transput.h"
  30  
  31  // These routines use A68G's RR transput routines,
  32  // essentially mimicking code of the form
  33  //    PROC puts = (REF STRING s, [] SIMPLOUT items) VOID:
  34  //         BEGIN FILE f;
  35  //               associate (f, s);
  36  //               put (f, items);
  37  //               close (f)
  38  //         END 
  39  // which is not the most efficient, though practical.
  40  
  41  static void associate (A68G_FILE *f, A68G_REF s)
  42  {
  43    STATUS (f) = INIT_MASK;
  44    FILE_ENTRY (f) = -1;
  45    CHANNEL (f) = A68G (associate_channel);
  46    OPENED (f) = A68G_TRUE;
  47    OPEN_EXCLUSIVE (f) = A68G_FALSE;
  48    READ_MOOD (f) = A68G_FALSE;
  49    WRITE_MOOD (f) = A68G_FALSE;
  50    CHAR_MOOD (f) = A68G_FALSE;
  51    DRAW_MOOD (f) = A68G_FALSE;
  52    TMP_FILE (f) = A68G_FALSE;
  53    IDENTIFICATION (f) = nil_ref;
  54    TERMINATOR (f) = nil_ref;
  55    FORMAT (f) = nil_format;
  56    FD (f) = A68G_NO_FILE;
  57    STRING (f) = s;
  58    STRPOS (f) = 0;
  59    DEVICE_MADE (&DEVICE (f)) = A68G_FALSE;
  60    STREAM (&DEVICE (f)) = NO_STREAM;
  61    set_default_event_procedures (f);
  62  }
  63  
  64  //! @brief PROC (REF STRING, [] SIMPLIN) VOID gets
  65  
  66  void genie_get_text (NODE_T * p)
  67  {
  68  // Block GC momentarily.
  69    A68G_GC (sema)++;
  70  // Pop [] SIMPLIN.
  71    A68G_REF row; 
  72    POP_REF (p, &row);
  73    CHECK_REF (p, row, M_ROW_SIMPLIN);
  74  // Pop REF STRING.
  75    A68G_REF ref_string;
  76    POP_REF (p, &ref_string);
  77    CHECK_REF (p, ref_string, M_REF_STRING);
  78  // Associate a temp file with argument string.
  79    A68G_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
  80    A68G_FILE *file = FILE_DEREF (&ref_file);
  81    associate (file, ref_string);
  82    open_for_reading (p, ref_file);
  83  // Read.
  84    A68G_ARRAY *arr; A68G_TUPLE *tup;
  85    GET_DESCRIPTOR (arr, tup, &row);
  86    int elems = ROW_SIZE (tup);
  87    if (elems > 0) {
  88      BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
  89      int elem_index = 0;
  90      for (int k = 0; k < elems; k++) {
  91        A68G_UNION *z = (A68G_UNION *) & base_address[elem_index];
  92        MOID_T *mode = (MOID_T *) (VALUE (z));
  93        BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68G_UNION_SIZE];
  94        genie_read_standard (p, mode, item, ref_file);
  95        elem_index += SIZE (M_SIMPLIN);
  96      }
  97    }
  98  // Discard temp file.
  99    unblock_transput_buffer (TRANSPUT_BUFFER (file));
 100    A68G_GC (sema)--;
 101  }
 102  
 103  //! @brief PROC (REF STRING, [] SIMPLOUT) VOID puts
 104  
 105  void genie_put_text (NODE_T * p)
 106  {
 107  // Block GC momentarily.
 108    A68G_GC (sema)++;
 109  // Pop [] SIMPLOUT.
 110    A68G_REF row; 
 111    POP_REF (p, &row);
 112    CHECK_REF (p, row, M_ROW_SIMPLOUT);
 113  // Pop REF STRING.
 114    A68G_REF ref_string;
 115    POP_REF (p, &ref_string);
 116    CHECK_REF (p, ref_string, M_REF_STRING);
 117  // Associate a temp file with argument string.
 118    A68G_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
 119    A68G_FILE *file = FILE_DEREF (&ref_file);
 120    associate (file, ref_string);
 121    open_for_writing (p, ref_file);
 122  // Write.
 123    A68G_ARRAY *arr; A68G_TUPLE *tup;
 124    GET_DESCRIPTOR (arr, tup, &row);
 125    int elems = ROW_SIZE (tup);
 126    if (elems > 0) {
 127      reset_transput_buffer (UNFORMATTED_BUFFER);
 128      BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
 129      int elem_index = 0;
 130      for (int k = 0; k < elems; k++) {
 131        A68G_UNION *z = (A68G_UNION *) & base_address[elem_index];
 132        MOID_T *mode = (MOID_T *) (VALUE (z));
 133        BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68G_UNION_SIZE];
 134        genie_write_standard (p, mode, item, ref_file);
 135        elem_index += SIZE (M_SIMPLOUT);
 136      }
 137      * DEREF (A68G_REF, &ref_string) = c_to_a_string (p, get_transput_buffer (UNFORMATTED_BUFFER), DEFAULT_WIDTH);
 138    }
 139  // Discard temp file.
 140    unblock_transput_buffer (TRANSPUT_BUFFER (file));
 141    A68G_GC (sema)--;
 142  }
 143  
 144  //! @brief PROC (REF STRING, [] SIMPLIN) VOID getsf
 145  
 146  void genie_getf_text (NODE_T * p)
 147  {
 148  // Block GC momentarily.
 149    A68G_GC (sema)++;
 150  // Pop [] SIMPLIN.
 151    A68G_REF row; 
 152    POP_REF (p, &row);
 153    CHECK_REF (p, row, M_ROW_SIMPLIN);
 154  // Pop REF STRING.
 155    A68G_REF ref_string;
 156    POP_REF (p, &ref_string);
 157    CHECK_REF (p, ref_string, M_REF_STRING);
 158  // Associate a temp file with argument string.
 159    A68G_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
 160    A68G_FILE *file = FILE_DEREF (&ref_file);
 161    associate (file, ref_string);
 162    open_for_reading (p, ref_file);
 163  // Save stack state since formats have frames.
 164    ADDR_T pop_fp = FRAME_POINTER (file);
 165    ADDR_T pop_sp = STACK_POINTER (file);
 166    FRAME_POINTER (file) = A68G_FP;
 167    STACK_POINTER (file) = A68G_SP;
 168  // Process [] SIMPLIN.
 169    if (BODY (&FORMAT (file)) != NO_NODE) {
 170      open_format_frame (p, ref_file, &FORMAT (file), NOT_EMBEDDED_FORMAT, A68G_FALSE);
 171    }
 172    int formats = 0;
 173  // Read.
 174    A68G_ARRAY *arr; A68G_TUPLE *tup;
 175    GET_DESCRIPTOR (arr, tup, &row);
 176    int elems = ROW_SIZE (tup);
 177    if (elems > 0) {
 178      BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
 179      int elem_index = 0;
 180      for (int k = 0; k < elems; k++) {
 181        A68G_UNION *z = (A68G_UNION *) & base_address[elem_index];
 182        MOID_T *mode = (MOID_T *) (VALUE (z));
 183        BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68G_UNION_SIZE];
 184        genie_read_standard_format (p, mode, item, ref_file, &formats);
 185        elem_index += SIZE (M_SIMPLIN);
 186      }
 187    }
 188  // Empty the format to purge insertions.
 189    purge_format_read (p, ref_file);
 190    BODY (&FORMAT (file)) = NO_NODE;
 191  // Forget about active formats.
 192    A68G_FP = FRAME_POINTER (file);
 193    A68G_SP = STACK_POINTER (file);
 194    FRAME_POINTER (file) = pop_fp;
 195    STACK_POINTER (file) = pop_sp;
 196  // Discard temp file.
 197    unblock_transput_buffer (TRANSPUT_BUFFER (file));
 198    A68G_GC (sema)--;
 199  }
 200  
 201  //! @brief PROC (REF STRING, [] SIMPLOUT) VOID putsf
 202  
 203  void genie_putf_text (NODE_T * p)
 204  {
 205  // Block GC momentarily.
 206    A68G_GC (sema)++;
 207  // Pop [] SIMPLOUT.
 208    A68G_REF row; 
 209    POP_REF (p, &row);
 210    CHECK_REF (p, row, M_ROW_SIMPLOUT);
 211  // Pop REF STRING.
 212    A68G_REF ref_string;
 213    POP_REF (p, &ref_string);
 214    CHECK_REF (p, ref_string, M_REF_STRING);
 215  // Associate a temp file with argument string.
 216    A68G_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
 217    A68G_FILE *file = FILE_DEREF (&ref_file);
 218    associate (file, ref_string);
 219    open_for_writing (p, ref_file);
 220  // Save stack state since formats have frames.
 221    ADDR_T pop_fp = FRAME_POINTER (file);
 222    ADDR_T pop_sp = STACK_POINTER (file);
 223    FRAME_POINTER (file) = A68G_FP;
 224    STACK_POINTER (file) = A68G_SP;
 225  // Process [] SIMPLIN.
 226    if (BODY (&FORMAT (file)) != NO_NODE) {
 227      open_format_frame (p, ref_file, &FORMAT (file), NOT_EMBEDDED_FORMAT, A68G_FALSE);
 228    }
 229    int formats = 0;
 230  // Write.
 231    A68G_ARRAY *arr; A68G_TUPLE *tup;
 232    GET_DESCRIPTOR (arr, tup, &row);
 233    int elems = ROW_SIZE (tup);
 234    if (elems > 0) {
 235      reset_transput_buffer (FORMATTED_BUFFER);
 236      BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
 237      int elem_index = 0;
 238      for (int k = 0; k < elems; k++) {
 239        A68G_UNION *z = (A68G_UNION *) & base_address[elem_index];
 240        MOID_T *mode = (MOID_T *) (VALUE (z));
 241        BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68G_UNION_SIZE];
 242        genie_write_standard_format (p, mode, item, ref_file, &formats);
 243        elem_index += SIZE (M_SIMPLOUT);
 244      }
 245    }
 246  // Empty the format to purge insertions.
 247    purge_format_write (p, ref_file);
 248    write_purge_buffer (p, ref_file, FORMATTED_BUFFER);
 249    BODY (&FORMAT (file)) = NO_NODE;
 250  // Forget about active formats.
 251    A68G_FP = FRAME_POINTER (file);
 252    A68G_SP = STACK_POINTER (file);
 253    FRAME_POINTER (file) = pop_fp;
 254    STACK_POINTER (file) = pop_sp;
 255  // Discard temp file.
 256    unblock_transput_buffer (TRANSPUT_BUFFER (file));
 257    A68G_GC (sema)--;
 258  }
 259  
 260  //! @brief PROC (REF STRING, [] SIMPLOUT) REF STRING string
 261  
 262  void genie_string (NODE_T * p)
 263  {
 264  // Block GC momentarily.
 265    A68G_GC (sema)++;
 266  // Pop [] SIMPLOUT.
 267    A68G_REF row; 
 268    POP_REF (p, &row);
 269    CHECK_REF (p, row, M_ROW_SIMPLOUT);
 270  // Pop REF STRING.
 271    A68G_REF ref_string;
 272    POP_REF (p, &ref_string);
 273    CHECK_REF (p, ref_string, M_REF_STRING);
 274  // Associate a temp file with argument string.
 275    A68G_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
 276    A68G_FILE *file = FILE_DEREF (&ref_file);
 277    associate (file, ref_string);
 278    open_for_writing (p, ref_file);
 279  // Write.
 280    A68G_ARRAY *arr; A68G_TUPLE *tup;
 281    GET_DESCRIPTOR (arr, tup, &row);
 282    int elems = ROW_SIZE (tup);
 283    if (elems > 0) {
 284      reset_transput_buffer (UNFORMATTED_BUFFER);
 285      BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
 286      int elem_index = 0;
 287      for (int k = 0; k < elems; k++) {
 288        A68G_UNION *z = (A68G_UNION *) & base_address[elem_index];
 289        MOID_T *mode = (MOID_T *) (VALUE (z));
 290        BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68G_UNION_SIZE];
 291        genie_write_standard (p, mode, item, ref_file);
 292        elem_index += SIZE (M_SIMPLOUT);
 293      }
 294      * DEREF (A68G_REF, &ref_string) = c_to_a_string (p, get_transput_buffer (UNFORMATTED_BUFFER), DEFAULT_WIDTH);
 295    }
 296    PUSH_REF (p, ref_string);
 297  // Discard temp file.
 298    unblock_transput_buffer (TRANSPUT_BUFFER (file));
 299    A68G_GC (sema)--;
 300  }
 301  
 302  //! @brief PROC (REF STRING, [] SIMPLOUT) REF STRING stringf
 303  
 304  void genie_stringf (NODE_T * p)
 305  {
 306  // Block GC momentarily.
 307    A68G_GC (sema)++;
 308  // Pop [] SIMPLOUT.
 309    A68G_REF row; 
 310    POP_REF (p, &row);
 311    CHECK_REF (p, row, M_ROW_SIMPLOUT);
 312  // Pop REF STRING.
 313    A68G_REF ref_string;
 314    POP_REF (p, &ref_string);
 315    CHECK_REF (p, ref_string, M_REF_STRING);
 316  // Associate a temp file with argument string.
 317    A68G_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
 318    A68G_FILE *file = FILE_DEREF (&ref_file);
 319    associate (file, ref_string);
 320    open_for_writing (p, ref_file);
 321  // Save stack state since formats have frames.
 322    ADDR_T pop_fp = FRAME_POINTER (file);
 323    ADDR_T pop_sp = STACK_POINTER (file);
 324    FRAME_POINTER (file) = A68G_FP;
 325    STACK_POINTER (file) = A68G_SP;
 326  // Process [] SIMPLIN.
 327    if (BODY (&FORMAT (file)) != NO_NODE) {
 328      open_format_frame (p, ref_file, &FORMAT (file), NOT_EMBEDDED_FORMAT, A68G_FALSE);
 329    }
 330    int formats = 0;
 331  // Write.
 332    A68G_ARRAY *arr; A68G_TUPLE *tup;
 333    GET_DESCRIPTOR (arr, tup, &row);
 334    int elems = ROW_SIZE (tup);
 335    if (elems > 0) {
 336      reset_transput_buffer (FORMATTED_BUFFER);
 337      BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
 338      int elem_index = 0;
 339      for (int k = 0; k < elems; k++) {
 340        A68G_UNION *z = (A68G_UNION *) & base_address[elem_index];
 341        MOID_T *mode = (MOID_T *) (VALUE (z));
 342        BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68G_UNION_SIZE];
 343        genie_write_standard_format (p, mode, item, ref_file, &formats);
 344        elem_index += SIZE (M_SIMPLOUT);
 345      }
 346    }
 347  // Empty the format to purge insertions.
 348    purge_format_write (p, ref_file);
 349    write_purge_buffer (p, ref_file, FORMATTED_BUFFER);
 350    BODY (&FORMAT (file)) = NO_NODE;
 351  // Forget about active formats.
 352    A68G_FP = FRAME_POINTER (file);
 353    A68G_SP = STACK_POINTER (file);
 354    FRAME_POINTER (file) = pop_fp;
 355    STACK_POINTER (file) = pop_sp;
 356    PUSH_REF (p, ref_string);
 357  // Discard temp file.
 358    unblock_transput_buffer (TRANSPUT_BUFFER (file));
 359    A68G_GC (sema)--;
 360  }