/* Micro-C Preprocessor Part */ 

/************************************************************************
** Copyright (C) 2006 Shinji Kono
** 連絡先： 琉球大学情報工学科 河野 真治  
** （E-Mail Address: kono@ie.u-ryukyu.ac.jp）
**
**    このソースのいかなる複写，改変，修正も許諾します。ただし、
**    その際には、誰が貢献したを示すこの部分を残すこと。
**    再配布や雑誌の付録などの問い合わせも必要ありません。
**    営利利用も上記に反しない範囲で許可します。
**    バイナリの配布の際にはversion messageを保存することを条件とします。
**    このプログラムについては特に何の保証もしない、悪しからず。
**
**    Everyone is permitted to do anything on this program 
**    including copying, modifying, improving,
**    as long as you don't try to pretend that you wrote it.
**    i.e., the above copyright notice has to appear in all copies.  
**    Binary distribution requires original version messages.
**    You don't have to ask before copying, redistribution or publishing.
**    THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE.
***********************************************************************/
#include <stdio.h>
#include "mc.h"
#include "mc-parse.h"
#include "mc-macro.h"
#include "mc-codegen.h"
#include "mc-code.h"
#include "mc-inline.h"

extern struct {int fd,ln;char *name0;int inc;FILE *fcb;} *filep,filestack[FILES];

int in_macro_if = 0;
char *chinput;
int macro_history = 0;
int macro_history_save = 0;

static int mconcat=0;

static void macro_define0();
static int macro_args(char **pchptr);
static int macro_function(int macrop,char **pchptr,NMTBL *nptr,int history);
static void local_define(char *macro,char *value);
static int macro_eval(int macrop,char *body0,int history,int local_only);
static char * mappend0(int lists,char **result);
static int macro_processing();

/*
    nptr->dsp
        list3s(MACRO,arg,char*)

    list3s(STRING,next,char*)
 */

/*

macro_expansion(NMTBL *nptrm)
    innput macro term (and chptr for arguments)
    result put into cheap, and chptr is set.
    current ch and  chptr are pushed into chptr stack.

    ## concatenation requires repeated replace.

    In macro_function and macro_eavl,
    expand result is put into macrop local variable.
        list3s(STRING,next,char*)
    to generate result, mappend/reverse0 is necessary.
    
 */

void
macro_expansion(NMTBL *nptrm)
{
    int i = mode;
    int macrop = 0;
    int slfree = lfree;
    int c;
    char *macropp,*s,*t;
    struct cheap scheap;
    mode = STAT;

    save_cheap(&scheap,cheap);
    // save recursive macro list
    macro_history_save = glist2(macro_history,macro_history_save);

    // call macro evaluation interpreter
    if (nptrm->sc == FMACRO) {
        macrop=macro_function(macrop,&chptr,nptrm,macro_history);
    } else {
        macrop=macro_eval(macrop,scaddr(nptrm->dsp),macro_history,0);
    }

    // copy output from resulted listed string

    cheap = reset_cheap(&scheap);
    macropp = cheap->ptr;
    // append result override, working cheap, but it's OK.
    mappend0(reverse0(macrop),&macropp);
    // cheap->ptr[-1] ='\n';  // makes some tokenize happy
    //         ## macro_result needs \n at end
    cheap->ptr[-1] = 0;  // makes some tokenize happy
    t = cheap->ptr-2;
    cheap->ptr[0] =0;
    cheap = increment_cheap(cheap,&macropp);

    // if we have ## (concatenation), 
    // remove \s**##\s*
    //  it is difficult to remove former space on the fly,
    //  so multi path loop is required
    int before=0;
    while (mconcat) {
        // ## re-eval macro
        if (lsrc) { printf("## before %s\n",macropp); before=1; }
        mconcat = 0;
        macrop = 0;
        for(s=t=macropp;*s;) {
            if ((c=*s++)=='#'&&*s=='#') {
                if (t>s-3) t=s-2; else t--;
                while(*t<=' '&&t>macropp) t--; t++;
                for(s++;*s && *s<=' ';) s++;
                continue;
            } else if (c==STRING) {
                c = '"';
            }
            *t++=c;
        }
        *t++=0;
#if 0
        if (1 && lsrc) {
           printf("\n### %s\n",macropp);
           if (t[-2]!='\n') putchar('\n');
        }
#endif
        while (macro_history!=0) {
            int i = cadr(macro_history); free_glist2(macro_history); macro_history = i;
        }
        macro_history = car(macro_history_save);
        // evaluate generated result again
        macrop=macro_eval(macrop,macropp,macro_history,0);
        cheap = reset_cheap(&scheap);
        macropp = cheap->ptr;
        // will not override evaled list
        mappend0(reverse0(macrop),&macropp);
        // cheap->ptr[-1] ='\n';
        cheap->ptr[-1] =0;
        cheap->ptr[0] =0;
        cheap = increment_cheap(cheap,&macropp);
    }

    cheap = reset_cheap(&scheap);
    // genrated macro will be overwrited by cheap, but it's OK, again
    if (before && lsrc) printf("## after %s\n",macropp);
    mconcat = 0;
    set_lfree(slfree);
#if 0
     if (lsrc && !asmf && nptrm->sc==FMACRO) {
        gen_comment(macropp);
        if (0 && t[-2]!='\n') putchar('\n');
     }
#endif
    // push previous chptr, and change it to the generate macro
    chptrsave = glist3s(STRING,chptrsave,chptr); // push old one into the stack
    chsave = glist2(ch,chsave);
    chptr = macropp;
    ch = *chptr++;
    mode = i;
}

