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