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