/* file inclusion */

/*
    file name concatenation
        on cheap
 */

static char *
expand_file_name(char *path,char *name)
{
    char *p = cheap->ptr;
    if (! *path) return name;
    while(( *cheap->ptr = *path++ )) cheap = increment_cheap(cheap,&p);
    if (cheap->ptr[-1]!='/') {
        *cheap->ptr = '/'; cheap = increment_cheap(cheap,&p);
    }
    while(( *cheap->ptr = *name++ )) cheap = increment_cheap(cheap,&p);
    *cheap->ptr = 0;
    cheap = increment_cheap(cheap,&p);
    return p;
}

/*
   internal string compare routine
      nameeq in mc-parse.c relies on 
      global name variable
 */

static int
nameeq(char *p, char *q)
{
    if (!p)
        return 0;
    while(*p)
            if(*p++ != *q++) return 0;
    return (*q==0);
}

/*
    file name expansion

    Get file name from input stream.
    Result is store in filep structure.
       included file is put on the filep stack
       return filep

    filename is copied into cheap

    possibly expanded by search path (including current
    directory ). 
    
      get file name
            <name> =>   name
                        current_file_name_dir / name
                        libdir / name
            "name" =>   name
                        current_file_name_dir / name
                        include_path / name
            (no difference?)
      next flag ignores the first occurence.
 */


static FILE *
getfname(int next)
{
    int i,end='"',err=0;
    char *s,*p,**pp,*name,*prev=0;
    FILE *fp;
    struct cheap scheap;
    name = cheap->ptr;

    getch();
    if(skipspc()=='"') { end = '"';
    } else if (ch=='<') { end = '>';
    } else { error(INCERR); err=1; 
    }
    for(i=0;(getch()!=end && ch!='\n');) {
        *cheap->ptr = ch;
        cheap = increment_cheap(cheap,&name);
    }
    if(ch=='\n') error(INCERR);
    if (err) return filep->fcb;
    *cheap->ptr = 0;
    cheap = increment_cheap(cheap,&name);
    save_cheap(&scheap,cheap);
    fp = fopen(name,"r") ;
    if (next && fp) { fclose(fp); fp=0; next=0; prev=name; }
    p = name;
    if (!fp) {
        // no deferenced on "" and <>?
        for(pp=include_path; *pp;pp++) {
            p = expand_file_name(*pp,name);
            if(prev && nameeq(p,prev)) continue;
            if ((fp = fopen(p,"r"))) {
                if (next) {
                    fclose(fp); fp=0; next=0; prev=p;
                    continue;
                } else
                    break ;
            }
        }
        if (!fp /* && (end=='>'||filep->inc=='>') */ ) {  // <> case only
            for(pp=l_include_path; *pp;pp++) {
                p = expand_file_name(*pp,name);
                if(prev && nameeq(p,prev)) continue;
                if ((fp = fopen(p,"r"))) {
                    if (next) {
                        fclose(fp); fp=0; next=0; prev=p;
                        continue;
                    } else
                        break ;
                }
            }
        }
    }
    if(!fp) { error(FILERR); return filep->fcb; }
    //  we have so search current directory of the included file
    //  keep track the name
    copy_current_file_dir(s=p);
    //  File name determined. Dispose extra copies.
    cheap = reset_cheap(&scheap);
    //  Generated name needs copy.
    if (p!=name) {
        name = cheap->ptr;
        while((*cheap->ptr = *s++)) cheap = increment_cheap(cheap,&name);
        *cheap->ptr = 0;
        cheap = increment_cheap(cheap,&name);
    }
    // should check filep over flow (sigh...)
    (filep+1)->inc = end;
    (filep+1)->name0 = name;
    if (lsrc) { printf("## file %s\n", name); }
    return ( (filep+1)->fcb = fp );
}

