diff options
Diffstat (limited to 'Build/source/texk/web2c/omegadir/omocp.ch')
-rw-r--r-- | Build/source/texk/web2c/omegadir/omocp.ch | 1068 |
1 files changed, 0 insertions, 1068 deletions
diff --git a/Build/source/texk/web2c/omegadir/omocp.ch b/Build/source/texk/web2c/omegadir/omocp.ch deleted file mode 100644 index a99cab4c100..00000000000 --- a/Build/source/texk/web2c/omegadir/omocp.ch +++ /dev/null @@ -1,1068 +0,0 @@ -% omocp.ch: Reading an OCP file -% -% This file is part of Omega, -% which is based on the web2c distribution of TeX, -% -% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous -% -% Omega is free software; you can redistribute it and/or modify -% it under the terms of the GNU General Public License as published by -% the Free Software Foundation; either version 2 of the License, or -% (at your option) any later version. -% -% Omega 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 General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with Omega; 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); -ocp_name(f):=nom; ocp_area(f):=aire; -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...@>= -if external_ocp then - @<Check |ocp_file| exists@> -else begin - @<Open |ocp_file| for input@>; - @<Read the {\.{OCP}} file@>; - end; - -@ @<Check |ocp_file| exists@>= -begin -file_opened:=false; -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@>= -file_opened:=false; -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) := null; - 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 -%--------------------------------------- |