Binary files old/camlcomp and src/camlcomp differ
Binary files old/camllex and src/camllex differ
Binary files old/camllibr and src/camllibr differ
Binary files old/camllink and src/camllink differ
Binary files old/camlrun and src/camlrun differ
Binary files old/camlyacc and src/camlyacc differ
Common subdirectories: old/compiler and src/compiler
Common subdirectories: old/launch and src/launch
Common subdirectories: old/lex and src/lex
Common subdirectories: old/lib and src/lib
Common subdirectories: old/librar and src/librar
Common subdirectories: old/linker and src/linker
Common subdirectories: old/man and src/man
Common subdirectories: old/runtime and src/runtime
Common subdirectories: old/tools and src/tools
Common subdirectories: old/toplevel and src/toplevel
Common subdirectories: old/yacc and src/yacc
diff -r -c old/compiler/parser.mly src/compiler/parser.mly
*** old/compiler/parser.mly	Tue Aug  8 15:40:07 1995
--- src/compiler/parser.mly	Tue Aug  8 16:24:24 1995
***************
*** 7,12 ****
--- 7,14 ----
  #open "builtins";;
  #open "syntax";;
  #open "primdecl";;
+ 
+ let yyerror s = raise Parse_error;;
  %}
  
  /* Tokens */
diff -r -c old/lex/grammar.mly src/lex/grammar.mly
*** old/lex/grammar.mly	Tue Aug  8 15:40:14 1995
--- src/lex/grammar.mly	Tue Aug  8 16:24:23 1995
***************
*** 3,8 ****
--- 3,10 ----
  %{
  #open "syntax";;
  #open "gram_aux";;
+ 
+ let yyerror s = raise Parse_error;;
  %}
  
  %token <string> Tident
diff -r -c old/lib/iparsing.mli src/lib/iparsing.mli
*** old/lib/iparsing.mli	Tue Aug  8 15:40:18 1995
--- src/lib/iparsing.mli	Tue Aug  8 16:18:35 1995
***************
*** 9,14 ****
--- 9,15 ----
      mutable symb_start_stack : int vect;(* Start positions *)
      mutable symb_end_stack : int vect;  (* End positions *)
      mutable stacksize : int;            (* Size of the stacks *)
+     mutable base : int;			(* Base sp value for current parse *)
      mutable curr_char : int;            (* Last token read *)
      mutable lval : obj;                 (* Its semantic attribute *)
      mutable symb_start : int;           (* Start pos. of the current symbol*)
***************
*** 17,23 ****
      mutable rule_len : int;             (* Number of rhs items in the rule *)
      mutable rule_number : int;          (* Rule number to reduce by *)
      mutable sp : int;                   (* Saved sp for parse_engine *)
!     mutable state : int }               (* Saved state for parse_engine *)
  ;;
  
  type parser_input =
--- 18,25 ----
      mutable rule_len : int;             (* Number of rhs items in the rule *)
      mutable rule_number : int;          (* Rule number to reduce by *)
      mutable sp : int;                   (* Saved sp for parse_engine *)
!     mutable state : int;                (* Saved state for parse_engine *)
!     mutable errflag : int }             (* Saved error state *)
  ;;
  
  type parser_input =
***************
*** 26,31 ****
--- 28,34 ----
    | Stacks_grown_1
    | Stacks_grown_2
    | Semantic_action_computed
+   | Error_detected
  
  and parser_output =
      Read_token
***************
*** 33,38 ****
--- 36,42 ----
    | Grow_stacks_1
    | Grow_stacks_2
    | Compute_semantic_action
+   | Call_yyerror
  ;;
  
  value parse_engine :
diff -r -c old/lib/parsing.ml src/lib/parsing.ml
*** old/lib/parsing.ml	Tue Aug  8 15:40:19 1995
--- src/lib/parsing.ml	Tue Aug  8 16:09:41 1995
***************
*** 15,20 ****
--- 15,21 ----
      symb_start_stack = make_vect 100 0;
      symb_end_stack = make_vect 100 0;
      stacksize = 100;
+     base = 0;
      curr_char = 0;
      lval = repr ();
      symb_start = 0;
***************
*** 23,29 ****
      rule_len = 0;
      rule_number = 0;
      sp = 0;
!     state = 0 }
  ;;
  
  let grow_stacks() =
--- 24,31 ----
      rule_len = 0;
      rule_number = 0;
      sp = 0;
!     state = 0;
!     errflag = 0 }
  ;;
  
  let grow_stacks() =
***************
*** 62,76 ****
      | Raise_parse_error ->
          raise Parse_error
      | Compute_semantic_action ->
