diff options
Diffstat (limited to 'Build/source/texk/bibtexu/bibtex-4.c')
-rw-r--r-- | Build/source/texk/bibtexu/bibtex-4.c | 2665 |
1 files changed, 0 insertions, 2665 deletions
diff --git a/Build/source/texk/bibtexu/bibtex-4.c b/Build/source/texk/bibtexu/bibtex-4.c deleted file mode 100644 index 95f30801fca..00000000000 --- a/Build/source/texk/bibtexu/bibtex-4.c +++ /dev/null @@ -1,2665 +0,0 @@ -/*- -****************************************************************************** -****************************************************************************** -** -** 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 -** -****************************************************************************** -****************************************************************************** -*/ - -#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 i=ex_buf_ptr; - int16_t llen; - - while ((ex_buf[i] != COLON) && (ex_buf[i] != WHITE_SPACE) && (i< ex_buf_length)) - BEGIN - i++; - END - llen=(i-ex_buf_ptr); - ex_buf_ptr=ex_buf_length-1+lower_case_uni (ex_buf, ex_buf_ptr, llen)+ex_buf_ptr; -#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 i=ex_buf_ptr; - int16_t llen; - while ((ex_buf[i] != COLON) && (ex_buf[i] != WHITE_SPACE) && (i< ex_buf_length)) - BEGIN - i++; - END - llen=(i-ex_buf_ptr+1); - ex_buf_ptr=ex_buf_ptr-1+lower_case_uni (ex_buf, ex_buf_ptr, llen); - 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 i=ex_buf_ptr; - int16_t ulen; - while ((ex_buf[i] != COLON) && (ex_buf[i] != WHITE_SPACE) && (i< ex_buf_length)) - BEGIN - i++; - END - ulen=(i-ex_buf_ptr+1); - ex_buf_ptr=ex_buf_ptr-1+upper_case_uni (ex_buf, ex_buf_ptr, ulen); - 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 - 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, ", 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 - 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 -#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[ex_buf_xptr] = ex_buf[ex_buf_ptr]; ex_buf_xptr += 2, - ex_buf[ex_buf_xptr] = ex_buf[ex_buf_ptr]; ex_buf_xptr += 3, - ex_buf[ex_buf_xptr] = ex_buf[ex_buf_ptr]; ex_buf_xptr += 4); -#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); - UChar uchs[BUF_SIZE+1]; - int32_t utcap = BUF_SIZE+1; - int32_t ulen = icu_toUChars(str_pool,str_start[pop_lit3],str_length,uchs, utcap); - - 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 -#ifdef UTF_8 - unsigned char frUch1[BUF_SIZE+1]; - int32_t frUchCap = BUF_SIZE + 1; - int32_t lenfrUch = icu_fromUChars(frUch1, frUchCap, &uchs[pop_lit2-1], pop_lit1); - unsigned char frUch2[BUF_SIZE+1]; - int32_t ptrfrUch = icu_fromUChars(frUch2, frUchCap, uchs, pop_lit2-1); -#endif - if (pop_lit1 > (sp_length - (pop_lit2 - 1))) - BEGIN - pop_lit1 = sp_length - (pop_lit2 - 1); - END -#ifdef UTF_8 - frUchCap = BUF_SIZE + 1; - lenfrUch = icu_fromUChars(frUch1, frUchCap, &uchs[pop_lit2-1], pop_lit1); - ptrfrUch = icu_fromUChars(frUch2, frUchCap, uchs, pop_lit2-1); - 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 -#ifdef UTF_8 - unsigned char frUch1[BUF_SIZE+1]; - int32_t frUchCap = BUF_SIZE + 1; - int32_t lenfrUch = icu_fromUChars(frUch1, frUchCap, &uchs[ulen - (pop_lit2-1) - pop_lit1], pop_lit1); - unsigned char frUch2[BUF_SIZE+1]; - int32_t ptrfrUch = icu_fromUChars(frUch2, frUchCap, &uchs[ulen - pop_lit2], pop_lit2-1); -#endif - 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 - frUchCap = BUF_SIZE + 1; - lenfrUch = icu_fromUChars(frUch1, frUchCap, &uchs[ulen - (pop_lit2-1) - pop_lit1], pop_lit1); - ptrfrUch = icu_fromUChars(frUch2, frUchCap, &uchs[ulen - pop_lit2], pop_lit2-1); - sp_ptr = str_start[pop_lit3] + ptrfrUch; - sp_end = str_start[pop_lit3 + 1] - ptrfrUch; - sp_ptr = sp_end - 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], , 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], , 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 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/ - - - -/*************************************************************************** - * 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 ^^^^^^^^^^^^^^^^^^^^^^^^^^^*/ |