DataMuseum.dk

Presents historical artifacts from the history of:

DKUUG/EUUG Conference tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DKUUG/EUUG Conference tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ T p

⟦0b81a2cf1⟧ TextFile

    Length: 5831 (0x16c7)
    Types: TextFile
    Names: »prep.c«

Derivation

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/euug-87hel/sec1/prep/prep.c« 

TextFile

/* Program PREP.C
 *
 * Preprocessor for FORTRAN 77.
 * Adds the additional features:
 *
 *  1) Vector arithmetic:
 *     a(#,#,1) = b(#,#) + 1
 *
 *   [ a(#) = b(#)*c(#) - 100
 *     x = y
 *     d(#) = e(#) 		]
 *
 *  2) Case construct:
 *     case ( exp1 )
 *     of   ( exp2 )  line of code
 *                    line of code
 *                    continue_case
 *     of   ( exp3 )  line of code
 *     default        line of code
 *                    line of code
 *     end_case
 *
 *  3) do i = 1, 10
 *        line of code
 *        line of code
 *     leave_do (optional expression)
 *        line of code
 *     continue_do (optional expression)
 *        line of code
 *     end_do
 *
 *  4) forth style begin/while/until/again construct:
 *     begin ... again
 *     begin ... while (exp1) ... again
 *     begin ... until (exp1)
 *     leave (optional expression) to exit current level
 *     continue (optional expression) to go back to beginning
 *
 *  5) Vector loop unrolling to any depth, for loops 
 *     that can be expressed as in #1 above.
 *
 *  6) Macro processing, defined a macro "name" with:
 *     : name(a,b,c)	a = a + func( c, d ) ;
 *
 *  7) Included files:
 *     #include "filename"
 *
 *    The nesting limit for all loops is defined by the constant
 * NESTING in file prepdefs.h.  All underline characters are removed,
 * as are comments if com_keep is NULL.
 *    Any delimeters (){}[]'" may be used in the logical expressions
 * ( i.e.  leave [i .eq. 1] ).
 *    The flow control directives are permitted inside vector
 * loops, but since they will inhibit Cray vectorization of those
 * loops it may be best to avoid this.  One of the reasons for
 * using the vector shorthand is that it encourages programming
 * in a style that can be easily vectorized.
 *    Some attempts have been made to avoid ratfor syntax to that
 * both preprocessors can be used, but this has never been checked.
 *    The number of parameters allowed in a macro is set by the constant
 * MAX_MAC_PARMS in file prepdefs.h (20 is probably more than enough).
 *    Although the syntax is similar to forth, the spirit of
 * forth is totally absent.  The macros are really macros,
 * not colon definitions, and recursive macro definitions will cause
 * an error during expansion.  Postfix notation would only cause
 * confusion, being in conflict with fortran conventions, and is
 * not used.
 *    The macro processor can be considered a pre-preprocessor.  The
 * order of translation is:
 *
 *	1) file inclusion
 *	2) macro processing
 *	3) flow control extensions
 *	4) vector statements
 *
 * Note that because of this the flow control syntax can be modified
 * at the macro level.
 *
 * Switches:
 *   -c		keep comments (truncated at column 72)
 *   -u		keep underline characters
 *   -m		only do macro substitution (==> -c and -u as well, and
 *		prevents file includes (except -i switch).
 *   -i	<file>	include <file> before processing
 *   -U n	unroll vector loops to depth n
 *   -L n	unroll loops with n or fewer lines
 *   -?		write message about allowed switches
 *
 * P. R. OVE  11/9/85
 */

#define	MAIN	1
#include "prep.h"

main( argc, argv )
int	argc ;
char	*argv[] ;
{
int 	i, j, maxlength, lines ;
char	*text ;


init() ;
parmer( argc, argv ) ;	/* process command line switches */

/* copyright notice */
fprintf( stderr,
	"PREP  Copyright (C) 1985,1986 P.R.Ove.  All rights reserved\n" ) ;

/* Main loop, loop until true end of file */
while ( 1 ) {

	/* get the next record */
	if ( NULL == get_rec() ) break ;

	/* comment and blank line filtering */		
	if ( (*in_buff == 'c') | (*in_buff == 'C') | NOT (IN_BUFF_FULL) ) {
		if ( com_keep ) {
			if ( NOT macro_only ) in_buff[72] = NULL ;
			put_string( in_buff ) ;
		}
		continue ;
	}

	/* handle file inclusion if not in macro_only mode */
	if ( NOT macro_only ) {
		preproc( rec_type( 0 ) ) ;
		if ( NOT (IN_BUFF_FULL) ) continue ;
	}

	/* expand macros in in_buff, result pointed to by text */
	if ( NULL == (text = mac_proc()) ) continue ;	/* NULL ==> macro def */

	/* output text here if only doing macro expansion */
	if ( macro_only ) {
		put_string( text ) ;
		free( text ) ;
		continue ;
	}

	/* count lines in text, delimit with NULLs, and find the longest line */
	for ( maxlength=0, i=0, j=0, lines=1;; i++, j++ ) {
		if ( text[i] == '\n' ) {
			text[i] = NULL ;
			if ( j>maxlength ) maxlength = j ;
			j = -1 ;
			lines++ ;
			continue ;
		}
		if ( text[i] == NULL ) {
			if ( j>maxlength ) maxlength = j ;
			break ;
		}
	}

	/* if necessary expand the output buffer size */
	if ( maxlength > allocation ) {
		allocation = maxlength + maxlength/10 ;
		if ( NULL == (in_buff = realloc( in_buff, allocation )) )
			abort( "reallocation failed" ) ;
		if ( NULL == (out_buff = realloc( out_buff, 4*allocation )) )
			abort( "reallocation failed" ) ;
	}

	/* send each line through the passes */
	for ( j=0, i=0; j<lines; j++, i+=strlen(&text[i])+1 ) {
		strcpy( in_buff, &text[i] ) ;
		passes() ;
	}
	
	/* free the storage created by mac_proc */
	free( text ) ;
}

fclose( out ) ;
}



/* Do preprocessor passes 1, 2, and 3 on text in in_buff.  Output is
 * also done here.
 */
passes()
{

/* process the statement until it is NULL */
while ( IN_BUFF_FULL ) {

	preproc( rec_type( 1 ) ) ;

	preproc( rec_type( 2 ) ) ;

	preproc( rec_type( 3 ) ) ;
}
}



/* initialization */
init() {
int	i ;

/* do loop counter variables and flags */
for ( i = 0; i < NESTING; i++ ) {
	sprintf( var_name[i], "i%03d", i ) ;
	leave_do_flag[i] = FALSE ;
}

/* Allocate some space for the buffers */
allocation = DEF_BUFFSIZE ;
GET_MEM( in_buff, allocation ) ;
GET_MEM( out_buff, 4*allocation ) ;
}



/* error exit */
abort( string )
char	*string ;
{
	fprintf( stderr, "%s\n", string ) ;
	fprintf( out, "%s\n", string ) ;
	fclose( out ) ;
	exit() ;
}