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 / FLOW.C < prev    next >
C/C++ Source or Header  |  1991-08-16  |  19KB  |  787 lines
  1. /* Flow control extensions and related routines */
  2.  
  3. #include "prep.h"
  4.  
  5. /* data declarations for the routines in the flow control set */
  6. char    *case_exp[NESTING] ;        /* case expression storage */
  7. char    *exp ;                /* general expression storage pointer */
  8. char    alabel[NESTING][6] ;        /* again label storage */
  9. char    blabel[NESTING][6] ;        /* begin label storage */
  10. char    clabel[NESTING][6] ;        /* case label storage */
  11. char    dlabel[NESTING][6] ;        /* do/end_do label storage */
  12. char    elabel[NESTING][6] ;        /* leave_do label storage */
  13.  
  14. int    of_count[NESTING] ;   /* counters for of statements */
  15. int    leave_do_flag[NESTING] ;   /* marks if leave_do in current loop */
  16.  
  17. int    alabel_count = 0 ;    /* alabel = alabel_count + 15000 */
  18. int    blabel_count = 0 ;    /* blabel = blabel_count + 17500 */
  19. int    clabel_count = 0 ;    /* clabel = clabel_count + 20000 */
  20. int    dlabel_count = 0 ;    /* dlabel = dlabel_count + 12500 */
  21. int    elabel_count = 0 ;    /* elabel = elabel_count + 22500 */
  22.  
  23. int    do_count = 0 ;        /* nesting counter for do/end_do */
  24. int    begin_count = 0 ;     /* nesting counter for begin ... loops */
  25. int    case_count = 0 ;      /* case nesting level */
  26.  
  27.  
  28.  
  29.  
  30. /* FLOW_INIT
  31.  *
  32.  * Initialize the flow control routines
  33.  */
  34. flow_init()
  35. {
  36. int i ;
  37.  
  38. for ( i = 0; i < NESTING; i++ ) leave_do_flag[i] = FALSE ;
  39. }
  40.  
  41.  
  42.  
  43. /* Function AGAIN_PROC
  44.  *
  45.  * Process again statements.
  46.  * 3/2/86
  47.  */
  48.  
  49. again_proc()     
  50. {                  
  51.  
  52. /* on missing begin statement, abort */
  53. if ( begin_count <= 0 ) {
  54.     sprintf( errline, "Again: no matching begin: %s", in_buff ) ;
  55.     abort( errline ) ;
  56. }
  57.  
  58. /* construct the goto statement back to begin */
  59. sprintf( out_buff, "      goto %s", blabel[begin_count] ) ;
  60. dump( out_buff ) ;
  61.  
  62. /* construct label statement */
  63. sprintf( out_buff, "%s continue", alabel[begin_count] ) ;
  64. dump( out_buff ) ;
  65.  
  66. begin_count-- ;
  67. IN_BUFF_DONE
  68. }
  69.  
  70.  
  71.  
  72.  
  73. /* Function BEGIN_PROC.C
  74.  *
  75.  * Process begin statements.  Construct a label for the
  76.  * while, until, and again statements to branch to.  The
  77.  * label for again is created here as well.
  78.  *
  79.  * P. R. OVE  3/2/86
  80.  */
  81.  
  82. begin_proc() 
  83. {
  84. int    count ;
  85.                       
  86. /* keep track of the nesting */
  87. begin_count++ ;
  88. if ( begin_count >= NESTING ) {
  89.     sprintf( errline, "Begin: nesting too deep: %s", in_buff ) ;
  90.     abort( errline ) ;
  91. }
  92.  
  93. /* make up a label (for begin) and store it in blabel[begin_count] */
  94. count = 17500 + blabel_count ;
  95. blabel_count++ ;
  96. if ( count > 19999 ) {
  97.     sprintf( errline, "Begin: too many labels: %s", in_buff ) ;
  98.     abort( errline ) ;
  99. }
  100. sprintf( blabel[begin_count], "%d", count ) ;
  101.  
  102. /* make up a label (for again) and store it in alabel[begin_count] */
  103. count = 15000 + alabel_count ;
  104. alabel_count++ ;
  105. if ( count > 17499 ) {
  106.     sprintf( errline, "Begin: too many labels: %s", in_buff ) ;
  107.     abort( errline ) ;
  108. }
  109. sprintf( alabel[begin_count], "%d", count ) ;
  110.  
  111. /* construct and dump the output record */
  112. sprintf( out_buff, "%s continue", blabel[begin_count] ) ;
  113. dump( out_buff ) ;
  114.  
  115. IN_BUFF_DONE
  116. }                            
  117.  
  118.  
  119.  
  120.  
  121. /* Function CASE_PROC
  122.  *
  123.  * Process again statements.
  124.  * 11/9/85
  125.  */
  126.  
  127. case_proc()     
  128. {                  
  129. int    n, count ;
  130. char    *open_parens, *close_parens ;
  131.  
  132. /* get the comparison expression */
  133. open_parens = line_end( first_nonblank + name_length ) ;
  134. close_parens = mat_del( open_parens ) ;
  135.  
  136. /* if char after case is not a blank, tab, or delimeter assume a */
  137. /* variable name beginning with case                             */
  138. if ((close_parens == NULL) && (open_parens == first_nonblank + name_length))
  139.     return ;
  140.  
  141. /* keep track of the nesting */
  142. case_count++ ;
  143. if ( case_count >= NESTING ) {
  144.     sprintf( errline, "Case: nesting too deep: %s", in_buff ) ;
  145.     abort( errline ) ;
  146. }
  147.  
  148. /* get logical expression, set to NULL if it is missing */
  149. if ( open_parens == NULL ) { 
  150.     case_exp[ case_count ][0] = NULL ;
  151. }
  152. else {  
  153.     if ( close_parens == NULL ) {
  154.         sprintf( errline, "Case: missing delimeter: %s", in_buff ) ;
  155.         abort( errline ) ;
  156.     }
  157.     n = close_parens - open_parens - 1 ;
  158.     GET_MEM( case_exp[case_count], n+5 ) ;
  159.     case_exp[case_count][0] = '(' ;
  160.     strncpy( case_exp[case_count] + 1, open_parens + 1, n ) ;
  161.     case_exp[case_count][n+1] = ')' ;
  162.     case_exp[case_count][n+2] = NULL ;
  163. }                              
  164.  
  165.  
  166. /* make label for continue to return to, store it in clabel[case_count] */
  167. count = 20000 + clabel_count ;
  168. clabel_count++ ;
  169. if ( count > 22499 ) {
  170.     sprintf( errline, "Case: too many labels: %s", in_buff ) ;
  171.     abort( errline ) ;
  172. }
  173. sprintf( clabel[case_count], "%d", count ) ;
  174.  
  175. /* construct and dump the output record */
  176. sprintf( out_buff, "%s continue", clabel[case_count] ) ;
  177. dump( out_buff ) ;
  178.  
  179.  
  180. /* signal that in_buff is empty */
  181. IN_BUFF_DONE
  182. }
  183.  
  184.  
  185.  
  186.  
  187. /* Function CONTINUE_CASE_PROC
  188.  *
  189.  * Process continue_case statements (part of case construct).
  190.  *
  191.  * P. R. OVE  10/10/86
  192.  */
  193.  
  194. continue_case_proc()     
  195. {                  
  196. int    n, count ;
  197. char    *pntr, *open_parens, *close_parens ;
  198.  
  199. /* get the comparison expression */
  200. open_parens = line_end( first_nonblank + name_length ) ;
  201. close_parens = mat_del( open_parens ) ;
  202.                                            
  203. /* if there is stuff on the line (open_parens != NULL) and no open
  204.  * parens (close_parens == NULL) assume variable name */
  205. if ( (open_parens != NULL) && (close_parens == NULL) ) return ;
  206.  
  207. /* on missing case statement, abort */
  208. if ( case_count <= 0 ) {
  209.     sprintf( errline, "CONTINUE_CASE: no matching CASE: %s", in_buff ) ;
  210.     abort( errline ) ;
  211. }
  212.                                    
  213. /* get the logical expression if there is one */
  214. if (open_parens != NULL) {
  215.     n = close_parens - open_parens - 1 ;
  216.     GET_MEM( exp, n+5 ) ;
  217.     exp[0] = '(' ;
  218.     strncpy( exp + 1, open_parens + 1, n ) ;
  219.     exp[n+1] = ')' ;
  220.     exp[n+2] = NULL ;
  221. }
  222.  
  223. /* construct and dump the jump back to the case statement */
  224. if (open_parens != NULL) {
  225.     strcpy( out_buff, "      if " ) ;
  226.     strcat( out_buff, exp ) ;
  227.     strcat( out_buff, " goto " ) ;
  228.     strcat( out_buff, clabel[case_count] ) ;
  229.     free( exp ) ;
  230. }
  231. else {
  232.     strcpy( out_buff, "      goto " ) ;
  233.     strcat( out_buff, clabel[case_count] ) ;
  234. }
  235.  
  236. dump( out_buff ) ;
  237.  
  238. IN_BUFF_DONE
  239. }
  240.  
  241.  
  242.  
  243.  
  244. /* Function CONTINUE_DO_PROC
  245.  *
  246.  * Process continue_do statements (part of do/end_do construct).
  247.  *
  248.  * P. R. OVE  11/13/86
  249.  */
  250.  
  251. continue_do_proc()     
  252. {                  
  253. int    n, count ;
  254. char    *pntr, *open_parens, *close_parens ;
  255.  
  256. /* get the comparison expression */
  257. open_parens = line_end( first_nonblank + name_length ) ;
  258. close_parens = mat_del( open_parens ) ;
  259.                                            
  260. /* if there is stuff on the line (open_parens != NULL) and no open
  261.  * parens (close_parens == NULL) assume variable name like CONTINUE_DOit */
  262. if ( (open_parens != NULL) && (close_parens == NULL) ) return ;
  263.  
  264. /* on missing do statement, abort */
  265. if ( do_count <= 0 ) {
  266.     sprintf( errline, "CONTINUE_DO: not in do/end_do loop: %s", in_buff ) ;
  267.     abort( errline ) ;
  268. }
  269.                                     
  270. /* get the logical expression if there is one */
  271. if (open_parens != NULL) {
  272.     n = close_parens - open_parens - 1 ;
  273.     GET_MEM( exp, n+5 ) ;
  274.     exp[0] = '(' ;
  275.     strncpy( exp + 1, open_parens + 1, n ) ;
  276.     exp[n+1] = ')' ;
  277.     exp[n+2] = NULL ;
  278. }
  279.  
  280. /* construct and dump the jump to the end_do label */
  281. if (open_parens != NULL) {
  282.     strcpy( out_buff, "      if " ) ;
  283.     strcat( out_buff, exp ) ;
  284.     strcat( out_buff, " goto " ) ;
  285.     strcat( out_buff, dlabel[do_count] ) ;
  286.     free( exp ) ;
  287. }
  288. else {
  289.     strcpy( out_buff, "      goto " ) ;
  290.     strcat( out_buff, dlabel[do_count] ) ;
  291. }
  292.  
  293. dump( out_buff ) ;
  294.  
  295. IN_BUFF_DONE
  296. }
  297.  
  298.  
  299.  
  300.  
  301. /* Function CONTINUE_PROC
  302.  *
  303.  * Process continue statements (part of begin construct).
  304.  *
  305.  * P. R. OVE  10/10/86
  306.  */
  307.  
  308. continue_proc()     
  309. {                  
  310. int    n, count ;
  311. char    *pntr, *open_parens, *close_parens ;
  312.  
  313. /* get the comparison expression */
  314. open_parens = line_end( first_nonblank + name_length ) ;
  315. close_parens = mat_del( open_parens ) ;
  316.                                            
  317. /* if there is stuff on the line (open_parens != NULL) and no open
  318.  * parens (close_parens == NULL) assume variable name like CONTINUEit */
  319. if ( (open_parens != NULL) && (close_parens == NULL) ) return ;
  320.  
  321. /* on missing begin statement, abort */
  322. if ( begin_count <= 0 ) {
  323.     sprintf( errline, "CONTINUE: no matching BEGIN: %s", in_buff ) ;
  324.     abort( errline ) ;
  325. }
  326.                                    
  327. /* get the logical expression if there is one */
  328. if (open_parens != NULL) {
  329.     n = close_parens - open_parens - 1 ;
  330.     GET_MEM( exp, n+5 ) ;
  331.     exp[0] = '(' ;
  332.     strncpy( exp + 1, open_parens + 1, n ) ;
  333.     exp[n+1] = ')' ;
  334.     exp[n+2] = NULL ;
  335. }
  336.  
  337. /* construct and dump the back to the begin statement */
  338. if (open_parens != NULL) {
  339.     strcpy( out_buff, "      if " ) ;
  340.     strcat( out_buff, exp ) ;
  341.     strcat( out_buff, " goto " ) ;
  342.     strcat( out_buff, blabel[begin_count] ) ;
  343.     free( exp ) ;
  344. }
  345. else {
  346.     strcpy( out_buff, "      goto " ) ;
  347.     strcat( out_buff, blabel[begin_count] ) ;
  348. }
  349.  
  350. dump( out_buff ) ;
  351.  
  352. IN_BUFF_DONE
  353. }
  354.  
  355.  
  356.  
  357.  
  358. /* Function DEFAULT_PROC
  359.  *
  360.  * Process default statements.
  361.  *
  362.  * P. R. OVE  11/9/85
  363.  */
  364.  
  365. default_proc()     
  366. {                  
  367. char    *pntr ;
  368.  
  369. if ( case_count <= 0 ) {
  370.     sprintf( errline, "DEFAULT: no matching CASE: %s", in_buff ) ;
  371.     abort( errline ) ;
  372. }
  373.  
  374. dump( "      else" ) ;
  375.  
  376. /* eliminate "default" from the input buffer */
  377. pntr = line_end( first_nonblank + name_length ) ;
  378. if ( pntr != NULL ) {
  379.     strcpy( in_buff, "\t" ) ;
  380.     strcat( in_buff, pntr ) ;
  381. }
  382. else { IN_BUFF_DONE }
  383.  
  384. }
  385.  
  386.  
  387.  
  388.  
  389. /* Function DO_PROC
  390.  *
  391.  * Process do statements.  If there is a label (ala
  392.  * fortran) just dump it to the output.  If no label
  393.  * exists make one up in anticipation of an eventual
  394.  * end_do statement.
  395.  *
  396.  * P. R. OVE  11/9/85
  397.  */
  398.  
  399. do_proc() 
  400. {
  401. char    *after_do, *pntr ;
  402. int    count ;
  403.                       
  404. /* return without processing if the first nonblank char after DO is a label
  405.    or if there is no blank/tab after the DO */
  406. pntr = first_nonblank + name_length ;
  407. after_do = line_end( pntr ) ;
  408. if ( ( strchr( "0123456789", *after_do ) != NULL ) | 
  409.      ( after_do == pntr )                            ) return ;
  410.                       
  411. /* keep track of the nesting */
  412. do_count++ ;
  413. if ( do_count >= NESTING ) {
  414.     sprintf( errline, "DO: nesting too deep: %s", in_buff ) ;
  415.     abort( errline ) ;
  416. }
  417.  
  418. /* make up a label and store it in dlabel[do_count] */
  419. count = 12500 + dlabel_count ;
  420. dlabel_count++ ;
  421. if ( count > 14999 ) {
  422.     sprintf( errline, "DO: too many labels: %s", in_buff ) ;
  423.     abort( errline ) ;
  424. }
  425. sprintf( dlabel[do_count], "%d", count ) ;
  426.  
  427. /* make label for leave_do to jump to and store it in elabel[do_count] */
  428. count = 22500 + elabel_count ;
  429. elabel_count++ ;
  430. if ( count > 24999 ) {
  431.     sprintf( errline, "DO: too many labels: %s", in_buff ) ;
  432.     abort( errline ) ;
  433. }
  434. sprintf( elabel[do_count], "%d", count ) ;
  435.  
  436. /* construct and dump the output record */
  437. sprintf( out_buff, "      do %s %s", dlabel[do_count], after_do ) ;
  438. dump( out_buff ) ;
  439.  
  440. IN_BUFF_DONE
  441. }                            
  442.  
  443.  
  444.  
  445. /* Function END_CASE_PROC
  446.  *
  447.  * Process end_case statements.
  448.  *
  449.  * P. R. OVE  11/9/85
  450.  */
  451.  
  452. end_case_proc()
  453. {                  
  454.     of_count[ case_count ] = 0 ;
  455.     free( case_exp[ case_count ] ) ;
  456.     case_count-- ;
  457.     IN_BUFF_DONE
  458.  
  459.     if ( case_count < 0 ) { 
  460.         case_count = 0 ;
  461.         return ; }        
  462.         
  463.     dump( "      end if" ) ;
  464. }
  465.  
  466.  
  467.  
  468.  
  469. /* Function END_DO_PROC
  470.  *
  471.  * Process end_do statements.  Use the label indexed
  472.  * by the current value of do_count (the do nesting
  473.  * index).
  474.  *
  475.  * P. R. OVE  11/9/85
  476.  */
  477.  
  478. end_do_proc() 
  479. {
  480.                       
  481. /* signal error if no matching do has been found */
  482. if ( do_count <= 0 )  {
  483.     sprintf( errline, "END_DO: no matching do: %s", in_buff ) ;
  484.     abort( errline ) ;
  485. }
  486.  
  487. /* construct and dump the normal do loop continue statement */
  488. sprintf( out_buff, "%s continue", dlabel[do_count] ) ;
  489. dump( out_buff ) ;
  490.  
  491. /* construct and dump the leave_do label if needed */
  492. if ( leave_do_flag[do_count] == TRUE ) {
  493.     sprintf( out_buff, "%s continue", elabel[do_count] ) ;
  494.     dump( out_buff ) ;
  495.     leave_do_flag[do_count] = FALSE ;
  496. }
  497.  
  498. do_count -= 1 ;
  499. IN_BUFF_DONE
  500. }                            
  501.  
  502.  
  503.  
  504.  
  505. /* Function LEAVE_DO_PROC
  506.  *
  507.  * Process leave_do statements.
  508.  *
  509.  * P. R. OVE  3/2/86
  510.  */
  511.  
  512. leave_do_proc()     
  513. {                  
  514. int    n, count ;
  515. char    *pntr, *open_parens, *close_parens ;
  516.  
  517. /* get the comparison expression */
  518. open_parens = line_end( first_nonblank + name_length ) ;
  519. close_parens = mat_del( open_parens ) ;
  520.                                            
  521. /* if there is stuff on the line (open_parens != NULL) and no              */
  522. /* open parens (close_parens == NULL) assume variable name like LEAVE_DOit */
  523. if ( (open_parens != NULL) && (close_parens == NULL) ) return ;
  524.  
  525. /* on missing do statement, abort */
  526. if ( do_count <= 0 ) {
  527.     sprintf( errline, "LEAVE_DO: not in do/end_do loop: %s", in_buff ) ;
  528.     abort( errline ) ;
  529. }
  530.                                     
  531. /* get the logical expression if there is one */
  532. if (open_parens != NULL) {
  533.     n = close_parens - open_parens - 1 ;
  534.     GET_MEM( exp, n+5 ) ;
  535.     exp[0] = '(' ;
  536.     strncpy( exp + 1, open_parens + 1, n ) ;
  537.     exp[n+1] = ')' ;
  538.     exp[n+2] = NULL ;
  539. }
  540.  
  541. /* construct and dump the jump out of the loop */
  542. if (open_parens != NULL) {
  543.     strcpy( out_buff, "      if " ) ;
  544.     strcat( out_buff, exp ) ;
  545.     strcat( out_buff, " goto " ) ;
  546.     strcat( out_buff, elabel[do_count] ) ;
  547.     free( exp ) ;
  548. }
  549. else {
  550.     strcpy( out_buff, "      goto " ) ;
  551.     strcat( out_buff, elabel[do_count] ) ;
  552. }
  553.  
  554. leave_do_flag[do_count] = TRUE ;
  555.  
  556. dump( out_buff ) ;
  557.  
  558. IN_BUFF_DONE
  559. }
  560.  
  561.  
  562.  
  563.  
  564. /* Function LEAVE_PROC
  565.  *
  566.  * Process leave statements.
  567.  *
  568.  * P. R. OVE  3/2/86
  569.  */
  570.  
  571. leave_proc()     
  572. {                  
  573. int    n, count ;
  574. char    *pntr, *open_parens, *close_parens ;
  575.  
  576. /* get the comparison expression */
  577. open_parens = line_end( first_nonblank + name_length ) ;
  578. close_parens = mat_del( open_parens ) ;
  579.                                            
  580. /* if there is stuff on the line (open_parens != NULL) and no           */
  581. /* open parens (close_parens == NULL) assume variable name like LEAVEit */
  582. if ( (open_parens != NULL) && (close_parens == NULL) ) return ;
  583.  
  584. /* on missing begin statement, abort */
  585. if ( begin_count <= 0 ) {
  586.     sprintf( errline, "LEAVE: no matching begin: %s", in_buff ) ;
  587.     abort( errline ) ;
  588. }
  589.                                     
  590. /* get the logical expression if there is one */
  591. if (open_parens != NULL) {
  592.     n = close_parens - open_parens - 1 ;
  593.     GET_MEM( exp, n+5 ) ;
  594.     exp[0] = '(' ;
  595.     strncpy( exp + 1, open_parens + 1, n ) ;
  596.     exp[n+1] = ')' ;
  597.     exp[n+2] = NULL ;
  598. }
  599.  
  600. /* construct and dump the jump to again */
  601. if (open_parens != NULL) {
  602.     strcpy( out_buff, "      if " ) ;
  603.     strcat( out_buff, exp ) ;
  604.     strcat( out_buff, " goto " ) ;
  605.     strcat( out_buff, alabel[begin_count] ) ;
  606.     free( exp ) ;
  607. }
  608. else {
  609.     strcpy( out_buff, "      goto " ) ;
  610.     strcat( out_buff, alabel[begin_count] ) ;
  611. }
  612.  
  613. dump( out_buff ) ;
  614.  
  615. IN_BUFF_DONE
  616. }
  617.  
  618.  
  619.  
  620. /* Function OF_PROC
  621.  *
  622.  * Process of statements.
  623.  *
  624.  * P. R. OVE  11/9/85
  625.  */
  626.  
  627. of_proc()     
  628. {                  
  629. int    n ;
  630. char    *pntr, *open_parens, *close_parens ;
  631.  
  632. /* get the comparison expression */
  633. open_parens = line_end( first_nonblank + name_length) ;
  634. close_parens = mat_del( open_parens ) ;
  635.                                            
  636. /* if no open parens assume variable name like OFile */
  637. /* (no open parens <==> close_parens will be NULL)   */
  638. if ( close_parens == NULL ) return ;
  639.  
  640. /* abort on missing case statement */
  641. if ( case_count <= 0 ) {
  642.     sprintf( errline, "OF: missing CASE statement: %s", in_buff ) ;
  643.     abort( errline ) ;
  644. }
  645.  
  646. /* keep track of "of's" for each case level */
  647. of_count[ case_count ] += 1 ;
  648.  
  649. /* get the logical expression */
  650. n = close_parens - open_parens - 1 ;
  651. GET_MEM( exp, n+5 ) ;
  652. exp[0] = '(' ;
  653. strncpy( exp + 1, open_parens + 1, n ) ;
  654. exp[n+1] = ')' ;
  655. exp[n+2] = NULL ;
  656.  
  657. /* construct the "if" or "if else" statement.  If there is a case */
  658. /* logical expression us .eq. to determine the result             */
  659. if ( case_exp[ case_count ][0] == NULL ) {
  660.     if ( of_count[ case_count ] != 1 ) {
  661.         strcpy( out_buff, "      else if " ) ; }
  662.          else {
  663.         strcpy( out_buff, "      if " )      ; }
  664.     strcat( out_buff, exp ) ;
  665.     strcat( out_buff, " then " ) ; }
  666. else {
  667.     if ( of_count[ case_count ] != 1 ) {
  668.         strcpy( out_buff, "      else if (" ) ; }
  669.          else {
  670.         strcpy( out_buff, "      if (" )      ; }
  671.     strcat( out_buff, case_exp[ case_count ] ) ;
  672.     strcat( out_buff, ".eq." ) ;
  673.     strcat( out_buff, exp ) ;
  674.     strcat( out_buff, ") then " ) ; }
  675.                                    
  676. dump( out_buff ) ;
  677.  
  678. /* eliminate "of stuff" from the input buffer */
  679. pntr = line_end( close_parens + 1 ) ;
  680. if ( pntr != NULL ) {
  681.     strcpy( in_buff, "\t" ) ;
  682.     strcat( in_buff, pntr ) ;
  683. }
  684. else { IN_BUFF_DONE }
  685.  
  686. free( exp ) ;
  687. }
  688.  
  689.  
  690.  
  691.  
  692. /* Function UNTIL_PROC
  693.  *
  694.  * Process until statements.
  695.  *
  696.  * P. R. OVE  3/2/86
  697.  */
  698.  
  699. until_proc()     
  700. {                  
  701. int    n, count ;
  702. char    *pntr, *open_parens, *close_parens ;
  703.  
  704. /* get the comparison expression */
  705. open_parens = line_end( first_nonblank + name_length ) ;
  706. close_parens = mat_del( open_parens ) ;
  707.                                            
  708. /* if no open parens assume variable name like UNTILon */
  709. /* (no open parens <==> close_parens will be NULL)   */
  710. if ( close_parens == NULL ) return ;
  711.  
  712. /* on missing begin statement, abort */
  713. if ( begin_count <= 0 ) {
  714.     sprintf( errline, "UNTIL: no matching begin: %s", in_buff ) ;
  715.     abort( errline ) ;
  716. }
  717.                                     
  718. /* get the logical expression */
  719. n = close_parens - open_parens - 1 ;
  720. GET_MEM( exp, n+5 ) ;
  721. exp[0] = '(' ;
  722. strncpy( exp + 1, open_parens + 1, n ) ;
  723. exp[n+1] = ')' ;
  724. exp[n+2] = NULL ;
  725.  
  726. /* construct and dump the conditional jump to begin */
  727. sprintf( out_buff, "      if (.not.%s) goto %s",
  728.     exp, blabel[begin_count] ) ;
  729. dump( out_buff ) ;
  730.  
  731. /* construct a label statement (for leave to jump to) */
  732. sprintf( out_buff, "%s continue", alabel[begin_count] ) ;
  733. dump( out_buff ) ;
  734.  
  735. begin_count-- ;
  736. free( exp ) ;
  737. IN_BUFF_DONE
  738. }
  739.  
  740.  
  741.  
  742.  
  743. /* Function WHILE_PROC
  744.  *
  745.  * Process while statements.
  746.  *
  747.  * P. R. OVE  3/2/86
  748.  */
  749.  
  750. while_proc()     
  751. {                  
  752. int    n, count ;
  753. char    *pntr, *open_parens, *close_parens ;
  754.  
  755. /* get the comparison expression */
  756. open_parens = line_end( first_nonblank + name_length ) ;
  757. close_parens = mat_del( open_parens ) ;
  758.                                            
  759. /* if no open parens assume variable name like WHILEon */
  760. /* (no open parens <==> close_parens will be NULL)   */
  761. if ( close_parens == NULL ) return ;
  762.  
  763. /* on missing begin statement, abort */
  764. if ( begin_count <= 0 ) {
  765.     sprintf( errline, "WHILE: no matching begin: %s", in_buff ) ;
  766.     abort( errline ) ;
  767. }
  768.  
  769. /* get the logical expression */
  770. n = close_parens - open_parens - 1 ;
  771. GET_MEM( exp, n+5 ) ;
  772. exp[0] = '(' ;
  773. strncpy( exp + 1, open_parens + 1, n ) ;
  774. exp[n+1] = ')' ;
  775. exp[n+2] = NULL ;
  776.  
  777. /* construct and dump the output record */
  778. strcpy( out_buff, "      if (.not." ) ;
  779. strcat( out_buff, exp ) ;
  780. strcat( out_buff, ") goto " ) ;
  781. strcat( out_buff, alabel[begin_count] ) ;
  782. dump( out_buff ) ;
  783.  
  784. free( exp ) ;
  785. IN_BUFF_DONE
  786. }
  787.