gas/macro.c

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