← Back to branch summary

~ubuntu-branches/ubuntu/precise/csound/precise

« back to all changes in this revision

Viewing changes to Engine/rdorch.c

  • Committer: Package Import Robot
  • Author(s): Felipe Sateler
  • Date: 2012-04-19 09:26:46 UTC
  • mfrom: (3.2.19 sid)
  • Revision ID: package-import@ubuntu.com-20120419092646-96xbj1n6atuqosk2
Tags: 1:5.17.6~dfsg-1
* New upstream release
 - Do not build the wiimote opcodes (we need wiiuse).
* Add new API function to symbols file
* Disable lua opcodes, they were broken. Requires OpenMP to be enabled.
* Backport fixes from upstream:
  - Link dssi4cs with dl. Backport
  - Fix building of CsoundAC

Show diffs side-by-side

added added

removed removed

Lines of Context:
Engine/rdorch.c
1
1
/*
2
 
    rdorch.c:
3
 
 
4
 
    Copyright (C) 1991-2002 Barry Vercoe, John ffitch, Istvan Varga
5
 
 
6
 
    This file is part of Csound.
7
 
 
8
 
    The Csound Library is free software; you can redistribute it
9
 
    and/or modify it under the terms of the GNU Lesser General Public
10
 
    License as published by the Free Software Foundation; either
11
 
    version 2.1 of the License, or (at your option) any later version.
12
 
 
13
 
    Csound is distributed in the hope that it will be useful,
14
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
15
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16
 
    GNU Lesser General Public License for more details.
17
 
 
18
 
    You should have received a copy of the GNU Lesser General Public
19
 
    License along with Csound; if not, write to the Free Software
20
 
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21
 
    02111-1307 USA
 
2
  rdorch.c:
 
3
 
 
4
  Copyright (C) 1991-2002 Barry Vercoe, John ffitch, Istvan Varga
 
5
 
 
6
  This file is part of Csound.
 
7
 
 
8
  The Csound Library is free software; you can redistribute it
 
9
  and/or modify it under the terms of the GNU Lesser General Public
 
10
  License as published by the Free Software Foundation; either
 
11
  version 2.1 of the License, or (at your option) any later version.
 
12
 
 
13
  Csound is distributed in the hope that it will be useful,
 
14
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
16
  GNU Lesser General Public License for more details.
 
17
 
 
18
  You should have received a copy of the GNU Lesser General Public
 
19
  License along with Csound; if not, write to the Free Software
 
20
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
 
21
  02111-1307 USA
22
22
*/
23
23
 
24
24
#include "csoundCore.h"         /*                      RDORCH.C        */
27
27
#include "typetabl.h"   /* IV - Oct 31 2002 */
28
28
#include "envvar.h"
29
29
#include <stddef.h>
 
30
#include "corfile.h"
30
31
 
31
32
#ifdef sun
32
33
#define   SEEK_SET        0
39
40
#define GRPMAX    VARGMAX
40
41
#define LBLMAX    100
41
42
 
 
43
//#define MACDEBUG (1)
 
44
 
42
45
typedef struct  {
43
 
        int     reqline;
44
 
        char    *label;
 
46
  int     reqline;
 
47
  char    *label;
45
48
} LBLREQ;
46
49
 
47
50
#define MARGS   (3)
48
51
 
49
52
typedef struct MACRO {          /* To store active macros */
50
 
    char          *name;        /* Use is by name */
51
 
    int           acnt;         /* Count of arguments */
52
 
    char          *body;        /* The text of the macro */
53
 
    struct MACRO  *next;        /* Chain of active macros */
54
 
    int           margs;        /* amount of space for args */
55
 
    char          *arg[MARGS];  /* With these arguments */
 
53
  char          *name;        /* Use is by name */
 
54
  int           acnt;         /* Count of arguments */
 
55
  char          *body;        /* The text of the macro */
 
56
  struct MACRO  *next;        /* Chain of active macros */
 
57
  int           margs;        /* amount of space for args */
 
58
  char          *arg[MARGS];  /* With these arguments */
56
59
} MACRO;
57
60
 
58
61
typedef struct in_stack {
59
 
    int16   string;
60
 
    int16   args;
61
 
    char    *body;
62
 
    FILE    *file;
63
 
    void    *fd;
64
 
    MACRO   *mac;
65
 
    int     line;
66
 
    int     unget_cnt;
67
 
    char    unget_buf[128];
 
62
  int16   string;
 
63
  int16   args;
 
64
  char    *body;
 
65
  FILE    *file;
 
66
  void    *fd;
 
67
  MACRO   *mac;
 
68
  int     line;
 
69
  int     unget_cnt;
 
70
  char    unget_buf[128];
68
71
} IN_STACK;
69
72
 
70
73
typedef struct iflabel {            /* for if/else/endif */
71
 
    char    els[256];
72
 
    char    end[256];
73
 
    /* is the conditional valid at i-time ? 0: no, 1: yes, -1: unknown */
74
 
    int     ithen;
75
 
    struct  iflabel *prv;
 
74
  char    els[256];
 
75
  char    end[256];
 
76
  /* is the conditional valid at i-time ? 0: no, 1: yes, -1: unknown */
 
77
  int     ithen;
 
78
  struct  iflabel *prv;
76
79
} IFLABEL;
77
80
 
78
81
typedef struct IFDEFSTACK_ {
79
 
    struct IFDEFSTACK_  *prv;
80
 
    unsigned char   isDef;      /* non-zero if #ifdef is true, or #ifndef   */
81
 
                                /*   is false                               */
82
 
    unsigned char   isElse;     /* non-zero between #else and #endif        */
83
 
    unsigned char   isSkip;     /* sum of: 1: skipping code due to this     */
84
 
                                /*   #ifdef, 2: skipping due to parent      */
 
82
  struct IFDEFSTACK_  *prv;
 
83
  unsigned char   isDef;      /* non-zero if #ifdef is true, or #ifndef   */
 
84
  /*   is false                               */
 
85
  unsigned char   isElse;     /* non-zero between #else and #endif        */
 
86
  unsigned char   isSkip;     /* sum of: 1: skipping code due to this     */
 
87
  /*   #ifdef, 2: skipping due to parent      */
85
88
} IFDEFSTACK;
86
89
 
87
90
typedef struct {
88
 
    MACRO   *macros;
89
 
    int32    lenmax /* = LENMAX */;  /* Length of input line buffer  */
90
 
    char    *ortext;
91
 
    char    **linadr;               /* adr of each line in text     */
92
 
    int     curline;                /* current line being examined  */
93
 
    char    *collectbuf;            /* splitline collect buffer     */
94
 
    char    **group;                /* splitline local storage      */
95
 
    char    **grpsav;               /* copy of above                */
96
 
    int32    grpmax /* = GRPMAX */;  /* Size of group structure      */
97
 
    int     opgrpno;                /* grpno identified as opcode   */
98
 
    int     linopnum;               /* data for opcode in this line */
99
 
    char    *linopcod;
100
 
    int     linlabels;              /* count of labels this line    */
101
 
    LBLREQ  *lblreq;
102
 
    int     lblmax;
103
 
    int     lblcnt;
104
 
    int     lgprevdef;
105
 
    int     opnum;                  /* opcod data carriers          */
106
 
    char    *opcod;                 /*  (line or subline)           */
107
 
    ARGLST  *nxtarglist, *nullist;
108
 
    IN_STACK  *inputs, *str;
109
 
    FILE    *fp;
110
 
    void    *fd;
111
 
    int     input_size, input_cnt;
112
 
    int     pop;                    /* Number of macros to pop      */
113
 
    int     ingappop /* = 1 */;
114
 
    int     linepos /* = -1 */;
115
 
    int32    *typemask_tabl;
116
 
    int32    *typemask_tabl_in, *typemask_tabl_out;
117
 
    int32    orchsiz;
118
 
    IFLABEL *iflabels;
119
 
    int     repeatingElseifLine;
120
 
    int32    tempNum /* = 300L */;
121
 
    int     repeatingElseLine;
122
 
    int16   grpcnt, nxtest /* = 1 */;
123
 
    int16   xprtstno, polcnt;
124
 
    int16   instrblk, instrcnt;
125
 
    int16   opcodblk;               /* IV - Sep 8 2002 */
126
 
    int16   opcodflg;               /* 1: xin, 2: xout, 4: setksmps */
127
 
    IFDEFSTACK  *ifdefStack;
128
 
    TEXT    optext;                 /* struct to be passed back to caller */
 
91
  MACRO   *macros;
 
92
  int32    lenmax /* = LENMAX */;  /* Length of input line buffer  */
 
93
  char    *ortext;
 
94
  char    **linadr;               /* adr of each line in text     */
 
95
  int     curline;                /* current line being examined  */
 
96
  char    *collectbuf;            /* splitline collect buffer     */
 
97
  char    **group;                /* splitline local storage      */
 
98
  char    **grpsav;               /* copy of above                */
 
99
  int32    grpmax /* = GRPMAX */;  /* Size of group structure      */
 
100
  int     opgrpno;                /* grpno identified as opcode   */
 
101
  int     linopnum;               /* data for opcode in this line */
 
102
  char    *linopcod;
 
103
  int     linlabels;              /* count of labels this line    */
 
104
  LBLREQ  *lblreq;
 
105
  int     lblmax;
 
106
  int     lblcnt;
 
107
  int     lgprevdef;
 
108
  int     opnum;                  /* opcod data carriers          */
 
109
  char    *opcod;                 /*  (line or subline)           */
 
110
  ARGLST  *nxtarglist, *nullist;
 
111
  IN_STACK  *inputs, *str;
 
112
  FILE    *fp;
 
113
  void    *fd;
 
114
  int     input_size, input_cnt;
 
115
  int     pop;                    /* Number of macros to pop      */
 
116
  int     ingappop /* = 1 */;
 
117
  int     linepos /* = -1 */;
 
118
  int32    *typemask_tabl;
 
119
  int32    *typemask_tabl_in, *typemask_tabl_out;
 
120
  int32    orchsiz;
 
121
  IFLABEL *iflabels;
 
122
  int     repeatingElseifLine;
 
123
  int32    tempNum /* = 300L */;
 
124
  int     repeatingElseLine;
 
125
  int16   grpcnt, nxtest /* = 1 */;
 
126
  int16   xprtstno, polcnt;
 
127
  int16   instrblk, instrcnt;
 
128
  int16   opcodblk;               /* IV - Sep 8 2002 */
 
129
  int16   opcodflg;               /* 1: xin, 2: xout, 4: setksmps */
 
130
  IFDEFSTACK  *ifdefStack;
 
131
  TEXT    optext;                 /* struct to be passed back to caller */
129
132
} RDORCH_GLOBALS;
130
133
 
131
134
#define ST(x)   (((RDORCH_GLOBALS*) csound->rdorchGlobals)->x)
132
135
#define CURLINE (csound->oparms->useCsdLineCounts ? \
133
 
                  csound->orcLineOffset + ST(curline) : ST(curline))
 
136
                 csound->orcLineOffset + ST(curline) : ST(curline))
134
137
 
135
138
static  void    intyperr(CSOUND *, int, char, char);
136
139
static  void    printgroups(CSOUND *, int);
142
145
 
143
146
static ARGLST *copy_arglist(CSOUND *csound, ARGLST *old)
144
147
{
145
 
    size_t n = sizeof(ARGLST) + old->count * sizeof(char*) - sizeof(char*);
146
 
    ARGLST *nn = (ARGLST*) mmalloc(csound, n);
147
 
    memcpy(nn, old, n);
148
 
    memset(old, 0, n);
149
 
    return nn;
 
148
  size_t n = sizeof(ARGLST) + old->count * sizeof(char*) - sizeof(char*);
 
149
  ARGLST *nn = (ARGLST*) mmalloc(csound, n);
 
150
  memcpy(nn, old, n);
 
151
  memset(old, 0, n);
 
152
  return nn;
150
153
}
151
154
 
152
155
static inline int isNameChar(int c, int pos)
153
156
{
154
 
    c = (int) ((unsigned char) c);
155
 
    return (isalpha(c) || (pos && (c == '_' || isdigit(c))));
 
157
  c = (int) ((unsigned char) c);
 
158
  return (isalpha(c) || (pos && (c == '_' || isdigit(c))));
156
159
}
157
160
 
158
161
/* Functions to read/unread chracters from
160
163
 
161
164
static inline void ungetorchar(CSOUND *csound, int c)
162
165
{
163
 
    if (LIKELY(ST(str)->unget_cnt < 128))
164
 
      ST(str)->unget_buf[ST(str)->unget_cnt++] = (char) c;
165
 
    else
166
 
      csoundDie(csound, Str("ungetorchar(): buffer overflow"));
 
166
  if (LIKELY(ST(str)->unget_cnt < 128))
 
167
    ST(str)->unget_buf[ST(str)->unget_cnt++] = (char) c;
 
168
  else
 
169
    csoundDie(csound, Str("ungetorchar(): buffer overflow"));
167
170
}
168
171
 
169
172
static int skiporccomment(CSOUND *csound)
170
173
{
171
 
    int c;
172
 
    int mode = 0;               /* Mode = 1 after / character */
173
 
    int srccnt = 0;
 
174
  int c;
 
175
  int mode = 0;               /* Mode = 1 after / character */
 
176
  int srccnt = 0;
174
177
 top:
