/[ascend]/trunk/tcltk98/generic/interface/typelex.l
ViewVC logotype

Contents of /trunk/tcltk98/generic/interface/typelex.l

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (show annotations) (download)
Sun Apr 2 07:05:54 2006 UTC (16 years, 1 month ago) by ben.allan
File size: 25538 byte(s)
Restored autotools to working, parsers to typ_ and zz_,
Fixed many missing initializations, many casting insanities
that have been creeping in, many missing forward declarations
in preparation for fixing external relations.

1 %{
2 /*
3 * TypeExtractor.l
4 * by Kirk Abbott and Ben Allan
5 * Created: 1/94
6 * Version: $Revision: 1.20 $
7 * Version control file: $RCSfile: typelex.l,v $
8 * Date last modified: $Date: 2003/08/23 18:43:09 $
9 * Last modified by: $Author: ballan $
10 *
11 * This file is part of the ASCEND Tcl/Tk interface
12 *
13 * Copyright 1997, Carnegie Mellon University
14 *
15 * The ASCEND Tcl/Tk interface is free software; you can redistribute
16 * it and/or modify it under the terms of the GNU General Public License as
17 * published by the Free Software Foundation; either version 2 of the
18 * License, or (at your option) any later version.
19 *
20 * The ASCEND Tcl/Tk interface is distributed in hope that it will be
21 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 * General Public License for more details.
24 *
25 * You should have received a copy of the GNU General Public License
26 * along with the program; if not, write to the Free Software Foundation,
27 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
28 * COPYING. COPYING is found in ../compiler.
29 */
30
31 /*
32 * ASCEND Type Retriever 1.2
33 *
34 * Purpose:
35 * To extract a type definition from an input file.
36 * Usage:
37 * See the header file for use from within ASCEND.
38 * For stand-alone use:
39 * typer [flags] ascend_type_name input_file output_file
40 * flags: -c show comments
41 * If no -c given, strip out comments.
42 * Features:
43 * --Does not descend into REQUIREd files. Only examines input_file
44 * for definitions of ascend_type_name.
45 * --This version DOES handle the UNIVERSAL quantifier.
46 *
47 */
48
49 #define MY_YYMORE() yymore()
50
51 #include <tcl.h>
52 #include <utilities/ascConfig.h>
53 #include <general/list.h>
54 #ifndef TYPER_TEST
55 /* for handling string modules and results in interp */
56 #include <compiler/compiler.h>
57 #include <compiler/symtab.h>
58 #include <compiler/fractions.h>
59 #include <compiler/dimen.h>
60 #include <compiler/child.h>
61 #include <compiler/type_desc.h>
62 #include <compiler/library.h>
63 #include <compiler/module.h>
64 #include "HelpProc.h" /* help is not necessary for test */
65 #endif /*!typertest*/
66
67 #include "typelex.h"
68
69
70 #ifndef lint
71 static const char TyperID[] = "$Id: typelex.l,v 1.20 2003/08/23 18:43:09 ballan Exp $";
72 #endif
73
74 #define YY_BREAK
75 /*
76 * Defining yybreak as above (empty) means that all of our matches must end
77 * in break or return because the normal flex supplied yybreak will
78 * be preempted by our empty one.
79 * In cases where matches contain a conditional return, make sure a
80 * break follows in the failure case.
81 */
82
83 static int CommentNestLevel = 0;
84 /*
85 * Nesting level of (* comments *)
86 */
87
88 static int BracesNestLevel = 0;
89 /*
90 * Nesting level of {braced} expressions
91 */
92
93 enum keyword_tokens {
94 NONE, /* Nothing to match, we're in the initial state */
95 MODEL, /* We've just read a MODEL or ATOM keyword */
96 MODEL_END, /* We've just read an END keyword inside a MODEL,
97 * an ATOM, or a DEFINITION. */
98 CONSTANT /* We've just read a CONSTANT keyword */
99 };
100 static enum keyword_tokens MatchedToken = NONE;
101 /*
102 * The recognized token we've most recently read. This usually implies
103 * that we're either in that state or we need to check the next keyword
104 * to see if we should enter (or leave, in the case of MODEL_END) that
105 * state. MODEL, ATOM, and DEFINITION state are equivalent.
106 */
107
108 static int ShowComments = 0;
109 /*
110 * Should we print comments? (1 = yes, 0 = no)
111 * This is set to 1 with `-c' on the command line
112 */
113
114 static unsigned long StartId = 0;
115 /*
116 * The location in the `typ_text' array where the MODEL, ATOM, or CONSTANT
117 * identifierbegins. We save this value and call MY_YYMORE() when we find
118 * a MODEL, ATOM, or CONSTANT keyword; StartId tells us where the
119 * Identifier will go.
120 */
121
122 static char *reqType = "";
123 /*
124 * The type we are looking for. This is one of the arguments passed
125 * to Asc_ExtractType() in the argv vector.
126 */
127
128 static void Asc_PutCode(char *s,FILE *fp);
129
130 static Tcl_Interp *g_typ__interp;
131 /* during parse, set to caller's interp if string result is wanted
132 * instead of file.
133 */
134
135 #ifdef TYPER_TEST
136 /*
137 * Specify ASCERR, ASCWAR when building stand alone.
138 */
139 FILE *ASCERR = stderr;
140 FILE *ASCWAR = stderr;
141 #endif /* TYPER_TEST */
142
143 %}
144
145 ws [\f\r\t\v ]
146 digit [0-9]
147 letter [a-zA-Z]
148
149 ident {letter}({digit}|{letter}|_)*
150
151 model MODEL{ws}+
152 atom ATOM{ws}+
153 definition DEFINITION{ws}+
154 end END{ws}+
155 univ UNIVERSAL{ws}+
156 constant CONSTANT{ws}+
157
158 %x Comment
159 %x BracedText
160 %x Model
161 %x Constant
162 %x CheckID
163
164 %option yymore
165 %%
166
167 /*
168 * Code to handle (* Comments *)
169 *
170 * "(*" puts us into the Comment state. Comments nest, so in the
171 * Comment state we need to look for "(*" that increases the nesting
172 * level and "*)" that will lower it.
173 * Do NOT try to match \(\*+ since that causes "(****)" to parse
174 * incorrectly.
175 */
176
177 <INITIAL>\(\* |
178 <Model>\(\* |
179 <Constant>\(\* {
180 /* Match "(" followed by "*" puts us into
181 * the COMMENT state. Don't use \*+ since
182 * that will parse "(***)" incorrectly.
183 * Initialize the nesting level.
184 * Print if ShowComments is TRUE and
185 * MatchedToken is not NONE
186 */
187 BEGIN(Comment);
188 CommentNestLevel = 1;
189 if( ShowComments && MatchedToken!=NONE ) {
190 Asc_PutCode( typ_text, typ_out );
191 }
192 break;
193 }
194 <Comment>\(\*[^*(]* {
195 /* Match "(" followed "*" followed by
196 * anything that's not "(" nor "*".
197 * `anything' includes newlines.
198 * Increase the commment nesting level.
199 * Print if ShowComments is TRUE and
200 * MatchedToken is not NONE.
201 */
202 CommentNestLevel++;
203 if( ShowComments && MatchedToken!=NONE ) {
204 Asc_PutCode( typ_text, typ_out );
205 }
206 break;
207 }
208 <Comment>[^*(]*\*+\) {
209 /* Match anything not "*" or "(" followed
210 * by one or more "*"s followed by ")".
211 * `anything' includes newlines.
212 * This decreases the comment nesting level
213 * and kicks us out if we're back to zero.
214 * Print if ShowComments is TRUE and
215 * MatchedToken is not NONE.
216 */
217 CommentNestLevel--;
218 if( CommentNestLevel > 0 ) {
219 /* more comments */
220 break;
221 }
222 if( MatchedToken == NONE ) {
223 BEGIN(INITIAL);
224 break;
225 }
226 if( ShowComments ) {
227 Asc_PutCode( typ_text, typ_out );
228 }
229 switch( MatchedToken ) {
230 case MODEL:
231 BEGIN(Model);
232 break;
233 case CONSTANT:
234 BEGIN(Constant);
235 break;
236 default:
237 BEGIN(INITIAL);
238 break;
239 }
240 break;
241 }
242 <Comment>[^*(]* |
243 <Comment>\(+[^*(]* |
244 <Comment>\*+[^*()]* {
245 /*
246 * These three rules eat:
247 * -- anything that's not a "*" or a "("
248 * -- "("s not followed by "*"
249 * -- "*"s not followed by ")"
250 * `anything' includes newlines.
251 * Print if ShowComments is TRUE and
252 * MatchedToken is not NONE
253 */
254 if( ShowComments && MatchedToken!=NONE ) {
255 Asc_PutCode( typ_text, typ_out );
256 }
257 break;
258 }
259
260
261 /*
262 * Code to handle { Text in Braces }
263 *
264 * "{" puts us into the BracedText state. Braces nest, so
265 * in the BracedText state we need to look for "{" that increases
266 * the nesting level and "}" that will lower it.
267 */
268
269 <INITIAL>\{ |
270 <Model>\{ |
271 <Constant>\{ {
272 /* A "{" puts us into the BracedText state.
273 * Initialize the nesting level.
274 * Print if MatchedToken is not NONE.
275 *
276 */
277 BEGIN(BracedText);
278 BracesNestLevel = 1;
279 if( MatchedToken != NONE ) {
280 Asc_PutCode( typ_text, typ_out );
281 }
282 break;
283 }
284 <BracedText>[^\\{}]*\\. {
285 /* A backslash \ in the BracedText state
286 * protects any character---even a
287 * newline---and does not affect the
288 * Nesting Level.
289 * Print if MatchedToken is not NONE.
290 */
291 if( MatchedToken != NONE ) {
292 Asc_PutCode( typ_text, typ_out );
293 }
294 break;
295 }
296 <BracedText>[^\\{}]*\\\n {
297 /* A backslash \ in the BracedText state
298 * protects any character---even a
299 * newline---and does not affect the
300 * Nesting Level.
301 * Print if MatchedToken is not NONE.
302 */
303 if( MatchedToken != NONE ) {
304 Asc_PutCode( typ_text, typ_out );
305 }
306 break;
307 }
308 <BracedText>\{[^\\{}]* {
309 /* A "{" in the braces state gets added to
310 * the text and increase the nesting level.
311 * Match any non-brace character---including
312 * newlines---that follows the open brace.
313 * Print if MatchedToken is not NONE.
314 */
315 BracesNestLevel++;
316 if( MatchedToken != NONE ) {
317 Asc_PutCode( typ_text, typ_out );
318 }
319 break;
320 }
321 <BracedText>[^\\{}]*\} {
322 /* A "}" will reduce the nesting level.
323 * If the nesting level is zero, go back to
324 * the previous state. Match any
325 * non-brace character---including
326 * newlines---that precedes the close brace.
327 * Print if MatchedToken is not NONE.
328 */
329 BracesNestLevel--;
330 if (BracesNestLevel > 0) {
331 /* more braced text */
332 break;
333 }
334 if( MatchedToken == NONE ) {
335 BEGIN(INITIAL);
336 break;
337 }
338 Asc_PutCode( typ_text, typ_out );
339 switch( MatchedToken ) {
340 case MODEL:
341 BEGIN(Model);
342 break;
343 case CONSTANT:
344 BEGIN(Constant);
345 break;
346 default:
347 BEGIN(INITIAL);
348 break;
349 }
350 break;
351 }
352 <BracedText>[^\\{}]* {
353 /* Match anything that is not "{" nor "}"
354 * nor "\\"(backslash).
355 * `anything' includes newlines.
356 * Print if MatchedToken is not NONE.
357 */
358 if( MatchedToken != NONE ) {
359 Asc_PutCode( typ_text, typ_out );
360 }
361 break;
362 }
363
364
365
366 /*
367 * Code to check an identifier.
368 *
369 * When we are looking for a MODEL, ATOM, CONSTANT, or DEFIITION
370 * and we find the text [UNIVERSAL]{MODEL|ATOM|CONSTANT|DEFINITION},
371 * we enter this state.
372 *
373 * When we are insided MODEL, ATOM, or DEFINITION and we find
374 * the text END, we enter this state.
375 *
376 * This state checks to see if the text following the MODEL,
377 * ATOM, CONSTANT, DEFINITION, or END keyword matches
378 * `reqType'---the type requested by the user. If so, we are
379 * at the beginning or end of a type, and should change states
380 * accordingly. If not, we should stay in our current state.
381 */
382
383 <CheckID>{ident} {
384 /*
385 * Found an identifier.
386 * Identify the correct state.
387 */
388 if( MatchedToken == MODEL_END ) {
389 /*
390 * We're in the Model state, print the
391 * text and see if matches reqType, if
392 * so, we're at the end of the MODEL
393 * (or ATOM or DEFINITION)
394 * and should exit typ_lex()---return to
395 * our caller, else stay in the Model
396 * state.
397 */
398 Asc_PutCode( typ_text, typ_out );
399 if(strcmp((typ_text+StartId),reqType) == 0) {
400 return 0;
401 } else {
402 MatchedToken = MODEL;
403 BEGIN(Model);
404 }
405 break;
406 }
407 if(strcmp((typ_text+StartId),reqType)==0){
408 /*
409 * We're in the INITIAL state, and we
410 * found the beginning of the
411 * requested MODEL, ATOM, CONSTANT,
412 * or DEFINITION.
413 * Print the text and set OutputState to
414 * say we are printing. Start the
415 * appropriate State by checking
416 * MatchedToken.
417 */
418 Asc_PutCode( typ_text, typ_out );
419 switch( MatchedToken ) {
420 case MODEL:
421 BEGIN(Model);
422 break;
423 case CONSTANT:
424 BEGIN(Constant);
425 break;
426 default:
427 /* something is wrong */
428 BEGIN(INITIAL);
429 break;
430 }
431 break;
432 }
433 /*
434 * We're in the INITIAL state; we found
435 * an MODEL, ATOM, CONSTANT, or
436 * DEFINITION, but it wasn't the right
437 * one. Stay in the INITIAL state.
438 */
439 MatchedToken = NONE;
440 BEGIN(INITIAL);
441 break;
442 }
443 <CheckID>. {
444 /*
445 * Some text other than an identifier
446 * was found. Print the text if
447 * MatchedToken is not NONE,
448 * and return to the correct state.
449 */
450 if( MatchedToken == NONE ) {
451 BEGIN(INITIAL);
452 break;
453 }
454 Asc_PutCode( typ_text, typ_out );
455 switch( MatchedToken ) {
456 case MODEL:
457 BEGIN(Model);
458 break;
459 case CONSTANT:
460 BEGIN(Constant);
461 break;
462 default:
463 /* something is wrong */
464 BEGIN(INITIAL);
465 break;
466 }
467 break;
468 }
469
470
471
472 /*
473 * Code to handle the model/atom/definition we want.
474 *
475 * Once we've found the start of the matching MODEL, ATOM, or
476 * DEFINITION, print the text until we find the END token.
477 * When we find END, save the current length of typ_text and use
478 * MY_YYMORE() to append the identifier, then check the identifier
479 * (in the CheckID state) to see if it is what we want. If so,
480 * this is the end of this MODEL, ATOM, or DEFINITION.
481 */
482
483 <Model>{end} {
484 /*
485 * Found the END keyword. Save the
486 * current location in the typ_text array,
487 * then enter the CheckID state to see if
488 * the identifier matches what we want.
489 */
490 StartId = typ_leng;
491 MatchedToken = MODEL_END;
492 BEGIN(CheckID);
493 MY_YYMORE();
494 break;
495 }
496 <Model>[^({A-Z]+ |
497 <Model>\(+[^*({A-Z]* |
498 <Model>[A-Z_]+;?{ws}* {
499 /*
500 * These rules match
501 * -- any character except that which
502 * would cause us to change states
503 * -- "("s not followed by "*"s
504 * -- uppercase keywords and following
505 * semicolon or whitespace.
506 * Print the text.
507 */
508 Asc_PutCode( typ_text, typ_out );
509 break;
510 }
511
512
513
514 /*
515 * Code to handle the constant definition we want.
516 *
517 * Once we've found the start of the matching CONSTANT, print
518 * the text until we find a semicolon ";".
519 */
520
521 <Constant>; {
522 /*
523 * Found the ";" which ends the CONSTANT.
524 * Do NOT print it since that will be
525 * added below. Return 0.
526 */
527 return 0;
528 }
529 <Constant>[^({;]+ |
530 <Constant>\(+[^*({;]* {
531 /*
532 * These rules match
533 * -- any character except that which
534 * would cause us to change states
535 * -- "("s not followed by "*"s
536 * Print the text.
537 */
538 Asc_PutCode( typ_text, typ_out );
539 break;
540 }
541
542
543
544 /*
545 * Code to look for [UNIVERSAL ]{MODEL|ATOM|CONSTANT|DEFINITION}.
546 *
547 * If we find UNIVERSAL, use yymore() to append the next
548 * keyword---probably MODEL, ATOM, or CONSTANT.
549 * If we find MODEL, ATOM, CONSTANT, or DEFINITION save the
550 * current length and use yymore() to append the identifier,
551 * then check the identifier (in the CheckID state) to see if
552 * it is what we're looking for.
553 */
554
555 <INITIAL>{univ} {
556 /*
557 * Found the UNIVERSAL keyword. Append
558 * the following ATOM/MODEL/CONSTANT
559 * keyword.
560 */
561 MY_YYMORE();
562 break;
563 }
564 <INITIAL>{model} |
565 <INITIAL>{atom} |
566 <INITIAL>{definition} {
567 /*
568 * Found an MODEL, ATOM, or DEFINITION
569 * keyword--perhaps with a UNIVERSAL
570 * modifier. Save the current location
571 * in the typ_text array, then enter the
572 * CheckID state to see if the identifier
573 * matches what we want.
574 */
575 StartId = typ_leng;
576 MatchedToken = MODEL;
577 BEGIN(CheckID);
578 MY_YYMORE();
579 break;
580 }
581 <INITIAL>{constant} {
582 /*
583 * Found a CONSTANT keyword--perhaps
584 * with a UNIVERSAL modifier. Save the
585 * current location in the typ_text array,
586 * then enter the CheckID state to see if
587 * the identifier matches what we want.
588 */
589 StartId = typ_leng;
590 MatchedToken = CONSTANT;
591 BEGIN(CheckID);
592 MY_YYMORE();
593 break;
594 }
595
596
597
598 /*
599 * Rules to match other text.
600 */
601
602
603 <INITIAL>[^({A-Z]+ |
604 <INITIAL>\(+[^*({A-Z]* |
605 <INITIAL>[A-Z_]+;?{ws}* {
606 /*
607 * These rules match
608 * -- any character except that which
609 * would cause us to change states
610 * -- "("s not followed by "*"s
611 * -- uppercase keywords and following
612 * semicolon or whitespace.
613 * Do nothing.
614 */
615 break;
616 }
617 <INITIAL><<EOF>> {
618 /*
619 * Reached End of file without a match
620 */
621 return 1;
622 }
623
624
625 %%
626 /*
627 * int typ_wrap(void);
628 *
629 * This returns 1 if the scanner should stop parsing, or 0 if
630 * the scanner should continue. Flex requires this function
631 * unless the flex directive `%option nozzwrap' is given, but
632 * `%option' directives are a recent addition to flex and for
633 * maximum portability should not be used.
634 */
635 int typ_wrap(void)
636 {
637 return 1;
638 }
639
640
641 #ifndef TYPER_TEST
642 STDHLF(Asc_ExtractType,(Asc_ExtractTypeHL1,Asc_ExtractTypeHL2,HLFSTOP));
643 #endif
644
645 /*
646 * int Asc_ExtractType(cdata, interp, argc, argv)
647 * ClientData cdata; --Tcl information, not used
648 * Tcl_Interp *interp; --Tcl interpreter, not used in standalone use
649 * int argc; --the number of arguments
650 * char **argv; --the array of arguments
651 *
652 * When running as part of ASCEND, returns TCL_OK or TCL_ERROR.
653 * When running as a stand alone tool (CPP macro TYPER_TEST is defined)
654 * we return:
655 * 0 --success
656 * 1 --problems with arguments
657 * 2 --problems opening file
658 * -1 --no errors occurred but the requested type was not found
659 *
660 */
661 extern int Asc_ExtractType(ClientData cdata, Tcl_Interp *interp,
662 int argc, CONST84 char **argv)
663 {
664 int ndx = 1; /* index into the argv array */
665 int result; /* result from typ_lex and value to return to caller */
666 #ifndef TYPER_TEST
667 struct TypeDescription *desc=NULL;
668 struct module_t *mod=NULL;
669 CONST char *scanstring=NULL;
670 YY_BUFFER_STATE oldbuf=NULL;
671 YY_BUFFER_STATE scanbuf=NULL;
672 #endif /*!typertest*/
673
674 (void)cdata; /* stop gcc whining about unused parameter */
675 #ifdef TYPER_TEST
676 (void)interp; /* stop gcc whining about unused parameter */
677 #endif
678
679
680 /*
681 * Reset our global set
682 */
683 BEGIN( INITIAL );
684 MatchedToken = NONE;
685 ShowComments = 0;
686 reqType = "";
687 CommentNestLevel = 0;
688 BracesNestLevel = 0;
689
690
691 /*
692 * Process the arguments
693 */
694 if (( argc < 2 ) || ( argc > 5 )) {
695 #ifdef TYPER_TEST
696 FPRINTF(ASCERR,
697 "Wrong number of arguments\n"
698 "Usage: %s [-c] type [source_file] [destination_file]\n",
699 argv[0]);
700 return 1;
701 #else /* ! TYPER_TEST */
702 Tcl_AppendResult(interp, "Wrong number of arguments\nUsage: ",
703 argv[0], "[-c] type [source_file] "
704 "[-s,destination_file]",
705 (char*)NULL);
706 return TCL_ERROR;
707 #endif /* TYPER_TYPER */
708 }
709
710 if(( argc > ndx ) && ( argv[ndx][0] == '-' )) {
711 switch( argv[ndx][1] ) {
712 case 'c':
713 ShowComments = 1;
714 ndx++;
715 break;
716 default:
717 #ifdef TYPER_TEST
718 FPRINTF(ASCERR, "Unknown switch %s\n", argv[ndx]);
719 return 1;
720 #else /* ! TYPER_TEST */
721 Tcl_AppendResult(interp, "Unknown switch ", argv[ndx], (char*)NULL);
722 return TCL_ERROR;
723 #endif /* TYPER_TEST */
724 }
725 }
726
727 if( argc > ndx ) {
728 /* The type of MODEL/ATOM to get */
729 reqType = QUIET(argv[ndx++]);
730 } else {
731 #ifdef TYPER_TEST
732 FPRINTF(ASCERR,
733 "Wrong number of arguments\n"
734 "Usage: %s [-c] type [source_file] [destination_file]\n",
735 argv[0]);
736 return 1;
737 #else /* ! TYPER_TEST */
738 Tcl_AppendResult(interp, "Wrong number of arguments\nUsage: ",
739 argv[0], "[-c] type [source_file] "
740 "[-s,destination_file]",
741 (char*)NULL);
742 return TCL_ERROR;
743 #endif /* TYPER_TEST */
744 }
745
746 if( argc > ndx ) {
747 /* The source file; stdin if not specified. */
748 #ifndef TYPER_TEST
749 /* in ascend, find source module if possible for string module name */
750 desc = FindType(AddSymbol(reqType));
751 if (desc != NULL) {
752 mod = GetModule(desc);
753 assert(mod!=NULL);
754 scanstring = Asc_ModuleString(mod);
755 if (scanstring == NULL) {
756 mod = NULL;
757 }
758 }
759 #endif /*!typertest*/
760 if(scanstring == NULL && (typ_in = fopen(argv[ndx],"r")) == NULL) {
761 #ifdef TYPER_TEST
762 FPRINTF(ASCERR, "Error opening source file \'%s\'\n", argv[ndx]);
763 return 2;
764 #else /* ! TYPER_TEST */
765 Tcl_AppendResult(interp, "Error opening source file \'",
766 argv[ndx], "\'", (char*)NULL);
767 return TCL_ERROR;
768 #endif /* TYPER_TEST */
769 }
770 ndx++;
771 } else {
772 typ_in = stdin;
773 }
774
775 if( argc > ndx ) {
776 #ifndef TYPER_TEST
777 if (argv[ndx][0] == '-' && argv[ndx][1] == 's') {
778 g_typ__interp = interp;
779 typ_out = NULL;
780 } else {
781 #endif /* !typertest*/
782 g_typ__interp = NULL;
783 /* The destination file; stdout if not specified */
784 if((typ_out = fopen(argv[ndx],"a+")) == NULL) {
785 #ifdef TYPER_TEST
786 FPRINTF(ASCERR, "Error opening destination file \'%s\'\n", argv[ndx]);
787 return 2;
788 #else /* ! TYPER_TEST */
789 Tcl_AppendResult(interp, "Error opening destination file \'",
790 argv[ndx], "\'", (char*)NULL);
791 return TCL_ERROR;
792 #endif /* TYPER_TEST */
793 }
794 #ifndef TYPER_TEST
795 }
796 #endif /* !typertest*/
797 ndx++;
798 } else {
799 typ_out = stdout;
800 }
801
802
803 /*
804 * Call typ_lex() to process the input
805 */
806 #ifndef TYPER_TEST
807 if (scanstring != NULL) {
808 oldbuf = YY_CURRENT_BUFFER;
809 scanbuf = typ__scan_string(scanstring);
810 typ__switch_to_buffer(scanbuf);
811 BEGIN(INITIAL);
812 /* typ_restart((FILE *)NULL); */
813 }
814 #else
815 typ_restart(typ_in);
816 #endif /* !typertest */
817 if( (result = typ_lex()) != 0 ) {
818 #ifdef TYPER_TEST
819 FPRINTF(ASCERR, "Could not find type \'%s\'\n", reqType);
820 #else /* ! TYPER_TEST */
821 if (g_typ__interp!=NULL) {
822 Tcl_ResetResult(interp);
823 }
824 Tcl_AppendResult(interp, "Could not find type \'", reqType, "\'",
825 (char*)NULL);
826 result = TCL_ERROR;
827 #endif /* TYPER_TEST */
828 } else {
829 /* add a closing semicolon and newline */
830 Asc_PutCode( ";\n", typ_out );
831 #ifndef TYPER_TEST
832 result = TCL_OK;
833 #endif /* ! TYPER_TEST */
834 }
835
836 /*
837 * Close any files/buffers we opened and exit.
838 */
839 #ifndef TYPER_TEST
840 if (scanstring != NULL) {
841 typ__delete_buffer(YY_CURRENT_BUFFER);
842 typ__switch_to_buffer(oldbuf);
843 BEGIN(INITIAL);
844 }
845 #endif
846 if ( typ_in != stdin && typ_in != NULL) {
847 fclose(typ_in);
848 }
849 if ( typ_out != stdout && typ_out != NULL) {
850 fclose(typ_out);
851 }
852
853 return result;
854 }
855
856 static void Asc_PutCode(char *s,FILE *fp)
857 /** into string or screen */
858 {
859 #ifndef TYPER_TEST
860 if (g_typ__interp != NULL) {
861 Tcl_AppendResult(g_typ__interp,s,(char *)NULL);
862 } else {
863 #endif /* typertest */
864 fputs(s,fp);
865 #ifndef TYPER_TEST
866 }
867 #endif /* typertest */
868 }
869
870 #ifdef TYPER_TEST
871 int main(int argc, char **argv)
872 {
873 return Asc_ExtractType((ClientData)NULL, (Tcl_Interp*)NULL, argc, argv);
874 }
875 #endif /* TYPER_TEST */

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22