/*******************************************************************************
* 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 / SGML Library                                       *
* STATUS           = Version 0, Release 1, Level 17 and up                     *
* COMPONENT NAME   = get.c                                                     *
* DESCRIPTIVE NAME = get miscellaneous chunks                                  *
* DATE_WR          = 07/28/1987                                                *
* AUTHOR           = Pierre G. Richard - PETRUS at YKTVMX                      *
*******************************************************************************/

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

/*---------------+
|Local Functions |
+---------------*/
typedef enum {
   MINLIT_GLC,
   LIT_GLC,
   PI_GLC
}GLC;

typedef struct {
   GA_P gbla_p;
   boolean is_active_type;
}LOCAL_AREA;

/* Local area (to check active type) is on the stack (in the nearby) */
typedef LOCAL_AREA STACK_BASED * LOCAL_P;

static void    P_FCT  check_active_type (void STACK_BASED *);
static uint    LP_FCT pick_namechar     (GA_P, uchar *, uint);
static uint    LP_FCT eat_refc          (GA_P);
static uchar * LP_FCT get_dltd_str(
   GA_P, uchar *, uchar *, uchar * const, GLC const
);

/*STATIC-----------------------------------------------------check_active_type-+
|Check if a document type or a link type is active                             |
+-----------------------------------------------------------------------------*/
#define L_p ((LOCAL_P)XL_p)
static void P_FCT check_active_type(void STACK_BASED * XL_p)
{
   GA_P gbla_p = L_p->gbla_p;
   uchar name[NAMELEN_MAX+1];

   get_name(gbla_p,name);
   if (!strcmp(name,GA(active_type))) {
      L_p->is_active_type = TRUE;
   }
}
#undef L_p

/*--------------------------------------------------------------------get_ngac-+
|Check if a document type or a link type in a name group is active             |
|                                                                              |
|Note: this code can be recursively entered via skip_ts, in case the name group|
|      contains a PER with a name-group in it (this explains LOCAL_AREA used). |
|      Tricky, but it works...                                                 |
+-----------------------------------------------------------------------------*/
boolean P_FCT get_ngac(GA_P gbla_p)
{
   LOCAL_AREA L;

   L.gbla_p = gbla_p;
   L.is_active_type = FALSE;
   get_nmgp(gbla_p,check_active_type,&L);
   return(L.is_active_type);
}

/*--------------------------------------------------------------------get_nmgp-+
|Parse a name group, call an user-defined install function for each name       |
|                                                                              |
|[69] name_group = GRPO, ts*,name,ts*,   , GRPC                                |
|                          (connector, ts*,name,ts* )*                         |
+-----------------------------------------------------------------------------*/
void P_FCT get_nmgp(
   GA_P gbla_p,
   void (P_FCT *install_function)(void STACK_BASED *),
   void STACK_BASED * arg_p)
{
   int curr_floor_level = GA(floor_level); /* save current floor_level */
   int init_enty_level  = GA(enty_level);  /* remember where we started */
   uint grpcnt=0;

   psh_mode(gbla_p,GRP_MODE);
   for (;;) {
      GA(floor_level) = GA(enty_level);      /* No Ee allowed */
      skip_ts(gbla_p);                       /* opt ts after GRPO */
      if (GA(curr_token)!=NOT_FOUND_TK) {
         errorh(gbla_p,INVNAMGRP,ERH_T_SEV+ERH_LOCATE);
      }
      if (++grpcnt > GRPCNT) {
         errorh(gbla_p,BIGGRPCNT,ERH_T_SEV+ERH_LOCATE);
      }
      (*install_function)(arg_p);            /* define a new elemt */
      GA(floor_level) = init_enty_level;
      skip_ts(gbla_p);                       /* skip opt ts */
      switch (GA(curr_token)) {
      case AND_TK:
      case SEQ_TK:
      case OR_TK:
         continue;                           /* more to do */
      default:
         errorh(gbla_p,INVCONN,ERH_T_SEV+ERH_LOCATE);
      case GRPC_TK:
         pop_mode(gbla_p);
         if (GA(enty_level) != init_enty_level) {
            errorh(gbla_p,INVHNEST,ERH_T_SEV+ERH_LOCATE);
         }
         GA(floor_level) = curr_floor_level; /* restore current floor_level */
         return;
      }
   }
}