/* line input and conversion */

static int macro_if_depth ;
static int macro_if_current ;
static int macro_if_skip ;

/* there may extra non-terminate comment after #if/#else directive */
/*      #endif / * hoge                                            */
/*           */
/*                                                                 */

static int
skip_rest_of_line()
{
    getch();
    do {
        while(ch!='\n'&&ch!='\r') {
            if (!in_comment) {
                if (ch=='/') {
                    getch();
                    if (ch=='/') in_comment=2;
                    else if (ch=='*') {
                        in_comment=1;
                    } else continue;
                }
            } else if (ch=='*') {
                getch();
                if (ch=='/') {
                    in_comment=0; 
                    return macro_if_skip?0:1;
                }
                else continue;
            }
            getch();
        }
        if (in_comment==1) { getline1(); getch(); }
    } while(in_comment==1);
    in_comment=0;
    return 0;
}

/*
     getline1 from chptr or chinput (for internal source)
        with macro processing 
        generate comment
        generate ST_COMMENT parse tree, in inline mode
    In getch, if chptr is empty, pop chptr stack, if stack is empy
    read from fp.
 */

static int next_eof;
struct cheap *st_cheap, *cheap1;
//   ST_COMMENT may interfere with other inrement_cheap, so we use
//   another cheap area.

extern void
getline1(void)
{
    int i;
    int c = 0;
    char num[10]; // for 32bit
    char *p;

    if (next_eof) {
        next_eof=0;
        error(EOFERR);
    }
    do {
        if (chinput) {
            //  some another input source ( init string )
            if (! *chinput) {
                chinput=0;
                continue;
            }
            chptr=linebuf;
            i=0;
            while((*chptr++=c=*chinput++)&&(c!='\n')) {
                if (++i > LBUFSIZE-2) error(LNERR);
            }
        } else {
            // get the line from input stream
            lineno++;
            glineno++;
            chptr=linebuf;
            i=0;
            while ((*chptr++ = c = getc(filep->fcb)) != '\n') {
                if (++i > LBUFSIZE-2) error(LNERR);
                if (c=='\r') {
                    c = getc(filep->fcb);
                    if (c == '\n') {
                        chptr[-1]='\n'; break;
                    } else {
                        // single cr equal to nl
                        ungetc(c,filep->fcb);
                        chptr[-1]=c='\n'; i--; break;
                    }
                }
                if (c==EOF) {
                    next_eof=1;
                    --chptr;
                    break;
                }
            }
        }

        *chptr = '\0';
        if (lsrc && !asmf && !macro_if_skip && linebuf[0]) {
            if (!inmode)
                gen_comment(linebuf);  // #if ed line will not be commented
            if (inmode) {
                // inline mode 

                // generate inlined line in assembler output

                int i=0;
                int c;
                // should be done in some init
                if (!st_cheap) {
                    st_cheap = cheap1 = new_cheap();
                }

                p = st_cheap->ptr;
                sprintf(num,"%d: ",lineno);
                parse = list4n(ST_COMMENT,parse,lineno,(NMTBL*)p);
                // should contain file name
                c = 0;
                while((*st_cheap->ptr = num[c++])) 
                    st_cheap = increment_cheap(st_cheap,&p);
                while((c = *st_cheap->ptr = linebuf[i++])) {
                    st_cheap = increment_cheap(st_cheap,&p);
                    if (c=='\n') {
                        *st_cheap->ptr = 0;
                        st_cheap = increment_cheap(st_cheap,&p);
                        p = st_cheap->ptr;
                        // parse = list3n(ST_COMMENT,parse,(NMTBL*)p);
                        sprintf(num,"%d: ",lineno);
                        c = 0;
                        while((*cheap->ptr = num[c++])) 
                            st_cheap = increment_cheap(st_cheap,&p);
                    }
                }
            }
        }
        p = chptr = linebuf; while(*p==' '||*p=='\t') p++;
        if (*p == '#' && !in_comment && !in_quote) {
            // macro directive
            chptr = p;
            if (macro_processing()) return;
        }
        if (c==EOF) break;
    } while(!in_quote && (macro_if_skip || linebuf[0] == '#'));
}

