/*******************************************************************************
* YORKTOWN ADVANCED SGML PARSER (YASP)                                         *
*         An SGML Parser conforming to International Standard ISO 8879 --      *
*         Standard Generalized Markup Language                                 *
*------------------------------------------------------------------------------*
* Written 1987 - 1993 by                                                       *
*         Pierre G. Richard                                                    *
*         IBM T.J. Watson Research Center                                      *
*         Yorktown Heights, New York                                           *
*         petrus@watson.ibm.com                                                *
*------------------------------------------------------------------------------*
* FUNCTION NAME    = YASP / Document Instance Parsing                          *
* STATUS           = Version 0, Release 1, Level 33 and up                     *
* COMPONENT NAME   = yasp.c                                                    *
* DESCRIPTIVE NAME = Main of the PARSER                                        *
* DATE_WR          = 05/28/1988                                                *
* AUTHOR           = Pierre G. Richard - PETRUS at YKTVMX                      *
*                                                                              *
* FUNCTIONAL DESCRIPTION =                                                     *
*                                                                              *
* IMPLEMENTATION NOTE =                                                        *
*   The stacksize must be around 20K for OS2,  40K for a mainframe.            *
*                                                                              *
* DEPENDENCIES =  (see Include list)                                           *
*                                                                              *
* IMPORT=                                                                      *
*                                                                              *
* EXPORT=                                                                      *
*                                                                              *
* CHANGE HISTORY =                                                             *
* Number Date     Inits    Change & Reason (brief)                             *
*      1 03/07/91 PETRUS   INI_MODE set by parse_prolog, CON_MODE by parse_doc *
*      2 12/07/91 PETRUS   INSTANCE: Parse_prolog checks and changes the OCS   *
*      3 06/13/95 ESPERT   Added a new SUBMAIN API function                    *
*******************************************************************************/

/*-------------+
|Include Files |
+-------------*/
#include "banner.h"    /* This module includes code depending on YASP version */
#include "machine.h"
#include "portable.h"
#include "yaspapi.h"
#include "global.h"
#include "usrlib.h"
#include "sgml.h"
#include "yasp.h"
#include "gtype.h"
#include "hash.h"
#include "teller.h"

/*-------------+
|Exported Data |
+-------------*/
char const * const C_FCT PACID = PAC_IDENTIFIER;
#if (defined(WATC))
const int _staksiz = (40*1024);   /* Get a comfortable stack */
#endif

/*--------------+
|Local Functions|
+--------------*/
static CHOICES const * _loadds LP_FCT adr_prolog_choices(void);
static void    LP_FCT   open_prim_entity (GA_P, EXID *, ETY  *);
static boolean LP_FCT   guess_a_doctype  (GA_P, uchar *);
static ELT *   LP_FCT   parse_prolog     (GA_P, boolean, boolean);
static int     C_FCT    pse              (PAC *);

/*STATIC----------------------------------------------------adr_prolog_choices-+
| Allow temporary access to local constant area (choices)                      |
+-----------------------------------------------------------------------------*/
static CHOICES const * _loadds LP_FCT adr_prolog_choices(void)
{
   static CHOICES const prolog_choices[] = {
      { offsetof(GNWDTAB,DOCTYPE),  (int)DOCTYPE_TK   },
      { offsetof(GNWDTAB,LINKTYPE), (int)LINKTYPE_TK  },
      { -1,                         (int)NOT_FOUND_TK }
   };
   return(prolog_choices);
}

/*STATIC------------------------------------------------------open_prim_entity-+
| Build an ETY and em_open the primary entity                                  |
+-----------------------------------------------------------------------------*/
static void LP_FCT open_prim_entity(GA_P gbla_p, EXID *exid_p, ETY  *ety_p)
{
   memset((uchar *)exid_p,0,sizeof(EXID));  /* zero the XID */
   exid_p->asgn_cls = PRIMARY_XFC;          /* tell it's text */
   ety_p->name._.p = (uchar *)0;            /* "(primary)" */
   ety_p->is = EXTERNAL_EF | RCDATA_EF;     /* Tell what it is */
   ety_p->kind = SGML_EFK;
   ety_p->val.ext._.exid.p = exid_p;
   ety_p->val.ext.nad.p = (NAD *)0;
   if (!em_open(gbla_p,ety_p)) {
      errorh(gbla_p,ABORTED,ERH_T_SEV);
   }
}

