⟦b52bcf72d⟧

TextFile

/* MACRO.c
 *
 *   The routines in this file support the macro processing facilities
 * of PREP.  The style is similar to that of c #define macros, except
 * that : is used instead of #define and ; terminates the macro.  
 * This is done to allow both PREP macros and ratfor macros in the
 * same program.
 *   Recursive definitions are permitted, but will cause an abort
 * (and possibley a memory allocation error) on expansion.  For each
 * line submitted to expand_macros, a count of is kept for each
 * stored macro indicating how many times it has been expanded in
 * the current line.  When this exceeds MAX_CALLS, the program 
 * assumes a macro definition is recursive and stops.  Macros
 * are expanded starting with the one with the longest name, so that
 * if the definitions
 *
 * : >=		.ge. ;
 * : >		.gt. ;
 *
 * are in effect, >= will be changed to .ge. rather than .gt.=.  This
 * is only a potential problem when macro names are not fully
 * alphanumeric, since "arg" will not be flagged if "r" is defined.
 *
 * 11/4/86 P.R.OVE
 */

#include "macro.h"


/* Macro processor.
 *
 *   This routine defines and expands macros.  The definition phase
 * is invoked when a leading : is found in the record.  Text is
 * then taken until the terminating ; is found.  Text following the
 * ; is ignored.  Multiline macros are permitted: they will be
 * converted to at least as many lines in the fortran program.
 * Failure to have a terminating ; will define the entire program
 * to be a macro.
 *   A NULL pointer is returned if a macro has been defined.  Otherwise
 * a pointer to the buffer with the expanded text is returned (even if
 * no macros have been expanded).  The buffer is temporary and should
 * be eliminated by the caller.
 */
 
char	*mac_proc()
{
int	i, j, size ;
char	*text, *def ;


/* see if this is a definition (look for leading :) */
for ( i=0, text=NULL; in_buff[i] != NULL; i++ ) {
	if ( in_buff[i] == BLANK | in_buff[i] == TAB ) continue ;
	if ( in_buff[i] == ':' ) text = &in_buff[i] ;
	break ;
}

if ( text == NULL ) {
/* expand macro if not a definition */
	if ( defined_macros == 0 ) {
		GET_MEM( text, strlen(in_buff) ) ;
		strcpy( text, in_buff ) ;
		return( text ) ;
	}
	else return( expand_macros( in_buff ) ) ;

}
else {

/* macro definition, get characters until ; */
	GET_MEM( def, strlen(text)+10 ) ;
	strcpy( def, text ) ;
	for ( j=1;; j++ ) {

		switch ( def[j] ) {

		case ';'  :{	def[j+1] = NULL ;
				define_macro( def ) ;
				free( def ) ;
				return( NULL ) ;
			}
			
		case NULL :{	
				def[j] = '\n' ;
				def[j+1] = NULL ;
				if ( NULL == get_rec() )
					abort("MACRO: EOF in macro def") ;
				size = strlen(def) + strlen(in_buff) + 10 ;
				if ( NULL == (def=realloc(def,size)) )
					abort("MACRO: realloc error") ;
				strcat( def, in_buff ) ;
			}
		}
	}
}
}




/* Process the macro definition in the argument string.
 * A macro has the form:
 *
 * : name( parm1, parm2, ... )	text with parms ;
 *
 * In a definition the delimeter must follow the name
 * without whitespace.  In the source code this requirement is
 * relaxed.  Alphanumeric macros must be not be next to an alpha or 
 * number character or they will not be recognized.
 *
 * This routine puts the macro string into a more easily handled
 * structure, replacing parms in the text with n, where n is a
 * binary value (128 to 128+MAX_TOKENS).
 *
 * The macro is placed in a structure of the form:
 *
 *    struct mac {
 *	char *name ;		macro id tag
 *	char *text ;		encoded macro text
 *	int  parmcount ;	number of arguments
 *	int  callcount ;	recursion check
 *	} macro[MAX_MACROS] ;
 *
 * where the text string has binary symbols where the parms were.
 * Returns the macro index.  The number of macros defined is stored
 * in global variable defined_macros.
 * 
 * The macros are entered in order of their name length, so that
 * the macro expander will expand those with long names first.
 */

