/*******************************************************************************
* 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 / CSD compiler                                       *
* STATUS           = Version 0, Release 1, Level 34 and up                     *
* COMPONENT NAME   = ocscomp.c                                                 *
* DESCRIPTIVE NAME = Compile the SGML Declaration                              *
* DATE_WR          = 07/02/1987                                                *
* AUTHOR           = Pierre G. Richard - PETRUS at YKTVMX                      *
*                                                                              *
* FUNCTIONAL DESCRIPTION =                                                     *
*                                                                              *
* IMPLEMENTATION NOTE =                                                        *
*                                                                              *
* DEPENDENCIES =  (see Include list)                                           *
*                                                                              *
* IMPORT=                                                                      *
*                                                                              *
* EXPORT=                                                                      *
*                                                                              *
* CHANGE HISTORY =                                                             *
* Number Date     Inits    Change & Reason (brief)                             *
*      1 02/14/89 PETRUS   added Quantity Table                                *
*      2 02/23/90 PGR      RANK Feature                                        *
*      3 07/03/91 PETRUS   Check in ocs_gplt if made solely of funchar         *
*      4 11/11/91 PETRUS   FCTCLS entry added in FNCR table                    *
*      5 11/27/91 PETRUS   Do not use skip_ps to find the final MDC            *
*      6 01/29/92 PETRUS   13.3.b: check mapping of SGML chars if INSTANCE     *
*      7 01/09/93 PETRUS   APPINFO field                                       *
*******************************************************************************/

/*-------------+
|Include Files |
+-------------*/
#include "machine.h"
#include "portable.h"
#include "yaspapi.h"
#include "global.h"
#include "usrlib.h"
#include "sgml.h"
#include "gtype.h"
#include "ocs.h"
#include "yasp.h"

/*---------------+
|Local Functions |
+---------------*/
static CHOICES const * _loadds LP_FCT adr_yesno_choices(void);
static CHOICES const * _loadds LP_FCT adr_scope_choices(void);
static CHOICES const * _loadds LP_FCT adr_fcl_choices(void);
static uchar   const * const * _loadds LP_FCT adr_ist_chars(void);
static void     LP_FCT check_instance_chars(COMMON_P);
static int      LP_FCT map_to_doc_chnb (COMMON_P, uchar);
static boolean  LP_FCT answer_is_yes   (GA_P);
static void     LP_FCT fncr_confront   (GA_P, FNCR *, uint);
static void     LP_FCT process_features      (COMMON_P);

#if defined (OS2V1_SYS)
/*STATIC-----------------------------------------------------------is_alphanum-+
| Check if a character is alphanumeric.                                        |
| In OS2V1, we need to use _loadds, because ds belongs to the caller, so       |
| the gtype table (used by isalnum) would not be properly addressed.           |
+-----------------------------------------------------------------------------*/
#include <ctype.h>
static boolean _loadds LP_FCT is_alphanum(uint c)
{
   return(isalnum(c) ? TRUE : FALSE);
}

#elif defined (IBMCSET2)
/*STATIC-----------------------------------------------------------is_alphanum-+
| Check if a character is alphanumeric.                                        |
| In OS2V2:                                                                    |
| 1) To be able to run anywhere, YASP.DLL is compiled with:                    |
|    /Rn  (do not use CSET/2 run-time environment), and                        |
|    /Gd- (do not dynamically call the run-time library)                       |
|                                                                              |
| 2) _ctype.h is a table used when char-classification are macros.             |
|    BUT: _ctype.h is unresolved when /Rn /Gd- is in use!                      |
|                                                                              |
| Before the SubSystem/SAA library (dde4nbs.lib) had FUNCTIONS                 |
| for islower, isupper, isdigit and toupper.  It was possible                  |
| to do an alphanum with this.  Alas...                                        |
+-----------------------------------------------------------------------------*/
static boolean LP_FCT is_alphanum(uint c)
{
   if ((c >= 'a' && c <= 'z') ||
       (c >= 'A' && c <= 'Z') ||
       (c >= '0' && c <= '9')) {
      return (TRUE);
   }else {
      return(FALSE);
   }
}

#else
/*DEFINED----------------------------------------------------------is_alphanum-+
| Check if a character is alphanumeric.                                        |
| For all other system, just use the regular isalnum.                          |
+-----------------------------------------------------------------------------*/
#include <ctype.h>
#define is_alphanum(c) isalnum(c)
#endif

/*STATIC---------------------------------------------------------fncr_confront-+
| Check redundancies in fncrtab                                                |
+-----------------------------------------------------------------------------*/
static void LP_FCT fncr_confront(GA_P gbla_p, FNCR *fncrtab, uint fncr_max)
{
   FNCR *fncr_p, *fncr1_p, *fncr2_p;
   boolean rc = FALSE;

   fncr_p = fncrtab + fncr_max - 1; /* last */
   for (fncr1_p = fncrtab; fncr1_p < fncr_p; ++fncr1_p) {
      for (fncr2_p = fncr1_p+1; fncr2_p <= fncr_p; ++fncr2_p) {
         uchar *c_p1 = sk_point(gbla_p, fncr1_p->s.ofs) - 1;
         uchar *c_p2 = sk_point(gbla_p, fncr2_p->s.ofs) - 1;
         while (*++c_p1 == *++c_p2) {
            if (!*c_p1) {
               errorh(
                  gbla_p,DUPFCTREF,ERH_W_SEV,sk_point(gbla_p,fncr1_p->s.ofs)
               );
               rc = TRUE;
            }
         }
         if (fncr1_p->ch_nb == fncr2_p->ch_nb) {
            errorh(gbla_p,DUPFCTCNB,ERH_W_SEV,fncr1_p->ch_nb);
            rc = TRUE;
         }
      }
   }
   if (rc) errorh(gbla_p,ABORTED,ERH_T_SEV);
}

