ocaml/byterun/oldlexing.c

/***********************************************************************/
/*                                                                     */
/*                         Caml Special Light                          */
/*                                                                     */
/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
/*                                                                     */
/*  Copyright 1995 Institut National de Recherche en Informatique et   */
/*  Automatique.  Distributed only by permission.                      */
/*                                                                     */
/***********************************************************************/

/* $Id$ */

/* The table-driven automaton for lexers generated by camllex. */

#include "mlvalues.h"
#include "stacks.h"
#include "str.h"

struct lexer_buffer {
  value refill_buff;
  value lex_buffer;
  value lex_buffer_len;
  value lex_abs_pos;
  value lex_start_pos;
  value lex_curr_pos;
  value lex_last_pos;
};

struct lexing_table {
  value lex_base;
  value lex_backtrk;
  value lex_default;
  value lex_trans;
  value lex_check;
};

#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

value lex_engine(tbl, start_state, lexbuf)     /* ML */
     struct lexing_table * tbl;
     value start_state;
     struct lexer_buffer * lexbuf;
{
  int state, last_action, base, backtrk, c;
  
  state = Int_val(start_state);
  lexbuf->lex_last_pos = lexbuf->lex_start_pos = lexbuf->lex_curr_pos;
  last_action = -1;
  while(1) {
    /* Lookup base address or action number for current state */
    base = Short(tbl->lex_base, state);
    if (base < 0) return Val_int(-base-1);
    /* See if it's a backtrack point */
    backtrk = Short(tbl->lex_backtrk, state);
    if (backtrk >= 0) {
      lexbuf->lex_last_pos = lexbuf->lex_curr_pos;
      last_action = backtrk;
    }
    /* Read next input char */
    if (lexbuf->lex_curr_pos >= lexbuf->lex_buffer_len) {
      Push_roots (r, 2);
      r[0] = (value) tbl;
      r[1] = (value) lexbuf;
      callback(lexbuf->refill_buff, (value) lexbuf);
      tbl = (struct lexing_table *) r[0];
      lexbuf = (struct lexer_buffer *) r[1];
      Pop_roots ();
    }
    c = Byte_u(lexbuf->lex_buffer, Long_val(lexbuf->lex_curr_pos));
    lexbuf->lex_curr_pos += 2;
    /* Determine next state */
    if (Short(tbl->lex_check, base + c) == state)
      state = Short(tbl->lex_trans, base + c);
    else
      state = Short(tbl->lex_default, state);
    /* If no transition on this char, return to last backtrack point */
    if (state < 0) {
      lexbuf->lex_curr_pos = lexbuf->lex_last_pos;
      return Val_int(last_action);
    }
  }
}