diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /macros/text1/texix |
Initial commit
Diffstat (limited to 'macros/text1/texix')
-rw-r--r-- | macros/text1/texix/plsort.pliopt | 9 | ||||
-rw-r--r-- | macros/text1/texix/texix.cmschan | 3 | ||||
-rw-r--r-- | macros/text1/texix/texix.cmsinfo | 5 | ||||
-rw-r--r-- | macros/text1/texix/texix.readme | 4 | ||||
-rw-r--r-- | macros/text1/texix/texix.web | 1577 | ||||
-rw-r--r-- | macros/text1/texix/txt1v293.cmschan | 2000 |
6 files changed, 3598 insertions, 0 deletions
diff --git a/macros/text1/texix/plsort.pliopt b/macros/text1/texix/plsort.pliopt new file mode 100644 index 0000000000..b644a4206c --- /dev/null +++ b/macros/text1/texix/plsort.pliopt @@ -0,0 +1,9 @@ + PLSORT: PROC(TEMP) OPTIONS(FORTRAN); + DCL TEMP FIXED BIN(31,0); + CALL PLISRTA( + ' SORT FIELDS=(38,256,CH,A,293,44,CH,A,342,256,CH,A,'|| + '597,44,CH,A,646,256,CH,A,901,44,CH,A,10,4,BI,D,6,4,BI,A)', + ' RECORD TYPE=V,LENGTH=(1857) ', + 95000,TEMP); + RETURN; + END; diff --git a/macros/text1/texix/texix.cmschan b/macros/text1/texix/texix.cmschan new file mode 100644 index 0000000000..9c767000c6 --- /dev/null +++ b/macros/text1/texix/texix.cmschan @@ -0,0 +1,3 @@ +% Version 1.0; Dean Guenther; 4/1/86 +% Version 1.1; Dean Guenther; 12/87 +% Version 1.2; Dean Guenther; 6/28/88 diff --git a/macros/text1/texix/texix.cmsinfo b/macros/text1/texix/texix.cmsinfo new file mode 100644 index 0000000000..72b6ab4e65 --- /dev/null +++ b/macros/text1/texix/texix.cmsinfo @@ -0,0 +1,5 @@ +TEXIX.WEB is the TEXT1 sorted index program. The TXT1V293.CMSCHAN can be used +to create a TXT1V293 MODULE on CMS which has the sorted index program imbedded +into TEX itself as an extended primative. PLSORT must be compiled to get a CMS +TEXT files, and TEXIX WEB must be compiled with TEXIX CMSCHAN to get its TEXT +file before compiling and linking TXT1V293 with TEX (version 2.93). diff --git a/macros/text1/texix/texix.readme b/macros/text1/texix/texix.readme new file mode 100644 index 0000000000..e2f9e3a8ec --- /dev/null +++ b/macros/text1/texix/texix.readme @@ -0,0 +1,4 @@ +TEXIX is a program which is used in conjunction with TEXT1 macros to create a +sorted index for TeX. In the text1.texix directory is the TEXIX source, along +with a changes file for CMS. If you are using VMS, look in the text1.vax_vms +directory for the VMS version. There is a Mac version in text1.macintosh. diff --git a/macros/text1/texix/texix.web b/macros/text1/texix/texix.web new file mode 100644 index 0000000000..bbf577633e --- /dev/null +++ b/macros/text1/texix/texix.web @@ -0,0 +1,1577 @@ +% Version 1.3 makes it easier to create other changes files (6/89) +\font\twelvept=cmbx12 +\font\tentex=cmr10 +\def\topofcontents{\null\vfill\eject + \def\titlepage{T} + \centerline{{\twelvept The \TeX IX Index Program}} + \centerline{{\twelvept For IBM VM/CMS Pascal/VS}} + \vskip15pt + \centerline{Version 1.3, June 1989} + \hbox{\vbox{\hsize\the\hsize This work is + protected as an unpublished work under U.S. copyright laws. + Copyright $\copyright$ 1988 by WSUCSC. All rights Reserved.}} + \vskip18pt + \hbox{\vbox{\hsize\the\hsize This software is furnished under a + license for + use only on a single computer system and may be copied only + with the inclusion of the above copyright notice. + This software, or any other copies + thereof, may not be provided or otherwise made available to any + other person except for use on such system and to one who agrees to + these license terms. Title to and ownership of the software shall + at all times remain in WSUCSC.}} + \vfill} +\let\tentex=\tt +\def\_{\leavevmode \kern.06em \vbox{\hrule width.3em}}% +% +\def\}{\ifmmode \rbrace + \else $\rbrace$\fi}% +% +\def\{{\ifmmode \lbrace + \else $\lbrace$\fi}% +% +\def\us#1{$\underline{\smash{\hbox{#1}}}$}% +\def\lin#1{\par + \leftskip 0pt + \advance \leftskip by #1 + }% +\def\vs#1{\vskip #1\relax} +\catcode`*=11 +% labeled definition macro +% +\newdimen\la*w \la*w=1in % Label width +\newtoks\la*g \la*g={1em} % Label gutter +\newtoks\la*s \la*s={12pt} % Skip before label +\newtoks\la*f \la*f={\rm} % Label font +\newbox\tempbox +% +\long\def\label#1{\par\vskip\the\la*s + \setbox\tempbox=\vtop{\hsize=\la*w + \leftskip=0pt + \rightskip=0pt plus2em + \tolerance=1600 + \noindent + \the\la*f + #1}% + \hangindent=\la*w + \advance \hangindent by \the\la*g + \hangafter=1 + \noindent + \setbox0=\hbox{\rlap{\box\tempbox}}\ht0=0pt\dp0=0pt\box0% + \hskip\la*w + \hskip\the\la*g + \ignorespaces} +\let\la=\label +\catcode`*=12 +\let\nin=\noindent +\def\lbr{\null\hfil\break} +\def\PASCAL{{\sc PASCAL/VS}} +\def\hs#1{\hskip#1} +\def\text#1{{\it \TeX T#1}} +\def\9{\it} +\def\bs{$\backslash$} +% Version 1.0; Dean Guenther; 4/1/86 +% +@* Introduction. +This procedure was created to give \text1\ the ability to produce a sorted +index in the same one pass, instead of creating the index, sorting it, and +printing the index out in three separate steps. + +To accomplish this feat, a new control sequence, \bs{}sortindex, was added to +the basic \TeX\ program which gives the \text1\ user up to three sorted +index files per run. The format of this new control sequence is +\par{\tt\indent\bs{}sortindex\it n} +\par +\nin where {\it n} is the index file number: 1, 2, or 3. + +@ The @^TEXIX@> +program is written entirely in WEB, except for an external +procedure, {\it plsort}, which is written in @^PL/1@> PL/1. +This was necessary since +\PASCAL\ cannot call +@:plsort@> +Syncsort @^SYNCSORT@> +to do an internal sort, and PL/1 can. + +@ +Also, it should be pointed out early that I made use of \PASCAL' +nifty string handling capability, in particular, the |string|, +|index| and |substr| functions. If needed, these should not be too +difficult to translate into another \PASCAL\ +compiler (famous last words). + +@p +segment texix; +procedure texix(ix:char); external; +procedure texix; +const @<Global Constants@> +type @<Global Types@> +var @! m,k,i,j :integer;@/ +@<Global Variables@> + +@ The file {\it ix\_file} +is the file opened for output in the \text1\ session +itself. It will be closed in TEXIX, opened for input, closed again, and +finally opened for output where the final sorted index file will be +written to, complete with all \text1\ markup necessary for printing +the index. + +@<Global Var...@>= +sysprint:text; +@!ix_file :text; + +@ The {\it sort\_file} is used for the internal sort only. The \text1\ user +never has access to it. + +@<Global Var...@>= +@!sort_file :file of sort_type; + +@* Macros and definitions. +Here are some macros and definitions used throughout. + +@d incr(#) == # := # + 1 +@d decr(#) == # := # - 1 + +@d othercases == otherwise +@d endcases == end; + +@d dosubstr == substr +@d doindex == index + +@f othercases == else +@f endcases == end + +@d getout == return +@d messages == sysprint + +@d max_field = 300 +@d max_levels = 3 +@d max_lrecl = 2048 + +@d remove_characters(#) == if length(in_record) > # then +in_record := dosubstr(in_record,1 + #) +else in_record := '' + +@d do_nothing == begin end + +@d do_sort_as == begin remove_characters(6); +i := doindex(in_record,'{$}'); +write_sort_chars(i-1); +remove_characters(3); +end + +@d check_case == begin +if not respect_case then for j:= 1 to +sort_part[i].field_lngth do sort_part[i].field_level[j] := +upper_case(sort_part[i].field_level[j]); end + +@d string_type(#) == string(#) + +@d ccat_temp == @t\hs{2em}@>@=||@>@t\hs{2em}@> + + +@d add_comma(#) == # := ccat(#,',') +@d add_cmma_blnk(#) == # := ccat(#,', ') + +@d do_when_bold == begin +if length(bold_string) > 0 then add_comma(bold_string); +bold_string:= +ccat(ccat(ccat(bold_string,'{\bd '),curr_str_page),'}'); +@.\bs{}bd@> +end + +@d do_when_underscore == begin +if length(us_string) > 0 then add_comma(us_string); +us_string:= +ccat(ccat(ccat(us_string,'\us{'),curr_str_page),'}'); +@.\bs{}us@> +end + +@d do_when_italic == begin +if length(rm_string) > 0 then add_comma(rm_string); +rm_string:= +ccat(ccat(ccat(rm_string,'{\it '),curr_str_page),'}'); +@.\bs{}it@> +end + +@d do_when_roman == begin +if length(rm_string) > 0 then add_comma(rm_string); +rm_string:=ccat(rm_string,curr_str_page); +end + +@d do_write(#)==write(#) + +@d do_lnwrite(#)==writeln(#) + +@ This is arbitrary, but +there should never be more than 8 indicies. + +@d s_file_number == '9' + +@ This is used to print the subentry1 header if there are no page +numbers under its subentry and there are under subentry2. + +@d id2_missing_check== +curr_level:=2; +if sort_record.sort_part[3].field_lngth=0 +then do_nothing else begin +id2_is_missing:=true; +write_header(sort_record.print[2].field_lngth, +sort_record.print[2].field_level); +id2_is_missing:=false; +curr_level:=3;end + +@ This is used to print the primary header if there are no page +numbers under the primary header, and there are page numbers under +either subentry1 or subentry2. + +@d id1_missing_check==if sort_record.sort_part[2].field_lngth = 0 +then begin curr_level:=1; +if sort_record.sort_part[3].field_lngth = 0 +then do_nothing else begin +id1_is_missing:=true; +write_header(sort_record.print[1].field_lngth, +sort_record.print[1].field_level); +id1_is_missing:=false; +curr_level:=3;end;end +else begin curr_level:=1; +id1_is_missing:=true; +write_header(sort_record.print[1].field_lngth, +sort_record.print[1].field_level); +id1_is_missing:=false; +id2_missing_check; +end + +@ This is a little macro used to access {\it write\_header}. + +@d write_prev_header== +begin case curr_level of +1: write_header(prev_ln1,prev_pn1); +2: write_header(prev_ln2,prev_pn2); +3: write_header(prev_ln3,prev_pn3); +othercases do_nothing +endcases +end; + +@ The function ccat will concatenate two strings together. + +@^System dependent code@> +@p function ccat(x,y:string_pass):string_pass; +begin + ccat := x ccat_temp y; +end; + +@* Opening and Closing the files. +This is all very dependent on \PASCAL. + +@ The {\it reset\_file} procedure is used to open all files. +One time this is done when first entering TEXIX. +Note that the file name is ``{\tt IX\it n}'' where ``{\it n}'' is +1--3. This can easily be extended to 4--8 by chaning the \bs{}index +markup in TEXT1@@. +The other time the open is done is when opening the sort file, after it +has already been sorted. +This is system dependent. The following will work for \PASCAL. + +@^System dependent code@> +@p procedure reset_file(file_number:char); +begin +if file_number = '9' then reset(sort_file, +'NAME=TEXT1$$.OUTSORT.A,LRECL=1857,RECFM=V') +else reset(ix_file, +ccat(ccat('NAME=TEXT1$$.IX',str(file_number)),'.A')); +end; + +@ +The {\it sort\_file} is opened for output to write the sort records to. +The {\it ix\_file} is opened for output after the sort records have +been sorted and processed again. +This is system dependent. The following will work for \PASCAL. + +@^System dependent code@> +@p procedure file_rewrite(file_number:char); +begin +if file_number = '9' +then +rewrite(sort_file,'NAME=TEXT1$$.INSORT.A,LRECL=1857,RECFM=V') +else +rewrite(ix_file, +ccat(ccat('NAME=TEXT1$$.IX',str(file_number)), +'.A,LRECL=2048,RECFM=V')); +end; + +@* The Sort Record Description. The record type called +{\it sort\_type} is the record written to the {\it sort\_file}. +If consists of the following: +\la{\bf Bytes} +\la{1} +A one byte {\it record\_type} (0={\bf bold page number}; +2= roman page number (the default); 4=\us{underscored} \us{page} +\us{number}; +6={\it italic page number}; 9=blind entry). +\la{2--5} +The integer page number. If the page +number is in the preface part of the document, then the page number will +be negative. +\la{6--9} +Used in sorting decending. That means that -1 will be at the top. +If the page number is plus to begin with, then this is set to zero +for sorting, so it will be at the bottom of the list. +\la{10-29} This is the same as page number, unless the page number is +negative, in which case this field is a roman numeral. +\la{30--33\lbr34--333\lbr334--337\lbr338--637\lbr638--641\lbr642--941} +The sort field. There are three arrays in this field. Each array +consists of a 4 byte length, followed by the {\it field\_array} which is +the length of the sort entry or subentry. +It is these fields which will get sorted by @^Syncsort@> Syncsort. +If there was a {\it sort\_as} +used for a sort entry or subentry, that value passed in the {\it sort\_as} +is placed here. +\vs{24pt} +\la{942--945\lbr946--1245\lbr1246--1249\lbr +1250--1549\lbr1550--1553\lbr1554--1853} +The print field. +The description is the same as the sort field. +This is the way the index entry will print, but not necessarily how +it will sort. +\vs{96pt} + +@ @<Global Constants@>= +@!max_pn_alpha=20; +@!max_pnum=9; + +@ @<Global Types@>= +@!string_pass=string_type(max_lrecl); +@!pass_pn_alpha=string_type(max_pn_alpha); +@!pn_type=packed array[1..max_pnum] of char; +@!pn_alpha_type=packed array[1..max_pn_alpha] of char; +@!field_array = packed array[1..max_field] of char; +@!field_type = packed record@| +@!field_lngth :integer; +@!field_level :field_array; +end; +@!sort_type = packed record@/ +@!record_type :char; +@!page_number :integer; +@!abs_page_number :integer; +@!page_string :pn_alpha_type; +@!sort_part :packed array[1..3] of field_type; +@!print :packed array[1..3] of field_type; +end; + +@* Subroutines. For many of the following subroutines, the following +global variable, {\it current\_level} is needed to indicate what +index level we are presently processing. +0 = the primary index; 1 = subentry 1, and +2 = subentry 2. +{\it on\_a\_roll} is `true' if we have a series of consecutive page +numbers going. `false' otherwise. +In other places, {\it print\_style}=1 for the paragraph style; it is +2 for the dash style; and it is 3 for the indent style. + +@<Global Var...@>= +@!curr_level :integer; +@!on_a_roll:boolean; + +@ The {\it write\_header} procedure will write out the primary and +subentry level titles from {\it sort\_record.print}. + +@p procedure write_header(print_length:integer;print_field:field_array); +var i:integer; +begin +case curr_level of +1: begin + do_write(ix_file,'\goodbreak\hp '); +@.\bs{}leavevmode@> +@.\bs{}goodbreak@> +@.\bs{}hp@> + for i:=1 to print_length do do_write(ix_file,print_field[i]); + case print_style of + '1':begin + do_write(ix_file,', '); + end; + '2','3':begin + if id1_is_missing or dot_leadering + then do_lnwrite(ix_file,' ') + else do_lnwrite(ix_file,', '); + end; + othercases do_nothing + endcases; end; +2: begin case print_style of + '1':do_nothing; + '2':begin + do_write(ix_file,'\indentsubentry',ix,'1---'); +@.\bs{}indentsubentry@> + end; + '3':begin + do_write(ix_file,'\indentsubentry',ix,'1'); + end; + othercases do_nothing + endcases; + for i:=1 to print_length do do_write(ix_file,print_field[i]); + if (print_style <> '1') or id2_is_missing or dot_leadering + then do_lnwrite(ix_file,' ') + else do_lnwrite(ix_file,', '); + end; +3: begin case print_style of + '1':do_nothing; + '2':begin + do_write(ix_file,'\indentsubentry',ix,'2---'); + end; + '3':begin + do_write(ix_file,'\indentsubentry',ix,'2'); + end; + othercases do_nothing + endcases; + for i:=1 to print_length do do_write(ix_file,print_field[i]); + if dot_leadering + then do_lnwrite(ix_file,' ') + else do_lnwrite(ix_file,', '); + end; +othercases do_nothing +endcases +end; + +@ The {\it numeric} function will take a packed array of length +max\_pnum and convert +that array (which is really the page number) into an integer. + +@p function numeric(simple_array:pn_type):integer; +var @!i,j_mult,pn:integer; +begin pn := 0; +i := max_pnum;j_mult:=1; +repeat +if i = 1 then if simple_array[1] = '-' +then pn := -1 * pn +else pn := pn + ((ord(simple_array[1])-ord('0')) * j_mult) +else pn := pn + ((ord(simple_array[i])-ord('0')) * j_mult); +j_mult := j_mult * 10; +decr(i); +until i < 1; +numeric:=pn; +end; + +@ The {\it get\_numeric} +function will take a packed array of length max\_pn\_alpha and convert +that array (which is really the page number) into an integer. + +@p function get_numeric(x_string:string_type(max_pn_alpha)):integer; +var @!i:integer; +begin +readstr(x_string,i); +get_numeric:=i; +end; + +@ The {\it strvalue} function takes an integer and converts it into +a string. + +@^System dependent code@> +@p procedure strvalue(x:integer; var results:pass_pn_alpha); +var +temp:string_type(max_pn_alpha); +begin +writestr(temp,x); +results:=ltrim(temp); +end; + +@ The {\it strconv} function takes an array and converts it into +a string. + +@p function strconv(x:pn_alpha_type):string_type(max_pn_alpha); +var i:integer; +temp:string_type(max_pn_alpha); +begin +temp:='';i := 1; +with sort_record do begin +repeat +if x[i] <> ' ' then +temp := ccat(temp,str(x[i])); +incr(i); +until (i > max_pn_alpha) or (x[i] = ' '); +end; +strconv:=temp; +end; + +@ The procedure {\it write\_print\_chars} will write the number of +characters indicated +in the parm field to the appropriate print field. There are three levels of +print fields. Level 0 is the primary index, level 1 is the subentry 1 index, +and level 2 is the subentry 2 index. After writing the number of characters +to the print field, that number of characters is removed from the input record. +You might notice that this procedure is very similar to the +write\_sort\_chars +procedure. The only difference in the two is that this procedure deals +with how the index is +to be printed after sorting. The former deals with how the +index is to be sorted. +Also, this procedure is called by {\it write\_sort\_chars}. + +@^System dependent code@> +@p procedure write_print_chars(number_of_characters:integer); +var m:integer; +begin with sort_record.print[curr_level+1] do +for m := 1 to number_of_characters do begin +incr(field_lngth); +field_level[field_lngth] := in_record[m]; +end; +remove_characters(number_of_characters); +end; + +@ The procedure {\it write\_sort\_chars} +will write the number of characters indicated +in the parm field to the appropriate sort field. There are three levels of +sort fields. Level 0 is the primary index, level 1 is the subentry 1 index, +and level 2 is the subentry 2 index. After writing the characters to +the sort fields, they will be removed from the input string. + +@^System dependent code@> +@p procedure write_sort_chars(number_of_characters:integer); +var m:integer; +begin with sort_record.sort_part[curr_level+1] do +for m := 1 to number_of_characters do begin +incr(field_lngth); +field_level[field_lngth] := in_record[m]; +end; +remove_characters(number_of_characters); +end; + +@ +This procedure processes subentries within the \bs{}index command. For example, +the phrase ``Mt. St. Helens'' would be processed here for the entry created +by the markup: +\vs{12pt} +{\lin{.5in} +{\tt\bs{}index\{volcanos\bs{}subentry1\{Mt. St. Helens\}\}}\par} +\vs{12pt} +\nin Note +that there are two levels of subentries, \bs{}subentry1 and \bs{}subentry2. +You can +use \bs{}sortas within a \bs{}subentry. But you cannot use \bs{}subentry2 within +\bs{}subentry1 and vise versa. If you think it should be permitted, don't. +Also, \bs{}blindentry is not permitted within \bs{}subentry. +(I can't be flexible {\bf everywhere}.) + +@ First save the current level, then set the current level to the +subentry level. Process until the subentry is completely digested. + +@^System dependent code@> +@p procedure process_subentry(@!entry_level:integer); +var temp_level :integer; +digest :boolean; +begin remove_characters(1);{Throw away the `1' or `2'}@/ +temp_level := curr_level; +curr_level := entry_level; +digest := true; +repeat +@<Digest Subentry@> +until not digest; +curr_level := temp_level; +end; + +@ If the next character is a dollar sign, then we {\bf might} have a \bs{}sortas +If the next character is a left curly brace, then check to see if we've +reached the end of this subentry. If the character is not `\$' or `\{', +then write the character to the print file. + +@<Digest Subentry@>= +if in_record[1] = '$' +then @<Check for Sortas@> +else if in_record[1] = '{' +then @<Check for Subentry End@> +else write_print_chars(1); + +@ If the next two characters are `\$\}' then we are are the end of +the subentry. + +@<Check for Subentry End@>= +begin +if (in_record[2] = '$') and (in_record[3] = '}') +then begin +digest := false; +remove_characters(3); +end +else write_print_chars(1); +end + +@ If the next three are `\{\$\}' then we {\it might} have a sortas. +and check the next two +characters to see if they +are `{\tt sa}'. If so, we {\bf do} have a sortas. +Otherwise write those 6 characters out. In any case, if we don't have +a `\{\$\}' to begin with, then write the first character out +(which was a +`\$' if you remember from earlier.) + +@<Check for Sortas@>= +if (in_record[2] = '{') and +(in_record[3] = '$') and (in_record[4] = '}') +then begin +if (in_record[5] = 's') and (in_record[6] = 'a') +then do_sort_as +else write_print_chars(6); +end +else write_print_chars(1) + +@ +The {\it equal\_arrays} +function returns a true if the two arrays being passed are +identical. False if not. + +@p function equal_arrays(fieldy:field_array;fieldz:field_array):boolean; +var i :integer; +still_checking :boolean; +begin i := 1; +still_checking := true; +repeat +if fieldy[i] <> fieldz[i] {if arrays not equal} +then still_checking := false +else incr(i); +until (i>max_field) or not still_checking; +equal_arrays := still_checking; +end; + +@ The {\it plsort} procedure is written in PL/1 to call the CMS sort program +Syncsort. This was necessary since you cannot call Syncsort from PASCAL/VS. +The fields to be sorted are defined internally in the {\it plsort} +program. This should be the same as the three sort fields in {\it sort\_type}. +@:sort_type@> +@:plsort@> @^PL/1@> +@^Syncsort@> + +@p procedure plsort(var sort_rc:integer); fortran; + +@ This function converts to all uppercase. +Notice that this is an EBCIDIC conversion, not an ASCII conversion +to uppercase. + +@p function upper_case(x:char):char; +var temp:char; +begin + if (ord(x)>=129)and(ord(x)<=169) then + temp:=chr(ord(x)+64) + else temp:=x; +upper_case:=temp; +end; + + +@* Read Each Index Entry. +Each line in the {\it ix\_file} is a separate index entry generated with the +\bs{\it index markup}. This markup has the format +\par{\tt\bs{}index\it n\tt\{\it entry\rm/\it markup\tt\}} +\par +\nin where ``{\it entry}'' +is the textual material of the primary index. The +``{\it markup}'' may be one of the following submarkup +which may {\bf only} +appear within the \bs{\it index markup}. Never outside of it. +\item{1.} {\tt\bs{}subentry{\it n\/}}: where {\it n} is ``1'' or ``2'', +denoting the subentry level. +You would use this submarkup in the following fashion: +\par{\lin{+.5in}\tt\bs{}index1\{\rm entry +\bs\rm subentry1\tt\{\it submarkup\tt\}\}\par} +\indent where {\it submarkup} here can only be \bs{\it sortas}. +\item{2.}{\tt\bs{}sortas}: This markup is used to indicate text for either the +primary sort level, or one of the two subentry sort levels that is to be +sorted, but not printed in the resulting index. For example, someone may +want ``10 Downing Street'' +to sort as ``ten Downing Street''. This would be accomplished by entering +``{\tt\bs{}index1\{10 Downing Street\bs{}sortas\{ten Downing Street\}\}}''. +You can also use \bs{\it sortas} within the \bs{\it subentry} submarkup. +\item{3.} +{\tt\bs{}itpn}: This markup indicates this index number +is to be printed in italics in the sorted index. +To use it, enter: +\par{\lin{+.5in}\tt\bs{}index1\{\rm entry \tt +\bs{}itpn\}\par} +\item{4.} {\tt\bs{}bdpn}: This markup indicates this +index number is to be +printed in bold in the sorted index. +To use it, enter: +\par{\lin{+.5in}\tt\bs{}index1\{\rm entry \tt +\bs{}bdpn\}\par} +\item{5.} {\tt\bs{}uspn}: This markup indicates +this index number is to +be underscored in the sorted index. +To use it, enter: +\par{\lin{+.5in}\tt\bs{}index1\{\rm entry \tt +\bs{}uspn\}\par} +\item{6.} {\tt\bs{}blindentry}: This markup indicates this index is to be +a blind entry or ``cross reference''. It may appear inside of a +standard entry or subentry. There is no page number associated with +this submarkup. +\par + +@ @<Global Var...@>= +@!respect_case :boolean; +@!dot_leadering :boolean; +@!print_style:char; +@!sort_record :sort_type; +@!in_record :string_type(max_lrecl); +@!temp_strvalue:pass_pn_alpha; + +@^System dependent code@> +@ This procedure will read the {\it ix\_file} in until all index requests +have been read. + +@p procedure read_all_entries; +var @!i,j,k:integer; +begin +@<Get Default Index Values@> +while not eof(ix_file) do begin +@<Initialize Sort Records@>@/ +@<Read Next Record@>@/ +@<Move Sort Type to Sort Record@>@/ +@<Move Page Number to Sort Record@>@/ +@<Digest the Input Record@>@/ +@<Fill in Sort Fields@>@/ +@<Write Sort Record@>@/ +end;end; + +@ The first index default variable passed is ``case=". A ``yes" value will +respect the case in an index sort field. ``no" (the default) will convert +everything to uppercase before sorting. + +The second index default ``style=" will be one of ``1", ``2'', or ``3'' +depending on whether the style is ``paragraph'', ``dash'', or ``indented'' +(which is the default). + +The third default read in here is the ``leadering=". A ``yes'' here will give +dot leadering. Guess what ``no'' does. +Dot leadering in the paragraph style ({\it print\_style}=1). If that +has been requested, change {\it dot\_leadering} to false. + +@<Get Default Index Values@>= +readln(ix_file,in_record); +if dosubstr(in_record,doindex(in_record,'=')+1) = 'no' +then respect_case := false +else respect_case := true; +readln(ix_file,in_record);@/ +print_style:=in_record[doindex(in_record,'=')+1];@/ +readln(ix_file,in_record);@/ +if dosubstr(in_record,doindex(in_record,'=')+1) = 'no' +then dot_leadering := false +else dot_leadering := true;@/ +if dot_leadering and (print_style = '1') +then begin writeln(messages, +'<TEXT1> Error! Dot leadering not permitted with the paragraph style.'); +writeln(messages,' Dot leadering will be disabled.'); +dot_leadering := false; +end; + +@ The {\it all\_blanks} variable is filled with all blanks. Other arrays +of the same dimension of {\it all\_blanks} can be set to blank themselves +by saying $array\leftarrow all\_blanks$. + +@<Global Var...@>= +@!all_blanks:field_array; + +@ @<Initialize Sort Records@>= +with sort_record do +for i := 1 to max_levels do begin +sort_part[i].field_level:= all_blanks; +sort_part[i].field_lngth := 0; +print[i].field_level:= all_blanks; +print[i].field_lngth := 0; +end; +curr_level := 0; + +@ Read the next index request to be processed. +Get rid of trailing blanks. + +@<Read Next Record@>= +readln(ix_file,in_record); +in_record:=trim(in_record); + +@ The {\it sort\_type} is always in column 2. Column 1, 3 and 4 will always +be curly braces. (`\{{\it s}\}\{' where ``{\it s}'' is the sort type.) +After moving the {\it sort\_type} to the sort record, then +delete the {\it sort\_type} and the three curly braces. + +@<Move Sort Type to Sort Record@>= +sort_record.record_type := in_record[2]; +remove_characters(4); + +@ The end of the page number is the next right curly brace (`\}'). +Move all of the digits from the input record to the sort record, +starting with the last digit and going forward. If a minus sign (`-') +is in +the page number (preface material), then put a minus sign in +byte one of the sort record's page number. + +@<Global Var...@>= +@!in_page_number:pn_type; + +@ Find and move the page number to the sort record. If it is negative, +then its a roman numeral. In that case, move the page number to the +{\it abs\_page\_number} to be sorted descending, as negative numbers +should be. If its not negative, then move zero to {\it abs\_page\_number} +so it will move to the bottom of that sort field. +After it is moved, delete the appropriate number of characters to +finish digesting the entry. + +@<Move Page Number to Sort Record@>= +k := doindex(in_record,'}'); {find the end of the page number} +i := k - 1; +for j := 1 to max_pnum do in_page_number[j] := '0'; +j := max_pnum; +repeat +if in_record[i] = '-' +then begin +in_page_number[1] := '-'; +i := 0; +end +else begin +in_page_number[j] := in_record[i]; +decr(i); +decr(j); +end; +until i <= 0; +remove_characters(k+1);@/ +sort_record.page_number:=numeric(in_page_number);@/ +if sort_record.page_number < 0 +then sort_record.abs_page_number:=abs(sort_record.page_number) +else sort_record.abs_page_number:=0; +k := doindex(in_record,'}'); {find the end of the page number string} +for i := 1 to max_pn_alpha do sort_record.page_string[i] := ' '; +for i := 1 to k-1 do +sort_record.page_string[i] := in_record[i]; +remove_characters(k); + +@^System dependent code@> +@ Process the rest of the input record. Each time you see a dollar sign, +there could be a submarkup coming, so examine the next three characters. + +@<Digest the Input Record@>= +repeat +if (in_record[1] = '$') and (length(in_record) >= 4) +then @<Examine Next 3 Chars@> +else write_print_chars(1); +until length(in_record) < 1; + +@ Once the index request has been digested, each sort field is checked +to see if it is blank. If so, then {\it sort\_as} was not used, so copy the +{\it print} field to the {\it sort} field. + +@<Fill in Sort Fields@>= +with sort_record do begin +for i := 1 to max_levels do +if sort_part[i].field_lngth=0 +then begin +sort_part[i].field_level := print[i].field_level; +sort_part[i].field_lngth := print[i].field_lngth; +check_case; end +else check_case; +end; + +@^System dependent code@> +@ Ok, the record has been processed, so write it to the output file. + +@<Write Sort Record@>= +sort_file@@:=sort_record; +put(sort_file); + +@ Ok, a dollar sign signals the beginning of some sort of action code if the +next three characters are `\{\$\}'. So lets look at them and see. + +@<Examine Next 3 Chars@>= +begin if (in_record[2] = '{') and +(in_record[3] = '$') and (in_record[4] = '}') +then @<Examine Next 2 Chars@> +else write_print_chars(1);{Well then, the dollar sign must be part of the index} +end + +@ If a {\it blindentry} (`{\tt be}') or {\it subentry} (`{\tt se}'), +then perform the appropriate sections. + +@<Examine Next 2 Chars@>= +begin if (in_record[5] = 'b') and (in_record[6] = 'e') +then @<Do Blind Entry@> +else if (in_record[5] = 's') and (in_record[6] = 'e') +then @<Do Sub Entries@> +else if (in_record[5] = 's') and (in_record[6] = 'a') +then do_sort_as +else write_print_chars(6);{Might as well write all 6 characters examined} +end + +@ Everything up to the next `\{\$\}' is the blind entry. +The page number for a blind entry will always be 999999999. + +@<Do Blind Entry@>= +begin remove_characters(6);{Throw away the `\$\{\$\}be'}@/ +i := doindex(in_record,'{$}'); +curr_level:=2; +write_print_chars(i-1); +curr_level:=0; +remove_characters(3);{Throw away the `\{\$\}'} +sort_record.page_number := 999999999; +end + +@ Process the subentry, depending on whether or not it is +{\it subentry}1 or {\it subentry}2. If not, ignore the whole thing. + +@<Do Sub Entries@>= +begin remove_characters(6); {Throw away the `\$\{\$\}se'} +if in_record[1] = '1' +then process_subentry(1) +else if in_record[1] = '2' +then process_subentry(2) +else write_print_chars(1);{Perhaps someone entered \bs{}subentry3??} +end + +@* Write Formated Index. This section of code takes the sorted index +entries, merges them together, and writes them back out to the index file +to be read in by \bs{}printindex in the user's program. This section consists +of three procedures for accomplishing this feat: {\it add\_page\_number}, +{\it digest\_the\_line}, and {\it read\_sorted\_records}. +{\it numeric} is a function to convert the character string page number into +an integer. + +@^System dependent code@> +@ The procedure {\it add\_page\_number} is used to add the page number of the +current sorted record to the {\it string\_bold} if a +\bs{\it bdpn}, or to +the {\it string\_underscore} if a \bs{\it uspn}, +or otherwise to +the {\it str\_build}. + +@p procedure add_page_number; +var i:integer; + +@ @<Global Var...@>= +@!prev_page_number:integer; +@!prev_pg_string:string_type(max_pn_alpha); +@!prev_record_type:char; + +@ First check to see if we have a new page number. If so, then add the page +number to the string. Otherwise, only add the page number if the sort type +is new and is not equal to ``6'' (italic). + +@p +begin +with sort_record do if prev_page_number = page_number +then if (prev_record_type = record_type) and (record_type <> '9') + then getout +else if record_type = '6' then getout; +@<Add Page Number to the String@> +end; + +@ {\it str\_build} is used to accumulate all of the page numbers. +{\it str\_blind\_entry} is used to accumulate the blind entry information +(typically there should be no more than one, but allowance is made for more.) + +@<Global Var...@>= +@!str_build:string_type(max_lrecl); +@!str_blind_entry:string_type(max_lrecl); +{come on, who's going to have one that long?} + +@ This module will take the page number of the current sorted index +record and add it to the build string, unless the record type is +9, which is a blind entry, in which case it is added to the blind entry +string. Note that if the record type is 0 (bold), 4 (underscore) or +6 (italic), then the page number is prefaced with ``B'', ``U'' or +``I'' respectively. This identifies that the page number is to be +emphasized when the build string is processed through the +{\it digest\_the\_line} procedure. + +@<Add Page Number to the String@>= +if sort_record.record_type = '9' then @<Do Sorted Blind Entry@> +else begin @<Do Sorted Non Blind Entry@> +end; +prev_page_number := sort_record.page_number;@/ +prev_pg_string := strconv(sort_record.page_string);@/ +prev_record_type := sort_record.record_type; + +@ @<Do Sorted Blind Entry@>= +with sort_record.print[3] do begin +if length(str_blind_entry) > 0 then add_cmma_blnk(str_blind_entry); +for i := 1 to field_lngth do +str_blind_entry := ccat(str_blind_entry,str(field_level[i])); +end + +@ If the {\it page\_string[1]} is less than zero, its alphabetic and +roman numeral processing is necessary. + +@<Do Sorted Non Blind Entry@>= +with sort_record do begin +if ord(page_string[1]) < ord('0') +then @<Add Roman Page Number@> +else @<Add Arabic Page Number@>; +end; + +@ @<Add Roman Page Number@>= +begin +if length(str_build) >= 1 +then str_build:=ccat(',',str_build); +strvalue(page_number,temp_strvalue); +str_build := ccat(ccat(ccat(strconv(page_string), +','),temp_strvalue),str_build); +if record_type = '0' +then str_build := ccat('B',str_build) +else if record_type = '4' +then str_build := ccat('U',str_build) +else if record_type = '6' +then str_build := ccat('I',str_build) +end + +@ @<Add Arabic Page Number@>= +begin +if length(str_build) >= 1 +then add_comma(str_build); +if record_type = '0' +then str_build := ccat(str_build,'B') +else if record_type = '4' +then str_build := ccat(str_build,'U') +else if record_type = '6' +then str_build := ccat(str_build,'I'); +str_build := ccat(str_build,strconv(page_string)); +end + +@ {\it output\_string} is used to collect all of the page numbers +before writing them back out to the index file; +{\it bold\_string} collects the bold page numbers; +{\it us\_string} collects the underscored page numbers; +{\it rm\_string} collects everything not bold or underscored. +As you might expect, {\it italic\_last\_page} is true when the last +page number of a `roll' is to be italic. + +@<Global Var...@>= +@!output_string:string_type(max_lrecl); +@!bold_string:string_type(max_lrecl); +@!us_string:string_type(max_lrecl); +@!rm_string:string_type(max_lrecl); +@!italic_last_page:boolean; + +@^System dependent code@> +@ {\it finish\_the\_process} is a procedure that is used to +first check to see if we are {\it on\_a\_roll}, which means we are formatting +something like pages 1-3. +After doing that, if there were any bold page numbers, they are concatenated +to the front of the {\it output\_string}; underscored page numbers (if any) +are concatenated to the end of the {\it output\_string}. + +@p procedure finish_the_process; +begin +@<Concatenate Bold Pages to Output@>;@/ +@<Concatenate Roman Pages to Output@>;@/ +@<Concatenate Underscored Pages to Output@>; +end; + +@ If there were any bold page numbers, then add them to the {\it +output\_string}. + +@<Concatenate Bold...@>= +if length(bold_string) > 0 then begin +if length(output_string) > 0 then add_cmma_blnk(output_string); +output_string := ccat(output_string,bold_string); +end + +@ If we were on a roll (a consecutive series of page numbers) then finish +the roll. Then if there were any roman or italic page numbers, add them to +the {\it output\_string}. + +@<Concatenate Roman...@>= +if on_a_roll then if italic_last_page +then rm_string := +ccat(ccat(ccat(rm_string,'{\it '),trim(prev_pg_string)),'}') +else rm_string := ccat(rm_string,prev_pg_string); +@.\bs{}it@> +if length(rm_string) > 0 then begin if length(output_string) > 0 +then add_cmma_blnk(output_string); +output_string := ccat(output_string,rm_string); +end + +@ If there were any underscored page numbers, add them to the {\it +output\_string} here. + +@<Concatenate Under...@>= +if length(us_string) > 0 then begin if length(output_string) > 0 +then add_cmma_blnk(output_string); +output_string := ccat(output_string,us_string); +end + +@ The procedure {\it start\_digesting} will initialize a few variables, +then add the {\it current\_page} to the appropriate list. + +@p procedure start_digesting; +begin @<Initialize Some Global Variables@>;@/ +prev_pg_string := curr_str_page;@/ +@<Do Appropriate Highlighting@>; +end; + +@ @<Initialize Some Global Variables@>= +italic_last_page := false; +bold_string := ''; us_string :=''; rm_string:=''; +starting_to_process:=false; +on_a_roll:=false + +@ @<Get the Current Print Type of this Page Number@>= +print_type:= curr_str_page[1]; +if (print_type='B') or (print_type='I') or (print_type='U') +then curr_str_page:=dosubstr(curr_str_page,2) +else print_type := ' ' + +@ @<Do Appropriate Highlighting@>= +if print_type = 'B' then do_when_bold +else if print_type = 'I' then do_when_italic +else if print_type = 'U' then do_when_underscore +else do_when_roman + +@^System dependent code@> +@ The procedure {\it digest\_the\_line} will take the full {\it str\_build} +and add the dashes when there is a run of page numbers (i.e. ``{\tt 1,2,3}'' bec +``1-3''); add the bold page numbers in front of the string (i.e. +``{\tt 1,2,B3,3,4}'' +prints as ``{\bf 3},1-4''. Note that page 3 had to appear twice +``{\tt B3,3}''. If it had only appeard as a bold page number and not the +default, ``{\tt 1,2,B3,4}'', you would get ``1-2,{\bf 3},4''); +add the underscored +page numbers to the end of the string (similar to bold page numbers, +``1,2,U3,3,4'' prints as ``1-4,\us{3}''); and print in italics when +necessary. + +@p procedure digest_the_line; +var +i:integer; +@!temp_roman:string_type(max_pn_alpha); +@!no_page_numbers:boolean; +begin +@<Process Each Page Number@>;@/ +@<Write the Line Out@>; +end; + +@ @<Global Var...@>= +@!starting_to_process :boolean; +@!print_type:char; +@!curr_str_page :string_type(max_pn_alpha); +@!curr_num_page :integer; + +@ Initialize the variables, then read each page number until the whole +string is digested, then finish off the page number string before returning. +If {\it str\_build} is null, then we are doing a blind entry with no +page numbers associated. In that case, initialize the highlighting +strings. +@<Process Each Page Number@>= +output_string := ''; +starting_to_process := true; +no_page_numbers:=false; +if length(str_build) > 0 +then repeat @<Digesting Each Page Number@> + until length(str_build) < 1 +else if starting_to_process then begin +@<Initialize Some Global Variables@>; +no_page_numbers:=true; +end; +finish_the_process; + +@ First get the next page number. Then if we are starting, initialize +everything. If we have already started, then check to see if we have a +consecutive page number sequence (i.e. pages 1,2,3,4 etc.) which is called +a `roll'. +@<Digesting Each Page Number@>= +@<Get Next Page Number@>;@/ +if starting_to_process +then start_digesting +else @<Check for a Roll@>; +prev_page_number:=curr_num_page; + +@ @<Get Next Page Number@>= +i := doindex(str_build,','); +if i < 1 then begin curr_str_page:=str_build; str_build:='';end +else begin +curr_str_page:=dosubstr(str_build,1,i-1); +str_build := dosubstr(str_build,i+1); +end; +@<Get the Current Print Type of this Page Number@>;@/ +if ord(curr_str_page[1]) < ord('0') {Then its alphabetic} +then @<Get Numeric for Roman Page Number@> +else curr_num_page:=get_numeric(curr_str_page); + +@ @<Get Numeric for Roman Page Number@>= +begin +i := doindex(str_build,','); +if i < 1 then begin temp_roman:=str_build; str_build:='';end +else begin +temp_roman:=dosubstr(str_build,1,i-1); +str_build := dosubstr(str_build,i+1); +end; +curr_num_page:=get_numeric(temp_roman); +end + +@ If we are on a roll, then the previous page number will be one less than +the current page number. If this is not the case, then {\it +finish\_the\_process} +and {\it start\_digesting} all over again. + +@<Check for a Roll@>= +if ((prev_page_number = curr_num_page) and (print_type <> ' ')) or + ((prev_page_number>=0) and (prev_page_number = curr_num_page - 1)) or + ((prev_page_number<0) and (prev_page_number = curr_num_page + 1)) +then begin +@<Got a Roll Going@> +prev_pg_string:=curr_str_page; +end +else begin finish_the_process; start_digesting; end + +@ Ok, so we're on a roll, right? If the {\it print\_type} is ``B'' (bold) or +``U'' (underscored) then do those and return. Otherwise, check to se if we +were previously {\it on\_a\_roll}. If we weren't, then add the hyphen to the +starting page number. In either case, move the {\it current\_page} to the +{\it prev\_pg\_string}. Lastly, if the page number is italic, then set +{\it italic\_last\_page} to true, in case it ends up being the last page in +the string. + +@<Got a Roll Going@>= +if print_type = 'B' then do_when_bold +else if print_type = 'U' then do_when_underscore +else begin if not on_a_roll then begin on_a_roll := true; +rm_string:=ccat(rm_string,'--'); end; +if print_type = 'I' then italic_last_page := true +else italic_last_page := false; +end; + +@ Before the page numbers are actually written, we need to write out +the ID depending on which level we are formatting. Level 1 is the +primary level, level 2 is the subentry1, and level 3 is subentry2. +Then, we need to do a couple of things depending on whether there is +dot leadering going on or not. +Finally, write the output string to the formatted index file. + +@<Write the Line Out@>= +write_prev_header; +if dot_leadering then begin @<Do Dot Leadering@> end +else begin @<Do not do Dot Leadering@> end; +do_lnwrite(ix_file,output_string); + +@ If there is dot leadering, then add the blind entry first, before adding +the leadering. + +@<Do Dot Leadering@>= +if length(str_blind_entry) > 0 +then begin +if length(output_string) > 0 then add_cmma_blnk(output_string); +output_string := ccat(output_string,str_blind_entry); +end; +output_string := ccat(ccat('\leader{}',output_string),'\par'); +@.\bs{}leader@> +@.\bs{}par@> + +@ @<Global Var...@>= +@!new_level_1:boolean; + +@ If there is not dot leadering, then the blind entry goes at the end of the +page, except for +the paragraph style ({\it print\_style}=1). Also, if the paragraph style, +then do not add the {\tt \bs{}par} at the end. Instead, add a comma +if there is a new level 1 entry. + +@<Do not do Dot Leadering@>= +if (print_style <> '1') and (length(str_blind_entry) > 0)@/ +then begin +if length(output_string) > 0 then add_cmma_blnk(output_string); +output_string := ccat(output_string,str_blind_entry); +end; +if print_style = '1' +then if new_level_1 and ((length(str_blind_entry)=0) or no_page_numbers) +then do_nothing +else add_cmma_blnk(output_string) +else output_string := ccat(output_string,'\par'); +@.\bs{}par@> + +@ The {\it build\_sorted\_index} procedure is the driving force behind +formatting the index. The basic process is to read all of the sorted records in +and create a record called {\it str\_build}. There will be one of these for +each primary and subentry level index. After doing the {\it str\_build}, +this record is then read through again to add the {\it\TeX T1} markup +necessary to +print out the sorted index line. + +@p procedure build_sorted_index; +var @!first_time_through:boolean; + +@ @<Global Var...@>= +@!prev_sr1:field_array; +@!prev_sr2:field_array; +@!prev_sr3:field_array; +@!prev_pn1:field_array; +@!prev_ln1:integer;{the length of pn1} +@!prev_pn2:field_array; +@!prev_ln2:integer;{the length of pn2} +@!prev_pn3:field_array; +@!prev_ln3:integer;{the length of pn3} +@!id1_is_missing:boolean; +@!id2_is_missing:boolean; + +@ The first thing we need to do is read the next sorted record. If this is the +first time ever through this procedure, then do some quick initializing. Then, +once we come to a new ID, we should write out the previous index page numbers, +etc. If the ID has not changed from the previous record, then add the page +number given here on the sorted record to the {\it str\_build}. + +@p begin first_time_through:=true; +while not eof(sort_file) do begin +sort_record:=sort_file@@; +get(sort_file); +if first_time_through then begin @<Do First Time Inits@> end; +if not equal_arrays(prev_sr1,sort_record.sort_part[1].field_level) +then begin +@<Start a New Level 1@> end +else if not equal_arrays(prev_sr2,sort_record.sort_part[2].field_level) +then begin +@<Start a New Level 2@> end +else if not equal_arrays(prev_sr3,sort_record.sort_part[3].field_level) +and (sort_record.record_type <> '9') +then begin +@<Start a New Level 3@> end +else add_page_number; +end; +@<Digest and Print Level 1@> +end; + +@ First write out the {\it \bs{}everyindex} record at the beginning +of the index file. + +@<Do First Time Inits@>= +do_lnwrite(ix_file,'\everyindex{',ix,'}'); +@.\bs{}everyindex@> + +@ These initializations only get done at the beginning of the +first sort record. + +@<Do First Time Inits@>= +first_time_through:=false; +id1_is_missing:=false; +id2_is_missing:=false; +new_level_1:=false; +with sort_record do begin +prev_sr1:=sort_part[1].field_level; +prev_sr2:=sort_part[2].field_level; +prev_sr3:=sort_part[3].field_level; +prev_pn1:=print[1].field_level; +prev_ln1:=print[1].field_lngth; +prev_pn2:=print[2].field_level; +prev_ln2:=print[2].field_lngth; +prev_pn3:=print[3].field_level; +prev_ln3:=print[3].field_lngth; +end; +prev_page_number:=0; +str_blind_entry:='';@/ +str_build:='';@/ + +@ If this is not a blind entry, then check to see if sort records for +the first level id are missing. If they are, then the id name itself +will be printed in {\it id1\_missing\_check}. + +@<Do First Time Inits@>= +if sort_record.record_type <> '9' +then id1_missing_check; + +@ Only alpha (a--z and A--Z) and numeric (0--9) characters get an +{\it \bs{}everyletterbreak}. Punctuation, for example, will not get +an {\it \bs{}everyletterbreak}. + +@<Do First Time Inits@>= +with sort_record.sort_part[1] do begin +if ((field_level[1]>='a') and (field_level[1]<='i')) or @/ +((field_level[1]>='j') and (field_level[1]<='r')) or @/ +((field_level[1]>='s') and (field_level[1]<='z')) or @/ +((field_level[1]>='A') and (field_level[1]<='I')) or @/ +((field_level[1]>='J') and (field_level[1]<='R')) or @/ +((field_level[1]>='S') and (field_level[1]<='Z')) or @/ +((field_level[1]>='0') and (field_level[1]<='9')) + then +do_lnwrite(ix_file,'\everyletterbreak{',ix,'}{',field_level[1],'}') + else +do_lnwrite(ix_file,'\everyletterbreak{',ix,'}{}'); +end +@.\bs{}everyletterbreak@> + +@ +First we need to {\it digest\_the\_line} which is the current index's +entry. {\it digest\_the\_line} will write out the formatted index unless +we are in the paragraph +style of formatted index +({\it print\_style}=1). If we are in the paragraph style, +then we need to write out any {\it str\_blind\_entry} pending. + +@<Digest and Print Level 1@>= +new_level_1:=true; +digest_the_line; +if print_style = '1' then +do_lnwrite(ix_file,str_blind_entry,'\par'); +new_level_1:=false; +@.\bs{}par@> + +@ We have just found the start of a new primary index level. +First we need to process the previous index's +entry. +If there is a blind entry, and it is style `1', then add it now. +Next, if we are at a letter break (i.e., going from the sorted ``A'' +primary index letters to the ``B''s) then write the ``{\tt +\bs{}everyletterbreak}'' to the formatted index file. + +@<Start a New Level 1@>= +@<Digest and Print Level 1@> +with sort_record.sort_part[1] do begin +if (field_level[1] <> prev_sr1[1]) +then if +(((field_level[1]>='a') and (field_level[1]<='i')) or @/ +((field_level[1]>='j') and (field_level[1]<='r')) or @/ +((field_level[1]>='s') and (field_level[1]<='z')) or @/ +((field_level[1]>='A') and (field_level[1]<='I')) or @/ +((field_level[1]>='J') and (field_level[1]<='R')) or @/ +((field_level[1]>='S') and (field_level[1]<='Z')) or @/ +((field_level[1]>='0') and (field_level[1]<='9'))) @/ +then do_lnwrite(ix_file,'\everyletterbreak{',ix,'}{',field_level[1],'}') + else +do_lnwrite(ix_file,'\everyletterbreak{',ix,'}{}'); +end; +@.\bs{}everyletterbreak@> + +@ The next thing to be done when starting a new primary index is to +check the subentries. If they exist, then you can assume that this +primary level index has no page numbers associated with it. The macro +{\it id1\_missing\_check} accomplishes this. + +@<Start a New Level 1@>= +curr_level:=1;@/ +if sort_record.record_type <> '9' +then id1_missing_check; + +@ The complicated stuff is done. So now we can actually do some simple +initializations to get this new level 1 (primary level) sort rolling. + +@<Start a New Level 1@>= +str_build:=''; +str_blind_entry:=''; +with sort_record do begin +prev_sr1:=sort_part[1].field_level; +prev_sr2:=sort_part[2].field_level; +prev_sr3:=sort_part[3].field_level; +prev_pn1:=print[1].field_level; +prev_ln1:=print[1].field_lngth; +prev_pn2:=print[2].field_level; +prev_ln2:=print[2].field_lngth; +prev_pn3:=print[3].field_level; +prev_ln3:=print[3].field_lngth; +prev_page_number:=0; +end; +add_page_number; + +@ We have just found the start of a new subentry1 index level. +These modules are similar to {\it Start a New Level 1}, but not as +detailed since it is dealing with fewer levels. +First we need to {\it digest\_the\_line} which is the previous index's +entry. {\it digest\_the\_line} will write out the formatted index unless +we are in the paragraph +style of formatted index +({\it print\_style}=1). + +@<Start a New Level 2@>= +digest_the_line; + +@ The next thing to be done when starting a new subentry1 index is to +check the subentry2. If it exists, then you can assume that this +subentry index has no page numbers associated with it. +This is done in {\it id2\_missing\_check}. + +@<Start a New Level 2@>= +id2_missing_check; + +@ The complicated stuff is done. So now we can actually do some simple +initializations to get this new level 2 (subentry2 level) sort rolling. + +@<Start a New Level 2@>= +str_build:=''; +if print_style <> '1' then str_blind_entry:=''; +with sort_record do begin +prev_sr2:=sort_part[2].field_level; +prev_sr3:=sort_part[3].field_level; +prev_pn2:=print[2].field_level; +prev_ln2:=print[2].field_lngth; +prev_pn3:=print[3].field_level; +prev_ln3:=print[3].field_lngth; +prev_page_number:=0; +end; +add_page_number; + +@ We have just found the start of a new subentry2 index level. +These modules are similar to {\it Start a New Level 2}, but not as +detailed since it is dealing with the lowest level. +First we need to {\it digest\_the\_line} which is the previous index's +entry. {\it digest\_the\_line} will write out the formatted index unless +we are in the paragraph +style of formatted index +({\it print\_style}=1). + +@<Start a New Level 3@>= +digest_the_line; +curr_level:=3; + +@ Do some +initializations to get this new level 3 (subentry2) sort rolling. + +@<Start a New Level 3@>= +str_build:=''; +if print_style <> '1' then str_blind_entry:=''; +with sort_record do begin +prev_sr3:=sort_part[3].field_level; +prev_pn3:=print[3].field_level; +prev_ln3:=print[3].field_lngth; +prev_page_number:=0; +end; +add_page_number; + +@* Main Program. +Ok, here is the main program. First we initialize (all\_blanks); then +set the ix\_file for input and the sort\_file for output; read all of the +entries, processing each one; close the files; sort; read the sorted file +in and build the entries, writing them back to the ix\_file to be read in +by the index markup. WHEW!! + +@p +begin @<Initialize Main@>@/ +termout(messages); +reset_file(ix);@/ +file_rewrite(s_file_number); {Should always be file 9}@/ +read_all_entries;@/ +close(ix_file);@/ +close(sort_file);@/ +@<Sort the Index@>@/ +reset_file(s_file_number);@/ +file_rewrite(ix);@/ +build_sorted_index;@/ +end; + +@ @<Initialize Main@>= +for i := 1 to max_field do all_blanks[i] := ' '; + +@ As mentioned earlier, {\it plsort} is an external PL/1 subroutine +@^PL/1@> +@^Syncsort@> +which is used to call Syncsort to sort the file. +The sort fields are as follows: +\halign{\hskip3em\hfill#\hfill&&\hskip3em\hfill#\hfill\cr +\bf Starting Column&\bf Length&\bf Field Description&\bf Order\cr +38&300&character&ascending\cr +342&300&character&ascending\cr +646&300&character&ascending\cr +10&4&binary&descending\cr +6&4&binary&ascending\cr} + +@<Global Var...@>= +sort_rc:integer; + +@ @<Sort the Index@>= +plsort(sort_rc); +if sort_rc = 0 + then writeln(messages,'Index Successfully Completed') + else writeln(messages,'Index Failed'); + +@* Index. +All modules in which an identifier is +used are listed with that identifier, except that reserved words are +indexed only when they appear in format definitions, and the appearances +of identifiers in module names are not indexed. Underlined entries +correspond to where the identifier was declared. Error messages, control +sequences put into the output, and a few +other things like ``Syncsort'' are indexed here too. diff --git a/macros/text1/texix/txt1v293.cmschan b/macros/text1/texix/txt1v293.cmschan new file mode 100644 index 0000000000..8f6bbe5a16 --- /dev/null +++ b/macros/text1/texix/txt1v293.cmschan @@ -0,0 +1,2000 @@ +TEX.CMS-CHAN - WEB change file for TeX 2.0 for VM/CMS and Pascal/VS. +Copyright (C) 1984 by David Fuchs. All rights are reserved. + +External references: TERMATTN, ATTN202, USESTACK. Assembled + text decks of these routines must be linked into module. + +Changes to this file since 1.0 version (at SLAC): + + Added increased mem size params etc from VMS-CHAN, + XEDIT hook, change ".log" to ".texlog". 11 Feb 84 + Fixed filemode specifier so you can "\input fn.ft.fm". 9 Mar 84 + Update line number references from TeX 1.0 to TeX 1.1. 20 Mar 84 + Increase |buf_size| parameter from 500 to 1024. 24 Apr 84 + Add CMS hook to send string to CMS using "\write15". 24 Apr 84 + Various small changes in comments in TeX. 12 Jul 84 + Change |pool_name| from "TEX.POOL" to "TEX.POOL.*". 21 Aug 84 + File mode "*" added to |prompt_file_name| on input. 23 Aug 84 + Allow tab and formfeed characters in input. 23 Aug 84 + Increase |pool_size| to 40000. 23 Aug 84 + ONERROR message deleted. 23 Aug 84 + DVI block size changed to 1024. 24 Aug 84 + SLAC character translates (hex): 4F->4A, 6A->4F, A1->5F. 27 Sep 84 + Add SLAC routines for logging use data. 27 Sep 84 + Update for TeX 1.4. 24 Feb 86 + Remove |ready_already| as per Klaus Thull's recommendation. 24 Feb 86 + Increase |hash_size| to 3000. 26 Feb 86 + Update for TeX 2.0. 10 Mar 86 + Add Chris Thompson's changes for large arrays, |use_stack|, + and do simple array asignments for |do_all_six|. 25 Mar 86 + Add code in |close_files_and_terminate| to explicitly close + all input files. Avoids Pascal/VS loop in AMPXIO. 6 May 86 + Allow |mem| array to start at negative index. 8 May 86 + Increase |pool_size| to 50000. 9 May 86 + Move |ret_code| from |end_of_TEX:| to |final_end:| and make + |history|:=|fatal_error_stop| if |bad_fmt|. 15 May 86 + Remove SLAC-specific routines and character translates + to conform to TeX Project (hex): 5F->A1, 4A->5F. 4 Jun 86 + Change |tfm_file| reading routine to read multiple 1024-byte + records. All TeX/MF data files are now RECFM F LRECL 1024. 2 Jul 86 + + Changes for TEXT1 by Dean Guenther 20 Aug 86 + Banner now reflects TEXT1 at WEB line 148 + DVI size changes to 2048 (4096) WEB line 345 + Variable tfm_buf_size added at WEB line 345 + (init'd at 1024) + tfm_buf_size replaces len_byte_block in system dependent + procedure fget in WEB code at line 23949 + Square brackets around the page numbers changed to + angle brackets at WEB line 12302 + Module's name changed to TXT1V2M0 at WEB line 212 + buf_size changed from 1024 to 2048 + + Changes by Dean Guenther 20 Dec 86 + Changes added to make \printindex a TeX primative. Refer to Web + lines 23602-23725 below. + Module's name changed to TXT1V2M1 at WEB line 212 + + Changes by Brian Harvey + Module's name is changed to TXT1V212 at WEB line 212 + Banner line changed "TEXT1 (TEX 2.1)" 16 June 87 + + Changes by Dean Guenther + Installed fixes for TeX 2.2, 2.3, 2.4, 2.5, 2.6 & 2.7 25 Nov 87 + Module is named TXT1V271 for TeX 2.7, mod 1 + Installed fixes for TeX 2.8 & 2.9 11 Jan 88 + Installed fixes for TeX 2.91, 2.92, & 2.93 2 Sep 88 + Now using 1k dvi files instead of 2k + Module is named TXT1V293 for TeX 2.93 + +TeX 2.0 WEB source line 34 +@x limbo +\def\ph{\hbox{Pascal-H}} +@y +\def\ph{\hbox{Pascal-H}} +\def\pvs{\hbox{Pascal/VS}} +@z + +TeX 2.0 WEB source line 60 +@x limbo +\pageno=3 +@y +\pageno=3 +\let\maybe=\iffalse % to TeX only the changed sections after WEAV'ing +\def\title{\TeX\ changes for VM/CMS} +@z + +TeX 2.0 WEB source line 148 +@x +@d banner=='This is TeX, Version 2.93' {printed when \TeX\ starts} +@y +The VM/CMS port of \TeX\ is a combination of efforts of many people. +\.{WEB} change files for preliminary versions of \TeX\ were brought to +the \TeX\ Users Group meeting in August 1983 and +given to David Fuchs, of Stanford +University Computer Science Department, who combined them into a +definitive version on the VM system at Stanford Linear Accelerator +Center. The original change files were supplied by Roger Chaffee of +SLAC (now at Metaphor), Craig Platt of the University of Manitoba, and +Peter M.~Sih of IBM Palo Alto Scientific Center. Bernd Schulze of the +University of Bonn contributed his experience from bringing up a +preliminary \TeX\ under CMS and has since sent many +further improvements including the Metafont change file used in this +implementation and other CMS change files. +Other CMS change files and suggestions were made by Klaus Thull. +All of this work was based on preliminary +work adapting \TeX\ to MVS by Eagle Berns and Susan Plass of Stanford +University. Peter Sih has donated countless hours of his expertise +and contributed the device support for the IBM 4250 and APA6670 (and +3800 model 3) printers. Many valuable revisions and additions to this +work were made by Robert J.~Creasy. +Alan Spragens at SLAC coordinated +communication among the CMS sites and made some enhancements to the +implementation while revising the CMS change file for \TeX\ versions +1.1 and 2.0. Significant improvements were contributed for version +2.0 by Chris Thompson of the University of Cambridge; they are +described in the ``System-dependent Changes'' section. +@d banner=='TEXT1 (TEX 2.93)' + {printed when \TeX\ starts} +@d term_in==tty_in +@d term_out==tty_out +@d string_length==len @& gth {IBM length function} +@d string_index ==ind @& ex {IBM index function} +@z + + +TeX 2.0 WEB source line 212 +@x +program TEX; {all file names are defined dynamically} +@y +program TXT1V293; {all file names are defined dynamically} +@z + +TeX 2.0 WEB source line 218 +@x +procedure initialize; {this procedure gets things started properly} +@y +@<Large array variables@>@/ +@<VM/CMS procedures@>@/ +@# +procedure initialize; {this procedure gets things started properly} +@z + +TeX 2.0 WEB source line 261 +@x +@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} +@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} +@y +@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} +@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} +@z + +TeX 2.0 WEB source line 266 +@x +@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== +@z + +TeX 2.0 WEB source line 281 +@x +@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version} +@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version} +@y virtex: init==@{ tini==@} initex: init== tini== +@d init==@{ +@d tini==@} +@z + +TeX 2.0 WEB source line 333 +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +TeX 2.0 WEB source line 345 +@x +@!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} +@!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} +@.TeXformats@> +@y +@!mem_max=32766; {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=-32768; {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|} +@!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=6; {maximum number of input files and error insertions that + can be going on simultaneously} +@!font_max=120; {maximum internal font number; must not exceed |max_quarterword| + and must be at most |font_base+256|} +@!font_mem_size=30000; {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=5000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=26000; {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=50000; {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} +@!dvi_buf_size=2048; {size of the output buffer; must be a multiple of 8} +@!len_byte_block=1024; {must be half of |dvi_buf_size|} +@!tfm_buf_size=1024; +@!len_word_block=256; {format file buffer length} +@!file_name_size=40; {file names shouldn't be longer than this} +@!pool_name='TEX.POOl.* '; + {string of length |file_name_size|; tells where the string pool appears} +@.TeXformats@> +@z + +TeX 2.0 WEB source line 395 +@x +@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|, but 2100 is already quite generous} +@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|} +@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} +@^system dependencies@> +@y +@d mem_bot==-32768 {smallest index in the |mem| array dumped by \.{INITEX}; + must not be less than |mem_min|} +@d mem_top==32766 {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=3000 {maximum number of control sequences; it should be at most + about |(mem_max-mem_min)/10|, but 2100 is already quite generous} +@d hash_prime=2549 {a prime number equal to about 85\% of |hash_size|} +@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} +@^system dependencies@> +@z + +TeX 2.0 WEB source line 503 +@x +@!ASCII_code=0..127; {seven-bit numbers} +@y +@!ASCII_code=packed 0..127; {seven-bit numbers} +@z + +TeX 2.0 WEB source line 533 +@x +@d last_text_char=127 {ordinal number of the largest element of |text_char|} +@y +@d last_text_char=255 {ordinal number of the largest element of |text_char|} +@z + +TeX 2.0 WEB source line 689 +@x [2] System-dependent character set changes: +@^character set dependencies@> +@^system dependencies@> + +@<Set init...@>= +for i:=1 to @'37 do xchr[i]:=' '; +@y +For \pvs\ we allow |form_feed| and |tab| characters in input. +@^character set dependencies@> +@^system dependencies@> + +@d form_feed=@'14 +@d tab=@'05 + +@<Set initial values...@>= +for i:=1 to @'37 do xchr[i]:=' '; +xchr[form_feed]:=chr(form_feed); +xchr[tab]:=chr(tab); +@z + +TeX 2.0 WEB source line 737 +@x +for us to specify simple operations on word files before they are defined. + +@<Types...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!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 +for us to specify simple operations on word files before they are defined. + +@d alpha_file==@= TEXT@> +@d ccat==@=||@> + +@<Types...@>= +@!eight_bits=packed 0..255; {unsigned one-byte quantity} +@z + +TeX 2.0 WEB source line 790 +@x +begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f); +@y +begin okstatus; reset(f,'NAME='ccat@, trim(str(name_of_file))); + a_open_in:=status; +@z + +TeX 2.0 WEB source line 795 +@x +begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f); +@y +var buf_string:string(4); +begin okstatus; +writestr(buf_string,buf_size:4); +rewrite(f,'NAME='ccat@, trim(str(name_of_file)) +ccat ',LRECL=' ccat buf_string); + a_open_out:=status; +@z + +TeX 2.0 WEB source line 800 +@x +begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f); +@y +begin okstatus; reset(f,'NAME='ccat@, trim(str(name_of_file) ccat'.*')); + b_open_in:=status; +@z + +TeX 2.0 WEB source line 805 +@x +begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f); +@y +begin okstatus; rewrite(f,'NAME='ccat@, trim(str(name_of_file))); + b_open_out:=status; +@z + +TeX 2.0 WEB source line 810 +@x +begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f); +@y +begin okstatus; reset(f,'NAME='ccat@, trim(str(name_of_file) ccat'.*')); + w_open_in:=status; +@z + +TeX 2.0 WEB source line 815 +@x +begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f); +@y +begin okstatus; rewrite(f,'NAME='ccat@, trim(str(name_of_file))); + w_open_out:=status; +@z + +TeX 2.0 WEB source line 855 +@x +@<Glob...@>= +@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read} +@y +@d LA_buffer== +@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read} + +@<Glob...@>= +@z + +TeX 2.0 WEB source line 901 +@x +@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 + overflow("buffer size",buf_size); +@:TeX capacity exceeded buffer size}{\quad buffer size@> + 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 +@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 + overflow("buffer size",buf_size); +@:TeX capacity exceeded buffer size}{\quad buffer size@> + end; + buffer[last]:=xord[f@@]; get(f); incr(last); {@@ is \pvs\ pointer notation} + if buffer[last-1]<>" " then last_nonblank:=last; + end; + last:=last_nonblank; input_ln:=true; + end; +end; +@z + +TeX 2.0 WEB source line 933 +@x +@ 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 +in \pvs. There is no need to do a |reset| or |rewrite| or suppress +the first |get| as with \ph. +@d t_open_in==@= TERMIN@>(term_in) {open the terminal for text input} +@d t_open_out==@= TERMOUT@>(term_out); {open the terminal for text output} +@z + +TeX 2.0 WEB source line 949 +@x +some instruction to the operating system. The following macros show how +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 +some instructions to the operating system. The following macros were +used to specify these operations in \ph\ but have been made into +``no-ops'' for \pvs. +@d update_terminal == do_nothing +@d clear_terminal == do_nothing +@d wake_up_terminal == do_nothing +@z + +TeX 2.0 WEB source line 1011 +@x +@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; +@y +@p function init_terminal:boolean; {gets the terminal input started} +label exit; +var i,j,k: integer; + l: string(256); +begin t_open_in; + l:=parms; + if l<>'' then begin + i:=@=LENGTH@>(l); + j:=min(i,buf_size-first); {this much will fit} + if j>0 then for k:=0 to j-1 do buffer[first+k]:=xord[l[k+1]]; + last:=first+j; + max_buf_stack:=max(max_buf_stack,last); + loc:=first; + init_terminal:=true; + return + end; +loop@+begin wake_up_terminal; write_ln(term_out,'**'); update_terminal; +@z + +TeX 2.0 WEB source line 1072 +@x +@ @<Glob...@>= +@!str_pool:packed array[pool_pointer] of ASCII_code; {the characters} +@!str_start : array[str_number] of pool_pointer; {the starting pointers} +@y +@ @d LA_string== +@!str_pool:packed array[pool_pointer] of ASCII_code; {the characters} +@!str_start : array[str_number] of pool_pointer; {the starting pointers} + +@<Glob...@>= +@z + +The following change is to use \write15 to send stuff to CMS +TeX 2.0 WEB source line 1373 +@x +@ To end a line of text output, we call |print_ln|. + +@<Basic print...@>= +procedure print_ln; {prints an end-of-line} +begin case selector of +term_and_log: begin wterm_cr; wlog_cr; + term_offset:=0; file_offset:=0; + end; +log_only: begin wlog_cr; file_offset:=0; + end; +term_only: begin wterm_cr; term_offset:=0; + end; +no_print,pseudo,new_string: do_nothing; +othercases write_ln(write_file[selector]) +endcases;@/ +end; {|tally| is not affected} +@y +@ To end a line of text output, we call |print_ln|. +In CMS \TeX\ we also use |print_ln| to send a message +to the operating system using the \.{\\write15} stream. + +@<Basic print...@>= +procedure print_ln; {prints an end-of-line} +var i:integer; +begin case selector of +term_and_log: begin wterm_cr; wlog_cr; + term_offset:=0; file_offset:=0; + end; +log_only: begin wlog_cr; file_offset:=0; + end; +term_only: begin wterm_cr; term_offset:=0; + end; +no_print,pseudo,new_string: do_nothing; +15: begin cms(trim(str(cms_buf)), irc); {send \.{\\write15} to CMS} + for i:=1 to cms_ptr do cms_buf[i]:=' '; + cms_ptr:=1; end; +othercases write_ln(write_file[selector]) +endcases;@/ +end; {|tally| is not affected} +@z + +The following change is to use \write15 to send stuff to CMS +TeX 2.0 WEB source line 1394 +@x +@<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 +@<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} +15: begin cms_buf[cms_ptr]:=xchr[s]; incr(cms_ptr); end; +othercases write(write_file[selector],xchr[s]) +endcases;@/ +incr(tally); +exit:end; +@z + +The following change is to use \write15 to send stuff to CMS +TeX 2.0 WEB source line 1623 +@x +if not input_ln(term_in,true) then fatal_error("End of file on the terminal!"); +@y +write_ln(term_out); +if not input_ln(term_in,true) then fatal_error("End of file on the terminal!"); +@z + +TeX 2.0 WEB source line 1814 +@x +wizardry, so the present implementation simply types out what file should be +edited and the relevant line number. +@^system dependencies@> + +There is a secret `\.D' option available when the debugging routines have +not been commented out. +@^debugging@> + +@<Interpret code |c| and |return| if done@>= +case c of +"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then + @<Delete |c-"0"| tokens and |goto continue|@>; +@t\4\4@>@;@+@!debug "D": begin debug_help; goto continue;@+end;@+gubed@/ +"E": if base_ptr>0 then + begin print_nl("You want to edit file "); +@.You want to edit file x@> + print(input_stack[base_ptr].name_field); + print(" at line "); print_int(line); + interaction:=scroll_mode; jump_out; + end; +"H": @<Print the help information and |goto continue|@>; +"I":@<Introduce new material from the terminal and |return|@>; +"Q","R","S":@<Change the interaction level and |return|@>; +"X":begin interaction:=scroll_mode; jump_out; + end; +othercases do_nothing +endcases;@/ +@<Print the menu of available options@> +@y +wizardry, so the standard implementation simply types out what file should be +edited and the relevant line number. +The CMS implementation uses an external assembly routine |attn202| to +invoke XEDIT with ``:|line|'' in the +program stack. +@^system dependencies@> + +There is a secret `\.D' option available when the debugging routines have +not been commented out. +@^debugging@> + +@<Interpret code |c| and |return| if done@>= +case c of +"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then + @<Delete |c-"0"| tokens and |goto continue|@>; +@t\4\4@>@;@+@!debug "D": begin debug_help; goto continue;@+end;@+gubed@/ +"E": if base_ptr>0 then + begin print_nl("You want to edit file "); +@.You want to edit file x@> + print(input_stack[base_ptr].name_field); + print(" at line "); print_int(line); + inp_line:='XEDIT '; + s1:=selector; + tally:=0; selector:=pseudo; + print(input_stack[base_ptr].name_field); + for s2:=0 to tally-1 do inp_line[s2+7]:=xchr[trick_buf[s2]]; + s2:=string_index(inp_line,'.'); if s2>0 then inp_line[s2]:=' '; + s2:=string_index(inp_line,'.'); if s2>0 then inp_line[s2]:=' '; + attn202('FIFO ',inp_line); + tally:=0; inp_line:=' '; + print_int(line); + inp_line[1]:=':'; + for s2:=0 to tally-1 do inp_line[s2+2]:=xchr[trick_buf[s2]]; + attn202('FIFO ',inp_line); + ret_code(12); + selector:=s1; + interaction:=scroll_mode; jump_out; + end; +"H": @<Print the help information and |goto continue|@>; +"I":@<Introduce new material from the terminal and |return|@>; +"Q","R","S":@<Change the interaction level and |return|@>; +"X":begin interaction:=scroll_mode; jump_out; + end; +othercases do_nothing +endcases;@/ +@<Print the menu of available options@> +@z + +TeX 2.0 WEB source line 2030 +@x +interrupt:=0; OK_to_interrupt:=true; +@y +interrupt:=0; OK_to_interrupt:=true; +term_attn(interrupt); +@z + +TeX 2.0 WEB source line 2277 +@x +@!glue_ratio=real; {one-word representation of a glue expansion factor} +@y +@!glue_ratio=shortreal; {are there any other reals in the program?} +@z + +TeX 2.0 WEB source line 2330 +@x +@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=255 {largest allowable value in a |quarterword|} +@d min_halfword==-32768 {smallest allowable value in a |halfword|} +@d max_halfword==32767 {largest allowable value in a |halfword|} +@z + +TeX 2.0 WEB source line 2363 +@x +@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(#)==# + {to put an |eight_bits| item into a quarterword} +@d qo(#)==# + {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} +@z + +TeX 2.0 WEB source line 2378 +@x +@!quarterword = min_quarterword..max_quarterword; {1/4 of a word} +@!halfword=min_halfword..max_halfword; {1/2 of a word} +@!two_choices = 1..2; {used when there are two variants in a record} +@!four_choices = 1..4; {used when there are four variants in a record} +@y +@!quarterword = packed min_quarterword..max_quarterword; {1/4 of a word} +@!halfword=packed min_halfword..max_halfword; {1/2 of a word} +@!two_choices=packed 1..2; {used when there are two variants in a record} +@!four_choices=packed 1..4; {when there are four variants in a record} +@z + +TeX 2.0 WEB source line 2401 +@x +@!word_file = file of memory_word; +@y +@!word_block = packed array [0..len_word_block-1] of memory_word; +@!word_file = packed file of word_block; +@!byte_block = packed array [0..len_byte_block-1] of quarterword; +@!byte_file = packed file of byte_block; +@z + +TeX 2.0 WEB source line 2466 +@x +deallocating them after their use. + +@<Glob...@>= +@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area} +@y +deallocating them after their use. + +For \pvs\ we have declared the big |mem| array in the ``large array +variables'' module. It is defined here in terms of a macro expanded +near the end of the program. All such ``large array'' macros begin +with ``|LA_|.'' + +@d LA_mem== +@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area} + +@<Glob...@>= +@z + +TeX 2.0 WEB source line 3268 +@x +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) + +@<Glob...@>= +@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells} +@t\hskip1em@>@!was_free: packed array [mem_min..mem_max] of boolean; + {previously free cells} +@t\hskip1em@>@!was_mem_end,@!was_lo_max,@!was_hi_min: pointer; +@y +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) + +@d LA_mem_debug== +@!free: packed array [mem_min..mem_max] of boolean; {free cells} +@!was_free: packed array [mem_min..mem_max] of boolean; + {previously free cells} + +@<Glob...@>= +@!debug @!was_mem_end,@!was_lo_max,@!was_hi_min: pointer; +@z + +TeX 2.0 WEB source line 3653 +@x + if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?") +@y + if false then print("?.?") {no need to check value in 370 architecture} +@z + +TeX 2.0 WEB source line 4218 +@x +@<Glob...@>= +@!nest:array[0..nest_size] of list_state_record; +@y +@d LA_nest== +@!nest:array[0..nest_size] of list_state_record; + +@<Glob...@>= +@z + +TeX 2.0 WEB source line 5085 +@x +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} +end; +@y +is needed. The standard program +here simply specified July 4, 1776, at noon; but +we want a better approximation to the truth. + +@p procedure fix_date_and_time; +var date,tod:alfa; hour, minute:integer; +begin datetime(date,tod); +readstr(str(date),month:3,day:3,year); +year:=year+1900;{Bug next century} +readstr(str(tod),hour:3,minute); time:=hour*60+minute; +end; +@z + +TeX 2.0 WEB source line 5289 +@x +called |xeq_level|. + +@<Glob...@>= +@!eqtb:array[active_base..eqtb_size] of memory_word; +@!xeq_level:array[int_base..eqtb_size] of quarterword; +@y +called |xeq_level|. + +@d LA_eqtb== +@!eqtb:array[active_base..eqtb_size] of memory_word; +@!xeq_level:array[int_base..eqtb_size] of quarterword; +@z + +TeX 2.0 WEB source line 5336 +@x +@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied} +@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name} + +@<Glob...@>= +@!hash: array[hash_base..undefined_control_sequence-1] of two_halves; + {the hash table} +@y +@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied} +@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name} +@# +@d LA_hash== +@!hash: array[hash_base..undefined_control_sequence-1] of two_halves; + {the hash table} + +@<Glob...@>= +@z + +TeX 2.0 WEB source line 5721 +@x +@ @<Glob...@>= +@!save_stack : array[0..save_size] of memory_word; +@y +@ @d LA_save_stack== +@!save_stack : array[0..save_size] of memory_word; + +@<Glob...@>= +@z + +TeX 2.0 WEB source line 6277 +@x +@ @<Glob...@>= +@!input_stack : array[0..stack_size] of in_state_record; +@y +@ @d LA_input_stack== +@!input_stack : array[0..stack_size] of in_state_record; + +@<Glob...@>= +@z + +TeX 2.0 WEB source line 6543 +@x +rate from the others. + +@<Glob...@>= +@!param_stack:array [0..param_size] of pointer; + {token list pointers for parameters} +@y +rate from the others. + +@d LA_param_stack== +@!param_stack:array [0..param_size] of pointer; + {token list pointers for parameters} + +@<Glob...@>= +@z + +TeX 2.0 WEB source line 9736 +@x +@d TEX_area=="TeXinputs:" +@.TeXinputs@> +@d TEX_font_area=="TeXfonts:" +@.TeXfonts@> +@y +@d TEX_area==".*" +@.TeXinputs@> +@d TEX_font_area=="" +@.TeXfonts@> +@z + +TeX 2.0 WEB source line 9751 +@x +@p function more_name(@!c:ASCII_code):boolean; +begin if c=" " then more_name:=false +else begin if (c=">")or(c=":") then + begin area_delimiter:=pool_ptr; ext_delimiter:=0; + end + else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr; + str_room(1); append_char(c); {contribute |c| to the current string} + more_name:=true; + end; +end; +@y +@p function more_name(@!c:ASCII_code):boolean; +var ret:boolean; +begin +if c=" " then ret:=false +else begin ret:=true; + if (c=".")then if ext_delimiter=0 then ext_delimiter:=pool_ptr + else if area_delimiter=0 then area_delimiter:=pool_ptr + else ret:=false; + if ret then begin {contribute |c| to the current string} + str_room(1); append_char(c); end; + end; +more_name:=ret; +end; +@z + +TeX 2.0 WEB source line 9769 +@x +if area_delimiter=0 then cur_area:="" +else begin cur_area:=str_ptr; incr(str_ptr); + str_start[str_ptr]:=area_delimiter+1; + end; +if ext_delimiter=0 then + begin cur_ext:=""; cur_name:=make_string; + end +else begin cur_name:=str_ptr; incr(str_ptr); + str_start[str_ptr]:=ext_delimiter; cur_ext:=make_string; + end; +end; +@y +if ext_delimiter=0 then begin cur_area:=""; cur_ext:=""; + cur_name:=make_string; end +else begin cur_name:=str_ptr; incr(str_ptr); + str_start[str_ptr]:=ext_delimiter; + if area_delimiter=0 then + begin cur_area:=""; cur_ext:=make_string; + end + else begin cur_ext:=str_ptr; incr(str_ptr); + str_start[str_ptr]:=area_delimiter; cur_area:=make_string; + end; + end; +end; +@z + +TeX 2.0 WEB source line 9788 +@x +begin print(a); print(n); print(e); +@y +begin print(n); print(e); print(a); +@z + +TeX 2.0 WEB source line 9800 +@x +@p procedure pack_file_name(@!n,@!a,@!e:str_number); +@y +@p procedure pack_file_name(@!a,@!e,@!n:str_number); +@z + +TeX 2.0 WEB source line 9818 +@x +@d format_default_length=20 {length of the |TEX_format_default| string} +@d format_area_length=11 {length of its area part} +@y +@d format_default_length=9 {length of the |TEX_format_default| string} +@d format_area_length=0 {length of its area part} +@z + +TeX 2.0 WEB source line 9826 +@x +TEX_format_default:='TeXformats:plain.fmt'; +@y +TEX_format_default:='plain.fmt'; +@z + +TeX 2.0 WEB source line 9998 +@x +clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>; +if cur_ext="" then cur_ext:=e; +pack_cur_name; +@y +clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>; +if cur_ext="" then cur_ext:=e; +if (s="input file name") and (cur_area="") then cur_area:=TEX_area; +pack_cur_name; +@z + +TeX 2.0 WEB source line 10034 +@x +@p procedure open_log_file; +var old_setting:0..max_selector; {previous |selector| setting} +@!k:0..buf_size; {index into |months| and |buffer|} +@!l:0..buf_size; {end of first input line} +@!months:packed array [1..36] of char; {abbreviations of month names} +begin old_setting:=selector; +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); +selector:=log_only; +@y +@p procedure open_log_file; +var old_setting:0..max_selector; {previous |selector| setting} +@!k:0..buf_size; {index into |months| and |buffer|} +@!l:0..buf_size; {end of first input line} +@!months:packed array [1..36] of char; {abbreviations of month names} +begin old_setting:=selector; +if job_name=0 then job_name:="texput"; +@.texput@> +pack_job_name(".texlog"); +while not a_open_out(log_file) do @<Try to get a different log file name@>; +log_name:=a_make_name_string(log_file); +selector:=log_only; +@z + +TeX 2.0 WEB source line 10089 +@x +@p procedure start_input; {\TeX\ will \.{\\input} something} +label done; +begin scan_file_name; {set |cur_name| to desired file name} +if cur_ext="" then cur_ext:=".tex"; +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"); + end; +done: name:=a_make_name_string(cur_file); +if job_name=0 then + begin job_name:=cur_name; open_log_file; +@y +@p procedure start_input; {\TeX\ will \.{\\input} something} +label done; +begin scan_file_name; {set |cur_name| to desired file name} +if cur_ext="" then cur_ext:=".tex"; +if cur_area="" then cur_area:=TEX_area; +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; + end_file_reading; {remove the level that didn't work} + prompt_file_name("input file name",".tex"); + end; +done: name:=a_make_name_string(cur_file); +if job_name=0 then + begin job_name:=cur_name; open_log_file; +@z + +|flush_string| removed--spoils XEDIT invocation +TeX 2.0 WEB source line 10110 +@x +print_char("("); print(name); update_terminal; state:=new_line; +if name=str_ptr-1 then {we can conserve string pool space now} + begin flush_string; name:=cur_name; + end; +@<Read the first line of the new file@>; +end; +@y +print_char("("); print(name); update_terminal; state:=new_line; +@<Read the first line of the new file@>; +end; +@z + +TeX 2.0 WEB source line 10399 +@x +@ Here now is the (rather formidable) array of font arrays. + +@<Glob...@>= +@!font_info:array[0..font_mem_size] of memory_word; + {the big collection of font data} +@!fmem_ptr:0..font_mem_size; {first unused word of |font_info|} +@!font_ptr:internal_font_number; {largest internal font number in use} +@!font_check:array[internal_font_number] of four_quarters; {check sum} +@!font_size:array[internal_font_number] of scaled; {``at'' size} +@!font_dsize:array[internal_font_number] of scaled; {``design'' size} +@!font_params:array[internal_font_number] of halfword; {how many font + parameters are present} +@!font_name:array[internal_font_number] of str_number; {name of the font} +@!font_area:array[internal_font_number] of str_number; {area of the font} +@!font_bc:array[internal_font_number] of eight_bits; + {beginning (smallest) character code} +@!font_ec:array[internal_font_number] of eight_bits; + {ending (largest) character code} +@!font_glue:array[internal_font_number] of pointer; + {glue specification for interword space, |null| if not allocated} +@!font_used:array[internal_font_number] of boolean; + {has a character from this font actually appeared in the output?} +@!hyphen_char:array[internal_font_number] of integer; + {current \.{\\hyphenchar} values} +@!skew_char:array[internal_font_number] of integer; + {current \.{\\skewchar} values} +@y +@ Here now is the (rather formidable) array of font arrays. + +@d LA_font1== +@!font_info:array[0..font_mem_size] of memory_word; + {the big collection of font data} +@!font_check:array[internal_font_number] of four_quarters; {check sum} +@!font_size:array[internal_font_number] of scaled; {``at'' size} +@!font_dsize:array[internal_font_number] of scaled; {``design'' size} +@!font_params:array[internal_font_number] of halfword; {how many font + parameters are present} +@!font_name:array[internal_font_number] of str_number; {name of the font} +@!font_area:array[internal_font_number] of str_number; {area of the font} +@!font_bc:array[internal_font_number] of eight_bits; + {beginning (smallest) character code} +@!font_ec:array[internal_font_number] of eight_bits; + {ending (largest) character code} +@!font_glue:array[internal_font_number] of pointer; + {glue specification for interword space, |null| if not allocated} +@!font_used:array[internal_font_number] of boolean; + {has a character from this font actually appeared in the output?} +@!hyphen_char:array[internal_font_number] of integer; + {current \.{\\hyphenchar} values} +@!skew_char:array[internal_font_number] of integer; + {current \.{\\skewchar} values} + +@<Glob...@>= +@!fmem_ptr:0..font_mem_size; {first unused word of |font_info|} +@!font_ptr:internal_font_number; {largest internal font number in use} +@z + +TeX 2.0 WEB source line 10435 +@x +@<Glob...@>= +@y +@d LA_font2== +@z + +TeX 2.0 WEB source line 10639 +@x +@ @<Open |tfm_file| for input@>= +@y +@ @<Open |tfm_file| for input@>= +tfm_count:=0; +@z + +TeX 2.0 WEB source line 10654 +@x +@d fget==get(tfm_file) +@d fbyte==tfm_file^ +@y +@ In CMS we know that \.{TFM} files have a logical record length of +1024 bytes, so we do one |get(tfm_file)| per CMS record. Then, since +|tfm_file| is a |byte_file| which is a |file of byte_block| which are +arrays of 1024 bytes, we refer to each byte in the record while it is +in the file buffer, avoiding the need to |get(tfm_file)| for each byte. +Note that |fget| procedure is defined at the end of the program. +@d fbyte==tfm_file@@[tfm_count] {@@ is \pvs\ pointer notation} +@z + +TeX 2.0 WEB source line 11527 +@x +@ 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@> +@y +@ We play a trick with variant records so that we can fill up the +|dvi_buf| array byte by byte, but write it out in one swell foop. +@^system dependencies@> +@d dvi_buf==d_buffer.b {buffer for \.{DVI} output} +@z + +TeX 2.0 WEB source line 11531 +@x +@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output} +@y +@!d_buffer: packed record + case boolean of + false:(b:packed array [dvi_index] of eight_bits); + true: (l:byte_block; r:byte_block); + end; +@z + +TeX 2.0 WEB source line 11547 +@x +@ 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 had +better be sure things line up properly. +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@> + +@<Check the ``const...@>= +if dvi_buf_size<>2*len_byte_block then bad:=223; +@z + +TeX 2.0 WEB source line 11572 +@x + begin write_dvi(0,half_buf-1); dvi_limit:=half_buf; +@y + begin write(dvi_file,d_buffer.l); dvi_limit:=half_buf; +@z + +TeX 2.0 WEB source line 11575 +@x +else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size; +@y +else begin write(dvi_file,d_buffer.r); dvi_limit:=dvi_buf_size; +@z + +TeX 2.0 WEB source line 11584 +@x +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 then write(dvi_file,d_buffer.r); +for k:=dvi_ptr to dvi_buf_size do dvi_buf[k]:=223; {bug is |k| ok?} +if dvi_ptr>0 then write(dvi_file,d_buffer.l); +if dvi_ptr>half_buf then write(dvi_file,d_buffer.r); +@z + +TeX 1.1 WEB source line 12302 +@x +print_char("["); j:=9; +while (count(j)=0)and(j>0) do decr(j); +for k:=0 to j do + begin print_int(count(k)); + if k<j then print_char("."); + end; +update_terminal; +if tracing_output>0 then + begin print_char("]"); + begin_diagnostic; show_box(p); end_diagnostic(true); + end; +@<Ship box |p| out@>; +if tracing_output<=0 then print_char("]"); +@y +print_char("<"); j:=9; +while (count(j)=0)and(j>0) do decr(j); +for k:=0 to j do + begin print_int(count(k)); + if k<j then print_char("."); + end; +update_terminal; +if tracing_output>0 then + begin print_char(">"); + begin_diagnostic; show_box(p); end_diagnostic(true); + end; +@<Ship box |p| out@>; +if tracing_output<=0 then print_char(">"); +@z + +TeX 2.0 WEB source line 15720 +@x +@d delta_node=2 {|type| field in a delta node} +@y +@d delta_node=2 {|type| field in a delta node} + +@<Types...@>= +@!delta_array=array[1..6] of scaled; +@z + +TeX 2.0 WEB source line 15735 +@x +@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6) + +@<Glo...@>= +@!active_width:array[1..6] of scaled; + {distance from first active node to~|cur_p|} +@!cur_active_width:array[1..6] of scaled; {distance from current active node} +@!background:array[1..6] of scaled; {length of an ``empty'' line} +@!break_width:array[1..6] of scaled; {length being computed after current break} +@y +In standard \TeX\ the |do_all_six| macro is sometimes used just to copy one +of these arrays to another. In this version, that uses \pvs, these have been +converted to simple array assignments. This not only produces faster code, +it decreases the size of the generated procedure: which is important, for +|try_break| is very nearly too large for \pvs. + +@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6) + +@<Glo...@>= +@!active_width:delta_array; {distance from first active node to~|cur_p|} +@!cur_active_width:delta_array; {distance from current active node} +@!background:delta_array; {length of an ``empty'' line} +@!break_width:delta_array; {length being computed after current break} +@z + +TeX 2.0 WEB source line 15874 +@x +@<Other local variables for |try_break|@>@; +@y +@<Other local variables for |try_break|@>@; + +procedure print_new_break; begin +@<Print a symbolic description of the new break node@> +end; + +procedure print_feasible_break; begin + @<Print a symbolic description of this feasible break@>; +end; +@z + +TeX 2.0 WEB source line 15877 +@x +do_all_six(copy_to_cur_active); +@y +cur_active_width:=active_width; {\pvs\ for |do_all_six(copy_to_cur_active)|} +@z + +TeX 2.0 WEB source line 16020 +@x +begin no_break_yet:=false; do_all_six(set_break_width_to_background); +@y +begin no_break_yet:=false; break_width:=background; + {\pvs\ for |do_all_six(set_break_width_to_background)|} +@z + +TeX 2.0 WEB source line 16122 +@x + begin do_all_six(store_break_width); +@y + begin active_width:=break_width; {\pvs\ for |do_all_six(store_break_width)|} +@z + +TeX 2.0 WEB source line 16158 +@x + @<Print a symbolic description of the new break node@>; +@y + print_new_break; +@z + +TeX 2.0 WEB source line 16343 +@x + @<Print a symbolic description of this feasible break@>; +@y + print_feasible_break; +@z + +TeX 2.0 WEB source line 16448 +@x + do_all_six(copy_to_cur_active); +@y + cur_active_width:=active_width; {\pvs\ for |do_all_six(copy_to_cur_active)|} +@z + +TeX 2.0 WEB source line 16523 +@x +do_all_six(store_background);@/ +@y +active_width:=background; {\pvs\ for |do_all_six(store_background)|} +@z + +TeX 2.0 WEB source line 17394 +@x +@!trie_pointer=0..trie_size; {an index into |trie|} +@y +@!trie_pointer=packed 0..trie_size; {an index into |trie|} +@z + +TeX 2.0 WEB source line 17398 +@x +@d trie_op(#)==trie[#].b0 {program for hyphenation at this trie location} + +@<Glob...@>= +@y +@d trie_op(#)==trie[#].b0 {program for hyphenation at this trie location} +@# +@d LA_trie== +@z + +TeX 2.0 WEB source line 17457 +@x +@!hyph_pointer=0..hyph_size; {an index into the ordered hash table} + +@ @<Glob...@>= +@!hyph_word:array[hyph_pointer] of str_number; {exception words} +@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions} +@y +@!hyph_pointer=packed 0..hyph_size; {an index into the ordered hash table} + +@ @d LA_hyph== +@!hyph_word:array[hyph_pointer] of str_number; {exception words} +@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions} + +@<Glob...@>= +@z + +TeX 2.0 WEB source line 17665 +@x +@d trie_op_hash_size=quarterword_diff+quarterword_diff {double} + +@<Glob...@>= +@!init@! trie_op_hash:array[0..trie_op_hash_size] of quarterword; + {trie op codes for triples} +tini@;@/ +@t\hskip1em@>@!trie_op_ptr:quarterword; {highest |trie_op| assigned} +@y +@d trie_op_hash_size=quarterword_diff+quarterword_diff {double} +@# +@d LA_trie_init1== +@! trie_op_hash:array[0..trie_op_hash_size] of quarterword; + {trie op codes for triples} + +@<Glob...@>= +@!trie_op_ptr:quarterword; {highest |trie_op| assigned} +@z + +TeX 2.0 WEB source line 17717 +@x +@d trie_root==trie_l[0] {root of the linked trie} + +@<Glob...@>= +@!init @!trie_c:packed array[trie_pointer] of ASCII_code; {characters to match} +@t\hskip1em@>@!trie_o:packed array[trie_pointer] of quarterword; + {operations to perform} +@t\hskip1em@>@!trie_l:packed array[trie_pointer] of trie_pointer; + {left subtrie links} +@t\hskip1em@>@!trie_r:packed array[trie_pointer] of trie_pointer; + {right subtrie links} +@t\hskip1em@>@!trie_ptr:trie_pointer; {the number of nodes in the trie} +@y +@d trie_root==trie_l[0] {root of the linked trie} +@# +@d LA_trie_init2== +@!trie_c:packed array[trie_pointer] of ASCII_code; {characters to match} +@t\hskip1em@>@!trie_o:packed array[trie_pointer] of quarterword; + {operations to perform} +@t\hskip1em@>@!trie_l:packed array[trie_pointer] of trie_pointer; + {left subtrie links} +@t\hskip1em@>@!trie_r:packed array[trie_pointer] of trie_pointer; + {right subtrie links} + +@<Glob...@>= +@!init @!trie_ptr:trie_pointer; {the number of nodes in the trie} +@z + +TeX 2.0 WEB source line 17734 +@x +initialized to zero. + +@<Glob...@>= +@!init @!trie_hash:packed array[trie_pointer] of trie_pointer; +tini {to identify equivalent subtries} +@y +initialized to zero. + +@d LA_trie_init3== +@!trie_hash:packed array[trie_pointer] of trie_pointer; + {to identify equivalent subtries} +@z + +TeX 2.0 WEB source line 17809 +@x +@d trie_back(#)==trie[#].lh {backward links in |trie| holes} + +@<Glob...@>= +@!init@!trie_taken:packed array[trie_pointer] of boolean; + {does a family start here?} +@t\hskip1em@>@!trie_min:trie_pointer; +@y +@d trie_back(#)==trie[#].lh {backward links in |trie| holes} +@# +@d LA_trie_init4== +@!trie_taken:packed array[trie_pointer] of boolean; + {does a family start here?} + +@<Glob...@>= +@!init @!trie_min:trie_pointer; +@z + +TeX 2.0 WEB source line 22573 +@x + if cur_ext="" then cur_ext:=".tex"; +@y + if cur_ext="" then cur_ext:=".tex"; + if cur_area="" then cur_area:=TEX_area; +@z + +TeX 2.0 WEB source line 22865 +@x +bad_fmt: wake_up_terminal; + wterm_ln('(Fatal format file error; I''m stymied)'); +@.Fatal format file error@> +load_fmt_file:=false; +exit:end; +@y +bad_fmt: wake_up_terminal; + wterm_ln('(Fatal format file error; I''m stymied)'); +@.Fatal format file error@> +history:=fatal_error_stop; +load_fmt_file:=false; +exit:end; +@z + +TeX 2.0 WEB source line 22885 +@x +@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 + +@<Glob...@>= +@y +@d fmt_word==fmt_file@@[fmt_count] + +@d dump_wd(#)==begin fmt_word:=#; put_fmt;@+end +@d dump_int(#)==begin fmt_word.int:=#; put_fmt;@+end +@d dump_hh(#)==begin fmt_word.hh:=#; put_fmt;@+end +@d dump_qqqq(#)==begin fmt_word.qqqq:=#; put_fmt;@+end + +@<Glob...@>= +@!fmt_count:integer; +@z + +TeX 2.0 WEB source line 22897 +@x +@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 undump_wd(#)==begin get_fmt; #:=fmt_word;@+end +@d undump_int(#)==begin get_fmt; #:=fmt_word.int;@+end +@d undump_hh(#)==begin get_fmt; #:=fmt_word.hh;@+end +@d undump_qqqq(#)==begin get_fmt; #:=fmt_word.qqqq;@+end +@z + +TeX 2.0 WEB source line 22912 +@x +@<Dump constants for consistency check@>= +@y +@<Dump constants for consistency check@>= +fmt_count:=0; +@z; + +TeX 2.0 WEB source line 22927 +@x +x:=fmt_file^.int; +@y +fmt_count:=0; +x:=fmt_word.int; +@z + +TeX 2.0 WEB source line 23224 +@x +dump_int(interaction); dump_int(format_ident); dump_int(69069); +@y +dump_int(interaction); dump_int(format_ident); dump_int(69069); +while fmt_count<>0 do dump_int(0); {flush out the buffer} +@z + +TeX 2.0 WEB source line 23309 +@x +The initial test involving |ready_already| should be deleted if the +\PASCAL\ runtime system is smart enough to detect such a ``mistake.'' +@^system dependencies@> + +@p begin @!{|start_here|} +history:=fatal_error_stop; {in case we quit during initialization} +t_open_out; {open the terminal for output} +if ready_already=314159 then goto start_of_TEX; +@y +The initial test involving |ready_already| has been deleted here +since the +CMS storage management is not smart enough to clean up properly. +We also declare the procedure |use_stack| which is explained in +its definition. +@^system dependencies@> + +@p @<Declare the procedure |use_stack|@> @; +@# +begin @!{|start_here|} +use_stack; +history:=fatal_error_stop; {in case we quit during initialization} +t_open_out; {open the terminal for output} +@z + +TeX 2.0 WEB source line 23319 +@x + begin wterm_ln('Ouch---my internal constants have been clobbered!', + '---case ',bad:1); +@y + begin wterm_ln('Ouch---my internal constants have been clobbered!', + '---case ',bad:1); + ret_code(100+bad); +@z + +TeX 2.0 WEB source line 23328 +@x +ready_already:=314159; +start_of_TEX: @<Initialize the output routines@>; +@<Get the first line of input and prepare to start@>; +init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;@/ +history:=spotless; {ready to go!} +main_control; {come to life} +final_cleanup; {prepare for death} +end_of_TEX: close_files_and_terminate; +final_end: ready_already:=0; +@y +do_nothing; {remove |ready_already:=314159;|} +start_of_TEX: @<Initialize the output routines@>; +@<Get the first line of input and prepare to start@>; +init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;@/ +history:=spotless; {ready to go!} +main_control; {come to life} +final_cleanup; {prepare for death} +end_of_TEX: close_files_and_terminate; +final_end: ret_code(history*4); +interrupt:=-1; +term_attn(interrupt); +@z + +TeX 2.0 WEB source line 23348 +@x +but that can't cause infinite recursion. + +@<Last-minute...@>= +procedure close_files_and_terminate; +var k:integer; {all-purpose index} +begin @<Finish the extensions@>; +@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/ +wake_up_terminal; @<Finish the \.{DVI} file@>; +if job_name>0 then + begin wlog_cr; a_close(log_file); selector:=selector-2; +@y +but that can't cause infinite recursion. + +For \pvs\ we explicitly close all text input files, which standard +\TeX\ leaves open, because \pvs\ sometimes(!) cannot manage +to close them +after a |jump_out| from an inner-level input file containing a +\TeX\ error. +It is (currently) okay to close files that are not open in \pvs. + +@<Last-minute...@>= +procedure close_files_and_terminate; +var k:integer; {all-purpose index} +begin @<Finish the extensions@>; +@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/ +wake_up_terminal; @<Finish the \.{DVI} file@>; +if job_name>0 then + begin wlog_cr; a_close(log_file); + for k:=1 to max_in_open do a_close(input_file[k]); {close input files} + selector:=selector-2; +@z + +Web line 23602, add index code +@x +@d special_node=3 {|subtype| in whatsits that represent \.{\\special} things} +@y +@d special_node=3 {|subtype| in whatsits that represent \.{\\special} things} +@d ix_print_node=5 +{|subtype| in whatsits that represent \.{\\printindex} things} +@z +The following change is to use \write15 to send stuff to CMS +TeX 2.0 WEB source line 23619 +@x +@ @<Set init...@>= +for k:=0 to 17 do write_open[k]:=false; +@y +@ @<Set init...@>= +for k:=0 to 17 do write_open[k]:=false; +write_open[15]:=true; {hack open \.{\\write15} stream for sending + messages to CMS} +cms_ptr:=1; {initialize |cms_buf| pointer and array} +for k:=1 to buf_size do cms_buf[k]:=' '; +@z + +Web line 23635, index code +@x +primitive("special",extension,special_node);@/ +@!@:special_}{\.{\\special} primitive@> +@y +primitive("special",extension,special_node);@/ +@!@:special_}{\.{\\special} primitive@> +primitive("printindex",extension,ix_print_node);@/ +@!@:printindex_}{\.{\\printindex} primitive@> +@z + +Web line 23651, index code +@x + special_node:print_esc("special"); +@y + special_node:print_esc("special"); + ix_print_node:print_esc("printindex"); +@z + +Web line 23671, index code +@x +special_node:@<Implement \.{\\special}@>; +@y +special_node:@<Implement \.{\\special}@>; +ix_print_node:@<Implement \.{\\printindex}@>; +@z + +Web line 23725, index code +@x +@<Implement \.{\\special}@>= +begin new_whatsit(special_node,write_node_size); write_stream(tail):=null; +p:=scan_toks(false,true); write_tokens(tail):=def_ref; +end +@y +@<Implement \.{\\special}@>= +begin new_whatsit(special_node,write_node_size); write_stream(tail):=null; +p:=scan_toks(false,true); write_tokens(tail):=def_ref; +end +@ This is an extension to call TEXIX, the index building and sorting +program. + +@<Implement \.{\\printindex}@>= +begin scan_int; +if (cur_val<1) or (cur_val>3) +then begin +print_err("Invalid index number"); +help2("Since I expected to read a number between 1 and 3,") +("I changed this one to 1."); +int_error(cur_val); +cur_val:=1; +end; +texix(chr(cur_val+ord('0'))); +end + +@ The next procedure calls the Pascal/VS module TEXIX to build the +sorted index. TEXIX calls +the PL/1 procedure PLSORT, which calls the CASORT procedure to sort +the index file. + +@<Declare procedures needed in |do_ext...@>= +procedure texix(@!ix:char); external; + +@z + +TeX 2.0 WEB source line 23949 +@x +This section should be replaced, if necessary, by changes to the program +that are necessary to make \TeX\ work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the published program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +The following sections, as recommended, contain the changes necessary to +make \TeX\ work under \pvs\ and CMS. + +@ The following two sections of code and comment are from Chris Thompson +of Cambridge University Computing Service: + +One of the unfortunate features of the \pvs\ compiler (and, indeed, of +all known \PASCAL\ compilers for the IBM/370 architecture) is that variables +in a stack frame are allocated strictly in the order they were declared. +If the stack frame is more than 4096 bytes long, access to the later variables +is less efficient, as \pvs\ must generate code to add a suitable multiple +of 4096 to the base register for the stack frame. If many different multiples +of 4096 are involved, the situation is correspondingly worse. + +Unfortunately, this effect is particularly acute for programs like \TeX. +The order of the global variable declarations in the program generated by +\.{TANGLE} is the order they actually occur in the source of \TeX. This order +is oriented towards a structured exposition of the program. In particular, +arrays (some of them rather large) and simple variables are mixed up; thus +some of the most heavily used global variables in \TeX\ not only are not +assigned addresses in the first 4096 bytes of the global stack frame, but +even occur in many different 4096-byte sections of that frame, causing +\pvs\ to have to assign many registers to point at them. + +There are many possible ways in which this situation could be improved. +In this version of \TeX\ the declarations of the largest arrays have been +removed from the module ``Global variables'' and added to a new one called +``Large array variables'' which is inserted at the end of the declarations. +The object is to make the space allocated to the variables left in the first +module no more than 4096 bytes. Many of the smaller arrays have been left in +the first module; after all, they too can gain from being directly addressable. + +As the individual sections of ``Global variables'' often contain declarations +of both simple and array variables, the latter have been converted to +\.{TANGLE} macros which are expanded here, rather than building up +``Large array variables'' on the way. +This would also enable us to change the order of +these arrays on the global stack frame if desired. + +@<Large array...@>= + LA_buffer @; LA_string @; + LA_mem @; debug LA_mem_debug gubed @; + LA_nest @; LA_eqtb @; LA_hash @; LA_save_stack @; + LA_input_stack @; LA_param_stack @; + LA_font1 @; LA_font2 @; + LA_trie @; LA_hyph @; + init LA_trie_init1 @; LA_trie_init2 @; LA_trie_init3 @; LA_trie_init4 tini + +@ Another unfortunate feature of the \pvs\ compiler (this time unique to it) +is the way it manages the \PASCAL\ stack. Rather than allocating the whole +stack area at once, it uses \.{GETMAIN} system calls to obtain chunks of store +for it on demand. If stack overflow is detected on a routine call (i.e., the +current chunk is not big enough; which, in particular, always happens when +the main program is called from the runtime system) then a new chunk is made +current. This is taken from a chain of spare chunks if any of them is big +enough; if not, a new chunk is obtained, of size +$$\lceil\max(\hbox{new stack frame}, d)\rceil\quad\hbox{Kbytes}$$ +where $d$ is specified by a runtime option, defaulting to 12\thinspace Kbytes. +A special dummy procedure is +placed between the caller and callee. When the callee returns, this procedure +switches back to the old chunk, placing the new one on the spare list. + +Now, consider the case of \TeX. Most of the stack frames are not much larger +than the \pvs\ minimum of 144 bytes, because they do not contain arrays; +on the other hand, the global stack frame is enormous. The chunk obtained +by \pvs\ for the main program will have between 0~and 1\thinspace Kbytes +left after the global stack frame itself---and exactly how much will be +quite impossible to keep control of as \TeX\ is altered. This is not +enough for very many nested routine calls, and \TeX\ will soon use it up +and obtain a new chunk of 12\thinspace Kbytes; this will suffice for +nearly all \TeX\ applications (and if it didn't, we could change the +runtime option). + +Some routines will have their stack frames very near the end of the +first chunk. On every routine call they make, a switch will have to be +made to the second chunk, and on each return to them a switch back again. +Although this part of the \pvs\ runtime system is written in assembler, +this is still a heavy overhead. If the routine involved is one that calls +many other routines (the worst case may be |main_control|) then this will +observably degrade the whole performance of \TeX. Experiments have shown +variations due to this cause in the CPU time used by \TeX\ of 10\% in +normal applications, and more than that in special cases. + +The possible solutions here range from altering the algorithm in \pvs\ to +use a chunk size of +$$\lceil\hbox{new stack frame} + d\rceil\quad\hbox{Kbytes}$$ +(which would work quite well for \TeX) to arranging to always specify a +runtime system \.{STACK=d} option comfortably larger than the global +stack frame (but then one could hardly hope ever to get another chunk +if the first one {\sl did} run out). The solution adopted in this version +of \TeX\ is to use an assembler routine |use_stack| which arranges that +its caller's stack frame will subsequently be judged by \pvs\ to be as +high as possible in the current chunk---to do this it has to know more +than is good for it about the internals of \pvs, of course! + +Ideally, this routine would be used as follows. The main program would +consist of a call of |use_stack|, followed by a call of + \\{do\_everything\_else}; +then only one call-return pair gets the overhead. This is awkward for \TeX, +though, because of the labels in the main program, especially |end_of_TEX|. +Almost as good is to insert a call of |use_stack| near the beginning of the +existing main program, and this is what we do here. It works because the +main program doesn't actually call many other routines, and has no loops---we +can hope it will stay that way! + +@<Declare the procedure |use_stack|@>= +procedure use_stack; external; + +@ Extra type needed for CMS message +@<Types...@>= + +@!cms_buf_type=packed array[1..buf_size] of char; + +@ Here are extra global variables for VM/CMS routines +@<Glob...@>= + +@!inp_line:string(255); +@!cms_buf:cms_buf_type; +@!cms_ptr:1..buf_size; +@!irc:integer; +@!tfm_count:integer; +@!status: boolean; {did the last |reset| or |rewrite| succeed?} + +@ @<VM/CMS...@>= +procedure term_attn(var interrupt: integer); fortran; +procedure cms(const s:string; var rc:integer); external; +procedure attn202(const lifofifo:alfa; const cmd:string); external; +procedure okstatus; begin status:=true; end; +@/@\@=%INCLUDE ONERROR;@>@\ +@# +procedure onerror; begin +if @= FERROR @> in [41,48] then begin + status:=false; + @= FACTION@>:=[@=XDECERR@>]; end; +if @= FERROR@>=30 then interrupt:=1; +end; + +procedure fget; begin {no check done for eof} + incr(tfm_count); + if tfm_count=tfm_buf_size then + begin get(tfm_file); tfm_count:=0; + end; + end; + +procedure put_fmt; begin + incr(fmt_count); + if fmt_count=len_word_block then + begin put(fmt_file); fmt_count:=0; + end; + end; + +procedure get_fmt; begin + incr(fmt_count); + if fmt_count=len_word_block then begin + get(fmt_file); fmt_count:=0; + end; + end; +@z |