175
 
    if (ST(str)->unget_cnt) {
176
 
      c = (int) ((unsigned char) ST(str)->unget_buf[--ST(str)->unget_cnt]);
 
178
  if (ST(str)->unget_cnt) {
 
179
    c = (int) ((unsigned char) ST(str)->unget_buf[--ST(str)->unget_cnt]);
 
180
  }
 
181
  else if (ST(str)->string) {
 
182
    c = *ST(str)->body++;
 
183
    if (c == '\0') {
 
184
      ST(pop) += ST(str)->args;
 
185
      ST(str)--; ST(input_cnt)--;
 
186
      ST(linepos) = -1;
 
187
      return srccnt;
177
188
    }
178
 
    else if (ST(str)->string) {
179
 
      c = *ST(str)->body++;
180
 
      if (c == '\0') {
181
 
        ST(pop) += ST(str)->args;
182
 
        ST(str)--; ST(input_cnt)--;
 
189
  }
 
190
  else {
 
191
    c = getc(ST(str)->file);
 
192
    if (c == EOF) {
 
193
      if (ST(str) == &ST(inputs)[0]) {
183
194
        ST(linepos) = -1;
184
195
        return srccnt;
185
196
      }
186
 
    }
187
 
    else {
188
 
      c = getc(ST(str)->file);
189
 
      if (c == EOF) {
190
 
        if (ST(str) == &ST(inputs)[0]) {
191
 
          ST(linepos) = -1;
192
 
          return srccnt;
193
 
        }
194
 
        if (ST(str)->fd != NULL) {
195
 
          csound->FileClose(csound, ST(str)->fd); ST(str)->fd = NULL;
196
 
        }
197
 
        ST(str)--; ST(input_cnt)--;
198
 
        ST(str)->line++; ST(linepos) = -1;
199
 
        return srccnt;
 
197
      if (ST(str)->fd != NULL) {
 
198
        csound->FileClose(csound, ST(str)->fd); ST(str)->fd = NULL;
200
199
      }
201
 
    }
202
 
    if (c == '*') mode = 1;     /* look for end of comment */
203
 
    else if (c == '/' && mode == 1) {
204
 
      return srccnt;
205
 
    }
206
 
    else mode = 0;
207
 
    if (c == '\n') {
 
200
      ST(str)--; ST(input_cnt)--;
208
201
      ST(str)->line++; ST(linepos) = -1;
209
 
      srccnt++;
 
202
      return srccnt;
210
203
    }
211
 
    goto top;
 
204
  }
 
205
  if (c == '*') mode = 1;     /* look for end of comment */
 
206
  else if (c == '/' && mode == 1) {
 
207
    return srccnt;
 
208
  }
 
209
  else mode = 0;
 
210
  if (c == '\n') {
 
211
    ST(str)->line++; ST(linepos) = -1;
 
212
    srccnt++;
 
213
  }
 
214
  goto top;
212
215
}
213
216
 
214
217
static void skiporchar(CSOUND *csound)
215
218
{
216
 
    int c;
 
219
  int c;
217
220
 top:
218
 
    if (UNLIKELY(ST(str)->unget_cnt)) {
219
 
      c = (int) ((unsigned char) ST(str)->unget_buf[--ST(str)->unget_cnt]);
220
 
      if (c == '\n') {
 
221
  if (UNLIKELY(ST(str)->unget_cnt)) {
 
222
    c = (int) ((unsigned char) ST(str)->unget_buf[--ST(str)->unget_cnt]);
 
223
    if (c == '\n') {
 
224
      ST(linepos) = -1;
 
225
      return;
 
226
    }
 
227
    goto top;
 
228
  }
 
229
  else if (ST(str)->string) {
 
230
    c = *ST(str)->body++;
 
231
    if (c == '\n') {
 
232
      ST(str)->line++; ST(linepos) = -1;
 
233
      return;
 
234
    }
 
235
    if (c == '\0') {
 
236
      ST(pop) += ST(str)->args;
 
237
      ST(str)--; ST(input_cnt)--;
 
238
      ST(linepos) = -1;
 
239
      return;
 
240
    }
 
241
  }
 
242
  else {
 
243
    c = getc(ST(str)->file);
 
244
    if (c == '\n' || c == '\r' || c == 26) {    /* MS-DOS spare ^Z */
 
245
      ST(str)->line++; ST(linepos) = -1;
 
246
      if (c == '\r') {
 
247
        if (ST(str)->string) {
 
248
          if ((c = *ST(str)->body++) != '\n')
 
249
            ST(str)->body--;
 
250
        }
 
251
        else if ((c = getc(ST(str)->file)) != '\n')
 
252
          ungetc(c, ST(str)->file);
 
253
      }
 
254
      return;
 
255
    }
 
256
    if (UNLIKELY(c == EOF)) {
 
257
      if (ST(str) == &ST(inputs)[0]) {
221
258
        ST(linepos) = -1;
222
259
        return;
223
260
      }
 
261
      if (ST(str)->fd != NULL) {
 
262
        csound->FileClose(csound, ST(str)->fd); ST(str)->fd = NULL;
 
263
      }
 
264
      ST(str)--; ST(input_cnt)--;
 
265
      ST(str)->line++; ST(linepos) = -1;
 
266
      return;
 
267
    }
 
268
  }
 
269
  ST(linepos)++;
 
270
  goto top;
 
271
}
 
272
 
 
273
static int getorchar(CSOUND *csound)
 
274
{
 
275
  int c;
 
276
 top:
 
277
  if (UNLIKELY(ST(str)->unget_cnt)) {
 
278
    c = (int) ((unsigned char) ST(str)->unget_buf[--ST(str)->unget_cnt]);
 
279
    if (c == '\n')
 
280
      ST(linepos) = -1;
 
281
    //    printf("%s(%d): %c(%.2x)\n", __FILE__, __LINE__, c,c);
 
282
    return c;
 
283
  }
 
284
  else if (ST(str)->string) {
 
285
    c = *ST(str)->body++;
 
286
    if (UNLIKELY(c == '\0')) {
 
287
      if (ST(str) == &ST(inputs)[0]) {
 
288
        //corfile_rm(&(csound->orchstr));
 
289
        //        printf("%s(%d): EOF\n", __FILE__, __LINE__);
 
290
        return EOF;
 
291
      }
 
292
      ST(pop) += ST(str)->args;
 
293
      ST(str)--; ST(input_cnt)--;
224
294
      goto top;
225
295
    }
226
 
    else if (ST(str)->string) {
227
 
      c = *ST(str)->body++;
228
 
      if (c == '\n') {
229
 
        ST(str)->line++; ST(linepos) = -1;
230
 
        return;
231
 
      }
232
 
      if (c == '\0') {
233
 
        ST(pop) += ST(str)->args;
234
 
        ST(str)--; ST(input_cnt)--;
235
 
        ST(linepos) = -1;
236
 
        return;
237
 
      }
238
 
    }
239
 
    else {
240
 
      c = getc(ST(str)->file);
241
 
      if (c == '\n' || c == '\r' || c == 26) {    /* MS-DOS spare ^Z */
242
 
        ST(str)->line++; ST(linepos) = -1;
243
 
        if (c == '\r') {
244
 
          if ((c = getc(ST(str)->file)) != '\n')
245
 
            ungetc(c, ST(str)->file);
246
 
        }
247
 
        return;
248
 
      }
249
 
      if (UNLIKELY(c == EOF)) {
250
 
        if (ST(str) == &ST(inputs)[0]) {
251
 
          ST(linepos) = -1;
252
 
          return;
253
 
        }
254
 
        if (ST(str)->fd != NULL) {
255
 
          csound->FileClose(csound, ST(str)->fd); ST(str)->fd = NULL;
256
 
        }
257
 
        ST(str)--; ST(input_cnt)--;
258
 
        ST(str)->line++; ST(linepos) = -1;
259
 
        return;
260
 
      }
261
 
    }
262
 
    ST(linepos)++;
263
 
    goto top;
264
 
}
265
 
 
266
 
static int getorchar(CSOUND *csound)
267
 
{
268
 
    int c;
269
 
 top:
270
 
    if (UNLIKELY(ST(str)->unget_cnt)) {
271
 
      c = (int) ((unsigned char) ST(str)->unget_buf[--ST(str)->unget_cnt]);
272
 
      if (c == '\n')
273
 
        ST(linepos) = -1;
274
 
      return c;
275
 
    }
276
 
    else if (ST(str)->string) {
277
 
      c = *ST(str)->body++;
278
 
      if (UNLIKELY(c == '\0')) {
279
 
        ST(pop) += ST(str)->args;
280
 
        ST(str)--; ST(input_cnt)--;
281
 
        goto top;
282
 
      }
283
 
    }
284
 
    else {
285
 
      c = getc(ST(str)->file);
286
 
      if (UNLIKELY(c == 26)) goto top;    /* MS-DOS spare ^Z */
287
 
      if (UNLIKELY(c == EOF)) {
288
 
        if (ST(str) == &ST(inputs)[0]) return EOF;
289
 
        if (ST(str)->fd != NULL) {
290
 
          csound->FileClose(csound, ST(str)->fd); ST(str)->fd = NULL;
291
 
        }
292
 
        ST(str)--; ST(input_cnt)--; goto top;
293
 
      }
294
 
    }
295
 
    if (c == '\r') {
296
 
      int d;
297
 
      if ((d = getc(ST(str)->file)) != '\n') {
298
 
        ungetc(d, ST(str)->file);
299
 
      }
300
 
      c = '\n';
301
 
    }
302
 
    if (c == '\n') {
303
 
      ST(str)->line++; ST(linepos) = -1;
304
 
    }
305
 
    else ST(linepos)++;
306
 
    if (ST(ingappop) && ST(pop)) {
307
 
      do {
308
 
        MACRO *nn = ST(macros)->next;
309
 
        int i;
 
296
  }
 
297
  else {
 
298
    c = getc(ST(str)->file);
 
299
    if (UNLIKELY(c == 26)) goto top;    /* MS-DOS spare ^Z */
 
300
    if (UNLIKELY(c == EOF)) {
 
301
      if (ST(str) == &ST(inputs)[0]) return EOF;
 
302
      if (ST(str)->fd != NULL) {
 
303
        csound->FileClose(csound, ST(str)->fd); ST(str)->fd = NULL;
 
304
      }
 
305
      ST(str)--; ST(input_cnt)--; goto top;
 
306
    }
 
307
  }
 
308
  if (c == '\r') {
 
309
    int d;
 
310
    if (ST(str)->string) {
 
311
      if ((d = *ST(str)->body++) != '\n')
 
312
        ST(str)->body--;
 
313
    }
 
314
    else if ((d = getc(ST(str)->file)) != '\n') {
 
315
      ungetc(d, ST(str)->file);
 
316
    }
 
317
    c = '\n';
 
318
  }
 
319
  if (c == '\n') {
 
320
    ST(str)->line++; ST(linepos) = -1;
 
321
  }
 
322
  else ST(linepos)++;
 
323
  if (ST(ingappop) && ST(pop)) {
 
324
    do {
 
325
      MACRO *nn = ST(macros)->next;
 
326
      int i;
310
327
#ifdef MACDEBUG
311
 
        csound->Message(csound, "popping %s\n", ST(macros)->name);
 
328
      csound->Message(csound, "popping %s\n", ST(macros)->name);
312
329
#endif
313
 
        mfree(csound, ST(macros)->name); mfree(csound, ST(macros)->body);
314
 
        for (i=0; i<ST(macros)->acnt; i++)
315
 
          mfree(csound, ST(macros)->arg[i]);
316
 
        mfree(csound, ST(macros));
317
 
        ST(macros) = nn;
318
 
        ST(pop)--;
319
 
      } while (ST(pop));
320
 
    }
321
 
    return c;
 
330
      mfree(csound, ST(macros)->name); mfree(csound, ST(macros)->body);
 
331
      for (i=0; i<ST(macros)->acnt; i++)
 
332
        mfree(csound, ST(macros)->arg[i]);
 
333
      mfree(csound, ST(macros));
 
334
      ST(macros) = nn;
 
335
      ST(pop)--;
 
336
    } while (ST(pop));
 
337
  }
 
338
  //  printf("%s(%d): %c(%.2x)\n", __FILE__, __LINE__, c,c);
 
339
  return c;
322
340
}
323
341
 
324
342
static int getorchar_noeof(CSOUND *csound)
325
343
{
326
 
    int     c;
 
344
  int     c;
327
345
 
328
 
    c = getorchar(csound);
329
 
    if (UNLIKELY(c == EOF))
330
 
      lexerr(csound, Str("Unexpected end of orchestra file"));
331
 
    return c;
 
346
  c = getorchar(csound);
 
347
  if (UNLIKELY(c == EOF))
 
348
    lexerr(csound, Str("Unexpected end of orchestra file"));
 
349
  return c;
332
350
}
333
351
 
334
352
/* The fromScore parameter should be 1 if opening a score include file,
335
353
   0 if opening an orchestra include file */
336
354
void *fopen_path(CSOUND *csound, FILE **fp, char *name, char *basename,
337
 
                                  char *env, int fromScore)
 
355
                 char *env, int fromScore)
338
356
{
339
 
    void *fd;
340
 
    int  csftype = (fromScore ? CSFTYPE_SCO_INCLUDE : CSFTYPE_ORC_INCLUDE);
 
357
  void *fd;
 
358
  int  csftype = (fromScore ? CSFTYPE_SCO_INCLUDE : CSFTYPE_ORC_INCLUDE);
341
359
 
342
 
                                /* First try to open name given */
343
 
    fd = csound->FileOpen2(csound, fp, CSFILE_STD, name, "rb", NULL,
344
 
                                             csftype, 0);
345
 
    if (fd != NULL)
346
 
      return fd;
347
 
                                /* if that fails try in base directory */
348
 
    if (basename != NULL) {
349
 
      char *dir, *name_full;
350
 
      if ((dir = csoundSplitDirectoryFromPath(csound, basename)) != NULL) {
351
 
          name_full = csoundConcatenatePaths(csound, dir, name);
352
 
          fd = csound->FileOpen2(csound, fp, CSFILE_STD, name_full, "rb", NULL,
353
 
                                             csftype, 0);
354
 
          mfree(csound, dir);
355
 
          mfree(csound, name_full);
356
 
          if (fd != NULL)
357
 
            return fd;
358
 
      }
359
 
    }
360
 
                                /* or use env argument */
361
 
    fd = csound->FileOpen2(csound, fp, CSFILE_STD, name, "rb", env,
362
 
                                             csftype, 0);
 
360
  /* First try to open name given */
 
361
  fd = csound->FileOpen2(csound, fp, CSFILE_STD, name, "rb", NULL,
 
362
                         csftype, 0);
 
363
  if (fd != NULL)
363
364
    return fd;
 
365
  /* if that fails try in base directory */
 
366
  if (basename != NULL) {
 
367
    char *dir, *name_full;
 
368
    if ((dir = csoundSplitDirectoryFromPath(csound, basename)) != NULL) {
 
369
      name_full = csoundConcatenatePaths(csound, dir, name);
 
370
      fd = csound->FileOpen2(csound, fp, CSFILE_STD, name_full, "rb", NULL,
 
371
                             csftype, 0);
 
372
      mfree(csound, dir);
 
373
      mfree(csound, name_full);
 
374
      if (fd != NULL)
 
375
        return fd;
 
376
    }
 
377
  }
 
378
  /* or use env argument */
 
379
  fd = csound->FileOpen2(csound, fp, CSFILE_STD, name, "rb", env,
 
380
                         csftype, 0);
 
381
  return fd;
364
382
}
365
383
 
366
384
static void add_math_const_macro(CSOUND *csound, char * name, char *body)
367
385
{
368
 
    MACRO *mm;
 
386
  MACRO *mm;
369
387
 
370
 
    mm = (MACRO*) mcalloc(csound, sizeof(MACRO));
371
 
    mm->name = (char*) mcalloc(csound, strlen(name) + 3);
372
 
    sprintf(mm->name, "M_%s", name);
373
 
    mm->next = ST(macros);
374
 
    ST(macros) = mm;
375
 
    mm->margs = MARGS;    /* Initial size */
376
 
    mm->acnt = 0;
377
 
    mm->body = (char*) mcalloc(csound, strlen(body) + 1);
378
 
    mm->body = strcpy(mm->body, body);
 
388
  mm = (MACRO*) mcalloc(csound, sizeof(MACRO));
 
389
  mm->name = (char*) mcalloc(csound, strlen(name) + 3);
 
390
  sprintf(mm->name, "M_%s", name);
 
391
  mm->next = ST(macros);
 
392
  ST(macros) = mm;
 
393
  mm->margs = MARGS;    /* Initial size */
 
394
  mm->acnt = 0;
 
395
  mm->body = (char*) mcalloc(csound, strlen(body) + 1);
 
396
  mm->body = strcpy(mm->body, body);
379
397
}
380
398
 
381
399
/**
382
400
 * Add math constants from math.h as orc macros
383
401
 */
384
402
static void init_math_constants_macros(CSOUND *csound)
385
 
 {
386
 
     add_math_const_macro(csound, "E", "2.7182818284590452354");
387
 
     add_math_const_macro(csound, "LOG2E", "1.4426950408889634074");
388
 
     add_math_const_macro(csound, "LOG10E", "0.43429448190325182765");
389
 
     add_math_const_macro(csound, "LN2", "0.69314718055994530942");
390
 
     add_math_const_macro(csound, "LN10", "2.30258509299404568402");
391
 
     add_math_const_macro(csound, "PI", "3.14159265358979323846");
392
 
     add_math_const_macro(csound, "PI_2", "1.57079632679489661923");
393
 
     add_math_const_macro(csound, "PI_4", "0.78539816339744830962");
394
 
     add_math_const_macro(csound, "1_PI", "0.31830988618379067154");
395
 
     add_math_const_macro(csound, "2_PI", "0.63661977236758134308");
396
 
     add_math_const_macro(csound, "2_SQRTPI", "1.12837916709551257390");
397
 
     add_math_const_macro(csound, "SQRT2", "1.41421356237309504880");
398
 
     add_math_const_macro(csound, "SQRT1_2", "0.70710678118654752440");
399
 
     add_math_const_macro(csound, "INF", "2147483647.0"); /* ~7 years */
 
403
{
 
404
  add_math_const_macro(csound, "E", "2.7182818284590452354");
 
405
  add_math_const_macro(csound, "LOG2E", "1.4426950408889634074");
 
406
  add_math_const_macro(csound, "LOG10E", "0.43429448190325182765");
 
407
  add_math_const_macro(csound, "LN2", "0.69314718055994530942");
 
408
  add_math_const_macro(csound, "LN10", "2.30258509299404568402");
 
409
  add_math_const_macro(csound, "PI", "3.14159265358979323846");
 
410
  add_math_const_macro(csound, "PI_2", "1.57079632679489661923");
 
411
  add_math_const_macro(csound, "PI_4", "0.78539816339744830962");
 
412
  add_math_const_macro(csound, "1_PI", "0.31830988618379067154");
 
413
  add_math_const_macro(csound, "2_PI", "0.63661977236758134308");
 
414
  add_math_const_macro(csound, "2_SQRTPI", "1.12837916709551257390");
 
415
  add_math_const_macro(csound, "SQRT2", "1.41421356237309504880");
 
416
  add_math_const_macro(csound, "SQRT1_2", "0.70710678118654752440");
 
417
  add_math_const_macro(csound, "INF", "800000000000.0"); /* ~25367 years */
400
418
}
401
419
 
402
420
static void init_omacros(CSOUND *csound, NAMES *nn)
403
421
{
404
 
    while (nn) {
405
 
      char  *s = nn->mac;
406
 
      char  *p = strchr(s, '=');
407
 
      char  *mname;
408
 
      MACRO *mm;
 
422
  while (nn) {
 
423
    char  *s = nn->mac;
 
424
    char  *p = strchr(s, '=');
 
425
    char  *mname;
 
426
    MACRO *mm;
409
427
 
410
 
      if (p == NULL)
411
 
        p = s + strlen(s);
412
 
      if (csound->oparms->msglevel & 7)
413
 
        csound->Message(csound, Str("Macro definition for %*s\n"), p - s, s);
414
 
      s = strchr(s, ':') + 1;                   /* skip arg bit */
415
 
      if (UNLIKELY(s == NULL || s >= p))
416
 
        csound->Die(csound, Str("Invalid macro name for --omacro"));
417
 
      mname = (char*) mmalloc(csound, (p - s) + 1);
418
 
      strncpy(mname, s, p - s);
419
 
      mname[p - s] = '\0';
420
 
      /* check if macro is already defined */
421
 
      for (mm = ST(macros); mm != NULL; mm = mm->next) {
422
 
        if (strcmp(mm->name, mname) == 0)
423
 
          break;
424
 
      }
425
 
      if (mm == NULL) {
426
 
        mm = (MACRO*) mcalloc(csound, sizeof(MACRO));
427
 
        mm->name = mname;
428
 
        mm->next = ST(macros);
429
 
        ST(macros) = mm;
430
 
      }
431
 
      else
432
 
        mfree(csound, mname);
433
 
      mm->margs = MARGS;    /* Initial size */
434
 
      mm->acnt = 0;
435
 
      if (*p != '\0')
436
 
        p++;
437
 
      mm->body = (char*) mmalloc(csound, strlen(p) + 1);
438
 
      strcpy(mm->body, p);
439
 
      nn = nn->next;
440
 
    }
 
428
    if (p == NULL)
 
429
      p = s + strlen(s);
 
430
    if (csound->oparms->msglevel & 7)
 
431
      csound->Message(csound, Str("Macro definition for %*s\n"), p - s, s);
 
432
    s = strchr(s, ':') + 1;                   /* skip arg bit */
 
433
    if (UNLIKELY(s == NULL || s >= p))
 
434
      csound->Die(csound, Str("Invalid macro name for --omacro"));
 
435
    mname = (char*) mmalloc(csound, (p - s) + 1);
 
436
    strncpy(mname, s, p - s);
 
437
    mname[p - s] = '\0';
 
438
    /* check if macro is already defined */
 
439
    for (mm = ST(macros); mm != NULL; mm = mm->next) {
 
440
      if (strcmp(mm->name, mname) == 0)
 
441
        break;
 
442
    }
 
443
    if (mm == NULL) {
 
444
      mm = (MACRO*) mcalloc(csound, sizeof(MACRO));
 
445
      mm->name = mname;
 
446
      mm->next = ST(macros);
 
447
      ST(macros) = mm;
 
448
    }
 
449
    else
 
450
      mfree(csound, mname);
 
451
    mm->margs = MARGS;    /* Initial size */
 
452
    mm->acnt = 0;
 
453
    if (*p != '\0')
 
454
      p++;
 
455
    mm->body = (char*) mmalloc(csound, strlen(p) + 1);
 
456
    strcpy(mm->body, p);
 
457
    nn = nn->next;
 
458
  }
441
459
}
442
460
 
443
461
void rdorchfile(CSOUND *csound)     /* read entire orch file into txt space */
444
462
{
445
 
    int     c, lincnt;
446
 
    int     srccnt;
447
 
    char    *cp, *endspace, *ortext;
448
 
    int     linmax = LINMAX;        /* Maximum number of lines      */
449
 
    int     heredoc = 0, openquote = 0;
 
463
  int     c, lincnt;
 
464
  int     srccnt;
 
465
  char    *cp, *endspace, *ortext;
 
466
  int     linmax = LINMAX;        /* Maximum number of lines      */
 
467
  int     heredoc = 0, openquote = 0;
450
468
 
451
 
    if (csound->rdorchGlobals == NULL) {
452
 
      csound->rdorchGlobals = csound->Calloc(csound, sizeof(RDORCH_GLOBALS));
453
 
      ST(lenmax)    = LENMAX;
454
 
      ST(grpmax)    = GRPMAX;
455
 
      ST(ingappop)  = 1;
456
 
      ST(linepos)   = -1;
457
 
      ST(tempNum)   = 300L;
458
 
      ST(nxtest)    = 1;
459
 
    }
460
 
    init_math_constants_macros(csound);
461
 
    init_omacros(csound, csound->omacros);
462
 
    /* IV - Oct 31 2002: create tables for easier checking for common types */
463
 
    if (!ST(typemask_tabl)) {
464
 
      const int32 *ptr = typetabl1;
465
 
      ST(typemask_tabl) = (int32*) mcalloc(csound, sizeof(int32) * 256);
466
 
      ST(typemask_tabl_in) = (int32*) mcalloc(csound, sizeof(int32) * 256);
467
 
      ST(typemask_tabl_out) = (int32*) mcalloc(csound, sizeof(int32) * 256);
468
 
      while (*ptr) {            /* basic types (both for input */
469
 
        int32 pos = *ptr++;      /* and output) */
470
 
        ST(typemask_tabl)[pos] = ST(typemask_tabl_in)[pos] =
471
 
                                 ST(typemask_tabl_out)[pos] = *ptr++;
472
 
      }
473
 
      ptr = typetabl2;
474
 
      while (*ptr) {            /* input types */
475
 
        int32 pos = *ptr++;
476
 
        ST(typemask_tabl_in)[pos] = *ptr++;
477
 
      }
478
 
      ptr = typetabl3;
479
 
      while (*ptr) {            /* output types */
480
 
        int32 pos = *ptr++;
 
469
  if (csound->rdorchGlobals == NULL) {
 
470
    csound->rdorchGlobals = csound->Calloc(csound, sizeof(RDORCH_GLOBALS));
 
471
    ST(lenmax)    = LENMAX;
 
472
    ST(grpmax)    = GRPMAX;
 
473
    ST(ingappop)  = 1;
 
474
    ST(linepos)   = -1;
 
475
    ST(tempNum)   = 300L;
 
476
    ST(nxtest)    = 1;
 
477
  }
 
478
  init_math_constants_macros(csound);
 
479
  init_omacros(csound, csound->omacros);
 
480
  /* IV - Oct 31 2002: create tables for easier checking for common types */
 
481
  if (!ST(typemask_tabl)) {
 
482
    const int32 *ptr = typetabl1;
 
483
    ST(typemask_tabl) = (int32*) mcalloc(csound, sizeof(int32) * 256);
 
484
    ST(typemask_tabl_in) = (int32*) mcalloc(csound, sizeof(int32) * 256);
 
485
    ST(typemask_tabl_out) = (int32*) mcalloc(csound, sizeof(int32) * 256);
 
486
    while (*ptr) {            /* basic types (both for input */
 
487
      int32 pos = *ptr++;      /* and output) */
 
488
      ST(typemask_tabl)[pos] = ST(typemask_tabl_in)[pos] =
481
489
        ST(typemask_tabl_out)[pos] = *ptr++;
482
 
      }
483
 
    }
484
 
    csound->Message(csound, Str("orch compiler:\n"));
485
 
    if (UNLIKELY((ST(fd) = csound->FileOpen2(csound, &ST(fp), CSFILE_STD,
486
 
                              csound->orchname, "rb", NULL, CSFTYPE_ORCHESTRA,
487
 
                                             (csound->tempStatus & csOrcMask)!=0)) == NULL))
488
 
      csoundDie(csound, Str("cannot open orch file %s"), csound->orchname);
489
 
    if (UNLIKELY(fseek(ST(fp), 0L, SEEK_END) != 0))
490
 
      csoundDie(csound, Str("cannot find end of file %s"), csound->orchname);
491
 
    if (UNLIKELY((ST(orchsiz) = ftell(ST(fp))) <= 0))
492
 
      csoundDie(csound, Str("ftell error on %s"), csound->orchname);
493
 
    rewind(ST(fp));
494
 
    ST(inputs) = (IN_STACK*) mmalloc(csound, 20 * sizeof(IN_STACK));
495
 
    ST(input_size) = 20;
496
 
    ST(input_cnt) = 0;
497
 
    ST(str) = ST(inputs);
498
 
    ST(str)->string = 0;
499
 
    ST(str)->file = ST(fp);
500
 
    ST(str)->fd = ST(fd);
501
 
    ST(str)->body = csound->orchname;
502
 
    ST(str)->line = 1;
503
 
    ST(str)->unget_cnt = 0;
504
 
    ortext = mmalloc(csound, ST(orchsiz) + 1);          /* alloc mem spaces */
505
 
    ST(linadr) = (char **) mmalloc(csound, (LINMAX + 1) * sizeof(char *));
506
 
    strsav_create(csound);
507
 
    lincnt = srccnt = 1;
508
 
    cp = ST(linadr)[1] = ortext;
509
 
    endspace = ortext + ST(orchsiz) + 1;
510
 
    strsav_string(csound, "sr");
511
 
    ST(group) = (char **)mcalloc(csound, (GRPMAX+1)*sizeof(char*));
512
 
    ST(grpsav)= (char **)mcalloc(csound, (GRPMAX+1)*sizeof(char*));
513
 
    ST(lblreq) = (LBLREQ*)mcalloc(csound, LBLMAX*sizeof(LBLREQ));
514
 
    ST(lblmax) = LBLMAX;
 
490
    }
 
491
    ptr = typetabl2;
 
492
    while (*ptr) {            /* input types */
 
493
      int32 pos = *ptr++;
 
494
      ST(typemask_tabl_in)[pos] = *ptr++;
 
495
    }
 
496
    ptr = typetabl3;
 
497
    while (*ptr) {            /* output types */
 
498
      int32 pos = *ptr++;
 
499
      ST(typemask_tabl_out)[pos] = *ptr++;
 
500
    }
 
501
  }
 
502
  csound->Message(csound, Str("orch compiler:\n"));
 
503
  ST(inputs) = (IN_STACK*) mmalloc(csound, 20 * sizeof(IN_STACK));
 
504
  ST(input_size) = 20;
 
505
  ST(input_cnt) = 0;
 
506
  ST(str) = ST(inputs);
 
507
  ST(str)->line = 1;
 
508
  ST(str)->unget_cnt = 0;
 
509
  if (csound->orchstr) {
 
510
    ST(orchsiz) = corfile_length(csound->orchstr);
 
511
    ST(str)->string = 1;
 
512
    ST(str)->body = corfile_body(csound->orchstr);
 
513
    ST(str)->file = NULL;
 
514
    ST(str)->fd = NULL;
 
515
  }
 
516
  else {
 
517
    /* if (UNLIKELY((ST(fd) = csound->FileOpen2(csound, &ST(fp), CSFILE_STD, */
 
518
    /*                         csound->orchname, "rb", NULL, CSFTYPE_ORCHESTRA, */
 
519
    /*                                        (csound->tempStatus & csOrcMask)!=0)) == NULL)) */
 
520
    csoundDie(csound, Str("cannot open orch file %s"), csound->orchname);
 
521
    /* if (UNLIKELY(fseek(ST(fp), 0L, SEEK_END) != 0)) */
 
522
    /*   csoundDie(csound, Str("cannot find end of file %s"), csound->orchname); */
 
523
    /* if (UNLIKELY((ST(orchsiz) = ftell(ST(fp))) <= 0)) */
 
524
    /*   csoundDie(csound, Str("ftell error on %s"), csound->orchname); */
 
525
    /* rewind(ST(fp)); */
 
526
    /* ST(str)->string = 0; */
 
527
    /* ST(str)->file = ST(fp); */
 
528
    /* ST(str)->fd = ST(fd); */
 
529
    /* ST(str)->body = csound->orchname; */
 
530
  }
 
531
  ortext = mmalloc(csound, ST(orchsiz) + 1);          /* alloc mem spaces */
 
532
  ST(linadr) = (char **) mmalloc(csound, (LINMAX + 1) * sizeof(char *));
 
533
  strsav_create(csound);
 
534
  lincnt = srccnt = 1;
 
535
  cp = ST(linadr)[1] = ortext;
 
536
  endspace = ortext + ST(orchsiz) + 1;
 
537
  strsav_string(csound, "sr");
 
538
  ST(group) = (char **)mcalloc(csound, (GRPMAX+1)*sizeof(char*));
 
539
  ST(grpsav)= (char **)mcalloc(csound, (GRPMAX+1)*sizeof(char*));
 
540
  ST(lblreq) = (LBLREQ*)mcalloc(csound, LBLMAX*sizeof(LBLREQ));
 
541
  ST(lblmax) = LBLMAX;
515
542
 
516
543
 top:
517
 
    while ((c = getorchar(csound)) != EOF) {    /* read entire orch file  */
518
 
      if (cp == endspace-5) {                   /* Must extend */
519
 
        char *orold = ortext;
520
 
        int  i;
521
 
        /* printf("Expand orch: %p (%d) %p -> ", ortext, ST(orchsiz), endspace); */
522
 
        ST(orchsiz) = ST(orchsiz) + (ST(orchsiz) >> 4) + 1L;
523
 
        ST(orchsiz) = (ST(orchsiz) + 511L) & (~511L);
524
 
        ortext = mrealloc(csound, ortext, ST(orchsiz));
525
 
        endspace = ortext + ST(orchsiz) + 1;
526
 
        /* printf("%p (%d) %p\n", ortext, ST(orchsiz), endspace); */
527
 
        if (ortext != orold) {
528
 
          ptrdiff_t adj = ortext - orold;
529
 
          for (i=1; i<=lincnt; i++)
530
 
            ST(linadr)[i] += adj; /* Relocate */
531
 
          cp += adj;
532
 
        }
533
 
      }
534
 
      *cp++ = c;
535
 
      if (c == '{' && !openquote) {
536
 
        char  c2 = getorchar(csound);
537
 
        if (c2 == '{') {
538
 
          heredoc = 1;
539
 
          *cp++ = c;
540
 
        }
541
 
        else
542
 
          ungetorchar(csound, c2);
543
 
      }
544
 
      else if (c == '}' && heredoc) {
545
 
        char  c2 = getorchar(csound);
546
 
        if (c2 == '}') {
547
 
          heredoc = 0;
548
 
          *cp++ = c;
549
 
        }
550
 
        else
551
 
          ungetorchar(csound, c2);
552
 
      }
553
 
      if (c == ';' && !heredoc) {
 
544
  while ((c = getorchar(csound)) != EOF) {    /* read entire orch file  */
 
545
    if (cp == endspace-5) {                   /* Must extend */
 
546
      char *orold = ortext;
 
547
      int  i;
 
548
      /* printf("Expand orch: %p (%d) %p -> ", ortext, ST(orchsiz), endspace); */
 
549
      ST(orchsiz) = ST(orchsiz) + (ST(orchsiz) >> 4) + 1L;
 
550
      ST(orchsiz) = (ST(orchsiz) + 511L) & (~511L);
 
551
      ortext = mrealloc(csound, ortext, ST(orchsiz));
 
552
      endspace = ortext + ST(orchsiz) + 1;
 
553
      /* printf("%p (%d) %p\n", ortext, ST(orchsiz), endspace); */
 
554
      if (ortext != orold) {
 
555
        ptrdiff_t adj = ortext - orold;
 
556
        for (i=1; i<=lincnt; i++)
 
557
          ST(linadr)[i] += adj; /* Relocate */
 
558
        cp += adj;
 
559
      }
 
560
    }
 
561
    *cp++ = c;
 
562
    if (c == '{' && !openquote) {
 
563
      char  c2 = getorchar(csound);
 
564
      if (c2 == '{') {
 
565
        heredoc = 1;
 
566
        *cp++ = c;
 
567
      }
 
568
      else
 
569
        ungetorchar(csound, c2);
 
570
    }
 
571
    else if (c == '}' && heredoc) {
 
572
      char  c2 = getorchar(csound);
 
573
      if (c2 == '}') {
 
574
        heredoc = 0;
 
575
        *cp++ = c;
 
576
      }
 
577
      else
 
578
        ungetorchar(csound, c2);
 
579
    }
 
580
    if (c == ';' && !heredoc) {
 
581
      skiporchar(csound);
 
582
      *(cp - 1) = (char) (c = '\n');
 
583
    }
 
584
    if (c == '"' && !heredoc) {
 
585
      openquote = !openquote;
 
586
    }
 
587
    if (c == '\\' && !heredoc & !openquote) {      /* Continuation ?       */
 
588
      while ((c = getorchar(csound)) == ' ' || c == '\t')
 
589
        ;                                          /* Ignore spaces        */
 
590
      if (c == ';') {                              /* Comments get skipped */
554
591
        skiporchar(csound);
555
 
        *(cp - 1) = (char) (c = '\n');
556
 
      }
557
 
      if (c == '"' && !heredoc) {
558
 
        openquote = !openquote;
559
 
      }
560
 
      if (c == '\\' && !heredoc & !openquote) {      /* Continuation ?       */
561
 
        while ((c = getorchar(csound)) == ' ' || c == '\t')
562
 
          ;                                          /* Ignore spaces        */
563
 
        if (c == ';') {                              /* Comments get skipped */
564
 
          skiporchar(csound);
565
 
          c = '\n';
566
 
        }
567
 
        if (c == '\n') {
568
 
          cp--;                                      /* Ignore newline */
569
 
          srccnt++;                                  /*    record a fakeline */
570
 
          /* lincnt++; Thsi is wrong */
571
 
        }
572
 
        else {
573
 
          *cp++ = c;
574
 
        }
575
 
      }
576
 
      else if (c == '/') {
577
 
        c = getorchar(csound);
578
 
        if (c=='*') {
579
 
          srccnt += skiporccomment(csound);
580
 
          cp--;                 /* ?? ?? ?? */
581
 
          goto top;
582
 
        }
583
 
        else {
584
 
          ungetorchar(csound, c);
585
 
          c = '/';
586
 
        }
587
 
      }
588
 
      else if (c == '\n') {                          /* at each new line */
589
 
        char *lp = ST(linadr)[lincnt];
590
 
        /* printf("lincnt=%d; lp=%p, ST(linadr)=%p\n", lincnt, lp, ST(linadr)); */
591
 
        while ((c = *lp) == ' ' || c == '\t')
592
 
          lp++;
593
 
        if (*lp != '\n' && *lp != ';') {
594
 
          ST(curline) = lincnt - 1;
595
 
        }
596
 
        srccnt++;
597
 
        if (++lincnt >= linmax) {
598
 
          linmax += 100;
599
 
          ST(linadr) = (char**) mrealloc(csound, ST(linadr), (linmax + 1)
600
 
                                                             * sizeof(char*));
601
 
        }
602
 
  /*    ST(srclin)[lincnt] = srccnt;    unused  */
603
 
        ST(linadr)[lincnt] = cp;            /* record the adrs */
604
 
      }
605
 
      else if (c == '#' && ST(linepos) == 0 && !heredoc) {
606
 
        /* Start Macro definition */
607
 
        /* also deal with #include here */
608
 
        char  *mname, *preprocName;
609
 
        int mlen = 40;
610
 
        int   i, cnt;
611
 
        mname = (char  *)malloc(mlen);
612
 
        cp--;
613
 
 parsePreproc:
614
 
        preprocName = NULL;
 
592
        c = '\n';
 
593
      }
 
594
      if (c == '\n') {
 
595
        cp--;                                      /* Ignore newline */
 
596
        srccnt++;                                  /*    record a fakeline */
 
597
        /* lincnt++; Thsi is wrong */
 
598
      }
 
599
      else {
 
600
        *cp++ = c;
 
601
      }
 
602
    }
 
603
    else if (c == '/') {
 
604
      c = getorchar(csound);
 
605
      if (c=='*') {
 
606
        srccnt += skiporccomment(csound);
 
607
        cp--;                 /* ?? ?? ?? */
 
608
        goto top;
 
609
      }
 
610
      else {
 
611
        ungetorchar(csound, c);
 
612
        c = '/';
 
613
      }
 
614
    }
 
615
    else if (c == '\n') {                          /* at each new line */
 
616
      char *lp = ST(linadr)[lincnt];
 
617
      /* printf("lincnt=%d; lp=%p, ST(linadr)=%p\n", lincnt, lp, ST(linadr)); */
 
618
      while ((c = *lp) == ' ' || c == '\t')
 
619
        lp++;
 
620
      if (*lp != '\n' && *lp != ';') {
 
621
        ST(curline) = lincnt - 1;
 
622
      }
 
623
      srccnt++;
 
624
      if (++lincnt >= linmax) {
 
625
        linmax += 100;
 
626
        ST(linadr) = (char**) mrealloc(csound, ST(linadr), (linmax + 1)
 
627
                                       * sizeof(char*));
 
628
      }
 
629
      /*    ST(srclin)[lincnt] = srccnt;    unused  */
 
630
      ST(linadr)[lincnt] = cp;            /* record the adrs */
 
631
    }
 
632
    else if (c == '#' && ST(linepos) == 0 && !heredoc) {
 
633
      /* Start Macro definition */
 
634
      /* also deal with #include here */
 
635
      char  *mname, *preprocName;
 
636
      int mlen = 40;
 
637
      int   i, cnt;
 
638
      mname = (char  *)malloc(mlen);
 
639
      cp--;
 
640
    parsePreproc:
 
641
      preprocName = NULL;
 
642
      i = 0;
 
643
      cnt = 0;
 
644
      mname[cnt++] = '#';
 
645
      if (cnt==mlen)
 
646
        mname = (char *)realloc(mname, mlen+=40);
 
647
      do {
 
648
        c = getorchar(csound);
 
649
        if (UNLIKELY(c == EOF))
 
650
          break;
 
651
        mname[cnt++] = c;
 
652
        if (cnt==mlen)
 
653
          mname = (char *)realloc(mname, mlen+=40);
 
654
      } while ((c == ' ' || c == '\t'));
 
655
      mname[cnt] = '\0';
 
656
      if (c == EOF || c == '\n')
 
657
        goto unknownPreproc;
 
658
      preprocName = &(mname[cnt - 1]);
 
659
      while (1) {
 
660
        c = getorchar(csound);
 
661
        if (c == EOF || !(isalnum(c) || c == '_'))
 
662
          break;
 
663
        mname[cnt++] = c;
 
664
        if (cnt==mlen)
 
665
          mname = (char *)realloc(mname, mlen+=40);
 
666
      }
 
667
      mname[cnt] = '\0';
 
668
      if (strcmp(preprocName, "define") == 0 &&
 
669
          !(ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)) {
 
670
        MACRO *mm = (MACRO*) mmalloc(csound, sizeof(MACRO));
 
671
        int   arg = 0;
 
672
        int   size = 40;
 
673
        mm->margs = MARGS;    /* Initial size */
 
674
        while (isspace((c = getorchar(csound))))
 
675
          ;
 
676
        while (isNameChar(c, i)) {
 
677
          mname[i++] = c;
 
678
          if (i==mlen)
 
679
            mname = (char *)realloc(mname, mlen+=40);
 
680
          c = getorchar(csound);
 
681
        }
 
682
        mname[i] = '\0';
 
683
        if (csound->oparms->msglevel & 7)
 
684
          csound->Message(csound, Str("Macro definition for %s\n"), mname);
 
685
        mm->name = mmalloc(csound, i + 1);
 
686
        strcpy(mm->name, mname);
 
687
        if (c == '(') {       /* arguments */
 
688
#ifdef MACDEBUG
 
689
          csound->Message(csound, "M-arguments: ");
 
690
#endif
 
691
          do {
 
692
            while (isspace((c = getorchar_noeof(csound))))
 
693
              ;
 
694
            i = 0;
 
695
            while (isNameChar(c, i)) {
 
696
              mname[i++] = c;
 
697
              if (i==mlen)
 
698
                mname = (char *)realloc(mname, mlen+=40);
 
699
              c = getorchar(csound);
 
700
            }
 
701
            mname[i] = '\0';
 
702
#ifdef MACDEBUG
 
703
            csound->Message(csound, "%s\t", mname);
 
704
#endif
 
705
            mm->arg[arg] = mmalloc(csound, i + 1);
 
706
            strcpy(mm->arg[arg++], mname);
 
707
            if (arg >= mm->margs) {
 
708
              mm = (MACRO*) mrealloc(csound, mm, sizeof(MACRO)
 
709
                                     + mm->margs * sizeof(char*));
 
710
              mm->margs += MARGS;
 
711
            }
 
712
            while (isspace(c))
 
713
              c = getorchar_noeof(csound);
 
714
          } while (c == '\'' || c == '#');
 
715
          if (UNLIKELY(c != ')'))
 
716
            csound->Message(csound, Str("macro error\n"));
 
717
        }
 
718
        mm->acnt = arg;
615
719
        i = 0;
616
 
        cnt = 0;
617
 
        mname[cnt++] = '#';
618
 
        if (cnt==mlen)
619
 
          mname = (char *)realloc(mname, mlen+=40);
620
 
        do {
621
 
          c = getorchar(csound);
622
 
          if (UNLIKELY(c == EOF))
623
 
            break;
624
 
          mname[cnt++] = c;
625
 
          if (cnt==mlen)
626
 
            mname = (char *)realloc(mname, mlen+=40);
627
 
        } while ((c == ' ' || c == '\t'));
628
 
        mname[cnt] = '\0';
629
 
        if (c == EOF || c == '\n')
630
 
          goto unknownPreproc;
631
 
        preprocName = &(mname[cnt - 1]);
632
 
        while (1) {
633
 
          c = getorchar(csound);
634
 
          if (c == EOF || !(isalnum(c) || c == '_'))
635
 
            break;
636
 
          mname[cnt++] = c;
637
 
          if (cnt==mlen)
638
 
            mname = (char *)realloc(mname, mlen+=40);
639
 
        }
640
 
        mname[cnt] = '\0';
641
 
        if (strcmp(preprocName, "define") == 0 &&
642
 
            !(ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)) {
643
 
          MACRO *mm = (MACRO*) mmalloc(csound, sizeof(MACRO));
644
 
          int   arg = 0;
645
 
          int   size = 40;
646
 
          mm->margs = MARGS;    /* Initial size */
647
 
          while (isspace((c = getorchar(csound))))
648
 
            ;
649
 
          while (isNameChar(c, i)) {
650
 
            mname[i++] = c;
651
 
            if (i==mlen)
652
 
              mname = (char *)realloc(mname, mlen+=40);
653
 
            c = getorchar(csound);
654
 
          }
655
 
          mname[i] = '\0';
656
 
          if (csound->oparms->msglevel & 7)
657
 
            csound->Message(csound, Str("Macro definition for %s\n"), mname);
658
 
          mm->name = mmalloc(csound, i + 1);
659
 
          strcpy(mm->name, mname);
660
 
          if (c == '(') {       /* arguments */
661
 
#ifdef MACDEBUG
662
 
            csound->Message(csound, "M-arguments: ");
663
 
#endif
664
 
            do {
665
 
              while (isspace((c = getorchar_noeof(csound))))
666
 
                ;
667
 
              i = 0;
668
 
              while (isNameChar(c, i)) {
669
 
                mname[i++] = c;
670
 
                if (i==mlen)
671
 
                  mname = (char *)realloc(mname, mlen+=40);
672
 
                c = getorchar(csound);
673
 
              }
674
 
              mname[i] = '\0';
675
 
#ifdef MACDEBUG
676
 
              csound->Message(csound, "%s\t", mname);
677
 
#endif
678
 
              mm->arg[arg] = mmalloc(csound, i + 1);
679
 
              strcpy(mm->arg[arg++], mname);
680
 
              if (arg >= mm->margs) {
681
 
                mm = (MACRO*) mrealloc(csound, mm, sizeof(MACRO)
682
 
                                                   + mm->margs * sizeof(char*));
683
 
                mm->margs += MARGS;
684
 
              }
685
 
              while (isspace(c))
686
 
                c = getorchar_noeof(csound);
687
 
            } while (c == '\'' || c == '#');
688
 
            if (UNLIKELY(c != ')'))
689
 
              csound->Message(csound, Str("macro error\n"));
690
 
          }
691
 
          mm->acnt = arg;
692
 
          i = 0;
693
 
          while (c != '#')
694
 
            c = getorchar_noeof(csound);        /* Skip to next # */
695
 
          mm->body = (char*) mmalloc(csound, 100);
696
 
          while ((c = getorchar_noeof(csound)) != '#') {
697
 
            mm->body[i++] = c;
 
720
        while (c != '#')
 
721
          c = getorchar_noeof(csound);        /* Skip to next # */
 
722
        mm->body = (char*) mmalloc(csound, 100);
 
723
        while ((c = getorchar_noeof(csound)) != '#') {
 
724
          mm->body[i++] = c;
 
725
          if (UNLIKELY(i >= size))
 
726
            mm->body = mrealloc(csound, mm->body, size += 100);
 
727
          if (c == '\\') {                    /* allow escaped # */
 
728
            mm->body[i++] = c = getorchar_noeof(csound);
698
729
            if (UNLIKELY(i >= size))
699
730
              mm->body = mrealloc(csound, mm->body, size += 100);
700
 
            if (c == '\\') {                    /* allow escaped # */
701
 
              mm->body[i++] = c = getorchar_noeof(csound);
702
 
              if (UNLIKELY(i >= size))
703
 
                mm->body = mrealloc(csound, mm->body, size += 100);
704
 
            }
705
 
            if (c == '\n')
706
 
              srccnt++;
707
 
          }
708
 
          mm->body[i] = '\0';
709
 
          mm->next = ST(macros);
710
 
          ST(macros) = mm;
711
 
#ifdef MACDEBUG
712
 
          csound->Message(csound, "Macro %s with %d arguments defined\n",
713
 
                                  mm->name, mm->acnt);
714
 
#endif
715
 
          c = ' ';
716
 
        }
717
 
        else if (strcmp(preprocName, "include") == 0 &&
718
 
                 !(ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)) {
719
 
          int   delim;
720
 
          while (isspace(c))
721
 
            c = getorchar(csound);
722
 
          delim = c;
723
 
          i = 0;
724
 
          while ((c = getorchar_noeof(csound)) != delim) {
725
 
            mname[i++] = c;
726
 
            if (i==mlen)
727
 
              mname = (char *)realloc(mname, mlen+=40);
728
 
          }
729
 
           mname[i] = '\0';
730
 
          do {
731
 
            c = getorchar(csound);
732
 
          } while (c != EOF && c != '\n');
733
 
#ifdef MACDEBUG
734
 
          csound->Message(csound, "#include \"%s\"\n", mname);
735
 
#endif
736
 
          ST(input_cnt)++;
737
 
          if (ST(input_cnt) >= ST(input_size)) {
738
 
            ST(input_size) += 20;
739
 
            ST(inputs) = mrealloc(csound, ST(inputs), ST(input_size)
740
 
                                                      * sizeof(IN_STACK));
741
 
          }
742
 
          ST(str) = (IN_STACK*) ST(inputs) + (int) ST(input_cnt);
743
 
          ST(str)->string = 0;
744
 
          ST(str)->fd = fopen_path(csound, &(ST(str)->file),
745
 
                                        mname, csound->orchname, "INCDIR", 0);
746
 
          if (UNLIKELY(ST(str)->fd == NULL)) {
747
 
            csound->Message(csound,
748
 
                            Str("Cannot open #include'd file %s\n"), mname);
749
 
            /* Should this stop things?? */
750
 
            ST(str)--; ST(input_cnt)--;
751
 
          }
752
 
          else {
753
 
            ST(str)->body = csound->GetFileName(ST(str)->fd);
754
 
            ST(str)->line = 1;
755
 
            ST(str)->unget_cnt = 0;
756
 
            ST(linepos) = -1;
757
 
          }
758
 
        }
759
 
        else if (strcmp(preprocName, "ifdef") == 0 ||
760
 
                 strcmp(preprocName, "ifndef") == 0) {
761
 
          MACRO   *mm;                  /* #ifdef or #ifndef */
762
 
          IFDEFSTACK  *pp;
763
 
          pp = (IFDEFSTACK*) mcalloc(csound, sizeof(IFDEFSTACK));
764
 
          pp->prv = ST(ifdefStack);
765
 
          if (strcmp(preprocName, "ifndef") == 0)
766
 
            pp->isDef = 1;
767
 
          while (isspace(c = getorchar(csound)))
768
 
            ;
769
 
          while (isNameChar(c, i)) {
770
 
            mname[i++] = c;
771
 
            if (i==mlen)
772
 
              mname = (char *)realloc(mname, mlen+=40);
773
 
            c = getorchar(csound);
774
 
          }
775
 
          mname[i] = '\0';
776
 
          for (mm = ST(macros); mm != NULL; mm = mm->next) {
777
 
            if (strcmp(mname, mm->name) == 0) {
778
 
              pp->isDef ^= (unsigned char) 1;
779
 
              break;
780
 
            }
781
 
          }
782
 
          ST(ifdefStack) = pp;
783
 
          pp->isSkip = pp->isDef ^ (unsigned char) 1;
784
 
          if (pp->prv != NULL && pp->prv->isSkip)
785
 
            pp->isSkip |= (unsigned char) 2;
786
 
          if (!pp->isSkip) {
787
 
            while (c != '\n' && c != EOF) {     /* Skip to end of line */
788
 
              c = getorchar(csound);
789
 
            }
790
 
            srccnt++; goto top;
791
 
          }
792
 
          else {                                /* Skip a section of code */
793
 
 ifdefSkipCode:
794
 
            do {
795
 
              while (c != '\n') {
796
 
                if (UNLIKELY(c == EOF))
797
 
                  lexerr(csound, Str("unmatched #ifdef"));
798
 
                c = getorchar(csound);
799
 
              }
800
 
              srccnt++;
801
 
              c = getorchar(csound);
802
 
            } while (c != '#');
803
 
            goto parsePreproc;
804
 
          }
805
 
        }
806
 
        else if (strcmp(preprocName, "else") == 0) {
807
 
          if (ST(ifdefStack) == NULL || ST(ifdefStack)->isElse)
808
 
            lexerr(csound, Str("Unmatched #else"));
809
 
          while (c != '\n' && c != EOF)
810
 
            c = getorchar(csound);
811
 
          srccnt++;
812
 
          ST(ifdefStack)->isElse = 1;
813
 
          ST(ifdefStack)->isSkip ^= (unsigned char) 1;
814
 
          if (ST(ifdefStack)->isSkip)
815
 
            goto ifdefSkipCode;
816
 
          goto top;
817
 
        }
818
 
        else if (strcmp(preprocName, "end") == 0 ||
819
 
                 strcmp(preprocName, "endif") == 0) {
820
 
          IFDEFSTACK  *pp = ST(ifdefStack);
821
 
          if (UNLIKELY(pp == NULL))
822
 
            lexerr(csound, Str("Unmatched #endif"));
823
 
          while (c != '\n' && c != EOF) {
824
 
            c = getorchar(csound);
825
 
          }
826
 
          srccnt++;
827
 
          ST(ifdefStack) = pp->prv;
828
 
          mfree(csound, pp);
829
 
          if (ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)
830
 
            goto ifdefSkipCode;
831
 
          goto top;
832
 
        }
833
 
        else if (strcmp(preprocName, "undef") == 0 &&
834
 
                 !(ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)) {
835
 
          while (isspace(c = getorchar(csound)))
836
 
            ;
837
 
          while (isNameChar(c, i)) {
838
 
            mname[i++] = c;
839
 
            if (i==mlen)
840
 
              mname = (char *)realloc(mname, mlen+=40);
841
 
            c = getorchar(csound);
842
 
          }
843
 
          mname[i] = '\0';
844
 
          if (csound->oparms->msglevel)
845
 
            csound->Message(csound,Str("macro %s undefined\n"), mname);
846
 
          if (strcmp(mname, ST(macros)->name)==0) {
847
 
            MACRO *mm=ST(macros)->next;
848
 
            mfree(csound, ST(macros)->name); mfree(csound, ST(macros)->body);
849
 
            for (i=0; i<ST(macros)->acnt; i++)
850
 
              mfree(csound, ST(macros)->arg[i]);
851
 
            mfree(csound, ST(macros)); ST(macros) = mm;
852
 
          }
853
 
          else {
854
 
            MACRO *mm = ST(macros);
855
 
            MACRO *nn = mm->next;
856
 
            while (strcmp(mname, nn->name) != 0) {
857
 
              mm = nn; nn = nn->next;
858
 
              if (nn == NULL)
859
 
                lexerr(csound, Str("Undefining undefined macro"));
860
 
            }
861
 
            mfree(csound, nn->name); mfree(csound, nn->body);
862
 
            for (i=0; i<nn->acnt; i++)
863
 
              mfree(csound, nn->arg[i]);
864
 
            mm->next = nn->next; mfree(csound, nn);
865
 
          }
866
 
          while (c != '\n' && c != EOF)
867
 
            c = getorchar(csound);              /* ignore rest of line */
868
 
          srccnt++;
869
 
        }
870
 
        else {
871
 
 unknownPreproc:
872
 
          if (ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)
873
 
            goto ifdefSkipCode;
874
 
          if (preprocName == NULL)
875
 
            lexerr(csound, Str("Unexpected # character"));
876
 
          else
877
 
            lexerr(csound, Str("Unknown # option: '%s'"), preprocName);
878
 
        }
879
 
        free(mname);
 
731
          }
 
732
          if (c == '\n')
 
733
            srccnt++;
 
734
        }
 
735
        mm->body[i] = '\0';
 
736
        mm->next = ST(macros);
 
737
        ST(macros) = mm;
 
738
#ifdef MACDEBUG
 
739
        csound->Message(csound, "Macro %s with %d arguments defined\n",
 
740
                        mm->name, mm->acnt);
 
741
#endif
 
742
        c = ' ';
880
743
      }
881
 
      else if (c == '$' && !heredoc) {
882
 
        char      name[100];
883
 
        int       i = 0;
884
 
        int       j;
885
 
        MACRO     *mm, *mm_save = NULL;
886
 
        ST(ingappop) = 0;
887
 
        while (isNameChar((c = getorchar(csound)), i)) {
888
 
          name[i++] = c; name[i] = '\0';
889
 
          mm = ST(macros);
890
 
          while (mm != NULL) {  /* Find the definition */
891
 
            if (!(strcmp(name, mm->name))) {
892
 
              mm_save = mm;     /* found a match, save it */
893
 
              break;
894
 
            }
895
 
            mm = mm->next;
896
 
          }
897
 
        }
898
 
        mm = mm_save;
899
 
        if (UNLIKELY(mm == NULL)) {
900
 
          if (i)
901
 
            lexerr(csound,Str("Undefined macro: '%s'"), name);
902
 
          else
903
 
            lexerr(csound,Str("Macro expansion symbol ($) without macro name"));
904
 
          continue;
905
 
        }
906
 
        if ((int) strlen(mm->name) != i) {
907
 
          int cnt = i - (int) strlen(mm->name);
908
 
          csound->Warning(csound, Str("$%s matches macro name $%s"),
909
 
                                  name, mm->name);
910
 
          do {
911
 
            ungetorchar(csound, c);
912
 
            c = name[--i];
913
 
          } while (cnt--);
914
 
        }
915
 
        else if (c != '.')
916
 
          ungetorchar(csound, c);
917
 
#ifdef MACDEBUG
918
 
        csound->Message(csound, "Found macro %s required %d arguments\n",
919
 
                                mm->name, mm->acnt);
920
 
#endif
921
 
        /* Should bind arguments here */
922
 
        /* How do I recognise entities?? */
923
 
        if (mm->acnt) {
924
 
          if (UNLIKELY((c = getorchar(csound)) != '('))
925
 
            lexerr(csound, Str("Syntax error in macro call"));
926
 
          for (j = 0; j < mm->acnt; j++) {
927
 
            char  term = (j == mm->acnt - 1 ? ')' : '\'');
928
 
            char  trm1 = (j == mm->acnt - 1 ? ')' : '#');   /* Compatability */
929
 
            MACRO *nn = (MACRO*) mmalloc(csound, sizeof(MACRO));
930
 
            int   size = 100;
931
 
            nn->name = mmalloc(csound, strlen(mm->arg[j]) + 1);
932
 
            strcpy(nn->name, mm->arg[j]);
933
 
#ifdef MACDEBUG
934
 
            csound->Message(csound, "defining argument %s ", nn->name);
935
 
#endif
936
 
            i = 0;
937
 
            nn->body = (char*) mmalloc(csound, 100);
938
 
            while ((c = getorchar(csound))!= term && c!=trm1) {
939
 
              if (UNLIKELY(i > 98)) {
940
 
                csound->Die(csound, Str("Missing argument terminator\n%.98s"),
941
 
                                    nn->body);
942
 
              }
943
 
              nn->body[i++] = c;
944
 
              if (UNLIKELY(i >= size))
945
 
                nn->body = mrealloc(csound, nn->body, size += 100);
946
 
              if (c == '\n') {
947
 
                srccnt++;
948
 
              }
949
 
            }
950
 
            nn->body[i] = '\0';
951
 
#ifdef MACDEBUG
952
 
            csound->Message(csound, "as...#%s#\n", nn->body);
953
 
#endif
954
 
            nn->acnt = 0;       /* No arguments for arguments */
955
 
            nn->next = ST(macros);
956
 
            ST(macros) = nn;
957
 
          }
958
 
        }
959
 
        cp--;                   /* Ignore $ sign */
 
744
      else if (strcmp(preprocName, "include") == 0 &&
 
745
               !(ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)) {
 
746
        int   delim;
 
747
        while (isspace(c))
 
748
          c = getorchar(csound);
 
749
        delim = c;
 
750
        i = 0;
 
751
        while ((c = getorchar_noeof(csound)) != delim) {
 
752
          mname[i++] = c;
 
753
          if (i==mlen)
 
754
            mname = (char *)realloc(mname, mlen+=40);
 
755
        }
 
756
        mname[i] = '\0';
 
757
        do {
 
758
          c = getorchar(csound);
 
759
        } while (c != EOF && c != '\n');
 
760
#ifdef MACDEBUG
 
761
        csound->Message(csound, "#include \"%s\"\n", mname);
 
762
#endif
960
763
        ST(input_cnt)++;
961
764
        if (ST(input_cnt) >= ST(input_size)) {
962
765
          ST(input_size) += 20;
963
 
          ST(inputs) = (IN_STACK*) mrealloc(csound, ST(inputs),
964
 
                                            ST(input_size) * sizeof(IN_STACK));
 
766
          ST(inputs) = mrealloc(csound, ST(inputs), ST(input_size)
 
767
                                * sizeof(IN_STACK));
965
768
        }
966
769
        ST(str) = (IN_STACK*) ST(inputs) + (int) ST(input_cnt);
967
 
        ST(str)->string = 1; ST(str)->body = mm->body; ST(str)->args = mm->acnt;
968
 
        ST(str)->mac = mm;
969
 
        ST(str)->line = 1;
970
 
        ST(str)->unget_cnt = 0;
971
 
        ST(ingappop) = 1;
972
 
      }
973
 
    }
974
 
    if (UNLIKELY(ST(ifdefStack) != NULL))
975
 
      lexerr(csound, Str("Unmatched #ifdef"));
976
 
    if (UNLIKELY(cp >= endspace)) {                   /* Ought to extend */
977
 
      csoundDie(csound, Str("file too large for ortext space"));
978
 
    }
979
 
    if (*(cp-1) != '\n')                    /* if no final NL,      */
980
 
      *cp++ = '\n';                         /*    add one           */
981
 
    else --lincnt;
982
 
    ST(linadr)[lincnt+1] = NULL;            /* terminate the adrs list */
 
770
        ST(str)->string = 0;
 
771
        ST(str)->fd = fopen_path(csound, &(ST(str)->file),
 
772
                                 mname, csound->orchname, "INCDIR", 0);
 
773
        if (UNLIKELY(ST(str)->fd == NULL)) {
 
774
          csound->Message(csound,
 
775
                          Str("Cannot open #include'd file %s\n"), mname);
 
776
          /* Should this stop things?? */
 
777
          ST(str)--; ST(input_cnt)--;
 
778
        }
 
779
        else {
 
780
          ST(str)->body = csound->GetFileName(ST(str)->fd);
 
781
          ST(str)->line = 1;
 
782
          ST(str)->unget_cnt = 0;
 
783
          ST(linepos) = -1;
 
784
        }
 
785
      }
 
786
      else if (strcmp(preprocName, "ifdef") == 0 ||
 
787
               strcmp(preprocName, "ifndef") == 0) {
 
788
        MACRO   *mm;                  /* #ifdef or #ifndef */
 
789
        IFDEFSTACK  *pp;
 
790
        pp = (IFDEFSTACK*) mcalloc(csound, sizeof(IFDEFSTACK));
 
791
        pp->prv = ST(ifdefStack);
 
792
        if (strcmp(preprocName, "ifndef") == 0)
 
793
          pp->isDef = 1;
 
794
        while (isspace(c = getorchar(csound)))
 
795
          ;
 
796
        while (isNameChar(c, i)) {
 
797
          mname[i++] = c;
 
798
          if (i==mlen)
 
799
            mname = (char *)realloc(mname, mlen+=40);
 
800
          c = getorchar(csound);
 
801
        }
 
802
        mname[i] = '\0';
 
803
        for (mm = ST(macros); mm != NULL; mm = mm->next) {
 
804
          if (strcmp(mname, mm->name) == 0) {
 
805
            pp->isDef ^= (unsigned char) 1;
 
806
            break;
 
807
          }
 
808
        }
 
809
        ST(ifdefStack) = pp;
 
810
        pp->isSkip = pp->isDef ^ (unsigned char) 1;
 
811
        if (pp->prv != NULL && pp->prv->isSkip)
 
812
          pp->isSkip |= (unsigned char) 2;
 
813
        if (!pp->isSkip) {
 
814
          while (c != '\n' && c != EOF) {     /* Skip to end of line */
 
815
            c = getorchar(csound);
 
816
          }
 
817
          srccnt++; goto top;
 
818
        }
 
819
        else {                                /* Skip a section of code */
 
820
        ifdefSkipCode:
 
821
          do {
 
822
            while (c != '\n') {
 
823
              if (UNLIKELY(c == EOF))
 
824
                lexerr(csound, Str("unmatched #ifdef"));
 
825
              c = getorchar(csound);
 
826
            }
 
827
            srccnt++;
 
828
            c = getorchar(csound);
 
829
          } while (c != '#');
 
830
          goto parsePreproc;
 
831
        }
 
832
      }
 
833
      else if (strcmp(preprocName, "else") == 0) {
 
834
        if (ST(ifdefStack) == NULL || ST(ifdefStack)->isElse)
 
835
          lexerr(csound, Str("Unmatched #else"));
 
836
        while (c != '\n' && c != EOF)
 
837
          c = getorchar(csound);
 
838
        srccnt++;
 
839
        ST(ifdefStack)->isElse = 1;
 
840
        ST(ifdefStack)->isSkip ^= (unsigned char) 1;
 
841
        if (ST(ifdefStack)->isSkip)
 
842
          goto ifdefSkipCode;
 
843
        goto top;
 
844
      }
 
845
      else if (strcmp(preprocName, "end") == 0 ||
 
846
               strcmp(preprocName, "endif") == 0) {
 
847
        IFDEFSTACK  *pp = ST(ifdefStack);
 
848
        if (UNLIKELY(pp == NULL))
 
849
          lexerr(csound, Str("Unmatched #endif"));
 
850
        while (c != '\n' && c != EOF) {
 
851
          c = getorchar(csound);
 
852
        }
 
853
        srccnt++;
 
854
        ST(ifdefStack) = pp->prv;
 
855
        mfree(csound, pp);
 
856
        if (ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)
 
857
          goto ifdefSkipCode;
 
858
        goto top;
 
859
      }
 
860
      else if (strcmp(preprocName, "undef") == 0 &&
 
861
               !(ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)) {
 
862
        while (isspace(c = getorchar(csound)))
 
863
          ;
 
864
        while (isNameChar(c, i)) {
 
865
          mname[i++] = c;
 
866
          if (i==mlen)
 
867
            mname = (char *)realloc(mname, mlen+=40);
 
868
          c = getorchar(csound);
 
869
        }
 
870
        mname[i] = '\0';
 
871
        if (csound->oparms->msglevel)
 
872
          csound->Message(csound,Str("macro %s undefined\n"), mname);
 
873
        if (strcmp(mname, ST(macros)->name)==0) {
 
874
          MACRO *mm=ST(macros)->next;
 
875
          mfree(csound, ST(macros)->name); mfree(csound, ST(macros)->body);
 
876
          for (i=0; i<ST(macros)->acnt; i++)
 
877
            mfree(csound, ST(macros)->arg[i]);
 
878
          mfree(csound, ST(macros)); ST(macros) = mm;
 
879
        }
 
880
        else {
 
881
          MACRO *mm = ST(macros);
 
882
          MACRO *nn = mm->next;
 
883
          while (strcmp(mname, nn->name) != 0) {
 
884
            mm = nn; nn = nn->next;
 
885
            if (nn == NULL)
 
886
              lexerr(csound, Str("Undefining undefined macro"));
 
887
          }
 
888
          mfree(csound, nn->name); mfree(csound, nn->body);
 
889
          for (i=0; i<nn->acnt; i++)
 
890
            mfree(csound, nn->arg[i]);
 
891
          mm->next = nn->next; mfree(csound, nn);
 
892
        }
 
893
        while (c != '\n' && c != EOF)
 
894
          c = getorchar(csound);              /* ignore rest of line */
 
895
        srccnt++;
 
896
      }
 
897
      else {
 
898
      unknownPreproc:
 
899
        if (ST(ifdefStack) != NULL && ST(ifdefStack)->isSkip)
 
900
          goto ifdefSkipCode;
 
901
        if (preprocName == NULL)
 
902
          lexerr(csound, Str("Unexpected # character"));
 
903
        else if (strcmp("exit", preprocName)) /* VL: ignore #exit */
 
904
          lexerr(csound, Str("Unknown # option: '%s'"), preprocName);
 
905
      }
 
906
      free(mname);
 
907
    }
 
908
    else if (c == '$' && !heredoc) {
 
909
      char      name[100];
 
910
      int       i = 0;
 
911
      int       j;
 
912
      MACRO     *mm, *mm_save = NULL;
 
913
      ST(ingappop) = 0;
 
914
      while (isNameChar((c = getorchar(csound)), i)) {
 
915
        name[i++] = c; name[i] = '\0';
 
916
        mm = ST(macros);
 
917
        while (mm != NULL) {  /* Find the definition */
 
918
          if (!(strcmp(name, mm->name))) {
 
919
            mm_save = mm;     /* found a match, save it */
 
920
            break;
 
921
          }
 
922
          mm = mm->next;
 
923
        }
 
924
      }
 
925
      mm = mm_save;
 
926
      if (UNLIKELY(mm == NULL)) {
 
927
        if (i)
 
928
          lexerr(csound,Str("Undefined macro: '%s'"), name);
 
929
        else
 
930
          lexerr(csound,Str("Macro expansion symbol ($) without macro name"));
 
931
        continue;
 
932
      }
 
933
      if ((int) strlen(mm->name) != i) {
 
934
        int cnt = i - (int) strlen(mm->name);
 
935
        csound->Warning(csound, Str("$%s matches macro name $%s"),
 
936
                        name, mm->name);
 
937
        do {
 
938
          ungetorchar(csound, c);
 
939
          c = name[--i];
 
940
        } while (cnt--);
 
941
      }
 
942
      else if (c != '.')
 
943
        ungetorchar(csound, c);
 
944
#ifdef MACDEBUG
 
945
      csound->Message(csound, "Found macro %s required %d arguments\n",
 
946
                      mm->name, mm->acnt);
 
947
#endif
 
948
      /* Should bind arguments here */
 
949
      /* How do I recognise entities?? */
 
950
      if (mm->acnt) {
 
951
        if (UNLIKELY((c = getorchar(csound)) != '('))
 
952
          lexerr(csound, Str("Syntax error in macro call"));
 
953
        for (j = 0; j < mm->acnt; j++) {
 
954
          char  term = (j == mm->acnt - 1 ? ')' : '\'');
 
955
          char  trm1 = (j == mm->acnt - 1 ? ')' : '#');   /* Compatability */
 
956
          MACRO *nn = (MACRO*) mmalloc(csound, sizeof(MACRO));
 
957
          int   size = 100;
 
958
          nn->name = mmalloc(csound, strlen(mm->arg[j]) + 1);
 
959
          strcpy(nn->name, mm->arg[j]);
 
960
#ifdef MACDEBUG
 
961
          csound->Message(csound, "defining argument %s ", nn->name);
 
962
#endif
 
963
          i = 0;
 
964
          nn->body = (char*) mmalloc(csound, 100);
 
965
          while ((c = getorchar(csound))!= term && c!=trm1) {
 
966
            if (UNLIKELY(i > 98)) {
 
967
              csound->Die(csound, Str("Missing argument terminator\n%.98s"),
 
968
                          nn->body);
 
969
            }
 
970
            nn->body[i++] = c;
 
971
            if (UNLIKELY(i >= size))
 
972
              nn->body = mrealloc(csound, nn->body, size += 100);
 
973
            if (c == '\n') {
 
974
              srccnt++;
 
975
            }
 
976
          }
 
977
          nn->body[i] = '\0';
 
978
#ifdef MACDEBUG
 
979
          csound->Message(csound, "as...#%s#\n", nn->body);
 
980
#endif
 
981
          nn->acnt = 0;       /* No arguments for arguments */
 
982
          nn->next = ST(macros);
 
983
          ST(macros) = nn;
 
984
        }
 
985
      }
 
986
      cp--;                   /* Ignore $ sign */
 
987
      ST(input_cnt)++;
 
988
      if (ST(input_cnt) >= ST(input_size)) {
 
989
        ST(input_size) += 20;
 
990
        ST(inputs) = (IN_STACK*) mrealloc(csound, ST(inputs),
 
991
                                          ST(input_size) * sizeof(IN_STACK));
 
992
      }
 
993
      ST(str) = (IN_STACK*) ST(inputs) + (int) ST(input_cnt);
 
994
      ST(str)->string = 1; ST(str)->body = mm->body; ST(str)->args = mm->acnt;
 
995
      ST(str)->mac = mm;
 
996
      ST(str)->line = 1;
 
997
      ST(str)->unget_cnt = 0;
 
998
      ST(ingappop) = 1;
 
999
    }
 
1000
  }
 
1001
  if (UNLIKELY(ST(ifdefStack) != NULL))
 
1002
    lexerr(csound, Str("Unmatched #ifdef"));
 
1003
  if (UNLIKELY(cp >= endspace)) {                   /* Ought to extend */
 
1004
    csoundDie(csound, Str("file too large for ortext space"));
 
1005
  }
 
1006
  if (*(cp-1) != '\n')                    /* if no final NL,      */
 
1007
    *cp++ = '\n';                         /*    add one           */
 
1008
  else --lincnt;
 
1009
  ST(linadr)[lincnt+1] = NULL;            /* terminate the adrs list */
983
1010
#ifdef BETA
984
 
    csound->Message(csound,Str("%d (%d) lines read\n"),lincnt, srccnt);
 
1011
  csound->Message(csound,Str("%d (%d) lines read\n"),lincnt, srccnt);
985
1012
#endif
986
 
    if (ST(fd) != NULL) {
987
 
      csound->FileClose(csound, ST(fd));    /* close the file       */
988
 
      ST(fd) = NULL;
989
 
    }
990
 
    ST(curline) = 0;                        /*   & reset to line 1  */
991
 
    ST(ortext) = ortext;
992
 
    while (ST(macros)) {                    /* Clear all macros */
993
 
      int i;
994
 
      mfree(csound, ST(macros)->body);
995
 
      mfree(csound, ST(macros)->name);
996
 
      for (i = 0; i < ST(macros)->acnt; i++)
997
 
        mfree(csound, ST(macros)->arg[i]);
998
 
      ST(macros) = ST(macros)->next;
999
 
    }                                       /* nullist is a count only */
1000
 
    ST(nullist) = (ARGLST *) mmalloc(csound, sizeof(ARGLST));
1001
 
    ST(nullist)->count = 0;
1002
 
    ST(nxtarglist) = (ARGLST*) mmalloc(csound, sizeof(ARGLST)
1003
 
                                               + 200 * sizeof(char*));
 
1013
  if (ST(fd) != NULL) {
 
1014
    csound->FileClose(csound, ST(fd));    /* close the file       */
 
1015
    ST(fd) = NULL;
 
1016
  }
 
1017
  ST(curline) = 0;                        /*   & reset to line 1  */
 
1018
  ST(ortext) = ortext;
 
1019
  while (ST(macros)) {                    /* Clear all macros */
 
1020
    int i;
 
1021
    mfree(csound, ST(macros)->body);
 
1022
    mfree(csound, ST(macros)->name);
 
1023
    for (i = 0; i < ST(macros)->acnt; i++)
 
1024
      mfree(csound, ST(macros)->arg[i]);
 
1025
    ST(macros) = ST(macros)->next;
 
1026
  }                                       /* nullist is a count only */
 
1027
  ST(nullist) = (ARGLST *) mmalloc(csound, sizeof(ARGLST));
 
1028
  ST(nullist)->count = 0;
 
1029
  ST(nxtarglist) = (ARGLST*) mmalloc(csound, sizeof(ARGLST)
 
1030
                                     + 200 * sizeof(char*));
1004
1031
}
1005
1032
 
1006
1033
static void extend_collectbuf(CSOUND *csound, char **cp, int grpcnt)
1007
1034
{
1008
 
    char  *nn;
1009
 
    int   i;
 
1035
  char  *nn;
 
1036
  int   i;
1010
1037
 
1011
 
    i = (int) ST(lenmax);
1012
 
    ST(lenmax) <<= 1;
1013
 
    nn = mrealloc(csound, ST(collectbuf), ST(lenmax) + 16);
1014
 
    (*cp) += (nn - ST(collectbuf));     /* Adjust pointer */
1015
 
    for ( ; i < (int) ST(lenmax); i++)
1016
 
      nn[i] = (char) 0;
1017
 
    /* Need to correct grp vector */
1018
 
    for (i = 0; i < grpcnt; i++)
1019
 
      ST(group)[i] += (nn - ST(collectbuf));
1020
 
    ST(collectbuf) = nn;
 
1038
  i = (int) ST(lenmax);
 
1039
  ST(lenmax) <<= 1;
 
1040
  nn = mrealloc(csound, ST(collectbuf), ST(lenmax) + 16);
 
1041
  (*cp) += (nn - ST(collectbuf));     /* Adjust pointer */
 
1042
  for ( ; i < (int) ST(lenmax); i++)
 
1043
    nn[i] = (char) 0;
 
1044
  /* Need to correct grp vector */
 
1045
  for (i = 0; i < grpcnt; i++)
 
1046
    ST(group)[i] += (nn - ST(collectbuf));
 
1047
  ST(collectbuf) = nn;
1021
1048
}
1022
1049
 
1023
1050
static void extend_group(CSOUND *csound)
1024
1051
{
1025
 
    int32  i, j;
 
1052
  int32  i, j;
1026
1053
 
1027
 
    i = ST(grpmax);
1028
 
    j = i + (int32) GRPMAX;
1029
 
    ST(grpmax) = (j++);
1030
 
    ST(group) = (char **) mrealloc(csound, ST(group), j * sizeof(char *));
1031
 
    ST(grpsav) = (char **) mrealloc(csound, ST(grpsav), j * sizeof(char *));
1032
 
    while (++i < j) {
1033
 
      ST(group)[i] = (char *) NULL;
1034
 
      ST(grpsav)[i] = (char *) NULL;
1035
 
    }
 
1054
  i = ST(grpmax);
 
1055
  j = i + (int32) GRPMAX;
 
1056
  ST(grpmax) = (j++);
 
1057
  ST(group) = (char **) mrealloc(csound, ST(group), j * sizeof(char *));
 
1058
  ST(grpsav) = (char **) mrealloc(csound, ST(grpsav), j * sizeof(char *));
 
1059
  while (++i < j) {
 
1060
    ST(group)[i] = (char *) NULL;
 
1061
    ST(grpsav)[i] = (char *) NULL;
 
1062
  }
1036
1063
}
1037
1064
 
1038
1065
/* split next orch line into atomic groups, count */
1040
1067
 
1041
1068
static int splitline(CSOUND *csound)
1042
1069
{
1043
 
    int     grpcnt, prvif, prvelsif, logical, condassgn, parens;
1044
 
    int     c, collecting;
1045
 
    char    *cp, *lp, *grpp = NULL;
 
1070
  int     grpcnt, prvif, prvelsif, logical, condassgn, parens;
 
1071
  int     c, collecting;
 
1072
  char    *cp, *lp, *grpp = NULL;
1046
1073
 
1047
 
    if (ST(collectbuf) == NULL)
1048
 
      ST(collectbuf) = mcalloc(csound, ST(lenmax) + 16);
 
1074
  if (ST(collectbuf) == NULL)
 
1075
    ST(collectbuf) = mcalloc(csound, ST(lenmax) + 16);
1049
1076
 nxtlin:
1050
 
    if ((lp = ST(linadr)[++ST(curline)]) == NULL)   /* point at next line   */
1051
 
      return 0;
1052
 
    csound->DebugMsg(csound, Str("LINE %d:"), CURLINE);
1053
 
    ST(linlabels) = ST(opgrpno) = 0;
1054
 
    grpcnt = prvif = prvelsif = logical = condassgn = parens = collecting = 0;
1055
 
    cp = ST(collectbuf);
1056
 
    while ((c = *lp++) != '\n') {       /* for all chars this line:   */
1057
 
      if (cp - ST(collectbuf) >= ST(lenmax))
1058
 
        extend_collectbuf(csound, &cp, grpcnt);
1059
 
      if (c == ' ' || c == '\t' || c == '(') {      /* spaces, tabs, (:   */
1060
 
        if (!ST(opgrpno) && collecting) {           /*  those before args */
1061
 
          *cp++ = '\0';                             /*  can be delimiters */
1062
 
          collecting = 0;
1063
 
          if (strcmp(grpp, "if") == 0) {            /*  of if opcod, */
1064
 
            strcpy(grpp, "cggoto");                 /*  (replace) */
 
1077
  if ((lp = ST(linadr)[++ST(curline)]) == NULL)   /* point at next line   */
 
1078
    return 0;
 
1079
  csound->DebugMsg(csound, Str("LINE %d:"), CURLINE);
 
1080
  ST(linlabels) = ST(opgrpno) = 0;
 
1081
  grpcnt = prvif = prvelsif = logical = condassgn = parens = collecting = 0;
 
1082
  cp = ST(collectbuf);
 
1083
  while ((c = *lp++) != '\n') {       /* for all chars this line:   */
 
1084
    if (cp - ST(collectbuf) >= ST(lenmax))
 
1085
      extend_collectbuf(csound, &cp, grpcnt);
 
1086
    if (c == ' ' || c == '\t' || c == '(') {      /* spaces, tabs, (:   */
 
1087
      if (!ST(opgrpno) && collecting) {           /*  those before args */
 
1088
        *cp++ = '\0';                             /*  can be delimiters */
 
1089
        collecting = 0;
 
1090
        if (strcmp(grpp, "if") == 0) {            /*  of if opcod, */
 
1091
          strcpy(grpp, "cggoto");                 /*  (replace) */
 
1092
          cp = grpp + 7;
 
1093
          prvif++;
 
1094
        }
 
1095
        else if (strcmp(grpp, "elseif") == 0) {   /*  of elseif opcod, ... */
 
1096
          /* check to see we had an 'if' before */
 
1097
          if (!ST(iflabels)) {
 
1098
            synterr(csound, Str("invalid 'elseif' statement.  "
 
1099
                                "must have a corresponding 'if'"));
 
1100
            goto nxtlin;
 
1101
          }
 
1102
          /* check to see we did not have an 'else' before */
 
1103
          if (UNLIKELY(!ST(iflabels)->els[0])) {
 
1104
            synterr(csound,
 
1105
                    Str("'elseif' statement cannot occur after an 'else'"));
 
1106
            goto nxtlin;
 
1107
          }
 
1108
          /* 'elseif' requires 2 additional lines */
 
1109
          if (ST(repeatingElseifLine)) {
 
1110
            /* add the 'elselabel' */
 
1111
            ST(linlabels)++;
 
1112
            strcpy(grpp, ST(iflabels)->els);
 
1113
            cp = grpp + strlen(ST(iflabels)->els) + 1;
 
1114
            /* finally replace the 'elseif' with a 'goto' */
 
1115
            grpp = ST(group)[grpcnt++] = cp;
 
1116
            strcpy(grpp, "cggoto");
1065
1117
            cp = grpp + 7;
1066
1118
            prvif++;
1067
 
          }
1068
 
          else if (strcmp(grpp, "elseif") == 0) {   /*  of elseif opcod, ... */
1069
 
            /* check to see we had an 'if' before */
1070
 
            if (!ST(iflabels)) {
1071
 
              synterr(csound, Str("invalid 'elseif' statement.  "
1072
 
                                  "must have a corresponding 'if'"));
1073
 
              goto nxtlin;
1074
 
            }
1075
 
            /* check to see we did not have an 'else' before */
1076
 
            if (UNLIKELY(!ST(iflabels)->els[0])) {
1077
 
              synterr(csound,
1078
 
                      Str("'elseif' statement cannot occur after an 'else'"));
1079
 
              goto nxtlin;
1080
 
            }
1081
 
            /* 'elseif' requires 2 additional lines */
1082
 
            if (ST(repeatingElseifLine)) {
1083
 
              /* add the 'elselabel' */
1084
 
              ST(linlabels)++;
1085
 
              strcpy(grpp, ST(iflabels)->els);
1086
 
              cp = grpp + strlen(ST(iflabels)->els) + 1;
1087
 
              /* finally replace the 'elseif' with a 'goto' */
1088
 
              grpp = ST(group)[grpcnt++] = cp;
1089
 
              strcpy(grpp, "cggoto");
1090
 
              cp = grpp + 7;
1091
 
              prvif++;
1092
 
              prvelsif++;
1093
 
              ST(repeatingElseifLine) = 0;
1094
 
            }
1095
 
            else {
1096
 
              /* first add a 'goto endif' for the previous if */
1097
 
              if (ST(iflabels)->ithen > 0)
1098
 
                strcpy(grpp, "goto");
1099
 
              else
1100
 
                strcpy(grpp, "kgoto");
1101
 
              if (isopcod(csound, grpp))
1102
 
                ST(opgrpno) = grpcnt;
1103
 
              ST(group)[grpcnt] = strchr(grpp, '\0') + 1;
1104
 
              grpp = ST(group)[grpcnt++];
1105
 
              strcpy(grpp, ST(iflabels)->end);
1106
 
              ST(curline)--;    /* roll back one and parse this line again */
1107
 
              ST(repeatingElseifLine)++;
1108
 
              ST(linopnum) = ST(opnum);     /* else save full line ops */
1109
 
              ST(linopcod) = ST(opcod);
1110
 
              return grpcnt;
1111
 
            }
1112
 
          }
1113
 
          if (isopcod(csound, grpp))                /*  ... or maybe others */
1114
 
            ST(opgrpno) = grpcnt;
1115
 
        }
1116
 
        if (c == ' ' || c == '\t')
1117
 
          continue;                         /* now discard blanks */
1118
 
      }
1119
 
      else if (c == ';') {
1120
 
        while ((c = *lp++) != '\n');        /* comments:  gobble */
1121
 
        break;                              /*    & exit linloop */
1122
 
      }
1123
 
      else if (c == '/' && *lp == '*') {    /* C Style comments */
1124
 
        char *ll, *eol;
1125
 
        ll = strstr(lp++, "*/");
1126
 
      nxtl:
1127
 
        eol = strchr(lp, '\n');
1128
 
        if (eol != NULL && eol < ll) {
1129
 
          lp = ST(linadr)[++ST(curline)];
1130
 
          ll = strstr(lp, "*/");
1131
 
          goto nxtl;
1132
 
        }
1133
 
        if (UNLIKELY(ll == NULL)) {
1134
 
          synterrp(csound, lp - 2, Str("Unmatched comment"));
1135
 
          lp = eol + 1; break;
1136
 
        }
1137
 
        lp = ll + 2;
1138
 
        continue;
1139
 
      }
1140
 
      else if (c == '"') {                  /* quoted string: */
1141
 
        if (grpcnt >= ST(grpmax))
1142
 
          extend_group(csound);
1143
 
        grpp = ST(group)[grpcnt++] = cp;
1144
 
        *cp++ = c;                          /*  cpy to nxt quote */
1145
 
       do {
1146
 
       loop:
1147
 
         c = *lp++;
1148
 
         if (c=='\\' && *lp=='"') {        /* Deal with \" case */
1149
 
           *cp++ = '\\';
1150
 
           *cp++ = '"';
1151
 
           lp++;
1152
 
           goto loop;
1153
 
         }
1154
 
         *cp++ = c;
1155
 
       } while (c != '"' && c != '\n');
 
1119
            prvelsif++;
 
1120
            ST(repeatingElseifLine) = 0;
 
1121
          }
 
1122
          else {
 
1123
            /* first add a 'goto endif' for the previous if */
 
1124
            if (ST(iflabels)->ithen > 0)
 
1125
              strcpy(grpp, "goto");
 
1126
            else
 
1127
              strcpy(grpp, "kgoto");
 
1128
            if (isopcod(csound, grpp))
 
1129
              ST(opgrpno) = grpcnt;
 
1130
            ST(group)[grpcnt] = strchr(grpp, '\0') + 1;
 
1131
            grpp = ST(group)[grpcnt++];
 
1132
            strcpy(grpp, ST(iflabels)->end);
 
1133
            ST(curline)--;    /* roll back one and parse this line again */
 
1134
            ST(repeatingElseifLine)++;
 
1135
            ST(linopnum) = ST(opnum);     /* else save full line ops */
 
1136
            ST(linopcod) = ST(opcod);
 
1137
            return grpcnt;
 
1138
          }
 
1139
        }
 
1140
        if (isopcod(csound, grpp))                /*  ... or maybe others */
 
1141
          ST(opgrpno) = grpcnt;
 
1142
      }
 
1143
      if (c == ' ' || c == '\t')
 
1144
        continue;                         /* now discard blanks */
 
1145
    }
 
1146
    else if (c == ';') {
 
1147
      while ((c = *lp++) != '\n');        /* comments:  gobble */
 
1148
      break;                              /*    & exit linloop */
 
1149
    }
 
1150
    else if (c == '/' && *lp == '*') {    /* C Style comments */
 
1151
      char *ll, *eol;
 
1152
      ll = strstr(lp++, "*/");
 
1153
    nxtl:
 
1154
      eol = strchr(lp, '\n');
 
1155
      if (eol != NULL && eol < ll) {
 
1156
        lp = ST(linadr)[++ST(curline)];
 
1157
        ll = strstr(lp, "*/");
 
1158
        goto nxtl;
 
1159
      }
 
1160
      if (UNLIKELY(ll == NULL)) {
 
1161
        synterrp(csound, lp - 2, Str("Unmatched comment"));
 
1162
        lp = eol + 1; break;
 
1163
      }
 
1164
      lp = ll + 2;
 
1165
      continue;
 
1166
    }
 
1167
    else if (c == '"') {                  /* quoted string: */
 
1168
      if (grpcnt >= ST(grpmax))
 
1169
        extend_group(csound);
 
1170
      grpp = ST(group)[grpcnt++] = cp;
 
1171
      *cp++ = c;                          /*  cpy to nxt quote */
 
1172
      do {
 
1173
      loop:
 
1174
        c = *lp++;
 
1175
        if (c=='\\' && *lp=='"') {        /* Deal with \" case */
 
1176
          *cp++ = '\\';
 
1177
          *cp++ = '"';
 
1178
          lp++;
 
1179
          goto loop;
 
1180
        }
 
1181
        *cp++ = c;
 
1182
      } while (c != '"' && c != '\n');
 
1183
      if (c == '\n')
 
1184
        synterrp(csound, lp - 1, Str("unmatched quotes"));
 
1185
      collecting = 1;                     /*   & resume chking */
 
1186
      continue;
 
1187
    }
 
1188
    else if (c == '{' && *lp == '{') {    /* multiline quoted string:   */
 
1189
      if (grpcnt >= ST(grpmax))
 
1190
        extend_group(csound);
 
1191
      grpp = ST(group)[grpcnt++] = cp;
 
1192
      c = '"';                            /*  cpy to nxt quote */
 
1193
      do {
 
1194
        *cp++ = c;
 
1195
        if (cp - ST(collectbuf) >= ST(lenmax))
 
1196
          extend_collectbuf(csound, &cp, grpcnt);
 
1197
        c = *(++lp);
1156
1198
        if (c == '\n')
1157
 
          synterrp(csound, lp - 1, Str("unmatched quotes"));
1158
 
        collecting = 1;                     /*   & resume chking */
1159
 
        continue;
1160
 
      }
1161
 
      else if (c == '{' && *lp == '{') {    /* multiline quoted string:   */
1162
 
        if (grpcnt >= ST(grpmax))
1163
 
          extend_group(csound);
1164
 
        grpp = ST(group)[grpcnt++] = cp;
1165
 
        c = '"';                            /*  cpy to nxt quote */
1166
 
        do {
1167
 
          *cp++ = c;
1168
 
          if (cp - ST(collectbuf) >= ST(lenmax))
1169
 
            extend_collectbuf(csound, &cp, grpcnt);
1170
 
          c = *(++lp);
1171
 
          if (c == '\n')
1172
 
            ++ST(curline);
1173
 
        } while (!(c == '}' && lp[1] == '}'));
1174
 
        lp += 2;
1175
 
        *cp++ = '"';
1176
 
        collecting = 1;                     /*   & resume chking */
1177
 
        continue;
1178
 
      }
1179
 
      else if (c == ':' && collecting && grpcnt == ST(linlabels)+1) {
1180
 
        ST(linlabels)++;                    /* colon in 1st grps */
1181
 
        *cp++ = '\0';                       /*  is also delimitr */
1182
 
        collecting = 0;                     /*  (do not copy it) */
1183
 
        continue;
1184
 
      }
1185
 
      else if (c == '=' && !ST(opgrpno)) {  /* assign befor args */
1186
 
        if (collecting)                     /* can be a delimitr */
1187
 
          *cp++ = '\0';
1188
 
        grpp = ST(group)[grpcnt++] = cp;    /* is itslf an opcod */
1189
 
        *cp++ = c;
1190
 
        *cp++ = '\0';
1191
 
        isopcod(csound, grpp);
1192
 
        ST(opgrpno) = grpcnt;
1193
 
        collecting = 0;                     /* & self-delimiting */
1194
 
        continue;
1195
 
      }
1196
 
      else if (c == ',') {                  /* comma:            */
1197
 
        if (UNLIKELY(!collecting))
1198
 
          synterrp(csound, lp - 1, Str("misplaced comma"));
1199
 
        if (UNLIKELY(parens)) {
1200
 
          synterrp(csound, lp - 2, Str("unbalanced parens"));
1201
 
          parens = 0;
1202
 
        }
1203
 
        *cp++ = '\0';                       /*  terminate string */
1204
 
        collecting = logical = condassgn = 0;
1205
 
        continue;
1206
 
      }
1207
 
      if (prvif && collecting && !parens) { /* for prev "if":    */
1208
 
        if (strncmp(lp-1,"goto",4) == 0) {  /* if found "goto"   */
1209
 
          *cp++ = '\0';                     /*      delimit cond */
1210
 
          lp += 3;                          /*      & step over  */
1211
 
          prvif = collecting = 0;
1212
 
          continue;
1213
 
        }
1214
 
        else if ((c == 'i' || c == 'k') &&          /*  if preced i or k */
1215
 
                 strncmp(lp, "goto", 4) == 0) {     /*  before "goto"    */
1216
 
          *(ST(group)[ST(opgrpno) - 1] + 1) = c;    /*     modify cggoto */
1217
 
          isopcod(csound, ST(group)[ST(opgrpno) - 1]);
1218
 
          *cp++ = '\0';                             /*     then delimit  */
1219
 
          lp += 4;                                  /*      etc          */
1220
 
          prvif = collecting = 0;
1221
 
          continue;
1222
 
        }
1223
 
        else if (strncmp(lp - 1, "then", 4) == 0) {
1224
 
          struct iflabel *prv = ST(iflabels);
1225
 
          /* modify cggoto */
1226
 
          *(ST(group)[ST(opgrpno) - 1] + 1) = 'n';
1227
 
          isopcod(csound, ST(group)[ST(opgrpno) - 1]);
1228
 
          *cp++ = '\0';
1229
 
          lp += 3;
1230
 
          prvif = collecting = 0;
1231
 
          grpp = ST(group)[grpcnt++] = cp;
1232
 
          /* synthesize labels to represent an else and endif */
1233
 
          if (prvelsif) { /* elseif, so we just need a new elselabel */
1234
 
            sprintf(ST(iflabels)->els, "__else_%d", ST(tempNum)++);
1235
 
            prvelsif = 0;
1236
 
          }
1237
 
          else {
1238
 
            /* this is a new if, so put a whole new label struct on the stack */
1239
 
            ST(iflabels) = (struct iflabel *) mmalloc(csound,
1240
 
                                                      sizeof(struct iflabel));
1241
 
            ST(iflabels)->prv = prv;
1242
 
            sprintf(ST(iflabels)->end, "__endif_%d",ST(tempNum)++);
1243
 
            sprintf(ST(iflabels)->els, "__else_%d", ST(tempNum)++);
1244
 
          }
1245
 
          /* we set the 'goto' label to the 'else' label */
1246
 
          strcpy(grpp, ST(iflabels)->els);
1247
 
          cp = strchr(grpp, '\0');
1248
 
          /* set ithen flag to unknown (getoptxt() will update it later) */
1249
 
          ST(iflabels)->ithen = -1;
1250
 
          continue;
1251
 
        }
1252
 
        else if (strncmp(lp - 1, "ithen", 5) == 0) {
1253
 
          struct iflabel *prv = ST(iflabels);
1254
 
          /* modify cggoto */
1255
 
          *(ST(group)[ST(opgrpno) - 1] + 1) = 'o';
1256
 
          isopcod(csound, ST(group)[ST(opgrpno) - 1]);
1257
 
          *cp++ = '\0';
1258
 
          lp += 4;
1259
 
          prvif = collecting = 0;
1260
 
          grpp = ST(group)[grpcnt++] = cp;
1261
 
          /* synthesize labels to represent an else and endif */
1262
 
          if (prvelsif) { /* elseif, so we just need a new elselabel */
1263
 
            sprintf(ST(iflabels)->els, "__else_%d",ST(tempNum)++);
1264
 
            prvelsif = 0;
1265
 
          }
1266
 
          else {
1267
 
            /* this is a new if, so put a whole new label struct on the stack */
1268
 
            ST(iflabels) = (struct iflabel *)mmalloc(csound,
1269
 
                                                     sizeof(struct iflabel));
1270
 
            ST(iflabels)->prv = prv;
1271
 
            sprintf(ST(iflabels)->end, "__endif_%d",ST(tempNum)++);
1272
 
            sprintf(ST(iflabels)->els, "__else_%d", ST(tempNum)++);
1273
 
          }
1274
 
          /* we set the 'goto' label to the 'else' label */
1275
 
          strcpy(grpp, ST(iflabels)->els);
1276
 
          cp = strchr(grpp, '\0');
1277
 
          /* set ithen flag */
1278
 
          ST(iflabels)->ithen = 1;
1279
 
          continue;
1280
 
        }
1281
 
      }
1282
 
      if (!collecting++) {                  /* remainder are     */
1283
 
        if (grpcnt >= ST(grpmax))           /* collectable chars */
1284
 
          extend_group(csound);
1285
 
        grpp = ST(group)[grpcnt++] = cp;
1286
 
      }
1287
 
      *cp++ = c;                            /* collect the char  */
1288
 
      /* establish validity: allow letters, digits, and underscore */
1289
 
      /* in label, variable, and opcode names */
1290
 
      if (isalnum(c) || c == '_')
1291
 
        continue;
1292
 
      /* other characters are valid only after an opcode */
1293
 
      if (UNLIKELY(!ST(opgrpno)))
1294
 
        goto char_err;
1295
 
      switch (c) {
1296
 
      case '<':
1297
 
      case '>':
1298
 
        if (*lp == c) {
1299
 
          lp++; *cp++ = c;                  /* <<, >> */
1300
 
        }
1301
 
        else if (prvif || parens)           /* <, <=, >=, > */
1302
 
          logical++;
1303
 
        else
1304
 
          goto char_err;
1305
 
        break;
1306
 
      case '&':
1307
 
      case '|':
1308
 
        if (*lp == c) {                     /* &&, ||, &, | */
1309
 
          if (UNLIKELY(!prvif && !parens))
1310
 
            goto char_err;
1311
 
          logical++; lp++; *cp++ = c;
1312
 
        }
1313
 
        break;
1314
 
      case '!':
1315
 
      case '=':
1316
 
        if (UNLIKELY(!prvif && !parens))              /* ==, !=, <=, >= */
1317
 
          goto char_err;
 
1199
          ++ST(curline);
 
1200
      } while (!(c == '}' && lp[1] == '}'));
 
1201
      lp += 2;
 
1202
      *cp++ = '"';
 
1203
      collecting = 1;                     /*   & resume chking */
 
1204
      continue;
 
1205
    }
 
1206
    else if (c == ':' && collecting && grpcnt == ST(linlabels)+1) {
 
1207
      ST(linlabels)++;                    /* colon in 1st grps */
 
1208
      *cp++ = '\0';                       /*  is also delimitr */
 
1209
      collecting = 0;                     /*  (do not copy it) */
 
1210
      continue;
 
1211
    }
 
1212
    else if (c == '=' && !ST(opgrpno)) {  /* assign befor args */
 
1213
      if (collecting)                     /* can be a delimitr */
 
1214
        *cp++ = '\0';
 
1215
      grpp = ST(group)[grpcnt++] = cp;    /* is itslf an opcod */
 
1216
      *cp++ = c;
 
1217
      *cp++ = '\0';
 
1218
      isopcod(csound, grpp);
 
1219
      ST(opgrpno) = grpcnt;
 
1220
      collecting = 0;                     /* & self-delimiting */
 
1221
      continue;
 
1222
    }
 
1223
    else if (c == ',') {                  /* comma:            */
 
1224
      if (UNLIKELY(!collecting))
 
1225
        synterrp(csound, lp - 1, Str("misplaced comma"));
 
1226
      if (UNLIKELY(parens)) {
 
1227
        synterrp(csound, lp - 2, Str("unbalanced parens"));
 
1228
        parens = 0;
 
1229
      }
 
1230
      *cp++ = '\0';                       /*  terminate string */
 
1231
      collecting = logical = condassgn = 0;
 
1232
      continue;
 
1233
    }
 
1234
    if (prvif && collecting && !parens) { /* for prev "if":    */
 
1235
      if (strncmp(lp-1,"goto",4) == 0) {  /* if found "goto"   */
 
1236
        *cp++ = '\0';                     /*      delimit cond */
 
1237
        lp += 3;                          /*      & step over  */
 
1238
        prvif = collecting = 0;
 
1239
        continue;
 
1240
      }
 
1241
      else if ((c == 'i' || c == 'k') &&          /*  if preced i or k */
 
1242
               strncmp(lp, "goto", 4) == 0) {     /*  before "goto"    */
 
1243
        *(ST(group)[ST(opgrpno) - 1] + 1) = c;    /*     modify cggoto */
 
1244
        isopcod(csound, ST(group)[ST(opgrpno) - 1]);
 
1245
        *cp++ = '\0';                             /*     then delimit  */
 
1246
        lp += 4;                                  /*      etc          */
 
1247
        prvif = collecting = 0;
 
1248
        continue;
 
1249
      }
 
1250
      else if (strncmp(lp - 1, "then", 4) == 0) {
 
1251
        struct iflabel *prv = ST(iflabels);
 
1252
        /* modify cggoto */
 
1253
        *(ST(group)[ST(opgrpno) - 1] + 1) = 'n';
 
1254
        isopcod(csound, ST(group)[ST(opgrpno) - 1]);
 
1255
        *cp++ = '\0';
 
1256
        lp += 3;
 
1257
        prvif = collecting = 0;
 
1258
        grpp = ST(group)[grpcnt++] = cp;
 
1259
        /* synthesize labels to represent an else and endif */
 
1260
        if (prvelsif) { /* elseif, so we just need a new elselabel */
 
1261
          sprintf(ST(iflabels)->els, "__else_%d", ST(tempNum)++);
 
1262
          prvelsif = 0;
 
1263
        }
 
1264
        else {
 
1265
          /* this is a new if, so put a whole new label struct on the stack */
 
1266
          ST(iflabels) = (struct iflabel *) mmalloc(csound,
 
1267
                                                    sizeof(struct iflabel));
 
1268
          ST(iflabels)->prv = prv;
 
1269
          sprintf(ST(iflabels)->end, "__endif_%d",ST(tempNum)++);
 
1270
          sprintf(ST(iflabels)->els, "__else_%d", ST(tempNum)++);
 
1271
        }
 
1272
        /* we set the 'goto' label to the 'else' label */
 
1273
        strcpy(grpp, ST(iflabels)->els);
 
1274
        cp = strchr(grpp, '\0');
 
1275
        /* set ithen flag to unknown (getoptxt() will update it later) */
 
1276
        ST(iflabels)->ithen = -1;
 
1277
        continue;
 
1278
      }
 
1279
      else if (strncmp(lp - 1, "ithen", 5) == 0) {
 
1280
        struct iflabel *prv = ST(iflabels);
 
1281
        /* modify cggoto */
 
1282
        *(ST(group)[ST(opgrpno) - 1] + 1) = 'o';
 
1283
        isopcod(csound, ST(group)[ST(opgrpno) - 1]);
 
1284
        *cp++ = '\0';
 
1285
        lp += 4;
 
1286
        prvif = collecting = 0;
 
1287
        grpp = ST(group)[grpcnt++] = cp;
 
1288
        /* synthesize labels to represent an else and endif */
 
1289
        if (prvelsif) { /* elseif, so we just need a new elselabel */
 
1290
          sprintf(ST(iflabels)->els, "__else_%d",ST(tempNum)++);
 
1291
          prvelsif = 0;
 
1292
        }
 
1293
        else {
 
1294
          /* this is a new if, so put a whole new label struct on the stack */
 
1295
          ST(iflabels) = (struct iflabel *)mmalloc(csound,
 
1296
                                                   sizeof(struct iflabel));
 
1297
          ST(iflabels)->prv = prv;
 
1298
          sprintf(ST(iflabels)->end, "__endif_%d",ST(tempNum)++);
 
1299
          sprintf(ST(iflabels)->els, "__else_%d", ST(tempNum)++);
 
1300
        }
 
1301
        /* we set the 'goto' label to the 'else' label */
 
1302
        strcpy(grpp, ST(iflabels)->els);
 
1303
        cp = strchr(grpp, '\0');
 
1304
        /* set ithen flag */
 
1305
        ST(iflabels)->ithen = 1;
 
1306
        continue;
 
1307
      }
 
1308
    }
 
1309
    if (!collecting++) {                  /* remainder are     */
 
1310
      if (grpcnt >= ST(grpmax))           /* collectable chars */
 
1311
        extend_group(csound);
 
1312
      grpp = ST(group)[grpcnt++] = cp;
 
1313
    }
 
1314
    *cp++ = c;                            /* collect the char  */
 
1315
    /* establish validity: allow letters, digits, and underscore */
 
1316
    /* in label, variable, and opcode names */
 
1317
    if (isalnum(c) || c == '_')
 
1318
      continue;
 
1319
    /* other characters are valid only after an opcode */
 
1320
    if (UNLIKELY(!ST(opgrpno)))
 
1321
      goto char_err;
 
1322
    switch (c) {
 
1323
    case '<':
 
1324
    case '>':
 
1325
      if (*lp == c) {
 
1326
        lp++; *cp++ = c;                  /* <<, >> */
 
1327
      }
 
1328
      else if (prvif || parens)           /* <, <=, >=, > */
1318
1329
        logical++;
1319
 
        break;
1320
 
      case '+':                             /* arithmetic and bitwise ops */
1321
 
      case '-':
1322
 
      case '*':
1323
 
      case '/':
1324
 
      case '%':
1325
 
      case '^':
1326
 
      case '#':                             /* XOR */
1327
 
      case '\254':                          /* NOT (same as ~) */
1328
 
      case '~':
1329
 
      case '.':
1330
 
        break;
1331
 
      case '\302':
1332
 
        if (*lp == '\254')                  /* NOT operator in UTF-8 format */
1333
 
          *(cp - 1) = *lp++;
1334
 
        else
1335
 
          goto char_err;
1336
 
        break;
1337
 
      case '(':
1338
 
        parens++;                           /* and monitor function */
1339
 
        break;
1340
 
      case ')':
1341
 
        if (UNLIKELY(!parens)) {
1342
 
          synterrp(csound, lp - 1, Str("unbalanced parens"));
1343
 
          cp--;
1344
 
        }
1345
 
        else
1346
 
          --parens;
1347
 
        break;
1348
 
      case '?':
1349
 
        if (UNLIKELY(!logical))
1350
 
          goto char_err;
1351
 
        condassgn++;
1352
 
        break;
1353
 
      case ':':
1354
 
        if (UNLIKELY(!condassgn))
1355
 
          goto char_err;
1356
 
        break;
1357
 
      default:
 
1330
      else
1358
1331
        goto char_err;
 
1332
      break;
 
1333
    case '&':
 
1334
    case '|':
 
1335
      if (*lp == c) {                     /* &&, ||, &, | */
 
1336
        if (UNLIKELY(!prvif && !parens))
 
1337
          goto char_err;
 
1338
        logical++; lp++; *cp++ = c;
1359
1339
      }
1360
 
      continue;                             /* loop back for next character */
1361
 
 char_err:
1362
 
      {
1363
 
        char err_msg[64];
1364
 
        sprintf(err_msg, Str("illegal character %c"), c);
1365
 
        synterrp(csound, lp - 1, err_msg);
 
1340
      break;
 
1341
    case '!':
 
1342
    case '=':
 
1343
      if (UNLIKELY(!prvif && !parens))              /* ==, !=, <=, >= */
 
1344
        goto char_err;
 
1345
      logical++;
 
1346
      break;
 
1347
    case '+':                             /* arithmetic and bitwise ops */
 
1348
    case '-':
 
1349
    case '*':
 
1350
    case '/':
 
1351
    case '%':
 
1352
    case '^':
 
1353
    case '#':                             /* XOR */
 
1354
    case '\254':                          /* NOT (same as ~) */
 
1355
    case '~':
 
1356
    case '.':
 
1357
      break;
 
1358
    case '\302':
 
1359
      if (*lp == '\254')                  /* NOT operator in UTF-8 format */
 
1360
        *(cp - 1) = *lp++;
 
1361
      else
 
1362
        goto char_err;
 
1363
      break;
 
1364
    case '(':
 
1365
      parens++;                           /* and monitor function */
 
1366
      break;
 
1367
    case ')':
 
1368
      if (UNLIKELY(!parens)) {
 
1369
        synterrp(csound, lp - 1, Str("unbalanced parens"));
1366
1370
        cp--;
1367
1371
      }
1368
 
    }
1369
 
    *cp = '\0';                             /* terminate last group */
1370
 
    if (grpp && grpcnt == (ST(linlabels) + 1)) {
1371
 
      /* convert an 'else' statement into 2 lines
1372
 
         goto <endiflabel>
1373
 
         <elselabel>
1374
 
         to do this, we parse the current twice */
1375
 
      if (strcmp(grpp, "else") == 0) {
1376
 
        if (UNLIKELY(!ST(iflabels))) {    /* 'else': check to see we had an 'if' before */
1377
 
          synterr(csound, Str("invalid 'else' statement.  "
1378
 
                              "must have a corresponding 'if'"));
1379
 
          goto nxtlin;
1380
 
        }
1381
 
        if (ST(repeatingElseLine)) {        /* add the elselabel */
1382
 
          if (UNLIKELY(!ST(iflabels)->els[0])) {
1383
 
            /* check to see we had not another 'else' */
1384
 
            synterr(csound, Str("duplicate 'else' statement"));
1385
 
            goto nxtlin;
1386
 
          }
1387
 
          ST(linlabels)++;
1388
 
          strcpy(grpp, ST(iflabels)->els);
1389
 
          ST(iflabels)->els[0] = '\0';
1390
 
          ST(repeatingElseLine) = 0;
1391
 
        }
1392
 
        else {                              /* add the goto statement */
1393
 
          if (ST(iflabels)->ithen > 0)
1394
 
            strcpy(grpp, "goto");
1395
 
          else
1396
 
            strcpy(grpp, "kgoto");
1397
 
          ST(linlabels) = 0;                /* ignore any labels this time */
1398
 
          ST(group)[0] = grpp;
1399
 
          grpcnt = 1;
1400
 
          if (isopcod(csound, grpp))
1401
 
            ST(opgrpno) = grpcnt;
1402
 
          ST(group)[grpcnt] = strchr(grpp, '\0') + 1;
1403
 
          grpp = ST(group)[grpcnt++];
1404
 
          strcpy(grpp, ST(iflabels)->end);
1405
 
          ST(curline)--;        /* roll back one and parse this line again */
1406
 
          ST(repeatingElseLine) = 1;
1407
 
        }
1408
 
      }
1409
 
      else if (strcmp(grpp, "endif") == 0) {
1410
 
        /* replace 'endif' with the synthesized label */
1411
 
        struct iflabel *prv;
1412
 
        if (UNLIKELY(!ST(iflabels))) {    /* check to see we had an 'if' before  */
1413
 
          synterr(csound, Str("invalid 'endif' statement.  "
1414
 
                              "must have a corresponding 'if'"));
1415
 
          goto nxtlin;
1416
 
        }
1417
 
        if (ST(iflabels)->els[0]) {
1418
 
          /* we had no 'else' statement, so we need to insert the elselabel */
1419
 
          ST(linlabels)++;
1420
 
          strcpy(grpp, ST(iflabels)->els);
1421
 
          ST(iflabels)->els[0] = '\0';
1422
 
          ST(curline)--;        /* roll back one and parse this line again */
1423
 
        }
1424
 
        else {
1425
 
          prv = ST(iflabels)->prv;
1426
 
          ST(linlabels)++;
1427
 
          strcpy(grpp, ST(iflabels)->end);
1428
 
          mfree(csound, ST(iflabels));
1429
 
          ST(iflabels) = prv;
1430
 
        }
1431
 
      }
1432
 
    }
1433
 
    if (!grpcnt)                        /* if line was trivial,    */
1434
 
      goto nxtlin;                      /*      try another        */
1435
 
    if (collecting && !ST(opgrpno)) {   /* if still collecting,    */
1436
 
      if (isopcod(csound, grpp))        /*      chk for opcod      */
1437
 
        ST(opgrpno) = grpcnt;
1438
 
    }
1439
 
    if (UNLIKELY(parens))                                   /* check balanced parens   */
1440
 
      synterrp(csound, lp - 1, Str("unbalanced parens"));
1441
 
    if (UNLIKELY(grpcnt > ST(linlabels) && !ST(opgrpno))) { /* if no full line opcod,  */
1442
 
      synterr(csound, Str("no legal opcode"));    /*      complain &         */
1443
 
      goto nxtlin;                                /*      try another        */
1444
 
    }
1445
 
    ST(linopnum) = ST(opnum);                     /* else save full line ops */
1446
 
    ST(linopcod) = ST(opcod);
1447
 
    if (UNLIKELY(csound->oparms->odebug))
1448
 
      printgroups(csound, grpcnt);
1449
 
    return grpcnt;
 
1372
      else
 
1373
        --parens;
 
1374
      break;
 
1375
    case '?':
 
1376
      if (UNLIKELY(!logical))
 
1377
        goto char_err;
 
1378
      condassgn++;
 
1379
      break;
 
1380
    case ':':
 
1381
      if (UNLIKELY(!condassgn))
 
1382
        goto char_err;
 
1383
      break;
 
1384
    default:
 
1385
      goto char_err;
 
1386
    }
 
1387
    continue;                             /* loop back for next character */
 
1388
  char_err:
 
1389
    {
 
1390
      char err_msg[64];
 
1391
      sprintf(err_msg, Str("illegal character %c"), c);
 
1392
      synterrp(csound, lp - 1, err_msg);
 
1393
      cp--;
 
1394
    }
 
1395
  }
 
1396
  *cp = '\0';                             /* terminate last group */
 
1397
  if (grpp && grpcnt == (ST(linlabels) + 1)) {
 
1398
    /* convert an 'else' statement into 2 lines
 
1399
       goto <endiflabel>
 
1400
       <elselabel>
 
1401
       to do this, we parse the current twice */
 
1402
    if (strcmp(grpp, "else") == 0) {
 
1403
      if (UNLIKELY(!ST(iflabels))) {    /* 'else': check to see we had an 'if' before */
 
1404
        synterr(csound, Str("invalid 'else' statement.  "
 
1405
                            "must have a corresponding 'if'"));
 
1406
        goto nxtlin;
 
1407
      }
 
1408
      if (ST(repeatingElseLine)) {        /* add the elselabel */
 
1409
        if (UNLIKELY(!ST(iflabels)->els[0])) {
 
1410
          /* check to see we had not another 'else' */
 
1411
          synterr(csound, Str("duplicate 'else' statement"));
 
1412
          goto nxtlin;
 
1413
        }
 
1414
        ST(linlabels)++;
 
1415
        strcpy(grpp, ST(iflabels)->els);
 
1416
        ST(iflabels)->els[0] = '\0';
 
1417
        ST(repeatingElseLine) = 0;
 
1418
      }
 
1419
      else {                              /* add the goto statement */
 
1420
        if (ST(iflabels)->ithen > 0)
 
1421
          strcpy(grpp, "goto");
 
1422
        else
 
1423
          strcpy(grpp, "kgoto");
 
1424
        ST(linlabels) = 0;                /* ignore any labels this time */
 
1425
        ST(group)[0] = grpp;
 
1426
        grpcnt = 1;
 
1427
        if (isopcod(csound, grpp))
 
1428
          ST(opgrpno) = grpcnt;
 
1429
        ST(group)[grpcnt] = strchr(grpp, '\0') + 1;
 
1430
        grpp = ST(group)[grpcnt++];
 
1431
        strcpy(grpp, ST(iflabels)->end);
 
1432
        ST(curline)--;        /* roll back one and parse this line again */
 
1433
        ST(repeatingElseLine) = 1;
 
1434
      }
 
1435
    }
 
1436
    else if (strcmp(grpp, "endif") == 0) {
 
1437
      /* replace 'endif' with the synthesized label */
 
1438
      struct iflabel *prv;
 
1439
      if (UNLIKELY(!ST(iflabels))) {    /* check to see we had an 'if' before  */
 
1440
        synterr(csound, Str("invalid 'endif' statement.  "
 
1441
                            "must have a corresponding 'if'"));
 
1442
        goto nxtlin;
 
1443
      }
 
1444
      if (ST(iflabels)->els[0]) {
 
1445
        /* we had no 'else' statement, so we need to insert the elselabel */
 
1446
        ST(linlabels)++;
 
1447
        strcpy(grpp, ST(iflabels)->els);
 
1448
        ST(iflabels)->els[0] = '\0';
 
1449
        ST(curline)--;        /* roll back one and parse this line again */
 
1450
      }
 
1451
      else {
 
1452
        prv = ST(iflabels)->prv;
 
1453
        ST(linlabels)++;
 
1454
        strcpy(grpp, ST(iflabels)->end);
 
1455
        mfree(csound, ST(iflabels));
 
1456
        ST(iflabels) = prv;
 
1457
      }
 
1458
    }
 
1459
  }
 
1460
  if (!grpcnt)                        /* if line was trivial,    */
 
1461
    goto nxtlin;                      /*      try another        */
 
1462
  if (collecting && !ST(opgrpno)) {   /* if still collecting,    */
 
1463
    if (isopcod(csound, grpp))        /*      chk for opcod      */
 
1464
      ST(opgrpno) = grpcnt;
 
1465
  }
 
1466
  if (UNLIKELY(parens))                                   /* check balanced parens   */
 
1467
    synterrp(csound, lp - 1, Str("unbalanced parens"));
 
1468
  if (UNLIKELY(grpcnt > ST(linlabels) && !ST(opgrpno))) { /* if no full line opcod,  */
 
1469
    synterr(csound, Str("no legal opcode"));    /*      complain &         */
 
1470
    goto nxtlin;                                /*      try another        */
 
1471
  }
 
1472
  ST(linopnum) = ST(opnum);                     /* else save full line ops */
 
1473
  ST(linopcod) = ST(opcod);
 
1474
  if (UNLIKELY(csound->oparms->odebug))
 
1475
    printgroups(csound, grpcnt);
 
1476
  return grpcnt;
1450
1477
}
1451
1478
 
1452
1479
static void resetouts(CSOUND *csound)
1453
1480
{
1454
 
    csound->acount = csound->kcount = csound->icount = 0;
1455
 
    csound->Bcount = csound->bcount = 0;
 
1481
  csound->acount = csound->kcount = csound->icount = 0;
 
1482
  csound->Bcount = csound->bcount = 0;
1456
1483
}
1457
1484
 
1458
1485
TEXT *getoptxt(CSOUND *csound, int *init)
1459
1486
{                               /* get opcod and args from current line */
1460
1487
                                /*      returns pntr to a TEXT struct   */
1461
 
    TEXT        *tp;
1462
 
    char        c, d, str[64], *s;
1463
 
    int         nn, incnt, outcnt;
 
1488
  TEXT        *tp;
 
1489
  char        c, d, str[64], *s;
 
1490
  int         nn, incnt, outcnt;
1464
1491
 
1465
 
    if (*init) {
1466
 
      ST(grpcnt)   = 0;
1467
 
      ST(nxtest)   = 1;
1468
 
      ST(xprtstno) = 0;
1469
 
      ST(polcnt)   = 0;
1470
 
      ST(instrblk) = 0;
1471
 
      ST(opcodblk) = 0;     /* IV - Sep 8 2002 */
1472
 
      ST(instrcnt) = 0;
1473
 
      *init    = 0;
1474
 
      memset(&ST(optext), 0, sizeof(TEXT));
1475
 
    }
 
1492
  if (*init) {
 
1493
    ST(grpcnt)   = 0;
 
1494
    ST(nxtest)   = 1;
 
1495
    ST(xprtstno) = 0;
 
1496
    ST(polcnt)   = 0;
 
1497
    ST(instrblk) = 0;
 
1498
    ST(opcodblk) = 0;     /* IV - Sep 8 2002 */
 
1499
    ST(instrcnt) = 0;
 
1500
    *init    = 0;
 
1501
    memset(&ST(optext), 0, sizeof(TEXT));
 
1502
  }
1476
1503
 
1477
1504
 tstnxt:
1478
 
    tp = &ST(optext);
1479
 
    if (ST(nxtest) >= ST(grpcnt)) {             /* if done with prevline, */
1480
 
      csound->argcnt_offs = 0;          /* reset temporary variable index */
1481
 
      if (!(ST(grpcnt) = splitline(csound))) {  /*    attack next line    */
1482
 
        /* end of orchestra, clean up */
1483
 
        mfree(csound, ST(linadr));      ST(linadr) = NULL;
1484
 
        mfree(csound, ST(ortext));      ST(ortext) = NULL;
1485
 
        mfree(csound, ST(collectbuf));  ST(collectbuf) = NULL;
1486
 
        mfree(csound, ST(group));       ST(group) = NULL;
1487
 
        mfree(csound, ST(grpsav));      ST(grpsav) = NULL;
1488
 
        mfree(csound, csound->tokens);      csound->tokens = NULL;
1489
 
        mfree(csound, csound->tokenlist);   csound->tokenlist = NULL;
1490
 
        mfree(csound, csound->tokenstring); csound->tokenstring = NULL;
1491
 
        mfree(csound, csound->polish);      csound->polish = NULL;
1492
 
        csound->token = NULL;
1493
 
        return (TEXT*) NULL;                    /*    (else we're done)   */
1494
 
      }
1495
 
      for (nn=0; nn<ST(grpcnt); nn++)           /*    save the group pntrs */
1496
 
        ST(grpsav)[nn] = ST(group)[nn];
1497
 
      ST(xprtstno) = ST(grpcnt) - 1;            /*    and reinit indices  */
1498
 
      ST(nxtest) = 0;
1499
 
      tp->linenum = ST(curline);
1500
 
      /* IV - Jan 27 2005 */
1501
 
      if (csound->oparms->expr_opt) {
1502
 
        int i = (int) ST(linlabels) + 1;
1503
 
        if (((int) ST(grpcnt) - i) > 0 && ST(group)[i][0] == '=' &&
1504
 
            ST(group)[i][1] == '\0') {
1505
 
          /* if opcode is '=', save outarg and type for expression optimiser */
1506
 
          csound->opcode_is_assign = 1;
1507
 
          csound->assign_type = (int) argtyp(csound, ST(group)[ST(linlabels)]);
1508
 
          csound->assign_outarg = strsav_string(csound,
1509
 
                                                ST(group)[ST(linlabels)]);
1510
 
        }
1511
 
        else {
1512
 
          csound->opcode_is_assign = csound->assign_type = 0;
1513
 
          csound->assign_outarg = NULL;
1514
 
        }
1515
 
      }
1516
 
    }
1517
 
    if (ST(linlabels)) {
1518
 
      s = strsav_string(csound, ST(group)[ST(nxtest)]);
1519
 
      lblfound(csound, s);
1520
 
      tp->opnum = LABEL;
1521
 
      tp->opcod = s;
1522
 
      tp->inlist = tp->outlist = ST(nullist);
1523
 
      ST(linlabels)--;
1524
 
      ST(nxtest)++;
1525
 
      return(tp);
1526
 
    }
1527
 
    if (!ST(instrcnt)) {                          /* send initial "instr 0"  */
1528
 
      tp->opnum = INSTR;
1529
 
      tp->opcod = strsav_string(csound, "instr"); /*  to hold global assigns */
1530
 
      tp->outlist = ST(nullist);
1531
 
      ST(nxtarglist)->count = 1;
1532
 
      ST(nxtarglist)->arg[0] = strsav_string(csound, "0");
 
1505
  tp = &ST(optext);
 
1506
  if (ST(nxtest) >= ST(grpcnt)) {             /* if done with prevline, */
 
1507
    csound->argcnt_offs = 0;          /* reset temporary variable index */
 
1508
    if (!(ST(grpcnt) = splitline(csound))) {  /*    attack next line    */
 
1509
      /* end of orchestra, clean up */
 
1510
      mfree(csound, ST(linadr));      ST(linadr) = NULL;
 
1511
      mfree(csound, ST(ortext));      ST(ortext) = NULL;
 
1512
      mfree(csound, ST(collectbuf));  ST(collectbuf) = NULL;
 
1513
      mfree(csound, ST(group));       ST(group) = NULL;
 
1514
      mfree(csound, ST(grpsav));      ST(grpsav) = NULL;
 
1515
      mfree(csound, csound->tokens);      csound->tokens = NULL;
 
1516
      mfree(csound, csound->tokenlist);   csound->tokenlist = NULL;
 
1517
      mfree(csound, csound->tokenstring); csound->tokenstring = NULL;
 
1518
      mfree(csound, csound->polish);      csound->polish = NULL;
 
1519
      csound->token = NULL;
 
1520
      return (TEXT*) NULL;                    /*    (else we're done)   */
 
1521
    }
 
1522
    for (nn=0; nn<ST(grpcnt); nn++)           /*    save the group pntrs */
 
1523
      ST(grpsav)[nn] = ST(group)[nn];
 
1524
    ST(xprtstno) = ST(grpcnt) - 1;            /*    and reinit indices  */
 
1525
    ST(nxtest) = 0;
 
1526
    tp->linenum = ST(curline);
 
1527
    /* IV - Jan 27 2005 */
 
1528
    if (csound->oparms->expr_opt) {
 
1529
      int i = (int) ST(linlabels) + 1;
 
1530
      if (((int) ST(grpcnt) - i) > 0 && ST(group)[i][0] == '=' &&
 
1531
          ST(group)[i][1] == '\0') {
 
1532
        /* if opcode is '=', save outarg and type for expression optimiser */
 
1533
        csound->opcode_is_assign = 1;
 
1534
        csound->assign_type = (int) argtyp(csound, ST(group)[ST(linlabels)]);
 
1535
        csound->assign_outarg = strsav_string(csound,
 
1536
                                              ST(group)[ST(linlabels)]);
 
1537
      }
 
1538
      else {
 
1539
        csound->opcode_is_assign = csound->assign_type = 0;
 
1540
        csound->assign_outarg = NULL;
 
1541
      }
 
1542
    }
 
1543
  }
 
1544
  if (ST(linlabels)) {
 
1545
    s = strsav_string(csound, ST(group)[ST(nxtest)]);
 
1546
    lblfound(csound, s);
 
1547
    tp->opnum = LABEL;
 
1548
    tp->opcod = s;
 
1549
    tp->inlist = tp->outlist = ST(nullist);
 
1550
    ST(linlabels)--;
 
1551
    ST(nxtest)++;
 
1552
    return(tp);
 
1553
  }
 
1554
  if (!ST(instrcnt)) {                          /* send initial "instr 0"  */
 
1555
    tp->opnum = INSTR;
 
1556
    tp->opcod = strsav_string(csound, "instr"); /*  to hold global assigns */
 
1557
    tp->outlist = ST(nullist);
 
1558
    ST(nxtarglist)->count = 1;
 
1559
    ST(nxtarglist)->arg[0] = strsav_string(csound, "0");
 
1560
    tp->inlist = copy_arglist(csound, ST(nxtarglist));
 
1561
    ST(instrcnt) = ST(instrblk) = 1;
 
1562
    return(tp);
 
1563
  }                                             /* then at 1st real INSTR, */
 
1564
  /*               or OPCODE, */
 
1565
  if (ST(instrcnt) == 1 && ST(instrblk) &&
 
1566
      (ST(opnum) == INSTR || ST(opnum) == OPCODE)) {
 
1567
    tp->opnum = ENDIN;                          /*  send an endin to */
 
1568
    tp->opcod = strsav_string(csound, "endin"); /*  term instr 0 blk */
 
1569
    tp->outlist = tp->inlist = ST(nullist);
 
1570
    ST(instrblk) = 0;
 
1571
    ST(instrcnt) = 2;
 
1572
    return(tp);
 
1573
  }
 
1574
  while (ST(xprtstno) >= 0) {             /* for each arg (last 1st):  */
 
1575
    if (!ST(polcnt)) {
 
1576
      /* if not midst of expressn: tst nxtarg */
 
1577
      ST(polcnt) = express(csound, ST(group)[ST(xprtstno)--]);
 
1578
      /* IV - Feb 06 2006: if there is an if/then with an unknown rate: */
 
1579
      if (ST(polcnt) > 0 && ST(iflabels) != NULL && ST(iflabels)->ithen < 0) {
 
1580
        char  tmp;
 
1581
        /* check the output type of the expression (FIXME: is this safe ?) */
 
1582
        /* if it is an i-rate conditional, set ithen flag for else/elseif */
 
1583
        tmp = argtyp(csound, csound->tokenlist[0]->str);
 
1584
        if (tmp == (char) 'b')
 
1585
          ST(iflabels)->ithen = 1;
 
1586
        else
 
1587
          ST(iflabels)->ithen = 0;
 
1588
      }
 
1589
    }
 
1590
    if (ST(polcnt) < 0) {
 
1591
      /* polish but arg only: redo ptr & contin */
 
1592
      ST(group)[ST(xprtstno)+1] = strsav_string(csound, csound->tokenstring);
 
1593
      ST(polcnt) = 0;
 
1594
    }
 
1595
    else if (ST(polcnt)) {
 
1596
      POLISH  *pol;                           /* for real polish ops, */
 
1597
      int n;
 
1598
      pol = &(csound->polish[--ST(polcnt)]);  /*    grab top one      */
 
1599
      if (UNLIKELY(isopcod(csound, pol->opcod) == 0)) { /* and check it out     */
 
1600
        synterr(csound, Str("illegal opcod from expr anal"));
 
1601
        goto tstnxt;
 
1602
      }
 
1603
      tp->opnum = ST(opnum);                  /* ok to send subop     */
 
1604
      tp->opcod = strsav_string(csound, ST(opcod));
 
1605
      ST(nxtarglist)->count = outcnt = 1;
 
1606
      ST(nxtarglist)->arg[0] = strsav_string(csound, pol->arg[0]);
 
1607
      tp->outlist = copy_arglist(csound, ST(nxtarglist));
 
1608
      n = ST(nxtarglist)->count = incnt = pol->incount;
 
1609
      do  ST(nxtarglist)->arg[n-1] = strsav_string(csound, pol->arg[n]);
 
1610
      while (--n);
1533
1611
      tp->inlist = copy_arglist(csound, ST(nxtarglist));
1534
 
      ST(instrcnt) = ST(instrblk) = 1;
1535
 
      return(tp);
1536
 
    }                                             /* then at 1st real INSTR, */
1537
 
                                                  /*               or OPCODE, */
1538
 
    if (ST(instrcnt) == 1 && ST(instrblk) &&
1539
 
        (ST(opnum) == INSTR || ST(opnum) == OPCODE)) {
1540
 
      tp->opnum = ENDIN;                          /*  send an endin to */
1541
 
      tp->opcod = strsav_string(csound, "endin"); /*  term instr 0 blk */
1542
 
      tp->outlist = tp->inlist = ST(nullist);
1543
 
      ST(instrblk) = 0;
1544
 
      ST(instrcnt) = 2;
1545
 
      return(tp);
1546
 
    }
1547
 
    while (ST(xprtstno) >= 0) {             /* for each arg (last 1st):  */
1548
 
      if (!ST(polcnt)) {
1549
 
        /* if not midst of expressn: tst nxtarg */
1550
 
        ST(polcnt) = express(csound, ST(group)[ST(xprtstno)--]);
1551
 
        /* IV - Feb 06 2006: if there is an if/then with an unknown rate: */
1552
 
        if (ST(polcnt) > 0 && ST(iflabels) != NULL && ST(iflabels)->ithen < 0) {
1553
 
          char  tmp;
1554
 
          /* check the output type of the expression (FIXME: is this safe ?) */
1555
 
          /* if it is an i-rate conditional, set ithen flag for else/elseif */
1556
 
          tmp = argtyp(csound, csound->tokenlist[0]->str);
1557
 
          if (tmp == (char) 'b')
1558
 
            ST(iflabels)->ithen = 1;
1559
 
          else
1560
 
            ST(iflabels)->ithen = 0;
1561
 
        }
1562
 
      }
1563
 
      if (ST(polcnt) < 0) {
1564
 
        /* polish but arg only: redo ptr & contin */
1565
 
        ST(group)[ST(xprtstno)+1] = strsav_string(csound, csound->tokenstring);
1566
 
        ST(polcnt) = 0;
1567
 
      }
1568
 
      else if (ST(polcnt)) {
1569
 
        POLISH  *pol;                           /* for real polish ops, */
1570
 
        int n;
1571
 
        pol = &(csound->polish[--ST(polcnt)]);  /*    grab top one      */
1572
 
        if (UNLIKELY(isopcod(csound, pol->opcod) == 0)) { /* and check it out     */
1573
 
          synterr(csound, Str("illegal opcod from expr anal"));
1574
 
          goto tstnxt;
1575
 
        }
1576
 
        tp->opnum = ST(opnum);                  /* ok to send subop     */
1577
 
        tp->opcod = strsav_string(csound, ST(opcod));
1578
 
        ST(nxtarglist)->count = outcnt = 1;
1579
 
        ST(nxtarglist)->arg[0] = strsav_string(csound, pol->arg[0]);
1580
 
        tp->outlist = copy_arglist(csound, ST(nxtarglist));
1581
 
        n = ST(nxtarglist)->count = incnt = pol->incount;
1582
 
        do  ST(nxtarglist)->arg[n-1] = strsav_string(csound, pol->arg[n]);
1583
 
        while (--n);
1584
 
        tp->inlist = copy_arglist(csound, ST(nxtarglist));
1585
 
        if (!ST(polcnt))                    /* last op? hit the grp ptr */
1586
 
          ST(group)[ST(xprtstno)+1] = tp->outlist->arg[0];
1587
 
        goto spctst;
1588
 
      }
1589
 
    }
1590
 
    if (!strcmp(ST(linopcod), "=")) {       /* IV - Jan 08 2003: '=' opcode */
1591
 
      if (csound->oparms->expr_opt && csound->opcode_is_assign < 0) {
1592
 
        /* if optimised away, skip line */
 
1612
      if (!ST(polcnt))                    /* last op? hit the grp ptr */
 
1613
        ST(group)[ST(xprtstno)+1] = tp->outlist->arg[0];
 
1614
      goto spctst;
 
1615
    }
 
1616
  }
 
1617
  if (!strcmp(ST(linopcod), "=")) {       /* IV - Jan 08 2003: '=' opcode */
 
1618
    if (csound->oparms->expr_opt && csound->opcode_is_assign < 0) {
 
1619
      /* if optimised away, skip line */
 
1620
      ST(nxtest) = ST(grpcnt); goto tstnxt;
 
1621
    }
 
1622
    if (ST(nxtest) < ST(opgrpno)) {
 
1623
      c = argtyp(csound, ST(group)[ST(nxtest)]);
 
1624
      switch (c) {
 
1625
      case 'S': strcpy(str, "strcpy"); break;
 
1626
      case 'a': c = argtyp(csound, ST(group)[ST(opgrpno)]);
 
1627
        strcpy(str, (c == 'a' ? "=.a" : "upsamp")); break;
 
1628
      case 'p': c = 'i';
 
1629
      default:  sprintf(str, "=.%c", c);
 
1630
      }
 
1631
      if (UNLIKELY(!(isopcod(csound, str)))) {
 
1632
        synterr(csound,
 
1633
                Str("failed to find %s, output arg '%s' illegal type"),
 
1634
                str, ST(group)[ST(nxtest)]);  /* report syntax error     */
 
1635
        ST(nxtest) = 100;                     /* step way over this line */
 
1636
        goto tstnxt;                          /* & go to next            */
 
1637
      }
 
1638
      if (strcmp(ST(group)[ST(nxtest)], ST(group)[ST(opgrpno)]) == 0) {
 
1639
        /* outarg same as inarg, skip line */
1593
1640
        ST(nxtest) = ST(grpcnt); goto tstnxt;
1594
1641
      }
1595
 
      if (ST(nxtest) < ST(opgrpno)) {
1596
 
        c = argtyp(csound, ST(group)[ST(nxtest)]);
1597
 
        switch (c) {
1598
 
          case 'S': strcpy(str, "strcpy"); break;
1599
 
          case 'a': c = argtyp(csound, ST(group)[ST(opgrpno)]);
1600
 
                    strcpy(str, (c == 'a' ? "=.a" : "upsamp")); break;
1601
 
          case 'p': c = 'i';
1602
 
          default:  sprintf(str, "=.%c", c);
1603
 
        }
1604
 
        if (UNLIKELY(!(isopcod(csound, str)))) {
1605
 
          synterr(csound,
1606
 
                  Str("failed to find %s, output arg '%s' illegal type"),
1607
 
                  str, ST(group)[ST(nxtest)]);  /* report syntax error     */
1608
 
          ST(nxtest) = 100;                     /* step way over this line */
1609
 
          goto tstnxt;                          /* & go to next            */
1610
 
        }
1611
 
        if (strcmp(ST(group)[ST(nxtest)], ST(group)[ST(opgrpno)]) == 0) {
1612
 
          /* outarg same as inarg, skip line */
1613
 
          ST(nxtest) = ST(grpcnt); goto tstnxt;
1614
 
        }
1615
 
        ST(linopnum) = ST(opnum);
1616
 
        ST(linopcod) = ST(opcod);
1617
 
        csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
1618
 
      }
1619
 
    }
1620
 
    else if (ST(nxtest) < ST(opgrpno) &&  /* Some aopcodes do not have ans! */
1621
 
             csound->opcodlst[ST(linopnum)].dsblksiz == 0xffff) {
1622
 
      /* use outype to modify some opcodes flagged as translating */
1623
 
      c = argtyp(csound, ST(group)[ST(nxtest)]);
1624
 
      if (c == 'p')   c = 'i';
1625
 
      if (c == '?')   c = 'a';                  /* tmp */
1626
 
      sprintf(str, "%s.%c", ST(linopcod), c);
1627
 
      if (UNLIKELY(!(isopcod(csound, str)))) {
1628
 
        synterr(csound, Str("failed to find %s, output arg '%s' illegal type"),
1629
 
                str, ST(group)[ST(nxtest)]);    /* report syntax error     */
1630
 
        ST(nxtest) = 100;                       /* step way over this line */
1631
 
        goto tstnxt;                            /* & go to next            */
1632
 
      }
1633
 
      ST(linopnum) = ST(opnum);
1634
 
      ST(linopcod) = ST(opcod);
1635
 
      csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
1636
 
    }
1637
 
    else if ((int) csound->opcodlst[ST(linopnum)].dsblksiz >= 0xfffb) {
1638
 
      c = argtyp(csound, ST(group)[ST(opgrpno)]); /* type of first input arg */
1639
 
      switch ((int) csound->opcodlst[ST(linopnum)].dsblksiz) {
1640
 
      case 0xfffe:                              /* Two tags for OSCIL's    */
1641
 
        if (c != 'a') c = 'k';
1642
 
        if ((d = argtyp(csound, ST(group)[ST(opgrpno)+1])) != 'a') d = 'k';
1643
 
        sprintf(str, "%s.%c%c", ST(linopcod), c, d);
1644
 
        break;
1645
 
      case 0xfffd:                              /* For peak, etc.          */
1646
 
        if (c != 'a') c = 'k';
1647
 
        sprintf(str, "%s.%c", ST(linopcod), c);
1648
 
        break;
1649
 
      case 0xfffc:                              /* For divz types          */
1650
 
        d = argtyp(csound, ST(group)[ST(opgrpno)+1]);
1651
 
        if ((c=='i' || c=='c') && (d=='i' || d=='c'))
1652
 
          c = 'i', d = 'i';
1653
 
        else {
1654
 
          if (c != 'a') c = 'k';
1655
 
          if (d != 'a') d = 'k';
1656
 
        }
1657
 
        sprintf(str, "%s.%c%c", ST(linopcod), c, d);
1658
 
        break;
1659
 
      case 0xfffb:          /* determine opcode by type of first input arg */
1660
 
            /* allows a, k, and i types (e.g. Inc, Dec), but not constants */
1661
 
        if (ST(typemask_tabl)[(unsigned char) c] & (ARGTYP_i | ARGTYP_p))
1662
 
          c = 'i';
1663
 
        sprintf(str, "%s.%c", ST(linopcod), c);
1664
 
        break;
1665
 
      default:
1666
 
        strcpy(str, ST(linopcod));  /* unknown code: use original opcode   */
1667
 
      }
1668
 
      if (UNLIKELY(!(isopcod(csound, str)))) {
1669
 
                        /* if opcode is not found: report syntax error     */
1670
 
        synterr(csound, Str("failed to find %s, input arg illegal type"), str);
1671
 
        ST(nxtest) = 100;                       /* step way over this line */
1672
 
        goto tstnxt;                            /* & go to next            */
1673
 
      }
1674
 
      ST(linopnum) = ST(opnum);
1675
 
      ST(linopcod) = ST(opcod);
1676
 
      csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
1677
 
    }
1678
 
    tp->opnum = ST(linopnum);                         /* now use identified   */
1679
 
    tp->opcod = strsav_string(csound, ST(linopcod));  /*   full line opcode   */
1680
 
    /* IV - Oct 24 2002: check for invalid use of setksmps */
1681
 
    if (strcmp(ST(linopcod), "setksmps") == 0) {
1682
 
      if (UNLIKELY(!ST(opcodblk)))
1683
 
        synterr(csound,
1684
 
                Str("setksmps is allowed only in user defined opcodes"));
1685
 
      else if (UNLIKELY((int) ST(opcodflg) & 4))
1686
 
        synterr(csound,
1687
 
                Str("multiple uses of setksmps in the same opcode definition"));
1688
 
      else
1689
 
        ST(opcodflg) |= (int16) 4;
1690
 
    }
1691
 
    if (strncmp(ST(linopcod),"out",3) == 0 && /* but take case of MIDI ops */
1692
 
        (ST(linopcod)[3] == '\0' || ST(linopcod)[3] == 's' ||
1693
 
         ST(linopcod)[3] == 'q'  || ST(linopcod)[3] == 'h' ||
1694
 
         ST(linopcod)[3] == 'o'  || ST(linopcod)[3] == 'x' ||
1695
 
         ST(linopcod)[3] == '3'     ))
1696
 
      if ((csound->tran_nchnls == 1  && strcmp(ST(linopcod),"out" ) != 0)    ||
1697
 
          (csound->tran_nchnls == 2  && strncmp(ST(linopcod),"outs",4) != 0) ||
1698
 
          (csound->tran_nchnls == 4  && strncmp(ST(linopcod),"outq",4) != 0) ||
1699
 
          (csound->tran_nchnls == 6  && strncmp(ST(linopcod),"outh",4) != 0) ||
1700
 
          (csound->tran_nchnls == 8  && strncmp(ST(linopcod),"outo",4) != 0) ||
1701
 
          (csound->tran_nchnls == 16 && strncmp(ST(linopcod),"outx",4) != 0) ||
1702
 
          (csound->tran_nchnls == 32 && strncmp(ST(linopcod),"out32",5) != 0)) {
1703
 
        if      (csound->tran_nchnls == 1)  isopcod(csound, "out");
1704
 
        else if (csound->tran_nchnls == 2)  isopcod(csound, "outs");
1705
 
        else if (csound->tran_nchnls == 4)  isopcod(csound, "outq");
1706
 
        else if (csound->tran_nchnls == 6)  isopcod(csound, "outh");
1707
 
        else if (csound->tran_nchnls == 8)  isopcod(csound, "outo");
1708
 
        else if (csound->tran_nchnls == 16) isopcod(csound, "outx");
1709
 
        else if (csound->tran_nchnls == 32) isopcod(csound, "out32");
1710
 
        csound->Message(csound, Str("%s inconsistent with global nchnls (%d); "
1711
 
                                    "replaced with %s\n"),
1712
 
                                ST(linopcod), csound->tran_nchnls, ST(opcod));
1713
 
        tp->opnum = ST(linopnum) = ST(opnum);
1714
 
        tp->opcod = strsav_string(csound, ST(linopcod) = ST(opcod));
1715
 
      }
1716
 
    incnt = outcnt = 0;
1717
 
    while (ST(nxtest) < ST(opgrpno)-1)          /* create the out arglist  */
1718
 
      ST(nxtarglist)->arg[outcnt++] =
1719
 
        strsav_string(csound, ST(group)[ST(nxtest)++]);
1720
 
    ST(nxtarglist)->count = outcnt;
1721
 
    if (outcnt == 0)
1722
 
      tp->outlist = ST(nullist);
1723
 
    else {
1724
 
      tp->outlist = copy_arglist(csound, ST(nxtarglist));   /* & prep ins */
1725
 
    }
1726
 
    ST(nxtest)++;
1727
 
    while (ST(nxtest) < ST(grpcnt))             /*      & ensuing inargs  */
1728
 
      ST(nxtarglist)->arg[incnt++] =
1729
 
        strsav_string(csound, ST(group)[ST(nxtest)++]);
1730
 
    ST(nxtarglist)->count = incnt;
1731
 
    if (incnt==0)
1732
 
      tp->inlist = ST(nullist);
1733
 
    else tp->inlist = copy_arglist(csound, ST(nxtarglist));
1734
 
    ST(grpcnt) = 0;                             /* all done w. these groups */
 
1642
      ST(linopnum) = ST(opnum);
 
1643
      ST(linopcod) = ST(opcod);
 
1644
      csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
 
1645
    }
 
1646
  }
 
1647
  else if (ST(nxtest) < ST(opgrpno) &&  /* Some aopcodes do not have ans! */
 
1648
           csound->opcodlst[ST(linopnum)].dsblksiz == 0xffff) {
 
1649
    /* use outype to modify some opcodes flagged as translating */
 
1650
    c = argtyp(csound, ST(group)[ST(nxtest)]);
 
1651
    if (c == 'p')   c = 'i';
 
1652
    if (c == '?')   c = 'a';                  /* tmp */
 
1653
    sprintf(str, "%s.%c", ST(linopcod), c);
 
1654
    if (UNLIKELY(!(isopcod(csound, str)))) {
 
1655
      synterr(csound, Str("failed to find %s, output arg '%s' illegal type"),
 
1656
              str, ST(group)[ST(nxtest)]);    /* report syntax error     */
 
1657
      ST(nxtest) = 100;                       /* step way over this line */
 
1658
      goto tstnxt;                            /* & go to next            */
 
1659
    }
 
1660
    ST(linopnum) = ST(opnum);
 
1661
    ST(linopcod) = ST(opcod);
 
1662
    csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
 
1663
  }
 
1664
  else if ((int) csound->opcodlst[ST(linopnum)].dsblksiz >= 0xfffb) {
 
1665
    c = argtyp(csound, ST(group)[ST(opgrpno)]); /* type of first input arg */
 
1666
    switch ((int) csound->opcodlst[ST(linopnum)].dsblksiz) {
 
1667
    case 0xfffe:                              /* Two tags for OSCIL's    */
 
1668
      if (c != 'a') c = 'k';
 
1669
      if ((d = argtyp(csound, ST(group)[ST(opgrpno)+1])) != 'a') d = 'k';
 
1670
      sprintf(str, "%s.%c%c", ST(linopcod), c, d);
 
1671
      break;
 
1672
    case 0xfffd:                              /* For peak, etc.          */
 
1673
      if (c != 'a') c = 'k';
 
1674
      sprintf(str, "%s.%c", ST(linopcod), c);
 
1675
      break;
 
1676
    case 0xfffc:                              /* For divz types          */
 
1677
      d = argtyp(csound, ST(group)[ST(opgrpno)+1]);
 
1678
      if ((c=='i' || c=='c') && (d=='i' || d=='c'))
 
1679
        c = 'i', d = 'i';
 
1680
      else {
 
1681
        if (c != 'a') c = 'k';
 
1682
        if (d != 'a') d = 'k';
 
1683
      }
 
1684
      sprintf(str, "%s.%c%c", ST(linopcod), c, d);
 
1685
      break;
 
1686
    case 0xfffb:          /* determine opcode by type of first input arg */
 
1687
      /* allows a, k, and i types (e.g. Inc, Dec), but not constants */
 
1688
      if (ST(typemask_tabl)[(unsigned char) c] & (ARGTYP_i | ARGTYP_p))
 
1689
        c = 'i';
 
1690
      sprintf(str, "%s.%c", ST(linopcod), c);
 
1691
      break;
 
1692
    default:
 
1693
      strcpy(str, ST(linopcod));  /* unknown code: use original opcode   */
 
1694
    }
 
1695
    if (UNLIKELY(!(isopcod(csound, str)))) {
 
1696
      /* if opcode is not found: report syntax error     */
 
1697
      synterr(csound, Str("failed to find %s, input arg illegal type"), str);
 
1698
      ST(nxtest) = 100;                       /* step way over this line */
 
1699
      goto tstnxt;                            /* & go to next            */
 
1700
    }
 
1701
    ST(linopnum) = ST(opnum);
 
1702
    ST(linopcod) = ST(opcod);
 
1703
    csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
 
1704
  }
 
1705
  tp->opnum = ST(linopnum);                         /* now use identified   */
 
1706
  tp->opcod = strsav_string(csound, ST(linopcod));  /*   full line opcode   */
 
1707
  /* IV - Oct 24 2002: check for invalid use of setksmps */
 
1708
  if (strcmp(ST(linopcod), "setksmps") == 0) {
 
1709
    if (UNLIKELY(!ST(opcodblk)))
 
1710
      synterr(csound,
 
1711
              Str("setksmps is allowed only in user defined opcodes"));
 
1712
    else if (UNLIKELY((int) ST(opcodflg) & 4))
 
1713
      synterr(csound,
 
1714
              Str("multiple uses of setksmps in the same opcode definition"));
 
1715
    else
 
1716
      ST(opcodflg) |= (int16) 4;
 
1717
  }
 
1718
#if 0
 
1719
  /* NO LONGER USED */
 
1720
  if (strncmp(ST(linopcod),"out",3) == 0 && /* but take case of MIDI ops */
 
1721
      (ST(linopcod)[3] == '\0' || ST(linopcod)[3] == 's' ||
 
1722
       ST(linopcod)[3] == 'q'  || ST(linopcod)[3] == 'h' ||
 
1723
       ST(linopcod)[3] == 'o'  || ST(linopcod)[3] == 'x' ||
 
1724
       ST(linopcod)[3] == '3'     ))
 
1725
    if ((csound->tran_nchnls == 1  && strcmp(ST(linopcod),"out" ) != 0)    ||
 
1726
        (csound->tran_nchnls == 2  && strncmp(ST(linopcod),"outs",4) != 0) ||
 
1727
        (csound->tran_nchnls == 4  && strncmp(ST(linopcod),"outq",4) != 0) ||
 
1728
        (csound->tran_nchnls == 6  && strncmp(ST(linopcod),"outh",4) != 0) ||
 
1729
        (csound->tran_nchnls == 8  && strncmp(ST(linopcod),"outo",4) != 0) ||
 
1730
        (csound->tran_nchnls == 16 && strncmp(ST(linopcod),"outx",4) != 0) ||
 
1731
        (csound->tran_nchnls == 32 && strncmp(ST(linopcod),"out32",5) != 0)) {
 
1732
      if      (csound->tran_nchnls == 1)  isopcod(csound, "out");
 
1733
      else if (csound->tran_nchnls == 2)  isopcod(csound, "outs");
 
1734
      else if (csound->tran_nchnls == 4)  isopcod(csound, "outq");
 
1735
      else if (csound->tran_nchnls == 6)  isopcod(csound, "outh");
 
1736
      else if (csound->tran_nchnls == 8)  isopcod(csound, "outo");
 
1737
      else if (csound->tran_nchnls == 16) isopcod(csound, "outx");
 
1738
      else if (csound->tran_nchnls == 32) isopcod(csound, "out32");
 
1739
      csound->Message(csound, Str("%s inconsistent with global nchnls (%d); "
 
1740
                                  "replaced with %s\n"),
 
1741
                      ST(linopcod), csound->tran_nchnls, ST(opcod));
 
1742
      tp->opnum = ST(linopnum) = ST(opnum);
 
1743
      tp->opcod = strsav_string(csound, ST(linopcod) = ST(opcod));
 
1744
    }
 
1745
#endif
 
1746
  incnt = outcnt = 0;
 
1747
  while (ST(nxtest) < ST(opgrpno)-1)          /* create the out arglist  */
 
1748
    ST(nxtarglist)->arg[outcnt++] =
 
1749
      strsav_string(csound, ST(group)[ST(nxtest)++]);
 
1750
  ST(nxtarglist)->count = outcnt;
 
1751
  if (outcnt == 0)
 
1752
    tp->outlist = ST(nullist);
 
1753
  else {
 
1754
    tp->outlist = copy_arglist(csound, ST(nxtarglist));   /* & prep ins */
 
1755
  }
 
1756
  ST(nxtest)++;
 
1757
  while (ST(nxtest) < ST(grpcnt))             /*      & ensuing inargs  */
 
1758
    ST(nxtarglist)->arg[incnt++] =
 
1759
      strsav_string(csound, ST(group)[ST(nxtest)++]);
 
1760
  ST(nxtarglist)->count = incnt;
 
1761
  if (incnt==0)
 
1762
    tp->inlist = ST(nullist);
 
1763
  else tp->inlist = copy_arglist(csound, ST(nxtarglist));
 
1764
  ST(grpcnt) = 0;                             /* all done w. these groups */
1735
1765
 
1736
1766
 spctst:
1737
 
    tp->xincod_str = tp->xincod = 0;
1738
 
    if (tp->opnum == OPCODE) {  /* IV - Sep 8 2002: added OPCODE and ENDOP */
1739
 
      if (UNLIKELY(ST(opcodblk)))
1740
 
        synterr(csound, Str("opcode blks cannot be nested (missing 'endop'?)"));
1741
 
      else if (UNLIKELY(ST(instrblk)))
1742
 
        synterr(csound, Str("opcode not allowed in instr block"));
1743
 
      else ST(instrblk) = ST(opcodblk) = 1;
1744
 
      ST(opcodflg) = 0;
1745
 
      resetouts(csound);                        /* reset #out counts */
1746
 
      lblclear(csound);                         /* restart labelist  */
1747
 
    }
1748
 
    else if (tp->opnum == ENDOP) {      /* IV - Sep 8 2002:     ENDOP:  */
1749
 
      lblchk(csound);                   /* chk missed labels */
1750
 
      if (UNLIKELY(!ST(instrblk)))
1751
 
        synterr(csound, Str("unmatched endop"));
1752
 
      else if (UNLIKELY(!ST(opcodblk)))
1753
 
        synterr(csound, Str("endop not allowed in instr block"));
1754
 
      else ST(instrblk) = ST(opcodblk) = 0;
1755
 
    }
1756
 
    else if (tp->opnum == INSTR) {      /* IV - Sep 8 2002: for opcod INSTR  */
1757
 
      if (UNLIKELY(ST(opcodblk)))     /* IV - Sep 8 2002 */
1758
 
        synterr(csound, Str("instr not allowed in opcode block"));
1759
 
      else if (UNLIKELY(ST(instrblk)))
 
1767
  tp->xincod_str = tp->xincod = 0;
 
1768
  if (tp->opnum == OPCODE) {  /* IV - Sep 8 2002: added OPCODE and ENDOP */
 
1769
    if (UNLIKELY(ST(opcodblk)))
 
1770
      synterr(csound, Str("opcode blks cannot be nested (missing 'endop'?)"));
 
1771
    else if (UNLIKELY(ST(instrblk)))
 
1772
      synterr(csound, Str("opcode not allowed in instr block"));
 
1773
    else ST(instrblk) = ST(opcodblk) = 1;
 
1774
    ST(opcodflg) = 0;
 
1775
    resetouts(csound);                        /* reset #out counts */
 
1776
    lblclear(csound);                         /* restart labelist  */
 
1777
  }
 
1778
  else if (tp->opnum == ENDOP) {      /* IV - Sep 8 2002:     ENDOP:  */
 
1779
    lblchk(csound);                   /* chk missed labels */
 
1780
    if (UNLIKELY(!ST(instrblk)))
 
1781
      synterr(csound, Str("unmatched endop"));
 
1782
    else if (UNLIKELY(!ST(opcodblk)))
 
1783
      synterr(csound, Str("endop not allowed in instr block"));
 
1784
    else ST(instrblk) = ST(opcodblk) = 0;
 
1785
  }
 
1786
  else if (tp->opnum == INSTR) {      /* IV - Sep 8 2002: for opcod INSTR  */
 
1787
    if (UNLIKELY(ST(opcodblk)))     /* IV - Sep 8 2002 */
 
1788
      synterr(csound, Str("instr not allowed in opcode block"));
 
1789
    else if (UNLIKELY(ST(instrblk)))
 
1790
      synterr(csound,
 
1791
              Str("instr blocks cannot be nested (missing 'endin'?)"));
 
1792
    else ST(instrblk) = 1;
 
1793
    resetouts(csound);                        /* reset #out counts */
 
1794
    lblclear(csound);                         /* restart labelist  */
 
1795
  }
 
1796
  else if (tp->opnum == ENDIN) {              /* ENDIN:       */
 
1797
    lblchk(csound);                           /* chk missed labels */
 
1798
    if (UNLIKELY(ST(opcodblk)))
 
1799
      synterr(csound, Str("endin not allowed in opcode blk"));
 
1800
    else if (UNLIKELY(!ST(instrblk)))
 
1801
      synterr(csound, Str("unmatched endin"));
 
1802
    else ST(instrblk) = 0;
 
1803
  }
 
1804
  else {                                      /* for all other opcodes:  */
 
1805
    OENTRY    *ep = csound->opcodlst + tp->opnum;
 
1806
    int       n, nreqd;
 
1807
    char      tfound = '\0', treqd, *types = NULL;
 
1808
    char      xtypes[OPCODENUMOUTS_MAX + 1];  /* IV - Oct 24 2002 */
 
1809
 
 
1810
    if (UNLIKELY(!ST(instrblk)))
 
1811
      synterr(csound, Str("misplaced opcode"));
 
1812
    /* IV - Oct 24 2002: moved argument parsing for xout here */
 
1813
    n = incnt;
 
1814
    nreqd = -1;
 
1815
    if (!strcmp(ep->opname, "xout")) {
 
1816
      if (UNLIKELY(!ST(opcodblk)))
 
1817
        synterr(csound, Str("xout is allowed only in user defined opcodes"));
 
1818
      else if (UNLIKELY((int) ST(opcodflg) & 2))
1760
1819
        synterr(csound,
1761
 
                Str("instr blocks cannot be nested (missing 'endin'?)"));
1762
 
      else ST(instrblk) = 1;
1763
 
      resetouts(csound);                        /* reset #out counts */
1764
 
      lblclear(csound);                         /* restart labelist  */
1765
 
    }
1766
 
    else if (tp->opnum == ENDIN) {              /* ENDIN:       */
1767
 
      lblchk(csound);                           /* chk missed labels */
1768
 
      if (UNLIKELY(ST(opcodblk)))
1769
 
        synterr(csound, Str("endin not allowed in opcode blk"));
1770
 
      else if (UNLIKELY(!ST(instrblk)))
1771
 
        synterr(csound, Str("unmatched endin"));
1772
 
      else ST(instrblk) = 0;
1773
 
    }
1774
 
    else {                                      /* for all other opcodes:  */
1775
 
      OENTRY    *ep = csound->opcodlst + tp->opnum;
1776
 
      int       n, nreqd;
1777
 
      char      tfound = '\0', treqd, *types = NULL;
1778
 
      char      xtypes[OPCODENUMOUTS_MAX + 1];  /* IV - Oct 24 2002 */
 
1820
                Str("multiple uses of xout in the same opcode definition"));
 
1821
      else {
 
1822
        /* IV - Oct 24 2002: opcodeInfo always points to the most recently */
 
1823
        /* defined user opcode (or named instrument) structure; in this */
 
1824
        /* case, it is the current opcode definition (not very elegant, */
 
1825
        /* but works) */
 
1826
        char *c = csound->opcodeInfo->outtypes;
 
1827
        int i = 0;
 
1828
        ST(opcodflg) |= (int16) 2;
 
1829
        nreqd = csound->opcodeInfo->outchns;
 
1830
        /* replace opcode if needed */
 
1831
        if (nreqd > OPCODENUMOUTS_LOW) {
 
1832
          if (nreqd > OPCODENUMOUTS_HIGH)
 
1833
            isopcod(csound, ".xout256");
 
1834
          else
 
1835
            isopcod(csound, ".xout64");
 
1836
          ST(linopcod) = ST(opcod);
 
1837
          ST(linopnum) = ST(opnum);
 
1838
          tp->opcod = strsav_string(csound, ST(linopcod));
 
1839
          tp->opnum = ST(linopnum);
 
1840
          ep = csound->opcodlst + tp->opnum;
 
1841
          csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
 
1842
        }
 
1843
        while (c[i]) {
 
1844
          switch (c[i]) {
 
1845
          case 'a':
 
1846
          case 'k':
 
1847
          case 'f':
 
1848
          case 'i': xtypes[i] = c[i]; break;
 
1849
          case 'K': xtypes[i] = 'k';
 
1850
          }
 
1851
          i++;
 
1852
        }
 
1853
        xtypes[i] = '\0';
 
1854
        types = &xtypes[0];
 
1855
      }
 
1856
    }
 
1857
    if (nreqd < 0)    /* for other opcodes */
 
1858
      nreqd = strlen(types = ep->intypes);
 
1859
    if (n > nreqd) {                  /* IV - Oct 24 2002: end of new code */
 
1860
      if ((treqd = types[nreqd-1]) == 'n') {  /* indef args: */
 
1861
        if (UNLIKELY(!(incnt & 01)))                    /* require odd */
 
1862
          synterr(csound, Str("missing or extra arg"));
 
1863
      }       /* IV - Sep 1 2002: added 'M' */
 
1864
      else if (UNLIKELY(treqd != 'm' && treqd != 'z' && treqd != 'y' &&
 
1865
                        treqd != 'Z' && treqd != 'M' &&
 
1866
                        treqd != 'N')) /* else any no */
 
1867
        synterr(csound, Str("too many input args"));
 
1868
    }
 
1869
    else if (incnt < nreqd) {         /*  or set defaults: */
 
1870
      do {
 
1871
        switch (types[incnt]) {
 
1872
        case 'O':             /* Will this work?  Doubtful code.... */
 
1873
        case 'o': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "0");
 
1874
          break;
 
1875
        case 'P':
 
1876
        case 'p': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "1");
 
1877
          break;
 
1878
        case 'q': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "10");
 
1879
          break;
 
1880
        case 'V':
 
1881
        case 'v': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, ".5");
 
1882
          break;
 
1883
        case 'h': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "127");
 
1884
          break;
 
1885
        case 'J':
 
1886
        case 'j': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "-1");
 
1887
          break;
 
1888
        case 'F':
 
1889
        case 'M':
 
1890
        case 'N':
 
1891
        case 'm': nreqd--;
 
1892
          break;
 
1893
        default:  synterr(csound, Str("insufficient required arguments"));
 
1894
          goto chkin;
 
1895
        }
 
1896
      } while (incnt < nreqd);
 
1897
      ST(nxtarglist)->count = n = incnt;          /*    in extra space */
 
1898
      if (tp->inlist == ST(nullist) && incnt > 0) {
 
1899
        /*MWB 2/11/97 fixed bug that prevented an
 
1900
          opcode with only optional arguments from
 
1901
          properly loading defaults */
 
1902
        tp->inlist = copy_arglist(csound, ST(nxtarglist));
 
1903
      }
 
1904
    }
 
1905
  chkin:
 
1906
    if (n>tp->inlist->count) {
 
1907
      int i;
 
1908
      size_t m = sizeof(ARGLST) + (n - 1) * sizeof(char*);
 
1909
      tp->inlist = (ARGLST*) mrealloc(csound, tp->inlist, m);
 
1910
      for (i=tp->inlist->count; i<n; i++) {
 
1911
        tp->inlist->arg[i] = ST(nxtarglist)->arg[i];
 
1912
      }
 
1913
      tp->inlist->count = n;
 
1914
    }
 
1915
    while (n--) {                     /* inargs:   */
 
1916
      int32    tfound_m, treqd_m = 0L;
 
1917
      s = tp->inlist->arg[n];
 
1918
      if (n >= nreqd) {               /* det type required */
 
1919
        switch (types[nreqd-1]) {
 
1920
        case 'M':
 
1921
        case 'N':
 
1922
        case 'Z':
 
1923
        case 'y':
 
1924
        case 'z':   treqd = types[nreqd-1]; break;
 
1925
        default:    treqd = 'i';    /*   (indef in-type) */
 
1926
        }
 
1927
      }
 
1928
      else treqd = types[n];          /*       or given)   */
 
1929
      if (treqd == 'l') {             /* if arg takes lbl  */
 
1930
        csound->DebugMsg(csound, "treqd = l");
 
1931
        lblrequest(csound, s);        /*      req a search */
 
1932
        continue;                     /*      chk it later */
 
1933
      }
 
1934
      tfound = argtyp(csound, s);     /* else get arg type */
 
1935
      /* IV - Oct 31 2002 */
1779
1936
 
1780
 
      if (UNLIKELY(!ST(instrblk)))
1781
 
        synterr(csound, Str("misplaced opcode"));
1782
 
      /* IV - Oct 24 2002: moved argument parsing for xout here */
1783
 
      n = incnt;
1784
 
      nreqd = -1;
1785
 
      if (!strcmp(ep->opname, "xout")) {
1786
 
        if (UNLIKELY(!ST(opcodblk)))
1787
 
          synterr(csound, Str("xout is allowed only in user defined opcodes"));
1788
 
        else if (UNLIKELY((int) ST(opcodflg) & 2))
1789
 
          synterr(csound,
1790
 
                  Str("multiple uses of xout in the same opcode definition"));
1791
 
        else {
1792
 
          /* IV - Oct 24 2002: opcodeInfo always points to the most recently */
1793
 
          /* defined user opcode (or named instrument) structure; in this */
1794
 
          /* case, it is the current opcode definition (not very elegant, */
1795
 
          /* but works) */
1796
 
          char *c = csound->opcodeInfo->outtypes;
1797
 
          int i = 0;
1798
 
          ST(opcodflg) |= (int16) 2;
1799
 
          nreqd = csound->opcodeInfo->outchns;
1800
 
          /* replace opcode if needed */
1801
 
          if (nreqd > OPCODENUMOUTS_LOW) {
1802
 
            if (nreqd > OPCODENUMOUTS_HIGH)
1803
 
              isopcod(csound, ".xout256");
 
1937
      tfound_m = ST(typemask_tabl)[(unsigned char) tfound];
 
1938
      if (UNLIKELY(!(tfound_m & (ARGTYP_c|ARGTYP_p)) &&
 
1939
                   !ST(lgprevdef) && *s != '"')) {
 
1940
        synterr(csound, Str("input arg '%s' used before defined \n"), s);
 
1941
      }
 
1942
      csound->DebugMsg(csound, "treqd %c, tfound %c", treqd, tfound);
 
1943
      if (tfound == 'a' && n < 31)    /* JMC added for FOG */
 
1944
        /* 4 for FOF, 8 for FOG; expanded to 15  */
 
1945
        tp->xincod |= (1 << n);
 
1946
      if (tfound == 'S' && n < 31)
 
1947
        tp->xincod_str |= (1 << n);
 
1948
      /* IV - Oct 31 2002: simplified code */
 
1949
      if (!(tfound_m & ST(typemask_tabl_in)[(unsigned char) treqd])) {
 
1950
        /* check for exceptional types */
 
1951
        switch (treqd) {
 
1952
        case 'I':
 
1953
          treqd_m = ARGTYP_i;
 
1954
          break;
 
1955
        case 'Z':                             /* indef kakaka ... */
 
1956
          if (UNLIKELY(!(tfound_m & (n & 1 ? ARGTYP_a : ARGTYP_ipcrk))))
 
1957
            intyperr(csound, n, tfound, treqd);
 
1958
          break;
 
1959
        case 'x':
 
1960
          treqd_m = ARGTYP_ipcr;              /* also allows i-rate */
 
1961
        case 's':                             /* a- or k-rate */
 
1962
          treqd_m |= ARGTYP_a | ARGTYP_k;
 
1963
          if (tfound_m & treqd_m) {
 
1964
            if (tfound == 'a' && tp->outlist != ST(nullist)) {
 
1965
              int32 outyp_m =                  /* ??? */
 
1966
                ST(typemask_tabl)[(unsigned char) argtyp(csound,
 
1967
                                                         tp->outlist->arg[0])];
 
1968
              if (outyp_m & (ARGTYP_a | ARGTYP_w | ARGTYP_f)) break;
 
1969
            }
1804
1970
            else
1805
 
              isopcod(csound, ".xout64");
1806
 
            ST(linopcod) = ST(opcod);
1807
 
            ST(linopnum) = ST(opnum);
1808
 
            tp->opcod = strsav_string(csound, ST(linopcod));
1809
 
            tp->opnum = ST(linopnum);
1810
 
            ep = csound->opcodlst + tp->opnum;
1811
 
            csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
1812
 
          }
1813
 
          while (c[i]) {
1814
 
            switch (c[i]) {
1815
 
              case 'a':
1816
 
              case 'k':
1817
 
              case 'f':
1818
 
              case 'i': xtypes[i] = c[i]; break;
1819
 
              case 'K': xtypes[i] = 'k';
1820
 
            }
1821
 
            i++;
1822
 
          }
1823
 
          xtypes[i] = '\0';
1824
 
          types = &xtypes[0];
1825
 
        }
1826
 
      }
1827
 
      if (nreqd < 0)    /* for other opcodes */
1828
 
        nreqd = strlen(types = ep->intypes);
1829
 
      if (n > nreqd) {                  /* IV - Oct 24 2002: end of new code */
1830
 
        if ((treqd = types[nreqd-1]) == 'n') {  /* indef args: */
1831
 
          if (UNLIKELY(!(incnt & 01)))                    /* require odd */
1832
 
            synterr(csound, Str("missing or extra arg"));
1833
 
        }       /* IV - Sep 1 2002: added 'M' */
1834
 
        else if (UNLIKELY(treqd != 'm' && treqd != 'z' && treqd != 'y' &&
1835
 
                          treqd != 'Z' && treqd != 'M' &&
1836
 
                          treqd != 'N')) /* else any no */
1837
 
          synterr(csound, Str("too many input args"));
1838
 
      }
1839
 
      else if (incnt < nreqd) {         /*  or set defaults: */
1840
 
        do {
1841
 
          switch (types[incnt]) {
1842
 
          case 'O':             /* Will this work?  Doubtful code.... */
1843
 
          case 'o': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "0");
1844
 
            break;
 
1971
              break;
 
1972
          }
 
1973
        default:
 
1974
          intyperr(csound, n, tfound, treqd);
 
1975
          break;
 
1976
        }
 
1977
      }
 
1978
    }
 
1979
    csound->DebugMsg(csound, "xincod = %d", tp->xincod);
 
1980
    /* IV - Sep 1 2002: added 'X' type, and xoutcod */
 
1981
    tp->xoutcod_str = tp->xoutcod = 0;
 
1982
    /* IV - Oct 24 2002: moved argument parsing for xin here */
 
1983
    n = outcnt;
 
1984
    nreqd = -1;
 
1985
    if (!strcmp(ep->opname, "xin")) {
 
1986
      if (UNLIKELY(!ST(opcodblk)))
 
1987
        synterr(csound, Str("xin is allowed only in user defined opcodes"));
 
1988
      else if (UNLIKELY((int) ST(opcodflg) & 1))
 
1989
        synterr(csound,
 
1990
                Str("multiple uses of xin in the same opcode definition"));
 
1991
      else {
 
1992
        /* IV - Oct 24 2002: opcodeInfo always points to the most recently */
 
1993
        /* defined user opcode (or named instrument) structure; in this */
 
1994
        /* case, it is the current opcode definition (not very elegant, */
 
1995
        /* but works) */
 
1996
        char *c = csound->opcodeInfo->intypes;
 
1997
        int i = 0;
 
1998
        ST(opcodflg) |= (int16) 1;
 
1999
        nreqd = csound->opcodeInfo->inchns;
 
2000
        /* replace opcode if needed */
 
2001
        if (nreqd > OPCODENUMOUTS_LOW) {
 
2002
          if (nreqd > OPCODENUMOUTS_HIGH)
 
2003
            isopcod(csound, ".xin256");
 
2004
          else
 
2005
            isopcod(csound, ".xin64");
 
2006
          ST(linopcod) = ST(opcod);
 
2007
          ST(linopnum) = ST(opnum);
 
2008
          tp->opcod = strsav_string(csound, ST(linopcod));
 
2009
          tp->opnum = ST(linopnum);
 
2010
          ep = csound->opcodlst + tp->opnum;
 
2011
          csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
 
2012
        }
 
2013
        while (c[i]) {
 
2014
          switch (c[i]) {
 
2015
          case 'a': xtypes[i] = c[i]; break;
 
2016
          case  'f': xtypes[i] = c[i]; break;
 
2017
          case 'k':
1845
2018
          case 'P':
1846
 
          case 'p': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "1");
1847
 
            break;
1848
 
          case 'q': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "10");
1849
 
            break;
1850
 
          case 'V':
1851
 
          case 'v': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, ".5");
1852
 
            break;
1853
 
          case 'h': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "127");
1854
 
            break;
1855
 
          case 'J':
1856
 
          case 'j': ST(nxtarglist)->arg[incnt++] = strsav_string(csound, "-1");
1857
 
            break;
1858
 
          case 'F':
1859
 
          case 'M':
1860
 
          case 'N':
1861
 
          case 'm': nreqd--;
1862
 
            break;
1863
 
          default:  synterr(csound, Str("insufficient required arguments"));
1864
 
            goto chkin;
1865
 
          }
1866
 
        } while (incnt < nreqd);
1867
 
        ST(nxtarglist)->count = n = incnt;          /*    in extra space */
1868
 
        if (tp->inlist == ST(nullist) && incnt > 0) {
1869
 
                                /*MWB 2/11/97 fixed bug that prevented an
1870
 
                                  opcode with only optional arguments from
1871
 
                                  properly loading defaults */
1872
 
          tp->inlist = copy_arglist(csound, ST(nxtarglist));
1873
 
        }
1874
 
      }
1875
 
    chkin:
1876
 
      if (n>tp->inlist->count) {
1877
 
        int i;
1878
 
        size_t m = sizeof(ARGLST) + (n - 1) * sizeof(char*);
1879
 
        tp->inlist = (ARGLST*) mrealloc(csound, tp->inlist, m);
1880
 
        for (i=tp->inlist->count; i<n; i++) {
1881
 
          tp->inlist->arg[i] = ST(nxtarglist)->arg[i];
1882
 
        }
1883
 
        tp->inlist->count = n;
1884
 
      }
1885
 
      while (n--) {                     /* inargs:   */
1886
 
        int32    tfound_m, treqd_m = 0L;
1887
 
        s = tp->inlist->arg[n];
1888
 
        if (n >= nreqd) {               /* det type required */
1889
 
          switch (types[nreqd-1]) {
1890
 
            case 'M':
1891
 
            case 'N':
1892
 
            case 'Z':
1893
 
            case 'y':
1894
 
            case 'z':   treqd = types[nreqd-1]; break;
1895
 
            default:    treqd = 'i';    /*   (indef in-type) */
1896
 
          }
1897
 
        }
1898
 
        else treqd = types[n];          /*       or given)   */
1899
 
        if (treqd == 'l') {             /* if arg takes lbl  */
1900
 
          csound->DebugMsg(csound, "treqd = l");
1901
 
          lblrequest(csound, s);        /*      req a search */
1902
 
          continue;                     /*      chk it later */
1903
 
        }
1904
 
        tfound = argtyp(csound, s);     /* else get arg type */
1905
 
        /* IV - Oct 31 2002 */
1906
 
        tfound_m = ST(typemask_tabl)[(unsigned char) tfound];
1907
 
        if (UNLIKELY(!(tfound_m & (ARGTYP_c|ARGTYP_p)) &&
1908
 
                     !ST(lgprevdef) && *s != '"')) {
1909
 
          synterr(csound, Str("input arg '%s' used before defined"), s);
1910
 
        }
1911
 
        csound->DebugMsg(csound, "treqd %c, tfound %c", treqd, tfound);
1912
 
        if (tfound == 'a' && n < 31)    /* JMC added for FOG */
1913
 
          /* 4 for FOF, 8 for FOG; expanded to 15  */
1914
 
          tp->xincod |= (1 << n);
1915
 
        if (tfound == 'S' && n < 31)
1916
 
          tp->xincod_str |= (1 << n);
1917
 
        /* IV - Oct 31 2002: simplified code */
1918
 
        if (!(tfound_m & ST(typemask_tabl_in)[(unsigned char) treqd])) {
1919
 
          /* check for exceptional types */
1920
 
          switch (treqd) {
1921
 
          case 'I':
1922
 
            treqd_m = ARGTYP_i;
1923
 
            break;
1924
 
          case 'Z':                             /* indef kakaka ... */
1925
 
            if (UNLIKELY(!(tfound_m & (n & 1 ? ARGTYP_a : ARGTYP_ipcrk))))
1926
 
              intyperr(csound, n, tfound, treqd);
1927
 
            break;
1928
 
          case 'x':
1929
 
            treqd_m = ARGTYP_ipcr;              /* also allows i-rate */
1930
 
          case 's':                             /* a- or k-rate */
1931
 
            treqd_m |= ARGTYP_a | ARGTYP_k;
1932
 
            if (tfound_m & treqd_m) {
1933
 
              if (tfound == 'a' && tp->outlist != ST(nullist)) {
1934
 
                int32 outyp_m =                  /* ??? */
1935
 
                  ST(typemask_tabl)[(unsigned char) argtyp(csound,
1936
 
                                                       tp->outlist->arg[0])];
1937
 
                if (outyp_m & (ARGTYP_a | ARGTYP_w | ARGTYP_f)) break;
1938
 
              }
1939
 
              else
1940
 
                break;
1941
 
            }
1942
 
          default:
1943
 
            intyperr(csound, n, tfound, treqd);
1944
 
            break;
1945
 
          }
1946
 
        }
1947
 
      }
1948
 
      csound->DebugMsg(csound, "xincod = %d", tp->xincod);
1949
 
      /* IV - Sep 1 2002: added 'X' type, and xoutcod */
1950
 
      tp->xoutcod_str = tp->xoutcod = 0;
1951
 
      /* IV - Oct 24 2002: moved argument parsing for xin here */
1952
 
      n = outcnt;
1953
 
      nreqd = -1;
1954
 
      if (!strcmp(ep->opname, "xin")) {
1955
 
        if (UNLIKELY(!ST(opcodblk)))
1956
 
          synterr(csound, Str("xin is allowed only in user defined opcodes"));
1957
 
        else if (UNLIKELY((int) ST(opcodflg) & 1))
1958
 
          synterr(csound,
1959
 
                  Str("multiple uses of xin in the same opcode definition"));
1960
 
        else {
1961
 
          /* IV - Oct 24 2002: opcodeInfo always points to the most recently */
1962
 
          /* defined user opcode (or named instrument) structure; in this */
1963
 
          /* case, it is the current opcode definition (not very elegant, */
1964
 
          /* but works) */
1965
 
          char *c = csound->opcodeInfo->intypes;
1966
 
          int i = 0;
1967
 
          ST(opcodflg) |= (int16) 1;
1968
 
          nreqd = csound->opcodeInfo->inchns;
1969
 
          /* replace opcode if needed */
1970
 
          if (nreqd > OPCODENUMOUTS_LOW) {
1971
 
            if (nreqd > OPCODENUMOUTS_HIGH)
1972
 
              isopcod(csound, ".xin256");
1973
 
            else
1974
 
              isopcod(csound, ".xin64");
1975
 
            ST(linopcod) = ST(opcod);
1976
 
            ST(linopnum) = ST(opnum);
1977
 
            tp->opcod = strsav_string(csound, ST(linopcod));
1978
 
            tp->opnum = ST(linopnum);
1979
 
            ep = csound->opcodlst + tp->opnum;
1980
 
            csound->DebugMsg(csound, Str("modified opcod: %s"), ST(opcod));
1981
 
          }
1982
 
          while (c[i]) {
1983
 
            switch (c[i]) {
1984
 
            case 'a': xtypes[i] = c[i]; break;
1985
 
            case  'f': xtypes[i] = c[i]; break;
1986
 
            case 'k':
1987
 
            case 'P':
1988
 
            case 'K': xtypes[i] = 'k'; break;
1989
 
            case 'S': xtypes[i] = 'S'; break;
1990
 
            default:  xtypes[i] = 'i';
1991
 
            }
1992
 
            i++;
1993
 
          }
1994
 
          xtypes[i] = '\0';
1995
 
          types = &xtypes[0];
1996
 
        }
1997
 
      }
1998
 
      if (nreqd < 0)    /* for other opcodes */
1999
 
        nreqd = strlen(types = ep->outypes);
2000
 
      if (UNLIKELY((n != nreqd) &&      /* IV - Oct 24 2002: end of new code */
2001
 
          !(n > 0 && n < nreqd &&
2002
 
            (types[n] == 'm' || types[n] == 'z' || types[n] == 'I' ||
2003
 
             types[n] == 'X' || types[n] == 'N' || types[n] == 'F')))) {
2004
 
        synterr(csound, Str("illegal no of output args"));
2005
 
        if (n > nreqd)
2006
 
          n = nreqd;
2007
 
      }
2008
 
      while (n--) {                                     /* outargs:  */
2009
 
        int32    tfound_m;       /* IV - Oct 31 2002 */
2010
 
        s = tp->outlist->arg[n];
2011
 
        treqd = types[n];
2012
 
        tfound = argtyp(csound, s);                     /*  found    */
2013
 
        /* IV - Oct 31 2002 */
2014
 
        tfound_m = ST(typemask_tabl)[(unsigned char) tfound];
2015
 
        /* IV - Sep 1 2002: xoutcod is the same as xincod for input */
2016
 
        if (tfound == 'a' && n < 31)
2017
 
          tp->xoutcod |= (1 << n);
2018
 
        if (tfound == 'S' && n < 31)
2019
 
          tp->xoutcod_str |= (1 << n);
2020
 
        csound->DebugMsg(csound, "treqd %c, tfound %c", treqd, tfound);
2021
 
        if (tfound_m & ARGTYP_w)
2022
 
          if (UNLIKELY(ST(lgprevdef))) {
2023
 
            synterr(csound, Str("output name previously used, "
2024
 
                                "type '%c' must be uniquely defined"), tfound);
2025
 
          }
2026
 
        /* IV - Oct 31 2002: simplified code */
2027
 
        if (UNLIKELY(!(tfound_m & ST(typemask_tabl_out)[(unsigned char) treqd]))) {
2028
 
          synterr(csound, Str("output arg '%s' illegal type"), s);
2029
 
        }
2030
 
      }
2031
 
      if (incnt) {
2032
 
        if (ep->intypes[0] != 'l')      /* intype defined by 1st inarg */
2033
 
          tp->intype = argtyp(csound, tp->inlist->arg[0]);
2034
 
        else tp->intype = 'l';          /*   (unless label)  */
2035
 
      }
2036
 
      if (outcnt)                       /* pftype defined by outarg */
2037
 
        tp->pftype = tfound;
2038
 
      else tp->pftype = tp->intype;     /*    else by 1st inarg     */
2039
 
    }
2040
 
    return(tp);                         /* return the text blk */
 
2019
          case 'K': xtypes[i] = 'k'; break;
 
2020
          case 'S': xtypes[i] = 'S'; break;
 
2021
          default:  xtypes[i] = 'i';
 
2022
          }
 
2023
          i++;
 
2024
        }
 
2025
        xtypes[i] = '\0';
 
2026
        types = &xtypes[0];
 
2027
      }
 