int	define_macro(string)
char	*string ;
{
char	*pntr, *pntr1, *name, *parms[MAX_TOKENS], *parm, *text,
	*open_parens, *close_parens ;
int	i, j, l, parmcount ;

/* macrop is a pointer to the macro structure that will be used */
	if ( defined_macros >= MAX_MACROS ) {
		sprintf(errline,"DEFINE_MACRO: too many macros: %s",string);
		abort( errline ) ;
	}
	macrop = &macro[defined_macros] ;
	defined_macros++ ;

/* get the name */
	name = strtokp( string, ":; \n\t(" ) ;	/* pointer to the name */
	GET_MEM( macrop->name, strlen(name) ) ;
	strcpy( macrop->name, name ) ;

/* get the parameters */
	for ( i=0; i<MAX_TOKENS; i++ ) parms[i] = NULL ;
	open_parens = strmatch(string,name) + strlen(name) ;
	if ( NULL == line_end( open_parens ) ) {
		sprintf( errline, "DEFINE_MACRO: unterminated: %s", string ) ;
		abort( errline ) ;
	}

	/* get the text storage here to avoid memory allocation tangles */
	text = open_parens ;
	GET_MEM( macrop->text, strlen(text) ) ;

	if ( strchr( "([{\'\"", *open_parens ) ) {
		if ( NULL == ( close_parens = mat_del( open_parens ) ) ) {
			sprintf(errline,"DEFINE_MACRO: missing delimeter: %s",
				string ) ;
			abort( errline ) ;
		}
		text = close_parens + 1 ;
		i = (int)(close_parens - open_parens) - 1 ;
		pntr = open_parens + 1 ;
		*close_parens = NULL ;
		for ( i=0, pntr1 = pntr; i<MAX_TOKENS; i++, pntr1 = NULL ) {
			if ( NULL == ( parm = strtokp( pntr1, ", \t" ) ) )
				break ;
			GET_MEM( parms[i], strlen(parm) ) ;
			strcpy( parms[i], parm ) ;
		}
	}

	
/* get the text, plugging in binary codes for parameters */

	/* remove leading whitespace */
	if ( NULL == (text=line_end( text )) ) {
		sprintf( errline, "DEFINE_MACRO: unterminated: %s", string ) ;
		abort( errline ) ;
	}

	/* remove the trailing ';' but NOT whitespace */
	for ( i=strlen(text)-1; i>=0; i-- ) {
		if ( text[i] == ';' ) { text[i] = NULL ; break ; }
	}

	strcpy( macrop->text, text ) ;
	text = macrop->text ;

	for ( i=0; i<MAX_TOKENS & NULL != (parm = parms[i]); i++ ) {

		/* replace parm by code, if not next to an alpha or number */
		l = strlen(parm) ;
		for ( pntr=text;NULL != (pntr1=strmatch(pntr,parm));
		pntr=pntr1+1 ) {
			if ( !( isalnum(*(pntr1-1)) && isalnum(*pntr1) ) &
			     !( isalnum(*(pntr1+l-1)) && isalnum(*(pntr1+l)))) {
			     	*pntr1 = i + 128 ;
				strcpy( pntr1 + 1, pntr1 + strlen(parm) ) ;
			}
		}
	}

	
/* count parms and free up temporary storage */
	macrop->parmcount = 0 ;
	for ( i=0; i<MAX_TOKENS & NULL != parms[i]; i++ ) {
		free( parms[i] ) ;
		macrop->parmcount++ ;
	}

/* rearrange the macro table so it is sorted by name length */
	name = macrop->name ;
	text = macrop->text ;
	parmcount = macrop->parmcount ;
	l = strlen( name ) ;
	for ( i=0; i<defined_macros-1; i++ ) {
		if ( l < strlen( macro[i].name ) ) {
			for ( j=defined_macros-1; j>i; j-- ) {
				macro[j].name = macro[j-1].name ;
				macro[j].text = macro[j-1].text ;
				macro[j].parmcount = macro[j-1].parmcount ;
			}
			macro[i].name = name ;
			macro[i].text = text ;
			macro[i].parmcount = parmcount ;
			break ;
		}
	}
	
/* return the index of the new macro */
	return(i) ;
}



/* Expand the macros in the argument string.  Returns a pointer
 * to the expanded string, which is likely to be huge.  The memory
 * should be freed as soon as possible.  The macros are expanded
 * starting with the one with the highest index.  Recursive macro
 * definitions will be flagged, but may cause a termination due to
 * allocation failure before doing so.  Caution must be exercised
 * to avoid accidental recursive definitions involving
 * more than one macro:
 *	: h	i+x ;
 *	: i(y)	func(y) ;
 *	: func	h ;
 * This will generate the successive strings (from a = func(x)):
 *	a = h(x)
 *	a = i+x(x)
 *	a = func()+x(x)
 *	a = h()+x(x) .... and so on.  Beware.
 * The string is deallocated by this routine.
 */

/* macros to check for being next to an alpha */
#define FIRSTCHAR ( (pntr1!=text) && (isalnum(*(pntr1-1))&&isalnum(*pntr1)) )
#define LASTCHAR  ( isalnum(*(pntr1+l-1)) && isalnum(*(pntr1+l)) )
#define NEXT_TO_ALPHA	( FIRSTCHAR || LASTCHAR )

