/* primitive.w Copyright 2008-2010 Taco Hoekwater 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 . */ #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 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 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 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; } }