% 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@>@ @y @t\4\4@>@ @t\4\4@>@ @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 @ @= @y @ @= @z %--------------------------------------- @x [30] m.??? l.11010 - Omega OCP @ @= @y @ @= @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. @= @!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. @= @!internal_ocp_number=ocp_base..ocp_biggest; @!ocp_index=integer; @ Here now is the array of ocp arrays. @= @!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. @= 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|} @ @= 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;@/ @; bad_ocp: @; 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,""); @= 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 @ @= file_opened:=false; if (ocp_ptr=ocp_biggest) then @; if external_ocp then @ else begin @; @; end; ocp_name(f):=nom; ocp_area(f):=aire @ @= 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 @ @= 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 @ @= 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 @ @= 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. @= procedure scan_ocp_ident; var f:internal_ocp_number; begin @; 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. @= @!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 @= @!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; @ @= 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. @ @= 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; @; 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 @; 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 @; 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 @; @y @; @; @; @z %--------------------------------------- @x [50] m.1303 l.23711 - Omega OCP @; @y @; @; @; @z %--------------------------------------- @x [50] m.1323 l.24907 - Omega OCP begin undump_font_table(k);@/ end @y begin undump_font_table(k);@/ end @ @= dump_int(ocp_ptr); for k:=null_ocp to ocp_ptr do @; print_ln; print_int(ocp_ptr-ocp_base); print(" preloaded ocp"); if ocp_ptr<>ocp_base+1 then print_char("s") @ @= undump_size(ocp_base)(ocp_biggest)('ocp max')(ocp_ptr); for k:=null_ocp to ocp_ptr do @ @ @= 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 @ @= begin undump_ocp_table(k); end @ @= 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_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. @ @= 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); @ @= 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"); @ @= 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; @ @= 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; @; 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. @= 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 @ @= 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; @ @= 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; @ @= 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; @ @= 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 %---------------------------------------