rts-char.c

     
   1  //! @file rts-char.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-2023 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  //! CHAR, STRING and BYTES routines.
  25  
  26  #include "a68g.h"
  27  #include "a68g-genie.h"
  28  #include "a68g-prelude.h"
  29  #include "a68g-mp.h"
  30  #include "a68g-double.h"
  31  #include "a68g-transput.h"
  32  
  33  // OP (CHAR, CHAR) BOOL.
  34  
  35  #define A68_CMP_CHAR(n, OP)\
  36  void n (NODE_T * p) {\
  37    A68_CHAR i, j;\
  38    POP_OBJECT (p, &j, A68_CHAR);\
  39    POP_OBJECT (p, &i, A68_CHAR);\
  40    PUSH_VALUE (p, (BOOL_T) (TO_UCHAR (VALUE (&i)) OP TO_UCHAR (VALUE (&j))), A68_BOOL);\
  41    }
  42  
  43  A68_CMP_CHAR (genie_eq_char, ==);
  44  A68_CMP_CHAR (genie_ne_char, !=);
  45  A68_CMP_CHAR (genie_lt_char, <);
  46  A68_CMP_CHAR (genie_gt_char, >);
  47  A68_CMP_CHAR (genie_le_char, <=);
  48  A68_CMP_CHAR (genie_ge_char, >=);
  49  
  50  //! @brief OP ABS = (CHAR) INT
  51  
  52  void genie_abs_char (NODE_T * p)
  53  {
  54    A68_CHAR i;
  55    POP_OBJECT (p, &i, A68_CHAR);
  56    PUSH_VALUE (p, TO_UCHAR (VALUE (&i)), A68_INT);
  57  }
  58  
  59  //! @brief OP REPR = (INT) CHAR
  60  
  61  void genie_repr_char (NODE_T * p)
  62  {
  63    A68_INT k;
  64    POP_OBJECT (p, &k, A68_INT);
  65    PRELUDE_ERROR (VALUE (&k) < 0 || VALUE (&k) > (int) UCHAR_MAX, p, ERROR_OUT_OF_BOUNDS, M_CHAR);
  66    PUSH_VALUE (p, (char) (VALUE (&k)), A68_CHAR);
  67  }
  68  
  69  // OP (CHAR) BOOL.
  70  
  71  #define A68_CHAR_BOOL(n, OP)\
  72  void n (NODE_T * p) {\
  73    A68_CHAR ch;\
  74    POP_OBJECT (p, &ch, A68_CHAR);\
  75    PUSH_VALUE (p, (BOOL_T) (OP (VALUE (&ch)) == 0 ? A68_FALSE : A68_TRUE), A68_BOOL);\
  76    }
  77  
  78  A68_CHAR_BOOL (genie_is_alnum, IS_ALNUM);
  79  A68_CHAR_BOOL (genie_is_alpha, IS_ALPHA);
  80  A68_CHAR_BOOL (genie_is_cntrl, IS_CNTRL);
  81  A68_CHAR_BOOL (genie_is_digit, IS_DIGIT);
  82  A68_CHAR_BOOL (genie_is_graph, IS_GRAPH);
  83  A68_CHAR_BOOL (genie_is_lower, IS_LOWER);
  84  A68_CHAR_BOOL (genie_is_print, IS_PRINT);
  85  A68_CHAR_BOOL (genie_is_punct, IS_PUNCT);
  86  A68_CHAR_BOOL (genie_is_space, IS_SPACE);
  87  A68_CHAR_BOOL (genie_is_upper, IS_UPPER);
  88  A68_CHAR_BOOL (genie_is_xdigit, IS_XDIGIT);
  89  
  90  #define A68_CHAR_CHAR(n, OP)\
  91  void n (NODE_T * p) {\
  92    A68_CHAR *ch;\
  93    POP_OPERAND_ADDRESS (p, ch, A68_CHAR);\
  94    VALUE (ch) = (char) (OP (TO_UCHAR (VALUE (ch))));\
  95  }
  96  A68_CHAR_CHAR (genie_to_lower, TO_LOWER)
  97    A68_CHAR_CHAR (genie_to_upper, TO_UPPER)
  98  //! @brief OP + = (CHAR, CHAR) STRING
  99       void genie_add_char (NODE_T * p)
 100  {
 101    A68_CHAR a, b;
 102    A68_REF c, d;
 103    A68_ARRAY *a_3;
 104    A68_TUPLE *t_3;
 105    BYTE_T *b_3;
 106  // right part.
 107    POP_OBJECT (p, &b, A68_CHAR);
 108    CHECK_INIT (p, INITIALISED (&b), M_CHAR);
 109  // left part.
 110    POP_OBJECT (p, &a, A68_CHAR);
 111    CHECK_INIT (p, INITIALISED (&a), M_CHAR);
 112  // sum.
 113    c = heap_generator (p, M_STRING, DESCRIPTOR_SIZE (1));
 114    d = heap_generator (p, M_STRING, 2 * SIZE (M_CHAR));
 115    GET_DESCRIPTOR (a_3, t_3, &c);
 116    DIM (a_3) = 1;
 117    MOID (a_3) = M_CHAR;
 118    ELEM_SIZE (a_3) = SIZE (M_CHAR);
 119    SLICE_OFFSET (a_3) = 0;
 120    FIELD_OFFSET (a_3) = 0;
 121    ARRAY (a_3) = d;
 122    LWB (t_3) = 1;
 123    UPB (t_3) = 2;
 124    SHIFT (t_3) = LWB (t_3);
 125    SPAN (t_3) = 1;
 126  // add chars.
 127    b_3 = DEREF (BYTE_T, &ARRAY (a_3));
 128    MOVE ((BYTE_T *) & b_3[0], (BYTE_T *) & a, SIZE (M_CHAR));
 129    MOVE ((BYTE_T *) & b_3[SIZE (M_CHAR)], (BYTE_T *) & b, SIZE (M_CHAR));
 130    PUSH_REF (p, c);
 131  }
 132  
 133  //! @brief OP ELEM = (INT, STRING) CHAR # ALGOL68C #
 134  
 135  void genie_elem_string (NODE_T * p)
 136  {
 137    A68_REF z;
 138    A68_ARRAY *a;
 139    A68_TUPLE *t;
 140    A68_INT k;
 141    BYTE_T *base;
 142    A68_CHAR *ch;
 143    POP_REF (p, &z);
 144    CHECK_REF (p, z, M_STRING);
 145    POP_OBJECT (p, &k, A68_INT);
 146    GET_DESCRIPTOR (a, t, &z);
 147    PRELUDE_ERROR (VALUE (&k) < LWB (t), p, ERROR_INDEX_OUT_OF_BOUNDS, NO_TEXT);
 148    PRELUDE_ERROR (VALUE (&k) > UPB (t), p, ERROR_INDEX_OUT_OF_BOUNDS, NO_TEXT);
 149    base = DEREF (BYTE_T, &(ARRAY (a)));
 150    ch = (A68_CHAR *) & (base[INDEX_1_DIM (a, t, VALUE (&k))]);
 151    PUSH_VALUE (p, VALUE (ch), A68_CHAR);
 152  }
 153  
 154  //! @brief OP + = (STRING, STRING) STRING
 155  
 156  void genie_add_string (NODE_T * p)
 157  {
 158    A68_REF a, b, c, d;
 159    A68_ARRAY *a_1, *a_2, *a_3;
 160    A68_TUPLE *t_1, *t_2, *t_3;
 161    BYTE_T *b_1, *b_2, *b_3;
 162  // right part.
 163    POP_REF (p, &b);
 164    CHECK_INIT (p, INITIALISED (&b), M_STRING);
 165    GET_DESCRIPTOR (a_2, t_2, &b);
 166    int l_2 = ROW_SIZE (t_2);
 167  // left part.
 168    POP_REF (p, &a);
 169    CHECK_REF (p, a, M_STRING);
 170    GET_DESCRIPTOR (a_1, t_1, &a);
 171    int l_1 = ROW_SIZE (t_1);
 172  // sum.
 173    c = heap_generator (p, M_STRING, DESCRIPTOR_SIZE (1));
 174    d = heap_generator (p, M_STRING, (l_1 + l_2) * SIZE (M_CHAR));
 175  // Calculate again since garbage collector might have moved data.
 176    GET_DESCRIPTOR (a_1, t_1, &a);
 177    GET_DESCRIPTOR (a_2, t_2, &b);
 178    GET_DESCRIPTOR (a_3, t_3, &c);
 179    DIM (a_3) = 1;
 180    MOID (a_3) = M_CHAR;
 181    ELEM_SIZE (a_3) = SIZE (M_CHAR);
 182    SLICE_OFFSET (a_3) = 0;
 183    FIELD_OFFSET (a_3) = 0;
 184    ARRAY (a_3) = d;
 185    LWB (t_3) = 1;
 186    UPB (t_3) = l_1 + l_2;
 187    SHIFT (t_3) = LWB (t_3);
 188    SPAN (t_3) = 1;
 189  // add strings.
 190    b_3 = DEREF (BYTE_T, &ARRAY (a_3));
 191    int m = 0;
 192    if (ROW_SIZE (t_1) > 0) {
 193      b_1 = DEREF (BYTE_T, &ARRAY (a_1));
 194      for (int k = LWB (t_1); k <= UPB (t_1); k++) {
 195        MOVE ((BYTE_T *) & b_3[m], (BYTE_T *) & b_1[INDEX_1_DIM (a_1, t_1, k)], SIZE (M_CHAR));
 196        m += SIZE (M_CHAR);
 197      }
 198    }
 199    if (ROW_SIZE (t_2) > 0) {
 200      b_2 = DEREF (BYTE_T, &ARRAY (a_2));
 201      for (int k = LWB (t_2); k <= UPB (t_2); k++) {
 202        MOVE ((BYTE_T *) & b_3[m], (BYTE_T *) & b_2[INDEX_1_DIM (a_2, t_2, k)], SIZE (M_CHAR));
 203        m += SIZE (M_CHAR);
 204      }
 205    }
 206    PUSH_REF (p, c);
 207  }
 208  
 209  //! @brief OP * = (INT, STRING) STRING
 210  
 211  void genie_times_int_string (NODE_T * p)
 212  {
 213    A68_REF a;
 214    POP_REF (p, &a);
 215    A68_INT k;
 216    POP_OBJECT (p, &k, A68_INT);
 217    PRELUDE_ERROR (VALUE (&k) < 0, p, ERROR_INVALID_ARGUMENT, M_INT);
 218    CHECK_INT_SHORTEN (p, VALUE (&k));
 219    PUSH_REF (p, empty_string (p));
 220    while (VALUE (&k)--) {
 221      PUSH_REF (p, a);
 222      genie_add_string (p);
 223    }
 224  }
 225  
 226  //! @brief OP * = (STRING, INT) STRING
 227  
 228  void genie_times_string_int (NODE_T * p)
 229  {
 230    A68_INT k;
 231    POP_OBJECT (p, &k, A68_INT);
 232    A68_REF a;
 233    POP_REF (p, &a);
 234    PUSH_VALUE (p, VALUE (&k), A68_INT);
 235    PUSH_REF (p, a);
 236    genie_times_int_string (p);
 237  }
 238  
 239  //! @brief OP * = (INT, CHAR) STRING
 240  
 241  void genie_times_int_char (NODE_T * p)
 242  {
 243  // Pop operands.
 244    A68_CHAR a;
 245    POP_OBJECT (p, &a, A68_CHAR);
 246    A68_INT str_size;
 247    POP_OBJECT (p, &str_size, A68_INT);
 248    PRELUDE_ERROR (VALUE (&str_size) < 0, p, ERROR_INVALID_ARGUMENT, M_INT);
 249    CHECK_INT_SHORTEN (p, VALUE (&str_size));
 250  // Make new string.
 251    A68_REF z, row; A68_ARRAY arr; A68_TUPLE tup;
 252    NEW_ROW_1D (z, row, arr, tup, M_ROW_CHAR, M_CHAR, (int) (VALUE (&str_size)));
 253    BYTE_T *base = ADDRESS (&row);
 254    for (int k = 0; k < VALUE (&str_size); k++) {
 255      A68_CHAR ch;
 256      STATUS (&ch) = INIT_MASK;
 257      VALUE (&ch) = VALUE (&a);
 258      *(A68_CHAR *) & base[k * SIZE (M_CHAR)] = ch;
 259    }
 260    PUSH_REF (p, z);
 261  }
 262  
 263  //! @brief OP * = (CHAR, INT) STRING
 264  
 265  void genie_times_char_int (NODE_T * p)
 266  {
 267    A68_INT k;
 268    A68_CHAR a;
 269    POP_OBJECT (p, &k, A68_INT);
 270    POP_OBJECT (p, &a, A68_CHAR);
 271    PUSH_VALUE (p, VALUE (&k), A68_INT);
 272    PUSH_VALUE (p, VALUE (&a), A68_CHAR);
 273    genie_times_int_char (p);
 274  }
 275  
 276  //! @brief OP +:= = (REF STRING, STRING) REF STRING
 277  
 278  void genie_plusab_string (NODE_T * p)
 279  {
 280    genie_f_and_becomes (p, M_REF_STRING, genie_add_string);
 281  }
 282  
 283  //! @brief OP +=: = (STRING, REF STRING) REF STRING
 284  
 285  void genie_plusto_string (NODE_T * p)
 286  {
 287    A68_REF refa, a, b;
 288    POP_REF (p, &refa);
 289    CHECK_REF (p, refa, M_REF_STRING);
 290    a = *DEREF (A68_REF, &refa);
 291    CHECK_INIT (p, INITIALISED (&a), M_STRING);
 292    POP_REF (p, &b);
 293    PUSH_REF (p, b);
 294    PUSH_REF (p, a);
 295    genie_add_string (p);
 296    POP_REF (p, DEREF (A68_REF, &refa));
 297    PUSH_REF (p, refa);
 298  }
 299  
 300  //! @brief OP *:= = (REF STRING, INT) REF STRING
 301  
 302  void genie_timesab_string (NODE_T * p)
 303  {
 304    A68_INT k;
 305    POP_OBJECT (p, &k, A68_INT);
 306    PRELUDE_ERROR (VALUE (&k) < 0, p, ERROR_INVALID_ARGUMENT, M_INT);
 307    A68_REF ref;
 308    POP_REF (p, &ref);
 309    CHECK_REF (p, ref, M_REF_STRING);
 310    A68_REF a = *DEREF (A68_REF, &ref);
 311    CHECK_INIT (p, INITIALISED (&a), M_STRING);
 312  // Multiplication as repeated addition.
 313    PUSH_REF (p, empty_string (p));
 314    for (int i = 1; i <= VALUE (&k); i++) {
 315      PUSH_REF (p, a);
 316      genie_add_string (p);
 317    }
 318  // The stack contains a STRING, promote to REF STRING.
 319    POP_REF (p, DEREF (A68_REF, &ref));
 320    PUSH_REF (p, ref);
 321  }
 322  
 323  //! @brief Difference between two STRINGs in the stack.
 324  
 325  int string_difference (NODE_T * p)
 326  {
 327  // Pop operands.
 328    A68_REF row2; A68_ARRAY *a_2; A68_TUPLE *t_2;
 329    POP_REF (p, &row2);
 330    CHECK_INIT (p, INITIALISED (&row2), M_STRING);
 331    GET_DESCRIPTOR (a_2, t_2, &row2);
 332    int s_2 = ROW_SIZE (t_2);
 333  //
 334    A68_REF row1; A68_ARRAY *a_1; A68_TUPLE *t_1;
 335    POP_REF (p, &row1);
 336    CHECK_INIT (p, INITIALISED (&row1), M_STRING);
 337    GET_DESCRIPTOR (a_1, t_1, &row1);
 338    int s_1 = ROW_SIZE (t_1);
 339  // Compute string difference.
 340    int size = (s_1 > s_2 ? s_1 : s_2), diff = 0;
 341    BYTE_T *b_1 = (s_1 > 0 ? DEREF (BYTE_T, &ARRAY (a_1)) : NO_BYTE);
 342    BYTE_T *b_2 = (s_2 > 0 ? DEREF (BYTE_T, &ARRAY (a_2)) : NO_BYTE);
 343    for (int k = 0; k < size && diff == 0; k++) {
 344      int a, b;
 345      if (s_1 > 0 && k < s_1) {
 346        A68_CHAR *ch = (A68_CHAR *) & b_1[INDEX_1_DIM (a_1, t_1, LWB (t_1) + k)];
 347        a = (int) VALUE (ch);
 348      } else {
 349        a = 0;
 350      }
 351      if (s_2 > 0 && k < s_2) {
 352        A68_CHAR *ch = (A68_CHAR *) & b_2[INDEX_1_DIM (a_2, t_2, LWB (t_2) + k)];
 353        b = (int) VALUE (ch);
 354      } else {
 355        b = 0;
 356      }
 357      diff += (TO_UCHAR (a) - TO_UCHAR (b));
 358    }
 359    return diff;
 360  }
 361  
 362  // OP (STRING, STRING) BOOL.
 363  
 364  #define A68_CMP_STRING(n, OP)\
 365  void n (NODE_T * p) {\
 366    int k = string_difference (p);\
 367    PUSH_VALUE (p, (BOOL_T) (k OP 0), A68_BOOL);\
 368  }
 369  
 370  A68_CMP_STRING (genie_eq_string, ==)
 371    A68_CMP_STRING (genie_ne_string, !=)
 372    A68_CMP_STRING (genie_lt_string, <)
 373    A68_CMP_STRING (genie_gt_string, >)
 374    A68_CMP_STRING (genie_le_string, <=)
 375    A68_CMP_STRING (genie_ge_string, >=)
 376  // BYTES operations.
 377  //! @brief OP ELEM = (INT, BYTES) CHAR
 378       void genie_elem_bytes (NODE_T * p)
 379  {
 380    A68_BYTES j; A68_INT i;
 381    POP_OBJECT (p, &j, A68_BYTES);
 382    POP_OBJECT (p, &i, A68_INT);
 383    PRELUDE_ERROR (VALUE (&i) < 1 || VALUE (&i) > BYTES_WIDTH, p, ERROR_OUT_OF_BOUNDS, M_INT);
 384    if (VALUE (&i) > (int) strlen (VALUE (&j))) {
 385      genie_null_char (p);
 386    } else {
 387      PUSH_VALUE (p, VALUE (&j)[VALUE (&i) - 1], A68_CHAR);
 388    }
 389  }
 390  
 391  //! @brief PROC bytes pack = (STRING) BYTES
 392  
 393  void genie_bytespack (NODE_T * p)
 394  {
 395    A68_REF z; A68_BYTES b;
 396    POP_REF (p, &z);
 397    CHECK_REF (p, z, M_STRING);
 398    PRELUDE_ERROR (a68_string_size (p, z) > BYTES_WIDTH, p, ERROR_OUT_OF_BOUNDS, M_STRING);
 399    STATUS (&b) = INIT_MASK;
 400    ASSERT (a_to_c_string (p, VALUE (&b), z) != NO_TEXT);
 401    PUSH_BYTES (p, VALUE (&b));
 402  }
 403  
 404  //! @brief PROC bytes pack = (STRING) BYTES
 405  
 406  void genie_add_bytes (NODE_T * p)
 407  {
 408    A68_BYTES *i, *j;
 409    POP_OPERAND_ADDRESSES (p, i, j, A68_BYTES);
 410    PRELUDE_ERROR (((int) strlen (VALUE (i)) + (int) strlen (VALUE (j))) > BYTES_WIDTH, p, ERROR_OUT_OF_BOUNDS, M_BYTES);
 411    bufcat (VALUE (i), VALUE (j), BYTES_WIDTH);
 412  }
 413  
 414  //! @brief OP +:= = (REF BYTES, BYTES) REF BYTES
 415  
 416  void genie_plusab_bytes (NODE_T * p)
 417  {
 418    genie_f_and_becomes (p, M_REF_BYTES, genie_add_bytes);
 419  }
 420  
 421  //! @brief OP +=: = (BYTES, REF BYTES) REF BYTES
 422  
 423  void genie_plusto_bytes (NODE_T * p)
 424  {
 425    A68_BYTES i, *address, j;
 426    A68_REF z;
 427    POP_REF (p, &z);
 428    CHECK_REF (p, z, M_REF_BYTES);
 429    address = DEREF (A68_BYTES, &z);
 430    CHECK_INIT (p, INITIALISED (address), M_BYTES);
 431    POP_OBJECT (p, &i, A68_BYTES);
 432    PRELUDE_ERROR (((int) strlen (VALUE (address)) + (int) strlen (VALUE (&i))) > BYTES_WIDTH, p, ERROR_OUT_OF_BOUNDS, M_BYTES);
 433    bufcpy (VALUE (&j), VALUE (&i), BYTES_WIDTH);
 434    bufcat (VALUE (&j), VALUE (address), BYTES_WIDTH);
 435    bufcpy (VALUE (address), VALUE (&j), BYTES_WIDTH);
 436    PUSH_REF (p, z);
 437  }
 438  
 439  //! @brief Difference between BYTE strings.
 440  
 441  int compare_bytes (NODE_T * p)
 442  {
 443    A68_BYTES x, y;
 444    POP_OBJECT (p, &y, A68_BYTES);
 445    POP_OBJECT (p, &x, A68_BYTES);
 446    return strcmp (VALUE (&x), VALUE (&y));
 447  }
 448  
 449  // OP (BYTES, BYTES) BOOL.
 450  
 451  #define A68_CMP_BYTES(n, OP)\
 452  void n (NODE_T * p) {\
 453    int k = compare_bytes (p);\
 454    PUSH_VALUE (p, (BOOL_T) (k OP 0), A68_BOOL);\
 455  }
 456  
 457  A68_CMP_BYTES (genie_eq_bytes, ==);
 458  A68_CMP_BYTES (genie_ne_bytes, !=);
 459  A68_CMP_BYTES (genie_lt_bytes, <);
 460  A68_CMP_BYTES (genie_gt_bytes, >);
 461  A68_CMP_BYTES (genie_le_bytes, <=);
 462  A68_CMP_BYTES (genie_ge_bytes, >=);
 463  
 464  //! @brief OP LENG = (BYTES) LONG BYTES
 465  
 466  void genie_leng_bytes (NODE_T * p)
 467  {
 468    A68_LONG_BYTES a;
 469    memset (VALUE (&a), 0, sizeof (VALUE (&a)));
 470    POP_OBJECT (p, (A68_BYTES *) &a, A68_BYTES);
 471    PUSH_LONG_BYTES (p, VALUE (&a));
 472  }
 473  
 474  //! @brief OP SHORTEN = (LONG BYTES) BYTES
 475  
 476  void genie_shorten_bytes (NODE_T * p)
 477  {
 478    A68_LONG_BYTES a;
 479    POP_OBJECT (p, &a, A68_LONG_BYTES);
 480    PRELUDE_ERROR (strlen (VALUE (&a)) >= BYTES_WIDTH, p, ERROR_OUT_OF_BOUNDS, M_BYTES);
 481    PUSH_BYTES (p, VALUE (&a));
 482  }
 483  
 484  //! @brief OP ELEM = (INT, LONG BYTES) CHAR
 485  
 486  void genie_elem_long_bytes (NODE_T * p)
 487  {
 488    A68_LONG_BYTES j; A68_INT i;
 489    POP_OBJECT (p, &j, A68_LONG_BYTES);
 490    POP_OBJECT (p, &i, A68_INT);
 491    PRELUDE_ERROR (VALUE (&i) < 1 || VALUE (&i) > LONG_BYTES_WIDTH, p, ERROR_OUT_OF_BOUNDS, M_INT);
 492    if (VALUE (&i) > (int) strlen (VALUE (&j))) {
 493      genie_null_char (p);
 494    } else {
 495      PUSH_VALUE (p, VALUE (&j)[VALUE (&i) - 1], A68_CHAR);
 496    }
 497  }
 498  
 499  //! @brief PROC long bytes pack = (STRING) LONG BYTES
 500  
 501  void genie_long_bytespack (NODE_T * p)
 502  {
 503    A68_REF z; A68_LONG_BYTES b;
 504    POP_REF (p, &z);
 505    CHECK_REF (p, z, M_STRING);
 506    PRELUDE_ERROR (a68_string_size (p, z) > LONG_BYTES_WIDTH, p, ERROR_OUT_OF_BOUNDS, M_STRING);
 507    STATUS (&b) = INIT_MASK;
 508    ASSERT (a_to_c_string (p, VALUE (&b), z) != NO_TEXT);
 509    PUSH_LONG_BYTES (p, VALUE (&b));
 510  }
 511  
 512  //! @brief OP + = (LONG BYTES, LONG BYTES) LONG BYTES
 513  
 514  void genie_add_long_bytes (NODE_T * p)
 515  {
 516    A68_LONG_BYTES *i, *j;
 517    POP_OPERAND_ADDRESSES (p, i, j, A68_LONG_BYTES);
 518    PRELUDE_ERROR (((int) strlen (VALUE (i)) + (int) strlen (VALUE (j))) > LONG_BYTES_WIDTH, p, ERROR_OUT_OF_BOUNDS, M_LONG_BYTES);
 519    bufcat (VALUE (i), VALUE (j), LONG_BYTES_WIDTH);
 520  }
 521  
 522  //! @brief OP +:= = (REF LONG BYTES, LONG BYTES) REF LONG BYTES
 523  
 524  void genie_plusab_long_bytes (NODE_T * p)
 525  {
 526    genie_f_and_becomes (p, M_REF_LONG_BYTES, genie_add_long_bytes);
 527  }
 528  
 529  //! @brief OP +=: = (LONG BYTES, REF LONG BYTES) REF LONG BYTES
 530  
 531  void genie_plusto_long_bytes (NODE_T * p)
 532  {
 533    A68_LONG_BYTES i, *address, j;
 534    A68_REF z;
 535    POP_REF (p, &z);
 536    CHECK_REF (p, z, M_REF_LONG_BYTES);
 537    address = DEREF (A68_LONG_BYTES, &z);
 538    CHECK_INIT (p, INITIALISED (address), M_LONG_BYTES);
 539    POP_OBJECT (p, &i, A68_LONG_BYTES);
 540    PRELUDE_ERROR (((int) strlen (VALUE (address)) + (int) strlen (VALUE (&i))) > LONG_BYTES_WIDTH, p, ERROR_OUT_OF_BOUNDS, M_LONG_BYTES);
 541    bufcpy (VALUE (&j), VALUE (&i), LONG_BYTES_WIDTH);
 542    bufcat (VALUE (&j), VALUE (address), LONG_BYTES_WIDTH);
 543    bufcpy (VALUE (address), VALUE (&j), LONG_BYTES_WIDTH);
 544    PUSH_REF (p, z);
 545  }
 546  
 547  //! @brief Difference between LONG BYTE strings.
 548  
 549  int compare_long_bytes (NODE_T * p)
 550  {
 551    A68_LONG_BYTES x, y;
 552    POP_OBJECT (p, &y, A68_LONG_BYTES);
 553    POP_OBJECT (p, &x, A68_LONG_BYTES);
 554    return strcmp (VALUE (&x), VALUE (&y));
 555  }
 556  
 557  // OP (LONG BYTES, LONG BYTES) BOOL.
 558  
 559  #define A68_CMP_LONG_BYTES(n, OP)\
 560    void n (NODE_T * p) {\
 561      int k = compare_long_bytes (p);\
 562      PUSH_VALUE (p, (BOOL_T) (k OP 0), A68_BOOL);\
 563    }
 564  
 565  A68_CMP_LONG_BYTES (genie_eq_long_bytes, ==);
 566  A68_CMP_LONG_BYTES (genie_ne_long_bytes, !=);
 567  A68_CMP_LONG_BYTES (genie_lt_long_bytes, <);
 568  A68_CMP_LONG_BYTES (genie_gt_long_bytes, >);
 569  A68_CMP_LONG_BYTES (genie_le_long_bytes, <=);
 570  A68_CMP_LONG_BYTES (genie_ge_long_bytes, >=);
 571  
 572  //! @brief PROC char in string = (CHAR, REF INT, STRING) BOOL
 573  
 574  void genie_char_in_string (NODE_T * p)
 575  {
 576    A68_REF ref_str; A68_ARRAY *arr; A68_TUPLE *tup;
 577    POP_REF (p, &ref_str);
 578    A68_ROW row = *(A68_REF *) &ref_str;
 579    CHECK_INIT (p, INITIALISED (&row), M_ROWS);
 580    GET_DESCRIPTOR (arr, tup, &row);
 581    A68_REF ref_pos; A68_INT pos;
 582    POP_REF (p, &ref_pos);
 583    A68_CHAR c;
 584    POP_OBJECT (p, &c, A68_CHAR);
 585    reset_transput_buffer (PATTERN_BUFFER);
 586    add_a_string_transput_buffer (p, PATTERN_BUFFER, (BYTE_T *) & ref_str);
 587    int len = get_transput_buffer_index (PATTERN_BUFFER);
 588    char *q = get_transput_buffer (PATTERN_BUFFER);
 589    char ch = (char) VALUE (&c);
 590    for (int k = 0; k < len; k++) {
 591      if (q[k] == ch) {
 592        STATUS (&pos) = INIT_MASK;
 593        VALUE (&pos) = k + LOWER_BOUND (tup);
 594        *DEREF (A68_INT, &ref_pos) = pos;
 595        PUSH_VALUE (p, A68_TRUE, A68_BOOL);
 596        return;
 597      }
 598    }
 599    PUSH_VALUE (p, A68_FALSE, A68_BOOL);
 600  }
 601  
 602  //! @brief PROC last char in string = (CHAR, REF INT, STRING) BOOL
 603  
 604  void genie_last_char_in_string (NODE_T * p)
 605  {
 606    A68_REF ref_str; A68_ARRAY *arr; A68_TUPLE *tup;
 607    POP_REF (p, &ref_str);
 608    A68_ROW row = *(A68_REF *) &ref_str;
 609    CHECK_INIT (p, INITIALISED (&row), M_ROWS);
 610    GET_DESCRIPTOR (arr, tup, &row);
 611    A68_REF ref_pos; A68_INT pos;
 612    POP_REF (p, &ref_pos);
 613    A68_CHAR c;
 614    POP_OBJECT (p, &c, A68_CHAR);
 615    reset_transput_buffer (PATTERN_BUFFER);
 616    add_a_string_transput_buffer (p, PATTERN_BUFFER, (BYTE_T *) & ref_str);
 617    int len = get_transput_buffer_index (PATTERN_BUFFER);
 618    char *q = get_transput_buffer (PATTERN_BUFFER);
 619    char ch = (char) VALUE (&c);
 620    for (int k = len - 1; k >= 0; k--) {
 621      if (q[k] == ch) {
 622        STATUS (&pos) = INIT_MASK;
 623        VALUE (&pos) = k + LOWER_BOUND (tup);
 624        *DEREF (A68_INT, &ref_pos) = pos;
 625        PUSH_VALUE (p, A68_TRUE, A68_BOOL);
 626        return;
 627      }
 628    }
 629    PUSH_VALUE (p, A68_FALSE, A68_BOOL);
 630  }
 631  
 632  //! @brief PROC string in string = (STRING, REF INT, STRING) BOOL
 633  
 634  void genie_string_in_string (NODE_T * p)
 635  {
 636    A68_REF ref_pos, ref_str, ref_pat; A68_ARRAY *arr; A68_TUPLE *tup;
 637    POP_REF (p, &ref_str);
 638    A68_ROW row = *(A68_REF *) &ref_str;
 639    CHECK_INIT (p, INITIALISED (&row), M_ROWS);
 640    GET_DESCRIPTOR (arr, tup, &row);
 641    POP_REF (p, &ref_pos);
 642    POP_REF (p, &ref_pat);
 643    reset_transput_buffer (PATTERN_BUFFER);
 644    reset_transput_buffer (STRING_BUFFER);
 645    add_a_string_transput_buffer (p, PATTERN_BUFFER, (BYTE_T *) & ref_pat);
 646    add_a_string_transput_buffer (p, STRING_BUFFER, (BYTE_T *) & ref_str);
 647    char *q = strstr (get_transput_buffer (STRING_BUFFER), get_transput_buffer (PATTERN_BUFFER));
 648    if (q != NO_TEXT) {
 649      if (!IS_NIL (ref_pos)) {
 650        A68_INT pos;
 651        STATUS (&pos) = INIT_MASK;
 652  // ANSI standard leaves pointer difference undefined.
 653        VALUE (&pos) = LOWER_BOUND (tup) + (int) get_transput_buffer_index (STRING_BUFFER) - (int) strlen (q);
 654        *DEREF (A68_INT, &ref_pos) = pos;
 655      }
 656      PUSH_VALUE (p, A68_TRUE, A68_BOOL);
 657    } else {
 658      PUSH_VALUE (p, A68_FALSE, A68_BOOL);
 659    }
 660  }
 661