|
|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: T p
Length: 5831 (0x16c7)
Types: TextFile
Names: »prep.c«
└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
└─⟦this⟧ »EUUGD11/euug-87hel/sec1/prep/prep.c«
/* 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() ;
}