2028
    }
 
2029
    if (nreqd < 0)    /* for other opcodes */
 
2030
      nreqd = strlen(types = ep->outypes);
 
2031
    if (UNLIKELY((n != nreqd) &&      /* IV - Oct 24 2002: end of new code */
 
2032
                 !(n > 0 && n < nreqd &&
 
2033
                   (types[n] == 'm' || types[n] == 'z' || types[n] == 'I' ||
 
2034
                    types[n] == 'X' || types[n] == 'N' || types[n] == 'F')))) {
 
2035
      synterr(csound, Str("illegal no of output args"));
 
2036
      if (n > nreqd)
 
2037
        n = nreqd;
 
2038
    }
 
2039
    while (n--) {                                     /* outargs:  */
 
2040
      int32    tfound_m;       /* IV - Oct 31 2002 */
 
2041
      s = tp->outlist->arg[n];
 
2042
      treqd = types[n];
 
2043
      tfound = argtyp(csound, s);                     /*  found    */
 
2044
      /* IV - Oct 31 2002 */
 
2045
      tfound_m = ST(typemask_tabl)[(unsigned char) tfound];
 
2046
      /* IV - Sep 1 2002: xoutcod is the same as xincod for input */
 
2047
      if (tfound == 'a' && n < 31)
 
2048
        tp->xoutcod |= (1 << n);
 
2049
      if (tfound == 'S' && n < 31)
 
2050
        tp->xoutcod_str |= (1 << n);
 
2051
      csound->DebugMsg(csound, "treqd %c, tfound %c", treqd, tfound);
 
2052
      if (tfound_m & ARGTYP_w)
 
2053
        if (UNLIKELY(ST(lgprevdef))) {
 
2054
          synterr(csound, Str("output name previously used, "
 
2055
                              "type '%c' must be uniquely defined"), tfound);
 
2056
        }
 
2057
      /* IV - Oct 31 2002: simplified code */
 
2058
      if (UNLIKELY(!(tfound_m & ST(typemask_tabl_out)[(unsigned char) treqd]))) {
 
2059
        synterr(csound, Str("output arg '%s' illegal type"), s);
 
2060
      }
 
2061
    }
 
