diff options
Diffstat (limited to 'Build/source/texk/web2c/omegadir-1.15/om16bit.ch')
| -rw-r--r-- | Build/source/texk/web2c/omegadir-1.15/om16bit.ch | 2635 |
1 files changed, 0 insertions, 2635 deletions
diff --git a/Build/source/texk/web2c/omegadir-1.15/om16bit.ch b/Build/source/texk/web2c/omegadir-1.15/om16bit.ch deleted file mode 100644 index 12d8b49d023..00000000000 --- a/Build/source/texk/web2c/omegadir-1.15/om16bit.ch +++ /dev/null @@ -1,2635 +0,0 @@ -% om16bit.ch: Basic changes to TeX data structures allowing all -% 8-bit entities to become 32-bit entities, in particular -% characters and glyphs. -% -% This file is part of Omega, -% which is based on the web2c distribution of TeX, -% -% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous -% -% This library is free software; you can redistribute it and/or -% modify it under the terms of the GNU Library General Public -% License as published by the Free Software Foundation; either -% version 2 of the License, or (at your option) any later version. -% -% This library 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 -% Library General Public License for more details. -% -% You should have received a copy of the GNU Library General Public -% License along with this library; if not, write to the Free Software -% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -% -@x limbo l.1 - Omega -% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved. -@y -% This program is copyright -% (C) 1994--2000 by John Plaice and Yannis Haralambous. -% It is designed to be a change file for D. E. Knuth's TeX version 3.141592. -% -% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved. -@z -%--------------------------------------- -@x limbo l.80 -\def\title{\TeX82} -@y -\def\title{$\Omega$ (OMEGA)} -@z -%--------------------------------------- -@x [1] m.1 l.90 - Omega -This is \TeX, a document compiler intended to produce typesetting of high -quality. -The \PASCAL\ program that follows is the definition of \TeX82, a standard -@:PASCAL}{\PASCAL@> -@!@:TeX82}{\TeX82@> -@y -This is $\Omega$, a document compiler intended to simplify high-quality -typesetting for many of the world's languages. It is an extension -of D. E. Knuth's \TeX, which was designed essentially for the -typesetting of languages using the Latin alphabet. - -The $\Omega$ system loosens many of the restrictions imposed by~\TeX: -register numbers are no longer limited to 8~bits; fonts may have more -than 256~characters; more than 256~fonts may be used; etc. In addition, -$\Omega$ allows much more complex ligature mechanisms between characters, -thereby simplifying the typesetting of alphabets that have preserved -their calligraphic traditions. - -The \PASCAL\ program that follows is a modification of the definition of \TeX82, -a standard @:PASCAL}{\PASCAL@> @!@:TeX82}{\TeX82@> -@z -%--------------------------------------- -@x [1] m.1 l.97 - Omega -will be obtainable on a great variety of computers. - -@y -will be obtainable on a great variety of computers. - -As little as possible is changed in this document. This means that -unless the contrary is explicitly stated, references to \TeX\ in the -documentation are equally applicable to~$\Omega$. References to `the -author' in the documentation are to D. E. Knuth. - -@z -%--------------------------------------- -@x [1] m.2 l.187 - Omega -@d banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts} -@y -@d banner=='This is Omega, Version 3.141592--1.15' {printed when \TeX\ starts} -@z -%--------------------------------------- -@x [1] m.4 l.243 -program TEX; {all file names are defined dynamically} -@y -program OMEGA; {all file names are defined dynamically} -@z -%--------------------------------------- -@x [1] m.11 l.392 - Omega -@!font_max=75; {maximum internal font number; must not exceed |max_quarterword| - and must be at most |font_base+256|} -@!font_mem_size=20000; {number of words of |font_info| for all fonts} -@y -@!font_max=65535; {maximum internal font number; must be at most |font_biggest|} -@z -%--------------------------------------- -@x [1] m.11 l.412 - Omega -@!pool_name='TeXformats:TEX.POOL '; -@y -@!pool_name='TeXformats:OMEGA.POOL '; -@z -%--------------------------------------- -@x [1] m.12 l.437 - Omega -@d hash_size=2100 {maximum number of control sequences; it should be at most - about |(mem_max-mem_min)/10|} -@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} -@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} -@y -@d hash_size=65536 {maximum number of control sequences; it should be at most - about |(mem_max-mem_min)/10|} -@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|} -@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} -@d biggest_char=65535 {the largest allowed character number; - must be |<=max_quarterword|} -@d too_big_char=65536 {|biggest_char+1|} -@d special_char=65537 {|biggest_char+2|} -@d number_chars=65536 {|biggest_char+1|} -@d biggest_reg=65535 {the largest allowed register number; - must be |<=max_quarterword|} -@d number_regs=65536 {|biggest_reg+1|} -@d font_biggest=65535 {the real biggest font} -@d number_fonts=font_biggest-font_base+2 -@d number_math_fonts=768 -@d math_font_biggest=767 -@d text_size=0 {size code for the largest size in a family} -@d script_size=256 {size code for the medium size in a family} -@d script_script_size=512 {size code for the smallest size in a family} -@d biggest_lang=255 -@d too_big_lang=256 -@z -%--------------------------------------- -@x [8] m.110 l.2355 - Omega -In order to make efficient use of storage space, \TeX\ bases its major data -structures on a |memory_word|, which contains either a (signed) integer, -possibly scaled, or a (signed) |glue_ratio|, or a small number of -fields that are one half or one quarter of the size used for storing -integers. - -@y -In order to make efficient use of storage space, \TeX\ bases its major data -structures on a |memory_word|, which contains either a (signed) integer, -possibly scaled, or a (signed) |glue_ratio|, or a small number of -fields that are one half or one quarter of the size used for storing -integers. - -That is the description for \TeX. For $\Omega$, we are going to keep -the same terminology, except that |quarterword| is going to refer to -16~bits, and |halfword| is going to refer to 32~bits. So, in fact, -a |memory_word| will take 64 bits, and, on a 64-bit machine, will run -smaller than \TeX\ will! - -@z -%--------------------------------------- -@x [8] m.110 l.2378 - Omega -Since we are assuming 32-bit integers, a halfword must contain at least -16 bits, and a quarterword must contain at least 8 bits. -@^system dependencies@> -But it doesn't hurt to have more bits; for example, with enough 36-bit -words you might be able to have |mem_max| as large as 262142, which is -eight times as much memory as anybody had during the first four years of -\TeX's existence. - -N.B.: Valuable memory space will be dreadfully wasted unless \TeX\ is compiled -by a \PASCAL\ that packs all of the |memory_word| variants into -the space of a single integer. This means, for example, that |glue_ratio| -words should be |short_real| instead of |real| on some computers. Some -\PASCAL\ compilers will pack an integer whose subrange is `|0..255|' into -an eight-bit field, but others insist on allocating space for an additional -sign bit; on such systems you can get 256 values into a quarterword only -if the subrange is `|-128..127|'. - -@y -@z -%--------------------------------------- -@x [8] m.110 l.2406 - Omega -@d max_quarterword=255 {largest allowable value in a |quarterword|} -@d min_halfword==0 {smallest allowable value in a |halfword|} -@d max_halfword==65535 {largest allowable value in a |halfword|} -@y -@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|} -@d min_halfword=0 {smallest allowable value in a |halfword|} -@d max_halfword=@"3FFFFFFF {largest allowable value in a |halfword|} -@z -%--------------------------------------- -@x [8] m.111 l.2416 - Omega -if (min_quarterword>0)or(max_quarterword<127) then bad:=11; -if (min_halfword>0)or(max_halfword<32767) then bad:=12; -@y -if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11; -if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12; -@z -%--------------------------------------- -@x [8] m.111 l.2423 - Omega -if font_max>font_base+256 then bad:=16; -@y -if font_max>font_base+@"10000 then bad:=16; -@z -%--------------------------------------- -@x [8] m.111 l.2426 - Omega -if max_quarterword-min_quarterword<255 then bad:=19; -@y -if max_quarterword-min_quarterword<@"FFFF then bad:=19; -@z -%--------------------------------------- -@x [10] m.134 l.2832 - Omega -Note that the format of a |char_node| allows for up to 256 different -fonts and up to 256 characters per font; but most implementations will -probably limit the total number of fonts to fewer than 75 per job, -and most fonts will stick to characters whose codes are -less than 128 (since higher codes -are more difficult to access on most keyboards). - -Extensions of \TeX\ intended for oriental languages will need even more -than $256\times256$ possible characters, when we consider different sizes -@^oriental characters@>@^Chinese characters@>@^Japanese characters@> -and styles of type. It is suggested that Chinese and Japanese fonts be -handled by representing such characters in two consecutive |char_node| -entries: The first of these has |font=font_base|, and its |link| points -to the second; -the second identifies the font and the character dimensions. -The saving feature about oriental characters is that most of them have -the same box dimensions. The |character| field of the first |char_node| -is a ``\\{charext}'' that distinguishes between graphic symbols whose -dimensions are identical for typesetting purposes. (See the \MF\ manual.) -Such an extension of \TeX\ would not be difficult; further details are -left to the reader. -@y -Note that the format of a |char_node| allows for up to 65536 different -fonts and up to 65536 characters per font. -@z -%--------------------------------------- -@x [15] m.208 l.4127 - Omega -@d min_internal=68 {the smallest code that can follow \.{\\the}} -@d char_given=68 {character code defined by \.{\\chardef}} -@d math_given=69 {math code defined by \.{\\mathchardef}} -@d last_item=70 {most recent item ( \.{\\lastpenalty}, - \.{\\lastkern}, \.{\\lastskip} )} -@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}} -@y -@d min_internal=end_cs_name+1 {the smallest code that can follow \.{\\the}} -@d char_given=min_internal {character code defined by \.{\\chardef}} -@d math_given=char_given+1 {math code defined by \.{\\mathchardef}} -@d omath_given=math_given+1 {math code defined by \.{\\omathchardef}} -@d last_item=omath_given+1 {most recent item ( \.{\\lastpenalty}, - \.{\\lastkern}, \.{\\lastskip} )} -@d max_non_prefixed_command=last_item - {largest command code that can't be \.{\\global}} -@z -%--------------------------------------- -@x [15] m.209 l.4138 - Omega -@d toks_register=71 {token list register ( \.{\\toks} )} -@d assign_toks=72 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)} -@d assign_int=73 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)} -@d assign_dimen=74 {user-defined length ( \.{\\hsize}, etc.~)} -@d assign_glue=75 {user-defined glue ( \.{\\baselineskip}, etc.~)} -@d assign_mu_glue=76 {user-defined muglue ( \.{\\thinmuskip}, etc.~)} -@d assign_font_dimen=77 {user-defined font dimension ( \.{\\fontdimen} )} -@d assign_font_int=78 {user-defined font integer ( \.{\\hyphenchar}, - \.{\\skewchar} )} -@d set_aux=79 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )} -@d set_prev_graf=80 {specify state info ( \.{\\prevgraf} )} -@d set_page_dimen=81 {specify state info ( \.{\\pagegoal}, etc.~)} -@d set_page_int=82 {specify state info ( \.{\\deadcycles}, - \.{\\insertpenalties} )} -@d set_box_dimen=83 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )} -@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )} -@d def_code=85 {define a character code ( \.{\\catcode}, etc.~)} -@d def_family=86 {declare math fonts ( \.{\\textfont}, etc.~)} -@d set_font=87 {set current font ( font identifiers )} -@d def_font=88 {define a font file ( \.{\\font} )} -@d register=89 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)} -@d max_internal=89 {the largest code that can follow \.{\\the}} -@d advance=90 {advance a register or parameter ( \.{\\advance} )} -@d multiply=91 {multiply a register or parameter ( \.{\\multiply} )} -@d divide=92 {divide a register or parameter ( \.{\\divide} )} -@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} -@d let=94 {assign a command code ( \.{\\let}, \.{\\futurelet} )} -@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} -@d read_to_cs=96 {read into a control sequence ( \.{\\read} )} -@d def=97 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )} -@d set_box=98 {set a box ( \.{\\setbox} )} -@d hyph_data=99 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )} -@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)} -@d max_command=100 {the largest command code seen at |big_switch|} -@y -@d toks_register=max_non_prefixed_command+1 - {token list register ( \.{\\toks} )} -@d assign_toks=toks_register+1 - {special token list ( \.{\\output}, \.{\\everypar}, etc.~)} -@d assign_int=assign_toks+1 - {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)} -@d assign_dimen=assign_int+1 - {user-defined length ( \.{\\hsize}, etc.~)} -@d assign_glue=assign_dimen+1 - {user-defined glue ( \.{\\baselineskip}, etc.~)} -@d assign_mu_glue=assign_glue+1 - {user-defined muglue ( \.{\\thinmuskip}, etc.~)} -@d assign_font_dimen=assign_mu_glue+1 - {user-defined font dimension ( \.{\\fontdimen} )} -@d assign_font_int=assign_font_dimen+1 - {user-defined font integer ( \.{\\hyphenchar}, \.{\\skewchar} )} -@d set_aux=assign_font_int+1 - {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )} -@d set_prev_graf=set_aux+1 - {specify state info ( \.{\\prevgraf} )} -@d set_page_dimen=set_prev_graf+1 - {specify state info ( \.{\\pagegoal}, etc.~)} -@d set_page_int=set_page_dimen+1 - {specify state info ( \.{\\deadcycles}, - \.{\\insertpenalties} )} -@d set_box_dimen=set_page_int+1 - {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )} -@d set_shape=set_box_dimen+1 - {specify fancy paragraph shape ( \.{\\parshape} )} -@d def_code=set_shape+1 - {define a character code ( \.{\\catcode}, etc.~)} -@d def_family=def_code+1 - {declare math fonts ( \.{\\textfont}, etc.~)} -@d set_font=def_family+1 - {set current font ( font identifiers )} -@d def_font=set_font+1 - {define a font file ( \.{\\font} )} -@d register=def_font+1 - {internal register ( \.{\\count}, \.{\\dimen}, etc.~)} -@d max_internal=register - {the largest code that can follow \.{\\the}} -@d advance=max_internal+1 - {advance a register or parameter ( \.{\\advance} )} -@d multiply=advance+1 - {multiply a register or parameter ( \.{\\multiply} )} -@d divide=multiply+1 - {divide a register or parameter ( \.{\\divide} )} -@d prefix=divide+1 - {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} -@d let=prefix+1 - {assign a command code ( \.{\\let}, \.{\\futurelet} )} -@d shorthand_def=let+1 - {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} -@d read_to_cs=shorthand_def+1 - {read into a control sequence ( \.{\\read} )} -@d def=read_to_cs+1 - {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )} -@d set_box=def+1 - {set a box ( \.{\\setbox} )} -@d hyph_data=set_box+1 - {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )} -@d set_interaction=hyph_data+1 - {define level of interaction ( \.{\\batchmode}, etc.~)} -@d max_command=set_interaction - {the largest command code seen at |big_switch|} -@z -%--------------------------------------- -@x [17] m.220 l.4486 - Omega -@d eq_level(#)==eq_level_field(eqtb[#]) {level of definition} -@d eq_type(#)==eq_type_field(eqtb[#]) {command code for equivalent} -@d equiv(#)==equiv_field(eqtb[#]) {equivalent value} -@y -@d eq_level(#)==new_eq_level(#) {level of definition} -@d eq_type(#)==new_eq_type(#) {command code for equivalent} -@d equiv(#)==new_equiv(#) {equivalent value} -@d equiv1(#)==new_equiv1(#) {equivalent value} -@z -%--------------------------------------- -@x [17] m.222 l.4496 - Omega -In the first region we have 256 equivalents for ``active characters'' that -act as control sequences, followed by 256 equivalents for single-character -control sequences. -@y -In the first region we have |number_chars| equivalents for ``active characters'' -that act as control sequences, followed by |number_chars| equivalents for -single-character control sequences. -@z -%--------------------------------------- -@x [17] m.222 l.4507 - Omega -@d single_base=active_base+256 {equivalents of one-character control sequences} -@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}} -@y -@d single_base=active_base+number_chars - {equivalents of one-character control sequences} -@d null_cs=single_base+number_chars {equivalent of \.{\\csname\\endcsname}} -@z -%--------------------------------------- -@x [17] m.222 l.4530 - Omega -eq_type(undefined_control_sequence):=undefined_cs; -equiv(undefined_control_sequence):=null; -eq_level(undefined_control_sequence):=level_zero; -for k:=active_base to undefined_control_sequence-1 do - eqtb[k]:=eqtb[undefined_control_sequence]; -@y -set_eq_type(undefined_control_sequence,undefined_cs); -set_equiv(undefined_control_sequence,null); -set_eq_level(undefined_control_sequence,level_zero); -@z -%--------------------------------------- -@x [17] m.224 l.4547 - Omega -@ Region 3 of |eqtb| contains the 256 \.{\\skip} registers, as well as the -glue parameters defined here. It is important that the ``muskip'' -parameters have larger numbers than the others. -@y -@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers, -as well as the glue parameters defined here. It is important that the -``muskip'' parameters have larger numbers than the others. -@z -%--------------------------------------- -@x [17] m.224 l.4572 - Omega -@d skip_base=glue_base+glue_pars {table of 256 ``skip'' registers} -@d mu_skip_base=skip_base+256 {table of 256 ``muskip'' registers} -@d local_base=mu_skip_base+256 {beginning of region 4} -@y -@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers} -@d mu_skip_base=skip_base+number_regs - {table of |number_regs| ``muskip'' registers} -@d local_base=mu_skip_base+number_regs {beginning of region 4} -@z -%--------------------------------------- -@x [17] m.228 l.4685 - Omega -equiv(glue_base):=zero_glue; eq_level(glue_base):=level_one; -eq_type(glue_base):=glue_ref; -for k:=glue_base+1 to local_base-1 do eqtb[k]:=eqtb[glue_base]; -@y -set_equiv(glue_base,zero_glue); set_eq_level(glue_base,level_one); -set_eq_type(glue_base,glue_ref); -@z -%--------------------------------------- -@x [17] m.230 l.4721 - Omega -@d toks_base=local_base+10 {table of 256 token list registers} -@d box_base=toks_base+256 {table of 256 box registers} -@d cur_font_loc=box_base+256 {internal font number outside math mode} -@d math_font_base=cur_font_loc+1 {table of 48 math font numbers} -@d cat_code_base=math_font_base+48 - {table of 256 command codes (the ``catcodes'')} -@d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings} -@d uc_code_base=lc_code_base+256 {table of 256 uppercase mappings} -@d sf_code_base=uc_code_base+256 {table of 256 spacefactor mappings} -@d math_code_base=sf_code_base+256 {table of 256 math mode mappings} -@d int_base=math_code_base+256 {beginning of region 5} -@y -@d toks_base=local_base+10 {table of |number_regs| token list registers} -@d box_base=toks_base+number_regs {table of |number_regs| box registers} -@d cur_font_loc=box_base+number_regs {internal font number outside math mode} -@d math_font_base=cur_font_loc+1 - {table of |number_math_fonts| math font numbers} -@d cat_code_base=math_font_base+number_math_fonts - {table of |number_chars| command codes (the ``catcodes'')} -@d lc_code_base=cat_code_base+number_chars - {table of |number_chars| lowercase mappings} -@d uc_code_base=lc_code_base+number_chars - {table of |number_chars| uppercase mappings} -@d sf_code_base=uc_code_base+number_chars - {table of |number_chars| spacefactor mappings} -@d math_code_base=sf_code_base+number_chars - {table of |number_chars| math mode mappings} -@d int_base=math_code_base+number_chars {beginning of region 5} -@z -%--------------------------------------- -@x [17] m.232 l.4802 - Omega -@d var_code==@'70000 {math code meaning ``use the current family''} - -@<Initialize table entries...@>= -par_shape_ptr:=null; eq_type(par_shape_loc):=shape_ref; -eq_level(par_shape_loc):=level_one;@/ -for k:=output_routine_loc to toks_base+255 do - eqtb[k]:=eqtb[undefined_control_sequence]; -box(0):=null; eq_type(box_base):=box_ref; eq_level(box_base):=level_one; -for k:=box_base+1 to box_base+255 do eqtb[k]:=eqtb[box_base]; -cur_font:=null_font; eq_type(cur_font_loc):=data; -eq_level(cur_font_loc):=level_one;@/ -for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc]; -equiv(cat_code_base):=0; eq_type(cat_code_base):=data; -eq_level(cat_code_base):=level_one;@/ -for k:=cat_code_base+1 to int_base-1 do eqtb[k]:=eqtb[cat_code_base]; -for k:=0 to 255 do - begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000; - end; -cat_code(carriage_return):=car_ret; cat_code(" "):=spacer; -cat_code("\"):=escape; cat_code("%"):=comment; -cat_code(invalid_code):=invalid_char; cat_code(null_code):=ignore; -for k:="0" to "9" do math_code(k):=hi(k+var_code); -for k:="A" to "Z" do - begin cat_code(k):=letter; cat_code(k+"a"-"A"):=letter;@/ - math_code(k):=hi(k+var_code+@"100); - math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/ - lc_code(k):=k+"a"-"A"; lc_code(k+"a"-"A"):=k+"a"-"A";@/ - uc_code(k):=k; uc_code(k+"a"-"A"):=k;@/ - sf_code(k):=999; - end; -@y -@d var_code==@"7000000 {math code meaning ``use the current family''} - -@<Initialize table entries...@>= -set_equiv(par_shape_loc,null); set_eq_type(par_shape_loc,shape_ref); -set_eq_level(par_shape_loc,level_one);@/ -set_equiv(cat_code_base+carriage_return,car_ret); -set_equiv(cat_code_base+" ",spacer); -set_equiv(cat_code_base+"\",escape); -set_equiv(cat_code_base+"%",comment); -set_equiv(cat_code_base+invalid_code,invalid_char); -set_equiv(cat_code_base+null_code,ignore); -for k:="0" to "9" do set_equiv(math_code_base+k,hi(k+var_code)); -for k:="A" to "Z" do - begin set_equiv(cat_code_base+k,letter); - set_equiv(cat_code_base+k+"a"-"A",letter);@/ - set_equiv(math_code_base+k,hi(k+var_code+@"10000)); - set_equiv(math_code_base+k+"a"-"A",hi(k+"a"-"A"+var_code+@"10000));@/ - set_equiv(lc_code_base+k,k+"a"-"A"); - set_equiv(lc_code_base+k+"a"-"A",k+"a"-"A");@/ - set_equiv(uc_code_base+k,k); - set_equiv(uc_code_base+k+"a"-"A",k);@/ - set_equiv(sf_code_base+k,999); - end; -@z -%--------------------------------------- -@x [17] m.234 l.4857 - Omega -@ @<Show the font identifier in |eqtb[n]|@>= -begin if n=cur_font_loc then print("current font") -else if n<math_font_base+16 then - begin print_esc("textfont"); print_int(n-math_font_base); - end -else if n<math_font_base+32 then - begin print_esc("scriptfont"); print_int(n-math_font_base-16); - end -else begin print_esc("scriptscriptfont"); print_int(n-math_font_base-32); - end; -print_char("=");@/ -print_esc(hash[font_id_base+equiv(n)].rh); - {that's |font_id_text(equiv(n))|} -@y -@ @<Show the font identifier in |eqtb[n]|@>= -begin if n=cur_font_loc then print("current font") -else if n<math_font_base+script_size then - begin print_esc("textfont"); print_int(n-math_font_base); - end -else if n<math_font_base+script_script_size then - begin print_esc("scriptfont"); print_int(n-math_font_base-script_size); - end -else begin print_esc("scriptscriptfont"); - print_int(n-math_font_base-script_script_size); - end; -print_char("=");@/ -print_esc(newtext(font_id_base+equiv(n))); - {that's |font_id_text(equiv(n))|} -@z -%--------------------------------------- -@x [17] m.236 l.4955 - Omega -@d count_base=int_base+int_pars {256 user \.{\\count} registers} -@d del_code_base=count_base+256 {256 delimiter code mappings} -@d dimen_base=del_code_base+256 {beginning of region 6} -@# -@d del_code(#)==eqtb[del_code_base+#].int -@d count(#)==eqtb[count_base+#].int -@d int_par(#)==eqtb[int_base+#].int {an integer parameter} -@y -@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers} -@d del_code_base=count_base+number_regs {|number_chars| delimiter code mappings} -@d dimen_base=del_code_base+number_chars {beginning of region 6} -@# -@d del_code0(#)==new_equiv(del_code_base+#) -@d del_code1(#)==new_equiv1(del_code_base+#) -@d count(#)==new_eqtb_int(count_base+#) -@d int_par(#)==new_eqtb_int(int_base+#) {an integer parameter} -@z -%--------------------------------------- -@x [17] m.240 l.5213 - Omega -for k:=int_base to del_code_base-1 do eqtb[k].int:=0; -mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25; -escape_char:="\"; end_line_char:=carriage_return; -for k:=0 to 255 do del_code(k):=-1; -del_code("."):=0; {this null delimiter is used in error recovery} -@y -set_new_eqtb_int(int_base+mag_code,1000); -set_new_eqtb_int(int_base+tolerance_code,10000); -set_new_eqtb_int(int_base+hang_after_code,1); -set_new_eqtb_int(int_base+max_dead_cycles_code,25); -set_new_eqtb_int(int_base+escape_char_code,"\"); -set_new_eqtb_int(int_base+end_line_char_code,carriage_return); -set_equiv(del_code_base+".",0); -set_equiv1(del_code_base+".",0); - {this null delimiter is used in error recovery} - -@ @<Set newline character to -1@>= -set_new_eqtb_int(int_base+new_line_char_code,-1) - -@ @<Set newline character to nl@>= -set_new_eqtb_int(int_base+new_line_char_code,nl) - -@z -%--------------------------------------- -@x [17] m.242 l.5240 - Omega -print_char("="); print_int(eqtb[n].int); -@y -print_char("="); print_int(new_eqtb_int(n)); -@z -%--------------------------------------- -@x [17] m.247 l.5273 - Omega -here, and the 256 \.{\\dimen} registers. -@y -here, and the |number_regs| \.{\\dimen} registers. -@z -%--------------------------------------- -@x [17] m.247 l.5298 - Omega - {table of 256 user-defined \.{\\dimen} registers} -@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|} -@# -@d dimen(#)==eqtb[scaled_base+#].sc -@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity} -@y - {table of |number_regs| user-defined \.{\\dimen} registers} -@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|} -@# -@d dimen(#)==new_eqtb_sc(scaled_base+(#)) -@d dimen_par(#)==new_eqtb_sc(dimen_base+(#)) {a scaled quantity} -@z -%--------------------------------------- -@x [17] m.250 l.5405 - Omega -for k:=dimen_base to eqtb_size do eqtb[k].sc:=0; -@y - -@ @p function init_eqtb_entry (p:pointer):memory_word; -var mw:memory_word; -begin - { Regions 1 and 2 } - if (p>=active_base) and - (p<=undefined_control_sequence) then begin - equiv_field(mw):=null; - eq_type_field(mw):=undefined_cs; - eq_level_field(mw):=level_zero; - end - { Region 3 } - else if (p>=glue_base) and - (p<=local_base+1) then begin - equiv_field(mw):=zero_glue; - eq_type_field(mw):=glue_ref; - eq_level_field(mw):=level_one; - end - { Region 4 } - else if (p>=par_shape_loc) and - (p<=toks_base+biggest_reg) then begin - equiv_field(mw):=null; - eq_type_field(mw):=undefined_cs; - eq_level_field(mw):=level_zero; - end - else if (p>=box_base) and - (p<=box_base+biggest_reg) then begin - equiv_field(mw):=null; - eq_type_field(mw):=box_ref; - eq_level_field(mw):=level_one; - end - else if (p>=cur_font_loc) and - (p<=math_font_base+math_font_biggest) then begin - equiv_field(mw):=null_font; - eq_type_field(mw):=data; - eq_level_field(mw):=level_one; - end - else if (p>=cat_code_base) and - (p<=cat_code_base+biggest_char) then begin - equiv_field(mw):=other_char; - eq_type_field(mw):=data; - eq_level_field(mw):=level_one; - end - else if (p>=lc_code_base) and - (p<=uc_code_base+biggest_char) then begin - equiv_field(mw):=0; - eq_type_field(mw):=data; - eq_level_field(mw):=level_one; - end - else if (p>=sf_code_base) and - (p<=sf_code_base+biggest_char) then begin - equiv_field(mw):=1000; - eq_type_field(mw):=data; - eq_level_field(mw):=level_one; - end - else if (p>=math_code_base) and - (p<=math_code_base+biggest_char) then begin - equiv_field(mw):=hi(p-math_code_base); - eq_type_field(mw):=data; - eq_level_field(mw):=level_one; - end - { Region 5 } - else if (p>=int_base) and (p<=del_code_base-1) then begin - setintzero(mw,0); - setintone(mw,0); - end - else if (p>=del_code_base) and (p<=del_code_base+biggest_char) then begin - setintzero(mw,-1); - setintone(mw,-1); - end - { Region 6 } - else if (p>=dimen_base) and (p<=eqtb_size) then begin - setintzero(mw,0); - setintone(mw,0); - end - else begin - equiv_field(mw):=null; - eq_type_field(mw):=undefined_cs; - eq_level_field(mw):=level_zero; - end; - init_eqtb_entry:=mw; -end; - -@z -%--------------------------------------- -@x [17] m.251 l.5411 - Omega -print_char("="); print_scaled(eqtb[n].sc); print("pt"); -@y -print_char("="); print_scaled(new_eqtb_sc(n)); print("pt"); -@z -%--------------------------------------- -@x [17] m.254 l.5435 - Omega -@ The last two regions of |eqtb| have fullword values instead of the -three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary, -but \TeX\ needs to store the |eq_level| information in another array -called |xeq_level|. - -@<Glob...@>= -@!eqtb:array[active_base..eqtb_size] of memory_word; -@!xeq_level:array[int_base..eqtb_size] of quarterword; -@y -@ The last two regions of |eqtb| have fullword values instead of the -three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary, -but \TeX\ needs to store the |eq_level| information in another array -called |xeq_level|. - -@d xeq_level(#) == new_xeq_level(eqtb_size+eqtb_size+#) -@d set_xeq_level(#) == set_new_eqtb_int(eqtb_size+eqtb_size+#) -@z -%--------------------------------------- -@x [17] m.255 l.5439 - Omega -for k:=int_base to eqtb_size do xeq_level[k]:=level_one; -@y -@z -%--------------------------------------- -@x [17] m.255 l.5446 - Omega -for q:=active_base to box_base+255 do -@y -for q:=active_base to box_base+biggest_reg do -@z -%--------------------------------------- -@x [18] m.256 l.5477 - Omega -@d next(#) == hash[#].lh {link for coalesced lists} -@d text(#) == hash[#].rh {string number for control sequence name} -@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied} -@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name} - -@<Glob...@>= -@!hash: array[hash_base..undefined_control_sequence-1] of two_halves; - {the hash table} -@y -@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied} -@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name} -@d newtext(#) == new_hash_text(eqtb_size+#) -@d newnext(#) == new_hash_next(eqtb_size+#) -@d settext(#) == set_hash_text(eqtb_size+#) -@d setnext(#) == set_hash_next(eqtb_size+#) - -@<Glob...@>= -@z -%--------------------------------------- -@x [18] m.257 l.5491 - Omega -next(hash_base):=0; text(hash_base):=0; -for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base]; -@y -@z -%--------------------------------------- -@x [18] m.258 l.5497 - Omega -hash_used:=frozen_control_sequence; {nothing is used} -cs_count:=0; -eq_type(frozen_dont_expand):=dont_expand; -text(frozen_dont_expand):="notexpanded:"; -@y -hash_used:=frozen_control_sequence; {nothing is used} -cs_count:=0; -set_eq_type(frozen_dont_expand,dont_expand); -settext(frozen_dont_expand,"notexpanded:"); -@z -%--------------------------------------- -@x [18] m.259 l.5514 - Omega -@!k:pointer; {index in |buffer| array} -begin @<Compute the hash code |h|@>; -p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|} -loop@+begin if text(p)>0 then if length(text(p))=l then - if str_eq_buf(text(p),j) then goto found; - if next(p)=0 then - begin if no_new_control_sequence then - p:=undefined_control_sequence - else @<Insert a new control sequence after |p|, then make - |p| point to it@>; - goto found; - end; - p:=next(p); - end; -found: id_lookup:=p; -@y -@!k:pointer; {index in |buffer| array} -@!newstring:integer; -begin @<Compute the hash code |h|@>; -p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|} -loop@+begin if newtext(p)>0 then if length(newtext(p))=l then - if str_eq_buf(newtext(p),j) then goto found; - if newnext(p)=0 then - begin if no_new_control_sequence then - p:=undefined_control_sequence - else @<Insert a new control sequence after |p|, then make - |p| point to it@>; - goto found; - end; - p:=newnext(p); - end; -found: id_lookup:=p; -@z -%--------------------------------------- -@x [18] m.260 l.5532 - Omega -begin if text(p)>0 then - begin repeat if hash_is_full then overflow("hash size",hash_size); -@:TeX capacity exceeded hash size}{\quad hash size@> - decr(hash_used); - until text(hash_used)=0; {search for an empty location in |hash|} - next(p):=hash_used; p:=hash_used; - end; -str_room(l); d:=cur_length; -while pool_ptr>str_start[str_ptr] do - begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr]; - end; {move current string up to make room for another} -for k:=j to j+l-1 do append_char(buffer[k]); -text(p):=make_string; pool_ptr:=pool_ptr+d; -@y -begin if newtext(p)>0 then - begin repeat if hash_is_full then overflow("hash size",hash_size); -@:TeX capacity exceeded hash size}{\quad hash size@> - decr(hash_used); - until newtext(hash_used)=0; {search for an empty location in |hash|} - setnext(p,hash_used); p:=hash_used; - end; -str_room(l); d:=cur_length; -while pool_ptr>str_start[str_ptr] do - begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr]; - end; {move current string up to make room for another} -for k:=j to j+l-1 do append_char(buffer[k]); -newstring:=make_string; -settext(p,newstring); pool_ptr:=pool_ptr+d; -@z -%--------------------------------------- -@x [18] m.262 l.5584 - Omega -else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.") -@.NONEXISTENT@> -else begin print_esc(text(p)); -@y -else if (newtext(p)<0)or(newtext(p)>=str_ptr) then print_esc("NONEXISTENT.") -@.NONEXISTENT@> -else begin print_esc(newtext(p)); -@z -%--------------------------------------- -@x [18] m.263 l.5601 - Omega -else print_esc(text(p)); -@y -else print_esc(newtext(p)); -@z -%--------------------------------------- -@x [18] m.264 l.5610 - Omega -@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword); -var k:pool_pointer; {index into |str_pool|} -@!j:small_number; {index into |buffer|} -@!l:small_number; {length of the string} -begin if s<256 then cur_val:=s+single_base -else begin k:=str_start[s]; l:=str_start[s+1]-k; - {we will move |s| into the (empty) |buffer|} - for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]); - cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|} - flush_string; text(cur_val):=s; {we don't want to have the string twice} - end; -eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o; -@y -@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword); -var k:pool_pointer; {index into |str_pool|} -@!j:small_number; {index into |buffer|} -@!l:small_number; {length of the string} -begin if s<=biggest_char then cur_val:=s+single_base -else begin k:=str_start[s]; l:=str_start[s+1]-k; - {we will move |s| into the (empty) |buffer|} - for j:=0 to l-1 do buffer[j]:=so(str_pool[k+j]); - cur_val:=id_lookup(0,l); {|no_new_control_sequence| is |false|} - flush_string; settext(cur_val,s); {we don't want to have the string twice} - end; -set_eq_level(cur_val,level_one); set_eq_type(cur_val,c); -set_equiv(cur_val,o); -@z -%--------------------------------------- -@x [18] m.265 l.5648 - Omega -primitive("delimiter",delim_num,0);@/ -@!@:delimiter_}{\.{\\delimiter} primitive@> -@y -primitive("delimiter",delim_num,0);@/ -@!@:delimiter_}{\.{\\delimiter} primitive@> -primitive("odelimiter",delim_num,1);@/ -@!@:delimiter_}{\.{\\odelimiter} primitive@> -@z -%--------------------------------------- -@x [18] m.265 l.5656 - Omega -text(frozen_end_group):="endgroup"; eqtb[frozen_end_group]:=eqtb[cur_val];@/ -@y -settext(frozen_end_group,"endgroup"); -set_new_eqtb(frozen_end_group,new_eqtb(cur_val));@/ -@z -%--------------------------------------- -@x [18] m.265 l.5673 - Omega -primitive("mathaccent",math_accent,0);@/ -@!@:math_accent_}{\.{\\mathaccent} primitive@> -primitive("mathchar",math_char_num,0);@/ -@!@:math_char_}{\.{\\mathchar} primitive@> -@y -primitive("mathaccent",math_accent,0);@/ -@!@:math_accent_}{\.{\\mathaccent} primitive@> -primitive("mathchar",math_char_num,0);@/ -@!@:math_char_}{\.{\\mathchar} primitive@> -primitive("omathaccent",math_accent,1);@/ -@!@:math_accent_}{\.{\\omathaccent} primitive@> -primitive("omathchar",math_char_num,1);@/ -@!@:math_char_}{\.{\\omathchar} primitive@> -@z -%--------------------------------------- -@x [18] m.265 l.5697 - Omega -primitive("radical",radical,0);@/ -@!@:radical_}{\.{\\radical} primitive@> -@y -primitive("radical",radical,0);@/ -@!@:radical_}{\.{\\radical} primitive@> -primitive("oradical",radical,1);@/ -@!@:radical_}{\.{\\oradical} primitive@> -@z -%--------------------------------------- -@x [18] m.265 l.5701 - Omega -primitive("relax",relax,256); {cf.\ |scan_file_name|} -@!@:relax_}{\.{\\relax} primitive@> -text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/ -@y -primitive("relax",relax,too_big_char); {cf.\ |scan_file_name|} -@!@:relax_}{\.{\\relax} primitive@> -settext(frozen_relax,"relax"); -set_new_eqtb(frozen_relax,new_eqtb(cur_val));@/ -@z -%--------------------------------------- -@x [19] m.276 l.5951 - Omega -else begin save_stack[save_ptr]:=eqtb[p]; incr(save_ptr); -@y -else begin save_stack[save_ptr]:=new_eqtb(p); incr(save_ptr); -@z -%--------------------------------------- -@x [19] m.277 l.5967 - Omega -begin if eq_level(p)=cur_level then eq_destroy(eqtb[p]) -else if cur_level>level_one then eq_save(p,eq_level(p)); -eq_level(p):=cur_level; eq_type(p):=t; equiv(p):=e; -@y -begin if eq_level(p)=cur_level then eq_destroy(new_eqtb(p)) -else if cur_level>level_one then eq_save(p,eq_level(p)); -set_eq_level(p,cur_level); set_eq_type(p,t); set_equiv(p,e); -@z -%--------------------------------------- -@x [19] m.278 l.5980 - Omega -@p procedure eq_word_define(@!p:pointer;@!w:integer); -begin if xeq_level[p]<>cur_level then - begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level; - end; -eqtb[p].int:=w; -end; -@y -@p procedure eq_word_define(@!p:pointer;@!w:integer); -begin if xeq_level(p)<>cur_level then - begin eq_save(p,xeq_level(p)); set_xeq_level(p,cur_level); - end; -set_new_eqtb_int(p,w); -end; - -procedure del_eq_word_define(@!p:pointer;@!w,wone:integer); -begin if xeq_level(p)<>cur_level then - begin eq_save(p,xeq_level(p)); set_xeq_level(p,cur_level); - end; -set_equiv(p,w); set_equiv1(p,wone); -end; - -@z -%--------------------------------------- -@x [19] m.279 l.5990 - Omega -begin eq_destroy(eqtb[p]); -eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e; -end; -@# -procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|} -begin eqtb[p].int:=w; xeq_level[p]:=level_one; -end; -@y -begin eq_destroy(new_eqtb(p)); -set_eq_level(p,level_one); set_eq_type(p,t); set_equiv(p,e); -end; -@# -procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|} -begin set_new_eqtb_int(p,w); set_xeq_level(p,level_one); -end; - -procedure del_geq_word_define(@!p:pointer;@!w,wone:integer); - {global |del_eq_word_define|} -begin set_equiv(p,w); set_equiv1(p,wone); set_xeq_level(p,level_one); -end; -@z -%--------------------------------------- -@x [19] m.282 l.6036 - Omega - else save_stack[save_ptr]:=eqtb[undefined_control_sequence]; -@y - else save_stack[save_ptr]:=new_eqtb(undefined_control_sequence); -@z -%--------------------------------------- -@x [19] m.283 l.6056 - Omega - else begin eq_destroy(eqtb[p]); {destroy the current value} - eqtb[p]:=save_stack[save_ptr]; {restore the saved value} - @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/ - end -else if xeq_level[p]<>level_one then - begin eqtb[p]:=save_stack[save_ptr]; xeq_level[p]:=l; -@y - else begin eq_destroy(new_eqtb(p)); {destroy the current value} - set_new_eqtb(p,save_stack[save_ptr]); {restore the saved value} - @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/ - end -else if xeq_level(p)<>level_one then - begin set_new_eqtb(p,save_stack[save_ptr]); set_xeq_level(p,l); -@z -%--------------------------------------- -@x [20] m.289 l.6129 - Omega -number $2^8m+c$; the command code is in the range |1<=m<=14|. (2)~A control -sequence whose |eqtb| address is |p| is represented as the number -|cs_token_flag+p|. Here |cs_token_flag=@t$2^{12}-1$@>| is larger than -@y -number $2^16m+c$; the command code is in the range |1<=m<=14|. (2)~A control -sequence whose |eqtb| address is |p| is represented as the number -|cs_token_flag+p|. Here |cs_token_flag=@t$2^{20}-1$@>| is larger than -@z -%--------------------------------------- -@x [20] m.289 l.6142 - Omega -@d cs_token_flag==@'7777 {amount added to the |eqtb| location in a - token that stands for a control sequence; is a multiple of~256, less~1} -@d left_brace_token=@'0400 {$2^8\cdot|left_brace|$} -@d left_brace_limit=@'1000 {$2^8\cdot(|left_brace|+1)$} -@d right_brace_token=@'1000 {$2^8\cdot|right_brace|$} -@d right_brace_limit=@'1400 {$2^8\cdot(|right_brace|+1)$} -@d math_shift_token=@'1400 {$2^8\cdot|math_shift|$} -@d tab_token=@'2000 {$2^8\cdot|tab_mark|$} -@d out_param_token=@'2400 {$2^8\cdot|out_param|$} -@d space_token=@'5040 {$2^8\cdot|spacer|+|" "|$} -@d letter_token=@'5400 {$2^8\cdot|letter|$} -@d other_token=@'6000 {$2^8\cdot|other_char|$} -@d match_token=@'6400 {$2^8\cdot|match|$} -@d end_match_token=@'7000 {$2^8\cdot|end_match|$} -@y -@d cs_token_flag=@"FFFFF {amount added to the |eqtb| location in a - token that stands for a control sequence; is a multiple of~65536, less~1} -@d max_char_val=@"10000 {to separate char and command code} -@d left_brace_token=@"10000 {$2^16\cdot|left_brace|$} -@d left_brace_limit=@"20000 {$2^16\cdot(|left_brace|+1)$} -@d right_brace_token=@"20000 {$2^16\cdot|right_brace|$} -@d right_brace_limit=@"30000 {$2^16\cdot(|right_brace|+1)$} -@d math_shift_token=@"30000 {$2^16\cdot|math_shift|$} -@d tab_token=@"40000 {$2^16\cdot|tab_mark|$} -@d out_param_token=@"50000 {$2^16\cdot|out_param|$} -@d space_token=@"A0020 {$2^16\cdot|spacer|+|" "|$} -@d letter_token=@"B0000 {$2^16\cdot|letter|$} -@d other_token=@"C0000 {$2^16\cdot|other_char|$} -@d match_token=@"D0000 {$2^16\cdot|match|$} -@d end_match_token=@"E0000 {$2^16\cdot|end_match|$} -@z -%--------------------------------------- -@x [20] m.293 l.6256 - Omega -else begin m:=info(p) div @'400; c:=info(p) mod @'400; -@y -else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val; -@z -%--------------------------------------- -@x [21] m.298 l.6375 - Omega -procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); -@y -procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); -@z -%--------------------------------------- -@x [24] m.334 l.7110 - Omega -primitive("par",par_end,256); {cf. |scan_file_name|} -@y -primitive("par",par_end,too_big_char); {cf. |scan_file_name|} -@z -%--------------------------------------- -@x [24] m.357 l.7462 - Omega - else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400; -@y - else begin cur_cmd:=t div max_char_val; cur_chr:=t mod max_char_val; -@z -%--------------------------------------- -@x [24] m.358 l.7479 - Omega -@d no_expand_flag=257 {this characterizes a special variant of |relax|} -@y -@d no_expand_flag=special_char {this characterizes a special variant of |relax|} -@z -%--------------------------------------- -@x [24] m.365 l.7606 - Omega -if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr -@y -if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr -@z -%--------------------------------------- -@x [25] m.374 l.7728 - Omega - begin eq_define(cur_cs,relax,256); {N.B.: The |save_stack| might change} -@y - begin eq_define(cur_cs,relax,too_big_char); - {N.B.: The |save_stack| might change} -@z -%--------------------------------------- -@x [25] m.374 l.7750 - Omega - buffer[j]:=info(p) mod @'400; incr(j); p:=link(p); -@y - buffer[j]:=info(p) mod max_char_val; incr(j); p:=link(p); -@z -%--------------------------------------- -@x [25] m.380 l.7812 - Omega -done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr -@y -done: if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr -@z -%--------------------------------------- -@x [25] m.381 l.7824 - Omega -if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr -@y -if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr -@z -%--------------------------------------- -@x [25] m.391 l.7985 - Omega -if (info(r)>match_token+255)or(info(r)<match_token) then s:=null -@y -if (info(r)>=end_match_token)or(info(r)<match_token) then s:=null -@z -%--------------------------------------- -@x [26] m.407 l.8161 - Omega -@ The |scan_left_brace| routine is called when a left brace is supposed to be -the next non-blank token. (The term ``left brace'' means, more precisely, -a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to -appear before the |left_brace|. - -@p procedure scan_left_brace; {reads a mandatory |left_brace|} -begin @<Get the next non-blank non-relax non-call token@>; -if cur_cmd<>left_brace then - begin print_err("Missing { inserted"); -@.Missing \{ inserted@> - help4("A left brace was mandatory here, so I've put one in.")@/ - ("You might want to delete and/or insert some corrections")@/ - ("so that I will find a matching right brace soon.")@/ - ("(If you're confused by all this, try typing `I}' now.)"); - back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace; - cur_chr:="{"; incr(align_state); - end; -end; -@y -@ The |scan_left_brace| routine is called when a left brace is supposed to be -the next non-blank token. (The term ``left brace'' means, more precisely, -a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to -appear before the |left_brace|. - -@p procedure scan_left_brace; {reads a mandatory |left_brace|} -begin @<Get the next non-blank non-relax non-call token@>; -if cur_cmd<>left_brace then - begin print_err("Missing { inserted"); -@.Missing \{ inserted@> - help4("A left brace was mandatory here, so I've put one in.")@/ - ("You might want to delete and/or insert some corrections")@/ - ("so that I will find a matching right brace soon.")@/ - ("(If you're confused by all this, try typing `I}' now.)"); - back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace; - cur_chr:="{"; incr(align_state); - end; -end; - -@ The |scan_right_brace| routine is called when a right brace is supposed to be -the next non-blank token. (The term ``right brace'' means, more precisely, -a character whose catcode is |right_brace|.) \TeX\ allows \.{\\relax} to -appear before the |right_brace|. - -@p procedure scan_right_brace; {reads a mandatory |right_brace|} -begin @<Get the next non-blank non-relax non-call token@>; -if cur_cmd<>right_brace then - begin print_err("Missing { inserted"); -@.Missing \{ inserted@> - help4("A right brace was mandatory here, so I've put one in.")@/ - ("You might want to delete and/or insert some corrections")@/ - ("so that I will find a matching right brace soon.")@/ - ("(If you're confused by all this, try typing `I}' now.)"); - back_error; cur_tok:=right_brace_token+"}"; cur_cmd:=right_brace; - cur_chr:="}"; incr(align_state); - end; -end; -@z -%--------------------------------------- -@x [26] m.410 l.8293 - Omega -@!cur_val:integer; {value returned by numeric scanners} -@y -@!cur_val:integer; {value returned by numeric scanners} -@!cur_val1:integer; {delcodes are now 51 digits} -@z -%--------------------------------------- -@x [26] m.413 l.8335 - Omega -assign_int: scanned_result(eqtb[m].int)(int_val); -assign_dimen: scanned_result(eqtb[m].sc)(dimen_val); -@y -assign_int: scanned_result(new_eqtb_int(m))(int_val); -assign_dimen: scanned_result(new_eqtb_sc(m))(dimen_val); -@z -%--------------------------------------- -@x [26] m.413 l.8345 - Omega -char_given,math_given: scanned_result(cur_chr)(int_val); -@y -char_given,math_given,omath_given: scanned_result(cur_chr)(int_val); -@z -%--------------------------------------- -@x [26] m.414 l.8356 - Omega -@ @<Fetch a character code from some table@>= -begin scan_char_num; -if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val) -else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val) -else scanned_result(eqtb[m+cur_val].int)(int_val); -@y -@ @<Fetch a character code from some table@>= -begin scan_char_num; -if m=math_code_base then begin - cur_val1:=ho(math_code(cur_val)); - if ((cur_val1 div @"1000000)>8) or - (((cur_val1 mod @"1000000) div @"10000)>15) or - ((cur_val1 mod @"10000)>255) then - begin print_err("Extended mathchar used as mathchar"); -@.Bad mathchar@> - help2("A mathchar number must be between 0 and ""7FFF.")@/ - ("I changed this one to zero."); int_error(cur_val1); cur_val1:=0; - end; - cur_val1:=((cur_val1 div @"1000000)*@"1000) + - (((cur_val1 mod @"1000000) div @"10000)*@"100) + - (cur_val1 mod @"10000); - scanned_result(cur_val1)(int_val) - end -else if m=(math_code_base+256) then - scanned_result(ho(math_code(cur_val)))(int_val) -else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val) -else scanned_result(new_eqtb_int(m+cur_val))(int_val); -@z -%--------------------------------------- -@x [26] m.433 l.8593 - Omega -procedure scan_eight_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>255) then - begin print_err("Bad register code"); -@.Bad register code@> - help2("A register number must be between 0 and 255.")@/ -@y -procedure scan_eight_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>biggest_reg) then - begin print_err("Bad register code"); -@.Bad register code@> - help2("A register number must be between 0 and 65535.")@/ -@z -%--------------------------------------- -@x [26] m.434 l.8604 - Omega -procedure scan_char_num; -begin scan_int; -if (cur_val<0)or(cur_val>255) then - begin print_err("Bad character code"); -@.Bad character code@> - help2("A character number must be between 0 and 255.")@/ -@y -procedure scan_char_num; -begin scan_int; -if (cur_val<0)or(cur_val>biggest_char) then - begin print_err("Bad character code"); -@.Bad character code@> - help2("A character number must be between 0 and 65535.")@/ -@z -%--------------------------------------- -@x [26] m.435 l.8618 - Omega -procedure scan_four_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>15) then - begin print_err("Bad number"); -@.Bad number@> - help2("Since I expected to read a number between 0 and 15,")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; -@y -procedure scan_four_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>15) then - begin print_err("Bad number"); -@.Bad number@> - help2("Since I expected to read a number between 0 and 15,")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_big_four_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>255) then - begin print_err("Bad number"); -@.Bad number@> - help2("Since I expected to read a number between 0 and 255,")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; -@z -%--------------------------------------- -@x [26] m.436 l.8629 - Omega -procedure scan_fifteen_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>@'77777) then - begin print_err("Bad mathchar"); -@.Bad mathchar@> - help2("A mathchar number must be between 0 and 32767.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; -@y -procedure scan_real_fifteen_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>@'77777) then - begin print_err("Bad mathchar"); -@.Bad mathchar@> - help2("A mathchar number must be between 0 and 32767.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_fifteen_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>@'77777) then - begin print_err("Bad mathchar"); -@.Bad mathchar@> - help2("A mathchar number must be between 0 and 32767.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -cur_val := ((cur_val div @"1000) * @"1000000) + - (((cur_val mod @"1000) div @"100) * @"10000) + - (cur_val mod @"100); -end; - -procedure scan_big_fifteen_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>@"7FFFFFF) then - begin print_err("Bad extended mathchar"); -@.Bad mathchar@> - help2("An extended mathchar number must be between 0 and ""7FFFFFF.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; -@z -%--------------------------------------- -@x [26] m.437 l.8640 - Omega -procedure scan_twenty_seven_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>@'777777777) then - begin print_err("Bad delimiter code"); -@.Bad delimiter code@> - help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; -@y -procedure scan_twenty_seven_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>@'777777777) then - begin print_err("Bad delimiter code"); -@.Bad delimiter code@> - help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -cur_val1 := (((cur_val mod @"1000) div @"100) * @"10000) + - (cur_val mod @"100); -cur_val := cur_val div @"1000; -cur_val := ((cur_val div @"1000) * @"1000000) + - (((cur_val mod @"1000) div @"100) * @"10000) + - (cur_val mod @"100); -end; - -procedure scan_fifty_one_bit_int; -var iiii:integer; -begin scan_int; -if (cur_val<0)or(cur_val>@'777777777) then - begin print_err("Bad delimiter code"); -@.Bad delimiter code@> - help2("A numeric delimiter (first part) must be between 0 and 2^{27}-1.") - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -iiii:=cur_val; -scan_int; -if (cur_val<0)or(cur_val>@"FFFFFF) then - begin print_err("Bad delimiter code"); -@.Bad delimiter code@> -help2("A numeric delimiter (second part) must be between 0 and 2^{24}-1.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -cur_val1:=cur_val; -cur_val:=iiii; -end; - -procedure scan_string_argument; -var s:integer; -begin -scan_left_brace; -get_x_token; -while (cur_cmd<>right_brace) do - begin - if (cur_cmd=letter) or (cur_cmd=other_char) then begin - str_room(1); append_char(cur_chr); - end - else if (cur_cmd=spacer) then begin - str_room(1); append_char(" "); - end - else begin - print("Bad token appearing in string argument"); - end; - get_x_token; - end; -s:=make_string; -if str_eq_str("mi",s) then s:="mi"; -if str_eq_str("mo",s) then s:="mo"; -if str_eq_str("mn",s) then s:="mn"; -cur_val:=s; -end; -@z -%--------------------------------------- -@x [26] m.442 l.8720 - Omega -if cur_val>255 then - begin print_err("Improper alphabetic constant"); -@y -if cur_val>biggest_char then - begin print_err("Improper alphabetic constant"); -@z -%--------------------------------------- -@x [27] m.468 l.9200 - Omega -@d job_name_code=5 {command code for \.{\\jobname}} -@y -@d omega_code=5 {command code for \.{\\OmegaVersion}} -@d job_name_code=6 {command code for \.{\\jobname}} -@z -%--------------------------------------- -@x [27] m.468 l.9200 - Omega -primitive("jobname",convert,job_name_code);@/ -@!@:job_name_}{\.{\\jobname} primitive@> -@y -primitive("OmegaVersion",convert,omega_code);@/ -@!@:omega_version_}{\.{\\OmegaVersion} primitive@> -primitive("jobname",convert,job_name_code);@/ -@!@:job_name_}{\.{\\jobname} primitive@> -@z -%--------------------------------------- -@x [27] m.469 l.9223 - Omega - othercases print_esc("jobname") -@y - omega_code: print_esc("OmegaVersion"); - othercases print_esc("jobname") -@z -%--------------------------------------- -@x [27] m.471 l.9248 - Omega -job_name_code: if job_name=0 then open_log_file; -@y -omega_code:; -job_name_code: if job_name=0 then open_log_file; -@z -%--------------------------------------- -@x [27] m.472 l.9258 - Omega -job_name_code: print(job_name); -@y -omega_code: print("1.15"); -job_name_code: print(job_name); -@z -%--------------------------------------- -@x [28] m.491 l.9610 - Omega -text(frozen_fi):="fi"; eqtb[frozen_fi]:=eqtb[cur_val]; -@y -settext(frozen_fi,"fi"); set_new_eqtb(frozen_fi,new_eqtb(cur_val)); -@z -%--------------------------------------- -@x [28] m.506 l.9802 - Omega -if (cur_cmd>active_char)or(cur_chr>255) then {not a character} - begin m:=relax; n:=256; -@y -if (cur_cmd>active_char)or(cur_chr>biggest_char) then {not a character} - begin m:=relax; n:=too_big_char; -@z -%--------------------------------------- -@x [28] m.506 l.9808 - Omega -if (cur_cmd>active_char)or(cur_chr>255) then - begin cur_cmd:=relax; cur_chr:=256; -@y -if (cur_cmd>active_char)or(cur_chr>biggest_char) then - begin cur_cmd:=relax; cur_chr:=too_big_char; -@z -%--------------------------------------- -@x [29] m.526 l.10178 - Omega -loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character} -@y -loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then - {not a character} -@z -%--------------------------------------- -@x [37] m.780 l.15354 - Omega -@d span_code=256 {distinct from any character} -@d cr_code=257 {distinct from |span_code| and from any character} -@y -@d span_code=special_char {distinct from any character} -@d cr_code=span_code+1 {distinct from |span_code| and from any character} -@z -%--------------------------------------- -@x [37] m.780 l.15364 - Omega -text(frozen_cr):="cr"; eqtb[frozen_cr]:=eqtb[cur_val];@/ -primitive("crcr",car_ret,cr_cr_code); -@!@:cr_cr_}{\.{\\crcr} primitive@> -text(frozen_end_template):="endtemplate"; text(frozen_endv):="endtemplate"; -eq_type(frozen_endv):=endv; equiv(frozen_endv):=null_list; -eq_level(frozen_endv):=level_one;@/ -eqtb[frozen_end_template]:=eqtb[frozen_endv]; -eq_type(frozen_end_template):=end_template; -@y -settext(frozen_cr,"cr"); -set_new_eqtb(frozen_cr,new_eqtb(cur_val));@/ -primitive("crcr",car_ret,cr_cr_code); -@!@:cr_cr_}{\.{\\crcr} primitive@> -settext(frozen_end_template,"endtemplate"); settext(frozen_endv,"endtemplate"); -set_eq_type(frozen_endv,endv); set_equiv(frozen_endv,null_list); -set_eq_level(frozen_endv,level_one);@/ -set_new_eqtb(frozen_end_template,new_eqtb(frozen_endv)); -set_eq_type(frozen_end_template,end_template); -@z -%--------------------------------------- -@x [37] m.798 l.15651 - Omega -if n>max_quarterword then confusion("256 spans"); {this can happen, but won't} -@^system dependencies@> -@:this can't happen 256 spans}{\quad 256 spans@> -@y -if n>max_quarterword then confusion("too many spans"); - {this can happen, but won't} -@^system dependencies@> -@:this can't happen too many spans}{\quad too many spans@> -@z -%--------------------------------------- -@x [37] m.804 l.15794 - Omega - overfull_rule:=0; {prevent rule from being packaged} - p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save; -@y - set_new_eqtb_sc(dimen_base+overfull_rule_code,0); - {prevent rule from being packaged} - p:=hpack(preamble,saved(1),saved(0)); - set_new_eqtb_sc(dimen_base+overfull_rule_code,rule_save); -@z -%--------------------------------------- -@x [37] m.827 l.16255 - Omega -check_shrinkage(left_skip); check_shrinkage(right_skip);@/ -@y -if (shrink_order(left_skip)<>normal)and(shrink(left_skip)<>0) then - begin set_equiv(glue_base+left_skip_code,finite_shrink(left_skip)); - end; -if (shrink_order(right_skip)<>normal)and(shrink(right_skip)<>0) then - begin set_equiv(glue_base+right_skip_code,finite_shrink(right_skip)); - end; -@z -%--------------------------------------- -@x [40] m.891 l.17434 - Omega -$c_1$ will be treated as nonletters. The |hyphen_char| for that font -must be between 0 and 255, otherwise hyphenation will not be attempted. -@y -$c_1$ will be treated as nonletters. The |hyphen_char| for that font must -be between 0 and |biggest_char|, otherwise hyphenation will not be attempted. -@z -%--------------------------------------- -@x [40] m.892 l.17469 - Omega -@!hc:array[0..65] of 0..256; {word to be hyphenated} -@!hn:small_number; {the number of positions occupied in |hc|} -@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result} -@!hf:internal_font_number; {font number of the letters in |hc|} -@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase} -@!hyf_char:integer; {hyphen character of the relevant font} -@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest} -@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes} -@!hyf_bchar:halfword; {boundary character after $c_n$} -@y -@!hc:array[0..65] of 0..too_big_char; {word to be hyphenated} -@!hn:small_number; {the number of positions occupied in |hc|} -@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result} -@!hf:internal_font_number; {font number of the letters in |hc|} -@!hu:array[0..63] of 0..too_big_char; - {like |hc|, before conversion to lowercase} -@!hyf_char:integer; {hyphen character of the relevant font} -@!cur_lang,@!init_cur_lang:0..biggest_lang; - {current hyphenation table of interest} -@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes} -@!hyf_bchar:halfword; {boundary character after $c_n$} -@!max_hyph_char:integer; - -@ @<Set initial values of key variables@>= -max_hyph_char:=too_big_lang; - -@z -%--------------------------------------- -@x [40] m.893 l.17483 - Omega -@!c:0..255; {character being considered for hyphenation} -@y -@!c:ASCII_code; {character being considered for hyphenation} -@z -%--------------------------------------- -@x [40] m.896 l.17534 - Omega -if hyf_char>255 then goto done1; -@y -if hyf_char>biggest_char then goto done1; -@z -%--------------------------------------- -@x [40] m.897 l.17546 - Omega - if lc_code(c)=0 then goto done3; -@y - if lc_code(c)=0 then goto done3; - if lc_code(c)>max_hyph_char then goto done3; -@z -%--------------------------------------- -@x [40] m.898 l.17572 - Omega - if lc_code(c)=0 then goto done3; -@y - if lc_code(c)=0 then goto done3; - if lc_code(c)>max_hyph_char then goto done3; -@z -%--------------------------------------- -@x [41] m.903 l.17648 - Omega - begin hu[0]:=256; init_lig:=false; -@y - begin hu[0]:=max_hyph_char; init_lig:=false; -@z -%--------------------------------------- -@x [41] m.903 l.17660 - Omega -found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null; -@y -found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null; -@z -%--------------------------------------- -@x [41] m.905 l.17707 - Omega -getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=256$, -we consider $x_j$ to be an implicit left boundary character; in this -case |j| must be strictly less than~|n|. There is a -parameter |bchar|, which is either 256 or an implicit right boundary character -@y -getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=|max_hyph_char|$, -we consider $x_j$ to be an implicit left boundary character; in this -case |j| must be strictly less than~|n|. There is a -parameter |bchar|, which is either |max_hyph_char| -or an implicit right boundary character -@z -%--------------------------------------- -@x [41] m.916 l.17980 - Omega - begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256; -@y - begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char; -@z -%--------------------------------------- -@x [42] m.921 l.18079 - Omega -@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language} -@y -@!op_start:array[0..biggest_lang] of 0..trie_op_size; - {offset for current language} -@z -%--------------------------------------- -@x [42] m.923 l.18086 - Omega -hyphenation algorithm is quite short. In the following code we set |hc[hn+2]| -to the impossible value 256, in order to guarantee that |hc[hn+3]| will -@y -hyphenation algorithm is quite short. In the following code we set |hc[hn+2]| to -the impossible value |max_hyph_char|, in order to guarantee that |hc[hn+3]| will -@z -%--------------------------------------- -@x [42] m.923 l.18095 - Omega -hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters} -@y -hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters} -@z -%--------------------------------------- -@x [42] m.934 l.18206 - Omega -@d set_cur_lang==if language<=0 then cur_lang:=0 - else if language>255 then cur_lang:=0 -@y -@d set_cur_lang==if language<=0 then cur_lang:=0 - else if language>biggest_lang then cur_lang:=0 -@z -%--------------------------------------- -@x [43] m.943 l.18348 - Omega -@!trie_used:array[ASCII_code] of quarterword; - {largest opcode used so far for this language} -@!trie_op_lang:array[1..trie_op_size] of ASCII_code; -@y -@!trie_used:array[0..biggest_lang] of quarterword; - {largest opcode used so far for this language} -@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang; -@z -%--------------------------------------- -@x [43] m.945 l.18400 - Omega -for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); -@y -for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); -@z -%--------------------------------------- -@x [43] m.946 l.18416 - Omega -for k:=0 to 255 do trie_used[k]:=min_quarterword; -@y -for k:=0 to biggest_lang do trie_used[k]:=min_quarterword; -@z -%--------------------------------------- -@x [43] m.947 l.18438 - Omega -@!init @!trie_c:packed array[trie_pointer] of packed_ASCII_code; -@y -@!init @!trie_c:packed array[trie_pointer] of ASCII_code; -@z -%--------------------------------------- -@x [43] m.952 l.18551 - Omega -for p:=0 to 255 do trie_min[p]:=p+1; -@y -for p:=0 to biggest_char do trie_min[p]:=p+1; -@z -%--------------------------------------- -@x [43] m.953 l.18569 - Omega -@!ll:1..256; {upper limit of |trie_min| updating} -@y -@!ll:1..too_big_char; {upper limit of |trie_min| updating} -@z -%--------------------------------------- -@x [43] m.953 l.18573 - Omega - @<Ensure that |trie_max>=h+256|@>; -@y - @<Ensure that |trie_max>=h+max_hyph_char|@>; -@z -%--------------------------------------- -@x [43] m.954 l.18582 - Omega -@ By making sure that |trie_max| is at least |h+256|, we can be sure that -|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will -never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|. - -@<Ensure that |trie_max>=h+256|@>= -if trie_max<h+256 then - begin if trie_size<=h+256 then overflow("pattern memory",trie_size); -@y -@ By making sure that |trie_max| is at least |h+max_hyph_char|, -we can be sure that -|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will -never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|. - -@<Ensure that |trie_max>=h+max_hyph_char|@>= -if trie_max<h+max_hyph_char then - begin if trie_size<=h+max_hyph_char then overflow("pattern memory",trie_size); -@z -%--------------------------------------- -@x [43] m.954 l.18592 - Omega - until trie_max=h+256; -@y - until trie_max=h+max_hyph_char; -@z -%--------------------------------------- -@x [43] m.956 l.18607 - Omega -if l<256 then - begin if z<256 then ll:=z @+else ll:=256; -@y -if l<max_hyph_char then - begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char; -@z -%--------------------------------------- -@x [43] m.958 l.18637 - Omega -if trie_root=0 then {no patterns were given} - begin for r:=0 to 256 do trie[r]:=h; - trie_max:=256; -@y -if trie_root=0 then {no patterns were given} - begin for r:=0 to max_hyph_char do trie[r]:=h; - trie_max:=max_hyph_char; -@z -%--------------------------------------- -@x [43] m.962 l.18714 - Omega -@ @<Append a new letter or a hyphen level@>= -if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then - begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter} - else begin cur_chr:=lc_code(cur_chr); - if cur_chr=0 then - begin print_err("Nonletter"); -@.Nonletter@> - help1("(See Appendix H.)"); error; - end; - end; -@y -@ @<Append a new letter or a hyphen level@>= -if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then - begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter} - else begin cur_chr:=lc_code(cur_chr); - if cur_chr=0 then - begin print_err("Nonletter"); -@.Nonletter@> - help1("(See Appendix H.)"); error; - end; - end; - if cur_chr>max_hyph_char then max_hyph_char:=cur_chr; -@z -%--------------------------------------- -@x [43] m.966 l. - Omega -procedure init_trie; -var @!p:trie_pointer; {pointer for initialization} -@!j,@!k,@!t:integer; {all-purpose registers for initialization} -@!r,@!s:trie_pointer; {used to clean up the packed |trie|} -@!h:two_halves; {template used to zero out |trie|'s holes} -begin @<Get ready to compress the trie@>; -@y -procedure init_trie; -var @!p:trie_pointer; {pointer for initialization} -@!j,@!k,@!t:integer; {all-purpose registers for initialization} -@!r,@!s:trie_pointer; {used to clean up the packed |trie|} -@!h:two_halves; {template used to zero out |trie|'s holes} -begin -incr(max_hyph_char); -@<Get ready to compress the trie@>; -@z -%--------------------------------------- -@x [44] m.977 l.19008 - Omega -if q=null then box(n):=null {the |eq_level| of the box stays the same} -else box(n):=vpack(q,natural); -@y -if q=null then set_equiv(box_base+n,null) - {the |eq_level| of the box stays the same} -else set_equiv(box_base+n,vpack(q,natural)); -@z -%--------------------------------------- -@x [45] m.992 l.24928 - Omega -flush_node_list(box(n)); box(n):=null; -@y -flush_node_list(box(n)); set_equiv(box_base+n,null); -@z -%--------------------------------------- -@x [45] m.994 l.19364 - Omega -@!n:min_quarterword..255; {insertion box number} -@y -@!n:min_quarterword..biggest_reg; {insertion box number} -@z -%--------------------------------------- -@x [45] m.1012 l.19655 - Omega -@!n:min_quarterword..255; {insertion box number} -@y -@!n:min_quarterword..biggest_reg; {insertion box number} -@z -%--------------------------------------- -@x [45] m.1014 l.19710 - Omega -split_top_skip:=save_split_top_skip; -@y -set_equiv(glue_base+split_top_skip_code,save_split_top_skip); -@z -%--------------------------------------- -@x [45] m.1017 l.19753 - Omega -save_vbadness:=vbadness; vbadness:=inf_bad; -save_vfuzz:=vfuzz; vfuzz:=max_dimen; {inhibit error messages} -box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth); -vbadness:=save_vbadness; vfuzz:=save_vfuzz; -@y -save_vbadness:=vbadness; -set_new_eqtb_int(int_base+vbadness_code,inf_bad); -save_vfuzz:=vfuzz; -set_new_eqtb_sc(dimen_base+vfuzz_code,max_dimen); - {inhibit error messages} -set_equiv(box_base+255, - vpackage(link(page_head),best_size,exactly,page_max_depth)); -set_new_eqtb_int(int_base+vbadness_code,save_vbadness); -set_new_eqtb_sc(dimen_base+vfuzz_code,save_vfuzz); -@z -%--------------------------------------- -@x [45] m.1018 l.19774 - Omega - if box(n)=null then box(n):=new_null_box; -@y - if box(n)=null then set_equiv(box_base+n,new_null_box); -@z -%--------------------------------------- -@x [45] m.1021 l.19817 - Omega - split_top_skip:=split_top_ptr(p); - ins_ptr(p):=prune_page_top(broken_ptr(r)); - if ins_ptr(p)<>null then - begin temp_ptr:=vpack(ins_ptr(p),natural); - height(p):=height(temp_ptr)+depth(temp_ptr); - free_node(temp_ptr,box_node_size); wait:=true; - end; - end; -best_ins_ptr(r):=null; -n:=qo(subtype(r)); -temp_ptr:=list_ptr(box(n)); -free_node(box(n),box_node_size); -box(n):=vpack(temp_ptr,natural); -@y - set_equiv(glue_base+split_top_skip_code,split_top_ptr(p)); - ins_ptr(p):=prune_page_top(broken_ptr(r)); - if ins_ptr(p)<>null then - begin temp_ptr:=vpack(ins_ptr(p),natural); - height(p):=height(temp_ptr)+depth(temp_ptr); - free_node(temp_ptr,box_node_size); wait:=true; - end; - end; -best_ins_ptr(r):=null; -n:=qo(subtype(r)); -temp_ptr:=list_ptr(box(n)); -free_node(box(n),box_node_size); -set_equiv(box_base+n,vpack(temp_ptr,natural)); -@z -%--------------------------------------- -@x [45] m.1023 l.19854 - Omega -ship_out(box(255)); box(255):=null; -@y -ship_out(box(255)); set_equiv(box_base+255,null); -@z -%--------------------------------------- -@x [46] m.1046 l.20339 - Omega -non_math(math_given), non_math(math_comp), non_math(delim_num), -@y -non_math(math_given), non_math(omath_given), -non_math(math_comp), non_math(delim_num), -@z -%--------------------------------------- -@x [47] m.1071 l.20718 - Omega -|box_flag+255| represent `\.{\\setbox0}' through `\.{\\setbox255}'; -codes |box_flag+256| through |box_flag+511| represent `\.{\\global\\setbox0}' -through `\.{\\global\\setbox255}'; -code |box_flag+512| represents `\.{\\shipout}'; and codes |box_flag+513| -through |box_flag+515| represent `\.{\\leaders}', `\.{\\cleaders}', -@y -|box_flag+biggest_reg| represent `\.{\\setbox0}' through -`\.{\\setbox}|biggest_reg|'; codes |box_flag+biggest_reg+1| through -|box_flag+2*biggest_reg| represent `\.{\\global\\setbox0}' -through `\.{\\global\\setbox}|biggest_reg|'; code |box_flag+2*number_regs| -represents `\.{\\shipout}'; and codes |box_flag+2*number_regs+1| -through |box_flag+2*number_regs+3| represent `\.{\\leaders}', `\.{\\cleaders}', -@z -%--------------------------------------- -@x [47] m.1071 l.20732 - Omega -@d ship_out_flag==box_flag+512 {context code for `\.{\\shipout}'} -@d leader_flag==box_flag+513 {context code for `\.{\\leaders}'} -@y -@d ship_out_flag==box_flag+(number_regs+number_regs) - {context code for `\.{\\shipout}'} -@d leader_flag==ship_out_flag+1 {context code for `\.{\\leaders}'} -@z -%--------------------------------------- -@x [47] m.1077 l.20853 - Omega -if box_context<box_flag+256 then - eq_define(box_base-box_flag+box_context,box_ref,cur_box) -else geq_define(box_base-box_flag-256+box_context,box_ref,cur_box) -@y -if box_context<box_flag+number_regs then - eq_define(box_base-box_flag+box_context,box_ref,cur_box) -else geq_define(box_base-box_flag-number_regs+box_context,box_ref,cur_box) -@z -%--------------------------------------- -@x [47] m.1079 l.20888 - Omega - box(cur_val):=null; {the box becomes void, at the same level} -@y - set_equiv(box_base+cur_val,null); - {the box becomes void, at the same level} -@z -%--------------------------------------- -@x [47] m.1100 l.21156 - Omega - if saved(0)<255 then -@y - if saved(0)<>255 then -@z -%--------------------------------------- -@x [47] m.1109 l.21265 - Omega -@ The |un_hbox| and |un_vbox| commands unwrap one of the 256 current boxes. -@y -@ The |un_hbox| and |un_vbox| commands unwrap one of the current boxes. -@z -%--------------------------------------- -@x [47] m.1110 l.21287 - Omega -else begin link(tail):=list_ptr(p); box(cur_val):=null; -@y -else begin link(tail):=list_ptr(p); -set_equiv(box_base+cur_val,null); -@z -%--------------------------------------- -@x [47] m.1117 l.21342 - Omega - if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c); -@y - if c>=0 then if c<=biggest_char then - pre_break(tail):=new_character(cur_font,c); -@z -%--------------------------------------- -@x [48] m.1151 l.21810 - Omega -@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are -broken down into subfields called |math_type| and either |info| or -|(fam,character)|. The job of |scan_math| is to figure out what to place -in one of these principal fields; it looks at the subformula that -comes next in the input, and places an encoding of that subformula -into a given word of |mem|. - -@d fam_in_range==((cur_fam>=0)and(cur_fam<16)) - -@<Declare act...@>= -procedure scan_math(@!p:pointer); -label restart,reswitch,exit; -var c:integer; {math character code} -begin restart:@<Get the next non-blank non-relax...@>; -reswitch:case cur_cmd of -letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); - if c=@'100000 then - begin @<Treat |cur_chr| as an active character@>; - goto restart; - end; - end; -char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given; - goto reswitch; - end; -math_char_num: begin scan_fifteen_bit_int; c:=cur_val; - end; -math_given: c:=cur_chr; -delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000; - end; -othercases @<Scan a subformula enclosed in braces and |return|@> -endcases;@/ -math_type(p):=math_char; character(p):=qi(c mod 256); -if (c>=var_code)and fam_in_range then fam(p):=cur_fam -else fam(p):=(c div 256) mod 16; -exit:end; -@y -@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are -broken down into subfields called |math_type| and either |info| or -|(fam,character)|. The job of |scan_math| is to figure out what to place -in one of these principal fields; it looks at the subformula that -comes next in the input, and places an encoding of that subformula -into a given word of |mem|. - -@d fam_in_range==((cur_fam>=0)and(cur_fam<16)) - -@<Declare act...@>= -@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/ - -procedure scan_math(@!p:pointer); -label restart,reswitch,exit; -var c:integer; {math character code} -begin restart:@<Get the next non-blank non-relax...@>; -reswitch: -case cur_cmd of -letter,other_char,char_given: begin - c:=ho(math_code(cur_chr)); - if c=@"8000000 then - begin @<Treat |cur_chr| as an active character@>; - goto restart; - end; - end; -char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given; - goto reswitch; - end; -math_char_num: begin - if cur_chr=0 then scan_fifteen_bit_int - else scan_big_fifteen_bit_int; - c:=cur_val; - end; -math_given: begin - c := ((cur_chr div @"1000) * @"1000000) + - (((cur_chr mod @"1000) div @"100) * @"10000) + - (cur_chr mod @"100); - end; -omath_given: begin c:=cur_chr; - end; -delim_num: begin - if cur_chr=0 then scan_twenty_seven_bit_int - else scan_fifty_one_bit_int; - c:=cur_val; - end; -othercases @<Scan a subformula enclosed in braces and |return|@> -endcases;@/ -math_type(p):=math_char; character(p):=qi(c mod @"10000); -if (c>=var_code)and fam_in_range then fam(p):=cur_fam -else fam(p):=(c div @"10000) mod @"100; -exit:end; -@z -%--------------------------------------- -@x [48] m.1154 l.21860 - Omega -mmode+letter,mmode+other_char,mmode+char_given: - set_math_char(ho(math_code(cur_chr))); -mmode+char_num: begin scan_char_num; cur_chr:=cur_val; - set_math_char(ho(math_code(cur_chr))); - end; -mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val); - end; -mmode+math_given: set_math_char(cur_chr); -mmode+delim_num: begin scan_twenty_seven_bit_int; - set_math_char(cur_val div @'10000); -@y -mmode+letter,mmode+other_char,mmode+char_given: - set_math_char(ho(math_code(cur_chr))); -mmode+char_num: begin scan_char_num; cur_chr:=cur_val; - set_math_char(ho(math_code(cur_chr))); - end; -mmode+math_char_num: begin - if cur_chr=0 then scan_fifteen_bit_int - else scan_big_fifteen_bit_int; - set_math_char(cur_val); - end; -mmode+math_given: begin - set_math_char(((cur_chr div @"1000) * @"1000000) + - (((cur_chr mod @"1000) div @"100) * @"10000) + - (cur_chr mod @"100)); - end; -mmode+omath_given: begin - set_math_char(cur_chr); - end; -mmode+delim_num: begin - if cur_chr=0 then scan_twenty_seven_bit_int - else scan_fifty_one_bit_int; - set_math_char(cur_val); -@z -%--------------------------------------- -@x [48] m.1155 l.21878 - Omega -procedure set_math_char(@!c:integer); -var p:pointer; {the new noad} -begin if c>=@'100000 then - @<Treat |cur_chr|...@> -else begin p:=new_noad; math_type(nucleus(p)):=math_char; - character(nucleus(p)):=qi(c mod 256); - fam(nucleus(p)):=(c div 256) mod 16; - if c>=var_code then - begin if fam_in_range then fam(nucleus(p)):=cur_fam; - type(p):=ord_noad; - end - else type(p):=ord_noad+(c div @'10000); - link(tail):=p; tail:=p; - end; -end; -@y -procedure set_math_char(@!c:integer); -var p,q,r:pointer; {the new noad} -begin if c>=@"8000000 then - @<Treat |cur_chr|...@> -else begin p:=new_noad; math_type(nucleus(p)):=math_char; - character(nucleus(p)):=qi(c mod @"10000); - fam(nucleus(p)):=(c div @"10000) mod @"100; - if c>=var_code then - begin if fam_in_range then fam(nucleus(p)):=cur_fam; - type(p):=ord_noad; - end - else type(p):=ord_noad+(c div @"1000000); - link(tail):=p; tail:=p; - end; -end; -@z -%--------------------------------------- -@x [48] m.1160 l.21966 - Omega -procedure scan_delimiter(@!p:pointer;@!r:boolean); -begin if r then scan_twenty_seven_bit_int -else begin @<Get the next non-blank non-relax...@>; - case cur_cmd of - letter,other_char: cur_val:=del_code(cur_chr); - delim_num: scan_twenty_seven_bit_int; - othercases cur_val:=-1 - endcases; - end; -if cur_val<0 then @<Report that an invalid delimiter code is being changed - to null; set~|cur_val:=0|@>; -small_fam(p):=(cur_val div @'4000000) mod 16; -small_char(p):=qi((cur_val div @'10000) mod 256); -large_fam(p):=(cur_val div 256) mod 16; -large_char(p):=qi(cur_val mod 256); -@y -procedure scan_delimiter(@!p:pointer;@!r:integer); -begin if r=1 then scan_twenty_seven_bit_int -else if r=2 then scan_fifty_one_bit_int -else begin @<Get the next non-blank non-relax...@>; - case cur_cmd of - letter,other_char: begin - cur_val:=del_code0(cur_chr); cur_val1:=del_code1(cur_chr); - end; - delim_num: if cur_chr=0 then scan_twenty_seven_bit_int - else scan_fifty_one_bit_int; - othercases begin cur_val:=-1; cur_val1:=-1; end; - endcases; - end; -if cur_val<0 then begin @<Report that an invalid delimiter code is being changed - to null; set~|cur_val:=0|@>; - cur_val1:=0; - end; -small_fam(p):=(cur_val div @"10000) mod @"100; -small_char(p):=qi(cur_val mod @"10000); -large_fam(p):=(cur_val1 div @"10000) mod @"100; -large_char(p):=qi(cur_val1 mod @"10000); -@z -%--------------------------------------- -@x [48] m.1163 l.22005 - Omega -scan_delimiter(left_delimiter(tail),true); scan_math(nucleus(tail)); -@y -scan_delimiter(left_delimiter(tail),cur_chr+1); scan_math(nucleus(tail)); -@z -%--------------------------------------- -@x [48] m.1165 l.22012 - Omega -procedure math_ac; -begin if cur_cmd=accent then - @<Complain that the user should have said \.{\\mathaccent}@>; -tail_append(get_node(accent_noad_size)); -type(tail):=accent_noad; subtype(tail):=normal; -mem[nucleus(tail)].hh:=empty_field; -mem[subscr(tail)].hh:=empty_field; -mem[supscr(tail)].hh:=empty_field; -math_type(accent_chr(tail)):=math_char; -scan_fifteen_bit_int; -character(accent_chr(tail)):=qi(cur_val mod 256); -if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam -else fam(accent_chr(tail)):=(cur_val div 256) mod 16; -scan_math(nucleus(tail)); -end; -@y -procedure math_ac; -begin if cur_cmd=accent then - @<Complain that the user should have said \.{\\mathaccent}@>; -tail_append(get_node(accent_noad_size)); -type(tail):=accent_noad; subtype(tail):=normal; -mem[nucleus(tail)].hh:=empty_field; -mem[subscr(tail)].hh:=empty_field; -mem[supscr(tail)].hh:=empty_field; -math_type(accent_chr(tail)):=math_char; -if cur_chr=0 then scan_fifteen_bit_int -else scan_big_fifteen_bit_int; -character(accent_chr(tail)):=qi(cur_val mod @"10000); -if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam -else fam(accent_chr(tail)):=(cur_val div @"10000) mod @"100; -scan_math(nucleus(tail)); -end; -@z -%--------------------------------------- -@x [48] m.1174 l.22085 - Omega -@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/ -@y -@z -%--------------------------------------- -@x [48] m.1188 l.22284 - Omega -text(frozen_right):="right"; eqtb[frozen_right]:=eqtb[cur_val]; -@y -settext(frozen_right,"right"); -set_new_eqtb(frozen_right,new_eqtb(cur_val)); -@z -%--------------------------------------- -@x [49] m.1214 l.22700 - Omega -@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#) -@y -@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#) -@d del_word_define(#)==if global - then del_geq_word_define(#)@+else del_eq_word_define(#) -@z -%--------------------------------------- -@x [49] m.1216 l.22734 - Omega -text(frozen_protection):="inaccessible"; -@y -settext(frozen_protection,"inaccessible"); -@z -%--------------------------------------- -@x [49] m.1222 l.22789 - Omega -@d char_def_code=0 {|shorthand_def| for \.{\\chardef}} -@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}} -@d count_def_code=2 {|shorthand_def| for \.{\\countdef}} -@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}} -@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}} -@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}} -@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}} - -@<Put each...@>= -primitive("chardef",shorthand_def,char_def_code);@/ -@!@:char_def_}{\.{\\chardef} primitive@> -primitive("mathchardef",shorthand_def,math_char_def_code);@/ -@!@:math_char_def_}{\.{\\mathchardef} primitive@> -@y -@d char_def_code=0 {|shorthand_def| for \.{\\chardef}} -@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}} -@d omath_char_def_code=2 {|shorthand_def| for \.{\\omathchardef}} -@d count_def_code=3 {|shorthand_def| for \.{\\countdef}} -@d dimen_def_code=4 {|shorthand_def| for \.{\\dimendef}} -@d skip_def_code=5 {|shorthand_def| for \.{\\skipdef}} -@d mu_skip_def_code=6 {|shorthand_def| for \.{\\muskipdef}} -@d toks_def_code=7 {|shorthand_def| for \.{\\toksdef}} - -@<Put each...@>= -primitive("chardef",shorthand_def,char_def_code);@/ -@!@:char_def_}{\.{\\chardef} primitive@> -primitive("mathchardef",shorthand_def,math_char_def_code);@/ -@!@:math_char_def_}{\.{\\mathchardef} primitive@> -primitive("omathchardef",shorthand_def,omath_char_def_code);@/ -@!@:math_char_def_}{\.{\\omathchardef} primitive@> -@z -%--------------------------------------- -@x [49] m.1224 l.22833 - Omega -shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256); - scan_optional_equals; - case n of - char_def_code: begin scan_char_num; define(p,char_given,cur_val); - end; - math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val); - end; -@y -shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; - define(p,relax,too_big_char); scan_optional_equals; - case n of - char_def_code: begin scan_char_num; define(p,char_given,cur_val); - end; - math_char_def_code: begin scan_real_fifteen_bit_int; - define(p,math_given,cur_val); - end; - omath_char_def_code: begin scan_big_fifteen_bit_int; - define(p,omath_given,cur_val); - end; -@z -%--------------------------------------- -@x [49] m.1230 l. - Omega -primitive("mathcode",def_code,math_code_base); -@!@:math_code_}{\.{\\mathcode} primitive@> -primitive("lccode",def_code,lc_code_base); -@!@:lc_code_}{\.{\\lccode} primitive@> -primitive("uccode",def_code,uc_code_base); -@!@:uc_code_}{\.{\\uccode} primitive@> -primitive("sfcode",def_code,sf_code_base); -@!@:sf_code_}{\.{\\sfcode} primitive@> -primitive("delcode",def_code,del_code_base); -@!@:del_code_}{\.{\\delcode} primitive@> -@y -primitive("mathcode",def_code,math_code_base); -@!@:math_code_}{\.{\\mathcode} primitive@> -primitive("omathcode",def_code,math_code_base+256); -@!@:math_code_}{\.{\\omathcode} primitive@> -primitive("lccode",def_code,lc_code_base); -@!@:lc_code_}{\.{\\lccode} primitive@> -primitive("uccode",def_code,uc_code_base); -@!@:uc_code_}{\.{\\uccode} primitive@> -primitive("sfcode",def_code,sf_code_base); -@!@:sf_code_}{\.{\\sfcode} primitive@> -primitive("delcode",def_code,del_code_base); -@!@:del_code_}{\.{\\delcode} primitive@> -primitive("odelcode",def_code,del_code_base+256); -@!@:del_code_}{\.{\\odelcode} primitive@> -@z -%--------------------------------------- -@x [49] m.1232 l.22990 - Omega -def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>; - p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals; - scan_int; - if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then - begin print_err("Invalid code ("); print_int(cur_val); -@.Invalid code@> - if p<del_code_base then print("), should be in the range 0..") - else print("), should be at most "); - print_int(n); - help1("I'm going to use 0 instead of that illegal code value.");@/ - error; cur_val:=0; - end; - if p<math_code_base then define(p,data,cur_val) - else if p<del_code_base then define(p,data,hi(cur_val)) - else word_define(p,cur_val); -@y -def_code: begin - if cur_chr=(del_code_base+256) then begin - p:=cur_chr-256; scan_char_num; p:=p+cur_val; scan_optional_equals; - scan_int; cur_val1:=cur_val; scan_int; {backwards} - if (cur_val1>@"FFFFFF) or (cur_val>@"FFFFFF) then - begin print_err("Invalid code ("); print_int(cur_val1); print(" "); - print_int(cur_val); - print("), should be at most ""FFFFFF ""FFFFFF"); - help1("I'm going to use 0 instead of that illegal code value.");@/ - error; cur_val1:=0; cur_val:=0; - end; - del_word_define(p,cur_val1,cur_val); - end - else begin - @<Let |n| be the largest legal code value, based on |cur_chr|@>; - p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals; - scan_int; - if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then - begin print_err("Invalid code ("); print_int(cur_val); -@.Invalid code@> - if p<del_code_base then print("), should be in the range 0..") - else print("), should be at most "); - print_int(n); - help1("I'm going to use 0 instead of that illegal code value.");@/ - error; cur_val:=0; - end; - if p<math_code_base then define(p,data,cur_val) - else if p<(math_code_base+256) then begin - if cur_val=@"8000 then cur_val:=@"8000000 - else cur_val:=((cur_val div @"1000) * @"1000000) + - (((cur_val mod @"1000) div @"100) * @"10000) + - (cur_val mod @"100); - define(p,data,hi(cur_val)); - end - else if p<del_code_base then define(p-256,data,hi(cur_val)) - else begin - cur_val1:=cur_val div @"1000; - cur_val1:=(cur_val1 div @"100)*@"10000 + (cur_val1 mod @"100); - cur_val:=cur_val mod @"1000; - cur_val:=(cur_val div @"100)*@"10000 + (cur_val mod @"100); - del_word_define(p,cur_val1,cur_val); - end; - end; -@z -%--------------------------------------- -@x [49] m.1233 l.22990 - Omega -if cur_chr=cat_code_base then n:=max_char_code -else if cur_chr=math_code_base then n:=@'100000 -else if cur_chr=sf_code_base then n:=@'77777 -else if cur_chr=del_code_base then n:=@'77777777 -else n:=255 -@y -if cur_chr=cat_code_base then n:=max_char_code -else if cur_chr=math_code_base then n:=@'100000 -else if cur_chr=(math_code_base+256) then n:=@"8000000 -else if cur_chr=sf_code_base then n:=@'77777 -else if cur_chr=del_code_base then n:=@'77777777 -else n:=biggest_char -@z -%--------------------------------------- -@x [49] m.1234 l.22990 - Omega -def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val; -@y -def_family: begin p:=cur_chr; scan_big_four_bit_int; p:=p+cur_val; -@z -%--------------------------------------- -@x [49] m.1238 l.23059 - Omega - if q=advance then cur_val:=cur_val+eqtb[l].int; -@y - if q=advance then cur_val:=cur_val+new_eqtb_int(l); -@z -%--------------------------------------- -@x [49] m.1240 l.23086 - Omega - if p=int_val then cur_val:=mult_integers(eqtb[l].int,cur_val) - else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0) - else cur_val:=x_over_n(eqtb[l].int,cur_val) -@y - if p=int_val then cur_val:=mult_integers(new_eqtb_int(l),cur_val) - else cur_val:=nx_plus_y(new_eqtb_int(l),cur_val,0) - else cur_val:=x_over_n(new_eqtb_int(l),cur_val) -@z -%--------------------------------------- -@x [49] m.1241 l.23109 - Omega - if global then n:=256+cur_val@+else n:=cur_val; -@y - if global then n:=number_regs+cur_val@+else n:=cur_val; -@z -%--------------------------------------- -@x [49] m.1289 l.23546 - Omega -|cs_token_flag+active_base| is a multiple of~256. -@y -|cs_token_flag+active_base| is a multiple of~|max_char_val|. -@z -%--------------------------------------- -@x [49] m.1289 l.23552 - Omega - begin c:=t mod 256; -@y - begin c:=t mod max_char_val; -@z -%--------------------------------------- -@x [50] m.1313 l.23892 - Omega -@<Dump regions 1 to 4 of |eqtb|@>; -@<Dump regions 5 and 6 of |eqtb|@>; -@y -dump_eqtb_table; -@z -%--------------------------------------- -@x [50] m.1314 l.23904 - Omega -@<Undump regions 1 to 6 of |eqtb|@>; -@y -undump_eqtb_table; -@z -%--------------------------------------- -@x [50] m.1315 l.23904 - Omega -@ The table of equivalents usually contains repeated information, so we dump it -in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the -format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra -copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$. - -@<Dump regions 1 to 4 of |eqtb|@>= -k:=active_base; -repeat j:=k; -while j<int_base-1 do - begin if (equiv(j)=equiv(j+1))and(eq_type(j)=eq_type(j+1))and@| - (eq_level(j)=eq_level(j+1)) then goto found1; - incr(j); - end; -l:=int_base; goto done1; {|j=int_base-1|} -found1: incr(j); l:=j; -while j<int_base-1 do - begin if (equiv(j)<>equiv(j+1))or(eq_type(j)<>eq_type(j+1))or@| - (eq_level(j)<>eq_level(j+1)) then goto done1; - incr(j); - end; -done1:dump_int(l-k); -while k<l do - begin dump_wd(eqtb[k]); incr(k); - end; -k:=j+1; dump_int(k-l); -until k=int_base - -@ @<Dump regions 5 and 6 of |eqtb|@>= -repeat j:=k; -while j<eqtb_size do - begin if eqtb[j].int=eqtb[j+1].int then goto found2; - incr(j); - end; -l:=eqtb_size+1; goto done2; {|j=eqtb_size|} -found2: incr(j); l:=j; -while j<eqtb_size do - begin if eqtb[j].int<>eqtb[j+1].int then goto done2; - incr(j); - end; -done2:dump_int(l-k); -while k<l do - begin dump_wd(eqtb[k]); incr(k); - end; -k:=j+1; dump_int(k-l); -until k>eqtb_size - -@ @<Undump regions 1 to 6 of |eqtb|@>= -k:=active_base; -repeat undump_int(x); -if (x<1)or(k+x>eqtb_size+1) then goto bad_fmt; -for j:=k to k+x-1 do undump_wd(eqtb[j]); -k:=k+x; -undump_int(x); -if (x<0)or(k+x>eqtb_size+1) then goto bad_fmt; -for j:=k to k+x-1 do eqtb[j]:=eqtb[k-1]; -k:=k+x; -until k>eqtb_size -@y - -@z -%--------------------------------------- -@x [50] m.1318 l.23967 - Omega -@<Dump the hash table@>= -dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used; -for p:=hash_base to hash_used do if text(p)<>0 then - begin dump_int(p); dump_hh(hash[p]); incr(cs_count); - end; -for p:=hash_used+1 to undefined_control_sequence-1 do dump_hh(hash[p]); -dump_int(cs_count);@/ -print_ln; print_int(cs_count); print(" multiletter control sequences") -@y -@<Dump the hash table@>= -dump_int(hash_used); -@z -%--------------------------------------- -@x [50] m.1319 l.23976 - Omega -undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1; -repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]); -until p=hash_used; -for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]); -undump_int(cs_count) -@y -undump(hash_base)(frozen_control_sequence)(hash_used); -@z -%--------------------------------------- -@x [50] m.1324 l.24066 - Omega -for k:=0 to trie_max do dump_hh(trie[k]); -@y -for k:=0 to trie_max do dump_hh(trie[k]); -dump_int(max_hyph_char); -@z -%--------------------------------------- -@x [50] m.1324 l.24078 - Omega -for k:=255 downto 0 do if trie_used[k]>min_quarterword then -@y -for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then -@z -%--------------------------------------- -@x [50] m.1325 l.24094 - Omega -for k:=0 to j do undump_hh(trie[k]); -@y -for k:=0 to j do undump_hh(trie[k]); -undump_int(max_hyph_char); -@z -%--------------------------------------- -@x [50] m.1325 l.24101 - Omega -init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/ -k:=256; -@y -init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/ -k:=biggest_lang+1; -@z -%--------------------------------------- -@x [50] m.1326 l.24100 - Omega -dump_int(interaction); dump_int(format_ident); dump_int(69069); -tracing_stats:=0 -@y -dump_int(interaction); dump_int(format_ident); dump_int(69069); -set_new_eqtb_int(int_base+tracing_stats_code,0) -@z -%--------------------------------------- -@x [53] m.1341 l.24506 - Omega -@d what_lang(#)==link(#+1) {language number, in the range |0..255|} -@y -@d what_lang(#)==link(#+1) {language number, in the range |0..biggest_lang|} -@z -%--------------------------------------- -@x [53] m.1370 -@!write_file:array[0..15] of alpha_file; -@y -@!outside_string_array: array[0..1000] of 0..255; -@!write_file:array[0..15] of alpha_file; -@z -%--------------------------------------- -@x [53] m. l.24761 - Omega -text(end_write):="endwrite"; eq_level(end_write):=level_one; -eq_type(end_write):=outer_call; equiv(end_write):=null; -@y -settext(end_write,"endwrite"); set_eq_level(end_write,level_one); -set_eq_type(end_write,outer_call); set_equiv(end_write,null); -@z -%--------------------------------------- -@x [53] m.1376 l.24878 - Omega -else if language>255 then l:=0 -@y -else if language>biggest_lang then l:=0 -@z -%--------------------------------------- -@x [53] m.1377 l.24893 - Omega - else if cur_val>255 then clang:=0 -@y - else if cur_val>biggest_lang then clang:=0 -@z -%--------------------------------------- -@x [54] -This section should be replaced, if necessary, by any special -modifications of the program -that are necessary to make \TeX\ work at a particular installation. -It is usually best to design your change file so that all changes to -previous sections preserve the section numbering; then everybody's version -will be consistent with the published program. More extensive changes, -which introduce new sections, can be inserted here; then only the index -itself will get a new section number. -@^system dependencies@> - -@y -@* \[54] $\Omega$ changes. - -@z -%--------------------------------------- |