!         loop Semantic_action_computed (tables.actions.(env.rule_number) ())
      | Grow_stacks_1 ->
          grow_stacks(); loop Stacks_grown_1 (repr ())
      | Grow_stacks_2 ->
          grow_stacks(); loop Stacks_grown_2 (repr ()) in
    let init_asp = env.asp
!   and init_sp = env.sp
    and init_state = env.state
    and init_curr_char = env.curr_char in
    env.curr_char <- start;
    try
      loop Start (repr ())
--- 64,84 ----
      | Raise_parse_error ->
          raise Parse_error
      | Compute_semantic_action ->
!         let (msg, val) =
! 	  try (Semantic_action_computed, tables.actions.(env.rule_number) ())
! 	  with Parse_error -> (Error_detected, (repr ())) in
! 	loop msg val
!     | Call_yyerror ->
! 	tables.error "syntax error"; loop Error_detected (repr ())
      | Grow_stacks_1 ->
          grow_stacks(); loop Stacks_grown_1 (repr ())
      | Grow_stacks_2 ->
          grow_stacks(); loop Stacks_grown_2 (repr ()) in
    let init_asp = env.asp
!   and init_base = env.base
    and init_state = env.state
    and init_curr_char = env.curr_char in
+   env.base <- env.sp + 1;
    env.curr_char <- start;
    try
      loop Start (repr ())
***************
*** 77,83 ****
    with exn ->
      let curr_char = env.curr_char in
      env.asp <- init_asp;
!     env.sp <- init_sp;
      env.state <- init_state;
      env.curr_char <- init_curr_char;
      match exn with
--- 85,92 ----
    with exn ->
      let curr_char = env.curr_char in
      env.asp <- init_asp;
!     env.sp <- env.base - 1;
!     env.base <- init_base;
      env.state <- init_state;
      env.curr_char <- init_curr_char;
      match exn with
diff -r -c old/lib/parsing.mli src/lib/parsing.mli
*** old/lib/parsing.mli	Tue Aug  8 15:40:19 1995
--- src/lib/parsing.mli	Tue Aug  8 16:08:54 1995
***************
*** 45,51 ****
      gindex : string;
      tablesize : int;
      table : string;
!     check : string }
  ;;
  
  exception yyexit of obj;;
--- 45,52 ----
      gindex : string;
      tablesize : int;
      table : string;
!     check : string;
!     error : string -> unit }
  ;;
  
  exception yyexit of obj;;
diff -r -c old/runtime/parsing.c src/runtime/parsing.c
*** old/runtime/parsing.c	Tue Aug  8 15:40:42 1995
--- src/runtime/parsing.c	Tue Aug  8 16:18:37 1995
***************
*** 5,10 ****
--- 5,12 ----
  #include "memory.h"
  #include "alloc.h"
  
+ #define ERRCODE 256
+ 
  struct parser_tables {    /* Mirrors parse_tables in ../lib/parsing.mli */
    value actions;
    value transl;
***************
*** 18,23 ****
--- 20,26 ----
    value tablesize;
    char * table;
    char * check;
+   value error;
  };
  
  struct parser_env {       /* Mirrors parser_env in ../lib/iparsing.mli */
***************
*** 26,31 ****
--- 29,35 ----
    value symb_start_stack;
    value symb_end_stack;
    value stacksize;
+   value base;
    value curr_char;
    value lval;
    value symb_start;
***************
*** 35,40 ****
--- 39,45 ----
    value rule_number;
    value sp;
    value state;
+   value errflag;
  };
  
  #ifdef BIG_ENDIAN
***************
*** 59,64 ****
--- 64,70 ----
  #define STACKS_GROWN_1 2
  #define STACKS_GROWN_2 3
  #define SEMANTIC_ACTION_COMPUTED 4
+ #define ERROR_DETECTED 5
  
  /* Output codes */
  
***************
*** 67,75 ****
--- 73,87 ----
  #define GROW_STACKS_1 Atom(2)
  #define GROW_STACKS_2 Atom(3)
  #define COMPUTE_SEMANTIC_ACTION Atom(4)
+ #define CALL_YYERROR Atom(5)
  
  /* The pushdown automata */
  
+ #define SAVE  env->sp = Val_int(sp); \
+     env->state = Val_int(state); env->errflag = Val_int(errflag)
+ #define RESTORE      sp = Int_val(env->sp); \
+     state = Int_val(env->state); errflag = Int_val(env->errflag)
+ 
  value parse_engine(tables, env, cmd, arg) /* ML */
       struct parser_tables * tables;
       struct parser_env * env;
