rts-sounds.c

     
   1  //! @file rts-sounds.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  //! SOUND routines. 
  25  
  26  #include "a68g.h"
  27  #include "a68g-genie.h"
  28  #include "a68g-prelude.h"
  29  #include "a68g-mp.h"
  30  #include "a68g-physics.h"
  31  #include "a68g-numbers.h"
  32  #include "a68g-optimiser.h"
  33  #include "a68g-double.h"
  34  
  35  // Implementation of SOUND values.
  36  
  37  #define MAX_BYTES 4
  38  #define A68_LITTLE_ENDIAN A68_TRUE
  39  #define A68_BIG_ENDIAN A68_FALSE
  40  
  41  // From public Microsoft RIFF documentation.
  42  
  43  #define      WAVE_FORMAT_UNKNOWN             (0x0000)
  44  #define      WAVE_FORMAT_PCM                 (0x0001)
  45  #define      WAVE_FORMAT_ADPCM               (0x0002)
  46  #define WAVE_FORMAT_IEEE_FLOAT          (0x0003)
  47  #define WAVE_FORMAT_IBM_FORMAT_CVSD  (0x0005)
  48  #define      WAVE_FORMAT_ALAW                (0x0006)
  49  #define      WAVE_FORMAT_MULAW               (0x0007)
  50  #define      WAVE_FORMAT_OKI_ADPCM           (0x0010)
  51  #define WAVE_FORMAT_DVI_ADPCM                (0x0011)
  52  #define WAVE_FORMAT_MEDIASPACE_ADPCM (0x0012)
  53  #define WAVE_FORMAT_SIERRA_ADPCM     (0x0013)
  54  #define WAVE_FORMAT_G723_ADPCM               (0X0014)
  55  #define      WAVE_FORMAT_DIGISTD             (0x0015)
  56  #define      WAVE_FORMAT_DIGIFIX             (0x0016)
  57  #define WAVE_FORMAT_YAMAHA_ADPCM     (0x0020)
  58  #define WAVE_FORMAT_SONARC           (0x0021)
  59  #define WAVE_FORMAT_DSPGROUP_TRUESPEECH      (0x0022)
  60  #define WAVE_FORMAT_ECHOSCI1         (0x0023)
  61  #define WAVE_FORMAT_AUDIOFILE_AF36   (0x0024)
  62  #define WAVE_FORMAT_APTX             (0x0025)
  63  #define WAVE_FORMAT_AUDIOFILE_AF10   (0x0026)
  64  #define WAVE_FORMAT_DOLBY_AC2           (0x0030)
  65  #define WAVE_FORMAT_GSM610              (0x0031)
  66  #define WAVE_FORMAT_ANTEX_ADPCME     (0x0033)
  67  #define WAVE_FORMAT_CONTROL_RES_VQLPC        (0x0034)
  68  #define WAVE_FORMAT_DIGIREAL         (0x0035)
  69  #define WAVE_FORMAT_DIGIADPCM                (0x0036)
  70  #define WAVE_FORMAT_CONTROL_RES_CR10 (0x0037)
  71  #define WAVE_FORMAT_NMS_VBXADPCM     (0x0038)
  72  #define WAVE_FORMAT_ROCKWELL_ADPCM      (0x003b)
  73  #define WAVE_FORMAT_ROCKWELL_DIGITALK   (0x003c)
  74  #define WAVE_FORMAT_G721_ADPCM          (0x0040)
  75  #define WAVE_FORMAT_G728_CELP           (0x0041)
  76  #define WAVE_FORMAT_MPEG                (0x0050)
  77  #define WAVE_FORMAT_MPEGLAYER3          (0x0055)
  78  #define WAVE_FORMAT_G726_ADPCM          (0x0064)
  79  #define WAVE_FORMAT_G722_ADPCM          (0x0065)
  80  #define WAVE_FORMAT_IBM_FORMAT_MULAW (0x0101)
  81  #define WAVE_FORMAT_IBM_FORMAT_ALAW  (0x0102)
  82  #define WAVE_FORMAT_IBM_FORMAT_ADPCM (0x0103)
  83  #define WAVE_FORMAT_CREATIVE_ADPCM   (0x0200)
  84  #define WAVE_FORMAT_FM_TOWNS_SND     (0x0300)
  85  #define WAVE_FORMAT_OLIGSM           (0x1000)
  86  #define WAVE_FORMAT_OLIADPCM         (0x1001)
  87  #define WAVE_FORMAT_OLICELP          (0x1002)
  88  #define WAVE_FORMAT_OLISBC           (0x1003)
  89  #define WAVE_FORMAT_OLIOPR           (0x1004)
  90  #define WAVE_FORMAT_EXTENSIBLE          (0xfffe)
  91  
  92  static unt pow256[] = { 1, 256, 65536, 16777216 };
  93  
  94  //! @brief Test bits per sample.
  95  
  96  void test_bits_per_sample (NODE_T * p, unt bps)
  97  {
  98    if (bps <= 0 || bps > 24) {
  99      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "unsupported number of bits per sample");
 100      exit_genie (p, A68_RUNTIME_ERROR);
 101    }
 102  }
 103  
 104  //! @brief Code string into big-endian unt.
 105  
 106  unt code_string (NODE_T * p, char *s, int n)
 107  {
 108    unt v;
 109    int k, m;
 110    if (n > MAX_BYTES) {
 111      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "too long word length");
 112      exit_genie (p, A68_RUNTIME_ERROR);
 113    }
 114    for (k = 0, m = n - 1, v = 0; k < n; k++, m--) {
 115      v += ((unt) s[k]) * pow256[m];
 116    } return v;
 117  }
 118  
 119  //! @brief Code unt into string.
 120  
 121  char *code_unt (NODE_T * p, unt n)
 122  {
 123    static char text[MAX_BYTES + 1];
 124    int k;
 125    (void) p;
 126    for (k = 0; k < MAX_BYTES; k++) {
 127      char ch = (char) (n % 0x100);
 128      if (ch == NULL_CHAR) {
 129        ch = BLANK_CHAR;
 130      } else if (ch < BLANK_CHAR) {
 131        ch = '?';
 132      }
 133      text[MAX_BYTES - k - 1] = ch;
 134      n >>= 8;
 135    }
 136    text[MAX_BYTES] = NULL_CHAR;
 137    return text;
 138  }
 139  
 140  //! @brief WAVE format category
 141  
 142  char *format_category (unt n)
 143  {
 144    switch (n) {
 145    case WAVE_FORMAT_UNKNOWN:
 146      {
 147        return "WAVE_FORMAT_UNKNOWN";
 148      }
 149    case WAVE_FORMAT_PCM:
 150      {
 151        return "WAVE_FORMAT_PCM       ";
 152      }
 153    case WAVE_FORMAT_ADPCM:
 154      {
 155        return "WAVE_FORMAT_ADPCM";
 156      }
 157    case WAVE_FORMAT_IEEE_FLOAT:
 158      {
 159        return "WAVE_FORMAT_IEEE_FLOAT";
 160      }
 161    case WAVE_FORMAT_IBM_FORMAT_CVSD:
 162      {
 163        return "WAVE_FORMAT_IBM_FORMAT_CVSD";
 164      }
 165    case WAVE_FORMAT_ALAW:
 166      {
 167        return "WAVE_FORMAT_ALAW";
 168      }
 169    case WAVE_FORMAT_MULAW:
 170      {
 171        return "WAVE_FORMAT_MULAW";
 172      }
 173    case WAVE_FORMAT_OKI_ADPCM:
 174      {
 175        return "WAVE_FORMAT_OKI_ADPCM";
 176      }
 177    case WAVE_FORMAT_DVI_ADPCM:
 178      {
 179        return "WAVE_FORMAT_DVI_ADPCM";
 180      }
 181    case WAVE_FORMAT_MEDIASPACE_ADPCM:
 182      {
 183        return "WAVE_FORMAT_MEDIASPACE_ADPCM";
 184      }
 185    case WAVE_FORMAT_SIERRA_ADPCM:
 186      {
 187        return "WAVE_FORMAT_SIERRA_ADPCM";
 188      }
 189    case WAVE_FORMAT_G723_ADPCM:
 190      {
 191        return "WAVE_FORMAT_G723_ADPCM";
 192      }
 193    case WAVE_FORMAT_DIGISTD:
 194      {
 195        return "WAVE_FORMAT_DIGISTD";
 196      }
 197    case WAVE_FORMAT_DIGIFIX:
 198      {
 199        return "WAVE_FORMAT_DIGIFIX";
 200      }
 201    case WAVE_FORMAT_YAMAHA_ADPCM:
 202      {
 203        return "WAVE_FORMAT_YAMAHA_ADPCM";
 204      }
 205    case WAVE_FORMAT_SONARC:
 206      {
 207        return "WAVE_FORMAT_SONARC";
 208      }
 209    case WAVE_FORMAT_DSPGROUP_TRUESPEECH:
 210      {
 211        return "WAVE_FORMAT_DSPGROUP_TRUESPEECH";
 212      }
 213    case WAVE_FORMAT_ECHOSCI1:
 214      {
 215        return "WAVE_FORMAT_ECHOSCI1";
 216      }
 217    case WAVE_FORMAT_AUDIOFILE_AF36:
 218      {
 219        return "WAVE_FORMAT_AUDIOFILE_AF36";
 220      }
 221    case WAVE_FORMAT_APTX:
 222      {
 223        return "WAVE_FORMAT_APTX";
 224      }
 225    case WAVE_FORMAT_AUDIOFILE_AF10:
 226      {
 227        return "WAVE_FORMAT_AUDIOFILE_AF10";
 228      }
 229    case WAVE_FORMAT_DOLBY_AC2:
 230      {
 231        return "WAVE_FORMAT_DOLBY_AC2";
 232      }
 233    case WAVE_FORMAT_GSM610:
 234      {
 235        return "WAVE_FORMAT_GSM610 ";
 236      }
 237    case WAVE_FORMAT_ANTEX_ADPCME:
 238      {
 239        return "WAVE_FORMAT_ANTEX_ADPCME";
 240      }
 241    case WAVE_FORMAT_CONTROL_RES_VQLPC:
 242      {
 243        return "WAVE_FORMAT_CONTROL_RES_VQLPC";
 244      }
 245    case WAVE_FORMAT_DIGIREAL:
 246      {
 247        return "WAVE_FORMAT_DIGIREAL";
 248      }
 249    case WAVE_FORMAT_DIGIADPCM:
 250      {
 251        return "WAVE_FORMAT_DIGIADPCM";
 252      }
 253    case WAVE_FORMAT_CONTROL_RES_CR10:
 254      {
 255        return "WAVE_FORMAT_CONTROL_RES_CR10";
 256      }
 257    case WAVE_FORMAT_NMS_VBXADPCM:
 258      {
 259        return "WAVE_FORMAT_NMS_VBXADPCM";
 260      }
 261    case WAVE_FORMAT_ROCKWELL_ADPCM:
 262      {
 263        return "WAVE_FORMAT_ROCKWELL_ADPCM";
 264      }
 265    case WAVE_FORMAT_ROCKWELL_DIGITALK:
 266      {
 267        return "WAVE_FORMAT_ROCKWELL_DIGITALK";
 268      }
 269    case WAVE_FORMAT_G721_ADPCM:
 270      {
 271        return "WAVE_FORMAT_G721_ADPCM";
 272      }
 273    case WAVE_FORMAT_G728_CELP:
 274      {
 275        return "WAVE_FORMAT_G728_CELP";
 276      }
 277    case WAVE_FORMAT_MPEG:
 278      {
 279        return "WAVE_FORMAT_MPEG";
 280      }
 281    case WAVE_FORMAT_MPEGLAYER3:
 282      {
 283        return "WAVE_FORMAT_MPEGLAYER3";
 284      }
 285    case WAVE_FORMAT_G726_ADPCM:
 286      {
 287        return "WAVE_FORMAT_G726_ADPCM";
 288      }
 289    case WAVE_FORMAT_G722_ADPCM:
 290      {
 291        return "WAVE_FORMAT_G722_ADPCM";
 292      }
 293    case WAVE_FORMAT_IBM_FORMAT_MULAW:
 294      {
 295        return "WAVE_FORMAT_IBM_FORMAT_MULAW";
 296      }
 297    case WAVE_FORMAT_IBM_FORMAT_ALAW:
 298      {
 299        return "WAVE_FORMAT_IBM_FORMAT_ALAW";
 300      }
 301    case WAVE_FORMAT_IBM_FORMAT_ADPCM:
 302      {
 303        return "WAVE_FORMAT_IBM_FORMAT_ADPCM";
 304      }
 305    case WAVE_FORMAT_CREATIVE_ADPCM:
 306      {
 307        return "WAVE_FORMAT_CREATIVE_ADPCM";
 308      }
 309    case WAVE_FORMAT_FM_TOWNS_SND:
 310      {
 311        return "WAVE_FORMAT_FM_TOWNS_SND";
 312      }
 313    case WAVE_FORMAT_OLIGSM:
 314      {
 315        return "WAVE_FORMAT_OLIGSM";
 316      }
 317    case WAVE_FORMAT_OLIADPCM:
 318      {
 319        return "WAVE_FORMAT_OLIADPCM";
 320      }
 321    case WAVE_FORMAT_OLICELP:
 322      {
 323        return "WAVE_FORMAT_OLICELP";
 324      }
 325    case WAVE_FORMAT_OLISBC:
 326      {
 327        return "WAVE_FORMAT_OLISBC";
 328      }
 329    case WAVE_FORMAT_OLIOPR:
 330      {
 331        return "WAVE_FORMAT_OLIOPR";
 332      }
 333    case WAVE_FORMAT_EXTENSIBLE:
 334      {
 335        return "WAVE_FORMAT_EXTENSIBLE";
 336      }
 337    default:
 338      {
 339        return "other";
 340      }
 341    }
 342  }
 343  
 344  //! @brief Read RIFF item.
 345  
 346  unt read_riff_item (NODE_T * p, FILE_T fd, int n, BOOL_T little)
 347  {
 348    unt v, z;
 349    int k, m, r;
 350    if (n > MAX_BYTES) {
 351      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "too long word length");
 352      exit_genie (p, A68_RUNTIME_ERROR);
 353    }
 354    if (little) {
 355      for (k = 0, m = 0, v = 0; k < n; k++, m++) {
 356        z = 0;
 357        errno = 0;
 358        r = (int) io_read (fd, &z, (size_t) 1);
 359        if (r != 1 || errno != 0) {
 360          diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "error while reading file");
 361          exit_genie (p, A68_RUNTIME_ERROR);
 362        }
 363        v += z * pow256[m];
 364      }
 365    } else {
 366      for (k = 0, m = n - 1, v = 0; k < n; k++, m--) {
 367        z = 0;
 368        errno = 0;
 369        r = (int) io_read (fd, &z, (size_t) 1);
 370        if (r != 1 || errno != 0) {
 371          diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "error while reading file");
 372          exit_genie (p, A68_RUNTIME_ERROR);
 373        }
 374        v += z * pow256[m];
 375      }
 376    }
 377    return v;
 378  }
 379  
 380  //! @brief Read sound from file.
 381  
 382  void read_sound (NODE_T * p, A68_REF ref_file, A68_SOUND * w)
 383  {
 384    A68_FILE *f = FILE_DEREF (&ref_file);
 385    int r;
 386    unt fmt_cat;
 387    unt blockalign, byterate, chunksize, subchunk2size, z;
 388    BOOL_T data_read = A68_FALSE;
 389    if (read_riff_item (p, FD (f), 4, A68_BIG_ENDIAN) != code_string (p, "RIFF", 4)) {
 390      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "file format is not RIFF");
 391      exit_genie (p, A68_RUNTIME_ERROR);
 392    }
 393    chunksize = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
 394    if ((z = read_riff_item (p, FD (f), 4, A68_BIG_ENDIAN)) != code_string (p, "WAVE", 4)) {
 395      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL_STRING, M_SOUND, "file format is not \"WAVE\" but", code_unt (p, z));
 396      exit_genie (p, A68_RUNTIME_ERROR);
 397    }
 398  // Now read chunks.
 399    while (data_read == A68_FALSE) {
 400      z = read_riff_item (p, FD (f), 4, A68_BIG_ENDIAN);
 401      if (z == code_string (p, "fmt ", 4)) {
 402  // Read fmt chunk.
 403        int k, skip;
 404        z = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
 405        skip = (int) z - 0x10;    // Bytes to skip in extended wave format
 406        fmt_cat = read_riff_item (p, FD (f), 2, A68_LITTLE_ENDIAN);
 407        if (fmt_cat != WAVE_FORMAT_PCM) {
 408          diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL_STRING, M_SOUND, "category is not WAVE_FORMAT_PCM but", format_category (fmt_cat));
 409          exit_genie (p, A68_RUNTIME_ERROR);
 410        }
 411        NUM_CHANNELS (w) = read_riff_item (p, FD (f), 2, A68_LITTLE_ENDIAN);
 412        SAMPLE_RATE (w) = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
 413        byterate = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
 414        blockalign = read_riff_item (p, FD (f), 2, A68_LITTLE_ENDIAN);
 415        BITS_PER_SAMPLE (w) = read_riff_item (p, FD (f), 2, A68_LITTLE_ENDIAN);
 416        test_bits_per_sample (p, BITS_PER_SAMPLE (w));
 417        for (k = 0; k < skip; k++) {
 418          z = read_riff_item (p, FD (f), 1, A68_LITTLE_ENDIAN);
 419        }
 420      } else if (z == code_string (p, "LIST", 4)) {
 421  // Skip a LIST chunk.
 422        int k, skip;
 423        z = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
 424        skip = (int) z;
 425        for (k = 0; k < skip; k++) {
 426          z = read_riff_item (p, FD (f), 1, A68_LITTLE_ENDIAN);
 427        }
 428      } else if (z == code_string (p, "cue ", 4)) {
 429  // Skip a cue chunk.
 430        int k, skip;
 431        z = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
 432        skip = (int) z;
 433        for (k = 0; k < skip; k++) {
 434          z = read_riff_item (p, FD (f), 1, A68_LITTLE_ENDIAN);
 435        }
 436      } else if (z == code_string (p, "fact", 4)) {
 437  // Skip a fact chunk.
 438        int k, skip;
 439        z = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
 440        skip = (int) z;
 441        for (k = 0; k < skip; k++) {
 442          z = read_riff_item (p, FD (f), 1, A68_LITTLE_ENDIAN);
 443        }
 444      } else if (z == code_string (p, "data", 4)) {
 445  // Read data chunk.
 446        subchunk2size = read_riff_item (p, FD (f), 4, A68_LITTLE_ENDIAN);
 447        NUM_SAMPLES (w) = subchunk2size / NUM_CHANNELS (w) / (unt) A68_SOUND_BYTES (w);
 448        DATA (w) = heap_generator (p, M_SOUND_DATA, (int) subchunk2size);
 449        r = (int) io_read (FD (f), ADDRESS (&(DATA (w))), subchunk2size);
 450        if (r != (int) subchunk2size) {
 451          diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "cannot read all of the data");
 452          exit_genie (p, A68_RUNTIME_ERROR);
 453        }
 454        data_read = A68_TRUE;
 455      } else {
 456        diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL_STRING, M_SOUND, "chunk is", code_unt (p, z));
 457        exit_genie (p, A68_RUNTIME_ERROR);
 458      }
 459    }
 460    (void) blockalign;
 461    (void) byterate;
 462    (void) chunksize;
 463    (void) subchunk2size;
 464    STATUS (w) = INIT_MASK;
 465  }
 466  
 467  //! @brief Write RIFF item.
 468  
 469  void write_riff_item (NODE_T * p, FILE_T fd, unt z, int n, BOOL_T little)
 470  {
 471    int k, r;
 472    unt char y[MAX_BYTES];
 473    if (n > MAX_BYTES) {
 474      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "too long word length");
 475      exit_genie (p, A68_RUNTIME_ERROR);
 476    }
 477    for (k = 0; k < n; k++) {
 478      y[k] = (unt char) (z & 0xff);
 479      z >>= 8;
 480    }
 481    if (little) {
 482      for (k = 0; k < n; k++) {
 483        ASSERT (io_write (fd, &(y[k]), 1) != -1);
 484      }
 485    } else {
 486      for (k = n - 1; k >= 0; k--) {
 487        r = (int) io_write (fd, &(y[k]), 1);
 488        if (r != 1) {
 489          diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "error while writing file");
 490          exit_genie (p, A68_RUNTIME_ERROR);
 491        }
 492      }
 493    }
 494  }
 495  
 496  //! @brief Write sound to file.
 497  
 498  void write_sound (NODE_T * p, A68_REF ref_file, A68_SOUND * w)
 499  {
 500    A68_FILE *f = FILE_DEREF (&ref_file);
 501    int r;
 502    unt blockalign = NUM_CHANNELS (w) * (unt) (A68_SOUND_BYTES (w));
 503    unt byterate = SAMPLE_RATE (w) * blockalign;
 504    unt subchunk2size = NUM_SAMPLES (w) * blockalign;
 505    unt chunksize = 4 + (8 + 16) + (8 + subchunk2size);
 506    write_riff_item (p, FD (f), code_string (p, "RIFF", 4), 4, A68_BIG_ENDIAN);
 507    write_riff_item (p, FD (f), chunksize, 4, A68_LITTLE_ENDIAN);
 508    write_riff_item (p, FD (f), code_string (p, "WAVE", 4), 4, A68_BIG_ENDIAN);
 509    write_riff_item (p, FD (f), code_string (p, "fmt ", 4), 4, A68_BIG_ENDIAN);
 510    write_riff_item (p, FD (f), 16, 4, A68_LITTLE_ENDIAN);
 511    write_riff_item (p, FD (f), 1, 2, A68_LITTLE_ENDIAN);
 512    write_riff_item (p, FD (f), NUM_CHANNELS (w), 2, A68_LITTLE_ENDIAN);
 513    write_riff_item (p, FD (f), SAMPLE_RATE (w), 4, A68_LITTLE_ENDIAN);
 514    write_riff_item (p, FD (f), byterate, 4, A68_LITTLE_ENDIAN);
 515    write_riff_item (p, FD (f), blockalign, 2, A68_LITTLE_ENDIAN);
 516    write_riff_item (p, FD (f), BITS_PER_SAMPLE (w), 2, A68_LITTLE_ENDIAN);
 517    write_riff_item (p, FD (f), code_string (p, "data", 4), 4, A68_BIG_ENDIAN);
 518    write_riff_item (p, FD (f), subchunk2size, 4, A68_LITTLE_ENDIAN);
 519    if (IS_NIL (DATA (w))) {
 520      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sound has no data");
 521      exit_genie (p, A68_RUNTIME_ERROR);
 522    }
 523    r = (int) io_write (FD (f), ADDRESS (&(DATA (w))), subchunk2size);
 524    if (r != (int) subchunk2size) {
 525      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "error while writing file");
 526      exit_genie (p, A68_RUNTIME_ERROR);
 527    }
 528  }
 529  
 530  //! @brief PROC new sound = (INT bits, INT sample rate, INT channels, INT samples) SOUND
 531  
 532  void genie_new_sound (NODE_T * p)
 533  {
 534    A68_INT num_channels, sample_rate, bits_per_sample, num_samples;
 535    A68_SOUND w;
 536    POP_OBJECT (p, &num_samples, A68_INT);
 537    POP_OBJECT (p, &num_channels, A68_INT);
 538    POP_OBJECT (p, &sample_rate, A68_INT);
 539    POP_OBJECT (p, &bits_per_sample, A68_INT);
 540    NUM_SAMPLES (&w) = (unt) (VALUE (&num_samples));
 541    NUM_CHANNELS (&w) = (unt) (VALUE (&num_channels));
 542    SAMPLE_RATE (&w) = (unt) (VALUE (&sample_rate));
 543    BITS_PER_SAMPLE (&w) = (unt) (VALUE (&bits_per_sample));
 544    test_bits_per_sample (p, BITS_PER_SAMPLE (&w));
 545    DATA_SIZE (&w) = (unt) A68_SOUND_DATA_SIZE (&w);
 546    DATA (&w) = heap_generator (p, M_SOUND_DATA, (int) DATA_SIZE (&w) * sizeof (unt));
 547    STATUS (&w) = INIT_MASK;
 548    PUSH_OBJECT (p, w, A68_SOUND);
 549  }
 550  
 551  //! @brief PROC get sound = (SOUND w, INT channel, sample) INT
 552  
 553  void genie_get_sound (NODE_T * p)
 554  {
 555    A68_INT channel, sample;
 556    A68_SOUND w;
 557    int addr, k, n, z, m;
 558    BYTE_T *d;
 559    POP_OBJECT (p, &sample, A68_INT);
 560    POP_OBJECT (p, &channel, A68_INT);
 561    POP_OBJECT (p, &w, A68_SOUND);
 562    if (!(VALUE (&channel) >= 1 && VALUE (&channel) <= (int) NUM_CHANNELS (&w))) {
 563      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "channel index out of range");
 564      exit_genie (p, A68_RUNTIME_ERROR);
 565    }
 566    if (!(VALUE (&sample) >= 1 && VALUE (&sample) <= (int) NUM_SAMPLES (&w))) {
 567      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sample index out of range");
 568      exit_genie (p, A68_RUNTIME_ERROR);
 569    }
 570    if (IS_NIL (DATA (&w))) {
 571      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sound has no data");
 572      exit_genie (p, A68_RUNTIME_ERROR);
 573    }
 574    n = A68_SOUND_BYTES (&w);
 575    addr = ((VALUE (&sample) - 1) * (int) (NUM_CHANNELS (&w)) + (VALUE (&channel) - 1)) * n;
 576    ABEND (addr < 0 || addr >= (int) DATA_SIZE (&w), ERROR_INTERNAL_CONSISTENCY, __func__);
 577    d = &(ADDRESS (&(DATA (&w)))[addr]);
 578  // Convert from little-endian, irrespective from the platform we work on.
 579    for (k = 0, z = 0, m = 0; k < n; k++) {
 580      z += ((int) (d[k]) * (int) (pow256[k]));
 581      m = k;
 582    }
 583    PUSH_VALUE (p, (d[m] & 0x80 ? (n == 4 ? z : z - (int) pow256[m + 1]) : z), A68_INT);
 584  }
 585  
 586  //! @brief PROC set sound = (SOUND w, INT channel, sample, value) VOID
 587  
 588  void genie_set_sound (NODE_T * p)
 589  {
 590    A68_INT channel, sample, value;
 591    int addr, k, n, z;
 592    BYTE_T *d;
 593    A68_SOUND w;
 594    POP_OBJECT (p, &value, A68_INT);
 595    POP_OBJECT (p, &sample, A68_INT);
 596    POP_OBJECT (p, &channel, A68_INT);
 597    POP_OBJECT (p, &w, A68_SOUND);
 598    if (!(VALUE (&channel) >= 1 && VALUE (&channel) <= (int) NUM_CHANNELS (&w))) {
 599      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "channel index out of range");
 600      exit_genie (p, A68_RUNTIME_ERROR);
 601    }
 602    if (!(VALUE (&sample) >= 1 && VALUE (&sample) <= (int) NUM_SAMPLES (&w))) {
 603      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sample index out of range");
 604      exit_genie (p, A68_RUNTIME_ERROR);
 605    }
 606    if (IS_NIL (DATA (&w))) {
 607      diagnostic (A68_RUNTIME_ERROR, p, ERROR_SOUND_INTERNAL, M_SOUND, "sound has no data");
 608      exit_genie (p, A68_RUNTIME_ERROR);
 609    }
 610    n = A68_SOUND_BYTES (&w);
 611    addr = ((VALUE (&sample) - 1) * (int) (NUM_CHANNELS (&w)) + (VALUE (&channel) - 1)) * n;
 612    ABEND (addr < 0 || addr >= (int) DATA_SIZE (&w), ERROR_INTERNAL_CONSISTENCY, __func__);
 613    d = &(ADDRESS (&(DATA (&w)))[addr]);
 614  // Convert to little-endian.
 615    for (k = 0, z = VALUE (&value); k < n; k++) {
 616      d[k] = (BYTE_T) (z & 0xff);
 617      z >>= 8;
 618    }
 619  }
 620  
 621  //! @brief OP SOUND = (SOUND) INT
 622  
 623  void genie_sound_samples (NODE_T * p)
 624  {
 625    A68_SOUND w;
 626    POP_OBJECT (p, &w, A68_SOUND);
 627    PUSH_VALUE (p, (int) (NUM_SAMPLES (&w)), A68_INT);
 628  }
 629  
 630  //! @brief OP RATE = (SOUND) INT
 631  
 632  void genie_sound_rate (NODE_T * p)
 633  {
 634    A68_SOUND w;
 635    POP_OBJECT (p, &w, A68_SOUND);
 636    PUSH_VALUE (p, (int) (SAMPLE_RATE (&w)), A68_INT);
 637  }
 638  
 639  //! @brief OP CHANNELS = (SOUND) INT
 640  
 641  void genie_sound_channels (NODE_T * p)
 642  {
 643    A68_SOUND w;
 644    POP_OBJECT (p, &w, A68_SOUND);
 645    PUSH_VALUE (p, (int) (NUM_CHANNELS (&w)), A68_INT);
 646  }
 647  
 648  //! @brief OP RESOLUTION = (SOUND) INT
 649  
 650  void genie_sound_resolution (NODE_T * p)
 651  {
 652    A68_SOUND w;
 653    POP_OBJECT (p, &w, A68_SOUND);
 654    PUSH_VALUE (p, (int) (BITS_PER_SAMPLE (&w)), A68_INT);
 655  }