2062
    if (incnt) {
 
2063
      if (ep->intypes[0] != 'l')      /* intype defined by 1st inarg */
 
2064
        tp->intype = argtyp(csound, tp->inlist->arg[0]);
 
2065
      else tp->intype = 'l';          /*   (unless label)  */
 
2066
    }
 
2067
    if (outcnt)                       /* pftype defined by outarg */
 
2068
      tp->pftype = tfound;
 
2069
    else tp->pftype = tp->intype;     /*    else by 1st inarg     */
 
2070
  }
 
2071
  return(tp);                         /* return the text blk */
2041
2072
}
2042
2073
 
2043
2074
static void intyperr(CSOUND *csound, int n, char tfound, char expect)
2044
2075
{
2045
 
    char    *s = ST(grpsav)[ST(opgrpno) + n];
2046
 
    char    t[10];
 
2076
  char    *s = ST(grpsav)[ST(opgrpno) + n];
 
2077
  char    t[10];
2047
2078
 
2048
 
    switch (tfound) {
2049
 
    case 'w':
2050
 
    case 'f':
2051
 
    case 'a':
2052
 
    case 'k':
2053
 
    case 'i':
2054
 
    case 'P':
2055
 
    case 'p': t[0] = tfound;
2056
 
              t[1] = '\0';
2057
 
              break;
2058
 
    case 'r':
2059
 
    case 'c': strcpy(t,"const");
2060
 
              break;
2061
 
    case 'S': strcpy(t,"string");
2062
 
              break;
2063
 
    case 'b':
2064
 
    case 'B': strcpy(t,"boolean");
2065
 
              break;
2066
 
    case '?': strcpy(t,"?");
2067
 
              break;
2068
 
    }
2069
 
    synterr(csound, Str("input arg '%s' of type %s "
2070
 
                        "not allowed when expecting %c"), s, t, expect);
 
2079
  switch (tfound) {
 
2080
  case 'w':
 
2081
  case 'f':
 
2082
  case 'a':
 
2083
  case 'k':
 
2084
  case 'i':
 
2085
  case 'P':
 
2086
  case 'p': t[0] = tfound;
 
2087
    t[1] = '\0';
 
2088
    break;
 
2089
  case 'r':
 
2090
  case 'c': strcpy(t,"const");
 
2091
    break;
 
2092
  case 'S': strcpy(t,"string");
 
2093
    break;
 
2094
  case 'b':
 
2095
  case 'B': strcpy(t,"boolean");
 
2096
    break;
 
2097
  case '?': strcpy(t,"?");
 
2098
    break;
 
2099
  }
 
2100
  synterr(csound, Str("input arg '%s' of type %s "
 
2101
                      "not allowed when expecting %c"), s, t, expect);
2071
2102
}
2072
2103
 
