diff options
Diffstat (limited to 'Build/source/texk/web2c/web2c/web2c.l')
-rw-r--r-- | Build/source/texk/web2c/web2c/web2c.l | 321 |
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; +} |