/*STATIC-------------------------------------------------------guess_a_doctype-+
| Strategy to guess a doctype when there is no DTD                             |
+-----------------------------------------------------------------------------*/
static boolean LP_FCT guess_a_doctype(GA_P gbla_p, uchar *DTname_p)
{
   if (GA(curr_token) != STAGO_TK) return(FALSE); /* Get first GI */
   em_unrd(gbla_p,                                /* unread ... */
      get_name(gbla_p, DTname_p)                  /* gotten GI */
   );
   return(ut_find(gbla_p, UTODTR_XFC, DTname_p, (EXID *)0) ? TRUE : FALSE);
}

/*STATIC----------------------------------------------------------parse_prolog-+
| [7] prolog = other prolog*, base document type declaration,                  |
|              (document type declaration | other prolog)*,                    |
|              (link type declaration | other prolog)*                         |
|                                                                              |
| [8] other prolog = comment declaration | processing instruction | s          |
|                                                                              |
| Returns a pointer to the ELT structure describing the base elt.              |
+-----------------------------------------------------------------------------*/
static ELT * LP_FCT parse_prolog(
   GA_P gbla_p,
   boolean is_SGML_found,
   boolean is_scope_instance
) {
   uchar  initial_LTname[NAMELEN_MAX+1];
   uchar  other_name[NAMELEN_MAX+1];
   boolean linktype_found = FALSE;
   uint doctype_count = 0;
   DTSG dtsg;
   POS pos;

   /*-----------------------------+
   |Create the ODT(s?) and OLT(s?)|
   +-----------------------------*/
   set_mode(gbla_p,INI_MODE);       /* and also to point the right dv */
   tll_PROB(gbla_p);                /* tell prolog started */
   for (;;) {
      skip_S(gbla_p);
      switch (GA(curr_token)) {
      case MDO_COM_TK:
         is_SGML_found = TRUE;
         skip_cdc(gbla_p);          /* skip comment declaration */
         continue;
      case MDO_MDC_TK:              /* "short" comment */
         is_SGML_found = TRUE;
         continue;
      case PIO_TK:                  /* Processing Instruction */
         is_SGML_found = TRUE;
         get_PI(gbla_p);
         continue;
      case MDO_TK:
#if YASP_RVL_GE(0,1,26)
         em_pos(gbla_p, &pos, GA(curr_count) + 1);
#endif
         switch(choos_in(gbla_p,adr_prolog_choices(),(GNWD *)&GA(gnwdtab))) {
         case DOCTYPE_TK:
            is_SGML_found = TRUE;
            if (linktype_found) {   /* No DOCTYPE can be found after LINKTYPE */
               errorh(gbla_p,INVMD,ERH_T_SEV+ERH_LOCATE);
            }
            if (doctype_count > GA(opt).max_concur) { /* see 7.1, 7.2.1 */
               errorh(gbla_p,BIGDTD,ERH_E_SEV+ERH_LOCATE);
            }
            tll_DTDB(gbla_p, &pos);
            odt_main(gbla_p, doctype_count ? other_name : dtsg.base_elt_name);
            tll_DTDN(gbla_p, doctype_count ? other_name : dtsg.base_elt_name);
            ++doctype_count;
            continue;
         case LINKTYPE_TK:
            is_SGML_found = TRUE;
            olt_main(gbla_p, linktype_found ? other_name : initial_LTname);
            linktype_found = TRUE;
            continue;
         default:
            /* Quiet: this can be a MD allowed in document instance */
            break;
         }
         break;
      default:                      /* NOT_FOUND, STAGO, combined STAGO_x */
         break;
      }
      break;
   }
   /*-----------------+
   |Load the base ODT |
   +-----------------*/
   if (!doctype_count) {                    /* If no DOCTYPE MD found, */
      if (guess_a_doctype(gbla_p, dtsg.base_elt_name)) { /* Guess one... */
         errorh(gbla_p,NODTDI,ERH_W_SEV+ERH_LOCATE);     /* OK but not in ISO */
      }else {                               /* No DOCTYPE, unable to guess */
         if (is_SGML_found) {
            errorh(gbla_p,NODTD,ERH_T_SEV+ERH_LOCATE);
         }else {
            errorh(gbla_p,NODTSG,ERH_T_SEV+ERH_LOCATE);
         }
      }
   }
   load_odt(gbla_p,&dtsg);                  /* load the ODT, get signature */
   em_unrd(gbla_p,GA(curr_count));          /* Unread STAGO_x, or MDO.. */
   if (is_scope_instance) {                 /* if scope instance */
      load_ocs(gbla_p, UTSYNU_XFC);         /* reload the instance OCS */
   }
   tll_PRON(gbla_p,dtsg.base_elt_p);        /* tell prolog ended */
   {
      /*-------------------------------------+
      | Check the new or current OCS is      |
      | compatible with what the DTD expects |
      +-------------------------------------*/
      uint i;
      QNTY *dtd_qnty_p, *ist_qnty_p;
      DSET *dtd_dset_p, *ist_dset_p;
      boolean err_found = FALSE;

      for (
         dtd_qnty_p = dtsg.qntytab, ist_qnty_p = GA(qntytab), i=0;
         i < sizeof(GA(qntytab))/sizeof(QNTY);
         ++i, ++dtd_qnty_p, ++ist_qnty_p
      ) {
         if (ist_qnty_p->value < dtd_qnty_p->value) {
            err_found = TRUE;
            errorh(
               gbla_p, INVISTQTY, ERH_W_SEV,
               GA(qnty_names)[i], ist_qnty_p->value, dtd_qnty_p->value
            );
         }
      }
      for (
         dtd_dset_p = dtsg.dsettab, ist_dset_p = GA(dsettab), i=0;
         i < sizeof(GA(dsettab))/sizeof(DSET);
         ++i, ++dtd_dset_p, ++ist_dset_p
      ) {
         if (
            (ist_dset_p->is_described != dtd_dset_p->is_described) ||
            (ist_dset_p->is_based     != dtd_dset_p->is_based    ) ||
            (ist_dset_p->is_parm_lit  != dtd_dset_p->is_parm_lit ) ||
            (ist_dset_p->is_unused    != dtd_dset_p->is_unused   ) ||
            (ist_dset_p->s_chnb       != dtd_dset_p->s_chnb      )
            ) {
            errorh(gbla_p, INVISTDST, ERH_W_SEV, i);
         }
      }
      if (err_found) errorh(gbla_p,ABORTED,ERH_T_SEV);
   }
   return(dtsg.base_elt_p);                 /* returns the base elt pointer */
}

