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