diff options
author | Karl Berry <karl@freefriends.org> | 2006-01-17 21:41:51 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2006-01-17 21:41:51 +0000 |
commit | 487ca4806cc046076293cf6cc5fbba0db282bac7 (patch) | |
tree | 847b412ab5158dd7bdd7ed7e5a4cc3fbca94be32 /Build/source/texk/bibtex8/bibtex-4.c | |
parent | a3d3111bfe26b8e5f5bc6049dfb2a4ca2edc7881 (diff) |
texk 1
git-svn-id: svn://tug.org/texlive/trunk@1485 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/bibtex8/bibtex-4.c')
-rw-r--r-- | Build/source/texk/bibtex8/bibtex-4.c | 2523 |
1 files changed, 2523 insertions, 0 deletions
diff --git a/Build/source/texk/bibtex8/bibtex-4.c b/Build/source/texk/bibtex8/bibtex-4.c new file mode 100644 index 00000000000..4186ec7f285 --- /dev/null +++ b/Build/source/texk/bibtex8/bibtex-4.c @@ -0,0 +1,2523 @@ +/*- +****************************************************************************** +****************************************************************************** +** +** MODULE +** +** $RCSfile: bibtex-4.c,v $ +** $Revision: 3.71 $ +** $Date: 1996/08/18 20:47:30 $ +** +** 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 +** +****************************************************************************** +****************************************************************************** +*/ +static char *rcsid = "$Id: bibtex-4.c,v 3.71 1996/08/18 20:47:30 kempson Exp $"; + +#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 + DO_NOTHING; + END + else if ((prev_colon) + && (lex_class[ex_buf[ex_buf_ptr - 1]] == WHITE_SPACE)) + BEGIN + DO_NOTHING; + END + else + BEGIN + lower_case (ex_buf, ex_buf_ptr, 1); + 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: + lower_case (ex_buf, ex_buf_ptr, 1); + break; + case ALL_UPPERS: + upper_case (ex_buf, ex_buf_ptr, 1); + 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 + else if (LENGTH (pop_lit1) != 1) + BEGIN + PRINT ("\""); + PRINT_POOL_STR (pop_lit1); + BST_EX_WARN ("\" isn't a single character"); + push_lit_stk (0, STK_INT); + END + else + BEGIN + push_lit_stk (str_pool[str_start[pop_lit1]], STK_INT); + 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 + 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, "%ld, 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, "%ld, 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 + else if ((pop_lit1 < 0) || (pop_lit1 > 127)) + BEGIN + BST_EX_WARN2 ("%ld isn't valid ASCII", (long) pop_lit1); + push_lit_stk (s_null, STK_STR); + END + else + BEGIN + STR_ROOM (1); + APPEND_CHAR (pop_lit1); + 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 + ex_buf[ex_buf_xptr] = ex_buf[ex_buf_ptr]; + INCR (ex_buf_xptr); + 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 + sp_length = LENGTH (pop_lit3); + 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 + sp_ptr = str_start[pop_lit3] + (pop_lit2 - 1); + sp_end = sp_ptr + pop_lit1; + 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 + sp_end = str_start[pop_lit3 + 1] - (pop_lit2 - 1); + sp_ptr = sp_end - pop_lit1; + END + 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 + 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 + 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 + 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 + INCR (num_text_chars); + END + END + sp_end = sp_xptr1; + END +/*^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF SECTION 445 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/ + + 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 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/ + + + +/*************************************************************************** + * 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 + string_width = string_width + + char_width[ex_buf[ex_buf_ptr]]; + END + INCR (ex_buf_ptr); + 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 + string_width = string_width + char_width[ex_buf[ex_buf_ptr]]; + END + INCR (ex_buf_ptr); + 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 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/ |