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