summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/web2c/web2c.l
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/web2c/web2c.l')
-rw-r--r--Build/source/texk/web2c/web2c/web2c.l321
1 files changed, 321 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/web2c/web2c.l b/Build/source/texk/web2c/web2c/web2c.l
new file mode 100644
index 00000000000..8f0194c49aa
--- /dev/null
+++ b/Build/source/texk/web2c/web2c/web2c.l
@@ -0,0 +1,321 @@
+%{
+/* web2c.l -- lexical analysis for Tangle output. Public domain. */
+
+#include "web2c.h"
+#include "y_tab.h"
+
+/* Hack to make it possible to compile the generated code with C++
+ Required if you use flex. */
+#ifdef __cplusplus
+#define webinput yyinput
+#else
+#define webinput input
+#endif
+
+/* For some reason flex wants to do a system call, so we must lose our
+ definition of the Pascal read. */
+#undef read
+
+char conditional[20], negbuf[2], temp[20];
+extern boolean doing_statements;
+
+
+/* We only read one input file. This is the default definition, but
+ giving it ourselves avoids the need to find -lfl or -ll at link time.
+ This is a good thing, since libfl.a is often installed somewhere that
+ the linker doesn't search by default. */
+int
+yywrap P1H(void)
+{
+ return 1;
+}
+#define YY_SKIP_YYWRAP /* not that it matters */
+%}
+DIGIT [0-9]
+ALPHA [a-zA-Z]
+ALPHANUM ({DIGIT}|{ALPHA})
+IDENTIFIER ({ALPHA}{ALPHANUM}*)
+NUMBER ({DIGIT}+)
+SIGN ("+"|"-")
+SIGNED ({SIGN}?{NUMBER})
+WHITE [ \n\t]+
+REAL ({NUMBER}"."{NUMBER}("e"{SIGNED})?)|({NUMBER}"e"{SIGNED})
+COMMENT (("{"[^}]*"}")|("(*"([^*]|"*"[^)])*"*)"))
+W ({WHITE}|"packed ")+
+WW ({WHITE}|{COMMENT}|"packed ")*
+HHB0 ("hh"{WW}"."{WW}"b0")
+HHB1 ("hh"{WW}"."{WW}"b1")
+
+%%
+{W} ;
+"{" { while (webinput() != '}'); }
+
+"#" {
+ register int c;
+ putc('#', out);
+ while ((c = webinput()) && c != ';')
+ putc(c, out);
+ putc('\n', out);
+ }
+
+"ifdef(" {register int c;
+ register char *cp=conditional;
+ new_line();
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ *cp++ = c;
+ *cp = '\0';
+ (void) webinput();
+ if (doing_statements) fputs("\t;\n", out);
+ fprintf(out, "#ifdef %s\n", conditional);
+ }
+
+"endif(" {register int c;
+ new_line();
+ fputs("#endif /* ", out);
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ (void) putc(c, out);
+ (void) webinput();
+ conditional[0] = '\0';
+ fputs(" */\n", out);
+ }
+
+"ifndef(" {register int c;
+ register char *cp=conditional;
+ new_line();
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ *cp++ = c;
+ *cp = '\0';
+ (void) webinput();
+ if (doing_statements) fputs("\t;\n", out);
+ fprintf(out, "#ifndef %s\n", conditional);
+ }
+
+"endifn(" {register int c;
+ new_line();
+ fputs("#endif /* not ", out);
+ while ((c = webinput()) != '\'')
+ ;
+ while ((c = webinput()) != '\'')
+ putc(c, out);
+ (void) webinput();
+ conditional[0] = '\0';
+ fputs(" */\n", out);
+ }
+
+
+"procedure "[a-z]+";"[ \n\t]*"forward;" ;
+
+"function "[(),:a-z]+";"[ \n\t]*"forward;" ;
+
+"@define" return last_tok=define_tok;
+"@field" return last_tok=field_tok;
+"and" return last_tok=and_tok;
+"array" return last_tok=array_tok;
+"begin" return last_tok=begin_tok;
+"case" return last_tok=case_tok;
+"const" return last_tok=const_tok;
+"div" return last_tok=div_tok;
+"break" return last_tok=break_tok;
+"do" return last_tok=do_tok;
+"downto" return last_tok=downto_tok;
+"else" return last_tok=else_tok;
+"end" return last_tok=end_tok;
+"file" return last_tok=file_tok;
+"for" return last_tok=for_tok;
+"function" return last_tok=function_tok;
+"goto" return last_tok=goto_tok;
+"if" return last_tok=if_tok;
+"label" return last_tok=label_tok;
+"mod" return last_tok=mod_tok;
+"not" return last_tok=not_tok;
+"of" return last_tok=of_tok;
+"or" return last_tok=or_tok;
+"procedure" return last_tok=procedure_tok;
+"program" return last_tok=program_tok;
+"record" return last_tok=record_tok;
+"repeat" return last_tok=repeat_tok;
+{HHB0} return last_tok=hhb0_tok;
+{HHB1} return last_tok=hhb1_tok;
+"then" return last_tok=then_tok;
+"to" return last_tok=to_tok;
+"type" return last_tok=type_tok;
+"until" return last_tok=until_tok;
+"var" return last_tok=var_tok;
+"while" return last_tok=while_tok;
+"others" return last_tok=others_tok;
+
+{REAL} {
+ sprintf (temp, "%s%s", negbuf, yytext);
+ negbuf[0] = '\0';
+ return last_tok=r_num_tok;
+ }
+
+{NUMBER} {
+ sprintf (temp, "%s%s", negbuf, yytext);
+ negbuf[0] = '\0';
+ return last_tok=i_num_tok;
+ }
+
+("'"([^']|"''")"'") return last_tok=single_char_tok;
+
+("'"([^']|"''")*"'") return last_tok=string_literal_tok;
+
+"+" { if ((last_tok>=undef_id_tok &&
+ last_tok<=field_id_tok) ||
+ last_tok==i_num_tok ||
+ last_tok==r_num_tok ||
+ last_tok==')' ||
+ last_tok==']')
+ return last_tok='+';
+ else return last_tok=unary_plus_tok; }
+
+"-" { if ((last_tok>=undef_id_tok &&
+ last_tok<=field_id_tok) ||
+ last_tok==i_num_tok ||
+ last_tok==r_num_tok ||
+ last_tok==')' ||
+ last_tok==']')
+ return last_tok='-';
+ else {
+ int c;
+ while ((c = webinput()) == ' ' || c == '\t')
+ ;
+ unput(c);
+ if (c < '0' || c > '9') {
+ return last_tok = unary_minus_tok;
+ }
+ negbuf[0] = '-';
+ }}
+
+"*" return last_tok='*';
+"/" return last_tok='/';
+"=" return last_tok='=';
+"<>" return last_tok=not_eq_tok;
+"<" return last_tok='<';
+">" return last_tok='>';
+"<=" return last_tok=less_eq_tok;
+">=" return last_tok=great_eq_tok;
+"(" return last_tok='(';
+")" return last_tok=')';
+"[" return last_tok='[';
+"]" return last_tok=']';
+":=" return last_tok=assign_tok;
+".." return last_tok=two_dots_tok;
+"." return last_tok='.';
+"," return last_tok=',';
+";" return last_tok=';';
+":" return last_tok=':';
+"^" return last_tok='^';
+
+{IDENTIFIER} { strcpy (last_id, yytext);
+ l_s = search_table (last_id);
+ return
+ last_tok = (l_s == -1 ? undef_id_tok : sym_table[l_s].typ);
+ }
+
+
+. { /* Any bizarre token will do. */
+ return last_tok = two_dots_tok; }
+%%
+/* Some helper routines. Defining these here means we don't have references
+ to yytext outside of this file. Which means we can omit one of the more
+ troublesome autoconf tests. */
+void
+get_string_literal P1C(char *, s)
+{
+ int i, j;
+ j = 1;
+ s[0] = '"';
+ for (i=1; yytext[i-1] != 0; i++) {
+ if (yytext[i] == '\\' || yytext[i] == '"')
+ s[j++] = '\\';
+ else if (yytext[i] == '\'')
+ i++;
+ s[j++] = yytext[i];
+ }
+ s[j-1] = '"';
+ s[j] = 0;
+}
+
+void
+get_single_char P1C(char *, s)
+{
+ s[0]='\'';
+ if (yytext[1] == '\\' || yytext[1] == '\'') {
+ s[1] = '\\';
+ s[2] = yytext[1];
+ s[3] = '\'';
+ s[4] = 0;
+ } else {
+ s[1] = yytext[1];
+ s[2] = '\'';
+ s[3] = 0;
+ }
+}
+
+void
+get_result_type P1C(char *, s)
+{
+ strcpy(s, yytext);
+}
+
+
+/* Since a syntax error can never be recovered from, we exit here with
+ bad status. */
+
+int
+yyerror P1C(string, s)
+{
+ /* This is so the convert script can delete the output file on error. */
+ puts ("@error@");
+ fflush (stdout);
+ fputs (s, stderr);
+ fprintf (stderr, ": Last token = %d (%c), ", last_tok, last_tok);
+ fprintf (stderr, "error buffer = `%s',\n\t", yytext);
+ fprintf (stderr, "last id = `%s' (", last_id);
+ ii = search_table (last_id);
+ if (ii == -1)
+ fputs ("not in symbol table", stderr);
+ else
+ switch (sym_table[ii].typ)
+ {
+ case undef_id_tok:
+ fputs ("undefined", stderr);
+ break;
+ case var_id_tok:
+ fputs ("variable", stderr);
+ break;
+ case const_id_tok:
+ fputs ("constant", stderr);
+ break;
+ case type_id_tok:
+ fputs ("type", stderr);
+ break;
+ case proc_id_tok:
+ fputs ("parameterless procedure", stderr);
+ break;
+ case proc_param_tok:
+ fputs ("procedure with parameters", stderr);
+ break;
+ case fun_id_tok:
+ fputs ("parameterless function", stderr);
+ break;
+ case fun_param_tok:
+ fputs ("function with parameters", stderr);
+ break;
+ default:
+ fputs ("unknown!", stderr);
+ break;
+ }
+ fputs (").\n", stderr);
+ exit (1);
+
+ /* Avoid silly warnings. */
+ return 0;
+}