2073
2104
static int isopcod(CSOUND *csound, char *s)
2074
2105
{                               /* tst a string against opcodlst  */
2075
 
    int     n;                  /*   & set op carriers if matched */
2076
 
 
2077
 
    if (!(n = find_opcode(csound, s))) return (0);      /* IV - Oct 31 2002 */
2078
 
    ST(opnum) = n;                          /* on corr match,   */
2079
 
    ST(opcod) = csound->opcodlst[n].opname; /*  set op carriers */
2080
 
 
2081
 
    return(1);                              /*  & report success */
 
2106
  int     n;                  /*   & set op carriers if matched */
 
2107
 
 
2108
  if (!(n = find_opcode(csound, s))) return (0);      /* IV - Oct 31 2002 */
 
2109
  ST(opnum) = n;                          /* on corr match,   */
 
2110
  ST(opcod) = csound->opcodlst[n].opname; /*  set op carriers */
 
2111
 
 
2112
  return(1);                              /*  & report success */
2082
2113
}
2083
2114
 
2084
2115
static int pnum(char *s)        /* check a char string for pnum format  */
2085
 
                                /*   and return the pnum ( >= 0 )       */
 
2116
/*   and return the pnum ( >= 0 )       */
2086
2117
{                               /* else return -1                       */
2087
 
    int n;
 
2118
  int n;
2088
2119
 
2089
 
    if (*s == 'p' || *s == 'P')
2090
 
      if (sscanf(++s, "%d", &n))
2091
 
        return(n);
2092
 
    return(-1);
 
2120
  if (*s == 'p' || *s == 'P')
 
2121
    if (sscanf(++s, "%d", &n))
 
2122
      return(n);
 
2123
  return(-1);
2093
2124
}
2094
2125
 
