gas/macro.c

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