char	*expand_macros(string)
char	*string ;
{
char	*pntr, *pntr1, *name, *text ;
int	i, hit, l ;

/* Allocate some initial storage */
	GET_MEM( text, strlen(string) ) ;
	strcpy( text, string ) ;

/* clear the recursion check counters */
	for ( i=0; i<defined_macros; i++ ) macro[i].callcount = 0 ;

/* search for macros */
	do {
	for ( i=defined_macros-1, hit=0; i>=0; i-- ) {
		
	/* See if macro[i] is in the present string.  If the "edges"
	 * of the macro name are alphanumeric, don't accept the string
	 * if the adjacent character is also alphanumeric.  This avoids
	 * having variables such as "sin" flagged if "s" is defined.
	 * Potential macros are also rejected if quoted with '.
	 */
		name = macro[i].name ;
		l = strlen(name) ;
		for ( pntr=text; NULL != (pntr1=strmatch(pntr,name));
		pntr=pntr1+1 ) {
			if ( !quoted( pntr1, text ) && !NEXT_TO_ALPHA ) {
				hit = 1 ;			/* got one */
				text = mac_expand( text, pntr1, i ) ;
				break ;
			}
		}
		if ( hit != 0 ) break ;	/* start over if one was found */
	}
	} while( hit != 0 ) ; 


	return( text ) ;
}



/* Expand a single macro in a text string, freeing the old storage
 * and returning * a pointer to the new string.  Name points to the
 * macro in the string and index is the macro index.
 */

char	*mac_expand( text, name, index )
char	*text, *name ;
int	index ;
{
char	*pntr, *newtext, *parm, *parms[MAX_TOKENS], *temp,
	*open_parens, *close_parens, *rest_of_text ;
int	i, j, size ;
unsigned char	 c ;

	macrop = &macro[index] ;
	if ( macrop->callcount++ > MAX_CALLS ) {
		sprintf( errline,
		"MAC_EXPAND: possible recursion involving: \'%s\' in\n%s",
			macrop->name, in_buff ) ;
		abort( errline ) ;
	}
	

/* get the parameters if there are any for this macro */
	for ( i=0; i<MAX_TOKENS; i++ ) parms[i] = NULL ;
	rest_of_text = &name[ strlen( macrop->name ) ] ;
	if ( macrop->parmcount != 0 ) {
		open_parens = &rest_of_text[ strspn( rest_of_text, " \t" ) ] ;
		if ( (NULL != strchr( "([{\'\"", *open_parens )) &
		     (NULL != *open_parens )) {
			if (NULL == (close_parens=mat_del(open_parens)) ) {
				sprintf( errline,
				"MAC_EXPAND: missing delimeter: %s", in_buff ) ;
				abort( errline ) ;
			}
			i = (int)(close_parens - open_parens) - 1 ;
			pntr = open_parens + 1 ;
			c = *close_parens ;		/* save *close_parens */
			*close_parens = NULL ;		/* make parm block a string */
			i = tokenize( pntr, parms ) ;	/* break out the parms */
			*close_parens = (char)c ; 	/* restore text */
			rest_of_text = close_parens + 1 ;
		}
	}

	
/* find out how much memory we will need, then allocate */
	size = strlen(text) ;
	if ( NULL != ( pntr = macrop->text ) ) size += strlen(pntr) ;
	for ( i=0; NULL != (c=pntr[i]); i++ ) {
		if ( c > 127 & parms[c-128] != NULL )
			size += strlen(parms[c-128]) ;
	}
	GET_MEM( newtext, size ) ;


/* copy up to macro verbatim */
	*name = NULL ;
	strcpy( newtext, text ) ;

/* expand the macro itself if there is text */
	if ( NULL != (pntr = macrop->text) ) {
		for ( i=0, j=strlen(newtext); NULL != (c=pntr[i]); i++, j++ ) {
			if ( c > 127 ) {
				if ( parms[c-128] != NULL ) {
					strcat( newtext, parms[c-128] ) ;
					j += strlen( parms[c-128] ) - 1 ;
				}
				else j-- ;
			}
			else {		/* keep null terminated */
				newtext[j] = c ;
				newtext[j+1] = NULL ;
			}
		}
	}
	

/* finish off trailing text */
	strcat( newtext, rest_of_text ) ;
	
/* free up temporary storage and return pointer to new allocation */
	for ( i=0; i<MAX_TOKENS & NULL != parms[i]; i++ ) free( parms[i] ) ;
	free( text ) ;
	return( newtext ) ;
}




/* isalnum: returns nonzero value if the character argument belongs to the 
 * sets { a-z, A-Z, 0-9 }.
 */
 
int	isalnum( c )
char	c ;
{
	if ( c >= 97 & c <= 122 ) return (1) ;	/* a-z */
	if ( c >= 65 & c <= 90 ) return (2) ;	/* A-Z */
	if ( c >= 48 & c <= 57 ) return (3) ;	/* 0-9 */
	return(0) ;				/* miss */
}




/* Return TRUE is the pointer is quoted in the string (pntr marks
 * a position in the string).  The quote character the apostrophe.
 * If pntr is not in the the result will be meaningless.
 */
 
int	quoted( pntr, string )
char	*pntr, *string ;
{
int	i, quote=FALSE ;

	for ( i=0; NULL != string[i] && &string[i] < pntr; i++ )
		if ( string[i] == '\'' ) quote = !quote ;
		
	return( quote ) ;
}
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦b52bcf72d⟧ TextFile

Derivation

TextFile
