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