/* preprocessor directive */

/* line continuation \\ */

extern void
check_macro_eof()
{
    int c;
    // can't be in macro expansion
    for(c=0;c<LBUFSIZE-3&&chptr[c];c++);
    if (c>0&&chptr[c-1]=='\\') {
        return;
    } else if (c>0&&chptr[c-1]=='\n') {
        if (c>0&&chptr[c-2]=='\\') {
            return;
        } else {
            c--;
        }
    } 
    chptr[c] = ';';
    chptr[c+1] = '\n';
    chptr[c+2] = 0;
}

/*   #if hoge case */

static void
macro_if()
{
    int i,stype=type;     // expr destroy type
    ch= *chptr;
    in_macro_if = 1;      // makes undefined symbol==list2(CONST,0)
    check_macro_eof();
    getsym(0);
    /* i=cexpr(expr(1)); #if allow undefined symbols.. */
    i=expr(1); 
    if (inmode) i = pexpr(i);  // it contain const value only
    in_macro_if = 0;
    if (car(i)==CONST) i=cadr(i);
    else i=0;
    if (ch) {
        if (chptr[-1]==ch) {
        /* we are fall into getch(), which lost the last ch */
        /* chptr[-1]==ch check is fanatic, but ... */
            chptr--;
        } else error(-1);
    }
    macro_if_depth = macro_if_current;
    macro_if_skip = !i;
    type=stype;
}

/*
     Macro directive 

       implemented in simple hash

 */