2095
2126
char argtyp(CSOUND *csound, char *s)
2096
2127
{                       /* find arg type:  d, w, a, k, i, c, p, r, S, B, b */
2097
 
    char c = *s;        /*   also set lgprevdef if !c && !p && !S */
2098
 
 
2099
 
    /*trap this before parsing for a number! */
2100
 
    /* two situations: defined at header level: 0dbfs = 1.0
2101
 
     *  and returned as a value:  idb = 0dbfs
2102
 
     */
2103
 
    if ((c >= '1' && c <= '9') || c == '.' || c == '-' || c == '+' ||
2104
 
        (c == '0' && strcmp(s, "0dbfs") != 0))
2105
 
      return('c');                              /* const */
2106
 
    if (pnum(s) >= 0)
2107
 
      return('p');                              /* pnum */
2108
 
    if (c == '"')
2109
 
      return('S');                              /* quoted String */
2110
 
    ST(lgprevdef) = lgexist(csound, s);               /* (lgprev) */
2111
 
    if (strcmp(s,"sr") == 0    || strcmp(s,"kr") == 0 ||
2112
 
        strcmp(s,"0dbfs") == 0 || strcmp(s,"nchnls_i") == 0 ||
2113
 
        strcmp(s,"ksmps") == 0 || strcmp(s,"nchnls") == 0)
2114
 
      return('r');                              /* rsvd */
2115
 
    if (c == 'w')               /* N.B. w NOT YET #TYPE OR GLOBAL */
2116
 
      return(c);
2117
 
    if (c == '#')
2118
 
      c = *(++s);
2119
 
    if (c == 'g')
2120
 
      c = *(++s);
2121
 
    if (strchr("akiBbfS", c) != NULL)
2122
 
      return(c);
2123
 
    else return('?');
 
2128
  char c = *s;        /*   also set lgprevdef if !c && !p && !S */
 
2129
 
 
2130
 
 
2131
  /*trap this before parsing for a number! */
 
2132
  /* two situations: defined at header level: 0dbfs = 1.0
 
2133
   *  and returned as a value:  idb = 0dbfs
 
2134
   */
 
2135
  if ((c >= '1' && c <= '9') || c == '.' || c == '-' || c == '+' ||
 
2136
      (c == '0' && strcmp(s, "0dbfs") != 0))
 
2137
    return('c');                              /* const */
 
2138
  if (pnum(s) >= 0)
 
2139
    return('p');                              /* pnum */
 
2140
  if (c == '"')
 
2141
    return('S');                              /* quoted String */
 
2142
  ST(lgprevdef) = lgexist(csound, s);               /* (lgprev) */
 
2143
  if (strcmp(s,"sr") == 0    || strcmp(s,"kr") == 0 ||
 
2144
      strcmp(s,"0dbfs") == 0 || strcmp(s,"nchnls_i") == 0 ||
 
2145
      strcmp(s,"ksmps") == 0 || strcmp(s,"nchnls") == 0)
 
2146
    return('r');                              /* rsvd */
 
2147
  if (c == 'w')               /* N.B. w NOT YET #TYPE OR GLOBAL */
 
2148
    return(c);
 
2149
  if (c == '#')
 
2150
    c = *(++s);
 
2151
  if (c == 'g')
 
2152
    c = *(++s);
 
2153
  if (strchr("akiBbfS", c) != NULL)
 
2154
    return(c);
 
2155
  else return('?');
2124
2156
}
2125
2157
 
