summaryrefslogtreecommitdiff
path: root/agen5/expOutput.c
diff options
context:
space:
mode:
Diffstat (limited to 'agen5/expOutput.c')
-rw-r--r--agen5/expOutput.c934
1 files changed, 934 insertions, 0 deletions
diff --git a/agen5/expOutput.c b/agen5/expOutput.c
new file mode 100644
index 0000000..8404ce2
--- /dev/null
+++ b/agen5/expOutput.c
@@ -0,0 +1,934 @@
+
+/**
+ * @file expOutput.c
+ *
+ * Time-stamp: "2012-04-07 09:20:37 bkorb"
+ *
+ * This module implements the output file manipulation function
+ *
+ * This file is part of AutoGen.
+ * AutoGen Copyright (c) 1992-2012 by Bruce Korb - all rights reserved
+ *
+ * AutoGen is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * AutoGen is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+ * See the GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program. If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#ifndef S_IAMB
+/*
+ * Access Mask Bits (3 special plus RWX for User Group & Others (9))
+ */
+# define S_IAMB (S_ISUID|S_ISGID|S_ISVTX|S_IRWXU|S_IRWXG|S_IRWXO)
+#endif
+
+#define NO_WRITE_MASK ((unsigned)(~(S_IWUSR|S_IWGRP|S_IWOTH) & S_IAMB))
+
+typedef struct {
+ char const * pzSuspendName;
+ out_stack_t* pOutDesc;
+} tSuspendName;
+
+static int suspendCt = 0;
+static int suspAllocCt = 0;
+static tSuspendName* pSuspended = NULL;
+static int outputDepth = 1;
+
+/**
+ * return the current line number
+ */
+static int
+current_line(FILE * fp)
+{
+ int lnno = 1;
+
+ while (! feof(fp)) {
+ int ch = getc(fp);
+ if (ch == NL)
+ lnno++;
+ }
+
+ return lnno;
+}
+
+/**
+ * guts of the output file/line function
+ */
+static SCM
+do_output_file_line(int line_delta, char const * fmt)
+{
+ char * buf;
+ char const * fname = cur_fpstack->stk_fname;
+
+ if (cur_fpstack->stk_flags & FPF_TEMPFILE) {
+ fname = OUTPUT_TEMP_FILE;
+ line_delta = 0;
+
+ } else if (fseek(cur_fpstack->stk_fp, 0, SEEK_SET) == 0) {
+ line_delta += current_line(cur_fpstack->stk_fp);
+
+ } else {
+ line_delta = 0;
+ }
+
+ {
+ size_t sz = strlen(fmt) + strlen(fname) + 24;
+ buf = ag_scribble(sz);
+ }
+
+ {
+ void * args[2] = {
+ (void *)fname,
+ (void *)(uintptr_t)line_delta
+ };
+ sprintfv(buf, fmt, (snv_constpointer *)args);
+ }
+
+ return AG_SCM_STR02SCM(buf);
+}
+
+/**
+ * chmod a-w on a file descriptor.
+ */
+LOCAL void
+make_readonly(void)
+{
+#if defined(HAVE_FSTAT) || defined(HAVE_FCHMOD)
+ int fd = fileno(cur_fpstack->stk_fp);
+#endif
+ struct stat sbuf;
+
+ /*
+ * If the output is supposed to be writable, then also see if
+ * it is a temporary condition (set vs. a command line option).
+ */
+ if (ENABLED_OPT(WRITABLE)) {
+ if (! HAVE_OPT(WRITABLE))
+ CLEAR_OPT(WRITABLE);
+ return;
+ }
+
+ /*
+ * Set our usage mask to all all the access
+ * bits that do not provide for write access
+ */
+#ifdef HAVE_FSTAT
+ fstat(fd, &sbuf);
+#else
+ stat(cur_fpstack->stk_fname, &sbuf);
+#endif
+
+ /*
+ * Mask off the write permission bits, but ensure that
+ * the user read bit is set.
+ */
+ {
+ mode_t f_mode = (NO_WRITE_MASK & sbuf.st_mode) | S_IRUSR;
+
+#ifdef HAVE_FCHMOD
+ fchmod(fd, f_mode);
+#else
+ chmod(cur_fpstack->stk_fname, f_mode);
+#endif
+ }
+}
+
+/**
+ * Some common code for creating a new file
+ */
+LOCAL void
+open_output_file(char const * fname, size_t nmsz, char const * mode, int flags)
+{
+ char * pz;
+ out_stack_t* p = AGALOC(sizeof(*p), "out file stack");
+
+ pz = (char*)AGALOC(nmsz + 1, "file name string");
+ memcpy(pz, fname, nmsz);
+ pz[ nmsz ] = NUL;
+ memset(p, NUL, sizeof(*p));
+ p->stk_fname = pz;
+
+ /*
+ * IF we are creating the file and we are allowed to unlink the output,
+ * then start by unlinking the thing.
+ */
+ if ((*mode == 'w') && ((flags & FPF_NOUNLINK) == 0)) {
+ if ((unlink(pz) != 0) && (errno != ENOENT))
+ AG_CANT(OUTPUT_NO_UNLINK, pz);
+ }
+
+ /*
+ * If we cannot write to the file, try to change permissions.
+ */
+ if ( (access(fname, W_OK) != 0)
+ && (errno != ENOENT)) {
+ struct stat sbuf;
+ if (stat(fname, &sbuf) == 0) {
+ mode_t m = (sbuf.st_mode & 07777) | S_IWUSR;
+ chmod(fname, m);
+ }
+ }
+
+ p->stk_fp = fopen(pz, mode);
+ if (p->stk_fp == NULL)
+ AG_CANT(OUTPUT_NO_OPEN, pz);
+
+ p->stk_prev = cur_fpstack;
+ cur_fpstack = p;
+ p->stk_flags = FPF_FREE | flags;
+ outputDepth++;
+
+ if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
+ fprintf(trace_fp, TRACE_OPEN_OUT, __func__, fname, mode);
+
+ /*
+ * Avoid printing temporary file names in the dependency file
+ */
+ if ((dep_fp != NULL) && ((flags & FPF_TEMPFILE) == 0))
+ add_target_file(fname);
+}
+
+/*=gfunc out_delete
+ *
+ * what: delete current output file
+ * doc:
+ * Remove the current output file. Cease processing the template for
+ * the current suffix. It is an error if there are @code{push}-ed
+ * output files. Use the @code{(error "0")} scheme function instead.
+ * @xref{output controls}.
+=*/
+SCM
+ag_scm_out_delete(void)
+{
+ /*
+ * Delete the current output file
+ */
+ if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
+ fprintf(trace_fp, TRACE_OUT_DELETE, cur_fpstack->stk_fname);
+ rm_target_file(cur_fpstack->stk_fname);
+ outputDepth = 1;
+ longjmp(abort_jmp_buf, PROBLEM);
+ /* NOTREACHED */
+ return SCM_UNDEFINED;
+}
+
+
+/*=gfunc out_move
+ *
+ * what: change name of output file
+ * exparg: new-name, new name for the current output file
+ *
+ * doc:
+ *
+ * Rename current output file. @xref{output controls}.
+ * Please note: changing the name will not save a temporary file from
+ * being deleted. It @i{may}, however, be used on the root output file.
+ *
+ * NOTE: if you are creating a dependency file, @i{both} the original
+ * file name @i{and} the new file name will be listed as derived files.
+=*/
+SCM
+ag_scm_out_move(SCM new_file)
+{
+ size_t sz = AG_SCM_STRLEN(new_file);
+ char* pz = (char*)AGALOC(sz + 1, "new file name string");
+ memcpy(pz, AG_SCM_CHARS(new_file), sz);
+ pz[ sz ] = NUL;
+
+ if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
+ fprintf(trace_fp, TRACE_MOVE_FMT, __func__,
+ cur_fpstack->stk_fname, pz);
+ rename(cur_fpstack->stk_fname, pz);
+
+ if (dep_fp != NULL) {
+ rm_target_file(cur_fpstack->stk_fname);
+ add_target_file(pz);
+ }
+
+ if ((cur_fpstack->stk_flags & FPF_STATIC_NM) == 0)
+ AGFREE((void*)cur_fpstack->stk_fname);
+
+ AGDUPSTR(cur_fpstack->stk_fname, pz, "file name");
+ cur_fpstack->stk_flags &= ~FPF_STATIC_NM;
+ return SCM_UNDEFINED;
+}
+
+
+/*=gfunc out_pop
+ *
+ * what: close current output file
+ * exparg: disp, return contents of the file, optional
+ * doc:
+ * If there has been a @code{push} on the output, then close that
+ * file and go back to the previously open file. It is an error
+ * if there has not been a @code{push}. @xref{output controls}.
+ *
+ * If there is no argument, no further action is taken. Otherwise,
+ * the argument should be @code{#t} and the contents of the file
+ * are returned by the function.
+=*/
+SCM
+ag_scm_out_pop(SCM ret_contents)
+{
+ SCM res = SCM_UNDEFINED;
+
+ if (cur_fpstack->stk_prev == NULL)
+ AG_ABEND(SCM_OUT_POP_EMPTY);
+
+ if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
+ fprintf(trace_fp, TRACE_POP_FMT, __func__, cur_fpstack->stk_fname,
+ (ret_contents == SCM_UNDEFINED) ? "" : " #t");
+
+ if (AG_SCM_BOOL_P(ret_contents) && AG_SCM_NFALSEP(ret_contents)) {
+ long pos = ftell(cur_fpstack->stk_fp);
+ char * pz;
+
+ if (pos <= 0) {
+ pz = (void*)zNil; // const-ness not important
+ pos = 0;
+
+ } else {
+ pz = ag_scribble((size_t)pos + 1);
+ rewind(cur_fpstack->stk_fp);
+ if (fread(pz, (size_t)pos, (size_t)1, cur_fpstack->stk_fp) != 1)
+ AG_CANT(SCM_OUT_POP_NO_REREAD, cur_fpstack->stk_fname);
+ }
+
+ res = AG_SCM_STR2SCM(pz, pos);
+ }
+
+ outputDepth--;
+ out_close(false);
+ return res;
+}
+
+/*=gfunc output_file_next_line
+ *
+ * what: print the file name and next line number
+ *
+ * exparg: line_off, offset to line number, optional
+ * exparg: alt_fmt, alternate format string, optional
+ *
+ * doc:
+ * Returns a string with the current output file name and line number.
+ * The default format is: # <line+1> "<output-file-name>" The argument may be
+ * either a number indicating an offset from the current output line number
+ * or an alternate formatting string. If both are provided, then the first
+ * must be a numeric offset.
+ *
+ * Be careful that you are directing output to the final output file.
+ * Otherwise, you will get the file name and line number of the temporary
+ * file. That won't be what you want.
+=*/
+SCM
+ag_scm_output_file_next_line(SCM num_or_str, SCM str)
+{
+ char const * pzFmt = FILE_LINE_FMT;
+ int line_off = 1;
+
+ if (AG_SCM_NUM_P(num_or_str))
+ line_off = AG_SCM_TO_LONG(num_or_str);
+ else
+ str = num_or_str;
+
+ if (AG_SCM_STRING_P(str))
+ pzFmt = ag_scm2zchars(str, "file/line format");
+
+ return do_output_file_line(line_off, pzFmt);
+}
+
+
+/*=gfunc out_suspend
+ *
+ * what: suspend current output file
+ * exparg: suspName, A name tag for reactivating
+ *
+ * doc:
+ * If there has been a @code{push} on the output, then set aside the output
+ * descriptor for later reactiviation with @code{(out-resume "xxx")}. The
+ * tag name need not reflect the name of the output file. In fact, the
+ * output file may be an anonymous temporary file. You may also change the
+ * tag every time you suspend output to a file, because the tag names are
+ * forgotten as soon as the file has been "resumed".
+=*/
+SCM
+ag_scm_out_suspend(SCM susp_nm)
+{
+ if (cur_fpstack->stk_prev == NULL)
+ AG_ABEND(OUT_SUSPEND_CANNOT);
+
+ if (++suspendCt > suspAllocCt) {
+ suspAllocCt += 8;
+ if (pSuspended == NULL)
+ pSuspended = (tSuspendName*)
+ AGALOC(suspAllocCt * sizeof(tSuspendName), "susp file list");
+ else
+ pSuspended = (tSuspendName*)
+ AGREALOC((void*)pSuspended,
+ suspAllocCt * sizeof(tSuspendName), "add to susp f");
+ }
+
+ pSuspended[ suspendCt-1 ].pzSuspendName = AG_SCM_TO_NEWSTR(susp_nm);
+ pSuspended[ suspendCt-1 ].pOutDesc = cur_fpstack;
+ if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
+ fprintf(trace_fp, TRACE_SUSPEND, __func__, cur_fpstack->stk_fname,
+ pSuspended[ suspendCt-1 ].pzSuspendName);
+
+ cur_fpstack = cur_fpstack->stk_prev;
+ outputDepth--;
+
+ return SCM_UNDEFINED;
+}
+
+
+/*=gfunc out_resume
+ *
+ * what: resume suspended output file
+ * exparg: susp_nm, A name tag for reactivating
+ * doc:
+ * If there has been a suspended output, then make that output descriptor
+ * current again. That output must have been suspended with the same tag
+ * name given to this routine as its argument.
+=*/
+SCM
+ag_scm_out_resume(SCM susp_nm)
+{
+ int ix = 0;
+ char const * pzName = ag_scm2zchars(susp_nm, "resume name");
+
+ for (; ix < suspendCt; ix++) {
+ if (strcmp(pSuspended[ ix ].pzSuspendName, pzName) == 0) {
+ pSuspended[ ix ].pOutDesc->stk_prev = cur_fpstack;
+ cur_fpstack = pSuspended[ ix ].pOutDesc;
+ free((void*)pSuspended[ ix ].pzSuspendName); /* Guile alloc */
+ if (ix < --suspendCt)
+ pSuspended[ ix ] = pSuspended[ suspendCt ];
+ ++outputDepth;
+ if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
+ fprintf(trace_fp, TRACE_RESUME, __func__,
+ cur_fpstack->stk_fname, pzName);
+ return SCM_UNDEFINED;
+ }
+ }
+
+ AG_ABEND(aprf(OUT_RESUME_CANNOT, pzName));
+ /* NOTREACHED */
+ return SCM_UNDEFINED;
+}
+
+
+/*=gfunc out_emit_suspended
+ *
+ * what: emit the text of suspended output
+ * exparg: susp_nm, A name tag of suspended output
+ * doc:
+ * This function is equivalent to
+ * @code{(begin (out-resume <name>) (out-pop #t))}
+=*/
+SCM
+ag_scm_out_emit_suspended(SCM susp_nm)
+{
+ (void)ag_scm_out_resume(susp_nm);
+ return ag_scm_out_pop(SCM_BOOL_T);
+}
+
+
+/*=gfunc ag_fprintf
+ *
+ * what: format to autogen stream
+ *
+ * exparg: ag-diversion, AutoGen diversion name or number
+ * exparg: format, formatting string
+ * exparg: format-arg, list of arguments to formatting string, opt, list
+ *
+ * doc: Format a string using arguments from the alist.
+ * Write to a specified AutoGen diversion.
+ * That may be either a specified suspended output stream
+ * (@pxref{SCM out-suspend}) or an index into the output stack
+ * (@pxref{SCM out-push-new}). @code{(ag-fprintf 0 ...)} is
+ * equivalent to @code{(emit (sprintf ...))}, and
+ * @code{(ag-fprintf 1 ...)} sends output to the most recently
+ * suspended output stream.
+=*/
+SCM
+ag_scm_ag_fprintf(SCM port, SCM fmt, SCM alist)
+{
+ int list_len = scm_ilength(alist);
+ char const * pzFmt = ag_scm2zchars(fmt, WORD_FORMAT);
+ SCM res = run_printf(pzFmt, list_len, alist);
+
+ /*
+ * If "port" is a string, it must match one of the suspended outputs.
+ * Otherwise, we'll fall through to the abend.
+ */
+ if (AG_SCM_STRING_P(port)) {
+ int ix = 0;
+ char const * pzName = ag_scm2zchars(port, "resume name");
+
+ for (; ix < suspendCt; ix++) {
+ if (strcmp(pSuspended[ ix ].pzSuspendName, pzName) == 0) {
+ out_stack_t* pSaveFp = cur_fpstack;
+ cur_fpstack = pSuspended[ ix ].pOutDesc;
+ (void) ag_scm_emit(res);
+ cur_fpstack = pSaveFp;
+ return SCM_UNDEFINED;
+ }
+ }
+ }
+
+ /*
+ * If "port" is a number, it is an index into the output stack with "0"
+ * (zero) representing the current output and "1" the last suspended
+ * output. If the number is out of range, we'll fall through to the
+ * abend.
+ */
+ else if (AG_SCM_NUM_P(port)) {
+ out_stack_t* pSaveFp = cur_fpstack;
+ unsigned long val = AG_SCM_TO_ULONG(port);
+
+ for (; val > 0; val--) {
+ cur_fpstack = cur_fpstack->stk_prev;
+ if (cur_fpstack == NULL) {
+ cur_fpstack = pSaveFp;
+ goto fprintf_woops;
+ }
+ }
+
+ (void) ag_scm_emit(res);
+ cur_fpstack = pSaveFp;
+ return SCM_UNDEFINED;
+ }
+
+ /*
+ * Still here? We have a bad "port" specification.
+ */
+ fprintf_woops:
+
+ AG_ABEND(AG_FPRINTF_BAD_PORT);
+ /* NOTREACHED */
+ return SCM_UNDEFINED;
+}
+
+/*=gfunc out_push_add
+ *
+ * what: append output to file
+ * exparg: file-name, name of the file to append text to
+ *
+ * doc:
+ * Identical to @code{push-new}, except the contents are @strong{not}
+ * purged, but appended to. @xref{output controls}.
+=*/
+SCM
+ag_scm_out_push_add(SCM new_file)
+{
+ static char const append_mode[] = "a" FOPEN_BINARY_FLAG "+";
+
+ if (! AG_SCM_STRING_P(new_file))
+ AG_ABEND(OUT_ADD_INVALID);
+
+ open_output_file(AG_SCM_CHARS(new_file), AG_SCM_STRLEN(new_file),
+ append_mode, 0);
+
+ return SCM_UNDEFINED;
+}
+
+
+/*=gfunc make_tmp_dir
+ *
+ * what: create a temporary directory
+ *
+ * doc:
+ * Create a directory that will be cleaned up upon exit.
+=*/
+SCM
+ag_scm_make_tmp_dir(void)
+{
+ if (pz_temp_tpl == NULL) {
+ char * tmpdir = shell_cmd(MK_TMP_DIR_CMD);
+ char * cmdbf =
+ ag_scribble(SET_TMP_DIR_CMD_LEN + 2 * MK_TMP_DIR_CMD_LEN);
+
+ pz_temp_tpl = tmpdir;
+ temp_tpl_dir_len = strlen(tmpdir) - 9; // "ag-XXXXXX"
+
+ tmpdir[temp_tpl_dir_len - 1] = NUL; // trim dir char
+ sprintf(cmdbf, SET_TMP_DIR_CMD, tmpdir);
+ tmpdir[temp_tpl_dir_len - 1] = DIRCH; // restore dir char
+
+ ag_scm_c_eval_string_from_file_line(cmdbf, __FILE__, __LINE__);
+ }
+
+ return SCM_UNDEFINED;
+}
+
+
+/*=gfunc out_push_new
+ *
+ * what: purge and create output file
+ * exparg: file-name, name of the file to create, optional
+ *
+ * doc:
+ * Leave the current output file open, but purge and create
+ * a new file that will remain open until a @code{pop} @code{delete}
+ * or @code{switch} closes it. The file name is optional and, if omitted,
+ * the output will be sent to a temporary file that will be deleted when
+ * it is closed.
+ * @xref{output controls}.
+=*/
+SCM
+ag_scm_out_push_new(SCM new_file)
+{
+ static char const write_mode[] = "w" FOPEN_BINARY_FLAG "+";
+
+ if (AG_SCM_STRING_P(new_file)) {
+ open_output_file(AG_SCM_CHARS(new_file), AG_SCM_STRLEN(new_file),
+ write_mode, 0);
+ return SCM_UNDEFINED;
+ }
+
+ /*
+ * "ENABLE_FMEMOPEN" is defined if we have either fopencookie(3GNU) or
+ * funopen(3BSD) is available and autogen was not configured with fmemopen
+ * disabled. We cannot use the POSIX fmemopen.
+ */
+#if defined(ENABLE_FMEMOPEN)
+ if (! HAVE_OPT(NO_FMEMOPEN)) {
+ char * pzNewFile;
+ out_stack_t * p;
+
+ /*
+ * This block is used IFF ENABLE_FMEMOPEN is defined and if
+ * --no-fmemopen is *not* selected on the command line.
+ */
+ p = (out_stack_t*)AGALOC(sizeof(out_stack_t), "out file stack");
+ p->stk_prev = cur_fpstack;
+ p->stk_flags = FPF_FREE;
+ p->stk_fp = ag_fmemopen(NULL, (ssize_t)0, "w" FOPEN_BINARY_FLAG "+");
+ pzNewFile = (char*)MEM_FILE_STR;
+ p->stk_flags |= FPF_STATIC_NM | FPF_NOUNLINK | FPF_NOCHMOD;
+
+ if (p->stk_fp == NULL)
+ AG_CANT(OUT_PUSH_NEW_FAIL, pzNewFile);
+
+ p->stk_fname = pzNewFile;
+ outputDepth++;
+ cur_fpstack = p;
+
+ if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
+ fprintf(trace_fp, TRACE_OUT_PUSH_NEW, __func__, pzNewFile);
+ return SCM_UNDEFINED;
+ }
+#endif
+
+ /*
+ * Either --no-fmemopen was specified or we cannot use ag_fmemopen().
+ */
+ {
+ static size_t tmplen;
+ char * tmp_fnm;
+ int tmpfd;
+
+ if (pz_temp_tpl == NULL)
+ ag_scm_make_tmp_dir();
+
+ tmplen = temp_tpl_dir_len + 10;
+ tmp_fnm = ag_scribble(tmplen + 1);
+ memcpy(tmp_fnm, pz_temp_tpl, tmplen + 1);
+ tmpfd = mkstemp(tmp_fnm);
+
+ if (tmpfd < 0)
+ AG_ABEND(aprf(OUT_PUSH_NEW_FAILED, pz_temp_tpl));
+
+ open_output_file(tmp_fnm, tmplen, write_mode, FPF_TEMPFILE);
+ close(tmpfd);
+ }
+
+ return SCM_UNDEFINED;
+}
+
+/*=gfunc out_switch
+ *
+ * what: close and create new output
+ * exparg: file-name, name of the file to create
+ *
+ * doc:
+ * Switch output files - close current file and make the current
+ * file pointer refer to the new file. This is equivalent to
+ * @code{out-pop} followed by @code{out-push-new}, except that
+ * you may not pop the base level output file, but you may
+ * @code{switch} it. @xref{output controls}.
+=*/
+SCM
+ag_scm_out_switch(SCM new_file)
+{
+ struct utimbuf tbuf;
+ char* pzNewFile;
+
+ if (! AG_SCM_STRING_P(new_file))
+ return SCM_UNDEFINED;
+ {
+ size_t sz = AG_SCM_STRLEN(new_file);
+ pzNewFile = AGALOC(sz + 1, "new file name");
+ memcpy(pzNewFile, AG_SCM_CHARS(new_file), sz);
+ pzNewFile[ sz ] = NUL;
+ }
+
+ /*
+ * IF no change, THEN ignore this
+ */
+ if (strcmp(cur_fpstack->stk_fname, pzNewFile) == 0) {
+ AGFREE((void*)pzNewFile);
+ return SCM_UNDEFINED;
+ }
+
+ make_readonly();
+
+ /*
+ * Make sure we get a new file pointer!!
+ * and try to ensure nothing is in the way.
+ */
+ unlink(pzNewFile);
+ if ( freopen(pzNewFile, "w" FOPEN_BINARY_FLAG "+", cur_fpstack->stk_fp)
+ != cur_fpstack->stk_fp)
+
+ AG_CANT(OUT_SWITCH_FAIL, pzNewFile);
+
+ /*
+ * Set the mod time on the old file.
+ */
+ tbuf.actime = time(NULL);
+ tbuf.modtime = outfile_time;
+ utime(cur_fpstack->stk_fname, &tbuf);
+ if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
+ fprintf(trace_fp, TRACE_OUT_SWITCH,
+ __func__, cur_fpstack->stk_fname, pzNewFile);
+ cur_fpstack->stk_fname = pzNewFile; /* memory leak */
+
+ return SCM_UNDEFINED;
+}
+
+
+/*=gfunc out_depth
+ *
+ * what: output file stack depth
+ * doc: Returns the depth of the output file stack.
+ * @xref{output controls}.
+=*/
+SCM
+ag_scm_out_depth(void)
+{
+ return AG_SCM_INT2SCM(outputDepth);
+}
+
+
+/*=gfunc out_name
+ *
+ * what: current output file name
+ * doc: Returns the name of the current output file. If the current file
+ * is a temporary, unnamed file, then it will scan up the chain until
+ * a real output file name is found.
+ * @xref{output controls}.
+=*/
+SCM
+ag_scm_out_name(void)
+{
+ out_stack_t* p = cur_fpstack;
+ while (p->stk_flags & FPF_UNLINK) p = p->stk_prev;
+ return AG_SCM_STR02SCM((void*)p->stk_fname);
+}
+
+
+/*=gfunc out_line
+ *
+ * what: output file line number
+ * doc: Returns the current line number of the output file.
+ * It rewinds and reads the file to count newlines.
+=*/
+SCM
+ag_scm_out_line(void)
+{
+ int lineNum = 1;
+
+ do {
+ long svpos = ftell(cur_fpstack->stk_fp);
+ long pos = svpos;
+
+ if (pos == 0)
+ break;
+
+ rewind(cur_fpstack->stk_fp);
+ do {
+ int ich = fgetc(cur_fpstack->stk_fp);
+ unsigned char ch = ich;
+ if (ich < 0)
+ break;
+ if (ch == (unsigned char)NL)
+ lineNum++;
+ } while (--pos > 0);
+ fseek(cur_fpstack->stk_fp, svpos, SEEK_SET);
+ } while(0);
+
+ return AG_SCM_INT2SCM(lineNum);
+}
+
+#if 0 /* for compilers that do not like C++ comments... */
+// This is done so that comment delimiters can be included in the doc.
+//
+// /*=gfunc make_header_guard
+// *
+// * what: make self-inclusion guard
+// *
+// * exparg: name , header group name
+// *
+// * doc:
+// * This function will create a @code{#ifndef}/@code{#define}
+// * sequence for protecting a header from multiple evaluation.
+// * It will also set the Scheme variable @code{header-file}
+// * to the name of the file being protected and it will set
+// * @code{header-guard} to the name of the @code{#define} being
+// * used to protect it. It is expected that this will be used
+// * as follows:
+// * @example
+// * [+ (make-header-guard "group_name") +]
+// * ...
+// * #endif /* [+ (. header-guard) +] */
+// *
+// * #include "[+ (. header-file) +]"
+// * @end example
+// * @noindent
+// * The @code{#define} name is composed as follows:
+// *
+// * @enumerate
+// * @item
+// * The first element is the string argument and a separating underscore.
+// * @item
+// * That is followed by the name of the header file with illegal
+// * characters mapped to underscores.
+// * @item
+// * The end of the name is always, "@code{_GUARD}".
+// * @item
+// * Finally, the entire string is mapped to upper case.
+// * @end enumerate
+// *
+// * The final @code{#define} name is stored in an SCM symbol named
+// * @code{header-guard}. Consequently, the concluding @code{#endif} for the
+// * file should read something like:
+// *
+// * @example
+// * #endif /* [+ (. header-guard) +] */
+// * @end example
+// *
+// * The name of the header file (the current output file) is also stored
+// * in an SCM symbol, @code{header-file}. Therefore, if you are also
+// * generating a C file that uses the previously generated header file,
+// * you can put this into that generated file:
+// *
+// * @example
+// * #include "[+ (. header-file) +]"
+// * @end example
+// *
+// * Obviously, if you are going to produce more than one header file from
+// * a particular template, you will need to be careful how these SCM symbols
+// * get handled.
+// =*/
+#endif
+SCM
+ag_scm_make_header_guard(SCM name)
+{
+
+ char const * opz; // output file name string
+ size_t osz;
+
+ char const * gpz; // guard name string
+ size_t gsz;
+
+ {
+ out_stack_t* p = cur_fpstack;
+ while (p->stk_flags & FPF_UNLINK) p = p->stk_prev;
+ opz = p->stk_fname;
+ osz = strlen(opz);
+ }
+
+ /*
+ * Construct the gard name using the leader (passed in or "HEADER")
+ * and the trailer (always "_GUARD") and the output file name in between.
+ */
+ {
+ /*
+ * Leader string and its length. Usually passed, but defaults
+ * to "HEADER"
+ */
+ char const * lpz =
+ AG_SCM_STRING_P(name) ? AG_SCM_CHARS(name) : HEADER_STR;
+ size_t lsz = (lpz == HEADER_STR)
+ ? HEADER_STR_LEN : AG_SCM_STRLEN(name);
+
+ /*
+ * Full, maximal length of output
+ */
+ size_t hsz = lsz + osz + GUARD_SFX_LEN + 2;
+ char * scan_p;
+
+ /*
+ * Sanity:
+ */
+ if (*lpz == NUL) {
+ lpz = HEADER_STR;
+ lsz = HEADER_STR_LEN;
+ hsz += lsz;
+ }
+ scan_p = AGALOC(hsz, "header guard string");
+
+ gpz = scan_p; // gpz must be freed
+ do {
+ *(scan_p++) = toupper(*(lpz++));
+ } while (--lsz > 0);
+
+ /*
+ * This copy converts non-alphanumerics to underscores,
+ * but never inserts more than one at a time. Thus, we may
+ * not use all of the space in "gpz".
+ */
+ lpz = opz;
+ do {
+ *(scan_p++) = '_';
+ lpz = BRK_ALPHANUMERIC_CHARS(lpz);
+ while (IS_ALPHANUMERIC_CHAR(*lpz))
+ *(scan_p++) = toupper((unsigned)*(lpz++));
+ } while (*lpz != NUL);
+
+ memcpy(scan_p, GUARD_SFX, GUARD_SFX_LEN + 1);
+ gsz = (scan_p - gpz) + GUARD_SFX_LEN;
+ }
+
+ {
+ size_t sz1 = MK_HEAD_GUARD_SCM_LEN + gsz + osz;
+ size_t sz2 = MK_HEAD_GUARD_GUARD_LEN + 2 * gsz;
+ size_t sz = (sz1 < sz2) ? sz2 : sz1;
+ char * p = ag_scribble(sz);
+ sprintf(p, MK_HEAD_GUARD_SCM, opz, gpz);
+ (void)ag_scm_c_eval_string_from_file_line(p, __FILE__, __LINE__);
+
+ sprintf(p, MK_HEAD_GUARD_GUARD, gpz);
+ name = AG_SCM_STR02SCM(p);
+ }
+
+ AGFREE(gpz);
+ return (name);
+}
+
+/*
+ * Local Variables:
+ * mode: C
+ * c-file-style: "stroustrup"
+ * indent-tabs-mode: nil
+ * End:
+ * end of agen5/expOutput.c */