% This is etex_vms.ch, a WEB change file produced by webmerge.tex
% to be applied to [--.knuth]tex.web
% combining the changes (one after the other) from
% 1. [-.web]etex.ch
% 2. tex_vms.ch
% 3. etex_vms.ech
@x l.1
% This program is copyright (C) 1982 by D. E. Knuth; all rights are reserved.
% Copying of this file is authorized only if (1) you are D. E. Knuth, or if
% (2) you make absolutely no changes to your copy. (The WEB system provides
% for alterations via an auxiliary file; the master file should stay intact.)
% See Appendix H of the WEB manual for hints on how to install this program.
% And see Appendix A of the TRIP manual for details about how to validate it.
% TeX is a trademark of the American Mathematical Society.
% METAFONT is a trademark of Addison-Wesley Publishing Company.
@y
% e-TeX is copyright (C) 1994,98 by the NTS team; all rights are reserved.
% Copying of this file is authorized only if (1) you are a member of the
% NTS team, or if (2) you make absolutely no changes to your copy.
% (Programs such as PATCHWEB, TIE, or WEBMERGE allow the application of
% several change files to tex.web; the master files tex.web and etex.ch
% should stay intact.)
% See etex_gen.tex for hints on how to install this program.
% And see etripman.tex for details about how to validate it.
% e-TeX and NTS are trademarks of the NTS group.
% TeX is a trademark of the American Mathematical Society.
% METAFONT is a trademark of Addison-Wesley Publishing Company.
% This program is directly derived from Donald E. Knuth's TeX;
% the change history which follows and the reward offered for finders of
% bugs refer specifically to TeX; they should not be taken as referring
% to e-TeX, although the change history is relevant in that it
% demonstrates the evolutionary path followed. This program is not TeX;
% that name is reserved strictly for the program which is the creation
% and sole responsibility of Professor Knuth.
@z
@x l.50
% Although considerable effort has been expended to make the TeX program
% correct and reliable, no warranty is implied; the author disclaims any
% obligation or liability for damages, including but not limited to
% special, indirect, or consequential damages arising out of or in
% connection with the use or performance of this software. This work has
% been a ``labor of love'' and the author hopes that users enjoy it.
@y
% A preliminary version of TeX--XeT was released in April 1992.
% TeX--XeT version 1.0 was released in June 1992,
% version 1.1 prevented arith overflow in glue computation (Oct 1992).
% A preliminary e-TeX version 0.95 was operational in March 1994.
% Version 1.0beta was released in May 1995.
% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995).
% Version 1.02beta allowed 256 mark classes (March 1996).
% Version 1.1 changed \group{type,level} -> \currentgroup{type,level},
% first public release (October 1996).
% Version 2.0 development was started in March 1997;
% fixed a ligature-\beginR bug in January 1998;
% was released in March 1998.
% Although considerable effort has been expended to make the e-TeX program
% correct and reliable, no warranty is implied; the authors disclaim any
% obligation or liability for damages, including but not limited to
% special, indirect, or consequential damages arising out of or in
% connection with the use or performance of this software. This work has
% been a ``labor of love'' and the authors hope that users enjoy it.
@z
@x l.61
\let\mc=\ninerm % medium caps for names like SAIL
@y
\let\mc=\ninerm % medium caps for names like SAIL
\def\eTeX{$\varepsilon$-\TeX}
\font\revrm=xbmc10 % for right-to-left text
% to generate xbmc10 (i.e., reflected cmbx10) use a file
% xbmc10.mf containing:
%+++++++++++++++++++++++++++++++++++++++++++++++++
% if unknown cmbase: input cmbase fi
% extra_endchar := extra_endchar &
% "currentpicture:=currentpicture " &
% "reflectedabout((.5[l,r],0),(.5[l,r],1));";
% input cmbx10
%+++++++++++++++++++++++++++++++++++++++++++++++++
\ifx\beginL\undefined % this is TeX
\def\XeT{X\kern-.125em\lower.5ex\hbox{E}\kern-.1667emT}
\def\TeXeT{\TeX-\hbox{\revrm \XeT}} % for TeX-XeT
\def\TeXXeT{\TeX-\hbox{\revrm -\XeT}} % for TeX--XeT
\else
\ifx\eTeXversion\undefined % this is \TeXeT
\def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT
\def\TeXXeT{\TeX-{\revrm\beginR\TeX-\endR}} % for TeX--XeT
\else % this is \eTeX
\def\TeXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX\endR}} % for TeX-XeT
\def\TeXXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX-\endR}} % for TeX--XeT
\fi
\fi
@z
@x l.64
\def\pct!{{\char`\%}} % percent sign in ordinary text
@y
\def\pct!{{\char`\%}} % percent sign in ordinary text
\def\grp{\.{\char'173...\char'175}}
@z
@x l.80
\def\title{\TeX82}
@y
\def\title{\eTeX}
% system dependent redefinitions of \title should come later
% and should use:
% \toks0=\expandafter{\title}
% \edef\title{...\the\toks0...}
\let\maybe=\iffalse % print only changed modules
@z
@x l.86
\pageno=3
@y
\pageno=3
\let\maybe=\iffalse %%% PT 8-DEC-1997 17:49:48
\toks0=\expandafter{\title}
\maybe
\edef\title{\the\toks0\ 3.14159 [PD VMS 3.6]}
\else
\edef\title{\the\toks0\ 3.14159 [PD VMS 3.6] changes}
\fi
\def\LaTeX{{\rm L\kern-.3em\raise.33ex\hbox{\sc A}\kern-.15em\TeX}}
@z
@x l.91
This is \TeX, a document compiler intended to produce typesetting of high
@y
This is \eTeX, a program derived from and extending the capabilities of
\TeX, a document compiler intended to produce typesetting of high
@z
@x l.179
If this program is changed, the resulting system should not be called
@y
This program contains code for various features extending \TeX,
therefore this program is called `\eTeX' and not
@z
@x l.185
November 1984].
@y
November 1984].
A similar test suite called the ``\.{e-TRIP} test'' is available for
helping to determine whether a particular implementation deserves to be
known as `\eTeX'.
@z
@x l.187
@d banner=='This is TeX, Version 3.14159' {printed when \TeX\ starts}
@y
This change file is the result of a long odyssey of change files beginning with
the original change files created in 1984 by David Fuchs; many people have made
significant contributions since then, the most notable of whom have been Brian
Hamilton Kelly, Niel Kempson, and Adrian Clark
@d banner=='This is TeX, Version 3.14159 [PD VMS 3.6]'
@#
@d eTeX_version_string=='3.14159-2.0' {current \eTeX\ version}
@d eTeX_version=2 { \.{\\eTeXversion} }
@d eTeX_revision==".0" { \.{\\eTeXrevision} }
@#
@d eTeX_banner=='This is e-TeX, Version ', eTeX_version_string,
';fMar06 [PD VMS 3.6f]' {printed when \eTeX\ starts}
@#
@d TEX==ETEX {change program name into |ETEX|}
@#
@d TeXXeT_code=0 {the \TeXXeT\ feature is optional}
@#
@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|}
@z
@x l.249
procedure initialize; {this procedure gets things started properly}
@y
@t\4@>@<VMS procedures@>@/
procedure initialize; {this procedure gets things started properly}
@z
@x l.292
@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
@y
@d debug==@{
@d gubed==@t\2@>@}
@z
@x l.297
@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
usage statistics}
@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
usage statistics}
@y
@d stat==
@d tats==@t\2@>
@z
@x l.310
the codewords `$|init|\ldots|tini|$'.
@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
@y
the codewords `$|init|\ldots|tini|$' for declarations and by the codewords
`$|Init|\ldots|Tini|$' for executable code. This distinction is helpful for
implementations where a run-time switch differentiates between the two
versions of the program.
@d init==
@d tini==
@d Init==init if init_flag then begin
@d Tini==end;@+tini
@f Init==begin
@f Tini==end
@z
@x l.319
@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
@y
@!Init @<Initialize table entries (done by \.{INITEX} only)@>@;@+Tini
@z
@x l.321
@ If the first character of a \PASCAL\ comment is a dollar sign,
\ph\ treats the comment as a list of ``compiler directives'' that will
affect the translation of this program into machine language. The
directives shown below specify full checking and inclusion of the \PASCAL\
debugger when \TeX\ is being debugged, but they cause range checking and other
redundant code to be eliminated when the production system is being generated.
Arithmetic overflow will be detected in all cases.
@^system dependencies@>
@^Overflow in arithmetic@>
@<Compiler directives@>=
@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
@y
@ When the \PASCAL\ program generated as a result of `tangling' the \.{WEB} with
the change file is compiled under VMS, command line qualifiers should be
included to specify full checking and inclusion of debugger symbol records
whilst \TeX\ is being debugged, but eliminate range checking and other
redundant code when the production system is being generated.
Arithmetic overflow should be detected in all cases.
@^system dependencies@>
@^Overflow in arithmetic@>
Under VMS, we arrange to `inherit' the descriptions of standard system
services and named constants from the precompiled \PASCAL\ environment held in
|'SYS$LIBRARY:STARLET.PEN'|---we do \&{not} specify whether or not any specific
level of run-time checks shall be included, because any such attribute applied
within the source code cannot be overridden by a command line qualifier when
\TeX\ is compiled.
This library does not include \&{all} the library routines that are used by
\TeX82 under VMS, so other routines are declared as required using \PASCAL's
syntax for |extern| routines.
@f extern==forward
@<Compiler directives@>=
@/@=[inherit('sys$library:starlet')]@>@\
{allows us to use system symbols and routines}
@z
@x l.364
@d othercases == others: {default for cases not listed explicitly}
@y
Fortunately for us, VAX-\PASCAL\ \&{does} support this default mechanism.
@d othercases == otherwise {default for cases not listed explicitly}
@z
@x l.373
@^system dependencies@>
@<Constants...@>=
@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
must be strictly less than |max_halfword|;
must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
@!mem_min=0; {smallest index in \TeX's internal |mem| array;
must be |min_halfword| or more;
must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
@!buf_size=500; {maximum number of characters simultaneously present in
current lines of open files and in control sequences between
\.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
@!error_line=72; {width of context lines on terminal error messages}
@!half_error_line=42; {width of first lines of contexts in terminal
error messages; should be between 30 and |error_line-15|}
@!max_print_line=79; {width of longest text lines output; should be at least 60}
@!stack_size=200; {maximum number of simultaneous input sources}
@!max_in_open=6; {maximum number of input files and error insertions that
can be going on simultaneously}
@!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}
@!param_size=60; {maximum number of simultaneous macro parameters}
@!nest_size=40; {maximum number of semantic levels simultaneously active}
@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
@!string_vacancies=8000; {the minimum number of characters that should be
available for the user's control sequences and font names,
after \TeX's own error messages are stored}
@!pool_size=32000; {maximum number of characters in strings, including all
error messages and help texts, and the names of all fonts and
control sequences; must exceed |string_vacancies| by the total
length of \TeX's own strings, which is currently about 23000}
@!save_size=600; {space for saving values outside of current group; must be
at most |max_halfword|}
@!trie_size=8000; {space for hyphenation patterns; should be larger for
\.{INITEX} than it is in production versions of \TeX}
@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns}
@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
@!file_name_size=40; {file names shouldn't be longer than this}
@!pool_name='TeXformats:TEX.POOL ';
{string of length |file_name_size|; tells where the string pool appears}
@y
Since a number of arrays of |file_name_size| are used in this program to receive
the full file specification of files when they are opened, it is necessary to
extend this constant to 255, which is the maximum possible size that VAX/RMS can
@.RMS@>
@^Record Management Services@>
return. It is not necessary, however, to pad out |pool_name| to this size
(which would in any case prove ``difficult'' in WEB, because VAX-\PASCAL\
automatically pads short strings with spaces when assigned into longer
variables. Furthermore, because the area where the pool file resides is
specified at run time, we need to make |pool_name| into a variable which
will be set shortly after we determine the value of the name of the format
area. Here, we define the constant |pool_f_name| instead, which holds
the name of the pool file without any area specification.
@^system dependencies@>
@<Constants...@>=
@!mem_max=327144; {greatest index in \TeX's internal |mem| array;
must be strictly less than |max_halfword|;
must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
@!mem_min=0; {smallest index in \TeX's internal |mem| array;
must be |min_halfword| or more;
must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
@!buf_size=2048; {maximum number of characters simultaneously present in
current lines of open files and in control sequences between
\.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
@!size_input_line=133; {maximum size of an input line}
@!error_line=79; {width of context lines on terminal error messages}
@!half_error_line=50; {width of first lines of contexts in terminal
error messages; should be between 30 and |error_line-15|}
@!max_print_line=79; {width of longest text lines output; should be at least 60}
@!stack_size=200; {maximum number of simultaneous input sources}
@!max_in_open=12; {maximum number of input files and error insertions that
can be going on simultaneously}
@!font_max=255; {maximum internal font number; must not exceed |max_quarterword|
and must be at most |font_base+256|}
@!font_mem_size=81920; {number of words of |font_info| for all fonts}
@!param_size=60; {maximum number of simultaneous macro parameters}
@!nest_size=40; {maximum number of semantic levels simultaneously active}
@!max_strings=15400; {maximum number of strings; must not exceed |max_halfword|}
@!string_vacancies=160000; {the minimum number of characters that should be
available for the user's control sequences and font names,
after \TeX's own error messages are stored}
@!pool_size=186000; {maximum number of characters in strings, including all
error messages and help texts, and the names of all fonts and
control sequences; must exceed |string_vacancies| by the total
length of \TeX's own strings, which is currently about 23800 for VMS \TeX\
and 24550 for VMS \eTeX}
@!save_size=2000; {space for saving values outside of current group; must be
at most |max_halfword|}
@!trie_size=45000; {space for hyphenation patterns; should be larger for
\.{INITEX} than it is in production versions of \TeX}
@#
@!trie_op_size=1000; {space for ``opcodes'' in the hyphenation patterns}
@!dvi_buf_size=1024; {size of the output buffer; must be a multiple of 8}
@!VAX_block_length=512; {must be half |dvi_buf_size| on VMS}
@!file_name_size=255; {file names shouldn't be longer than this}
@#
@!pool_f_name='ETEX.POOL';
{string \&{not} of length |file_name_size|; tells the name of the string
pool}
@z
@x l.427
@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
must not be less than |mem_min|}
@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
must be substantially larger than |mem_bot|
and not greater than |mem_max|}
@d font_base=0 {smallest internal font number; must not be less
than |min_quarterword|}
@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 mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
must not be less than |mem_min|}
@d mem_top==327144 {largest index in the |mem| array dumped by \.{INITEX};
must be substantially larger than |mem_bot|
and not greater than |mem_max|}
@d font_base=0 {smallest internal font number; must not be less
than |min_quarterword|}
@d hash_size=10000 {maximum number of control sequences; it should be at most
about |(mem_max-mem_min)/10|}
@d hash_prime=8501 {a prime number equal to about 85\pct! of |hash_size|}
@d hyph_size=503 {another prime; the number of \.{\\hyphenation} exceptions}
@z
@x l.493
@d not_found=45 {go here when you've found nothing}
@y
@d not_found=45 {go here when you've found nothing}
@d not_found1=46 {like |not_found|, when there's more than one}
@d not_found2=47 {like |not_found|, when there's more than two}
@d not_found3=48 {like |not_found|, when there's more than three}
@d not_found4=49 {like |not_found|, when there's more than four}
@z
@x l.719
@^character set dependencies@>
@^system dependencies@>
@<Set init...@>=
for i:=0 to @'37 do xchr[i]:=' ';
for i:=@'177 to @'377 do xchr[i]:=' ';
@y
@^character set dependencies@>
@^system dependencies@>
The code shown here is intended to be used on VMS systems,
and at other installations where only the printable ASCII set, plus
|carriage_return|, |tab|, and |form_feed| will show up in text files.
All |line_feed| and |null| characters are skipped.
We also permit characters taken from columns 10--15 of the extended ISO
character set; macro packages can then utilize these character codes for
multilingual support.
@d form_feed=@'14 {ASCII code used at end of a page}
@d tab=@'11
@<Set initial values...@>=
xchr[0]:=' ';
for i:=1 to @'37 do xchr[i]:=chr(i);
xchr[form_feed]:=chr(form_feed);
xchr[tab]:=chr(tab);
for i:=@'177 to @'237 do xchr[i]:=' ';
for i:=@'240 to @'377 do xchr[i]:=chr(i);
@z
@x l.766
The program actually makes use also of a third kind of file, called a
|word_file|, when dumping and reloading base information for its own
initialization. We shall define a word file later; but it will be possible
for us to specify simple operations on word files before they are defined.
@y
The program actually makes use also of a third kind of file, called a
|word_file|, when dumping and reloading base information for its own
initialization. We shall define a word file later; but it will be possible
for us to specify simple operations on word files before they are defined.
Since the \.{WEB} already uses the name |text| for its own purposes, we have to
define a macro to permit access to this VAX-\PASCAL\ file type identifier.
@d VAX_text==@= text @>
@z
@x l.773
@!alpha_file=packed file of text_char; {files that contain textual data}
@!byte_file=packed file of eight_bits; {files that contain binary data}
@y
@!alpha_file=VAX_text; {files that contain textual data}
@!byte_block=packed array[0..VAX_block_length-1] of eight_bits;
@!byte_file=packed file of byte_block; {files that contain binary data}
@z
@x l.784
implement \TeX\ can open a file whose external name is specified by
|name_of_file|.
@^system dependencies@>
@<Glob...@>=
@!name_of_file:packed array[1..file_name_size] of char;@;@/
{on some systems this may be a \&{record} variable}
@!name_length:0..file_name_size;@/{this many characters are actually
relevant in |name_of_file| (the rest are blank)}
@y
implement \TeX\ can open a file whose external name is specified by
|name_of_file|. Any VAX-\PASCAL\ defaults may be supplied in |default_name|;
this is used to expand partial file specifications given on such qualifiers as
\.{/LOG}, in combination with other parts taken from the file specification of
the \.{.TeX} file.
@^system dependencies@>
@<Glob...@>=
@!name_of_file, @!default_name:packed array[1..file_name_size] of char;@;@/
{on some systems this may be a \&{record} variable}
@!name_length, @!deflt_length : file_size;@/
{this many characters are actually relevant in |name_of_file|
(the rest are blank)}
@z
@x l.794
@ The \ph\ compiler with which the present version of \TeX\ was prepared has
extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
we can write
$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
|reset(f,@t\\{name}@>,'/O')|&for input;\cr
|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
The `\\{name}' parameter, which is of type `{\bf packed array
$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
the external file that is being opened for input or output.
Blank spaces that might appear in \\{name} are ignored.
The `\.{/O}' parameter tells the operating system not to issue its own
error messages if something goes wrong. If a file of the specified name
cannot be found, or if such a file cannot be opened for some other reason
(e.g., someone may already be trying to write the same file), we will have
|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
\TeX\ to undertake appropriate corrective action.
@:PASCAL H}{\ph@>
@^system dependencies@>
\TeX's file-opening procedures return |false| if no file identified by
|name_of_file| could be opened.
@d reset_OK(#)==erstat(#)=0
@d rewrite_OK(#)==erstat(#)=0
@p function a_open_in(var f:alpha_file):boolean;
@y
@ Under VAX-\PASCAL, we can open files with names that are not known at compile
time through use of the VAX-specific procedure |open|, which takes too many
varied parameters to describe here: for example, the third parameter controls
whether a new file shall be generated, or can enforce that an existing file
cannot possibly be altered.
@^system dependencies@>
However, one in particular deserves special mention: the |user_action| parameter
when included causes execution of a user-supplied routine which can
manipulate the data structures used by RMS (Record Management Services) and thus
@.RMS@>
@^Record Management Services@>
permit finer control over the actions undertaken during the opening or creation
of files.
All file manipulation procedures in VAX-\PASCAL\ (including |open|/|close|,
|read|/|write|, etc.)\ can take an optional parameter which specifies whether
or no the program shall continue execution after an error. Since we code to
detect such errors, we nearly always make use of this facility.
\TeX's file-opening procedures return |false| if no file identified by
|name_of_file| could be opened: note that VAX-\PASCAL's |status| function
returns zero if the previous file operation was successfully completed, |-1| if
|eof| would be |true|, and a positive integer if any error was detected.
When a |new| file is opened, we specify that it shall be deleted when the
program exits; this ensures that output files are correctly discarded if \TeX\
is interrupted in its work. Later, when the files are closed, we can arrange to
keep the files instead. VAX-\PASCAL's |open| procedure also allows us to
specify a `default' file specification, which is used to supply defaults for
those parts of the specification of the file being created that have not
otherwise been provided by the user.
Whenever a |word_file| is opened, the variable |fmt_count| is reset to zero to
ensure that the first byte of the VAX block is that first accessed.
@d VAX_user_action==@=user_action@>
@#
@d VAX_new==@= new @>
@d VAX_readonly==@= readonly @>
@#
@d VAX_default==@= default @>
@#
@d VAX_disposition_delete==@=disposition:=delete@>
@d VAX_ignore_error==@=error:=continue@>
@p function a_open_in(var f:alpha_file):boolean;
@z
@x l.822
begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
@y
begin
open(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
VAX_ignore_error);
if status(f)>0 then a_open_in:=false
else begin
reset(f,VAX_ignore_error);
a_open_in:=status(f)<=0;
end;
@z
@x l.827
begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
@y
begin
open(f,name_of_file,VAX_new,16383,VAX_disposition_delete,
VAX_default:=default_name,
VAX_user_action:=user_rewrite,VAX_ignore_error);
if status(f)>0 then a_open_out:=false
else begin
linelimit(f,maxint);
rewrite(f,VAX_ignore_error);
a_open_out:=status(f)<=0;
end;
@z
@x l.832
begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
@y
begin
open(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
VAX_ignore_error);
if status(f)>0 then b_open_in:=false
else begin
reset(f,VAX_ignore_error);
b_open_in:=status(f)<=0;
end;
@z
@x l.837
begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
@y
begin
open(f,name_of_file,VAX_new,VAX_disposition_delete,
VAX_default:=default_name,
VAX_user_action:=user_rewrite,VAX_ignore_error);
if status(f)>0 then b_open_out:=false
else begin
rewrite(f,VAX_ignore_error);
b_open_out:=status(f)<=0;
end;
@z
@x l.842
begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
@y
begin
open(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
VAX_ignore_error);
if status(f)>0 then w_open_in:=false
else begin
reset(f,VAX_ignore_error);
w_open_in:=status(f)<=0;
end;
fmt_count:=0;
@z
@x l.847
begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
@y
begin
open(f,name_of_file,VAX_new,VAX_disposition_delete,
VAX_user_action:=user_rewrite,VAX_ignore_error);
if status(f)>0 then w_open_out:=false
else begin
rewrite(f,VAX_ignore_error);
w_open_out:=status(f)<=0;
end;
fmt_count:=0;
@z
@x l.850
@ Files can be closed with the \ph\ routine `|close(f)|', which
@^system dependencies@>
should be used when all input or output with respect to |f| has been completed.
This makes |f| available to be opened again, if desired; and if |f| was used for
output, the |close| operation makes the corresponding external file appear
on the user's area, ready to be read.
These procedures should not generate error messages if a file is
being closed before it has been successfully opened.
@p procedure a_close(var f:alpha_file); {close a text file}
begin close(f);
@y
@ Files can be closed with the VAX-\PASCAL\ routine
|close(f,disposition,error)|, which
@^system dependencies@>
should be used when all input or output with respect to |f| has been completed.
This makes |f| available to be opened again, if desired; and if |f| was used for
output, the |close| operation can make the corresponding external file appear
in the user's directory, ready to be read: this depends upon the value of the
|disposition| parameter, which can (\\{inter alia}) control whether the file is
kept or discarded. If this parameter is not specified, then disposition of the
file is determined by the corresponding parameter of the |open| routine.
It is through this mechanism that we are able to ensure that all output files
are discarded if the operation of \TeX\ is aborted by the user, and yet are kept
if the program terminates correctly.
These procedures should not generate error messages if a file is
being closed before it has been successfully opened; the |error| parameter is
used here to ensure that any such errors do not cause run-time failures.
@d VAX_disposition_save==@=disposition:=save@>
@p procedure a_close(var f:alpha_file); {close a text file}
begin close(f,VAX_disposition_save,VAX_ignore_error);
@z
@x l.865
begin close(f);
@y
begin close(f,VAX_disposition_save,VAX_ignore_error);
@z
@x l.869
begin close(f);
@y
begin close(f,VAX_disposition_save,VAX_ignore_error);
@z
@x l.885
representing the beginning and ending of a line of text.
@<Glob...@>=
@y
representing the beginning and ending of a line of text.
On VMS, we will read the lines first into an auxiliary buffer, in
order to save the running time of procedure-call overhead. We have
to be very careful to handle lines longer than the arbitrarily chosen
length of the |aux_buf|. This buffer is declared using a VAX-\PASCAL\ extension
for variable length strings, namely the |varying| array type. Such arrays
actually appear as if they were a record declared with two fields, thus:
|varying [max_size] of = record length: 0..max_size; body: packed array
[1..max_size] of|.
@d VAX_length(#)==#.@=length@>
@d VAX_body(#)==#.@=body@>
@f varying==array
@<Glob...@>=
@!aux_buf:varying [size_input_line] of char; {where the characters go first}
@z
@x l.928
of characters at once, if such routines are available. The following
code uses standard \PASCAL\ to illustrate what needs to be done, but
finer tuning is often possible at well-developed \PASCAL\ sites.
@^inner loop@>
@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
{inputs the next line or returns |false|}
var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
begin if bypass_eoln then if not eof(f) then get(f);
{input the first character of the line into |f^|}
last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
if eof(f) then input_ln:=false
else begin last_nonblank:=first;
while not eoln(f) do
begin if last>=max_buf_stack then
begin max_buf_stack:=last+1;
if max_buf_stack=buf_size then
@<Report overflow of the input buffer, and abort@>;
end;
buffer[last]:=xord[f^]; get(f); incr(last);
if buffer[last-1]<>" " then last_nonblank:=last;
end;
last:=last_nonblank; input_ln:=true;
end;
end;
@y
of characters at once, if such routines are available. The following
code uses VAX-\PASCAL\ extensions, such as |varying| strings to perform input of
larger amounts of characters with a single input instruction.
@^inner loop@>
Under VAX-\PASCAL, it is not necessary to take special action to |bypass_eoln|,
since the terminator character will be included in those read into the
|aux_buf|.
@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
{inputs the next line or returns |false|}
label found;
var @!len:integer; {length of line input}
@!k:0..buf_size; {index into |buffer|}
begin
last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
if status(f)<>0 then input_ln:=false
else begin
while not eoln(f) do
begin read(f,aux_buf,VAX_ignore_error);
len:=VAX_length(aux_buf);
if last+len>=max_buf_stack then
begin
if last+len<buf_size then max_buf_stack:=last+len
else
@<Report overflow of the input buffer, and abort@>;
end;
for k:=last to last+len-1 do buffer[k]:=xord[aux_buf[k-last+1]];
last:=last+len;
end;
found: if last>first then if buffer[last-1]=" " then begin
decr(last); goto found; end;
input_ln:=true;
read_ln(f,VAX_ignore_error);
end;
end;
@z
@x l.964
@ Here is how to open the terminal files
in \ph. The `\.{/I}' switch suppresses the first |get|.
@^system dependencies@>
@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
@y
@ Here is how to open the terminal files
under VMS.
@^system dependencies@>
The standard input and output proces-permanent files \.{SYS\$INPUT} and
\.{SYS\$OUTPUT}
@.SYS{\$}INPUT@>
@.SYS{\$}OUTPUT@>
are opened, and the addresses of the associated |FAB| and |RAB| noted so that
special actions (such as flushing the input buffer) can be coded.
Output occurs without any implicit carriage-control: this
permits the output buffer to be flushed to the terminal without terminating the
line of output; it is necessary to output the carriage-return, line-feed
character pair explicitly when the line is to be terminated.
@d VAX_sys_input==@= 'SYS$INPUT' @>
@d VAX_sys_output==@= 'SYS$OUTPUT' @>
@d VAX_PAS_FAB==@= PAS$FAB@>
@d VAX_PAS_RAB==@= PAS$RAB@>
@d VAX_carriage_control==@= carriage_control @>
@d VAX_none==@= none @>
@#
@d t_open_in==begin open(term_in,VAX_sys_input);
reset(term_in);
in_FAB:=VAX_PAS_FAB(term_in);
in_RAB:=VAX_PAS_RAB(term_in);
end {open the terminal for text input}
@d t_open_out==begin
open(term_out,VAX_sys_output,VAX_carriage_control:=VAX_none);
linelimit(term_out,maxint);
rewrite(term_out);
out_FAB:=VAX_PAS_FAB(term_out);
out_RAB:=VAX_PAS_RAB(term_out);
end {open the terminal for text output}
@z
@x l.982
these operations can be specified in \ph:
@^system dependencies@>
@d update_terminal == break(term_out) {empty the terminal output buffer}
@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
@y
these operations can be specified on VMS in VAX-\PASCAL\ or DEC-\PASCAL,
through manipulation of the data structures maintained in the |RAB|
(Record Access Block)
@^Record Access Block@>
by RMS.
@^RMS@>
@^Record Management Services@>
Since |wake_up_terminal|
is only called just before output of an error message, there's no significant
overhead in its being a procedure, and this saves 8k bytes of \PASCAL\ source
compared with having it as a \.{WEB} definition.
@^system dependencies@>
To prevent spurious empty writes to the terminal in |batch_mode|, we apply a
condition to |update_terminal|.
@d VAX_RAB_purge_typeahead== @=RAB$V_PTA@>
@d VAX_RAB_cancel_ctrlO== @=RAB$V_CCO@>
@#
@d update_terminal == if odd(selector) then write_ln(term_out)
{empty the terminal output buffer}
@d clear_terminal == in_RAB^.VAX_RAB_purge_typeahead:=true
{clear the terminal input buffer}
@.PTA@>
@d crlf == chr(13),chr(10)
@#
@<VMS proc...@>=
procedure wake_up_terminal;
begin
out_RAB^.VAX_RAB_cancel_ctrlO:=true;
write_ln(term_out);
out_RAB^.VAX_RAB_cancel_ctrlO:=false;
end; {cancel the user's cancellation of output}
@.CCO@>
@z
@x l.1055
@ The following program does the required initialization
without retrieving a possible command line.
It should be clear how to modify this routine to deal with command lines,
if the system permits them.
@^system dependencies@>
@p function init_terminal:boolean; {gets the terminal input started}
label exit;
begin t_open_in;
loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
@.**@>
if not input_ln(term_in,true) then {this shouldn't happen}
begin write_ln(term_out);
write(term_out,'! End of file on the terminal... why?');
@.End of file on the terminal@>
init_terminal:=false; return;
end;
loc:=first;
while (loc<last)and(buffer[loc]=" ") do incr(loc);
if loc<last then
begin init_terminal:=true;
return; {return unless the line was all blank}
end;
write_ln(term_out,'Please type the name of your input file.');
end;
exit:end;
@y
@ The following program does the required initialization
by retrieving a possible command line, and if none exists,
prompting the user for the first line of input.
VMS standard library routines are used to ``input'' an initial command line
from the pseudo-qualifier \.{COMMAND\_LINE} of the Command Line Interface.
@.CLI{\$}GET_VALUE@>
@^system dependencies@>
Since any command line passed to \TeX\ from DCL via \.{LIB\$GET\_VALUE} will
have been ``up-cased'', we might consider converting everything to lower-case,
so that all (usually lowercase) \TeX\ commands therein can be recognized;
of course, any such commands which are named with upper-case letters would be
``ruined''.
But, since we are using the full DCL command line interpreter interface,
commands consisting of more than one word have to be enclosed in
`\.{\char'042}' quotation marks, anyway. The correct case is thus
preserved; and file names (which are by far the most common single word
arguments) are case insensitive on VMS.
Therefore, lower case conversion has not been implemented.
@d VAX_cli_present==@= cli$present@>
@d VAX_cli_get_value==@= cli$get_value@>
@p function init_terminal:boolean; {gets the terminal input started}
label exit;
var command_line: packed array[1..256] of char;
@!len: sixteen_bits;
@!i: integer;
begin t_open_in;
if cmd_line_present then begin
VAX_cli_get_value('COMMAND_LINE',command_line,len);
i:=1; while (i<=len) and (command_line[i]=' ') do incr(i);
if i<=len then begin
loc:=first;
last:=first;
while i<=len do begin
buffer[last]:=xord[command_line[i]];
incr(last); incr(i);
end;
init_terminal:=true; return;
end;
end;
loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
@.**@>
if not input_ln(term_in,true) then {this shouldn't happen}
begin write(term_out,crlf);
write_ln(term_out,'! End of file on the terminal... why?',crlf);
@.End of file on the terminal@>
init_terminal:=false; return;
end;
loc:=first;
while (loc<last)and(buffer[loc]=" ") do incr(loc);
if loc<last then
begin init_terminal:=true;
return; {return unless the line was all blank}
end;
write_ln(term_out,'Please type the name of your input file.',crlf);
end;
exit:end;
@z
@x l.1247
@<Read the other strings from the \.{TEX.POOL} file and return |true|,
@y
@<Read the other strings from the \.{ETEX.POOL} file and return |true|,
@z
@x l.1279
Unprintable characters of codes 128--255 are, similarly, rendered
\.{\^\^80}--\.{\^\^ff}.
@y
Unprintable characters of codes 128--159 and 255 are, similarly, rendered
\.{\^\^80}--\.{\^\^9f} and \.{\^\^ff}. We will print characters in the range
160--254 if the qualifier \.{/EIGHT\_BIT} is used.
@./EIGHT_BIT@>
@z
@x l.1296
(k<" ")or(k>"~")
@y
(k<" ")or((k>"~")and (k<160))or(k=255)or((k>=160)and not eight_qual)
@z
@x l.1298
@ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB}
description that you are now reading, it outputs the \PASCAL\ program
\.{TEX.PAS} and also a string pool file called \.{TEX.POOL}. The \.{INITEX}
@.WEB@>@.INITEX@>
@y
@ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB}
description that you are now reading, together with the merged change file
for your system's implementation of \eTeX, it should output the \PASCAL\
program \.{ETEX.PAS} and also a string pool file called \.{ETEX.POOL}.
The \.{EINITEX}
@.WEB@>@.EINITEX@>
@z
@x l.1310
@ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#);
@y
@ As noted before, it is not necessary for the string |pool_name| to have the
same length as the |array name_of_file|, because VAX-\PASCAL\ automatically
pads such shorter strings with spaces when an assignment is made into a longer
string variable.
@d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#,crlf);
@z
@x l.1322
else bad_pool('! I can''t read TEX.POOL.')
@.I can't read TEX.POOL@>
@y
else bad_pool('! I can''t read ETEX.POOL.')
@.I can't read ETEX.POOL@>
@z
@x l.1326
begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.');
@.TEX.POOL has no check sum@>
@y
begin if eof(pool_file) then bad_pool('! ETEX.POOL has no check sum.');
@.ETEX.POOL has no check sum@>
@z
@x l.1332
bad_pool('! TEX.POOL line doesn''t begin with two digits.');
@.TEX.POOL line doesn't...@>
@y
bad_pool('! ETEX.POOL line doesn''t begin with two digits.');
@.ETEX.POOL line doesn't...@>
@z
@x l.1346
@ The \.{WEB} operation \.{@@\$} denotes the value that should be at the
end of this \.{TEX.POOL} file; any other value means that the wrong pool
@y
@ The \.{WEB} operation \.{@@\$} denotes the value that should be at the
end of this \.{ETEX.POOL} file; any other value means that the wrong pool
@z
@x l.1354
bad_pool('! TEX.POOL check sum doesn''t have nine digits.');
@.TEX.POOL check sum...@>
@y
bad_pool('! ETEX.POOL check sum doesn''t have nine digits.');
@.ETEX.POOL check sum...@>
@z
@x l.1360
done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.');
@.TEX.POOL doesn't match@>
@y
done: if a<>@$ then bad_pool('! ETEX.POOL doesn''t match; TANGLE me again.');
@.ETEX.POOL doesn't match@>
@z
@x l.1387
\hang |new_string|, appends the output to the current string in the
string pool.
@y
\hang |new_string|, appends the output to the current string in the
string pool.
\hang |edcmd_write|, prints the characters into the |edcmd_file| only.
@z
@x l.1393
\noindent The symbolic names `|term_and_log|', etc., have been assigned
numeric codes that satisfy the convenient relations |no_print+1=term_only|,
|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|.
@y
\noindent The symbolic names `|term_and_log|', etc., have been assigned
numeric codes that satisfy the convenient relations |no_print+1=term_only|,
|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|.
The interface to various ``callable editors'', described toward the end of
this program, necessitates the use of a separate output file (in addition
to \TeX's 16 auxiliary output streams), |edcmd_file|, which is declared here,
together with the associated value |edcmd_write| of the global |selector|
variable.
@z
@x l.1411
@d max_selector=21 {highest selector setting}
@<Glob...@>=
@!log_file : alpha_file; {transcript of \TeX\ session}
@y
@d edcmd_write=22 {printing is deflected to the |edcmd_file|}
@d max_selector=22 {highest selector setting}
@<Glob...@>=
@!log_file : alpha_file; {transcript of \TeX\ session}
@!edcmd_file : alpha_file; {command file used when invoking some editors}
@z
@x l.1433
by changing |wterm|, |wterm_ln|, and |wterm_cr| in this section.
@^system dependencies@>
@d wterm(#)==write(term_out,#)
@d wterm_ln(#)==write_ln(term_out,#)
@d wterm_cr==write_ln(term_out)
@d wlog(#)==write(log_file,#)
@d wlog_ln(#)==write_ln(log_file,#)
@d wlog_cr==write_ln(log_file)
@y
by changing |wterm|, |wterm_ln|, and |wterm_cr| in this section.
@^system dependencies@>
We also introduce here analogous macros for writing to the |diag_file|, which
is used to generate diagnostic messages for use in conjunction with DEC's
Language-sensitive editor (LSEdit).
@^Language-sensitive editor@>
@^LSE@>
Yet another set of macros is concerned with writing to |temp_file|, which is a
purely internal file, used to concatenate the various elements of \TeX's error
messages for use in diagnostic and other files.
@d wterm(#)==write(term_out,#)
@d wterm_ln(#)==write_ln(term_out,#,crlf)
@d wterm_cr==write_ln(term_out,crlf)
@d wlog(#)==if log_qual then write(log_file,#)
@d wlog_ln(#)==if log_qual then write_ln(log_file,#)
@d wlog_cr==if log_qual then write_ln(log_file)
@d wdiag(#)==if diag_qual then write(diag_file,#)
@d wdiag_ln(#)==if diag_qual then write_ln(diag_file,#)
@d wdiag_cr==if diag_qual then write_ln(diag_file)
@d wtemp(#)==write(temp_file,#)
@d wtemp_ln(#)==write_ln(temp_file,#)
@d wtemp_cr==write_ln(temp_file)
@<Basic print...@>=
procedure diag_char(@!s:ASCII_code);
var ch : char;
begin
ch := xchr[s];
wdiag(ch); if ch='"' then wdiag(ch)
end;
@# procedure temp_char(@!s:ASCII_code);
var ch : char;
begin
ch := xchr[s];
wtemp(ch); if ch='"' then wtemp(ch)
end;
@# procedure diag_print( s : integer);
var j : pool_pointer;
begin
j:=str_start[s];
while j < str_start[s+1] do
begin diag_char(so(str_pool[j]));
incr(j)
end;
end;
@z
@x l.1455
no_print,pseudo,new_string: do_nothing;
@y
no_print,pseudo,new_string: do_nothing;
edcmd_write: write_ln(edcmd_file);
@z
@x l.1460
@ The |print_char| procedure sends one character to the desired destination,
using the |xchr| array to map it into an external character compatible with
|input_ln|. All printing comes through |print_ln| or |print_char|.
@<Basic printing...@>=
procedure print_char(@!s:ASCII_code); {prints a single character}
label exit;
begin if @<Character |s| is the current new-line character@> then
if selector<pseudo then
begin print_ln; return;
end;
case selector of
term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
incr(term_offset); incr(file_offset);
if term_offset=max_print_line then
begin wterm_cr; term_offset:=0;
end;
if file_offset=max_print_line then
begin wlog_cr; file_offset:=0;
end;
end;
log_only: begin wlog(xchr[s]); incr(file_offset);
if file_offset=max_print_line then print_ln;
end;
term_only: begin wterm(xchr[s]); incr(term_offset);
if term_offset=max_print_line then print_ln;
end;
no_print: do_nothing;
pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
new_string: begin if pool_ptr<pool_size then append_char(s);
end; {we drop characters if the string space is full}
othercases write(write_file[selector],xchr[s])
endcases;@/
incr(tally);
exit:end;
@y
@ The |print_char| procedure sends one character to the desired destination,
using the |xchr| array to map it into an external character compatible with
|input_ln|. All printing comes through |print_ln| or |print_char|.
@<Basic printing...@>=
procedure print_char(@!s:ASCII_code); {prints a single character}
label exit;
begin if @<Character |s| is the current new-line character@> then
if selector<pseudo then
begin print_ln; return;
end;
@<Save printed character for diagnostic messages@>;
case selector of
term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
incr(term_offset); incr(file_offset);
if term_offset=max_print_line then
begin wterm_cr; term_offset:=0;
end;
if file_offset=max_print_line then
begin wlog_cr; file_offset:=0;
end;
end;
log_only: begin wlog(xchr[s]); incr(file_offset);
if file_offset=max_print_line then print_ln;
end;
term_only: begin wterm(xchr[s]); incr(term_offset);
if term_offset=max_print_line then print_ln;
end;
no_print: do_nothing;
pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
new_string: begin if pool_ptr<pool_size then append_char(s);
end; {we drop characters if the string space is full}
edcmd_write: write(edcmd_file,xchr[s]); {Copy character to editor command file}
othercases write(write_file[selector],xchr[s])
endcases;@/
incr(tally);
exit:end;
@z
@x l.1556
wterm(banner);
@y
wterm(eTeX_banner);
@z
@x l.1697
term_offset:=0; {the user's line ended with \<\rm return>}
@y
in_RAB^.VAX_RAB_purge_typeahead:=false; {turn off purging of typeahead}
@.PTA@>
term_offset:=0; {the user's line ended with \<\rm return>}
@z
@x l.1726
@ The global variable |interaction| has four settings, representing increasing
amounts of user interaction:
@y
@ The global variable |interaction| has four settings, representing increasing
amounts of user interaction:
This version of \TeX\ can generate a diagnostics file for use with the
\.{REVIEW} mode of DEC's Language-sensitive editor (LSEdit).
@^Language-sensitive editor@>
So whenever \TeX\ starts to generate an error message, we arrange for the text
which is sent to the terminal and/or the transcript file to be copied also into
our |temp_file|.
@z
@x l.1733
@d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal;
print_nl("! "); print(#);
end
@<Glob...@>=
@!interaction:batch_mode..error_stop_mode; {current level of interaction}
@y
@d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal;
print_nl("! ");
copy_err:=save_it; rewrite(temp_file);
print(#); {Other |print|s will add to |temp_file|}
end
@<Glob...@>=
@!interaction:batch_mode..error_stop_mode; {current level of interaction}
@z
@x l.1857
@ Here now is the general |error| routine.
@y
@ Here now is the general |error| routine, which completes output of the error
message.
@z
@x l.1865
begin if history<error_message_issued then history:=error_message_issued;
print_char("."); show_context;
if interaction=error_stop_mode then @<Get user's advice and |return|@>;
@y
begin if history<error_message_issued then history:=error_message_issued;
print_char(".");
@<Ensure |temp_file| not in use@>;
show_context;
if interaction=error_stop_mode then @<Get user's advice and |return|@>;
@z
@x l.1886
@ It is desirable to provide an `\.E' option here that gives the user
an easy way to return from \TeX\ to the system editor, with the offending
line ready to be edited. But such an extension requires some system
wizardry, so the present implementation simply types out the name of the
file that should be
edited and the relevant line number.
@^system dependencies@>
@y
@ It is desirable to provide an `\.E' option here that gives the user
an easy way to return from \TeX\ to the system editor, with the offending
line ready to be edited. This version of \TeX\ invokes callable versions of
various DEC editors, depending upon the value of the
\.{/EDITOR} switch (normally set to \.{TEX\_EDIT}),
@./EDITOR@>
@.TEX_EDIT@>
including \.{EDT}, \.{TPU}, DEC's Language-sensitive editor (LSEdit), and even
@^EDT@>
@^TPU@>
@^Language-sensitive editor@>
@^LSE@>
\.{TECO}.
@^TECO@>
Other editors may be run in a sub-process by setting \.{/EDITOR}
to any DCL command, including activating a command procedure.
In addition, if the \.{/CONTINUE} qualifier is present on the command line,
@./CONTINUE@>
\TeX\ will continue processing after returning from the editor.
@^system dependencies@>
@z
@x l.1903
"E": if base_ptr>0 then
begin print_nl("You want to edit file ");
@.You want to edit file x@>
slow_print(input_stack[base_ptr].name_field);
print(" at line "); print_int(line);
interaction:=scroll_mode; jump_out;
end;
@y
"E": if base_ptr>0 then
begin
if edit_file(input_stack[base_ptr],line) then
begin
if continue_qual then
begin show_context; goto continue;
end
else begin interaction:=scroll_mode; jump_out;
end
end
else
begin
print_nl("You want to edit file ");
@.You want to edit file x@>
slow_print(input_stack[base_ptr].name_field);
print(" at line "); print_int(line);
interaction:=scroll_mode; jump_out;
end
end;
@z
@x l.1935
@<Change the interaction...@>=
begin error_count:=0; interaction:=batch_mode+c-"Q";
print("OK, entering ");
case c of
"Q":begin print_esc("batchmode"); decr(selector);
end;
"R":print_esc("nonstopmode");
"S":print_esc("scrollmode");
end; {there are no other cases}
print("..."); print_ln; update_terminal; return;
end
@y
@<Change the interaction...@>=
begin error_count:=0; interaction:=batch_mode+c-"Q";
print("OK, entering ");
case c of
"Q":print_esc("batchmode");
"R":print_esc("nonstopmode");
"S":print_esc("scrollmode");
end; {there are no other cases}
print("..."); print_ln; update_terminal;
if c = "Q" then
decr (selector);
return;
end
@z
@x l.2085
@ Users occasionally want to interrupt \TeX\ while it's running.
If the \PASCAL\ runtime system allows this, one can implement
a routine that sets the global variable |interrupt| to some nonzero value
when such an interrupt is signalled. Otherwise there is probably at least
a way to make |interrupt| nonzero using the \PASCAL\ debugger.
@^system dependencies@>
@^debugging@>
@y
@ Users occasionally want to interrupt \TeX\ while it's running.
By using a VAX system service, we can declare an Asynchronous System Trap (AST)
handler which will be called when the user types \.{Ctrl-C}. The AST handler
then sets the global variable |interrupt| to some nonzero value
when such an interrupt is signalled.
@^system dependencies@>
Since this variable may be changed at any time, we must prevent the compiler
from applying optimizations to the code related to this variable (for example,
it would not do for it to be held in a machine register), so we give it the
VAX-\PASCAL\ `attribute' \.{volatile}, which is defined at this point. We also
define a couple of other attributes that may be applied to affect the placement
of variables under VAX-\PASCAL.
Assuming that it's possible to assign an I/O channel to device \.{SYS\$COMMAND},
@.SYS{\$}COMMAND@>
which should be the case provided the program is being run interactively, then
the Control-C handler is declared by a call of the \.{\$QIOW} system service.
@.{\$}QIOW@>
Some parameters for this system service have to passed by the `immediate'
parameter-passing mechanism; we take this opportunity to define all the means
used in \TeX\ to override VAX-\PASCAL's default parameter-passing mechanisms.
@d VAX_volatile==@= volatile @>
@d VAX_unsafe==@= unsafe @>
@d VAX_aligned==@= aligned @>
@d VAX_static==@= static @>
@#
@d VAX_immed==@= %immed @>
@d VAX_stdescr==@= %stdescr @>
@d VAX_ref==@= %ref @>
@#
@d VAX_io_setmode==@= io$_setmode @>
@d VAX_iom_ctrlcast==@= io$m_ctrlcast @>
@#
@d VAX_qiow==@= $qiow@>
@d VAX_assign==@= $assign@>
@#
@z
@x l.2093
@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
end
@<Global...@>=
@!interrupt:integer; {should \TeX\ pause for instructions?}
@y
@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
end
@d enable_control_C==
VAX_qiow(,tt_chan,VAX_io_setmode+VAX_iom_ctrlcast,,,,
VAX_immed ctrlc_rout,,VAX_immed 3,,,);
@<Global...@>=
@!interrupt: [VAX_volatile] integer; {should \TeX\ pause for instruction?}
@z
@x l.2101
interrupt:=0; OK_to_interrupt:=true;
@y
interrupt:=0; OK_to_interrupt:=true;
if VAX_assign('SYS$COMMAND',tt_chan,,)=VAX_ss_normal then enable_control_C;
@z
@x l.2345
@d set_glue_ratio_zero(#) == #:=0.0 {store the representation of zero ratio}
@d set_glue_ratio_one(#) == #:=1.0 {store the representation of unit ratio}
@d float(#) == # {convert from |glue_ratio| to type |real|}
@d unfloat(#) == # {convert from |real| to type |glue_ratio|}
@d float_constant(#) == #.0 {convert |integer| constant to |real|}
@<Types...@>=
@!glue_ratio=real; {one-word representation of a glue expansion factor}
@y
On VMS, we use some hackery to cause floating point numbers stored in
|mem| to be |single|, but other |real| variables and expressions are
done as |double| length reals.
@d set_glue_ratio_zero(#) == #:=0.0 {store the representation of zero ratio}
@d set_glue_ratio_one(#) == #:=1.0 {store the representation of unit ratio}
@d real == double {use double precision reals for computation}
@d float(#) == dble(#) {convert from |glue_ratio| to type |real|}
{FIX ME}
@d unfloat(#) == sngl(1.0@&D0 * #) {convert from |real| to type |glue_ratio|}
@d float_constant(#) == #.0@&D0 {convert |integer| constant to |real|}
@<Types...@>=
@!glue_ratio=r@&e@&a@&l; {one-word representation of a glue expansion factor}
@z
@x l.2405
@d min_quarterword=0 {smallest allowable value in a |quarterword|}
@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 min_quarterword=0 {smallest allowable value in a |quarterword|}
@d max_quarterword=511 {largest allowable value in a |quarterword|}
@d min_halfword==0 {smallest allowable value in a |halfword|}
@d max_halfword==327144+1 {largest allowable value in a |halfword|}
@z
@x l.2438
@d qi(#)==#+min_quarterword
{to put an |eight_bits| item into a quarterword}
@d qo(#)==#-min_quarterword
{to take an |eight_bits| item out of a quarterword}
@d hi(#)==#+min_halfword
{to put a sixteen-bit item into a halfword}
@d ho(#)==#-min_halfword
{to take a sixteen-bit item from a halfword}
@y
@d qi(#)==#
@d qo(#)==#
@d hi(#)==#
@d ho(#)==#
@z
@x l.2469
@!memory_word = record@;@/
case four_choices of
1: (@!int:integer);
2: (@!gr:glue_ratio);
3: (@!hh:two_halves);
4: (@!qqqq:four_quarters);
end;
@y
@!memory_word = packed record@;@/
case four_choices of
1: (@!int:integer);
2: (@!gr:glue_ratio);
3: (@!hh:two_halves);
4: (@!qqqq:four_quarters);
end;
@z
@x l.2476
@!word_file = file of memory_word;
@y
@!word_block = packed array[0..VAX_block_length-1] of memory_word;
@!word_file = packed file of word_block;
@z
@x l.2965
This field occupies a full word instead of a halfword, because
there's nothing to put in the other halfword; it is easier in \PASCAL\ to
use the full word than to risk leaving garbage in the unused half.
@y
In addition there is a |mark_class| field that contains the mark class.
@z
@x l.2971
@d mark_ptr(#)==mem[#+1].int {head of the token list for a mark}
@y
@d mark_ptr(#)==link(#+1) {head of the token list for a mark}
@d mark_class(#)==info(#+1) {the mark class}
@z
@x l.2980
@d adjust_ptr==mark_ptr {vertical list to be moved out of horizontal list}
@y
@d adjust_ptr(#)==mem[#+1].int
{vertical list to be moved out of horizontal list}
@z
@x l.3069
the amount of surrounding space inserted by \.{\\mathsurround}.
@y
the amount of surrounding space inserted by \.{\\mathsurround}.
In addition a |math_node| with |subtype>after| and |width=0| will be
(ab)used to record a regular |math_node| reinserted after being
discarded at a line break or one of the text direction primitives (
\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} ).
@z
@x l.3073
@d after=1 {|subtype| for math node that winds up a formula}
@y
@d after=1 {|subtype| for math node that winds up a formula}
@#
@d M_code=2
@d begin_M_code=M_code+before {|subtype| for \.{\\beginM} node}
@d end_M_code=M_code+after {|subtype| for \.{\\endM} node}
@d L_code=4
@d begin_L_code=L_code+begin_M_code {|subtype| for \.{\\beginL} node}
@d end_L_code=L_code+end_M_code {|subtype| for \.{\\endL} node}
@d R_code=L_code+L_code
@d begin_R_code=R_code+begin_M_code {|subtype| for \.{\\beginR} node}
@d end_R_code=R_code+end_M_code {|subtype| for \.{\\endR} node}
@#
@d end_LR(#)==odd(subtype(#))
@d end_LR_type(#)==(L_code*(subtype(#) div L_code)+end_M_code)
@d begin_LR_type(#)==(#-after+before)
@z
@x l.3546
math_node: print_char("$");
@y
math_node: if subtype(p)>=L_code then print("[]")
else print_char("$");
@z
@x l.3713
begin print(", shifted "); print_scaled(shift_amount(p));
end;
@y
begin print(", shifted "); print_scaled(shift_amount(p));
end;
if eTeX_ex then @<Display if this box is never to be reversed@>;
@z
@x l.3735
arbitrary random value. The following code assumes that a properly
formed nonzero |real| number has absolute value $2^{20}$ or more when
it is regarded as an integer; this precaution was adequate to prevent
floating point underflow on the author's computer.
@y
arbitrary random value. The following WEB macro simulates VAX/DEC-\PASCAL's
predeclared routine |undefined|, which returns |true| if its argument
is not a properly constituted |real| number. (The real function cannot
be used, because it is currently unsupported on DEC-\PASCAL\ for AXP.)
@d VAX_undefined(#)== (#::VAX_F_float.Sign and (#::VAX_F_float.Expo = 0))
@z
@x l.3747
if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
@y
if VAX_undefined(glue_set(p)) then print("?.?")
@z
@x l.3811
begin print_esc("math");
@y
if subtype(p)>after then
begin if end_LR(p) then print_esc("end")
else print_esc("begin");
if subtype(p)>R_code then print_char("R")
else if subtype(p)>L_code then print_char("L")
else print_char("M");
end else
begin print_esc("math");
@z
@x l.3844
begin print_esc("mark"); print_mark(mark_ptr(p));
@y
begin print_esc("mark");
if mark_class(p)<>null then
begin print_char("s"); print_int(mark_class(p));
end;
print_mark(mark_ptr(p));
@z
@x l.4081
@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
@y
@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
{( or \.{\\pagediscards}, \.{\\splitdiscards} )}
@z
@x l.4091
@d valign=33 {vertical table alignment ( \.{\\valign} )}
@y
@d valign=33 {vertical table alignment ( \.{\\valign} )}
{or text direction directives ( \.{\\beginL}, etc.~)}
@z
@x l.4107
@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
@y
@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
{( or \.{\\middle} )}
@z
@x l.4151
\.{\\insertpenalties} )}
@y
\.{\\insertpenalties} )}
{( or \.{\\interactionmode} )}
@z
@x l.4153
@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
@y
@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
{(or \.{\\interlinepenalties}, etc.~)}
@z
@x l.4163
@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
@y
@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
{( or \.{\\protected} )}
@z
@x l.4166
@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
@y
@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
{( or \.{\\readline} )}
@z
@x l.4181
@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
@y
@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
{( or \.{\\scantokens} )}
@z
@x l.4186
@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
@y
@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
{( or \.{\\unexpanded}, \.{\\detokenize} )}
@z
@x l.4289
user's output routine.
@y
user's output routine.
A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX.
In vertical modes it is known as |LR_save| and holds the LR stack when a
paragraph is interrupted by a displayed formula. In display math mode
it is known as |LR_box| and holds a pointer to a prototype box for the
display. In math mode it is known as |delim_ptr| and points to the most
recent |left_noad| or |middle_noad| of a |math_left_group|.
@z
@x l.4304
@!head_field,@!tail_field: pointer;
@y
@!head_field,@!tail_field: pointer;
@!eTeX_aux_field: pointer;
@z
@x l.4311
@d tail==cur_list.tail_field {final node on current list}
@y
@d tail==cur_list.tail_field {final node on current list}
@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX}
@d LR_save==eTeX_aux {LR stack when a paragraph is interrupted}
@d LR_box==eTeX_aux {prototype box for display}
@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group}
@z
@x l.4342
mode:=vmode; head:=contrib_head; tail:=contrib_head;
@y
mode:=vmode; head:=contrib_head; tail:=contrib_head;
eTeX_aux:=null;
@z
@x l.4358
incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
@y
incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
eTeX_aux:=null;
@z
@x l.4712
@d output_routine_loc=local_base+1 {points to token list for \.{\\output}}
@d every_par_loc=local_base+2 {points to token list for \.{\\everypar}}
@d every_math_loc=local_base+3 {points to token list for \.{\\everymath}}
@d every_display_loc=local_base+4 {points to token list for \.{\\everydisplay}}
@d every_hbox_loc=local_base+5 {points to token list for \.{\\everyhbox}}
@d every_vbox_loc=local_base+6 {points to token list for \.{\\everyvbox}}
@d every_job_loc=local_base+7 {points to token list for \.{\\everyjob}}
@d every_cr_loc=local_base+8 {points to token list for \.{\\everycr}}
@d err_help_loc=local_base+9 {points to token list for \.{\\errhelp}}
@d toks_base=local_base+10 {table of 256 token list registers}
@y
@d inter_line_penalties_loc=local_base+1 {additional penalties between lines}
@d club_penalties_loc=local_base+2 {penalties for creating club lines}
@d widow_penalties_loc=local_base+3 {penalties for creating widow lines}
@d display_widow_penalties_loc=local_base+4 {ditto, just before a display}
@d token_base=local_base+5 {table of token list parameters}
@d output_routine_loc=token_base {points to token list for \.{\\output}}
@d every_par_loc=token_base+1 {points to token list for \.{\\everypar}}
@d every_math_loc=token_base+2 {points to token list for \.{\\everymath}}
@d every_display_loc=token_base+3 {points to token list for \.{\\everydisplay}}
@d every_hbox_loc=token_base+4 {points to token list for \.{\\everyhbox}}
@d every_vbox_loc=token_base+5 {points to token list for \.{\\everyvbox}}
@d every_job_loc=token_base+6 {points to token list for \.{\\everyjob}}
@d every_cr_loc=token_base+7 {points to token list for \.{\\everycr}}
@d every_eof_loc=token_base+8 {points to token list for \.{\\everyeof}}
@d err_help_loc=token_base+9 {points to token list for \.{\\errhelp}}
@d toks_base=token_base+10 {table of 256 token list registers}
@z
@x l.4787
othercases print_esc("errhelp")
@y
@/@<Cases of |assign_toks| for |print_cmd_chr|@>@/
othercases print_esc("errhelp")
@z
@x l.4805
eq_level(par_shape_loc):=level_one;@/
@y
eq_level(par_shape_loc):=level_one;@/
for k:=par_shape_loc+1 to token_base-1 do
eqtb[k]:=eqtb[par_shape_loc];
@z
@x l.4820
cat_code("\"):=escape; cat_code("%"):=comment;
@y
cat_code("\"):=escape; cat_code("%"):=comment;
cat_code(form_feed):=car_ret;
@z
@x l.4833
if n=par_shape_loc then
begin print_esc("parshape"); print_char("=");
if par_shape_ptr=null then print_char("0")
else print_int(info(par_shape_ptr));
@y
if n<token_base then
begin print_cmd_chr(set_shape,n); print_char("=");
if equiv(n)=null then print_char("0")
else if n>par_shape_loc then
begin print_int(penalty(equiv(n))); print_char(" ");
print_int(penalty(equiv(n)+1));
if penalty(equiv(n))>1 then print_esc("ETC.");
end
else print_int(info(par_shape_ptr));
@z
@x l.4955
@d count_base=int_base+int_pars {256 user \.{\\count} registers}
@y
@d tracing_assigns_code=int_pars {show assignments}
@d tracing_groups_code=int_pars+1 {show save/restore groups}
@d tracing_ifs_code=int_pars+2 {show conditionals}
@d tracing_scan_tokens_code=int_pars+3 {show pseudo file open and close}
@d tracing_nesting_code=int_pars+4
{show incomplete groups and ifs within files}
@d pre_display_direction_code=int_pars+5 {text direction preceding a display}
@d last_line_fit_code=int_pars+6 {adjustment for last line of paragraph}
@d saving_vdiscards_code=int_pars+7 {save items discarded from vlists}
@d saving_hyph_codes_code=int_pars+8 {save hyphenation codes for languages}
@d eTeX_state_code=int_pars+9 {\eTeX\ state variables}
@d count_base=int_base+eTeX_state_code+eTeX_states
{256 user \.{\\count} registers}
@z
@x l.5016
@d error_context_lines==int_par(error_context_lines_code)
@y
@d error_context_lines==int_par(error_context_lines_code)
@d tracing_assigns==int_par(tracing_assigns_code)
@d tracing_groups==int_par(tracing_groups_code)
@d tracing_ifs==int_par(tracing_ifs_code)
@d tracing_scan_tokens==int_par(tracing_scan_tokens_code)
@d tracing_nesting==int_par(tracing_nesting_code)
@d pre_display_direction==int_par(pre_display_direction_code)
@d last_line_fit==int_par(last_line_fit_code)
@d saving_vdiscards==int_par(saving_vdiscards_code)
@d saving_hyph_codes==int_par(saving_hyph_codes_code)
@z
@x l.5081
othercases print("[unknown integer parameter!]")
@y
@/@<Cases for |print_param|@>@/
othercases print("[unknown integer parameter!]")
@z
@x l.5222
Since standard \PASCAL\ cannot provide such information, something special
is needed. The program here simply specifies July 4, 1776, at noon; but
users probably want a better approximation to the truth.
@p procedure fix_date_and_time;
begin time:=12*60; {minutes since midnight}
day:=4; {fourth day of the month}
month:=7; {seventh month of the year}
year:=1776; {Anno Domini}
@y
The requisite information is obtained through a call of the \.{\$NUMTIM} system
@.{\$}NUMTIM@>
service.
@d VAX_numtim==@= $numtim@>
@p procedure fix_date_and_time;
var t:array[1..7] of signed_halfword; {raw year, month, day and time}
begin VAX_numtim(t);
year:=t[1]; month:=t[2]; day:=t[3];
time:=t[4]*60+t[5]; {minutes since midnight}
@z
@x l.5612
@!j:small_number; {index into |buffer|}
@y
@!j:0..buf_size; {index into |buffer|}
@z
@x l.5616
{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|}
@y
{we will move |s| into the (possibly non-empty) |buffer|}
if first+l>buf_size+1 then
overflow("buffer size",buf_size);
@:TeX capacity exceeded buffer size}{\quad buffer size@>
for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
@z
@x l.5691
primitive("parshape",set_shape,0);@/
@y
primitive("parshape",set_shape,par_shape_loc);@/
@z
@x l.5708
primitive("toks",toks_register,0);@/
@y
primitive("toks",toks_register,mem_bot);@/
@z
@x l.5741
expand_after: print_esc("expandafter");
@y
expand_after: if chr_code=0 then print_esc("expandafter")
@<Cases of |expandafter| for |print_cmd_chr|@>;
@z
@x l.5747
mark: print_esc("mark");
@y
mark: begin print_esc("mark");
if chr_code>0 then print_char("s");
end;
@z
@x l.5758
read_to_cs: print_esc("read");
@y
read_to_cs: if chr_code=0 then print_esc("read")
@<Cases of |read| for |print_cmd_chr|@>;
@z
@x l.5762
set_shape: print_esc("parshape");
@y
set_shape: case chr_code of
par_shape_loc: print_esc("parshape");
@<Cases of |set_shape| for |print_cmd_chr|@>@;@/
end; {there are no other cases}
@z
@x l.5763
the: print_esc("the");
@y
the: if chr_code=0 then print_esc("the")
@<Cases of |the| for |print_cmd_chr|@>;
@z
@x l.5764
toks_register: print_esc("toks");
@y
toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>;
@z
@x l.5766
valign: print_esc("valign");
@y
valign: if chr_code=0 then print_esc("valign")@/
@<Cases of |valign| for |print_cmd_chr|@>;
@z
@x l.5800
interpreted in one of four ways:
@y
interpreted in one of five ways:
@z
@x l.5820
the entries for that group.
@y
the entries for that group.
Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
source line number at which the current level of grouping was entered.
\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a
chain of sparse array entries to be restored at the end of the current
group. Furthermore |save_index(p)| and |save_level(p)| should replace
the values of |sa_chain| and |sa_level| respectively.
@z
@x l.5830
@d level_boundary=3 {|save_type| corresponding to beginning of group}
@y
@d level_boundary=3 {|save_type| corresponding to beginning of group}
@d restore_sa=4 {|save_type| when sparse array entries should be restored}
@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
@z
@x l.5888
@ The following macro is used to test if there is room for up to six more
@y
@ The following macro is used to test if there is room for up to seven more
@z
@x l.5894
if max_save_stack>save_size-6 then overflow("save size",save_size);
@y
if max_save_stack>save_size-7 then overflow("save size",save_size);
@z
@x l.5916
begin check_full_save_stack;
@y
begin check_full_save_stack;
if eTeX_ex then
begin saved(0):=line; incr(save_ptr);
end;
@z
@x l.5923
cur_boundary:=save_ptr; incr(cur_level); incr(save_ptr); cur_group:=c;
@y
cur_boundary:=save_ptr; cur_group:=c;
@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/
incr(cur_level); incr(save_ptr);
@z
@x l.5941
othercases do_nothing
@y
@/@<Cases for |eq_destroy|@>@/
othercases do_nothing
@z
@x l.5963
the call, since |eq_save| makes the necessary test.
@y
the call, since |eq_save| makes the necessary test.
@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#);
tats
@z
@x l.5967
begin if eq_level(p)=cur_level then eq_destroy(eqtb[p])
@y
label exit;
begin if eTeX_ex and(eq_type(p)=t)and(equiv(p)=e) then
begin assign_trace(p,"reassigning")@;@/
eq_destroy(eqtb[p]); return;
end;
assign_trace(p,"changing")@;@/
if eq_level(p)=cur_level then eq_destroy(eqtb[p])
@z
@x l.5970
end;
@y
assign_trace(p,"into")@;@/
exit:end;
@z
@x l.5977
begin if xeq_level[p]<>cur_level then
@y
label exit;
begin if eTeX_ex and(eqtb[p].int=w) then
begin assign_trace(p,"reassigning")@;@/
return;
end;
assign_trace(p,"changing")@;@/
if xeq_level[p]<>cur_level then
@z
@x l.5981
end;
@y
assign_trace(p,"into")@;@/
exit:end;
@z
@x l.5990
begin eq_destroy(eqtb[p]);
eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
@y
begin assign_trace(p,"globally changing")@;@/
begin eq_destroy(eqtb[p]);
eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
end;
assign_trace(p,"into")@;@/
@z
@x l.5995
begin eqtb[p].int:=w; xeq_level[p]:=level_one;
@y
begin assign_trace(p,"globally changing")@;@/
begin eqtb[p].int:=w; xeq_level[p]:=level_one;
end;
assign_trace(p,"into")@;@/
@z
@x l.6012
@p@t\4@>@<Declare the procedure called |restore_trace|@>@;@/
@y
@p
@z
@x l.6019
begin if cur_level>level_one then
@y
@!a:boolean; {have we already processed an \.{\\aftergroup} ?}
begin a:=false;
if cur_level>level_one then
@z
@x l.6033
else begin if save_type(save_ptr)=restore_old_value then
@y
else if save_type(save_ptr)=restore_sa then
begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr);
end
else begin if save_type(save_ptr)=restore_old_value then
@z
@x l.6041
done: cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr)
@y
done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/
if grp_stack[in_open]=cur_boundary then group_warning;
{groups possibly not properly nested with files}
cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr);
if eTeX_ex then decr(save_ptr)
@z
@x l.6067
@ @<Declare the procedure called |restore_trace|@>=
@y
@ @<Declare \eTeX\ procedures for tr...@>=
@z
@x l.6155
@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
@y
@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
@d protected_token=@'7001 {$2^8\cdot|end_match|+1$}
@z
@x l.6280
end_match: print("->");
@y
end_match: if c=0 then print("->");
@z
@x l.6301
else if cur_cmd=top_bot_mark then
@y
else if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then
@z
@x l.6375
procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
@y
procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
var n:integer; {temp variable}
@z
@x l.6394
@p procedure show_cur_cmd_chr;
@y
@p procedure show_cur_cmd_chr;
var n:integer; {level of \.{\\if...\\fi} nesting}
@!l:integer; {line where \.{\\if} started}
@!p:pointer;
@z
@x l.6399
print_cmd_chr(cur_cmd,cur_chr); print_char("}");
@y
print_cmd_chr(cur_cmd,cur_chr);
if tracing_ifs>0 then
if cur_cmd>=if_test then if cur_cmd<=fi_or_else then
begin print(": ");
if cur_cmd=fi_or_else then
begin print_cmd_chr(if_test,cur_if); print_char(" ");
n:=0; l:=if_line;
end
else begin n:=1; l:=line;
end;
p:=cond_ptr;
while p<>null do
begin incr(n); p:=link(p);
end;
print("(level "); print_int(n); print_char(")"); print_if_line(l);
end;
print_char("}");
@z
@x l.6475
the terminal, under control of the procedure |read_toks|.)
@y
the terminal, under control of the procedure |read_toks|.)
Finally |18<=name<=19| indicates that we are reading a pseudo file
created by the \.{\\scantokens} command.
@z
@x l.6692
@d mark_text=14 {|token_type| code for \.{\\topmark}, etc.}
@d write_text=15 {|token_type| code for \.{\\write}}
@y
@d every_eof_text=14 {|token_type| code for \.{\\everyeof}}
@d mark_text=15 {|token_type| code for \.{\\topmark}, etc.}
@d write_text=16 {|token_type| code for \.{\\write}}
@z
@x l.6743
@<Local variables for formatting calculations@>@/
begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
{store current state}
@y
@<Local variables for formatting calculations@>@/
begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
{store current state}
@<Commence an LSE diagnostic report@>;
@z
@x l.6749
if (name>17) or (base_ptr=0) then bottom_line:=true;
@y
if (name>19) or (base_ptr=0) then bottom_line:=true;
@z
@x l.6758
done: cur_input:=input_stack[input_ptr]; {restore original state}
end;
@y
done: cur_input:=input_stack[input_ptr]; {restore original state}
@<Terminate an LSE diagnostic report@>;
end;
@z
@x l.6785
@<Print location of current line@>=
if name<=17 then
if terminal_input then
if base_ptr=0 then print_nl("<*>") else print_nl("<insert> ")
else begin print_nl("<read ");
if name=17 then print_char("*")@+else print_int(name-1);
@.*\relax@>
print_char(">");
end
@y
@<Print location of current line@>=
if name<=17 then
begin
@<Output the location to the diagnostics file@>;
if terminal_input then
if base_ptr=0 then print_nl("<*>") else print_nl("<insert> ")
else begin print_nl("<read ");
if name=17 then print_char("*")@+else print_int(name-1);
@.*\relax@>
print_char(">");
end;
@<Prepare to copy tokens to the diagnostic region@>;
end
@z
@x l.6794
else begin print_nl("l."); print_int(line);
end;
@y
else if index<>in_open then {input from a pseudo file}
begin print_nl("l."); print_int(line_stack[index+1]);
end
else begin print_nl("l."); print_int(line);
@<Report location within source file to diagnostics@>;
end;
@z
@x l.6798
@ @<Print type of token list@>=
case token_type of
parameter: print_nl("<argument> ");
@y
@ @<Print type of token list@>=
@<Include token report within diagnostics file@>;
case token_type of
parameter: print_nl("<argument> ");
@z
@x l.6814
every_cr_text: print_nl("<everycr> ");
@y
every_cr_text: print_nl("<everycr> ");
every_eof_text: print_nl("<everyeof> ");
@z
@x l.6815
mark_text: print_nl("<mark> ");
write_text: print_nl("<write> ");
othercases print_nl("?") {this should never happen}
endcases
@y
mark_text: print_nl("<mark> ");
write_text: print_nl("<write> ");
othercases print_nl("?") {this should never happen}
endcases;
@<Prepare to copy tokens to the diagnostic region@>
@z
@x l.6874
@<Print two lines using the tricky pseudoprinted information@>=
if trick_count=1000000 then set_trick_count;
{|set_trick_count| must be performed}
if tally<trick_count then m:=tally-first_count
else m:=trick_count-first_count; {context on line 2}
if l+first_count<=half_error_line then
begin p:=0; n:=l+first_count;
end
else begin print("..."); p:=l+first_count-half_error_line+3;
n:=half_error_line;
end;
for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]);
print_ln;
for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2}
if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3);
for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]);
if m+n>error_line then print("...")
@y
@<Print two lines using the tricky pseudoprinted information@>=
if trick_count=1000000 then set_trick_count;
{|set_trick_count| must be performed}
if tally<trick_count then m:=tally-first_count
else m:=trick_count-first_count; {context on line 2}
if l+first_count<=half_error_line then
begin p:=0; n:=l+first_count;
end
else begin print("..."); p:=l+first_count-half_error_line+3;
n:=half_error_line;
end;
for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]);
@<Split the context line display@>;
if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3);
for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]);
if m+n>error_line then print("...");
@<Indicate offending character@>
@z
@x l.6896
@<Pseudoprint the line@>=
begin_pseudoprint;
if buffer[limit]=end_line_char then j:=limit
else j:=limit+1; {determine the effective end of the line}
if j>0 then for i:=start to j-1 do
begin if i=loc then set_trick_count;
print(buffer[i]);
end
@y
@<Pseudoprint the line@>=
begin_pseudoprint;
if buffer[limit]=end_line_char then j:=limit
else j:=limit+1; {determine the effective end of the line}
if j>0 then for i:=start to j-1 do
begin if i=loc then set_trick_count;
print(buffer[i]);
end;
if name<=17 then @<Copy remainder of context to diagnostic file@>
@z
@x l.6905
@ @<Pseudoprint the token list@>=
begin_pseudoprint;
if token_type<macro then show_token_list(start,loc,100000)
else show_token_list(link(start),loc,100000) {avoid reference count}
@y
@ @<Pseudoprint the token list@>=
begin_pseudoprint;
if token_type<macro then show_token_list(start,loc,100000)
else show_token_list(link(start),loc,100000); {avoid reference count}
@<Copy remainder of context to diagnostic file@>;
@z
@x l.7009
begin t:=cur_tok; cur_tok:=p; back_input; cur_tok:=t;
@y
begin t:=cur_tok; cur_tok:=p;
if a then
begin p:=get_avail; info(p):=cur_tok; link(p):=loc; loc:=p; start:=p;
if cur_tok<right_brace_limit then
if cur_tok<left_brace_limit then decr(align_state)
else incr(align_state);
end
else begin back_input; a:=eTeX_ex;
end;
cur_tok:=t;
@z
@x l.7037
incr(in_open); push_input; index:=in_open;
@y
incr(in_open); push_input; index:=in_open;
eof_seen[index]:=false;
grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr;
@z
@x l.7047
if name>17 then a_close(cur_file); {forget it}
@y
if (name=18)or(name=19) then pseudo_close else
if name>17 then a_close(cur_file); {forget it}
@z
@x l.7066
in_open:=0; open_parens:=0; max_buf_stack:=0;
@y
in_open:=0; open_parens:=0; max_buf_stack:=0;
grp_stack[0]:=0; if_stack[0]:=null;
@z
@x l.7538
if not force_eof then
@y
if not force_eof then
if name<=19 then
begin if pseudo_input then {not end of file}
firm_up_the_line {this sets |limit|}
else if (every_eof<>null)and not eof_seen[index] then
begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
begin_token_list(every_eof,every_eof_text); goto restart;
end
else force_eof:=true;
end
else
@z
@x l.7541
else force_eof:=true;
@y
else if (every_eof<>null)and not eof_seen[index] then
begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
begin_token_list(every_eof,every_eof_text); goto restart;
end
else force_eof:=true;
@z
@x l.7544
begin print_char(")"); decr(open_parens);
update_terminal; {show user that file has been read}
@y
begin if tracing_nesting>0 then
if (grp_stack[in_open]<>cur_boundary)or@|
(if_stack[in_open]<>cond_ptr) then file_warning;
{give warning for some unfinished groups and/or conditionals}
if name>=19 then
begin print_char(")"); decr(open_parens);
update_terminal; {show user that file has been read}
end;
@z
@x l.7630
@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
@y
@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/
@z
@x l.7637
procedure expand;
@y
procedure expand;
label reswitch;
@z
@x l.7648
if cur_cmd<call then @<Expand a nonmacro@>
@y
reswitch:
if cur_cmd<call then @<Expand a nonmacro@>
@z
@x l.7659
expand_after:@<Expand the token after the next token@>;
@y
expand_after:if cur_chr=0 then @<Expand the token after the next token@>
else @<Negate a boolean conditional and |goto reswitch|@>;
@z
@x l.7779
input: if chr_code=0 then print_esc("input")@+else print_esc("endinput");
@y
input: if chr_code=0 then print_esc("input")
@/@<Cases of |input| for |print_cmd_chr|@>@/
else print_esc("endinput");
@z
@x l.7782
if cur_chr>0 then force_eof:=true
@y
if cur_chr=1 then force_eof:=true
@/@<Cases for |input|@>@/
@z
@x l.7838
@d top_mark_code=0 {the mark in effect at the previous page break}
@y
@d marks_code==5 {add this for \.{\\topmarks} etc.}
@#
@d top_mark_code=0 {the mark in effect at the previous page break}
@z
@x l.7870
top_bot_mark: case chr_code of
@y
top_bot_mark: begin case (chr_code mod marks_code) of
@z
@x l.7876
endcases;
@y
endcases;
if chr_code>=marks_code then print_char("s");
end;
@z
@x l.7882
begin if cur_mark[cur_chr]<>null then
begin_token_list(cur_mark[cur_chr],mark_text);
@y
begin t:=cur_chr mod marks_code;
if cur_chr>=marks_code then scan_register_num@+else cur_val:=0;
if cur_val=0 then cur_ptr:=cur_mark[t]
else @<Compute the mark pointer for mark type |t| and class |cur_val|@>;
if cur_ptr<>null then begin_token_list(cur_ptr,mark_text);
@z
@x l.7945
if info(r)<>end_match_token then
@y
if info(r)=protected_token then r:=link(r);
if info(r)<>end_match_token then
@z
@x l.8255
@t\4\4@>@<Declare procedures that scan font-related stuff@>
@y
@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@;
@t\4\4@>@<Declare procedures that scan font-related stuff@>
@z
@x l.8299
|glue_val|, or |mu_val|.
@y
|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes
cannot have these values)
@z
@x l.8302
primitive("count",register,int_val);
@!@:count_}{\.{\\count} primitive@>
primitive("dimen",register,dimen_val);
@!@:dimen_}{\.{\\dimen} primitive@>
primitive("skip",register,glue_val);
@!@:skip_}{\.{\\skip} primitive@>
primitive("muskip",register,mu_val);
@y
primitive("count",register,mem_bot+int_val);
@!@:count_}{\.{\\count} primitive@>
primitive("dimen",register,mem_bot+dimen_val);
@!@:dimen_}{\.{\\dimen} primitive@>
primitive("skip",register,mem_bot+glue_val);
@!@:skip_}{\.{\\skip} primitive@>
primitive("muskip",register,mem_bot+mu_val);
@z
@x l.8312
register: if chr_code=int_val then print_esc("count")
else if chr_code=dimen_val then print_esc("dimen")
else if chr_code=glue_val then print_esc("skip")
else print_esc("muskip");
@y
register: @<Cases of |register| for |print_cmd_chr|@>;
@z
@x l.8328
var m:halfword; {|chr_code| part of the operand token}
@y
label exit;
var m:halfword; {|chr_code| part of the operand token}
@!q:halfword; {general purpose index}
@!i:four_quarters; {character info}
@z
@x l.8354
end;
@y
exit:end;
@z
@x l.8375
begin scan_eight_bit_int; m:=toks_base+cur_val;
end;
scanned_result(equiv(m))(tok_val);
@y
if m=mem_bot then
begin scan_register_num;
if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
else begin find_sa_element(tok_val,cur_val,false);
if cur_ptr=null then cur_val:=null
else cur_val:=sa_ptr(cur_ptr);
end;
end
else cur_val:=sa_ptr(m)
else cur_val:=equiv(m);
cur_val_level:=tok_val;
@z
@x l.8390
|glue_val|, |input_line_no_code|, or |badness_code|.
@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
@d badness_code=glue_val+2 {code for \.{\\badness}}
@y
|glue_val|, |last_node_type_code|, |input_line_no_code|, |badness_code|,
|eTeX_version_code|, or one of the other codes for \eTeX\ extensions.
@d last_node_type_code=glue_val+1 {code for \.{\\lastnodetype}}
@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}}
@d badness_code=glue_val+3 {code for \.{\\badness}}
@d eTeX_int=glue_val+4 {first of \eTeX\ codes for integers}
@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions}
@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue}
@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue}
@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions}
@z
@x l.8425
@+else print_esc("insertpenalties");
@y
@/@<Cases of |set_page_int| for |print_cmd_chr|@>@/
@+else print_esc("insertpenalties");
@z
@x l.8434
othercases print_esc("badness")
@y
@/@<Cases of |last_item| for |print_cmd_chr|@>@/
othercases print_esc("badness")
@z
@x l.8457
begin if m=0 then cur_val:=dead_cycles@+else cur_val:=insert_penalties;
@y
begin if m=0 then cur_val:=dead_cycles
@/@<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>@/
else cur_val:=insert_penalties;
@z
@x l.8462
begin scan_eight_bit_int;
if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc;
@y
begin scan_register_num; fetch_box(q);
if q=null then cur_val:=0 @+else cur_val:=mem[q+m].sc;
@z
@x l.8487
begin if par_shape_ptr=null then cur_val:=0
@y
begin if m>par_shape_loc then @<Fetch a penalties array element@>
else if par_shape_ptr=null then cur_val:=0
@z
@x l.8493
implemented. The reference count for \.{\\lastskip} will be updated later.
@y
implemented. The reference count for \.{\\lastskip} will be updated later.
A final \.{\\endM} node is temporarily removed.
@z
@x l.8499
if cur_chr>glue_val then
begin if cur_chr=input_line_no_code then cur_val:=line
else cur_val:=last_badness; {|cur_chr=badness_code|}
@y
if m>last_node_type_code then
if m>=eTeX_glue then @<Process an expression and |return|@>@;
else if m>=eTeX_dim then
begin case m of
@/@<Cases for fetching a dimension value@>@/
end; {there are no other cases}
cur_val_level:=dimen_val;
end
else begin case m of
input_line_no_code: cur_val:=line;
badness_code: cur_val:=last_badness;
@/@<Cases for fetching an integer value@>@/
end; {there are no other cases}
@z
@x l.8505
cur_val_level:=cur_chr;
@y
if cur_chr=last_node_type_code then
begin cur_val:=int_val;
if (tail=head)or(mode=0) then cur_val:=-1;
end
else cur_val_level:=cur_chr;
@z
@x l.8507
case cur_chr of
@y
begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
remove_end_M;
case cur_chr of
@z
@x l.8513
end;
@y
end;
last_node_type_code:
if (type(tail)<>math_node)or(subtype(tail)<>end_M_code) then
if type(tail)<=unset_node then cur_val:=type(tail)+1
else cur_val:=unset_node+2;
@z
@x l.8514
end {there are no other cases}
@y
end; {there are no other cases}
if LR_temp<>null then insert_end_M;
end
@z
@x l.8519
glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
@y
glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
last_node_type_code: cur_val:=last_node_type;
@z
@x l.8535
begin scan_eight_bit_int;
case m of
@y
begin if (m<mem_bot)or(m>lo_mem_stat_max) then
begin cur_val_level:=sa_type(m);
if cur_val_level<glue_val then cur_val:=sa_int(m)
else cur_val:=sa_ptr(m);
end
else begin scan_register_num; cur_val_level:=m-mem_bot;
if cur_val>255 then
begin find_sa_element(cur_val_level,cur_val,false);
if cur_ptr=null then
if cur_val_level<glue_val then cur_val:=0
else cur_val:=zero_glue
else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
else cur_val:=sa_ptr(cur_ptr);
end
else
case cur_val_level of
@z
@x l.8542
cur_val_level:=m;
@y
end;
@z
@x l.9070
exit:end;
@y
exit:end;
@#
@<Declare procedures needed for expressions@>@;
@z
@x l.9129
@p function str_toks(@!b:pool_pointer):pointer;
@y
@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
function str_toks(@!b:pool_pointer):pointer;
@z
@x l.9154
@p function the_toks:pointer;
@y
@p function the_toks:pointer;
label exit;
@z
@x l.9158
begin get_x_token; scan_something_internal(tok_val,false);
@y
@!c:small_number; {value of |cur_chr|}
begin @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>;@/
get_x_token; scan_something_internal(tok_val,false);
@z
@x l.9172
end;
@y
exit:end;
@z
@x l.9223
othercases print_esc("jobname")
@y
@/@<Cases of |convert| for |print_cmd_chr|@>@/
othercases print_esc("jobname")
@z
@x l.9232
@!c:number_code..job_name_code; {desired type of conversion}
@y
@!c:small_number; {desired type of conversion}
@z
@x l.9249
end {there are no other cases}
@y
@/@<Cases of `Scan the argument for command |c|'@>@/
end {there are no other cases}
@z
@x l.9265
end {there are no other cases}
@y
@/@<Cases of `Print the result of command |c|'@>@/
end {there are no other cases}
@z
@x l.9374
if cur_cmd<=max_command then goto done2;
@y
if cur_cmd>=call then
if info(link(cur_chr))=protected_token then
begin cur_cmd:=relax; cur_chr:=no_expand_flag;
end;
if cur_cmd<=max_command then goto done2;
@z
@x l.9422
@p procedure read_toks(@!n:integer;@!r:pointer);
@y
@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword);
@z
@x l.9448
loop@+ begin get_token;
@y
@<Handle \.{\\readline} and |goto done|@>;@/
loop@+ begin get_token;
@z
@x l.9500
@d if_char_code=0 { `\.{\\if}' }
@y
@d unless_code=32 {amount added for `\.{\\unless}' prefix}
@#
@d if_char_code=0 { `\.{\\if}' }
@z
@x l.9555
if_test: case chr_code of
@y
if_test: begin if chr_code>=unless_code then print_esc("unless");
case chr_code mod unless_code of
@z
@x l.9572
othercases print_esc("if")
endcases;
@y
@/@<Cases of |if_test| for |print_cmd_chr|@>@/
othercases print_esc("if")
endcases;
end;
@z
@x l.9646
done: scanner_status:=save_scanner_status;
@y
done: scanner_status:=save_scanner_status;
if tracing_ifs>0 then show_cur_cmd_chr;
@z
@x l.9662
begin p:=cond_ptr; if_line:=if_line_field(p);
@y
begin if if_stack[in_open]=cond_ptr then if_warning;
{conditionals possibly not properly nested with files}
p:=cond_ptr; if_line:=if_line_field(p);
@z
@x l.9699
begin @<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/
@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
@y
@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?}
begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/
@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
if is_unless then b:=not b;
@z
@x l.9742
if_false_code: b:=false;
@y
if_false_code: b:=false;
@/@<Cases for |conditional|@>@/
@z
@x l.9781
begin scan_eight_bit_int; p:=box(cur_val);
@y
begin scan_register_num; fetch_box(p);
@z
@x l.9871
if cur_chr>if_limit then
@y
begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
if cur_chr>if_limit then
@z
@x l.9882
end
@y
end;
end
@z
@x l.9952
following structure: If the name contains `\.>' or `\.:', the file area
consists of all characters up to and including the final such character;
otherwise the file area is null. If the remaining file name contains
`\..', the file extension consists of all such characters from the first
remaining `\..' to the end, otherwise the file extension is null.
@^system dependencies@>
We can scan such file names easily by using two global variables that keep track
of the occurrences of area and extension delimiters:
@y
following structure: If the name contains `\.>', `\.]' or `\.:', the directory
consists of all characters up to and including the final such character;
otherwise the directory is null. If the remaining file name contains
`\..', the file extension consists of all such characters from the first
remaining `\..' to the end, otherwise the file extension is null.
@^system dependencies@>
We can scan such file names easily by using two global variables that keep track
of the occurrences of area and extension delimiters:
We also take this opportunity to add some more global definitions for an
upcoming section.
@z
@x l.9963
@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
@y
@!area_delimiter:pool_pointer; {the most recent `\.>', `\.]' or `\.:', if any}
@!TEX_area, @!TEX_font_area:str_number;
@!inp_name, @!fonts_name : packed array[1..file_name_size] of char;
@!inp_len, @!fonts_len : file_size;
@!i: integer;
@z
@x l.9973
@d TEX_area=="TeXinputs:"
@.TeXinputs@>
@d TEX_font_area=="TeXfonts:"
@.TeXfonts@>
@y
For VMS, we handle setting the names for these two logicals by defining them in
the \.{CLD} file. We'll deal with getting that information later. The code that
follows here will be executed after we've read the command line and \.{CLD}
file and assumes that the first |inp_len| characters of |inp_name| are the
value to use for |TEX_area| and the first |fonts_len| characters of
|fonts_name| are the value to use for |TEX_font_area|. This code must be
inserted just after \TeX\ has initialized all of its strings but before its
first attempt at reading a file.
I apologize for adding |i| to the globals above, by the way. There's only so
much searching for a global in \.{TEX.WEB} one can take.
@^frustration@>
@<Read the values of \.{/TEXINPUTS} and \.{/TEXFONTS} and put them
into the string pool@>=
VAX_cli_get_value('TEXINPUTS',inp_name,inp_len);
str_room(inp_len); for i:=1 to inp_len do append_char(xord[inp_name[i]]);
TEX_area:=make_string;
@#
VAX_cli_get_value('TEXFONTS',fonts_name,fonts_len);
str_room(fonts_len); for i:=1 to fonts_len do append_char(xord[fonts_name[i]]);
TEX_font_area:=make_string
@z
@x l.9985
@ And here's the second. The string pool might change as the file name is
being scanned, since a new \.{\\csname} might be entered; therefore we keep
|area_delimiter| and |ext_delimiter| relative to the beginning of the current
string, instead of assigning an absolute address like |pool_ptr| to them.
@^system dependencies@>
@p function more_name(@!c:ASCII_code):boolean;
begin if c=" " then more_name:=false
else begin str_room(1); append_char(c); {contribute |c| to the current string}
if (c=">")or(c=":") then
begin area_delimiter:=cur_length; ext_delimiter:=0;
end
else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
more_name:=true;
end;
end;
@y
@ And here's the second. The string pool might change as the file name is
being scanned, since a new \.{\\csname} might be entered; therefore we keep
|area_delimiter| and |ext_delimiter| relative to the beginning of the current
string, instead of assigning an absolute address like |pool_ptr| to them.
@^system dependencies@>
On VMS, we support wildcards in filenames. But, since the single char
wildcard `\.\%' is interpreted as comment delimiter in the \TeX\ input
stream, the question mark `\.?' should be used for that purpose, instead.
Here, we have to convert those `\.?' characters back to `\.\%'.
@p function more_name(@!c:ASCII_code):boolean;
begin if c=" " then more_name:=false
else begin str_room(1); {check for enough string space to add one char}
if (c="?") then
c:="%"; {convert `\.?' ``single char wildcard'' into `\.\%'}
append_char(c); {contribute |c| to the current string}
if (c=">")or(c="]")or(c=":") then
begin area_delimiter:=cur_length; ext_delimiter:=0;
end
else if (c=".")and(ext_delimiter=0) then
ext_delimiter:=cur_length;
more_name:=true;
end;
end;
@z
@x l.10002
@ The third.
@^system dependencies@>
@p procedure end_name;
begin if str_ptr+3>max_strings then
overflow("number of strings",max_strings-init_str_ptr);
@:TeX capacity exceeded number of strings}{\quad number of strings@>
if area_delimiter=0 then cur_area:=""
else begin cur_area:=str_ptr;
str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
end;
if ext_delimiter=0 then
begin cur_ext:=""; cur_name:=make_string;
end
else begin cur_name:=str_ptr;
str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
incr(str_ptr); cur_ext:=make_string;
end;
end;
@y
@ The third. We have to check to see if a logical name has been
referred to, and if so, translate it.
@^system dependencies@>
@p procedure end_name;
label restart,exit;
var
@!t:packed array[1..file_name_size] of char;
@!i:pool_pointer;
@!len:signed_halfword;
begin
restart:
if (str_pool[str_start[str_ptr]+area_delimiter]=si(":")) and @|
(pool_ptr=str_start[str_ptr]+area_delimiter+1) then
begin
cur_area:=make_string;
len:=length(cur_area)-1; {don't include the colon}
for i:=1 to len do
t[i]:=xchr[so(str_pool[str_start[cur_area]+i-1])];
if not translate(t,len) then begin
cur_ext:=""; cur_name:=""; {silly case}
return;
end;
flush_string; {needn't remember logical name in |cur_area|}
begin_name;
for i:=1 to len do
if not more_name(xord[t[i]]) then goto restart;
goto restart; {heavy!}
end;
if str_ptr+3>max_strings then
overflow("number of strings",max_strings-init_str_ptr);
@:TeX capacity exceeded number of strings}{\quad number of strings@>
if area_delimiter=0 then cur_area:=""
else begin cur_area:=str_ptr;
str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
end;
if ext_delimiter=0 then
begin cur_ext:=""; cur_name:=make_string;
end
else begin cur_name:=str_ptr;
str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
incr(str_ptr); cur_ext:=make_string;
end;
exit:
end;
@z
@x l.10060
@d format_default_length=20 {length of the |TEX_format_default| string}
@d format_area_length=11 {length of its area part}
@d format_ext_length=4 {length of its `\.{.fmt}' part}
@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
@<Glob...@>=
@!TEX_format_default:packed array[1..format_default_length] of char;
@y
We want to be able to load the name of the area where formats live from an
argument on the command line (actually, this will work like the \.{/TEXINPUTS}
and \.{/TEXFONTS} qualifiers mentioned above, except that here, the qualifier
will be read by both \TeX\ and \.{INITEX}. Also, things are a little simpler
since we don't deal with the string pool ourselves. On the other hand some
\.{WEB} constants will be changed to variables since we cannot know at compile
time how long the argument to \.{/TEXFORMATS} will be.
@./TEXFORMATS@>
We also will take this opportunity to set the value for |pool_name| since we
need the value given by \.{/TEXFORMATS} to construct it.
@d format_name_length=9 {length of |'plain.fmt'|}
@d format_ext_length=4 {length of its `\.{.fmt}' part}
@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
@d pool_name_length==@= length@>(pool_f_name)
@<Glob...@>=
@!TEX_f_name_default:packed array[1..format_name_length] of char;
{abbreviated name for conflict considerations}
@!TEX_format_default:packed array[1..file_name_size] of char;
@!pool_name:packed array[1..file_name_size] of char;
@!format_area_length:file_size; {length of the area part}
@!format_default_length:integer; {length of the whole mess upon construction}
@z
@x l.10069
TEX_format_default:='TeXformats:plain.fmt';
@.TeXformats@>
@y
TEX_f_name_default:='plain.fmt';
VAX_cli_get_value('TEXFORMATS',TEX_format_default,format_area_length);
pool_name:=TEX_format_default;
for i:=1 to pool_name_length do
pool_name[i+format_area_length]:=pool_f_name[i];
for i:=1 to format_name_length do
TEX_format_default[i+format_area_length]:=TEX_f_name_default[i];
format_default_length:=format_area_length+format_name_length;
@z
@x l.10074
@ @<Check the ``constant'' values for consistency@>=
if format_default_length>file_name_size then bad:=31;
@y
@ There used to be a consistency check here, but since the value it checked
wouldn't be set until {\it after\/} the consistency checking, we've deleted it.
Besides, our code will automatically guarantee consistancy simply by the way
|TEX_format_default| is defined.
@z
@x l.10140
@ Operating systems often make it possible to determine the exact name (and
possible version number) of a file that has been opened. The following routine,
which simply makes a \TeX\ string from the value of |name_of_file|, should
ideally be changed to deduce the full name of file~|f|, which is the file
most recently opened, if it is possible to do this in a \PASCAL\ program.
@^system dependencies@>
@y
@ The VMS operating system is able to determine the exact name (and version
number) of a file that has been opened through use of the |user_action|
parameter of the |open| routine. The following routine makes a \TeX\ string from
the value of |last_name[1..last_length]|, which is the full specification of the
most recently opened file.
@^system dependencies@>
@z
@x l.10150
@p function make_name_string:str_number;
var k:1..file_name_size; {index into |name_of_file|}
begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or
(cur_length>0) then
make_name_string:="?"
else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
make_name_string:=make_string;
end;
end;
@y
@p function make_name_string:str_number;
var k:1..file_name_size; {index into |name_of_file|}
begin if (pool_ptr+last_length>pool_size)or(str_ptr=max_strings)or
(cur_length>0) then
make_name_string:="?"
else begin for k:=1 to last_length do append_char(xord[last_name[k]]);
make_name_string:=make_string;
end;
end;
@z
@x l.10211
@ Here is a routine that manufactures the output file names, assuming that
|job_name<>0|. It ignores and changes the current settings of |cur_area|
and |cur_ext|.
@y
@ Here is a routine that manufactures the output file names, assuming that
|job_name<>0|. It ignores and changes the current settings of |cur_area|
and |cur_ext|.
Similarly, |pack_default_name| extracts a (possibly partial) file specification
from the appropriate command line qualifier, if used, and creates a string which
may be used to provide defaults for part of a file specification when opening
certain auxiliary files. The routine |clear_default_name| is also provided to
ensure that no defaults are applied on successive calls of |open|.
@z
@x l.10217
@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".dvi"|, or
|format_extension|}
begin cur_area:=""; cur_ext:=s;
cur_name:=job_name; pack_cur_name;
end;
@y
@p procedure pack_job_name(@!s:str_number); {|s = ".lis"|, |".dvi"|, |".dia"|,
|format_extension|}
begin cur_area:=""; cur_ext:=s;
cur_name:=job_name; pack_cur_name;
end;@#
function pack_default_name(qual : boolean;
df_name : packed array [l1..u1:integer] of char;
df_len : file_size) : boolean;
var k : integer;
begin
for k:=1 to file_name_size do default_name[k] := name_of_file[k];
deflt_length:=name_length;
if qual then
begin
name_of_file := df_name;
name_length := df_len;
if name_length < file_name_size then
for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
end;
pack_default_name := qual; {Result is whether file wanted}
end;@#
procedure clear_default_name;
var k : integer;
begin
for k:=1 to file_name_size do default_name[k]:=' ';
end;
@z
@x l.10223
@ If some trouble arises when \TeX\ tries to open a file, the following
routine calls upon the user to supply another file name. Parameter~|s|
is used in the error message to identify the type of file; parameter~|e|
is the default extension if none is given. Upon exit from the routine,
variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are
ready for another attempt at file opening.
@y
@ If some trouble arises when \TeX\ tries to open a file, the following
routine calls upon the user to supply another file name. Parameter~|s|
is used in the error message to identify the type of file; parameter~|e|
is the default extension if none is given. Upon exit from the routine,
variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are
ready for another attempt at file opening.
Because this procedure invokes the |print_err| macro, but does not terminate
the ``error'' (by invoking |error|), we have to take special measures to
prevent everything from here onwards being written to the |temp_file| used for
diagnostics. It does this by resetting the |temp_file|.
@z
@x l.10245
clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
@y
clear_terminal; prompt_input(": "); @<Ensure |temp_file| not in use@>;
@<Scan file name in the buffer@>;
@z
@x l.10263
@d ensure_dvi_open==if output_file_name=0 then
begin if job_name=0 then open_log_file;
pack_job_name(".dvi");
while not b_open_out(dvi_file) do
prompt_file_name("file name for output",".dvi");
output_file_name:=b_make_name_string(dvi_file);
end
@y
@d ensure_dvi_open==if output_file_name=0 then
begin if job_name=0 then open_log_file;
pack_job_name(".dvi");
if pack_default_name(dvi_qual,dvif_name,dvif_len) then
begin
while not b_open_out(dvi_file) do
prompt_file_name("file name for output",".dvi");
output_file_name:=b_make_name_string(dvi_file);
end else
output_file_name:=".";
clear_default_name;
end
@z
@x l.10278
@ The |open_log_file| routine is used to open the transcript file and to help
it catch up to what has previously been printed on the terminal.
@p procedure open_log_file;
@y
@ The |open_log_file| routine is used to open the transcript file and to help
it catch up to what has previously been printed on the terminal.
@p @<Declare the |open_diag_file| procedure@>
@#
procedure open_log_file;
@z
@x l.10287
if job_name=0 then job_name:="texput";
@.texput@>
pack_job_name(".log");
while not a_open_out(log_file) do @<Try to get a different log file name@>;
log_name:=a_make_name_string(log_file);
@y
if job_name=0 then job_name:="texput";
@.texput@>
pack_job_name(".lis");
if pack_default_name(log_qual,logf_name,logf_len) then
begin
while not a_open_out(log_file) do @<Try to get a different log file name@>;
log_name:=a_make_name_string(log_file);
end else
log_name:=".";
clear_default_name;
open_diag_file;
@z
@x l.10320
prompt_file_name("transcript file name",".log");
@y
prompt_file_name("transcript file name",".lis");
@z
@x l.10324
begin wlog(banner);
@y
begin wlog(eTeX_banner);
@z
@x l.10331
end
@y
if eTeX_ex then
begin; wlog_cr; wlog('entering extended mode');
end;
end
@z
@x l.10333
@ Let's turn now to the procedure that is used to initiate file reading
when an `\.{\\input}' command is being processed.
@y
@ Let's turn now to the procedure that is used to initiate file reading
when an `\.{\\input}' command is being processed.
As originally used by \TeX82 under VMS, this procedure discarded the current
file name (as returned to it by the operating system) after it had been printed.
However, with this version of \TeX, with its capability of writing diagnostic
files for use by LSEdit's review mode, we need to be able to report the full
file specifications of any files that may be involved in |show_context|;
therefore, we do not call |flush_string| here.
@z
@x l.10336
@p procedure start_input; {\TeX\ will \.{\\input} something}
label done;
begin scan_file_name; {set |cur_name| to desired file name}
@y
Here, |x_open_in|, a modified version of |a_open_in|, is inserted.
This function is located here (and not next to |a_open_in|) to eliminate
the neccessity of a forward declaration for the |pack_file_name| function.
The new function |x_open_in| is intended to replace the calls to
|a_open_in| in the procedures |start_input| and |open_or_close_in|.
It extends the file opening functionality of |a_open_in| by
a second try to open the file using the |TEX_area| path specification,
when no explicit path was specified. The code needed
for this purpose has been moved out of the |start_input| procedure.
This change unifies the file search behaviour of the \.{\\input} and
\.{\\openin} commands, a useful modification of \TeX\ recommended by the
new edition of the \LaTeX\ macro package.
The original function |a_open_in| is still used to read the \TeX\ pool file.
When |start_input| decides to initiate the transcript file (this can only
happen when |start_input| is called the first time!), the |cur_name| string
get updated with the contents of |last_basename|. This string is the base
name part of the file opened the previous |x_open_in| call. This modification
reveals the correct job name when the primary input file specification
contained wildcard characters in the base name part.
@p function x_open_in(var f:alpha_file):boolean;
begin
open(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
VAX_ignore_error);
if status(f)>0 then begin
if cur_area="" then begin
pack_file_name(cur_name,TEX_area,cur_ext);
open(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
VAX_ignore_error);
end;
end;
if status(f)>0 then x_open_in:=false
else begin
reset(f,VAX_ignore_error);
x_open_in:=status(f)<=0;
end;
end;
@#
procedure start_input; {\TeX\ will \.{\\input} something}
label done;
var k:integer;
begin scan_file_name; {set |cur_name| to desired file name}
@z
@x l.10340
pack_cur_name;
loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
if a_open_in(cur_file) then goto done;
if cur_area="" then
begin pack_file_name(cur_name,TEX_area,cur_ext);
if a_open_in(cur_file) then goto done;
end;
end_file_reading; {remove the level that didn't work}
prompt_file_name("input file name",".tex");
@y
pack_cur_name;
loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
if x_open_in(cur_file) then goto done;
end_file_reading; {remove the level that didn't work}
prompt_file_name("input file name",".tex");
@z
@x l.10350
done: name:=a_make_name_string(cur_file);
if job_name=0 then
begin job_name:=cur_name; open_log_file;
end; {|open_log_file| doesn't |show_context|, so |limit|
and |loc| needn't be set to meaningful values yet}
@y
done: name:=a_make_name_string(cur_file);
if job_name=0 then
begin
if last_basenam_len = length(cur_name) then
begin
for k:=1 to last_basenam_len do
str_pool[str_start[cur_name]+k-1]:=si(xord[last_basename[k]]);
end
else
if (pool_ptr+last_basenam_len<=pool_size)and(str_ptr<>max_strings)and
(cur_length<=0) then
begin
for k:=1 to last_basenam_len do append_char(xord[last_basename[k]]);
cur_name:=make_string;
end;
job_name:=cur_name; open_log_file;
end; {|open_log_file| doesn't |show_context|, so |limit|
and |loc| needn't be set to meaningful values yet}
@z
@x l.10359
if name=str_ptr-1 then {we can conserve string pool space now}
begin flush_string; name:=cur_name;
end;
@y
@z
@x l.10945
if not b_open_in(tfm_file) then abort;
@y
if not b_open_in(tfm_file) then abort;
tfm_count:=0;
@z
@x l.10956
@d fget==get(tfm_file)
@d fbyte==tfm_file^
@y
@d fget==begin incr(tfm_count);
if tfm_count=VAX_block_length then begin
get(tfm_file,VAX_ignore_error); tfm_count:=0; end
end
@d fbyte==tfm_file^[tfm_count]
@z
@x l.11161
if eof(tfm_file) then abort;
@y
if status(tfm_file)<>0 then abort;
@z
@x l.11263
begin if tracing_lost_chars>0 then
@y
var old_setting: integer; {saved value of |tracing_online|}
begin if tracing_lost_chars>0 then
begin old_setting:=tracing_online;
if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
@z
@x l.11270
end;
@y
tracing_online:=old_setting;
end;
end;
@z
@x l.11855
@ Some systems may find it more efficient to make |dvi_buf| a |packed|
array, since output of four bytes at once may be facilitated.
@^system dependencies@>
@<Glob...@>=
@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
@y
@ Some systems may find it more efficient to make |dvi_buf| a |packed|
array, since output of four bytes at once may be facilitated. On VMS,
we get even more complicated than that, for efficiency.
@d dvi_buf==d_buffer.b {buffer for \.{DVI} output}
@<Glob...@>=
@!d_buffer: [VAX_volatile,VAX_aligned(9)] packed record
case boolean of
false: (@!b:packed array[dvi_index] of eight_bits);
true: (@!l:byte_block; @!r:byte_block; @!j:eight_bits);
end;
@z
@x l.11875
@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
|write_dvi(a,b)|. For best results, this procedure should be optimized to
run as fast as possible on each particular system, since it is part of
\TeX's inner loop. It is safe to assume that |a| and |b+1| will both be
multiples of 4 when |write_dvi(a,b)| is called; therefore it is possible on
many machines to use efficient methods to pack four bytes per word and to
output an array of words with one system call.
@^system dependencies@>
@^inner loop@>
@^defecation@>
@p procedure write_dvi(@!a,@!b:dvi_index);
var k:dvi_index;
begin for k:=a to b do write(dvi_file,dvi_buf[k]);
end;
@y
@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
|write| on the other variant of the |dvi_buf| record. Thus, we have to be
sure that things line up properly, by padding out with ``signature'' bytes.
@^system dependencies@>
@^inner loop@>
@^defecation@>
@<Check the ``co...@>=
if dvi_buf_size<>2*VAX_block_length then bad:=223;
@z
@x l.11900
begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
@y
begin if dvi_qual then write(dvi_file,d_buffer.l); dvi_limit:=half_buf;
@z
@x l.11903
else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
@y
else begin if dvi_qual then write(dvi_file,d_buffer.r);
dvi_limit:=dvi_buf_size;
@z
@x l.11912
if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
@y
if (dvi_limit=half_buf) and dvi_qual then write(dvi_file,d_buffer.r);
for k:=dvi_ptr to dvi_buf_size do dvi_buf[k]:=223;
if (dvi_ptr>0) and dvi_qual then write(dvi_file,d_buffer.l);
if (dvi_ptr>half_buf) and dvi_qual then write(dvi_file,d_buffer.r);
@z
@x l.12238
this is essentially the depth of |push| commands in the \.{DVI} output.
@y
this is essentially the depth of |push| commands in the \.{DVI} output.
For mixed direction text (\TeXXeT) the current text direction is called
|cur_dir|. As the box being shipped out will never be used again and
soon be recycled, we can simply reverse any R-text (i.e., right-to-left)
segments of hlist nodes as well as complete hlist nodes embedded in such
segments. Moreover this can be done iteratively rather than recursively.
There are, however, two complications related to leaders that require
some additional bookkeeping: (1)~One and the same hlist node might be
used more than once (but never inside both L- and R-text); and
(2)~leader boxes inside hlists must be aligned with respect to the left
edge of the original hlist.
A math node is changed into a kern node whenever the text direction
remains the same, it is replaced by an |edge_node| if the text direction
changes; the subtype of an an |hlist_node| inside R-text is changed to
|reversed| once its hlist has been reversed.
@!@^data structure assumptions@>
@z
@x l.12240
@d synch_h==if cur_h<>dvi_h then
@y
@d reversed=min_quarterword+1 {subtype for an |hlist_node| whose hlist
has been reversed}
@d dlist=min_quarterword+2 {subtype for an |hlist_node| from display math mode}
@d left_to_right=0
@d right_to_left=1
@d reflected==1-cur_dir {the opposite of |cur_dir|}
@#
@d synch_h==if cur_h<>dvi_h then
@z
@x l.12300
@!g_order: glue_ord; {applicable order of infinity for glue}
@y
@z
@x l.12308
@!edge:scaled; {left edge of sub-box, or right edge of leader space}
@y
@!edge:scaled; {right edge of sub-box or leader space}
@!prev_p:pointer; {one step behind |p|}
@z
@x l.12309
@!glue_temp:real; {glue value before rounding}
begin this_box:=temp_ptr; g_order:=glue_order(this_box);
@y
begin this_box:=temp_ptr;
@z
@x l.12315
save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
@y
save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v;
prev_p:=this_box+list_offset;
if eTeX_ex then
begin @<Initialize the LR stack@>;
if subtype(this_box)=dlist then
if cur_dir=right_to_left then
begin cur_dir:=left_to_right; cur_h:=cur_h-width(this_box);
end
else subtype(this_box):=min_quarterword;
if (cur_dir=right_to_left)and(subtype(this_box)<>reversed) then
@<Reverse the complete hlist and set the subtype to |reversed|@>;
end;
left_edge:=cur_h;
@z
@x l.12318
prune_movements(save_loc);
@y
if eTeX_ex then
begin @<Check for LR anomalies at the end of |hlist_out|@>;
if subtype(this_box)=dlist then cur_dir:=right_to_left;
end;
prune_movements(save_loc);
@z
@x l.12337
p:=link(p);
@y
prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|}
p:=link(p);
@z
@x l.12362
kern_node,math_node:cur_h:=cur_h+width(p);
@y
kern_node:cur_h:=cur_h+width(p);
math_node:begin if eTeX_ex then
@<Adjust \(t)the LR stack for the |hlist_out| routine; if necessary
reverse an hlist segment and |goto reswitch|@>;
cur_h:=cur_h+width(p);
end;
@z
@x l.12364
othercases do_nothing
@y
@/@<Cases of |hlist_out| that arise in mixed direction text only@>@;
othercases do_nothing
@z
@x l.12369
next_p:p:=link(p);
@y
next_p:prev_p:=p; p:=link(p);
@z
@x l.12376
temp_ptr:=p; edge:=cur_h;
@y
temp_ptr:=p; edge:=cur_h+width(p);
if cur_dir=right_to_left then cur_h:=edge;
@z
@x l.12379
cur_h:=edge+width(p); cur_v:=base_line;
@y
cur_h:=edge; cur_v:=base_line;
@z
@x l.12401
begin if g_sign=stretching then
begin if stretch_order(g)=g_order then
begin vet_glue(float(glue_set(this_box))*stretch(g));
@^real multiplication@>
rule_wd:=rule_wd+round(glue_temp);
end;
end
else if shrink_order(g)=g_order then
begin vet_glue(float(glue_set(this_box))*shrink(g));
rule_wd:=rule_wd-round(glue_temp);
end;
end;
@y
add_glue(rule_wd);
@z
@x l.12428
edge:=cur_h+rule_wd; lx:=0;
@y
if cur_dir=right_to_left then cur_h:=cur_h-10;
edge:=cur_h+rule_wd; lx:=0;
@z
@x l.12434
cur_h:=edge-10; goto next_p;
@y
if cur_dir=right_to_left then cur_h:=edge
else cur_h:=edge-10;
goto next_p;
@z
@x l.12473
synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
@y
synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
if cur_dir=right_to_left then cur_h:=cur_h+leader_wd;
@z
@x l.12489
@!g_order: glue_ord; {applicable order of infinity for glue}
@y
@z
@x l.12498
@!glue_temp:real; {glue value before rounding}
begin this_box:=temp_ptr; g_order:=glue_order(this_box);
@y
begin this_box:=temp_ptr;
@z
@x l.12544
cur_h:=left_edge+shift_amount(p); {shift the box right}
@y
if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p)
else cur_h:=left_edge+shift_amount(p); {shift the box right}
@z
@x l.12556
begin synch_h; synch_v;
dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
@y
begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
synch_h; synch_v;
dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
cur_h:=left_edge;
@z
@x l.12564
begin if g_sign=stretching then
begin if stretch_order(g)=g_order then
begin vet_glue(float(glue_set(this_box))*stretch(g));
@^real multiplication@>
rule_ht:=rule_ht+round(glue_temp);
end;
end
else if shrink_order(g)=g_order then
begin vet_glue(float(glue_set(this_box))*shrink(g));
rule_ht:=rule_ht-round(glue_temp);
end;
end;
@y
add_glue(rule_ht);
@z
@x l.12619
begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/
@y
begin if cur_dir=right_to_left then
cur_h:=left_edge-shift_amount(leader_box)
else cur_h:=left_edge+shift_amount(leader_box);
synch_h; save_h:=dvi_h;@/
@z
@x l.12656
@<Ship box |p| out@>;
@y
@<Ship box |p| out@>;
if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>;
@z
@x l.12747
print_nl("Output written on "); slow_print(output_file_name);
@.Output written on x@>
print(" ("); print_int(total_pages); print(" page");
if total_pages<>1 then print_char("s");
print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
b_close(dvi_file);
@y
if dvi_qual then
begin
b_close(dvi_file);
print_nl("Output written on "); slow_print(output_file_name);
@.Output written on x@>
end else
print_nl("NO output file --- would have had");
print(" ("); print_int(total_pages); print(" page");
if total_pages<>1 then print_char("s");
print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
@z
@x l.12876
h:=0; @<Clear dimensions to zero@>;
@y
h:=0; @<Clear dimensions to zero@>;
if TeXXeT_en then @<Initialize the LR stack@>;
@z
@x l.12886
exit: hpack:=r;
@y
exit: if TeXXeT_en then @<Check for LR anomalies at the end of |hpack|@>;
hpack:=r;
@z
@x l.12910
kern_node,math_node: x:=x+width(p);
@y
kern_node: x:=x+width(p);
math_node: begin x:=x+width(p);
if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>;
end;
@z
@x l.13480
\TeX's \.{\\left} and \.{\\right}. The |nucleus| of such noads is
@y
\TeX's \.{\\left} and \.{\\right} as well as \eTeX's \.{\\middle}.
The |nucleus| of such noads is
@z
@x l.13497
@d delimiter==nucleus {|delimiter| field in left and right noads}
@y
@d delimiter==nucleus {|delimiter| field in left and right noads}
@d middle_noad==1 {|subtype| of right noad representing \.{\\middle}}
@z
@x l.13670
right_noad: begin print_esc("right"); print_delimiter(nucleus(p));
end;
end;
if subtype(p)<>normal then
if subtype(p)=limits then print_esc("limits")
else print_esc("nolimits");
if type(p)<left_noad then print_subsidiary_data(nucleus(p),".");
@y
right_noad: begin if subtype(p)=normal then print_esc("right")
else print_esc("middle");
print_delimiter(nucleus(p));
end;
end;
if type(p)<left_noad then
begin if subtype(p)<>normal then
if subtype(p)=limits then print_esc("limits")
else print_esc("nolimits");
print_subsidiary_data(nucleus(p),".");
end;
@z
@x l.14268
done_with_noad: r:=q; r_type:=type(r);
@y
done_with_noad: r:=q; r_type:=type(r);
if r_type=right_noad then
begin r_type:=left_noad; cur_style:=style; @<Set up the values...@>;
end;
@z
@x l.14929
r_type:=t;
@y
if type(q)=right_noad then t:=open_noad;
r_type:=t;
@z
@x l.14970
begin if style<script_style then cur_size:=text_size
else cur_size:=16*((style-text_style) div 2);
@y
begin cur_style:=style; @<Set up the values...@>;
@z
@x l.15461
begin restart: align_state:=1000000; @<Get the next non-blank non-call token@>;
@y
begin restart: align_state:=1000000;
repeat get_x_or_protected;
until cur_cmd<>spacer;
@z
@x l.15572
align_state:=1000000; @<Get the next non-blank non-call token@>;
@y
align_state:=1000000;
repeat get_x_or_protected;
until cur_cmd<>spacer;
@z
@x l.15834
begin type(q):=hlist_node; width(q):=width(p);
@y
begin type(q):=hlist_node; width(q):=width(p);
if nest[nest_ptr-1].mode_field=mmode then subtype(q):=dlist; {for |ship_out|}
@z
@x l.15852
n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
@y
n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
subtype(r):=min_quarterword; {for |ship_out|}
@z
@x l.15975
There is one explicit parameter: |final_widow_penalty| is the amount of
additional penalty to be inserted before the final line of the paragraph.
@y
There is one explicit parameter: |d| is true for partial paragraphs
preceding display math mode; in this case the amount of additional
penalty inserted before the final line is |display_widow_penalty|
instead of |widow_penalty|.
@z
@x l.16002
procedure line_break(@!final_widow_penalty:integer);
@y
procedure line_break(@!d:boolean);
@z
@x l.16012
end;
@y
end;
@#
@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@>
@z
@x l.16032
link(tail):=new_param_glue(par_fill_skip_code);
@y
link(tail):=new_param_glue(par_fill_skip_code);
last_line_fill:=link(tail);
@z
@x l.16097
@d active_node_size=3 {number of words in active nodes}
@y
@d active_node_size_normal=3 {number of words in normal active nodes}
@z
@x l.16260
background[6]:=shrink(q)+shrink(r);
@y
background[6]:=shrink(q)+shrink(r);
@<Check for special treatment of last line of paragraph@>;
@z
@x l.16311
label exit,done,done1,continue,deactivate;
@y
label exit,done,done1,continue,deactivate,found,not_found;
@z
@x l.16603
total_demerits(q):=minimal_demerits[fit_class];
@y
total_demerits(q):=minimal_demerits[fit_class];
if do_last_line_fit then
@<Store \(a)additional data in the new active node@>;
@z
@x l.16616
print(" t="); print_int(total_demerits(q));
@y
print(" t="); print_int(total_demerits(q));
if do_last_line_fit then @<Print additional data in the new active node@>;
@z
@x l.16715
if (b>inf_bad)or(pi=eject_penalty) then
@y
if do_last_line_fit then @<Adjust \(t)the additional data for last line@>;
found:
if (b>inf_bad)or(pi=eject_penalty) then
@z
@x l.16739
begin b:=0; fit_class:=decent_fit; {infinite stretch}
@y
begin if do_last_line_fit then
begin if cur_p=null then {the last line of a paragraph}
@<Perform computations for last line and |goto found|@>;
shortfall:=0;
end;
b:=0; fit_class:=decent_fit; {infinite stretch}
@z
@x l.16796
best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
@y
best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
if do_last_line_fit then
@<Store \(a)additional data for this feasible break@>;
@z
@x l.16969
end;@+tats@/
@y
end;@+tats@/
if do_last_line_fit then @<Adjust \(t)the final line of the paragraph@>;
@z
@x l.16980
line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
@y
line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
if do_last_line_fit then
@<Initialize additional fields of the first active node@>;
@z
@x l.17030
math_node: begin auto_breaking:=(subtype(cur_p)=after); kern_break;
@y
math_node: begin if subtype(cur_p)<L_code then auto_breaking:=end_LR(cur_p);
kern_break;
@z
@x l.17192
post_line_break(final_widow_penalty)
@y
post_line_break(d)
@z
@x l.17206
procedure post_line_break(@!final_widow_penalty:integer);
@y
procedure post_line_break(@!d:boolean);
@z
@x l.17216
begin @<Reverse the links of the relevant passive nodes, setting |cur_p| to the
@y
@!LR_ptr:pointer; {stack of LR codes}
begin LR_ptr:=LR_save;
@<Reverse the links of the relevant passive nodes, setting |cur_p| to the
@z
@x l.17229
prev_graf:=best_line-1;
@y
prev_graf:=best_line-1;
LR_save:=LR_ptr;
@z
@x l.17259
r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
@y
r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node| or |penalty_node|}
if type(q)=math_node then if TeXXeT_en then
@<Adjust \(t)the LR stack for the |post_line_break| routine@>;
@z
@x l.17276
@<Modify the end of the line to reflect the nature of the break and to include
\.{\\rightskip}; also set the proper value of |disc_break|@>;
@y
if TeXXeT_en then
@<Insert LR nodes at the beginning of the current line and adjust
the LR stack based on LR nodes in this line@>;
@<Modify the end of the line to reflect the nature of the break and to include
\.{\\rightskip}; also set the proper value of |disc_break|@>;
if TeXXeT_en then @<Insert LR nodes at the end of the current line@>;
@z
@x l.17299
else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0;
@y
else if type(q)=kern_node then width(q):=0
else if type(q)=math_node then
begin width(q):=0;
if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>;
end;
@z
@x l.17393
begin pen:=inter_line_penalty;
if cur_line=prev_graf+1 then pen:=pen+club_penalty;
if cur_line+2=best_line then pen:=pen+final_widow_penalty;
@y
begin q:=inter_line_penalties_ptr;
if q<>null then
begin r:=cur_line;
if r>penalty(q) then r:=penalty(q);
pen:=penalty(q+r);
end
else pen:=inter_line_penalty;
q:=club_penalties_ptr;
if q<>null then
begin r:=cur_line-prev_graf;
if r>penalty(q) then r:=penalty(q);
pen:=pen+penalty(q+r);
end
else if cur_line=prev_graf+1 then pen:=pen+club_penalty;
if d then q:=display_widow_penalties_ptr
else q:=widow_penalties_ptr;
if q<>null then
begin r:=best_line-cur_line-1;
if r>penalty(q) then r:=penalty(q);
pen:=pen+penalty(q+r);
end
else if cur_line+2=best_line then
if d then pen:=pen+display_widow_penalty
else pen:=pen+widow_penalty;
@z
@x l.17460
cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
@y
cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
set_hyph_index;
@z
@x l.17529
if lc_code(c)<>0 then
if (lc_code(c)=c)or(uc_hyph>0) then goto done2
@y
set_lc_code(c);
if hc[0]<>0 then
if (hc[0]=c)or(uc_hyph>0) then goto done2
@z
@x l.17546
if lc_code(c)=0 then goto done3;
if hn=63 then goto done3;
hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=lc_code(c); hyf_bchar:=non_char;
@y
set_lc_code(c);
if hc[0]=0 then goto done3;
if hn=63 then goto done3;
hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char;
@z
@x l.17572
if lc_code(c)=0 then goto done3;
if j=63 then goto done3;
incr(j); hu[j]:=c; hc[j]:=lc_code(c);@/
@y
set_lc_code(c);
if hc[0]=0 then goto done3;
if j=63 then goto done3;
incr(j); hu[j]:=c; hc[j]:=hc[0];@/
@z
@x l.18211
label reswitch, exit, found, not_found;
@y
label reswitch, exit, found, not_found, not_found1;
@z
@x l.18221
set_cur_lang;
@y
set_cur_lang;
@!init if trie_not_ready then
begin hyph_index:=0; goto not_found1;
end;
tini@/
set_hyph_index;
not_found1:
@z
@x l.18253
else begin if lc_code(cur_chr)=0 then
@y
else begin set_lc_code(cur_chr);
if hc[0]=0 then
@z
@x l.18261
begin incr(n); hc[n]:=lc_code(cur_chr);
@y
begin incr(n); hc[n]:=hc[0];
@z
@x l.18549
trie_root:=compress_trie(trie_root); {identify equivalent subtries}
@y
hyph_root:=compress_trie(hyph_root);
trie_root:=compress_trie(trie_root); {identify equivalent subtries}
@z
@x l.18637
if trie_root=0 then {no patterns were given}
@y
if trie_max=0 then {no patterns were given}
@z
@x l.18641
else begin trie_fix(trie_root); {this fixes the non-holes in |trie|}
@y
else begin if hyph_root>0 then trie_fix(hyph_root);
if trie_root>0 then trie_fix(trie_root); {this fixes the non-holes in |trie|}
@z
@x l.18684
brace@>;
@y
brace@>;
if saving_hyph_codes>0 then
@<Store hyphenation codes for current language@>;
@z
@x l.18791
@<Move the data into |trie|@>;
@y
if hyph_root<>0 then @<Pack all stored |hyph_codes|@>;
@<Move the data into |trie|@>;
@z
@x l.18807
whenever this is possible without backspacing.
@y
whenever this is possible without backspacing.
When the second argument |s| is |false| the deleted nodes are destroyed,
otherwise they are collected in a list starting at |split_disc|.
@z
@x l.18814
@p function prune_page_top(@!p:pointer):pointer; {adjust top after page break}
var prev_p:pointer; {lags one step behind |p|}
@!q:pointer; {temporary variable for list manipulation}
@y
@p function prune_page_top(@!p:pointer;@!s:boolean):pointer;
{adjust top after page break}
var prev_p:pointer; {lags one step behind |p|}
@!q,@!r:pointer; {temporary variables for list manipulation}
@z
@x l.18825
link(prev_p):=p; flush_node_list(q);
@y
link(prev_p):=p;
if s then
begin if split_disc=null then split_disc:=q@+else link(r):=q;
r:=q;
end
else flush_node_list(q);
@z
@x l.18992
@p function vsplit(@!n:eight_bits; @!h:scaled):pointer;
@y
@p @t\4@>@<Declare the function called |do_marks|@>@;
function vsplit(@!n:halfword; @!h:scaled):pointer;
@z
@x l.18998
begin v:=box(n);
@y
begin cur_val:=n; fetch_box(v);
@z
@x l.18999
if split_first_mark<>null then
@y
flush_node_list(split_disc); split_disc:=null;
if sa_mark<>null then
if do_marks(vsplit_init,0,sa_mark) then sa_mark:=null;
if split_first_mark<>null then
@z
@x l.19007
q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size);
@y
q:=prune_page_top(q,saving_vdiscards>0);
p:=list_ptr(v); free_node(v,box_node_size);
@z
@x l.19008
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 q:=vpack(q,natural);
change_box(q); {the |eq_level| of the box stays the same}
@z
@x l.19033
if split_first_mark=null then
@y
if mark_class(p)<>null then @<Update the current marks for |vsplit|@>
else if split_first_mark=null then
@z
@x l.19167
The variables |last_penalty| and |last_kern| are similar. And
@y
The variables |last_penalty|, |last_kern|, and |last_node_type|
are similar. And
@z
@x l.19180
@!last_kern:scaled; {used to implement \.{\\lastkern}}
@y
@!last_kern:scaled; {used to implement \.{\\lastkern}}
@!last_node_type:integer; {used to implement \.{\\lastnodetype}}
@z
@x l.19317
last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
@y
last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
last_node_type:=-1;
@z
@x l.19384
last_penalty:=0; last_kern:=0;
@y
last_penalty:=0; last_kern:=0;
last_node_type:=type(p)+1;
@z
@x l.19421
link(contrib_head):=link(p); link(p):=null; flush_node_list(p)
@y
link(contrib_head):=link(p); link(p):=null;
if saving_vdiscards>0 then
begin if page_disc=null then page_disc:=p@+else link(tail_page_disc):=p;
tail_page_disc:=p;
end
else flush_node_list(p)
@z
@x l.19661
if bot_mark<>null then
@y
if sa_mark<>null then
if do_marks(fire_up_init,0,sa_mark) then sa_mark:=null;
if bot_mark<>null then
@z
@x l.19669
if (top_mark<>null)and(first_mark=null) then
@y
if sa_mark<>null then
if do_marks(fire_up_done,0,sa_mark) then sa_mark:=null;
if (top_mark<>null)and(first_mark=null) then
@z
@x l.19706
else if type(p)=mark_node then @<Update the values of
@y
else if type(p)=mark_node then
if mark_class(p)<>null then @<Update the current marks for |fire_up|@>
else @<Update the values of
@z
@x l.19818
ins_ptr(p):=prune_page_top(broken_ptr(r));
@y
ins_ptr(p):=prune_page_top(broken_ptr(r),false);
@z
@x l.19854
ship_out(box(255)); box(255):=null;
@y
flush_node_list(page_disc); page_disc:=null;
ship_out(box(255)); box(255):=null;
@z
@x l.19896
pop_nest; build_page;
@y
flush_node_list(page_disc); page_disc:=null;
pop_nest; build_page;
@z
@x l.20697
if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
@y
if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
if inter_line_penalties_ptr<>null then
eq_define(inter_line_penalties_loc,shape_ref,null);
@z
@x l.20718
|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
|global_box_flag-1| represent `\.{\\setbox0}' through `\.{\\setbox32767}';
codes |global_box_flag| through |ship_out_flag-1| represent
`\.{\\global\\setbox0}' through `\.{\\global\\setbox32767}';
code |ship_out_flag| represents `\.{\\shipout}'; and codes |leader_flag|
through |leader_flag+2| represent `\.{\\leaders}', `\.{\\cleaders}',
@z
@x l.20732
@d ship_out_flag==box_flag+512 {context code for `\.{\\shipout}'}
@d leader_flag==box_flag+513 {context code for `\.{\\leaders}'}
@y
@d global_box_flag==@'10000100000 {context code for `\.{\\global\\setbox0}'}
@d ship_out_flag==@'10000200000 {context code for `\.{\\shipout}'}
@d leader_flag==@'10000200001 {context code for `\.{\\leaders}'}
@z
@x l.20815
var p:pointer; {|ord_noad| for new box in math mode}
@y
var p:pointer; {|ord_noad| for new box in math mode}
@!a:small_number; {global prefix}
@z
@x l.20853
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
begin if box_context<global_box_flag then
begin cur_val:=box_context-box_flag; a:=0;
end
else begin cur_val:=box_context-global_box_flag; a:=4;
end;
if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
else sa_def_box;
end
@z
@x l.20885
@!n:eight_bits; {a box number}
begin case cur_chr of
box_code: begin scan_eight_bit_int; cur_box:=box(cur_val);
box(cur_val):=null; {the box becomes void, at the same level}
end;
copy_code: begin scan_eight_bit_int; cur_box:=copy_node_list(box(cur_val));
@y
@!n:halfword; {a box number}
begin case cur_chr of
box_code: begin scan_register_num; fetch_box(cur_box);
change_box(null); {the box becomes void, at the same level}
end;
copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
@z
@x l.20901
since |head| is a one-word node.
@y
since |head| is a one-word node.
A final \.{\\endM} node is temporarily removed.
@z
@x l.20914
if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
@<Remove the last box, unless it's part of a discretionary@>;
@y
begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
remove_end_M;
if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
@<Remove the last box, unless it's part of a discretionary@>;
if LR_temp<>null then insert_end_M;
end;
@z
@x l.20935
begin scan_eight_bit_int; n:=cur_val;
@y
begin scan_register_num; n:=cur_val;
@z
@x l.21119
else line_break(widow_penalty);
@y
else line_break(false);
if LR_save<>null then
begin flush_list(LR_save); LR_save:=null;
end;
@z
@x l.21175
begin p:=scan_toks(false,true); p:=get_node(small_node_size);
@y
@!c:halfword; {the mark class}
begin if cur_chr=0 then c:=0
else begin scan_register_num; c:=cur_val;
end;
p:=scan_toks(false,true); p:=get_node(small_node_size);
mark_class(p):=c;
@z
@x l.21203
will be deleted, if present.
@y
will be deleted, if present.
A final \.{\\endM} node is temporarily removed.
@z
@x l.21213
else begin if not is_char_node(tail) then if type(tail)=cur_chr then
@y
else begin if not is_char_node(tail) then
begin if (type(tail)=math_node)and(subtype(tail)=end_M_code) then
remove_end_M;
if type(tail)=cur_chr then
@z
@x l.21224
end;
@y
if LR_temp<>null then insert_end_M;
end;
end;
@z
@x l.21262
un_vbox: if chr_code=copy_code then print_esc("unvcopy")
@y
un_vbox: if chr_code=copy_code then print_esc("unvcopy")
@<Cases of |un_vbox| for |print_cmd_chr|@>@/
@z
@x l.21272
label exit;
@y
label done, exit;
@z
@x l.21275
begin c:=cur_chr; scan_eight_bit_int; p:=box(cur_val);
@y
begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
c:=cur_chr; scan_register_num; fetch_box(p);
@z
@x l.21287
else begin link(tail):=list_ptr(p); box(cur_val):=null;
@y
else begin link(tail):=list_ptr(p); change_box(null);
@z
@x l.21290
while link(tail)<>null do tail:=link(tail);
@y
done:
while link(tail)<>null do tail:=link(tail);
@z
@x l.21562
vmode+halign,hmode+valign:init_align;
@y
vmode+halign:init_align;
hmode+valign:@<Cases of |main_control| for |hmode+valign|@>@; init_align;
@z
@x l.21629
procedure init_math;
label reswitch,found,not_found,done;
var w:scaled; {new or partial |pre_display_size|}
@y
@t\4@>@<Declare subprocedures for |init_math|@>@;
procedure init_math;
label reswitch,found,not_found,done;
var w:scaled; {new or partial |pre_display_size|}
@!j:pointer; {prototype box for display}
@!x:integer; {new |pre_display_direction|}
@z
@x l.21687
begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
begin pop_nest; w:=-max_dimen;
end
else begin line_break(display_widow_penalty);@/
@y
begin j:=null; w:=-max_dimen;
if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
@<Prepare for display after an empty paragraph@>
else begin line_break(true);@/
@z
@x l.21700
eq_word_define(dimen_base+pre_display_size_code,w);
@y
eq_word_define(dimen_base+pre_display_size_code,w);
LR_box:=j;
if eTeX_ex then eq_word_define(int_base+pre_display_direction_code,x);
@z
@x l.21708
v:=shift_amount(just_box)+2*quad(cur_font); w:=-max_dimen;
p:=list_ptr(just_box);
@y
@<Prepare for display after a non-empty paragraph@>;
@z
@x l.21723
done:
@y
done:
@<Finish the natural width computation@>
@z
@x l.21734
kern_node,math_node: d:=width(p);
@y
kern_node: d:=width(p);
@t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@;
@z
@x l.22243
if type(q)<>left_noad then confusion("right");
@:this can't happen right}{\quad right@>
info(numerator(incompleat_noad)):=link(q);
link(q):=incompleat_noad; link(incompleat_noad):=p;
@y
if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right");
@:this can't happen right}{\quad right@>
info(numerator(incompleat_noad)):=link(delim_ptr);
link(delim_ptr):=incompleat_noad; link(incompleat_noad):=p;
@z
@x l.22288
else print_esc("right");
@y
@/@<Cases of |left_right| for |print_cmd_chr|@>@/
else print_esc("right");
@z
@x l.22297
begin t:=cur_chr;
if (t=right_noad)and(cur_group<>math_left_group) then
@y
@!q:pointer; {resulting mlist}
begin t:=cur_chr;
if (t<>left_noad)and(cur_group<>math_left_group) then
@z
@x l.22302
if t=left_noad then
begin push_math(math_left_group); link(head):=p; tail:=p;
end
else begin p:=fin_mlist(p); unsave; {end of |math_left_group|}
@y
if t=middle_noad then
begin type(p):=right_noad; subtype(p):=middle_noad;
end;
if t=left_noad then q:=p
else begin q:=fin_mlist(p); unsave; {end of |math_left_group|}
end;
if t<>right_noad then
begin push_math(math_left_group); link(head):=q; tail:=p;
delim_ptr:=p;
end
else begin
@z
@x l.22308
info(nucleus(tail)):=p;
@y
info(nucleus(tail)):=q;
@z
@x l.22316
print_err("Extra "); print_esc("right");
@.Extra \\right.@>
help1("I'm ignoring a \right that had no matching \left.");
@y
print_err("Extra ");
if t=middle_noad then
begin print_esc("middle");
@.Extra \\middle.@>
help1("I'm ignoring a \middle that had no matching \left.");
end
else begin print_esc("right");
@.Extra \\right.@>
help1("I'm ignoring a \right that had no matching \left.");
end;
@z
@x l.22331
procedure after_math;
@y
@t\4@>@<Declare subprocedures for |after_math|@>@;
procedure after_math;
@z
@x l.22338
begin danger:=false;
@y
begin danger:=false;
@<Retrieve the prototype box@>;
@z
@x l.22345
mlist_to_hlist; a:=hpack(link(temp_head),natural);
@y
mlist_to_hlist; a:=hpack(link(temp_head),natural);
subtype(a):=dlist;
@z
@x l.22348
danger:=false;
@y
danger:=false;
@<Retrieve the prototype box@>;
@z
@x l.22435
w:=width(b); z:=display_width; s:=display_indent;
@y
w:=width(b); z:=display_width; s:=display_indent;
if pre_display_direction<0 then s:=-s-z;
@z
@x l.22450
resume_after_display
@y
@<Flush the prototype box@>;
resume_after_display
@z
@x l.22492
d:=half(z-w);
@y
subtype(b):=dlist;
d:=half(z-w);
@z
@x l.22513
begin shift_amount(a):=s; append_to_vlist(a);
@y
begin app_display(j,a,0);
@z
@x l.22528
shift_amount(b):=s+d; append_to_vlist(b)
@y
app_display(j,b,d)
@z
@x l.22533
shift_amount(a):=s+z-width(a);
append_to_vlist(a);
@y
app_display(j,a,z-width(a));
@z
@x l.22552
pop_nest;
@y
flush_node_list(LR_box);
pop_nest;
@z
@x l.22577
control sequence can be defined to be `\.{\\long}' or `\.{\\outer}', and
it might or might not be expanded. The prefixes `\.{\\global}', `\.{\\long}',
@y
control sequence can be defined to be `\.{\\long}', `\.{\\protected}',
or `\.{\\outer}', and it might or might not be expanded. The prefixes
`\.{\\global}', `\.{\\long}', `\.{\\protected}',
@z
@x l.22603
else print_esc("global");
@y
@/@<Cases of |prefix| for |print_cmd_chr|@>@/
else print_esc("global");
@z
@x l.22665
@<Discard erroneous prefixes and |return|@>;
@y
@<Discard erroneous prefixes and |return|@>;
if tracing_commands>2 then if eTeX_ex then show_cur_cmd_chr;
@z
@x l.22686
if (cur_cmd<>def)and(a mod 4<>0) then
@y
if a>=8 then
begin j:=protected_token; a:=a-8;
end
else j:=0;
if (cur_cmd<>def)and((a mod 4<>0)or(j<>0)) then
@z
@x l.22749
q:=scan_toks(true,e); define(p,call+(a mod 4),def_ref);
@y
q:=scan_toks(true,e);
if j<>0 then
begin q:=get_avail; info(q):=j; link(q):=link(def_ref);
link(def_ref):=q;
end;
define(p,call+(a mod 4),def_ref);
@z
@x l.22840
othercases begin scan_eight_bit_int;
@y
othercases begin scan_register_num;
if cur_val>255 then
begin j:=n-count_def_code; {|int_val..box_val|}
if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
if j=tok_val then j:=toks_register@+else j:=register;
define(p,j,cur_ptr);
end
else
@z
@x l.22853
read_to_cs: begin scan_int; n:=cur_val;
@y
read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val;
@z
@x l.22861
p:=cur_cs; read_toks(n,p); define(p,call,cur_val);
@y
p:=cur_cs; read_toks(n,p,j); define(p,call,cur_val);
@z
@x l.22870
if cur_cmd=toks_register then
begin scan_eight_bit_int; p:=toks_base+cur_val;
end
else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
@y
e:=false; {just in case, will be set |true| for sparse array elements}
if cur_cmd=toks_register then
if cur_chr=mem_bot then
begin scan_register_num;
if cur_val>255 then
begin find_sa_element(tok_val,cur_val,true);
cur_chr:=cur_ptr; e:=true;
end
else cur_chr:=toks_base+cur_val;
end
else e:=true;
p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
@z
@x l.22880
begin define(p,undefined_cs,null); free_avail(def_ref);
end
else begin if p=output_routine_loc then {enclose in curlies}
@y
begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
end
else begin if (p=output_routine_loc)and not e then {enclose in curlies}
@z
@x l.22888
define(p,call,def_ref);
@y
sa_define(p,def_ref)(p,call,def_ref);
@z
@x l.22893
begin if cur_cmd=toks_register then
begin scan_eight_bit_int; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
end;
if cur_cmd=assign_toks then
begin q:=equiv(cur_chr);
if q=null then define(p,undefined_cs,null)
else begin add_token_ref(q); define(p,call,q);
end;
goto done;
end;
end
@y
if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
begin if cur_cmd=toks_register then
if cur_chr=mem_bot then
begin scan_register_num;
if cur_val<256 then q:=equiv(toks_base+cur_val)
else begin find_sa_element(tok_val,cur_val,false);
if cur_ptr=null then q:=null
else q:=sa_ptr(cur_ptr);
end;
end
else q:=sa_ptr(cur_ptr)
else q:=equiv(cur_chr);
if q=null then sa_define(p,null)(p,undefined_cs,null)
else begin add_token_ref(q); sa_define(p,q)(p,call,q);
end;
goto done;
end
@z
@x l.23009
begin q:=cur_cmd;
@y
@!e:boolean; {does |l| refer to a sparse array element?}
@!w:integer; {integer or dimen value of |l|}
begin q:=cur_cmd;
e:=false; {just in case, will be set |true| for sparse array elements}
@z
@x l.23024
if p<glue_val then word_define(l,cur_val)
else begin trap_zero_glue; define(l,glue_ref,cur_val);
@y
if p<glue_val then sa_word_define(l,cur_val)
else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
@z
@x l.23046
p:=cur_chr; scan_eight_bit_int;
@y
if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
begin l:=cur_chr; p:=sa_type(l); e:=true;
end
else begin p:=cur_chr-mem_bot; scan_register_num;
if cur_val>255 then
begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
end
else
@z
@x l.23053
end;
found:
@y
end;
end;
found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=eqtb[l].int
else if e then s:=sa_ptr(l)@+else s:=equiv(l)
@z
@x l.23059
if q=advance then cur_val:=cur_val+eqtb[l].int;
@y
if q=advance then cur_val:=cur_val+w;
@z
@x l.23066
begin q:=new_spec(cur_val); r:=equiv(l);
@y
begin q:=new_spec(cur_val); r:=s;
@z
@x l.23086
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)
else begin s:=equiv(l); r:=new_spec(s);
@y
if p=int_val then cur_val:=mult_integers(w,cur_val)
else cur_val:=nx_plus_y(w,cur_val,0)
else cur_val:=x_over_n(w,cur_val)
else begin r:=new_spec(s);
@z
@x l.23108
set_box: begin scan_eight_bit_int;
if global then n:=256+cur_val@+else n:=cur_val;
scan_optional_equals;
if set_box_allowed then scan_box(box_flag+n)
@y
set_box: begin scan_register_num;
if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
scan_optional_equals;
if set_box_allowed then scan_box(n)
@z
@x l.23179
var c:0..1; {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}}
begin c:=cur_chr; scan_optional_equals; scan_int;
if c=0 then dead_cycles:=cur_val
@y
var c:small_number;
{0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.}
begin c:=cur_chr; scan_optional_equals; scan_int;
if c=0 then dead_cycles:=cur_val
@/@<Cases for |alter_integer|@>@/
@z
@x l.23188
@!b:eight_bits; {box number}
begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals;
scan_normal_dimen;
if box(b)<>null then mem[box(b)+c].sc:=cur_val;
@y
@!b:pointer; {box register}
begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
scan_normal_dimen;
if b<>null then mem[b+c].sc:=cur_val;
@z
@x l.23197
set_shape: begin scan_optional_equals; scan_int; n:=cur_val;
if n<=0 then p:=null
@y
set_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val;
if n<=0 then p:=null
else if q>par_shape_loc then
begin n:=(cur_val div 2)+1; p:=get_node(2*n+1); info(p):=n;
n:=cur_val; mem[p+1].int:=n; {number of penalties}
for j:=p+2 to p+n+1 do
begin scan_int; mem[j].int:=cur_val; {penalty values}
end;
if not odd(n) then mem[p+n+2].int:=0; {unused}
end
@z
@x l.23207
define(par_shape_loc,shape_ref,p);
@y
define(q,shape_ref,p);
@z
@x l.23231
begin @!init new_patterns; goto done;@;@+tini@/
@y
begin @!Init new_patterns; goto done;@;@+Tini@/
@z
@x l.23439
if c<>0 then
begin scan_optional_equals; scan_file_name;
if cur_ext="" then cur_ext:=".tex";
pack_cur_name;
if a_open_in(read_file[n]) then read_open[n]:=just_open;
end;
end;
@y
if c<>0 then
begin scan_optional_equals; scan_file_name;
if cur_ext="" then cur_ext:=".tex";
pack_cur_name;
if x_open_in(read_file[n]) then read_open[n]:=just_open;
end;
end;
@z
@x l.23581
show_lists:print_esc("showlists");
@y
show_lists:print_esc("showlists");
@<Cases of |xray| for |print_cmd_chr|@>@;@/
@z
@x l.23586
procedure show_whatever;
@y
procedure show_whatever;
@z
@x l.23588
var p:pointer; {tail of a token list to show}
@y
var p:pointer; {tail of a token list to show}
@!t:small_number; {type of conditional being shown}
@!m:normal..or_code; {upper bound on |fi_or_else| codes}
@!l:integer; {line where that conditional began}
@!n:integer; {level of \.{\\if...\\fi} nesting}
@z
@x l.23589
begin case cur_chr of
@y
begin
@<Clear out the |temp_file|@>;
case cur_chr of
@z
@x l.23594
othercases @<Show the current value of some parameter or register,
@y
@<Cases for |show_whatever|@>@;@/
othercases @<Show the current value of some parameter or register,
@z
@x l.23629
call: print("macro");
long_call: print_esc("long macro");
outer_call: print_esc("outer macro");
long_outer_call: begin print_esc("long"); print_esc("outer macro");
@y
call,long_call,outer_call,long_outer_call: begin n:=cmd-call;
if info(link(chr_code))=protected_token then n:=n+4;
if odd(n div 4) then print_esc("protected");
if odd(n) then print_esc("long");
if odd(n div 2) then print_esc("outer");
if n>0 then print_char(" ");
print("macro");
@z
@x l.23637
begin scan_eight_bit_int; begin_diagnostic;
print_nl("> \box"); print_int(cur_val); print_char("=");
if box(cur_val)=null then print("void")
else show_box(box(cur_val));
@y
begin scan_register_num; fetch_box(p); begin_diagnostic;
print_nl("> \box"); print_int(cur_val); print_char("=");
if p=null then print("void")@+else show_box(p);
@z
@x l.23751
@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
@y
@d fmt_put==begin incr(fmt_count);
if fmt_count=VAX_block_length then begin
put(fmt_file,VAX_ignore_error); fmt_count:=0; end
end
@d fmt_word==fmt_file^[fmt_count]
@d dump_wd(#)==begin fmt_word:=#; fmt_put;@+end
@d dump_int(#)==begin fmt_word.int:=#; fmt_put;@+end
@d dump_hh(#)==begin fmt_word.hh:=#; fmt_put;@+end
@d dump_qqqq(#)==begin fmt_word.qqqq:=#; fmt_put;@+end
@z
@x l.23763
@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
@y
@d fmt_get==begin incr(fmt_count);
if fmt_count=VAX_block_length then begin
get(fmt_file,VAX_ignore_error); fmt_count:=0; end
end
@d undump_wd(#)==begin fmt_get; #:=fmt_word;@+end
@d undump_int(#)==begin fmt_get; #:=fmt_word.int;@+end
@d undump_hh(#)==begin fmt_get; #:=fmt_word.hh;@+end
@d undump_qqqq(#)==begin fmt_get; #:=fmt_word.qqqq;@+end
@z
@x l.23779
dump_int(@$);@/
@y
dump_int(@$);@/
@<Dump the \eTeX\ state@>@/
@z
@x l.23793
x:=fmt_file^.int;
@y
x:=fmt_word.int;
@z
@x l.23794
if x<>@$ then goto bad_fmt; {check that strings are the same}
@y
if x<>@$ then goto bad_fmt; {check that strings are the same}
@/@<Undump the \eTeX\ state@>@/
@z
@x l.23848
dump_int(lo_mem_max); dump_int(rover);
@y
dump_int(lo_mem_max); dump_int(rover);
if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
@z
@x l.23871
undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
@y
undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
if eTeX_ex then for k:=int_val to tok_val do
undump(null)(lo_mem_max)(sa_root[k]);
@z
@x l.24065
dump_int(trie_max);
@y
dump_int(trie_max);
dump_int(hyph_start);
@z
@x l.24093
undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
@y
undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
undump(0)(j)(hyph_start);
@z
@x l.24140
w_close(fmt_file)
@y
while fmt_count>0 do dump_int(0); {flush out the buffer}
w_close(fmt_file)
@z
@x l.24195
@!ready_already:integer; {a sacrifice of purity for economy}
@y
@!init
@!init_flag: boolean;
tini@/
@z
@x l.24197
@ Now this is really it: \TeX\ starts and ends here.
The initial test involving |ready_already| should be deleted if the
\PASCAL\ runtime system is smart enough to detect such a ``mistake.''
@^system dependencies@>
@y
@ Now this is really it: \TeX\ starts and ends here.
The initial test involving |ready_already| should be deleted if the \PASCAL\
runtime system is smart enough to detect such a ``mistake'' and in fact it has
been deleted. We also take this opportunity to find out if we're supposed to be
\TeX\ or \.{INITEX}. (As an interesting note, Knuth simply uses \.{INITEX} for
everything now. The performance difference is too minimal on his machine to
make it worth maintaining two copies of \TeX.)
Since all files are opened with a |disposition:=delete| clause, they will be
deleted automatically if the program does not complete properly. However, if a
fatal error occurs, the |jumpout| procedure also causes termination of the
program without closing the files, therefore we ensure that at least the
|log_file| gets closed so that the fatal error can be examined!
@z
@x l.24206
if ready_already=314159 then goto start_of_TEX;
@y
if not odd(init_cli(eTeX_CLD_table,'ETEX','TEXFORMATS')) then
begin
wterm_ln('Ouch---access to DCL command line interface has failed!');
goto final_end;
end;
@!init init_flag:=odd(VAX_cli_present('INIT'));@+tini
@z
@x l.24215
@!init if not get_strings_started then goto final_end;
init_prim; {call |primitive| for each primitive}
init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
tini@/
@y
eight_qual:=odd(VAX_cli_present('EIGHT_BIT'));
@./EIGHT_BIT@>
@!Init if not get_strings_started then goto final_end;
init_prim; {call |primitive| for each primitive}
init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
Tini@/
@z
@x l.24219
ready_already:=314159;
start_of_TEX: @<Initialize the output routines@>;
@y
start_of_TEX: @<Extract command-line and qualifiers@>;
@<Initialize the output routines@>;
@z
@x l.24225
end_of_TEX: close_files_and_terminate;
final_end: ready_already:=0;
end.
@y
end_of_TEX: close_files_and_terminate;
final_end:
if log_opened then
begin wlog_cr;
a_close(log_file); selector:=selector-2;
if selector=term_only then
begin
if log_qual then
begin print_nl("Transcript written on ");
@.Transcript written...@>
slow_print(log_name); print_char(".");
end else
print_nl("NO transcript file.");
end;
end;
@<Exit to operating system with final status@>;
end.
@z
@x l.24249
if log_opened then
begin wlog_cr; a_close(log_file); selector:=selector-2;
if selector=term_only then
begin print_nl("Transcript written on ");
@.Transcript written...@>
slow_print(log_name); print_char(".");
end;
end;
@y
if diag_qual then
begin wdiag_cr; wdiag_ln('end module');
a_close(diag_file);
print_nl("Diagnostics written on ");
@.Diagnostics written...@>
slow_print(diag_name); print_char(".");
end;
@z
@x l.24313
print_int(cur_level-level_one); print_char(")");
@y
print_int(cur_level-level_one); print_char(")");
if eTeX_ex then show_save_groups;
@z
@x l.24335
begin @!init for c:=top_mark_code to split_bot_mark_code do
@y
begin @!Init for c:=top_mark_code to split_bot_mark_code do
@z
@x l.24336
if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
@y
if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
if sa_mark<>null then
if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
@z
@x l.24337
store_fmt_file; return;@+tini@/
@y
store_fmt_file; return;@+Tini@/
@z
@x l.24345
begin no_new_control_sequence:=false;
@y
begin no_new_control_sequence:=false;
first:=0;
@z
@x l.24360
if (format_ident=0)or(buffer[loc]="&") then
@y
@<Enable \eTeX, if requested@>@;@/
if (format_ident=0)or(buffer[loc]="&") then
@z
@x l.24368
end;
@y
end;
if eTeX_ex then wterm_ln('entering extended mode');
@z
@x l.24373
@<Initialize the print |selector|...@>;
@y
@<Initialize the print |selector|...@>;
@<Read the values of \.{/TEXINPUTS} and \.{/TEXFONTS} and put them
into the string pool@>;
@z
@x l.24573
@t\4@>@<Declare procedures needed in |do_extension|@>@;
procedure do_extension;
var i,@!j,@!k:integer; {all-purpose integers}
@!p,@!q,@!r:pointer; {all-purpose pointers}
@y
@t\4@>@<Declare procedures needed in |do_extension|@>@;
procedure do_extension;
var k:integer; {all-purpose integers}
@!p:pointer; {all-purpose pointers}
@z
@x l.24715
adv_past(s)
@y
if subtype(s)=language_node then
begin cur_lang:=what_lang(s); l_hyf:=what_lhm(s); r_hyf:=what_rhm(s);
set_hyph_index;
end
@z
@x l.24903
@* \[54] System-dependent changes.
@y
@* \[53a] The extended features of \eTeX.
The program has two modes of operation: (1)~In \TeX\ compatibility mode
it fully deserves the name \TeX\ and there are neither extended features
nor additional primitive commands. There are, however, a few
modifications that would be legitimate in any implementation of \TeX\
such as, e.g., preventing inadequate results of the glue to \.{DVI}
unit conversion during |ship_out|. (2)~In extended mode there are
additional primitive commands and the extended features of \eTeX\ are
available.
The distinction between these two modes of operation initially takes
place when a `virgin' \.{eINITEX} starts without reading a format file.
Later on the values of all \eTeX\ state variables are inherited when
\.{eVIRTEX} (or \.{eINITEX}) reads a format file.
The code below is designed to work for cases where `$|init|\ldots|tini|$'
is a run-time switch.
@<Enable \eTeX, if requested@>=
@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
begin no_new_control_sequence:=false;
@<Generate all \eTeX\ primitives@>@;
incr(loc); eTeX_mode:=1; {enter extended mode}
@<Initialize variables for \eTeX\ extended mode@>@;
end;
tini@;@/
if not no_new_control_sequence then {just entered extended mode ?}
no_new_control_sequence:=true@+else
@ The \eTeX\ features available in extended mode are grouped into two
categories: (1)~Some of them are permanently enabled and have no
semantic effect as long as none of the additional primitives are
executed. (2)~The remaining \eTeX\ features are optional and can be
individually enabled and disabled. For each optional feature there is
an \eTeX\ state variable named \.{\\...state}; the feature is enabled,
resp.\ disabled by assigning a positive, resp.\ non-positive value to
that integer.
@d eTeX_state_base=int_base+eTeX_state_code
@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable}
@#
@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
@d eTeX_revision_code=6 {command code for \.{\\eTeXrevision}}
@<Generate all \eTeX...@>=
primitive("lastnodetype",last_item,last_node_type_code);
@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
primitive("eTeXversion",last_item,eTeX_version_code);
@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
primitive("eTeXrevision",convert,eTeX_revision_code);@/
@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
@ @<Cases of |last_item| for |print_cmd_chr|@>=
last_node_type_code: print_esc("lastnodetype");
eTeX_version_code: print_esc("eTeXversion");
@ @<Cases for fetching an integer value@>=
eTeX_version_code: cur_val:=eTeX_version;
@ @<Cases of |convert| for |print_cmd_chr|@>=
eTeX_revision_code: print_esc("eTeXrevision");
@ @<Cases of `Scan the argument for command |c|'@>=
eTeX_revision_code: do_nothing;
@ @<Cases of `Print the result of command |c|'@>=
eTeX_revision_code: print(eTeX_revision);
@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?}
@<Glob...@>=
@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
@ @<Initialize table entries...@>=
eTeX_mode:=0; {initially we are in compatibility mode}
@<Initialize variables for \eTeX\ compatibility mode@>@;
@ @<Dump the \eTeX\ state@>=
dump_int(eTeX_mode);
for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
@ @<Undump the \eTeX\ state@>=
undump(0)(1)(eTeX_mode);
if eTeX_ex then
begin @<Initialize variables for \eTeX\ extended mode@>@;
end
else begin @<Initialize variables for \eTeX\ compatibility mode@>@;
end;
@ The |eTeX_enabled| function simply returns its first argument as
result. This argument is |true| if an optional \eTeX\ feature is
currently enabled; otherwise, if the argument is |false|, the function
gives an error message.
@<Declare \eTeX\ procedures for use...@>=
function eTeX_enabled(@!b:boolean;@!j:quarterword;@!k:halfword):boolean;
begin if not b then
begin print_err("Improper "); print_cmd_chr(j,k);
help1("Sorry, this optional e-TeX feature has been disabled."); error;
end;
eTeX_enabled:=b;
end;
@ First we implement the additional \eTeX\ parameters in the table of
equivalents.
@<Generate all \eTeX...@>=
primitive("everyeof",assign_toks,every_eof_loc);
@!@:every_eof_}{\.{\\everyeof} primitive@>
primitive("tracingassigns",assign_int,int_base+tracing_assigns_code);@/
@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@>
primitive("tracinggroups",assign_int,int_base+tracing_groups_code);@/
@!@:tracing_groups_}{\.{\\tracinggroups} primitive@>
primitive("tracingifs",assign_int,int_base+tracing_ifs_code);@/
@!@:tracing_ifs_}{\.{\\tracingifs} primitive@>
primitive("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code);@/
@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@>
primitive("tracingnesting",assign_int,int_base+tracing_nesting_code);@/
@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@>
primitive("predisplaydirection",
assign_int,int_base+pre_display_direction_code);@/
@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@>
primitive("lastlinefit",assign_int,int_base+last_line_fit_code);@/
@!@:last_line_fit_}{\.{\\lastlinefit} primitive@>
primitive("savingvdiscards",assign_int,int_base+saving_vdiscards_code);@/
@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@>
primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/
@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@>
@ @d every_eof==equiv(every_eof_loc)
@<Cases of |assign_toks| for |print_cmd_chr|@>=
every_eof_loc: print_esc("everyeof");
@ @<Cases for |print_param|@>=
tracing_assigns_code:print_esc("tracingassigns");
tracing_groups_code:print_esc("tracinggroups");
tracing_ifs_code:print_esc("tracingifs");
tracing_scan_tokens_code:print_esc("tracingscantokens");
tracing_nesting_code:print_esc("tracingnesting");
pre_display_direction_code:print_esc("predisplaydirection");
last_line_fit_code:print_esc("lastlinefit");
saving_vdiscards_code:print_esc("savingvdiscards");
saving_hyph_codes_code:print_esc("savinghyphcodes");
@ In order to handle \.{\\everyeof} we need an array |eof_seen| of
boolean variables.
@<Glob...@>=
@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
@ The |print_group| procedure prints the current level of grouping and
the name corresponding to |cur_group|.
@<Declare \eTeX\ procedures for tr...@>=
procedure print_group(@!e:boolean);
label exit;
begin case cur_group of
bottom_level: begin print("bottom level"); return;
end;
simple_group,semi_simple_group:
begin if cur_group=semi_simple_group then print("semi ");
print("simple");
end;
hbox_group,adjusted_hbox_group:
begin if cur_group=adjusted_hbox_group then print("adjusted ");
print("hbox");
end;
vbox_group: print("vbox");
vtop_group: print("vtop");
align_group,no_align_group:
begin if cur_group=no_align_group then print("no ");
print("align");
end;
output_group: print("output");
disc_group: print("disc");
insert_group: print("insert");
vcenter_group: print("vcenter");
math_group,math_choice_group,math_shift_group,math_left_group:
begin print("math");
if cur_group=math_choice_group then print(" choice")
else if cur_group=math_shift_group then print(" shift")
else if cur_group=math_left_group then print(" left");
end;
end; {there are no other cases}
print(" group (level "); print_int(qo(cur_level)); print_char(")");
if saved(-1)<>0 then
begin if e then print(" entered at line ") else print(" at line ");
print_int(saved(-1));
end;
exit:end;
@ The |group_trace| procedure is called when a new level of grouping
begins (|e=false|) or ends (|e=true|) with |saved(-1)| containing the
line number.
@<Declare \eTeX\ procedures for tr...@>=
@!stat procedure group_trace(@!e:boolean);
begin begin_diagnostic; print_char("{");
if e then print("leaving ") else print("entering ");
print_group(e); print_char("}"); end_diagnostic(false);
end;
tats
@ The \.{\\currentgrouplevel} and \.{\\currentgrouptype} commands return
the current level of grouping and the type of the current group
respectively.
@d current_group_level_code=eTeX_int+1 {code for \.{\\currentgrouplevel}}
@d current_group_type_code=eTeX_int+2 {code for \.{\\currentgrouptype}}
@<Generate all \eTeX...@>=
primitive("currentgrouplevel",last_item,current_group_level_code);
@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@>
primitive("currentgrouptype",last_item,current_group_type_code);
@!@:current_group_type_}{\.{\\currentgrouptype} primitive@>
@ @<Cases of |last_item| for |print_cmd_chr|@>=
current_group_level_code: print_esc("currentgrouplevel");
current_group_type_code: print_esc("currentgrouptype");
@ @<Cases for fetching an integer value@>=
current_group_level_code: cur_val:=cur_level-level_one;
current_group_type_code: cur_val:=cur_group;
@ The \.{\\currentiflevel}, \.{\\currentiftype}, and
\.{\\currentifbranch} commands return the current level of conditionals
and the type and branch of the current conditional.
@d current_if_level_code=eTeX_int+3 {code for \.{\\currentiflevel}}
@d current_if_type_code=eTeX_int+4 {code for \.{\\currentiftype}}
@d current_if_branch_code=eTeX_int+5 {code for \.{\\currentifbranch}}
@<Generate all \eTeX...@>=
primitive("currentiflevel",last_item,current_if_level_code);
@!@:current_if_level_}{\.{\\currentiflevel} primitive@>
primitive("currentiftype",last_item,current_if_type_code);
@!@:current_if_type_}{\.{\\currentiftype} primitive@>
primitive("currentifbranch",last_item,current_if_branch_code);
@!@:current_if_branch_}{\.{\\currentifbranch} primitive@>
@ @<Cases of |last_item| for |print_cmd_chr|@>=
current_if_level_code: print_esc("currentiflevel");
current_if_type_code: print_esc("currentiftype");
current_if_branch_code: print_esc("currentifbranch");
@ @<Cases for fetching an integer value@>=
current_if_level_code: begin q:=cond_ptr; cur_val:=0;
while q<>null do
begin incr(cur_val); q:=link(q);
end;
end;
current_if_type_code: if cond_ptr=null then cur_val:=0
else if cur_if<unless_code then cur_val:=cur_if+1
else cur_val:=-(cur_if-unless_code+1);
current_if_branch_code:
if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1
else if if_limit=fi_code then cur_val:=-1
else cur_val:=0;
@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and
\.{\\fontcharic} commands return information about a character in a
font.
@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}}
@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}}
@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}}
@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}}
@<Generate all \eTeX...@>=
primitive("fontcharwd",last_item,font_char_wd_code);
@!@:font_char_wd_}{\.{\\fontcharwd} primitive@>
primitive("fontcharht",last_item,font_char_ht_code);
@!@:font_char_ht_}{\.{\\fontcharht} primitive@>
primitive("fontchardp",last_item,font_char_dp_code);
@!@:font_char_dp_}{\.{\\fontchardp} primitive@>
primitive("fontcharic",last_item,font_char_ic_code);
@!@:font_char_ic_}{\.{\\fontcharic} primitive@>
@ @<Cases of |last_item| for |print_cmd_chr|@>=
font_char_wd_code: print_esc("fontcharwd");
font_char_ht_code: print_esc("fontcharht");
font_char_dp_code: print_esc("fontchardp");
font_char_ic_code: print_esc("fontcharic");
@ @<Cases for fetching a dimension value@>=
font_char_wd_code,
font_char_ht_code,
font_char_dp_code,
font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
begin i:=char_info(q)(qi(cur_val));
case m of
font_char_wd_code: cur_val:=char_width(q)(i);
font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
font_char_ic_code: cur_val:=char_italic(q)(i);
end; {there are no other cases}
end
else cur_val:=0;
end;
@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength}
commands return the indent and length parameters of the current
\.{\\parshape} specification.
@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}}
@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}}
@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}}
@<Generate all \eTeX...@>=
primitive("parshapelength",last_item,par_shape_length_code);
@!@:par_shape_length_}{\.{\\parshapelength} primitive@>
primitive("parshapeindent",last_item,par_shape_indent_code);
@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@>
primitive("parshapedimen",last_item,par_shape_dimen_code);
@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@>
@ @<Cases of |last_item| for |print_cmd_chr|@>=
par_shape_length_code: print_esc("parshapelength");
par_shape_indent_code: print_esc("parshapeindent");
par_shape_dimen_code: print_esc("parshapedimen");
@ @<Cases for fetching a dimension value@>=
par_shape_length_code,
par_shape_indent_code,
par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int;
if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0
else begin if q=2 then
begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2;
end;
if cur_val>info(par_shape_ptr) then cur_val:=info(par_shape_ptr);
cur_val:=mem[par_shape_ptr+2*cur_val-q].sc;
end;
cur_val_level:=dimen_val;
end;
@ The \.{\\showgroups} command displays all currently active grouping
levels.
@d show_groups=4 { \.{\\showgroups} }
@<Generate all \eTeX...@>=
primitive("showgroups",xray,show_groups);
@!@:show_groups_}{\.{\\showgroups} primitive@>
@ @<Cases of |xray| for |print_cmd_chr|@>=
show_groups:print_esc("showgroups");
@ @<Cases for |show_whatever|@>=
show_groups: begin begin_diagnostic; show_save_groups;
end;
@ @<Types...@>=
@!save_pointer=0..save_size; {index into |save_stack|}
@ The modifications of \TeX\ required for the display produced by the
|show_save_groups| procedure were first discussed by Donald~E. Knuth in
{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990.
@^Knuth, Donald Ervin@>
In order to understand a group type we also have to know its mode.
Since unrestricted horizontal modes are not associated with grouping,
they are skipped when traversing the semantic nest.
@<Declare \eTeX\ procedures for use...@>=
procedure show_save_groups;
label found1,found2,found,done;
var p:0..nest_size; {index into |nest|}
@!m:-mmode..mmode; {mode}
@!v:save_pointer; {saved value of |save_ptr|}
@!l:quarterword; {saved value of |cur_level|}
@!c:group_code; {saved value of |cur_group|}
@!a:-1..1; {to keep track of alignments}
@!i:integer;
@!j:quarterword;
@!s:str_number;
begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array}
v:=save_ptr; l:=cur_level; c:=cur_group;
save_ptr:=cur_boundary; decr(cur_level);@/
a:=1;
print_nl(""); print_ln;
loop@+begin print_nl("### "); print_group(true);
if cur_group=bottom_level then goto done;
repeat m:=nest[p].mode_field;
if p>0 then decr(p) else m:=vmode;
until m<>hmode;
print(" (");
case cur_group of
simple_group: begin incr(p); goto found2;
end;
hbox_group,adjusted_hbox_group: s:="hbox";
vbox_group: s:="vbox";
vtop_group: s:="vtop";
align_group: if a=0 then
begin if m=-vmode then s:="halign" else s:="valign";
a:=1; goto found1;
end
else begin if a=1 then print("align entry") else print_esc("cr");
if p>=a then p:=p-a;
a:=0; goto found;
end;
no_align_group:
begin incr(p); a:=-1; print_esc("noalign"); goto found2;
end;
output_group:
begin print_esc("output"); goto found;
end;
math_group: goto found2;
disc_group,math_choice_group:
begin if cur_group=disc_group then print_esc("discretionary")
else print_esc("mathchoice");
for i:=1 to 3 do if i<=saved(-2) then print("{}");
goto found2;
end;
insert_group:
begin if saved(-2)=255 then print_esc("vadjust")
else begin print_esc("insert"); print_int(saved(-2));
end;
goto found2;
end;
vcenter_group: begin s:="vcenter"; goto found1;
end;
semi_simple_group: begin incr(p); print_esc("begingroup"); goto found;
end;
math_shift_group:
begin if m=mmode then print_char("$")
else if nest[p].mode_field=mmode then
begin print_cmd_chr(eq_no,saved(-2)); goto found;
end;
print_char("$"); goto found;
end;
math_left_group:
begin if type(nest[p+1].eTeX_aux_field)=left_noad then print_esc("left")
else print_esc("middle");
goto found;
end;
end; {there are no other cases}
@<Show the box context@>;
found1: print_esc(s); @<Show the box packaging info@>;
found2: print_char("{");
found: print_char(")"); decr(cur_level);
cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
end;
done: save_ptr:=v; cur_level:=l; cur_group:=c;
end;
@ @<Show the box packaging info@>=
if saved(-2)<>0 then
begin print_char(" ");
if saved(-3)=exactly then print("to") else print("spread");
print_scaled(saved(-2)); print("pt");
end
@ @<Show the box context@>=
i:=saved(-4);
if i<>0 then
if i<box_flag then
begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
print_scaled(abs(i)); print("pt");
end
else if i<ship_out_flag then
begin if i>=global_box_flag then
begin print_esc("global"); i:=i-(global_box_flag-box_flag);
end;
print_esc("setbox"); print_int(i-box_flag); print_char("=");
end
else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
@ The |scan_general_text| procedure is much like |scan_toks(false,false)|,
but will be invoked via |expand|, i.e., recursively.
@^recursion@>
@<Declare \eTeX\ procedures for sc...@>=
procedure@?scan_general_text; forward;@t\2@>
@ The token list (balanced text) created by |scan_general_text| begins
at |link(temp_head)| and ends at |cur_val|. (If |cur_val=temp_head|,
the list is empty.)
@<Declare \eTeX\ procedures for tok...@>=
procedure scan_general_text;
label found;
var s:normal..absorbing; {to save |scanner_status|}
@!w:pointer; {to save |warning_index|}
@!d:pointer; {to save |def_ref|}
@!p:pointer; {tail of the token list being built}
@!q:pointer; {new node being added to the token list via |store_new_token|}
@!unbalance:halfword; {number of unmatched left braces}
begin s:=scanner_status; w:=warning_index; d:=def_ref;
scanner_status:=absorbing; warning_index:=cur_cs;
def_ref:=get_avail; token_ref_count(def_ref):=null; p:=def_ref;
scan_left_brace; {remove the compulsory left brace}
unbalance:=1;
loop@+ begin get_token;
if cur_tok<right_brace_limit then
if cur_cmd<right_brace then incr(unbalance)
else begin decr(unbalance);
if unbalance=0 then goto found;
end;
store_new_token(cur_tok);
end;
found: q:=link(def_ref); free_avail(def_ref); {discard reference count}
if q=null then cur_val:=temp_head @+ else cur_val:=p;
link(temp_head):=q;
scanner_status:=s; warning_index:=w; def_ref:=d;
end;
@ The \.{\\showtokens} command displays a token list.
@d show_tokens=5 { \.{\\showtokens} , must be odd! }
@<Generate all \eTeX...@>=
primitive("showtokens",xray,show_tokens);
@!@:show_tokens_}{\.{\\showtokens} primitive@>
@ @<Cases of |xray| for |print_cmd_chr|@>=
show_tokens:print_esc("showtokens");
@ The \.{\\unexpanded} primitive prevents expansion of tokens much as
the result from \.{\\the} applied to a token variable. The
\.{\\detokenize} primitive converts a token list into a list of
character tokens much as if the token list were written to a file. We
use the fact that the command modifiers for \.{\\unexpanded} and
\.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe}
are even.
@<Generate all \eTeX...@>=
primitive("unexpanded",the,1);@/
@!@:unexpanded_}{\.{\\unexpanded} primitive@>
primitive("detokenize",the,show_tokens);@/
@!@:detokenize_}{\.{\\detokenize} primitive@>
@ @<Cases of |the| for |print_cmd_chr|@>=
else if chr_code=1 then print_esc("unexpanded")
else print_esc("detokenize")
@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>=
if odd(cur_chr) then
begin c:=cur_chr; scan_general_text;
if c=1 then the_toks:=cur_val
else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
p:=get_avail; link(p):=link(temp_head);
token_show(p); flush_list(p);
selector:=old_setting; the_toks:=str_toks(b);
end;
return;
end
@ The \.{\\showifs} command displays all currently active conditionals.
@d show_ifs=6 { \.{\\showifs} }
@<Generate all \eTeX...@>=
primitive("showifs",xray,show_ifs);
@!@:show_ifs_}{\.{\\showifs} primitive@>
@ @<Cases of |xray| for |print_cmd_chr|@>=
show_ifs:print_esc("showifs");
@
@d print_if_line(#)==if #<>0 then
begin print(" entered on line "); print_int(#);
end
@<Cases for |show_whatever|@>=
show_ifs: begin begin_diagnostic; print_nl(""); print_ln;
if cond_ptr=null then
begin print_nl("### "); print("no active conditionals");
end
else begin p:=cond_ptr; n:=0;
repeat incr(n); p:=link(p);@+until p=null;
p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit;
repeat print_nl("### level "); print_int(n); print(": ");
print_cmd_chr(if_test,t);
if m=fi_code then print_esc("else");
print_if_line(l);
decr(n); t:=subtype(p); l:=if_line_field(p); m:=type(p); p:=link(p);
until p=null;
end;
end;
@ The \.{\\interactionmode} primitive allows to query and set the
interaction mode.
@<Generate all \eTeX...@>=
primitive("interactionmode",set_page_int,2);
@!@:interaction_mode_}{\.{\\interactionmode} primitive@>
@ @<Cases of |set_page_int| for |print_cmd_chr|@>=
else if chr_code=2 then print_esc("interactionmode")
@ @<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>=
else if m=2 then cur_val:=interaction
@ @<Declare \eTeX\ procedures for use...@>=
procedure@?new_interaction; forward;@t\2@>
@ @<Cases for |alter_integer|@>=
else if c=2 then
begin if (cur_val<batch_mode)or(cur_val>error_stop_mode) then
begin print_err("Bad interaction mode");
@.Bad interaction mode@>
help2("Modes are 0=batch, 1=nonstop, 2=scroll, and")@/
("3=errorstop. Proceed, and I'll ignore this case.");
int_error(cur_val);
end
else begin cur_chr:=cur_val; new_interaction;
end;
end
@ The |middle| feature of \eTeX\ allows one ore several \.{\\middle}
delimiters to appear between \.{\\left} and \.{\\right}.
@<Generate all \eTeX...@>=
primitive("middle",left_right,middle_noad);
@!@:middle_}{\.{\\middle} primitive@>
@ @<Cases of |left_right| for |print_cmd_chr|@>=
else if chr_code=middle_noad then print_esc("middle")
@ In constructions such as
$$\vbox{\halign{\.{#}\hfil\cr
{}\\vbox to \\vsize\{\cr
\hskip 25pt \\vskip 0pt plus 0.0001fil\cr
\hskip 25pt ...\cr
\hskip 25pt \\vfil\\penalty-200\\vfilneg\cr
\hskip 25pt ...\}\cr}}$$
the stretch components of \.{\\vfil} and \.{\\vfilneg} compensate;
in standard \TeX\ they may get modified in order to prevent arithmetic
overflow during |ship_out| when each of them is multiplied by a large
|glue_set| value.
In \eTeX\ the conversion from stretch or shrink components of glue to
\.{DVI} units is performed by the |do_glue| function defined below.
In extended mode the |do_glue| function adds up the relevant stretch (or
shrink) components of consecutive glue nodes and converts the glue nodes
into equivalent kern nodes; during this process glue specifications may
be recycled. The accumulated stretch or shrink is then multiplied by
|glue_set(this_box)| and returned as result. Since one and the same box
may be used several times inside leaders the result is also added to the
width of the first or only kern node; the subtype of the glue node(s)
remains unchanged. The consecutive glue nodes may be separated by
insert, mark, adjust, kern, and penalty nodes.
@d add_glue(#)==#:=#+do_glue(this_box,p)
@#
@d add_stretch_shrink== {accumulate stretch or shrink amount}
if g_sign=stretching then
begin if stretch_order(g)=g_order then s:=s+stretch(g);
end
else begin if shrink_order(g)=g_order then s:=s-shrink(g);
end
@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
function do_glue(@!this_box,@!p:pointer):scaled;
label continue, next_p, done;
var q:pointer; {list traverser}
@!g_order: glue_ord; {applicable order of infinity for glue}
@!g_sign: normal..shrinking; {selects type of glue}
@!s:scaled; {accumulated stretch or shrink}
@!glue_temp:real; {glue value before rounding}
begin g_order:=glue_order(this_box); g_sign:=glue_sign(this_box);
s:=0; add_stretch_shrink;
if not eTeX_ex or(subtype(p)>=a_leaders) then goto done;
q:=p;
continue: type(q):=kern_node; width(q):=width(g);
fast_delete_glue_ref(g);
next_p: q:=link(q);
if (q<>null) and not is_char_node(q) then case type(q) of
ins_node,mark_node,adjust_node,kern_node,penalty_node: goto next_p;
glue_node: if subtype(q)<a_leaders then
begin g:=glue_ptr(q); add_stretch_shrink; goto continue;
end;
othercases do_nothing
endcases;@/
done: if s<>0 then
begin vet_glue(float(glue_set(this_box))*s); s:=round(glue_temp);
@^real multiplication@>
if type(p)=kern_node then width(p):=width(p)+s;
end;
do_glue:=s;
end;
@ The optional |TeXXeT| feature of \eTeX\ contains the code for mixed
left-to-right and right-to-left typesetting. This code is inspired by
but different from \TeXeT\ as presented by Donald~E. Knuth and Pierre
MacKay in {\sl TUGboat\/} {\bf 8}, 14--25, 1987.
@^Knuth, Donald Ervin@>
@^MacKay, Pierre@>
In order to avoid confusion with \TeXeT\ the present implementation of
mixed direction typesetting is called \TeXXeT. It differs from \TeXeT\
in several important aspects: (1)~Right-to-left text is reversed
explicitely by the |ship_out| routine and is written to a normal \.{DVI}
file without any |begin_reflect| or |end_reflect| commands; (2)~a
|math_node| is (ab)used instead of a |whatsit_node| to record the
\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} text direction
primitives in order to keep the influence on the line breaking algorithm
for pure left-to-right text as small as possible; (3)~right-to-left text
interrupted by a displayed equation is automatically resumed after that
equation; and (4)~the |valign| command code with a non-zero command
modifier is (ab)used for the text direction primitives.
Nevertheless there is a subtle difference between \TeX\ and \TeXXeT\
that may influence the line breaking algorithm for pure left-to-right
text. When a paragraph containing math mode material is broken into
lines \TeX\ may generate lines where math mode material is not enclosed
by properly nested \.{\\mathon} and \.{\\mathoff} nodes. Unboxing such
lines as part of a new paragraph may have the effect that hyphenation is
attempted for `words' originating from math mode or that hyphenation is
inhibited for words originating from horizontal mode.
In \TeXXeT\ additional \.{\\beginM}, resp.\ \.{\\endM} math nodes are
supplied at the start, resp.\ end of lines such that math mode material
inside a horizontal list always starts with either \.{\\mathon} or
\.{\\beginM} and ends with \.{\\mathoff} or \.{\\endM}. These
additional nodes are transparent to operations such as \.{\\unskip},
\.{\\lastpenalty}, or \.{\\lastbox} but they do have the effect that
hyphenation is never attempted for `words' originating from math mode
and is never inhibited for words originating from horizontal mode.
@d TeXXeT_state==eTeX_state(TeXXeT_code)
@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?}
@<Cases for |print_param|@>=
eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate");
@ @<Generate all \eTeX...@>=
primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code);
@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@>
primitive("beginL",valign,begin_L_code);
@!@:beginL_}{\.{\\beginL} primitive@>
primitive("endL",valign,end_L_code);
@!@:endL_}{\.{\\endL} primitive@>
primitive("beginR",valign,begin_R_code);
@!@:beginR_}{\.{\\beginR} primitive@>
primitive("endR",valign,end_R_code);
@!@:endR_}{\.{\\endR} primitive@>
@ @<Cases of |valign| for |print_cmd_chr|@>=
else case chr_code of
begin_L_code: print_esc("beginL");
end_L_code: print_esc("endL");
begin_R_code: print_esc("beginR");
othercases print_esc("endR")
endcases
@ @<Cases of |main_control| for |hmode+valign|@>=
if cur_chr>0 then
begin if eTeX_enabled(TeXXeT_en,cur_cmd,cur_chr) then
@.Improper \\beginL@>
@.Improper \\endL@>
@.Improper \\beginR@>
@.Improper \\endR@>
tail_append(new_math(0,cur_chr));
end
else
@ An hbox with subtype dlist will never be reversed, even when embedded
in right-to-left text.
@<Display if this box is never to be reversed@>=
if (type(p)=hlist_node)and(subtype(p)=dlist) then print(", display")
@ A number of routines are based on a stack of one-word nodes whose
|info| fields contain |end_M_code|, |end_L_code|, or |end_R_code|. The
top of the stack is pointed to by |LR_ptr|.
When the stack manipulation macros of this section are used below,
variable |LR_ptr| might be the global variable declared here for |hpack|
and |ship_out|, or might be local to |post_line_break|.
@d put_LR(#)==begin temp_ptr:=get_avail; info(temp_ptr):=#;
link(temp_ptr):=LR_ptr; LR_ptr:=temp_ptr;
end
@#
@d push_LR(#)==put_LR(end_LR_type(#))
@#
@d pop_LR==begin temp_ptr:=LR_ptr; LR_ptr:=link(temp_ptr);
free_avail(temp_ptr);
end
@<Glob...@>=
@!LR_temp:pointer; {holds a temporarily removed \.{\\endM} node}
@!LR_ptr:pointer; {stack of LR codes for |hpack|, |ship_out|, and |init_math|}
@!LR_problems:integer; {counts missing begins and ends}
@!cur_dir:small_number; {current text direction}
@ @<Set init...@>=
LR_temp:=null; LR_ptr:=null; LR_problems:=0; cur_dir:=left_to_right;
@ @<Insert LR nodes at the beg...@>=
begin q:=link(temp_head);
if LR_ptr<>null then
begin temp_ptr:=LR_ptr; r:=q;
repeat s:=new_math(0,begin_LR_type(info(temp_ptr))); link(s):=r; r:=s;
temp_ptr:=link(temp_ptr);
until temp_ptr=null;
link(temp_head):=r;
end;
while q<>cur_break(cur_p) do
begin if not is_char_node(q) then
if type(q)=math_node then @<Adjust \(t)the LR stack for the |p...@>;
q:=link(q);
end;
end
@ @<Adjust \(t)the LR stack for the |p...@>=
if end_LR(q) then
begin if LR_ptr<>null then if info(LR_ptr)=end_LR_type(q) then pop_LR;
end
else push_LR(q)
@ We use the fact that |q| now points to the node with \.{\\rightskip} glue.
@<Insert LR nodes at the end...@>=
if LR_ptr<>null then
begin s:=temp_head; r:=link(s);
while r<>q do
begin s:=r; r:=link(s);
end;
r:=LR_ptr;
while r<>null do
begin temp_ptr:=new_math(0,info(r));
link(s):=temp_ptr; s:=temp_ptr; r:=link(r);
end;
link(s):=q;
end
@ Special \.{\\beginM} and \.{\\endM} nodes are inserted in cases where
math nodes are discarded during line breaking or end up in different
lines. When the current lists ends with an \.{\\endM} node that node is
temporarily removed and later reinserted when the last node is to be
inspected or removed. A final \.{\\endM} preceded by a |char_node| will
not be removed.
@<Declare \eTeX\ procedures for sc...@>=
procedure remove_end_M;
var @!p:pointer; {runs through the current list}
begin p:=head;
while link(p)<>tail do p:=link(p);
if not is_char_node(p) then
begin LR_temp:=tail; link(p):=null; tail:=p;
end;
end;
@ @<Declare \eTeX\ procedures for sc...@>=
procedure insert_end_M;
label done;
var @!p:pointer; {runs through the current list}
begin if not is_char_node(tail) then
if (type(tail)=math_node)and(subtype(tail)=begin_M_code) then
begin free_node(LR_temp,small_node_size); p:=head;
while link(p)<>tail do p:=link(p);
free_node(tail,small_node_size); link(p):=null; tail:=p; goto done;
end;
link(tail):=LR_temp; tail:=LR_temp;
done: LR_temp:=null;
end;
@ @<Initialize the LR stack@>=
put_LR(before) {this will never match}
@ @<Adjust \(t)the LR stack for the |hp...@>=
if end_LR(p) then
if info(LR_ptr)=end_LR_type(p) then pop_LR
else begin incr(LR_problems); type(p):=kern_node; subtype(p):=explicit;
end
else push_LR(p)
@ @<Check for LR anomalies at the end of |hp...@>=
begin if info(LR_ptr)<>before then
begin while link(q)<>null do q:=link(q);
repeat temp_ptr:=q; q:=new_math(0,info(LR_ptr)); link(temp_ptr):=q;
LR_problems:=LR_problems+10000; pop_LR;
until info(LR_ptr)=before;
end;
if LR_problems>0 then
begin @<Report LR problems@>; goto common_ending;
end;
pop_LR;
if LR_ptr<>null then confusion("LR1");
@:this can't happen LR1}{\quad LR1@>
end
@ @<Report LR problems@>=
begin print_ln; print_nl("\endL or \endR problem (");@/
print_int(LR_problems div 10000); print(" missing, ");@/
print_int(LR_problems mod 10000); print(" extra");@/
LR_problems:=0;
end
@ Breaking a paragraph into lines while \TeXXeT\ is disabled may result
in lines whith unpaired math nodes. Such hlists are silently accepted
in the absence of text direction directives.
@d LR_dir(#)==(subtype(#) div R_code) {text direction of a `math node'}
@<Adjust \(t)the LR stack for the |hl...@>=
begin if end_LR(p) then
if info(LR_ptr)=end_LR_type(p) then pop_LR
else begin if subtype(p)>L_code then incr(LR_problems);
end
else begin push_LR(p);
if LR_dir(p)<>cur_dir then
@<Reverse an hlist segment and |goto reswitch|@>;
end;
type(p):=kern_node;
end
@ @<Check for LR anomalies at the end of |hl...@>=
begin while info(LR_ptr)<>before do
begin if info(LR_ptr)>L_code then LR_problems:=LR_problems+10000;
pop_LR;
end;
pop_LR;
end
@ @d edge_node=style_node {a |style_node| does not occur in hlists}
@d edge_node_size=style_node_size {number of words in an edge node}
@d edge_dist(#)==depth(#) {new |left_edge| position relative to |cur_h|
(after |width| has been taken into account)}
@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
function new_edge(@!s:small_number;@!w:scaled):pointer;
{create an edge node}
var p:pointer; {the new node}
begin p:=get_node(edge_node_size); type(p):=edge_node; subtype(p):=s;
width(p):=w; edge_dist(p):=0; {the |edge_dist| field will be set later}
new_edge:=p;
end;
@ @<Cases of |hlist_out| that arise...@>=
edge_node: begin cur_h:=cur_h+width(p);
left_edge:=cur_h+edge_dist(p); cur_dir:=subtype(p);
end;
@ We detach the hlist, start a new one consisting of just one kern node,
append the reversed list, and set the width of the kern node.
@<Reverse the complete hlist...@>=
begin save_h:=cur_h; temp_ptr:=p; p:=new_kern(0); link(prev_p):=p;
cur_h:=0; link(p):=reverse(this_box,null); width(p):=-cur_h;
cur_h:=save_h; subtype(this_box):=reversed;
end
@ We detach the remainder of the hlist, replace the math node by
an edge node, and append the reversed hlist segment to it; the tail of
the reversed segment is another edge node and the remainder of the
original list is attached to it.
@<Reverse an hlist segment...@>=
begin save_h:=cur_h; temp_ptr:=link(p); rule_wd:=width(p);
free_node(p,small_node_size);
cur_dir:=reflected; p:=new_edge(cur_dir,rule_wd); link(prev_p):=p;
cur_h:=cur_h-left_edge+rule_wd;
link(p):=reverse(this_box,new_edge(reflected,0));
edge_dist(p):=cur_h; cur_dir:=reflected; cur_h:=save_h;
goto reswitch;
end
@ The |reverse| function defined here is responsible to reverse the
nodes of an hlist (segment). The first parameter |this_box| is the
enclosing hlist node, the second parameter |t| is to become the tail of
the reversed list, and the global variable |temp_ptr| is the head of the
list to be reversed. We remove nodes from the original list and add them
to the head of the new one.
@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
function reverse(@!this_box,@!t:pointer):pointer;
label reswitch,next_p,done;
var l:pointer; {the new list}
@!p:pointer; {the current node}
@!q:pointer; {the next node}
@!g_sign: normal..shrinking; {selects type of glue}
@!m,@!n:halfword; {count of unmatched math nodes}
begin g_sign:=glue_sign(this_box);
l:=t; p:=temp_ptr; m:=min_halfword; n:=min_halfword;
loop@+ begin while p<>null do
@<Move node |p| to the new list and go to the next node;
or |goto done| if the end of the reflected segment has been reached@>;
if (t=null)and(m=min_halfword)and(n=min_halfword) then goto done;
p:=new_math(0,info(LR_ptr)); LR_problems:=LR_problems+10000;
{manufacture one missing math node}
end;
done:reverse:=l;
end;
@ @<Move node |p| to the new list...@>=
reswitch: if is_char_node(p) then
repeat f:=font(p); c:=character(p);
cur_h:=cur_h+char_width(f)(char_info(f)(c));
q:=link(p); link(p):=l; l:=p; p:=q;
until not is_char_node(p)
else @<Move the non-|char_node| |p| to the new list@>
@ @<Move the non-|char_node| |p| to the new list@>=
begin q:=link(p);
case type(p) of
hlist_node,vlist_node,rule_node,kern_node: rule_wd:=width(p);
@t\4@>@<Cases of |reverse| that need special treatment@>@;
edge_node: confusion("LR2");
@:this can't happen LR2}{\quad LR2@>
othercases goto next_p
endcases;@/
cur_h:=cur_h+rule_wd;
next_p: link(p):=l;
if type(p)=kern_node then if (rule_wd=0)or(l=null) then
begin free_node(p,small_node_size); p:=l;
end;
l:=p; p:=q;
end
@ Here we have to remember that |add_glue| may have converted the glue
node into a kern node. If this is not the case we try to covert the
glue node into a rule node.
@<Cases of |reverse|...@>=
glue_node: begin g:=glue_ptr(p); rule_wd:=width(g);
if g_sign<>normal then add_glue(rule_wd);
if subtype(p)>=a_leaders then
begin temp_ptr:=leader_ptr(p);
if type(temp_ptr)=rule_node then
begin delete_glue_ref(g); free_node(p,small_node_size);
p:=temp_ptr; width(p):=rule_wd;
end;
end;
end;
@ A ligature node is replaced by a char node.
@<Cases of |reverse|...@>=
ligature_node: begin flush_node_list(lig_ptr(p));
temp_ptr:=p; p:=get_avail; mem[p]:=mem[lig_char(temp_ptr)]; link(p):=q;
free_node(temp_ptr,small_node_size); goto reswitch;
end;
@ Math nodes in an inner reflected segment are modified, those at the
outer level are changed into kern nodes.
@<Cases of |reverse|...@>=
math_node: begin rule_wd:=width(p);
if end_LR(p) then
if info(LR_ptr)<>end_LR_type(p) then
begin type(p):=kern_node; incr(LR_problems);
end
else begin pop_LR;
if n>min_halfword then
begin decr(n); decr(subtype(p)); {change |after| into |before|}
end
else begin type(p):=kern_node;
if m>min_halfword then decr(m)
else @<Finish the reversed hlist segment and |goto done|@>;
end;
end
else begin push_LR(p);
if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
begin incr(n); incr(subtype(p)); {change |before| into |after|}
end
else begin type(p):=kern_node; incr(m);
end;
end;
end;
@ Finally we have found the end of the hlist segment to be reversed; the
final math node is released and the remaining list attached to the
edge node terminating the reversed segment.
@<Finish the reversed...@>=
begin free_node(p,small_node_size);
link(t):=q; width(t):=rule_wd; edge_dist(t):=-cur_h-rule_wd; goto done;
end
@ @<Check for LR anomalies at the end of |s...@>=
begin if LR_problems>0 then
begin @<Report LR problems@>; print_char(")"); print_ln;
end;
if (LR_ptr<>null)or(cur_dir<>left_to_right) then confusion("LR3");
@:this can't happen LR3}{\quad LR3@>
end
@ Some special actions are required for displayed equation in paragraphs
with mixed direction texts. First of all we have to set the text
direction preceding the display.
@<Set the value of |x| to the text direction before the display@>=
if LR_save=null then x:=0
else if info(LR_save)>=R_code then x:=-1@+else x:=1
@ @<Prepare for display after an empty...@>=
begin pop_nest; @<Set the value of |x|...@>;
end
@ When calculating the natural width, |w|, of the final line preceding
the display, we may have to copy all or part of its hlist. We copy,
however, only those parts of the original list that are relevant for the
computation of |pre_display_size|.
@^data structure assumptions@>
@<Declare subprocedures for |init_math|@>=
procedure just_copy(@!p,@!h,@!t:pointer);
label found,not_found;
var @!r:pointer; {current node being fabricated for new list}
@!words:0..5; {number of words remaining to be copied}
begin while p<>null do
begin words:=1; {this setting occurs in more branches than any other}
if is_char_node(p) then r:=get_avail
else case type(p) of
hlist_node,vlist_node: begin r:=get_node(box_node_size);
mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
words:=5; list_ptr(r):=null; {this affects |mem[r+5]|}
end;
rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size;
end;
ligature_node: begin r:=get_avail; {only |font| and |character| are needed}
mem[r]:=mem[lig_char(p)]; goto found;
end;
kern_node,math_node: begin r:=get_node(small_node_size);
words:=small_node_size;
end;
glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p));
glue_ptr(r):=glue_ptr(p); leader_ptr(r):=null;
end;
whatsit_node:@<Make a partial copy of the whatsit...@>;
othercases goto not_found
endcases;
while words>0 do
begin decr(words); mem[r+words]:=mem[p+words];
end;
found: link(h):=r; h:=r;
not_found: p:=link(p);
end;
link(h):=t;
end;
@ When the final line ends with R-text, the value |w| refers to the line
reflected with respect to the left edge of the enclosing vertical list.
@<Prepare for display after a non-empty...@>=
if eTeX_ex then @<Let |j| be the prototype box for the display@>;
v:=shift_amount(just_box);
@<Set the value of |x|...@>;
if x>=0 then
begin p:=list_ptr(just_box); link(temp_head):=null;
end
else begin v:=-v-width(just_box);
p:=new_math(0,begin_L_code); link(temp_head):=p;
just_copy(list_ptr(just_box),p,new_math(0,end_L_code));
cur_dir:=right_to_left;
end;
v:=v+2*quad(cur_font);
if TeXXeT_en then @<Initialize the LR stack@>
@ @<Finish the natural width computation@>=
if TeXXeT_en then
begin while LR_ptr<>null do pop_LR;
if LR_problems<>0 then
begin w:=max_dimen; LR_problems:=0;
end;
end;
cur_dir:=left_to_right; flush_node_list(link(temp_head))
@ In the presence of text direction directives we assume that any LR
problems have been fixed by the |hpack| routine. If the final line
contains, however, text direction directives while \TeXXeT\ is disabled,
then we set |w:=max_dimen|.
@<Cases of `Let |d| be the natural...@>=
math_node: begin d:=width(p);
if TeXXeT_en then @<Adjust \(t)the LR stack for the |init_math| routine@>
else if subtype(p)>=L_code then
begin w:=max_dimen; goto done;
end;
end;
edge_node: begin d:=width(p); cur_dir:=subtype(p);
end;
@ @<Adjust \(t)the LR stack for the |i...@>=
if end_LR(p) then
begin if info(LR_ptr)=end_LR_type(p) then pop_LR
else if subtype(p)>L_code then
begin w:=max_dimen; goto done;
end
end
else begin push_LR(p);
if LR_dir(p)<>cur_dir then
begin just_reverse(p); p:=temp_head;
end;
end
@ @<Declare subprocedures for |init_math|@>=
procedure just_reverse(@!p:pointer);
label found,done;
var l:pointer; {the new list}
@!t:pointer; {tail of reversed segment}
@!q:pointer; {the next node}
@!m,@!n:halfword; {count of unmatched math nodes}
begin m:=min_halfword; n:=min_halfword;
if link(temp_head)=null then
begin just_copy(link(p),temp_head,null); q:=link(temp_head);
end
else begin q:=link(p); link(p):=null; flush_node_list(link(temp_head));
end;
t:=new_edge(cur_dir,0); l:=t; cur_dir:=reflected;
while q<>null do
if is_char_node(q) then
repeat p:=q; q:=link(p); link(p):=l; l:=p;
until not is_char_node(q)
else begin p:=q; q:=link(p);
if type(p)=math_node then
@<Adjust \(t)the LR stack for the |just_reverse| routine@>;
link(p):=l; l:=p;
end;
goto done;
found:width(t):=width(p); link(t):=q; free_node(p,small_node_size);
done:link(temp_head):=l;
end;
@ @<Adjust \(t)the LR stack for the |j...@>=
if end_LR(p) then
if info(LR_ptr)<>end_LR_type(p) then
begin type(p):=kern_node; incr(LR_problems);
end
else begin pop_LR;
if n>min_halfword then
begin decr(n); decr(subtype(p)); {change |after| into |before|}
end
else begin if m>min_halfword then decr(m)@+else goto found;
type(p):=kern_node;
end;
end
else begin push_LR(p);
if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
begin incr(n); incr(subtype(p)); {change |before| into |after|}
end
else begin type(p):=kern_node; incr(m);
end;
end
@ The prototype box is an hlist node with the width, glue set, and shift
amount of |just_box|, i.e., the last line preceding the display. Its
hlist reflects the current \.{\\leftskip} and \.{\\rightskip}.
@<Let |j| be the prototype box for the display@>=
begin if right_skip=zero_glue then j:=new_kern(0)
else j:=new_param_glue(right_skip_code);
if left_skip=zero_glue then p:=new_kern(0)
else p:=new_param_glue(left_skip_code);
link(p):=j; j:=new_null_box; width(j):=width(just_box);
shift_amount(j):=shift_amount(just_box); list_ptr(j):=p;
glue_order(j):=glue_order(just_box); glue_sign(j):=glue_sign(just_box);
glue_set(j):=glue_set(just_box);
end
@ At the end of a displayed equation we retrieve the prototype box.
@<Local variables for finishing...@>=
@!j:pointer; {prototype box}
@ @<Retrieve the prototype box@>=
if mode=mmode then j:=LR_box
@ @<Flush the prototype box@>=
flush_node_list(j)
@ The |app_display| procedure used to append the displayed equation
and\slash or equation number to the current vertical list has three
parameters: the prototype box, the hbox to be appended, and the
displacement of the hbox in the display line.
@<Declare subprocedures for |after_math|@>=
procedure app_display(@!j,@!b:pointer;@!d:scaled);
var z:scaled; {width of the line}
@!s:scaled; {move the line right this much}
@!e:scaled; {distance from right edge of box to end of line}
@!x:integer; {|pre_display_direction|}
@!p,@!q,@!r,@!t,@!u:pointer; {for list manipulation}
begin s:=display_indent; x:=pre_display_direction;
if x=0 then shift_amount(b):=s+d
else begin z:=display_width; p:=b;
@<Set up the hlist for the display line@>;
@<Package the display line@>;
end;
append_to_vlist(b);
end;
@ Here we construct the hlist for the display, starting with node |p|
and ending with node |q|. We also set |d| and |e| to the amount of
kerning to be added before and after the hlist (adjusted for the
prototype box).
@<Set up the hlist for the display line@>=
if x>0 then e:=z-d-width(p)
else begin e:=d; d:=z-e-width(p);
end;
if j<>null then
begin b:=copy_node_list(j); height(b):=height(p); depth(b):=depth(p);
s:=s-shift_amount(b); d:=d+s; e:=e+width(b)-z-s;
end;
if subtype(p)=dlist then q:=p {display or equation number}
else begin {display and equation number}
r:=list_ptr(p); free_node(p,box_node_size);
if r=null then confusion("LR4");
if x>0 then
begin p:=r;
repeat q:=r; r:=link(r); {find tail of list}
until r=null;
end
else begin p:=null; q:=r;
repeat t:=link(r); link(r):=p; p:=r; r:=t; {reverse list}
until r=null;
end;
end
@ In the presence of a prototype box we use its shift amount and width
to adjust the values of kerning and add these values to the glue nodes
inserted to cancel the \.{\\leftskip} and \.{\\rightskip}. If there is
no prototype box (because the display is preceded by an empty
paragraph), or if the skip parameters are zero, we just add kerns.
The |cancel_glue| macro creates and links a glue node that is, together
with another glue node, equivalent to a given amount of kerning. We can
use |j| as temporary pointer, since all we need is |j<>null|.
@d cancel_glue(#)==j:=new_skip_param(#); cancel_glue_cont
@d cancel_glue_cont(#)==link(#):=j; cancel_glue_cont_cont
@d cancel_glue_cont_cont(#)==link(j):=#; cancel_glue_end
@d cancel_glue_end(#)==j:=glue_ptr(#); cancel_glue_end_end
@d cancel_glue_end_end(#)==
stretch_order(temp_ptr):=stretch_order(j);
shrink_order(temp_ptr):=shrink_order(j); width(temp_ptr):=#-width(j);
stretch(temp_ptr):=-stretch(j); shrink(temp_ptr):=-shrink(j)
@<Package the display line@>=
if j=null then
begin r:=new_kern(0); t:=new_kern(0); {the widths will be set later}
end
else begin r:=list_ptr(b); t:=link(r);
end;
u:=new_math(0,end_M_code);
if type(t)=glue_node then {|t| is \.{\\rightskip} glue}
begin cancel_glue(right_skip_code)(q)(u)(t)(e); link(u):=t;
end
else begin width(t):=e; link(t):=u; link(q):=t;
end;
u:=new_math(0,begin_M_code);
if type(r)=glue_node then {|r| is \.{\\leftskip} glue}
begin cancel_glue(left_skip_code)(u)(p)(r)(d); link(r):=u;
end
else begin width(r):=d; link(r):=p; link(u):=r;
if j=null then
begin b:=hpack(u,natural); shift_amount(b):=s;
end
else list_ptr(b):=u;
end
@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens}
primitive.
@<Generate all \eTeX...@>=
primitive("scantokens",input,2);
@!@:scan_tokens_}{\.{\\scantokens} primitive@>
@ @<Cases of |input| for |print_cmd_chr|@>=
else if chr_code=2 then print_esc("scantokens")
@ @<Cases for |input|@>=
else if cur_chr=2 then pseudo_start
@ The global variable |pseudo_files| is used to maintain a stack of
pseudo files. The |info| field of each pseudo file points to a linked
list of variable size nodes representing lines not yet processed: the
|info| field of the first word contains the size of this node, all the
following words contain ASCII codes.
@<Glob...@>=
@!pseudo_files:pointer; {stack of pseudo files}
@ @<Set init...@>=
pseudo_files:=null;
@ The |pseudo_start| procedure initiates reading from a pseudo file.
@<Declare \eTeX\ procedures for ex...@>=
procedure@?pseudo_start; forward;@t\2@>
@ @<Declare \eTeX\ procedures for tok...@>=
procedure pseudo_start;
var old_setting:0..max_selector; {holds |selector| setting}
@!s:str_number; {string to be converted into a pseudo file}
@!l,@!m:pool_pointer; {indices into |str_pool|}
@!p,@!q,@!r:pointer; {for list construction}
@!w: four_quarters; {four ASCII codes}
@!nl,@!sz:integer;
begin scan_general_text;
old_setting:=selector; selector:=new_string;
token_show(temp_head); selector:=old_setting;
flush_list(link(temp_head));
str_room(1); s:=make_string;
@<Convert string |s| into a new pseudo file@>;
flush_string;
@<Initiate input from new pseudo file@>;
end;
@ @<Convert string |s| into a new pseudo file@>=
str_pool[pool_ptr]:=si(" "); l:=str_start[s];
nl:=si(new_line_char);
p:=get_avail; q:=p;
while l<pool_ptr do
begin m:=l;
while (l<pool_ptr)and(str_pool[l]<>nl) do incr(l);
sz:=(l-m+7)div 4;
if sz=1 then sz:=2;
r:=get_node(sz); link(q):=r; q:=r; info(q):=hi(sz);
while sz>2 do
begin decr(sz); incr(r);
w.b0:=qi(so(str_pool[m])); w.b1:=qi(so(str_pool[m+1]));
w.b2:=qi(so(str_pool[m+2])); w.b3:=qi(so(str_pool[m+3]));
mem[r].qqqq:=w; m:=m+4;
end;
w.b0:=qi(" "); w.b1:=qi(" "); w.b2:=qi(" "); w.b3:=qi(" ");
if l>m then
begin w.b0:=qi(so(str_pool[m]));
if l>m+1 then
begin w.b1:=qi(so(str_pool[m+1]));
if l>m+2 then
begin w.b2:=qi(so(str_pool[m+2]));
if l>m+3 then w.b3:=qi(so(str_pool[m+3]));
end;
end;
end;
mem[r+1].qqqq:=w;
if str_pool[l]=nl then incr(l);
end;
info(p):=link(p); link(p):=pseudo_files; pseudo_files:=p
@ @<Initiate input from new pseudo file@>=
begin_file_reading; {set up |cur_file| and new level of input}
line:=0; limit:=start; loc:=limit+1; {force line read}
if tracing_scan_tokens>0 then
begin if term_offset>max_print_line-3 then print_ln
else if (term_offset>0)or(file_offset>0) then print_char(" ");
name:=19; print("( "); incr(open_parens); update_terminal;
end
else name:=18
@ Here we read a line from the current pseudo file into |buffer|.
@<Declare \eTeX\ procedures for tr...@>=
function pseudo_input: boolean; {inputs the next line or returns |false|}
var p:pointer; {current line from pseudo file}
@!sz:integer; {size of node |p|}
@!w:four_quarters; {four ASCII codes}
@!r:pointer; {loop index}
begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
p:=info(pseudo_files);
if p=null then pseudo_input:=false
else begin info(pseudo_files):=link(p); sz:=ho(info(p));
if 4*sz-3>=buf_size-last then
@<Report overflow of the input buffer, and abort@>;
last:=first;
for r:=p+1 to p+sz-1 do
begin w:=mem[r].qqqq;
buffer[last]:=w.b0; buffer[last+1]:=w.b1;
buffer[last+2]:=w.b2; buffer[last+3]:=w.b3;
last:=last+4;
end;
if last>=max_buf_stack then max_buf_stack:=last+1;
while (last>first)and(buffer[last-1]=" ") do decr(last);
free_node(p,sz);
pseudo_input:=true;
end;
end;
@ When we are done with a pseudo file we `close' it.
@<Declare \eTeX\ procedures for tr...@>=
procedure pseudo_close; {close the top level pseudo file}
var p,@!q: pointer;
begin p:=link(pseudo_files); q:=info(pseudo_files);
free_avail(pseudo_files); pseudo_files:=p;
while q<>null do
begin p:=q; q:=link(p); free_node(p,ho(info(p)));
end;
end;
@ @<Dump the \eTeX\ state@>=
while pseudo_files<>null do pseudo_close; {flush pseudo files}
@ @<Generate all \eTeX...@>=
primitive("readline",read_to_cs,1);@/
@!@:read_line_}{\.{\\readline} primitive@>
@ @<Cases of |read| for |print_cmd_chr|@>=
else print_esc("readline")
@ @<Handle \.{\\readline} and |goto done|@>=
if j=1 then
begin while loc<=limit do {current line not yet finished}
begin cur_chr:=buffer[loc]; incr(loc);
if cur_chr=" " then cur_tok:=space_token
@+else cur_tok:=cur_chr+other_token;
store_new_token(cur_tok);
end;
goto done;
end
@ Here we define the additional conditionals of \eTeX\ as well as the
\.{\\unless} prefix.
@d if_def_code=17 { `\.{\\ifdefined}' }
@d if_cs_code=18 { `\.{\\ifcsname}' }
@d if_font_char_code=19 { `\.{\\iffontchar}' }
@<Generate all \eTeX...@>=
primitive("unless",expand_after,1);@/
@!@:unless_}{\.{\\unless} primitive@>
primitive("ifdefined",if_test,if_def_code);
@!@:if_defined_}{\.{\\ifdefined} primitive@>
primitive("ifcsname",if_test,if_cs_code);
@!@:if_cs_name_}{\.{\\ifcsname} primitive@>
primitive("iffontchar",if_test,if_font_char_code);
@!@:if_font_char_}{\.{\\iffontchar} primitive@>
@ @<Cases of |expandafter| for |print_cmd_chr|@>=
else print_esc("unless")
@ @<Cases of |if_test| for |print_cmd_chr|@>=
if_def_code:print_esc("ifdefined");
if_cs_code:print_esc("ifcsname");
if_font_char_code:print_esc("iffontchar");
@ The result of a boolean condition is reversed when the conditional is
preceded by \.{\\unless}.
@<Negate a boolean conditional and |goto reswitch|@>=
begin get_token;
if (cur_cmd=if_test)and(cur_chr<>if_case_code) then
begin cur_chr:=cur_chr+unless_code; goto reswitch;
end;
print_err("You can't use `"); print_esc("unless"); print("' before `");
@.You can't use \\unless...@>
print_cmd_chr(cur_cmd,cur_chr); print_char("'");
help1("Continue, and I'll forget that it ever happened.");
back_error;
end
@ The conditional \.{\\ifdefined} tests if a control sequence is
defined.
We need to reset |scanner_status|, since \.{\\outer} control sequences
are allowed, but we might be scanning a macro definition or preamble.
@<Cases for |conditional|@>=
if_def_code:begin save_scanner_status:=scanner_status;
scanner_status:=normal;
get_next; b:=(cur_cmd<>undefined_cs);
scanner_status:=save_scanner_status;
end;
@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter}
\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new
control sequence will be entered into the hash table (once all tokens
preceding the mandatory \.{\\endcsname} have been expanded).
@<Cases for |conditional|@>=
if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
repeat get_x_token;
if cur_cs=0 then store_new_token(cur_tok);
until cur_cs<>0;
if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
@<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
flush_list(n);
b:=(eq_type(cur_cs)<>undefined_cs);
end;
@ @<Look up the characters of list |n| in the hash table...@>=
m:=first; p:=link(n);
while p<>null do
begin if m>=max_buf_stack then
begin max_buf_stack:=m+1;
if max_buf_stack=buf_size then
overflow("buffer size",buf_size);
@:TeX capacity exceeded buffer size}{\quad buffer size@>
end;
buffer[m]:=info(p) mod @'400; incr(m); p:=link(p);
end;
if m>first+1 then
cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|}
else if m=first then cur_cs:=null_cs {the list is empty}
else cur_cs:=single_base+buffer[first] {the list has length one}
@ The conditional \.{\\iffontchar} tests the existence of a character in
a font.
@<Cases for |conditional|@>=
if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
b:=char_exists(char_info(n)(qi(cur_val)))
else b:=false;
end;
@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
command for macro definitions. Such macros are protected against
expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
or during \.{\\write}.
@<Generate all \eTeX...@>=
primitive("protected",prefix,8);
@!@:protected_}{\.{\\protected} primitive@>
@ @<Cases of |prefix| for |print_cmd_chr|@>=
else if chr_code=8 then print_esc("protected")
@ The |get_x_or_protected| procedure is like |get_x_token| except that
protected macros are not expanded.
@<Declare \eTeX\ procedures for sc...@>=
procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
and expands non-protected macros}
label exit;
begin loop@+begin get_token;
if cur_cmd<=max_command then return;
if (cur_cmd>=call)and(cur_cmd<end_template) then
if info(link(cur_chr))=protected_token then return;
expand;
end;
exit:end;
@ A group entered (or a conditional started) in one file may end in a
different file. Such slight anomalies, although perfectly legitimate,
may cause errors that are difficult to locate. In order to be able to
give a warning message when such anomalies occur, \eTeX\ uses the
|grp_stack| and |if_stack| arrays to record the initial |cur_boundary|
and |cond_ptr| values for each input file.
@<Glob...@>=
@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
@ When a group ends that was apparently entered in a different input
file, the |group_warning| procedure is invoked in order to update the
|grp_stack|. If moreover \.{\\tracingnesting} is positive we want to
give a warning message. The situation is, however, somewhat complicated
by two facts: (1)~There may be |grp_stack| elements without a
corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g.,
error insertions from the terminal); and (2)~the relevant information is
recorded in the |name_field| of the |input_stack| only loosely
synchronized with the |in_open| variable indexing |grp_stack|.
@<Declare \eTeX\ procedures for tr...@>=
procedure group_warning;
var i:0..max_in_open; {index into |grp_stack|}
@!w:boolean; {do we need a warning?}
begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
{store current state}
i:=in_open; w:=false;
while (grp_stack[i]=cur_boundary)and(i>0) do
begin @<Set variable |w| to indicate if this case should be reported@>;
grp_stack[i]:=save_index(save_ptr); decr(i);
end;
if w then
begin print_nl("Warning: end of "); print_group(true);
@.Warning: end of...@>
print(" of a different file"); print_ln;
if tracing_nesting>1 then show_context;
if history=spotless then history:=warning_issued;
end;
end;
@ This code scans the input stack in order to determine the type of the
current input file.
@<Set variable |w| to...@>=
if tracing_nesting>0 then
begin while (input_stack[base_ptr].state_field=token_list)or@|
(input_stack[base_ptr].index_field>i) do decr(base_ptr);
if input_stack[base_ptr].name_field>17 then w:=true;
end
@ When a conditional ends that was apparently started in a different
input file, the |if_warning| procedure is invoked in order to update the
|if_stack|. If moreover \.{\\tracingnesting} is positive we want to
give a warning message (with the same complications as above).
@<Declare \eTeX\ procedures for tr...@>=
procedure if_warning;
var i:0..max_in_open; {index into |if_stack|}
@!w:boolean; {do we need a warning?}
begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
{store current state}
i:=in_open; w:=false;
while if_stack[i]=cond_ptr do
begin @<Set variable |w| to...@>;
if_stack[i]:=link(cond_ptr); decr(i);
end;
if w then
begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if);
@.Warning: end of...@>
print_if_line(if_line); print(" of a different file"); print_ln;
if tracing_nesting>1 then show_context;
if history=spotless then history:=warning_issued;
end;
end;
@ Conversely, the |file_warning| procedure is invoked when a file ends
and some groups entered or conditionals started while reading from that
file are still incomplete.
@<Declare \eTeX\ procedures for tr...@>=
procedure file_warning;
var p:pointer; {saved value of |save_ptr| or |cond_ptr|}
@!l:quarterword; {saved value of |cur_level| or |if_limit|}
@!c:quarterword; {saved value of |cur_group| or |cur_if|}
@!i:integer; {saved value of |if_line|}
begin p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary;
while grp_stack[in_open]<>save_ptr do
begin decr(cur_level);
print_nl("Warning: end of file when ");
@.Warning: end of file when...@>
print_group(true); print(" is incomplete");@/
cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
end;
save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values}
p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line;
while if_stack[in_open]<>cond_ptr do
begin print_nl("Warning: end of file when ");
@.Warning: end of file when...@>
print_cmd_chr(if_test,cur_if);
if if_limit=fi_code then print_esc("else");
print_if_line(if_line); print(" is incomplete");@/
if_line:=if_line_field(cond_ptr); cur_if:=subtype(cond_ptr);
if_limit:=type(cond_ptr); cond_ptr:=link(cond_ptr);
end;
cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values}
print_ln;
if tracing_nesting>1 then show_context;
if history=spotless then history:=warning_issued;
end;
@ Here are the additional \eTeX\ primitives for expressions.
@<Generate all \eTeX...@>=
primitive("numexpr",last_item,eTeX_expr-int_val+int_val);
@!@:num_expr_}{\.{\\numexpr} primitive@>
primitive("dimexpr",last_item,eTeX_expr-int_val+dimen_val);
@!@:dim_expr_}{\.{\\dimexpr} primitive@>
primitive("glueexpr",last_item,eTeX_expr-int_val+glue_val);
@!@:glue_expr_}{\.{\\glueexpr} primitive@>
primitive("muexpr",last_item,eTeX_expr-int_val+mu_val);
@!@:mu_expr_}{\.{\\muexpr} primitive@>
@ @<Cases of |last_item| for |print_cmd_chr|@>=
eTeX_expr-int_val+int_val: print_esc("numexpr");
eTeX_expr-int_val+dimen_val: print_esc("dimexpr");
eTeX_expr-int_val+glue_val: print_esc("glueexpr");
eTeX_expr-int_val+mu_val: print_esc("muexpr");
@ This code for reducing |cur_val_level| and\slash or negating the
result is similar to the one for all the other cases of
|scan_something_internal|, with the difference that |scan_expr| has
already increased the reference count of a glue specification.
@<Process an expression and |return|@>=
begin if m<eTeX_mu then
begin case m of
@/@<Cases for fetching a glue value@>@/
end; {there are no other cases}
cur_val_level:=glue_val;
end
else if m<eTeX_expr then
begin case m of
@/@<Cases for fetching a mu value@>@/
end; {there are no other cases}
cur_val_level:=mu_val;
end
else begin cur_val_level:=m-eTeX_expr+int_val; scan_expr;
end;
while cur_val_level>level do
begin if cur_val_level=glue_val then
begin m:=cur_val; cur_val:=width(m); delete_glue_ref(m);
end
else if cur_val_level=mu_val then mu_error;
decr(cur_val_level);
end;
if negative then
if cur_val_level>=glue_val then
begin m:=cur_val; cur_val:=new_spec(m); delete_glue_ref(m);
@<Negate all three glue components of |cur_val|@>;
end
else negate(cur_val);
return;
end
@ @<Declare \eTeX\ procedures for sc...@>=
procedure@?scan_expr; forward;@t\2@>
@ The |scan_expr| procedure scans and evaluates an expression.
@<Declare procedures needed for expressions@>=
@t\4@>@<Declare subprocedures for |scan_expr|@>
procedure scan_expr; {scans and evaluates an expression}
label restart, continue, found;
var a,@!b:boolean; {saved values of |arith_error|}
@!l:small_number; {type of expression}
@!r:small_number; {state of expression so far}
@!s:small_number; {state of term so far}
@!o:small_number; {next operation or type of next factor}
@!e:integer; {expression so far}
@!t:integer; {term so far}
@!f:integer; {current factor}
@!n:integer; {numerator of combined multiplication and division}
@!p:pointer; {top of expression stack}
@!q:pointer; {for stack manipulations}
begin l:=cur_val_level; a:=arith_error; b:=false; p:=null;
@<Scan and evaluate an expression |e| of type |l|@>;
if b then
begin print_err("Arithmetic overflow");
@.Arithmetic overflow@>
help2("I can't evaluate this expression,")@/
("since the result is out of range.");
error;
if l>=glue_val then
begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e);
end
else e:=0;
end;
arith_error:=a; cur_val:=e; cur_val_level:=l;
end;
@ Evaluating an expression is a recursive process: When the left
parenthesis of a subexpression is scanned we descend to the next level
of recursion; the previous level is resumed with the matching right
parenthesis.
@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen}
@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen}
@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen}
@d expr_mult=3 {$\langle\it term\rangle$ \.* seen}
@d expr_div=4 {$\langle\it term\rangle$ \./ seen}
@d expr_scale=5 {$\langle\it term\rangle$ \.*
$\langle\it factor\rangle$ \./ seen}
@<Scan and eval...@>=
restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0;
continue: if s=expr_none then o:=l@+else o:=int_val;
@<Scan a factor |f| of type |o| or start a subexpression@>;
found: @<Scan the next operator and set |o|@>;
arith_error:=b;
@<Make sure that |f| is in the proper range@>;
case s of @<Cases for evaluation of the current term@>@;
end; {there are no other cases}
if o>expr_sub then s:=o@+else @<Evaluate the current expression@>;
b:=arith_error;
if o<>expr_none then goto continue;
if p<>null then @<Pop the expression stack and |goto found|@>
@ @<Scan the next op...@>=
@<Get the next non-blank non-call token@>;
if cur_tok=other_token+"+" then o:=expr_add
else if cur_tok=other_token+"-" then o:=expr_sub
else if cur_tok=other_token+"*" then o:=expr_mult
else if cur_tok=other_token+"/" then o:=expr_div
else begin o:=expr_none;
if p=null then
begin if cur_cmd<>relax then back_input;
end
else if cur_tok<>other_token+")" then
begin print_err("Missing ) inserted for expression");
@.Missing ) inserted@>
help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't.");
back_error;
end;
end
@ @<Scan a factor...@>=
@<Get the next non-blank non-call token@>;
if cur_tok=other_token+"(" then
@<Push the expression stack and |goto restart|@>;
back_input;
if o=int_val then scan_int
else if o=dimen_val then scan_normal_dimen
else if o=glue_val then scan_normal_glue
else scan_mu_glue;
f:=cur_val
@ @<Declare \eTeX\ procedures for sc...@>=
procedure@?scan_normal_glue; forward;@t\2@>@/
procedure@?scan_mu_glue; forward;@t\2@>
@ Here we declare to trivial procedures in order to avoid mutually
recursive procedures with parameters.
@<Declare procedures needed for expressions@>=
procedure scan_normal_glue;
begin scan_glue(glue_val);
end;
@#
procedure scan_mu_glue;
begin scan_glue(mu_val);
end;
@ Parenthesized subexpressions can be inside expressions, and this
nesting has a stack. Seven local variables represent the top of the
expression stack: |p| points to pushed-down entries, if any; |l|
specifies the type of expression currently beeing evaluated; |e| is the
expression so far and |r| is the state of its evaluation; |t| is the
term so far and |s| is the state of its evaluation; finally |n| is the
numerator for a combined multiplication and division, if any.
@d expr_node_size=4 {number of words in stack entry for subexpressions}
@d expr_e_field(#)==mem[#+1].int {saved expression so far}
@d expr_t_field(#)==mem[#+2].int {saved term so far}
@d expr_n_field(#)==mem[#+3].int {saved numerator}
@<Push the expression...@>=
begin q:=get_node(expr_node_size); link(q):=p; type(q):=l;
subtype(q):=4*s+r;
expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n;
p:=q; l:=o; goto restart;
end
@ @<Pop the expression...@>=
begin f:=e; q:=p;
e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q);
s:=subtype(q) div 4; r:=subtype(q) mod 4;
l:=type(q); p:=link(q); free_node(q,expr_node_size);
goto found;
end
@ We want to make sure that each term and (intermediate) result is in
the proper range. Integer values must not exceed |infinity|
($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen|
($2^{30}-1$). We avoid the absolute value of an integer, because this
might fail for the value $-2^{31}$ using 32-bit arithmetic.
@d num_error(#)== {clear a number or dimension and set |arith_error|}
begin arith_error:=true; #:=0;
end
@d glue_error(#)== {clear a glue spec and set |arith_error|}
begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue);
end
@<Make sure that |f|...@>=
if (l=int_val)or(s>expr_sub) then
begin if (f>infinity)or(f<-infinity) then num_error(f);
end
else if l=dimen_val then
begin if abs(f)>max_dimen then num_error(f);
end
else begin if (abs(width(f))>max_dimen)or@|
(abs(stretch(f))>max_dimen)or@|
(abs(shrink(f))>max_dimen) then glue_error(f);
end
@ Applying the factor |f| to the partial term |t| (with the operator
|s|) is delayed until the next operator |o| has been scanned. Here we
handle the first factor of a partial term. A glue spec has to be copied
unless the next operator is a right parenthesis; this allows us later on
to simply modify the glue components.
@d normalize_glue(#)==
if stretch(#)=0 then stretch_order(#):=normal;
if shrink(#)=0 then shrink_order(#):=normal
@<Cases for evaluation of the current term@>=
expr_none: if (l>=glue_val)and(o<>expr_none) then
begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t);
end
else t:=f;
@ When a term |t| has been completed it is copied to, added to, or
subtracted from the expression |e|.
@d expr_add_sub(#)==add_or_sub(#,r=expr_sub)
@d expr_a(#)==expr_add_sub(#,max_dimen)
@<Evaluate the current expression@>=
begin s:=expr_none;
if r=expr_none then e:=t
else if l=int_val then e:=expr_add_sub(e,t,infinity)
else if l=dimen_val then e:=expr_a(e,t)
else @<Compute the sum or difference of two glue specs@>;
r:=o;
end
@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum
(for |negative=false|) or difference (for |negative=true|) of |x| and
|y|, provided the absolute value of the result does not exceed
|max_answer|.
@<Declare subprocedures for |scan_expr|@>=
function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer;
var a:integer; {the answer}
begin if negative then negate(y);
if x>=0 then
if y<=max_answer-x then a:=x+y@+else num_error(a)
else if y>=-max_answer-x then a:=x+y@+else num_error(a);
add_or_sub:=a;
end;
@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and
|shrink_order(e)>normal| implies |shrink(e)<>0|.
@<Compute the sum or diff...@>=
begin width(e):=expr_a(width(e),width(t));
if stretch_order(e)=stretch_order(t) then
stretch(e):=expr_a(stretch(e),stretch(t))
else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then
begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t);
end;
if shrink_order(e)=shrink_order(t) then
shrink(e):=expr_a(shrink(e),shrink(t))
else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then
begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t);
end;
delete_glue_ref(t); normalize_glue(e);
end
@ If a multiplication is followed by a division, the two operations are
combined into a `scaling' operation. Otherwise the term |t| is
multiplied by the factor |f|.
@d expr_m(#)==#:=nx_plus_y(#,f,0)
@<Cases for evaluation of the current term@>=
expr_mult: if o=expr_div then
begin n:=f; o:=expr_scale;
end
else if l=int_val then t:=mult_integers(t,f)
else if l=dimen_val then expr_m(t)
else begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t));
end;
@ Here we divide the term |t| by the factor |f|.
@d expr_d(#)==#:=quotient(#,f)
@<Cases for evaluation of the current term@>=
expr_div: if l<glue_val then expr_d(t)
else begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t));
end;
@ The function |quotient(n,d)| computes the rounded quotient
$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive.
@<Declare subprocedures for |scan_expr|@>=
function quotient(@!n,@!d:integer):integer;
var negative:boolean; {should the answer be negated?}
@!a:integer; {the answer}
begin if d=0 then num_error(a)
else begin if d>0 then negative:=false
else begin negate(d); negative:=true;
end;
if n<0 then
begin negate(n); negative:=not negative;
end;
a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!}
if d+n>=0 then incr(a);
if negative then negate(a);
end;
quotient:=a;
end;
@ Here the term |t| is multiplied by the quotient $n/f$.
@d expr_s(#)==#:=fract(#,n,f,max_dimen)
@<Cases for evaluation of the current term@>=
expr_scale: if l=int_val then t:=fract(t,n,f,infinity)
else if l=dimen_val then expr_s(t)
else begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t));
end;
@ Finally, the function |fract(x,n,d,max_answer)| computes the integer
$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive
and the result does not exceed |max_answer|. We can't use floating
point arithmetic since the routine must produce identical results in all
cases; and it would be too dangerous to multiply by~|n| and then divide
by~|d|, in separate operations, since overflow might well occur. Hence
this subroutine simulates double precision arithmetic, somewhat
analogous to \MF's |make_fraction| and |take_fraction| routines.
@d too_big=88 {go here when the result is too big}
@<Declare subprocedures for |scan_expr|@>=
function fract(@!x,@!n,@!d,@!max_answer:integer):integer;
label found, found1, too_big, done;
var negative:boolean; {should the answer be negated?}
@!a:integer; {the answer}
@!f:integer; {a proper fraction}
@!h:integer; {smallest integer such that |2*h>=d|}
@!r:integer; {intermediate remainder}
@!t:integer; {temp variable}
begin if d=0 then goto too_big;
a:=0;
if d>0 then negative:=false
else begin negate(d); negative:=true;
end;
if x<0 then
begin negate(x); negative:=not negative;
end
else if x=0 then goto done;
if n<0 then
begin negate(n); negative:=not negative;
end;
t:=n div d;
if t>max_answer div x then goto too_big;
a:=t*x; n:=n-t*d;
if n=0 then goto found;
t:=x div d;
if t>(max_answer-a) div n then goto too_big;
a:=a+t*n; x:=x-t*d;
if x=0 then goto found;
if x<n then
begin t:=x; x:=n; n:=t;
end; {now |0<n<=x<d|}
@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@;
if f>(max_answer-a) then goto too_big;
a:=a+f;
found: if negative then negate(a);
goto done;
too_big: num_error(a);
done: fract:=a;
end;
@ The loop here preserves the following invariant relations
between |f|, |x|, |n|, and~|r|:
(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$;
(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$
and $n$.
Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|,
because the latter could overflow.
@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>=
f:=0; r:=(d div 2)-d; h:=-r;
loop@+begin if odd(n) then
begin r:=r+x;
if r>=0 then
begin r:=r-d; incr(f);
end;
end;
n:=n div 2;
if n=0 then goto found1;
if x<h then x:=x+x
else begin t:=x-d; x:=t+x; f:=f+n;
if x<n then
begin if x=0 then goto found1;
t:=x; x:=n; n:=t;
end;
end;
end;
found1:
@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and
\.{\\glueshrinkorder} commands return the stretch and shrink components
and their orders of ``infinity'' of a glue specification.
@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}}
@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}}
@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}}
@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}}
@<Generate all \eTeX...@>=
primitive("gluestretchorder",last_item,glue_stretch_order_code);
@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@>
primitive("glueshrinkorder",last_item,glue_shrink_order_code);
@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@>
primitive("gluestretch",last_item,glue_stretch_code);
@!@:glue_stretch_}{\.{\\gluestretch} primitive@>
primitive("glueshrink",last_item,glue_shrink_code);
@!@:glue_shrink_}{\.{\\glueshrink} primitive@>
@ @<Cases of |last_item| for |print_cmd_chr|@>=
glue_stretch_order_code: print_esc("gluestretchorder");
glue_shrink_order_code: print_esc("glueshrinkorder");
glue_stretch_code: print_esc("gluestretch");
glue_shrink_code: print_esc("glueshrink");
@ @<Cases for fetching an integer value@>=
glue_stretch_order_code, glue_shrink_order_code:
begin scan_normal_glue; q:=cur_val;
if m=glue_stretch_order_code then cur_val:=stretch_order(q)
else cur_val:=shrink_order(q);
delete_glue_ref(q);
end;
@ @<Cases for fetching a dimension value@>=
glue_stretch_code, glue_shrink_code:
begin scan_normal_glue; q:=cur_val;
if m=glue_stretch_code then cur_val:=stretch(q)
else cur_val:=shrink(q);
delete_glue_ref(q);
end;
@ The \.{\\mutoglue} and \.{\\gluetomu} commands convert ``math'' glue
into normal glue and vice versa; they allow to manipulate math glue with
\.{\\gluestretch} etc.
@d mu_to_glue_code=eTeX_glue {code for \.{\\mutoglue}}
@d glue_to_mu_code=eTeX_mu {code for \.{\\gluetomu}}
@<Generate all \eTeX...@>=
primitive("mutoglue",last_item,mu_to_glue_code);
@!@:mu_to_glue_}{\.{\\mutoglue} primitive@>
primitive("gluetomu",last_item,glue_to_mu_code);
@!@:glue_to_mu_}{\.{\\gluetomu} primitive@>
@ @<Cases of |last_item| for |print_cmd_chr|@>=
mu_to_glue_code: print_esc("mutoglue");
glue_to_mu_code: print_esc("gluetomu");
@ @<Cases for fetching a glue value@>=
mu_to_glue_code: scan_mu_glue;
@ @<Cases for fetching a mu value@>=
glue_to_mu_code: scan_normal_glue;
@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
dimen, skip, muskip, box, and token registers. As in \TeX\ the first
256 registers of each kind are realized as arrays in the table of
equivalents; the additional registers are realized as tree structures
built from variable-size nodes with individual registers existing only
when needed. Default values are used for nonexistent registers: zero
for count and dimen values, |zero_glue| for glue (skip and muskip)
values, void for boxes, and |null| for token lists (and current marks
discussed below).
Similarly there are 32768 mark classes; the command \.{\\marks}|n|
creates a mark node for a given mark class |0<=n<=32767| (where
\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
the |fire_up| routine) and the |vsplit| routine maintain the current
values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
|split_bot_mark| for each mark class. They are accessed as
\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
are realized as |cur_mark| array. The additional current marks are
again realized as tree structure with individual mark classes existing
only when needed.
@<Generate all \eTeX...@>=
primitive("marks",mark,marks_code);
@!@:marks_}{\.{\\marks} primitive@>
primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
@!@:top_marks_}{\.{\\topmarks} primitive@>
primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
@!@:first_marks_}{\.{\\firstmarks} primitive@>
primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
@!@:bot_marks_}{\.{\\botmarks} primitive@>
primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
@ The |scan_register_num| procedure scans a register number that must
not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
@<Declare \eTeX\ procedures for ex...@>=
procedure@?scan_register_num; forward;@t\2@>
@ @<Declare procedures that scan restricted classes of integers@>=
procedure scan_register_num;
begin scan_int;
if (cur_val<0)or(cur_val>max_reg_num) then
begin print_err("Bad register code");
@.Bad register code@>
help2(max_reg_help_line)("I changed this one to zero.");
int_error(cur_val); cur_val:=0;
end;
end;
@ @<Initialize variables for \eTeX\ comp...@>=
max_reg_num:=255;
max_reg_help_line:="A register number must be between 0 and 255.";
@ @<Initialize variables for \eTeX\ ext...@>=
max_reg_num:=32767;
max_reg_help_line:="A register number must be between 0 and 32767.";
@ @<Glob...@>=
@!max_reg_num: halfword; {largest allowed register number}
@!max_reg_help_line: str_number; {first line of help message}
@ There are seven almost identical doubly linked trees, one for the
sparse array of the up to 32512 additional registers of each kind and
one for the sparse array of the up to 32767 additional mark classes.
The root of each such tree, if it exists, is an index node containing 16
pointers to subtrees for 4096 consecutive array elements. Similar index
nodes are the starting points for all nonempty subtrees for 4096, 256,
and 16 consecutive array elements. These four levels of index nodes are
followed by a fifth level with nodes for the individual array elements.
Each index node is nine words long. The pointers to the 16 possible
subtrees or are kept in the |info| and |link| fields of the last eight
words. (It would be both elegant and efficient to declare them as
array, unfortunately \PASCAL\ doesn't allow this.)
The fields in the first word of each index node and in the nodes for the
array elements are closely related. The |link| field points to the next
lower index node and the |sa_index| field contains four bits (one
hexadecimal digit) of the register number or mark class. For the lowest
index node the |link| field is |null| and the |sa_index| field indicates
the type of quantity (|int_avl|, |dimen_val|, |glue_val|, |mu_val|,
|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
nodes counts how many of the 16 pointers are non-null.
The |sa_index| field in the nodes for array elements contains the four
bits plus 16 times the type. Therefore such a node represents a count
or dimen register if and only if |sa_index<dimen_val_limit|; it
represents a skip or muskip register if and only if
|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
token list register if and only if
|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
class if and only if |tok_val_limit<=sa_index|.
The |new_index| procedure creates an index node (returned in |cur_ptr|)
having given contents of the |sa_index| and |link| fields.
@d box_val==4 {the additional box registers}
@d mark_val=6 {the additional mark classes}
@#
@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
@#
@d index_node_size=9 {size of an index node}
@d sa_index==type {a four-bit address or a type or both}
@d sa_used==subtype {count of non-null pointers}
@<Declare \eTeX\ procedures for ex...@>=
procedure new_index(@!i:quarterword; @!q:pointer);
var k:small_number; {loop index}
begin cur_ptr:=get_node(index_node_size); sa_index(cur_ptr):=i;
sa_used(cur_ptr):=0; link(cur_ptr):=q;
for k:=1 to index_node_size-1 do {clear all 16 pointers}
mem[cur_ptr+k]:=sa_null;
end;
@ The roots of the seven trees for the additional registers and mark
classes are kept in the |sa_root| array. The first six locations must
be dumped and undumped; the last one is also known as |sa_mark|.
@d sa_mark==sa_root[mark_val] {root for mark classes}
@<Glob...@>=
@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
@!sa_null:memory_word; {two |null| pointers}
@ @<Set init...@>=
sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
@ @<Initialize table...@>=
for i:=int_val to tok_val do sa_root[i]:=null;
@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
procedure returns (in |cur_ptr|) a pointer to the node for the
corresponding array element, or |null| when no such element exists. The
third parameter |w| is set |true| if the element must exist, e.g.,
because it is about to be modified. The procedure has two main
branches: one follows the existing tree structure, the other (only used
when |w| is |true|) creates the missing nodes.
We use macros to extract the four-bit pieces from a sixteen-bit register
number or mark class and to fetch or store one of the 16 pointers from
an index node.
@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
begin if cur_ptr=null then
if w then goto #@+else return;
end
@#
@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
@#
@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
else cur_ptr:=info(q+(i div 2)+1)
{set |cur_ptr| to the pointer indexed by |i| from index node |q|}
@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
else info(q+(i div 2)+1):=#
{store the pointer indexed by |i| in index node |q|}
@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
end {delete the pointer indexed by |i| in index node |q|}
@<Declare \eTeX\ procedures for ex...@>=
procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
{sets |cur_val| to sparse array element location or |null|}
label not_found,not_found1,not_found2,not_found3,not_found4,exit;
var q:pointer; {for list manipulations}
@!i:small_number; {a four bit index}
begin cur_ptr:=sa_root[t];
if_cur_ptr_is_null_then_return_or_goto(not_found);@/
q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
if (cur_ptr=null)and w then goto not_found4;
return;
not_found: new_index(t,null); {create first level index node}
sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
not_found1: new_index(i,q); {create second level index node}
add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
not_found2: new_index(i,q); {create third level index node}
add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
not_found3: new_index(i,q); {create fourth level index node}
add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
not_found4: @<Create a new array element of type |t| with index |i|@>;
link(cur_ptr):=q; add_sa_ptr;
exit:end;
@ The array elements for registers are subject to grouping and have an
|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
Since saved values as well as shorthand definitions (created by e.g.,
\.{\\countdef}) refer to the location of the respective array element,
we need a reference count that is kept in the |sa_ref| field. An array
element can be deleted (together with all references to it) when its
|sa_ref| value is |null| and its value is the default value.
@^reference counts@>
Skip, muskip, box, and token registers use two word nodes, their values
are stored in the |sa_ptr| field.
Count and dimen registers use three word nodes, their
values are stored in the |sa_int| resp.\ |sa_dim| field in the third
word; the |sa_ptr| field is used under the name |sa_num| to store
the register number. Mark classes use four word nodes. The last three
words contain the five types of current marks
@d sa_lev==sa_used {grouping level for the current value}
@d pointer_node_size=2 {size of an element with a pointer value}
@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
@d sa_ptr(#)==link(#+1) {a pointer value}
@#
@d word_node_size=3 {size of an element with a word value}
@d sa_num==sa_ptr {the register number}
@d sa_int(#)==mem[#+2].int {an integer}
@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
@#
@d mark_class_node_size=4 {size of an element for a mark class}
@#
@d fetch_box(#)== {fetch |box(cur_val)|}
if cur_val<256 then #:=box(cur_val)
else begin find_sa_element(box_val,cur_val,false);
if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
end
@<Create a new array element...@>=
if t=mark_val then {a mark class}
begin cur_ptr:=get_node(mark_class_node_size);
mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
end
else begin if t<=dimen_val then {a count or dimen register}
begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
sa_num(cur_ptr):=n;
end
else begin cur_ptr:=get_node(pointer_node_size);
if t<=mu_val then {a skip or muskip register}
begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
end
else sa_ptr(cur_ptr):=null; {a box or token list register}
end;
sa_ref(cur_ptr):=null; {all registers have a reference count}
end;
sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
@ The |delete_sa_ref| procedure is called when a pointer to an array
element representing a register is being removed; this means that the
reference count should be decreased by one. If the reduced reference
count is |null| and the register has been (globally) assigned its
default value the array element should disappear, possibly together with
some index nodes. This procedure will never be used for mark class
nodes.
@^reference counts@>
@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
@#
@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
if cur_val<256 then box(cur_val):=#@+else set_sa_box(#)
@#
@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
if cur_ptr<>0 then
begin sa_ptr(cur_ptr):=#; add_sa_ref(cur_ptr); delete_sa_ref(cur_ptr);
end;
end
@<Declare \eTeX\ procedures for tr...@>=
procedure delete_sa_ref(@!q:pointer); {reduce reference count}
label exit;
var p:pointer; {for list manipulations}
@!i:small_number; {a four bit index}
@!s:small_number; {size of a node}
begin decr(sa_ref(q));
if sa_ref(q)<>null then return;
if sa_index(q)<dimen_val_limit then
if sa_int(q)=0 then s:=word_node_size
else return
else begin if sa_index(q)<mu_val_limit then
if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
else return
else if sa_ptr(q)<>null then return;
s:=pointer_node_size;
end;
repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
if q=null then {the whole tree has been freed}
begin sa_root[i]:=null; return;
end;
delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
until sa_used(q)>0;
exit:end;
@ The |print_sa_num| procedure prints the register number corresponding
to an array element.
@<Basic print...@>=
procedure print_sa_num(@!q:pointer); {print register number}
var @!n:halfword; {the register number}
begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
end;
print_int(n);
end;
@ Here is a procedure that displays the contents of an array element
symbolically. It is used under similar circumstances as is
|restore_trace| (together with |show_eqtb|) for the quantities kept in
the |eqtb| array.
@<Declare \eTeX\ procedures for tr...@>=
@!stat procedure show_sa(@!p:pointer;@!s:str_number);
var t:small_number; {the type of element}
begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
if p=null then print_char("?") {this can't happen}
else begin t:=sa_type(p);
if t<box_val then print_cmd_chr(register,p)
else if t=box_val then
begin print_esc("box"); print_sa_num(p);
end
else if t=tok_val then print_cmd_chr(toks_register,p)
else print_char("?"); {this can't happen either}
print_char("=");
if t=int_val then print_int(sa_int(p))
else if t=dimen_val then
begin print_scaled(sa_dim(p)); print("pt");
end
else begin p:=sa_ptr(p);
if t=glue_val then print_spec(p,"pt")
else if t=mu_val then print_spec(p,"mu")
else if t=box_val then
if p=null then print("void")
else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
end
else if t=tok_val then
begin if p<>null then show_token_list(link(p),null,32);
end
else print_char("?"); {this can't happen either}
end;
end;
print_char("}"); end_diagnostic(false);
end;
tats
@ Here we compute the pointer to the current mark of type |t| and mark
class |cur_val|.
@<Compute the mark pointer...@>=
begin find_sa_element(mark_val,cur_val,false);
if cur_ptr<>null then
if odd(t) then cur_ptr:=link(cur_ptr+(t div 2)+1)
else cur_ptr:=info(cur_ptr+(t div 2)+1);
end
@ The current marks for all mark classes are maintained by the |vsplit|
and |fire_up| routines and are finally destroyed (for \.{INITEX} only)
@.INITEX@>
by the |final_cleanup| routine. Apart from updating the current marks
when mark nodes are encountered, these routines perform certain actions
on all existing mark classes. The recursive |do_marks| procedure walks
through the whole tree or a subtree of existing mark class nodes and
preforms certain actions indicted by its first parameter |a|, the action
code. The second parameter |l| indicates the level of recursion (at
most four); the third parameter points to a nonempty tree or subtree.
The result is |true| if the complete tree or subtree has been deleted.
@d vsplit_init==0 {action code for |vsplit| initialization}
@d fire_up_init==1 {action code for |fire_up| initialization}
@d fire_up_done==2 {action code for |fire_up| completion}
@d destroy_marks==3 {action code for |final_cleanup|}
@#
@d sa_top_mark(#)==info(#+1) {\.{\\topmarks}|n|}
@d sa_first_mark(#)==link(#+1) {\.{\\firstmarks}|n|}
@d sa_bot_mark(#)==info(#+2) {\.{\\botmarks}|n|}
@d sa_split_first_mark(#)==link(#+2) {\.{\\splitfirstmarks}|n|}
@d sa_split_bot_mark(#)==info(#+3) {\.{\\splitbotmarks}|n|}
@<Declare the function called |do_marks|@>=
function do_marks(@!a,@!l:small_number;@!q:pointer):boolean;
var i:small_number; {a four bit index}
begin if l<4 then {|q| is an index node}
begin for i:=0 to 15 do
begin get_sa_ptr;
if cur_ptr<>null then if do_marks(a,l+1,cur_ptr) then delete_sa_ptr;
end;
if sa_used(q)=0 then
begin free_node(q,index_node_size); q:=null;
end;
end
else {|q| is the node for a mark class}
begin case a of
@<Cases for |do_marks|@>@;
end; {there are no other cases}
if sa_bot_mark(q)=null then if sa_split_bot_mark(q)=null then
begin free_node(q,mark_class_node_size); q:=null;
end;
end;
do_marks:=(q=null);
end;
@ At the start of the |vsplit| routine the existing |split_fist_mark|
and |split_bot_mark| are discarded.
@<Cases for |do_marks|@>=
vsplit_init: if sa_split_first_mark(q)<>null then
begin delete_token_ref(sa_split_first_mark(q)); sa_split_first_mark(q):=null;
delete_token_ref(sa_split_bot_mark(q)); sa_split_bot_mark(q):=null;
end;
@ We use again the fact that |split_first_mark=null| if and only if
|split_bot_mark=null|.
@<Update the current marks for |vsplit|@>=
begin find_sa_element(mark_val,mark_class(p),true);
if sa_split_first_mark(cur_ptr)=null then
begin sa_split_first_mark(cur_ptr):=mark_ptr(p);
add_token_ref(mark_ptr(p));
end
else delete_token_ref(sa_split_bot_mark(cur_ptr));
sa_split_bot_mark(cur_ptr):=mark_ptr(p);
add_token_ref(mark_ptr(p));
end
@ At the start of the |fire_up| routine the old |top_mark| and
|first_mark| are discarded, whereas the old |bot_mark| becomes the new
|top_mark|. An empty new |top_mark| token list is, however, discarded
as well in order that mark class nodes can eventually be released. We
use again the fact that |bot_mark<>null| implies |first_mark<>null|; it
also knows that |bot_mark=null| implies |top_mark=first_mark=null|.
@<Cases for |do_marks|@>=
fire_up_init: if sa_bot_mark(q)<>null then
begin if sa_top_mark(q)<>null then delete_token_ref(sa_top_mark(q));
delete_token_ref(sa_first_mark(q)); sa_first_mark(q):=null;
if link(sa_bot_mark(q))=null then {an empty token list}
begin delete_token_ref(sa_bot_mark(q)); sa_bot_mark(q):=null;
end
else add_token_ref(sa_bot_mark(q));
sa_top_mark(q):=sa_bot_mark(q);
end;
@ @<Cases for |do_marks|@>=
fire_up_done: if (sa_top_mark(q)<>null)and(sa_first_mark(q)=null) then
begin sa_first_mark(q):=sa_top_mark(q); add_token_ref(sa_top_mark(q));
end;
@ @<Update the current marks for |fire_up|@>=
begin find_sa_element(mark_val,mark_class(p),true);
if sa_first_mark(cur_ptr)=null then
begin sa_first_mark(cur_ptr):=mark_ptr(p);
add_token_ref(mark_ptr(p));
end;
if sa_bot_mark(cur_ptr)<>null then delete_token_ref(sa_bot_mark(cur_ptr));
sa_bot_mark(cur_ptr):=mark_ptr(p); add_token_ref(mark_ptr(p));
end
@ Here we use the fact that the five current mark pointers in a mark
class node occupy the same locations as the the first five pointers of
an index node. For systems using a run-time switch to distinguish
between \.{VIRTEX} and \.{INITEX}, the codewords `$|init|\ldots|tini|$'
surrounding the following piece of code should be removed.
@.INITEX@>
@^system dependencies@>
@<Cases for |do_marks|@>=
@!init destroy_marks: for i:=top_mark_code to split_bot_mark_code do
begin get_sa_ptr;
if cur_ptr<>null then
begin delete_token_ref(cur_ptr); put_sa_ptr(null);
end;
end;
tini
@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
etc., as well as for references to sparse array elements defined by
`\.{\\countdef}', etc.
@<Cases of |register| for |print_cmd_chr|@>=
begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
cmd:=sa_type(chr_code)
else begin cmd:=chr_code-mem_bot; chr_code:=null;
end;
if cmd=int_val then print_esc("count")
else if cmd=dimen_val then print_esc("dimen")
else if cmd=glue_val then print_esc("skip")
else print_esc("muskip");
if chr_code<>null then print_sa_num(chr_code);
end
@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
well as for references to sparse array elements defined by
`\.{\\toksdef}'.
@<Cases of |toks_register| for |print_cmd_chr|@>=
begin print_esc("toks");
if chr_code<>mem_bot then print_sa_num(chr_code);
end
@ When a shorthand definition for an element of one of the sparse arrays
is destroyed, we must reduce the reference count.
@<Cases for |eq_destroy|@>=
toks_register,register:
if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
delete_sa_ref(equiv_field(w));
@ The task to maintain (change, save, and restore) register values is
essentially the same when the register is realized as sparse array
element or entry in |eqtb|. The global variable |sa_chain| is the head
of a linked list of entries saved at the topmost level |sa_level|; the
lists for lowel levels are kept in special save stack entries.
@<Glob...@>=
@!sa_chain: pointer; {chain of saved sparse array entries}
@!sa_level: quarterword; {group level for |sa_chain|}
@ @<Set init...@>=
sa_chain:=null; sa_level:=level_zero;
@ The individual saved items are kept in pointer or word nodes similar
to those used for the array elements: a word node with value zero is,
however, saved as pointer node with the otherwise impossible |sa_index|
value |tok_val_limit|.
@d sa_loc==sa_ref {location of saved item}
@<Declare \eTeX\ procedures for tr...@>=
procedure sa_save(@!p:pointer); {saves value of |p|}
var q:pointer; {the new save node}
@!i:quarterword; {index field of node}
begin if cur_level<>sa_level then
begin check_full_save_stack; save_type(save_ptr):=restore_sa;
save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
end;
i:=sa_index(p);
if i<dimen_val_limit then
begin if sa_int(p)=0 then
begin q:=get_node(pointer_node_size); i:=tok_val_limit;
end
else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
end;
sa_ptr(q):=null;
end
else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
end;
sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
end;
@ @<Declare \eTeX\ procedures for tr...@>=
procedure sa_destroy(@!p:pointer); {destroy value of |p|}
begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
else if sa_ptr(p)<>null then
if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
else delete_token_ref(sa_ptr(p));
end;
@ The procedure |sa_def| assigns a new value to sparse array elements,
and saves the former value if appropriate. This procedure is used only
for skip, muskip, box, and token list registers. The counterpart of
|sa_def| for count and dimen registers is called |sa_w_def|.
@d sa_define(#)==if e then
if global then gsa_def(#)@+else sa_def(#)
else define
@#
@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
begin find_sa_element(box_val,cur_val,true);
if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
end
@#
@d sa_word_define(#)==if e then
if global then gsa_w_def(#)@+else sa_w_def(#)
else word_define(#)
@<Declare \eTeX\ procedures for tr...@>=
procedure sa_def(@!p:pointer;@!e:halfword);
{new data for sparse array elements}
begin add_sa_ref(p);
if sa_ptr(p)=e then
begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
sa_destroy(p);
end
else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
sa_lev(p):=cur_level; sa_ptr(p):=e;
@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
end;
delete_sa_ref(p);
end;
@#
procedure sa_w_def(@!p:pointer;@!w:integer);
begin add_sa_ref(p);
if sa_int(p)=w then
begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
end
else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
if sa_lev(p)<>cur_level then sa_save(p);
sa_lev(p):=cur_level; sa_int(p):=w;
@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
end;
delete_sa_ref(p);
end;
@ The |sa_def| and |sa_w_def| routines take care of local definitions.
@^global definitions@>
Global definitions are done in almost the same way, but there is no need
to save old values, and the new value is associated with |level_one|.
@<Declare \eTeX\ procedures for tr...@>=
procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
begin add_sa_ref(p);
@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
delete_sa_ref(p);
end;
@#
procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
begin add_sa_ref(p);
@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
sa_lev(p):=level_one; sa_int(p):=w;
@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
delete_sa_ref(p);
end;
@ The |sa_restore| procedure restores the sparse array entries pointed
at by |sa_chain|
@<Declare \eTeX\ procedures for tr...@>=
procedure sa_restore;
var p:pointer; {sparse array element}
begin repeat p:=sa_loc(sa_chain);
if sa_lev(p)=level_one then
begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
@!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
end
else begin if sa_index(p)<dimen_val_limit then
if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
else sa_int(p):=0
else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
end;
sa_lev(p):=sa_lev(sa_chain);
@!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
end;
delete_sa_ref(p);
p:=sa_chain; sa_chain:=link(p);
if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
else free_node(p,pointer_node_size);
until sa_chain=null;
end;
@ When the value of |last_line_fit| is positive, the last line of a
(partial) paragraph is treated in a special way and we need additional
fields in the active nodes.
@d active_node_size_extended=5 {number of words in extended active nodes}
@d active_short(#)==mem[#+3].sc {|shortfall| of this line}
@d active_glue(#)==mem[#+4].sc {corresponding glue stretch or shrink}
@<Glob...@>=
@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph}
@!do_last_line_fit:boolean; {special algorithm for last line of paragraph?}
@!active_node_size:small_number; {number of words in active nodes}
@!fill_width:array[0..2] of scaled; {infinite stretch components of
|par_fill_skip|}
@!best_pl_short:array[very_loose_fit..tight_fit] of scaled; {|shortfall|
corresponding to |minimal_demerits|}
@!best_pl_glue:array[very_loose_fit..tight_fit] of scaled; {corresponding
glue stretch or shrink}
@ The new algorithm for the last line requires that the stretchability
|par_fill_skip| is infinite and the stretchability of |left_skip| plus
|right_skip| is finite.
@<Check for special...@>=
do_last_line_fit:=false; active_node_size:=active_node_size_normal;
{just in case}
if last_line_fit>0 then
begin q:=glue_ptr(last_line_fill);
if (stretch(q)>0)and(stretch_order(q)>normal) then
if (background[3]=0)and(background[4]=0)and(background[5]=0) then
begin do_last_line_fit:=true;
active_node_size:=active_node_size_extended;
fill_width[0]:=0; fill_width[1]:=0; fill_width[2]:=0;
fill_width[stretch_order(q)-1]:=stretch(q);
end;
end
@ @<Other local variables for |try_break|@>=
@!g:scaled; {glue stretch or shrink of test line, adjustment for last line}
@ Here we initialize the additional fields of the first active node
representing the beginning of the paragraph.
@<Initialize additional fields of the first active node@>=
begin active_short(q):=0; active_glue(q):=0;
end
@ Here we compute the adjustment |g| and badness |b| for a line from |r|
to the end of the paragraph. When any of the criteria for adjustment is
violated we fall through to the normal algorithm.
The last line must be too short, and have infinite stretch entirely due
to |par_fill_skip|.
@<Perform computations for last line and |goto found|@>=
begin if (active_short(r)=0)or(active_glue(r)<=0) then goto not_found;
{previous line was neither stretched nor shrunk, or was infinitely bad}
if (cur_active_width[3]<>fill_width[0])or@|
(cur_active_width[4]<>fill_width[1])or@|
(cur_active_width[5]<>fill_width[2]) then goto not_found;
{infinite stretch of this line not entirely due to |par_fill_skip|}
if active_short(r)>0 then g:=cur_active_width[2]
else g:=cur_active_width[6];
if g<=0 then goto not_found; {no finite stretch resp.\ no shrink}
arith_error:=false; g:=fract(g,active_short(r),active_glue(r),max_dimen);
if last_line_fit<1000 then g:=fract(g,last_line_fit,1000,max_dimen);
if arith_error then
if active_short(r)>0 then g:=max_dimen@+else g:=-max_dimen;
if g>0 then
@<Set the value of |b| to the badness of the last line for stretching,
compute the corresponding |fit_class, and |goto found||@>
else if g<0 then
@<Set the value of |b| to the badness of the last line for shrinking,
compute the corresponding |fit_class, and |goto found||@>;
not_found:end
@ These badness computations are rather similar to those of the standard
algorithm, with the adjustment amount |g| replacing the |shortfall|.
@<Set the value of |b| to the badness of the last line for str...@>=
begin if g>shortfall then g:=shortfall;
if g>7230584 then if cur_active_width[2]<1663497 then
begin b:=inf_bad; fit_class:=very_loose_fit; goto found;
end;
b:=badness(g,cur_active_width[2]);
if b>12 then
if b>99 then fit_class:=very_loose_fit
else fit_class:=loose_fit
else fit_class:=decent_fit;
goto found;
end
@ @<Set the value of |b| to the badness of the last line for shr...@>=
begin if -g>cur_active_width[6] then g:=-cur_active_width[6];
b:=badness(-g,cur_active_width[6]);
if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
goto found;
end
@ Vanishing values of |shortfall| and |g| indicate that the last line is
not adjusted.
@<Adjust \(t)the additional data for last line@>=
begin if cur_p=null then shortfall:=0;
if shortfall>0 then g:=cur_active_width[2]
else if shortfall<0 then g:=cur_active_width[6]
else g:=0;
end
@ For each feasible break we record the shortfall and glue stretch or
shrink (or adjustment).
@<Store \(a)additional data for this feasible break@>=
begin best_pl_short[fit_class]:=shortfall; best_pl_glue[fit_class]:=g;
end
@ Here we save these data in the active node representing a potential
line break.
@<Store \(a)additional data in the new active node@>=
begin active_short(q):=best_pl_short[fit_class];
active_glue(q):=best_pl_glue[fit_class];
end
@ @<Print additional data in the new active node@>=
begin print(" s="); print_scaled(active_short(q));
if cur_p=null then print(" a=")@+else print(" g=");
print_scaled(active_glue(q));
end
@ Here we either reset |do_last_line_fit| or adjust the |par_fill_skip|
glue.
@<Adjust \(t)the final line of the paragraph@>=
if active_short(best_bet)=0 then do_last_line_fit:=false
else begin q:=new_spec(glue_ptr(last_line_fill));
delete_glue_ref(glue_ptr(last_line_fill));
width(q):=width(q)+active_short(best_bet)-active_glue(best_bet);
stretch(q):=0; glue_ptr(last_line_fill):=q;
end
@ When reading \.{\\patterns} while \.{\\savinghyphcodes} is positive
the current |lc_code| values are stored together with the hyphenation
patterns for the current language. They will later be used instead of
the |lc_code| values for hyphenation purposes.
The |lc_code| values are stored in the linked trie analogous to patterns
$p_1$ of length~1, with |hyph_root=trie_r[0]| replacing |trie_root| and
|lc_code(p_1)| replacing the |trie_op| code. This allows to compress
and pack them together with the patterns with minimal changes to the
existing code.
@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|}
@<Initialize table entries...@>=
hyph_root:=0; hyph_start:=0;
@ @<Store hyphenation codes for current language@>=
begin c:=cur_lang; first_child:=false; p:=0;
repeat q:=p; p:=trie_r[q];
until (p=0)or(c<=so(trie_c[p]));
if (p=0)or(c<so(trie_c[p])) then
@<Insert a new trie node between |q| and |p|, and
make |p| point to it@>;
q:=p; {now node |q| represents |cur_lang|}
@<Store all current |lc_code| values@>;
end
@ We store all nonzero |lc_code| values, overwriting any previously
stored values (and possibly wasting a few trie nodes that were used
previously and are not needed now). We always store at least one
|lc_code| value such that |hyph_index| (defined below) will not be zero.
@<Store all current |lc_code| values@>=
p:=trie_l[q]; first_child:=true;
for c:=0 to 255 do
if (lc_code(c)>0)or((c=255)and first_child) then
begin if p=0 then
@<Insert a new trie node between |q| and |p|, and
make |p| point to it@>
else trie_c[p]:=si(c);
trie_o[p]:=qi(lc_code(c));
q:=p; p:=trie_r[q]; first_child:=false;
end;
if first_child then trie_l[q]:=0@+else trie_r[q]:=0
@ We must avoid to ``take'' location~1, in order to distinguish between
|lc_code| values and patterns.
@<Pack all stored |hyph_codes|@>=
begin if trie_root=0 then for p:=0 to 255 do trie_min[p]:=p+2;
first_fit(hyph_root); trie_pack(hyph_root);
hyph_start:=trie_ref[hyph_root];
end
@ The global variable |hyph_index| will point to the hyphenation codes
for the current language.
@d set_hyph_index== {set |hyph_index| for current language}
if trie_char(hyph_start+cur_lang)<>qi(cur_lang)
then hyph_index:=0 {no hyphenation codes for |cur_lang|}
else hyph_index:=trie_link(hyph_start+cur_lang)
@#
@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
if hyph_index=0 then hc[0]:=lc_code(#)
else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0
else hc[0]:=qo(trie_op(hyph_index+#))
@<Glob...@>=
@!hyph_start:trie_pointer; {root of the packed trie for |hyph_codes|}
@!hyph_index:trie_pointer; {pointer to hyphenation codes for |cur_lang|}
@ When |saving_vdiscards| is positive then the glue, kern, and penalty
nodes removed by the page builder or by \.{\\vsplit} from the top of a
vertical list are saved in special lists instead of being discarded.
@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder}
@d page_disc==disc_ptr[last_box_code] {first item removed by page builder}
@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}}
@<Glob...@>=
@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers}
@ @<Set init...@>=
page_disc:=null; split_disc:=null;
@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
distinguished by their |chr_code| values |last_box_code| and
|vsplit_code|. These |chr_code| values are larger than |box_code| and
|copy_code|.
@<Generate all \eTeX...@>=
primitive("pagediscards",un_vbox,last_box_code);@/
@!@:page_discards_}{\.{\\pagediscards} primitive@>
primitive("splitdiscards",un_vbox,vsplit_code);@/
@!@:split_discards_}{\.{\\splitdiscards} primitive@>
@ @<Cases of |un_vbox| for |print_cmd_chr|@>=
else if chr_code=last_box_code then print_esc("pagediscards")
else if chr_code=vsplit_code then print_esc("splitdiscards")
@ @<Handle saved items and |goto done|@>=
begin link(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null;
goto done;
end
@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
and \.{\\displaywidowpenalties} commands allow to define arrays of
penalty values to be used instead of the corresponding single values.
@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc)
@d club_penalties_ptr==equiv(club_penalties_loc)
@d widow_penalties_ptr==equiv(widow_penalties_loc)
@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc)
@<Generate all \eTeX...@>=
primitive("interlinepenalties",set_shape,inter_line_penalties_loc);@/
@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@>
primitive("clubpenalties",set_shape,club_penalties_loc);@/
@!@:club_penalties_}{\.{\\clubpenalties} primitive@>
primitive("widowpenalties",set_shape,widow_penalties_loc);@/
@!@:widow_penalties_}{\.{\\widowpenalties} primitive@>
primitive("displaywidowpenalties",set_shape,display_widow_penalties_loc);@/
@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@>
@ @<Cases of |set_shape| for |print_cmd_chr|@>=
inter_line_penalties_loc: print_esc("interlinepenalties");
club_penalties_loc: print_esc("clubpenalties");
widow_penalties_loc: print_esc("widowpenalties");
display_widow_penalties_loc: print_esc("displaywidowpenalties");
@ @<Fetch a penalties array element@>=
begin scan_int;
if (equiv(m)=null)or(cur_val<0) then cur_val:=0
else begin if cur_val>penalty(equiv(m)) then cur_val:=penalty(equiv(m));
cur_val:=penalty(equiv(m)+cur_val);
end;
end
@* \[54] System-dependent changes.
@z
@x l.24904
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.
@y
Here are the remaining changes to the program
that are necessary to make \TeX\ work on VMS. Note that especial care
has been taken not to introduce any new sections; therefore, everything up
to this point has had the same section numbers as the canonical versions in
``\TeX: The Program''.
Firstly, putting the cart before the horse, this is how we can return the final
status of \TeX\ to the operating system, in such a way that DCL command
procedures and the like can determine whether the run of \TeX\ was successfull
or not. We use the \.{\$EXIT} system service; the value of its parameter is
@.{\$}EXIT@>
given by an appropriate symbolic constant taken from the \.{starlet} library.
We also take this opportunity to call the |symbol_jobname| routine (defined
below).
@d VAX_exit==@=$exit@>
@d VAX_ss_normal==@= sts$k_success @>
@d VAX_ss_ignore==@= sts$m_inhib_msg @>
@d VAX_ss_warning==@= sts$k_warning+sts$m_inhib_msg @>
@d VAX_ss_error==@= sts$k_error+sts$m_inhib_msg @>
@d VAX_ss_fatal==@= sts$k_severe+sts$m_inhib_msg @>
@<Exit to operating system with final status@>=
symbol_jobname;
case history of { Issue an appropriate VAX exit status }
spotless: VAX_exit(VAX_ss_normal); { Everything OK! }
warning_issued: VAX_exit(VAX_ss_warning);
error_message_issued: VAX_exit(VAX_ss_error);
fatal_error_stop: VAX_exit(VAX_ss_fatal)
endcases
@ |symbol_jobname| is a routine which takes the |job_name| string and the
numeric portion of the extension of the output file and writes that information
to the DCL symbol given by \.{/JOBNAME\_SYMBOL}.
@./JOBNAME_SYMBOL@>
The code here is based on code
donated by Jim Walker of South Carolina University.
@d VAX_set_symbol == @= lib$set_symbol @>
@<Last-minute ...@>=
procedure@?VAX_set_symbol(VAX_immed symbol: descr_ptr;
VAX_immed value_string: descr_ptr;
tbl_ind: integer := VAX_immed 0); external; @t\2@>
@#
procedure symbol_jobname;
var tmp_descr: descr_ptr;
begin tmp_descr:=nil;
if job_qual then begin
str_to_descr(job_name,tmp_descr);
VAX_set_symbol (VAX_stdescr l_jobname, tmp_descr, 2);
end;
end;
@ Support is provided for the \.{REVIEW} mode of DEC's Language-sensitive
editor,
@^Language-sensitive editor@>
@^LSE@>
by generating a \.{.dia} file. Any output sent via this routine is also repeated
to that file if the global |copy_err| is |print_it|: if the characters are being
``repeated'' to produce a \.{label} for a \.{region/text} directive, then
characters will only be copied if no more than |label_max| have been output;
this is controlled by |label_size|. Negative values for this variable always
permit printing.
Since \TeX\ produces its error messages by many separate calls to various
printing routines, we accumulate the full text in the \PASCAL\ internal file
|temp_file| when |copy_err| is set to |save_it|. This file can later be |reset|
and ``played back'' by standard \PASCAL\ routines.
@d label_max=14
@<Save printed character for diagnostic messages@>=
case copy_err of
print_it: begin if label_size<> 0 then diag_char(s);
if label_size>0 then decr(label_size)
end;
ignore_it: do_nothing;
save_it: temp_char(s)
endcases
@ We introduce here variables which control the action of error reporting
routines. When error message display is commenced, the variable |copy_err| is
set to |save_it|: this causes parts of the error message to be saved in
the internal file |temp_file|, which is rewound at this point. Certain parts of
the error message are not so saved (|copy_err=ignore_it|). This variable is
also used to cause messages to be written (|copy_err=print_it|) to the
diagnostics file |diag_file|. Since VAX-\PASCAL\ supports proper enumeration
types, we don't bother with defining numeric constants for this.
When information is being written to the |diag_file|, we restrict the ``label''
portion of a diagnostic message to |label_max| characters, to preserve on-screen
alignment in LSEdit's \.{REVIEW} buffer. Characters are only output through to
the |diag_file| if |label_size| is non-zero, and this variable is decremented
after each character has been output if it is positive. Thus negative values of
|label_size| do not impose any restriction on the amount of text that may be
output to the |diag_file|.
@<Glob...@>=
@!copy_err:(ignore_it,print_it,save_it);
@!label_size:-1..label_max; {Restricts ``printing'' in the \.{.dia} file}
@ After the terminating period has been written, |copy_err| is reset to
prevent further output to |temp_file|, which is also reset, ready to be
``replayed'' into the diagnostics file itself.
This code is also used during initialization, and also before prompting for a
new file name when \TeX\ has been unable to find a users' file.
@<Ensure |temp_file| not in use@>=
copy_err:=ignore_it; reset(temp_file) {Full \TeX\ message in |temp_file|}
@ Every error message that \TeX\ creates is ``wrapped'' into a \.{diagnostic}
environment for use by LSE's \.{REVIEW} mode.
This is the text generated for the start of such an environment.
@<Commence an LSE diagnostic report@>=
wdiag_ln('!');
wdiag_ln(' start diagnostic')
@ And this finishes off the \.{diagnostic} environment: we copy into it the
informational part of \TeX's own error message.
@<Terminate an LSE diagnostic report@>=
wdiag(' message "%TEX-E-TEXERROR, ');
while not eof(temp_file) do
begin wdiag(temp_file^); get(temp_file) end;
wdiag_ln('"');
wdiag_ln(' end diagnostic')
@ If the error report arises within the expansion of a macro, \TeX\ will report
the expansions of all macros and arguments involved: each such line of
information is used in the diagnostics file as a \.{label} (in the terminology
of LSE's \.{REVIEW} mode). This is how we start it off, and ensure that no more
than |label_max| characters are printed, thus preserving alignment of the text
within the \.{\$REVIEW} buffer.
@<Output the location to the diagnostics file@>=
wdiag(' region/text/label="');
copy_err:=print_it; label_size:=label_max
@ The rest of the context (display of macro expansions, or whatever) forms the
remainder of the diagnostic region label.
@<Prepare to copy tokens to the diagnostic region@>=
copy_err:=ignore_it; wdiag('" "')
@ On the other hand, if \TeX's error report specifies a location within a
source file, the diagnostic region generated in the diagnostics file reports
that location thus:
@<Report location within source file to diagnostics@>=
wdiag(' region/file/primary ');
diag_print(name); wdiag_ln(' -'); {Continuation line follows}
wdiag_ln(' /line=',line:1,'/column_range=(1,65535)')
@ Whenever |show_context| involves printing out a token list, we arrange to
capture the printed tokens for our diagnostic file.
@<Include token report within diagnostics file@>=
wdiag(' region/text/label="');
copy_err:=print_it; label_size:=label_max
@ As we write out the second line of the original source, split at the point of
error detection, we don't want to include within the diagnostic file the newline
nor the leading spaces. This looks like horrible duplication of code, but
remember that |copy_err=print_it| \&{only} if a diagnostic file is being
generated.
@<Split the context line display@>=
if copy_err=print_it then
begin
copy_err:=ignore_it;
print_ln;
for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2}
copy_err:=print_it
end
else
begin
print_ln;
for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2}
end
@ After we've completed the display of the error context, we are able to
complete the diagnostic region within the diagnostics file.
@<Indicate offending character@>=
if copy_err=print_it then
begin
wdiag('"/line=1/column_range=(');
n:=n-l;
wdiag_ln(n+1:1,',65535)');
copy_err:=ignore_it;
end
else
wdiag_ln(' region/nested/column=',loc-start+1:1)
@ When we are writing the remainder of the context to the terminal and/or
transcript file, we need to ensure that it is also \&{all} copied to the
diagnostics file.
The diagnostic is completed by ``playing back'' the contents of the |temp_file|,
which contains \TeX's error message.
@<Copy remainder of context to diagnostic file@>=
begin copy_err:=print_it; label_size:=-1 end
@ When the \.{\string\show} primitive is used, it will later involve the display
of a token; the latter would cause output to be written to the |temp_file| used
for accumulating error messages for the diagnostics file, so we ensure here that
the file will not be overfilled.
@<Clear out the |temp_file|@>=
copy_err:=ignore_it; rewrite(temp_file); {Internal file will later be |reset|}
@ The |open_diag_file| routine is used to open a file into which error
diagnostics are written to support DEC's Language-sensitive Editor (LSEdit).
@^Language-sensitive editor@>
@^LSE@>
These may be used by the latter to locate the editor at the position within
the source file at which an error has been detected.
@<Declare the |open_diag_file| procedure@>=
procedure open_diag_file;
begin
pack_job_name(".dia");
if pack_default_name(diag_qual,diagf_name,diagf_len) then
begin
while not a_open_out(diag_file) do
prompt_file_name("diagnostics file name",".dia");
diag_name:=a_make_name_string(diag_file);
wdiag_ln('start module');
end else
diag_name:=".";
clear_default_name;
end;
@ Here are a number of variables used during the initial extraction of the
command line and its qualifiers. Firstly, we require separate flags for each of
the possible qualifiers.
We also need to declare those variables associated with support for the
diagnostics file, utilized by LSEdit.
@^Language-sensitive editor@>
@^LSE@>
When \TeX\ is producing error messages, they are created in ``dribs and drabs'';
we utilize a \PASCAL\ `internal' file |temp_file| to accumulate the whole
message for transfer to the diagnostics file.
This mechanism is also used to create a command line by means of which an editor
can be invoked by the user answering `\.e' in response to \TeX's error prompt.
Since such invocation of an editor will disrupt access to the values associated
with any qualifiers on the \.{TEX} command, we have to provide storage space for
any values provided with those qualifiers, so that they may be read during the
initialization phase, in preparation for use later (in some cases, much later)
in the program. For each such piece of text, we need somewhere to save it, and
somewhere else to record its length, for use with |pack_default_name|.
@<Glob...@>=
@!format_qual, @!dvi_qual, @!cmd_line_present, @!continue_qual, @!eight_qual,
@!job_qual,@!batch_qual, @!log_qual, @!diag_qual, @!edit_qual : boolean;
@#
@!diag_file : alpha_file;
@!diag_name : str_number;
@!temp_file : alpha_file;
@#
@!logf_name, @!diagf_name, @!edit_name, @!l_jobname,
@!dvif_name : packed array[1..file_name_size] of char;
@!logf_len, @!diagf_len, @!edit_len, @!l_len_name, @!dvif_len : file_size;
@ Since we provide a command-line qualifier which will ``preload'' a format
file, it would be best to extract all the qualifiers before the |banner| gets
printed, so that the correct preloaded format can be displayed (it will never
{\it really\/} be preloaded, but a VAX doesn't take long to read a \.{.FMT}
file!) In fact, it is {\it essential\/} that all command-line qualifiers be
read at this stage; the reader might imagine that extraction of qualifiers
and their values could be deferred until the point at which the qualifier is
used, but any intervening activation of another image (for example, an editor)
results in the information being wiped out.
The |cmd_line_present| flag will later avoid clearing the |buffer| if a
command-line has already been ``read'' into it. We can control \TeX's operation
in |batch_mode| through the \.{/BATCH} qualifier.
At this point, we also initialize |copy_err|, which controls the insertion into
the diagnostics file of text being (pseudo)printed in traditional \TeX\ error
message.
@<Extract command-line and qualifiers@>=
diag_name := 0;
get_command_line;
if batch_qual then interaction:=batch_mode;
copy_err:=ignore_it@;
@ For interacting with a user-supplied command line, we need to call the VAX
standard library routines \.{CLI\$PRESENT}, \.{CLI\$GET\_VALUE},
\.{CLI\$DCL\_PARSE} and \.{LIB\$GET\_FOREIGN}.
@.CLI{\$}PRESENT@>
@.CLI{\$}GET_VALUE@>
@.CLI{\$}DCL_PARSE@>
@.LIB{\$}GET_FOREIGN@>
This is a definition of their external interfaces: note the application of the
`external' attribute, and use of the |extern| directive.
@d VAX_external==@= external@>
@d VAX_asynchronous==@= asynchronous@>
@d VAX_cli_dcl_parse==@= cli$dcl_parse@>
@d VAX_lib_get_foreign==@= lib$get_foreign@>
@d VAX_lib_sig_to_ret==@= lib$sig_to_ret@>
@d VAX_establish==@= establish@>
@<VMS procedures@>=
[VAX_external] function VAX_cli_present(@/
VAX_stdescr @!entity: [VAX_volatile,VAX_readonly]
packed array [l1..u1:integer] of char
:= VAX_immed 0) : integer; @/
extern;@;@t\2@>@#
[VAX_external] function VAX_cli_get_value(@/
VAX_stdescr @!entity: [VAX_volatile,VAX_readonly]
packed array [l1..u1:integer] of char
:= VAX_immed 0;
VAX_stdescr @!returns: [VAX_volatile]
packed array [l2..u2:integer] of char
:= VAX_immed 0;
var @!retlen: [VAX_volatile] sixteen_bits := VAX_immed 0):integer; @/
extern;@;@t\2@>@#
[VAX_external] function VAX_cli_dcl_parse(@/
VAX_stdescr @!cmdline: [VAX_volatile,VAX_readonly]
packed array [l1..u1:integer] of char
:= VAX_immed 0;
VAX_immed @!cld_table: [VAX_volatile,VAX_readonly]
VAX_unsigned
:= VAX_immed 0):integer; @/
extern;@;@t\2@>@#
[VAX_external] function VAX_lib_get_foreign(@/
VAX_stdescr @!cmdlin: [VAX_volatile] packed array [l1..u1:integer] of char
:= VAX_immed 0;
VAX_stdescr @!prompt: [VAX_volatile] packed array [l2..u2:integer] of char
:= VAX_immed 0;
var @!len: [VAX_volatile] sixteen_bits := VAX_immed 0;
var @!flag: [VAX_volatile] integer := VAX_immed 0)
:integer; @/
extern;@;@t\2@>@#
[VAX_external, VAX_asynchronous] function VAX_lib_sig_to_ret(@/
VAX_ref @!signal_args: [VAX_volatile,VAX_unsafe]
array [l1..u1:integer] of [VAX_byte] eight_bits;
VAX_ref @!mechan_args: [VAX_volatile,VAX_unsafe]
array [l2..u2:integer] of [VAX_byte] eight_bits)
:integer; @/
extern;
@ The following global symbol is used to refer to the command definition
table linked into the \TeX\ program
@d eTeX_CLD_table == @=ETEX_CLI@>
@<Glob...@>=
@!eTeX_CLD_table : [VAX_external, VAX_readonly] VAX_unsigned;
@ The |init_cli| function is invoked right at the beginning of \TeX,
only preceded by the terminal output initialization. Its purpose
is to make sure that the DCL command interface is available.
This function checks, if the program was invoked by the DCL command
specified through |verb_name| and that a command
qualifier specified by |qual_name| is present (or defaulted) in the
command description. For the second test, a small subroutine |check_cli|
is needed, because of the "caller--callee" dependence required by
the user error handler facility.
The |verb_name| string supplied to |init_cli| by the caller must not
exceed a length of 4, otherwise the comparison with the "last DCL command"
does never succeed, because the DCL parser truncates commands to a length
of 4!
The test item |qual_name| should be a specific, non-negatable command
qualifier for the verb |verb_name|, which is set by default in the command
description.
If either of these two tests fail, it can be assumed that the program
was invoked as a foreign command (or started by the RUN command).
If this case, the command line tail is fetched with the
\.{LIB\$GET\_FOREIGN} runtime functions and parsed internally,
using the \.{CLI\$DCL\_PARSE} utility routine and the command table
linked into the program executable, whose name is supplied by the
|table| formal parameter.
@.LIB{\$}GET_FOREIGN@>
@.CLI{\$}DCL_PARSE@>
@<Last-minute procedures@>=
function init_cli(
var @!table:[VAX_readonly] VAX_unsigned;
@!verb_name:[VAX_readonly] packed array[l1..u1:integer] of char;
@!qual_name:[VAX_readonly] packed array[l2..u2:integer] of char
): integer;
label exit;
var command_line: packed array[1..256] of char;
@!len: sixteen_bits;
@!sts: integer;
function check_cli(
@!unique_def_qual:[VAX_readonly] packed array[l1..u1:integer] of char
): integer;
begin
VAX_establish(VAX_lib_sig_to_ret);
check_cli := VAX_cli_present(unique_def_qual);
end;
begin
sts := VAX_cli_get_value('$VERB',command_line,len);
if (odd(sts) and (len > 0)) then
if (VAX_substr(command_line,1,len) = verb_name) then
if (odd(check_cli(qual_name))) then
begin
init_cli := 1;
return;
end;
VAX_lib_get_foreign(command_line,,len);
{prepend |verb_name| plus a blank to |command_line|}
command_line := verb_name + ' ' + VAX_substr(command_line,1,len);
init_cli := VAX_cli_dcl_parse(command_line, VAX_address_of(table));
exit:end;
@ Logically, the following procedure belongs with |init_terminal|; however,
we can't declare it there because it calls functions which don't get
declared until later, so we'll stuff it in just before the main program starts.
If an editor is invoked later, its use of the command-line interface parsing
routines will ``disable communications'', so we'd better extract any values
associated with qualifiers now. The various flags are set or cleared according
as to whether the associated qualifier is or is not present.
@<Last-minute procedures@>=
procedure get_command_line;
var qual_argument: packed array[1..256] of char;
@!len: sixteen_bits;
@!i: integer;
@!j: 0..buf_size;
begin
cmd_line_present := odd(VAX_cli_present('COMMAND_LINE'));
edit_qual := odd(VAX_cli_present('EDITOR'));
if edit_qual then VAX_cli_get_value('EDITOR',edit_name,edit_len);
job_qual:=odd(VAX_cli_present('JOBNAME_SYMBOL'));
if job_qual then VAX_cli_get_value('JOBNAME_SYMBOL',l_jobname,l_len_name);
continue_qual := odd(VAX_cli_present('CONTINUE'));
batch_qual := odd(VAX_cli_present('BATCH'));
dvi_qual := odd(VAX_cli_present('OUTPUT'));
if dvi_qual then VAX_cli_get_value('OUTPUT',dvif_name,dvif_len);
log_qual := odd(VAX_cli_present('LOG_FILE'));
if log_qual then VAX_cli_get_value('LOG_FILE',logf_name,logf_len);
diag_qual := odd(VAX_cli_present('DIAGNOSTICS'));
if diag_qual then VAX_cli_get_value('DIAGNOSTICS',diagf_name,diagf_len);
format_qual := odd(VAX_cli_present('FORMAT'));
if format_qual then
begin
VAX_cli_get_value('FORMAT',qual_argument,len);
loc := 0; buffer[0] := xord['&']; j := 1;
for i := 1 to len do
begin
buffer[j] := xord[qual_argument[i]]; incr(j)
end;
buffer[j] := xord[' ']; { |open_fmt_file| requires space after name }
if format_ident <> 0 then initialize;
if not open_fmt_file then goto final_end;
if not load_fmt_file then
begin
w_close(fmt_file); goto final_end;
end;
w_close(fmt_file);
end;
end;
@ Here are the things we need for |byte_file| and |word_file| files:
@<Glob...@>=
@!tfm_count: 0..VAX_block_length;
@!fmt_count: 0..VAX_block_length;
@ Here's the interrupt stuff.
At this point, we define some attributes for specifying particular sizes and
alignments of numerical quantities in VAX-\PASCAL.
@d VAX_word==@= word @>
@d VAX_longword==@= long @>
@d VAX_byte==@= byte @>
@d VAX_unsigned==@= unsigned @>
@<Types...@>=
@!signed_halfword=[VAX_word] -32768..32767;
@!sixteen_bits=[VAX_word] 0..65535;
@!file_size=[VAX_word] 0..file_name_size;
@#
@!VAX_F_float = packed record {Bit pattern layout of F-Floating Reals}
@!Frac1 : 0..127; {the 7 MSBits of the mantissa}
@!Expo : 0..255; {8 bit exponent}
@!Sign : boolean; {1 sign bit}
@!Frac : 0..65535; {the 16 lower bits of the mantissa}
end;
@ @<Glob...@>=
@!res: [VAX_volatile] integer;
@!tt_chan: [VAX_volatile] signed_halfword;
@ @<VMS procedures@>=
[VAX_asynchronous] procedure @!ctrlc_rout;
begin
interrupt:=1;
enable_control_C;
end;
@ Here is the stuff for magic file operations.
@d VAX_FAB_type==@= FAB$type @>
@d VAX_RAB_type==@= RAB$type @>
@d VAX_NAM_type==@= NAM$type @>
@<Types...@>=
@!unsafe_file = [VAX_unsafe] file of char;
@!FAB_ptr = ^VAX_FAB_type;
@!RAB_ptr = ^VAX_RAB_type;
@!NAM_ptr = ^VAX_NAM_type;
@!chrptr = ^char;
@ We supply the following two routines to be used (in a call of the VAX-\PASCAL\
|open| procedure) as a |user_action| function. When called from within the
|open| routine, the addresses of the |FAB| and |RAB| allocated to the file are
passed to such a function, along with the file variable; the latter is tagged as
`unsafe' to prevent undesirable compiler optimizations.
The |user_reset| function, used to open files for reading, performs
wild card expansion on the file specification and opens the first matching
file.
Both |user_action| functions copy the fully qualified name of the file
that was actually opened into the global variable |last_name|. Additionally,
the basename part of the filename is available in the string variable
|last_basename|. The latter string is converted to lowercase; to comply
with normal usage on other (case-sensitive) operating systems.
The two external functions |VAX_PAS_FAB| and |VAX_PAS_RAB| permit access by the
program to these structures after the file has been opened.
@d VAX_rms_parse==@=$parse@>
@d VAX_rms_search==@=$search@>
@d VAX_rms_create==@=$create@>
@d VAX_rms_connect==@=$connect@>
@d VAX_rms_open==@=$open@>
@#
@d VAX_FAB_V_NAM== @=FAB$V_NAM@>
@d VAX_FAB_L_NAM== @=FAB$L_NAM@>
@d VAX_NAM_B_RSL== @=NAM$B_RSL@>
@d VAX_NAM_L_RSA== @=NAM$L_RSA@>
@d VAX_NAM_B_NAME== @=NAM$B_NAME@>
@d VAX_NAM_L_NAME== @=NAM$L_NAME@>
@<VMS procedures@>=
function user_reset
(var FAB:VAX_FAB_type;
var RAB:VAX_RAB_type;
var F:unsafe_file):integer;
label done;
var sts:integer; @!NAM:NAM_ptr; @!p:chrptr; @!i:integer; @!ichr:integer;
begin
last_length:=0;
sts:=VAX_rms_parse(FAB);
if not odd(sts) then goto done;
sts:=VAX_rms_search(FAB);
if odd(sts) then
FAB.VAX_FAB_V_NAM:=true; {Use |NAM| block in |VAX_rms_open| call!}
sts:=VAX_rms_open(FAB);
if not odd(sts) then goto done;
sts:=VAX_rms_connect(RAB);
if not odd(sts) then goto done;
NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr;
if NAM=nil then goto done;
last_length:=NAM^.VAX_NAM_B_RSL;
for i:=1 to last_length do begin
p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::chrptr;
last_name[i]:=p^;
end;
last_basenam_len:=NAM^.VAX_NAM_B_NAME;
for i:=1 to last_basenam_len do begin
p:=(NAM^.VAX_NAM_L_NAME::integer+i-1)::chrptr;
ichr:=ord(p^);
if (ichr > 64) and (ichr < 91) then ichr := ichr+32;
last_basename[i]:=chr(ichr);
end;
done: user_reset:=sts;
end;
@#
function user_rewrite
(var FAB:VAX_FAB_type;
var RAB:VAX_RAB_type;
var F:unsafe_file):integer;
label done;
var sts:integer; @!NAM:NAM_ptr; @!p:chrptr; @!i:integer; @!ichr:integer;
begin
sts:=VAX_rms_create(FAB);
if not odd(sts) then goto done;
sts:=VAX_rms_connect(RAB);
if not odd(sts) then goto done;
NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr;
if NAM=nil then goto done;
last_length:=NAM^.VAX_NAM_B_RSL;
for i:=1 to last_length do begin
p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::chrptr;
last_name[i]:=p^;
end;
last_basenam_len:=NAM^.VAX_NAM_B_NAME;
for i:=1 to last_basenam_len do begin
p:=(NAM^.VAX_NAM_L_NAME::integer+i-1)::chrptr;
ichr:=ord(p^);
if (ichr > 64) and (ichr < 91) then ichr := ichr+32;
last_basename[i]:=chr(ichr);
end;
done: user_rewrite:=sts;
end;
@#
function VAX_PAS_FAB(var foobar:unsafe_file):FAB_ptr; extern;@;@t\2@>@/
function VAX_PAS_RAB(var foobar:unsafe_file):RAB_ptr; extern;
@ @<Glob...@>=
@!in_FAB,out_FAB: FAB_ptr;
@!in_RAB,out_RAB: RAB_ptr;
@!last_length: integer;
@!last_name:packed array[1..file_name_size] of char;
@!last_basenam_len: integer;
@!last_basename:packed array[1..file_name_size] of char;
@ The following procedure is used to translate any logical name that may appear
as its parameter into its equivalence string and makes use of the \.{\$TRNLNM}
@.{\$}TRNLNM@>
system service in place of the obsolete \.{\$TRNLOG}. If the content of the
@.{\$}TRNLOG@>
buffer is a logical name, it is replaced by its equivalence string and the
routine returns |true|. If no translation can be found, the result is |false|,
and the original string is left unchanged.
The VAX-\PASCAL\ procedure |substr| is used to extract a substring into the
|varying| array which is passed to the system service, whilst another
VAX-specific function |iaddress| is used to obtain the address of various data
items to fill in the |item_list|.
@d VAX_trnlnm==@= $trnlnm@>
@d VAX_lnm_case_blind==@= lnm$m_case_blind @>
@d VAX_lnm_string==@= lnm$_string @>
@#
@d VAX_substr==@= substr@>
@d VAX_address_of==@= iaddress@>
@<VMS procedures@>=
function translate ( var t : packed array [l1..u1 : integer] of char;
var len : signed_halfword): boolean;
var
@!s: varying[file_name_size] of char;
@!trnlnm_return: integer; {what did the \.{\$TRNLNM} return?}
@!return_length: [VAX_volatile] integer;
@!attributes: unsigned;
@!item_list: [VAX_volatile] array [0..1] of VMS_item_list;
begin
s:=VAX_substr(t,1,len);
attributes := VAX_lnm_case_blind;
return_length := 0;
with item_list[0] do
begin
buffer_length := file_name_size;
item_code := VAX_lnm_string;
buffer_addr := VAX_address_of(t);
ret_len_addr := VAX_address_of(return_length);
end;
item_list[1].next_item := 0;
trnlnm_return := VAX_trnlnm(attributes,'LNM$DCL_LOGICAL',s,,item_list);
len := return_length;
translate := trnlnm_return=VAX_ss_normal;
end;
@ Here is a new type introduced to support \.{\$TRNLNM}. Many VMS system
@.{\$}TRNLNM@>
services make use of an |item_list| to pass information in and out. An
|item_list| consists of a number of |item_list| elements, with each element
containing the following fields:
\centerline{\vtop{\offinterlineskip\hrule
\halign{\vrule#\hskip2pt&\strut#\hfil&#\hfil&#\hfil&\hskip2pt\vrule#\cr
height2pt&\omit&\omit&\omit&\cr
&\hfil Name & \hfil Type & \hfil Usage&\cr
height2pt&\omit&\omit&\omit&\cr
\noalign{\hrule}
height2pt&\omit&\omit&\omit&\cr
&|buffer_length| & 16-bit word & Size of buffer&\cr
&|item_code| & unsigned 16-bit word & Code for desired operation&\cr
&|buffer_address| & Pointer to char & Address of buffer&\cr
&|ret_len_addr| & Pointer to integer & To receive length of
translation&\cr
height2pt&\omit&\omit&\omit&\cr}
\hrule
}}
This structure is overlaid with a single 32-bit integer whose use is solely to
hold the value zero indicating the end of the list.
@<Types in the...@>==
@!VMS_item_list =
packed record
case boolean of
true: (
@!buffer_length : sixteen_bits;@/
@!item_code : sixteen_bits;@/
@!buffer_addr : [VAX_longword] integer;@/
@!ret_len_addr : [VAX_longword] integer);
false: (
@!next_item : [VAX_longword] integer)
end;
@ If the user, in response to \TeX's error message, elects to edit the source
file, then we have to find some method of invoking an editor. The simplest
solution, under VMS, is simply to spawn a sub-process, but this is expensive
in terms of image activation and might leave the sub-process short of page file
quota, since the latter is shared by all processes in the current `job'.
Therefore, where possible, we invoke a ``callable'' editor, which merely
requires that we find the relevant editor's entry point in an installed
shareable image. However, the library routine which can perform this trick
returns the entry point as an address, and yet we want the \PASCAL\ code to
think that it's invoking the editor through a procedure call, passing
appropriate parameter(s).
The callable versions of LSEdit
@^Language-sensitive editor@>
@^LSE@>
and TPU each require a single parameter which is
@^TPU@>
@.EDIT/TPU@>
a string similar to the DCL command that could be used to invoke the
non-callable versions. In the case of EDT
@^EDT@>
@.EDIT/EDT@>
@^Callable editors@>
and TECO,
@^TECO@>
@.EDIT/TECO@>
the first parameter gives
the name of the file to be edited, the second (if used) names the output file,
whilst the third can specify the name of a command file. Both editors can also
take further parameters, and their meanings differ, but luckily we don't need
any of these other parameters!
Unfortunately, \PASCAL\ provides no mechanism by which a routine, which has
amongst its formal parameters one which is in turn another routine, may be
called with anything but the name of an \\{actual} routine (with congruent
parameters) substitued for that formal parameter. Therefore, it is not
permissible to pass the address of the routine instead and yet that is all that
we have available!
We therefore provide a procedure which calls, in turn, the actual editor
``procedure'', and resorting to subterfuge, invoke a rather useful VAX Library
Routine:
@d VAX_lib_callg==@= lib$callg@>
@<VMS procedures@>=
[VAX_external] function VAX_lib_callg (@/
VAX_immed arg_list : [VAX_longword] integer;
VAX_immed user_proc: [VAX_longword] integer) : integer;
extern;@t\2@>@#
function call_editor ( @!proc: [VAX_longword] integer;
@!param_1, @!param_3 :
[VAX_volatile] descr_ptr ) : integer;
var
@!call_G_descriptor : packed array [1..4] of [VAX_longword] integer;
begin
call_G_descriptor[1] := 1; {Number of arguments}
call_G_descriptor[2] := param_1::integer; {DCL-like command line or
name of file to be edited}
if param_3 <> nil then
begin
call_G_descriptor[1] := 3; {EDT and TECO require more arguments}
call_G_descriptor[3] := 0; {Default the output file name}
call_G_descriptor[4] := param_3::integer; {Editor command file}
end;
call_editor:=VAX_lib_callg(VAX_address_of(call_G_descriptor),proc)
end;
@ Here is the interface to two routines from the run-time library to handle
dynamic strings. Also, we declare here the interface to the \.{LIB\$SIGNAL}
@.LIB{\$}SIGNAL@>
library function, because we don't have much else to fall back on if an error
crops up whilst allocating strings!
@d str_allocate ==@= str$get1_dx@>
@d str_release ==@= str$free1_dx@>
@d lib_signal ==@= lib$signal@>
@d VAX_char_string==@= dsc$k_dtype_t @>
@d VAX_class_S==@= dsc$k_class_s @>
@d VAX_class_D==@= dsc$k_class_d @>
@<VMS procedures@>=
[VAX_external, VAX_asynchronous] function str_allocate(@/
VAX_ref alloc : [VAX_readonly] sixteen_bits;
VAX_immed descrp : descr_ptr ) : integer;
extern;@t\2@>
@#
[VAX_external, VAX_asynchronous] function str_release(@/
VAX_immed descrp : descr_ptr ) : integer;
extern;@t\2@>
@#
[VAX_external, VAX_asynchronous] procedure lib_signal(@/
VAX_immed cond_code: integer;
VAX_immed num_of_args: integer := VAX_immed 0;
VAX_immed fao_argument: [@=list,unsafe@>] integer );
extern;
@ Some editors require either command or file specifications to be passed to
them as parameters, which in turn requires that they be passed in the form of
string descriptors. Many of the strings that we have to deal with are held
within \TeX's string pool.
This routine converts a \.{WEB}-type string (from the pool) into an appropriate
VAX-\PASCAL\ string descriptor. Any existing string described by |dynam_str| is
returned to the operating system and a new string allocated to reflect the
actual length of the string in |pool_string|.
@<VMS procedures@>=
procedure str_to_descr( @!pool_string : str_number;
var @!dynam_str : [VAX_volatile] descr_ptr);
var @!ch_ptr, @!str_stat : integer;
@!str_size : sixteen_bits;
@!ch_ctr : chrptr;
begin
if dynam_str = nil then
begin
new( dynam_str );
with dynam_str^ do
begin len := 0;
desc_type := VAX_char_string;
desc_class := VAX_class_D;
string := 0
end;
end
else
if dynam_str^.len <> 0 then
begin
str_stat := str_release( dynam_str );
if not odd(str_stat) then lib_signal(str_stat)
end;
ch_ptr := str_start[pool_string];
str_size := str_start[pool_string+1]-str_start[pool_string];
str_stat := str_allocate(str_size,dynam_str);
if not odd(str_stat) then lib_signal(str_stat);
ch_ctr := dynam_str^.string :: chrptr;
while str_size>0 do
begin
ch_ctr^ := xchr[so(str_pool[ch_ptr])];
ch_ctr := (ch_ctr::integer + 1)::chrptr;
incr(ch_ptr);
decr(str_size)
end;
end;
@ Here is where we declare a structure to hold a VMS Descriptor. We could just
have used one of the definitions in the \.{STARLET} library that we've
inherited, but declaring it here is an aid to understanding.
\centerline{\vtop{\offinterlineskip\hrule
\halign{\vrule#\hskip2pt&\strut#\hfil&#\hfil&#\hfil&\hskip2pt\vrule#\cr
height2pt&\omit&\omit&\omit&\cr
&\hfil Name & \hfil Type & \hfil Usage&\cr
height2pt&\omit&\omit&\omit&\cr
\noalign{\hrule}
height2pt&\omit&\omit&\omit&\cr
&|len| & 16-bit word & Elements in the array&\cr
&|desc_type| & unsigned 8-bit byte & Type of items in array&\cr
&|desc_class| & unsigned 8-bit byte & \\{e.g.} Fixed, Varying, Dynamic&\cr
&|string| & Pointer to char & Address of first item in array&\cr
height2pt&\omit&\omit&\omit&\cr}
\hrule
}}
It also makes life much easier, when passing dynamic strings as parameters,
especially to system services and library routines which expect to be passed the
address of such a descriptor, to have a type which is a pointer to such a
descriptor, and then pass the pointer's value by immediate parameter-passing
mechanism.
@<Types...@>=
@!descr_type = packed record {A VAX-descriptor object}
@!len : sixteen_bits;
@!desc_type : eight_bits;
@!desc_class: eight_bits;
@!string : [VAX_longword] integer;
end;
@!descr_ptr = ^descr_type;
@ Here is a procedure to dispose of dynamically-allocated strings when they are
no longer required.
@<VMS proc...@>=
procedure release ( @!string : descr_ptr );
var str_stat : integer;
begin
if string <> nil then
begin
str_stat := str_release( string );
if not odd(str_stat) then lib_signal( str_stat );
dispose(string);
string := nil;
end;
end;
@ This version of \TeX\ supports various editors; that required by the user
must be specified by the qualifier \.{/EDITOR} which is set by default to
\.{TEX\_EDIT} (which should be defined as a VMS logical name, in analogy with
@.TEX_EDIT@>
@.MAIL{\$}EDIT@>
\.{MAIL\$EDIT}---in fact some system managers may want to set the default in
the CLD file to {\it be\/} \.{MAIL\$EDIT}).
If this qualifier specifies one of the strings
`\.{Callable\_LSE}', `\.{Callable\_TPU}', `\.{Callable\_EDT}
@.Callable_xxx@>
or `\.{Callable\_TECO}' (or a logical name translating to one of those
strings), the appropriate
editor is invoked from its callable shared image. Any other value
for \.{/EDITOR} is treated as a DCL command, and a sub-process is spawned in
which the command is executed; the name of the file to be edited, together with
the location of the error, are passed as parameters to this DCL command, which
will most usefully, therefore, be defined to invoke a command procedure.
Because the original version of this change file simply used \.{TEX\_EDIT}
directly and this is the default value, the remainder of this exposition will
simply refer to the value of \.{/EDITOR} as \.{TEX\_EDIT}.
Here is a data structure which holds details of the supported callable editors:
@<Types...@>=
@!editor_ident = record
@!cmd_offset : integer;
@!image, @!entry, @!quitting,
@!exiting, @!cmd_text: str_number;
@!start_qual, @!EDT_like : boolean;
@!logical : packed array[1..file_name_size] of char;
end;
@ We need a suitably sized array of such structures:
@d max_editor=4
@#
@d LSE_editor=1
@d TPU_editor=2
@d EDT_editor=3
@d TECO_editor=4
@<Glob...@>=
@!editor : packed array [1..max_editor] of editor_ident;
@ And we needs must initialize them:
@<Set init...@>=
with editor[LSE_editor] do
begin
logical := 'CALLABLE_LSE';
image := "LSESHR";
entry := "LSE$LSE";
quitting := "TPU$_QUITTING";
exiting := "TPU$_EXITING";
cmd_text := "LSEdit";
cmd_offset := 0;
start_qual:=true;
EDT_like := false;
end;
with editor[TPU_editor] do
begin
logical := 'CALLABLE_TPU';
image := "TPUSHR";
entry := "TPU$TPU";
quitting := "TPU$_QUITTING";
exiting := "TPU$_EXITING";
cmd_text := "EDIT/TPU";
cmd_offset := 5; {Actual command expected by \.{TPU\$TPU} omits \.{EDIT/}}
start_qual:=true;
EDT_like := false;
end;
with editor[EDT_editor] do
begin
logical := 'CALLABLE_EDT';
image := "EDTSHR";
entry := "EDT$EDIT";
quitting := 0;
exiting := 0;
cmd_text := "EDIT/EDT";
cmd_offset := 0;
start_qual:=false;
EDT_like := true;
end;
with editor[TECO_editor] do
begin
logical := 'CALLABLE_TECO';
image := "TECOSHR";
entry := "TECO$EDIT";
quitting := 0;
exiting := 0;
cmd_text := "EDIT/TECO";
cmd_offset := 0;
start_qual := false;
EDT_like := true;
end;
@ When we invoke an editor, there are three (possibly more?) potential outcomes:
(1) The editor cannot be invoked --- perhaps we should find some other method;
(2) The user makes no change to the file (quits); (3) The use produces a new
version of the file. This type allows us to discriminate between these
outcomes:
@<Types...@>=
@!edit_result = (failed,quit,edited);
@ If the user elects to edit the relevant input file in response to an error
message, we prefer to use an editor provided as a ``callable image'', since this
saves the overhead of spawning a sub-process. DEC provide callable versions of
EDT,
@^EDT@>
@.EDIT/EDT@>
@^Callable editors@>
TPU,
@^TPU@>
@.EDIT/TPU@>
LSEdit (the language-sensitive editor, highly recommended for \LaTeX),
@^Language-sensitive editor@>
@^LSE@>
and even for that editor beloved of many, TECO.
@^TECO@>
@.EDIT/TECO@>
To activate such a callable image, we need to load it into the process's \.{P0}
space, and determine its entry point before transferring control to it with
appropriate parameters.
If it proves impossible to load a suitable callable image, we can adopt the
expedient of spawning a new (DCL) sub-process, and pass to it the command to be
executed. When such a spawned sub-process is given a single command to execute,
the exit status of that command is passed back to the parent process when the
sub-process exits. In most useful applications of such a sub-process, the
``command'' to be executed will be a DCL command procedure; the code below will
accept an exit status of $1$ as indicating that an edit has taken place, the
value $0$ (which is of warning severity level) as showing that the edit was
aborted (the user quit), and any other value will be interpreted as indicative
of a failure of the sub-process to perform editing.
The official definition of \.{LIB\$SPAWN} has about a dozen parameters, but
@.LIB{\$}SPAWN@>
since all of them are optional, and we only need to pass a command (which is the
first parameter) and get back the completion status (which is the seventh),
we'll pretend that it only takes seven parameters.
@d VAX_find_image ==@= lib$find_image_symbol@>
@d VAX_lib_spawn ==@= lib$spawn@>
@<VMS procedures@>=
[VAX_external] function VAX_find_image (@/
VAX_immed @!filenm : descr_ptr;
VAX_immed @!symbol : descr_ptr;
VAX_ref @!symbol_value : [VAX_volatile,VAX_longword] integer;
VAX_immed @!image_name : descr_ptr := VAX_immed 0) : integer; @/
extern;@t\2@>
@#
[VAX_external] function VAX_lib_spawn (@/
VAX_immed @!cmd : descr_ptr;
VAX_immed @!sys_input : descr_ptr := VAX_immed 0;
VAX_immed @!sys_output : descr_ptr := VAX_immed 0;
VAX_ref @!flags : [VAX_longword] integer := VAX_immed 0;
VAX_immed @!prcnm : descr_ptr := VAX_immed 0;
VAX_ref @!pid : [VAX_longword] integer := VAX_immed 0;
VAX_ref @!status : [VAX_longword] integer := VAX_immed 0 ): integer; @/
extern;@t\2@>
@# function Edit ( @!filenm, @!cmd_file : str_number;
@!editor : editor_ident ): edit_result;
var @!edit_command_line : descr_ptr;
@!char_ct : sixteen_bits;
@!editor_entry : integer;
@!editor_status, @!str_stat : integer;
@!ch_ptr : chrptr;
@!quit_status, @!exit_status : integer;
@!image_symbol, @!entry_point, @!bad_symbol, @!good_symbol : descr_ptr;
@!edit_file, @!edit_cmd : descr_ptr;
begin
@<Determine length of the editor command@>;
edit_command_line := nil;
@<Copy editor command into dynamic string@>;
edit_file:=nil; edit_cmd:=nil;
if editor.EDT_like then {Such editors take \\{filenames} as parameters}
begin
str_to_descr(filenm,edit_file);
str_to_descr(cmd_file,edit_cmd);
end;
Edit := failed; {Assume the worst!}
editor_status := 4; {Neither edited nor quitted}
quit_status := 0; {Users' command procedures can return this for quitting}
exit_status := VAX_ss_normal;
@<Create names of symbols to be sought@>;
if editor.image <> 0 then {Possibly callable}
begin
if VAX_find_image(image_symbol,entry_point,editor_entry)=VAX_ss_normal
then
@<Load shareable image and call the editor@>
else
editor.image := 0 {Indicate inability to invoke shareable image}
end;
if editor.image = 0 then {Use non-shareable-image editing}
str_stat:=VAX_lib_spawn(cmd:=edit_command_line,status:=editor_status);
@<Dispose of dynamic strings used by |Edit|@>;
@<Interpret exit status of editor@>
end;
@ The data structure |editor| contains pool strings giving the name of the
required shareable image and the names of symbols which are to be sought for in
it. This is where we translate those strings into dynamic ones to be passed to
\.{LIB\$FIND\_IMAGE\_SYMBOL}
@.LIB{\$}FIND_IMAGE_SYMBOL@>
@<Create names of symbols to be sought@>==
image_symbol := nil; entry_point := nil;
bad_symbol := nil; good_symbol := nil;
str_to_descr(editor.image,image_symbol);
str_to_descr(editor.entry,entry_point);
str_to_descr(editor.quitting,bad_symbol);
str_to_descr(editor.exiting,good_symbol)
@ If we're to invoke a callable editor, we have now obtained its entry point,
which will have caused its image to be loaded into the process's \.{P0} space.
Now we find within the image the values associated with the symbols which
indicate whether the editor was used to create a new file or whether the use
quit without creating a new file (only possible for LSEdit and TPU; with EDT and
TECO, we assume that any successful exit resulted in the creation of a new
file).
@<Load shareable image and call the editor@>=
begin
@<Preset anticipated exit statuses of the called editor@>;
if editor.EDT_like then
editor_status:=call_editor(editor_entry,edit_file,edit_cmd)
else
@<Invoke callable LSEdit or TPU@>;
end
@ Just to keep things tidy, we dispose of all dynamic strings used by |Edit|
before exit; this ensures that repeated invocation of an editor will not result
in the ``eating up'' of virtual memory.
@<Dispose of dynamic strings used by |Edit|@>=
release(image_symbol); release(entry_point); release(bad_symbol);
release(good_symbol);
release(edit_command_line); release(edit_file); release(edit_cmd);
@ After the editor, whether running in a spawned sub-process or as a callable
version in a shared image, has returned control to \TeX, we attempt to interpret
its exit status. Having removed any flag instructing the CLI to ignore the
error status (because the editor will have reported such an error already), we
attempt to match the exit status against the values which we have preset as
indicating normal exit or quit from the editor. Any other value will leave the
value |failed| to be returned by |Edit|: this should cause \TeX\ to inform the
user that the edit will have to be performed ``off-line''.
@<Interpret exit status of editor@>=
if editor_status>=VAX_ss_ignore then editor_status:=editor_status-VAX_ss_ignore;
if editor_status = exit_status then Edit := edited
else
if editor_status = quit_status then Edit := quit
@ As well as containing the entry point at which the callable editor should be
entered, its image file may also contain global symbols which give the exit
status which will be returned by the editor if the user exits successfully,
having written a new file, or quits without writing a new file. We extract the
values of these symbols so that this status can be interpreted on exit from this
procedure |Edit|.
@<Preset anticipated exit statuses of the called editor@>=
if editor.quitting<>0 then
if not odd(VAX_find_image(image_symbol,bad_symbol,quit_status)) then
quit_status := VAX_ss_normal;
if editor.exiting<>0 then
if not odd(VAX_find_image(image_symbol,good_symbol,exit_status)) then
exit_status := VAX_ss_normal
@ If we're invoking the callable version of TPU, we have to remove the
`\.{EDIT/}' from the `\.{EDIT/TPU...}' command that we've constructed in
|edit_command_line|. This code removes the first |editor.cmd_offset| characters
of the command by overwriting with spaces, which achieves the desired effect.
We then invoke the editor through |call_editor|.
@<Invoke callable LSEdit or TPU@>=
begin
ch_ptr := edit_command_line^.string :: chrptr;
for char_ct := 1 to editor.cmd_offset do
begin
ch_ptr^ := ' '; {Expunge the first |cmd_offset| characters}
ch_ptr := (ch_ptr::integer + 1)::chrptr
end;
editor_status:=call_editor(editor_entry,edit_command_line,nil);
end
@ So far, we've managed to construct in the |temp_file| a command to be passed
to the callable editor (through appropriate diversion to that \PASCAL\ internal
file during the analysis of the logical \.{TEX\_EDIT}). So that we can allocate
@.TEX_EDIT@>
an appropriately sized dynamic string and its descriptor to be passed to the
callable image, we need initially to determine how long that command really is:
@<Determine length of the editor command@>=
reset(temp_file); char_ct:=1;
while not eof(temp_file) do
begin
get(temp_file); incr(char_ct)
end
@ Now we can allocate the dynamic string to hold the editor command, and copy
the latter into it. Perhaps it might be thought that this could be simplified,
because we could ``replay'' the command from the |temp_file| into a pool string
by setting |selector| to |new_string| and then using |str_to_descr|: however,
I'm not sure that this would be safe if in so doing we exceeded the allocated
string pool, so we're going to do a bit more work!
@<Copy editor command into dynamic string@>=
new( edit_command_line );
with edit_command_line^ do
begin len := 0;
desc_type := VAX_char_string;
desc_class := VAX_class_D;
string := 0
end;
str_stat := str_allocate( char_ct, edit_command_line );
if not odd(str_stat) then lib_signal(str_stat);
ch_ptr := edit_command_line^.string::chrptr;
reset(temp_file);
while not eof(temp_file) do
begin
ch_ptr^ := temp_file^;
get(temp_file);
ch_ptr := (ch_ptr::integer + 1)::chrptr
end
@ Certain VAX callable editors (\.{LSE} and \.{TPU}) accept a qualifier which
may be used to specify the row and column number at which the editor's cursor is
to be positioned. This routine adds suitable characters to the editor command
line currently under construction in |temp_file|.
@<Basic printing...@>=
procedure edit_locate(@!line, @!col : integer);
begin
print("/START_POSITION=("); print_int(line); print_char(",");
print_int(col); print(") ")
end;
@ The function |edit_file| is called from the error reporting routine with the
context of an input file and the
line number as parameters. It forms a command for the desired editor
(making using of |temp_file| and various of the error printing routines).
The function returns |true| if it was able to invoke an editor. If |false| is
returned, the user-interface routine should tell the user what and where to
edit, and exit from \TeX.
First of all, we need to make a forward declaration in order that the code which
interprets the user's response can be compiled to call this procedure.
@<Basic printing...@>=
function edit_file( @!stack_item : in_state_record; line : integer ) : boolean;
forward;
@ But the function itself needs to {\it follow\/} all those declared in \.{WEB}
modules, so we put it just before the main program itself.
To determine what name to use in invoking the editor, this function
attempts to translate the value of \.{/EDITOR}; if the translation is
recognized, then we'll use that as the value, otherwise, we'll use the value
given by \.{/EDITOR}.
If the editing of the file has
(or could have) created a new version of the source file, then steps are taken
to ensure that further edits all access the newly created file(s) rather than
the original.
@<Last-minute procedures@>=
function edit_file; {|( @!stack_item : in_state_record; line : integer ) :
boolean|}
var @!equivalence : packed array[1..file_name_size] of char;
@!equv_len : signed_halfword;
@!old_setting : integer;
@!edit_status : edit_result;
@!edit_ctr : integer;
@!edit_found : integer;
@<Variables for |edit_file|@>@;
begin
old_setting:=selector; selector:=log_only;
edit_file := false;
edit_status:=failed; {Assume the worst!}
equivalence:=edit_name; equv_len:=edit_len;
if edit_qual then
if equivalence[equv_len]=':' then begin
equivalence[equv_len]:=' '; decr(equv_len);
edit_qual:=translate(equivalence,equv_len);
end;
if edit_qual then
@<Attempt to invoke desired editor@>;
if edit_status<>failed then
begin
edit_file := true;
if edit_status=edited then
@<Remove version number from file specification@>
end;
selector:=old_setting;
end;
@ If the logical \.{TEX\_EDIT} has a suitable translation, we attempt to
@.TEX_EDIT@>
identify the ``preferred'' editors (preferred in the sense that they can be
invoked from a shareable image, without the overhead of spawning a new process).
@<Attempt to invoke desired editor@>=
begin
print_nl("Issuing the following command:");
@.Issuing the following command:@>
@<Upcase the equivalence string@>;
@<Attempt to recognize name of editor@>;
if edit_found<>0 then
@<Invoke callable editor@>
else
@<Invoke editor in a sub-process@>;
copy_err:=ignore_it; selector:=old_setting;
end
@ The equivalence string for \.{TEX\_EDIT} needs to be converted to upper-case,
@.TEX_EDIT@>
to ensure that it may be matched to the names of the preferred editors.
@<Upcase the equivalence string@>=
for edit_ctr:=1 to equv_len do
if equivalence[edit_ctr] in ['a'..'z'] then
equivalence[edit_ctr] := xchr[xord[equivalence[edit_ctr]]+"A"-"a"]
@ Now that we have the equivalence string in upper-case, we attempt to match it
with the names of the preferred editors in the data structure |editor|.
For testing equality between two strings, we use VAX-\PASCAL's |index| function.
@d VAX_index==@= index@>
@<Attempt to recognize name of editor@>=
edit_ctr:=1; edit_found:=0;
while (edit_ctr<=max_editor) and (edit_found=0) do
begin
if VAX_index(editor[edit_ctr].logical,equivalence) = 1 then
edit_found:=edit_ctr;
incr(edit_ctr)
end;
@ Well, we now know that the user wishes to use one of the supported
\\{callable} editors. So the next move is to construct suitable command strings
and invoke the editor from the appropriate shareable image.
@<Invoke callable editor@>=
with editor[edit_found] do
begin
rewrite(temp_file); copy_err:=save_it;
print_nl(cmd_text);
if start_qual then with stack_item do
edit_locate(line,loc_field-start_field+1);
if edit_found=EDT_editor then
@<Create \.{EDT} command file@>;
if edit_found=TECO_editor then
@<Create \.{TECO} command file@>;
print(stack_item.name_field);
copy_err:=ignore_it; selector:=old_setting;
if EDT_like then
begin
edit_status := Edit(stack_item.name_field,cmd_file,editor[edit_found]);
@<Delete an editor command file@>
end
else
edit_status := Edit(0,0,editor[edit_found]);
end
@ The common-or-garden \.{EDT} editor doesn't have a qualifier to specify the
starting position, so we create a small command file, and specify its name on
the \.{/COMMAND} qualifier for \.{EDT}
The command file contains line-mode commands to position the cursor
appropriately. Strictly speaking, it is illegal to issue a \.{CHANGE} command
(which is the only one that accepts no-keypad commands to position the cursor)
except from a terminal, and \.{EDT} will display a message about this when it
executes the command from the command file; however, it \\{does} honour the
command correctly, so the end does justify the means!
It seemed too complicated to try to delve into \TeX's
``whatsits'', and yet we'll want to use |print|, etc, to transfer text into the
file. Previous versions of the VMS implementation tried to create the file
using the first free |file| in the array |write_file|. But this approach
failed, if \TeX\ has got all sixteen available files in use (although this
is a rare case). To prevent this interference with TeX's own use of its
output streams, the present solution uses a dedicated file |edcmd_file| for
creating the editor command file. It is access by setting |selector| to
the additional mode |edcmd_write|.
@<Create \.{EDT} command file@>=
begin
name_of_file:='TEX_EDTINI'; default_name:='.EDT';
if a_open_out(edcmd_file) then
begin
cmd_file:=make_name_string;
equivalence:='EDTINI'; equv_len:=6; {If it's defined}
if not translate(equivalence,equv_len) then equv_len:=6;
copy_err:=ignore_it; selector:=edcmd_write;
print("SHOW COMMAND");
print_ln; print("CHANGE "); print_int(line); print_char(";");
with stack_item do print_int(loc_field-start_field);
print("(+C)");
print_ln; print("SET MODE CHANGE");
print_ln; print("SET COMMAND ");
for kkk:=1 to equv_len do print_char(xord[equivalence[kkk]]);
a_close(edcmd_file);
copy_err:=save_it; selector:=log_only;
print("/COMMAND="); print(cmd_file); print_char(" ");
end
end
@ Here are the other variables used in the above module:
@<Variables for |edit_file|@>=
@!kkk : integer;
@!cmd_file : str_number;
@ Neither does the \.{TECO} editor accept such a qualifier, so again we create a
suitable command file.
@<Create \.{TECO} command file@>=
begin
name_of_file:='TEX_TECOINI'; default_name:='.TEC';
if a_open_out(edcmd_file) then
begin
cmd_file:=make_name_string;
equivalence:='TEC$INIT'; equv_len:=8; {If it's defined}
copy_err:=ignore_it; selector:=edcmd_write;
if translate(equivalence,equv_len) then
begin
if equivalence[1]='$' then
begin
print("EI");
for kkk:=2 to equv_len do print_char(xord[equivalence[kkk]]);
end else
for kkk:=1 to equv_len do print_char(xord[equivalence[kkk]]);
print_char(@"1B);
print_ln;
end;
print("@@^U1/"); print_int(line); print("U0");
with stack_item do print_int(loc_field-start_field);
print("U20U1<(Q1+1)U1(Q0-Q1-1):;L(.-Z)""LF>'^E""L(Q1+1)U1'P>Q2CT/");
print_char(@"1B); print_char(@"1B);
print_ln;
a_close(edcmd_file);
copy_err:=save_it; selector:=log_only;
print("/COMMAND="); print(cmd_file); print_char(" ");
@<Create logical \.{TEC\$INIT}@>
end
end
@ Unfortunately, the present version (V40.36) of \.{TECO} does not appear to
make use of the third parameter (which is supposed to be the name of an
initialization file). Therefore, we create (or redefine) the logical name
\.{TEC\$INIT}, which the callable version of TECO will then use. Afterwards, of
@.TEC{\$}INIT@>
course, we have to put things back as they were, since otherwise a further
invocation of the editor would introduce a circularity.
The requirement for \.{TEC\$INIT} is that its first character shall be a dollar
sign (`\.\$') to indicate that the rest of the logical name gives the name of a
file to be used for initialization.
@d VAX_create_logical==@= $crelnm@>
@<Create logical \.{TEC\$INIT}@>=
begin
TECO_cmd := '$';
kkk:=str_start[cmd_file];
while kkk<str_start[cmd_file+1] do
begin
TECO_cmd:=TECO_cmd+xchr[so(str_pool[kkk])];
incr(kkk)
end;
with item_list[0] do
begin
buffer_length := VAX_length(TECO_cmd);
item_code := VAX_lnm_string;
buffer_addr := VAX_address_of(VAX_body(TECO_cmd));
ret_len_addr := 0;
end;
item_list[1].next_item := 0;
VAX_create_logical(,'LNM$PROCESS_TABLE','TEC$INIT',,item_list);
end
@ Here are some additional variables used in the above module.
@<Variables for |edit_file|@>=
@!TECO_cmd : [VAX_volatile] varying [file_name_size] of char;
@!item_list : [VAX_volatile] array [0..1] of VMS_item_list;
@ After \.{EDT} or \.{TECO} has completed its editing, we are at liberty to
delete the command file that was used to direct the cursor to the appropriate
place. We've got the full file specification saved up from when the file was
created, so we can go ahead and use the VAX-\PASCAL\ |delete_file| command to
remove the file.
@d VAX_delete_logical==@= $dellnm@>
@d VAX_delete_file ==@= delete_file@>
@<Delete an editor command file@>=
begin
if edit_found=TECO_editor then
begin
if equv_len>0 then
begin
with item_list[0] do
begin
buffer_length := equv_len;
item_code := VAX_lnm_string;
buffer_addr := VAX_address_of(equivalence);
ret_len_addr := 0;
end;
item_list[1].next_item := 0;
VAX_create_logical(,'LNM$PROCESS_TABLE','TEC$INIT',,item_list);
end
else
VAX_delete_logical('LNM$PROCESS_TABLE','TEC$INIT');
end;
VAX_delete_file(last_name)
end
@ Once a source file has been edited, any further calls of an editor should
access the latest version of the source file, rather than that first opened by
\TeX. Therefore, as a crude approximation to this desired outcome, we truncate
the file specification held in the pool by substituting spaces for the `\.;'
and any characters that follow it in there. (This is a good approximation,
since generally any revised file will have been written out to the next higher
version number, and the method adopted is easier than trying to shuffle all of
the pool down to fill the vacant space.)
@<Remove version...@>=
begin
had_semicolon := false;
for next_ch := str_start[stack_item.name_field] to
str_start[stack_item.name_field+1]-1 do
begin
if str_pool[next_ch] = si(";") then had_semicolon := true;
if had_semicolon then str_pool[next_ch] := si(" ")
end;
end
@ Here's the necessary global variables for the previous module:
@<Variables for |edit_file|@>=
@!next_ch : pool_pointer;
@!had_semicolon : boolean;
@ If we were unable to recognize the equivalence string for the \.{TEX\_EDIT}
@.TEX_EDIT@>
logical name, it's assumed to be a DCL command (most probably preceded by an
`\.@@' to invoke a command procedure). The command will be run in a
sub-process, and provided with three parameters: the name of the file to be
edited, and the row and column numbers (starting from 1) of the file at which
the error was detected.
The following code constructs the requisite DCL command ready to be passed to
the spawned sub-process by procedure |Edit|. As for the callable editors above,
this command is constructed in the \PASCAL\ internal file |temp_file|, using
various print commands.
@<Invoke editor in a sub-process@>=
begin
rewrite(temp_file); copy_err:=save_it; print_ln;
for kkk:=1 to equv_len do print(xord[equivalence[kkk]]);
print(" "); print(stack_item.name_field); print(" ");
print_int(line); print(" ");
with stack_item do print_int(loc_field-start_field+1);
edit_status := Edit(0,0,empty_editor);
end
@ Here's a dummy |editor| structure to be passed to |Edit| for non-callable
editors:
@<Glob...@>=
@!empty_editor : editor_ident;
@ and its initialization:
@<Set initial...@>=
with empty_editor do
begin
logical := '';
image := 0;
entry := 0;
quitting := 0;
exiting := 0;
cmd_text := 0;
cmd_offset := 0;
start_qual := false;
EDT_like := false;
end;
@z