/**************************************************************************/
/*                                                                        */
/*                                 Sources                                */
/*                                from  the                               */
/*                           XSC SOFTWARE PACKAGE                         */
/*                                                                        */
/*                Copyright (c) 1997 University of Karlsruhe              */
/*                     Institute for Appl. Mathematics                    */
/*                                                                        */
/* This program is free software for non-commercial use. For details, see */
/* the file LICENSE.XSC, distributed with this software package.          */
/*                                                                        */
/* This program is distributed WITHOUT ANY WARRANTY. For details, see the */
/* file LICENSE.XSC, distributed with this software package.              */
/*                                                                        */
/**************************************************************************/

/* RCS $Id: e_actn.c,v 1.2 1997/09/25 17:15:35 ae59 Exp $ */
/*
$Log: e_actn.c,v $
 * Revision 1.2  1997/09/25  17:15:35  ae59
 * Copyright-message
 *
 * Revision 1.1  1994/01/27  13:22:12  ae59
 * Put under RCS control
 *
 */
/****************************************************************/
/*                                                              */
/*      Filename        : e_actn.c                              */
/*                                                              */
/*      Entry           : void e_actn(action,code,function)     */
/*                        a_btyp action,code;                   */
/*                        void (*function)( );                  */
/*                                                              */
/*      Arguments       : code - error code                     */
/*                        action - action to be performed       */
/*                        function - trap function              */
/*                                                              */
/*      Description     : Action stack handler.                 */
/*                                                              */
/*      Date            : 1992-07-22                            */
/*      1992-07-22 : changed new to pnew =b=                    */
/*      1991-01-22 : VAX_VMS_C considered                       */
/*      1990-12-18 : prototype                                  */
/*      1990-11-28 : E_RC_MASK/->rc removed                     */
/*      1990-11-12 : E_TPUSH+E_TPOPP                            */
/*      1990-10-31 : force linkage of global variables          */
/*      1990-10-17 : Initialization of exception stack          */
/****************************************************************/

#ifndef ALL_IN_ONE
#ifdef AIX
#include "/u/p88c/runtime/o_defs.h"
#else
#include "o_defs.h"
#endif
#define local
extern aentry *e_astk;
extern aentry e_anor;
extern char *e_head;
extern f_text f_errr;
#endif

#ifdef LINT_ARGS
local void e_actn(a_btyp action,a_btyp code,
                  void (*function)(a_btyp,int,va_list))
#else
local void e_actn(action,code,function)

a_btyp action;
a_btyp code;
void (*function)();
#endif
        {
        aentry *pnew,*p,*pold;
        a_btyp op;

        E_TPUSH("e_actn");

        op = code & E_MASK;

        /* Initialize exception handler stack                   */
        if (e_astk==(aentry *)NULL)
           {
#if VAX_VMS_C
           e_data();
#endif
           e_astk = &e_anor;
           }

/* This case has been withdrawn. >>>
        if (e_astk==(aentry *)NULL)
           {
           if (action & (E_CHNG | E_POPP))
              {
              fprintf(f_errr.fp,"%se_actn : No exception ",e_head);
              fprintf(f_errr.fp,"handler found ");
              fprintf(f_errr.fp,"for trap code %08.8lx\n",code);
              E_TPOPP("e_actn")
              return;
              }
           else if (action & E_PUSH)
              {
              p = e_astk = (aentry *)malloc(sizeof(aentry));
              if (p==(aentry *)NULL)
                 {
                 e_trap(ALLOCATION,2,E_TMSG,41);
                 E_TPOPP("e_actn")
                 return;
                 }
#ifdef HEAP_CHECK
b_geth((a_char *)&e_astk,(a_char *)e_astk,(a_char *)"e_actn");
#endif
              p->succ = NULL;
              p->stat = FALSE;
              }
           else
              {
              fprintf(f_errr.fp,"%se_actn : No action specified ",e_head);
              fprintf(f_errr.fp,"for trap code %08.8lx\n",code);
              E_TPOPP("e_actn")
              return;
              }
           }
        else
 <<< This case has been withdrawn. */
           {
           pold = (aentry *)NULL;
           p = e_astk;
           while ((p->code & E_MASK)<op) {
              if (p->succ==(aentry *)NULL) break;
              pold = p;
              p = p->succ;
              }

           if ((p->code & E_MASK)!=op)
              {
              if (action & (E_CHNG | E_POPP))
                 {
                 fprintf(f_errr.fp,"%se_actn : No exception ",e_head);
                 fprintf(f_errr.fp,"handler found ");
                 fprintf(f_errr.fp,"for trap code %08.8lx\n",code);
                 E_TPOPP("e_actn")
                 return;
                 }
              }

           if (action & E_POPP)
              {
              if (p->stat)
                 {
                 fprintf(f_errr.fp,"%se_actn : Static exception ",e_head);
                 fprintf(f_errr.fp,"handler may not be ");
                 fprintf(f_errr.fp,"removed for trap code %08.8lx\n",code);
                 E_TPOPP("e_actn")
                 return;
                 }
              if (pold==(aentry *)NULL)
                 {
                 e_astk = p->succ;
#ifdef HEAP_CHECK
b_freh((a_char *)&e_astk,(a_char *)p,(a_char *)"e_actn");
#endif
                 }
              else
                 {
                 pold->succ = p->succ;
#ifdef HEAP_CHECK
b_freh((a_char *)&pold->succ,(a_char *)p,(a_char *)"e_actn");
#endif
                 }
              free((char *)p);
              E_TPOPP("e_actn")
              return;
              }

           if (action & E_PUSH)
              {
              /* activate exception handler if inactive special */
              if ((p->code & E_MASK)==op && !(p->active)
                  && !(p->def))
                 {
                 p->active = TRUE;
                 E_TPOPP("e_actn")
                 return;
                 }

              /* possible pointer allignment problems           */
              pnew = (aentry *)malloc(sizeof(aentry));
              if (pnew==(aentry *)NULL)
                 {
                 e_trap(ALLOCATION,2,E_TMSG,41);
                 E_TPOPP("e_actn")
                 return;
                 }
#ifdef HEAP_CHECK
b_geth((a_char *)&pold->succ,(a_char *)pnew,(a_char *)"e_actn");
#endif
              pnew->succ = pold->succ;
              pold->succ = pnew;
              p = pnew;
              p->stat = FALSE;
              }
           else if (!(action & E_CHNG))
              {
              fprintf(f_errr.fp,"%se_actn : No exception handler ",e_head);
              fprintf(f_errr.fp,"found for trap code %08.8lx\n",code);
              E_TPOPP("e_actn")
              return;
              }
           }

        p->code = code;
        if (function!=NO_TRAP) p->action = function;
        p->active = (action & E_ACTIVE) ? TRUE : FALSE;
        p->back = (action & E_BACK) ? TRUE : FALSE;
        p->cont = (action & E_CONT) ? TRUE : FALSE;
        p->def = (action & E_DEFAULT) ? TRUE : FALSE;

        E_TPOPP("e_actn")
        }