/*---------------------------------------------------------------------PRSMAIN-+
|This entry is taken at the very first time the PARSER is called.              |
|                                                                              |
|Parse the SGML declaration or load an already compiled one, open the          |
|primary entity, parse the prolog and the document instance.                   |
|                                                                              |
| [1] SGML document = SGML document entity,                                    |
|     (SGML subdocument entity | SGML text entity | non-SGML data entity)*     |
|                                                                              |
| [2] SGML document entity = s*, SGML declaration,                             |
|     prolog, document instance set, Ee                                        |
+-----------------------------------------------------------------------------*/
#if (defined(C6_00))                        /* Microsoft C6.00 */
#pragma optimize( "elg",off )               /* setjmp/longjmp => No optimize */
#endif
uint C_FCT PRSMAIN(PAC *pac_p)
{
   uint rc;
   EXID prim_exid;
   ETY  prim_ety;
   void  *ocsmin_storage;
   GA_P gbla_p;
   boolean is_SGML_found;
   boolean is_scope_instance;

   /*---------------------+
   |Obtain the global area|
   +---------------------*/
#if (defined(DOS_SYS) || defined(OS2V1_SYS))/* 16-bit systems */
   GLOBAL_AREA global_area;                 /* Global Area: on the stack */
   gbla_p = (GA_P)&global_area;             /* cast to a NEAR_D */
   pac_p->gwork_p = &global_area;           /* to regain our GA_P in pse() */
#else
   pac_p->stg.len = sizeof(GLOBAL_AREA);    /* set size of storage to get */
   pac_p->func = SGET_PFC;                  /* "get storage" service */
   if ((rc = pac_p->ase(pac_p)) != 0) return(rc);
   pac_p->gwork_p = gbla_p = pac_p->stg._.p;
#endif

   /*---------------+
   |Initializations |
   +---------------*/
   pac_p->pse = pse;                        /* Parser Services entry */
   memset(gbla_p,'\0',sizeof(GLOBAL_AREA)); /* Initialize GLOBAL area */
   gbla_p->pac_p = pac_p;
   if ((rc = setjmp(GA(to_main))) != 0) {   /* jump back here if troubles */
      pac_p->gwork_p = (void *)0;           /* refuse further services */
      return(rc);                           /* take this back-door exit */
   }
   pl_accs(gbla_p,0);                       /* activate pool zero */
   ocsmin_storage = min_load(gbla_p);       /* load the minimal OCS */
   GA(lit_p) = malloc(2 * (LITLEN+1));      /* Get work area for literals */

   open_prim_entity(gbla_p, &prim_exid, &prim_ety);
   GA(floor_level) = GA(enty_level);

   /*--------------------------------------------------+
   |SGML Declaration: create (?) and load the real OCS |
   +--------------------------------------------------*/
   set_mode(gbla_p,INI_MODE);               /* STAGO will also be recognized */
   skip_S(gbla_p);
#if YASP_RVL_GE(0,1,26)
   em_pos(gbla_p, &(pac_p->pos), GA(curr_count) + 1); /* position before MDO */
#endif
   if ((GA(curr_token) == MDO_TK) &&        /* MDO found */
      (get_gnam(gbla_p,GA(alwdtab_p)->SGML.s.p))) { /* variant (USER ?) OCS */
      tll_DECB(gbla_p);                     /* Tell SGML found */
      is_scope_instance = ocs_main(gbla_p); /* Call the CS Compiler */
      free(ocsmin_storage);                 /* free temp OCS */
      load_ocs(                             /* Load the OCS: */
         gbla_p, is_scope_instance ?        /* RefCon... if SCOPE INSTANCE */
         UTSYNR_XFC : UTSYNU_XFC            /* User... if SCOPE DOCUMENT */
      );
      em_read(gbla_p);                      /* see change #5 in ocscomp.c */
      is_SGML_found = TRUE;
   }else {
      free(ocsmin_storage);                 /* free temp OCS */
      load_ocs(gbla_p, UTSYNL_XFC);         /* Assume the Local OCS */
      SET_BITOFF(GA(opt).ot,INSTANCE_SCOPE_OT);
      is_scope_instance = FALSE;            /* Deny SCOPE Instance */
      em_unrd(gbla_p,GA(curr_count));       /* unread the MDO or STAGO */
      is_SGML_found = FALSE;
   }
   /*-----------------------------------------+
   | Reset the lit buffer, set the PI buffer: |
   | now their size is well known.            |
   +-----------------------------------------*/
   GA(lit_p) = realloc(GA(lit_p), 2*(LITLEN+1)); /* Resize iterals */
   GA(pi_lit) = malloc(PILEN+1);            /* PI buffer (now PILEN is known) */

   /*--------------------------------------------+
   |Parse the prolog, then the main doc instance |
   +--------------------------------------------*/
   prs_prid(gbla_p,parse_prolog(gbla_p, is_SGML_found, is_scope_instance));

   capa_chk(gbla_p,GA(capcnt));             /* check capacity overflows */
   em_close(gbla_p);                        /* close the primary entity */
   GA(is_doc_ended) = TRUE;
   tll_DOCN(gbla_p);                        /* tell document ended */

   /*---------------------------+
   |Perform clean-up and return |
   +---------------------------*/
   pac_p->gwork_p = (void *)0;             /* no more PSE's */
   free(GA(pi_lit));                       /* Free the PI Buffer */
   free(GA(lit_p));                        /* Free the lit buffer */
   if (GA(opt).appinfo._.p) free(GA(opt).appinfo._.p); /* Free APPINFO */
   pl_clean(gbla_p);                       /* release all pools */

#if (!defined(DOS_SYS) && !defined(OS2V1_SYS)) /* *not* 16-bit systems */
   pac_p->stg.len = sizeof(GLOBAL_AREA);   /* set size of storage to free */
   pac_p->stg._.p = gbla_p;                /* address in stg.p */
   pac_p->func = SFRE_PFC;                 /* "free storage" service */
   pac_p->ase(pac_p);                      /* Free the Global Area */
#endif
   return(0);
}
#if (defined(C6_00))                        /* Microsoft C6.00 */
#pragma optimize( "",on )                   /* Resume optimization */
#endif

