src/texsourc/tex0.c

   1 /* Copyright 2014 Clerk Ma
   2
   3    This program is free software; you can redistribute it and/or modify
   4    it under the terms of the GNU General Public License as published by
   5    the Free Software Foundation; either version 2 of the License, or
   6    (at your option) any later version.
   7
   8    This program is distributed in the hope that it will be useful, but
   9    WITHOUT ANY WARRANTY; without even the implied warranty of
  10    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11    General Public License for more details.
  12
  13    You should have received a copy of the GNU General Public License
  14    along with this program; if not, write to the Free Software
  15    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16    02110-1301 USA.  */
  17
  18 #define EXTERN extern
  19 #include "yandytex.h"
  20
  21 /* sec 0058 */
  22 void print_ln (void)
  23 {
  24   switch (selector)
  25   {
  26     case term_and_log:
  27       wterm_cr();
  28       term_offset = 0;
  29       wlog_cr();
  30       file_offset = 0;
  31       break;
  32
  33     case log_only:
  34       wlog_cr();
  35       file_offset = 0;
  36       break;
  37
  38     case term_only:
  39       wterm_cr();
  40       term_offset = 0;
  41       break;
  42
  43     case no_print:
  44     case pseudo:
  45     case new_string:
  46       do_nothing();
  47       break;
  48
  49     default:
  50       putc('\n', write_file[selector]);
  51       break;
  52   }
  53 }
  54 /* sec 0058 */
  55 void print_char_ (ASCII_code s)
  56 {
  57   if (s == new_line_char)
  58     if (selector < pseudo)
  59     {
  60       print_ln();
  61       return;
  62     }
  63
  64   switch (selector)
  65   {
  66     case term_and_log:
  67       wterm(xchr[s]);
  68       incr(term_offset);
  69       wlog(xchr[s]);
  70       incr(file_offset);
  71
  72       if (term_offset == max_print_line)
  73       {
  74         wterm_cr();
  75         term_offset = 0;
  76       }
  77
  78       if (file_offset == max_print_line)
  79       {
  80         wlog_cr();
  81         file_offset = 0;
  82       }
  83
  84       break;
  85
  86     case log_only:
  87       wlog(xchr[s]);
  88       incr(file_offset);
  89
  90       if (file_offset == max_print_line)
  91         print_ln();
  92
  93       break;
  94
  95     case term_only:
  96       wterm(xchr[s]);
  97       incr(term_offset);
  98
  99       if (term_offset == max_print_line)
 100         print_ln();
 101
 102       break;
 103
 104     case no_print:
 105       do_nothing();
 106       break;
 107
 108     case pseudo:
 109       if (tally < trick_count)
 110         trick_buf[tally % error_line] = s;
 111
 112       break;
 113
 114     case new_string:
 115 #ifdef ALLOCATESTRING
 116       if (pool_ptr + 1 > current_pool_size)
 117         str_pool = realloc_str_pool(increment_pool_size);
 118
 119       if (pool_ptr < current_pool_size)
 120         append_char(s);
 121 #else
 122       if (pool_ptr < pool_size)
 123         append_char(s);
 124 #endif
 125       break;
 126
 127     default:
 128       putc(xchr[s], write_file[selector]);
 129       break;
 130   }
 131
 132   incr(tally);
 133 }
 134 /* sec 0059 */
 135 void print_ (integer s)
 136 {
 137   pool_pointer j;
 138   integer nl;
 139
 140   if (s >= str_ptr)
 141     s = 259; /* ??? */
 142   else
 143   {
 144     if (s < 256)
 145     {
 146       if (s < 0)
 147         s = 259; /* ??? */
 148       else
 149       {
 150         if (selector > pseudo)
 151         {
 152           print_char(s);
 153           return;
 154         }
 155
 156         if (s == new_line_char)
 157           if (selector < pseudo)
 158           {
 159             print_ln();
 160             return;
 161           }
 162
 163         nl = new_line_char;
 164         new_line_char = -1;
 165
 166         /* translate ansi to dos 850 */
 167         if (!show_in_hex && s < 256 && s >= 32)
 168         {
 169           if (show_in_dos && s > 127)
 170           {
 171             if (wintodos[s - 128] > 0)
 172             {
 173               print_char(wintodos[s - 128]);
 174             }
 175             else
 176             {
 177               j = str_start[s];
 178
 179               while (j < str_start[s + 1])
 180               {
 181                 print_char(str_pool[j]);
 182                 incr(j);
 183               }
 184             }
 185           }
 186           else
 187           {
 188             print_char(s);       /* don't translate to hex */
 189           }
 190         }
 191         else
 192         {                       /* not just a character */
 193           j = str_start[s];
 194
 195           while (j < str_start[s + 1])
 196           {
 197             print_char(str_pool[j]);
 198             incr(j);
 199           }
 200         }
 201
 202         new_line_char = nl; /* restore eol */
 203         return;
 204       }
 205     }
 206   }
 207 /*  we get here with s > 256 - i.e. not a single character */
 208   j = str_start[s];
 209
 210   while (j < str_start[s + 1])
 211   {
 212     print_char(str_pool[j]);
 213     incr(j);
 214   }
 215 }
 216 /* string version print. */
 217 void prints_ (const char * s)
 218 {
 219   while (*s)
 220     print_char(*s++);
 221 }
 222 /* sec 0060 */
 223 void slow_print_ (integer s)
 224 {
 225   pool_pointer j;
 226
 227   if ((s >= str_ptr) || (s < 256))
 228     print(s);
 229   else
 230   {
 231     j = str_start[s];
 232
 233     while (j < str_start[s + 1])
 234     {
 235       print(str_pool[j]);
 236       incr(j);
 237     }
 238   }
 239 }
 240 /* sec 0062 */
 241 void print_nl (const char * s)
 242 {
 243   if (((term_offset > 0) && (odd(selector))) ||
 244       ((file_offset > 0) && (selector >= log_only)))
 245     print_ln();
 246
 247   prints(s);
 248 }
 249 /* sec 0063 */
 250 void print_esc (const char * s)
 251 {
 252   integer c;
 253
 254   c = escape_char;
 255
 256   if (c >= 0)
 257     if (c < 256)
 258       print(c);
 259
 260   prints(s);
 261 }
 262 /* sec 0064 */
 263 void print_the_digs (eight_bits k)
 264 {
 265   while (k > 0)
 266   {
 267     decr(k);
 268
 269     if (dig[k] < 10)
 270       print_char('0' + dig[k]);
 271     else
 272       print_char('A' + dig[k]);
 273   }
 274 }
 275 /* sec 0065 */
 276 void print_int_ (integer n)
 277 {
 278   char k;
 279   integer m;
 280
 281   k = 0;
 282
 283   if (n < 0)
 284   {
 285     print_char('-');
 286
 287     if (n > -100000000L)
 288       n = - (integer) n;
 289     else
 290     {
 291       m = -1 - n;
 292       n = m / 10;
 293       m = (m % 10) + 1;
 294       k = 1;
 295
 296       if (m < 10)
 297         dig[0] = (char) m;
 298       else
 299       {
 300         dig[0] = 0;
 301         incr(n);
 302       }
 303     }
 304   }
 305
 306   do
 307     {
 308       dig[k] = (char) (n % 10);
 309       n = n / 10;
 310       incr(k);
 311     }
 312   while (!(n == 0));
 313
 314   print_the_digs(k);
 315 }
 316 /* sec 0262 */
 317 void print_cs_ (integer p)
 318 {
 319   if (p < hash_base)
 320     if (p >= single_base)
 321       if (p == null_cs)
 322       {
 323         print_esc("csname");
 324         print_esc("endcsname");
 325         print_char(' ');
 326       }
 327       else
 328       {
 329         print_esc(""); print(p - single_base);
 330
 331         if (cat_code(p - single_base) == letter)
 332           print_char(' ');
 333       }
 334     else if (p < active_base)
 335       print_esc("IMPOSSIBLE.");
 336     else
 337       print(p - active_base);
 338   else if (p >= undefined_control_sequence)
 339     print_esc("IMPOSSIBLE.");
 340   else if ((text(p) >= str_ptr))
 341     print_esc("NONEXISTENT.");
 342   else
 343   {
 344     print_esc("");
 345     print(text(p));
 346     print_char(' ');
 347   }
 348 }
 349 /* sec 0263 */
 350 void sprint_cs (pointer p)
 351 {
 352   if (p < hash_base)
 353     if (p < single_base)
 354       print(p - active_base);
 355     else if (p < null_cs)
 356     {
 357       print_esc("");
 358       print(p - single_base);
 359     }
 360     else
 361     {
 362       print_esc("csname");
 363       print_esc("endcsname");
 364     }
 365   else
 366   {
 367     print_esc(""); print(text(p));
 368   }
 369 }
 370 /* sec 0518 */
 371 void print_file_name (integer n, integer a, integer e)
 372 {
 373   slow_print(a);
 374   slow_print(n);
 375   slow_print(e);
 376 }
 377 /* sec 0699 */
 378 void print_size_ (integer s)
 379 {
 380   if (s == 0)
 381     print_esc("textfont");
 382   else if (s == 16)
 383     print_esc("scriptfont");
 384   else
 385     print_esc("scriptscriptfont");
 386 }
 387 /* sec 1355 */
 388 void print_write_whatsit_(const char * s, pointer p)
 389 {
 390   print_esc(s);
 391
 392   if (write_stream(p) < 16)
 393     print_int(write_stream(p));
 394   else if (write_stream(p) == 16)
 395     print_char('*');
 396   else
 397     print_char('-');
 398 }
 399 /* sec 0081 */
 400 void jump_out (void)
 401 {
 402   close_files_and_terminate();
 403
 404   {
 405     int code;
 406
 407     fflush(stdout);
 408     ready_already = 0;
 409
 410     if (trace_flag)
 411       puts("EXITING at JUMPOUT");
 412
 413     if ((history != 0) && (history != 1))
 414       code = 1;
 415     else
 416       code = 0;
 417
 418     uexit(code);
 419   }
 420 }
 421 /* sec 0082 */
 422 void error (void)
 423 {
 424   ASCII_code c;
 425   integer s1, s2, s3, s4;
 426
 427   if (history < error_message_issued)
 428     history = error_message_issued;
 429
 430   print_char('.');
 431   show_context();
 432
 433   if (interaction == error_stop_mode)
 434     while (true)
 435     {
 436 continu:
 437       clear_for_error_prompt();
 438       prompt_input("? ");
 439
 440       if (last == first)
 441         return; // no input
 442
 443       c = buffer[first];
 444
 445       if (c >= 'a')
 446         c = (c + 'A' - 'a');
 447
 448       switch (c)
 449       {
 450         case '0':
 451         case '1':
 452         case '2':
 453         case '3':
 454         case '4':
 455         case '5':
 456         case '6':
 457         case '7':
 458         case '8':
 459         case '9':
 460           if (deletions_allowed)
 461           {
 462             s1 = cur_tok;
 463             s2 = cur_cmd;
 464             s3 = cur_chr;
 465             s4 = align_state;
 466             align_state = 1000000L;
 467             OK_to_interrupt = false;
 468
 469             if ((last > first + 1) && (buffer[first + 1] >= '0') && (buffer[first + 1] <= '9'))
 470               c = (c * 10 + buffer[first + 1] - '0' * 11);
 471             else
 472               c = (c - 48);
 473
 474             while (c > 0)
 475             {
 476               get_token();
 477               decr(c);
 478             }
 479
 480             cur_tok = s1;
 481             cur_cmd = s2;
 482             cur_chr = s3;
 483             align_state = s4;
 484             OK_to_interrupt = true;
 485             help2("I have just deleted some text, as you asked.",
 486                 "You can now delete more, or insert, or whatever.");
 487             show_context();
 488             goto continu;
 489           }
 490           break;
 491
 492 #ifdef DEBUG
 493         case 'D':
 494           {
 495             debug_help();
 496             goto continu;
 497           }
 498           break;
 499 #endif
 500
 501         case 'E':
 502           if (base_ptr > 0)
 503           {
 504             edit_name_start = str_start[input_stack[base_ptr].name_field];
 505             edit_name_length = length(input_stack[base_ptr].name_field);
 506             edit_line = line;
 507             jump_out();
 508           }
 509           break;
 510
 511         case 'H':
 512           {
 513             if (use_err_help)
 514             {
 515               give_err_help();
 516               use_err_help = false;
 517             }
 518             else
 519             {
 520               if (help_ptr == 0)
 521                 help2("Sorry, I don't know how to help in this situation.",
 522                     "Maybe you should try asking a human?");
 523               do
 524                 {
 525                   decr(help_ptr);
 526                   prints(help_line[help_ptr]);
 527                   print_ln();
 528                 }
 529               while (!(help_ptr == 0));
 530             }
 531
 532             help4("Sorry, I already gave what help I could...",
 533                 "Maybe you should try asking a human?",
 534                 "An error might have occurred before I noticed any problems.",
 535                 "``If all else fails, read the instructions.''");
 536             goto continu;
 537           }
 538           break;
 539
 540         case 'I':
 541           {
 542             begin_file_reading();
 543
 544             if (last > first + 1)
 545             {
 546               loc = first + 1;
 547               buffer[first] = 32;
 548             }
 549             else
 550             {
 551               prompt_input("insert>");
 552               loc = first;
 553             }
 554
 555             first = last;
 556             limit = last - 1;
 557
 558             return;
 559           }
 560           break;
 561
 562         case 'Q':
 563         case 'R':
 564         case 'S':
 565           {
 566             error_count = 0;
 567             interaction = 0 + c - 'Q';
 568             prints("OK, entering ");
 569
 570             switch (c)
 571             {
 572               case 'Q':
 573                 print_esc("batchmode");
 574                 decr(selector);
 575                 break;
 576
 577               case 'R':
 578                 print_esc("nonstopmode");
 579                 break;
 580
 581               case 'S':
 582                 print_esc("scrollmode");
 583                 break;
 584             }
 585
 586             prints("...");
 587             print_ln();
 588             update_terminal();
 589             return;
 590           }
 591           break;
 592
 593         case 'X':
 594           {
 595             interaction = scroll_mode;
 596             jump_out();
 597           }
 598           break;
 599
 600         default:
 601           break;
 602       }
 603
 604       {
 605         prints("Type <return> to proceed, S to scroll future error messages,");
 606         print_nl("R to run without stopping, Q to run quietly,");
 607         print_nl("I to insert something, ");
 608
 609         if (base_ptr > 0)
 610           prints("E to edit your file,");
 611
 612         if (deletions_allowed)
 613           print_nl("1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
 614
 615         print_nl("H for help, X to quit.");
 616       }
 617     }
 618
 619   incr(error_count);
 620
 621   if (error_count == 100)
 622   {
 623     print_nl("(That makes 100 errors; please try again.)");
 624     history = fatal_error_stop;
 625     jump_out();
 626   }
 627
 628   if (interaction > batch_mode)
 629     decr(selector);
 630
 631   if (use_err_help)
 632   {
 633     print_ln();
 634     give_err_help();
 635   }
 636   else while (help_ptr > 0)
 637   {
 638     decr(help_ptr);
 639     print_nl(help_line[help_ptr] == NULL ? "" : help_line[help_ptr]);
 640   }
 641
 642   print_ln();
 643
 644   if (interaction > batch_mode)
 645     incr(selector);
 646
 647   print_ln();
 648 }
 649 /* sec 0093 */
 650 void fatal_error (const char * s)
 651 {
 652   normalize_selector();
 653   print_err("Emergency stop");
 654   help1(s);
 655   succumb();
 656 }
 657 /* sec 0094 */
 658 void overflow_(const char * s, integer n)
 659 {
 660   normalize_selector();
 661   print_err("TeX capacity exceeded, sorry [");
 662   prints(s);
 663   print_char('=');
 664   print_int(n);
 665   print_char(']');
 666   help2("If you really absolutely need more capacity,",
 667       "you can ask a wizard to enlarge me.");
 668
 669   if (!knuth_flag)
 670   {
 671     if (!strcmp(s, "pattern memory") && (n == trie_size))
 672       printf("\n  (Maybe use -h=... on command line in initex)\n");
 673     else if (!strcmp(s, "exception dictionary") && (n == hyphen_prime))
 674       printf("\n  (Maybe use -e=... on command line in initex)\n");
 675   }
 676
 677   succumb();
 678 }
 679 /* sec 0095 */
 680 void confusion (const char * s)
 681 {
 682   normalize_selector();
 683
 684   if (history < error_message_issued)
 685   {
 686     print_err("This can't happen (");
 687     prints(s);
 688     print_char(')');
 689     help1("I'm broken. Please show this to someone who can fix can fix");
 690   }
 691   else
 692   {
 693     print_err("I can't go on meeting you like this");
 694     help2("One of your faux pas seems to have wounded me deeply...",
 695         "in fact, I'm barely conscious. Please fix it and try again.");
 696   }
 697
 698   succumb();
 699 }
 700 /* sec 0037 */
 701 boolean init_terminal (void)
 702 {
 703   boolean flag;
 704
 705   t_open_in();
 706
 707   if (last > first)
 708   {
 709     loc = first;
 710
 711     while ((loc < last) && (buffer[loc]== ' '))
 712       incr(loc);
 713
 714     if (loc < last)
 715       return true;
 716   }
 717
 718 // failed to find input file name
 719   while (true)
 720   {
 721     fputs("**", stdout);
 722     update_terminal();
 723     flag = input_ln(stdin, true);
 724
 725     if (!flag)
 726     {
 727       wterm_cr();
 728       puts("! End of file on the terminal... why?\n");
 729       return false;
 730     }
 731
 732     loc = first;
 733
 734     while ((loc < last) && (buffer[loc]== ' '))
 735       incr(loc);    // step over intial white space
 736
 737     if (loc < last)
 738       return true;
 739
 740     printf("%s\n", "Please type the name of your input file.");
 741   }
 742 }
 743 /* sec 0043 */
 744 str_number make_string (void)
 745 {
 746 #ifdef ALLOCATESTRING
 747   if (str_ptr == current_max_strings)
 748     str_start = realloc_str_start(increment_max_strings);
 749
 750   if (str_ptr == current_max_strings)
 751   {
 752     overflow("number of strings", current_max_strings - init_str_ptr);
 753     return 0;
 754   }
 755 #else
 756   if (str_ptr == max_strings)
 757   {
 758     overflow("number of strings", max_strings - init_str_ptr);
 759     return 0;
 760   }
 761 #endif
 762
 763   incr(str_ptr);
 764   str_start[str_ptr] = pool_ptr;
 765
 766   return (str_ptr - 1);
 767 }
 768 /* sec 0044 */
 769 boolean str_eq_buf_ (str_number s, integer k)
 770 {
 771   pool_pointer j;
 772   boolean result;
 773
 774   j = str_start[s];
 775
 776   while (j < str_start[s + 1])
 777   {
 778     if (str_pool[j] != buffer[k])
 779     {
 780       result = false;
 781       goto not_found;
 782     }
 783
 784     incr(j);
 785     incr(k);
 786   }
 787
 788   result = true;
 789
 790 not_found:
 791   return result;
 792 }
 793 /* sec 0045 */
 794 boolean str_eq_str_ (str_number s, str_number t)
 795 {
 796   pool_pointer j, k;
 797   boolean result;
 798
 799   result = false;
 800
 801   if (length(s) != length(t))
 802     goto not_found;
 803
 804   j = str_start[s];
 805   k = str_start[t];
 806
 807   while (j < str_start[s + 1])
 808   {
 809     if (str_pool[j] != str_pool[k])
 810       goto not_found;
 811
 812     incr(j);
 813     incr(k);
 814   }
 815
 816   result = true;
 817
 818 not_found:
 819   return result;
 820 }
 821 /* sec 0066 */
 822 void print_two_(integer n)
 823 {
 824   n = abs(n) % 100;
 825   print_char('0' + (n / 10));
 826   print_char('0' + (n % 10));
 827 }
 828 /* sec 0067 */
 829 void print_hex_(integer n)
 830 {
 831   char k;
 832
 833   k = 0;
 834   print_char('"');
 835
 836   do
 837     {
 838       dig[k] = (unsigned char) (n % 16);
 839       n = n / 16;
 840       incr(k);
 841     }
 842   while (!(n == 0));
 843
 844   print_the_digs(k);
 845 }
 846 /* sec 0069 */
 847 void print_roman_int_(integer n)
 848 {
 849   pool_pointer j, k;
 850   nonnegative_integer u, v;
 851
 852   j = str_start[260]; /* m2d5c2l5x2v5i */
 853   v = 1000;
 854
 855   while (true)
 856   {
 857     while (n >= v)
 858     {
 859       print_char(str_pool[j]);
 860       n = n - v;
 861     }
 862
 863     if (n <= 0)
 864       return;
 865
 866     k = j + 2;
 867     u = v / (str_pool[k - 1] - '0');
 868
 869     if (str_pool[k - 1] == 50)
 870     {
 871       k = k + 2;
 872       u = u / (str_pool[k - 1] - '0');
 873     }
 874
 875     if (n + u >= v)
 876     {
 877       print_char(str_pool[k]);
 878       n = n + u;
 879     }
 880     else
 881     {
 882       j = j + 2;
 883       v = v / (str_pool[j - 1] - '0');
 884     }
 885   }
 886 }
 887 /* sec 0070 */
 888 void print_current_string (void)
 889 {
 890   pool_pointer j;
 891
 892   j = str_start[str_ptr];
 893
 894   while (j < pool_ptr)
 895   {
 896     print_char(str_pool[j]);
 897     incr(j);
 898   }
 899 }
 900
 901 /* sec 0071 */
 902 void term_input (void)
 903 {
 904   integer k;
 905   boolean flag;
 906
 907   if (!knuth_flag)
 908     show_line("\n", 0);
 909
 910   update_terminal();
 911   flag = input_ln(stdin, true);
 912
 913   if (!flag)
 914   {
 915     fatal_error("End of file on the terminal!");
 916     return;
 917   }
 918
 919   term_offset = 0;
 920   decr(selector);
 921
 922   if (last != first)
 923     for (k = first; k <= last - 1; k++)
 924       print(buffer[k]);
 925
 926   print_ln();
 927   incr(selector);
 928 }
 929 /* sec 0091 */
 930 void int_error_ (integer n)
 931 {
 932   prints(" (");
 933   print_int(n);
 934   print_char(')');
 935   error();
 936 }
 937 /* sec 0092 */
 938 void normalize_selector (void)
 939 {
 940   if (log_opened)
 941     selector = term_and_log;
 942   else
 943     selector = term_only;
 944
 945   if (job_name == 0)
 946     open_log_file();
 947
 948   if (interaction == batch_mode)
 949     decr(selector);
 950 }
 951 /* sec 0098 */
 952 void pause_for_instructions (void)
 953 {
 954   if (OK_to_interrupt)
 955   {
 956     interaction = error_stop_mode;
 957
 958     if ((selector == log_only) || (selector == no_print))
 959       incr(selector);
 960
 961     print_err("Interruption");
 962     help3("You rang?",
 963         "Try to insert some instructions for me (e.g.,`I\\showlists'),",
 964         "unless you just want to quit by typing `X'.");
 965     deletions_allowed = false;
 966     error();
 967     deletions_allowed = true;
 968     interrupt = 0;
 969   }
 970 }
 971 /* sec 0100 */
 972 integer half_(integer x)
 973 {
 974   if (odd(x))
 975     return ((x + 1) / 2);
 976   else
 977     return (x / 2);
 978 }
 979 /* sec 0102 */
 980 scaled round_decimals_(small_number k)
 981 {
 982   integer a;
 983
 984   a = 0;
 985
 986   while (k > 0)
 987   {
 988     decr(k);
 989     a = (a + dig[k] * 131072L) / 10; /* 2^17 */
 990   }
 991
 992   return ((a + 1) / 2);
 993 }
 994 /* sec 0103 */
 995 void print_scaled_(scaled s)
 996 {
 997   scaled delta;
 998
 999   if (s < 0)
1000   {
1001     print_char('-');
1002     s = - (integer) s;
1003   }
1004
1005   print_int(s / 65536L);
1006   print_char('.');
1007   s = 10 * (s % 65536L) + 5;
1008   delta = 10;
1009
1010   do
1011     {
1012       if (delta > 65536L)
1013         s = s - 17232; /* 2^15 - 50000 - rounding */
1014
1015       print_char('0' + (s / 65536L));
1016       s = 10 * (s % 65536L);
1017       delta = delta * 10;
1018     }
1019   while (!(s <= delta));
1020 }
1021 /* sec 0105 */
1022 scaled mult_and_add_(integer n, scaled x, scaled y, scaled max_answer)
1023 {
1024   if (n < 0)
1025   {
1026     x = - (integer) x;
1027     n = - (integer) n;
1028   }
1029
1030   if (n == 0)
1031     return y;
1032   else if (((x <= (max_answer - y) / n) && (- (integer) x <= (max_answer + y) / n)))
1033     return (n * x + y);
1034   else
1035   {
1036     arith_error = true;
1037     return 0;
1038   }
1039 }
1040 /* sec 0106 */
1041 scaled x_over_n_(scaled x, integer n)
1042 {
1043   register scaled Result;
1044   boolean negative;
1045
1046   negative = false;
1047
1048   if (n == 0)
1049   {
1050     arith_error = true;
1051     Result = 0;
1052     tex_remainder = x;
1053   }
1054   else
1055   {
1056     if (n < 0)
1057     {
1058       x = - (integer) x;
1059       n = - (integer) n;
1060       negative = true;
1061     }
1062
1063     if (x >= 0)
1064     {
1065       Result = x / n;
1066       tex_remainder = x % n;
1067     }
1068     else
1069     {
1070       Result = - (integer) ((- (integer) x)/ n);
1071       tex_remainder = - (integer) ((- (integer) x)% n);
1072     }
1073   }
1074
1075   if (negative)
1076     tex_remainder = - (integer) tex_remainder;
1077
1078   return Result;
1079 }
1080 /* sec 0107 */
1081 scaled xn_over_d_(scaled x, integer n, integer d)
1082 {
1083   register scaled Result;
1084   boolean positive;
1085   nonnegative_integer t, u, v;
1086
1087   if (x >= 0)
1088     positive = true;
1089   else
1090   {
1091     x = - (integer) x;
1092     positive = false;
1093   }
1094
1095   t = (x % 32767L) * n;
1096   u = (x / 32768L) * n + (t / 32768L);
1097   v = (u % d) * 32768L + (t % 32768L);
1098
1099   if (u / d >= 32768L)
1100     arith_error = true;
1101   else
1102     u = 32768L * (u / d) + (v / d);
1103
1104   if (positive)
1105   {
1106     Result = u;
1107     tex_remainder = v % d;
1108   }
1109   else
1110   {
1111     Result = - (integer) u;
1112     tex_remainder = - (integer)(v % d);
1113   }
1114
1115   return Result;
1116 }
1117 /* sec 0108 */
1118 halfword badness_(scaled t, scaled s)
1119 {
1120   integer r;
1121
1122   if (t == 0)
1123     return 0;
1124   else if (s <= 0)
1125     return 10000;
1126   else
1127   {
1128     if (t <= 7230584L)
1129       r = (t * 297) / s;
1130     else if (s >= 1663497L)
1131       r = t / (s / 297);
1132     else
1133       r = t;
1134
1135     if (r > 1290)
1136       return 10000;
1137     else
1138       return (r * r * r + 131072L) / 262144L;  /* 2^17 */
1139   }
1140 }
1141 /* sec 0114 */
1142 #ifdef DEBUG
1143 void print_word (memory_word w)
1144 {
1145   print_int(w.cint);
1146   print_char(' ');
1147   print_scaled(w.cint);
1148   print_char(' ');
1149   print_scaled(round(unity * w.gr));
1150   print_ln();
1151   print_int(w.hh.lh);
1152   print_char('=');
1153   print_int(w.hh.b0);
1154   print_char(':');
1155   print_int(w.hh.b1);
1156   print_char(';');
1157   print_int(w.hh.rh);
1158   print_char(' ');
1159   print_int(w.qqqq.b0);
1160   print_char(':');
1161   print_int(w.qqqq.b1);
1162   print_char(':');
1163   print_int(w.qqqq.b2);
1164   print_char(':');
1165   print_int(w.qqqq.b3);
1166 }
1167 #endif
1168 /* sec 0292 */
1169 void show_token_list_(integer p, integer q, integer l)
1170 {
1171   integer m, c;
1172   ASCII_code match_chr;
1173   ASCII_code n;
1174
1175   match_chr = '#';
1176   n = '0';
1177   tally = 0;
1178
1179   while ((p != 0) && (tally < l))
1180   {
1181     if (p == q)
1182     {
1183       first_count = tally;
1184       trick_count = tally + 1 + error_line - half_error_line;
1185
1186       if (trick_count < error_line)
1187         trick_count = error_line;
1188     }
1189
1190     if ((p < hi_mem_min) || (p > mem_end))
1191     {
1192       print_esc("CLOBBERED.");
1193       return;
1194     }
1195
1196     if (info(p) >= cs_token_flag)
1197       print_cs(info(p) - cs_token_flag);
1198     else
1199     {
1200       m = info(p) / 256;
1201       c = info(p) % 256;
1202
1203       if (info(p) < 0)
1204         print_esc("BAD.");
1205       else switch (m)
1206       {
1207         case left_brace:
1208         case right_brace:
1209         case math_shift:
1210         case tab_mark:
1211         case sup_mark:
1212         case sub_mark:
1213         case spacer:
1214         case letter:
1215         case other_char:
1216           print(c);
1217           break;
1218
1219         case mac_param:
1220           print(c);
1221           print(c);
1222           break;
1223
1224         case out_param:
1225           print(match_chr);
1226
1227           if (c <= 9)
1228             print_char(c + '0');
1229           else
1230           {
1231             print_char('!');
1232             return;
1233           }
1234           break;
1235
1236         case match:
1237           match_chr = (ASCII_code) c;
1238           print(c);
1239           incr(n);
1240           print_char(n);
1241
1242           if (n > '9')
1243             return;
1244           break;
1245
1246         case end_match:
1247           prints("->");
1248           break;
1249
1250         default:
1251           print_esc("BAD.");
1252           break;
1253       }
1254     }
1255     p = link(p);
1256   }
1257
1258   if (p != 0)
1259     print_esc("ETC.");
1260 }
1261 /* sec 0306 */
1262 void runaway (void)
1263 {
1264   pointer p;
1265
1266   if (scanner_status > 1)
1267   {
1268     print_nl("Runaway ");
1269
1270     switch (scanner_status)
1271     {
1272       case defining:
1273         prints("definition");
1274         p = def_ref;
1275         break;
1276
1277       case matching:
1278         prints("argument");
1279         p = temp_head;
1280         break;
1281
1282       case aligning:
1283         prints("preamble");
1284         p = hold_head;
1285         break;
1286
1287       case absorbing:
1288         prints("text");
1289         p = def_ref;
1290         break;
1291     }
1292
1293     print_char('?');
1294     print_ln();
1295     show_token_list(link(p), 0, error_line - 10);
1296   }
1297 }
1298 /* sec 0120 */
1299 /* *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** */
1300 /* first try list of available nodes (avail != NULL)                   */
1301 /* then see if can go upwards (mem_end < mem_max)                      */
1302 /* then see if can go downwards (hi_mem_min > lo_mem_max)              */
1303 /* if not, extend memory at the top and grab from there --- new        */
1304 /* else fail ! paragraph 120                                           */
1305 /* *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** */
1306 pointer get_avail (void)
1307 {
1308   pointer p;
1309
1310   p = avail;
1311
1312   if (p != 0)
1313     avail = link(avail);
1314   else if (mem_end < mem_max)
1315   {
1316     incr(mem_end);
1317     p = mem_end;
1318   }
1319   else
1320   {
1321     decr(hi_mem_min);
1322     p = hi_mem_min;
1323
1324     if (hi_mem_min <= lo_mem_max) /* have we run out in middle ? */
1325     {
1326       incr(hi_mem_min);
1327       mem = realloc_main (0, mem_top / 2);  /* zzzaa = zmem = mem */
1328
1329       if (mem == NULL)
1330         return 0;
1331
1332       if (mem_end >= mem_max)
1333       {
1334         runaway();
1335         overflow("main memory size", mem_max + 1 - mem_min);
1336         return 0;
1337       }
1338
1339       incr(mem_end);        /* then grab from new area */
1340       p = mem_end;          /* 1993/Dec/14 */
1341     }
1342   }
1343
1344   link(p) = 0;       /* link(p) = null !!! */
1345
1346 #ifdef STAT
1347   incr(dyn_used);
1348 #endif
1349
1350   return p;
1351 }
1352 /* sec 0123 */
1353 void flush_list_(pointer p)
1354 {
1355   pointer q, r;
1356
1357   if (p != 0)
1358   {
1359     r = p;
1360
1361     do
1362       {
1363         q = r;
1364         r = link(r);
1365 #ifdef STAT
1366         decr(dyn_used);
1367 #endif
1368       }
1369     while (!(r == 0));
1370
1371     link(q) = avail;
1372     avail = p;
1373   }
1374 }
1375 /* sec 0125 */
1376 pointer get_node_(integer s)
1377 {
1378   pointer p;
1379   pointer q;
1380   integer r;
1381   integer t;
1382
1383 restart:
1384   p = rover;
1385
1386   do
1387     {
1388       q = p + node_size(p);
1389
1390       while (is_empty(q))
1391       {
1392         t = rlink(q);
1393
1394         if (q == rover)
1395           rover = t;
1396
1397         llink(t) = llink(q);
1398         rlink(llink(q)) = t;
1399         q = q + node_size(q);
1400       }
1401
1402       r = q - s;
1403
1404       if (r > toint(p + 1))
1405       {
1406         node_size(p) = r - p;
1407         rover = p;
1408         goto found;
1409       }
1410
1411       if (r == p)
1412         if (rlink(p) != p)
1413         {
1414           rover = rlink(p);
1415           t = llink(p);
1416           llink(rover) = t;
1417           rlink(t) = rover;
1418           goto found;
1419         }
1420
1421       node_size(p) = q - p;
1422       p = rlink(p);
1423     }
1424   while (!(p == rover));
1425
1426   if (s == 1073741824L)    /* 2^30 - special case - merge adjacent */
1427   {
1428     if (trace_flag)
1429       puts("Merged adjacent multi-word nodes");
1430
1431     return max_halfword;
1432   }
1433
1434 /*  maybe try downward epxansion first instead ? */
1435   if (lo_mem_max + 2 < hi_mem_min)
1436     if (lo_mem_max + 2 <= mem_bot + max_halfword)  /* silly ? flush 93/Dec/16 */
1437     {
1438       if (hi_mem_min - lo_mem_max >= (block_size + block_size - 2))
1439         t = lo_mem_max + block_size;
1440       else
1441         t = lo_mem_max + 1 + (hi_mem_min - lo_mem_max) / 2;
1442
1443       p = llink(rover);
1444       q = lo_mem_max;
1445       rlink(p) = q;
1446       llink(rover) = q;
1447
1448       if (t > mem_bot + max_halfword)
1449         t = mem_bot + max_halfword;     /* silly ? flush 93/Dec/16 */
1450
1451       rlink(q) = rover;
1452       llink(q) = p;
1453       link(q) = empty_flag;
1454       node_size(q) = t - lo_mem_max; /* block size */
1455       lo_mem_max = t;
1456       link(lo_mem_max) = 0;
1457       info(lo_mem_max) = 0;
1458       rover = q;
1459       goto restart;
1460     }
1461
1462 /* *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** */
1463 /* we've run out of space in the middle for variable length blocks */
1464 /* try and add new block from below mem_bot *//* first check if space ! */
1465   if (mem_min - (block_size + 1) <= mem_start) /* extend lower memory downwards */
1466   {
1467     mem = realloc_main (mem_top / 2 + block_size, 0);  /* zzzaa = zmem = mem */
1468
1469     if (mem == NULL)
1470     {
1471       return 0;
1472     }
1473   }
1474
1475   if (mem_min - (block_size + 1) <= mem_start) /* check again */
1476   {
1477     if (trace_flag)
1478       printf("mem_min %lld, mem_start %d, block_size %d\n", mem_min, mem_start, block_size);
1479
1480     overflow("main memory size", mem_max + 1 - mem_min); /* darn: allocation failed ! */
1481     return 0;
1482   }
1483
1484   add_variable_space(block_size);
1485   goto restart; /* go try get_node again */
1486
1487 found:
1488   link(r) = 0;
1489
1490 #ifdef STAT
1491   var_used = var_used + s;
1492 #endif
1493
1494   return r;
1495 }
1496 /* sec 0130 */
1497 void free_node_(pointer p, halfword s)
1498 {
1499   pointer q;
1500
1501   node_size(p) = s;
1502   link(p) = empty_flag;
1503   q = llink(rover);
1504   llink(p) = q;
1505   rlink(p) = rover;
1506   llink(rover) = p;
1507   rlink(q) = p;
1508
1509 #ifdef STAT
1510   var_used = var_used - s;
1511 #endif
1512 }
1513 /* sec 0136 */
1514 pointer new_null_box (void)
1515 {
1516   pointer p;
1517
1518   p = get_node(box_node_size);
1519   type(p) = hlist_node;
1520   subtype(p) = min_quarterword;
1521   width(p) = 0;
1522   depth(p) = 0;
1523   height(p) = 0;
1524   shift_amount(p) = 0;
1525   list_ptr(p) = 0;
1526   glue_sign(p) = normal;
1527   glue_order(p) = normal;
1528   glue_set(p) = 0.0;
1529
1530   return p;
1531 }
1532 /* sec 0139 */
1533 pointer new_rule (void)
1534 {
1535   pointer p;
1536
1537   p = get_node(rule_node_size);
1538   type(p) = rule_node;
1539   subtype(p) = 0;
1540   width(p) = null_flag;
1541   depth(p) = null_flag;
1542   height(p) = null_flag;
1543
1544   return p;
1545 }
1546 /* sec 0144 */
1547 pointer new_ligature_(quarterword f, quarterword c, pointer q)
1548 {
1549   pointer p;
1550
1551   p = get_node(small_node_size);
1552   type(p) = ligature_node;
1553   font(lig_char(p)) = f;
1554   character(lig_char(p)) = c;
1555   lig_ptr(p) = q;
1556   subtype(p) = 0;
1557
1558   return p;
1559 }
1560 /* sec 0144 */
1561 pointer new_lig_item_(quarterword c)
1562 {
1563   pointer p;
1564
1565   p = get_node(small_node_size);
1566   character(p) = c;
1567   lig_ptr(p) = 0;
1568
1569   return p;
1570 }
1571 /* sec 0145 */
1572 pointer new_disc (void)
1573 {
1574   pointer p;
1575
1576   p = get_node(small_node_size);
1577   type(p) = disc_node;
1578   replace_count(p) = 0;
1579   pre_break(p) = 0;
1580   post_break(p) = 0;
1581
1582   return p;
1583 }
1584 /* sec 0147 */
1585 pointer new_math (scaled w, small_number s)
1586 {
1587   pointer p;
1588
1589   p = get_node(small_node_size);
1590   type(p) = math_node;
1591   subtype(p) = s;
1592   width(p) = w;
1593
1594   return p;
1595 }
1596 /* sec 0151 */
1597 pointer new_spec_(pointer p)
1598 {
1599   pointer q;
1600
1601   q = get_node(glue_spec_size);
1602   mem[q] = mem[p];
1603   glue_ref_count(q) = 0;
1604   width(q) = width(p);
1605   stretch(q) = stretch(p);
1606   shrink(q) = shrink(p);
1607
1608   return q;
1609 }
1610 /* se 0152 */
1611 pointer new_param_glue (small_number n)
1612 {
1613   pointer p;
1614   pointer q;
1615
1616   p = get_node(small_node_size);
1617   type(p) = glue_node;
1618   subtype(p) = n + 1;
1619   leader_ptr(p) = 0;
1620   q = glue_par(n);
1621   glue_ptr(p) = q;
1622   incr(glue_ref_count(q));
1623
1624   return p;
1625 }
1626 /* sec 0153 */
1627 pointer new_glue (pointer q)
1628 {
1629   pointer p;
1630
1631   p = get_node(small_node_size);
1632   type(p) = glue_node;
1633   subtype(p) = normal;
1634   leader_ptr(p) = 0;
1635   glue_ptr(p) = q;
1636   incr(glue_ref_count(q));
1637
1638   return p;
1639 }
1640 /* sec 0154 */
1641 pointer new_skip_param (small_number n)
1642 {
1643   pointer p;
1644
1645   temp_ptr = new_spec(glue_par(n));
1646   p = new_glue(temp_ptr);
1647   glue_ref_count(temp_ptr) = 0;
1648   subtype(p) = n + 1;
1649
1650   return p;
1651 }
1652 /* sec 0155 */
1653 pointer new_kern(scaled w)
1654 {
1655   pointer p;
1656
1657   p = get_node(small_node_size);
1658   type(p) = kern_node;
1659   subtype(p) = normal;
1660   width(p) = w;
1661
1662   return p;
1663 }
1664 /* sec 0158 */
1665 pointer new_penalty(integer m)
1666 {
1667   pointer p;
1668
1669   p = get_node(small_node_size);
1670   type(p) = penalty_node;
1671   subtype(p) = 0;
1672   penalty(p) = m;
1673
1674   return p;
1675 }
1676
1677 #ifdef DEBUG
1678 /* sec 0167 */
1679 void check_mem (boolean print_locs)
1680 {
1681   pointer p, q;
1682   boolean clobbered;
1683
1684   for (p = mem_min; p <= lo_mem_max; p++)
1685     freearr[p] = false;
1686
1687   for (p = hi_mem_min; p <= mem_end; p++)
1688     freearr[p] = false;
1689
1690   p = avail;
1691   q = 0;
1692   clobbered = false;
1693
1694   while (p != 0)
1695   {
1696     if ((p > mem_end) || (p < hi_mem_min))
1697       clobbered = true;
1698     else if (freearr[p])
1699       clobbered = true;
1700
1701     if (clobbered)
1702     {
1703       print_nl("AVAIL list clobbered at ");
1704       print_int(q);
1705       goto done1;
1706     }
1707
1708     freearr[p] = true;
1709     q = p;
1710     p = link(q);
1711   }
1712
1713 done1:
1714   p = rover;
1715   q = 0;
1716   clobbered = false;
1717
1718   do
1719     {
1720       if ((p >= lo_mem_max) || (p < mem_min))
1721         clobbered = true;
1722       else if ((rlink(p) >= lo_mem_max) || (rlink(p) < mem_min))
1723         clobbered = true;
1724       else if (!(is_empty(p)) || (node_size(p) < 2) ||
1725           (p + node_size(p) > lo_mem_max) || (llink(rlink(p)) != p))
1726         clobbered = true;
1727
1728       if (clobbered)
1729       {
1730         print_nl("Double-AVAIL list clobbered at ");
1731         print_int(q);
1732         goto done2;
1733       }
1734
1735       for (q = p; q <= p + node_size(p) - 1; q++)
1736       {
1737         if (freearr[q])
1738         {
1739           print_nl("Doubly free location at ");
1740           print_int(q);
1741           goto done2;
1742         }
1743
1744         freearr[q] = true;
1745       }
1746
1747       q = p;
1748       p = rlink(p);
1749     }
1750   while (!(p == rover));
1751
1752 done2:
1753   p = mem_min;
1754
1755   while (p <= lo_mem_max)
1756   {
1757     if (is_empty(p))
1758     {
1759       print_nl("Bad flag at ");
1760       print_int(p);
1761     }
1762
1763     while ((p <= lo_mem_max) && !freearr[p])
1764       incr(p);
1765
1766     while ((p <= lo_mem_max) && freearr[p])
1767       incr(p);
1768   }
1769
1770   if (print_locs)
1771   {
1772     print_nl("New busy locs:");
1773
1774     for (p = mem_min; p <= lo_mem_max; p++)
1775       if (!freearr[p] && ((p > was_lo_max) || wasfree[p]))
1776       {
1777         print_char(' ');
1778         print_int(p);
1779       }
1780
1781     for (p = hi_mem_min; p <= mem_end; p++)
1782       if (!freearr[p] && ((p < was_hi_min) || (p > was_mem_end) || wasfree[p]))
1783       {
1784         print_char(' ');
1785         print_int(p);
1786       }
1787   }
1788
1789   for (p = mem_min; p <= lo_mem_max; p++)
1790     wasfree[p] = freearr[p];
1791
1792   for (p = hi_mem_min; p <= mem_end; p++)
1793     wasfree[p] = freearr[p];
1794
1795   was_mem_end = mem_end;
1796   was_lo_max = lo_mem_max;
1797   was_hi_min = hi_mem_min;
1798 }
1799 #endif /* DEBUG */
1800
1801 #ifdef DEBUG
1802 /* sec 0172 */
1803 void search_mem_(pointer p)
1804 {
1805   integer q;
1806
1807   for (q = mem_min; q <= lo_mem_max; q++)
1808   {
1809     if (link(q) == p)
1810     {
1811       print_nl("LINK(");
1812       print_int(q);
1813       print_char(')');
1814     }
1815
1816     if (info(q) == p)
1817     {
1818       print_nl("INFO(");
1819       print_int(q);
1820       print_char(')');
1821     }
1822   }
1823
1824   for (q = hi_mem_min; q <= mem_end; q++)
1825   {
1826     if (link(q) == p)
1827     {
1828       print_nl("LINK(");
1829       print_int(q);
1830       print_char(')');
1831     }
1832
1833     if (info(q) == p)
1834     {
1835       print_nl("INFO(");
1836       print_int(q);
1837       print_char(')');
1838     }
1839   }
1840
1841   for (q = active_base; q <= box_base + 255; q++)
1842     if (equiv(q) == p)
1843     {
1844       print_nl("EQUIV(");
1845       print_int(q);
1846       print_char(')');
1847     }
1848
1849   if (save_ptr > 0)
1850     for (q = 0; q <= save_ptr - 1; q++)
1851     {
1852       if (equiv_field(save_stack[q]) == p)
1853       {
1854         print_nl("SAVE(");
1855         print_int(q);
1856         print_char(')');
1857       }
1858     }
1859
1860   for (q = 0; q <= hyphen_prime; q++)
1861     if (hyph_list[q] == p)
1862     {
1863       print_nl("HYPH(");
1864       print_int(q);
1865       print_char(')');
1866     }
1867 }
1868 #endif
1869 /* sec 0174 */
1870 void short_display_(integer p)
1871 {
1872   integer n;
1873
1874   while (p != 0) /* want p != null here ! */
1875   {
1876     if (is_char_node(p))
1877     {
1878       if (p <= mem_end)
1879       {
1880         if (font(p) != font_in_short_display)
1881         {
1882           if ((font(p) > font_max))
1883             print_char('*');
1884           else
1885           {
1886             print_esc("");
1887             print(font_id_text(font(p)));
1888           }
1889
1890           print_char(' ');
1891           font_in_short_display = font(p);
1892         }
1893
1894         print(character(p));
1895       }
1896     }
1897     else switch (type(p))
1898     {
1899       case hlist_node:
1900       case vlist_node:
1901       case ins_node:
1902       case whatsit_node:
1903       case mark_node:
1904       case adjust_node:
1905       case unset_node:
1906         prints("[]");
1907         break;
1908
1909       case rule_node:
1910         print_char('|');
1911         break;
1912
1913       case glue_node:
1914         if (glue_ptr(p) != 0)
1915           print_char(' ');
1916         break;
1917
1918       case math_node:
1919         print_char('$');
1920         break;
1921
1922       case ligature_node:
1923         short_display(lig_ptr(p));
1924         break;
1925
1926       case disc_node:
1927         short_display(pre_break(p));
1928         short_display(post_break(p));
1929         n = replace_count(p);
1930
1931         while (n > 0)
1932         {
1933           if (link(p) != 0)
1934             p = link(p);
1935
1936           decr(n);
1937         }
1938         break;
1939
1940       default:
1941         break;
1942     }
1943
1944     p = link(p);
1945   }
1946 }
1947 /* sec 0176 */
1948 void print_font_and_char (integer p)
1949 {
1950   if (p > mem_end)
1951     print_esc("CLOBBERED.");
1952   else
1953   {
1954     if ((font(p) > font_max))
1955       print_char('*');
1956     else
1957     {
1958       print_esc("");
1959       print(font_id_text(font(p)));
1960     }
1961
1962     print_char(' ');
1963     print(character(p));
1964   }
1965 }
1966 /* sec 0176 */
1967 void print_mark_ (integer p)
1968 {
1969   print_char('{');
1970
1971   if ((p < hi_mem_min) || (p > mem_end))
1972     print_esc("CLOBBERED.");
1973   else
1974     show_token_list(link(p), 0, max_print_line - 10);
1975
1976   print_char('}');
1977 }
1978 /* sec 0176 */
1979 void print_rule_dimen(scaled d)
1980 {
1981   if (is_running(d))
1982     print_char('*');
1983   else
1984     print_scaled(d);
1985 }
1986 /* sec 0177 */
1987 void print_glue_(scaled d, integer order, const char * s)
1988 {
1989   print_scaled(d);
1990
1991   if ((order < normal) || (order > filll))
1992     prints("foul");
1993   else if (order > 0)
1994   {
1995     prints("fil");
1996
1997     while (order > 1)
1998     {
1999       print_char('l');
2000       decr(order);
2001     }
2002   }
2003   else if (*s != '\0')
2004     prints(s);
2005 }
2006 /* sec 0178 */
2007 void print_spec_(integer p, const char * s)
2008 {
2009   if ((p < mem_min) || (p >= lo_mem_max))
2010     print_char('*');
2011   else
2012   {
2013     print_scaled(width(p));
2014
2015     if (*s != '\0')
2016       prints(s);
2017
2018     if (stretch(p) != 0)
2019     {
2020       prints("plus");
2021       print_glue(stretch(p), stretch_order(p), s);
2022     }
2023
2024     if (shrink(p) != 0)
2025     {
2026       prints("minus");
2027       print_glue(shrink(p), shrink_order(p), s);
2028     }
2029   }
2030 }
2031 /* sec 0691 */
2032 void print_fam_and_char_(pointer p)
2033 {
2034   print_esc("fam");
2035   print_int(fam(p));
2036   print_char(' ');
2037   print(character(p));
2038 }
2039 /* sec 0691 */
2040 void print_delimiter_(pointer p)
2041 {
2042   integer a;
2043
2044   a = small_fam(p) * 256 + small_char(p);
2045   a = a * 0x1000 + large_fam(p) * 256 + large_char(p);
2046
2047   if (a < 0)
2048     print_int(a);
2049   else
2050     print_hex(a);
2051 }
2052 /* sec 0692 */
2053 void print_subsidiary_data_(pointer p, ASCII_code c)
2054 {
2055   if ((pool_ptr - str_start[str_ptr]) >= depth_threshold)
2056   {
2057     if (math_type(p) != 0)
2058       prints(" []");
2059   }
2060   else
2061   {
2062     append_char(c);
2063     temp_ptr = p;
2064
2065     switch (math_type(p))
2066     {
2067       case math_char:
2068         print_ln();
2069         print_current_string();
2070         print_fam_and_char(p);
2071         break;
2072
2073       case sub_box:
2074         show_info();
2075         break;
2076
2077       case sub_mlist:
2078         if (info(p) == 0)
2079         {
2080           print_ln();
2081           print_current_string();
2082           prints("{}");
2083         }
2084         else
2085           show_info();
2086         break;
2087
2088       default:
2089         break;
2090     }
2091
2092     decr(pool_ptr);
2093   }
2094 }
2095 /* sec 0694 */
2096 void print_style_(integer c)
2097 {
2098   switch (c / 2)
2099   {
2100     case 0:
2101       print_esc("displaystyle");
2102       break;
2103     case 1:
2104       print_esc("textstyle");
2105       break;
2106     case 2:
2107       print_esc("scriptstyle");
2108       break;
2109     case 3:
2110       print_esc("scriptscriptstyle");
2111       break;
2112     default:
2113       prints("Unknown style!");
2114       break;
2115   }
2116 }
2117 /* sec 0225 */
2118 void print_skip_param_(integer n)
2119 {
2120   switch (n)
2121   {
2122     case line_skip_code:
2123       print_esc("lineskip");
2124       break;
2125
2126     case baseline_skip_code:
2127       print_esc("baselineskip");
2128       break;
2129
2130     case par_skip_code:
2131       print_esc("parskip");
2132       break;
2133
2134     case above_display_skip_code:
2135       print_esc("abovedisplayskip");
2136       break;
2137
2138     case below_display_skip_code:
2139       print_esc("belowdisplayskip");
2140       break;
2141
2142     case above_display_short_skip_code:
2143       print_esc("abovedisplayshortskip");
2144       break;
2145
2146     case below_display_short_skip_code:
2147       print_esc("belowdisplayshortskip");
2148       break;
2149
2150     case left_skip_code:
2151       print_esc("leftskip");
2152       break;
2153
2154     case right_skip_code:
2155       print_esc("rightskip");
2156       break;
2157
2158     case top_skip_code:
2159       print_esc("topskip");
2160       break;
2161
2162     case split_top_skip_code:
2163       print_esc("splittopskip");
2164       break;
2165
2166     case tab_skip_code:
2167       print_esc("tabskip");
2168       break;
2169
2170     case space_skip_code:
2171       print_esc("spaceskip");
2172       break;
2173
2174     case xspace_skip_code:
2175       print_esc("xspaceskip");
2176       break;
2177
2178     case par_fill_skip_code:
2179       print_esc("parfillskip");
2180       break;
2181
2182     case thin_mu_skip_code:
2183       print_esc("thinmuskip");
2184       break;
2185
2186     case med_mu_skip_code:
2187       print_esc("medmuskip");
2188       break;
2189
2190     case thick_mu_skip_code:
2191       print_esc("thickmuskip");
2192       break;
2193
2194     default:
2195       prints("[unknown glue parameter!]");
2196       break;
2197   }
2198 }
2199 /* sec 0182 */
2200 void show_node_list_(integer p)
2201 {
2202   integer n;
2203   real g;
2204
2205   if (cur_length > depth_threshold)
2206   {
2207     if (p != 0)    /* fixed 94/Mar/23 BUG FIX NOTE: still not fixed in 3.14159 ! */
2208       prints(" []");
2209
2210     return;
2211   }
2212
2213   n = 0;
2214
2215   while (p != 0)
2216   {
2217     print_ln();
2218     print_current_string();
2219
2220     if (p > mem_end)
2221     {
2222       prints("Bad link, display aborted.");
2223       return;
2224     }
2225
2226     incr(n);
2227
2228     if (n > breadth_max)
2229     {
2230       prints("etc.");
2231       return;
2232     }
2233
2234     if (is_char_node(p))
2235       print_font_and_char(p);
2236     else switch (type(p))
2237     {
2238       case hlist_node:
2239       case vlist_node:
2240       case unset_node:
2241         {
2242           if (type(p) == hlist_node)
2243             print_esc("h");
2244           else if (type(p) == vlist_node)
2245             print_esc("v");
2246           else
2247             print_esc("unset");
2248
2249           prints("box(");
2250           print_scaled(height(p));
2251           print_char('+');
2252           print_scaled(depth(p));
2253           prints(")x");
2254           print_scaled(width(p));
2255
2256           if (type(p) == unset_node)
2257           {
2258             if (span_count(p) != 0)
2259             {
2260               prints(" (");
2261               print_int(span_count(p) + 1);
2262               prints(" columns)");
2263             }
2264
2265             if (glue_stretch(p) != 0)
2266             {
2267               prints(", stretch ");
2268               print_glue(glue_stretch(p), glue_order(p), "");
2269             }
2270
2271             if (glue_shrink(p) != 0)
2272             {
2273               prints(", shrink ");
2274               print_glue(glue_shrink(p), glue_sign(p), "");
2275             }
2276           }
2277           else
2278           {
2279             g = glue_set(p);
2280
2281             if ((g != 0.0) && (glue_sign(p) != 0))
2282             {
2283               prints(", glue set ");
2284
2285               if (glue_sign(p) == shrinking)
2286                 prints("- ");
2287
2288               if (fabs(g) > 20000.0)
2289               {
2290                 if (g > 0.0)
2291                   print_char('>');
2292                 else
2293                   prints("< -");
2294
2295                 print_glue(20000 * unity, glue_order(p), "");
2296               }
2297               else
2298                 print_glue(round(unity * g), glue_order(p), "");
2299             }
2300
2301             if (shift_amount(p) != 0)
2302             {
2303               prints(", shifted ");
2304               print_scaled(shift_amount(p));
2305             }
2306           }
2307
2308           node_list_display(list_ptr(p));
2309         }
2310         break;
2311
2312       case rule_node:
2313         {
2314           print_esc("rule(");
2315           print_rule_dimen(height(p));
2316           print_char('+');
2317           print_rule_dimen(depth(p));
2318           prints(")x");
2319           print_rule_dimen(width(p));
2320         }
2321         break;
2322
2323       case ins_node:
2324         {
2325           print_esc("insert");
2326           print_int(subtype(p));
2327           prints(", natural size ");
2328           print_scaled(height(p));
2329           prints("; split(");
2330           print_spec(split_top_ptr(p), "");
2331           print_char(',');
2332           print_scaled(depth(p));
2333           prints("); float cost ");
2334           print_int(float_cost(p));
2335           node_list_display(ins_ptr(p));
2336         }
2337         break;
2338
2339       case whatsit_node:
2340         switch (subtype(p))
2341         {
2342           case open_node:
2343             {
2344               print_write_whatsit("openout", p);
2345               print_char('=');
2346               print_file_name(open_name(p), open_area(p), open_ext(p));
2347             }
2348             break;
2349
2350           case write_node:
2351             {
2352               print_write_whatsit("write", p);
2353               print_mark(write_tokens(p));
2354             }
2355             break;
2356
2357           case close_node:
2358             print_write_whatsit("closeout", p);
2359             break;
2360
2361           case special_node:
2362             {
2363               print_esc("special");
2364               print_mark(write_tokens(p));
2365             }
2366             break;
2367
2368           case language_node:
2369             {
2370               print_esc("setlanguage");
2371               print_int(what_lang(p));
2372               prints(" (hyphenmin ");
2373               print_int(what_lhm(p));
2374               print_char(',');
2375               print_int(what_rhm(p));
2376               print_char(')');
2377             }
2378             break;
2379
2380           default:
2381             prints("whatsit?");
2382             break;
2383         }
2384         break;
2385
2386       case glue_node:
2387         if (subtype(p) >= a_leaders)
2388         {
2389           print_esc("");
2390
2391           if (subtype(p) == c_leaders)
2392             print_char('c');
2393           else if (subtype(p) == x_leaders)
2394             print_char('x');
2395
2396           prints("leaders ");
2397           print_spec(glue_ptr(p), "");
2398           node_list_display(leader_ptr(p));
2399         }
2400         else
2401         {
2402           print_esc("glue");
2403
2404           if (subtype(p) != normal)
2405           {
2406             print_char('(');
2407
2408             if (subtype(p) < cond_math_glue)
2409               print_skip_param(subtype(p) - 1);
2410             else if (subtype(p) == cond_math_glue)
2411               print_esc("nonscript");
2412             else print_esc("mskip");
2413
2414             print_char(')');
2415           }
2416
2417           if (subtype(p) != cond_math_glue)
2418           {
2419             print_char(' ');
2420
2421             if (subtype(p) < cond_math_glue)
2422               print_spec(glue_ptr(p), "");
2423             else
2424               print_spec(glue_ptr(p), "mu");
2425           }
2426         }
2427         break;
2428
2429       case kern_node:
2430         if (subtype(p) != mu_glue)
2431         {
2432           print_esc("kern");
2433
2434           if (subtype(p) != normal)
2435             print_char(' ');
2436
2437           print_scaled(width(p));
2438
2439           if (subtype(p) == acc_kern)
2440             prints(" (for accent)");
2441         }
2442         else
2443         {
2444           print_esc("mkern");
2445           print_scaled(width(p));
2446           prints("mu");
2447         }
2448         break;
2449
2450       case math_node:
2451         {
2452           print_esc("math");
2453
2454           if (subtype(p) == before)
2455             prints("on");
2456           else
2457             prints("off");
2458
2459           if (width(p) != 0)
2460           {
2461             prints(", surrounded ");
2462             print_scaled(width(p));
2463           }
2464         }
2465         break;
2466
2467       case ligature_node:
2468         {
2469           print_font_and_char(lig_char(p));
2470           prints("(ligature ");
2471
2472           if (subtype(p) > 1)
2473             print_char('|');
2474
2475           font_in_short_display = font(lig_char(p));
2476           short_display(lig_ptr(p));
2477
2478           if (odd(subtype(p)))
2479             print_char('|');
2480
2481           print_char(')');
2482         }
2483         break;
2484
2485       case penalty_node:
2486         {
2487           print_esc("penalty ");
2488           print_int(penalty(p));
2489         }
2490         break;
2491
2492       case disc_node:
2493         {
2494           print_esc("discretionary");
2495
2496           if (replace_count(p) > 0)
2497           {
2498             prints(" replacing ");
2499             print_int(replace_count(p));
2500           }
2501
2502           node_list_display(pre_break(p));
2503           append_char('|');
2504           show_node_list(post_break(p));
2505           decr(pool_ptr);
2506         }
2507         break;
2508
2509       case mark_node:
2510         {
2511           print_esc("mark");
2512           print_mark(mark_ptr(p));
2513         }
2514         break;
2515
2516       case adjust_node:
2517         {
2518           print_esc("vadjust");
2519           node_list_display(adjust_ptr(p));
2520         }
2521         break;
2522
2523       case style_node:
2524         print_style(subtype(p));
2525         break;
2526
2527       case choice_node:
2528         {
2529           print_esc("mathchoice");
2530           append_char('D');
2531           show_node_list(display_mlist(p));
2532           decr(pool_ptr);
2533           append_char('T');
2534           show_node_list(text_mlist(p));
2535           decr(pool_ptr);
2536           append_char('S');
2537           show_node_list(script_mlist(p));
2538           decr(pool_ptr);
2539           append_char('s');
2540           show_node_list(script_script_mlist(p));
2541           decr(pool_ptr);
2542         }
2543         break;
2544
2545       case ord_noad:
2546       case op_noad:
2547       case bin_noad:
2548       case rel_noad:
2549       case open_noad:
2550       case close_noad:
2551       case punct_noad:
2552       case inner_noad:
2553       case radical_noad:
2554       case over_noad:
2555       case under_noad:
2556       case vcenter_noad:
2557       case accent_noad:
2558       case left_noad:
2559       case right_noad:
2560         {
2561           switch (type(p))
2562           {
2563             case ord_noad:
2564               print_esc("mathord");
2565               break;
2566
2567             case op_noad:
2568               print_esc("mathop");
2569               break;
2570
2571             case bin_noad:
2572               print_esc("mathbin");
2573               break;
2574
2575             case rel_noad:
2576               print_esc("mathrel");
2577               break;
2578
2579             case open_noad:
2580               print_esc("mathopen");
2581               break;
2582
2583             case close_noad:
2584               print_esc("mathclose");
2585               break;
2586
2587             case punct_noad:
2588               print_esc("mathpunct");
2589               break;
2590
2591             case inner_noad:
2592               print_esc("mathinner");
2593               break;
2594
2595             case over_noad:
2596               print_esc("overline");
2597               break;
2598
2599             case under_noad:
2600               print_esc("underline");
2601               break;
2602
2603             case vcenter_noad:
2604               print_esc("vcenter");
2605               break;
2606
2607             case radical_noad:
2608               {
2609                 print_esc("radical");
2610                 print_delimiter(left_delimiter(p));
2611               }
2612               break;
2613
2614             case accent_noad:
2615               {
2616                 print_esc("accent");
2617                 print_fam_and_char(accent_chr(p));
2618               }
2619               break;
2620
2621             case left_noad:
2622               {
2623                 print_esc("left");
2624                 print_delimiter(delimiter(p));
2625               }
2626               break;
2627
2628             case right_noad:
2629               {
2630                 print_esc("right");
2631                 print_delimiter(delimiter(p));
2632               }
2633               break;
2634           }
2635
2636           if (subtype(p) != normal)
2637             if (subtype(p) == limits)
2638               print_esc("limits");
2639             else
2640               print_esc("nolimits");
2641
2642           if (type(p) < left_noad)
2643             print_subsidiary_data(nucleus(p), '.');
2644
2645           print_subsidiary_data(supscr(p), '^');
2646           print_subsidiary_data(subscr(p), '_');
2647         }
2648         break;
2649
2650       case fraction_noad:
2651         {
2652           print_esc("fraction, thickness ");
2653
2654           if (thickness(p) == 1073741824L)  /* 2^30 */
2655             prints("= default");
2656           else
2657             print_scaled(thickness(p));
2658
2659           if ((small_fam(left_delimiter(p)) != 0) || (small_char(left_delimiter(p)) != 0) ||
2660               (large_fam(left_delimiter(p)) != 0) || (large_char(left_delimiter(p)) != 0))
2661           {
2662             prints(", left-delimiter ");
2663             print_delimiter(left_delimiter(p));
2664           }
2665
2666           if ((small_fam(right_delimiter(p)) != 0) || (small_char(right_delimiter(p)) != 0) ||
2667               (large_fam(right_delimiter(p)) != 0) || (large_char(right_delimiter(p)) != 0))
2668           {
2669             prints(", right-delimiter ");
2670             print_delimiter(right_delimiter(p));
2671           }
2672
2673           print_subsidiary_data(numerator(p), '\\');
2674           print_subsidiary_data(denominator(p), '/');
2675         }
2676         break;
2677
2678       default:
2679         prints("Unknown node type!");
2680         break;
2681     }
2682
2683     p = link(p);
2684   }
2685 }