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