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
 309           idx++;
 310
 311           while (idx < in->len)
 312             {
 313               if (in->ptr[idx-1] == '\\')
 314                 escaped ^= 1;
 315               else
 316                 escaped = 0;
 317
 318               if (macro_alternate && in->ptr[idx] == '!')
 319                 {
 320                   idx ++;
 321
 322                   sb_add_char (acc, in->ptr[idx]);
 323
 324                   idx ++;
 325                 }
 326               else if (escaped && in->ptr[idx] == tchar)
 327                 {
 328                   sb_add_char (acc, tchar);
 329                   idx ++;
 330                 }
 331               else
 332                 {
 333                   if (in->ptr[idx] == tchar)
 334                     {
 335                       idx ++;
 336
 337                       if (idx >= in->len || in->ptr[idx] != tchar)
 338                         break;
 339                     }
 340
 341                   sb_add_char (acc, in->ptr[idx]);
 342                   idx ++;
 343                 }
 344             }
 345         }
 346     }
 347
 348   return idx;
 349 }
 350
 351 /* Fetch string from the input stream,
 352    rules:
 353     'Bxyx<whitespace>   -> return 'Bxyza
 354     %<char>             -> return string of decimal value of x
 355     "<string>"          -> return string
 356     xyx<whitespace>     -> return xyz
 357 */
 358
 359 static int
 360 get_any_string (idx, in, out, expand, pretend_quoted)
 361      int idx;
 362      sb *in;
 363      sb *out;
 364      int expand;
 365      int pretend_quoted;
 366 {
 367   sb_reset (out);
 368   idx = sb_skip_white (idx, in);
 369
 370   if (idx < in->len)
 371     {
 372       if (in->len > 2 && in->ptr[idx+1] == '\'' && ISBASE (in->ptr[idx]))
 373         {
 374           while (!ISSEP (in->ptr[idx]))
 375             sb_add_char (out, in->ptr[idx++]);
 376         }
 377       else if (in->ptr[idx] == '%'
 378                && macro_alternate
 379                && expand)
 380         {
 381           int val;
 382           char buf[20];
 383           /* Turns the next expression into a string */
 384           idx = (*macro_expr) (_("% operator needs absolute expression"),
 385                                idx + 1,
 386                                in,
 387                                &val);
 388           sprintf(buf, "%d", val);
 389           sb_add_string (out, buf);
 390         }
 391       else if (in->ptr[idx] == '"'
 392                || (in->ptr[idx] == '<' && (macro_alternate || macro_mri))
 393                || (macro_alternate && in->ptr[idx] == '\''))
 394         {
 395           if (macro_alternate
 396               && ! macro_strip_at
 397               && expand)
 398             {
 399               /* Keep the quotes */
 400               sb_add_char (out,  '\"');
 401
 402               idx = getstring (idx, in, out);
 403               sb_add_char (out,  '\"');
 404             }
 405           else
 406             {
 407               idx = getstring (idx, in, out);
 408             }
 409         }
 410       else
 411         {
 412           while (idx < in->len
 413                  && (in->ptr[idx] == '"'
 414                      || in->ptr[idx] == '\''
 415                      || pretend_quoted
 416                      || (in->ptr[idx] != ' '
 417                          && in->ptr[idx] != '\t'
 418                          && in->ptr[idx] != ','
 419                          && (in->ptr[idx] != '<'
 420                              || (! macro_alternate && ! macro_mri)))))
 421             {
 422               if (in->ptr[idx] == '"'
 423                   || in->ptr[idx] == '\'')
 424                 {
 425                   char tchar = in->ptr[idx];
 426                   sb_add_char (out, in->ptr[idx++]);
 427                   while (idx < in->len
 428                          && in->ptr[idx] != tchar)
 429                     sb_add_char (out, in->ptr[idx++]);
 430                   if (idx == in->len)
 431                     return idx;
 432                 }
 433               sb_add_char (out, in->ptr[idx++]);
 434             }
 435         }
 436     }
 437
 438   return idx;
 439 }
 440
 441 /* Pick up the formal parameters of a macro definition.  */
 442
 443 static int
 444 do_formals (macro, idx, in)
 445      macro_entry *macro;
 446      int idx;
 447      sb *in;
 448 {
 449   formal_entry **p = &macro->formals;
 450
 451   macro->formal_count = 0;
 452   macro->formal_hash = hash_new ();
 453   while (idx < in->len)
 454     {
 455       formal_entry *formal;
 456
 457       formal = (formal_entry *) xmalloc (sizeof (formal_entry));
 458
 459       sb_new (&formal->name);
 460       sb_new (&formal->def);
 461       sb_new (&formal->actual);
 462
 463       idx = sb_skip_white (idx, in);
 464       idx = get_token (idx, in, &formal->name);
 465       if (formal->name.len == 0)
 466         break;
 467       idx = sb_skip_white (idx, in);
 468       if (formal->name.len)
 469         {
 470           /* This is a formal */
 471           if (idx < in->len && in->ptr[idx] == '=')
 472             {
 473               /* Got a default */
 474               idx = get_any_string (idx + 1, in, &formal->def, 1, 0);
 475             }
 476         }
 477
 478       /* Add to macro's hash table */
 479       hash_jam (macro->formal_hash, sb_terminate (&formal->name), formal);
 480
 481       formal->index = macro->formal_count;
 482       idx = sb_skip_comma (idx, in);
 483       macro->formal_count++;
 484       *p = formal;
 485       p = &formal->next;
 486       *p = NULL;
 487     }
 488
 489   if (macro_mri)
 490     {
 491       formal_entry *formal;
 492       const char *name;
 493
 494       /* Add a special NARG formal, which macro_expand will set to the
 495          number of arguments.  */
 496       formal = (formal_entry *) xmalloc (sizeof (formal_entry));
 497
 498       sb_new (&formal->name);
 499       sb_new (&formal->def);
 500       sb_new (&formal->actual);
 501
 502       /* The same MRI assemblers which treat '@' characters also use
 503          the name $NARG.  At least until we find an exception.  */
 504       if (macro_strip_at)
 505         name = "$NARG";
 506       else
 507         name = "NARG";
 508
 509       sb_add_string (&formal->name, name);
 510
 511       /* Add to macro's hash table */
 512       hash_jam (macro->formal_hash, name, formal);
 513
 514       formal->index = NARG_INDEX;
 515       *p = formal;
 516       formal->next = NULL;
 517     }
 518
 519   return idx;
 520 }
 521
 522 /* Define a new macro.  Returns NULL on success, otherwise returns an
 523    error message.  If NAMEP is not NULL, *NAMEP is set to the name of
 524    the macro which was defined.  */
 525
 526 const char *
 527 define_macro (idx, in, label, get_line, namep)
 528      int idx;
 529      sb *in;
 530      sb *label;
 531      int (*get_line) PARAMS ((sb *));
 532      const char **namep;
 533 {
 534   macro_entry *macro;
 535   sb name;
 536   const char *namestr;
 537
 538   macro = (macro_entry *) xmalloc (sizeof (macro_entry));
 539   sb_new (&macro->sub);
 540   sb_new (&name);
 541
 542   macro->formal_count = 0;
 543   macro->formals = 0;
 544
 545   idx = sb_skip_white (idx, in);
 546   if (! buffer_and_nest ("MACRO", "ENDM", &macro->sub, get_line))
 547     return _("unexpected end of file in macro definition");
 548   if (label != NULL && label->len != 0)
 549     {
 550       sb_add_sb (&name, label);
 551       if (idx < in->len && in->ptr[idx] == '(')
 552         {
 553           /* It's the label: MACRO (formals,...)  sort */
 554           idx = do_formals (macro, idx + 1, in);
 555           if (in->ptr[idx] != ')')
 556             return _("missing ) after formals");
 557         }
 558       else
 559         {
 560           /* It's the label: MACRO formals,...  sort */
 561           idx = do_formals (macro, idx, in);
 562         }
 563     }
 564   else
 565     {
 566       idx = get_token (idx, in, &name);
 567       idx = sb_skip_comma (idx, in);
 568       idx = do_formals (macro, idx, in);
 569     }
 570
 571   /* and stick it in the macro hash table */
 572   for (idx = 0; idx < name.len; idx++)
 573     if (isupper ((unsigned char) name.ptr[idx]))
 574       name.ptr[idx] = tolower (name.ptr[idx]);
 575   namestr = sb_terminate (&name);
 576   hash_jam (macro_hash, namestr, (PTR) macro);
 577
 578   macro_defined = 1;
 579
 580   if (namep != NULL)
 581     *namep = namestr;
 582
 583   return NULL;
 584 }
 585
 586 /* Scan a token, and then skip KIND.  */
 587
 588 static int
 589 get_apost_token (idx, in, name, kind)
 590      int idx;
 591      sb *in;
 592      sb *name;
 593      int kind;
 594 {
 595   idx = get_token (idx, in, name);
 596   if (idx < in->len
 597       && in->ptr[idx] == kind
 598       && (! macro_mri || macro_strip_at)
 599       && (! macro_strip_at || kind == '@'))
 600     idx++;
 601   return idx;
 602 }
 603
 604 /* Substitute the actual value for a formal parameter.  */
 605
 606 static int
 607 sub_actual (start, in, t, formal_hash, kind, out, copyifnotthere)
 608      int start;
 609      sb *in;
 610      sb *t;
 611      struct hash_control *formal_hash;
 612      int kind;
 613      sb *out;
 614      int copyifnotthere;
 615 {
 616   int src;
 617   formal_entry *ptr;
 618
 619   src = get_apost_token (start, in, t, kind);
 620   /* See if it's in the macro's hash table, unless this is
 621      macro_strip_at and kind is '@' and the token did not end in '@'.  */
 622   if (macro_strip_at
 623       && kind == '@'
 624       && (src == start || in->ptr[src - 1] != '@'))
 625     ptr = NULL;
 626   else
 627     ptr = (formal_entry *) hash_find (formal_hash, sb_terminate (t));
 628   if (ptr)
 629     {
 630       if (ptr->actual.len)
 631         {
 632           sb_add_sb (out, &ptr->actual);
 633         }
 634       else
 635         {
 636           sb_add_sb (out, &ptr->def);
 637         }
 638     }
 639   else if (kind == '&')
 640     {
 641       /* Doing this permits people to use & in macro bodies.  */
 642       sb_add_char (out, '&');
 643     }
 644   else if (copyifnotthere)
 645     {
 646       sb_add_sb (out, t);
 647     }
 648   else
 649     {
 650       sb_add_char (out, '\\');
 651       sb_add_sb (out, t);
 652     }
 653   return src;
 654 }
 655
 656 /* Expand the body of a macro.  */
 657
 658 static const char *
 659 macro_expand_body (in, out, formals, formal_hash, comment_char, locals)
 660      sb *in;
 661      sb *out;
 662      formal_entry *formals;
 663      struct hash_control *formal_hash;
 664      int comment_char;
 665      int locals;
 666 {
 667   sb t;
 668   int src = 0;
 669   int inquote = 0;
 670   formal_entry *loclist = NULL;
 671
 672   sb_new (&t);
 673
 674   while (src < in->len)
 675     {
 676       if (in->ptr[src] == '&')
 677         {
 678           sb_reset (&t);
 679           if (macro_mri)
 680             {
 681               if (src + 1 < in->len && in->ptr[src + 1] == '&')
 682                 src = sub_actual (src + 2, in, &t, formal_hash, '\'', out, 1);
 683               else
 684                 sb_add_char (out, in->ptr[src++]);
 685             }
 686           else
 687             {
 688               /* FIXME: Why do we do this?  */
 689               src = sub_actual (src + 1, in, &t, formal_hash, '&', out, 0);
 690             }
 691         }
 692       else if (in->ptr[src] == '\\')
 693         {
 694           src++;
 695           if (in->ptr[src] == comment_char && comment_char != '\0')
 696             {
 697               /* This is a comment, just drop the rest of the line */
 698               while (src < in->len
 699                      && in->ptr[src] != '\n')
 700                 src++;
 701             }
 702           else if (in->ptr[src] == '(')
 703             {
 704               /* Sub in till the next ')' literally */
 705               src++;
 706               while (src < in->len && in->ptr[src] != ')')
 707                 {
 708                   sb_add_char (out, in->ptr[src++]);
 709                 }
 710               if (in->ptr[src] == ')')
 711                 src++;
 712               else
 713                 return _("missplaced )");
 714             }
 715           else if (in->ptr[src] == '@')
 716             {
 717               /* Sub in the macro invocation number */
 718
 719               char buffer[10];
 720               src++;
 721               sprintf (buffer, "%d", macro_number);
 722               sb_add_string (out, buffer);
 723             }
 724           else if (in->ptr[src] == '&')
 725             {
 726               /* This is a preprocessor variable name, we don't do them
 727                  here */
 728               sb_add_char (out, '\\');
 729               sb_add_char (out, '&');
 730               src++;
 731             }
 732           else if (macro_mri
 733                    && isalnum ((unsigned char) in->ptr[src]))
 734             {
 735               int ind;
 736               formal_entry *f;
 737
 738               if (isdigit ((unsigned char) in->ptr[src]))
 739                 ind = in->ptr[src] - '0';
 740               else if (isupper ((unsigned char) in->ptr[src]))
 741                 ind = in->ptr[src] - 'A' + 10;
 742               else
 743                 ind = in->ptr[src] - 'a' + 10;
 744               ++src;
 745               for (f = formals; f != NULL; f = f->next)
 746                 {
 747                   if (f->index == ind - 1)
 748                     {
 749                       if (f->actual.len != 0)
 750                         sb_add_sb (out, &f->actual);
 751                       else
 752                         sb_add_sb (out, &f->def);
 753                       break;
 754                     }
 755                 }
 756             }
 757           else
 758             {
 759               sb_reset (&t);
 760               src = sub_actual (src, in, &t, formal_hash, '\'', out, 0);
 761             }
 762         }
 763       else if ((macro_alternate || macro_mri)
 764                && (isalpha ((unsigned char) in->ptr[src])
 765                    || in->ptr[src] == '_'
 766                    || in->ptr[src] == '$')
 767                && (! inquote
 768                    || ! macro_strip_at
 769                    || (src > 0 && in->ptr[src - 1] == '@')))
 770         {
 771           if (! locals
 772               || src + 5 >= in->len
 773               || strncasecmp (in->ptr + src, "LOCAL", 5) != 0
 774               || ! ISWHITE (in->ptr[src + 5]))
 775             {
 776               sb_reset (&t);
 777               src = sub_actual (src, in, &t, formal_hash,
 778                                 (macro_strip_at && inquote) ? '@' : '\'',
 779                                 out, 1);
 780             }
 781           else
 782             {
 783               formal_entry *f;
 784
 785               src = sb_skip_white (src + 5, in);
 786               while (in->ptr[src] != '\n' && in->ptr[src] != comment_char)
 787                 {
 788                   static int loccnt;
 789                   char buf[20];
 790                   const char *err;
 791
 792                   f = (formal_entry *) xmalloc (sizeof (formal_entry));
 793                   sb_new (&f->name);
 794                   sb_new (&f->def);
 795                   sb_new (&f->actual);
 796                   f->index = LOCAL_INDEX;
 797                   f->next = loclist;
 798                   loclist = f;
 799
 800                   src = get_token (src, in, &f->name);
 801                   ++loccnt;
 802                   sprintf (buf, "LL%04x", loccnt);
 803                   sb_add_string (&f->actual, buf);
 804
 805                   err = hash_jam (formal_hash, sb_terminate (&f->name), f);
 806                   if (err != NULL)
 807                     return err;
 808
 809                   src = sb_skip_comma (src, in);
 810                 }
 811             }
 812         }
 813       else if (comment_char != '\0'
 814                && in->ptr[src] == comment_char
 815                && src + 1 < in->len
 816                && in->ptr[src + 1] == comment_char
 817                && !inquote)
 818         {
 819           /* Two comment chars in a row cause the rest of the line to
 820              be dropped.  */
 821           while (src < in->len && in->ptr[src] != '\n')
 822             src++;
 823         }
 824       else if (in->ptr[src] == '"'
 825                || (macro_mri && in->ptr[src] == '\''))
 826         {
 827           inquote = !inquote;
 828           sb_add_char (out, in->ptr[src++]);
 829         }
 830       else if (in->ptr[src] == '@' && macro_strip_at)
 831         {
 832           ++src;
 833           if (src < in->len
 834               && in->ptr[src] == '@')
 835             {
 836               sb_add_char (out, '@');
 837               ++src;
 838             }
 839         }
 840       else if (macro_mri
 841                && in->ptr[src] == '='
 842                && src + 1 < in->len
 843                && in->ptr[src + 1] == '=')
 844         {
 845           formal_entry *ptr;
 846
 847           sb_reset (&t);
 848           src = get_token (src + 2, in, &t);
 849           ptr = (formal_entry *) hash_find (formal_hash, sb_terminate (&t));
 850           if (ptr == NULL)
 851             {
 852               /* FIXME: We should really return a warning string here,
 853                  but we can't, because the == might be in the MRI
 854                  comment field, and, since the nature of the MRI
 855                  comment field depends upon the exact instruction
 856                  being used, we don't have enough information here to
 857                  figure out whether it is or not.  Instead, we leave
 858                  the == in place, which should cause a syntax error if
 859                  it is not in a comment.  */
 860               sb_add_char (out, '=');
 861               sb_add_char (out, '=');
 862               sb_add_sb (out, &t);
 863             }
 864           else
 865             {
 866               if (ptr->actual.len)
 867                 {
 868                   sb_add_string (out, "-1");
 869                 }
 870               else
 871                 {
 872                   sb_add_char (out, '0');
 873                 }
 874             }
 875         }
 876       else
 877         {
 878           sb_add_char (out, in->ptr[src++]);
 879         }
 880     }
 881
 882   sb_kill (&t);
 883
 884   while (loclist != NULL)
 885     {
 886       formal_entry *f;
 887
 888       f = loclist->next;
 889       /* Setting the value to NULL effectively deletes the entry.  We
 890          avoid calling hash_delete because it doesn't reclaim memory.  */
 891       hash_jam (formal_hash, sb_terminate (&loclist->name), NULL);
 892       sb_kill (&loclist->name);
 893       sb_kill (&loclist->def);
 894       sb_kill (&loclist->actual);
 895       free (loclist);
 896       loclist = f;
 897     }
 898
 899   return NULL;
 900 }
 901
 902 /* Assign values to the formal parameters of a macro, and expand the
 903    body.  */
 904
 905 static const char *
 906 macro_expand (idx, in, m, out, comment_char)
 907      int idx;
 908      sb *in;
 909      macro_entry *m;
 910      sb *out;
 911      int comment_char;
 912 {
 913   sb t;
 914   formal_entry *ptr;
 915   formal_entry *f;
 916   int is_positional = 0;
 917   int is_keyword = 0;
 918   int narg = 0;
 919   const char *err;
 920
 921   sb_new (&t);
 922
 923   /* Reset any old value the actuals may have */
 924   for (f = m->formals; f; f = f->next)
 925       sb_reset (&f->actual);
 926   f = m->formals;
 927   while (f != NULL && f->index < 0)
 928     f = f->next;
 929
 930   if (macro_mri)
 931     {
 932       /* The macro may be called with an optional qualifier, which may
 933          be referred to in the macro body as \0.  */
 934       if (idx < in->len && in->ptr[idx] == '.')
 935         {
 936           formal_entry *n;
 937
 938           n = (formal_entry *) xmalloc (sizeof (formal_entry));
 939           sb_new (&n->name);
 940           sb_new (&n->def);
 941           sb_new (&n->actual);
 942           n->index = QUAL_INDEX;
 943
 944           n->next = m->formals;
 945           m->formals = n;
 946
 947           idx = get_any_string (idx + 1, in, &n->actual, 1, 0);
 948         }
 949     }
 950
 951   /* Peel off the actuals and store them away in the hash tables' actuals */
 952   idx = sb_skip_white (idx, in);
 953   while (idx < in->len && in->ptr[idx] != comment_char)
 954     {
 955       int scan;
 956
 957       /* Look and see if it's a positional or keyword arg */
 958       scan = idx;
 959       while (scan < in->len
 960              && !ISSEP (in->ptr[scan])
 961              && !(macro_mri && in->ptr[scan] == '\'')
 962              && (!macro_alternate && in->ptr[scan] != '='))
 963         scan++;
 964       if (scan < in->len && !macro_alternate && in->ptr[scan] == '=')
 965         {
 966           is_keyword = 1;
 967
 968           /* It's OK to go from positional to keyword.  */
 969
 970           /* This is a keyword arg, fetch the formal name and
 971              then the actual stuff */
 972           sb_reset (&t);
 973           idx = get_token (idx, in, &t);
 974           if (in->ptr[idx] != '=')
 975             return _("confusion in formal parameters");
 976
 977           /* Lookup the formal in the macro's list */
 978           ptr = (formal_entry *) hash_find (m->formal_hash, sb_terminate (&t));
 979           if (!ptr)
 980             return _("macro formal argument does not exist");
 981           else
 982             {
 983               /* Insert this value into the right place */
 984               sb_reset (&ptr->actual);
 985               idx = get_any_string (idx + 1, in, &ptr->actual, 0, 0);
 986               if (ptr->actual.len > 0)
 987                 ++narg;
 988             }
 989         }
 990       else
 991         {
 992           /* This is a positional arg */
 993           is_positional = 1;
 994           if (is_keyword)
 995             return _("can't mix positional and keyword arguments");
 996
 997           if (!f)
 998             {
 999               formal_entry **pf;
1000               int c;
1001
1002               if (!macro_mri)
1003                 return _("too many positional arguments");
1004
1005               f = (formal_entry *) xmalloc (sizeof (formal_entry));
1006               sb_new (&f->name);
1007               sb_new (&f->def);
1008               sb_new (&f->actual);
1009               f->next = NULL;
1010
1011               c = -1;
1012               for (pf = &m->formals; *pf != NULL; pf = &(*pf)->next)
1013                 if ((*pf)->index >= c)
1014                   c = (*pf)->index + 1;
1015               if (c == -1)
1016                 c = 0;
1017               *pf = f;
1018               f->index = c;
1019             }
1020
1021           sb_reset (&f->actual);
1022           idx = get_any_string (idx, in, &f->actual, 1, 0);
1023           if (f->actual.len > 0)
1024             ++narg;
1025           do
1026             {
1027               f = f->next;
1028             }
1029           while (f != NULL && f->index < 0);
1030         }
1031
1032       if (! macro_mri)
1033         idx = sb_skip_comma (idx, in);
1034       else
1035         {
1036           if (in->ptr[idx] == ',')
1037             ++idx;
1038           if (ISWHITE (in->ptr[idx]))
1039             break;
1040         }
1041     }
1042
1043   if (macro_mri)
1044     {
1045       char buffer[20];
1046
1047       sb_reset (&t);
1048       sb_add_string (&t, macro_strip_at ? "$NARG" : "NARG");
1049       ptr = (formal_entry *) hash_find (m->formal_hash, sb_terminate (&t));
1050       sb_reset (&ptr->actual);
1051       sprintf (buffer, "%d", narg);
1052       sb_add_string (&ptr->actual, buffer);
1053     }
1054
1055   err = macro_expand_body (&m->sub, out, m->formals, m->formal_hash,
1056                            comment_char, 1);
1057   if (err != NULL)
1058     return err;
1059
1060   /* Discard any unnamed formal arguments.  */
1061   if (macro_mri)
1062     {
1063       formal_entry **pf;
1064
1065       pf = &m->formals;
1066       while (*pf != NULL)
1067         {
1068           if ((*pf)->name.len != 0)
1069             pf = &(*pf)->next;
1070           else
1071             {
1072               sb_kill (&(*pf)->name);
1073               sb_kill (&(*pf)->def);
1074               sb_kill (&(*pf)->actual);
1075               f = (*pf)->next;
1076               free (*pf);
1077               *pf = f;
1078             }
1079         }
1080     }
1081
1082   sb_kill (&t);
1083   macro_number++;
1084
1085   return NULL;
1086 }
1087
1088 /* Check for a macro.  If one is found, put the expansion into
1089    *EXPAND.  COMMENT_CHAR is the comment character--this is used by
1090    gasp.  Return 1 if a macro is found, 0 otherwise.  */
1091
1092 int
1093 check_macro (line, expand, comment_char, error, info)
1094      const char *line;
1095      sb *expand;
1096      int comment_char;
1097      const char **error;
1098      macro_entry **info;
1099 {
1100   const char *s;
1101   char *copy, *cs;
1102   macro_entry *macro;
1103   sb line_sb;
1104
1105   if (! isalpha ((unsigned char) *line)
1106       && *line != '_'
1107       && *line != '$'
1108       && (! macro_mri || *line != '.'))
1109     return 0;
1110
1111   s = line + 1;
1112   while (isalnum ((unsigned char) *s)
1113          || *s == '_'
1114          || *s == '$')
1115     ++s;
1116
1117   copy = (char *) alloca (s - line + 1);
1118   memcpy (copy, line, s - line);
1119   copy[s - line] = '\0';
1120   for (cs = copy; *cs != '\0'; cs++)
1121     if (isupper ((unsigned char) *cs))
1122       *cs = tolower (*cs);
1123
1124   macro = (macro_entry *) hash_find (macro_hash, copy);
1125
1126   if (macro == NULL)
1127     return 0;
1128
1129   /* Wrap the line up in an sb.  */
1130   sb_new (&line_sb);
1131   while (*s != '\0' && *s != '\n' && *s != '\r')
1132     sb_add_char (&line_sb, *s++);
1133
1134   sb_new (expand);
1135   *error = macro_expand (0, &line_sb, macro, expand, comment_char);
1136
1137   sb_kill (&line_sb);
1138
1139   /* export the macro information if requested */
1140   if (info)
1141     *info = macro;
1142
1143   return 1;
1144 }
1145
1146 /* Delete a macro.  */
1147
1148 void
1149 delete_macro (name)
1150      const char *name;
1151 {
1152   hash_delete (macro_hash, name);
1153 }
1154
1155 /* Handle the MRI IRP and IRPC pseudo-ops.  These are handled as a
1156    combined macro definition and execution.  This returns NULL on
1157    success, or an error message otherwise.  */
1158
1159 const char *
1160 expand_irp (irpc, idx, in, out, get_line, comment_char)
1161      int irpc;
1162      int idx;
1163      sb *in;
1164      sb *out;
1165      int (*get_line) PARAMS ((sb *));
1166      int comment_char;
1167 {
1168   const char *mn;
1169   sb sub;
1170   formal_entry f;
1171   struct hash_control *h;
1172   const char *err;
1173
1174   if (irpc)
1175     mn = "IRPC";
1176   else
1177     mn = "IRP";
1178
1179   idx = sb_skip_white (idx, in);
1180
1181   sb_new (&sub);
1182   if (! buffer_and_nest (mn, "ENDR", &sub, get_line))
1183     return _("unexpected end of file in irp or irpc");
1184
1185   sb_new (&f.name);
1186   sb_new (&f.def);
1187   sb_new (&f.actual);
1188
1189   idx = get_token (idx, in, &f.name);
1190   if (f.name.len == 0)
1191     return _("missing model parameter");
1192
1193   h = hash_new ();
1194   err = hash_jam (h, sb_terminate (&f.name), &f);
1195   if (err != NULL)
1196     return err;
1197
1198   f.index = 1;
1199   f.next = NULL;
1200
1201   sb_reset (out);
1202
1203   idx = sb_skip_comma (idx, in);
1204   if (idx >= in->len || in->ptr[idx] == comment_char)
1205     {
1206       /* Expand once with a null string.  */
1207       err = macro_expand_body (&sub, out, &f, h, comment_char, 0);
1208       if (err != NULL)
1209         return err;
1210     }
1211   else
1212     {
1213       if (irpc && in->ptr[idx] == '"')
1214         ++idx;
1215       while (idx < in->len && in->ptr[idx] != comment_char)
1216         {
1217           if (!irpc)
1218             idx = get_any_string (idx, in, &f.actual, 1, 0);
1219           else
1220             {
1221               if (in->ptr[idx] == '"')
1222                 {
1223                   int nxt;
1224
1225                   nxt = sb_skip_white (idx + 1, in);
1226                   if (nxt >= in->len || in->ptr[nxt] == comment_char)
1227                     {
1228                       idx = nxt;
1229                       break;
1230                     }
1231                 }
1232               sb_reset (&f.actual);
1233               sb_add_char (&f.actual, in->ptr[idx]);
1234               ++idx;
1235             }
1236           err = macro_expand_body (&sub, out, &f, h, comment_char, 0);
1237           if (err != NULL)
1238             return err;
1239           if (!irpc)
1240             idx = sb_skip_comma (idx, in);
1241           else
1242             idx = sb_skip_white (idx, in);
1243         }
1244     }
1245
1246   hash_die (h);
1247   sb_kill (&sub);
1248
1249   return NULL;
1250 }