1
2 /**
3 * @file expOutput.c
4 *
5 * This module implements the output file manipulation function
6 *
7 * @addtogroup autogen
8 * @{
9 */
10 /*
11 * This file is part of AutoGen.
12 * AutoGen Copyright (C) 1992-2018 by Bruce Korb - all rights reserved
13 *
14 * AutoGen is free software: you can redistribute it and/or modify it
15 * under the terms of the GNU General Public License as published by the
16 * Free Software Foundation, either version 3 of the License, or
17 * (at your option) any later version.
18 *
19 * AutoGen is distributed in the hope that it will be useful, but
20 * WITHOUT ANY WARRANTY; without even the implied warranty of
21 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
22 * See the GNU General Public License for more details.
23 *
24 * You should have received a copy of the GNU General Public License along
25 * with this program. If not, see <http://www.gnu.org/licenses/>.
26 */
27
28 #ifndef S_IAMB
29 /*
30 * Access Mask Bits (3 special plus RWX for User Group & Others (9))
31 */
32 # define S_IAMB (S_ISUID|S_ISGID|S_ISVTX|S_IRWXU|S_IRWXG|S_IRWXO)
33 #endif
34
35 #define NO_WRITE_MASK ((unsigned)(~(S_IWUSR|S_IWGRP|S_IWOTH) & S_IAMB))
36
37 typedef struct {
38 char const * pzSuspendName;
39 out_stack_t * pOutDesc;
40 } tSuspendName;
41
42 static int suspendCt = 0;
43 static int suspAllocCt = 0;
44 static tSuspendName * pSuspended = NULL;
45 static int outputDepth = 1;
46
47 /**
48 * return the current line number
49 */
50 static int
current_line(FILE * fp)51 current_line(FILE * fp)
52 {
53 int lnno = 1;
54
55 while (! feof(fp)) {
56 int ch = getc(fp);
57 if (ch == NL)
58 lnno++;
59 }
60
61 return lnno;
62 }
63
64 /**
65 * guts of the output file/line function
66 */
67 static SCM
do_output_file_line(int line_delta,char const * fmt)68 do_output_file_line(int line_delta, char const * fmt)
69 {
70 char * buf;
71 char const * fname = cur_fpstack->stk_fname;
72
73 if (cur_fpstack->stk_flags & FPF_TEMPFILE) {
74 fname = OUTPUT_TEMP_FILE;
75 line_delta = 0;
76
77 } else if (fseek(cur_fpstack->stk_fp, 0, SEEK_SET) == 0) {
78 line_delta += current_line(cur_fpstack->stk_fp);
79
80 } else {
81 line_delta = 0;
82 }
83
84 {
85 ssize_t sz = (ssize_t)(strlen(fmt) + strlen(fname) + 24);
86 buf = scribble_get(sz);
87 }
88
89 {
90 void * args[2] = {
91 VOIDP(fname),
92 VOIDP(line_delta)
93 };
94 sprintfv(buf, fmt, (snv_constpointer *)args);
95 }
96
97 return scm_from_latin1_string(buf);
98 }
99
100 /**
101 * chmod a-w on a file descriptor.
102 */
103 static void
make_readonly(void)104 make_readonly(void)
105 {
106 #if defined(HAVE_FSTAT) || defined(HAVE_FCHMOD)
107 int fd = fileno(cur_fpstack->stk_fp);
108 #endif
109 struct stat sbuf;
110
111 /*
112 * If the output is supposed to be writable, then also see if
113 * it is a temporary condition (set vs. a command line option).
114 */
115 if (ENABLED_OPT(WRITABLE)) {
116 if (! HAVE_OPT(WRITABLE))
117 CLEAR_OPT(WRITABLE);
118 return;
119 }
120
121 /*
122 * Set our usage mask to all all the access
123 * bits that do not provide for write access
124 */
125 #ifdef HAVE_FSTAT
126 fstat(fd, &sbuf);
127 #else
128 stat(cur_fpstack->stk_fname, &sbuf);
129 #endif
130
131 /*
132 * Mask off the write permission bits, but ensure that
133 * the user read bit is set.
134 */
135 {
136 mode_t f_mode = (NO_WRITE_MASK & sbuf.st_mode) | S_IRUSR;
137
138 #ifdef HAVE_FCHMOD
139 fchmod(fd, f_mode);
140 #else
141 chmod(cur_fpstack->stk_fname, f_mode);
142 #endif
143 }
144 }
145
146 /**
147 * Some common code for creating a new file
148 */
149 static void
open_output_file(char const * fname,size_t nmsz,char const * mode,int flags)150 open_output_file(char const * fname, size_t nmsz, char const * mode, int flags)
151 {
152 char * pz;
153 out_stack_t * p = AGALOC(sizeof(*p), "out file stack");
154
155 pz = (char *)AGALOC(nmsz + 1, "file name string");
156 memcpy(pz, fname, nmsz);
157 pz[ nmsz ] = NUL;
158 memset(p, NUL, sizeof(*p));
159 p->stk_fname = pz;
160
161 /*
162 * IF we are creating the file and we are allowed to unlink the output,
163 * then start by unlinking the thing.
164 */
165 if ((*mode == 'w') && ((flags & FPF_NOUNLINK) == 0)) {
166 if ((unlink(pz) != 0) && (errno != ENOENT))
167 AG_CANT(OUTPUT_NO_UNLINK, pz);
168 }
169
170 /*
171 * If we cannot write to the file, try to change permissions.
172 */
173 if ( (access(fname, W_OK) != 0)
174 && (errno != ENOENT)) {
175 struct stat sbuf;
176 if (stat(fname, &sbuf) == 0) {
177 mode_t m = (sbuf.st_mode & 07777) | S_IWUSR;
178 chmod(fname, m);
179 }
180 }
181
182 p->stk_fp = fopen(pz, mode);
183 if (p->stk_fp == NULL)
184 AG_CANT(OUTPUT_NO_OPEN, pz);
185
186 p->stk_prev = cur_fpstack;
187 cur_fpstack = p;
188 p->stk_flags = FPF_FREE | flags;
189 outputDepth++;
190
191 if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
192 fprintf(trace_fp, TRACE_OPEN_OUT, __func__, fname, mode);
193
194 /*
195 * Avoid printing temporary file names in the dependency file
196 */
197 if ((dep_fp != NULL) && ((flags & FPF_TEMPFILE) == 0))
198 add_target_file(fname);
199 }
200
201 /*=gfunc out_delete
202 *
203 * what: delete current output file
204 * doc:
205 * Remove the current output file. Cease processing the template for
206 * the current suffix. It is an error if there are @code{push}-ed
207 * output files. Use the @code{(error "0")} scheme function instead.
208 * @xref{output controls}.
209 =*/
210 SCM
ag_scm_out_delete(void)211 ag_scm_out_delete(void)
212 {
213 /*
214 * Delete the current output file
215 */
216 if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
217 fprintf(trace_fp, TRACE_OUT_DELETE, cur_fpstack->stk_fname);
218 rm_target_file(cur_fpstack->stk_fname);
219 outputDepth = 1;
220 longjmp(abort_jmp_buf, PROBLEM);
221 /* NOTREACHED */
222 return SCM_UNDEFINED;
223 }
224
225
226 /*=gfunc out_move
227 *
228 * what: change name of output file
229 * exparg: new-name, new name for the current output file
230 *
231 * doc:
232 *
233 * Rename current output file. @xref{output controls}.
234 * Please note: changing the name will not save a temporary file from
235 * being deleted. It @i{may}, however, be used on the root output file.
236 *
237 * NOTE: if you are creating a dependency file, @i{both} the original
238 * file name @i{and} the new file name will be listed as derived files.
239 =*/
240 SCM
ag_scm_out_move(SCM new_file)241 ag_scm_out_move(SCM new_file)
242 {
243 size_t sz = scm_c_string_length(new_file);
244 char * pz = (char *)AGALOC(sz + 1, "file name");
245 memcpy(pz, scm_i_string_chars(new_file), sz);
246 pz[sz] = NUL;
247
248 if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
249 fprintf(trace_fp, TRACE_MOVE_FMT, __func__,
250 cur_fpstack->stk_fname, pz);
251
252 if (strcmp(pz, cur_fpstack->stk_fname) != 0) {
253
254 rename(cur_fpstack->stk_fname, pz);
255
256 if (dep_fp != NULL) {
257 rm_target_file(cur_fpstack->stk_fname);
258 add_target_file(pz);
259 }
260
261 if ((cur_fpstack->stk_flags & FPF_STATIC_NM) == 0) {
262 AGFREE(cur_fpstack->stk_fname);
263 cur_fpstack->stk_flags &= ~FPF_STATIC_NM;
264 }
265
266 AGDUPSTR(cur_fpstack->stk_fname, pz, "file name");
267 }
268
269 return SCM_UNDEFINED;
270 }
271
272
273 /*=gfunc out_pop
274 *
275 * what: close current output file
276 * exparg: disp, return contents of the file, optional
277 * doc:
278 * If there has been a @code{push} on the output, then close that
279 * file and go back to the previously open file. It is an error
280 * if there has not been a @code{push}. @xref{output controls}.
281 *
282 * If there is no argument, no further action is taken. Otherwise,
283 * the argument should be @code{#t} and the contents of the file
284 * are returned by the function.
285 =*/
286 SCM
ag_scm_out_pop(SCM ret_contents)287 ag_scm_out_pop(SCM ret_contents)
288 {
289 SCM res = SCM_UNDEFINED;
290
291 if (cur_fpstack->stk_prev == NULL)
292 AG_ABEND(SCM_OUT_POP_EMPTY);
293
294 if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
295 fprintf(trace_fp, TRACE_POP_FMT, __func__, cur_fpstack->stk_fname,
296 (ret_contents == SCM_UNDEFINED) ? "" : " #t");
297
298 if (scm_is_bool(ret_contents) && scm_is_true(ret_contents)) {
299 long pos = ftell(cur_fpstack->stk_fp);
300 char * pz;
301
302 if (pos <= 0) {
303 pz = VOIDP(zNil); // const-ness not important
304 pos = 0;
305
306 } else {
307 pz = scribble_get((ssize_t)pos + 1);
308 rewind(cur_fpstack->stk_fp);
309 if (fread(pz, (size_t)pos, (size_t)1, cur_fpstack->stk_fp) != 1)
310 AG_CANT(SCM_OUT_POP_NO_REREAD, cur_fpstack->stk_fname);
311 }
312
313 res = scm_from_latin1_stringn(pz, (size_t)pos);
314 }
315
316 outputDepth--;
317 out_close(false);
318 return res;
319 }
320
321 /*=gfunc output_file_next_line
322 *
323 * what: print the file name and next line number
324 *
325 * exparg: line_off, offset to line number, optional
326 * exparg: alt_fmt, alternate format string, optional
327 *
328 * doc:
329 * Returns a string with the current output file name and line number.
330 * The default format is: # <line+1> "<output-file-name>" The argument may be
331 * either a number indicating an offset from the current output line number
332 * or an alternate formatting string. If both are provided, then the first
333 * must be a numeric offset.
334 *
335 * Be careful that you are directing output to the final output file.
336 * Otherwise, you will get the file name and line number of the temporary
337 * file. That won't be what you want.
338 =*/
339 SCM
ag_scm_output_file_next_line(SCM num_or_str,SCM str)340 ag_scm_output_file_next_line(SCM num_or_str, SCM str)
341 {
342 char const * fmt;
343 int line_off = 1;
344
345 if (scm_is_number(num_or_str))
346 line_off = (int)AG_SCM_TO_LONG(num_or_str);
347 else
348 str = num_or_str;
349
350 if (scm_is_string(str))
351 fmt = ag_scm2zchars(str, "file/line format");
352 else
353 fmt = FILE_LINE_FMT;
354
355 return do_output_file_line(line_off, fmt);
356 }
357
358
359 /*=gfunc out_suspend
360 *
361 * what: suspend current output file
362 * exparg: suspName, A name tag for reactivating
363 *
364 * doc:
365 * If there has been a @code{push} on the output, then set aside the output
366 * descriptor for later reactiviation with @code{(out-resume "xxx")}. The
367 * tag name need not reflect the name of the output file. In fact, the
368 * output file may be an anonymous temporary file. You may also change the
369 * tag every time you suspend output to a file, because the tag names are
370 * forgotten as soon as the file has been "resumed".
371 =*/
372 SCM
ag_scm_out_suspend(SCM susp_nm)373 ag_scm_out_suspend(SCM susp_nm)
374 {
375 if (cur_fpstack->stk_prev == NULL)
376 AG_ABEND(OUT_SUSPEND_CANNOT);
377
378 if (++suspendCt > suspAllocCt) {
379 suspAllocCt += 8;
380 if (pSuspended == NULL)
381 pSuspended = (tSuspendName *)
382 AGALOC(suspAllocCt * sizeof(tSuspendName), "susp file list");
383 else
384 pSuspended = (tSuspendName *)
385 AGREALOC(VOIDP(pSuspended),
386 suspAllocCt * sizeof(tSuspendName), "add to susp f");
387 }
388
389 pSuspended[ suspendCt-1 ].pzSuspendName = scm_to_latin1_string(susp_nm);
390 pSuspended[ suspendCt-1 ].pOutDesc = cur_fpstack;
391 if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
392 fprintf(trace_fp, TRACE_SUSPEND, __func__, cur_fpstack->stk_fname,
393 pSuspended[ suspendCt-1 ].pzSuspendName);
394
395 cur_fpstack = cur_fpstack->stk_prev;
396 outputDepth--;
397
398 return SCM_UNDEFINED;
399 }
400
401
402 /*=gfunc out_resume
403 *
404 * what: resume suspended output file
405 * exparg: susp_nm, A name tag for reactivating
406 * doc:
407 * If there has been a suspended output, then make that output descriptor
408 * current again. That output must have been suspended with the same tag
409 * name given to this routine as its argument.
410 =*/
411 SCM
ag_scm_out_resume(SCM susp_nm)412 ag_scm_out_resume(SCM susp_nm)
413 {
414 int ix = 0;
415 char const * pzName = ag_scm2zchars(susp_nm, "resume name");
416
417 for (; ix < suspendCt; ix++) {
418 if (strcmp(pSuspended[ ix ].pzSuspendName, pzName) == 0) {
419 pSuspended[ ix ].pOutDesc->stk_prev = cur_fpstack;
420 cur_fpstack = pSuspended[ ix ].pOutDesc;
421 free(VOIDP(pSuspended[ ix ].pzSuspendName)); /* Guile alloc */
422 if (ix < --suspendCt)
423 pSuspended[ ix ] = pSuspended[ suspendCt ];
424 ++outputDepth;
425 if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS)
426 fprintf(trace_fp, TRACE_RESUME, __func__,
427 cur_fpstack->stk_fname, pzName);
428 return SCM_UNDEFINED;
429 }
430 }
431
432 AG_ABEND(aprf(OUT_RESUME_CANNOT, pzName));
433 /* NOTREACHED */
434 return SCM_UNDEFINED;
435 }
436
437
438 /*=gfunc out_emit_suspended
439 *
440 * what: emit the text of suspended output
441 * exparg: susp_nm, A name tag of suspended output
442 * doc:
443 * This function is equivalent to
444 * @code{(begin (out-resume <name>) (out-pop #t))}
445 =*/
446 SCM
ag_scm_out_emit_suspended(SCM susp_nm)447 ag_scm_out_emit_suspended(SCM susp_nm)
448 {
449 (void)ag_scm_out_resume(susp_nm);
450 return ag_scm_out_pop(SCM_BOOL_T);
451 }
452
453
454 /*=gfunc ag_fprintf
455 *
456 * what: format to autogen stream
457 *
458 * exparg: ag-diversion, AutoGen diversion name or number
459 * exparg: format, formatting string
460 * exparg: format-arg, list of arguments to formatting string, opt, list
461 *
462 * doc: Format a string using arguments from the alist.
463 * Write to a specified AutoGen diversion.
464 * That may be either a specified suspended output stream
465 * (@pxref{SCM out-suspend}) or an index into the output stack
466 * (@pxref{SCM out-push-new}). @code{(ag-fprintf 0 ...)} is
467 * equivalent to @code{(emit (sprintf ...))}, and
468 * @code{(ag-fprintf 1 ...)} sends output to the most recently
469 * suspended output stream.
470 =*/
471 SCM
ag_scm_ag_fprintf(SCM port,SCM fmt,SCM alist)472 ag_scm_ag_fprintf(SCM port, SCM fmt, SCM alist)
473 {
474 int list_len = (int)scm_ilength(alist);
475 SCM res =
476 run_printf(ag_scm2zchars(fmt, WORD_FORMAT), list_len, alist);
477
478 /*
479 * If "port" is a string, it must match one of the suspended outputs.
480 * Otherwise, we'll fall through to the abend.
481 */
482 if (scm_is_string(port)) {
483 int ix = 0;
484 char const * pzName = ag_scm2zchars(port, "resume name");
485
486 for (; ix < suspendCt; ix++) {
487 if (strcmp(pSuspended[ ix ].pzSuspendName, pzName) == 0) {
488 out_stack_t * pSaveFp = cur_fpstack;
489 cur_fpstack = pSuspended[ ix ].pOutDesc;
490 (void) ag_scm_emit(res);
491 cur_fpstack = pSaveFp;
492 return SCM_UNDEFINED;
493 }
494 }
495 }
496
497 /*
498 * If "port" is a number, it is an index into the output stack with "0"
499 * (zero) representing the current output and "1" the last suspended
500 * output. If the number is out of range, we'll fall through to the
501 * abend.
502 */
503 else if (scm_is_number(port)) {
504 out_stack_t * pSaveFp = cur_fpstack;
505 long val = AG_SCM_TO_LONG(port);
506
507 if (val < 0) {
508 char const * txt = ag_scm2zchars(res, "f-chars");
509 fputs(txt, stderr);
510 putc('\n', stderr);
511 return SCM_UNDEFINED;
512 }
513
514 for (; val > 0; val--) {
515 cur_fpstack = cur_fpstack->stk_prev;
516 if (cur_fpstack == NULL) {
517 cur_fpstack = pSaveFp;
518 goto fprintf_woops;
519 }
520 }
521
522 (void) ag_scm_emit(res);
523 cur_fpstack = pSaveFp;
524 return SCM_UNDEFINED;
525 }
526
527 /*
528 * Still here? We have a bad "port" specification.
529 */
530 fprintf_woops:
531
532 AG_ABEND(AG_FPRINTF_BAD_PORT);
533 /* NOTREACHED */
534 return SCM_UNDEFINED;
535 }
536
537 /*=gfunc out_push_add
538 *
539 * what: append output to file
540 * exparg: file-name, name of the file to append text to
541 *
542 * doc:
543 * Identical to @code{push-new}, except the contents are @strong{not}
544 * purged, but appended to. @xref{output controls}.
545 =*/
546 SCM
ag_scm_out_push_add(SCM new_file)547 ag_scm_out_push_add(SCM new_file)
548 {
549 static char const append_mode[] = "a" FOPEN_BINARY_FLAG "+";
550
551 if (! scm_is_string(new_file))
552 AG_ABEND(OUT_ADD_INVALID);
553
554 open_output_file(scm_i_string_chars(new_file),
555 scm_c_string_length(new_file), append_mode, 0);
556
557 return SCM_UNDEFINED;
558 }
559
560
561 /*=gfunc make_tmp_dir
562 *
563 * what: create a temporary directory
564 *
565 * doc:
566 * Create a directory that will be cleaned up upon exit.
567 =*/
568 SCM
ag_scm_make_tmp_dir(void)569 ag_scm_make_tmp_dir(void)
570 {
571 if (pz_temp_tpl == NULL) {
572 char * tmpdir = shell_cmd(MK_TMP_DIR_CMD);
573 size_t tmp_sz = strlen(tmpdir);
574 size_t bfsz = SET_TMP_DIR_CMD_LEN + 2 * tmp_sz;
575 char * cmdbf = scribble_get(bfsz);
576
577 pz_temp_tpl = tmpdir;
578 temp_tpl_dir_len = tmp_sz - 9; // "ag-XXXXXX"
579
580 tmpdir[temp_tpl_dir_len - 1] = NUL; // trim dir char
581 if (snprintf(cmdbf, bfsz, SET_TMP_DIR_CMD, tmpdir) >= (int)bfsz)
582 AG_ABEND(BOGUS_TAG);
583 tmpdir[temp_tpl_dir_len - 1] = DIRCH; // restore dir char
584
585 ag_scm_c_eval_string_from_file_line(cmdbf, __FILE__, __LINE__);
586 }
587
588 return SCM_UNDEFINED;
589 }
590
591
592 /*=gfunc out_push_new
593 *
594 * what: purge and create output file
595 * exparg: file-name, name of the file to create, optional
596 *
597 * doc:
598 * Leave the current output file open, but purge and create
599 * a new file that will remain open until a @code{pop} @code{delete}
600 * or @code{switch} closes it. The file name is optional and, if omitted,
601 * the output will be sent to a temporary file that will be deleted when
602 * it is closed.
603 * @xref{output controls}.
604 =*/
605 SCM
ag_scm_out_push_new(SCM new_file)606 ag_scm_out_push_new(SCM new_file)
607 {
608 static char const write_mode[] = "w" FOPEN_BINARY_FLAG "+";
609
610 if (scm_is_string(new_file)) {
611 open_output_file(scm_i_string_chars(new_file),
612 scm_c_string_length(new_file), write_mode, 0);
613 return SCM_UNDEFINED;
614 }
615
616 /*
617 * "ENABLE_FMEMOPEN" is defined if we have either fopencookie(3GNU) or
618 * funopen(3BSD) is available and autogen was not configured with fmemopen
619 * disabled. We cannot use the POSIX fmemopen.
620 */
621 #if defined(ENABLE_FMEMOPEN)
622 if (! HAVE_OPT(NO_FMEMOPEN)) {
623 char * pzNewFile;
624 out_stack_t * p;
625
626 /*
627 * This block is used IFF ENABLE_FMEMOPEN is defined and if
628 * --no-fmemopen is *not* selected on the command line.
629 */
630 p = (out_stack_t *)AGALOC(sizeof(out_stack_t), "out file stack");
631 p->stk_prev = cur_fpstack;
632 p->stk_flags = FPF_FREE;
633 p->stk_fp = ag_fmemopen(NULL, (ssize_t)0, "w" FOPEN_BINARY_FLAG "+");
634 pzNewFile = (char *)MEM_FILE_STR;
635 p->stk_flags |= FPF_STATIC_NM | FPF_NOUNLINK | FPF_NOCHMOD;
636
637 if (p->stk_fp == NULL)
638 AG_CANT(OUT_PUSH_NEW_FAIL, pzNewFile);
639
640 p->stk_fname = pzNewFile;
641 outputDepth++;
642 cur_fpstack = p;
643
644 if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
645 fprintf(trace_fp, TRACE_OUT_PUSH_NEW, __func__, pzNewFile);
646 return SCM_UNDEFINED;
647 }
648 #endif
649
650 /*
651 * Either --no-fmemopen was specified or we cannot use ag_fmemopen().
652 */
653 {
654 static size_t tmplen;
655 char * tmp_fnm;
656 int tmpfd;
657
658 if (pz_temp_tpl == NULL)
659 ag_scm_make_tmp_dir();
660
661 tmplen = temp_tpl_dir_len + 10;
662 tmp_fnm = scribble_get((ssize_t)tmplen + 1);
663 memcpy(tmp_fnm, pz_temp_tpl, tmplen + 1);
664 tmpfd = mkstemp(tmp_fnm);
665
666 if (tmpfd < 0)
667 AG_ABEND(aprf(OUT_PUSH_NEW_FAILED, pz_temp_tpl));
668
669 open_output_file(tmp_fnm, tmplen, write_mode, FPF_TEMPFILE);
670 close(tmpfd);
671 }
672
673 return SCM_UNDEFINED;
674 }
675
676 /*=gfunc out_switch
677 *
678 * what: close and create new output
679 * exparg: file-name, name of the file to create
680 *
681 * doc:
682 * Switch output files - close current file and make the current
683 * file pointer refer to the new file. This is equivalent to
684 * @code{out-pop} followed by @code{out-push-new}, except that
685 * you may not pop the base level output file, but you may
686 * @code{switch} it. @xref{output controls}.
687 =*/
688 SCM
ag_scm_out_switch(SCM new_file)689 ag_scm_out_switch(SCM new_file)
690 {
691 char * new_fname;
692
693 if (! scm_is_string(new_file))
694 return SCM_UNDEFINED;
695 {
696 size_t sz = scm_c_string_length(new_file);
697 new_fname = AGALOC(sz + 1, "new file name");
698 memcpy(new_fname, scm_i_string_chars(new_file), sz);
699 new_fname[ sz ] = NUL;
700 }
701
702 /*
703 * IF no change, THEN ignore this
704 */
705 if (strcmp(cur_fpstack->stk_fname, new_fname) == 0) {
706 AGFREE(new_fname);
707 return SCM_UNDEFINED;
708 }
709
710 make_readonly();
711
712 /*
713 * Make sure we get a new file pointer!!
714 * and try to ensure nothing is in the way.
715 */
716 unlink(new_fname);
717 if ( freopen(new_fname, "w" FOPEN_BINARY_FLAG "+", cur_fpstack->stk_fp)
718 != cur_fpstack->stk_fp)
719
720 AG_CANT(OUT_SWITCH_FAIL, new_fname);
721
722 /*
723 * Set the mod time on the old file.
724 */
725 set_utime(cur_fpstack->stk_fname);
726
727 if (OPT_VALUE_TRACE > TRACE_DEBUG_MESSAGE)
728 fprintf(trace_fp, TRACE_OUT_SWITCH,
729 __func__, cur_fpstack->stk_fname, new_fname);
730 cur_fpstack->stk_fname = new_fname; /* FIXME: memory leak */
731
732 return SCM_UNDEFINED;
733 }
734
735
736 /*=gfunc out_depth
737 *
738 * what: output file stack depth
739 * doc: Returns the depth of the output file stack.
740 * @xref{output controls}.
741 =*/
742 SCM
ag_scm_out_depth(void)743 ag_scm_out_depth(void)
744 {
745 return scm_from_int(outputDepth);
746 }
747
748
749 /*=gfunc out_name
750 *
751 * what: current output file name
752 * doc: Returns the name of the current output file. If the current file
753 * is a temporary, unnamed file, then it will scan up the chain until
754 * a real output file name is found.
755 * @xref{output controls}.
756 =*/
757 SCM
ag_scm_out_name(void)758 ag_scm_out_name(void)
759 {
760 out_stack_t * p = cur_fpstack;
761 while (p->stk_flags & FPF_UNLINK) p = p->stk_prev;
762 return scm_from_latin1_string(VOIDP(p->stk_fname));
763 }
764
765
766 /*=gfunc out_line
767 *
768 * what: output file line number
769 * doc: Returns the current line number of the output file.
770 * It rewinds and reads the file to count newlines.
771 =*/
772 SCM
ag_scm_out_line(void)773 ag_scm_out_line(void)
774 {
775 int lineNum = 1;
776
777 do {
778 long svpos = ftell(cur_fpstack->stk_fp);
779 long pos = svpos;
780
781 if (pos == 0)
782 break;
783
784 rewind(cur_fpstack->stk_fp);
785 do {
786 int ch = fgetc(cur_fpstack->stk_fp);
787 if (ch < 0)
788 break;
789 if (ch == (int)NL)
790 lineNum++;
791 } while (--pos > 0);
792 fseek(cur_fpstack->stk_fp, svpos, SEEK_SET);
793 } while(0);
794
795 return scm_from_int(lineNum);
796 }
797
798 #if 0 /* for compilers that do not like C++ comments... */
799 // This is done so that comment delimiters can be included in the doc.
800 //
801 // /*=gfunc make_header_guard
802 // *
803 // * what: make self-inclusion guard
804 // *
805 // * exparg: name , header group name
806 // *
807 // * doc:
808 // * This function will create a @code{#ifndef}/@code{#define}
809 // * sequence for protecting a header from multiple evaluation.
810 // * It will also set the Scheme variable @code{header-file}
811 // * to the name of the file being protected and it will set
812 // * @code{header-guard} to the name of the @code{#define} being
813 // * used to protect it. It is expected that this will be used
814 // * as follows:
815 // * @example
816 // * [+ (make-header-guard "group_name") +]
817 // * ...
818 // * #endif /* [+ (. header-guard) +] */
819 // *
820 // * #include "[+ (. header-file) +]"
821 // * @end example
822 // * @noindent
823 // * The @code{#define} name is composed as follows:
824 // *
825 // * @enumerate
826 // * @item
827 // * The first element is the string argument and a separating underscore.
828 // * @item
829 // * That is followed by the name of the header file with illegal
830 // * characters mapped to underscores.
831 // * @item
832 // * The end of the name is always, "@code{_GUARD}".
833 // * @item
834 // * Finally, the entire string is mapped to upper case.
835 // * @end enumerate
836 // *
837 // * The final @code{#define} name is stored in an SCM symbol named
838 // * @code{header-guard}. Consequently, the concluding @code{#endif} for the
839 // * file should read something like:
840 // *
841 // * @example
842 // * #endif /* [+ (. header-guard) +] */
843 // * @end example
844 // *
845 // * The name of the header file (the current output file) is also stored
846 // * in an SCM symbol, @code{header-file}. Therefore, if you are also
847 // * generating a C file that uses the previously generated header file,
848 // * you can put this into that generated file:
849 // *
850 // * @example
851 // * #include "[+ (. header-file) +]"
852 // * @end example
853 // *
854 // * Obviously, if you are going to produce more than one header file from
855 // * a particular template, you will need to be careful how these SCM symbols
856 // * get handled.
857 // =*/
858 #endif
859 SCM
ag_scm_make_header_guard(SCM name)860 ag_scm_make_header_guard(SCM name)
861 {
862
863 char const * opz; // output file name string
864 size_t osz;
865
866 char const * gpz; // guard name string
867 size_t gsz;
868
869 {
870 out_stack_t * p = cur_fpstack;
871 while (p->stk_flags & FPF_UNLINK) p = p->stk_prev;
872 opz = p->stk_fname;
873 osz = strlen(opz);
874 }
875
876 /*
877 * Construct the gard name using the leader (passed in or "HEADER")
878 * and the trailer (always "_GUARD") and the output file name in between.
879 */
880 {
881 /*
882 * Leader string and its length. Usually passed, but defaults
883 * to "HEADER"
884 */
885 char const * lpz =
886 scm_is_string(name) ? scm_i_string_chars(name) : HEADER_STR;
887 size_t lsz = (lpz == HEADER_STR)
888 ? HEADER_STR_LEN : scm_c_string_length(name);
889
890 /*
891 * Full, maximal length of output
892 */
893 size_t hsz = lsz + osz + GUARD_SFX_LEN + 2;
894 char * scan_p;
895
896 /*
897 * Sanity:
898 */
899 if (*lpz == NUL) {
900 lpz = HEADER_STR;
901 lsz = HEADER_STR_LEN;
902 hsz += lsz;
903 }
904 scan_p = AGALOC(hsz, "header guard string");
905
906 gpz = scan_p; // gpz must be freed
907 do {
908 *(scan_p++) = (char)toupper(*(lpz++));
909 } while (--lsz > 0);
910
911 /*
912 * This copy converts non-alphanumerics to underscores,
913 * but never inserts more than one at a time. Thus, we may
914 * not use all of the space in "gpz".
915 */
916 lpz = opz;
917 do {
918 *(scan_p++) = '_';
919 lpz = BRK_ALPHANUMERIC_CHARS(lpz);
920 while (IS_ALPHANUMERIC_CHAR(*lpz))
921 *(scan_p++) = (char)toupper((unsigned char)*(lpz++));
922 } while (*lpz != NUL);
923
924 memcpy(scan_p, GUARD_SFX, GUARD_SFX_LEN + 1);
925 gsz = (size_t)(scan_p - gpz) + GUARD_SFX_LEN;
926 }
927
928 {
929 size_t sz1 = MK_HEAD_GUARD_SCM_LEN + gsz + osz;
930 size_t sz2 = MK_HEAD_GUARD_GUARD_LEN + 2 * gsz;
931 size_t sz = (sz1 < sz2) ? sz2 : sz1;
932 char * p = scribble_get((ssize_t)sz);
933 if (snprintf(p, sz, MK_HEAD_GUARD_SCM, opz, gpz) >= (int)sz)
934 AG_ABEND(BOGUS_TAG);
935 (void)ag_scm_c_eval_string_from_file_line(p, __FILE__, __LINE__);
936
937 if (snprintf(p, sz, MK_HEAD_GUARD_GUARD, gpz) >= (int)sz)
938 AG_ABEND(BOGUS_TAG);
939 name = scm_from_latin1_string(p);
940 }
941
942 AGFREE(gpz);
943 return (name);
944 }
945
946 /**
947 * @}
948 *
949 * Local Variables:
950 * mode: C
951 * c-file-style: "stroustrup"
952 * indent-tabs-mode: nil
953 * End:
954 * end of agen5/expOutput.c */
955