summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/alephdir/omocp.ch
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/alephdir/omocp.ch')
-rw-r--r--Build/source/texk/web2c/alephdir/omocp.ch1078
1 files changed, 1078 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/alephdir/omocp.ch b/Build/source/texk/web2c/alephdir/omocp.ch
new file mode 100644
index 00000000000..4b6d1cb2a46
--- /dev/null
+++ b/Build/source/texk/web2c/alephdir/omocp.ch
@@ -0,0 +1,1078 @@
+% omocp.ch: Reading an OCP file
+%
+% This file is part of the Omega project, which
+% is based on the web2c distribution of TeX.
+%
+% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous
+%
+% This library is free software; you can redistribute it and/or
+% modify it under the terms of the GNU Library General Public
+% License as published by the Free Software Foundation; either
+% version 2 of the License, or (at your option) any later version.
+%
+% This library is distributed in the hope that it will be useful,
+% but WITHOUT ANY WARRANTY; without even the implied warranty of
+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+% Library General Public License for more details.
+%
+% You should have received a copy of the GNU Library General Public
+% License along with this library; if not, write to the Free Software
+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+%
+%---------------------------------------
+@x [1] m.11 l.412 - Omega OCP
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@y
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@!ocp_maxint=@"10000000;
+@z
+%---------------------------------------
+@x [1] m.12 l.436 - Omega OCP
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@d ocp_base=0 {smallest internal ocp number; must not be less
+ than |min_quarterword|}
+@d ocp_biggest=65535 {the real biggest ocp}
+@d number_ocps=ocp_biggest-ocp_base+1
+@d ocp_list_base=0 {smallest internal ocp list number; must not be less
+ than |min_quarterword|}
+@d ocp_list_biggest=65535 {the real biggest ocp list}
+@d number_ocp_lists=ocp_list_biggest-ocp_list_base+1
+@d max_active_ocp_lists=65536
+@z
+%---------------------------------------
+@x [15] m.209 l.4170 - Omega OCP
+@d max_command=set_interaction
+ {the largest command code seen at |big_switch|}
+@y
+@d set_ocp=set_interaction+1
+ {Place a translation process in the stream}
+@d def_ocp=set_ocp+1
+ {Define and load a translation process}
+@d set_ocp_list=def_ocp+1
+ {Place a list of OCPs in the stream}
+@d def_ocp_list=set_ocp_list+1
+ {Define a list of OCPs}
+@d clear_ocp_lists=def_ocp_list+1
+ {Remove all active OCP lists}
+@d push_ocp_list=clear_ocp_lists+1
+ {Add to the sequence of active OCP lists}
+@d pop_ocp_list=push_ocp_list+1
+ {Remove from the sequence of active OCP lists}
+@d ocp_list_op=pop_ocp_list+1
+ {Operations for building a list of OCPs}
+@d ocp_trace_level=ocp_list_op+1
+ {Tracing of active OCPs, either 0 or 1}
+@d max_command=ocp_trace_level
+ {the largest command code seen at |big_switch|}
+@z
+%---------------------------------------
+@x [17] m.222 l.4523 - Omega OCP
+@d font_id_base=frozen_null_font-font_base
+ {begins table of |number_fonts| permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+number_fonts
+@y
+@d font_id_base=frozen_null_font-font_base
+ {begins table of |number_fonts| permanent font identifiers}
+@d frozen_null_ocp=frozen_null_font+number_fonts
+ {permanent `\.{\\nullocp}'}
+@d ocp_id_base=frozen_null_ocp-ocp_base
+ {begins table of |number_ocps| permanent ocp identifiers}
+@d frozen_null_ocp_list=frozen_null_ocp+number_ocps
+ {permanent `\.{\\nullocplist}'}
+@d ocp_list_id_base=frozen_null_ocp_list-ocp_list_base
+ {begins table of |number_ocp_lists| permanent ocp list identifiers}
+@d undefined_control_sequence=frozen_null_ocp_list+number_ocp_lists
+@z
+%---------------------------------------
+@x
+@d toks_base=local_base+10 {table of |number_regs| token list registers}
+@y
+@d ocp_trace_level_base=local_base+10
+@d ocp_active_number_base=ocp_trace_level_base+1
+@d ocp_active_min_ptr_base = ocp_active_number_base+1
+@d ocp_active_max_ptr_base = ocp_active_min_ptr_base+1
+@d ocp_active_base = ocp_active_max_ptr_base+1
+@d toks_base=ocp_active_base+max_active_ocp_lists
+ {table of |number_regs| token list registers}
+@z
+%---------------------------------------
+@x [17] m.232 l.4799 - Omega OCP
+@d null_font==font_base
+@y
+@d null_font==font_base
+@d null_ocp==ocp_base
+@d null_ocp_list==ocp_list_base
+@z
+%---------------------------------------
+@x [18] m.256 l.5479 - Omega OCP
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@y
+@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name}
+@d ocp_id_text(#) == newtext(ocp_id_base+#) {a frozen ocp identifier's name}
+@d ocp_list_id_text(#) == newtext(ocp_list_id_base+#)
+ {a frozen ocp list identifier's name}
+@z
+%---------------------------------------
+@x [26] m.409 l.8254 - Omega OCP
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@y
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@t\4\4@>@<Declare procedures that scan ocp-related stuff@>
+@z
+%---------------------------------------
+@x [29] m.514 l.9968 - Omega OCP
+|TEX_font_area|. These system area names will, of course, vary from place
+to place.
+@y
+|TEX_font_area|. $\Omega$'s compiled translation process files whose areas
+are not given explicitly are assumed to appear in a standard system area
+called |OMEGA_ocp_area|. These system area names will, of course, vary
+from place to place.
+@z
+%---------------------------------------
+@x [29] m.514 l.9974 - Omega OCP
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@d OMEGA_ocp_area=="OmegaOCPs:"
+@.OmegaOCPs@>
+@z
+%---------------------------------------
+@x [30] m.582 l.10379 - Omega OCP
+@* \[30] Font metric data.
+@y
+@* \[30] Font metric data and OCPs.
+@z
+%---------------------------------------
+@x [30] m.??? l.10928 - Omega OCP
+@ @<Read and check...@>=
+@y
+@ @<Read and check the font data...@>=
+@z
+%---------------------------------------
+@x [30] m.??? l.11010 - Omega OCP
+@ @<Apologize for not loading...@>=
+@y
+@ @<Apologize for not loading the font...@>=
+@z
+%---------------------------------------
+@x [30] m.582 l.11283 - Omega OCP
+char_warning(f,c);
+new_character:=null;
+exit:end;
+@y
+char_warning(f,c);
+new_character:=null;
+exit:end;
+
+@ Here we begin the \.{OCP} file handling.
+
+@<Glob...@>=
+@!ocp_file:byte_file;
+
+@ So that is what \.{OCP} files hold.
+
+When the user defines \.{\\ocp\\f}, say, \TeX\ assigns an internal number
+to the user's ocp~\.{\\f}. Adding this number to |ocp_id_base| gives the
+|eqtb| location of a ``frozen'' control sequence that will always select
+the ocp.
+
+@<Types...@>=
+@!internal_ocp_number=ocp_base..ocp_biggest;
+@!ocp_index=integer;
+
+@ Here now is the array of ocp arrays.
+
+@<Glob...@>=
+@!ocp_ptr:internal_ocp_number; {largest internal ocp number in use}
+
+@ Besides the arrays just enumerated, we have two directory arrays that
+make it easy to get at the individual entries in |ocp_info|.
+The beginning of the info for the |j|-th state in the |i|-th ocp is at
+location |ocp_info[ocp_state_base[i]+j]| and the |k|-th entry is in
+location |ocp_info[ocp_info[ocp_state_base[i]+j]+k]|.
+(These formulas assume that |min_quarterword| has already been
+added to |i|, |j| and |k|, since $\Omega$ stores its quarterwords that way.)
+
+@d ocp_info_end(#)==#]
+@d ocp_info(#)==ocp_tables[#,ocp_info_end
+@d offset_ocp_file_size=0
+@d offset_ocp_name=1
+@d offset_ocp_area=offset_ocp_name+1
+@d offset_ocp_external=offset_ocp_area+1
+@d offset_ocp_external_arg=offset_ocp_external+1
+@d offset_ocp_input=offset_ocp_external_arg+1
+@d offset_ocp_output=offset_ocp_input+1
+@d offset_ocp_no_tables=offset_ocp_output+1
+@d offset_ocp_no_states=offset_ocp_no_tables+1
+@d offset_ocp_table_base=offset_ocp_no_states+1
+@d offset_ocp_state_base=offset_ocp_table_base+1
+@d offset_ocp_info=offset_ocp_state_base+1
+@d ocp_file_size(#)==ocp_info(#)(offset_ocp_file_size)
+@d ocp_name(#)==ocp_info(#)(offset_ocp_name)
+@d ocp_area(#)==ocp_info(#)(offset_ocp_area)
+@d ocp_external(#)==ocp_info(#)(offset_ocp_external)
+@d ocp_external_arg(#)==ocp_info(#)(offset_ocp_external_arg)
+@d ocp_input(#)==ocp_info(#)(offset_ocp_input)
+@d ocp_output(#)==ocp_info(#)(offset_ocp_output)
+@d ocp_no_tables(#)==ocp_info(#)(offset_ocp_no_tables)
+@d ocp_no_states(#)==ocp_info(#)(offset_ocp_no_states)
+@d ocp_table_base(#)==ocp_info(#)(offset_ocp_table_base)
+@d ocp_state_base(#)==ocp_info(#)(offset_ocp_state_base)
+
+@ $\Omega$ always knows at least one ocp, namely the null ocp.
+It does nothing.
+
+@<Initialize table...@>=
+ocp_ptr:=null_ocp;
+allocate_ocp_table(null_ocp,17);
+ocp_file_size(null_ocp):=17;
+ocp_name(null_ocp):="nullocp"; ocp_area(null_ocp):="";
+ocp_external(null_ocp):=0; ocp_external_arg(null_ocp):=0;
+ocp_input(null_ocp):=1; ocp_output(null_ocp):=1;
+ocp_no_tables(null_ocp):=0;
+ocp_no_states(null_ocp):=1;
+ocp_table_base(f):=offset_ocp_info;
+ocp_state_base(f):=offset_ocp_info;
+ocp_info(null_ocp)(offset_ocp_info) := offset_ocp_info+2; {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+1) := offset_ocp_info+5; {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+2) := 23; {|OTP_LEFT_START|}
+ocp_info(null_ocp)(offset_ocp_info+3) := 3; {|OTP_RIGHT_CHAR|}
+ocp_info(null_ocp)(offset_ocp_info+4) := 36; {|OTP_STOP|}
+
+
+@ @<Put each...@>=
+primitive("nullocp", set_ocp, null_ocp);
+settext(frozen_null_ocp,"nullocp");
+set_new_eqtb(frozen_null_ocp,new_eqtb(cur_val));
+geq_define(ocp_active_number_base, data, 0);
+geq_define(ocp_active_min_ptr_base, data, 0);
+geq_define(ocp_active_max_ptr_base, data, 0);
+
+@ Of course we want to define macros that suppress the detail of how ocp
+information is actually packed, so that we don't have to write things like
+$$\hbox{|ocp_info[k+ocp_info[j+ocp_state_base[i]]]|}$$
+too often. The \.{WEB} definitions here make |ocp_state_entry(i)(j)(k)|
+(|ocp_table_entry(i)(j)(k)|) the |k|-th word in the |j|-th state (table)
+of the |i|-th ocp.
+@^inner loop@>
+
+@d ocp_state_end(#)==#]
+@d ocp_state_one(#)==#*2]+ocp_state_end
+@d ocp_state_entry(#)==ocp_tables[#,ocp_tables[#,ocp_state_base(#)+ocp_state_one
+
+@d ocp_state_no_end(#)==#*2+1]
+@d ocp_state_no(#)==ocp_tables[#,ocp_state_base(#)+ocp_state_no_end
+
+@d ocp_table_end(#)==#]
+@d ocp_table_one(#)==#*2]+ocp_table_end
+@d ocp_table_entry(#)==ocp_tables[#,ocp_tables[#,ocp_table_base(#)+ocp_table_one
+
+@d ocp_table_no_end(#)==#*2+1]
+@d ocp_table_no(#)==ocp_tables[#,ocp_table_base(#)+ocp_table_no_end
+
+@ $\Omega$ checks the information of a \.{OCP} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. The somewhat tedious subroutine that does this
+is called |read_ocp_info|. It has three parameters: the user ocp
+identifier~|u|, and the file name and area strings |nom| and |aire|.
+
+The subroutine opens and closes a global file variable called |ocp_file|.
+It returns the value of the internal ocp number that was just loaded.
+If an error is detected, an error message is issued and no ocp
+information is stored; |null_ocp| is returned in this case.
+
+@d bad_ocp=11 {label for |read_ocp_info|}
+@d ocp_abort(#)==begin print("OCP file error (");
+ print(#); print(")"); print_ln; goto bad_ocp end
+ {do this when the \.{OCP} data is wrong}
+
+@p function read_ocp_info(@!u:pointer;@!nom,@!aire,@!ext:str_number;
+ @!external_ocp:boolean)
+ :internal_ocp_number; {input a \.{OCP} file}
+label done,bad_ocp,not_found;
+var
+@!file_opened:boolean; {was |ocp_file| successfully opened?}
+@!f:internal_ocp_number; {the new ocp's number}
+@!g:internal_ocp_number; {the number to return}
+@!ocpword:integer;
+@!ocpmem_run_ptr:ocp_index;
+@!ocp_length,real_ocp_length:integer; {length of ocp file}
+@!previous_address:ocp_index;
+@!temp_ocp_input:integer;
+@!temp_ocp_output:integer;
+@!temp_ocp_no_tables:integer;
+@!temp_ocp_no_states:integer;
+@!i,new_offset,room_for_tables,room_for_states:integer;
+begin g:=null_ocp;@/
+@<Read and check the ocp data; |ocp_abort| if the \.{OCP} file is
+ malformed; if there's no room for this ocp, say so and |goto
+ done|; otherwise |incr(ocp_ptr)| and |goto done|@>;
+bad_ocp: @<Report that the ocp won't be loaded@>;
+done: if file_opened then b_close(ocp_file);
+read_ocp_info:=g;
+end;
+
+@ $\Omega$ does not give precise details about why it
+rejects a particular \.{OCP} file.
+
+@d start_ocp_error_message==print_err("Translation process ");
+ sprint_cs(u); print_char("="); print_file_name(nom,aire,"");
+
+@<Report that the ocp won't be loaded@>=
+start_ocp_error_message;
+@.Translation process x=xx not loadable...@>
+if file_opened then print(" not loadable: Bad ocp file")
+else print(" not loadable: ocp file not found");
+help2("I wasn't able to read the data for this ocp,")@/
+("so I will ignore the ocp specification.");
+error
+
+@ @<Read and check the ocp data...@>=
+file_opened:=false;
+if (ocp_ptr=ocp_biggest) then
+ @<Apologize for not loading the ocp, |goto done|@>;
+if external_ocp then
+ @<Check |ocp_file| exists@>
+else begin
+ @<Open |ocp_file| for input@>;
+ @<Read the {\.{OCP}} file@>;
+ end;
+ocp_name(f):=nom; ocp_area(f):=aire
+
+@ @<Apologize for not loading the ocp...@>=
+begin start_ocp_error_message;
+print(" not loaded: Not enough room left");
+@.Translation process x=xx not loaded...@>
+help2("I cant handle more than 65535 translation processes,")@/
+("so I will ignore the ocp specification.");
+error; goto done;
+end
+
+@ @<Check |ocp_file| exists@>=
+begin
+pack_file_name(nom,aire,ext);
+b_test_in;
+if name_length=0 then ocp_abort("opening file");
+f :=ocp_ptr+1;
+allocate_ocp_table(f,13);
+ocp_file_size(f):=13;
+for i:=1 to name_length do begin
+ append_char(name_of_file[i]);
+ end;
+ocp_external(f):=make_string;
+scan_string_argument;
+ocp_external_arg(f):=cur_val;
+ocp_name(f):=""; ocp_area(f):="";
+ocp_state_base(f):=0; ocp_table_base(f):=0;
+ocp_input(f):=1; ocp_output(f):=1;
+ocp_info(f)(offset_ocp_info):=0;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ @<Open |ocp_file| for input@>=
+pack_file_name(nom,aire,".ocp");
+if not b_open_in(ocp_file) then ocp_abort("opening file");
+file_opened:=true
+
+@ Note: A malformed \.{OCP} file might be shorter than it claims to be;
+thus |eof(ocp_file)| might be true when |read_ocp_info| refers to
+|ocp_file^| or when it says |get(ocp_file)|. If such circumstances
+cause system error messages, you will have to defeat them somehow,
+for example by defining |ocpget| to be `\ignorespaces|begin get(ocp_file);|
+|if eof(ocp_file) then ocp_abort; end|\unskip'.
+@^system dependencies@>
+
+@d add_to_ocp_info(#)==begin ocp_tables[f,ocpmem_run_ptr]:=#;
+ incr(ocpmem_run_ptr);
+ end
+@d ocpget==get(ocp_file)
+@d ocpbyte==ocp_file^
+@d ocp_read(#)==begin ocpword:=ocpbyte;
+ if ocpword>127 then ocp_abort("checking first octet");
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ ocpget; ocpword:=ocpword*@'400+ocpbyte;
+ #:=ocpword;
+ end
+@d ocp_read_all(#)==begin ocpget; ocp_read(#); end
+@d ocp_read_info==begin ocp_read_all(ocpword);
+ add_to_ocp_info(ocpword);
+ end
+
+@ @<Read the {\.{OCP}} file@>=
+begin
+f :=ocp_ptr+1;
+ocpmem_run_ptr:=offset_ocp_info;
+ocp_read(ocp_length);
+real_ocp_length:=ocp_length-7;
+ocp_read_all(temp_ocp_input);
+ocp_read_all(temp_ocp_output);
+ocp_read_all(temp_ocp_no_tables);
+ocp_read_all(room_for_tables);
+ocp_read_all(temp_ocp_no_states);
+ocp_read_all(room_for_states);
+if real_ocp_length <>
+ (temp_ocp_no_tables + room_for_tables +
+ temp_ocp_no_states + room_for_states) then
+ ocp_abort("checking size");
+real_ocp_length:=real_ocp_length+12+
+ temp_ocp_no_states+temp_ocp_no_tables;
+allocate_ocp_table(f,real_ocp_length);
+ocp_external(f):=0;
+ocp_external_arg(f):=0;
+ocp_file_size(f):=real_ocp_length;
+ocp_input(f):=temp_ocp_input;
+ocp_output(f):=temp_ocp_output;
+ocp_no_tables(f):=temp_ocp_no_tables;
+ocp_no_states(f):=temp_ocp_no_states;
+ocp_table_base(f):=ocpmem_run_ptr;
+if ocp_no_tables(f) <> 0 then begin
+ previous_address:=ocpmem_run_ptr+2*(ocp_no_tables(f));
+ for i:=1 to ocp_no_tables(f) do begin
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address:=previous_address+new_offset;
+ end
+ end;
+if room_for_tables <> 0 then begin
+ for i:=1 to room_for_tables do begin
+ ocp_read_info;
+ end
+ end;
+ocp_state_base(f):=ocpmem_run_ptr;
+if ocp_no_states(f) <> 0 then begin
+ previous_address:=ocpmem_run_ptr+2*(ocp_no_states(f));
+ for i:=1 to ocp_no_states(f) do begin
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address:=previous_address+new_offset;
+ end;
+ end;
+if room_for_states <> 0 then begin
+ for i:=1 to room_for_states do begin
+ ocp_read_info;
+ end
+ end;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ Before we forget about the format of these tables, let's deal with
+$\Omega$'s basic scanning routine related to ocp information.
+
+@<Declare procedures that scan ocp-related stuff@>=
+procedure scan_ocp_ident;
+var f:internal_ocp_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp then f:=cur_chr
+else begin print_err("Missing ocp identifier");
+@.Missing ocp identifier@>
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \ocp.");
+ back_error; f:=null_ocp;
+ end;
+cur_val:=f;
+end;
+
+
+@ Here we begin the \.{OCP} list handling.
+
+
+@<Types...@>=
+@!internal_ocp_list_number=ocp_list_base..ocp_list_biggest;
+@!ocp_list_index=integer; {index into |ocp_list_info|}
+@!ocp_lstack_index=integer; {index into |ocp_lstack_info|}
+
+@ Here now is the array of ocp arrays.
+@d ocp_list_lnext(#)==ocp_list_info[#].hh.b0
+@d ocp_list_lstack(#)==ocp_list_info[#].hh.b1
+@d ocp_list_lstack_no(#)==ocp_list_info[#+1].sc
+@d ocp_lstack_lnext(#)==ocp_lstack_info[#].hh.b0
+@d ocp_lstack_ocp(#)==ocp_lstack_info[#].hh.b1
+@d make_null_ocp_list==make_ocp_list_node(0,ocp_maxint,0)
+@d is_null_ocp_list(#)==ocp_list_lstack_no(#)=ocp_maxint
+@d make_null_ocp_lstack==0
+@d is_null_ocp_lstack(#)==#=0
+@d add_before_op=1
+@d add_after_op=2
+@d remove_before_op=3
+@d remove_after_op=4
+
+@<Glob...@>=
+@!ocp_list_info:array[ocp_list_index] of memory_word;
+ {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
+ {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
+
+@
+@<Initialize table...@>=
+ocp_listmem_ptr:=2;
+ocp_list_lstack(0):=0;
+ocp_list_lstack_no(0):=ocp_maxint;
+ocp_list_lnext(0):=0;
+ocp_list_ptr:=null_ocp_list;
+ocp_list_list[null_ocp_list]:=0;
+ocp_lstackmem_ptr:=1;
+
+@ $\Omega$ always knows at least one ocp list, namely the null ocp list.
+
+@ @<Put each...@>=
+primitive("nullocplist", set_ocp_list, null_ocp_list);
+settext(frozen_null_ocp_list,"nullocplist");
+set_new_eqtb(frozen_null_ocp_list,new_eqtb(cur_val));
+
+@ @p function make_ocp_list_node(llstack:ocp_lstack_index;
+ llstack_no:scaled;
+ llnext:ocp_list_index):ocp_list_index;
+var p:ocp_list_index;
+begin
+p:=ocp_listmem_run_ptr;
+ocp_list_lstack(p):=llstack;
+ocp_list_lstack_no(p):=llstack_no;
+ocp_list_lnext(p):=llnext;
+ocp_listmem_run_ptr:=ocp_listmem_run_ptr+2;
+make_ocp_list_node:=p;
+end;
+
+function make_ocp_lstack_node(locp:internal_ocp_number;
+ llnext:ocp_lstack_index) : ocp_lstack_index;
+var p:ocp_lstack_index;
+begin
+p:=ocp_lstackmem_run_ptr;
+ocp_lstack_ocp(p):=locp;
+ocp_lstack_lnext(p):=llnext;
+incr(ocp_lstackmem_run_ptr);
+make_ocp_lstack_node:=p;
+end;
+
+function copy_ocp_lstack(llstack:ocp_lstack_index):ocp_lstack_index;
+var result:ocp_lstack_index;
+begin
+if is_null_ocp_lstack(llstack) then
+ result:=make_null_ocp_lstack
+else
+ result:=make_ocp_lstack_node(ocp_lstack_ocp(llstack),
+ copy_ocp_lstack(ocp_lstack_lnext(llstack)));
+copy_ocp_lstack:=result;
+end;
+
+function copy_ocp_list(list:ocp_list_index):ocp_list_index;
+var result:ocp_list_index;
+begin
+if is_null_ocp_list(list) then
+ result:=make_null_ocp_list
+else
+ result:=make_ocp_list_node(copy_ocp_lstack(ocp_list_lstack(list)),
+ ocp_list_lstack_no(list),
+ copy_ocp_list(ocp_list_lnext(list)));
+copy_ocp_list:=result;
+end;
+
+function ocp_ensure_lstack(list:ocp_list_index; llstack_no:scaled):
+ ocp_list_index;
+var p:ocp_list_index;
+ q:ocp_list_index;
+begin
+p:=list;
+if is_null_ocp_list(p) then begin
+ ocp_list_lstack_no(p) := llstack_no;
+ ocp_list_lnext(p) := make_null_ocp_list;
+ end
+else if ocp_list_lstack_no(p) > llstack_no then begin
+ ocp_list_lnext(p):=
+ make_ocp_list_node(ocp_list_lstack(p),
+ ocp_list_lstack_no(p),
+ ocp_list_lnext(p));
+ ocp_list_lstack(p):=0;
+ ocp_list_lstack_no(p):=llstack_no;
+ end
+else begin
+ q:=ocp_list_lnext(p);
+ while (not (is_null_ocp_list(q))) and
+ ocp_list_lstack_no(q) <= llstack_no do begin
+ p:=q; q:=ocp_list_lnext(q);
+ end;
+ if ocp_list_lstack_no(p) < llstack_no then begin
+ ocp_list_lnext(p) := make_ocp_list_node(0, llstack_no, q);
+ p := ocp_list_lnext(p);
+ end;
+ end;
+ocp_ensure_lstack := p;
+end;
+
+procedure ocp_apply_add(list_entry:ocp_list_index;
+ lbefore:boolean;
+ locp:internal_ocp_number);
+var p:ocp_lstack_index;
+ q:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if lbefore or (p=0) then begin
+ ocp_list_lstack(list_entry) := make_ocp_lstack_node(locp, p);
+ end
+else begin
+ q:=ocp_lstack_lnext(p);
+ while q<>0 do begin
+ p:=q; q:=ocp_lstack_lnext(q);
+ end;
+ ocp_lstack_lnext(p):=make_ocp_lstack_node(locp, null);
+ end;
+end;
+
+procedure ocp_apply_remove(list_entry:ocp_list_index;
+ lbefore:boolean);
+var p:ocp_lstack_index;
+ q:ocp_lstack_index;
+ r:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if p=0 then begin
+ print_err("warning: stack entry already empty"); print_ln
+ end
+else begin
+ q := ocp_lstack_lnext(p);
+ if lbefore or (q=0) then
+ ocp_list_lstack(list_entry) := q
+ else begin
+ r:=ocp_lstack_lnext(q);
+ while r <> 0 do begin
+ p:=q; q:=r; r:=ocp_lstack_lnext(r);
+ end;
+ ocp_lstack_lnext(p) := 0;
+ end
+ end;
+end;
+
+procedure scan_scaled; {sets |cur_val| to a scaled value}
+label done, done1, done2, found, not_found, attach_fraction;
+var negative:boolean; {should the answer be negated?}
+@!f:integer; {numerator of a fraction whose denominator is $2^{16}$}
+@!k,@!kk:small_number; {number of digits in a decimal fraction}
+@!p,@!q:pointer; {top of decimal digit stack}
+begin f:=0; arith_error:=false; negative:=false;
+@<Get the next non-blank non-sign...@>;
+back_input;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if cur_tok<>point_token then scan_int
+else begin radix:=10; cur_val:=0;
+ end;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>;
+if cur_val<0 then {in this case |f=0|}
+ begin negative := not negative; negate(cur_val);
+ end;
+if cur_val>@'40000 then arith_error:=true
+else cur_val := cur_val*unity +f;
+if arith_error or(abs(cur_val)>=@'10000000000) then
+begin print_err("Stack number too large");
+end;
+if negative then negate(cur_val);
+end;
+
+procedure print_ocp_lstack(lstack_entry:ocp_lstack_index);
+var p:ocp_lstack_index;
+begin
+p:=lstack_entry;
+while (p<>0) do begin
+ print_esc(ocp_id_text(ocp_lstack_ocp(p)));
+ p:=ocp_lstack_lnext(p);
+ if (p<>0) then print(",");
+ end;
+end;
+
+procedure print_ocp_list(list_entry:ocp_list_index);
+var p:ocp_list_index;
+begin
+print("["); p:=list_entry;
+while not (is_null_ocp_list(p)) do begin
+ print("(");
+ print_scaled(ocp_list_lstack_no(p));
+ print(" : ");
+ print_ocp_lstack(ocp_list_lstack(p));
+ print(")");
+ p:=ocp_list_lnext(p);
+ if not (is_null_ocp_list(p)) then print(", ");
+ end;
+print("]");
+end;
+
+function scan_ocp_list: ocp_list_index;
+var llstack_no:scaled;
+ lop:quarterword;
+ lstack_entry:ocp_list_index;
+ other_list:ocp_list_index;
+ ocp_ident:internal_ocp_number;
+ result:ocp_list_index;
+begin
+get_r_token;
+if cur_cmd = set_ocp_list then
+ result := copy_ocp_list(ocp_list_list[cur_chr])
+else if cur_cmd <> ocp_list_op then begin
+ print_err("Bad ocp list specification");
+@.Bad ocp list specification@>
+ help1("I was looking for a ocp list specification.");
+ result := make_null_ocp_list;
+ end
+else begin
+ lop:=cur_chr;
+ scan_scaled; llstack_no:=cur_val;
+ if (llstack_no<=0) or (llstack_no>=ocp_maxint) then begin
+ print_err("Stack numbers must be between 0 and 4096 (exclusive)");
+ result := make_null_ocp_list;
+ end
+ else begin
+ if lop <= add_after_op then begin
+ scan_ocp_ident; ocp_ident:=cur_val;
+ end;
+ other_list:=scan_ocp_list;
+ lstack_entry:=ocp_ensure_lstack(other_list, llstack_no);
+ if lop <= add_after_op then
+ ocp_apply_add(lstack_entry, (lop=add_before_op), ocp_ident)
+ else
+ ocp_apply_remove(lstack_entry, (lop=remove_before_op));
+ result:=other_list;
+ end;
+ end;
+scan_ocp_list:=result;
+end;
+
+function read_ocp_list: internal_ocp_list_number;
+var f:internal_ocp_list_number;
+ g:internal_ocp_list_number;
+begin
+g:=null_ocp_list;
+f:=ocp_list_ptr+1;
+ocp_listmem_run_ptr:=ocp_listmem_ptr;
+ocp_lstackmem_run_ptr:=ocp_lstackmem_ptr;
+ocp_list_list[f]:=scan_ocp_list;
+ocp_list_ptr:=f;
+ocp_listmem_ptr:=ocp_listmem_run_ptr;
+ocp_lstackmem_ptr:=ocp_lstackmem_run_ptr;
+g:=f;
+read_ocp_list:=g;
+end;
+
+procedure scan_ocp_list_ident;
+var f:internal_ocp_list_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp_list then f:=cur_chr
+else begin print_err("Missing ocp list identifier");
+@.Missing ocp list identifier@>
+ help2("I was looking for a control sequence whose")@/
+ ("current meaning has been defined by \ocplist.");
+ back_error; f:=null_ocp_list;
+ end;
+cur_val:=f;
+end;
+
+
+@z
+%---------------------------------------
+@x [49] m.1210 l.22629 - Omega OCP
+any_mode(set_interaction):prefixed_command;
+@y
+any_mode(set_interaction),
+any_mode(set_ocp),
+any_mode(def_ocp),
+any_mode(set_ocp_list),
+any_mode(def_ocp_list),
+any_mode(clear_ocp_lists),
+any_mode(push_ocp_list),
+any_mode(pop_ocp_list),
+any_mode(ocp_list_op),
+any_mode(ocp_trace_level) : prefixed_command;
+@z
+%---------------------------------------
+@x [50] m.1302 l.23682 - Omega OCP
+@<Dump the font information@>;
+@y
+@<Dump the font information@>;
+@<Dump the ocp information@>;
+@<Dump the ocp list information@>;
+@z
+%---------------------------------------
+@x [50] m.1303 l.23711 - Omega OCP
+@<Undump the font information@>;
+@y
+@<Undump the font information@>;
+@<Undump the ocp information@>;
+@<Undump the ocp list information@>;
+@z
+%---------------------------------------
+@x [50] m.1323 l.24907 - Omega OCP
+begin undump_font_table(k);@/
+end
+@y
+begin undump_font_table(k);@/
+end
+
+@ @<Dump the ocp information@>=
+dump_int(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+ @<Dump the array info for internal ocp number |k|@>;
+print_ln; print_int(ocp_ptr-ocp_base); print(" preloaded ocp");
+if ocp_ptr<>ocp_base+1 then print_char("s")
+
+@ @<Undump the ocp information@>=
+undump_size(ocp_base)(ocp_biggest)('ocp max')(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+ @<Undump the array info for internal ocp number |k|@>
+
+@ @<Dump the array info for internal ocp number |k|@>=
+begin dump_ocp_table(k);
+print_nl("\ocp"); print_esc(ocp_id_text(k)); print_char("=");
+print_file_name(ocp_name(k),ocp_area(k),"");
+end
+
+@ @<Undump the array info for internal ocp number |k|@>=
+begin undump_ocp_table(k);
+end
+
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
+dump_int(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do begin
+ dump_int(ocp_list_list[k]);
+ print_nl("\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char("=");
+ print_ocp_list(ocp_list_list[k]);
+ end;
+dump_int(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
+
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
+undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do
+ undump_int(ocp_list_list[k]);
+undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
+
+@z
+%---------------------------------------
+@x
+@* \[54] $\Omega$ changes.
+
+@y
+@* \[54] $\Omega$ changes.
+
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+
+@ @<Put each...@>=
+primitive("ocp", def_ocp, 0);
+primitive("externalocp", def_ocp, 1);
+primitive("ocplist", def_ocp_list, 0);
+primitive("pushocplist", push_ocp_list, 0);
+primitive("popocplist", pop_ocp_list, 0);
+primitive("clearocplists", clear_ocp_lists, 0);
+primitive("addbeforeocplist", ocp_list_op, add_before_op);
+primitive("addafterocplist", ocp_list_op, add_after_op);
+primitive("removebeforeocplist", ocp_list_op, remove_before_op);
+primitive("removeafterocplist", ocp_list_op, remove_after_op);
+primitive("ocptracelevel", ocp_trace_level, 0);
+set_equiv(ocp_trace_level_base,0);
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_ocp: begin
+ print("select ocp ");
+ slow_print(ocp_name(chr_code));
+ end;
+def_ocp: if cur_chr=0 then print_esc("ocp")
+ else print_esc("externalocp");
+set_ocp_list: print("select ocp list ");
+def_ocp_list: print_esc("ocplist");
+push_ocp_list: print_esc("pushocplist");
+pop_ocp_list: print_esc("popocplist");
+clear_ocp_lists: print_esc("clearocplists");
+ocp_list_op:
+ if chr_code=add_before_op then print_esc("addbeforeocplist")
+ else if chr_code=add_after_op then print_esc("addafterocplist")
+ else if chr_code=remove_before_op then print_esc("removebeforeocplist")
+ else {|chr_code|=|remove_after_op|} print_esc("removeafterocplist");
+ocp_trace_level: print_esc("ocptracelevel");
+
+@ @<Assignments@>=
+set_ocp: begin
+ print_err("To use ocps, use the "); print_esc("pushocplist");
+ print(" primitive");print_ln
+ end;
+def_ocp: new_ocp(a);
+set_ocp_list: begin
+ print_err("To use ocp lists, use the ");
+ print_esc("pushocplist"); print(" primitive");print_ln
+ end;
+def_ocp_list: new_ocp_list(a);
+push_ocp_list: do_push_ocp_list(a);
+pop_ocp_list: do_pop_ocp_list(a);
+clear_ocp_lists: do_clear_ocp_lists(a);
+ocp_list_op: begin
+ print_err("To build ocp lists, use the ");
+ print_esc("ocplist"); print(" primitive"); print_ln
+ end;
+ocp_trace_level: begin scan_optional_equals; scan_int;
+ if cur_val<>0 then cur_val:=1;
+ define(ocp_trace_level_base, data, cur_val);
+ end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp(@!a:small_number);
+label common_ending;
+var u:pointer; {user's ocp identifier}
+@!f:internal_ocp_number; {runs through existing ocps}
+@!t:str_number; {name for the frozen ocp identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+@!flushable_string:str_number; {string not yet referenced}
+@!external_ocp:boolean; {external binary file}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the ocp name}
+@.texput@>
+if cur_chr=1 then external_ocp:=true
+else external_ocp:=false;
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+else if u>=single_base then
+ if u=null_cs then t:="OCP"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("OCP"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_ocp,null_ocp); scan_optional_equals; scan_file_name;
+@<If this ocp has already been loaded, set |f| to the internal
+ ocp number and |goto common_ending|@>;
+f:=read_ocp_info(u,cur_name,cur_area,cur_ext,external_ocp);
+common_ending:
+set_equiv(u,f); set_new_eqtb(ocp_id_base+f,new_eqtb(u));
+settext(ocp_id_base+f,t);
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl(""); print_esc("ocp"); print_esc(t); print("="); print(cur_name);
+ end;
+end;
+
+@ When the user gives a new identifier to a ocp that was previously loaded,
+the new name becomes the ocp identifier of record. OCP names `\.{xyz}' and
+`\.{XYZ}' are considered to be different.
+
+@<If this ocp has already been loaded...@>=
+flushable_string:=str_ptr-1;
+for f:=ocp_base+1 to ocp_ptr do
+ if str_eq_str(ocp_name(f),cur_name)and str_eq_str(ocp_area(f),cur_area) then
+ begin
+ if cur_name=flushable_string then begin
+ flush_string; cur_name:=ocp_name(f);
+ end;
+ goto common_ending
+ end
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp_list(@!a:small_number);
+var u:pointer; {user's ocp list identifier}
+@!f:internal_ocp_list_number; {runs through existing ocp lists}
+@!t:str_number; {name for the frozen ocp list identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+begin if job_name=0 then open_log_file;
+ {avoid confusing \.{texput} with the ocp list name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=newtext(u)
+else if u>=single_base then
+ if u=null_cs then t:="OCPLIST"@+else t:=u-single_base
+else begin old_setting:=selector; selector:=new_string;
+ print("OCPLIST"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+ str_room(1); t:=make_string;
+ end;
+define(u,set_ocp_list,null_ocp_list); scan_optional_equals;
+f:=read_ocp_list;
+ set_equiv(u,f); set_new_eqtb(ocp_list_id_base+f,new_eqtb(u));
+ settext(ocp_list_id_base+f,t);
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl(""); print_esc("ocplist"); print_esc(t); print("=");
+ print_ocp_list(ocp_list_list[f]);
+ end;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_push_ocp_list(@!a:small_number);
+var ocp_list_no:halfword;
+ old_number:halfword;
+ i:integer;
+begin
+scan_ocp_list_ident; ocp_list_no:=cur_val;
+old_number:=equiv(ocp_active_number_base);
+define(ocp_active_base+old_number, data, ocp_list_no);
+define(ocp_active_number_base, data, (old_number+1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl("New active ocp list: {");
+ for i:=old_number downto 0 do begin
+ print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+ print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+ if i<>0 then print(",");
+ end;
+ print("}");
+ end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_pop_ocp_list(@!a:small_number);
+var old_number:halfword;
+ i:integer;
+begin
+old_number:=equiv(ocp_active_number_base);
+if old_number=0 then begin
+ print_err("No active ocp lists to be popped");
+ end
+else
+ define(ocp_active_number_base, data, (old_number-1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+ print_nl("New active ocp list: {");
+ for i:=(old_number-2) downto 0 do begin
+ print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+ print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+ if i<>0 then print(",");
+ end;
+ print("}");
+ end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_clear_ocp_lists(@!a:small_number);
+begin
+define(ocp_active_number_base, data, 0);
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@z
+%---------------------------------------