gas/macro.c

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