/*--------------------------------------------------------------------get_plit-+
|Get a parameter literal into str_p, returns its length                        |
|str_p must point to a buffer that is LITLEN + 1 long                          |
|(or DTEMPLEN +1 for datatag)                                                  |
|                                                                              |
|ASSUME: curr_token is one of LIT_TK or LITA_TK                                |
|                                                                              |
|The mode is LITP_MODE, so CRO_TK, LIT_TK, LITA_TK, PERO_TK, PERO_GRPO_TK      |
|are recognized.  Since get_plit is only called while parsing the prolog,      |
|PERO_GRPO is an error (see 9.4.4).                                            |
|                                                                              |
+-----------------------------------------------------------------------------*/
uint P_FCT get_plit(GA_P gbla_p, uchar *str_p, boolean for_datatag)
{
   uchar *c_p, *e_p;
   TK delim_token;
   int init_enty_level = GA(enty_level);

   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 + (for_datatag ? DTEMPLEN : 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) &&
            (GA(enty_level)==init_enty_level)) {
            pop_mode(gbla_p);
            *c_p = '\0';
            return(c_p-str_p);
         }
         em_unrd(gbla_p,GA(curr_count));
         break;
      case NOT_FOUND_TK:
         if (GA(curr_char) == Ee) {
            rst_mode(gbla_p);
            if (GA(enty_level) == init_enty_level) {
               errorh(gbla_p,UBLNLIT,ERH_T_SEV+ERH_LOCATE,
               delim_token==LIT_TK ?
               GA(dstab)[LIT_ix].p : GA(dstab)[LITA_ix].p);
            }else {
               em_close(gbla_p); /* read a new character in previous file */
               continue;
            }
         }else if (is_ms_char(GA(curr_char))) {       /* mso, msi, mss */
            if (is_msochar(GA(curr_char))) {
               hid_mode(gbla_p);
            }else if (is_msichar(GA(curr_char))) {
               rst_mode(gbla_p);
            }else {             /* mss_char: treat it directly */
               *c_p = (uchar)GA(curr_char);
               em_read(gbla_p);
               if (++c_p > e_p) errorh(gbla_p,BIGLIT,ERH_T_SEV+ERH_LOCATE);
               if (GA(curr_char) == Ee) continue;
            }
         }
         break;
      case CRO_TK:
         switch (get_chrf(gbla_p)) {
         case INVALID_CHRF:
            continue;
         case NUMERIC_CHRF:
            if ((for_datatag) &&
               ((is_nonsgml(GA(curr_char)))||(is_fctchar(GA(curr_char))))) {
               errorh(gbla_p,INVDTPLIT,ERH_W_SEV+ERH_LOCATE);
               em_read(gbla_p);
               continue;
            }
            /* else fall thru */
         case NAMED_CHRF:
            break;
         }
         /*----------------------------------------+
         |As of now we don't care numeric vs. named|
         |so a numeric could be interpreted as     |
         |markup?                                  |
         |Hmmmm... Better keep numeric unparsed ?  |
         +----------------------------------------*/
         break;
      case PERO_TK:
#ifndef KEEP_PER_UNPARSED
         em_opper(gbla_p);
         continue;
#else
         em_unrd(gbla_p,GA(curr_count));    /* to keep PER unparsed */
         break;
#endif
      default:
      case PERO_GRPO_TK:
         errorh(gbla_p,INVDLM,ERH_T_SEV+ERH_LOCATE);
         break;
      }
      *c_p = (uchar)GA(curr_char);
      em_read(gbla_p);
      if (++c_p > e_p) {
         errorh(gbla_p,for_datatag ? BIGDLIT : BIGLIT,ERH_T_SEV+ERH_LOCATE);
      }
   }
}

/*--------------------------------------------------------------------get_zlit-+
| This procedure is #defined as:                                               |
|      get_lit_min   (== get_zlit(TRUE)), to get a minimum parameter literal,  |
| or   get_lit_cdata (== get_zlit(FALSE)) to get a character data literal,     |
|                                                                              |
| str_p must point to a buffer that is LITLEN + 1 long.                        |
| The length of the literal is returned.                                       |
+-----------------------------------------------------------------------------*/
uint P_FCT get_zlit(GA_P gbla_p, uchar *str_p, boolean is_min)
{
   uchar *c_p;
   uchar *dlm_p;

   switch (GA(curr_token)) {
   case LIT_TK:
      dlm_p = GA(dstab)[LIT_ix].p;
      break;
   case LITA_TK:
      dlm_p = GA(dstab)[LITA_ix].p;
      break;
   default:
      errorh(gbla_p,NOLIT,ERH_T_SEV+ERH_LOCATE);
      dlm_p = (uchar *)0; /* avoid compiler warning (can't return from ERH_T) */
      break;
   }
   c_p = get_dltd_str(
      gbla_p, str_p, str_p+LITLEN,dlm_p, is_min ? MINLIT_GLC : LIT_GLC
   );
   if (c_p > str_p + LITLEN) errorh(gbla_p,BIGLIT,ERH_T_SEV+ERH_LOCATE);
   if ((is_min) && (c_p > str_p + LITLEN_RCS)) {
      errorh(gbla_p,BIGLITRCS,ERH_W_SEV+ERH_LOCATE,c_p - str_p);
   }
   return(c_p - str_p);
}

