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 #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       hash_delete (formal_hash, sb_terminate (&loclist->name));
 906       sb_kill (&loclist->name);
 907       sb_kill (&loclist->def);
 908       sb_kill (&loclist->actual);
 909       free (loclist);
 910       loclist = f;
 911     }
 912
 913   return NULL;
 914 }
 915
 916 /* Assign values to the formal parameters of a macro, and expand the
 917    body.  */
 918
 919 static const char *
 920 macro_expand (idx, in, m, out, comment_char)
 921      int idx;
 922      sb *in;
 923      macro_entry *m;
 924      sb *out;
 925      int comment_char;
 926 {
 927   sb t;
 928   formal_entry *ptr;
 929   formal_entry *f;
 930   int is_positional = 0;
 931   int is_keyword = 0;
 932   int narg = 0;
 933   const char *err;
 934
 935   sb_new (&t);
 936
 937   /* Reset any old value the actuals may have */
 938   for (f = m->formals; f; f = f->next)
 939       sb_reset (&f->actual);
 940   f = m->formals;
 941   while (f != NULL && f->index < 0)
 942     f = f->next;
 943
 944   if (macro_mri)
 945     {
 946       /* The macro may be called with an optional qualifier, which may
 947          be referred to in the macro body as \0.  */
 948       if (idx < in->len && in->ptr[idx] == '.')
 949         {
 950           formal_entry *n;
 951
 952           n = (formal_entry *) xmalloc (sizeof (formal_entry));
 953           sb_new (&n->name);
 954           sb_new (&n->def);
 955           sb_new (&n->actual);
 956           n->index = QUAL_INDEX;
 957
 958           n->next = m->formals;
 959           m->formals = n;
 960
 961           idx = get_any_string (idx + 1, in, &n->actual, 1, 0);
 962         }
 963     }
 964
 965   /* Peel off the actuals and store them away in the hash tables' actuals */
 966   idx = sb_skip_white (idx, in);
 967   while (idx < in->len && in->ptr[idx] != comment_char)
 968     {
 969       int scan;
 970
 971       /* Look and see if it's a positional or keyword arg */
 972       scan = idx;
 973       while (scan < in->len
 974              && !ISSEP (in->ptr[scan])
 975              && !(macro_mri && in->ptr[scan] == '\'')
 976              && (!macro_alternate && in->ptr[scan] != '='))
 977         scan++;
 978       if (scan < in->len && !macro_alternate && in->ptr[scan] == '=')
 979         {
 980           is_keyword = 1;
 981
 982           /* It's OK to go from positional to keyword.  */
 983
 984           /* This is a keyword arg, fetch the formal name and
 985              then the actual stuff */
 986           sb_reset (&t);
 987           idx = get_token (idx, in, &t);
 988           if (in->ptr[idx] != '=')
 989             return _("confusion in formal parameters");
 990
 991           /* Lookup the formal in the macro's list */
 992           ptr = (formal_entry *) hash_find (m->formal_hash, sb_terminate (&t));
 993           if (!ptr)
 994             return _("macro formal argument does not exist");
 995           else
 996             {
 997               /* Insert this value into the right place */
 998               sb_reset (&ptr->actual);
 999               idx = get_any_string (idx + 1, in, &ptr->actual, 0, 0);
1000               if (ptr->actual.len > 0)
1001                 ++narg;
1002             }
1003         }
1004       else
1005         {
1006           /* This is a positional arg */
1007           is_positional = 1;
1008           if (is_keyword)
1009             return _("can't mix positional and keyword arguments");
1010
1011           if (!f)
1012             {
1013               formal_entry **pf;
1014               int c;
1015
1016               if (!macro_mri)
1017                 return _("too many positional arguments");
1018
1019               f = (formal_entry *) xmalloc (sizeof (formal_entry));
1020               sb_new (&f->name);
1021               sb_new (&f->def);
1022               sb_new (&f->actual);
1023               f->next = NULL;
1024
1025               c = -1;
1026               for (pf = &m->formals; *pf != NULL; pf = &(*pf)->next)
1027                 if ((*pf)->index >= c)
1028                   c = (*pf)->index + 1;
1029               if (c == -1)
1030                 c = 0;
1031               *pf = f;
1032               f->index = c;
1033             }
1034
1035           sb_reset (&f->actual);
1036           idx = get_any_string (idx, in, &f->actual, 1, 0);
1037           if (f->actual.len > 0)
1038             ++narg;
1039           do
1040             {
1041               f = f->next;
1042             }
1043           while (f != NULL && f->index < 0);
1044         }
1045
1046       if (! macro_mri)
1047         idx = sb_skip_comma (idx, in);
1048       else
1049         {
1050           if (in->ptr[idx] == ',')
1051             ++idx;
1052           if (ISWHITE (in->ptr[idx]))
1053             break;
1054         }
1055     }
1056
1057   if (macro_mri)
1058     {
1059       char buffer[20];
1060
1061       sb_reset (&t);
1062       sb_add_string (&t, macro_strip_at ? "$NARG" : "NARG");
1063       ptr = (formal_entry *) hash_find (m->formal_hash, sb_terminate (&t));
1064       sb_reset (&ptr->actual);
1065       sprintf (buffer, "%d", narg);
1066       sb_add_string (&ptr->actual, buffer);
1067     }
1068
1069   err = macro_expand_body (&m->sub, out, m->formals, m->formal_hash,
1070                            comment_char, 1);
1071   if (err != NULL)
1072     return err;
1073
1074   /* Discard any unnamed formal arguments.  */
1075   if (macro_mri)
1076     {
1077       formal_entry **pf;
1078
1079       pf = &m->formals;
1080       while (*pf != NULL)
1081         {
1082           if ((*pf)->name.len != 0)
1083             pf = &(*pf)->next;
1084           else
1085             {
1086               sb_kill (&(*pf)->name);
1087               sb_kill (&(*pf)->def);
1088               sb_kill (&(*pf)->actual);
1089               f = (*pf)->next;
1090               free (*pf);
1091               *pf = f;
1092             }
1093         }
1094     }
1095
1096   sb_kill (&t);
1097   macro_number++;
1098
1099   return NULL;
1100 }
1101
1102 /* Check for a macro.  If one is found, put the expansion into
1103    *EXPAND.  COMMENT_CHAR is the comment character--this is used by
1104    gasp.  Return 1 if a macro is found, 0 otherwise.  */
1105
1106 int
1107 check_macro (line, expand, comment_char, error)
1108      const char *line;
1109      sb *expand;
1110      int comment_char;
1111      const char **error;
1112 {
1113   const char *s;
1114   char *copy, *cs;
1115   macro_entry *macro;
1116   sb line_sb;
1117
1118   if (! isalpha ((unsigned char) *line)
1119       && *line != '_'
1120       && *line != '$'
1121       && (! macro_mri || *line != '.'))
1122     return 0;
1123
1124   s = line + 1;
1125   while (isalnum ((unsigned char) *s)
1126          || *s == '_'
1127          || *s == '$')
1128     ++s;
1129
1130   copy = (char *) alloca (s - line + 1);
1131   memcpy (copy, line, s - line);
1132   copy[s - line] = '\0';
1133   for (cs = copy; *cs != '\0'; cs++)
1134     if (isupper ((unsigned char) *cs))
1135       *cs = tolower (*cs);
1136
1137   macro = (macro_entry *) hash_find (macro_hash, copy);
1138
1139   if (macro == NULL)
1140     return 0;
1141
1142   /* Wrap the line up in an sb.  */
1143   sb_new (&line_sb);
1144   while (*s != '\0' && *s != '\n' && *s != '\r')
1145     sb_add_char (&line_sb, *s++);
1146
1147   sb_new (expand);
1148   *error = macro_expand (0, &line_sb, macro, expand, comment_char);
1149
1150   sb_kill (&line_sb);
1151
1152   return 1;
1153 }
1154
1155 /* Delete a macro.  */
1156
1157 void
1158 delete_macro (name)
1159      const char *name;
1160 {
1161   hash_delete (macro_hash, name);
1162 }
1163
1164 /* Handle the MRI IRP and IRPC pseudo-ops.  These are handled as a
1165    combined macro definition and execution.  This returns NULL on
1166    success, or an error message otherwise.  */
1167
1168 const char *
1169 expand_irp (irpc, idx, in, out, get_line, comment_char)
1170      int irpc;
1171      int idx;
1172      sb *in;
1173      sb *out;
1174      int (*get_line) PARAMS ((sb *));
1175      int comment_char;
1176 {
1177   const char *mn;
1178   sb sub;
1179   formal_entry f;
1180   struct hash_control *h;
1181   const char *err;
1182
1183   if (irpc)
1184     mn = "IRPC";
1185   else
1186     mn = "IRP";
1187
1188   idx = sb_skip_white (idx, in);
1189
1190   sb_new (&sub);
1191   if (! buffer_and_nest (mn, "ENDR", &sub, get_line))
1192     return _("unexpected end of file in irp or irpc");
1193
1194   sb_new (&f.name);
1195   sb_new (&f.def);
1196   sb_new (&f.actual);
1197
1198   idx = get_token (idx, in, &f.name);
1199   if (f.name.len == 0)
1200     return _("missing model parameter");
1201
1202   h = hash_new ();
1203   err = hash_jam (h, sb_terminate (&f.name), &f);
1204   if (err != NULL)
1205     return err;
1206
1207   f.index = 1;
1208   f.next = NULL;
1209
1210   sb_reset (out);
1211
1212   idx = sb_skip_comma (idx, in);
1213   if (idx >= in->len || in->ptr[idx] == comment_char)
1214     {
1215       /* Expand once with a null string.  */
1216       err = macro_expand_body (&sub, out, &f, h, comment_char, 0);
1217       if (err != NULL)
1218         return err;
1219     }
1220   else
1221     {
1222       if (irpc && in->ptr[idx] == '"')
1223         ++idx;
1224       while (idx < in->len && in->ptr[idx] != comment_char)
1225         {
1226           if (!irpc)
1227             idx = get_any_string (idx, in, &f.actual, 1, 0);
1228           else
1229             {
1230               if (in->ptr[idx] == '"')
1231                 {
1232                   int nxt;
1233
1234                   nxt = sb_skip_white (idx + 1, in);
1235                   if (nxt >= in->len || in->ptr[nxt] == comment_char)
1236                     {
1237                       idx = nxt;
1238                       break;
1239                     }
1240                 }
1241               sb_reset (&f.actual);
1242               sb_add_char (&f.actual, in->ptr[idx]);
1243               ++idx;
1244             }
1245           err = macro_expand_body (&sub, out, &f, h, comment_char, 0);
1246           if (err != NULL)
1247             return err;
1248           if (!irpc)
1249             idx = sb_skip_comma (idx, in);
1250           else
1251             idx = sb_skip_white (idx, in);
1252         }
1253     }
1254
1255   hash_die (h);
1256   sb_kill (&sub);
1257
1258   return NULL;
1259 }