1% omocp.ch: Reading an OCP file 2% 3% This file is part of the Omega project, which 4% is based on the web2c distribution of TeX. 5% 6% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous 7% 8% This library is free software; you can redistribute it and/or 9% modify it under the terms of the GNU Library General Public 10% License as published by the Free Software Foundation; either 11% version 2 of the License, or (at your option) any later version. 12% 13% This library is distributed in the hope that it will be useful, 14% but WITHOUT ANY WARRANTY; without even the implied warranty of 15% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16% Library General Public License for more details. 17% 18% You should have received a copy of the GNU Library General Public 19% License along with this library; if not, write to the Free Software 20% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 21% 22%--------------------------------------- 23@x [1] m.11 l.412 - Omega OCP 24 {string of length |file_name_size|; tells where the string pool appears} 25@.TeXformats@> 26@y 27 {string of length |file_name_size|; tells where the string pool appears} 28@.TeXformats@> 29@!ocp_maxint=@"10000000; 30@z 31%--------------------------------------- 32@x [1] m.12 l.436 - Omega OCP 33@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} 34@y 35@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} 36@d ocp_base=0 {smallest internal ocp number; must not be less 37 than |min_quarterword|} 38@d ocp_biggest=65535 {the real biggest ocp} 39@d number_ocps=ocp_biggest-ocp_base+1 40@d ocp_list_base=0 {smallest internal ocp list number; must not be less 41 than |min_quarterword|} 42@d ocp_list_biggest=65535 {the real biggest ocp list} 43@d number_ocp_lists=ocp_list_biggest-ocp_list_base+1 44@d max_active_ocp_lists=65536 45@z 46%--------------------------------------- 47@x [15] m.209 l.4170 - Omega OCP 48@d max_command=set_interaction 49 {the largest command code seen at |big_switch|} 50@y 51@d set_ocp=set_interaction+1 52 {Place a translation process in the stream} 53@d def_ocp=set_ocp+1 54 {Define and load a translation process} 55@d set_ocp_list=def_ocp+1 56 {Place a list of OCPs in the stream} 57@d def_ocp_list=set_ocp_list+1 58 {Define a list of OCPs} 59@d clear_ocp_lists=def_ocp_list+1 60 {Remove all active OCP lists} 61@d push_ocp_list=clear_ocp_lists+1 62 {Add to the sequence of active OCP lists} 63@d pop_ocp_list=push_ocp_list+1 64 {Remove from the sequence of active OCP lists} 65@d ocp_list_op=pop_ocp_list+1 66 {Operations for building a list of OCPs} 67@d ocp_trace_level=ocp_list_op+1 68 {Tracing of active OCPs, either 0 or 1} 69@d max_command=ocp_trace_level 70 {the largest command code seen at |big_switch|} 71@z 72%--------------------------------------- 73@x [17] m.222 l.4523 - Omega OCP 74@d font_id_base=frozen_null_font-font_base 75 {begins table of |number_fonts| permanent font identifiers} 76@d undefined_control_sequence=frozen_null_font+number_fonts 77@y 78@d font_id_base=frozen_null_font-font_base 79 {begins table of |number_fonts| permanent font identifiers} 80@d frozen_null_ocp=frozen_null_font+number_fonts 81 {permanent `\.{\\nullocp}'} 82@d ocp_id_base=frozen_null_ocp-ocp_base 83 {begins table of |number_ocps| permanent ocp identifiers} 84@d frozen_null_ocp_list=frozen_null_ocp+number_ocps 85 {permanent `\.{\\nullocplist}'} 86@d ocp_list_id_base=frozen_null_ocp_list-ocp_list_base 87 {begins table of |number_ocp_lists| permanent ocp list identifiers} 88@d undefined_control_sequence=frozen_null_ocp_list+number_ocp_lists 89@z 90%--------------------------------------- 91@x 92@d toks_base=local_base+10 {table of |number_regs| token list registers} 93@y 94@d ocp_trace_level_base=local_base+10 95@d ocp_active_number_base=ocp_trace_level_base+1 96@d ocp_active_min_ptr_base = ocp_active_number_base+1 97@d ocp_active_max_ptr_base = ocp_active_min_ptr_base+1 98@d ocp_active_base = ocp_active_max_ptr_base+1 99@d toks_base=ocp_active_base+max_active_ocp_lists 100 {table of |number_regs| token list registers} 101@z 102%--------------------------------------- 103@x [17] m.232 l.4799 - Omega OCP 104@d null_font==font_base 105@y 106@d null_font==font_base 107@d null_ocp==ocp_base 108@d null_ocp_list==ocp_list_base 109@z 110%--------------------------------------- 111@x [18] m.256 l.5479 - Omega OCP 112@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name} 113@y 114@d font_id_text(#) == newtext(font_id_base+#) {a frozen font identifier's name} 115@d ocp_id_text(#) == newtext(ocp_id_base+#) {a frozen ocp identifier's name} 116@d ocp_list_id_text(#) == newtext(ocp_list_id_base+#) 117 {a frozen ocp list identifier's name} 118@z 119%--------------------------------------- 120@x [26] m.409 l.8254 - Omega OCP 121@t\4\4@>@<Declare procedures that scan font-related stuff@> 122@y 123@t\4\4@>@<Declare procedures that scan font-related stuff@> 124@t\4\4@>@<Declare procedures that scan ocp-related stuff@> 125@z 126%--------------------------------------- 127@x [29] m.514 l.9968 - Omega OCP 128|TEX_font_area|. These system area names will, of course, vary from place 129to place. 130@y 131|TEX_font_area|. $\Omega$'s compiled translation process files whose areas 132are not given explicitly are assumed to appear in a standard system area 133called |OMEGA_ocp_area|. These system area names will, of course, vary 134from place to place. 135@z 136%--------------------------------------- 137@x [29] m.514 l.9974 - Omega OCP 138@d TEX_font_area=="TeXfonts:" 139@.TeXfonts@> 140@y 141@d TEX_font_area=="TeXfonts:" 142@.TeXfonts@> 143@d OMEGA_ocp_area=="OmegaOCPs:" 144@.OmegaOCPs@> 145@z 146%--------------------------------------- 147@x [30] m.582 l.10379 - Omega OCP 148@* \[30] Font metric data. 149@y 150@* \[30] Font metric data and OCPs. 151@z 152%--------------------------------------- 153@x [30] m.??? l.10928 - Omega OCP 154@ @<Read and check...@>= 155@y 156@ @<Read and check the font data...@>= 157@z 158%--------------------------------------- 159@x [30] m.??? l.11010 - Omega OCP 160@ @<Apologize for not loading...@>= 161@y 162@ @<Apologize for not loading the font...@>= 163@z 164%--------------------------------------- 165@x [30] m.582 l.11283 - Omega OCP 166char_warning(f,c); 167new_character:=null; 168exit:end; 169@y 170char_warning(f,c); 171new_character:=null; 172exit:end; 173 174@ Here we begin the \.{OCP} file handling. 175 176@<Glob...@>= 177@!ocp_file:byte_file; 178 179@ So that is what \.{OCP} files hold. 180 181When the user defines \.{\\ocp\\f}, say, \TeX\ assigns an internal number 182to the user's ocp~\.{\\f}. Adding this number to |ocp_id_base| gives the 183|eqtb| location of a ``frozen'' control sequence that will always select 184the ocp. 185 186@<Types...@>= 187@!internal_ocp_number=ocp_base..ocp_biggest; 188@!ocp_index=integer; 189 190@ Here now is the array of ocp arrays. 191 192@<Glob...@>= 193@!ocp_ptr:internal_ocp_number; {largest internal ocp number in use} 194 195@ Besides the arrays just enumerated, we have two directory arrays that 196make it easy to get at the individual entries in |ocp_info|. 197The beginning of the info for the |j|-th state in the |i|-th ocp is at 198location |ocp_info[ocp_state_base[i]+j]| and the |k|-th entry is in 199location |ocp_info[ocp_info[ocp_state_base[i]+j]+k]|. 200(These formulas assume that |min_quarterword| has already been 201added to |i|, |j| and |k|, since $\Omega$ stores its quarterwords that way.) 202 203@d ocp_info_end(#)==#] 204@d ocp_info(#)==ocp_tables[#,ocp_info_end 205@d offset_ocp_file_size=0 206@d offset_ocp_name=1 207@d offset_ocp_area=offset_ocp_name+1 208@d offset_ocp_external=offset_ocp_area+1 209@d offset_ocp_external_arg=offset_ocp_external+1 210@d offset_ocp_input=offset_ocp_external_arg+1 211@d offset_ocp_output=offset_ocp_input+1 212@d offset_ocp_no_tables=offset_ocp_output+1 213@d offset_ocp_no_states=offset_ocp_no_tables+1 214@d offset_ocp_table_base=offset_ocp_no_states+1 215@d offset_ocp_state_base=offset_ocp_table_base+1 216@d offset_ocp_info=offset_ocp_state_base+1 217@d ocp_file_size(#)==ocp_info(#)(offset_ocp_file_size) 218@d ocp_name(#)==ocp_info(#)(offset_ocp_name) 219@d ocp_area(#)==ocp_info(#)(offset_ocp_area) 220@d ocp_external(#)==ocp_info(#)(offset_ocp_external) 221@d ocp_external_arg(#)==ocp_info(#)(offset_ocp_external_arg) 222@d ocp_input(#)==ocp_info(#)(offset_ocp_input) 223@d ocp_output(#)==ocp_info(#)(offset_ocp_output) 224@d ocp_no_tables(#)==ocp_info(#)(offset_ocp_no_tables) 225@d ocp_no_states(#)==ocp_info(#)(offset_ocp_no_states) 226@d ocp_table_base(#)==ocp_info(#)(offset_ocp_table_base) 227@d ocp_state_base(#)==ocp_info(#)(offset_ocp_state_base) 228 229@ $\Omega$ always knows at least one ocp, namely the null ocp. 230It does nothing. 231 232@<Initialize table...@>= 233ocp_ptr:=null_ocp; 234allocate_ocp_table(null_ocp,17); 235ocp_file_size(null_ocp):=17; 236ocp_name(null_ocp):="nullocp"; ocp_area(null_ocp):=""; 237ocp_external(null_ocp):=0; ocp_external_arg(null_ocp):=0; 238ocp_input(null_ocp):=1; ocp_output(null_ocp):=1; 239ocp_no_tables(null_ocp):=0; 240ocp_no_states(null_ocp):=1; 241ocp_table_base(f):=offset_ocp_info; 242ocp_state_base(f):=offset_ocp_info; 243ocp_info(null_ocp)(offset_ocp_info) := offset_ocp_info+2; {number of entries} 244ocp_info(null_ocp)(offset_ocp_info+1) := offset_ocp_info+5; {number of entries} 245ocp_info(null_ocp)(offset_ocp_info+2) := 23; {|OTP_LEFT_START|} 246ocp_info(null_ocp)(offset_ocp_info+3) := 3; {|OTP_RIGHT_CHAR|} 247ocp_info(null_ocp)(offset_ocp_info+4) := 36; {|OTP_STOP|} 248 249 250@ @<Put each...@>= 251primitive("nullocp", set_ocp, null_ocp); 252settext(frozen_null_ocp,"nullocp"); 253set_new_eqtb(frozen_null_ocp,new_eqtb(cur_val)); 254geq_define(ocp_active_number_base, data, 0); 255geq_define(ocp_active_min_ptr_base, data, 0); 256geq_define(ocp_active_max_ptr_base, data, 0); 257 258@ Of course we want to define macros that suppress the detail of how ocp 259information is actually packed, so that we don't have to write things like 260$$\hbox{|ocp_info[k+ocp_info[j+ocp_state_base[i]]]|}$$ 261too often. The \.{WEB} definitions here make |ocp_state_entry(i)(j)(k)| 262(|ocp_table_entry(i)(j)(k)|) the |k|-th word in the |j|-th state (table) 263of the |i|-th ocp. 264@^inner loop@> 265 266@d ocp_state_end(#)==#] 267@d ocp_state_one(#)==#*2]+ocp_state_end 268@d ocp_state_entry(#)==ocp_tables[#,ocp_tables[#,ocp_state_base(#)+ocp_state_one 269 270@d ocp_state_no_end(#)==#*2+1] 271@d ocp_state_no(#)==ocp_tables[#,ocp_state_base(#)+ocp_state_no_end 272 273@d ocp_table_end(#)==#] 274@d ocp_table_one(#)==#*2]+ocp_table_end 275@d ocp_table_entry(#)==ocp_tables[#,ocp_tables[#,ocp_table_base(#)+ocp_table_one 276 277@d ocp_table_no_end(#)==#*2+1] 278@d ocp_table_no(#)==ocp_tables[#,ocp_table_base(#)+ocp_table_no_end 279 280@ $\Omega$ checks the information of a \.{OCP} file for validity as the 281file is being read in, so that no further checks will be needed when 282typesetting is going on. The somewhat tedious subroutine that does this 283is called |read_ocp_info|. It has three parameters: the user ocp 284identifier~|u|, and the file name and area strings |nom| and |aire|. 285 286The subroutine opens and closes a global file variable called |ocp_file|. 287It returns the value of the internal ocp number that was just loaded. 288If an error is detected, an error message is issued and no ocp 289information is stored; |null_ocp| is returned in this case. 290 291@d bad_ocp=11 {label for |read_ocp_info|} 292@d ocp_abort(#)==begin print("OCP file error ("); 293 print(#); print(")"); print_ln; goto bad_ocp end 294 {do this when the \.{OCP} data is wrong} 295 296@p function read_ocp_info(@!u:pointer;@!nom,@!aire,@!ext:str_number; 297 @!external_ocp:boolean) 298 :internal_ocp_number; {input a \.{OCP} file} 299label done,bad_ocp,not_found; 300var 301@!file_opened:boolean; {was |ocp_file| successfully opened?} 302@!f:internal_ocp_number; {the new ocp's number} 303@!g:internal_ocp_number; {the number to return} 304@!ocpword:integer; 305@!ocpmem_run_ptr:ocp_index; 306@!ocp_length,real_ocp_length:integer; {length of ocp file} 307@!previous_address:ocp_index; 308@!temp_ocp_input:integer; 309@!temp_ocp_output:integer; 310@!temp_ocp_no_tables:integer; 311@!temp_ocp_no_states:integer; 312@!i,new_offset,room_for_tables,room_for_states:integer; 313begin g:=null_ocp;@/ 314@<Read and check the ocp data; |ocp_abort| if the \.{OCP} file is 315 malformed; if there's no room for this ocp, say so and |goto 316 done|; otherwise |incr(ocp_ptr)| and |goto done|@>; 317bad_ocp: @<Report that the ocp won't be loaded@>; 318done: if file_opened then b_close(ocp_file); 319read_ocp_info:=g; 320end; 321 322@ $\Omega$ does not give precise details about why it 323rejects a particular \.{OCP} file. 324 325@d start_ocp_error_message==print_err("Translation process "); 326 sprint_cs(u); print_char("="); print_file_name(nom,aire,""); 327 328@<Report that the ocp won't be loaded@>= 329start_ocp_error_message; 330@.Translation process x=xx not loadable...@> 331if file_opened then print(" not loadable: Bad ocp file") 332else print(" not loadable: ocp file not found"); 333help2("I wasn't able to read the data for this ocp,")@/ 334("so I will ignore the ocp specification."); 335error 336 337@ @<Read and check the ocp data...@>= 338file_opened:=false; 339if (ocp_ptr=ocp_biggest) then 340 @<Apologize for not loading the ocp, |goto done|@>; 341if external_ocp then 342 @<Check |ocp_file| exists@> 343else begin 344 @<Open |ocp_file| for input@>; 345 @<Read the {\.{OCP}} file@>; 346 end; 347ocp_name(f):=nom; ocp_area(f):=aire 348 349@ @<Apologize for not loading the ocp...@>= 350begin start_ocp_error_message; 351print(" not loaded: Not enough room left"); 352@.Translation process x=xx not loaded...@> 353help2("I cant handle more than 65535 translation processes,")@/ 354("so I will ignore the ocp specification."); 355error; goto done; 356end 357 358@ @<Check |ocp_file| exists@>= 359begin 360pack_file_name(nom,aire,ext); 361b_test_in; 362if name_length=0 then ocp_abort("opening file"); 363f :=ocp_ptr+1; 364allocate_ocp_table(f,13); 365ocp_file_size(f):=13; 366for i:=1 to name_length do begin 367 append_char(name_of_file[i]); 368 end; 369ocp_external(f):=make_string; 370scan_string_argument; 371ocp_external_arg(f):=cur_val; 372ocp_name(f):=""; ocp_area(f):=""; 373ocp_state_base(f):=0; ocp_table_base(f):=0; 374ocp_input(f):=1; ocp_output(f):=1; 375ocp_info(f)(offset_ocp_info):=0; 376ocp_ptr:=f; g:=f; 377goto done; 378end 379 380@ @<Open |ocp_file| for input@>= 381pack_file_name(nom,aire,".ocp"); 382if not b_open_in(ocp_file) then ocp_abort("opening file"); 383file_opened:=true 384 385@ Note: A malformed \.{OCP} file might be shorter than it claims to be; 386thus |eof(ocp_file)| might be true when |read_ocp_info| refers to 387|ocp_file^| or when it says |get(ocp_file)|. If such circumstances 388cause system error messages, you will have to defeat them somehow, 389for example by defining |ocpget| to be `\ignorespaces|begin get(ocp_file);| 390|if eof(ocp_file) then ocp_abort; end|\unskip'. 391@^system dependencies@> 392 393@d add_to_ocp_info(#)==begin ocp_tables[f,ocpmem_run_ptr]:=#; 394 incr(ocpmem_run_ptr); 395 end 396@d ocpget==get(ocp_file) 397@d ocpbyte==ocp_file^ 398@d ocp_read(#)==begin ocpword:=ocpbyte; 399 if ocpword>127 then ocp_abort("checking first octet"); 400 ocpget; ocpword:=ocpword*@'400+ocpbyte; 401 ocpget; ocpword:=ocpword*@'400+ocpbyte; 402 ocpget; ocpword:=ocpword*@'400+ocpbyte; 403 #:=ocpword; 404 end 405@d ocp_read_all(#)==begin ocpget; ocp_read(#); end 406@d ocp_read_info==begin ocp_read_all(ocpword); 407 add_to_ocp_info(ocpword); 408 end 409 410@ @<Read the {\.{OCP}} file@>= 411begin 412f :=ocp_ptr+1; 413ocpmem_run_ptr:=offset_ocp_info; 414ocp_read(ocp_length); 415real_ocp_length:=ocp_length-7; 416ocp_read_all(temp_ocp_input); 417ocp_read_all(temp_ocp_output); 418ocp_read_all(temp_ocp_no_tables); 419ocp_read_all(room_for_tables); 420ocp_read_all(temp_ocp_no_states); 421ocp_read_all(room_for_states); 422if real_ocp_length <> 423 (temp_ocp_no_tables + room_for_tables + 424 temp_ocp_no_states + room_for_states) then 425 ocp_abort("checking size"); 426real_ocp_length:=real_ocp_length+12+ 427 temp_ocp_no_states+temp_ocp_no_tables; 428allocate_ocp_table(f,real_ocp_length); 429ocp_external(f):=0; 430ocp_external_arg(f):=0; 431ocp_file_size(f):=real_ocp_length; 432ocp_input(f):=temp_ocp_input; 433ocp_output(f):=temp_ocp_output; 434ocp_no_tables(f):=temp_ocp_no_tables; 435ocp_no_states(f):=temp_ocp_no_states; 436ocp_table_base(f):=ocpmem_run_ptr; 437if ocp_no_tables(f) <> 0 then begin 438 previous_address:=ocpmem_run_ptr+2*(ocp_no_tables(f)); 439 for i:=1 to ocp_no_tables(f) do begin 440 add_to_ocp_info(previous_address); 441 ocp_read_all(new_offset); 442 add_to_ocp_info(new_offset); 443 previous_address:=previous_address+new_offset; 444 end 445 end; 446if room_for_tables <> 0 then begin 447 for i:=1 to room_for_tables do begin 448 ocp_read_info; 449 end 450 end; 451ocp_state_base(f):=ocpmem_run_ptr; 452if ocp_no_states(f) <> 0 then begin 453 previous_address:=ocpmem_run_ptr+2*(ocp_no_states(f)); 454 for i:=1 to ocp_no_states(f) do begin 455 add_to_ocp_info(previous_address); 456 ocp_read_all(new_offset); 457 add_to_ocp_info(new_offset); 458 previous_address:=previous_address+new_offset; 459 end; 460 end; 461if room_for_states <> 0 then begin 462 for i:=1 to room_for_states do begin 463 ocp_read_info; 464 end 465 end; 466ocp_ptr:=f; g:=f; 467goto done; 468end 469 470@ Before we forget about the format of these tables, let's deal with 471$\Omega$'s basic scanning routine related to ocp information. 472 473@<Declare procedures that scan ocp-related stuff@>= 474procedure scan_ocp_ident; 475var f:internal_ocp_number; 476begin @<Get the next non-blank non-call...@>; 477if cur_cmd=set_ocp then f:=cur_chr 478else begin print_err("Missing ocp identifier"); 479@.Missing ocp identifier@> 480 help2("I was looking for a control sequence whose")@/ 481 ("current meaning has been defined by \ocp."); 482 back_error; f:=null_ocp; 483 end; 484cur_val:=f; 485end; 486 487 488@ Here we begin the \.{OCP} list handling. 489 490 491@<Types...@>= 492@!internal_ocp_list_number=ocp_list_base..ocp_list_biggest; 493@!ocp_list_index=integer; {index into |ocp_list_info|} 494@!ocp_lstack_index=integer; {index into |ocp_lstack_info|} 495 496@ Here now is the array of ocp arrays. 497@d ocp_list_lnext(#)==ocp_list_info[#].hh.b0 498@d ocp_list_lstack(#)==ocp_list_info[#].hh.b1 499@d ocp_list_lstack_no(#)==ocp_list_info[#+1].sc 500@d ocp_lstack_lnext(#)==ocp_lstack_info[#].hh.b0 501@d ocp_lstack_ocp(#)==ocp_lstack_info[#].hh.b1 502@d make_null_ocp_list==make_ocp_list_node(0,ocp_maxint,0) 503@d is_null_ocp_list(#)==ocp_list_lstack_no(#)=ocp_maxint 504@d make_null_ocp_lstack==0 505@d is_null_ocp_lstack(#)==#=0 506@d add_before_op=1 507@d add_after_op=2 508@d remove_before_op=3 509@d remove_after_op=4 510 511@<Glob...@>= 512@!ocp_list_info:array[ocp_list_index] of memory_word; 513 {the big collection of ocp list data} 514@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|} 515@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|} 516@!ocp_lstack_info:array[ocp_lstack_index] of memory_word; 517 {the big collection of ocp lstack data} 518@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|} 519@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|} 520@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use} 521@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index; 522 523@ 524@<Initialize table...@>= 525ocp_listmem_ptr:=2; 526ocp_list_lstack(0):=0; 527ocp_list_lstack_no(0):=ocp_maxint; 528ocp_list_lnext(0):=0; 529ocp_list_ptr:=null_ocp_list; 530ocp_list_list[null_ocp_list]:=0; 531ocp_lstackmem_ptr:=1; 532 533@ $\Omega$ always knows at least one ocp list, namely the null ocp list. 534 535@ @<Put each...@>= 536primitive("nullocplist", set_ocp_list, null_ocp_list); 537settext(frozen_null_ocp_list,"nullocplist"); 538set_new_eqtb(frozen_null_ocp_list,new_eqtb(cur_val)); 539 540@ @p function make_ocp_list_node(llstack:ocp_lstack_index; 541 llstack_no:scaled; 542 llnext:ocp_list_index):ocp_list_index; 543var p:ocp_list_index; 544begin 545p:=ocp_listmem_run_ptr; 546ocp_list_lstack(p):=llstack; 547ocp_list_lstack_no(p):=llstack_no; 548ocp_list_lnext(p):=llnext; 549ocp_listmem_run_ptr:=ocp_listmem_run_ptr+2; 550make_ocp_list_node:=p; 551end; 552 553function make_ocp_lstack_node(locp:internal_ocp_number; 554 llnext:ocp_lstack_index) : ocp_lstack_index; 555var p:ocp_lstack_index; 556begin 557p:=ocp_lstackmem_run_ptr; 558ocp_lstack_ocp(p):=locp; 559ocp_lstack_lnext(p):=llnext; 560incr(ocp_lstackmem_run_ptr); 561make_ocp_lstack_node:=p; 562end; 563 564function copy_ocp_lstack(llstack:ocp_lstack_index):ocp_lstack_index; 565var result:ocp_lstack_index; 566begin 567if is_null_ocp_lstack(llstack) then 568 result:=make_null_ocp_lstack 569else 570 result:=make_ocp_lstack_node(ocp_lstack_ocp(llstack), 571 copy_ocp_lstack(ocp_lstack_lnext(llstack))); 572copy_ocp_lstack:=result; 573end; 574 575function copy_ocp_list(list:ocp_list_index):ocp_list_index; 576var result:ocp_list_index; 577begin 578if is_null_ocp_list(list) then 579 result:=make_null_ocp_list 580else 581 result:=make_ocp_list_node(copy_ocp_lstack(ocp_list_lstack(list)), 582 ocp_list_lstack_no(list), 583 copy_ocp_list(ocp_list_lnext(list))); 584copy_ocp_list:=result; 585end; 586 587function ocp_ensure_lstack(list:ocp_list_index; llstack_no:scaled): 588 ocp_list_index; 589var p:ocp_list_index; 590 q:ocp_list_index; 591begin 592p:=list; 593if is_null_ocp_list(p) then begin 594 ocp_list_lstack_no(p) := llstack_no; 595 ocp_list_lnext(p) := make_null_ocp_list; 596 end 597else if ocp_list_lstack_no(p) > llstack_no then begin 598 ocp_list_lnext(p):= 599 make_ocp_list_node(ocp_list_lstack(p), 600 ocp_list_lstack_no(p), 601 ocp_list_lnext(p)); 602 ocp_list_lstack(p):=0; 603 ocp_list_lstack_no(p):=llstack_no; 604 end 605else begin 606 q:=ocp_list_lnext(p); 607 while (not (is_null_ocp_list(q))) and 608 ocp_list_lstack_no(q) <= llstack_no do begin 609 p:=q; q:=ocp_list_lnext(q); 610 end; 611 if ocp_list_lstack_no(p) < llstack_no then begin 612 ocp_list_lnext(p) := make_ocp_list_node(0, llstack_no, q); 613 p := ocp_list_lnext(p); 614 end; 615 end; 616ocp_ensure_lstack := p; 617end; 618 619procedure ocp_apply_add(list_entry:ocp_list_index; 620 lbefore:boolean; 621 locp:internal_ocp_number); 622var p:ocp_lstack_index; 623 q:ocp_lstack_index; 624begin 625p := ocp_list_lstack(list_entry); 626if lbefore or (p=0) then begin 627 ocp_list_lstack(list_entry) := make_ocp_lstack_node(locp, p); 628 end 629else begin 630 q:=ocp_lstack_lnext(p); 631 while q<>0 do begin 632 p:=q; q:=ocp_lstack_lnext(q); 633 end; 634 ocp_lstack_lnext(p):=make_ocp_lstack_node(locp, null); 635 end; 636end; 637 638procedure ocp_apply_remove(list_entry:ocp_list_index; 639 lbefore:boolean); 640var p:ocp_lstack_index; 641 q:ocp_lstack_index; 642 r:ocp_lstack_index; 643begin 644p := ocp_list_lstack(list_entry); 645if p=0 then begin 646 print_err("warning: stack entry already empty"); print_ln 647 end 648else begin 649 q := ocp_lstack_lnext(p); 650 if lbefore or (q=0) then 651 ocp_list_lstack(list_entry) := q 652 else begin 653 r:=ocp_lstack_lnext(q); 654 while r <> 0 do begin 655 p:=q; q:=r; r:=ocp_lstack_lnext(r); 656 end; 657 ocp_lstack_lnext(p) := 0; 658 end 659 end; 660end; 661 662procedure scan_scaled; {sets |cur_val| to a scaled value} 663label done, done1, done2, found, not_found, attach_fraction; 664var negative:boolean; {should the answer be negated?} 665@!f:integer; {numerator of a fraction whose denominator is $2^{16}$} 666@!k,@!kk:small_number; {number of digits in a decimal fraction} 667@!p,@!q:pointer; {top of decimal digit stack} 668begin f:=0; arith_error:=false; negative:=false; 669@<Get the next non-blank non-sign...@>; 670back_input; 671if cur_tok=continental_point_token then cur_tok:=point_token; 672if cur_tok<>point_token then scan_int 673else begin radix:=10; cur_val:=0; 674 end; 675if cur_tok=continental_point_token then cur_tok:=point_token; 676if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>; 677if cur_val<0 then {in this case |f=0|} 678 begin negative := not negative; negate(cur_val); 679 end; 680if cur_val>@'40000 then arith_error:=true 681else cur_val := cur_val*unity +f; 682if arith_error or(abs(cur_val)>=@'10000000000) then 683begin print_err("Stack number too large"); 684end; 685if negative then negate(cur_val); 686end; 687 688procedure print_ocp_lstack(lstack_entry:ocp_lstack_index); 689var p:ocp_lstack_index; 690begin 691p:=lstack_entry; 692while (p<>0) do begin 693 print_esc(ocp_id_text(ocp_lstack_ocp(p))); 694 p:=ocp_lstack_lnext(p); 695 if (p<>0) then print(","); 696 end; 697end; 698 699procedure print_ocp_list(list_entry:ocp_list_index); 700var p:ocp_list_index; 701begin 702print("["); p:=list_entry; 703while not (is_null_ocp_list(p)) do begin 704 print("("); 705 print_scaled(ocp_list_lstack_no(p)); 706 print(" : "); 707 print_ocp_lstack(ocp_list_lstack(p)); 708 print(")"); 709 p:=ocp_list_lnext(p); 710 if not (is_null_ocp_list(p)) then print(", "); 711 end; 712print("]"); 713end; 714 715function scan_ocp_list: ocp_list_index; 716var llstack_no:scaled; 717 lop:quarterword; 718 lstack_entry:ocp_list_index; 719 other_list:ocp_list_index; 720 ocp_ident:internal_ocp_number; 721 result:ocp_list_index; 722begin 723get_r_token; 724if cur_cmd = set_ocp_list then 725 result := copy_ocp_list(ocp_list_list[cur_chr]) 726else if cur_cmd <> ocp_list_op then begin 727 print_err("Bad ocp list specification"); 728@.Bad ocp list specification@> 729 help1("I was looking for a ocp list specification."); 730 result := make_null_ocp_list; 731 end 732else begin 733 lop:=cur_chr; 734 scan_scaled; llstack_no:=cur_val; 735 if (llstack_no<=0) or (llstack_no>=ocp_maxint) then begin 736 print_err("Stack numbers must be between 0 and 4096 (exclusive)"); 737 result := make_null_ocp_list; 738 end 739 else begin 740 if lop <= add_after_op then begin 741 scan_ocp_ident; ocp_ident:=cur_val; 742 end; 743 other_list:=scan_ocp_list; 744 lstack_entry:=ocp_ensure_lstack(other_list, llstack_no); 745 if lop <= add_after_op then 746 ocp_apply_add(lstack_entry, (lop=add_before_op), ocp_ident) 747 else 748 ocp_apply_remove(lstack_entry, (lop=remove_before_op)); 749 result:=other_list; 750 end; 751 end; 752scan_ocp_list:=result; 753end; 754 755function read_ocp_list: internal_ocp_list_number; 756var f:internal_ocp_list_number; 757 g:internal_ocp_list_number; 758begin 759g:=null_ocp_list; 760f:=ocp_list_ptr+1; 761ocp_listmem_run_ptr:=ocp_listmem_ptr; 762ocp_lstackmem_run_ptr:=ocp_lstackmem_ptr; 763ocp_list_list[f]:=scan_ocp_list; 764ocp_list_ptr:=f; 765ocp_listmem_ptr:=ocp_listmem_run_ptr; 766ocp_lstackmem_ptr:=ocp_lstackmem_run_ptr; 767g:=f; 768read_ocp_list:=g; 769end; 770 771procedure scan_ocp_list_ident; 772var f:internal_ocp_list_number; 773begin @<Get the next non-blank non-call...@>; 774if cur_cmd=set_ocp_list then f:=cur_chr 775else begin print_err("Missing ocp list identifier"); 776@.Missing ocp list identifier@> 777 help2("I was looking for a control sequence whose")@/ 778 ("current meaning has been defined by \ocplist."); 779 back_error; f:=null_ocp_list; 780 end; 781cur_val:=f; 782end; 783 784 785@z 786%--------------------------------------- 787@x [49] m.1210 l.22629 - Omega OCP 788any_mode(set_interaction):prefixed_command; 789@y 790any_mode(set_interaction), 791any_mode(set_ocp), 792any_mode(def_ocp), 793any_mode(set_ocp_list), 794any_mode(def_ocp_list), 795any_mode(clear_ocp_lists), 796any_mode(push_ocp_list), 797any_mode(pop_ocp_list), 798any_mode(ocp_list_op), 799any_mode(ocp_trace_level) : prefixed_command; 800@z 801%--------------------------------------- 802@x [50] m.1302 l.23682 - Omega OCP 803@<Dump the font information@>; 804@y 805@<Dump the font information@>; 806@<Dump the ocp information@>; 807@<Dump the ocp list information@>; 808@z 809%--------------------------------------- 810@x [50] m.1303 l.23711 - Omega OCP 811@<Undump the font information@>; 812@y 813@<Undump the font information@>; 814@<Undump the ocp information@>; 815@<Undump the ocp list information@>; 816@z 817%--------------------------------------- 818@x [50] m.1323 l.24907 - Omega OCP 819begin undump_font_table(k);@/ 820end 821@y 822begin undump_font_table(k);@/ 823end 824 825@ @<Dump the ocp information@>= 826dump_int(ocp_ptr); 827for k:=null_ocp to ocp_ptr do 828 @<Dump the array info for internal ocp number |k|@>; 829print_ln; print_int(ocp_ptr-ocp_base); print(" preloaded ocp"); 830if ocp_ptr<>ocp_base+1 then print_char("s") 831 832@ @<Undump the ocp information@>= 833undump_size(ocp_base)(ocp_biggest)('ocp max')(ocp_ptr); 834for k:=null_ocp to ocp_ptr do 835 @<Undump the array info for internal ocp number |k|@> 836 837@ @<Dump the array info for internal ocp number |k|@>= 838begin dump_ocp_table(k); 839print_nl("\ocp"); print_esc(ocp_id_text(k)); print_char("="); 840print_file_name(ocp_name(k),ocp_area(k),""); 841end 842 843@ @<Undump the array info for internal ocp number |k|@>= 844begin undump_ocp_table(k); 845end 846 847@ @<Dump the ocp list information@>= 848dump_int(ocp_listmem_ptr); 849for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]); 850dump_int(ocp_list_ptr); 851for k:=null_ocp_list to ocp_list_ptr do begin 852 dump_int(ocp_list_list[k]); 853 print_nl("\ocplist"); 854 print_esc(ocp_list_id_text(k)); 855 print_char("="); 856 print_ocp_list(ocp_list_list[k]); 857 end; 858dump_int(ocp_lstackmem_ptr); 859for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k]) 860 861@ @<Undump the ocp list information@>= 862undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr); 863for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]); 864undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr); 865for k:=null_ocp_list to ocp_list_ptr do 866 undump_int(ocp_list_list[k]); 867undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr); 868for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k]) 869 870@z 871%--------------------------------------- 872@x 873@* \[54] $\Omega$ changes. 874 875@y 876@* \[54] $\Omega$ changes. 877 878@ Here we do the main work required for reading and interpreting 879 $\Omega$ Compiled Translation Processes. 880 881@ @<Put each...@>= 882primitive("ocp", def_ocp, 0); 883primitive("externalocp", def_ocp, 1); 884primitive("ocplist", def_ocp_list, 0); 885primitive("pushocplist", push_ocp_list, 0); 886primitive("popocplist", pop_ocp_list, 0); 887primitive("clearocplists", clear_ocp_lists, 0); 888primitive("addbeforeocplist", ocp_list_op, add_before_op); 889primitive("addafterocplist", ocp_list_op, add_after_op); 890primitive("removebeforeocplist", ocp_list_op, remove_before_op); 891primitive("removeafterocplist", ocp_list_op, remove_after_op); 892primitive("ocptracelevel", ocp_trace_level, 0); 893set_equiv(ocp_trace_level_base,0); 894 895@ @<Cases of |print_cmd_chr|...@>= 896set_ocp: begin 897 print("select ocp "); 898 slow_print(ocp_name(chr_code)); 899 end; 900def_ocp: if cur_chr=0 then print_esc("ocp") 901 else print_esc("externalocp"); 902set_ocp_list: print("select ocp list "); 903def_ocp_list: print_esc("ocplist"); 904push_ocp_list: print_esc("pushocplist"); 905pop_ocp_list: print_esc("popocplist"); 906clear_ocp_lists: print_esc("clearocplists"); 907ocp_list_op: 908 if chr_code=add_before_op then print_esc("addbeforeocplist") 909 else if chr_code=add_after_op then print_esc("addafterocplist") 910 else if chr_code=remove_before_op then print_esc("removebeforeocplist") 911 else {|chr_code|=|remove_after_op|} print_esc("removeafterocplist"); 912ocp_trace_level: print_esc("ocptracelevel"); 913 914@ @<Assignments@>= 915set_ocp: begin 916 print_err("To use ocps, use the "); print_esc("pushocplist"); 917 print(" primitive");print_ln 918 end; 919def_ocp: new_ocp(a); 920set_ocp_list: begin 921 print_err("To use ocp lists, use the "); 922 print_esc("pushocplist"); print(" primitive");print_ln 923 end; 924def_ocp_list: new_ocp_list(a); 925push_ocp_list: do_push_ocp_list(a); 926pop_ocp_list: do_pop_ocp_list(a); 927clear_ocp_lists: do_clear_ocp_lists(a); 928ocp_list_op: begin 929 print_err("To build ocp lists, use the "); 930 print_esc("ocplist"); print(" primitive"); print_ln 931 end; 932ocp_trace_level: begin scan_optional_equals; scan_int; 933 if cur_val<>0 then cur_val:=1; 934 define(ocp_trace_level_base, data, cur_val); 935 end; 936 937@ @<Declare subprocedures for |prefixed_command|@>= 938procedure new_ocp(@!a:small_number); 939label common_ending; 940var u:pointer; {user's ocp identifier} 941@!f:internal_ocp_number; {runs through existing ocps} 942@!t:str_number; {name for the frozen ocp identifier} 943@!old_setting:0..max_selector; {holds |selector| setting} 944@!flushable_string:str_number; {string not yet referenced} 945@!external_ocp:boolean; {external binary file} 946begin if job_name=0 then open_log_file; 947 {avoid confusing \.{texput} with the ocp name} 948@.texput@> 949if cur_chr=1 then external_ocp:=true 950else external_ocp:=false; 951get_r_token; u:=cur_cs; 952if u>=hash_base then t:=newtext(u) 953else if u>=single_base then 954 if u=null_cs then t:="OCP"@+else t:=u-single_base 955else begin old_setting:=selector; selector:=new_string; 956 print("OCP"); print(u-active_base); selector:=old_setting; 957@.OCPx@> 958 str_room(1); t:=make_string; 959 end; 960define(u,set_ocp,null_ocp); scan_optional_equals; scan_file_name; 961@<If this ocp has already been loaded, set |f| to the internal 962 ocp number and |goto common_ending|@>; 963f:=read_ocp_info(u,cur_name,cur_area,cur_ext,external_ocp); 964common_ending: 965set_equiv(u,f); set_new_eqtb(ocp_id_base+f,new_eqtb(u)); 966settext(ocp_id_base+f,t); 967if equiv(ocp_trace_level_base)=1 then begin 968 print_nl(""); print_esc("ocp"); print_esc(t); print("="); print(cur_name); 969 end; 970end; 971 972@ When the user gives a new identifier to a ocp that was previously loaded, 973the new name becomes the ocp identifier of record. OCP names `\.{xyz}' and 974`\.{XYZ}' are considered to be different. 975 976@<If this ocp has already been loaded...@>= 977flushable_string:=str_ptr-1; 978for f:=ocp_base+1 to ocp_ptr do 979 if str_eq_str(ocp_name(f),cur_name)and str_eq_str(ocp_area(f),cur_area) then 980 begin 981 if cur_name=flushable_string then begin 982 flush_string; cur_name:=ocp_name(f); 983 end; 984 goto common_ending 985 end 986 987@ @<Declare subprocedures for |prefixed_command|@>= 988procedure new_ocp_list(@!a:small_number); 989var u:pointer; {user's ocp list identifier} 990@!f:internal_ocp_list_number; {runs through existing ocp lists} 991@!t:str_number; {name for the frozen ocp list identifier} 992@!old_setting:0..max_selector; {holds |selector| setting} 993begin if job_name=0 then open_log_file; 994 {avoid confusing \.{texput} with the ocp list name} 995@.texput@> 996get_r_token; u:=cur_cs; 997if u>=hash_base then t:=newtext(u) 998else if u>=single_base then 999 if u=null_cs then t:="OCPLIST"@+else t:=u-single_base 1000else begin old_setting:=selector; selector:=new_string; 1001 print("OCPLIST"); print(u-active_base); selector:=old_setting; 1002@.OCPx@> 1003 str_room(1); t:=make_string; 1004 end; 1005define(u,set_ocp_list,null_ocp_list); scan_optional_equals; 1006f:=read_ocp_list; 1007 set_equiv(u,f); set_new_eqtb(ocp_list_id_base+f,new_eqtb(u)); 1008 settext(ocp_list_id_base+f,t); 1009if equiv(ocp_trace_level_base)=1 then begin 1010 print_nl(""); print_esc("ocplist"); print_esc(t); print("="); 1011 print_ocp_list(ocp_list_list[f]); 1012 end; 1013end; 1014 1015@ @<Declare subprocedures for |prefixed_command|@>= 1016procedure do_push_ocp_list(@!a:small_number); 1017var ocp_list_no:halfword; 1018 old_number:halfword; 1019 i:integer; 1020begin 1021scan_ocp_list_ident; ocp_list_no:=cur_val; 1022old_number:=equiv(ocp_active_number_base); 1023define(ocp_active_base+old_number, data, ocp_list_no); 1024define(ocp_active_number_base, data, (old_number+1)); 1025 1026if equiv(ocp_trace_level_base)=1 then begin 1027 print_nl("New active ocp list: {"); 1028 for i:=old_number downto 0 do begin 1029 print_esc(ocp_list_id_text(equiv(ocp_active_base+i))); 1030 print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]); 1031 if i<>0 then print(","); 1032 end; 1033 print("}"); 1034 end; 1035 1036active_compile; 1037define(ocp_active_min_ptr_base, data, active_min_ptr); 1038define(ocp_active_max_ptr_base, data, active_max_ptr); 1039end; 1040 1041@ @<Declare subprocedures for |prefixed_command|@>= 1042procedure do_pop_ocp_list(@!a:small_number); 1043var old_number:halfword; 1044 i:integer; 1045begin 1046old_number:=equiv(ocp_active_number_base); 1047if old_number=0 then begin 1048 print_err("No active ocp lists to be popped"); 1049 end 1050else 1051 define(ocp_active_number_base, data, (old_number-1)); 1052 1053if equiv(ocp_trace_level_base)=1 then begin 1054 print_nl("New active ocp list: {"); 1055 for i:=(old_number-2) downto 0 do begin 1056 print_esc(ocp_list_id_text(equiv(ocp_active_base+i))); 1057 print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]); 1058 if i<>0 then print(","); 1059 end; 1060 print("}"); 1061 end; 1062 1063active_compile; 1064define(ocp_active_min_ptr_base, data, active_min_ptr); 1065define(ocp_active_max_ptr_base, data, active_max_ptr); 1066end; 1067 1068@ @<Declare subprocedures for |prefixed_command|@>= 1069procedure do_clear_ocp_lists(@!a:small_number); 1070begin 1071define(ocp_active_number_base, data, 0); 1072active_compile; 1073define(ocp_active_min_ptr_base, data, active_min_ptr); 1074define(ocp_active_max_ptr_base, data, active_max_ptr); 1075end; 1076 1077@z 1078%--------------------------------------- 1079