summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/luatexdir/tex/primitive.c
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/luatexdir/tex/primitive.c')
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/primitive.c785
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;
+ }
+}