/** 
   --  Exception-oriented Subroutines.
   
    Copyright (C) Tektronix, Inc. 1998 - 2001. All rights reserved.
  
    @see     GNU LGPL
    @author  Tektronix CTE            @(#) %derived_by: guidod %
    @version %version: bln_mpt1!1.22 %
      (%date_modified: Tue Jun 04 16:34:59 2002 %)
 */
/*@{*/
#if defined(__version_control__) && defined(__GNUC__)
static char* id __attribute__((unused)) = 
"@(#) $Id: %full_filespec:  exception-sub.c~bln_mpt1!1.22:csrc:bln_12xx!1 % $";
#endif

#define _P4_SOURCE 1

#include <pfe/pfe-base.h>
#include <pfe/def-xtra.h>

#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include <setjmp.h>

#include <pfe/exception-sub.h>
#include <pfe/block-sub.h>
#include <pfe/file-sub.h>
#include <pfe/_missing.h>

#include <pfe/logging.h>

#ifndef _export
#define p4_longjmp_abort()	(p4_longjmp_loop('A'))
#define p4_longjmp_exit()	(p4_longjmp_loop('X'))
#define p4_longjmp_quit()	(p4_longjmp_loop('Q'))
#define p4_longjmp_yield()	(p4_longjmp_loop('S'))
#endif

/**
   just call longjmp on PFE.loop
 */
_export void
p4_longjmp_loop(int arg)
{
    longjmp (PFE.loop, arg);
}


/*
   show the error, along with info like the block, filename, line numer.
 */
static void
show_error (const char* str, int len)
{
    int n;

    PFE.input_err = PFE.input;	/* save input specification of error */

    if (! str) str = "";
    if (! len) len = strlen(str);
    p4_outf ("\nError: %.*s", len, str);
    if (! PFE.word.ptr || ! PFE.word.len) 
{ str = ""; len = 1; }

    else 
{ str = PFE.word.ptr; len = PFE.word.len; }


    switch (SOURCE_ID)
    
{
     case 0:
         if (BLK && BLOCK_FILE && ! ferror (BLOCK_FILE->f))
         
{
             p4_outf ("\nBlock %lu line %d: \"%.*s\"\n",
               (unsigned long) BLK, (int) TO_IN / 64, len, str);
             p4_dot_line (BLOCK_FILE, BLK, TO_IN / 64);
             n = TO_IN % 64;
             break;
         }
 /* fallthrough*/
     case -1:
	 p4_outf (" : \"%.*s\"\n", len, str); /* to Error:-line */
         p4_type (TIB, NUMBER_TIB);
         n = TO_IN;
         break;
     default:
         p4_outf ("\nFile %s line %lu: \"%.*s\"\n",
           SOURCE_FILE->name, (unsigned long) SOURCE_FILE->n, len, str);
         p4_type (TIB, NUMBER_TIB);
	 n = TO_IN;
    }

    if (PFE.word.len > TO_IN)
	p4_outf ("\n%*s", n, "^"); /* just mark ">IN" */
    else
    
{
	p4_outs ("\n");
	if (TO_IN != PFE.word.len)
	    p4_emits (TO_IN - PFE.word.len-1, ' ');
	p4_emits (PFE.word.len+1, '^'); /* mark the word */
    }


# ifdef _K12_SOURCE
    if (len > 70) len = 70;
    if (PFE.tib) strncpy (PFE.tib, str, len);
# endif

    p4_outs (" ");
    p4_longjmp_abort ();
}