/*STATIC-----------------------------------------------------adr_yesno_choices-+
| Allow temporary access to local constant area (choices)                      |
+-----------------------------------------------------------------------------*/
static CHOICES const * _loadds LP_FCT adr_yesno_choices(void)
{
   static CHOICES const yesno_choices[] = {
      { offsetof(ALWDTAB,YES), YES_TK },
      { offsetof(ALWDTAB,NO),  NO_TK },
      { -1,                    NOT_FOUND_TK }
   };
   return(yesno_choices);
}

/*STATIC---------------------------------------------------------answer_is_yes-+
| Get YES or NO, or abort                                                      |
+-----------------------------------------------------------------------------*/
static boolean LP_FCT answer_is_yes(
   GA_P gbla_p)
{
   switch (choos_in(gbla_p,adr_yesno_choices(),(GNWD *)GA(alwdtab_p))) {
   case YES_TK:  return(TRUE);
   case NO_TK:   return(FALSE);
   default:
      errorh(gbla_p,YESNO,ERH_T_SEV+ERH_LOCATE);
      return(FALSE);
   }
}

/*STATIC-----------------------------------------------------adr_scope_choices-+
| Allow temporary access to local constant area (choices)                      |
+-----------------------------------------------------------------------------*/
static CHOICES const * _loadds LP_FCT adr_scope_choices(void)
{
   static CHOICES const scope_choices[] = {
      { offsetof(ALWDTAB,DOCUMENT), DOCUMENT_TK  },
      { offsetof(ALWDTAB,INSTANCE), INSTANCE_TK  },
      { -1,                         NOT_FOUND_TK }
   };
   return(scope_choices);
}

/*STATIC-------------------------------------------------------adr_fcl_choices-+
| Allow temporary access to local constant area (choices)                      |
+-----------------------------------------------------------------------------*/
static CHOICES const * _loadds LP_FCT adr_fcl_choices(void)
{
   static CHOICES const fcl_choices[] = {
      { offsetof(ALWDTAB,FUNCHAR), FUNCHAR_FCTCLS },
      { offsetof(ALWDTAB,MSICHAR), MSICHAR_FCTCLS },
      { offsetof(ALWDTAB,MSOCHAR), MSOCHAR_FCTCLS },
      { offsetof(ALWDTAB,MSSCHAR), MSSCHAR_FCTCLS },
      { offsetof(ALWDTAB,SEPCHAR), SEPCHAR_FCTCLS },
      { -1,                        NULL_FCTCLS    }
   };
   return(fcl_choices);
}

/*--------------------------------------------------------------------ocs_chrf-+
| Map a character entered directly to a document character number.             |
| Normally, this is not allowed when the character number is different in      |
| both the syntax-reference character set and the document character set.      |
|                                                                              |
| However, if the character can be mapped without ambiguity (not multiple)     |
| to a syntax-reference character number, it can be considered as if it was    |
| entered using a character reference.  Is this a YASP extension ?             |
|                                                                              |
| See the comments in "map_to_doc_chnb" for other required conditions          |
| in doing such a mapping.                                                     |
+-----------------------------------------------------------------------------*/
int P_FCT ocs_chrf(COMMON_P M_p, uchar system_chnb)
{
   GA_P gbla_p = M_p->gbla_p;
   CHARSTAT *charstat_p;

#if (defined(IBMCSET2))          /* IBM C/Set2 bug (01/04/92, V1.0) */
   charstat_p = M_p->charstat + (uint)system_chnb;
#else
   charstat_p = M_p->charstat + system_chnb;
#endif
   if (!(charstat_p->is_described & IN_SYN_MASK)) {
      errorh(gbla_p,NODRSYN,ERH_W_SEV+ERH_LOCATE,system_chnb);
      M_p->must_abort = TRUE;
      return(-1);
   }
   if (charstat_p->is_multiple & IN_SYN_MASK) {
      errorh(gbla_p,DUPDRSYN,ERH_W_SEV+ERH_LOCATE,system_chnb);
      M_p->must_abort = TRUE;
      return(-1);
   }
   return(map_to_doc_chnb(M_p,charstat_p->syn_d_chnb));
}

/*STATIC-------------------------------------------------------map_to_doc_chnb-+
| Map a syntax character number to a document character number.                |
| Returns the document character number, or -1 if in error.                    |
|                                                                              |
| There is a lot of reason not to be able to map a syntax character:           |
|                                                                              |
|   -- NODRSYN2 --                                                             |
|   1) The syntax character number has not be described                        |
|   2) The syntax character has been described as UNUSED                       |
|   3) The syntax character set is mapped on its BASESET to an UNUSED character|
|                                                                              |
|   -- NODRDOC2 --                                                             |
|   4) A corresponding document character number has not been described,       |
|   5) The corresponding document character number has been described as       |
|      UNUSED.                                                                 |
|   6) The corresponding document character number is mapped on its BASESET    |
|      to an UNUSED character                                                  |
|   In such cases, the CHARSTAT table indicates: not described                 |
|   7) More than one corresponding document character number has been found    |
|                                                                              |
+-----------------------------------------------------------------------------*/
static int LP_FCT map_to_doc_chnb(COMMON_P M_p, uchar syn_chnb)
{
   GA_P gbla_p = M_p->gbla_p;
   DSET *syn_dset_p;
   CHARSTAT *charstat_p;
   uchar doc_chnb;

#if (defined(IBMCSET2))          /* IBM C/Set2 bug (01/04/92, V1.0) */
   syn_dset_p = M_p->syn_dset + (uint)(M_p->swtab[syn_chnb]);
#else
   syn_dset_p = M_p->syn_dset + M_p->swtab[syn_chnb];
#endif
   if ((!syn_dset_p->is_described)||(syn_dset_p->is_unused)) {
      errorh(gbla_p,NODRSYN2,ERH_W_SEV+ERH_LOCATE,syn_chnb);
      M_p->must_abort = TRUE;
      return(-1);
   }
   charstat_p = M_p->charstat + syn_dset_p->s_chnb;
   if (syn_dset_p->is_parm_lit) charstat_p += MAX_CHARSET;

   if ((charstat_p->is_described & IN_DOC_MASK) &&
      (!(charstat_p->is_multiple & IN_DOC_MASK)) &&
      (*(M_p->gtype + (doc_chnb=charstat_p->doc_d_chnb)) != S_NONSGML)) {
      return(doc_chnb);
   }else {
      errorh(gbla_p,NODRDOC2,ERH_W_SEV+ERH_LOCATE,syn_chnb);
      M_p->must_abort = TRUE;
      return(-1);
   }
}