static int
macro_processing()
{
    int i;
    int c=0;
    int mode_save;
    int next;

    ++chptr;
    while (*chptr==' '||*chptr=='\t') ++chptr;
    switch(chptr[0]*chptr[1]) {
    case 'i'*'f':
        if ((macroeq("ifdef") || macroeq("ifndef"))) {
            c = (chptr[-4]=='n');
            macro_if_current++;
            if (!macro_if_skip) {
                // try getsym in IFDEF mode to avoid symbol define
                mode_save = mode; mode = IFDEF;
                ch= *chptr;
                i = getsym(0);
                mode = mode_save;
                macro_if_depth = macro_if_current;
                macro_if_skip = (!i)^c;
            }
            return 0;
        } else if (macroeq("if")) {
            macro_if_current++;
            if (!macro_if_skip) {
                macro_if();
            }
            return 0;
        }
        break;
    case 'e'*'l':
        if (macroeq("elif")) {
            if (macro_if_current==0) {
                error(MCERR); /* extra #else */
                return 0;
            }
            if (macro_if_current == macro_if_depth) {
                if (!macro_if_skip || macro_if_skip==2) {
                    macro_if_skip=2;
                    return 0;
                }
                macro_if();
            }
            return 0;
        } else if (macroeq("else")) {
            if (macro_if_current==0) {
                error(MCERR); /* extra #else */
                return 0;
            }
            if (macro_if_current == macro_if_depth) {
                if (macro_if_skip==2) ;
                else if (macro_if_skip) macro_if_skip=0;
                else macro_if_skip=1;
            }
            return skip_rest_of_line();
        }
        break;
    case 'e'*'n':
        if (macroeq("endif")) {
            if (macro_if_current == macro_if_depth) {
                macro_if_skip = 0;
                macro_if_depth = --macro_if_current;
            } else {
                if (macro_if_current<=0) {
                    error(MCERR); /* extra #if */
                    return 0;
                }
                macro_if_current--;
            }
            return skip_rest_of_line();
        }
    }
    if (macro_if_skip) return 0;
    switch(chptr[0]) {
    case 'd':
        if (macroeq("define")) {
            ch= *chptr;
            macro_define0();
            *(chptr = linebuf) = '\0';
            return 0;
        }
        break;
    case 'u':
        if (macroeq("undef")) {
            i=mode;
            mode=IFDEF;
            ch= *chptr;
            if (getsym(0)) {
                // make it EMPTY
                if (nptr->sc == MACRO) {
                    nptr->sc = EMPTY;
                } else if (nptr->sc == FMACRO) {
                    nptr->sc = EMPTY;
                    /* we cannot reclaim it's arg */
                } else error(MCERR);
            }
            mode=i;
            return 0;
        }
        break;
    case 'i':
        next = 1;
        if (macroeq("include_next")|| (next=0, macroeq("include"))) {
            if(filep+1 >= filestack + FILES) error(FILERR);
            if ( ((filep+1)->fcb=getfname(next)) == NULL) error(FILERR);
            (filep+1)->ln=lineno;
            lineno=0;
            ++filep;
            *(chptr = linebuf) = '\0';
            return 0;
        }
        break;
    case 'p':
        if (macroeq("pragma")) {
            getline1();
            return 0;
        }
        break;
#if ASM_CODE
    // deprecated, use asm function
    case 'a':
        if (macroeq("asm")) {
            if (asmf) error(MCERR);
            asmf = 1;
            getline1();
            while (asmf) {
                 printf("%s",linebuf);
                getline1();
            }
            return 0;
        }
        break;
    case 'e':
        if (macroeq("endasm")) {
            if (!asmf) error(MCERR);
            asmf = 0;
            return 0;
        }
        break;
#endif
    case ' ': case '\t': case '\n': case 0:
        getline1();
        return 0;
    }
    error(MCERR);
    return 0;
}

extern int
macroeq(char *s)
{
    char *p;

    for (p = chptr; *s;) if (*s++ != *p++) return 0;
    chptr = p;
    return 1;
}

/* macro interpreter */

/* generate macro define */

extern void
macro_define(char *macro)
{
    char *chptr_save;
    int chsave;

    chptr_save = chptr;
    chsave = ch;
    chptr = macro;
    ch= *chptr++;
    macro_define0();
    chptr = chptr_save;
    ch = chsave;
}

/* macro define from chptr 

       body will be copied and stored in nptr->dsp 
            list3s( STRING, list of argments (if any), char *)
       We don't expand macro here, it just copied.

 */

static void
macro_define0()
{
    int i,args,c;
    char **body;

    i=mode;
    mode=MDECL;
    // ch= *chptr; ??
// fprintf(stderr,"macro def: ch %c *chptr %c\n",ch,*chptr);
    getsym(0);
// fprintf(stderr,"macro def: %s =>",name); 
    if (nptr->sc != EMPTY) { /* override existing macro */
    }
    args = 0;
    if (ch=='(') {
        nptr->sc = FMACRO;
        args = macro_args(&chptr);
    } else {
        nptr->sc = MACRO;
        nptr->ty = -1;
    }
    // equal is allowed for -Dhoge=aho option
    // if (ch=='=') chptr++;
    while((c=*chptr)==' '||c=='\t') chptr++;
    nptr->dsp = list3s(MACRO,args,cheap->ptr); /* macro body */
    body = (char **)&scaddr(nptr->dsp);

    // now copy it to the body
    while ((*cheap->ptr = c = *chptr++)
        && c != '\n') {
        cheap = increment_cheap(cheap,body);
        if (c=='/'&&chptr[0]=='/') {
            cheap->ptr--; 
            *cheap->ptr = '\0';
            while(*chptr++)
              ; 
            break;
        } else if (c=='/'&&chptr[0]=='*') {
            cheap->ptr--; chptr++;
            for(;;) {
                c = *chptr++;
                if (!c) {
                    getline1();
                    continue;
                }
                if (c=='*'&&chptr[0]=='/') {
                    c = *chptr++; break;
                }
            }
            if (!c) break;
        } else if (c=='\\' && (*chptr=='\n'||*chptr==0)) {
            chptr++;
            cheap->ptr--;
            getline1();
        }
    }
    if (c=='\n') {
        *cheap->ptr = '\0';
    }
    cheap = increment_cheap(cheap,body);
// fprintf(stderr,"%s\n",(char *)car(nptr->dsp));
    mode=i;
}