static void
throw_msg (int id, char *msg)
{
    static const char *throw_explanation[] =
    
{
        /*  -1 */ NULL, /* ABORT */
        /*  -2 */ NULL, /* ABORT" */
        /*  -3 */ "stack overflow",
        /*  -4 */ "stack underflow",
        /*  -5 */ "return-stack overflow",
        /*  -6 */ "return-stack underflow",
        /*  -7 */ "do-loops nested too deeply during execution",
        /*  -8 */ "dictionary overflow",
        /*  -9 */ "invalid memory address",
        /* -10 */ "division by zero",
        /* -11 */ "result out of range",
        /* -12 */ "argument type mismatch",
        /* -13 */ "undefined word",
        /* -14 */ "interpreting a compile-only word",
        /* -15 */ "invalid FORGET (not between FENCE and HERE)",
        /* -16 */ "attempt to use a zero-length string as a name",
        /* -17 */ "pictured numeric output string overflow",
        /* -18 */ "parsed string overflow (input token longer than 255)",
        /* -19 */ "definition name too long",
        /* -20 */ "write to a read-only location",
        /* -21 */ "unsupported operation",
        /* -22 */ "control structure mismatch",
        /* -23 */ "address alignment exception",
        /* -24 */ "invalid numeric argument",
        /* -25 */ "return stack imbalance",
        /* -26 */ "loop parameters unavailable",
        /* -27 */ "invalid recursion",
        /* -28 */ "user interrupt",
        /* -29 */ "compiler nesting (exec/comp state incorrect)",
        /* -30 */ "obsolescent feature",
        /* -31 */ ">BODY used on non-CREATEDd definition",
        /* -32 */ "invalid name argument",
        /* -33 */ "block read exception",
        /* -34 */ "block write exception",
        /* -35 */ "invalid block number",
        /* -36 */ "invalid file position",
        /* -37 */ "file I/O exception",
        /* -38 */ "non-existent file",
        /* -39 */ "unexpected end of file",
        /* -40 */ "invalid BASE for floating-point conversion",
        /* -41 */ "loss of precision",
        /* -42 */ "floating-point divide by zero",
        /* -43 */ "floating-point result out of range",
        /* -44 */ "floating-point stack overflow",
        /* -45 */ "floating-point stack underflow",
        /* -46 */ "floating-point invalid argument",
        /* -47 */ "CURRENT deleted (forget on DEFINITIONS vocabulary)",
        /* -48 */ "invalid POSTPONE",
        /* -49 */ "search-order overflow (ALSO failed)",
        /* -50 */ "search-order underflow (PREVIOUS failed)",
        /* -51 */ "compilation word list changed",
        /* -52 */ "control flow stack overflow",
        /* -53 */ "exception stack overflow",
        /* -54 */ "floating-point underflow",
        /* -55 */ "floating-point unidentified fault",
        /* -56 */ NULL, /* QUIT */
        /* -57 */ "error in sending or receiving a character",
        /* -58 */ "[IF], [ELSE] or [THEN] error",
        /* -59 */ "dictionary space exhausted"
    }
;

    if (-1 - DIM (throw_explanation) < id && id <= -1)
    
{
        /* ANS-Forth throw codes, messages are in throw_explanation[] */
        strcpy (msg, throw_explanation[-1 - id]);
    }

    else if (-1024 < id && id <= -256)
    
{
        /* Signals, see signal-ext.c, 
	   those not handled and not fatal lead to THROW */
        sprintf (msg, "Received signal %d", -256 - id);
    }

    else if (-2048 < id && id <= -1024)
    
{
        /* File errors, see FX_IOR / P4_IOR(flag) */
        sprintf (msg, "I/O Error %d : %s", -1024-id, strerror (-1024-id));
    }

    else if (-32767 < id && id <= -2048)
    
{
	/* search the exception_link for our id */
	p4_Exception* expt = PFE.exception_link;
	strcpy (msg, "module-specific error-condition");
	while (expt)
	
{
	    if (expt->id == id)
	    
{
		strcpy (msg, expt->name);
		break;
	    }

	    expt = expt->next;
	}

    }

    else if (0 < id)
    
{
#     ifdef PFE_HAVE_STRERROR_R
	strerror_r (id, msg, 255);
#     else
	strcpy (msg, strerror (id));
#     endif
    }

    else 
    
{
        sprintf (msg, "%d THROW unassigned", id);
    }

}