/*----------------------------------------------------------------------get_PI-+
| Get a PI, skipping to PIC ending separator, and tell the Application.        |
| GA(pi_lit) must point a buffer that is LITLEN + 1 long.                      |
|                                                                              |
| [44] processing instruction = pio, system data, pic                          |
|                                                                              |
| No markup is recognized in a PI, other than the PIC delimiter that           |
| terminates it.                                                               |
+-----------------------------------------------------------------------------*/
void P_FCT get_PI(GA_P gbla_p)
{
   uchar *str_p = GA(pi_lit);
   uchar *c_p;

   c_p = get_dltd_str(gbla_p,str_p, str_p+PILEN, GA(dstab)[PIC_ix].p, PI_GLC);
   if (c_p > str_p + PILEN) errorh(gbla_p,BIGPI,ERH_T_SEV+ERH_LOCATE);
   tll_PI(gbla_p, str_p, c_p - str_p);
}

/*STATIC----------------------------------------------------------get_dltd_str-+
| Get a delimited string in a buffer, returns pointer to end of string.        |
|                                                                              |
| On ENTRY:                                                                    |
| c_p points the target buffer,                                                |
| e_p points the last character in the buffer,                                 |
| dlm_p is the delimiter (ASCIIZ string).                                      |
| code is one of:                                                              |
|     MINLIT_GLC : get a minimum literal                                       |
|     LIT_GLC    : get a character data (SDATA) literal                        |
|     PI_GLC     : get a processing instruction                                |
|                                                                              |
| NOTE: The buffer *MUST* be one byte larger than the largest string to get    |
|       -- ie one can write buffer[LITLEN+1] and e_p=buffer + LITLEN.          |
|       If an unexpected end-of-file is found, then an appropriate             |
|       message is ussued and the string is closed (c_p, ending 0);            |
|                                                                              |
| Returns:                                                                     |
| A pointer in the buffer just after the righmost character gotten.            |
| (this points to an ending '\0').                                             |
| According to our conventions, if (returned_pointer > e_p) ==> too big and    |
| it's up to the caller to take the suitable actions.                          |
|                                                                              |
| No markup is recognized other than the delimiter that terminates it.         |
|                                                                              |
| Markup Scan Characters:                                                      |
| It seems inappropriate to check for Markup Scan Characters for               |
| PI (SDATA), MINLT (minimum literal) or LIT (SDATA).                          |
| This is why the code has been deactivated...  (but not destroyed,            |
| as this is not explicitely said in ISO)                                      |
|                                                                              |
| -- OPTIMIZED --                                                              |
+-----------------------------------------------------------------------------*/
static uchar * LP_FCT get_dltd_str(
   GA_P gbla_p,
   uchar *str_p,
   uchar *e_p,
   uchar * const dlm_p,
   GLC const glc)
{
   register uchar *c_p = str_p;
   boolean a_space_is_waiting = FALSE;
   uchar dlm_1 = *dlm_p;
   uchar *d_p;
   uint c;

   c = GA(curr_char);
   for (;;) {                                  /* main loop */
      if (dlm_1 != (uchar)c) {                 /* until dlm_1 is found */
         if (Ee == c) {                        /* while no Ee */
            switch (glc) {
            case MINLIT_GLC:
            case LIT_GLC:
               errorh(gbla_p,UBLNLIT,ERH_T_SEV+ERH_LOCATE,dlm_p);
            case PI_GLC:
               errorh(gbla_p,UBLNPIC,ERH_T_SEV+ERH_LOCATE);
            }
            *c_p = '\0';                       /* put an ending 0 */
            return(c_p);                       /* leave */
         }                                     /* else pursue */
      }else {
         for (d_p=dlm_p ;;) {                  /* dlm_1 was found */
            c = em_read(gbla_p);               /* get next character ready */
            if (*++d_p) {                      /* not at end */
               if (*d_p == (uchar)c) continue; /* and does match: continue */
               c = em_unrd(gbla_p,d_p - dlm_p);  /* mismatch: unread all */
               break;                              /* and break */
            }else {                            /* end of delimiter */
               *c_p = '\0';                    /* put an ending 0 */
               return(c_p);                    /* leave */
            }
         }
      }
      /*----------------------------+
      |For minimum literal, compress|
      |separators (ISO8879 10.1.7)  |
      +----------------------------*/
      if (glc == MINLIT_GLC) {
         if (!is_minldat(c)) {
            if (!is_sspchar(c)) {
               errorh(gbla_p,INVMLCHAR,ERH_W_SEV+ERH_LOCATE,c);
               c = em_read(gbla_p);            /* ignore non-mindata */
            }else if (c == GA(RS_char)) {
               c = em_read(gbla_p);            /* ignore  RS */
            }else  {                           /* RE, TAB, SPACE, etc..*/
               while (is_sspchar(em_read(gbla_p)));  /* compress spaces */
               if (c_p > str_p) a_space_is_waiting = TRUE; /* not for leading */
               c = GA(curr_char);
            }
            continue;                          /* and trailing */
         }
         if (a_space_is_waiting) {
            a_space_is_waiting = FALSE;
            *c_p = GA(SPACE_char);
            if (++c_p > e_p) return(c_p);
         }
      }
#ifdef MSS_UNACTIVATED /*-----------------<MSS_PROCESSING>------*/
      (see comments in the banner)
      /*----------------------------+
      |Supress delimiter recognition|
      |if MSO or MSS is encountered |
      +----------------------------*/
      if (is_msrchar(c))                   {  /* MSO or MSS */
         if (is_msochar(c)) {
            do {
               *c_p = (uchar)c;
               c = em_read(gbla_p);
               if (++c_p > e_p) return(c_p);
            }while (!is_msichar(c) && (c != Ee));
         }else {
            *c_p = (uchar)c;
            c = em_read(gbla_p);
            if (++c_p > e_p) return(c_p);
         }
         if (c == Ee) continue;
      }
#endif /*--------------------------------</MSS_PROCESSING>------*/

      /*------------------+
      |Store the character|
      +------------------*/
#if (defined(IBMCSET2))          /* IBM C/Set2 bug (01/04/92, V1.0) */
      {  /*--- <Temp-Fix> ---*/
         uchar d;
         d = (uchar)c;
         c = em_read(gbla_p);
         *c_p = d;
      }  /*-- </Temp-Fix> ---*/
#else
      *c_p = (uchar)c;
      c = em_read(gbla_p);
#endif
      if (++c_p > e_p) return(c_p);
   }
}

