/*############################################################################## FUNNNELWEB COPYRIGHT ==================== FunnelWeb is a literate-programming macro preprocessor. The FunnelWeb web is at http://www.ross.net/funnelweb/ Copyright (c) Ross N. Williams 1992. All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of Version 2 of the GNU General Public License as published by the Free Software Foundation (http://www.gnu.org/). This program is distributed WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See Version 2 of the GNU General Public License for more details. You should have received a copy of Version 2 of the GNU General Public License along with this program. If not, you can obtain a copy as follows: ftp://prep.ai.mit.edu/pub/gnu/COPYING-2.0 or write to: Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA Section 2a of the license requires that all changes to this file be recorded prominently in this file. Please record all changes here. Programmers: RNW Ross N. Williams (ross@ross.net) Changes: 07-May-1992 RNW Program prepared for release under GNU GPL V2. 09-May-1999 RNW Modified to expand lowest defined library level defn. ##############################################################################*/ /******************************************************************************/ /* TANGLE.C */ /******************************************************************************/ /* Note: In this module, "ex_" at the start of a function name means "expand" */ /* rather than the standard meaning of "ex" of "expression. */ /******************************************************************************/ #include "style.h" #include "as.h" #include "data.h" #include "lister.h" #include "memory.h" #include "misc.h" #include "table.h" #include "tangle.h" #include "writfile.h" /******************************************************************************/ /* The following variable keeps track of the output line number. This is */ /* needed to report lines that are too long. */ LOCVAR ulong lineno; /* Last line for which error message was generated. */ LOCVAR ulong errlin; /* Number of too-long lines seen so far in this file. */ LOCVAR ulong numlong; /* Number of long line error messages we can tolerate per product file. */ #define LONGMESS 5 /* Note: An indentation of n means n blanks before current material. */ /* tgindent is a global variable set by the scanner. It is TRUE if blank */ /* indenting is required and FALSE if no indenting is required. */ LOCVAR ulong ind_base; /* Base indenting level of macro being expanded. */ LOCVAR ulong ind_curr; /* Current indenting position. */ LOCVAR char *fn_targ; /* Name of current (target) product file. */ LOCVAR wf_t f_o; /* Current product file. */ /******************************************************************************/ /* The expression expansion function has to have a forward declaration. */ LOCAL void ex_ex P_((p_ells_t)); /******************************************************************************/ LOCAL void eolblank P_((ulong)); LOCAL void eolblank(n) /* Writes an EOL followed by n blanks to the product file. Efficiently! */ ulong n; { /* The whole aim of this routine is to write blanks EFFICIENTLY. In */ /* particular avoiding any per-char procedure call overhead (e.g. calls to */ /* wf_chr). The best way to avoid this is to create a static array of blanks */ /* and write out large blocks of blanks all at once. */ #define BLANKLEN 100 /* Number of BLANKS in blank array. */ STAVAR bool notinit=TRUE; /* Has blank array been initialized? */ STAVAR char blanks[1+BLANKLEN]; /* EOL followed by BLANKLEN blanks. */ /* Set up the blank array. This only ever done once because of the static */ /* boolean. Note that use of an initialized static here does not make the */ /* code non-reentrant, as the state does not change after initialization. */ if (notinit) {blanks[0]=EOL; memset(blanks+1,' ',(size_t) BLANKLEN); notinit=FALSE;} /* The most common case will be a small indentation. Do this case fast. */ if (n<=BLANKLEN) wf_blk(&f_o,&blanks[0],(size_t) n+1); else { /* We now know that n>=BLANKLEN. Write out a long line with \n at front. */ wf_blk(&f_o,&blanks[0],BLANKLEN+1); n-=BLANKLEN; /* Now get into large scale blank production! */ while (n>0) { ulong len=MIN(n,BLANKLEN); wf_blk(&f_o,&blanks[1],(size_t) len); n-=len; } } } /******************************************************************************/ #define SENDLINE {wl_l(linet1); if (option.op_s_b) wl_sj(linet1);} LOCAL void ex_sc P_((p_sc_t)); LOCAL void ex_sc(p_sc) /* This function writes the specified scrap to the product file. It also */ /* performs two other tasks: */ /* If tgindent==TRUE, inserts indentation at the start of each line. */ /* If tglinmax>0, checks for product file lines longer than tglinmax. */ /* Note: The speed of this routine is fairly critical. */ p_sc_t p_sc; { /* Output of a scrap is straightforward if we are not inserting indentation */ /* or watching for lines that are too long. If neither of these tasks have */ /* to be performed, we can bang the scrap out directly with a wf_blk. */ if (!tgindent && tglinmax==TGMAXINF) { wf_blk(&f_o, p_sc->sc_first, (size_t) (p_sc->sc_last-p_sc->sc_first+1)); return; } /* Otherwise it gets rather messy. Basically, we have to watch for end of */ /* lines and perform special actions there. */ /* ind_curr is the number of characters already written to the current line. */ { char *p = p_sc->sc_first; char *p_post = p_sc->sc_last+1; while (TRUE) { char *p_sot = p; /* SOT=Start of Text. */ /* Scan scrap until we hit either its end or an EOL. */ while (p!=p_post && *p!=EOL) p++; /* Assert: p==p_post || (p_sot<=pp_sot) {wf_blk(&f_o,p_sot,(size_t) (p-p_sot));ind_curr+=p-p_sot;} /* Check that what we have written so far is not too long. */ /* Performing this check here rather than with the EOL processing */ /* means that we will detect overlong final non-EOL terminated lines. */ /* Use of errlin suppresses multiple errors on the same line. */ /* Note: We assume that TGMAXINF is very large. */ if (ind_curr>tglinmax && lineno!=errlin) { numlong++; if (numlong <= LONGMESS) { if (option.op_b7_b) sprintf(linet1, "E: Product file line is too long (line %lu of \"%s\").", (ulong) lineno,SUPPNAME); else sprintf(linet1, "E: Product file line is too long (line %lu of \"%s\").", (ulong) lineno,fn_targ); SENDLINE; if (numlong==1) { sprintf(linet1," Product file line length limit is %lu characters.", (ulong) tglinmax); SENDLINE; sprintf(linet1," Note: You can change the limit by specifying."); SENDLINE; sprintf(linet1," @p maximum_output_line_length = "); SENDLINE; sprintf(linet1," somewhere in the input file."); SENDLINE; } errlin=lineno; num_err++; } if (numlong == LONGMESS+1) { sprintf(linet1, "Further line-too-long warnings for file \"%s\" have been suppressed.", fn_targ); SENDLINE; } } /* Exit if we hit the end of the scrap. */ if (p==p_post) break; /* Move past the EOL and bump up the line counter. */ p++; lineno++; /* Output an EOL with indentation if desired. */ if (tgindent) eolblank(ind_base); else wf_chr(&f_o,EOL); ind_curr=ind_base; } } } /******************************************************************************/ LOCAL void ex_eltx P_((p_el_t)); LOCAL void ex_eltx(p_el) /* Writes the given text element to the product file. */ p_el_t p_el; { p_sc_t p_sc; /* Make sure that we have actually been handed a text element. */ as_cold(p_el->el_kind==EL_TEXT,"ex_eltx: Not a text element!"); /* Write all the scraps in the text list to the product file. */ ls_fir(p_el->el_text); while (TRUE) { ls_nxt(p_el->el_text,PPV &p_sc); if (p_sc==NULL) break; ex_sc(p_sc); } } /******************************************************************************/ LOCAL void ex_elpr P_((p_el_t)); LOCAL void ex_elpr(p_el) /* Write the expansion of the given parameter element to the product file. */ p_el_t p_el; { p_ell3_t actn = p_el->el_which->ma_actn; p_elll_t *pp_parls; p_ells_t *pp_exp; ulong ind_save; /* Make sure that we have been handed a parameter element. */ as_cold(p_el->el_kind==EL_PARM,"ex_elpr: Not a parameter element!"); /* Save the current indentation base and set it to the current level. */ ind_save=ind_base; ind_base=ind_curr; /* Get a pointer to the most recent parameter list of the target macro. */ ls_loo(actn,ls_len(actn),PPV &pp_parls); /* Get the expression corresponding to the el_parno'th parameter. */ ls_loo(*pp_parls,p_el->el_parno,PPV &pp_exp); /* Expand that expression. */ ex_ex(*pp_exp); /* Restore the indentation base. */ ind_base=ind_save; } /******************************************************************************/ LOCAL void ex_elin P_((p_el_t)); LOCAL void ex_elin(p_el) /* Expand invocation element. */ p_el_t p_el; { p_ma_t p_ma; p_bp_t p_bp; ulong ind_save; p_void p_mark; p_md_t p_md; /* Make sure that we have been handed an invocation element. */ as_cold(p_el->el_kind==EL_INVC,"ex_elin: Not an invocation element!"); /* Save the current indentation base and set it to the current level. */ ind_save=ind_base; ind_base=ind_curr; /* Grab a pointer to the macro being invoked. */ p_ma = p_el->el_p_mac; as_cold(maisdef(p_ma),"ex_elin: Macro is undefined!"); p_md = &p_ma->ma_defn[p_ma->ma_minlev]; /* Push the actual parameter list onto the invoked macro's activation list. */ ls_add(p_ma->ma_actn,PV &p_el->el_parls); /* Expand each body part expression. */ ls_fir(p_md->md_body); while (TRUE) { ls_nxt(p_md->md_body,PPV &p_bp); if (p_bp==NULL) break; p_mark=ls_mar(p_md->md_body); /* Protect againt recursion. */ ex_ex(p_bp->bp_ex); ls_set(p_md->md_body,p_mark); } /* Pop the activated macro's parameter list. */ ls_lop(p_ma->ma_actn); /* Restore the indentation base. */ ind_base=ind_save; } /******************************************************************************/ LOCAL void ex_ex(p_exp) /* Expand the specified expression. */ p_ells_t p_exp; { p_void p_mark; /* We need to save the current position in the expression list in case we */ /* are being recursively invoked (e.g. in @@(@"@@(@"sloth@"@)@"@). */ ls_fir(p_exp); while (TRUE) { p_el_t p_el; ls_nxt(p_exp,PPV &p_el); if (p_el==NULL) break; p_mark=ls_mar(p_exp); switch (p_el->el_kind) { case EL_TEXT: ex_eltx(p_el); break; case EL_INVC: ex_elin(p_el); break; case EL_PARM: ex_elpr(p_el); break; default : as_bomb("ex_ex: Case defaulted."); } ls_set(p_exp,p_mark); } } /******************************************************************************/ LOCAL void ex_file P_((p_ma_t)); LOCAL void ex_file(p_ma) /* This function accepts a pointer to a macro. It creates a product file */ /* with the same name as the macro (inheriting any filename parts given in */ /* the command line) and expands the macro, writing the expansion to the */ /* product file. */ p_ma_t p_ma; { fn_t fn_tmp; /* Name of temporary file. */ bool renfil; /* Do we wish to rename product file? */ bool istarg; /* Does a target file already exist? */ /* Writing product files differs to the other output files. With non */ /* critical files such as the listing file that are really just logs, */ /* generation of half a listing file is acceptable if not desirable. However */ /* in the case of product files, it is very bad to generate half a product */ /* file; far better to generate none at all. For this reason, and also */ /* because of the presence of the D option (which prohibits the writing */ /* of product files identical to existing files (to prevent MAKE */ /* propagations)) it is best to write a temporary file and then rename it. */ /* Construct the target file name. */ strcpy(fn_targ,""); /* Start with an empty name. */ fn_ins(fn_targ,&option.op_o_s[0]); fn_ins(fn_targ,&p_ma->ma_name[0]); /* The temporary file has to inherit too, because the output directory may */ /* not be the default directory and some computers can't rename across */ /* directories (and we have to rename it later). */ strcpy(fn_tmp,fn_targ); fn_ins(fn_tmp,fn_temp()); /* Expand the macro to the temporary file. */ wf_ini(&f_o,TRUE); wf_ope(&f_o,fn_tmp); if (wf_err(&f_o)) { sprintf(linet1,"Error creating temporary product file \"%s\".",&fn_tmp[0]); wl_sjl(linet1); (void) remove(fn_tmp); goto severe; } /* Now expand the target macro into the file. */ { el_t el; el.el_kind = EL_INVC; el.el_p_mac = p_ma; el.el_parls = ls_cre(sizeof(p_ells_t)); /* Note: We don't set el_pretx and el_postx as they are not used here. */ ind_base = 0; ind_curr = 0; lineno = 1; errlin = 0; numlong = 0; ex_elin(&el); } /* Make sure that there weren't any errors writing to the product file. */ if (wf_err(&f_o)) { sprintf(linet1,"S: Error writing to temporary product file \"%s\".",&fn_tmp[0]); wl_sjl(linet1); (void) remove(fn_tmp); goto severe; } /* Close the product file. */ wf_clo(&f_o); if (wf_err(&f_o)) { sprintf(linet1,"S: Error closing temporary product file \"%s\".",&fn_tmp[0]); wl_sjl(linet1); (void) remove(fn_tmp); goto severe; } /* The rest of the code in this function copes with the renaming. */ /* By default, we wish to rename the temporary file. */ renfil=TRUE; /* Deal with any existing file of the target name. */ istarg=fexists(fn_targ); if (istarg && option.op_d_b) { /* A target already exists, and the D option is on. If the target is */ /* identical to the temporary, we can simply delete the temporary! */ char *errstr; bool same; errstr=eq_files(fn_tmp,fn_targ,&same); if (errstr != NULL) { wl_sjl("S: Error comparing temporary file with previous product file."); wl_sjl("(A comparison was attempted because the D option was turned on.)"); wl_sjl("Error from comparison routine was as follows (first=temp):"); wr_sjl(" ");wl_sjl(errstr); sprintf(linet1,"Temporary file name was \"%s\".",&fn_tmp[0]); wl_sjl(linet1); sprintf(linet1,"Product file name was \"%s\".",fn_targ); wl_sjl(linet1); wl_sjl("FunnelWeb will leave both files intact so you can look at them."); goto severe; } /* If the two files are the same, we can simply delete the temporary. */ if (same) { int status; status=remove(fn_tmp); if (status != REMOVE_S) { sprintf(linet1,"S: Error deleting (under +D option) temporary file \"%s\".",&fn_tmp[0]); wl_sjl(linet1); goto severe; } sprintf(linet1,"Deleted identical product file \"%s\".",fn_targ); wl_sjl(linet1); renfil=FALSE; } } if (renfil) { int status; /* We need to delete any existing file of the target name. */ if (istarg) { status=remove(fn_targ); if (status != REMOVE_S) { sprintf(linet1,"S: Error deleting existing product file \"%s\".",fn_targ); wl_sjl(linet1); goto severe; } } /* Rename the temporary file to the product file. */ status=rename(fn_tmp,fn_targ); if (status != RENAME_S) { wl_sjl("S: Error renaming temporary product file to product file."); sprintf(linet1,"Temporary file name was \"%s\".",&fn_tmp[0]); wl_sjl(linet1); sprintf(linet1,"Product file name was \"%s\".",fn_targ); wl_sjl(linet1); wl_sjl("FunnelWeb will leave both files intact so you can look at them."); goto severe; } } /* Tell everyone that we have written a product file. */ /* Note that we use the macro name. The full name is usually too messy. */ sprintf(linet1,"Tangle: Completed %s.",&p_ma->ma_name[0]); wl_sjl(linet1); return; /* Jump here is a nasty file error occurs. */ severe: sprintf(linet1,"A problem occurred during the generation of product file \"%s\".",&fn_targ[0]); wl_sjl(linet1); wl_sjl("S: Aborting..."); num_sev++; return; } /******************************************************************************/ EXPORT void tangle() { name_t dummyname; p_ma_t p_ma; /* Possibly decrease tglinmax if W option is turned on. */ if (option.op_w_b) tglinmax=MIN(tglinmax,option.op_w_i); /* Some compilers do not allow much space for statics so we allocate fn_targ */ /* dynamically to save static space. */ fn_targ=(char *) mm_temp(sizeof(fn_t)); /* Generate each file contained in the file table. */ tb_fir(file_table); while (num_sev==0 && tb_rea(file_table,PV dummyname,PV &p_ma)) ex_file(p_ma); } /******************************************************************************/ /* End of TANGLE.C */ /******************************************************************************/