diff options
Diffstat (limited to 'Build/source/texk/web2c/luatexdir/tex/primitive.c')
-rw-r--r-- | Build/source/texk/web2c/luatexdir/tex/primitive.c | 785 |
1 files changed, 785 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/luatexdir/tex/primitive.c b/Build/source/texk/web2c/luatexdir/tex/primitive.c new file mode 100644 index 00000000000..f16d69a333c --- /dev/null +++ b/Build/source/texk/web2c/luatexdir/tex/primitive.c @@ -0,0 +1,785 @@ +/* + +primitive.w + +Copyright 2008-2010 Taco Hoekwater <taco@@luatex.org> + +This file is part of LuaTeX. + +LuaTeX 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 2 of the License, or (at your +option) any later version. + +LuaTeX 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 Lesser General Public +License for more details. + +You should have received a copy of the GNU General Public License along +with LuaTeX; if not, see <http://www.gnu.org/licenses/>. + +*/ + +#include "ptexlib.h" + +/*tex + +Control sequences are stored and retrieved by means of a fairly standard hash +table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C in +{\sl The Art of Computer Programming\/}). Once a control sequence enters the +table, it is never removed, because there are complicated situations involving +\.{\\gdef} where the removal of a control sequence at the end of a group would be +a mistake preventable only by the introduction of a complicated reference-count +mechanism. + +The actual sequence of letters forming a control sequence identifier is stored in +the |str_pool| array together with all the other strings. An auxiliary array +|hash| consists of items with two halfword fields per word. The first of these, +called |next(p)|, points to the next identifier belonging to the same coalesced +list as the identifier corresponding to~|p|; and the other, called |text(p)|, +points to the |str_start| entry for |p|'s identifier. If position~|p| of the hash +table is empty, we have |text(p)=0|; if position |p| is either empty or the end +of a coalesced hash list, we have |next(p)=0|. An auxiliary pointer variable +called |hash_used| is maintained in such a way that all locations |p>=hash_used| +are nonempty. The global variable |cs_count| tells how many multiletter control +sequences have been defined, if statistics are being kept. + +A global boolean variable called |no_new_control_sequence| is set to |true| +during the time that new hash table entries are forbidden. + +*/ + +/*tex The hash table: */ + +two_halves *hash; + +/*tex Allocation pointer for |hash|: */ + +halfword hash_used; + +/*tex |hash_extra=hash| above |eqtb_size|: */ + +int hash_extra; + +/*tex Maximum of the hash array: */ + +halfword hash_top; + +/*tex Pointer to next high hash location: */ + +halfword hash_high; + +/*tex Are new identifiers legal? */ + +boolean no_new_control_sequence; + +/*tex Total number of known identifiers: */ + +int cs_count; + +/*tex Test if all positions are occupied: */ + +#define hash_is_full (hash_used==hash_base) + +/*tex + + \.{\\primitive} support needs a few extra variables and definitions, + like: + +*/ + +#define prim_base 1 + +/*tex + +The arrays |prim| and |prim_eqtb| are used for name -> cmd,chr lookups. The are +modelled after |hash| and |eqtb|, except that primitives do not have an +|eq_level|, that field is replaced by |origin|. + +*/ + +/*tex Link for coalesced lists: */ + +#define prim_next(a) prim[(a)].lhfield + +/*tex String number for control sequence name: */ + +#define prim_text(a) prim[(a)].rh + +/*tex Test if all positions are occupied: */ + +#define prim_is_full (prim_used==prim_base) + +#define prim_origin_field(a) (a).hh.b1 + +#define prim_eq_type_field(a) (a).hh.b0 + +#define prim_equiv_field(a) (a).hh.rh + +/*tex Level of definition: */ + +#define prim_origin(a) prim_origin_field(prim_eqtb[(a)]) + +/*tex Command code for equivalent: */ + +#define prim_eq_type(a) prim_eq_type_field(prim_eqtb[(a)]) + +/*tex Equivalent value: */ + +#define prim_equiv(a) prim_equiv_field(prim_eqtb[(a)]) + +/*tex Allocation pointer for |prim|: */ + +static pointer prim_used; + +/*tex The primitives table: */ + +static two_halves prim[(prim_size + 1)]; + +static memory_word prim_eqtb[(prim_size + 1)]; + +/*tex + +The array |prim_data| works the other way around, it is used for cmd,chr -> name +lookups. + +*/ + +typedef struct prim_info { + /*tex Number of name entries: */ + halfword subids; + /*tex Offset to be used for |chr_code|s: */ + halfword offset; + /*tex Array of names: */ + str_number *names; +} prim_info; + +static prim_info prim_data[(last_cmd + 1)]; + +/*tex + +Initialize the memory arrays: + +*/ + +void init_primitives(void) +{ + int k; + memset(prim_data, 0, (sizeof(prim_info) * (last_cmd + 1))); + memset(prim, 0, (sizeof(two_halves) * (prim_size + 1))); + memset(prim_eqtb, 0, (sizeof(memory_word) * (prim_size + 1))); + for (k = 0; k <= prim_size; k++) { + prim_eq_type(k) = undefined_cs_cmd; + } +} + +/*tex Nothing is used (yet). */ + +void ini_init_primitives(void) +{ + prim_used = prim_size; +} + + +/*tex + +The value of |hash_prime| should be roughly 85\%! of |hash_size|, and it should +be a prime number. The theory of hashing tells us to expect fewer than two table +probes, on the average, when the search is successful. [See J.~S. Vitter, {\sl +Journal of the ACM\/ \bf30} (1983), 231--258.] @^Vitter, Jeffrey Scott@> + +*/ + +static halfword compute_hash(const char *j, unsigned int l, halfword prime_number) +{ + int k; + halfword h = (unsigned char) *j; + for (k = 1; k <= (int)(l - 1); k++) { + h = h + h + (unsigned char) *(j + k); + while (h >= prime_number) { + h = h - prime_number; + } + } + return h; +} + +/*tex + +Here is the subroutine that searches the primitive table for an identifier. + +*/ + +pointer prim_lookup(str_number s) +{ + /*tex The hash code: */ + int h; + /*tex The index in the |hash| array: */ + pointer p; + unsigned char *j; + unsigned l; + if (s < STRING_OFFSET) { + p = s; + if ((p < 0) || (get_prim_eq_type(p) == undefined_cs_cmd)) { + p = undefined_primitive; + } + } else { + j = str_string(s); + l = (unsigned) str_length(s); + h = compute_hash((char *) j, l, prim_prime); + /*tex We start searching here; note that |0<=h<hash_prime|. */ + p = h + prim_base; + while (1) { + if (prim_text(p) > 0) + if (str_length(prim_text(p)) == l) + if (str_eq_str(prim_text(p), s)) + goto FOUND; + if (prim_next(p) == 0) { + if (no_new_control_sequence) { + p = undefined_primitive; + } else { + /*tex Insert a new primitive after |p|, then make |p| point to it. */ + if (prim_text(p) > 0) { + do { + /*tex Search for an empty location in |prim| */ + if (prim_is_full) { + overflow("primitive size", prim_size); + } + decr(prim_used); + } while (prim_text(prim_used) != 0); + prim_next(p) = prim_used; + p = prim_used; + } + prim_text(p) = s; + } + goto FOUND; + } + p = prim_next(p); + } + } + FOUND: + return p; +} + +/*tex + +How to test a csname for primitive-ness? + +*/ + +boolean is_primitive(str_number csname) +{ + int n, m; + char *ss; + m = prim_lookup(csname); + ss = makecstring(csname); + n = string_lookup(ss, str_length(csname)); + free(ss); + return ((n != undefined_cs_cmd) && (m != undefined_primitive) && + (eq_type(n) == prim_eq_type(m)) && (equiv(n) == prim_equiv(m))); +} + + +/*tex + +A few simple accessors. + +*/ + +quarterword get_prim_eq_type(int p) +{ + return prim_eq_type(p); +} + +quarterword get_prim_origin(int p) +{ + return prim_origin(p); +} + +halfword get_prim_equiv(int p) +{ + return prim_equiv(p); +} + +str_number get_prim_text(int p) +{ + return prim_text(p); +} + + +/*tex + +Dumping and undumping. + +*/ + +void dump_primitives(void) +{ + int p, q; + for (p = 0; p <= prim_size; p++) { + dump_hh(prim[p]); + } + for (p = 0; p <= prim_size; p++) { + dump_wd(prim_eqtb[p]); + } + for (p = 0; p <= last_cmd; p++) { + dump_int(prim_data[p].offset); + dump_int(prim_data[p].subids); + for (q = 0; q < prim_data[p].subids; q++) { + dump_int(prim_data[p].names[q]); + } + } +} + +void undump_primitives(void) +{ + int p, q; + for (p = 0; p <= prim_size; p++) { + undump_hh(prim[p]); + } + for (p = 0; p <= prim_size; p++) { + undump_wd(prim_eqtb[p]); + } + for (p = 0; p <= last_cmd; p++) { + undump_int(prim_data[p].offset); + undump_int(prim_data[p].subids); + if (prim_data[p].subids > 0) { + prim_data[p].names = (str_number *) xmalloc((unsigned) ((unsigned) prim_data[p].subids * sizeof(str_number *))); + for (q = 0; q < prim_data[p].subids; q++) { + undump_int(prim_data[p].names[q]); + } + } + } +} + +/*tex + +We need to put \TeX's ``primitive'' control sequences into the hash table, +together with their command code (which will be the |eq_type|) and an operand +(which will be the |equiv|). The |primitive| procedure does this, in a way that +no \TeX\ user can. The global value |cur_val| contains the new |eqtb| pointer +after |primitive| has acted. + +Because the definitions of the actual user-accessible name of a primitive can be +postponed until runtime, the function |primitive_def| is needed that does nothing +except creating the control sequence name. + +*/ + +void primitive_def(const char *s, size_t l, quarterword c, halfword o) +{ + int nncs = no_new_control_sequence; + no_new_control_sequence = false; + /*tex This creates the |text()| string: */ + cur_val = string_lookup(s, l); + no_new_control_sequence = nncs; + eq_level(cur_val) = level_one; + eq_type(cur_val) = c; + equiv(cur_val) = o; +} + +/*tex + +The function |store_primitive_name| sets up the bookkeeping for the reverse +lookup. It is quite paranoid, because it is easy to mess this up accidentally. + +The |offset| is needed because sometimes character codes (in |o|) are indices +into |eqtb| or are offset by a magical value to make sure they do not conflict +with something else. We don't want the |prim_data[c].names| to have too many +entries as it will just be wasted room, so |offset| is substracted from |o| +because creating or accessing the array. The |assert(idx<=0xFFFF)| is not +strictly needed, but it helps catch errors of this kind. + +*/ + +static void store_primitive_name(str_number s, quarterword c, halfword o, halfword offset) +{ + int idx; + /* + if (prim_data[c].offset != 0 && prim_data[c].offset != offset) { + assert(false); + } + */ + prim_data[c].offset = offset; + idx = ((int) o - offset); + /* + assert(idx >= 0); + assert(idx <= 0xFFFF); + */ + if (prim_data[c].subids < (idx + 1)) { + str_number *new = (str_number *) xcalloc((unsigned) (idx + 1), sizeof(str_number *)); + if (prim_data[c].names != NULL) { + /* + assert(prim_data[c].subids); + */ + memcpy(new, (prim_data[c].names), (unsigned) (prim_data[c].subids) * sizeof(str_number)); + free(prim_data[c].names); + } + prim_data[c].names = new; + prim_data[c].subids = idx + 1; + } + prim_data[c].names[idx] = s; +} + +/*tex + +Compared to tex82, |primitive| has two extra parameters. The |off| is an offset +that will be passed on to |store_primitive_name|, the |cmd_origin| is the bit +that is used to group primitives by originator. + +*/ + +void primitive(const char *thes, quarterword c, halfword o, halfword off, int cmd_origin) +{ + /*tex Needed to fill |prim_eqtb|: */ + int prim_val; + str_number ss; + ss = maketexstring(thes); + if (cmd_origin == tex_command || cmd_origin == core_command) { + primitive_def(thes, strlen(thes), c, o); + } + prim_val = prim_lookup(ss); + prim_origin(prim_val) = (quarterword) cmd_origin; + prim_eq_type(prim_val) = c; + prim_equiv(prim_val) = o; + store_primitive_name(ss, c, o, off); +} + +/*tex + +Here is a helper that does the actual hash insertion. This code far from ideal: +the existance of |hash_extra| changes all the potential (short) coalesced lists +into a single (long) one. This will create a slowdown. + +*/ + +static halfword insert_id(halfword p, const unsigned char *j, unsigned int l) +{ + unsigned saved_cur_length; + unsigned saved_cur_string_size; + unsigned char *saved_cur_string; + const unsigned char *k; + if (cs_text(p) > 0) { + if (hash_high < hash_extra) { + incr(hash_high); + /*tex + Can't we use |eqtb_top| here (perhaps because that is not + finalized yet when called from |primitive|? + */ + cs_next(p) = hash_high + eqtb_size; + p = cs_next(p); + } else { + /*tex + Search for an empty location in |hash|. + */ + do { + if (hash_is_full) + overflow("hash size", (unsigned) (hash_size + hash_extra)); + decr(hash_used); + } while (cs_text(hash_used) != 0); + cs_next(p) = hash_used; + p = hash_used; + } + } + saved_cur_length = cur_length; + saved_cur_string = cur_string; + saved_cur_string_size = cur_string_size; + reset_cur_string(); + for (k = j; k <= j + l - 1; k++) { + append_char(*k); + } + cs_text(p) = make_string(); + cur_length = saved_cur_length; + xfree(cur_string); + cur_string = saved_cur_string; + cur_string_size = saved_cur_string_size; + incr(cs_count); + return p; +} + + +/*tex + +Here is the subroutine that searches the hash table for an identifier that +matches a given string of length |l>1| appearing in |buffer[j.. (j+l-1)]|. If the +identifier is found, the corresponding hash table address is returned. Otherwise, +if the global variable |no_new_control_sequence| is |true|, the dummy address +|undefined_control_sequence| is returned. Otherwise the identifier is inserted +into the hash table and its location is returned. + +*/ + +pointer id_lookup(int j, int l) +{ + /*tex The hash code: */ + int h; + /*tex The index in |hash| array: */ + pointer p; + h = compute_hash((char *) (buffer + j), (unsigned) l, hash_prime); + /*tex We start searching here. Note that |0<=h<hash_prime|: */ + p = h + hash_base; + while (1) { + if (cs_text(p) > 0) + if (str_length(cs_text(p)) == (unsigned) l) + if (str_eq_buf(cs_text(p), j)) + goto FOUND; + if (cs_next(p) == 0) { + if (no_new_control_sequence) { + p = undefined_control_sequence; + } else { + p = insert_id(p, (buffer + j), (unsigned) l); + } + goto FOUND; + } + p = cs_next(p); + } + FOUND: + return p; +} + +/*tex + +Here is a similar subroutine for finding a primitive in the hash. +This one is based on a C string. + +*/ + +pointer string_lookup(const char *s, size_t l) +{ + /*tex The hash code: */ + int h; + /*tex The index in |hash| array: */ + pointer p; + h = compute_hash(s, (unsigned) l, hash_prime); + /*tex We start searching here. Note that |0<=h<hash_prime|: */ + p = h + hash_base; + while (1) { + if (cs_text(p) > 0) + if (str_eq_cstr(cs_text(p), s, l)) + goto FOUND; + if (cs_next(p) == 0) { + if (no_new_control_sequence) { + p = undefined_control_sequence; + } else { + p = insert_id(p, (const unsigned char *) s, (unsigned) l); + } + goto FOUND; + } + p = cs_next(p); + } + FOUND: + return p; +} + +/*tex + +The |print_cmd_chr| routine prints a symbolic interpretation of a command code +and its modifier. This is used in certain `\.{You can\'t}' error messages, and in +the implementation of diagnostic routines like \.{\\show}. + +The body of |print_cmd_chr| use to be a rather tedious listing of print commands, +and most of it was essentially an inverse to the |primitive| routine that enters +a \TeX\ primitive into |eqtb|. + +Thanks to |prim_data|, there is no need for all that tediousness. What is left of +|primt_cnd_chr| are just the exceptions to the general rule that the +|cmd,chr_code| pair represents in a single primitive command. + +*/ + +#define chr_cmd(A) do { tprint(A); print(chr_code); } while (0) + +static void prim_cmd_chr(quarterword cmd, halfword chr_code) +{ + int idx = chr_code - prim_data[cmd].offset; + if (cmd <= last_cmd && + idx >= 0 && idx < prim_data[cmd].subids && + prim_data[cmd].names != NULL && prim_data[cmd].names[idx] != 0) { + tprint_esc(""); + print(prim_data[cmd].names[idx]); + } else { + /* \TEX82 didn't print the |cmd,idx| information, but it may be useful. */ + tprint("[unknown command code! ("); + print_int(cmd); + tprint(", "); + print_int(idx); + tprint(")]"); + } +} + +void print_cmd_chr(quarterword cmd, halfword chr_code) +{ + int n; + switch (cmd) { + case left_brace_cmd: + chr_cmd("begin-group character "); + break; + case right_brace_cmd: + chr_cmd("end-group character "); + break; + case math_shift_cmd: + chr_cmd("math shift character "); + break; + case mac_param_cmd: + if (chr_code == tab_mark_cmd_code) + tprint_esc("alignmark"); + else + chr_cmd("macro parameter character "); + break; + case sup_mark_cmd: + chr_cmd("superscript character "); + break; + case sub_mark_cmd: + chr_cmd("subscript character "); + break; + case endv_cmd: + tprint("end of alignment template"); + break; + case spacer_cmd: + chr_cmd("blank space "); + break; + case letter_cmd: + chr_cmd("the letter "); + break; + case other_char_cmd: + chr_cmd("the character "); + break; + case tab_mark_cmd: + if (chr_code == span_code) + tprint_esc("span"); + else if (chr_code == tab_mark_cmd_code) + tprint_esc("aligntab"); + else + chr_cmd("alignment tab character "); + break; + case if_test_cmd: + if (chr_code >= unless_code) + tprint_esc("unless"); + prim_cmd_chr(cmd, (chr_code % unless_code)); + break; + case char_given_cmd: + tprint_esc("char"); + print_qhex(chr_code); + break; + case math_given_cmd: + /*tex + Okay, it's better for old macro packages that mess with meaning + to report a traditional value. A compromise. + */ + tprint_esc("mathchar"); + show_mathcode_value_old(chr_code); + break; + case xmath_given_cmd: + tprint_esc("Umathchar"); + show_mathcode_value(mathchar_from_integer(chr_code, umath_mathcode)); + break; + case lua_expandable_call_cmd: + tprint("expandable luacall "); + print_int(chr_code); + break; + case lua_local_call_cmd: + tprint("local luacall "); + print_int(chr_code); + break; + case lua_call_cmd: + tprint("luacall "); + print_int(chr_code); + break; + case set_font_cmd: + tprint("select font "); + tprint(font_name(chr_code)); + if (font_size(chr_code) != font_dsize(chr_code)) { + tprint(" at "); + print_scaled(font_size(chr_code)); + tprint("pt"); + } + break; + case undefined_cs_cmd: + tprint("undefined"); + break; + case call_cmd: + case long_call_cmd: + case outer_call_cmd: + case long_outer_call_cmd: + n = cmd - call_cmd; + if (token_info(token_link(chr_code)) == protected_token) + n = n + 4; + if (odd(n / 4)) + tprint_esc("protected"); + if (odd(n)) + tprint_esc("long"); + if (odd(n / 2)) + tprint_esc("outer"); + if (n > 0) + tprint(" "); + tprint("macro"); + break; + case assign_glue_cmd: + case assign_mu_glue_cmd: + if (chr_code < skip_base) { + prim_cmd_chr(cmd, chr_code); + } else if (chr_code < mu_skip_base) { + tprint_esc("skip"); + print_int(chr_code - skip_base); + } else { + tprint_esc("muskip"); + print_int(chr_code - mu_skip_base); + } + break; + case assign_toks_cmd: + if (chr_code >= toks_base) { + tprint_esc("toks"); + print_int(chr_code - toks_base); + } else { + prim_cmd_chr(cmd, chr_code); + } + break; + case assign_int_cmd: + if (chr_code < count_base) { + prim_cmd_chr(cmd, chr_code); + } else { + tprint_esc("count"); + print_int(chr_code - count_base); + } + break; + case assign_attr_cmd: + tprint_esc("attribute"); + print_int(chr_code - attribute_base); + break; + case assign_dimen_cmd: + if (chr_code < scaled_base) { + prim_cmd_chr(cmd, chr_code); + } else { + tprint_esc("dimen"); + print_int(chr_code - scaled_base); + } + break; + case normal_cmd: + if (chr_code < prim_data[cmd].subids && prim_data[cmd].names[chr_code] != 0) { + prim_cmd_chr(cmd, chr_code); + } else { + tprint("[unknown command! ("); + print_int(chr_code); + tprint(")]"); + } + break; + case extension_cmd: + if (chr_code < prim_data[cmd].subids && prim_data[cmd].names[chr_code] != 0) { + prim_cmd_chr(cmd, chr_code); + } else { + tprint("[unknown extension! ("); + print_int(chr_code); + tprint(")]"); + + } + break; + case node_cmd: + tprint("node "); + print_int(chr_code); + break; + default: + /*tex These are most commands, actually. */ + prim_cmd_chr(cmd, chr_code); + break; + } +} |