/*---------------------------------------------------------------------submain-+
|This entry is taken when a SUBDOC is encountered,                             |
|   - either directly by the PARSER, when a SUBDOC entity is encountered       |
|     in content                                                               |
|   - OR by the Application, when processing a SUBDOC attribute                |
|                                                                              |
| [3] SGML subdocument entity =                                                |
|     prolog, s*, document instance set, Ee                                    |
|                                                                              |
|Note: this routine can be reentered as many time as nested SUBDOC.            |
|      In case of severe errors, the exit routine will properly close          |
|      any active "submain" and longjump to the exit point of "prsmain".       |
|                                                                              |
+-----------------------------------------------------------------------------*/
#if (defined(C6_00))                        /* Microsoft C6.00 */
#pragma optimize( "elg",off )               /* setjmp/longjmp => No optimize */
#endif
void P_FCT submain(GA_P gbla_p)
{
   void *save_gbla_part;
   uint rc;
   int curr_floor_level;
   boolean is_scope_instance;

   if (GA(subdoc_count) >= (GA(opt).max_subdoc)) {
      errorh(gbla_p,BIGSUBDOC,ERH_W_SEV);
   }else {
      ++(GA(subdoc_count));
      curr_floor_level = GA(floor_level);       /* save current floor_level */
      GA(floor_level) = GA(enty_level);         /* set a new one */
      save_gbla_part = malloc(VARIABLE_GLOBAL_AREA_SIZE);
      memcpy(save_gbla_part,gbla_p,VARIABLE_GLOBAL_AREA_SIZE);
      memset(gbla_p,0,VARIABLE_GLOBAL_AREA_SIZE);

      if ((rc = setjmp(GA(to_main))) == 0) {   /* allow long jumps */
         pl_accs(gbla_p,0);                    /* activate pool zero */
         /*-----------------------------------------+
         |Parse the Prolog and the Document Instance|
         +-----------------------------------------*/
         if IS_BITON(GA(opt).ot,INSTANCE_SCOPE_OT) {
            is_scope_instance = TRUE;          /* if scope instance */
            load_ocs(gbla_p, UTSYNR_XFC);      /* Reload the RefCon OCS */
         }else {
            is_scope_instance = FALSE;
         }
         prs_subd(gbla_p,parse_prolog(gbla_p,TRUE,is_scope_instance));
         capa_chk(gbla_p,GA(capcnt));          /* check capacity overflows */
         tll_DOCN(gbla_p);                     /* tell document ended */
         pl_clean(gbla_p);                     /* release all pools */
      }
      /*---------------------------------------+
      |Restore the previous environment        |
      |(this is also where the long_jump lands)|
      +---------------------------------------*/
      memcpy(gbla_p, save_gbla_part, VARIABLE_GLOBAL_AREA_SIZE);
      free(save_gbla_part);
      GA(floor_level) = curr_floor_level;      /* restore current floor_level */
      --(GA(subdoc_count));
      if (rc) exit(rc);                        /* propaged among SUBMAINS */
   }
   em_close(gbla_p);
}
#if (defined(C6_00))                        /* Microsoft C6.00 */
#pragma optimize( "",on )                   /* Resume optimization */
#endif