2126
2158
static void lblclear(CSOUND *csound)
2127
2159
{
2128
 
    ST(lblcnt) = 0;
 
2160
  ST(lblcnt) = 0;
2129
2161
}
2130
2162
 
2131
2163
static void lblrequest(CSOUND *csound, char *s)
2132
2164
{
2133
 
    int     req;
 
2165
  int     req;
2134
2166
 
2135
 
    for (req=0; req<ST(lblcnt); req++)
2136
 
      if (strcmp(ST(lblreq)[req].label,s) == 0)
2137
 
        return;
2138
 
    if (++ST(lblcnt) >= ST(lblmax)) {
2139
 
      LBLREQ *tmp;
2140
 
      ST(lblmax) += LBLMAX;
2141
 
      tmp = mrealloc(csound, ST(lblreq), ST(lblmax) * sizeof(LBLREQ));
2142
 
      ST(lblreq) = tmp;
2143
 
    }
2144
 
    ST(lblreq)[req].reqline = ST(curline);
2145
 
    ST(lblreq)[req].label =s;
 
2167
  for (req=0; req<ST(lblcnt); req++)
 
2168
    if (strcmp(ST(lblreq)[req].label,s) == 0)
 
2169
      return;
 
2170
  if (++ST(lblcnt) >= ST(lblmax)) {
 
2171
    LBLREQ *tmp;
 
2172
    ST(lblmax) += LBLMAX;
 
2173
    tmp = mrealloc(csound, ST(lblreq), ST(lblmax) * sizeof(LBLREQ));
 
2174
    ST(lblreq) = tmp;
 
2175
  }
 
2176
  ST(lblreq)[req].reqline = ST(curline);
 
2177
  ST(lblreq)[req].label =s;
2146
2178
}
2147
2179
 
