/*-
******************************************************************************
******************************************************************************
**
** MODULE
**
** file: bibtex-4.c
**
** DESCRIPTION
**
** A 32-bit implementation of BibTeX v0.99c for MS-DOS, OS/2 2.x,
** Unix and VMS. This C language implementation is based on the
** original WEB source but it has been enhanced to support 8-bit input
** characters and a very large processing capacity.
**
** For documentation describing how to use and build this program,
** see the 00README.TXT file that accompanies this distribution.
**
** MODULE CONTENTS
**
** This is the fourth of 4 source modules for BibTeX. The source has
** been split into 4 parts so that some of the more primitive editors
** can cope. This code mimics the BibTeX WEB source as closely as
** possible and there should be NO system dependent code in any of the
** bibtex-#.c modules.
**
** The functions defined in this module are:
**
** x_change_case
** x_chr_to_int
** x_cite
** x_concatenate
** x_duplicate
** x_empty
** x_equals
** x_format_name
** x_gets
** x_greater_than
** x_int_to_chr
** x_int_to_str
** x_less_than
** x_minus
** x_missing
** x_num_names
** x_plus
** x_preamble
** x_purify
** x_quote
** x_substring
** x_swap
** x_text_length
** x_text_prefix
** x_type
** x_warning
** x_width
** x_write
**
** AUTHORS
**
** Original WEB translation to C, conversion to "big" (32-bit) capacity,
** addition of run-time selectable capacity and 8-bit support extensions
** by:
**
** Niel Kempson
** Snowy Owl Systems Limited, Cheltenham, England
** E-mail: kempson@snowyowl.co.uk
**
** 8-bit support extensions also by:
**
** Alejandro Aguilar-Sierra
** Centro de Ciencias de la Atm\'osfera,
** Universidad Nacional Aut\'onoma de M\'exico, M\'exico
** E-mail: asierra@servidor.unam.mx
**
** COPYRIGHT
**
** This implementation copyright (c) 1991-1995 by Niel Kempson
** and copyright (c) 1995 by Alejandro Aguilar-Sierra.
**
** This program is free software; you can redistribute it and/or
** modify it under the terms of the GNU General Public License as
** published by the Free Software Foundation; either version 1, or
** (at your option) any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
** General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software
** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
**
** In other words, you are welcome to use, share and improve this
** program. You are forbidden to forbid anyone else to use, share
** and improve what you give them. Help stamp out software-hoarding!
**
** ACKNOWLEDGEMENT
**
** The original BibTeX was written by Oren Patashnik using Donald
** Knuth's WEB system. This format produces a PASCAL program for
** execution and a TeX documented version of the source code. This
** program started as a (manual) translation of the WEB source into C.
**
** CHANGE LOG
**
** $Log: bibtex-4.c,v $
** Revision 3.71 1996/08/18 20:47:30 kempson
** Official release 3.71 (see HISTORY file for details).
**
** Revision 3.70 1996/04/08 10:08:40 kempson
** Final documentation & cosmetic changes for official release 3.70.
**
** Revision 3.5 1995/09/24 20:44:37 kempson
** Many changes for final beta test version.
**
** Revision 3.4 1995/04/09 22:15:41 kempson
** Placed under RCS control
**
******************************************************************************
******************************************************************************
*/
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
#include "sysdep.h"
#include "bibtex.h"
#include "datatype.h"
#include "gblprocs.h"
#include "gblvars.h"
#include "utils.h"
#include "version.h"
/***************************************************************************
* WEB section number: 364
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function change.case$ pops the top two (string)
* literals; it changes the case of the second according to the
* specifications of the first, as follows. (Note: The word `letters' in
* the next sentence refers only to those at brace-level~0, the top-most
* brace level; no other characters are changed, except perhaps for
* special characters, described shortly.) If the first literal is the
* string t, it converts to lower case all letters except the very
* first character in the string, which it leaves alone, and except the
* first character following any |colon| and then nonnull |white_space|,
* which it also leaves alone; if it's the string l, it converts all
* letters to lower case; if it's the string u, it converts all
* letters to upper case; and if it's anything else, it complains and
* does no conversion. It then pushes this resulting string. If either
* type is incorrect, it complains and pushes the null string; however,
* if both types are correct but the specification string (i.e., the
* first string) isn't one of the legal ones, it merely pushes the second
* back onto the stack, after complaining. (Another note: It ignores
* case differences in the specification string; for example, the strings
* t and T are equivalent for the purposes of this |built_in|
* function.)
***************************************************************************/
void x_change_case (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else if (pop_typ2 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else
BEGIN
/***************************************************************************
* WEB section number: 366
* ~~~~~~~~~~~~~~~~~~~
* First we define a few variables for case conversion. The constant
* definitions, to be used in |case| statements, are in order of probable
* frequency.
***************************************************************************/
BEGIN
switch (str_pool[str_start[pop_lit1]])
BEGIN
case 't':
case 'T':
conversion_type = TITLE_LOWERS;
break;
case 'l':
case 'L':
conversion_type = ALL_LOWERS;
break;
case 'u':
case 'U':
conversion_type = ALL_UPPERS;
break;
default:
conversion_type = BAD_CONVERSION;
break;
END
if ((LENGTH (pop_lit1) != 1) || (conversion_type == BAD_CONVERSION))
BEGIN
conversion_type = BAD_CONVERSION;
PRINT_POOL_STR (pop_lit1);
BST_EX_WARN (" is an illegal case-conversion string");
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 366 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
ex_buf_length = 0;
add_buf_pool (pop_lit2);
/***************************************************************************
* WEB section number: 370
* ~~~~~~~~~~~~~~~~~~~
* Here's where we actually go through the string and do the case
* conversion.
***************************************************************************/
BEGIN
brace_level = 0;
ex_buf_ptr = 0;
while (ex_buf_ptr < ex_buf_length)
BEGIN
if (ex_buf[ex_buf_ptr] == LEFT_BRACE)
BEGIN
INCR (brace_level);
if (brace_level != 1)
BEGIN
goto OK_Pascal_I_Give_Up_Label;
END
if ((ex_buf_ptr + 4) > ex_buf_length)
BEGIN
goto OK_Pascal_I_Give_Up_Label;
END
else if (ex_buf[ex_buf_ptr + 1] != BACKSLASH)
BEGIN
goto OK_Pascal_I_Give_Up_Label;
END
if (conversion_type == TITLE_LOWERS)
BEGIN
if (ex_buf_ptr == 0)
BEGIN
goto OK_Pascal_I_Give_Up_Label;
END
else if ((prev_colon)
&& (lex_class[ex_buf[ex_buf_ptr - 1]] == WHITE_SPACE))
BEGIN
goto OK_Pascal_I_Give_Up_Label;
END
END
/***************************************************************************
* WEB section number: 371
* ~~~~~~~~~~~~~~~~~~~
* We're dealing with a special character (usually either an undotted
* `\i' or `\j', or an accent like one in Table~3.1 of the \LaTeX\
* manual, or a foreign character like one in Table~3.2) if the first
* character after the |left_brace| is a |backslash|; the special
* character ends with the matching |right_brace|. How we handle what's
* in between depends on the special character. In general, this code
* will do reasonably well if there is other stuff, too, between braces,
* but it doesn't try to do anything special with |colon|s.
***************************************************************************/
BEGIN
INCR (ex_buf_ptr);
while ((ex_buf_ptr < ex_buf_length) && (brace_level > 0))
BEGIN
INCR (ex_buf_ptr);
ex_buf_xptr = ex_buf_ptr;
while ((ex_buf_ptr < ex_buf_length)
&& (lex_class[ex_buf[ex_buf_ptr]] == ALPHA))
BEGIN
INCR (ex_buf_ptr);
END
control_seq_loc = str_lookup (ex_buf, ex_buf_xptr,
ex_buf_ptr - ex_buf_xptr,
CONTROL_SEQ_ILK, DONT_INSERT);
if (hash_found)
/***************************************************************************
* WEB section number: 372
* ~~~~~~~~~~~~~~~~~~~
* A control sequence, for the purposes of this program, consists just of
* the consecutive alphabetic characters following the |backslash|; it
* might be empty (although ones in this section aren't).
***************************************************************************/
BEGIN
switch (conversion_type)
BEGIN
case TITLE_LOWERS:
case ALL_LOWERS:
switch (ilk_info[control_seq_loc])
BEGIN
case N_L_UPPER:
case N_O_UPPER:
case N_OE_UPPER:
case N_AE_UPPER:
case N_AA_UPPER:
Lower_case (ex_buf, ex_buf_xptr,
ex_buf_ptr - ex_buf_xptr);
break;
default:
DO_NOTHING;
break;
END
break;
case ALL_UPPERS:
switch (ilk_info[control_seq_loc])
BEGIN
case N_L:
case N_O:
case N_OE:
case N_AE:
case N_AA:
upper_case (ex_buf, ex_buf_xptr,
ex_buf_ptr - ex_buf_xptr);
break;
case N_I:
case N_J:
case N_SS:
/***************************************************************************
* WEB section number: 374
* ~~~~~~~~~~~~~~~~~~~
* After converting the control sequence, we need to remove the preceding
* |backslash| and any following |white_space|.
***************************************************************************/
BEGIN
upper_case (ex_buf, ex_buf_xptr,
ex_buf_ptr - ex_buf_xptr);
while (ex_buf_xptr < ex_buf_ptr)
BEGIN
ex_buf[ex_buf_xptr - 1] = ex_buf[ex_buf_xptr];
INCR (ex_buf_xptr);
END
DECR (ex_buf_xptr);
while ((ex_buf_ptr < ex_buf_length)
&& (lex_class[ex_buf[ex_buf_ptr]] == WHITE_SPACE))
BEGIN
INCR (ex_buf_ptr);
END
tmp_ptr = ex_buf_ptr;
while (tmp_ptr < ex_buf_length)
BEGIN
ex_buf[tmp_ptr - (ex_buf_ptr - ex_buf_xptr)]
= ex_buf[tmp_ptr];
INCR (tmp_ptr);
END
ex_buf_length = tmp_ptr - (ex_buf_ptr - ex_buf_xptr);
ex_buf_ptr = ex_buf_xptr;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 374 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
default:
DO_NOTHING;
break;
END
break;
case BAD_CONVERSION:
DO_NOTHING;
break;
default:
case_conversion_confusion ();
break;
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 372 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
ex_buf_xptr = ex_buf_ptr;
while ((ex_buf_ptr < ex_buf_length) && (brace_level > 0)
&& (ex_buf[ex_buf_ptr] != BACKSLASH))
BEGIN
if (ex_buf[ex_buf_ptr] == RIGHT_BRACE)
BEGIN
DECR (brace_level);
END
else if (ex_buf[ex_buf_ptr] == LEFT_BRACE)
BEGIN
INCR (brace_level);
END
INCR (ex_buf_ptr);
END
/***************************************************************************
* WEB section number: 375
* ~~~~~~~~~~~~~~~~~~~
* There are no control sequences in what we're about to convert,
* so a straight conversion suffices.
***************************************************************************/
switch (conversion_type)
BEGIN
case TITLE_LOWERS:
case ALL_LOWERS:
Lower_case (ex_buf, ex_buf_xptr, ex_buf_ptr - ex_buf_xptr);
break;
case ALL_UPPERS:
upper_case (ex_buf, ex_buf_xptr, ex_buf_ptr - ex_buf_xptr);
break;
case BAD_CONVERSION:
DO_NOTHING;
break;
default:
case_conversion_confusion ();
break;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 375 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
END
DECR (ex_buf_ptr);
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 371 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
OK_Pascal_I_Give_Up_Label: prev_colon = FALSE;
END
else if (ex_buf[ex_buf_ptr] == RIGHT_BRACE)
BEGIN
decr_brace_level (pop_lit2);
prev_colon = FALSE;
END
else if (brace_level == 0)
/***************************************************************************
* WEB section number: 376
* ~~~~~~~~~~~~~~~~~~~
* This code does any needed conversion for an ordinary character; it
* won't touch nonletters.
***************************************************************************/
BEGIN
switch (conversion_type)
BEGIN
case TITLE_LOWERS:
if (ex_buf_ptr == 0)
BEGIN
#ifdef UTF_8
/*
For the case of TITLE_LOWERS, we transform the characters to low case except the first
character. When it's UTF-8, we should care about the length of charater. 23/sep/2009
*/
DO_UTF8(ex_buf[ex_buf_ptr], , ex_buf_ptr = 1, ex_buf_ptr = 2, ex_buf_ptr = 3);
#else
DO_NOTHING;
#endif
END
else if ((prev_colon)
&& (lex_class[ex_buf[ex_buf_ptr - 1]] == WHITE_SPACE))
BEGIN
DO_NOTHING;
END
else
BEGIN
#ifdef UTF_8
/*
When we do lower_case_uni, the length of string have been changed. So we should do some job
for the precessing after lower case. Here there may be some potential bug. 23/sep/2009
*/
int16_t llen;
llen=utf8len(ex_buf[ex_buf_ptr]);
ex_buf_ptr=ex_buf_ptr+lower_case_uni (ex_buf, ex_buf_ptr, llen)-1;
#else
lower_case (ex_buf, ex_buf_ptr, 1);
#endif
END
if (ex_buf[ex_buf_ptr] == COLON)
BEGIN
prev_colon = TRUE;
END
else if (lex_class[ex_buf[ex_buf_ptr]] != WHITE_SPACE)
BEGIN
prev_colon = FALSE;
END
break;
case ALL_LOWERS:
#ifdef UTF_8
/*
Here the same for processing the length of string after change case. 23/sep/2009
*/
BEGIN
int16_t llen;
llen=utf8len(ex_buf[ex_buf_ptr]);
ex_buf_ptr=ex_buf_ptr+lower_case_uni (ex_buf, ex_buf_ptr, llen)-1;
END
#else
lower_case (ex_buf, ex_buf_ptr, 1);
#endif
break;
case ALL_UPPERS:
#ifdef UTF_8
/*
Here the same for processing the length of string after change case. 23/sep/2009
*/
BEGIN
int16_t ulen;
ulen=utf8len(ex_buf[ex_buf_ptr]);
ex_buf_ptr=ex_buf_ptr+upper_case_uni (ex_buf, ex_buf_ptr, ulen)-1;
END
#else
upper_case (ex_buf, ex_buf_ptr, 1);
#endif
break;
case BAD_CONVERSION:
DO_NOTHING;
break;
default:
case_conversion_confusion ();
break;
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 376 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
INCR (ex_buf_ptr);
END
check_brace_level (pop_lit2);
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 370 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
add_pool_buf_and_push ();
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 364 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 377
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function chr.to.int$ pops the top (string)
* literal, makes sure it's a single character, converts it to the
* corresponding |ASCII_code| integer, and pushes this integer. If the
* literal isn't an appropriate string, it complains and pushes the
* integer~0.
***************************************************************************/
void x_chr_to_int (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
push_lit_stk (0, STK_INT);
END
#ifdef UTF_8
else if (LENGTH (pop_lit1) != utf8len(str_pool[str_start[pop_lit1]]))
#else
else if (LENGTH (pop_lit1) != 1)
#endif
BEGIN
PRINT ("\"");
PRINT_POOL_STR (pop_lit1);
BST_EX_WARN ("\" isn't a single character");
push_lit_stk (0, STK_INT);
END
else
BEGIN
#ifdef UTF_8
UChar32 ch;
U8_GET_OR_FFFD(&str_pool[str_start[pop_lit1]], 0, 0, -1, ch);
push_lit_stk (ch, STK_INT);
#else
push_lit_stk (str_pool[str_start[pop_lit1]], STK_INT);
#endif
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 377 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 378
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function cite pushes the appropriate string
* from |cite_list| onto the stack.
***************************************************************************/
void x_cite (void)
BEGIN
if ( ! mess_with_entries)
BEGIN
bst_cant_mess_with_entries_prin ();
END
else
BEGIN
push_lit_stk (CUR_CITE_STR, STK_STR);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 378 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 350
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function * pops the top two (string) literals,
* concatenates them (in reverse order, that is, the order in which
* pushed), and pushes the resulting string back onto the stack. If
* either isn't a string literal, it complains and pushes the null
* string.
***************************************************************************/
void x_concatenate (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else if (pop_typ2 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else
/***************************************************************************
* WEB section number: 351
* ~~~~~~~~~~~~~~~~~~~
* Often both strings will be at the top of the string pool, in which
* case we just move some pointers. Furthermore, it's worth doing some
* special stuff in case either string is null, since empirically this
* seems to happen about $20\%$ of the time. In any case, we don't need
* the execution buffer---we simple move the strings around in the string
* pool when necessary.
***************************************************************************/
BEGIN
if (pop_lit2 >= cmd_str_ptr)
BEGIN
if (pop_lit1 >= cmd_str_ptr)
BEGIN
str_start[pop_lit1] = str_start[pop_lit1 + 1];
UNFLUSH_STRING;
INCR (lit_stk_ptr);
END
else if (LENGTH (pop_lit2) == 0)
BEGIN
push_lit_stk (pop_lit1, STK_STR);
END
else
BEGIN
pool_ptr = str_start[pop_lit2 + 1];
STR_ROOM (LENGTH (pop_lit1));
sp_ptr = str_start[pop_lit1];
sp_end = str_start[pop_lit1 + 1];
while (sp_ptr < sp_end)
BEGIN
APPEND_CHAR (str_pool[sp_ptr]);
INCR (sp_ptr);
END
push_lit_stk (make_string (), STK_STR);
END
END
else
/***************************************************************************
* WEB section number: 352
* ~~~~~~~~~~~~~~~~~~~
* We simply continue the previous module.
***************************************************************************/
BEGIN
if (pop_lit1 >= cmd_str_ptr)
BEGIN
if (LENGTH (pop_lit2) == 0)
BEGIN
UNFLUSH_STRING;
lit_stack[lit_stk_ptr] = pop_lit1;
INCR (lit_stk_ptr);
END
else if (LENGTH (pop_lit1) == 0)
BEGIN
INCR (lit_stk_ptr);
END
else
BEGIN
sp_length = LENGTH (pop_lit1);
sp2_length = LENGTH (pop_lit2);
STR_ROOM (sp_length + sp2_length);
sp_ptr = str_start[pop_lit1 + 1];
sp_end = str_start[pop_lit1];
sp_xptr1 = sp_ptr + sp2_length;
while (sp_ptr > sp_end)
BEGIN
DECR (sp_ptr);
DECR (sp_xptr1);
str_pool[sp_xptr1] = str_pool[sp_ptr];
END
sp_ptr = str_start[pop_lit2];
sp_end = str_start[pop_lit2 + 1];
while (sp_ptr < sp_end)
BEGIN
APPEND_CHAR (str_pool[sp_ptr]);
INCR (sp_ptr);
END
pool_ptr = pool_ptr + sp_length;
push_lit_stk (make_string (), STK_STR);
END
END
else
/***************************************************************************
* WEB section number: 353
* ~~~~~~~~~~~~~~~~~~~
* Again, we simply continue the previous module.
***************************************************************************/
BEGIN
if (LENGTH (pop_lit1) == 0)
BEGIN
INCR (lit_stk_ptr);
END
else if (LENGTH (pop_lit2) == 0)
BEGIN
push_lit_stk (pop_lit1, STK_STR);
END
else
BEGIN
STR_ROOM (LENGTH (pop_lit1) + LENGTH (pop_lit2));
sp_ptr = str_start[pop_lit2];
sp_end = str_start[pop_lit2 + 1];
while (sp_ptr < sp_end)
BEGIN
APPEND_CHAR (str_pool[sp_ptr]);
INCR (sp_ptr);
END
sp_ptr = str_start[pop_lit1];
sp_end = str_start[pop_lit1 + 1];
while (sp_ptr < sp_end)
BEGIN
APPEND_CHAR (str_pool[sp_ptr]);
INCR (sp_ptr);
END
push_lit_stk (make_string (), STK_STR);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 353 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 352 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 351 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 350 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 379
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function duplicate$ pops the top literal from
* the stack and pushes two copies of it.
***************************************************************************/
void x_duplicate (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_STR)
BEGIN
push_lit_stk (pop_lit1, pop_typ1);
push_lit_stk (pop_lit1, pop_typ1);
END
else
BEGIN
REPUSH_STRING;
if (pop_lit1 < cmd_str_ptr)
BEGIN
push_lit_stk (pop_lit1, pop_typ1);
END
else
BEGIN
STR_ROOM (LENGTH (pop_lit1));
sp_ptr = str_start[pop_lit1];
sp_end = str_start[pop_lit1 + 1];
while (sp_ptr < sp_end)
BEGIN
APPEND_CHAR (str_pool[sp_ptr]);
INCR (sp_ptr);
END
push_lit_stk (make_string (), STK_STR);
END
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 379 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 380
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function empty$ pops the top literal and pushes
* the integer 1 if it's a missing field or a string having no
* non|white_space| characters, 0 otherwise. If the literal isn't a
* missing field or a string, it complains and pushes 0.
***************************************************************************/
void x_empty (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
switch (pop_typ1)
BEGIN
case STK_STR:
/***************************************************************************
* WEB section number: 381
* ~~~~~~~~~~~~~~~~~~~
* When we arrive here we're dealing with a legitimate string. If it has
* no characters, or has nothing but |white_space| characters, we push~1,
* otherwise we push~0.
***************************************************************************/
BEGIN
sp_ptr = str_start[pop_lit1];
sp_end = str_start[pop_lit1 + 1];
while (sp_ptr < sp_end)
BEGIN
if (lex_class[str_pool[sp_ptr]] != WHITE_SPACE)
BEGIN
push_lit_stk (0, STK_INT);
goto Exit_Label;
END
INCR (sp_ptr);
END
push_lit_stk (1, STK_INT);
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 381 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
case STK_FIELD_MISSING:
push_lit_stk (1, STK_INT);
break;
case STK_EMPTY:
push_lit_stk (0, STK_INT);
break;
default:
print_stk_lit (pop_lit1, pop_typ1);
BST_EX_WARN (", not a string or missing field,");
push_lit_stk (0, STK_INT);
break;
END
Exit_Label: DO_NOTHING;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 380 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 345
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function = pops the top two (integer or string)
* literals, compares them, and pushes the integer 1 if they're equal, 0
* otherwise. If they're not either both string or both integer, it
* complains and pushes the integer 0.
***************************************************************************/
void x_equals (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != pop_typ2)
BEGIN
if ((pop_typ1 != STK_EMPTY) && (pop_typ2 != STK_EMPTY))
BEGIN
print_stk_lit (pop_lit1, pop_typ1);
PRINT (", ");
print_stk_lit (pop_lit2, pop_typ2);
PRINT_NEWLINE;
BST_EX_WARN ("---they aren't the same literal types");
END
push_lit_stk (0, STK_INT);
END
else if ((pop_typ1 != STK_INT) && (pop_typ1 != STK_STR))
BEGIN
if (pop_typ1 != STK_EMPTY)
BEGIN
print_stk_lit (pop_lit1, pop_typ1);
BST_EX_WARN (", not an integer or a string,");
END
push_lit_stk (0, STK_INT);
END
else if (pop_typ1 == STK_INT)
BEGIN
if (pop_lit2 == pop_lit1)
BEGIN
push_lit_stk (1, STK_INT);
END
else
BEGIN
push_lit_stk (0, STK_INT);
END
END
else if (str_eq_str (pop_lit2, pop_lit1))
BEGIN
push_lit_stk (1, STK_INT);
END
else
BEGIN
push_lit_stk (0, STK_INT);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 345 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 382
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function format.name$ pops the top three
* literals (they are a string, an integer, and a string literal, in that
* order). The last string literal represents a name list (each name
* corresponding to a person), the integer literal specifies which name
* to pick from this list, and the first string literal specifies how to
* format this name, as described in the \BibTeX\ documentation.
* Finally, this function pushes the formatted name. If any of the types
* is incorrect, it complains and pushes the null string.
***************************************************************************/
void x_format_name (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
pop_lit_stk (&pop_lit3, &pop_typ3);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
push_lit_stk (s_null, STK_STR);
END
else if (pop_typ3 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit3, pop_typ3, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else
BEGIN
ex_buf_length = 0;
add_buf_pool (pop_lit3);
/***************************************************************************
* WEB section number: 383
* ~~~~~~~~~~~~~~~~~~~
* This module skips over undesired names in |pop_lit3| and it throws
* away the ``and'' from the end of the name if it exists. When it's
* done, |ex_buf_xptr| points to its first character and |ex_buf_ptr|
* points just past its last.
***************************************************************************/
BEGIN
ex_buf_ptr = 0;
num_names = 0;
while ((num_names < pop_lit2) && (ex_buf_ptr < ex_buf_length))
BEGIN
INCR (num_names);
ex_buf_xptr = ex_buf_ptr;
name_scan_for_and (pop_lit3);
END
if (ex_buf_ptr < ex_buf_length)
BEGIN
#ifdef UTF_8
if (ex_buf[ex_buf_ptr-3]==0xE3 || ex_buf[ex_buf_ptr-3]==0xEF)
/* expect U+3001 "、" or U+FF0C "，" :: Ideographic/Fulwidth Comma */
ex_buf_ptr = ex_buf_ptr - 3;
else
/* expect "and " or "AND " */
#endif
ex_buf_ptr = ex_buf_ptr - 4;
END
if (num_names < pop_lit2)
BEGIN
if (pop_lit2 == 1)
BEGIN
PRINT ("There is no name in \"");
END
else
BEGIN
PRINT2 ("There aren't %ld names in \"", (long) pop_lit2);
END
PRINT_POOL_STR (pop_lit3);
BST_EX_WARN ("\"");
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 383 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 387
* ~~~~~~~~~~~~~~~~~~~
* When we arrive here, the desired name is in |ex_buf[ex_buf_xptr]|
* through |ex_buf[ex_buf_ptr-1]|. This module does its thing for
* characters only at |brace_level = 0|; the rest get processed verbatim.
* It removes leading |white_space| (and |sep_char|s), and trailing
* |white_space| (and |sep_char|s) and |comma|s, complaining for each
* trailing |comma|. It then copies the name into |name_buf|, removing
* all |white_space|, |sep_char|s and |comma|s, counting |comma|s, and
* constructing a list of name tokens, which are sequences of characters
* separated (at |brace_level=0|) by |white_space|, |sep_char|s or
* |comma|s. Each name token but the first has an associated
* |name_sep_char|, the character that separates it from the preceding
* token. If there are too many (more than two) |comma|s, a complaint is
* in order.
***************************************************************************/
BEGIN
/***************************************************************************
* WEB section number: 388
* ~~~~~~~~~~~~~~~~~~~
* This module removes all leading |white_space| (and |sep_char|s), and
* trailing |white_space| (and |sep_char|s) and |comma|s. It complains
* for each trailing |comma|.
***************************************************************************/
BEGIN
while ((ex_buf_xptr < ex_buf_ptr)
&& (lex_class[ex_buf[ex_buf_ptr]] == WHITE_SPACE)
&& (lex_class[ex_buf[ex_buf_ptr]] == SEP_CHAR))
BEGIN
INCR (ex_buf_xptr);
END
while (ex_buf_ptr > ex_buf_xptr)
BEGIN
switch (lex_class[ex_buf[ex_buf_ptr - 1]])
BEGIN
case WHITE_SPACE:
case SEP_CHAR:
DECR (ex_buf_ptr);
break;
default:
if (ex_buf[ex_buf_ptr - 1] == COMMA)
BEGIN
PRINT2 ("Name %ld in \"", (long) pop_lit2);
PRINT_POOL_STR (pop_lit3);
PRINT ("\" has a comma at the end");
bst_ex_warn_print ();
DECR (ex_buf_ptr);
END
else
BEGIN
goto Loop1_Exit_Label;
END
break;
END
END
Loop1_Exit_Label: DO_NOTHING;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 388 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
name_bf_ptr = 0;
num_commas = 0;
num_tokens = 0;
token_starting = TRUE;
while (ex_buf_xptr < ex_buf_ptr)
BEGIN
switch (ex_buf[ex_buf_xptr])
BEGIN
case COMMA:
/***************************************************************************
* WEB section number: 389
* ~~~~~~~~~~~~~~~~~~~
* Here we mark the token number at which this comma has occurred.
***************************************************************************/
BEGIN
if (num_commas == 2)
BEGIN
PRINT2 ("Too many commas in name %ld of \"", (long) pop_lit2);
PRINT_POOL_STR (pop_lit3);
PRINT ("\"");
bst_ex_warn_print ();
END
else
BEGIN
INCR (num_commas);
if (num_commas == 1)
BEGIN
comma1 = num_tokens;
END
else
BEGIN
comma2 = num_tokens;
END
name_sep_char[num_tokens] = COMMA;
END
INCR (ex_buf_xptr);
token_starting = TRUE;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 389 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
case LEFT_BRACE:
/***************************************************************************
* WEB section number: 390
* ~~~~~~~~~~~~~~~~~~~
* We copy the stuff up through the matching |right_brace| verbatim.
***************************************************************************/
BEGIN
INCR (brace_level);
if (token_starting)
BEGIN
name_tok[num_tokens] = name_bf_ptr;
INCR (num_tokens);
END
NAME_BUF[name_bf_ptr] = ex_buf[ex_buf_xptr];
INCR (name_bf_ptr);
INCR (ex_buf_xptr);
while ((brace_level > 0) && (ex_buf_xptr < ex_buf_ptr))
BEGIN
if (ex_buf[ex_buf_xptr] == RIGHT_BRACE)
BEGIN
DECR (brace_level);
END
else if (ex_buf[ex_buf_xptr] == LEFT_BRACE)
BEGIN
INCR (brace_level);
END
NAME_BUF[name_bf_ptr] = ex_buf[ex_buf_xptr];
INCR (name_bf_ptr);
INCR (ex_buf_xptr);
END
token_starting = FALSE;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 390 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
case RIGHT_BRACE:
/***************************************************************************
* WEB section number: 391
* ~~~~~~~~~~~~~~~~~~~
* We don't copy an extra |right_brace|; this code will almost never be
* executed.
***************************************************************************/
BEGIN
if (token_starting)
BEGIN
name_tok[num_tokens] = name_bf_ptr;
INCR (num_tokens);
END
PRINT2 ("Name %ld of \"", (long) pop_lit2);
PRINT_POOL_STR (pop_lit3);
BST_EX_WARN ("\" isn't brace balanced");
INCR (ex_buf_xptr);
token_starting = FALSE;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 391 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
default:
switch (lex_class[ex_buf[ex_buf_xptr]])
BEGIN
case WHITE_SPACE:
/***************************************************************************
* WEB section number: 392
* ~~~~~~~~~~~~~~~~~~~
* A token will be starting soon in a buffer near you, one way$\ldots$
***************************************************************************/
BEGIN
if ( ! token_starting)
BEGIN
name_sep_char[num_tokens] = SPACE;
END
INCR (ex_buf_xptr);
token_starting = TRUE;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 392 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
case SEP_CHAR:
/***************************************************************************
* WEB section number: 393
* ~~~~~~~~~~~~~~~~~~~
* or another. If one of the valid |sep_char|s appears between tokens,
* we usually use it instead of a |space|. If the user has been silly
* enough to have multiple |sep_char|s, or to have both |white_space| and
* a |sep_char|, we use the first such character.
***************************************************************************/
BEGIN
if ( ! token_starting)
BEGIN
name_sep_char[num_tokens] = ex_buf[ex_buf_xptr];
END
INCR (ex_buf_xptr);
token_starting = TRUE;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 393 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
default:
/***************************************************************************
* WEB section number: 394
* ~~~~~~~~~~~~~~~~~~~
* For ordinary characters, we just copy the character.
***************************************************************************/
BEGIN
if (token_starting)
BEGIN
name_tok[num_tokens] = name_bf_ptr;
INCR (num_tokens);
END
NAME_BUF[name_bf_ptr] = ex_buf[ex_buf_xptr];
INCR (name_bf_ptr);
INCR (ex_buf_xptr);
token_starting = FALSE;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 394 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
END
break;
END
END
name_tok[num_tokens] = name_bf_ptr;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 387 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 395
* ~~~~~~~~~~~~~~~~~~~
* Here we set all the pointers for the various parts of the name,
* depending on which of the three possible syntaxes this name uses.
***************************************************************************/
BEGIN
if (num_commas == 0)
BEGIN
first_start = 0;
last_end = num_tokens;
jr_end = last_end;
/***************************************************************************
* WEB section number: 396
* ~~~~~~~~~~~~~~~~~~~
* When there are no brace-level-0 |comma|s in the name, the von name
* starts with the first nonlast token whose first brace-level-0 letter
* is in lower case (for the purposes of this determination, an accented
* or foreign character at brace-level-1 that's in lower case will do, as
* well). A module following this one determines where the von name ends
* and the last starts.
***************************************************************************/
BEGIN
von_start = 0;
while (von_start < (last_end - 1))
BEGIN
name_bf_ptr = name_tok[von_start];
name_bf_xptr = name_tok[von_start + 1];
if (von_token_found ())
BEGIN
von_name_ends_and_last_name_sta ();
goto Von_Found_Label;
END
INCR (von_start);
END
while (von_start > 0)
BEGIN
if ((lex_class[name_sep_char[von_start]] != SEP_CHAR)
|| (name_sep_char[von_start] == TIE))
BEGIN
goto Loop2_Exit_Label;
END
DECR (von_start);
END
Loop2_Exit_Label: von_end = von_start;
Von_Found_Label: first_end = von_start;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 396 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
END
else if (num_commas == 1)
BEGIN
von_start = 0;
last_end = comma1;
jr_end = last_end;
first_start = jr_end;
first_end = num_tokens;
von_name_ends_and_last_name_sta ();
END
else if (num_commas == 2)
BEGIN
von_start = 0;
last_end = comma1;
jr_end = comma2;
first_start = jr_end;
first_end = num_tokens;
von_name_ends_and_last_name_sta ();
END
else
BEGIN
CONFUSION ("Illegal number of comma,s");
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 395 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
ex_buf_length = 0;
add_buf_pool (pop_lit1);
figure_out_the_formatted_name ();
add_pool_buf_and_push ();
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 382 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 354
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function := pops the top two literals and assigns
* to the first (which must be an |int_entry_var|, a |str_entry_var|, an
* |int_global_var|, or a |str_global_var|) the value of the second;
* it complains if the value isn't of the appropriate type.
***************************************************************************/
void x_gets (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_FN)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_FN);
END
else if (( ! mess_with_entries)
&& ((fn_type[pop_lit1] == STR_ENTRY_VAR)
|| (fn_type[pop_lit1] == INT_ENTRY_VAR)))
BEGIN
bst_cant_mess_with_entries_prin ();
END
else
BEGIN
switch (fn_type[pop_lit1])
BEGIN
case INT_ENTRY_VAR:
/***************************************************************************
* WEB section number: 355
* ~~~~~~~~~~~~~~~~~~~
* This module checks that what we're about to assign is really an
* integer, and then assigns.
***************************************************************************/
if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
END
else
BEGIN
entry_ints[(cite_ptr * num_ent_ints) + FN_INFO[pop_lit1]] = pop_lit2;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 355 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
case STR_ENTRY_VAR:
/***************************************************************************
* WEB section number: 357
* ~~~~~~~~~~~~~~~~~~~
* This module checks that what we're about to assign is really a
* string, and then assigns.
***************************************************************************/
BEGIN
if (pop_typ2 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_STR);
END
else
BEGIN
str_ent_ptr = (cite_ptr * num_ent_strs) + FN_INFO[pop_lit1];
ent_chr_ptr = 0;
sp_ptr = str_start[pop_lit2];
sp_xptr1 = str_start[pop_lit2 + 1];
if ((sp_xptr1 - sp_ptr) > Ent_Str_Size)
BEGIN
BST_STRING_SIZE_EXCEEDED (Ent_Str_Size, ", the entry");
sp_xptr1 = sp_ptr + Ent_Str_Size;
END
while (sp_ptr < sp_xptr1)
BEGIN
ENTRY_STRS(str_ent_ptr, ent_chr_ptr) = str_pool[sp_ptr];
INCR (ent_chr_ptr);
INCR (sp_ptr);
END
ENTRY_STRS(str_ent_ptr, ent_chr_ptr) = END_OF_STRING;
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 357 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
case INT_GLOBAL_VAR:
/***************************************************************************
* WEB section number: 358
* ~~~~~~~~~~~~~~~~~~~
* This module checks that what we're about to assign is really an
* integer, and then assigns.
***************************************************************************/
if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
END
else
BEGIN
FN_INFO[pop_lit1] = pop_lit2;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 358 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
case STR_GLOBAL_VAR:
/***************************************************************************
* WEB section number: 359
* ~~~~~~~~~~~~~~~~~~~
* This module checks that what we're about to assign is really a
* string, and then assigns.
***************************************************************************/
BEGIN
if (pop_typ2 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_STR);
END
else
BEGIN
str_glb_ptr = FN_INFO[pop_lit1];
if (pop_lit2 < cmd_str_ptr)
BEGIN
glb_str_ptr[str_glb_ptr] = pop_lit2;
END
else
BEGIN
glb_str_ptr[str_glb_ptr] = 0;
glob_chr_ptr = 0;
sp_ptr = str_start[pop_lit2];
sp_end = str_start[pop_lit2 + 1];
if ((sp_end - sp_ptr) > Glob_Str_Size)
BEGIN
BST_STRING_SIZE_EXCEEDED (Glob_Str_Size, ", the global");
sp_end = sp_ptr + Glob_Str_Size;
END
while (sp_ptr < sp_end)
BEGIN
GLOBAL_STRS(str_glb_ptr, glob_chr_ptr) = str_pool[sp_ptr];
INCR (glob_chr_ptr);
INCR (sp_ptr);
END
glb_str_end[str_glb_ptr] = glob_chr_ptr;
END
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 359 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
break;
default:
PRINT ("You can't assign to type ");
print_fn_class (pop_lit1);
BST_EX_WARN (", a nonvariable function class");
break;
END
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 354 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 346
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function > pops the top two (integer) literals,
* compares them, and pushes the integer 1 if the second is greater than
* the first, 0 otherwise. If either isn't an integer literal, it
* complains and pushes the integer 0.
***************************************************************************/
void x_greater_than (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (0, STK_INT);
END
else if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
push_lit_stk (0, STK_INT);
END
else if (pop_lit2 > pop_lit1)
BEGIN
push_lit_stk (1, STK_INT);
END
else
BEGIN
push_lit_stk (0, STK_INT);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 346 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 422
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function int.to.chr$ pops the top (integer)
* literal, interpreted as the |ASCII_code| of a single character,
* converts it to the corresponding single-character string, and pushes
* this string. If the literal isn't an appropriate integer, it
* complains and pushes the null string.
***************************************************************************/
void x_int_to_chr (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (s_null, STK_STR);
END
#if UTF_8
else if ((pop_lit1 < 0) || (pop_lit1 > LAST_UCS_CHAR))
#else
else if ((pop_lit1 < 0) || (pop_lit1 > LAST_ASCII_CHAR))
#endif
BEGIN
BST_EX_WARN2 ("%ld isn't valid character code", (long) pop_lit1);
push_lit_stk (s_null, STK_STR);
END
else
BEGIN
STR_ROOM (1);
#if UTF_8
BEGIN
UChar ch0[3] = {0};
unsigned char ch1[5] = {0}, *ch;
if (pop_lit1> 0xFFFF)
BEGIN
ch0[0] = U16_LEAD(pop_lit1);
ch0[1] = U16_TRAIL(pop_lit1);
END
else
ch0[0] = pop_lit1;
icu_fromUChars(ch1, 5, ch0, 3);
ch=ch1;
while(*ch)
BEGIN
APPEND_CHAR (*ch);
INCR (ch);
END
END
#else
APPEND_CHAR (pop_lit1);
#endif
push_lit_stk (make_string (), STK_STR);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 422 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 423
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function int.to.str$ pops the top (integer)
* literal, converts it to its (unique) string equivalent, and pushes
* this string. If the literal isn't an integer, it complains and pushes
* the null string.
***************************************************************************/
void x_int_to_str (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (s_null, STK_STR);
END
else
BEGIN
int_to_ASCII (pop_lit1, ex_buf, 0, &ex_buf_length);
add_pool_buf_and_push ();
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 423 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 347
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function < pops the top two (integer) literals,
* compares them, and pushes the integer 1 if the second is less than the
* first, 0 otherwise. If either isn't an integer literal, it complains
* and pushes the integer 0.
***************************************************************************/
void x_less_than (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (0, STK_INT);
END
else if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
push_lit_stk (0, STK_INT);
END
else if (pop_lit2 < pop_lit1)
BEGIN
push_lit_stk (1, STK_INT);
END
else
BEGIN
push_lit_stk (0, STK_INT);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 347 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 349
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function - pops the top two (integer) literals
* and pushes their difference (the first subtracted from the second).
* If either isn't an integer literal, it complains and pushes the
* integer 0.
***************************************************************************/
void x_minus (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (0, STK_INT);
END
else if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
push_lit_stk (0, STK_INT);
END
else
BEGIN
push_lit_stk (pop_lit2 - pop_lit1, STK_INT);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 349 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 424
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function missing$ pops the top literal and
* pushes the integer 1 if it's a missing field, 0 otherwise. If the
* literal isn't a missing field or a string, it complains and pushes 0.
* Unlike empty$ , this function should be called only when
* |mess_with_entries| is true.
***************************************************************************/
void x_missing (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if ( ! mess_with_entries)
BEGIN
bst_cant_mess_with_entries_prin ();
END
else if ((pop_typ1 != STK_STR) && (pop_typ1 != STK_FIELD_MISSING))
BEGIN
if (pop_typ1 != STK_EMPTY)
BEGIN
print_stk_lit (pop_lit1, pop_typ1);
BST_EX_WARN (", not a string or missing field,");
END
push_lit_stk (0, STK_INT);
END
else if (pop_typ1 == STK_FIELD_MISSING)
BEGIN
push_lit_stk (1, STK_INT);
END
else
BEGIN
push_lit_stk (0, STK_INT);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 424 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 426
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function num.names$ pops the top (string)
* literal; it pushes the number of names the string represents---one
* plus the number of occurrences of the substring ``and'' (ignoring case
* differences) surrounded by nonnull |white_space| at the top brace
* level. If the literal isn't a string, it complains and pushes the
* value 0.
***************************************************************************/
void x_num_names (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
push_lit_stk (0, STK_INT);
END
else
BEGIN
ex_buf_length = 0;
add_buf_pool (pop_lit1);
/***************************************************************************
* WEB section number: 427
* ~~~~~~~~~~~~~~~~~~~
* This module, while scanning the list of names, counts the occurrences
* of ``and'' (ignoring case differences) surrounded by nonnull
* |white_space|, and adds 1.
***************************************************************************/
BEGIN
ex_buf_ptr = 0;
num_names = 0;
while (ex_buf_ptr < ex_buf_length)
BEGIN
name_scan_for_and (pop_lit1);
INCR (num_names);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 427 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
push_lit_stk (num_names, STK_INT);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 426 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 348
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function + pops the top two (integer) literals
* and pushes their sum. If either isn't an integer literal, it
* complains and pushes the integer 0.
***************************************************************************/
void x_plus (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (0, STK_INT);
END
else if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
push_lit_stk (0, STK_INT);
END
else
BEGIN
push_lit_stk (pop_lit2 + pop_lit1, STK_INT);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 348 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 429
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function preamble$ pushes onto the stack the
* concatenation of all the preamble strings read from the database
* files.
***************************************************************************/
void x_preamble (void)
BEGIN
ex_buf_length = 0;
preamble_ptr = 0;
while (preamble_ptr < num_preamble_strings)
BEGIN
add_buf_pool (s_preamble[preamble_ptr]);
INCR (preamble_ptr);
END
add_pool_buf_and_push ();
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 429 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 430
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function purify$ pops the top (string) literal,
* removes nonalphanumeric characters except for |white_space| and
* |sep_char| characters (these get converted to a |space|) and removes
* certain alphabetic characters contained in the control sequences
* associated with a special character, and pushes the resulting string.
* If the literal isn't a string, it complains and pushes the null
* string.
***************************************************************************/
void x_purify (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else
BEGIN
ex_buf_length = 0;
add_buf_pool (pop_lit1);
/***************************************************************************
* WEB section number: 431
* ~~~~~~~~~~~~~~~~~~~
* The resulting string has nonalphanumeric characters removed, and each
* |white_space| or |sep_char| character converted to a |space|. The next
* module handles special characters. This code doesn't complain if the
* string isn't brace balanced.
***************************************************************************/
BEGIN
brace_level = 0;
ex_buf_xptr = 0;
ex_buf_ptr = 0;
while (ex_buf_ptr < ex_buf_length)
BEGIN
switch (lex_class[ex_buf[ex_buf_ptr]])
BEGIN
case WHITE_SPACE:
case SEP_CHAR:
BEGIN
ex_buf[ex_buf_xptr] = SPACE;
INCR (ex_buf_xptr);
END
break;
case ALPHA:
case NUMERIC:
BEGIN
#ifdef UTF_8
/*
When we processe the character UTF-8, the length has been changed. This focntion is used in
quick_sort. 23/sep/2009
*/
DO_UTF8(ex_buf[ex_buf_ptr],
ex_buf[ex_buf_xptr] = ex_buf[ex_buf_ptr];
ex_buf_xptr += 1,
ex_buf[ex_buf_xptr] = ex_buf[ex_buf_ptr];
ex_buf[ex_buf_xptr+1] = ex_buf[ex_buf_ptr+1];
ex_buf_xptr += 2; ex_buf_ptr += 1,
ex_buf[ex_buf_xptr] = ex_buf[ex_buf_ptr];
ex_buf[ex_buf_xptr+1] = ex_buf[ex_buf_ptr+1];
ex_buf[ex_buf_xptr+2] = ex_buf[ex_buf_ptr+2];
ex_buf_xptr += 3; ex_buf_ptr += 2,
ex_buf[ex_buf_xptr] = ex_buf[ex_buf_ptr];
ex_buf[ex_buf_xptr+1] = ex_buf[ex_buf_ptr+1];
ex_buf[ex_buf_xptr+2] = ex_buf[ex_buf_ptr+2];
ex_buf[ex_buf_xptr+3] = ex_buf[ex_buf_ptr+3];
ex_buf_xptr += 4; ex_buf_ptr += 3);
#else
ex_buf[ex_buf_xptr] = ex_buf[ex_buf_ptr];
INCR (ex_buf_xptr);
#endif
END
break;
default:
if (ex_buf[ex_buf_ptr] == LEFT_BRACE)
BEGIN
INCR (brace_level);
if ((brace_level == 1) && ((ex_buf_ptr + 1) < ex_buf_length))
BEGIN
if (ex_buf[ex_buf_ptr + 1] == BACKSLASH)
/***************************************************************************
* WEB section number: 432
* ~~~~~~~~~~~~~~~~~~~
* Special characters (even without a matching |right_brace|) are
* purified by removing the control sequences (but restoring the correct
* thing for `\i' and `\j' as well as the eleven alphabetic
* foreign characters in Table~3.2 of the \LaTeX\ manual) and removing
* all nonalphanumeric characters (including |white_space| and
* |sep_char|s).
***************************************************************************/
BEGIN
INCR (ex_buf_ptr);
while ((ex_buf_ptr < ex_buf_length) && (brace_level > 0))
BEGIN
INCR (ex_buf_ptr);
ex_buf_yptr = ex_buf_ptr;
while ((ex_buf_ptr < ex_buf_length)
&& (lex_class[ex_buf[ex_buf_ptr]] == ALPHA))
BEGIN
INCR (ex_buf_ptr);
END
control_seq_loc = str_lookup (ex_buf, ex_buf_yptr,
ex_buf_ptr - ex_buf_yptr,
CONTROL_SEQ_ILK,
DONT_INSERT);
if (hash_found)
/***************************************************************************
* WEB section number: 433
* ~~~~~~~~~~~~~~~~~~~
* We consider the purified character to be either the first alphabetic
* character of its control sequence, or perhaps both alphabetic
* characters.
***************************************************************************/
BEGIN
ex_buf[ex_buf_xptr] = ex_buf[ex_buf_yptr];
INCR (ex_buf_xptr);
switch (ilk_info[control_seq_loc])
BEGIN
case N_OE:
case N_OE_UPPER:
case N_AE:
case N_AE_UPPER:
case N_SS:
BEGIN
ex_buf[ex_buf_xptr] = ex_buf[ex_buf_yptr + 1];
INCR (ex_buf_xptr);
END
break;
default:
DO_NOTHING;
break;
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 433 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
while ((ex_buf_ptr < ex_buf_length) && (brace_level > 0)
&& (ex_buf[ex_buf_ptr] != BACKSLASH))
BEGIN
switch (lex_class[ex_buf[ex_buf_ptr]])
BEGIN
case ALPHA:
case NUMERIC:
BEGIN
ex_buf[ex_buf_xptr] = ex_buf[ex_buf_ptr];
INCR (ex_buf_xptr);
END
break;
default:
if (ex_buf[ex_buf_ptr] == RIGHT_BRACE)
BEGIN
DECR (brace_level);
END
else if (ex_buf[ex_buf_ptr] == LEFT_BRACE)
BEGIN
INCR (brace_level);
END
break;
END
INCR (ex_buf_ptr);
END
END
DECR (ex_buf_ptr);
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 432 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
END
END
else if (ex_buf[ex_buf_ptr] == RIGHT_BRACE)
BEGIN
if (brace_level > 0)
BEGIN
DECR (brace_level);
END
END
break;
END
INCR (ex_buf_ptr);
END
ex_buf_length = ex_buf_xptr;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 431 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
add_pool_buf_and_push ();
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 430 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 434
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function quote$ pushes the string consisting of
* the |double_quote| character.
***************************************************************************/
void x_quote (void)
BEGIN
STR_ROOM (1);
APPEND_CHAR (DOUBLE_QUOTE);
push_lit_stk (make_string (), STK_STR);
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 434 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 437
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function substring$ pops the top three literals
* (they are the two integers literals |pop_lit1| and |pop_lit2| and a
* string literal, in that order). It pushes the substring of the (at
* most) |pop_lit1| consecutive characters starting at the |pop_lit2|th
* character (assuming 1-based indexing) if |pop_lit2| is positive, and
* ending at the |-pop_lit2|th character from the end if |pop_lit2| is
* negative (where the first character from the end is the last
* character). If any of the types is incorrect, it complain and pushes
* the null string.
*
* Note: If |sp_length| is compared with a signed quantity (e.g. pop_lit2),
* must be first cast to |Integer_T| because it is an UNSIGNED variable.
***************************************************************************/
void x_substring (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
pop_lit_stk (&pop_lit3, &pop_typ3);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (s_null, STK_STR);
END
else if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
push_lit_stk (s_null, STK_STR);
END
else if (pop_typ3 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit3, pop_typ3, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else
BEGIN
#ifdef UTF_8
/*
This is a new code of x_substring for processing the character UTF-8.
We transform the character to Unicode and then get the substring, then
back to UTF-8. 23/sep/2009
*/
Integer_T str_length = LENGTH (pop_lit3);
UChar32 uchs[BUF_SIZE+1];
UChar uch16[BUF_SIZE+1];
int32_t utcap = BUF_SIZE+1;
int32_t ulen;
unsigned char frUch1[BUF_SIZE+1];
unsigned char frUch2[BUF_SIZE+1];
int32_t frUchCap = BUF_SIZE + 1;
int32_t lenfrUch;
int32_t ptrfrUch;
ulen = icu_toUChar32s(str_pool,str_start[pop_lit3],str_length,uchs,utcap,uch16);
sp_length = ulen;
#else
sp_length = LENGTH (pop_lit3);
#endif
if (pop_lit1 >= (Integer_T) sp_length)
BEGIN
if ((pop_lit2 == 1) || (pop_lit2 == -1))
BEGIN
REPUSH_STRING;
goto Exit_Label;
END
END
if ((pop_lit1 <= 0) || (pop_lit2 == 0)
|| (pop_lit2 > (Integer_T) sp_length)
|| (pop_lit2 < -(Integer_T) sp_length))
BEGIN
push_lit_stk (s_null, STK_STR);
goto Exit_Label;
END
else
/***************************************************************************
* WEB section number: 438
* ~~~~~~~~~~~~~~~~~~~
* This module finds the substring as described in the last section,
* and slides it into place in the string pool, if necessary.
***************************************************************************/
BEGIN
if (pop_lit2 > 0)
BEGIN
if (pop_lit1 > (sp_length - (pop_lit2 - 1)))
BEGIN
pop_lit1 = sp_length - (pop_lit2 - 1);
END
#ifdef UTF_8
lenfrUch = icu_fromUChar32s(frUch1, frUchCap, &uchs[pop_lit2-1], pop_lit1, uch16);
ptrfrUch = icu_fromUChar32s(frUch2, frUchCap, uchs, pop_lit2-1, uch16);
sp_ptr = str_start[pop_lit3] + ptrfrUch;
sp_end = sp_ptr + lenfrUch;
#else
sp_ptr = str_start[pop_lit3] + (pop_lit2 - 1);
sp_end = sp_ptr + pop_lit1;
#endif
if (pop_lit2 == 1)
BEGIN
if (pop_lit3 >= cmd_str_ptr)
BEGIN
str_start[pop_lit3 + 1] = sp_end;
UNFLUSH_STRING;
INCR (lit_stk_ptr);
goto Exit_Label;
END
END
END
else
BEGIN
pop_lit2 = -pop_lit2;
if (pop_lit1 > (Integer_T) (sp_length - (pop_lit2 - 1)))
BEGIN
pop_lit1 = sp_length - (pop_lit2 - 1);
END
#ifdef UTF_8
lenfrUch = icu_fromUChar32s(frUch1, frUchCap, &uchs[ulen - (pop_lit2-1) - pop_lit1], pop_lit1, uch16);
ptrfrUch = icu_fromUChar32s(frUch2, frUchCap, uchs, ulen - (pop_lit2-1) - pop_lit1, uch16);
sp_ptr = str_start[pop_lit3] + ptrfrUch;
sp_end = sp_ptr + lenfrUch;
#else
sp_end = str_start[pop_lit3 + 1] - (pop_lit2 - 1);
sp_ptr = sp_end - pop_lit1;
#endif
END
STR_ROOM (sp_end - sp_ptr);
while (sp_ptr < sp_end)
BEGIN
APPEND_CHAR (str_pool[sp_ptr]);
INCR (sp_ptr);
END
push_lit_stk (make_string (), STK_STR);
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 438 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
END
Exit_Label: DO_NOTHING;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 437 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 439
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function swap$ pops the top two literals from
* the stack and pushes them back swapped.
***************************************************************************/
void x_swap (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if ((pop_typ1 != STK_STR) || (pop_lit1 < cmd_str_ptr))
BEGIN
push_lit_stk (pop_lit1, pop_typ1);
if ((pop_typ2 == STK_STR) && (pop_lit2 >= cmd_str_ptr))
BEGIN
UNFLUSH_STRING;
END
push_lit_stk (pop_lit2, pop_typ2);
END
else if ((pop_typ2 != STK_STR) || (pop_lit2 < cmd_str_ptr))
BEGIN
UNFLUSH_STRING;
push_lit_stk (pop_lit1, STK_STR);
push_lit_stk (pop_lit2, pop_typ2);
END
else
/***************************************************************************
* WEB section number: 440
* ~~~~~~~~~~~~~~~~~~~
* We have to swap both (a)~the strings at the end of the string pool,
* and (b)~their pointers on the literal stack.
***************************************************************************/
BEGIN
ex_buf_length = 0;
add_buf_pool (pop_lit2);
sp_ptr = str_start[pop_lit1];
sp_end = str_start[pop_lit1 + 1];
while (sp_ptr < sp_end)
BEGIN
APPEND_CHAR (str_pool[sp_ptr]);
INCR (sp_ptr);
END
push_lit_stk (make_string (), STK_STR);
add_pool_buf_and_push ();
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 440 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 439 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 441
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function text.length$ pops the top (string)
* literal, and pushes the number of text characters it contains, where
* an accented character (more precisely, a ``special character''$\!$,
* defined earlier) counts as a single text character, even if it's
* missing its matching |right_brace|, and where braces don't count as
* text characters. If the literal isn't a string, it complains and
* pushes the null string.
***************************************************************************/
void x_text_length (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else
BEGIN
num_text_chars = 0;
/***************************************************************************
* WEB section number: 442
* ~~~~~~~~~~~~~~~~~~~
* Here we determine the number of text characters in the string, where
* an entire special character counts as a single text character (even if
* it's missing its matching |right_brace|), and where braces don't count
* as text characters.
***************************************************************************/
BEGIN
sp_ptr = str_start[pop_lit1];
sp_end = str_start[pop_lit1 + 1];
sp_brace_level = 0;
while (sp_ptr < sp_end)
BEGIN
INCR (sp_ptr);
if (str_pool[sp_ptr - 1] == LEFT_BRACE)
BEGIN
INCR (sp_brace_level);
if ((sp_brace_level == 1) && (sp_ptr < sp_end))
BEGIN
if (str_pool[sp_ptr] == BACKSLASH)
BEGIN
INCR (sp_ptr);
while ((sp_ptr < sp_end) && (sp_brace_level > 0))
BEGIN
if (str_pool[sp_ptr] == RIGHT_BRACE)
BEGIN
DECR (sp_brace_level);
END
else if (str_pool[sp_ptr] == LEFT_BRACE)
BEGIN
INCR (sp_brace_level);
END
INCR (sp_ptr);
END
#ifdef UTF_8
/*
The length of character of UTF-8 is different. 23/sep/2009
*/
DO_UTF8(str_pool[sp_ptr-1], , sp_ptr++, sp_ptr += 2, sp_ptr += 3);
#endif
INCR (num_text_chars);
END
END
END
else if (str_pool[sp_ptr - 1] == RIGHT_BRACE)
BEGIN
if (sp_brace_level > 0)
BEGIN
DECR (sp_brace_level);
END
END
else
BEGIN
#ifdef UTF_8
/*
The same for the length of character. 23/sep/2009
*/
DO_UTF8(str_pool[sp_ptr-1], , sp_ptr++, sp_ptr += 2, sp_ptr += 3);
#endif
INCR (num_text_chars);
END
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 442 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
push_lit_stk (num_text_chars, STK_INT);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 441 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 443
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function text.prefix$ pops the top two literals
* (the integer literal |pop_lit1| and a string literal, in that order).
* It pushes the substring of the (at most) |pop_lit1| consecutive text
* characters starting from the beginning of the string. This function
* is similar to substring$ , but this one considers an accented
* character (or more precisely, a ``special character''$\!$, even if
* it's missing its matching |right_brace|) to be a single text character
* (rather than however many |ASCII_code| characters it actually
* comprises), and this function doesn't consider braces to be text
* characters; furthermore, this function appends any needed matching
* |right_brace|s. If any of the types is incorrect, it complains and
* pushes the null string.
***************************************************************************/
void x_text_prefix (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (s_null, STK_STR);
END
else if (pop_typ2 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_STR);
push_lit_stk (s_null, STK_STR);
END
else if (pop_lit1 <= 0)
BEGIN
push_lit_stk (s_null, STK_STR);
goto Exit_Label;
END
else
/***************************************************************************
* WEB section number: 444
* ~~~~~~~~~~~~~~~~~~~
* This module finds the prefix as described in the last section, and
* appends any needed matching |right_brace|s.
***************************************************************************/
BEGIN
sp_ptr = str_start[pop_lit2];
sp_end = str_start[pop_lit2 + 1];
/***************************************************************************
* WEB section number: 445
* ~~~~~~~~~~~~~~~~~~~
* This section scans |pop_lit1| text characters, where an entire special
* character counts as a single text character (even if it's missing its
* matching |right_brace|), and where braces don't count as text
* characters.
***************************************************************************/
BEGIN
num_text_chars = 0;
sp_brace_level = 0;
sp_xptr1 = sp_ptr;
while ((sp_xptr1 < sp_end) && (num_text_chars < pop_lit1))
BEGIN
INCR (sp_xptr1);
if (str_pool[sp_xptr1 - 1] == LEFT_BRACE)
BEGIN
INCR (sp_brace_level);
if ((sp_brace_level == 1) && (sp_xptr1 < sp_end))
BEGIN
if (str_pool[sp_xptr1] == BACKSLASH)
BEGIN
INCR (sp_xptr1);
while ((sp_xptr1 < sp_end) && (sp_brace_level > 0))
BEGIN
if (str_pool[sp_xptr1] == RIGHT_BRACE)
BEGIN
DECR (sp_brace_level);
END
else if (str_pool[sp_xptr1] == LEFT_BRACE)
BEGIN
INCR (sp_brace_level);
END
INCR (sp_xptr1);
END
#ifdef UTF_8
/*
The same for the length of character UTF-8. 23/sep/2009
*/
DO_UTF8(str_pool[sp_xptr1-1], , sp_xptr1++, sp_xptr1 += 2, sp_xptr1 += 3);
#endif
INCR (num_text_chars);
END
END
END
else if (str_pool[sp_xptr1 - 1] == RIGHT_BRACE)
BEGIN
if (sp_brace_level > 0)
BEGIN
DECR (sp_brace_level);
END
END
else
BEGIN
#ifdef UTF_8
/*
The same for the length of character UTF-8. 23/sep/2009
*/
DO_UTF8(str_pool[sp_xptr1-1], , sp_xptr1++, sp_xptr1 += 2, sp_xptr1 += 3);
#endif
INCR (num_text_chars);
END
END
sp_end = sp_xptr1;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 445 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
STR_ROOM (sp_brace_level + sp_end - sp_ptr);
if (pop_lit2 >= cmd_str_ptr)
BEGIN
pool_ptr = sp_end;
END
else
BEGIN
while (sp_ptr < sp_end)
BEGIN
APPEND_CHAR (str_pool[sp_ptr]);
INCR (sp_ptr);
END
END
while (sp_brace_level > 0)
BEGIN
APPEND_CHAR (RIGHT_BRACE);
DECR (sp_brace_level);
END
push_lit_stk (make_string (), STK_STR);
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 444 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
Exit_Label: DO_NOTHING;
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 443 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 447
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function type$ pushes the appropriate string
* from |type_list| onto the stack (unless either it's |undefined| or
* |empty|, in which case it pushes the null string).
***************************************************************************/
void x_type (void)
BEGIN
if ( ! mess_with_entries)
BEGIN
bst_cant_mess_with_entries_prin ();
END
else if ((type_list[cite_ptr] == UNDEFINED)
|| (type_list[cite_ptr] == EMPTY))
BEGIN
push_lit_stk (s_null, STK_STR);
END
else
BEGIN
push_lit_stk (hash_text[type_list[cite_ptr]], STK_STR);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 447 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 448
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function warning$ pops the top (string) literal
* and prints it following a warning message. This is implemented as a
* special |built_in| function rather than using the top$ function
* so that it can |mark_warning|.
***************************************************************************/
void x_warning (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
END
else
BEGIN
PRINT ("Warning--");
print_lit (pop_lit1, pop_typ1);
mark_warning ();
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 448 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
#ifdef UTF_8
Integer_T char_width_uni (ASCIICode_T * str)
BEGIN
UChar32 ch;
U8_GET_OR_FFFD(str, 0, 0, -1, ch);
if (ch<=LAST_LATIN_CHAR)
return ( char_width[ch] );
else
BEGIN
switch ( u_getIntPropertyValue(ch, UCHAR_EAST_ASIAN_WIDTH) )
BEGIN
case U_EA_WIDE:
case U_EA_FULLWIDTH:
return ( 1000 );
case U_EA_HALFWIDTH:
return ( 500 );
case U_EA_NARROW:
case U_EA_NEUTRAL:
case U_EA_AMBIGUOUS:
default:
return ( 700 );
END
END
END
#endif
/***************************************************************************
* WEB section number: 450
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function width$ pops the top (string) literal
* and pushes the integer that represents its width in units specified by
* the |char_width| array. This function takes the literal literally;
* that is, it assumes each character in the string is to be printed as
* is, regardless of whether the character has a special meaning to \TeX,
* except that special characters (even without their |right_brace|s) are
* handled specially. If the literal isn't a string, it complains and
* pushes~0.
***************************************************************************/
void x_width (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
push_lit_stk (0, STK_INT);
END
else
BEGIN
ex_buf_length = 0;
add_buf_pool (pop_lit1);
string_width = 0;
/***************************************************************************
* WEB section number: 451
* ~~~~~~~~~~~~~~~~~~~
* We use the natural width for all but special characters, and we
* complain if the string isn't brace-balanced.
***************************************************************************/
BEGIN
brace_level = 0;
ex_buf_ptr = 0;
while (ex_buf_ptr < ex_buf_length)
BEGIN
if (ex_buf[ex_buf_ptr] == LEFT_BRACE)
BEGIN
INCR (brace_level);
if ((brace_level == 1) && ((ex_buf_ptr + 1) < ex_buf_length))
BEGIN
if (ex_buf[ex_buf_ptr + 1] == BACKSLASH)
/***************************************************************************
* WEB section number: 452
* ~~~~~~~~~~~~~~~~~~~
* We use the natural widths of all characters except that some
* characters have no width: braces, control sequences (except for the
* usual 13 accented and foreign characters, whose widths are given in
* the next module), and |white_space| following control sequences (even
* a null control sequence).
***************************************************************************/
BEGIN
INCR (ex_buf_ptr);
while ((ex_buf_ptr < ex_buf_length) && (brace_level > 0))
BEGIN
INCR (ex_buf_ptr);
ex_buf_xptr = ex_buf_ptr;
while ((ex_buf_ptr < ex_buf_length)
&& (lex_class[ex_buf[ex_buf_ptr]] == ALPHA))
BEGIN
INCR (ex_buf_ptr);
END
if ((ex_buf_ptr < ex_buf_length)
&& (ex_buf_ptr == ex_buf_xptr))
BEGIN
INCR (ex_buf_ptr);
END
else
BEGIN
control_seq_loc = str_lookup (ex_buf, ex_buf_xptr,
ex_buf_ptr - ex_buf_xptr,
CONTROL_SEQ_ILK, DONT_INSERT);
if (hash_found)
/***************************************************************************
* WEB section number: 453
* ~~~~~~~~~~~~~~~~~~~
* Five of the 13 possibilities resort to special information not present
* in the |char_width| array; the other eight simply use |char_width|'s
* information for the first letter of the control sequence.
***************************************************************************/
BEGIN
switch (ilk_info[control_seq_loc])
BEGIN
case N_SS:
string_width = string_width + SS_WIDTH;
break;
case N_AE:
string_width = string_width + AE_WIDTH;
break;
case N_OE:
string_width = string_width + OE_WIDTH;
break;
case N_AE_UPPER:
string_width = string_width + UPPER_AE_WIDTH;
break;
case N_OE_UPPER:
string_width = string_width + UPPER_OE_WIDTH;
break;
default:
string_width = string_width
+ char_width[ex_buf[ex_buf_xptr]];
break;
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 453 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
END
while ((ex_buf_ptr < ex_buf_length)
&& (lex_class[ex_buf[ex_buf_ptr]] == WHITE_SPACE))
BEGIN
INCR (ex_buf_ptr);
END
while ((ex_buf_ptr < ex_buf_length) && (brace_level > 0)
&& (ex_buf[ex_buf_ptr] != BACKSLASH))
BEGIN
if (ex_buf[ex_buf_ptr] == RIGHT_BRACE)
BEGIN
DECR (brace_level);
END
else if (ex_buf[ex_buf_ptr] == LEFT_BRACE)
BEGIN
INCR (brace_level);
END
else
BEGIN
#if UTF_8
string_width = string_width
+ char_width_uni(&ex_buf[ex_buf_ptr]);
#else
string_width = string_width
+ char_width[ex_buf[ex_buf_ptr]];
#endif
END
#if UTF_8
if (utf8len(ex_buf[ex_buf_ptr])>0)
ex_buf_ptr = ex_buf_ptr + utf8len(ex_buf[ex_buf_ptr]);
else
INCR (ex_buf_ptr);
#else
INCR (ex_buf_ptr);
#endif
END
END
DECR (ex_buf_ptr);
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 452 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
else
BEGIN
string_width = string_width + char_width[LEFT_BRACE];
END
END
else
BEGIN
string_width = string_width + char_width[LEFT_BRACE];
END
END
else if (ex_buf[ex_buf_ptr] == RIGHT_BRACE)
BEGIN
decr_brace_level (pop_lit1);
string_width = string_width + char_width[RIGHT_BRACE];
END
else
BEGIN
#if UTF_8
string_width = string_width + char_width_uni(&ex_buf[ex_buf_ptr]);
#else
string_width = string_width + char_width[ex_buf[ex_buf_ptr]];
#endif
END
#if UTF_8
if (utf8len(ex_buf[ex_buf_ptr])>0)
ex_buf_ptr = ex_buf_ptr + utf8len(ex_buf[ex_buf_ptr]);
else
INCR (ex_buf_ptr);
#else
INCR (ex_buf_ptr);
#endif
END
check_brace_level (pop_lit1);
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 451 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
push_lit_stk (string_width, STK_INT);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 450 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
/***************************************************************************
* WEB section number: 454
* ~~~~~~~~~~~~~~~~~~~
* The |built_in| function write$ pops the top (string) literal
* and writes it onto the output buffer |out_buf| (which will result in
* stuff being written onto the .bbl file if the buffer fills up). If
* the literal isn't a string, it complains but does nothing else.
***************************************************************************/
void x_write (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
END
else
BEGIN
add_out_pool (pop_lit1);
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 454 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
void x_bit_and (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (0, STK_INT);
END
else if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
push_lit_stk (0, STK_INT);
END
else
BEGIN
push_lit_stk (pop_lit1 & pop_lit2, STK_INT);
END
END
void x_bit_or (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
pop_lit_stk (&pop_lit2, &pop_typ2);
if (pop_typ1 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_INT);
push_lit_stk (0, STK_INT);
END
else if (pop_typ2 != STK_INT)
BEGIN
print_wrong_stk_lit (pop_lit2, pop_typ2, STK_INT);
push_lit_stk (0, STK_INT);
END
else
BEGIN
push_lit_stk (pop_lit1 | pop_lit2, STK_INT);
END
END
#ifdef UTF_8
#define FULLWIDTH_DIGIT_0 0xFF10
#define FULLWIDTH_DIGIT_9 0xFF19
#define FULLWIDTH_CAPITAL_A 0xFF21
#define FULLWIDTH_CAPITAL_Z 0xFF3A
#define FULLWIDTH_SMALL_A 0xFF41
#define FULLWIDTH_SMALL_Z 0xFF5A
#define HALFWIDTH_KATAKANA_WO 0xFF66
#define HALFWIDTH_KATAKANA_SMALL_TSU 0xFF6F
#define HALFWIDTH_KATAKANA_A 0xFF71
#define HALFWIDTH_KATAKANA_N 0xFF9D
void x_is_cjk_string (void)
BEGIN
pop_lit_stk (&pop_lit1, &pop_typ1);
if (pop_typ1 != STK_STR)
BEGIN
print_wrong_stk_lit (pop_lit1, pop_typ1, STK_STR);
push_lit_stk (-1, STK_INT);
END
else
BEGIN
ex_buf_length = 0;
add_buf_pool (pop_lit1);
string_width = 0;
BEGIN
ex_buf_ptr = 0;
while (ex_buf_ptr < ex_buf_length)
BEGIN
UChar32 ch;
U8_NEXT_OR_FFFD(ex_buf, ex_buf_ptr, -1, ch);
switch ( ublock_getCode(ch) )
BEGIN
/* hanzi */
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS:
case UBLOCK_CJK_COMPATIBILITY_IDEOGRAPHS:
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS_EXTENSION_A:
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS_EXTENSION_B:
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS_EXTENSION_C:
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS_EXTENSION_D:
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS_EXTENSION_E:
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS_EXTENSION_F:
#if defined(U_ICU_VERSION_MAJOR_NUM)
#if U_ICU_VERSION_MAJOR_NUM > 65
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS_EXTENSION_G:
#endif
#if U_ICU_VERSION_MAJOR_NUM > 71
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS_EXTENSION_H:
#endif
#if U_ICU_VERSION_MAJOR_NUM > 73
case UBLOCK_CJK_UNIFIED_IDEOGRAPHS_EXTENSION_I:
#endif
#endif
string_width |= 0x001;
break;
/* kana */
case UBLOCK_HIRAGANA:
case UBLOCK_KATAKANA:
case UBLOCK_KATAKANA_PHONETIC_EXTENSIONS:
case UBLOCK_KANA_EXTENDED_A:
#if defined(U_ICU_VERSION_MAJOR_NUM)
#if U_ICU_VERSION_MAJOR_NUM > 69
case UBLOCK_KANA_EXTENDED_B:
#endif
#if U_ICU_VERSION_MAJOR_NUM > 63
case UBLOCK_SMALL_KANA_EXTENSION:
#endif
#endif
string_width |= 0x002;
break;
/* hangul */
case UBLOCK_HANGUL_SYLLABLES:
case UBLOCK_HANGUL_JAMO:
case UBLOCK_HANGUL_JAMO_EXTENDED_A:
case UBLOCK_HANGUL_JAMO_EXTENDED_B:
case UBLOCK_HANGUL_COMPATIBILITY_JAMO:
string_width |= 0x004;
break;
/* bopomofo */
case UBLOCK_BOPOMOFO:
case UBLOCK_BOPOMOFO_EXTENDED:
string_width |= 0x008;
break;
case UBLOCK_HALFWIDTH_AND_FULLWIDTH_FORMS:
/* Fullwidth ASCII variants except for U+FF01..FF0F, U+FF1A..FF20, U+FF3B..FF40, U+FF5B..FF5E */
if ( (FULLWIDTH_DIGIT_0 <=ch && ch<=FULLWIDTH_DIGIT_9 )
|| (FULLWIDTH_CAPITAL_A<=ch && ch<=FULLWIDTH_CAPITAL_Z)
|| (FULLWIDTH_SMALL_A <=ch && ch<=FULLWIDTH_SMALL_Z ) )
string_width |= 0x800;
/* Halfwidth Katakana variants except for U+FF65, U+FF70, U+FF9E..FF9F */
if ( (HALFWIDTH_KATAKANA_WO <=ch && ch<=HALFWIDTH_KATAKANA_SMALL_TSU )
|| (HALFWIDTH_KATAKANA_A <=ch && ch<=HALFWIDTH_KATAKANA_N ) )
string_width |= 0x002;
break;
/* miscellaneous */
case UBLOCK_KANBUN:
case UBLOCK_KANGXI_RADICALS:
case UBLOCK_CJK_RADICALS_SUPPLEMENT:
string_width |= 0x800;
break;
END
END
END
/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 451 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/
push_lit_stk (string_width, STK_INT);
END
END
#endif