/*STATIC---------------------------------------------------------pick_namechar-+
|Move all name characters of standard input to "name", make an ASCIIZ string.  |
|Characters in excess are truncated;                                           |
|Returns the count of characters read;                                         |
+-----------------------------------------------------------------------------*/
static uint LP_FCT pick_namechar(GA_P gbla_p, uchar *name, uint namecase)
{
   uchar *c_p = name - 1;
   uint count = 0;

   do {
      if (++count > NAMELEN) {
         if (count == NAMELEN + 1) errorh(gbla_p,BIGNAMET,ERH_W_SEV+ERH_LOCATE);
      }else {
         *++c_p = namecase ? GA(uctab)[GA(curr_char)] : (uchar)GA(curr_char);
      }
   }while is_name(em_read(gbla_p));
   *++c_p = '\0';
   return(count);
}

/*--------------------------------------------------------------------get_name-+
|get a name - if impossible, issue error message and leave.                    |
+-----------------------------------------------------------------------------*/
uint P_FCT get_name(GA_P gbla_p, uchar *name)
{
   if (!is_namestrt(GA(curr_char))) errorh(gbla_p,NONAME,ERH_T_SEV+ERH_LOCATE);
   return(pick_namechar(gbla_p,name,IS_BITON(GA(opt).ot,GENERAL_CASE_OT)));
}

