/* 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, char *name);
static int macro_eval(int macrop,char *body0,int history);
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.
    
 */

extern 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);
    }

    // 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

    while (mconcat) {
        // ## re-eval macro
if (lsrc) printf("## before %s",macropp);
        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;
	// evaluate generated result again
if (1 && lsrc) {
     printf("\n### %s\n",macropp);
     if (t[-2]!='\n') putchar('\n');
}
        macrop=macro_eval(macrop,macropp,macro_history);
	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
    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;
    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 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);
    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==',') {
		cheap->ptr[-1] = 0;
		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),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, scaddr(values));
	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));
    args = sargs;
    // unbind arguments
    leave_scope();
    return macrop;
}

/*
   define name in the local scope
 */

static void
local_define(char *macro,char *value, char *name)
{
    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;
    nptr0->u.nm = name;  // shallow value for concatenation
}

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 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 (!mconcat && 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->u.nm;
		} else if (next_concat(c,body)) {
		    prev_concat = 1;
		    macro = nptrm->u.nm;
		}  
		if (macro==0 || !macro[0]) 
		    macro = nptrm->nm;
		goto skip;
	    case MACRO:
		if (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);
		    history = glist3s(STRING,history,nptrm->nm);
		    macrop=macro_eval(macrop,macro,history);
		    macrop = list3s(STRING,macrop,cheap->ptr);
		    expand = (char **)&(scaddr(macrop));
		    break;
		}
		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)
{
    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 */