IMPLEMENTATION MODULE Exceptions;

FROM Streams IMPORT StdOut;

INLINE
  % #include <setjmp.h>
  % #include <assert.h>
  % #include <signal.h>
  % #ifdef YAFL_MICROSOFT
  % #include <float.h>
  % #endif
  % 
  % #define MAX_CONTEXTS 600
  %                                   
  % #ifdef YAFL_ANSI
  % extern int trace_entries(void);
  % extern void set_trace_entries (int new_sp);
  % #else
  % extern int trace_entries();
  % extern void set_trace_entries();
  % #endif
  %
  % typedef struct
  %     {
  %       jmp_buf jmp;
  %       obj_ptr *v_pointer;
  %       obj_ptr **d_pointer;
  %       int      meth_sp;
  %     } CONTEXT_TYPE;
  % 
  % static CONTEXT_TYPE * context [MAX_CONTEXTS];
  % static int sp = 0;
  % static int disable_exception = 0; 
  % static obj_ptr cur_exc;
  % 
  % #ifdef YAFL_ANSI
  %  static void push_context(CONTEXT_TYPE * c)
  % #else
  %  static void push_context(c)
  %  CONTEXT_TYPE * c;
  % #endif
  % {
  %   assert(sp < MAX_CONTEXTS);
  %   context[sp] = c;
  %   sp ++;
  % }
  %
  %
  % void do_exception()
  % {
  %  if ((!disable_exception)&&(sp))
  %    longjmp(&(context[sp-1]->jmp), 1);
  % }
  % 
  END;

  CLASS ExceptionHandler;
    VAR
      TheCStack: CallStack;
      TheException: Exception;
  
    METHOD Attempt;
      VAR
        SpBuff: INTEGER;
      BEGIN
      SpBuff := 0;
      TheException := VOID;
      INLINE
        % Y_SpBuff = sp;
        % {
        %   CONTEXT_TYPE ctxt;
        %   ctxt.v_pointer = v_stack;
        %   ctxt.d_pointer = d_stack;
        %   ctxt.meth_sp = trace_entries();
        %   push_context(&ctxt);
        %   if (setjmp(&ctxt.jmp) == 0)
        %     {
        END;
      Action;
      INLINE
        %       sp = Y_SpBuff;
        %     }
        %    else
        %     {
        %       sp = Y_SpBuff;
        %       v_stack = ctxt.v_pointer;
        %       d_stack = ctxt.d_pointer;
        END;
      TheCStack.CREATE;
      INLINE
        %      set_trace_entries(ctxt.meth_sp);
        %      THIS->Y_TheException = cur_exc;
        %      cur_exc = NULL; 
        END;
      Recover;
      INLINE
        %     }
        % }
        END;
      END Attempt;
      
    REDEFINE METHOD CREATE;
      BEGIN
      BASE;
      Attempt;
      END CREATE;
      
    METHOD CStack: CallStack;
      BEGIN
      RESULT := TheCStack;
      END CStack;
      
    METHOD GetException: Exception;
      BEGIN
      RESULT := TheException;
      END GetException;
      
  END ExceptionHandler;
  
------------------------------

  CLASS Exception;
  
    METHOD Raise;
      BEGIN
      INLINE
        % cur_exc = THIS;
        % do_exception();
        END;
      END Raise;
  
  END Exception;

------------------------------
  CLASS SystemException;
    INHERITS Exception;
    
    VAR
      TheCode: INTEGER;
    
    REDEFINE METHOD CREATE (Code: INTEGER);
      BEGIN
      TheCode := Code;
      BASE;
      END CREATE;
    
    METHOD Code: INTEGER;
      BEGIN
      RESULT := TheCode;
      END Code;
      
  END SystemException;
------------------------------
  ONCE CLASS SystemExceptionCreator;
  
    VAR
	   TheDisableFlag: BOOLEAN;

    METHOD DisableException;
      BEGIN
      TheDisableFlag := TRUE;
      INLINE
        % disable_exception = TRUE;
        END;
      END DisableException;

    METHOD EnableException;
      BEGIN
      TheDisableFlag := FALSE;
      INLINE
        % disable_exception = FALSE;
        END;
      END EnableException;
    
    PRAGMA
      CallBack (Err, "y_sys_exc");

    METHOD Err (Code: INTEGER);
      VAR
        Exc: SystemException;
      BEGIN
      StdOut.WriteLine("exception");
      IF NOT TheDisableFlag THEN
        StdOut.WriteLine("catched");
        Exc.CREATE (Code);
        Exc.Raise;
        END;
      StdOut.WriteLine("not catched");
      END Err;
      
  END SystemExceptionCreator;
------------------------------
  
END Exceptions;
