gas/macro.c

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