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