// create function macro argument list
//    return  list2((char*)arg,next)
//    it can be sepearted by \ or comments
//    no expansion

static char *
skip_space(char *chptr, char **pchptr) {
    int c;
    for(;;) {
        c = *chptr;
	while (c=='\n') {
            getline1();
            chptr = *pchptr;
	    c = *chptr;
	}
        if (c==' '||c=='\t') ++chptr;
	else break;
    }
    return chptr;
}

static int
macro_args(char **pchptr)
{
    int c;
    int in_quote = 0;
    int in_wquote = 0;
    int plevel = 0;
    char **body;
    char *chptr = *pchptr;
    int args = glist3s(STRING,0,cheap->ptr);
    body = (char **)&scaddr(args);
    chptr = skip_space(chptr, pchptr);
    for(;;) {
	*cheap->ptr = c = *chptr++;
        cheap = increment_cheap(cheap,body);
        if (c=='\\') {
            if (*chptr=='\n') {
                cheap->ptr--;
                getline1();
                chptr = *pchptr;
                continue;
            }
        }
        if (!c)  {
            chptr--;
            error(MCERR);
            *pchptr = chptr;
            return reverse0(args);
        }
        if (in_quote) {
            if (c=='\\') {
                if (*chptr != '\n') {
                    *cheap->ptr = *chptr++;
                    cheap = increment_cheap(cheap,body);
                } else {
                    getline1();
                    chptr = *pchptr;
                }
            } else if (c=='\'') {
                in_quote = 0;
            }
        } else if (in_wquote) {
            if (c=='\\') {
                if (*chptr !='\n') {
                    *cheap->ptr = *chptr++;
                    cheap = increment_cheap(cheap,body);
                } else {
                    *cheap->ptr = '\n';
                    getline1();
                    chptr = *pchptr;
                }
            } else if (c=='"') {
                in_wquote = 0;
            }
        } else if (c=='"') {
            in_wquote = 1;
        } else if (c=='\'') {
            in_quote = 1;
        } if (plevel==0) {
            if (c==',') {
		int rev = -1;
		while((c = cheap->ptr[--rev])==' '|| c=='\t') 
                    ;
                cheap->ptr[++rev] = 0;
                chptr = skip_space(chptr, pchptr);
                args = list3s(STRING,args,cheap->ptr);
                body = (char **)&scaddr(args);
            } else if (c==')') {
                cheap->ptr[-1] = 0;
                break;
            } else if (c=='(') {
                plevel++;
            } else if (c=='\\') {
                if (*chptr=='\n') {
                    cheap->ptr--;
                    getline1();
                    chptr = *pchptr;
                }
//          } else if (c==' '||c=='\t') {
//              cheap->ptr--;
            } else if (c=='\n') {
                cheap->ptr--;
                getline1();
                chptr = *pchptr;
            }
        } else if (c==')') {
            plevel--;
        } else if (c=='(') {
            plevel++;
        } else if (c=='\n') {
            cheap->ptr--;
            getline1();
            chptr = *pchptr;
        }
    }
    *pchptr = chptr;
    return reverse0(args);
}

/* output macro expansion 

   This is a recursive interpreter. 

   result into macrobuf (macropp) */

