gas/macro.c

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