/*----------------------------------------------------------------------get_gi-+
|get a gi - if impossible, issue error message and leave.                      |
+-----------------------------------------------------------------------------*/
uint P_FCT get_gi(GA_P gbla_p, uchar *name)
{
   if (!is_gistrt(GA(curr_char))) errorh(gbla_p,NOGINAME,ERH_T_SEV+ERH_LOCATE);
   return(pick_namechar(gbla_p,name,IS_BITON(GA(opt).ot,GENERAL_CASE_OT)));
}

/*--------------------------------------------------------------------get_enam-+
|get an entity name if impossible, issue error message and leave.              |
|(as get_name, except the case translation)                                    |
+-----------------------------------------------------------------------------*/
uint P_FCT get_enam(GA_P gbla_p, uchar *name)
{
   if (!is_namestrt(GA(curr_char))) errorh(gbla_p,NONAME,ERH_T_SEV+ERH_LOCATE);
   return(pick_namechar(gbla_p,name,IS_BITON(GA(opt).ot,ENTITY_CASE_OT)));
}

/*--------------------------------------------------------------------get_enmd-+
|get a REFC delimited entity name                                              |
+-----------------------------------------------------------------------------*/
void P_FCT get_enmd(GA_P gbla_p, uchar *name)
{
   get_enam(gbla_p, name);
   eat_refc(gbla_p);
}

/*--------------------------------------------------------------------get_nmtk-+
|get a name token                                                              |
+-----------------------------------------------------------------------------*/
uint P_FCT get_nmtk(GA_P gbla_p, uchar *name)
{
   if (!is_name(GA(curr_char))) errorh(gbla_p,NONMTK,ERH_T_SEV+ERH_LOCATE);
   return(pick_namechar(gbla_p,name,IS_BITON(GA(opt).ot,GENERAL_CASE_OT)));
}

/*--------------------------------------------------------------------get_gnam-+
| Get a given name                                                             |
| RETURN: FALSE if no match found,                                             |
|         TRUE, if the input matches.                                          |
|               curr_char is next char on input (as usual)                     |
+-----------------------------------------------------------------------------*/
boolean P_FCT get_gnam(GA_P gbla_p, uchar *str)
{
   uchar *c_p;

   for (c_p=str; *c_p; em_read(gbla_p), ++c_p) {
      if ((GA(curr_char)==Ee)||
         (*c_p != (IS_BITON(GA(opt).ot,GENERAL_CASE_OT) ?
         GA(uctab)[GA(curr_char)] : (uchar)GA(curr_char)))) {
         em_unrd(gbla_p,c_p - str);
         return(FALSE);
      }
   }
   return(TRUE);
}

/*-------------------------------------------------------------------chk_gname-+
| Check if input matches a given name: if not, exit in error (strong check)    |
+-----------------------------------------------------------------------------*/
void P_FCT chk_gnam(
   GA_P gbla_p,
   uchar *str)
{
   if (!get_gnam(gbla_p,str)) errorh(gbla_p,NOKYWD,ERH_T_SEV+ERH_LOCATE,str);
}

/*--------------------------------------------------------------------get_gstr-+
| Get a given string                                                           |
| RETURN: FALSE if no match found,                                             |
|         TRUE, if the input matches.                                          |
|               curr_char is next char on input (as usual)                     |
+-----------------------------------------------------------------------------*/
boolean P_FCT get_gstr(
   GA_P gbla_p,
   uchar *str)
{
   uchar *c_p;

   for (c_p=str; *c_p; em_read(gbla_p), ++c_p) {
      if ((GA(curr_char)==Ee)||(*c_p != (uchar)GA(curr_char))) {
         em_unrd(gbla_p,c_p - str);
         return(FALSE);
      }
   }
   return(TRUE);
}