static int
macro_function(int macrop,char **pchptr,NMTBL *nptr,int history)
{
    int args,sargs,values;
    char *macro;

    // make argument list
    sargs = args = cadr(nptr->dsp);
    values = macro_args(pchptr);
    if (pchptr==&chptr) {
        getch();
        // ch = *chptr++;
    }
    // eval all argument list
    int evalues = 0;
    int values0 = values;
    while(values) {
       evalues = list2(macro_eval(0,scaddr(values),history,1),evalues);
       values = cadr(values);
    }
    evalues = reverse0(evalues);
    values = values0;
    // define all arguments locally
    //    #define arg0 arg0_value
    //    #define arg1 arg2_value ....
    enter_scope();
    while(args) {
        mappend0(reverse0(car(evalues)),&macro);
        local_define(scaddr(args),macro);
        args = cadr(args);
        evalues = cadr(evalues);
        values = cadr(values);
    }
    // process body replacement
    macro = scaddr(nptr->dsp);
    macrop = macro_eval(macrop,macro,glist3s(STRING,history,nptr->nm),1);
    args = sargs;
    // unbind arguments
    leave_scope();
    return macrop;
}

/*
   define name in the local scope
 */

static void
local_define(char *macro,char *value)
{
    NMTBL *nptr0,*nlist;
    while(*macro==' '||*macro=='\t') macro++;
    nptr0 = name_space_search(nlist=get_name(macro,0,DEF),MACRO);
    nptr0 = make_local_scope(nlist,nptr0,MACRO);
    nptr0->nm = value;
}

static void
string_mark(char **expand)
{
    mconcat = 1;
    *cheap->ptr = STRING; //  special value for string
    cheap = increment_cheap(cheap,expand);
}

static int
next_concat(int c, char *body)
{
    if (c=='#' && body[0]=='#') return 1;
    while((c=*body++)) {
        if (c=='#' && body[0]=='#') return 1;
        if (c!=' ' && c!='\t' && c!='\n') return 0;
    }
    return 0;
}

/*
    Evaluate macro string.

    This is a recursive interpreter. 

    reuslt:   list2("replaced string",next)
        history is necessary to avoid recursion
 */