/*---------------------------------------------------------------------SUBMAIN-+
|Entry point for Application when encountering a SUBDOC entity reference       |
+-----------------------------------------------------------------------------*/
uint C_FCT SUBMAIN(PAC *pac_p, ETY *ety_p)
{
   GA_P gbla_p;
   void *save_gbla_part;
   uint rc;
   int curr_floor_level;
   boolean is_scope_instance;

   if ((!pac_p->gwork_p) || (!ety_p))
     return(END_PARSE_RC);   /* RC=10 was issued */

   gbla_p = pac_p->gwork_p;
   if (GA(subdoc_count) >= (GA(opt).max_subdoc)) {
      errorh(gbla_p,BIGSUBDOC,ERH_W_SEV);
   }else {
     if (!em_open(gbla_p,ety_p)) {
       errorh(gbla_p,ABORTED,ERH_T_SEV);
     }
     ++(GA(subdoc_count));
     curr_floor_level = GA(floor_level);       /* save current floor_level */
     GA(floor_level) = GA(enty_level);         /* set a new one */
     save_gbla_part = malloc(VARIABLE_GLOBAL_AREA_SIZE);
     memcpy(save_gbla_part,gbla_p,VARIABLE_GLOBAL_AREA_SIZE);
     memset(gbla_p,0,VARIABLE_GLOBAL_AREA_SIZE);
     if ((rc = setjmp(GA(to_main))) == 0) {   /* allow long jumps */
       pl_accs(gbla_p,0);                    /* activate pool zero */
       /*-----------------------------------------+
       |Parse the Prolog and the Document Instance|
       +-----------------------------------------*/
       if IS_BITON(GA(opt).ot,INSTANCE_SCOPE_OT) {
	 is_scope_instance = TRUE;          /* if scope instance */
	 load_ocs(gbla_p, UTSYNR_XFC);      /* Reload the RefCon OCS */
       }else {
	 is_scope_instance = FALSE;
       }
       prs_subd(gbla_p,parse_prolog(gbla_p,TRUE,is_scope_instance));
       capa_chk(gbla_p,GA(capcnt));          /* check capacity overflows */
       tll_DOCN(gbla_p);                     /* tell document ended */
       pl_clean(gbla_p);                     /* release all pools */
     }
     /*---------------------------------------+
     |Restore the previous environment        |
     |(this is also where the long_jump lands)|
     +---------------------------------------*/
     memcpy(gbla_p, save_gbla_part, VARIABLE_GLOBAL_AREA_SIZE);
     free(save_gbla_part);
     GA(floor_level) = curr_floor_level;      /* restore current floor_level */
     --(GA(subdoc_count));
     if (rc) exit(rc);                        /* propaged among SUBMAINS */
   }
   em_close(gbla_p);
}

