[llvm-commits] [parallel] CVS: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/README grading.p mf.p ptc.p

Misha Brukman brukman at cs.uiuc.edu
Mon Mar 1 19:11:41 PST 2004


Changes in directory llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT:

README added (r1.1.2.1)
grading.p added (r1.1.2.1)
mf.p added (r1.1.2.1)
ptc.p added (r1.1.2.1)

---
Log message:

Merge from trunk

---
Diffs of the changes:  (+29755 -0)

Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/README
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/README:1.1.2.1
*** /dev/null	Mon Mar  1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/README	Mon Mar  1 17:59:12 2004
***************
*** 0 ****
--- 1,8 ----
+ 
+ Test Inputs to p2c program:
+ 
+ p2c -v < INPUT/grading.p
+ p2c -v < INPUT/ptc.p 
+ p2c -v < INPUT/mf.p
+ 
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/grading.p
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/grading.p:1.1.2.1
*** /dev/null	Mon Mar  1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/grading.p	Mon Mar  1 17:59:12 2004
***************
*** 0 ****
--- 1,514 ----
+ program grading (input, output);
+ 
+ const
+         namelength = 34;
+           idlength = 12;
+      commentlength =  6;
+     headlinelength = 40;
+ 
+ type
+ 
+     scores =
+         (
+          assign1, assign2, assign3, assign4,
+          assign5, assign6, assign7, assign8, assigns,
+          exam1, exam2, better, final, total
+         );
+ 
+     gradetype =
+         (
+                A, Aminus,
+         Bplus, B, Bminus,
+         Cplus, C, Cminus,
+         Dplus, D, Dminus,
+                F
+         );
+ 
+     grades =
+         (
+          absolu, curved, course
+         );
+ 
+         namestring = packed array [1..    namelength] of char;
+           idstring = packed array [1..      idlength] of char;
+      commentstring = packed array [1.. commentlength] of char;
+     headlinestring = packed array [1..headlinelength] of char;
+ 
+     studentpointer = ^ studentrecord;
+     studentrecord =
+         record
+                    name : namestring;
+                      id : idstring;
+                   score : array [scores] of integer;
+                   grade : array [grades] of gradetype;
+                    rank : integer;
+              percentile : integer;
+                 comment : commentstring;
+                    next : studentpointer;
+              nextinrank : studentpointer
+         end;
+ 
+ var
+     studentlist : studentpointer;
+     nonames : boolean;
+     nstudents, noshows, nofinals : integer;
+ 
+     scoresfile : text;
+ 
+     histogram : array [0..100] of integer;
+     histogramlist : array [0..100] of studentpointer;
+ 
+     scoretorank : array [0..100] of integer; (* scoretorank [76] = rank of student(s)
+                                                 with total score of 76 *)
+     percent : array [0..100] of integer; (* percent [76] = percentile of student(s)
+                                             with total score of 76 *)
+ 
+ function isnoshow (student : studentrecord) : boolean;
+     begin
+         isnoshow := (student.score [total] = 0)
+     end (* isnoshow *);
+ 
+ procedure computescoretorank;
+     var
+         score, nhigher : integer;
+     begin
+         nhigher := 0;
+         for score := 100 downto 0 do begin
+             scoretorank [score] := 1 + nhigher;
+             if
+                 (nstudents - noshows - nofinals) > 0
+             then
+                 percent [score] :=
+                     ((nstudents - noshows - nofinals - nhigher) * 100)
+                     div
+                     (nstudents - noshows - nofinals)
+             else
+                percent [score] := 0;
+             nhigher := nhigher + histogram [score];
+         end
+     end (* computescoretorank *);
+ 
+ procedure settitle (headline : headlinestring);
+     begin
+         writeln ('.bp');
+         writeln ('.ds Ti ', headline)
+     end (* settitle *);
+ 
+ procedure writetroffheader;
+     begin
+         writeln ('.po 1.2c');
+         writeln ('.m3 0');
+         writeln ('.m4 10');
+         writeln ('.ps 8');
+         writeln ('.vs 10');
+         writeln ('.pl 10.0i');
+         writeln ('.ll 7.3i');
+         writeln ('.lt 7.3i');
+         writeln ('\ ');
+         writeln ('.bp');
+         writeln ('.de $f');
+         writeln ('.ev 1');
+         writeln ('.nf');
+         writeln ('.ti 4.85c');
+         writeln ('\fC\ Gr\ \ \ \ \ Id\ \ \ \ \ \ \ \ A1\ A2\ A3\ A4\ A5\ A6\ A7\ A8\ A\ \ E1\ E2\ E\ \ Fi\ To\ Ab\ Cu\ Gr\ Rank\ Percentile\ Coll');
+         writeln ('.sp 2');
+         writeln ('.in 1.0i');
+         writeln ('\fC\s+2A  = \fRsum of all assignments');
+         writeln ('\fCE1 = \fRfirst exam');
+         writeln ('\fCE2 = \fRsecond exam');
+         writeln ('\fCE  = \fR better of first two exams');
+         writeln ('\fCFi = \fRfinal exam');
+         writeln ('.sp -5');
+         writeln ('.in +2.3i');
+         writeln ('\fCTo = \fRtotal score in course');
+         writeln ('\fCAb = \fRgrade according to first (absolute, i.e. not curved) policy');
+         writeln ('\fCCu = \fRgrade according to second (curved) policy');
+         writeln ('\fCGr = \fRcourse grade');
+         writeln ('Percentiles are computed ignoring ''No shows'' and ''No finals''.\s-2');
+         writeln ('.sp 2');
+         writeln ('.in 0');
+         writeln ('.tl ^\s+8\fB\\*(Ti^^\*(td\s-8\fP^^');
+         writeln ('.ev');
+         writeln ('..');
+         writeln ('.de $h');
+         writeln ('.ev 1');
+         writeln ('.ps 8');
+         writeln ('.vs 10');
+         writeln ('\ ');
+         writeln ('.sp |2.5c');
+         writeln ('.ti 4.85c');
+         writeln ('\fC\ Gr\ \ \ \ \ Id\ \ \ \ \ \ \ \ A1\ A2\ A3\ A4\ A5\ A6\ A7\ A8\ A\ \ E1\ E2\ E\ \ Fi\ To\ Ab\ Cu\ Gr\ Rank\ Percentile\ Coll');
+         writeln ('.sp 2');
+         writeln ('.ev');
+         writeln ('..');
+         writeln ('\ ');
+         writeln ('.bp');
+         writeln ('\fC');
+         writeln ('.nf');
+         writeln ('.ev 1');
+         writeln ('.ps 8');
+         writeln ('.vs 10');
+         writeln ('.ev');
+     end (* writetroffheader *);
+ 
+ procedure initialize;
+     var
+         score : integer;
+     begin
+         nstudents := 0;
+         noshows := 0;
+         nofinals := 0;
+         studentlist := nil;
+ 
+         for score := 0 to 100 do begin
+             histogram [score] := 0;
+             histogramlist [score] := nil
+         end;
+ 
+         writetroffheader
+     end (* initialize *);
+ 
+ procedure readscores;
+     var
+         newstudent : studentpointer;
+         s : scores;
+         c : integer;
+     begin
+         new (newstudent);
+         nstudents := nstudents + 1;
+ 
+         with newstudent^ do begin
+             next := studentlist;
+ 
+             for c := 1 to namelength do
+                 read (input, name [c]);
+ 
+             for c := 1 to idlength do
+                 read (input, id   [c]);
+ 
+             for s := assign1 to assign8 do
+                 read (input, score [s]);
+ 
+             read (input, score [exam1]);
+             read (input, score [exam2]);
+             read (input, score [final]);
+             
+             for c := 1 to commentlength do
+                 read (input, comment [c])
+         end;
+ 
+         readln (input);
+         studentlist := newstudent
+     end (* readscores *);
+ 
+ procedure computescores (student : studentpointer);
+     var
+         s : scores;
+     begin
+         with student^ do begin
+             score [assigns] := 0;
+             for s := assign1 to assign8 do
+                 score [assigns] := score [assigns] + score [s];
+ 
+             if
+                 score [exam1] > score [exam2]
+             then
+                 score [better] := score [exam1]
+             else
+                 score [better] := score [exam2];
+ 
+             score [total] :=    score [assigns]
+                               + score [better ]
+                               + score [final  ];
+ 
+             if
+                 isnoshow (student^)
+             then
+                 noshows := noshows + 1
+             else if
+                 score [final] = 0
+             then
+                 nofinals := nofinals + 1
+             else
+                 histogram [score [total]] := histogram [score [total]] + 1;
+       
+         end
+     end (* computescores *);
+ 
+ procedure computeallscores (studentlist : studentpointer);
+     begin
+         if
+             studentlist <> nil
+         then begin
+             computescores (studentlist);
+             computeallscores (studentlist^.next)
+         end
+     end (* computeallscores *);
+     
+ procedure computegrades (student : studentpointer);
+     
+     begin
+         with student^ do begin
+             if score [total] >= 90 then grade [absolu] := A      else
+             if score [total] >= 88 then grade [absolu] := Aminus else
+             if score [total] >= 86 then grade [absolu] := Bplus  else
+             if score [total] >= 80 then grade [absolu] := B      else
+             if score [total] >= 78 then grade [absolu] := Bminus else
+             if score [total] >= 76 then grade [absolu] := Cplus  else
+             if score [total] >= 70 then grade [absolu] := C      else
+             if score [total] >= 65 then grade [absolu] := Cminus else
+             if score [total] >= 60 then grade [absolu] := Dplus  else
+             if score [total] >= 55 then grade [absolu] := D      else
+             if score [total] >= 50 then grade [absolu] := Dminus else
+                                         grade [absolu] := F
+             ;
+ 
+                   rank := scoretorank   [score [total]];
+             nextinrank := histogramlist [score [total]];
+                           histogramlist [score [total]] := student;
+             percentile := percent       [score [total]];
+ 
+             if percentile >= 80 then grade [curved] := A      else
+             if percentile >= 78 then grade [curved] := Aminus else
+             if percentile >= 76 then grade [curved] := Bplus  else
+             if percentile >= 50 then grade [curved] := B      else
+             if percentile >= 48 then grade [curved] := Bminus else
+             if percentile >= 46 then grade [curved] := Cplus  else
+             if percentile >= 25 then grade [curved] := C      else
+             if percentile >= 23 then grade [curved] := Cminus else
+             if percentile >= 21 then grade [curved] := Dplus  else
+             if percentile >= 10 then grade [curved] := D      else
+             if percentile >=  8 then grade [curved] := Dminus else
+                                      grade [curved] := F
+             ;
+ 
+            if
+                grade [absolu] < grade [curved]
+            then
+                grade [course] := grade [absolu]
+            else
+                grade [course] := grade [curved]
+ 
+         end
+     end (* computegrades *);
+ 
+ procedure computeallgrades (studentlist : studentpointer);
+     begin
+         if
+             studentlist <> nil
+         then begin
+             computegrades (studentlist);
+             computeallgrades (studentlist^.next)
+         end
+     end (* computeallgrades *);
+ 
+ function gradepoint (g : gradetype) : real;
+     begin
+         if g = A      then gradepoint := 4.0 else
+         if g = Aminus then gradepoint := 3.7 else
+         if g = Bplus  then gradepoint := 3.3 else
+         if g = B      then gradepoint := 3.0 else
+         if g = Bminus then gradepoint := 2.7 else
+         if g = Cplus  then gradepoint := 2.3 else
+         if g = C      then gradepoint := 2.0 else
+         if g = Cminus then gradepoint := 1.7 else
+         if g = Dplus  then gradepoint := 1.3 else
+         if g = D      then gradepoint := 1.0 else
+         if g = Dminus then gradepoint := 0.7 else
+         if g = F      then gradepoint := 0.0 else
+                            gradepoint := 0.0
+     end (* gradepoint *);
+ 
+ procedure writegrade (g : gradetype);
+     begin
+         if g = A      then write (' A ') else
+         if g = Aminus then write (' A-') else
+         if g = Bplus  then write (' B+') else
+         if g = B      then write (' B ') else
+         if g = Bminus then write (' B-') else
+         if g = Cplus  then write (' C+') else
+         if g = C      then write (' C ') else
+         if g = Cminus then write (' C-') else
+         if g = Dplus  then write (' D+') else
+         if g = D      then write (' D ') else
+         if g = Dminus then write (' D-') else
+         if g = F      then write (' F ') else
+                            write (' ??')
+     end (* writegrade *);
+ 
+ procedure readallscores;
+     begin
+         while
+             not eof (input)
+         do
+             readscores
+     end (* readallscores *);
+ 
+ procedure writestudent (student : studentpointer);
+     var
+         c : integer;
+         s : scores;
+         g : grades;
+     begin
+     end (* writestudent *);
+ 
+ procedure writestraight (studentlist : studentpointer);
+     begin
+         if
+             studentlist <> nil
+         then begin
+             writestraight (studentlist^.next);
+             writestudent (studentlist);
+         end
+     end (* writestraight *);
+ 
+ procedure gotoXY (x, y : integer);
+     begin
+         writeln ('\ ');
+         writeln ('.sp |', 1500 - 40 * y : 0, 'u');
+         writeln ('.ti  ',        40 * x : 0, 'u');
+     end (* gotoXY *);
+ 
+ procedure writehistogram;
+     var
+         score, height : integer;
+     begin
+         for score := 0 to 100 do
+             for height := 1 to histogram [score] do begin
+                 gotoXY (score, height);
+                 writeln ('X')
+             end;
+ 
+         score := 0;
+         repeat
+             gotoXY (score, - 1);
+             writeln ('\v''0.5c''|');
+             gotoXY (score, - 3);
+             writeln (score : 0);
+             score := score + 5
+         until
+             score > 100;
+ 
+         gotoXY (0,- 10)
+     end (* writehistogram *);
+ 
+ procedure writerank (studentlist : studentpointer);
+     begin
+         if
+             studentlist <> nil
+         then begin
+             writerank (studentlist^.nextinrank);
+             writestudent (studentlist)
+         end
+     end (* writerank *);
+ 
+ procedure writebyrank;
+     var
+         score : integer;
+     begin
+         for score := 100 downto 0 do
+             writerank (histogramlist [score])
+     end (* writebyrank *);
+ 
+ procedure stats;
+     var
+         scoresum : array [scores] of real;
+         gradecount : array [grades, gradetype] of integer;
+         s   : scores;
+         g   : grades;
+         gt  : gradetype;
+         currentstudent : studentpointer;
+     begin
+         writeln ('.in 0');
+         writeln ('.hl');
+         writeln ('\fC');
+         writeln ('.2c');
+         write   ('Number of students: ');
+         writeln (nstudents : 5);
+         write   ('          No-shows: ');
+         writeln (noshows   : 5);
+         write   ('         No finals: ');
+         writeln (nofinals  : 5);
+         write   ('      Assignment 1: ');
+         writeln (scoresum [assign1] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 2: ');
+         writeln (scoresum [assign2] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 3: ');
+         writeln (scoresum [assign3] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 4: ');
+         writeln (scoresum [assign4] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 5: ');
+         writeln (scoresum [assign5] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 6: ');
+         writeln (scoresum [assign6] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 7: ');
+         writeln (scoresum [assign7] / (nstudents - noshows) : 5 : 1);
+         write   ('      Assignment 8: ');
+         writeln (scoresum [assign8] / (nstudents - noshows) : 5 : 1);
+         write   ('   All assignments: ');
+         writeln (scoresum [assigns] / (nstudents - noshows) : 5 : 1);
+         write   ('            Exam 1: ');
+         writeln (scoresum [exam1  ] / (nstudents - noshows) : 5 : 1);
+         write   ('            Exam 2: ');
+         writeln (scoresum [exam2  ] / (nstudents - noshows) : 5 : 1);
+         write   ('     Better of 1,2: ');
+         writeln (scoresum [better ] / (nstudents - noshows) : 5 : 1);
+         write   ('        Final exam: ');
+         writeln (scoresum [final  ] / (nstudents - noshows) : 5 : 1);
+         write   ('       Total score: ');
+         writeln (scoresum [total  ] / (nstudents - noshows) : 5 : 1);
+         
+         writeln ('.sp 2');
+         writeln ('Absolute grade distribution: ');
+         for gt := A to F do begin
+             writegrade (gt);
+             writeln (gradecount [absolu, gt])
+         end;
+         writeln ('.bc');
+ 
+         writeln ('Curved grade distribution: ');
+         for gt := A to F do begin
+             writegrade (gt);
+             writeln (gradecount [curved, gt])
+         end;
+         writeln ('.sp 2');
+ 
+         writeln ('Course grade distribution: ');
+         for gt := A to F do begin
+             writegrade (gt);
+             writeln (gradecount [course, gt])
+         end;
+ 
+     end (* stats *);
+ 
+ begin
+     initialize;
+     readallscores;
+     computeallscores (studentlist);
+     computescoretorank;
+     computeallgrades (studentlist);
+ 
+     settitle ('CSCI 1200, Spring 1989');
+     nonames := false;
+     writestraight (studentlist);
+ 
+     settitle ('CSCI 1200, Spring 1989');
+     nonames := true;
+     writestraight (studentlist);
+ 
+     settitle ('CSCI 1200, Spring 1989, grades by rank');
+     nonames := false;
+     writebyrank;
+ 
+     settitle ('CSCI 1200, Spring 1989, grade statistics');
+     writeln ('.de $f');
+     writeln ('.tl ^\v''1.0i''\s+8\fB\\*(Ti^^\*(td\s-8\fP\v''-1.0i''^^');
+     writeln ('..');
+     writeln ('.de $h');
+     writeln ('..');
+     writeln ('\ ');
+     writeln ('.bp');
+     writeln ('Histogram, without ''No-shows'' and ''No finals''');
+     writehistogram;
+     stats;
+ end.


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p:1.1.2.1
*** /dev/null	Mon Mar  1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p	Mon Mar  1 17:59:12 2004
***************
*** 0 ****
--- 1,19497 ----
+ program MF(input, output); {6:}
+ 
+ {------------------------------}
+ { declarations are in mf2ps1.h }
+ {------------------------------}
+ label
+     1, 9998, 9999;
+ {:6} {11:}
+ const
+     memmax = 30000;
+     maxinternal = 100;
+     bufsize = 500;
+     errorline = 79;
+     halferrorline = 50;
+     maxprintline = 79;
+     screenwidth = 1024;
+     screendepth = 1024;
+     stacksize = 30;
+     maxstrings = 2000;
+     stringvacancies = 8000;
+     poolsize = 32000;
+     movesize = 5000;
+     maxwiggle = 300;
+     gfbufsize = 800;
+     filenamesize = 256;
+     poolname = 'mf.pool';
+     pathsize = 300;
+     bistacksize = 785;
+     headersize = 100;
+     ligtablesize = 300;
+     maxfontdimen = 50; {:11} {18:}
+ type
+     ASCIIcode = 0..127; {:18}
+ {24:}
+     eightbits = 0..255;
+     alphafile = text;
+     {------------------}
+     postscript = text;
+     {------------------}
+     UNIXfilename = packed array [1..filenamesize] of char;
+     bytefile = 
+ 	record 
+ 	    stdioptr: ^ integer;
+ 	    locptr: ^ integer;
+ 	    filename: UNIXfilename
+ 	end; {:24} {37:}
+     poolpointer = 0..poolsize;
+     strnumber = 0..maxstrings; {:37}
+ {101:}
+     scaled = integer;
+     smallnumber = 0..63; {:101} {105:}
+     fraction = integer;
+ {:105}
+     {106:}
+     angle = integer; {:106} {156:}
+     quarterword = -128..127;
+     halfword = -32768..32767;
+     twochoices = 1..2;
+     threechoices = 1..3;
+     twohalves = packed 
+ 	record 
+ 	    rh: halfword;
+ 	    case twochoices of
+ 		1: (
+ 		    lh: halfword
+ 		);
+ 		2: (
+ 		    b0: quarterword;
+ 		    b1: quarterword
+ 		)
+ 	end;
+     fourquarters = packed 
+ 	record 
+ 	    b0: quarterword;
+ 	    b1: quarterword;
+ 	    b2: quarterword;
+ 	    b3: quarterword
+ 	end;
+     memoryword = 
+ 	record 
+ 	    case threechoices of
+ 		1: (
+ 		    int: integer
+ 		);
+ 		2: (
+ 		    hh: twohalves
+ 		);
+ 		3: (
+ 		    qqqq: fourquarters
+ 		)
+ 	end;
+     wordfile = file of memoryword; {:156} {186:}
+     commandcode = 1..82; {:186} {565:}
+     screenrow = 0..screendepth;
+     screencol = 0..screenwidth;
+     transspec = array [screencol] of screencol;
+     pixelcolor = 0..1; {:565} {571:}
+     windownumber = 0..15; {:571} {627:}
+     instaterecord = 
+ 	record 
+ 	    indexfield: quarterword;
+ 	    startfield, locfield, limitfield, namefield: halfword
+ 	end; {:627} {1151:}
+     gfindex = 0..gfbufsize;
+     gfbuftype = array [gfindex] of eightbits; {:1151} {13:}
+ var
+     bad: integer; {:13} {20:}
+     xord: array [char] of ASCIIcode;
+     xchr: array [ASCIIcode] of char; {:20} {25:}
+     nameoffile, realnameoffile: UNIXfilename;
+     namelength: 0..filenamesize; {:25}
+ {29:}
+     buffer: array [0..bufsize] of ASCIIcode;
+     first: 0..bufsize;
+     last: 0..bufsize;
+     maxbufstack: 0..bufsize; {:29} {38:}
+     strpool: packed array [poolpointer] of ASCIIcode;
+     strstart: array [strnumber] of poolpointer;
+     poolptr: poolpointer;
+     strptr: strnumber;
+     initpoolptr: poolpointer;
+     initstrptr: strnumber;
+     maxpoolptr: poolpointer;
+     maxstrptr: strnumber; {:38} {42:}
+     strref: array [strnumber] of 0..127; {:42} {50:}
+     poolfile: alphafile; {:50} {54:}
+     logfile: alphafile;
+     {-------------------------------------------------------------}
+      psfile          :postscript; { the PostScript code           }
+      g               :postscript; { holds the character information after re-arrange}
+      lastx0 , lasty0 :real   ;    { last point in sunpath         }
+      lastx3 , lasty3 :real   ;    { make optimization on commands } 
+      prevtox3 , prevtoy3 :real;
+      lastyearval ,                { mark entering to macros       } 
+      lastmonthval    :integer;    { STROKE , FILL , and ERASE     }
+                                   { in MY plain.mf                }   
+      my_xx , my_yy   :integer;    { hold the values of xx & yy    }
+      LineSource     : integer;    { Identifier for sendline source  }
+      CurveSource    : integer;    { Identifier for makemoves source }
+      foundnew       : boolean;    { true while xchr[s]='[' until ']' } 
+      ascval         : integer;    { holds the ascii of curr. letter }
+      ascii_on       : boolean;    { reading ascval is 'on'        }
+     {-------------------------------------------------------------}
+     selector: 0..5;
+     dig: array [0..22] of 0..15;
+     tally: integer;
+     termoffset: 0..maxprintline;
+     fileoffset: 0..maxprintline;
+     trickbuf: array [0..errorline] of ASCIIcode;
+     trickcount: integer;
+     firstcount: integer; {:54} {68:}
+     interaction: 0..3; {:68} {71:}
+     deletionsallowed: boolean;
+     history: 0..3;
+     errorcount: -1..100; {:71} {74:}
+     helpline: array [0..5] of strnumber;
+     helpptr: 0..6;
+     useerrhelp: boolean;
+     errhelp: strnumber; {:74} {91:}
+     interrupt: integer;
+     OKtointerrupt: boolean;
+ {:91}
+     {97:}
+     aritherror: boolean; {:97} {129:}
+     twotothe: array [0..30] of integer;
+     speclog: array [1..28] of integer; {:129} {137:}
+     specatan: array [1..26] of angle; {:137} {144:}
+     nsin, ncos: fraction; {:144}
+ {148:}
+     randoms: array [0..54] of fraction;
+     jrandom: 0..54; {:148} {158:}
+     tempptr: halfword; {:158} {159:}
+     mem: array [-30000..memmax] of memoryword;
+     lomemmax: halfword;
+     himemmin: halfword; {:159} {160:}
+     varused, dynused: integer;
+ {:160}
+     {161:}
+     avail: halfword;
+     memend: halfword; {:161} {166:}
+     rover: halfword;
+ {:166}
+     {178:}
+     freearr: packed array [-30000..memmax] of boolean;
+     wasfree: packed array [-30000..memmax] of boolean;
+     wasmemend, waslomax, washimin: halfword;
+     panicking: boolean; {:178} {190:}
+     internal: array [1..maxinternal] of scaled;
+     intname: array [1..maxinternal] of strnumber;
+     intptr: 40..maxinternal; {:190}
+ {196:}
+     oldsetting: 0..5; {:196} {198:}
+     charclass: array [ASCIIcode] of 0..20;
+ {:198}
+     {200:}
+     hashused: halfword;
+     stcount: integer; {:200} {201:}
+     hash: array [1..2241] of twohalves;
+     eqtb: array [1..2241] of twohalves; {:201}
+ {225:}
+     gpointer: halfword; {:225} {230:}
+     bignodesize: array [13..14] of smallnumber; {:230} {250:}
+     saveptr: halfword;
+ {:250}
+     {267:}
+     pathtail: halfword; {:267} {279:}
+     deltax, deltay, delta: array [0..pathsize] of scaled;
+     psi: array [1..pathsize] of angle; {:279} {283:}
+     theta: array [0..pathsize] of angle;
+     uu: array [0..pathsize] of fraction;
+     vv: array [0..pathsize] of angle;
+     ww: array [0..pathsize] of fraction; {:283}
+ {298:}
+     st, ct, sf, cf: fraction; {:298} {308:}
+     move: array [0..movesize] of integer;
+     moveptr: 0..movesize; {:308} {309:}
+     bisectstack: array [0..bistacksize] of integer;
+     bisectptr: 0..bistacksize;
+ {:309}
+     {327:}
+     curedges: halfword;
+     curwt: integer; {:327} {371:}
+     tracex: integer;
+     tracey: integer;
+     traceyy: integer; {:371} {379:}
+     octant: 1..8; {:379} {389:}
+     curx, cury: scaled; {:389} {395:}
+     octantdir: array [1..8] of strnumber; {:395}
+ {403:}
+     curspec: halfword;
+     turningnumber: integer;
+     curpen: halfword;
+     curpathtype: 0..2;
+     maxallowed: scaled; {:403} {427:}
+     before, after: array [0..maxwiggle] of scaled;
+     nodetoround: array [0..maxwiggle] of halfword;
+     curroundingptr: 0..maxwiggle;
+     maxroundingptr: 0..maxwiggle; {:427} {430:}
+     curgran: scaled; {:430} {448:}
+     octantnumber: array [1..8] of 1..8;
+     octantcode: array [1..8] of 1..8; {:448}
+ {455:}
+     revturns: boolean; {:455} {461:}
+     ycorr, xycorr, zcorr: array [1..8] of 0..1;
+     xcorr: array [1..8] of -1..1; {:461}
+ {464:}
+     m0, n0, m1, n1: integer;
+     d0, d1: 0..1; {:464} {507:}
+     envmove: array [0..movesize] of integer; {:507} {552:}
+     tolstep: 0..6; {:552}
+ {555:}
+     curt, curtt: integer;
+     timetogo: integer;
+     maxt: integer; {:555} {557:}
+     delx, dely: integer;
+     tol: integer;
+     uv, xy: 0..bistacksize;
+     threel: integer;
+     apprt, apprtt: integer; {:557} {566:}
+ {screenpixel:array[screenrow,screencol]of pixelcolor;}
+     {:566}
+     {569:}
+     screenstarted: boolean;
+     screenOK: boolean; {:569} {572:}
+     windowopen: array [windownumber] of boolean;
+     leftcol: array [windownumber] of screencol;
+     rightcol: array [windownumber] of screencol;
+     toprow: array [windownumber] of screenrow;
+     botrow: array [windownumber] of screenrow;
+     mwindow: array [windownumber] of integer;
+     nwindow: array [windownumber] of integer;
+     windowtime: array [windownumber] of integer; {:572} {579:}
+     rowtransition: transspec; {:579} {585:}
+     serialno: integer; {:585} {592:}
+     fixneeded: boolean;
+     watchcoefs: boolean;
+     depfinal: halfword; {:592} {624:}
+     curcmd: eightbits;
+     curmod: integer;
+     cursym: halfword; {:624} {628:}
+     inputstack: array [0..stacksize] of instaterecord;
+     inputptr: 0..stacksize;
+     maxinstack: 0..stacksize;
+     curinput: instaterecord; {:628} {631:}
+     inopen: 0..6;
+     inputfile: array [1..6] of alphafile;
+     line: integer;
+     linestack: array [1..6] of integer; {:631} {633:}
+     paramstack: array [0..150] of halfword;
+     paramptr: 0..150;
+     maxparamstack: integer; {:633} {634:}
+     fileptr: 0..stacksize; {:634} {659:}
+     scannerstatus: 0..6;
+     warninginfo: integer; {:659} {680:}
+     forceeof: boolean;
+ {:680}
+     {699:}
+     bgloc, egloc: 1..2241; {:699} {738:}
+     condptr: halfword;
+     iflimit: 0..4;
+     curif: smallnumber;
+     ifline: integer; {:738} {752:}
+     loopptr: halfword; {:752} {767:}
+     curname: strnumber;
+     curarea: strnumber;
+     curext: strnumber; {:767} {768:}
+     areadelimiter: poolpointer;
+     extdelimiter: poolpointer; {:768} {775:}
+     MFbasedefault: packed array [1..10] of char; {:775} {782:}
+     jobname: strnumber;
+     logname: strnumber; {:782} {785:}
+     gfext: strnumber; {:785} {791:}
+     gffile: bytefile;
+     outputfilename: strnumber; {:791} {796:}
+     curtype: smallnumber;
+     curexp: integer; {:796} {813:}
+     maxc: array [17..18] of integer;
+     maxptr: array [17..18] of halfword;
+     maxlink: array [17..18] of halfword; {:813} {821:}
+     varflag: 0..82; {:821} {954:}
+     txx, txy, tyx, tyy, tx, ty: scaled; {:954} {1077:}
+     startsym: halfword; {:1077}
+ {1084:}
+     longhelpseen: boolean; {:1084} {1087:}
+     tfmfile: bytefile;
+     metricfilename: strnumber; {:1087} {1096:}
+     bc, ec: eightbits;
+     tfmwidth: array [eightbits] of scaled;
+     tfmheight: array [eightbits] of scaled;
+     tfmdepth: array [eightbits] of scaled;
+     tfmitalcorr: array [eightbits] of scaled;
+     charexists: array [eightbits] of boolean;
+     chartag: array [eightbits] of 0..3;
+     charremainder: array [eightbits] of eightbits;
+     headerbyte: array [1..headersize] of -1..255;
+     ligkern: array [0..ligtablesize] of fourquarters;
+     nl: 0..ligtablesize;
+     kern: array [eightbits] of scaled;
+     nk: 0..256;
+     exten: array [eightbits] of fourquarters;
+     ne: 0..256;
+     param: array [1..maxfontdimen] of scaled;
+     np: 0..maxfontdimen;
+     nw, nh, nd, ni: 0..256; {:1096} {1119:}
+     perturbation: scaled; {:1119} {1125:}
+     dimenhead: array [1..4] of halfword; {:1125} {1130:}
+     maxtfmdimen: scaled;
+     tfmchanged: integer; {:1130} {1149:}
+     gfminm, gfmaxm, gfminn, gfmaxn: integer;
+     gfprevptr: integer;
+     totalchars: integer;
+     charptr: array [eightbits] of integer;
+     gfdx, gfdy: array [eightbits] of integer; {:1149} {1152:}
+     gfbuf: gfbuftype;
+     halfbuf: gfindex;
+     gflimit: gfindex;
+     gfptr: gfindex;
+     gfoffset: integer; {:1152}
+ {1162:}
+     bocc, bocp: integer; {:1162} {1183:}
+     baseident: strnumber; {:1183}
+ {1188:}
+     basefile: wordfile; {:1188} {1203:}
+     readyalready: integer; {:1203}
+ {1214:}
+     editnamestart: poolpointer;
+     editnamelength, editline: integer; {:1214}
+ 
+ procedure unskew(x, y: scaled; octant: smallnumber);external;
+ 
+ procedure sendcurve(x0,x1,x2,x3,y0,y1,y2,y3,octant:integer);external;
+ 
+ procedure sendline(x0,y0,x1,y1,octant,LineSource:integer);external;
+ 
+ procedure confusion(s: strnumber);external;
+ 
+ function abvscd(a, b, c, d: integer): integer;external;
+ 
+ procedure makemoves(xx0, xx1, xx2, xx3, yy0, yy1, yy2, yy3: scaled; xicorr, etacorr: smallnumber;CurveSource:integer;oc:smallnumber);external;
+ 
+ procedure print_start(var f:postscript);external;
+ 
+ procedure print_end(var f:postscript);external;
+ 
+ procedure init_ps(var f:postscript);external;
+ 
+ procedure tini_ps(var f:postscript);external;
+ 
+ procedure auxslowprint(s: integer);external;
+ 
+ procedure auxprintnl(s: strnumber);external;
+ 
+ procedure sendascii(asc: integer);external;
+ 
+ {------------------------------}
+ { $Header: /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p,v 1.1.2.1 2004/03/01 23:59:12 brukman Exp $ }
+ 
+ { declarations for external C assist routines for MetaFont }
+ 
+ procedure exit(x : integer);
+  external;
+ 
+ procedure closea(var f:text);
+  external;
+ 
+ procedure closew(var f:wordfile);
+  external;
+ 
+ procedure dateandtime(var minutes, day, month, year : integer);
+     external;
+ 
+ procedure setpaths;
+     external;
+ 
+ function testaccess(var nameoffile, realnameoffile: UNIXfilename;
+ 		accessmode:integer; filepath:integer): boolean;
+     external;
+ 
+ procedure calledit(var filename: ASCIIcode; fnlength, linenumber: integer);
+     external;
+ 
+ function bopenout(var f: bytefile; var name: UNIXfilename): boolean;
+     external;
+ 
+ procedure bclose(var f: bytefile);
+     external;
+ 
+ procedure bgetname(var f: bytefile; var name: UNIXfilename);
+     external;
+ 
+ procedure bwritebuf(var f: bytefile; var buf: gfbuftype;
+ 		first, last: integer);
+     external;
+ 
+ procedure bwritebyte(var f: bytefile; b: integer);
+     external;
+ 
+ procedure bwrite2bytes(var f: bytefile; b: integer);
+     external;
+ 
+ procedure bwrite4bytes(var f: bytefile; b: integer);
+     external;
+ 
+ function makefraction(p, q: integer): fraction;
+     external;
+ 
+ function takefraction(q: integer; f: fraction): integer;
+     external;
+ 
+ { $Header: /home/vadve/shared/PublicCVS/llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/mf.p,v 1.1.2.1 2004/03/01 23:59:12 brukman Exp $ }
+ 
+ { External procedures for UNIX MetaFont VIRMF for display graphics }
+ 
+ function initscreen: boolean;
+     external;
+ 
+ procedure updatescreen;
+     external;
+ 
+ procedure blankrectangle(leftcol, rightcol: screencol; toprow, botrow: screenrow);
+     external;
+ 
+ procedure paintrow(r: screenrow; b: pixelcolor; var a: transspec; n: screencol);
+     external;
+ 
+ 
+     procedure initialize; {19:}
+     var
+ 	i: 0..127; {:19} {130:}
+ 	k: integer; {:130} {21:}
+     begin
+ 	xchr[32] := ' ';
+ 	xchr[33] := '!';
+ 	xchr[34] := '"';
+ 	xchr[35] := '#';
+ 	xchr[36] := '$';
+ 	xchr[37] := '%';
+ 	xchr[38] := '&';
+ 	xchr[39] := '''';
+ 	xchr[40] := '(';
+ 	xchr[41] := ')';
+ 	xchr[42] := '*';
+ 	xchr[43] := '+';
+ 	xchr[44] := ',';
+ 	xchr[45] := '-';
+ 	xchr[46] := '.';
+ 	xchr[47] := '/';
+ 	xchr[48] := '0';
+ 	xchr[49] := '1';
+ 	xchr[50] := '2';
+ 	xchr[51] := '3';
+ 	xchr[52] := '4';
+ 	xchr[53] := '5';
+ 	xchr[54] := '6';
+ 	xchr[55] := '7';
+ 	xchr[56] := '8';
+ 	xchr[57] := '9';
+ 	xchr[58] := ':';
+ 	xchr[59] := ';';
+ 	xchr[60] := '<';
+ 	xchr[61] := '=';
+ 	xchr[62] := '>';
+ 	xchr[63] := '?';
+ 	xchr[64] := '@';
+ 	xchr[65] := 'A';
+ 	xchr[66] := 'B';
+ 	xchr[67] := 'C';
+ 	xchr[68] := 'D';
+ 	xchr[69] := 'E';
+ 	xchr[70] := 'F';
+ 	xchr[71] := 'G';
+ 	xchr[72] := 'H';
+ 	xchr[73] := 'I';
+ 	xchr[74] := 'J';
+ 	xchr[75] := 'K';
+ 	xchr[76] := 'L';
+ 	xchr[77] := 'M';
+ 	xchr[78] := 'N';
+ 	xchr[79] := 'O';
+ 	xchr[80] := 'P';
+ 	xchr[81] := 'Q';
+ 	xchr[82] := 'R';
+ 	xchr[83] := 'S';
+ 	xchr[84] := 'T';
+ 	xchr[85] := 'U';
+ 	xchr[86] := 'V';
+ 	xchr[87] := 'W';
+ 	xchr[88] := 'X';
+ 	xchr[89] := 'Y';
+ 	xchr[90] := 'Z';
+ 	xchr[91] := '[';
+ 	xchr[92] := '\';
+ 	xchr[93] := ']';
+ 	xchr[94] := '^';
+ 	xchr[95] := '_';
+ 	xchr[96] := '`';
+ 	xchr[97] := 'a';
+ 	xchr[98] := 'b';
+ 	xchr[99] := 'c';
+ 	xchr[100] := 'd';
+ 	xchr[101] := 'e';
+ 	xchr[102] := 'f';
+ 	xchr[103] := 'g';
+ 	xchr[104] := 'h';
+ 	xchr[105] := 'i';
+ 	xchr[106] := 'j';
+ 	xchr[107] := 'k';
+ 	xchr[108] := 'l';
+ 	xchr[109] := 'm';
+ 	xchr[110] := 'n';
+ 	xchr[111] := 'o';
+ 	xchr[112] := 'p';
+ 	xchr[113] := 'q';
+ 	xchr[114] := 'r';
+ 	xchr[115] := 's';
+ 	xchr[116] := 't';
+ 	xchr[117] := 'u';
+ 	xchr[118] := 'v';
+ 	xchr[119] := 'w';
+ 	xchr[120] := 'x';
+ 	xchr[121] := 'y';
+ 	xchr[122] := 'z';
+ 	xchr[123] := '{';
+ 	xchr[124] := '|';
+ 	xchr[125] := '}';
+ 	xchr[126] := '~';
+ 	xchr[0] := ' ';
+ 	xchr[127] := ' '; {:21} {22:}
+ 	for i := 1 to 31 do 
+ 	    xchr[i] := ' ';
+ 	xchr[9] := chr(9);
+ 	xchr[12] := chr(12); {:22}
+ {23:}
+ 	for i := 0 to 127 do 
+ 	    xord[chr(i)] := 127;
+ 	for i := 1 to 126 do 
+ 	    xord[xchr[i]] := i; {:23} {69:}
+ 	interaction := 3; {:69} {72:}
+ 	deletionsallowed := true;
+ 	errorcount := 0; {:72} {75:}
+ 	helpptr := 0;
+ 	useerrhelp := false;
+ 	errhelp := 0; {:75} {92:}
+ 	interrupt := 0;
+ 	OKtointerrupt := true;
+ {:92}
+ 	{98:}
+ 	aritherror := false; {:98} {131:}
+ 	twotothe[0] := 1;
+ 	for k := 1 to 30 do 
+ 	    twotothe[k] := 2 * twotothe[k - 1];
+ 	speclog[1] := 93032640;
+ 	speclog[2] := 38612034;
+ 	speclog[3] := 17922280;
+ 	speclog[4] := 8662214;
+ 	speclog[5] := 4261238;
+ 	speclog[6] := 2113709;
+ 	speclog[7] := 1052693;
+ 	speclog[8] := 525315;
+ 	speclog[9] := 262400;
+ 	speclog[10] := 131136;
+ 	speclog[11] := 65552;
+ 	speclog[12] := 32772;
+ 	speclog[13] := 16385;
+ 	for k := 14 to 27 do 
+ 	    speclog[k] := twotothe[27 - k];
+ 	speclog[28] := 1; {:131}
+ {138:}
+ 	specatan[1] := 27855475;
+ 	specatan[2] := 14718068;
+ 	specatan[3] := 7471121;
+ 	specatan[4] := 3750058;
+ 	specatan[5] := 1876857;
+ 	specatan[6] := 938658;
+ 	specatan[7] := 469357;
+ 	specatan[8] := 234682;
+ 	specatan[9] := 117342;
+ 	specatan[10] := 58671;
+ 	specatan[11] := 29335;
+ 	specatan[12] := 14668;
+ 	specatan[13] := 7334;
+ 	specatan[14] := 3667;
+ 	specatan[15] := 1833;
+ 	specatan[16] := 917;
+ 	specatan[17] := 458;
+ 	specatan[18] := 229;
+ 	specatan[19] := 115;
+ 	specatan[20] := 57;
+ 	specatan[21] := 29;
+ 	specatan[22] := 14;
+ 	specatan[23] := 7;
+ 	specatan[24] := 4;
+ 	specatan[25] := 2;
+ 	specatan[26] := 1; {:138} {179:}
+ {wasmemend:=-30000;waslomax:=-30000;washimin:=memmax;panicking:=false;}
+ {:179}
+ 	{191:}
+ 	for k := 1 to 40 do 
+ 	    internal[k] := 0;
+ 	intptr := 40; {:191} {199:}
+ 	for k := 48 to 57 do 
+ 	    charclass[k] := 0;
+ 	charclass[46] := 1;
+ 	charclass[32] := 2;
+ 	charclass[37] := 3;
+ 	charclass[34] := 4;
+ 	charclass[44] := 5;
+ 	charclass[59] := 6;
+ 	charclass[40] := 7;
+ 	charclass[41] := 8;
+ 	for k := 65 to 90 do 
+ 	    charclass[k] := 9;
+ 	for k := 97 to 122 do 
+ 	    charclass[k] := 9;
+ 	charclass[95] := 9;
+ 	charclass[60] := 10;
+ 	charclass[61] := 10;
+ 	charclass[62] := 10;
+ 	charclass[58] := 10;
+ 	charclass[124] := 10;
+ 	charclass[96] := 11;
+ 	charclass[39] := 11;
+ 	charclass[43] := 12;
+ 	charclass[45] := 12;
+ 	charclass[47] := 13;
+ 	charclass[42] := 13;
+ 	charclass[92] := 13;
+ 	charclass[33] := 14;
+ 	charclass[63] := 14;
+ 	charclass[35] := 15;
+ 	charclass[38] := 15;
+ 	charclass[64] := 15;
+ 	charclass[36] := 15;
+ 	charclass[94] := 16;
+ 	charclass[126] := 16;
+ 	charclass[91] := 17;
+ 	charclass[93] := 18;
+ 	charclass[123] := 19;
+ 	charclass[125] := 19;
+ 	for k := 0 to 31 do 
+ 	    charclass[k] := 20;
+ 	charclass[127] := 20;
+ 	charclass[9] := 2;
+ 	charclass[12] := 2; {:199} {202:}
+ 	hash[1].lh := 0;
+ 	hash[1].rh := 0;
+ 	eqtb[1].lh := 41;
+ 	eqtb[1].rh := -30000;
+ 	for k := 2 to 2241 do begin
+ 	    hash[k] := hash[1];
+ 	    eqtb[k] := eqtb[1]
+ 	end; {:202} {231:}
+ 	bignodesize[13] := 12;
+ 	bignodesize[14] := 4;
+ {:231}
+ 	{251:}
+ 	saveptr := -30000; {:251} {396:}
+ 	octantdir[1] := 415;
+ 	octantdir[5] := 416;
+ 	octantdir[6] := 417;
+ 	octantdir[2] := 418;
+ 	octantdir[4] := 419;
+ 	octantdir[8] := 420;
+ 	octantdir[7] := 421;
+ 	octantdir[3] := 422; {:396} {428:}
+ 	maxroundingptr := 0; {:428} {449:}
+ 	octantcode[1] := 1;
+ 	octantcode[2] := 5;
+ 	octantcode[3] := 6;
+ 	octantcode[4] := 2;
+ 	octantcode[5] := 4;
+ 	octantcode[6] := 8;
+ 	octantcode[7] := 7;
+ 	octantcode[8] := 3;
+ 	for k := 1 to 8 do 
+ 	    octantnumber[octantcode[k]] := k; {:449} {456:}
+ 	revturns := false; {:456} {462:}
+ 	xcorr[1] := 0;
+ 	ycorr[1] := 0;
+ 	xycorr[1] := 0;
+ 	xcorr[5] := 0;
+ 	ycorr[5] := 0;
+ 	xycorr[5] := 1;
+ 	xcorr[6] := -1;
+ 	ycorr[6] := 1;
+ 	xycorr[6] := 0;
+ 	xcorr[2] := 1;
+ 	ycorr[2] := 0;
+ 	xycorr[2] := 1;
+ 	xcorr[4] := 0;
+ 	ycorr[4] := 1;
+ 	xycorr[4] := 1;
+ 	xcorr[8] := 0;
+ 	ycorr[8] := 1;
+ 	xycorr[8] := 0;
+ 	xcorr[7] := 1;
+ 	ycorr[7] := 0;
+ 	xycorr[7] := 1;
+ 	xcorr[3] := -1;
+ 	ycorr[3] := 1;
+ 	xycorr[3] := 0;
+ 	for k := 1 to 8 do 
+ 	    zcorr[k] := xycorr[k] - xcorr[k]; {:462} {570:}
+ 	screenstarted := false;
+ 	screenOK := false; {:570} {573:}
+ 	for k := 0 to 15 do begin
+ 	    windowopen[k] := false;
+ 	    windowtime[k] := 0
+ 	end; {:573}
+ {593:}
+ 	fixneeded := false;
+ 	watchcoefs := true; {:593} {739:}
+ 	condptr := -30000;
+ 	iflimit := 0;
+ 	curif := 0;
+ 	ifline := 0; {:739} {753:}
+ 	loopptr := -30000; {:753} {776:}
+ 	MFbasedefault := 'plain.base'; {:776} {797:}
+ 	curexp := 0; {:797} {822:}
+ 	varflag := 0; {:822} {1078:}
+ 	startsym := 0; {:1078} {1085:}
+ 	longhelpseen := false;
+ {:1085}
+ 	{1097:}
+ 	for k := 0 to 255 do begin
+ 	    tfmwidth[k] := 0;
+ 	    tfmheight[k] := 0;
+ 	    tfmdepth[k] := 0;
+ 	    tfmitalcorr[k] := 0;
+ 	    charexists[k] := false;
+ 	    chartag[k] := 0;
+ 	    charremainder[k] := 0
+ 	end;
+ 	for k := 1 to headersize do 
+ 	    headerbyte[k] := -1;
+ 	bc := 255;
+ 	ec := 0;
+ 	nl := 0;
+ 	nk := 0;
+ 	ne := 0;
+ 	np := 0; {:1097} {1150:}
+ 	gfprevptr := 0;
+ 	totalchars := 0; {:1150} {1153:}
+ 	halfbuf := gfbufsize div 2;
+ 	gflimit := gfbufsize;
+ 	gfptr := 0;
+ 	gfoffset := 0; {:1153} {1184:}
+ 	baseident := 0; {:1184} {1215:}
+ 	editnamestart := 0
+     end; {:1215} {57:}
+ 
+     procedure println;
+     begin
+ 	case selector of
+ 	    3:
+ 		begin
+ 		    writeln(output);
+ 		    writeln(logfile);
+ 		    termoffset := 0;
+ 		    fileoffset := 0
+ 		end;
+ 	    2:
+ 		begin
+ 		    writeln(logfile);
+ 		    fileoffset := 0
+ 		end;
+ 	    1:
+ 		begin
+ 		    writeln(output);
+ 		    termoffset := 0
+ 		end;
+ 	    0, 4, 5:
+ 	end
+     end; {:57} {58:}
+ 
+     procedure printchar(s: ASCIIcode);
+     var tmp : integer;
+     begin
+ 	case selector of
+ 	    3:
+ 		begin
+ 		    {----------------------------------}
+ 		     if xchr[s] = '[' then 
+ 		     begin
+ 			ascii_on := true;
+ 			ascval := 0;
+                      end
+ 		     else if xchr[s] = ']' then 
+ 		     begin
+ 			ascii_on := false;
+ 			sendascii(ascval);
+                      end
+ 		     else if ascii_on then 
+ 		     begin
+ 			tmp := s - ord('0');
+ 			ascval := ascval*10+tmp;
+                      end;
+                     {-------------------------------------}
+ 		    write(output, xchr[s]);
+ 		    write(logfile, xchr[s]);
+ 		    termoffset := termoffset + 1;
+ 		    fileoffset := fileoffset + 1;
+ 		    if termoffset = maxprintline then begin
+ 			writeln(output);
+ 			termoffset := 0
+ 		    end;
+ 		    if fileoffset = maxprintline then begin
+ 			writeln(logfile);
+ 			fileoffset := 0
+ 		    end
+ 		end;
+ 	    2:
+ 		begin
+ 		    write(logfile, xchr[s]);
+ 		    fileoffset := fileoffset + 1;
+ 		    if fileoffset = maxprintline then 
+ 			println
+ 		end;
+ 	    1:
+ 		begin
+ 		    write(output, xchr[s]);
+ 		    termoffset := termoffset + 1;
+ 		    if termoffset = maxprintline then 
+ 			println
+ 		end;
+ 	    0:
+ 		;
+ 	    4:
+ 		if tally < trickcount then 
+ 		    trickbuf[tally mod errorline] := s;
+ 	    5:
+ 		begin
+ 		    if poolptr < poolsize then begin
+ 			strpool[poolptr] := s;
+ 			poolptr := poolptr + 1
+ 		    end
+ 		end
+ 	end;
+ 	tally := tally + 1
+     end; {:58} {59:}
+ 
+     procedure print(s: integer);
+     var
+ 	j: poolpointer;
+     begin
+ 	if (s < 0) or (s >= strptr) then 
+ 	    s := 131;
+ 	j := strstart[s];
+ 	while j < strstart[s + 1] do begin
+ 	    printchar(strpool[j]);
+ 	    j := j + 1
+ 	end
+     end; {:59}
+ {60:}
+ 
+     procedure slowprint(s: integer);
+     var
+ 	j: poolpointer;
+     begin
+ 	if (s < 0) or (s >= strptr) then 
+ 	    s := 131;
+ 	j := strstart[s];
+ 	while j < strstart[s + 1] do begin
+ 	    print(strpool[j]);
+ 	    j := j + 1
+ 	end
+     end; {:60}
+ {62:}
+ 
+     procedure printnl(s: strnumber);
+     begin
+ 	if ((termoffset > 0) and odd(selector)) or ((fileoffset > 0) and (selector >= 2)) then 
+ 	    println;
+ 	print(s)
+     end; {:62} {63:}
+ 
+     procedure printthedigs(k: eightbits);
+     begin
+ 	while k > 0 do begin
+ 	    k := k - 1;
+ 	    printchar(48 + dig[k])
+ 	end
+     end; {:63} {64:}
+ 
+     procedure printint(n: integer);
+     var
+ 	k: 0..23;
+ 	m: integer;
+     begin
+ 	k := 0;
+ 	if n < 0 then begin
+ 	    printchar(45);
+ 	    if n > (-100000000) then 
+ 		n := -n
+ 	    else begin
+ 		m := (-1) - n;
+ 		n := m div 10;
+ 		m := (m mod 10) + 1;
+ 		k := 1;
+ 		if m < 10 then 
+ 		    dig[0] := m
+ 		else begin
+ 		    dig[0] := 0;
+ 		    n := n + 1
+ 		end
+ 	    end
+ 	end;
+ 	repeat
+ 	    dig[k] := n mod 10;
+ 	    n := n div 10;
+ 	    k := k + 1
+ 	until n = 0;
+ 	printthedigs(k)
+     end; {:64} {103:}
+ 
+     procedure printscaled(s: scaled);
+     var
+ 	delta: scaled;
+     begin
+ 	if s < 0 then begin
+ 	    printchar(45);
+ 	    s := -s
+ 	end;
+ 	printint(s div 65536);
+ 	s := (10 * (s mod 65536)) + 5;
+ 	if s <> 5 then begin
+ 	    delta := 10;
+ 	    printchar(46);
+ 	    repeat
+ 		if delta > 65536 then 
+ 		    s := (s + 32768) - (delta div 2);
+ 		printchar(48 + (s div 65536));
+ 		s := 10 * (s mod 65536);
+ 		delta := delta * 10
+ 	    until s <= delta
+ 	end
+     end; {:103} {104:}
+ 
+     procedure printtwo(x, y: scaled);
+     begin
+ 	printchar(40);
+ 	printscaled(x);
+ 	printchar(44);
+ 	printscaled(y);
+ 	printchar(41)
+     end; {:104} {187:}
+ 
+     procedure printtype(t: smallnumber);
+     begin
+ 	if t in
+ 	    [1, 2, 3, 4, 5, 6, 7, 8,
+ 	     9, 10, 11, 12, 13, 14, 16, 17,
+ 	     18, 15, 19, 20, 21, 22, 23] then
+ 	    case t of
+ 		1:
+ 		    print(194);
+ 		2:
+ 		    print(195);
+ 		3:
+ 		    print(196);
+ 		4:
+ 		    print(197);
+ 		5:
+ 		    print(198);
+ 		6:
+ 		    print(199);
+ 		7:
+ 		    print(200);
+ 		8:
+ 		    print(201);
+ 		9:
+ 		    print(202);
+ 		10:
+ 		    print(203);
+ 		11:
+ 		    print(204);
+ 		12:
+ 		    print(205);
+ 		13:
+ 		    print(206);
+ 		14:
+ 		    print(207);
+ 		16:
+ 		    print(208);
+ 		17:
+ 		    print(209);
+ 		18:
+ 		    print(210);
+ 		15:
+ 		    print(211);
+ 		19:
+ 		    print(212);
+ 		20:
+ 		    print(213);
+ 		21:
+ 		    print(214);
+ 		22:
+ 		    print(215);
+ 		23:
+ 		    print(216)
+ 	    end
+ 	else
+ 	    print(217)
+     end; {:187} {195:}
+ 
+     procedure begindiagnostic;
+     begin
+ 	oldsetting := selector;
+ 	if (internal[13] <= 0) and (selector = 3) then begin
+ 	    selector := selector - 1;
+ 	    if history = 0 then 
+ 		history := 1
+ 	end
+     end; { begindiagnostic }
+ 
+     procedure enddiagnostic(blankline: boolean);
+     begin
+ 	printnl(155);
+ 	if blankline then 
+ 	    println;
+ 	selector := oldsetting
+     end; {:195} {197:}
+ 
+     procedure printdiagnostic(s, t: strnumber; nuline: boolean);
+     begin
+ 	begindiagnostic;
+ 	if nuline then 
+ 	    printnl(s)
+ 	else 
+ 	    print(s);
+ 	print(320);
+ 	printint(line);
+ 	print(t);
+ 	printchar(58)
+     end; {:197} {773:}
+ 
+     procedure printfilename(n, a, e: integer);
+     begin
+ 	print(a);
+ 	print(n);
+ 	print(e)
+     end; {:773} {73:}
+ 
+     procedure normalizeselector;
+     forward;
+ 
+     procedure getnext;
+     forward;
+ 
+     procedure terminput;
+     forward;
+ 
+     procedure showcontext;
+     forward;
+ 
+     procedure beginfilereading;
+     forward;
+ 
+     procedure openlogfile;
+     forward;
+ 
+     procedure closefilesandtermina;
+     forward;
+ 
+     procedure clearforerrorprompt;
+     forward; {procedure debughelp;forward;} {43:}
+ 
+     procedure flushstring(s: strnumber);
+     begin
+ 	if s < (strptr - 1) then 
+ 	    strref[s] := 0
+ 	else 
+ 	    repeat
+ 		strptr := strptr - 1
+ 	    until strref[strptr - 1] <> 0;
+ 	poolptr := strstart[strptr]
+     end; {:43} {:73} {76:}
+ 
+     procedure jumpout;
+     begin
+ 	goto 9998
+     end; {:76} {77:}
+ 
+     procedure error;
+     label
+ 	22, 10;
+     var
+ 	c: ASCIIcode;
+ 	s1, s2, s3: integer;
+ 	j: poolpointer;
+     begin
+ 	if history < 2 then 
+ 	    history := 2;
+ 	printchar(46);
+ 	showcontext;
+ 	if interaction = 3 then  {78:}
+ 	    while true do begin
+     22:
+ 		clearforerrorprompt;
+ 		begin
+ 		    print(135);
+ 		    terminput
+ 		end;
+ 		if last = first then 
+ 		    goto 10;
+ 		c := buffer[first];
+ 		if c >= 97 then 
+ 		    c := c - 32; {79:}
+ 		if c in
+ 		    [48, 49, 50, 51, 52, 53, 54, 55,
+ 		     56, 57, 69, 72, 73, 81, 82, 83,
+ 		     88] then
+ 		    case c of
+ 			48, 49, 50, 51, 52, 53, 54,
+ 			55, 56, 57:
+ 			    if deletionsallowed then begin {83:}
+ 				s1 := curcmd;
+ 				s2 := curmod;
+ 				s3 := cursym;
+ 				OKtointerrupt := false;
+ 				if ((last > (first + 1)) and (buffer[first + 1] >= 48)) and (buffer[first + 1] <= 57) then 
+ 				    c := ((c * 10) + buffer[first + 1]) - (48 * 11)
+ 				else 
+ 				    c := c - 48;
+ 				while c > 0 do begin
+ 				    getnext;
+ {743:}
+ 				    if curcmd = 39 then begin
+ 					if strref[curmod] < 127 then 
+ 					    if strref[curmod] > 1 then 
+ 						strref[curmod] := strref[curmod] - 1
+ 					    else 
+ 						flushstring(curmod)
+ 				    end {:743};
+ 				    c := c - 1
+ 				end;
+ 				curcmd := s1;
+ 				curmod := s2;
+ 				cursym := s3;
+ 				OKtointerrupt := true;
+ 				begin
+ 				    helpptr := 2;
+ 				    helpline[1] := 148;
+ 				    helpline[0] := 149
+ 				end;
+ 				showcontext;
+ 				goto 22
+ 			    end {:83}; {68:begin debughelp;goto 22;end;}
+ 			69:
+ 			    if fileptr > 0 then begin
+ 				editnamestart := strstart[inputstack[fileptr].namefield];
+ 				editnamelength := strstart[inputstack[fileptr].namefield + 1] - strstart[inputstack[fileptr].namefield];
+ 				editline := line;
+ 				jumpout
+ 			    end;
+ 			72:
+ 			    begin {84:}
+ 				if useerrhelp then begin {85:}
+ 				    j := strstart[errhelp];
+ 				    while j < strstart[errhelp + 1] do begin
+ 					if strpool[j] <> 37 then 
+ 					    print(strpool[j])
+ 					else if (j + 1) = strstart[errhelp + 1] then 
+ 					    println
+ 					else if strpool[j + 1] <> 37 then 
+ 					    println
+ 					else begin
+ 					    j := j + 1;
+ 					    printchar(37)
+ 					end;
+ 					j := j + 1
+ 				    end {:85};
+ 				    useerrhelp := false
+ 				end else begin
+ 				    if helpptr = 0 then begin
+ 					helpptr := 2;
+ 					helpline[1] := 150;
+ 					helpline[0] := 151
+ 				    end;
+ 				    repeat
+ 					helpptr := helpptr - 1;
+ 					print(helpline[helpptr]);
+ 					println
+ 				    until helpptr = 0
+ 				end;
+ 				begin
+ 				    helpptr := 4;
+ 				    helpline[3] := 152;
+ 				    helpline[2] := 151;
+ 				    helpline[1] := 153;
+ 				    helpline[0] := 154
+ 				end;
+ 				goto 22
+ 			    end; {:84}
+ 			73:
+ 			    begin {82:}
+ 				beginfilereading;
+ 				if last > (first + 1) then begin
+ 				    curinput.locfield := first + 1;
+ 				    buffer[first] := 32
+ 				end else begin
+ 				    begin
+ 					print(147);
+ 					terminput
+ 				    end;
+ 				    curinput.locfield := first
+ 				end;
+ 				first := last + 1;
+ 				curinput.limitfield := last;
+ 				goto 10
+ 			    end; {:82}
+ 			81, 82, 83:
+ 			    begin {81:}
+ 				errorcount := 0;
+ 				interaction := (0 + c) - 81;
+ 				print(142);
+ 				case c of
+ 				    81:
+ 					begin
+ 					    print(143);
+ 					    selector := selector - 1
+ 					end;
+ 				    82:
+ 					print(144);
+ 				    83:
+ 					print(145)
+ 				end;
+ 				print(146);
+ 				println;
+ 				flush(output);
+ 				goto 10
+ 			    end; {:81}
+ 			88:
+ 			    begin
+ 				interaction := 2;
+ 				jumpout
+ 			    end
+ 		    end
+ 		else
+ 		    ; {80:}
+ 		begin
+ 		    print(136);
+ 		    printnl(137);
+ 		    printnl(138);
+ 		    if fileptr > 0 then 
+ 			print(139);
+ 		    if deletionsallowed then 
+ 			printnl(140);
+ 		    printnl(141)
+ 		end {:80} {:79}
+ 	    end {:78};
+ 	errorcount := errorcount + 1;
+ 	if errorcount = 100 then begin
+ 	    printnl(134);
+ 	    history := 3;
+ 	    jumpout
+ 	end; {86:}
+ 	if interaction > 0 then 
+ 	    selector := selector - 1;
+ 	if useerrhelp then begin
+ 	    printnl(155); {85:}
+ 	    j := strstart[errhelp];
+ 	    while j < strstart[errhelp + 1] do begin
+ 		if strpool[j] <> 37 then 
+ 		    print(strpool[j])
+ 		else if (j + 1) = strstart[errhelp + 1] then 
+ 		    println
+ 		else if strpool[j + 1] <> 37 then 
+ 		    println
+ 		else begin
+ 		    j := j + 1;
+ 		    printchar(37)
+ 		end;
+ 		j := j + 1
+ 	    end {:85}
+ 	end else 
+ 	    while helpptr > 0 do begin
+ 		helpptr := helpptr - 1;
+ 		printnl(helpline[helpptr])
+ 	    end;
+ 	println;
+ 	if interaction > 0 then 
+ 	    selector := selector + 1; {:86}
+ 	println;
+     10:
+ 	
+     end; {:77}
+ {88:}
+ 
+     procedure fatalerror(s: strnumber);
+     begin
+ 	normalizeselector;
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(156)
+ 	end;
+ 	begin
+ 	    helpptr := 1;
+ 	    helpline[0] := s
+ 	end;
+ 	begin
+ 	    if interaction = 3 then 
+ 		interaction := 2;
+ 	    error;
+ {if interaction>0 then debughelp;}
+ 	    history := 3;
+ 	    jumpout
+ 	end
+     end; {:88} {89:}
+ 
+     procedure overflow(s: strnumber; n: integer);
+     begin
+ 	normalizeselector;
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(157)
+ 	end;
+ 	print(s);
+ 	printchar(61);
+ 	printint(n);
+ 	printchar(93);
+ 	begin
+ 	    helpptr := 2;
+ 	    helpline[1] := 158;
+ 	    helpline[0] := 159
+ 	end;
+ 	begin
+ 	    if interaction = 3 then 
+ 		interaction := 2;
+ 	    error;
+ {if interaction>0 then debughelp;}
+ 	    history := 3;
+ 	    jumpout
+ 	end
+     end; {:89} {90:}
+ 
+     procedure confusion;
+     begin
+ 	normalizeselector;
+ 	if history < 2 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(160)
+ 	    end;
+ 	    print(s);
+ 	    printchar(41);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 161
+ 	    end
+ 	end else begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(162)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 163;
+ 		helpline[0] := 164
+ 	    end
+ 	end;
+ 	begin
+ 	    if interaction = 3 then 
+ 		interaction := 2;
+ 	    error;
+ {if interaction>0 then debughelp;}
+ 	    history := 3;
+ 	    jumpout
+ 	end
+     end; {:90} {:4}
+ 
+ 
+ {26:}
+ 
+     function aopenin(var f: alphafile; pathspecifier: integer): boolean;
+     var
+ 	ok: boolean;
+     begin
+ 	if testaccess(nameoffile, realnameoffile, 4, pathspecifier) then begin
+ 	    reset(f, realnameoffile);
+ 	    ok := true
+ 	end else 
+ 	    ok := false;
+ 	aopenin := ok
+     end; { aopenin }
+ 
+     function aopenout(var f: alphafile): boolean;
+     var
+ 	ok: boolean;
+     begin
+ 	if testaccess(nameoffile, realnameoffile, 2, 0) then begin
+ 	    rewrite(f, realnameoffile);
+ 	    ok := true
+ 	end else 
+ 	    ok := false;
+ 	aopenout := ok
+     end; { aopenout }
+ 
+     function wopenin(var f: wordfile): boolean;
+     var
+ 	ok: boolean;
+     begin
+ 	if testaccess(nameoffile, realnameoffile, 4, 7) then begin
+ 	    reset(f, realnameoffile);
+ 	    ok := true
+ 	end else 
+ 	    ok := false;
+ 	wopenin := ok
+     end; { wopenin }
+ 
+     function wopenout(var f: wordfile): boolean;
+     var
+ 	ok: boolean;
+     begin
+ 	if testaccess(nameoffile, realnameoffile, 2, 0) then begin
+ 	    rewrite(f, nameoffile);
+ 	    ok := true
+ 	end else 
+ 	    ok := false;
+ 	wopenout := ok
+     end; {:26} {27:}
+ 
+     procedure aclose(var f: alphafile);
+     begin
+ 	closea(f)
+     end; { aclose }
+ 
+     procedure wclose(var f: wordfile);
+     begin
+ 	closew(f)
+     end; {:27} {30:}
+ 
+     function inputln(var f: alphafile; bypasseoln: boolean): boolean;
+     var
+ 	lastnonblank: 0..bufsize;
+     begin
+ 	if bypasseoln then 
+ 	    if not eof(f) then 
+ 		if eoln(f) then 
+ 		    get(f);
+ 	last := first;
+ 	if eof(f) then 
+ 	    inputln := false
+ 	else begin
+ 	    lastnonblank := first;
+ 	    while not eoln(f) do begin
+ 		if last >= maxbufstack then begin
+ 		    maxbufstack := last + 1;
+ 		    if maxbufstack = bufsize then 
+ 			overflow(128, bufsize)
+ 		end;
+ 		buffer[last] := xord[f^];
+ 		get(f);
+ 		last := last + 1;
+ 		if buffer[last - 1] <> 32 then 
+ 		    lastnonblank := last
+ 	    end;
+ 	    last := lastnonblank;
+ 	    inputln := true
+ 	end
+     end; {:30} {36:}
+ 
+     function initterminal: boolean;
+     label
+ 	10;
+     var
+ 	dummy, i, j, k: integer;
+ 	arg: packed array [1..100] of char;
+     begin
+ 	if argc > 1 then begin
+ 	    last := first;
+ 	    for i := 1 to argc - 1 do begin
+ 		argv(i, arg);
+ 		j := 1;
+ 		k := 100;
+ 		while (k > 1) and (arg[k] = ' ') do 
+ 		    k := k - 1;
+ 		while j <= k do begin
+ 		    buffer[last] := xord[arg[j]];
+ 		    j := j + 1;
+ 		    last := last + 1
+ 		end;
+ 		if k > 1 then begin
+ 		    buffer[last] := xord[' '];
+ 		    last := last + 1
+ 		end
+ 	    end;
+ 	    if last > first then begin
+ 		curinput.locfield := first;
+ 		initterminal := true;
+ 		goto 10
+ 	    end
+ 	end;
+ 	while true do begin
+ 	    write(output, '**');
+ 	    flush(output);
+ 	    if not inputln(input, true) then begin
+ 		writeln(output);
+ 		writeln(output, '! End of file on the terminal... why?');
+ 		initterminal := false;
+ 		goto 10
+ 	    end;
+ 	    curinput.locfield := first;
+ 	    while (curinput.locfield < last) and (buffer[curinput.locfield] = 32) do 
+ 		curinput.locfield := curinput.locfield + 1;
+ 	    if curinput.locfield < last then begin
+ 		initterminal := true;
+ 		goto 10
+ 	    end;
+ 	    writeln(output, 'Please type the name of your input file.')
+ 	end;
+     10:
+ 	
+     end; { initterminal }
+ {:36}
+     {44:}
+ 
+     function makestring: strnumber;
+     begin
+ 	if strptr = maxstrptr then begin
+ 	    if strptr = maxstrings then 
+ 		overflow(130, maxstrings - initstrptr);
+ 	    maxstrptr := maxstrptr + 1
+ 	end;
+ 	strref[strptr] := 1;
+ 	strptr := strptr + 1;
+ 	strstart[strptr] := poolptr;
+ 	makestring := strptr - 1
+     end; { makestring }
+ {:44}
+     {45:}
+ 
+     function streqbuf(s: strnumber; k: integer): boolean;
+     label
+ 	45;
+     var
+ 	j: poolpointer;
+ 	result: boolean;
+     begin
+ 	j := strstart[s];
+ 	while j < strstart[s + 1] do begin
+ 	    if strpool[j] <> buffer[k] then begin
+ 		result := false;
+ 		goto 45
+ 	    end;
+ 	    j := j + 1;
+ 	    k := k + 1
+ 	end;
+ 	result := true;
+     45:
+ 	streqbuf := result
+     end; {:45} {46:}
+ 
+     function strvsstr(s, t: strnumber): integer;
+     label
+ 	10;
+     var
+ 	j, k: poolpointer;
+ 	ls, lt: integer;
+ 	l: integer;
+     begin
+ 	ls := strstart[s + 1] - strstart[s];
+ 	lt := strstart[t + 1] - strstart[t];
+ 	if ls <= lt then 
+ 	    l := ls
+ 	else 
+ 	    l := lt;
+ 	j := strstart[s];
+ 	k := strstart[t];
+ 	while l > 0 do begin
+ 	    if strpool[j] <> strpool[k] then begin
+ 		strvsstr := strpool[j] - strpool[k];
+ 		goto 10
+ 	    end;
+ 	    j := j + 1;
+ 	    k := k + 1;
+ 	    l := l - 1
+ 	end;
+ 	strvsstr := ls - lt;
+     10:
+ 	
+     end; {:46} {47:}
+     {function getstringsstarted:boolean;label 30,10;
+     var k,l:0..127;m,n:char;g:strnumber;a:integer;c:boolean;
+     begin poolptr:=0;strptr:=0;maxpoolptr:=0;maxstrptr:=0;strstart[0]:=0;
+     [48:]for k:=0 to 127 do begin if([49:](k<32)or(k>126)[:49])then begin
+     begin strpool[poolptr]:=94;poolptr:=poolptr+1;end;
+     begin strpool[poolptr]:=94;poolptr:=poolptr+1;end;
+     if k<64 then begin strpool[poolptr]:=k+64;poolptr:=poolptr+1;
+     end else begin strpool[poolptr]:=k-64;poolptr:=poolptr+1;end;
+     end else begin strpool[poolptr]:=k;poolptr:=poolptr+1;end;g:=makestring;
+     strref[g]:=127;end[:48];[51:]nameoffile:=poolname;
+     if aopenin(poolfile,8)then begin c:=false;
+     repeat[52:]begin if eof(poolfile)then begin;
+     writeln(output,'! mf.pool has no check sum.');aclose(poolfile);
+     getstringsstarted:=false;goto 10;end;read(poolfile,m,n);
+     if m='*'then[53:]begin a:=0;k:=1;
+     while true do begin if(xord[n]<48)or(xord[n]>57)then begin;
+     writeln(output,'! mf.pool check sum doesn''t have nine digits.');
+     aclose(poolfile);getstringsstarted:=false;goto 10;end;
+     a:=10*a+xord[n]-48;if k=9 then goto 30;k:=k+1;read(poolfile,n);end;
+     30:if a<>503742536 then begin;
+     writeln(output,'! mf.pool doesn''t match; tangle me again.');
+     aclose(poolfile);getstringsstarted:=false;goto 10;end;c:=true;
+     end[:53]else begin if(xord[m]<48)or(xord[m]>57)or(xord[n]<48)or(xord[n]>
+     57)then begin;
+     writeln(output,'! mf.pool line doesn''t begin with two digits.');
+     aclose(poolfile);getstringsstarted:=false;goto 10;end;
+     l:=xord[m]*10+xord[n]-48*11;
+     if poolptr+l+stringvacancies>poolsize then begin;
+     writeln(output,'! You have to increase POOLSIZE.');aclose(poolfile);
+     getstringsstarted:=false;goto 10;end;
+     for k:=1 to l do begin if eoln(poolfile)then m:=' 'else read(poolfile,m)
+     ;begin strpool[poolptr]:=xord[m];poolptr:=poolptr+1;end;end;
+     readln(poolfile);g:=makestring;strref[g]:=127;end;end[:52];until c;
+     aclose(poolfile);getstringsstarted:=true;end else begin;
+     writeln(output,'! I can''t read mf.pool.');aclose(poolfile);
+     getstringsstarted:=false;goto 10;end[:51];10:end;}
+     {:47}
+     {65:}
+ 
+     procedure printdd(n: integer);
+     begin
+ 	n := abs(n) mod 100;
+ 	printchar(48 + (n div 10));
+ 	printchar(48 + (n mod 10))
+     end; {:65} {66:}
+ 
+     procedure terminput;
+     var
+ 	k: 0..bufsize;
+     begin
+ 	flush(output);
+ 	if not inputln(input, true) then 
+ 	    fatalerror(132);
+ 	termoffset := 0;
+ 	selector := selector - 1;
+ 	if last <> first then 
+ 	    for k := first to last - 1 do 
+ 		print(buffer[k]);
+ 	println;
+ 	buffer[last] := 37;
+ 	selector := selector + 1
+     end; {:66} {87:}
+ 
+     procedure normalizeselector;
+     begin
+ 	if jobname > 0 then 
+ 	    selector := 3
+ 	else 
+ 	    selector := 1;
+ 	if jobname = 0 then 
+ 	    openlogfile;
+ 	if interaction = 0 then 
+ 	    selector := selector - 1
+     end; {:87} {93:}
+ 
+     procedure pauseforinstructions;
+     begin
+ 	if OKtointerrupt then begin
+ 	    interaction := 3;
+ 	    if (selector = 2) or (selector = 0) then 
+ 		selector := selector + 1;
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(165)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 166;
+ 		helpline[1] := 167;
+ 		helpline[0] := 168
+ 	    end;
+ 	    deletionsallowed := false;
+ 	    error;
+ 	    deletionsallowed := true;
+ 	    interrupt := 0
+ 	end
+     end; {:93} {94:}
+ 
+     procedure missingerr(s: strnumber);
+     begin
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(169)
+ 	end;
+ 	print(s);
+ 	print(170)
+     end; {:94} {99:}
+ 
+     procedure cleararith;
+     begin
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(171)
+ 	end;
+ 	begin
+ 	    helpptr := 4;
+ 	    helpline[3] := 172;
+ 	    helpline[2] := 173;
+ 	    helpline[1] := 174;
+ 	    helpline[0] := 175
+ 	end;
+ 	error;
+ 	aritherror := false
+     end; {:99} {100:}
+ 
+     function slowadd(x, y: integer): integer;
+     begin
+ 	if x >= 0 then 
+ 	    if y <= (2147483647 - x) then 
+ 		slowadd := x + y
+ 	    else begin
+ 		aritherror := true;
+ 		slowadd := 2147483647
+ 	    end
+ 	else if (-y) <= (2147483647 + x) then 
+ 	    slowadd := x + y
+ 	else begin
+ 	    aritherror := true;
+ 	    slowadd := -2147483647
+ 	end
+     end; {:100} {102:}
+ 
+     function rounddecimals(k: smallnumber): scaled;
+     var
+ 	a: integer;
+     begin
+ 	a := 0;
+ 	while k > 0 do begin
+ 	    k := k - 1;
+ 	    a := (a + (dig[k] * 131072)) div 10
+ 	end;
+ 	rounddecimals := (a + 1) div 2
+     end; {:102} {112:}
+ 
+     function takescaled(q: integer; f: scaled): integer;
+     var
+ 	p: integer;
+ 	negative: boolean;
+ 	n: integer;
+ 	becareful: integer; {110:}
+     begin
+ 	if f >= 0 then 
+ 	    negative := false
+ 	else begin
+ 	    f := -f;
+ 	    negative := true
+ 	end;
+ 	if q < 0 then begin
+ 	    q := -q;
+ 	    negative := not negative
+ 	end; {:110}
+ 	if f < 65536 then 
+ 	    n := 0
+ 	else begin
+ 	    n := f div 65536;
+ 	    f := f mod 65536;
+ 	    if q <= (2147483647 div n) then 
+ 		n := n * q
+ 	    else begin
+ 		aritherror := true;
+ 		n := 2147483647
+ 	    end
+ 	end;
+ 	f := f + 65536; {113:}
+ 	p := 32768;
+ 	if q < 1073741824 then 
+ 	    repeat
+ 		if odd(f) then 
+ 		    p := (p + q) div 2
+ 		else 
+ 		    p := p div 2;
+ 		f := f div 2
+ 	    until f = 1
+ 	else 
+ 	    repeat
+ 		if odd(f) then 
+ 		    p := p + ((q - p) div 2)
+ 		else 
+ 		    p := p div 2;
+ 		f := f div 2
+ 	    until f = 1 {:113};
+ 	becareful := n - 2147483647;
+ 	if (becareful + p) > 0 then begin
+ 	    aritherror := true;
+ 	    n := 2147483647 - p
+ 	end;
+ 	if negative then 
+ 	    takescaled := -(n + p)
+ 	else 
+ 	    takescaled := n + p
+     end; {:112} {114:}
+ 
+     function makescaled(p, q: integer): scaled;
+     var
+ 	f: integer;
+ 	n: integer;
+ 	negative: boolean;
+ 	becareful: integer;
+     begin
+ 	if p >= 0 then 
+ 	    negative := false
+ 	else begin
+ 	    p := -p;
+ 	    negative := true
+ 	end;
+ 	if q <= 0 then begin {if q=0 then confusion(47);}
+ 	    q := -q;
+ 	    negative := not negative
+ 	end;
+ 	n := p div q;
+ 	p := p mod q;
+ 	if n >= 32768 then begin
+ 	    aritherror := true;
+ 	    if negative then 
+ 		makescaled := -2147483647
+ 	    else 
+ 		makescaled := 2147483647
+ 	end else begin
+ 	    n := (n - 1) * 65536; {115:}
+ 	    f := 1;
+ 	    repeat
+ 		becareful := p - q;
+ 		p := becareful + p;
+ 		if p >= 0 then 
+ 		    f := (f + f) + 1
+ 		else begin
+ 		    f := f + f;
+ 		    p := p + q
+ 		end
+ 	    until f >= 65536;
+ 	    becareful := p - q;
+ 	    if (becareful + p) >= 0 then 
+ 		f := f + 1 {:115};
+ 	    if negative then 
+ 		makescaled := -(f + n)
+ 	    else 
+ 		makescaled := f + n
+ 	end
+     end; {:114}
+ {116:}
+ 
+     function velocity(st, ct, sf, cf: fraction; t: scaled): fraction;
+     var
+ 	acc, num, denom: integer;
+     begin
+ 	acc := takefraction(st - (sf div 16), sf - (st div 16));
+ 	acc := takefraction(acc, ct - cf);
+ 	num := 536870912 + takefraction(acc, 379625062);
+ 	denom := (805306368 + takefraction(ct, 497706707)) + takefraction(cf, 307599661);
+ 	if t <> 65536 then 
+ 	    num := makescaled(num, t);
+ 	if (num div 4) >= denom then 
+ 	    velocity := 1073741824
+ 	else 
+ 	    velocity := makefraction(num, denom)
+     end; {:116} {117:}
+ 
+     function abvscd ;
+     label
+ 	10;
+     var
+ 	q, r: integer; {118:}
+     begin
+ 	if a < 0 then begin
+ 	    a := -a;
+ 	    b := -b
+ 	end;
+ 	if c < 0 then begin
+ 	    c := -c;
+ 	    d := -d
+ 	end;
+ 	if d <= 0 then begin
+ 	    if b >= 0 then 
+ 		if ((a = 0) or (b = 0)) and ((c = 0) or (d = 0)) then begin
+ 		    abvscd := 0;
+ 		    goto 10
+ 		end else begin
+ 		    abvscd := 1;
+ 		    goto 10
+ 		end;
+ 	    if d = 0 then 
+ 		if a = 0 then begin
+ 		    abvscd := 0;
+ 		    goto 10
+ 		end else begin
+ 		    abvscd := -1;
+ 		    goto 10
+ 		end;
+ 	    q := a;
+ 	    a := c;
+ 	    c := q;
+ 	    q := -b;
+ 	    b := -d;
+ 	    d := q
+ 	end else if b <= 0 then begin
+ 	    if b < 0 then 
+ 		if a > 0 then begin
+ 		    abvscd := -1;
+ 		    goto 10
+ 		end;
+ 	    if c = 0 then begin
+ 		abvscd := 0;
+ 		goto 10
+ 	    end else begin
+ 		abvscd := -1;
+ 		goto 10
+ 	    end
+ 	end {:118};
+ 	while true do begin
+ 	    q := a div d;
+ 	    r := c div b;
+ 	    if q <> r then 
+ 		if q > r then begin
+ 		    abvscd := 1;
+ 		    goto 10
+ 		end else begin
+ 		    abvscd := -1;
+ 		    goto 10
+ 		end;
+ 	    q := a mod d;
+ 	    r := c mod b;
+ 	    if r = 0 then 
+ 		if q = 0 then begin
+ 		    abvscd := 0;
+ 		    goto 10
+ 		end else begin
+ 		    abvscd := 1;
+ 		    goto 10
+ 		end;
+ 	    if q = 0 then begin
+ 		abvscd := -1;
+ 		goto 10
+ 	    end;
+ 	    a := b;
+ 	    b := q;
+ 	    c := d;
+ 	    d := r
+ 	end;
+     10:
+ 	
+     end; {:117} {119:}
+ 
+     function floorscaled(x: scaled): scaled;
+     var
+ 	becareful: integer;
+     begin
+ 	if x >= 0 then 
+ 	    floorscaled := x - (x mod 65536)
+ 	else begin
+ 	    becareful := x + 1;
+ 	    floorscaled := (x + ((-becareful) mod 65536)) - 65535
+ 	end
+     end; { floorscaled }
+ 
+     function floorunscaled(x: scaled): integer;
+     var
+ 	becareful: integer;
+     begin
+ 	if x >= 0 then 
+ 	    floorunscaled := x div 65536
+ 	else begin
+ 	    becareful := x + 1;
+ 	    floorunscaled := -(1 + ((-becareful) div 65536))
+ 	end
+     end; { floorunscaled }
+ 
+     function roundunscaled(x: scaled): integer;
+     var
+ 	becareful: integer;
+     begin
+ 	if x >= 32768 then 
+ 	    roundunscaled := 1 + ((x - 32768) div 65536)
+ 	else if x >= (-32768) then 
+ 	    roundunscaled := 0
+ 	else begin
+ 	    becareful := x + 1;
+ 	    roundunscaled := -(1 + (((-becareful) - 32768) div 65536))
+ 	end
+     end; { roundunscaled }
+ 
+     function roundfraction(x: fraction): scaled;
+     var
+ 	becareful: integer;
+     begin
+ 	if x >= 2048 then 
+ 	    roundfraction := 1 + ((x - 2048) div 4096)
+ 	else if x >= (-2048) then 
+ 	    roundfraction := 0
+ 	else begin
+ 	    becareful := x + 1;
+ 	    roundfraction := -(1 + (((-becareful) - 2048) div 4096))
+ 	end
+     end; {:119} {121:}
+ 
+     function squarert(x: scaled): scaled;
+     var
+ 	k: smallnumber;
+ 	y, q: integer;
+     begin
+ 	if x <= 0 then begin {122:}
+ 	    if x < 0 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(176)
+ 		end;
+ 		printscaled(x);
+ 		print(177);
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 178;
+ 		    helpline[0] := 179
+ 		end;
+ 		error
+ 	    end;
+ 	    squarert := 0
+ 	end else begin {:122}
+ 	    k := 23;
+ 	    q := 2;
+ 	    while x < 536870912 do begin
+ 		k := k - 1;
+ 		x := ((x + x) + x) + x
+ 	    end;
+ 	    if x < 1073741824 then 
+ 		y := 0
+ 	    else begin
+ 		x := x - 1073741824;
+ 		y := 1
+ 	    end; {123:}
+ 	    repeat
+ 		x := x + x;
+ 		y := y + y;
+ 		if x >= 1073741824 then begin
+ 		    x := x - 1073741824;
+ 		    y := y + 1
+ 		end;
+ 		x := x + x;
+ 		y := (y + y) - q;
+ 		q := q + q;
+ 		if x >= 1073741824 then begin
+ 		    x := x - 1073741824;
+ 		    y := y + 1
+ 		end;
+ 		if y > q then begin
+ 		    y := y - q;
+ 		    q := q + 2
+ 		end else if y <= 0 then begin
+ 		    q := q - 2;
+ 		    y := y + q
+ 		end;
+ 		k := k - 1 {:123}
+ 	    until k = 0;
+ 	    squarert := q div 2
+ 	end
+     end; {:121}
+ {124:}
+ 
+     function pythadd(a, b: integer): integer;
+     label
+ 	30;
+     var
+ 	r: fraction;
+ 	big: boolean;
+     begin
+ 	a := abs(a);
+ 	b := abs(b);
+ 	if a < b then begin
+ 	    r := b;
+ 	    b := a;
+ 	    a := r
+ 	end;
+ 	if a > 0 then begin
+ 	    if a < 536870912 then 
+ 		big := false
+ 	    else begin
+ 		a := a div 4;
+ 		b := b div 4;
+ 		big := true
+ 	    end; {125:}
+ 	    while true do begin
+ 		r := makefraction(b, a);
+ 		r := takefraction(r, r);
+ 		if r = 0 then 
+ 		    goto 30;
+ 		r := makefraction(r, 1073741824 + r);
+ 		a := a + takefraction(a + a, r);
+ 		b := takefraction(b, r)
+ 	    end;
+     30: {:125}
+ 	    ;
+ 	    if big then 
+ 		if a < 536870912 then 
+ 		    a := ((a + a) + a) + a
+ 		else begin
+ 		    aritherror := true;
+ 		    a := 2147483647
+ 		end
+ 	end;
+ 	pythadd := a
+     end; {:124} {126:}
+ 
+     function pythsub(a, b: integer): integer;
+     label
+ 	30;
+     var
+ 	r: fraction;
+ 	big: boolean;
+     begin
+ 	a := abs(a);
+ 	b := abs(b);
+ 	if a <= b then begin {128:}
+ 	    if a < b then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(180)
+ 		end;
+ 		printscaled(a);
+ 		print(181);
+ 		printscaled(b);
+ 		print(177);
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 178;
+ 		    helpline[0] := 179
+ 		end;
+ 		error
+ 	    end;
+ 	    a := 0
+ 	end else begin {:128}
+ 	    if a < 1073741824 then 
+ 		big := false
+ 	    else begin
+ 		a := a div 2;
+ 		b := b div 2;
+ 		big := true
+ 	    end; {127:}
+ 	    while true do begin
+ 		r := makefraction(b, a);
+ 		r := takefraction(r, r);
+ 		if r = 0 then 
+ 		    goto 30;
+ 		r := makefraction(r, 1073741824 - r);
+ 		a := a - takefraction(a + a, r);
+ 		b := takefraction(b, r)
+ 	    end;
+     30: {:127}
+ 	    ;
+ 	    if big then 
+ 		a := a + a
+ 	end;
+ 	pythsub := a
+     end; {:126} {132:}
+ 
+     function mlog(x: scaled): scaled;
+     var
+ 	y, z: integer;
+ 	k: integer;
+     begin
+ 	if x <= 0 then begin {134:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(182)
+ 	    end;
+ 	    printscaled(x);
+ 	    print(177);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 183;
+ 		helpline[0] := 179
+ 	    end;
+ 	    error;
+ 	    mlog := 0
+ 	end else begin {:134}
+ 	    y := 1302456860;
+ 	    z := 6581195;
+ 	    while x < 1073741824 do begin
+ 		x := x + x;
+ 		y := y - 93032639;
+ 		z := z - 48782
+ 	    end;
+ 	    y := y + (z div 65536);
+ 	    k := 2;
+ 	    while x > 1073741828 do begin {133:}
+ 		z := ((x - 1) div twotothe[k]) + 1;
+ 		while x < (1073741824 + z) do begin
+ 		    z := (z + 1) div 2;
+ 		    k := k + 1
+ 		end;
+ 		y := y + speclog[k];
+ 		x := x - z
+ 	    end {:133};
+ 	    mlog := y div 8
+ 	end
+     end; {:132} {135:}
+ 
+     function mexp(x: scaled): scaled;
+     var
+ 	k: smallnumber;
+ 	y, z: integer;
+     begin
+ 	if x > 174436200 then begin
+ 	    aritherror := true;
+ 	    mexp := 2147483647
+ 	end else if x < (-197694359) then 
+ 	    mexp := 0
+ 	else begin
+ 	    if x <= 0 then begin
+ 		z := -(8 * x);
+ 		y := 1048576
+ 	    end else begin
+ 		if x <= 127919879 then 
+ 		    z := 1023359037 - (8 * x)
+ 		else 
+ 		    z := 8 * (174436200 - x);
+ 		y := 2147483647
+ 	    end; {136:}
+ 	    k := 1;
+ 	    while z > 0 do begin
+ 		while z >= speclog[k] do begin
+ 		    z := z - speclog[k];
+ 		    y := (y - 1) - ((y - twotothe[k - 1]) div twotothe[k])
+ 		end;
+ 		k := k + 1
+ 	    end {:136};
+ 	    if x <= 127919879 then 
+ 		mexp := (y + 8) div 16
+ 	    else 
+ 		mexp := y
+ 	end
+     end; {:135} {139:}
+ 
+     function narg(x, y: integer): angle;
+     var
+ 	z: angle;
+ 	t: integer;
+ 	k: smallnumber;
+ 	octant: 1..8;
+     begin
+ 	if x >= 0 then 
+ 	    octant := 1
+ 	else begin
+ 	    x := -x;
+ 	    octant := 2
+ 	end;
+ 	if y < 0 then begin
+ 	    y := -y;
+ 	    octant := octant + 2
+ 	end;
+ 	if x < y then begin
+ 	    t := y;
+ 	    y := x;
+ 	    x := t;
+ 	    octant := octant + 4
+ 	end;
+ 	if x = 0 then begin {140:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(184)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 185;
+ 		helpline[0] := 179
+ 	    end;
+ 	    error;
+ 	    narg := 0
+ 	end else begin {:140} {142:}
+ 	    while x >= 536870912 do begin
+ 		x := x div 2;
+ 		y := y div 2
+ 	    end;
+ 	    z := 0;
+ 	    if y > 0 then begin
+ 		while x < 268435456 do begin
+ 		    x := x + x;
+ 		    y := y + y
+ 		end; {143:}
+ 		k := 0;
+ 		repeat
+ 		    y := y + y;
+ 		    k := k + 1;
+ 		    if y > x then begin
+ 			z := z + specatan[k];
+ 			t := x;
+ 			x := x + (y div twotothe[k + k]);
+ 			y := y - t
+ 		    end
+ 		until k = 15;
+ 		repeat
+ 		    y := y + y;
+ 		    k := k + 1;
+ 		    if y > x then begin
+ 			z := z + specatan[k];
+ 			y := y - x
+ 		    end
+ 		until k = 26 {:143}
+ 	    end {:142}; {141:}
+ 	    case octant of
+ 		1:
+ 		    narg := z;
+ 		5:
+ 		    narg := 94371840 - z;
+ 		6:
+ 		    narg := 94371840 + z;
+ 		2:
+ 		    narg := 188743680 - z;
+ 		4:
+ 		    narg := z - 188743680;
+ 		8:
+ 		    narg := (-z) - 94371840;
+ 		7:
+ 		    narg := z - 94371840;
+ 		3:
+ 		    narg := -z
+ 	    end {:141}
+ 	end
+     end; {:139} {145:}
+ 
+     procedure nsincos(z: angle);
+     var
+ 	k: smallnumber;
+ 	q: 0..7;
+ 	r: fraction;
+ 	x, y, t: integer;
+     begin
+ 	while z < 0 do 
+ 	    z := z + 377487360;
+ 	z := z mod 377487360;
+ 	q := z div 47185920;
+ 	z := z mod 47185920;
+ 	x := 268435456;
+ 	y := x;
+ 	if not odd(q) then 
+ 	    z := 47185920 - z; {147:}
+ 	k := 1;
+ 	while z > 0 do begin
+ 	    if z >= specatan[k] then begin
+ 		z := z - specatan[k];
+ 		t := x;
+ 		x := t + (y div twotothe[k]);
+ 		y := y - (t div twotothe[k])
+ 	    end;
+ 	    k := k + 1
+ 	end;
+ 	if y < 0 then 
+ 	    y := 0 {:147}; {146:}
+ 	case q of
+ 	    0:
+ 		;
+ 	    1:
+ 		begin
+ 		    t := x;
+ 		    x := y;
+ 		    y := t
+ 		end;
+ 	    2:
+ 		begin
+ 		    t := x;
+ 		    x := -y;
+ 		    y := t
+ 		end;
+ 	    3:
+ 		x := -x;
+ 	    4:
+ 		begin
+ 		    x := -x;
+ 		    y := -y
+ 		end;
+ 	    5:
+ 		begin
+ 		    t := x;
+ 		    x := -y;
+ 		    y := -t
+ 		end;
+ 	    6:
+ 		begin
+ 		    t := x;
+ 		    x := y;
+ 		    y := -t
+ 		end;
+ 	    7:
+ 		y := -y
+ 	end {:146};
+ 	r := pythadd(x, y);
+ 	ncos := makefraction(x, r);
+ 	nsin := makefraction(y, r)
+     end; {:145} {149:}
+ 
+     procedure newrandoms;
+     var
+ 	k: 0..54;
+ 	x: fraction;
+     begin
+ 	for k := 0 to 23 do begin
+ 	    x := randoms[k] - randoms[k + 31];
+ 	    if x < 0 then 
+ 		x := x + 268435456;
+ 	    randoms[k] := x
+ 	end;
+ 	for k := 24 to 54 do begin
+ 	    x := randoms[k] - randoms[k - 24];
+ 	    if x < 0 then 
+ 		x := x + 268435456;
+ 	    randoms[k] := x
+ 	end;
+ 	jrandom := 54
+     end; {:149}
+ {150:}
+ 
+     procedure initrandoms(seed: scaled);
+     var
+ 	j, jj, k: fraction;
+ 	i: 0..54;
+     begin
+ 	j := abs(seed);
+ 	while j >= 268435456 do 
+ 	    j := j div 2;
+ 	k := 1;
+ 	for i := 0 to 54 do begin
+ 	    jj := k;
+ 	    k := j - k;
+ 	    j := jj;
+ 	    if k < 0 then 
+ 		k := k + 268435456;
+ 	    randoms[(i * 21) mod 55] := j
+ 	end;
+ 	newrandoms;
+ 	newrandoms;
+ 	newrandoms
+     end; {:150}
+ {151:}
+ 
+     function unifrand(x: scaled): scaled;
+     var
+ 	y: scaled;
+     begin
+ 	if jrandom = 0 then 
+ 	    newrandoms
+ 	else 
+ 	    jrandom := jrandom - 1;
+ 	y := takefraction(abs(x), randoms[jrandom]);
+ 	if y = abs(x) then 
+ 	    unifrand := 0
+ 	else if x > 0 then 
+ 	    unifrand := y
+ 	else 
+ 	    unifrand := -y
+     end; {:151} {152:}
+ 
+     function normrand: scaled;
+     var
+ 	x, u, l: integer;
+     begin
+ 	repeat
+ 	    repeat
+ 		if jrandom = 0 then 
+ 		    newrandoms
+ 		else 
+ 		    jrandom := jrandom - 1;
+ 		x := takefraction(112429, randoms[jrandom] - 134217728);
+ 		if jrandom = 0 then 
+ 		    newrandoms
+ 		else 
+ 		    jrandom := jrandom - 1;
+ 		u := randoms[jrandom]
+ 	    until abs(x) < u;
+ 	    x := makefraction(x, u);
+ 	    l := 139548960 - mlog(u)
+ 	until abvscd(1024, l, x, x) >= 0;
+ 	normrand := x
+     end; {:152}
+ {157:}
+     {procedure printword(w:memoryword);begin printint(w.int);
+     printchar(32);printscaled(w.int);printchar(32);
+     printscaled(w.int div 4096);println;printint(w.hh.lh);printchar(61);
+     printint(w.hh.b0);printchar(58);printint(w.hh.b1);printchar(59);
+     printint(w.hh.rh);printchar(32);printint(w.qqqq.b0);printchar(58);
+     printint(w.qqqq.b1);printchar(58);printint(w.qqqq.b2);printchar(58);
+     printint(w.qqqq.b3);end;}
+     {:157}
+     {162:}
+     {217:}
+ 
+     procedure printcapsule;
+     forward;
+ 
+     procedure showtokenlist(p, q: integer; l, nulltally: integer);
+     label
+ 	10;
+     var
+ 	class, c: smallnumber;
+ 	r, v: integer;
+     begin
+ 	class := 3;
+ 	tally := nulltally;
+ 	while (p <> (-30000)) and (tally < l) do begin
+ 	    if p = q then begin {646:}
+ 		firstcount := tally;
+ 		trickcount := ((tally + 1) + errorline) - halferrorline;
+ 		if trickcount < errorline then 
+ 		    trickcount := errorline
+ 	    end {:646}; {218:}
+ 	    c := 9;
+ 	    if (p < (-30000)) or (p > memend) then begin
+ 		print(360);
+ 		goto 10
+ 	    end;
+ 	    if p < himemmin then  {219:}
+ 		if mem[p].hh.b1 = 12 then 
+ 		    if mem[p].hh.b0 = 16 then begin {220:}
+ 			if class = 0 then 
+ 			    printchar(32);
+ 			v := mem[p + 1].int;
+ 			if v < 0 then begin
+ 			    if class = 17 then 
+ 				printchar(32);
+ 			    printchar(91);
+ 			    printscaled(v);
+ 			    printchar(93);
+ 			    c := 18
+ 			end else begin
+ 			    printscaled(v);
+ 			    c := 0
+ 			end
+ 		    end else if mem[p].hh.b0 <> 4 then  {:220}
+ 			print(363)
+ 		    else begin
+ 			printchar(34);
+ 			slowprint(mem[p + 1].int);
+ 			printchar(34);
+ 			c := 4
+ 		    end
+ 		else if ((mem[p].hh.b1 <> 11) or (mem[p].hh.b0 < 1)) or (mem[p].hh.b0 > 19) then 
+ 		    print(363)
+ 		else begin
+ 		    gpointer := p;
+ 		    printcapsule;
+ 		    c := 8
+ 		end {:219}
+ 	    else begin
+ 		r := mem[p].hh.lh;
+ 		if r >= 2242 then begin {222:}
+ 		    if r < 2392 then begin
+ 			print(365);
+ 			r := r - 2242
+ 		    end else if r < 2542 then begin
+ 			print(366);
+ 			r := r - 2392
+ 		    end else begin
+ 			print(367);
+ 			r := r - 2542
+ 		    end;
+ 		    printint(r);
+ 		    printchar(41);
+ 		    c := 8
+ 		end else if r < 1 then  {:222}
+ 		    if r = 0 then begin {221:}
+ 			if class = 17 then 
+ 			    printchar(32);
+ 			print(364);
+ 			c := 18
+ 		    end else  {:221}
+ 			print(361)
+ 		else begin
+ 		    r := hash[r].rh;
+ 		    if (r < 0) or (r >= strptr) then 
+ 			print(362) {223:}
+ 		    else begin
+ 			c := charclass[strpool[strstart[r]]];
+ 			if c = class then 
+ 			    if c in
+ 				[9, 5, 6, 7, 8] then
+ 				case c of
+ 				    9:
+ 					printchar(46);
+ 				    5, 6, 7, 8:
+ 				end
+ 			    else
+ 				printchar(32);
+ 			print(r)
+ 		    end {:223}
+ 		end
+ 	    end {:218};
+ 	    class := c;
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	if p <> (-30000) then 
+ 	    print(359);
+     10:
+ 	
+     end; {:217} {665:}
+ 
+     procedure runaway;
+     begin
+ 	if scannerstatus > 2 then begin
+ 	    printnl(503);
+ 	    case scannerstatus of
+ 		3:
+ 		    print(504);
+ 		4, 5:
+ 		    print(505);
+ 		6:
+ 		    print(506)
+ 	    end;
+ 	    println;
+ 	    showtokenlist(mem[29998].hh.rh, -30000, errorline - 10, 0)
+ 	end
+     end; { runaway }
+ {:665}
+     {:162}
+     {163:}
+ 
+     function getavail: halfword;
+     var
+ 	p: halfword;
+     begin
+ 	p := avail;
+ 	if p <> (-30000) then 
+ 	    avail := mem[avail].hh.rh
+ 	else if memend < memmax then begin
+ 	    memend := memend + 1;
+ 	    p := memend
+ 	end else begin
+ 	    himemmin := himemmin - 1;
+ 	    p := himemmin;
+ 	    if himemmin <= lomemmax then begin
+ 		runaway;
+ 		overflow(186, memmax + 30001)
+ 	    end
+ 	end;
+ 	mem[p].hh.rh := -30000;
+ {dynused:=dynused+1;}
+ 	getavail := p
+     end; {:163} {167:}
+ 
+     function getnode(s: integer): halfword;
+     label
+ 	40, 10, 20;
+     var
+ 	p: halfword;
+ 	q: halfword;
+ 	r: integer;
+ 	t, tt: integer;
+     begin
+     20:
+ 	p := rover; {169:}
+ 	repeat
+ 	    q := p + mem[p].hh.lh;
+ 	    while mem[q].hh.rh = 32767 do begin
+ 		t := mem[q + 1].hh.rh;
+ 		tt := mem[q + 1].hh.lh;
+ 		if q = rover then 
+ 		    rover := t;
+ 		mem[t + 1].hh.lh := tt;
+ 		mem[tt + 1].hh.rh := t;
+ 		q := q + mem[q].hh.lh
+ 	    end;
+ 	    r := q - s;
+ 	    if r > (p + 1) then begin {170:}
+ 		mem[p].hh.lh := r - p;
+ 		rover := p;
+ 		goto 40
+ 	    end {:170};
+ 	    {171
+ 	    :}
+ 	    if r = p then 
+ 		if (mem[p + 1].hh.rh <> rover) or (mem[p + 1].hh.lh <> rover) then begin
+ 		    rover := mem[p + 1].hh.rh;
+ 		    t := mem[p + 1].hh.lh;
+ 		    mem[rover + 1].hh.lh := t;
+ 		    mem[t + 1].hh.rh := rover;
+ 		    goto 40
+ 		end {:171};
+ 	    mem[p].hh.lh := q - p {:169};
+ 	    p := mem[p + 1].hh.rh
+ 	until p = rover;
+ 	if s = 1073741824 then begin
+ 	    getnode := 32767;
+ 	    goto 10
+ 	end;
+ 	if (lomemmax + 2) < himemmin then 
+ 	    if (lomemmax + 2) <= 2767 then begin {168:}
+ 		if (lomemmax + 1000) < himemmin then 
+ 		    t := lomemmax + 1000
+ 		else 
+ 		    t := ((lomemmax + himemmin) + 2) div 2;
+ 		if t > 2767 then 
+ 		    t := 2767;
+ 		p := mem[rover + 1].hh.lh;
+ 		q := lomemmax;
+ 		mem[p + 1].hh.rh := q;
+ 		mem[rover + 1].hh.lh := q;
+ 		mem[q + 1].hh.rh := rover;
+ 		mem[q + 1].hh.lh := p;
+ 		mem[q].hh.rh := 32767;
+ 		mem[q].hh.lh := t - lomemmax;
+ 		lomemmax := t;
+ 		mem[lomemmax].hh.rh := -30000;
+ 		mem[lomemmax].hh.lh := -30000;
+ 		rover := q;
+ 		goto 20
+ 	    end {:168};
+ 	overflow(186, memmax + 30001);
+     40:
+ 	mem[r].hh.rh := -30000; {varused:=varused+s;}
+ 	getnode := r;
+     10:
+ 	
+     end; {:167} {172:}
+ 
+     procedure freenode(p: halfword; s: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	mem[p].hh.lh := s;
+ 	mem[p].hh.rh := 32767;
+ 	q := mem[rover + 1].hh.lh;
+ 	mem[p + 1].hh.lh := q;
+ 	mem[p + 1].hh.rh := rover;
+ 	mem[rover + 1].hh.lh := p;
+ 	mem[q + 1].hh.rh := p
+     end; {varused:=varused-s;} {:172}
+ {173:}
+     {procedure sortavail;var p,q,r:halfword;oldrover:halfword;
+     begin p:=getnode(1073741824);p:=mem[rover+1].hh.rh;
+     mem[rover+1].hh.rh:=32767;oldrover:=rover;
+     while p<>oldrover do[174:]if p<rover then begin q:=p;p:=mem[q+1].hh.rh;
+     mem[q+1].hh.rh:=rover;rover:=q;end else begin q:=rover;
+     while mem[q+1].hh.rh<p do q:=mem[q+1].hh.rh;r:=mem[p+1].hh.rh;
+     mem[p+1].hh.rh:=mem[q+1].hh.rh;mem[q+1].hh.rh:=p;p:=r;end[:174];
+     p:=rover;
+     while mem[p+1].hh.rh<>32767 do begin mem[mem[p+1].hh.rh+1].hh.lh:=p;
+     p:=mem[p+1].hh.rh;end;mem[p+1].hh.rh:=rover;mem[rover+1].hh.lh:=p;end;}
+ {:173}
+     {177:}
+ 
+     procedure flushlist(p: halfword);
+     label
+ 	30;
+     var
+ 	q, r: halfword;
+     begin
+ 	if p >= himemmin then 
+ 	    if p <> 30000 then begin
+ 		r := p;
+ 		repeat
+ 		    q := r;
+ 		    r := mem[r].hh.rh; {dynused:=dynused-1;}
+ 		    if r < himemmin then 
+ 			goto 30
+ 		until r = 30000;
+     30:
+ 		mem[q].hh.rh := avail;
+ 		avail := p
+ 	    end
+     end; { flushlist }
+ 
+     procedure flushnodelist(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	while p <> (-30000) do begin
+ 	    q := p;
+ 	    p := mem[p].hh.rh;
+ 	    if q < himemmin then 
+ 		freenode(q, 2)
+ 	    else begin
+ 		mem[q].hh.rh := avail;
+ 		avail := q
+ 	    end
+ {dynused:=dynused-1;}
+ 	end
+     end; {:177} {180:}
+ {procedure checkmem(printlocs:boolean);label 31,32;var p,q,r:halfword;
+ clobbered:boolean;begin for p:=-30000 to lomemmax do freearr[p]:=false;
+ for p:=himemmin to memend do freearr[p]:=false;[181:]p:=avail;q:=-30000;
+ clobbered:=false;
+ while p<>-30000 do begin if(p>memend)or(p<himemmin)then clobbered:=true
+ else if freearr[p]then clobbered:=true;
+ if clobbered then begin printnl(187);printint(q);goto 31;end;
+ freearr[p]:=true;q:=p;p:=mem[q].hh.rh;end;31:[:181];[182:]p:=rover;
+ q:=-30000;clobbered:=false;
+ repeat if(p>=lomemmax)or(p<-30000)then clobbered:=true else if(mem[p+1].
+ hh.rh>=lomemmax)or(mem[p+1].hh.rh<-30000)then clobbered:=true else if
+ not((mem[p].hh.rh=32767))or(mem[p].hh.lh<2)or(p+mem[p].hh.lh>lomemmax)or
+ (mem[mem[p+1].hh.rh+1].hh.lh<>p)then clobbered:=true;
+ if clobbered then begin printnl(188);printint(q);goto 32;end;
+ for q:=p to p+mem[p].hh.lh-1 do begin if freearr[q]then begin printnl(
+ 189);printint(q);goto 32;end;freearr[q]:=true;end;q:=p;
+ p:=mem[p+1].hh.rh;until p=rover;32:[:182];[183:]p:=-30000;
+ while p<=lomemmax do begin if(mem[p].hh.rh=32767)then begin printnl(190)
+ ;printint(p);end;while(p<=lomemmax)and not freearr[p]do p:=p+1;
+ while(p<=lomemmax)and freearr[p]do p:=p+1;end[:183];[617:]q:=-29987;
+ p:=mem[q].hh.rh;
+ while p<>-29987 do begin if mem[p+1].hh.lh<>q then begin printnl(463);
+ printint(p);end;p:=mem[p+1].hh.rh;r:=himemmin;
+ repeat if mem[p].hh.lh>=r then begin printnl(464);printint(p);end;
+ r:=mem[p].hh.lh;q:=p;p:=mem[q].hh.rh;until r=-30000;end[:617];
+ if printlocs then[184:]begin printnl(191);
+ for p:=-30000 to lomemmax do if not freearr[p]and((p>waslomax)or wasfree
+ [p])then begin printchar(32);printint(p);end;
+ for p:=himemmin to memend do if not freearr[p]and((p<washimin)or(p>
+ wasmemend)or wasfree[p])then begin printchar(32);printint(p);end;
+ end[:184];for p:=-30000 to lomemmax do wasfree[p]:=freearr[p];
+ for p:=himemmin to memend do wasfree[p]:=freearr[p];wasmemend:=memend;
+ waslomax:=lomemmax;washimin:=himemmin;end;}
+     {:180}
+     {185:}
+ {procedure searchmem(p:halfword);var q:integer;
+ begin for q:=-30000 to lomemmax do begin if mem[q].hh.rh=p then begin
+ printnl(192);printint(q);printchar(41);end;
+ if mem[q].hh.lh=p then begin printnl(193);printint(q);printchar(41);end;
+ end;
+ for q:=himemmin to memend do begin if mem[q].hh.rh=p then begin printnl(
+ 192);printint(q);printchar(41);end;
+ if mem[q].hh.lh=p then begin printnl(193);printint(q);printchar(41);end;
+ end;
+ [209:]for q:=1 to 2241 do begin if eqtb[q].rh=p then begin printnl(328);
+ printint(q);printchar(41);end;end[:209];end;}
+     {:185}
+     {189:}
+ 
+     procedure printop(c: quarterword);
+     begin
+ 	if c <= 15 then 
+ 	    printtype(c)
+ 	else 
+ 	    if c in
+ 		[30, 31, 32, 33, 34, 35, 36, 37,
+ 		 38, 39, 40, 41, 42, 43, 44, 45,
+ 		 46, 47, 48, 49, 50, 51, 52, 53,
+ 		 54, 55, 56, 57, 58, 59, 60, 61,
+ 		 62, 63, 64, 65, 66, 67, 68, 69,
+ 		 70, 71, 72, 73, 74, 75, 76, 77,
+ 		 78, 79, 80, 81, 82, 83, 84, 85,
+ 		 86, 87, 88, 89, 90, 91, 92, 94,
+ 		 95, 96, 97, 98, 99, 100] then
+ 		case c of
+ 		    30:
+ 			print(218);
+ 		    31:
+ 			print(219);
+ 		    32:
+ 			print(220);
+ 		    33:
+ 			print(221);
+ 		    34:
+ 			print(222);
+ 		    35:
+ 			print(223);
+ 		    36:
+ 			print(224);
+ 		    37:
+ 			print(225);
+ 		    38:
+ 			print(226);
+ 		    39:
+ 			print(227);
+ 		    40:
+ 			print(228);
+ 		    41:
+ 			print(229);
+ 		    42:
+ 			print(230);
+ 		    43:
+ 			print(231);
+ 		    44:
+ 			print(232);
+ 		    45:
+ 			print(233);
+ 		    46:
+ 			print(234);
+ 		    47:
+ 			print(235);
+ 		    48:
+ 			print(236);
+ 		    49:
+ 			print(237);
+ 		    50:
+ 			print(238);
+ 		    51:
+ 			print(239);
+ 		    52:
+ 			print(240);
+ 		    53:
+ 			print(241);
+ 		    54:
+ 			print(242);
+ 		    55:
+ 			print(243);
+ 		    56:
+ 			print(244);
+ 		    57:
+ 			print(245);
+ 		    58:
+ 			print(246);
+ 		    59:
+ 			print(247);
+ 		    60:
+ 			print(248);
+ 		    61:
+ 			print(249);
+ 		    62:
+ 			print(250);
+ 		    63:
+ 			print(251);
+ 		    64:
+ 			print(252);
+ 		    65:
+ 			print(253);
+ 		    66:
+ 			print(254);
+ 		    67:
+ 			print(255);
+ 		    68:
+ 			print(256);
+ 		    69:
+ 			printchar(43);
+ 		    70:
+ 			printchar(45);
+ 		    71:
+ 			printchar(42);
+ 		    72:
+ 			printchar(47);
+ 		    73:
+ 			print(257);
+ 		    74:
+ 			print(181);
+ 		    75:
+ 			print(258);
+ 		    76:
+ 			print(259);
+ 		    77:
+ 			printchar(60);
+ 		    78:
+ 			print(260);
+ 		    79:
+ 			printchar(62);
+ 		    80:
+ 			print(261);
+ 		    81:
+ 			printchar(61);
+ 		    82:
+ 			print(262);
+ 		    83:
+ 			print(38);
+ 		    84:
+ 			print(263);
+ 		    85:
+ 			print(264);
+ 		    86:
+ 			print(265);
+ 		    87:
+ 			print(266);
+ 		    88:
+ 			print(267);
+ 		    89:
+ 			print(268);
+ 		    90:
+ 			print(269);
+ 		    91:
+ 			print(270);
+ 		    92:
+ 			print(271);
+ 		    94:
+ 			print(272);
+ 		    95:
+ 			print(273);
+ 		    96:
+ 			print(274);
+ 		    97:
+ 			print(275);
+ 		    98:
+ 			print(276);
+ 		    99:
+ 			print(277);
+ 		    100:
+ 			print(278)
+ 		end
+ 	    else
+ 		print(279)
+     end; { printop }
+ {:189}
+     {194:}
+ 
+     procedure fixdateandtime;
+     begin
+ 	dateandtime(internal[17], internal[16], internal[15], internal[14]);
+ 	internal[17] := internal[17] * 65536;
+ 	internal[16] := internal[16] * 65536;
+ 	internal[15] := internal[15] * 65536;
+ 	internal[14] := internal[14] * 65536;
+ 	{----------------------------------}
+ 	 lastyearval := internal[14];
+ 	 lastmonthval:= internal[15];
+         {----------------------------------}
+     end; { fixdateandtime }
+ {:194}
+     {205:}
+ 
+     function idlookup(j, l: integer): halfword;
+     label
+ 	40;
+     var
+ 	h: integer;
+ 	p: halfword;
+ 	k: halfword;
+     begin
+ 	if l = 1 then begin {206:}
+ 	    p := buffer[j] + 1;
+ 	    hash[p].rh := p - 1;
+ 	    goto 40
+ 	end {:206}; {208:}
+ 	h := buffer[j];
+ 	for k := j + 1 to (j + l) - 1 do begin
+ 	    h := (h + h) + buffer[k];
+ 	    while h >= 1777 do 
+ 		h := h - 1777
+ 	end {:208};
+ 	p := h + 129;
+ 	while true do begin
+ 	    if hash[p].rh > 0 then 
+ 		if (strstart[hash[p].rh + 1] - strstart[hash[p].rh]) = l then 
+ 		    if streqbuf(hash[p].rh, j) then 
+ 			goto 40;
+ 	    if hash[p].lh = 0 then begin {207:}
+ 		if hash[p].rh > 0 then begin
+ 		    repeat
+ 			if hashused = 1 then 
+ 			    overflow(327, 2100);
+ 			hashused := hashused - 1
+ 		    until hash[hashused].rh = 0;
+ 		    hash[p].lh := hashused;
+ 		    p := hashused
+ 		end;
+ 		begin
+ 		    if (poolptr + l) > maxpoolptr then begin
+ 			if (poolptr + l) > poolsize then 
+ 			    overflow(129, poolsize - initpoolptr);
+ 			maxpoolptr := poolptr + l
+ 		    end
+ 		end;
+ 		for k := j to (j + l) - 1 do begin
+ 		    strpool[poolptr] := buffer[k];
+ 		    poolptr := poolptr + 1
+ 		end;
+ 		hash[p].rh := makestring;
+ 		strref[hash[p].rh] := 127;
+ {stcount:=stcount+1;}
+ 		goto 40
+ 	    end {:207};
+ 	    p := hash[p].lh
+ 	end;
+     40:
+ 	idlookup := p
+     end; {:205} {210:}
+     {procedure primitive(s:strnumber;c:halfword;o:halfword);
+     var k:poolpointer;j:smallnumber;l:smallnumber;begin k:=strstart[s];
+     l:=strstart[s+1]-k;for j:=0 to l-1 do buffer[j]:=strpool[k+j];
+     cursym:=idlookup(0,l);if s>=128 then begin flushstring(strptr-1);
+     hash[cursym].rh:=s;end;eqtb[cursym].lh:=c;eqtb[cursym].rh:=o;end;}
+     {:210}
+ {215:}
+ 
+     function newnumtok(v: scaled): halfword;
+     var
+ 	p: halfword;
+     begin
+ 	p := getnode(2);
+ 	mem[p + 1].int := v;
+ 	mem[p].hh.b0 := 16;
+ 	mem[p].hh.b1 := 12;
+ 	newnumtok := p
+     end; {:215} {216:}
+ 
+     procedure tokenrecycle;
+     forward;
+ 
+     procedure flushtokenlist(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	while p <> (-30000) do begin
+ 	    q := p;
+ 	    p := mem[p].hh.rh;
+ 	    if q >= himemmin then begin
+ 		mem[q].hh.rh := avail;
+ 		avail := q
+ 	    end else begin
+ {dynused:=dynused-1;}
+ 		if mem[q].hh.b0 in
+ 		    [1, 2, 16, 4, 3, 5, 7, 12,
+ 		     10, 6, 9, 8, 11, 14, 13, 17,
+ 		     18, 19] then
+ 		    case mem[q].hh.b0 of
+ 			1, 2, 16:
+ 			    ;
+ 			4:
+ 			    begin
+ 				if strref[mem[q + 1].int] < 127 then 
+ 				    if strref[mem[q + 1].int] > 1 then 
+ 					strref[mem[q + 1].int] := strref[mem[q + 1].int] - 1
+ 				    else 
+ 					flushstring(mem[q + 1].int)
+ 			    end;
+ 			3, 5, 7, 12, 10, 6, 9,
+ 			8, 11, 14, 13, 17, 18, 19:
+ 			    begin
+ 				gpointer := q;
+ 				tokenrecycle
+ 			    end
+ 		    end
+ 		else
+ 		    confusion(358);
+ 		freenode(q, 2)
+ 	    end
+ 	end
+     end; { flushtokenlist }
+ {:216}
+     {226:}
+ 
+     procedure deletemacref(p: halfword);
+     begin
+ 	if mem[p].hh.lh = (-30000) then 
+ 	    flushtokenlist(p)
+ 	else 
+ 	    mem[p].hh.lh := mem[p].hh.lh - 1
+     end; {:226} {227:} {625:}
+ 
+     procedure printcmdmod(c, m: integer);
+     begin
+ 	if c in
+ 	    [18, 77, 59, 72, 32, 78, 79, 57,
+ 	     19, 60, 27, 11, 81, 26, 6, 9,
+ 	     70, 73, 13, 46, 63, 14, 15, 69,
+ 	     28, 47, 24, 7, 65, 64, 12, 8,
+ 	     80, 17, 74, 35, 58, 71, 75, 16,
+ 	     4, 61, 56, 3, 1, 2, 33, 34,
+ 	     37, 55, 45, 50, 36, 43, 54, 48,
+ 	     51, 52, 30, 82, 23, 21, 22, 31,
+ 	     62, 41, 10, 53, 44, 49, 5, 40,
+ 	     68, 66, 67, 25, 20, 76, 29] then
+ 	    case c of {212:}
+ 		18:
+ 		    print(330);
+ 		77:
+ 		    print(329);
+ 		59:
+ 		    print(332);
+ 		72:
+ 		    print(331);
+ 		32:
+ 		    print(333);
+ 		78:
+ 		    print(58);
+ 		79:
+ 		    print(44);
+ 		57:
+ 		    print(334);
+ 		19:
+ 		    print(335);
+ 		60:
+ 		    print(336);
+ 		27:
+ 		    print(337);
+ 		11:
+ 		    print(338);
+ 		81:
+ 		    print(323);
+ 		26:
+ 		    print(339);
+ 		6:
+ 		    print(340);
+ 		9:
+ 		    print(341);
+ 		70:
+ 		    print(342);
+ 		73:
+ 		    print(343);
+ 		13:
+ 		    print(344);
+ 		46:
+ 		    print(123);
+ 		63:
+ 		    print(91);
+ 		14:
+ 		    print(345);
+ 		15:
+ 		    print(346);
+ 		69:
+ 		    print(347);
+ 		28:
+ 		    print(348);
+ 		47:
+ 		    print(279);
+ 		24:
+ 		    print(349);
+ 		7:
+ 		    printchar(92);
+ 		65:
+ 		    print(125);
+ 		64:
+ 		    print(93);
+ 		12:
+ 		    print(350);
+ 		8:
+ 		    print(351);
+ 		80:
+ 		    print(59);
+ 		17:
+ 		    print(352);
+ 		74:
+ 		    print(353);
+ 		35:
+ 		    print(354);
+ 		58:
+ 		    print(355);
+ 		71:
+ 		    print(356);
+ 		75:
+ 		    print(357); {:212} {684:}
+ 		16:
+ 		    if m <= 2 then 
+ 			if m = 1 then 
+ 			    print(520)
+ 			else if m < 1 then 
+ 			    print(324)
+ 			else 
+ 			    print(521)
+ 		    else if m = 53 then 
+ 			print(522)
+ 		    else if m = 44 then 
+ 			print(523)
+ 		    else 
+ 			print(524);
+ 		4:
+ 		    if m <= 1 then 
+ 			if m = 1 then 
+ 			    print(527)
+ 			else 
+ 			    print(325)
+ 		    else if m = 2242 then 
+ 			print(525)
+ 		    else 
+ 			print(526); {:684} {689:}
+ 		61:
+ 		    if m in
+ 			[1, 2, 3] then
+ 			case m of
+ 			    1:
+ 				print(529);
+ 			    2:
+ 				printchar(64);
+ 			    3:
+ 				print(530)
+ 			end
+ 		    else
+ 			print(528); {:689} {696:}
+ 		56:
+ 		    if m >= 2242 then 
+ 			if m = 2242 then 
+ 			    print(541)
+ 			else if m = 2392 then 
+ 			    print(542)
+ 			else 
+ 			    print(543)
+ 		    else if m < 2 then 
+ 			print(544)
+ 		    else if m = 2 then 
+ 			print(545)
+ 		    else 
+ 			print(546); {:696} {710:}
+ 		3:
+ 		    if m = 0 then 
+ 			print(556)
+ 		    else 
+ 			print(482);
+ {:710}
+ 		{741:}
+ 		1, 2:
+ 		    if m in
+ 			[1, 2, 3] then
+ 			case m of
+ 			    1:
+ 				print(583);
+ 			    2:
+ 				print(322);
+ 			    3:
+ 				print(584)
+ 			end
+ 		    else
+ 			print(585); {:741} {894:}
+ 		33, 34, 37, 55, 45, 50, 36,
+ 		43, 54, 48, 51, 52:
+ 		    printop(m); {:894} {1014:}
+ 		30:
+ 		    printtype(m); {:1014} {1019:}
+ 		82:
+ 		    if m = 0 then 
+ 			print(776)
+ 		    else 
+ 			print(777);
+ {:1019}
+ 		{1025:}
+ 		23:
+ 		    if m in
+ 			[0, 1, 2] then
+ 			case m of
+ 			    0:
+ 				print(143);
+ 			    1:
+ 				print(144);
+ 			    2:
+ 				print(145)
+ 			end
+ 		    else
+ 			print(783); {:1025} {1028:}
+ 		21:
+ 		    if m = 0 then 
+ 			print(784)
+ 		    else 
+ 			print(785); {:1028} {1038:}
+ 		22:
+ 		    if m in
+ 			[0, 1, 2, 3] then
+ 			case m of
+ 			    0:
+ 				print(799);
+ 			    1:
+ 				print(800);
+ 			    2:
+ 				print(801);
+ 			    3:
+ 				print(802)
+ 			end
+ 		    else
+ 			print(803); {:1038} {1043:}
+ 		31, 62:
+ 		    begin
+ 			if c = 31 then 
+ 			    print(806)
+ 			else 
+ 			    print(807);
+ 			print(808);
+ 			print(hash[m].rh)
+ 		    end;
+ 		41:
+ 		    if m = (-30000) then 
+ 			print(809)
+ 		    else 
+ 			print(810);
+ 		10:
+ 		    print(811);
+ 		53, 44, 49:
+ 		    begin
+ 			printcmdmod(16, c);
+ 			print(812);
+ 			println;
+ 			showtokenlist(mem[mem[m].hh.rh].hh.rh, -30000, 1000, 0)
+ 		    end;
+ 		5:
+ 		    print(813);
+ 		40:
+ 		    print(intname[m]); {:1043} {1053:}
+ 		68:
+ 		    if m = 1 then 
+ 			print(820)
+ 		    else if m = 0 then 
+ 			print(821)
+ 		    else 
+ 			print(822);
+ 		66:
+ 		    if m = 6 then 
+ 			print(823)
+ 		    else 
+ 			print(824);
+ 		67:
+ 		    if m = 0 then 
+ 			print(825)
+ 		    else 
+ 			print(826); {:1053} {1080:}
+ 		25:
+ 		    if m < 1 then 
+ 			print(856)
+ 		    else if m = 1 then 
+ 			print(857)
+ 		    else 
+ 			print(858);
+ {:1080}
+ 		{1102:}
+ 		20:
+ 		    if m in
+ 			[0, 1, 2, 3] then
+ 			case m of
+ 			    0:
+ 				print(868);
+ 			    1:
+ 				print(869);
+ 			    2:
+ 				print(870);
+ 			    3:
+ 				print(871)
+ 			end
+ 		    else
+ 			print(872); {:1102} {1110:}
+ 		76:
+ 		    if m = 0 then 
+ 			print(889)
+ 		    else 
+ 			print(890); {:1110} {1180:}
+ 		29:
+ 		    if m = 16 then 
+ 			print(913)
+ 		    else 
+ 			print(912)
+ 	    end
+ 	else {:1180}
+ 	    print(468)
+     end; {:625}
+ 
+     procedure showmacro(p: halfword; q, l: integer);
+     label
+ 	10;
+     var
+ 	r: halfword;
+     begin
+ 	p := mem[p].hh.rh;
+ 	while mem[p].hh.lh > 7 do begin
+ 	    r := mem[p].hh.rh;
+ 	    mem[p].hh.rh := -30000;
+ 	    showtokenlist(p, -30000, l, 0);
+ 	    mem[p].hh.rh := r;
+ 	    p := r;
+ 	    if l > 0 then 
+ 		l := l - tally
+ 	    else 
+ 		goto 10
+ 	end;
+ 	tally := 0;
+ 	case mem[p].hh.lh of
+ 	    0:
+ 		print(368);
+ 	    1, 2, 3:
+ 		begin
+ 		    printchar(60);
+ 		    printcmdmod(56, mem[p].hh.lh);
+ 		    print(369)
+ 		end;
+ 	    4:
+ 		print(370);
+ 	    5:
+ 		print(371);
+ 	    6:
+ 		print(372);
+ 	    7:
+ 		print(373)
+ 	end;
+ 	showtokenlist(mem[p].hh.rh, q, l - tally, 0);
+     10:
+ 	
+     end; {:227} {232:}
+ 
+     procedure initbignode(p: halfword);
+     var
+ 	q: halfword;
+ 	s: smallnumber;
+     begin
+ 	s := bignodesize[mem[p].hh.b0];
+ 	q := getnode(s);
+ 	repeat
+ 	    s := s - 2; {586:}
+ 	    begin
+ 		mem[q + s].hh.b0 := 19;
+ 		serialno := serialno + 64;
+ 		mem[(q + s) + 1].int := serialno
+ 	    end {:586};
+ 	    mem[q + s].hh.b1 := (s div 2) + 5;
+ 	    mem[q + s].hh.rh := -30000
+ 	until s = 0;
+ 	mem[q].hh.rh := p;
+ 	mem[p + 1].int := q
+     end; { initbignode }
+ {:232}
+     {233:}
+ 
+     function idtransform: halfword;
+     var
+ 	p, q, r: halfword;
+     begin
+ 	p := getnode(2);
+ 	mem[p].hh.b0 := 13;
+ 	mem[p].hh.b1 := 11;
+ 	mem[p + 1].int := -30000;
+ 	initbignode(p);
+ 	q := mem[p + 1].int;
+ 	r := q + 12;
+ 	repeat
+ 	    r := r - 2;
+ 	    mem[r].hh.b0 := 16;
+ 	    mem[r + 1].int := 0
+ 	until r = q;
+ 	mem[q + 5].int := 65536;
+ 	mem[q + 11].int := 65536;
+ 	idtransform := p
+     end; {:233} {234:}
+ 
+     procedure newroot(x: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	p := getnode(2);
+ 	mem[p].hh.b0 := 0;
+ 	mem[p].hh.b1 := 0;
+ 	mem[p].hh.rh := x;
+ 	eqtb[x].rh := p
+     end; {:234}
+ {235:}
+ 
+     procedure printvariablename(p: halfword);
+     label
+ 	40, 10;
+     var
+ 	q: halfword;
+ 	r: halfword;
+     begin
+ 	while mem[p].hh.b1 >= 5 do begin {237:}
+ 	    case mem[p].hh.b1 of
+ 		5:
+ 		    printchar(120);
+ 		6:
+ 		    printchar(121);
+ 		7:
+ 		    print(376);
+ 		8:
+ 		    print(377);
+ 		9:
+ 		    print(378);
+ 		10:
+ 		    print(379);
+ 		11:
+ 		    begin
+ 			print(380);
+ 			printint(p + 30000);
+ 			goto 10
+ 		    end
+ 	    end;
+ 	    print(381);
+ 	    p := mem[p - (2 * (mem[p].hh.b1 - 5))].hh.rh
+ 	end {:237};
+ 	q := -30000;
+ 	while mem[p].hh.b1 > 1 do begin {236:}
+ 	    if mem[p].hh.b1 = 3 then begin
+ 		r := newnumtok(mem[p + 2].int);
+ 		repeat
+ 		    p := mem[p].hh.rh
+ 		until mem[p].hh.b1 = 4
+ 	    end else if mem[p].hh.b1 = 2 then begin
+ 		p := mem[p].hh.rh;
+ 		goto 40
+ 	    end else begin
+ 		if mem[p].hh.b1 <> 4 then 
+ 		    confusion(375);
+ 		r := getavail;
+ 		mem[r].hh.lh := mem[p + 2].hh.lh
+ 	    end;
+ 	    mem[r].hh.rh := q;
+ 	    q := r;
+     40:
+ 	    p := mem[p + 2].hh.rh
+ 	end {:236};
+ 	r := getavail;
+ 	mem[r].hh.lh := mem[p].hh.rh;
+ 	mem[r].hh.rh := q;
+ 	if mem[p].hh.b1 = 1 then 
+ 	    print(374);
+ 	showtokenlist(r, -30000, 2147483647, tally);
+ 	flushtokenlist(r);
+     10:
+ 	
+     end; {:235}
+ {238:}
+ 
+     function interesting(p: halfword): boolean;
+     var
+ 	t: smallnumber;
+     begin
+ 	if internal[3] > 0 then 
+ 	    interesting := true
+ 	else begin
+ 	    t := mem[p].hh.b1;
+ 	    if t >= 5 then 
+ 		if t <> 11 then 
+ 		    t := mem[mem[p - (2 * (t - 5))].hh.rh].hh.b1;
+ 	    interesting := t <> 11
+ 	end
+     end; {:238} {239:}
+ 
+     function newstructure(p: halfword): halfword;
+     var
+ 	q, r: halfword;
+     begin
+ 	if mem[p].hh.b1 in
+ 	    [0, 3, 4] then
+ 	    case mem[p].hh.b1 of
+ 		0:
+ 		    begin
+ 			q := mem[p].hh.rh;
+ 			r := getnode(2);
+ 			eqtb[q].rh := r
+ 		    end;
+ 		3:
+ 		    begin {240:}
+ 			q := p;
+ 			repeat
+ 			    q := mem[q].hh.rh
+ 			until mem[q].hh.b1 = 4;
+ 			q := mem[q + 2].hh.rh;
+ 			r := q + 1;
+ 			repeat
+ 			    q := r;
+ 			    r := mem[r].hh.rh
+ 			until r = p;
+ 			r := getnode(3);
+ 			mem[q].hh.rh := r;
+ 			mem[r + 2].int := mem[p + 2].int
+ 		    end; {:240}
+ 		4:
+ 		    begin {241:}
+ 			q := mem[p + 2].hh.rh;
+ 			r := mem[q + 1].hh.lh;
+ 			repeat
+ 			    q := r;
+ 			    r := mem[r].hh.rh
+ 			until r = p;
+ 			r := getnode(3);
+ 			mem[q].hh.rh := r;
+ 			mem[r + 2] := mem[p + 2];
+ 			if mem[p + 2].hh.lh = 0 then begin
+ 			    q := mem[p + 2].hh.rh + 1;
+ 			    while mem[q].hh.rh <> p do 
+ 				q := mem[q].hh.rh;
+ 			    mem[q].hh.rh := r
+ 			end
+ 		    end
+ 	    end
+ 	else {:241}
+ 	    confusion(382);
+ 	mem[r].hh.rh := mem[p].hh.rh;
+ 	mem[r].hh.b0 := 21;
+ 	mem[r].hh.b1 := mem[p].hh.b1;
+ 	mem[r + 1].hh.lh := p;
+ 	mem[p].hh.b1 := 2;
+ 	q := getnode(3);
+ 	mem[p].hh.rh := q;
+ 	mem[r + 1].hh.rh := q;
+ 	mem[q + 2].hh.rh := r;
+ 	mem[q].hh.b0 := 0;
+ 	mem[q].hh.b1 := 4;
+ 	mem[q].hh.rh := -29983;
+ 	mem[q + 2].hh.lh := 0;
+ 	newstructure := r
+     end; {:239} {242:}
+ 
+     function findvariable(t: halfword): halfword;
+     label
+ 	10;
+     var
+ 	p, q, r, s: halfword;
+ 	pp, qq, rr, ss: halfword;
+ 	n: integer;
+ 	saveword: memoryword;
+     begin
+ 	p := mem[t].hh.lh;
+ 	t := mem[t].hh.rh;
+ 	if (eqtb[p].lh mod 83) <> 41 then begin
+ 	    findvariable := -30000;
+ 	    goto 10
+ 	end;
+ 	if eqtb[p].rh = (-30000) then 
+ 	    newroot(p);
+ 	p := eqtb[p].rh;
+ 	pp := p;
+ 	while t <> (-30000) do begin {243:}
+ 	    if mem[pp].hh.b0 <> 21 then begin
+ 		if mem[pp].hh.b0 > 21 then begin
+ 		    findvariable := -30000;
+ 		    goto 10
+ 		end;
+ 		ss := newstructure(pp);
+ 		if p = pp then 
+ 		    p := ss;
+ 		pp := ss
+ 	    end;
+ 	    if mem[p].hh.b0 <> 21 then 
+ 		p := newstructure(p) {:243};
+ 	    if t < himemmin then begin {244:}
+ 		n := mem[t + 1].int;
+ 		pp := mem[mem[pp + 1].hh.lh].hh.rh;
+ 		q := mem[mem[p + 1].hh.lh].hh.rh;
+ 		saveword := mem[q + 2];
+ 		mem[q + 2].int := 2147483647;
+ 		s := p + 1;
+ 		repeat
+ 		    r := s;
+ 		    s := mem[s].hh.rh
+ 		until n <= mem[s + 2].int;
+ 		if n = mem[s + 2].int then 
+ 		    p := s
+ 		else begin
+ 		    p := getnode(3);
+ 		    mem[r].hh.rh := p;
+ 		    mem[p].hh.rh := s;
+ 		    mem[p + 2].int := n;
+ 		    mem[p].hh.b1 := 3;
+ 		    mem[p].hh.b0 := 0
+ 		end;
+ 		mem[q + 2] := saveword
+ 	    end else begin {:244} {245:}
+ 		n := mem[t].hh.lh;
+ 		ss := mem[pp + 1].hh.lh;
+ 		repeat
+ 		    rr := ss;
+ 		    ss := mem[ss].hh.rh
+ 		until n <= mem[ss + 2].hh.lh;
+ 		if n < mem[ss + 2].hh.lh then begin
+ 		    qq := getnode(3);
+ 		    mem[rr].hh.rh := qq;
+ 		    mem[qq].hh.rh := ss;
+ 		    mem[qq + 2].hh.lh := n;
+ 		    mem[qq].hh.b1 := 4;
+ 		    mem[qq].hh.b0 := 0;
+ 		    mem[qq + 2].hh.rh := pp;
+ 		    ss := qq
+ 		end;
+ 		if p = pp then begin
+ 		    p := ss;
+ 		    pp := ss
+ 		end else begin
+ 		    pp := ss;
+ 		    s := mem[p + 1].hh.lh;
+ 		    repeat
+ 			r := s;
+ 			s := mem[s].hh.rh
+ 		    until n <= mem[s + 2].hh.lh;
+ 		    if n = mem[s + 2].hh.lh then 
+ 			p := s
+ 		    else begin
+ 			q := getnode(3);
+ 			mem[r].hh.rh := q;
+ 			mem[q].hh.rh := s;
+ 			mem[q + 2].hh.lh := n;
+ 			mem[q].hh.b1 := 4;
+ 			mem[q].hh.b0 := 0;
+ 			mem[q + 2].hh.rh := p;
+ 			p := q
+ 		    end
+ 		end
+ 	    end {:245};
+ 	    t := mem[t].hh.rh
+ 	end;
+ 	if mem[pp].hh.b0 >= 21 then 
+ 	    if mem[pp].hh.b0 = 21 then 
+ 		pp := mem[pp + 1].hh.lh
+ 	    else begin
+ 		findvariable := -30000;
+ 		goto 10
+ 	    end;
+ 	if mem[p].hh.b0 = 21 then 
+ 	    p := mem[p + 1].hh.lh;
+ 	if mem[p].hh.b0 = 0 then begin
+ 	    if mem[pp].hh.b0 = 0 then begin
+ 		mem[pp].hh.b0 := 15;
+ 		mem[pp + 1].int := -30000
+ 	    end;
+ 	    mem[p].hh.b0 := mem[pp].hh.b0;
+ 	    mem[p + 1].int := -30000
+ 	end;
+ 	findvariable := p;
+     10:
+ 	
+     end; {:242} {246:} {257:}
+ 
+     procedure printpath(h: halfword; s: strnumber; nuline: boolean);
+     label
+ 	30, 31;
+     var
+ 	p, q: halfword;
+     begin
+ 	printdiagnostic(384, s, nuline);
+ 	println;
+ 	p := h;
+ 	repeat
+ 	    q := mem[p].hh.rh;
+ 	    if (p = (-30000)) or (q = (-30000)) then begin
+ 		printnl(131);
+ 		goto 30
+ 	    end; {258:}
+ 	    printtwo(mem[p + 1].int, mem[p + 2].int);
+ 	    if mem[p].hh.b1 in
+ 		[0, 1, 4, 3, 2] then
+ 		case mem[p].hh.b1 of
+ 		    0:
+ 			begin
+ 			    if mem[p].hh.b0 = 4 then 
+ 				print(385);
+ 			    if (mem[q].hh.b0 <> 0) or (q <> h) then 
+ 				q := -30000;
+ 			    goto 31
+ 			end;
+ 		    1:
+ 			begin {261:}
+ 			    print(391);
+ 			    printtwo(mem[p + 5].int, mem[p + 6].int);
+ 			    print(390);
+ 			    if mem[q].hh.b0 <> 1 then 
+ 				print(392)
+ 			    else 
+ 				printtwo(mem[q + 3].int, mem[q + 4].int);
+ 			    goto 31
+ 			end; {:261}
+ 		    4: {262:}
+ 			if (mem[p].hh.b0 <> 1) and (mem[p].hh.b0 <> 4) then 
+ 			    print(385) {:262};
+ 		    3, 2:
+ 			begin {263:}
+ 			    if mem[p].hh.b0 = 4 then 
+ 				print(392);
+ 			    if mem[p].hh.b1 = 3 then begin
+ 				print(388);
+ 				printscaled(mem[p + 5].int)
+ 			    end else begin
+ 				nsincos(mem[p + 5].int);
+ 				printchar(123);
+ 				printscaled(ncos);
+ 				printchar(44);
+ 				printscaled(nsin)
+ 			    end;
+ 			    printchar(125)
+ 			end
+ 		end
+ 	    else {:263}
+ 		print(131);
+ 	    if mem[q].hh.b0 <= 1 then 
+ 		print(386)
+ 	    else if (mem[p + 6].int <> 65536) or (mem[q + 4].int <> 65536) then begin {260:}
+ 		print(389);
+ 		if mem[p + 6].int < 0 then 
+ 		    print(332);
+ 		printscaled(abs(mem[p + 6].int));
+ 		if mem[p + 6].int <> mem[q + 4].int then begin
+ 		    print(390);
+ 		    if mem[q + 4].int < 0 then 
+ 			print(332);
+ 		    printscaled(abs(mem[q + 4].int))
+ 		end
+ 	    end {:260};
+     31: {:258}
+ 	    ;
+ 	    p := q;
+ 	    if (p <> h) or (mem[h].hh.b0 <> 0) then begin {259:}
+ 		printnl(387);
+ 		if mem[p].hh.b0 = 2 then begin
+ 		    nsincos(mem[p + 3].int);
+ 		    printchar(123);
+ 		    printscaled(ncos);
+ 		    printchar(44);
+ 		    printscaled(nsin);
+ 		    printchar(125)
+ 		end else if mem[p].hh.b0 = 3 then begin
+ 		    print(388);
+ 		    printscaled(mem[p + 3].int);
+ 		    printchar(125)
+ 		end
+ 	    end {:259}
+ 	until p = h;
+ 	if mem[h].hh.b0 <> 0 then 
+ 	    print(256);
+     30:
+ 	enddiagnostic(true)
+     end; {:257}
+ {332:}
+     {333:}
+ 
+     procedure printweight(q: halfword; xoff: integer);
+     var
+ 	w, m: integer;
+ 	d: integer;
+     begin
+ 	d := mem[q].hh.lh + 32768;
+ 	w := d mod 8;
+ 	m := (d div 8) - mem[curedges + 3].hh.lh;
+ 	if fileoffset > (maxprintline - 9) then 
+ 	    printnl(32)
+ 	else 
+ 	    printchar(32);
+ 	printint(m + xoff);
+ 	while w > 4 do begin
+ 	    printchar(43);
+ 	    w := w - 1
+ 	end;
+ 	while w < 4 do begin
+ 	    printchar(45);
+ 	    w := w + 1
+ 	end
+     end; {:333}
+ 
+     procedure printedges(s: strnumber; nuline: boolean; xoff, yoff: integer);
+     var
+ 	p, q, r: halfword;
+ 	n: integer;
+     begin
+ 	printdiagnostic(399, s, nuline);
+ 	p := mem[curedges].hh.lh;
+ 	n := mem[curedges + 1].hh.rh - 4096;
+ 	while p <> curedges do begin
+ 	    q := mem[p + 1].hh.lh;
+ 	    r := mem[p + 1].hh.rh;
+ 	    if (q > (-29999)) or (r <> 30000) then begin
+ 		printnl(400);
+ 		printint(n + yoff);
+ 		printchar(58);
+ 		while q > (-29999) do begin
+ 		    printweight(q, xoff);
+ 		    q := mem[q].hh.rh
+ 		end;
+ 		print(401);
+ 		while r <> 30000 do begin
+ 		    printweight(r, xoff);
+ 		    r := mem[r].hh.rh
+ 		end
+ 	    end;
+ 	    p := mem[p].hh.lh;
+ 	    n := n - 1
+ 	end;
+ 	enddiagnostic(true)
+     end; {:332} {388:}
+ 
+     {---------------------------------------------------
+     procedure unskew(x, y: scaled; octant: smallnumber);
+ 
+     moved to mf2ps1.p
+     ---------------------------------------------------}
+ 
+     procedure printpen(p: halfword; s: strnumber; nuline: boolean);
+     var
+ 	nothingprinted: boolean;
+ 	k: 1..8;
+ 	h: halfword;
+ 	m, n: integer;
+ 	w, ww: halfword;
+     begin
+ 	printdiagnostic(436, s, nuline);
+ 	nothingprinted := true;
+ 	println;
+ 	for k := 1 to 8 do begin
+ 	    octant := octantcode[k];
+ 	    h := p + octant;
+ 	    n := mem[h].hh.lh;
+ 	    w := mem[h].hh.rh;
+ 	    if not odd(k) then 
+ 		w := mem[w].hh.lh;
+ 	    for m := 1 to n + 1 do begin
+ 		if odd(k) then 
+ 		    ww := mem[w].hh.rh
+ 		else 
+ 		    ww := mem[w].hh.lh;
+ 		if (mem[ww + 1].int <> mem[w + 1].int) or (mem[ww + 2].int <> mem[w + 2].int) then begin {474:}
+ 		    if nothingprinted then 
+ 			nothingprinted := false
+ 		    else 
+ 			printnl(438);
+ 		    unskew(mem[ww + 1].int, mem[ww + 2].int, octant);
+ 		    printtwo(curx, cury)
+ 		end {:474};
+ 		w := ww
+ 	    end
+ 	end;
+ 	if nothingprinted then begin
+ 	    w := mem[p + 1].hh.rh;
+ 	    printtwo(mem[w + 1].int + mem[w + 2].int, mem[w + 2].int)
+ 	end;
+ 	printnl(437);
+ 	enddiagnostic(true)
+     end; {:473} {589:}
+ 
+     procedure printdependency(p: halfword; t: smallnumber);
+     label
+ 	10;
+     var
+ 	v: integer;
+ 	pp, q: halfword;
+     begin
+ 	pp := p;
+ 	while true do begin
+ 	    v := abs(mem[p + 1].int);
+ 	    q := mem[p].hh.lh;
+ 	    if q = (-30000) then begin
+ 		if (v <> 0) or (p = pp) then begin
+ 		    if mem[p + 1].int > 0 then 
+ 			if p <> pp then 
+ 			    printchar(43);
+ 		    printscaled(mem[p + 1].int)
+ 		end;
+ 		goto 10
+ 	    end;
+ {590:}
+ 	    if mem[p + 1].int < 0 then 
+ 		printchar(45)
+ 	    else if p <> pp then 
+ 		printchar(43);
+ 	    if t = 17 then 
+ 		v := roundfraction(v);
+ 	    if v <> 65536 then 
+ 		printscaled(v) {:590};
+ 	    if mem[q].hh.b0 <> 19 then 
+ 		confusion(454);
+ 	    printvariablename(q);
+ 	    v := mem[q + 1].int mod 64;
+ 	    while v > 0 do begin
+ 		print(455);
+ 		v := v - 2
+ 	    end;
+ 	    p := mem[p].hh.rh
+ 	end;
+     10:
+ 	
+     end; {:589} {801:} {805:}
+ 
+     procedure printdp(t: smallnumber; p: halfword; verbosity: smallnumber);
+     var
+ 	q: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	if (mem[q].hh.lh = (-30000)) or (verbosity > 0) then 
+ 	    printdependency(p, t)
+ 	else 
+ 	    print(628)
+     end; {:805} {799:}
+ 
+     function stashcurexp: halfword;
+     var
+ 	p: halfword;
+     begin
+ 	if curtype in
+ 	    [3, 5, 7, 12, 10, 13, 14, 17,
+ 	     18, 19] then
+ 	    case curtype of
+ 		3, 5, 7, 12, 10, 13, 14,
+ 		17, 18, 19:
+ 		    p := curexp
+ 	    end
+ 	else
+ 	    begin
+ 		p := getnode(2);
+ 		mem[p].hh.b1 := 11;
+ 		mem[p].hh.b0 := curtype;
+ 		mem[p + 1].int := curexp
+ 	    end;
+ 	curtype := 1;
+ 	mem[p].hh.rh := -29999;
+ 	stashcurexp := p
+     end; {:799} {800:}
+ 
+     procedure unstashcurexp(p: halfword);
+     begin
+ 	curtype := mem[p].hh.b0;
+ 	if curtype in
+ 	    [3, 5, 7, 12, 10, 13, 14, 17,
+ 	     18, 19] then
+ 	    case curtype of
+ 		3, 5, 7, 12, 10, 13, 14,
+ 		17, 18, 19:
+ 		    curexp := p
+ 	    end
+ 	else
+ 	    begin
+ 		curexp := mem[p + 1].int;
+ 		freenode(p, 2)
+ 	    end
+     end; {:800}
+ 
+     procedure printexp(p: halfword; verbosity: smallnumber);
+     var
+ 	restorecurexp: boolean;
+ 	t: smallnumber;
+ 	v: integer;
+ 	q: halfword;
+     begin
+ 	if p <> (-30000) then 
+ 	    restorecurexp := false
+ 	else begin
+ 	    p := stashcurexp;
+ 	    restorecurexp := true
+ 	end;
+ 	t := mem[p].hh.b0;
+ 	if t < 17 then 
+ 	    v := mem[p + 1].int
+ 	else if t < 19 then 
+ 	    v := mem[p + 1].hh.rh; {802:}
+ 	if t in
+ 	    [1, 2, 3, 5, 7, 12, 10, 15,
+ 	     4, 6, 8, 9, 11, 13, 14, 16,
+ 	     17, 18, 19] then
+ 	    case t of
+ 		1:
+ 		    print(194);
+ 		2:
+ 		    if v = 30 then 
+ 			print(218)
+ 		    else 
+ 			print(219);
+ 		3, 5, 7, 12, 10, 15:
+ 		    begin {806:}
+ 			printtype(t);
+ 			if v <> (-30000) then begin
+ 			    printchar(32);
+ 			    while (mem[v].hh.b1 = 11) and (v <> p) do 
+ 				v := mem[v + 1].int;
+ 			    printvariablename(v)
+ 			end
+ 		    end; {:806}
+ 		4:
+ 		    begin
+ 			printchar(34);
+ 			slowprint(v);
+ 			printchar(34)
+ 		    end;
+ 		6, 8, 9, 11: {804:}
+ 		    if verbosity <= 1 then 
+ 			printtype(t)
+ 		    else begin
+ 			if selector = 3 then 
+ 			    if internal[13] <= 0 then begin
+ 				selector := 1;
+ 				printtype(t);
+ 				print(626);
+ 				selector := 3
+ 			    end;
+ 			case t of
+ 			    6:
+ 				printpen(v, 155, false);
+ 			    8:
+ 				printpath(v, 627, false);
+ 			    9:
+ 				printpath(v, 155, false);
+ 			    11:
+ 				begin
+ 				    curedges := v;
+ 				    printedges(155, false, 0, 0)
+ 				end
+ 			end
+ 		    end {:804};
+ 		13, 14:
+ 		    if v = (-30000) then 
+ 			printtype(t) {803:}
+ 		    else begin
+ 			printchar(40);
+ 			q := v + bignodesize[t];
+ 			repeat
+ 			    if mem[v].hh.b0 = 16 then 
+ 				printscaled(mem[v + 1].int)
+ 			    else if mem[v].hh.b0 = 19 then 
+ 				printvariablename(v)
+ 			    else 
+ 				printdp(mem[v].hh.b0, mem[v + 1].hh.rh, verbosity);
+ 			    v := v + 2;
+ 			    if v <> q then 
+ 				printchar(44)
+ 			until v = q;
+ 			printchar(41)
+ 		    end {:803};
+ 		16:
+ 		    printscaled(v);
+ 		17, 18:
+ 		    printdp(t, v, verbosity);
+ 		19:
+ 		    printvariablename(p)
+ 	    end
+ 	else
+ 	    confusion(625) {:802};
+ 	if restorecurexp then 
+ 	    unstashcurexp(p)
+     end; {:801} {807:}
+ 
+     procedure disperr(p: halfword; s: strnumber);
+     begin
+ 	if interaction = 3 then 
+ 	    ;
+ 	printnl(629);
+ 	printexp(p, 1);
+ 	if s <> 155 then begin
+ 	    printnl(133);
+ 	    print(s)
+ 	end
+     end; {:807} {594:}
+ 
+     function pplusfq(p: halfword; f: integer; q: halfword; t, tt: smallnumber): halfword;
+     label
+ 	30;
+     var
+ 	pp, qq: halfword;
+ 	r, s: halfword;
+ 	threshold: integer;
+ 	v: integer;
+     begin
+ 	if t = 17 then 
+ 	    threshold := 2685
+ 	else 
+ 	    threshold := 8;
+ 	r := 29999;
+ 	pp := mem[p].hh.lh;
+ 	qq := mem[q].hh.lh;
+ 	while true do 
+ 	    if pp = qq then 
+ 		if pp = (-30000) then 
+ 		    goto 30 {595:}
+ 		else begin
+ 		    if tt = 17 then 
+ 			v := mem[p + 1].int + takefraction(f, mem[q + 1].int)
+ 		    else 
+ 			v := mem[p + 1].int + takescaled(f, mem[q + 1].int);
+ 		    mem[p + 1].int := v;
+ 		    s := p;
+ 		    p := mem[p].hh.rh;
+ 		    if abs(v) < threshold then 
+ 			freenode(s, 2)
+ 		    else begin
+ 			if abs(v) >= 626349397 then 
+ 			    if watchcoefs then begin
+ 				mem[qq].hh.b0 := 0;
+ 				fixneeded := true
+ 			    end;
+ 			mem[r].hh.rh := s;
+ 			r := s
+ 		    end;
+ 		    pp := mem[p].hh.lh;
+ 		    q := mem[q].hh.rh;
+ 		    qq := mem[q].hh.lh
+ 		end {:595}
+ 	    else if mem[pp + 1].int < mem[qq + 1].int then begin {596:}
+ 		if tt = 17 then 
+ 		    v := takefraction(f, mem[q + 1].int)
+ 		else 
+ 		    v := takescaled(f, mem[q + 1].int);
+ 		if abs(v) > (threshold div 2) then begin
+ 		    s := getnode(2);
+ 		    mem[s].hh.lh := qq;
+ 		    mem[s + 1].int := v;
+ 		    if abs(v) >= 626349397 then 
+ 			if watchcoefs then begin
+ 			    mem[qq].hh.b0 := 0;
+ 			    fixneeded := true
+ 			end;
+ 		    mem[r].hh.rh := s;
+ 		    r := s
+ 		end;
+ 		q := mem[q].hh.rh;
+ 		qq := mem[q].hh.lh
+ 	    end else begin {:596}
+ 		mem[r].hh.rh := p;
+ 		r := p;
+ 		p := mem[p].hh.rh;
+ 		pp := mem[p].hh.lh
+ 	    end;
+     30:
+ 	if t = 17 then 
+ 	    mem[p + 1].int := slowadd(mem[p + 1].int, takefraction(mem[q + 1].int, f))
+ 	else 
+ 	    mem[p + 1].int := slowadd(mem[p + 1].int, takescaled(mem[q + 1].int, f));
+ 	mem[r].hh.rh := p;
+ 	depfinal := p;
+ 	pplusfq := mem[29999].hh.rh
+     end; {:594}
+ {600:}
+ 
+     function poverv(p: halfword; v: scaled; t0, t1: smallnumber): halfword;
+     var
+ 	r, s: halfword;
+ 	w: integer;
+ 	threshold: integer;
+ 	scalingdown: boolean;
+     begin
+ 	if t0 <> t1 then 
+ 	    scalingdown := true
+ 	else 
+ 	    scalingdown := false;
+ 	if t1 = 17 then 
+ 	    threshold := 1342
+ 	else 
+ 	    threshold := 4;
+ 	r := 29999;
+ 	while mem[p].hh.lh <> (-30000) do begin
+ 	    if scalingdown then 
+ 		if abs(v) < 524288 then 
+ 		    w := makescaled(mem[p + 1].int, v * 4096)
+ 		else 
+ 		    w := makescaled(roundfraction(mem[p + 1].int), v)
+ 	    else 
+ 		w := makescaled(mem[p + 1].int, v);
+ 	    if abs(w) <= threshold then begin
+ 		s := mem[p].hh.rh;
+ 		freenode(p, 2);
+ 		p := s
+ 	    end else begin
+ 		if abs(w) >= 626349397 then begin
+ 		    fixneeded := true;
+ 		    mem[mem[p].hh.lh].hh.b0 := 0
+ 		end;
+ 		mem[r].hh.rh := p;
+ 		r := p;
+ 		mem[p + 1].int := w;
+ 		p := mem[p].hh.rh
+ 	    end
+ 	end;
+ 	mem[r].hh.rh := p;
+ 	mem[p + 1].int := makescaled(mem[p + 1].int, v);
+ 	poverv := mem[29999].hh.rh
+     end; { poverv }
+ {:600}
+     {602:}
+ 
+     procedure valtoobig(x: scaled);
+     begin
+ 	if internal[40] > 0 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(456)
+ 	    end;
+ 	    printscaled(x);
+ 	    printchar(41);
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 457;
+ 		helpline[2] := 458;
+ 		helpline[1] := 459;
+ 		helpline[0] := 460
+ 	    end;
+ 	    error
+ 	end
+     end; {:602} {603:}
+ 
+     procedure makeknown(p, q: halfword);
+     var
+ 	t: 17..18;
+     begin
+ 	mem[mem[q].hh.rh + 1].hh.lh := mem[p + 1].hh.lh;
+ 	mem[mem[p + 1].hh.lh].hh.rh := mem[q].hh.rh;
+ 	t := mem[p].hh.b0;
+ 	mem[p].hh.b0 := 16;
+ 	mem[p + 1].int := mem[q + 1].int;
+ 	freenode(q, 2);
+ 	if abs(mem[p + 1].int) >= 268435456 then 
+ 	    valtoobig(mem[p + 1].int);
+ 	if internal[2] > 0 then 
+ 	    if interesting(p) then begin
+ 		begindiagnostic;
+ 		printnl(461);
+ 		printvariablename(p);
+ 		printchar(61);
+ 		printscaled(mem[p + 1].int);
+ 		enddiagnostic(false)
+ 	    end;
+ 	if curexp = p then 
+ 	    if curtype = t then begin
+ 		curtype := 16;
+ 		curexp := mem[p + 1].int;
+ 		freenode(p, 2)
+ 	    end
+     end; {:603} {604:}
+ 
+     procedure fixdependencies;
+     label
+ 	30;
+     var
+ 	p, q, r, s, t: halfword;
+ 	x: halfword;
+     begin
+ 	r := mem[-29987].hh.rh;
+ 	s := -30000;
+ 	while r <> (-29987) do begin
+ 	    t := r;
+ {605:}
+ 	    r := t + 1;
+ 	    while true do begin
+ 		q := mem[r].hh.rh;
+ 		x := mem[q].hh.lh;
+ 		if x = (-30000) then 
+ 		    goto 30;
+ 		if mem[x].hh.b0 <= 1 then begin
+ 		    if mem[x].hh.b0 < 1 then begin
+ 			p := getavail;
+ 			mem[p].hh.rh := s;
+ 			s := p;
+ 			mem[s].hh.lh := x;
+ 			mem[x].hh.b0 := 1
+ 		    end;
+ 		    mem[q + 1].int := mem[q + 1].int div 4;
+ 		    if mem[q + 1].int = 0 then begin
+ 			mem[r].hh.rh := mem[q].hh.rh;
+ 			freenode(q, 2);
+ 			q := r
+ 		    end
+ 		end;
+ 		r := q
+ 	    end;
+     30: {:605}
+ 	    ;
+ 	    r := mem[q].hh.rh;
+ 	    if q = mem[t + 1].hh.rh then 
+ 		makeknown(t, q)
+ 	end;
+ 	while s <> (-30000) do begin
+ 	    p := mem[s].hh.rh;
+ 	    x := mem[s].hh.lh;
+ 	    begin
+ 		mem[s].hh.rh := avail;
+ 		avail := s
+ 	    end {dynused:=dynused-1;};
+ 	    s := p;
+ 	    mem[x].hh.b0 := 19;
+ 	    mem[x + 1].int := mem[x + 1].int + 2
+ 	end;
+ 	fixneeded := false
+     end; { fixdependencies }
+ {:604}
+     {268:}
+ 
+     procedure tossknotlist(p: halfword);
+     var
+ 	q: halfword;
+ 	r: halfword;
+     begin
+ 	q := p;
+ 	repeat
+ 	    r := mem[q].hh.rh;
+ 	    freenode(q, 7);
+ 	    q := r
+ 	until q = p
+     end; {:268} {385:}
+ 
+     procedure tossedges(h: halfword);
+     var
+ 	p, q: halfword;
+     begin
+ 	q := mem[h].hh.rh;
+ 	while q <> h do begin
+ 	    flushlist(mem[q + 1].hh.rh);
+ 	    if mem[q + 1].hh.lh > (-29999) then 
+ 		flushlist(mem[q + 1].hh.lh);
+ 	    p := q;
+ 	    q := mem[q].hh.rh;
+ 	    freenode(p, 2)
+ 	end;
+ 	freenode(h, 6)
+     end; {:385} {487:}
+ 
+     procedure tosspen(p: halfword);
+     var
+ 	k: 1..8;
+ 	w, ww: halfword;
+     begin
+ 	if p <> (-29997) then begin
+ 	    for k := 1 to 8 do begin
+ 		w := mem[p + k].hh.rh;
+ 		repeat
+ 		    ww := mem[w].hh.rh;
+ 		    freenode(w, 3);
+ 		    w := ww
+ 		until w = mem[p + k].hh.rh
+ 	    end;
+ 	    freenode(p, 10)
+ 	end
+     end; {:487} {620:}
+ 
+     procedure ringdelete(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	q := mem[p + 1].int;
+ 	if q <> (-30000) then 
+ 	    if q <> p then begin
+ 		while mem[q + 1].int <> p do 
+ 		    q := mem[q + 1].int;
+ 		mem[q + 1].int := mem[p + 1].int
+ 	    end
+     end; {:620} {809:}
+ 
+     procedure recyclevalue(p: halfword);
+     label
+ 	30;
+     var
+ 	t: smallnumber;
+ 	v: integer;
+ 	vv: integer;
+ 	q, r, s, pp: halfword;
+     begin
+ 	t := mem[p].hh.b0;
+ 	if t < 17 then 
+ 	    v := mem[p + 1].int;
+ 	case t of
+ 	    0, 1, 2, 16, 15:
+ 		;
+ 	    3, 5, 7, 12, 10:
+ 		ringdelete(p);
+ 	    4:
+ 		begin
+ 		    if strref[v] < 127 then 
+ 			if strref[v] > 1 then 
+ 			    strref[v] := strref[v] - 1
+ 			else 
+ 			    flushstring(v)
+ 		end;
+ 	    6:
+ 		if mem[v].hh.lh = (-30000) then 
+ 		    tosspen(v)
+ 		else 
+ 		    mem[v].hh.lh := mem[v].hh.lh - 1;
+ 	    9, 8:
+ 		tossknotlist(v);
+ 	    11:
+ 		tossedges(v);
+ 	    14, 13: {810:}
+ 		if v <> (-30000) then begin
+ 		    q := v + bignodesize[t];
+ 		    repeat
+ 			q := q - 2;
+ 			recyclevalue(q)
+ 		    until q = v;
+ 		    freenode(v, bignodesize[t])
+ 		end {:810};
+ 	    17, 18:
+ 		begin {811:}
+ 		    q := mem[p + 1].hh.rh;
+ 		    while mem[q].hh.lh <> (-30000) do 
+ 			q := mem[q].hh.rh;
+ 		    mem[mem[p + 1].hh.lh].hh.rh := mem[q].hh.rh;
+ 		    mem[mem[q].hh.rh + 1].hh.lh := mem[p + 1].hh.lh;
+ 		    mem[q].hh.rh := -30000;
+ 		    flushnodelist(mem[p + 1].hh.rh)
+ 		end; {:811}
+ 	    19:
+ 		begin {812:}
+ 		    maxc[17] := 0;
+ 		    maxc[18] := 0;
+ 		    maxlink[17] := -30000;
+ 		    maxlink[18] := -30000;
+ 		    q := mem[-29987].hh.rh;
+ 		    while q <> (-29987) do begin
+ 			s := q + 1;
+ 			while true do begin
+ 			    r := mem[s].hh.rh;
+ 			    if mem[r].hh.lh = (-30000) then 
+ 				goto 30;
+ 			    if mem[r].hh.lh <> p then 
+ 				s := r
+ 			    else begin
+ 				t := mem[q].hh.b0;
+ 				mem[s].hh.rh := mem[r].hh.rh;
+ 				mem[r].hh.lh := q;
+ 				if abs(mem[r + 1].int) > maxc[t] then begin {814:}
+ 				    if maxc[t] > 0 then begin
+ 					mem[maxptr[t]].hh.rh := maxlink[t];
+ 					maxlink[t] := maxptr[t]
+ 				    end;
+ 				    maxc[t] := abs(mem[r + 1].int);
+ 				    maxptr[t] := r
+ 				end else begin {:814}
+ 				    mem[r].hh.rh := maxlink[t];
+ 				    maxlink[t] := r
+ 				end
+ 			    end
+ 			end;
+     30:
+ 			q := mem[r].hh.rh
+ 		    end;
+ 		    if (maxc[17] > 0) or (maxc[18] > 0) then begin {815:}
+ 			if (maxc[17] >= 268435456) or ((maxc[17] div 4096) >= maxc[18]) then 
+ 			    t := 17
+ 			else 
+ 			    t := 18; {816:}
+ 			s := maxptr[t];
+ 			pp := mem[s].hh.lh;
+ 			v := mem[s + 1].int;
+ 			if t = 17 then 
+ 			    mem[s + 1].int := -268435456
+ 			else 
+ 			    mem[s + 1].int := -65536;
+ 			r := mem[pp + 1].hh.rh;
+ 			mem[s].hh.rh := r;
+ 			while mem[r].hh.lh <> (-30000) do 
+ 			    r := mem[r].hh.rh;
+ 			q := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000;
+ 			mem[q + 1].hh.lh := mem[pp + 1].hh.lh;
+ 			mem[mem[pp + 1].hh.lh].hh.rh := q;
+ 			begin
+ 			    mem[pp].hh.b0 := 19;
+ 			    serialno := serialno + 64;
+ 			    mem[pp + 1].int := serialno
+ 			end;
+ 			if curexp = pp then 
+ 			    if curtype = t then 
+ 				curtype := 19;
+ 			if internal[2] > 0 then  {817:}
+ 			    if interesting(p) then begin
+ 				begindiagnostic;
+ 				printnl(631);
+ 				if v > 0 then 
+ 				    printchar(45);
+ 				if t = 17 then 
+ 				    vv := roundfraction(maxc[17])
+ 				else 
+ 				    vv := maxc[18];
+ 				if vv <> 65536 then 
+ 				    printscaled(vv);
+ 				printvariablename(p);
+ 				while (mem[p + 1].int mod 64) > 0 do begin
+ 				    print(455);
+ 				    mem[p + 1].int := mem[p + 1].int - 2
+ 				end;
+ 				if t = 17 then 
+ 				    printchar(61)
+ 				else 
+ 				    print(632);
+ 				printdependency(s, t);
+ 				enddiagnostic(false)
+ 			    end {:817} {:816};
+ 			t := 35 - t;
+ 			if maxc[t] > 0 then begin
+ 			    mem[maxptr[t]].hh.rh := maxlink[t];
+ 			    maxlink[t] := maxptr[t]
+ 			end;
+ 			if t <> 17 then  {818:}
+ 			    for t := 17 to 18 do begin
+ 				r := maxlink[t];
+ 				while r <> (-30000) do begin
+ 				    q := mem[r].hh.lh;
+ 				    mem[q + 1].hh.rh := pplusfq(mem[q + 1].hh.rh, makefraction(mem[r + 1].int, -v), s, t, 17);
+ 				    if mem[q + 1].hh.rh = depfinal then 
+ 					makeknown(q, depfinal);
+ 				    q := r;
+ 				    r := mem[r].hh.rh;
+ 				    freenode(q, 2)
+ 				end
+ 			    end {:818} {819:}
+ 			else 
+ 			    for t := 17 to 18 do begin
+ 				r := maxlink[t];
+ 				while r <> (-30000) do begin
+ 				    q := mem[r].hh.lh;
+ 				    if t = 17 then begin
+ 					if curexp = q then 
+ 					    if curtype = 17 then 
+ 						curtype := 18;
+ 					mem[q + 1].hh.rh := poverv(mem[q + 1].hh.rh, 65536, 17, 18);
+ 					mem[q].hh.b0 := 18;
+ 					mem[r + 1].int := roundfraction(mem[r + 1].int)
+ 				    end;
+ 				    mem[q + 1].hh.rh := pplusfq(mem[q + 1].hh.rh, makescaled(mem[r + 1].int, -v), s, 18, 18);
+ 				    if mem[q + 1].hh.rh = depfinal then 
+ 					makeknown(q, depfinal);
+ 				    q := r;
+ 				    r := mem[r].hh.rh;
+ 				    freenode(q, 2)
+ 				end
+ 			    end {:819};
+ 			flushnodelist(s);
+ 			if fixneeded then 
+ 			    fixdependencies;
+ 			begin
+ 			    if aritherror then 
+ 				cleararith
+ 			end
+ 		    end {:815}
+ 		end; {:812}
+ 	    20, 21:
+ 		confusion(630);
+ 	    22, 23:
+ 		deletemacref(mem[p + 1].int)
+ 	end;
+ 	mem[p].hh.b0 := 0
+     end; {:809} {808:}
+ 
+     procedure flushcurexp(v: scaled);
+     begin
+ 	if curtype in
+ 	    [3, 5, 7, 12, 10, 13, 14, 17,
+ 	     18, 19, 6, 4, 8, 9, 11] then
+ 	    case curtype of
+ 		3, 5, 7, 12, 10, 13, 14,
+ 		17, 18, 19:
+ 		    begin
+ 			recyclevalue(curexp);
+ 			freenode(curexp, 2)
+ 		    end;
+ 		6:
+ 		    if mem[curexp].hh.lh = (-30000) then 
+ 			tosspen(curexp)
+ 		    else 
+ 			mem[curexp].hh.lh := mem[curexp].hh.lh - 1;
+ 		4:
+ 		    begin
+ 			if strref[curexp] < 127 then 
+ 			    if strref[curexp] > 1 then 
+ 				strref[curexp] := strref[curexp] - 1
+ 			    else 
+ 				flushstring(curexp)
+ 		    end;
+ 		8, 9:
+ 		    tossknotlist(curexp);
+ 		11:
+ 		    tossedges(curexp)
+ 	    end
+ 	else
+ 	    ;
+ 	curtype := 16;
+ 	curexp := v
+     end; {:808} {820:}
+ 
+     procedure flusherror(v: scaled);
+     begin
+ 	error;
+ 	flushcurexp(v)
+     end;
+ 
+     procedure backerror;
+     forward;
+ 
+     procedure getxnext;
+     forward;
+ 
+     procedure putgeterror;
+     begin
+ 	backerror;
+ 	getxnext
+     end; { putgeterror }
+ 
+     procedure putgetflusherror(v: scaled);
+     begin
+ 	putgeterror;
+ 	flushcurexp(v)
+     end; {:820} {247:}
+ 
+     procedure flushbelowvariable(p: halfword);
+     var
+ 	q, r: halfword;
+     begin
+ 	if mem[p].hh.b0 <> 21 then 
+ 	    recyclevalue(p)
+ 	else begin
+ 	    q := mem[p + 1].hh.rh;
+ 	    while mem[q].hh.b1 = 3 do begin
+ 		flushbelowvariable(q);
+ 		r := q;
+ 		q := mem[q].hh.rh;
+ 		freenode(r, 3)
+ 	    end;
+ 	    r := mem[p + 1].hh.lh;
+ 	    q := mem[r].hh.rh;
+ 	    recyclevalue(r);
+ 	    if mem[p].hh.b1 <= 1 then 
+ 		freenode(r, 2)
+ 	    else 
+ 		freenode(r, 3);
+ 	    repeat
+ 		flushbelowvariable(q);
+ 		r := q;
+ 		q := mem[q].hh.rh;
+ 		freenode(r, 3)
+ 	    until q = (-29983);
+ 	    mem[p].hh.b0 := 0
+ 	end
+     end; {:247}
+ 
+     procedure flushvariable(p, t: halfword; discardsuffixes: boolean);
+     label
+ 	10;
+     var
+ 	q, r: halfword;
+ 	n: halfword;
+     begin
+ 	while t <> (-30000) do begin
+ 	    if mem[p].hh.b0 <> 21 then 
+ 		goto 10;
+ 	    n := mem[t].hh.lh;
+ 	    t := mem[t].hh.rh;
+ 	    if n = 0 then begin
+ 		r := p + 1;
+ 		q := mem[r].hh.rh;
+ 		while mem[q].hh.b1 = 3 do begin
+ 		    flushvariable(q, t, discardsuffixes);
+ 		    if t = (-30000) then 
+ 			if mem[q].hh.b0 = 21 then 
+ 			    r := q
+ 			else begin
+ 			    mem[r].hh.rh := mem[q].hh.rh;
+ 			    freenode(q, 3)
+ 			end
+ 		    else 
+ 			r := q;
+ 		    q := mem[r].hh.rh
+ 		end
+ 	    end;
+ 	    p := mem[p + 1].hh.lh;
+ 	    repeat
+ 		r := p;
+ 		p := mem[p].hh.rh
+ 	    until mem[p + 2].hh.lh >= n;
+ 	    if mem[p + 2].hh.lh <> n then 
+ 		goto 10
+ 	end;
+ 	if discardsuffixes then 
+ 	    flushbelowvariable(p)
+ 	else begin
+ 	    if mem[p].hh.b0 = 21 then 
+ 		p := mem[p + 1].hh.lh;
+ 	    recyclevalue(p)
+ 	end;
+     10:
+ 	
+     end; {:246} {248:}
+ 
+     function undtype(p: halfword): smallnumber;
+     begin
+ 	case mem[p].hh.b0 of
+ 	    0, 1:
+ 		undtype := 0;
+ 	    2, 3:
+ 		undtype := 3;
+ 	    4, 5:
+ 		undtype := 5;
+ 	    6, 7, 8:
+ 		undtype := 7;
+ 	    9, 10:
+ 		undtype := 10;
+ 	    11, 12:
+ 		undtype := 12;
+ 	    13, 14, 15:
+ 		undtype := mem[p].hh.b0;
+ 	    16, 17, 18, 19:
+ 		undtype := 15
+ 	end
+     end; {:248}
+ {249:}
+ 
+     procedure clearsymbol(p: halfword; saving: boolean);
+     var
+ 	q: halfword;
+     begin
+ 	q := eqtb[p].rh;
+ 	if eqtb[p].lh mod 83 in
+ 	    [10, 53, 44, 49, 41] then
+ 	    case eqtb[p].lh mod 83 of
+ 		10, 53, 44, 49:
+ 		    if not saving then 
+ 			deletemacref(q);
+ 		41:
+ 		    if q <> (-30000) then 
+ 			if saving then 
+ 			    mem[q].hh.b1 := 1
+ 			else begin
+ 			    flushbelowvariable(q);
+ 			    freenode(q, 2)
+ 			end
+ 	    end
+ 	else
+ 	    ;
+ 	eqtb[p] := eqtb[2241]
+     end; {:249} {252:}
+ 
+     procedure savevariable(q: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	if saveptr <> (-30000) then begin
+ 	    p := getnode(2);
+ 	    mem[p].hh.lh := q;
+ 	    mem[p].hh.rh := saveptr;
+ 	    mem[p + 1].hh := eqtb[q];
+ 	    saveptr := p
+ 	end;
+ 	clearsymbol(q, saveptr <> (-30000))
+     end; {:252} {253:}
+ 
+     procedure saveinternal(q: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	if saveptr <> (-30000) then begin
+ 	    p := getnode(2);
+ 	    mem[p].hh.lh := 2241 + q;
+ 	    mem[p].hh.rh := saveptr;
+ 	    mem[p + 1].int := internal[q];
+ 	    saveptr := p
+ 	end
+     end; { saveinternal }
+ {:253}
+     {254:}
+ 
+     procedure unsave;
+     var
+ 	q: halfword;
+ 	p: halfword;
+     begin
+ 	while mem[saveptr].hh.lh <> 0 do begin
+ 	    q := mem[saveptr].hh.lh;
+ 	    if q > 2241 then begin
+ 		if internal[8] > 0 then begin
+ 		    begindiagnostic;
+ 		    printnl(383);
+ 		    print(intname[q - 2241]);
+ 		    printchar(61);
+ 		    printscaled(mem[saveptr + 1].int);
+ 		    printchar(125);
+ 		    enddiagnostic(false)
+ 		end;
+ 		internal[q - 2241] := mem[saveptr + 1].int
+ 	    end else begin
+ 		if internal[8] > 0 then begin
+ 		    begindiagnostic;
+ 		    printnl(383);
+ 		    print(hash[q].rh);
+ 		    printchar(125);
+ 		    enddiagnostic(false)
+ 		end;
+ 		clearsymbol(q, false);
+ 		eqtb[q] := mem[saveptr + 1].hh;
+ 		if (eqtb[q].lh mod 83) = 41 then begin
+ 		    p := eqtb[q].rh;
+ 		    if p <> (-30000) then 
+ 			mem[p].hh.b1 := 0
+ 		end
+ 	    end;
+ 	    p := mem[saveptr].hh.rh;
+ 	    freenode(saveptr, 2);
+ 	    saveptr := p
+ 	end;
+ 	p := mem[saveptr].hh.rh;
+ 	begin
+ 	    mem[saveptr].hh.rh := avail;
+ 	    avail := saveptr
+ 	end {dynused:=dynused-1;};
+ 	saveptr := p
+     end; {:254} {264:}
+ 
+     function copyknot(p: halfword): halfword;
+     var
+ 	q: halfword;
+ 	k: 0..6;
+     begin
+ 	q := getnode(7);
+ 	for k := 0 to 6 do 
+ 	    mem[q + k] := mem[p + k];
+ 	copyknot := q
+     end; {:264} {265:}
+ 
+     function copypath(p: halfword): halfword;
+     label
+ 	10;
+     var
+ 	q, pp, qq: halfword;
+     begin
+ 	q := getnode(7);
+ 	qq := q;
+ 	pp := p;
+ 	while true do begin
+ 	    mem[qq].hh.b0 := mem[pp].hh.b0;
+ 	    mem[qq].hh.b1 := mem[pp].hh.b1;
+ 	    mem[qq + 1].int := mem[pp + 1].int;
+ 	    mem[qq + 2].int := mem[pp + 2].int;
+ 	    mem[qq + 3].int := mem[pp + 3].int;
+ 	    mem[qq + 4].int := mem[pp + 4].int;
+ 	    mem[qq + 5].int := mem[pp + 5].int;
+ 	    mem[qq + 6].int := mem[pp + 6].int;
+ 	    if mem[pp].hh.rh = p then begin
+ 		mem[qq].hh.rh := q;
+ 		copypath := q;
+ 		goto 10
+ 	    end;
+ 	    mem[qq].hh.rh := getnode(7);
+ 	    qq := mem[qq].hh.rh;
+ 	    pp := mem[pp].hh.rh
+ 	end;
+     10:
+ 	
+     end; {:265} {266:}
+ 
+     function htapypoc(p: halfword): halfword;
+     label
+ 	10;
+     var
+ 	q, pp, qq, rr: halfword;
+     begin
+ 	q := getnode(7);
+ 	qq := q;
+ 	pp := p;
+ 	while true do begin
+ 	    mem[qq].hh.b1 := mem[pp].hh.b0;
+ 	    mem[qq].hh.b0 := mem[pp].hh.b1;
+ 	    mem[qq + 1].int := mem[pp + 1].int;
+ 	    mem[qq + 2].int := mem[pp + 2].int;
+ 	    mem[qq + 5].int := mem[pp + 3].int;
+ 	    mem[qq + 6].int := mem[pp + 4].int;
+ 	    mem[qq + 3].int := mem[pp + 5].int;
+ 	    mem[qq + 4].int := mem[pp + 6].int;
+ 	    if mem[pp].hh.rh = p then begin
+ 		mem[q].hh.rh := qq;
+ 		pathtail := pp;
+ 		htapypoc := q;
+ 		goto 10
+ 	    end;
+ 	    rr := getnode(7);
+ 	    mem[rr].hh.rh := qq;
+ 	    qq := rr;
+ 	    pp := mem[pp].hh.rh
+ 	end;
+     10:
+ 	
+     end; {:266} {269:} {284:} {296:}
+ 
+     function curlratio(gamma, atension, btension: scaled): fraction;
+     var
+ 	alpha, beta, num, denom, ff: fraction;
+     begin
+ 	alpha := makefraction(65536, atension);
+ 	beta := makefraction(65536, btension);
+ 	if alpha <= beta then begin
+ 	    ff := makefraction(alpha, beta);
+ 	    ff := takefraction(ff, ff);
+ 	    gamma := takefraction(gamma, ff);
+ 	    beta := beta div 4096;
+ 	    denom := (takefraction(gamma, alpha) + 196608) - beta;
+ 	    num := takefraction(gamma, 805306368 - alpha) + beta
+ 	end else begin
+ 	    ff := makefraction(beta, alpha);
+ 	    ff := takefraction(ff, ff);
+ 	    beta := takefraction(beta, ff) div 4096;
+ 	    denom := (takefraction(gamma, alpha) + (ff div 1365)) - beta;
+ 	    num := takefraction(gamma, 805306368 - alpha) + beta
+ 	end;
+ 	if num >= (((denom + denom) + denom) + denom) then 
+ 	    curlratio := 1073741824
+ 	else 
+ 	    curlratio := makefraction(num, denom)
+     end; {:296} {299:}
+ 
+     procedure setcontrols(p, q: halfword; k: integer);
+     var
+ 	rr, ss: fraction;
+ 	lt, rt: scaled;
+ 	sine: fraction;
+     begin
+ 	lt := abs(mem[q + 4].int);
+ 	rt := abs(mem[p + 6].int);
+ 	rr := velocity(st, ct, sf, cf, rt);
+ 	ss := velocity(sf, cf, st, ct, lt);
+ 	if (mem[p + 6].int < 0) or (mem[q + 4].int < 0) then  {300:}
+ 	    if ((st >= 0) and (sf >= 0)) or ((st <= 0) and (sf <= 0)) then begin
+ 		sine := takefraction(abs(st), cf) + takefraction(abs(sf), ct);
+ 		if sine > 0 then begin
+ 		    sine := takefraction(sine, 268500992);
+ 		    if mem[p + 6].int < 0 then 
+ 			if abvscd(abs(sf), 268435456, rr, sine) < 0 then 
+ 			    rr := makefraction(abs(sf), sine);
+ 		    if mem[q + 4].int < 0 then 
+ 			if abvscd(abs(st), 268435456, ss, sine) < 0 then 
+ 			    ss := makefraction(abs(st), sine)
+ 		end
+ 	    end {:300};
+ 	mem[p + 5].int := mem[p + 1].int + takefraction(takefraction(deltax[k], ct) - takefraction(deltay[k], st), rr);
+ 	mem[p + 6].int := mem[p + 2].int + takefraction(takefraction(deltay[k], ct) + takefraction(deltax[k], st), rr);
+ 	mem[q + 3].int := mem[q + 1].int - takefraction(takefraction(deltax[k], cf) + takefraction(deltay[k], sf), ss);
+ 	mem[q + 4].int := mem[q + 2].int - takefraction(takefraction(deltay[k], cf) - takefraction(deltax[k], sf), ss);
+ 	mem[p].hh.b1 := 1;
+ 	mem[q].hh.b0 := 1
+     end; { setcontrols }
+ {:299}
+ 
+     procedure solvechoices(p, q: halfword; n: halfword);
+     label
+ 	40, 10;
+     var
+ 	k: 0..pathsize;
+ 	r, s, t: halfword;
+ 	sine, cosine: fraction; {286:}
+ 	aa, bb, cc, ff, acc: fraction;
+ 	dd, ee: scaled;
+ 	lt, rt: scaled; {:286}
+     begin
+ 	k := 0;
+ 	s := p;
+ 	while true do begin
+ 	    t := mem[s].hh.rh;
+ 	    if k = 0 then  {285:}
+ 		case mem[s].hh.b1 of
+ 		    2:
+ 			if mem[t].hh.b0 = 2 then begin {301:}
+ 			    aa := narg(deltax[0], deltay[0]);
+ 			    nsincos(mem[p + 5].int - aa);
+ 			    ct := ncos;
+ 			    st := nsin;
+ 			    nsincos(mem[q + 3].int - aa);
+ 			    cf := ncos;
+ 			    sf := -nsin;
+ 			    setcontrols(p, q, 0);
+ 			    goto 10
+ 			end else begin {:301} {293:}
+ 			    vv[0] := mem[s + 5].int - narg(deltax[0], deltay[0]);
+ 			    if abs(vv[0]) > 188743680 then 
+ 				if vv[0] > 0 then 
+ 				    vv[0] := vv[0] - 377487360
+ 				else 
+ 				    vv[0] := vv[0] + 377487360;
+ 			    uu[0] := 0;
+ 			    ww[0] := 0
+ 			end {:293};
+ 		    3:
+ 			if mem[t].hh.b0 = 3 then begin {302:}
+ 			    mem[p].hh.b1 := 1;
+ 			    mem[q].hh.b0 := 1;
+ 			    lt := abs(mem[q + 4].int);
+ 			    rt := abs(mem[p + 6].int);
+ 			    if rt = 65536 then begin
+ 				if deltax[0] >= 0 then 
+ 				    mem[p + 5].int := mem[p + 1].int + ((deltax[0] + 1) div 3)
+ 				else 
+ 				    mem[p + 5].int := mem[p + 1].int + ((deltax[0] - 1) div 3);
+ 				if deltay[0] >= 0 then 
+ 				    mem[p + 6].int := mem[p + 2].int + ((deltay[0] + 1) div 3)
+ 				else 
+ 				    mem[p + 6].int := mem[p + 2].int + ((deltay[0] - 1) div 3)
+ 			    end else begin
+ 				ff := makefraction(65536, 3 * rt);
+ 				mem[p + 5].int := mem[p + 1].int + takefraction(deltax[0], ff);
+ 				mem[p + 6].int := mem[p + 2].int + takefraction(deltay[0], ff)
+ 			    end;
+ 			    if lt = 65536 then begin
+ 				if deltax[0] >= 0 then 
+ 				    mem[q + 3].int := mem[q + 1].int - ((deltax[0] + 1) div 3)
+ 				else 
+ 				    mem[q + 3].int := mem[q + 1].int - ((deltax[0] - 1) div 3);
+ 				if deltay[0] >= 0 then 
+ 				    mem[q + 4].int := mem[q + 2].int - ((deltay[0] + 1) div 3)
+ 				else 
+ 				    mem[q + 4].int := mem[q + 2].int - ((deltay[0] - 1) div 3)
+ 			    end else begin
+ 				ff := makefraction(65536, 3 * lt);
+ 				mem[q + 3].int := mem[q + 1].int - takefraction(deltax[0], ff);
+ 				mem[q + 4].int := mem[q + 2].int - takefraction(deltay[0], ff)
+ 			    end;
+ 			    goto 10
+ 			end else begin {:302} {294:}
+ 			    cc := mem[s + 5].int;
+ 			    lt := abs(mem[t + 4].int);
+ 			    rt := abs(mem[s + 6].int);
+ 			    if (rt = 65536) and (lt = 65536) then 
+ 				uu[0] := makefraction((cc + cc) + 65536, cc + 131072)
+ 			    else 
+ 				uu[0] := curlratio(cc, rt, lt);
+ 			    vv[0] := -takefraction(psi[1], uu[0]);
+ 			    ww[0] := 0
+ 			end {:294};
+ 		    4:
+ 			begin
+ 			    uu[0] := 0;
+ 			    vv[0] := 0;
+ 			    ww[0] := 268435456
+ 			end
+ 		end {:285}
+ 	    else 
+ 		case mem[s].hh.b0 of
+ 		    5, 4:
+ 			begin {287:} {288:}
+ 			    if abs(mem[r + 6].int) = 65536 then begin
+ 				aa := 134217728;
+ 				dd := 2 * delta[k]
+ 			    end else begin
+ 				aa := makefraction(65536, (3 * abs(mem[r + 6].int)) - 65536);
+ 				dd := takefraction(delta[k], 805306368 - makefraction(65536, abs(mem[r + 6].int)))
+ 			    end;
+ 			    if abs(mem[t + 4].int) = 65536 then begin
+ 				bb := 134217728;
+ 				ee := 2 * delta[k - 1]
+ 			    end else begin
+ 				bb := makefraction(65536, (3 * abs(mem[t + 4].int)) - 65536);
+ 				ee := takefraction(delta[k - 1], 805306368 - makefraction(65536, abs(mem[t + 4].int)))
+ 			    end;
+ 			    cc := 268435456 - takefraction(uu[k - 1], aa) {:288}; {289:}
+ 			    dd := takefraction(dd, cc);
+ 			    lt := abs(mem[s + 4].int);
+ 			    rt := abs(mem[s + 6].int);
+ 			    if lt <> rt then 
+ 				if lt < rt then begin
+ 				    ff := makefraction(lt, rt);
+ 				    ff := takefraction(ff, ff);
+ 				    dd := takefraction(dd, ff)
+ 				end else begin
+ 				    ff := makefraction(rt, lt);
+ 				    ff := takefraction(ff, ff);
+ 				    ee := takefraction(ee, ff)
+ 				end;
+ 			    ff := makefraction(ee, ee + dd) {:289};
+ 			    uu[k] := takefraction(ff, bb); {290:}
+ 			    acc := -takefraction(psi[k + 1], uu[k]);
+ 			    if mem[r].hh.b1 = 3 then begin
+ 				ww[k] := 0;
+ 				vv[k] := acc - takefraction(psi[1], 268435456 - ff)
+ 			    end else begin
+ 				ff := makefraction(268435456 - ff, cc);
+ 				acc := acc - takefraction(psi[k], ff);
+ 				ff := takefraction(ff, aa);
+ 				vv[k] := acc - takefraction(vv[k - 1], ff);
+ 				if ww[k - 1] = 0 then 
+ 				    ww[k] := 0
+ 				else 
+ 				    ww[k] := -takefraction(ww[k - 1], ff)
+ 			    end {:290};
+ 			    if mem[s].hh.b0 = 5 then begin {291:}
+ 				aa := 0;
+ 				bb := 268435456;
+ 				repeat
+ 				    k := k - 1;
+ 				    if k = 0 then 
+ 					k := n;
+ 				    aa := vv[k] - takefraction(aa, uu[k]);
+ 				    bb := ww[k] - takefraction(bb, uu[k])
+ 				until k = n;
+ 				aa := makefraction(aa, 268435456 - bb);
+ 				theta[n] := aa;
+ 				vv[0] := aa;
+ 				for k := 1 to n - 1 do 
+ 				    vv[k] := vv[k] + takefraction(aa, ww[k]);
+ 				goto 40
+ 			    end {:291}
+ 			end; {:287}
+ 		    3:
+ 			begin {295:}
+ 			    cc := mem[s + 3].int;
+ 			    lt := abs(mem[s + 4].int);
+ 			    rt := abs(mem[r + 6].int);
+ 			    if (rt = 65536) and (lt = 65536) then 
+ 				ff := makefraction((cc + cc) + 65536, cc + 131072)
+ 			    else 
+ 				ff := curlratio(cc, lt, rt);
+ 			    theta[n] := -makefraction(takefraction(vv[n - 1], ff), 268435456 - takefraction(ff, uu[n - 1]));
+ 			    goto 40
+ 			end; {:295}
+ 		    2:
+ 			begin {292:}
+ 			    theta[n] := mem[s + 3].int - narg(deltax[n - 1], deltay[n - 1]);
+ 			    if abs(theta[n]) > 188743680 then 
+ 				if theta[n] > 0 then 
+ 				    theta[n] := theta[n] - 377487360
+ 				else 
+ 				    theta[n] := theta[n] + 377487360;
+ 			    goto 40
+ 			end
+ 		end {:292};
+ 	    r := s;
+ 	    s := t;
+ 	    k := k + 1
+ 	end;
+     40: {297:}
+ 	for k := n - 1 downto 0 do 
+ 	    theta[k] := vv[k] - takefraction(theta[k + 1], uu[k]);
+ 	s := p;
+ 	k := 0;
+ 	repeat
+ 	    t := mem[s].hh.rh;
+ 	    nsincos(theta[k]);
+ 	    st := nsin;
+ 	    ct := ncos;
+ 	    nsincos((-psi[k + 1]) - theta[k + 1]);
+ 	    sf := nsin;
+ 	    cf := ncos;
+ 	    setcontrols(s, t, k);
+ 	    k := k + 1;
+ 	    s := t
+ 	until k = n {:297};
+     10:
+ 	
+     end; {:284}
+ 
+     procedure makechoices(knots: halfword);
+     label
+ 	30;
+     var
+ 	h: halfword;
+ 	p, q: halfword; {280:}
+ 	k, n: 0..pathsize;
+ 	r, s, t: halfword;
+ 	delx, dely: scaled;
+ 	sine, cosine: fraction; {:280}
+     begin
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	if internal[4] > 0 then 
+ 	    printpath(knots, 393, true); {271:}
+ 	p := knots;
+ 	repeat
+ 	    q := mem[p].hh.rh;
+ 	    if mem[p + 1].int = mem[q + 1].int then 
+ 		if mem[p + 2].int = mem[q + 2].int then 
+ 		    if mem[p].hh.b1 > 1 then begin
+ 			mem[p].hh.b1 := 1;
+ 			if mem[p].hh.b0 = 4 then begin
+ 			    mem[p].hh.b0 := 3;
+ 			    mem[p + 3].int := 65536
+ 			end;
+ 			mem[q].hh.b0 := 1;
+ 			if mem[q].hh.b1 = 4 then begin
+ 			    mem[q].hh.b1 := 3;
+ 			    mem[q + 5].int := 65536
+ 			end;
+ 			mem[p + 5].int := mem[p + 1].int;
+ 			mem[q + 3].int := mem[p + 1].int;
+ 			mem[p + 6].int := mem[p + 2].int;
+ 			mem[q + 4].int := mem[p + 2].int
+ 		    end;
+ 	    p := q
+ 	until p = knots {:271}; {272:}
+ 	h := knots;
+ 	while true do begin
+ 	    if mem[h].hh.b0 <> 4 then 
+ 		goto 30;
+ 	    if mem[h].hh.b1 <> 4 then 
+ 		goto 30;
+ 	    h := mem[h].hh.rh;
+ 	    if h = knots then begin
+ 		mem[h].hh.b0 := 5;
+ 		goto 30
+ 	    end
+ 	end;
+     30: {:272}
+ 	;
+ 	p := h; {273:}
+ 	repeat
+ 	    q := mem[p].hh.rh;
+ 	    if mem[p].hh.b1 >= 2 then begin
+ 		while (mem[q].hh.b0 = 4) and (mem[q].hh.b1 = 4) do 
+ 		    q := mem[q].hh.rh; {278:} {281:}
+ 		k := 0;
+ 		s := p;
+ 		n := pathsize;
+ 		repeat
+ 		    t := mem[s].hh.rh;
+ 		    deltax[k] := mem[t + 1].int - mem[s + 1].int;
+ 		    deltay[k] := mem[t + 2].int - mem[s + 2].int;
+ 		    delta[k] := pythadd(deltax[k], deltay[k]);
+ 		    if k > 0 then begin
+ 			sine := makefraction(deltay[k - 1], delta[k - 1]);
+ 			cosine := makefraction(deltax[k - 1], delta[k - 1]);
+ 			psi[k] := narg(takefraction(deltax[k], cosine) + takefraction(deltay[k], sine), takefraction(deltay[k], cosine) - takefraction(deltax[k], sine))
+ 		    end;
+ 		    k := k + 1;
+ 		    s := t;
+ 		    if k = pathsize then 
+ 			overflow(398, pathsize);
+ 		    if s = q then 
+ 			n := k
+ 		until (k >= n) and (mem[s].hh.b0 <> 5);
+ 		if k = n then 
+ 		    psi[n] := 0
+ 		else 
+ 		    psi[k] := psi[1] {:281}; {282:}
+ 		if mem[q].hh.b0 = 4 then begin
+ 		    delx := mem[q + 5].int - mem[q + 1].int;
+ 		    dely := mem[q + 6].int - mem[q + 2].int;
+ 		    if (delx = 0) and (dely = 0) then begin
+ 			mem[q].hh.b0 := 3;
+ 			mem[q + 3].int := 65536
+ 		    end else begin
+ 			mem[q].hh.b0 := 2;
+ 			mem[q + 3].int := narg(delx, dely)
+ 		    end
+ 		end;
+ 		if (mem[p].hh.b1 = 4) and (mem[p].hh.b0 = 1) then begin
+ 		    delx := mem[p + 1].int - mem[p + 3].int;
+ 		    dely := mem[p + 2].int - mem[p + 4].int;
+ 		    if (delx = 0) and (dely = 0) then begin
+ 			mem[p].hh.b1 := 3;
+ 			mem[p + 5].int := 65536
+ 		    end else begin
+ 			mem[p].hh.b1 := 2;
+ 			mem[p + 5].int := narg(delx, dely)
+ 		    end
+ 		end {:282};
+ 		solvechoices(p, q, n) {:278}
+ 	    end;
+ 	    p := q {:273}
+ 	until p = h;
+ 	if internal[4] > 0 then 
+ 	    printpath(knots, 394, true);
+ 	if aritherror then begin {270:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(395)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 396;
+ 		helpline[0] := 397
+ 	    end;
+ 	    putgeterror;
+ 	    aritherror := false
+ 	end {:270}
+     end; {:269} {311:}
+ 
+     {-------------------------------------------------------------------
+     procedure makemoves(xx0, xx1, xx2, xx3, yy0, yy1, yy2, yy3: scaled; xicorr, etacorr: smallnumber);
+ 
+     moved to mf2ps3.p
+     -------------------------------------------------------------------}
+ 
+     procedure smoothmoves(b, t: integer);
+     var
+ 	k: 1..movesize;
+ 	a, aa, aaa: integer;
+     begin
+ 	if (t - b) >= 3 then begin
+ 	    k := b + 2;
+ 	    aa := move[k - 1];
+ 	    aaa := move[k - 2];
+ 	    repeat
+ 		a := move[k];
+ 		if abs(a - aa) > 1 then  {322:}
+ 		    if a > aa then begin
+ 			if aaa >= aa then 
+ 			    if a >= move[k + 1] then begin
+ 				move[k - 1] := move[k - 1] + 1;
+ 				move[k] := a - 1
+ 			    end
+ 		    end else begin
+ 			if aaa <= aa then 
+ 			    if a <= move[k + 1] then begin
+ 				move[k - 1] := move[k - 1] - 1;
+ 				move[k] := a + 1
+ 			    end
+ 		    end {:322};
+ 		k := k + 1;
+ 		aaa := aa;
+ 		aa := a
+ 	    until k = t
+ 	end
+     end; {:321} {326:}
+ 
+     procedure initedges(h: halfword);
+     begin
+ 	mem[h].hh.lh := h;
+ 	mem[h].hh.rh := h;
+ 	mem[h + 1].hh.lh := 8191;
+ 	mem[h + 1].hh.rh := 1;
+ 	mem[h + 2].hh.lh := 8191;
+ 	mem[h + 2].hh.rh := 1;
+ 	mem[h + 3].hh.lh := 4096;
+ 	mem[h + 3].hh.rh := 0;
+ 	mem[h + 4].int := 0;
+ 	mem[h + 5].hh.rh := h;
+ 	mem[h + 5].hh.lh := 0
+     end; {:326} {328:}
+ 
+     procedure fixoffset;
+     var
+ 	p, q: halfword;
+ 	delta: integer;
+     begin
+ 	delta := 8 * (mem[curedges + 3].hh.lh - 4096);
+ 	mem[curedges + 3].hh.lh := 4096;
+ 	q := mem[curedges].hh.rh;
+ 	while q <> curedges do begin
+ 	    p := mem[q + 1].hh.rh;
+ 	    while p <> 30000 do begin
+ 		mem[p].hh.lh := mem[p].hh.lh - delta;
+ 		p := mem[p].hh.rh
+ 	    end;
+ 	    p := mem[q + 1].hh.lh;
+ 	    while p > (-29999) do begin
+ 		mem[p].hh.lh := mem[p].hh.lh - delta;
+ 		p := mem[p].hh.rh
+ 	    end;
+ 	    q := mem[q].hh.rh
+ 	end
+     end; {:328} {329:}
+ 
+     procedure edgeprep(ml, mr, nl, nr: integer);
+     var
+ 	delta: halfword;
+ 	p, q: halfword;
+     begin
+ 	ml := ml + 4096;
+ 	mr := mr + 4096;
+ 	nl := nl + 4096;
+ 	nr := nr + 4095;
+ 	if ml < mem[curedges + 2].hh.lh then 
+ 	    mem[curedges + 2].hh.lh := ml;
+ 	if mr > mem[curedges + 2].hh.rh then 
+ 	    mem[curedges + 2].hh.rh := mr;
+ 	if (not (abs((mem[curedges + 2].hh.lh + mem[curedges + 3].hh.lh) - 8192) < 4096)) or (not (abs((mem[curedges + 2].hh.rh + mem[curedges + 3].hh.lh) - 8192) < 4096)) then 
+ 	    fixoffset;
+ 	if mem[curedges].hh.rh = curedges then begin
+ 	    mem[curedges + 1].hh.lh := nr + 1;
+ 	    mem[curedges + 1].hh.rh := nr
+ 	end;
+ 	if nl < mem[curedges + 1].hh.lh then begin {330:}
+ 	    delta := mem[curedges + 1].hh.lh - nl;
+ 	    mem[curedges + 1].hh.lh := nl;
+ 	    p := mem[curedges].hh.rh;
+ 	    repeat
+ 		q := getnode(2);
+ 		mem[q + 1].hh.rh := 30000;
+ 		mem[q + 1].hh.lh := -29999;
+ 		mem[p].hh.lh := q;
+ 		mem[q].hh.rh := p;
+ 		p := q;
+ 		delta := delta - 1
+ 	    until delta = 0;
+ 	    mem[p].hh.lh := curedges;
+ 	    mem[curedges].hh.rh := p;
+ 	    if mem[curedges + 5].hh.rh = curedges then 
+ 		mem[curedges + 5].hh.lh := nl - 1
+ 	end {:330};
+ 	if nr > mem[curedges + 1].hh.rh then begin {331:}
+ 	    delta := nr - mem[curedges + 1].hh.rh;
+ 	    mem[curedges + 1].hh.rh := nr;
+ 	    p := mem[curedges].hh.lh;
+ 	    repeat
+ 		q := getnode(2);
+ 		mem[q + 1].hh.rh := 30000;
+ 		mem[q + 1].hh.lh := -29999;
+ 		mem[p].hh.rh := q;
+ 		mem[q].hh.lh := p;
+ 		p := q;
+ 		delta := delta - 1
+ 	    until delta = 0;
+ 	    mem[p].hh.rh := curedges;
+ 	    mem[curedges].hh.lh := p;
+ 	    if mem[curedges + 5].hh.rh = curedges then 
+ 		mem[curedges + 5].hh.lh := nr + 1
+ 	end {:331}
+     end; {:329} {334:}
+ 
+     function copyedges(h: halfword): halfword;
+     var
+ 	p, r: halfword;
+ 	hh, pp, qq, rr, ss: halfword;
+     begin
+ 	hh := getnode(6);
+ 	mem[hh + 1] := mem[h + 1];
+ 	mem[hh + 2] := mem[h + 2];
+ 	mem[hh + 3] := mem[h + 3];
+ 	mem[hh + 4] := mem[h + 4];
+ 	mem[hh + 5].hh.lh := mem[hh + 1].hh.rh + 1;
+ 	mem[hh + 5].hh.rh := hh;
+ 	p := mem[h].hh.rh;
+ 	qq := hh;
+ 	while p <> h do begin
+ 	    pp := getnode(2);
+ 	    mem[qq].hh.rh := pp;
+ 	    mem[pp].hh.lh := qq;
+ {335:}
+ 	    r := mem[p + 1].hh.rh;
+ 	    rr := pp + 1;
+ 	    while r <> 30000 do begin
+ 		ss := getavail;
+ 		mem[rr].hh.rh := ss;
+ 		rr := ss;
+ 		mem[rr].hh.lh := mem[r].hh.lh;
+ 		r := mem[r].hh.rh
+ 	    end;
+ 	    mem[rr].hh.rh := 30000;
+ 	    r := mem[p + 1].hh.lh;
+ 	    rr := 29999;
+ 	    while r > (-29999) do begin
+ 		ss := getavail;
+ 		mem[rr].hh.rh := ss;
+ 		rr := ss;
+ 		mem[rr].hh.lh := mem[r].hh.lh;
+ 		r := mem[r].hh.rh
+ 	    end;
+ 	    mem[rr].hh.rh := r;
+ 	    mem[pp + 1].hh.lh := mem[29999].hh.rh {:335};
+ 	    p := mem[p].hh.rh;
+ 	    qq := pp
+ 	end;
+ 	mem[qq].hh.rh := hh;
+ 	mem[hh].hh.lh := qq;
+ 	copyedges := hh
+     end; {:334} {336:}
+ 
+     procedure yreflectedges;
+     var
+ 	p, q, r: halfword;
+     begin
+ 	p := mem[curedges + 1].hh.lh;
+ 	mem[curedges + 1].hh.lh := 8191 - mem[curedges + 1].hh.rh;
+ 	mem[curedges + 1].hh.rh := 8191 - p;
+ 	mem[curedges + 5].hh.lh := 8191 - mem[curedges + 5].hh.lh;
+ 	p := mem[curedges].hh.rh;
+ 	q := curedges;
+ 	repeat
+ 	    r := mem[p].hh.rh;
+ 	    mem[p].hh.rh := q;
+ 	    mem[q].hh.lh := p;
+ 	    q := p;
+ 	    p := r
+ 	until q = curedges;
+ 	mem[curedges + 4].int := 0
+     end; {:336} {337:}
+ 
+     procedure xreflectedges;
+     var
+ 	p, q, r, s: halfword;
+ 	m: integer;
+     begin
+ 	p := mem[curedges + 2].hh.lh;
+ 	mem[curedges + 2].hh.lh := 8192 - mem[curedges + 2].hh.rh;
+ 	mem[curedges + 2].hh.rh := 8192 - p;
+ 	m := ((4096 + mem[curedges + 3].hh.lh) * 8) - 65528;
+ 	mem[curedges + 3].hh.lh := 4096;
+ 	p := mem[curedges].hh.rh; {339:}
+ 	repeat
+ 	    q := mem[p + 1].hh.rh;
+ 	    r := 30000;
+ 	    while q <> 30000 do begin
+ 		s := mem[q].hh.rh;
+ 		mem[q].hh.rh := r;
+ 		r := q;
+ 		mem[r].hh.lh := m - mem[q].hh.lh;
+ 		q := s
+ 	    end;
+ 	    mem[p + 1].hh.rh := r {:339}; {338:}
+ 	    q := mem[p + 1].hh.lh;
+ 	    while q > (-29999) do begin
+ 		mem[q].hh.lh := m - mem[q].hh.lh;
+ 		q := mem[q].hh.rh
+ 	    end {:338};
+ 	    p := mem[p].hh.rh
+ 	until p = curedges;
+ 	mem[curedges + 4].int := 0
+     end; { xreflectedges }
+ {:337}
+     {340:}
+ 
+     procedure yscaleedges(s: integer);
+     var
+ 	p, q, pp, r, rr, ss: halfword;
+ 	t: integer;
+     begin
+ 	if ((s * (mem[curedges + 1].hh.rh - 4095)) >= 4096) or ((s * (mem[curedges + 1].hh.lh - 4096)) <= (-4096)) then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(402)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 403;
+ 		helpline[1] := 404;
+ 		helpline[0] := 405
+ 	    end;
+ 	    putgeterror
+ 	end else begin
+ 	    mem[curedges + 1].hh.rh := (s * (mem[curedges + 1].hh.rh - 4095)) + 4095;
+ 	    mem[curedges + 1].hh.lh := (s * (mem[curedges + 1].hh.lh - 4096)) + 4096; {341:}
+ 	    p := curedges;
+ 	    repeat
+ 		q := p;
+ 		p := mem[p].hh.rh;
+ 		for t := 2 to s do begin
+ 		    pp := getnode(2);
+ 		    mem[q].hh.rh := pp;
+ 		    mem[p].hh.lh := pp;
+ 		    mem[pp].hh.rh := p;
+ 		    mem[pp].hh.lh := q;
+ 		    q := pp; {335:}
+ 		    r := mem[p + 1].hh.rh;
+ 		    rr := pp + 1;
+ 		    while r <> 30000 do begin
+ 			ss := getavail;
+ 			mem[rr].hh.rh := ss;
+ 			rr := ss;
+ 			mem[rr].hh.lh := mem[r].hh.lh;
+ 			r := mem[r].hh.rh
+ 		    end;
+ 		    mem[rr].hh.rh := 30000;
+ 		    r := mem[p + 1].hh.lh;
+ 		    rr := 29999;
+ 		    while r > (-29999) do begin
+ 			ss := getavail;
+ 			mem[rr].hh.rh := ss;
+ 			rr := ss;
+ 			mem[rr].hh.lh := mem[r].hh.lh;
+ 			r := mem[r].hh.rh
+ 		    end;
+ 		    mem[rr].hh.rh := r;
+ 		    mem[pp + 1].hh.lh := mem[29999].hh.rh {:335}
+ 		end
+ 	    until mem[p].hh.rh = curedges {:341};
+ 	    mem[curedges + 4].int := 0
+ 	end
+     end; {:340}
+ {342:}
+ 
+     procedure xscaleedges(s: integer);
+     var
+ 	p, q: halfword;
+ 	t: 0..65535;
+ 	w: 0..7;
+ 	delta: integer;
+     begin
+ 	if ((s * (mem[curedges + 2].hh.rh - 4096)) >= 4096) or ((s * (mem[curedges + 2].hh.lh - 4096)) <= (-4096)) then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(402)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 406;
+ 		helpline[1] := 404;
+ 		helpline[0] := 405
+ 	    end;
+ 	    putgeterror
+ 	end else if (mem[curedges + 2].hh.rh <> 4096) or (mem[curedges + 2].hh.lh <> 4096) then begin
+ 	    mem[curedges + 2].hh.rh := (s * (mem[curedges + 2].hh.rh - 4096)) + 4096;
+ 	    mem[curedges + 2].hh.lh := (s * (mem[curedges + 2].hh.lh - 4096)) + 4096;
+ 	    delta := (8 * (4096 - (s * mem[curedges + 3].hh.lh))) - 32768;
+ 	    mem[curedges + 3].hh.lh := 4096; {343:}
+ 	    q := mem[curedges].hh.rh;
+ 	    repeat
+ 		p := mem[q + 1].hh.rh;
+ 		while p <> 30000 do begin
+ 		    t := mem[p].hh.lh + 32768;
+ 		    w := t mod 8;
+ 		    mem[p].hh.lh := (((t - w) * s) + w) + delta;
+ 		    p := mem[p].hh.rh
+ 		end;
+ 		p := mem[q + 1].hh.lh;
+ 		while p > (-29999) do begin
+ 		    t := mem[p].hh.lh + 32768;
+ 		    w := t mod 8;
+ 		    mem[p].hh.lh := (((t - w) * s) + w) + delta;
+ 		    p := mem[p].hh.rh
+ 		end;
+ 		q := mem[q].hh.rh
+ 	    until q = curedges {:343};
+ 	    mem[curedges + 4].int := 0
+ 	end
+     end; { xscaleedges }
+ {:342}
+     {344:}
+ 
+     procedure negateedges(h: halfword);
+     label
+ 	30;
+     var
+ 	p, q, r, s, t, u: halfword;
+     begin
+ 	p := mem[h].hh.rh;
+ 	while p <> h do begin
+ 	    q := mem[p + 1].hh.lh;
+ 	    while q > (-29999) do begin
+ 		mem[q].hh.lh := (8 - (2 * ((mem[q].hh.lh + 32768) mod 8))) + mem[q].hh.lh;
+ 		q := mem[q].hh.rh
+ 	    end;
+ 	    q := mem[p + 1].hh.rh;
+ 	    if q <> 30000 then begin
+ 		repeat
+ 		    mem[q].hh.lh := (8 - (2 * ((mem[q].hh.lh + 32768) mod 8))) + mem[q].hh.lh;
+ 		    q := mem[q].hh.rh
+ 		until q = 30000; {345:}
+ 		u := p + 1;
+ 		q := mem[u].hh.rh;
+ 		r := q;
+ 		s := mem[r].hh.rh;
+ 		while true do 
+ 		    if mem[s].hh.lh > mem[r].hh.lh then begin
+ 			mem[u].hh.rh := q;
+ 			if s = 30000 then 
+ 			    goto 30;
+ 			u := r;
+ 			q := s;
+ 			r := q;
+ 			s := mem[r].hh.rh
+ 		    end else begin
+ 			t := s;
+ 			s := mem[t].hh.rh;
+ 			mem[t].hh.rh := q;
+ 			q := t
+ 		    end;
+     30:
+ 		mem[r].hh.rh := 30000 {:345}
+ 	    end;
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	mem[h + 4].int := 0
+     end; {:344} {346:}
+ 
+     procedure sortedges(h: halfword);
+     label
+ 	30;
+     var
+ 	k: halfword;
+ 	p, q, r, s: halfword;
+     begin
+ 	r := mem[h + 1].hh.lh;
+ 	mem[h + 1].hh.lh := -30000;
+ 	p := mem[r].hh.rh;
+ 	mem[r].hh.rh := 30000;
+ 	mem[29999].hh.rh := r;
+ 	while p > (-29999) do begin
+ 	    k := mem[p].hh.lh;
+ 	    q := 29999;
+ 	    repeat
+ 		r := q;
+ 		q := mem[r].hh.rh
+ 	    until k <= mem[q].hh.lh;
+ 	    mem[r].hh.rh := p;
+ 	    r := mem[p].hh.rh;
+ 	    mem[p].hh.rh := q;
+ 	    p := r
+ 	end; {347:}
+ 	begin
+ 	    r := h + 1;
+ 	    q := mem[r].hh.rh;
+ 	    p := mem[29999].hh.rh;
+ 	    while true do begin
+ 		k := mem[p].hh.lh;
+ 		while k > mem[q].hh.lh do begin
+ 		    r := q;
+ 		    q := mem[r].hh.rh
+ 		end;
+ 		mem[r].hh.rh := p;
+ 		s := mem[p].hh.rh;
+ 		mem[p].hh.rh := q;
+ 		if s = 30000 then 
+ 		    goto 30;
+ 		r := p;
+ 		p := s
+ 	    end;
+     30: {:347}
+ 	    
+ 	end
+     end; {:346} {348:}
+ 
+     procedure culledges(wlo, whi, wout, win: integer);
+     label
+ 	30;
+     var
+ 	p, q, r, s: halfword;
+ 	w: integer;
+ 	d: integer;
+ 	m: integer;
+ 	mm: integer;
+ 	ww: integer;
+ 	prevw: integer;
+ 	n, minn, maxn: halfword;
+ 	mind, maxd: halfword;
+     begin
+ 	mind := 32767;
+ 	maxd := -32768;
+ 	minn := 32767;
+ 	maxn := -32768;
+ 	p := mem[curedges].hh.rh;
+ 	n := mem[curedges + 1].hh.lh;
+ 	while p <> curedges do begin
+ 	    if mem[p + 1].hh.lh > (-29999) then 
+ 		sortedges(p);
+ 	    if mem[p + 1].hh.rh <> 30000 then begin {349:}
+ 		r := 29999;
+ 		q := mem[p + 1].hh.rh;
+ 		ww := 0;
+ 		m := 1000000;
+ 		prevw := 0;
+ 		while true do begin
+ 		    if q = 30000 then 
+ 			mm := 1000000
+ 		    else begin
+ 			d := mem[q].hh.lh + 32768;
+ 			mm := d div 8;
+ 			ww := (ww + (d mod 8)) - 4
+ 		    end;
+ 		    if mm > m then begin {350:}
+ 			if w <> prevw then begin
+ 			    s := getavail;
+ 			    mem[r].hh.rh := s;
+ 			    mem[s].hh.lh := (((8 * m) - 32764) + w) - prevw;
+ 			    r := s;
+ 			    prevw := w
+ 			end {:350};
+ 			if q = 30000 then 
+ 			    goto 30
+ 		    end;
+ 		    m := mm;
+ 		    if ww >= wlo then 
+ 			if ww <= whi then 
+ 			    w := win
+ 			else 
+ 			    w := wout
+ 		    else 
+ 			w := wout;
+ 		    s := mem[q].hh.rh;
+ 		    begin
+ 			mem[q].hh.rh := avail;
+ 			avail := q
+ 		    end {dynused:=dynused-1;};
+ 		    q := s
+ 		end;
+     30:
+ 		mem[r].hh.rh := 30000;
+ 		mem[p + 1].hh.rh := mem[29999].hh.rh;
+ 		if r <> 29999 then begin {351:}
+ 		    if minn = 32767 then 
+ 			minn := n;
+ 		    maxn := n;
+ 		    if mind > mem[mem[29999].hh.rh].hh.lh then 
+ 			mind := mem[mem[29999].hh.rh].hh.lh;
+ 		    if maxd < mem[r].hh.lh then 
+ 			maxd := mem[r].hh.lh
+ 		end {:351}
+ 	    end {:349};
+ 	    p := mem[p].hh.rh;
+ 	    n := n + 1
+ 	end; {352:}
+ 	if minn > maxn then begin {353:}
+ 	    p := mem[curedges].hh.rh;
+ 	    while p <> curedges do begin
+ 		q := mem[p].hh.rh;
+ 		freenode(p, 2);
+ 		p := q
+ 	    end;
+ 	    initedges(curedges)
+ 	end else begin {:353}
+ 	    n := mem[curedges + 1].hh.lh;
+ 	    mem[curedges + 1].hh.lh := minn;
+ 	    while minn > n do begin
+ 		p := mem[curedges].hh.rh;
+ 		mem[curedges].hh.rh := mem[p].hh.rh;
+ 		mem[mem[p].hh.rh].hh.lh := curedges;
+ 		freenode(p, 2);
+ 		n := n + 1
+ 	    end;
+ 	    n := mem[curedges + 1].hh.rh;
+ 	    mem[curedges + 1].hh.rh := maxn;
+ 	    mem[curedges + 5].hh.lh := maxn + 1;
+ 	    mem[curedges + 5].hh.rh := curedges;
+ 	    while maxn < n do begin
+ 		p := mem[curedges].hh.lh;
+ 		mem[curedges].hh.lh := mem[p].hh.lh;
+ 		mem[mem[p].hh.lh].hh.rh := curedges;
+ 		freenode(p, 2);
+ 		n := n - 1
+ 	    end;
+ 	    mem[curedges + 2].hh.lh := (((mind + 32768) div 8) - mem[curedges + 3].hh.lh) + 4096;
+ 	    mem[curedges + 2].hh.rh := (((maxd + 32768) div 8) - mem[curedges + 3].hh.lh) + 4096
+ 	end {:352};
+ 	mem[curedges + 4].int := 0
+     end; {:348} {354:}
+ 
+     procedure xyswapedges;
+     label
+ 	30;
+     var
+ 	mmagic, nmagic: integer;
+ 	p, q, r, s: halfword; {357:}
+ 	mspread: integer;
+ 	j, jj: 0..movesize;
+ 	m, mm: integer;
+ 	pd, rd: integer;
+ 	pm, rm: integer;
+ 	w: integer;
+ 	ww: integer;
+ 	dw: integer; {:357} {363:}
+ 	extras: integer;
+ 	xw: -3..3;
+ 	k: integer; {:363} {356:}
+     begin
+ 	mspread := mem[curedges + 2].hh.rh - mem[curedges + 2].hh.lh;
+ 	if mspread > movesize then 
+ 	    overflow(407, movesize);
+ 	for j := 0 to mspread do 
+ 	    move[j] := 30000 {:356}; {355:}
+ 	p := getnode(2);
+ 	mem[p + 1].hh.rh := 30000;
+ 	mem[p + 1].hh.lh := -30000;
+ 	mem[p].hh.lh := curedges;
+ 	mem[mem[curedges].hh.rh].hh.lh := p;
+ 	p := getnode(2);
+ 	mem[p + 1].hh.rh := 30000;
+ 	mem[p].hh.lh := mem[curedges].hh.lh; {:355} {365:}
+ 	mmagic := (mem[curedges + 2].hh.lh + mem[curedges + 3].hh.lh) - 4096;
+ 	nmagic := (8 * mem[curedges + 1].hh.rh) - 32756 {:365};
+ 	repeat
+ 	    q := mem[p].hh.lh;
+ 	    if mem[q + 1].hh.lh > (-29999) then 
+ 		sortedges(q); {358:}
+ 	    r := mem[p + 1].hh.rh;
+ 	    freenode(p, 2);
+ 	    p := r;
+ 	    pd := mem[p].hh.lh + 32768;
+ 	    pm := pd div 8;
+ 	    r := mem[q + 1].hh.rh;
+ 	    rd := mem[r].hh.lh + 32768;
+ 	    rm := rd div 8;
+ 	    w := 0;
+ 	    while true do begin
+ 		if pm < rm then 
+ 		    mm := pm
+ 		else 
+ 		    mm := rm;
+ 		if w <> 0 then  {362:}
+ 		    if m <> mm then begin
+ 			if (mm - mmagic) >= movesize then 
+ 			    confusion(377);
+ 			extras := (abs(w) - 1) div 3;
+ 			if extras > 0 then begin
+ 			    if w > 0 then 
+ 				xw := +3
+ 			    else 
+ 				xw := -3;
+ 			    ww := w - (extras * xw)
+ 			end else 
+ 			    ww := w;
+ 			repeat
+ 			    j := m - mmagic;
+ 			    for k := 1 to extras do begin
+ 				s := getavail;
+ 				mem[s].hh.lh := nmagic + xw;
+ 				mem[s].hh.rh := move[j];
+ 				move[j] := s
+ 			    end;
+ 			    s := getavail;
+ 			    mem[s].hh.lh := nmagic + ww;
+ 			    mem[s].hh.rh := move[j];
+ 			    move[j] := s;
+ 			    m := m + 1
+ 			until m = mm
+ 		    end {:362};
+ 		if pd < rd then begin
+ 		    dw := (pd mod 8) - 4; {360:}
+ 		    s := mem[p].hh.rh;
+ 		    begin
+ 			mem[p].hh.rh := avail;
+ 			avail := p
+ 		    end {dynused:=dynused-1;};
+ 		    p := s;
+ 		    pd := mem[p].hh.lh + 32768;
+ 		    pm := pd div 8 {:360}
+ 		end else begin
+ 		    if r = 30000 then 
+ 			goto 30;
+ 		    dw := -((rd mod 8) - 4); {359:}
+ 		    r := mem[r].hh.rh;
+ 		    rd := mem[r].hh.lh + 32768;
+ 		    rm := rd div 8 {:359}
+ 		end;
+ 		m := mm;
+ 		w := w + dw
+ 	    end;
+     30: {:358}
+ 	    ;
+ 	    p := q;
+ 	    nmagic := nmagic - 8
+ 	until mem[p].hh.lh = curedges;
+ 	freenode(p, 2); {364:}
+ 	move[mspread] := 0;
+ 	j := 0;
+ 	while move[j] = 30000 do 
+ 	    j := j + 1;
+ 	if j = mspread then 
+ 	    initedges(curedges)
+ 	else begin
+ 	    mm := mem[curedges + 2].hh.lh;
+ 	    mem[curedges + 2].hh.lh := mem[curedges + 1].hh.lh;
+ 	    mem[curedges + 2].hh.rh := mem[curedges + 1].hh.rh + 1;
+ 	    mem[curedges + 3].hh.lh := 4096;
+ 	    jj := mspread - 1;
+ 	    while move[jj] = 30000 do 
+ 		jj := jj - 1;
+ 	    mem[curedges + 1].hh.lh := j + mm;
+ 	    mem[curedges + 1].hh.rh := jj + mm;
+ 	    q := curedges;
+ 	    repeat
+ 		p := getnode(2);
+ 		mem[q].hh.rh := p;
+ 		mem[p].hh.lh := q;
+ 		mem[p + 1].hh.rh := move[j];
+ 		mem[p + 1].hh.lh := -30000;
+ 		j := j + 1;
+ 		q := p
+ 	    until j > jj;
+ 	    mem[q].hh.rh := curedges;
+ 	    mem[curedges].hh.lh := q;
+ 	    mem[curedges + 5].hh.lh := mem[curedges + 1].hh.rh + 1;
+ 	    mem[curedges + 5].hh.rh := curedges;
+ 	    mem[curedges + 4].int := 0
+ 	end
+     end; {:364}
+ {:354}
+     {366:}
+ 
+     procedure mergeedges(h: halfword);
+     label
+ 	30;
+     var
+ 	p, q, r, pp, qq, rr: halfword;
+ 	n: integer;
+ 	k: halfword;
+ 	delta: integer;
+     begin
+ 	if mem[h].hh.rh <> h then begin
+ 	    if (((mem[h + 2].hh.lh < mem[curedges + 2].hh.lh) or (mem[h + 2].hh.rh > mem[curedges + 2].hh.rh)) or (mem[h + 1].hh.lh < mem[curedges + 1].hh.lh)) or (mem[h + 1].hh.rh > mem[curedges + 1].hh.rh) then 
+ 		edgeprep(mem[h + 2].hh.lh - 4096, mem[h + 2].hh.rh - 4096, mem[h + 1].hh.lh - 4096, mem[h + 1].hh.rh - 4095);
+ 	    if mem[h + 3].hh.lh <> mem[curedges + 3].hh.lh then begin {367:}
+ 		pp := mem[h].hh.rh;
+ 		delta := 8 * (mem[curedges + 3].hh.lh - mem[h + 3].hh.lh);
+ 		repeat
+ 		    qq := mem[pp + 1].hh.rh;
+ 		    while qq <> 30000 do begin
+ 			mem[qq].hh.lh := mem[qq].hh.lh + delta;
+ 			qq := mem[qq].hh.rh
+ 		    end;
+ 		    qq := mem[pp + 1].hh.lh;
+ 		    while qq > (-29999) do begin
+ 			mem[qq].hh.lh := mem[qq].hh.lh + delta;
+ 			qq := mem[qq].hh.rh
+ 		    end;
+ 		    pp := mem[pp].hh.rh
+ 		until pp = h
+ 	    end {:367};
+ 	    n := mem[curedges + 1].hh.lh;
+ 	    p := mem[curedges].hh.rh;
+ 	    pp := mem[h].hh.rh;
+ 	    while n < mem[h + 1].hh.lh do begin
+ 		n := n + 1;
+ 		p := mem[p].hh.rh
+ 	    end; {368:}
+ 	    repeat
+ 		qq := mem[pp + 1].hh.lh;
+ 		if qq > (-29999) then 
+ 		    if mem[p + 1].hh.lh <= (-29999) then 
+ 			mem[p + 1].hh.lh := qq
+ 		    else begin
+ 			while mem[qq].hh.rh > (-29999) do 
+ 			    qq := mem[qq].hh.rh;
+ 			mem[qq].hh.rh := mem[p + 1].hh.lh;
+ 			mem[p + 1].hh.lh := mem[pp + 1].hh.lh
+ 		    end;
+ 		mem[pp + 1].hh.lh := -30000;
+ 		qq := mem[pp + 1].hh.rh;
+ 		if qq <> 30000 then begin
+ 		    if mem[p + 1].hh.lh = (-29999) then 
+ 			mem[p + 1].hh.lh := -30000;
+ 		    mem[pp + 1].hh.rh := 30000;
+ 		    r := p + 1;
+ 		    q := mem[r].hh.rh;
+ 		    if q = 30000 then 
+ 			mem[p + 1].hh.rh := qq
+ 		    else 
+ 			while true do begin
+ 			    k := mem[qq].hh.lh;
+ 			    while k > mem[q].hh.lh do begin
+ 				r := q;
+ 				q := mem[r].hh.rh
+ 			    end;
+ 			    mem[r].hh.rh := qq;
+ 			    rr := mem[qq].hh.rh;
+ 			    mem[qq].hh.rh := q;
+ 			    if rr = 30000 then 
+ 				goto 30;
+ 			    r := qq;
+ 			    qq := rr
+ 			end
+ 		end;
+     30: {:368}
+ 		;
+ 		pp := mem[pp].hh.rh;
+ 		p := mem[p].hh.rh
+ 	    until pp = h
+ 	end
+     end; {:366} {369:}
+ 
+     function totalweight(h: halfword): integer;
+     var
+ 	p, q: halfword;
+ 	n: integer;
+ 	m: 0..65535;
+     begin
+ 	n := 0;
+ 	p := mem[h].hh.rh;
+ 	while p <> h do begin
+ 	    q := mem[p + 1].hh.rh;
+ 	    while q <> 30000 do begin {370:}
+ 		m := mem[q].hh.lh + 32768;
+ 		n := n - (((m mod 8) - 4) * (m div 8));
+ 		q := mem[q].hh.rh
+ 	    end {:370};
+ 	    q := mem[p + 1].hh.lh;
+ 	    while q > (-29999) do begin {370:}
+ 		m := mem[q].hh.lh + 32768;
+ 		n := n - (((m mod 8) - 4) * (m div 8));
+ 		q := mem[q].hh.rh
+ 	    end {:370};
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	totalweight := n
+     end; {:369}
+ {372:}
+ 
+     procedure beginedgetracing;
+     begin
+ 	printdiagnostic(408, 155, true);
+ 	print(409);
+ 	printint(curwt);
+ 	printchar(41);
+ 	tracex := -4096
+     end; { beginedgetracing }
+ 
+     procedure traceacorner;
+     begin
+ 	if fileoffset > (maxprintline - 13) then 
+ 	    printnl(155);
+ 	printchar(40);
+ 	printint(tracex);
+ 	printchar(44);
+ 	printint(traceyy);
+ 	printchar(41);
+ 	tracey := traceyy
+     end;
+ 
+     procedure endedgetracing;
+     begin
+ 	if tracex = (-4096) then 
+ 	    printnl(410)
+ 	else begin
+ 	    traceacorner;
+ 	    printchar(46)
+ 	end;
+ 	enddiagnostic(true)
+     end; {:372} {373:}
+ 
+     procedure tracenewedge(r: halfword; n: integer);
+     var
+ 	d: integer;
+ 	w: -3..3;
+ 	m, n0, n1: integer;
+     begin
+ 	d := mem[r].hh.lh + 32768;
+ 	w := (d mod 8) - 4;
+ 	m := (d div 8) - mem[curedges + 3].hh.lh;
+ 	if w = curwt then begin
+ 	    n0 := n + 1;
+ 	    n1 := n
+ 	end else begin
+ 	    n0 := n;
+ 	    n1 := n + 1
+ 	end;
+ 	if m <> tracex then begin
+ 	    if tracex = (-4096) then begin
+ 		printnl(155);
+ 		traceyy := n0
+ 	    end else if traceyy <> n0 then 
+ 		printchar(63)
+ 	    else 
+ 		traceacorner;
+ 	    tracex := m;
+ 	    traceacorner
+ 	end else begin
+ 	    if n0 <> traceyy then 
+ 		printchar(33);
+ 	    if ((n0 < n1) and (tracey > traceyy)) or ((n0 > n1) and (tracey < traceyy)) then 
+ 		traceacorner
+ 	end;
+ 	traceyy := n1
+     end; {:373} {374:}
+ 
+     procedure lineedges(x0, y0, x1, y1: scaled);
+     label
+ 	30, 31;
+     var
+ 	m0, n0, m1, n1: integer;
+ 	delx, dely: scaled;
+ 	yt: scaled;
+ 	tx: scaled;
+ 	p, r: halfword;
+ 	base: integer;
+ 	n: integer;
+     begin
+ 	n0 := roundunscaled(y0);
+ 	n1 := roundunscaled(y1);
+ 	if n0 <> n1 then begin
+ 	    m0 := roundunscaled(x0);
+ 	    m1 := roundunscaled(x1);
+ 	    delx := x1 - x0;
+ 	    dely := y1 - y0;
+ 	    yt := (n0 * 65536) - 32768;
+ 	    y0 := y0 - yt;
+ 	    y1 := y1 - yt;
+ 	    if n0 < n1 then begin {375:}
+ 		base := ((8 * mem[curedges + 3].hh.lh) - 32764) - curwt;
+ 		if m0 <= m1 then 
+ 		    edgeprep(m0, m1, n0, n1)
+ 		else 
+ 		    edgeprep(m1, m0, n0, n1); {377:}
+ 		n := mem[curedges + 5].hh.lh - 4096;
+ 		p := mem[curedges + 5].hh.rh;
+ 		if n <> n0 then 
+ 		    if n < n0 then 
+ 			repeat
+ 			    n := n + 1;
+ 			    p := mem[p].hh.rh
+ 			until n = n0
+ 		    else 
+ 			repeat
+ 			    n := n - 1;
+ 			    p := mem[p].hh.lh
+ 			until n = n0 {:377};
+ 		y0 := 65536 - y0;
+ 		while true do begin
+ 		    r := getavail;
+ 		    mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		    mem[p + 1].hh.lh := r;
+ 		    tx := takefraction(delx, makefraction(y0, dely));
+ 		    if abvscd(delx, y0, dely, tx) < 0 then 
+ 			tx := tx - 1;
+ 		    mem[r].hh.lh := (8 * roundunscaled(x0 + tx)) + base;
+ 		    y1 := y1 - 65536;
+ 		    if internal[10] > 0 then 
+ 			tracenewedge(r, n);
+ 		    if y1 < 65536 then 
+ 			goto 30;
+ 		    p := mem[p].hh.rh;
+ 		    y0 := y0 + 65536;
+ 		    n := n + 1
+ 		end;
+     30: {:375}
+ 		
+ 	    end else begin {376:}
+ 		base := ((8 * mem[curedges + 3].hh.lh) - 32764) + curwt;
+ 		if m0 <= m1 then 
+ 		    edgeprep(m0, m1, n1, n0)
+ 		else 
+ 		    edgeprep(m1, m0, n1, n0);
+ 		n0 := n0 - 1;
+ {377:}
+ 		n := mem[curedges + 5].hh.lh - 4096;
+ 		p := mem[curedges + 5].hh.rh;
+ 		if n <> n0 then 
+ 		    if n < n0 then 
+ 			repeat
+ 			    n := n + 1;
+ 			    p := mem[p].hh.rh
+ 			until n = n0
+ 		    else 
+ 			repeat
+ 			    n := n - 1;
+ 			    p := mem[p].hh.lh
+ 			until n = n0 {:377};
+ 		while true do begin
+ 		    r := getavail;
+ 		    mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		    mem[p + 1].hh.lh := r;
+ 		    tx := takefraction(delx, makefraction(y0, dely));
+ 		    if abvscd(delx, y0, dely, tx) < 0 then 
+ 			tx := tx + 1;
+ 		    mem[r].hh.lh := (8 * roundunscaled(x0 - tx)) + base;
+ 		    y1 := y1 + 65536;
+ 		    if internal[10] > 0 then 
+ 			tracenewedge(r, n);
+ 		    if y1 >= 0 then 
+ 			goto 31;
+ 		    p := mem[p].hh.lh;
+ 		    y0 := y0 + 65536;
+ 		    n := n - 1
+ 		end;
+     31: {:376}
+ 		
+ 	    end;
+ 	    mem[curedges + 5].hh.rh := p;
+ 	    mem[curedges + 5].hh.lh := n + 4096
+ 	end
+     end; {:374}
+ {378:}
+ 
+     procedure movetoedges(m0, n0, m1, n1: integer);
+     label
+ 	60, 61, 62, 63, 30;
+     var
+ 	delta: 0..movesize;
+ 	k: 0..movesize;
+ 	p, r: halfword;
+ 	dx: integer;
+ 	edgeandweight: integer;
+ 	j: integer;
+ 	n: integer; {sum:integer;}
+     {sum:=move[0];
+     for k:=1 to delta do sum:=sum+abs(move[k]);
+     if sum<>m1-m0 then confusion(48);}
+     begin
+ 	delta := n1 - n0;
+ 	{380:}
+ 	case octant of
+ 	    1:
+ 		begin
+ 		    dx := 8;
+ 		    edgeprep(m0, m1, n0, n1);
+ 		    goto 60
+ 		end;
+ 	    5:
+ 		begin
+ 		    dx := 8;
+ 		    edgeprep(n0, n1, m0, m1);
+ 		    goto 62
+ 		end;
+ 	    6:
+ 		begin
+ 		    dx := -8;
+ 		    edgeprep(-n1, -n0, m0, m1);
+ 		    n0 := -n0;
+ 		    goto 62
+ 		end;
+ 	    2:
+ 		begin
+ 		    dx := -8;
+ 		    edgeprep(-m1, -m0, n0, n1);
+ 		    m0 := -m0;
+ 		    goto 60
+ 		end;
+ 	    4:
+ 		begin
+ 		    dx := -8;
+ 		    edgeprep(-m1, -m0, -n1, -n0);
+ 		    m0 := -m0;
+ 		    goto 61
+ 		end;
+ 	    8:
+ 		begin
+ 		    dx := -8;
+ 		    edgeprep(-n1, -n0, -m1, -m0);
+ 		    n0 := -n0;
+ 		    goto 63
+ 		end;
+ 	    7:
+ 		begin
+ 		    dx := 8;
+ 		    edgeprep(n0, n1, -m1, -m0);
+ 		    goto 63
+ 		end;
+ 	    3:
+ 		begin
+ 		    dx := 8;
+ 		    edgeprep(m0, m1, -n1, -n0);
+ 		    goto 61
+ 		end
+ 	end; {:380}
+     60: {381:} {377:}
+ 	n := mem[curedges + 5].hh.lh - 4096;
+ 	p := mem[curedges + 5].hh.rh;
+ 	if n <> n0 then 
+ 	    if n < n0 then 
+ 		repeat
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until n = n0
+ 	    else 
+ 		repeat
+ 		    n := n - 1;
+ 		    p := mem[p].hh.lh
+ 		until n = n0 {:377};
+ 	if delta > 0 then begin
+ 	    k := 0;
+ 	    edgeandweight := ((8 * (m0 + mem[curedges + 3].hh.lh)) - 32764) - curwt;
+ 	    repeat
+ 		edgeandweight := edgeandweight + (dx * move[k]);
+ 		begin
+ 		    r := avail;
+ 		    if r = (-30000) then 
+ 			r := getavail
+ 		    else begin
+ 			avail := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000
+ 		    end {dynused:=dynused+1;}
+ 		end;
+ 		mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		mem[r].hh.lh := edgeandweight;
+ 		if internal[10] > 0 then 
+ 		    tracenewedge(r, n);
+ 		mem[p + 1].hh.lh := r;
+ 		p := mem[p].hh.rh;
+ 		k := k + 1;
+ 		n := n + 1
+ 	    until k = delta
+ 	end;
+ 	goto 30 {:381};
+     61: {382:}
+ 	n0 := (-n0) - 1; {377:}
+ 	n := mem[curedges + 5].hh.lh - 4096;
+ 	p := mem[curedges + 5].hh.rh;
+ 	if n <> n0 then 
+ 	    if n < n0 then 
+ 		repeat
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until n = n0
+ 	    else 
+ 		repeat
+ 		    n := n - 1;
+ 		    p := mem[p].hh.lh
+ 		until n = n0 {:377};
+ 	if delta > 0 then begin
+ 	    k := 0;
+ 	    edgeandweight := ((8 * (m0 + mem[curedges + 3].hh.lh)) - 32764) + curwt;
+ 	    repeat
+ 		edgeandweight := edgeandweight + (dx * move[k]);
+ 		begin
+ 		    r := avail;
+ 		    if r = (-30000) then 
+ 			r := getavail
+ 		    else begin
+ 			avail := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000
+ 		    end {dynused:=dynused+1;}
+ 		end;
+ 		mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		mem[r].hh.lh := edgeandweight;
+ 		if internal[10] > 0 then 
+ 		    tracenewedge(r, n);
+ 		mem[p + 1].hh.lh := r;
+ 		p := mem[p].hh.lh;
+ 		k := k + 1;
+ 		n := n - 1
+ 	    until k = delta
+ 	end;
+ 	goto 30 {:382};
+     62: {383:}
+ 	edgeandweight := ((8 * (n0 + mem[curedges + 3].hh.lh)) - 32764) - curwt;
+ 	n0 := m0;
+ 	k := 0;
+ {377:}
+ 	n := mem[curedges + 5].hh.lh - 4096;
+ 	p := mem[curedges + 5].hh.rh;
+ 	if n <> n0 then 
+ 	    if n < n0 then 
+ 		repeat
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until n = n0
+ 	    else 
+ 		repeat
+ 		    n := n - 1;
+ 		    p := mem[p].hh.lh
+ 		until n = n0 {:377};
+ 	repeat
+ 	    j := move[k];
+ 	    while j > 0 do begin
+ 		begin
+ 		    r := avail;
+ 		    if r = (-30000) then 
+ 			r := getavail
+ 		    else begin
+ 			avail := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000
+ 		    end {dynused:=dynused+1;}
+ 		end;
+ 		mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		mem[r].hh.lh := edgeandweight;
+ 		if internal[10] > 0 then 
+ 		    tracenewedge(r, n);
+ 		mem[p + 1].hh.lh := r;
+ 		p := mem[p].hh.rh;
+ 		j := j - 1;
+ 		n := n + 1
+ 	    end;
+ 	    edgeandweight := edgeandweight + dx;
+ 	    k := k + 1
+ 	until k > delta;
+ 	goto 30 {:383};
+     63: {384:}
+ 	edgeandweight := ((8 * (n0 + mem[curedges + 3].hh.lh)) - 32764) + curwt;
+ 	n0 := (-m0) - 1;
+ 	k := 0;
+ {377:}
+ 	n := mem[curedges + 5].hh.lh - 4096;
+ 	p := mem[curedges + 5].hh.rh;
+ 	if n <> n0 then 
+ 	    if n < n0 then 
+ 		repeat
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until n = n0
+ 	    else 
+ 		repeat
+ 		    n := n - 1;
+ 		    p := mem[p].hh.lh
+ 		until n = n0 {:377};
+ 	repeat
+ 	    j := move[k];
+ 	    while j > 0 do begin
+ 		begin
+ 		    r := avail;
+ 		    if r = (-30000) then 
+ 			r := getavail
+ 		    else begin
+ 			avail := mem[r].hh.rh;
+ 			mem[r].hh.rh := -30000
+ 		    end {dynused:=dynused+1;}
+ 		end;
+ 		mem[r].hh.rh := mem[p + 1].hh.lh;
+ 		mem[r].hh.lh := edgeandweight;
+ 		if internal[10] > 0 then 
+ 		    tracenewedge(r, n);
+ 		mem[p + 1].hh.lh := r;
+ 		p := mem[p].hh.lh;
+ 		j := j - 1;
+ 		n := n - 1
+ 	    end;
+ 	    edgeandweight := edgeandweight + dx;
+ 	    k := k + 1
+ 	until k > delta;
+ 	goto 30 {:384};
+     30:
+ 	mem[curedges + 5].hh.lh := n + 4096;
+ 	mem[curedges + 5].hh.rh := p
+     end; {:378} {387:}
+ 
+     procedure skew(x, y: scaled; octant: smallnumber);
+     begin
+ 	case octant of
+ 	    1:
+ 		begin
+ 		    curx := x - y;
+ 		    cury := y
+ 		end;
+ 	    5:
+ 		begin
+ 		    curx := y - x;
+ 		    cury := x
+ 		end;
+ 	    6:
+ 		begin
+ 		    curx := y + x;
+ 		    cury := -x
+ 		end;
+ 	    2:
+ 		begin
+ 		    curx := (-x) - y;
+ 		    cury := y
+ 		end;
+ 	    4:
+ 		begin
+ 		    curx := (-x) + y;
+ 		    cury := -y
+ 		end;
+ 	    8:
+ 		begin
+ 		    curx := (-y) + x;
+ 		    cury := -x
+ 		end;
+ 	    7:
+ 		begin
+ 		    curx := (-y) - x;
+ 		    cury := x
+ 		end;
+ 	    3:
+ 		begin
+ 		    curx := x + y;
+ 		    cury := -y
+ 		end
+ 	end
+     end; {:387} {390:}
+ 
+     procedure abnegate(x, y: scaled; octantbefore, octantafter: smallnumber);
+     begin
+ 	if odd(octantbefore) = odd(octantafter) then 
+ 	    curx := x
+ 	else 
+ 	    curx := -x;
+ 	if (octantbefore > 2) = (octantafter > 2) then 
+ 	    cury := y
+ 	else 
+ 	    cury := -y
+     end; {:390}
+ {391:}
+ 
+     function crossingpoint(a, b, c: integer): fraction;
+     label
+ 	10;
+     var
+ 	d: integer;
+ 	x, xx, x0, x1, x2: integer;
+     begin
+ 	if a < 0 then begin
+ 	    crossingpoint := 0;
+ 	    goto 10
+ 	end;
+ 	if c >= 0 then begin
+ 	    if b >= 0 then 
+ 		if c > 0 then begin
+ 		    crossingpoint := 268435457;
+ 		    goto 10
+ 		end else if (a = 0) and (b = 0) then begin
+ 		    crossingpoint := 268435457;
+ 		    goto 10
+ 		end else begin
+ 		    crossingpoint := 268435456;
+ 		    goto 10
+ 		end;
+ 	    if a = 0 then begin
+ 		crossingpoint := 0;
+ 		goto 10
+ 	    end
+ 	end else if a = 0 then 
+ 	    if b <= 0 then begin
+ 		crossingpoint := 0;
+ 		goto 10
+ 	    end;
+ {392:}
+ 	d := 1;
+ 	x0 := a;
+ 	x1 := a - b;
+ 	x2 := b - c;
+ 	repeat
+ 	    x := (x1 + x2) div 2;
+ 	    if (x1 - x0) > x0 then begin
+ 		x2 := x;
+ 		x0 := x0 + x0;
+ 		d := d + d
+ 	    end else begin
+ 		xx := (x1 + x) - x0;
+ 		if xx > x0 then begin
+ 		    x2 := x;
+ 		    x0 := x0 + x0;
+ 		    d := d + d
+ 		end else begin
+ 		    x0 := x0 - xx;
+ 		    if x <= x0 then 
+ 			if (x + x2) <= x0 then begin
+ 			    crossingpoint := 268435457;
+ 			    goto 10
+ 			end;
+ 		    x1 := x;
+ 		    d := (d + d) + 1
+ 		end
+ 	    end
+ 	until d >= 268435456;
+ 	crossingpoint := d - 268435456 {:392};
+     10:
+ 	
+     end; {:391} {394:}
+ 
+     procedure printspec(s: strnumber);
+     label
+ 	45, 30;
+     var
+ 	p, q: halfword;
+ 	octant: smallnumber;
+     begin
+ 	printdiagnostic(411, s, true);
+ 	p := curspec;
+ 	octant := mem[p + 3].int;
+ 	println;
+ 	unskew(mem[curspec + 1].int, mem[curspec + 2].int, octant);
+ 	printtwo(curx, cury);
+ 	print(412);
+ 	while true do begin
+ 	    print(octantdir[octant]);
+ 	    printchar(39);
+ 	    while true do begin
+ 		q := mem[p].hh.rh;
+ 		if mem[p].hh.b1 = 0 then 
+ 		    goto 45;
+ {397:}
+ 		begin
+ 		    printnl(423);
+ 		    unskew(mem[p + 5].int, mem[p + 6].int, octant);
+ 		    printtwo(curx, cury);
+ 		    print(390);
+ 		    unskew(mem[q + 3].int, mem[q + 4].int, octant);
+ 		    printtwo(curx, cury);
+ 		    printnl(387);
+ 		    unskew(mem[q + 1].int, mem[q + 2].int, octant);
+ 		    printtwo(curx, cury);
+ 		    print(424);
+ 		    printint(mem[q].hh.b0 - 1)
+ 		end {:397};
+ 		p := q
+ 	    end;
+     45:
+ 	    if q = curspec then 
+ 		goto 30;
+ 	    p := q;
+ 	    octant := mem[p + 3].int;
+ 	    printnl(413)
+ 	end;
+     30:
+ 	printnl(414);
+ 	enddiagnostic(true)
+     end; {:394} {398:}
+ 
+     procedure printstrange(s: strnumber);
+     var
+ 	p: halfword;
+ 	f: halfword;
+ 	q: halfword;
+ 	t: integer;
+     begin
+ 	if interaction = 3 then 
+ 	    ;
+ 	printnl(62); {399:}
+ 	p := curspec;
+ 	t := 128;
+ 	repeat
+ 	    p := mem[p].hh.rh;
+ 	    if mem[p].hh.b0 <> 0 then begin
+ 		if mem[p].hh.b0 < t then 
+ 		    f := p;
+ 		t := mem[p].hh.b0
+ 	    end
+ 	until p = curspec {:399}; {400:}
+ 	p := curspec;
+ 	q := p;
+ 	repeat
+ 	    p := mem[p].hh.rh;
+ 	    if mem[p].hh.b0 = 0 then 
+ 		q := p
+ 	until p = f {:400};
+ 	t := 0;
+ 	repeat
+ 	    if mem[p].hh.b0 <> 0 then begin
+ 		if mem[p].hh.b0 <> t then begin
+ 		    t := mem[p].hh.b0;
+ 		    printchar(32);
+ 		    printint(t - 1)
+ 		end;
+ 		if q <> (-30000) then begin {401:}
+ 		    if mem[mem[q].hh.rh].hh.b0 = 0 then begin
+ 			print(425);
+ 			print(octantdir[mem[q + 3].int]);
+ 			q := mem[q].hh.rh;
+ 			while mem[mem[q].hh.rh].hh.b0 = 0 do begin
+ 			    printchar(32);
+ 			    print(octantdir[mem[q + 3].int]);
+ 			    q := mem[q].hh.rh
+ 			end;
+ 			printchar(41)
+ 		    end {:401};
+ 		    printchar(32);
+ 		    print(octantdir[mem[q + 3].int]);
+ 		    q := -30000
+ 		end
+ 	    end else if q = (-30000) then 
+ 		q := p;
+ 	    p := mem[p].hh.rh
+ 	until p = f;
+ 	printchar(32);
+ 	printint(mem[p].hh.b0 - 1);
+ 	if q <> (-30000) then  {401:}
+ 	    if mem[mem[q].hh.rh].hh.b0 = 0 then begin
+ 		print(425);
+ 		print(octantdir[mem[q + 3].int]);
+ 		q := mem[q].hh.rh;
+ 		while mem[mem[q].hh.rh].hh.b0 = 0 do begin
+ 		    printchar(32);
+ 		    print(octantdir[mem[q + 3].int]);
+ 		    q := mem[q].hh.rh
+ 		end;
+ 		printchar(41)
+ 	    end {:401};
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(s)
+ 	end
+     end; { printstrange }
+ {:398}
+     {402:}
+     {405:}
+ 
+     procedure removecubic(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	mem[p].hh.b1 := mem[q].hh.b1;
+ 	mem[p].hh.rh := mem[q].hh.rh;
+ 	mem[p + 1].int := mem[q + 1].int;
+ 	mem[p + 2].int := mem[q + 2].int;
+ 	mem[p + 5].int := mem[q + 5].int;
+ 	mem[p + 6].int := mem[q + 6].int;
+ 	freenode(q, 7)
+     end; {:405} {406:} {410:}
+ 
+     procedure splitcubic(p: halfword; t: fraction; xq, yq: scaled);
+     var
+ 	v: scaled;
+ 	q, r: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	r := getnode(7);
+ 	mem[p].hh.rh := r;
+ 	mem[r].hh.rh := q;
+ 	mem[r].hh.b0 := mem[q].hh.b0;
+ 	mem[r].hh.b1 := mem[p].hh.b1;
+ 	v := mem[p + 5].int - takefraction(mem[p + 5].int - mem[q + 3].int, t);
+ 	mem[p + 5].int := mem[p + 1].int - takefraction(mem[p + 1].int - mem[p + 5].int, t);
+ 	mem[q + 3].int := mem[q + 3].int - takefraction(mem[q + 3].int - xq, t);
+ 	mem[r + 3].int := mem[p + 5].int - takefraction(mem[p + 5].int - v, t);
+ 	mem[r + 5].int := v - takefraction(v - mem[q + 3].int, t);
+ 	mem[r + 1].int := mem[r + 3].int - takefraction(mem[r + 3].int - mem[r + 5].int, t);
+ 	v := mem[p + 6].int - takefraction(mem[p + 6].int - mem[q + 4].int, t);
+ 	mem[p + 6].int := mem[p + 2].int - takefraction(mem[p + 2].int - mem[p + 6].int, t);
+ 	mem[q + 4].int := mem[q + 4].int - takefraction(mem[q + 4].int - yq, t);
+ 	mem[r + 4].int := mem[p + 6].int - takefraction(mem[p + 6].int - v, t);
+ 	mem[r + 6].int := v - takefraction(v - mem[q + 4].int, t);
+ 	mem[r + 2].int := mem[r + 4].int - takefraction(mem[r + 4].int - mem[r + 6].int, t)
+     end; {:410}
+ 
+     procedure quadrantsubdivide;
+     label
+ 	22, 10;
+     var
+ 	p, q, r, s, pp, qq: halfword;
+ 	firstx, firsty: scaled;
+ 	del1, del2, del3, del, dmax: scaled;
+ 	t: fraction;
+ 	destx, desty: scaled;
+ 	constantx: boolean;
+     begin
+ 	p := curspec;
+ 	firstx := mem[curspec + 1].int;
+ 	firsty := mem[curspec + 2].int;
+ 	repeat
+     22:
+ 	    q := mem[p].hh.rh; {407:}
+ 	    if q = curspec then begin
+ 		destx := firstx;
+ 		desty := firsty
+ 	    end else begin
+ 		destx := mem[q + 1].int;
+ 		desty := mem[q + 2].int
+ 	    end;
+ 	    del1 := mem[p + 5].int - mem[p + 1].int;
+ 	    del2 := mem[q + 3].int - mem[p + 5].int;
+ 	    del3 := destx - mem[q + 3].int; {408:}
+ 	    if del1 <> 0 then 
+ 		del := del1
+ 	    else if del2 <> 0 then 
+ 		del := del2
+ 	    else 
+ 		del := del3;
+ 	    if del <> 0 then begin
+ 		dmax := abs(del1);
+ 		if abs(del2) > dmax then 
+ 		    dmax := abs(del2);
+ 		if abs(del3) > dmax then 
+ 		    dmax := abs(del3);
+ 		while dmax < 134217728 do begin
+ 		    dmax := dmax + dmax;
+ 		    del1 := del1 + del1;
+ 		    del2 := del2 + del2;
+ 		    del3 := del3 + del3
+ 		end
+ 	    end {:408};
+ 	    if del = 0 then 
+ 		constantx := true
+ 	    else begin
+ 		constantx := false;
+ 		if del < 0 then begin {409:}
+ 		    mem[p + 1].int := -mem[p + 1].int;
+ 		    mem[p + 5].int := -mem[p + 5].int;
+ 		    mem[q + 3].int := -mem[q + 3].int;
+ 		    del1 := -del1;
+ 		    del2 := -del2;
+ 		    del3 := -del3;
+ 		    destx := -destx;
+ 		    mem[p].hh.b1 := 2
+ 		end {:409};
+ 		t := crossingpoint(del1, del2, del3);
+ 		if t < 268435456 then begin {411:}
+ 		    splitcubic(p, t, destx, desty);
+ 		    r := mem[p].hh.rh;
+ 		    if mem[r].hh.b1 > 1 then 
+ 			mem[r].hh.b1 := 1
+ 		    else 
+ 			mem[r].hh.b1 := 2;
+ 		    if mem[r + 1].int < mem[p + 1].int then 
+ 			mem[r + 1].int := mem[p + 1].int;
+ 		    mem[r + 3].int := mem[r + 1].int;
+ 		    mem[r + 1].int := -mem[r + 1].int;
+ 		    mem[r + 5].int := mem[r + 1].int;
+ 		    mem[q + 3].int := -mem[q + 3].int;
+ 		    destx := -destx;
+ 		    del2 := del2 - takefraction(del2 - del3, t);
+ 		    if del2 > 0 then 
+ 			del2 := 0;
+ 		    t := crossingpoint(0, -del2, -del3);
+ 		    if t < 268435456 then begin {412:}
+ 			splitcubic(r, t, destx, desty);
+ 			s := mem[r].hh.rh;
+ 			if mem[s + 1].int < destx then 
+ 			    mem[s + 1].int := destx;
+ 			if mem[s + 1].int < mem[r + 1].int then 
+ 			    mem[s + 1].int := mem[r + 1].int;
+ 			mem[s].hh.b1 := mem[p].hh.b1;
+ 			mem[s + 3].int := mem[s + 1].int;
+ 			mem[s + 1].int := -mem[s + 1].int;
+ 			mem[s + 5].int := mem[s + 1].int;
+ 			mem[q + 3].int := -mem[q + 3].int
+ 		    end else if mem[r + 1].int > destx then  {:412}
+ 			mem[r + 1].int := destx
+ 		end {:411}
+ 	    end {:407};
+ {413:}
+ 	    pp := p;
+ 	    repeat
+ 		qq := mem[pp].hh.rh;
+ 		abnegate(mem[qq + 1].int, mem[qq + 2].int, mem[qq].hh.b1, mem[pp].hh.b1);
+ 		destx := curx;
+ 		desty := cury;
+ 		del1 := mem[pp + 6].int - mem[pp + 2].int;
+ 		del2 := mem[qq + 4].int - mem[pp + 6].int;
+ 		del3 := desty - mem[qq + 4].int; {408:}
+ 		if del1 <> 0 then 
+ 		    del := del1
+ 		else if del2 <> 0 then 
+ 		    del := del2
+ 		else 
+ 		    del := del3;
+ 		if del <> 0 then begin
+ 		    dmax := abs(del1);
+ 		    if abs(del2) > dmax then 
+ 			dmax := abs(del2);
+ 		    if abs(del3) > dmax then 
+ 			dmax := abs(del3);
+ 		    while dmax < 134217728 do begin
+ 			dmax := dmax + dmax;
+ 			del1 := del1 + del1;
+ 			del2 := del2 + del2;
+ 			del3 := del3 + del3
+ 		    end
+ 		end {:408};
+ 		if del <> 0 then begin
+ 		    if del < 0 then begin {414:}
+ 			mem[pp + 2].int := -mem[pp + 2].int;
+ 			mem[pp + 6].int := -mem[pp + 6].int;
+ 			mem[qq + 4].int := -mem[qq + 4].int;
+ 			del1 := -del1;
+ 			del2 := -del2;
+ 			del3 := -del3;
+ 			desty := -desty;
+ 			mem[pp].hh.b1 := mem[pp].hh.b1 + 2
+ 		    end {:414};
+ 		    t := crossingpoint(del1, del2, del3);
+ 		    if t < 268435456 then begin {415:}
+ 			splitcubic(pp, t, destx, desty);
+ 			r := mem[pp].hh.rh;
+ 			if mem[r].hh.b1 > 2 then 
+ 			    mem[r].hh.b1 := mem[r].hh.b1 - 2
+ 			else 
+ 			    mem[r].hh.b1 := mem[r].hh.b1 + 2;
+ 			if mem[r + 1].int > destx then 
+ 			    mem[r + 1].int := destx
+ 			else if mem[r + 1].int < mem[pp + 1].int then 
+ 			    mem[r + 1].int := mem[pp + 1].int;
+ 			if mem[r + 2].int < mem[pp + 2].int then 
+ 			    mem[r + 2].int := mem[pp + 2].int;
+ 			mem[r + 4].int := mem[r + 2].int;
+ 			mem[r + 2].int := -mem[r + 2].int;
+ 			mem[r + 6].int := mem[r + 2].int;
+ 			mem[qq + 4].int := -mem[qq + 4].int;
+ 			desty := -desty;
+ 			del2 := del2 - takefraction(del2 - del3, t);
+ 			if del2 > 0 then 
+ 			    del2 := 0;
+ 			t := crossingpoint(0, -del2, -del3);
+ 			if t < 268435456 then begin {416:}
+ 			    splitcubic(r, t, destx, desty);
+ 			    s := mem[r].hh.rh;
+ 			    if mem[s + 1].int > destx then 
+ 				mem[s + 1].int := destx
+ 			    else if mem[s + 1].int < mem[r + 1].int then 
+ 				mem[s + 1].int := mem[r + 1].int;
+ 			    if mem[s + 2].int < desty then 
+ 				mem[s + 2].int := desty;
+ 			    if mem[s + 2].int < mem[r + 2].int then 
+ 				mem[s + 2].int := mem[r + 2].int;
+ 			    mem[s].hh.b1 := mem[pp].hh.b1;
+ 			    mem[s + 4].int := mem[s + 2].int;
+ 			    mem[s + 2].int := -mem[s + 2].int;
+ 			    mem[s + 6].int := mem[s + 2].int;
+ 			    mem[qq + 4].int := -mem[qq + 4].int
+ 			end else if mem[r + 2].int > desty then  {:416}
+ 			    mem[r + 2].int := desty
+ 		    end {:415}
+ 		end else if constantx then begin {417:}
+ 		    if q <> p then begin
+ 			removecubic(p);
+ 			if curspec <> q then 
+ 			    goto 22
+ 			else begin
+ 			    curspec := p;
+ 			    goto 10
+ 			end
+ 		    end
+ 		end else if not odd(mem[pp].hh.b1) then begin {414:}
+ 		    mem[pp + 2].int := -mem[pp + 2].int;
+ 		    mem[pp + 6].int := -mem[pp + 6].int;
+ 		    mem[qq + 4].int := -mem[qq + 4].int;
+ 		    del1 := -del1;
+ 		    del2 := -del2;
+ 		    del3 := -del3;
+ 		    desty := -desty;
+ 		    mem[pp].hh.b1 := mem[pp].hh.b1 + 2
+ 		end {:414} {:417};
+ 		pp := qq
+ 	    until pp = q;
+ 	    if constantx then begin {418:}
+ 		pp := p;
+ 		repeat
+ 		    qq := mem[pp].hh.rh;
+ 		    if mem[pp].hh.b1 > 2 then begin
+ 			mem[pp].hh.b1 := mem[pp].hh.b1 + 1;
+ 			mem[pp + 1].int := -mem[pp + 1].int;
+ 			mem[pp + 5].int := -mem[pp + 5].int;
+ 			mem[qq + 3].int := -mem[qq + 3].int
+ 		    end;
+ 		    pp := qq
+ 		until pp = q
+ 	    end {:418} {:413};
+ 	    p := q
+ 	until p = curspec;
+     10:
+ 	
+     end; {:406} {419:}
+ 
+     procedure octantsubdivide;
+     var
+ 	p, q, r, s: halfword;
+ 	del1, del2, del3, del, dmax: scaled;
+ 	t: fraction;
+ 	destx, desty: scaled;
+     begin
+ 	p := curspec;
+ 	repeat
+ 	    q := mem[p].hh.rh;
+ 	    mem[p + 1].int := mem[p + 1].int - mem[p + 2].int;
+ 	    mem[p + 5].int := mem[p + 5].int - mem[p + 6].int;
+ 	    mem[q + 3].int := mem[q + 3].int - mem[q + 4].int; {420:} {421:}
+ 	    if q = curspec then begin
+ 		unskew(mem[q + 1].int, mem[q + 2].int, mem[q].hh.b1);
+ 		skew(curx, cury, mem[p].hh.b1);
+ 		destx := curx;
+ 		desty := cury
+ 	    end else begin
+ 		abnegate(mem[q + 1].int, mem[q + 2].int, mem[q].hh.b1, mem[p].hh.b1);
+ 		destx := curx - cury;
+ 		desty := cury
+ 	    end;
+ 	    del1 := mem[p + 5].int - mem[p + 1].int;
+ 	    del2 := mem[q + 3].int - mem[p + 5].int;
+ 	    del3 := destx - mem[q + 3].int {:421}; {408:}
+ 	    if del1 <> 0 then 
+ 		del := del1
+ 	    else if del2 <> 0 then 
+ 		del := del2
+ 	    else 
+ 		del := del3;
+ 	    if del <> 0 then begin
+ 		dmax := abs(del1);
+ 		if abs(del2) > dmax then 
+ 		    dmax := abs(del2);
+ 		if abs(del3) > dmax then 
+ 		    dmax := abs(del3);
+ 		while dmax < 134217728 do begin
+ 		    dmax := dmax + dmax;
+ 		    del1 := del1 + del1;
+ 		    del2 := del2 + del2;
+ 		    del3 := del3 + del3
+ 		end
+ 	    end {:408};
+ 	    if del <> 0 then begin
+ 		if del < 0 then begin {423:}
+ 		    mem[p + 2].int := mem[p + 1].int + mem[p + 2].int;
+ 		    mem[p + 1].int := -mem[p + 1].int;
+ 		    mem[p + 6].int := mem[p + 5].int + mem[p + 6].int;
+ 		    mem[p + 5].int := -mem[p + 5].int;
+ 		    mem[q + 4].int := mem[q + 3].int + mem[q + 4].int;
+ 		    mem[q + 3].int := -mem[q + 3].int;
+ 		    del1 := -del1;
+ 		    del2 := -del2;
+ 		    del3 := -del3;
+ 		    desty := destx + desty;
+ 		    destx := -destx;
+ 		    mem[p].hh.b1 := mem[p].hh.b1 + 4
+ 		end {:423};
+ 		t := crossingpoint(del1, del2, del3);
+ 		if t < 268435456 then begin {424:}
+ 		    splitcubic(p, t, destx, desty);
+ 		    r := mem[p].hh.rh;
+ 		    if mem[r].hh.b1 > 4 then 
+ 			mem[r].hh.b1 := mem[r].hh.b1 - 4
+ 		    else 
+ 			mem[r].hh.b1 := mem[r].hh.b1 + 4;
+ 		    if mem[r + 2].int > desty then 
+ 			mem[r + 2].int := desty
+ 		    else if mem[r + 2].int < mem[p + 2].int then 
+ 			mem[r + 2].int := mem[p + 2].int;
+ 		    if mem[r + 1].int < mem[p + 1].int then 
+ 			mem[r + 1].int := mem[p + 1].int;
+ 		    mem[r + 3].int := mem[r + 1].int;
+ 		    mem[r + 2].int := mem[r + 2].int + mem[r + 1].int;
+ 		    mem[r + 1].int := -mem[r + 1].int;
+ 		    mem[r + 5].int := mem[r + 1].int;
+ 		    mem[r + 6].int := mem[r + 6].int - mem[r + 5].int;
+ 		    mem[q + 4].int := mem[q + 4].int + mem[q + 3].int;
+ 		    mem[q + 3].int := -mem[q + 3].int;
+ 		    desty := desty + destx;
+ 		    destx := -destx;
+ 		    del2 := del2 - takefraction(del2 - del3, t);
+ 		    if del2 > 0 then 
+ 			del2 := 0;
+ 		    t := crossingpoint(0, -del2, -del3);
+ 		    if t < 268435456 then begin {425:}
+ 			splitcubic(r, t, destx, desty);
+ 			s := mem[r].hh.rh;
+ 			if mem[s + 2].int > desty then 
+ 			    mem[s + 2].int := desty
+ 			else if mem[s + 2].int < mem[r + 2].int then 
+ 			    mem[s + 2].int := mem[r + 2].int;
+ 			if mem[s + 1].int < destx then 
+ 			    mem[s + 1].int := destx;
+ 			if mem[s + 1].int < mem[r + 1].int then 
+ 			    mem[s + 1].int := mem[r + 1].int;
+ 			mem[s].hh.b1 := mem[p].hh.b1;
+ 			mem[s + 3].int := mem[s + 1].int;
+ 			mem[s + 2].int := mem[s + 2].int + mem[s + 1].int;
+ 			mem[s + 1].int := -mem[s + 1].int;
+ 			mem[s + 6].int := mem[s + 6].int - mem[s + 1].int;
+ 			mem[s + 5].int := mem[s + 1].int;
+ 			mem[q + 4].int := mem[q + 4].int + mem[q + 3].int;
+ 			mem[q + 3].int := -mem[q + 3].int
+ 		    end else if mem[r + 1].int > destx then  {:425}
+ 			mem[r + 1].int := destx {:424}
+ 		end
+ 	    end {:420};
+ 	    p := q
+ 	until p = curspec
+     end; {:419} {426:}
+ 
+     procedure makesafe;
+     var
+ 	k: 0..maxwiggle;
+ 	allsafe: boolean;
+ 	nexta: scaled;
+ 	deltaa, deltab: scaled;
+     begin
+ 	before[curroundingptr] := before[0];
+ 	nodetoround[curroundingptr] := nodetoround[0];
+ 	repeat
+ 	    after[curroundingptr] := after[0];
+ 	    allsafe := true;
+ 	    nexta := after[0];
+ 	    for k := 0 to curroundingptr - 1 do begin
+ 		deltab := before[k + 1] - before[k];
+ 		if deltab >= 0 then 
+ 		    deltaa := after[k + 1] - nexta
+ 		else 
+ 		    deltaa := nexta - after[k + 1];
+ 		nexta := after[k + 1];
+ 		if (deltaa < 0) or (deltaa > abs(deltab + deltab)) then begin
+ 		    allsafe := false;
+ 		    after[k] := before[k];
+ 		    if k = (curroundingptr - 1) then 
+ 			after[0] := before[0]
+ 		    else 
+ 			after[k + 1] := before[k + 1]
+ 		end
+ 	    end
+ 	until allsafe
+     end; {:426} {429:}
+ 
+     procedure beforeandafter(b, a: scaled; p: halfword);
+     begin
+ 	if curroundingptr = maxroundingptr then 
+ 	    if maxroundingptr < maxwiggle then 
+ 		maxroundingptr := maxroundingptr + 1
+ 	    else 
+ 		overflow(435, maxwiggle);
+ 	after[curroundingptr] := a;
+ 	before[curroundingptr] := b;
+ 	nodetoround[curroundingptr] := p;
+ 	curroundingptr := curroundingptr + 1
+     end; { beforeandafter }
+ {:429}
+     {431:}
+ 
+     function goodval(b, o: scaled): scaled;
+     var
+ 	a: scaled;
+     begin
+ 	a := b + o;
+ 	if a >= 0 then 
+ 	    a := (a - (a mod curgran)) - o
+ 	else 
+ 	    a := (((a + ((-(a + 1)) mod curgran)) - curgran) + 1) - o;
+ 	if (b - a) < ((a + curgran) - b) then 
+ 	    goodval := a
+ 	else 
+ 	    goodval := a + curgran
+     end; {:431} {432:}
+ 
+     function compromise(u, v: scaled): scaled;
+     begin
+ 	compromise := goodval(u + u, (-u) - v) div 2
+     end; {:432} {433:}
+ 
+     procedure xyround;
+     var
+ 	p, q: halfword;
+ 	b, a: scaled;
+ 	penedge: scaled;
+ 	alpha: fraction;
+     begin
+ 	curgran := abs(internal[37]);
+ 	if curgran = 0 then 
+ 	    curgran := 65536;
+ 	p := curspec;
+ 	curroundingptr := 0;
+ 	repeat
+ 	    q := mem[p].hh.rh; {434:}
+ 	    if odd(mem[p].hh.b1) <> odd(mem[q].hh.b1) then begin
+ 		if odd(mem[q].hh.b1) then 
+ 		    b := mem[q + 1].int
+ 		else 
+ 		    b := -mem[q + 1].int;
+ 		if (abs(mem[q + 1].int - mem[q + 5].int) < 655) or (abs(mem[q + 1].int + mem[q + 3].int) < 655) then begin {435:}
+ 		    if curpen = (-29997) then 
+ 			penedge := 0
+ 		    else if curpathtype = 0 then 
+ 			penedge := compromise(mem[mem[curpen + 5].hh.rh + 2].int, mem[mem[curpen + 7].hh.rh + 2].int)
+ 		    else if odd(mem[q].hh.b1) then 
+ 			penedge := mem[mem[curpen + 7].hh.rh + 2].int
+ 		    else 
+ 			penedge := mem[mem[curpen + 5].hh.rh + 2].int;
+ 		    a := goodval(b, penedge)
+ 		end else  {:435}
+ 		    a := b;
+ 		if abs(a) > maxallowed then 
+ 		    if a > 0 then 
+ 			a := maxallowed
+ 		    else 
+ 			a := -maxallowed;
+ 		beforeandafter(b, a, q)
+ 	    end {:434};
+ 	    p := q
+ 	until p = curspec;
+ 	if curroundingptr > 0 then begin {436:}
+ 	    makesafe;
+ 	    repeat
+ 		curroundingptr := curroundingptr - 1;
+ 		if (after[curroundingptr] <> before[curroundingptr]) or (after[curroundingptr + 1] <> before[curroundingptr + 1]) then begin
+ 		    p := nodetoround[curroundingptr];
+ 		    if odd(mem[p].hh.b1) then begin
+ 			b := before[curroundingptr];
+ 			a := after[curroundingptr]
+ 		    end else begin
+ 			b := -before[curroundingptr];
+ 			a := -after[curroundingptr]
+ 		    end;
+ 		    if before[curroundingptr] = before[curroundingptr + 1] then 
+ 			alpha := 268435456
+ 		    else 
+ 			alpha := makefraction(after[curroundingptr + 1] - after[curroundingptr], before[curroundingptr + 1] - before[curroundingptr]);
+ 		    repeat
+ 			mem[p + 1].int := takefraction(alpha, mem[p + 1].int - b) + a;
+ 			mem[p + 5].int := takefraction(alpha, mem[p + 5].int - b) + a;
+ 			p := mem[p].hh.rh;
+ 			mem[p + 3].int := takefraction(alpha, mem[p + 3].int - b) + a
+ 		    until p = nodetoround[curroundingptr + 1]
+ 		end
+ 	    until curroundingptr = 0
+ 	end {:436};
+ 	p := curspec;
+ 	curroundingptr := 0;
+ 	repeat
+ 	    q := mem[p].hh.rh; {437:}
+ 	    if (mem[p].hh.b1 > 2) <> (mem[q].hh.b1 > 2) then begin
+ 		if mem[q].hh.b1 <= 2 then 
+ 		    b := mem[q + 2].int
+ 		else 
+ 		    b := -mem[q + 2].int;
+ 		if (abs(mem[q + 2].int - mem[q + 6].int) < 655) or (abs(mem[q + 2].int + mem[q + 4].int) < 655) then begin {438:}
+ 		    if curpen = (-29997) then 
+ 			penedge := 0
+ 		    else if curpathtype = 0 then 
+ 			penedge := compromise(mem[mem[curpen + 2].hh.rh + 2].int, mem[mem[curpen + 1].hh.rh + 2].int)
+ 		    else if mem[q].hh.b1 <= 2 then 
+ 			penedge := mem[mem[curpen + 1].hh.rh + 2].int
+ 		    else 
+ 			penedge := mem[mem[curpen + 2].hh.rh + 2].int;
+ 		    a := goodval(b, penedge)
+ 		end else  {:438}
+ 		    a := b;
+ 		if abs(a) > maxallowed then 
+ 		    if a > 0 then 
+ 			a := maxallowed
+ 		    else 
+ 			a := -maxallowed;
+ 		beforeandafter(b, a, q)
+ 	    end {:437};
+ 	    p := q
+ 	until p = curspec;
+ 	if curroundingptr > 0 then begin {439:}
+ 	    makesafe;
+ 	    repeat
+ 		curroundingptr := curroundingptr - 1;
+ 		if (after[curroundingptr] <> before[curroundingptr]) or (after[curroundingptr + 1] <> before[curroundingptr + 1]) then begin
+ 		    p := nodetoround[curroundingptr];
+ 		    if mem[p].hh.b1 <= 2 then begin
+ 			b := before[curroundingptr];
+ 			a := after[curroundingptr]
+ 		    end else begin
+ 			b := -before[curroundingptr];
+ 			a := -after[curroundingptr]
+ 		    end;
+ 		    if before[curroundingptr] = before[curroundingptr + 1] then 
+ 			alpha := 268435456
+ 		    else 
+ 			alpha := makefraction(after[curroundingptr + 1] - after[curroundingptr], before[curroundingptr + 1] - before[curroundingptr]);
+ 		    repeat
+ 			mem[p + 2].int := takefraction(alpha, mem[p + 2].int - b) + a;
+ 			mem[p + 6].int := takefraction(alpha, mem[p + 6].int - b) + a;
+ 			p := mem[p].hh.rh;
+ 			mem[p + 4].int := takefraction(alpha, mem[p + 4].int - b) + a
+ 		    until p = nodetoround[curroundingptr + 1]
+ 		end
+ 	    until curroundingptr = 0
+ 	end {:439}
+     end; {:433} {440:}
+ 
+     procedure diaground;
+     var
+ 	p, q, pp: halfword;
+ 	b, a, bb, aa, d, c, dd, cc: scaled;
+ 	penedge: scaled;
+ 	alpha, beta: fraction;
+ 	nexta: scaled;
+ 	allsafe: boolean;
+ 	k: 0..maxwiggle;
+ 	firstx, firsty: scaled;
+     begin
+ 	p := curspec;
+ 	curroundingptr := 0;
+ 	repeat
+ 	    q := mem[p].hh.rh; {441:}
+ 	    if mem[p].hh.b1 <> mem[q].hh.b1 then begin
+ 		if mem[q].hh.b1 > 4 then 
+ 		    b := -mem[q + 1].int
+ 		else 
+ 		    b := mem[q + 1].int;
+ 		if abs(mem[q].hh.b1 - mem[p].hh.b1) = 4 then 
+ 		    if (abs(mem[q + 1].int - mem[q + 5].int) < 655) or (abs(mem[q + 1].int + mem[q + 3].int) < 655) then begin {442:}
+ 			if curpen = (-29997) then 
+ 			    penedge := 0
+ 			else if curpathtype = 0 then  {443:}
+ 			    case mem[q].hh.b1 of
+ 				1, 5:
+ 				    penedge := compromise(mem[mem[mem[curpen + 1].hh.rh].hh.lh + 1].int, -mem[mem[mem[curpen + 4].hh.rh].hh.lh + 1].int);
+ 				4, 8:
+ 				    penedge := -compromise(mem[mem[mem[curpen + 1].hh.rh].hh.lh + 1].int, -mem[mem[mem[curpen + 4].hh.rh].hh.lh + 1].int);
+ 				6, 2:
+ 				    penedge := compromise(mem[mem[mem[curpen + 2].hh.rh].hh.lh + 1].int, -mem[mem[mem[curpen + 3].hh.rh].hh.lh + 1].int);
+ 				7, 3:
+ 				    penedge := -compromise(mem[mem[mem[curpen + 2].hh.rh].hh.lh + 1].int, -mem[mem[mem[curpen + 3].hh.rh].hh.lh + 1].int)
+ 			    end {:443}
+ 			else if mem[q].hh.b1 <= 4 then 
+ 			    penedge := mem[mem[mem[curpen + mem[q].hh.b1].hh.rh].hh.lh + 1].int
+ 			else 
+ 			    penedge := -mem[mem[mem[curpen + mem[q].hh.b1].hh.rh].hh.lh + 1].int;
+ 			if odd(mem[q].hh.b1) then 
+ 			    a := goodval(b, penedge + (curgran div 2))
+ 			else 
+ 			    a := goodval(b - 1, penedge + (curgran div 2))
+ 		    end else  {:442}
+ 			a := b
+ 		else 
+ 		    a := b;
+ 		beforeandafter(b, a, q)
+ 	    end {:441};
+ 	    p := q
+ 	until p = curspec;
+ 	if curroundingptr > 0 then begin {444:}
+ 	    p := nodetoround[0];
+ 	    firstx := mem[p + 1].int;
+ 	    firsty := mem[p + 2].int; {446:}
+ 	    before[curroundingptr] := before[0];
+ 	    nodetoround[curroundingptr] := nodetoround[0];
+ 	    repeat
+ 		after[curroundingptr] := after[0];
+ 		allsafe := true;
+ 		nexta := after[0];
+ 		for k := 0 to curroundingptr - 1 do begin
+ 		    a := nexta;
+ 		    b := before[k];
+ 		    nexta := after[k + 1];
+ 		    aa := nexta;
+ 		    bb := before[k + 1];
+ 		    if (a <> b) or (aa <> bb) then begin
+ 			p := nodetoround[k];
+ 			pp := nodetoround[k + 1];
+ {445:}
+ 			if aa = bb then begin
+ 			    if pp = nodetoround[0] then 
+ 				unskew(firstx, firsty, mem[pp].hh.b1)
+ 			    else 
+ 				unskew(mem[pp + 1].int, mem[pp + 2].int, mem[pp].hh.b1);
+ 			    skew(curx, cury, mem[p].hh.b1);
+ 			    bb := curx;
+ 			    aa := bb;
+ 			    dd := cury;
+ 			    cc := dd;
+ 			    if mem[p].hh.b1 > 4 then begin
+ 				b := -b;
+ 				a := -a
+ 			    end
+ 			end else begin
+ 			    if mem[p].hh.b1 > 4 then begin
+ 				bb := -bb;
+ 				aa := -aa;
+ 				b := -b;
+ 				a := -a
+ 			    end;
+ 			    if pp = nodetoround[0] then 
+ 				dd := firsty - bb
+ 			    else 
+ 				dd := mem[pp + 2].int - bb;
+ 			    if odd(aa - bb) then 
+ 				if mem[p].hh.b1 > 4 then 
+ 				    cc := dd - (((aa - bb) + 1) div 2)
+ 				else 
+ 				    cc := dd - (((aa - bb) - 1) div 2)
+ 			    else 
+ 				cc := dd - ((aa - bb) div 2)
+ 			end;
+ 			d := mem[p + 2].int;
+ 			if odd(a - b) then 
+ 			    if mem[p].hh.b1 > 4 then 
+ 				c := d - (((a - b) - 1) div 2)
+ 			    else 
+ 				c := d - (((a - b) + 1) div 2)
+ 			else 
+ 			    c := d - ((a - b) div 2) {:445};
+ 			if (((aa < a) or (cc < c)) or ((aa - a) > (2 * (bb - b)))) or ((cc - c) > (2 * (dd - d))) then begin
+ 			    allsafe := false;
+ 			    after[k] := before[k];
+ 			    if k = (curroundingptr - 1) then 
+ 				after[0] := before[0]
+ 			    else 
+ 				after[k + 1] := before[k + 1]
+ 			end
+ 		    end
+ 		end
+ 	    until allsafe {:446};
+ 	    for k := 0 to curroundingptr - 1 do begin
+ 		a := after[k];
+ 		b := before[k];
+ 		aa := after[k + 1];
+ 		bb := before[k + 1];
+ 		if (a <> b) or (aa <> bb) then begin
+ 		    p := nodetoround[k];
+ 		    pp := nodetoround[k + 1];
+ {445:}
+ 		    if aa = bb then begin
+ 			if pp = nodetoround[0] then 
+ 			    unskew(firstx, firsty, mem[pp].hh.b1)
+ 			else 
+ 			    unskew(mem[pp + 1].int, mem[pp + 2].int, mem[pp].hh.b1);
+ 			skew(curx, cury, mem[p].hh.b1);
+ 			bb := curx;
+ 			aa := bb;
+ 			dd := cury;
+ 			cc := dd;
+ 			if mem[p].hh.b1 > 4 then begin
+ 			    b := -b;
+ 			    a := -a
+ 			end
+ 		    end else begin
+ 			if mem[p].hh.b1 > 4 then begin
+ 			    bb := -bb;
+ 			    aa := -aa;
+ 			    b := -b;
+ 			    a := -a
+ 			end;
+ 			if pp = nodetoround[0] then 
+ 			    dd := firsty - bb
+ 			else 
+ 			    dd := mem[pp + 2].int - bb;
+ 			if odd(aa - bb) then 
+ 			    if mem[p].hh.b1 > 4 then 
+ 				cc := dd - (((aa - bb) + 1) div 2)
+ 			    else 
+ 				cc := dd - (((aa - bb) - 1) div 2)
+ 			else 
+ 			    cc := dd - ((aa - bb) div 2)
+ 		    end;
+ 		    d := mem[p + 2].int;
+ 		    if odd(a - b) then 
+ 			if mem[p].hh.b1 > 4 then 
+ 			    c := d - (((a - b) - 1) div 2)
+ 			else 
+ 			    c := d - (((a - b) + 1) div 2)
+ 		    else 
+ 			c := d - ((a - b) div 2) {:445};
+ 		    if b = bb then 
+ 			alpha := 268435456
+ 		    else 
+ 			alpha := makefraction(aa - a, bb - b);
+ 		    if d = dd then 
+ 			beta := 268435456
+ 		    else 
+ 			beta := makefraction(cc - c, dd - d);
+ 		    repeat
+ 			mem[p + 1].int := takefraction(alpha, mem[p + 1].int - b) + a;
+ 			mem[p + 2].int := takefraction(beta, mem[p + 2].int - d) + c;
+ 			mem[p + 5].int := takefraction(alpha, mem[p + 5].int - b) + a;
+ 			mem[p + 6].int := takefraction(beta, mem[p + 6].int - d) + c;
+ 			p := mem[p].hh.rh;
+ 			mem[p + 3].int := takefraction(alpha, mem[p + 3].int - b) + a;
+ 			mem[p + 4].int := takefraction(beta, mem[p + 4].int - d) + c
+ 		    until p = pp
+ 		end
+ 	    end
+ 	end {:444}
+     end; {:440} {451:}
+ 
+     procedure newboundary(p: halfword; octant: smallnumber);
+     var
+ 	q, r: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	r := getnode(7);
+ 	mem[r].hh.rh := q;
+ 	mem[p].hh.rh := r;
+ 	mem[r].hh.b0 := mem[q].hh.b0;
+ 	mem[r + 3].int := mem[q + 3].int;
+ 	mem[r + 4].int := mem[q + 4].int;
+ 	mem[r].hh.b1 := 0;
+ 	mem[q].hh.b0 := 0;
+ 	mem[r + 5].int := octant;
+ 	mem[q + 3].int := mem[q].hh.b1;
+ 	unskew(mem[q + 1].int, mem[q + 2].int, mem[q].hh.b1);
+ 	skew(curx, cury, octant);
+ 	mem[r + 1].int := curx;
+ 	mem[r + 2].int := cury
+     end; {:451}
+ 
+     function makespec(h: halfword; safetymargin: scaled; tracing: integer): halfword;
+     label
+ 	22, 30;
+     var
+ 	p, q, r, s: halfword;
+ 	k: integer;
+ 	chopped: boolean; {453:}
+ 	o1, o2: smallnumber;
+ 	clockwise: boolean;
+ 	dx1, dy1, dx2, dy2: integer;
+ 	dmax, del: integer; {:453}
+     begin
+ 	curspec := h;
+ 	if tracing > 0 then 
+ 	    printpath(curspec, 426, true);
+ 	maxallowed := 268402687 - safetymargin; {404:}
+ 	p := curspec;
+ 	k := 1;
+ 	chopped := false;
+ 	repeat
+ 	    if abs(mem[p + 3].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 3].int > 0 then 
+ 		    mem[p + 3].int := maxallowed
+ 		else 
+ 		    mem[p + 3].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 4].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 4].int > 0 then 
+ 		    mem[p + 4].int := maxallowed
+ 		else 
+ 		    mem[p + 4].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 1].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 1].int > 0 then 
+ 		    mem[p + 1].int := maxallowed
+ 		else 
+ 		    mem[p + 1].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 2].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 2].int > 0 then 
+ 		    mem[p + 2].int := maxallowed
+ 		else 
+ 		    mem[p + 2].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 5].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 5].int > 0 then 
+ 		    mem[p + 5].int := maxallowed
+ 		else 
+ 		    mem[p + 5].int := -maxallowed
+ 	    end;
+ 	    if abs(mem[p + 6].int) > maxallowed then begin
+ 		chopped := true;
+ 		if mem[p + 6].int > 0 then 
+ 		    mem[p + 6].int := maxallowed
+ 		else 
+ 		    mem[p + 6].int := -maxallowed
+ 	    end;
+ 	    p := mem[p].hh.rh;
+ 	    mem[p].hh.b0 := k;
+ 	    if k < 127 then 
+ 		k := k + 1
+ 	    else 
+ 		k := 1
+ 	until p = curspec;
+ 	if chopped then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(430)
+ 	    end;
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 431;
+ 		helpline[2] := 432;
+ 		helpline[1] := 433;
+ 		helpline[0] := 434
+ 	    end;
+ 	    putgeterror
+ 	end {:404};
+ 	quadrantsubdivide;
+ 	if internal[36] > 0 then 
+ 	    xyround;
+ 	octantsubdivide;
+ 	if internal[36] > 65536 then 
+ 	    diaground; {447:}
+ 	p := curspec;
+ 	repeat
+     22:
+ 	    q := mem[p].hh.rh;
+ 	    if p <> q then begin
+ 		if mem[p + 1].int = mem[p + 5].int then 
+ 		    if mem[p + 2].int = mem[p + 6].int then 
+ 			if mem[p + 1].int = mem[q + 3].int then 
+ 			    if mem[p + 2].int = mem[q + 4].int then begin
+ 				unskew(mem[q + 1].int, mem[q + 2].int, mem[q].hh.b1);
+ 				skew(curx, cury, mem[p].hh.b1);
+ 				if mem[p + 1].int = curx then 
+ 				    if mem[p + 2].int = cury then begin
+ 					removecubic(p);
+ 					if q <> curspec then 
+ 					    goto 22;
+ 					curspec := p;
+ 					q := p
+ 				    end
+ 			    end
+ 	    end;
+ 	    p := q
+ 	until p = curspec; {:447} {450:}
+ 	turningnumber := 0;
+ 	p := curspec;
+ 	q := mem[p].hh.rh;
+ 	repeat
+ 	    r := mem[q].hh.rh;
+ 	    if (mem[p].hh.b1 <> mem[q].hh.b1) or (q = r) then begin {452:}
+ 		newboundary(p, mem[p].hh.b1);
+ 		s := mem[p].hh.rh;
+ 		o1 := octantnumber[mem[p].hh.b1];
+ 		o2 := octantnumber[mem[q].hh.b1];
+ 		case o2 - o1 of
+ 		    1, -7, 7, -1:
+ 			goto 30;
+ 		    2, -6:
+ 			clockwise := false;
+ 		    3, -5, 4, -4, 5, -3:
+ 			begin {454:} {457:}
+ 			    dx1 := mem[s + 1].int - mem[s + 3].int;
+ 			    dy1 := mem[s + 2].int - mem[s + 4].int;
+ 			    if dx1 = 0 then 
+ 				if dy1 = 0 then begin
+ 				    dx1 := mem[s + 1].int - mem[p + 5].int;
+ 				    dy1 := mem[s + 2].int - mem[p + 6].int;
+ 				    if dx1 = 0 then 
+ 					if dy1 = 0 then begin
+ 					    dx1 := mem[s + 1].int - mem[p + 1].int;
+ 					    dy1 := mem[s + 2].int - mem[p + 2].int
+ 					end
+ 				end;
+ 			    dmax := abs(dx1);
+ 			    if abs(dy1) > dmax then 
+ 				dmax := abs(dy1);
+ 			    while dmax < 268435456 do begin
+ 				dmax := dmax + dmax;
+ 				dx1 := dx1 + dx1;
+ 				dy1 := dy1 + dy1
+ 			    end;
+ 			    dx2 := mem[q + 5].int - mem[q + 1].int;
+ 			    dy2 := mem[q + 6].int - mem[q + 2].int;
+ 			    if dx2 = 0 then 
+ 				if dy2 = 0 then begin
+ 				    dx2 := mem[r + 3].int - mem[q + 1].int;
+ 				    dy2 := mem[r + 4].int - mem[q + 2].int;
+ 				    if dx2 = 0 then 
+ 					if dy2 = 0 then begin
+ 					    if mem[r].hh.b1 = 0 then begin
+ 						curx := mem[r + 1].int;
+ 						cury := mem[r + 2].int
+ 					    end else begin
+ 						unskew(mem[r + 1].int, mem[r + 2].int, mem[r].hh.b1);
+ 						skew(curx, cury, mem[q].hh.b1)
+ 					    end;
+ 					    dx2 := curx - mem[q + 1].int;
+ 					    dy2 := cury - mem[q + 2].int
+ 					end
+ 				end;
+ 			    dmax := abs(dx2);
+ 			    if abs(dy2) > dmax then 
+ 				dmax := abs(dy2);
+ 			    while dmax < 268435456 do begin
+ 				dmax := dmax + dmax;
+ 				dx2 := dx2 + dx2;
+ 				dy2 := dy2 + dy2
+ 			    end {:457};
+ 			    unskew(dx1, dy1, mem[p].hh.b1);
+ 			    del := pythadd(curx, cury);
+ 			    dx1 := makefraction(curx, del);
+ 			    dy1 := makefraction(cury, del);
+ 			    unskew(dx2, dy2, mem[q].hh.b1);
+ 			    del := pythadd(curx, cury);
+ 			    dx2 := makefraction(curx, del);
+ 			    dy2 := makefraction(cury, del);
+ 			    del := takefraction(dx1, dy2) - takefraction(dx2, dy1);
+ 			    if del > 4684844 then 
+ 				clockwise := false
+ 			    else if del < (-4684844) then 
+ 				clockwise := true
+ 			    else 
+ 				clockwise := revturns
+ 			end; {:454}
+ 		    6, -2:
+ 			clockwise := true;
+ 		    0:
+ 			clockwise := revturns
+ 		end; {458:}
+ 		while true do begin
+ 		    if clockwise then 
+ 			if o1 = 1 then 
+ 			    o1 := 8
+ 			else 
+ 			    o1 := o1 - 1
+ 		    else if o1 = 8 then 
+ 			o1 := 1
+ 		    else 
+ 			o1 := o1 + 1;
+ 		    if o1 = o2 then 
+ 			goto 30;
+ 		    newboundary(s, octantcode[o1]);
+ 		    s := mem[s].hh.rh;
+ 		    mem[s + 3].int := mem[s + 5].int
+ 		end {:458};
+     30:
+ 		if q = r then begin
+ 		    q := mem[q].hh.rh;
+ 		    r := q;
+ 		    p := s;
+ 		    mem[s].hh.rh := q;
+ 		    mem[q + 3].int := mem[q + 5].int;
+ 		    mem[q].hh.b0 := 0;
+ 		    freenode(curspec, 7);
+ 		    curspec := q
+ 		end; {459:}
+ 		p := mem[p].hh.rh;
+ 		repeat
+ 		    s := mem[p].hh.rh;
+ 		    o1 := octantnumber[mem[p + 5].int];
+ 		    o2 := octantnumber[mem[s + 3].int];
+ 		    if abs(o1 - o2) = 1 then begin
+ 			if o2 < o1 then 
+ 			    o2 := o1;
+ 			if odd(o2) then 
+ 			    mem[p + 6].int := 0
+ 			else 
+ 			    mem[p + 6].int := 1
+ 		    end else begin
+ 			if o1 = 8 then 
+ 			    turningnumber := turningnumber + 1
+ 			else 
+ 			    turningnumber := turningnumber - 1;
+ 			mem[p + 6].int := 0
+ 		    end;
+ 		    mem[s + 4].int := mem[p + 6].int;
+ 		    p := s
+ 		until p = q {:459}
+ 	    end {:452};
+ 	    p := q;
+ 	    q := r
+ 	until p = curspec; {:450}
+ 	while mem[curspec].hh.b0 <> 0 do 
+ 	    curspec := mem[curspec].hh.rh;
+ 	if tracing > 0 then 
+ 	    if internal[36] <= 0 then 
+ 		printspec(427)
+ 	    else if internal[36] > 65536 then 
+ 		printspec(428)
+ 	    else 
+ 		printspec(429);
+ 	makespec := curspec
+     end; { makespec }
+ {:402}
+     {463:}
+ 
+     procedure endround(x, y: scaled);
+     begin
+ 	y := (y + 32768) - ycorr[octant];
+ 	x := (x + y) - xcorr[octant];
+ 	m1 := floorunscaled(x);
+ 	n1 := floorunscaled(y);
+ 	if (x - (65536 * m1)) >= ((y - (65536 * n1)) + zcorr[octant]) then 
+ 	    d1 := 1
+ 	else 
+ 	    d1 := 0
+     end; {:463}
+ {465:}
+ 
+     procedure fillspec(h: halfword);
+     var
+ 	p, q, r, s: halfword;
+     begin
+ 	if internal[10] > 0 then 
+ 	    beginedgetracing;
+ 	p := h;
+ 	{------------------------------------}
+ 	print_start(psfile); { Start cycle }
+ 	{------------------------------------}
+ 	repeat
+ 	    octant := mem[p + 3].int; {466:}
+ 	    q := p;
+ 	    while mem[q].hh.b1 <> 0 do 
+ 		q := mem[q].hh.rh {:466};
+ 	    if q <> p then begin {467:}
+ 		endround(mem[p + 1].int, mem[p + 2].int);
+ 		m0 := m1;
+ 		n0 := n1;
+ 		d0 := d1;
+ 		endround(mem[q + 1].int, mem[q + 2].int) {:467}; {468:}
+ 		if (n1 - n0) >= movesize then 
+ 		    overflow(407, movesize);
+ 		move[0] := d0;
+ 		moveptr := 0;
+ 		r := p;
+ 		repeat
+ 		    s := mem[r].hh.rh;
+ 		    makemoves(mem[r + 1].int, mem[r + 5].int, mem[s + 3].int, mem[s + 1].int, mem[r + 2].int + 32768, mem[r + 6].int + 32768, mem[s + 4].int + 32768, mem[s + 2].int + 32768, xycorr[octant], ycorr[octant],465,octant);
+ 		    r := s
+ 		until r = q;
+ 		move[moveptr] := move[moveptr] - d1;
+ 		if internal[35] > 0 then 
+ 		    smoothmoves(0, moveptr) {:468};
+ 		movetoedges(m0, n0, m1, n1)
+ 	    end;
+ 	    p := mem[q].hh.rh
+ 	until p = h;
+ 	{------------------------------------}
+ 	print_end(psfile); { End cycle }
+ 	{------------------------------------}
+ 	tossknotlist(h);
+ 	if internal[10] > 0 then 
+ 	    endedgetracing
+     end; {:465} {476:}
+ 
+     procedure dupoffset(w: halfword);
+     var
+ 	r: halfword;
+     begin
+ 	r := getnode(3);
+ 	mem[r + 1].int := mem[w + 1].int;
+ 	mem[r + 2].int := mem[w + 2].int;
+ 	mem[r].hh.rh := mem[w].hh.rh;
+ 	mem[mem[w].hh.rh].hh.lh := r;
+ 	mem[r].hh.lh := w;
+ 	mem[w].hh.rh := r
+     end; {:476} {477:}
+ 
+     function makepen(h: halfword): halfword;
+     label
+ 	30, 31, 45, 40;
+     var
+ 	o, oo, k: smallnumber;
+ 	p: halfword;
+ 	q, r, s, w, hh: halfword;
+ 	n: integer;
+ 	dx, dy: scaled;
+ 	mc: scaled; {479:}
+     begin
+ 	q := h;
+ 	r := mem[q].hh.rh;
+ 	mc := abs(mem[h + 1].int);
+ 	if q = r then begin
+ 	    hh := h;
+ 	    mem[h].hh.b1 := 0;
+ 	    if mc < abs(mem[h + 2].int) then 
+ 		mc := abs(mem[h + 2].int)
+ 	end else begin
+ 	    o := 0;
+ 	    hh := -30000;
+ 	    while true do begin
+ 		s := mem[r].hh.rh;
+ 		if mc < abs(mem[r + 1].int) then 
+ 		    mc := abs(mem[r + 1].int);
+ 		if mc < abs(mem[r + 2].int) then 
+ 		    mc := abs(mem[r + 2].int);
+ 		dx := mem[r + 1].int - mem[q + 1].int;
+ 		dy := mem[r + 2].int - mem[q + 2].int;
+ 		if dx = 0 then 
+ 		    if dy = 0 then 
+ 			goto 45;
+ 		if abvscd(dx, mem[s + 2].int - mem[r + 2].int, dy, mem[s + 1].int - mem[r + 1].int) < 0 then 
+ 		    goto 45; {480:}
+ 		if dx > 0 then 
+ 		    octant := 1
+ 		else if dx = 0 then 
+ 		    if dy > 0 then 
+ 			octant := 1
+ 		    else 
+ 			octant := 2
+ 		else begin
+ 		    dx := -dx;
+ 		    octant := 2
+ 		end;
+ 		if dy < 0 then begin
+ 		    dy := -dy;
+ 		    octant := octant + 2
+ 		end else if dy = 0 then 
+ 		    if octant > 1 then 
+ 			octant := 4;
+ 		if dx < dy then 
+ 		    octant := octant + 4 {:480};
+ 		mem[q].hh.b1 := octant;
+ 		oo := octantnumber[octant];
+ 		if o > oo then begin
+ 		    if hh <> (-30000) then 
+ 			goto 45;
+ 		    hh := q
+ 		end;
+ 		o := oo;
+ 		if (q = h) and (hh <> (-30000)) then 
+ 		    goto 30;
+ 		q := r;
+ 		r := s
+ 	    end;
+     30: {:479}
+ 	    
+ 	end;
+ 	if mc >= 268402688 then 
+ 	    goto 45;
+ 	p := getnode(10);
+ 	q := hh;
+ 	mem[p + 9].int := mc;
+ 	mem[p].hh.lh := -30000;
+ 	if mem[q].hh.rh <> q then 
+ 	    mem[p].hh.rh := -29999;
+ 	for k := 1 to 8 do begin {481:}
+ 	    octant := octantcode[k];
+ 	    n := 0;
+ 	    h := p + octant;
+ 	    while true do begin
+ 		r := getnode(3);
+ 		skew(mem[q + 1].int, mem[q + 2].int, octant);
+ 		mem[r + 1].int := curx;
+ 		mem[r + 2].int := cury;
+ 		if n = 0 then 
+ 		    mem[h].hh.rh := r {482:}
+ 		else if odd(k) then begin
+ 		    mem[w].hh.rh := r;
+ 		    mem[r].hh.lh := w
+ 		end else begin
+ 		    mem[w].hh.lh := r;
+ 		    mem[r].hh.rh := w
+ 		end {:482};
+ 		w := r;
+ 		if mem[q].hh.b1 <> octant then 
+ 		    goto 31;
+ 		q := mem[q].hh.rh;
+ 		n := n + 1
+ 	    end;
+     31: {483:}
+ 	    r := mem[h].hh.rh;
+ 	    if odd(k) then begin
+ 		mem[w].hh.rh := r;
+ 		mem[r].hh.lh := w
+ 	    end else begin
+ 		mem[w].hh.lh := r;
+ 		mem[r].hh.rh := w;
+ 		mem[h].hh.rh := w;
+ 		r := w
+ 	    end;
+ 	    if (mem[r + 2].int <> mem[mem[r].hh.rh + 2].int) or (n = 0) then begin
+ 		dupoffset(r);
+ 		n := n + 1
+ 	    end;
+ 	    r := mem[r].hh.lh;
+ 	    {:
+ 	    483}
+ 	    if mem[r + 1].int <> mem[mem[r].hh.lh + 1].int then 
+ 		dupoffset(r)
+ 	    else 
+ 		n := n - 1;
+ 	    if n >= 127 then 
+ 		overflow(446, 127);
+ 	    mem[h].hh.lh := n
+ 	end {:481};
+ 	goto 40;
+     45:
+ 	p := -29997; {478:}
+ 	if mc >= 268402688 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(440)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 441;
+ 		helpline[0] := 442
+ 	    end
+ 	end else begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(443)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 444;
+ 		helpline[1] := 445;
+ 		helpline[0] := 442
+ 	    end
+ 	end; {:478}
+ 	putgeterror;
+     40:
+ 	if internal[6] > 0 then 
+ 	    printpen(p, 439, true);
+ 	makepen := p
+     end; {:477} {484:} {486:}
+ 
+     function trivialknot(x, y: scaled): halfword;
+     var
+ 	p: halfword;
+     begin
+ 	p := getnode(7);
+ 	mem[p].hh.b0 := 1;
+ 	mem[p].hh.b1 := 1;
+ 	mem[p + 1].int := x;
+ 	mem[p + 3].int := x;
+ 	mem[p + 5].int := x;
+ 	mem[p + 2].int := y;
+ 	mem[p + 4].int := y;
+ 	mem[p + 6].int := y;
+ 	trivialknot := p
+     end; {:486}
+ 
+     function makepath(penhead: halfword): halfword;
+     var
+ 	p: halfword;
+ 	k: 1..8;
+ 	h: halfword;
+ 	m, n: integer;
+ 	w, ww: halfword;
+     begin
+ 	p := 29999;
+ 	for k := 1 to 8 do begin
+ 	    octant := octantcode[k];
+ 	    h := penhead + octant;
+ 	    n := mem[h].hh.lh;
+ 	    w := mem[h].hh.rh;
+ 	    if not odd(k) then 
+ 		w := mem[w].hh.lh;
+ 	    for m := 1 to n + 1 do begin
+ 		if odd(k) then 
+ 		    ww := mem[w].hh.rh
+ 		else 
+ 		    ww := mem[w].hh.lh;
+ 		if (mem[ww + 1].int <> mem[w + 1].int) or (mem[ww + 2].int <> mem[w + 2].int) then begin {485:}
+ 		    unskew(mem[ww + 1].int, mem[ww + 2].int, octant);
+ 		    mem[p].hh.rh := trivialknot(curx, cury);
+ 		    p := mem[p].hh.rh
+ 		end {:485};
+ 		w := ww
+ 	    end
+ 	end;
+ 	if p = 29999 then begin
+ 	    w := mem[penhead + 1].hh.rh;
+ 	    p := trivialknot(mem[w + 1].int + mem[w + 2].int, mem[w + 2].int);
+ 	    mem[29999].hh.rh := p
+ 	end;
+ 	mem[p].hh.rh := mem[29999].hh.rh;
+ 	makepath := mem[29999].hh.rh
+     end; {:484} {488:}
+ 
+     procedure findoffset(x, y: scaled; p: halfword);
+     label
+ 	30, 10;
+     var
+ 	octant: 1..8;
+ 	s: -1..+1;
+ 	n: integer;
+ 	h, w, ww: halfword; {489:}
+     begin
+ 	if x > 0 then 
+ 	    octant := 1
+ 	else if x = 0 then 
+ 	    if y <= 0 then 
+ 		if y = 0 then begin
+ 		    curx := 0;
+ 		    cury := 0;
+ 		    goto 10
+ 		end else 
+ 		    octant := 2
+ 	    else 
+ 		octant := 1
+ 	else begin
+ 	    x := -x;
+ 	    if y = 0 then 
+ 		octant := 4
+ 	    else 
+ 		octant := 2
+ 	end;
+ 	if y < 0 then begin
+ 	    octant := octant + 2;
+ 	    y := -y
+ 	end;
+ 	if x >= y then 
+ 	    x := x - y
+ 	else begin
+ 	    octant := octant + 4;
+ 	    x := y - x;
+ 	    y := y - x
+ 	end {:489};
+ 	if odd(octantnumber[octant]) then 
+ 	    s := -1
+ 	else 
+ 	    s := +1;
+ 	h := p + octant;
+ 	w := mem[mem[h].hh.rh].hh.rh;
+ 	ww := mem[w].hh.rh;
+ 	n := mem[h].hh.lh;
+ 	while n > 1 do begin
+ 	    if abvscd(x, mem[ww + 2].int - mem[w + 2].int, y, mem[ww + 1].int - mem[w + 1].int) <> s then 
+ 		goto 30;
+ 	    w := ww;
+ 	    ww := mem[w].hh.rh;
+ 	    n := n - 1
+ 	end;
+     30:
+ 	unskew(mem[w + 1].int, mem[w + 2].int, octant);
+     10:
+ 	
+     end; {:488} {491:} {493:}
+ 
+     procedure splitforoffset(p: halfword; t: fraction);
+     var
+ 	q: halfword;
+ 	r: halfword;
+     begin
+ 	q := mem[p].hh.rh;
+ 	splitcubic(p, t, mem[q + 1].int, mem[q + 2].int);
+ 	r := mem[p].hh.rh;
+ 	if mem[r + 2].int < mem[p + 2].int then 
+ 	    mem[r + 2].int := mem[p + 2].int
+ 	else if mem[r + 2].int > mem[q + 2].int then 
+ 	    mem[r + 2].int := mem[q + 2].int;
+ 	if mem[r + 1].int < mem[p + 1].int then 
+ 	    mem[r + 1].int := mem[p + 1].int
+ 	else if mem[r + 1].int > mem[q + 1].int then 
+ 	    mem[r + 1].int := mem[q + 1].int
+     end; {:493} {497:}
+ 
+     procedure finoffsetprep(p: halfword; k: halfword; w: halfword; x0, x1, x2, y0, y1, y2: integer; rising: boolean; n: integer);
+     label
+ 	10;
+     var
+ 	q, ww: halfword;
+ 	du, dv: scaled;
+ 	t0, t1, t2: integer;
+ 	t: fraction;
+ 	s: fraction;
+ 	v: integer;
+     begin
+ 	while true do begin
+ 	    q := mem[p].hh.rh;
+ 	    mem[p].hh.b1 := k;
+ 	    if rising then 
+ 		if k = n then 
+ 		    goto 10
+ 		else 
+ 		    ww := mem[w].hh.rh
+ 	    else if k = 1 then 
+ 		goto 10
+ 	    else 
+ 		ww := mem[w].hh.lh; {498:}
+ 	    du := mem[ww + 1].int - mem[w + 1].int;
+ 	    dv := mem[ww + 2].int - mem[w + 2].int;
+ 	    if abs(du) >= abs(dv) then begin
+ 		s := makefraction(dv, du);
+ 		t0 := takefraction(x0, s) - y0;
+ 		t1 := takefraction(x1, s) - y1;
+ 		t2 := takefraction(x2, s) - y2
+ 	    end else begin
+ 		s := makefraction(du, dv);
+ 		t0 := x0 - takefraction(y0, s);
+ 		t1 := x1 - takefraction(y1, s);
+ 		t2 := x2 - takefraction(y2, s)
+ 	    end {:498};
+ 	    t := crossingpoint(t0, t1, t2);
+ 	    if t >= 268435456 then 
+ 		goto 10; {499:}
+ 	    begin
+ 		splitforoffset(p, t);
+ 		mem[p].hh.b1 := k;
+ 		p := mem[p].hh.rh;
+ 		v := x0 - takefraction(x0 - x1, t);
+ 		x1 := x1 - takefraction(x1 - x2, t);
+ 		x0 := v - takefraction(v - x1, t);
+ 		v := y0 - takefraction(y0 - y1, t);
+ 		y1 := y1 - takefraction(y1 - y2, t);
+ 		y0 := v - takefraction(v - y1, t);
+ 		t1 := t1 - takefraction(t1 - t2, t);
+ 		if t1 > 0 then 
+ 		    t1 := 0;
+ 		t := crossingpoint(0, -t1, -t2);
+ 		if t < 268435456 then begin
+ 		    splitforoffset(p, t);
+ 		    mem[mem[p].hh.rh].hh.b1 := k;
+ 		    v := x1 - takefraction(x1 - x2, t);
+ 		    x1 := x0 - takefraction(x0 - x1, t);
+ 		    x2 := x1 - takefraction(x1 - v, t);
+ 		    v := y1 - takefraction(y1 - y2, t);
+ 		    y1 := y0 - takefraction(y0 - y1, t);
+ 		    y2 := y1 - takefraction(y1 - v, t)
+ 		end
+ 	    end {:499};
+ 	    if rising then 
+ 		k := k + 1
+ 	    else 
+ 		k := k - 1;
+ 	    w := ww
+ 	end;
+     10:
+ 	
+     end; {:497}
+ 
+     procedure offsetprep(c, h: halfword);
+     label
+ 	30, 45;
+     var
+ 	n: halfword;
+ 	p, q, r, lh, ww: halfword;
+ 	k: halfword;
+ 	w: halfword; {495:}
+ 	x0, x1, x2, y0, y1, y2: integer;
+ 	t0, t1, t2: integer;
+ 	du, dv, dx, dy: integer;
+ 	maxcoef: integer;
+ 	x0a, x1a, x2a, y0a, y1a, y2a: integer;
+ 	t: fraction;
+ 	s: fraction;
+ {:495}
+     begin
+ 	p := c;
+ 	n := mem[h].hh.lh;
+ 	lh := mem[h].hh.rh;
+ 	while mem[p].hh.b1 <> 0 do begin
+ 	    q := mem[p].hh.rh; {494:}
+ 	    if n <= 1 then 
+ 		mem[p].hh.b1 := 1
+ 	    else begin {496:}
+ 		x0 := mem[p + 5].int - mem[p + 1].int;
+ 		x2 := mem[q + 1].int - mem[q + 3].int;
+ 		x1 := mem[q + 3].int - mem[p + 5].int;
+ 		y0 := mem[p + 6].int - mem[p + 2].int;
+ 		y2 := mem[q + 2].int - mem[q + 4].int;
+ 		y1 := mem[q + 4].int - mem[p + 6].int;
+ 		maxcoef := abs(x0);
+ 		if abs(x1) > maxcoef then 
+ 		    maxcoef := abs(x1);
+ 		if abs(x2) > maxcoef then 
+ 		    maxcoef := abs(x2);
+ 		if abs(y0) > maxcoef then 
+ 		    maxcoef := abs(y0);
+ 		if abs(y1) > maxcoef then 
+ 		    maxcoef := abs(y1);
+ 		if abs(y2) > maxcoef then 
+ 		    maxcoef := abs(y2);
+ 		if maxcoef = 0 then 
+ 		    goto 45;
+ 		while maxcoef < 268435456 do begin
+ 		    maxcoef := maxcoef + maxcoef;
+ 		    x0 := x0 + x0;
+ 		    x1 := x1 + x1;
+ 		    x2 := x2 + x2;
+ 		    y0 := y0 + y0;
+ 		    y1 := y1 + y1;
+ 		    y2 := y2 + y2
+ 		end {:496}; {501:}
+ 		dx := x0;
+ 		dy := y0;
+ 		if dx = 0 then 
+ 		    if dy = 0 then begin
+ 			dx := x1;
+ 			dy := y1;
+ 			if dx = 0 then 
+ 			    if dy = 0 then begin
+ 				dx := x2;
+ 				dy := y2
+ 			    end
+ 		    end {:501};
+ 		if dx = 0 then  {505:}
+ 		    finoffsetprep(p, n, mem[mem[lh].hh.lh].hh.lh, -x0, -x1, -x2, -y0, -y1, -y2, false, n) {:505}
+ 		else begin {502:}
+ 		    k := 1;
+ 		    w := mem[lh].hh.rh;
+ 		    while true do begin
+ 			if k = n then 
+ 			    goto 30;
+ 			ww := mem[w].hh.rh;
+ 			if abvscd(dy, abs(mem[ww + 1].int - mem[w + 1].int), dx, abs(mem[ww + 2].int - mem[w + 2].int)) >= 0 then begin
+ 			    k := k + 1;
+ 			    w := ww
+ 			end else 
+ 			    goto 30
+ 		    end;
+     30: {:502}
+ 		    ;
+ {503:}
+ 		    if k = 1 then 
+ 			t := 268435457
+ 		    else begin
+ 			ww := mem[w].hh.lh; {498:}
+ 			du := mem[ww + 1].int - mem[w + 1].int;
+ 			dv := mem[ww + 2].int - mem[w + 2].int;
+ 			if abs(du) >= abs(dv) then begin
+ 			    s := makefraction(dv, du);
+ 			    t0 := takefraction(x0, s) - y0;
+ 			    t1 := takefraction(x1, s) - y1;
+ 			    t2 := takefraction(x2, s) - y2
+ 			end else begin
+ 			    s := makefraction(du, dv);
+ 			    t0 := x0 - takefraction(y0, s);
+ 			    t1 := x1 - takefraction(y1, s);
+ 			    t2 := x2 - takefraction(y2, s)
+ 			end {:498};
+ 			t := crossingpoint(-t0, -t1, -t2)
+ 		    end;
+ 		    if t >= 268435456 then 
+ 			finoffsetprep(p, k, w, x0, x1, x2, y0, y1, y2, true, n)
+ 		    else begin
+ 			splitforoffset(p, t);
+ 			r := mem[p].hh.rh;
+ 			x1a := x0 - takefraction(x0 - x1, t);
+ 			x1 := x1 - takefraction(x1 - x2, t);
+ 			x2a := x1a - takefraction(x1a - x1, t);
+ 			y1a := y0 - takefraction(y0 - y1, t);
+ 			y1 := y1 - takefraction(y1 - y2, t);
+ 			y2a := y1a - takefraction(y1a - y1, t);
+ 			finoffsetprep(p, k, w, x0, x1a, x2a, y0, y1a, y2a, true, n);
+ 			x0 := x2a;
+ 			y0 := y2a;
+ 			t1 := t1 - takefraction(t1 - t2, t);
+ 			if t1 < 0 then 
+ 			    t1 := 0;
+ 			t := crossingpoint(0, t1, t2);
+ 			if t < 268435456 then begin {504:}
+ 			    splitforoffset(r, t);
+ 			    x1a := x1 - takefraction(x1 - x2, t);
+ 			    x1 := x0 - takefraction(x0 - x1, t);
+ 			    x0a := x1 - takefraction(x1 - x1a, t);
+ 			    y1a := y1 - takefraction(y1 - y2, t);
+ 			    y1 := y0 - takefraction(y0 - y1, t);
+ 			    y0a := y1 - takefraction(y1 - y1a, t);
+ 			    finoffsetprep(mem[r].hh.rh, k, w, x0a, x1a, x2, y0a, y1a, y2, true, n);
+ 			    x2 := x0a;
+ 			    y2 := y0a
+ 			end {:504};
+ 			finoffsetprep(r, k - 1, ww, -x0, -x1, -x2, -y0, -y1, -y2, false, n)
+ 		    end {:503}
+ 		end;
+     45: {:494}
+ 		
+ 	    end; {492:}
+ 	    repeat
+ 		r := mem[p].hh.rh;
+ 		if mem[p + 1].int = mem[p + 5].int then 
+ 		    if mem[p + 2].int = mem[p + 6].int then 
+ 			if mem[p + 1].int = mem[r + 3].int then 
+ 			    if mem[p + 2].int = mem[r + 4].int then 
+ 				if mem[p + 1].int = mem[r + 1].int then 
+ 				    if mem[p + 2].int = mem[r + 2].int then begin
+ 					removecubic(p);
+ 					if r = q then 
+ 					    q := p;
+ 					r := p
+ 				    end;
+ 		p := r
+ 	    until p = q {:492}
+ 	end
+     end; { offsetprep }
+ {:491}
+     {506:}
+     {510:}
+ 
+     procedure skewlineedges(p, w, ww: halfword);
+     var
+ 	x0, y0, x1, y1: scaled;
+     begin
+ 	if (mem[w + 1].int <> mem[ww + 1].int) or (mem[w + 2].int <> mem[ww + 2].int) then begin
+ 	    x0 := mem[p + 1].int + mem[w + 1].int;
+ 	    y0 := mem[p + 2].int + mem[w + 2].int;
+ 	    x1 := mem[p + 1].int + mem[ww + 1].int;
+ 	    y1 := mem[p + 2].int + mem[ww + 2].int;
+             {-------------------------------------}
+              sendline(x0,y0,x1,y1,octant,510);
+             {-------------------------------------}
+ 	    unskew(x0, y0, octant);
+ 	    x0 := curx;
+ 	    y0 := cury;
+ 	    unskew(x1, y1, octant);
+ {if internal[10]>65536 then begin printnl(451);printtwo(x0,y0);
+ print(450);printtwo(curx,cury);printnl(155);end;}
+ 	    lineedges(x0, y0, curx, cury)
+ 	end
+     end; {:510} {518:}
+ 
+     procedure dualmoves(h, p, q: halfword);
+     label
+ 	30, 31;
+     var
+ 	r, s: halfword; {511:}
+ 	m, n: integer;
+ 	mm0, mm1: integer;
+ 	k: integer;
+ 	w, ww: halfword;
+ 	smoothbot, smoothtop: 0..movesize;
+ 	xx, yy, xp, yp, delx, dely, tx, ty: scaled;
+ {:511} {519:}
+     begin
+ 	k := mem[h].hh.lh + 1;
+ 	ww := mem[h].hh.rh;
+ 	w := mem[ww].hh.lh;
+ 	mm0 := floorunscaled((mem[p + 1].int + mem[w + 1].int) - xycorr[octant]);
+ 	mm1 := floorunscaled((mem[q + 1].int + mem[ww + 1].int) - xycorr[octant]);
+ 	for n := 1 to (n1 - n0) + 1 do 
+ 	    envmove[n] := mm1;
+ 	envmove[0] := mm0;
+ 	moveptr := 0;
+ 	m := mm0 {:519};
+ 	r := p;
+ 	while true do begin
+ 	    if r = q then 
+ 		smoothtop := moveptr;
+ 	    while mem[r].hh.b1 <> k do begin {521:}
+ 		xx := mem[r + 1].int + mem[w + 1].int;
+ 		yy := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ {if internal[10]>65536 then begin printnl(452);printint(k);print(453);
+ unskew(xx,yy-32768,octant);printtwo(curx,cury);end;}
+                 {------------}
+                  my_xx := xx;
+                  my_yy := yy;
+                 {------------}
+ 		if mem[r].hh.b1 < k then begin
+ 		    k := k - 1;
+ 		    w := mem[w].hh.lh;
+ 		    xp := mem[r + 1].int + mem[w + 1].int;
+ 		    yp := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ 		    if yp <> yy then begin {522:}
+ 			ty := floorscaled(yy - ycorr[octant]);
+ 			dely := yp - yy;
+ 			yy := yy - ty;
+ 			ty := (yp - ycorr[octant]) - ty;
+ 			if ty >= 65536 then begin
+ 			    delx := xp - xx;
+ 			    yy := 65536 - yy;
+ 			    while true do begin
+ 				if m < envmove[moveptr] then 
+ 				    envmove[moveptr] := m;
+ 				tx := takefraction(delx, makefraction(yy, dely));
+ 				if (abvscd(tx, dely, delx, yy) + xycorr[octant]) > 0 then 
+ 				    tx := tx - 1;
+ 				m := floorunscaled(xx + tx);
+ 				ty := ty - 65536;
+ 				moveptr := moveptr + 1;
+ 				if ty < 65536 then 
+ 				    goto 31;
+ 				yy := yy + 65536
+ 			    end;
+     31:
+ 			    if m < envmove[moveptr] then 
+ 				envmove[moveptr] := m
+ 			end
+ 		    end {:522}
+ 		end else begin
+ 		    k := k + 1;
+ 		    w := mem[w].hh.rh;
+ 		    xp := mem[r + 1].int + mem[w + 1].int;
+ 		    yp := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ 		end;
+ {if internal[10]>65536 then begin print(450);unskew(xp,yp-32768,octant);
+ printtwo(curx,cury);printnl(155);end;}
+ 		{---------------------------------------------------}
+ 		 sendline(my_xx,my_yy-32768,xp,yp-32768,octant,521);
+ 		{---------------------------------------------------}
+ 		m := floorunscaled(xp - xycorr[octant]);
+ 		moveptr := floorunscaled(yp - ycorr[octant]) - n0;
+ 		if m < envmove[moveptr] then 
+ 		    envmove[moveptr] := m
+ 	    end {:521};
+ 	    if r = p then 
+ 		smoothbot := moveptr;
+ 	    if r = q then 
+ 		goto 30;
+ 	    move[moveptr] := 1;
+ 	    n := moveptr;
+ 	    s := mem[r].hh.rh;
+ 	    makemoves(mem[r + 1].int + mem[w + 1].int, mem[r + 5].int + mem[w + 1].int, mem[s + 3].int + mem[w + 1].int, mem[s + 1].int + mem[w + 1].int, (mem[r + 2].int + mem[w + 2].int) + 32768, (mem[r + 6].int + mem[w + 2].int) + 32768, (mem[s + 4].int + mem[w + 2].int) + 32768, (mem[s + 2].int + mem[w + 2].int) + 32768, xycorr[octant], ycorr[octant],518,octant); {520:}
+ 	    repeat
+ 		if m < envmove[n] then 
+ 		    envmove[n] := m;
+ 		m := (m + move[n]) - 1;
+ 		n := n + 1
+ 	    until n > moveptr {:520};
+ 	    r := s
+ 	end;
+     30: {523:}
+ {if(m<>mm1)or(moveptr<>n1-n0)then confusion(50);}
+ 	move[0] := (d0 + envmove[1]) - mm0;
+ 	for n := 1 to moveptr do 
+ 	    move[n] := (envmove[n + 1] - envmove[n]) + 1;
+ 	move[moveptr] := move[moveptr] - d1;
+ 	if internal[35] > 0 then 
+ 	    smoothmoves(smoothbot, smoothtop);
+ 	movetoedges(m0, n0, m1, n1);
+ 	if mem[q + 6].int = 1 then begin
+ 	    w := mem[h].hh.rh;
+ 	    skewlineedges(q, w, mem[w].hh.lh)
+ 	end {:523}
+     end; {:518}
+ 
+     procedure fillenvelope(spechead: halfword);
+     label
+ 	30, 31;
+     var
+ 	p, q, r, s: halfword;
+ 	h: halfword;
+ 	www: halfword; {511:}
+ 	m, n: integer;
+ 	mm0, mm1: integer;
+ 	k: integer;
+ 	w, ww: halfword;
+ 	smoothbot, smoothtop: 0..movesize;
+ 	xx, yy, xp, yp, delx, dely, tx, ty: scaled; {:511}
+     begin
+ 	if internal[10] > 0 then 
+ 	    beginedgetracing;
+ 	{------------------------------------}
+ 	print_start(psfile); { Start cycle }
+ 	{------------------------------------}
+ 	p := spechead;
+ 	repeat
+ 	    octant := mem[p + 3].int;
+ 	    h := curpen + octant; {466:}
+ 	    q := p;
+ 	    while mem[q].hh.b1 <> 0 do 
+ 		q := mem[q].hh.rh {:466}; {508:}
+ 	    w := mem[h].hh.rh;
+ 	    if mem[p + 4].int = 1 then 
+ 		w := mem[w].hh.lh;
+ {if internal[10]>65536 then[509:]begin printnl(447);
+ print(octantdir[octant]);print(425);printint(mem[h].hh.lh);print(448);
+ if mem[h].hh.lh<>1 then printchar(115);print(449);
+ unskew(mem[p+1].int+mem[w+1].int,mem[p+2].int+mem[w+2].int,octant);
+ printtwo(curx,cury);ww:=mem[h].hh.rh;
+ if mem[q+6].int=1 then ww:=mem[ww].hh.lh;print(450);
+ unskew(mem[q+1].int+mem[ww+1].int,mem[q+2].int+mem[ww+2].int,octant);
+ printtwo(curx,cury);end[:509];}
+ 	    ww := mem[h].hh.rh;
+ 	    www := ww;
+ 	    if odd(octantnumber[octant]) then 
+ 		www := mem[www].hh.lh
+ 	    else 
+ 		ww := mem[ww].hh.lh;
+ 	    if w <> ww then 
+ 		skewlineedges(p, w, ww);
+ 	    endround(mem[p + 1].int + mem[ww + 1].int, mem[p + 2].int + mem[ww + 2].int);
+ 	    m0 := m1;
+ 	    n0 := n1;
+ 	    d0 := d1;
+ 	    endround(mem[q + 1].int + mem[www + 1].int, mem[q + 2].int + mem[www + 2].int);
+ 	    if (n1 - n0) >= movesize then 
+ 		overflow(407, movesize) {:508};
+ 	    offsetprep(p, h);
+ {466:}
+ 	    q := p;
+ 	    while mem[q].hh.b1 <> 0 do 
+ 		q := mem[q].hh.rh {:466}; {512:}
+ 	    if odd(octantnumber[octant]) then begin {513:}
+ 		k := 0;
+ 		w := mem[h].hh.rh;
+ 		ww := mem[w].hh.lh;
+ 		mm0 := floorunscaled((mem[p + 1].int + mem[w + 1].int) - xycorr[octant]);
+ 		mm1 := floorunscaled((mem[q + 1].int + mem[ww + 1].int) - xycorr[octant]);
+ 		for n := 0 to n1 - n0 do 
+ 		    envmove[n] := mm0;
+ 		envmove[n1 - n0] := mm1;
+ 		moveptr := 0;
+ 		m := mm0 {:513};
+ 		r := p;
+ 		mem[q].hh.b1 := mem[h].hh.lh + 1;
+ 		while true do begin
+ 		    if r = q then 
+ 			smoothtop := moveptr;
+ 		    while mem[r].hh.b1 <> k do begin {515:}
+ 			xx := mem[r + 1].int + mem[w + 1].int;
+ 			yy := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ {if internal[10]>65536 then begin printnl(452);printint(k);print(453);
+ unskew(xx,yy-32768,octant);printtwo(curx,cury);end;}
+                         {------------}
+                          my_xx := xx;
+                          my_yy := yy;
+                         {------------}
+ 			if mem[r].hh.b1 > k then begin
+ 			    k := k + 1;
+ 			    w := mem[w].hh.rh;
+ 			    xp := mem[r + 1].int + mem[w + 1].int;
+ 			    yp := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ 			    if yp <> yy then begin {516:}
+ 				ty := floorscaled(yy - ycorr[octant]);
+ 				dely := yp - yy;
+ 				yy := yy - ty;
+ 				ty := (yp - ycorr[octant]) - ty;
+ 				if ty >= 65536 then begin
+ 				    delx := xp - xx;
+ 				    yy := 65536 - yy;
+ 				    while true do begin
+ 					tx := takefraction(delx, makefraction(yy, dely));
+ 					if (abvscd(tx, dely, delx, yy) + xycorr[octant]) > 0 then 
+ 					    tx := tx - 1;
+ 					m := floorunscaled(xx + tx);
+ 					if m > envmove[moveptr] then 
+ 					    envmove[moveptr] := m;
+ 					ty := ty - 65536;
+ 					if ty < 65536 then 
+ 					    goto 31;
+ 					yy := yy + 65536;
+ 					moveptr := moveptr + 1
+ 				    end;
+     31:
+ 				    
+ 				end
+ 			    end {:516}
+ 			end else begin
+ 			    k := k - 1;
+ 			    w := mem[w].hh.lh;
+ 			    xp := mem[r + 1].int + mem[w + 1].int;
+ 			    yp := (mem[r + 2].int + mem[w + 2].int) + 32768;
+ 			end;
+ {if internal[10]>65536 then begin print(450);unskew(xp,yp-32768,octant);
+ printtwo(curx,cury);printnl(155);end;}
+ 		{---------------------------------------------------}
+ 		 sendline(my_xx,my_yy-32768,xp,yp-32768,octant,515);
+ 		{---------------------------------------------------}
+ 			m := floorunscaled(xp - xycorr[octant]);
+ 			moveptr := floorunscaled(yp - ycorr[octant]) - n0;
+ 			if m > envmove[moveptr] then 
+ 			    envmove[moveptr] := m
+ 		    end {:515};
+ 		    if r = p then 
+ 			smoothbot := moveptr;
+ 		    if r = q then 
+ 			goto 30;
+ 		    move[moveptr] := 1;
+ 		    n := moveptr;
+ 		    s := mem[r].hh.rh;
+ 		    makemoves(mem[r + 1].int + mem[w + 1].int, mem[r + 5].int + mem[w + 1].int, mem[s + 3].int + mem[w + 1].int, mem[s + 1].int + mem[w + 1].int, (mem[r + 2].int + mem[w + 2].int) + 32768, (mem[r + 6].int + mem[w + 2].int) + 32768, (mem[s + 4].int + mem[w + 2].int) + 32768, (mem[s + 2].int + mem[w + 2].int) + 32768, xycorr[octant], ycorr[octant],512,octant); {514:}
+ 		    repeat
+ 			m := (m + move[n]) - 1;
+ 			if m > envmove[n] then 
+ 			    envmove[n] := m;
+ 			n := n + 1
+ 		    until n > moveptr {:514};
+ 		    r := s
+ 		end;
+     30: {517:}
+ {if(m<>mm1)or(moveptr<>n1-n0)then confusion(49);}
+ 		move[0] := (d0 + envmove[0]) - mm0;
+ 		for n := 1 to moveptr do 
+ 		    move[n] := (envmove[n] - envmove[n - 1]) + 1;
+ 		move[moveptr] := move[moveptr] - d1;
+ 		if internal[35] > 0 then 
+ 		    smoothmoves(smoothbot, smoothtop);
+ 		movetoedges(m0, n0, m1, n1);
+ 		if mem[q + 6].int = 0 then begin
+ 		    w := mem[h].hh.rh;
+ 		    skewlineedges(q, mem[w].hh.lh, w)
+ 		end {:517}
+ 	    end else 
+ 		dualmoves(h, p, q);
+ 	    mem[q].hh.b1 := 0 {:512};
+ 	    p := mem[q].hh.rh
+ 	until p = spechead;
+ 	{------------------------------------}
+ 	print_end(psfile); { End cycle }
+ 	{------------------------------------}
+ 	if internal[10] > 0 then 
+ 	    endedgetracing;
+ 	tossknotlist(spechead)
+     end; {:506}
+ {527:}
+ 
+     function makeellipse(majoraxis, minoraxis: scaled; theta: angle): halfword;
+     label
+ 	30, 31, 40;
+     var
+ 	p, q, r, s: halfword;
+ 	h: halfword;
+ 	alpha, beta, gamma, delta: integer;
+ 	c, d: integer;
+ 	u, v: integer;
+ 	symmetric: boolean; {528:}
+     begin {530:}
+ 	if (majoraxis = minoraxis) or ((theta mod 94371840) = 0) then begin
+ 	    symmetric := true;
+ 	    alpha := 0;
+ 	    if odd(theta div 94371840) then begin
+ 		beta := majoraxis;
+ 		gamma := minoraxis;
+ 		nsin := 268435456;
+ 		ncos := 0
+ 	    end else begin
+ 		beta := minoraxis;
+ 		gamma := majoraxis
+ 	    end
+ 	end else begin
+ 	    symmetric := false;
+ 	    nsincos(theta);
+ 	    gamma := takefraction(majoraxis, nsin);
+ 	    delta := takefraction(minoraxis, ncos);
+ 	    beta := pythadd(gamma, delta);
+ 	    alpha := takefraction(takefraction(majoraxis, makefraction(gamma, beta)), ncos) - takefraction(takefraction(minoraxis, makefraction(delta, beta)), nsin);
+ 	    alpha := (alpha + 32768) div 65536;
+ 	    gamma := pythadd(takefraction(majoraxis, ncos), takefraction(minoraxis, nsin))
+ 	end;
+ 	beta := (beta + 32768) div 65536;
+ 	gamma := (gamma + 32768) div 65536 {:530};
+ 	p := getnode(7);
+ 	q := getnode(7);
+ 	r := getnode(7);
+ 	if symmetric then 
+ 	    s := -30000
+ 	else 
+ 	    s := getnode(7);
+ 	h := p;
+ 	mem[p].hh.rh := q;
+ 	mem[q].hh.rh := r;
+ 	mem[r].hh.rh := s; {529:}
+ 	if beta = 0 then 
+ 	    beta := 1;
+ 	if gamma = 0 then 
+ 	    gamma := 1;
+ 	if gamma <= abs(alpha) then 
+ 	    if alpha > 0 then 
+ 		alpha := gamma - 1
+ 	    else 
+ 		alpha := 1 - gamma {:529};
+ 	mem[p + 1].int := -(alpha * 32768);
+ 	mem[p + 2].int := -(beta * 32768);
+ 	mem[q + 1].int := gamma * 32768;
+ 	mem[q + 2].int := mem[p + 2].int;
+ 	mem[r + 1].int := mem[q + 1].int;
+ 	mem[p + 5].int := 0;
+ 	mem[q + 3].int := -32768;
+ 	mem[q + 5].int := 32768;
+ 	mem[r + 3].int := 0;
+ 	mem[r + 5].int := 0;
+ 	mem[p + 6].int := beta;
+ 	mem[q + 6].int := gamma;
+ 	mem[r + 6].int := beta;
+ 	mem[q + 4].int := gamma + alpha;
+ 	if symmetric then begin
+ 	    mem[r + 2].int := 0;
+ 	    mem[r + 4].int := beta
+ 	end else begin
+ 	    mem[r + 2].int := -mem[p + 2].int;
+ 	    mem[r + 4].int := beta + beta;
+ 	    mem[s + 1].int := -mem[p + 1].int;
+ 	    mem[s + 2].int := mem[r + 2].int;
+ 	    mem[s + 3].int := 32768;
+ 	    mem[s + 4].int := gamma - alpha
+ 	end {:528}; {531:}
+ 	while true do begin
+ 	    u := mem[p + 5].int + mem[q + 5].int;
+ 	    v := mem[q + 3].int + mem[r + 3].int;
+ 	    c := mem[p + 6].int + mem[q + 6].int; {533:}
+ 	    delta := pythadd(u, v);
+ 	    if majoraxis = minoraxis then 
+ 		d := majoraxis
+ 	    else begin
+ 		if theta = 0 then begin
+ 		    alpha := u;
+ 		    beta := v
+ 		end else begin
+ 		    alpha := takefraction(u, ncos) + takefraction(v, nsin);
+ 		    beta := takefraction(v, ncos) - takefraction(u, nsin)
+ 		end;
+ 		alpha := makefraction(alpha, delta);
+ 		beta := makefraction(beta, delta);
+ 		d := pythadd(takefraction(majoraxis, alpha), takefraction(minoraxis, beta))
+ 	    end;
+ 	    d := takefraction(d, delta);
+ 	    alpha := abs(u);
+ 	    beta := abs(v);
+ 	    if alpha < beta then begin
+ 		delta := alpha;
+ 		alpha := beta;
+ 		beta := delta
+ 	    end;
+ 	    if internal[38] <> 0 then 
+ 		d := d - takefraction(internal[38], beta + beta);
+ 	    d := (d + 4) div 8;
+ 	    alpha := alpha div 32768;
+ 	    if d < alpha then 
+ 		d := alpha {:533};
+ 	    delta := c - d;
+ 	    if delta > 0 then begin
+ 		if delta > mem[r + 4].int then 
+ 		    delta := mem[r + 4].int;
+ 		if delta >= mem[q + 4].int then begin {534:}
+ 		    delta := mem[q + 4].int;
+ 		    mem[p + 6].int := c - delta;
+ 		    mem[p + 5].int := u;
+ 		    mem[q + 3].int := v;
+ 		    mem[q + 1].int := mem[q + 1].int - (delta * mem[r + 3].int);
+ 		    mem[q + 2].int := mem[q + 2].int + (delta * mem[q + 5].int);
+ 		    mem[r + 4].int := mem[r + 4].int - delta
+ 		end else begin {:534} {535:}
+ 		    s := getnode(7);
+ 		    mem[p].hh.rh := s;
+ 		    mem[s].hh.rh := q;
+ 		    mem[s + 1].int := mem[q + 1].int + (delta * mem[q + 3].int);
+ 		    mem[s + 2].int := mem[q + 2].int - (delta * mem[p + 5].int);
+ 		    mem[q + 1].int := mem[q + 1].int - (delta * mem[r + 3].int);
+ 		    mem[q + 2].int := mem[q + 2].int + (delta * mem[q + 5].int);
+ 		    mem[s + 3].int := mem[q + 3].int;
+ 		    mem[s + 5].int := u;
+ 		    mem[q + 3].int := v;
+ 		    mem[s + 6].int := c - delta;
+ 		    mem[s + 4].int := mem[q + 4].int - delta;
+ 		    mem[q + 4].int := delta;
+ 		    mem[r + 4].int := mem[r + 4].int - delta
+ 		end {:535}
+ 	    end else 
+ 		p := q; {532:}
+ 	    while true do begin
+ 		q := mem[p].hh.rh;
+ 		if q = (-30000) then 
+ 		    goto 30;
+ 		if mem[q + 4].int = 0 then begin
+ 		    mem[p].hh.rh := mem[q].hh.rh;
+ 		    mem[p + 6].int := mem[q + 6].int;
+ 		    mem[p + 5].int := mem[q + 5].int;
+ 		    freenode(q, 7)
+ 		end else begin
+ 		    r := mem[q].hh.rh;
+ 		    if r = (-30000) then 
+ 			goto 30;
+ 		    if mem[r + 4].int = 0 then begin
+ 			mem[p].hh.rh := r;
+ 			freenode(q, 7);
+ 			p := r
+ 		    end else 
+ 			goto 40
+ 		end
+ 	    end;
+     40: {:532}
+ 	    
+ 	end;
+     30: {:531}
+ 	;
+ 	if symmetric then begin {536:}
+ 	    s := -30000;
+ 	    q := h;
+ 	    while true do begin
+ 		r := getnode(7);
+ 		mem[r].hh.rh := s;
+ 		s := r;
+ 		mem[s + 1].int := mem[q + 1].int;
+ 		mem[s + 2].int := -mem[q + 2].int;
+ 		if q = p then 
+ 		    goto 31;
+ 		q := mem[q].hh.rh;
+ 		if mem[q + 2].int = 0 then 
+ 		    goto 31
+ 	    end;
+     31:
+ 	    mem[p].hh.rh := s;
+ 	    beta := -mem[h + 2].int;
+ 	    while mem[p + 2].int <> beta do 
+ 		p := mem[p].hh.rh;
+ 	    q := mem[p].hh.rh
+ 	end {:536};
+ {537:}
+ 	if q <> (-30000) then begin
+ 	    if mem[h + 5].int = 0 then begin
+ 		p := h;
+ 		h := mem[h].hh.rh;
+ 		freenode(p, 7);
+ 		mem[q + 1].int := -mem[h + 1].int
+ 	    end;
+ 	    p := q
+ 	end else 
+ 	    q := p;
+ 	r := mem[h].hh.rh;
+ 	repeat
+ 	    s := getnode(7);
+ 	    mem[p].hh.rh := s;
+ 	    p := s;
+ 	    mem[p + 1].int := -mem[r + 1].int;
+ 	    mem[p + 2].int := -mem[r + 2].int;
+ 	    r := mem[r].hh.rh
+ 	until r = q;
+ 	mem[p].hh.rh := h {:537};
+ 	makeellipse := h
+     end; {:527} {539:}
+ 
+     function finddirectiontime(x, y: scaled; h: halfword): scaled;
+     label
+ 	10, 40, 45, 30;
+     var
+ 	max: scaled;
+ 	p, q: halfword;
+ 	n: scaled;
+ 	tt: scaled; {542:}
+ 	x1, x2, x3, y1, y2, y3: scaled;
+ 	theta, phi: angle;
+ 	t: fraction; {:542} {540:}
+     begin
+ 	if abs(x) < abs(y) then begin
+ 	    x := makefraction(x, abs(y));
+ 	    if y > 0 then 
+ 		y := 268435456
+ 	    else 
+ 		y := -268435456
+ 	end else if x = 0 then begin
+ 	    finddirectiontime := 0;
+ 	    goto 10
+ 	end else begin
+ 	    y := makefraction(y, abs(x));
+ 	    if x > 0 then 
+ 		x := 268435456
+ 	    else 
+ 		x := -268435456
+ 	end {:540};
+ 	n := 0;
+ 	p := h;
+ 	while true do begin
+ 	    if mem[p].hh.b1 = 0 then 
+ 		goto 45;
+ 	    q := mem[p].hh.rh;
+ {541:}
+ 	    tt := 0; {543:}
+ 	    x1 := mem[p + 5].int - mem[p + 1].int;
+ 	    x2 := mem[q + 3].int - mem[p + 5].int;
+ 	    x3 := mem[q + 1].int - mem[q + 3].int;
+ 	    y1 := mem[p + 6].int - mem[p + 2].int;
+ 	    y2 := mem[q + 4].int - mem[p + 6].int;
+ 	    y3 := mem[q + 2].int - mem[q + 4].int;
+ 	    max := abs(x1);
+ 	    if abs(x2) > max then 
+ 		max := abs(x2);
+ 	    if abs(x3) > max then 
+ 		max := abs(x3);
+ 	    if abs(y1) > max then 
+ 		max := abs(y1);
+ 	    if abs(y2) > max then 
+ 		max := abs(y2);
+ 	    if abs(y3) > max then 
+ 		max := abs(y3);
+ 	    if max = 0 then 
+ 		goto 40;
+ 	    while max < 134217728 do begin
+ 		max := max + max;
+ 		x1 := x1 + x1;
+ 		x2 := x2 + x2;
+ 		x3 := x3 + x3;
+ 		y1 := y1 + y1;
+ 		y2 := y2 + y2;
+ 		y3 := y3 + y3
+ 	    end;
+ 	    t := x1;
+ 	    x1 := takefraction(x1, x) + takefraction(y1, y);
+ 	    y1 := takefraction(y1, x) - takefraction(t, y);
+ 	    t := x2;
+ 	    x2 := takefraction(x2, x) + takefraction(y2, y);
+ 	    y2 := takefraction(y2, x) - takefraction(t, y);
+ 	    t := x3;
+ 	    x3 := takefraction(x3, x) + takefraction(y3, y);
+ 	    y3 := takefraction(y3, x) - takefraction(t, y) {:543};
+ 	    if y1 = 0 then 
+ 		if x1 >= 0 then 
+ 		    goto 40;
+ 	    if n > 0 then begin {544:}
+ 		theta := narg(x1, y1);
+ 		if theta >= 0 then 
+ 		    if phi <= 0 then 
+ 			if phi >= (theta - 188743680) then 
+ 			    goto 40;
+ 		{:
+ 		544}
+ 		if theta <= 0 then 
+ 		    if phi >= 0 then 
+ 			if phi <= (theta + 188743680) then 
+ 			    goto 40;
+ 		if p = h then 
+ 		    goto 45
+ 	    end;
+ 	    if (x3 <> 0) or (y3 <> 0) then 
+ 		phi := narg(x3, y3);
+ {546:}
+ 	    if x1 < 0 then 
+ 		if x2 < 0 then 
+ 		    if x3 < 0 then 
+ 			goto 30;
+ 	    if abvscd(y1, y3, y2, y2) = 0 then begin {548:}
+ 		if abvscd(y1, y2, 0, 0) < 0 then begin
+ 		    t := makefraction(y1, y1 - y2);
+ 		    x1 := x1 - takefraction(x1 - x2, t);
+ 		    x2 := x2 - takefraction(x2 - x3, t);
+ 		    if (x1 - takefraction(x1 - x2, t)) >= 0 then begin
+ 			tt := (t + 2048) div 4096;
+ 			goto 40
+ 		    end
+ 		end else if y3 = 0 then 
+ 		    if y1 = 0 then begin {549:}
+ 			t := crossingpoint(-x1, -x2, -x3);
+ 			if t <= 268435456 then begin
+ 			    tt := (t + 2048) div 4096;
+ 			    goto 40
+ 			end;
+ 			if abvscd(x1, x3, x2, x2) <= 0 then begin
+ 			    t := makefraction(x1, x1 - x2);
+ 			    begin
+ 				tt := (t + 2048) div 4096;
+ 				goto 40
+ 			    end
+ 			end
+ 		    end else if x3 >= 0 then begin {:549}
+ 			tt := 65536;
+ 			goto 40
+ 		    end;
+ 		goto 30
+ 	    end {:548};
+ 	    if y1 <= 0 then 
+ 		if y1 < 0 then begin
+ 		    y1 := -y1;
+ 		    y2 := -y2;
+ 		    y3 := -y3
+ 		end else if y2 > 0 then begin
+ 		    y2 := -y2;
+ 		    y3 := -y3
+ 		end; {547:}
+ 	    t := crossingpoint(y1, y2, y3);
+ 	    if t > 268435456 then 
+ 		goto 30;
+ 	    y2 := y2 - takefraction(y2 - y3, t);
+ 	    x1 := x1 - takefraction(x1 - x2, t);
+ 	    x2 := x2 - takefraction(x2 - x3, t);
+ 	    x1 := x1 - takefraction(x1 - x2, t);
+ 	    if x1 >= 0 then begin
+ 		tt := (t + 2048) div 4096;
+ 		goto 40
+ 	    end;
+ 	    if y2 > 0 then 
+ 		y2 := 0;
+ 	    tt := t;
+ 	    t := crossingpoint(0, -y2, -y3);
+ 	    if t > 268435456 then 
+ 		goto 30;
+ 	    x1 := x1 - takefraction(x1 - x2, t);
+ 	    x2 := x2 - takefraction(x2 - x3, t);
+ 	    if (x1 - takefraction(x1 - x2, t)) >= 0 then begin
+ 		t := tt - takefraction(tt - 268435456, t);
+ 		begin
+ 		    tt := (t + 2048) div 4096;
+ 		    goto 40
+ 		end
+ 	    end {:547};
+     30: {:546}
+ {:541}
+ 	    ;
+ 	    p := q;
+ 	    n := n + 65536
+ 	end;
+     45:
+ 	finddirectiontime := -65536;
+ 	goto 10;
+     40:
+ 	finddirectiontime := n + tt;
+     10:
+ 	
+     end; {:539} {556:}
+ 
+     procedure cubicintersection(p, pp: halfword);
+     label
+ 	22, 45, 10;
+     var
+ 	q, qq: halfword;
+     begin
+ 	timetogo := 5000;
+ 	maxt := 2; {558:}
+ 	q := mem[p].hh.rh;
+ 	qq := mem[pp].hh.rh;
+ 	bisectptr := 20;
+ 	bisectstack[bisectptr - 5] := mem[p + 5].int - mem[p + 1].int;
+ 	bisectstack[bisectptr - 4] := mem[q + 3].int - mem[p + 5].int;
+ 	bisectstack[bisectptr - 3] := mem[q + 1].int - mem[q + 3].int;
+ 	if bisectstack[bisectptr - 5] < 0 then 
+ 	    if bisectstack[bisectptr - 3] >= 0 then begin
+ 		if bisectstack[bisectptr - 4] < 0 then 
+ 		    bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]
+ 		else 
+ 		    bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5];
+ 		bisectstack[bisectptr - 1] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 		if bisectstack[bisectptr - 1] < 0 then 
+ 		    bisectstack[bisectptr - 1] := 0
+ 	    end else begin
+ 		bisectstack[bisectptr - 2] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 		if bisectstack[bisectptr - 2] > bisectstack[bisectptr - 5] then 
+ 		    bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5];
+ 		bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4];
+ 		if bisectstack[bisectptr - 1] < 0 then 
+ 		    bisectstack[bisectptr - 1] := 0
+ 	    end
+ 	else if bisectstack[bisectptr - 3] <= 0 then begin
+ 	    if bisectstack[bisectptr - 4] > 0 then 
+ 		bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]
+ 	    else 
+ 		bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5];
+ 	    bisectstack[bisectptr - 2] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 	    if bisectstack[bisectptr - 2] > 0 then 
+ 		bisectstack[bisectptr - 2] := 0
+ 	end else begin
+ 	    bisectstack[bisectptr - 1] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 	    if bisectstack[bisectptr - 1] < bisectstack[bisectptr - 5] then 
+ 		bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5];
+ 	    bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4];
+ 	    if bisectstack[bisectptr - 2] > 0 then 
+ 		bisectstack[bisectptr - 2] := 0
+ 	end;
+ 	bisectstack[bisectptr - 10] := mem[p + 6].int - mem[p + 2].int;
+ 	bisectstack[bisectptr - 9] := mem[q + 4].int - mem[p + 6].int;
+ 	bisectstack[bisectptr - 8] := mem[q + 2].int - mem[q + 4].int;
+ 	if bisectstack[bisectptr - 10] < 0 then 
+ 	    if bisectstack[bisectptr - 8] >= 0 then begin
+ 		if bisectstack[bisectptr - 9] < 0 then 
+ 		    bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]
+ 		else 
+ 		    bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10];
+ 		bisectstack[bisectptr - 6] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 		if bisectstack[bisectptr - 6] < 0 then 
+ 		    bisectstack[bisectptr - 6] := 0
+ 	    end else begin
+ 		bisectstack[bisectptr - 7] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 		if bisectstack[bisectptr - 7] > bisectstack[bisectptr - 10] then 
+ 		    bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10];
+ 		bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9];
+ 		if bisectstack[bisectptr - 6] < 0 then 
+ 		    bisectstack[bisectptr - 6] := 0
+ 	    end
+ 	else if bisectstack[bisectptr - 8] <= 0 then begin
+ 	    if bisectstack[bisectptr - 9] > 0 then 
+ 		bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]
+ 	    else 
+ 		bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10];
+ 	    bisectstack[bisectptr - 7] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 	    if bisectstack[bisectptr - 7] > 0 then 
+ 		bisectstack[bisectptr - 7] := 0
+ 	end else begin
+ 	    bisectstack[bisectptr - 6] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 	    if bisectstack[bisectptr - 6] < bisectstack[bisectptr - 10] then 
+ 		bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10];
+ 	    bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9];
+ 	    if bisectstack[bisectptr - 7] > 0 then 
+ 		bisectstack[bisectptr - 7] := 0
+ 	end;
+ 	bisectstack[bisectptr - 15] := mem[pp + 5].int - mem[pp + 1].int;
+ 	bisectstack[bisectptr - 14] := mem[qq + 3].int - mem[pp + 5].int;
+ 	bisectstack[bisectptr - 13] := mem[qq + 1].int - mem[qq + 3].int;
+ 	if bisectstack[bisectptr - 15] < 0 then 
+ 	    if bisectstack[bisectptr - 13] >= 0 then begin
+ 		if bisectstack[bisectptr - 14] < 0 then 
+ 		    bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]
+ 		else 
+ 		    bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15];
+ 		bisectstack[bisectptr - 11] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 		if bisectstack[bisectptr - 11] < 0 then 
+ 		    bisectstack[bisectptr - 11] := 0
+ 	    end else begin
+ 		bisectstack[bisectptr - 12] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 		if bisectstack[bisectptr - 12] > bisectstack[bisectptr - 15] then 
+ 		    bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15];
+ 		bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14];
+ 		if bisectstack[bisectptr - 11] < 0 then 
+ 		    bisectstack[bisectptr - 11] := 0
+ 	    end
+ 	else if bisectstack[bisectptr - 13] <= 0 then begin
+ 	    if bisectstack[bisectptr - 14] > 0 then 
+ 		bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]
+ 	    else 
+ 		bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15];
+ 	    bisectstack[bisectptr - 12] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 	    if bisectstack[bisectptr - 12] > 0 then 
+ 		bisectstack[bisectptr - 12] := 0
+ 	end else begin
+ 	    bisectstack[bisectptr - 11] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 	    if bisectstack[bisectptr - 11] < bisectstack[bisectptr - 15] then 
+ 		bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15];
+ 	    bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14];
+ 	    if bisectstack[bisectptr - 12] > 0 then 
+ 		bisectstack[bisectptr - 12] := 0
+ 	end;
+ 	bisectstack[bisectptr - 20] := mem[pp + 6].int - mem[pp + 2].int;
+ 	bisectstack[bisectptr - 19] := mem[qq + 4].int - mem[pp + 6].int;
+ 	bisectstack[bisectptr - 18] := mem[qq + 2].int - mem[qq + 4].int;
+ 	if bisectstack[bisectptr - 20] < 0 then 
+ 	    if bisectstack[bisectptr - 18] >= 0 then begin
+ 		if bisectstack[bisectptr - 19] < 0 then 
+ 		    bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]
+ 		else 
+ 		    bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20];
+ 		bisectstack[bisectptr - 16] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 		if bisectstack[bisectptr - 16] < 0 then 
+ 		    bisectstack[bisectptr - 16] := 0
+ 	    end else begin
+ 		bisectstack[bisectptr - 17] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 		if bisectstack[bisectptr - 17] > bisectstack[bisectptr - 20] then 
+ 		    bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20];
+ 		bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19];
+ 		if bisectstack[bisectptr - 16] < 0 then 
+ 		    bisectstack[bisectptr - 16] := 0
+ 	    end
+ 	else if bisectstack[bisectptr - 18] <= 0 then begin
+ 	    if bisectstack[bisectptr - 19] > 0 then 
+ 		bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]
+ 	    else 
+ 		bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20];
+ 	    bisectstack[bisectptr - 17] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 	    if bisectstack[bisectptr - 17] > 0 then 
+ 		bisectstack[bisectptr - 17] := 0
+ 	end else begin
+ 	    bisectstack[bisectptr - 16] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 	    if bisectstack[bisectptr - 16] < bisectstack[bisectptr - 20] then 
+ 		bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20];
+ 	    bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19];
+ 	    if bisectstack[bisectptr - 17] > 0 then 
+ 		bisectstack[bisectptr - 17] := 0
+ 	end;
+ 	delx := mem[p + 1].int - mem[pp + 1].int;
+ 	dely := mem[p + 2].int - mem[pp + 2].int;
+ 	tol := 0;
+ 	uv := bisectptr;
+ 	xy := bisectptr;
+ 	threel := 0;
+ 	curt := 1;
+ 	curtt := 1 {:558};
+ 	while true do begin
+     22:
+ 	    if (delx - tol) <= (bisectstack[xy - 11] - bisectstack[uv - 2]) then 
+ 		if (delx + tol) >= (bisectstack[xy - 12] - bisectstack[uv - 1]) then 
+ 		    if (dely - tol) <= (bisectstack[xy - 16] - bisectstack[uv - 7]) then 
+ 			if (dely + tol) >= (bisectstack[xy - 17] - bisectstack[uv - 6]) then begin
+ 			    if curt >= maxt then begin
+ 				if maxt = 131072 then begin
+ 				    curt := (curt + 1) div 2;
+ 				    curtt := (curtt + 1) div 2;
+ 				    goto 10
+ 				end;
+ 				maxt := maxt + maxt;
+ 				apprt := curt;
+ 				apprtt := curtt
+ 			    end; {559:}
+ 			    bisectstack[bisectptr] := delx;
+ 			    bisectstack[bisectptr + 1] := dely;
+ 			    bisectstack[bisectptr + 2] := tol;
+ 			    bisectstack[bisectptr + 3] := uv;
+ 			    bisectstack[bisectptr + 4] := xy;
+ 			    bisectptr := bisectptr + 45;
+ 			    curt := curt + curt;
+ 			    curtt := curtt + curtt;
+ 			    bisectstack[bisectptr - 25] := bisectstack[uv - 5];
+ 			    bisectstack[bisectptr - 3] := bisectstack[uv - 3];
+ 			    bisectstack[bisectptr - 24] := (bisectstack[bisectptr - 25] + bisectstack[uv - 4]) div 2;
+ 			    bisectstack[bisectptr - 4] := (bisectstack[bisectptr - 3] + bisectstack[uv - 4]) div 2;
+ 			    bisectstack[bisectptr - 23] := (bisectstack[bisectptr - 24] + bisectstack[bisectptr - 4]) div 2;
+ 			    bisectstack[bisectptr - 5] := bisectstack[bisectptr - 23];
+ 			    if bisectstack[bisectptr - 25] < 0 then 
+ 				if bisectstack[bisectptr - 23] >= 0 then begin
+ 				    if bisectstack[bisectptr - 24] < 0 then 
+ 					bisectstack[bisectptr - 22] := bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]
+ 				    else 
+ 					bisectstack[bisectptr - 22] := bisectstack[bisectptr - 25];
+ 				    bisectstack[bisectptr - 21] := (bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]) + bisectstack[bisectptr - 23];
+ 				    if bisectstack[bisectptr - 21] < 0 then 
+ 					bisectstack[bisectptr - 21] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 22] := (bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]) + bisectstack[bisectptr - 23];
+ 				    if bisectstack[bisectptr - 22] > bisectstack[bisectptr - 25] then 
+ 					bisectstack[bisectptr - 22] := bisectstack[bisectptr - 25];
+ 				    bisectstack[bisectptr - 21] := bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24];
+ 				    if bisectstack[bisectptr - 21] < 0 then 
+ 					bisectstack[bisectptr - 21] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 23] <= 0 then begin
+ 				if bisectstack[bisectptr - 24] > 0 then 
+ 				    bisectstack[bisectptr - 21] := bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]
+ 				else 
+ 				    bisectstack[bisectptr - 21] := bisectstack[bisectptr - 25];
+ 				bisectstack[bisectptr - 22] := (bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]) + bisectstack[bisectptr - 23];
+ 				if bisectstack[bisectptr - 22] > 0 then 
+ 				    bisectstack[bisectptr - 22] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 21] := (bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]) + bisectstack[bisectptr - 23];
+ 				if bisectstack[bisectptr - 21] < bisectstack[bisectptr - 25] then 
+ 				    bisectstack[bisectptr - 21] := bisectstack[bisectptr - 25];
+ 				bisectstack[bisectptr - 22] := bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24];
+ 				if bisectstack[bisectptr - 22] > 0 then 
+ 				    bisectstack[bisectptr - 22] := 0
+ 			    end;
+ 			    if bisectstack[bisectptr - 5] < 0 then 
+ 				if bisectstack[bisectptr - 3] >= 0 then begin
+ 				    if bisectstack[bisectptr - 4] < 0 then 
+ 					bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]
+ 				    else 
+ 					bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5];
+ 				    bisectstack[bisectptr - 1] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 				    if bisectstack[bisectptr - 1] < 0 then 
+ 					bisectstack[bisectptr - 1] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 2] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 				    if bisectstack[bisectptr - 2] > bisectstack[bisectptr - 5] then 
+ 					bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5];
+ 				    bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4];
+ 				    if bisectstack[bisectptr - 1] < 0 then 
+ 					bisectstack[bisectptr - 1] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 3] <= 0 then begin
+ 				if bisectstack[bisectptr - 4] > 0 then 
+ 				    bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]
+ 				else 
+ 				    bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5];
+ 				bisectstack[bisectptr - 2] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 				if bisectstack[bisectptr - 2] > 0 then 
+ 				    bisectstack[bisectptr - 2] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 1] := (bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]) + bisectstack[bisectptr - 3];
+ 				if bisectstack[bisectptr - 1] < bisectstack[bisectptr - 5] then 
+ 				    bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5];
+ 				bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4];
+ 				if bisectstack[bisectptr - 2] > 0 then 
+ 				    bisectstack[bisectptr - 2] := 0
+ 			    end;
+ 			    bisectstack[bisectptr - 30] := bisectstack[uv - 10];
+ 			    bisectstack[bisectptr - 8] := bisectstack[uv - 8];
+ 			    bisectstack[bisectptr - 29] := (bisectstack[bisectptr - 30] + bisectstack[uv - 9]) div 2;
+ 			    bisectstack[bisectptr - 9] := (bisectstack[bisectptr - 8] + bisectstack[uv - 9]) div 2;
+ 			    bisectstack[bisectptr - 28] := (bisectstack[bisectptr - 29] + bisectstack[bisectptr - 9]) div 2;
+ 			    bisectstack[bisectptr - 10] := bisectstack[bisectptr - 28];
+ 			    if bisectstack[bisectptr - 30] < 0 then 
+ 				if bisectstack[bisectptr - 28] >= 0 then begin
+ 				    if bisectstack[bisectptr - 29] < 0 then 
+ 					bisectstack[bisectptr - 27] := bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]
+ 				    else 
+ 					bisectstack[bisectptr - 27] := bisectstack[bisectptr - 30];
+ 				    bisectstack[bisectptr - 26] := (bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]) + bisectstack[bisectptr - 28];
+ 				    if bisectstack[bisectptr - 26] < 0 then 
+ 					bisectstack[bisectptr - 26] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 27] := (bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]) + bisectstack[bisectptr - 28];
+ 				    if bisectstack[bisectptr - 27] > bisectstack[bisectptr - 30] then 
+ 					bisectstack[bisectptr - 27] := bisectstack[bisectptr - 30];
+ 				    bisectstack[bisectptr - 26] := bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29];
+ 				    if bisectstack[bisectptr - 26] < 0 then 
+ 					bisectstack[bisectptr - 26] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 28] <= 0 then begin
+ 				if bisectstack[bisectptr - 29] > 0 then 
+ 				    bisectstack[bisectptr - 26] := bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]
+ 				else 
+ 				    bisectstack[bisectptr - 26] := bisectstack[bisectptr - 30];
+ 				bisectstack[bisectptr - 27] := (bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]) + bisectstack[bisectptr - 28];
+ 				if bisectstack[bisectptr - 27] > 0 then 
+ 				    bisectstack[bisectptr - 27] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 26] := (bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]) + bisectstack[bisectptr - 28];
+ 				if bisectstack[bisectptr - 26] < bisectstack[bisectptr - 30] then 
+ 				    bisectstack[bisectptr - 26] := bisectstack[bisectptr - 30];
+ 				bisectstack[bisectptr - 27] := bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29];
+ 				if bisectstack[bisectptr - 27] > 0 then 
+ 				    bisectstack[bisectptr - 27] := 0
+ 			    end;
+ 			    if bisectstack[bisectptr - 10] < 0 then 
+ 				if bisectstack[bisectptr - 8] >= 0 then begin
+ 				    if bisectstack[bisectptr - 9] < 0 then 
+ 					bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]
+ 				    else 
+ 					bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10];
+ 				    bisectstack[bisectptr - 6] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 				    if bisectstack[bisectptr - 6] < 0 then 
+ 					bisectstack[bisectptr - 6] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 7] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 				    if bisectstack[bisectptr - 7] > bisectstack[bisectptr - 10] then 
+ 					bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10];
+ 				    bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9];
+ 				    if bisectstack[bisectptr - 6] < 0 then 
+ 					bisectstack[bisectptr - 6] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 8] <= 0 then begin
+ 				if bisectstack[bisectptr - 9] > 0 then 
+ 				    bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]
+ 				else 
+ 				    bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10];
+ 				bisectstack[bisectptr - 7] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 				if bisectstack[bisectptr - 7] > 0 then 
+ 				    bisectstack[bisectptr - 7] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 6] := (bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]) + bisectstack[bisectptr - 8];
+ 				if bisectstack[bisectptr - 6] < bisectstack[bisectptr - 10] then 
+ 				    bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10];
+ 				bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9];
+ 				if bisectstack[bisectptr - 7] > 0 then 
+ 				    bisectstack[bisectptr - 7] := 0
+ 			    end;
+ 			    bisectstack[bisectptr - 35] := bisectstack[xy - 15];
+ 			    bisectstack[bisectptr - 13] := bisectstack[xy - 13];
+ 			    bisectstack[bisectptr - 34] := (bisectstack[bisectptr - 35] + bisectstack[xy - 14]) div 2;
+ 			    bisectstack[bisectptr - 14] := (bisectstack[bisectptr - 13] + bisectstack[xy - 14]) div 2;
+ 			    bisectstack[bisectptr - 33] := (bisectstack[bisectptr - 34] + bisectstack[bisectptr - 14]) div 2;
+ 			    bisectstack[bisectptr - 15] := bisectstack[bisectptr - 33];
+ 			    if bisectstack[bisectptr - 35] < 0 then 
+ 				if bisectstack[bisectptr - 33] >= 0 then begin
+ 				    if bisectstack[bisectptr - 34] < 0 then 
+ 					bisectstack[bisectptr - 32] := bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]
+ 				    else 
+ 					bisectstack[bisectptr - 32] := bisectstack[bisectptr - 35];
+ 				    bisectstack[bisectptr - 31] := (bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]) + bisectstack[bisectptr - 33];
+ 				    if bisectstack[bisectptr - 31] < 0 then 
+ 					bisectstack[bisectptr - 31] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 32] := (bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]) + bisectstack[bisectptr - 33];
+ 				    if bisectstack[bisectptr - 32] > bisectstack[bisectptr - 35] then 
+ 					bisectstack[bisectptr - 32] := bisectstack[bisectptr - 35];
+ 				    bisectstack[bisectptr - 31] := bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34];
+ 				    if bisectstack[bisectptr - 31] < 0 then 
+ 					bisectstack[bisectptr - 31] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 33] <= 0 then begin
+ 				if bisectstack[bisectptr - 34] > 0 then 
+ 				    bisectstack[bisectptr - 31] := bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]
+ 				else 
+ 				    bisectstack[bisectptr - 31] := bisectstack[bisectptr - 35];
+ 				bisectstack[bisectptr - 32] := (bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]) + bisectstack[bisectptr - 33];
+ 				if bisectstack[bisectptr - 32] > 0 then 
+ 				    bisectstack[bisectptr - 32] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 31] := (bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]) + bisectstack[bisectptr - 33];
+ 				if bisectstack[bisectptr - 31] < bisectstack[bisectptr - 35] then 
+ 				    bisectstack[bisectptr - 31] := bisectstack[bisectptr - 35];
+ 				bisectstack[bisectptr - 32] := bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34];
+ 				if bisectstack[bisectptr - 32] > 0 then 
+ 				    bisectstack[bisectptr - 32] := 0
+ 			    end;
+ 			    if bisectstack[bisectptr - 15] < 0 then 
+ 				if bisectstack[bisectptr - 13] >= 0 then begin
+ 				    if bisectstack[bisectptr - 14] < 0 then 
+ 					bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]
+ 				    else 
+ 					bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15];
+ 				    bisectstack[bisectptr - 11] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 				    if bisectstack[bisectptr - 11] < 0 then 
+ 					bisectstack[bisectptr - 11] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 12] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 				    if bisectstack[bisectptr - 12] > bisectstack[bisectptr - 15] then 
+ 					bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15];
+ 				    bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14];
+ 				    if bisectstack[bisectptr - 11] < 0 then 
+ 					bisectstack[bisectptr - 11] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 13] <= 0 then begin
+ 				if bisectstack[bisectptr - 14] > 0 then 
+ 				    bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]
+ 				else 
+ 				    bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15];
+ 				bisectstack[bisectptr - 12] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 				if bisectstack[bisectptr - 12] > 0 then 
+ 				    bisectstack[bisectptr - 12] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 11] := (bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]) + bisectstack[bisectptr - 13];
+ 				if bisectstack[bisectptr - 11] < bisectstack[bisectptr - 15] then 
+ 				    bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15];
+ 				bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14];
+ 				if bisectstack[bisectptr - 12] > 0 then 
+ 				    bisectstack[bisectptr - 12] := 0
+ 			    end;
+ 			    bisectstack[bisectptr - 40] := bisectstack[xy - 20];
+ 			    bisectstack[bisectptr - 18] := bisectstack[xy - 18];
+ 			    bisectstack[bisectptr - 39] := (bisectstack[bisectptr - 40] + bisectstack[xy - 19]) div 2;
+ 			    bisectstack[bisectptr - 19] := (bisectstack[bisectptr - 18] + bisectstack[xy - 19]) div 2;
+ 			    bisectstack[bisectptr - 38] := (bisectstack[bisectptr - 39] + bisectstack[bisectptr - 19]) div 2;
+ 			    bisectstack[bisectptr - 20] := bisectstack[bisectptr - 38];
+ 			    if bisectstack[bisectptr - 40] < 0 then 
+ 				if bisectstack[bisectptr - 38] >= 0 then begin
+ 				    if bisectstack[bisectptr - 39] < 0 then 
+ 					bisectstack[bisectptr - 37] := bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]
+ 				    else 
+ 					bisectstack[bisectptr - 37] := bisectstack[bisectptr - 40];
+ 				    bisectstack[bisectptr - 36] := (bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]) + bisectstack[bisectptr - 38];
+ 				    if bisectstack[bisectptr - 36] < 0 then 
+ 					bisectstack[bisectptr - 36] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 37] := (bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]) + bisectstack[bisectptr - 38];
+ 				    if bisectstack[bisectptr - 37] > bisectstack[bisectptr - 40] then 
+ 					bisectstack[bisectptr - 37] := bisectstack[bisectptr - 40];
+ 				    bisectstack[bisectptr - 36] := bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39];
+ 				    if bisectstack[bisectptr - 36] < 0 then 
+ 					bisectstack[bisectptr - 36] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 38] <= 0 then begin
+ 				if bisectstack[bisectptr - 39] > 0 then 
+ 				    bisectstack[bisectptr - 36] := bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]
+ 				else 
+ 				    bisectstack[bisectptr - 36] := bisectstack[bisectptr - 40];
+ 				bisectstack[bisectptr - 37] := (bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]) + bisectstack[bisectptr - 38];
+ 				if bisectstack[bisectptr - 37] > 0 then 
+ 				    bisectstack[bisectptr - 37] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 36] := (bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]) + bisectstack[bisectptr - 38];
+ 				if bisectstack[bisectptr - 36] < bisectstack[bisectptr - 40] then 
+ 				    bisectstack[bisectptr - 36] := bisectstack[bisectptr - 40];
+ 				bisectstack[bisectptr - 37] := bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39];
+ 				if bisectstack[bisectptr - 37] > 0 then 
+ 				    bisectstack[bisectptr - 37] := 0
+ 			    end;
+ 			    if bisectstack[bisectptr - 20] < 0 then 
+ 				if bisectstack[bisectptr - 18] >= 0 then begin
+ 				    if bisectstack[bisectptr - 19] < 0 then 
+ 					bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]
+ 				    else 
+ 					bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20];
+ 				    bisectstack[bisectptr - 16] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 				    if bisectstack[bisectptr - 16] < 0 then 
+ 					bisectstack[bisectptr - 16] := 0
+ 				end else begin
+ 				    bisectstack[bisectptr - 17] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 				    if bisectstack[bisectptr - 17] > bisectstack[bisectptr - 20] then 
+ 					bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20];
+ 				    bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19];
+ 				    if bisectstack[bisectptr - 16] < 0 then 
+ 					bisectstack[bisectptr - 16] := 0
+ 				end
+ 			    else if bisectstack[bisectptr - 18] <= 0 then begin
+ 				if bisectstack[bisectptr - 19] > 0 then 
+ 				    bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]
+ 				else 
+ 				    bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20];
+ 				bisectstack[bisectptr - 17] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 				if bisectstack[bisectptr - 17] > 0 then 
+ 				    bisectstack[bisectptr - 17] := 0
+ 			    end else begin
+ 				bisectstack[bisectptr - 16] := (bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]) + bisectstack[bisectptr - 18];
+ 				if bisectstack[bisectptr - 16] < bisectstack[bisectptr - 20] then 
+ 				    bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20];
+ 				bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19];
+ 				if bisectstack[bisectptr - 17] > 0 then 
+ 				    bisectstack[bisectptr - 17] := 0
+ 			    end;
+ 			    uv := bisectptr - 20;
+ 			    xy := bisectptr - 20;
+ 			    delx := delx + delx;
+ 			    dely := dely + dely;
+ 			    tol := (tol - threel) + tolstep;
+ 			    tol := tol + tol;
+ 			    threel := threel + tolstep {:559};
+ 			    goto 22
+ 			end;
+ 	    if timetogo > 0 then 
+ 		timetogo := timetogo - 1
+ 	    else begin
+ 		while apprt < 65536 do begin
+ 		    apprt := apprt + apprt;
+ 		    apprtt := apprtt + apprtt
+ 		end;
+ 		curt := apprt;
+ 		curtt := apprtt;
+ 		goto 10
+ 	    end; {560:}
+     45:
+ 	    if odd(curtt) then 
+ 		if odd(curt) then begin {561:}
+ 		    curt := curt div 2;
+ 		    curtt := curtt div 2;
+ 		    if curt = 0 then 
+ 			goto 10;
+ 		    bisectptr := bisectptr - 45;
+ 		    threel := threel - tolstep;
+ 		    delx := bisectstack[bisectptr];
+ 		    dely := bisectstack[bisectptr + 1];
+ 		    tol := bisectstack[bisectptr + 2];
+ 		    uv := bisectstack[bisectptr + 3];
+ 		    xy := bisectstack[bisectptr + 4];
+ 		    goto 45
+ 		end else begin {:561}
+ 		    curt := curt + 1;
+ 		    delx := ((delx + bisectstack[uv - 5]) + bisectstack[uv - 4]) + bisectstack[uv - 3];
+ 		    dely := ((dely + bisectstack[uv - 10]) + bisectstack[uv - 9]) + bisectstack[uv - 8];
+ 		    uv := uv + 20;
+ 		    curtt := curtt - 1;
+ 		    xy := xy - 20;
+ 		    delx := ((delx + bisectstack[xy - 15]) + bisectstack[xy - 14]) + bisectstack[xy - 13];
+ 		    dely := ((dely + bisectstack[xy - 20]) + bisectstack[xy - 19]) + bisectstack[xy - 18]
+ 		end
+ 	    else begin
+ 		curtt := curtt + 1;
+ 		tol := tol + threel;
+ 		delx := ((delx - bisectstack[xy - 15]) - bisectstack[xy - 14]) - bisectstack[xy - 13];
+ 		dely := ((dely - bisectstack[xy - 20]) - bisectstack[xy - 19]) - bisectstack[xy - 18];
+ 		xy := xy + 20
+ 	    end {:560}
+ 	end;
+     10:
+ 	
+     end; {:556} {562:}
+ 
+     procedure pathintersection(h, hh: halfword);
+     label
+ 	10;
+     var
+ 	p, pp: halfword;
+ 	n, nn: integer; {563:}
+     begin
+ 	if mem[h].hh.b1 = 0 then begin
+ 	    mem[h + 5].int := mem[h + 1].int;
+ 	    mem[h + 3].int := mem[h + 1].int;
+ 	    mem[h + 6].int := mem[h + 2].int;
+ 	    mem[h + 4].int := mem[h + 2].int;
+ 	    mem[h].hh.b1 := 1
+ 	end;
+ 	if mem[hh].hh.b1 = 0 then begin
+ 	    mem[hh + 5].int := mem[hh + 1].int;
+ 	    mem[hh + 3].int := mem[hh + 1].int;
+ 	    mem[hh + 6].int := mem[hh + 2].int;
+ 	    mem[hh + 4].int := mem[hh + 2].int;
+ 	    mem[hh].hh.b1 := 1
+ 	end; {:563}
+ 	tolstep := 0;
+ 	repeat
+ 	    n := -65536;
+ 	    p := h;
+ 	    repeat
+ 		if mem[p].hh.b1 <> 0 then begin
+ 		    nn := -65536;
+ 		    pp := hh;
+ 		    repeat
+ 			if mem[pp].hh.b1 <> 0 then begin
+ 			    cubicintersection(p, pp);
+ 			    if curt > 0 then begin
+ 				curt := curt + n;
+ 				curtt := curtt + nn;
+ 				goto 10
+ 			    end
+ 			end;
+ 			nn := nn + 65536;
+ 			pp := mem[pp].hh.rh
+ 		    until pp = hh
+ 		end;
+ 		n := n + 65536;
+ 		p := mem[p].hh.rh
+ 	    until p = h;
+ 	    tolstep := tolstep + 3
+ 	until tolstep > 3;
+ 	curt := -65536;
+ 	curtt := -65536;
+     10:
+ 	
+     end; {:562} {574:}
+ 
+     procedure openawindow(k: windownumber; r0, c0, r1, c1: scaled; x, y: scaled);
+     var
+ 	m, n: integer; {575:}
+     begin
+ 	if r0 < 0 then 
+ 	    r0 := 0
+ 	else 
+ 	    r0 := roundunscaled(r0);
+ 	r1 := roundunscaled(r1);
+ 	if r1 > screendepth then 
+ 	    r1 := screendepth;
+ 	if r1 < r0 then 
+ 	    if r0 > screendepth then 
+ 		r0 := r1
+ 	    else 
+ 		r1 := r0;
+ 	if c0 < 0 then 
+ 	    c0 := 0
+ 	else 
+ 	    c0 := roundunscaled(c0);
+ 	c1 := roundunscaled(c1);
+ 	if c1 > screenwidth then 
+ 	    c1 := screenwidth;
+ 	if c1 < c0 then 
+ 	    if c0 > screenwidth then 
+ 		c0 := c1
+ 	    else 
+ 		c1 := c0 {:575};
+ 	windowopen[k] := true;
+ 	windowtime[k] := windowtime[k] + 1;
+ 	leftcol[k] := c0;
+ 	rightcol[k] := c1;
+ 	toprow[k] := r0;
+ 	botrow[k] := r1; {576:}
+ 	m := roundunscaled(x);
+ 	n := roundunscaled(y) - 1;
+ 	mwindow[k] := c0 - m;
+ 	nwindow[k] := r0 + n {:576};
+ 	begin
+ 	    if not screenstarted then begin
+ 		screenOK := initscreen;
+ 		screenstarted := true
+ 	    end
+ 	end;
+ 	if screenOK then begin
+ 	    blankrectangle(c0, c1, r0, r1);
+ 	    updatescreen
+ 	end
+     end; { openawindow }
+ {:574}
+     {577:}
+ 
+     procedure dispedges(k: windownumber);
+     label
+ 	30, 40;
+     var
+ 	p, q: halfword;
+ 	alreadythere: boolean;
+ 	r: integer; {580:}
+ 	n: screencol;
+ 	w, ww: integer;
+ 	b: pixelcolor;
+ 	m, mm: integer;
+ 	d: integer;
+ 	madjustment: integer;
+ 	rightedge: integer;
+ 	mincol: screencol; {:580}
+     begin
+ 	if screenOK then 
+ 	    if leftcol[k] < rightcol[k] then 
+ 		if toprow[k] < botrow[k] then begin
+ 		    alreadythere := false;
+ 		    if mem[curedges + 3].hh.rh = k then 
+ 			if mem[curedges + 4].int = windowtime[k] then 
+ 			    alreadythere := true;
+ 		    if not alreadythere then 
+ 			blankrectangle(leftcol[k], rightcol[k], toprow[k], botrow[k]); {581:}
+ 		    madjustment := mwindow[k] - mem[curedges + 3].hh.lh;
+ 		    rightedge := 8 * (rightcol[k] - madjustment);
+ 		    mincol := leftcol[k] {:581};
+ 		    p := mem[curedges].hh.rh;
+ 		    r := nwindow[k] - (mem[curedges + 1].hh.lh - 4096);
+ 		    while (p <> curedges) and (r >= toprow[k]) do begin
+ 			if r < botrow[k] then begin {578:}
+ 			    if mem[p + 1].hh.lh > (-29999) then 
+ 				sortedges(p)
+ 			    else if mem[p + 1].hh.lh = (-29999) then 
+ 				if alreadythere then 
+ 				    goto 30;
+ 			    mem[p + 1].hh.lh := -29999; {582:}
+ 			    n := 0;
+ 			    ww := 0;
+ 			    m := -1;
+ 			    w := 0;
+ 			    q := mem[p + 1].hh.rh;
+ 			    rowtransition[0] := mincol;
+ 			    while true do begin
+ 				if q = 30000 then 
+ 				    d := rightedge
+ 				else 
+ 				    d := mem[q].hh.lh + 32768;
+ 				mm := (d div 8) + madjustment;
+ 				if mm <> m then begin {583:}
+ 				    if w <= 0 then begin
+ 					if ww > 0 then 
+ 					    if m > mincol then begin
+ 						if n = 0 then 
+ 						    if alreadythere then begin
+ 							b := 0;
+ 							n := n + 1
+ 						    end else 
+ 							b := 1
+ 						else 
+ 						    n := n + 1;
+ 						rowtransition[n] := m
+ 					    end
+ 				    end else if ww <= 0 then 
+ 					if m > mincol then begin
+ 					    if n = 0 then 
+ 						b := 1;
+ 					    n := n + 1;
+ 					    rowtransition[n] := m
+ 					end {:583};
+ 				    m := mm;
+ 				    w := ww
+ 				end;
+ 				if d >= rightedge then 
+ 				    goto 40;
+ 				ww := (ww + (d mod 8)) - 4;
+ 				q := mem[q].hh.rh
+ 			    end;
+     40: {584:}
+ 			    if alreadythere or (ww > 0) then begin
+ 				if n = 0 then 
+ 				    if ww > 0 then 
+ 					b := 1
+ 				    else 
+ 					b := 0;
+ 				n := n + 1;
+ 				rowtransition[n] := rightcol[k]
+ 			    end else if n = 0 then 
+ 				goto 30 {:584}; {:582}
+ 			    paintrow(r, b, rowtransition, n);
+     30: {:578}
+ 			    
+ 			end;
+ 			p := mem[p].hh.rh;
+ 			r := r - 1
+ 		    end;
+ 		    updatescreen;
+ 		    windowtime[k] := windowtime[k] + 1;
+ 		    mem[curedges + 3].hh.rh := k;
+ 		    mem[curedges + 4].int := windowtime[k]
+ 		end
+     end; {:577} {591:}
+ 
+     function maxcoef(p: halfword): fraction;
+     var
+ 	x: fraction;
+     begin
+ 	x := 0;
+ 	while mem[p].hh.lh <> (-30000) do begin
+ 	    if abs(mem[p + 1].int) > x then 
+ 		x := abs(mem[p + 1].int);
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	maxcoef := x
+     end; {:591} {597:}
+ 
+     function pplusq(p: halfword; q: halfword; t: smallnumber): halfword;
+     label
+ 	30;
+     var
+ 	pp, qq: halfword;
+ 	r, s: halfword;
+ 	threshold: integer;
+ 	v: integer;
+     begin
+ 	if t = 17 then 
+ 	    threshold := 2685
+ 	else 
+ 	    threshold := 8;
+ 	r := 29999;
+ 	pp := mem[p].hh.lh;
+ 	qq := mem[q].hh.lh;
+ 	while true do 
+ 	    if pp = qq then 
+ 		if pp = (-30000) then 
+ 		    goto 30 {598:}
+ 		else begin
+ 		    v := mem[p + 1].int + mem[q + 1].int;
+ 		    mem[p + 1].int := v;
+ 		    s := p;
+ 		    p := mem[p].hh.rh;
+ 		    pp := mem[p].hh.lh;
+ 		    if abs(v) < threshold then 
+ 			freenode(s, 2)
+ 		    else begin
+ 			if abs(v) >= 626349397 then 
+ 			    if watchcoefs then begin
+ 				mem[qq].hh.b0 := 0;
+ 				fixneeded := true
+ 			    end;
+ 			mem[r].hh.rh := s;
+ 			r := s
+ 		    end;
+ 		    q := mem[q].hh.rh;
+ 		    qq := mem[q].hh.lh
+ 		end {:598}
+ 	    else if mem[pp + 1].int < mem[qq + 1].int then begin
+ 		s := getnode(2);
+ 		mem[s].hh.lh := qq;
+ 		mem[s + 1].int := mem[q + 1].int;
+ 		q := mem[q].hh.rh;
+ 		qq := mem[q].hh.lh;
+ 		mem[r].hh.rh := s;
+ 		r := s
+ 	    end else begin
+ 		mem[r].hh.rh := p;
+ 		r := p;
+ 		p := mem[p].hh.rh;
+ 		pp := mem[p].hh.lh
+ 	    end;
+     30:
+ 	mem[p + 1].int := slowadd(mem[p + 1].int, mem[q + 1].int);
+ 	mem[r].hh.rh := p;
+ 	depfinal := p;
+ 	pplusq := mem[29999].hh.rh
+     end; {:597} {599:}
+ 
+     function ptimesv(p: halfword; v: integer; t0, t1: smallnumber; visscaled: boolean): halfword;
+     var
+ 	r, s: halfword;
+ 	w: integer;
+ 	threshold: integer;
+ 	scalingdown: boolean;
+     begin
+ 	if t0 <> t1 then 
+ 	    scalingdown := true
+ 	else 
+ 	    scalingdown := not visscaled;
+ 	if t1 = 17 then 
+ 	    threshold := 1342
+ 	else 
+ 	    threshold := 4;
+ 	r := 29999;
+ 	while mem[p].hh.lh <> (-30000) do begin
+ 	    if scalingdown then 
+ 		w := takefraction(v, mem[p + 1].int)
+ 	    else 
+ 		w := takescaled(v, mem[p + 1].int);
+ 	    if abs(w) <= threshold then begin
+ 		s := mem[p].hh.rh;
+ 		freenode(p, 2);
+ 		p := s
+ 	    end else begin
+ 		if abs(w) >= 626349397 then begin
+ 		    fixneeded := true;
+ 		    mem[mem[p].hh.lh].hh.b0 := 0
+ 		end;
+ 		mem[r].hh.rh := p;
+ 		r := p;
+ 		mem[p + 1].int := w;
+ 		p := mem[p].hh.rh
+ 	    end
+ 	end;
+ 	mem[r].hh.rh := p;
+ 	if visscaled then 
+ 	    mem[p + 1].int := takescaled(mem[p + 1].int, v)
+ 	else 
+ 	    mem[p + 1].int := takefraction(mem[p + 1].int, v);
+ 	ptimesv := mem[29999].hh.rh
+     end; {:599}
+ {601:}
+ 
+     function pwithxbecomingq(p, x, q: halfword; t: smallnumber): halfword;
+     var
+ 	r, s: halfword;
+ 	v: integer;
+ 	sx: integer;
+     begin
+ 	s := p;
+ 	r := 29999;
+ 	sx := mem[x + 1].int;
+ 	while mem[mem[s].hh.lh + 1].int > sx do begin
+ 	    r := s;
+ 	    s := mem[s].hh.rh
+ 	end;
+ 	if mem[s].hh.lh <> x then 
+ 	    pwithxbecomingq := p
+ 	else begin
+ 	    mem[29999].hh.rh := p;
+ 	    mem[r].hh.rh := mem[s].hh.rh;
+ 	    v := mem[s + 1].int;
+ 	    freenode(s, 2);
+ 	    pwithxbecomingq := pplusfq(mem[29999].hh.rh, v, q, t, 17)
+ 	end
+     end; {:601} {606:}
+ 
+     procedure newdep(q, p: halfword);
+     var
+ 	r: halfword;
+     begin
+ 	mem[q + 1].hh.rh := p;
+ 	mem[q + 1].hh.lh := -29987;
+ 	r := mem[-29987].hh.rh;
+ 	mem[depfinal].hh.rh := r;
+ 	mem[r + 1].hh.lh := depfinal;
+ 	mem[-29987].hh.rh := q
+     end; {:606} {607:}
+ 
+     function constdependency(v: scaled): halfword;
+     begin
+ 	depfinal := getnode(2);
+ 	mem[depfinal + 1].int := v;
+ 	mem[depfinal].hh.lh := -30000;
+ 	constdependency := depfinal
+     end; {:607} {608:}
+ 
+     function singledependency(p: halfword): halfword;
+     var
+ 	q: halfword;
+ 	m: integer;
+     begin
+ 	m := mem[p + 1].int mod 64;
+ 	if m > 28 then 
+ 	    singledependency := constdependency(0)
+ 	else begin
+ 	    q := getnode(2);
+ 	    mem[q + 1].int := twotothe[28 - m];
+ 	    mem[q].hh.lh := p;
+ 	    mem[q].hh.rh := constdependency(0);
+ 	    singledependency := q
+ 	end
+     end; {:608}
+ {609:}
+ 
+     function copydeplist(p: halfword): halfword;
+     label
+ 	30;
+     var
+ 	q: halfword;
+     begin
+ 	q := getnode(2);
+ 	depfinal := q;
+ 	while true do begin
+ 	    mem[depfinal].hh.lh := mem[p].hh.lh;
+ 	    mem[depfinal + 1].int := mem[p + 1].int;
+ 	    if mem[depfinal].hh.lh = (-30000) then 
+ 		goto 30;
+ 	    mem[depfinal].hh.rh := getnode(2);
+ 	    depfinal := mem[depfinal].hh.rh;
+ 	    p := mem[p].hh.rh
+ 	end;
+     30:
+ 	copydeplist := q
+     end; {:609} {610:}
+ 
+     procedure lineareq(p: halfword; t: smallnumber);
+     var
+ 	q, r, s: halfword;
+ 	x: halfword;
+ 	n: integer;
+ 	v: integer;
+ 	prevr: halfword;
+ 	finalnode: halfword;
+ 	w: integer; {611:}
+     begin
+ 	q := p;
+ 	r := mem[p].hh.rh;
+ 	v := mem[q + 1].int;
+ 	while mem[r].hh.lh <> (-30000) do begin
+ 	    if abs(mem[r + 1].int) > abs(v) then begin
+ 		q := r;
+ 		v := mem[r + 1].int
+ 	    end;
+ 	    r := mem[r].hh.rh
+ 	end {:611};
+ 	x := mem[q].hh.lh;
+ 	n := mem[x + 1].int mod 64; {612:}
+ 	s := 29999;
+ 	mem[s].hh.rh := p;
+ 	r := p;
+ 	repeat
+ 	    if r = q then begin
+ 		mem[s].hh.rh := mem[r].hh.rh;
+ 		freenode(r, 2)
+ 	    end else begin
+ 		w := makefraction(mem[r + 1].int, v);
+ 		if abs(w) <= 1342 then begin
+ 		    mem[s].hh.rh := mem[r].hh.rh;
+ 		    freenode(r, 2)
+ 		end else begin
+ 		    mem[r + 1].int := -w;
+ 		    s := r
+ 		end
+ 	    end;
+ 	    r := mem[s].hh.rh
+ 	until mem[r].hh.lh = (-30000);
+ 	if t = 18 then 
+ 	    mem[r + 1].int := -makescaled(mem[r + 1].int, v)
+ 	else if v <> (-268435456) then 
+ 	    mem[r + 1].int := -makefraction(mem[r + 1].int, v);
+ 	finalnode := r;
+ 	p := mem[29999].hh.rh {:612};
+ 	if internal[2] > 0 then  {613:}
+ 	    if interesting(x) then begin
+ 		begindiagnostic;
+ 		printnl(462);
+ 		printvariablename(x);
+ 		w := n;
+ 		while w > 0 do begin
+ 		    print(455);
+ 		    w := w - 2
+ 		end;
+ 		printchar(61);
+ 		printdependency(p, 17);
+ 		enddiagnostic(false)
+ 	    end {:613};
+ {614:}
+ 	prevr := -29987;
+ 	r := mem[-29987].hh.rh;
+ 	while r <> (-29987) do begin
+ 	    s := mem[r + 1].hh.rh;
+ 	    q := pwithxbecomingq(s, x, p, mem[r].hh.b0);
+ 	    if mem[q].hh.lh = (-30000) then 
+ 		makeknown(r, q)
+ 	    else begin
+ 		mem[r + 1].hh.rh := q;
+ 		repeat
+ 		    q := mem[q].hh.rh
+ 		until mem[q].hh.lh = (-30000);
+ 		prevr := q
+ 	    end;
+ 	    r := mem[prevr].hh.rh
+ 	end {:614}; {615:}
+ 	if n > 0 then begin {616:}
+ 	    s := 29999;
+ 	    mem[29999].hh.rh := p;
+ 	    r := p;
+ 	    repeat
+ 		if n > 30 then 
+ 		    w := 0
+ 		else 
+ 		    w := mem[r + 1].int div twotothe[n];
+ 		if (abs(w) <= 1342) and (mem[r].hh.lh <> (-30000)) then begin
+ 		    mem[s].hh.rh := mem[r].hh.rh;
+ 		    freenode(r, 2)
+ 		end else begin
+ 		    mem[r + 1].int := w;
+ 		    s := r
+ 		end;
+ 		r := mem[s].hh.rh
+ 	    until mem[s].hh.lh = (-30000);
+ 	    p := mem[29999].hh.rh
+ 	end {:616};
+ 	if mem[p].hh.lh = (-30000) then begin
+ 	    mem[x].hh.b0 := 16;
+ 	    mem[x + 1].int := mem[p + 1].int;
+ 	    if abs(mem[x + 1].int) >= 268435456 then 
+ 		valtoobig(mem[x + 1].int);
+ 	    freenode(p, 2);
+ 	    if curexp = x then 
+ 		if curtype = 19 then begin
+ 		    curexp := mem[x + 1].int;
+ 		    curtype := 16;
+ 		    freenode(x, 2)
+ 		end
+ 	end else begin
+ 	    mem[x].hh.b0 := 17;
+ 	    depfinal := finalnode;
+ 	    newdep(x, p);
+ 	    if curexp = x then 
+ 		if curtype = 19 then 
+ 		    curtype := 17
+ 	end {:615};
+ 	if fixneeded then 
+ 	    fixdependencies
+     end; {:610} {619:}
+ 
+     function newringentry(p: halfword): halfword;
+     var
+ 	q: halfword;
+     begin
+ 	q := getnode(2);
+ 	mem[q].hh.b1 := 11;
+ 	mem[q].hh.b0 := mem[p].hh.b0;
+ 	if mem[p + 1].int = (-30000) then 
+ 	    mem[q + 1].int := p
+ 	else 
+ 	    mem[q + 1].int := mem[p + 1].int;
+ 	mem[p + 1].int := q;
+ 	newringentry := q
+     end; {:619} {621:}
+ 
+     procedure nonlineareq(v: integer; p: halfword; flushp: boolean);
+     var
+ 	t: smallnumber;
+ 	q, r: halfword;
+     begin
+ 	t := mem[p].hh.b0 - 1;
+ 	q := mem[p + 1].int;
+ 	if flushp then 
+ 	    mem[p].hh.b0 := 1
+ 	else 
+ 	    p := q;
+ 	repeat
+ 	    r := mem[q + 1].int;
+ 	    mem[q].hh.b0 := t;
+ 	    case t of
+ 		2:
+ 		    mem[q + 1].int := v;
+ 		4:
+ 		    begin
+ 			mem[q + 1].int := v;
+ 			begin
+ 			    if strref[v] < 127 then 
+ 				strref[v] := strref[v] + 1
+ 			end
+ 		    end;
+ 		6:
+ 		    begin
+ 			mem[q + 1].int := v;
+ 			mem[v].hh.lh := mem[v].hh.lh + 1
+ 		    end;
+ 		9:
+ 		    mem[q + 1].int := copypath(v);
+ 		11:
+ 		    mem[q + 1].int := copyedges(v)
+ 	    end;
+ 	    q := r
+ 	until q = p
+     end; {:621} {622:}
+ 
+     procedure ringmerge(p, q: halfword);
+     label
+ 	10;
+     var
+ 	r: halfword;
+     begin
+ 	r := mem[p + 1].int;
+ 	while r <> p do begin
+ 	    if r = q then begin {623:}
+ 		begin
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(465)
+ 		    end;
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 466;
+ 			helpline[0] := 467
+ 		    end;
+ 		    putgeterror
+ 		end {:623};
+ 		goto 10
+ 	    end;
+ 	    r := mem[r + 1].int
+ 	end;
+ 	r := mem[p + 1].int;
+ 	mem[p + 1].int := mem[q + 1].int;
+ 	mem[q + 1].int := r;
+     10:
+ 	
+     end; {:622} {626:}
+ 
+     procedure showcmdmod(c, m: integer);
+     begin
+ 	begindiagnostic;
+ 	printnl(123);
+ 	printcmdmod(c, m);
+ 	printchar(125);
+ 	enddiagnostic(false)
+     end; {:626} {635:}
+ 
+     procedure showcontext;
+     label
+ 	30;
+     var
+ 	oldsetting: 0..5; {641:}
+ 	i: 0..bufsize;
+ 	l: integer;
+ 	m: integer;
+ 	n: 0..errorline;
+ 	p: integer;
+ 	q: integer; {:641}
+     begin
+ 	fileptr := inputptr;
+ 	inputstack[fileptr] := curinput;
+ 	while true do begin
+ 	    curinput := inputstack[fileptr]; {636:}
+ 	    if (((fileptr = inputptr) or (curinput.indexfield <= 6)) or (curinput.indexfield <> 10)) or (curinput.locfield <> (-30000)) then begin
+ 		tally := 0;
+ 		oldsetting := selector;
+ 		if curinput.indexfield <= 6 then begin {637:}
+ 		    if curinput.namefield <= 1 then 
+ 			if (curinput.namefield = 0) and (fileptr = 0) then 
+ 			    printnl(469)
+ 			else 
+ 			    printnl(470)
+ 		    else if curinput.namefield = 2 then 
+ 			printnl(471)
+ 		    else begin
+ 			printnl(472);
+ 			printint(line)
+ 		    end;
+ 		    printchar(32) {:637};
+ {644:}
+ 		    begin
+ 			l := tally;
+ 			tally := 0;
+ 			selector := 4;
+ 			trickcount := 1000000
+ 		    end;
+ 		    if curinput.limitfield > 0 then 
+ 			for i := curinput.startfield to curinput.limitfield - 1 do begin
+ 			    if i = curinput.locfield then begin
+ 				firstcount := tally;
+ 				trickcount := ((tally + 1) + errorline) - halferrorline;
+ 				if trickcount < errorline then 
+ 				    trickcount := errorline
+ 			    end;
+ 			    print(buffer[i])
+ 			end {:644}
+ 		end else begin {638:}
+ 		    if curinput.indexfield in
+ 			[7, 8, 9, 10, 11, 12] then
+ 			case curinput.indexfield of
+ 			    7:
+ 				printnl(473);
+ 			    8:
+ 				begin {639:}
+ 				    printnl(478);
+ 				    p := paramstack[curinput.limitfield];
+ 				    if p <> (-30000) then 
+ 					if mem[p].hh.rh = (-29999) then 
+ 					    printexp(p, 0)
+ 					else 
+ 					    showtokenlist(p, -30000, 20, tally);
+ 				    print(479)
+ 				end; {:639}
+ 			    9:
+ 				printnl(474);
+ 			    10:
+ 				if curinput.locfield = (-30000) then 
+ 				    printnl(475)
+ 				else 
+ 				    printnl(476);
+ 			    11:
+ 				printnl(477);
+ 			    12:
+ 				begin
+ 				    println;
+ 				    if curinput.namefield <> (-30000) then 
+ 					print(hash[curinput.namefield].rh) {640:}
+ 				    else begin
+ 					p := paramstack[curinput.limitfield];
+ 					if p = (-30000) then 
+ 					    showtokenlist(paramstack[curinput.limitfield + 1], -30000, 20, tally)
+ 					else begin
+ 					    q := p;
+ 					    while mem[q].hh.rh <> (-30000) do 
+ 						q := mem[q].hh.rh;
+ 					    mem[q].hh.rh := paramstack[curinput.limitfield + 1];
+ 					    showtokenlist(p, -30000, 20, tally);
+ 					    mem[q].hh.rh := -30000
+ 					end
+ 				    end {:640};
+ 				    print(368)
+ 				end
+ 			end
+ 		    else
+ 			printnl(63) {:638}; {645:}
+ 		    begin
+ 			l := tally;
+ 			tally := 0;
+ 			selector := 4;
+ 			trickcount := 1000000
+ 		    end;
+ 		    if curinput.indexfield <> 12 then 
+ 			showtokenlist(curinput.startfield, curinput.locfield, 100000, 0)
+ 		    else 
+ 			showmacro(curinput.startfield, curinput.locfield, 100000) {:645}
+ 		end;
+ 		selector := oldsetting; {643:}
+ 		if trickcount = 1000000 then begin
+ 		    firstcount := tally;
+ 		    trickcount := ((tally + 1) + errorline) - halferrorline;
+ 		    if trickcount < errorline then 
+ 			trickcount := errorline
+ 		end;
+ 		if tally < trickcount then 
+ 		    m := tally - firstcount
+ 		else 
+ 		    m := trickcount - firstcount;
+ 		if (l + firstcount) <= halferrorline then begin
+ 		    p := 0;
+ 		    n := l + firstcount
+ 		end else begin
+ 		    print(146);
+ 		    p := ((l + firstcount) - halferrorline) + 3;
+ 		    n := halferrorline
+ 		end;
+ 		for q := p to firstcount - 1 do 
+ 		    printchar(trickbuf[q mod errorline]);
+ 		println;
+ 		for q := 1 to n do 
+ 		    printchar(32);
+ 		if (m + n) <= errorline then 
+ 		    p := firstcount + m
+ 		else 
+ 		    p := firstcount + ((errorline - n) - 3);
+ 		for q := firstcount to p - 1 do 
+ 		    printchar(trickbuf[q mod errorline]);
+ 		if (m + n) > errorline then 
+ 		    print(146) {:643}
+ 	    end {:636};
+ 	    if curinput.indexfield <= 6 then 
+ 		if (curinput.namefield > 2) or (fileptr = 0) then 
+ 		    goto 30;
+ 	    fileptr := fileptr - 1
+ 	end;
+     30:
+ 	curinput := inputstack[inputptr]
+     end; { showcontext }
+ {:635}
+     {649:}
+ 
+     procedure begintokenlist(p: halfword; t: quarterword);
+     begin
+ 	begin
+ 	    if inputptr > maxinstack then begin
+ 		maxinstack := inputptr;
+ 		if inputptr = stacksize then 
+ 		    overflow(480, stacksize)
+ 	    end;
+ 	    inputstack[inputptr] := curinput;
+ 	    inputptr := inputptr + 1
+ 	end;
+ 	curinput.startfield := p;
+ 	curinput.indexfield := t;
+ 	curinput.limitfield := paramptr;
+ 	curinput.locfield := p
+     end; {:649} {650:}
+ 
+     procedure endtokenlist;
+     label
+ 	30;
+     var
+ 	p: halfword;
+     begin
+ 	if curinput.indexfield >= 10 then 
+ 	    if curinput.indexfield <= 11 then begin
+ 		flushtokenlist(curinput.startfield);
+ 		goto 30
+ 	    end else 
+ 		deletemacref(curinput.startfield);
+ 	while paramptr > curinput.limitfield do begin
+ 	    paramptr := paramptr - 1;
+ 	    p := paramstack[paramptr];
+ 	    if p <> (-30000) then 
+ 		if mem[p].hh.rh = (-29999) then begin
+ 		    recyclevalue(p);
+ 		    freenode(p, 2)
+ 		end else 
+ 		    flushtokenlist(p)
+ 	end;
+     30:
+ 	begin
+ 	    inputptr := inputptr - 1;
+ 	    curinput := inputstack[inputptr]
+ 	end;
+ 	begin
+ 	    if interrupt <> 0 then 
+ 		pauseforinstructions
+ 	end
+     end; {:650} {651:}
+ {855:}
+     {856:}
+ 
+     procedure encapsulate(p: halfword);
+     begin
+ 	curexp := getnode(2);
+ 	mem[curexp].hh.b0 := curtype;
+ 	mem[curexp].hh.b1 := 11;
+ 	newdep(curexp, p)
+     end; { encapsulate }
+ {:856}
+     {858:}
+ 
+     procedure install(r, q: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	if mem[q].hh.b0 = 16 then begin
+ 	    mem[r + 1].int := mem[q + 1].int;
+ 	    mem[r].hh.b0 := 16
+ 	end else if mem[q].hh.b0 = 19 then begin
+ 	    p := singledependency(q);
+ 	    if p = depfinal then begin
+ 		mem[r].hh.b0 := 16;
+ 		mem[r + 1].int := 0;
+ 		freenode(p, 2)
+ 	    end else begin
+ 		mem[r].hh.b0 := 17;
+ 		newdep(r, p)
+ 	    end
+ 	end else begin
+ 	    mem[r].hh.b0 := mem[q].hh.b0;
+ 	    newdep(r, copydeplist(mem[q + 1].hh.rh))
+ 	end
+     end; {:858}
+ 
+     procedure makeexpcopy(p: halfword);
+     label
+ 	20;
+     var
+ 	q, r, t: halfword;
+     begin
+     20:
+ 	curtype := mem[p].hh.b0;
+ 	if curtype in
+ 	    [1, 2, 16, 3, 5, 7, 12, 10,
+ 	     4, 6, 11, 9, 8, 13, 14, 17,
+ 	     18, 15, 19] then
+ 	    case curtype of
+ 		1, 2, 16:
+ 		    curexp := mem[p + 1].int;
+ 		3, 5, 7, 12, 10:
+ 		    curexp := newringentry(p);
+ 		4:
+ 		    begin
+ 			curexp := mem[p + 1].int;
+ 			begin
+ 			    if strref[curexp] < 127 then 
+ 				strref[curexp] := strref[curexp] + 1
+ 			end
+ 		    end;
+ 		6:
+ 		    begin
+ 			curexp := mem[p + 1].int;
+ 			mem[curexp].hh.lh := mem[curexp].hh.lh + 1
+ 		    end;
+ 		11:
+ 		    curexp := copyedges(mem[p + 1].int);
+ 		9, 8:
+ 		    curexp := copypath(mem[p + 1].int);
+ 		13, 14:
+ 		    begin {857:}
+ 			if mem[p + 1].int = (-30000) then 
+ 			    initbignode(p);
+ 			t := getnode(2);
+ 			mem[t].hh.b1 := 11;
+ 			mem[t].hh.b0 := curtype;
+ 			initbignode(t);
+ 			q := mem[p + 1].int + bignodesize[curtype];
+ 			r := mem[t + 1].int + bignodesize[curtype];
+ 			repeat
+ 			    q := q - 2;
+ 			    r := r - 2;
+ 			    install(r, q)
+ 			until q = mem[p + 1].int;
+ 			curexp := t
+ 		    end; {:857}
+ 		17, 18:
+ 		    encapsulate(copydeplist(mem[p + 1].hh.rh));
+ 		15:
+ 		    begin
+ 			begin
+ 			    mem[p].hh.b0 := 19;
+ 			    serialno := serialno + 64;
+ 			    mem[p + 1].int := serialno
+ 			end;
+ 			goto 20
+ 		    end;
+ 		19:
+ 		    begin
+ 			q := singledependency(p);
+ 			if q = depfinal then begin
+ 			    curtype := 16;
+ 			    curexp := 0;
+ 			    freenode(q, 2)
+ 			end else begin
+ 			    curtype := 17;
+ 			    encapsulate(q)
+ 			end
+ 		    end
+ 	    end
+ 	else
+ 	    confusion(664)
+     end; {:855}
+ 
+     function curtok: halfword;
+     var
+ 	p: halfword;
+ 	savetype: smallnumber;
+ 	saveexp: integer;
+     begin
+ 	if cursym = 0 then 
+ 	    if curcmd = 38 then begin
+ 		savetype := curtype;
+ 		saveexp := curexp;
+ 		makeexpcopy(curmod);
+ 		p := stashcurexp;
+ 		mem[p].hh.rh := -30000;
+ 		curtype := savetype;
+ 		curexp := saveexp
+ 	    end else begin
+ 		p := getnode(2);
+ 		mem[p + 1].int := curmod;
+ 		mem[p].hh.b1 := 12;
+ 		if curcmd = 42 then 
+ 		    mem[p].hh.b0 := 16
+ 		else 
+ 		    mem[p].hh.b0 := 4
+ 	    end
+ 	else begin
+ 	    begin
+ 		p := avail;
+ 		if p = (-30000) then 
+ 		    p := getavail
+ 		else begin
+ 		    avail := mem[p].hh.rh;
+ 		    mem[p].hh.rh := -30000
+ 		end {dynused:=dynused+1;}
+ 	    end;
+ 	    mem[p].hh.lh := cursym
+ 	end;
+ 	curtok := p
+     end; {:651} {652:}
+ 
+     procedure backinput;
+     var
+ 	p: halfword;
+ 	s: 0..150;
+     begin
+ 	p := curtok;
+ 	while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do 
+ 	    endtokenlist;
+ 	begintokenlist(p, 10)
+     end; {:652} {653:}
+ 
+     procedure backerror;
+     begin
+ 	OKtointerrupt := false;
+ 	backinput;
+ 	OKtointerrupt := true;
+ 	error
+     end; { backerror }
+ 
+     procedure inserror;
+     begin
+ 	OKtointerrupt := false;
+ 	backinput;
+ 	curinput.indexfield := 11;
+ 	OKtointerrupt := true;
+ 	error
+     end; {:653} {654:}
+ 
+     procedure beginfilereading;
+     begin
+ 	if inopen = 6 then 
+ 	    overflow(481, 6);
+ 	if first = bufsize then 
+ 	    overflow(128, bufsize);
+ 	inopen := inopen + 1;
+ 	begin
+ 	    if inputptr > maxinstack then begin
+ 		maxinstack := inputptr;
+ 		if inputptr = stacksize then 
+ 		    overflow(480, stacksize)
+ 	    end;
+ 	    inputstack[inputptr] := curinput;
+ 	    inputptr := inputptr + 1
+ 	end;
+ 	curinput.indexfield := inopen;
+ 	linestack[curinput.indexfield] := line;
+ 	curinput.startfield := first;
+ 	curinput.namefield := 0
+     end; {:654} {655:}
+ 
+     procedure endfilereading;
+     begin
+ 	first := curinput.startfield;
+ 	line := linestack[curinput.indexfield];
+ 	if curinput.indexfield <> inopen then 
+ 	    confusion(482);
+ 	if curinput.namefield > 2 then 
+ 	    aclose(inputfile[curinput.indexfield]);
+ 	begin
+ 	    inputptr := inputptr - 1;
+ 	    curinput := inputstack[inputptr]
+ 	end;
+ 	inopen := inopen - 1
+     end; {:655} {656:}
+ 
+     procedure clearforerrorprompt;
+     begin
+ 	while (((curinput.indexfield <= 6) and (curinput.namefield = 0)) and (inputptr > 0)) and (curinput.locfield = curinput.limitfield) do 
+ 	    endfilereading;
+ 	println
+     end; {:656} {661:}
+ 
+     function checkoutervalidity: boolean;
+     var
+ 	p: halfword;
+     begin
+ 	if scannerstatus = 0 then 
+ 	    checkoutervalidity := true
+ 	else begin
+ 	    deletionsallowed := false; {662:}
+ 	    if cursym <> 0 then begin
+ 		p := getavail;
+ 		mem[p].hh.lh := cursym;
+ 		begintokenlist(p, 10)
+ 	    end {:662};
+ 	    if scannerstatus > 1 then begin {663:}
+ 		runaway;
+ 		if cursym = 0 then begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(488)
+ 		end else begin
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(489)
+ 		    end
+ 		end;
+ 		print(490);
+ 		begin
+ 		    helpptr := 4;
+ 		    helpline[3] := 491;
+ 		    helpline[2] := 492;
+ 		    helpline[1] := 493;
+ 		    helpline[0] := 494
+ 		end;
+ 		case scannerstatus of {664:}
+ 		    2:
+ 			begin
+ 			    print(495);
+ 			    helpline[3] := 496;
+ 			    cursym := 2235
+ 			end;
+ 		    3:
+ 			begin
+ 			    print(497);
+ 			    helpline[3] := 498;
+ 			    if warninginfo = 0 then 
+ 				cursym := 2239
+ 			    else begin
+ 				cursym := 2231;
+ 				eqtb[2231].rh := warninginfo
+ 			    end
+ 			end;
+ 		    4, 5:
+ 			begin
+ 			    print(499);
+ 			    if scannerstatus = 5 then 
+ 				print(hash[warninginfo].rh)
+ 			    else 
+ 				printvariablename(warninginfo);
+ 			    cursym := 2237
+ 			end;
+ 		    6:
+ 			begin
+ 			    print(500);
+ 			    print(hash[warninginfo].rh);
+ 			    print(501);
+ 			    helpline[3] := 502;
+ 			    cursym := 2236
+ 			end
+ 		end {:664};
+ 		inserror
+ 	    end else begin {:663}
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(483)
+ 		end;
+ 		printint(warninginfo);
+ 		begin
+ 		    helpptr := 3;
+ 		    helpline[2] := 484;
+ 		    helpline[1] := 485;
+ 		    helpline[0] := 486
+ 		end;
+ 		if cursym = 0 then 
+ 		    helpline[2] := 487;
+ 		cursym := 2238;
+ 		inserror
+ 	    end;
+ 	    deletionsallowed := true;
+ 	    checkoutervalidity := false
+ 	end
+     end; {:661} {666:}
+ 
+     procedure firmuptheline;
+     forward; {:666} {667:}
+ 
+     procedure getnext;
+     label
+ 	20, 10, 40, 25, 85, 86, 87, 30;
+     var
+ 	k: 0..bufsize;
+ 	c: ASCIIcode;
+ 	class: ASCIIcode;
+ 	n, f: integer;
+     begin
+     20:
+ 	cursym := 0;
+ 	if curinput.indexfield <= 6 then begin {669:}
+     25:
+ 	    c := buffer[curinput.locfield];
+ 	    curinput.locfield := curinput.locfield + 1;
+ 	    class := charclass[c];
+ 	    if class in
+ 		[0, 1, 2, 3, 4, 5, 6, 7,
+ 		 8, 20] then
+ 		case class of
+ 		    0:
+ 			goto 85;
+ 		    1:
+ 			begin
+ 			    class := charclass[buffer[curinput.locfield]];
+ 			    if class > 1 then 
+ 				goto 25
+ 			    else if class < 1 then begin
+ 				n := 0;
+ 				goto 86
+ 			    end
+ 			end;
+ 		    2:
+ 			goto 25;
+ 		    3:
+ 			begin {679:}
+ 			    if curinput.namefield > 2 then begin {681:}
+ 				line := line + 1;
+ 				first := curinput.startfield;
+ 				if not forceeof then begin
+ 				    if inputln(inputfile[curinput.indexfield], true) then 
+ 					firmuptheline
+ 				    else 
+ 					forceeof := true
+ 				end;
+ 				if forceeof then begin
+ 				    printchar(41);
+ 				    forceeof := false;
+ 				    flush(output);
+ 				    endfilereading;
+ 				    if checkoutervalidity then 
+ 					goto 20
+ 				    else 
+ 					goto 20
+ 				end;
+ 				buffer[curinput.limitfield] := 37;
+ 				first := curinput.limitfield + 1;
+ 				curinput.locfield := curinput.startfield
+ 			    end else begin {:681}
+ 				if inputptr > 0 then begin
+ 				    endfilereading;
+ 				    goto 20
+ 				end;
+ 				if selector < 2 then 
+ 				    openlogfile;
+ 				if interaction > 1 then begin
+ 				    if curinput.limitfield = curinput.startfield then 
+ 					printnl(517);
+ 				    println;
+ 				    first := curinput.startfield;
+ 				    begin
+ 					print(42);
+ 					terminput
+ 				    end;
+ 				    curinput.limitfield := last;
+ 				    buffer[curinput.limitfield] := 37;
+ 				    first := curinput.limitfield + 1;
+ 				    curinput.locfield := curinput.startfield
+ 				end else 
+ 				    fatalerror(518)
+ 			    end {:679};
+ 			    begin
+ 				if interrupt <> 0 then 
+ 				    pauseforinstructions
+ 			    end;
+ 			    goto 25
+ 			end;
+ 		    4:
+ 			begin {671:}
+ 			    if buffer[curinput.locfield] = 34 then 
+ 				curmod := 155
+ 			    else begin
+ 				k := curinput.locfield;
+ 				buffer[curinput.limitfield + 1] := 34;
+ 				repeat
+ 				    curinput.locfield := curinput.locfield + 1
+ 				until buffer[curinput.locfield] = 34;
+ 				if curinput.locfield > curinput.limitfield then begin {672:}
+ 				    curinput.locfield := curinput.limitfield;
+ 				    begin
+ 					if interaction = 3 then 
+ 					    ;
+ 					printnl(133);
+ 					print(510)
+ 				    end;
+ 				    begin
+ 					helpptr := 3;
+ 					helpline[2] := 511;
+ 					helpline[1] := 512;
+ 					helpline[0] := 513
+ 				    end;
+ 				    deletionsallowed := false;
+ 				    error;
+ 				    deletionsallowed := true;
+ 				    goto 20
+ 				end {:672};
+ 				if curinput.locfield = (k + 1) then 
+ 				    curmod := buffer[k]
+ 				else begin
+ 				    begin
+ 					if ((poolptr + curinput.locfield) - k) > maxpoolptr then begin
+ 					    if ((poolptr + curinput.locfield) - k) > poolsize then 
+ 						overflow(129, poolsize - initpoolptr);
+ 					    maxpoolptr := (poolptr + curinput.locfield) - k
+ 					end
+ 				    end;
+ 				    repeat
+ 					begin
+ 					    strpool[poolptr] := buffer[k];
+ 					    poolptr := poolptr + 1
+ 					end;
+ 					k := k + 1
+ 				    until k = curinput.locfield;
+ 				    curmod := makestring
+ 				end
+ 			    end;
+ 			    curinput.locfield := curinput.locfield + 1;
+ 			    curcmd := 39;
+ 			    goto 10
+ 			end; {:671}
+ 		    5, 6, 7, 8:
+ 			begin
+ 			    k := curinput.locfield - 1;
+ 			    goto 40
+ 			end;
+ 		    20:
+ 			begin {670:}
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(507)
+ 			    end;
+ 			    begin
+ 				helpptr := 2;
+ 				helpline[1] := 508;
+ 				helpline[0] := 509
+ 			    end;
+ 			    deletionsallowed := false;
+ 			    error;
+ 			    deletionsallowed := true;
+ 			    goto 20
+ 			end
+ 		end
+ 	    else
+ 		 {:670};
+ 	    k := curinput.locfield - 1;
+ 	    while charclass[buffer[curinput.locfield]] = class do 
+ 		curinput.locfield := curinput.locfield + 1;
+ 	    goto 40;
+     85: {673:}
+ 	    n := c - 48;
+ 	    while charclass[buffer[curinput.locfield]] = 0 do begin
+ 		if n < 4096 then 
+ 		    n := ((10 * n) + buffer[curinput.locfield]) - 48;
+ 		curinput.locfield := curinput.locfield + 1
+ 	    end;
+ 	    if buffer[curinput.locfield] = 46 then 
+ 		if charclass[buffer[curinput.locfield + 1]] = 0 then 
+ 		    goto 30;
+ 	    f := 0;
+ 	    goto 87;
+     30:
+ 	    curinput.locfield := curinput.locfield + 1 {:673};
+     86: {674:}
+ 	    k := 0;
+ 	    repeat
+ 		if k < 17 then begin
+ 		    dig[k] := buffer[curinput.locfield] - 48;
+ 		    k := k + 1
+ 		end;
+ 		curinput.locfield := curinput.locfield + 1
+ 	    until charclass[buffer[curinput.locfield]] <> 0;
+ 	    f := rounddecimals(k);
+ 	    if f = 65536 then begin
+ 		n := n + 1;
+ 		f := 0
+ 	    end {:674};
+     87: {675:}
+ 	    if n < 4096 then 
+ 		curmod := (n * 65536) + f
+ 	    else begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(514)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 515;
+ 		    helpline[0] := 516
+ 		end;
+ 		deletionsallowed := false;
+ 		error;
+ 		deletionsallowed := true;
+ 		curmod := 268435455
+ 	    end;
+ 	    curcmd := 42;
+ 	    goto 10 {:675};
+     40:
+ 	    cursym := idlookup(k, curinput.locfield - k)
+ 	end else if curinput.locfield >= himemmin then begin {:669} {676:}
+ 	    cursym := mem[curinput.locfield].hh.lh;
+ 	    curinput.locfield := mem[curinput.locfield].hh.rh;
+ 	    if cursym >= 2242 then 
+ 		if cursym >= 2392 then begin {677:}
+ 		    if cursym >= 2542 then 
+ 			cursym := cursym - 150;
+ 		    begintokenlist(paramstack[(curinput.limitfield + cursym) - 2392], 9);
+ 		    goto 20
+ 		end else begin {:677}
+ 		    curcmd := 38;
+ 		    curmod := paramstack[(curinput.limitfield + cursym) - 2242];
+ 		    cursym := 0;
+ 		    goto 10
+ 		end
+ 	end else if curinput.locfield > (-30000) then begin {678:}
+ 	    if mem[curinput.locfield].hh.b1 = 12 then begin
+ 		curmod := mem[curinput.locfield + 1].int;
+ 		if mem[curinput.locfield].hh.b0 = 16 then 
+ 		    curcmd := 42
+ 		else begin
+ 		    curcmd := 39;
+ 		    begin
+ 			if strref[curmod] < 127 then 
+ 			    strref[curmod] := strref[curmod] + 1
+ 		    end
+ 		end
+ 	    end else begin
+ 		curmod := curinput.locfield;
+ 		curcmd := 38
+ 	    end;
+ 	    curinput.locfield := mem[curinput.locfield].hh.rh;
+ 	    goto 10
+ 	end else begin {:678}
+ 	    endtokenlist;
+ 	    goto 20
+ 	end {:676}; {668:}
+ 	curcmd := eqtb[cursym].lh;
+ 	curmod := eqtb[cursym].rh;
+ 	if curcmd >= 83 then 
+ 	    if checkoutervalidity then 
+ 		curcmd := curcmd - 83
+ 	    else 
+ 		goto 20 {:668};
+     10:
+ 	
+     end; {:667} {682:}
+ 
+     procedure firmuptheline;
+     var
+ 	k: 0..bufsize;
+     begin
+ 	curinput.limitfield := last;
+ 	if internal[31] > 0 then 
+ 	    if interaction > 1 then begin
+ 		println;
+ 		if curinput.startfield < curinput.limitfield then 
+ 		    for k := curinput.startfield to curinput.limitfield - 1 do 
+ 			print(buffer[k]);
+ 		first := curinput.limitfield;
+ 		begin
+ 		    print(519);
+ 		    terminput
+ 		end;
+ 		if last > first then begin
+ 		    for k := first to last - 1 do 
+ 			buffer[(k + curinput.startfield) - first] := buffer[k];
+ 		    curinput.limitfield := (curinput.startfield + last) - first
+ 		end
+ 	    end
+     end; {:682}
+ {685:}
+ 
+     function scantoks(terminator: commandcode; substlist, tailend: halfword; suffixcount: smallnumber): halfword;
+     label
+ 	30, 40;
+     var
+ 	p: halfword;
+ 	q: halfword;
+ 	balance: integer;
+     begin
+ 	p := 29998;
+ 	balance := 1;
+ 	mem[29998].hh.rh := -30000;
+ 	while true do begin
+ 	    getnext;
+ 	    if cursym > 0 then begin {686:}
+ 		begin
+ 		    q := substlist;
+ 		    while q <> (-30000) do begin
+ 			if mem[q].hh.lh = cursym then begin
+ 			    cursym := mem[q + 1].int;
+ 			    curcmd := 7;
+ 			    goto 40
+ 			end;
+ 			q := mem[q].hh.rh
+ 		    end;
+     40: {:686}
+ 		    
+ 		end;
+ 		if curcmd = terminator then  {687:}
+ 		    if curmod > 0 then 
+ 			balance := balance + 1
+ 		    else begin
+ 			balance := balance - 1;
+ 			if balance = 0 then 
+ 			    goto 30
+ 		    end {:687}
+ 		else if curcmd = 61 then begin {690:}
+ 		    if curmod = 0 then 
+ 			getnext
+ 		    else if curmod <= suffixcount then 
+ 			cursym := 2391 + curmod
+ 		end {:690}
+ 	    end;
+ 	    mem[p].hh.rh := curtok;
+ 	    p := mem[p].hh.rh
+ 	end;
+     30:
+ 	mem[p].hh.rh := tailend;
+ 	flushnodelist(substlist);
+ 	scantoks := mem[29998].hh.rh
+     end; {:685} {691:}
+ 
+     procedure getsymbol;
+     label
+ 	20;
+     begin
+     20:
+ 	getnext;
+ 	if (cursym = 0) or (cursym > 2229) then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(531)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 532;
+ 		helpline[1] := 533;
+ 		helpline[0] := 534
+ 	    end;
+ 	    if cursym > 0 then 
+ 		helpline[2] := 535
+ 	    else if curcmd = 39 then begin
+ 		if strref[curmod] < 127 then 
+ 		    if strref[curmod] > 1 then 
+ 			strref[curmod] := strref[curmod] - 1
+ 		    else 
+ 			flushstring(curmod)
+ 	    end;
+ 	    cursym := 2229;
+ 	    inserror;
+ 	    goto 20
+ 	end
+     end; { getsymbol }
+ {:691}
+     {692:}
+ 
+     procedure getclearsymbol;
+     begin
+ 	getsymbol;
+ 	clearsymbol(cursym, false)
+     end; {:692} {693:}
+ 
+     procedure checkequals;
+     begin
+ 	if curcmd <> 51 then 
+ 	    if curcmd <> 77 then begin
+ 		missingerr(61);
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 536;
+ 		    helpline[3] := 537;
+ 		    helpline[2] := 538;
+ 		    helpline[1] := 539;
+ 		    helpline[0] := 540
+ 		end;
+ 		backerror
+ 	    end
+     end; {:693} {694:}
+ 
+     procedure makeopdef;
+     var
+ 	m: commandcode;
+ 	p, q, r: halfword;
+     begin
+ 	m := curmod;
+ 	getsymbol;
+ 	q := getnode(2);
+ 	mem[q].hh.lh := cursym;
+ 	mem[q + 1].int := 2242;
+ 	getclearsymbol;
+ 	warninginfo := cursym;
+ 	getsymbol;
+ 	p := getnode(2);
+ 	mem[p].hh.lh := cursym;
+ 	mem[p + 1].int := 2243;
+ 	mem[p].hh.rh := q;
+ 	getnext;
+ 	checkequals;
+ 	scannerstatus := 5;
+ 	q := getavail;
+ 	mem[q].hh.lh := -30000;
+ 	r := getavail;
+ 	mem[q].hh.rh := r;
+ 	mem[r].hh.lh := 0;
+ 	mem[r].hh.rh := scantoks(16, p, -30000, 0);
+ 	scannerstatus := 0;
+ 	eqtb[warninginfo].lh := m;
+ 	eqtb[warninginfo].rh := q;
+ 	getxnext
+     end; {:694}
+ {697:}
+     {1032:}
+ 
+     procedure checkdelimiter(ldelim, rdelim: halfword);
+     label
+ 	10;
+     begin
+ 	if curcmd = 62 then 
+ 	    if curmod = ldelim then 
+ 		goto 10;
+ 	if cursym <> rdelim then begin
+ 	    missingerr(hash[rdelim].rh);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 786;
+ 		helpline[0] := 787
+ 	    end;
+ 	    backerror
+ 	end else begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(788)
+ 	    end;
+ 	    print(hash[rdelim].rh);
+ 	    print(789);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 790;
+ 		helpline[1] := 791;
+ 		helpline[0] := 792
+ 	    end;
+ 	    error
+ 	end;
+     10:
+ 	
+     end; {:1032} {1011:}
+ 
+     function scandeclaredvariable: halfword;
+     label
+ 	30;
+     var
+ 	x: halfword;
+ 	h, t: halfword;
+ 	l: halfword;
+     begin
+ 	getsymbol;
+ 	x := cursym;
+ 	if curcmd <> 41 then 
+ 	    clearsymbol(x, false);
+ 	if eqtb[x].rh = (-30000) then 
+ 	    newroot(x);
+ 	h := getavail;
+ 	mem[h].hh.lh := x;
+ 	t := h;
+ 	while true do begin
+ 	    getxnext;
+ 	    if cursym = 0 then 
+ 		goto 30;
+ 	    if curcmd <> 41 then 
+ 		if curcmd <> 40 then 
+ 		    if curcmd = 63 then begin {1012:}
+ 			l := cursym;
+ 			getxnext;
+ 			if curcmd <> 64 then begin
+ 			    backinput;
+ 			    cursym := l;
+ 			    curcmd := 63;
+ 			    goto 30
+ 			end else 
+ 			    cursym := 0
+ 		    end else  {:1012}
+ 			goto 30;
+ 	    mem[t].hh.rh := getavail;
+ 	    t := mem[t].hh.rh;
+ 	    mem[t].hh.lh := cursym
+ 	end;
+     30:
+ 	scandeclaredvariable := h
+     end; {:1011}
+ 
+     procedure scandef;
+     var
+ 	m: 1..2;
+ 	n: 0..3;
+ 	k: 0..150;
+ 	c: 0..7;
+ 	r: halfword;
+ 	q: halfword;
+ 	p: halfword;
+ 	base: halfword;
+ 	ldelim, rdelim: halfword;
+     begin
+ 	m := curmod;
+ 	c := 0;
+ 	mem[29998].hh.rh := -30000;
+ 	q := getavail;
+ 	mem[q].hh.lh := -30000;
+ 	r := -30000; {700:}
+ 	if m = 1 then begin
+ 	    getclearsymbol;
+ 	    warninginfo := cursym;
+ 	    getnext;
+ 	    scannerstatus := 5;
+ 	    n := 0;
+ 	    eqtb[warninginfo].lh := 10;
+ 	    eqtb[warninginfo].rh := q
+ 	end else begin
+ 	    p := scandeclaredvariable;
+ 	    flushvariable(eqtb[mem[p].hh.lh].rh, mem[p].hh.rh, true);
+ 	    warninginfo := findvariable(p);
+ 	    flushlist(p);
+ 	    if warninginfo = (-30000) then begin {701:}
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(547)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 548;
+ 		    helpline[0] := 549
+ 		end;
+ 		error;
+ 		warninginfo := -29979
+ 	    end {:701};
+ 	    scannerstatus := 4;
+ 	    n := 2;
+ 	    if curcmd = 61 then 
+ 		if curmod = 3 then begin
+ 		    n := 3;
+ 		    getnext
+ 		end;
+ 	    mem[warninginfo].hh.b0 := 20 + n;
+ 	    mem[warninginfo + 1].int := q
+ 	end {:700};
+ 	k := n;
+ 	if curcmd = 31 then  {703:}
+ 	    repeat
+ 		ldelim := cursym;
+ 		rdelim := curmod;
+ 		getnext;
+ 		if (curcmd = 56) and (curmod >= 2242) then 
+ 		    base := curmod
+ 		else begin
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(550)
+ 		    end;
+ 		    begin
+ 			helpptr := 1;
+ 			helpline[0] := 551
+ 		    end;
+ 		    backerror;
+ 		    base := 2242
+ 		end; {704:}
+ 		repeat
+ 		    mem[q].hh.rh := getavail;
+ 		    q := mem[q].hh.rh;
+ 		    mem[q].hh.lh := base + k;
+ 		    getsymbol;
+ 		    p := getnode(2);
+ 		    mem[p + 1].int := base + k;
+ 		    mem[p].hh.lh := cursym;
+ 		    if k = 150 then 
+ 			overflow(552, 150);
+ 		    k := k + 1;
+ 		    mem[p].hh.rh := r;
+ 		    r := p;
+ 		    getnext
+ 		until curcmd <> 79 {:704};
+ 		checkdelimiter(ldelim, rdelim);
+ 		getnext
+ 	    until curcmd <> 31 {:703};
+ 	if curcmd = 56 then begin {705:}
+ 	    p := getnode(2);
+ 	    if curmod < 2242 then begin
+ 		c := curmod;
+ 		mem[p + 1].int := 2242 + k
+ 	    end else begin
+ 		mem[p + 1].int := curmod + k;
+ 		if curmod = 2242 then 
+ 		    c := 4
+ 		else if curmod = 2392 then 
+ 		    c := 6
+ 		else 
+ 		    c := 7
+ 	    end;
+ 	    if k = 150 then 
+ 		overflow(552, 150);
+ 	    k := k + 1;
+ 	    getsymbol;
+ 	    mem[p].hh.lh := cursym;
+ 	    mem[p].hh.rh := r;
+ 	    r := p;
+ 	    getnext;
+ 	    if c = 4 then 
+ 		if curcmd = 69 then begin
+ 		    c := 5;
+ 		    p := getnode(2);
+ 		    if k = 150 then 
+ 			overflow(552, 150);
+ 		    mem[p + 1].int := 2242 + k;
+ 		    getsymbol;
+ 		    mem[p].hh.lh := cursym;
+ 		    mem[p].hh.rh := r;
+ 		    r := p;
+ 		    getnext
+ 		end
+ 	end {:705};
+ 	checkequals;
+ 	p := getavail;
+ 	mem[p].hh.lh := c;
+ 	mem[q].hh.rh := p; {698:}
+ 	if m = 1 then 
+ 	    mem[p].hh.rh := scantoks(16, r, -30000, n)
+ 	else begin
+ 	    q := getavail;
+ 	    mem[q].hh.lh := bgloc;
+ 	    mem[p].hh.rh := q;
+ 	    p := getavail;
+ 	    mem[p].hh.lh := egloc;
+ 	    mem[q].hh.rh := scantoks(16, r, p, n)
+ 	end;
+ 	if warninginfo = (-29979) then 
+ 	    flushtokenlist(mem[-29978].int) {:698};
+ 	scannerstatus := 0;
+ 	getxnext
+     end; {:697} {706:}
+ 
+     procedure scanprimary;
+     forward;
+ 
+     procedure scansecondary;
+     forward;
+ 
+     procedure scantertiary;
+     forward;
+ 
+     procedure scanexpression;
+     forward;
+ 
+     procedure scansuffix;
+     forward; {720:}
+ {722:}
+ 
+     procedure printmacroname(a, n: halfword);
+     var
+ 	p, q: halfword;
+     begin
+ 	if n <> (-30000) then 
+ 	    print(hash[n].rh)
+ 	else begin
+ 	    p := mem[a].hh.lh;
+ 	    if p = (-30000) then 
+ 		print(hash[mem[mem[mem[a].hh.rh].hh.lh].hh.lh].rh)
+ 	    else begin
+ 		q := p;
+ 		while mem[q].hh.rh <> (-30000) do 
+ 		    q := mem[q].hh.rh;
+ 		mem[q].hh.rh := mem[mem[a].hh.rh].hh.lh;
+ 		showtokenlist(p, -30000, 1000, 0);
+ 		mem[q].hh.rh := -30000
+ 	    end
+ 	end
+     end; {:722} {723:}
+ 
+     procedure printarg(q: halfword; n: integer; b: halfword);
+     begin
+ 	if mem[q].hh.rh = (-29999) then 
+ 	    printnl(365)
+ 	else if (b < 2542) and (b <> 7) then 
+ 	    printnl(366)
+ 	else 
+ 	    printnl(367);
+ 	printint(n);
+ 	print(568);
+ 	if mem[q].hh.rh = (-29999) then 
+ 	    printexp(q, 1)
+ 	else 
+ 	    showtokenlist(q, -30000, 1000, 0)
+     end; {:723} {730:}
+ 
+     procedure scantextarg(ldelim, rdelim: halfword);
+     label
+ 	30;
+     var
+ 	balance: integer;
+ 	p: halfword;
+     begin
+ 	warninginfo := ldelim;
+ 	scannerstatus := 3;
+ 	p := 29998;
+ 	balance := 1;
+ 	mem[29998].hh.rh := -30000;
+ 	while true do begin
+ 	    getnext;
+ 	    if ldelim = 0 then begin {732:}
+ 		if curcmd > 79 then begin
+ 		    if balance = 1 then 
+ 			goto 30
+ 		    else if curcmd = 81 then 
+ 			balance := balance - 1
+ 		end else if curcmd = 32 then 
+ 		    balance := balance + 1
+ 	    end else begin {:732} {731:}
+ 		if curcmd = 62 then begin
+ 		    if curmod = ldelim then begin
+ 			balance := balance - 1;
+ 			if balance = 0 then 
+ 			    goto 30
+ 		    end
+ 		end else if curcmd = 31 then 
+ 		    if curmod = rdelim then 
+ 			balance := balance + 1
+ 	    end {:731};
+ 	    mem[p].hh.rh := curtok;
+ 	    p := mem[p].hh.rh
+ 	end;
+     30:
+ 	curexp := mem[29998].hh.rh;
+ 	curtype := 20;
+ 	scannerstatus := 0
+     end; {:730}
+ 
+     procedure macrocall(defref, arglist, macroname: halfword);
+     label
+ 	40;
+     var
+ 	r: halfword;
+ 	p, q: halfword;
+ 	n: integer;
+ 	ldelim, rdelim: halfword;
+ 	tail: halfword;
+     begin
+ 	r := mem[defref].hh.rh;
+ 	mem[defref].hh.lh := mem[defref].hh.lh + 1;
+ 	if arglist = (-30000) then 
+ 	    n := 0 {724:}
+ 	else begin
+ 	    n := 1;
+ 	    tail := arglist;
+ 	    while mem[tail].hh.rh <> (-30000) do begin
+ 		n := n + 1;
+ 		tail := mem[tail].hh.rh
+ 	    end
+ 	end {:724};
+ 	if internal[9] > 0 then begin {721:}
+ 	    begindiagnostic;
+ 	    println;
+ 	    printmacroname(arglist, macroname);
+ 	    if n = 3 then 
+ 		print(530);
+ 	    showmacro(defref, -30000, 100000);
+ 	    if arglist <> (-30000) then begin
+ 		n := 0;
+ 		p := arglist;
+ 		repeat
+ 		    q := mem[p].hh.lh;
+ 		    printarg(q, n, 0);
+ 		    n := n + 1;
+ 		    p := mem[p].hh.rh
+ 		until p = (-30000)
+ 	    end;
+ 	    enddiagnostic(false)
+ 	end {:721}; {725:}
+ 	curcmd := 80;
+ 	while mem[r].hh.lh >= 2242 do begin {726:}
+ 	    if curcmd <> 79 then begin
+ 		getxnext;
+ 		if curcmd <> 31 then begin
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(574)
+ 		    end;
+ 		    printmacroname(arglist, macroname);
+ 		    begin
+ 			helpptr := 3;
+ 			helpline[2] := 575;
+ 			helpline[1] := 576;
+ 			helpline[0] := 577
+ 		    end;
+ 		    if mem[r].hh.lh >= 2392 then begin
+ 			curexp := -30000;
+ 			curtype := 20
+ 		    end else begin
+ 			curexp := 0;
+ 			curtype := 16
+ 		    end;
+ 		    backerror;
+ 		    curcmd := 62;
+ 		    goto 40
+ 		end;
+ 		ldelim := cursym;
+ 		rdelim := curmod
+ 	    end; {729:}
+ 	    if mem[r].hh.lh >= 2542 then 
+ 		scantextarg(ldelim, rdelim)
+ 	    else begin
+ 		getxnext;
+ 		if mem[r].hh.lh >= 2392 then 
+ 		    scansuffix
+ 		else 
+ 		    scanexpression
+ 	    end {:729};
+ 	    if curcmd <> 79 then  {727:}
+ 		if (curcmd <> 62) or (curmod <> ldelim) then 
+ 		    if mem[mem[r].hh.rh].hh.lh >= 2242 then begin
+ 			missingerr(44);
+ 			begin
+ 			    helpptr := 3;
+ 			    helpline[2] := 578;
+ 			    helpline[1] := 579;
+ 			    helpline[0] := 573
+ 			end;
+ 			backerror;
+ 			curcmd := 79
+ 		    end else begin
+ 			missingerr(hash[rdelim].rh);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 580;
+ 			    helpline[0] := 573
+ 			end;
+ 			backerror
+ 		    end {:727};
+     40: {728:}
+ 	    begin
+ 		p := getavail;
+ 		if curtype = 20 then 
+ 		    mem[p].hh.lh := curexp
+ 		else 
+ 		    mem[p].hh.lh := stashcurexp;
+ 		if internal[9] > 0 then begin
+ 		    begindiagnostic;
+ 		    printarg(mem[p].hh.lh, n, mem[r].hh.lh);
+ 		    enddiagnostic(false)
+ 		end;
+ 		if arglist = (-30000) then 
+ 		    arglist := p
+ 		else 
+ 		    mem[tail].hh.rh := p;
+ 		tail := p;
+ 		n := n + 1
+ 	    end {:728} {:726};
+ 	    r := mem[r].hh.rh
+ 	end;
+ 	if curcmd = 79 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(569)
+ 	    end;
+ 	    printmacroname(arglist, macroname);
+ 	    printchar(59);
+ 	    printnl(570);
+ 	    print(hash[rdelim].rh);
+ 	    print(170);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 571;
+ 		helpline[1] := 572;
+ 		helpline[0] := 573
+ 	    end;
+ 	    error
+ 	end;
+ 	if mem[r].hh.lh <> 0 then begin {733:}
+ 	    if mem[r].hh.lh < 7 then begin
+ 		getxnext;
+ 		if mem[r].hh.lh <> 6 then 
+ 		    if (curcmd = 51) or (curcmd = 77) then 
+ 			getxnext
+ 	    end;
+ 	    case mem[r].hh.lh of
+ 		1:
+ 		    scanprimary;
+ 		2:
+ 		    scansecondary;
+ 		3:
+ 		    scantertiary;
+ 		4:
+ 		    scanexpression;
+ 		5:
+ 		    begin {734:}
+ 			scanexpression;
+ 			p := getavail;
+ 			mem[p].hh.lh := stashcurexp;
+ 			if internal[9] > 0 then begin
+ 			    begindiagnostic;
+ 			    printarg(mem[p].hh.lh, n, 0);
+ 			    enddiagnostic(false)
+ 			end;
+ 			if arglist = (-30000) then 
+ 			    arglist := p
+ 			else 
+ 			    mem[tail].hh.rh := p;
+ 			tail := p;
+ 			n := n + 1;
+ 			if curcmd <> 69 then begin
+ 			    missingerr(347);
+ 			    print(581);
+ 			    printmacroname(arglist, macroname);
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 582
+ 			    end;
+ 			    backerror
+ 			end;
+ 			getxnext;
+ 			scanprimary
+ 		    end; {:734}
+ 		6:
+ 		    begin {735:}
+ 			if curcmd <> 31 then 
+ 			    ldelim := -30000
+ 			else begin
+ 			    ldelim := cursym;
+ 			    rdelim := curmod;
+ 			    getxnext
+ 			end;
+ 			scansuffix;
+ 			if ldelim <> (-30000) then begin
+ 			    if (curcmd <> 62) or (curmod <> ldelim) then begin
+ 				missingerr(hash[rdelim].rh);
+ 				begin
+ 				    helpptr := 2;
+ 				    helpline[1] := 580;
+ 				    helpline[0] := 573
+ 				end;
+ 				backerror
+ 			    end;
+ 			    getxnext
+ 			end
+ 		    end; {:735}
+ 		7:
+ 		    scantextarg(0, 0)
+ 	    end;
+ 	    backinput; {728:}
+ 	    begin
+ 		p := getavail;
+ 		if curtype = 20 then 
+ 		    mem[p].hh.lh := curexp
+ 		else 
+ 		    mem[p].hh.lh := stashcurexp;
+ 		if internal[9] > 0 then begin
+ 		    begindiagnostic;
+ 		    printarg(mem[p].hh.lh, n, mem[r].hh.lh);
+ 		    enddiagnostic(false)
+ 		end;
+ 		if arglist = (-30000) then 
+ 		    arglist := p
+ 		else 
+ 		    mem[tail].hh.rh := p;
+ 		tail := p;
+ 		n := n + 1
+ 	    end {:728}
+ 	end {:733};
+ 	r := mem[r].hh.rh {:725}; {736:}
+ 	while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do 
+ 	    endtokenlist;
+ 	if (paramptr + n) > maxparamstack then begin
+ 	    maxparamstack := paramptr + n;
+ 	    if maxparamstack > 150 then 
+ 		overflow(552, 150)
+ 	end;
+ 	begintokenlist(defref, 12);
+ 	curinput.namefield := macroname;
+ 	curinput.locfield := r;
+ 	if n > 0 then begin
+ 	    p := arglist;
+ 	    repeat
+ 		paramstack[paramptr] := mem[p].hh.lh;
+ 		paramptr := paramptr + 1;
+ 		p := mem[p].hh.rh
+ 	    until p = (-30000);
+ 	    flushlist(arglist)
+ 	end {:736}
+     end; {:720}
+ 
+     procedure getboolean;
+     forward;
+ 
+     procedure passtext;
+     forward;
+ 
+     procedure conditional;
+     forward;
+ 
+     procedure startinput;
+     forward;
+ 
+     procedure beginiteration;
+     forward;
+ 
+     procedure resumeiteration;
+     forward;
+ 
+     procedure stopiteration;
+     forward; {:706} {707:}
+ 
+     procedure expand;
+     var
+ 	p: halfword;
+ 	k: integer;
+ 	j: poolpointer;
+     begin
+ 	if internal[7] > 65536 then 
+ 	    if curcmd <> 10 then 
+ 		showcmdmod(curcmd, curmod);
+ 	case curcmd of
+ 	    1:
+ 		conditional;
+ 	    2: {751:}
+ 		if curmod > iflimit then 
+ 		    if iflimit = 1 then begin
+ 			missingerr(58);
+ 			backinput;
+ 			cursym := 2234;
+ 			inserror
+ 		    end else begin
+ 			begin
+ 			    if interaction = 3 then 
+ 				;
+ 			    printnl(133);
+ 			    print(589)
+ 			end;
+ 			printcmdmod(2, curmod);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 590
+ 			end;
+ 			error
+ 		    end
+ 		else begin
+ 		    while curmod <> 2 do 
+ 			passtext;
+ {745:}
+ 		    begin
+ 			p := condptr;
+ 			ifline := mem[p + 1].int;
+ 			curif := mem[p].hh.b1;
+ 			iflimit := mem[p].hh.b0;
+ 			condptr := mem[p].hh.rh;
+ 			freenode(p, 2)
+ 		    end {:745}
+ 		end {:751};
+ 	    3: {711:}
+ 		if curmod > 0 then 
+ 		    forceeof := true
+ 		else  {:711}
+ 		    startinput;
+ 	    4:
+ 		if curmod = 0 then begin {708:}
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(553)
+ 		    end;
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 554;
+ 			helpline[0] := 555
+ 		    end;
+ 		    error
+ 		end else  {:708}
+ 		    beginiteration;
+ 	    5:
+ 		begin {712:}
+ 		    while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do 
+ 			endtokenlist;
+ 		    if loopptr = (-30000) then begin
+ 			begin
+ 			    if interaction = 3 then 
+ 				;
+ 			    printnl(133);
+ 			    print(557)
+ 			end;
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 558;
+ 			    helpline[0] := 559
+ 			end;
+ 			error
+ 		    end else 
+ 			resumeiteration
+ 		end; {:712}
+ 	    6:
+ 		begin {713:}
+ 		    getboolean;
+ 		    if internal[7] > 65536 then 
+ 			showcmdmod(33, curexp);
+ 		    if curexp = 30 then 
+ 			if loopptr = (-30000) then begin
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(560)
+ 			    end;
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 561
+ 			    end;
+ 			    if curcmd = 80 then 
+ 				error
+ 			    else 
+ 				backerror
+ 			end else begin {714:}
+ 			    p := -30000;
+ 			    repeat
+ 				if curinput.indexfield <= 6 then 
+ 				    endfilereading
+ 				else begin
+ 				    if curinput.indexfield <= 8 then 
+ 					p := curinput.startfield;
+ 				    endtokenlist
+ 				end
+ 			    until p <> (-30000);
+ 			    if p <> mem[loopptr].hh.lh then 
+ 				fatalerror(564);
+ 			    stopiteration
+ 			end {:714}
+ 		    else if curcmd <> 80 then begin
+ 			missingerr(59);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 562;
+ 			    helpline[0] := 563
+ 			end;
+ 			backerror
+ 		    end
+ 		end; {:713}
+ 	    7:
+ 		;
+ 	    9:
+ 		begin {715:}
+ 		    getnext;
+ 		    p := curtok;
+ 		    getnext;
+ 		    if curcmd < 11 then 
+ 			expand
+ 		    else 
+ 			backinput;
+ 		    begintokenlist(p, 10)
+ 		end; {:715}
+ 	    8:
+ 		begin {716:}
+ 		    getxnext;
+ 		    scanprimary;
+ 		    if curtype <> 4 then begin
+ 			disperr(-30000, 565);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 566;
+ 			    helpline[0] := 567
+ 			end;
+ 			putgetflusherror(0)
+ 		    end else begin
+ 			backinput;
+ 			if (strstart[curexp + 1] - strstart[curexp]) > 0 then begin {717:}
+ 			    beginfilereading;
+ 			    curinput.namefield := 2;
+ 			    k := first + (strstart[curexp + 1] - strstart[curexp]);
+ 			    if k >= maxbufstack then begin
+ 				if k >= bufsize then begin
+ 				    maxbufstack := bufsize;
+ 				    overflow(128, bufsize)
+ 				end;
+ 				maxbufstack := k + 1
+ 			    end;
+ 			    j := strstart[curexp];
+ 			    curinput.limitfield := k;
+ 			    while first < curinput.limitfield do begin
+ 				buffer[first] := strpool[j];
+ 				j := j + 1;
+ 				first := first + 1
+ 			    end;
+ 			    buffer[curinput.limitfield] := 37;
+ 			    first := curinput.limitfield + 1;
+ 			    curinput.locfield := curinput.startfield;
+ 			    flushcurexp(0)
+ 			end {:717}
+ 		    end
+ 		end; {:716}
+ 	    10:
+ 		macrocall(curmod, -30000, cursym)
+ 	end
+     end; {:707} {718:}
+ 
+     procedure getxnext;
+     var
+ 	saveexp: halfword;
+     begin
+ 	getnext;
+ 	if curcmd < 11 then begin
+ 	    saveexp := stashcurexp;
+ 	    repeat
+ 		if curcmd = 10 then 
+ 		    macrocall(curmod, -30000, cursym)
+ 		else 
+ 		    expand;
+ 		getnext
+ 	    until curcmd >= 11;
+ 	    unstashcurexp(saveexp)
+ 	end
+     end; {:718} {737:}
+ 
+     procedure stackargument(p: halfword);
+     begin
+ 	if paramptr = maxparamstack then begin
+ 	    maxparamstack := maxparamstack + 1;
+ 	    if maxparamstack > 150 then 
+ 		overflow(552, 150)
+ 	end;
+ 	paramstack[paramptr] := p;
+ 	paramptr := paramptr + 1
+     end; {:737} {742:}
+ 
+     procedure passtext;
+     label
+ 	30;
+     var
+ 	l: integer;
+     begin
+ 	scannerstatus := 1;
+ 	l := 0;
+ 	warninginfo := line;
+ 	while true do begin
+ 	    getnext;
+ 	    if curcmd <= 2 then 
+ 		if curcmd < 2 then 
+ 		    l := l + 1
+ 		else begin
+ 		    if l = 0 then 
+ 			goto 30;
+ 		    if curmod = 2 then 
+ 			l := l - 1
+ 		end {743:}
+ 	    else if curcmd = 39 then begin
+ 		if strref[curmod] < 127 then 
+ 		    if strref[curmod] > 1 then 
+ 			strref[curmod] := strref[curmod] - 1
+ 		    else 
+ 			flushstring(curmod)
+ 	    end {:743}
+ 	end;
+     30:
+ 	scannerstatus := 0
+     end; {:742} {746:}
+ 
+     procedure changeiflimit(l: smallnumber; p: halfword);
+     label
+ 	10;
+     var
+ 	q: halfword;
+     begin
+ 	if p = condptr then 
+ 	    iflimit := l
+ 	else begin
+ 	    q := condptr;
+ 	    while true do begin
+ 		if q = (-30000) then 
+ 		    confusion(583);
+ 		if mem[q].hh.rh = p then begin
+ 		    mem[q].hh.b0 := l;
+ 		    goto 10
+ 		end;
+ 		q := mem[q].hh.rh
+ 	    end
+ 	end;
+     10:
+ 	
+     end; {:746} {747:}
+ 
+     procedure checkcolon;
+     begin
+ 	if curcmd <> 78 then begin
+ 	    missingerr(58);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 586;
+ 		helpline[0] := 563
+ 	    end;
+ 	    backerror
+ 	end
+     end; {:747} {748:}
+ 
+     procedure conditional;
+     label
+ 	10, 30, 21, 40;
+     var
+ 	savecondptr: halfword;
+ 	newiflimit: 2..4;
+ 	p: halfword; {744:}
+     begin
+ 	begin
+ 	    p := getnode(2);
+ 	    mem[p].hh.rh := condptr;
+ 	    mem[p].hh.b0 := iflimit;
+ 	    mem[p].hh.b1 := curif;
+ 	    mem[p + 1].int := ifline;
+ 	    condptr := p;
+ 	    iflimit := 1;
+ 	    ifline := line;
+ 	    curif := 1
+ 	end {:744};
+ 	savecondptr := condptr;
+     21:
+ 	getboolean;
+ 	newiflimit := 4;
+ 	if internal[7] > 65536 then begin {750:}
+ 	    begindiagnostic;
+ 	    if curexp = 30 then 
+ 		print(587)
+ 	    else 
+ 		print(588);
+ 	    enddiagnostic(false)
+ 	end {:750};
+     40:
+ 	checkcolon;
+ 	if curexp = 30 then begin
+ 	    changeiflimit(newiflimit, savecondptr);
+ 	    goto 10
+ 	end; {749:}
+ 	while true do begin
+ 	    passtext;
+ 	    if condptr = savecondptr then 
+ 		goto 30
+ 	    else if curmod = 2 then begin {745:}
+ 		p := condptr;
+ 		ifline := mem[p + 1].int;
+ 		curif := mem[p].hh.b1;
+ 		iflimit := mem[p].hh.b0;
+ 		condptr := mem[p].hh.rh;
+ 		freenode(p, 2)
+ 	    end {:745}
+ 	end {:749};
+     30:
+ 	curif := curmod;
+ 	ifline := line;
+ 	if curmod = 2 then begin {745:}
+ 	    p := condptr;
+ 	    ifline := mem[p + 1].int;
+ 	    curif := mem[p].hh.b1;
+ 	    iflimit := mem[p].hh.b0;
+ 	    condptr := mem[p].hh.rh;
+ 	    freenode(p, 2)
+ 	end else if curmod = 4 then  {:745}
+ 	    goto 21
+ 	else begin
+ 	    curexp := 30;
+ 	    newiflimit := 2;
+ 	    getxnext;
+ 	    goto 40
+ 	end;
+     10:
+ 	
+     end; {:748} {754:}
+ 
+     procedure badfor(s: strnumber);
+     begin
+ 	disperr(-30000, 591);
+ 	print(s);
+ 	print(177);
+ 	begin
+ 	    helpptr := 4;
+ 	    helpline[3] := 592;
+ 	    helpline[2] := 593;
+ 	    helpline[1] := 594;
+ 	    helpline[0] := 179
+ 	end;
+ 	putgetflusherror(0)
+     end; {:754} {755:}
+ 
+     procedure beginiteration;
+     label
+ 	22, 30, 40;
+     var
+ 	m: halfword;
+ 	n: halfword;
+ 	p, q, s, pp: halfword;
+     begin
+ 	m := curmod;
+ 	n := cursym;
+ 	s := getnode(2);
+ 	if m = 1 then begin
+ 	    mem[s + 1].hh.lh := -29999;
+ 	    p := -30000;
+ 	    getxnext;
+ 	    goto 40
+ 	end;
+ 	getsymbol;
+ 	p := getnode(2);
+ 	mem[p].hh.lh := cursym;
+ 	mem[p + 1].int := m;
+ 	getxnext;
+ 	if (curcmd <> 51) and (curcmd <> 77) then begin
+ 	    missingerr(61);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 595;
+ 		helpline[1] := 538;
+ 		helpline[0] := 596
+ 	    end;
+ 	    backerror
+ 	end;
+ {764:}
+ 	mem[s + 1].hh.lh := -30000;
+ 	q := s + 1;
+ 	mem[q].hh.rh := -30000;
+ 	repeat
+ 	    getxnext;
+ 	    if m <> 2242 then 
+ 		scansuffix
+ 	    else begin
+ 		if curcmd >= 78 then 
+ 		    if curcmd <= 79 then 
+ 			goto 22;
+ 		scanexpression;
+ 		if curcmd = 74 then 
+ 		    if q = (s + 1) then begin {765:}
+ 			if curtype <> 16 then 
+ 			    badfor(602);
+ 			pp := getnode(4);
+ 			mem[pp + 1].int := curexp;
+ 			getxnext;
+ 			scanexpression;
+ 			if curtype <> 16 then 
+ 			    badfor(603);
+ 			mem[pp + 2].int := curexp;
+ 			if curcmd <> 75 then begin
+ 			    missingerr(357);
+ 			    begin
+ 				helpptr := 2;
+ 				helpline[1] := 604;
+ 				helpline[0] := 605
+ 			    end;
+ 			    backerror
+ 			end;
+ 			getxnext;
+ 			scanexpression;
+ 			if curtype <> 16 then 
+ 			    badfor(606);
+ 			mem[pp + 3].int := curexp;
+ 			mem[s + 1].hh.lh := pp;
+ 			goto 30
+ 		    end {:765};
+ 		curexp := stashcurexp
+ 	    end;
+ 	    mem[q].hh.rh := getavail;
+ 	    q := mem[q].hh.rh;
+ 	    mem[q].hh.lh := curexp;
+ 	    curtype := 1;
+     22:
+ 	    
+ 	until curcmd <> 79;
+     30: {:764}
+ 	;
+     40: {756:}
+ 	if curcmd <> 78 then begin
+ 	    missingerr(58);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 597;
+ 		helpline[1] := 598;
+ 		helpline[0] := 599
+ 	    end;
+ 	    backerror
+ 	end {:756}; {758:}
+ 	q := getavail;
+ 	mem[q].hh.lh := 2230;
+ 	scannerstatus := 6;
+ 	warninginfo := n;
+ 	mem[s].hh.lh := scantoks(4, p, q, 0);
+ 	scannerstatus := 0;
+ 	mem[s].hh.rh := loopptr;
+ 	loopptr := s {:758};
+ 	resumeiteration
+     end; {:755} {760:}
+ 
+     procedure resumeiteration;
+     label
+ 	45, 10;
+     var
+ 	p, q: halfword;
+     begin
+ 	p := mem[loopptr + 1].hh.lh;
+ 	if p > (-29999) then begin
+ 	    curexp := mem[p + 1].int; {761:}
+ 	    if ((mem[p + 2].int > 0) and (curexp > mem[p + 3].int)) or ((mem[p + 2].int < 0) and (curexp < mem[p + 3].int)) then  {:761}
+ 		goto 45;
+ 	    curtype := 16;
+ 	    q := stashcurexp;
+ 	    mem[p + 1].int := curexp + mem[p + 2].int
+ 	end else if p < (-29999) then begin
+ 	    p := mem[loopptr + 1].hh.rh;
+ 	    if p = (-30000) then 
+ 		goto 45;
+ 	    mem[loopptr + 1].hh.rh := mem[p].hh.rh;
+ 	    q := mem[p].hh.lh;
+ 	    begin
+ 		mem[p].hh.rh := avail;
+ 		avail := p
+ 	    end {dynused:=dynused-1;}
+ 	end else begin
+ 	    begintokenlist(mem[loopptr].hh.lh, 7);
+ 	    goto 10
+ 	end;
+ 	begintokenlist(mem[loopptr].hh.lh, 8);
+ 	stackargument(q);
+ 	if internal[7] > 65536 then begin {762:}
+ 	    begindiagnostic;
+ 	    printnl(601);
+ 	    if (q <> (-30000)) and (mem[q].hh.rh = (-29999)) then 
+ 		printexp(q, 1)
+ 	    else 
+ 		showtokenlist(q, -30000, 50, 0);
+ 	    printchar(125);
+ 	    enddiagnostic(false)
+ 	end {:762};
+ 	goto 10;
+     45:
+ 	stopiteration;
+     10:
+ 	
+     end; {:760} {763:}
+ 
+     procedure stopiteration;
+     var
+ 	p, q: halfword;
+     begin
+ 	p := mem[loopptr + 1].hh.lh;
+ 	if p > (-29999) then 
+ 	    freenode(p, 4)
+ 	else if p < (-29999) then begin
+ 	    q := mem[loopptr + 1].hh.rh;
+ 	    while q <> (-30000) do begin
+ 		p := mem[q].hh.lh;
+ 		if p <> (-30000) then 
+ 		    if mem[p].hh.rh = (-29999) then begin
+ 			recyclevalue(p);
+ 			freenode(p, 2)
+ 		    end else 
+ 			flushtokenlist(p);
+ 		p := q;
+ 		q := mem[q].hh.rh;
+ 		begin
+ 		    mem[p].hh.rh := avail;
+ 		    avail := p
+ 		end {dynused:=dynused-1;}
+ 	    end
+ 	end;
+ 	p := loopptr;
+ 	loopptr := mem[p].hh.rh;
+ 	flushtokenlist(mem[p].hh.lh);
+ 	freenode(p, 2)
+     end; {:763} {770:}
+ 
+     procedure beginname;
+     begin
+ 	areadelimiter := 0;
+ 	extdelimiter := 0
+     end; {:770} {771:}
+ 
+     function morename(c: ASCIIcode): boolean;
+     begin
+ 	if (c = 32) or (c = 9) then 
+ 	    morename := false
+ 	else begin
+ 	    if c = 47 then begin
+ 		areadelimiter := poolptr;
+ 		extdelimiter := 0
+ 	    end else if (c = 46) and (extdelimiter = 0) then 
+ 		extdelimiter := poolptr;
+ 	    begin
+ 		if (poolptr + 1) > maxpoolptr then begin
+ 		    if (poolptr + 1) > poolsize then 
+ 			overflow(129, poolsize - initpoolptr);
+ 		    maxpoolptr := poolptr + 1
+ 		end
+ 	    end;
+ 	    begin
+ 		strpool[poolptr] := c;
+ 		poolptr := poolptr + 1
+ 	    end;
+ 	    morename := true
+ 	end
+     end; { morename }
+ {:771}
+     {772:}
+ 
+     procedure endname;
+     begin
+ 	if (strptr + 3) > maxstrptr then begin
+ 	    if (strptr + 3) > maxstrings then 
+ 		overflow(130, maxstrings - initstrptr);
+ 	    maxstrptr := strptr + 3
+ 	end;
+ 	if areadelimiter = 0 then 
+ 	    curarea := 155
+ 	else begin
+ 	    curarea := strptr;
+ 	    strptr := strptr + 1;
+ 	    strstart[strptr] := areadelimiter + 1
+ 	end;
+ 	if extdelimiter = 0 then begin
+ 	    curext := 155;
+ 	    curname := makestring
+ 	end else begin
+ 	    curname := strptr;
+ 	    strptr := strptr + 1;
+ 	    strstart[strptr] := extdelimiter;
+ 	    curext := makestring
+ 	end
+     end; {:772} {774:}
+ 
+     procedure packfilename(n, a, e: strnumber);
+     var
+ 	k: integer;
+ 	c: ASCIIcode;
+ 	j: poolpointer;
+     begin
+ 	k := 0;
+ 	for j := strstart[a] to strstart[a + 1] - 1 do begin
+ 	    c := strpool[j];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	for j := strstart[n] to strstart[n + 1] - 1 do begin
+ 	    c := strpool[j];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	for j := strstart[e] to strstart[e + 1] - 1 do begin
+ 	    c := strpool[j];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	if k <= filenamesize then 
+ 	    namelength := k
+ 	else 
+ 	    namelength := filenamesize;
+ 	for k := namelength + 1 to filenamesize do 
+ 	    nameoffile[k] := ' '
+     end; {:774}
+ {778:}
+ 
+     procedure packbufferedname(n: smallnumber; a, b: integer);
+     var
+ 	k: integer;
+ 	c: ASCIIcode;
+ 	j: integer;
+     begin
+ 	if (((n + b) - a) + 6) > filenamesize then 
+ 	    b := ((a + filenamesize) - n) - 6;
+ 	k := 0;
+ 	for j := 1 to n do begin
+ 	    c := xord[MFbasedefault[j]];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	for j := a to b do begin
+ 	    c := buffer[j];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	for j := 6 to 10 do begin
+ 	    c := xord[MFbasedefault[j]];
+ 	    k := k + 1;
+ 	    if k <= filenamesize then 
+ 		nameoffile[k] := xchr[c]
+ 	end;
+ 	if k <= filenamesize then 
+ 	    namelength := k
+ 	else 
+ 	    namelength := filenamesize;
+ 	for k := namelength + 1 to filenamesize do 
+ 	    nameoffile[k] := ' '
+     end; {:778}
+ {780:}
+ 
+     function makenamestring: strnumber;
+     var
+ 	k, kstart: 1..filenamesize;
+     begin
+ 	k := 1;
+ 	while (k < filenamesize) and (xord[realnameoffile[k]] <> 32) do 
+ 	    k := k + 1;
+ 	namelength := k - 1;
+ 	if ((poolptr + namelength) > poolsize) or (strptr = maxstrings) then 
+ 	    makenamestring := 63
+ 	else begin
+ 	    if (xord[realnameoffile[1]] = 46) and (xord[realnameoffile[2]] = 47) then 
+ 		kstart := 3
+ 	    else 
+ 		kstart := 1;
+ 	    for k := kstart to namelength do begin
+ 		strpool[poolptr] := xord[realnameoffile[k]];
+ 		poolptr := poolptr + 1
+ 	    end;
+ 	    makenamestring := makestring
+ 	end
+     end;
+ 
+     function amakenamestring(var f: alphafile): strnumber;
+     begin
+ 	amakenamestring := makenamestring
+     end; { amakenamestring }
+ 
+     function bmakenamestring(var f: bytefile): strnumber;
+     begin
+ 	bgetname(f, realnameoffile);
+ 	bmakenamestring := makenamestring
+     end; { bmakenamestring }
+ 
+     function wmakenamestring(var f: wordfile): strnumber;
+     begin
+ 	wmakenamestring := makenamestring
+     end; {:780} {781:}
+ 
+     procedure scanfilename;
+     label
+ 	30;
+     begin
+ 	beginname;
+ 	while (buffer[curinput.locfield] = 32) or (buffer[curinput.locfield] = 9) do 
+ 	    curinput.locfield := curinput.locfield + 1;
+ 	while true do begin
+ 	    if (buffer[curinput.locfield] = 59) or (buffer[curinput.locfield] = 37) then 
+ 		goto 30;
+ 	    if not morename(buffer[curinput.locfield]) then 
+ 		goto 30;
+ 	    curinput.locfield := curinput.locfield + 1
+ 	end;
+     30:
+ 	endname
+     end; {:781} {784:}
+ 
+     procedure packjobname(s: strnumber);
+     begin
+ 	curarea := 155;
+ 	curext := s;
+ 	curname := jobname;
+ 	packfilename(curname, curarea, curext)
+     end; {:784} {786:}
+ 
+     procedure promptfilename(s, e: strnumber);
+     label
+ 	30;
+     var
+ 	k: 0..bufsize;
+     begin
+ 	if interaction = 2 then 
+ 	    ;
+ 	if s = 607 then begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(608)
+ 	end else begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(609)
+ 	end;
+ 	printfilename(curname, curarea, curext);
+ 	print(610);
+ 	if e = 611 then 
+ 	    showcontext;
+ 	printnl(612);
+ 	print(s);
+ 	if interaction < 2 then 
+ 	    fatalerror(613);
+ 	begin
+ 	    print(614);
+ 	    terminput
+ 	end;
+ {787:}
+ 	begin
+ 	    beginname;
+ 	    k := first;
+ 	    while ((buffer[k] = 32) or (buffer[k] = 9)) and (k < last) do 
+ 		k := k + 1;
+ 	    while true do begin
+ 		if k = last then 
+ 		    goto 30;
+ 		if not morename(buffer[k]) then 
+ 		    goto 30;
+ 		k := k + 1
+ 	    end;
+     30:
+ 	    endname
+ 	end {:787};
+ 	if curext = 155 then 
+ 	    curext := e;
+ 	packfilename(curname, curarea, curext)
+     end; { promptfilename }
+ {:786}
+     {788:}
+ 
+     procedure openlogfile;
+     var
+ 	oldsetting: 0..5;
+ 	k: 0..bufsize;
+ 	l: 0..bufsize;
+ 	m: integer;
+ 	months: packed array [1..36] of char;
+     begin
+ 	oldsetting := selector;
+ 	if jobname = 0 then 
+ 	    jobname := 615;
+ 	packjobname(616);
+ 	while not aopenout(logfile) do begin {789:}
+ 	    if interaction < 2 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(609)
+ 		end;
+ 		printfilename(curname, curarea, curext);
+ 		print(610);
+ 		jobname := 0;
+ 		history := 3;
+ 		jumpout
+ 	    end;
+ 	    promptfilename(618, 616)
+ 	end {:789};
+ 	logname := amakenamestring(logfile);
+ 	selector := 2; {790:}
+ 	begin
+ 	    write(logfile, 'This is METAFONT, Version 1.0 for Berkeley UNIX');
+ 	    print(baseident);
+ 	    print(619);
+ 	    printint(roundunscaled(internal[16]));
+ 	    printchar(32);
+ 	    months := 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+ 	    m := roundunscaled(internal[15]);
+ 	    for k := (3 * m) - 2 to 3 * m do 
+ 		write(logfile, months[k]);
+ 	    printchar(32);
+ 	    printint(roundunscaled(internal[14]));
+ 	    printchar(32);
+ 	    m := roundunscaled(internal[17]);
+ 	    printdd(m div 60);
+ 	    printchar(58);
+ 	    printdd(m mod 60)
+ 	end {:790};
+ 	inputstack[inputptr] := curinput;
+ 	printnl(617);
+ 	l := inputstack[0].limitfield - 1;
+ 	for k := 1 to l do 
+ 	    print(buffer[k]);
+ 	println;
+ 	selector := oldsetting + 2
+     end; {:788} {793:}
+ 
+     procedure startinput;
+     label
+ 	30; {795:}
+     begin
+ 	while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do 
+ 	    endtokenlist;
+ 	if curinput.indexfield > 6 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(621)
+ 	    end;
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 622;
+ 		helpline[1] := 623;
+ 		helpline[0] := 624
+ 	    end;
+ 	    error
+ 	end;
+ 	if curinput.indexfield <= 6 then 
+ 	    scanfilename
+ 	else begin
+ 	    curname := 155;
+ 	    curext := 155;
+ 	    curarea := 155
+ 	end {:795};
+ 	if curext = 155 then 
+ 	    curext := 611;
+ 	packfilename(curname, curarea, curext);
+ 	while true do begin
+ 	    beginfilereading;
+ 	    if aopenin(inputfile[curinput.indexfield], 6) then 
+ 		goto 30;
+ 	    endfilereading;
+ 	    promptfilename(607, 611)
+ 	end;
+     30:
+ 	curinput.namefield := amakenamestring(inputfile[curinput.indexfield]);
+ 	strref[curname] := 127;
+ 	if jobname = 0 then begin
+ 	    jobname := curname;
+ 	    openlogfile
+ 	end;
+ 	if (termoffset + (strstart[curinput.namefield + 1] - strstart[curinput.namefield])) > (maxprintline - 2) then 
+ 	    println
+ 	else if (termoffset > 0) or (fileoffset > 0) then 
+ 	    printchar(32);
+ 	printchar(40);
+ 	print(curinput.namefield);
+ 	flush(output); {794:}
+ 	begin
+ 	    if not inputln(inputfile[curinput.indexfield], false) then 
+ 		;
+ 	    firmuptheline;
+ 	    buffer[curinput.limitfield] := 37;
+ 	    first := curinput.limitfield + 1;
+ 	    curinput.locfield := curinput.startfield;
+ 	    line := 1
+ 	end {:794}
+     end; {:793} {824:}
+ 
+     procedure badexp(s: strnumber);
+     var
+ 	saveflag: 0..82;
+     begin
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(s)
+ 	end;
+ 	print(634);
+ 	printcmdmod(curcmd, curmod);
+ 	printchar(39);
+ 	begin
+ 	    helpptr := 4;
+ 	    helpline[3] := 635;
+ 	    helpline[2] := 636;
+ 	    helpline[1] := 637;
+ 	    helpline[0] := 638
+ 	end;
+ 	backinput;
+ 	cursym := 0;
+ 	curcmd := 42;
+ 	curmod := 0;
+ 	inserror;
+ 	saveflag := varflag;
+ 	varflag := 0;
+ 	getxnext;
+ 	varflag := saveflag
+     end; {:824} {827:}
+ 
+     procedure stashin(p: halfword);
+     var
+ 	q: halfword;
+     begin
+ 	mem[p].hh.b0 := curtype;
+ 	{
+ 	829:}
+ 	if curtype = 16 then 
+ 	    mem[p + 1].int := curexp
+ 	else begin
+ 	    if curtype = 19 then begin
+ 		q := singledependency(curexp);
+ 		if q = depfinal then begin
+ 		    mem[p].hh.b0 := 16;
+ 		    mem[p + 1].int := 0;
+ 		    freenode(q, 2)
+ 		end else begin
+ 		    mem[p].hh.b0 := 17;
+ 		    newdep(p, q)
+ 		end;
+ 		recyclevalue(curexp)
+ 	    end else begin {:829}
+ 		mem[p + 1] := mem[curexp + 1];
+ 		mem[mem[p + 1].hh.lh].hh.rh := p
+ 	    end;
+ 	    freenode(curexp, 2)
+ 	end;
+ 	curtype := 1
+     end; { stashin }
+ {:827}
+     {848:}
+ 
+     procedure backexpr;
+     var
+ 	p: halfword;
+     begin
+ 	p := stashcurexp;
+ 	mem[p].hh.rh := -30000;
+ 	begintokenlist(p, 10)
+     end; {:848} {849:}
+ 
+     procedure badsubscript;
+     begin
+ 	disperr(-30000, 650);
+ 	begin
+ 	    helpptr := 3;
+ 	    helpline[2] := 651;
+ 	    helpline[1] := 652;
+ 	    helpline[0] := 653
+ 	end;
+ 	flusherror(0)
+     end; {:849} {851:}
+ 
+     procedure obliterated(q: halfword);
+     begin
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(654)
+ 	end;
+ 	showtokenlist(q, -30000, 1000, 0);
+ 	print(655);
+ 	begin
+ 	    helpptr := 5;
+ 	    helpline[4] := 656;
+ 	    helpline[3] := 657;
+ 	    helpline[2] := 658;
+ 	    helpline[1] := 659;
+ 	    helpline[0] := 660
+ 	end
+     end; {:851} {863:}
+ 
+     procedure binarymac(p, c, n: halfword);
+     var
+ 	q, r: halfword;
+     begin
+ 	q := getavail;
+ 	r := getavail;
+ 	mem[q].hh.rh := r;
+ 	mem[q].hh.lh := p;
+ 	mem[r].hh.lh := stashcurexp;
+ 	macrocall(c, q, n)
+     end; {:863} {865:}
+ 
+     procedure materializepen;
+     label
+ 	50;
+     var
+ 	aminusb, aplusb, majoraxis, minoraxis: scaled;
+ 	theta: angle;
+ 	p: halfword;
+ 	q: halfword;
+     begin
+ 	q := curexp;
+ 	if mem[q].hh.b0 = 0 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(670)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 671;
+ 		helpline[0] := 442
+ 	    end;
+ 	    putgeterror;
+ 	    curexp := -29997;
+ 	    goto 50
+ 	end else if mem[q].hh.b0 = 4 then begin {866:}
+ 	    tx := mem[q + 1].int;
+ 	    ty := mem[q + 2].int;
+ 	    txx := mem[q + 3].int - tx;
+ 	    tyx := mem[q + 4].int - ty;
+ 	    txy := mem[q + 5].int - tx;
+ 	    tyy := mem[q + 6].int - ty;
+ 	    aminusb := pythadd(txx - tyy, tyx + txy);
+ 	    aplusb := pythadd(txx + tyy, tyx - txy);
+ 	    majoraxis := (aminusb + aplusb) div 2;
+ 	    minoraxis := abs(aplusb - aminusb) div 2;
+ 	    if majoraxis = minoraxis then 
+ 		theta := 0
+ 	    else 
+ 		theta := (narg(txx - tyy, tyx + txy) + narg(txx + tyy, tyx - txy)) div 2;
+ 	    freenode(q, 7);
+ 	    q := makeellipse(majoraxis, minoraxis, theta);
+ 	    if (tx <> 0) or (ty <> 0) then begin {867:}
+ 		p := q;
+ 		repeat
+ 		    mem[p + 1].int := mem[p + 1].int + tx;
+ 		    mem[p + 2].int := mem[p + 2].int + ty;
+ 		    p := mem[p].hh.rh
+ 		until p = q
+ 	    end {:867}
+ 	end {:866};
+ 	curexp := makepen(q);
+     50:
+ 	tossknotlist(q);
+ 	curtype := 6
+     end; {:865}
+ {871:}
+     {872:}
+ 
+     procedure knownpair;
+     var
+ 	p: halfword;
+     begin
+ 	if curtype <> 14 then begin
+ 	    disperr(-30000, 673);
+ 	    begin
+ 		helpptr := 5;
+ 		helpline[4] := 674;
+ 		helpline[3] := 675;
+ 		helpline[2] := 676;
+ 		helpline[1] := 677;
+ 		helpline[0] := 678
+ 	    end;
+ 	    putgetflusherror(0);
+ 	    curx := 0;
+ 	    cury := 0
+ 	end else begin
+ 	    p := mem[curexp + 1].int; {873:}
+ 	    if mem[p].hh.b0 = 16 then 
+ 		curx := mem[p + 1].int
+ 	    else begin
+ 		disperr(p, 679);
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 680;
+ 		    helpline[3] := 675;
+ 		    helpline[2] := 676;
+ 		    helpline[1] := 677;
+ 		    helpline[0] := 678
+ 		end;
+ 		putgeterror;
+ 		recyclevalue(p);
+ 		curx := 0
+ 	    end;
+ 	    if mem[p + 2].hh.b0 = 16 then 
+ 		cury := mem[p + 3].int
+ 	    else begin
+ 		disperr(p + 2, 681);
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 682;
+ 		    helpline[3] := 675;
+ 		    helpline[2] := 676;
+ 		    helpline[1] := 677;
+ 		    helpline[0] := 678
+ 		end;
+ 		putgeterror;
+ 		recyclevalue(p + 2);
+ 		cury := 0
+ 	    end {:873};
+ 	    flushcurexp(0)
+ 	end
+     end; {:872}
+ 
+     function newknot: halfword;
+     var
+ 	q: halfword;
+     begin
+ 	q := getnode(7);
+ 	mem[q].hh.b0 := 0;
+ 	mem[q].hh.b1 := 0;
+ 	mem[q].hh.rh := q;
+ 	knownpair;
+ 	mem[q + 1].int := curx;
+ 	mem[q + 2].int := cury;
+ 	newknot := q
+     end; {:871} {875:}
+ 
+     function scandirection: smallnumber;
+     var
+ 	t: 2..4;
+ 	x: scaled;
+     begin
+ 	getxnext;
+ 	if curcmd = 60 then begin {876:}
+ 	    getxnext;
+ 	    scanexpression;
+ 	    if (curtype <> 16) or (curexp < 0) then begin
+ 		disperr(-30000, 685);
+ 		begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 686
+ 		end;
+ 		putgetflusherror(65536)
+ 	    end;
+ 	    t := 3
+ 	end else begin {:876} {877:}
+ 	    scanexpression;
+ 	    if curtype > 14 then begin {878:}
+ 		if curtype <> 16 then begin
+ 		    disperr(-30000, 679);
+ 		    begin
+ 			helpptr := 5;
+ 			helpline[4] := 680;
+ 			helpline[3] := 675;
+ 			helpline[2] := 676;
+ 			helpline[1] := 677;
+ 			helpline[0] := 678
+ 		    end;
+ 		    putgetflusherror(0)
+ 		end;
+ 		x := curexp;
+ 		if curcmd <> 79 then begin
+ 		    missingerr(44);
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 687;
+ 			helpline[0] := 688
+ 		    end;
+ 		    backerror
+ 		end;
+ 		getxnext;
+ 		scanexpression;
+ 		if curtype <> 16 then begin
+ 		    disperr(-30000, 681);
+ 		    begin
+ 			helpptr := 5;
+ 			helpline[4] := 682;
+ 			helpline[3] := 675;
+ 			helpline[2] := 676;
+ 			helpline[1] := 677;
+ 			helpline[0] := 678
+ 		    end;
+ 		    putgetflusherror(0)
+ 		end;
+ 		cury := curexp;
+ 		curx := x
+ 	    end else  {:878}
+ 		knownpair;
+ 	    if (curx = 0) and (cury = 0) then 
+ 		t := 4
+ 	    else begin
+ 		t := 2;
+ 		curexp := narg(curx, cury)
+ 	    end
+ 	end {:877};
+ 	if curcmd <> 65 then begin
+ 	    missingerr(125);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 683;
+ 		helpline[1] := 684;
+ 		helpline[0] := 563
+ 	    end;
+ 	    backerror
+ 	end;
+ 	getxnext;
+ 	scandirection := t
+     end; {:875} {895:}
+ 
+     procedure donullary(c: quarterword);
+     var
+ 	k: integer;
+     begin
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	if internal[7] > 131072 then 
+ 	    showcmdmod(33, c);
+ 	case c of
+ 	    30, 31:
+ 		begin
+ 		    curtype := 2;
+ 		    curexp := c
+ 		end;
+ 	    32:
+ 		begin
+ 		    curtype := 11;
+ 		    curexp := getnode(6);
+ 		    initedges(curexp)
+ 		end;
+ 	    33:
+ 		begin
+ 		    curtype := 6;
+ 		    curexp := -29997
+ 		end;
+ 	    37:
+ 		begin
+ 		    curtype := 16;
+ 		    curexp := normrand
+ 		end;
+ 	    36:
+ 		begin {896:}
+ 		    curtype := 8;
+ 		    curexp := getnode(7);
+ 		    mem[curexp].hh.b0 := 4;
+ 		    mem[curexp].hh.b1 := 4;
+ 		    mem[curexp].hh.rh := curexp;
+ 		    mem[curexp + 1].int := 0;
+ 		    mem[curexp + 2].int := 0;
+ 		    mem[curexp + 3].int := 65536;
+ 		    mem[curexp + 4].int := 0;
+ 		    mem[curexp + 5].int := 0;
+ 		    mem[curexp + 6].int := 65536
+ 		end; {:896}
+ 	    34:
+ 		begin
+ 		    if jobname = 0 then 
+ 			openlogfile;
+ 		    curtype := 4;
+ 		    curexp := jobname
+ 		end;
+ 	    35:
+ 		begin {897:}
+ 		    if interaction <= 1 then 
+ 			fatalerror(699);
+ 		    beginfilereading;
+ 		    curinput.namefield := 1;
+ 		    begin
+ 			print(155);
+ 			terminput
+ 		    end;
+ 		    begin
+ 			if ((poolptr + last) - curinput.startfield) > maxpoolptr then begin
+ 			    if ((poolptr + last) - curinput.startfield) > poolsize then 
+ 				overflow(129, poolsize - initpoolptr);
+ 			    maxpoolptr := (poolptr + last) - curinput.startfield
+ 			end
+ 		    end;
+ 		    for k := curinput.startfield to last - 1 do begin
+ 			strpool[poolptr] := buffer[k];
+ 			poolptr := poolptr + 1
+ 		    end;
+ 		    endfilereading;
+ 		    curtype := 4;
+ 		    curexp := makestring
+ 		end
+ 	end {:897};
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end
+     end; {:895} {898:}
+ {899:}
+ 
+     function nicepair(p: integer; t: quarterword): boolean;
+     label
+ 	10;
+     begin
+ 	if t = 14 then begin
+ 	    p := mem[p + 1].int;
+ 	    if mem[p].hh.b0 = 16 then 
+ 		if mem[p + 2].hh.b0 = 16 then begin
+ 		    nicepair := true;
+ 		    goto 10
+ 		end
+ 	end;
+ 	nicepair := false;
+     10:
+ 	
+     end; {:899} {900:}
+ 
+     procedure printknownorunknownt(t: smallnumber; v: integer);
+     begin
+ 	printchar(40);
+ 	if t < 17 then 
+ 	    if t <> 14 then 
+ 		printtype(t)
+ 	    else if nicepair(v, 14) then 
+ 		print(207)
+ 	    else 
+ 		print(700)
+ 	else 
+ 	    print(701);
+ 	printchar(41)
+     end; {:900} {901:}
+ 
+     procedure badunary(c: quarterword);
+     begin
+ 	disperr(-30000, 702);
+ 	printop(c);
+ 	printknownorunknownt(curtype, curexp);
+ 	begin
+ 	    helpptr := 3;
+ 	    helpline[2] := 703;
+ 	    helpline[1] := 704;
+ 	    helpline[0] := 705
+ 	end;
+ 	putgeterror
+     end; {:901} {904:}
+ 
+     procedure negatedeplist(p: halfword);
+     label
+ 	10;
+     begin
+ 	while true do begin
+ 	    mem[p + 1].int := -mem[p + 1].int;
+ 	    if mem[p].hh.lh = (-30000) then 
+ 		goto 10;
+ 	    p := mem[p].hh.rh
+ 	end;
+     10:
+ 	
+     end; {:904}
+ {908:}
+ 
+     procedure pairtopath;
+     begin
+ 	curexp := newknot;
+ 	curtype := 9
+     end; {:908}
+ {910:}
+ 
+     procedure takepart(c: quarterword);
+     var
+ 	p: halfword;
+     begin
+ 	p := mem[curexp + 1].int;
+ 	mem[-29982].int := p;
+ 	mem[-29983].hh.b0 := curtype;
+ 	mem[p].hh.rh := -29983;
+ 	freenode(curexp, 2);
+ 	makeexpcopy(p + (2 * (c - 53)));
+ 	recyclevalue(-29983)
+     end; {:910} {913:}
+ 
+     procedure strtonum(c: quarterword);
+     var
+ 	n: integer;
+ 	m: ASCIIcode;
+ 	k: poolpointer;
+ 	b: 8..16;
+ 	badchar: boolean;
+     begin
+ 	if c = 49 then 
+ 	    if (strstart[curexp + 1] - strstart[curexp]) = 0 then 
+ 		n := -1
+ 	    else 
+ 		n := strpool[strstart[curexp]]
+ 	else begin
+ 	    if c = 47 then 
+ 		b := 8
+ 	    else 
+ 		b := 16;
+ 	    n := 0;
+ 	    badchar := false;
+ 	    for k := strstart[curexp] to strstart[curexp + 1] - 1 do begin
+ 		m := strpool[k];
+ 		if (m >= 48) and (m <= 57) then 
+ 		    m := m - 48
+ 		else if (m >= 65) and (m <= 70) then 
+ 		    m := m - 55
+ 		else if (m >= 97) and (m <= 102) then 
+ 		    m := m - 87
+ 		else begin
+ 		    badchar := true;
+ 		    m := 0
+ 		end;
+ 		if m >= b then begin
+ 		    badchar := true;
+ 		    m := 0
+ 		end;
+ 		if n < (32768 div b) then 
+ 		    n := (n * b) + m
+ 		else 
+ 		    n := 32767
+ 	    end; {914:}
+ 	    if badchar then begin
+ 		disperr(-30000, 707);
+ 		if c = 47 then begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 708
+ 		end else begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 709
+ 		end;
+ 		putgeterror
+ 	    end;
+ 	    if n > 4095 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(710)
+ 		end;
+ 		printint(n);
+ 		printchar(41);
+ 		begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 711
+ 		end;
+ 		putgeterror
+ 	    end {:914}
+ 	end;
+ 	flushcurexp(n * 65536)
+     end; { strtonum }
+ {:913}
+     {916:}
+ 
+     function pathlength: scaled;
+     var
+ 	n: scaled;
+ 	p: halfword;
+     begin
+ 	p := curexp;
+ 	if mem[p].hh.b0 = 0 then 
+ 	    n := -65536
+ 	else 
+ 	    n := 0;
+ 	repeat
+ 	    p := mem[p].hh.rh;
+ 	    n := n + 65536
+ 	until p = curexp;
+ 	pathlength := n
+     end; { pathlength }
+ {:916}
+     {919:}
+ 
+     procedure testknown(c: quarterword);
+     label
+ 	30;
+     var
+ 	b: 30..31;
+ 	p, q: halfword;
+     begin
+ 	b := 31;
+ 	if curtype in
+ 	    [1, 2, 4, 6, 8, 9, 11, 16,
+ 	     13, 14] then
+ 	    case curtype of
+ 		1, 2, 4, 6, 8, 9, 11,
+ 		16:
+ 		    b := 30;
+ 		13, 14:
+ 		    begin
+ 			p := mem[curexp + 1].int;
+ 			q := p + bignodesize[curtype];
+ 			repeat
+ 			    q := q - 2;
+ 			    if mem[q].hh.b0 <> 16 then 
+ 				goto 30
+ 			until q = p;
+ 			b := 30;
+     30:
+ 			
+ 		    end
+ 	    end
+ 	else
+ 	    ;
+ 	if c = 39 then 
+ 	    flushcurexp(b)
+ 	else 
+ 	    flushcurexp(61 - b);
+ 	curtype := 2
+     end; {:919}
+ 
+     procedure dounary(c: quarterword);
+     var
+ 	p, q: halfword;
+ 	x: integer;
+     begin
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	if internal[7] > 131072 then begin {902:}
+ 	    begindiagnostic;
+ 	    printnl(123);
+ 	    printop(c);
+ 	    printchar(40);
+ 	    printexp(-30000, 0);
+ 	    print(706);
+ 	    enddiagnostic(false)
+ 	end {:902};
+ 	case c of
+ 	    69:
+ 		if curtype < 14 then 
+ 		    if curtype <> 11 then 
+ 			badunary(69);
+ 	    70: {903:}
+ 		if curtype in
+ 		    [14, 19, 17, 18, 16, 11] then
+ 		    case curtype of
+ 			14, 19:
+ 			    begin
+ 				q := curexp;
+ 				makeexpcopy(q);
+ 				if curtype = 17 then 
+ 				    negatedeplist(mem[curexp + 1].hh.rh)
+ 				else if curtype = 14 then begin
+ 				    p := mem[curexp + 1].int;
+ 				    if mem[p].hh.b0 = 16 then 
+ 					mem[p + 1].int := -mem[p + 1].int
+ 				    else 
+ 					negatedeplist(mem[p + 1].hh.rh);
+ 				    if mem[p + 2].hh.b0 = 16 then 
+ 					mem[p + 3].int := -mem[p + 3].int
+ 				    else 
+ 					negatedeplist(mem[p + 3].hh.rh)
+ 				end;
+ 				recyclevalue(q);
+ 				freenode(q, 2)
+ 			    end;
+ 			17, 18:
+ 			    negatedeplist(mem[curexp + 1].hh.rh);
+ 			16:
+ 			    curexp := -curexp;
+ 			11:
+ 			    negateedges(curexp)
+ 		    end
+ 		else
+ 		    badunary(70) {:903}; {905:}
+ 	    41:
+ 		if curtype <> 2 then 
+ 		    badunary(41)
+ 		else 
+ 		    curexp := 61 - curexp; {:905} {906:}
+ 	    59, 60, 61, 62, 63, 64, 65,
+ 	    38, 66:
+ 		if curtype <> 16 then 
+ 		    badunary(c)
+ 		else 
+ 		    case c of
+ 			59:
+ 			    curexp := squarert(curexp);
+ 			60:
+ 			    curexp := mexp(curexp);
+ 			61:
+ 			    curexp := mlog(curexp);
+ 			62, 63:
+ 			    begin
+ 				nsincos((curexp mod 23592960) * 16);
+ 				if c = 62 then 
+ 				    curexp := roundfraction(nsin)
+ 				else 
+ 				    curexp := roundfraction(ncos)
+ 			    end;
+ 			64:
+ 			    curexp := floorscaled(curexp);
+ 			65:
+ 			    curexp := unifrand(curexp);
+ 			38:
+ 			    begin
+ 				if odd(roundunscaled(curexp)) then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 				curtype := 2
+ 			    end;
+ 			66:
+ 			    begin {1181:}
+ 				curexp := roundunscaled(curexp) mod 256;
+ 				if curexp < 0 then 
+ 				    curexp := curexp + 256;
+ 				if charexists[curexp] then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 				curtype := 2
+ 			    end
+ 		    end {:1181}; {:906} {907:}
+ 	    67:
+ 		if nicepair(curexp, curtype) then begin
+ 		    p := mem[curexp + 1].int;
+ 		    x := narg(mem[p + 1].int, mem[p + 3].int);
+ 		    if x >= 0 then 
+ 			flushcurexp((x + 8) div 16)
+ 		    else 
+ 			flushcurexp(-(((-x) + 8) div 16))
+ 		end else 
+ 		    badunary(67); {:907} {909:}
+ 	    53, 54:
+ 		if (curtype <= 14) and (curtype >= 13) then 
+ 		    takepart(c)
+ 		else 
+ 		    badunary(c);
+ 	    55, 56, 57, 58:
+ 		if curtype = 13 then 
+ 		    takepart(c)
+ 		else 
+ 		    badunary(c); {:909} {912:}
+ 	    50:
+ 		if curtype <> 16 then 
+ 		    badunary(50)
+ 		else begin
+ 		    curexp := roundunscaled(curexp) mod 128;
+ 		    curtype := 4;
+ 		    if curexp < 0 then 
+ 			curexp := curexp + 128;
+ 		    if (strstart[curexp + 1] - strstart[curexp]) <> 1 then begin
+ 			begin
+ 			    if (poolptr + 1) > maxpoolptr then begin
+ 				if (poolptr + 1) > poolsize then 
+ 				    overflow(129, poolsize - initpoolptr);
+ 				maxpoolptr := poolptr + 1
+ 			    end
+ 			end;
+ 			begin
+ 			    strpool[poolptr] := curexp;
+ 			    poolptr := poolptr + 1
+ 			end;
+ 			curexp := makestring
+ 		    end
+ 		end;
+ 	    42:
+ 		if curtype <> 16 then 
+ 		    badunary(42)
+ 		else begin
+ 		    oldsetting := selector;
+ 		    selector := 5;
+ 		    printscaled(curexp);
+ 		    curexp := makestring;
+ 		    selector := oldsetting;
+ 		    curtype := 4
+ 		end;
+ 	    47, 48, 49:
+ 		if curtype <> 4 then 
+ 		    badunary(c)
+ 		else 
+ 		    strtonum(c);
+ {:912}
+ 	    {915:}
+ 	    51:
+ 		if curtype = 4 then 
+ 		    flushcurexp((strstart[curexp + 1] - strstart[curexp]) * 65536)
+ 		else if curtype = 9 then 
+ 		    flushcurexp(pathlength)
+ 		else if curtype = 16 then 
+ 		    curexp := abs(curexp)
+ 		else if nicepair(curexp, curtype) then 
+ 		    flushcurexp(pythadd(mem[mem[curexp + 1].int + 1].int, mem[mem[curexp + 1].int + 3].int))
+ 		else 
+ 		    badunary(c); {:915} {917:}
+ 	    52:
+ 		if curtype = 14 then 
+ 		    flushcurexp(0)
+ 		else if curtype <> 9 then 
+ 		    badunary(52)
+ 		else if mem[curexp].hh.b0 = 0 then 
+ 		    flushcurexp(0)
+ 		else begin
+ 		    curpen := -29997;
+ 		    curpathtype := 1;
+ 		    curexp := makespec(curexp, -1879080960, 0);
+ 		    flushcurexp(turningnumber * 65536)
+ 		end; {:917} {918:}
+ 	    2:
+ 		begin
+ 		    if (curtype >= 2) and (curtype <= 3) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    4:
+ 		begin
+ 		    if (curtype >= 4) and (curtype <= 5) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    6:
+ 		begin
+ 		    if (curtype >= 6) and (curtype <= 8) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    9:
+ 		begin
+ 		    if (curtype >= 9) and (curtype <= 10) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    11:
+ 		begin
+ 		    if (curtype >= 11) and (curtype <= 12) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    13, 14:
+ 		begin
+ 		    if curtype = c then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    15:
+ 		begin
+ 		    if (curtype >= 16) and (curtype <= 19) then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end;
+ 	    39, 40:
+ 		testknown(c); {:918} {920:}
+ 	    68:
+ 		begin
+ 		    if curtype <> 9 then 
+ 			flushcurexp(31)
+ 		    else if mem[curexp].hh.b0 <> 0 then 
+ 			flushcurexp(30)
+ 		    else 
+ 			flushcurexp(31);
+ 		    curtype := 2
+ 		end; {:920} {921:}
+ 	    45:
+ 		begin
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if curtype = 9 then 
+ 			curtype := 8
+ 		    else 
+ 			badunary(45)
+ 		end;
+ 	    44:
+ 		begin
+ 		    if curtype = 8 then 
+ 			materializepen;
+ 		    if curtype <> 6 then 
+ 			badunary(44)
+ 		    else begin
+ 			flushcurexp(makepath(curexp));
+ 			curtype := 9
+ 		    end
+ 		end;
+ 	    46:
+ 		if curtype <> 11 then 
+ 		    badunary(46)
+ 		else 
+ 		    flushcurexp(totalweight(curexp));
+ 	    43:
+ 		if curtype = 9 then begin
+ 		    p := htapypoc(curexp);
+ 		    if mem[p].hh.b1 = 0 then 
+ 			p := mem[p].hh.rh;
+ 		    tossknotlist(curexp);
+ 		    curexp := p
+ 		end else if curtype = 14 then 
+ 		    pairtopath
+ 		else 
+ 		    badunary(43)
+ 	end {:921};
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end
+     end; {:898} {922:} {923:}
+ 
+     procedure badbinary(p: halfword; c: quarterword);
+     begin
+ 	disperr(p, 155);
+ 	disperr(-30000, 702);
+ 	if c >= 94 then 
+ 	    printop(c);
+ 	printknownorunknownt(mem[p].hh.b0, p);
+ 	if c >= 94 then 
+ 	    print(347)
+ 	else 
+ 	    printop(c);
+ 	printknownorunknownt(curtype, curexp);
+ 	begin
+ 	    helpptr := 3;
+ 	    helpline[2] := 703;
+ 	    helpline[1] := 712;
+ 	    helpline[0] := 713
+ 	end;
+ 	putgeterror
+     end; {:923} {928:}
+ 
+     function tarnished(p: halfword): halfword;
+     label
+ 	10;
+     var
+ 	q: halfword;
+ 	r: halfword;
+     begin
+ 	q := mem[p + 1].int;
+ 	r := q + bignodesize[mem[p].hh.b0];
+ 	repeat
+ 	    r := r - 2;
+ 	    if mem[r].hh.b0 = 19 then begin
+ 		tarnished := -29999;
+ 		goto 10
+ 	    end
+ 	until r = q;
+ 	tarnished := -30000;
+     10:
+ 	
+     end; {:928} {930:} {935:}
+ 
+     procedure depfinish(v, q: halfword; t: smallnumber);
+     var
+ 	p: halfword;
+ 	vv: scaled;
+     begin
+ 	if q = (-30000) then 
+ 	    p := curexp
+ 	else 
+ 	    p := q;
+ 	mem[p + 1].hh.rh := v;
+ 	mem[p].hh.b0 := t;
+ 	if mem[v].hh.lh = (-30000) then begin
+ 	    vv := mem[v + 1].int;
+ 	    if q = (-30000) then 
+ 		flushcurexp(vv)
+ 	    else begin
+ 		recyclevalue(p);
+ 		mem[q].hh.b0 := 16;
+ 		mem[q + 1].int := vv
+ 	    end
+ 	end else if q = (-30000) then 
+ 	    curtype := t;
+ 	if fixneeded then 
+ 	    fixdependencies
+     end; {:935}
+ 
+     procedure addorsubtract(p, q: halfword; c: quarterword);
+     label
+ 	30, 10;
+     var
+ 	s, t: smallnumber;
+ 	r: halfword;
+ 	v: integer;
+     begin
+ 	if q = (-30000) then begin
+ 	    t := curtype;
+ 	    if t < 17 then 
+ 		v := curexp
+ 	    else 
+ 		v := mem[curexp + 1].hh.rh
+ 	end else begin
+ 	    t := mem[q].hh.b0;
+ 	    if t < 17 then 
+ 		v := mem[q + 1].int
+ 	    else 
+ 		v := mem[q + 1].hh.rh
+ 	end;
+ 	if t = 16 then begin
+ 	    if c = 70 then 
+ 		v := -v;
+ 	    if mem[p].hh.b0 = 16 then begin
+ 		v := slowadd(mem[p + 1].int, v);
+ 		if q = (-30000) then 
+ 		    curexp := v
+ 		else 
+ 		    mem[q + 1].int := v;
+ 		goto 10
+ 	    end; {931:}
+ 	    r := mem[p + 1].hh.rh;
+ 	    while mem[r].hh.lh <> (-30000) do 
+ 		r := mem[r].hh.rh;
+ 	    mem[r + 1].int := slowadd(mem[r + 1].int, v);
+ 	    if q = (-30000) then begin
+ 		q := getnode(2);
+ 		curexp := q;
+ 		curtype := mem[p].hh.b0;
+ 		mem[q].hh.b1 := 11
+ 	    end;
+ 	    mem[q + 1].hh.rh := mem[p + 1].hh.rh;
+ 	    mem[q].hh.b0 := mem[p].hh.b0;
+ 	    mem[q + 1].hh.lh := mem[p + 1].hh.lh;
+ 	    mem[mem[p + 1].hh.lh].hh.rh := q;
+ 	    mem[p].hh.b0 := 16
+ 	end else begin {:931}
+ 	    if c = 70 then 
+ 		negatedeplist(v); {932:}
+ 	    if mem[p].hh.b0 = 16 then begin {933:}
+ 		while mem[v].hh.lh <> (-30000) do 
+ 		    v := mem[v].hh.rh;
+ 		mem[v + 1].int := slowadd(mem[p + 1].int, mem[v + 1].int)
+ 	    end else begin {:933}
+ 		s := mem[p].hh.b0;
+ 		r := mem[p + 1].hh.rh;
+ 		if t = 17 then begin
+ 		    if s = 17 then 
+ 			if (maxcoef(r) + maxcoef(v)) < 626349397 then begin
+ 			    v := pplusq(v, r, 17);
+ 			    goto 30
+ 			end;
+ 		    t := 18;
+ 		    v := poverv(v, 65536, 17, 18)
+ 		end;
+ 		if s = 18 then 
+ 		    v := pplusq(v, r, 18)
+ 		else 
+ 		    v := pplusfq(v, 65536, r, 18, 17);
+     30: {934:}
+ 		if q <> (-30000) then 
+ 		    depfinish(v, q, t)
+ 		else begin
+ 		    curtype := t;
+ 		    depfinish(v, -30000, t)
+ 		end {:934}
+ 	    end {:932}
+ 	end;
+     10:
+ 	
+     end; {:930} {943:}
+ 
+     procedure depmult(p: halfword; v: integer; visscaled: boolean);
+     label
+ 	10;
+     var
+ 	q: halfword;
+ 	s, t: smallnumber;
+     begin
+ 	if p = (-30000) then 
+ 	    q := curexp
+ 	else if mem[p].hh.b0 <> 16 then 
+ 	    q := p
+ 	else begin
+ 	    if visscaled then 
+ 		mem[p + 1].int := takescaled(mem[p + 1].int, v)
+ 	    else 
+ 		mem[p + 1].int := takefraction(mem[p + 1].int, v);
+ 	    goto 10
+ 	end;
+ 	t := mem[q].hh.b0;
+ 	q := mem[q + 1].hh.rh;
+ 	s := t;
+ 	if t = 17 then 
+ 	    if visscaled then 
+ 		if abvscd(maxcoef(q), abs(v), 626349396, 65536) >= 0 then 
+ 		    t := 18;
+ 	q := ptimesv(q, v, s, t, visscaled);
+ 	depfinish(q, p, t);
+     10:
+ 	
+     end; {:943} {946:}
+ 
+     procedure hardtimes(p: halfword);
+     var
+ 	q: halfword;
+ 	r: halfword;
+ 	u, v: scaled;
+     begin
+ 	if mem[p].hh.b0 = 14 then begin
+ 	    q := stashcurexp;
+ 	    unstashcurexp(p);
+ 	    p := q
+ 	end;
+ 	r := mem[curexp + 1].int;
+ 	u := mem[r + 1].int;
+ 	v := mem[r + 3].int; {947:}
+ 	mem[r + 2].hh.b0 := mem[p].hh.b0;
+ 	newdep(r + 2, copydeplist(mem[p + 1].hh.rh));
+ 	mem[r].hh.b0 := mem[p].hh.b0;
+ 	mem[r + 1] := mem[p + 1];
+ 	mem[mem[p + 1].hh.lh].hh.rh := r;
+ 	freenode(p, 2) {:947};
+ 	depmult(r, u, true);
+ 	depmult(r + 2, v, true)
+     end; {:946} {949:}
+ 
+     procedure depdiv(p: halfword; v: scaled);
+     label
+ 	10;
+     var
+ 	q: halfword;
+ 	s, t: smallnumber;
+     begin
+ 	if p = (-30000) then 
+ 	    q := curexp
+ 	else if mem[p].hh.b0 <> 16 then 
+ 	    q := p
+ 	else begin
+ 	    mem[p + 1].int := makescaled(mem[p + 1].int, v);
+ 	    goto 10
+ 	end;
+ 	t := mem[q].hh.b0;
+ 	q := mem[q + 1].hh.rh;
+ 	s := t;
+ 	if t = 17 then 
+ 	    if abvscd(maxcoef(q), 65536, 626349396, abs(v)) >= 0 then 
+ 		t := 18;
+ 	q := poverv(q, v, s, t);
+ 	depfinish(q, p, t);
+     10:
+ 	
+     end; {:949} {953:}
+ 
+     procedure setuptrans(c: quarterword);
+     label
+ 	30, 10;
+     var
+ 	p, q, r: halfword;
+     begin
+ 	if (c <> 88) or (curtype <> 13) then begin {955:}
+ 	    p := stashcurexp;
+ 	    curexp := idtransform;
+ 	    curtype := 13;
+ 	    q := mem[curexp + 1].int;
+ 	    case c of {957:}
+ 		84:
+ 		    if mem[p].hh.b0 = 16 then begin {958:}
+ 			nsincos((mem[p + 1].int mod 23592960) * 16);
+ 			mem[q + 5].int := roundfraction(ncos);
+ 			mem[q + 9].int := roundfraction(nsin);
+ 			mem[q + 7].int := -mem[q + 9].int;
+ 			mem[q + 11].int := mem[q + 5].int;
+ 			goto 30
+ 		    end {:958};
+ 		85:
+ 		    if mem[p].hh.b0 > 14 then begin
+ 			install(q + 6, p);
+ 			goto 30
+ 		    end;
+ 		86:
+ 		    if mem[p].hh.b0 > 14 then begin
+ 			install(q + 4, p);
+ 			install(q + 10, p);
+ 			goto 30
+ 		    end;
+ 		87:
+ 		    if mem[p].hh.b0 = 14 then begin
+ 			r := mem[p + 1].int;
+ 			install(q, r);
+ 			install(q + 2, r + 2);
+ 			goto 30
+ 		    end;
+ 		89:
+ 		    if mem[p].hh.b0 > 14 then begin
+ 			install(q + 4, p);
+ 			goto 30
+ 		    end;
+ 		90:
+ 		    if mem[p].hh.b0 > 14 then begin
+ 			install(q + 10, p);
+ 			goto 30
+ 		    end;
+ 		91:
+ 		    if mem[p].hh.b0 = 14 then begin {959:}
+ 			r := mem[p + 1].int;
+ 			install(q + 4, r);
+ 			install(q + 10, r);
+ 			install(q + 8, r + 2);
+ 			if mem[r + 2].hh.b0 = 16 then 
+ 			    mem[r + 3].int := -mem[r + 3].int
+ 			else 
+ 			    negatedeplist(mem[r + 3].hh.rh);
+ 			install(q + 6, r + 2);
+ 			goto 30
+ 		    end {:959};
+ 		88:
+ 		    
+ 	    end {:957};
+ 	    disperr(p, 722);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 723;
+ 		helpline[1] := 724;
+ 		helpline[0] := 405
+ 	    end;
+ 	    putgeterror;
+     30:
+ 	    recyclevalue(p);
+ 	    freenode(p, 2)
+ 	end {:955}; {956:}
+ 	q := mem[curexp + 1].int;
+ 	r := q + 12;
+ 	repeat
+ 	    r := r - 2;
+ 	    if mem[r].hh.b0 <> 16 then 
+ 		goto 10
+ 	until r = q;
+ 	txx := mem[q + 5].int;
+ 	txy := mem[q + 7].int;
+ 	tyx := mem[q + 9].int;
+ 	tyy := mem[q + 11].int;
+ 	tx := mem[q + 1].int;
+ 	ty := mem[q + 3].int;
+ 	flushcurexp(0) {:956};
+     10:
+ 	
+     end; {:953} {960:}
+ 
+     procedure setupknowntrans(c: quarterword);
+     begin
+ 	setuptrans(c);
+ 	if curtype <> 16 then begin
+ 	    disperr(-30000, 725);
+ 	    begin
+ 		helpptr := 3;
+ 		helpline[2] := 726;
+ 		helpline[1] := 727;
+ 		helpline[0] := 405
+ 	    end;
+ 	    putgetflusherror(0);
+ 	    txx := 65536;
+ 	    txy := 0;
+ 	    tyx := 0;
+ 	    tyy := 65536;
+ 	    tx := 0;
+ 	    ty := 0
+ 	end
+     end; {:960} {961:}
+ 
+     procedure trans(p, q: halfword);
+     var
+ 	v: scaled;
+     begin
+ 	v := (takescaled(mem[p].int, txx) + takescaled(mem[q].int, txy)) + tx;
+ 	mem[q].int := (takescaled(mem[p].int, tyx) + takescaled(mem[q].int, tyy)) + ty;
+ 	mem[p].int := v
+     end; {:961} {962:}
+ 
+     procedure pathtrans(p: halfword; c: quarterword);
+     label
+ 	10;
+     var
+ 	q: halfword;
+     begin
+ 	setupknowntrans(c);
+ 	unstashcurexp(p);
+ 	if curtype = 6 then begin
+ 	    if mem[curexp + 9].int = 0 then 
+ 		if tx = 0 then 
+ 		    if ty = 0 then 
+ 			goto 10;
+ 	    flushcurexp(makepath(curexp));
+ 	    curtype := 8
+ 	end;
+ 	q := curexp;
+ 	repeat
+ 	    if mem[q].hh.b0 <> 0 then 
+ 		trans(q + 3, q + 4);
+ 	    trans(q + 1, q + 2);
+ 	    if mem[q].hh.b1 <> 0 then 
+ 		trans(q + 5, q + 6);
+ 	    q := mem[q].hh.rh
+ 	until q = curexp;
+     10:
+ 	
+     end; {:962} {963:}
+ 
+     procedure edgestrans(p: halfword; c: quarterword);
+     label
+ 	10;
+     begin
+ 	setupknowntrans(c);
+ 	unstashcurexp(p);
+ 	curedges := curexp;
+ 	if mem[curedges].hh.rh = curedges then 
+ 	    goto 10;
+ 	if txx = 0 then 
+ 	    if tyy = 0 then 
+ 		if (txy mod 65536) = 0 then 
+ 		    if (tyx mod 65536) = 0 then begin
+ 			xyswapedges;
+ 			txx := txy;
+ 			tyy := tyx;
+ 			txy := 0;
+ 			tyx := 0;
+ 			if mem[curedges].hh.rh = curedges then 
+ 			    goto 10
+ 		    end;
+ 	if txy = 0 then 
+ 	    if tyx = 0 then 
+ 		if (txy mod 65536) = 0 then 
+ 		    if (tyy mod 65536) = 0 then begin {964:}
+ 			if (txx = 0) or (tyy = 0) then begin
+ 			    tossedges(curedges);
+ 			    curexp := getnode(6);
+ 			    initedges(curexp)
+ 			end else begin
+ 			    if txx < 0 then begin
+ 				xreflectedges;
+ 				txx := -txx
+ 			    end;
+ 			    if tyy < 0 then begin
+ 				yreflectedges;
+ 				tyy := -tyy
+ 			    end;
+ 			    if txx <> 65536 then 
+ 				xscaleedges(txx div 65536);
+ 			    if tyy <> 65536 then 
+ 				yscaleedges(tyy div 65536); {965:}
+ 			    tx := roundunscaled(tx);
+ 			    ty := roundunscaled(ty);
+ 			    if ((((((mem[curedges + 2].hh.lh + tx) <= 0) or ((mem[curedges + 2].hh.rh + tx) >= 8192)) or ((mem[curedges + 1].hh.lh + ty) <= 0)) or ((mem[curedges + 1].hh.rh + ty) >= 8191)) or (abs(tx) >= 4096)) or (abs(ty) >= 4096) then begin
+ 				begin
+ 				    if interaction = 3 then 
+ 					;
+ 				    printnl(133);
+ 				    print(731)
+ 				end;
+ 				begin
+ 				    helpptr := 3;
+ 				    helpline[2] := 732;
+ 				    helpline[1] := 404;
+ 				    helpline[0] := 405
+ 				end;
+ 				putgeterror
+ 			    end else begin
+ 				if tx <> 0 then begin
+ 				    if not (abs((mem[curedges + 3].hh.lh - tx) - 4096) < 4096) then 
+ 					fixoffset;
+ 				    mem[curedges + 2].hh.lh := mem[curedges + 2].hh.lh + tx;
+ 				    mem[curedges + 2].hh.rh := mem[curedges + 2].hh.rh + tx;
+ 				    mem[curedges + 3].hh.lh := mem[curedges + 3].hh.lh - tx;
+ 				    mem[curedges + 4].int := 0
+ 				end;
+ 				if ty <> 0 then begin
+ 				    mem[curedges + 1].hh.lh := mem[curedges + 1].hh.lh + ty;
+ 				    mem[curedges + 1].hh.rh := mem[curedges + 1].hh.rh + ty;
+ 				    mem[curedges + 5].hh.lh := mem[curedges + 5].hh.lh + ty;
+ 				    mem[curedges + 4].int := 0
+ 				end
+ 			    end {:965}
+ 			end;
+ 			goto 10
+ 		    end {:964};
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(728)
+ 	end;
+ 	begin
+ 	    helpptr := 3;
+ 	    helpline[2] := 729;
+ 	    helpline[1] := 730;
+ 	    helpline[0] := 405
+ 	end;
+ 	putgeterror;
+     10:
+ 	
+     end; {:963} {966:}
+ {968:}
+ 
+     procedure bilin1(p: halfword; t: scaled; q: halfword; u, delta: scaled);
+     var
+ 	r: halfword;
+     begin
+ 	if t <> 65536 then 
+ 	    depmult(p, t, true);
+ 	if u <> 0 then 
+ 	    if mem[q].hh.b0 = 16 then 
+ 		delta := delta + takescaled(mem[q + 1].int, u)
+ 	    else begin {969:}
+ 		if mem[p].hh.b0 <> 18 then begin
+ 		    if mem[p].hh.b0 = 16 then 
+ 			newdep(p, constdependency(mem[p + 1].int))
+ 		    else 
+ 			mem[p + 1].hh.rh := ptimesv(mem[p + 1].hh.rh, 65536, 17, 18, true);
+ 		    mem[p].hh.b0 := 18
+ 		end {:969};
+ 		mem[p + 1].hh.rh := pplusfq(mem[p + 1].hh.rh, u, mem[q + 1].hh.rh, 18, mem[q].hh.b0)
+ 	    end;
+ 	if mem[p].hh.b0 = 16 then 
+ 	    mem[p + 1].int := mem[p + 1].int + delta
+ 	else begin
+ 	    r := mem[p + 1].hh.rh;
+ 	    while mem[r].hh.lh <> (-30000) do 
+ 		r := mem[r].hh.rh;
+ 	    delta := mem[r + 1].int + delta;
+ 	    if r <> mem[p + 1].hh.rh then 
+ 		mem[r + 1].int := delta
+ 	    else begin
+ 		recyclevalue(p);
+ 		mem[p].hh.b0 := 16;
+ 		mem[p + 1].int := delta
+ 	    end
+ 	end;
+ 	if fixneeded then 
+ 	    fixdependencies
+     end; {:968} {971:}
+ 
+     procedure addmultdep(p: halfword; v: scaled; r: halfword);
+     begin
+ 	if mem[r].hh.b0 = 16 then 
+ 	    mem[depfinal + 1].int := mem[depfinal + 1].int + takescaled(mem[r + 1].int, v)
+ 	else begin
+ 	    mem[p + 1].hh.rh := pplusfq(mem[p + 1].hh.rh, v, mem[r + 1].hh.rh, 18, mem[r].hh.b0);
+ 	    if fixneeded then 
+ 		fixdependencies
+ 	end
+     end; {:971} {972:}
+ 
+     procedure bilin2(p, t: halfword; v: scaled; u, q: halfword);
+     var
+ 	vv: scaled;
+     begin
+ 	vv := mem[p + 1].int;
+ 	mem[p].hh.b0 := 18;
+ 	newdep(p, constdependency(0));
+ 	if vv <> 0 then 
+ 	    addmultdep(p, vv, t);
+ 	if v <> 0 then 
+ 	    addmultdep(p, v, u);
+ 	if q <> (-30000) then 
+ 	    addmultdep(p, 65536, q);
+ 	if mem[p + 1].hh.rh = depfinal then begin
+ 	    vv := mem[depfinal + 1].int;
+ 	    recyclevalue(p);
+ 	    mem[p].hh.b0 := 16;
+ 	    mem[p + 1].int := vv
+ 	end
+     end; {:972} {974:}
+ 
+     procedure bilin3(p: halfword; t, v, u, delta: scaled);
+     begin
+ 	if t <> 65536 then 
+ 	    delta := delta + takescaled(mem[p + 1].int, t)
+ 	else 
+ 	    delta := delta + mem[p + 1].int;
+ 	if u <> 0 then 
+ 	    mem[p + 1].int := delta + takescaled(v, u)
+ 	else 
+ 	    mem[p + 1].int := delta
+     end; {:974}
+ 
+     procedure bigtrans(p: halfword; c: quarterword);
+     label
+ 	10;
+     var
+ 	q, r, pp, qq: halfword;
+ 	s: smallnumber;
+     begin
+ 	s := bignodesize[mem[p].hh.b0];
+ 	q := mem[p + 1].int;
+ 	r := q + s;
+ 	repeat
+ 	    r := r - 2;
+ 	    if mem[r].hh.b0 <> 16 then begin {967:}
+ 		setupknowntrans(c);
+ 		makeexpcopy(p);
+ 		r := mem[curexp + 1].int;
+ 		if curtype = 13 then begin
+ 		    bilin1(r + 10, tyy, q + 6, tyx, 0);
+ 		    bilin1(r + 8, tyy, q + 4, tyx, 0);
+ 		    bilin1(r + 6, txx, q + 10, txy, 0);
+ 		    bilin1(r + 4, txx, q + 8, txy, 0)
+ 		end;
+ 		bilin1(r + 2, tyy, q, tyx, ty);
+ 		bilin1(r, txx, q + 2, txy, tx);
+ 		goto 10
+ 	    end {:967}
+ 	until r = q; {970:}
+ 	setuptrans(c);
+ 	if curtype = 16 then begin {973:}
+ 	    makeexpcopy(p);
+ 	    r := mem[curexp + 1].int;
+ 	    if curtype = 13 then begin
+ 		bilin3(r + 10, tyy, mem[q + 7].int, tyx, 0);
+ 		bilin3(r + 8, tyy, mem[q + 5].int, tyx, 0);
+ 		bilin3(r + 6, txx, mem[q + 11].int, txy, 0);
+ 		bilin3(r + 4, txx, mem[q + 9].int, txy, 0)
+ 	    end;
+ 	    bilin3(r + 2, tyy, mem[q + 1].int, tyx, ty);
+ 	    bilin3(r, txx, mem[q + 3].int, txy, tx)
+ 	end else begin {:973}
+ 	    pp := stashcurexp;
+ 	    qq := mem[pp + 1].int;
+ 	    makeexpcopy(p);
+ 	    r := mem[curexp + 1].int;
+ 	    if curtype = 13 then begin
+ 		bilin2(r + 10, qq + 10, mem[q + 7].int, qq + 8, -30000);
+ 		bilin2(r + 8, qq + 10, mem[q + 5].int, qq + 8, -30000);
+ 		bilin2(r + 6, qq + 4, mem[q + 11].int, qq + 6, -30000);
+ 		bilin2(r + 4, qq + 4, mem[q + 9].int, qq + 6, -30000)
+ 	    end;
+ 	    bilin2(r + 2, qq + 10, mem[q + 1].int, qq + 8, qq + 2);
+ 	    bilin2(r, qq + 4, mem[q + 3].int, qq + 6, qq);
+ 	    recyclevalue(pp);
+ 	    freenode(pp, 2)
+ 	end;
+ {:970}
+     10:
+ 	
+     end; {:966} {976:}
+ 
+     procedure cat(p: halfword);
+     var
+ 	a, b: strnumber;
+ 	k: poolpointer;
+     begin
+ 	a := mem[p + 1].int;
+ 	b := curexp;
+ 	begin
+ 	    if ((poolptr + (strstart[a + 1] - strstart[a])) + (strstart[b + 1] - strstart[b])) > maxpoolptr then begin
+ 		if ((poolptr + (strstart[a + 1] - strstart[a])) + (strstart[b + 1] - strstart[b])) > poolsize then 
+ 		    overflow(129, poolsize - initpoolptr);
+ 		maxpoolptr := (poolptr + (strstart[a + 1] - strstart[a])) + (strstart[b + 1] - strstart[b])
+ 	    end
+ 	end;
+ 	for k := strstart[a] to strstart[a + 1] - 1 do begin
+ 	    strpool[poolptr] := strpool[k];
+ 	    poolptr := poolptr + 1
+ 	end;
+ 	for k := strstart[b] to strstart[b + 1] - 1 do begin
+ 	    strpool[poolptr] := strpool[k];
+ 	    poolptr := poolptr + 1
+ 	end;
+ 	curexp := makestring;
+ 	begin
+ 	    if strref[b] < 127 then 
+ 		if strref[b] > 1 then 
+ 		    strref[b] := strref[b] - 1
+ 		else 
+ 		    flushstring(b)
+ 	end
+     end; {:976} {977:}
+ 
+     procedure chopstring(p: halfword);
+     var
+ 	a, b: integer;
+ 	l: integer;
+ 	k: integer;
+ 	s: strnumber;
+ 	reversed: boolean;
+     begin
+ 	a := roundunscaled(mem[p + 1].int);
+ 	b := roundunscaled(mem[p + 3].int);
+ 	if a <= b then 
+ 	    reversed := false
+ 	else begin
+ 	    reversed := true;
+ 	    k := a;
+ 	    a := b;
+ 	    b := k
+ 	end;
+ 	s := curexp;
+ 	l := strstart[s + 1] - strstart[s];
+ 	if a < 0 then begin
+ 	    a := 0;
+ 	    if b < 0 then 
+ 		b := 0
+ 	end;
+ 	if b > l then begin
+ 	    b := l;
+ 	    if a > l then 
+ 		a := l
+ 	end;
+ 	begin
+ 	    if ((poolptr + b) - a) > maxpoolptr then begin
+ 		if ((poolptr + b) - a) > poolsize then 
+ 		    overflow(129, poolsize - initpoolptr);
+ 		maxpoolptr := (poolptr + b) - a
+ 	    end
+ 	end;
+ 	if reversed then 
+ 	    for k := (strstart[s] + b) - 1 downto strstart[s] + a do begin
+ 		strpool[poolptr] := strpool[k];
+ 		poolptr := poolptr + 1
+ 	    end
+ 	else 
+ 	    for k := strstart[s] + a to (strstart[s] + b) - 1 do begin
+ 		strpool[poolptr] := strpool[k];
+ 		poolptr := poolptr + 1
+ 	    end;
+ 	curexp := makestring;
+ 	begin
+ 	    if strref[s] < 127 then 
+ 		if strref[s] > 1 then 
+ 		    strref[s] := strref[s] - 1
+ 		else 
+ 		    flushstring(s)
+ 	end
+     end; {:977} {978:}
+ 
+     procedure choppath(p: halfword);
+     var
+ 	q: halfword;
+ 	pp, qq, rr, ss: halfword;
+ 	a, b, k, l: scaled;
+ 	reversed: boolean;
+     begin
+ 	l := pathlength;
+ 	a := mem[p + 1].int;
+ 	b := mem[p + 3].int;
+ 	if a <= b then 
+ 	    reversed := false
+ 	else begin
+ 	    reversed := true;
+ 	    k := a;
+ 	    a := b;
+ 	    b := k
+ 	end; {979:}
+ 	if a < 0 then 
+ 	    if mem[curexp].hh.b0 = 0 then begin
+ 		a := 0;
+ 		if b < 0 then 
+ 		    b := 0
+ 	    end else 
+ 		repeat
+ 		    a := a + l;
+ 		    b := b + l
+ 		until a >= 0;
+ 	if b > l then 
+ 	    if mem[curexp].hh.b0 = 0 then begin
+ 		b := l;
+ 		if a > l then 
+ 		    a := l
+ 	    end else 
+ 		while a >= l do begin
+ 		    a := a - l;
+ 		    b := b - l
+ 		end {:979};
+ 	q := curexp;
+ 	while a >= 65536 do begin
+ 	    q := mem[q].hh.rh;
+ 	    a := a - 65536;
+ 	    b := b - 65536
+ 	end;
+ 	if b = a then begin {981:}
+ 	    if a > 0 then begin
+ 		qq := mem[q].hh.rh;
+ 		splitcubic(q, a * 4096, mem[qq + 1].int, mem[qq + 2].int);
+ 		q := mem[q].hh.rh
+ 	    end;
+ 	    pp := copyknot(q);
+ 	    qq := pp
+ 	end else begin {:981} {980:}
+ 	    pp := copyknot(q);
+ 	    qq := pp;
+ 	    repeat
+ 		q := mem[q].hh.rh;
+ 		rr := qq;
+ 		qq := copyknot(q);
+ 		mem[rr].hh.rh := qq;
+ 		b := b - 65536
+ 	    until b <= 0;
+ 	    if a > 0 then begin
+ 		ss := pp;
+ 		pp := mem[pp].hh.rh;
+ 		splitcubic(ss, a * 4096, mem[pp + 1].int, mem[pp + 2].int);
+ 		pp := mem[ss].hh.rh;
+ 		freenode(ss, 7);
+ 		if rr = ss then begin
+ 		    b := makescaled(b, 65536 - a);
+ 		    rr := pp
+ 		end
+ 	    end;
+ 	    if b < 0 then begin
+ 		splitcubic(rr, (b + 65536) * 4096, mem[qq + 1].int, mem[qq + 2].int);
+ 		freenode(qq, 7);
+ 		qq := mem[rr].hh.rh
+ 	    end
+ 	end {:980};
+ 	mem[pp].hh.b0 := 0;
+ 	mem[qq].hh.b1 := 0;
+ 	mem[qq].hh.rh := pp;
+ 	tossknotlist(curexp);
+ 	if reversed then begin
+ 	    curexp := mem[htapypoc(pp)].hh.rh;
+ 	    tossknotlist(pp)
+ 	end else 
+ 	    curexp := pp
+     end; {:978} {982:}
+ 
+     procedure pairvalue(x, y: scaled);
+     var
+ 	p: halfword;
+     begin
+ 	p := getnode(2);
+ 	flushcurexp(p);
+ 	curtype := 14;
+ 	mem[p].hh.b0 := 14;
+ 	mem[p].hh.b1 := 11;
+ 	initbignode(p);
+ 	p := mem[p + 1].int;
+ 	mem[p].hh.b0 := 16;
+ 	mem[p + 1].int := x;
+ 	mem[p + 2].hh.b0 := 16;
+ 	mem[p + 3].int := y
+     end; { pairvalue }
+ {:982}
+     {984:}
+ 
+     procedure setupoffset(p: halfword);
+     begin
+ 	findoffset(mem[p + 1].int, mem[p + 3].int, curexp);
+ 	pairvalue(curx, cury)
+     end;
+ 
+     procedure setupdirectiontime(p: halfword);
+     begin
+ 	flushcurexp(finddirectiontime(mem[p + 1].int, mem[p + 3].int, curexp))
+     end; {:984} {985:}
+ 
+     procedure findpoint(v: scaled; c: quarterword);
+     var
+ 	p: halfword;
+ 	n: scaled;
+ 	vv: scaled;
+ 	q: halfword;
+     begin
+ 	vv := v;
+ 	p := curexp;
+ 	if mem[p].hh.b0 = 0 then 
+ 	    n := -65536
+ 	else 
+ 	    n := 0;
+ 	repeat
+ 	    p := mem[p].hh.rh;
+ 	    n := n + 65536
+ 	until p = curexp;
+ 	if n = 0 then 
+ 	    v := 0
+ 	else if v < 0 then 
+ 	    if mem[p].hh.b0 = 0 then 
+ 		v := 0
+ 	    else 
+ 		v := (n - 1) - (((-v) - 1) mod n)
+ 	else if v > n then 
+ 	    if mem[p].hh.b0 = 0 then 
+ 		v := n
+ 	    else 
+ 		v := v mod n;
+ 	p := curexp;
+ 	while v >= 65536 do begin
+ 	    p := mem[p].hh.rh;
+ 	    v := v - 65536
+ 	end;
+ 	if v <> 0 then begin {986:}
+ 	    q := mem[p].hh.rh;
+ 	    splitcubic(p, v * 4096, mem[q + 1].int, mem[q + 2].int);
+ 	    p := mem[p].hh.rh
+ 	end {:986}; {987:}
+ 	case c of
+ 	    97:
+ 		pairvalue(mem[p + 1].int, mem[p + 2].int);
+ 	    98:
+ 		if mem[p].hh.b0 = 0 then 
+ 		    pairvalue(mem[p + 1].int, mem[p + 2].int)
+ 		else 
+ 		    pairvalue(mem[p + 3].int, mem[p + 4].int);
+ 	    99:
+ 		if mem[p].hh.b1 = 0 then 
+ 		    pairvalue(mem[p + 1].int, mem[p + 2].int)
+ 		else 
+ 		    pairvalue(mem[p + 5].int, mem[p + 6].int)
+ 	end {:987}
+     end; {:985}
+ 
+     procedure dobinary(p: halfword; c: quarterword);
+     label
+ 	30, 31, 10;
+     var
+ 	q, r, rr: halfword;
+ 	oldp, oldexp: halfword;
+ 	v: integer;
+     begin
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	if internal[7] > 131072 then begin {924:}
+ 	    begindiagnostic;
+ 	    printnl(714);
+ 	    printexp(p, 0);
+ 	    printchar(41);
+ 	    printop(c);
+ 	    printchar(40);
+ 	    printexp(-30000, 0);
+ 	    print(706);
+ 	    enddiagnostic(false)
+ 	end {:924}; {926:}
+ 	if mem[p].hh.b0 in
+ 	    [13, 14, 19] then
+ 	    case mem[p].hh.b0 of
+ 		13, 14:
+ 		    oldp := tarnished(p);
+ 		19:
+ 		    oldp := -29999
+ 	    end
+ 	else
+ 	    oldp := -30000;
+ 	if oldp <> (-30000) then begin
+ 	    q := stashcurexp;
+ 	    oldp := p;
+ 	    makeexpcopy(oldp);
+ 	    p := stashcurexp;
+ 	    unstashcurexp(q)
+ 	end; {:926}
+ {927:}
+ 	if curtype in
+ 	    [13, 14, 19] then
+ 	    case curtype of
+ 		13, 14:
+ 		    oldexp := tarnished(curexp);
+ 		19:
+ 		    oldexp := -29999
+ 	    end
+ 	else
+ 	    oldexp := -30000;
+ 	if oldexp <> (-30000) then begin
+ 	    oldexp := curexp;
+ 	    makeexpcopy(oldexp)
+ 	end {:927};
+ 	case c of
+ 	    69, 70: {929:}
+ 		if (curtype < 14) or (mem[p].hh.b0 < 14) then 
+ 		    if (curtype = 11) and (mem[p].hh.b0 = 11) then begin
+ 			if c = 70 then 
+ 			    negateedges(curexp);
+ 			curedges := curexp;
+ 			mergeedges(mem[p + 1].int)
+ 		    end else 
+ 			badbinary(p, c)
+ 		else if curtype = 14 then 
+ 		    if mem[p].hh.b0 <> 14 then 
+ 			badbinary(p, c)
+ 		    else begin
+ 			q := mem[p + 1].int;
+ 			r := mem[curexp + 1].int;
+ 			addorsubtract(q, r, c);
+ 			addorsubtract(q + 2, r + 2, c)
+ 		    end
+ 		else if mem[p].hh.b0 = 14 then 
+ 		    badbinary(p, c)
+ 		else 
+ 		    addorsubtract(p, -30000, c) {:929}; {936:}
+ 	    77, 78, 79, 80, 81, 82:
+ 		begin
+ 		    if (curtype > 14) and (mem[p].hh.b0 > 14) then 
+ 			addorsubtract(p, -30000, 70)
+ 		    else if curtype <> mem[p].hh.b0 then begin
+ 			badbinary(p, c);
+ 			goto 30
+ 		    end else if curtype = 4 then 
+ 			flushcurexp(strvsstr(mem[p + 1].int, curexp))
+ 		    else if (curtype = 5) or (curtype = 3) then begin {938:}
+ 			q := mem[curexp + 1].int;
+ 			while (q <> curexp) and (q <> p) do 
+ 			    q := mem[q + 1].int;
+ 			if q = p then 
+ 			    flushcurexp(0)
+ 		    end else if (curtype = 14) or (curtype = 13) then begin {:938} {939:}
+ 			q := mem[p + 1].int;
+ 			r := mem[curexp + 1].int;
+ 			rr := (r + bignodesize[curtype]) - 2;
+ 			while true do begin
+ 			    addorsubtract(q, r, 70);
+ 			    if mem[r].hh.b0 <> 16 then 
+ 				goto 31;
+ 			    if mem[r + 1].int <> 0 then 
+ 				goto 31;
+ 			    if r = rr then 
+ 				goto 31;
+ 			    q := q + 2;
+ 			    r := r + 2
+ 			end;
+     31:
+ 			takepart(53 + ((r - mem[curexp + 1].int) div 2))
+ 		    end else if curtype = 2 then  {:939}
+ 			flushcurexp(curexp - mem[p + 1].int)
+ 		    else begin
+ 			badbinary(p, c);
+ 			goto 30
+ 		    end; {937:}
+ 		    if curtype <> 16 then begin
+ 			if curtype < 16 then begin
+ 			    disperr(p, 155);
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 715
+ 			    end
+ 			end else begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 716;
+ 			    helpline[0] := 717
+ 			end;
+ 			disperr(-30000, 718);
+ 			putgetflusherror(31)
+ 		    end else 
+ 			case c of
+ 			    77:
+ 				if curexp < 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    78:
+ 				if curexp <= 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    79:
+ 				if curexp > 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    80:
+ 				if curexp >= 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    81:
+ 				if curexp = 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31;
+ 			    82:
+ 				if curexp <> 0 then 
+ 				    curexp := 30
+ 				else 
+ 				    curexp := 31
+ 			end;
+ 		    curtype := 2 {:937};
+     30:
+ 		    
+ 		end; {:936} {940:}
+ 	    76, 75:
+ 		if (mem[p].hh.b0 <> 2) or (curtype <> 2) then 
+ 		    badbinary(p, c)
+ 		else if mem[p + 1].int = (c - 45) then 
+ 		    curexp := mem[p + 1].int; {:940} {941:}
+ 	    71:
+ 		if (curtype < 14) or (mem[p].hh.b0 < 14) then 
+ 		    badbinary(p, 71)
+ 		else if (curtype = 16) or (mem[p].hh.b0 = 16) then begin {942:}
+ 		    if mem[p].hh.b0 = 16 then begin
+ 			v := mem[p + 1].int;
+ 			freenode(p, 2)
+ 		    end else begin
+ 			v := curexp;
+ 			unstashcurexp(p)
+ 		    end;
+ 		    if curtype = 16 then 
+ 			curexp := takescaled(curexp, v)
+ 		    else if curtype = 14 then begin
+ 			p := mem[curexp + 1].int;
+ 			depmult(p, v, true);
+ 			depmult(p + 2, v, true)
+ 		    end else 
+ 			depmult(-30000, v, true);
+ 		    goto 10
+ 		end else if (nicepair(p, mem[p].hh.b0) and (curtype > 14)) or (nicepair(curexp, curtype) and (mem[p].hh.b0 > 14)) then begin {:942}
+ 		    hardtimes(p);
+ 		    goto 10
+ 		end else 
+ 		    badbinary(p, 71); {:941} {948:}
+ 	    72:
+ 		if (curtype <> 16) or (mem[p].hh.b0 < 14) then 
+ 		    badbinary(p, 72)
+ 		else begin
+ 		    v := curexp;
+ 		    unstashcurexp(p);
+ 		    if v = 0 then begin {950:}
+ 			disperr(-30000, 648);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 720;
+ 			    helpline[0] := 721
+ 			end;
+ 			putgeterror
+ 		    end else begin {:950}
+ 			if curtype = 16 then 
+ 			    curexp := makescaled(curexp, v)
+ 			else if curtype = 14 then begin
+ 			    p := mem[curexp + 1].int;
+ 			    depdiv(p, v);
+ 			    depdiv(p + 2, v)
+ 			end else 
+ 			    depdiv(-30000, v)
+ 		    end;
+ 		    goto 10
+ 		end; {:948} {951:}
+ 	    73, 74:
+ 		if (curtype = 16) and (mem[p].hh.b0 = 16) then 
+ 		    if c = 73 then 
+ 			curexp := pythadd(mem[p + 1].int, curexp)
+ 		    else 
+ 			curexp := pythsub(mem[p + 1].int, curexp)
+ 		else 
+ 		    badbinary(p, c); {:951} {952:}
+ 	    84, 85, 86, 87, 88, 89, 90,
+ 	    91:
+ 		if ((mem[p].hh.b0 = 9) or (mem[p].hh.b0 = 8)) or (mem[p].hh.b0 = 6) then begin
+ 		    pathtrans(p, c);
+ 		    goto 10
+ 		end else if (mem[p].hh.b0 = 14) or (mem[p].hh.b0 = 13) then 
+ 		    bigtrans(p, c)
+ 		else if mem[p].hh.b0 = 11 then begin
+ 		    edgestrans(p, c);
+ 		    goto 10
+ 		end else 
+ 		    badbinary(p, c); {:952} {975:}
+ 	    83:
+ 		if (curtype = 4) and (mem[p].hh.b0 = 4) then 
+ 		    cat(p)
+ 		else 
+ 		    badbinary(p, 83);
+ 	    94:
+ 		if nicepair(p, mem[p].hh.b0) and (curtype = 4) then 
+ 		    chopstring(mem[p + 1].int)
+ 		else 
+ 		    badbinary(p, 94);
+ 	    95:
+ 		begin
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if nicepair(p, mem[p].hh.b0) and (curtype = 9) then 
+ 			choppath(mem[p + 1].int)
+ 		    else 
+ 			badbinary(p, 95)
+ 		end; {:975} {983:}
+ 	    97, 98, 99:
+ 		begin
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if (curtype = 9) and (mem[p].hh.b0 = 16) then 
+ 			findpoint(mem[p + 1].int, c)
+ 		    else 
+ 			badbinary(p, c)
+ 		end;
+ 	    100:
+ 		begin
+ 		    if curtype = 8 then 
+ 			materializepen;
+ 		    if (curtype = 6) and nicepair(p, mem[p].hh.b0) then 
+ 			setupoffset(mem[p + 1].int)
+ 		    else 
+ 			badbinary(p, 100)
+ 		end;
+ 	    96:
+ 		begin
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if (curtype = 9) and nicepair(p, mem[p].hh.b0) then 
+ 			setupdirectiontime(mem[p + 1].int)
+ 		    else 
+ 			badbinary(p, 96)
+ 		end; {:983} {988:}
+ 	    92:
+ 		begin
+ 		    if mem[p].hh.b0 = 14 then begin
+ 			q := stashcurexp;
+ 			unstashcurexp(p);
+ 			pairtopath;
+ 			p := stashcurexp;
+ 			unstashcurexp(q)
+ 		    end;
+ 		    if curtype = 14 then 
+ 			pairtopath;
+ 		    if (curtype = 9) and (mem[p].hh.b0 = 9) then begin
+ 			pathintersection(mem[p + 1].int, curexp);
+ 			pairvalue(curt, curtt)
+ 		    end else 
+ 			badbinary(p, 92)
+ 		end
+ 	end {:988};
+ 	recyclevalue(p);
+ 	freenode(p, 2);
+     10:
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end; {925:}
+ 	if oldp <> (-30000) then begin
+ 	    recyclevalue(oldp);
+ 	    freenode(oldp, 2)
+ 	end;
+ 	if oldexp <> (-30000) then begin
+ 	    recyclevalue(oldexp);
+ 	    freenode(oldexp, 2)
+ 	end {:925}
+     end; {:922} {944:}
+ 
+     procedure fracmult(n, d: scaled);
+     var
+ 	p: halfword;
+ 	oldexp: halfword;
+ 	v: fraction;
+     begin
+ 	if internal[7] > 131072 then begin {945:}
+ 	    begindiagnostic;
+ 	    printnl(714);
+ 	    printscaled(n);
+ 	    printchar(47);
+ 	    printscaled(d);
+ 	    print(719);
+ 	    printexp(-30000, 0);
+ 	    print(706);
+ 	    enddiagnostic(false)
+ 	end {:945};
+ 	if curtype in
+ 	    [13, 14, 19] then
+ 	    case curtype of
+ 		13, 14:
+ 		    oldexp := tarnished(curexp);
+ 		19:
+ 		    oldexp := -29999
+ 	    end
+ 	else
+ 	    oldexp := -30000;
+ 	if oldexp <> (-30000) then begin
+ 	    oldexp := curexp;
+ 	    makeexpcopy(oldexp)
+ 	end;
+ 	v := makefraction(n, d);
+ 	if curtype = 16 then 
+ 	    curexp := takefraction(curexp, v)
+ 	else if curtype = 14 then begin
+ 	    p := mem[curexp + 1].int;
+ 	    depmult(p, v, false);
+ 	    depmult(p + 2, v, false)
+ 	end else 
+ 	    depmult(-30000, v, false);
+ 	if oldexp <> (-30000) then begin
+ 	    recyclevalue(oldexp);
+ 	    freenode(oldexp, 2)
+ 	end
+     end; {:944} {989:} {1155:}
+ 
+     procedure gfswap;
+     begin
+ 	if gflimit = gfbufsize then begin
+ 	    bwritebuf(gffile, gfbuf, 0, halfbuf - 1);
+ 	    gflimit := halfbuf;
+ 	    gfoffset := gfoffset + gfbufsize;
+ 	    gfptr := 0
+ 	end else begin
+ 	    bwritebuf(gffile, gfbuf, halfbuf, gfbufsize - 1);
+ 	    gflimit := gfbufsize
+ 	end
+     end; {:1155} {1157:}
+ 
+     procedure gffour(x: integer);
+     begin
+ 	if x >= 0 then begin
+ 	    gfbuf[gfptr] := x div 16777216;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end else begin
+ 	    x := x + 1073741824;
+ 	    x := x + 1073741824;
+ 	    begin
+ 		gfbuf[gfptr] := (x div 16777216) + 128;
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end
+ 	end;
+ 	x := x mod 16777216;
+ 	begin
+ 	    gfbuf[gfptr] := x div 65536;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	x := x mod 65536;
+ 	begin
+ 	    gfbuf[gfptr] := x div 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := x mod 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end
+     end; {:1157} {1158:}
+ 
+     procedure gftwo(x: integer);
+     begin
+ 	begin
+ 	    gfbuf[gfptr] := x div 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := x mod 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end
+     end;
+ 
+     procedure gfthree(x: integer);
+     begin
+ 	begin
+ 	    gfbuf[gfptr] := x div 65536;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := (x mod 65536) div 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := x mod 256;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end
+     end; {:1158} {1159:}
+ 
+     procedure gfpaint(d: integer);
+     begin
+ 	if d < 64 then begin
+ 	    gfbuf[gfptr] := 0 + d;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end else if d < 256 then begin
+ 	    begin
+ 		gfbuf[gfptr] := 64;
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end;
+ 	    begin
+ 		gfbuf[gfptr] := d;
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end
+ 	end else begin
+ 	    begin
+ 		gfbuf[gfptr] := 65;
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end;
+ 	    gftwo(d)
+ 	end
+     end; {:1159}
+ {1160:}
+ 
+     procedure gfstring(s, t: strnumber);
+     var
+ 	k: poolpointer;
+ 	l: integer;
+     begin
+ 	if s <> 0 then begin
+ 	    l := strstart[s + 1] - strstart[s];
+ 	    if t <> 0 then 
+ 		l := l + (strstart[t + 1] - strstart[t]);
+ 	    if l <= 255 then begin
+ 		begin
+ 		    gfbuf[gfptr] := 239;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		begin
+ 		    gfbuf[gfptr] := l;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end
+ 	    end else begin
+ 		begin
+ 		    gfbuf[gfptr] := 241;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gfthree(l)
+ 	    end;
+ 	    for k := strstart[s] to strstart[s + 1] - 1 do begin
+ 		gfbuf[gfptr] := strpool[k];
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end
+ 	end;
+ 	if t <> 0 then 
+ 	    for k := strstart[t] to strstart[t + 1] - 1 do begin
+ 		gfbuf[gfptr] := strpool[k];
+ 		gfptr := gfptr + 1;
+ 		if gfptr = gflimit then 
+ 		    gfswap
+ 	    end
+     end; {:1160}
+ {1161:}
+ 
+     procedure gfboc(minm, maxm, minn, maxn: integer);
+     label
+ 	10;
+     begin
+ 	if minm < gfminm then 
+ 	    gfminm := minm;
+ 	if maxn > gfmaxn then 
+ 	    gfmaxn := maxn;
+ 	if bocp = (-1) then 
+ 	    if bocc >= 0 then 
+ 		if bocc < 256 then 
+ 		    if (maxm - minm) >= 0 then 
+ 			if (maxm - minm) < 256 then 
+ 			    if maxm >= 0 then 
+ 				if maxm < 256 then 
+ 				    if (maxn - minn) >= 0 then 
+ 					if (maxn - minn) < 256 then 
+ 					    if maxn >= 0 then 
+ 						if maxn < 256 then begin
+ 						    begin
+ 							gfbuf[gfptr] := 68;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := bocc;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := maxm - minm;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := maxm;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := maxn - minn;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    begin
+ 							gfbuf[gfptr] := maxn;
+ 							gfptr := gfptr + 1;
+ 							if gfptr = gflimit then 
+ 							    gfswap
+ 						    end;
+ 						    goto 10
+ 						end;
+ 	begin
+ 	    gfbuf[gfptr] := 67;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	gffour(bocc);
+ 	gffour(bocp);
+ 	gffour(minm);
+ 	gffour(maxm);
+ 	gffour(minn);
+ 	gffour(maxn);
+     10:
+ 	
+     end; {:1161} {1163:}
+ 
+     procedure initgf;
+     var
+ 	k: eightbits;
+ 	t: integer;
+     begin
+ 	gfminm := 4096;
+ 	gfmaxm := -4096;
+ 	gfminn := 4096;
+ 	gfmaxn := -4096;
+ 	for k := 0 to 255 do 
+ 	    charptr[k] := -1; {1164:}
+ 	if internal[27] <= 0 then 
+ 	    gfext := 908
+ 	else begin
+ 	    oldsetting := selector;
+ 	    selector := 5;
+ 	    printchar(46);
+ 	    printint(makescaled(internal[27], 59429463));
+ 	    print(909);
+ 	    gfext := makestring;
+ 	    selector := oldsetting
+ 	end {:1164};
+ 	begin
+ 	    if jobname = 0 then 
+ 		openlogfile;
+ 	    packjobname(gfext);
+ 	    while not bopenout(gffile, nameoffile) do 
+ 		promptfilename(620, gfext);
+ 	    outputfilename := bmakenamestring(gffile)
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := 247;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	begin
+ 	    gfbuf[gfptr] := 131;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	oldsetting := selector;
+ 	selector := 5;
+ 	print(907);
+ 	printint(roundunscaled(internal[14]));
+ 	printchar(46);
+ 	printdd(roundunscaled(internal[15]));
+ 	printchar(46);
+ 	printdd(roundunscaled(internal[16]));
+ 	printchar(58);
+ 	t := roundunscaled(internal[17]);
+ 	printdd(t div 60);
+ 	printdd(t mod 60);
+ 	selector := oldsetting;
+ 	begin
+ 	    gfbuf[gfptr] := poolptr - strstart[strptr];
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	strstart[strptr + 1] := poolptr;
+ 	gfstring(0, strptr);
+ 	poolptr := strstart[strptr];
+ 	gfprevptr := gfoffset + gfptr
+     end; {:1163} {1165:}
+ 
+     procedure shipout(c: eightbits);
+     label
+ 	30;
+     var
+ 	f: integer;
+ 	prevm, m, mm: integer;
+ 	prevn, n: integer;
+ 	p, q: halfword;
+ 	prevw, w, ww: integer;
+ 	d: integer;
+ 	delta: integer;
+ 	curminm: integer;
+ 	xoff, yoff: integer;
+     begin
+ 	if outputfilename = 0 then 
+ 	    initgf;
+ 	f := roundunscaled(internal[19]);
+ 	xoff := roundunscaled(internal[29]);
+ 	yoff := roundunscaled(internal[30]);
+ 	if termoffset > (maxprintline - 9) then 
+ 	    println
+ 	else if (termoffset > 0) or (fileoffset > 0) then 
+ 	    printchar(32);
+ 	printchar(91);
+ 	printint(c);
+ 	if f <> 0 then begin
+ 	    printchar(46);
+ 	    printint(f)
+ 	end;
+ 	flush(output);
+ 	bocc := (256 * f) + c;
+ 	bocp := charptr[c];
+ 	charptr[c] := gfprevptr;
+ 	if internal[34] > 0 then begin {1166:}
+ 	    if xoff <> 0 then begin
+ 		gfstring(308, 0);
+ 		begin
+ 		    gfbuf[gfptr] := 243;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(xoff * 65536)
+ 	    end;
+ 	    if yoff <> 0 then begin
+ 		gfstring(309, 0);
+ 		begin
+ 		    gfbuf[gfptr] := 243;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(yoff * 65536)
+ 	    end
+ 	end {:1166}; {1167:}
+ 	prevn := 4096;
+ 	p := mem[curedges].hh.lh;
+ 	n := mem[curedges + 1].hh.rh - 4096;
+ 	while p <> curedges do begin {1169:}
+ 	    if mem[p + 1].hh.lh > (-29999) then 
+ 		sortedges(p);
+ 	    q := mem[p + 1].hh.rh;
+ 	    w := 0;
+ 	    prevm := -268435456;
+ 	    ww := 0;
+ 	    prevw := 0;
+ 	    m := prevm;
+ 	    repeat
+ 		if q = 30000 then 
+ 		    mm := 268435456
+ 		else begin
+ 		    d := mem[q].hh.lh + 32768;
+ 		    mm := d div 8;
+ 		    ww := (ww + (d mod 8)) - 4
+ 		end;
+ 		if mm <> m then begin
+ 		    if prevw <= 0 then begin
+ 			if w > 0 then begin {1170:}
+ 			    if prevm = (-268435456) then begin {1172:}
+ 				if prevn = 4096 then begin
+ 				    gfboc((mem[curedges + 2].hh.lh + xoff) - 4096, (mem[curedges + 2].hh.rh + xoff) - 4096, (mem[curedges + 1].hh.lh + yoff) - 4096, n + yoff);
+ 				    curminm := (mem[curedges + 2].hh.lh - 4096) + mem[curedges + 3].hh.lh
+ 				end else if prevn > (n + 1) then begin {1174:}
+ 				    delta := (prevn - n) - 1;
+ 				    if delta < 256 then 
+ 					if delta = 0 then begin
+ 					    gfbuf[gfptr] := 70;
+ 					    gfptr := gfptr + 1;
+ 					    if gfptr = gflimit then 
+ 						gfswap
+ 					end else begin
+ 					    begin
+ 						gfbuf[gfptr] := 71;
+ 						gfptr := gfptr + 1;
+ 						if gfptr = gflimit then 
+ 						    gfswap
+ 					    end;
+ 					    begin
+ 						gfbuf[gfptr] := delta;
+ 						gfptr := gfptr + 1;
+ 						if gfptr = gflimit then 
+ 						    gfswap
+ 					    end
+ 					end
+ 				    else begin
+ 					begin
+ 					    gfbuf[gfptr] := 72;
+ 					    gfptr := gfptr + 1;
+ 					    if gfptr = gflimit then 
+ 						gfswap
+ 					end;
+ 					gftwo(delta)
+ 				    end
+ 				end else begin {:1174} {1173:}
+ 				    delta := m - curminm;
+ 				    if delta > 164 then begin
+ 					gfbuf[gfptr] := 70;
+ 					gfptr := gfptr + 1;
+ 					if gfptr = gflimit then 
+ 					    gfswap
+ 				    end else begin
+ 					begin
+ 					    gfbuf[gfptr] := 74 + delta;
+ 					    gfptr := gfptr + 1;
+ 					    if gfptr = gflimit then 
+ 						gfswap
+ 					end;
+ 					goto 30
+ 				    end
+ 				end {:1173};
+ 				gfpaint(m - curminm);
+     30:
+ 				prevn := n
+ 			    end else  {:1172}
+ 				gfpaint(m - prevm);
+ 			    prevm := m;
+ 			    prevw := w
+ 			end {:1170}
+ 		    end else if w <= 0 then begin {1171:}
+ 			gfpaint(m - prevm);
+ 			prevm := m;
+ 			prevw := w
+ 		    end {:1171};
+ 		    m := mm
+ 		end;
+ 		w := ww;
+ 		q := mem[q].hh.rh
+ 	    until mm = 268435456;
+ 	    if w <> 0 then 
+ 		printnl(911);
+ 	    if ((prevm - mem[curedges + 3].hh.lh) + xoff) > gfmaxm then 
+ 		gfmaxm := (prevm - mem[curedges + 3].hh.lh) + xoff {:1169};
+ 	    p := mem[p].hh.lh;
+ 	    n := n - 1
+ 	end;
+ 	if prevn = 4096 then begin {1168:}
+ 	    gfboc(0, 0, 0, 0);
+ 	    if gfmaxm < 0 then 
+ 		gfmaxm := 0;
+ 	    if gfminn > 0 then 
+ 		gfminn := 0
+ 	end else if (prevn + yoff) < gfminn then  {:1168}
+ 	    gfminn := prevn + yoff {:1167};
+ 	begin
+ 	    gfbuf[gfptr] := 69;
+ 	    gfptr := gfptr + 1;
+ 	    if gfptr = gflimit then 
+ 		gfswap
+ 	end;
+ 	gfprevptr := gfoffset + gfptr;
+ 	totalchars := totalchars + 1;
+ 	printchar(93);
+ 	flush(output);
+ 	if internal[11] > 0 then 
+ 	    printedges(910, true, xoff, yoff)
+     end; { shipout }
+ {:1165}
+     {995:}
+     {1006:}
+ 
+     procedure tryeq(l, r: halfword);
+     label
+ 	30, 31;
+     var
+ 	p: halfword;
+ 	t: 16..19;
+ 	q: halfword;
+ 	pp: halfword;
+ 	tt: 17..19;
+ 	copied: boolean; {1007:}
+     begin
+ 	t := mem[l].hh.b0;
+ 	if t = 16 then begin
+ 	    t := 17;
+ 	    p := constdependency(-mem[l + 1].int);
+ 	    q := p
+ 	end else if t = 19 then begin
+ 	    t := 17;
+ 	    p := singledependency(l);
+ 	    mem[p + 1].int := -mem[p + 1].int;
+ 	    q := depfinal
+ 	end else begin
+ 	    p := mem[l + 1].hh.rh;
+ 	    q := p;
+ 	    while true do begin
+ 		mem[q + 1].int := -mem[q + 1].int;
+ 		if mem[q].hh.lh = (-30000) then 
+ 		    goto 30;
+ 		q := mem[q].hh.rh
+ 	    end;
+     30:
+ 	    mem[mem[l + 1].hh.lh].hh.rh := mem[q].hh.rh;
+ 	    mem[mem[q].hh.rh + 1].hh.lh := mem[l + 1].hh.lh;
+ 	    mem[l].hh.b0 := 16
+ 	end {:1007};
+ {1009:}
+ 	if r = (-30000) then 
+ 	    if curtype = 16 then begin
+ 		mem[q + 1].int := mem[q + 1].int + curexp;
+ 		goto 31
+ 	    end else begin
+ 		tt := curtype;
+ 		if tt = 19 then 
+ 		    pp := singledependency(curexp)
+ 		else 
+ 		    pp := mem[curexp + 1].hh.rh
+ 	    end
+ 	else if mem[r].hh.b0 = 16 then begin
+ 	    mem[q + 1].int := mem[q + 1].int + mem[r + 1].int;
+ 	    goto 31
+ 	end else begin
+ 	    tt := mem[r].hh.b0;
+ 	    if tt = 19 then 
+ 		pp := singledependency(r)
+ 	    else 
+ 		pp := mem[r + 1].hh.rh
+ 	end;
+ 	if tt <> 19 then 
+ 	    copied := false
+ 	else begin
+ 	    copied := true;
+ 	    tt := 17
+ 	end; {1010:}
+ 	watchcoefs := false;
+ 	if t = tt then 
+ 	    p := pplusq(p, pp, t)
+ 	else if t = 18 then 
+ 	    p := pplusfq(p, 65536, pp, 18, 17)
+ 	else begin
+ 	    q := p;
+ 	    while mem[q].hh.lh <> (-30000) do begin
+ 		mem[q + 1].int := roundfraction(mem[q + 1].int);
+ 		q := mem[q].hh.rh
+ 	    end;
+ 	    t := 18;
+ 	    p := pplusq(p, pp, t)
+ 	end;
+ 	watchcoefs := true;
+ {:1010}
+ 	if copied then 
+ 	    flushnodelist(pp);
+     31: {:1009}
+ 	;
+ 	if mem[p].hh.lh = (-30000) then begin {1008:}
+ 	    if abs(mem[p + 1].int) > 64 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(761)
+ 		end;
+ 		print(763);
+ 		printscaled(mem[p + 1].int);
+ 		printchar(41);
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 762;
+ 		    helpline[0] := 760
+ 		end;
+ 		putgeterror
+ 	    end else if r = (-30000) then begin {623:}
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(465)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 466;
+ 		    helpline[0] := 467
+ 		end;
+ 		putgeterror
+ 	    end {:623};
+ 	    freenode(p, 2)
+ 	end else begin {:1008}
+ 	    lineareq(p, t);
+ 	    if r = (-30000) then 
+ 		if curtype <> 16 then 
+ 		    if mem[curexp].hh.b0 = 16 then begin
+ 			pp := curexp;
+ 			curexp := mem[curexp + 1].int;
+ 			curtype := 16;
+ 			freenode(pp, 2)
+ 		    end
+ 	end
+     end; {:1006} {1001:}
+ 
+     procedure makeeq(lhs: halfword);
+     label
+ 	20, 30, 45;
+     var
+ 	t: smallnumber;
+ 	v: integer;
+ 	p, q: halfword;
+     begin
+     20:
+ 	t := mem[lhs].hh.b0;
+ 	if t <= 14 then 
+ 	    v := mem[lhs + 1].int;
+ 	case t of {1003:}
+ 	    2, 4, 6, 9, 11:
+ 		if curtype = (t + 1) then begin
+ 		    nonlineareq(v, curexp, false);
+ 		    goto 30
+ 		end else if curtype = t then begin {1004:}
+ 		    if curtype <= 4 then begin
+ 			if curtype = 4 then begin
+ 			    if strvsstr(v, curexp) <> 0 then 
+ 				goto 45
+ 			end else if v <> curexp then 
+ 			    goto 45; {623:}
+ 			begin
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(465)
+ 			    end;
+ 			    begin
+ 				helpptr := 2;
+ 				helpline[1] := 466;
+ 				helpline[0] := 467
+ 			    end;
+ 			    putgeterror
+ 			end {:623};
+ 			goto 30
+ 		    end;
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(758)
+ 		    end;
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 759;
+ 			helpline[0] := 760
+ 		    end;
+ 		    putgeterror;
+ 		    goto 30;
+     45:
+ 		    begin
+ 			if interaction = 3 then 
+ 			    ;
+ 			printnl(133);
+ 			print(761)
+ 		    end;
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 762;
+ 			helpline[0] := 760
+ 		    end;
+ 		    putgeterror;
+ 		    goto 30
+ 		end {:1004};
+ 	    3, 5, 7, 12, 10:
+ 		if curtype = (t - 1) then begin
+ 		    nonlineareq(curexp, lhs, true);
+ 		    goto 30
+ 		end else if curtype = t then begin
+ 		    ringmerge(lhs, curexp);
+ 		    goto 30
+ 		end else if curtype = 14 then 
+ 		    if t = 10 then begin
+ 			pairtopath;
+ 			goto 20
+ 		    end;
+ 	    13, 14:
+ 		if curtype = t then begin {1005:}
+ 		    p := v + bignodesize[t];
+ 		    q := mem[curexp + 1].int + bignodesize[t];
+ 		    repeat
+ 			p := p - 2;
+ 			q := q - 2;
+ 			tryeq(p, q)
+ 		    until p = v;
+ 		    goto 30
+ 		end {:1005};
+ 	    16, 17, 18, 19:
+ 		if curtype >= 16 then begin
+ 		    tryeq(lhs, -30000);
+ 		    goto 30
+ 		end;
+ 	    1:
+ 		
+ 	end
+ {:1003}; {1002:}
+ 	disperr(lhs, 155);
+ 	disperr(-30000, 755);
+ 	if mem[lhs].hh.b0 <= 14 then 
+ 	    printtype(mem[lhs].hh.b0)
+ 	else 
+ 	    print(211);
+ 	printchar(61);
+ 	if curtype <= 14 then 
+ 	    printtype(curtype)
+ 	else 
+ 	    print(211);
+ 	printchar(41);
+ 	begin
+ 	    helpptr := 2;
+ 	    helpline[1] := 756;
+ 	    helpline[0] := 757
+ 	end; {:1002}
+ 	putgeterror;
+     30:
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end;
+ 	recyclevalue(lhs);
+ 	freenode(lhs, 2)
+     end; {:1001}
+ 
+     procedure doassignment;
+     forward;
+ 
+     procedure doequation;
+     var
+ 	lhs: halfword;
+ 	p: halfword;
+     begin
+ 	lhs := stashcurexp;
+ 	getxnext;
+ 	varflag := 77;
+ 	scanexpression;
+ 	if curcmd = 51 then 
+ 	    doequation
+ 	else if curcmd = 77 then 
+ 	    doassignment;
+ 	if internal[7] > 131072 then begin {997:}
+ 	    begindiagnostic;
+ 	    printnl(714);
+ 	    printexp(lhs, 0);
+ 	    print(750);
+ 	    printexp(-30000, 0);
+ 	    print(706);
+ 	    enddiagnostic(false)
+ 	end {:997};
+ 	if curtype = 10 then 
+ 	    if mem[lhs].hh.b0 = 14 then begin
+ 		p := stashcurexp;
+ 		unstashcurexp(lhs);
+ 		lhs := p
+ 	    end;
+ 	makeeq(lhs)
+     end; {:995} {996:}
+ 
+     procedure doassignment;
+     var
+ 	lhs: halfword;
+ 	p: halfword;
+ 	q: halfword;
+     begin
+ 	if curtype <> 20 then begin
+ 	    disperr(-30000, 747);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 748;
+ 		helpline[0] := 749
+ 	    end;
+ 	    error;
+ 	    doequation
+ 	end else begin
+ 	    lhs := curexp;
+ 	    curtype := 1;
+ 	    getxnext;
+ 	    varflag := 77;
+ 	    scanexpression;
+ 	    if curcmd = 51 then 
+ 		doequation
+ 	    else if curcmd = 77 then 
+ 		doassignment;
+ 	    if internal[7] > 131072 then begin {998:}
+ 		begindiagnostic;
+ 		printnl(123);
+ 		if mem[lhs].hh.lh > 2241 then 
+ 		    print(intname[mem[lhs].hh.lh - 2241])
+ 		else 
+ 		    showtokenlist(lhs, -30000, 1000, 0);
+ 		print(329);
+ 		printexp(-30000, 0);
+ 		printchar(125);
+ 		enddiagnostic(false)
+ 	    end {:998};
+ 	    if mem[lhs].hh.lh > 2241 then  {999:}
+ 		if curtype = 16 then 
+ 		    internal[mem[lhs].hh.lh - 2241] := curexp
+ 		else begin
+ 		    disperr(-30000, 751);
+ 		    print(intname[mem[lhs].hh.lh - 2241]);
+ 		    print(752);
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 753;
+ 			helpline[0] := 754
+ 		    end;
+ 		    putgeterror
+ 		end {:999} {1000:}
+ 	    else begin
+ 		p := findvariable(lhs);
+ 		if p <> (-30000) then begin
+ 		    q := stashcurexp;
+ 		    curtype := undtype(p);
+ 		    recyclevalue(p);
+ 		    mem[p].hh.b0 := curtype;
+ 		    mem[p + 1].int := -30000;
+ 		    makeexpcopy(p);
+ 		    p := stashcurexp;
+ 		    unstashcurexp(q);
+ 		    makeeq(p)
+ 		end else begin
+ 		    obliterated(lhs);
+ 		    putgeterror
+ 		end
+ 	    end {:1000};
+ 	    flushnodelist(lhs)
+ 	end
+     end; {:996} {1015:}
+ 
+     procedure dotypedeclaration;
+     var
+ 	t: smallnumber;
+ 	p: halfword;
+ 	q: halfword;
+     begin
+ 	if curmod >= 13 then 
+ 	    t := curmod
+ 	else 
+ 	    t := curmod + 1;
+ 	repeat
+ 	    p := scandeclaredvariable;
+ 	    flushvariable(eqtb[mem[p].hh.lh].rh, mem[p].hh.rh, false);
+ 	    q := findvariable(p);
+ 	    if q <> (-30000) then begin
+ 		mem[q].hh.b0 := t;
+ 		mem[q + 1].int := -30000
+ 	    end else begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(764)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 765;
+ 		    helpline[0] := 766
+ 		end;
+ 		putgeterror
+ 	    end;
+ 	    flushlist(p);
+ 	    if curcmd < 79 then begin {1016:}
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(767)
+ 		end;
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 768;
+ 		    helpline[3] := 769;
+ 		    helpline[2] := 770;
+ 		    helpline[1] := 771;
+ 		    helpline[0] := 772
+ 		end;
+ 		if curcmd = 42 then 
+ 		    helpline[2] := 773;
+ 		putgeterror;
+ 		scannerstatus := 2;
+ 		repeat
+ 		    getnext; {743:}
+ 		    if curcmd = 39 then begin
+ 			if strref[curmod] < 127 then 
+ 			    if strref[curmod] > 1 then 
+ 				strref[curmod] := strref[curmod] - 1
+ 			    else 
+ 				flushstring(curmod)
+ 		    end {:743}
+ 		until curcmd >= 79;
+ 		scannerstatus := 0
+ 	    end {:1016}
+ 	until curcmd > 79
+     end; { dotypedeclaration }
+ {:1015}
+     {1021:}
+ 
+     procedure dorandomseed;
+     begin
+ 	getxnext;
+ 	if curcmd <> 77 then begin
+ 	    missingerr(329);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 778
+ 	    end;
+ 	    backerror
+ 	end;
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype <> 16 then begin
+ 	    disperr(-30000, 779);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 780;
+ 		helpline[0] := 781
+ 	    end;
+ 	    putgetflusherror(0)
+ 	end else begin {1022:}
+ 	    initrandoms(curexp);
+ 	    if selector >= 2 then begin
+ 		oldsetting := selector;
+ 		selector := 2;
+ 		printnl(782);
+ 		printscaled(curexp);
+ 		printchar(125);
+ 		printnl(155);
+ 		selector := oldsetting
+ 	    end
+ 	end {:1022}
+     end; {:1021} {1029:}
+ 
+     procedure doprotection;
+     var
+ 	m: 0..1;
+ 	t: halfword;
+     begin
+ 	m := curmod;
+ 	repeat
+ 	    getsymbol;
+ 	    t := eqtb[cursym].lh;
+ 	    if m = 0 then begin
+ 		if t >= 83 then 
+ 		    eqtb[cursym].lh := t - 83
+ 	    end else if t < 83 then 
+ 		eqtb[cursym].lh := t + 83;
+ 	    getxnext
+ 	until curcmd <> 79
+     end; {:1029} {1031:}
+ 
+     procedure defdelims;
+     var
+ 	ldelim, rdelim: halfword;
+     begin
+ 	getclearsymbol;
+ 	ldelim := cursym;
+ 	getclearsymbol;
+ 	rdelim := cursym;
+ 	eqtb[ldelim].lh := 31;
+ 	eqtb[ldelim].rh := rdelim;
+ 	eqtb[rdelim].lh := 62;
+ 	eqtb[rdelim].rh := ldelim;
+ 	getxnext
+     end; {:1031} {1034:}
+ 
+     procedure dostatement;
+     forward;
+ 
+     procedure dointerim;
+     begin
+ 	getxnext;
+ 	if curcmd <> 40 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(788)
+ 	    end;
+ 	    if cursym = 0 then 
+ 		print(793)
+ 	    else 
+ 		print(hash[cursym].rh);
+ 	    print(794);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 795
+ 	    end;
+ 	    backerror
+ 	end else begin
+ 	    saveinternal(curmod);
+ 	    backinput
+ 	end;
+ 	dostatement
+     end; { dointerim }
+ {:1034}
+     {1035:}
+ 
+     procedure dolet;
+     var
+ 	l: halfword;
+     begin
+ 	getsymbol;
+ 	l := cursym;
+ 	getxnext;
+ 	if curcmd <> 51 then 
+ 	    if curcmd <> 77 then begin
+ 		missingerr(61);
+ 		begin
+ 		    helpptr := 3;
+ 		    helpline[2] := 796;
+ 		    helpline[1] := 538;
+ 		    helpline[0] := 797
+ 		end;
+ 		backerror
+ 	    end;
+ 	getsymbol;
+ 	if curcmd in
+ 	    [10, 53, 44, 49] then
+ 	    case curcmd of
+ 		10, 53, 44, 49:
+ 		    mem[curmod].hh.lh := mem[curmod].hh.lh + 1
+ 	    end
+ 	else
+ 	    ;
+ 	clearsymbol(l, false);
+ 	eqtb[l].lh := curcmd;
+ 	if curcmd = 41 then 
+ 	    eqtb[l].rh := -30000
+ 	else 
+ 	    eqtb[l].rh := curmod;
+ 	getxnext
+     end; {:1035} {1036:}
+ 
+     procedure donewinternal;
+     begin
+ 	repeat
+ 	    if intptr = maxinternal then 
+ 		overflow(798, maxinternal);
+ 	    getclearsymbol;
+ 	    intptr := intptr + 1;
+ 	    eqtb[cursym].lh := 40;
+ 	    eqtb[cursym].rh := intptr;
+ 	    intname[intptr] := hash[cursym].rh;
+ 	    internal[intptr] := 0;
+ 	    getxnext
+ 	until curcmd <> 79
+     end; {:1036} {1040:}
+ 
+     procedure doshow;
+     begin
+ 	repeat
+ 	    getxnext;
+ 	    scanexpression;
+ 	    printnl(629);
+ 	    printexp(-30000, 2);
+ 	    flushcurexp(0)
+ 	until curcmd <> 79
+     end; {:1040} {1041:}
+ 
+     procedure disptoken;
+     begin
+ 	printnl(804);
+ 	if cursym = 0 then begin {1042:}
+ 	    if curcmd = 42 then 
+ 		printscaled(curmod)
+ 	    else if curcmd = 38 then begin
+ 		gpointer := curmod;
+ 		printcapsule
+ 	    end else begin
+ 		printchar(34);
+ 		print(curmod);
+ 		printchar(34);
+ 		begin
+ 		    if strref[curmod] < 127 then 
+ 			if strref[curmod] > 1 then 
+ 			    strref[curmod] := strref[curmod] - 1
+ 			else 
+ 			    flushstring(curmod)
+ 		end
+ 	    end
+ 	end else begin {:1042}
+ 	    print(hash[cursym].rh);
+ 	    printchar(61);
+ 	    if eqtb[cursym].lh >= 83 then 
+ 		print(805);
+ 	    printcmdmod(curcmd, curmod);
+ 	    if curcmd = 10 then begin
+ 		println;
+ 		showmacro(curmod, -30000, 100000)
+ 	    end
+ 	end
+     end; {:1041} {1044:}
+ 
+     procedure doshowtoken;
+     begin
+ 	repeat
+ 	    getnext;
+ 	    disptoken;
+ 	    getxnext
+ 	until curcmd <> 79
+     end; {:1044} {1045:}
+ 
+     procedure doshowstats;
+     {printint(varused);printchar(38);printint(dynused);
+     if false then}
+     begin
+ 	printnl(814);
+ 	print(228);
+ 	print(425);
+ 	printint((himemmin - lomemmax) - 1);
+ 	print(815);
+ 	println;
+ 	printnl(816);
+ 	printint(strptr - initstrptr);
+ 	printchar(38);
+ 	printint(poolptr - initpoolptr);
+ 	print(425);
+ 	printint(maxstrings - maxstrptr);
+ 	printchar(38);
+ 	printint(poolsize - maxpoolptr);
+ 	print(815);
+ 	println;
+ 	getxnext
+     end; {:1045}
+ {1046:}
+ 
+     procedure dispvar(p: halfword);
+     var
+ 	q: halfword;
+ 	n: 0..maxprintline;
+     begin
+ 	if mem[p].hh.b0 = 21 then begin {1047:}
+ 	    q := mem[p + 1].hh.lh;
+ 	    repeat
+ 		dispvar(q);
+ 		q := mem[q].hh.rh
+ 	    until q = (-29983);
+ 	    q := mem[p + 1].hh.rh;
+ 	    while mem[q].hh.b1 = 3 do begin
+ 		dispvar(q);
+ 		q := mem[q].hh.rh
+ 	    end
+ 	end else if mem[p].hh.b0 >= 22 then begin {:1047} {1048:}
+ 	    printnl(155);
+ 	    printvariablename(p);
+ 	    if mem[p].hh.b0 > 22 then 
+ 		print(530);
+ 	    print(817);
+ 	    if fileoffset >= (maxprintline - 20) then 
+ 		n := 5
+ 	    else 
+ 		n := (maxprintline - fileoffset) - 15;
+ 	    showmacro(mem[p + 1].int, -30000, n)
+ 	end else if mem[p].hh.b0 <> 0 then begin {:1048}
+ 	    printnl(155);
+ 	    printvariablename(p);
+ 	    printchar(61);
+ 	    printexp(p, 0)
+ 	end
+     end; {:1046} {1049:}
+ 
+     procedure doshowvar;
+     label
+ 	30;
+     begin
+ 	repeat
+ 	    getnext;
+ 	    if cursym > 0 then 
+ 		if cursym <= 2241 then 
+ 		    if curcmd = 41 then 
+ 			if curmod <> (-30000) then begin
+ 			    dispvar(curmod);
+ 			    goto 30
+ 			end;
+ 	    disptoken;
+     30:
+ 	    getxnext
+ 	until curcmd <> 79
+     end; {:1049} {1050:}
+ 
+     procedure doshowdependencies;
+     var
+ 	p: halfword;
+     begin
+ 	p := mem[-29987].hh.rh;
+ 	while p <> (-29987) do begin
+ 	    if interesting(p) then begin
+ 		printnl(155);
+ 		printvariablename(p);
+ 		if mem[p].hh.b0 = 17 then 
+ 		    printchar(61)
+ 		else 
+ 		    print(632);
+ 		printdependency(mem[p + 1].hh.rh, mem[p].hh.b0)
+ 	    end;
+ 	    p := mem[p + 1].hh.rh;
+ 	    while mem[p].hh.lh <> (-30000) do 
+ 		p := mem[p].hh.rh;
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	getxnext
+     end; {:1050} {1051:}
+ 
+     procedure doshowwhatever;
+     begin
+ 	if interaction = 3 then 
+ 	    ;
+ 	case curmod of
+ 	    0:
+ 		doshowtoken;
+ 	    1:
+ 		doshowstats;
+ 	    2:
+ 		doshow;
+ 	    3:
+ 		doshowvar;
+ 	    4:
+ 		doshowdependencies
+ 	end;
+ 	if internal[32] > 0 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(818)
+ 	    end;
+ 	    if interaction < 3 then begin
+ 		helpptr := 0;
+ 		errorcount := errorcount - 1
+ 	    end else begin
+ 		helpptr := 1;
+ 		helpline[0] := 819
+ 	    end;
+ 	    if curcmd = 80 then 
+ 		error
+ 	    else 
+ 		putgeterror
+ 	end
+     end; {:1051} {1054:}
+ 
+     function scanwith: boolean;
+     var
+ 	t: smallnumber;
+ 	result: boolean;
+     begin
+ 	t := curmod;
+ 	curtype := 1;
+ 	getxnext;
+ 	scanexpression;
+ 	result := false;
+ 	if curtype <> t then begin {1055:}
+ 	    disperr(-30000, 827);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 828;
+ 		helpline[0] := 829
+ 	    end;
+ 	    if t = 6 then 
+ 		helpline[1] := 830;
+ 	    putgetflusherror(0)
+ 	end else if curtype = 6 then  {:1055}
+ 	    result := true {1056:}
+ 	else begin
+ 	    curexp := roundunscaled(curexp);
+ 	    if (abs(curexp) < 4) and (curexp <> 0) then 
+ 		result := true
+ 	    else begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(831)
+ 		end;
+ 		begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 829
+ 		end;
+ 		putgetflusherror(0)
+ 	    end
+ 	end {:1056};
+ 	scanwith := result
+     end; {:1054} {1057:}
+ 
+     procedure findedgesvar(t: halfword);
+     var
+ 	p: halfword;
+     begin
+ 	p := findvariable(t);
+ 	curedges := -30000;
+ 	if p = (-30000) then begin
+ 	    obliterated(t);
+ 	    putgeterror
+ 	end else if mem[p].hh.b0 <> 11 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(654)
+ 	    end;
+ 	    showtokenlist(t, -30000, 1000, 0);
+ 	    print(832);
+ 	    printtype(mem[p].hh.b0);
+ 	    printchar(41);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 833;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgeterror
+ 	end else 
+ 	    curedges := mem[p + 1].int;
+ 	flushnodelist(t)
+     end; {:1057} {1059:}
+ 
+     procedure doaddto;
+     label
+ 	30, 45;
+     var
+ 	lhs, rhs: halfword;
+ 	t: smallnumber;
+ 	w: integer;
+ 	p: halfword;
+ 	q: halfword;
+     begin
+ 	getxnext;
+ 	varflag := 68;
+ 	scanprimary;
+ 	if curtype <> 20 then begin {1060:}
+ 	    disperr(-30000, 835);
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 836;
+ 		helpline[2] := 837;
+ 		helpline[1] := 838;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgetflusherror(0)
+ 	end else begin {:1060}
+ 	    lhs := curexp;
+ 	    curpathtype := curmod;
+ 	    curtype := 1;
+ 	    getxnext;
+ 	    scanexpression;
+ 	    if curpathtype = 2 then begin {1061:}
+ 		findedgesvar(lhs);
+ 		if curedges = (-30000) then 
+ 		    flushcurexp(0)
+ 		else if curtype <> 11 then begin
+ 		    disperr(-30000, 839);
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 840;
+ 			helpline[0] := 834
+ 		    end;
+ 		    putgetflusherror(0)
+ 		end else begin
+ 		    mergeedges(curexp);
+ 		    flushcurexp(0)
+ 		end
+ 	    end else begin {:1061} {1062:}
+ 		if curtype = 14 then 
+ 		    pairtopath;
+ 		if curtype <> 9 then begin
+ 		    disperr(-30000, 839);
+ 		    begin
+ 			helpptr := 2;
+ 			helpline[1] := 841;
+ 			helpline[0] := 834
+ 		    end;
+ 		    putgetflusherror(0);
+ 		    flushtokenlist(lhs)
+ 		end else begin
+ 		    rhs := curexp;
+ 		    w := 1;
+ 		    curpen := -29997;
+ 		    {
+ 		    1063:}
+ 		    while curcmd = 66 do 
+ 			if scanwith then 
+ 			    if curtype = 16 then 
+ 				w := curexp
+ 			    else begin
+ 				if mem[curpen].hh.lh = (-30000) then 
+ 				    tosspen(curpen)
+ 				else 
+ 				    mem[curpen].hh.lh := mem[curpen].hh.lh - 1;
+ 				curpen := curexp
+ 			    end {:1063}; {1064:}
+ 		    findedgesvar(lhs);
+ 		    if curedges = (-30000) then 
+ 			tossknotlist(rhs)
+ 		    else begin
+ 			lhs := -30000;
+ 			if mem[rhs].hh.b0 = 0 then 
+ 			    if curpathtype = 0 then  {1065:}
+ 				if mem[rhs].hh.rh = rhs then begin {1066:}
+ 				    mem[rhs + 5].int := mem[rhs + 1].int;
+ 				    mem[rhs + 6].int := mem[rhs + 2].int;
+ 				    mem[rhs + 3].int := mem[rhs + 1].int;
+ 				    mem[rhs + 4].int := mem[rhs + 2].int;
+ 				    mem[rhs].hh.b0 := 1;
+ 				    mem[rhs].hh.b1 := 1
+ 				end else begin {:1066}
+ 				    p := htapypoc(rhs);
+ 				    q := mem[p].hh.rh;
+ 				    mem[pathtail + 5].int := mem[q + 5].int;
+ 				    mem[pathtail + 6].int := mem[q + 6].int;
+ 				    mem[pathtail].hh.b1 := mem[q].hh.b1;
+ 				    mem[pathtail].hh.rh := mem[q].hh.rh;
+ 				    freenode(q, 7);
+ 				    mem[p + 5].int := mem[rhs + 5].int;
+ 				    mem[p + 6].int := mem[rhs + 6].int;
+ 				    mem[p].hh.b1 := mem[rhs].hh.b1;
+ 				    mem[p].hh.rh := mem[rhs].hh.rh;
+ 				    freenode(rhs, 7);
+ 				    rhs := p
+ 				end {:1065} {1067:}
+ 			    else begin
+ 				begin
+ 				    if interaction = 3 then 
+ 					;
+ 				    printnl(133);
+ 				    print(842)
+ 				end;
+ 				begin
+ 				    helpptr := 2;
+ 				    helpline[1] := 843;
+ 				    helpline[0] := 834
+ 				end;
+ 				putgeterror;
+ 				tossknotlist(rhs);
+ 				goto 45
+ 			    end {:1067}
+ 			else if curpathtype = 0 then 
+ 			    lhs := htapypoc(rhs);
+ 			curwt := w;
+ 			rhs := makespec(rhs, mem[curpen + 9].int, internal[5]); {1068:}
+ 			if turningnumber <= 0 then 
+ 			    if curpathtype <> 0 then 
+ 				if internal[39] > 0 then 
+ 				    if (turningnumber < 0) and (mem[curpen].hh.rh = (-30000)) then 
+ 					curwt := -curwt
+ 				    else begin
+ 					if turningnumber = 0 then 
+ 					    if (internal[39] <= 65536) and (mem[curpen].hh.rh = (-30000)) then 
+ 						goto 30
+ 					    else 
+ 						printstrange(844)
+ 					else 
+ 					    printstrange(845);
+ 					begin
+ 					    helpptr := 3;
+ 					    helpline[2] := 846;
+ 					    helpline[1] := 847;
+ 					    helpline[0] := 848
+ 					end;
+ 					putgeterror
+ 				    end;
+     30: {:1068}
+ 			;
+ 			if mem[curpen + 9].int = 0 then 
+ 			    fillspec(rhs)
+ 			else 
+ 			    fillenvelope(rhs);
+ 			if lhs <> (-30000) then begin
+ 			    revturns := true;
+ 			    lhs := makespec(lhs, mem[curpen + 9].int, internal[5]);
+ 			    revturns := false;
+ 			    if mem[curpen + 9].int = 0 then 
+ 				fillspec(lhs)
+ 			    else 
+ 				fillenvelope(lhs)
+ 			end;
+     45: {:1064}
+ 			
+ 		    end;
+ 		    if mem[curpen].hh.lh = (-30000) then 
+ 			tosspen(curpen)
+ 		    else 
+ 			mem[curpen].hh.lh := mem[curpen].hh.lh - 1
+ 		end
+ 	    end {:1062}
+ 	end
+     end; {:1059} {1070:} {1098:}
+ 
+     function tfmcheck(m: smallnumber): scaled;
+     begin
+ 	if abs(internal[m]) >= 134217728 then begin
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(865)
+ 	    end;
+ 	    print(intname[m]);
+ 	    print(866);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 867
+ 	    end;
+ 	    putgeterror;
+ 	    if internal[m] > 0 then 
+ 		tfmcheck := 134217727
+ 	    else 
+ 		tfmcheck := -134217727
+ 	end else 
+ 	    tfmcheck := internal[m]
+     end; {:1098}
+ 
+     procedure doshipout;
+     label
+ 	10;
+     var
+ 	c: integer;
+     begin
+ 	getxnext;
+ 	varflag := 80;
+ 	scanexpression;
+ 	{1060:
+ 	}
+ 	if curtype <> 20 then 
+ 	    if curtype = 11 then 
+ 		curedges := curexp
+ 	    else begin
+ 		begin
+ 		    disperr(-30000, 835);
+ 		    begin
+ 			helpptr := 4;
+ 			helpline[3] := 836;
+ 			helpline[2] := 837;
+ 			helpline[1] := 838;
+ 			helpline[0] := 834
+ 		    end;
+ 		    putgetflusherror(0)
+ 		end {:1060};
+ 		goto 10
+ 	    end
+ 	else begin
+ 	    findedgesvar(curexp);
+ 	    curtype := 1
+ 	end;
+ 	if curedges <> (-30000) then begin
+ 	    c := roundunscaled(internal[18]) mod 256;
+ 	    if c < 0 then 
+ 		c := c + 256; {1099:}
+ 	    if c < bc then 
+ 		bc := c;
+ 	    if c > ec then 
+ 		ec := c;
+ 	    charexists[c] := true;
+ 	    gfdx[c] := internal[24];
+ 	    gfdy[c] := internal[25];
+ 	    tfmwidth[c] := tfmcheck(20);
+ 	    tfmheight[c] := tfmcheck(21);
+ 	    tfmdepth[c] := tfmcheck(22);
+ 	    tfmitalcorr[c] := tfmcheck(23) {:1099};
+ 	    if internal[34] >= 0 then 
+ 		shipout(c)
+ 	end;
+ 	flushcurexp(0);
+     10:
+ 	
+     end; {:1070}
+ {1071:}
+ 
+     procedure dodisplay;
+     label
+ 	45, 50, 10;
+     var
+ 	e: halfword;
+     begin
+ 	getxnext;
+ 	varflag := 73;
+ 	scanprimary;
+ 	if curtype <> 20 then begin {1060:}
+ 	    disperr(-30000, 835);
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 836;
+ 		helpline[2] := 837;
+ 		helpline[1] := 838;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgetflusherror(0)
+ 	end else begin {:1060}
+ 	    e := curexp;
+ 	    curtype := 1;
+ 	    getxnext;
+ 	    scanexpression;
+ 	    if curtype <> 16 then 
+ 		goto 50;
+ 	    curexp := roundunscaled(curexp);
+ 	    if curexp < 0 then 
+ 		goto 45;
+ 	    if curexp > 15 then 
+ 		goto 45;
+ 	    if not windowopen[curexp] then 
+ 		goto 45;
+ 	    findedgesvar(e);
+ 	    if curedges <> (-30000) then 
+ 		dispedges(curexp);
+ 	    goto 10;
+     45:
+ 	    curexp := curexp * 65536;
+     50:
+ 	    disperr(-30000, 849);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 850
+ 	    end;
+ 	    putgetflusherror(0);
+ 	    flushtokenlist(e)
+ 	end;
+     10:
+ 	
+     end; { dodisplay }
+ {:1071}
+     {1072:}
+ 
+     function getpair(c: commandcode): boolean;
+     var
+ 	p: halfword;
+ 	b: boolean;
+     begin
+ 	if curcmd <> c then 
+ 	    getpair := false
+ 	else begin
+ 	    getxnext;
+ 	    scanexpression;
+ 	    if nicepair(curexp, curtype) then begin
+ 		p := mem[curexp + 1].int;
+ 		curx := mem[p + 1].int;
+ 		cury := mem[p + 3].int;
+ 		b := true
+ 	    end else 
+ 		b := false;
+ 	    flushcurexp(0);
+ 	    getpair := b
+ 	end
+     end; {:1072} {1073:}
+ 
+     procedure doopenwindow;
+     label
+ 	45, 10;
+     var
+ 	k: integer;
+ 	r0, c0, r1, c1: scaled;
+     begin
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype <> 16 then 
+ 	    goto 45;
+ 	k := roundunscaled(curexp);
+ 	if k < 0 then 
+ 	    goto 45;
+ 	if k > 15 then 
+ 	    goto 45;
+ 	if not getpair(70) then 
+ 	    goto 45;
+ 	r0 := curx;
+ 	c0 := cury;
+ 	if not getpair(71) then 
+ 	    goto 45;
+ 	r1 := curx;
+ 	c1 := cury;
+ 	if not getpair(72) then 
+ 	    goto 45;
+ 	openawindow(k, r0, c0, r1, c1, curx, cury);
+ 	goto 10;
+     45:
+ 	begin
+ 	    if interaction = 3 then 
+ 		;
+ 	    printnl(133);
+ 	    print(851)
+ 	end;
+ 	begin
+ 	    helpptr := 2;
+ 	    helpline[1] := 852;
+ 	    helpline[0] := 853
+ 	end;
+ 	putgeterror;
+     10:
+ 	
+     end; {:1073} {1074:}
+ 
+     procedure docull;
+     label
+ 	45, 10;
+     var
+ 	e: halfword;
+ 	keeping: 0..1;
+ 	w, win, wout: integer;
+     begin
+ 	w := 1;
+ 	getxnext;
+ 	varflag := 67;
+ 	scanprimary;
+ 	if curtype <> 20 then begin {1060:}
+ 	    disperr(-30000, 835);
+ 	    begin
+ 		helpptr := 4;
+ 		helpline[3] := 836;
+ 		helpline[2] := 837;
+ 		helpline[1] := 838;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgetflusherror(0)
+ 	end else begin {:1060}
+ 	    e := curexp;
+ 	    curtype := 1;
+ 	    keeping := curmod;
+ 	    if not getpair(67) then 
+ 		goto 45;
+ 	    while (curcmd = 66) and (curmod = 16) do 
+ 		if scanwith then 
+ 		    w := curexp; {1075:}
+ 	    if curx > cury then 
+ 		goto 45;
+ 	    if keeping = 0 then begin
+ 		if (curx > 0) or (cury < 0) then 
+ 		    goto 45;
+ 		wout := w;
+ 		win := 0
+ 	    end else begin
+ 		if (curx <= 0) and (cury >= 0) then 
+ 		    goto 45;
+ 		wout := 0;
+ 		win := w
+ 	    end {:1075};
+ 	    findedgesvar(e);
+ 	    if curedges <> (-30000) then 
+ 		culledges(floorunscaled(curx + 65535), floorunscaled(cury), wout, win);
+ 	    goto 10;
+     45:
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(854)
+ 	    end;
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 855
+ 	    end;
+ 	    putgeterror;
+ 	    flushtokenlist(e)
+ 	end;
+     10:
+ 	
+     end; {:1074} {1082:}
+ 
+     procedure domessage;
+     var
+ 	m: 0..2;
+     begin
+ 	m := curmod;
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype <> 4 then begin
+ 	    disperr(-30000, 565);
+ 	    begin
+ 		helpptr := 1;
+ 		helpline[0] := 859
+ 	    end;
+ 	    putgeterror
+ 	end else 
+ 	    case m of
+ 		0:
+ 		    begin
+ 			printnl(155);
+ 			slowprint(curexp)
+ 		    end;
+ 		1:
+ 		    begin {1086:}
+ 			begin
+ 			    if interaction = 3 then 
+ 				;
+ 			    printnl(133);
+ 			    print(155)
+ 			end;
+ 			slowprint(curexp);
+ 			if errhelp <> 0 then 
+ 			    useerrhelp := true
+ 			else if longhelpseen then begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 860
+ 			end else begin
+ 			    if interaction < 3 then 
+ 				longhelpseen := true;
+ 			    begin
+ 				helpptr := 4;
+ 				helpline[3] := 861;
+ 				helpline[2] := 862;
+ 				helpline[1] := 863;
+ 				helpline[0] := 864
+ 			    end
+ 			end;
+ 			putgeterror;
+ 			useerrhelp := false
+ 		    end; {:1086}
+ 		2:
+ 		    begin {1083:}
+ 			if errhelp <> 0 then begin
+ 			    if strref[errhelp] < 127 then 
+ 				if strref[errhelp] > 1 then 
+ 				    strref[errhelp] := strref[errhelp] - 1
+ 				else 
+ 				    flushstring(errhelp)
+ 			end;
+ 			if (strstart[curexp + 1] - strstart[curexp]) = 0 then 
+ 			    errhelp := 0
+ 			else begin
+ 			    errhelp := curexp;
+ 			    begin
+ 				if strref[errhelp] < 127 then 
+ 				    strref[errhelp] := strref[errhelp] + 1
+ 			    end
+ 			end
+ 		    end
+ 	    end {:1083};
+ 	flushcurexp(0)
+     end; {:1082} {1103:}
+ 
+     function getcode: eightbits;
+     label
+ 	40;
+     var
+ 	c: integer;
+     begin
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype = 16 then begin
+ 	    c := roundunscaled(curexp);
+ 	    if c >= 0 then 
+ 		if c < 256 then 
+ 		    goto 40
+ 	end else if curtype = 4 then 
+ 	    if (strstart[curexp + 1] - strstart[curexp]) = 1 then begin
+ 		c := strpool[strstart[curexp]];
+ 		goto 40
+ 	    end;
+ 	disperr(-30000, 873);
+ 	begin
+ 	    helpptr := 2;
+ 	    helpline[1] := 874;
+ 	    helpline[0] := 875
+ 	end;
+ 	putgetflusherror(0);
+ 	c := 0;
+     40:
+ 	getcode := c
+     end; {:1103} {1104:}
+ 
+     procedure settag(c: eightbits; t: smallnumber; r: eightbits);
+     begin
+ 	if chartag[c] = 0 then begin
+ 	    chartag[c] := t;
+ 	    charremainder[c] := r
+ 	end else begin {1105:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(876)
+ 	    end;
+ 	    if (c > 32) and (c < 128) then 
+ 		print(c)
+ 	    else begin
+ 		print(877);
+ 		printint(c)
+ 	    end;
+ 	    print(878);
+ 	    case chartag[c] of
+ 		1:
+ 		    print(879);
+ 		2:
+ 		    print(880);
+ 		3:
+ 		    print(870)
+ 	    end;
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 881;
+ 		helpline[0] := 834
+ 	    end;
+ 	    putgeterror
+ 	end {:1105}
+     end; {:1104} {1106:}
+ 
+     procedure dotfmcommand;
+     label
+ 	22;
+     var
+ 	c, cc: eightbits;
+ 	k: 0..256;
+ 	j: integer;
+     begin
+ 	case curmod of
+ 	    0:
+ 		begin {1107:}
+ 		    c := getcode;
+ 		    while curcmd = 78 do begin
+ 			cc := getcode;
+ 			settag(c, 2, cc);
+ 			c := cc
+ 		    end
+ 		end; {:1107}
+ 	    1:
+ 		begin {1108:}
+     22:
+ 		    c := getcode;
+ 		    if curcmd = 78 then begin {1111:}
+ 			if nl < 256 then 
+ 			    settag(c, 1, nl)
+ 			else begin
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(891)
+ 			    end;
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 892
+ 			    end;
+ 			    error
+ 			end;
+ 			goto 22
+ 		    end {:1111};
+ 		    if curcmd = 76 then begin {1112:}
+ 			ligkern[nl].b1 := c - 128;
+ 			ligkern[nl].b2 := curmod - 128;
+ 			ligkern[nl].b0 := -128;
+ 			if curmod = 0 then 
+ 			    ligkern[nl].b3 := getcode - 128
+ 			else begin
+ 			    getxnext;
+ 			    scanexpression;
+ 			    if curtype <> 16 then begin
+ 				disperr(-30000, 893);
+ 				begin
+ 				    helpptr := 2;
+ 				    helpline[1] := 894;
+ 				    helpline[0] := 179
+ 				end;
+ 				putgetflusherror(0)
+ 			    end;
+ 			    kern[nk] := curexp;
+ 			    k := 0;
+ 			    while kern[k] <> curexp do 
+ 				k := k + 1;
+ 			    if k = nk then begin
+ 				if nk = 256 then 
+ 				    overflow(890, 256);
+ 				nk := nk + 1
+ 			    end;
+ 			    ligkern[nl].b3 := k - 128
+ 			end {:1112};
+ 			if nl = ligtablesize then 
+ 			    overflow(886, ligtablesize);
+ 			nl := nl + 1;
+ 			if curcmd = 79 then 
+ 			    goto 22
+ 		    end else begin
+ 			begin
+ 			    if interaction = 3 then 
+ 				;
+ 			    printnl(133);
+ 			    print(887)
+ 			end;
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 888
+ 			end;
+ 			backerror
+ 		    end;
+ 		    if nl > 0 then 
+ 			ligkern[nl - 1].b0 := 0
+ 		end; {:1108}
+ 	    2:
+ 		begin {1113:}
+ 		    if ne = 256 then 
+ 			overflow(870, 256);
+ 		    c := getcode;
+ 		    settag(c, 3, ne);
+ 		    if curcmd <> 78 then begin
+ 			missingerr(58);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 895
+ 			end;
+ 			backerror
+ 		    end;
+ 		    exten[ne].b0 := getcode - 128;
+ 		    if curcmd <> 79 then begin
+ 			missingerr(44);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 895
+ 			end;
+ 			backerror
+ 		    end;
+ 		    exten[ne].b1 := getcode - 128;
+ 		    if curcmd <> 79 then begin
+ 			missingerr(44);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 895
+ 			end;
+ 			backerror
+ 		    end;
+ 		    exten[ne].b2 := getcode - 128;
+ 		    if curcmd <> 79 then begin
+ 			missingerr(44);
+ 			begin
+ 			    helpptr := 1;
+ 			    helpline[0] := 895
+ 			end;
+ 			backerror
+ 		    end;
+ 		    exten[ne].b3 := getcode - 128;
+ 		    ne := ne + 1
+ 		end; {:1113}
+ 	    3, 4:
+ 		begin
+ 		    c := curmod;
+ 		    getxnext;
+ 		    scanexpression;
+ 		    if (curtype <> 16) or (curexp < 32768) then begin
+ 			disperr(-30000, 882);
+ 			begin
+ 			    helpptr := 2;
+ 			    helpline[1] := 883;
+ 			    helpline[0] := 884
+ 			end;
+ 			putgeterror
+ 		    end else begin
+ 			j := roundunscaled(curexp);
+ 			if curcmd <> 78 then begin
+ 			    missingerr(58);
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 885
+ 			    end;
+ 			    backerror
+ 			end;
+ 			if c = 3 then  {1114:}
+ 			    repeat
+ 				if j > headersize then 
+ 				    overflow(871, headersize);
+ 				headerbyte[j] := getcode;
+ 				j := j + 1
+ 			    until curcmd <> 79 {:1114} {1115:}
+ 			else 
+ 			    repeat
+ 				if j > maxfontdimen then 
+ 				    overflow(872, maxfontdimen);
+ 				while j > np do begin
+ 				    np := np + 1;
+ 				    param[np] := 0
+ 				end;
+ 				getxnext;
+ 				scanexpression;
+ 				if curtype <> 16 then begin
+ 				    disperr(-30000, 896);
+ 				    begin
+ 					helpptr := 1;
+ 					helpline[0] := 179
+ 				    end;
+ 				    putgetflusherror(0)
+ 				end;
+ 				param[j] := curexp;
+ 				j := j + 1
+ 			    until curcmd <> 79 {:1115}
+ 		    end
+ 		end
+ 	end
+     end; {:1106} {1177:}
+ 
+     procedure dospecial;
+     var
+ 	m: smallnumber;
+     begin
+ 	m := curmod;
+ 	getxnext;
+ 	scanexpression;
+ 	if internal[34] >= 0 then 
+ 	    if curtype <> m then begin {1178:}
+ 		disperr(-30000, 914);
+ 		begin
+ 		    helpptr := 1;
+ 		    helpline[0] := 915
+ 		end;
+ 		putgeterror
+ 	    end else begin {:1178}
+ 		if outputfilename = 0 then 
+ 		    initgf;
+ 		if m = 4 then 
+ 		    gfstring(curexp, 0)
+ 		else begin
+ 		    begin
+ 			gfbuf[gfptr] := 243;
+ 			gfptr := gfptr + 1;
+ 			if gfptr = gflimit then 
+ 			    gfswap
+ 		    end;
+ 		    gffour(curexp)
+ 		end
+ 	    end;
+ 	flushcurexp(0)
+     end; {:1177} {1186:}
+     {procedure storebasefile;var k:integer;
+     p,q:halfword;x:integer;w:fourquarters;begin[1200:]selector:=5;
+     print(925);print(jobname);printchar(32);
+     printint(roundunscaled(internal[14])mod 100);printchar(46);
+     printint(roundunscaled(internal[15]));printchar(46);
+     printint(roundunscaled(internal[16]));printchar(41);
+     if interaction=0 then selector:=2 else selector:=3;
+     begin if poolptr+1>maxpoolptr then begin if poolptr+1>poolsize then
+     overflow(129,poolsize-initpoolptr);maxpoolptr:=poolptr+1;end;end;
+     baseident:=makestring;strref[baseident]:=127;packjobname(926);
+     while not wopenout(basefile)do promptfilename(927,926);printnl(928);
+     print(wmakenamestring(basefile));flushstring(strptr-1);
+     printnl(baseident)[:1200];[1190:]begin basefile^.int:=503742536;
+     put(basefile);end;begin basefile^.int:=-30000;put(basefile);end;
+     begin basefile^.int:=30000;put(basefile);end;begin basefile^.int:=2100;
+     put(basefile);end;begin basefile^.int:=1777;put(basefile);end;
+     begin basefile^.int:=6;put(basefile);end[:1190];
+     [1192:]begin basefile^.int:=poolptr;put(basefile);end;
+     begin basefile^.int:=strptr;put(basefile);end;
+     for k:=0 to strptr do begin basefile^.int:=strstart[k];put(basefile);
+     end;k:=0;while k+4<poolptr do begin w.b0:=strpool[k];w.b1:=strpool[k+1];
+     w.b2:=strpool[k+2];w.b3:=strpool[k+3];begin basefile^.qqqq:=w;
+     put(basefile);end;k:=k+4;end;k:=poolptr-4;w.b0:=strpool[k];
+     w.b1:=strpool[k+1];w.b2:=strpool[k+2];w.b3:=strpool[k+3];
+     begin basefile^.qqqq:=w;put(basefile);end;println;printint(strptr);
+     print(922);printint(poolptr)[:1192];[1194:]sortavail;varused:=0;
+     begin basefile^.int:=lomemmax;put(basefile);end;
+     begin basefile^.int:=rover;put(basefile);end;p:=-30000;q:=rover;x:=0;
+     repeat for k:=p to q+1 do begin basefile^:=mem[k];put(basefile);end;
+     x:=x+q+2-p;varused:=varused+q-p;p:=q+mem[q].hh.lh;q:=mem[q+1].hh.rh;
+     until q=rover;varused:=varused+lomemmax-p;dynused:=memend+1-himemmin;
+     for k:=p to lomemmax do begin basefile^:=mem[k];put(basefile);end;
+     x:=x+lomemmax+1-p;begin basefile^.int:=himemmin;put(basefile);end;
+     begin basefile^.int:=avail;put(basefile);end;
+     for k:=himemmin to memend do begin basefile^:=mem[k];put(basefile);end;
+     x:=x+memend+1-himemmin;p:=avail;
+     while p<>-30000 do begin dynused:=dynused-1;p:=mem[p].hh.rh;end;
+     begin basefile^.int:=varused;put(basefile);end;
+     begin basefile^.int:=dynused;put(basefile);end;println;printint(x);
+     print(923);printint(varused);printchar(38);printint(dynused)[:1194];
+     [1196:]begin basefile^.int:=hashused;put(basefile);end;
+     stcount:=2228-hashused;
+     for p:=1 to hashused do if hash[p].rh<>0 then begin begin basefile^.int
+     :=p;put(basefile);end;begin basefile^.hh:=hash[p];put(basefile);end;
+     begin basefile^.hh:=eqtb[p];put(basefile);end;stcount:=stcount+1;end;
+     for p:=hashused+1 to 2241 do begin begin basefile^.hh:=hash[p];
+     put(basefile);end;begin basefile^.hh:=eqtb[p];put(basefile);end;end;
+     begin basefile^.int:=stcount;put(basefile);end;println;
+     printint(stcount);print(924)[:1196];[1198:]begin basefile^.int:=intptr;
+     put(basefile);end;
+     for k:=1 to intptr do begin begin basefile^.int:=internal[k];
+     put(basefile);end;begin basefile^.int:=intname[k];put(basefile);end;end;
+     begin basefile^.int:=startsym;put(basefile);end;
+     begin basefile^.int:=interaction;put(basefile);end;
+     begin basefile^.int:=baseident;put(basefile);end;
+     begin basefile^.int:=bgloc;put(basefile);end;begin basefile^.int:=egloc;
+     put(basefile);end;begin basefile^.int:=serialno;put(basefile);end;
+     begin basefile^.int:=69069;put(basefile);end;internal[12]:=0[:1198];
+     [1201:]wclose(basefile)[:1201];end;}
+     {:1186}
+ 
+     procedure dostatement;
+     begin
+ 	curtype := 1;
+ 	getxnext;
+ 	if curcmd > 43 then begin {990:}
+ 	    if curcmd < 80 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(733)
+ 		end;
+ 		printcmdmod(curcmd, curmod);
+ 		printchar(39);
+ 		begin
+ 		    helpptr := 5;
+ 		    helpline[4] := 734;
+ 		    helpline[3] := 735;
+ 		    helpline[2] := 736;
+ 		    helpline[1] := 737;
+ 		    helpline[0] := 738
+ 		end;
+ 		backerror;
+ 		getxnext
+ 	    end
+ 	end else if curcmd > 30 then begin {:990} {993:}
+ 	    varflag := 77;
+ 	    scanexpression;
+ 	    if curcmd < 81 then begin
+ 		if curcmd = 51 then 
+ 		    doequation
+ 		else if curcmd = 77 then 
+ 		    doassignment
+ 		else if curtype = 4 then begin {994:}
+ 		    if internal[1] > 0 then begin
+ 			printnl(155);
+ 			slowprint(curexp);
+ 			{---------------------}
+ 			 auxprintnl(155);
+ 			 auxslowprint(curexp);
+ 			{---------------------}
+ 			flush(output)
+ 		    end;
+ 		    if internal[34] > 0 then begin {1179:}
+ 			if outputfilename = 0 then 
+ 			    initgf;
+ 			gfstring(916, curexp)
+ 		    end {:1179}
+ 		end else if curtype <> 1 then begin {:994}
+ 		    disperr(-30000, 743);
+ 		    begin
+ 			helpptr := 3;
+ 			helpline[2] := 744;
+ 			helpline[1] := 745;
+ 			helpline[0] := 746
+ 		    end;
+ 		    putgeterror
+ 		end;
+ 		flushcurexp(0);
+ 		curtype := 1
+ 	    end
+ 	end else begin {:993} {992:}
+ 	    if internal[7] > 0 then 
+ 		showcmdmod(curcmd, curmod);
+ 	    case curcmd of
+ 		30:
+ 		    dotypedeclaration;
+ 		16:
+ 		    if curmod > 2 then 
+ 			makeopdef
+ 		    else if curmod > 0 then 
+ 			scandef; {1020:}
+ 		24:
+ 		    dorandomseed; {:1020} {1023:}
+ 		23:
+ 		    begin
+ 			println;
+ 			interaction := curmod; {70:}
+ 			if interaction = 0 then 
+ 			    selector := 0
+ 			else 
+ 			    selector := 1 {:70};
+ 			if jobname <> 0 then 
+ 			    selector := selector + 2;
+ 			getxnext
+ 		    end; {:1023} {1026:}
+ 		21:
+ 		    doprotection; {:1026} {1030:}
+ 		27:
+ 		    defdelims; {:1030} {1033:}
+ 		12:
+ 		    repeat
+ 			getsymbol;
+ 			savevariable(cursym);
+ 			getxnext
+ 		    until curcmd <> 79;
+ 		13:
+ 		    dointerim;
+ 		14:
+ 		    dolet;
+ 		15:
+ 		    donewinternal; {:1033} {1039:}
+ 		22:
+ 		    doshowwhatever;
+ {:1039}
+ 		{1058:}
+ 		18:
+ 		    doaddto; {:1058} {1069:}
+ 		17:
+ 		    doshipout;
+ 		11:
+ 		    dodisplay;
+ 		28:
+ 		    doopenwindow;
+ 		19:
+ 		    docull; {:1069} {1076:}
+ 		26:
+ 		    begin
+ 			getsymbol;
+ 			startsym := cursym;
+ 			getxnext
+ 		    end; {:1076} {1081:}
+ 		25:
+ 		    domessage; {:1081} {1100:}
+ 		20:
+ 		    dotfmcommand; {:1100} {1175:}
+ 		29:
+ 		    dospecial
+ 	    end {:1175};
+ 	    curtype := 1
+ 	end {:992};
+ 	if curcmd < 80 then begin {991:}
+ 	    begin
+ 		if interaction = 3 then 
+ 		    ;
+ 		printnl(133);
+ 		print(739)
+ 	    end;
+ 	    begin
+ 		helpptr := 6;
+ 		helpline[5] := 740;
+ 		helpline[4] := 741;
+ 		helpline[3] := 742;
+ 		helpline[2] := 736;
+ 		helpline[1] := 737;
+ 		helpline[0] := 738
+ 	    end;
+ 	    backerror;
+ 	    scannerstatus := 2;
+ 	    repeat
+ 		getnext; {743:}
+ 		if curcmd = 39 then begin
+ 		    if strref[curmod] < 127 then 
+ 			if strref[curmod] > 1 then 
+ 			    strref[curmod] := strref[curmod] - 1
+ 			else 
+ 			    flushstring(curmod)
+ 		end {:743}
+ 	    until curcmd > 79;
+ 	    scannerstatus := 0
+ 	end {:991};
+ 	errorcount := 0
+     end; {:989}
+ {1017:}
+ 
+     procedure maincontrol;
+     begin
+ 	repeat
+ 	    dostatement;
+ 	    if curcmd = 81 then begin
+ 		begin
+ 		    if interaction = 3 then 
+ 			;
+ 		    printnl(133);
+ 		    print(774)
+ 		end;
+ 		begin
+ 		    helpptr := 2;
+ 		    helpline[1] := 775;
+ 		    helpline[0] := 555
+ 		end;
+ 		flusherror(0)
+ 	    end
+ 	until curcmd = 82
+     end; {:1017} {1117:}
+ 
+     function sortin(v: scaled): halfword;
+     label
+ 	40;
+     var
+ 	p, q, r: halfword;
+     begin
+ 	p := 29999;
+ 	while true do begin
+ 	    q := mem[p].hh.rh;
+ 	    if v <= mem[q + 1].int then 
+ 		goto 40;
+ 	    p := q
+ 	end;
+     40:
+ 	if v < mem[q + 1].int then begin
+ 	    r := getnode(2);
+ 	    mem[r + 1].int := v;
+ 	    mem[r].hh.rh := q;
+ 	    mem[p].hh.rh := r
+ 	end;
+ 	sortin := mem[p].hh.rh
+     end; {:1117}
+ {1118:}
+ 
+     function mincover(d: scaled): integer;
+     var
+ 	p: halfword;
+ 	l: scaled;
+ 	m: integer;
+     begin
+ 	m := 0;
+ 	p := mem[29999].hh.rh;
+ 	perturbation := 2147483647;
+ 	while p <> (-29981) do begin
+ 	    m := m + 1;
+ 	    l := mem[p + 1].int;
+ 	    repeat
+ 		p := mem[p].hh.rh
+ 	    until mem[p + 1].int > (l + d);
+ 	    if (mem[p + 1].int - l) < perturbation then 
+ 		perturbation := mem[p + 1].int - l
+ 	end;
+ 	mincover := m
+     end; {:1118} {1120:}
+ 
+     function threshold(m: integer): scaled;
+     var
+ 	d: scaled;
+     begin
+ 	if mincover(0) <= m then 
+ 	    threshold := 0
+ 	else begin
+ 	    repeat
+ 		d := perturbation
+ 	    until mincover(d + d) <= m;
+ 	    while mincover(d) > m do 
+ 		d := perturbation;
+ 	    threshold := d
+ 	end
+     end; {:1120}
+ {1121:}
+ 
+     function skimp(m: integer): integer;
+     var
+ 	d: scaled;
+ 	p, q, r: halfword;
+ 	l: scaled;
+ 	v: scaled;
+     begin
+ 	d := threshold(m);
+ 	perturbation := 0;
+ 	q := 29999;
+ 	m := 0;
+ 	p := mem[29999].hh.rh;
+ 	while p <> (-29981) do begin
+ 	    m := m + 1;
+ 	    l := mem[p + 1].int;
+ 	    mem[p].hh.lh := m;
+ 	    if mem[mem[p].hh.rh + 1].int <= (l + d) then begin {1122:}
+ 		repeat
+ 		    p := mem[p].hh.rh;
+ 		    mem[p].hh.lh := m
+ 		until mem[mem[p].hh.rh + 1].int > (l + d);
+ 		v := (l + mem[p + 1].int) div 2;
+ 		if (mem[p + 1].int - v) > perturbation then 
+ 		    perturbation := mem[p + 1].int - v;
+ 		r := q;
+ 		repeat
+ 		    r := mem[r].hh.rh;
+ 		    mem[r + 1].int := v
+ 		until r = p;
+ 		mem[q].hh.rh := p
+ 	    end {:1122};
+ 	    q := p;
+ 	    p := mem[p].hh.rh
+ 	end;
+ 	skimp := m
+     end; {:1121} {1123:}
+ 
+     procedure tfmwarning(m: smallnumber);
+     begin
+ 	printnl(897);
+ 	print(intname[m]);
+ 	print(898);
+ 	printscaled(perturbation);
+ 	print(899)
+     end; { tfmwarning }
+ {:1123}
+     {1128:}
+ 
+     procedure fixdesignsize;
+     var
+ 	d: scaled;
+     begin
+ 	d := internal[26];
+ 	if (d < 65536) or (d >= 134217728) then begin
+ 	    if d <> 0 then 
+ 		printnl(900);
+ 	    d := 8388608;
+ 	    internal[26] := d
+ 	end;
+ 	if headerbyte[5] < 0 then 
+ 	    if headerbyte[6] < 0 then 
+ 		if headerbyte[7] < 0 then 
+ 		    if headerbyte[8] < 0 then begin
+ 			headerbyte[5] := d div 1048576;
+ 			headerbyte[6] := (d div 4096) mod 256;
+ 			headerbyte[7] := (d div 16) mod 256;
+ 			headerbyte[8] := (d mod 16) * 16
+ 		    end;
+ 	maxtfmdimen := (16 * internal[26]) - (internal[26] div 2097152);
+ 	if maxtfmdimen >= 134217728 then 
+ 	    maxtfmdimen := 134217727
+     end; {:1128} {1129:}
+ 
+     function dimenout(x: scaled): integer;
+     begin
+ 	if abs(x) > maxtfmdimen then begin
+ 	    tfmchanged := tfmchanged + 1;
+ 	    if x > 0 then 
+ 		x := 16777215
+ 	    else 
+ 		x := -16777215
+ 	end else 
+ 	    x := makescaled(x * 16, internal[26]);
+ 	dimenout := x
+     end; {:1129} {1131:}
+ 
+     procedure fixchecksum;
+     label
+ 	10;
+     var
+ 	k: eightbits;
+ 	b1, b2, b3, b4: eightbits;
+ 	x: integer;
+     begin
+ 	if headerbyte[1] < 0 then 
+ 	    if headerbyte[2] < 0 then 
+ 		if headerbyte[3] < 0 then 
+ 		    if headerbyte[4] < 0 then begin {1132:}
+ 			b1 := bc;
+ 			b2 := ec;
+ 			b3 := bc;
+ 			b4 := ec;
+ 			tfmchanged := 0;
+ 			for k := bc to ec do 
+ 			    if charexists[k] then begin
+ 				x := dimenout(mem[tfmwidth[k] + 1].int) + ((k + 4) * 4194304);
+ 				b1 := ((b1 + b1) + x) mod 255;
+ 				b2 := ((b2 + b2) + x) mod 253;
+ 				b3 := ((b3 + b3) + x) mod 251;
+ 				b4 := ((b4 + b4) + x) mod 247
+ 			    end {:1132};
+ 			headerbyte[1] := b1;
+ 			headerbyte[2] := b2;
+ 			headerbyte[3] := b3;
+ 			headerbyte[4] := b4;
+ 			goto 10
+ 		    end;
+ 	for k := 1 to 4 do 
+ 	    if headerbyte[k] < 0 then 
+ 		headerbyte[k] := 0;
+     10:
+ 	
+     end; {:1131}
+ {1133:}
+ 
+     procedure tfmqqqq(x: fourquarters);
+     begin
+ 	bwritebyte(tfmfile, x.b0 + 128);
+ 	bwritebyte(tfmfile, x.b1 + 128);
+ 	bwritebyte(tfmfile, x.b2 + 128);
+ 	bwritebyte(tfmfile, x.b3 + 128)
+     end; {:1133}
+ {1187:}
+     {779:}
+ 
+     function openbasefile: boolean;
+     label
+ 	40, 10;
+     var
+ 	j: 0..bufsize;
+     begin
+ 	j := curinput.locfield;
+ 	if buffer[curinput.locfield] = 38 then begin
+ 	    curinput.locfield := curinput.locfield + 1;
+ 	    j := curinput.locfield;
+ 	    buffer[last] := 32;
+ 	    while buffer[j] <> 32 do 
+ 		j := j + 1;
+ 	    packbufferedname(0, curinput.locfield, j - 1);
+ 	    if wopenin(basefile) then 
+ 		goto 40;
+ 	    writeln(output, 'Sorry, I can''t find that base;', ' will try PLAIN.');
+ 	    flush(output)
+ 	end;
+ 	packbufferedname(5, 1, 0);
+ 	if not wopenin(basefile) then begin
+ 	    writeln(output, 'I can''t find the PLAIN base file!');
+ 	    openbasefile := false;
+ 	    goto 10
+ 	end;
+     40:
+ 	curinput.locfield := j;
+ 	openbasefile := true;
+     10:
+ 	
+     end; {:779}
+ 
+     function loadbasefile: boolean;
+     label
+ 	6666, 10;
+     var
+ 	k: integer;
+ 	p, q: halfword;
+ 	x: integer;
+ 	w: fourquarters; {1191:}
+     begin
+ 	x := basefile^.int;
+ 	if x <> 503742536 then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> (-30000) then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> 30000 then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> 2100 then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> 1777 then 
+ 	    goto 6666;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if x <> 6 then 
+ 	    goto 6666 {:1191};
+ {1193:}
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if x < 0 then 
+ 		goto 6666;
+ 	    if x > poolsize then begin
+ 		writeln(output, '---! Must increase the ', 'string pool size');
+ 		goto 6666
+ 	    end else 
+ 		poolptr := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if x < 0 then 
+ 		goto 6666;
+ 	    if x > maxstrings then begin
+ 		writeln(output, '---! Must increase the ', 'max strings');
+ 		goto 6666
+ 	    end else 
+ 		strptr := x
+ 	end;
+ 	for k := 0 to strptr do begin
+ 	    begin
+ 		begin
+ 		    get(basefile);
+ 		    x := basefile^.int
+ 		end;
+ 		if (x < 0) or (x > poolptr) then 
+ 		    goto 6666
+ 		else 
+ 		    strstart[k] := x
+ 	    end;
+ 	    strref[k] := 127
+ 	end;
+ 	k := 0;
+ 	while (k + 4) < poolptr do begin
+ 	    begin
+ 		get(basefile);
+ 		w := basefile^.qqqq
+ 	    end;
+ 	    strpool[k] := w.b0;
+ 	    strpool[k + 1] := w.b1;
+ 	    strpool[k + 2] := w.b2;
+ 	    strpool[k + 3] := w.b3;
+ 	    k := k + 4
+ 	end;
+ 	k := poolptr - 4;
+ 	begin
+ 	    get(basefile);
+ 	    w := basefile^.qqqq
+ 	end;
+ 	strpool[k] := w.b0;
+ 	strpool[k + 1] := w.b1;
+ 	strpool[k + 2] := w.b2;
+ 	strpool[k + 3] := w.b3 {:1193}; {1195:}
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < (-28978)) or (x > 29997) then 
+ 		goto 6666
+ 	    else 
+ 		lomemmax := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < (-29977)) or (x > lomemmax) then 
+ 		goto 6666
+ 	    else 
+ 		rover := x
+ 	end;
+ 	p := -30000;
+ 	q := rover;
+ 	x := 0;
+ 	repeat
+ 	    for k := p to q + 1 do begin
+ 		get(basefile);
+ 		mem[k] := basefile^
+ 	    end;
+ 	    p := q + mem[q].hh.lh;
+ 	    if (p > lomemmax) or ((q >= mem[q + 1].hh.rh) and (mem[q + 1].hh.rh <> rover)) then 
+ 		goto 6666;
+ 	    q := mem[q + 1].hh.rh
+ 	until q = rover;
+ 	for k := p to lomemmax do begin
+ 	    get(basefile);
+ 	    mem[k] := basefile^
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < (lomemmax + 1)) or (x > 29998) then 
+ 		goto 6666
+ 	    else 
+ 		himemmin := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < (-30000)) or (x > 30000) then 
+ 		goto 6666
+ 	    else 
+ 		avail := x
+ 	end;
+ 	memend := 30000;
+ 	for k := himemmin to memend do begin
+ 	    get(basefile);
+ 	    mem[k] := basefile^
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    varused := basefile^.int
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    dynused := basefile^.int
+ 	end {:1195}; {1197:}
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 1) or (x > 2229) then 
+ 		goto 6666
+ 	    else 
+ 		hashused := x
+ 	end;
+ 	p := 0;
+ 	repeat
+ 	    begin
+ 		begin
+ 		    get(basefile);
+ 		    x := basefile^.int
+ 		end;
+ 		if (x < (p + 1)) or (x > hashused) then 
+ 		    goto 6666
+ 		else 
+ 		    p := x
+ 	    end;
+ 	    begin
+ 		get(basefile);
+ 		hash[p] := basefile^.hh
+ 	    end;
+ 	    begin
+ 		get(basefile);
+ 		eqtb[p] := basefile^.hh
+ 	    end
+ 	until p = hashused;
+ 	for p := hashused + 1 to 2241 do begin
+ 	    begin
+ 		get(basefile);
+ 		hash[p] := basefile^.hh
+ 	    end;
+ 	    begin
+ 		get(basefile);
+ 		eqtb[p] := basefile^.hh
+ 	    end
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    stcount := basefile^.int
+ 	end {:1197}; {1199:}
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 40) or (x > maxinternal) then 
+ 		goto 6666
+ 	    else 
+ 		intptr := x
+ 	end;
+ 	for k := 1 to intptr do begin
+ 	    begin
+ 		get(basefile);
+ 		internal[k] := basefile^.int
+ 	    end;
+ 	    begin
+ 		begin
+ 		    get(basefile);
+ 		    x := basefile^.int
+ 		end;
+ 		if (x < 0) or (x > strptr) then 
+ 		    goto 6666
+ 		else 
+ 		    intname[k] := x
+ 	    end
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 0) or (x > 2229) then 
+ 		goto 6666
+ 	    else 
+ 		startsym := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 0) or (x > 3) then 
+ 		goto 6666
+ 	    else 
+ 		interaction := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 0) or (x > strptr) then 
+ 		goto 6666
+ 	    else 
+ 		baseident := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 1) or (x > 2241) then 
+ 		goto 6666
+ 	    else 
+ 		bgloc := x
+ 	end;
+ 	begin
+ 	    begin
+ 		get(basefile);
+ 		x := basefile^.int
+ 	    end;
+ 	    if (x < 1) or (x > 2241) then 
+ 		goto 6666
+ 	    else 
+ 		egloc := x
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    serialno := basefile^.int
+ 	end;
+ 	begin
+ 	    get(basefile);
+ 	    x := basefile^.int
+ 	end;
+ 	if (x <> 69069) or eof(basefile) then 
+ 	    goto 6666 {:1199};
+ 	loadbasefile := true;
+ 	goto 10;
+     6666:
+ 	;
+ 	writeln(output, '(Fatal base file error; I''m stymied)');
+ 	loadbasefile := false;
+     10:
+ 	
+     end; {:1187} {1202:} {823:}
+ 
+     procedure scanprimary;
+     label
+ 	20, 30, 31, 32;
+     var
+ 	p, q, r: halfword;
+ 	c: quarterword;
+ 	myvarflag: 0..82;
+ 	ldelim, rdelim: halfword; {831:}
+ 	groupline: integer; {:831} {836:}
+ 	num, denom: scaled; {:836} {843:}
+ 	prehead, posthead, tail: halfword;
+ 	tt: smallnumber;
+ 	t: halfword;
+ 	macroref: halfword; {:843}
+     begin
+ 	myvarflag := varflag;
+ 	varflag := 0;
+     20:
+ 	begin
+ 	    if aritherror then 
+ 		cleararith
+ 	end; {825:}
+ {if panicking then checkmem(false);}
+ 	if interrupt <> 0 then 
+ 	    if OKtointerrupt then begin
+ 		backinput;
+ 		begin
+ 		    if interrupt <> 0 then 
+ 			pauseforinstructions
+ 		end;
+ 		getxnext
+ 	    end {:825};
+ 	if curcmd in
+ 	    [31, 32, 39, 42, 33, 34, 30, 36,
+ 	     43, 37, 35, 40, 38, 41] then
+ 	    case curcmd of
+ 		31:
+ 		    begin {826:}
+ 			ldelim := cursym;
+ 			rdelim := curmod;
+ 			getxnext;
+ 			scanexpression;
+ 			if (curcmd = 79) and (curtype >= 16) then begin {830:}
+ 			    p := getnode(2);
+ 			    mem[p].hh.b0 := 14;
+ 			    mem[p].hh.b1 := 11;
+ 			    initbignode(p);
+ 			    q := mem[p + 1].int;
+ 			    stashin(q);
+ 			    getxnext;
+ 			    scanexpression;
+ 			    if curtype < 16 then begin
+ 				disperr(-30000, 639);
+ 				begin
+ 				    helpptr := 4;
+ 				    helpline[3] := 640;
+ 				    helpline[2] := 641;
+ 				    helpline[1] := 642;
+ 				    helpline[0] := 643
+ 				end;
+ 				putgetflusherror(0)
+ 			    end;
+ 			    stashin(q + 2);
+ 			    checkdelimiter(ldelim, rdelim);
+ 			    curtype := 14;
+ 			    curexp := p
+ 			end else  {:830}
+ 			    checkdelimiter(ldelim, rdelim)
+ 		    end; {:826}
+ 		32:
+ 		    begin {832:}
+ 			groupline := line;
+ 			if internal[7] > 0 then 
+ 			    showcmdmod(curcmd, curmod);
+ 			begin
+ 			    p := getavail;
+ 			    mem[p].hh.lh := 0;
+ 			    mem[p].hh.rh := saveptr;
+ 			    saveptr := p
+ 			end;
+ 			repeat
+ 			    dostatement
+ 			until curcmd <> 80;
+ 			if curcmd <> 81 then begin
+ 			    begin
+ 				if interaction = 3 then 
+ 				    ;
+ 				printnl(133);
+ 				print(644)
+ 			    end;
+ 			    printint(groupline);
+ 			    print(645);
+ 			    begin
+ 				helpptr := 2;
+ 				helpline[1] := 646;
+ 				helpline[0] := 647
+ 			    end;
+ 			    backerror;
+ 			    curcmd := 81
+ 			end;
+ 			unsave;
+ 			if internal[7] > 0 then 
+ 			    showcmdmod(curcmd, curmod)
+ 		    end; {:832}
+ 		39:
+ 		    begin {833:}
+ 			curtype := 4;
+ 			curexp := curmod
+ 		    end; {:833}
+ 		42:
+ 		    begin {837:}
+ 			curexp := curmod;
+ 			curtype := 16;
+ 			getxnext;
+ 			if curcmd <> 54 then begin
+ 			    num := 0;
+ 			    denom := 0
+ 			end else begin
+ 			    getxnext;
+ 			    if curcmd <> 42 then begin
+ 				backinput;
+ 				curcmd := 54;
+ 				curmod := 72;
+ 				cursym := 2233;
+ 				goto 30
+ 			    end;
+ 			    num := curexp;
+ 			    denom := curmod;
+ 			    if denom = 0 then begin {838:}
+ 				begin
+ 				    if interaction = 3 then 
+ 					;
+ 				    printnl(133);
+ 				    print(648)
+ 				end;
+ 				begin
+ 				    helpptr := 1;
+ 				    helpline[0] := 649
+ 				end;
+ 				error
+ 			    end else  {:838}
+ 				curexp := makescaled(num, denom);
+ 			    begin
+ 				if aritherror then 
+ 				    cleararith
+ 			    end;
+ 			    getxnext
+ 			end;
+ 			if curcmd >= 30 then 
+ 			    if curcmd < 42 then begin
+ 				p := stashcurexp;
+ 				scanprimary;
+ 				if (abs(num) >= abs(denom)) or (curtype < 14) then 
+ 				    dobinary(p, 71)
+ 				else begin
+ 				    fracmult(num, denom);
+ 				    freenode(p, 2)
+ 				end
+ 			    end;
+ 			goto 30
+ 		    end; {:837}
+ 		33: {834:}
+ 		    donullary(curmod) {:834};
+ 		34, 30, 36, 43:
+ 		    begin {835:}
+ 			c := curmod;
+ 			getxnext;
+ 			scanprimary;
+ 			dounary(c);
+ 			goto 30
+ 		    end; {:835}
+ 		37:
+ 		    begin {839:}
+ 			c := curmod;
+ 			getxnext;
+ 			scanexpression;
+ 			if curcmd <> 69 then begin
+ 			    missingerr(347);
+ 			    print(581);
+ 			    printcmdmod(37, c);
+ 			    begin
+ 				helpptr := 1;
+ 				helpline[0] := 582
+ 			    end;
+ 			    backerror
+ 			end;
+ 			p := stashcurexp;
+ 			getxnext;
+ 			scanprimary;
+ 			dobinary(p, c);
+ 			goto 30
+ 		    end; {:839}
+ 		35:
+ 		    begin {840:}
+ 			getxnext;
+ 			scansuffix;
+ 			oldsetting := selector;
+ 			selector := 5;
+ 			showtokenlist(curexp, -30000, 100000, 0);
+ 			flushtokenlist(curexp);
+ 			curexp := makestring;
+ 			selector := oldsetting;
+ 			curtype := 4;
+ 			goto 30
+ 		    end; {:840}
+ 		40:
+ 		    begin {841:}
+ 			q := curmod;
+ 			if myvarflag = 77 then begin
+ 			    getxnext;
+ 			    if curcmd = 77 then begin
+ 				curexp := getavail;
+ 				mem[curexp].hh.lh := q + 2241;
+ 				curtype := 20;
+ 				goto 30
+ 			    end;
+ 			    backinput
+ 			end;
+ 			curtype := 16;
+ 			curexp := internal[q]
+ 		    end; {:841}
+ 		38:
+ 		    makeexpcopy(curmod);
+ 		41:
+ 		    begin {844:}
+ 			begin
+ 			    prehead := avail;
+ 			    if prehead = (-30000) then 
+ 				prehead := getavail
+ 			    else begin
+ 				avail := mem[prehead].hh.rh;
+ 				mem[prehead].hh.rh := -30000
+ 			    end {dynused:=dynused+1;}
+ 			end;
+ 			tail := prehead;
+ 			posthead := -30000;
+ 			tt := 1;
+ 			while true do begin
+ 			    t := curtok;
+ 			    mem[tail].hh.rh := t;
+ 			    if tt <> 0 then begin {850:}
+ 				begin
+ 				    p := mem[prehead].hh.rh;
+ 				    q := mem[p].hh.lh;
+ 				    tt := 0;
+ 				    if (eqtb[q].lh mod 83) = 41 then begin
+ 					q := eqtb[q].rh;
+ 					if q = (-30000) then 
+ 					    goto 32;
+ 					while true do begin
+ 					    p := mem[p].hh.rh;
+ 					    if p = (-30000) then begin
+ 						tt := mem[q].hh.b0;
+ 						goto 32
+ 					    end;
+ 					    if mem[q].hh.b0 <> 21 then 
+ 						goto 32;
+ 					    q := mem[mem[q + 1].hh.lh].hh.rh;
+ 					    if p >= himemmin then begin
+ 						repeat
+ 						    q := mem[q].hh.rh
+ 						until mem[q + 2].hh.lh >= mem[p].hh.lh;
+ 						if mem[q + 2].hh.lh > mem[p].hh.lh then 
+ 						    goto 32
+ 					    end
+ 					end
+ 				    end;
+     32: {:850}
+ 				    
+ 				end;
+ 				if tt >= 22 then begin {845:}
+ 				    mem[tail].hh.rh := -30000;
+ 				    if tt > 22 then begin
+ 					posthead := getavail;
+ 					tail := posthead;
+ 					mem[tail].hh.rh := t;
+ 					tt := 0;
+ 					macroref := mem[q + 1].int;
+ 					mem[macroref].hh.lh := mem[macroref].hh.lh + 1
+ 				    end else begin {853:}
+ 					p := getavail;
+ 					mem[prehead].hh.lh := mem[prehead].hh.rh;
+ 					mem[prehead].hh.rh := p;
+ 					mem[p].hh.lh := t;
+ 					macrocall(mem[q + 1].int, prehead, -30000);
+ 					getxnext;
+ 					goto 20
+ 				    end {:853}
+ 				end {:845}
+ 			    end;
+ 			    getxnext;
+ 			    tail := t;
+ 			    if curcmd = 63 then begin {846:}
+ 				getxnext;
+ 				scanexpression;
+ 				if curcmd <> 64 then begin {847:}
+ 				    backinput;
+ 				    backexpr;
+ 				    curcmd := 63;
+ 				    curmod := 0;
+ 				    cursym := 2232
+ 				end else begin {:847}
+ 				    if curtype <> 16 then 
+ 					badsubscript;
+ 				    curcmd := 42;
+ 				    curmod := curexp;
+ 				    cursym := 0
+ 				end
+ 			    end {:846};
+ 			    if curcmd > 42 then 
+ 				goto 31;
+ 			    if curcmd < 40 then 
+ 				goto 31
+ 			end;
+     31: {852:}
+ 			if posthead <> (-30000) then begin {854:}
+ 			    backinput;
+ 			    p := getavail;
+ 			    q := mem[posthead].hh.rh;
+ 			    mem[prehead].hh.lh := mem[prehead].hh.rh;
+ 			    mem[prehead].hh.rh := posthead;
+ 			    mem[posthead].hh.lh := q;
+ 			    mem[posthead].hh.rh := p;
+ 			    mem[p].hh.lh := mem[q].hh.rh;
+ 			    mem[q].hh.rh := -30000;
+ 			    macrocall(macroref, prehead, -30000);
+ 			    mem[macroref].hh.lh := mem[macroref].hh.lh - 1;
+ 			    getxnext;
+ 			    goto 20
+ 			end {:854};
+ 			q := mem[prehead].hh.rh;
+ 			begin
+ 			    mem[prehead].hh.rh := avail;
+ 			    avail := prehead
+ 			end
+ {dynused:=dynused-1;};
+ 			if curcmd = myvarflag then begin
+ 			    curtype := 20;
+ 			    curexp := q;
+ 			    goto 30
+ 			end;
+ 			p := findvariable(q);
+ 			if p <> (-30000) then 
+ 			    makeexpcopy(p)
+ 			else begin
+ 			    obliterated(q);
+ 			    helpline[2] := 661;
+ 			    helpline[1] := 662;
+ 			    helpline[0] := 663;
+ 			    putgetflusherror(0)
+ 			end;
+ 			flushnodelist(q);
+ 			goto 30 {:852}
+ 		    end
+ 	    end
+ 	else
+ 	    begin {:844}
+ 		badexp(633);
+ 		goto 20
+ 	    end;
+ 	getxnext;
+     30:
+ 	if curcmd = 63 then 
+ 	    if curtype >= 16 then begin {859:}
+ 		p := stashcurexp;
+ 		getxnext;
+ 		scanexpression;
+ 		if curcmd <> 79 then begin {847:}
+ 		    begin
+ 			backinput;
+ 			backexpr;
+ 			curcmd := 63;
+ 			curmod := 0;
+ 			cursym := 2232
+ 		    end {:847};
+ 		    unstashcurexp(p)
+ 		end else begin
+ 		    q := stashcurexp;
+ 		    getxnext;
+ 		    scanexpression;
+ 		    if curcmd <> 64 then begin
+ 			missingerr(93);
+ 			begin
+ 			    helpptr := 3;
+ 			    helpline[2] := 665;
+ 			    helpline[1] := 666;
+ 			    helpline[0] := 563
+ 			end;
+ 			backerror
+ 		    end;
+ 		    r := stashcurexp;
+ 		    makeexpcopy(q);
+ 		    dobinary(r, 70);
+ 		    dobinary(p, 71);
+ 		    dobinary(q, 69);
+ 		    getxnext
+ 		end
+ 	    end {:859}
+     end; {:823} {860:}
+ 
+     procedure scansuffix;
+     label
+ 	30;
+     var
+ 	h, t: halfword;
+ 	p: halfword;
+     begin
+ 	h := getavail;
+ 	t := h;
+ 	while true do begin
+ 	    if curcmd = 63 then begin {861:}
+ 		getxnext;
+ 		scanexpression;
+ 		if curtype <> 16 then 
+ 		    badsubscript;
+ 		if curcmd <> 64 then begin
+ 		    missingerr(93);
+ 		    begin
+ 			helpptr := 3;
+ 			helpline[2] := 667;
+ 			helpline[1] := 666;
+ 			helpline[0] := 563
+ 		    end;
+ 		    backerror
+ 		end;
+ 		curcmd := 42;
+ 		curmod := curexp
+ 	    end {:861};
+ 	    if curcmd = 42 then 
+ 		p := newnumtok(curmod)
+ 	    else if (curcmd = 41) or (curcmd = 40) then begin
+ 		p := getavail;
+ 		mem[p].hh.lh := cursym
+ 	    end else 
+ 		goto 30;
+ 	    mem[t].hh.rh := p;
+ 	    t := p;
+ 	    getxnext
+ 	end;
+     30:
+ 	curexp := mem[h].hh.rh;
+ 	begin
+ 	    mem[h].hh.rh := avail;
+ 	    avail := h
+ 	end {dynused:=dynused-1;};
+ 	curtype := 20
+     end; {:860} {862:}
+ 
+     procedure scansecondary;
+     label
+ 	20, 22;
+     var
+ 	p, q, r: halfword;
+ 	c, d: halfword;
+ 	macname: halfword;
+     begin
+     20:
+ 	if (curcmd < 30) or (curcmd > 43) then 
+ 	    badexp(668);
+ 	scanprimary;
+     22:
+ 	if curcmd <= 55 then 
+ 	    if curcmd >= 52 then begin
+ 		p := stashcurexp;
+ 		c := curmod;
+ 		d := curcmd;
+ 		if d = 53 then begin
+ 		    macname := cursym;
+ 		    mem[c].hh.lh := mem[c].hh.lh + 1
+ 		end;
+ 		getxnext;
+ 		scanprimary;
+ 		if d <> 53 then 
+ 		    dobinary(p, c)
+ 		else begin
+ 		    backinput;
+ 		    binarymac(p, c, macname);
+ 		    mem[c].hh.lh := mem[c].hh.lh - 1;
+ 		    getxnext;
+ 		    goto 20
+ 		end;
+ 		goto 22
+ 	    end
+     end; {:862}
+ {864:}
+ 
+     procedure scantertiary;
+     label
+ 	20, 22;
+     var
+ 	p: halfword;
+ 	c, d: halfword;
+ 	macname: halfword;
+     begin
+     20:
+ 	if (curcmd < 30) or (curcmd > 43) then 
+ 	    badexp(669);
+ 	scansecondary;
+ 	if curtype = 8 then 
+ 	    materializepen;
+     22:
+ 	if curcmd <= 45 then 
+ 	    if curcmd >= 43 then begin
+ 		p := stashcurexp;
+ 		c := curmod;
+ 		d := curcmd;
+ 		if d = 44 then begin
+ 		    macname := cursym;
+ 		    mem[c].hh.lh := mem[c].hh.lh + 1
+ 		end;
+ 		getxnext;
+ 		scansecondary;
+ 		if d <> 44 then 
+ 		    dobinary(p, c)
+ 		else begin
+ 		    backinput;
+ 		    binarymac(p, c, macname);
+ 		    mem[c].hh.lh := mem[c].hh.lh - 1;
+ 		    getxnext;
+ 		    goto 20
+ 		end;
+ 		goto 22
+ 	    end
+     end; {:864}
+ {868:}
+ 
+     procedure scanexpression;
+     label
+ 	20, 30, 22, 25, 26, 10;
+     var
+ 	p, q, r, pp, qq: halfword;
+ 	c, d: halfword;
+ 	myvarflag: 0..82;
+ 	macname: halfword;
+ 	cyclehit: boolean;
+ 	x, y: scaled;
+ 	t: 0..4;
+     begin
+ 	myvarflag := varflag;
+     20:
+ 	if (curcmd < 30) or (curcmd > 43) then 
+ 	    badexp(672);
+ 	scantertiary;
+     22:
+ 	if curcmd <= 51 then 
+ 	    if curcmd >= 46 then 
+ 		if (curcmd <> 51) or (myvarflag <> 77) then begin
+ 		    p := stashcurexp;
+ 		    c := curmod;
+ 		    d := curcmd;
+ 		    if d = 49 then begin
+ 			macname := cursym;
+ 			mem[c].hh.lh := mem[c].hh.lh + 1
+ 		    end;
+ 		    if (d < 48) or ((d = 48) and ((mem[p].hh.b0 = 14) or (mem[p].hh.b0 = 9))) then begin {869:}
+ 			cyclehit := false; {870:}
+ 			begin
+ 			    unstashcurexp(p);
+ 			    if curtype = 14 then 
+ 				p := newknot
+ 			    else if curtype = 9 then 
+ 				p := curexp
+ 			    else 
+ 				goto 10;
+ 			    q := p;
+ 			    while mem[q].hh.rh <> p do 
+ 				q := mem[q].hh.rh;
+ 			    if mem[p].hh.b0 <> 0 then begin
+ 				r := copyknot(p);
+ 				mem[q].hh.rh := r;
+ 				q := r
+ 			    end;
+ 			    mem[p].hh.b0 := 4;
+ 			    mem[q].hh.b1 := 4
+ 			end {:870};
+     25: {874:}
+ 			if curcmd = 46 then begin {879:}
+ 			    t := scandirection;
+ 			    if t <> 4 then begin
+ 				mem[q].hh.b1 := t;
+ 				mem[q + 5].int := curexp;
+ 				if mem[q].hh.b0 = 4 then begin
+ 				    mem[q].hh.b0 := t;
+ 				    mem[q + 3].int := curexp
+ 				end
+ 			    end
+ 			end {:879};
+ 			d := curcmd;
+ 			if d = 47 then begin {881:}
+ 			    getxnext;
+ 			    if curcmd = 58 then begin {882:}
+ 				getxnext;
+ 				y := curcmd;
+ 				if curcmd = 59 then 
+ 				    getxnext;
+ 				scanprimary; {883:}
+ 				if (curtype <> 16) or (curexp < 49152) then begin
+ 				    disperr(-30000, 690);
+ 				    begin
+ 					helpptr := 1;
+ 					helpline[0] := 691
+ 				    end;
+ 				    putgetflusherror(65536)
+ 				end {:883};
+ 				if y = 59 then 
+ 				    curexp := -curexp;
+ 				mem[q + 6].int := curexp;
+ 				if curcmd = 52 then begin
+ 				    getxnext;
+ 				    y := curcmd;
+ 				    if curcmd = 59 then 
+ 					getxnext;
+ 				    scanprimary; {883:}
+ 				    if (curtype <> 16) or (curexp < 49152) then begin
+ 					disperr(-30000, 690);
+ 					begin
+ 					    helpptr := 1;
+ 					    helpline[0] := 691
+ 					end;
+ 					putgetflusherror(65536)
+ 				    end {:883};
+ 				    if y = 59 then 
+ 					curexp := -curexp
+ 				end;
+ 				y := curexp
+ 			    end else if curcmd = 57 then begin {:882} {884:}
+ 				mem[q].hh.b1 := 1;
+ 				t := 1;
+ 				getxnext;
+ 				scanprimary;
+ 				knownpair;
+ 				mem[q + 5].int := curx;
+ 				mem[q + 6].int := cury;
+ 				if curcmd <> 52 then begin
+ 				    x := mem[q + 5].int;
+ 				    y := mem[q + 6].int
+ 				end else begin
+ 				    getxnext;
+ 				    scanprimary;
+ 				    knownpair;
+ 				    x := curx;
+ 				    y := cury
+ 				end
+ 			    end else begin {:884}
+ 				mem[q + 6].int := 65536;
+ 				y := 65536;
+ 				backinput;
+ 				goto 30
+ 			    end;
+ 			    if curcmd <> 47 then begin
+ 				missingerr(279);
+ 				begin
+ 				    helpptr := 1;
+ 				    helpline[0] := 689
+ 				end;
+ 				backerror
+ 			    end;
+     30: {:881}
+ 			    
+ 			end else if d <> 48 then 
+ 			    goto 26;
+ 			getxnext;
+ 			if curcmd = 46 then begin {880:}
+ 			    t := scandirection;
+ 			    if mem[q].hh.b1 <> 1 then 
+ 				x := curexp
+ 			    else 
+ 				t := 1
+ 			end else if mem[q].hh.b1 <> 1 then begin {:880}
+ 			    t := 4;
+ 			    x := 0
+ 			end {:874};
+ 			if curcmd = 36 then begin {886:}
+ 			    cyclehit := true;
+ 			    getxnext;
+ 			    pp := p;
+ 			    qq := p;
+ 			    if d = 48 then 
+ 				if p = q then begin
+ 				    d := 47;
+ 				    mem[q + 6].int := 65536;
+ 				    y := 65536
+ 				end
+ 			end else begin {:886}
+ 			    scantertiary; {885:}
+ 			    begin
+ 				if curtype <> 9 then 
+ 				    pp := newknot
+ 				else 
+ 				    pp := curexp;
+ 				qq := pp;
+ 				while mem[qq].hh.rh <> pp do 
+ 				    qq := mem[qq].hh.rh;
+ 				if mem[pp].hh.b0 <> 0 then begin
+ 				    r := copyknot(pp);
+ 				    mem[qq].hh.rh := r;
+ 				    qq := r
+ 				end;
+ 				mem[pp].hh.b0 := 4;
+ 				mem[qq].hh.b1 := 4
+ 			    end {:885}
+ 			end; {887:}
+ 			begin
+ 			    if d = 48 then 
+ 				if (mem[q + 1].int <> mem[pp + 1].int) or (mem[q + 2].int <> mem[pp + 2].int) then begin
+ 				    begin
+ 					if interaction = 3 then 
+ 					    ;
+ 					printnl(133);
+ 					print(692)
+ 				    end;
+ 				    begin
+ 					helpptr := 3;
+ 					helpline[2] := 693;
+ 					helpline[1] := 694;
+ 					helpline[0] := 695
+ 				    end;
+ 				    putgeterror;
+ 				    d := 47;
+ 				    mem[q + 6].int := 65536;
+ 				    y := 65536
+ 				end;
+ {889:}
+ 			    if mem[pp].hh.b1 = 4 then 
+ 				if (t = 3) or (t = 2) then begin
+ 				    mem[pp].hh.b1 := t;
+ 				    mem[pp + 5].int := x
+ 				end {:889};
+ 			    if d = 48 then begin {890:}
+ 				if mem[q].hh.b0 = 4 then 
+ 				    if mem[q].hh.b1 = 4 then begin
+ 					mem[q].hh.b0 := 3;
+ 					mem[q + 3].int := 65536
+ 				    end;
+ 				if mem[pp].hh.b1 = 4 then 
+ 				    if t = 4 then begin
+ 					mem[pp].hh.b1 := 3;
+ 					mem[pp + 5].int := 65536
+ 				    end;
+ 				mem[q].hh.b1 := mem[pp].hh.b1;
+ 				mem[q].hh.rh := mem[pp].hh.rh;
+ 				mem[q + 5].int := mem[pp + 5].int;
+ 				mem[q + 6].int := mem[pp + 6].int;
+ 				freenode(pp, 7);
+ 				if qq = pp then 
+ 				    qq := q
+ 			    end else begin {:890} {888:}
+ 				if mem[q].hh.b1 = 4 then 
+ 				    if (mem[q].hh.b0 = 3) or (mem[q].hh.b0 = 2) then begin
+ 					mem[q].hh.b1 := mem[q].hh.b0;
+ 					mem[q + 5].int := mem[q + 3].int
+ 				    end {:888};
+ 				mem[q].hh.rh := pp;
+ 				mem[pp + 4].int := y;
+ 				if t <> 4 then begin
+ 				    mem[pp + 3].int := x;
+ 				    mem[pp].hh.b0 := t
+ 				end
+ 			    end;
+ 			    q := qq
+ 			end {:887};
+ 			if curcmd >= 46 then 
+ 			    if curcmd <= 48 then 
+ 				if not cyclehit then 
+ 				    goto 25;
+     26: {891:}
+ 			if cyclehit then begin
+ 			    if d = 48 then 
+ 				p := q
+ 			end else begin
+ 			    mem[p].hh.b0 := 0;
+ 			    if mem[p].hh.b1 = 4 then begin
+ 				mem[p].hh.b1 := 3;
+ 				mem[p + 5].int := 65536
+ 			    end;
+ 			    mem[q].hh.b1 := 0;
+ 			    if mem[q].hh.b0 = 4 then begin
+ 				mem[q].hh.b0 := 3;
+ 				mem[q + 3].int := 65536
+ 			    end;
+ 			    mem[q].hh.rh := p
+ 			end;
+ 			makechoices(p);
+ 			curtype := 9;
+ 			curexp := p {:891}
+ 		    end else begin {:869}
+ 			getxnext;
+ 			scantertiary;
+ 			if d <> 49 then 
+ 			    dobinary(p, c)
+ 			else begin
+ 			    backinput;
+ 			    binarymac(p, c, macname);
+ 			    mem[c].hh.lh := mem[c].hh.lh - 1;
+ 			    getxnext;
+ 			    goto 20
+ 			end
+ 		    end;
+ 		    goto 22
+ 		end;
+     10:
+ 	
+     end; {:868} {892:}
+ 
+     procedure getboolean;
+     begin
+ 	getxnext;
+ 	scanexpression;
+ 	if curtype <> 2 then begin
+ 	    disperr(-30000, 696);
+ 	    begin
+ 		helpptr := 2;
+ 		helpline[1] := 697;
+ 		helpline[0] := 698
+ 	    end;
+ 	    putgetflusherror(31);
+ 	    curtype := 2
+ 	end
+     end; {:892} {224:}
+ 
+     procedure printcapsule;
+     begin
+ 	printchar(40);
+ 	printexp(gpointer, 0);
+ 	printchar(41)
+     end;
+ 
+     procedure tokenrecycle;
+     begin
+ 	recyclevalue(gpointer)
+     end; {:224} {1205:}
+ 
+     procedure closefilesandtermina;
+     var
+ 	k: integer;
+ 	lh: integer;
+ 	p: halfword;
+ 	x: scaled;
+     {if internal[12]>0 then[1208:]if jobname>0 then begin writeln(
+     logfile,' ');
+     writeln(logfile,'Here is how much of METAFONT''s memory',' you used:');
+     write(logfile,' ',maxstrptr-initstrptr:1,' string');
+     if maxstrptr<>initstrptr+1 then write(logfile,'s');
+     writeln(logfile,' out of ',maxstrings-initstrptr:1);
+     writeln(logfile,' ',maxpoolptr-initpoolptr:1,
+     ' string characters out of ',poolsize-initpoolptr:1);
+     writeln(logfile,' ',lomemmax+30000+memend-himemmin+2:1,
+     ' words of memory out of ',memend+30001:1);
+     writeln(logfile,' ',stcount:1,' symbolic tokens out of ',2100:1);
+     writeln(logfile,' ',maxinstack:1,'i,',intptr:1,'n,',maxroundingptr:1,
+     'r,',maxparamstack:1,'p,',maxbufstack+1:1,'b stack positions out of ',
+     stacksize:1,'i,',maxinternal:1,'n,',maxwiggle:1,'r,',150:1,'p,',bufsize:
+     1,'b');end[:1208];}
+     begin
+ 	{1206:}
+ 	if (gfprevptr > 0) or (internal[33] > 0) then begin {1207:}
+ 	    rover := -29977;
+ 	    mem[rover].hh.rh := 32767;
+ 	    lomemmax := himemmin - 1;
+ 	    if (lomemmax - rover) > 32767 then 
+ 		lomemmax := 32767 + rover;
+ 	    mem[rover].hh.lh := lomemmax - rover;
+ 	    mem[rover + 1].hh.lh := rover;
+ 	    mem[rover + 1].hh.rh := rover;
+ 	    mem[lomemmax].hh.rh := -30000;
+ 	    mem[lomemmax].hh.lh := -30000 {:1207}; {1124:}
+ 	    mem[29999].hh.rh := -29981;
+ 	    for k := bc to ec do 
+ 		if charexists[k] then 
+ 		    tfmwidth[k] := sortin(tfmwidth[k]);
+ 	    nw := skimp(255) + 1;
+ 	    dimenhead[1] := mem[29999].hh.rh;
+ 	    if perturbation >= 4096 then 
+ 		tfmwarning(20) {:1124};
+ 	    fixdesignsize;
+ 	    fixchecksum;
+ 	    if internal[33] > 0 then begin {1126:}
+ 		mem[29999].hh.rh := -29981;
+ 		for k := bc to ec do 
+ 		    if charexists[k] then 
+ 			if tfmheight[k] = 0 then 
+ 			    tfmheight[k] := -29985
+ 			else 
+ 			    tfmheight[k] := sortin(tfmheight[k]);
+ 		nh := skimp(15) + 1;
+ 		dimenhead[2] := mem[29999].hh.rh;
+ 		if perturbation >= 4096 then 
+ 		    tfmwarning(21);
+ 		mem[29999].hh.rh := -29981;
+ 		for k := bc to ec do 
+ 		    if charexists[k] then 
+ 			if tfmdepth[k] = 0 then 
+ 			    tfmdepth[k] := -29985
+ 			else 
+ 			    tfmdepth[k] := sortin(tfmdepth[k]);
+ 		nd := skimp(15) + 1;
+ 		dimenhead[3] := mem[29999].hh.rh;
+ 		if perturbation >= 4096 then 
+ 		    tfmwarning(22);
+ 		mem[29999].hh.rh := -29981;
+ 		for k := bc to ec do 
+ 		    if charexists[k] then 
+ 			if tfmitalcorr[k] = 0 then 
+ 			    tfmitalcorr[k] := -29985
+ 			else 
+ 			    tfmitalcorr[k] := sortin(tfmitalcorr[k]);
+ 		ni := skimp(63) + 1;
+ 		dimenhead[4] := mem[29999].hh.rh;
+ 		if perturbation >= 4096 then 
+ 		    tfmwarning(23) {:1126}; {1134:}
+ 		if jobname = 0 then 
+ 		    openlogfile;
+ 		packjobname(901);
+ 		while not bopenout(tfmfile, nameoffile) do 
+ 		    promptfilename(902, 901);
+ 		metricfilename := bmakenamestring(tfmfile); {1135:}
+ 		k := headersize;
+ 		while headerbyte[k] < 0 do 
+ 		    k := k - 1;
+ 		lh := (k + 3) div 4;
+ 		if bc > ec then 
+ 		    bc := 1;
+ 		bwrite2bytes(tfmfile, (((((((((6 + lh) + ((ec - bc) + 1)) + nw) + nh) + nd) + ni) + nl) + nk) + ne) + np);
+ 		bwrite2bytes(tfmfile, lh);
+ 		bwrite2bytes(tfmfile, bc);
+ 		bwrite2bytes(tfmfile, ec);
+ 		bwrite2bytes(tfmfile, nw);
+ 		bwrite2bytes(tfmfile, nh);
+ 		bwrite2bytes(tfmfile, nd);
+ 		bwrite2bytes(tfmfile, ni);
+ 		bwrite2bytes(tfmfile, nl);
+ 		bwrite2bytes(tfmfile, nk);
+ 		bwrite2bytes(tfmfile, ne);
+ 		bwrite2bytes(tfmfile, np);
+ 		for k := 1 to 4 * lh do begin
+ 		    if headerbyte[k] < 0 then 
+ 			headerbyte[k] := 0;
+ 		    bwritebyte(tfmfile, headerbyte[k])
+ 		end {:1135}; {1137:}
+ 		for k := bc to ec do 
+ 		    if not charexists[k] then 
+ 			bwrite4bytes(tfmfile, 0)
+ 		    else begin
+ 			bwritebyte(tfmfile, mem[tfmwidth[k]].hh.lh);
+ 			bwritebyte(tfmfile, (mem[tfmheight[k]].hh.lh * 16) + mem[tfmdepth[k]].hh.lh);
+ 			bwritebyte(tfmfile, (mem[tfmitalcorr[k]].hh.lh * 4) + chartag[k]);
+ 			bwritebyte(tfmfile, charremainder[k])
+ 		    end {:1137}; {1138:}
+ 		tfmchanged := 0;
+ 		for k := 1 to 4 do begin
+ 		    bwrite4bytes(tfmfile, 0);
+ 		    p := dimenhead[k];
+ 		    while p <> (-29981) do begin
+ 			bwrite4bytes(tfmfile, dimenout(mem[p + 1].int));
+ 			p := mem[p].hh.rh
+ 		    end
+ 		end {:1138}; {1139:}
+ 		for k := 0 to nl - 1 do 
+ 		    tfmqqqq(ligkern[k]);
+ 		for k := 0 to nk - 1 do 
+ 		    bwrite4bytes(tfmfile, dimenout(kern[k])) {:1139};
+ {1140:}
+ 		for k := 0 to ne - 1 do 
+ 		    tfmqqqq(exten[k]) {:1140}; {1141:}
+ 		for k := 1 to np do 
+ 		    if k = 1 then 
+ 			if abs(param[1]) < 134217728 then 
+ 			    bwrite4bytes(tfmfile, param[1] * 16)
+ 			else begin
+ 			    tfmchanged := tfmchanged + 1;
+ 			    if param[1] > 0 then 
+ 				bwrite4bytes(tfmfile, 2147483647)
+ 			    else 
+ 				bwrite4bytes(tfmfile, -2147483647)
+ 			end
+ 		    else 
+ 			bwrite4bytes(tfmfile, dimenout(param[k]));
+ 		if tfmchanged > 0 then begin
+ 		    if tfmchanged = 1 then 
+ 			printnl(904)
+ 		    else begin
+ 			printnl(40);
+ 			printint(tfmchanged);
+ 			print(905)
+ 		    end;
+ 		    print(906)
+ 		end {:1141};
+ {if internal[12]>0 then[1136:]begin writeln(logfile,' ');
+ writeln(logfile,'(You used ',nw:1,'w,',nh:1,'h,',nd:1,'d,',ni:1,'i,',nl:
+ 1,'l,',nk:1,'k,',ne:1,'e,',np:1,'p metric file positions');
+ writeln(logfile,'  out of ','256w,16h,16d,64i,',ligtablesize:1,
+ 'l,256k,256e,',maxfontdimen:1,'p)');end[:1136];}
+ 		printnl(903);
+ 		print(metricfilename);
+ 		bclose(tfmfile) {:1134}
+ 	    end;
+ 	    if gfprevptr > 0 then begin {1182:}
+ 		begin
+ 		    gfbuf[gfptr] := 248;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(gfprevptr);
+ 		gfprevptr := (gfoffset + gfptr) - 5;
+ 		gffour(internal[26] * 16);
+ 		for k := 1 to 4 do begin
+ 		    gfbuf[gfptr] := headerbyte[k];
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(internal[27]);
+ 		gffour(internal[28]);
+ 		gffour(gfminm);
+ 		gffour(gfmaxm);
+ 		gffour(gfminn);
+ 		gffour(gfmaxn);
+ 		for k := 0 to 255 do 
+ 		    if charexists[k] then begin
+ 			x := gfdx[k] div 65536;
+ 			if (((gfdy[k] = 0) and (x >= 0)) and (x < 256)) and (gfdx[k] = (x * 65536)) then begin
+ 			    begin
+ 				gfbuf[gfptr] := 246;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end;
+ 			    begin
+ 				gfbuf[gfptr] := k;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end;
+ 			    begin
+ 				gfbuf[gfptr] := x;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end
+ 			end else begin
+ 			    begin
+ 				gfbuf[gfptr] := 245;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end;
+ 			    begin
+ 				gfbuf[gfptr] := k;
+ 				gfptr := gfptr + 1;
+ 				if gfptr = gflimit then 
+ 				    gfswap
+ 			    end;
+ 			    gffour(gfdx[k]);
+ 			    gffour(gfdy[k])
+ 			end;
+ 			x := mem[tfmwidth[k] + 1].int;
+ 			if abs(x) > maxtfmdimen then 
+ 			    if x > 0 then 
+ 				x := 16777215
+ 			    else 
+ 				x := -16777215
+ 			else 
+ 			    x := makescaled(x * 16, internal[26]);
+ 			gffour(x);
+ 			gffour(charptr[k])
+ 		    end;
+ 		begin
+ 		    gfbuf[gfptr] := 249;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		gffour(gfprevptr);
+ 		begin
+ 		    gfbuf[gfptr] := 131;
+ 		    gfptr := gfptr + 1;
+ 		    if gfptr = gflimit then 
+ 			gfswap
+ 		end;
+ 		k := 4 + ((gfbufsize - gfptr) mod 4);
+ 		while k > 0 do begin
+ 		    begin
+ 			gfbuf[gfptr] := 223;
+ 			gfptr := gfptr + 1;
+ 			if gfptr = gflimit then 
+ 			    gfswap
+ 		    end;
+ 		    k := k - 1
+ 		end; {1156:}
+ 		if gflimit = halfbuf then 
+ 		    bwritebuf(gffile, gfbuf, halfbuf, gfbufsize - 1);
+ 		if gfptr > 0 then 
+ 		    bwritebuf(gffile, gfbuf, 0, gfptr - 1) {:1156};
+ 		printnl(917);
+ 		print(outputfilename);
+ 		print(425);
+ 		printint(totalchars);
+ 		print(918);
+ 		if totalchars <> 1 then 
+ 		    printchar(115);
+ 		print(919);
+ 		printint(gfoffset + gfptr);
+ 		print(920);
+ 		bclose(gffile)
+ 	    end {:1182}
+ 	end {:1206};
+ 	if jobname > 0 then begin
+ 	    writeln(logfile);
+ 	    aclose(logfile);
+ 	    selector := selector - 2;
+ 	    if selector = 1 then begin
+ 		printnl(929);
+ 		print(logname);
+ 		printchar(46)
+ 	    end
+ 	end;
+ 	println;
+ 	if (editnamestart <> 0) and (interaction > 0) then 
+ 	    calledit(strpool[editnamestart], editnamelength, editline)
+     end; {:1205} {1209:}
+ 
+     procedure finalcleanup;
+     label
+ 	10;
+     var
+ 	c: smallnumber;
+     begin
+ 	c := curmod;
+ 	if jobname = 0 then 
+ 	    openlogfile;
+ 	while condptr <> (-30000) do begin
+ 	    printnl(930);
+ 	    printcmdmod(2, curif);
+ 	    if ifline <> 0 then begin
+ 		print(931);
+ 		printint(ifline)
+ 	    end;
+ 	    print(932);
+ 	    ifline := mem[condptr + 1].int;
+ 	    curif := mem[condptr].hh.b1;
+ 	    condptr := mem[condptr].hh.rh
+ 	end;
+ 	if history <> 0 then 
+ 	    if (history = 1) or (interaction < 3) then 
+ 		if selector = 3 then begin
+ 		    selector := 1;
+ 		    printnl(933);
+ 		    selector := 3
+ 		end;
+ 	if c = 1 then begin {storebasefile;goto 10;}
+ 	    printnl(934);
+ 	    goto 10
+ 	end;
+     10:
+ 	
+     end; {:1209} {1210:}
+     {procedure initprim;begin[192:]primitive(280,40,1);
+     primitive(281,40,2);primitive(282,40,3);primitive(283,40,4);
+     primitive(284,40,5);primitive(285,40,6);primitive(286,40,7);
+     primitive(287,40,8);primitive(288,40,9);primitive(289,40,10);
+     primitive(290,40,11);primitive(291,40,12);primitive(292,40,13);
+     primitive(293,40,14);primitive(294,40,15);primitive(295,40,16);
+     primitive(296,40,17);primitive(297,40,18);primitive(298,40,19);
+     primitive(299,40,20);primitive(300,40,21);primitive(301,40,22);
+     primitive(302,40,23);primitive(303,40,24);primitive(304,40,25);
+     primitive(305,40,26);primitive(306,40,27);primitive(307,40,28);
+     primitive(308,40,29);primitive(309,40,30);primitive(310,40,31);
+     primitive(311,40,32);primitive(312,40,33);primitive(313,40,34);
+     primitive(314,40,35);primitive(315,40,36);primitive(316,40,37);
+     primitive(317,40,38);primitive(318,40,39);primitive(319,40,40);
+     [:192][211:]primitive(279,47,0);primitive(91,63,0);
+     eqtb[2232]:=eqtb[cursym];primitive(93,64,0);primitive(125,65,0);
+     primitive(123,46,0);primitive(58,78,0);eqtb[2234]:=eqtb[cursym];
+     primitive(329,77,0);primitive(44,79,0);primitive(59,80,0);
+     eqtb[2235]:=eqtb[cursym];primitive(92,7,0);primitive(330,18,0);
+     primitive(331,72,0);primitive(332,59,0);primitive(333,32,0);
+     bgloc:=cursym;primitive(334,57,0);primitive(335,19,0);
+     primitive(336,60,0);primitive(337,27,0);primitive(338,11,0);
+     primitive(323,81,0);eqtb[2239]:=eqtb[cursym];egloc:=cursym;
+     primitive(339,26,0);primitive(340,6,0);primitive(341,9,0);
+     primitive(342,70,0);primitive(343,73,0);primitive(344,13,0);
+     primitive(345,14,0);primitive(346,15,0);primitive(347,69,0);
+     primitive(348,28,0);primitive(349,24,0);primitive(350,12,0);
+     primitive(351,8,0);primitive(352,17,0);primitive(353,74,0);
+     primitive(354,35,0);primitive(355,58,0);primitive(356,71,0);
+     primitive(357,75,0);[:211][683:]primitive(520,16,1);primitive(521,16,2);
+     primitive(522,16,53);primitive(523,16,44);primitive(524,16,49);
+     primitive(324,16,0);eqtb[2237]:=eqtb[cursym];primitive(525,4,2242);
+     primitive(526,4,2392);primitive(527,4,1);primitive(325,4,0);
+     eqtb[2236]:=eqtb[cursym];[:683][688:]primitive(528,61,0);
+     primitive(529,61,1);primitive(64,61,2);primitive(530,61,3);
+     [:688][695:]primitive(541,56,2242);primitive(542,56,2392);
+     primitive(543,56,2542);primitive(544,56,1);primitive(545,56,2);
+     primitive(546,56,3);[:695][709:]primitive(556,3,0);primitive(482,3,1);
+     [:709][740:]primitive(583,1,1);primitive(322,2,2);
+     eqtb[2238]:=eqtb[cursym];primitive(584,2,3);primitive(585,2,4);
+     [:740][893:]primitive(218,33,30);primitive(219,33,31);
+     primitive(220,33,32);primitive(221,33,33);primitive(222,33,34);
+     primitive(223,33,35);primitive(224,33,36);primitive(225,33,37);
+     primitive(226,34,38);primitive(227,34,39);primitive(228,34,40);
+     primitive(229,34,41);primitive(230,34,42);primitive(231,34,43);
+     primitive(232,34,44);primitive(233,34,45);primitive(234,34,46);
+     primitive(235,34,47);primitive(236,34,48);primitive(237,34,49);
+     primitive(238,34,50);primitive(239,34,51);primitive(240,34,52);
+     primitive(241,34,53);primitive(242,34,54);primitive(243,34,55);
+     primitive(244,34,56);primitive(245,34,57);primitive(246,34,58);
+     primitive(247,34,59);primitive(248,34,60);primitive(249,34,61);
+     primitive(250,34,62);primitive(251,34,63);primitive(252,34,64);
+     primitive(253,34,65);primitive(254,34,66);primitive(255,34,67);
+     primitive(256,36,68);primitive(43,43,69);primitive(45,43,70);
+     primitive(42,55,71);primitive(47,54,72);eqtb[2233]:=eqtb[cursym];
+     primitive(257,45,73);primitive(181,45,74);primitive(259,52,76);
+     primitive(258,45,75);primitive(60,50,77);primitive(260,50,78);
+     primitive(62,50,79);primitive(261,50,80);primitive(61,51,81);
+     primitive(262,50,82);primitive(272,37,94);primitive(273,37,95);
+     primitive(274,37,96);primitive(275,37,97);primitive(276,37,98);
+     primitive(277,37,99);primitive(278,37,100);primitive(38,48,83);
+     primitive(263,55,84);primitive(264,55,85);primitive(265,55,86);
+     primitive(266,55,87);primitive(267,55,88);primitive(268,55,89);
+     primitive(269,55,90);primitive(270,55,91);primitive(271,45,92);
+     [:893][1013:]primitive(211,30,15);primitive(197,30,4);
+     primitive(195,30,2);primitive(202,30,9);primitive(199,30,6);
+     primitive(204,30,11);primitive(206,30,13);primitive(207,30,14);
+     [:1013][1018:]primitive(776,82,0);primitive(777,82,1);
+     [:1018][1024:]primitive(143,23,0);primitive(144,23,1);
+     primitive(145,23,2);primitive(783,23,3);
+     [:1024][1027:]primitive(784,21,0);primitive(785,21,1);
+     [:1027][1037:]primitive(799,22,0);primitive(800,22,1);
+     primitive(801,22,2);primitive(802,22,3);primitive(803,22,4);
+     [:1037][1052:]primitive(820,68,1);primitive(821,68,0);
+     primitive(822,68,2);primitive(823,66,6);primitive(824,66,16);
+     primitive(825,67,0);primitive(826,67,1);
+     [:1052][1079:]primitive(856,25,0);primitive(857,25,1);
+     primitive(858,25,2);[:1079][1101:]primitive(868,20,0);
+     primitive(869,20,1);primitive(870,20,2);primitive(871,20,3);
+     primitive(872,20,4);[:1101][1109:]primitive(889,76,0);
+     primitive(890,76,128);[:1109][1176:]primitive(912,29,4);
+     primitive(913,29,16);[:1176];end;procedure inittab;var k:integer;
+     begin[176:]rover:=-29977;mem[rover].hh.rh:=32767;mem[rover].hh.lh:=1000;
+     mem[rover+1].hh.lh:=rover;mem[rover+1].hh.rh:=rover;
+     lomemmax:=rover+1000;mem[lomemmax].hh.rh:=-30000;
+     mem[lomemmax].hh.lh:=-30000;
+     for k:=29998 to 30000 do mem[k]:=mem[lomemmax];avail:=-30000;
+     memend:=30000;himemmin:=29998;varused:=23;dynused:=-1;
+     [:176][193:]intname[1]:=280;intname[2]:=281;intname[3]:=282;
+     intname[4]:=283;intname[5]:=284;intname[6]:=285;intname[7]:=286;
+     intname[8]:=287;intname[9]:=288;intname[10]:=289;intname[11]:=290;
+     intname[12]:=291;intname[13]:=292;intname[14]:=293;intname[15]:=294;
+     intname[16]:=295;intname[17]:=296;intname[18]:=297;intname[19]:=298;
+     intname[20]:=299;intname[21]:=300;intname[22]:=301;intname[23]:=302;
+     intname[24]:=303;intname[25]:=304;intname[26]:=305;intname[27]:=306;
+     intname[28]:=307;intname[29]:=308;intname[30]:=309;intname[31]:=310;
+     intname[32]:=311;intname[33]:=312;intname[34]:=313;intname[35]:=314;
+     intname[36]:=315;intname[37]:=316;intname[38]:=317;intname[39]:=318;
+     intname[40]:=319;[:193][203:]hashused:=2229;stcount:=0;
+     hash[2240].rh:=321;hash[2238].rh:=322;hash[2239].rh:=323;
+     hash[2237].rh:=324;hash[2236].rh:=325;hash[2235].rh:=59;
+     hash[2234].rh:=58;hash[2233].rh:=47;hash[2232].rh:=91;hash[2231].rh:=41;
+     hash[2229].rh:=326;eqtb[2231].lh:=62;
+     [:203][229:]mem[-29981].hh.lh:=2242;mem[-29981].hh.rh:=-30000;
+     [:229][324:]mem[30000].hh.lh:=32767;
+     [:324][475:]mem[-29997].hh.lh:=-30000;mem[-29997].hh.rh:=-30000;
+     mem[-29996].hh.lh:=1;mem[-29996].hh.rh:=-30000;
+     for k:=-29995 to-29989 do mem[k]:=mem[-29996];mem[-29988].int:=0;
+     mem[-30000].hh.rh:=-30000;mem[-30000].hh.lh:=-30000;mem[-29999].int:=0;
+     mem[-29998].int:=0;[:475][587:]serialno:=0;mem[-29987].hh.rh:=-29987;
+     mem[-29986].hh.lh:=-29987;mem[-29987].hh.lh:=-30000;
+     mem[-29986].hh.rh:=-30000;[:587][702:]mem[-29979].hh.b1:=0;
+     mem[-29979].hh.rh:=2240;eqtb[2240].rh:=-29979;eqtb[2240].lh:=41;
+     [:702][759:]eqtb[2230].lh:=88;hash[2230].rh:=600;
+     [:759][911:]mem[-29983].hh.b1:=11;
+     [:911][1116:]mem[-29980].int:=1073741824;
+     [:1116][1127:]mem[-29984].int:=0;mem[-29985].hh.lh:=0;
+     [:1127][1185:]baseident:=921;[:1185]end;}
+ {:1210}
+ {1212:}
+ {procedure debughelp;label 888,10;var k,l,m,n:integer;
+ begin while true do begin;printnl(935);flush(output);read(input,m);
+ if m<0 then goto 10 else if m=0 then begin goto 888;
+ 888:m:=0;
+ ['BREAKPOINT']
+ end else begin read(input,n);case m of[1213:]1:printword(mem[n]);
+ 2:printint(mem[n].hh.lh);3:printint(mem[n].hh.rh);
+ 4:begin printint(eqtb[n].lh);printchar(58);printint(eqtb[n].rh);end;
+ 5:printvariablename(n);6:printint(internal[n]);7:doshowdependencies;
+ 9:showtokenlist(n,-30000,100000,0);10:print(n);11:checkmem(n>0);
+ 12:searchmem(n);13:begin read(input,l);printcmdmod(n,l);end;
+ 14:for k:=0 to n do print(buffer[k]);15:panicking:=not panicking;
+ [:1213]others:print(63)end;end;end;10:end;}
+ {:1212}
+ {:1202}
+ {1204:}
+ 
+ begin
+ {-----------------------------------}
+     init_ps(psfile);
+ {-----------------------------------}
+     history := 3;
+     setpaths;
+     if readyalready = 314159 then 
+ 	goto 1; {14:}
+     bad := 0;
+     if (halferrorline < 30) or (halferrorline > (errorline - 15)) then 
+ 	bad := 1;
+     if maxprintline < 60 then 
+ 	bad := 2;
+     if (gfbufsize mod 8) <> 0 then 
+ 	bad := 3;
+     if (-28900) > 30000 then 
+ 	bad := 4;
+     if 1777 > 2100 then 
+ 	bad := 5;
+     if (headersize mod 4) <> 0 then 
+ 	bad := 6; {:14} {154:}
+ {if memmax<>30000 then bad:=10;}
+     if memmax < 30000 then 
+ 	bad := 10;
+     if ((-128) > 0) or (127 < 127) then 
+ 	bad := 11;
+     if ((-32768) > 0) or (32767 < 32767) then 
+ 	bad := 12;
+     if ((-128) < (-32768)) or (127 > 32767) then 
+ 	bad := 13;
+     if ((-30000) < (-32768)) or (memmax >= 32767) then 
+ 	bad := 14;
+     if maxstrings > 32767 then 
+ 	bad := 15;
+     if bufsize > 32767 then 
+ 	bad := 16;
+     if (255 < 255) or (65535 < 65535) then 
+ 	bad := 17; {:154} {204:}
+     if (2241 + maxinternal) > 32767 then 
+ 	bad := 21; {:204} {214:}
+     if 2692 > 32767 then 
+ 	bad := 22; {:214} {310:}
+     if (15 * 11) > bistacksize then 
+ 	bad := 31; {:310} {553:}
+     if (20 + (17 * 45)) > bistacksize then 
+ 	bad := 32; {:553} {777:}
+     if 10 > filenamesize then 
+ 	bad := 41; {:777}
+     if bad > 0 then begin
+ 	writeln(output, 'Ouch---my internal constants have been clobbered!', '---case ', bad: 1);
+ 	{if not getstringsstarted then goto 9999;
+ 	inittab;initprim;}
+ 	goto 9999
+     end;
+     initialize;
+     readyalready := 314159;
+ 1: {55:}
+     selector := 1;
+     tally := 0;
+     termoffset := 0;
+     fileoffset := 0; {:55} {61:}
+     write(output, 'This is METAFONT, Version 1.0 for Berkeley UNIX');
+     {-----------------------------------------------------------------}
+     writeln(output);
+     writeln(output,'*** embedded METAFONT to PostScript Compiler ***');
+     {-----------------------------------------------------------------}
+     if baseident = 0 then 
+ 	writeln(output, ' (no base preloaded)')
+     else begin
+ 	print(baseident);
+ 	println
+     end;
+     flush(output); {:61} {783:}
+     jobname := 0; {:783}
+ {792:}
+     outputfilename := 0; {:792} {1211:} {657:}
+     begin
+ 	begin
+ 	    inputptr := 0;
+ 	    maxinstack := 0;
+ 	    inopen := 0;
+ 	    maxbufstack := 0;
+ 	    paramptr := 0;
+ 	    maxparamstack := 0;
+ 	    first := 1;
+ 	    curinput.startfield := 1;
+ 	    curinput.indexfield := 0;
+ 	    line := 0;
+ 	    curinput.namefield := 0;
+ 	    forceeof := false;
+ 	    if not initterminal then 
+ 		goto 9999;
+ 	    curinput.limitfield := last;
+ 	    first := last + 1
+ 	end; {:657} {660:}
+ 	scannerstatus := 0; {:660}
+ 	if (baseident = 0) or (buffer[curinput.locfield] = 38) then begin
+ 	    if baseident <> 0 then 
+ 		initialize;
+ 	    if not openbasefile then 
+ 		goto 9999;
+ 	    if not loadbasefile then begin
+ 		wclose(basefile);
+ 		goto 9999
+ 	    end;
+ 	    wclose(basefile);
+ 	    while (curinput.locfield < curinput.limitfield) and (buffer[curinput.locfield] = 32) do 
+ 		curinput.locfield := curinput.locfield + 1
+ 	end;
+ 	buffer[curinput.limitfield] := 37;
+ 	fixdateandtime;
+ 	initrandoms((internal[17] div 65536) + internal[16]); {70:}
+ 	if interaction = 0 then 
+ 	    selector := 0
+ 	else 
+ 	    selector := 1 {:70};
+ 	if curinput.locfield < curinput.limitfield then 
+ 	    if buffer[curinput.locfield] <> 92 then 
+ 		startinput
+     end {:1211};
+     initstrptr := strptr;
+     initpoolptr := poolptr;
+     maxstrptr := strptr;
+     maxpoolptr := poolptr;
+     history := 0;
+     if startsym > 0 then begin
+ 	cursym := startsym;
+ 	backinput
+     end;
+     maincontrol;
+     finalcleanup;
+ 9998:
+     closefilesandtermina;
+ 9999:
+     readyalready := 0;
+ {---------------------------------}
+ tini_ps(g);
+ {---------------------------------}
+     if (history <> 0) and (history <> 1) then 
+ 	exit(1)
+     else 
+ 	exit(0);
+ end. {:1204}
+ 


Index: llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/ptc.p
diff -c /dev/null llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/ptc.p:1.1.2.1
*** /dev/null	Mon Mar  1 17:59:22 2004
--- llvm/test/Programs/MultiSource/Benchmarks/MallocBench/p2c/INPUT/ptc.p	Mon Mar  1 17:59:12 2004
***************
*** 0 ****
--- 1,9736 ----
+ (***************************************************************************)
+ (***************************************************************************)
+ (**									  **)
+ (**	Copyright (C) 1987 by Per Bergsten, Gothenburg, Sweden		  **)
+ (**									  **)
+ (**	No part of this program, or parts derived from this program,	  **)
+ (**	may be sold, hired or otherwise exploited without the author's	  **)
+ (**	written consent.						  **)
+ (**									  **)
+ (**	The program may be freely redistributed provided that:		  **)
+ (**									  **)
+ (**		1) the original program text, including this notice,	  **)
+ (**		   is reproduced unaltered,				  **)
+ (**		2) no charge (other than a nominal media cost) is	  **)
+ (**		   demanded for the copy.				  **)
+ (**									  **)
+ (**	The program may be included in a package only on the condition	  **)
+ (**	that the package as a whole is distributed at media cost.	  **)
+ (**									  **)
+ (***************************************************************************)
+ (***************************************************************************)
+ (**									  **)
+ (**	The program ptc is a Pascal-to-C translator.			  **)
+ (**	It accepts a correct Pascal program and creates a C program	  **)
+ (**	with the same behaviour. It is not a complete compiler in the	  **)
+ (**	sense that it does NOT do complete typechecking or error-	  **)
+ (**	reporting. Only a minimal typecheck is done so that the meaning	  **)
+ (**	of each construct can be determined. Therefore, an incorrect	  **)
+ (**	Pascal program can easily cause the translator to malfunction.	  **)
+ (**									  **)
+ (***************************************************************************)
+ (***************************************************************************)
+ (**									  **)
+ (**	Things which are known to be dependent on the underlying cha-	  **)
+ (**	racterset are marked with a comment containing the word	CHAR.	  **)
+ (**	Things that are known to be dependent on the host operating	  **)
+ (**	system are marked with a comment containing the word OS.	  **)
+ (**	Things known to be dependent on the cpu and/or the target C-	  **)
+ (**	implementation are marked with the word CPU.			  **)
+ (**	Things dependent on the target C-library are marked with LIB.	  **)
+ (**									  **)
+ (**	The code generated by the translator assumes that there	is a	  **)
+ (**	C-implementation with at least a reasonable <stdio> library	  **)
+ (**	since all input/output is implemented in terms of C functions	  **)
+ (**	like fprintf(), getc(), fopen(), rewind() etc.			  **)
+ (**	If the source-program uses Pascal functions like sin(), sqrt()	  **)
+ (**	etc, there must also exist such functions in the C-library.	  **)
+ (**									  **)
+ (***************************************************************************)
+ (***************************************************************************)
+ 
+ program	ptc(input, output);
+ 
+ label	9999;				(* end of program		*)
+ 
+ const	version		= '@(#)ptc.p	1.5  Date 87/05/01';
+ 
+ 	keytablen	= 38;		(* nr of keywords		*)
+ 	keywordlen	= 10;		(* length of a keyword		*)
+ 	othersym	= 'otherwise '; (* keyword for others		*)
+ 	externsym	= 'external  '; (* keyword for external		*)
+ 	dummysym	= '          '; (* dummy keyword		*)
+ 
+ 	(* a Pascal set is implemented as an array of "wordtype" where	*)
+ 	(* each element contains bits numbered from 0 to "setbits"	*)
+ 	wordtype	= 'unsigned short';	(* CPU *)
+ 	setbits		= 15;			(* CPU *)
+ 
+ 	(* a Pascal file is implemented as a struct which (among other	*)
+ 	(* things) contain a flag-field, currently 3 bits are used	*)
+ 	filebits	= 'unsigned short';	(* flags for files	*)
+ 	filefill	= 12;			(* 16 less used 3 bits	*)
+ 
+ 	maxsetrange	= 15;			(* nr of words in a set	*)
+ 	scalbase	= 0;	(* ordinal value of first scalar member	*)
+ 
+ 	maxprio		= 7;
+ 
+ 	maxmachdefs	= 8;	(* max nr of machine integer types	*)
+ 	machdeflen	= 16;	(* max length of machine int type name	*)
+ 
+ 	(* limit of identifier table, identifiers and strings are saved	*)
+ 	(* in an array 0 .. maxblkcnt of ^ array 0 .. maxstrblk of char	*)
+ 	maxstrblk	= 1023;
+ 	maxblkcnt	= 63;
+ 	maxstrstor	= 65535; (* maxstrstor should be ==
+ 					(maxblkcnt+1) * (maxstrblk+1) - 1 *)
+ 
+ 	maxtoknlen	= 127;	(* max size of token (i.e. identifier,
+ 				   string or number); must be > keywordlen
+ 				   and should be <= 256, see hashtokn()	*)
+ 
+ 	hashmax		= 64;	(* size of hashtable - 1		*)
+ 
+ 	null		= 0;	(* "impossible" character value, CHAR;
+ 				   a char with this value is used as delimiter
+ 				   of strings in "strstor" and in toknbuffers;
+ 				   it is also used as end-of-input marker by
+ 				   the input procedures in lexical analysis *)
+ 
+ 	minchar		= null;
+ 	maxchar		= 127;	(* greatest possible character, CHAR; limits
+ 				   the number of elements in type "char" *)
+ 
+ 	(* tmpfilename is used in the generated code to obtain names of
+ 	   temporary files for reset/rewrite, the last character is supplied
+ 	   by the reset/rewrite routine *)
+ 	tmpfilename	= '"/tmp/ptc%d%c", getpid(), '; (* OS *)
+ 
+ 	(* some frequently used characters *)
+ 	space		= ' ';
+ 	tab1		= '	';
+ 	tab2		= '		';
+ 	tab3		= '			';
+ 	tab4		= '				';
+ 	bslash		= '\';
+ 	nlchr		= '''\n''';
+ 	ffchr		= '''\f''';
+ 	nulchr		= '''\0''';
+ 	spchr		= ''' ''';
+ 	quote		= '''';
+ 	cite		= '"';
+ 	xpnent		= 'e';		(* exponent char in output. CPU	*)
+ 	percent		= '%';
+ 	uscore		= '_';
+ 	badchr		= '?';		(* CHAR *)
+ 	okchr		= quote;	(* CHAR *)
+ 
+ 	tabwidth	= 8;		(* width of a tab-stop. OS	*)
+ 
+ 	echo		= false; 	(* echo input as read		*)
+ 	diffcomm	= false; 	(* comment delimiters different	*)
+ 	lazyfor		= false; 	(* compile for-stmts a la C	*)
+ 	unionnew	= true; 	(* malloc unions for variants	*)
+ 
+ 	inttyp		= 'int';	(* for predefined functions	*)
+ 	chartyp		= 'char';
+ 	setwtyp		= 'setword';
+ 	setptyp		= 'setptr';
+ 	floattyp	= 'float';
+ 	doubletyp	= 'double';
+ 	dblcast		= '(double)';	(* for predefined functions	*)
+ 
+ 	realtyp		= doubletyp;	(* user real-vars and functions	*)
+ 
+ 	voidtyp		= 'void';	(* for procedures 		*)
+ 	voidcast	= '(void)';
+ 
+ 	intlen		= 10;		(* length of written integer	*)
+ 	fixlen		= 20;		(* length of written real	*)
+ 
+ type
+ 	hashtyp	= 0 .. hashmax;		(* index to hash-tables	*)
+ 
+ 	strindx	= 0 .. maxstrstor;	(* index to "strstor"		*)
+ 
+ 	(* string-table "strstor" is implemented as an array that is grown
+ 	   dynamically by adding blocks when needed *)
+ 	strbidx	= 0 .. maxstrblk;
+ 	strblk	= array [ strbidx ] of char;
+ 	strptr	= ^ strblk;
+ 	strbcnt	= 0 .. maxblkcnt;
+ 
+ 	(* table for stored identifiers *)
+ 	(* an identifier in any scope is represented by an idnode which is
+ 	   hooked to a slot in "idtab" as determined by a hash-function.
+ 	   whenever the input procedures find an identifier its idnode is
+ 	   immediately located, or created, if none was found; the identifier
+ 	   is then always handled though a pointer to the idnode. the actual
+ 	   text of the identifier is stored in "strstor". *)
+ 	idptr	= ^ idnode;
+ 	idnode	= record
+ 			inext	: idptr;	(* chain of idnode's	*)
+ 			inref	: 0 .. 127;	(* # of refs to this id	*)
+ 			ihash	: hashtyp;	(* its hash value	*)
+ 			istr	: strindx;	(* index to "strstor"	*)
+ 		  end;
+ 
+ 	(* toknbuf is used to handle identifiers and strings in those situations
+ 	   where the actual text is of intrest *)
+ 	toknidx	= 1 .. maxtoknlen;
+ 	toknbuf	= array [ toknidx ] of char;
+ 
+ 	(* a type to hold Pascal keywords *)
+ 	keyword	= packed array [ 1 .. keywordlen ] of char;
+ 
+ 	(* predefined identifier enumeration *)
+ 	predefs = (
+ 		dabs,		darctan,	dargc,		dargv,
+ 		dboolean,	dchar,		dchr,		dclose,
+ 		dcos,		ddispose,	deof,		deoln,
+ 		dexit,		dexp,		dfalse,		dflush,
+ 		dget,		dhalt,		dinput,		dinteger,
+ 		dln,		dmaxint,	dmessage,	dnew,
+ 		dodd,		dord,		doutput,	dpage,
+ 		dpack,		dpred,		dput,		dread,
+ 		dreadln,	dreal,		dreset,		drewrite,
+ 		dround,		dsin,		dsqr,		dsqrt,
+ 		dsucc,		dtext,		dtrue,		dtrunc,
+ 		dtan,		dwrite,		dwriteln,	dunpack,
+ 		dzinit,		dztring
+ 	);
+ 
+ 	(* lexical symbol enumeration *)
+ 	symtyp	= (
+ 	    (* keywords and eof are sorted alphabetically ...... *)
+ 		sand,		sarray,		sbegin,		scase,
+ 		sconst,		sdiv,		sdo,		sdownto,
+ 		selse,		send,		sextern,	sfile,
+ 		sfor,		sforward,	sfunc,		sgoto,
+ 		sif,		sinn,		slabel,		smod,
+ 		snil,		snot,		sof,		sor,
+ 		sother,		spacked,	sproc,		spgm,
+ 		srecord,	srepeat,	sset,		sthen,
+ 		sto,		stype,		suntil,		svar,
+ 		swhile,		swith,		seof,
+ 	    (* ...... sorted *)
+ 								sinteger,
+ 		sreal,		sstring,	schar,		sid,
+ 		splus,		sminus,		smul,		squot,
+ 		sarrow,		slpar,		srpar,		slbrack,
+ 		srbrack,	seq,		sne,		slt,
+ 		sle,		sgt,		sge,		scomma,
+ 		scolon,		ssemic,		sassign,	sdotdot,
+ 		sdot
+ 	);
+ 	symset	= set of symtyp;
+ 
+ 	(* lexical symbol definition *)
+ 	(* the lexical symbol holds a descriptor and the value of a symbol
+ 	   read by the input procedures; note that real values are represented
+ 	   as strings saved in "strstor" like ordinary strings to avoid using
+ 	   float-variables and float-arithmetic in the translator *)
+ 	lexsym	=
+ 	    record
+ 		case st : symtyp of
+ 		  sid:		(vid	: idptr);
+ 		  schar:	(vchr	: char);
+ 		  sinteger:	(vint	: integer);
+ 		  sreal:	(vflt	: strindx);
+ 		  sstring:	(vstr	: strindx);
+ 	    end;
+ 
+ 	(* enumeration of symnode variants *)
+ 	ltypes = (
+ 		lpredef,	lidentifier,	lfield,		lforward,
+ 		lpointer,	lstring,	llabel,		lforwlab,
+ 		linteger,	lreal,		lcharacter
+ 	);
+ 
+ 	declptr	= ^ declnode;
+ 	treeptr	= ^ treenode;
+ 	symptr	= ^ symnode;
+ 	(* identifier/literal symbol definition *)
+ 	(* in a given scope an identifier or a label is uniquely represented
+ 	   by a "symnode"; in order to have a uniform treatment of all objects
+ 	   occurring in the same syntactical positions (and hence in the parse-
+ 	   tree) the literal constants are represented in a similar manner *)
+ 	symnode	=
+ 	    record
+ 		lsymdecl	: treeptr;	(* symbol decl. point	*)
+ 		lnext		: symptr;	(* symtab chain pointer	*)
+ 		ldecl		: declptr;	(* backptr to symtab	*)
+ 		case lt : ltypes of
+ 		  lpredef,			(* a predefined id	*)
+ 		  lfield,			(* a record field	*)
+ 		  lpointer,			(* a pointer id		*)
+ 		  lidentifier,			(* an identifier	*)
+ 		  lforward:
+ 		    (
+ 			lid	: idptr;	(* ptr to its idnode	*)
+ 			lused	: boolean	(* true if symbol used	*)
+ 		    );
+ 		  lstring:			(* a string literal 	*)
+ 		    (
+ 			lstr	: strindx	(* index to "strstor"	*)
+ 		    );
+ 		  lreal:			(* a real literal	*)
+ 		    (
+ 			lfloat	: strindx	(* index to "strstor"	*)
+ 		    );
+ 		  lforwlab,			(* a declared label	*)
+ 		  llabel:			(* label decl & defined	*)
+ 		    (
+ 			lno	: integer;	(* label number		*)
+ 			lgo	: boolean	(* non-local usage	*)
+ 		    );
+ 		  linteger:			(* an integer literal	*)
+ 		    (
+ 			linum	: integer	(* its value		*)
+ 		    );
+ 		  lcharacter:			(* a character literal	*)
+ 		    (
+ 			lchar	: char		(* its value		*)
+ 		    )
+ 	    end;
+ 
+ 	(* symbol table definition *)
+ 	(* the symbol table consists of symnodes chained along the lnext
+ 	   field; the nodes are connected in reverse order of occurence (last
+ 	   declared, first in chain) in the slot in the declnode determined
+ 	   by the hashfunction; when a new scope is entered a new declnode is
+ 	   manufactured and the previous one is hooked to the dprev field, thus
+ 	   nested scopes are represented by a list of declnodes *)
+ 	declnode = record
+ 			dprev	: declptr;
+ 			ddecl	: array [ hashtyp ] of symptr
+ 		   end;
+ 
+ 	(* enumeration of nodes in parse tree *)
+ 	(* NOTE: the subrange [ assignment .. nil ]  have priorities *)
+ 	treetyp	= (
+ 		npredef,	npgm,		nfunc,		nproc,
+ 		nlabel,		nconst,		ntype,		nvar,
+ 		nvalpar,	nvarpar,	nparproc,	nparfunc,
+ 		nsubrange,	nvariant,	nfield,		nrecord,
+ 		narray,		nconfarr,	nfileof,	nsetof,
+ 		nbegin,		nptr,		nscalar,	nif,
+ 		nwhile,		nrepeat,	nfor,		ncase,
+ 		nchoise,	ngoto,		nwith,		nwithvar,
+ 		nempty,		nlabstmt,	nassign,	nformat,
+ 		nin,		neq,		nne,		nlt,
+ 		nle,		ngt,		nge,		nor,
+ 		nplus,		nminus,		nand,		nmul,
+ 		ndiv,		nmod,		nquot,		nnot,
+ 		numinus,	nuplus,		nset,		nrange,
+ 		nindex,		nselect,	nderef,		ncall,
+ 		nid,		nchar,		ninteger,	nreal,
+ 		nstring,	nnil,		npush,		npop,
+ 		nbreak
+ 	);
+ 
+ 	(* enumeration of predefined types *)
+ 	pretyps = (
+ 		tnone,		tboolean,	tchar,		tinteger,
+ 		treal,		tstring,	tnil,		tset,
+ 		ttext,		tpoly,		terror
+ 	);
+ 
+ 	(* enumeration of some special attributes *)
+ 	attributes = (
+ 		anone, aregister, aextern, areference
+ 	);
+ 
+ 	(* parse tree definition *)
+ 	(* the sourceprogram is represented by a treestructure built from
+ 	   treenodes where each node corresponds to one syntactic form from
+ 	   the pascal program *)
+ 	treenode =
+ 	    record
+ 		tnext,			(* ptr to next node in a list	*)
+ 		ttype,			(* pointer to nodes type	*)
+ 		tup	: treeptr;	(* ptr to parent node		*) 
+ 		case tt : treetyp of
+ 		  npredef:		(* predefined object decl	*)
+ 		    (
+ 			tdef:		(* predefined object descr.	*)
+ 				predefs;
+ 			tobtyp:		(* object type			*)
+ 				pretyps
+ 		    );
+ 		  npgm,			(* program declaration		*)
+ 		  nproc,		(* procedure declaration	*)
+ 		  nfunc:		(* function declaration		*)
+ 		    (
+ 			tsubid,		(* subr. identifier (nid)	*)
+ 			tsubpar,	(* parameter list		*)
+ 			tfuntyp,	(* function type (nid)		*)
+ 			tsublab,	(* label decl list (nlabel)	*)
+ 			tsubconst,	(* const decl list (nconst)	*)
+ 			tsubtype,	(* type decl list (ntype)	*)
+ 			tsubvar,	(* var decl list (nvar)		*)
+ 			tsubsub,	(* subr. decl (nproc/nfunc)	*)
+ 			tsubstmt:	(* stmt. list (NOT nbegin)	*)
+ 				treeptr;
+ 			tstat:		(* static declaration level	*)
+ 				integer;
+ 			tscope:		(* symbol table for local id's	*)
+ 				 declptr
+ 		    );
+ 		  nvalpar,		(* value parameter declaration	*)
+ 		  nvarpar,		(* var parameter declaration	*)
+ 		  nconst,		(* constant declaration		*)
+ 		  ntype,		(* type declaration		*)
+ 		  nfield,		(* record field declaration	*)
+ 		  nvar:			(* var declaration declaration	*)
+ 		    (
+ 			tidl,		(* list of declared id's (nid)	*)
+ 			tbind:		(* var/type-type, const-value	*)
+ 				treeptr;
+ 			tattr:		(* special attributes for vars	*)
+ 				attributes
+ 		    );
+ 		  nparproc,		(* parameter procedure		*)
+ 		  nparfunc:		(* parameter function		*)
+ 		    (
+ 			tparid,		(* parm proc/func id (nid)	*)
+ 			tparparm,	(* parm proc/func parm decl	*)
+ 			tpartyp:	(* parm func type (nid)		*)
+ 				treeptr
+ 		    );
+ 		  nptr:			(* pointer constructor		*)
+ 		    (
+ 			tptrid:		(* referenced type (nid)	*)
+ 				treeptr;
+ 			tptrflag:	(* have seen node before	*)
+ 				boolean
+ 		    );
+ 		  nscalar:		(* scalar type constructor	*)
+ 		    (
+ 			tscalid:	(* list of scalar ids (nid)	*)
+ 				treeptr
+ 		    );
+ 		  nfileof,		(* file type constructor	*)
+ 		  nsetof:		(* set type constructor		*)
+ 		    (
+ 			tof:		(* set/file component type	*)
+ 				treeptr
+ 		    );
+ 		  nsubrange:		(* subrange type constructor	*)
+ 		    (
+ 			tlo, thi:	(* subrange limits		*)
+ 				treeptr
+ 		    );
+ 		  nvariant:		(* record variant constructor	*)
+ 		    (
+ 			tselct,		(* selector list (constants)	*)
+ 			tvrnt:		(* variant field decl (nrecord)	*)
+ 				treeptr
+ 		    );
+ 
+ 		(* the tuid field is used to attach a name to variants since
+ 		   C requires all union members to have names *)
+ 		  nrecord:		(* record/variant constructor	*)
+ 		    (
+ 			tflist,		(* fixed field list (nfield)	*)
+ 			tvlist:		(* variant list (nvariant)	*)
+ 				treeptr;
+ 			tuid:		(* variant name			*)
+ 				idptr;
+ 			trscope:	(* symbol table for local id's	*)
+ 				 declptr
+ 		    );
+ 		  nconfarr:		(* conformant array constructor	*)
+ 		    (
+ 			tcindx,		(* index declaration		*)
+ 			tindtyp,	(* conf. arr. index type (nid)	*)
+ 			tcelem:		(* array element type decl	*)
+ 				treeptr;
+ 			tcuid:		(* variant name			*)
+ 				idptr
+ 		    );
+ 		  narray:		(* array type constructor	*)
+ 		    (
+ 			taindx,		(* index declaration		*)
+ 			taelem:		(* array element type decl	*)
+ 				treeptr
+ 		    );
+ 		  nbegin:		(* begin statement		*)
+ 		    (
+ 			tbegin:		(* statement list		*)
+ 				treeptr
+ 		    );
+ 		  nlabstmt:		(* labeled statement		*)
+ 		    (
+ 			tlabno,		(* label number (nlabel)	*)
+ 			tstmt:		(* statement			*)
+ 				treeptr
+ 		    );
+ 		  ngoto:		(* goto statement		*)
+ 		    (
+ 			tlabel:		(* label to go to (nlabel)	*)
+ 				treeptr
+ 		    );
+ 
+ 		  nassign:		(* assignment statement		*)
+ 		    (
+ 			tlhs,		(* variable			*)
+ 			trhs:		(* value			*)
+ 				treeptr
+ 		    );
+ 
+ 		(* npush/npop is used in proc/func which have local variables
+ 		   used in local proc/funcs; those variables are converted to
+ 		   global ptrs initialized to reference the local variable *)
+ 		  npush,		(* init code for proc/func	*)
+ 		  npop:			(* exit code for proc/func	*)
+ 		    (
+ 			tglob,		(* global identifier (nid)	*)
+ 			tloc,		(* local identifier (nid)	*)
+ 			ttmp:		(* temp store for global (nid)	*)
+ 				treeptr
+ 		    );
+ 
+ 		  nbreak:
+ 		    (
+ 			tbrkid,		(* for-variable			*)
+ 			tbrkxp:		(* value for break		*)
+ 				treeptr
+ 		    );
+ 
+ 		  ncall:		(* procedure/function call	*)
+ 		    (
+ 			tcall,		(* called identifier		*)
+ 			taparm:		(* actual paramters		*)
+ 				treeptr
+ 		    );
+ 		  nif:			(* if statement			*)
+ 		    (
+ 			tifxp,		(* conditional expression	*)
+ 			tthen,		(* stmt execd if true condition	*)
+ 			telse:		(* stmt execd if true condition	*)
+ 				treeptr
+ 		    );
+ 		  nwhile:		(* while statemnet		*)
+ 		    (
+ 			twhixp,		(* conditional expression	*)
+ 			twhistmt:	(* stmt execd if true condition	*)
+ 				treeptr
+ 		    );
+ 		  nrepeat:		(* repeat statement		*)
+ 		    (
+ 			treptstmt,	(* statement list		*)
+ 			treptxp:	(* conditional expression	*)
+ 				treeptr
+ 		    );
+ 		  nfor:			(* for statement		*)
+ 		    (
+ 			tforid,		(* loop control variable (nid)	*)
+ 			tfrom,		(* initial value		*)
+ 			tto,		(* final value			*)
+ 			tforstmt:	(* stmt execd in loop		*)
+ 				treeptr;
+ 			tincr:		(* to/downto flag true <==> to	*)
+ 				boolean
+ 		    );
+ 		  ncase:		(* case statement		*)
+ 		    (
+ 			tcasxp,		(* selecting expression		*)
+ 			tcaslst,	(* list of choises		*)
+ 			tcasother:	(* default action		*)
+ 				treeptr
+ 		    );
+ 		  nchoise:		(* a choise in a case-stmt	*)
+ 		    (
+ 			tchocon,	(* list of constants		*)
+ 			tchostmt:	(* execd statement		*)
+ 				treeptr
+ 		    );
+ 		  nwith:		(* with statment		*)
+ 		    (
+ 			twithvar,	(* list of variables (nwithvar)	*)
+ 			twithstmt:	(* statement execd in new scope	*)
+ 				treeptr
+ 		    );
+ 
+ 		(* the local symbol table holds identifiers, picked from
+ 		   the record fields, temporarily declared during parsing
+ 		   of remainder of with-statement; these identifiers are
+ 		   later converted into fields referenced through a ptr *)
+ 		  nwithvar:		(* variable in with statement	*)
+ 		    (
+ 			texpw:		(* record variable		*)
+ 				treeptr;
+ 			tenv:		(* symbol table for local scope	*)
+ 				declptr
+ 		    );
+ 
+ 		  nindex:		(* array indexing expression	*)
+ 		    (
+ 			tvariable,	(* indexed variable		*)
+ 			toffset:	(* index expression		*)
+ 				treeptr
+ 		    );
+ 		  nselect:		(* record field selection expr	*)
+ 		    (
+ 			trecord,	(* record variable		*)
+ 			tfield:		(* selected field (nid)		*)
+ 				treeptr
+ 		    );
+ 
+ 		(* binary operators or constructors *)
+ 		  nrange,		(* .. (set range)	*)
+ 		  nformat,		(* :  (write format)	*)
+ 		  nin,			(* in			*)
+ 		  neq,			(* =			*)
+ 		  nne,			(* <>			*)
+ 		  nlt,			(* <			*)
+ 		  nle,			(* <=			*)
+ 		  ngt,			(* >			*)
+ 		  nge,			(* >=			*)
+ 		  nor,			(* or			*)
+ 		  nplus,		(* +			*)
+ 		  nminus,		(* -			*)
+ 		  nand,			(* and			*)
+ 		  nmul,			(* *			*)
+ 		  ndiv,			(* div			*)
+ 		  nmod,			(* mod			*)
+ 		  nquot:		(* /			*)
+ 		    (
+ 			texpl,		(* left operand expr	*)
+ 			texpr:		(* right operand expr	*)
+ 				treeptr
+ 		    );
+ 
+ 		(* unary operators or constructors; note that uplus is
+ 		   used to represent any parenthesized expression *)
+ 		  nderef,		(* ^ (ptr dereference)	*)
+ 		  nnot,			(* not			*)
+ 		  nset,			(* [ ] (set constr)	*)
+ 		  nuplus,		(* +			*)
+ 		  numinus:		(* -			*)
+ 		    (
+ 			texps:		(* operand expression	*)
+ 				treeptr
+ 		    );
+ 
+ 		  nid,			(* identifier in decl or stmt	*)
+ 		  nreal,		(* literal real (decl or stmt)	*)
+ 		  ninteger,		(* literal int ( - " - )	*)
+ 		  nchar,		(* literal char ( - " - )	*)
+ 		  nstring,		(* literal string ( - " - )	*)
+ 		  nlabel:		(* label (decl, defpt or use)	*)
+ 		    (
+ 			tsym:
+ 				symptr
+ 		    );
+ 
+ 		  nnil,			(* nil (pointer constant)	*)
+ 		  nempty:		(* empty statement		*)
+ 		    ( );
+ 	    end;
+ 
+ 	(* "reserved" words and standard identifiers from C, C LIB and
+ 	    OS environment excluding those reserved in Pascal *)
+ 	cnames = (
+ 		cabort,		cbreak,		ccontinue,	cdefine,
+ 		cdefault,	cdouble,	cedata,		cenum,
+ 		cetext,		cextern,	cfgetc,		cfclose,
+ 		cfflush,	cfloat,		cfloor,		cfprintf,
+ 		cfputc,		cfread,		cfscanf,	cfwrite,
+ 		cgetc,		cgetpid,	cint,		cinclude,
+ 		clong,		clog,		cmain,		cmalloc,
+ 		cprintf,	cpower,		cputc,		cread,
+ 		creturn,	cregister,	crewind,	cscanf,
+ 		csetbits,	csetword,	csetptr,	cshort,
+ 		csigned,	csizeof,	csprintf,	cstdin,
+ 		cstdout,	cstderr,	cstrncmp,	cstrncpy,
+ 		cstruct,	cstatic,	cswitch,	ctypedef,
+ 		cundef,		cungetc,	cunion,		cunlink,
+ 		cunsigned,	cwrite
+ 	);
+ 
+ 	(* these are the detected errors. some are user-errors,
+ 	   some are internal problems and some are host system errors *)
+ 	errors	= (
+ 		ebadsymbol,	elongstring,	elongtokn,	erange,
+ 		emanytokn,	enotdeclid,	emultdeclid,	enotdecllab,
+ 		emultdecllab,	emuldeflab,	ebadstring,	enulchr,
+ 		ebadchar,	eeofcmnt,	eeofstr,	evarpar,
+ 		enew,		esetbase,	esetsize,	eoverflow,
+ 		etree,		etag,		euprconf,	easgnconf,
+ 		ecmpconf,	econfconf,	evrntfile,	evarfile,
+ 		emanymachs,	ebadmach
+ 	);
+ 
+ 	machdefstr = packed array [ 1 .. machdeflen ] of char;
+ 
+ var
+ 	usemax,			(* program needs max-function		*)
+ 	usejmps,		(* source program uses non-local gotos	*)
+ 	usecase,		(* source program has case-statement	*)
+ 	usesets,		(* source program uses set-operations	*)
+ 	useunion,
+ 	usediff,
+ 	usemksub,
+ 	useintr,
+ 	usesge,
+ 	usesle,
+ 	useseq,
+ 	usesne,
+ 	usememb,
+ 	useins,
+ 	usescpy,
+ 	usecomp,		(* source program uses string-compare	*)
+ 	usefopn,		(* source program uses reset/rewrite	*)
+ 	usescan,
+ 	usegetl,
+ 	usenilp,		(* source program uses nil-pointer 	*)
+ 	usebool	: boolean;	(* source program writes boolean-values	*)
+ 
+ 	top	: treeptr;	(* top of parsetree, result from parse	*)
+ 
+ 	setlst	: treeptr;	(* list of set-initializations		*)
+ 	setcnt	: integer;	(* counter for setlst length		*)
+ 
+ 	currsym	: lexsym;	(* current lexical symbol		*)
+ 
+ 	keytab	: array [ 0 .. keytablen ] of	(* table of keywords	*)
+ 		    record
+ 			wrd	: keyword;	(* keyword text		*)
+ 			sym	: symtyp	(* corresponding symbol	*)
+ 		    end;
+ 
+ 	strstor	: array [ strbcnt ] of strptr;	(* store for strings	*)
+ 	strfree	: strindx;			(* first free position	*)
+ 	strleft	: strbidx;			(* room in last blk	*)
+ 
+ 	idtab	: array [ hashtyp ] of idptr;	(* hashed table of id's	*)
+ 
+ 	symtab	: declptr;			(* table of symbols	*)
+ 
+ 	statlvl,				(* static decl. level	*)
+ 	maxlevel : integer;			(*  - " - maximum value	*) 
+ 
+ 	deftab	: array [ predefs ] of treeptr;	(* predefined idents.	*)
+ 	defnams	: array [ predefs ] of symptr;	(*        - " -		*)
+ 	typnods	: array [ pretyps ] of treeptr;	(* predef. types.	*)
+ 
+ 	pprio,
+ 	cprio	: array [ nassign .. nnil ] of 0 .. maxprio;
+ 
+ 	ctable	: array [ cnames ] of idptr;	(* table of C-keywords	*)
+ 
+ 	nmachdefs : 0 .. maxmachdefs;
+ 	machdefs : array [ 1 .. maxmachdefs ] of (* table of C-types	*)
+ 			record
+ 				lolim, hilim	: integer;
+ 				typstr		: strindx
+ 			end;
+ 
+ 	lineno,					(* input line number	*)
+ 	colno,					(* input column number	*)
+ 	lastcol,				(* last OK input column	*)
+ 	lastline : integer;			(* last OK input line	*)
+ 
+ 	lasttok	: toknbuf;			(* last input token	*)
+ 
+ 	varno	: integer;		(* counter for unique id's	*)
+ 
+ 	hexdig	: packed array [ 0 .. 15 ] of char;
+ 
+ (*	Prtmsg produces an error message. It asssumes that procedure	*)
+ (*	"message" (predefined) will "writeln" to user tty. OS		*)
+ procedure prtmsg(m : errors);
+ 
+ const	user	= 'Error: ';
+ 	restr	= 'Implementation restriction: ';
+ 	inter	= '* Internal error * ';
+ 	xtoklen	= 64;				(* should be <= maxtoklen *)
+ 
+ var	i	: toknidx;
+ 	xtok	: packed array [ 1 .. xtoklen ] of char;
+ 
+ begin
+ 	case m of
+ 	  ebadsymbol:
+ 		message(user, 'Unexpected symbol');
+ 	  ebadchar:
+ 		message(user, 'Bad character');
+ 	  elongstring:
+ 		message(restr, 'Too long string');
+ 	  ebadstring:
+ 		message(user, 'Newline in string or character');
+ 	  eeofstr:
+ 		message(user, 'End of file in string or character');
+ 	  eeofcmnt:
+ 		message(user, 'End of file in comment');
+ 	  elongtokn:
+ 		message(restr, 'Too long identfier');
+ 	  emanytokn:
+ 		message(restr, 'Too many strings, identifiers or real numbers');
+ 	  enotdeclid:
+ 		message(user, 'Identifier not declared');
+ 	  emultdeclid:
+ 		message(user, 'Identifier declared twice');
+ 	  enotdecllab:
+ 		message(user, 'Label not declared');
+ 	  emultdecllab:
+ 		message(user, 'Label declared twice');
+ 	  emuldeflab:
+ 		message(user, 'Label defined twice');
+ 	  evarpar:
+ 		message(user, 'Actual parameter not a variable');
+ 	  enulchr:
+ 		message(restr, 'Cannot handle nul-character in strings');
+ 	  enew:
+ 		message(restr, 'New returned a nil-pointer');
+ 	  eoverflow:
+ 		message(restr, 'Token buffer overflowed');
+ 	  esetbase:
+ 		message(restr, 'Cannot handle sets with base >> 0');
+ 	  esetsize:
+ 		message(restr, 'Cannot handle sets with very large range');
+ 	  etree:
+ 		message(inter, 'Bad tree structure');
+ 	  etag:
+ 		message(inter, 'Cannot find tag');
+ 	  evrntfile:
+ 		message(restr, 'Cannot initialize files in record variants');
+ 	  evarfile:
+ 		message(restr, 'Cannot handle files in structured variables');
+ 	  euprconf:
+ 		message(inter, 'No upper bound on conformant arrays');
+ 	  easgnconf:
+ 		message(inter, 'Cannot assign conformant arrays');
+ 	  ecmpconf:
+ 		message(inter, 'Cannot compare conformant arrays');
+ 	  econfconf:
+ 		message(restr, 'Cannot handle nested conformat arrays');
+ 	  erange:
+ 		message(inter, 'Cannot find C-type for integer-subrange');
+ 	  emanymachs:
+ 		message(restr, 'Too many machine integer types');
+ 	  ebadmach:
+ 		message(inter, 'Bad name for machine integer type');
+ 	end;(* case *)
+ 	if lastline <> 0 then
+ 	    begin
+ 		(* error detected during parsing,
+ 		    report line/column and print the offending symbol *)
+ 		message('Line ', lastline:1, ', col ', lastcol:1, ':');
+ 		if m in [enulchr, ebadchar, ebadstring, ebadsymbol,
+ 			emuldeflab, emultdecllab, enotdecllab, emultdeclid,
+ 			enotdeclid, elongtokn, elongstring] then
+ 		    begin
+ 			i := 1;
+ 			while (i < xtoklen) and (lasttok[i] <> chr(null)) do
+ 			    begin
+ 				xtok[i] := lasttok[i];
+ 				i := i + 1
+ 			    end;
+ 			while i < xtoklen do
+ 			    begin
+ 				xtok[i] := ' ';
+ 				i := i + 1
+ 			    end;
+ 			xtok[xtoklen] := ' ';
+ 			message('Current symbol: ', xtok)
+ 		    end
+ 	    end
+ end;
+ 
+ procedure fatal(m : errors);	forward;
+ procedure error(m : errors);	forward;
+ 
+ (*	Map letters to upper-case.					*)
+ (*	This function assumes a machine collating sequence where the	*)
+ (*	letters of either case form a contigous sequence, CHAR.	*)
+ function uppercase(c : char) : char;
+ 
+ begin
+ 	if (c >= 'a') and (c <= 'z') then
+ 		uppercase := chr(ord(c) + ord('A') - ord('a'))
+ 	else
+ 		uppercase := c
+ end;
+ 
+ 
+ (*	Map letters to lower-case.					*)
+ (*	This function assumes a machine collating sequence where the	*)
+ (*	letters of either case form a contigous sequence, CHAR.	*)
+ function lowercase(c : char) : char;
+ 
+ begin
+ 	if (c >= 'A') and (c <= 'Z') then
+ 		lowercase := chr(ord(c) - ord('A') + ord('a'))
+ 	else
+ 		lowercase := c
+ end;
+ 
+ (*	Retrieve a string from strstor.				*)
+ procedure gettokn(i : strindx; var t : toknbuf);
+ 
+ var	c	: char;
+ 	k	: toknidx;
+ 	j	: strbidx;
+ 	p	: strptr;
+ 
+ begin
+ 	k := 1;
+ 	(* compute block and offset in block *)
+ 	p := strstor[i div (maxstrblk + 1)];
+ 	j := i mod (maxstrblk + 1);
+ 	(* retrieve text up to null *)
+ 	repeat
+ 		c := p^[j];
+ 		t[k] := c;
+ 		j := j + 1;
+ 		k := k + 1;
+ 		if k = maxtoknlen then
+ 		    begin
+ 			c := chr(null);
+ 			t[maxtoknlen] := chr(null);
+ 			prtmsg(eoverflow)
+ 		    end
+ 	until	c = chr(null)
+ end;
+ 
+ (*	Deposit a string into strstor at a given start-position.	*)
+ procedure puttokn(i : strindx; var t : toknbuf);
+ 
+ var	c	: char;
+ 	k	: toknidx;
+ 	j	: strbidx;
+ 	p	: strptr;
+ 
+ begin
+ 	k := 1;
+ 	p := strstor[i div (maxstrblk + 1)];
+ 	j := i mod (maxstrblk + 1);
+ 	repeat
+ 		c := t[k];
+ 		p^[j] := c;
+ 		k := k + 1;
+ 		j := j + 1
+ 	until	c = chr(null)
+ end;
+ 
+ (*	Write a token on standard output.				*)
+ procedure writetok(var w : toknbuf);
+ 
+ var	j	: toknidx;
+ 
+ begin
+ 	j := 1;
+ 	while w[j] <> chr(null) do
+ 	    begin
+ 		write(w[j]);
+ 		j := j + 1
+ 	    end
+ end;
+ 
+ (*	Print a float number on standard output.			*)
+ procedure printtok(i : strindx);
+ 
+ var	w	: toknbuf;
+ 
+ begin
+ 	gettokn(i, w);
+ 	writetok(w)
+ end;
+ 
+ (*	Print an identifier on standard output.				*)
+ procedure printid(ip : idptr);
+ 
+ begin
+ 	printtok(ip^.istr)
+ end;
+ 
+ (*	Print a character on standard output with proper C-quoting.	*)
+ procedure printchr(c : char);
+ 
+ begin
+ 	if (c = quote) or (c = bslash) then
+ 		write(quote, bslash, c, quote)
+ 	else
+ 		write(quote, c, quote)
+ end;
+ 
+ (*	Print a string on standard output with proper C-quoting.	*)
+ procedure printstr(i : strindx);
+ 
+ var	k	: toknidx;
+ 	c	: char;
+ 	w	: toknbuf;
+ 
+ begin
+ 	gettokn(i, w);
+ 	write(cite);
+ 	k := 1;
+ 	while w[k] <> chr(null) do
+ 	    begin
+ 		c := w[k];
+ 		k := k + 1;
+ 		if (c = cite) or (c = bslash) then
+ 			write(bslash);
+ 		write(c)
+ 	    end;
+ 	write(cite)
+ end;
+ 
+ (*	Return a pointer to the declarationpoint of an identifier.	*)
+ function idup(ip : treeptr) : treeptr;
+ 
+ begin
+ 	idup := ip^.tsym^.lsymdecl^.tup
+ end;
+ 
+ (*	Compute a hashvalue for an identifier or a string.		*)
+ function hashtokn(var id : toknbuf) : hashtyp;
+ 
+ var	h	: integer;
+ 	i	: toknidx;
+ 
+ begin
+ 	i := 1;
+ 	h := 0;
+ 	while id[i] <> chr(null) do
+ 	    begin
+ 		(* if ord() of a character ranges from 0 to 127 then we can loop
+ 		   256 times without causing h to exceed 32767, this is safe as
+ 		   both strings and identifiers are limited in length *)
+ 		h := h + ord(id[i]);	(* CHAR, CPU *)
+ 		i := i + 1
+ 	    end;
+ 	hashtokn := h mod hashmax
+ end;
+ 
+ (*	Global string table update.					*)
+ (*	This function accepts a string and stores it in strstor.	*)
+ (*	It returns the id-number for the new string.			*)
+ function savestr(var t : toknbuf) : strindx;
+ 
+ var	k	: toknidx;
+ 	i	: strindx;
+ 	j	: strbcnt;
+ 
+ begin
+ 	(* find length of new string including null-char *)
+ 	k := 1;
+ 	while t[k] <> chr(null) do
+ 		k := k + 1;
+ 	if k > strleft then
+ 	    begin
+ 		(* out of space in strstore *)
+ 		if strstor[maxblkcnt] <> nil then	(* last slot used *)
+ 			error(emanytokn);
+ 		(* allocate a new block *)
+ 		j := (strfree + maxstrblk) div (maxstrblk + 1);
+ 		new(strstor[j]);
+ 		if strstor[j] = nil then
+ 			error(enew);
+ 		strfree := j * (maxstrblk + 1);
+ 		strleft := maxstrblk
+ 	    end;
+ 	(* copy new str, update location of last used cell,
+ 	   return starting location for new str *)
+ 	i := strfree;
+ 	strfree := strfree + k;
+ 	strleft := strleft - k;
+ 	puttokn(i, t);
+ 	savestr := i
+ end;
+ 
+ (*	Global id table lookup.						*)
+ (*	This procedure accepts an identifier and determines if it has	*)
+ (*	been seen before. If that is the case a pointer to its idnode	*)
+ (*	is returned, otherwise the identifier is saved and a pointer to	*)
+ (*	a new node is returned.						*)
+ function saveid(var id : toknbuf) : idptr;
+ 
+ label	999;
+ 
+ var	k	: toknidx;
+ 	ip	: idptr;
+ 	h	: hashtyp;
+ 	t	: toknbuf;
+ 
+ begin
+ 	h := hashtokn(id);
+ 	ip := idtab[h];				(* scan hashlist for id	*)
+ 	while ip <> nil do
+ 	    begin
+ 		gettokn(ip^.istr, t);		(* look at saved token	*)
+ 		k := 1;
+ 		while id[k] = t[k] do
+ 			if id[k] = chr(null) then
+ 				goto 999	(* found it!		*)
+ 			else
+ 				k := k + 1;	(* look at next char	*)
+ 		ip := ip^.inext
+ 	    end;
+ 
+ 	(* identifier wasn't previously seen, manufacture a new idnode,
+ 	   save index to strstor and hashvalue, insert idnode in idtab *)
+ 	new(ip);
+ 	if ip = nil then
+ 		error(enew);
+ 	ip^.inref := 0;
+ 	ip^.istr := savestr(id);
+ 	ip^.ihash := h;
+ 	ip^.inext := idtab[h];
+ 	idtab[h] := ip;
+ 
+ 999:
+ 	(* return the idnode *)
+ 	saveid := ip
+ end;
+ 
+ (*	This function creates a new variable by concatenating one name	*)
+ (*	with another injecting a given separator.			*)
+ function mkconc(sep : char; p, q : idptr) : idptr;
+ 
+ var	w, x	: toknbuf;
+ 	i, j	: toknidx;
+ 
+ begin
+ 	(* fetch second part and determine its length *)
+ 	gettokn(q^.istr, x);
+ 	j := 1;
+ 	while x[j] <> chr(null) do
+ 		j := j + 1;
+ 	(* fetch first part and locate its end *)
+ 	w[1] := chr(null);
+ 	if p <> nil then
+ 		gettokn(p^.istr, w);
+ 	i := 1;
+ 	while w[i] <> chr(null) do
+ 		i := i + 1;
+ 	(* check total length *)
+ 	if i + j + 2 >= maxtoknlen then
+ 		error(eoverflow);
+ 
+ 	(* add separators *)
+ 	if sep = '>' then
+ 	    begin
+ 		(* special case 1: > gives arrow: a->b *)
+ 		w[i] := '-';
+ 		i := i + 1
+ 	    end;
+ 	if sep <> space then
+ 	    begin
+ 		(* special case 2: space gives nothing: ab *)
+ 		w[i] := sep;
+ 		i := i + 1
+ 	    end;
+ 	(* add second part *)
+ 	j := 1;
+ 	repeat
+ 		w[i] := x[j];
+ 		i := i + 1;
+ 		j := j + 1
+ 	until w[i-1] = chr(null);
+ 	(* save new identifier *)
+ 	mkconc := saveid(w)
+ end;
+ 
+ (*	Create a new id with name-prefix from w.			*)
+ function mkuniqname(var t : toknbuf) : idptr;
+ 
+ var	i	: toknidx;
+ 
+ 	procedure dig(n : integer);
+ 	begin
+ 		if n > 0 then
+ 		    begin
+ 			dig(n div 10);
+ 			if i = maxtoknlen then
+ 				error(eoverflow);
+ 			t[i] := chr(n mod 10 + ord('0'));	(* CHAR *)
+ 			i := i + 1
+ 		    end
+ 	end;
+ 
+ begin
+ 	i := 1;
+ 	while t[i] <> chr(null) do
+ 		i := i + 1;
+ 	varno := varno + 1;
+ 	dig(varno);
+ 	t[i] := chr(null);
+ 	mkuniqname := saveid(t)
+ end;
+ 
+ (*	Make a new unique variable with given char as prefix.		*)
+ function mkvariable(c : char) : idptr;
+ 
+ var	t	: toknbuf;
+ 
+ begin
+ 	t[1] := c;
+ 	t[2] := chr(null);
+ 	mkvariable := mkuniqname(t)
+ end;
+ 
+ (*	Make a new unique variable with given char as prefix and	*)
+ (*	with a given id as tail. Commonly used for renaming id's.	*)
+ function mkrename(c : char; ip : idptr) : idptr;
+ 
+ begin
+ 	mkrename := mkconc(uscore, mkvariable(c), ip)
+ end;
+ 
+ (*	Make a name for a variant. Variants are mapped onto C unions,	*)
+ (*	which we always give the name "U", thus the name of the variant	*)
+ (*	becomes "U.Vnnn" where "nnn" is a unique number.		*)
+ function mkvrnt : idptr;
+ 
+ var	t	: toknbuf;
+ 
+ begin
+ 	t[1] := 'U';
+ 	t[2] := '.';
+ 	t[3] := 'V';
+ 	t[4] := chr(null);
+ 	mkvrnt := mkuniqname(t)
+ end;
+ 
+ procedure checksymbol(ss : symset);
+ begin
+ 	if not (currsym.st in ss) then
+ 		error(ebadsymbol);
+ end;
+ 
+ (*	Lexical analysis routine.					*)
+ (*	This procedure reads and classifies the next lexical token in	*)
+ (*	the input stream. The token is saved in the global variable	*)
+ (*	"currsym". The found symbol should be one of the symbols given	*)
+ (*	in the parameter "ss" otherwise the error routine is called.	*)
+ procedure nextsymbol(ss : symset);
+ 
+ var	lastchr	: 0 .. maxtoknlen;
+ 
+ 	(*	This function reads the next character from the input	*)
+ 	(*	and updates "lineno" and "colno" accordingly.		*)
+ 	function nextchar : char;
+ 
+ 	var	c	: char;
+ 
+ 	begin
+ 		if eof then
+ 			c := chr(null)
+ 		else begin
+ 			colno := colno + 1;
+ 			if eoln then
+ 			    begin
+ 				lineno := lineno + 1;
+ 				colno := 0
+ 			    end;
+ 			read(c);
+ 			if echo then
+ 				if colno = 0 then
+ 					writeln
+ 				else
+ 					write(c);
+ 			if c = tab1 then
+ 				colno := ((colno div tabwidth) + 1) * tabwidth
+ 		     end;
+ 		if lastchr > 0 then
+ 		    begin
+ 			lasttok[lastchr] := c;
+ 			lastchr := lastchr + 1
+ 		    end;
+ 		nextchar := c
+ 	end;
+ 
+ 	(*	This function looks at the next input character.	*)
+ 	function peekchar : char;
+ 
+ 	begin
+ 		if eof then
+ 			peekchar := chr(null)
+ 		else
+ 			peekchar := input^
+ 	end;
+ 
+ 	(*	Read and classify the next token.			*)
+ 	procedure nexttoken(realok : boolean);
+ 
+ 	var	c	: char;
+ 		n	: integer;
+ 
+ 		ready	: boolean;
+ 
+ 		wl	: toknidx;
+ 		wb	: toknbuf;
+ 
+ 		(*	Determine if c is valid in an identifier.	*)
+ 		(*	This function assumes a machine collating	*)
+ 		(*	sequence where letters and digits form conti-	*)
+ 		(*	gous sequences, CHAR.				*)
+ 		function idchar(c : char) : boolean;
+ 
+ 		begin
+ 			idchar := 
+ 				(c >= 'a') and (c <= 'z') or
+ 				    (c >= '0') and (c <= '9') or
+ 					(c >= 'A') and (c <= 'Z') or
+ 					    (c = uscore)
+ 		end;
+ 
+ 		(*	Determine if c is valid in a number. CHAR.	*)
+ 		function numchar(c : char) : boolean;
+ 
+ 		begin
+ 			numchar := (c >= '0') and (c <= '9')
+ 		end;
+ 
+ 		(*	Convert a digit to its numeric value. CHAR	*)
+ 		function numval(c : char) : integer;
+ 
+ 		begin
+ 			numval := ord(c) - ord('0')
+ 		end;
+ 
+ 		(*	Determine if the current token is a keyword.	*)
+ 		function keywordcheck(var w : toknbuf; l : toknidx) : symtyp;
+ 
+ 		var	n	: 1 .. keywordlen;
+ 			i, j, k	: 0 .. keytablen;
+ 			wrd	: keyword;
+ 			kwc	: symtyp;
+ 
+ 		begin
+ 			(* quick check on token length,
+ 			   pascal keywords range from 2 to 9 chars in length *)
+ 			if (l > 1) and (l < keywordlen) then
+ 			    begin
+ 				(* could be a keyword, initialize wrd *)
+ 				wrd := keytab[keytablen].wrd;
+ 				(* copy w to wrd *)
+ 				for n := 1 to l do
+ 					wrd[n] := w[n];
+ 
+ 				(* binary search for tokn,
+ 				   relies on symtyp being sorted *)
+ 				i := 0;
+ 				j := keytablen;
+ 				while j > i do
+ 				    begin
+ 					k := (i + j) div 2;
+ 					if keytab[k].wrd >= wrd then
+ 						j := k
+ 					else
+ 						i := k + 1
+ 				    end;
+ 				if keytab[j].wrd = wrd then
+ 					kwc := keytab[j].sym
+ 				else
+ 					kwc := sid
+ 			    end
+ 			else
+ 				kwc := sid;
+ 			keywordcheck := kwc
+ 		end;
+ 
+ 	begin	(* nexttoken *)
+ 		(* don't save blanks/comments *)
+ 		lastchr := 0;
+ 		(* read non-blank character *)
+ 		repeat
+ 			c := nextchar;
+ 			(* skip comments, the two comment delimiters of pascal
+ 			   are treated as different if "diffcomm" is true *)
+ 			if c = '{' then
+ 			    begin
+ 				repeat
+ 					c := nextchar;
+ 					if diffcomm then
+ 						ready := c = '}'
+ 					else
+ 						ready := ((c = '*') and
+ 							    (peekchar = ')'))
+ 							or (c = '}')
+ 				until ready or eof;
+ 				if eof and not ready then
+ 					error(eeofcmnt);
+ 				if (c = '*') and not eof then
+ 					c := nextchar;
+ 				c := space
+ 			    end
+ 			else if (c = '(') and (peekchar = '*')  then
+ 			    begin
+ 				c := nextchar;
+ 				repeat
+ 					c := nextchar;
+ 					if diffcomm then
+ 						ready := (c = '*') and
+ 							(peekchar = ')')
+ 					else
+ 						ready := ((c = '*') and
+ 							    (peekchar = ')'))
+ 							or (c = '}')
+ 				until ready or eof;
+ 				if eof and not ready then
+ 					error(eeofcmnt);
+ 				if (c = '*') and not eof then
+ 					c := nextchar;
+ 				c := space
+ 			    end
+ 		until	(c <> space) and (c <> tab1);
+ 
+ 		(* save characters from this token and save line- and column-
+ 		   numbers for errormessages *)
+ 		lasttok[1] := c;
+ 		lastchr := 2;
+ 		lastcol := colno;
+ 		lastline := lineno;
+ 
+ 		(* map all CHAR control characters onto "badchr" *)
+ 		if c < okchr then
+ 			c := badchr;
+ 
+ 		(* decode symbol *)
+ 		with currsym do
+ 		    if eof then
+ 			begin
+ 				lasttok[1] := '*';
+ 				lasttok[2] := 'E';
+ 				lasttok[3] := 'O';
+ 				lasttok[4] := 'F';
+ 				lasttok[5] := '*';
+ 				lastchr := 6;
+ 				st := seof
+ 			end
+ 		    else
+ 			case c of
+ 
+ 
+ 			(* CHAR, chars not in Pascal *)
+ 			  '|', '`', '~', '}',
+ 			  bslash, uscore, badchr:
+ 				error(ebadchar);
+ 
+ 			(* identifiers or keywords *)
+ 			  'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j',
+ 			  'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't',
+ 			  'u', 'v', 'w', 'x', 'y', 'z',
+ 			  'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J',
+ 			  'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',
+ 			  'U', 'V', 'W', 'X', 'Y', 'Z':
+ 			    begin
+ 				(* read token into buffer *)
+ 				wb[1] := lowercase(c);
+ 				wl := 2;
+ 				while (wl < maxtoknlen) and idchar(peekchar) do
+ 				    begin
+ 					wb[wl] := lowercase(nextchar);
+ 					wl := wl + 1
+ 				    end;
+ 				if wl >= maxtoknlen then
+ 				    begin
+ 					lasttok[lastchr] := chr(null);
+ 					error(elongtokn)
+ 				    end;
+ 				(* terminate token and match *)
+ 				wb[wl] := chr(null);
+ 				(* check if keyword/identifier *)
+ 				st := keywordcheck(wb, wl-1);
+ 				if st = sid then
+ 					vid := saveid(wb)
+ 			    end;
+ 
+ 			(* integer or real numbers *)
+ 			  '0', '1', '2', '3', '4', '5', '6', '7' ,'8', '9':
+ 			    begin
+ 				(* assume integer number, save it in buffer *)
+ 				wb[1] := c;
+ 				wl := 2;
+ 				n := numval(c);
+ 				while numchar(peekchar) do
+ 				    begin
+ 					c := nextchar;
+ 					n := n * 10 + numval(c);
+ 					wb[wl] := c;
+ 					wl := wl + 1
+ 				    end;
+ 				st := sinteger;
+ 				vint := n;
+ 				if realok then
+ 				    begin
+ 					(* accept real numbers *)
+ 					if peekchar = '.' then
+ 					    begin
+ 						(* this is a real number *)
+ 						st := sreal;
+ 						wb[wl] := nextchar;
+ 						wl := wl + 1;
+ 						while numchar(peekchar) do
+ 						    begin
+ 							wb[wl] := nextchar;
+ 							wl := wl + 1
+ 						    end
+ 					    end;
+ 					c := peekchar;
+ 					if (c = 'e') or (c = 'E') then
+ 					    begin
+ 						(* this is a real number *)
+ 						st := sreal;
+ 						c := nextchar;
+ 						wb[wl] := xpnent;
+ 						wl := wl + 1;
+ 						c := peekchar;
+ 						if (c = '-') or (c = '+') then
+ 						    begin
+ 							wb[wl] := nextchar;
+ 							wl := wl + 1
+ 						    end;
+ 						while numchar(peekchar) do
+ 						    begin
+ 							wb[wl] := nextchar;
+ 							wl := wl + 1
+ 						    end
+ 					    end;
+ 					if st = sreal then
+ 					    begin
+ 						wb[wl] := chr(null);
+ 						vflt := savestr(wb)
+ 					    end
+ 				    end
+ 			    end;
+ 
+ 			  '(':
+ 				if peekchar = '.' then
+ 				    begin
+ 					(* some compilers on non-ascii systems
+ 					   use (. for [ and .) for ] *)
+ 					c := nextchar;
+ 					st := slbrack
+ 				    end
+ 				else
+ 					st := slpar;
+ 			  ')':
+ 				st := srpar;
+ 			  '[':
+ 				st := slbrack;
+ 			  ']':
+ 				st := srbrack;
+ 			  '.':
+ 				if peekchar = '.' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sdotdot
+ 				    end
+ 				else if peekchar = ')' then
+ 				    begin
+ 					c := nextchar;
+ 					st := srbrack
+ 				    end
+ 				else
+ 					st := sdot;
+ 			  ';':
+ 				st := ssemic;
+ 			  ':':
+ 				if peekchar = '=' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sassign
+ 				    end
+ 				else
+ 					st := scolon;
+ 			  ',':
+ 				st := scomma;
+ 			  '@',
+ 			  '^':
+ 				st := sarrow;
+ 			  '=':
+ 				st := seq;
+ 			  '<':
+ 				if peekchar = '=' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sle
+ 				    end
+ 				else if peekchar = '>' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sne
+ 				    end
+ 				else
+ 					st := slt;
+ 			  '>':
+ 				if peekchar = '=' then
+ 				    begin
+ 					c := nextchar;
+ 					st := sge
+ 				    end
+ 				else
+ 					st := sgt;
+ 			  '+':
+ 				st := splus;
+ 			  '-':
+ 				st := sminus;
+ 			  '*':
+ 				st := smul;
+ 			  '/':
+ 				st := squot;
+ 			  quote:
+ 			    begin
+ 				(* assume the symbol is a literal string *)
+ 				wl := 0;
+ 				ready := false;
+ 				repeat
+ 					if eoln then
+ 					    begin
+ 						lasttok[lastchr] := chr(null);
+ 						error(ebadstring)
+ 					    end;
+ 					c := nextchar;
+ 					if c = quote then
+ 						if peekchar = quote then
+ 							c := nextchar
+ 						else
+ 							ready := true;
+ 					if c = chr(null) then
+ 					    begin
+ 						if eof then
+ 							error(eeofstr);
+ 						lasttok[lastchr] := chr(null);
+ 						error(enulchr)
+ 					    end;
+ 					if not ready then
+ 					    begin
+ 						wl := wl + 1;
+ 						if wl >= maxtoknlen then
+ 						    begin
+ 							lasttok[lastchr] :=
+ 								chr(null);
+ 							error(elongstring)
+ 						    end;
+ 						wb[wl] := c
+ 					    end
+ 				until	ready;
+ 				if wl = 1 then
+ 				    begin
+ 					(* only 1 character => not a string *)
+ 					st := schar;
+ 					vchr := wb[1]
+ 				    end
+ 				else begin
+ 					(* > 1 character => its a string *)
+ 					wl := wl + 1;
+ 					if wl >= maxtoknlen then
+ 					    begin
+ 						lasttok[lastchr] := chr(null);
+ 						error(elongstring)
+ 					    end;
+ 					wb[wl] := chr(null);
+ 					st := sstring;
+ 					vstr := savestr(wb)
+ 				     end
+ 			    end
+ 
+ 			end;(* case *)
+ 		if lastchr = 0 then
+ 			lastchr := 1;
+ 		lasttok[lastchr] := chr(null)
+ 	end;	(* nexttoken *)
+ 
+ begin	(* nextsymbol *)
+ 	nexttoken(sreal in ss);
+ 	checksymbol(ss)
+ end;	(* nextsymbol *)
+ 
+ (*	Return a pointer to the node describing the type of tp. This	*)
+ (*	function also stores the result in the node for future ref.	*)
+ function typeof(tp : treeptr) : treeptr;
+ 
+ var	tf, tq	: treeptr;
+ 
+ begin
+ 	tq := tp;
+ 	tf := tq^.ttype;
+ 	(* keep working until a type is found *)
+ 	while tf = nil do
+ 	    begin
+ 		case tq^.tt of
+ 		  nchar:
+ 			tf := typnods[tchar];
+ 
+ 		  ninteger:
+ 			tf := typnods[tinteger];
+ 
+ 		  nreal:
+ 			tf := typnods[treal];
+ 
+ 		  nstring:
+ 			tf := typnods[tstring];
+ 
+ 		  nnil:
+ 			tf := typnods[tnil];
+ 
+ 		  nid:
+ 		    begin
+ 			tq := idup(tq);
+ 			if tq = nil then
+ 				fatal(etree)
+ 		    end;
+ 
+ 		  ntype,
+ 		  nvar,
+ 		  nconst,
+ 		  nfield,
+ 		  nvalpar,
+ 		  nvarpar:
+ 			tq := tq^.tbind;
+ 
+ 		  npredef,
+ 		  nptr,
+ 		  nscalar,
+ 		  nrecord,
+ 		  nconfarr,
+ 		  narray,
+ 		  nfileof,
+ 		  nsetof:
+ 			tf := tq;	(* these nodetypes represent types *)
+ 
+ 		  nsubrange:
+ 			if tq^.tup^.tt = nconfarr then
+ 				tf := tq^.tup^.tindtyp
+ 			else
+ 				tf := tq;
+ 
+ 		  ncall:
+ 		    begin
+ 			tf := typeof(tq^.tcall);
+ 			if tf = typnods[tpoly] then
+ 				tf := typeof(tq^.taparm)
+ 		    end;
+ 
+ 		  nfunc:
+ 			tq := tq^.tfuntyp;
+ 
+ 		  nparfunc:
+ 			tq := tq^.tpartyp;
+ 
+ 		  nproc,
+ 		  nparproc:
+ 			tf := typnods[tnone];
+ 
+ 		  nvariant,
+ 		  nlabel,
+ 		  npgm,
+ 		  nempty,
+ 		  nbegin,
+ 		  nlabstmt,
+ 		  nassign,
+ 		  npush,
+ 		  npop,
+ 		  nif,
+ 		  nwhile,
+ 		  nrepeat,
+ 		  nfor,
+ 		  ncase,
+ 		  nchoise,
+ 		  ngoto,
+ 		  nwith,
+ 		  nwithvar:
+ 			fatal(etree);
+ 
+ 		  nformat,
+ 		  nrange:
+ 			tq := tq^.texpl;
+ 
+ 		  nplus,
+ 		  nminus,
+ 		  nmul:
+ 		    begin
+ 			tf := typeof(tq^.texpl);
+ 			if tf = typnods[tinteger] then
+ 				tf := typeof(tq^.texpr)
+ 			else if tf^.tt = nsetof then
+ 				tf := typnods[tset]
+ 		    end;
+ 
+ 		  numinus,
+ 		  nuplus:
+ 			tq := tq^.texps;
+ 
+ 		  nmod,
+ 		  ndiv:
+ 			tf := typnods[tinteger];
+ 
+ 		  nquot:
+ 			tf := typnods[treal];
+ 
+ 		  neq,
+ 		  nne,
+ 		  nlt,
+ 		  nle,
+ 		  ngt,
+ 		  nge,
+ 		  nin,
+ 		  nor,
+ 		  nand,
+ 		  nnot:
+ 			tf := typnods[tboolean];
+ 
+ 		  nset:
+ 			tf := typnods[tset];
+ 
+ 		  nselect:
+ 			tq := tq^.tfield;
+ 
+ 		  nderef:
+ 		    begin
+ 			tq := typeof(tq^.texps);
+ 			case tq^.tt of
+ 			  nptr:
+ 				tq := tq^.tptrid;
+ 			  nfileof:
+ 				tq := tq^.tof;
+ 			  npredef:
+ 				tf := typnods[tchar]	(* textfile *)
+ 			end (* case *)
+ 		    end;
+ 
+ 		  nindex:
+ 		    begin
+ 			tq := typeof(tq^.tvariable);
+ 			if tq^.tt = nconfarr then
+ 				tq := tq^.tcelem
+ 			else if tq = typnods[tstring] then
+ 				tf := typnods[tchar]
+ 			else
+ 				tq := tq^.taelem
+ 		    end;
+ 
+ 		end (* case *)
+ 	end;
+ 	if tp^.ttype = nil then
+ 		tp^.ttype := tf;	(* remember type for future reference *)
+ 	typeof := tf
+ end;	(* typeof *)
+ 
+ (*	Connect all nodes to their fathers.				*)
+ procedure linkup(up, tp : treeptr);
+ 
+ begin
+ 	while tp <> nil do
+ 	    begin
+ 		if tp^.tup = nil then
+ 		    begin
+ 			tp^.tup := up;
+ 			case tp^.tt of
+ 			  npgm,
+ 			  nfunc,
+ 			  nproc:
+ 			    begin
+ 				linkup(tp, tp^.tsubid);
+ 				linkup(tp, tp^.tsubpar);
+ 				linkup(tp, tp^.tfuntyp);
+ 				linkup(tp, tp^.tsublab);
+ 				linkup(tp, tp^.tsubconst);
+ 				linkup(tp, tp^.tsubtype);
+ 				linkup(tp, tp^.tsubvar);
+ 				linkup(tp, tp^.tsubsub);
+ 				linkup(tp, tp^.tsubstmt)
+ 			    end;
+ 
+ 
+ 			  nvalpar,
+ 			  nvarpar,
+ 			  nconst,
+ 			  ntype,
+ 			  nfield,
+ 			  nvar:
+ 			    begin
+ 				linkup(tp, tp^.tidl);
+ 				linkup(tp, tp^.tbind)
+ 			    end;
+ 
+ 			  nparproc,
+ 			  nparfunc:
+ 			    begin
+ 				linkup(tp, tp^.tparid);
+ 				linkup(tp, tp^.tparparm);
+ 				linkup(tp, tp^.tpartyp)
+ 			    end;
+ 
+ 			  nptr:
+ 				linkup(tp, tp^.tptrid);
+ 			  nscalar:
+ 				linkup(tp, tp^.tscalid);
+ 
+ 			  nsubrange:
+ 			    begin
+ 				linkup(tp, tp^.tlo);
+ 				linkup(tp, tp^.thi)
+ 			    end;
+ 			  nvariant:
+ 			    begin
+ 				linkup(tp, tp^.tselct);
+ 				linkup(tp, tp^.tvrnt)
+ 			    end;
+ 			  nrecord:
+ 			    begin
+ 				linkup(tp, tp^.tflist);
+ 				linkup(tp, tp^.tvlist)
+ 			    end;
+ 			  nconfarr:
+ 			    begin
+ 				linkup(tp, tp^.tcindx);
+ 				linkup(tp, tp^.tcelem);
+ 				linkup(tp, tp^.tindtyp)
+ 			    end;
+ 			  narray:
+ 			    begin
+ 				linkup(tp, tp^.taindx);
+ 				linkup(tp, tp^.taelem)
+ 			    end;
+ 			  nfileof,
+ 			  nsetof:
+ 				linkup(tp, tp^.tof);
+ 			  nbegin:
+ 				linkup(tp, tp^.tbegin);
+ 			  nlabstmt:
+ 			    begin
+ 				linkup(tp, tp^.tlabno);
+ 				linkup(tp, tp^.tstmt)
+ 			    end;
+ 			  nassign:
+ 			    begin
+ 				linkup(tp, tp^.tlhs);
+ 				linkup(tp, tp^.trhs)
+ 			    end;
+ 			  npush,
+ 			  npop:
+ 			    begin
+ 				linkup(tp, tp^.tglob);
+ 				linkup(tp, tp^.tloc);
+ 				linkup(tp, tp^.ttmp)
+ 			    end;
+ 			  ncall:
+ 			    begin
+ 				linkup(tp, tp^.tcall);
+ 				linkup(tp, tp^.taparm )
+ 			    end;
+ 			  nif:
+ 			    begin
+ 				linkup(tp, tp^.tifxp);
+ 				linkup(tp, tp^.tthen);
+ 				linkup(tp, tp^.telse)
+ 			    end;
+ 			  nwhile:
+ 			    begin
+ 				linkup(tp, tp^.twhixp);
+ 				linkup(tp, tp^.twhistmt)
+ 			    end;
+ 			  nrepeat:
+ 			    begin
+ 				linkup(tp, tp^.treptstmt);
+ 				linkup(tp, tp^.treptxp)
+ 			    end;
+ 			  nfor:
+ 			    begin
+ 				linkup(tp, tp^.tforid);
+ 				linkup(tp, tp^.tfrom);
+ 				linkup(tp, tp^.tto);
+ 				linkup(tp, tp^.tforstmt)
+ 			    end;
+ 			  ncase:
+ 			    begin
+ 				linkup(tp, tp^.tcasxp);
+ 				linkup(tp, tp^.tcaslst);
+ 				linkup(tp, tp^.tcasother)
+ 			    end;
+ 			  nchoise:
+ 			    begin
+ 				linkup(tp, tp^.tchocon);
+ 				linkup(tp, tp^.tchostmt)
+ 			    end;
+ 			  nwith:
+ 			    begin
+ 				linkup(tp, tp^.twithvar);
+ 				linkup(tp, tp^.twithstmt)
+ 			    end;
+ 			  nwithvar:
+ 				linkup(tp, tp^.texpw);
+ 			  nindex:
+ 			    begin
+ 				linkup(tp, tp^.tvariable);
+ 				linkup(tp, tp^.toffset)
+ 			    end;
+ 			  nselect:
+ 			    begin
+ 				linkup(tp, tp^.trecord);
+ 				linkup(tp, tp^.tfield)
+ 			    end;
+ 
+ 			  ngoto:
+ 				linkup(tp, tp^.tlabel);
+ 
+ 			  nrange, nformat,
+ 			  nin, neq,
+ 			  nne, nlt, nle,
+ 			  ngt, nge, nor,
+ 			  nplus, nminus,
+ 			  nand, nmul,
+ 			  ndiv, nmod,
+ 			  nquot:
+ 			    begin
+ 				linkup(tp, tp^.texpl);
+ 				linkup(tp, tp^.texpr)
+ 			    end;
+ 
+ 			  nderef,
+ 			  nnot, nset,
+ 			  numinus,
+ 			  nuplus:
+ 				linkup(tp, tp^.texps);
+ 
+ 			  nid,
+ 			  nnil, ninteger,
+ 			  nreal, nchar,
+ 			  nstring, npredef,
+ 			  nlabel, nempty:
+ 				(* no op *)
+ 			end (* case *)
+ 		end;
+ 		tp := tp^.tnext
+ 	    end
+ end;	(* linkup *)
+ 
+ (*	Allocate a new symbol node.					*)
+ function mksym(vt : ltypes) : symptr;
+ 
+ var	mp	: symptr;
+ 
+ begin
+ 	new(mp);
+ 	if mp = nil then
+ 		error(enew);
+ 	mp^.lt := vt;
+ 	mp^.lnext := nil;
+ 	mp^.lsymdecl := nil;
+ 	mp^.ldecl := nil;
+ 	mksym := mp
+ end;
+ 
+ (*	Enter a symbol at current declarationlevel.			*)
+ procedure declsym(sp : symptr);
+ 
+ var	h	: hashtyp;
+ 
+ begin
+ 	if sp^.lt in [lpredef, lidentifier, lfield, lforward, lpointer] then
+ 		h := sp^.lid^.ihash
+ 	else
+ 		h := hashmax;
+ 	sp^.lnext := symtab^.ddecl[h];
+ 	symtab^.ddecl[h] := sp;
+ 	sp^.ldecl := symtab
+ end;
+ 
+ (*	Create a node of selected type.					*)
+ function mknode(nt : treetyp) : treeptr;
+ 
+ var	tp	: treeptr;
+ 
+ begin
+ 	tp := nil;
+ 	case nt of
+ 	  npredef:	new(tp, npredef);
+ 	  npgm:		new(tp, npgm);
+ 	  nfunc:	new(tp, nfunc);
+ 	  nproc:	new(tp, nproc);
+ 	  nlabel:	new(tp, nlabel);
+ 	  nconst:	new(tp, nconst);
+ 	  ntype:	new(tp, ntype);
+ 	  nvar:		new(tp, nvar);
+ 	  nvalpar:	new(tp, nvalpar);
+ 	  nvarpar:	new(tp, nvarpar);
+ 	  nparproc:	new(tp, nparproc);
+ 	  nparfunc:	new(tp, nparfunc);
+ 	  nsubrange:	new(tp, nsubrange);
+ 	  nvariant:	new(tp, nvariant);
+ 	  nfield:	new(tp, nfield);
+ 	  nrecord:	new(tp, nrecord);
+ 	  nconfarr:	new(tp, nconfarr);
+ 	  narray:	new(tp, narray);
+ 	  nfileof:	new(tp, nfileof);
+ 	  nsetof:	new(tp, nsetof);
+ 	  nbegin:	new(tp, nbegin);
+ 	  nptr:		new(tp, nptr);
+ 	  nscalar:	new(tp, nscalar);
+ 	  nif:		new(tp, nif);
+ 	  nwhile:	new(tp, nwhile);
+ 	  nrepeat:	new(tp, nrepeat);
+ 	  nfor:		new(tp, nfor);
+ 	  ncase:	new(tp, ncase);
+ 	  nchoise:	new(tp, nchoise);
+ 	  ngoto:	new(tp, ngoto);
+ 	  nwith:	new(tp, nwith);
+ 	  nwithvar:	new(tp, nwithvar);
+ 	  nempty:	new(tp, nempty);
+ 	  nlabstmt:	new(tp, nlabstmt);
+ 	  nassign:	new(tp, nassign);
+ 	  nformat:	new(tp, nformat);
+ 	  nin:		new(tp, nin);
+ 	  neq:		new(tp, neq);
+ 	  nne:		new(tp, nne);
+ 	  nlt:		new(tp, nlt);
+ 	  nle:		new(tp, nle);
+ 	  ngt:		new(tp, ngt);
+ 	  nge:		new(tp, nge);
+ 	  nor:		new(tp, nor);
+ 	  nplus:	new(tp, nplus);
+ 	  nminus:	new(tp, nminus);
+ 	  nand:		new(tp, nand);
+ 	  nmul:		new(tp, nmul);
+ 	  ndiv:		new(tp, ndiv);
+ 	  nmod:		new(tp, nmod);
+ 	  nquot:	new(tp, nquot);
+ 	  nnot:		new(tp, nnot);
+ 	  numinus:	new(tp, numinus);
+ 	  nuplus:	new(tp, nuplus);
+ 	  nset:		new(tp, nset);
+ 	  nrange:	new(tp, nrange);
+ 	  nindex:	new(tp, nindex);
+ 	  nselect:	new(tp, nselect);
+ 	  nderef:	new(tp, nderef);
+ 	  ncall:	new(tp, ncall);
+ 	  nid:		new(tp, nid);
+ 	  nchar:	new(tp, nchar);
+ 	  ninteger:	new(tp, ninteger);
+ 	  nreal:	new(tp, nreal);
+ 	  nstring:	new(tp, nstring);
+ 	  nnil:		new(tp, nnil);
+ 	  npush:	new(tp, npush);
+ 	  npop:		new(tp, npop);
+ 	  nbreak:	new(tp, nbreak)
+ 	end;(* case *)
+ 	if tp = nil then
+ 		error(enew);
+ 	tp^.tt := nt;
+ 	tp^.tnext := nil;
+ 	tp^.tup := nil;
+ 	tp^.ttype := nil;
+ 	mknode := tp
+ end;
+ 
+ (*	Create a node with a literal value.				*)
+ function mklit : treeptr;
+ 
+ var	sp	: symptr;
+ 	tp	: treeptr;
+ 
+ begin
+ 	case currsym.st of
+ 	  sinteger:
+ 	    begin
+ 		sp := mksym(linteger);
+ 		sp^.linum := currsym.vint;
+ 		tp := mknode(ninteger);
+ 	    end;
+ 	  sreal:
+ 	    begin
+ 		sp := mksym(lreal);
+ 		sp^.lfloat := currsym.vflt;
+ 		tp := mknode(nreal);
+ 	    end;
+ 	  schar:
+ 	    begin
+ 		sp := mksym(lcharacter);
+ 		sp^.lchar := currsym.vchr;
+ 		tp := mknode(nchar);
+ 	    end;
+ 	  sstring:
+ 	    begin
+ 		sp := mksym(lstring);
+ 		sp^.lstr := currsym.vstr;
+ 		tp := mknode(nstring);
+ 	    end
+ 	end;(* case *)
+ 	tp^.tsym := sp;
+ 	sp^.lsymdecl := tp;
+ 	mklit := tp
+ end;
+ 
+ (*	Look up an identifier among declared symbols.			*)
+ function lookupid(ip : idptr; fieldok : boolean) : symptr;
+ 
+ label	999;
+ 
+ var	sp	: symptr;
+ 	dp	: declptr;
+ 	vs	: set of ltypes;
+ 
+ begin
+ 	lookupid := nil;
+ 	if fieldok then
+ 		vs := [lidentifier, lforward, lpointer, lfield]
+ 	else
+ 		vs := [lidentifier, lforward, lpointer];
+ 	sp := nil;
+ 
+ 	(* pick up symboltable from innermost scope *)
+ 	dp := symtab;
+ 	while dp <> nil do
+ 	    begin
+ 		(* scan linked symbols with same hasvalue *) 
+ 		sp := dp^.ddecl[ip^.ihash];
+ 		while sp <> nil do
+ 		    begin
+ 			(* break out when proper id found *)
+ 			if (sp^.lt in vs) and (sp^.lid = ip) then
+ 				goto 999;
+ 			sp := sp^.lnext
+ 		    end;
+ 		(* proceed to enclosing scope *)
+ 		dp := dp^.dprev
+ 	    end;
+ 999:
+ 	lookupid := sp
+ end;
+ 
+ (*	Look up a label.						*)
+ function lookuplabel(i : integer) : symptr;
+ 
+ label	999;
+ 
+ var	sp	: symptr;
+ 	dp	: declptr;
+ 
+ begin
+ 	sp := nil;
+ 	dp := symtab;
+ 	while dp <> nil do
+ 	    begin
+ 		sp := dp^.ddecl[hashmax];
+ 		while sp <> nil do
+ 		    begin
+ 			if (sp^.lt in [lforwlab, llabel]) and (sp^.lno = i) then
+ 				goto 999;
+ 			sp := sp^.lnext
+ 		    end;
+ 		dp := dp^.dprev
+ 	    end;
+ 999:
+ 	lookuplabel := sp
+ end;
+ 
+ (*	Create a new declaration level (a new scope) link declnode to	*)
+ (*	previous node.	dp is non-nil when a procedure/function body	*)
+ (*	is encountered for which we have seen a forward declaration.	 *)
+ procedure enterscope(dp : declptr);
+ 
+ var	h	: hashtyp;
+ 
+ begin
+ 	if dp = nil then
+ 	    begin
+ 		new(dp);
+ 		for h := 0 to hashmax do
+ 			dp^.ddecl[h] := nil
+ 	    end;
+ 	dp^.dprev := symtab;
+ 	symtab := dp
+ end;
+ 
+ (*	Return current scope (as a pointer to symbol-table).	*)
+ function currscope : declptr;
+ 
+ begin
+ 	currscope := symtab
+ end;
+ 
+ (*	Drop innermost declaration scope.				*)
+ procedure leavescope;
+ 
+ begin
+ 	symtab := symtab^.dprev
+ end;
+ 
+ (*	Create a new identifier symbol.					*)
+ function mkid(ip : idptr) : symptr;
+ 
+ var	sp	: symptr;
+ 
+ begin
+ 	sp := mksym(lidentifier);
+ 	sp^.lid := ip;
+ 	sp^.lused := false;
+ 	declsym(sp);
+ 	ip^.inref := ip^.inref + 1;
+ 	mkid := sp
+ end;
+ 
+ (*	Check that the current identifier is new then save it in the	*)
+ (*	current scope. Create and return a new node representing this	*)
+ (*	instance of the identifier.					*)
+ function newid(ip : idptr) : treeptr;
+ 
+ var	sp	: symptr;
+ 	tp	: treeptr;
+ 
+ begin
+ 	sp := lookupid(ip, false);
+ 	if sp <> nil then
+ 		if sp^.ldecl <> symtab then
+ 			sp := nil;
+ 	if sp = nil then
+ 	    begin
+ 		(* new identifier *)
+ 		tp := mknode(nid);
+ 		sp := mkid(ip);
+ 		sp^.lsymdecl := tp;
+ 		tp^.tsym := sp
+ 	    end
+ 	else if sp^.lt = lpointer then
+ 	    begin
+ 		(* previously declared as a pointer type *)
+ 		tp := mknode(nid);
+ 		tp^.tsym := sp;
+ 		sp^.lt := lidentifier;
+ 		sp^.lsymdecl := tp
+ 	    end
+ 	else if sp^.lt = lforward then
+ 	    begin
+ 		(* previously forward declared *)
+ 		sp^.lt := lidentifier;
+ 		tp := sp^.lsymdecl
+ 	    end
+ 	else
+ 		error(emultdeclid);
+ 	newid := tp
+ end;
+ 
+ (*	Check that the current identifier is already declared,	*)
+ (*	we fail unless l in [lforward, lpointer].		*)
+ (*	Create and return a new node referencing it.		*)
+ function oldid(ip : idptr; l : ltypes) : treeptr;
+ 
+ var	sp	: symptr;
+ 	tp	: treeptr;
+ 
+ begin
+ 	sp := lookupid(ip, true);
+ 	if sp = nil then
+ 	    begin
+ 		if l in [lforward, lpointer] then
+ 		    begin
+ 			tp := newid(ip);
+ 			tp^.tsym^.lt := l
+ 		    end
+ 		else
+ 			error(enotdeclid)
+ 	    end
+ 	else begin
+ 		sp^.lused := true;
+ 		tp := mknode(nid);
+ 		tp^.tsym := sp;
+ 		if (sp^.lt = lpointer) and (l = lidentifier) then
+ 		    begin
+ 			sp^.lt := lidentifier;
+ 			sp^.lsymdecl := tp
+ 		    end
+ 	     end;
+ 	oldid := tp
+ end;
+ 
+ (*	Look up a field in a record declaration.			*)
+ (*	Return nil if field isn't declared in "tp" or its variants.	*)
+ function oldfield(tp : treeptr; ip : idptr) : treeptr;
+ 
+ label	999;
+ 
+ var	tq, ti,
+ 	fp	: treeptr;
+ 
+ begin
+ 	fp := nil;
+ 	tq := tp^.tflist;
+ 	while tq <> nil do
+ 	    begin
+ 		ti := tq^.tidl;
+ 		while ti <> nil do
+ 		    begin
+ 			if ti^.tsym^.lid = ip then
+ 			    begin
+ 				fp := mknode(nid);
+ 				fp^.tsym := ti^.tsym;
+ 				goto 999
+ 			    end;
+ 			ti := ti^.tnext
+ 		    end;
+ 		tq := tq^.tnext
+ 	    end;
+ 	tq := tp^.tvlist;
+ 	while tq <> nil do
+ 	    begin
+ 		fp := oldfield(tq^.tvrnt, ip);
+ 		if fp <> nil then
+ 			tq := nil
+ 		else
+ 			tq := tq^.tnext
+ 	    end;
+ 999:
+ 	oldfield := fp
+ end;
+ 
+ (*	This is the main parsing routine. It parses a correct pascal-	*)
+ (*	program and builds a parsetree which is left in the global	*)
+ (*	variable top.							*)
+ (*	Parsing is done through recursive descent using a set of	*)
+ (*	mutually recursive functions.					*)
+ procedure parse;
+ 
+ 	function plabel : treeptr;				forward;
+ 	function pidlist(l : ltypes) : treeptr;			forward;
+ 	function pconst : treeptr;				forward;
+ 	function pconstant(realok : boolean) : treeptr;		forward;
+ 	function precord(cs : symtyp; dp : declptr) : treeptr;	forward;
+ 	function ptypedef : treeptr;				forward;
+ 	function ptype : treeptr;				forward;
+ 	function pvar : treeptr;				forward;
+ 	function psubs : treeptr;				forward;
+ 	function psubpar : treeptr;				forward;
+ 	function plabstmt : treeptr;				forward;
+ 	function pstmt : treeptr;				forward;
+ 	function psimple : treeptr;				forward;
+ 	function pvariable(varptr : treeptr) : treeptr;		forward;
+ 	function pexpr(tnp : treeptr) : treeptr;		forward;
+ 	function pcase : treeptr;				forward;
+ 	function pif : treeptr;					forward;
+ 	function pwhile : treeptr;				forward;
+ 	function prepeat : treeptr;				forward;
+ 	function pfor : treeptr;				forward;
+ 	function pwith : treeptr;				forward;
+ 	function pgoto : treeptr;				forward;
+ 	function pbegin(retain : boolean) : treeptr;		forward;
+ 
+ 	(*	Open scope of a record variable.			*)
+ 	procedure scopeup(tp : treeptr);
+ 
+ 		(*	Scan a record-declaration and add all fields to	*)
+ 		(*	current scope.					*)
+ 		procedure addfields(rp : treeptr);
+ 
+ 		var	fp, ip, vp	: treeptr;
+ 			sp		: symptr;
+ 
+ 		begin
+ 			fp := rp^.tflist;
+ 			while fp <> nil do
+ 			    begin
+ 				ip := fp^.tidl;
+ 				while ip <> nil do
+ 				    begin
+ 					sp := mksym(lfield);
+ 					sp^.lid := ip^.tsym^.lid;
+ 					sp^.lused := false;
+ 					sp^.lsymdecl := ip;
+ 					declsym(sp);
+ 					ip := ip^.tnext
+ 				    end;
+ 				fp := fp^.tnext
+ 			    end;
+ 			vp := rp^.tvlist;
+ 			while vp <> nil do
+ 			    begin
+ 				addfields(vp^.tvrnt);
+ 				vp := vp^.tnext
+ 			    end
+ 		end;
+ 	begin
+ 		addfields(typeof(tp))
+ 	end;
+ 
+ 	(*	Check that the current label is new then save it in the	*)
+ 	(*	current scope. Create and return a new node referencing	*)
+ 	(*	the label.						*)
+ 	function newlbl : treeptr;
+ 
+ 	var	sp	: symptr;
+ 		tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nlabel);
+ 		sp := lookuplabel(currsym.vint);
+ 		if sp <> nil then
+ 			if sp^.ldecl <> symtab then
+ 				sp := nil;
+ 		if sp = nil then
+ 		    begin
+ 			sp := mksym(lforwlab);
+ 			sp^.lno := currsym.vint;
+ 			sp^.lgo := false;
+ 			sp^.lsymdecl := tp;
+ 			declsym(sp)
+ 		    end
+ 		else
+ 			error(emultdecllab);
+ 		tp^.tsym := sp;
+ 		newlbl := tp
+ 	end;
+ 
+ 	(*	Check that the current label is already declared.	*)
+ 	(*	Create and return a new node referencing it.		*)
+ 	function oldlbl(defpt : boolean) : treeptr;
+ 
+ 	var	sp	: symptr;
+ 		tp	: treeptr;
+ 
+ 	begin
+ 		sp := lookuplabel(currsym.vint);
+ 		if sp = nil then
+ 		    begin
+ 			prtmsg(enotdecllab);
+ 			tp := newlbl;
+ 			sp := tp^.tsym
+ 		    end
+ 		else begin
+ 			tp := mknode(nlabel);
+ 			tp^.tsym := sp
+ 		     end;
+ 		if defpt then
+ 		    begin
+ 
+ 			if sp^.lt = lforwlab then
+ 				sp^.lt := llabel
+ 			else
+ 				error(emuldeflab);
+ 		    end;
+ 		oldlbl := tp
+ 	end;
+ 
+ 	(*	Parse declaration and statement-body for prog/subs.	*)
+ 	procedure pbody(tp : treeptr);
+ 
+ 	var	tq	: treeptr;
+ 
+ 	begin
+ 		statlvl := statlvl + 1;
+ 		if currsym.st = slabel then
+ 		    begin
+ 			tp^.tsublab := plabel;
+ 			linkup(tp, tp^.tsublab)
+ 		    end
+ 		else
+ 			tp^.tsublab := nil;
+ 		if currsym.st = sconst then
+ 		    begin
+ 			tp^.tsubconst := pconst;
+ 			linkup(tp, tp^.tsubconst)
+ 		    end
+ 		else
+ 			tp^.tsubconst := nil;
+ 		if currsym.st = stype then
+ 		    begin
+ 			tp^.tsubtype := ptype;
+ 			linkup(tp, tp^.tsubtype)
+ 		    end
+ 		else
+ 			tp^.tsubtype := nil;
+ 		if currsym.st = svar then
+ 		    begin
+ 			tp^.tsubvar := pvar;
+ 			linkup(tp, tp^.tsubvar)
+ 		    end
+ 		else
+ 			tp^.tsubvar := nil;
+ 		tp^.tsubsub := nil;
+ 		tq := nil;
+ 		while (currsym.st = sproc) or (currsym.st = sfunc) do
+ 		    begin
+ 			if tq = nil then
+ 			    begin
+ 				tq := psubs;
+ 				tp^.tsubsub := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := psubs;
+ 				tq := tq^.tnext
+ 			     end
+ 		    end;
+ 		linkup(tp, tp^.tsubsub);
+ 		checksymbol([sbegin, seof]);
+ 		if currsym.st = sbegin then
+ 		    begin
+ 			tp^.tsubstmt := pbegin(false);
+ 			linkup(tp, tp^.tsubstmt)
+ 		    end;
+ 		statlvl := statlvl - 1
+ 	end;
+ 
+ 	(*	Parse program-declaration.				*)
+ 	function pprogram : treeptr;
+ 
+ 	var	tp	: treeptr;
+ 
+ 		(*	Parse a program parameter id-list.		*)
+ 		function pprmlist : treeptr;
+ 
+ 		label	999;
+ 
+ 		var	tp,
+ 			tq	: treeptr;
+ 			din,
+ 			dut	: idptr;
+ 
+ 		begin
+ 			tp := nil;
+ 			din := deftab[dinput]^.tidl^.tsym^.lid;
+ 			dut := deftab[doutput]^.tidl^.tsym^.lid;
+ 			while (currsym.vid = din) or (currsym.vid = dut) do
+ 			    begin
+ 				(* ignore input/output as parameters so that
+ 				   they will be bound to stdin/stdout unless
+ 				   declared as variables *)
+ 				if currsym.vid = din then
+ 					defnams[dinput]^.lused := true
+ 				else
+ 					defnams[doutput]^.lused := true;
+ 				nextsymbol([scomma, srpar]);
+ 				if currsym.st = srpar then
+ 					goto 999;
+ 				nextsymbol([sid])
+ 			    end;
+ 			tq := newid(currsym.vid);
+ 			tq^.tsym^.lt := lpointer;
+ 			tp := tq;
+ 			nextsymbol([scomma, srpar]);
+ 			while currsym.st = scomma do
+ 			    begin
+ 				nextsymbol([sid]);
+ 				if currsym.vid = din then
+ 					defnams[dinput]^.lused := true
+ 				else if currsym.vid = dut then
+ 					defnams[doutput]^.lused := true
+ 				else begin
+ 					tq^.tnext := newid(currsym.vid);
+ 					tq := tq^.tnext;
+ 					tq^.tsym^.lt := lpointer;
+ 				     end;
+ 				nextsymbol([scomma, srpar])
+ 			    end;
+ 		999:
+ 			pprmlist := tp
+ 		end;
+ 
+ 	begin	(* pprogram *)
+ 		enterscope(nil);
+ 		tp := mknode(npgm);
+ 		nextsymbol([sid]);
+ 		tp^.tstat := statlvl;
+ 		tp^.tsubid := mknode(nid);
+ 		tp^.tsubid^.tup := tp;
+ 		tp^.tsubid^.tsym := mksym(lidentifier);
+ 		tp^.tsubid^.tsym^.lid := currsym.vid;
+ 		tp^.tsubid^.tsym^.lsymdecl := tp^.tsubid;
+ 		linkup(tp, tp^.tsubid);
+ 		nextsymbol([slpar, ssemic]);
+ 		if currsym.st = slpar then
+ 		    begin
+ 			nextsymbol([sid]);
+ 			tp^.tsubpar := pprmlist;
+ 			linkup(tp, tp^.tsubpar);
+ 			nextsymbol([ssemic])
+ 		    end
+ 		else
+ 			tp^.tsubpar := nil;
+ 		nextsymbol([slabel, sconst, stype, svar,
+ 						sproc, sfunc, sbegin]);
+ 		pbody(tp);
+ 		checksymbol([sdot]);
+ 		tp^.tscope := currscope;
+ 		leavescope;
+ 		pprogram := tp
+ 	end;	(* pprogram *)
+ 
+ 	(*	Parse a module.				*)
+ 	function pmodule : treeptr;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin	(* pmodule *)
+ 		enterscope(nil);
+ 		tp := mknode(npgm);
+ 		tp^.tstat := statlvl;
+ 		tp^.tsubid := nil;
+ 		tp^.tsubpar := nil;
+ 		pbody(tp);
+ 		checksymbol([ssemic]);
+ 		tp^.tscope := currscope;
+ 		leavescope;
+ 		pmodule := tp
+ 	end;	(* pmodule *)
+ 
+ 
+ 	(*	Parse label-clause.					*)
+ 	function plabel;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		repeat
+ 			nextsymbol([sinteger]);
+ 			if tq = nil then
+ 			    begin
+ 				tq := newlbl;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := newlbl;
+ 				tq := tq^.tnext;
+ 			     end;
+ 			nextsymbol([scomma, ssemic])
+ 		until	currsym.st = ssemic;
+ 		nextsymbol([sconst, stype, svar, sbegin, sproc, sfunc]);
+ 		plabel := tp
+ 	end;
+ 
+ 	(*	Parse an id-list.					*)
+ 	function pidlist;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := newid(currsym.vid);
+ 		tq^.tsym^.lt := l;
+ 		tp := tq;
+ 		nextsymbol([scomma, scolon, seq, srpar]);
+ 		while currsym.st = scomma do
+ 		    begin
+ 			nextsymbol([sid]);
+ 			tq^.tnext := newid(currsym.vid);
+ 			tq := tq^.tnext;
+ 			tq^.tsym^.lt := l;
+ 			nextsymbol([scomma, scolon, seq, srpar])
+ 		    end;
+ 		pidlist := tp
+ 	end;
+ 
+ 	(*	Parse const-clause.					*)
+ 	function pconst;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		nextsymbol([sid]);
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nconst);
+ 				tq^.tattr := anone;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nconst);
+ 				tq := tq^.tnext;
+ 				tq^.tattr := anone
+ 			     end;
+ 			tq^.tidl := pidlist(lidentifier);
+ 			checksymbol([seq]);
+ 			nextsymbol([sid, schar, sstring, sinteger, sreal,
+ 						splus, sminus]);
+ 			tq^.tbind := pconstant(true);
+ 			nextsymbol([ssemic]);
+ 			nextsymbol([sid, stype, svar, sbegin,
+ 							sfunc, sproc, seof])
+ 		until	currsym.st <> sid;
+ 		pconst := tp
+ 	end;
+ 
+ 	(*	Parse a declared constant or a case-statment const.	*)
+ 	function pconstant;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 		neg	: boolean;
+ 
+ 	begin
+ 		neg := currsym.st = sminus;
+ 		if currsym.st in [splus, sminus] then
+ 			if realok then
+ 				nextsymbol([sid, sinteger, sreal])
+ 			else
+ 				nextsymbol([sid, sinteger]);
+ 		if currsym.st = sid then
+ 			tp := oldid(currsym.vid, lidentifier)
+ 		else
+ 			tp := mklit;
+ 		if neg then
+ 		    begin
+ 			tq := mknode(numinus);
+ 			tq^.texps := tp;
+ 			tp := tq
+ 		     end;
+ 		pconstant := tp
+ 	end;
+ 
+ 	(*	Parse a record (or record-variant) declaration.		*)
+ 	(*	Cs is the expected closing symbol, dp the scope.	*)
+ 	function precord;
+ 
+ 	label	999;
+ 
+ 	var	tp,
+ 		tq,
+ 		tl,
+ 		tv	: treeptr;
+ 		tsym	: lexsym;
+ 
+ 	begin
+ 		tp := mknode(nrecord);
+ 		tp^.tflist := nil;
+ 		tp^.tvlist := nil;
+ 		tp^.tuid := nil;
+ 		tp^.trscope := nil;
+ 		if cs = send then
+ 		    begin
+ 			enterscope(dp);
+ 			dp := currscope
+ 		    end;
+ 		nextsymbol([sid, scase] + [cs]);
+ 		tq := nil;
+ 		while currsym.st = sid do
+ 		    begin
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nfield);
+ 				tq^.tattr := anone;
+ 				tp^.tflist := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nfield);
+ 				tq := tq^.tnext;
+ 				tq^.tattr := anone
+ 			     end;
+ 			tq^.tidl := pidlist(lfield);
+ 			checksymbol([scolon]);
+ 			leavescope;
+ 			tq^.tbind := ptypedef;
+ 			enterscope(dp);
+ 			if currsym.st = ssemic then
+ 				nextsymbol([sid, scase] + [cs])
+ 		    end;
+ 		if currsym.st = scase then
+ 		    begin
+ 			nextsymbol([sid]);
+ 			tsym := currsym;
+ 			nextsymbol([scolon, sof]);
+ 			if currsym.st = scolon then
+ 			    begin
+ 				tv := newid(tsym.vid);
+ 				if tq = nil then
+ 				    begin
+ 					tq := mknode(nfield);
+ 					tp^.tflist := tq
+ 				    end
+ 				else begin
+ 					tq^.tnext := mknode(nfield);
+ 					tq := tq^.tnext
+ 				     end;
+ 				tq^.tidl := tv;
+ 				tv^.tsym^.lt := lfield;
+ 				nextsymbol([sid]);
+ 				leavescope;
+ 				tq^.tbind := oldid(currsym.vid, lidentifier);
+ 				enterscope(dp);
+ 				nextsymbol([sof])
+ 			    end;
+ 			tq := nil;
+ 			repeat
+ 				tv := nil;
+ 				repeat
+ 					nextsymbol([sid, sinteger, schar, splus,
+ 							 sminus] + [cs]);
+ 					if currsym.st = cs then
+ 						goto 999;
+ 					if tv = nil then
+ 					    begin
+ 						tv := pconstant(false);
+ 						tl := tv
+ 					    end
+ 					else begin
+ 						tv^.tnext := pconstant(false);
+ 						tv := tv^.tnext
+ 					     end;
+ 					nextsymbol([scolon, scomma])
+ 				until currsym.st = scolon;
+ 				nextsymbol([slpar]);
+ 				if tq = nil then
+ 				    begin
+ 					tq := mknode(nvariant);
+ 					tp^.tvlist := tq;
+ 				    end
+ 				else begin
+ 					tq^.tnext := mknode(nvariant);
+ 					tq := tq^.tnext;
+ 				     end;
+ 				tq^.tselct := tl;
+ 				tq^.tvrnt := precord(srpar, dp)
+ 			until	currsym.st = cs
+ 		    end;
+ 	999:
+ 		if cs = send then
+ 		    begin
+ 			tp^.trscope := dp;
+ 			leavescope
+ 		    end;
+ 		nextsymbol([ssemic, send, srpar]);
+ 		(* currsym is the symbol following record end/rpar,
+ 			(usually semicolon, sometimes enclosing end/rpar) *)
+ 		precord := tp
+ 	end;
+ 
+ 	function ptypedef;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 		st	: symtyp;
+ 		ss	: symset;
+ 
+ 	begin
+ 		nextsymbol([sid, slpar, sarrow, sinteger, schar, splus, sminus,
+ 				spacked, sarray, srecord, sfile, sset]);
+ 
+ 		(* the "packed" keyword is completely ignored *)
+ 		if currsym.st = spacked then
+ 			nextsymbol([sarray, srecord, sfile, sset]);
+ 
+ 		ss := [ssemic, send, srpar, scomma, srbrack];
+ 		case currsym.st of
+ 		  splus,
+ 		  sminus,
+ 		  schar,
+ 		  sinteger,
+ 		  sid:
+ 		    begin
+ 			st := currsym.st;
+ 			tp := pconstant(false);
+ 			if st = sid then
+ 				nextsymbol([sdotdot] + ss)
+ 			else
+ 				nextsymbol([sdotdot]);
+ 			if currsym.st = sdotdot then
+ 			    begin
+ 				nextsymbol([sid, sinteger, schar,
+ 								splus, sminus]);
+ 				tq := mknode(nsubrange);
+ 				tq^.tlo := tp;
+ 				tq^.thi := pconstant(false);
+ 				tp := tq;
+ 				nextsymbol(ss)
+ 			    end
+ 		    end;
+ 		  slpar:
+ 		    begin
+ 			tp := mknode(nscalar);
+ 			nextsymbol([sid]);
+ 			tp^.tscalid := pidlist(lidentifier);
+ 			checksymbol([srpar]);
+ 			nextsymbol(ss)
+ 		    end;
+ 		  sarrow:
+ 		    begin
+ 			tp := mknode(nptr);
+ 			nextsymbol([sid]);
+ 			tp^.tptrid := oldid(currsym.vid, lpointer);
+ 			tp^.tptrflag := false;
+ 			nextsymbol([ssemic, send, srpar])
+ 		    end;
+ 		  sarray:
+ 		    begin
+ 			nextsymbol([slbrack]);
+ 			tp := mknode(narray);
+ 			tp^.taindx := ptypedef;	(* parse subrange ...	*)
+ 			tq := tp;
+ 			while currsym.st = scomma do
+ 			    begin
+ 				(* expand:   array [ A , B ] of X
+ 				   to:   array [ A ] of array [ B ] of X   *)
+ 				tq^.taelem := mknode(narray);
+ 				tq := tq^.taelem;
+ 				tq^.taindx := ptypedef	(* ... again	*)
+ 			    end;
+ 			checksymbol([srbrack]);
+ 			nextsymbol([sof]);
+ 			tq^.taelem := ptypedef
+ 		    end;
+ 		  srecord:
+ 			tp := precord(send, nil);
+ 		  sfile,
+ 		  sset:
+ 		    begin
+ 			if currsym.st = sfile then
+ 				tp := mknode(nfileof)
+ 			else begin
+ 				tp := mknode(nsetof);
+ 				usesets := true
+ 			     end;
+ 			nextsymbol([sof]);
+ 			tp^.tof := ptypedef
+ 		    end
+ 		end;
+ 		(* at this point "currsym" holds the symbol following the type
+ 		   (usually semicolon, sometimes the following end/rpar) *)
+ 		ptypedef := tp
+ 	end;
+ 
+ 	(*	Parse type-clause.					*)
+ 	function ptype;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		nextsymbol([sid]);
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(ntype);
+ 				tq^.tattr := anone;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(ntype);
+ 				tq := tq^.tnext;
+ 				tq^.tattr := anone
+ 			     end;
+ 			tq^.tidl := pidlist(lidentifier);
+ 			checksymbol([seq]);
+ 			tq^.tbind := ptypedef;
+ 			nextsymbol([sid, svar, sbegin, sfunc, sproc, seof])
+ 		until	currsym.st <> sid;
+ 		ptype := tp;
+ 	end;
+ 
+ 	(*	Parse var-clause.					*)
+ 	function pvar;
+ 
+ 	var	ti,
+ 		tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		nextsymbol([sid]);
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nvar);
+ 				tq^.tattr := anone;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nvar);
+ 				tq := tq^.tnext;
+ 				tq^.tattr := anone
+ 			     end;
+ 
+ 			ti := newid(currsym.vid);
+ 			tq^.tidl := ti;
+ 			nextsymbol([scomma, scolon]);
+ 			while currsym.st = scomma do
+ 			    begin
+ 				nextsymbol([sid]);
+ 				ti^.tnext := newid(currsym.vid);
+ 				ti := ti^.tnext;
+ 				nextsymbol([scomma, scolon])
+ 			    end;
+ 
+ 			tq^.tbind := ptypedef;
+ 			nextsymbol([sid, sbegin, sfunc, sproc, seof])
+ 		until	currsym.st <> sid;
+ 		pvar := tp
+ 	end;
+ 
+ 	(*	Parse subroutine-declaration.				*)
+ 	function psubs;
+ 
+ 	var	tp,			(* return value		*)
+ 		tv, tq	: treeptr;	(* temporary		*)
+ 		func	: boolean;	(* true for functions	*)
+ 		colsem	: symtyp;	(* colon/semicolon	*)
+ 
+ 	begin
+ 		(* parsing function or procedure *)
+ 		func := currsym.st = sfunc;
+ 		if func then
+ 			colsem := scolon
+ 		else
+ 			colsem := ssemic;
+ 
+ 		(* parse id, it may already be forward declared *)
+ 		nextsymbol([sid]);
+ 		tq := newid(currsym.vid);
+ 		if tq^.tup = nil then
+ 		   begin
+ 			enterscope(nil);
+ 			(* id wasn't previously declared, params possible *)
+ 			if func then
+ 				tp := mknode(nfunc)
+ 			else
+ 				tp := mknode(nproc);
+ 			tp^.tstat := statlvl;
+ 			tp^.tsubid := tq;
+ 			linkup(tp, tq);
+ 			nextsymbol([slpar, colsem]);
+ 			if currsym.st = slpar then
+ 			    begin
+ 				tp^.tsubpar := psubpar;
+ 				linkup(tp, tp^.tsubpar);
+ 				nextsymbol([colsem])
+ 			    end
+ 			else
+ 				tp^.tsubpar := nil;
+ 			if func then
+ 			    begin
+ 				(* parse function type *)
+ 				nextsymbol([sid]);
+ 				tp^.tfuntyp := oldid(currsym.vid, lidentifier);
+ 				nextsymbol([ssemic])
+ 			    end
+ 			else
+ 				tp^.tfuntyp := mknode(nempty);
+ 			linkup(tp, tp^.tfuntyp);
+ 			nextsymbol([sextern, sforward,
+ 					slabel, sconst, stype, svar,
+ 							sproc, sfunc, sbegin]);
+ 		   end
+ 		else begin
+ 			(* id was forward declared =>
+ 				pick up declarations from parameterlist *)
+ 			enterscope(tq^.tup^.tscope);
+ 			if func then
+ 				tp := mknode(nfunc)
+ 			else
+ 				tp := mknode(nproc);
+ 			tp^.tfuntyp := tq^.tup^.tfuntyp;
+ 			(* steal id and params from forward decl *)
+ 			tv := tq^.tup^.tsubpar;
+ 			tp^.tsubpar := tv;
+ 			while tv <> nil do
+ 			    begin
+ 				tv^.tup := tp;
+ 				tv := tv^.tnext
+ 			    end;
+ 			tp^.tsubid := tq;
+ 			tq^.tup := tp;
+ 			(* id was forward declared =>
+ 				no params, no function type, no forward *)
+ 			nextsymbol([ssemic]);
+ 			nextsymbol([slabel, sconst, stype, svar,
+ 							sproc, sfunc, sbegin]);
+ 		     end;
+ 		if currsym.st in [sforward, sextern] then
+ 		    begin
+ 			tp^.tsubid^.tsym^.lt := lforward;
+ 			nextsymbol([ssemic]);
+ 			tp^.tsublab := nil;
+ 			tp^.tsubconst := nil;
+ 			tp^.tsubtype := nil;
+ 			tp^.tsubvar := nil;
+ 			tp^.tsubsub := nil;
+ 			tp^.tsubstmt := nil
+ 		    end
+ 		else
+ 			pbody(tp);
+ 		nextsymbol([sproc, sfunc, sbegin, seof]);
+ 		tp^.tscope := currscope;
+ 		leavescope;
+ 		psubs := tp
+ 	end;
+ 
+ 	(*	Parse a conformant array index type.			*)
+ 	function pconfsub : treeptr;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nsubrange);
+ 		nextsymbol([sid]);
+ 		tp^.tlo := newid(currsym.vid);
+ 		nextsymbol([sdotdot]);
+ 		nextsymbol([sid]);
+ 		tp^.thi := newid(currsym.vid);
+ 		nextsymbol([scolon]);
+ 		pconfsub := tp
+ 	end;
+ 
+ 	(*	Parse a conformant array-declaration.			*)
+ 	function pconform : treeptr;
+ 
+ 	var	tp, tq	: treeptr;
+ 
+ 	begin
+ 		nextsymbol([slbrack]);
+ 		tp := mknode(nconfarr);
+ 		tp^.tcuid := mkvariable('S');
+ 		tp^.tcindx := pconfsub;	(* parse subrange ...	*)
+ 		nextsymbol([sid]);
+ 		tp^.tindtyp := oldid(currsym.vid, lidentifier);
+ 		nextsymbol([ssemic, srbrack]);
+ 		tq := tp;
+ 		while currsym.st = ssemic do
+ 		    begin
+ 			error(econfconf); (* what size does tp have *)
+ 
+ 			(* expand:   array [ A ; B ] of X
+ 			   to:   array [ A ] of array [ B ] of X   *)
+ 			tq^.tcelem := mknode(nconfarr);
+ 			tq := tq^.tcelem;
+ 			tq^.tcindx := pconfsub;	(* ... again	*)
+ 			nextsymbol([sid]);
+ 			tq^.tindtyp := oldid(currsym.vid, lidentifier);
+ 			nextsymbol([ssemic, srbrack])
+ 		    end;
+ 		nextsymbol([sof]);
+ 		nextsymbol([sid, sarray]);
+ 		case currsym.st of
+ 		  sid:
+ 			tq^.tcelem := oldid(currsym.vid, lidentifier);
+ 		  sarray: 
+ 		    begin
+ 			error(econfconf); (* what size does tp have *)
+ 
+ 			tq^.tcelem := pconform
+ 		    end;
+ 		end;(* case *)
+ 		pconform := tp
+ 	end;
+ 
+ 	(*	Parse subroutine parameter list.			*)
+ 	function psubpar;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 		nt	: treetyp;
+ 
+ 	begin
+ 		tq := nil;
+ 		repeat
+ 			nextsymbol([sid, svar, sfunc, sproc]);
+ 			case currsym.st of
+ 			  sid:
+ 				nt := nvalpar;
+ 			  svar:
+ 				nt := nvarpar;
+ 			  sfunc:
+ 				nt := nparfunc;
+ 			  sproc:
+ 				nt := nparproc;
+ 			end;
+ 			if nt <> nvalpar then
+ 				nextsymbol([sid]);
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nt);
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nt);
+ 				tq := tq^.tnext
+ 			     end;
+ 			case nt of
+ 			  nvarpar,
+ 			  nvalpar:
+ 			    begin
+ 				tq^.tidl := pidlist(lidentifier);
+ 				tq^.tattr := anone;
+ 				checksymbol([scolon]);
+ 				if nt = nvalpar then
+ 					nextsymbol([sid])
+ 				else
+ 					nextsymbol([sid, sarray]);
+ 				case currsym.st of
+ 				  sid:
+ 					tq^.tbind :=
+ 						oldid(currsym.vid, lidentifier);
+ 				  sarray:
+ 					tq^.tbind := pconform
+ 				end;(* case *)
+ 				nextsymbol([srpar, ssemic])
+ 			    end;
+ 			  nparproc:
+ 			    begin
+ 				tq^.tparid := newid(currsym.vid);
+ 				nextsymbol([ssemic, slpar, srpar]);
+ 				if currsym.st = slpar then
+ 				    begin
+ 					enterscope(nil);
+ 					tq^.tparparm := psubpar;
+ 					nextsymbol([ssemic, srpar]);
+ 					leavescope
+ 				    end
+ 				else
+ 					tq^.tparparm := nil;
+ 				tq^.tpartyp := nil
+ 			    end;
+ 			  nparfunc:
+ 			    begin
+ 				tq^.tparid := newid(currsym.vid);
+ 				nextsymbol([scolon, slpar]);
+ 				if currsym.st = slpar then
+ 				    begin
+ 					enterscope(nil);
+ 					tq^.tparparm := psubpar;
+ 					nextsymbol([scolon]);
+ 					leavescope
+ 				    end
+ 				else
+ 					tq^.tparparm := nil;
+ 				nextsymbol([sid]);
+ 				tq^.tpartyp := oldid(currsym.vid, lidentifier);
+ 				nextsymbol([srpar, ssemic])
+ 			    end
+ 			end (* case *)
+ 		until	currsym.st = srpar;
+ 		psubpar := tp
+ 	end;
+ 
+ 	(*	Parse a (possibly labeled) statement.			*)
+ 	function plabstmt;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		nextsymbol([sid, sinteger, sif, swhile, srepeat, sfor, scase,
+ 				  swith, sbegin, sgoto,
+ 					selse, ssemic, send, suntil]);
+ 		if currsym.st = sinteger then
+ 		    begin
+ 			tp := mknode(nlabstmt);
+ 			tp^.tlabno := oldlbl(true);
+ 			nextsymbol([scolon]);
+ 			nextsymbol([sid, sif, swhile, srepeat, sfor, scase,
+ 				  swith, sbegin, sgoto,
+ 					selse, ssemic, send, suntil]);
+ 			tp^.tstmt := pstmt
+ 		    end
+ 		else
+ 			tp := pstmt;
+ 		plabstmt := tp
+ 	end;
+ 
+ 	(*	Parse an unlabeled statement.				*)
+ 	function pstmt;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		case currsym.st of
+ 		  sid:
+ 			tp := psimple;
+ 		  sif:
+ 			tp := pif;
+ 		  swhile:
+ 			tp := pwhile;
+ 		  srepeat:
+ 			tp := prepeat;
+ 		  sfor:
+ 			tp := pfor;
+ 		  scase:
+ 			tp := pcase;
+ 		  swith:
+ 			tp := pwith;
+ 		  sbegin:
+ 			tp := pbegin(true);
+ 		  sgoto:
+ 			tp := pgoto;
+ 		  send,
+ 		  selse,
+ 		  suntil,
+ 		  ssemic:
+ 			tp := mknode(nempty);
+ 		end;
+ 		pstmt := tp
+ 	end;
+ 
+ 	(*	Parse an assignment or a procedure call.		*)
+ 	function psimple;
+ 
+ 	var	tq,
+ 		tp	: treeptr;
+ 
+ 	begin
+ 		tp := pvariable(oldid(currsym.vid, lidentifier));
+ 		if currsym.st = sassign then
+ 		    begin
+ 			tq := mknode(nassign);
+ 			tq^.tlhs := tp;
+ 			tq^.trhs := pexpr(nil);
+ 			tp := tq
+ 		    end;
+ 		psimple := tp
+ 	end;
+ 
+ 	(*	Parse a varable-reference (or a subroutine-call).	*)
+ 	function pvariable;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		nextsymbol([slpar, slbrack, sdot, sarrow,
+ 			sassign, ssemic, scomma, scolon, sdotdot,
+ 			splus, sminus, smul, sdiv, smod, squot,
+ 			sand, sor, sinn, srpar, srbrack,
+ 			sle, slt, seq, sge, sgt, sne,
+ 			send, suntil, sthen, selse, sdo, sdownto, sto, sof]);
+ 		if currsym.st in [slpar, slbrack, sdot, sarrow] then
+ 		    begin
+ 			case currsym.st of
+ 			  slpar:
+ 			    begin
+ 				tp := mknode(ncall);
+ 				tp^.tcall := varptr;
+ 				tq := nil;
+ 				repeat
+ 					if tq = nil then
+ 					    begin
+ 						tq := pexpr(nil);
+ 						tp^.taparm  := tq
+ 					    end
+ 					else begin
+ 						tq^.tnext := pexpr(nil);
+ 						tq := tq^.tnext
+ 					     end;
+ 				until	currsym.st = srpar
+ 			    end;
+ 			  slbrack:
+ 			    begin
+ 				tq := varptr;
+ 				repeat
+ 					tp := mknode(nindex);
+ 					tp^.tvariable := tq;
+ 					tp^.toffset := pexpr(nil);
+ 					tq := tp
+ 				until	currsym.st = srbrack
+ 			    end;
+ 			  sdot:
+ 			    begin
+ 				tp := mknode(nselect);
+ 				tp^.trecord := varptr;
+ 				nextsymbol([sid]);
+ 				tq := typeof(varptr);
+ 				enterscope(tq^.trscope);
+ 				tp^.tfield := oldid(currsym.vid, lfield);
+ 				leavescope
+ 			    end;
+ 			  sarrow:
+ 			    begin
+ 				tp := mknode(nderef);
+ 				tp^.texps := varptr
+ 			    end
+ 			end;(* case *)
+ 			tp := pvariable(tp)
+ 		    end
+ 		else begin
+ 			tp := varptr;
+ 			if tp^.tt = nid then
+ 			    begin
+ 				tq := idup(tp);
+ 				if tq <> nil then
+ 					if tq^.tt in [nfunc, nproc,
+ 							nparproc, nparfunc] then
+ 					    begin
+ 						(* subroutine-call without
+ 						   parameters *)
+ 						tp := mknode(ncall);
+ 						tp^.tcall := varptr;
+ 						tp^.taparm := nil
+ 					    end
+ 			    end
+ 		     end;
+ 		pvariable := tp
+ 	end;
+ 
+ 	(*	Parse an expression.					*)
+ 	function pexpr;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 		nt	: treetyp;
+ 		next	: boolean;
+ 
+ 		function padjust(tu, tr : treeptr) : treeptr;
+ 		begin
+ 			if pprio[tu^.tt] >= pprio[tr^.tt] then
+ 			    begin
+ 				if tr^.tt in [nnot, numinus, nuplus,
+ 							nset, nderef] then
+ 					tr^.texps := padjust(tu, tr^.texps)
+ 				else
+ 					tr^.texpl := padjust(tu, tr^.texpl);
+ 				padjust := tr
+ 			    end
+ 			else begin
+ 				if tu^.tt in [nnot, numinus, nuplus,
+ 							nset, nderef] then
+ 					tu^.texps := tr
+ 				else
+ 					tu^.texpr := tr;
+ 				padjust := tu
+ 			     end
+ 		end;
+ 
+ 	begin
+ 		nextsymbol([sid, schar, sinteger, sreal, sstring, snil,
+ 				splus, sminus, snot, slpar, slbrack, srbrack]);
+ 		next := true;
+ 		case currsym.st of
+ 		  splus:
+ 		    begin
+ 			tp := mknode(nuplus);
+ 			tp^.texps := nil;
+ 			tp := pexpr(tp);
+ 			next := false
+ 		    end;
+ 		  sminus:
+ 		    begin
+ 			tp := mknode(numinus);
+ 			tp^.texps := nil;
+ 			tp := pexpr(tp);
+ 			next := false
+ 		    end;
+ 		  snot:
+ 		    begin
+ 			tp := mknode(nnot);
+ 			tp^.texps := nil;
+ 			tp := pexpr(tp);
+ 			next := false
+ 		    end;
+ 		  schar,
+ 		  sinteger,
+ 		  sreal,
+ 		  sstring:
+ 			tp := mklit;
+ 		  snil:
+ 		    begin
+ 			usenilp := true;
+ 			tp := mknode(nnil);
+ 		    end;
+ 		  sid:
+ 		    begin
+ 			tp := pvariable(oldid(currsym.vid, lidentifier));
+ 			next := false
+ 		    end;
+ 		  slpar:
+ 		    begin
+ 			tp := mknode(nuplus);
+ 			tp^.texps := pexpr(nil)
+ 		    end;
+ 		  slbrack:
+ 		    begin
+ 			usesets := true;
+ 			tp := mknode(nset);
+ 			tp^.texps := nil;
+ 			tq := nil;
+ 			repeat
+ 				if tq = nil then
+ 				    begin
+ 					tq := pexpr(nil);
+ 					tp^.texps := tq
+ 				    end
+ 				else begin
+ 					tq^.tnext := pexpr(nil);
+ 					tq := tq^.tnext
+ 				     end
+ 			until	currsym.st = srbrack;
+ 		    end;
+ 		  srbrack:
+ 		    begin
+ 			tp := mknode(nempty);
+ 			next := false
+ 		    end
+ 		end;
+ 		if next then
+ 			nextsymbol([
+ 				scolon, ssemic, scomma, sdotdot, srpar, srbrack,
+ 				sle, slt, seq, sge, sgt, sne,
+ 				splus, sminus, smul, sdiv, smod, squot,
+ 				sand, sor, sinn,
+ 				send, suntil, sthen, selse, sdo, sdownto, sto,
+ 				sof, slpar, slbrack]);
+ 		case currsym.st of
+ 		  sdotdot:
+ 			nt := nrange;
+ 		  splus:
+ 			nt := nplus;
+ 		  sminus:
+ 			nt := nminus;
+ 		  smul:
+ 			nt := nmul;
+ 		  sdiv:
+ 			nt := ndiv;
+ 		  smod:
+ 			nt := nmod;
+ 		  squot:
+ 		    begin
+ 			defnams[dreal]^.lused := true;
+ 			nt := nquot;
+ 		    end;
+ 		  sand:
+ 			nt := nand;
+ 		  sor:
+ 			nt := nor;
+ 		  sinn:
+ 		    begin
+ 			nt := nin;
+ 			usesets := true
+ 		    end;
+ 		  sle:
+ 			nt := nle;
+ 		  slt:
+ 			nt := nlt;
+ 		  seq:
+ 			nt := neq;
+ 		  sge:
+ 			nt := nge;
+ 		  sgt:
+ 			nt := ngt;
+ 		  sne:
+ 			nt := nne;
+ 		  scolon:
+ 			nt := nformat;
+ 		  sid, schar, sinteger, sreal, sstring, snil,
+ 		  ssemic, scomma, slpar, slbrack, srpar, srbrack,
+ 		  send, suntil, sthen, selse, sdo, sdownto, sto, sof:
+ 			nt := nnil
+ 		end;(* case *)
+ 		if nt in [nin .. nor, nand, nnot] then
+ 			defnams[dboolean]^.lused := true;
+ 		if nt <> nnil then
+ 		    begin
+ 			(* binary operator *)
+ 			tq := mknode(nt);
+ 			tq^.texpl := tp;
+ 			tq^.texpr := nil;
+ 			tp := pexpr(tq)
+ 		    end;
+ 
+ 		(* this statement yilds proper operator precedence *)
+ 		if tnp <> nil then
+ 			tp := padjust(tnp, tp);
+ 		pexpr := tp
+ 	end;
+ 
+ 	(*	Parse a case-statement.					*)
+ 	function pcase;
+ 
+ 	label	999;
+ 
+ 	var	tp,
+ 		tq,
+ 		tv	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(ncase);
+ 		tp^.tcasxp := pexpr(nil);
+ 		checksymbol([sof]);
+ 		tq := nil;
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nchoise);
+ 				tp^.tcaslst := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nchoise);
+ 				tq := tq^.tnext
+ 			     end;
+ 			tv := nil;
+ 			repeat
+ 				nextsymbol([sid, sinteger, schar,
+ 						splus, sminus, send, sother]);
+ 				if currsym.st in [send, sother] then
+ 					goto 999;
+ 				if tv = nil then
+ 				    begin
+ 					tv := pconstant(false);
+ 					tq^.tchocon := tv
+ 				    end
+ 				else begin
+ 					tv^.tnext := pconstant(false);
+ 					tv := tv^.tnext
+ 				     end;
+ 				nextsymbol([scomma, scolon])
+ 			until	currsym.st = scolon;
+ 			tq^.tchostmt := plabstmt
+ 		until	currsym.st = send;
+ 	999:
+ 		if currsym.st = sother then
+ 		    begin
+ 			nextsymbol([scolon, sid, sif, swhile, srepeat, sfor,
+ 				    scase, swith, sbegin, sgoto,
+ 					selse, ssemic, send, suntil]);
+ 			if currsym.st = scolon then
+ 				nextsymbol([sid, sif, swhile, srepeat, sfor,
+ 				    scase, swith, sbegin, sgoto,
+ 					selse, ssemic, send, suntil]);
+ 			tp^.tcasother := pstmt
+ 		    end
+ 		else begin
+ 			tp^.tcasother := nil;
+ 			usecase := true
+ 		     end;
+ 		nextsymbol([ssemic, send, selse, suntil]);
+ 		pcase := tp
+ 	end;
+ 
+ 	(*	Parse an if-statement.					*)
+ 	function pif;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nif);
+ 		tp^.tifxp := pexpr(nil);
+ 		checksymbol([sthen]);
+ 		tp^.tthen := plabstmt;
+ 		if currsym.st = selse then
+ 			tp^.telse := plabstmt
+ 		else
+ 			tp^.telse := nil;
+ 		pif := tp;
+ 	end;
+ 
+ 	(*	Parse a while-statement.				*)
+ 	function pwhile;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nwhile);
+ 		tp^.twhixp := pexpr(nil);
+ 		checksymbol([sdo]);
+ 		tp^.twhistmt := plabstmt;
+ 		pwhile := tp;
+ 	end;
+ 
+ 	(*	Parse a repeat-statement.				*)
+ 	function prepeat;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nrepeat);
+ 		tq := nil;
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := plabstmt;
+ 				tp^.treptstmt := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := plabstmt;
+ 				tq := tq^.tnext
+ 			     end;
+ 			checksymbol([ssemic, suntil])
+ 		until	currsym.st = suntil;
+ 		tp^.treptxp := pexpr(nil);
+ 		prepeat := tp
+ 	end;
+ 
+ 	(*	Parse a for-statement.					*)
+ 	function pfor;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nfor);
+ 		nextsymbol([sid]);
+ 		tp^.tforid := oldid(currsym.vid, lidentifier);
+ 		nextsymbol([sassign]);
+ 		tp^.tfrom := pexpr(nil);
+ 		checksymbol([sdownto, sto]);
+ 		tp^.tincr := currsym.st = sto;
+ 		tp^.tto := pexpr(nil);
+ 		checksymbol([sdo]);
+ 		tp^.tforstmt := plabstmt;
+ 		pfor := tp
+ 	end;
+ 
+ 	(*	Parse a with-statement.					*)
+ 	function pwith;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tp := mknode(nwith);
+ 		tq := nil;
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := mknode(nwithvar);
+ 				tp^.twithvar := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := mknode(nwithvar);
+ 				tq := tq^.tnext
+ 			     end;
+ 			enterscope(nil);
+ 			tq^.tenv := currscope;
+ 			tq^.texpw := pexpr(nil);
+ 			scopeup(tq^.texpw);
+ 			checksymbol([scomma, sdo])
+ 		until	currsym.st = sdo;
+ 		tp^.twithstmt := plabstmt;
+ 		tq := tp^.twithvar;
+ 		while tq <> nil do
+ 		    begin
+ 			leavescope;
+ 			tq := tq^.tnext
+ 		    end;
+ 		pwith := tp
+ 	end;
+ 
+ 	(*	Parse a goto-statement.					*)
+ 	function pgoto;
+ 
+ 	var	tp	: treeptr;
+ 
+ 	begin
+ 		nextsymbol([sinteger]);
+ 		tp := mknode(ngoto);
+ 		tp^.tlabel := oldlbl(false);
+ 		nextsymbol([ssemic, send, suntil, selse]);
+ 		pgoto := tp
+ 	end;
+ 
+ 	(*	Parse a begin-statement.				*)
+ 	function pbegin;
+ 
+ 	var	tp,
+ 		tq	: treeptr;
+ 
+ 	begin
+ 		tq := nil;
+ 		repeat
+ 			if tq = nil then
+ 			    begin
+ 				tq := plabstmt;
+ 				tp := tq
+ 			    end
+ 			else begin
+ 				tq^.tnext := plabstmt;
+ 				tq := tq^.tnext
+ 			     end
+ 		until	currsym.st = send;
+ 		if retain then
+ 		    begin
+ 			tq := mknode(nbegin);
+ 			tq^.tbegin := tp;
+ 			tp := tq
+ 		    end;
+ 		nextsymbol([send, selse, suntil, sdot, ssemic]);
+ 		pbegin := tp
+ 	end;
+ 
+ begin	(* parse *)
+ 	nextsymbol([spgm, sconst, stype, svar, sproc, sfunc]);
+ 	if currsym.st = spgm then
+ 		top := pprogram
+ 	else
+ 		top := pmodule;
+ 	nextsymbol([seof]);
+ end;	(* parse *)
+ 
+ (*	Compute value for a node (which must be some kind of constant).	*)
+ function cvalof(tp : treeptr) : integer;
+ 
+ var	v	: integer;
+ 	tq	: treeptr;
+ 
+ begin
+ 	case tp^.tt of
+ 	  nuplus:
+ 		cvalof := cvalof(tp^.texps);
+ 	  numinus:
+ 		cvalof := - cvalof(tp^.texps);
+ 	  nnot:
+ 		cvalof := 1 - cvalof(tp^.texps);
+ 	  nid:
+ 	    begin
+ 		tq := idup(tp);
+ 		if tq = nil then
+ 			fatal(etree);
+ 		tp := tp^.tsym^.lsymdecl;
+ 		case tq^.tt of
+ 		  nscalar:
+ 		    begin
+ 			v := 0;
+ 			tq := tq^.tscalid;
+ 			while tq <> nil do
+ 				if tq = tp then
+ 					tq := nil
+ 				else begin
+ 					v := v + 1;
+ 					tq := tq^.tnext
+ 				     end;
+ 			cvalof := v
+ 		    end;
+ 		  nconst:
+ 			cvalof := cvalof(tq^.tbind);
+ 		end;(* case *)
+ 	    end;
+ 	  ninteger:
+ 		cvalof := tp^.tsym^.linum;
+ 	  nchar:
+ 		cvalof := ord(tp^.tsym^.lchar);
+ 	end (* case *)
+ end;	(* cvalof *)
+ 
+ (*	Compute lower value of subrange or scalar type.			*)
+ function clower(tp : treeptr) : integer;
+ 
+ var	tq	: treeptr;
+ 
+ begin
+ 	tq := typeof(tp);
+ 	if tq^.tt = nscalar then
+ 		clower := scalbase
+ 	else if tq^.tt = nsubrange then
+ 		if tq^.tup^.tt = nconfarr then
+ 			clower := 0
+ 		else
+ 			clower := cvalof(tq^.tlo)
+ 	else if tq = typnods[tchar] then
+ 		clower := 0
+ 	else if tq = typnods[tinteger] then
+ 		clower := -maxint
+ 	else
+ 		fatal(etree)
+ end;	(* clower *)
+ 
+ (*	Compute upper value of subrange or scalar type.			*)
+ function cupper(tp : treeptr) : integer;
+ 
+ var	tq	: treeptr;
+ 	i	: integer;
+ 
+ begin
+ 	tq := typeof(tp);
+ 	if tq^.tt = nscalar then
+ 	    begin
+ 		tq := tq^.tscalid;
+ 		i := scalbase;
+ 		while tq^.tnext <> nil do
+ 		    begin
+ 			i := i + 1;
+ 			tq := tq^.tnext
+ 		    end;
+ 		cupper := i
+ 	    end
+ 	else if tq^.tt = nsubrange then
+ 		if tq^.tup^.tt = nconfarr then
+ 			fatal(euprconf)
+ 		else
+ 			cupper := cvalof(tq^.thi)
+ 	else if tq = typnods[tchar] then
+ 		cupper := maxchar
+ 	else if tq = typnods[tinteger] then
+ 		cupper := maxint
+ 	else
+ 		fatal(etree)
+ end;	(* cupper *)
+ 
+ (*	Compute the number of elements in a subrange.			*)
+ function crange(tp : treeptr) : integer;
+ 
+ begin
+ 	crange := cupper(tp) - clower(tp) + 1
+ end;
+ 
+ (*	Return number of words uset to store a set.			*)
+ function csetwords(i : integer) : integer;
+ 
+ begin
+ 	i := (i+(setbits)) div (setbits+1);
+ 	if i > maxsetrange then
+ 		error(esetsize);
+ 	csetwords := i
+ end;
+ 
+ (*	Return number of words uset to store a set.			*)
+ function csetsize(tp : treeptr) : integer;
+ 
+ var	tq	: treeptr;
+ 	i	: integer;
+ 
+ begin
+ 	tq := typeof(tp^.tof);
+ 	i := clower(tq);
+ 	(* bits in sets are always numbered from 0, so we (arbitrarily)
+ 	   decide that the base must be in the first 6 words to avoid
+ 	   unnecessary waste of space *)
+ 	if (i < 0) or (i >= 6 * (setbits+1))  then
+ 		error(esetbase);
+ 	csetsize := csetwords(crange(tq)) + 1
+ end;
+ 
+ (*	Determine if tp is declared in the procedure it is used in.	*)
+ function islocal(tp : treeptr) : boolean;
+ 
+ var	tq	: treeptr;
+ 
+ begin
+ 	tq := tp^.tsym^.lsymdecl;
+ 	while not (tq^.tt in [nproc, nfunc, npgm]) do
+ 		tq := tq^.tup;
+ 	while not (tp^.tt in [nproc, nfunc, npgm]) do
+ 		tp := tp^.tup;
+ 	islocal := tp = tq
+ end;
+ 
+ (*	Perform necessary transformations on tree and identifiers	*)
+ (*	before generating code.						*)
+ procedure transform;
+ 
+ 
+ 	(*	Rename function when used as a variable.		*)
+ 	procedure renamf(tp : treeptr);
+ 
+ 	var	ip, iq	: symptr;
+ 		tq, tv	: treeptr;
+ 
+ 		(*	This procedure recursively descends the tree	*)
+ 		(*	and replaces function-assignments with variable	*)
+ 		(*	assignments.					*)
+ 		procedure crtnvar(tp : treeptr);
+ 
+ 		begin
+ 			while tp <> nil do
+ 			    begin
+ 				case tp^.tt of
+ 				  npgm:
+ 					crtnvar(tp^.tsubsub);
+ 				  nfunc,
+ 				  nproc:
+ 				    begin
+ 					crtnvar(tp^.tsubsub);
+ 					crtnvar(tp^.tsubstmt)
+ 				    end;
+ 				  nbegin:
+ 					crtnvar(tp^.tbegin);
+ 				  nif:
+ 				    begin
+ 					crtnvar(tp^.tthen);
+ 					crtnvar(tp^.telse)
+ 				    end;
+ 				  nwhile:
+ 					crtnvar(tp^.twhistmt);
+ 				  nrepeat:
+ 					crtnvar(tp^.treptstmt);
+ 				  nfor:
+ 					crtnvar(tp^.tforstmt);
+ 				  ncase:
+ 				    begin
+ 					crtnvar(tp^.tcaslst);
+ 					crtnvar(tp^.tcasother)
+ 				    end;
+ 				  nchoise:
+ 					crtnvar(tp^.tchostmt);
+ 				  nwith:
+ 					crtnvar(tp^.twithstmt);
+ 				  nlabstmt:
+ 					crtnvar(tp^.tstmt);
+ 				  nassign:
+ 				    begin
+ 					(* revoke calls in assignment lhs, (mis-
+ 					   parsed due to ambiguous syntax) *)
+ 					if tp^.tlhs^.tt = ncall then
+ 					    begin
+ 						tp^.tlhs := tp^.tlhs^.tcall;
+ 						tp^.tlhs^.tup := tp
+ 					    end;
+ 					(* function name -> variable name *)
+ 					tv := tp^.tlhs;
+ 					if tv^.tt = nid then
+ 						if tv^.tsym = ip then
+ 							tv^.tsym := iq
+ 				    end;
+ 				  nbreak,
+ 				  npush,
+ 				  npop,
+ 				  ngoto,
+ 				  nempty,
+ 				  ncall:
+ 					(* no op *)
+ 				end;(* case *)
+ 				tp := tp^.tnext
+ 			    end
+ 		end;
+ 
+ 	begin	(* renamf *)
+ 		while tp <> nil do
+ 		    begin
+ 			case tp^.tt of
+ 			  npgm,
+ 			  nproc:
+ 				renamf(tp^.tsubsub);
+ 			  nfunc:
+ 			    begin
+ 				(* create a variable to hold return value *)
+ 				tq := mknode(nvar);
+ 				tq^.tattr := aregister;
+ 				tq^.tup := tp;
+ 				tq^.tidl := newid(mkvariable('R'));
+ 				tq^.tidl^.tup := tq;
+ 				tq^.tbind := tp^.tfuntyp;
+ 				(* put it FIRST among variables, see esubr() *)
+ 				tq^.tnext := tp^.tsubvar;
+ 				tp^.tsubvar := tq;
+ 
+ 				iq := tq^.tidl^.tsym;
+ 				ip := tp^.tsubid^.tsym;
+ 				crtnvar(tp^.tsubsub);
+ 				crtnvar(tp^.tsubstmt);
+ 				(* process inner functions *)
+ 				renamf(tp^.tsubsub)
+ 			    end;
+ 			end;(* case *)
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* renamf *)
+ 
+ 	(*	This procedure rearranges the tree such that multiple	*)
+ 	(*	vardeclarations don't have (structured) types attached	*)
+ 	(*	to them. If such a declararation is found, a new name	*)
+ 	(*	is created and the type is moved to the type section.	*)
+ 	procedure extract(tp : treeptr);
+ 
+ 	var	vp	: treeptr;
+ 
+ 		(*	Create a declaration for tp, enter in pp type-	*)
+ 		(*	list and return an identifier referencing it.	*)
+ 		function xtrit(tp, pp : treeptr; last : boolean) : treeptr;
+ 
+ 		var	np, rp	: treeptr;
+ 			ip	: idptr;
+ 
+ 		begin
+ 			(* create new declaration *)
+ 			np := mknode(ntype);
+ 			ip := mkvariable('T');
+ 			np^.tidl := newid(ip);
+ 			np^.tidl^.tup := np;
+ 
+ 			(* create substitute id *)
+ 			rp := oldid(ip, lidentifier);
+ 			rp^.tup := tp^.tup;
+ 			rp^.tnext := tp^.tnext;
+ 
+ 			(* steal type description *)
+ 			np^.tbind := tp;
+ 			tp^.tup := np;
+ 			tp^.tnext := nil;
+ 
+ 			(* add new declaration to tree *)
+ 			np^.tup := pp;
+ 			if last and (pp^.tsubtype <> nil) then
+ 			    begin
+ 				pp := pp^.tsubtype;
+ 				while pp^.tnext <> nil do
+ 					pp := pp^.tnext;
+ 				pp^.tnext := np
+ 			    end
+ 			else begin
+ 				np^.tnext := pp^.tsubtype;
+ 				pp^.tsubtype := np;
+ 			    end;
+ 
+ 			xtrit := rp;
+ 		end;
+ 
+ 		(*	Extract anonymous enumeration types.		*)
+ 		function xtrenum(tp, pp : treeptr) : treeptr;
+ 
+ 			(*	Name record-types referenced by ptrs.	*)
+ 			procedure nametype(tp : treeptr);
+ 
+ 			begin
+ 				tp := typeof(tp);
+ 				if tp^.tt = nrecord then
+ 					if tp^.tuid = nil then
+ 						tp^.tuid := mkvariable('S');
+ 			end;
+ 
+ 		begin
+ 			if tp <> nil then
+ 			    begin
+ 				case tp^.tt of
+ 				  nfield,
+ 				  ntype,
+ 				  nvar:
+ 					tp^.tbind :=
+ 						xtrenum(tp^.tbind, pp);
+ 
+ 				  nscalar:
+ 					if tp^.tup^.tt <> ntype then
+ 					    tp := xtrit(tp, pp, false);
+ 
+ 				  narray:
+ 				    begin
+ 					tp^.taindx := xtrenum(tp^.taindx, pp);
+ 					tp^.taelem := xtrenum(tp^.taelem, pp);
+ 				    end;
+ 				  nrecord:
+ 				    begin
+ 					tp^.tflist := xtrenum(tp^.tflist, pp);
+ 					tp^.tvlist := xtrenum(tp^.tvlist, pp);
+ 				    end;
+ 				  nvariant:
+ 					tp^.tvrnt := xtrenum(tp^.tvrnt, pp);
+ 				  nfileof:
+ 					tp^.tof := xtrenum(tp^.tof, pp);
+ 
+ 				  nptr:
+ 					nametype(tp^.tptrid);
+ 
+ 				  nid,
+ 				  nsubrange,
+ 				  npredef,
+ 				  nempty,
+ 				  nsetof:
+ 					(* no op *)
+ 				end;(* case *)
+ 				tp^.tnext := xtrenum(tp^.tnext, pp)
+ 			    end;
+ 			xtrenum := tp
+ 		end;
+ 
+ 	begin	(* extract *)
+ 		while tp <> nil do
+ 		    begin
+ 			(* tp points to a program/procedure/function node *)
+ 			tp^.tsubtype := xtrenum(tp^.tsubtype, tp);
+ 			tp^.tsubvar := xtrenum(tp^.tsubvar, tp);
+ 			vp := tp^.tsubvar;
+ 			while vp <> nil do
+ 			    begin
+ 				(* variables of structured unnamed types *)
+ 				if vp^.tbind^.tt in [nscalar, narray,
+ 							nrecord, nfileof] then
+ 					vp^.tbind := xtrit(vp^.tbind, tp, true);
+ 				vp := vp^.tnext
+ 			    end;
+ 			extract(tp^.tsubsub);
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* extract *)
+ 
+ 	(*	This procedure moves all local constants and types	*)
+ 	(*	used in nested procedures to the outermost declaration	*)
+ 	(*	level so that nested procedures may be extracted.	*)
+ 	procedure global(tp, dp : treeptr; depend : boolean);
+ 
+ 	label	555;
+ 
+ 	var	ip	: treeptr;
+ 		dep	: boolean;
+ 
+ 		(*	Mark all declared identifiers as unused.	*)
+ 		procedure markdecl(xp : treeptr);
+ 
+ 		begin
+ 			while xp <> nil do
+ 			    begin
+ 				case xp^.tt of
+ 				  nid:
+ 					xp^.tsym^.lused := false;
+ 				  nconst:
+ 					markdecl(xp^.tidl);
+ 				  ntype,
+ 				  nvar,
+ 				  nvalpar,
+ 				  nvarpar,
+ 				  nfield:
+ 				    begin
+ 					markdecl(xp^.tidl);
+ 					if xp^.tbind^.tt <> nid then
+ 						markdecl(xp^.tbind)
+ 				    end;
+ 				  nscalar:
+ 					markdecl(xp^.tscalid);
+ 				  nrecord:
+ 				    begin
+ 					markdecl(xp^.tflist);
+ 					markdecl(xp^.tvlist)
+ 				    end;
+ 				  nvariant:
+ 					markdecl(xp^.tvrnt);
+ 				  nconfarr:
+ 					if xp^.tcelem^.tt <> nid then
+ 						markdecl(xp^.tcelem);
+ 				  narray:
+ 					if xp^.taelem^.tt <> nid then
+ 						markdecl(xp^.taelem);
+ 				  nsetof,
+ 				  nfileof:
+ 					if xp^.tof^.tt <> nid then
+ 						markdecl(xp^.tof);
+ 				  nparproc,
+ 				  nparfunc:
+ 					markdecl(xp^.tparid);
+ 				  nptr,
+ 				  nsubrange:
+ 					(* no op *)
+ 				end;(* case *)
+ 				xp := xp^.tnext
+ 			    end
+ 		end;	(* markdecl *)
+ 
+ 		(*	Move all marked declarations to global scope.	*)
+ 		function movedecl(tp : treeptr) : treeptr;
+ 
+ 		var	ip, np	: treeptr;
+ 			sp	: symptr;
+ 			move	: boolean;
+ 
+ 		begin
+ 			if tp <> nil then
+ 			    begin
+ 				move := false;
+ 				case tp^.tt of
+ 				  nconst,
+ 				  ntype:
+ 					ip := tp^.tidl
+ 				end;(* case *)
+ 				while ip <> nil do
+ 				    begin
+ 					if ip^.tsym^.lused then
+ 					    begin
+ 						move := true;
+ 						sp := ip^.tsym;
+ 						if sp^.lid^.inref > 1 then
+ 						  begin
+ 						    sp^.lid :=
+ 							mkrename( 'M', sp^.lid);
+ 						    sp^.lid^.inref :=
+ 							    sp^.lid^.inref - 1
+ 						  end;
+ 						ip := nil
+ 					    end
+ 					else
+ 						ip := ip^.tnext
+ 				    end;
+ 				if move then
+ 				    begin
+ 					np := tp^.tnext;
+ 					tp^.tnext := nil;
+ 					ip := tp;
+ 					while ip^.tt <> npgm do
+ 						ip := ip^.tup;
+ 					tp^.tup := ip;
+ 					case tp^.tt of
+ 					  nconst:
+ 					    begin
+ 						if ip^.tsubconst = nil then
+ 							ip^.tsubconst := tp
+ 						else begin
+ 							ip := ip^.tsubconst;
+ 							while ip^.tnext <> nil
+ 							    do ip := ip^.tnext;
+ 							ip^.tnext := tp
+ 						     end
+ 					    end;
+ 					  ntype:
+ 					    begin
+ 						if ip^.tsubtype = nil then
+ 							ip^.tsubtype := tp
+ 						else begin
+ 							ip := ip^.tsubtype;
+ 							while ip^.tnext <> nil
+ 							    do ip := ip^.tnext;
+ 							ip^.tnext := tp
+ 						     end
+ 					    end
+ 					end;(* case *)
+ 					(* tp is moved, drop it and process
+ 					   remainder of declarationlist *)
+ 					tp := movedecl(np)
+ 				    end
+ 				else
+ 					tp^.tnext := movedecl(tp^.tnext)
+ 			    end;
+ 			movedecl := tp
+ 		end;	(* movedecl *)
+ 
+ 		(*	This procedure lifts out variables/parameters	*)
+ 		(*	used in nested procedures/functions.		*)
+ 		procedure movevars(tp, vp : treeptr);
+ 
+ 		label	555;
+ 
+ 		var	ep, dp, np	: treeptr;
+ 			ip		: idptr;
+ 			sp		: symptr;
+ 
+ 			(*	Move a variable	declaration to global	*)
+ 			(*	var declaration lists.			*)
+ 			procedure moveglob(tp, dp : treeptr);
+ 
+ 			begin
+ 				while tp^.tt <> npgm do
+ 					tp := tp^.tup;
+ 				dp^.tup := tp;
+ 				dp^.tnext := tp^.tsubvar;
+ 				tp^.tsubvar := dp
+ 			end;
+ 
+ 			(*	Create nodes for saving a global	*)
+ 			(*	pointer variable.			*)
+ 			function stackop(decl, glob, loc : treeptr) : treeptr;
+ 
+ 			var	op, ip, dp, tp	: treeptr;
+ 
+ 			begin
+ 				(* create a new variable to hold old value
+ 				   of the global variable during a call *)
+ 				ip := newid(mkvariable('F'));
+ 				case vp^.tt of
+ 				  nvarpar,
+ 				  nvalpar,
+ 				  nvar:
+ 				    begin
+ 					dp := mknode(nvarpar);
+ 					dp^.tattr := areference;
+ 					dp^.tidl := ip;
+ 					(* use same type as the global var *)
+ 					dp^.tbind := decl^.tbind
+ 				    end;
+ 				  nparproc,
+ 				  nparfunc:
+ 				    begin
+ 					dp := mknode(vp^.tt);
+ 					dp^.tparid := ip;
+ 					dp^.tparparm := nil;
+ 					dp^.tpartyp := vp^.tpartyp
+ 				    end
+ 				end;(* case *)
+ 				ip^.tup := dp;
+ 
+ 				(* add variable to declarationlists *)
+ 				tp := decl;
+ 				while not (tp^.tt in [nproc, nfunc, npgm]) do
+ 					tp := tp^.tup;
+ 				dp^.tup := tp;
+ 				if tp^.tsubvar = nil then
+ 					tp^.tsubvar := dp
+ 				else begin
+ 					tp := tp^.tsubvar;
+ 					while tp^.tnext <> nil do
+ 						tp := tp^.tnext;
+ 					tp^.tnext := dp
+ 				     end;
+ 				dp^.tnext := nil;
+ 
+ 				(* create an assignment saving value *)
+ 				op := mknode(npush);
+ 				op^.tglob := glob;
+ 				op^.tloc := loc;
+ 				op^.ttmp := ip;
+ 				stackop := op
+ 			end;
+ 
+ 			(*	Take a "push" node, create "pop" node	*)
+ 			(*	and add both to tree.			*)
+ 			procedure addcode(tp, push : treeptr);
+ 
+ 			var	pop	: treeptr;
+ 
+ 			begin
+ 				pop := mknode(npop);
+ 				(* share variables with "push"-node *)
+ 				pop^.tglob := push^.tglob;
+ 				pop^.ttmp := push^.ttmp;
+ 				pop^.tloc := nil;
+ 
+ 				(* add npush to head of statement list *)
+ 				push^.tnext := tp^.tsubstmt;
+ 				tp^.tsubstmt := push;
+ 				push^.tup := tp;
+ 
+ 				(* add npop to end of statement list *)
+ 				while push^.tnext <> nil do
+ 					push := push^.tnext;
+ 				push^.tnext := pop;
+ 				pop^.tup := tp
+ 			end;
+ 
+ 		begin	(* movevars *)
+ 			while vp <> nil do
+ 			    begin
+ 				case vp^.tt of
+ 				  nvar,
+ 				  nvalpar,
+ 				  nvarpar:
+ 					dp := vp^.tidl;
+ 				  nparproc,
+ 				  nparfunc:
+ 				    begin
+ 					dp := vp^.tparid;
+ 					if dp^.tsym^.lused then
+ 					    begin
+ 						(* create a var declaration *)
+ 						ep := mknode(vp^.tt);
+ 						ep^.tparparm := nil;
+ 						ep^.tpartyp := vp^.tpartyp;
+ 						np := newid(mkrename('G',
+ 								dp^.tsym^.lid));
+ 						ep^.tparid := np;
+ 						np^.tup := ep;
+ 						(* swap id's and symbols *)
+ 						sp := np^.tsym;
+ 						ip := sp^.lid;
+ 						np^.tsym^.lid := dp^.tsym^.lid;
+ 						dp^.tsym^.lid := ip;
+ 						np^.tsym := dp^.tsym;
+ 						dp^.tsym := sp;
+ 						np^.tsym^.lsymdecl := np;
+ 						dp^.tsym^.lsymdecl := dp;
+ 						(* make declaration global *)
+ 						moveglob(tp, ep);
+ 						(* add save/restore-code *)
+ 						addcode(tp, stackop(vp, np, dp))
+ 					    end;
+ 					goto 555
+ 				    end
+ 				end;(* case *)
+ 				while dp <> nil do
+ 				    begin
+ 					if dp^.tsym^.lused then
+ 					    begin
+ 						(* create a varpar declaration,
+ 						   (nvarpar will cause emit to
+ 						   treat the new identifier
+ 						   as a pointer) *)
+ 						ep := mknode(nvarpar);
+ 						ep^.tattr := areference;
+ 						np := newid(mkrename('G',
+ 								dp^.tsym^.lid));
+ 						ep^.tidl := np;
+ 						np^.tup := ep;
+ 						ep^.tbind := vp^.tbind;
+ 						if ep^.tbind^.tt = nid then
+ 							ep^.tbind^.tsym^.lused
+ 								:= true;
+ 						(* swap id's and symbols *)
+ 						sp := np^.tsym;
+ 						ip := sp^.lid;
+ 						np^.tsym^.lid := dp^.tsym^.lid;
+ 						dp^.tsym^.lid := ip;
+ 						np^.tsym := dp^.tsym;
+ 						dp^.tsym := sp;
+ 						np^.tsym^.lsymdecl := np;
+ 						dp^.tsym^.lsymdecl := dp;
+ 						(* note that dp is referenced *)
+ 						dp^.tup^.tattr := aextern;
+ 						(* make declaration global *)
+ 						moveglob(tp, ep);
+ 						(* add save/restore-code *)
+ 						addcode(tp, stackop(vp, np, dp))
+ 					    end;
+ 					dp := dp^.tnext
+ 				    end;
+ 			555:
+ 				vp := vp^.tnext
+ 			    end
+ 		end;	(* movevars *)
+ 
+ 		(*	Break out a local variable and set the register	*)
+ 		(*	attribute.					*)
+ 		procedure registervar(tp : treeptr);
+ 
+ 		var	vp, xp	: treeptr;
+ 
+ 		begin
+ 			vp := idup(tp);
+ 			tp := tp^.tsym^.lsymdecl;
+ 			(* vp points to nvar node *)
+ 			if (vp^.tidl <> tp) or (tp^.tnext <> nil) then
+ 			    begin
+ 				(* tp is not alone in list of identifiers,
+ 				   create a new nvar-node and hook up tp *)
+ 				xp := mknode(nvar);
+ 				xp^.tattr := anone;
+ 				xp^.tidl := tp;
+ 				tp^.tup := xp;
+ 				(* enter new nvar node among declarations *)
+ 				xp^.tup := vp^.tup;
+ 				xp^.tbind := vp^.tbind; (* borrow type *)
+ 				xp^.tnext := vp^.tnext;
+ 				vp^.tnext := xp;
+ 				(* break tp out of list of identifiers *)
+ 				if vp^.tidl = tp then
+ 					vp^.tidl := tp^.tnext
+ 				else begin
+ 					vp := vp^.tidl;
+ 					while vp^.tnext <> tp do
+ 						vp := vp^.tnext;
+ 					vp^.tnext := tp^.tnext
+ 				     end;
+ 				tp^.tnext := nil
+ 			    end;
+ 			(* tp is alone in this declaration, set attribute *)
+ 			if tp^.tup^.tattr = anone then
+ 				tp^.tup^.tattr := aregister
+ 		end;	(* registervar *)
+ 
+ 		(*	Check static declarationlevel for a label	*)
+ 		(*	used in a non-local goto.			*)
+ 		procedure cklevel(tp : treeptr);
+ 
+ 		begin
+ 			tp := tp^.tsym^.lsymdecl;
+ 			while not(tp^.tt in [npgm, nproc, nfunc]) do
+ 				tp := tp^.tup;
+ 			if tp^.tstat > maxlevel then
+ 				maxlevel := tp^.tstat
+ 		end;
+ 
+ 	begin	(* global *)
+ 		while tp <> nil do
+ 		    begin
+ 			case tp^.tt of
+ 			  nproc,
+ 			  nfunc:
+ 			    begin
+ 				(* procid/parameters/const/type/var not used *)
+ 				markdecl(tp^.tsubid);
+ 				markdecl(tp^.tsubpar);
+ 				markdecl(tp^.tsubconst);
+ 				markdecl(tp^.tsubtype);
+ 				markdecl(tp^.tsubvar);
+ 
+ 				(* mark those used in nested subroutines *)
+ 				global(tp^.tsubsub, tp, false);
+ 
+ 				(* move out variables used in inner scope *)
+ 				movevars(tp, tp^.tsubpar);
+ 				movevars(tp, tp^.tsubvar);
+ 				(* move out const/type used in inner scope *)
+ 				tp^.tsubtype := movedecl(tp^.tsubtype);
+ 				tp^.tsubconst := movedecl(tp^.tsubconst);
+ 
+ 				(* mark identifiers used in this subroutine *)
+ 				global(tp^.tsubstmt, tp, true);
+ 				global(tp^.tsubpar, tp, false);
+ 				global(tp^.tsubvar, tp, false);
+ 				global(tp^.tsubtype, tp, false);
+ 				global(tp^.tfuntyp, tp, false);
+ 			    end;
+ 
+ 			  npgm:
+ 			    begin
+ 				markdecl(tp^.tsubconst);
+ 				markdecl(tp^.tsubtype);
+ 				markdecl(tp^.tsubvar);
+ 				global(tp^.tsubsub, tp, false);
+ 				global(tp^.tsubstmt, tp, true)
+ 			    end;
+ 
+ 			  nconst,
+ 			  ntype,
+ 			  nvar,
+ 			  nfield,
+ 			  nvalpar,
+ 			  nvarpar:
+ 			    begin
+ 				ip := tp^.tidl;
+ 				dep := depend;
+ 				while (ip <> nil) and not dep do
+ 				    begin
+ 					(* for all used identifiers, propagate
+ 					   the use to their bindings *)
+ 					if ip^.tsym^.lused then
+ 						dep := true;
+ 					ip := ip^.tnext
+ 				    end;
+ 				global(tp^.tbind, dp, dep);
+ 			    end;
+ 			  nparproc,
+ 			  nparfunc:
+ 			    begin
+ 				global(tp^.tparparm, dp, depend);
+ 				global(tp^.tpartyp, dp, depend)
+ 			    end;
+ 			  nsubrange:
+ 			    begin
+ 				global(tp^.tlo, dp, depend);
+ 				global(tp^.thi, dp, depend)
+ 			    end;
+ 			  nvariant:
+ 			    begin
+ 				global(tp^.tselct, dp, depend);
+ 				global(tp^.tvrnt, dp, depend)
+ 			    end;
+ 			  nrecord:
+ 			    begin
+ 				global(tp^.tflist, dp, depend);
+ 				global(tp^.tvlist, dp, depend)
+ 			    end;
+ 			  nconfarr:
+ 			    begin
+ 				global(tp^.tcindx, dp, depend);
+ 				global(tp^.tcelem, dp, depend)
+ 			    end;
+ 			  narray:
+ 			    begin
+ 				global(tp^.taindx, dp, depend);
+ 				global(tp^.taelem, dp, depend)
+ 			    end;
+ 			  nfileof,
+ 			  nsetof:
+ 				global(tp^.tof, dp, depend);
+ 			  nptr:
+ 				global(tp^.tptrid, dp, depend);
+ 			  nscalar:
+ 				global(tp^.tscalid, dp, depend);
+ 			  nbegin:
+ 				global(tp^.tbegin, dp, depend);
+ 			  nif:
+ 			    begin
+ 				global(tp^.tifxp, dp, depend);
+ 				global(tp^.tthen, dp, depend);
+ 				global(tp^.telse, dp, depend)
+ 			    end;
+ 			  nwhile:
+ 			    begin
+ 				global(tp^.twhixp, dp, depend);
+ 				global(tp^.twhistmt, dp, depend)
+ 			    end;
+ 			  nrepeat:
+ 			    begin
+ 				global(tp^.treptstmt, dp, depend);
+ 				global(tp^.treptxp, dp, depend)
+ 			    end;
+ 			  nfor:
+ 			    begin
+ 				ip := idup(tp^.tforid);
+ 				if ip^.tup^.tt in [nproc, nfunc] then
+ 					registervar(tp^.tforid);
+ 				global(tp^.tforid, dp, depend);
+ 				global(tp^.tfrom, dp, depend);
+ 				global(tp^.tto, dp, depend);
+ 				global(tp^.tforstmt, dp, depend)
+ 			    end;
+ 			  ncase:
+ 			    begin
+ 				global(tp^.tcasxp, dp, depend);
+ 				global(tp^.tcaslst, dp, depend);
+ 				global(tp^.tcasother, dp, depend)
+ 			    end;
+ 			  nchoise:
+ 			    begin
+ 				global(tp^.tchocon, dp, depend);
+ 				global(tp^.tchostmt, dp, depend);
+ 			    end;
+ 			  nwith:
+ 			    begin
+ 				global(tp^.twithvar, dp, depend);
+ 				global(tp^.twithstmt, dp, depend)
+ 			    end;
+ 			  nwithvar:
+ 			    begin
+ 				ip := typeof(tp^.texpw);
+ 				if ip^.tuid = nil then
+ 					ip^.tuid := mkvariable('S');
+ 				global(tp^.texpw, dp, depend);
+ 			    end;
+ 			  nlabstmt:
+ 				global(tp^.tstmt, dp, depend);
+ 			  neq, nne, nlt, nle, ngt, nge:
+ 			    begin
+ 				global(tp^.texpl, dp, depend);
+ 				global(tp^.texpr, dp, depend);
+ 				ip := typeof(tp^.texpl);
+ 				if (ip = typnods[tstring]) or
+ 							(ip^.tt = narray) then
+ 					usecomp := true;
+ 				ip := typeof(tp^.texpr);
+ 				if (ip = typnods[tstring]) or
+ 							(ip^.tt = narray) then
+ 					usecomp := true
+ 			    end;
+ 			  nin, nor, nplus, nminus,
+ 			  nand, nmul, ndiv, nmod, nquot,
+ 			  nformat, nrange:
+ 			    begin
+ 				global(tp^.texpl, dp, depend);
+ 				global(tp^.texpr, dp, depend)
+ 			    end;
+ 
+ 			  nassign:
+ 			    begin
+ 				global(tp^.tlhs, dp, depend);
+ 				global(tp^.trhs, dp, depend)
+ 			    end;
+ 
+ 			  nnot,
+ 			  numinus,
+ 			  nuplus,
+ 			  nderef:
+ 				global(tp^.texps, dp, depend);
+ 			  nset:
+ 				global(tp^.texps, dp, depend);
+ 			  nindex:
+ 			    begin
+ 				global(tp^.tvariable, dp, depend);
+ 				global(tp^.toffset, dp, depend)
+ 			    end;
+ 			  nselect:
+ 				global(tp^.trecord, dp, depend);
+ 			  ncall:
+ 			    begin
+ 				global(tp^.tcall, dp, depend);
+ 				global(tp^.taparm, dp, depend)
+ 			    end;
+ 			  nid:
+ 			    begin
+ 				(* find declaration point *)
+ 				ip := idup(tp);
+ 				if ip = nil then
+ 					goto 555;
+ 				(* ip points to nconst/ntype/nvar/nproc/nfunc/
+ 				   nvalpar/nvarpar/nparproc or nparfunc node,
+ 				   move to beginning of enclosing scope *)
+ 				repeat
+ 					ip := ip^.tup;
+ 					if ip = nil then
+ 						goto 555
+ 					(* stop only for locally declared items,
+ 					   for global or predefined identifiers
+ 					   we will have gone to label 555 *)
+ 				until	ip^.tt in [npgm, nproc, nfunc];
+ 				if dp = ip then
+ 				    begin
+ 					(* identifier used here, mark it used *)
+ 					if depend then
+ 						tp^.tsym^.lused := true
+ 				    end
+ 				else begin
+ 					(* identifier declared in enclosing
+ 					   scope, mark it used *)
+ 					tp^.tsym^.lused := true
+ 				     end;
+ 			555:
+ 			    end;
+ 			  ngoto:
+ 				if not islocal(tp^.tlabel) then
+ 				    begin
+ 					tp^.tlabel^.tsym^.lgo := true;
+ 					usejmps := true;
+ 					cklevel(tp^.tlabel)
+ 				    end;
+ 
+ 			  nbreak,
+ 			  npush,
+ 			  npop,
+ 			  npredef,
+ 			  nempty,
+ 			  nchar,
+ 			  ninteger,
+ 			  nreal,
+ 			  nstring,
+ 			  nnil:
+ 			end;(* case *)
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* global *)
+ 
+ 	(*	Rename identifiers identical to C keywords.		*)
+ 	procedure renamc;
+ 
+ 	var	ip	: idptr;
+ 		cn	: cnames;
+ 
+ 	begin
+ 		(* rename identifiers that mustn't be redefined
+ 		   if C and Pascal semantix are to be preserved *)
+ 		for cn := cabort to cwrite do
+ 		    begin
+ 			ip := mkrename('C', ctable[cn]);
+ 			ctable[cn]^.istr := ip^.istr
+ 		    end
+ 	end;
+ 
+ 	(*	Rename subroutines declared in other subroutines such	*)
+ 	(*	that they can be moved to a global scope without name-	*)
+ 	(*	clashes.						*)
+ 	procedure renamp(tp : treeptr; on : boolean);
+ 
+ 	var	sp	: symptr;
+ 
+ 	begin
+ 		(* tp points to subroutine-list *)
+ 		while tp <> nil do
+ 		    begin
+ 			renamp(tp^.tsubsub, true);
+ 			if on and (tp^.tsubstmt <> nil) then
+ 			    begin
+ 				(* change name of subroutine by prefixing
+ 				   a unique name *)
+ 				sp := tp^.tsubid^.tsym;
+ 				if sp^.lid^.inref > 1 then
+ 				    begin
+ 					sp^.lid := mkrename('P', sp^.lid);
+ 					sp^.lid^.inref := sp^.lid^.inref - 1
+ 				    end
+ 			    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;
+ 
+ 	(*	Add initialization-code for file-variables.		*)
+ 	procedure initcode(tp : treeptr);
+ 
+ 	var	ti, tq, tu, tv	: treeptr;
+ 
+ 		(*	Determine if a type contains a file.		*)
+ 		function filevar(tp : treeptr) : boolean;
+ 
+ 		var	fv	: boolean;
+ 			tq	: treeptr;
+ 
+ 		begin
+ 			case tp^.tt of
+ 			  npredef:
+ 				fv := tp = typnods[ttext];
+ 			  nfileof:
+ 				fv := true;
+ 			  nconfarr:
+ 				fv := filevar(typeof(tp^.tcelem));
+ 			  narray:
+ 				fv := filevar(typeof(tp^.taelem));
+ 			  nrecord:
+ 			    begin
+ 				fv := false;
+ 				tq := tp^.tvlist;
+ 				while tq <> nil do
+ 				    begin
+ 					if filevar(tq^.tvrnt) then
+ 						error(evrntfile);
+ 					tq := tq^.tnext
+ 				    end;
+ 				tq := tp^.tflist;
+ 				while tq <> nil do
+ 				    begin
+ 					if filevar(typeof(tq^.tbind)) then
+ 					    begin
+ 						fv := true;
+ 						tq := nil
+ 					    end
+ 					else
+ 						tq := tq^.tnext
+ 				    end
+ 			    end;
+ 			  nptr:
+ 			    begin
+ 				fv := false;
+ 				if not tp^.tptrflag then
+ 				    begin
+ 					tp^.tptrflag := true;
+ 					if filevar(typeof(tp^.tptrid)) then
+ 						error(evarfile);
+ 					tp^.tptrflag := false
+ 				    end
+ 			    end;
+ 			  nsubrange,
+ 			  nscalar,
+ 			  nsetof:
+ 				fv := false
+ 			end;
+ 			filevar := fv
+ 		end;
+ 
+ 		(*	Create code for initialization of files.	*)
+ 		function fileinit(ti, tq : treeptr; opn : boolean) : treeptr;
+ 
+ 		var	tx, ty, tz	: treeptr;
+ 
+ 		begin
+ 			(* create 1 statement initializing "ti" *)
+ 			case tq^.tt of
+ 			  narray:
+ 			    begin
+ 				(* create declaration for a loopvariable *)
+ 				tz := newid(mkvariable('I'));
+ 				ty := mknode(nvar);
+ 				ty^.tattr := aregister;
+ 				ty^.tidl := tz;
+ 				ty^.tbind := typeof(tq^.taindx);
+ 				tz := tq;
+ 				while not(tz^.tt in [nproc, nfunc, npgm]) do
+ 					tz := tz^.tup;
+ 				linkup(tz, ty);
+ 				if tz^.tsubvar = nil then
+ 					tz^.tsubvar := ty
+ 				else begin
+ 					tz := tz^.tsubvar;
+ 					while tz^.tnext <> nil do
+ 						tz := tz^.tnext;
+ 					tz^.tnext := ty
+ 				     end;
+ 				ty := ty^.tidl;
+ 				(* create a loop initializing tq *)
+ 				tz := mknode(nindex);
+ 				tz^.tvariable := ti;
+ 				tz^.toffset := ty;
+ 				tz := fileinit(tz, tq^.taelem, opn);
+ 				tx := mknode(nfor);
+ 				tx^.tforid := ty;
+ 				ty := typeof(tq^.taindx);
+ 				if ty^.tt = nsubrange then
+ 				    begin
+ 					tx^.tfrom := ty^.tlo;
+ 
+ 					tx^.tto := ty^.thi
+ 				    end
+ 				else if ty^.tt = nscalar then
+ 				    begin
+ 					ty := ty^.tscalid;
+ 					tx^.tfrom := ty;
+ 					while ty^.tnext <> nil do
+ 						ty := ty^.tnext;
+ 					tx^.tto := ty
+ 				    end
+ 				else if ty = typnods[tchar] then
+ 				    begin
+ 					currsym.st := schar;
+ 					currsym.vchr := chr(minchar);
+ 					tx^.tfrom := mklit;
+ 					currsym.st := schar;
+ 					currsym.vchr := chr(maxchar);
+ 					tx^.tto := mklit
+ 				    end
+ 				else if ty = typnods[tinteger] then
+ 				    begin
+ 					currsym.st := sinteger;
+ 					currsym.vint := -maxint;
+ 					tx^.tfrom := mklit;
+ 					currsym.st := sinteger;
+ 					currsym.vint := maxint;
+ 					tx^.tto := mklit
+ 				    end
+ 				else
+ 					fatal(etree);
+ 				tx^.tforstmt := tz;
+ 				tx^.tincr := true
+ 			    end;
+ 			  npredef,
+ 			  nfileof:
+ 				if opn then
+ 				    begin
+ 					(* create file-struct initialization *)
+ 					ty := mknode(nselect);
+ 					ty^.trecord := ti;
+ 					ty^.tfield :=
+ 						oldid(defnams[dzinit]^.lid,
+ 								lforward);
+ 					tx := mknode(nassign);
+ 					tx^.tlhs := ty;
+ 					currsym.st := sinteger;
+ 					currsym.vint := 0;
+ 					tx^.trhs := mklit
+ 				    end
+ 				else begin
+ 					(* create file-struct wrapup *)
+ 					tx := mknode(ncall);
+ 					tx^.tcall := 
+ 						oldid(defnams[dclose]^.lid,
+ 								lidentifier);
+ 					tx^.taparm := ti
+ 				     end;
+ 			  nrecord:
+ 			    begin
+ 				ty := nil;
+ 				tq := tq^.tflist;
+ 				while tq <> nil do
+ 				    begin
+ 					if filevar(typeof(tq^.tbind)) then
+ 					    begin
+ 						tz := tq^.tidl;
+ 						while tz <> nil do
+ 						    begin
+ 							tx := mknode(nselect);
+ 							tx^.trecord := ti;
+ 							tx^.tfield := tz;
+ 							tx := fileinit(tx,
+ 							    typeof(tq^.tbind),
+ 								opn);
+ 							tx^.tnext := ty;
+ 							ty := tx;
+ 							tz := tz^.tnext
+ 						    end
+ 					    end;
+ 					tq := tq^.tnext
+ 				    end;
+ 				tx := mknode(nbegin);
+ 				tx^.tbegin := ty
+ 			    end;
+ 			end;(* case *)
+ 			fileinit := tx
+ 		end;
+ 
+ 	begin	(* initcode *)
+ 		while tp <> nil do
+ 		    begin
+ 			initcode(tp^.tsubsub);
+ 			tv := tp^.tsubvar;
+ 			while tv <> nil do
+ 			    begin
+ 				tq := typeof(tv^.tbind);
+ 				if filevar(tq) then
+ 				    begin
+ 					ti := tv^.tidl;
+ 					while ti <> nil do
+ 					    begin
+ 						tu := fileinit(ti, tq, true);
+ 						linkup(tp, tu);
+ 						tu^.tnext := tp^.tsubstmt;
+ 						tp^.tsubstmt := tu;
+ 						while tu^.tnext <> nil do
+ 							tu := tu^.tnext;
+ 						tu^.tnext := fileinit(ti, tq,
+ 									false);
+ 						linkup(tp, tu^.tnext);
+ 						ti := ti^.tnext
+ 					    end
+ 				    end;
+ 				tv := tv^.tnext;
+ 			    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* initcode *)
+ 
+ begin	(* transform *)
+ 	renamc;
+ 	renamp(top^.tsubsub, false);
+ 	extract(top);
+ 	renamf(top);
+ 	initcode(top^.tsubsub);
+ 	global(top, top, false)
+ end;	(* transform *)
+ 
+ (*	Emit C-code for program or module.				*)
+ procedure emit;
+ 
+ const	include	= '# include ';
+ 	define	= '# define ';
+ 	ifdef	= '# ifdef ';
+ 	ifndef	= '# ifndef ';
+ 	elsif	= '# else';
+ 	endif	= '# endif';
+ 	static	= 'static ';
+ 	xtern	= 'extern ';
+ 	typdef	= 'typedef ';
+ 	registr	= 'register ';
+ 	usigned	= 'unsigned ';
+ 	indstep	= 8;
+ 
+ var	conflag,
+ 	setused,
+ 	dropset,
+ 	donearr	: boolean;
+ 	doarrow,
+ 	indnt	: integer;
+ 
+ 	procedure increment;
+ 	begin
+ 		indnt := indnt + indstep
+ 	end;
+ 
+ 	procedure decrement;
+ 	begin
+ 		indnt := indnt - indstep
+ 	end;
+ 
+ 	(*	Write tabs/blanks to properly (?) indent C-code.	*) 
+ 	procedure indent;
+ 
+ 	var	i	: integer;
+ 
+ 	begin
+ 		i := indnt;
+ 		(* limit indent to an integral number of tabs *)
+ 		if i > 60 then
+ 			i := i div tabwidth * tabwidth;
+ 		while i >= tabwidth do
+ 		    begin
+ 			write(tab1);
+ 			i := i - tabwidth
+ 		    end;
+ 		while i > 0 do
+ 		    begin
+ 			write(space);
+ 			i := i - 1
+ 		    end;
+ 	end;
+ 
+ 	(*	Determine if tp must be cast to an integer before being	*)
+ 	(*	used in an arithmetic expression.			*)
+ 	function arithexpr(tp : treeptr) : boolean;
+ 
+ 	begin
+ 		tp := typeof(tp);
+ 		if tp^.tt = nsubrange then
+ 			if tp^.tup^.tt = nconfarr then
+ 				tp := typeof(tp^.tup^.tindtyp)
+ 			else
+ 				tp := typeof(tp^.tlo);
+ 		arithexpr := (tp = typnods[tinteger]) or
+ 				(tp = typnods[tchar]) or
+ 					(tp = typnods[treal])
+ 	end;
+ 
+ 	procedure eexpr(tp : treeptr);				forward;
+ 	procedure etypedef(tp : treeptr);			forward;
+ 
+ 	(*	Emit code to select a record member.	*)
+ 	procedure eselect(tp : treeptr);
+ 
+ 	begin
+ 		doarrow := doarrow + 1;
+ 		eexpr(tp);
+ 		doarrow := doarrow - 1;
+ 		if donearr then
+ 			donearr := false
+ 		else
+ 			write('.')
+ 	end;
+ 
+ 	(*	Emit code for call to a predefined function/procedure.	*)
+ 	procedure epredef(ts, tp : treeptr);
+ 
+ 	label	444, 555;
+ 
+ 	var	tq,
+ 		tv, tx	: treeptr;
+ 		td	: predefs;
+ 		nelems	: integer;
+ 		ch	: char;
+ 		txtfile	: boolean;
+ 
+ 		(*	Determine a format-code for fprintf.		*)
+ 		(*	Update nelems as a sideeffect.			*)
+ 		function typeletter(tp : treeptr) : char;
+ 
+ 		label	999;
+ 
+ 		var	tq	: treeptr;
+ 
+ 		begin
+ 			tq := tp;
+ 			if tq^.tt = nformat then
+ 			    begin
+ 				if tq^.texpl^.tt = nformat then
+ 				    begin
+ 					typeletter := 'f';
+ 					goto 999
+ 				    end;
+ 				tq := tp^.texpl
+ 			    end;
+ 			tq := typeof(tq);
+ 			if tq^.tt = nsubrange then
+ 				tq := typeof(tq^.tlo);
+ 			if tq = typnods[tstring] then
+ 				typeletter := 's'
+ 			else if tq = typnods[tinteger] then
+ 				typeletter := 'd'
+ 			else if tq = typnods[tchar] then
+ 				typeletter := 'c'
+ 			else if tq = typnods[treal] then
+ 				if tp^.tt = nformat then
+ 					typeletter := 'e'
+ 				else
+ 					typeletter := 'g'
+ 			else if tq = typnods[tboolean] then
+ 			    begin
+ 				typeletter := 'b';
+ 				nelems := 6
+ 			    end
+ 			else if tq^.tt = narray then
+ 			    begin
+ 				typeletter := 'a';
+ 				nelems := crange(tq^.taindx)
+ 			    end
+ 			else if tq^.tt = nconfarr then
+ 			    begin
+ 				typeletter := 'v';
+ 				nelems := 0
+ 			    end
+ 			else
+ 				fatal(etree);
+ 		999:
+ 		end;	(* typeletter *)
+ 
+ 		procedure etxt(tp : treeptr);
+ 
+ 		var	w	: toknbuf;
+ 			c	: char;
+ 			i	: toknidx;
+ 
+ 		begin
+ 			case tp^.tt of
+ 			  nid:
+ 			    begin
+ 				tp := idup(tp);
+ 				if tp^.tt = nconst then
+ 					etxt(tp^.tbind)
+ 				else
+ 					fatal(etree)
+ 			    end;
+ 			  nstring:
+ 			    begin
+ 				(* printf format string *)
+ 				gettokn(tp^.tsym^.lstr, w);
+ 				i := 1;
+ 				while w[i] <> chr(null) do
+ 				    begin
+ 					c := w[i];
+ 					if (c = cite) or (c = bslash) then
+ 						write(bslash)
+ 					else if c = percent then
+ 						write(percent);
+ 					write(c);
+ 					i := i + 1
+ 				    end
+ 			    end;
+ 			  nchar:
+ 			    begin
+ 				(* single character in printf format *)
+ 				c := tp^.tsym^.lchar;
+ 				if (c = cite) or (c = bslash) then
+ 					write(bslash)
+ 				else if c = percent then
+ 					write(percent);
+ 				write(c)
+ 			    end;
+ 			end;(* case *)
+ 		end;	(* etxt *)
+ 
+ 		(*	Emit format for fprintf.			*)
+ 		procedure eformat(tq : treeptr);
+ 
+ 		var	tx	: treeptr;
+ 			i	: integer;
+ 
+ 		begin
+ 			case typeletter(tq) of
+ 			  'a':
+ 			    begin
+ 				write(percent);
+ 				if tq^.tt = nformat then
+ 					if tq^.texpr^.tt = ninteger then
+ 						eexpr(tq^.texpr)
+ 					else
+ 						write('*');
+ 				write('.', nelems:1, 's')
+ 			    end;
+ 			  'b':
+ 			    begin
+ 				write(percent);
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt = ninteger then
+ 						eexpr(tq^.texpr)
+ 					else
+ 						write('*')
+ 				    end;
+ 				write('s')
+ 			    end;
+ 			  'c':
+ 				if tq^.tt = nchar then
+ 					etxt(tq)
+ 				else begin
+ 					write(percent);
+ 					if tq^.tt = nformat then
+ 						if tq^.texpr^.tt = ninteger then
+ 							eexpr(tq^.texpr)
+ 						else
+ 							write('*');
+ 					write('c')
+ 				     end;
+ 			  'd':
+ 			    begin
+ 				write(percent);
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt = ninteger then
+ 						eexpr(tq^.texpr)
+ 					else
+ 						write('*')
+ 				    end
+ 				else
+ 					write(intlen:1);
+ 				write('d')
+ 			    end;
+ 			  'e':
+ 			    begin
+ 				write(percent, space);
+ 				tx := tq^.texpr;
+ 				if tx^.tt = ninteger then
+ 				    begin
+ 					i := cvalof(tx);
+ 					write(i:1, '.');
+ 					i := i - 7;
+ 					if i < 1 then
+ 						write('1')
+ 					else
+ 						write(i:1)
+ 				    end
+ 				else
+ 					write('*.*');
+ 				write('e')
+ 			    end;
+ 			  'f':
+ 			    begin
+ 				write(percent);
+ 				tx := tq^.texpl;
+ 				if tx^.texpr^.tt = ninteger then
+ 				    begin
+ 					eexpr(tx^.texpr);
+ 					write('.');
+ 					tx := tq^.texpr;
+ 					if tx^.tt = ninteger then
+ 					    begin
+ 						i := cvalof(tx);
+ 						tx := tq^.texpl^.texpr;
+ 						if i > cvalof(tx) - 1 then
+ 							write('1')
+ 						else
+ 							write(i:1)
+ 					    end
+ 					else
+ 						write('*');
+ 				    end
+ 				else
+ 					write('*.*');
+ 				write('f')
+ 			    end;
+ 			  'g':
+ 				write(percent, fixlen:1, 'e');
+ 			  's':
+ 				if tq^.tt = nstring then
+ 					etxt(tq)
+ 				else begin
+ 					write(percent);
+ 					if tq^.tt = nformat then
+ 						if tq^.texpr^.tt = ninteger then
+ 							eexpr(tq^.texpr)
+ 						else
+ 							write('*.*');
+ 					write('s')
+ 				     end
+ 			end (* case *)
+ 		end;	(* eformat *)
+ 
+ 		(*	Emit parameters to fprintf except format.	*)
+ 		procedure ewrite(tq : treeptr);
+ 
+ 		var	tx	: treeptr;
+ 
+ 		begin
+ 			case typeletter(tq) of
+ 			  'a':
+ 			    begin
+ 				write(', ');
+ 				tx := tq;
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					    begin
+ 					      eexpr(tq^.texpr);
+ 					      write(', ')
+ 					    end;
+ 					tx := tq^.texpl
+ 				    end;
+ 				eexpr(tx);
+ 				write('.A')
+ 			    end;
+ 			  'b':
+ 			    begin
+ 				write(', ');
+ 				tx := tq;
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					    begin
+ 					      eexpr(tq^.texpr);
+ 					      write(', ')
+ 					    end;
+ 					tx := tq^.texpl
+ 				    end;
+ 				usebool := true;
+ 				write('Bools[(int)(');
+ 				eexpr(tx);
+ 				write(')]')
+ 			    end;
+ 			  'c':
+ 			    begin
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					    begin
+ 						write(', ');
+ 						eexpr(tq^.texpr)
+ 					    end;
+ 					write(', ');
+ 					eexpr(tq^.texpl)
+ 				    end
+ 				else if tq^.tt <> nchar then
+ 				    begin
+ 					write(', ');
+ 					eexpr(tq)
+ 				    end
+ 			    end;
+ 			  'd':
+ 			    begin
+ 				write(', ');
+ 				tx := tq;
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					    begin
+ 						eexpr(tq^.texpr);
+ 						write(', ')
+ 					    end;
+ 					tx := tq^.texpl
+ 				    end;
+ 				eexpr(tx)
+ 			    end;
+ 			  'e':
+ 			    begin
+ 				write(', ');
+ 				tx := tq^.texpr;
+ 				if tx^.tt <> ninteger then
+ 				    begin
+ 					usemax := true;
+ 					eexpr(tx);
+ 					write(', Max(');
+ 					eexpr(tx);
+ 					write(' - 7, 1), ')
+ 				    end;
+ 				eexpr(tq^.texpl)
+ 			    end;
+ 			  'f':
+ 			    begin
+ 				write(', ');
+ 				tx := tq^.texpl;
+ 				if tx^.texpr^.tt <> ninteger then
+ 				    begin
+ 					eexpr(tx^.texpr);
+ 					write(', ')
+ 				    end;
+ 				if (tx^.texpr^.tt <> ninteger) or
+ 					(tq^.texpr^.tt <> ninteger) then
+ 				    begin
+ 					usemax := true;
+ 					write('Max((');
+ 					eexpr(tx^.texpr);
+ 					write(') - (');
+ 					eexpr(tq^.texpr);
+ 					write(') - 1, 1), ')
+ 				    end;
+ 				eexpr(tq^.texpl^.texpl)
+ 			    end;
+ 			  'g':
+ 			    begin
+ 				write(', ');
+ 				eexpr(tq)
+ 			    end;
+ 			  's':
+ 			    begin
+ 				if tq^.tt = nformat then
+ 				    begin
+ 					if tq^.texpr^.tt <> ninteger then
+ 					   begin
+ 						write(', ');
+ 						eexpr(tq^.texpr);
+ 						write(', ');
+ 						eexpr(tq^.texpr)
+ 					   end;
+ 					write(', ');
+ 					eexpr(tq^.texpl)
+ 				    end
+ 				else if tq^.tt <> nstring then
+ 				    begin
+ 					write(', ');
+ 					eexpr(tq)
+ 				    end
+ 			    end
+ 			end (* case *)
+ 		end;	(* ewrite *)
+ 
+ 		(*	Emit size of *tp for call to malloc. CPU	*)
+ 		(*	There is no safe way to compute the size of a	*)
+ 		(*	particular variant of a C-union, we assume that	*)
+ 		(*	the size can be computed by taking the address	*)
+ 		(*	of the first member and subracting the address	*)
+ 		(*	of the record and then adding the size of the	*)
+ 		(*	variant containing the record.			*)
+ 		procedure enewsize(tp : treeptr);
+ 
+ 		label	555;
+ 
+ 		var	tq, tx, ty	: treeptr;
+ 			v		: integer;
+ 
+ 			(*	Emit size of union member tq.		*)
+ 			procedure esubsize(tp, tq : treeptr);
+ 
+ 			label	555, 666;
+ 
+ 			var	tx, ty	: treeptr;
+ 				addsize	: boolean;
+ 
+ 			begin
+ 				tx := tq^.tvrnt;
+ 				ty := tx^.tflist;
+ 				if ty = nil then
+ 				    begin
+ 					ty := tx^.tvlist;
+ 					while ty <> nil do
+ 					    begin
+ 						if ty^.tvrnt^.tflist <> nil then
+ 						    begin
+ 							ty := ty^.tvrnt^.tflist;
+ 							goto 555
+ 						    end;
+ 						ty := ty^.tnext
+ 					    end;
+ 				555:
+ 				    end;
+ 				addsize := true;
+ 				if ty = nil then
+ 				    begin
+ 					(* empty variant, try using another *)
+ 					addsize := false;
+ 					ty := tx^.tup^.tup^.tvlist;
+ 					while ty <> nil do
+ 					    begin
+ 						if ty^.tvrnt^.tflist <> nil then
+ 						    begin
+ 							ty := ty^.tvrnt^.tflist;
+ 							goto 666
+ 						    end;
+ 						ty := ty^.tnext
+ 					    end;
+ 				666:
+ 				    end;
+ 				if ty = nil then
+ 				    begin
+ 					(* its getting too complicated,
+ 						ignore tag value *)
+ 					write('sizeof(*');
+ 					eexpr(tp);
+ 					write(')')
+ 				    end
+ 				else begin
+ 					(* compute offset to first member of
+ 					   the selected union variant *)
+ 					write('Unionoffs(');
+ 					eexpr(tp);
+ 					write(', ');
+ 					printid(ty^.tidl^.tsym^.lid);
+ 					if addsize then
+ 					    begin
+ 						(* add the size of the selected
+ 						   union variant *)
+ 						write(') + sizeof(');
+ 						eexpr(tp);
+ 						write('->');
+ 						printid(tx^.tuid)
+ 					    end;
+ 					write(')')
+ 				     end
+ 			end;
+ 
+ 		begin	(* newsize *)
+ 			if (tp^.tnext <> nil) and unionnew then
+ 			    begin
+ 				(* tnext points to a tag-value, evaluate it *)
+ 				v := cvalof(tp^.tnext);
+ 				(* find union type *)
+ 				tq := typeof(tp);
+ 				tq := typeof(tq^.tptrid);
+ 				if tq^.tt <> nrecord then
+ 					fatal(etree);
+ 				(* find corresponding variant *)
+ 				tx := tq^.tvlist;
+ 				while tx <> nil do
+ 				    begin
+ 					ty := tx^.tselct;
+ 					while ty <> nil do
+ 					    begin
+ 						if v = cvalof(ty) then
+ 							goto 555;
+ 						ty := ty^.tnext
+ 					    end;
+ 					tx := tx^.tnext
+ 				    end;
+ 				fatal(etag);
+ 			555:
+ 				(* emit size for that variant *)
+ 				esubsize(tp, tx)
+ 			    end
+ 			else begin
+ 				write('sizeof(*');
+ 				eexpr(tp);
+ 				write(')')
+ 			     end
+ 		end;	(* newsize *)
+ 
+ 	begin	(* epredef *)
+ 		td := ts^.tsubstmt^.tdef;
+ 		case td of
+ 		  dabs:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then
+ 				write('abs(')			(* LIB *)
+ 			else
+ 				write('fabs(');			(* LIB *)
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dargv:
+ 		    begin
+ 			write('Argvgt(');
+ 			eexpr(tp^.taparm);
+ 			write(', ');
+ 			eexpr(tp^.taparm^.tnext);
+ 			write('.A, sizeof(');
+ 			eexpr(tp^.taparm^.tnext);
+ 			writeln('.A));')
+ 		    end;
+ 		  dchr:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			if tq^.tt = nsubrange then
+ 				if tq^.tup^.tt = nconfarr then
+ 					tq := typeof(tq^.tup^.tindtyp)
+ 				else
+ 					tq := typeof(tq^.tlo);
+ 			if (tq = typnods[tinteger]) or
+ 						(tq = typnods[tchar]) then
+ 				eexpr(tp^.taparm)
+ 			else begin
+ 				write('(char)(');
+ 				eexpr(tp^.taparm);
+ 				write(')')
+ 			     end
+ 		    end;
+ 		  ddispose:
+ 		    begin
+ 			write('free(');				(* LIB *)
+ 			eexpr(tp^.taparm);
+ 			writeln(');')
+ 		    end;
+ 		  deof:
+ 		    begin
+ 			write('Eof(');
+ 			if tp^.taparm = nil then
+ 			    begin
+ 				defnams[dinput]^.lused := true;
+ 				printid(defnams[dinput]^.lid)
+ 			    end
+ 			else
+ 				eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  deoln:
+ 		    begin
+ 			write('Eoln(');
+ 			if tp^.taparm = nil then
+ 			    begin
+ 				defnams[dinput]^.lused := true;
+ 				printid(defnams[dinput]^.lid)
+ 			    end
+ 			else
+ 				eexpr(tp^.taparm);
+ 			write(')');
+ 		    end;
+ 		  dexit:
+ 		    begin
+ 			write('exit(');				(* OS *)
+ 			if tp^.taparm = nil then
+ 				write('0')
+ 			else
+ 				eexpr(tp^.taparm);
+ 			writeln(');');
+ 		    end;
+ 		  dflush:
+ 		    begin
+ 			write('fflush(');			(* LIB *)
+ 			if tp^.taparm = nil then
+ 			    begin
+ 				defnams[doutput]^.lused := true;
+ 				printid(defnams[doutput]^.lid)
+ 			    end
+ 			else
+ 				eexpr(tp^.taparm);
+ 			writeln('.fp);')
+ 		    end;
+ 		  dpage:
+ 		    begin
+ 			(* write form-feed character *)
+ 			write('Putchr(', ffchr, ', '); (* CHAR *)
+ 			if tp^.taparm = nil then
+ 			    begin
+ 				defnams[doutput]^.lused := true;
+ 				printid(defnams[doutput]^.lid)
+ 			    end
+ 			else
+ 				eexpr(tp^.taparm);
+ 			writeln(');');
+ 		    end;
+ 		  dput,
+ 		  dget:
+ 		    begin
+ 			if typeof(tp^.taparm) = typnods[ttext] then
+ 				if td = dget then
+ 					write('Getx')
+ 				else
+ 					write('Putx')
+ 			else begin
+ 				write(voidcast);
+ 				if td = dget then
+ 					write('Get')
+ 				else
+ 					write('Put')
+ 			     end;
+ 			write('(');
+ 			eexpr(tp^.taparm);
+ 			writeln(');')
+ 		    end;
+ 		  dhalt:
+ 			writeln('abort();');			(* OS *)
+ 		  dnew:
+ 		    begin
+ 			eexpr(tp^.taparm);
+ 			write(' = (');
+ 			etypedef(typeof(tp^.taparm));
+ 			write(')malloc((unsigned)(');	(* LIB *)
+ 			enewsize(tp^.taparm);
+ 			writeln('));')
+ 		    end;
+ 		  dord:
+ 		    begin
+ 			write('(unsigned)(');
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dread,
+ 		  dreadln:
+ 		    begin
+ 			txtfile := false;
+ 			tq := tp^.taparm;
+ 			if tq <> nil then
+ 			    begin
+ 				tv := typeof(tq);
+ 				if tv = typnods[ttext] then
+ 				    begin
+ 					(* reading from textfile *)
+ 					txtfile := true;
+ 					tv := tq;
+ 					tq := tq^.tnext
+ 				    end
+ 				else if tv^.tt = nfileof then
+ 				    begin
+ 					(* reading from other file *)
+ 					txtfile := typeof(tv^.tof) =
+ 							typnods[tchar];
+ 					tv := tq;
+ 					tq := tq^.tnext
+ 				    end
+ 				else begin
+ 					(* reading from std-input *)
+ 					txtfile := true;
+ 					tv := nil
+ 				     end
+ 			    end
+ 			else begin
+ 				tv := nil;
+ 				txtfile := true
+ 			     end;
+ 			if txtfile then
+ 			    begin
+ 				(* check for special case *)
+ 				if tq = nil then
+ 					goto 444;
+ 				if (tq^.tt <> nformat) and
+ 						(tq^.tnext = nil) and
+ 						(typeletter(tq) = 'c') then
+ 				    begin
+ 					(* read single char *)
+ 					eexpr(tq);
+ 					write(' = ');
+ 					write('Getchr(');
+ 					if tv = nil then
+ 						printid(defnams[dinput]^.lid)
+ 					else
+ 						eexpr(tv);
+ 					write(')');
+ 					if td = dreadln then
+ 						write(',');
+ 					goto 444
+ 				    end;
+ 				usescan := true;
+ 				write('Fscan(');
+ 				if tv = nil then
+ 					printid(defnams[dinput]^.lid)
+ 				else
+ 					eexpr(tv);
+ 				write('), ');
+ 				(* first pass, emit format string *)
+ 				while tq <> nil do
+ 				    begin
+ 					write('Scan(', cite);
+ 					ch := typeletter(tq);
+ 					case ch of
+ 					  'a':
+ 						write(percent, 's');
+ 					  'c':
+ 						write(percent, 'c');
+ 					  'd':
+ 						write(percent, 'ld');
+ 					  'g':
+ 						write(percent, 'le')
+ 					end;(* case *)
+ 					write(cite, ', ');
+ 					case ch of
+ 					  'a':
+ 					    begin
+ 						eexpr(tq);
+ 						write('.A')
+ 					    end;
+ 					  'c':
+ 					    begin
+ 						write('&');
+ 						eexpr(tq)
+ 					    end;
+ 					  'd':
+ 						write('&Tmplng');
+ 					  'g':
+ 						write('&Tmpdbl')
+ 					end;(* case *)
+ 					write(')');
+ 					case ch of
+ 					  'd':
+ 					    begin
+ 						write(', ');
+ 						eexpr(tq);
+ 						write(' = Tmplng')
+ 					    end;
+ 					  'g':
+ 					    begin
+ 						write(', ');
+ 						eexpr(tq);
+ 						write(' = Tmpdbl')
+ 					    end;
+ 					  'a',
+ 					  'c':
+ 						(* no op *)
+ 					end;(* case *)
+ 					tq := tq^.tnext;
+ 					if tq <> nil then
+ 					    begin
+ 						writeln(',');
+ 						indent;
+ 						write(tab1)
+ 					    end
+ 				    end;
+ 				write(', Getx(');
+ 				if tv = nil then
+ 					printid(defnams[dinput]^.lid)
+ 				else
+ 					eexpr(tv);
+ 				write(')');
+ 				if td = dreadln then
+ 					write(',');
+ 			444:
+ 				if td = dreadln then
+ 				    begin
+ 					usegetl := true;
+ 					write('Getl(&');
+ 					if tv = nil then
+ 						printid(defnams[dinput]^.lid)
+ 					else
+ 						eexpr(tv);
+ 					write(')')
+ 				    end
+ 			    end
+ 			else begin
+ 				increment;
+ 				while tq <> nil do
+ 				    begin
+ 					write(voidcast, 'Fread(');
+ 					eexpr(tq);
+ 					write(', ');
+ 					eexpr(tv);
+ 					write('.fp)');
+ 					tq := tq^.tnext;
+ 					if tq <> nil then
+ 					    begin
+ 						writeln(',');
+ 						indent
+ 					    end
+ 				    end;
+ 				decrement
+ 			     end;
+ 			writeln(';')
+ 		    end;
+ 		  dwrite,
+ 		  dwriteln,
+ 		  dmessage:
+ 		    begin
+ 			txtfile := false;
+ 			tq := tp^.taparm;
+ 			if tq <> nil then
+ 			    begin
+ 				tv := typeof(tq);
+ 				if tv = typnods[ttext] then
+ 				    begin
+ 					(* writing to textfile *)
+ 					txtfile := true;
+ 					tv := tq;
+ 					tq := tq^.tnext
+ 				    end
+ 				else if tv^.tt = nfileof then
+ 				    begin
+ 					(* writing to other file *)
+ 					txtfile := typeof(tv^.tof) =
+ 							typnods[tchar];
+ 					tv := tq;
+ 					tq := tq^.tnext
+ 				    end
+ 				else begin
+ 					(* writing to std-output *)
+ 					txtfile := true;
+ 					tv := nil
+ 				     end
+ 			    end
+ 			else begin
+ 				tv := nil;
+ 				txtfile := true
+ 			     end;
+ 			if txtfile then
+ 			    begin
+ 				(* check for special case *)
+ 				if tq = nil then
+ 				    begin
+ 					(* writeln whithout parameters *)
+ 					if td in [dwriteln, dmessage] then
+ 					    begin
+ 						write('Putchr(', nlchr, ', ');
+ 						if tv = nil then
+ 							printid(
+ 							  defnams[doutput]^.lid)
+ 						else
+ 							eexpr(tv);
+ 						write(')')
+ 					    end;
+ 					writeln(';');
+ 					goto 555
+ 				    end
+ 				else if (tq^.tt <> nformat) and
+ 						(tq^.tnext = nil) then
+ 					if typeletter(tq) = 'c' then
+ 					    begin
+ 						(* print single char *)
+ 						write('Putchr(');
+ 						eexpr(tq);
+ 						write(', ');
+ 						if tv = nil then
+ 							printid(
+ 							  defnams[doutput]^.lid)
+ 						else
+ 							eexpr(tv);
+ 						write(')');
+ 						if td = dwriteln then
+ 						    begin
+ 							write(',Putchr(',
+ 							    nlchr, ', ');
+ 							if tv = nil then
+ 							 printid(
+ 							  defnams[doutput]^.lid)
+ 							else
+ 								eexpr(tv);
+ 							write(')');
+ 						    end;
+ 						writeln(';');
+ 						goto 555
+ 					    end;
+ 				tx := nil;
+ 				write(voidcast, 'fprintf(');	(* LIB *)
+ 				if td = dmessage then
+ 					write('stderr, ')
+ 				else begin
+ 					if tv = nil then
+ 						printid(defnams[doutput]^.lid)
+ 					else
+ 						eexpr(tv);
+ 					write('.fp, ')
+ 				     end;
+ 				write(cite);
+ 				tx := tq;	(* remember 1:st parm *)
+ 				(* first pass, emit format string *)
+ 				while tq <> nil do
+ 				    begin
+ 					eformat(tq);
+ 					tq := tq^.tnext
+ 				    end;
+ 				if (td = dmessage) or (td = dwriteln) then
+ 					write('\n');
+ 				write(cite);
+ 				(* second pass, add parameters *)
+ 				tq := tx;
+ 				while tq <> nil do
+ 				    begin
+ 					ewrite(tq);
+ 					tq := tq^.tnext
+ 				    end;
+ 				write('), Putl(');
+ 				if tv = nil then
+ 					printid(defnams[doutput]^.lid)
+ 				else
+ 					eexpr(tv);
+ 				if td = dwrite then
+ 					write(', 0)')
+ 				else
+ 					write(', 1)')
+ 			    end
+ 			else begin
+ 				increment;
+ 				tx := typeof(tv);
+ 				if tx = typnods[ttext] then
+ 					tx := typnods[tchar]
+ 				else if tx^.tt = nfileof then
+ 					tx := typeof(tx^.tof)
+ 				else
+ 					fatal(etree);
+ 				while tq <> nil do
+ 				    begin
+ 					if (tq^.tt in [nid, nindex, nselect,
+ 							nderef]) and
+ 						(tx = typeof(tq)) then
+ 					    begin
+ 						write(voidcast, 'Fwrite(');
+ 						eexpr(tq)
+ 					    end
+ 					else begin
+ 						if tx^.tt = nsetof then
+ 						    begin
+ 							usescpy := true;
+ 							write('Setncpy(');
+ 							eselect(tv);
+ 							write('buf.S, ');
+ 							eexpr(tq);
+ 							if typeof(tp^.trhs) =
+ 							   typnods[tset] then
+ 								eexpr(tq)
+ 							else begin
+ 								eselect(tq);
+ 								write('S')
+ 							     end;
+ 							write(', sizeof(');
+ 							eexpr(tv);
+ 							write('.buf))');
+ 						    end
+ 						else begin
+ 							eexpr(tv);
+ 							write('.buf = ');
+ 							eexpr(tq)
+ 						     end;
+ 						write(', Fwrite(');
+ 						eexpr(tv);
+ 						write('.buf');
+ 					     end;
+ 					write(', ');
+ 					eexpr(tv);
+ 					write('.fp)');
+ 					tq := tq^.tnext;
+ 					if tq <> nil then
+ 					    begin
+ 						writeln(',');
+ 						indent
+ 					    end
+ 				    end;
+ 				decrement
+ 			     end;
+ 			writeln(';');
+ 		555:
+ 		    end;
+ 		  dclose:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			txtfile := tq = typnods[ttext];
+ 			if (not txtfile) and (tq^.tt = nfileof) then
+ 				if typeof(tq^.tof) = typnods[tchar] then
+ 					txtfile := true;
+ 			if txtfile then
+ 				write('Closex(')
+ 			else
+ 				write('Close(');
+ 			eexpr(tp^.taparm);
+ 			writeln(');');
+ 		    end;
+ 		  dreset,
+ 		  drewrite:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			txtfile := tq = typnods[ttext];
+ 			if (not txtfile) and (tq^.tt = nfileof) then
+ 				if typeof(tq^.tof) = typnods[tchar] then
+ 					txtfile := true;
+ 			if txtfile then
+ 				if td = dreset then
+ 					write('Resetx(')
+ 				else
+ 					write('Rewritex(')
+ 			else
+ 				if td = dreset then
+ 					write('Reset(')
+ 				else
+ 					write('Rewrite(');
+ 			eexpr(tp^.taparm);
+ 			write(', ');
+ 			tq := tp^.taparm^.tnext;
+ 			if tq = nil then
+ 				write('NULL')
+ 			else begin
+ 				tq := typeof(tq);
+ 				if tq = typnods[tchar] then
+ 				    begin
+ 					write(cite);
+ 					ch := chr(cvalof(tp^.taparm^.tnext));
+ 					if (ch = bslash) or (ch = cite) then
+ 						write(bslash);
+ 					write(ch, cite)
+ 				    end
+ 				else if tq = typnods[tstring] then
+ 					eexpr(tp^.taparm^.tnext)
+ 				else  if tq^.tt in [narray, nconfarr] then
+ 				     begin
+ 					eexpr(tp^.taparm^.tnext);
+ 					write('.A')
+ 				     end
+ 				else
+ 					fatal(etree)
+ 			     end;
+ 			writeln(');')
+ 		    end;
+ 		  darctan:
+ 		    begin
+ 			write('atan(');	(* LIB *)
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dln:
+ 		    begin
+ 			write('log(');	(* LIB *)
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dexp:
+ 		    begin
+ 			write('exp(');	(* LIB *)
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dcos,
+ 		  dsin,
+ 		  dsqrt:
+ 		    begin
+ 			eexpr(tp^.tcall);	(* LIB *)
+ 			write('(');
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dtan:
+ 		    begin
+ 			write('atan(');		(* LIB *)
+ 			if typeof(tp^.taparm) <> typnods[treal] then
+ 				write(dblcast);
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dsucc,
+ 		  dpred:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			if tq^.tt = nsubrange then
+ 				if tq^.tup^.tt = nconfarr then
+ 					tq := typeof(tq^.tup^.tindtyp)
+ 				else
+ 					tq := typeof(tq^.tlo);
+ 			if (tq = typnods[tinteger]) or
+ 						(tq = typnods[tchar]) then
+ 			    begin
+ 				write('((');
+ 				eexpr(tp^.taparm);
+ 				if td = dpred then
+ 					write(')-1)')
+ 				else
+ 					write(')+1)')
+ 			    end
+ 			else begin
+ 				(* some sort of scalar type, casting needed *)
+ 				write('(');
+ 				tq := tq^.tup;
+ 				if tq^.tt = ntype then
+ 				    begin
+ 					(* cast only if it is a named type *)
+ 					write('(');
+ 					printid(tq^.tidl^.tsym^.lid);
+ 					write(')')
+ 				    end;
+ 				write('((int)(');
+ 				eexpr(tp^.taparm);
+ 				if td = dpred then
+ 					write(')-1))')
+ 				else
+ 					write(')+1))')
+ 			     end
+ 		    end;
+ 		  dodd:
+ 		    begin
+ 			write('(');
+ 			printid(defnams[dboolean]^.lid);
+ 			write(')((');
+ 			eexpr(tp^.taparm);
+ 			write(') & 1)')
+ 		    end;
+ 		  dsqr:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then
+ 			    begin
+ 				write('((');
+ 				eexpr(tp^.taparm);
+ 				write(') * (');
+ 				eexpr(tp^.taparm);
+ 				write('))')
+ 			    end
+ 			else begin
+ 				write('pow(');	(* LIB *)
+ 				if typeof(tp^.taparm) <> typnods[treal] then
+ 					write(dblcast);
+ 				eexpr(tp^.taparm);
+ 				write(', 2.0)')
+ 			     end
+ 		    end;
+ 		  dround:
+ 		    begin
+ 			write('Round(');
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dtrunc:
+ 		    begin
+ 			write('Trunc(');
+ 			eexpr(tp^.taparm);
+ 			write(')')
+ 		    end;
+ 		  dpack:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			tx := typeof(tp^.taparm^.tnext^.tnext);
+ 			write('{    ', registr, inttyp, tab1, '_j, _i = ');
+ 			if not arithexpr(tp^.taparm^.tnext) then
+ 				write('(int)');
+ 			eexpr(tp^.taparm^.tnext);
+ 			if tx^.tt = narray then
+ 				write(' - ', clower(tq^.taindx):1);
+ 			writeln(';');
+ 			indent;
+ 			write('    for (_j = 0; _j < ');
+ 			if tq^.tt = nconfarr then
+ 			    begin
+ 				write('(int)(');
+ 				printid(tx^.tcindx^.thi^.tsym^.lid);
+ 				write(')')
+ 			    end
+ 			else
+ 				write(crange(tx^.taindx):1);
+ 			writeln('; )');
+ 			indent;
+ 			write(tab1);
+ 			eexpr(tp^.taparm^.tnext^.tnext);
+ 			write('.A[_j++] = ');
+ 			eexpr(tp^.taparm);
+ 			writeln('.A[_i++];');
+ 			indent;
+ 			writeln('}')
+ 		    end;
+ 		  dunpack:
+ 		    begin
+ 			tq := typeof(tp^.taparm);
+ 			tx := typeof(tp^.taparm^.tnext);
+ 			write('{   ', registr, inttyp, tab1, '_j, _i = ');
+ 			if not arithexpr(tp^.taparm^.tnext^.tnext) then
+ 				write('(int)');
+ 			eexpr(tp^.taparm^.tnext^.tnext);
+ 			if tx^.tt <> nconfarr then
+ 				write(' - ', clower(tx^.taindx):1);
+ 			writeln(';');
+ 			indent;
+ 			write('    for (_j = 0; _j < ');
+ 			if tq^.tt = nconfarr then
+ 			    begin
+ 				write('(int)(');
+ 				printid(tq^.tcindx^.thi^.tsym^.lid);
+ 				write(')')
+ 			    end
+ 			else
+ 				write(crange(tq^.taindx):1);
+ 			writeln('; )');
+ 			indent;
+ 			write(tab1);
+ 			eexpr(tp^.taparm^.tnext);
+ 			write('.A[_i++] = ');
+ 			eexpr(tp^.taparm);
+ 			writeln('.A[_j++];');
+ 			indent;
+ 			writeln('}')
+ 		    end;
+ 		end (* case *)
+ 	end;	(* epredef *)
+ 
+ 	procedure eaddr(tp : treeptr);
+ 
+ 	begin
+ 		write('&');
+ 		if not(tp^.tt in [nid, nselect, nindex, nderef]) then
+ 			error(evarpar);
+ 		eexpr(tp)
+ 	end;
+ 
+ 	(*	Emit code for a subroutine call.			*)
+ 	procedure ecall(tp : treeptr);
+ 
+ 	var	tf, tq, tx	: treeptr;
+ 
+ 	begin
+ 		(* find first formal parameter id *)
+ 		tf := idup(tp^.tcall);
+ 		case tf^.tt of
+ 		  nproc,
+ 		  nfunc:
+ 			tf := tf^.tsubpar;
+ 		  nparproc,
+ 		  nparfunc:
+ 			tf := tf^.tparparm
+ 		end;(* case *)
+ 		if tf <> nil then
+ 		    begin
+ 			case tf^.tt of
+ 			  nvalpar,
+ 			  nvarpar:
+ 				tf := tf^.tidl;
+ 			  nparproc,
+ 			  nparfunc:
+ 				tf := tf^.tparid
+ 			end (* case *)
+ 		    end;
+ 		(* emit called function name *)
+ 		eexpr(tp^.tcall);
+ 		write('(');
+ 		(* emit actual parameters *)
+ 		tq := tp^.taparm;
+ 		while tq <> nil do
+ 		    begin
+ 			if tf^.tup^.tt in [nparfunc, nparproc] then
+ 			    begin
+ 				(* single subroutine-nid converted to ncall *)
+ 				if tq^.tt = ncall then
+ 					printid(tq^.tcall^.tsym^.lid)
+ 				else
+ 					printid(tq^.tsym^.lid)
+ 			    end
+ 			else begin
+ 				tx := typeof(tq);
+ 				if tx = typnods[tboolean] then
+ 				    begin
+ 					tx := tq;
+ 					while tx^.tt = nuplus do
+ 						tx := tx^.texps;
+ 					if tx^.tt in [nin .. nor, nand, nnot]
+ 									then
+ 					    begin
+ 						write('(');
+ 						printid(defnams[dboolean]^.lid);
+ 						write(')(');
+ 						eexpr(tq);
+ 						write(')')
+ 					    end
+ 					else
+ 						eexpr(tq);
+ 				    end
+ 				else if (tx = typnods[tstring]) or
+ 						(tx = typnods[tset]) then
+ 				    begin
+ 					(* cast literal to proper type *)
+ 					write('*((');
+ 					etypedef(tf^.tup^.tbind);
+ 					write(' *)');
+ 					if tx = typnods[tset] then
+ 					    begin
+ 						dropset := true;
+ 						eexpr(tq);
+ 						dropset := false
+ 					    end
+ 					else
+ 						eexpr(tq);
+ 					write(')')
+ 				    end
+ 				else if tx = typnods[tnil] then
+ 				    begin
+ 					write('(');
+ 					etypedef(tf^.tup^.tbind);
+ 					write(')NIL')
+ 				    end
+ 				else if tf^.tup^.tbind^.tt = nconfarr then
+ 				    begin
+ 					write('(struct ');
+ 					printid(tf^.tup^.tbind^.tcuid);
+ 					write(' *)&');
+ 					eexpr(tq);
+ 					(* add upper bound of actual value *)
+ 					if tq^.tnext = nil then
+ 						write(', ',
+ 							crange(tx^.taindx):1)
+ 				    end
+ 				else begin
+ 					if tf^.tup^.tt = nvarpar then
+ 						eaddr(tq)
+ 					else
+ 						eexpr(tq)
+ 				     end
+ 			    end;
+ 			tq := tq^.tnext;
+ 			if tq <> nil then
+ 			    begin
+ 				write(', ');
+ 				(* next formal parameter *)
+ 				if tf^.tnext = nil then
+ 				    begin
+ 					tf := tf^.tup^.tnext;
+ 					case tf^.tt of
+ 					  nvalpar,
+ 					  nvarpar:
+ 						tf := tf^.tidl;
+ 					  nparproc,
+ 					  nparfunc:
+ 						tf := tf^.tparid
+ 					end (* case *)
+ 				    end
+ 				else
+ 					tf := tf^.tnext;
+ 			    end;
+ 		    end;
+ 		write(')')
+ 	end;	(* ecall *)
+ 
+ 	(*	Emit code for a general expression.			*)
+ 	procedure eexpr;
+ 
+ 	label	999;
+ 
+ 	var	tq	: treeptr;
+ 		flag	: boolean;
+ 
+ 		function constset(tp : treeptr) : boolean;
+ 
+ 			function constxps(tp : treeptr) : boolean;
+ 			begin
+ 				case tp^.tt of
+ 				  nrange:
+ 					if constxps(tp^.texpr) then
+ 						constxps := constxps(tp^.texpl)
+ 					else
+ 						constxps := false;
+ 				  nempty,
+ 				  ninteger,
+ 				  nchar:
+ 					constxps := true;
+ 				  nid:
+ 				    begin
+ 					tp := idup(tp);
+ 					constxps := (tp^.tt = nconst)
+ 							or (tp^.tt = nscalar)
+ 				    end;
+ 				  nin, neq, nne, nlt, nle, ngt, nge, nor,
+ 				  nplus, nminus, nand, nmul, ndiv, nmod,
+ 				  nquot, nnot, numinus, nuplus, nset,	
+ 				  nindex, nselect, nderef, ncall,
+ 				  nreal, nstring, nnil:
+ 					constxps := false
+ 				end (* case *)
+ 			end;
+ 
+ 		begin
+ 			constset := true;
+ 			while tp <> nil do
+ 				if constxps(tp) then
+ 					tp := tp^.tnext
+ 				else begin
+ 					constset := false;
+ 					tp := nil
+ 				    end
+ 		end;
+ 
+ 	begin	(* eexpr *)
+ 		donearr := false;
+ 		if tp^.tt in [nplus, nminus, nmul, nle, nge, neq, nne] then
+ 		    begin
+ 			tq := typeof(tp^.texpl);
+ 			if (tq^.tt in [nset, nsetof]) or
+ 						(tq = typnods[tset]) then
+ 			    begin
+ 				(* set operations *)
+ 				case tp^.tt of
+ 				  nplus:
+ 				    begin
+ 					setused := true;
+ 					useunion := true;
+ 					write('Union')
+ 				    end;
+ 				  nminus:
+ 				    begin
+ 					setused := true;
+ 					usediff := true;
+ 					write('Diff')
+ 				    end;
+ 				  nmul:
+ 				    begin
+ 					setused := true;
+ 					useintr := true;
+ 					write('Inter')
+ 				    end;
+ 				  neq:
+ 				    begin
+ 					useseq := true;
+ 					write('Eq')
+ 				    end;
+ 				  nne:
+ 				    begin
+ 					usesne := true;
+ 					write('Ne')
+ 				    end;
+ 				  nge:
+ 				    begin
+ 					usesge := true;
+ 					write('Ge')
+ 				    end;
+ 				  nle:
+ 				    begin
+ 					usesle := true;
+ 					write('Le')
+ 				    end
+ 				end;(* case *)
+ 				if tp^.tt in [nplus, nminus, nmul] then
+ 					dropset := false;
+ 				write('(');
+ 				eexpr(tp^.texpl);
+ 				if tq^.tt = nsetof then
+ 					write('.S');
+ 				write(', ');
+ 				eexpr(tp^.texpr);
+ 				tq := typeof(tp^.texpr);
+ 				if tq^.tt = nsetof then
+ 					write('.S');
+ 				write(')');
+ 				goto 999
+ 			    end
+ 		    end;
+ 		if tp^.tt in [neq, nne, ngt, nlt, nge, nle] then
+ 		    begin
+ 			tq := typeof(tp^.texpl);
+ 			if tq^.tt = nconfarr then
+ 				fatal(ecmpconf);
+ 			if (tq^.tt in [nstring, narray]) or
+ 						(tq = typnods[tstring]) then
+ 			    begin
+ 				write('Cmpstr(');
+ 				eexpr(tp^.texpl);
+ 				if tq^.tt = narray then
+ 					write('.A');
+ 				write(', ');
+ 				tq := typeof(tp^.texpr);
+ 				if tq^.tt = nconfarr then
+ 					fatal(ecmpconf);
+ 				eexpr(tp^.texpr);
+ 				if tq^.tt = narray then
+ 					write('.A');
+ 				write(')');
+ 				case tp^.tt of
+ 				  neq:
+ 					write(' == ');
+ 				  nne:
+ 					write(' != ');
+ 				  ngt:
+ 					write(' > ');
+ 				  nlt:
+ 					write(' < ');
+ 				  nge:
+ 					write(' >= ');
+ 				  nle:
+ 					write(' <= ');
+ 				end;(* case *)
+ 				write('0');
+ 				goto 999
+ 			    end
+ 		    end;
+ 		case tp^.tt of
+ 		  neq, nne, nlt, nle,
+ 		  ngt, nge, nor, nand, nplus, nminus,
+ 		  nmul, ndiv, nmod, nquot:
+ 		    begin
+ 			flag := cprio[tp^.tt] > cprio[tp^.texpl^.tt];
+ 			if (tp^.tt in [nlt, nle, ngt, nge]) and
+ 					not arithexpr(tp^.texpl) then
+ 			    begin
+ 				write('(int)');
+ 				flag := true
+ 			    end;
+ 			if flag then
+ 				write('(');
+ 			eexpr(tp^.texpl);
+ 			if flag then
+ 				write(')');
+ 			case tp^.tt of
+ 			  neq:
+ 				write(' == ');
+ 			  nne:
+ 				write(' != ');
+ 			  nlt:
+ 				write(' < ');
+ 			  nle:
+ 				write(' <= ');
+ 			  ngt:
+ 				write(' > ');
+ 			  nge:
+ 				write(' >= ');
+ 			  nor:
+ 				write(' || ');
+ 			  nand:
+ 				write(' && ');
+ 			  nplus:
+ 				write(' + ');
+ 			  nminus:
+ 				write(' - ');
+ 			  nmul:
+ 				write(' * ');
+ 			  ndiv:
+ 				write(' / ');
+ 			  nmod:
+ 				write(' % ');
+ 			  nquot:
+ 			    begin
+ 				write(' / ((');
+ 				printid(defnams[dreal]^.lid);
+ 				write(')')
+ 			    end
+ 			end;(* case *)
+ 			flag := cprio[tp^.tt] > cprio[tp^.texpr^.tt];
+ 			if (tp^.tt in [nlt, nle, ngt, nge]) and
+ 					not arithexpr(tp^.texpr) then
+ 			    begin
+ 				write('(int)');
+ 				flag := true
+ 			    end;
+ 			if flag then
+ 				write('(');
+ 			eexpr(tp^.texpr);
+ 			if flag then
+ 				write(')');
+ 			if tp^.tt = nquot then
+ 				write(')')
+ 		    end;
+ 
+ 		  nuplus, numinus, nnot:
+ 		    begin
+ 			case tp^.tt of
+ 			  numinus:
+ 				write('-');
+ 			  nnot:
+ 				write('!');
+ 			  nuplus:
+ 			end;(* case *)
+ 			flag := cprio[tp^.tt] >= cprio[tp^.texps^.tt];
+ 			if flag then
+ 				write('(');
+ 			eexpr(tp^.texps);
+ 			if flag then
+ 				write(')');
+ 		    end;
+ 		  
+ 		  nin:
+ 		    begin
+ 			usememb := true;
+ 			write('Member((unsigned)(');
+ 			eexpr(tp^.texpl);
+ 			write('), ');
+ 			dropset := true;	(* no need to save set-expr *)
+ 			eexpr(tp^.texpr);
+ 			dropset := false;
+ 			tq := typeof(tp^.texpr);
+ 			if tq^.tt = nsetof then
+ 				write('.S');
+ 			write(')')
+ 		    end;
+ 
+ 		  nassign:
+ 		    begin
+ 			tq := typeof(tp^.trhs);
+ 			if tq = typnods[tstring] then
+ 			    begin
+ 				write(voidcast, 'strncpy(');
+ 				eexpr(tp^.tlhs);
+ 				write('.A, ');
+ 				eexpr(tp^.trhs);
+ 				write(', sizeof(');
+ 				eexpr(tp^.tlhs);
+ 				write('.A))')
+ 			    end
+ 			else if tq = typnods[tboolean] then
+ 			    begin
+ 				eexpr(tp^.tlhs);
+ 				write(' = ');
+ 				tq := tp^.trhs;
+ 				while tq^.tt = nuplus do
+ 					tq := tq^.texps;
+ 				if tq^.tt in [nin .. nor, nand, nnot] then
+ 				    begin
+ 					write('(');
+ 					printid(defnams[dboolean]^.lid);
+ 					write(')(');
+ 					eexpr(tq);
+ 					write(')')
+ 				    end
+ 				else
+ 					eexpr(tq)
+ 			    end
+ 			else if tq = typnods[tnil] then
+ 			    begin
+ 				eexpr(tp^.tlhs);
+ 				write(' = (');
+ 				etypedef(typeof(tp^.tlhs));
+ 				write(')NIL')
+ 			    end
+ 			else begin
+ 				tq := typeof(tp^.tlhs);
+ 				if tq^.tt = nsetof then
+ 				    begin
+ 					usescpy := true;
+ 					write('Setncpy(');
+ 					eselect(tp^.tlhs);
+ 					write('S, ');
+ 					dropset := true;
+ 					tq := typeof(tp^.trhs);
+ 					if tq = typnods[tset] then
+ 						eexpr(tp^.trhs)
+ 					else begin
+ 						eselect(tp^.trhs);
+ 						write('S')
+ 					     end;
+ 					dropset := false;
+ 					write(', sizeof(');
+ 					eselect(tp^.tlhs);
+ 					write('S))')
+ 				    end
+ 				else begin
+ 					eexpr(tp^.tlhs);
+ 					write(' = ');
+ 					eexpr(tp^.trhs)
+ 				     end
+ 			     end
+ 		    end;
+ 
+ 		  ncall:
+ 		    begin
+ 			tq := idup(tp^.tcall);
+ 			if (tq^.tt in [nfunc, nproc]) and
+ 					(tq^.tsubstmt <> nil) then
+ 				if tq^.tsubstmt^.tt = npredef then
+ 					epredef(tq, tp)
+ 				else
+ 					ecall(tp)
+ 			else
+ 				ecall(tp)
+ 		    end;
+ 
+ 		  nselect:
+ 		    begin
+ 			eselect(tp^.trecord);
+ 			eexpr(tp^.tfield)
+ 		    end;
+ 		  nindex:
+ 		    begin
+ 			eselect(tp^.tvariable);
+ 			write('A[');
+ 			tq := tp^.toffset;
+ 			if arithexpr(tq) then
+ 				eexpr(tq)
+ 			else begin
+ 				write('(int)(');
+ 				eexpr(tq);
+ 				write(')')
+ 			     end;
+ 			tq := typeof(tp^.tvariable);
+ 			if tq^.tt = narray then
+ 				if clower(tq^.taindx) <> 0 then
+ 				    begin
+ 					write(' - ');
+ 					tq := typeof(tq^.taindx);
+ 					if tq^.tt = nsubrange then
+ 						if arithexpr(tq^.tlo) then
+ 							eexpr(tq^.tlo)
+ 						else begin
+ 							write('(int)(');
+ 							eexpr(tq^.tlo);
+ 							write(')')
+ 						     end
+ 					else 
+ 						fatal(etree)
+ 				    end;
+ 			write(']')
+ 		    end;
+ 		  nderef:
+ 		    begin
+ 			tq := typeof(tp^.texps);
+ 			if (tq^.tt = nfileof) or
+ 			     ((tq^.tt = npredef) and (tq^.tdef = dtext)) then
+ 			    begin
+ 				(* using a file-variable as pointer *)
+ 				eexpr(tp^.texps);
+ 				write('.buf')
+ 			    end
+ 			else if doarrow = 0 then
+ 			    begin
+ 				write('*');
+ 				eexpr(tp^.texps)
+ 			    end
+ 			else begin
+ 				eexpr(tp^.texps);
+ 				write('->');
+ 				donearr := true
+ 			     end
+ 		    end;
+ 		  nid:
+ 		    begin
+ 			(* add pointer-dereference if this id is declared as a
+ 			   var-parameter or as a procedure-parameter *)
+ 			tq := idup(tp);
+ 			if tq^.tt = nvarpar then
+ 			    begin
+ 				if (doarrow = 0) or
+ 						(tq^.tattr = areference) then
+ 				    begin
+ 					write('(*');
+ 					printid(tp^.tsym^.lid);
+ 					write(')')
+ 				    end
+ 				else begin
+ 					printid(tp^.tsym^.lid);
+ 					write('->');
+ 					donearr := true
+ 				     end
+ 			    end
+ 			else if (tq^.tt = nconst) and conflag then
+ 				write(cvalof(tp):1)
+ 			else if tq^.tt in [nparproc, nparfunc] then
+ 			    begin
+ 				write('(*');
+ 				printid(tp^.tsym^.lid);
+ 				write(')')
+ 			    end
+ 			else
+ 				printid(tp^.tsym^.lid);
+ 		    end;
+ 		  nchar:
+ 			printchr(tp^.tsym^.lchar);
+ 		  ninteger:
+ 			write(tp^.tsym^.linum:1);
+ 		  nreal:
+ 			printtok(tp^.tsym^.lfloat);
+ 		  nstring:
+ 			printstr(tp^.tsym^.lstr);
+ 		  nset:
+ 			if constset(tp^.texps) then
+ 			    begin
+ 				(* save set expression for initialization *)
+ 				write('Conset[', setcnt:1, ']');
+ 				setcnt := setcnt + 1;
+ 				tq := mknode(nset);
+ 				tq^.tnext := setlst;
+ 				setlst := tq;
+ 				tq^.texps := tp^.texps
+ 			    end
+ 			else begin
+ 				increment;
+ 				flag := dropset;
+ 				(* if a set-constructor is used in an
+ 				   expression involving + - *  it will need to
+ 				   be saved temporarily (by Saveset) but often
+ 				   we can simply forget the set-value when we
+ 				   have finished using it *)
+ 				if dropset then
+ 					dropset := false
+ 				else
+ 					write('Saveset(');
+ 				write('(Tmpset = Newset(), ');
+ 				tq := tp^.texps;
+ 				while tq <> nil do
+ 				    begin
+ 					case tq^.tt of
+ 					  nrange:
+ 					    begin
+ 						usemksub := true;
+ 						write(voidcast, 'Mksubr(');
+ 						write('(unsigned)(');
+ 						eexpr(tq^.texpl);
+ 						write('), ');
+ 						write('(unsigned)(');
+ 						eexpr(tq^.texpr);
+ 						write('), Tmpset)')
+ 					    end;
+ 					  nin, neq, nne, nlt, nle, ngt, nge,
+ 					  nor, nand, nmul, ndiv, nmod, nquot,
+ 					  nplus, nminus, nnot, numinus, nuplus, 
+ 					  nindex, nselect, nderef, ncall,
+ 					  ninteger, nchar, nid:
+ 					    begin
+ 						useins := true;
+ 						write(voidcast, 'Insmem(');
+ 						write('(unsigned)(');
+ 						eexpr(tq);
+ 						write('), Tmpset)')
+ 					    end
+ 					end;(* case *)
+ 					tq := tq^.tnext;
+ 					if tq <> nil then
+ 					    begin
+ 						writeln(',');
+ 						indent
+ 					    end
+ 				    end;
+ 				write(', Tmpset)');
+ 				if not flag then
+ 				    begin
+ 					write(')');
+ 					setused := true
+ 				    end;
+ 				decrement
+ 			     end;
+ 		  nnil:
+ 		    begin
+ 			tq := tp;
+ 			repeat
+ 				tq := tq^.tup
+ 			until	tq^.tt in [neq, nne, ncall, nassign, npgm];
+ 			if tq^.tt in [neq, nne] then
+ 			    begin
+ 				if typeof(tq^.texpl) = typnods[tnil] then
+ 					tq := typeof(tq^.texpr)
+ 				else
+ 					tq := typeof(tq^.texpl);
+ 				if tq^.tt = nptr then
+ 				    begin
+ 					write('(');
+ 					etypedef(tq);
+ 					write(')')
+ 				    end
+ 			    end;
+ 			write('NIL')
+ 		    end;
+ 		end;(* case *)
+ 	999:
+ 	end;	(* eexpr *)
+ 
+ 	(*	Emit constant definitions.				*)
+ 	procedure econst(tp : treeptr);
+ 
+ 	var	sp	: symptr;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			sp := tp^.tidl^.tsym;
+ 			if sp^.lid^.inref > 1 then
+ 				sp^.lid := mkrename('X', sp^.lid);
+ 			if tp^.tbind^.tt = nstring then
+ 			    begin
+ 				(* string constants emitted as
+ 				   static local variables *)
+ 				indent;
+ 				write(static, chartyp, tab1);
+ 				printid(sp^.lid);
+ 				write('[]	= ');
+ 				eexpr(tp^.tbind);
+ 				writeln(';')
+ 			    end
+ 			else begin
+ 				(* all other constants emitted as
+ 				   preprocessor # defines *)
+ 				write(define);
+ 				printid(sp^.lid);
+ 				write(space);
+ 				eexpr(tp^.tbind);
+ 				writeln
+ 			    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* econst *)
+ 
+ 	(*	Emit a typedef.						*)
+ 	procedure etypedef;
+ 
+ 		(*	Workhorse for etypedef, this procedure also	*)
+ 		(*	renames all fields in record-unions when	*)
+ 		(*	necessary.					*)
+ 		procedure etdef(uid : idptr; tp : treeptr);
+ 
+ 		var	i	: integer;
+ 			tq	: treeptr;
+ 
+ 			(*	Emit definition for an integer subrange	*)
+ 			(*	using data from worddefs set up during	*)
+ 			(*	initialization.				*)
+ 			procedure etrange(tp : treeptr);
+ 
+ 			label	999;
+ 
+ 			var	lo, hi	: integer;
+ 				i	: 1 .. maxmachdefs;
+ 
+ 			begin
+ 				lo := clower(tp);
+ 				hi := cupper(tp);
+ 				(* scan CPU word definitions for a type
+ 				   enclosing wanted range *)
+ 				for i := 1 to nmachdefs do
+ 				    with machdefs[i] do
+ 					if (lo >= lolim) and (hi <= hilim) then
+ 					    begin
+ 						(* found it, print type name *)
+ 						printtok(typstr);
+ 						goto 999
+ 					    end;
+ 				fatal(erange);
+ 			999:
+ 			end;
+ 
+ 			(*	Print last component of identifier.	*)
+ 			procedure printsuf(ip : idptr);
+ 
+ 			var	w	: toknbuf;
+ 				i, j	: toknidx;
+ 
+ 			begin
+ 				gettokn(ip^.istr, w);
+ 				i := 1;
+ 				j := i;
+ 				while w[i] <> chr(null) do
+ 				    begin
+ 					if w[i] = '.' then
+ 						j := i;
+ 					i := i + 1
+ 				    end;
+ 				if w[j] = '.' then
+ 					j := j + 1;
+ 				while w[j] <> chr(null) do
+ 				    begin
+ 					write(w[j]);
+ 					j := j + 1
+ 				    end
+ 			end;
+ 
+ 		begin	(* etdef *)
+ 			case tp^.tt of
+ 			  nid:
+ 				printid(tp^.tsym^.lid);
+ 			  nptr:
+ 			    begin
+ 				tq := typeof(tp^.tptrid);
+ 				if tq^.tt = nrecord then
+ 				    begin
+ 					write('struct ');
+ 					printid(tq^.tuid)
+ 				    end
+ 				else
+ 					printid(tp^.tptrid^.tsym^.lid);
+ 				write(' *');
+ 			    end;
+ 			  nscalar:
+ 			    begin
+ 				write('enum { ');
+ 				increment;
+ 				tp := tp^.tscalid;
+ 
+ 				(* avoid bug in C-compiler:
+ 					   enums are mixed in same namespace *)
+ 				if tp^.tsym^.lid^.inref > 1 then
+ 					tp^.tsym^.lid :=
+ 						mkrename('E', tp^.tsym^.lid);
+ 				printid(tp^.tsym^.lid);
+ 				i := 1;
+ 				while tp^.tnext <> nil do
+ 				    begin
+ 					if i >= 4 then
+ 					    begin
+ 						writeln(',');
+ 						indent;
+ 						i := 1
+ 					    end
+ 					else begin
+ 						write(', ');
+ 						i := i + 1
+ 					     end;
+ 					tp := tp^.tnext;
+ 					if tp^.tsym^.lid^.inref > 1 then
+ 					    tp^.tsym^.lid :=
+ 						mkrename('E', tp^.tsym^.lid);
+ 					printid(tp^.tsym^.lid)
+ 				    end;
+ 				decrement;
+ 				write(' } ')
+ 			    end;
+ 			  nsubrange:
+ 			    begin
+ 				tq := typeof(tp^.tlo);
+ 				if tq = typnods[tinteger] then
+ 					etrange(tp)
+ 				else begin
+ 					if tq^.tup^.tt = ntype then
+ 						tq := tq^.tup^.tidl;
+ 					etdef(nil, tq)
+ 				     end
+ 			    end;
+ 			  nfield:
+ 			    begin
+ 				etdef(nil, tp^.tbind);
+ 				write(tab1);
+ 				tp := tp^.tidl;
+ 				if uid <> nil then
+ 					tp^.tsym^.lid :=
+ 						mkconc('.', uid, tp^.tsym^.lid);
+ 				printsuf(tp^.tsym^.lid);
+ 				i := 1;
+ 				while tp^.tnext <> nil do
+ 				    begin
+ 					if i >= 4 then
+ 					    begin
+ 						writeln(',');
+ 						indent;
+ 						write(tab1);
+ 						i := 1
+ 					    end
+ 					else begin
+ 						write(', ');
+ 						i := i + 1
+ 					     end;
+ 					tp := tp^.tnext;
+ 					if uid <> nil then
+ 					    tp^.tsym^.lid :=
+ 						mkconc('.', uid, tp^.tsym^.lid);
+ 					printsuf(tp^.tsym^.lid);
+ 				    end;
+ 				writeln(';');
+ 			    end;
+ 			  nrecord:
+ 			    begin
+ 				write('struct ');
+ 				if tp^.tuid = nil then
+ 					tp^.tuid := uid
+ 				else if uid = nil then
+ 					printid(tp^.tuid);
+ 				writeln(' {');
+ 				increment;
+ 				if (tp^.tflist = nil) and
+ 							(tp^.tvlist = nil) then
+ 				    begin
+ 					(* C doesn't allow empty structures *)
+ 					indent;
+ 					writeln(inttyp, tab1, 'dummy;')
+ 				    end;
+ 				tq := tp^.tflist;
+ 				while tq <> nil do
+ 				    begin
+ 					indent;
+ 					etdef(uid, tq);
+ 					tq := tq^.tnext
+ 				    end;
+ 				if tp^.tvlist <> nil then
+ 				    begin
+ 					indent;
+ 					writeln('union {');
+ 					increment;
+ 					tq := tp^.tvlist;
+ 					while tq <> nil do
+ 					    begin
+ 						if (tq^.tvrnt^.tflist <> nil) or
+ 						 (tq^.tvrnt^.tvlist <> nil) then
+ 						    begin
+ 							indent;
+ 							if uid = nil then
+ 							    etdef(mkvrnt,
+ 								tq^.tvrnt)
+ 							else
+ 							    etdef(mkconc('.',
+ 								   uid, mkvrnt),
+ 								tq^.tvrnt);
+ 							writeln(';')
+ 						    end;
+ 						tq := tq^.tnext
+ 					    end;
+ 					decrement;
+ 					indent;
+ 					writeln('} U;');
+ 				    end;
+ 				decrement;
+ 				indent;
+ 				if tp^.tup^.tt = nvariant then
+ 				    begin
+ 					write('} ');
+ 					printsuf(tp^.tuid)
+ 				    end
+ 				else
+ 					write('}');
+ 			    end;
+ 			  nconfarr:
+ 			    begin
+ 				write('struct ');
+ 				printid(tp^.tcuid);
+ 				write(' { ');
+ 				etdef(nil, tp^.tcelem);
+ 				write(tab1, 'A[]; }')
+ 			    end;
+ 			  narray:
+ 			    begin
+ 				write('struct { ');
+ 				etdef(nil, tp^.taelem);
+ 				write(tab1, 'A[');
+ 				tq := typeof(tp^.taindx);
+ 				if tq^.tt = nsubrange then
+ 				    begin
+ 					if arithexpr(tq^.thi) then
+ 					    begin
+ 						eexpr(tq^.thi);
+ 						if cvalof(tq^.tlo) <> 0 then
+ 						    begin
+ 							write(' - ');
+ 							eexpr(tq^.tlo)
+ 						    end
+ 					    end
+ 					else begin
+ 						write('(int)(');
+ 						eexpr(tq^.thi);
+ 						if cvalof(tq^.tlo) <> 0 then
+ 						    begin
+ 							write(') - (int)(');
+ 							eexpr(tq^.tlo)
+ 						    end;
+ 						write(')')
+ 					     end;
+ 					write(' + 1')
+ 				    end
+ 				else
+ 					write(crange(tp^.taindx):1);
+ 				write(']; }')
+ 			    end;
+ 			  nfileof:
+ 			    begin
+ 				writeln('struct {');
+ 				indent;
+ 				writeln(tab1, 'FILE', tab1, '*fp;');
+ 				indent;
+ 				writeln(tab1, filebits, tab1, 'eoln:1,');
+ 				indent;
+ 				writeln(tab3, 'eof:1,');
+ 				indent;
+ 				writeln(tab3, 'out:1,');
+ 				indent;
+ 				writeln(tab3, 'init:1,');
+ 				indent;
+ 				writeln(tab3, ':', filefill:1, ';');
+ 				indent;
+ 				write(tab1);
+ 				etdef(nil, tp^.tof);
+ 				writeln(tab1, 'buf;');
+ 				indent;
+ 				write('} ')
+ 			    end;
+ 			  nsetof:
+ 				write('struct { ', setwtyp, tab1, 'S[',
+ 							csetsize(tp):1, ']; }');
+ 			  npredef:
+ 			    begin
+ 				case tp^.tobtyp of
+ 				  tboolean:
+ 					printid(defnams[dboolean]^.lid);
+ 				  tchar:
+ 					write(chartyp);
+ 				  tinteger:
+ 					printid(defnams[dinteger]^.lid);
+ 				  treal:
+ 					printid(defnams[dreal]^.lid);
+ 				  tstring:
+ 					write(chartyp, ' *');
+ 				  ttext:
+ 					write('text');
+ 				  tnil,
+ 				  tset,
+ 				  terror:
+ 					fatal(etree);
+ 				  tnone:
+ 					write(voidtyp);
+ 				end (* case *)
+ 			    end;
+ 			  nempty:
+ 				write(voidtyp);
+ 			end;(* case *)
+ 		end;	(* etdef *)
+ 	begin
+ 		etdef(nil, tp)
+ 	end;	(* etypedef *)
+ 
+ 	(*	Emit code for type declarations.			*)
+ 	procedure etype(tp : treeptr);
+ 
+ 	var	sp	: symptr;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			(* if identifier used more than once we rename the type
+ 			   to avoid typedef'ing an identifier twice *)
+ 			sp := tp^.tidl^.tsym;
+ 			if sp^.lid^.inref > 1 then
+ 				sp^.lid := mkrename('Y', sp^.lid);
+ 			indent;
+ 			write(typdef);
+ 			etypedef(tp^.tbind);
+ 			write(tab1);
+ 			printid(sp^.lid);
+ 			writeln(';');
+ 			tp := tp^.tnext
+ 		    end
+ 	end;
+ 
+ 	(*	Emit code for variable declarations.			*)
+ 	procedure evar(tp : treeptr);
+ 
+ 	label	555;
+ 
+ 	var	tq	: treeptr;
+ 		i	: integer;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			indent;
+ 			case tp^.tt of
+ 			  nvar,
+ 			  nvalpar,
+ 			  nvarpar:
+ 			    begin
+ 				if tp^.tattr = aregister then
+ 					write(registr);
+ 				etypedef(tp^.tbind)
+ 			    end;
+ 			  nparproc,
+ 			  nparfunc:
+ 			    begin
+ 				if tp^.tt = nparproc then
+ 					write(voidtyp)
+ 				else
+ 					etypedef(tp^.tpartyp);
+ 				tq := tp^.tparid;
+ 				write(tab1, '(*');
+ 				printid(tq^.tsym^.lid);
+ 				write(')()');
+ 				goto 555
+ 			    end
+ 			end;(* case *)
+ 			write(tab1);
+ 			tq := tp^.tidl;
+ 			i := 1;
+ 			repeat
+ 				if tp^.tt = nvarpar then
+ 					write('*');
+ 				printid(tq^.tsym^.lid);
+ 				tq := tq^.tnext;
+ 				if tq <> nil then
+ 				    begin
+ 					if i >= 6 then
+ 					    begin
+ 						i := 1;
+ 						writeln(',');
+ 						indent;
+ 						write(tab1)
+ 					    end
+ 					else begin
+ 						i := i + 1;
+ 						write(', ')
+ 					     end
+ 
+ 				    end
+ 			until	tq = nil;
+ 		555:
+ 			writeln(';');
+ 			if tp^.tt = nvarpar then
+ 				if tp^.tbind^.tt = nconfarr then
+ 				    begin
+ 					indent;
+ 					etypedef(tp^.tbind^.tindtyp);
+ 					write(tab1);
+ 					tq := tp^.tbind^.tcindx^.thi;
+ 					printid(tq^.tsym^.lid);
+ 					writeln(';')
+ 				    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* evar *)
+ 
+ 	(*	Emit code for a statment.				*)
+ 	procedure estmt(tp : treeptr);
+ 
+ 	var	tq	: treeptr;
+ 		locid1,
+ 		locid2	: idptr;
+ 		stusd	: boolean;
+ 		opc1,
+ 		opc2	: char;
+ 
+ 		(*	Emit typename for with-variable.		*)
+ 		procedure ewithtype(tp : treeptr);
+ 
+ 		var	tq	: treeptr;
+ 
+ 		begin
+ 			tq := typeof(tp);
+ 			write('struct ');
+ 			printid(tq^.tuid)
+ 		end;
+ 
+ 		(*	Emit code for a case-choise.		*)
+ 		procedure echoise(tp : treeptr);
+ 
+ 		var	tq	: treeptr;
+ 			i	: integer;
+ 
+ 		begin
+ 			while tp <> nil do
+ 			    begin
+ 				tq := tp^.tchocon;
+ 				i := 0;
+ 				indent;
+ 				while tq <> nil do
+ 				    begin
+ 					write('  case ');
+ 					conflag := true;
+ 					eexpr(tq);
+ 					conflag := false;
+ 					write(':');
+ 					i := i + 1;
+ 					tq := tq^.tnext;
+ 					if (tq = nil) or (i mod 4 = 0) then
+ 					    begin
+ 						writeln;
+ 						if tq <> nil then
+ 							indent;
+ 						i := 0
+ 					    end
+ 				    end;
+ 				increment;
+ 				if tp^.tchostmt^.tt = nbegin then
+ 					estmt(tp^.tchostmt^.tbegin)
+ 				else
+ 					estmt(tp^.tchostmt);
+ 				indent;
+ 				writeln('break ;');
+ 				decrement;
+ 				tp := tp^.tnext;
+ 				if tp <> nil then
+ 					if tp^.tchocon = nil then
+ 						tp := nil
+ 			    end
+ 		end;	(* echoise *)
+ 
+ 		(*	Rename all accessible record-fields to include	*)
+ 		(*	pointer name.					*)
+ 		procedure cenv(ip : idptr; dp : declptr);
+ 
+ 		var	tp	: treeptr;
+ 			sp	: symptr;
+ 			np	: idptr;
+ 			h	: hashtyp;
+ 
+ 		begin
+ 			with dp^ do
+ 			  for h := 0 to hashmax - 1 do
+ 			    begin
+ 				sp := ddecl[h];
+ 				while sp <> nil do
+ 				    begin
+ 					if sp^.lt = lfield  then
+ 					    begin
+ 						np := sp^.lid;
+ 						tp := sp^.lsymdecl^.tup^.tup;
+ 						if (tp^.tup^.tt = nvariant) and
+ 							(tp^.tuid <> nil) then
+ 							np := mkconc('.',
+ 								tp^.tuid, np);
+ 						np := mkconc('>', ip, np);
+ 						sp^.lid := np
+ 					    end;
+ 					sp := sp^.lnext
+ 				    end
+ 			    end
+ 		end;	(* cenv *)
+ 
+ 		(*	Emit identifiers for push/pop of global ptrs.	*)
+ 		procedure eglobid(tp : treeptr);
+ 
+ 		var	j	: toknidx;
+ 			w	: toknbuf;
+ 
+ 		begin
+ 			gettokn(tp^.tsym^.lid^.istr, w);
+ 			j := 1;
+ 			if w[1] = '*' then
+ 				j := 2;
+ 			while w[j] <> chr(null) do
+ 			    begin
+ 				write(w[j]);
+ 				j := j + 1
+ 			    end
+ 		end;
+ 
+ 	begin	(* estmt *)
+ 		while tp <> nil do
+ 		    begin
+ 			case tp^.tt of
+ 			  nbegin:
+ 			    begin
+ 				if tp^.tup^.tt in [nbegin, nrepeat,
+ 						nproc, nfunc, npgm] then
+ 					indent;
+ 				writeln('{');
+ 				increment;
+ 				estmt(tp^.tbegin);
+ 				decrement;
+ 				indent;
+ 				write('}');
+ 				if tp^.tup^.tt <> nif then
+ 					writeln
+ 			    end;
+ 			  nrepeat:
+ 			    begin
+ 				indent;
+ 				writeln('do {');
+ 				increment;
+ 				estmt(tp^.treptstmt);
+ 				decrement;
+ 				indent;
+ 				write('} while (!(');
+ 				eexpr(tp^.treptxp);
+ 				writeln('));')
+ 			    end;
+ 			  nwhile:
+ 			    begin
+ 				indent;
+ 				write('while (');
+ 				increment;
+ 				eexpr(tp^.twhixp);
+ 				stusd := setused;
+ 				if tp^.twhistmt^.tt = nbegin then
+ 				    begin
+ 					decrement;
+ 					write(') ');
+ 					estmt(tp^.twhistmt)
+ 				    end
+ 				else begin
+ 					writeln(')');
+ 					estmt(tp^.twhistmt);
+ 					decrement
+ 				     end;
+ 				setused := stusd or setused
+ 			    end;
+ 			  nfor:
+ 			    begin
+ 				indent;
+ 				if tp^.tincr then
+ 				    begin
+ 					opc1 := '+';	(* increment variable *)
+ 					opc2 := '<'	(* test for <= *)
+ 				    end
+ 				else begin
+ 					opc1 := '-';	(* decrement variable *)
+ 					opc2 := '>';	(* test for >= *)
+ 				     end;
+ 				if not lazyfor then
+ 				    begin
+ 					locid1 := mkvariable('B');
+ 					locid2 := mkvariable('B');
+ 					writeln('{');
+ 					increment;
+ 					indent;
+ 					tq := idup(tp^.tforid);
+ 					etypedef(tq^.tbind);
+ 					tq := typeof(tq^.tbind);
+ 					write(tab1);
+ 					printid(locid1);
+ 					write(' = ');
+ 					eexpr(tp^.tfrom);
+ 					writeln(',');
+ 					indent;
+ 					write(tab1);
+ 					printid(locid2);
+ 					write(' = ');
+ 					eexpr(tp^.tto);
+ 					writeln(';');
+ 					writeln;
+ 					indent;
+ 					write('if (');
+ 					if tq^.tt = nscalar then
+ 					    begin
+ 						write('(int)(');
+ 						printid(locid1);
+ 						write(')')
+ 					    end
+ 					else
+ 						printid(locid1);
+ 					write(' ', opc2, '= ');
+ 					if tq^.tt = nscalar then
+ 					    begin
+ 						write('(int)(');
+ 						printid(locid2);
+ 						write(')')
+ 					    end
+ 					else
+ 						printid(locid2);
+ 					writeln(')');
+ 					increment;
+ 					indent;
+ 					tp^.tfrom := newid(locid1);
+ 					tp^.tfrom^.tup := tp
+ 				    end;
+ 				write('for (');
+ 				increment;
+ 				eexpr(tp^.tforid);
+ 				tq := typeof(tp^.tforid);
+ 				write(' = ');
+ 				eexpr(tp^.tfrom);
+ 				write('; ');
+ 				if lazyfor then
+ 				    begin
+ 					if tq^.tt = nscalar then
+ 					    begin
+ 						write('(int)(');
+ 						eexpr(tp^.tforid);
+ 						write(')')
+ 					    end
+ 					else
+ 						eexpr(tp^.tforid);
+ 					write(' ', opc2, '= ');
+ 					if tq^.tt = nscalar then
+ 					    begin
+ 						write('(int)(');
+ 						eexpr(tp^.tto);
+ 						write(')')
+ 					    end
+ 					else
+ 						eexpr(tp^.tto)
+ 				    end;
+ 				write('; ');
+ 				eexpr(tp^.tforid);
+ 				if tq^.tt = nscalar then
+ 				    begin
+ 					write(' = (');
+ 					eexpr(tq^.tup^.tidl);
+ 					write(')((int)(');
+ 					eexpr(tp^.tforid);
+ 					write(')', opc1, '1)')
+ 				    end
+ 				else
+ 					write(opc1, opc1);
+ 				if not lazyfor then
+ 				    begin
+ 					if tp^.tforstmt^.tt <> nbegin then
+ 					    begin
+ 						(* create compund stmt *)
+ 						tq := mknode(nbegin);
+ 						tq^.tbegin := tp^.tforstmt;
+ 						tq^.tbegin^.tup := tq;
+ 						tp^.tforstmt := tq;
+ 						tq^.tup := tp
+ 					    end;
+ 					(* find end of loop *)
+ 					tq := tp^.tforstmt^.tbegin;
+ 					while tq^.tnext <> nil do
+ 						tq := tq^.tnext;
+ 					(* add break stmt *)
+ 					tq^.tnext := mknode(nbreak);
+ 					tq := tq^.tnext;
+ 					tq^.tup := tp^.tforstmt;
+ 					tq^.tbrkid := tp^.tforid;
+ 					tq^.tbrkxp := newid(locid2);
+ 					tq^.tbrkxp^.tup := tq
+ 				    end;
+ 				if tp^.tforstmt^.tt = nbegin then
+ 				    begin
+ 					decrement;
+ 					write(') ');
+ 					estmt(tp^.tforstmt)
+ 				    end
+ 				else begin
+ 					writeln(')');
+ 					estmt(tp^.tforstmt);
+ 					decrement
+ 				     end;
+ 				if not lazyfor then
+ 				    begin
+ 					decrement;
+ 					decrement;
+ 					indent;
+ 					writeln('}')
+ 				    end
+ 			    end;
+ 			  nif:
+ 			    begin
+ 				indent;
+ 				write('if (');
+ 				increment;
+ 				eexpr(tp^.tifxp);
+ 				stusd := setused;
+ 				setused := false;
+ 				if tp^.tthen^.tt = nbegin then
+ 				    begin
+ 					decrement;
+ 					write(') ');
+ 					estmt(tp^.tthen);
+ 					if tp^.telse <> nil then
+ 						write(space)
+ 					else
+ 						writeln
+ 				    end
+ 				else begin
+ 					writeln(')');
+ 					estmt(tp^.tthen);
+ 					decrement;
+ 					if tp^.telse <> nil then
+ 						indent
+ 				     end;
+ 				if tp^.telse <> nil then
+ 				    begin
+ 					write('else');
+ 					if tp^.telse^.tt = nbegin then
+ 					    begin
+ 						write(space);
+ 						estmt(tp^.telse);
+ 						writeln
+ 					    end
+ 					else begin
+ 						increment;
+ 						writeln;
+ 						estmt(tp^.telse);
+ 						decrement
+ 					     end;
+ 				    end;
+ 				setused := stusd or setused
+ 			    end;
+ 			  ncase:
+ 			    begin
+ 				indent;
+ 				write('switch (');
+ 				increment;
+ 				eexpr(tp^.tcasxp);
+ 				writeln(') {');
+ 				decrement;
+ 				echoise(tp^.tcaslst);
+ 				indent;
+ 				writeln('  default:');
+ 				increment;
+ 				if tp^.tcasother = nil then
+ 				    begin
+ 					indent;
+ 					writeln('Caseerror(Line);')
+ 				    end
+ 				else
+ 					estmt(tp^.tcasother);
+ 				decrement;
+ 				indent;
+ 				writeln('}')
+ 			    end;
+ 			  nwith:
+ 			    begin
+ 				indent;
+ 				writeln('{');
+ 				increment;
+ 				tq := tp^.twithvar;
+ 				while tq <> nil do
+ 				    begin
+ 					indent;
+ 					write(registr);
+ 					ewithtype(tq^.texpw);
+ 					write(' *');
+ 					locid1 := mkvariable('W');
+ 					printid(locid1);
+ 					write(' = ');
+ 					eaddr(tq^.texpw);
+ 					writeln(';');
+ 					cenv(locid1, tq^.tenv);
+ 					tq := tq^.tnext
+ 				    end;
+ 				writeln;
+ 				if tp^.twithstmt^.tt = nbegin then
+ 					estmt(tp^.twithstmt^.tbegin)
+ 				else
+ 					estmt(tp^.twithstmt);
+ 				decrement;
+ 				indent;
+ 				writeln('}')
+ 			    end;
+ 			  ngoto:
+ 			    begin
+ 				indent;
+ 				if islocal(tp^.tlabel) then
+ 					writeln('goto L',
+ 						tp^.tlabel^.tsym^.lno:1, ';')
+ 				else begin
+ 					tq := idup(tp^.tlabel);
+ 					writeln('longjmp(J[',	(* LIB *)
+ 						tq^.tstat:1, '].jb, ',
+ 						tp^.tlabel^.tsym^.lno:1, ');')
+ 				     end
+ 			    end;
+ 			  nlabstmt:
+ 			    begin
+ 				decrement;
+ 				indent;
+ 				writeln('L', tp^.tlabno^.tsym^.lno:1, ':');
+ 				increment;
+ 				estmt(tp^.tstmt)
+ 			    end;
+ 			  nassign:
+ 			    begin
+ 				indent;
+ 				eexpr(tp);
+ 				writeln(';')
+ 			    end;
+ 			  ncall:
+ 			    begin
+ 				indent;
+ 				tq := idup(tp^.tcall);
+ 				if (tq^.tt in [nfunc, nproc]) and
+ 						(tq^.tsubstmt <> nil) then
+ 					if tq^.tsubstmt^.tt = npredef then
+ 						epredef(tq, tp)
+ 					else begin
+ 						ecall(tp);
+ 						writeln(';')
+ 					     end
+ 				else begin
+ 					ecall(tp);
+ 					writeln(';')
+ 				     end
+ 			    end;
+ 			  npush:
+ 			    begin
+ 				indent;
+ 				eglobid(tp^.ttmp);
+ 				write(' = ');
+ 				eglobid(tp^.tglob);
+ 				writeln(';');
+ 				indent;
+ 				eglobid(tp^.tglob);
+ 				write(' = ');
+ 				if tp^.tloc^.tt = nid then
+ 				    begin
+ 					tq := idup(tp^.tloc);
+ 					if tq^.tt in [nparproc, nparfunc] then
+ 						printid(tp^.tloc^.tsym^.lid)
+ 					else
+ 						eaddr(tp^.tloc)
+ 				    end
+ 				else
+ 					eaddr(tp^.tloc);
+ 				writeln(';')
+ 			    end;
+ 			  npop:
+ 			    begin
+ 				indent;
+ 				eglobid(tp^.tglob);
+ 				write(' = ');
+ 				eglobid(tp^.ttmp);
+ 				writeln(';')
+ 			    end;
+ 			  nbreak:
+ 			    begin
+ 				indent;
+ 				write('if (');
+ 				eexpr(tp^.tbrkid);
+ 				write(' == ');
+ 				eexpr(tp^.tbrkxp);
+ 				writeln(') break;')
+ 			    end;
+ 			  nempty:
+ 				if not (tp^.tup^.tt in [npgm, nproc, nfunc,
+ 						nchoise, nbegin, nrepeat]) then
+ 				    begin
+ 					indent;
+ 					writeln(';')
+ 				    end
+ 			end;(* case *)
+ 			if setused and
+ 				(tp^.tup^.tt in [npgm, nproc, nfunc, nrepeat,
+ 						nbegin, nchoise, nwith]) then
+ 			    begin
+ 				indent;
+ 				writeln('Claimset();');
+ 				setused := false
+ 			    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* estmt *)
+ 
+ 	(*	Emit initialization for non-local gotos.		*)
+ 	procedure elabel(tp : treeptr);
+ 
+ 	var	tq	: treeptr;
+ 		i	: integer;
+ 
+ 	begin
+ 		i := 0;
+ 		tq := tp^.tsublab;
+ 		while tq <> nil do
+ 		    begin
+ 			if tq^.tsym^.lgo then
+ 				i := i + 1;
+ 			tq := tq^.tnext
+ 		    end;
+ 		if i =1 then
+ 		    begin
+ 			tq := tp^.tsublab;
+ 			while not tq^.tsym^.lgo do
+ 				tq := tq^.tnext;
+ 			indent;
+ 			writeln('if (',
+ 				'setjmp(J[', tp^.tstat:1, '].jb))'); (* LIB *)
+ 			writeln(tab1, 'goto L', tq^.tsym^.lno:1, ';')
+ 		    end
+ 		else if i > 1 then
+ 		    begin
+ 			indent;
+ 			writeln('switch (',
+ 				'setjmp(J[', tp^.tstat:1, '].jb)) {'); (* LIB *)
+ 			indent;
+ 			writeln('  case 0:');
+ 			indent;
+ 			writeln(tab1, 'break');
+ 			tq := tp^.tsublab;
+ 			while tq <> nil do
+ 			    begin
+ 				if tq^.tsym^.lgo then
+ 				    begin
+ 					(* label used in non-local goto *)
+ 					indent;
+ 					writeln('  case ',
+ 							tq^.tsym^.lno:1, ':');
+ 					indent;
+ 					writeln(tab1, 'goto L',
+ 							tq^.tsym^.lno:1, ';')
+ 				    end;
+ 				tq := tq^.tnext
+ 			    end;
+ 			indent;
+ 			writeln('  default:');
+ 			indent;
+ 			writeln(tab1, 'Caseerror(Line)');
+ 			indent;
+ 			writeln('}')
+ 		    end
+ 	end;	(* elabel *)
+ 
+ 	(*	Emit declaration for lower bound of conformant array.	*)
+ 	procedure econf(tp : treeptr);
+ 
+ 	var	tq	: treeptr;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			if tp^.tt = nvarpar then
+ 				if tp^.tbind^.tt = nconfarr then
+ 				    begin
+ 					indent;
+ 					etypedef(tp^.tbind^.tindtyp);
+ 					write(tab1);
+ 					tq := tp^.tbind^.tcindx^.tlo;
+ 					printid(tq^.tsym^.lid);
+ 					write(' = (');
+ 					etypedef(tp^.tbind^.tindtyp);
+ 					writeln(')0;')
+ 				    end;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* econf *)
+ 
+ 	(*	Emit code for subroutines.				*)
+ 	procedure esubr(tp : treeptr);
+ 
+ 	label	999;
+ 
+ 	var	tq, ti	: treeptr;
+ 
+ 	begin
+ 		while tp <> nil do
+ 		    begin
+ 			(* emit nested subroutines *)
+ 			if tp^.tsubsub <> nil then
+ 			    begin
+ 				(* emit forward declaration of this subroutine
+ 				   in case of recursion *)
+ 				etypedef(tp^.tfuntyp);
+ 				write(space);
+ 				printid(tp^.tsubid^.tsym^.lid);
+ 				writeln('();');
+ 				writeln;
+ 				esubr(tp^.tsubsub)
+ 			    end;
+ 			(* emit this subroutine *)
+ 			if tp^.tsubstmt = nil then
+ 			    begin
+ 				(* forward/external decl *)
+ 				if tp^.tsubid^.tsym^.lsymdecl^.tup = tp then
+ 					write(xtern);
+ 				etypedef(tp^.tfuntyp);
+ 				write(space);
+ 				printid(tp^.tsubid^.tsym^.lid);
+ 				writeln('();');
+ 				goto 999
+ 			    end;
+ 			write(space);
+ 			etypedef(tp^.tfuntyp);
+ 			writeln;
+ 			printid(tp^.tsubid^.tsym^.lid);
+ 			write('(');
+ 			tq := tp^.tsubpar;
+ 			while tq <> nil do
+ 			    begin
+ 				case tq^.tt of
+ 				  nvarpar,
+ 				  nvalpar:
+ 				    begin
+ 					ti := tq^.tidl;
+ 					while ti <> nil do
+ 					    begin
+ 						printid(ti^.tsym^.lid);
+ 						ti := ti^.tnext;
+ 						if ti <> nil then
+ 							write(', ');
+ 					    end;
+ 					if tq^.tbind^.tt = nconfarr then
+ 					    begin
+ 						(* add upper bound parameter *)
+ 						ti := tq^.tbind^.tcindx^.thi;
+ 						write(', ');
+ 						printid(ti^.tsym^.lid)
+ 					    end;
+ 				    end;
+ 				  nparproc,
+ 				  nparfunc:
+ 				    begin
+ 					ti := tq^.tparid;
+ 					printid(ti^.tsym^.lid)
+ 				    end
+ 				end;(* case *)
+ 				tq := tq^.tnext;
+ 				if tq <> nil then
+ 					write(', ');
+ 			    end;
+ 			writeln(')');
+ 			increment;
+ 			evar(tp^.tsubpar);
+ 			writeln('{');
+ 			econf(tp^.tsubpar);
+ 			econst(tp^.tsubconst);
+ 			etype(tp^.tsubtype);
+ 			evar(tp^.tsubvar);
+ 
+ 			if (tp^.tsubconst <> nil) or (tp^.tsubtype <> nil) or
+ 					(tp^.tsubvar <> nil) then
+ 				writeln;
+ 			elabel(tp);
+ 			estmt(tp^.tsubstmt);
+ 			if tp^.tt = nfunc then
+ 			    begin
+ 				(* return value in the FIRST variable,
+ 				   see renamf() above *)
+ 				indent;
+ 				write('return ');
+ 				printid(tp^.tsubvar^.tidl^.tsym^.lid);
+ 				writeln(';');
+ 			    end;
+ 			decrement;
+ 			writeln('}');
+ 		999:
+ 			writeln;
+ 			tp := tp^.tnext
+ 		    end
+ 	end;	(* esubr *)
+ 
+ 	function use(d : predefs) : boolean;
+ 
+ 	begin
+ 		use := defnams[d]^.lused
+ 	end;
+ 
+ 	(*	Emit code for main program.				*)
+ 	procedure eprogram(tp : treeptr);
+ 
+ 		(*	Symbol that sp refers to is renamed if it has	*)
+ 		(*	been redefined in source program.		*)
+ 		procedure capital(sp : symptr);
+ 
+ 		var	tb	: toknbuf;
+ 
+ 		begin
+ 			if sp^.lid^.inref > 1 then
+ 			    begin
+ 				gettokn(sp^.lid^.istr, tb);
+ 				tb[1] := uppercase(tb[1]);
+ 				sp^.lid := saveid(tb)
+ 			    end
+ 		end;
+ 
+ 		procedure etextdef;
+ 
+ 		var	tq	: treeptr;
+ 
+ 		begin
+ 			write('typedef ');
+ 			tq := mknode(nfileof);
+ 			tq^.tof := typnods[tchar];
+ 			etypedef(tq);
+ 			writeln(tab1, 'text;')
+ 		end;
+ 
+ 	begin	(* eprogram *)
+ 		if tp^.tsubid <> nil then
+ 		    begin
+ 			(* program heading was seen *)
+ 			writeln('/', '*');
+ 			write('**	Code derived from program ');
+ 			printid(tp^.tsubid^.tsym^.lid);
+ 			writeln;
+ 			writeln('*', '/');
+ 			writeln(xtern, voidtyp, tab1, 'exit();')
+ 		    end;
+ 		if usecase or usesets or
+ 		   use(dinput) or use(doutput) or
+ 		   use(dwrite) or use(dwriteln) or use(dmessage) or
+ 		   use(deof) or use(deoln) or use(dflush) or use(dpage) or
+ 		   use(dread) or use(dreadln) or use(dclose) or
+ 		   use(dreset) or use(drewrite) or use(dget) or use(dput) then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for i/o');
+ 			writeln('*', '/');
+ 			writeln(include, '<stdio.h>')	(* LIB *)
+ 		    end;
+ 		if use(dinput) or use(doutput) or use(dtext) then
+ 		    begin
+ 			etextdef;
+ 			if use(dinput) then
+ 			    begin
+ 				if tp^.tsubid = nil then
+ 					write(xtern);
+ 				write('text', tab1);
+ 				printid(defnams[dinput]^.lid);
+ 				if tp^.tsubid <> nil then
+ 					write(' = { stdin, 0, 0 }');
+ 				writeln(';')
+ 			    end;
+ 			if use(doutput) then
+ 			    begin
+ 				if tp^.tsubid = nil then
+ 					write(xtern);
+ 				write('text', tab1);
+ 				printid(defnams[doutput]^.lid);
+ 				if tp^.tsubid <> nil then
+ 					write(' = { stdout, 0, 0 }');
+ 				writeln(';')
+ 			    end
+ 		    end;
+ 		if use(dinput) or use(dget) or use(dread) or use(dreadln) or
+ 		   use(deof) or use(deoln) or use(dreset) or use(drewrite) then
+ 		    begin
+ 			writeln(define, 'Fread(x, f) ',
+ 				'fread((char *)&x, sizeof(x), 1, f)'); (* LIB *)
+ 			writeln(define, 'Get(f) Fread((f).buf, (f).fp)');
+ 			writeln(define, 'Getx(f) (f).init = 1, ',
+ 				'(f).eoln = (((f).buf = ',
+ 					'fgetc((f).fp)',	(* LIB *)
+ 					') == ', nlchr, ') ? (((f).buf = ',
+ 						spchr, '), 1) : 0');
+ 			writeln(define, 'Getchr(f) (f).buf, Getx(f)')
+ 		    end;
+ 		if use(dread) or use(dreadln) then
+ 		    begin
+ 			writeln(static, 'FILE', tab1, '*Tmpfil;');
+ 			writeln(static, 'long', tab1, 'Tmplng;');
+ 			writeln(static, 'double', tab1, 'Tmpdbl;');
+ 			writeln(define, 'Fscan(f) (f).init ? ',
+ 				'ungetc((f).buf, (f).fp)',	(* LIB *)
+ 					' : 0, Tmpfil = (f).fp');
+ 			writeln(define, 'Scan(p, a) ',
+ 				'Scanck(fscanf(Tmpfil, p, a))'); (* LIB *)
+ 			writeln(voidtyp, tab1, 'Scanck();');
+ 			if use(dreadln) then
+ 				writeln(voidtyp, tab1, 'Getl();');
+ 		    end;
+ 		if use(deoln) then
+ 			writeln(define, 'Eoln(f) ((f).eoln ? true : false)');
+ 		if use(deof) then
+ 			writeln(define, 'Eof(f) ',
+ 				'((((f).init == 0) ? (Get(f)) : 0, ',
+ 					'((f).eof ? 1 : ',
+ 						'feof((f).fp))) ? ', (* LIB *)
+ 							'true : false)');
+ 		if use(doutput) or use(dput) or
+ 				use(dwrite) or use(dwriteln) or
+ 				use(dreset) or use(drewrite) or use(dclose) then
+ 		    begin
+ 			writeln(define, 'Fwrite(x, f) ',
+ 				'fwrite((char *)&x, sizeof(x), 1, f)');(* LIB *)
+ 			writeln(define, 'Put(f) Fwrite((f).buf, (f).fp)');
+ 			writeln(define, 'Putx(f) (f).eoln = ((f).buf == ',
+ 			    nlchr, '), ', voidcast,
+ 				'fputc((f).buf, (f).fp)'); (* LIB *)
+ 			writeln(define, 'Putchr(c, f) (f).buf = (c), Putx(f)');
+ 			writeln(define, 'Putl(f, v) (f).eoln = v')
+ 		    end;
+ 		if use(dreset) or use(drewrite) or use(dclose) then
+ 			writeln(define, 'Finish(f) ((f).out && !(f).eoln) ? ',
+ 				'(Putchr(', nlchr, ', f), 0) : 0, ',
+ 					'rewind((f).fp)');	(* LIB *)
+ 		if use(dclose) then
+ 		    begin
+ 			writeln(define, 'Close(f) (f).init = ',
+ 				'((f).init ? (',
+ 					'fclose((f).fp), ',	(* LIB *)
+ 						'0) : 0), (f).fp = NULL');
+ 			writeln(define, 'Closex(f) (f).init = ',
+ 				'((f).init ? ',
+ 					'(Finish(f), ',
+ 					'fclose((f).fp), ',	(* LIB *)
+ 						'0) : 0), (f).fp = NULL')
+ 		    end;
+ 		if use(dreset) then
+ 		    begin
+ 			writeln(ifdef, 'READONLY');
+ 			writeln(static, chartyp, tab1, 'Rmode[] = "r";');
+ 			writeln(elsif);
+ 			writeln(static, chartyp, tab1, 'Rmode[] = "r+";');
+ 			writeln(endif);
+ 			writeln(define, 'Reset(f, n) (f).init = ',
+ 			    '(f).init ? rewind((f).fp) : ',	(* LIB *)
+ 				'(((f).fp = Fopen(n, Rmode)), 1), ',
+ 					'(f).eof = (f).out = 0, Get(f)');
+ 			writeln(define, 'Resetx(f, n) (f).init = ',
+ 			    '(f).init ? (Finish(f)) : ',
+ 				'(((f).fp = Fopen(n, Rmode)), 1), ',
+ 					'(f).eof = (f).out = 0, Getx(f)');
+ 			usefopn := true
+ 		    end;
+ 		if use(drewrite) then
+ 		    begin
+ 			writeln(ifdef, 'WRITEONLY');
+ 			writeln(static, chartyp, tab1, 'Wmode[] = "w";');
+ 			writeln(elsif);
+ 			writeln(static, chartyp, tab1, 'Wmode[] = "w+";');
+ 			writeln(endif);
+ 			writeln(define, 'Rewrite(f, n) (f).init = ',
+ 			    '(f).init ? rewind((f).fp) : ',	(* LIB *)
+ 				'(((f).fp = Fopen(n, Wmode)), 1), ',
+ 					'(f).out = (f).eof = 1');
+ 			writeln(define, 'Rewritex(f, n) (f).init = ',
+ 			    '(f).init ? (Finish(f)) : ',
+ 				'(((f).fp = Fopen(n, Wmode)), 1), ',
+ 					'(f).out = (f).eof = (f).eoln = 1');
+ 			usefopn := true
+ 		    end;
+ 		if usefopn then
+ 		    begin
+ 			writeln('FILE	*Fopen();');
+ 			writeln(define, 'MAXFILENAME 256')
+ 		    end;
+ 		if usecase or usejmps then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for case-statements');
+ 			writeln('**	and for non-local gotos');
+ 			writeln('*', '/');
+ 			writeln(define, 'Line __LINE__');
+ 			writeln(voidtyp, tab1, 'Caseerror();')
+ 		    end;
+ 		if usejmps then
+ 		    begin
+ 			writeln(include, '<setjmp.h>');	(* LIB *)
+ 			writeln(static, 'struct Jb { jmp_buf', tab1, 'jb; } J[',
+ 							(maxlevel+1):1, '];')
+ 		    end;
+ 		if use(dinteger) or use(dmaxint) or 
+ 			use(dboolean) or use(dfalse) or use(dtrue) or
+ 				use(deof) or use(deoln) or use(dexp) or
+ 				use(dln) or use(dsqr) or use(dsin) or
+ 				use(dcos) or use(dtan) or use(darctan) or
+ 				use(dsqrt) or use(dreal) then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for standard types');
+ 			writeln('*', '/')
+ 		    end;
+ 		if usecomp then
+ 		    begin
+ 			writeln(xtern, inttyp, ' strncmp();');	(* LIB *)
+ 			writeln(define,
+ 				'Cmpstr(x, y) ',
+ 				'strncmp((x), (y), sizeof(x))')	(* LIB *)
+ 		    end;
+ 		if use(dboolean) or use(dfalse) or use(dtrue) or
+ 			use(deof) or use(deoln) or usesets then
+ 		    begin
+ 			capital(defnams[dboolean]);
+ 			write(typdef, chartyp, tab1);
+ 			printid(defnams[dboolean]^.lid);
+ 			writeln(';');
+ 			capital(defnams[dfalse]);
+ 			write(define);
+ 			printid(defnams[dfalse]^.lid);
+ 			write(' (');
+ 			printid(defnams[dboolean]^.lid);
+ 			writeln(')0');
+ 			capital(defnams[dtrue]);
+ 			write(define);
+ 			printid(defnams[dtrue]^.lid);
+ 			write(' (');
+ 			printid(defnams[dboolean]^.lid);
+ 			writeln(')1');
+ 			writeln(xtern, chartyp, tab1, '*Bools[];')
+ 		    end;
+ 		capital(defnams[dinteger]);
+ 		if use(dinteger) then
+ 		    begin
+ 			write(typdef, inttyp, tab1);
+ 			printid(defnams[dinteger]^.lid);
+ 			writeln(';')
+ 		    end;
+ 		if use(dmaxint) then
+ 			writeln(define, 'maxint', tab1, maxint:1);
+ 		capital(defnams[dreal]);
+ 		if use(dreal) then
+ 		    begin
+ 			write(typdef, realtyp, tab1);
+ 			printid(defnams[dreal]^.lid);
+ 			writeln(';')
+ 		    end;
+ 		if use(dexp) then
+ 			writeln(xtern, doubletyp, ' exp();');	(* LIB *)
+ 		if use(dln) then
+ 			writeln(xtern, doubletyp, ' log();');	(* LIB *)
+ 		if use(dsqr) then
+ 			writeln(xtern, doubletyp, ' pow();');	(* LIB *)
+ 		if use(dsin) then
+ 			writeln(xtern, doubletyp, ' sin();');	(* LIB *)
+ 		if use(dcos) then
+ 			writeln(xtern, doubletyp, ' cos();');	(* LIB *)
+ 		if use(dtan) then
+ 			writeln(xtern, doubletyp, ' tan();');	(* LIB *)
+ 		if use(darctan) then
+ 			writeln(xtern, doubletyp, ' atan();');	(* LIB *)
+ 		if use(dsqrt) then
+ 			writeln(xtern, doubletyp, ' sqrt();');	(* LIB *)
+ 		if use(dabs) and use(dreal) then
+ 			writeln(xtern, doubletyp, ' fabs();');	(* LIB *)
+ 		if use(dhalt) then
+ 			writeln(xtern, voidtyp, ' abort();');	(* LIB *)
+ 		if use(dnew) or usenilp then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for pointers');
+ 			writeln('*', '/');
+ 		    end;
+ 		if use(dnew) then
+ 		    begin
+ 			writeln(ifndef, 'Unionoffs');
+ 			writeln(define, 'Unionoffs(p, m) ',
+ 			    '(((long)(&(p)->m))-((long)(p)))');	(* CPU *)
+ 			writeln(endif)
+ 		    end;
+ 		if usenilp then
+ 			writeln(define, 'NIL 0');		(* CPU *)
+ 		if use(dnew) then
+ 			writeln(xtern, chartyp, ' *malloc();');	(* LIB *)
+ 		if use(ddispose) then
+ 			writeln(xtern, voidtyp, ' free();');	(* LIB *)
+ 		if usesets then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for set-operations');
+ 			writeln('*', '/');
+ 			writeln(define, 'Claimset() ',
+ 				voidcast, 'Currset(0, (', setptyp, ')0)');
+ 			writeln(define, 'Newset() ',
+ 					'Currset(1, (', setptyp, ')0)');
+ 			writeln(define, 'Saveset(s) Currset(2, s)');
+ 			writeln(define, 'setbits ', setbits:1);
+ 			writeln(typdef, wordtype, tab1, setwtyp, ';');
+ 			writeln(typdef, setwtyp, ' *', tab1, setptyp, ';');
+ 			printid(defnams[dboolean]^.lid);
+ 			writeln(tab1, 'Member(), Le(), Ge(), Eq(), Ne();');
+ 			writeln(setptyp, tab1, 'Union(), Diff();');
+ 			writeln(setptyp, tab1, 'Insmem(), Mksubr();');
+ 			writeln(setptyp, tab1, 'Currset(), Inter();');
+ 			writeln(static, setptyp, tab1, 'Tmpset;');
+ 			writeln(xtern, setptyp, tab1, 'Conset[];');
+ 			writeln(voidtyp, tab1, 'Setncpy();')
+ 		    end;
+ 		writeln(xtern, chartyp, ' *strncpy();');	(* LIB *)
+ 		if use(dargc) or use(dargv) then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Definitions for argv-operations');
+ 			writeln('*', '/');
+ 			writeln(inttyp, tab1, 'argc;');		(* OS *)
+ 			writeln(chartyp, tab1, '**argv;');
+ 			writeln(' void');
+ 			writeln('Argvgt(n, cp, l)');
+ 			writeln(inttyp, tab1, 'n;');
+ 			writeln(registr, inttyp, tab1, 'l;');
+ 			writeln(registr, chartyp, tab1, '*cp;');
+ 			writeln('{');
+ 			writeln(tab1, registr, chartyp, tab1, '*sp;');
+ 			writeln;
+ 			writeln(tab1, 'for (sp = argv[n]; l > 0 && *sp; l--)');
+ 			writeln(tab2, '*cp++ = *sp++;');
+ 			writeln(tab1, 'while (l-- > 0)');
+ 			writeln(tab2, '*cp++ = ', spchr, ';');
+ 			writeln('}');
+ 		    end;
+ 		if (tp^.tsubconst <> nil) or (tp^.tsubtype<> nil) or
+ 			(tp^.tsubvar <> nil) or (tp^.tsubsub <> nil) then
+ 		    begin
+ 			writeln('/', '*');
+ 			writeln('**	Start of program definitions');
+ 			writeln('*', '/');
+ 		    end;
+ 		econst(tp^.tsubconst);
+ 		etype(tp^.tsubtype);
+ 		evar(tp^.tsubvar);
+ 		if tp^.tsubsub <> nil then
+ 			writeln;
+ 		esubr(tp^.tsubsub);
+ 		if tp^.tsubid <> nil then
+ 		    begin
+ 			(* program heading was seen *)
+ 			writeln('/', '*');
+ 			writeln('**	Start of program code');
+ 			writeln('*', '/');
+ 			if use(dargc) or use(dargv) then
+ 			    begin
+ 				writeln('main(_ac, _av)');	(* OS *)
+ 				writeln(inttyp, tab1, '_ac;');
+ 				writeln(chartyp, tab1, '*_av[];');
+ 				writeln('{');
+ 				writeln;
+ 				writeln(tab1, 'argc = _ac;');
+ 				writeln(tab1, 'argv = _av;')
+ 			    end
+ 			else begin
+ 				writeln('main()');
+ 				writeln('{')
+ 			     end;
+ 			increment;
+ 			elabel(tp);
+ 			estmt(tp^.tsubstmt);
+ 			indent;
+ 			writeln('exit(0);');
+ 			decrement;
+ 			writeln('}');
+ 			writeln('/', '*');
+ 			writeln('**	End of program code');
+ 			writeln('*', '/')
+ 		    end
+ 	end;	(* eprogram *)
+ 
+ 	(*	Emit definitions for constant sets	*)
+ 	procedure econset(tp : treeptr; len : integer);
+ 
+ 	var	i	: integer;
+ 
+ 		function size(tp : treeptr) : integer;
+ 
+ 		var	r, x	: integer;
+ 
+ 		begin
+ 			r := 0;
+ 			while tp <> nil do
+ 			    begin
+ 				if tp^.tt = nrange then
+ 					x := cvalof(tp^.texpr)
+ 				else if tp^.tt = nempty then
+ 					x := 0
+ 				else
+ 					x := cvalof(tp);
+ 				if x > r then
+ 					r := x;
+ 				tp := tp^.tnext
+ 			    end;
+ 			size := csetwords(r+1)
+ 		end;
+ 
+ 		(*	Emit bits in a constant set	*)
+ 		procedure ebits(tp : treeptr);
+ 
+ 		type	bitset	= set of 0 .. setbits;
+ 
+ 		var	sets	: array [ 0 .. maxsetrange ] of bitset;
+ 			s, m, n	: integer;
+ 
+ 			procedure eword(s : bitset);
+ 
+ 			const	bitshex	= 4;	(* nr of bits in a hex-digit *)
+ 
+ 			var	n, i	: integer;
+ 				x	: 0 .. setbits;
+ 
+ 			begin
+ 				n := 0;
+ 				while n <= setbits do
+ 					n := n + bitshex;
+ 				n := n - bitshex;
+ 				while n >= 0 do
+ 				    begin
+ 					(* compute 1 hexdigit *)
+ 					x := 0;
+ 					for i := 0 to bitshex - 1 do
+ 						if (n + i) in s then
+ 							case i of
+ 							  0:	x := x + 1;
+ 							  1:	x := x + 2;
+ 							  2:	x := x + 4;
+ 							  3:	x := x + 8
+ 							end;(* case *)
+ 					(* print it *)
+ 					write(hexdig[x]);
+ 					n := n - bitshex
+ 				    end
+ 			end;
+ 
+ 		begin
+ 			s := size(tp);
+ 			for n := 0 to s - 1 do
+ 				sets[n] := [];
+ 			while tp <> nil do
+ 			    begin
+ 				if tp^.tt = nrange then
+ 					for m := cvalof(tp^.texpl) to
+ 							cvalof(tp^.texpr) do
+ 					    begin
+ 						n := m div (setbits+1);
+ 						sets[n] := sets[n] +
+ 							[m mod (setbits+1)]
+ 					    end
+ 				else if tp^.tt <> nempty then
+ 				    begin
+ 					m := cvalof(tp);
+ 					n := m div (setbits+1);
+ 					sets[n] := sets[n] +
+ 						[m mod (setbits+1)]
+ 				    end;
+ 				tp := tp^.tnext
+ 			    end;
+ 			write(tab1, s:1);
+ 			for n := 0 to s - 1 do
+ 			    begin
+ 				write(',');
+ 				if n mod 6 = 0 then
+ 					writeln;
+ 				write(tab1, '0x');
+ 				eword(sets[n]);
+ 			    end;
+ 			writeln
+ 		end;
+ 
+ 	begin
+ 		i := 0;
+ 		while tp <> nil do
+ 		    begin
+ 			writeln(static, setwtyp, tab1, 'Q', i:1, '[] = {');
+ 			ebits(tp^.texps);
+ 			writeln('};');
+ 			i := i + 1;
+ 			tp := tp^.tnext
+ 		    end;
+ 		writeln(static, setwtyp, tab1, '*Conset[] = {');
+ 		for i := len - 1 downto 1 do
+ 		    begin
+ 			write(tab1, 'Q', i:1, ',');
+ 			if i mod 6 = 5 then
+ 				writeln
+ 		    end;
+ 		writeln(tab1, 'Q0');
+ 		writeln('};');
+ 	end;
+ 
+ begin	(* emit *)
+ 	indnt := 0;
+ 	varno := 0;
+ 	conflag := false;
+ 	setused := false;
+ 	dropset := false;
+ 	doarrow := 0;
+ 	eprogram(top);
+ 	if usebool then
+ 		writeln(chartyp, tab1, '*Bools[] = { "false", "true" };');
+ 	if usescan then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Scanck(n)');
+ 		writeln(inttyp, tab1, 'n;');
+ 		writeln('{');
+ 		writeln(tab1, 'if (n != 1) {');
+ 		writeln(tab2, voidcast, 'fprintf(stderr, "Bad input\n");');
+ 		writeln(tab2, 'exit(1);');
+ 		writeln(tab1, '}');
+ 		writeln('}')
+ 	    end;
+ 	if usegetl then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Getl(f)');
+ 		writeln(' text', tab1, '*f;');
+ 		writeln('{');
+ 		writeln(tab1, 'while (f->eoln == 0)');
+ 		writeln(tab2, 'Getx(*f);');
+ 		writeln(tab1, 'Getx(*f);');
+ 		writeln('}')
+ 	    end;
+ 	if usefopn then
+ 	    begin
+ 		writeln;
+ 		writeln(static, 'FILE *');
+ 		writeln('Fopen(n, m)');
+ 		writeln(chartyp, tab1, '*n, *m;');
+ 		writeln('{');
+ 		writeln(tab1, 'FILE', tab2, '*f;');
+ 		writeln(tab1, registr, chartyp, tab1, '*s;');
+ 		writeln(tab1, static, chartyp, tab1, 'ch = ',
+ 						quote, 'A', quote, ';');
+ 		writeln(tab1, static, chartyp, tab1, 'tmp[MAXFILENAME];');
+ 		writeln(tab1, xtern , inttyp, tab1, 'unlink();'); (* OS *)
+ 		writeln;
+ 		writeln(tab1, 'if (n == NULL)');
+ 		writeln(tab2, 'sprintf(tmp, ', tmpfilename, 'ch++);');
+ 		writeln(tab1, 'else {');
+ 		writeln(tab2, 'strncpy(tmp, n, sizeof(tmp));');
+ 		writeln(tab2, 'for (s = &tmp[sizeof(tmp)-1]; *s == ',
+ 			spchr, ' || *s == ', nulchr, '; )');
+ 		writeln(tab3, '*s-- = ', nulchr, ';');
+ 		writeln(tab2, 'if (tmp[sizeof(tmp)-1]) {');
+ 		writeln(tab3, voidcast, 'fprintf(stderr, "Too long filename ',
+ 			quote, '%s', quote, '\n", n);');
+ 		writeln(tab3, 'exit(1);');
+ 		writeln(tab2, '}');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 's = tmp;');
+ 		writeln(tab1, 'if ((f = fopen(s, m)) == NULL) {');
+ 		writeln(tab2, voidcast,
+ 				'fprintf(stderr, "Cannot open: %s\n", s);');
+ 		writeln(tab2, 'exit(1);');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'if (n == NULL)');
+ 		writeln(tab2, 'unlink(tmp);');	(* OS *)
+ 		writeln(tab1, 'return (f);');
+ 		writeln('}');
+ 		writeln(xtern, inttyp, tab1, 'rewind();')
+ 	    end;
+ 	if setcnt > 0 then
+ 		econset(setlst, setcnt);
+ 	if useunion then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Union(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab2, 'i, j, k;');
+ 		writeln(tab1, registr, setptyp, tab2, 'sp = Newset(),');
+ 		writeln(tab4, 'p3 = sp;');
+ 		writeln;
+ 		writeln(tab1, 'j = *p1;');
+ 		writeln(tab1, '*p3 = j;');
+ 		writeln(tab1, 'if (j > *p2)');
+ 		writeln(tab2, 'j = *p2;');
+ 		writeln(tab1, 'else');
+ 		writeln(tab2, '*p3 = *p2;');
+ 		writeln(tab1, 'k = *p1 - *p2;');
+ 		writeln(tab1, 'p1++, p2++, p3++;');
+ 		writeln(tab1, 'for (i = 0; i < j; i++)');
+ 		writeln(tab2, '*p3++ = (*p1++ | *p2++);');
+ 		writeln(tab1, 'while (k > 0) {');
+ 		writeln(tab2, '*p3++ = *p1++;');
+ 		writeln(tab2, 'k--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (k < 0) {');
+ 		writeln(tab2, '*p3++ = *p2++;');
+ 		writeln(tab2, 'k++;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'return (Saveset(sp));');
+ 		writeln('}')
+ 	    end;
+ 	if usediff then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Diff(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab2, 'i, j, k;');
+ 		writeln(tab1, registr, setptyp, tab2, 'sp = Newset(),');
+ 		writeln(tab4, 'p3 = sp;');
+ 		writeln;
+ 		writeln(tab1, 'j = *p1;');
+ 		writeln(tab1, '*p3 = j;');
+ 		writeln(tab1, 'if (j > *p2)');
+ 		writeln(tab2, 'j = *p2;');
+ 		writeln(tab1, 'k = *p1 - *p2;');
+ 		writeln(tab1, 'p1++, p2++, p3++;');
+ 		writeln(tab1, 'for (i = 0; i < j; i++)');
+ 		writeln(tab2, '*p3++ = (*p1++ & ~ (*p2++));');
+ 		writeln(tab1, 'while (k > 0) {');
+ 		writeln(tab2, '*p3++ = *p1++;');
+ 		writeln(tab2, 'k--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'return (Saveset(sp));');
+ 		writeln('}')
+ 	    end;
+ 	if useintr then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Inter(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab2, 'i, j, k;');
+ 		writeln(tab1, registr, setptyp, tab2, 'sp = Newset(),');
+ 		writeln(tab4, 'p3 = sp;');
+ 		writeln;
+ 		writeln(tab1, 'if ((j = *p1) > *p2)');
+ 		writeln(tab2, 'j = *p2;');
+ 		writeln(tab1, '*p3 = j;');
+ 		writeln(tab1, 'p1++, p2++, p3++;');
+ 		writeln(tab1, 'for (i = 0; i < j; i++)');
+ 		writeln(tab2, '*p3++ = (*p1++ & *p2++);');
+ 		writeln(tab1, 'return (Saveset(sp));');
+ 		writeln('}')
+ 	    end;
+ 	if usememb then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Member(m, sp)');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'm;');
+ 		writeln(tab1, registr, setptyp, tab1, 'sp;');
+ 		writeln('{');
+ 		writeln(tab1, registr, usigned, inttyp,
+ 					tab1, 'i = m / (setbits+1) + 1;');
+ 		writeln;
+ 		writeln(tab1, 'if ((i <= *sp) &&',
+ 					' (sp[i] & (1 << (m % (setbits+1)))))');
+ 		write(tab2, 'return (');
+ 		printid(defnams[dtrue]^.lid);
+ 		writeln(');');
+ 		write(tab1, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln('}')
+ 	    end;
+ 	if useseq or usesne then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Eq(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i, j;');
+ 		writeln;
+ 		writeln(tab1, 'i = *p1++;');
+ 		writeln(tab1, 'j = *p2++;');
+ 		writeln(tab1, 'while (i != 0 && j != 0) {');
+ 		writeln(tab2, 'if (*p1++ != *p2++)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'i--, j--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (i != 0) {');
+ 		writeln(tab2, 'if (*p1++ != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'i--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (j != 0) {');
+ 		writeln(tab2, 'if (*p2++ != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'j--;');
+ 		writeln(tab1, '}');
+ 		write(tab1, 'return (');
+ 		printid(defnams[dtrue]^.lid);
+ 		writeln(');');
+ 		writeln('}')
+ 	    end;
+ 	if usesne then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Ne(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		write(tab1, 'return (!Eq(p1, p2));');
+ 		writeln('}')
+ 	    end;
+ 	if usesle then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Le(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i, j;');
+ 		writeln;
+ 		writeln(tab1, 'i = *p1++;');
+ 		writeln(tab1, 'j = *p2++;');
+ 		writeln(tab1, 'while (i != 0 && j != 0) {');
+ 		writeln(tab2, 'if ((*p1++ & ~ *p2++) != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'i--, j--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (i != 0) {');
+ 		writeln(tab2, 'if (*p1++ != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'i--;');
+ 		writeln(tab1, '}');
+ 		write(tab1, 'return (');
+ 		printid(defnams[dtrue]^.lid);
+ 		writeln(');');
+ 		writeln('}')
+ 	    end;
+ 	if usesge then
+ 	    begin
+ 		writeln;
+ 		write(static);
+ 		printid(defnams[dboolean]^.lid);
+ 		writeln;
+ 		writeln('Ge(p1, p2)');
+ 		writeln(tab1, registr, setptyp, tab1, 'p1, p2;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i, j;');
+ 		writeln;
+ 		writeln(tab1, 'i = *p1++;');
+ 		writeln(tab1, 'j = *p2++;');
+ 		writeln(tab1, 'while (i != 0 && j != 0) {');
+ 		writeln(tab2, 'if ((*p2++ & ~ *p1++) != 0)');
+ 		writeln(tab3, 'return (false);');
+ 		writeln(tab2, 'i--, j--;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (j != 0) {');
+ 		writeln(tab2, 'if (*p2++ != 0)');
+ 		write(tab3, 'return (');
+ 		printid(defnams[dfalse]^.lid);
+ 		writeln(');');
+ 		writeln(tab2, 'j--;');
+ 		writeln(tab1, '}');
+ 		write(tab1, 'return (');
+ 		printid(defnams[dtrue]^.lid);
+ 		writeln(');');
+ 		writeln('}')
+ 	    end;
+ 	if usemksub then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Mksubr(lo, hi, sp)');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'lo, hi;');
+ 		writeln(tab1, registr, setptyp, tab1, 'sp;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i, k;');
+ 		writeln;
+ 		writeln(tab1, 'if (hi < lo)');
+ 		writeln(tab2, 'return (sp);');
+ 		writeln(tab1, 'i = hi / (setbits+1) + 1;');
+ 		writeln(tab1, 'for (k = *sp + 1; k <= i; k++)');
+ 		writeln(tab2, 'sp[k] = 0;');
+ 		writeln(tab1, 'if (*sp < i)');
+ 		writeln(tab2, '*sp = i;');
+ 		writeln(tab1, 'for (k = lo; k <= hi; k++)');
+ 		writeln(tab2, 'sp[k / (setbits+1) + 1] |= ',
+ 						'(1 << (k % (setbits+1)));');
+ 		writeln(tab1, 'return (sp);');
+ 		writeln('}')
+ 	    end;
+ 	if useins then
+ 	    begin
+ 		writeln;
+ 		writeln(static, setptyp);
+ 		writeln('Insmem(m, sp)');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'm;');
+ 		writeln(tab1, registr, setptyp, tab1, 'sp;');
+ 		writeln('{');
+ 		writeln(tab1, registr, inttyp, tab1, 'i,');
+ 		writeln(tab3, tab1, 'j = m / (setbits+1) + 1;');
+ 		writeln;
+ 		writeln(tab1, 'if (*sp < j)');
+ 		writeln(tab2, 'for (i = *sp + 1, *sp = j; i <= *sp; i++)');
+ 		writeln(tab3, 'sp[i] = 0;');
+ 		writeln(tab1, 'sp[j] |= (1 << (m % (setbits+1)));');
+ 		writeln(tab1, 'return (sp);');
+ 		writeln('}')
+ 	    end;
+ 	if usesets then
+ 	    begin
+ 		writeln;
+ 		writeln(ifndef, 'SETSPACE');
+ 		writeln(define, 'SETSPACE 256');
+ 		writeln(endif);
+ 		writeln(static, setptyp);
+ 		writeln('Currset(n,sp)');
+ 		writeln(tab1, inttyp, tab1, 'n;');
+ 		writeln(tab1, setptyp, tab1, 'sp;');
+ 		writeln('{');
+ 		writeln(tab1, static, setwtyp, tab1, 'Space[SETSPACE];');
+ 		writeln(tab1, static, setptyp, tab1, 'Top = Space;');
+ 		writeln;
+ 		writeln(tab1, 'switch (n) {');
+ 		writeln(tab1, '  case 0:');
+ 		writeln(tab2, 'Top = Space;');
+ 		writeln(tab2, 'return (0);');
+ 		writeln(tab1, '  case 1:');
+ 		writeln(tab2, 'if (&Space[SETSPACE] - Top <= ',
+ 							maxsetrange:1, ') {');
+ 		writeln(tab3,
+ 			voidcast, 'fprintf(stderr, "Set-space exhausted\n");');
+ 		writeln(tab3, 'exit(1);');
+ 		writeln(tab2, '}');
+ 		writeln(tab2, '*Top = 0;');
+ 		writeln(tab2, 'return (Top);');
+ 		writeln(tab1, '  case 2:');
+ 		writeln(tab2, 'if (Top <= &sp[*sp])');
+ 		writeln(tab3, 'Top = &sp[*sp + 1];');
+ 		writeln(tab2, 'return (sp);');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, '/', '* NOTREACHED *', '/');
+ 		writeln('}')
+ 	    end;
+ 	if usescpy then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Setncpy(S1, S2, N)');
+ 		writeln(tab1, registr, setptyp, tab1, 'S1, S2;');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'N;');
+ 		writeln('{');
+ 		writeln(tab1, registr, usigned, inttyp, tab1, 'm;');
+ 		writeln;
+ 		writeln(tab1, 'N /= sizeof(', setwtyp, ');');
+ 		writeln(tab1, '*S1++ = --N;');
+ 		writeln(tab1, 'm = *S2++;');
+ 		writeln(tab1, 'while (m != 0 && N != 0) {');
+ 		writeln(tab2, '*S1++ = *S2++;');
+ 		writeln(tab2, '--N;');
+ 		writeln(tab2, '--m;');
+ 		writeln(tab1, '}');
+ 		writeln(tab1, 'while (N-- != 0)');
+ 		writeln(tab2, '*S1++ = 0;');
+ 		writeln('}')
+ 	    end;
+ 	if usecase then
+ 	    begin
+ 		writeln;
+ 		writeln(static, voidtyp);
+ 		writeln('Caseerror(n)');
+ 		writeln(tab1, inttyp, tab1, 'n;');
+ 		writeln('{');
+ 		writeln(tab1, voidcast,
+ 			'fprintf(stderr, "Missing case limb: line %d\n", n);');
+ 		writeln(tab1, 'exit(1);');
+ 		writeln('}')
+ 	    end;
+ 	if usemax then
+ 	    begin
+ 		writeln;
+ 		writeln(static, inttyp);
+ 		writeln('Max(m, n)');
+ 		writeln(tab1, inttyp, tab1, 'm, n;');
+ 		writeln('{');
+ 		writeln(tab1, 'if (m > n)');
+ 		writeln(tab2, 'return (m);');
+ 		writeln(tab1, 'return (n);');
+ 		writeln('}')
+ 	    end;
+ 	if use(dtrunc) then
+ 	    begin
+ 		writeln(static, inttyp);
+ 		writeln('Trunc(f)');
+ 		printid(defnams[dreal]^.lid);
+ 		writeln(tab1, 'f;');
+ 		writeln('{');
+ 		writeln(tab1, 'return f;');
+ 		writeln('}')
+ 	    end;
+ 	if use(dround) then
+ 	    begin
+ 		writeln(static, inttyp);
+ 		writeln('Round(f)');
+ 		printid(defnams[dreal]^.lid);
+ 		writeln(tab1, 'f;');
+ 		writeln('{');
+ 		writeln(tab1, xtern, doubletyp, ' floor();');	(* LIB *)
+ 		writeln(tab1,
+ 			'return floor(', dblcast, '(0.5+f));');	(* LIB *)
+ 		writeln('}')
+ 	    end
+ end;	(* emit *)
+ 
+ (*	Initialize all global structures used in translator.		*)
+ procedure initialize;
+ 
+ var	s	: hashtyp;
+ 	t	: pretyps;
+ 	d	: predefs;
+ 
+ 	(*	Define names in ctable.					*)
+ 	procedure defname(cn : cnames; str : keyword);
+ 
+ 	label	999;
+ 
+ 	var	w	: toknbuf;
+ 		i	: toknidx;
+ 
+ 	begin
+ 		unpack(str, w, 1);
+ 		for i := 1 to keywordlen do
+ 			if w[i] = space then
+ 			    begin
+ 				w[i] := chr(null);
+ 				goto 999
+ 			    end;
+ 		w[keywordlen+1] := chr(null);
+ 	999:
+ 		ctable[cn] := saveid(w)
+ 	end;
+ 
+ 	(*	Define predefined identifiers.				*)
+ 	procedure defid(nt : treetyp; did : predefs; str : keyword);
+ 
+ 	label	999;
+ 
+ 	var	w	: toknbuf;
+ 		i	: toknidx;
+ 		tp, tq,
+ 		tv	: treeptr;
+ 
+ 	begin
+ 		for i := 1 to keywordlen do
+ 			if str[i] = space then
+ 			    begin
+ 				w[i] := chr(null);
+ 				goto 999
+ 			    end
+ 			else
+ 				w[i] := str[i];
+ 		w[keywordlen+1] := chr(null);
+ 	999:
+ 		tp := newid(saveid(w));
+ 		defnams[did] := tp^.tsym;
+ 		if nt in [ntype, nfunc, nproc] then
+ 		    begin
+ 			(* predefined types, procedures and functions
+ 				are marked with a particular node *)
+ 			tv := mknode(npredef);
+ 			tv^.tdef := did;
+ 			tv^.tobtyp := tnone
+ 		    end
+ 		else
+ 			tv := nil; (* predefined constants and variables will
+ 					eventually be bound to something *)
+ 		case nt of
+ 		  nscalar:
+ 		    begin
+ 			tv := mknode(nscalar);
+ 			tv^.tscalid := nil;
+ 			tq := mknode(ntype);
+ 			tq^.tbind := tv;
+ 			tq^.tidl := tp;
+ 			tp := tq
+ 		    end;
+ 		  nconst,
+ 		  ntype,
+ 		  nfield,
+ 		  nvar:
+ 		    begin
+ 			tq := mknode(nt);
+ 			tq^.tbind := tv;
+ 			tq^.tidl := tp;
+ 			tq^.tattr := anone;
+ 			tp := tq
+ 		    end;
+ 		  nfunc,
+ 		  nproc:
+ 		    begin
+ 			tq := mknode(nt);
+ 			tq^.tsubid := tp;
+ 			tq^.tsubstmt := tv;
+ 			tq^.tfuntyp := nil;
+ 			tq^.tsubpar := nil;
+ 			tq^.tsublab := nil;
+ 			tq^.tsubconst := nil;
+ 			tq^.tsubtype := nil;
+ 			tq^.tsubvar := nil;
+ 			tq^.tsubsub := nil;
+ 			tq^.tscope := nil;
+ 			tq^.tstat := 0;
+ 			tp := tq
+ 		    end;
+ 		  nid:
+ 		end;(* case *)
+ 		deftab[did] := tp
+ 	end;	(* defid *)
+ 
+ 	(*	Define keywords.					*)
+ 	procedure defkey(s : symtyp; w : keyword);
+ 
+ 	var	i	: 1 .. keywordlen;
+ 
+ 	begin
+ 		for i := 1 to keywordlen do
+ 			if w[i] = space then
+ 				w[i] := chr(null);
+ 		(* relies on symtyp being sorted *)
+ 		with keytab[ord(s)] do
+ 		    begin
+ 			wrd := w;
+ 			sym := s
+ 		    end;
+ 	end;
+ 
+ 	procedure fixinit(i : strindx);
+ 
+ 	var	t	: toknbuf;
+ 
+ 	begin
+ 		gettokn(i, t);
+ 		t[1] := 'i';
+ 		puttokn(i, t);
+ 	end;
+ 
+ 	(*	Add a cpu word type description.			*)
+ 	(*	Parameters lo and hi gives the range of a machine-	*)
+ 	(*	dependant integer type. Parameter str gives the corres-	*)
+ 	(*	ponding C-language type-name.				*)
+ 	procedure defmach(lo, hi : integer; str : machdefstr);
+ 
+ 	label	999;
+ 
+ 	var	i	: toknidx;
+ 		w	: toknbuf;
+ 
+ 	begin
+ 		unpack(str, w, 1);
+ 		if w[machdeflen] <> space then
+ 			error(ebadmach);
+ 		for i := machdeflen - 1 downto 1 do
+ 			if w[i] <> space then
+ 			    begin
+ 				w[i+1] := chr(null);
+ 				goto 999
+ 			    end;
+ 		error(ebadmach);
+ 	999:
+ 		if nmachdefs >= maxmachdefs then
+ 			error(emanymachs);
+ 		nmachdefs := nmachdefs + 1;
+ 		with machdefs[nmachdefs] do
+ 		    begin
+ 			lolim := lo;
+ 			hilim := hi;
+ 			typstr := savestr(w)
+ 		    end
+ 	end;
+ 
+ 	procedure initstrstore;
+ 
+ 	var	i	: strbcnt;
+ 
+ 	begin
+ 		for i := 1 to maxblkcnt do
+ 			strstor[i] := nil;
+ 		new(strstor[0]);
+ 		strstor[0]^[0] := chr(null);
+ 		strfree := 1;
+ 		strleft := maxstrblk
+ 	end;
+ 
+ begin	(* initialize *)
+ 	lineno := 1;
+ 	colno := 0;
+ 
+ 	initstrstore;
+ 
+ 	setlst := nil;
+ 	setcnt := 0;
+ 	hexdig := '0123456789ABCDEF';
+ 
+ 	symtab := nil;
+ 	statlvl := 0;
+ 	maxlevel := -1;
+ 	enterscope(nil);
+ 	varno:= 0;
+ 
+ 	usenilp := false;
+ 
+ 	usesets := false;
+ 	useunion := false;
+ 	usediff := false;
+ 	usemksub := false;
+ 	useintr := false;
+ 	usesge := false;
+ 	usesle := false;
+ 	usesne := false;
+ 	useseq := false;
+ 	usememb := false;
+ 	useins := false;
+ 	usescpy := false;
+ 	usefopn := false;
+ 	usescan := false;
+ 	usegetl := false;
+ 
+ 	usecase := false;
+ 	usejmps := false;
+ 
+ 	usebool := false;
+ 
+ 	usecomp := false;
+ 	usemax	:= false;
+ 
+ 	for s := 0 to hashmax do
+ 		idtab[s] := nil;
+ 	for d := dabs to dztring do
+ 	    begin
+ 		deftab[d] := nil;
+ 		defnams[d] := nil
+ 	    end;
+ 
+ 	(* Pascal keywords *)
+ 	defkey(sand,	'and       ');
+ 	defkey(sarray,	'array     ');
+ 	defkey(sbegin,	'begin     ');
+ 	defkey(scase,	'case      ');
+ 	defkey(sconst,	'const     ');
+ 	defkey(sdiv,	'div       ');
+ 	defkey(sdo,	'do        ');
+ 	defkey(sdownto,	'downto    ');
+ 	defkey(selse,	'else      ');
+ 	defkey(send,	'end       ');
+ 	defkey(sextern,	externsym);	(* non-standard *)
+ 	defkey(sfile,	'file      ');
+ 	defkey(sfor,	'for       ');
+ 	defkey(sforward,'forward   ');
+ 	defkey(sfunc,	'function  ');
+ 	defkey(sgoto,	'goto      ');
+ 	defkey(sif,	'if        ');
+ 	defkey(sinn,	'in        ');
+ 	defkey(slabel,	'label     ');
+ 	defkey(smod,	'mod       ');
+ 	defkey(snil,	'nil       ');
+ 	defkey(snot,	'not       ');
+ 	defkey(sof,	'of        ');
+ 	defkey(sor,	'or        ');
+ 	defkey(sother,	othersym);	(* non-standard *)
+ 	defkey(spacked,	'packed    ');
+ 	defkey(sproc,	'procedure ');
+ 	defkey(spgm,	'program   ');
+ 	defkey(srecord,	'record    ');
+ 	defkey(srepeat,	'repeat    ');
+ 	defkey(sset,	'set       ');
+ 	defkey(sthen,	'then      ');
+ 	defkey(sto,	'to        ');
+ 	defkey(stype,	'type      ');
+ 	defkey(suntil,	'until     ');
+ 	defkey(svar,	'var       ');
+ 	defkey(swhile,	'while     ');
+ 	defkey(swith,	'with      ');
+ 	defkey(seof,	dummysym);	(* dummy entry *)
+ 
+ 	(* C language operator priorities *)
+ 	cprio[nformat]	:= 0;
+ 	cprio[nrange]	:= 0;
+ 	cprio[nin]	:= 0;
+ 	cprio[nset]	:= 0;
+ 	cprio[nassign]	:= 0;
+ 	cprio[nor]	:= 1;
+ 	cprio[nand]	:= 2;
+ 	cprio[neq]	:= 3;
+ 	cprio[nne]	:= 3;
+ 	cprio[nlt]	:= 3;
+ 	cprio[nle]	:= 3;
+ 	cprio[ngt]	:= 3;
+ 	cprio[nge]	:= 3;
+ 	cprio[nplus]	:= 4;
+ 	cprio[nminus]	:= 4;
+ 	cprio[nmul]	:= 5;
+ 	cprio[ndiv]	:= 5;
+ 	cprio[nmod]	:= 5;
+ 	cprio[nquot]	:= 5;
+ 	cprio[nnot]	:= 6;
+ 	cprio[numinus]	:= 6;
+ 	cprio[nuplus]	:= 7;
+ 	cprio[nindex]	:= 7;
+ 	cprio[nselect]	:= 7;
+ 	cprio[nderef]	:= 7;
+ 	cprio[ncall]	:= 7;
+ 	cprio[nid]	:= 7;
+ 	cprio[nchar]	:= 7;
+ 	cprio[ninteger]	:= 7;
+ 	cprio[nreal]	:= 7;
+ 	cprio[nstring]	:= 7;
+ 	cprio[nnil]	:= 7;
+ 
+ 	(* Pascal language operator priorities *)
+ 	pprio[nassign]	:= 0;
+ 	pprio[nformat]	:= 0;
+ 	pprio[nrange]	:= 1;
+ 	pprio[nin]	:= 1;
+ 	pprio[neq]	:= 1;
+ 	pprio[nne]	:= 1;
+ 	pprio[nlt]	:= 1;
+ 	pprio[nle]	:= 1;
+ 	pprio[ngt]	:= 1;
+ 	pprio[nge]	:= 1;
+ 	pprio[nor]	:= 2;
+ 	pprio[nplus]	:= 2;
+ 	pprio[nminus]	:= 2;
+ 	pprio[nand]	:= 3;
+ 	pprio[nmul]	:= 3;
+ 	pprio[ndiv]	:= 3;
+ 	pprio[nmod]	:= 3;
+ 	pprio[nquot]	:= 3;
+ 	pprio[nnot]	:= 4;
+ 	pprio[numinus]	:= 4;
+ 	pprio[nuplus]	:= 5;
+ 	pprio[nset]	:= 6;
+ 	pprio[nindex]	:= 6;
+ 	pprio[nselect]	:= 6;
+ 	pprio[nderef]	:= 6;
+ 	pprio[ncall]	:= 6;
+ 	pprio[nid]	:= 6;
+ 	pprio[nchar]	:= 6;
+ 	pprio[ninteger]	:= 6;
+ 	pprio[nreal]	:= 6;
+ 	pprio[nstring]	:= 6;
+ 	pprio[nnil]	:= 6;
+ 
+ 	(* table of C keywords/functions (which Pascal doesn't know about) *)
+ 	defname(cabort,		'abort     ');	(* OS *)
+ 	defname(cbreak,		'break     ');
+ 	defname(ccontinue,	'continue  ');
+ 	defname(cdefine,	'define    ');
+ 	defname(cdefault,	'default   ');
+ 	defname(cdouble,	'double    ');
+ 	defname(cedata,		'edata     ');	(* OS *)
+ 	defname(cenum,		'enum      ');
+ 	defname(cetext,		'etext     ');	(* OS *)
+ 	defname(cextern,	'extern    ');
+ 	defname(cfclose,	'fclose    ');	(* LIB *)
+ 	defname(cfflush,	'fflush    ');	(* LIB *)
+ 	defname(cfgetc,		'fgetc     ');	(* LIB *)
+ 	defname(cfloat,		'float     ');
+ 	defname(cfloor,		'floor     ');	(* OS *)
+ 	defname(cfprintf,	'fprintf   ');	(* LIB *)
+ 	defname(cfputc,		'fputc     ');	(* LIB *)
+ 	defname(cfread,		'fread     ');	(* LIB *)
+ 	defname(cfscanf,	'fscanf    ');	(* LIB *)
+ 	defname(cfwrite,	'fwrite    ');	(* LIB *)
+ 	defname(cgetc,		'getc      ');	(* OS *)
+ 	defname(cgetpid,	'getpid    ');	(* OS *)
+ 	defname(cint,		'int       ');
+ 	defname(cinclude,	'include   ');
+ 	defname(clong,		'long      ');
+ 	defname(clog,		'log       ');	(* OS *)
+ 	defname(cmain,		'main      ');
+ 	defname(cmalloc,	'malloc    ');	(* LIB *)
+ 	defname(cprintf,	'printf    ');	(* LIB *)
+ 	defname(cpower,		'pow       ');	(* OS *)
+ 	defname(cputc,		'putc      ');	(* LIB *)
+ 	defname(cread,		'read      ');	(* OS *)
+ 	defname(creturn,	'return    ');
+ 	defname(cregister,	'register  ');
+ 	defname(crewind,	'rewind    ');	(* LIB *)
+ 	defname(cscanf,		'scanf     ');	(* LIB *)
+ 	defname(csetbits,	'setbits   ');
+ 	defname(csetword,	'setword   ');
+ 	defname(csetptr,	'setptr    ');
+ 	defname(cshort,		'short     ');
+ 	defname(csigned,	'signed    ');
+ 	defname(csizeof,	'sizeof    ');
+ 	defname(csprintf,	'sprintf   ');	(* LIB *)
+ 	defname(cstatic,	'static    ');
+ 	defname(cstdin,		'stdin     ');	(* LIB *)
+ 	defname(cstdout,	'stdout    ');	(* LIB *)
+ 	defname(cstderr,	'stderr    ');	(* LIB *)
+ 	defname(cstrncmp,	'strncmp   ');	(* OS *)
+ 	defname(cstrncpy,	'strncpy   ');	(* OS *)
+ 	defname(cstruct,	'struct    ');
+ 	defname(cswitch,	'switch    ');
+ 	defname(ctypedef,	'typedef   ');
+ 	defname(cundef,		'undef     ');
+ 	defname(cungetc,	'ungetc    ');	(* LIB *)
+ 	defname(cunion,		'union     ');
+ 	defname(cunlink,	'unlink    ');	(* OS *)
+ 	defname(cunsigned,	'unsigned  ');
+ 	defname(cwrite,		'write     ');	(* OS *)
+ 
+ 	(* create predefined identifiers *)
+ 	defid(nfunc,	dabs,		'abs       ');
+ 	defid(nfunc,	darctan,	'arctan    ');
+ 	defid(nvar,	dargc,		'argc      ');	(* OS *)
+ 	defid(nproc,	dargv,		'argv      ');	(* OS *)
+ 	defid(nscalar,	dboolean,	'boolean   ');
+ 	defid(ntype,	dchar,		'char      ');
+ 	defid(nfunc,	dchr,		'chr       ');
+ 	defid(nproc,	dclose,		'close     ');	(* OS *)
+ 	defid(nfunc,	dcos,		'cos       ');
+ 	defid(nproc,	ddispose,	'dispose   ');
+ 	defid(nid,	dfalse,		'false     ');
+ 	defid(nfunc,	deof,		'eof       ');
+ 	defid(nfunc,	deoln,		'eoln      ');
+ 	defid(nproc,	dexit,		'exit      ');	(* OS *)
+ 	defid(nfunc,	dexp,		'exp       ');
+ 	defid(nproc,	dflush,		'flush     ');	(* OS *)
+ 	defid(nproc,	dget,		'get       ');
+ 	defid(nproc,	dhalt,		'halt      ');	(* OS *)
+ 	defid(nvar,	dinput,		'input     ');
+ 	defid(ntype,	dinteger,	'integer   ');
+ 	defid(nfunc,	dln,		'ln        ');
+ 	defid(nconst,	dmaxint,	'maxint    ');
+ 	defid(nproc,	dmessage,	'message   ');	(* OS *)
+ 	defid(nproc,	dnew,		'new       ');
+ 	defid(nfunc,	dodd,		'odd       ');
+ 	defid(nfunc,	dord,		'ord       ');
+ 	defid(nvar,	doutput,	'output    ');
+ 	defid(nproc,	dpack,		'pack      ');
+ 	defid(nproc,	dpage,		'page      ');
+ 	defid(nfunc,	dpred,		'pred      ');
+ 	defid(nproc,	dput,		'put       ');
+ 	defid(nproc,	dread,		'read      ');
+ 	defid(nproc,	dreadln,	'readln    ');
+ 	defid(ntype,	dreal,		'real      ');
+ 	defid(nproc,	dreset,		'reset     ');
+ 	defid(nproc,	drewrite,	'rewrite   ');
+ 	defid(nfunc,	dround,		'round     ');
+ 	defid(nfunc,	dsin,		'sin       ');
+ 	defid(nfunc,	dsqr,		'sqr       ');
+ 	defid(nfunc,	dsqrt,		'sqrt      ');
+ 	defid(nfunc,	dsucc,		'succ      ');
+ 	defid(ntype,	dtext,		'text      ');
+ 	defid(nid,	dtrue,		'true      ');
+ 	defid(nfunc,	dtrunc,		'trunc     ');
+ 	defid(nfunc,	dtan,		'tan       ');
+ 	defid(nproc,	dunpack,	'unpack    ');
+ 	defid(nproc,	dwrite,		'write     ');
+ 	defid(nproc,	dwriteln,	'writeln   ');
+ 
+ 	defid(nfield,	dzinit,		'$nit      ');	(* for internal use *)
+ 	defid(ntype,	dztring,	'$ztring   ');
+ 
+ 	(* bind constants and variables *)
+ 	deftab[dboolean]^.tbind^.tscalid := deftab[dfalse];
+ 	deftab[dfalse]^.tnext := deftab[dtrue];
+ 	currsym.st := sinteger;
+ 	currsym.vint := maxint;
+ 	deftab[dmaxint]^.tbind := mklit;
+ 	deftab[dargc]^.tbind := deftab[dinteger]^.tbind;
+ 	deftab[dinput]^.tbind := deftab[dtext]^.tbind;
+ 	deftab[doutput]^.tbind := deftab[dtext]^.tbind;
+ 
+ 	for t := tnone to terror do
+ 	    begin
+ 		(* for predefined types: set up pointers to "npredef" nodes
+ 		   describing type, fill in constant identifying type *)
+ 		case t of
+ 		  tboolean:
+ 			typnods[t] := deftab[dboolean]; (* scalar type *)
+ 		  tchar:
+ 			typnods[t] := deftab[dchar]^.tbind;
+ 		  tinteger:
+ 			typnods[t] := deftab[dinteger]^.tbind;
+ 		  treal:
+ 			typnods[t] := deftab[dreal]^.tbind;
+ 		  ttext:
+ 			typnods[t] := deftab[dtext]^.tbind;
+ 		  tstring:
+ 			typnods[t] := deftab[dztring]^.tbind;
+ 		  tnil,
+ 		  tset,
+ 		  tpoly,
+ 		  tnone:
+ 			typnods[t] := mknode(npredef);
+ 		  terror:
+ 			(* no op *)
+ 		end;(* case *)
+ 		if t in [tchar, tinteger, treal, ttext, tnone, tpoly,
+ 						tstring, tnil, tset] then
+ 			typnods[t]^.tobtyp := t
+ 	    end;
+ 
+ 	(* fix name and type of field "init" *)
+ 	fixinit(defnams[dzinit]^.lid^.istr);
+ 	deftab[dzinit]^.tbind := deftab[dinteger]^.tbind;
+ 
+ 	for d := dabs to dztring do
+ 		linkup(nil, deftab[d]);
+ 
+ 	deftab[dchr]^.tfuntyp := typnods[tchar];
+ 
+ 	deftab[deof]^.tfuntyp := typnods[tboolean];
+ 	deftab[deoln]^.tfuntyp := typnods[tboolean];
+ 	deftab[dodd]^.tfuntyp := typnods[tboolean];
+ 
+ 	deftab[dord]^.tfuntyp := typnods[tinteger];
+ 	deftab[dround]^.tfuntyp := typnods[tinteger];
+ 	deftab[dtrunc]^.tfuntyp := typnods[tinteger];
+ 
+ 	deftab[darctan]^.tfuntyp := typnods[treal];
+ 	deftab[dcos]^.tfuntyp := typnods[treal];
+ 	deftab[dsin]^.tfuntyp := typnods[treal];
+ 	deftab[dtan]^.tfuntyp := typnods[treal];
+ 	deftab[dsqrt]^.tfuntyp := typnods[treal];
+ 	deftab[dexp]^.tfuntyp := typnods[treal];
+ 	deftab[dln]^.tfuntyp := typnods[treal];
+ 
+ 	deftab[dsqr]^.tfuntyp := typnods[tpoly];
+ 	deftab[dabs]^.tfuntyp := typnods[tpoly];
+ 	deftab[dpred]^.tfuntyp := typnods[tpoly];
+ 	deftab[dsucc]^.tfuntyp := typnods[tpoly];
+ 
+ 	deftab[dargv]^.tfuntyp := typnods[tnone];
+ 	deftab[ddispose]^.tfuntyp := typnods[tnone];
+ 	deftab[dexit]^.tfuntyp := typnods[tnone];
+ 	deftab[dget]^.tfuntyp := typnods[tnone];
+ 	deftab[dhalt]^.tfuntyp := typnods[tnone];
+ 	deftab[dnew]^.tfuntyp := typnods[tnone];
+ 	deftab[dpack]^.tfuntyp := typnods[tnone];
+ 	deftab[dput]^.tfuntyp := typnods[tnone];
+ 	deftab[dread]^.tfuntyp := typnods[tnone];
+ 	deftab[dreadln]^.tfuntyp := typnods[tnone];
+ 	deftab[dreset]^.tfuntyp := typnods[tnone];
+ 	deftab[drewrite]^.tfuntyp := typnods[tnone];
+ 	deftab[dwrite]^.tfuntyp := typnods[tnone];
+ 	deftab[dwriteln]^.tfuntyp := typnods[tnone];
+ 	deftab[dmessage]^.tfuntyp := typnods[tnone];
+ 	deftab[dunpack]^.tfuntyp := typnods[tnone];
+ 
+ 	(* set up definitions for integer subranges *)
+ 	nmachdefs := 0;
+ 	defmach(0,		255,		'unsigned char   '); (* CPU *)
+ 	defmach(-128,		127,		'char            '); (* CPU *)
+ 	defmach(0,		65535,		'unsigned short  '); (* CPU *)
+ 	defmach(-32768,		32767,		'short           '); (* CPU *)
+ 	defmach(-2147483647,	2147483647,	'long            '); (* CPU *)
+ {	defmach(0,		4294967295,	'unsigned long   ');}(* CPU *)
+ end;	(* initialize *)
+ 
+ procedure exit(i : integer); external;	(* OS *)
+ 
+ (*	Action to take when an error is detected.			*)
+ procedure error;
+ 
+ begin
+ 	prtmsg(m);
+ 	exit(1);	(* OS *)
+ 	goto 9999
+ end;
+ 
+ (*	Action to take when a fatal error is detected.			*)
+ procedure fatal;
+ 
+ begin
+ 	prtmsg(m);
+ 	halt		(* OS *)
+ 	(* goto 9999	*)
+ end;
+ 
+ 
+ begin	(* program *)
+ 	initialize;
+ 	if echo then
+ 		writeln('# ifdef PASCAL');
+ 	parse;
+ 	if echo then
+ 		writeln('# else');
+ 	lineno := 0; lastline := 0;
+ 	transform;
+ 	emit;
+ 	if echo then
+ 		writeln('# endif');
+ 9999:
+ 	(* the very *)
+ end.
+ 





More information about the llvm-commits mailing list