gas/macro.c

   1 /* macro.c - macro support for gas and gasp
   2    Copyright (C) 1994, 95, 96, 1997 Free Software Foundation, Inc.
   3
   4    Written by Steve and Judy Chamberlain of Cygnus Support,
   5       sac@cygnus.com
   6
   7    This file is part of GAS, the GNU Assembler.
   8
   9    GAS is free software; you can redistribute it and/or modify
  10    it under the terms of the GNU General Public License as published by
  11    the Free Software Foundation; either version 2, or (at your option)
  12    any later version.
  13
  14    GAS is distributed in the hope that it will be useful,
  15    but WITHOUT ANY WARRANTY; without even the implied warranty of
  16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17    GNU General Public License for more details.
  18
  19    You should have received a copy of the GNU General Public License
  20    along with GAS; see the file COPYING.  If not, write to the Free
  21    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  22    02111-1307, USA. */
  23
  24 #include "config.h"
  25
  26 /* AIX requires this to be the first thing in the file.  */
  27 #ifdef __GNUC__
  28 #ifdef __STDC__
  29 extern void *alloca ();
  30 #else
  31 extern char *alloca ();
  32 #endif
  33 #else
  34 # if HAVE_ALLOCA_H
  35 #  include <alloca.h>
  36 # else
  37 #  ifdef _AIX
  38  #pragma alloca
  39 #  else
  40 #   ifndef alloca /* predefined by HP cc +Olibcalls */
  41 #    if !defined (__STDC__) && !defined (__hpux)
  42 extern char *alloca ();
  43 #    else
  44 extern void *alloca ();
  45 #    endif /* __STDC__, __hpux */
  46 #   endif /* alloca */
  47 #  endif /* _AIX */
  48 # endif /* HAVE_ALLOCA_H */
  49 #endif
  50
  51 #include <stdio.h>
  52 #ifdef HAVE_STRING_H
  53 #include <string.h>
  54 #else
  55 #include <strings.h>
  56 #endif
  57 #include <ctype.h>
  58 #ifdef HAVE_STDLIB_H
  59 #include <stdlib.h>
  60 #endif
  61 #include "libiberty.h"
  62 #include "sb.h"
  63 #include "hash.h"
  64 #include "macro.h"
  65
  66 /* The routines in this file handle macro definition and expansion.
  67    They are called by both gasp and gas.  */
  68
  69 /* Structures used to store macros.
  70
  71    Each macro knows its name and included text.  It gets built with a
  72    list of formal arguments, and also keeps a hash table which points
  73    into the list to speed up formal search.  Each formal knows its
  74    name and its default value.  Each time the macro is expanded, the
  75    formals get the actual values attatched to them. */
  76
  77 /* describe the formal arguments to a macro */
  78
  79 typedef struct formal_struct
  80   {
  81     struct formal_struct *next; /* next formal in list */
  82     sb name;                    /* name of the formal */
  83     sb def;                     /* the default value */
  84     sb actual;                  /* the actual argument (changed on each expansion) */
  85     int index;                  /* the index of the formal 0..formal_count-1 */
  86   }
  87 formal_entry;
  88
  89 /* Other values found in the index field of a formal_entry.  */
  90 #define QUAL_INDEX (-1)
  91 #define NARG_INDEX (-2)
  92 #define LOCAL_INDEX (-3)
  93
  94 /* describe the macro. */
  95
  96 typedef struct macro_struct
  97   {
  98     sb sub;                     /* substitution text. */
  99     int formal_count;           /* number of formal args. */
 100     formal_entry *formals;      /* pointer to list of formal_structs */
 101     struct hash_control *formal_hash; /* hash table of formals. */
 102   }
 103 macro_entry;
 104
 105 /* Internal functions.  */
 106
 107 static int get_token PARAMS ((int, sb *, sb *));
 108 static int getstring PARAMS ((int, sb *, sb *));
 109 static int get_any_string PARAMS ((int, sb *, sb *, int, int));
 110 static int do_formals PARAMS ((macro_entry *, int, sb *));
 111 static int get_apost_token PARAMS ((int, sb *, sb *, int));
 112 static int sub_actual
 113   PARAMS ((int, sb *, sb *, struct hash_control *, int, sb *, int));
 114 static const char *macro_expand_body
 115   PARAMS ((sb *, sb *, formal_entry *, struct hash_control *, int, int));
 116 static const char *macro_expand PARAMS ((int, sb *, macro_entry *, sb *, int));
 117
 118 #define ISWHITE(x) ((x) == ' ' || (x) == '\t')
 119
 120 #define ISSEP(x) \
 121  ((x) == ' ' || (x) == '\t' || (x) == ',' || (x) == '"' || (x) == ';' \
 122   || (x) == '<' || (x) == '>' || (x) == ')' || (x) == '(')
 123
 124 #define ISBASE(x) \
 125   ((x) == 'b' || (x) == 'B' \
 126    || (x) == 'q' || (x) == 'Q' \
 127    || (x) == 'h' || (x) == 'H' \
 128    || (x) == 'd' || (x) == 'D')
 129
 130 /* The macro hash table.  */
 131
 132 static struct hash_control *macro_hash;
 133
 134 /* Whether any macros have been defined.  */
 135
 136 int macro_defined;
 137
 138 /* Whether we are in GASP alternate mode.  */
 139
 140 static int macro_alternate;
 141
 142 /* Whether we are in MRI mode.  */
 143
 144 static int macro_mri;
 145
 146 /* Whether we should strip '@' characters.  */
 147
 148 static int macro_strip_at;
 149
 150 /* Function to use to parse an expression.  */
 151
 152 static int (*macro_expr) PARAMS ((const char *, int, sb *, int *));
 153
 154 /* Number of macro expansions that have been done.  */
 155
 156 static int macro_number;
 157
 158 /* Initialize macro processing.  */
 159
 160 void
 161 macro_init (alternate, mri, strip_at, expr)
 162      int alternate;
 163      int mri;
 164      int strip_at;
 165      int (*expr) PARAMS ((const char *, int, sb *, int *));
 166 {
 167   macro_hash = hash_new ();
 168   macro_defined = 0;
 169   macro_alternate = alternate;
 170   macro_mri = mri;
 171   macro_strip_at = strip_at;
 172   macro_expr = expr;
 173 }
 174
 175 /* Read input lines till we get to a TO string.
 176    Increase nesting depth if we get a FROM string.
 177    Put the results into sb at PTR.
 178    Add a new input line to an sb using GET_LINE.
 179    Return 1 on success, 0 on unexpected EOF.  */
 180
 181 int
 182 buffer_and_nest (from, to, ptr, get_line)
 183      const char *from;
 184      const char *to;
 185      sb *ptr;
 186      int (*get_line) PARAMS ((sb *));
 187 {
 188   int from_len = strlen (from);
 189   int to_len = strlen (to);
 190   int depth = 1;
 191   int line_start = ptr->len;
 192
 193   int more = get_line (ptr);
 194
 195   while (more)
 196     {
 197       /* Try and find the first pseudo op on the line */
 198       int i = line_start;
 199
 200       if (! macro_alternate && ! macro_mri)
 201         {
 202           /* With normal syntax we can suck what we want till we get
 203              to the dot.  With the alternate, labels have to start in
 204              the first column, since we cant tell what's a label and
 205              whats a pseudoop */
 206
 207           /* Skip leading whitespace */
 208           while (i < ptr->len && ISWHITE (ptr->ptr[i]))
 209             i++;
 210
 211           /* Skip over a label */
 212           while (i < ptr->len
 213                  && (isalnum ((unsigned char) ptr->ptr[i])
 214                      || ptr->ptr[i] == '_'
 215                      || ptr->ptr[i] == '$'))
 216             i++;
 217
 218           /* And a colon */
 219           if (i < ptr->len
 220               && ptr->ptr[i] == ':')
 221             i++;
 222
 223         }
 224       /* Skip trailing whitespace */
 225       while (i < ptr->len && ISWHITE (ptr->ptr[i]))
 226         i++;
 227
 228       if (i < ptr->len && (ptr->ptr[i] == '.'
 229                            || macro_alternate
 230                            || macro_mri))
 231         {
 232           if (ptr->ptr[i] == '.')
 233               i++;
 234           if (strncasecmp (ptr->ptr + i, from, from_len) == 0)
 235             depth++;
 236           if (strncasecmp (ptr->ptr + i, to, to_len) == 0)
 237             {
 238               depth--;
 239               if (depth == 0)
 240                 {
 241                   /* Reset the string to not include the ending rune */
 242                   ptr->len = line_start;
 243                   break;
 244                 }
 245             }
 246         }
 247
 248       /* Add a CR to the end and keep running */
 249       sb_add_char (ptr, '\n');
 250       line_start = ptr->len;
 251       more = get_line (ptr);
 252     }
 253
 254   /* Return 1 on success, 0 on unexpected EOF.  */
 255   return depth == 0;
 256 }
 257
 258 /* Pick up a token.  */
 259
 260 static int
 261 get_token (idx, in, name)
 262      int idx;
 263      sb *in;
 264      sb *name;
 265 {
 266   if (idx < in->len
 267       && (isalpha ((unsigned char) in->ptr[idx])
 268           || in->ptr[idx] == '_'
 269           || in->ptr[idx] == '$'))
 270     {
 271       sb_add_char (name, in->ptr[idx++]);
 272       while (idx < in->len
 273              && (isalnum ((unsigned char) in->ptr[idx])
 274                  || in->ptr[idx] == '_'
 275                  || in->ptr[idx] == '$'))
 276         {
 277           sb_add_char (name, in->ptr[idx++]);
 278         }
 279     }
 280   /* Ignore trailing & */
 281   if (macro_alternate && idx < in->len && in->ptr[idx] == '&')
 282     idx++;
 283   return idx;
 284 }
 285
 286 /* Pick up a string.  */
 287
 288 static int
 289 getstring (idx, in, acc)
 290      int idx;
 291      sb *in;
 292      sb *acc;
 293 {
 294   idx = sb_skip_white (idx, in);
 295
 296   while (idx < in->len
 297          && (in->ptr[idx] == '"'
 298              || in->ptr[idx] == '<'
 299              || (in->ptr[idx] == '\'' && macro_alternate)))
 300     {
 301       if (in->ptr[idx] == '<')
 302         {
 303           if (macro_alternate || macro_mri)
 304             {
 305               int nest = 0;
 306               idx++;
 307               while ((in->ptr[idx] != '>' || nest)
 308                      && idx < in->len)
 309                 {
 310                   if (in->ptr[idx] == '!')
 311                     {
 312                       idx++  ;
 313                       sb_add_char (acc, in->ptr[idx++]);
 314                     }
 315                   else
 316                     {
 317                       if (in->ptr[idx] == '>')
 318                         nest--;
 319                       if (in->ptr[idx] == '<')
 320                         nest++;
 321                       sb_add_char (acc, in->ptr[idx++]);
 322                     }
 323                 }
 324               idx++;
 325             }
 326           else
 327             {
 328               int code;
 329               idx++;
 330               idx = ((*macro_expr)
 331                      ("character code in string must be absolute expression",
 332                       idx, in, &code));
 333               sb_add_char (acc, code);
 334
 335 #if 0
 336               if (in->ptr[idx] != '>')
 337                 ERROR ((stderr, "Missing > for character code.\n"));
 338 #endif
 339               idx++;
 340             }
 341         }
 342       else if (in->ptr[idx] == '"' || in->ptr[idx] == '\'')
 343         {
 344           char tchar = in->ptr[idx];
 345           idx++;
 346           while (idx < in->len)
 347             {
 348               if (macro_alternate && in->ptr[idx] == '!')
 349                 {
 350                   idx++  ;
 351                   sb_add_char (acc, in->ptr[idx++]);
 352                 }
 353               else
 354                 {
 355                   if (in->ptr[idx] == tchar)
 356                     {
 357                       idx++;
 358                       if (idx >= in->len || in->ptr[idx] != tchar)
 359                         break;
 360                     }
 361                   sb_add_char (acc, in->ptr[idx]);
 362                   idx++;
 363                 }
 364             }
 365         }
 366     }
 367
 368   return idx;
 369 }
 370
 371 /* Fetch string from the input stream,
 372    rules:
 373     'Bxyx<whitespace>   -> return 'Bxyza
 374     %<char>             -> return string of decimal value of x
 375     "<string>"          -> return string
 376     xyx<whitespace>     -> return xyz
 377 */
 378
 379 static int
 380 get_any_string (idx, in, out, expand, pretend_quoted)
 381      int idx;
 382      sb *in;
 383      sb *out;
 384      int expand;
 385      int pretend_quoted;
 386 {
 387   sb_reset (out);
 388   idx = sb_skip_white (idx, in);
 389
 390   if (idx < in->len)
 391     {
 392       if (in->len > 2 && in->ptr[idx+1] == '\'' && ISBASE (in->ptr[idx]))
 393         {
 394           while (!ISSEP (in->ptr[idx]))
 395             sb_add_char (out, in->ptr[idx++]);
 396         }
 397       else if (in->ptr[idx] == '%'
 398                && macro_alternate
 399                && expand)
 400         {
 401           int val;
 402           char buf[20];
 403           /* Turns the next expression into a string */
 404           idx = (*macro_expr) ("% operator needs absolute expression",
 405                                idx + 1,
 406                                in,
 407                                &val);
 408           sprintf(buf, "%d", val);
 409           sb_add_string (out, buf);
 410         }
 411       else if (in->ptr[idx] == '"'
 412                || in->ptr[idx] == '<'
 413                || (macro_alternate && in->ptr[idx] == '\''))
 414         {
 415           if (macro_alternate
 416               && ! macro_strip_at
 417               && expand)
 418             {
 419               /* Keep the quotes */
 420               sb_add_char (out,  '\"');
 421
 422               idx = getstring (idx, in, out);
 423               sb_add_char (out,  '\"');
 424             }
 425           else
 426             {
 427               idx = getstring (idx, in, out);
 428             }
 429         }
 430       else
 431         {
 432           while (idx < in->len
 433                  && (in->ptr[idx] == '"'
 434                      || in->ptr[idx] == '\''
 435                      || pretend_quoted
 436                      || (in->ptr[idx] != ' '
 437                          && in->ptr[idx] != '\t'
 438                          && in->ptr[idx] != ','
 439                          && in->ptr[idx] != '<')))
 440             {
 441               if (in->ptr[idx] == '"'
 442                   || in->ptr[idx] == '\'')
 443                 {
 444                   char tchar = in->ptr[idx];
 445                   sb_add_char (out, in->ptr[idx++]);
 446                   while (idx < in->len
 447                          && in->ptr[idx] != tchar)
 448                     sb_add_char (out, in->ptr[idx++]);
 449                   if (idx == in->len)
 450                     return idx;
 451                 }
 452               sb_add_char (out, in->ptr[idx++]);
 453             }
 454         }
 455     }
 456
 457   return idx;
 458 }
 459
 460 /* Pick up the formal parameters of a macro definition.  */
 461
 462 static int
 463 do_formals (macro, idx, in)
 464      macro_entry *macro;
 465      int idx;
 466      sb *in;
 467 {
 468   formal_entry **p = &macro->formals;
 469
 470   macro->formal_count = 0;
 471   macro->formal_hash = hash_new ();
 472   while (idx < in->len)
 473     {
 474       formal_entry *formal;
 475
 476       formal = (formal_entry *) xmalloc (sizeof (formal_entry));
 477
 478       sb_new (&formal->name);
 479       sb_new (&formal->def);
 480       sb_new (&formal->actual);
 481
 482       idx = sb_skip_white (idx, in);
 483       idx = get_token (idx, in, &formal->name);
 484       if (formal->name.len == 0)
 485         break;
 486       idx = sb_skip_white (idx, in);
 487       if (formal->name.len)
 488         {
 489           /* This is a formal */
 490           if (idx < in->len && in->ptr[idx] == '=')
 491             {
 492               /* Got a default */
 493               idx = get_any_string (idx + 1, in, &formal->def, 1, 0);
 494             }
 495         }
 496
 497       /* Add to macro's hash table */
 498       hash_jam (macro->formal_hash, sb_terminate (&formal->name), formal);
 499
 500       formal->index = macro->formal_count;
 501       idx = sb_skip_comma (idx, in);
 502       macro->formal_count++;
 503       *p = formal;
 504       p = &formal->next;
 505       *p = NULL;
 506     }
 507
 508   if (macro_mri)
 509     {
 510       formal_entry *formal;
 511       const char *name;
 512
 513       /* Add a special NARG formal, which macro_expand will set to the
 514          number of arguments.  */
 515       formal = (formal_entry *) xmalloc (sizeof (formal_entry));
 516
 517       sb_new (&formal->name);
 518       sb_new (&formal->def);
 519       sb_new (&formal->actual);
 520
 521       /* The same MRI assemblers which treat '@' characters also use
 522          the name $NARG.  At least until we find an exception.  */
 523       if (macro_strip_at)
 524         name = "$NARG";
 525       else
 526         name = "NARG";
 527
 528       sb_add_string (&formal->name, name);
 529
 530       /* Add to macro's hash table */
 531       hash_jam (macro->formal_hash, name, formal);
 532
 533       formal->index = NARG_INDEX;
 534       *p = formal;
 535       formal->next = NULL;
 536     }
 537
 538   return idx;
 539 }
 540
 541 /* Define a new macro.  Returns NULL on success, otherwise returns an
 542    error message.  If NAMEP is not NULL, *NAMEP is set to the name of
 543    the macro which was defined.  */
 544
 545 const char *
 546 define_macro (idx, in, label, get_line, namep)
 547      int idx;
 548      sb *in;
 549      sb *label;
 550      int (*get_line) PARAMS ((sb *));
 551      const char **namep;
 552 {
 553   macro_entry *macro;
 554   sb name;
 555   const char *namestr;
 556
 557   macro = (macro_entry *) xmalloc (sizeof (macro_entry));
 558   sb_new (&macro->sub);
 559   sb_new (&name);
 560
 561   macro->formal_count = 0;
 562   macro->formals = 0;
 563
 564   idx = sb_skip_white (idx, in);
 565   if (! buffer_and_nest ("MACRO", "ENDM", &macro->sub, get_line))
 566     return "unexpected end of file in macro definition";
 567   if (label != NULL && label->len != 0)
 568     {
 569       sb_add_sb (&name, label);
 570       if (idx < in->len && in->ptr[idx] == '(')
 571         {
 572           /* It's the label: MACRO (formals,...)  sort */
 573           idx = do_formals (macro, idx + 1, in);
 574           if (in->ptr[idx] != ')')
 575             return "missing ) after formals";
 576         }
 577       else
 578         {
 579           /* It's the label: MACRO formals,...  sort */
 580           idx = do_formals (macro, idx, in);
 581         }
 582     }
 583   else
 584     {
 585       idx = get_token (idx, in, &name);
 586       idx = sb_skip_comma (idx, in);
 587       idx = do_formals (macro, idx, in);
 588     }
 589
 590   /* and stick it in the macro hash table */
 591   for (idx = 0; idx < name.len; idx++)
 592     if (isupper (name.ptr[idx]))
 593       name.ptr[idx] = tolower (name.ptr[idx]);
 594   namestr = sb_terminate (&name);
 595   hash_jam (macro_hash, namestr, (PTR) macro);
 596
 597   macro_defined = 1;
 598
 599   if (namep != NULL)
 600     *namep = namestr;
 601
 602   return NULL;
 603 }
 604
 605 /* Scan a token, and then skip KIND.  */
 606
 607 static int
 608 get_apost_token (idx, in, name, kind)
 609      int idx;
 610      sb *in;
 611      sb *name;
 612      int kind;
 613 {
 614   idx = get_token (idx, in, name);
 615   if (idx < in->len
 616       && in->ptr[idx] == kind
 617       && (! macro_mri || macro_strip_at)
 618       && (! macro_strip_at || kind == '@'))
 619     idx++;
 620   return idx;
 621 }
 622
 623 /* Substitute the actual value for a formal parameter.  */
 624
 625 static int
 626 sub_actual (start, in, t, formal_hash, kind, out, copyifnotthere)
 627      int start;
 628      sb *in;
 629      sb *t;
 630      struct hash_control *formal_hash;
 631      int kind;
 632      sb *out;
 633      int copyifnotthere;
 634 {
 635   int src;
 636   formal_entry *ptr;
 637
 638   src = get_apost_token (start, in, t, kind);
 639   /* See if it's in the macro's hash table, unless this is
 640      macro_strip_at and kind is '@' and the token did not end in '@'.  */
 641   if (macro_strip_at
 642       && kind == '@'
 643       && (src == start || in->ptr[src - 1] != '@'))
 644     ptr = NULL;
 645   else
 646     ptr = (formal_entry *) hash_find (formal_hash, sb_terminate (t));
 647   if (ptr)
 648     {
 649       if (ptr->actual.len)
 650         {
 651           sb_add_sb (out, &ptr->actual);
 652         }
 653       else
 654         {
 655           sb_add_sb (out, &ptr->def);
 656         }
 657     }
 658   else if (copyifnotthere)
 659     {
 660       sb_add_sb (out, t);
 661     }
 662   else
 663     {
 664       sb_add_char (out, '\\');
 665       sb_add_sb (out, t);
 666     }
 667   return src;
 668 }
 669
 670 /* Expand the body of a macro.  */
 671
 672 static const char *
 673 macro_expand_body (in, out, formals, formal_hash, comment_char, locals)
 674      sb *in;
 675      sb *out;
 676      formal_entry *formals;
 677      struct hash_control *formal_hash;
 678      int comment_char;
 679      int locals;
 680 {
 681   sb t;
 682   int src = 0;
 683   int inquote = 0;
 684   formal_entry *loclist = NULL;
 685
 686   sb_new (&t);
 687
 688   while (src < in->len)
 689     {
 690       if (in->ptr[src] == '&')
 691         {
 692           sb_reset (&t);
 693           if (macro_mri)
 694             {
 695               if (src + 1 < in->len && in->ptr[src + 1] == '&')
 696                 src = sub_actual (src + 2, in, &t, formal_hash, '\'', out, 1);
 697               else
 698                 sb_add_char (out, in->ptr[src++]);
 699             }
 700           else
 701             {
 702               /* FIXME: Why do we do this?  It prevents people from
 703                  using the & operator in a macro.  */
 704               src = sub_actual (src + 1, in, &t, formal_hash, '&', out, 0);
 705             }
 706         }
 707       else if (in->ptr[src] == '\\')
 708         {
 709           src++;
 710           if (in->ptr[src] == comment_char && comment_char != '\0')
 711             {
 712               /* This is a comment, just drop the rest of the line */
 713               while (src < in->len
 714                      && in->ptr[src] != '\n')
 715                 src++;
 716             }
 717           else if (in->ptr[src] == '(')
 718             {
 719               /* Sub in till the next ')' literally */
 720               src++;
 721               while (src < in->len && in->ptr[src] != ')')
 722                 {
 723                   sb_add_char (out, in->ptr[src++]);
 724                 }
 725               if (in->ptr[src] == ')')
 726                 src++;
 727               else
 728                 return "missplaced )";
 729             }
 730           else if (in->ptr[src] == '@')
 731             {
 732               /* Sub in the macro invocation number */
 733
 734               char buffer[6];
 735               src++;
 736               sprintf (buffer, "%05d", macro_number);
 737               sb_add_string (out, buffer);
 738             }
 739           else if (in->ptr[src] == '&')
 740             {
 741               /* This is a preprocessor variable name, we don't do them
 742                  here */
 743               sb_add_char (out, '\\');
 744               sb_add_char (out, '&');
 745               src++;
 746             }
 747           else if (macro_mri
 748                    && isalnum ((unsigned char) in->ptr[src]))
 749             {
 750               int ind;
 751               formal_entry *f;
 752
 753               if (isdigit ((unsigned char) in->ptr[src]))
 754                 ind = in->ptr[src] - '0';
 755               else if (isupper ((unsigned char) in->ptr[src]))
 756                 ind = in->ptr[src] - 'A' + 10;
 757               else
 758                 ind = in->ptr[src] - 'a' + 10;
 759               ++src;
 760               for (f = formals; f != NULL; f = f->next)
 761                 {
 762                   if (f->index == ind - 1)
 763                     {
 764                       if (f->actual.len != 0)
 765                         sb_add_sb (out, &f->actual);
 766                       else
 767                         sb_add_sb (out, &f->def);
 768                       break;
 769                     }
 770                 }
 771             }
 772           else
 773             {
 774               sb_reset (&t);
 775               src = sub_actual (src, in, &t, formal_hash, '\'', out, 0);
 776             }
 777         }
 778       else if ((macro_alternate || macro_mri)
 779                && (isalpha ((unsigned char) in->ptr[src])
 780                    || in->ptr[src] == '_'
 781                    || in->ptr[src] == '$')
 782                && (! inquote
 783                    || ! macro_strip_at
 784                    || (src > 0 && in->ptr[src - 1] == '@')))
 785         {
 786           if (! locals
 787               || src + 5 >= in->len
 788               || strncasecmp (in->ptr + src, "LOCAL", 5) != 0
 789               || ! ISWHITE (in->ptr[src + 5]))
 790             {
 791               sb_reset (&t);
 792               src = sub_actual (src, in, &t, formal_hash,
 793                                 (macro_strip_at && inquote) ? '@' : '\'',
 794                                 out, 1);
 795             }
 796           else
 797             {
 798               formal_entry *f;
 799
 800               src = sb_skip_white (src + 5, in);
 801               while (in->ptr[src] != '\n' && in->ptr[src] != comment_char)
 802                 {
 803                   static int loccnt;
 804                   char buf[20];
 805                   const char *err;
 806
 807                   f = (formal_entry *) xmalloc (sizeof (formal_entry));
 808                   sb_new (&f->name);
 809                   sb_new (&f->def);
 810                   sb_new (&f->actual);
 811                   f->index = LOCAL_INDEX;
 812                   f->next = loclist;
 813                   loclist = f;
 814
 815                   src = get_token (src, in, &f->name);
 816                   ++loccnt;
 817                   sprintf (buf, "LL%04x", loccnt);
 818                   sb_add_string (&f->actual, buf);
 819
 820                   err = hash_jam (formal_hash, sb_terminate (&f->name), f);
 821                   if (err != NULL)
 822                     return err;
 823
 824                   src = sb_skip_comma (src, in);
 825                 }
 826             }
 827         }
 828       else if (comment_char != '\0'
 829                && in->ptr[src] == comment_char
 830                && src + 1 < in->len
 831                && in->ptr[src + 1] == comment_char
 832                && !inquote)
 833         {
 834           /* Two comment chars in a row cause the rest of the line to
 835              be dropped.  */
 836           while (src < in->len && in->ptr[src] != '\n')
 837             src++;
 838         }
 839       else if (in->ptr[src] == '"'
 840                || (macro_mri && in->ptr[src] == '\''))
 841         {
 842           inquote = !inquote;
 843           sb_add_char (out, in->ptr[src++]);
 844         }
 845       else if (in->ptr[src] == '@' && macro_strip_at)
 846         {
 847           ++src;
 848           if (src < in->len
 849               && in->ptr[src] == '@')
 850             {
 851               sb_add_char (out, '@');
 852               ++src;
 853             }
 854         }
 855       else if (macro_mri
 856                && in->ptr[src] == '='
 857                && src + 1 < in->len
 858                && in->ptr[src + 1] == '=')
 859         {
 860           formal_entry *ptr;
 861
 862           sb_reset (&t);
 863           src = get_token (src + 2, in, &t);
 864           ptr = (formal_entry *) hash_find (formal_hash, sb_terminate (&t));
 865           if (ptr == NULL)
 866             {
 867               /* FIXME: We should really return a warning string here,
 868                  but we can't, because the == might be in the MRI
 869                  comment field, and, since the nature of the MRI
 870                  comment field depends upon the exact instruction
 871                  being used, we don't have enough information here to
 872                  figure out whether it is or not.  Instead, we leave
 873                  the == in place, which should cause a syntax error if
 874                  it is not in a comment.  */
 875               sb_add_char (out, '=');
 876               sb_add_char (out, '=');
 877               sb_add_sb (out, &t);
 878             }
 879           else
 880             {
 881               if (ptr->actual.len)
 882                 {
 883                   sb_add_string (out, "-1");
 884                 }
 885               else
 886                 {
 887                   sb_add_char (out, '0');
 888                 }
 889             }
 890         }
 891       else
 892         {
 893           sb_add_char (out, in->ptr[src++]);
 894         }
 895     }
 896
 897   sb_kill (&t);
 898
 899   while (loclist != NULL)
 900     {
 901       formal_entry *f;
 902
 903       f = loclist->next;
 904       hash_delete (formal_hash, sb_terminate (&loclist->name));
 905       sb_kill (&loclist->name);
 906       sb_kill (&loclist->def);
 907       sb_kill (&loclist->actual);
 908       free (loclist);
 909       loclist = f;
 910     }
 911
 912   return NULL;
 913 }
 914
 915 /* Assign values to the formal parameters of a macro, and expand the
 916    body.  */
 917
 918 static const char *
 919 macro_expand (idx, in, m, out, comment_char)
 920      int idx;
 921      sb *in;
 922      macro_entry *m;
 923      sb *out;
 924      int comment_char;
 925 {
 926   sb t;
 927   formal_entry *ptr;
 928   formal_entry *f;
 929   int is_positional = 0;
 930   int is_keyword = 0;
 931   int narg = 0;
 932   const char *err;
 933
 934   sb_new (&t);
 935
 936   /* Reset any old value the actuals may have */
 937   for (f = m->formals; f; f = f->next)
 938       sb_reset (&f->actual);
 939   f = m->formals;
 940   while (f != NULL && f->index < 0)
 941     f = f->next;
 942
 943   if (macro_mri)
 944     {
 945       /* The macro may be called with an optional qualifier, which may
 946          be referred to in the macro body as \0.  */
 947       if (idx < in->len && in->ptr[idx] == '.')
 948         {
 949           formal_entry *n;
 950
 951           n = (formal_entry *) xmalloc (sizeof (formal_entry));
 952           sb_new (&n->name);
 953           sb_new (&n->def);
 954           sb_new (&n->actual);
 955           n->index = QUAL_INDEX;
 956
 957           n->next = m->formals;
 958           m->formals = n;
 959
 960           idx = get_any_string (idx + 1, in, &n->actual, 1, 0);
 961         }
 962     }
 963
 964   /* Peel off the actuals and store them away in the hash tables' actuals */
 965   idx = sb_skip_white (idx, in);
 966   while (idx < in->len && in->ptr[idx] != comment_char)
 967     {
 968       int scan;
 969
 970       /* Look and see if it's a positional or keyword arg */
 971       scan = idx;
 972       while (scan < in->len
 973              && !ISSEP (in->ptr[scan])
 974              && !(macro_mri && in->ptr[scan] == '\'')
 975              && (!macro_alternate && in->ptr[scan] != '='))
 976         scan++;
 977       if (scan < in->len && !macro_alternate && in->ptr[scan] == '=')
 978         {
 979           is_keyword = 1;
 980           if (is_positional)
 981             return "can't mix positional and keyword arguments";
 982
 983           /* This is a keyword arg, fetch the formal name and
 984              then the actual stuff */
 985           sb_reset (&t);
 986           idx = get_token (idx, in, &t);
 987           if (in->ptr[idx] != '=')
 988             return "confusion in formal parameters";
 989
 990           /* Lookup the formal in the macro's list */
 991           ptr = (formal_entry *) hash_find (m->formal_hash, sb_terminate (&t));
 992           if (!ptr)
 993             return "macro formal argument does not exist";
 994           else
 995             {
 996               /* Insert this value into the right place */
 997               sb_reset (&ptr->actual);
 998               idx = get_any_string (idx + 1, in, &ptr->actual, 0, 0);
 999               if (ptr->actual.len > 0)
1000                 ++narg;
1001             }
1002         }
1003       else
1004         {
1005           /* This is a positional arg */
1006           is_positional = 1;
1007           if (is_keyword)
1008             return "can't mix positional and keyword arguments";
1009
1010           if (!f)
1011             {
1012               formal_entry **pf;
1013               int c;
1014
1015               if (!macro_mri)
1016                 return "too many positional arguments";
1017
1018               f = (formal_entry *) xmalloc (sizeof (formal_entry));
1019               sb_new (&f->name);
1020               sb_new (&f->def);
1021               sb_new (&f->actual);
1022               f->next = NULL;
1023
1024               c = -1;
1025               for (pf = &m->formals; *pf != NULL; pf = &(*pf)->next)
1026                 if ((*pf)->index >= c)
1027                   c = (*pf)->index + 1;
1028               if (c == -1)
1029                 c = 0;
1030               *pf = f;
1031               f->index = c;
1032             }
1033
1034           sb_reset (&f->actual);
1035           idx = get_any_string (idx, in, &f->actual, 1, 0);
1036           if (f->actual.len > 0)
1037             ++narg;
1038           do
1039             {
1040               f = f->next;
1041             }
1042           while (f != NULL && f->index < 0);
1043         }
1044
1045       if (! macro_mri)
1046         idx = sb_skip_comma (idx, in);
1047       else
1048         {
1049           if (in->ptr[idx] == ',')
1050             ++idx;
1051           if (ISWHITE (in->ptr[idx]))
1052             break;
1053         }
1054     }
1055
1056   if (macro_mri)
1057     {
1058       char buffer[20];
1059
1060       sb_reset (&t);
1061       sb_add_string (&t, macro_strip_at ? "$NARG" : "NARG");
1062       ptr = (formal_entry *) hash_find (m->formal_hash, sb_terminate (&t));
1063       sb_reset (&ptr->actual);
1064       sprintf (buffer, "%d", narg);
1065       sb_add_string (&ptr->actual, buffer);
1066     }
1067
1068   err = macro_expand_body (&m->sub, out, m->formals, m->formal_hash,
1069                            comment_char, 1);
1070   if (err != NULL)
1071     return err;
1072
1073   /* Discard any unnamed formal arguments.  */
1074   if (macro_mri)
1075     {
1076       formal_entry **pf;
1077
1078       pf = &m->formals;
1079       while (*pf != NULL)
1080         {
1081           if ((*pf)->name.len != 0)
1082             pf = &(*pf)->next;
1083           else
1084             {
1085               sb_kill (&(*pf)->name);
1086               sb_kill (&(*pf)->def);
1087               sb_kill (&(*pf)->actual);
1088               f = (*pf)->next;
1089               free (*pf);
1090               *pf = f;
1091             }
1092         }
1093     }
1094
1095   sb_kill (&t);
1096   macro_number++;
1097
1098   return NULL;
1099 }
1100
1101 /* Check for a macro.  If one is found, put the expansion into
1102    *EXPAND.  COMMENT_CHAR is the comment character--this is used by
1103    gasp.  Return 1 if a macro is found, 0 otherwise.  */
1104
1105 int
1106 check_macro (line, expand, comment_char, error)
1107      const char *line;
1108      sb *expand;
1109      int comment_char;
1110      const char **error;
1111 {
1112   const char *s;
1113   char *copy, *cs;
1114   macro_entry *macro;
1115   sb line_sb;
1116
1117   if (! isalpha ((unsigned char) *line)
1118       && *line != '_'
1119       && *line != '$'
1120       && (! macro_mri || *line != '.'))
1121     return 0;
1122
1123   s = line + 1;
1124   while (isalnum ((unsigned char) *s)
1125          || *s == '_'
1126          || *s == '$')
1127     ++s;
1128
1129   copy = (char *) alloca (s - line + 1);
1130   memcpy (copy, line, s - line);
1131   copy[s - line] = '\0';
1132   for (cs = copy; *cs != '\0'; cs++)
1133     if (isupper (*cs))
1134       *cs = tolower (*cs);
1135
1136   macro = (macro_entry *) hash_find (macro_hash, copy);
1137
1138   if (macro == NULL)
1139     return 0;
1140
1141   /* Wrap the line up in an sb.  */
1142   sb_new (&line_sb);
1143   while (*s != '\0' && *s != '\n' && *s != '\r')
1144     sb_add_char (&line_sb, *s++);
1145
1146   sb_new (expand);
1147   *error = macro_expand (0, &line_sb, macro, expand, comment_char);
1148
1149   sb_kill (&line_sb);
1150
1151   return 1;
1152 }
1153
1154 /* Delete a macro.  */
1155
1156 void
1157 delete_macro (name)
1158      const char *name;
1159 {
1160   hash_delete (macro_hash, name);
1161 }
1162
1163 /* Handle the MRI IRP and IRPC pseudo-ops.  These are handled as a
1164    combined macro definition and execution.  This returns NULL on
1165    success, or an error message otherwise.  */
1166
1167 const char *
1168 expand_irp (irpc, idx, in, out, get_line, comment_char)
1169      int irpc;
1170      int idx;
1171      sb *in;
1172      sb *out;
1173      int (*get_line) PARAMS ((sb *));
1174      int comment_char;
1175 {
1176   const char *mn;
1177   sb sub;
1178   formal_entry f;
1179   struct hash_control *h;
1180   const char *err;
1181
1182   if (irpc)
1183     mn = "IRPC";
1184   else
1185     mn = "IRP";
1186
1187   idx = sb_skip_white (idx, in);
1188
1189   sb_new (&sub);
1190   if (! buffer_and_nest (mn, "ENDR", &sub, get_line))
1191     return "unexpected end of file in irp or irpc";
1192
1193   sb_new (&f.name);
1194   sb_new (&f.def);
1195   sb_new (&f.actual);
1196
1197   idx = get_token (idx, in, &f.name);
1198   if (f.name.len == 0)
1199     return "missing model parameter";
1200
1201   h = hash_new ();
1202   err = hash_jam (h, sb_terminate (&f.name), &f);
1203   if (err != NULL)
1204     return err;
1205
1206   f.index = 1;
1207   f.next = NULL;
1208
1209   sb_reset (out);
1210
1211   idx = sb_skip_comma (idx, in);
1212   if (idx >= in->len || in->ptr[idx] == comment_char)
1213     {
1214       /* Expand once with a null string.  */
1215       err = macro_expand_body (&sub, out, &f, h, comment_char, 0);
1216       if (err != NULL)
1217         return err;
1218     }
1219   else
1220     {
1221       if (irpc && in->ptr[idx] == '"')
1222         ++idx;
1223       while (idx < in->len && in->ptr[idx] != comment_char)
1224         {
1225           if (!irpc)
1226             idx = get_any_string (idx, in, &f.actual, 1, 0);
1227           else
1228             {
1229               if (in->ptr[idx] == '"')
1230                 {
1231                   int nxt;
1232
1233                   nxt = sb_skip_white (idx + 1, in);
1234                   if (nxt >= in->len || in->ptr[nxt] == comment_char)
1235                     {
1236                       idx = nxt;
1237                       break;
1238                     }
1239                 }
1240               sb_reset (&f.actual);
1241               sb_add_char (&f.actual, in->ptr[idx]);
1242               ++idx;
1243             }
1244           err = macro_expand_body (&sub, out, &f, h, comment_char, 0);
1245           if (err != NULL)
1246             return err;
1247           if (!irpc)
1248             idx = sb_skip_comma (idx, in);
1249           else
1250             idx = sb_skip_white (idx, in);
1251         }
1252     }
1253
1254   hash_die (h);
1255   sb_kill (&sub);
1256
1257   return NULL;
1258 }