summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/alephdir/omocp.ch
diff options
context:
space:
mode:
authorDenis Bitouzé <dbitouze@wanadoo.fr>2021-02-25 18:23:07 +0000
committerDenis Bitouzé <dbitouze@wanadoo.fr>2021-02-25 18:23:07 +0000
commitc6101f91d071883b48b1b4b51e5eba0f36d9a78d (patch)
tree1bf7f5a881d7a4f5c5bf59d0b2821943dd822372 /Build/source/texk/web2c/alephdir/omocp.ch
parent07ee7222e389b0777456b427a55c22d0e6ffd267 (diff)
French translation for tlmgr updated
git-svn-id: svn://tug.org/texlive/trunk@57912 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/alephdir/omocp.ch')
-rw-r--r--Build/source/texk/web2c/alephdir/omocp.ch1078
1 files changed, 0 insertions, 1078 deletions
diff --git a/Build/source/texk/web2c/alephdir/omocp.ch b/Build/source/texk/web2c/alephdir/omocp.ch
deleted file mode 100644
index 4b6d1cb2a46..00000000000
--- a/Build/source/texk/web2c/alephdir/omocp.ch
+++ /dev/null
@@ -1,1078 +0,0 @@
-% 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
-%---------------------------------------