/*--------------------------------------------------------------------get_chrf-+
|Translate a character reference.                                              |
|                                                                              |
|On entry: it's assumed dl_find has just been called, so current_count has     |
|         the count of CRO.                                                    |
|                                                                              |
|Returns:                                                                      |
|                                                                              |
|When the character cannot be translated (unsuccessful return):                |
|     - return code is INVALID_CHRF,                                           |
|     - character in curr_char is the next character (after the REFC, if any)  |
|                                                                              |
|When the translation has been successful:                                     |
|     - return code is:                                                        |
|         - NAMED_CHRF if a named character reference was translated           |
|         - NUMERIC_CHRF if a numeric character reference was translated       |
|     - curr_char has the translated character, and the read buffer is         |
|       updated "as though the translated character were entered directly"     |
|       (and unread will work properly)                                        |
+-----------------------------------------------------------------------------*/
CHRF P_FCT get_chrf(GA_P gbla_p)
{
   uint  i, j, k, len;
   FNCR *fncr_p;
   MSGCODE msgcode;
   uchar name[NAMELEN_MAX+1];         /* see 9.3.1 */

   len = GA(curr_count);
   if (is_digit(GA(curr_char))) {
      /*--------------------------+
      |Numeric Character Reference|
      +--------------------------*/
      msgcode = ER_NULL;
      i=k=0;
      do {
         i = ((i +(i<<2))<<1) + GA(curr_char) - '0';   /* i*10 +c - '0' */
         if (i >= MAX_CHARSET) msgcode = BIGCHNB;
         if ((++k > NAMELEN)&&(!msgcode)) msgcode = BIGNAMET;
         em_read(gbla_p);
      }while (((j=eat_refc(gbla_p))==0)&&(is_digit(GA(curr_char))));

      if (msgcode) {
         errorh(gbla_p, msgcode, ERH_W_SEV+ERH_LOCATE);
         if (msgcode == BIGCHNB) return(INVALID_CHRF);
      }
      em_rplac(gbla_p,(uchar)i,len+j+k);
      return(NUMERIC_CHRF);
   }else {
      /* due to the design of dlfind, is_namestrt(GA(curr_char))==TRUE */
      /*------------------------+
      |Named Character Reference|
      +------------------------*/
      len += pick_namechar(gbla_p,name,IS_BITON(GA(opt).ot,GENERAL_CASE_OT));
      len += eat_refc(gbla_p);            /* will "eat" the refc if any */
      for (i = GA(fncr_max), fncr_p = GA(fncrtab);  ; --i, ++fncr_p) {
         if (!i) {
            errorh(gbla_p,INVCHRF,ERH_W_SEV+ERH_LOCATE,name);
            return(INVALID_CHRF);
         }
         if (!strcmp(name,fncr_p->s.p)) {
            em_rplac(gbla_p,(uchar)(fncr_p->ch_nb), len);
            return(NAMED_CHRF);
         }
      }
   }
}

/*STATIC--------------------------------------------------------------eat_refc-+
|Check if curr_string on input could end a reference - skip past it if so      |
|Return 0 if no refc found, else the length skipped;                           |
|                                                                              |
| [61] reference end = (refc | RE)?                                            |
+-----------------------------------------------------------------------------*/
static uint LP_FCT eat_refc(
   GA_P gbla_p)
{
   uchar *c_p;
   uchar *c_p0 = GA(dstab)[REFC_ix].p;
   uint i;

   if (GA(curr_char)==*c_p0) {
      for (i=1, c_p = c_p0 + 1; *c_p; ++i, ++c_p) {
         if (*c_p != (uchar)em_read(gbla_p)) {
            em_unrd(gbla_p,i);
            return(0);
         }
      }
   }else if (GA(curr_char)==GA(RE_char)) {
      i=1;
   }else {
      return(0);
   }
   em_read(gbla_p);      /* get next char */
   return(i);
}

/*---------------------------------------------------------------------get_num-+
|Read a (long) integer - At least first char must be a digit                   |
+-----------------------------------------------------------------------------*/
ulong P_FCT get_num(
   GA_P gbla_p)
{
   register ulong i = 0;
   register uint k;

#if (defined(__TURBOC__))      /* Here is a TURBOC V1.5 bug !!! */
#define MAXUL_BY_TEN  429496729L
#else
#define MAXUL_BY_TEN (((ulong)~0)/10)
#endif

   if (is_digit(k = GA(curr_char))) for (;;) {
      if ((i >= MAXUL_BY_TEN) && ((i > MAXUL_BY_TEN) || (k > '5'))) break;
      i = (i*10) + k - '0';
      if (!is_digit(k = em_read(gbla_p))) return(i);
   }
   errorh(gbla_p,INVNUM,ERH_T_SEV+ERH_LOCATE);
   return(i);
}

/*--------------------------------------------------------------------get_chnb-+
|Read a character number                                                       |
+-----------------------------------------------------------------------------*/
boolean P_FCT get_chnb(GA_P gbla_p, uint *i_p)
{
   ulong il = get_num(gbla_p);

   if (il >= MAX_CHARSET) {
      errorh(gbla_p,BIGCHDESC,ERH_I_SEV+ERH_LOCATE);
      return(FALSE);
   }else {
      *i_p = (uint)il;
      return(TRUE);
   }
}
/******************************************************************************/
