diff options
Diffstat (limited to 'byterun/parsing.c')
| -rw-r--r-- | byterun/parsing.c | 205 |
1 files changed, 205 insertions, 0 deletions
diff --git a/byterun/parsing.c b/byterun/parsing.c new file mode 100644 index 000000000..f051ffed7 --- /dev/null +++ b/byterun/parsing.c @@ -0,0 +1,205 @@ +/* The PDA automaton for parsers generated by camlyacc */ + +#include <stdio.h> +#include "config.h" +#include "mlvalues.h" +#include "memory.h" +#include "alloc.h" + +struct parser_tables { /* Mirrors parse_tables in ../stdlib/parsing.mli */ + value actions; + value transl; + char * lhs; + char * len; + char * defred; + char * dgoto; + char * sindex; + char * rindex; + char * gindex; + value tablesize; + char * table; + char * check; +}; + +struct parser_env { /* Mirrors parser_env in ../stdlib/parsing.ml */ + value s_stack; + value v_stack; + value symb_start_stack; + value symb_end_stack; + value stacksize; + value curr_char; + value lval; + value symb_start; + value symb_end; + value asp; + value rule_len; + value rule_number; + value sp; + value state; +}; + +#ifdef BIG_ENDIAN +#define Short(tbl,n) \ + (*((unsigned char *)((tbl) + (n) * sizeof(short))) + \ + (*((schar *)((tbl) + (n) * sizeof(short) + 1)) << 8)) +#else +#define Short(tbl,n) (((short *)(tbl))[n]) +#endif + +#ifdef DEBUG +int parser_trace = 0; +#define Trace(act) if(parser_trace) act +#else +#define Trace(act) +#endif + +/* Input codes */ + +#define START 0 /* Mirrors parser_input in ../stdlib/parsing.ml */ +#define TOKEN_READ 1 +#define STACKS_GROWN_1 2 +#define STACKS_GROWN_2 3 +#define SEMANTIC_ACTION_COMPUTED 4 + +/* Output codes */ + +#define READ_TOKEN Atom(0) /* Mirrors parser_output in ../stdlib/parsing.ml */ +#define RAISE_PARSE_ERROR Atom(1) +#define GROW_STACKS_1 Atom(2) +#define GROW_STACKS_2 Atom(3) +#define COMPUTE_SEMANTIC_ACTION Atom(4) + +/* The pushdown automata */ + +value parse_engine(tables, env, cmd, arg) /* ML */ + struct parser_tables * tables; + struct parser_env * env; + value cmd; + value arg; +{ + int state; + mlsize_t sp; + int n, n1, n2, m, state1; + + switch(Tag_val(cmd)) { + + case START: + state = 0; + sp = Int_val(env->sp); + + loop: + Trace(printf("Loop %d\n", state)); + n = Short(tables->defred, state); + if (n != 0) goto reduce; + if (Int_val(env->curr_char) >= 0) goto testshift; + env->sp = Val_int(sp); + env->state = Val_int(state); + return READ_TOKEN; + /* The ML code calls the lexer and updates */ + /* symb_start and symb_end */ + case TOKEN_READ: + sp = Int_val(env->sp); + state = Int_val(env->state); + env->curr_char = Field(tables->transl, Tag_val(arg)); + switch (Wosize_val(arg)) { + case 0: + env->lval = Val_long(0); break; + case 1: + modify(&env->lval, Field(arg, 0)); break; + default: { + value tuple; + mlsize_t size, i; + Push_roots(r, 4); + r[0] = (value) tables; + r[1] = (value) env; + r[2] = cmd; + r[3] = arg; + size = Wosize_val(arg); + tuple = alloc_tuple(size); + tables = (struct parser_tables *) r[0]; + env = (struct parser_env *) r[1]; + cmd = r[2]; + arg = r[3]; + for (i = 0; i < size; i++) Field(tuple, i) = Field(arg, i); + modify(&env->lval, tuple); + Pop_roots(); + break; } + } + Trace(printf("Token %d (0x%lx)\n", Int_val(env->curr_char), env->lval)); + + testshift: + n1 = Short(tables->sindex, state); + n2 = n1 + Int_val(env->curr_char); + if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) && + Short(tables->check, n2) == Int_val(env->curr_char)) goto shift; + n1 = Short(tables->rindex, state); + n2 = n1 + Int_val(env->curr_char); + if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) && + Short(tables->check, n2) == Int_val(env->curr_char)) { + n = Short(tables->table, n2); + goto reduce; + } + env->sp = Val_int(sp); + env->state = Val_int(state); + return RAISE_PARSE_ERROR; + /* The ML code raises the Parse_error exn */ + shift: + state = Short(tables->table, n2); + Trace(printf("Shift %d\n", state)); + sp++; + if (sp < Long_val(env->stacksize)) goto push; + env->sp = Val_int(sp); + env->state = Val_int(state); + return GROW_STACKS_1; + /* The ML code resizes the stacks */ + case STACKS_GROWN_1: + sp = Int_val(env->sp); + state = Int_val(env->state); + push: + Field(env->s_stack, sp) = Val_int(state); + modify(&Field(env->v_stack, sp), env->lval); + Field(env->symb_start_stack, sp) = env->symb_start; + Field(env->symb_end_stack, sp) = env->symb_end; + env->curr_char = Val_int(-1); + goto loop; + + reduce: + Trace(printf("Reduce %d\n", n)); + m = Short(tables->len, n); + env->asp = Val_int(sp); + env->rule_number = Val_int(n); + env->rule_len = Val_int(m); + sp = sp - m + 1; + m = Short(tables->lhs, n); + state1 = Int_val(Field(env->s_stack, sp - 1)); + n1 = Short(tables->gindex, m); + n2 = n1 + state1; + if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) && + Short(tables->check, n2) == state1) { + state = Short(tables->table, n2); + } else { + state = Short(tables->dgoto, m); + } + if (sp < Long_val(env->stacksize)) goto semantic_action; + env->sp = Val_int(sp); + env->state = Val_int(state); + return GROW_STACKS_2; + /* The ML code resizes the stacks */ + case STACKS_GROWN_2: + sp = Int_val(env->sp); + state = Int_val(env->state); + semantic_action: + env->sp = Val_int(sp); + env->state = Val_int(state); + return COMPUTE_SEMANTIC_ACTION; + /* The ML code calls the semantic action */ + case SEMANTIC_ACTION_COMPUTED: + sp = Int_val(env->sp); + state = Int_val(env->state); + Field(env->s_stack, sp) = Val_int(state); + modify(&Field(env->v_stack, sp), arg); + Field(env->symb_end_stack, sp) = + Field(env->symb_end_stack, Int_val(env->asp)); + goto loop; + } +} |