static int
macro_eval(int macrop,char *body0,int history, int local_only)
{
    int c,len;
    int in_quote = 0;
    int in_wquote = 0;
    int string_flag = 0;
    int prev_concat = 0;
    char *macro;
    char *body = body0;
    char **expand;
    NMTBL *nptrm;

    macro_history = history;
    macrop = list3s(STRING,macrop,cheap->ptr);
    expand = (char **)&scaddr(macrop);
    for(; (c = *body++) ;) {
        if (in_quote) {
            if (c=='\\') {
                *cheap->ptr = c; c = *body++;
                cheap = increment_cheap(cheap,expand);
            } else if (c=='\'') {
                in_quote = 0;
            }
        } else if (in_wquote) {
            if (c=='\\') {
                *cheap->ptr = c; c = *body++;
                cheap = increment_cheap(cheap,expand);
            } else if (c=='"') {
                in_wquote = 0;
            }
        } else if (c=='"') {
            in_wquote = 1; prev_concat = 0;
        } else if (c=='\'') {
            in_quote = 1; prev_concat = 0;
        } else if (c=='#' && *body=='#') {
            mconcat = 1; 
            prev_concat = 1;
            // name concatenation. flag only. remove and re-evaluate
            // in the top level. (and skip space)
        } else if (!prev_concat && c=='#' && alpha(*body)) {
            // turn into string next macro literal
            string_flag = 1;
            string_mark(expand);
            prev_concat = 0;
            goto names;
        } else if (alpha(c)) {
            // find a name
            body--; // ungetc
names:
            nptrm = get_name(body,&len,NONDEF);
            if (!nptrm) {
                while((*cheap->ptr = *body++) && len--)
                    cheap = increment_cheap(cheap,expand);
                body--;
                if (string_flag) {
                    string_flag = 0;
                    string_mark(expand);
                }
                continue;
            }
            body += len;
            c = *body;
            nptrm = name_space_search(nptrm,MACRO);
            if (nptrm->dsp)
                macro = scaddr(nptrm->dsp);
            else
                macro="";
            if (check_recurse(nptrm->nm,history)) {
                // should return the most original one, but how?
                // save_cheap/reset_cheap and return here?
                macro = nptrm->nm;
                goto skip;
            }
            switch(nptrm->sc) {
            case FMACRO:
                if (c==' '||c=='\t') {
                    while (c==' '||c=='\t') c=*body++;
                    body--;
                }
                if(c!='(') {
                    macro = nptrm->nm;
                    goto skip; // error(MCERR); this isn't error
                }
                *cheap->ptr = 0;
                cheap = increment_cheap(cheap,expand);
                body++;
                macrop = macro_function(macrop,&body,nptrm,
                        glist3s(STRING,history,nptrm->nm));
                macrop = list3s(STRING,macrop,cheap->ptr);
                expand = (char **)&(scaddr(macrop));
                break;
            default:
                if (prev_concat) {
                    prev_concat = 0;
                    macro = nptrm->nm;
                } else if (next_concat(c,body)) {
                    prev_concat = 1;
                    macro = nptrm->nm;
                }  
                if (macro==0 || !macro[0]) 
                    macro = nptrm->nm;
                goto skip;
            case MACRO:
                if (!local_only && neqname(nptrm->nm,macro)) {
                    if (macro[0]==0)  {
                        if (string_flag) {
                            string_flag = 0;
                            string_mark(expand);
                        }
                        continue;
                    }
                    *cheap->ptr = 0;
                    cheap = increment_cheap(cheap,expand);
                    macrop=macro_eval(macrop,macro,glist3s(STRING,history,nptrm->nm),local_only);
                    macrop = list3s(STRING,macrop,cheap->ptr);
                    expand = (char **)&(scaddr(macrop));
                    break;
                }
                if (local_only) mconcat = 1;
                macro = nptrm->nm;
skip:
            case LMACRO:
                while((*cheap->ptr = *macro++)/* && len-- */)
                    cheap = increment_cheap(cheap,expand);
            }
            if (string_flag) {
                string_flag = 0;
                string_mark(expand);
            }
            continue;
        }
        *cheap->ptr = c;
        cheap = increment_cheap(cheap,expand);
    }
    *cheap->ptr = 0;
    cheap = increment_cheap(cheap,expand);
    return macrop;
}

/*
    cancat list2("string",next) into cheap.
    result overwrited by next cheap allocation
 */

static char *
mappend0(int lists,char **result)
{
    char *p;
    *result = cheap->ptr;
    for(;lists;lists = cadr(lists)) {
        p = scaddr(lists);
        for(;(*cheap->ptr = *p++);cheap = increment_cheap(cheap,result)) {
            // in_quote + \n case ? should be \n.
            if (p[-1]=='\n') cheap->ptr[0]=' ';
        }
    }
    cheap = increment_cheap(cheap,result);
    return *result;
}

// do not replace \n
extern char *
mappend(int lists,char **result)
{
    char *p;
    *result = cheap->ptr;
    for(;lists;lists = cadr(lists)) {
        p = scaddr(lists);
        for(;(*cheap->ptr=*p++);cheap = increment_cheap(cheap,result)) {
            // in_quote + \n case ? should be \n.
            // if (p[-1]=='\n') cheap->ptr[0]=' ';
        }
    }
    cheap = increment_cheap(cheap,result);
    return *result;
}

extern int
check_recurse(char *macro,int history)
{
    int len;
    char *name = macro;
    while(1) {
        NMTBL *nptrm = get_name(name,&len,NONDEF);
        if (!nptrm) break;
        nptrm = name_space_search(nptrm,MACRO);
        if (!nptrm) break;
        if (nptrm->dsp)
           name = scaddr(nptrm->dsp);
        else break;
        if ( nameeq(macro,name) )  return 1;
    }

    for(;history;history = cadr(history)) {
        if (macro==scaddr(history)) {
// fprintf(stderr,"check_recurse: %s %s = ",macro,scaddr(history)); 
// fprintf(stderr,"1\n");
            return 1;
        }
    }
// fprintf(stderr,"0\n");
    return 0;
}

/* end */