/**
   the CATCH impl
 */
_export int
p4_catch (p4xt xt)
{
    register int id;
#  ifdef P4_RP_IN_VM
    Except *x = P4_DEC (RP, Except);
#  else
    auto Except except;  register Except *x = & except;
#  endif

    x->magic = P4_EXCEPTION_MAGIC;
#  ifndef PFE_SBR_CALL_ARG_THREADING 
    x->ipp = IP;
#  endif
    x->spp = SP;
    x->lpp = LP;
#  ifndef P4_NO_FP
    x->fpp = FP;
#  endif
    x->iframe = PFE.saved_input;
    x->prev = PFE.cAtch;
    PFE.cAtch = x;
    id = setjmp (x->jmp);
    if (!id)
        p4_call (xt);
    PFE.cAtch = x->prev;
#  ifdef P4_RP_IN_VM
    RP = (p4xcode **) &x[1]; /*fixme: need to enable that in sbr-threading??*/
#  endif
    return id;
}


#ifdef _K12_SOURCE
extern void trcStack(int); /* show stack trace */
extern int taskIdSelf();
extern int taskPriorityGet(int, int*);
extern int taskDelay(int);
extern int taskSpawn(char*, int, int, int, void*, int, ...);
static int spawn_trcStack(int taskprio, int taskid)
{ 
    if (taskprio > 0) taskprio--;
    taskDelay(1); /* 1 x sched_yield */
    taskSpawn(0, taskprio, 0, 8192, (void*)trcStack, taskid); 
    return 0;
}

#endif 

/**
   the THROW impl
 */
_export void
p4_throws (int id, const char* addr, int len)
{
    Except *x = PFE.cAtch;
    char msg[256];

    if (PFE.atexit_running) 
    
{
        if (addr && len)
            show_error (addr, len);
        p4_longjmp_exit ();
    }

  
#ifdef _K12_SOURCE
    
{
        int taskid, taskprio;
        if (p4_LogMask & P4_LOG_DEBUG) 
        
{ /* if any debug-channel used */
            taskPriorityGet((taskid= taskIdSelf()), &taskprio);
            taskSpawn(0, taskprio, 0, 8192, 
              (void*)spawn_trcStack, taskprio, taskid);
            taskDelay(2); /* 2 x sched_yield */
        }

    }

#endif
  
    if (PFE.throw_cleanup) 
    
{ 
        PFE.throw_cleanup ();
        PFE.throw_cleanup = NULL;
    }


    if (x && x->magic == P4_EXCEPTION_MAGIC)
    
{
#    ifndef PFE_SBR_CALL_ARG_THREADING
        IP = x->ipp;
#    endif
        SP = x->spp;
        LP = x->lpp;
#    ifndef P4_NO_FP
        FP = x->fpp;
#     endif /*P4_NO_FP*/
        p4_unnest_input (x->iframe);
        longjmp (x->jmp, id);
    }


#  ifdef P4_RP_IN_VM
    *--RP = IP;
    CSP = (p4cell*) RP;         /* come_back marker */
#  endif
    switch (id)
    
{
     case P4_ON_ABORT_QUOTE:
     
{
	 show_error (addr, len);
     }

     case P4_ON_ABORT:
         p4_longjmp_abort ();
     case P4_ON_QUIT:
         p4_longjmp_quit ();
     default:
         throw_msg (id, msg);
         if (addr)
         
{
             strcat (msg, " : ");
             if (! len)
                 strcat (msg, addr);
             else
             
{
                 msg[len+strlen(msg)] = '\0';
                 strncat (msg, addr, len);
             }

         }

         show_error (msg, 0);
    }

}


_export void
p4_throw (int id)
{
    p4_throws (id, 0, 0);
}


/*@}*/