home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / prog_oth / prep_065.lzh / PREP / VEC.C < prev    next >
C/C++ Source or Header  |  1991-08-16  |  13KB  |  565 lines
  1. /* Routines related to vector shorthand extensions */
  2.  
  3. #include "prep.h"
  4.  
  5. char    *initial_name[NESTING] ;    /* do loop initial values */
  6. char    *limit_name[NESTING] ;        /* do loop limits */
  7. char    *increment_name[NESTING] ;    /* do loop increments */
  8. char    label[NESTING][6] ;        /* label storage (vector loops) */
  9. char    var_name[NESTING][6] ;        /* do counter names */
  10.  
  11. int    var_count = 0 ;            /* number of vars used in do loops */
  12. int    label_count = 0 ;        /* label = label_count + 10000 */
  13.  
  14.  
  15.  
  16. /* VEC_INIT
  17.  *
  18.  * Initialize the vec routines
  19.  */
  20. vec_init()
  21. {
  22. int i ;
  23.  
  24. for ( i = 0; i < NESTING; i++ ) sprintf( var_name[i], "i%03d", i ) ;
  25. }
  26.  
  27.  
  28.  
  29. /* Function CSQB_PROC.C
  30.  *
  31.  * Process close square brackets.  Abort if called while
  32.  * not in a vector loop, else finish off vector loop processing
  33.  * with a call to end_vec.
  34.  *
  35.  * P. R. OVE  11/9/85
  36.  */
  37.  
  38. csqb_proc() 
  39. {
  40. int    i, quote=1 ;
  41.  
  42. /* if vec_flag not set this call is an error */
  43. if ( NOT vec_flag ) {
  44.     sprintf( errline, "CSQB: not in vector loop: %s", in_buff ) ;
  45.     abort( errline ) ;
  46. }
  47.                       
  48. /* see what in_buff contains and replace unquoted ] by NULL */
  49. for ( i = 0; in_buff[i] != NULL; i++ ) {
  50.     switch ( in_buff[i] ) {
  51.     
  52.     case '\'' :    quote = -quote ;
  53.             break ;
  54.     case ']' :    if ( quote == 1 ) {
  55.                 in_buff[i] = NULL ;
  56.                 i-- ;        /* force termination */
  57.                 break ;
  58.             }
  59.     }
  60. }
  61.  
  62. dump( in_buff ) ;    /* --> mem_store */
  63. end_vec();        /* terminate vector loop */
  64.  
  65. IN_BUFF_DONE ;
  66. }
  67.  
  68.  
  69.  
  70.  
  71. /* Function DO_LIMITS_PROC
  72.  *
  73.  * Process do_limits statements: Parse variable string.
  74.  *
  75.  * P. R. OVE  11/9/85
  76.  */
  77.  
  78. char    *tokens[MAX_TOKENS] ;
  79.  
  80. do_limits_proc()
  81. {                  
  82. int    i, j, k ;
  83. char    *temp[MAX_TOKENS], *open_parens, *close_parens ;
  84.  
  85. /* free allocation from previous call */
  86. free_loop_vars() ;
  87.  
  88. /* find the open and close delimeters */
  89. open_parens = &in_buff[ strcspn( in_buff, "[({\'\"" ) ] ;
  90. if ( NULL == ( close_parens = mat_del( open_parens ) ) ) {
  91.     sprintf( errline, "DO_LIMITS: missing delimeter: %s", in_buff ) ;
  92.     abort( errline ) ;
  93. }
  94. *close_parens = NULL ;    /* make arg string null terminated */
  95.  
  96.  
  97. /* get the (initial,limit,increment) triples */
  98. var_count = tokenize( open_parens+1, tokens ) ;
  99.  
  100. /* handle wierd numbers of tokens */
  101. if ( var_count <= 0 ) abort( "ERROR: no variables found" ) ;
  102. for ( i = NESTING; i < var_count; i++ ) {
  103.     var_count = NESTING ; free( tokens[i] ) ; }
  104.  
  105.  
  106. /* At this stage the tokens are strings like
  107.  *
  108.  *  "(initial , limit , increment)  ==>  do i = initial, limit, increment.
  109.  *
  110.  * If one is missing it is assumed to be the increment.  If two are
  111.  * missing the single item is assumed to be the limit.  The parens are
  112.  * unnecessary if there is only the limit.
  113.  *
  114.  * break out the tokens (delimeted by commas)
  115.  */
  116. alloc_loop_vars() ;
  117. for ( i = 0; i < var_count; i++ ) {
  118.  
  119.     /* find the open and close delimeters if present, and handle them*/
  120.     open_parens = &tokens[i][ strcspn( tokens[i], "[({\'\"" ) ] ;
  121.     if ( NULL != ( close_parens = mat_del( open_parens ) ) ) {
  122.         *close_parens = NULL ;
  123.         *open_parens = BLANK ;
  124.     }
  125.  
  126.     k = tokenize( tokens[i], temp ) ;
  127.  
  128.     /* case of too many tokens, ignore trailers */
  129.     for ( j = 3; j < k; j++ ) { k = 3 ; free( temp[j] ) ; }
  130.  
  131.     switch ( k ) {
  132.     case 1:    strcpy(initial_name[i], "1") ;
  133.         sprintf(limit_name[i], "(%s)", temp[0]) ; free( temp[0] ) ;
  134.         strcpy(increment_name[i], "1") ;
  135.         break;
  136.  
  137.     case 2:    sprintf(initial_name[i], "(%s)", temp[0]) ; free( temp[0] ) ;
  138.         sprintf(limit_name[i], "(%s)", temp[1]) ; free( temp[1] ) ;
  139.         strcpy(increment_name[i], "1") ;
  140.         break;
  141.  
  142.     case 3:    sprintf(initial_name[i], "(%s)", temp[0]) ; free( temp[0] ) ;
  143.         sprintf(limit_name[i], "(%s)", temp[1]) ; free( temp[1] ) ;
  144.         sprintf(increment_name[i], "(%s)", temp[2]) ; free( temp[2] ) ;
  145.         break;
  146.  
  147.     default:strcpy(initial_name[i], "1") ;
  148.         sprintf(limit_name[i], "(%s)", "undefined" ) ;
  149.         strcpy(increment_name[i], "1") ;
  150.         break;
  151.     }
  152. }                
  153.  
  154. IN_BUFF_DONE
  155. }
  156.  
  157. /* release allocation from previous call */
  158. free_loop_vars() {
  159. int    i ;
  160.  
  161. for ( i = 0; i < var_count; i++ ) {
  162.     free( tokens[i] ) ;
  163.     free( initial_name[i] ) ;
  164.     free( limit_name[i] ) ;
  165.     free( increment_name[i] ) ;
  166. }
  167. }
  168.  
  169. /* allocate space for do loop variables */
  170. alloc_loop_vars() {
  171. int    i, size ;
  172.  
  173. for ( i = 0; i < var_count; i++ ) {
  174.     size = strlen( tokens[i] ) + 10 ;
  175.     GET_MEM( initial_name[i], size ) ;
  176.     GET_MEM( limit_name[i], size ) ;
  177.     GET_MEM( increment_name[i], size ) ;
  178. }
  179. }
  180.  
  181.  
  182.  
  183.  
  184. /* Function END_VEC.C
  185.  *
  186.  * This routine is called when a cluster of vector arithmetic
  187.  * is ready to be terminated (a closing ] has been found
  188.  * or the statement was a single line vector * statement.  The
  189.  * core of the loop has by now been pushed into MEM_STORE and
  190.  * will now be extracted and processed.  On completion MEM_STORE
  191.  * is released.
  192.  *
  193.  * P. R. OVE  11/9/85
  194.  */
  195.  
  196. end_vec() 
  197. {
  198. int    i, j ;
  199.  
  200. /* reset the flag */
  201. vec_flag = FALSE ;
  202.  
  203. make_do() ;    /* write the initial do loop statements */
  204.  
  205. if ( NOT UNROLLING ) {
  206.     /* process all of the pushed statements through transvec */
  207.     for ( i = 0; i < mem_count; i++ )
  208.         transvec( mem_store[i], 0 ) ;
  209.  
  210.     make_continue() ;    /* write continue statements */
  211. }
  212.  
  213. else {
  214.     /* process the statements though transvec unroll_depth times */
  215.     for ( j = 0; j < unroll_depth; j++ ) {
  216.         for ( i = 0; i < mem_count; i++ )
  217.             transvec( mem_store[i], j ) ;
  218.     }
  219.     make_continue() ;
  220.  
  221.     /* write the clean up part of the unrolled loop */
  222.     make_labels() ;
  223.     make_clean_do() ;
  224.     for ( i = 0; i < mem_count; i++ )
  225.         transvec( mem_store[i], 0 ) ;
  226.     make_continue() ;
  227. }
  228.  
  229. /* release the memory held by MEM_STORE and return to main level */
  230. while ( push(NULL) >= 0 ) ;
  231. IN_BUFF_DONE
  232. }
  233.  
  234.  
  235.  
  236.  
  237. /* Make the initial do statements */
  238. make_do() {
  239. int    i ;
  240.  
  241. /* outermost do statement is different if unrolling is on */
  242. i = var_count - 1 ;
  243.  
  244. if ( UNROLLING ) {
  245. /* This section unrolls: do i = a, b, c   (depth = d)   into
  246.  *
  247.  *             b-a+c
  248.  * do i = a, (-------)*(c*d) + a - c, c*d  
  249.  *              c*d
  250.  *
  251.  * for the outermost loop.  Inner loops are unchanged.
  252.  */
  253.     sprintf( out_buff,
  254.     "      do %s %s=%s,int((1.0*(%s-%s+%s))/(%s*%d))*%s*%d+%s-%s,%s*%d",
  255.         label[i], var_name[i], initial_name[i],
  256.         limit_name[i], initial_name[i], increment_name[i],
  257.         increment_name[i], unroll_depth,
  258.         increment_name[i], unroll_depth,
  259.         initial_name[i], increment_name[i],
  260.         increment_name[i], unroll_depth ) ;
  261.     dump( out_buff ) ; }
  262. else {
  263.     sprintf( out_buff, "      do %s %s = %s, %s, %s",
  264.         label[i], var_name[i],
  265.         initial_name[i], limit_name[i], increment_name[i] ) ;
  266.     dump( out_buff ) ; }
  267.  
  268. /* handle the rest of the do statements */
  269. for ( i = var_count-2; i >= 0; i-- ) {
  270.     sprintf( out_buff, "      do %s %s = %s, %s, %s",
  271.         label[i], var_name[i],
  272.         initial_name[i], limit_name[i], increment_name[i] ) ;
  273.     dump( out_buff ) ; }
  274. }
  275.  
  276.  
  277.  
  278.  
  279. /* make the do statements for the clean up part of the unrolled loop */
  280. make_clean_do() {
  281. int    i ;
  282.  
  283. /* make the outer do statement.
  284.  * This section unrolls: do i = a, b, c   (depth = d)   into
  285.  *
  286.  *          b-a+c
  287.  * do i = (-------)*(c*d) + a, b, c
  288.  *           c*d
  289.  *
  290.  * for the outermost loop.  Inner loops are unchanged.  The initial
  291.  * value is the first element that missed the main do loop */
  292. i = var_count - 1 ;
  293. sprintf( out_buff,
  294.     "      do %s %s=int((1.0*(%s-%s+%s))/(%s*%d))*%s*%d+%s,%s,%s",
  295.     label[i], var_name[i],
  296.     limit_name[i], initial_name[i], increment_name[i],
  297.     increment_name[i], unroll_depth,
  298.     increment_name[i], unroll_depth,
  299.     initial_name[i], limit_name[i], increment_name[i] ) ;
  300. dump( out_buff ) ;
  301.  
  302. /* make the remaining do statements */
  303. for ( i = var_count-2; i >= 0; i-- ) {
  304.     sprintf( out_buff, "      do %s %s = %s, %s, %s",
  305.         label[i], var_name[i],
  306.         initial_name[i], limit_name[i], increment_name[i] ) ;
  307.     dump( out_buff ) ;
  308. }
  309. }
  310.  
  311.  
  312. /* make the continue statements */
  313. make_continue() {
  314. int    i ;
  315.  
  316. for ( i = 0; i < var_count; i++ ) {
  317.     sprintf( out_buff, "%s continue", label[i] ) ;
  318.     dump( out_buff ) ; }
  319. }
  320.  
  321.  
  322.  
  323.  
  324. /* Function MAKE_LABELS.C
  325.  *
  326.  * Make var_count labels, starting with label_count
  327.  * + 10000.
  328.  *
  329.  * P. R. OVE  11/9/85
  330.  */
  331.  
  332. make_labels()
  333. {                  
  334. int    i, count ;
  335.                     
  336. for ( i = 0; i < var_count; i++ ) {
  337.      
  338.     count = 10000 + label_count ;
  339.     label_count++ ;              
  340.     if ( count > 12499 ) { 
  341.         sprintf( errline, "MAKE_LABELS: too many labels: %s", in_buff ) ;
  342.         abort( errline ) ;
  343.     }
  344.     sprintf( label[i], "%d", count ) ;
  345. }
  346. }
  347.  
  348.  
  349.  
  350. /* Function OSQB_PROC.C
  351.  *
  352.  *   Process open square brackets.  This routine will be
  353.  * called when an open square bracket is found in the
  354.  * record (start cluster of vector arithmetic).  It sets
  355.  * up the labels and sets vec_flag so that dump will direct
  356.  * output to mem_store instead of the output file.
  357.  *   The initial do statements are not written here, so that
  358.  * unrolling can be turned off if there are too many lines
  359.  * ( > line_limit ) in the loop.  Endvec will write them.
  360.  *   If a closing ] is also found in the same record then
  361.  * the statement is passed through transvec immediately, since
  362.  * it has already been processed by the rest of the preprocessor.
  363.  *
  364.  * P. R. OVE  11/9/85
  365.  */
  366.  
  367. osqb_proc() 
  368. {
  369. int    i, quote=1 ;
  370.  
  371. /* if default loop limits have not been set abort here */
  372. if ( var_count <= 0 ) {
  373.     sprintf( errline, "Vector loop without default limits set: %s", in_buff ) ;
  374.     abort( errline ) ;
  375. }
  376.  
  377. make_labels() ;        /* get a list of labels */
  378.  
  379. vec_flag = TRUE ;    /* now force output --> mem_store */
  380.                       
  381. /* see what in_buff contains and replace unquoted [] by blanks */
  382. for ( i = 0; in_buff[i] != NULL; i++ ) {
  383.  
  384.     switch ( in_buff[i] ) {
  385.     
  386.     case '\'' :    quote = -quote ;
  387.             break ;
  388.     case '[' :    if ( quote == 1 ) {
  389.                 in_buff[i] = BLANK ;
  390.                 break ;
  391.             }
  392.     case ']' :    if ( quote == 1 ) {
  393.                 vec_flag = FALSE ;
  394.                 in_buff[i] = BLANK ;
  395.                 break ;
  396.             }
  397.     }
  398. }
  399.  
  400. /* if there is a closing ] process the line now */
  401. if ( NOT vec_flag ) {
  402.     vec_flag = TRUE ;    /* force line to mem_store */
  403.     dump( in_buff ) ;
  404.     end_vec() ;        /* flag will be reset here */
  405. }
  406. else dump( in_buff ) ;        /* this will go to mem_store */
  407.  
  408. IN_BUFF_DONE ;
  409. }
  410.  
  411.  
  412.  
  413.  
  414. /* Function TRANSVEC.C
  415.  *
  416.  * Translate a record of vectored arithmetic and expand
  417.  * out the # signs.  The resulting expanded record is
  418.  * placed in out_buff and dumped.  The second argument
  419.  * is related to unrolling, and is the amount to be
  420.  * added to the index of the outermost loop.  This
  421.  * should be zero if unrolling is off.  Quoted characters
  422.  * are ignored ( ' is the fortran quote character ).
  423.  *
  424.  * P. R. OVE  11/9/85
  425.  */
  426.  
  427. /* copy character verbatim to the output buffer */
  428. #define    VERBATIM    out_buff[i_out] = string[i_in] ;\
  429.             out_buff[i_out + 1] = NULL ;    \
  430.             i_out++ ;
  431.  
  432.  
  433. transvec( string, outer_loop_inc ) 
  434. char    *string ;
  435. int    outer_loop_inc ;
  436. {
  437. int    i_in, i_out = 0, i_var = 0, quote = 1 ;
  438. char    *pntr ;
  439.  
  440. /* make string version of loop counter increment */
  441. if ( UNROLLING ) {
  442.     GET_MEM( pntr, strlen(increment_name[var_count-1]) + abs(outer_loop_inc) + 10 ) ;
  443.     sprintf( pntr, "+%s*%d", increment_name[ var_count - 1 ],
  444.         outer_loop_inc ) ;
  445. }
  446.  
  447. /* loop over the input record */
  448. for ( i_in = 0; string[i_in] != NULL; i_in++ ) {
  449.  
  450. /* pass characters straight through if quoted */
  451. if ( string[i_in] == '\'' ) quote = -quote ;
  452. if ( quote == -1 ) {
  453.     VERBATIM ;
  454.     continue ;
  455. }
  456.  
  457. switch( string[i_in] ) {
  458.  
  459.     /* replace #'s with variable names */
  460.     case '#' :    strcat( out_buff, var_name[i_var] ) ;
  461.             i_out += 4 ;
  462.             i_var++ ;   
  463.             if ( i_var >= var_count ) {
  464.                 i_var = 0 ;
  465.                 if (UNROLLING && outer_loop_inc != 0) {
  466.                     strcat( out_buff, pntr ) ;
  467.                     i_out += strlen( pntr ) ;
  468.                 }
  469.             }
  470.             break ;
  471.  
  472.     /* reset variable counter */
  473.     case ')' :    out_buff[i_out] = ')' ;
  474.             out_buff[i_out + 1] = NULL ;
  475.             i_out++ ;
  476.             i_var = 0 ;
  477.             break ;
  478.  
  479.     /* copy character verbatim */
  480.     default :     VERBATIM ;
  481.  
  482. }
  483. }
  484.  
  485. if (UNROLLING) free( pntr ) ;
  486. dump( out_buff ) ;
  487.  
  488. IN_BUFF_DONE ;
  489. }
  490.  
  491.  
  492.  
  493.  
  494. /* Function UNROLL_PROC
  495.  *
  496.  * Change the unrolling depth.  If depth is less than 2 unrolling is off.
  497.  *
  498.  * P. R. OVE  6/18/86
  499.  */
  500.  
  501. unroll_proc()     
  502. {                  
  503. int    n ;
  504. char    *open_parens, *close_parens ;
  505.  
  506. /* get the expression delimeters */
  507. open_parens = line_end( first_nonblank + name_length ) ;
  508. close_parens = mat_del( open_parens ) ;
  509.                                            
  510. /* if there is stuff on the line (open_parens != NULL) and no            */
  511. /* open parens (close_parens == NULL) assume variable name like UNROLLit */
  512. if ( (open_parens != NULL) && (close_parens == NULL) ) return ;
  513.  
  514. /* get the depth if it is there (error ==> depth = 0 (OFF)) */
  515. if (open_parens != NULL) {
  516.     n = close_parens - open_parens - 1 ;
  517.     *close_parens == NULL ;
  518.     unroll_depth = atoi( open_parens + 1 ) ;
  519. }
  520. else {    unroll_depth = DEF_UNROLL_DEPTH ; }
  521.  
  522. IN_BUFF_DONE
  523. }
  524.  
  525.  
  526.  
  527.  
  528. /* Function VEC_PROC.C
  529.  *
  530.  * This routine's functions when a "naked"
  531.  * (with out surrounding [ ]) vector statement is found.
  532.  * The action depends on whether vec_flag is set or not.
  533.  * If set:
  534.  *   The record is dumped (to mem_store).
  535.  * If not:
  536.  *   It is handled by placing a [ at the beginning and a
  537.  * ] at the end and then starting over.  OSQB_PROC will
  538.  * then trap it and pass it to END_VEC to be processed.
  539.  *
  540.  * P. R. OVE  11/9/85
  541.  */
  542.  
  543. vec_proc()
  544. {
  545. int    i, length ;
  546.  
  547. /* if default loop limits have not been set abort here */
  548. if ( var_count <= 0 ) {
  549.     sprintf( errline, "Vector loop without default limits set: %s", in_buff ) ;
  550.     abort( errline ) ;
  551. }
  552.                       
  553. if ( vec_flag ) {
  554.     dump( in_buff ) ;    /* --> mem_store */
  555.     IN_BUFF_DONE ;
  556. }
  557. else {
  558.     length = strlen( in_buff ) ;
  559.     for ( i = length - 1; i >= 0; i-- ) in_buff[i+1] = in_buff[i] ;
  560.     in_buff[ length + 1 ] = ']' ;
  561.     in_buff[ length + 2 ] = NULL ;
  562.     in_buff[ 0 ] = '[' ;
  563. }
  564. }
  565.