1% 2% This file is part of the Omega project, which 3% is based in the web2c distribution of TeX. 4% 5% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous 6% applies only to the changes to the original tftopl.ch. 7% 8% tftopl.ch for C compilation with web2c. 9% 10% 04/04/83 (PC) Original version, made to work with version 1.0 of TFtoPL, 11% released with version 0.96 of TeX in February, 1983. 12% 04/16/83 (PC) Brought up to version 1.0 released with version 0.97 of TeX 13% in April, 1983. 14% 06/30/83 (HWT) Revised changefile format, for use with version 1.7 Tangle. 15% 07/28/83 (HWT) Brought up to version 2 16% 11/21/83 (HWT) Brought up to version 2.1 17% 03/24/84 (HWT) Brought up to version 2.2 18% 07/12/84 (HWT) Brought up to version 2.3 19% 07/05/87 (ETM) Brought up to version 2.5 20% 03/22/88 (ETM) Converted for use with WEB to C. 21% 11/30/89 (KB) Version 3. 22% 01/16/90 (SR) Version 3.1. 23% (more recent changes in the ChangeLog) 24 25@x [0] WEAVE: print changes only. 26\pageno=\contentspagenumber \advance\pageno by 1 27@y 28\pageno=\contentspagenumber \advance\pageno by 1 29%\let\maybe=\iffalse 30%\def\title{TF\lowercase{to}PL changes for C} 31@z 32 33@x [1] Define my_name 34@d banner=='This is OFM2OPL, Version 1.13' {printed when the program starts} 35@y 36@d my_name=='ofm2opl' 37@d banner=='This is OFM2OPL, Version 1.13' {printed when the program starts} 38@z 39 40@x [2] Print all terminal output on stderr, so the pl can be sent to stdout. 41@d print(#)==write(#) 42@d print_ln(#)==write_ln(#) 43@y 44@d print(#)==write(stderr,#) 45@d print_ln(#)==write_ln(stderr,#) 46@z 47 48% [2] Fix files in program statement. We need to tell web2c about one 49% special variable. Perhaps it would be better to allow @define's 50% anywhere in a source file, but that seemed just as painful as this. 51@x 52@p program OFM2OPL(@!tfm_file,@!pl_file,@!output); 53@y 54@p 55{Tangle doesn't recognize @@ when it's right after the \.=.} 56@\@= @@define var tfm;@>@\ 57program OFM2OPL(@!tfm_file,@!pl_file,@!output); 58@z 59 60@x [still 2] Don't print banner until later (and unless verbose). 61procedure initialize; {this procedure gets things started properly} 62 begin print_ln(banner);@/ 63@y 64@<Define |parse_arguments|@> 65procedure initialize; {this procedure gets things started properly} 66 begin 67 kpse_set_program_name (argv[0], my_name); 68 kpse_init_prog ('OFM2OPL', 0, nil, nil); 69 {We |xrealloc| when we know how big the file is. The 1000 comes 70 from the negative lower bound.} 71 tfm_file_array := xmalloc_array (byte, 1008); 72 parse_arguments; 73@z 74 75@x [4] Drop unused constant. 76@!tfm_size=2000000; {maximum length of |tfm| data, in bytes} 77@y 78@z 79 80@x [7] Open the TFM file. 81@ On some systems you may have to do something special to read a 82packed file of bytes. For example, the following code didn't work 83when it was first tried at Stanford, because packed files have to be 84opened with a special switch setting on the \PASCAL\ that was used. 85@^system dependencies@> 86 87@<Set init...@>= 88reset(tfm_file); 89@y 90@ On some systems you may have to do something special to read a 91packed file of bytes. With C under Unix, we just open the file by name 92and read characters from it. 93 94@<Set init...@>= 95tfm_file := kpse_open_file (tfm_name, kpse_ofm_format); 96if verbose then begin 97 print (banner); 98 print_ln (version_string); 99end; 100@z 101 102@x [17] Open the PL file. 103@!pl_file:text; 104 105@ @<Set init...@>= 106rewrite(pl_file); 107@y 108@!pl_file:text; 109 110@ If an explicit filename isn't given, we write to |stdout|. 111 112@<Set init...@>= 113if optind + 1 = argc then begin 114 pl_file := stdout; 115end else begin 116 pl_name := extend_filename (cmdline (optind + 1), 'opl'); 117 rewrite (pl_file, pl_name); 118end; 119@z 120 121@x [18] Make |tfm| be dynamically allocated, and rename `index'. 122@<Types...@>= 123@!byte=0..255; {unsigned eight-bit quantity} 124@!index=0..tfm_size; {address of a byte in |tfm|} 125@y 126@d index == index_type 127 128@<Types...@>= 129@!byte=0..255; {unsigned eight-bit quantity} 130@!index=integer; {address of a byte in |tfm|} 131@z 132 133@x [19] Make |tfm| dynamically allocated. 134@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here} 135@y 136{Kludge here to define |tfm| as a macro which takes care of the negative 137 lower bound. We've defined |tfm| for the benefit of web2c above.} 138@=#define tfm (tfmfilearray + 1001);@>@\ 139@!tfm_file_array: ^byte; {the input data all goes here} 140@z 141 142% [21] abort() should cause a bad exit code. 143@x 144@d abort(#)==begin print_ln(#); 145 print_ln('Sorry, but I can''t go on; are you sure this is a OFM?'); 146 goto final_end; 147 end 148@y 149@d abort(#)==begin print_ln(#); 150 write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OFM?'); 151 uexit(1); 152 end 153@z 154 155@x [21] Allow arbitrarily large input files. 156if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); 157@.The file is bigger...@> 158@y 159tfm_file_array := xrealloc_array (tfm_file_array, byte, 4 * lf + 1000); 160@z 161 162% [28, 29] Change strings to C char pointers. The Pascal strings are 163% indexed starting at 1, so we pad with a blank. 164@x 165@!ASCII_04,@!ASCII_10,@!ASCII_14: packed array [1..32] of char; 166 {strings for output in the user's external character set} 167@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; 168 {handy string constants for |face| codes} 169@!HEX: packed array [1..16] of char; 170@y 171@!ASCII_04,@!ASCII_10,@!ASCII_14: const_c_string; 172 {strings for output in the user's external character set} 173@!ASCII_all: packed array[0..256] of char; 174@!MBL_string,@!RI_string,@!RCE_string: const_c_string; 175 {handy string constants for |face| codes} 176@!HEX: const_c_string; 177@z 178@x 179ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ 180ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ 181ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/ 182MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; 183HEX:='0123456789ABCDEF';@/ 184@y 185ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ 186ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ 187ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~ ';@/ 188strcpy (ASCII_all, ASCII_04); 189strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); 190strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/ 191MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE'; 192HEX:=' 0123456789ABCDEF';@/ 193@z 194 195% [39] How we output the character code depends on |charcode_format|. 196%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 197@x 198begin if font_type>vanilla then 199 out_hex_char(c) 200else if (c>="0")and(c<="9") then 201 out(' C ',c-"0":1) 202else if (c>="A")and(c<="Z") then 203 out(' C ',ASCII_10[c-"A"+2]) 204else if (c>="a")and(c<="z") then 205 out(' C ',ASCII_14[c-"a"+2]) 206else out_hex_char(c); 207@y 208begin if (font_type > vanilla) or (charcode_format = charcode_hex) then 209 out_hex_char(c) 210else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~") 211 and (c <> "(") and (c <> ")") then 212 out(' C ', ASCII_all[c - " " + 1]) 213{default case, use hex} 214else out_hex_char(c); 215@z 216 217% [40] Don't output the face code as an integer. 218%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 219@x 220 out(MBL_string[1+(b mod 3)]); 221 out(RI_string[1+s]); 222 out(RCE_string[1+(b div 3)]); 223@y 224 put_byte(MBL_string[1+(b mod 3)], pl_file); 225 put_byte(RI_string[1+s], pl_file); 226 put_byte(RCE_string[1+(b div 3)], pl_file); 227@z 228 229% [95] No progress reports unless verbose. 230%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 231@x 232 incr(chars_on_line); 233 end; 234 if no_repeats(c)>0 then begin 235 print_hex(c); print('-'); print_hex(c+no_repeats(c)); incr(chars_on_line); 236 left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln; 237 end 238 else begin 239 print_hex(c); {progress report} 240 left; out('CHARACTER'); out_char(c); out_ln; 241 end; 242@y 243 if verbose then incr(chars_on_line); 244 end; 245 if no_repeats(c)>0 then begin 246 if verbose then begin 247 print_hex(c); print('-'); print_hex(c+no_repeats(c)); incr(chars_on_line); 248 end; 249 left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln; 250 end 251 else begin 252 if verbose then print_hex(c); {progress report} 253 left; out('CHARACTER'); out_char(c); out_ln; 254 end; 255@z 256 257% [107] Change the name of the variable `class', since AIX 3.1's <math.h> 258% defines a function by that name. 259%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 260@x 261@d pending=4 {$f(x,y)$ is being evaluated} 262@y 263@d pending=4 {$f(x,y)$ is being evaluated} 264 265@d class == class_var 266@z 267 268@x [108] 269 goto final_end; 270@y 271 uexit(1); 272@z 273 274% [108] Change name of the function `f'. 275%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 276@x 277 r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); 278@y 279 r:=f_fn(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); 280@z 281 282% [112] web2c can't handle these mutually recursive procedures. 283% But let's do a fake definition of f here, so that it gets into web2c's 284% symbol table. We also have to change the name, because there is also a 285% variable named `f', and some C compilers can't deal with that. 286@x 287@p function f(@!h,@!x,@!y:index):index; forward;@t\2@> 288 {compute $f$ for arguments known to be in |hash[h]|} 289@y 290@p 291ifdef('notdef') 292function f_fn(@!h,@!x,@!y:index):index; begin end;@t\2@> 293 {compute $f$ for arguments known to be in |hash[h]|} 294endif('notdef') 295@z 296@x 297else eval:=f(h,x,y); 298@y 299else eval:=f_fn(h,x,y); 300@z 301 302% [113] The real definition of f. 303%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 304@x 305@p function f; 306@y 307@p function f_fn(@!h,@!x,@!y:index):index; 308@z 309@x 310f:=lig_z[h]; 311@y 312f_fn:=lig_z[h]; 313@z 314 315@x [114] Eliminate the |final_end| and |exit| labels. 316label final_end, 30; 317@y 318@z 319@x 320organize:=true; goto 30; 321final_end: organize:=false; 32230: end; 323@y 324organize:=true 325end; 326@z 327 328@x [117] 329if not organize then goto final_end; 330@y 331if not organize then uexit(1); 332@z 333 334% [117] No final newline unless verbose. 335%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 336@x 337do_characters; print_ln('.');@/ 338@y 339do_characters; if verbose then print_ln('.');@/ 340@z 341 342@x [117] 343final_end:end. 344@y 345end. 346@z 347 348@x [118] System-dependent changes. 349This section should be replaced, if necessary, by changes to the program 350that are necessary to make \.{TFtoPL} work at a particular installation. 351It is usually best to design your change file so that all changes to 352previous sections preserve the section numbering; then everybody's version 353will be consistent with the printed program. More extensive changes, 354which introduce new sections, can be inserted here; then only the index 355itself will get a new section number. 356@^system dependencies@> 357@y 358Parse a Unix-style command line. 359 360@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0) 361 362@<Define |parse_arguments|@> = 363procedure parse_arguments; 364const n_options = 4; {Pascal won't count array lengths for us.} 365var @!long_options: array[0..n_options] of getopt_struct; 366 @!getopt_return_val: integer; 367 @!option_index: c_int_type; 368 @!current_option: 0..n_options; 369begin 370 @<Initialize the option variables@>; 371 @<Define the option table@>; 372 repeat 373 getopt_return_val := getopt_long_only (argc, argv, '', long_options, 374 address_of (option_index)); 375 if getopt_return_val = -1 then begin 376 {End of arguments; we exit the loop below.} ; 377 378 end else if getopt_return_val = "?" then begin 379 usage (my_name); 380 381 end else if argument_is ('help') then begin 382 usage_help (OFM2OPL_HELP, nil); 383 384 end else if argument_is ('version') then begin 385 print_version_and_exit 386 (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil); 387 388 end else if argument_is ('charcode-format') then begin 389 if strcmp (optarg, 'ascii') = 0 then 390 charcode_format := charcode_ascii 391 else if strcmp (optarg, 'hex') = 0 then 392 charcode_format := charcode_hex 393 else 394 write_ln (stderr, 'Bad character code format ', stringcast(optarg), '.'); 395 396 end; {Else it was a flag; |getopt| has already done the assignment.} 397 until getopt_return_val = -1; 398 399 {Now |optind| is the index of first non-option on the command line.} 400 if (optind + 1 <> argc) and (optind + 2 <> argc) then begin 401 write_ln (stderr, my_name, ': Need one or two file arguments.'); 402 usage (my_name); 403 end; 404 405 tfm_name := cmdline (optind); 406end; 407 408@ Here are the options we allow. The first is one of the standard GNU options. 409@.-help@> 410 411@<Define the option...@> = 412current_option := 0; 413long_options[current_option].name := 'help'; 414long_options[current_option].has_arg := 0; 415long_options[current_option].flag := 0; 416long_options[current_option].val := 0; 417incr (current_option); 418 419@ Another of the standard options. 420@.-version@> 421 422@<Define the option...@> = 423long_options[current_option].name := 'version'; 424long_options[current_option].has_arg := 0; 425long_options[current_option].flag := 0; 426long_options[current_option].val := 0; 427incr (current_option); 428 429@ Print progress information? 430@.-verbose@> 431 432@<Define the option...@> = 433long_options[current_option].name := 'verbose'; 434long_options[current_option].has_arg := 0; 435long_options[current_option].flag := address_of (verbose); 436long_options[current_option].val := 1; 437incr (current_option); 438 439@ 440@<Glob...@> = 441@!verbose: c_int_type; 442 443@ 444@<Initialize the option...@> = 445verbose := false; 446 447@ This option changes how we output character codes. 448@.-charcode-format@> 449 450@<Define the option...@> = 451long_options[current_option].name := 'charcode-format'; 452long_options[current_option].has_arg := 1; 453long_options[current_option].flag := 0; 454long_options[current_option].val := 0; 455incr (current_option); 456 457@ We use an ``enumerated'' type to store the information. 458 459@<Type...@> = 460@!charcode_format_type = charcode_ascii..charcode_default; 461 462@ 463@<Const...@> = 464@!charcode_ascii = 0; 465@!charcode_hex = 1; 466@!charcode_default = 2; 467 468@ 469@<Global...@> = 470@!charcode_format: charcode_format_type; 471 472@ It starts off as the default, which is hex for OFM2OPL. 473 474@<Initialize the option...@> = 475charcode_format := charcode_default; 476 477@ An element with all zeros always ends the list. 478 479@<Define the option...@> = 480long_options[current_option].name := 0; 481long_options[current_option].has_arg := 0; 482long_options[current_option].flag := 0; 483long_options[current_option].val := 0; 484 485@ Global filenames. 486 487@<Global...@> = 488@!tfm_name, @!pl_name:const_c_string; 489@z 490