/*STATIC-------------------------------------------------------------------pse-+
|Parser Services                                                               |
+-----------------------------------------------------------------------------*/
static int C_FCT pse(PAC *pac_p)
{
   GLOBAL_AREA *gbla_p;
   int rc = 0;

   if (!pac_p->gwork_p) return(END_PARSE_RC);   /* RC=10 was issued */

   gbla_p = pac_p->gwork_p;
   switch (pac_p->psf) {
   case QELT_PSF:
      if (!GA(elt_htab)) {
         rc = 2;         /* Invalid context */
      }else {
         pac_p->dad._.p = shsh_fnd(GA(elt_htab),pac_p->dad._.p);
      }
      break;
   case QLELT_PSF:
      if (!GA(elt_htab)) {
         rc = 2;         /* invalid context */
      }else {
         pac_p->dad._.p = GA(elt_tab);
         pac_p->dad.len = GA(elt_count);
      }
      break;
   case QGETY_PSF:
      pac_p->dad._.p = GA(gety_htab) ?
      (ETY *)shsh_fnd(GA(gety_htab),pac_p->dad._.p) :   /* use compacted form */
      (ETY *)ehsh_fnd(GA(gety_scope),pac_p->dad._.p);   /* or primary h-table */
      break;
   case FGETY_PSF:                                                               /*@GP0012*/
      if (!GA(gety_htab)) {
         rc = 2;         /* can't do this while creating the ODT */
      }else {
         pac_p->dad._.p = em_fgety(gbla_p, pac_p->dad._.p);                         /*@GP0012*/
      }
      break;                                                                     /*@GP0012*/
   case QLGETY_PSF:
      if (!GA(gety_htab)) {
         rc = 2;         /* Invalid context */
      }else {
         pac_p->dad._.p = GA(gety_tab);
         pac_p->dad.len = GA(gety_count);
      }
      break;
   case QPETY_PSF:
      pac_p->dad._.p = GA(pety_htab) ?
      (ETY *)shsh_fnd(GA(pety_htab),pac_p->dad._.p) :   /* use compacted form */
      (ETY *)ehsh_fnd(GA(pety_scope),pac_p->dad._.p);   /* or primary h-table */
      break;
   case QLPETY_PSF:
      if (!GA(pety_htab)) {
         rc = 2;         /* Invalid context */
      }else {
         pac_p->dad._.p = GA(pety_tab);
         pac_p->dad.len = GA(pety_count);
      }
      break;
   case QNOTA_PSF:
      if (!GA(ncb_htab)) {
         rc = 2;         /* Invalid context */
      }else {
         pac_p->dad._.p = (NCB *)shsh_fnd(GA(ncb_htab),pac_p->dad._.p);
      }
      break;
   case QLNOTA_PSF:
      if (!GA(ncb_htab)) {
         rc = 2;         /* Invalid context */
      }else {
         pac_p->dad._.p = GA(ncb_tab);
         pac_p->dad.len = GA(ncb_count);
      }
      break;
   case QDLM_PSF:
      pac_p->dad._.p = (void *)(GA(dstab)); /* Warning: no more const protect */
      break;
   case QCAPA_PSF:
      {
         void **arr_ptr = (void **)pac_p->dad._.p;
         arr_ptr[0] = GA(capcnt);
         arr_ptr[1] = GA(cappoint);
         arr_ptr[2] = GA(capmax);
      }
      break;
   case QETY_PSF:
      pac_p->dad._.p = GA(enty_level) ? GA(yb_pC)->oeb.ety_p : (void *)0;
      break;
   case QSR_PSF:
      pac_p->dad._.p = GA(srtab);
      pac_p->dad.len = GA(sr_max);
      break;
   case QQTY_PSF:
      pac_p->dad._.p=(void *)(GA(qntytab)); /* Warning: no more const protect */
      break;
   case QOPT_PSF:
      pac_p->dad._.p= &GA(opt);
      break;
   case QFCT_PSF:
      pac_p->dad._.p = GA(fncrtab);
      pac_p->dad.len = GA(fncr_max);
      break;
   default:
      rc = 4;         /* Unknown PSF code */
   }
   if (rc != 0) pac_p->dad._.p = (void *)0;
   return(rc);
}

/*---------------------------------------------------------------------prsexit-+
| Quick exit (abandon ship)  - the #defined exit                               |
+-----------------------------------------------------------------------------*/
#if (defined(C6_00))                        /* Microsoft C6.00 */
#pragma optimize( "elg",off )               /* setjmp/longjmp => No optimize */
#endif
void P_FCT prsexit(GA_P gbla_p, int code)
{
   if (GA(recovering)) return;              /* don't allow to be called again */
   GA(recovering) = TRUE;

   if (code != END_RESUME_RC) {             /* Stay quiet for normal exits */
      errorh(gbla_p,EXITED,ERH_I_SEV,code);
   }
   if (GA(ut_opened)) ut_close(gbla_p,GA(ut_ahl));
   while (GA(enty_level)) em_close(gbla_p); /* close all opened entities */
   pl_clean(gbla_p);                        /* release all pools */
   longjmp(GA(to_main),code);               /* long jump back to main */
}
#if (defined(C6_00))                        /* Microsoft C6.00 */
#pragma optimize( "",on )                   /* Resume optimization */
#endif
/*****************************************************************************/