/*--------------------------------------------------------------------ocs_gplt-+
|Get a parameter literal into str_p, returns its length.  When the boolean     |
|"is_solely_funchar" is TRUE, if the parameter was made solely of function     |
|characters (introduced by named character reference), returns a length of 0.  |
|"str_p" must point to a buffer that is at least LITLEN + 1 long.              |
|                                                                              |
|This is a variant version of get_plit to get a parameter literal while        |
|parsing the SYNTAX parameter.                                                 |
|  1) Only CRO, LIT or LITA will be recognized.                                |
|  2) The gotten parameter will be expressed using the document character set. |
|     a) If a character reference number is found, it will be represented by   |
|        its matching brother in the document character set (map_to_doc_chnb)  |
|     b) If a named character reference is found, it is translated into        |
|        a document character number by get_chrf, as the "fncrtab" is          |
|        already mapping name to char number in the document character set.    |
|     c) If a character is entered directly, it is transformed into            |
|        a syntax character number, then mapped to a document character number |                                  |
|        (ocs_chrf)                                                            |
|                                                                              |
|  ASSUME: curr_token is one of LIT_TK or LITA_TK                              |
+-----------------------------------------------------------------------------*/
uint P_FCT ocs_gplt(COMMON_P M_p, uchar *str_p, boolean is_solely_funchar)
{
   GA_P gbla_p = M_p->gbla_p;
   uchar *c_p, *e_p;
   int chnb;
   TK delim_token;

   if ((GA(curr_token) != LIT_TK)&&(GA(curr_token) != LITA_TK)) {
      errorh(gbla_p,NOLIT,ERH_T_SEV+ERH_LOCATE);
   }
   psh_mode(gbla_p,LITP_MODE);
   c_p = str_p;
   e_p = str_p + LITLEN;
   delim_token = GA(curr_token);
   for (;;) {
#if (defined(IBMC370))                             /* IBM C370 Bug */
      dl_find(gbla_p);  switch (GA(curr_token)) {  /* *}* */
#else
      switch (dl_find(gbla_p)) {
#endif
      case LIT_TK:
      case LITA_TK:
         if (GA(curr_token)==delim_token) {
            pop_mode(gbla_p);
            *c_p = '\0';
            return(is_solely_funchar ? 0 : c_p-str_p);
         }
         /* fall thru */
      default:
         em_unrd(gbla_p,GA(curr_count));
         /* fall thru */
      case NOT_FOUND_TK:
         if (GA(curr_char) == Ee) {
            errorh(gbla_p,UBLNLIT,ERH_T_SEV+ERH_LOCATE,
            delim_token==LIT_TK ? GA(dstab)[LIT_ix].p : GA(dstab)[LITA_ix].p);
         }else if ((chnb = ocs_chrf(M_p,(uchar)GA(curr_char)))!=-1) {
            break;                 /* OK: enter this chnb */
         }
         em_read(gbla_p);
         continue;
      case CRO_TK:
         switch(get_chrf(gbla_p)) {
         case INVALID_CHRF:
            continue;              /* GA(curr_char) already at next char */
         case NAMED_CHRF:
            chnb = GA(curr_char);  /* Named: is already a doc_chnb */
            break;                 /* OK: enter this chnb */
         case NUMERIC_CHRF:
            if ((chnb = map_to_doc_chnb(M_p,(uchar)GA(curr_char)))!=-1) {
               break;              /* OK: enter this chnb */
            }
            em_read(gbla_p);
            continue;
         }
         break;
      }
      if ((is_solely_funchar) && (!((M_p->gtype)[chnb] & (S_SSPCHAR |
         S_SEPCHAR | S_FUNCHAR | S_MSICHAR | S_MSOCHAR | S_MSSCHAR)))) {
         is_solely_funchar = FALSE; /* release caller's bad assumption */
      }
      *c_p = (uchar)chnb;
      if (++c_p > e_p) errorh(gbla_p,BIGLIT,ERH_T_SEV+ERH_LOCATE);
      em_read(gbla_p);
   }
}

/*STATIC---------------------------------------------------------adr_ist_chars-+
| Allow temporary access to local constant area                                |
+-----------------------------------------------------------------------------*/
static uchar const * const * _loadds LP_FCT adr_ist_chars(void)
{
   static uchar const * const char_names[] = {
      (uchar *)"RE",
      (uchar *)"RS",
      (uchar *)"SPACE",
      (uchar *)"TAB",
      (uchar *)"MDO",
      (uchar *)"COM",
      (uchar *)"PIO",
      (uchar *)"MDC",
      (uchar *)"\0\0<\0!\0>\0-\0?\0\0"
   };
   return(char_names);
}

/*STATIC--------------------------------------------------check_instance_chars-+
| If INSTANCE, verify that no SGML character can lead to an ambiguity,         |
| as decribed by 13.3 b)                                                       |
+-----------------------------------------------------------------------------*/
static void LP_FCT check_instance_chars(COMMON_P M_p)
{
   GA_P gbla_p = M_p->gbla_p;
   int case_count = 0;
   boolean is_next_case = FALSE;
   boolean must_abort = M_p->must_abort;      /* Must be restored */
   uchar const * const * char_names;
   uchar const *c_p;
   uchar ist_char, ref_char;
   boolean is_tab_OK, inv_dlm_change;
   uint fncr_count = GA(fncr_max)+1;
   FNCR *fncr_p = GA(fncrtab)-1;
   int i;

   c_p = *(char_names = adr_ist_chars());
   for (;;) {
      ist_char = ref_char = '\0';
      inv_dlm_change = FALSE;
      if (is_next_case) {
         ++case_count;
         c_p = *++char_names;
      }
      switch (case_count) {
      case 0:
         ist_char = (uchar)((++fncr_p)->ch_nb), ref_char = GA(RE_char);
         is_next_case = TRUE;
         --fncr_count;
         break;
      case 1:
         ist_char = (uchar)((++fncr_p)->ch_nb), ref_char = GA(RS_char);
         is_next_case = TRUE;
         --fncr_count;
         break;
      case 2:
         ist_char = (uchar)((++fncr_p)->ch_nb), ref_char = GA(SPACE_char);
         is_next_case = TRUE;
         --fncr_count;
         break;
      case 3:        /* TAB */
         is_tab_OK = FALSE;
         while (--fncr_count > 0) {
            if (((++fncr_p)->fctcls == SEPCHAR_FCTCLS) &&
              ('\t'==(uchar)fncr_p->ch_nb) && (!strcmp(fncr_p->s.p, c_p))) {
              is_tab_OK = TRUE;
              break;
            }
         }
         is_next_case = TRUE;
         if (!is_tab_OK) {
            ist_char = '\0', ref_char = '\t';
            break;
         }else {
            continue;
         }
      case 4:        /* MDO */
         inv_dlm_change = (boolean)M_p->is_dlm_change.mdo;
         is_next_case = TRUE;
         break;
      case 5:        /* COM */
         inv_dlm_change = (boolean)M_p->is_dlm_change.com;
         is_next_case = TRUE;
         break;
      case 6:        /* PIO */
         inv_dlm_change = (boolean)M_p->is_dlm_change.pio;
         is_next_case = TRUE;
         break;
      case 7:        /* MDC */
         inv_dlm_change = (boolean)M_p->is_dlm_change.mdc;
         is_next_case = TRUE;
         break;
      case 8:        /* List: "<!>-?" */
         if ((ref_char = *(c_p += 2)) != '\0') {
            is_next_case = FALSE;
            if ((i = map_to_doc_chnb(M_p, ref_char)) == -1) {
               ist_char = '\0';
            }else {
               ist_char = (uchar)i;
            }
            break;
         }
         M_p->must_abort = must_abort;   /* if map_to_doc_chnb changed it */
         is_next_case = TRUE;
         continue;
      default:
         return;
      }
      if (inv_dlm_change) {
         errorh(gbla_p, INVISTDLM, ERH_W_SEV, c_p);
         inv_dlm_change = FALSE;
      }else if (ist_char != ref_char) {
         errorh(gbla_p, INVISTCH, ERH_W_SEV, c_p);
      }
   }
}

/*STATIC------------------------------------------------------process_features-+
|Enter here when FEATURES is about to be read.                                 |
|Set the M_p->opt structure.                                                   |
+-----------------------------------------------------------------------------*/
static void LP_FCT process_features(COMMON_P M_p)
{
   GA_P gbla_p = M_p->gbla_p;
   ulong il;
   uint  max_feat;
   uint *i_p;
   boolean feature_not_supported;
   int i;
   uchar    *s_p;
   uint     ft_bit;

   chk_gnam(gbla_p,GA(alwdtab_p)->FEATURES.s.p);
   for (i=0; i<13; ++i) {
      i_p = (uint *)0;               /* Indicate no number can follows */
      feature_not_supported = FALSE;
      skip_Wps(gbla_p);
      switch (i) {
      case 0:                        /* MINIMIZE     */
         chk_gnam(gbla_p,GA(alwdtab_p)->MINIMIZE.s.p);
         continue;
      case 1:                        /*     DATATAG  */
         s_p = GA(alwdtab_p)->DATATAG.s.p;
         ft_bit = DATATAG_FT;
         break;
      case 2:                        /*     OMITTAG  */
         s_p = GA(alwdtab_p)->OMITTAG.s.p;
         ft_bit = OMITTAG_FT;
         break;
      case 3:                        /*     RANK     */
         s_p = GA(alwdtab_p)->RANK.s.p;
         ft_bit = RANK_FT;
         break;
      case 4:                        /*     SHORTTAG */
         s_p = GA(alwdtab_p)->SHORTTAG.s.p;
         ft_bit = SHORTTAG_FT;
         break;
      case 5:                        /* LINK         */
         chk_gnam(gbla_p,GA(alwdtab_p)->LINK.s.p);
         continue;
      case 6:                        /*     SIMPLE + number */
         feature_not_supported = TRUE;
         s_p = GA(alwdtab_p)->SIMPLE.s.p;
         max_feat = 10;
         i_p = &M_p->opt.max_simple;
         ft_bit = SIMPLE_FT;
         break;
      case 7:                        /*     IMPLICIT */
         feature_not_supported = TRUE;
         s_p = GA(alwdtab_p)->IMPLICIT.s.p;
         ft_bit = IMPLICIT_FT;
         break;
      case 8:                        /*     EXPLICIT + number */
         feature_not_supported = TRUE;
         s_p = GA(alwdtab_p)->EXPLICIT.s.p;
         max_feat = 10;
         i_p = &M_p->opt.max_explicit;
         ft_bit = EXPLICIT_FT;
         break;
      case 9:                        /* OTHER        */
         chk_gnam(gbla_p,GA(alwdtab_p)->OTHER.s.p);
         continue;
      case 10:                       /*     CONCUR   */
         feature_not_supported = TRUE;
         s_p = GA(alwdtab_p)->CONCUR.s.p;
         max_feat = MAX_DTD;
         i_p = &M_p->opt.max_concur;
         ft_bit = CONCUR_FT;
         break;
      case 11:                       /*     SUBDOC   */
         s_p = GA(alwdtab_p)->SUBDOC.s.p;
         max_feat = MAX_DTD;
         i_p = &M_p->opt.max_subdoc;
         ft_bit = SUBDOC_FT;
         break;
      default:                       /*     FORMAL   */
         s_p = GA(alwdtab_p)->FORMAL.s.p;
         ft_bit = FORMAL_FT;
         break;
      }
      chk_gnam(gbla_p,s_p);
      skip_Wps(gbla_p);
      if (answer_is_yes(gbla_p)) {
         if (feature_not_supported) {
            errorh(gbla_p,INVFEAT,ERH_W_SEV+ERH_LOCATE,s_p);
         }else {
            SET_BITON(M_p->opt.ft, ft_bit);
         }
         if (i_p) {
            skip_Wps(gbla_p);
            il = get_num(gbla_p);
            if (!feature_not_supported) {
               if (il > max_feat) {
                  errorh(gbla_p,BIGFEAT,ERH_W_SEV+ERH_LOCATE,max_feat);
                  *i_p = max_feat;
               }else if (!il) {
                  SET_BITOFF(M_p->opt.ft, ft_bit);  /* 0 ==> NO  */
               }else {
                  *i_p = (uint)il;
               }
            }
         }
      }
   }
   skip_Wps(gbla_p);
}

/*--------------------------------------------------------------------ocs_main-+
|Enter here when SGML has been decoded.                                        |
|Compile the SGML Declaration, and create:                                     |
|                                                                              |
|  M_p->gtype            sgml types                                            |
|  M_p->uctab            upper case table                                      |
|  M_p->dltab            delimiter advanced recognition table                  |
|  M_p->sr_max           # of items in SR Table                                |
|  M_p->srtab            SHORTREF decl "shortref" recognition                  |
|  new_fncr_max          # of items in FNCR table                              |
|  new_fncrtab           Function Character <-> Character Nbr                  |
|                                                                              |
|  M_p->dstab            A restricted set of delimiter strings                 |
| *new_gnwdtab_p         New values for reserved names                         |
|  M_p->opt              option/feature/scope                                  |
|  new_dvtbent           Delimiter Vector Table Entries ( f(mode) )            |
|  M_p->dv_max           # of items in DV Table                                |
|  new_dvtab             Delimiter Vector Table                                |
|  GA(capmax)            Capacity: max (updated "in place")                    |
|  new_qntytab           Quantity Table                                        |
|  new_RE_char           Record End Character                                  |
|  new_RS_char           Record Start Character                                |
|  new_SPACE_char        Space Character                                       |
|                                                                              |
+-----------------------------------------------------------------------------*/
boolean P_FCT ocs_main(GA_P gbla_p)
{
   AHL       ahl;
   FNCR     *new_fncrtab, fncr, *new_fncr_p, *fncr_p;
   uint      new_fncr_max;
   DV       *new_dvtab;
   QNTYTAB   new_qntytab;
   uint      new_cappoint[CAP_MAX_SIZE];
   DVTBENT   new_dvtbent[NBR_OF_MODES];
   GNWDTAB  *new_gnwdtab_p;
   uchar     new_RE_char;
   uchar     new_RS_char;
   uchar     new_SPACE_char;
   char     *sr_id;
   uchar    *s_p, *lit_p, *c_p, *d_p, *appinfo_p;
   int       i;
   int       d_chnb;
   uint      all_classes, class;
   boolean   external_syntax_found = FALSE;
   int       curr_floor_level;
   uint      ot_bit;
   uchar const * ocs_banner;
   EXID      syn_exid;
   ETY       syn_ety;
   COMMON_P  M_p;            /* points the OCS common area on the stack */
   COMMON_OCS_AREA common;

   pl_sppsh(gbla_p);         /* do all malloc/free in another sub-pool */
   memset(M_p=&common,0,sizeof(common));
   common.gbla_p = gbla_p;
   common.must_abort  = FALSE;
   common.is_not_FPID = FALSE;
   lit_p = GA(lit_p);

   psh_mode(gbla_p,MD_MODE);
   /*------------------------------------+
   |Check we read: <!SGML "ISO 8879:1986"|
   +------------------------------------*/
   skip_ps(gbla_p);
   get_lit_min(gbla_p,lit_p);
   if (strcmp(lit_p,GA(ISO_banner))) {
      errorh(gbla_p, INVSGMLID, ERH_W_SEV+ERH_LOCATE);
   }
   skip_ps(gbla_p);

   /*--------------------------------------------+
   |1) CHARSET  (document character set)         |
   |   Get the System Character Set              |
   |   Fill the M_p->gtype and M_p->uctab tables |
   +--------------------------------------------*/
   chk_gnam(gbla_p,GA(alwdtab_p)->CHARSET.s.p);
   skip_Wps(gbla_p);
   chr_bld(M_p, TRUE);         /* build document character set tables */

   /*-------------------------+
   |2) CAPACITY (capacity set)|
   +-------------------------*/
   cap_bld(M_p);               /* Does check for SCOPE */

   /*-------------------------------+
   |3) SCOPE (concrete syntax scope)|
   +-------------------------------*/
   skip_Wps(gbla_p);
   switch (choos_in(gbla_p,adr_scope_choices(),(GNWD *)GA(alwdtab_p))) {
   case DOCUMENT_TK:
      break;
   case INSTANCE_TK:
      SET_BITON(common.opt.ot,INSTANCE_SCOPE_OT);
      break;
   default:
      errorh(gbla_p,ISORDOC,ERH_T_SEV+ERH_LOCATE);
      break;
   }
   skip_Wps(gbla_p);

   /*--------------------------+
   |4) SYNTAX (concrete syntax)|
   +--------------------------*/
   chk_gnam(gbla_p,GA(alwdtab_p)->SYNTAX.s.p);
   skip_Wps(gbla_p);

   /*-----------------------------+
   |Create a default switch table |
   +-----------------------------*/
   c_p = common.swtab-1;
   i = -1;
   while (++i < MAX_CHARSET) *(++c_p) = (uchar)i;

   if (!get_gnam(gbla_p,GA(alwdtab_p)->SHUNCHAR.s.p)) {
      external_syntax_found = TRUE;
      /*-------------------------------+
      |SYNTAX not followed by SHUNCHAR |
      |Fill the EXID block - build ETY |
      +-------------------------------*/
      xid_fill(gbla_p,&syn_exid,SYNTAX_XFC);        /* skip_ps done */
      if (!(IS_BITON(syn_exid.is,VALIDFPI_XF))) common.is_not_FPID = TRUE;
      syn_exid.name.len = syn_ety.name.len = strlen(
      syn_exid.name._.p = syn_ety.name._.p = GA(alwdtab_p)->SYNTAX.s.p);
      syn_ety.is = EXTERNAL_EF | RCDATA_EF;   /* tell what it is.. */
      syn_ety.kind = SGML_EFK;
      syn_ety.val.ext._.exid.p = &syn_exid;
      syn_ety.val.ext.nad.p = (NAD *)0;
      /*-----------------------+
      |Change the switch table |
      |if any switch are found |
      +-----------------------*/
      {
         uint d_chnb1, d_chnb2;
         boolean is_chnb1_ok, is_chnb2_ok;

         skip_ps(gbla_p);
         if (get_gnam(gbla_p,GA(alwdtab_p)->SWITCHES.s.p)) {
            skip_Wps(gbla_p);
            if ((GA(curr_token) != NOT_FOUND_TK)||(!is_digit(GA(curr_char)))) {
               errorh(gbla_p,NODIG,ERH_T_SEV+ERH_LOCATE);
            }
            do {
               is_chnb1_ok = get_chnb(gbla_p,&d_chnb1);
               skip_Wps(gbla_p);
               is_chnb2_ok = get_chnb(gbla_p,&d_chnb2);
               skip_Wps(gbla_p);
               if ((is_chnb1_ok) && (is_chnb2_ok)) {
                  common.swtab[d_chnb1] = (uchar)d_chnb2;
                  common.swtab[d_chnb2] = (uchar)d_chnb1;
               }
            }while ((GA(curr_token)==NOT_FOUND_TK)&&(is_digit(GA(curr_char))));
         }
      }
      /*--------------------------+
      |Now open the Public Syntax |
      +--------------------------*/
      if (!em_open(gbla_p,&syn_ety)) {
         errorh(gbla_p,ABORTED,ERH_T_SEV);
      }
      curr_floor_level = GA(floor_level); /* save current floor_level */
      GA(floor_level) = GA(enty_level);
      GA(quiet_at_floor) = TRUE;
      skip_Wps(gbla_p);
      chk_gnam(gbla_p,GA(alwdtab_p)->SHUNCHAR.s.p); /* SHUNCHAR expected */
   }

   /*---------------------------------------+
   |SHUNCHAR: update gtype for shunned char |
   |Syntax-Reference character description  |
   +---------------------------------------*/
   chr_shun(M_p);
   chr_bld(M_p, FALSE);

   /*-------------------------------+
   |Check if SWITCHES were properly |
   |assigned (see 13.4.1)           |
   +-------------------------------*/
   c_p = common.swtab-1;
   i = -1;
   while (++i < MAX_CHARSET) {
      if ((uchar)i != *(++c_p)) {         /* have been switched */
         MSGCODE msgcode;
         if ((is_alphanum(common.syn_dset[i].s_chnb)) ||
            (is_alphanum(common.syn_dset[*c_p].s_chnb))) {
            msgcode = INVSWITCH;          /* switch digit or letter : bad */
         }else if ((is_nonsgml(common.syn_dset[i].s_chnb)) ||
            (is_nonsgml(common.syn_dset[*c_p].s_chnb))) {
            msgcode = INVSWTCH2;          /* switch not in syntax: bad */
         }else {
            continue;                     /* else it's ok */
         }
         errorh(gbla_p,msgcode,ERH_W_SEV,*c_p,(uchar)i);
         common.swtab[*c_p] = *c_p;
         common.swtab[i] = (uchar)i;
      }
   }

   /*-------+
   |FUNCTION|
   +-------*/
   chk_gnam(gbla_p,GA(alwdtab_p)->FUNCTION.s.p);
   skip_Wps(gbla_p);
   sr_id = (char *)sa_init(
       gbla_p, sizeof(FNCR), (int (P_FCT *)(uchar *, uchar *, GA_P))0
   );
   for (i=0; i<3; ++i) {
      switch(i) {
      case 0:
         d_p = &GA(RE_char);
         c_p = &new_RE_char;
         fncr.fctcls = RE_FCTCLS;
         break;
      case 1:
         d_p = &GA(RS_char);
         c_p = &new_RS_char;
         fncr.fctcls = RS_FCTCLS;
         break;
      default:
         d_p = &GA(SPACE_char);
         c_p = &new_SPACE_char;
         fncr.fctcls = SPACE_FCTCLS;
         break;
      }
      s_p = GA(fncrtab)[i].s.p;
      chk_gnam(gbla_p,s_p);
      /*-------------------------------------------------------+
      |RE, RS and SPACE can be changed by the NAMES parameter; |
      |however, it's easier to "park" their value now, even    |
      |if they become useless (only 12 bytes wasted at most).  |
      +-------------------------------------------------------*/
      fncr.s.ofs = sk_park(gbla_p, s_p, 1+strlen(s_p));
      skip_Wps(gbla_p);
      if (!get_chnb(gbla_p, (uint *)&d_chnb)) d_chnb = (uint)(*d_p);
      if ((d_chnb = map_to_doc_chnb(M_p,(uchar)d_chnb)) != -1) {
         *(common.gtype + (*c_p = (uchar)(fncr.ch_nb = d_chnb))) |= S_SSPCHAR;
      }
      skip_Wps(gbla_p);
      sa_instl(sr_id,(uchar *)&fncr);
   }
   all_classes = 0;   /* to check MSO/MSI */
   while (!(get_gnam(gbla_p,GA(alwdtab_p)->NAMING.s.p))) {
      get_name(gbla_p,lit_p);
      skip_ps(gbla_p);                                /* added function */
      fncr.fctcls = choos_in(gbla_p,adr_fcl_choices(),(GNWD *)GA(alwdtab_p));
      switch (fncr.fctcls) {
      case FUNCHAR_FCTCLS: class = S_FUNCHAR; break;
      case MSICHAR_FCTCLS: class = S_MSICHAR; break;
      case MSOCHAR_FCTCLS: class = S_MSOCHAR; break;
      case MSSCHAR_FCTCLS: class = S_MSSCHAR; break;
      case SEPCHAR_FCTCLS: class = S_SEPCHAR; break;
      default: errorh(gbla_p,INVFCTCL,ERH_T_SEV+ERH_LOCATE); break;
      }
      skip_Wps(gbla_p);
      if ((get_chnb(gbla_p, (uint *)&d_chnb)) &&
         ((d_chnb = map_to_doc_chnb(M_p,(uchar)d_chnb)) != -1)) {
         class = (*(common.gtype + (fncr.ch_nb = d_chnb)) |= class);
         if ((class & (S_LETTER | S_DIGIT | S_SPECIAL)) &&
            (class & (S_MSICHAR | S_MSOCHAR | S_MSSCHAR))) {
            errorh(gbla_p,INVSCASGN,ERH_W_SEV+ERH_LOCATE);
         }else {
            fncr.s.ofs = sk_park(gbla_p, lit_p, 1+strlen(lit_p));
            sa_instl(sr_id,(uchar *)&fncr);
            all_classes |= class;
         }
      }
      skip_Wps(gbla_p);
   }
   if ((all_classes & S_MSOCHAR) && (!(all_classes & S_MSICHAR))) {
      errorh(gbla_p,NOMSICHAR,ERH_W_SEV);
   }
   if (common.must_abort) errorh(gbla_p,ABORTED,ERH_T_SEV);

   new_fncrtab = (FNCR *)sa_term(sr_id,&new_fncr_max);
   /* check all function names and code are different */
   fncr_confront(gbla_p, new_fncrtab, new_fncr_max);

   /*------------------------------------+
   |Activate the new function table NOW !|
   |(Needed for users'shortref)          |
   +------------------------------------*/
   fncr_p = (GA(fncrtab) = (FNCR *)malloc(new_fncr_max * sizeof(FNCR))) - 1;
   new_fncr_p = new_fncrtab - 1;
   i = (GA(fncr_max) = new_fncr_max) + 1;
   while (--i) {
      (++fncr_p)->s.p = sk_point(gbla_p,(++new_fncr_p)->s.ofs);
      fncr_p->ch_nb = new_fncr_p->ch_nb;
      fncr_p->fctcls = new_fncr_p->fctcls;
   }

   /*-----+
   |NAMING|
   +-----*/
   skip_Wps(gbla_p);

   for (i=0; i<4; ++i) {
      switch (i) {
      case 0:
         c_p = lit_p;
         s_p = GA(alwdtab_p)->LCNMSTRT.s.p;
         class = S_NMSTRT;
         break;
      case 1:
         ++c_p;
         s_p = GA(alwdtab_p)->UCNMSTRT.s.p;
         class = S_NMSTRT;
         break;
      case 2:
         c_p = lit_p;
         s_p = GA(alwdtab_p)->LCNMCHAR.s.p;
         class = S_NMCHAR;
         break;
      default:
         ++c_p;
         s_p = GA(alwdtab_p)->UCNMCHAR.s.p;
         class = S_NMCHAR;
         break;
      }
      chk_gnam(gbla_p,s_p);
      skip_ps(gbla_p);
      ocs_gplt(M_p,c_p,FALSE);
      for (d_p=lit_p; *c_p; ++c_p) {
         class = (*(common.gtype + *c_p) |= class);
         if ((class & (S_LETTER | S_DIGIT | S_SSPCHAR | S_SEPCHAR |
            S_MSICHAR | S_MSOCHAR | S_MSSCHAR)) ||
            ((class & S_NMCHAR) && (class & S_NMSTRT))) {
            errorh(gbla_p,INVNASGN,ERH_T_SEV+ERH_LOCATE,*c_p);
         }
         if (i & 1) common.uctab[*d_p++] = *c_p;
      }
      skip_ps(gbla_p);
      if ((i & 1) && (*d_p)) errorh(gbla_p,DIFUCLC,ERH_T_SEV+ERH_LOCATE);
   }
   chk_gnam(gbla_p,GA(alwdtab_p)->NAMECASE.s.p);
   skip_Wps(gbla_p);
   for (i=0; i<2; ++i) {
      switch (i) {
      case 0:
         s_p = GA(alwdtab_p)->GENERAL.s.p;
         ot_bit = GENERAL_CASE_OT;
         break;
      default:
         s_p = GA(alwdtab_p)->ENTITY.s.p;
         ot_bit = ENTITY_CASE_OT;
         break;
      }
      chk_gnam(gbla_p,s_p);
      skip_Wps(gbla_p);
      if (answer_is_yes(gbla_p)) SET_BITON(common.opt.ot, ot_bit);
      skip_Wps(gbla_p);
   }
   if (common.must_abort) errorh(gbla_p,ABORTED,ERH_T_SEV);

   /*--------------------------------------+
   |DELIM                                  |
   |Set up new_dltab, new_dstab, new_srtab |
   +--------------------------------------*/
   dlm_bld(M_p);

   /*-----+
   |NAMES |
   +-----*/
   nam_bld(gbla_p, &new_gnwdtab_p, new_fncrtab);  /* Does check for QUANTITY */

   /* check again fncrtab validity: SPACE, RE and RS could have been changed */
   fncr_confront(gbla_p, new_fncrtab, new_fncr_max);

   /*-------+
   |QUANTITY|
   +-------*/
   qty_bld(gbla_p, new_qntytab);

   if (external_syntax_found) {
      if (GA(curr_char) != Ee) errorh(gbla_p,INVKWD,ERH_W_SEV+ERH_LOCATE);
      em_close(gbla_p);
      free(syn_exid.val._.p);             /* free chunk allocated by xid_fill */
      GA(quiet_at_floor) = FALSE;
      GA(floor_level) = curr_floor_level; /* restore current floor_level */
   }

   /*------------------------+
   |5) FEATURES (feature use)|
   +------------------------*/
   process_features(M_p);
   if ((IS_BITON(common.opt.ft,FORMAL_FT)) && (common.is_not_FPID)) {
      errorh(gbla_p,INVSGFPI,ERH_W_SEV);
   }

   /*--------------------------------------------+
   |6) APPINFO (application-specific information)|
   |   Store the value into appinfo_p            |
   +--------------------------------------------*/
   chk_gnam(gbla_p,GA(alwdtab_p)->APPINFO.s.p);
   skip_Wps(gbla_p);
   if (GA(curr_token) == NOT_FOUND_TK) {
      chk_gnam(gbla_p,GA(alwdtab_p)->NONE.s.p);
      common.opt.appinfo.len = 0;
      appinfo_p = (uchar *)0;
   }else {
      appinfo_p = malloc(
         common.opt.appinfo.len = 1 + get_lit_min(gbla_p,lit_p)
      );
      memcpy(appinfo_p, lit_p, common.opt.appinfo.len);
      /* The following is to allow me to do specific tests */
      if ((*lit_p    == 'P') && (*(lit_p+1) == 'e') && (*(lit_p+2) == 't') &&
         (*(lit_p+3) == 'r') && (*(lit_p+4) == 'u') && (*(lit_p+5) == 's') &&
         (*(lit_p+6) == '.')) {
         /* Testing LINK SIMPLE 10 today (Sept 27, 1992) ... */                  /*@LK0001*/
         SET_BITON(common.opt.ft, SIMPLE_FT);                                    /*@LK0001*/
         common.opt.max_simple = 10;                                             /*@LK0001*/
      }
   }

   /*-Nov 11, 1991-------------------------------+
   | skip_ps cannot be used here: who knows what |
   | the world will look like after the MDC?     |
   | This explains this awfull piece of code.    |
   +--------------------------------------------*/
   for (;;) {
      if (is_separator(GA(curr_char))) {
        em_read(gbla_p);
      }else if ((GA(curr_char) == *GA(dstab)[COM_ix].p) &&
         (dl_find(gbla_p) == COM_TK)) {
         if (!skip_dlm(gbla_p,GA(dstab)[COM_ix].p)) { /* skip to ending COM */
            errorh(gbla_p,UBLNCOM,ERH_T_SEV+ERH_LOCATE);
         }
      }else {
         if (GA(curr_char) == *GA(dstab)[MDC_ix].p) { /* Bout-du-monde */
            GA(curr_token) = MDC_TK;
         }else {
            GA(curr_token) = NOT_FOUND_TK;            /* error caught later */
         }
         break;
      }
   }

   /*----------------------------+
   |Get the new dvtab            |
   |Final gtype update and check |
   +----------------------------*/
   new_dvtab = dlm_dvtb(M_p,new_dvtbent);
   {
      ushort *i_p = common.gtype - 1;
      i = MAX_CHARSET + 1;
      while (--i) {
         SET_BITOFF(*(++i_p), S_SHUNNED);  /* pure S_SHUNNED are now NON_SGML */
      }
   }
   /*--------------------------+
   |Update the capacity points |
   +--------------------------*/
   {
      uint *i_p = GA(cappoint) - 1;
      uint *j_p = new_cappoint - 1;
      i = CAP_MAX_SIZE + 1;
      while (--i) {
         if (*++i_p == NAMELEN_RCS) {
            *++j_p = new_qntytab[NAMELEN_ix].value;
         }else {
            *++j_p = *i_p;
         }
      }
   }

   if (IS_BITON(common.opt.ot,INSTANCE_SCOPE_OT)) check_instance_chars(M_p);

   /*-----------------+
   |Write the OCS file|
   +-----------------*/
   if (!ut_open(gbla_p, UTSYNU_XFC, TRUE, (uchar *)0, (EXID *)0, &ahl)) {
      errorh(gbla_p,BADOPSWR,ERH_T_SEV);
   }
   ocs_banner = bnr_ocs();
   ut_write(gbla_p,ahl,ocs_banner+1,1 + *ocs_banner);  /* Identify an OCS */
   ut_write(gbla_p,ahl,&new_RE_char,sizeof(uchar));
   ut_write(gbla_p,ahl,&new_RS_char,sizeof(uchar));
   ut_write(gbla_p,ahl,&new_SPACE_char,sizeof(uchar));
   ut_write(gbla_p,ahl,common.dstab,sizeof(DSTAB));
   ut_write(gbla_p,ahl,new_gnwdtab_p,sizeof(GNWDTAB));
   ut_write(gbla_p,ahl,GA(capmax),sizeof GA(capmax));
   ut_write(gbla_p,ahl,new_cappoint,sizeof(GA(cappoint)));
   ut_write(gbla_p,ahl,new_qntytab,sizeof(QNTYTAB));
   ut_write(gbla_p,ahl,&common.opt,sizeof(OPT));
   if (appinfo_p) {                                    /* APPINFO field */
      ut_write(gbla_p,ahl,appinfo_p, common.opt.appinfo.len);
      free(appinfo_p);
   }
   ut_write(gbla_p,ahl,new_dvtbent,sizeof(new_dvtbent));
   ut_write(gbla_p,ahl,common.uctab,sizeof(common.uctab));
   ut_write(gbla_p,ahl,common.gtype,sizeof(common.gtype));
   ut_write(gbla_p,ahl,common.dltab,sizeof(common.dltab));
   ut_write(gbla_p,ahl,common.syn_dset,sizeof(common.syn_dset));
   ut_vput(gbla_p,ahl,new_fncrtab,new_fncr_max * sizeof(FNCR));
   ut_vput(gbla_p,ahl,new_dvtab,common.dv_max * sizeof(DV));
   ut_vput(gbla_p,ahl,common.srtab,common.sr_max * sizeof(EQTK));
   sk_out(gbla_p,ut_write,ahl);
   ut_close(gbla_p,ahl);

   free((uchar *)new_gnwdtab_p);
   free(GA(fncrtab));  /* release fncrtab */
   if (GA(curr_token) != MDC_TK) errorh(gbla_p,NOMDC,ERH_W_SEV+ERH_LOCATE);

   /*-Oct 03, 1988---------------------------------+
   | At this point, we checked that all mallocated |
   | chunks (of the pool #1) were properly freed.  |
   +----------------------------------------------*/
   pop_mode(gbla_p);
   pl_rels(gbla_p);
   pl_sppop(gbla_p);
   return(IS_BITON(common.opt.ot,INSTANCE_SCOPE_OT) ? TRUE : FALSE);
}
/******************************************************************************/