2148
2180
static void lblfound(CSOUND *csound, char *s)
2149
2181
{
2150
 
    int     req;
 
2182
  int     req;
2151
2183
 
2152
 
    for (req=0; req<ST(lblcnt); req++ )
2153
 
      if (strcmp(ST(lblreq)[req].label,s) == 0) {
2154
 
        if (UNLIKELY(ST(lblreq)[req].reqline == 0))
2155
 
          synterr(csound, Str("duplicate label"));
2156
 
        goto noprob;
2157
 
      }
2158
 
    if (++ST(lblcnt) >= ST(lblmax)) {
2159
 
      LBLREQ *tmp;
2160
 
      ST(lblmax) += LBLMAX;
2161
 
      tmp = mrealloc(csound, ST(lblreq), ST(lblmax) * sizeof(LBLREQ));
2162
 
      ST(lblreq) = tmp;
 
2184
  for (req=0; req<ST(lblcnt); req++ )
 
2185
    if (strcmp(ST(lblreq)[req].label,s) == 0) {
 
2186
      if (UNLIKELY(ST(lblreq)[req].reqline == 0))
 
2187
        synterr(csound, Str("duplicate label"));
 
2188
      goto noprob;
2163
2189
    }
2164
 
    ST(lblreq)[req].label = s;
2165
 
noprob:
2166
 
    ST(lblreq)[req].reqline = 0;
 
2190
  if (++ST(lblcnt) >= ST(lblmax)) {
 
2191
    LBLREQ *tmp;
 
2192
    ST(lblmax) += LBLMAX;
 
2193
    tmp = mrealloc(csound, ST(lblreq), ST(lblmax) * sizeof(LBLREQ));
 
2194
    ST(lblreq) = tmp;
 
2195
  }
 
2196
  ST(lblreq)[req].label = s;
 
2197
 noprob:
 
2198
  ST(lblreq)[req].reqline = 0;
2167
2199
}
2168
2200
 
2169
2201
static void lblchk(CSOUND *csound)
2170
2202
{
2171
 
    int req;
2172
 
    int n;
 
2203
  int req;
 
2204
  int n;
2173
2205
 
2174
 
    for (req=0; req<ST(lblcnt); req++ )
2175
 
      if (UNLIKELY((n = ST(lblreq)[req].reqline))) {
2176
 
        char    *s;
2177
 
        csound->Message(csound, Str("error line %d.  unknown label:\n"), n);
2178
 
        s = ST(linadr)[n];
2179
 
        do {
2180
 
          csound->Message(csound, "%c", *s);
2181
 
        } while (*s++ != '\n');
2182
 
        csound->synterrcnt++;
2183
 
      }
 
2206
  for (req=0; req<ST(lblcnt); req++ )
 
2207
    if (UNLIKELY((n = ST(lblreq)[req].reqline))) {
 
2208
      char    *s;
 
2209
      csound->Message(csound, Str("error line %d.  unknown label:\n"), n);
 
2210
      s = ST(linadr)[n];
 
2211
      do {
 
2212
        csound->Message(csound, "%c", *s);
 
2213
      } while (*s++ != '\n');
 
2214
      csound->synterrcnt++;
 
2215
    }
2184
2216
}
2185
2217
 
2186
2218
void synterr(CSOUND *csound, const char *s, ...)
2187
2219
{
2188
 
    va_list args;
2189
 
    char    *cp;
2190
 
    int     c;
2191
 
 
2192
 
    csound->MessageS(csound, CSOUNDMSG_ERROR, Str("error:  "));
2193
 
    va_start(args, s);
2194
 
    csound->MessageV(csound, CSOUNDMSG_ERROR, s, args);
2195
 
    va_end(args);
2196
 
 
2197
 
 
2198
 
    /* FIXME - Removed temporarily for debugging
2199
 
     * This function may not be necessary at all in the end if some of this is
2200
 
     * done in the parser
2201
 
     */
2202
 
    if (ST(linadr) != NULL && (cp = ST(linadr)[ST(curline)]) != NULL
 
2220
  va_list args;
 
2221
 
 
2222
  csound->MessageS(csound, CSOUNDMSG_ERROR, Str("error:  "));
 
2223
  va_start(args, s);
 
2224
  csound->MessageV(csound, CSOUNDMSG_ERROR, s, args);
 
2225
  va_end(args);
 
2226
 
 
2227
 
 
2228
  /* FIXME - Removed temporarily for debugging
 
2229
   * This function may not be necessary at all in the end if some of this is
 
2230
   * done in the parser
 
2231
   */
 
2232
#ifdef never
 
2233
  if (ST(linadr) != NULL && (cp = ST(linadr)[ST(curline)]) != NULL
2203
2234
#if defined(ENABLE_NEW_PARSER)
2204
 
        && !csound->oparms->newParser
2205
 
#endif
2206
 
    ) {
2207
 
      csound->MessageS(csound, CSOUNDMSG_ERROR,
2208
 
                               Str(", line %d:\n"), CURLINE);
2209
 
      do {
2210
 
        csound->MessageS(csound, CSOUNDMSG_ERROR, "%c", (c = *cp++));
2211
 
      } while (c != '\n');
2212
 
    }
2213
 
    else {
2214
 
      csound->MessageS(csound, CSOUNDMSG_ERROR, "\n");
2215
 
    }
2216
 
    csound->synterrcnt++;
 
2235
      && !csound->oparms->newParser
 
2236
#endif
 
2237
      ) {
 
2238
    csound->MessageS(csound, CSOUNDMSG_ERROR,
 
2239
                     Str(", line %d:\n"), CURLINE);
 
2240
    do {
 
2241
      csound->MessageS(csound, CSOUNDMSG_ERROR, "%c", (c = *cp++));
 
2242
    } while (c != '\n');
 
2243
  }
 
2244
  else {
 
2245
    csound->MessageS(csound, CSOUNDMSG_ERROR, "\n");
 
2246
  }
 
2247
#endif
 
2248
  csound->synterrcnt++;
2217
2249
}
2218
2250
 
2219
2251
static void synterrp(CSOUND *csound, const char *errp, char *s)
2220
2252
{
2221
 
    char    *cp;
 
2253
  char    *cp;
2222
2254
 
2223
 
    synterr(csound, s);
2224
 
    cp = ST(linadr)[ST(curline)];
2225
 
    while (cp < errp) {
2226
 
      int ch = *cp++;
2227
 
      if (ch != '\t') ch = ' ';
2228
 
      csound->MessageS(csound, CSOUNDMSG_ERROR, "%c", ch);
2229
 
    }
2230
 
    csound->ErrorMsg(csound, "^");
 
2255
  synterr(csound, s);
 
2256
  cp = ST(linadr)[ST(curline)];
 
2257
  while (cp < errp) {
 
2258
    int ch = *cp++;
 
2259
    if (ch != '\t') ch = ' ';
 
2260
    csound->MessageS(csound, CSOUNDMSG_ERROR, "%c", ch);
 
2261
  }
 
2262
  csound->ErrorMsg(csound, "^");
2231
2263
}
2232
2264
 
2233
2265
static void lexerr(CSOUND *csound, const char *s, ...)
2234
2266
{
2235
 
    IN_STACK  *curr = ST(str);
2236
 
    va_list   args;
2237
 
 
2238
 
    va_start(args, s);
2239
 
    csound->ErrMsgV(csound, Str("error:  "), s, args);
2240
 
    va_end(args);
2241
 
 
2242
 
    while (curr != ST(inputs)) {
2243
 
      if (curr->string) {
2244
 
        MACRO *mm = ST(macros);
2245
 
        while (mm != curr->mac) mm = mm->next;
2246
 
        csound->ErrorMsg(csound, Str("called from line %d of macro %s"),
2247
 
                                 curr->line, mm->name);
2248
 
      }
2249
 
      else {
2250
 
        csound->ErrorMsg(csound, Str("in line %d of file input %s"),
2251
 
                                 curr->line, curr->body);
2252
 
      }
2253
 
      curr--;
2254
 
    }
2255
 
    csound->LongJmp(csound, 1);
 
2267
  IN_STACK  *curr = ST(str);
 
2268
  va_list   args;
 
2269
 
 
2270
  va_start(args, s);
 
2271
  csound->ErrMsgV(csound, Str("error:  "), s, args);
 
2272
  va_end(args);
 
2273
 
 
2274
  while (curr != ST(inputs)) {
 
2275
    if (curr->string) {
 
2276
      MACRO *mm = ST(macros);
 
2277
      while (mm != curr->mac) mm = mm->next;
 
2278
      csound->ErrorMsg(csound, Str("called from line %d of macro %s"),
 
2279
                       curr->line, mm->name);
 
2280
    }
 
2281
    else {
 
2282
      csound->ErrorMsg(csound, Str("in line %d of file input %s"),
 
2283
                       curr->line, curr->body);
 
2284
    }
 
2285
    curr--;
 
2286
  }
 
2287
  csound->LongJmp(csound, 1);
2256
2288
}
2257
2289
 
2258
2290
static void printgroups(CSOUND *csound, int grpcnt)
2259
2291
{                                       /*   debugging aid (onto stdout) */
2260
 
    char    c, *cp = ST(group)[0];
 
2292
  char    c, *cp = ST(group)[0];
2261
2293
 
2262
 
    csound->Message(csound, "groups:\t");
2263
 
    while (grpcnt--) {
2264
 
      csound->Message(csound, "%s ", cp);
2265
 
      while ((c = *cp++));
2266
 
    }
2267
 
    csound->Message(csound, "\n");
 
2294
  csound->Message(csound, "groups:\t");
 
2295
  while (grpcnt--) {
 
2296
    csound->Message(csound, "%s ", cp);
 
2297
    while ((c = *cp++));
 
2298
  }
 
2299
  csound->Message(csound, "\n");
2268
2300
}