***************
*** 76,82 ****
       value cmd;
       value arg;
  {
!   int state;
    mlsize_t sp;
    int n, n1, n2, m, state1;
  
--- 88,94 ----
       value cmd;
       value arg;
  {
!   int state, errflag;
    mlsize_t sp;
    int n, n1, n2, m, state1;
  
***************
*** 85,90 ****
--- 97,103 ----
    case START:
      state = 0;
      sp = Int_val(env->sp);
+     errflag = 0;
  
    loop:
      Trace(printf("Loop %d\n", state));
***************
*** 91,104 ****
      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:
--- 104,115 ----
      n = Short(tables->defred, state);
      if (n != 0) goto reduce;
      if (Int_val(env->curr_char) >= 0) goto testshift;
!     SAVE;
      return READ_TOKEN;
                                  /* The ML code calls the lexer and updates */
                                  /* symb_start and symb_end */
    case TOKEN_READ:
!     RESTORE;
      env->curr_char = Field(tables->transl, Tag_val(arg));
      switch (Wosize_val(arg)) {
      case 0:
***************
*** 138,165 ****
        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:
--- 149,211 ----
        n = Short(tables->table, n2);
        goto reduce;
      }
!     if (errflag > 0) goto errlab;
!     SAVE;
!     return CALL_YYERROR;
! 				/* The ML code calls yyerror */
!   case ERROR_DETECTED:
!     RESTORE;
!   errlab:
!     if (errflag < 3) {
!       errflag = 3;
!       for (;;) {
! 	state1 = Int_val(Field(env->s_stack, sp));
! 	n1 = Short(tables->sindex, state1);
! 	n2 = n1 + ERRCODE;
! 	if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) &&
! 	    Short(tables->check, n2) == ERRCODE) {
! 	  Trace(printf("Recovering in state %d\n", state1));
! 	  goto do_shift;
!         } 
! 	else {
! 	  Trace(printf("Discarding state %d\n", state1));
! 	  if (sp <= Int_val(env->base)) {
! 	    Trace(printf("Fallen off bottom\n"));
! 	    return RAISE_PARSE_ERROR;
! 				/* The ML code raises Parse_error */
!           }
! 	  sp--;
!         }
!       }
!     }
!     else {
! 	if (Int_val(env->curr_char) == 0)
! 	  return RAISE_PARSE_ERROR;
! 				/* The ML code raises Parse_error */
! 	  Trace(printf("Discarding token %d (0x%lx)\n",
! 		       Int_val(env->curr_char), env->lval));
! 	  env->curr_char = Val_int(-1);
! 	  goto loop;
!     }
! 
    shift:
+     env->curr_char = Val_int(-1);
+     if (errflag > 0) errflag--;
+   do_shift:
      state = Short(tables->table, n2);
      Trace(printf("Shift %d\n", state));
      sp++;
      if (sp < Long_val(env->stacksize)) goto push;
!     SAVE;
      return GROW_STACKS_1;
                                  /* The ML code resizes the stacks */
    case STACKS_GROWN_1:
!     RESTORE;
    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;
      goto loop;
  
    reduce:
***************
*** 180,200 ****
        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) =
--- 226,242 ----
        state = Short(tables->dgoto, m);
      }
      if (sp < Long_val(env->stacksize)) goto semantic_action;
!     SAVE;
      return GROW_STACKS_2;
                                  /* The ML code resizes the stacks */
    case STACKS_GROWN_2:
!     RESTORE;
    semantic_action:
!     SAVE;
      return COMPUTE_SEMANTIC_ACTION;
                                  /* The ML code calls the semantic action */
    case SEMANTIC_ACTION_COMPUTED:
!     RESTORE;
      Field(env->s_stack, sp) = Val_int(state);
      modify(&Field(env->v_stack, sp), arg);
      Field(env->symb_end_stack, sp) =
diff -r -c old/yacc/skeleton.c src/yacc/skeleton.c
*** old/yacc/skeleton.c	Tue Aug  8 15:40:55 1995
--- src/yacc/skeleton.c	Tue Aug  8 16:05:09 1995
***************
*** 21,27 ****
    "    gindex=yygindex;",
    "    tablesize=YYTABLESIZE;",
    "    table=yytable;",
!   "    check=yycheck };;",
    0
  };
  
--- 21,28 ----
    "    gindex=yygindex;",
    "    tablesize=YYTABLESIZE;",
    "    table=yytable;",
!   "    check=yycheck;",
!   "    error=yyerror };;",
    0
  };
  
