{4:}{9:}{$C-,A+,D-}ifdef('TEXMF_DEBUG'){$C+,D+}endif('TEXMF_DEBUG'){:9} program MP;label{6:}1,9998,9999;{:6}const{11:}maxinternal=300; bufsize=3000;emergencylinelength=255;stacksize=300;maxreadfiles=30; stringsvacant=1000;fontmax=50;fontmemsize=10000;poolname='mp.pool'; pstabname='psfonts.map';pathsize=1000;bistacksize=1500;headersize=100; ligtablesize=15000;maxkerns=2500;maxfontdimen=50;infmainmemory=2999; supmainmemory=8000000;infmaxstrings=2500;supmaxstrings=32767; infpoolsize=32000;suppoolsize=10000000;infpoolfree=1000; suppoolfree=suppoolsize;infstringvacancies=8000; supstringvacancies=suppoolsize-23000;{:11}type{18:}ASCIIcode=0..255; {:18}{24:}eightbits=0..255;alphafile=packed file of ASCIIcode; bytefile=packed file of eightbits;{:24}{37:}poolpointer=0..poolsize; strnumber=0..maxstrings;poolASCIIcode=0..255;{:37}{116:}scaled=integer; smallnumber=0..63;{:116}{120:}fraction=integer;{:120}{121:} angle=integer;{:121}{171:}quarterword=0..255;halfword=0..268435455; twochoices=1..2;threechoices=1..3; #include "texmfmem.h";wordfile=file of memoryword;{:171}{204:} commandcode=1..84;{:204}{581:} instaterecord=record indexfield:quarterword; startfield,locfield,limitfield,namefield:halfword;end;{:581}{779:} readfindex=0..maxreadfiles;writeindex=0..4;{:779}{1174:} fontnumber=0..fontmax;{:1174}{1311:}strreftype=0..127;{:1311}var{13:} bad:integer;ifdef('INIMP')iniversion:boolean;dumpoption:boolean; dumpline:boolean;endif('INIMP')bounddefault:integer;boundname:^char; mainmemory:integer;memtop:integer;memmax:integer;errorline:integer; halferrorline:integer;maxprintline:integer;poolsize:integer; stringvacancies:integer;poolfree:integer;maxstrings:integer;{:13}{20:} xord:array[ASCIIcode]of ASCIIcode;xchr:array[ASCIIcode]of ASCIIcode; {:20}{25:}nameoffile:^ASCIIcode;namelength:0..maxint;{:25}{29:} buffer:array[0..bufsize]of ASCIIcode;first:0..bufsize;last:0..bufsize; maxbufstack:0..bufsize;{:29}{38:}strpool:^poolASCIIcode; strstart:^poolpointer;nextstr:^strnumber;poolptr:poolpointer; strptr:strnumber;initpoolptr:poolpointer;initstruse:strnumber; maxpoolptr:poolpointer;maxstrptr:strnumber;{:38}{39:}strsusedup:integer; poolinuse:integer;strsinuse:integer;maxplused:integer; maxstrsused:integer;{:39}{44:}strref:^strreftype;{:44}{48:} lastfixedstr:strnumber;fixedstruse:strnumber;{:48}{56:} stroverflowed:boolean;{:56}{58:}pactcount:integer;pactchars:integer; pactstrs:integer;{:58}{65:}ifdef('INIMP')poolfile:alphafile; endif('INIMP'){:65}{69:}logfile:alphafile;psfile:alphafile; selector:0..10;dig:array[0..22]of 0..15;tally:integer; termoffset:0..maxprintline;fileoffset:0..maxprintline;psoffset:integer; trickbuf:array[0..255]of ASCIIcode;trickcount:integer; firstcount:integer;{:69}{83:}interaction:0..3;interactionoption:0..4; {:83}{86:}deletionsallowed:boolean;history:0..3;errorcount:-1..100;{:86} {89:}helpline:array[0..5]of strnumber;helpptr:0..6;useerrhelp:boolean; errhelp:strnumber;{:89}{106:}interrupt:integer;OKtointerrupt:boolean; {:106}{112:}aritherror:boolean;{:112}{144:} twotothe:array[0..30]of integer;speclog:array[1..28]of integer;{:144} {152:}specatan:array[1..26]of angle;{:152}{159:}nsin,ncos:fraction; {:159}{163:}randoms:array[0..54]of fraction;jrandom:0..54;{:163}{174:} mem:^memoryword;lomemmax:halfword;himemmin:halfword;{:174}{175:} varused,dynused:integer;{:175}{176:}avail:halfword;memend:halfword; {:176}{181:}rover:halfword;{:181}{193:} ifdef('TEXMF_DEBUG')freearr:packed array[0..1]of boolean; wasfree:packed array[0..1]of boolean; wasmemend,waslomax,washimin:halfword;panicking:boolean; endif('TEXMF_DEBUG'){:193}{208:}internal:array[1..maxinternal]of scaled; intname:array[1..maxinternal]of strnumber;intptr:33..maxinternal;{:208} {214:}oldsetting,nonpssetting:0..10;{:214}{216:} charclass:array[ASCIIcode]of 0..20;{:216}{218:}hashused:halfword; stcount:integer;{:218}{219:}hash:array[1..9771]of twohalves; eqtb:array[1..9771]of twohalves;{:219}{244:}gpointer:halfword;{:244} {249:}bignodesize:array[12..14]of smallnumber; sector0:array[12..14]of smallnumber; sectoroffset:array[5..13]of smallnumber;{:249}{269:}saveptr:halfword; {:269}{287:}pathtail:halfword;{:287}{300:} deltax,deltay,delta:array[0..pathsize]of scaled; psi:array[1..pathsize]of angle;{:300}{304:} theta:array[0..pathsize]of angle;uu:array[0..pathsize]of fraction; vv:array[0..pathsize]of angle;ww:array[0..pathsize]of fraction;{:304} {319:}st,ct,sf,cf:fraction;{:319}{329:}bbmin,bbmax:array[0..1]of scaled; {:329}{373:}halfcos:array[0..7]of fraction;dcos:array[0..7]of fraction; {:373}{387:}curx,cury:scaled;{:387}{401:} grobjectsize:array[1..7]of smallnumber;{:401}{462:}specoffset:integer; {:462}{464:}specp1,specp2:halfword;{:464}{526:}tolstep:0..6;{:526}{527:} bisectstack:array[0..bistacksize]of integer;bisectptr:0..bistacksize; {:527}{530:}curt,curtt:integer;timetogo:integer;maxt:integer;{:530} {532:}delx,dely:integer;tol:integer;uv,xy:0..bistacksize;threel:integer; apprt,apprtt:integer;{:532}{539:}serialno:integer;{:539}{546:} fixneeded:boolean;watchcoefs:boolean;depfinal:halfword;{:546}{578:} curcmd:eightbits;curmod:integer;cursym:halfword;{:578}{582:} inputstack:array[0..stacksize]of instaterecord;inputptr:0..stacksize; maxinstack:0..stacksize;curinput:instaterecord;{:582}{585:}inopen:0..15; openparens:0..15;inputfile:array[1..15]of alphafile; linestack:array[0..15]of integer;inamestack:array[0..15]of strnumber; iareastack:array[0..15]of strnumber;mpxname:array[0..15]of halfword; {:585}{587:}paramstack:array[0..150]of halfword;paramptr:0..150; maxparamstack:integer;{:587}{589:}fileptr:0..stacksize;{:589}{618:} scannerstatus:0..7;warninginfo:integer;{:618}{641:}forceeof:boolean; {:641}{671:}bgloc,egloc:1..9771;{:671}{710:}condptr:halfword; iflimit:0..4;curif:smallnumber;ifline:integer;{:710}{724:} loopptr:halfword;{:724}{743:}curname:strnumber;curarea:strnumber; curext:strnumber;{:743}{745:}areadelimiter:integer;extdelimiter:integer; {:745}{752:}memdefaultlength:integer;MPmemdefault:^char; troffmode:boolean;{:752}{760:}jobname:strnumber;logopened:boolean; texmflogname:strnumber;{:760}{775:}oldfilename:^char; oldnamelength:0..maxint;{:775}{780:} rdfile:array[readfindex]of alphafile; rdfname:array[readfindex]of strnumber;readfiles:readfindex; wrfile:array[writeindex]of alphafile; wrfname:array[writeindex]of strnumber;writefiles:writeindex;{:780}{784:} curtype:smallnumber;curexp:integer;{:784}{801:} maxc:array[17..18]of integer;maxptr:array[17..18]of halfword; maxlink:array[17..18]of halfword;{:801}{809:}varflag:0..84;{:809}{903:} sepic:halfword;sesf:scaled;{:903}{927:}eofline:strnumber;{:927}{961:} txx,txy,tyx,tyy,tx,ty:scaled;{:961}{1085:}lastaddtype:quarterword; {:1085}{1101:}startsym:halfword;{:1101}{1109:}longhelpseen:boolean; {:1109}{1118:}tfmfile:bytefile;metricfilename:strnumber;{:1118}{1127:} 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 0..ligtablesize; headerbyte:array[1..headersize]of-1..255; ligkern:array[0..ligtablesize]of fourquarters;nl:0..32511; kern:array[0..maxkerns]of scaled;nk:0..maxkerns; exten:array[eightbits]of fourquarters;ne:0..256; param:array[1..maxfontdimen]of scaled;np:0..maxfontdimen; nw,nh,nd,ni:0..256;skiptable:array[eightbits]of 0..ligtablesize; lkstarted:boolean;bchar:integer;bchlabel:0..ligtablesize; ll,lll:0..ligtablesize;labelloc:array[0..256]of-1..ligtablesize; labelchar:array[1..256]of eightbits;labelptr:0..256;{:1127}{1150:} perturbation:scaled;excess:integer;{:1150}{1156:} dimenhead:array[1..4]of halfword;{:1156}{1161:}maxtfmdimen:scaled; tfmchanged:integer;{:1161}{1173:}tfminfile:bytefile;{:1173}{1175:} fontinfo:array[0..fontmemsize]of memoryword;nextfmem:0..fontmemsize; lastfnum:fontnumber;fontdsize:array[fontnumber]of scaled; fontname:array[fontnumber]of strnumber; fontpsname:array[fontnumber]of strnumber;lastpsfnum:fontnumber; fontbc,fontec:array[fontnumber]of eightbits;{:1175}{1176:} charbase:array[fontnumber]of 0..fontmemsize; widthbase:array[fontnumber]of 0..fontmemsize; heightbase:array[fontnumber]of 0..fontmemsize; depthbase:array[fontnumber]of 0..fontmemsize;{:1176}{1196:} pstabfile:alphafile;{:1196}{1204:}firstfilename,lastfilename:strnumber; firstoutputcode,lastoutputcode:integer;totalshipped:integer;{:1204} {1212:}neednewpath:boolean;{:1212}{1215:}gsred,gsgreen,gsblue:scaled; gsljoin,gslcap:quarterword;gsmiterlim:scaled;gsdashp:halfword; gsdashsc:scaled;gswidth:scaled;gsadjwx:boolean;{:1215}{1250:} fontsizes:array[fontnumber]of halfword;{:1250}{1254:} lastpending:halfword;{:1254}{1277:}memident:strnumber;{:1277}{1282:} memfile:wordfile;{:1282}{1297:}readyalready:integer;{:1297}{1309:} editnamestart:poolpointer;editnamelength,editline:integer;{:1309} procedure initialize;var{19:}i:integer;{:19}{145:}k:integer;{:145} begin{21:}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]:='~';{:21}{22:} for i:=0 to 31 do xchr[i]:=chr(i);for i:=127 to 255 do xchr[i]:=chr(i); {:22}{23:}for i:=0 to 255 do xord[chr(i)]:=127; for i:=128 to 255 do xord[xchr[i]]:=i; for i:=0 to 126 do xord[xchr[i]]:=i;{:23}{84:} if interactionoption=4 then interaction:=3 else interaction:= interactionoption;{:84}{87:}deletionsallowed:=true;errorcount:=0;{:87} {90:}helpptr:=0;useerrhelp:=false;errhelp:=0;{:90}{107:}interrupt:=0; OKtointerrupt:=true;{:107}{113:}aritherror:=false;{:113}{146:} 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;{:146}{153:}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;{:153}{194:}ifdef('TEXMF_DEBUG')wasmemend:=0; waslomax:=0;washimin:=memmax;panicking:=false;endif('TEXMF_DEBUG'){:194} {209:}for k:=1 to 33 do internal[k]:=0;intptr:=33;{:209}{217:} 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; for k:=127 to 255 do charclass[k]:=20;charclass[9]:=2;charclass[12]:=2; {:217}{220:}hash[1].lh:=0;hash[1].rh:=0;eqtb[1].lh:=43;eqtb[1].rh:=0; for k:=2 to 9771 do begin hash[k]:=hash[1];eqtb[k]:=eqtb[1];end;{:220} {250:}bignodesize[12]:=12;bignodesize[14]:=4;bignodesize[13]:=6; sector0[12]:=5;sector0[14]:=5;sector0[13]:=11; for k:=5 to 10 do sectoroffset[k]:=2*(k-5); for k:=11 to 13 do sectoroffset[k]:=2*(k-11);{:250}{270:}saveptr:=0; {:270}{374:}halfcos[0]:=134217728;halfcos[1]:=94906266;halfcos[2]:=0; dcos[0]:=35596755;dcos[1]:=25170707;dcos[2]:=0; for k:=3 to 4 do begin halfcos[k]:=-halfcos[4-k];dcos[k]:=-dcos[4-k]; end;for k:=5 to 7 do begin halfcos[k]:=halfcos[8-k];dcos[k]:=dcos[8-k]; end;{:374}{402:}grobjectsize[1]:=6;grobjectsize[2]:=8; grobjectsize[3]:=14;grobjectsize[4]:=2;grobjectsize[6]:=2; grobjectsize[5]:=2;grobjectsize[7]:=2;{:402}{465:}specp1:=0;specp2:=0; {:465}{547:}fixneeded:=false;watchcoefs:=true;{:547}{711:}condptr:=0; iflimit:=0;curif:=0;ifline:=0;{:711}{725:}loopptr:=0;{:725}{744:} curname:=284;curarea:=284;curext:=284;{:744}{781:}readfiles:=0; writefiles:=0;{:781}{785:}curexp:=0;{:785}{810:}varflag:=0;{:810}{928:} eofline:=0;{:928}{1102:}startsym:=0;{:1102}{1110:}longhelpseen:=false; {:1110}{1128:}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;skiptable[k]:=ligtablesize;end; for k:=1 to headersize do headerbyte[k]:=-1;bc:=255;ec:=0;nl:=0;nk:=0; ne:=0;np:=0;internal[31]:=-65536;bchlabel:=ligtablesize;labelloc[0]:=-1; labelptr:=0;{:1128}{1205:}firstfilename:=284;lastfilename:=284; firstoutputcode:=32768;lastoutputcode:=-32768;totalshipped:=0;{:1205} {1255:}lastpending:=memtop-3;{:1255}{1278:}memident:=0;{:1278}{1310:} editnamestart:=0;{:1310}end;{72:}procedure println; begin case selector of 10:begin writeln(stdout);writeln(logfile); termoffset:=0;fileoffset:=0;end;9:begin writeln(logfile);fileoffset:=0; end;8:begin writeln(stdout);termoffset:=0;end;5:begin writeln(psfile); psoffset:=0;end;7,6,4:;others:writeln(wrfile[selector])end;end;{:72} {73:}procedure unitstrroom;forward; procedure printvisiblechar(s:ASCIIcode);label 30; begin case selector of 10:begin write(stdout,xchr[s]); write(logfile,xchr[s]);incr(termoffset);incr(fileoffset); if termoffset=maxprintline then begin writeln(stdout);termoffset:=0;end; if fileoffset=maxprintline then begin writeln(logfile);fileoffset:=0; end;end;9:begin write(logfile,xchr[s]);incr(fileoffset); if fileoffset=maxprintline then println;end; 8:begin write(stdout,xchr[s]);incr(termoffset); if termoffset=maxprintline then println;end; 5:begin write(psfile,xchr[s]);incr(psoffset);end;7:; 6:if tally=maxpoolptr then begin unitstrroom; if poolptr>=poolsize then goto 30;end;begin strpool[poolptr]:=s; incr(poolptr);end;end;others:write(wrfile[selector],xchr[s])end; 30:incr(tally);end;{:73}{74:}procedure printchar(k:ASCIIcode); var l:0..255;begin if selector<6 then printvisiblechar(k)else if{64:} (k<32)or(k>126){:64}then begin printvisiblechar(94); printvisiblechar(94); if k<64 then printvisiblechar(k+64)else if k<128 then printvisiblechar(k -64)else begin l:=k div 16; if l<10 then printvisiblechar(l+48)else printvisiblechar(l+87); l:=k mod 16; if l<10 then printvisiblechar(l+48)else printvisiblechar(l+87);end; end else printvisiblechar(k);end;{:74}{75:}procedure print(s:integer); var j:poolpointer;begin if(s<0)or(s>maxstrptr)then s:=260; j:=strstart[s]; while j0)or(fileoffset>0)then println; 9:if fileoffset>0 then println;8:if termoffset>0 then println; 5:if psoffset>0 then println;7,6,4:;end;print(s);end;{:77}{78:} procedure printthedigs(k:eightbits);begin while k>0 do begin decr(k); printchar(48+dig[k]);end;end;{:78}{79:}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; incr(n);end;end;end;repeat dig[k]:=n mod 10;n:=n div 10;incr(k); until n=0;printthedigs(k);end;{:79}{118:} 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;{:118}{119:}procedure printtwo(x,y:scaled); begin printchar(40);printscaled(x);printchar(44);printscaled(y); printchar(41);end;{:119}{205:}procedure printtype(t:smallnumber); begin case t of 1:print(324);2:print(325);3:print(326);4:print(259); 5:print(327);6:print(328);7:print(329);8:print(330);9:print(331); 10:print(332);11:print(333);12:print(334);13:print(335);14:print(336); 16:print(337);17:print(338);18:print(339);15:print(340);19:print(341); 20:print(342);21:print(343);22:print(344);23:print(345); others:print(346)end;end;{:205}{213:}{588:}function trueline:integer; var k:0..stacksize; begin if(curinput.indexfield<=15)and(curinput.namefield>2)then trueline :=linestack[curinput.indexfield]else begin k:=inputptr; while(k>0)and(inputstack[k].indexfield>15)or(inputstack[k].namefield<=2) do decr(k);trueline:=linestack[k];end;end;{:588} procedure begindiagnostic;begin oldsetting:=selector; if selector=5 then selector:=nonpssetting; if(internal[12]<=0)and(selector=10)then begin decr(selector); if history=0 then history:=1;end;end; procedure enddiagnostic(blankline:boolean);begin printnl(284); if blankline then println;selector:=oldsetting;end;{:213}{215:} procedure printdiagnostic(s,t:strnumber;nuline:boolean); begin begindiagnostic;if nuline then printnl(s)else print(s);print(463); printint(trueline);print(t);printchar(58);end;{:215}{750:} procedure printfilename(n,a,e:integer);begin print(a);print(n);print(e); end;{:750}{88:}procedure normalizeselector;forward;procedure getnext; forward;procedure terminput;forward;procedure showcontext;forward; procedure beginfilereading;forward;procedure openlogfile;forward; procedure closefilesandterminate;forward;procedure clearforerrorprompt; forward;ifdef('TEXMF_DEBUG')procedure debughelp;forward; endif('TEXMF_DEBUG'){45:}procedure flushstring(s:strnumber); begin ifdef('STAT')poolinuse:=poolinuse-(strstart[nextstr[s]]-strstart[s ]);decr(strsinuse); endif('STAT')if nextstr[s]<>strptr then strref[s]:=0 else begin strptr:= s;decr(strsusedup);end;poolptr:=strstart[strptr];end;{:45}{:88}{91:} procedure jumpout;begin closefilesandterminate;begin fflush(stdout); readyalready:=0;if(history<>0)and(history<>1)then uexit(1)else uexit(0); end;end;{:91}{92:}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{93:} while true do begin 22:clearforerrorprompt;begin;print(264);terminput; end;if last=first then goto 10;c:=buffer[first];if c>=97 then c:=c-32; {94:} case c of 48,49,50,51,52,53,54,55,56,57:if deletionsallowed then{98:} begin 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; {715:} if curcmd=41 then begin if strref[curmod]<127 then if strref[curmod]>1 then decr(strref[curmod])else flushstring(curmod);end{:715};decr(c);end; curcmd:=s1;curmod:=s2;cursym:=s3;OKtointerrupt:=true;begin helpptr:=2; helpline[1]:=277;helpline[0]:=278;end;showcontext;goto 22;end{:98}; ifdef('TEXMF_DEBUG')68:begin debughelp;goto 22;end; endif('TEXMF_DEBUG')69:if fileptr>0 then begin editnamestart:=strstart[ inputstack[fileptr].namefield]; editnamelength:=(strstart[nextstr[inputstack[fileptr].namefield]]- strstart[inputstack[fileptr].namefield]);editline:=trueline;jumpout;end; 72:{99:}begin if useerrhelp then begin{100:}j:=strstart[errhelp]; while j37 then print( strpool[j])else if j+1=strstart[nextstr[errhelp]]then println else if strpool[j+1]<>37 then println else begin incr(j);printchar(37);end; incr(j);end{:100};useerrhelp:=false; end else begin if helpptr=0 then begin helpptr:=2;helpline[1]:=279; helpline[0]:=280;end;repeat decr(helpptr);print(helpline[helpptr]); println;until helpptr=0;end;begin helpptr:=4;helpline[3]:=281; helpline[2]:=280;helpline[1]:=282;helpline[0]:=283;end;goto 22;end{:99}; 73:{97:}begin beginfilereading; if last>first+1 then begin curinput.locfield:=first+1;buffer[first]:=32; end else begin begin;print(276);terminput;end;curinput.locfield:=first; end;first:=last+1;curinput.limitfield:=last;goto 10;end{:97}; 81,82,83:{96:}begin errorcount:=0;interaction:=0+c-81;print(271); case c of 81:begin print(272);decr(selector);end;82:print(273); 83:print(274);end;print(275);println;fflush(stdout);goto 10;end{:96}; 88:begin interaction:=2;jumpout;end;others:end;{95:}begin print(265); printnl(266);printnl(267);if fileptr>0 then print(268); if deletionsallowed then printnl(269);printnl(270);end{:95}{:94}; end{:93};incr(errorcount);if errorcount=100 then begin printnl(263); history:=3;jumpout;end;{101:}if interaction>0 then decr(selector); if useerrhelp then begin printnl(284);{100:}j:=strstart[errhelp]; while j37 then print( strpool[j])else if j+1=strstart[nextstr[errhelp]]then println else if strpool[j+1]<>37 then println else begin incr(j);printchar(37);end; incr(j);end{:100};end else while helpptr>0 do begin decr(helpptr); printnl(helpline[helpptr]);end;println; if interaction>0 then incr(selector);println{:101};10:end;{:92}{103:} procedure fatalerror(s:strnumber);begin normalizeselector; begin if interaction=3 then;printnl(262);print(285);end; begin helpptr:=1;helpline[0]:=s;end; begin if interaction=3 then interaction:=2;if logopened then error; ifdef('TEXMF_DEBUG')if interaction>0 then debughelp; endif('TEXMF_DEBUG')history:=3;jumpout;end;end;{:103}{104:} procedure overflow(s:strnumber;n:integer);begin normalizeselector; begin if interaction=3 then;printnl(262);print(286);end;print(s); printchar(61);printint(n);printchar(93);begin helpptr:=2; helpline[1]:=287;helpline[0]:=288;end; begin if interaction=3 then interaction:=2;if logopened then error; ifdef('TEXMF_DEBUG')if interaction>0 then debughelp; endif('TEXMF_DEBUG')history:=3;jumpout;end;end;{:104}{105:} procedure confusion(s:strnumber);begin normalizeselector; if history<2 then begin begin if interaction=3 then;printnl(262); print(289);end;print(s);printchar(41);begin helpptr:=1;helpline[0]:=290; end;end else begin begin if interaction=3 then;printnl(262);print(291); end;begin helpptr:=2;helpline[1]:=292;helpline[0]:=293;end;end; begin if interaction=3 then interaction:=2;if logopened then error; ifdef('TEXMF_DEBUG')if interaction>0 then debughelp; endif('TEXMF_DEBUG')history:=3;jumpout;end;end;{:105}{:4}{30:} {[34:]if memident=0 then begin writeln(stdout,'Buffer size exceeded!'); goto 9999;end else begin curinput.locfield:=first; curinput.limitfield:=last-1;overflow(256,bufsize);end[:34]}{:30}{36:} function initterminal:boolean;label 10;begin topenin; if last>first then begin curinput.locfield:=first; while(curinput.locfieldstrptr)do begin incr(fixedstruse); lastfixedstr:=t;t:=nextstr[t];end;struse:=fixedstruse{:50}; r:=lastfixedstr;s:=nextstr[r];p:=strstart[s]; while s<>strptr do begin while strref[s]=0 do{51:}begin t:=s; s:=nextstr[s];nextstr[r]:=s;nextstr[t]:=nextstr[strptr]; nextstr[strptr]:=t;if s=strptr then goto 30;end{:51};r:=s;s:=nextstr[s]; incr(struse);{52:}q:=strstart[r];strstart[r]:=p; while q=maxstrings-1 then begin stroverflowed:=true; overflow(257,maxstrings-1-initstruse);end; if poolptr+needed>maxpoolptr then if poolptr+needed>poolsize then begin stroverflowed:=true;overflow(258,poolsize-initpoolptr); end else maxpoolptr:=poolptr+needed;end{:55};ifdef('STAT'){57:} if(strstart[strptr]<>poolinuse)or(struse<>strsinuse)then confusion(259); incr(pactcount); pactchars:=pactchars+poolptr-strstart[nextstr[lastfixedstr]]; pactstrs:=pactstrs+struse-fixedstruse;ifdef('TEXMF_DEBUG')s:=strptr; t:=struse;while s<=maxstrptr do begin if t>maxstrptr then confusion(34); incr(t);s:=nextstr[s];end;if t<=maxstrptr then confusion(34); endif('TEXMF_DEBUG'){:57};endif('STAT')strsusedup:=struse;end;{:49}{43:} procedure unitstrroom; begin if poolptr>=poolsize then docompaction(poolsize); if poolptr>=maxpoolptr then maxpoolptr:=poolptr+1;end;{:43} function makestring:strnumber;label 20;var s:strnumber; begin 20:s:=strptr;strptr:=nextstr[s]; if strptr>maxstrptr then if strptr=maxstrings then begin strptr:=s; docompaction(0);goto 20; end else begin ifdef('TEXMF_DEBUG')if strsusedup<>maxstrptr then confusion(115);endif('TEXMF_DEBUG')maxstrptr:=strptr; nextstr[strptr]:=maxstrptr+1;end;strref[s]:=1;strstart[strptr]:=poolptr; incr(strsusedup);ifdef('STAT')incr(strsinuse); poolinuse:=poolinuse+(strstart[nextstr[s]]-strstart[s]); if poolinuse>maxplused then maxplused:=poolinuse; if strsinuse>maxstrsused then maxstrsused:=strsinuse; endif('STAT')makestring:=s;end;{:46}{47:} procedure choplaststring(p:poolpointer); begin ifdef('STAT')poolinuse:=poolinuse-(strstart[strptr]-p); endif('STAT');strstart[strptr]:=p;end;{:47}{60:} function streqbuf(s:strnumber;k:integer):boolean;label 45; var j:poolpointer;result:boolean;begin j:=strstart[s]; while jbuffer[k]then begin result:=false;goto 45;end;incr(j);incr(k);end;result:=true; 45:streqbuf:=result;end;{:60}{61:} function strvsstr(s,t:strnumber):integer;label 10;var j,k:poolpointer; ls,lt:integer;l:integer;begin ls:=(strstart[nextstr[s]]-strstart[s]); lt:=(strstart[nextstr[t]]-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;incr(j);incr(k);decr(l);end;strvsstr:=ls-lt; 10:end;{:61}{62:}ifdef('INIMP')function getstringsstarted:boolean; label 30,10;var k,l:0..255;m,n:ASCIIcode;g:strnumber;a:integer; c:boolean;begin poolptr:=0;strptr:=0;maxpoolptr:=0;maxstrptr:=0; strstart[0]:=0;nextstr[0]:=1;stroverflowed:=false; ifdef('STAT')poolinuse:=0;strsinuse:=0;maxplused:=0;maxstrsused:=0;{59:} pactcount:=0;pactchars:=0;pactstrs:=0{:59};endif('STAT')strsusedup:=0; {63:}for k:=0 to 255 do begin begin strpool[poolptr]:=k;incr(poolptr); end;g:=makestring;strref[g]:=127;end;{:63};{66:} namelength:=strlen(poolname);nameoffile:=xmalloc(1+namelength+1); strcpy(nameoffile+1,poolname); if aopenin(poolfile,kpsemppoolformat)then begin c:=false;repeat{67:} begin if eof(poolfile)then begin; writeln(stdout,'! mp.pool has no check sum.');aclose(poolfile); getstringsstarted:=false;goto 10;end;read(poolfile,m);read(poolfile,n); if m='*'then{68:}begin a:=0;k:=1; while true do begin if(xord[n]<48)or(xord[n]>57)then begin; writeln(stdout,'! mp.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;incr(k);read(poolfile,n);end; 30:if a<>136687108 then begin;writeln(stdout, '! mp.pool doesn''t match; tangle me again (or fix the path).'); aclose(poolfile);getstringsstarted:=false;goto 10;end;c:=true;end{:68} else begin if(xord[m]<48)or(xord[m]>57)or(xord[n]<48)or(xord[n]>57)then begin;writeln(stdout,'! mp.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(stdout,'! You have to increase POOLSIZE.');aclose(poolfile); getstringsstarted:=false;goto 10;end; if strptr+stringsvacant>=maxstrings then begin; writeln(stdout,'! You have to increase MAXSTRINGS.');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];incr(poolptr);end;end;readln(poolfile); g:=makestring;strref[g]:=127;end;end{:67};until c;aclose(poolfile); getstringsstarted:=true;end else begin; writeln(stdout,'! I can''t read mp.pool; bad path?');aclose(poolfile); getstringsstarted:=false;goto 10;end{:66};lastfixedstr:=strptr-1; fixedstruse:=strptr;10:end;endif('INIMP'){:62}{80:} procedure printdd(n:integer);begin n:=abs(n)mod 100; printchar(48+(n div 10));printchar(48+(n mod 10));end;{:80}{81:} procedure terminput;var k:0..bufsize;begin fflush(stdout); if not inputln(stdin,true)then fatalerror(261);termoffset:=0; decr(selector); if last<>first then for k:=first to last-1 do print(buffer[k]);println; buffer[last]:=37;incr(selector);end;{:81}{102:} procedure normalizeselector; begin if logopened then selector:=10 else selector:=8; if jobname=0 then openlogfile;if interaction=0 then decr(selector);end; {:102}{108:}procedure pauseforinstructions; begin if OKtointerrupt then begin interaction:=3; if(selector=9)or(selector=7)then incr(selector); begin if interaction=3 then;printnl(262);print(294);end; begin helpptr:=3;helpline[2]:=295;helpline[1]:=296;helpline[0]:=297;end; deletionsallowed:=false;error;deletionsallowed:=true;interrupt:=0;end; end;{:108}{109:}procedure missingerr(s:strnumber); begin begin if interaction=3 then;printnl(262);print(298);end;print(s); print(299);end;{:109}{114:}procedure cleararith; begin begin if interaction=3 then;printnl(262);print(300);end; begin helpptr:=4;helpline[3]:=301;helpline[2]:=302;helpline[1]:=303; helpline[0]:=304;end;error;aritherror:=false;end;{:114}{115:} 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;{:115}{117:} function rounddecimals(k:smallnumber):scaled;var a:integer;begin a:=0; while k>0 do begin decr(k);a:=(a+dig[k]*131072)div 10;end; rounddecimals:=halfp(a+1);end;{:117}{122:} ifdef('FIXPT')function makefraction(p,q:integer):fraction;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 ifdef('TEXMF_DEBUG')if q=0 then confusion(47); endif('TEXMF_DEBUG')q:=-q;negative:=not negative;end;n:=p div q; p:=p mod q;if n>=8 then begin aritherror:=true; if negative then makefraction:=-2147483647 else makefraction:=2147483647 ;end else begin n:=(n-1)*268435456;{123:}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>=268435456;becareful:=p-q;if becareful+p>=0 then incr(f){:123}; if negative then makefraction:=-(f+n)else makefraction:=f+n;end;end; endif('FIXPT'){:122}{124:}ifdef('FIXPT')function takefraction(q:integer; f:fraction):integer;var p:integer;negative:boolean;n:integer; becareful:integer;begin{125:} if f>=0 then negative:=false else begin f:=-f;negative:=true;end; if q<0 then begin q:=-q;negative:=not negative;end;{:125}; if f<268435456 then n:=0 else begin n:=f div 268435456; f:=f mod 268435456; if q<=2147483647 div n then n:=n*q else begin aritherror:=true; n:=2147483647;end;end;f:=f+268435456;{126:}p:=134217728; if q<1073741824 then repeat if odd(f)then p:=halfp(p+q)else p:=halfp(p); f:=halfp(f); until f=1 else repeat if odd(f)then p:=p+halfp(q-p)else p:=halfp(p); f:=halfp(f);until f=1{:126};becareful:=n-2147483647; if becareful+p>0 then begin aritherror:=true;n:=2147483647-p;end; if negative then takefraction:=-(n+p)else takefraction:=n+p;end; endif('FIXPT'){:124}{127:}ifdef('FIXPT')function takescaled(q:integer; f:scaled):integer;var p:integer;negative:boolean;n:integer; becareful:integer;begin{125:} if f>=0 then negative:=false else begin f:=-f;negative:=true;end; if q<0 then begin q:=-q;negative:=not negative;end;{:125}; 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;{128:}p:=32768; if q<1073741824 then repeat if odd(f)then p:=halfp(p+q)else p:=halfp(p); f:=halfp(f); until f=1 else repeat if odd(f)then p:=p+halfp(q-p)else p:=halfp(p); f:=halfp(f);until f=1{:128};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; endif('FIXPT'){:127}{129:} ifdef('FIXPT')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 ifdef('TEXMF_DEBUG')if q=0 then confusion(47); endif('TEXMF_DEBUG')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;{130:}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 incr(f){:130}; if negative then makescaled:=-(f+n)else makescaled:=f+n;end;end; endif('FIXPT'){:129}{131:}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;{:131}{132:} function abvscd(a,b,c,d:integer):integer;label 10;var q,r:integer; begin{133:}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{:133}; 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;{:132}{136:} function squarert(x:scaled):scaled;var k:smallnumber;y,q:integer; begin if x<=0 then{137:} begin if x<0 then begin begin if interaction=3 then;printnl(262); print(305);end;printscaled(x);print(306);begin helpptr:=2; helpline[1]:=307;helpline[0]:=308;end;error;end;squarert:=0;end{:137} else begin k:=23;q:=2;while x<536870912 do begin decr(k);x:=x+x+x+x;end; if x<1073741824 then y:=0 else begin x:=x-1073741824;y:=1;end; repeat{138:}x:=x+x;y:=y+y;if x>=1073741824 then begin x:=x-1073741824; incr(y);end;x:=x+x;y:=y+y-q;q:=q+q; if x>=1073741824 then begin x:=x-1073741824;incr(y);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;decr(k){:138};until k=0;squarert:=halfp(q);end;end;{:136} {139:}function pythadd(a,b:integer):integer;label 30;var r:fraction; big:boolean;begin a:=abs(a);b:=abs(b);if a0 then begin if a<536870912 then big:=false else begin a:=a div 4; b:=b div 4;big:=true;end;{140:}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:{:140}; if big then if a<536870912 then a:=a+a+a+a else begin aritherror:=true; a:=2147483647;end;end;pythadd:=a;end;{:139}{141:} function pythsub(a,b:integer):integer;label 30;var r:fraction; big:boolean;begin a:=abs(a);b:=abs(b);if a<=b then{143:} begin if a1073741828 do{148:}begin z:=((x-1)div twotothe[k])+1; while x<1073741824+z do begin z:=halfp(z+1);k:=k+1;end;y:=y+speclog[k]; x:=x-z;end{:148};mlog:=y div 8;end;end;{:147}{150:} 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;{151:}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;incr(k);end{:151}; if x<=127919879 then mexp:=(y+8)div 16 else mexp:=y;end;end;{:150}{154:} 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=536870912 do begin x:=halfp(x); y:=halfp(y);end;z:=0; if y>0 then begin while x<268435456 do begin x:=x+x;y:=y+y;end;{158:} k:=0;repeat y:=y+y;incr(k);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;incr(k); if y>x then begin z:=z+specatan[k];y:=y-x;end;until k=26{:158};end{:157} ;{156:}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{:156};end;end;{:154}{160:} 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;{162:}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;incr(k);end; if y<0 then y:=0{:162};{161:}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{:161};r:=pythadd(x,y);ncos:=makefraction(x,r); nsin:=makefraction(y,r);end;{:160}{164:}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;{:164} {165:}procedure initrandoms(seed:scaled);var j,jj,k:fraction;i:0..54; begin j:=abs(seed);while j>=268435456 do j:=halfp(j);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;{:165} {166:}function unifrand(x:scaled):scaled;var y:scaled; begin if jrandom=0 then newrandoms else decr(jrandom); y:=takefraction(abs(x),randoms[jrandom]); if y=abs(x)then unifrand:=0 else if x>0 then unifrand:=y else unifrand:= -y;end;{:166}{167:}function normrand:scaled;var x,u,l:integer; begin repeat repeat if jrandom=0 then newrandoms else decr(jrandom); x:=takefraction(112429,randoms[jrandom]-134217728); if jrandom=0 then newrandoms else decr(jrandom);u:=randoms[jrandom]; until abs(x)=0;normrand:=x;end;{:167}{172:} ifdef('TEXMF_DEBUG')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;endif('TEXMF_DEBUG'){:172}{177:}{236:} 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<>0)and(tallymemend)then begin print(505);goto 10;end; if p4 then print(508)else begin printchar(34); print(mem[p+1].int);printchar(34);c:=4; end else if(mem[p].hh.b1<>14)or(mem[p].hh.b0<1)or(mem[p].hh.b0>19)then print(508)else begin gpointer:=p;printcapsule;c:=8;end{:238} else begin r:=mem[p].hh.lh;if r>=9772 then{241:} begin if r<9922 then begin print(510);r:=r-(9772); end else if r<10072 then begin print(511);r:=r-(9922); end else begin print(512);r:=r-(10072);end;printint(r);printchar(41); c:=8;end{:241}else if r<1 then if r=0 then{240:} begin if class=17 then printchar(32);print(509);c:=18;end{:240} else print(506)else begin r:=hash[r].rh; if(r<0)or(r>maxstrptr)then print(507)else{242:} begin c:=charclass[strpool[strstart[r]]]; if c=class then case c of 9:printchar(46);5,6,7,8:; others:printchar(32)end;print(r);end{:242};end;end{:237};class:=c; p:=mem[p].hh.rh;end;if p<>0 then print(504);10:end;{:236}{625:} procedure runaway;begin if scannerstatus>2 then begin printnl(658); case scannerstatus of 3:print(659);4,5:print(660);6:print(661);end; println;showtokenlist(mem[memtop-2].hh.rh,0,errorline-10,0);end;end; {:625}{:177}{178:}function getavail:halfword;var p:halfword; begin p:=avail; if p<>0 then avail:=mem[avail].hh.rh else if memendtoint(p+1)then{185:}begin mem[p].hh.lh:=r-p;rover:=p;goto 40; end{:185};if r=p then if mem[p+1].hh.rh<>p then{186:} 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{:186};mem[p].hh.lh:=q-p{:184}; p:=mem[p+1].hh.rh;until p=rover; if s=1073741824 then begin getnode:=268435455;goto 10;end; if lomemmax+2=1998 then t:=lomemmax+1000 else t:=lomemmax +1+(himemmin-lomemmax)div 2;if t>268435455 then t:=268435455; 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:=268435455;mem[q].hh.lh:=t-lomemmax;lomemmax:=t; mem[lomemmax].hh.rh:=0;mem[lomemmax].hh.lh:=0;rover:=q;goto 20;end{:183} ;overflow(315,memmax+1);40:mem[r].hh.rh:=0; ifdef('STAT')varused:=varused+s;endif('STAT')getnode:=r;10:end;{:182} {187:}procedure freenode(p:halfword;s:halfword);var q:halfword; begin mem[p].hh.lh:=s;mem[p].hh.rh:=268435455;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;ifdef('STAT')varused:=varused-s;endif('STAT')end; {:187}{188:}ifdef('INIMP')procedure sortavail;var p,q,r:halfword; oldrover:halfword;begin p:=getnode(1073741824);p:=mem[rover+1].hh.rh; mem[rover+1].hh.rh:=268435455;oldrover:=rover;while p<>oldrover do{189:} if p268435455 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; endif('INIMP'){:188}{192:}procedure flushlist(p:halfword);label 30; var q,r:halfword;begin if p>=himemmin then if p<>memtop then begin r:=p; repeat q:=r;r:=mem[r].hh.rh;ifdef('STAT')decr(dynused); endif('STAT')if r0 do begin q:=p;p:=mem[p].hh.rh; if q0 do begin if(p>memend)or(p=lomemmax)then clobbered:=true else if(mem[p+1].hh.rh>= lomemmax)then clobbered:=true else if not((mem[p].hh.rh=268435455))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(317); printint(q);goto 32;end; for q:=p to p+mem[p].hh.lh-1 do begin if freearr[q]then begin printnl( 318);printint(q);goto 32;end;freearr[q]:=true;end;q:=p; p:=mem[p+1].hh.rh;until p=rover;32:{:197};{198:}p:=0; while p<=lomemmax do begin if(mem[p].hh.rh=268435455)then begin printnl( 319);printint(p);end;while(p<=lomemmax)and not freearr[p]do incr(p); while(p<=lomemmax)and freearr[p]do incr(p);end{:198};{571:}q:=5; p:=mem[q].hh.rh; while p<>5 do begin if mem[p+1].hh.lh<>q then begin printnl(609); printint(p);end;p:=mem[p+1].hh.rh;while true do begin r:=mem[p].hh.lh; q:=p;p:=mem[q].hh.rh;if r=0 then goto 33; if mem[mem[p].hh.lh+1].int>=mem[r+1].int then begin printnl(610); printint(p);end;end;33:;end{:571};if printlocs then{199:}begin{201:} q:=memmax;r:=memmax{:201};printnl(320); for p:=0 to lomemmax do if not freearr[p]and((p>waslomax)or wasfree[p]) then{200:}begin if p>q+1 then begin if q>r then begin print(321); printint(q);end;printchar(32);printint(p);r:=p;end;q:=p;end{:200}; for p:=himemmin to memend do if not freearr[p]and((p wasmemend)or wasfree[p])then{200:} begin if p>q+1 then begin if q>r then begin print(321);printint(q);end; printchar(32);printint(p);r:=p;end;q:=p;end{:200};{202:} if q>r then begin print(321);printint(q);end{:202};end{:199}; for p:=0 to lomemmax do wasfree[p]:=freearr[p]; for p:=himemmin to memend do wasfree[p]:=freearr[p];wasmemend:=memend; waslomax:=lomemmax;washimin:=himemmin;end;endif('TEXMF_DEBUG'){:195} {203:}ifdef('TEXMF_DEBUG')procedure searchmem(p:halfword);var q:integer; begin for q:=0 to lomemmax do begin if mem[q].hh.rh=p then begin printnl (322);printint(q);printchar(41);end; if mem[q].hh.lh=p then begin printnl(323);printint(q);printchar(41);end; end; for q:=himemmin to memend do begin if mem[q].hh.rh=p then begin printnl( 322);printint(q);printchar(41);end; if mem[q].hh.lh=p then begin printnl(323);printint(q);printchar(41);end; end;{227:} for q:=1 to 9771 do begin if eqtb[q].rh=p then begin printnl(473); printint(q);printchar(41);end;end{:227};end;endif('TEXMF_DEBUG'){:203} {207:}procedure printop(c:quarterword); begin if c<=15 then printtype(c)else case c of 30:print(347); 31:print(348);32:print(349);33:print(350);34:print(351);35:print(352); 36:print(353);37:print(354);38:print(355);39:print(356);40:print(357); 41:print(358);42:print(359);43:print(360);44:print(361);45:print(362); 46:print(363);47:print(364);48:print(365);49:print(366);50:print(367); 51:print(368);52:print(369);53:print(370);54:print(371);55:print(372); 56:print(373);57:print(374);58:print(375);59:print(376);60:print(377); 61:print(378);62:print(379);63:print(380);64:print(381);65:print(382); 66:print(383);67:print(384);68:print(385);69:print(386);70:print(387); 71:print(388);72:print(389);73:print(390);74:print(391);75:print(392); 76:print(393);77:print(394);78:print(395);79:print(396);80:print(397); 81:print(398);82:print(399);83:print(400);84:print(401);85:print(402); 86:print(403);87:print(404);88:print(405);89:printchar(43); 90:printchar(45);91:printchar(42);92:printchar(47);93:print(406); 94:print(310);95:print(407);96:print(408);97:printchar(60); 98:print(409);99:printchar(62);100:print(410);101:printchar(61); 102:print(411);103:print(38);104:print(412);105:print(413); 106:print(414);107:print(415);108:print(416);109:print(417); 110:print(418);111:print(419);112:print(420);113:print(421); 115:print(422);116:print(423);117:print(424);118:print(425); 119:print(426);120:print(427);121:print(428);122:print(429); others:print(321)end;end;{:207}{212:}procedure fixdateandtime; begin dateandtime(internal[16],internal[15],internal[14],internal[13]); internal[16]:=internal[16]*65536;internal[15]:=internal[15]*65536; internal[14]:=internal[14]*65536;internal[13]:=internal[13]*65536;end; {:212}{223:}function idlookup(j,l:integer):halfword;label 40; var h:integer;p:halfword;k:halfword;begin if l=1 then{224:} begin p:=buffer[j]+1;hash[p].rh:=p-1;goto 40;end{:224};{226:} h:=buffer[j];for k:=j+1 to j+l-1 do begin h:=h+h+buffer[k]; while h>=7919 do h:=h-7919;end{:226};p:=h+257; while true do begin if hash[p].rh>0 then if(strstart[nextstr[hash[p].rh] ]-strstart[hash[p].rh])=l then if streqbuf(hash[p].rh,j)then goto 40; if hash[p].lh=0 then{225:} begin if hash[p].rh>0 then begin repeat if(hashused=257)then overflow( 472,9500);decr(hashused);until hash[hashused].rh=0;hash[p].lh:=hashused; p:=hashused;end; begin if poolptr+l>maxpoolptr then if poolptr+l>poolsize then docompaction(l)else maxpoolptr:=poolptr+l;end; for k:=j to j+l-1 do begin strpool[poolptr]:=buffer[k];incr(poolptr); end;hash[p].rh:=makestring;strref[hash[p].rh]:=127; ifdef('STAT')incr(stcount);endif('STAT')goto 40;end{:225};p:=hash[p].lh; end;40:idlookup:=p;end;{:223}{228:} ifdef('INIMP')procedure primitive(s:strnumber;c:halfword;o:halfword); var k:poolpointer;j:smallnumber;l:smallnumber;begin k:=strstart[s]; l:=strstart[nextstr[s]]-k;for j:=0 to l-1 do buffer[j]:=strpool[k+j]; cursym:=idlookup(0,l);if s>=256 then begin flushstring(hash[cursym].rh); hash[cursym].rh:=s;end;eqtb[cursym].lh:=c;eqtb[cursym].rh:=o;end; endif('INIMP'){:228}{234:}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:=15;newnumtok:=p;end;{:234}{235:}procedure tokenrecycle; forward;procedure flushtokenlist(p:halfword);var q:halfword; begin while p<>0 do begin q:=p;p:=mem[p].hh.rh; if q>=himemmin then begin mem[q].hh.rh:=avail;avail:=q; ifdef('STAT')decr(dynused); endif('STAT')end else begin 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 decr(strref[mem[q+1].int])else flushstring(mem[q+1].int);end; 3,5,7,11,9,6,8,10,14,13,12,17,18,19:begin gpointer:=q;tokenrecycle;end; others:confusion(503)end;freenode(q,2);end;end;end;{:235}{245:} procedure deletemacref(p:halfword); begin if mem[p].hh.lh=0 then flushtokenlist(p)else decr(mem[p].hh.lh); end;{:245}{246:}{579:}procedure printcmdmod(c,m:integer); begin case c of{230:}20:print(477);76:print(476);61:print(478); 78:print(475);34:print(479);80:print(58);81:print(44);59:print(480); 62:print(481);29:print(482);79:print(474);83:print(468);28:print(483); 9:print(484);12:print(485);15:print(486);48:print(123);65:print(91); 16:print(487);17:print(488);70:print(489);49:print(321);26:print(490); 10:printchar(92);67:print(125);66:print(93);14:print(491);11:print(492); 82:print(59);19:print(493);77:print(494);30:print(495);72:print(496); 37:print(497);60:print(498);71:print(499);73:print(500);74:print(501); 31:print(502);{:230}{648:}1:if m=0 then print(681)else print(682); 2:print(465);3:print(466);{:648}{656:} 18:if m<=2 then if m=1 then print(695)else if m<1 then print(469)else print(696)else if m=55 then print(697)else if m=46 then print(698)else print(699); 7:if m<=1 then if m=1 then print(702)else print(470)else if m=9772 then print(700)else print(701);{:656}{661:}63:case m of 1:print(704); 2:printchar(64);3:print(705);others:print(703)end;{:661}{668:} 58:if m>=9772 then if m=9772 then print(716)else if m=9922 then print( 717)else print(718)else if m<2 then print(719)else if m=2 then print(720 )else print(721);{:668}{682:}6:if m=0 then print(731)else print(628); {:682}{713:}4,5:case m of 1:print(758);2:print(467);3:print(759); others:print(760)end;{:713}{881:} 35,36,39,57,47,52,38,45,56,50,53,54:printop(m);{:881}{1031:} 32:printtype(m);{:1031}{1036:}84:if m=0 then print(960)else print(961); {:1036}{1042:}25:case m of 0:print(272);1:print(273);2:print(274); others:print(967)end;{:1042}{1045:} 23:if m=0 then print(968)else print(969);{:1045}{1055:} 24:case m of 0:print(983);1:print(984);2:print(985);3:print(986); others:print(987)end;{:1055}{1060:} 33,64:begin if c=33 then print(990)else print(991);print(992); print(hash[m].rh);end;43:if m=0 then print(993)else print(994); 13:print(995);55,46,51:begin printcmdmod(18,c);print(996);println; showtokenlist(mem[mem[m].hh.rh].hh.rh,0,1000,0);end;8:print(997); 42:print(intname[m]);{:1060}{1070:} 69:if m=1 then print(1007)else if m=0 then print(1006)else print(1008); 68:if m=6 then print(1009)else if m=13 then print(1011)else print(1010); {:1070}{1084:}21:if m=4 then print(1020)else print(1021);{:1084}{1104:} 27:if m<1 then print(1034)else if m=1 then print(1035)else print(1036); {:1104}{1133:}22:case m of 0:print(1051);1:print(1052);2:print(1053); 3:print(1054);others:print(1055)end;{:1133}{1140:} 75:case m of 0:print(1073);1:print(1074);2:print(1076);3:print(1078); 5:print(1075);6:print(1077);7:print(1079);11:print(1080); others:print(1081)end;{:1140}others:print(614)end;end;{:579} 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:=0;showtokenlist(p,0,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(513);1,2,3:begin printchar(60); printcmdmod(58,mem[p].hh.lh);print(514);end;4:print(515);5:print(516); 6:print(517);7:print(518);end;showtokenlist(mem[p].hh.rh,q,l-tally,0); 10:end;{:246}{251:}procedure initbignode(p:halfword);var q:halfword; s:smallnumber;begin s:=bignodesize[mem[p].hh.b0];q:=getnode(s); repeat s:=s-2;{540:}begin mem[q+s].hh.b0:=19;serialno:=serialno+64; mem[q+s+1].int:=serialno;end{:540}; mem[q+s].hh.b1:=halfp(s)+sector0[mem[p].hh.b0];mem[q+s].hh.rh:=0; until s=0;mem[q].hh.rh:=p;mem[p+1].int:=q;end;{:251}{252:} function idtransform:halfword;var p,q,r:halfword;begin p:=getnode(2); mem[p].hh.b0:=12;mem[p].hh.b1:=14;mem[p+1].int:=0;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; {:252}{253:}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;{:253}{254:}procedure printvariablename(p:halfword); label 40,10;var q:halfword;r:halfword; begin while mem[p].hh.b1>=5 do{256:} begin case mem[p].hh.b1 of 5:printchar(120);6:printchar(121); 7:print(521);8:print(522);9:print(523);10:print(524);11:print(525); 12:print(526);13:print(527);14:begin print(528);printint(p-0);goto 10; end;end;print(529);p:=mem[p-sectoroffset[mem[p].hh.b1]].hh.rh;end{:256}; q:=0;while mem[p].hh.b1>1 do{255:} begin 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(520);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{:255};r:=getavail;mem[r].hh.lh:=mem[p].hh.rh; mem[r].hh.rh:=q;if mem[p].hh.b1=1 then print(519); showtokenlist(r,0,2147483647,tally);flushtokenlist(r);10:end;{:254} {257:}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<>14 then t:=mem[mem[p-sectoroffset[t]].hh.rh].hh.b1; interesting:=(t<>14);end;end;{:257}{258:} function newstructure(p:halfword):halfword;var q,r:halfword; begin case mem[p].hh.b1 of 0:begin q:=mem[p].hh.rh;r:=getnode(2); eqtb[q].rh:=r;end;3:{259:}begin 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{:259};4:{260:}begin 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{:260}; others:confusion(530)end;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:=9;mem[q+2].hh.lh:=0; newstructure:=r;end;{:258}{261:} 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 85<>43 then begin findvariable:=0;goto 10;end; if eqtb[p].rh=0 then newroot(p);p:=eqtb[p].rh;pp:=p; while t<>0 do begin{262:} if mem[pp].hh.b0<>21 then begin if mem[pp].hh.b0>21 then begin findvariable:=0;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){:262}; if t=21 then if mem[pp].hh.b0=21 then pp:=mem[pp+1].hh.lh else begin findvariable:=0;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:=0;end;mem[p].hh.b0:=mem[pp].hh.b0;mem[p+1].int:=0; end;findvariable:=p;10:end;{:261}{265:}{276:} procedure prpath(h:halfword);label 30,31;var p,q:halfword;begin p:=h; repeat q:=mem[p].hh.rh;if(p=0)or(q=0)then begin printnl(260);goto 30; end;{277:}printtwo(mem[p+1].int,mem[p+2].int); case mem[p].hh.b1 of 0:begin if mem[p].hh.b0=4 then print(532); if(mem[q].hh.b0<>0)or(q<>h)then q:=0;goto 31;end;1:{280:} begin print(538);printtwo(mem[p+5].int,mem[p+6].int);print(537); if mem[q].hh.b0<>1 then print(539)else printtwo(mem[q+3].int,mem[q+4]. int);goto 31;end{:280};4:{281:} if(mem[p].hh.b0<>1)and(mem[p].hh.b0<>4)then print(532){:281};3,2:{282:} begin if mem[p].hh.b0=4 then print(539); if mem[p].hh.b1=3 then begin print(535);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{:282}; others:print(260)end; if mem[q].hh.b0<=1 then print(533)else if(mem[p+6].int<>65536)or(mem[q+4 ].int<>65536)then{279:}begin print(536); if mem[p+6].int<0 then print(478);printscaled(abs(mem[p+6].int)); if mem[p+6].int<>mem[q+4].int then begin print(537); if mem[q+4].int<0 then print(478);printscaled(abs(mem[q+4].int));end; end{:279};31:{:277};p:=q;if(p<>h)or(mem[h].hh.b0<>0)then{278:} begin printnl(534);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(535); printscaled(mem[p+3].int);printchar(125);end;end{:278};until p=h; if mem[h].hh.b0<>0 then print(400);30:end;{:276}{283:} procedure printpath(h:halfword;s:strnumber;nuline:boolean); begin printdiagnostic(540,s,nuline);println;prpath(h); enddiagnostic(true);end;{:283}{363:}procedure prpen(h:halfword); label 30;var p,q:halfword;begin if(h=mem[h].hh.rh)then{365:} begin print(549);printscaled(mem[h+1].int);printchar(44); printscaled(mem[h+2].int);printchar(44); printscaled(mem[h+3].int-mem[h+1].int);printchar(44); printscaled(mem[h+5].int-mem[h+1].int);printchar(44); printscaled(mem[h+4].int-mem[h+2].int);printchar(44); printscaled(mem[h+6].int-mem[h+2].int);printchar(41);end{:365} else begin p:=h;repeat printtwo(mem[p+1].int,mem[p+2].int);printnl(548); {364:}q:=mem[p].hh.rh;if(q=0)or(mem[q].hh.lh<>p)then begin printnl(260); goto 30;end;p:=q{:364};until p=h;print(400);end;30:end;{:363}{366:} procedure printpen(h:halfword;s:strnumber;nuline:boolean); begin printdiagnostic(550,s,nuline);println;prpen(h); enddiagnostic(true);end;{:366}{417:}{397:} function sqrtdet(a,b,c,d:scaled):scaled;var maxabs:scaled;s:integer; begin{398:}maxabs:=abs(a);if abs(b)>maxabs then maxabs:=abs(b); if abs(c)>maxabs then maxabs:=abs(c); if abs(d)>maxabs then maxabs:=abs(d){:398};s:=64; while(maxabs<268435456)and(s>1)do begin a:=a+a;b:=b+b;c:=c+c;d:=d+d; maxabs:=maxabs+maxabs;s:=halfp(s);end; sqrtdet:=s*squarert(abs(takefraction(a,d)-takefraction(b,c)));end; function getpenscale(p:halfword):scaled; begin getpenscale:=sqrtdet(mem[p+3].int-mem[p+1].int,mem[p+5].int-mem[p +1].int,mem[p+4].int-mem[p+2].int,mem[p+6].int-mem[p+2].int);end;{:397} {421:}{422:}procedure printcompactnode(p:halfword;k:smallnumber); var q:halfword;begin q:=p+k-1;printchar(40); while p<=q do begin printscaled(mem[p].int);if p0)or(mem[p+3].int>0)or(mem[p+4].int>0)then begin print(565);printcompactnode(p+2,3);end;end;{:421}{425:} function dashoffset(h:halfword):scaled;var x:scaled; begin if(mem[h].hh.rh=2)or(mem[h+1].int<0)then confusion(573); if mem[h+1].int=0 then x:=0 else begin x:=-(mem[mem[h].hh.rh+1].int mod mem[h+1].int);if x<0 then x:=x+mem[h+1].int;end;dashoffset:=x;end;{:425} procedure printedges(h:halfword;s:strnumber;nuline:boolean); var p:halfword;hh,pp:halfword;scf:scaled;oktodash:boolean; begin printdiagnostic(552,s,nuline);p:=h+7; while mem[p].hh.rh<>0 do begin p:=mem[p].hh.rh;println; case mem[p].hh.b0 of{418:}1:begin print(555);printobjcolor(p); printchar(58);println;prpath(mem[p+1].hh.rh);println; if(mem[p+1].hh.lh<>0)then begin{419:} case mem[p].hh.b1 of 0:begin print(557);printscaled(mem[p+5].int);end; 1:print(558);2:print(559);others:print(560);end{:419};print(556); println;prpen(mem[p+1].hh.lh);end;end;{:418}{423:}2:begin print(566); printobjcolor(p);printchar(58);println;prpath(mem[p+1].hh.rh); if mem[p+6].hh.rh<>0 then begin printnl(567);{424:} oktodash:=(mem[p+1].hh.lh=mem[mem[p+1].hh.lh].hh.rh); if not oktodash then scf:=65536 else scf:=mem[p+7].int; hh:=mem[p+6].hh.rh;pp:=mem[hh].hh.rh; if(pp=2)or(mem[hh+1].int<0)then print(568)else begin mem[3].int:=mem[pp +1].int+mem[hh+1].int;while pp<>2 do begin print(569); printscaled(takescaled(mem[pp+2].int-mem[pp+1].int,scf));print(570); printscaled(takescaled(mem[mem[pp].hh.rh+1].int-mem[pp+2].int,scf)); pp:=mem[pp].hh.rh;if pp<>2 then printchar(32);end;print(571); printscaled(-takescaled(dashoffset(hh),scf)); if not oktodash or(mem[hh+1].int=0)then print(572);end{:424};end; println;{420:}case mem[p+6].hh.b0 of 0:print(561);1:print(562); 2:print(563);others:print(539)end;print(564);{419:} case mem[p].hh.b1 of 0:begin print(557);printscaled(mem[p+5].int);end; 1:print(558);2:print(559);others:print(560);end{:419}{:420};print(556); println;if mem[p+1].hh.lh=0 then print(260)else prpen(mem[p+1].hh.lh); end;{:423}{426:}3:begin printchar(34);print(mem[p+1].hh.rh);print(574); print(fontname[mem[p+1].hh.lh]);printchar(34);println;printobjcolor(p); print(575);printcompactnode(p+8,6);end;{:426}{427:}4:begin print(576); println;prpath(mem[p+1].hh.rh);end;6:print(577);{:427}{428:} 5:begin print(578);println;prpath(mem[p+1].hh.rh);end;7:print(579); {:428}others:begin print(553);end end;end;printnl(554); if p<>mem[h+7].hh.lh then print(63);enddiagnostic(true);end;{:417}{543:} 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=0 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;{544:} 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){:544}; if mem[q].hh.b0<>19 then confusion(600);printvariablename(q); v:=mem[q+1].int mod 64;while v>0 do begin print(601);v:=v-2;end; p:=mem[p].hh.rh;end;10:end;{:543}{789:}{793:} procedure printdp(t:smallnumber;p:halfword;verbosity:smallnumber); var q:halfword;begin q:=mem[p].hh.rh; if(mem[q].hh.lh=0)or(verbosity>0)then printdependency(p,t)else print(814 );end;{:793}{787:}function stashcurexp:halfword;var p:halfword; begin case curtype of 3,5,7,11,9,12,13,14,17,18,19:p:=curexp; others:begin p:=getnode(2);mem[p].hh.b1:=14;mem[p].hh.b0:=curtype; mem[p+1].int:=curexp;end end;curtype:=1;mem[p].hh.rh:=1;stashcurexp:=p; end;{:787}{788:}procedure unstashcurexp(p:halfword); begin curtype:=mem[p].hh.b0; case curtype of 3,5,7,11,9,12,13,14,17,18,19:curexp:=p; others:begin curexp:=mem[p+1].int;freenode(p,2);end end;end;{:788} procedure printexp(p:halfword;verbosity:smallnumber); var restorecurexp:boolean;t:smallnumber;v:integer;q:halfword; begin if p<>0 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;{790:} case t of 1:print(324);2:if v=30 then print(347)else print(348); 3,5,7,11,9,15:{794:}begin printtype(t);if v<>0 then begin printchar(32); while(mem[v].hh.b1=14)and(v<>p)do v:=mem[v+1].int;printvariablename(v); end;end{:794};4:begin printchar(34);print(v);printchar(34);end; 6,8,10:{792:} if verbosity<=1 then printtype(t)else begin if selector=10 then if internal[12]<=0 then begin selector:=8;printtype(t);print(813); selector:=10;end;case t of 6:printpen(v,284,false); 8:printpath(v,284,false);10:printedges(v,284,false);end;end{:792}; 12,13,14:if v=0 then printtype(t)else{791:}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{:791};16:printscaled(v);17,18:printdp(t,v,verbosity); 19:printvariablename(p);others:confusion(812)end{:790}; if restorecurexp then unstashcurexp(p);end;{:789}{795:} procedure disperr(p:halfword;s:strnumber);begin if interaction=3 then; printnl(804);printexp(p,1);if s<>284 then begin printnl(262);print(s); end;end;{:795}{548:}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:=memtop-1; pp:=mem[p].hh.lh;qq:=mem[q].hh.lh; while true do if pp=qq then if pp=0 then goto 30 else{549:} 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)=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{:549}else if mem[pp+1].inthalfp(threshold)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{:550}else begin 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[memtop-1].hh.rh;end;{:548} {554:}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:=memtop-1; while mem[p].hh.lh<>0 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[memtop-1].hh.rh; end;{:554}{556:}procedure valtoobig(x:scaled); begin if internal[30]>0 then begin begin if interaction=3 then; printnl(262);print(602);end;printscaled(x);printchar(41); begin helpptr:=4;helpline[3]:=603;helpline[2]:=604;helpline[1]:=605; helpline[0]:=606;end;error;end;end;{:556}{557:} 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(607);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;{:557}{558:} procedure fixdependencies;label 30;var p,q,r,s,t:halfword;x:halfword; begin r:=mem[5].hh.rh;s:=0;while r<>5 do begin t:=r;{559:}r:=t+1; while true do begin q:=mem[r].hh.rh;x:=mem[q].hh.lh;if x=0 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:{:559};r:=mem[q].hh.rh; if q=mem[t+1].hh.rh then makeknown(t,q);end; while s<>0 do begin p:=mem[s].hh.rh;x:=mem[s].hh.lh; begin mem[s].hh.rh:=avail;avail:=s;ifdef('STAT')decr(dynused); endif('STAT')end;s:=p;mem[x].hh.b0:=19;mem[x+1].int:=mem[x+1].int+2;end; fixneeded:=false;end;{:558}{288:}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;{:288}{406:}{407:} procedure flushdashlist(h:halfword);var p,q:halfword; begin q:=mem[h].hh.rh;while q<>2 do begin p:=q;q:=mem[q].hh.rh; freenode(p,3);end;mem[h].hh.rh:=2;end;{:407}{408:} function tossgrobject(p:halfword):halfword;var e:halfword;begin e:=0; {409:}case mem[p].hh.b0 of 1:begin tossknotlist(mem[p+1].hh.rh); if mem[p+1].hh.lh<>0 then tossknotlist(mem[p+1].hh.lh);end; 2:begin tossknotlist(mem[p+1].hh.rh); if mem[p+1].hh.lh<>0 then tossknotlist(mem[p+1].hh.lh); e:=mem[p+6].hh.rh;end; 3:begin if strref[mem[p+1].hh.rh]<127 then if strref[mem[p+1].hh.rh]>1 then decr(strref[mem[p+1].hh.rh])else flushstring(mem[p+1].hh.rh);end; 4,5:tossknotlist(mem[p+1].hh.rh);6,7:;end;{:409}; freenode(p,grobjectsize[mem[p].hh.b0]);tossgrobject:=e;end;{:408} procedure tossedges(h:halfword);var p,q:halfword;r:halfword; begin flushdashlist(h);q:=mem[h+7].hh.rh;while(q<>0)do begin p:=q; q:=mem[q].hh.rh;r:=tossgrobject(p); if r<>0 then if mem[r].hh.lh=0 then tossedges(r)else decr(mem[r].hh.lh); end;freenode(h,8);end;{:406}{574:}procedure ringdelete(p:halfword); var q:halfword;begin q:=mem[p+1].int; if q<>0 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;{:574}{797:} 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,11,9:ringdelete(p); 4:begin if strref[v]<127 then if strref[v]>1 then decr(strref[v])else flushstring(v);end;8,6:tossknotlist(v); 10:if mem[v].hh.lh=0 then tossedges(v)else decr(mem[v].hh.lh); 14,13,12:{798:}if v<>0 then begin q:=v+bignodesize[t];repeat q:=q-2; recyclevalue(q);until q=v;freenode(v,bignodesize[t]);end{:798}; 17,18:{799:}begin q:=mem[p+1].hh.rh; while mem[q].hh.lh<>0 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:=0; flushnodelist(mem[p+1].hh.rh);end{:799};19:{800:}begin maxc[17]:=0; maxc[18]:=0;maxlink[17]:=0;maxlink[18]:=0;q:=mem[5].hh.rh; while q<>5 do begin s:=q+1;while true do begin r:=mem[s].hh.rh; if mem[r].hh.lh=0 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{802:} begin 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{:802}else begin 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{803:} begin if(maxc[17]div 4096>=maxc[18])then t:=17 else t:=18;{804:} 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<>0 do r:=mem[r].hh.rh;q:=mem[r].hh.rh; mem[r].hh.rh:=0;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{805:}if interesting(p)then begin begindiagnostic; printnl(816);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(601); mem[p+1].int:=mem[p+1].int-2;end; if t=17 then printchar(61)else print(817);printdependency(s,t); enddiagnostic(false);end{:805}{:804};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{806:} for t:=17 to 18 do begin r:=maxlink[t]; while r<>0 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{:806}else{807:} for t:=17 to 18 do begin r:=maxlink[t]; while r<>0 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{:807};flushnodelist(s); if fixneeded then fixdependencies;begin if aritherror then cleararith; end;end{:803};end{:800};20,21:confusion(815); 22,23:deletemacref(mem[p+1].int);end;mem[p].hh.b0:=0;end;{:797}{796:} procedure flushcurexp(v:scaled); begin case curtype of 3,5,7,11,9,12,13,14,17,18,19:begin recyclevalue( curexp);freenode(curexp,2);end; 4:begin if strref[curexp]<127 then if strref[curexp]>1 then decr(strref[ curexp])else flushstring(curexp);end;6,8:tossknotlist(curexp); 10:if mem[curexp].hh.lh=0 then tossedges(curexp)else decr(mem[curexp].hh .lh);others:end;curtype:=16;curexp:=v;end;{:796}{808:} procedure flusherror(v:scaled);begin error;flushcurexp(v);end; procedure backerror;forward;procedure getxnext;forward; procedure putgeterror;begin backerror;getxnext;end; procedure putgetflusherror(v:scaled);begin putgeterror;flushcurexp(v); end;{:808}{266:}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=9;mem[p].hh.b0:=0;end;end;{:266} procedure flushvariable(p,t:halfword;discardsuffixes:boolean);label 10; var q,r:halfword;n:halfword; begin while t<>0 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=0 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;{:265}{267:} 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:undtype:=7;8,9:undtype:=9;10,11:undtype:=11; 12,13,14,15:undtype:=mem[p].hh.b0;16,17,18,19:undtype:=15;end;end;{:267} {268:}procedure clearsymbol(p:halfword;saving:boolean);var q:halfword; begin q:=eqtb[p].rh; case eqtb[p].lh mod 85 of 13,55,46,51:if not saving then deletemacref(q) ;43:if q<>0 then if saving then mem[q].hh.b1:=1 else begin flushbelowvariable(q);freenode(q,2);end;others:end;eqtb[p]:=eqtb[9771]; end;{:268}{271:}procedure savevariable(q:halfword);var p:halfword; begin if saveptr<>0 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<>0));end;{:271}{272:} procedure saveinternal(q:halfword);var p:halfword; begin if saveptr<>0 then begin p:=getnode(2);mem[p].hh.lh:=9771+q; mem[p].hh.rh:=saveptr;mem[p+1].int:=internal[q];saveptr:=p;end;end; {:272}{273:}procedure unsave;var q:halfword;p:halfword; begin while mem[saveptr].hh.lh<>0 do begin q:=mem[saveptr].hh.lh; if q>9771 then begin if internal[7]>0 then begin begindiagnostic; printnl(531);print(intname[q-(9771)]);printchar(61); printscaled(mem[saveptr+1].int);printchar(125);enddiagnostic(false);end; internal[q-(9771)]:=mem[saveptr+1].int; end else begin if internal[7]>0 then begin begindiagnostic;printnl(531); print(hash[q].rh);printchar(125);enddiagnostic(false);end; clearsymbol(q,false);eqtb[q]:=mem[saveptr+1].hh; if eqtb[q].lh mod 85=43 then begin p:=eqtb[q].rh; if p<>0 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; ifdef('STAT')decr(dynused);endif('STAT')end;saveptr:=p;end;{:273}{284:} 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; {:284}{285:}function copypath(p:halfword):halfword;var q,pp,qq:halfword; begin q:=copyknot(p);qq:=q;pp:=mem[p].hh.rh; while pp<>p do begin mem[qq].hh.rh:=copyknot(pp);qq:=mem[qq].hh.rh; pp:=mem[pp].hh.rh;end;mem[qq].hh.rh:=q;copypath:=q;end;{:285}{286:} 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;{:286}{289:}{305:}{317:} 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;{:317}{320:} 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{321:} 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{:321}; 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; {:320}procedure solvechoices(p,q:halfword;n:halfword);label 40,10; var k:0..pathsize;r,s,t:halfword;{307:}aa,bb,cc,ff,acc:fraction; dd,ee:scaled;lt,rt:scaled;{:307}begin k:=0;s:=p; while true do begin t:=mem[s].hh.rh;if k=0 then{306:} case mem[s].hh.b1 of 2:if mem[t].hh.b0=2 then{322:} begin 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{:322}else{314:} begin 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{:314}; 3:if mem[t].hh.b0=3 then{323:}begin 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{:323}else{315:}begin 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{:315};4:begin uu[0]:=0;vv[0]:=0;ww[0]:=268435456;end; end{:306}else case mem[s].hh.b0 of 5,4:{308:}begin{309:} 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){:309};{310:} dd:=takefraction(dd,cc);lt:=abs(mem[s+4].int);rt:=abs(mem[s+6].int); if lt<>rt then if lt188743680 then if theta[n]>0 then theta[n]:=theta[n] -377487360 else theta[n]:=theta[n]+377487360;goto 40;end{:313};end;r:=s; s:=t;incr(k);end;40:{318:} 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); incr(k);s:=t;until k=n{:318};10:end;{:305} procedure makechoices(knots:halfword);label 30;var h:halfword; p,q:halfword;{301:}k,n:0..pathsize;s,t:halfword;delx,dely:scaled; sine,cosine:fraction;{:301}begin begin if aritherror then cleararith; end;if internal[4]>0 then printpath(knots,541,true);{291:}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{:291};{292:}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:{:292};p:=h; repeat{293:}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;{299:}{302:}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; incr(k);s:=t;if k=pathsize then overflow(546,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]{:302};{303:} 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{:303};solvechoices(p,q,n){:299}; end else if mem[p].hh.b1=0 then{294:}begin mem[p+5].int:=mem[p+1].int; mem[p+6].int:=mem[p+2].int;mem[q+3].int:=mem[q+1].int; mem[q+4].int:=mem[q+2].int;end{:294};p:=q{:293};until p=h; if internal[4]>0 then printpath(knots,542,true);if aritherror then{290:} begin begin if interaction=3 then;printnl(262);print(543);end; begin helpptr:=2;helpline[1]:=544;helpline[0]:=545;end;putgeterror; aritherror:=false;end{:290};end;{:289}{326:} 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; {327:}d:=1;x0:=a;x1:=a-b;x2:=b-c;repeat x:=half(x1+x2); 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{:327};10:end;{:326}{328:} function evalcubic(p,q:halfword;t:fraction):scaled;var x1,x2,x3:scaled; begin x1:=mem[p].int-takefraction(mem[p].int-mem[p+4].int,t); x2:=mem[p+4].int-takefraction(mem[p+4].int-mem[q+2].int,t); x3:=mem[q+2].int-takefraction(mem[q+2].int-mem[q].int,t); x1:=x1-takefraction(x1-x2,t);x2:=x2-takefraction(x2-x3,t); evalcubic:=x1-takefraction(x1-x2,t);end;{:328}{330:} procedure boundcubic(p,q:halfword;c:smallnumber);var wavy:boolean; del1,del2,del3,del,dmax:scaled;t,tt:fraction;x:scaled; begin x:=mem[q].int;{331:}if xbbmax[c]then bbmax[c]:=x{:331};{332:}wavy:=true; if bbmin[c]<=mem[p+4].int then if mem[p+4].int<=bbmax[c]then if bbmin[c] <=mem[q+2].int then if mem[q+2].int<=bbmax[c]then wavy:=false{:332}; if wavy then begin del1:=mem[p+4].int-mem[p].int; del2:=mem[q+2].int-mem[p+4].int;del3:=mem[q].int-mem[q+2].int;{333:} 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{:333}; if del<0 then begin del1:=-del1;del2:=-del2;del3:=-del3;end; t:=crossingpoint(del1,del2,del3);if t<268435456 then{334:} begin x:=evalcubic(p,q,t);{331:}if xbbmax[c]then bbmax[c]:=x{:331}; del2:=del2-takefraction(del2-del3,t);if del2>0 then del2:=0; tt:=crossingpoint(0,-del2,-del3);if tt<268435456 then{335:} begin x:=evalcubic(p,q,tt-takefraction(tt-268435456,t));{331:} if xbbmax[c]then bbmax[c]:=x{:331}; end{:335};end{:334};end;end;{:330}{336:}procedure pathbbox(h:halfword); label 10;var p,q:halfword;begin bbmin[0]:=mem[h+1].int; bbmin[1]:=mem[h+2].int;bbmax[0]:=bbmin[0];bbmax[1]:=bbmin[1];p:=h; repeat if mem[p].hh.b1=0 then goto 10;q:=mem[p].hh.rh; boundcubic(p+1,q+1,0);boundcubic(p+2,q+2,1);p:=q;until p=h;10:end;{:336} {339:}{349:}function solverisingcubic(a,b,c,x:scaled):scaled; var ab,bc,ac:scaled;t:integer;xx:integer; begin if(a<0)or(c<0)then confusion(547); if x<=0 then solverisingcubic:=0 else if x>=a+b+c then solverisingcubic :=65536 else begin t:=1;{351:} while(a>715827882)or(b>715827882)or(c>715827882)do begin a:=halfp(a); b:=half(b);c:=halfp(c);x:=halfp(x);end{:351};repeat t:=t+t;{350:} ab:=half(a+b);bc:=half(b+c);ac:=half(ab+bc){:350};xx:=x-a-ab-ac; if xx<-x then begin x:=x+x;b:=ab;c:=ac;end else begin x:=x+xx;a:=ac; b:=bc;t:=t+1;end;until t>=65536;solverisingcubic:=t-65536;end;end;{:349} function arctest(dx0,dy0,dx1,dy1,dx2,dy2,v0,v02,v2,agoal,tol:scaled): scaled;label 10;var simple:boolean;dx01,dy01,dx12,dy12,dx02,dy02:scaled; v002,v022:scaled;arc:scaled;{341:}a,b:scaled;anew,aaux:scaled;{:341} {346:}tmp,tmp2:scaled;arc1:scaled;{:346}begin{344:}dx01:=half(dx0+dx1); dx12:=half(dx1+dx2);dx02:=half(dx01+dx12);dy01:=half(dy0+dy1); dy12:=half(dy1+dy2);dy02:=half(dy01+dy12){:344};{345:} v002:=pythadd(dx01+half(dx0+dx02),dy01+half(dy0+dy02)); v022:=pythadd(dx12+half(dx02+dx2),dy12+half(dy02+dy2)); tmp:=halfp(v02+2);arc1:=v002+half(halfp(v0+tmp)-v002); arc:=v022+half(halfp(v2+tmp)-v022); if(arc<2147483647-arc1)then arc:=arc+arc1 else begin aritherror:=true; if agoal=2147483647 then arctest:=2147483647 else arctest:=-131072; goto 10;end{:345};{347:} simple:=(dx0>=0)and(dx1>=0)and(dx2>=0)or(dx0<=0)and(dx1<=0)and(dx2<=0); if simple then simple:=(dy0>=0)and(dy1>=0)and(dy2>=0)or(dy0<=0)and(dy1<= 0)and(dy2<=0); if not simple then begin simple:=(dx0>=dy0)and(dx1>=dy1)and(dx2>=dy2)or( dx0<=dy0)and(dx1<=dy1)and(dx2<=dy2); if simple then simple:=(-dx0>=dy0)and(-dx1>=dy1)and(-dx2>=dy2)or(-dx0<= dy0)and(-dx1<=dy1)and(-dx2<=dy2);end{:347}; if simple and(abs(arc-v02-halfp(v0+v2))<=tol)then if arcaaux then begin aaux:=agoal-aaux;anew:=2147483647; end else begin anew:=agoal+agoal;aaux:=0;end{:342};tol:=tol+halfp(tol); a:=arctest(dx0,dy0,dx01,dy01,dx02,dy02,v0,v002,halfp(v02),anew,tol); if a<0 then arctest:=-halfp(131072-a)else begin{343:} if a>aaux then begin aaux:=aaux-a;anew:=anew+aaux;end{:343}; b:=arctest(dx02,dy02,dx12,dy12,dx2,dy2,halfp(v02),v022,v2,anew,tol); if b<0 then arctest:=-halfp(-b)-32768 else arctest:=a+half(b-a);end; end{:340};10:end;{:339}{352:} function doarctest(dx0,dy0,dx1,dy1,dx2,dy2,agoal:scaled):scaled; var v0,v1,v2:scaled;v02:scaled;begin v0:=pythadd(dx0,dy0); v1:=pythadd(dx1,dy1);v2:=pythadd(dx2,dy2); if(v0>=1073741824)or(v1>=1073741824)or(v2>=1073741824)then begin aritherror:=true; if agoal=2147483647 then doarctest:=2147483647 else doarctest:=-131072; end else begin v02:=pythadd(dx1+half(dx0+dx2),dy1+half(dy0+dy2)); doarctest:=arctest(dx0,dy0,dx1,dy1,dx2,dy2,v0,v02,v2,agoal,16);end;end; {:352}{353:}function getarclength(h:halfword):scaled;label 30; var p,q:halfword;a,atot:scaled;begin atot:=0;p:=h; while mem[p].hh.b1<>0 do begin q:=mem[p].hh.rh; a:=doarctest(mem[p+5].int-mem[p+1].int,mem[p+6].int-mem[p+2].int,mem[q+3 ].int-mem[p+5].int,mem[q+4].int-mem[p+6].int,mem[q+1].int-mem[q+3].int, mem[q+2].int-mem[q+4].int,2147483647);atot:=slowadd(a,atot); if q=h then goto 30 else p:=q;end; 30:begin if aritherror then cleararith;end;getarclength:=atot;end;{:353} {354:}function getarctime(h:halfword;arc0:scaled):scaled;label 30; var p,q:halfword;ttot:scaled;t:scaled;arc:scaled;n:integer; begin if arc0<0 then{356:} begin if mem[h].hh.b0=0 then ttot:=0 else begin p:=htapypoc(h); ttot:=-getarctime(p,-arc0);tossknotlist(p);end;goto 30;end{:356}; if arc0=2147483647 then decr(arc0);ttot:=0;arc:=arc0;p:=h; while(mem[p].hh.b1<>0)and(arc>0)do begin q:=mem[p].hh.rh; t:=doarctest(mem[p+5].int-mem[p+1].int,mem[p+6].int-mem[p+2].int,mem[q+3 ].int-mem[p+5].int,mem[q+4].int-mem[p+6].int,mem[q+1].int-mem[q+3].int, mem[q+2].int-mem[q+4].int,arc);{355:} if t<0 then begin ttot:=ttot+t+131072;arc:=0; end else begin ttot:=ttot+65536;arc:=arc-t;end{:355};if q=h then{357:} if arc>0 then begin n:=arc div(arc0-arc);arc:=arc-n*(arc0-arc); if ttot>2147483647 div(n+1)then begin aritherror:=true;ttot:=2147483647; goto 30;end;ttot:=(n+1)*ttot;end{:357};p:=q;end; 30:begin if aritherror then cleararith;end;getarctime:=ttot;end;{:354} {359:}{375:}{380:}procedure moveknot(p,q:halfword); begin mem[mem[p].hh.lh].hh.rh:=mem[p].hh.rh; mem[mem[p].hh.rh].hh.lh:=mem[p].hh.lh;mem[p].hh.lh:=q; mem[p].hh.rh:=mem[q].hh.rh;mem[q].hh.rh:=p;mem[mem[p].hh.rh].hh.lh:=p; end;{:380}function convexhull(h:halfword):halfword;label 31,32,33; var l,r:halfword;p,q:halfword;s:halfword;dx,dy:scaled; begin if(h=mem[h].hh.rh)then convexhull:=h else begin{376:}l:=h; p:=mem[h].hh.rh; while p<>h do begin if mem[p+1].int<=mem[l+1].int then if(mem[p+1].int< mem[l+1].int)or(mem[p+2].inth do begin if mem[p+1].int>=mem[r+1].int then if(mem[p+1].int> mem[r+1].int)or(mem[p+2].int>mem[r+2].int)then r:=p;p:=mem[p].hh.rh; end{:377};if l<>r then begin s:=mem[r].hh.rh;{378:} dx:=mem[r+1].int-mem[l+1].int;dy:=mem[r+2].int-mem[l+2].int; p:=mem[l].hh.rh;while p<>r do begin q:=mem[p].hh.rh; if abvscd(dx,mem[p+2].int-mem[l+2].int,dy,mem[p+1].int-mem[l+1].int)>0 then moveknot(p,r);p:=q;end{:378};{381:}p:=s; while p<>l do begin q:=mem[p].hh.rh; if abvscd(dx,mem[p+2].int-mem[l+2].int,dy,mem[p+1].int-mem[l+1].int)<0 then moveknot(p,l);p:=q;end{:381};{382:}p:=mem[l].hh.rh; while p<>r do begin q:=mem[p].hh.lh; while mem[q+1].int>mem[p+1].int do q:=mem[q].hh.lh; while mem[q+1].int=mem[p+1].int do if mem[q+2].int>mem[p+2].int then q:= mem[q].hh.lh else goto 31; 31:if q=mem[p].hh.lh then p:=mem[p].hh.rh else begin p:=mem[p].hh.rh; moveknot(mem[p].hh.lh,q);end;end{:382};{383:}p:=mem[r].hh.rh; while p<>l do begin q:=mem[p].hh.lh; while mem[q+1].intmem[l].hh.rh then{384:} begin p:=l;q:=mem[l].hh.rh; while true do begin dx:=mem[q+1].int-mem[p+1].int; dy:=mem[q+2].int-mem[p+2].int;p:=q;q:=mem[q].hh.rh;if p=l then goto 33; if p<>r then if abvscd(dx,mem[q+2].int-mem[p+2].int,dy,mem[q+1].int-mem[ p+1].int)<=0 then{385:}begin s:=mem[p].hh.lh;freenode(p,7); mem[s].hh.rh:=q;mem[q].hh.lh:=s; if s=l then p:=s else begin p:=mem[s].hh.lh;q:=s;end;end{:385};end;33:; end{:384};convexhull:=l;end;end;{:375}function makepen(h:halfword; needhull:boolean):halfword;var p,q:halfword;begin q:=h;repeat p:=q; q:=mem[q].hh.rh;mem[q].hh.lh:=p;until q=h; if needhull then begin h:=convexhull(h);{361:} if(h=mem[h].hh.rh)then begin mem[h+3].int:=mem[h+1].int; mem[h+4].int:=mem[h+2].int;mem[h+5].int:=mem[h+1].int; mem[h+6].int:=mem[h+2].int;end{:361};end;makepen:=h;end;{:359}{360:} function getpencircle(diam:scaled):halfword;var h:halfword; begin h:=getnode(7);mem[h].hh.rh:=h;mem[h].hh.lh:=h;mem[h+1].int:=0; mem[h+2].int:=0;mem[h+3].int:=diam;mem[h+4].int:=0;mem[h+5].int:=0; mem[h+6].int:=diam;getpencircle:=h;end;{:360}{367:} procedure makepath(h:halfword);var p:halfword;k:smallnumber;{371:} centerx,centery:scaled;widthx,widthy:scaled;heightx,heighty:scaled; dx,dy:scaled;kk:integer;{:371}begin if(h=mem[h].hh.rh)then{369:} begin{370:}centerx:=mem[h+1].int;centery:=mem[h+2].int; widthx:=mem[h+3].int-centerx;widthy:=mem[h+4].int-centery; heightx:=mem[h+5].int-centerx;heighty:=mem[h+6].int-centery{:370};p:=h; for k:=0 to 7 do begin{372:}kk:=(k+6)mod 8; mem[p+1].int:=centerx+takefraction(halfcos[k],widthx)+takefraction( halfcos[kk],heightx); mem[p+2].int:=centery+takefraction(halfcos[k],widthy)+takefraction( halfcos[kk],heighty); dx:=-takefraction(dcos[kk],widthx)+takefraction(dcos[k],heightx); dy:=-takefraction(dcos[kk],widthy)+takefraction(dcos[k],heighty); mem[p+5].int:=mem[p+1].int+dx;mem[p+6].int:=mem[p+2].int+dy; mem[p+3].int:=mem[p+1].int-dx;mem[p+4].int:=mem[p+2].int-dy; mem[p].hh.b0:=1;mem[p].hh.b1:=1{:372}; if k=7 then mem[p].hh.rh:=h else mem[p].hh.rh:=getnode(7); p:=mem[p].hh.rh;end;end{:369}else begin p:=h;repeat mem[p].hh.b0:=1; mem[p].hh.b1:=1;{368:}mem[p+3].int:=mem[p+1].int; mem[p+4].int:=mem[p+2].int;mem[p+5].int:=mem[p+1].int; mem[p+6].int:=mem[p+2].int{:368};p:=mem[p].hh.rh;until p=h;end;end; {:367}{386:}procedure findoffset(x,y:scaled;h:halfword); var p,q:halfword;wx,wy,hx,hy:scaled;xx,yy:fraction;d:fraction; begin if(h=mem[h].hh.rh)then{388:} if(x=0)and(y=0)then begin curx:=mem[h+1].int;cury:=mem[h+2].int; end else begin{389:}wx:=mem[h+3].int-mem[h+1].int; wy:=mem[h+4].int-mem[h+2].int;hx:=mem[h+5].int-mem[h+1].int; hy:=mem[h+6].int-mem[h+2].int{:389}; while(abs(x)<134217728)and(abs(y)<134217728)do begin x:=x+x;y:=y+y;end; {390:}yy:=-(takefraction(x,hy)+takefraction(y,-hx)); xx:=takefraction(x,-wy)+takefraction(y,wx);d:=pythadd(xx,yy); if d>0 then begin xx:=half(makefraction(xx,d)); yy:=half(makefraction(yy,d));end{:390}; curx:=mem[h+1].int+takefraction(xx,wx)+takefraction(yy,hx); cury:=mem[h+2].int+takefraction(xx,wy)+takefraction(yy,hy);end{:388} else begin q:=h;repeat p:=q;q:=mem[q].hh.rh; until abvscd(mem[q+1].int-mem[p+1].int,y,mem[q+2].int-mem[p+2].int,x)>=0 ;repeat p:=q;q:=mem[q].hh.rh; until abvscd(mem[q+1].int-mem[p+1].int,y,mem[q+2].int-mem[p+2].int,x)<=0 ;curx:=mem[p+1].int;cury:=mem[p+2].int;end;end;{:386}{391:} procedure penbbox(h:halfword);var p:halfword; begin if(h=mem[h].hh.rh)then{392:}begin findoffset(0,268435456,h); bbmax[0]:=curx;bbmin[0]:=2*mem[h+1].int-curx;findoffset(-268435456,0,h); bbmax[1]:=cury;bbmin[1]:=2*mem[h+2].int-cury;end{:392} else begin bbmin[0]:=mem[h+1].int;bbmax[0]:=bbmin[0]; bbmin[1]:=mem[h+2].int;bbmax[1]:=bbmin[1];p:=mem[h].hh.rh; while p<>h do begin if mem[p+1].intbbmax[0]then bbmax[0]:=mem[p+1].int; if mem[p+2].int>bbmax[1]then bbmax[1]:=mem[p+2].int;p:=mem[p].hh.rh;end; end;end;{:391}{394:}function newfillnode(p:halfword):halfword; var t:halfword;begin t:=getnode(6);mem[t].hh.b0:=1;mem[t+1].hh.rh:=p; mem[t+1].hh.lh:=0;mem[t+2].int:=0;mem[t+3].int:=0;mem[t+4].int:=0;{395:} if internal[27]>65536 then mem[t].hh.b1:=2 else if internal[27]>0 then mem[t].hh.b1:=1 else mem[t].hh.b1:=0; if internal[29]<65536 then mem[t+5].int:=65536 else mem[t+5].int:= internal[29]{:395};newfillnode:=t;end;{:394}{396:} function newstrokednode(p:halfword):halfword;var t:halfword; begin t:=getnode(8);mem[t].hh.b0:=2;mem[t+1].hh.rh:=p;mem[t+1].hh.lh:=0; mem[t+6].hh.rh:=0;mem[t+7].int:=65536;mem[t+2].int:=0;mem[t+3].int:=0; mem[t+4].int:=0;{395:} if internal[27]>65536 then mem[t].hh.b1:=2 else if internal[27]>0 then mem[t].hh.b1:=1 else mem[t].hh.b1:=0; if internal[29]<65536 then mem[t+5].int:=65536 else mem[t+5].int:= internal[29]{:395}; if internal[28]>65536 then mem[t+6].hh.b0:=2 else if internal[28]>0 then mem[t+6].hh.b0:=1 else mem[t+6].hh.b0:=0;newstrokednode:=t;end;{:396} {399:}{1179:}{747:}procedure beginname; begin begin if strref[curname]<127 then if strref[curname]>1 then decr( strref[curname])else flushstring(curname);end; begin if strref[curarea]<127 then if strref[curarea]>1 then decr(strref[ curarea])else flushstring(curarea);end; begin if strref[curext]<127 then if strref[curext]>1 then decr(strref[ curext])else flushstring(curext);end;areadelimiter:=-1;extdelimiter:=-1; end;{:747}{748:}function morename(c:ASCIIcode):boolean; begin if(c=32)or(c=9)then morename:=false else begin if ISDIRSEP(c)then begin areadelimiter:=poolptr-strstart[strptr];extdelimiter:=-1; end else if(c=46)then extdelimiter:=poolptr-strstart[strptr]; begin if poolptr+1>maxpoolptr then if poolptr+1>poolsize then docompaction(1)else maxpoolptr:=poolptr+1;end;begin strpool[poolptr]:=c; incr(poolptr);end;morename:=true;end;end;{:748}{749:}procedure endname; var a,n,e:poolpointer;begin e:=poolptr-strstart[strptr]; if extdelimiter<0 then extdelimiter:=e;a:=areadelimiter+1; n:=extdelimiter-a;e:=e-extdelimiter; if a=0 then curarea:=284 else begin curarea:=makestring; choplaststring(strstart[curarea]+a);end; if n=0 then curname:=284 else begin curname:=makestring; choplaststring(strstart[curname]+n);end; if e=0 then curext:=284 else curext:=makestring;end;{:749}{751:} procedure packfilename(n,a,e:strnumber);var k:integer;c:ASCIIcode; j:poolpointer;begin k:=0;if nameoffile then libcfree(nameoffile); nameoffile:=xmalloc(1+(strstart[nextstr[a]]-strstart[a])+(strstart[ nextstr[n]]-strstart[n])+(strstart[nextstr[e]]-strstart[e])+1); for j:=strstart[a]to strstart[nextstr[a]]-1 do begin c:=strpool[j]; incr(k);if k<=maxint then nameoffile[k]:=xchr[c];end; for j:=strstart[n]to strstart[nextstr[n]]-1 do begin c:=strpool[j]; incr(k);if k<=maxint then nameoffile[k]:=xchr[c];end; for j:=strstart[e]to strstart[nextstr[e]]-1 do begin c:=strpool[j]; incr(k);if k<=maxint then nameoffile[k]:=xchr[c];end; if k<=maxint then namelength:=k else namelength:=maxint; nameoffile[namelength+1]:=0;end;{:751}{759:} procedure strscanfile(s:strnumber);label 30;var p,q:poolpointer; begin beginname;p:=strstart[s];q:=strstart[nextstr[s]]; while p127 then goto 11; tfmtemp:=getc(tfminfile);lf:=lf*256+tfmtemp;end; tfmtemp:=getc(tfminfile);begin lh:=tfmtemp;if lh>127 then goto 11; tfmtemp:=getc(tfminfile);lh:=lh*256+tfmtemp;end; tfmtemp:=getc(tfminfile);begin bc:=tfmtemp;if bc>127 then goto 11; tfmtemp:=getc(tfminfile);bc:=bc*256+tfmtemp;end; tfmtemp:=getc(tfminfile);begin ec:=tfmtemp;if ec>127 then goto 11; tfmtemp:=getc(tfminfile);ec:=ec*256+tfmtemp;end; if(bc>1+ec)or(ec>255)then goto 11;tfmtemp:=getc(tfminfile); begin nw:=tfmtemp;if nw>127 then goto 11;tfmtemp:=getc(tfminfile); nw:=nw*256+tfmtemp;end;tfmtemp:=getc(tfminfile);begin nh:=tfmtemp; if nh>127 then goto 11;tfmtemp:=getc(tfminfile);nh:=nh*256+tfmtemp;end; tfmtemp:=getc(tfminfile);begin nd:=tfmtemp;if nd>127 then goto 11; tfmtemp:=getc(tfminfile);nd:=nd*256+tfmtemp;end; whdsize:=(ec+1-bc)+nw+nh+nd;if lf<6+lh+whdsize then goto 11; for jj:=10 downto 1 do tfmtemp:=getc(tfminfile){:1182};{1183:} if nextfmem=fontmemsize)then{1184:} begin begin if interaction=3 then;printnl(262);print(1100);end; print(fname);print(1107);begin helpptr:=3;helpline[2]:=1108; helpline[1]:=1109;helpline[0]:=1110;end;error;goto 30;end{:1184}; incr(lastfnum);n:=lastfnum;fontbc[n]:=bc;fontec[n]:=ec; charbase[n]:=nextfmem-bc-0;widthbase[n]:=nextfmem+ec-bc+1; heightbase[n]:=widthbase[n]+0+nw;depthbase[n]:=heightbase[n]+nh; nextfmem:=nextfmem+whdsize;{:1183};{1185:}if lh<2 then goto 11; for jj:=4 downto 1 do tfmtemp:=getc(tfminfile);tfmtemp:=getc(tfminfile); begin z:=tfmtemp;if z>127 then goto 11;tfmtemp:=getc(tfminfile); z:=z*256+tfmtemp;end;tfmtemp:=getc(tfminfile);z:=z*256+tfmtemp; tfmtemp:=getc(tfminfile);z:=z*256+tfmtemp; fontdsize[n]:=takefraction(z,267432584); for jj:=4*(lh-2)downto 1 do tfmtemp:=getc(tfminfile){:1185};{1186:} ii:=widthbase[n]+0;i:=charbase[n]+0+bc; while i=128 then d:=d-256;tfmtemp:=getc(tfminfile);d:=d*256+tfmtemp; tfmtemp:=getc(tfminfile);d:=d*256+tfmtemp;tfmtemp:=getc(tfminfile); d:=d*256+tfmtemp;fontinfo[i].int:=takefraction(d*16,fontdsize[n]); incr(i);end{:1187};if feof(tfminfile)then goto 11;goto 30{:1186}{:1181}; 11:{1180:}begin if interaction=3 then;printnl(262);print(1100);end; print(fname);if fileopened then print(1101)else print(1102); begin helpptr:=3;helpline[2]:=1103;helpline[1]:=1104;helpline[0]:=1105; end;if fileopened then helpline[0]:=1106;error{:1180}; 30:if fileopened then bclose(tfminfile); if n<>0 then begin fontpsname[n]:=fname;fontname[n]:=fname; strref[fname]:=127;end;readfontinfo:=n;end;{:1179}{1189:} function findfont(f:strnumber):fontnumber;label 10,40;var n:fontnumber; begin for n:=0 to lastfnum do if strvsstr(f,fontname[n])=0 then goto 40; findfont:=readfontinfo(f);goto 10;40:findfont:=n;10:end;{:1189}{1191:} procedure lostwarning(f:fontnumber;k:poolpointer); begin if internal[11]>0 then begin begindiagnostic;printnl(1111); print(strpool[k]);print(1112);print(fontname[f]);printchar(33); enddiagnostic(false);end;end;{:1191}{1192:} procedure settextbox(p:halfword);var f:fontnumber;bc,ec:poolASCIIcode; k,kk:poolpointer;cc:fourquarters;h,d:scaled;begin mem[p+5].int:=0; mem[p+6].int:=-2147483647;mem[p+7].int:=-2147483647;f:=mem[p+1].hh.lh; bc:=fontbc[f];ec:=fontec[f];kk:=strstart[nextstr[mem[p+1].hh.rh]]; k:=strstart[mem[p+1].hh.rh];while kec)then lostwarning(f,k)else begin cc:=fontinfo[charbase[f]+strpool[k]].qqqq; if not(cc.b0>0)then lostwarning(f,k)else begin mem[p+5].int:=mem[p+5]. int+fontinfo[widthbase[f]+cc.b0].int; h:=fontinfo[heightbase[f]+cc.b1].int; d:=fontinfo[depthbase[f]+cc.b2].int; if h>mem[p+6].int then mem[p+6].int:=h; if d>mem[p+7].int then mem[p+7].int:=d;end;end;incr(k);end{:1193}; {1194:}if mem[p+6].int<-mem[p+7].int then begin mem[p+6].int:=0; mem[p+7].int:=0;end{:1194};end;{:1192} function newtextnode(f,s:strnumber):halfword;var t:halfword; begin t:=getnode(14);mem[t].hh.b0:=3;mem[t+1].hh.rh:=s; mem[t+1].hh.lh:=findfont(f);mem[t+2].int:=0;mem[t+3].int:=0; mem[t+4].int:=0;mem[t+8].int:=0;mem[t+9].int:=0;mem[t+10].int:=65536; mem[t+11].int:=0;mem[t+12].int:=0;mem[t+13].int:=65536;settextbox(t); newtextnode:=t;end;{:399}{400:}function newboundsnode(p:halfword; c:smallnumber):halfword;var t:halfword; begin t:=getnode(grobjectsize[c]);mem[t].hh.b0:=c;mem[t+1].hh.rh:=p; newboundsnode:=t;end;{:400}{404:}procedure initbbox(h:halfword); begin mem[h+6].hh.rh:=h+7;mem[h+6].hh.lh:=0;mem[h+2].int:=2147483647; mem[h+3].int:=2147483647;mem[h+4].int:=-2147483647; mem[h+5].int:=-2147483647;end;{:404}{405:} procedure initedges(h:halfword);begin mem[h].hh.rh:=2; mem[h+7].hh.lh:=h+7;mem[h+7].hh.rh:=0;mem[h].hh.lh:=0;initbbox(h);end; {:405}{410:}{413:}function copyobjects(p,q:halfword):halfword; var hh:halfword;pp:halfword;k:smallnumber;begin hh:=getnode(8); mem[hh].hh.rh:=2;mem[hh].hh.lh:=0;pp:=hh+7;while(p<>q)do{414:} begin k:=grobjectsize[mem[p].hh.b0];mem[pp].hh.rh:=getnode(k); pp:=mem[pp].hh.rh;while(k>0)do begin decr(k);mem[pp+k]:=mem[p+k];end; {415:} case mem[p].hh.b0 of 4,5:mem[pp+1].hh.rh:=copypath(mem[p+1].hh.rh); 1:begin mem[pp+1].hh.rh:=copypath(mem[p+1].hh.rh); if mem[p+1].hh.lh<>0 then mem[pp+1].hh.lh:=makepen(copypath(mem[p+1].hh. lh),false);end;2:begin mem[pp+1].hh.rh:=copypath(mem[p+1].hh.rh); mem[pp+1].hh.lh:=makepen(copypath(mem[p+1].hh.lh),false); if mem[p+6].hh.rh<>0 then incr(mem[mem[pp+6].hh.rh].hh.lh);end; 3:begin if strref[mem[pp+1].hh.rh]<127 then incr(strref[mem[pp+1].hh.rh] );end;6,7:;end{:415};p:=mem[p].hh.rh;end{:414};mem[hh+7].hh.lh:=pp; mem[pp].hh.rh:=0;copyobjects:=hh;end;{:413} function privateedges(h:halfword):halfword;var hh:halfword; p,pp:halfword; begin if mem[h].hh.lh=0 then privateedges:=h else begin decr(mem[h].hh. lh);hh:=copyobjects(mem[h+7].hh.rh,0);{411:}pp:=hh;p:=mem[h].hh.rh; while(p<>2)do begin mem[pp].hh.rh:=getnode(3);pp:=mem[pp].hh.rh; mem[pp+1].int:=mem[p+1].int;mem[pp+2].int:=mem[p+2].int;p:=mem[p].hh.rh; end;mem[pp].hh.rh:=2;mem[hh+1].int:=mem[h+1].int{:411};{412:} mem[hh+2].int:=mem[h+2].int;mem[hh+3].int:=mem[h+3].int; mem[hh+4].int:=mem[h+4].int;mem[hh+5].int:=mem[h+5].int; mem[hh+6].hh.lh:=mem[h+6].hh.lh;p:=h+7;pp:=hh+7; while(p<>mem[h+6].hh.rh)do begin if p=0 then confusion(551); p:=mem[p].hh.rh;pp:=mem[pp].hh.rh;end;mem[hh+6].hh.rh:=pp{:412}; privateedges:=hh;end;end;{:410}{416:} function skip1component(p:halfword):halfword;var lev:integer; begin lev:=0; repeat if(mem[p].hh.b0>=4)then if(mem[p].hh.b0>=6)then decr(lev)else incr(lev);p:=mem[p].hh.rh;until lev=0;skip1component:=p;end;{:416}{429:} {431:}procedure xretraceerror;begin begin if interaction=3 then; printnl(262);print(580);end;begin helpptr:=3;helpline[2]:=584; helpline[1]:=585;helpline[0]:=583;end;putgeterror;end;{:431} function makedashes(h:halfword):halfword;label 10,40,45;var p:halfword; y0:scaled;p0:halfword;pp,qq,rr:halfword;d,dd:halfword;{434:} x0,x1,x2,x3:scaled;{:434}{440:}dln:halfword;hh:halfword;hsf:scaled; ds:halfword;xoff:scaled;{:440}begin if mem[h].hh.rh<>2 then goto 40; p0:=0;p:=mem[h+7].hh.rh; while p<>0 do begin if mem[p].hh.b0<>2 then{430:} begin begin if interaction=3 then;printnl(262);print(580);end; begin helpptr:=3;helpline[2]:=581;helpline[1]:=582;helpline[0]:=583;end; putgeterror;goto 45;end{:430};pp:=mem[p+1].hh.rh; if p0=0 then begin p0:=p;y0:=mem[pp+2].int;end;{432:}{435:} if(mem[p+2].int<>mem[p0+2].int)or(mem[p+3].int<>mem[p0+3].int)or(mem[p+4 ].int<>mem[p0+4].int)then begin begin if interaction=3 then; printnl(262);print(580);end;begin helpptr:=3;helpline[2]:=586; helpline[1]:=587;helpline[0]:=583;end;putgeterror;goto 45;end{:435}; rr:=pp;if mem[pp].hh.rh<>pp then repeat qq:=rr;rr:=mem[rr].hh.rh;{433:} x0:=mem[qq+1].int;x1:=mem[qq+5].int;x2:=mem[rr+3].int;x3:=mem[rr+1].int; if(x0>x1)or(x1>x2)or(x2>x3)then if(x00 then begin xretraceerror;goto 45;end; if(mem[pp+1].int>x0)or(x0>x3)then if(mem[pp+1].inth then if(mem[dd+2].int>mem[d+1].int)then begin xretraceerror; goto 45;end;mem[d].hh.rh:=mem[dd].hh.rh;mem[dd].hh.rh:=d{:436}; p:=mem[p].hh.rh;end;if mem[h].hh.rh=2 then goto 45;{439:}d:=h; while mem[d].hh.rh<>2 do begin ds:=mem[mem[d].hh.rh].hh.lh; if ds=0 then d:=mem[d].hh.rh else begin hh:=mem[ds+6].hh.rh; hsf:=mem[ds+7].int;if(hh=0)then confusion(588); if mem[hh+1].int=0 then d:=mem[d].hh.rh else begin if mem[hh].hh.rh=0 then confusion(588);{441:}dln:=mem[d].hh.rh;dd:=mem[hh].hh.rh; xoff:=mem[dln+1].int-takescaled(hsf,mem[dd+1].int)-takescaled(hsf, dashoffset(hh)); mem[3].int:=takescaled(hsf,mem[dd+1].int)+takescaled(hsf,mem[hh+1].int); mem[4].int:=mem[3].int;{442:} while xoff+takescaled(hsf,mem[dd+2].int)xoff+takescaled(hsf,mem[dd+1].int)then mem[d+1].int:= mem[dln+1].int else mem[d+1].int:=xoff+takescaled(hsf,mem[dd+1].int); if mem[dln+2].int2)do d:=mem[d].hh.rh; dd:=mem[h].hh.rh;mem[h+1].int:=mem[d+2].int-mem[dd+1].int; if abs(y0)>mem[h+1].int then mem[h+1].int:=abs(y0)else if d<>dd then begin mem[h].hh.rh:=mem[dd].hh.rh; mem[d+2].int:=mem[dd+2].int+mem[h+1].int;freenode(dd,3);end{:437}; 40:makedashes:=h;goto 10;45:{438:}flushdashlist(h); if mem[h].hh.lh=0 then tossedges(h)else decr(mem[h].hh.lh); makedashes:=0{:438};10:end;{:429}{445:}procedure adjustbbox(h:halfword); begin if bbmin[0]mem[h+4].int then mem[h+4].int:=bbmax[0]; if bbmax[1]>mem[h+5].int then mem[h+5].int:=bbmax[1];end;{:445}{446:} procedure boxends(p,pp,h:halfword);label 10;var q:halfword; dx,dy:fraction;d:scaled;z:scaled;xx,yy:scaled;i:integer; begin if mem[p].hh.b1<>0 then begin q:=mem[p].hh.rh; while true do begin{447:} if q=mem[p].hh.rh then begin dx:=mem[p+1].int-mem[p+5].int; dy:=mem[p+2].int-mem[p+6].int; if(dx=0)and(dy=0)then begin dx:=mem[p+1].int-mem[q+3].int; dy:=mem[p+2].int-mem[q+4].int;end; end else begin dx:=mem[p+1].int-mem[p+3].int; dy:=mem[p+2].int-mem[p+4].int; if(dx=0)and(dy=0)then begin dx:=mem[p+1].int-mem[q+5].int; dy:=mem[p+2].int-mem[q+6].int;end;end;dx:=mem[p+1].int-mem[q+1].int; dy:=mem[p+2].int-mem[q+2].int{:447};d:=pythadd(dx,dy); if d>0 then begin{448:}dx:=makefraction(dx,d);dy:=makefraction(dy,d); findoffset(-dy,dx,pp);xx:=curx;yy:=cury{:448}; for i:=1 to 2 do begin{449:}findoffset(dx,dy,pp); d:=takefraction(xx-curx,dx)+takefraction(yy-cury,dy); if(d<0)and(i=1)or(d>0)and(i=2)then confusion(589); z:=mem[p+1].int+curx+takefraction(d,dx); if zmem[h+4].int then mem[h+4].int:=z; z:=mem[p+2].int+cury+takefraction(d,dy); if zmem[h+5].int then mem[h+5].int:=z{:449};dx:=-dx;dy:=-dy;end;end; if mem[p].hh.b1=0 then goto 10 else{450:}repeat q:=p;p:=mem[p].hh.rh; until mem[p].hh.b1=0{:450};end;end;10:;end;{:446}{451:} procedure setbbox(h:halfword;toplevel:boolean);label 10;var p:halfword; sminx,sminy,smaxx,smaxy:scaled;x0,x1,y0,y1:scaled;lev:integer; begin{452:}case mem[h+6].hh.lh of 0:; 1:if internal[33]>0 then initbbox(h); 2:if internal[33]<=0 then initbbox(h);end{:452}; while mem[mem[h+6].hh.rh].hh.rh<>0 do begin p:=mem[mem[h+6].hh.rh].hh.rh ;mem[h+6].hh.rh:=p; case mem[p].hh.b0 of 6:if toplevel then confusion(590)else goto 10; {453:}1:begin pathbbox(mem[p+1].hh.rh);adjustbbox(h);end;{:453}{454:} 5:if internal[33]>0 then mem[h+6].hh.lh:=2 else begin mem[h+6].hh.lh:=1; pathbbox(mem[p+1].hh.rh);adjustbbox(h);{455:}lev:=1; while lev<>0 do begin if mem[p].hh.rh=0 then confusion(591); p:=mem[p].hh.rh; if mem[p].hh.b0=5 then incr(lev)else if mem[p].hh.b0=7 then decr(lev); end;mem[h+6].hh.rh:=p{:455};end; 7:if internal[33]<=0 then confusion(591);{:454}{456:} 2:begin pathbbox(mem[p+1].hh.rh);x0:=bbmin[0];y0:=bbmin[1];x1:=bbmax[0]; y1:=bbmax[1];penbbox(mem[p+1].hh.lh);bbmin[0]:=bbmin[0]+x0; bbmin[1]:=bbmin[1]+y0;bbmax[0]:=bbmax[0]+x1;bbmax[1]:=bbmax[1]+y1; adjustbbox(h); if(mem[mem[p+1].hh.rh].hh.b0=0)and(mem[p+6].hh.b0=2)then boxends(mem[p+1 ].hh.rh,mem[p+1].hh.lh,h);end;{:456}{457:} 3:begin x1:=takescaled(mem[p+10].int,mem[p+5].int); y0:=takescaled(mem[p+11].int,-mem[p+7].int); y1:=takescaled(mem[p+11].int,mem[p+6].int);bbmin[0]:=mem[p+8].int; bbmax[0]:=bbmin[0];if y0x1 then mem[h+4].int:=x1; if mem[h+5].int>y1 then mem[h+5].int:=y1{:460};bbmin[0]:=sminx; bbmin[1]:=sminy;bbmax[0]:=smaxx;bbmax[1]:=smaxy;adjustbbox(h);end;{:458} end;end;if not toplevel then confusion(590);10:end;{:451}{463:}{470:} procedure splitcubic(p:halfword;t:fraction);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:=1;mem[r].hh.b1:=1; 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-mem[q+1].int,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-mem[q+2].int,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;{:470}{471:}procedure removecubic(p:halfword);var q:halfword; begin q:=mem[p].hh.rh;mem[p].hh.rh:=mem[q].hh.rh; mem[p+5].int:=mem[q+5].int;mem[p+6].int:=mem[q+6].int;freenode(q,7);end; {:471}{473:}function penwalk(w:halfword;k:integer):halfword; begin while k>0 do begin w:=mem[w].hh.rh;decr(k);end; while k<0 do begin w:=mem[w].hh.lh;incr(k);end;penwalk:=w;end;{:473} {476:}procedure finoffsetprep(p:halfword;w:halfword; x0,x1,x2,y0,y1,y2:integer;rise,turnamt:integer);label 10; var ww:halfword;du,dv:scaled;t0,t1,t2:integer;t:fraction;s:fraction; v:integer;q:halfword;begin q:=mem[p].hh.rh; while true do begin if rise>0 then ww:=mem[w].hh.rh else ww:=mem[w].hh. lh;{477:}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;if du<0 then begin t0:=-t0;t1:=-t1;t2:=-t2; end end else begin s:=makefraction(du,dv);t0:=x0-takefraction(y0,s); t1:=x1-takefraction(y1,s);t2:=x2-takefraction(y2,s); if dv<0 then begin t0:=-t0;t1:=-t1;t2:=-t2;end end; if t0<0 then t0:=0{:477};t:=crossingpoint(t0,t1,t2); if t>=268435456 then if turnamt>0 then t:=268435456 else goto 10;{478:} begin splitcubic(p,t);p:=mem[p].hh.rh;mem[p].hh.lh:=16384+rise; decr(turnamt);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); if turnamt<0 then begin t1:=t1-takefraction(t1-t2,t);if t1>0 then t1:=0; t:=crossingpoint(0,-t1,-t2);if t>268435456 then t:=268435456; incr(turnamt); if(t=268435456)and(mem[p].hh.rh<>q)then mem[mem[p].hh.rh].hh.lh:=mem[mem [p].hh.rh].hh.lh-rise else begin splitcubic(p,t); mem[mem[p].hh.rh].hh.lh:=16384-rise;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;end{:478};w:=ww;end;10:end;{:476} {482:}function getturnamt(w:halfword;dx,dy:scaled;ccw:boolean):integer; label 30;var ww:halfword;s:integer;t:integer;begin s:=0; if ccw then begin ww:=mem[w].hh.rh; repeat t:=abvscd(dy,mem[ww+1].int-mem[w+1].int,dx,mem[ww+2].int-mem[w+2] .int);if t<0 then goto 30;incr(s);w:=ww;ww:=mem[ww].hh.rh;until t<=0; 30:end else begin ww:=mem[w].hh.lh; while abvscd(dy,mem[w+1].int-mem[ww+1].int,dx,mem[w+2].int-mem[ww+2].int )<0 do begin decr(s);w:=ww;ww:=mem[ww].hh.lh;end;end;getturnamt:=s;end; {:482}function offsetprep(c,h:halfword):halfword;label 45; var n:halfword;p,q,r,w,ww:halfword;kneeded:integer;w0:halfword; dxin,dyin:scaled;turnamt:integer;{474:}x0,x1,x2,y0,y1,y2:integer; t0,t1,t2:integer;du,dv,dx,dy:integer;dx0,dy0:integer;maxcoef:integer; x0a,x1a,x2a,y0a,y1a,y2a:integer;t:fraction;s:fraction;{:474}{487:} u0,u1,v0,v1:integer;ss:integer;dsign:-1..1;{:487}begin{466:}n:=0;p:=h; repeat incr(n);p:=mem[p].hh.rh;until p=h{:466};{467:} dxin:=mem[mem[h].hh.rh+1].int-mem[mem[h].hh.lh+1].int; dyin:=mem[mem[h].hh.rh+2].int-mem[mem[h].hh.lh+2].int; if(dxin=0)and(dyin=0)then begin dxin:=mem[mem[h].hh.lh+2].int-mem[h+2]. int;dyin:=mem[h+1].int-mem[mem[h].hh.lh+1].int;end;w0:=h{:467};p:=c; kneeded:=0;repeat q:=mem[p].hh.rh;{472:}mem[p].hh.lh:=16384+kneeded; kneeded:=0;{475:}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<134217728 do begin maxcoef:=maxcoef+maxcoef;x0:=x0+x0; x1:=x1+x1;x2:=x2+x2;y0:=y0+y0;y1:=y1+y1;y2:=y2+y2;end{:475};{479:} 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; if p=c then begin dx0:=dx;dy0:=dy;end{:479};{481:} turnamt:=getturnamt(w0,dx,dy,abvscd(dy,dxin,dx,dyin)>=0); w:=penwalk(w0,turnamt);w0:=w;mem[p].hh.lh:=mem[p].hh.lh+turnamt{:481}; {480:}dxin:=x2;dyin:=y2;if dxin=0 then if dyin=0 then begin dxin:=x1; dyin:=y1;if dxin=0 then if dyin=0 then begin dxin:=x0;dyin:=y0;end; end{:480};{488:}dsign:=abvscd(dx,dyin,dxin,dy); if dsign=0 then if dx=0 then if dy>0 then dsign:=1 else dsign:=-1 else if dx>0 then dsign:=1 else dsign:=-1;{489:} t0:=half(takefraction(x0,y2))-half(takefraction(x2,y0)); t1:=half(takefraction(x1,y0+y2))-half(takefraction(y1,x0+x2)); if t0=0 then t0:=dsign;if t0>0 then begin t:=crossingpoint(t0,t1,-t0); u0:=x0-takefraction(x0-x1,t);u1:=x1-takefraction(x1-x2,t); v0:=y0-takefraction(y0-y1,t);v1:=y1-takefraction(y1-y2,t); end else begin t:=crossingpoint(-t0,t1,t0);u0:=x2-takefraction(x2-x1,t); u1:=x1-takefraction(x1-x0,t);v0:=y2-takefraction(y2-y1,t); v1:=y1-takefraction(y1-y0,t);end; ss:=takefraction(x0+x2,u0-takefraction(u0-u1,t))+takefraction(y0+y2,v0- takefraction(v0-v1,t)){:489};turnamt:=getturnamt(w,dxin,dyin,dsign>0); if ss<0 then turnamt:=turnamt-dsign*n{:488};{484:}ww:=mem[w].hh.lh; {477:}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;if du<0 then begin t0:=-t0;t1:=-t1;t2:=-t2; end end else begin s:=makefraction(du,dv);t0:=x0-takefraction(y0,s); t1:=x1-takefraction(y1,s);t2:=x2-takefraction(y2,s); if dv<0 then begin t0:=-t0;t1:=-t1;t2:=-t2;end end; if t0<0 then t0:=0{:477};{486:}t:=crossingpoint(t0,t1,t2); if turnamt>=0 then if t2<0 then t:=268435457 else begin u0:=x0- takefraction(x0-x1,t);u1:=x1-takefraction(x1-x2,t); ss:=takefraction(-du,u0-takefraction(u0-u1,t)); v0:=y0-takefraction(y0-y1,t);v1:=y1-takefraction(y1-y2,t); ss:=ss+takefraction(-dv,v0-takefraction(v0-v1,t)); if ss<0 then t:=268435457;end else if t>268435456 then t:=268435456; {:486}; if t>268435456 then finoffsetprep(p,w,x0,x1,x2,y0,y1,y2,1,turnamt)else begin splitcubic(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,w,x0,x1a,x2a,y0,y1a,y2a,1,0);x0:=x2a;y0:=y2a; mem[r].hh.lh:=16383; if turnamt>=0 then begin t1:=t1-takefraction(t1-t2,t); if t1>0 then t1:=0;t:=crossingpoint(0,-t1,-t2); if t>268435456 then t:=268435456;{485:}splitcubic(r,t); mem[mem[r].hh.rh].hh.lh:=16385;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,w,x0a,x1a,x2,y0a,y1a,y2,1,turnamt);x2:=x0a; y2:=y0a{:485};finoffsetprep(r,ww,x0,x1,x2,y0,y1,y2,-1,0); end else finoffsetprep(r,ww,x0,x1,x2,y0,y1,y2,-1,-1-turnamt);end{:484}; w0:=penwalk(w0,turnamt);45:{:472};{468:}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 if r<>p then{469:}begin kneeded:=mem[p].hh.lh-16384; if r=q then q:=p else begin mem[p].hh.lh:=kneeded+mem[r].hh.lh; kneeded:=0;end;if r=c then begin mem[p].hh.lh:=mem[c].hh.lh;c:=p;end; if r=specp1 then specp1:=p;if r=specp2 then specp2:=p;r:=p; removecubic(p);end{:469};p:=r;until p=q{:468};until q=c;{483:} specoffset:=mem[c].hh.lh-16384; if mem[c].hh.rh=c then mem[c].hh.lh:=16384+n else begin mem[c].hh.lh:= mem[c].hh.lh+kneeded;while w0<>h do begin mem[c].hh.lh:=mem[c].hh.lh+1; w0:=mem[w0].hh.rh;end; while mem[c].hh.lh<=16384-n do mem[c].hh.lh:=mem[c].hh.lh+n; while mem[c].hh.lh>16384 do mem[c].hh.lh:=mem[c].hh.lh-n; if(mem[c].hh.lh<>16384)and(abvscd(dy0,dxin,dx0,dyin)>=0)then mem[c].hh. lh:=mem[c].hh.lh+n;end;offsetprep:=c{:483};end;{:463}{490:} procedure printspec(curspec,curpen:halfword;s:strnumber); var p,q:halfword;w:halfword;begin printdiagnostic(592,s,true); p:=curspec;w:=penwalk(curpen,specoffset);println; printtwo(mem[curspec+1].int,mem[curspec+2].int);print(593); printtwo(mem[w+1].int,mem[w+2].int);repeat repeat q:=mem[p].hh.rh;{492:} begin printnl(598);printtwo(mem[p+5].int,mem[p+6].int);print(537); printtwo(mem[q+3].int,mem[q+4].int);printnl(534); printtwo(mem[q+1].int,mem[q+2].int);end{:492};p:=q; until(p=curspec)or(mem[p].hh.lh<>16384); if mem[p].hh.lh<>16384 then{491:}begin w:=penwalk(w,mem[p].hh.lh-16384); print(595);if mem[p].hh.lh>16384 then print(596);print(597); printtwo(mem[w+1].int,mem[w+2].int);end{:491};until p=curspec; printnl(594);enddiagnostic(true);end;{:490}{493:}{500:} function insertknot(q:halfword;x,y:scaled):halfword;var r:halfword; begin r:=getnode(7);mem[r].hh.rh:=mem[q].hh.rh;mem[q].hh.rh:=r; mem[r+5].int:=mem[q+5].int;mem[r+6].int:=mem[q+6].int;mem[r+1].int:=x; mem[r+2].int:=y;mem[q+5].int:=mem[q+1].int;mem[q+6].int:=mem[q+2].int; mem[r+3].int:=mem[r+1].int;mem[r+4].int:=mem[r+2].int;mem[r].hh.b0:=1; mem[r].hh.b1:=1;insertknot:=r;end;{:500} function makeenvelope(c,h:halfword;ljoin,lcap:smallnumber; miterlim:scaled):halfword;label 30;var p,q,r,q0:halfword;jointype:0..3; w,w0:halfword;qx,qy:scaled;k,k0:halfword;{497:} dxin,dyin,dxout,dyout:fraction;tmp:scaled;{:497}{503:}det:fraction; {:503}{505:}htx,hty:fraction;maxht:scaled;kk:halfword;ww:halfword;{:505} begin specp1:=0;specp2:=0;if mem[c].hh.b0=0 then{508:} begin specp1:=htapypoc(c);specp2:=pathtail; mem[specp2].hh.rh:=mem[specp1].hh.rh;mem[specp1].hh.rh:=c; removecubic(specp1);c:=specp1; if c<>mem[c].hh.rh then removecubic(specp2)else{509:} begin mem[c].hh.b0:=1;mem[c].hh.b1:=1;mem[c+3].int:=mem[c+1].int; mem[c+4].int:=mem[c+2].int;mem[c+5].int:=mem[c+1].int; mem[c+6].int:=mem[c+2].int;end;{:509};end{:508};{494:} c:=offsetprep(c,h);if internal[5]>0 then printspec(c,h,284); h:=penwalk(h,specoffset){:494};w:=h;p:=c;repeat q:=mem[p].hh.rh;q0:=q; qx:=mem[q+1].int;qy:=mem[q+2].int;k:=mem[q].hh.lh;k0:=k;w0:=w; if k<>16384 then{495:} if k<16384 then jointype:=2 else begin if(q<>specp1)and(q<>specp2)then jointype:=ljoin else if lcap=2 then jointype:=3 else jointype:=2-lcap; if(jointype=0)or(jointype=3)then begin{510:} dxin:=mem[q+1].int-mem[q+3].int;dyin:=mem[q+2].int-mem[q+4].int; if(dxin=0)and(dyin=0)then begin dxin:=mem[q+1].int-mem[p+5].int; dyin:=mem[q+2].int-mem[p+6].int; if(dxin=0)and(dyin=0)then begin dxin:=mem[q+1].int-mem[p+1].int; dyin:=mem[q+2].int-mem[p+2].int; if p<>c then begin dxin:=dxin+mem[w+1].int;dyin:=dyin+mem[w+2].int;end; end;end;tmp:=pythadd(dxin,dyin); if tmp=0 then jointype:=2 else begin dxin:=makefraction(dxin,tmp); dyin:=makefraction(dyin,tmp);{511:}dxout:=mem[q+5].int-mem[q+1].int; dyout:=mem[q+6].int-mem[q+2].int; if(dxout=0)and(dyout=0)then begin r:=mem[q].hh.rh; dxout:=mem[r+3].int-mem[q+1].int;dyout:=mem[r+4].int-mem[q+2].int; if(dxout=0)and(dyout=0)then begin dxout:=mem[r+1].int-mem[q+1].int; dyout:=mem[r+2].int-mem[q+2].int;end;end; if q=c then begin dxout:=dxout-mem[h+1].int;dyout:=dyout-mem[h+2].int; end;tmp:=pythadd(dxout,dyout);if tmp=0 then confusion(599); dxout:=makefraction(dxout,tmp);dyout:=makefraction(dyout,tmp){:511}; end{:510};if jointype=0 then{496:} begin tmp:=takefraction(miterlim,134217728+half(takefraction(dxin,dxout) +takefraction(dyin,dyout))); if tmp<65536 then if takescaled(miterlim,tmp)<65536 then jointype:=2; end{:496};end;end{:495};{498:}mem[p+5].int:=mem[p+5].int+mem[w+1].int; mem[p+6].int:=mem[p+6].int+mem[w+2].int; mem[q+3].int:=mem[q+3].int+mem[w+1].int; mem[q+4].int:=mem[q+4].int+mem[w+2].int; mem[q+1].int:=mem[q+1].int+mem[w+1].int; mem[q+2].int:=mem[q+2].int+mem[w+2].int;mem[q].hh.b0:=1; mem[q].hh.b1:=1{:498};while k<>16384 do begin{499:} if k>16384 then begin w:=mem[w].hh.rh;decr(k); end else begin w:=mem[w].hh.lh;incr(k);end{:499}; if(jointype=1)or(k=16384)then q:=insertknot(q,qx+mem[w+1].int,qy+mem[w+2 ].int);end;if q<>mem[p].hh.rh then{501:}begin p:=mem[p].hh.rh; if(jointype=0)or(jointype=3)then begin if jointype=0 then{502:} begin det:=takefraction(dyout,dxin)-takefraction(dxout,dyin); if abs(det)<26844 then r:=0 else begin tmp:=takefraction(mem[q+1].int- mem[p+1].int,dyout)-takefraction(mem[q+2].int-mem[p+2].int,dxout); tmp:=makefraction(tmp,det); r:=insertknot(p,mem[p+1].int+takefraction(tmp,dxin),mem[p+2].int+ takefraction(tmp,dyin));end;end{:502}else{504:} begin htx:=mem[w+2].int-mem[w0+2].int;hty:=mem[w0+1].int-mem[w+1].int; while(abs(htx)<134217728)and(abs(hty)<134217728)do begin htx:=htx+htx; hty:=hty+hty;end;{506:}maxht:=0;kk:=16384;ww:=w; while true do begin{507:}if kk>k0 then begin ww:=mem[ww].hh.rh;decr(kk); end else begin ww:=mem[ww].hh.lh;incr(kk);end{:507}; if kk=k0 then goto 30; tmp:=takefraction(mem[ww+1].int-mem[w0+1].int,htx)+takefraction(mem[ww+2 ].int-mem[w0+2].int,hty);if tmp>maxht then maxht:=tmp;end;30:{:506}; tmp:=makefraction(maxht,takefraction(dxin,htx)+takefraction(dyin,hty)); r:=insertknot(p,mem[p+1].int+takefraction(tmp,dxin),mem[p+2].int+ takefraction(tmp,dyin)); tmp:=makefraction(maxht,takefraction(dxout,htx)+takefraction(dyout,hty)) ;r:=insertknot(r,mem[q+1].int+takefraction(tmp,dxout),mem[q+2].int+ takefraction(tmp,dyout));end{:504}; if r<>0 then begin mem[r+5].int:=mem[r+1].int; mem[r+6].int:=mem[r+2].int;end;end;end{:501};p:=q;until q0=c; makeenvelope:=c;end;{:493}{513:}function finddirectiontime(x,y:scaled; h:halfword):scaled;label 10,40,45,30;var max:scaled;p,q:halfword; n:scaled;tt:scaled;{516:}x1,x2,x3,y1,y2,y3:scaled;theta,phi:angle; t:fraction;{:516}begin{514:} if abs(x)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{:514};n:=0;p:=h; while true do begin if mem[p].hh.b1=0 then goto 45;q:=mem[p].hh.rh; {515:}tt:=0;{517:}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){:517}; if y1=0 then if x1>=0 then goto 40;if n>0 then begin{518:} theta:=narg(x1,y1); if theta>=0 then if phi<=0 then if phi>=theta-188743680 then goto 40; if theta<=0 then if phi>=0 then if phi<=theta+188743680 then goto 40{: 518};if p=h then goto 45;end;if(x3<>0)or(y3<>0)then phi:=narg(x3,y3); {520:}if x1<0 then if x2<0 then if x3<0 then goto 30; if abvscd(y1,y3,y2,y2)=0 then{522:} begin 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{523:} begin 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{:523} else if x3>=0 then begin tt:=65536;goto 40;end;goto 30;end{:522}; 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;{521:} 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{:521};30:{:520} {:515};p:=q;n:=n+65536;end;45:finddirectiontime:=-65536;goto 10; 40:finddirectiontime:=n+tt;10:end;{:513}{531:} procedure cubicintersection(p,pp:halfword);label 22,45,10; var q,qq:halfword;begin timetogo:=5000;maxt:=2;{533:}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]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]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]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]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{:533}; 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:=halfp(curt+1);curtt:=halfp(curtt+1);goto 10;end; maxt:=maxt+maxt;apprt:=curt;apprtt:=curtt;end;{534:} 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]:=half(bisectstack[bisectptr-25]+bisectstack[uv -4]); bisectstack[bisectptr-4]:=half(bisectstack[bisectptr-3]+bisectstack[uv-4 ]); bisectstack[bisectptr-23]:=half(bisectstack[bisectptr-24]+bisectstack[ bisectptr-4]);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]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]0 then bisectstack[bisectptr-2]:=0;end; bisectstack[bisectptr-30]:=bisectstack[uv-10]; bisectstack[bisectptr-8]:=bisectstack[uv-8]; bisectstack[bisectptr-29]:=half(bisectstack[bisectptr-30]+bisectstack[uv -9]); bisectstack[bisectptr-9]:=half(bisectstack[bisectptr-8]+bisectstack[uv-9 ]); bisectstack[bisectptr-28]:=half(bisectstack[bisectptr-29]+bisectstack[ bisectptr-9]);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]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]0 then bisectstack[bisectptr-7]:=0;end; bisectstack[bisectptr-35]:=bisectstack[xy-15]; bisectstack[bisectptr-13]:=bisectstack[xy-13]; bisectstack[bisectptr-34]:=half(bisectstack[bisectptr-35]+bisectstack[xy -14]); bisectstack[bisectptr-14]:=half(bisectstack[bisectptr-13]+bisectstack[xy -14]); bisectstack[bisectptr-33]:=half(bisectstack[bisectptr-34]+bisectstack[ bisectptr-14]);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]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]0 then bisectstack[bisectptr-12]:=0;end; bisectstack[bisectptr-40]:=bisectstack[xy-20]; bisectstack[bisectptr-18]:=bisectstack[xy-18]; bisectstack[bisectptr-39]:=half(bisectstack[bisectptr-40]+bisectstack[xy -19]); bisectstack[bisectptr-19]:=half(bisectstack[bisectptr-18]+bisectstack[xy -19]); bisectstack[bisectptr-38]:=half(bisectstack[bisectptr-39]+bisectstack[ bisectptr-19]);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]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]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{:534}; goto 22;end; if timetogo>0 then decr(timetogo)else begin while apprt<65536 do begin apprt:=apprt+apprt;apprtt:=apprtt+apprtt;end;curt:=apprt;curtt:=apprtt; goto 10;end;{535:}45:if odd(curtt)then if odd(curt)then{536:} begin curt:=halfp(curt);curtt:=halfp(curtt);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{:536}else begin incr(curt); 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;decr(curtt);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 incr(curtt);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{:535};end;10:end;{:531}{537:} procedure pathintersection(h,hh:halfword);label 10;var p,pp:halfword; n,nn:integer;begin{538:} 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;{:538};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;{:537}{545:} function maxcoef(p:halfword):fraction;var x:fraction;begin x:=0; while mem[p].hh.lh<>0 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;{:545}{551:} 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:=memtop-1; pp:=mem[p].hh.lh;qq:=mem[q].hh.lh; while true do if pp=qq then if pp=0 then goto 30 else{552:} 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)=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{:552} else if mem[pp+1].intt1 then scalingdown:=true else scalingdown:=not visscaled; if t1=17 then threshold:=1342 else threshold:=4;r:=memtop-1; while mem[p].hh.lh<>0 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[memtop-1].hh.rh;end; {:553}{555:}function pwithxbecomingq(p,x,q:halfword; t:smallnumber):halfword;var r,s:halfword;v:integer;sx:integer; begin s:=p;r:=memtop-1;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[memtop-1].hh. rh:=p;mem[r].hh.rh:=mem[s].hh.rh;v:=mem[s+1].int;freenode(s,2); pwithxbecomingq:=pplusfq(mem[memtop-1].hh.rh,v,q,t,17);end;end;{:555} {560:}procedure newdep(q,p:halfword);var r:halfword; begin mem[q+1].hh.rh:=p;mem[q+1].hh.lh:=5;r:=mem[5].hh.rh; mem[depfinal].hh.rh:=r;mem[r+1].hh.lh:=depfinal;mem[5].hh.rh:=q;end; {:560}{561:}function constdependency(v:scaled):halfword; begin depfinal:=getnode(2);mem[depfinal+1].int:=v; mem[depfinal].hh.lh:=0;constdependency:=depfinal;end;{:561}{562:} 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;{:562} {563:}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=0 then goto 30; mem[depfinal].hh.rh:=getnode(2);depfinal:=mem[depfinal].hh.rh; p:=mem[p].hh.rh;end;30:copydeplist:=q;end;{:563}{564:} procedure lineareq(p:halfword;t:smallnumber);var q,r,s:halfword; x:halfword;n:integer;v:integer;prevr:halfword;finalnode:halfword; w:integer;begin{565:}q:=p;r:=mem[p].hh.rh;v:=mem[q+1].int; while mem[r].hh.lh<>0 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{:565};x:=mem[q].hh.lh; n:=mem[x+1].int mod 64;{566:}s:=memtop-1;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=0; 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[memtop-1].hh.rh{:566};if internal[2]>0 then{567:} if interesting(x)then begin begindiagnostic;printnl(608); printvariablename(x);w:=n;while w>0 do begin print(601);w:=w-2;end; printchar(61);printdependency(p,17);enddiagnostic(false);end{:567}; {568:}prevr:=5;r:=mem[5].hh.rh;while r<>5 do begin s:=mem[r+1].hh.rh; q:=pwithxbecomingq(s,x,p,mem[r].hh.b0); if mem[q].hh.lh=0 then makeknown(r,q)else begin mem[r+1].hh.rh:=q; repeat q:=mem[q].hh.rh;until mem[q].hh.lh=0;prevr:=q;end; r:=mem[prevr].hh.rh;end{:568};{569:}if n>0 then{570:}begin s:=memtop-1; mem[memtop-1].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<>0)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=0;p:=mem[memtop-1].hh.rh;end{:570}; if mem[p].hh.lh=0 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{:569}; if fixneeded then fixdependencies;end;{:564}{573:} function newringentry(p:halfword):halfword;var q:halfword; begin q:=getnode(2);mem[q].hh.b1:=14;mem[q].hh.b0:=mem[p].hh.b0; if mem[p+1].int=0 then mem[q+1].int:=p else mem[q+1].int:=mem[p+1].int; mem[p+1].int:=q;newringentry:=q;end;{:573}{575:} 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 incr(strref[v]);end;end; 6:mem[q+1].int:=makepen(copypath(v),false);8:mem[q+1].int:=copypath(v); 10:begin mem[q+1].int:=v;incr(mem[v].hh.lh);end;end;q:=r;until q=p;end; {:575}{576:}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{577:} begin begin if interaction=3 then;printnl(262);print(611);end; begin helpptr:=2;helpline[1]:=612;helpline[0]:=613;end;putgeterror; end{:577};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;{:576}{580:} procedure showcmdmod(c,m:integer);begin begindiagnostic;printnl(123); printcmdmod(c,m);printchar(125);enddiagnostic(false);end;{:580}{590:} procedure showcontext;label 30;var oldsetting:0..10;{596:}i:0..bufsize; l:integer;m:integer;n:0..errorline;p:integer;q:integer;{:596} begin fileptr:=inputptr;inputstack[fileptr]:=curinput; while true do begin curinput:=inputstack[fileptr];{591:} if(fileptr=inputptr)or(curinput.indexfield<=15)or(curinput.indexfield<> 19)or(curinput.locfield<>0)then begin tally:=0;oldsetting:=selector; if(curinput.indexfield<=15)then begin{592:} if curinput.namefield>2 then begin printnl(curinput.namefield); print(58);printint(trueline);print(58); end else if(curinput.namefield=0)then if fileptr=0 then printnl(615)else printnl(616)else if curinput.namefield=2 then printnl(617)else printnl( 618);printchar(32){:592};{599:}begin l:=tally;tally:=0;selector:=6; 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 trickcount0 then if mem[p].hh.rh=1 then printexp(p,0)else showtokenlist(p,0, 20,tally);print(625);end{:594};18:printnl(620); 19:if curinput.locfield=0 then printnl(621)else printnl(622); 20:printnl(623);21:begin println; if curinput.namefield<>0 then print(hash[curinput.namefield].rh)else{595 :}begin p:=paramstack[curinput.limitfield]; if p=0 then showtokenlist(paramstack[curinput.limitfield+1],0,20,tally) else begin q:=p;while mem[q].hh.rh<>0 do q:=mem[q].hh.rh; mem[q].hh.rh:=paramstack[curinput.limitfield+1]; showtokenlist(p,0,20,tally);mem[q].hh.rh:=0;end;end{:595};print(513); end;others:printnl(63)end{:593};{600:}begin l:=tally;tally:=0; selector:=6;trickcount:=1000000;end; if curinput.indexfield<>21 then showtokenlist(curinput.startfield, curinput.locfield,100000,0)else showmacro(curinput.startfield,curinput. locfield,100000){:600};end;selector:=oldsetting;{598:} if trickcount=1000000 then begin firstcount:=tally; trickcount:=tally+1+errorline-halferrorline; if trickcounterrorline then print(275){:598};end{:591}; if(curinput.indexfield<=15)then if(curinput.namefield>2)or(fileptr=0) then goto 30;decr(fileptr);end;30:curinput:=inputstack[inputptr];end; {:590}{604:}procedure begintokenlist(p:halfword;t:quarterword); begin begin if inputptr>maxinstack then begin maxinstack:=inputptr; if inputptr=stacksize then overflow(626,stacksize);end; inputstack[inputptr]:=curinput;incr(inputptr);end; curinput.startfield:=p;curinput.indexfield:=t; curinput.limitfield:=paramptr;curinput.locfield:=p;end;{:604}{605:} procedure endtokenlist;label 30;var p:halfword; begin if curinput.indexfield>=19 then if curinput.indexfield<=20 then begin flushtokenlist(curinput.startfield);goto 30; end else deletemacref(curinput.startfield); while paramptr>curinput.limitfield do begin decr(paramptr); p:=paramstack[paramptr]; if p<>0 then if mem[p].hh.rh=1 then begin recyclevalue(p);freenode(p,2); end else flushtokenlist(p);end;30:begin decr(inputptr); curinput:=inputstack[inputptr];end; begin if interrupt<>0 then pauseforinstructions;end;end;{:605}{606:} {845:}{846:}procedure encapsulate(p:halfword);begin curexp:=getnode(2); mem[curexp].hh.b0:=curtype;mem[curexp].hh.b1:=14;newdep(curexp,p);end; {:846}{848:}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;{:848} procedure makeexpcopy(p:halfword);label 20;var q,r,t:halfword; begin 20:curtype:=mem[p].hh.b0; case curtype of 1,2,16:curexp:=mem[p+1].int; 3,5,7,11,9:curexp:=newringentry(p);4:begin curexp:=mem[p+1].int; begin if strref[curexp]<127 then incr(strref[curexp]);end;end; 10:begin curexp:=mem[p+1].int;incr(mem[curexp].hh.lh);end; 6:curexp:=makepen(copypath(mem[p+1].int),false); 8:curexp:=copypath(mem[p+1].int);12,13,14:{847:} begin if mem[p+1].int=0 then initbignode(p);t:=getnode(2); mem[t].hh.b1:=14;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{:847}; 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; others:confusion(851)end;end;{:845}function curtok:halfword; var p:halfword;savetype:smallnumber;saveexp:integer; begin if cursym=0 then if curcmd=40 then begin savetype:=curtype; saveexp:=curexp;makeexpcopy(curmod);p:=stashcurexp;mem[p].hh.rh:=0; curtype:=savetype;curexp:=saveexp;end else begin p:=getnode(2); mem[p+1].int:=curmod;mem[p].hh.b1:=15; if curcmd=44 then mem[p].hh.b0:=16 else mem[p].hh.b0:=4; end else begin begin p:=avail; if p=0 then p:=getavail else begin avail:=mem[p].hh.rh;mem[p].hh.rh:=0; ifdef('STAT')incr(dynused);endif('STAT')end;end;mem[p].hh.lh:=cursym; end;curtok:=p;end;{:606}{607:}procedure backinput;var p:halfword; begin p:=curtok; while(curinput.indexfield>15)and(curinput.locfield=0)do endtokenlist; begintokenlist(p,19);end;{:607}{608:}procedure backerror; begin OKtointerrupt:=false;backinput;OKtointerrupt:=true;error;end; procedure inserror;begin OKtointerrupt:=false;backinput; curinput.indexfield:=20;OKtointerrupt:=true;error;end;{:608}{609:} procedure beginfilereading;begin if inopen=15 then overflow(627,15); if first=bufsize then overflow(256,bufsize);incr(inopen); begin if inputptr>maxinstack then begin maxinstack:=inputptr; if inputptr=stacksize then overflow(626,stacksize);end; inputstack[inputptr]:=curinput;incr(inputptr);end; curinput.indexfield:=inopen;mpxname[curinput.indexfield]:=1; curinput.startfield:=first;curinput.namefield:=0;end;{:609}{610:} procedure endfilereading; begin if inopen>curinput.indexfield then if(mpxname[inopen]=1)or( curinput.namefield<=2)then confusion(628)else begin aclose(inputfile[ inopen]); begin if strref[mpxname[inopen]]<127 then if strref[mpxname[inopen]]>1 then decr(strref[mpxname[inopen]])else flushstring(mpxname[inopen]);end; decr(inopen);end;first:=curinput.startfield; if curinput.indexfield<>inopen then confusion(628); if curinput.namefield>2 then begin aclose(inputfile[curinput.indexfield] );begin if strref[curinput.namefield]<127 then if strref[curinput. namefield]>1 then decr(strref[curinput.namefield])else flushstring( curinput.namefield);end; begin if strref[inamestack[curinput.indexfield]]<127 then if strref[ inamestack[curinput.indexfield]]>1 then decr(strref[inamestack[curinput. indexfield]])else flushstring(inamestack[curinput.indexfield]);end; begin if strref[iareastack[curinput.indexfield]]<127 then if strref[ iareastack[curinput.indexfield]]>1 then decr(strref[iareastack[curinput. indexfield]])else flushstring(iareastack[curinput.indexfield]);end;end; begin decr(inputptr);curinput:=inputstack[inputptr];end;decr(inopen); end;{:610}{611:}function beginmpxreading:boolean; begin if inopen<>curinput.indexfield+1 then beginmpxreading:=false else begin if mpxname[inopen]<=1 then confusion(629); if first=bufsize then overflow(256,bufsize); begin if inputptr>maxinstack then begin maxinstack:=inputptr; if inputptr=stacksize then overflow(626,stacksize);end; inputstack[inputptr]:=curinput;incr(inputptr);end; curinput.indexfield:=inopen;curinput.startfield:=first; curinput.namefield:=mpxname[inopen]; begin if strref[curinput.namefield]<127 then incr(strref[curinput. namefield]);end;{644:}last:=first;curinput.limitfield:=last; buffer[curinput.limitfield]:=37;first:=curinput.limitfield+1; curinput.locfield:=curinput.startfield{:644};beginmpxreading:=true;end; end;{:611}{612:}procedure endmpxreading; begin if inopen<>curinput.indexfield then confusion(629); if curinput.locfield0)and(curinput.locfield=curinput.limitfield)do endfilereading; println;;end;{:615}{620:}function checkoutervalidity:boolean; var p:halfword; begin if scannerstatus=0 then checkoutervalidity:=true else if scannerstatus=7 then{621:} if cursym<>0 then checkoutervalidity:=true else begin deletionsallowed:= false;begin if interaction=3 then;printnl(262);print(640);end; printint(warninginfo);begin helpptr:=2;helpline[1]:=641; helpline[0]:=642;end;cursym:=9768;inserror;deletionsallowed:=true; checkoutervalidity:=false;end{:621}else begin deletionsallowed:=false; {622:}if cursym<>0 then begin p:=getavail;mem[p].hh.lh:=cursym; begintokenlist(p,19);end{:622};if scannerstatus>1 then{623:} begin runaway;if cursym=0 then begin if interaction=3 then;printnl(262); print(643);end else begin begin if interaction=3 then;printnl(262); print(644);end;end;print(645);begin helpptr:=4;helpline[3]:=646; helpline[2]:=647;helpline[1]:=648;helpline[0]:=649;end; case scannerstatus of{624:}2:begin print(650);helpline[3]:=651; cursym:=9763;end;3:begin print(652);helpline[3]:=653; if warninginfo=0 then cursym:=9767 else begin cursym:=9759; eqtb[9759].rh:=warninginfo;end;end;4,5:begin print(654); if scannerstatus=5 then print(hash[warninginfo].rh)else printvariablename(warninginfo);cursym:=9765;end;6:begin print(655); print(hash[warninginfo].rh);print(656);helpline[3]:=657;cursym:=9764; end;{:624}end;inserror;end{:623}else begin begin if interaction=3 then; printnl(262);print(635);end;printint(warninginfo);begin helpptr:=3; helpline[2]:=636;helpline[1]:=637;helpline[0]:=638;end; if cursym=0 then helpline[2]:=639;cursym:=9766;inserror;end; deletionsallowed:=true;checkoutervalidity:=false;end;end;{:620}{626:} procedure firmuptheline;forward;{:626}{627:}procedure getnext; label 20,10,50,40,25,85,86,87,30;var k:0..bufsize;c:ASCIIcode; class:ASCIIcode;n,f:integer;begin 20:cursym:=0; if(curinput.indexfield<=15)then{629:} begin 25:c:=buffer[curinput.locfield];incr(curinput.locfield); class:=charclass[c];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 if scannerstatus=7 then if curinput.locfield2 then{642:} begin incr(linestack[curinput.indexfield]);first:=curinput.startfield; if not forceeof then begin if inputln(inputfile[curinput.indexfield], true)then firmuptheline else forceeof:=true;end; if forceeof then begin forceeof:=false;decr(curinput.locfield); if(mpxname[curinput.indexfield]>1)then{643:} begin mpxname[curinput.indexfield]:=0;begin if interaction=3 then; printnl(262);print(676);end;begin helpptr:=4;helpline[3]:=677; helpline[2]:=632;helpline[1]:=678;helpline[0]:=679;end; deletionsallowed:=false;error;deletionsallowed:=true;cursym:=9769; goto 50;end{:643}else begin printchar(41);decr(openparens); fflush(stdout);endfilereading; if checkoutervalidity then goto 20 else goto 20;end end; buffer[curinput.limitfield]:=37;first:=curinput.limitfield+1; curinput.locfield:=curinput.startfield;end{:642} else begin if inputptr>0 then begin endfilereading;goto 20;end; if selector<9 then openlogfile; if interaction>1 then begin if curinput.limitfield=curinput.startfield then printnl(674);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(675);end{:640}; begin if interrupt<>0 then pauseforinstructions;end;goto 25;end; 4:if scannerstatus=7 then goto 25 else{631:} begin if buffer[curinput.locfield]=34 then curmod:=284 else begin k:= curinput.locfield;buffer[curinput.limitfield+1]:=34; repeat incr(curinput.locfield);until buffer[curinput.locfield]=34; if curinput.locfield>curinput.limitfield then{632:} begin curinput.locfield:=curinput.limitfield; begin if interaction=3 then;printnl(262);print(665);end; begin helpptr:=3;helpline[2]:=666;helpline[1]:=667;helpline[0]:=668;end; deletionsallowed:=false;error;deletionsallowed:=true;goto 20;end{:632}; if curinput.locfield=k+1 then curmod:=buffer[k]else begin begin if poolptr+curinput.locfield-k>maxpoolptr then if poolptr+curinput.locfield -k>poolsize then docompaction(curinput.locfield-k)else maxpoolptr:= poolptr+curinput.locfield-k;end; repeat begin strpool[poolptr]:=buffer[k];incr(poolptr);end;incr(k); until k=curinput.locfield;curmod:=makestring;end;end; incr(curinput.locfield);curcmd:=41;goto 10;end{:631}; 5,6,7,8:begin k:=curinput.locfield-1;goto 40;end; 20:if scannerstatus=7 then goto 25 else{630:} begin begin if interaction=3 then;printnl(262);print(662);end; begin helpptr:=2;helpline[1]:=663;helpline[0]:=664;end; deletionsallowed:=false;error;deletionsallowed:=true;goto 20;end{:630}; others:end;k:=curinput.locfield-1; while charclass[buffer[curinput.locfield]]=class do incr(curinput. locfield);goto 40;85:{633:}n:=c-48; while charclass[buffer[curinput.locfield]]=0 do begin if n<32768 then n :=10*n+buffer[curinput.locfield]-48;incr(curinput.locfield);end; if buffer[curinput.locfield]=46 then if charclass[buffer[curinput. locfield+1]]=0 then goto 30;f:=0;goto 87; 30:incr(curinput.locfield){:633};86:{634:}k:=0; repeat if k<17 then begin dig[k]:=buffer[curinput.locfield]-48;incr(k); end;incr(curinput.locfield); until charclass[buffer[curinput.locfield]]<>0;f:=rounddecimals(k); if f=65536 then begin incr(n);f:=0;end{:634};87:{635:} if n<32768 then{636:}begin curmod:=n*65536+f; if curmod>=268435456 then if(internal[30]>0)and(scannerstatus<>7)then begin begin if interaction=3 then;printnl(262);print(672);end; printscaled(curmod);printchar(41);begin helpptr:=3;helpline[2]:=673; helpline[1]:=605;helpline[0]:=606;end;error;end;end{:636} else if scannerstatus<>7 then begin begin if interaction=3 then; printnl(262);print(669);end;begin helpptr:=2;helpline[1]:=670; helpline[0]:=671;end;deletionsallowed:=false;error; deletionsallowed:=true;curmod:=2147483647;end;curcmd:=44;goto 10{:635}; 40:cursym:=idlookup(k,curinput.locfield-k);end{:629}else{637:} if curinput.locfield>=himemmin then begin cursym:=mem[curinput.locfield] .hh.lh;curinput.locfield:=mem[curinput.locfield].hh.rh; if cursym>=9772 then if cursym>=9922 then{638:} begin if cursym>=10072 then cursym:=cursym-150; begintokenlist(paramstack[curinput.limitfield+cursym-(9922)],18); goto 20;end{:638}else begin curcmd:=40; curmod:=paramstack[curinput.limitfield+cursym-(9772)];cursym:=0;goto 10; end;end else if curinput.locfield>0 then{639:} begin if mem[curinput.locfield].hh.b1=15 then begin curmod:=mem[curinput .locfield+1].int; if mem[curinput.locfield].hh.b0=16 then curcmd:=44 else begin curcmd:=41 ;begin if strref[curmod]<127 then incr(strref[curmod]);end;end; end else begin curmod:=curinput.locfield;curcmd:=40;end; curinput.locfield:=mem[curinput.locfield].hh.rh;goto 10;end{:639} else begin endtokenlist;goto 20;end{:637};50:{628:} curcmd:=eqtb[cursym].lh;curmod:=eqtb[cursym].rh; if curcmd>=85 then if checkoutervalidity then curcmd:=curcmd-85 else goto 20{:628};10:end;{:627}{645:}procedure firmuptheline; var k:0..bufsize;begin curinput.limitfield:=last; if internal[24]>0 then if interaction>1 then begin;println; if curinput.startfieldfirst 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;{:645} {649:}procedure startmpxinput;forward;procedure tnext;label 65,50; var oldstatus:0..6;oldinfo:integer; begin while curcmd<=3 do begin if curcmd=3 then if not(curinput. indexfield<=15)or(mpxname[curinput.indexfield]=1)then{653:} begin begin if interaction=3 then;printnl(262);print(690);end; begin helpptr:=2;helpline[1]:=691;helpline[0]:=692;end;error;end{:653} else begin endmpxreading;goto 65; end else if curcmd=1 then if(curinput.indexfield>15)or(curinput. namefield<=2)then{652:}begin begin if interaction=3 then;printnl(262); print(686);end;begin helpptr:=3;helpline[2]:=687;helpline[1]:=688; helpline[0]:=689;end;error;end{:652} else if(mpxname[curinput.indexfield]>1)then{651:} begin begin if interaction=3 then;printnl(262);print(683);end; begin helpptr:=4;helpline[3]:=631;helpline[2]:=632;helpline[1]:=684; helpline[0]:=685;end;error;end{:651} else if(curmod<>1)and(mpxname[curinput.indexfield]<>0)then begin if not beginmpxreading then startmpxinput;end else goto 65 else{654:} begin begin if interaction=3 then;printnl(262);print(693);end; begin helpptr:=1;helpline[0]:=694;end;error;end{:654};goto 50;65:{650:} oldstatus:=scannerstatus;oldinfo:=warninginfo;scannerstatus:=7; warninginfo:=linestack[curinput.indexfield];repeat getnext; until curcmd=2;scannerstatus:=oldstatus;warninginfo:=oldinfo{:650}; 50:getnext;end;end;{:649}{657:}function scantoks(terminator:commandcode; substlist,tailend:halfword;suffixcount:smallnumber):halfword; label 30,40;var p:halfword;q:halfword;balance:integer;begin p:=memtop-2; balance:=1;mem[memtop-2].hh.rh:=0;while true do begin begin getnext; if curcmd<=3 then tnext;end;if cursym>0 then begin{658:} begin q:=substlist; while q<>0 do begin if mem[q].hh.lh=cursym then begin cursym:=mem[q+1]. int;curcmd:=10;goto 40;end;q:=mem[q].hh.rh;end;40:end{:658}; if curcmd=terminator then{659:} if curmod>0 then incr(balance)else begin decr(balance); if balance=0 then goto 30;end{:659}else if curcmd=63 then{662:} begin if curmod=0 then begin getnext;if curcmd<=3 then tnext; end else if curmod<=suffixcount then cursym:=9921+curmod;end{:662};end; mem[p].hh.rh:=curtok;p:=mem[p].hh.rh;end;30:mem[p].hh.rh:=tailend; flushnodelist(substlist);scantoks:=mem[memtop-2].hh.rh;end;{:657}{663:} procedure getsymbol;label 20;begin 20:begin getnext; if curcmd<=3 then tnext;end; if(cursym=0)or(cursym>9757)then begin begin if interaction=3 then; printnl(262);print(706);end;begin helpptr:=3;helpline[2]:=707; helpline[1]:=708;helpline[0]:=709;end; if cursym>0 then helpline[2]:=710 else if curcmd=41 then begin if strref [curmod]<127 then if strref[curmod]>1 then decr(strref[curmod])else flushstring(curmod);end;cursym:=9757;inserror;goto 20;end;end;{:663} {664:}procedure getclearsymbol;begin getsymbol; clearsymbol(cursym,false);end;{:664}{665:}procedure checkequals; begin if curcmd<>53 then if curcmd<>76 then begin missingerr(61); begin helpptr:=5;helpline[4]:=711;helpline[3]:=712;helpline[2]:=713; helpline[1]:=714;helpline[0]:=715;end;backerror;end;end;{:665}{666:} 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:=9772; getclearsymbol;warninginfo:=cursym;getsymbol;p:=getnode(2); mem[p].hh.lh:=cursym;mem[p+1].int:=9773;mem[p].hh.rh:=q;begin getnext; if curcmd<=3 then tnext;end;checkequals;scannerstatus:=5;q:=getavail; mem[q].hh.lh:=0;r:=getavail;mem[q].hh.rh:=r;mem[r].hh.lh:=0; mem[r].hh.rh:=scantoks(18,p,0,0);scannerstatus:=0; eqtb[warninginfo].lh:=m;eqtb[warninginfo].rh:=q;getxnext;end;{:666} {669:}{1049:}procedure checkdelimiter(ldelim,rdelim:halfword);label 10; begin if curcmd=64 then if curmod=ldelim then goto 10; if cursym<>rdelim then begin missingerr(hash[rdelim].rh); begin helpptr:=2;helpline[1]:=970;helpline[0]:=971;end;backerror; end else begin begin if interaction=3 then;printnl(262);print(972);end; print(hash[rdelim].rh);print(973);begin helpptr:=3;helpline[2]:=974; helpline[1]:=975;helpline[0]:=976;end;error;end;10:end;{:1049}{1028:} function scandeclaredvariable:halfword;label 30;var x:halfword; h,t:halfword;l:halfword;begin getsymbol;x:=cursym; if curcmd<>43 then clearsymbol(x,false);h:=getavail;mem[h].hh.lh:=x; t:=h;while true do begin getxnext;if cursym=0 then goto 30; if curcmd<>43 then if curcmd<>42 then if curcmd=65 then{1029:} begin l:=cursym;getxnext;if curcmd<>66 then begin backinput;cursym:=l; curcmd:=65;goto 30;end else cursym:=0;end{:1029}else goto 30; mem[t].hh.rh:=getavail;t:=mem[t].hh.rh;mem[t].hh.lh:=cursym;end; 30:if eqtb[x].lh<>43 then clearsymbol(x,false); if eqtb[x].rh=0 then newroot(x);scandeclaredvariable:=h;end;{:1028} 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[memtop-2].hh.rh:=0;q:=getavail;mem[q].hh.lh:=0; r:=0;{672:}if m=1 then begin getclearsymbol;warninginfo:=cursym; begin getnext;if curcmd<=3 then tnext;end;scannerstatus:=5;n:=0; eqtb[warninginfo].lh:=13;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=0 then{673:} begin begin if interaction=3 then;printnl(262);print(722);end; begin helpptr:=2;helpline[1]:=723;helpline[0]:=724;end;error; warninginfo:=22;end{:673};scannerstatus:=4;n:=2; if curcmd=63 then if curmod=3 then begin n:=3;begin getnext; if curcmd<=3 then tnext;end;end;mem[warninginfo].hh.b0:=20+n; mem[warninginfo+1].int:=q;end{:672};k:=n;if curcmd=33 then{675:} repeat ldelim:=cursym;rdelim:=curmod;begin getnext; if curcmd<=3 then tnext;end; if(curcmd=58)and(curmod>=9772)then base:=curmod else begin begin if interaction=3 then;printnl(262);print(725);end;begin helpptr:=1; helpline[0]:=726;end;backerror;base:=9772;end;{676:} 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(727,150);incr(k);mem[p].hh.rh:=r;r:=p; begin getnext;if curcmd<=3 then tnext;end;until curcmd<>81{:676}; checkdelimiter(ldelim,rdelim);begin getnext;if curcmd<=3 then tnext;end; until curcmd<>33{:675};if curcmd=58 then{677:}begin p:=getnode(2); if curmod<9772 then begin c:=curmod;mem[p+1].int:=9772+k; end else begin mem[p+1].int:=curmod+k; if curmod=9772 then c:=4 else if curmod=9922 then c:=6 else c:=7;end; if k=150 then overflow(727,150);incr(k);getsymbol;mem[p].hh.lh:=cursym; mem[p].hh.rh:=r;r:=p;begin getnext;if curcmd<=3 then tnext;end; if c=4 then if curcmd=70 then begin c:=5;p:=getnode(2); if k=150 then overflow(727,150);mem[p+1].int:=9772+k;getsymbol; mem[p].hh.lh:=cursym;mem[p].hh.rh:=r;r:=p;begin getnext; if curcmd<=3 then tnext;end;end;end{:677};checkequals;p:=getavail; mem[p].hh.lh:=c;mem[q].hh.rh:=p;{670:} if m=1 then mem[p].hh.rh:=scantoks(18,r,0,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(18,r,p,n);end; if warninginfo=22 then flushtokenlist(mem[23].int){:670}; scannerstatus:=0;getxnext;end;{:669}{678:}procedure scanprimary;forward; procedure scansecondary;forward;procedure scantertiary;forward; procedure scanexpression;forward;procedure scansuffix;forward;{692:} {694:}procedure printmacroname(a,n:halfword);var p,q:halfword; begin if n<>0 then print(hash[n].rh)else begin p:=mem[a].hh.lh; if p=0 then print(hash[mem[mem[mem[a].hh.rh].hh.lh].hh.lh].rh)else begin q:=p;while mem[q].hh.rh<>0 do q:=mem[q].hh.rh; mem[q].hh.rh:=mem[mem[a].hh.rh].hh.lh;showtokenlist(p,0,1000,0); mem[q].hh.rh:=0;end;end;end;{:694}{695:}procedure printarg(q:halfword; n:integer;b:halfword); begin if mem[q].hh.rh=1 then printnl(510)else if(b<10072)and(b<>7)then printnl(511)else printnl(512);printint(n);print(743); if mem[q].hh.rh=1 then printexp(q,1)else showtokenlist(q,0,1000,0);end; {:695}{702:}procedure scantextarg(ldelim,rdelim:halfword);label 30; var balance:integer;p:halfword;begin warninginfo:=ldelim; scannerstatus:=3;p:=memtop-2;balance:=1;mem[memtop-2].hh.rh:=0; while true do begin begin getnext;if curcmd<=3 then tnext;end; if ldelim=0 then{704:} begin if curcmd>81 then begin if balance=1 then goto 30 else if curcmd= 83 then decr(balance);end else if curcmd=34 then incr(balance);end{:704} else{703:} begin if curcmd=64 then begin if curmod=ldelim then begin decr(balance); if balance=0 then goto 30;end; end else if curcmd=33 then if curmod=rdelim then incr(balance);end{:703} ;mem[p].hh.rh:=curtok;p:=mem[p].hh.rh;end; 30:curexp:=mem[memtop-2].hh.rh;curtype:=20;scannerstatus:=0;end;{:702} 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;incr(mem[defref].hh.lh); if arglist=0 then n:=0 else{696:}begin n:=1;tail:=arglist; while mem[tail].hh.rh<>0 do begin incr(n);tail:=mem[tail].hh.rh;end; end{:696};if internal[8]>0 then{693:}begin begindiagnostic;println; printmacroname(arglist,macroname);if n=3 then print(705); showmacro(defref,0,100000);if arglist<>0 then begin n:=0;p:=arglist; repeat q:=mem[p].hh.lh;printarg(q,n,0);incr(n);p:=mem[p].hh.rh; until p=0;end;enddiagnostic(false);end{:693};{697:}curcmd:=82; while mem[r].hh.lh>=9772 do begin{698:} if curcmd<>81 then begin getxnext; if curcmd<>33 then begin begin if interaction=3 then;printnl(262); print(749);end;printmacroname(arglist,macroname);begin helpptr:=3; helpline[2]:=750;helpline[1]:=751;helpline[0]:=752;end; if mem[r].hh.lh>=9922 then begin curexp:=0;curtype:=20; end else begin curexp:=0;curtype:=16;end;backerror;curcmd:=64;goto 40; end;ldelim:=cursym;rdelim:=curmod;end;{701:} if mem[r].hh.lh>=10072 then scantextarg(ldelim,rdelim)else begin getxnext;if mem[r].hh.lh>=9922 then scansuffix else scanexpression; end{:701};if curcmd<>81 then{699:} if(curcmd<>64)or(curmod<>ldelim)then if mem[mem[r].hh.rh].hh.lh>=9772 then begin missingerr(44);begin helpptr:=3;helpline[2]:=753; helpline[1]:=754;helpline[0]:=748;end;backerror;curcmd:=81; end else begin missingerr(hash[rdelim].rh);begin helpptr:=2; helpline[1]:=755;helpline[0]:=748;end;backerror;end{:699};40:{700:} begin p:=getavail; if curtype=20 then mem[p].hh.lh:=curexp else mem[p].hh.lh:=stashcurexp; if internal[8]>0 then begin begindiagnostic; printarg(mem[p].hh.lh,n,mem[r].hh.lh);enddiagnostic(false);end; if arglist=0 then arglist:=p else mem[tail].hh.rh:=p;tail:=p;incr(n); end{:700}{:698};r:=mem[r].hh.rh;end; if curcmd=81 then begin begin if interaction=3 then;printnl(262); print(744);end;printmacroname(arglist,macroname);printchar(59); printnl(745);print(hash[rdelim].rh);print(299);begin helpptr:=3; helpline[2]:=746;helpline[1]:=747;helpline[0]:=748;end;error;end; if mem[r].hh.lh<>0 then{705:} begin if mem[r].hh.lh<7 then begin getxnext; if mem[r].hh.lh<>6 then if(curcmd=53)or(curcmd=76)then getxnext;end; case mem[r].hh.lh of 1:scanprimary;2:scansecondary;3:scantertiary; 4:scanexpression;5:{706:}begin scanexpression;p:=getavail; mem[p].hh.lh:=stashcurexp;if internal[8]>0 then begin begindiagnostic; printarg(mem[p].hh.lh,n,0);enddiagnostic(false);end; if arglist=0 then arglist:=p else mem[tail].hh.rh:=p;tail:=p;incr(n); if curcmd<>70 then begin missingerr(489);print(756); printmacroname(arglist,macroname);begin helpptr:=1;helpline[0]:=757;end; backerror;end;getxnext;scanprimary;end{:706};6:{707:} begin if curcmd<>33 then ldelim:=0 else begin ldelim:=cursym; rdelim:=curmod;getxnext;end;scansuffix; if ldelim<>0 then begin if(curcmd<>64)or(curmod<>ldelim)then begin missingerr(hash[rdelim].rh);begin helpptr:=2;helpline[1]:=755; helpline[0]:=748;end;backerror;end;getxnext;end;end{:707}; 7:scantextarg(0,0);end;backinput;{700:}begin p:=getavail; if curtype=20 then mem[p].hh.lh:=curexp else mem[p].hh.lh:=stashcurexp; if internal[8]>0 then begin begindiagnostic; printarg(mem[p].hh.lh,n,mem[r].hh.lh);enddiagnostic(false);end; if arglist=0 then arglist:=p else mem[tail].hh.rh:=p;tail:=p;incr(n); end{:700};end{:705};r:=mem[r].hh.rh{:697};{708:} while(curinput.indexfield>15)and(curinput.locfield=0)do endtokenlist; if paramptr+n>maxparamstack then begin maxparamstack:=paramptr+n; if maxparamstack>150 then overflow(727,150);end; begintokenlist(defref,21);curinput.namefield:=macroname; curinput.locfield:=r;if n>0 then begin p:=arglist; repeat paramstack[paramptr]:=mem[p].hh.lh;incr(paramptr); p:=mem[p].hh.rh;until p=0;flushlist(arglist);end{:708};end;{:692} procedure getboolean;forward;procedure passtext;forward; procedure conditional;forward;procedure startinput;forward; procedure beginiteration;forward;procedure resumeiteration;forward; procedure stopiteration;forward;{:678}{679:}procedure expand; var p:halfword;k:integer;j:poolpointer; begin if internal[6]>65536 then if curcmd<>13 then showcmdmod(curcmd, curmod);case curcmd of 4:conditional;5:{723:} if curmod>iflimit then if iflimit=1 then begin missingerr(58);backinput; cursym:=9762;inserror;end else begin begin if interaction=3 then; printnl(262);print(764);end;printcmdmod(5,curmod);begin helpptr:=1; helpline[0]:=765;end;error;end else begin while curmod<>2 do passtext; {717:}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{:717}; end{:723};6:{683:}if curmod>0 then forceeof:=true else startinput{:683}; 7:if curmod=0 then{680:}begin begin if interaction=3 then;printnl(262); print(728);end;begin helpptr:=2;helpline[1]:=729;helpline[0]:=730;end; error;end{:680}else beginiteration;8:{684:} begin while(curinput.indexfield>15)and(curinput.locfield=0)do endtokenlist;if loopptr=0 then begin begin if interaction=3 then; printnl(262);print(732);end;begin helpptr:=2;helpline[1]:=733; helpline[0]:=734;end;error;end else resumeiteration;end{:684};9:{685:} begin getboolean;if internal[6]>65536 then showcmdmod(35,curexp); if curexp=30 then if loopptr=0 then begin begin if interaction=3 then; printnl(262);print(735);end;begin helpptr:=1;helpline[0]:=736;end; if curcmd=82 then error else backerror;end else{686:}begin p:=0; repeat if(curinput.indexfield<=15)then endfilereading else begin if curinput.indexfield<=17 then p:=curinput.startfield;endtokenlist;end; until p<>0;if p<>mem[loopptr].hh.lh then fatalerror(739);stopiteration; end{:686}else if curcmd<>82 then begin missingerr(59);begin helpptr:=2; helpline[1]:=737;helpline[0]:=738;end;backerror;end;end{:685};10:; 12:{687:}begin begin getnext;if curcmd<=3 then tnext;end;p:=curtok; begin getnext;if curcmd<=3 then tnext;end; if curcmd<14 then expand else backinput;begintokenlist(p,19);end{:687}; 11:{688:}begin getxnext;scanprimary; if curtype<>4 then begin disperr(0,740);begin helpptr:=2; helpline[1]:=741;helpline[0]:=742;end;putgetflusherror(0); end else begin backinput; if(strstart[nextstr[curexp]]-strstart[curexp])>0 then{689:} begin beginfilereading;curinput.namefield:=2; k:=first+(strstart[nextstr[curexp]]-strstart[curexp]); if k>=maxbufstack then begin if k>=bufsize then begin maxbufstack:= bufsize;overflow(256,bufsize);end;maxbufstack:=k+1;end; j:=strstart[curexp];curinput.limitfield:=k; while first=14; unstashcurexp(saveexp);end;end;{:690}{709:} procedure stackargument(p:halfword); begin if paramptr=maxparamstack then begin incr(maxparamstack); if maxparamstack>150 then overflow(727,150);end;paramstack[paramptr]:=p; incr(paramptr);end;{:709}{714:}procedure passtext;label 30; var l:integer;begin scannerstatus:=1;l:=0;warninginfo:=trueline; while true do begin begin getnext;if curcmd<=3 then tnext;end; if curcmd<=5 then if curcmd<5 then incr(l)else begin if l=0 then goto 30 ;if curmod=2 then decr(l);end else{715:} if curcmd=41 then begin if strref[curmod]<127 then if strref[curmod]>1 then decr(strref[curmod])else flushstring(curmod);end{:715};end; 30:scannerstatus:=0;end;{:714}{718:} 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=0 then confusion(758); 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;{:718}{719:}procedure checkcolon; begin if curcmd<>80 then begin missingerr(58);begin helpptr:=2; helpline[1]:=761;helpline[0]:=738;end;backerror;end;end;{:719}{720:} procedure conditional;label 10,30,21,40;var savecondptr:halfword; newiflimit:2..4;p:halfword;begin{716:}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:=trueline;curif:=1; end{:716};savecondptr:=condptr;21:getboolean;newiflimit:=4; if internal[6]>65536 then{722:}begin begindiagnostic; if curexp=30 then print(762)else print(763);enddiagnostic(false); end{:722};40:checkcolon; if curexp=30 then begin changeiflimit(newiflimit,savecondptr);goto 10; end;{721:}while true do begin passtext; if condptr=savecondptr then goto 30 else if curmod=2 then{717:} 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{:717}; end{:721};30:curif:=curmod;ifline:=trueline;if curmod=2 then{717:} 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{:717} else if curmod=4 then goto 21 else begin curexp:=30;newiflimit:=2; getxnext;goto 40;end;10:end;{:720}{726:}procedure badfor(s:strnumber); begin disperr(0,766);print(s);print(306);begin helpptr:=4; helpline[3]:=767;helpline[2]:=768;helpline[1]:=769;helpline[0]:=308;end; putgetflusherror(0);end;{:726}{727:}procedure beginiteration; label 22,30;var m:halfword;n:halfword;s:halfword;p:halfword;q:halfword; pp:halfword;begin m:=curmod;n:=cursym;s:=getnode(2); if m=1 then begin mem[s+1].hh.lh:=1;p:=0;getxnext; end else begin getsymbol;p:=getnode(2);mem[p].hh.lh:=cursym; mem[p+1].int:=m;getxnext;if curcmd=74 then{740:}begin getxnext; scanexpression;{741:}if curtype<>10 then begin disperr(0,782); begin helpptr:=1;helpline[0]:=783;end;putgetflusherror(getnode(8)); initedges(curexp);curtype:=10;end{:741};mem[s+1].hh.lh:=curexp; curtype:=1;q:=mem[curexp+7].hh.rh; if q<>0 then if(mem[q].hh.b0>=4)then if skip1component(q)=0 then q:=mem[ q].hh.rh;mem[s+1].hh.rh:=q;end{:740}else begin{728:} if(curcmd<>53)and(curcmd<>76)then begin missingerr(61);begin helpptr:=3; helpline[2]:=770;helpline[1]:=713;helpline[0]:=771;end;backerror; end{:728};{738:}mem[s+1].hh.lh:=0;q:=s+1;mem[q].hh.rh:=0; repeat getxnext; if m<>9772 then scansuffix else begin if curcmd>=80 then if curcmd<=81 then goto 22;scanexpression;if curcmd=72 then if q=s+1 then{739:} begin if curtype<>16 then badfor(777);pp:=getnode(4); mem[pp+1].int:=curexp;getxnext;scanexpression; if curtype<>16 then badfor(778);mem[pp+2].int:=curexp; if curcmd<>73 then begin missingerr(500);begin helpptr:=2; helpline[1]:=779;helpline[0]:=780;end;backerror;end;getxnext; scanexpression;if curtype<>16 then badfor(781);mem[pp+3].int:=curexp; mem[s+1].hh.rh:=pp;mem[s+1].hh.lh:=2;goto 30;end{:739}; curexp:=stashcurexp;end;mem[q].hh.rh:=getavail;q:=mem[q].hh.rh; mem[q].hh.lh:=curexp;curtype:=1;22:until curcmd<>81;30:{:738};end;end; {729:}if curcmd<>80 then begin missingerr(58);begin helpptr:=3; helpline[2]:=772;helpline[1]:=773;helpline[0]:=774;end;backerror; end{:729};{731:}q:=getavail;mem[q].hh.lh:=9758;scannerstatus:=6; warninginfo:=n;mem[s].hh.lh:=scantoks(7,p,q,0);scannerstatus:=0; mem[s].hh.rh:=loopptr;loopptr:=s{:731};resumeiteration;end;{:727}{733:} procedure resumeiteration;label 45,10;var p,q:halfword; begin p:=mem[loopptr+1].hh.lh;if p=2 then begin p:=mem[loopptr+1].hh.rh; curexp:=mem[p+1].int;if{734:} ((mem[p+2].int>0)and(curexp>mem[p+3].int))or((mem[p+2].int<0)and(curexp< mem[p+3].int)){:734}then goto 45;curtype:=16;q:=stashcurexp; mem[p+1].int:=curexp+mem[p+2].int; end else if p=0 then begin p:=mem[loopptr+1].hh.rh;if p=0 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;ifdef('STAT')decr(dynused); endif('STAT')end; end else if p=1 then begin begintokenlist(mem[loopptr].hh.lh,16); goto 10;end else{736:}begin q:=mem[loopptr+1].hh.rh;if q=0 then goto 45; if not(mem[q].hh.b0>=4)then q:=mem[q].hh.rh else if not(mem[q].hh.b0>=6) then q:=skip1component(q)else goto 45; curexp:=copyobjects(mem[loopptr+1].hh.rh,q);initbbox(curexp); curtype:=10;mem[loopptr+1].hh.rh:=q;q:=stashcurexp;end{:736}; begintokenlist(mem[loopptr].hh.lh,17);stackargument(q); if internal[6]>65536 then{735:}begin begindiagnostic;printnl(776); if(q<>0)and(mem[q].hh.rh=1)then printexp(q,1)else showtokenlist(q,0,50,0 );printchar(125);enddiagnostic(false);end{:735};goto 10; 45:stopiteration;10:end;{:733}{737:}procedure stopiteration; var p,q:halfword;begin p:=mem[loopptr+1].hh.lh; if p=2 then freenode(mem[loopptr+1].hh.rh,4)else if p=0 then begin q:= mem[loopptr+1].hh.rh;while q<>0 do begin p:=mem[q].hh.lh; if p<>0 then if mem[p].hh.rh=1 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;ifdef('STAT')decr(dynused); endif('STAT')end;end; end else if p>2 then if mem[p].hh.lh=0 then tossedges(p)else decr(mem[p] .hh.lh);p:=loopptr;loopptr:=mem[p].hh.rh;flushtokenlist(mem[p].hh.lh); freenode(p,2);end;{:737}{755:}procedure packbufferedname(n:smallnumber; a,b:integer);var k:integer;c:ASCIIcode;j:integer; begin if n+b-a+5>maxint then b:=a+maxint-n-5;k:=0; if nameoffile then libcfree(nameoffile); nameoffile:=xmalloc(1+n+(b-a+1)+5); for j:=1 to n do begin c:=xord[MPmemdefault[j]];incr(k); if k<=maxint then nameoffile[k]:=xchr[c];end; for j:=a to b do begin c:=buffer[j];incr(k); if k<=maxint then nameoffile[k]:=xchr[c];end; for j:=memdefaultlength-3 to memdefaultlength do begin c:=xord[ MPmemdefault[j]];incr(k);if k<=maxint then nameoffile[k]:=xchr[c];end; if k<=maxint then namelength:=k else namelength:=maxint; nameoffile[namelength+1]:=0;end;{:755}{757:} function makenamestring:strnumber;var k:1..maxint; begin if stroverflowed then makenamestring:=63 else begin begin if poolptr+namelength>maxpoolptr then if poolptr+namelength>poolsize then docompaction(namelength)else maxpoolptr:=poolptr+namelength;end; for k:=1 to namelength do begin strpool[poolptr]:=xord[nameoffile[k]]; incr(poolptr);end;makenamestring:=makestring;end;end; function amakenamestring(var f:alphafile):strnumber; begin amakenamestring:=makenamestring;end; function bmakenamestring(var f:bytefile):strnumber; begin bmakenamestring:=makenamestring;end; function wmakenamestring(var f:wordfile):strnumber; begin wmakenamestring:=makenamestring;end;{:757}{758:} procedure scanfilename;label 30;begin beginname; while(buffer[curinput.locfield]=32)or(buffer[curinput.locfield]=9)do incr(curinput.locfield); 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; incr(curinput.locfield);end;30:endname;end;{:758}{762:} procedure packjobname(s:strnumber); begin begin if strref[s]<127 then incr(strref[s]);end; begin if strref[curname]<127 then if strref[curname]>1 then decr(strref[ curname])else flushstring(curname);end; begin if strref[curarea]<127 then if strref[curarea]>1 then decr(strref[ curarea])else flushstring(curarea);end; begin if strref[curext]<127 then if strref[curext]>1 then decr(strref[ curext])else flushstring(curext);end;curarea:=284;curext:=s; curname:=jobname;packfilename(curname,curarea,curext);end;{:762}{763:} procedure promptfilename(s,e:strnumber);label 30;var k:0..bufsize; begin if interaction=2 then;if s=785 then begin if interaction=3 then; printnl(262);print(786);end else begin if interaction=3 then; printnl(262);print(787);end;printfilename(curname,curarea,curext); print(788);if e=284 then showcontext;printnl(789);print(s); if interaction<2 then fatalerror(790);;begin;print(791);terminput;end; {764:}begin beginname;k:=first; while((buffer[k]=32)or(buffer[k]=9))and(k15)and(curinput.locfield=0)do endtokenlist; if(curinput.indexfield>15)then begin begin if interaction=3 then; printnl(262);print(799);end;begin helpptr:=3;helpline[2]:=800; helpline[1]:=801;helpline[0]:=802;end;error;end; if(curinput.indexfield<=15)then scanfilename else begin curname:=284; curext:=284;curarea:=284;end{:773};while true do begin beginfilereading; if tryextension(798)then goto 30 else if tryextension(797)then goto 30 else;endfilereading;promptfilename(785,284);end; 30:curinput.namefield:=amakenamestring(inputfile[curinput.indexfield]); {769:} if inamestack[curinput.indexfield]=curname then begin if strref[curname] <127 then incr(strref[curname]);end; if iareastack[curinput.indexfield]=curarea then begin if strref[curarea] <127 then incr(strref[curarea]);end{:769};if jobname=0 then begin j:=1; beginname;while(j<=namelength)and(morename(nameoffile[j]))do incr(j); endname;jobname:=curname;strref[jobname]:=127; ifdef('INIMP')if iniversion and dumpoption then begin begin if poolptr+ memdefaultlength>maxpoolptr then if poolptr+memdefaultlength>poolsize then docompaction(memdefaultlength)else maxpoolptr:=poolptr+ memdefaultlength;end; for j:=1 to memdefaultlength-4 do begin strpool[poolptr]:=xord[ MPmemdefault[j]];incr(poolptr);end;jobname:=makestring; strref[jobname]:=127;end;endif('INIMP')openlogfile;end; if termoffset+(strstart[nextstr[curinput.namefield]]-strstart[curinput. namefield])>maxprintline-2 then println else if(termoffset>0)or( fileoffset>0)then printchar(32);printchar(40);incr(openparens); print(curinput.namefield);fflush(stdout);{771:}{:771};{772:} begin linestack[curinput.indexfield]:=1; if inputln(inputfile[curinput.indexfield],false)then;firmuptheline; buffer[curinput.limitfield]:=37;first:=curinput.limitfield+1; curinput.locfield:=curinput.startfield;end{:772};end;{:770}{774:} procedure copyoldname(s:strnumber);var k:integer;j:poolpointer; begin k:=0;if oldfilename then libcfree(oldfilename); oldfilename:=xmalloc(1+(strstart[nextstr[s]]-strstart[s])+1); for j:=strstart[s]to strstart[nextstr[s]]-1 do begin incr(k); if k<=maxint then oldfilename[k]:=xchr[strpool[j]];end; if k<=maxint then oldnamelength:=k else oldnamelength:=maxint; oldfilename[oldnamelength+1]:=0;end;{:774}{776:}procedure startmpxinput; label 10,45;var k:1..maxint; begin packfilename(inamestack[curinput.indexfield],iareastack[curinput. indexfield],803);{777:}copyoldname(curinput.namefield); if not callmakempx(oldfilename+1,nameoffile+1)then goto 45{:777}; beginfilereading; if not aopenin(inputfile[curinput.indexfield],-1)then begin endfilereading;goto 45;end; curinput.namefield:=amakenamestring(inputfile[curinput.indexfield]); mpxname[curinput.indexfield]:=curinput.namefield; begin if strref[curinput.namefield]<127 then incr(strref[curinput. namefield]);end;{772:}begin linestack[curinput.indexfield]:=1; if inputln(inputfile[curinput.indexfield],false)then;firmuptheline; buffer[curinput.limitfield]:=37;first:=curinput.limitfield+1; curinput.locfield:=curinput.startfield;end{:772};goto 10;45:{778:} if interaction=3 then;printnl(804); for k:=1 to oldnamelength do print(xord[oldfilename[k]]);printnl(804); for k:=1 to namelength do print(xord[nameoffile[k]]);printnl(805); begin helpptr:=4;helpline[3]:=806;helpline[2]:=807;helpline[1]:=808; helpline[0]:=809;end;begin if interaction=3 then interaction:=2; if logopened then error; ifdef('TEXMF_DEBUG')if interaction>0 then debughelp; endif('TEXMF_DEBUG')history:=3;jumpout;end;{:778};10:end;{:776}{782:} function startreadinput(s:strnumber;n:readfindex):boolean;label 10,45; begin strscanfile(s);packfilename(curname,curarea,curext); beginfilereading;if not aopenin(rdfile[n],-1)then goto 45; if not inputln(rdfile[n],false)then begin aclose(rdfile[n]);goto 45;end; rdfname[n]:=s;begin if strref[s]<127 then incr(strref[s]);end; startreadinput:=true;goto 10;45:endfilereading;startreadinput:=false; 10:end;{:782}{783:}procedure openwritefile(s:strnumber;n:readfindex); ifdef('AMIGA')label 30;var n0:readfindex; endif('AMIGA')begin strscanfile(s);packfilename(curname,curarea,curext); ifdef('AMIGA')for n0:=0 to readfiles-1 do begin if rdfname[n0]<>0 then begin if strvsstr(s,rdfname[n0])=0 then begin aclose(rdfile[n0]); begin if strref[rdfname[n0]]<127 then if strref[rdfname[n0]]>1 then decr (strref[rdfname[n0]])else flushstring(rdfname[n0]);end;rdfname[n0]:=0; if n0=readfiles-1 then readfiles:=n0;goto 30;end;end;end;30:; endif('AMIGA')while not openoutnameok(nameoffile+1)or not aopenout( wrfile[n])do promptfilename(810,284);wrfname[n]:=s; begin if strref[s]<127 then incr(strref[s]);end; if logopened then begin oldsetting:=selector; if(internal[12]<=0)then selector:=9 else selector:=10;printnl(502); printint(n);print(811);printfilename(curname,curarea,curext);print(788); printnl(284);println;selector:=oldsetting;end;end;{:783}{812:} procedure badexp(s:strnumber);var saveflag:0..84; begin begin if interaction=3 then;printnl(262);print(s);end;print(819); printcmdmod(curcmd,curmod);printchar(39);begin helpptr:=4; helpline[3]:=820;helpline[2]:=821;helpline[1]:=822;helpline[0]:=823;end; backinput;cursym:=0;curcmd:=44;curmod:=0;inserror;saveflag:=varflag; varflag:=0;getxnext;varflag:=saveflag;end;{:812}{815:} procedure stashin(p:halfword);var q:halfword; begin mem[p].hh.b0:=curtype; if curtype=16 then mem[p+1].int:=curexp else begin if curtype=19 then{ 817:}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{:817}else begin mem[p+1]:=mem[curexp+1]; mem[mem[p+1].hh.lh].hh.rh:=p;end;freenode(curexp,2);end;curtype:=1;end; {:815}{838:}procedure backexpr;var p:halfword;begin p:=stashcurexp; mem[p].hh.rh:=0;begintokenlist(p,19);end;{:838}{839:} procedure badsubscript;begin disperr(0,837);begin helpptr:=3; helpline[2]:=838;helpline[1]:=839;helpline[0]:=840;end;flusherror(0); end;{:839}{841:}procedure obliterated(q:halfword); begin begin if interaction=3 then;printnl(262);print(841);end; showtokenlist(q,0,1000,0);print(842);begin helpptr:=5;helpline[4]:=843; helpline[3]:=844;helpline[2]:=845;helpline[1]:=846;helpline[0]:=847;end; end;{:841}{853:}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;{:853}{858:}{859:} procedure knownpair;var p:halfword; begin if curtype<>14 then begin disperr(0,858);begin helpptr:=5; helpline[4]:=859;helpline[3]:=860;helpline[2]:=861;helpline[1]:=862; helpline[0]:=863;end;putgetflusherror(0);curx:=0;cury:=0; end else begin p:=mem[curexp+1].int;{860:} if mem[p].hh.b0=16 then curx:=mem[p+1].int else begin disperr(p,864); begin helpptr:=5;helpline[4]:=865;helpline[3]:=860;helpline[2]:=861; helpline[1]:=862;helpline[0]:=863;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,866) ;begin helpptr:=5;helpline[4]:=867;helpline[3]:=860;helpline[2]:=861; helpline[1]:=862;helpline[0]:=863;end;putgeterror;recyclevalue(p+2); cury:=0;end{:860};flushcurexp(0);end;end;{:859} 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;{:858}{862:} function scandirection:smallnumber;var t:2..4;x:scaled;begin getxnext; if curcmd=62 then{863:}begin getxnext;scanexpression; if(curtype<>16)or(curexp<0)then begin disperr(0,870);begin helpptr:=1; helpline[0]:=871;end;putgetflusherror(65536);end;t:=3;end{:863} else{864:}begin scanexpression;if curtype>14 then{865:} begin if curtype<>16 then begin disperr(0,864);begin helpptr:=5; helpline[4]:=865;helpline[3]:=860;helpline[2]:=861;helpline[1]:=862; helpline[0]:=863;end;putgetflusherror(0);end;x:=curexp; if curcmd<>81 then begin missingerr(44);begin helpptr:=2; helpline[1]:=872;helpline[0]:=873;end;backerror;end;getxnext; scanexpression;if curtype<>16 then begin disperr(0,866); begin helpptr:=5;helpline[4]:=867;helpline[3]:=860;helpline[2]:=861; helpline[1]:=862;helpline[0]:=863;end;putgetflusherror(0);end; cury:=curexp;curx:=x;end{:865}else knownpair; if(curx=0)and(cury=0)then t:=4 else begin t:=2;curexp:=narg(curx,cury); end;end{:864};if curcmd<>67 then begin missingerr(125);begin helpptr:=3; helpline[2]:=868;helpline[1]:=869;helpline[0]:=738;end;backerror;end; getxnext;scandirection:=t;end;{:862}{882:}{884:}procedure finishread; var k:poolpointer; begin begin if poolptr+last-curinput.startfield>maxpoolptr then if poolptr+last-curinput.startfield>poolsize then docompaction(last- curinput.startfield)else maxpoolptr:=poolptr+last-curinput.startfield; end; for k:=curinput.startfield to last-1 do begin strpool[poolptr]:=buffer[k ];incr(poolptr);end;endfilereading;curtype:=4;curexp:=makestring;end; {:884}procedure donullary(c:quarterword); begin begin if aritherror then cleararith;end; if internal[6]>131072 then showcmdmod(35,c); case c of 30,31:begin curtype:=2;curexp:=c;end;32:begin curtype:=10; curexp:=getnode(8);initedges(curexp);end;33:begin curtype:=6; curexp:=getpencircle(0);end;37:begin curtype:=16;curexp:=normrand;end; 36:begin curtype:=6;curexp:=getpencircle(65536);end; 34:begin if jobname=0 then openlogfile;curtype:=4;curexp:=jobname;end; 35:{883:}begin if interaction<=1 then fatalerror(884);beginfilereading; curinput.namefield:=1;curinput.limitfield:=curinput.startfield;begin; print(284);terminput;end;finishread;end{:883};end; begin if aritherror then cleararith;end;end;{:882}{885:}{886:} 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;{:886}{887:} function nicecolororpair(p:integer;t:quarterword):boolean;label 10; var q,r:halfword; begin if(t<>14)and(t<>13)then nicecolororpair:=false else begin q:=mem[p +1].int;r:=q+bignodesize[mem[p].hh.b0];repeat r:=r-2; if mem[r].hh.b0<>16 then begin nicecolororpair:=false;goto 10;end; until r=q;nicecolororpair:=true;end;10:end;{:887}{888:} procedure printknownorunknowntype(t:smallnumber;v:integer); begin printchar(40); if t>16 then print(885)else begin if(t=14)or(t=13)then if not nicecolororpair(v,t)then print(886);printtype(t);end;printchar(41);end; {:888}{889:}procedure badunary(c:quarterword);begin disperr(0,887); printop(c);printknownorunknowntype(curtype,curexp);begin helpptr:=3; helpline[2]:=888;helpline[1]:=889;helpline[0]:=890;end;putgeterror;end; {:889}{892:}procedure negatedeplist(p:halfword);label 10; begin while true do begin mem[p+1].int:=-mem[p+1].int; if mem[p].hh.lh=0 then goto 10;p:=mem[p].hh.rh;end;10:end;{:892}{896:} procedure pairtopath;begin curexp:=newknot;curtype:=8;end;{:896}{898:} procedure takepart(c:quarterword);var p:halfword; begin p:=mem[curexp+1].int;mem[10].int:=p;mem[9].hh.b0:=curtype; mem[p].hh.rh:=9;freenode(curexp,2);makeexpcopy(p+sectoroffset[c-49]); recyclevalue(9);end;{:898}{901:}procedure scaleedges;forward; procedure takepictpart(c:quarterword);label 10,45;var p:halfword; begin p:=mem[curexp+7].hh.rh; if p<>0 then begin case c of 54,55,56,57,58,59:if mem[p].hh.b0=3 then flushcurexp(mem[p+c-46].int)else goto 45; 60,61,62:if(mem[p].hh.b0<4)then flushcurexp(mem[p+c-58].int)else goto 45 ;{902:} 64:if mem[p].hh.b0<>3 then goto 45 else begin flushcurexp(mem[p+1].hh.rh );begin if strref[curexp]<127 then incr(strref[curexp]);end;curtype:=4; end; 63:if mem[p].hh.b0<>3 then goto 45 else begin flushcurexp(fontname[mem[p +1].hh.lh]);begin if strref[curexp]<127 then incr(strref[curexp]);end; curtype:=4;end; 65:if mem[p].hh.b0=3 then goto 45 else if(mem[p].hh.b0>=6)then confusion (892)else begin flushcurexp(copypath(mem[p+1].hh.rh));curtype:=8;end; 66:if not(mem[p].hh.b0<3)then goto 45 else if mem[p+1].hh.lh=0 then goto 45 else begin flushcurexp(makepen(copypath(mem[p+1].hh.lh),false)); curtype:=6;end; 67:if mem[p].hh.b0<>2 then goto 45 else if mem[p+6].hh.rh=0 then goto 45 else begin incr(mem[mem[p+6].hh.rh].hh.lh);sesf:=mem[p+7].int; sepic:=mem[p+6].hh.rh;scaleedges;flushcurexp(sepic);curtype:=10;end; {:902}end;goto 10;end;45:{904:}case c of 64,63:begin flushcurexp(284); curtype:=4;end;65:begin flushcurexp(getnode(7));mem[curexp].hh.b0:=0; mem[curexp].hh.b1:=0;mem[curexp].hh.rh:=curexp;mem[curexp+1].int:=0; mem[curexp+2].int:=0;curtype:=8;end; 66:begin flushcurexp(getpencircle(0));curtype:=6;end; 67:begin flushcurexp(getnode(8));initedges(curexp);curtype:=10;end; others:flushcurexp(0)end{:904};10:end;{:901}{906:} procedure strtonum(c:quarterword);var n:integer;m:ASCIIcode; k:poolpointer;b:8..16;badchar:boolean; begin if c=50 then if(strstart[nextstr[curexp]]-strstart[curexp])=0 then n:=-1 else n:=strpool[strstart[curexp]]else begin if c=48 then b:=8 else b:=16;n:=0;badchar:=false; for k:=strstart[curexp]to strstart[nextstr[curexp]]-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;{907:} if badchar then begin disperr(0,893);if c=48 then begin helpptr:=1; helpline[0]:=894;end else begin helpptr:=1;helpline[0]:=895;end; putgeterror;end; if(n>4095)then if internal[30]>0 then begin begin if interaction=3 then; printnl(262);print(896);end;printint(n);printchar(41);begin helpptr:=2; helpline[1]:=897;helpline[0]:=606;end;putgeterror;end{:907};end; flushcurexp(n*65536);end;{:906}{909:}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;{:909}{910:} function pictlength:scaled;label 40;var n:scaled;p:halfword;begin n:=0; p:=mem[curexp+7].hh.rh; if p<>0 then begin if(mem[p].hh.b0>=4)then if skip1component(p)=0 then p :=mem[p].hh.rh; while p<>0 do begin if not(mem[p].hh.b0>=4)then p:=mem[p].hh.rh else if not(mem[p].hh.b0>=6)then p:=skip1component(p)else goto 40;n:=n+65536; end;end;40:pictlength:=n;end;{:910}{912:} function countturns(c:halfword):scaled;var p:halfword;t:integer; begin t:=0;p:=c;repeat t:=t+mem[p].hh.lh-16384;p:=mem[p].hh.rh; until p=c;countturns:=(t div 3)*65536;end;{:912}{914:} procedure testknown(c:quarterword);label 30;var b:30..31;p,q:halfword; begin b:=31;case curtype of 1,2,4,6,8,10,16:b:=30; 12,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; others:end;if c=41 then flushcurexp(b)else flushcurexp(61-b);curtype:=2; end;{:914}{919:}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:=14;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;{:919}{921:} function getcurbbox:boolean;label 10; begin case curtype of 10:begin setbbox(curexp,true); if mem[curexp+2].int>mem[curexp+4].int then begin bbmin[0]:=0; bbmax[0]:=0;bbmin[1]:=0;bbmax[1]:=0; end else begin bbmin[0]:=mem[curexp+2].int;bbmax[0]:=mem[curexp+4].int; bbmin[1]:=mem[curexp+3].int;bbmax[1]:=mem[curexp+5].int;end;end; 8:pathbbox(curexp);6:penbbox(curexp);others:begin getcurbbox:=false; goto 10;end end;getcurbbox:=true;10:end;{:921}{923:} procedure doreadorclose(c:quarterword);label 10,22,40,45,46; var n,n0:readfindex;begin{924:}n:=readfiles;n0:=readfiles; repeat 22:if n>0 then decr(n)else if c=39 then goto 46 else{925:} begin if n0=readfiles then if readfiles1 then decr( strref[rdfname[n]])else flushstring(rdfname[n]);end;rdfname[n]:=0; if n=readfiles-1 then readfiles:=n;if c=39 then goto 46;{929:} if eofline=0 then begin begin strpool[poolptr]:=0;incr(poolptr);end; eofline:=makestring;strref[eofline]:=127;end{:929};flushcurexp(eofline); curtype:=4{:926};goto 10;46:flushcurexp(0);curtype:=1;goto 10; 40:flushcurexp(0);finishread;10:end;{:923} procedure dounary(c:quarterword);var p,q,r:halfword;x:integer; begin begin if aritherror then cleararith;end; if internal[6]>131072 then{890:}begin begindiagnostic;printnl(123); printop(c);printchar(40);printexp(0,0);print(891);enddiagnostic(false); end{:890};case c of 89:if curtype<13 then badunary(89);90:{891:} case curtype of 13,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;r:=p+bignodesize[curtype];repeat r:=r-2; if mem[r].hh.b0=16 then mem[r+1].int:=-mem[r+1].int else negatedeplist( mem[r+1].hh.rh);until r=p;end;recyclevalue(q);freenode(q,2);end; 17,18:negatedeplist(mem[curexp+1].hh.rh);16:curexp:=-curexp; others:badunary(90)end{:891};{893:} 43:if curtype<>2 then badunary(43)else curexp:=61-curexp;{:893}{894:} 68,69,70,71,72,73,74,40,75:if curtype<>16 then badunary(c)else case c of 68:curexp:=squarert(curexp);69:curexp:=mexp(curexp); 70:curexp:=mlog(curexp);71,72:begin nsincos((curexp mod 23592960)*16); if c=71 then curexp:=roundfraction(nsin)else curexp:=roundfraction(ncos) ;end;73:curexp:=floorscaled(curexp);74:curexp:=unifrand(curexp); 40:begin if odd(roundunscaled(curexp))then curexp:=30 else curexp:=31; curtype:=2;end;75:{1276:}begin curexp:=roundunscaled(curexp)mod 256; if curexp<0 then curexp:=curexp+256; if charexists[curexp]then curexp:=30 else curexp:=31;curtype:=2; end{:1276};end;{:894}{895:} 82: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(82);{:895}{897:} 54,55:if(curtype=14)or(curtype=12)then takepart(c)else if curtype=10 then takepictpart(c)else badunary(c); 56,57,58,59:if curtype=12 then takepart(c)else if curtype=10 then takepictpart(c)else badunary(c); 60,61,62:if curtype=13 then takepart(c)else if curtype=10 then takepictpart(c)else badunary(c);{:897}{900:} 63,64,65,66,67:if curtype=10 then takepictpart(c)else badunary(c);{:900} {905:} 51:if curtype<>16 then badunary(51)else begin curexp:=roundunscaled( curexp)mod 256;curtype:=4;if curexp<0 then curexp:=curexp+256;end; 44:if curtype<>16 then badunary(44)else begin oldsetting:=selector; selector:=4;printscaled(curexp);curexp:=makestring;selector:=oldsetting; curtype:=4;end;48,49,50:if curtype<>4 then badunary(c)else strtonum(c); 76:if curtype<>4 then badunary(76)else{1190:} flushcurexp((fontdsize[findfont(curexp)]+8)div 16){:1190};{:905}{908:} 52:case curtype of 4:flushcurexp((strstart[nextstr[curexp]]-strstart[ curexp])*65536);8:flushcurexp(pathlength);16:curexp:=abs(curexp); 10:flushcurexp(pictlength); others:if nicepair(curexp,curtype)then flushcurexp(pythadd(mem[mem[ curexp+1].int+1].int,mem[mem[curexp+1].int+3].int))else badunary(c)end; {:908}{911:} 53:if curtype=14 then flushcurexp(0)else if curtype<>8 then badunary(53) else if mem[curexp].hh.b0=0 then flushcurexp(0)else begin curexp:= offsetprep(curexp,13); if internal[5]>65536 then printspec(curexp,13,898); flushcurexp(countturns(curexp));end;{:911}{913:} 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<=7)then flushcurexp(30)else flushcurexp(31);curtype:=2;end; 8:begin if(curtype>=8)and(curtype<=9)then flushcurexp(30)else flushcurexp(31);curtype:=2;end; 10:begin if(curtype>=10)and(curtype<=11)then flushcurexp(30)else flushcurexp(31);curtype:=2;end; 12,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;41,42:testknown(c);{:913}{915:} 83:begin if curtype<>8 then flushcurexp(31)else if mem[curexp].hh.b0<>0 then flushcurexp(30)else flushcurexp(31);curtype:=2;end;{:915}{916:} 81:begin if curtype=14 then pairtopath; if curtype<>8 then badunary(81)else flushcurexp(getarclength(curexp)); end;{:916}{917:} 84,85,86,87,88:begin if curtype<>10 then flushcurexp(31)else if mem[ curexp+7].hh.rh=0 then flushcurexp(31)else if mem[mem[curexp+7].hh.rh]. hh.b0=c-83 then flushcurexp(30)else flushcurexp(31);curtype:=2;end; {:917}{918:}47:begin if curtype=14 then pairtopath; if curtype<>8 then badunary(47)else begin curtype:=6; curexp:=makepen(curexp,true);end;end; 46:if curtype<>6 then badunary(46)else begin curtype:=8; makepath(curexp);end;45:if curtype=8 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(45);{:918}{920:} 77:if not getcurbbox then badunary(77)else pairvalue(bbmin[0],bbmin[1]); 78:if not getcurbbox then badunary(78)else pairvalue(bbmax[0],bbmin[1]); 79:if not getcurbbox then badunary(79)else pairvalue(bbmin[0],bbmax[1]); 80:if not getcurbbox then badunary(80)else pairvalue(bbmax[0],bbmax[1]); {:920}{922:}38,39:if curtype<>4 then badunary(c)else doreadorclose(c); {:922}end;begin if aritherror then cleararith;end;end;{:885}{930:}{931:} procedure badbinary(p:halfword;c:quarterword);begin disperr(p,284); disperr(0,887);if c>=115 then printop(c); printknownorunknowntype(mem[p].hh.b0,p); if c>=115 then print(489)else printop(c); printknownorunknowntype(curtype,curexp);begin helpptr:=3; helpline[2]:=888;helpline[1]:=900;helpline[0]:=901;end;putgeterror;end; {:931}{936:}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:=1;goto 10;end;until r=q; tarnished:=0;10:end;{:936}{938:}{943:}procedure depfinish(v,q:halfword; t:smallnumber);var p:halfword;vv:scaled; begin if q=0 then p:=curexp else p:=q;mem[p+1].hh.rh:=v;mem[p].hh.b0:=t; if mem[v].hh.lh=0 then begin vv:=mem[v+1].int; if q=0 then flushcurexp(vv)else begin recyclevalue(p);mem[q].hh.b0:=16; mem[q+1].int:=vv;end;end else if q=0 then curtype:=t; if fixneeded then fixdependencies;end;{:943} procedure addorsubtract(p,q:halfword;c:quarterword);label 30,10; var s,t:smallnumber;r:halfword;v:integer; begin if q=0 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=90 then v:=-v; if mem[p].hh.b0=16 then begin v:=slowadd(mem[p+1].int,v); if q=0 then curexp:=v else mem[q+1].int:=v;goto 10;end;{939:} r:=mem[p+1].hh.rh;while mem[r].hh.lh<>0 do r:=mem[r].hh.rh; mem[r+1].int:=slowadd(mem[r+1].int,v);if q=0 then begin q:=getnode(2); curexp:=q;curtype:=mem[p].hh.b0;mem[q].hh.b1:=14;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;{:939};end else begin if c=90 then negatedeplist(v); {940:}if mem[p].hh.b0=16 then{941:} begin while mem[v].hh.lh<>0 do v:=mem[v].hh.rh; mem[v+1].int:=slowadd(mem[p+1].int,mem[v+1].int);end{:941} else begin 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:{942:} if q<>0 then depfinish(v,q,t)else begin curtype:=t;depfinish(v,0,t); end{:942};end{:940};end;10:end;{:938}{951:}procedure depmult(p:halfword; v:integer;visscaled:boolean);label 10;var q:halfword;s,t:smallnumber; begin if p=0 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;{:951}{954:}procedure hardtimes(p:halfword);label 30; var q:halfword;r:halfword;v:scaled; begin if mem[p].hh.b0<=14 then begin q:=stashcurexp;unstashcurexp(p); p:=q;end;r:=mem[curexp+1].int+bignodesize[curtype]; while true do begin r:=r-2;v:=mem[r+1].int;mem[r].hh.b0:=mem[p].hh.b0; if r=mem[curexp+1].int then goto 30; newdep(r,copydeplist(mem[p+1].hh.rh));depmult(r,v,true);end; 30:mem[r+1]:=mem[p+1];mem[mem[p+1].hh.lh].hh.rh:=r;freenode(p,2); depmult(r,v,true);end;{:954}{956:}procedure depdiv(p:halfword;v:scaled); label 10;var q:halfword;s,t:smallnumber; begin if p=0 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;{:956}{960:} procedure setuptrans(c:quarterword);label 30,10;var p,q,r:halfword; begin if(c<>108)or(curtype<>12)then{962:}begin p:=stashcurexp; curexp:=idtransform;curtype:=12;q:=mem[curexp+1].int;case c of{964:} 104:if mem[p].hh.b0=16 then{965:} begin 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{:965};105:if mem[p].hh.b0>14 then begin install(q+6,p);goto 30;end; 106:if mem[p].hh.b0>14 then begin install(q+4,p);install(q+10,p); goto 30;end;107:if mem[p].hh.b0=14 then begin r:=mem[p+1].int; install(q,r);install(q+2,r+2);goto 30;end; 109:if mem[p].hh.b0>14 then begin install(q+4,p);goto 30;end; 110:if mem[p].hh.b0>14 then begin install(q+10,p);goto 30;end; 111:if mem[p].hh.b0=14 then{966:}begin 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{:966};108:;{:964}end; disperr(p,910);begin helpptr:=3;helpline[2]:=911;helpline[1]:=912; helpline[0]:=913;end;putgeterror;30:recyclevalue(p);freenode(p,2); end{:962};{963:}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){:963};10:end;{:960}{967:} procedure setupknowntrans(c:quarterword);begin setuptrans(c); if curtype<>16 then begin disperr(0,914);begin helpptr:=3; helpline[2]:=915;helpline[1]:=916;helpline[0]:=913;end; putgetflusherror(0);txx:=65536;txy:=0;tyx:=0;tyy:=65536;tx:=0;ty:=0;end; end;{:967}{968:}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;{:968}{969:}procedure dopathtrans(p:halfword); label 10;var q:halfword;begin q:=p; 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=p;10:end; {:969}{970:}procedure dopentrans(p:halfword);label 10;var q:halfword; begin if(p=mem[p].hh.rh)then begin trans(p+3,p+4);trans(p+5,p+6);end; q:=p;repeat trans(q+1,q+2);q:=mem[q].hh.rh;until q=p;10:end;{:970}{971:} function edgestrans(h:halfword):halfword;label 31;var q:halfword; r,s:halfword;sx,sy:scaled;sqdet:scaled;sgndet:integer;v:scaled; begin h:=privateedges(h);sqdet:=sqrtdet(txx,txy,tyx,tyy); sgndet:=abvscd(txx,tyy,txy,tyx);if mem[h].hh.rh<>2 then{972:} if(txy<>0)or(tyx<>0)or(ty<>0)or(abs(txx)<>abs(tyy))then flushdashlist(h) else begin if txx<0 then{973:}begin r:=mem[h].hh.rh;mem[h].hh.rh:=2; while r<>2 do begin s:=r;r:=mem[r].hh.rh;v:=mem[s+1].int; mem[s+1].int:=mem[s+2].int;mem[s+2].int:=v;mem[s].hh.rh:=mem[h].hh.rh; mem[h].hh.rh:=s;end;end{:973};{974:}r:=mem[h].hh.rh; while r<>2 do begin mem[r+1].int:=takescaled(mem[r+1].int,txx)+tx; mem[r+2].int:=takescaled(mem[r+2].int,txx)+tx;r:=mem[r].hh.rh;end{:974}; mem[h+1].int:=takescaled(mem[h+1].int,abs(tyy));end{:972};{975:} if(txx=0)and(tyy=0)then{976:}begin v:=mem[h+2].int; mem[h+2].int:=mem[h+3].int;mem[h+3].int:=v;v:=mem[h+4].int; mem[h+4].int:=mem[h+5].int;mem[h+5].int:=v;end{:976} else if(txy<>0)or(tyx<>0)then begin initbbox(h);goto 31;end; if mem[h+2].int<=mem[h+4].int then{977:} begin mem[h+2].int:=takescaled(mem[h+2].int,txx+txy)+tx; mem[h+4].int:=takescaled(mem[h+4].int,txx+txy)+tx; mem[h+3].int:=takescaled(mem[h+3].int,tyx+tyy)+ty; mem[h+5].int:=takescaled(mem[h+5].int,tyx+tyy)+ty; if txx+txy<0 then begin v:=mem[h+2].int;mem[h+2].int:=mem[h+4].int; mem[h+4].int:=v;end;if tyx+tyy<0 then begin v:=mem[h+3].int; mem[h+3].int:=mem[h+5].int;mem[h+5].int:=v;end;end{:977};31:{:975}; q:=mem[h+7].hh.rh;while q<>0 do begin{978:} case mem[q].hh.b0 of 1,2:begin dopathtrans(mem[q+1].hh.rh);{979:} if mem[q+1].hh.lh<>0 then begin sx:=tx;sy:=ty;tx:=0;ty:=0; dopentrans(mem[q+1].hh.lh); if((mem[q].hh.b0=2)and(mem[q+6].hh.rh<>0))then mem[q+7].int:=takescaled( mem[q+7].int,sqdet); if not(mem[q+1].hh.lh=mem[mem[q+1].hh.lh].hh.rh)then if sgndet<0 then mem[q+1].hh.lh:=makepen(copypath(mem[q+1].hh.lh),true);tx:=sx;ty:=sy; end{:979};end;4,5:dopathtrans(mem[q+1].hh.rh);3:begin r:=q+8;{980:} trans(r,r+1);sx:=tx;sy:=ty;tx:=0;ty:=0;trans(r+2,r+4);trans(r+3,r+5); tx:=sx;ty:=sy{:980};end;6,7:;end{:978};q:=mem[q].hh.rh;end; edgestrans:=h;end;procedure doedgestrans(p:halfword;c:quarterword); begin setupknowntrans(c);mem[p+1].int:=edgestrans(mem[p+1].int); unstashcurexp(p);end;procedure scaleedges;begin txx:=sesf;tyy:=sesf; txy:=0;tyx:=0;tx:=0;ty:=0;sepic:=edgestrans(sepic);end;{:971}{981:} {983:}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{984:} 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{:984}; 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<>0 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;{:983}{986:} 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;{:986}{987:}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<>0 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;{:987}{989:} 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;{:989}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{982:} begin setupknowntrans(c);makeexpcopy(p);r:=mem[curexp+1].int; if curtype=12 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{:982};until r=q;{985:} setuptrans(c);if curtype=16 then{988:}begin makeexpcopy(p); r:=mem[curexp+1].int; if curtype=12 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{:988}else begin pp:=stashcurexp;qq:=mem[pp+1].int;makeexpcopy(p); r:=mem[curexp+1].int; if curtype=12 then begin bilin2(r+10,qq+10,mem[q+7].int,qq+8,0); bilin2(r+8,qq+10,mem[q+5].int,qq+8,0); bilin2(r+6,qq+4,mem[q+11].int,qq+6,0); bilin2(r+4,qq+4,mem[q+9].int,qq+6,0);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; {:985};10:end;{:981}{991:}procedure cat(p:halfword);var a,b:strnumber; k:poolpointer;begin a:=mem[p+1].int;b:=curexp; begin if poolptr+(strstart[nextstr[a]]-strstart[a])+(strstart[nextstr[b] ]-strstart[b])>maxpoolptr then if poolptr+(strstart[nextstr[a]]-strstart [a])+(strstart[nextstr[b]]-strstart[b])>poolsize then docompaction(( strstart[nextstr[a]]-strstart[a])+(strstart[nextstr[b]]-strstart[b])) else maxpoolptr:=poolptr+(strstart[nextstr[a]]-strstart[a])+(strstart[ nextstr[b]]-strstart[b]);end; for k:=strstart[a]to strstart[nextstr[a]]-1 do begin strpool[poolptr]:= strpool[k];incr(poolptr);end; for k:=strstart[b]to strstart[nextstr[b]]-1 do begin strpool[poolptr]:= strpool[k];incr(poolptr);end;curexp:=makestring; begin if strref[b]<127 then if strref[b]>1 then decr(strref[b])else flushstring(b);end;end;{:991}{992:}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[nextstr[s]]-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 if poolptr+b-a>poolsize then docompaction(b-a)else maxpoolptr:=poolptr+b-a;end; if reversed then for k:=strstart[s]+b-1 downto strstart[s]+a do begin strpool[poolptr]:=strpool[k];incr(poolptr); end else for k:=strstart[s]+a to strstart[s]+b-1 do begin strpool[ poolptr]:=strpool[k];incr(poolptr);end;curexp:=makestring; begin if strref[s]<127 then if strref[s]>1 then decr(strref[s])else flushstring(s);end;end;{:992}{993:}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;{994:}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{:994};q:=curexp; while a>=65536 do begin q:=mem[q].hh.rh;a:=a-65536;b:=b-65536;end; if b=a then{996:}begin if a>0 then begin splitcubic(q,a*4096); q:=mem[q].hh.rh;end;pp:=copyknot(q);qq:=pp;end{:996}else{995:} begin 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); 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);freenode(qq,7); qq:=mem[rr].hh.rh;end;end{:995};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;{:993}{998:}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;{:998}{999:}procedure findpoint(v:scaled;c:quarterword); var p:halfword;n:scaled;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; 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{1000:}begin splitcubic(p,v*4096);p:=mem[p].hh.rh;end{:1000} ;{1001:}case c of 118:pairvalue(mem[p+1].int,mem[p+2].int); 119: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); 120: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{:1001};end;{:999}{1005:} procedure doinfont(p:halfword);var q:halfword;begin q:=getnode(8); initedges(q); mem[mem[q+7].hh.lh].hh.rh:=newtextnode(curexp,mem[p+1].int); mem[q+7].hh.lh:=mem[mem[q+7].hh.lh].hh.rh;freenode(p,2);flushcurexp(q); curtype:=10;end;{:1005}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[6]>131072 then{932:}begin begindiagnostic;printnl(902); printexp(p,0);printchar(41);printop(c);printchar(40);printexp(0,0); print(891);enddiagnostic(false);end{:932};{934:} case mem[p].hh.b0 of 12,13,14:oldp:=tarnished(p);19:oldp:=1; others:oldp:=0 end;if oldp<>0 then begin q:=stashcurexp;oldp:=p; makeexpcopy(oldp);p:=stashcurexp;unstashcurexp(q);end;{:934};{935:} case curtype of 12,13,14:oldexp:=tarnished(curexp);19:oldexp:=1; others:oldexp:=0 end;if oldexp<>0 then begin oldexp:=curexp; makeexpcopy(oldexp);end{:935};case c of 89,90:{937:} if(curtype<13)or(mem[p].hh.b0<13)then badbinary(p,c)else if(curtype>14) and(mem[p].hh.b0>14)then addorsubtract(p,0,c)else if curtype<>mem[p].hh. b0 then badbinary(p,c)else begin q:=mem[p+1].int;r:=mem[curexp+1].int; rr:=r+bignodesize[curtype];while r14)and(mem[p].hh.b0>14)then addorsubtract(p,0,90)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{946:}begin q:=mem[curexp+1].int; while(q<>curexp)and(q<>p)do q:=mem[q+1].int;if q=p then flushcurexp(0); end{:946}else if(curtype<=14)and(curtype>=12)then{947:} begin q:=mem[p+1].int;r:=mem[curexp+1].int;rr:=r+bignodesize[curtype]-2; while true do begin addorsubtract(q,r,90); 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(mem[r].hh.b1+49); end{:947} else if curtype=2 then flushcurexp(curexp-mem[p+1].int)else begin badbinary(p,c);goto 30;end;{945:} if curtype<>16 then begin if curtype<16 then begin disperr(p,284); begin helpptr:=1;helpline[0]:=903;end end else begin helpptr:=2; helpline[1]:=904;helpline[0]:=905;end;disperr(0,906); putgetflusherror(31); end else case c of 97:if curexp<0 then curexp:=30 else curexp:=31; 98:if curexp<=0 then curexp:=30 else curexp:=31; 99:if curexp>0 then curexp:=30 else curexp:=31; 100:if curexp>=0 then curexp:=30 else curexp:=31; 101:if curexp=0 then curexp:=30 else curexp:=31; 102:if curexp<>0 then curexp:=30 else curexp:=31;end;curtype:=2{:945}; 30:aritherror:=false;end;{:944}{948:} 96,95:if(mem[p].hh.b0<>2)or(curtype<>2)then badbinary(p,c)else if mem[p +1].int=c-65 then curexp:=mem[p+1].int;{:948}{949:} 91:if(curtype<13)or(mem[p].hh.b0<13)then badbinary(p,91)else if(curtype= 16)or(mem[p].hh.b0=16)then{950:} begin 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)or( curtype=13)then begin p:=mem[curexp+1].int+bignodesize[curtype]; repeat p:=p-2;depmult(p,v,true);until p=mem[curexp+1].int; end else depmult(0,v,true);goto 10;end{:950} else if(nicecolororpair(p,mem[p].hh.b0)and(curtype>14))or( nicecolororpair(curexp,curtype)and(mem[p].hh.b0>14))then begin hardtimes (p);goto 10;end else badbinary(p,91);{:949}{955:} 92:if(curtype<>16)or(mem[p].hh.b0<13)then badbinary(p,92)else begin v:= curexp;unstashcurexp(p);if v=0 then{957:}begin disperr(0,835); begin helpptr:=2;helpline[1]:=908;helpline[0]:=909;end;putgeterror; end{:957} else begin if curtype=16 then curexp:=makescaled(curexp,v)else if curtype<=14 then begin p:=mem[curexp+1].int+bignodesize[curtype]; repeat p:=p-2;depdiv(p,v);until p=mem[curexp+1].int; end else depdiv(0,v);end;goto 10;end;{:955}{958:} 93,94:if(curtype=16)and(mem[p].hh.b0=16)then if c=93 then curexp:= pythadd(mem[p+1].int,curexp)else curexp:=pythsub(mem[p+1].int,curexp) else badbinary(p,c);{:958}{959:} 104,105,106,107,108,109,110,111:if mem[p].hh.b0=8 then begin begin setupknowntrans(c);unstashcurexp(p);dopathtrans(curexp);end;goto 10; end else if mem[p].hh.b0=6 then begin begin setupknowntrans(c); unstashcurexp(p);dopentrans(curexp);end;curexp:=convexhull(curexp); goto 10; end else if(mem[p].hh.b0=14)or(mem[p].hh.b0=12)then bigtrans(p,c)else if mem[p].hh.b0=10 then begin doedgestrans(p,c);goto 10; end else badbinary(p,c);{:959}{990:} 103:if(curtype=4)and(mem[p].hh.b0=4)then cat(p)else badbinary(p,103); 115:if nicepair(p,mem[p].hh.b0)and(curtype=4)then chopstring(mem[p+1]. int)else badbinary(p,115);116:begin if curtype=14 then pairtopath; if nicepair(p,mem[p].hh.b0)and(curtype=8)then choppath(mem[p+1].int)else badbinary(p,116);end;{:990}{997:} 118,119,120:begin if curtype=14 then pairtopath; if(curtype=8)and(mem[p].hh.b0=16)then findpoint(mem[p+1].int,c)else badbinary(p,c);end; 121:if(curtype=6)and nicepair(p,mem[p].hh.b0)then setupoffset(mem[p+1]. int)else badbinary(p,121);117:begin if curtype=14 then pairtopath; if(curtype=8)and nicepair(p,mem[p].hh.b0)then setupdirectiontime(mem[p+1 ].int)else badbinary(p,117);end;{:997}{1002:} 122:begin if curtype=14 then pairtopath; if(curtype=8)and(mem[p].hh.b0=16)then flushcurexp(getarctime(curexp,mem[ p+1].int))else badbinary(p,c);end;{:1002}{1003:} 113: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=8)and(mem[p].hh.b0=8)then begin pathintersection(mem[p+1].int ,curexp);pairvalue(curt,curtt);end else badbinary(p,113);end;{:1003} {1004:} 112:if(curtype<>4)or(mem[p].hh.b0<>4)then badbinary(p,112)else begin doinfont(p);goto 10;end;{:1004}end;recyclevalue(p);freenode(p,2); 10:begin if aritherror then cleararith;end;{933:} if oldp<>0 then begin recyclevalue(oldp);freenode(oldp,2);end; if oldexp<>0 then begin recyclevalue(oldexp);freenode(oldexp,2); end{:933};end;{:930}{952:}procedure fracmult(n,d:scaled);var p:halfword; oldexp:halfword;v:fraction;begin if internal[6]>131072 then{953:} begin begindiagnostic;printnl(902);printscaled(n);printchar(47); printscaled(d);print(907);printexp(0,0);print(891);enddiagnostic(false); end{:953};case curtype of 12,13,14:oldexp:=tarnished(curexp); 19:oldexp:=1;others:oldexp:=0 end; if oldexp<>0 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+bignodesize[curtype];repeat p:=p-2; depmult(p,v,false);until p=mem[curexp+1].int; end else depmult(0,v,false); if oldexp<>0 then begin recyclevalue(oldexp);freenode(oldexp,2);end end; {:952}{1006:}{1012:}{1023:}procedure tryeq(l,r:halfword);label 30,31; var p:halfword;t:16..19;q:halfword;pp:halfword;tt:17..19;copied:boolean; begin{1024:}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=0 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{:1024}; {1026:} if r=0 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;{1027:} 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<>0 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; {:1027};if copied then flushnodelist(pp);31:{:1026}; if mem[p].hh.lh=0 then{1025:} begin if abs(mem[p+1].int)>64 then begin begin if interaction=3 then; printnl(262);print(945);end;print(947);printscaled(mem[p+1].int); printchar(41);begin helpptr:=2;helpline[1]:=946;helpline[0]:=944;end; putgeterror;end else if r=0 then{577:}begin begin if interaction=3 then; printnl(262);print(611);end;begin helpptr:=2;helpline[1]:=612; helpline[0]:=613;end;putgeterror;end{:577};freenode(p,2);end{:1025} else begin lineareq(p,t); if r=0 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; {:1023}{1018:}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{1020:} 2,4,6,8,10:if curtype=t+1 then begin nonlineareq(v,curexp,false); goto 30;end else if curtype=t then{1021:} begin 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;{577:} begin begin if interaction=3 then;printnl(262);print(611);end; begin helpptr:=2;helpline[1]:=612;helpline[0]:=613;end;putgeterror; end{:577};goto 30;end;begin if interaction=3 then;printnl(262); print(942);end;begin helpptr:=2;helpline[1]:=943;helpline[0]:=944;end; putgeterror;goto 30;45:begin if interaction=3 then;printnl(262); print(945);end;begin helpptr:=2;helpline[1]:=946;helpline[0]:=944;end; putgeterror;goto 30;end{:1021}; 3,5,7,11,9: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=9 then begin pairtopath;goto 20;end; 12,13,14:if curtype=t then{1022:}begin 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{:1022}; 16,17,18,19:if curtype>=16 then begin tryeq(lhs,0);goto 30;end;1:; {:1020}end;{1019:}disperr(lhs,284);disperr(0,939); if mem[lhs].hh.b0<=14 then printtype(mem[lhs].hh.b0)else print(340); printchar(61);if curtype<=14 then printtype(curtype)else print(340); printchar(41);begin helpptr:=2;helpline[1]:=940;helpline[0]:=941;end; putgeterror{:1019};30:begin if aritherror then cleararith;end; recyclevalue(lhs);freenode(lhs,2);end;{:1018}procedure doassignment; forward;procedure doequation;var lhs:halfword;p:halfword; begin lhs:=stashcurexp;getxnext;varflag:=76;scanexpression; if curcmd=53 then doequation else if curcmd=76 then doassignment; if internal[6]>131072 then{1014:}begin begindiagnostic;printnl(902); printexp(lhs,0);print(934);printexp(0,0);print(891); enddiagnostic(false);end{:1014}; if curtype=9 then if mem[lhs].hh.b0=14 then begin p:=stashcurexp; unstashcurexp(lhs);lhs:=p;end;makeeq(lhs);end;{:1012}{1013:} procedure doassignment;var lhs:halfword;p:halfword;q:halfword; begin if curtype<>20 then begin disperr(0,931);begin helpptr:=2; helpline[1]:=932;helpline[0]:=933;end;error;doequation; end else begin lhs:=curexp;curtype:=1;getxnext;varflag:=76; scanexpression; if curcmd=53 then doequation else if curcmd=76 then doassignment; if internal[6]>131072 then{1015:}begin begindiagnostic;printnl(123); if mem[lhs].hh.lh>9771 then print(intname[mem[lhs].hh.lh-(9771)])else showtokenlist(lhs,0,1000,0);print(476);printexp(0,0);printchar(125); enddiagnostic(false);end{:1015};if mem[lhs].hh.lh>9771 then{1016:} if curtype=16 then internal[mem[lhs].hh.lh-(9771)]:=curexp else begin disperr(0,935);print(intname[mem[lhs].hh.lh-(9771)]);print(936); begin helpptr:=2;helpline[1]:=937;helpline[0]:=938;end;putgeterror; end{:1016}else{1017:}begin p:=findvariable(lhs); if p<>0 then begin q:=stashcurexp;curtype:=undtype(p);recyclevalue(p); mem[p].hh.b0:=curtype;mem[p+1].int:=0;makeexpcopy(p);p:=stashcurexp; unstashcurexp(q);makeeq(p);end else begin obliterated(lhs);putgeterror; end;end{:1017};flushnodelist(lhs);end;end;{:1013}{1032:} procedure dotypedeclaration;var t:smallnumber;p:halfword;q:halfword; begin if curmod>=12 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<>0 then begin mem[q].hh.b0:=t;mem[q+1].int:=0; end else begin begin if interaction=3 then;printnl(262);print(948);end; begin helpptr:=2;helpline[1]:=949;helpline[0]:=950;end;putgeterror;end; flushlist(p);if curcmd<81 then{1033:}begin begin if interaction=3 then; printnl(262);print(951);end;begin helpptr:=5;helpline[4]:=952; helpline[3]:=953;helpline[2]:=954;helpline[1]:=955;helpline[0]:=956;end; if curcmd=44 then helpline[2]:=957;putgeterror;scannerstatus:=2; repeat begin getnext;if curcmd<=3 then tnext;end;{715:} if curcmd=41 then begin if strref[curmod]<127 then if strref[curmod]>1 then decr(strref[curmod])else flushstring(curmod);end{:715}; until curcmd>=81;scannerstatus:=0;end{:1033};until curcmd>81;end;{:1032} {1038:}procedure dorandomseed;begin getxnext; if curcmd<>76 then begin missingerr(476);begin helpptr:=1; helpline[0]:=962;end;backerror;end;getxnext;scanexpression; if curtype<>16 then begin disperr(0,963);begin helpptr:=2; helpline[1]:=964;helpline[0]:=965;end;putgetflusherror(0); end else{1039:}begin initrandoms(curexp); if selector>=9 then begin oldsetting:=selector;selector:=9;printnl(966); printscaled(curexp);printchar(125);printnl(284);selector:=oldsetting; end;end{:1039};end;{:1038}{1046:}procedure doprotection;var m:0..1; t:halfword;begin m:=curmod;repeat getsymbol;t:=eqtb[cursym].lh; if m=0 then begin if t>=85 then eqtb[cursym].lh:=t-85; end else if t<85 then eqtb[cursym].lh:=t+85;getxnext;until curcmd<>81; end;{:1046}{1048:}procedure defdelims;var ldelim,rdelim:halfword; begin getclearsymbol;ldelim:=cursym;getclearsymbol;rdelim:=cursym; eqtb[ldelim].lh:=33;eqtb[ldelim].rh:=rdelim;eqtb[rdelim].lh:=64; eqtb[rdelim].rh:=ldelim;getxnext;end;{:1048}{1051:} procedure dostatement;forward;procedure dointerim;begin getxnext; if curcmd<>42 then begin begin if interaction=3 then;printnl(262); print(972);end;if cursym=0 then print(977)else print(hash[cursym].rh); print(978);begin helpptr:=1;helpline[0]:=979;end;backerror; end else begin saveinternal(curmod);backinput;end;dostatement;end; {:1051}{1052:}procedure dolet;var l:halfword;begin getsymbol;l:=cursym; getxnext;if curcmd<>53 then if curcmd<>76 then begin missingerr(61); begin helpptr:=3;helpline[2]:=980;helpline[1]:=713;helpline[0]:=981;end; backerror;end;getsymbol; case curcmd of 13,55,46,51:incr(mem[curmod].hh.lh);others:end; clearsymbol(l,false);eqtb[l].lh:=curcmd; if curcmd=43 then eqtb[l].rh:=0 else eqtb[l].rh:=curmod;getxnext;end; {:1052}{1053:}procedure donewinternal; begin repeat if intptr=maxinternal then overflow(982,maxinternal); getclearsymbol;incr(intptr);eqtb[cursym].lh:=42;eqtb[cursym].rh:=intptr; intname[intptr]:=hash[cursym].rh;internal[intptr]:=0;getxnext; until curcmd<>81;end;{:1053}{1057:}procedure doshow; begin repeat getxnext;scanexpression;printnl(804);printexp(0,2); flushcurexp(0);until curcmd<>81;end;{:1057}{1058:}procedure disptoken; begin printnl(988);if cursym=0 then{1059:} begin if curcmd=44 then printscaled(curmod)else if curcmd=40 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 decr(strref[ curmod])else flushstring(curmod);end;end;end{:1059} else begin print(hash[cursym].rh);printchar(61); if eqtb[cursym].lh>=85 then print(989);printcmdmod(curcmd,curmod); if curcmd=13 then begin println;showmacro(curmod,0,100000);end;end;end; {:1058}{1061:}procedure doshowtoken;begin repeat begin getnext; if curcmd<=3 then tnext;end;disptoken;getxnext;until curcmd<>81;end; {:1061}{1062:}procedure doshowstats;begin printnl(998); ifdef('STAT')printint(varused);printchar(38);printint(dynused); if false then endif('STAT')print(359);print(999); printint(himemmin-lomemmax-1);print(1000);println;printnl(1001); ifdef('STAT')printint(strsinuse-initstruse);printchar(38); printint(poolinuse-initpoolptr);if false then endif('STAT')print(359); print(999);printint(maxstrings-1-strsusedup);printchar(38); printint(poolsize-poolptr);print(1002);println;getxnext;end;{:1062} {1063:}procedure dispvar(p:halfword);var q:halfword;n:0..maxprintline; begin if mem[p].hh.b0=21 then{1064:}begin q:=mem[p+1].hh.lh; repeat dispvar(q);q:=mem[q].hh.rh;until q=9;q:=mem[p+1].hh.rh; while mem[q].hh.b1=3 do begin dispvar(q);q:=mem[q].hh.rh;end;end{:1064} else if mem[p].hh.b0>=22 then{1065:}begin printnl(284); printvariablename(p);if mem[p].hh.b0>22 then print(705);print(1003); if fileoffset>=maxprintline-20 then n:=5 else n:=maxprintline-fileoffset -15;showmacro(mem[p+1].int,0,n);end{:1065} else if mem[p].hh.b0<>0 then begin printnl(284);printvariablename(p); printchar(61);printexp(p,0);end;end;{:1063}{1066:}procedure doshowvar; label 30;begin repeat begin getnext;if curcmd<=3 then tnext;end; if cursym>0 then if cursym<=9771 then if curcmd=43 then if curmod<>0 then begin dispvar(curmod);goto 30;end;disptoken;30:getxnext; until curcmd<>81;end;{:1066}{1067:}procedure doshowdependencies; var p:halfword;begin p:=mem[5].hh.rh; while p<>5 do begin if interesting(p)then begin printnl(284); printvariablename(p); if mem[p].hh.b0=17 then printchar(61)else print(817); printdependency(mem[p+1].hh.rh,mem[p].hh.b0);end;p:=mem[p+1].hh.rh; while mem[p].hh.lh<>0 do p:=mem[p].hh.rh;p:=mem[p].hh.rh;end;getxnext; end;{:1067}{1068:}procedure doshowwhatever;begin if interaction=3 then; case curmod of 0:doshowtoken;1:doshowstats;2:doshow;3:doshowvar; 4:doshowdependencies;end; if internal[25]>0 then begin begin if interaction=3 then;printnl(262); print(1004);end;if interaction<3 then begin helpptr:=0;decr(errorcount); end else begin helpptr:=1;helpline[0]:=1005;end; if curcmd=82 then error else putgeterror;end;end;{:1068}{1071:} procedure scanwithlist(p:halfword);label 30,31,32;var t:smallnumber; q:halfword;cp,pp,dp:halfword;begin cp:=1;pp:=1;dp:=1; while curcmd=68 do begin t:=curmod;getxnext;scanexpression; if curtype<>t then{1072:}begin disperr(0,1012);begin helpptr:=2; helpline[1]:=1013;helpline[0]:=1014;end; if t=10 then helpline[1]:=1015 else if t=13 then helpline[1]:=1016; putgetflusherror(0);end{:1072} else if t=13 then begin if cp=1 then{1074:}begin cp:=p; while cp<>0 do begin if(mem[cp].hh.b0<4)then goto 30;cp:=mem[cp].hh.rh; end;30:;end{:1074};if cp<>0 then{1073:}begin q:=mem[curexp+1].int; mem[cp+2].int:=mem[q+1].int;mem[cp+3].int:=mem[q+3].int; mem[cp+4].int:=mem[q+5].int;if mem[cp+2].int<0 then mem[cp+2].int:=0; if mem[cp+3].int<0 then mem[cp+3].int:=0; if mem[cp+4].int<0 then mem[cp+4].int:=0; if mem[cp+2].int>65536 then mem[cp+2].int:=65536; if mem[cp+3].int>65536 then mem[cp+3].int:=65536; if mem[cp+4].int>65536 then mem[cp+4].int:=65536;end{:1073}; flushcurexp(0);end else if t=6 then begin if pp=1 then{1075:} begin pp:=p;while pp<>0 do begin if(mem[pp].hh.b0<3)then goto 31; pp:=mem[pp].hh.rh;end;31:;end{:1075}; if pp<>0 then begin if mem[pp+1].hh.lh<>0 then tossknotlist(mem[pp+1].hh .lh);mem[pp+1].hh.lh:=curexp;curtype:=1;end; end else begin if dp=1 then{1076:}begin dp:=p; while dp<>0 do begin if mem[dp].hh.b0=2 then goto 32;dp:=mem[dp].hh.rh; end;32:;end{:1076}; if dp<>0 then begin if mem[dp+6].hh.rh<>0 then if mem[mem[dp+6].hh.rh]. hh.lh=0 then tossedges(mem[dp+6].hh.rh)else decr(mem[mem[dp+6].hh.rh].hh .lh);mem[dp+6].hh.rh:=makedashes(curexp);mem[dp+7].int:=65536; curtype:=1;end;end;end;{1077:}if cp>1 then{1078:}begin q:=mem[cp].hh.rh; while q<>0 do begin if(mem[q].hh.b0<4)then begin mem[q+2].int:=mem[cp+2] .int;mem[q+3].int:=mem[cp+3].int;mem[q+4].int:=mem[cp+4].int;end; q:=mem[q].hh.rh;end;end{:1078};if pp>1 then{1079:} begin q:=mem[pp].hh.rh; while q<>0 do begin if(mem[q].hh.b0<3)then begin if mem[q+1].hh.lh<>0 then tossknotlist(mem[q+1].hh.lh); mem[q+1].hh.lh:=makepen(copypath(mem[pp+1].hh.lh),false);end; q:=mem[q].hh.rh;end;end{:1079};if dp>1 then{1080:} begin q:=mem[dp].hh.rh; while q<>0 do begin if mem[q].hh.b0=2 then begin if mem[q+6].hh.rh<>0 then if mem[mem[q+6].hh.rh].hh.lh=0 then tossedges(mem[q+6].hh.rh)else decr(mem[mem[q+6].hh.rh].hh.lh);mem[q+6].hh.rh:=mem[dp+6].hh.rh; mem[q+7].int:=65536; if mem[q+6].hh.rh<>0 then incr(mem[mem[q+6].hh.rh].hh.lh);end; q:=mem[q].hh.rh;end;end{:1080}{:1077};end;{:1071}{1081:} function findedgesvar(t:halfword):halfword;var p:halfword; curedges:halfword;begin p:=findvariable(t);curedges:=0; if p=0 then begin obliterated(t);putgeterror; end else if mem[p].hh.b0<>10 then begin begin if interaction=3 then; printnl(262);print(841);end;showtokenlist(t,0,1000,0);print(1017); printtype(mem[p].hh.b0);printchar(41);begin helpptr:=2; helpline[1]:=1018;helpline[0]:=1019;end;putgeterror; end else begin mem[p+1].int:=privateedges(mem[p+1].int); curedges:=mem[p+1].int;end;flushnodelist(t);findedgesvar:=curedges;end; {:1081}{1086:}function startdrawcmd(sep:quarterword):halfword; var lhv:halfword;addtype:quarterword;begin lhv:=0;getxnext;varflag:=sep; scanprimary;if curtype<>20 then{1087:}begin disperr(0,1022); begin helpptr:=4;helpline[3]:=1023;helpline[2]:=1024;helpline[1]:=1025; helpline[0]:=1019;end;putgetflusherror(0);end{:1087} else begin lhv:=curexp;addtype:=curmod;curtype:=1;getxnext; scanexpression;end;lastaddtype:=addtype;startdrawcmd:=lhv;end;{:1086} {1088:}procedure dobounds;var lhv,lhe:halfword;p:halfword;m:integer; begin m:=curmod;lhv:=startdrawcmd(71); if lhv<>0 then begin lhe:=findedgesvar(lhv); if lhe=0 then flushcurexp(0)else if curtype<>8 then begin disperr(0,1026 );begin helpptr:=2;helpline[1]:=1027;helpline[0]:=1019;end; putgetflusherror(0);end else if mem[curexp].hh.b0=0 then{1089:} begin begin if interaction=3 then;printnl(262);print(1028);end; begin helpptr:=2;helpline[1]:=1029;helpline[0]:=1019;end;putgeterror; end{:1089}else{1090:}begin p:=newboundsnode(curexp,m); mem[p].hh.rh:=mem[lhe+7].hh.rh;mem[lhe+7].hh.rh:=p; if mem[lhe+7].hh.lh=lhe+7 then mem[lhe+7].hh.lh:=p; p:=getnode(grobjectsize[(m+2)]);mem[p].hh.b0:=(m+2); mem[mem[lhe+7].hh.lh].hh.rh:=p;mem[lhe+7].hh.lh:=p;initbbox(lhe); end{:1090};end;end;{:1088}{1091:}procedure doaddto;var lhv,lhe:halfword; p:halfword;e:halfword;addtype:quarterword;begin lhv:=startdrawcmd(69); addtype:=lastaddtype;if lhv<>0 then begin if addtype=2 then{1093:} begin p:=0;e:=0;if curtype<>10 then begin disperr(0,1030); begin helpptr:=2;helpline[1]:=1031;helpline[0]:=1019;end; putgetflusherror(0);end else begin e:=privateedges(curexp);curtype:=1; p:=mem[e+7].hh.rh;end;end{:1093}else{1094:}begin e:=0;p:=0; if curtype=14 then pairtopath;if curtype<>8 then begin disperr(0,1030); begin helpptr:=2;helpline[1]:=1027;helpline[0]:=1019;end; putgetflusherror(0); end else if addtype=1 then if mem[curexp].hh.b0=0 then{1089:} begin begin if interaction=3 then;printnl(262);print(1028);end; begin helpptr:=2;helpline[1]:=1029;helpline[0]:=1019;end;putgeterror; end{:1089}else begin p:=newfillnode(curexp);curtype:=1; end else begin p:=newstrokednode(curexp);curtype:=1;end;end{:1094}; scanwithlist(p);{1095:}lhe:=findedgesvar(lhv); if lhe=0 then begin if(e=0)and(p<>0)then e:=tossgrobject(p); if e<>0 then if mem[e].hh.lh=0 then tossedges(e)else decr(mem[e].hh.lh); end else if addtype=2 then if e<>0 then{1096:} begin if mem[e+7].hh.rh<>0 then begin mem[mem[lhe+7].hh.lh].hh.rh:=mem[e +7].hh.rh;mem[lhe+7].hh.lh:=mem[e+7].hh.lh;mem[e+7].hh.lh:=e+7; mem[e+7].hh.rh:=0;flushdashlist(lhe);end;tossedges(e);end{:1096} else else if p<>0 then begin mem[mem[lhe+7].hh.lh].hh.rh:=p; mem[lhe+7].hh.lh:=p; if addtype=0 then if mem[p+1].hh.lh=0 then mem[p+1].hh.lh:=getpencircle( 0);end{:1095};end;end;{:1091}{1098:}{1129:} function tfmcheck(m:smallnumber):scaled; begin if abs(internal[m])>=134217728 then begin begin if interaction=3 then;printnl(262);print(1048);end;print(intname[m]);print(1049); begin helpptr:=1;helpline[0]:=1050;end;putgeterror; if internal[m]>0 then tfmcheck:=134217727 else tfmcheck:=-134217727; end else tfmcheck:=internal[m];end;{:1129}{1195:} procedure readpsnametable;label 50,30;var k:fontnumber;lmax:integer; j:integer;c:ASCIIcode;s:strnumber;begin namelength:=strlen(pstabname); nameoffile:=xmalloc(1+namelength+1);strcpy(nameoffile+1,pstabname); if aopenin(pstabfile,kpsedvipsconfigformat)then begin{1197:}lmax:=0; for k:=lastpsfnum+1 to lastfnum do if(strstart[nextstr[fontname[k]]]- strstart[fontname[k]])>lmax then lmax:=(strstart[nextstr[fontname[k]]]- strstart[fontname[k]]){:1197};while not eof(pstabfile)do begin{1198:} begin if poolptr+lmax>maxpoolptr then if poolptr+lmax>poolsize then docompaction(lmax)else maxpoolptr:=poolptr+lmax;end;j:=lmax; while true do begin if eoln(pstabfile)then if j=lmax then begin poolptr :=strstart[strptr];goto 50;end else fatalerror(1113);read(pstabfile,c); if((c='%')or(c='*')or(c=';')or(c='#'))then begin poolptr:=strstart[ strptr];goto 50;end;if((c=' ')or(c=9))then goto 30;decr(j); if j>=0 then begin strpool[poolptr]:=xord[c];incr(poolptr); end else begin poolptr:=strstart[strptr];goto 50;end;end; 30:s:=makestring{:1198}; for k:=lastpsfnum+1 to lastfnum do if strvsstr(s,fontname[k])=0 then{ 1199:}begin flushstring(s);j:=32; begin if poolptr+j>maxpoolptr then if poolptr+j>poolsize then docompaction(j)else maxpoolptr:=poolptr+j;end; repeat if eoln(pstabfile)then fatalerror(1113);read(pstabfile,c); until((c<>' ')and(c<>9));repeat decr(j);if j<0 then fatalerror(1113); begin strpool[poolptr]:=xord[c];incr(poolptr);end; if eoln(pstabfile)then c:=' 'else read(pstabfile,c); until((c=' ')or(c=9)); begin if strref[fontpsname[k]]<127 then if strref[fontpsname[k]]>1 then decr(strref[fontpsname[k]])else flushstring(fontpsname[k]);end; fontpsname[k]:=makestring;goto 50;end{:1199};flushstring(s); 50:readln(pstabfile);end;lastpsfnum:=lastfnum;aclose(pstabfile);end;end; {:1195}{1201:}procedure openoutputfile;var c:integer;oldsetting:0..10; s:strnumber;begin if jobname=0 then openlogfile; c:=roundunscaled(internal[17]);if c<0 then s:=1114 else{1202:} begin oldsetting:=selector;selector:=4;printchar(46);printint(c); s:=makestring;selector:=oldsetting;end{:1202};packjobname(s); while not aopenout(psfile)do promptfilename(1115,s); begin if strref[s]<127 then if strref[s]>1 then decr(strref[s])else flushstring(s);end;{1203:} if(c=0)then begin firstoutputcode:= c; begin if strref[firstfilename]<127 then if strref[firstfilename]>1 then decr(strref[firstfilename])else flushstring(firstfilename);end; firstfilename:=amakenamestring(psfile);end; if c>=lastoutputcode then begin lastoutputcode:=c; begin if strref[lastfilename]<127 then if strref[lastfilename]>1 then decr(strref[lastfilename])else flushstring(lastfilename);end; lastfilename:=amakenamestring(psfile);end{:1203};{1206:} if termoffset>maxprintline-6 then println else if(termoffset>0)or( fileoffset>0)then printchar(32);printchar(91); if c>=0 then printint(c){:1206};end;{:1201}{1209:} procedure pspairout(x,y:scaled); begin if psoffset+26>maxprintline then println;printscaled(x); printchar(32);printscaled(y);printchar(32)end;{:1209}{1210:} procedure psprint(s:strnumber); begin if psoffset+(strstart[nextstr[s]]-strstart[s])>maxprintline then println;print(s);end;{:1210}{1211:}procedure pspathout(h:halfword); label 10;var p,q:halfword;d:scaled;curved:boolean; begin if psoffset+40>maxprintline then println; if neednewpath then print(1118);neednewpath:=true; pspairout(mem[h+1].int,mem[h+2].int);print(1119);p:=h; repeat if mem[p].hh.b1=0 then begin if p=h then psprint(1120);goto 10; end;q:=mem[p].hh.rh;{1213:}curved:=true;{1214:} if mem[p+5].int=mem[p+1].int then if mem[p+6].int=mem[p+2].int then if mem[q+3].int=mem[q+1].int then if mem[q+4].int=mem[q+2].int then curved :=false;d:=mem[q+3].int-mem[p+5].int; if abs(mem[p+5].int-mem[p+1].int-d)<=131 then if abs(mem[q+1].int-mem[q +3].int-d)<=131 then begin d:=mem[q+4].int-mem[p+6].int; if abs(mem[p+6].int-mem[p+2].int-d)<=131 then if abs(mem[q+2].int-mem[q +4].int-d)<=131 then curved:=false;end{:1214};println; if curved then begin pspairout(mem[p+5].int,mem[p+6].int); pspairout(mem[q+3].int,mem[q+4].int); pspairout(mem[q+1].int,mem[q+2].int);psprint(1122); end else if q<>h then begin pspairout(mem[q+1].int,mem[q+2].int); psprint(1123);end{:1213};p:=q;until p=h;psprint(1121);10:end;{:1211} {1216:}procedure unknowngraphicsstate(c:scaled);begin gsred:=c; gsgreen:=c;gsblue:=c;gsljoin:=3;gslcap:=3;gsmiterlim:=0;gsdashp:=1; gsdashsc:=0;gswidth:=-1;end;{:1216}{1217:}{1224:} function coordrangeOK(h:halfword;zoff:smallnumber;dz:scaled):boolean; label 40,45,10;var p:halfword;zlo,zhi:scaled;z:scaled; begin zlo:=mem[h+zoff].int;zhi:=zlo;p:=h; while mem[p].hh.b1<>0 do begin z:=mem[p+zoff+4].int;{1225:} if zzhi then zhi:=z; if zhi-zlo>dz then goto 40{:1225};p:=mem[p].hh.rh;z:=mem[p+zoff+2].int; {1225:}if zzhi then zhi:=z; if zhi-zlo>dz then goto 40{:1225};z:=mem[p+zoff].int;{1225:} if zzhi then zhi:=z; if zhi-zlo>dz then goto 40{:1225};if p=h then goto 45;end; 45:coordrangeOK:=true;goto 10;40:coordrangeOK:=false;10:end;{:1224} {1228:}function samedashes(h,hh:halfword):boolean;label 30; var p,pp:halfword; begin if h=hh then samedashes:=true else if(h<=1)or(hh<=1)then samedashes:=false else if mem[h+1].int<>mem[hh+1].int then samedashes:= false else{1229:}begin p:=mem[h].hh.rh;pp:=mem[hh].hh.rh; while(p<>2)and(pp<>2)do if(mem[p+1].int<>mem[pp+1].int)or(mem[p+2].int<> mem[pp+2].int)then goto 30 else begin p:=mem[p].hh.rh;pp:=mem[pp].hh.rh; end;30:samedashes:=p=pp;end{:1229};end;{:1228} procedure fixgraphicsstate(p:halfword);var hh,pp:halfword; wx,wy,ww:scaled;adjwx:boolean;tx,ty:integer;scf:scaled; begin if(mem[p].hh.b0<4)then{1220:} if(gsred<>mem[p+2].int)or(gsgreen<>mem[p+3].int)or(gsblue<>mem[p+4].int) then begin gsred:=mem[p+2].int;gsgreen:=mem[p+3].int; gsblue:=mem[p+4].int; if(gsred=gsgreen)and(gsgreen=gsblue)then begin if psoffset+16> maxprintline then println;printchar(32);printscaled(gsred);print(1127); end else begin if psoffset+36>maxprintline then println;printchar(32); printscaled(gsred);printchar(32);printscaled(gsgreen);printchar(32); printscaled(gsblue);print(1128);end;end;{:1220}; if(mem[p].hh.b0=1)or(mem[p].hh.b0=2)then if mem[p+1].hh.lh<>0 then if( mem[p+1].hh.lh=mem[mem[p+1].hh.lh].hh.rh)then begin{1221:}{1222:} pp:=mem[p+1].hh.lh; if(mem[pp+5].int=mem[pp+1].int)and(mem[pp+4].int=mem[pp+2].int)then begin wx:=abs(mem[pp+3].int-mem[pp+1].int); wy:=abs(mem[pp+6].int-mem[pp+2].int); end else begin wx:=pythadd(mem[pp+3].int-mem[pp+1].int,mem[pp+5].int-mem [pp+1].int); wy:=pythadd(mem[pp+4].int-mem[pp+2].int,mem[pp+6].int-mem[pp+2].int); end{:1222};{1223:}tx:=1;ty:=1; if coordrangeOK(mem[p+1].hh.rh,2,wy)then tx:=10 else if coordrangeOK(mem [p+1].hh.rh,1,wx)then ty:=10;if wy div ty>=wx div tx then begin ww:=wy; adjwx:=false;end else begin ww:=wx;adjwx:=true;end{:1223}; if(ww<>gswidth)or(adjwx<>gsadjwx)then begin if adjwx then begin if psoffset+13>maxprintline then println;printchar(32);printscaled(ww); psprint(1129);end else begin if psoffset+15>maxprintline then println; print(1130);printscaled(ww);psprint(1131);end;gswidth:=ww; gsadjwx:=adjwx;end{:1221};{1226:} if mem[p].hh.b0=1 then hh:=0 else begin hh:=mem[p+6].hh.rh; scf:=getpenscale(mem[p+1].hh.lh); if scf=0 then if gswidth=0 then scf:=mem[p+7].int else hh:=0 else begin scf:=makescaled(gswidth,scf);scf:=takescaled(scf,mem[p+7].int);end;end; if hh=0 then begin if gsdashp<>0 then begin psprint(1132);gsdashp:=0; end;end else if(gsdashsc<>scf)or not samedashes(gsdashp,hh)then{1227:} begin gsdashp:=hh;gsdashsc:=scf; if(mem[hh+1].int=0)or(abs(mem[hh+1].int)div 65536>=2147483647 div scf) then psprint(1132)else begin pp:=mem[hh].hh.rh; mem[3].int:=mem[pp+1].int+mem[hh+1].int; if psoffset+28>maxprintline then println;print(1133); while pp<>2 do begin pspairout(takescaled(mem[pp+2].int-mem[pp+1].int, scf),takescaled(mem[mem[pp].hh.rh+1].int-mem[pp+2].int,scf)); pp:=mem[pp].hh.rh;end;if psoffset+22>maxprintline then println; print(1134);printscaled(takescaled(dashoffset(hh),scf));print(1135);end; end{:1227}{:1226};{1218:} if mem[p].hh.b0=2 then if(mem[mem[p+1].hh.rh].hh.b0=0)or(mem[p+6].hh.rh <>0)then if gslcap<>mem[p+6].hh.b0 then begin if psoffset+13> maxprintline then println;printchar(32);printchar(48+mem[p+6].hh.b0); print(1124);gslcap:=mem[p+6].hh.b0;end{:1218};{1219:} if gsljoin<>mem[p].hh.b1 then begin if psoffset+14>maxprintline then println;printchar(32);printchar(48+mem[p].hh.b1);print(1125); gsljoin:=mem[p].hh.b1;end; if gsmiterlim<>mem[p+5].int then begin if psoffset+27>maxprintline then println;printchar(32);printscaled(mem[p+5].int);print(1126); gsmiterlim:=mem[p+5].int;end{:1219};end;if psoffset>0 then println;end; {:1217}{1230:}procedure strokeellipse(h:halfword;fillalso:boolean); var txx,txy,tyx,tyy:scaled;p:halfword;d1,det:scaled;s:integer; transformed:boolean;begin transformed:=false;{1231:}p:=mem[h+1].hh.lh; txx:=mem[p+3].int;tyx:=mem[p+4].int;txy:=mem[p+5].int;tyy:=mem[p+6].int; if(mem[p+1].int<>0)or(mem[p+2].int<>0)then begin printnl(1139); pspairout(mem[p+1].int,mem[p+2].int);psprint(1140); txx:=txx-mem[p+1].int;tyx:=tyx-mem[p+2].int;txy:=txy-mem[p+1].int; tyy:=tyy-mem[p+2].int;transformed:=true;end else printnl(284);{1232:} if gswidth<>65536 then if gswidth=0 then begin txx:=65536;tyy:=65536; end else begin txx:=makescaled(txx,gswidth); txy:=makescaled(txy,gswidth);tyx:=makescaled(tyx,gswidth); tyy:=makescaled(tyy,gswidth);end; if(txy<>0)or(tyx<>0)or(txx<>65536)or(tyy<>65536)then if(not transformed) then begin psprint(1139);transformed:=true;end{:1232}{:1231};{1234:} det:=takescaled(txx,tyy)-takescaled(txy,tyx);d1:=4*10+1; if abs(det)=0 then begin d1:=d1-det;s:=1; end else begin d1:=-d1-det;s:=-1;end;d1:=d1*65536; if abs(txx)+abs(tyy)>=abs(txy)+abs(tyy)then if abs(txx)>abs(tyy)then tyy :=tyy+(d1+s*abs(txx))div txx else txx:=txx+(d1+s*abs(tyy))div tyy else if abs(txy)>abs(tyx)then tyx:=tyx+(d1+s*abs(txy))div txy else txy:=txy+( d1+s*abs(tyx))div tyx;end{:1234};pspathout(mem[h+1].hh.rh); if fillalso then printnl(1136);{1233:} if(txy<>0)or(tyx<>0)then begin println;printchar(91);pspairout(txx,tyx); pspairout(txy,tyy);psprint(1141); end else if(txx<>65536)or(tyy<>65536)then begin println; pspairout(txx,tyy);print(1142);end{:1233};psprint(1137); if transformed then psprint(1138);println;end;{:1230}{1235:} procedure psfillout(p:halfword);begin pspathout(p);psprint(1143); println;end;{:1235}{1236:}procedure doouterenvelope(p,h:halfword); begin p:=makeenvelope(p,mem[h+1].hh.lh,mem[h].hh.b1,0,mem[h+5].int); psfillout(p);tossknotlist(p);end;{:1236}{1237:} function choosescale(p:halfword):scaled;var a,b,c,d,ad,bc:scaled; begin a:=mem[p+10].int;b:=mem[p+11].int;c:=mem[p+12].int; d:=mem[p+13].int;if(a<0)then a:=-a;if(b<0)then b:=-b;if(c<0)then c:=-c; if(d<0)then d:=-d;ad:=half(a-d);bc:=half(b-c); choosescale:=pythadd(pythadd(d+ad,ad),pythadd(c+bc,bc));end;{:1237} {1238:}procedure psstringout(s:strnumber);var i:poolpointer;k:ASCIIcode; begin print(40);i:=strstart[s]; while imaxprintline then begin printchar(92);println;end;k:=strpool[i];if({64:} (k<32)or(k>126){:64})then begin printchar(92);printchar(48+(k div 64)); printchar(48+((k div 8)mod 8));printchar(48+(k mod 8)); end else begin if(k=40)or(k=41)or(k=92)then printchar(92);printchar(k); end;incr(i);end;print(41);end;{:1238}{1239:} function ispsname(s:strnumber):boolean;label 45,10;var i:poolpointer; k:ASCIIcode;begin i:=strstart[s]; while i126)then goto 45; if(k=40)or(k=41)or(k=60)or(k=62)or(k=123)or(k=125)or(k=47)or(k=37)then goto 45;incr(i);end;ispsname:=true;goto 10;45:ispsname:=false;10:end; {:1239}{1240:}procedure psnameout(s:strnumber;lit:boolean); begin if psoffset+(strstart[nextstr[s]]-strstart[s])+2>maxprintline then println;printchar(32); if ispsname(s)then begin if lit then printchar(47);print(s); end else begin psstringout(s);if not lit then psprint(1144); psprint(1145);end;end;{:1240}{1242:}procedure unmarkfont(f:fontnumber); var k:0..fontmemsize; begin for k:=charbase[f]+fontbc[f]to charbase[f]+fontec[f]do fontinfo[k] .qqqq.b3:=0;end;{:1242}{1243:}procedure markstringchars(f:fontnumber; s:strnumber);var b:integer;bc,ec:poolASCIIcode;k:poolpointer; begin b:=charbase[f];bc:=fontbc[f];ec:=fontec[f]; k:=strstart[nextstr[s]];while k>strstart[s]do begin decr(k); if(strpool[k]>=bc)and(strpool[k]<=ec)then fontinfo[b+strpool[k]].qqqq.b3 :=1;end end;{:1243}{1244:}procedure hexdigitout(d:smallnumber); begin if d<10 then printchar(d+48)else printchar(d+87);end;{:1244} {1245:}function psmarksout(f:fontnumber;c:eightbits):halfword; var bc,ec:eightbits;lim:integer;p:0..fontmemsize;d,b:0..15; begin lim:=4*(emergencylinelength-psoffset-4);bc:=fontbc[f]; ec:=fontec[f];if c>bc then bc:=c;{1246:}p:=charbase[f]+bc; while(fontinfo[p].qqqq.b3=0)and(bc=bc+lim then ec:=bc+lim-1;p:=charbase[f]+ec; while(fontinfo[p].qqqq.b3=0)and(bc0 then d:=d+b; b:=halfp(b);end;hexdigitout(d){:1248}; while(ec0 do begin if abs(s-mem[q+1].int)<=65 then goto 40 else begin p :=q;q:=mem[q].hh.rh;incr(i);end;if i=255 then overflow(1146,255);end; q:=getnode(2);mem[q+1].int:=s; if i=0 then fontsizes[f]:=q else mem[p].hh.rh:=q;40:sizeindex:=i;end; {:1251}{1252:}function indexedsize(f:fontnumber;j:quarterword):scaled; var p:halfword;i:quarterword;begin p:=fontsizes[f];i:=0; if p=0 then confusion(1147);while(i<>j)do begin incr(i);p:=mem[p].hh.rh; if p=0 then confusion(1147);end;indexedsize:=mem[p+1].int;end;{:1252} {1253:}procedure clearsizes;var f:fontnumber;p:halfword; begin for f:=1 to lastfnum do while fontsizes[f]<>0 do begin p:= fontsizes[f];fontsizes[f]:=mem[p].hh.rh;freenode(p,2);end;end;{:1253} {1260:}procedure shipout(h:halfword);label 30,40;var p:halfword; q:halfword;t:integer;f,ff:fontnumber;ldf:fontnumber;donefonts:boolean; nextsize:quarterword;curfsize:array[fontnumber]of halfword; ds,scf:scaled;transformed:boolean;begin openoutputfile; if(internal[32]>0)and(lastpsfnum0 then print(1157);printnl(1158);setbbox(h,true); if mem[h+2].int>mem[h+4].int then print(1159)else if internal[32]<0 then begin pspairout(mem[h+2].int,mem[h+3].int); pspairout(mem[h+4].int,mem[h+5].int); end else begin pspairout(floorscaled(mem[h+2].int),floorscaled(mem[h+3]. int)); pspairout(-floorscaled(-mem[h+4].int),-floorscaled(-mem[h+5].int));end; printnl(1160);printnl(1161);printint(roundunscaled(internal[13])); printchar(46);printdd(roundunscaled(internal[14]));printchar(46); printdd(roundunscaled(internal[15]));printchar(58); t:=roundunscaled(internal[16]);printdd(t div 60);printdd(t mod 60); printnl(1162);{1262:}{1265:}for f:=1 to lastfnum do fontsizes[f]:=0; p:=mem[h+7].hh.rh; while p<>0 do begin if mem[p].hh.b0=3 then if mem[p+1].hh.lh<>0 then begin f:=mem[p+1].hh.lh; if internal[32]>0 then fontsizes[f]:=1 else begin if fontsizes[f]=0 then unmarkfont(f);mem[p].hh.b1:=sizeindex(f,choosescale(p)); if mem[p].hh.b1=0 then markstringchars(f,mem[p+1].hh.rh);end;end; p:=mem[p].hh.rh;end{:1265};if internal[32]>0 then{1264:}begin ldf:=0; for f:=1 to lastfnum do if fontsizes[f]<>0 then begin if ldf=0 then printnl(1163); for ff:=ldf downto 0 do if fontsizes[ff]<>0 then if strvsstr(fontpsname[ f],fontpsname[ff])=0 then goto 40; if psoffset+1+(strstart[nextstr[fontpsname[f]]]-strstart[fontpsname[f]]) >maxprintline then printnl(1164);printchar(32);print(fontpsname[f]); ldf:=f;40:end;end{:1264}else begin nextsize:=0;{1263:} for f:=1 to lastfnum do curfsize[f]:=fontsizes[f]{:1263}; repeat donefonts:=true; for f:=1 to lastfnum do begin if curfsize[f]<>0 then{1266:}begin t:=0; while checkpsmarks(f,t)do begin printnl(1165); if psoffset+(strstart[nextstr[fontname[f]]]-strstart[fontname[f]])+12> emergencylinelength then goto 30;print(fontname[f]);printchar(32); ds:=(fontdsize[f]+8)div 16; printscaled(takescaled(ds,mem[curfsize[f]+1].int)); if psoffset+12>emergencylinelength then goto 30;printchar(32); printscaled(ds);if psoffset+5>emergencylinelength then goto 30; t:=psmarksout(f,t);end;30:curfsize[f]:=mem[curfsize[f]].hh.rh;end{:1266} ;if curfsize[f]<>0 then begin unmarkfont(f);donefonts:=false;end;end; if not donefonts then{1267:}begin incr(nextsize);p:=mem[h+7].hh.rh; while p<>0 do begin if mem[p].hh.b0=3 then if mem[p+1].hh.lh<>0 then if mem[p].hh.b1=nextsize then markstringchars(mem[p+1].hh.lh,mem[p+1].hh.rh );p:=mem[p].hh.rh;end;end{:1267};until donefonts;end{:1262}; println{:1261};if internal[32]>0 then{1268:} begin if ldf<>0 then begin for f:=1 to lastfnum do if fontsizes[f]<>0 then begin psnameout(fontname[f],true);psnameout(fontpsname[f],true); psprint(1166);println;end;print(1167);println;end;end{:1268}; print(1151);printnl(1152);println;{1259:}t:=mem[memtop-3].hh.rh; while t<>0 do begin if(strstart[nextstr[mem[t+1].int]]-strstart[mem[t+1] .int])<=emergencylinelength then print(mem[t+1].int)else overflow(1150, emergencylinelength);println;t:=mem[t].hh.rh;end; flushtokenlist(mem[memtop-3].hh.rh);mem[memtop-3].hh.rh:=0; lastpending:=memtop-3{:1259};unknowngraphicsstate(0);neednewpath:=true; p:=mem[h+7].hh.rh;while p<>0 do begin fixgraphicsstate(p); case mem[p].hh.b0 of{1269:}4:begin printnl(1139); pspathout(mem[p+1].hh.rh);psprint(1168);println;end; 6:begin printnl(1169);println;unknowngraphicsstate(-1);end;{:1269} {1270:} 1:if mem[p+1].hh.lh=0 then psfillout(mem[p+1].hh.rh)else if(mem[p+1].hh. lh=mem[mem[p+1].hh.lh].hh.rh)then strokeellipse(p,true)else begin doouterenvelope(copypath(mem[p+1].hh.rh),p); doouterenvelope(htapypoc(mem[p+1].hh.rh),p);end; 2:if(mem[p+1].hh.lh=mem[mem[p+1].hh.lh].hh.rh)then strokeellipse(p,false )else begin q:=copypath(mem[p+1].hh.rh);t:=mem[p+6].hh.b0;{1271:} if mem[q].hh.b0<>0 then begin mem[insertknot(q,mem[q+1].int,mem[q+2].int )].hh.b0:=0;mem[q].hh.b1:=0;q:=mem[q].hh.rh;t:=1;end{:1271}; q:=makeenvelope(q,mem[p+1].hh.lh,mem[p].hh.b1,t,mem[p+5].int); psfillout(q);tossknotlist(q);end;{:1270}{1272:} 3:if(mem[p+1].hh.lh<>0)and((strstart[nextstr[mem[p+1].hh.rh]]-strstart[ mem[p+1].hh.rh])>0)then begin if internal[32]>0 then scf:=choosescale(p) else scf:=indexedsize(mem[p+1].hh.lh,mem[p].hh.b1);{1274:} transformed:=(mem[p+10].int<>scf)or(mem[p+13].int<>scf)or(mem[p+11].int <>0)or(mem[p+12].int<>0);if transformed then begin print(1171); pspairout(makescaled(mem[p+10].int,scf),makescaled(mem[p+12].int,scf)); pspairout(makescaled(mem[p+11].int,scf),makescaled(mem[p+13].int,scf)); pspairout(mem[p+8].int,mem[p+9].int);psprint(1172); end else begin pspairout(mem[p+8].int,mem[p+9].int);psprint(1119);end; println{:1274};psstringout(mem[p+1].hh.rh); psnameout(fontname[mem[p+1].hh.lh],false);{1273:} if psoffset+18>maxprintline then println;printchar(32); ds:=(fontdsize[mem[p+1].hh.lh]+8)div 16;printscaled(takescaled(ds,scf)); print(1170);if transformed then psprint(1138){:1273};println;end;{:1272} 5,7:;end;p:=mem[p].hh.rh;end;print(1153);println;print(1154);println; aclose(psfile);selector:=nonpssetting; if internal[32]<=0 then clearsizes;{1207:}printchar(93);fflush(stdout); incr(totalshipped){:1207};if internal[9]>0 then printedges(h,1155,true); end;{:1260}procedure doshipout;var c:integer;begin getxnext; scanexpression;if curtype<>10 then{1099:}begin disperr(0,1032); begin helpptr:=1;helpline[0]:=1033;end;putgetflusherror(0);end{:1099} else begin c:=roundunscaled(internal[17])mod 256;if c<0 then c:=c+256; {1130:}if cec then ec:=c;charexists[c]:=true; tfmwidth[c]:=tfmcheck(19);tfmheight[c]:=tfmcheck(20); tfmdepth[c]:=tfmcheck(21);tfmitalcorr[c]:=tfmcheck(22){:1130}; shipout(curexp);flushcurexp(0);end;end;{:1098}{1106:}{1107:} procedure nostringerr(s:strnumber);begin disperr(0,740); begin helpptr:=1;helpline[0]:=s;end;putgeterror;end;{:1107} procedure domessage;var m:0..2;begin m:=curmod;getxnext;scanexpression; if curtype<>4 then nostringerr(1037)else case m of 0:begin printnl(284); print(curexp);end;1:{1111:}begin begin if interaction=3 then; printnl(262);print(284);end;print(curexp); if errhelp<>0 then useerrhelp:=true else if longhelpseen then begin helpptr:=1;helpline[0]:=1038; end else begin if interaction<3 then longhelpseen:=true; begin helpptr:=4;helpline[3]:=1039;helpline[2]:=1040;helpline[1]:=1041; helpline[0]:=1042;end;end;putgeterror;useerrhelp:=false;end{:1111}; 2:{1108:} begin if errhelp<>0 then begin if strref[errhelp]<127 then if strref[ errhelp]>1 then decr(strref[errhelp])else flushstring(errhelp);end; if(strstart[nextstr[curexp]]-strstart[curexp])=0 then errhelp:=0 else begin errhelp:=curexp; begin if strref[errhelp]<127 then incr(strref[errhelp]);end;end; end{:1108};end;flushcurexp(0);end;{:1106}{1113:}procedure dowrite; label 22;var t:strnumber;n,n0:writeindex;oldsetting:0..10; begin getxnext;scanexpression; if curtype<>4 then nostringerr(1043)else if curcmd<>71 then begin begin if interaction=3 then;printnl(262);print(1044);end;begin helpptr:=1; helpline[0]:=1045;end;putgeterror;end else begin t:=curexp;curtype:=1; getxnext;scanexpression;if curtype<>4 then nostringerr(1046)else{1114:} begin{1115:}n:=writefiles;n0:=writefiles;repeat 22:if n=0 then{1116:} begin if n0=writefiles then if writefiles<4 then incr(writefiles)else overflow(1047,4);n:=n0;openwritefile(curexp,n);end{:1116} else begin decr(n);if wrfname[n]=0 then begin n0:=n;goto 22;end;end; until strvsstr(curexp,wrfname[n])=0{:1115};{929:} if eofline=0 then begin begin strpool[poolptr]:=0;incr(poolptr);end; eofline:=makestring;strref[eofline]:=127;end{:929}; if strvsstr(t,eofline)=0 then{1117:}begin aclose(wrfile[n]); begin if strref[wrfname[n]]<127 then if strref[wrfname[n]]>1 then decr( strref[wrfname[n]])else flushstring(wrfname[n]);end;wrfname[n]:=0; if n=writefiles-1 then writefiles:=n;end{:1117} else begin oldsetting:=selector;selector:=n;print(t);println; selector:=oldsetting;end;end{:1114}; begin if strref[t]<127 then if strref[t]>1 then decr(strref[t])else flushstring(t);end;end;flushcurexp(0);end;{:1113}{1134:} 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[nextstr[curexp]]-strstart[curexp] )=1 then begin c:=strpool[strstart[curexp]];goto 40;end;disperr(0,1056); begin helpptr:=2;helpline[1]:=1057;helpline[0]:=1058;end; putgetflusherror(0);c:=0;40:getcode:=c;end;{:1134}{1135:} procedure settag(c:halfword;t:smallnumber;r:halfword); begin if chartag[c]=0 then begin chartag[c]:=t;charremainder[c]:=r; if t=1 then begin incr(labelptr);labelloc[labelptr]:=r; labelchar[labelptr]:=c;end;end else{1136:} begin begin if interaction=3 then;printnl(262);print(1059);end; if(c>32)and(c<127)then print(c)else if c=256 then print(1060)else begin print(1061);printint(c);end;print(1062);case chartag[c]of 1:print(1063); 2:print(1064);3:print(1053);end;begin helpptr:=2;helpline[1]:=1065; helpline[0]:=1019;end;putgeterror;end{:1136};end;{:1135}{1137:} procedure dotfmcommand;label 22,30;var c,cc:0..256;k:0..maxkerns; j:integer;begin case curmod of 0:begin c:=getcode; while curcmd=80 do begin cc:=getcode;settag(c,2,cc);c:=cc;end;end; 1:{1138:}begin lkstarted:=false;22:getxnext; if(curcmd=77)and lkstarted then{1141:}begin c:=getcode; if nl-skiptable[c]>128 then begin begin begin if interaction=3 then; printnl(262);print(1082);end;begin helpptr:=1;helpline[0]:=1083;end; error;ll:=skiptable[c];repeat lll:=ligkern[ll].b0;ligkern[ll].b0:=128; ll:=ll-lll;until lll=0;end;skiptable[c]:=ligtablesize;end; if skiptable[c]=ligtablesize then ligkern[nl-1].b0:=0 else ligkern[nl-1] .b0:=nl-skiptable[c]-1;skiptable[c]:=nl-1;goto 30;end{:1141}; if curcmd=78 then begin c:=256;curcmd:=80;end else begin backinput; c:=getcode;end;if(curcmd=80)or(curcmd=79)then{1142:} begin if curcmd=80 then if c=256 then bchlabel:=nl else settag(c,1,nl) else if skiptable[c]128 then begin begin begin if interaction=3 then;printnl(262); print(1082);end;begin helpptr:=1;helpline[0]:=1083;end;error;ll:=ll; repeat lll:=ligkern[ll].b0;ligkern[ll].b0:=128;ll:=ll-lll;until lll=0; end;goto 22;end;ligkern[ll].b0:=nl-ll-1;ll:=ll-lll;until lll=0;end; goto 22;end{:1142};if curcmd=75 then{1143:}begin ligkern[nl].b1:=c; ligkern[nl].b0:=0;if curmod<128 then begin ligkern[nl].b2:=curmod; ligkern[nl].b3:=getcode;end else begin getxnext;scanexpression; if curtype<>16 then begin disperr(0,1084);begin helpptr:=2; helpline[1]:=1085;helpline[0]:=308;end;putgetflusherror(0);end; kern[nk]:=curexp;k:=0;while kern[k]<>curexp do incr(k); if k=nk then begin if nk=maxkerns then overflow(1081,maxkerns);incr(nk); end;ligkern[nl].b2:=128+(k div 256);ligkern[nl].b3:=(k mod 256);end; lkstarted:=true;end{:1143}else begin begin if interaction=3 then; printnl(262);print(1070);end;begin helpptr:=1;helpline[0]:=1071;end; backerror;ligkern[nl].b1:=0;ligkern[nl].b2:=0;ligkern[nl].b3:=0; ligkern[nl].b0:=129;end; if nl=ligtablesize then overflow(1072,ligtablesize);incr(nl); if curcmd=81 then goto 22; if ligkern[nl-1].b0<128 then ligkern[nl-1].b0:=128;30:end{:1138}; 2:{1144:}begin if ne=256 then overflow(1053,256);c:=getcode; settag(c,3,ne);if curcmd<>80 then begin missingerr(58);begin helpptr:=1; helpline[0]:=1086;end;backerror;end;exten[ne].b0:=getcode; if curcmd<>81 then begin missingerr(44);begin helpptr:=1; helpline[0]:=1086;end;backerror;end;exten[ne].b1:=getcode; if curcmd<>81 then begin missingerr(44);begin helpptr:=1; helpline[0]:=1086;end;backerror;end;exten[ne].b2:=getcode; if curcmd<>81 then begin missingerr(44);begin helpptr:=1; helpline[0]:=1086;end;backerror;end;exten[ne].b3:=getcode;incr(ne); end{:1144};3,4:begin c:=curmod;getxnext;scanexpression; if(curtype<>16)or(curexp<32768)then begin disperr(0,1066); begin helpptr:=2;helpline[1]:=1067;helpline[0]:=1068;end;putgeterror; end else begin j:=roundunscaled(curexp); if curcmd<>80 then begin missingerr(58);begin helpptr:=1; helpline[0]:=1069;end;backerror;end;if c=3 then{1145:} repeat if j>headersize then overflow(1054,headersize); headerbyte[j]:=getcode;incr(j);until curcmd<>81{:1145}else{1146:} repeat if j>maxfontdimen then overflow(1055,maxfontdimen); while j>np do begin incr(np);param[np]:=0;end;getxnext;scanexpression; if curtype<>16 then begin disperr(0,1087);begin helpptr:=1; helpline[0]:=308;end;putgetflusherror(0);end;param[j]:=curexp;incr(j); until curcmd<>81{:1146};end;end;end;end;{:1137}{1257:} procedure dospecial;begin getxnext;scanexpression; if curtype<>4 then{1258:}begin disperr(0,1148);begin helpptr:=1; helpline[0]:=1149;end;putgeterror;end{:1258} else begin mem[lastpending].hh.rh:=stashcurexp; lastpending:=mem[lastpending].hh.rh;mem[lastpending].hh.rh:=0;end;end; {:1257}{1280:}ifdef('INIMP')procedure storememfile;label 30; var k:integer;p,q:halfword;x:integer;w:fourquarters;s:strnumber; begin{1294:}selector:=4;print(1178);print(jobname);printchar(32); printint(roundunscaled(internal[13]));printchar(46); printint(roundunscaled(internal[14]));printchar(46); printint(roundunscaled(internal[15]));printchar(41); if interaction=0 then selector:=9 else selector:=10; begin if poolptr+1>maxpoolptr then if poolptr+1>poolsize then docompaction(1)else maxpoolptr:=poolptr+1;end;memident:=makestring; strref[memident]:=127;packjobname(784); while not wopenout(memfile)do promptfilename(1179,784);printnl(1180); s:=wmakenamestring(memfile);print(s);flushstring(s); printnl(memident){:1294};{1284:}dumpint(136687108);dumpint(0); dumpint(memtop);dumpint(9500);dumpint(7919);dumpint(15){:1284};{1286:} docompaction(poolsize);dumpint(poolptr);dumpint(maxstrptr); dumpint(strptr);k:=0;while(nextstr[k]=k+1)and(k<=maxstrptr)do incr(k); dumpint(k);while k<=maxstrptr do begin dumpint(nextstr[k]);incr(k);end; k:=0;while true do begin dumpint(strstart[k]); if k=strptr then goto 30 else k:=nextstr[k];end;30:k:=0; while k+40 do begin decr(dynused);p:=mem[p].hh.rh;end; dumpint(varused);dumpint(dynused);println;printint(x);print(1176); printint(varused);printchar(38);printint(dynused){:1288};{1290:} dumpint(hashused);stcount:=9756-hashused; for p:=1 to hashused do if hash[p].rh<>0 then begin dumpint(p); dumphh(hash[p]);dumphh(eqtb[p]);incr(stcount);end; for p:=hashused+1 to 9771 do begin dumphh(hash[p]);dumphh(eqtb[p]);end; dumpint(stcount);println;printint(stcount);print(1177){:1290};{1292:} dumpint(intptr);for k:=1 to intptr do begin dumpint(internal[k]); dumpint(intname[k]);end;dumpint(startsym);dumpint(interaction); dumpint(memident);dumpint(bgloc);dumpint(egloc);dumpint(serialno); dumpint(69073);internal[10]:=0{:1292};{1295:}wclose(memfile){:1295};end; endif('INIMP'){:1280}procedure dostatement;begin curtype:=1;getxnext; if curcmd>45 then{1007:} begin if curcmd<82 then begin begin if interaction=3 then;printnl(262); print(917);end;printcmdmod(curcmd,curmod);printchar(39); begin helpptr:=5;helpline[4]:=918;helpline[3]:=919;helpline[2]:=920; helpline[1]:=921;helpline[0]:=922;end;backerror;getxnext;end;end{:1007} else if curcmd>32 then{1010:}begin varflag:=76;scanexpression; if curcmd<83 then begin if curcmd=53 then doequation else if curcmd=76 then doassignment else if curtype=4 then{1011:} begin if internal[1]>0 then begin printnl(284);print(curexp); fflush(stdout);end;end{:1011} else if curtype<>1 then begin disperr(0,927);begin helpptr:=3; helpline[2]:=928;helpline[1]:=929;helpline[0]:=930;end;putgeterror;end; flushcurexp(0);curtype:=1;end;end{:1010}else{1009:} begin if internal[6]>0 then showcmdmod(curcmd,curmod); case curcmd of 32:dotypedeclaration; 18:if curmod>2 then makeopdef else if curmod>0 then scandef;{1037:} 26:dorandomseed;{:1037}{1040:}25:begin println;interaction:=curmod; if interaction=0 then kpsemaketexdiscarderrors:=1 else kpsemaketexdiscarderrors:=0;{85:} if interaction=0 then selector:=7 else selector:=8{:85}; if logopened then selector:=selector+2;getxnext;end;{:1040}{1043:} 23:doprotection;{:1043}{1047:}29:defdelims;{:1047}{1050:} 14:repeat getsymbol;savevariable(cursym);getxnext;until curcmd<>81; 15:dointerim;16:dolet;17:donewinternal;{:1050}{1056:}24:doshowwhatever; {:1056}{1082:}20:doaddto;21:dobounds;{:1082}{1097:}19:doshipout;{:1097} {1100:}28:begin getsymbol;startsym:=cursym;getxnext;end;{:1100}{1105:} 27:domessage;{:1105}{1112:}31:dowrite;{:1112}{1131:}22:dotfmcommand; {:1131}{1256:}30:dospecial;{:1256}end;curtype:=1;end{:1009}; if curcmd<82 then{1008:}begin begin if interaction=3 then;printnl(262); print(923);end;begin helpptr:=6;helpline[5]:=924;helpline[4]:=925; helpline[3]:=926;helpline[2]:=920;helpline[1]:=921;helpline[0]:=922;end; backerror;scannerstatus:=2;repeat begin getnext;if curcmd<=3 then tnext; end;{715:} if curcmd=41 then begin if strref[curmod]<127 then if strref[curmod]>1 then decr(strref[curmod])else flushstring(curmod);end{:715}; until curcmd>81;scannerstatus:=0;end{:1008};errorcount:=0;end;{:1006} {1034:}procedure maincontrol;begin repeat dostatement; if curcmd=83 then begin begin if interaction=3 then;printnl(262); print(958);end;begin helpptr:=2;helpline[1]:=959;helpline[0]:=730;end; flusherror(0);end;until curcmd=84;end;{:1034}{1148:} function sortin(v:scaled):halfword;label 40;var p,q,r:halfword; begin p:=memtop-1;while true do begin q:=mem[p].hh.rh; if v<=mem[q+1].int then goto 40;p:=q;end; 40:if v11 do begin incr(m);l:=mem[p+1].int;repeat p:=mem[p].hh.rh; until mem[p+1].int>l+d; if mem[p+1].int-lm do d:=perturbation; computethreshold:=d;end;end;{:1151}{1152:} function skimp(m:integer):integer;var d:scaled;p,q,r:halfword;l:scaled; v:scaled;begin d:=computethreshold(m);perturbation:=0;q:=memtop-1;m:=0; p:=mem[memtop-1].hh.rh;while p<>11 do begin incr(m);l:=mem[p+1].int; mem[p].hh.lh:=m;if mem[mem[p].hh.rh+1].int<=l+d then{1153:} begin repeat p:=mem[p].hh.rh;mem[p].hh.lh:=m;decr(excess); if excess=0 then d:=0;until mem[mem[p].hh.rh+1].int>l+d; v:=l+halfp(mem[p+1].int-l); 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{:1153};q:=p;p:=mem[p].hh.rh;end;skimp:=m;end;{:1152}{1154:} procedure tfmwarning(m:smallnumber);begin printnl(1088); print(intname[m]);print(1089);printscaled(perturbation);print(1090);end; {:1154}{1159:}procedure fixdesignsize;var d:scaled; begin d:=internal[23]; if(d<65536)or(d>=134217728)then begin if d<>0 then printnl(1091); d:=8388608;internal[23]:=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[23]-internal[23]div 2097152; if maxtfmdimen>=134217728 then maxtfmdimen:=134217727;end;{:1159}{1160:} function dimenout(x:scaled):integer; begin if abs(x)>maxtfmdimen then begin incr(tfmchanged); if x>0 then x:=16777215 else x:=-16777215; end else x:=makescaled(x*16,internal[23]);dimenout:=x;end;{:1160}{1162:} 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{1163:}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{:1163};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;{:1162} {1164:}procedure tfmqqqq(x:fourquarters);begin putbyte(x.b0,tfmfile); putbyte(x.b1,tfmfile);putbyte(x.b2,tfmfile);putbyte(x.b3,tfmfile);end; {:1164}{1281:}{756:}function openmemfile:boolean;label 40,10; var j:0..bufsize;begin j:=curinput.locfield; if buffer[curinput.locfield]=38 then begin incr(curinput.locfield); j:=curinput.locfield;buffer[last]:=32;while buffer[j]<>32 do incr(j); packbufferedname(0,curinput.locfield,j-1); if wopenin(memfile)then goto 40;; write(stdout,'Sorry, I can''t find the mem file `'); fputs(nameoffile+1,stdout);write(stdout,'''; will try `'); fputs(MPmemdefault+1,stdout);writeln(stdout,'''.');fflush(stdout);end; packbufferedname(memdefaultlength-4,1,0); if not wopenin(memfile)then begin; write(stdout,'I can''t find the mem file `'); fputs(MPmemdefault+1,stdout);writeln(stdout,'''!');openmemfile:=false; goto 10;end;40:curinput.locfield:=j;openmemfile:=true;10:end;{:756} function loadmemfile:boolean;label 30,6666,10;var k:integer; p,q:halfword;x:integer;s:strnumber;w:fourquarters;begin{1285:} undumpint(x);if x<>136687108 then goto 6666;undumpint(x); if x<>0 then goto 6666; ifdef('INIMP')if iniversion then begin libcfree(mem);libcfree(strref); libcfree(nextstr);libcfree(strstart);libcfree(strpool);end; endif('INIMP')undumpint(memtop);if memmaxmemtop then goto 6666;xmallocarray(mem,memmax-0);undumpint(x); if x<>9500 then goto 6666;undumpint(x);if x<>7919 then goto 6666; undumpint(x);if x<>15 then goto 6666{:1285};{1287:}begin undumpint(x); if x<0 then goto 6666;if x>suppoolsize-poolfree then begin; writeln(stdout,'---! Must increase the ','string pool size');goto 6666; end else poolptr:=x;end; if poolsizesupmaxstrings then begin; writeln(stdout,'---! Must increase the ','max strings');goto 6666; end else maxstrptr:=x;end;xmallocarray(strref,maxstrings); xmallocarray(nextstr,maxstrings);xmallocarray(strstart,maxstrings); xmallocarray(strpool,poolsize);begin undumpint(x); if(x<0)or(x>maxstrptr)then goto 6666 else strptr:=x;end; begin undumpint(x);if(x<0)or(x>maxstrptr+1)then goto 6666 else s:=x;end; for k:=0 to s-1 do nextstr[k]:=k+1; for k:=s to maxstrptr do begin undumpint(x); if(xmaxstrptr+1)then goto 6666 else nextstr[k]:=x;end; fixedstruse:=0;k:=0;while true do begin begin undumpint(x); if(x<0)or(x>poolptr)then goto 6666 else strstart[k]:=x;end; if k=strptr then goto 30;strref[k]:=127;incr(fixedstruse); lastfixedstr:=k;k:=nextstr[k];end;30:k:=0; while k+4memtop-4)then goto 6666 else lomemmax:=x;end; begin undumpint(x);if(x<24)or(x>lomemmax)then goto 6666 else rover:=x; end;p:=0;q:=rover;repeat for k:=p to q+1 do undumpwd(mem[k]); 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 undumpwd(mem[k]);begin undumpint(x); if(xmemtop-3)then goto 6666 else himemmin:=x;end; begin undumpint(x);if(x<0)or(x>memtop)then goto 6666 else avail:=x;end; memend:=memtop;for k:=himemmin to memend do undumpwd(mem[k]); undumpint(varused);undumpint(dynused){:1289};{1291:}begin undumpint(x); if(x<1)or(x>9757)then goto 6666 else hashused:=x;end;p:=0; repeat begin undumpint(x); if(xhashused)then goto 6666 else p:=x;end;undumphh(hash[p]); undumphh(eqtb[p]);until p=hashused; for p:=hashused+1 to 9771 do begin undumphh(hash[p]);undumphh(eqtb[p]); end;undumpint(stcount){:1291};{1293:}begin undumpint(x); if(x<33)or(x>maxinternal)then goto 6666 else intptr:=x;end; for k:=1 to intptr do begin undumpint(internal[k]);begin undumpint(x); if(x<0)or(x>strptr)then goto 6666 else intname[k]:=x;end;end; begin undumpint(x);if(x<0)or(x>9757)then goto 6666 else startsym:=x;end; begin undumpint(x);if(x<0)or(x>3)then goto 6666 else interaction:=x;end; if interactionoption<>4 then interaction:=interactionoption; begin undumpint(x);if(x<0)or(x>strptr)then goto 6666 else memident:=x; end;begin undumpint(x);if(x<1)or(x>9771)then goto 6666 else bgloc:=x; end;begin undumpint(x);if(x<1)or(x>9771)then goto 6666 else egloc:=x; end;undumpint(serialno);undumpint(x); if(x<>69073)or feof(memfile)then goto 6666{:1293};loadmemfile:=true; goto 10;6666:;writeln(stdout,'(Fatal mem file error; I''m stymied)'); loadmemfile:=false;10:end;{:1281}{1296:}{811:}procedure scanprimary; label 20,30,31,32;var p,q,r:halfword;c:quarterword;myvarflag:0..84; ldelim,rdelim:halfword;{821:}groupline:integer;{:821}{826:} num,denom:scaled;{:826}{833:}prehead,posthead,tail:halfword; tt:smallnumber;t:halfword;macroref:halfword;{:833} begin myvarflag:=varflag;varflag:=0; 20:begin if aritherror then cleararith;end;{813:} ifdef('TEXMF_DEBUG')if panicking then checkmem(false); endif('TEXMF_DEBUG')if interrupt<>0 then if OKtointerrupt then begin backinput;begin if interrupt<>0 then pauseforinstructions;end;getxnext; end{:813};case curcmd of 33:{814:}begin ldelim:=cursym;rdelim:=curmod; getxnext;scanexpression;if(curcmd=81)and(curtype>=16)then{818:} begin p:=stashcurexp;getxnext;scanexpression;{819:} if curtype<16 then begin disperr(0,824);begin helpptr:=4; helpline[3]:=825;helpline[2]:=826;helpline[1]:=827;helpline[0]:=828;end; putgetflusherror(0);end{:819};q:=getnode(2);mem[q].hh.b1:=14; if curcmd=81 then mem[q].hh.b0:=13 else mem[q].hh.b0:=14;initbignode(q); r:=mem[q+1].int;stashin(r+2);unstashcurexp(p);stashin(r); if curcmd=81 then{820:}begin getxnext;scanexpression; if curtype<16 then begin disperr(0,829);begin helpptr:=3; helpline[2]:=830;helpline[1]:=827;helpline[0]:=828;end; putgetflusherror(0);end;stashin(r+4);end{:820}; checkdelimiter(ldelim,rdelim);curtype:=mem[q].hh.b0;curexp:=q;end{:818} else checkdelimiter(ldelim,rdelim);end{:814};34:{822:} begin groupline:=trueline; if internal[6]>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<>82;if curcmd<>83 then begin begin if interaction=3 then; printnl(262);print(831);end;printint(groupline);print(832); begin helpptr:=2;helpline[1]:=833;helpline[0]:=834;end;backerror; curcmd:=83;end;unsave;if internal[6]>0 then showcmdmod(curcmd,curmod); end{:822};41:{823:}begin curtype:=4;curexp:=curmod;end{:823};44:{827:} begin curexp:=curmod;curtype:=16;getxnext; if curcmd<>56 then begin num:=0;denom:=0;end else begin getxnext; if curcmd<>44 then begin backinput;curcmd:=56;curmod:=92;cursym:=9761; goto 30;end;num:=curexp;denom:=curmod;if denom=0 then{828:} begin begin if interaction=3 then;printnl(262);print(835);end; begin helpptr:=1;helpline[0]:=836;end;error;end{:828} else curexp:=makescaled(num,denom);begin if aritherror then cleararith; end;getxnext;end; if curcmd>=32 then if curcmd<44 then begin p:=stashcurexp;scanprimary; if(abs(num)>=abs(denom))or(curtype<13)then dobinary(p,91)else begin fracmult(num,denom);freenode(p,2);end;end;goto 30;end{:827};35:{824:} donullary(curmod){:824};36,32,38,45:{825:}begin c:=curmod;getxnext; scanprimary;dounary(c);goto 30;end{:825};39:{829:}begin c:=curmod; getxnext;scanexpression;if curcmd<>70 then begin missingerr(489); print(756);printcmdmod(39,c);begin helpptr:=1;helpline[0]:=757;end; backerror;end;p:=stashcurexp;getxnext;scanprimary;dobinary(p,c);goto 30; end{:829};37:{830:}begin getxnext;scansuffix;oldsetting:=selector; selector:=4;showtokenlist(curexp,0,100000,0);flushtokenlist(curexp); curexp:=makestring;selector:=oldsetting;curtype:=4;goto 30;end{:830}; 42:{831:}begin q:=curmod;if myvarflag=76 then begin getxnext; if curcmd=76 then begin curexp:=getavail;mem[curexp].hh.lh:=q+9771; curtype:=20;goto 30;end;backinput;end;curtype:=16;curexp:=internal[q]; end{:831};40:makeexpcopy(curmod);43:{834:}begin begin prehead:=avail; if prehead=0 then prehead:=getavail else begin avail:=mem[prehead].hh.rh ;mem[prehead].hh.rh:=0;ifdef('STAT')incr(dynused);endif('STAT')end;end; tail:=prehead;posthead:=0;tt:=1;while true do begin t:=curtok; mem[tail].hh.rh:=t;if tt<>0 then begin{840:}begin p:=mem[prehead].hh.rh; q:=mem[p].hh.lh;tt:=0;if eqtb[q].lh mod 85=43 then begin q:=eqtb[q].rh; if q=0 then goto 32;while true do begin p:=mem[p].hh.rh; if p=0 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:end{:840}; if tt>=22 then{835:}begin mem[tail].hh.rh:=0; if tt>22 then begin posthead:=getavail;tail:=posthead; mem[tail].hh.rh:=t;tt:=0;macroref:=mem[q+1].int; incr(mem[macroref].hh.lh);end else{843:}begin 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,0);getxnext;goto 20; end{:843};end{:835};end;getxnext;tail:=t;if curcmd=65 then{836:} begin getxnext;scanexpression;if curcmd<>66 then{837:}begin backinput; backexpr;curcmd:=65;curmod:=0;cursym:=9760;end{:837} else begin if curtype<>16 then badsubscript;curcmd:=44;curmod:=curexp; cursym:=0;end;end{:836};if curcmd>44 then goto 31; if curcmd<42 then goto 31;end;31:{842:}if posthead<>0 then{844:} begin 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:=0; macrocall(macroref,prehead,0);decr(mem[macroref].hh.lh);getxnext; goto 20;end{:844};q:=mem[prehead].hh.rh;begin mem[prehead].hh.rh:=avail; avail:=prehead;ifdef('STAT')decr(dynused);endif('STAT')end; if curcmd=myvarflag then begin curtype:=20;curexp:=q;goto 30;end; p:=findvariable(q);if p<>0 then makeexpcopy(p)else begin obliterated(q); helpline[2]:=848;helpline[1]:=849;helpline[0]:=850;putgetflusherror(0); end;flushnodelist(q);goto 30{:842};end{:834};others:begin badexp(818); goto 20;end end;getxnext;30:if curcmd=65 then if curtype>=16 then{849:} begin p:=stashcurexp;getxnext;scanexpression; if curcmd<>81 then begin{837:}begin backinput;backexpr;curcmd:=65; curmod:=0;cursym:=9760;end{:837};unstashcurexp(p); end else begin q:=stashcurexp;getxnext;scanexpression; if curcmd<>66 then begin missingerr(93);begin helpptr:=3; helpline[2]:=852;helpline[1]:=853;helpline[0]:=738;end;backerror;end; r:=stashcurexp;makeexpcopy(q);dobinary(r,90);dobinary(p,91); dobinary(q,89);getxnext;end;end{:849};end;{:811}{850:} procedure scansuffix;label 30;var h,t:halfword;p:halfword; begin h:=getavail;t:=h;while true do begin if curcmd=65 then{851:} begin getxnext;scanexpression;if curtype<>16 then badsubscript; if curcmd<>66 then begin missingerr(93);begin helpptr:=3; helpline[2]:=854;helpline[1]:=853;helpline[0]:=738;end;backerror;end; curcmd:=44;curmod:=curexp;end{:851}; if curcmd=44 then p:=newnumtok(curmod)else if(curcmd=43)or(curcmd=42) 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;ifdef('STAT')decr(dynused); endif('STAT')end;curtype:=20;end;{:850}{852:}procedure scansecondary; label 20,22;var p:halfword;c,d:halfword;macname:halfword; begin 20:if(curcmd<32)or(curcmd>45)then badexp(855);scanprimary; 22:if curcmd<=57 then if curcmd>=54 then begin p:=stashcurexp;c:=curmod; d:=curcmd;if d=55 then begin macname:=cursym;incr(mem[c].hh.lh);end; getxnext;scanprimary;if d<>55 then dobinary(p,c)else begin backinput; binarymac(p,c,macname);decr(mem[c].hh.lh);getxnext;goto 20;end;goto 22; end;end;{:852}{854:}procedure scantertiary;label 20,22;var p:halfword; c,d:halfword;macname:halfword; begin 20:if(curcmd<32)or(curcmd>45)then badexp(856);scansecondary; 22:if curcmd<=47 then if curcmd>=45 then begin p:=stashcurexp;c:=curmod; d:=curcmd;if d=46 then begin macname:=cursym;incr(mem[c].hh.lh);end; getxnext;scansecondary;if d<>46 then dobinary(p,c)else begin backinput; binarymac(p,c,macname);decr(mem[c].hh.lh);getxnext;goto 20;end;goto 22; end;end;{:854}{855:}procedure scanexpression;label 20,30,22,25,26,10; var p,q,r,pp,qq:halfword;c,d:halfword;myvarflag:0..84;macname:halfword; cyclehit:boolean;x,y:scaled;t:0..4;begin myvarflag:=varflag; 20:if(curcmd<32)or(curcmd>45)then badexp(857);scantertiary; 22:if curcmd<=53 then if curcmd>=48 then if(curcmd<>53)or(myvarflag<>76) then begin p:=stashcurexp;c:=curmod;d:=curcmd; if d=51 then begin macname:=cursym;incr(mem[c].hh.lh);end; if(d<50)or((d=50)and((mem[p].hh.b0=14)or(mem[p].hh.b0=8)))then{856:} begin cyclehit:=false;{857:}begin unstashcurexp(p); if curtype=14 then p:=newknot else if curtype=8 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{:857};25:{861:} if curcmd=48 then{866:}begin 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{:866};d:=curcmd;if d=49 then{868:}begin getxnext; if curcmd=60 then{869:}begin getxnext;y:=curcmd; if curcmd=61 then getxnext;scanprimary;{870:} if(curtype<>16)or(curexp<49152)then begin disperr(0,875); begin helpptr:=1;helpline[0]:=876;end;putgetflusherror(65536);end{:870}; if y=61 then curexp:=-curexp;mem[q+6].int:=curexp; if curcmd=54 then begin getxnext;y:=curcmd;if curcmd=61 then getxnext; scanprimary;{870:} if(curtype<>16)or(curexp<49152)then begin disperr(0,875); begin helpptr:=1;helpline[0]:=876;end;putgetflusherror(65536);end{:870}; if y=61 then curexp:=-curexp;end;y:=curexp;end{:869} else if curcmd=59 then{871:}begin mem[q].hh.b1:=1;t:=1;getxnext; scanprimary;knownpair;mem[q+5].int:=curx;mem[q+6].int:=cury; if curcmd<>54 then begin x:=mem[q+5].int;y:=mem[q+6].int; end else begin getxnext;scanprimary;knownpair;x:=curx;y:=cury;end; end{:871}else begin mem[q+6].int:=65536;y:=65536;backinput;goto 30;end; if curcmd<>49 then begin missingerr(321);begin helpptr:=1; helpline[0]:=874;end;backerror;end;30:end{:868} else if d<>50 then goto 26;getxnext;if curcmd=48 then{867:} begin t:=scandirection;if mem[q].hh.b1<>1 then x:=curexp else t:=1; end{:867}else if mem[q].hh.b1<>1 then begin t:=4;x:=0;end{:861}; if curcmd=38 then{873:}begin cyclehit:=true;getxnext;pp:=p;qq:=p; if d=50 then if p=q then begin d:=49;mem[q+6].int:=65536;y:=65536;end; end{:873}else begin scantertiary;{872:} begin if curtype<>8 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{:872};end;{874:} begin if d=50 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(262); print(877);end;begin helpptr:=3;helpline[2]:=878;helpline[1]:=879; helpline[0]:=880;end;putgeterror;d:=49;mem[q+6].int:=65536;y:=65536;end; {876:}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{:876};if d=50 then{877:} begin 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{:877} else begin{875:} 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{:875}; 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{:874}; if curcmd>=48 then if curcmd<=50 then if not cyclehit then goto 25; 26:{878:}if cyclehit then begin if d=50 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:=8; curexp:=p{:878};end{:856}else begin getxnext;scantertiary; if d<>51 then dobinary(p,c)else begin backinput;binarymac(p,c,macname); decr(mem[c].hh.lh);getxnext;goto 20;end;end;goto 22;end;10:end;{:855} {879:}procedure getboolean;begin getxnext;scanexpression; if curtype<>2 then begin disperr(0,881);begin helpptr:=2; helpline[1]:=882;helpline[0]:=883;end;putgetflusherror(31);curtype:=2; end;end;{:879}{243:}procedure printcapsule;begin printchar(40); printexp(gpointer,0);printchar(41);end;procedure tokenrecycle; begin recyclevalue(gpointer);end;{:243}{1299:} procedure closefilesandterminate;var k:integer;lh:integer; lkoffset:0..256;p:halfword;begin{1300:} for k:=0 to readfiles-1 do if rdfname[k]<>0 then aclose(rdfile[k]); for k:=0 to writefiles-1 do if wrfname[k]<>0 then aclose(wrfile[k]){: 1300};ifdef('STAT')if internal[10]>0 then{1303:} if logopened then begin writeln(logfile,' '); writeln(logfile,'Here is how much of MetaPost''s memory',' you used:'); write(logfile,' ',maxstrsused-initstruse:1,' string'); if maxstrsused<>initstruse+1 then write(logfile,'s'); writeln(logfile,' out of ',maxstrings-1-initstruse:1); writeln(logfile,' ',maxplused-initpoolptr:1,' string characters out of ' ,poolsize-initpoolptr:1); writeln(logfile,' ',lomemmax+0+memend-himemmin+2:1, ' words of memory out of ',memend+1:1); writeln(logfile,' ',stcount:1,' symbolic tokens out of ',9500:1); writeln(logfile,' ',maxinstack:1,'i,',intptr:1,'n,',maxparamstack:1,'p,' ,maxbufstack+1:1,'b stack positions out of ',stacksize:1,'i,', maxinternal:1,'n,',150:1,'p,',bufsize:1,'b'); writeln(logfile,' ',pactcount:1,' string compactions (moved ',pactchars: 1,' characters, ',pactstrs:1,' strings)');end{:1303};endif('STAT'); {1301:}if internal[26]>0 then begin{1302:}rover:=24; mem[rover].hh.rh:=268435455;lomemmax:=himemmin-1; if lomemmax-rover>268435455 then lomemmax:=268435455+rover; mem[rover].hh.lh:=lomemmax-rover;mem[rover+1].hh.lh:=rover; mem[rover+1].hh.rh:=rover;mem[lomemmax].hh.rh:=0; mem[lomemmax].hh.lh:=0{:1302};{1155:}mem[memtop-1].hh.rh:=11; for k:=bc to ec do if charexists[k]then tfmwidth[k]:=sortin(tfmwidth[k]) ;nw:=skimp(255)+1;dimenhead[1]:=mem[memtop-1].hh.rh; if perturbation>=4096 then tfmwarning(19){:1155};fixdesignsize; fixchecksum;{1157:}mem[memtop-1].hh.rh:=11; for k:=bc to ec do if charexists[k]then if tfmheight[k]=0 then tfmheight [k]:=7 else tfmheight[k]:=sortin(tfmheight[k]);nh:=skimp(15)+1; dimenhead[2]:=mem[memtop-1].hh.rh; if perturbation>=4096 then tfmwarning(20);mem[memtop-1].hh.rh:=11; for k:=bc to ec do if charexists[k]then if tfmdepth[k]=0 then tfmdepth[k ]:=7 else tfmdepth[k]:=sortin(tfmdepth[k]);nd:=skimp(15)+1; dimenhead[3]:=mem[memtop-1].hh.rh; if perturbation>=4096 then tfmwarning(21);mem[memtop-1].hh.rh:=11; for k:=bc to ec do if charexists[k]then if tfmitalcorr[k]=0 then tfmitalcorr[k]:=7 else tfmitalcorr[k]:=sortin(tfmitalcorr[k]); ni:=skimp(63)+1;dimenhead[4]:=mem[memtop-1].hh.rh; if perturbation>=4096 then tfmwarning(22){:1157};internal[26]:=0;{1165:} if jobname=0 then openlogfile;packjobname(1092); while not bopenout(tfmfile)do promptfilename(1093,1092); metricfilename:=bmakenamestring(tfmfile);{1166:}k:=headersize; while headerbyte[k]<0 do decr(k);lh:=(k+3)div 4;if bc>ec then bc:=1; {1168:}bchar:=roundunscaled(internal[31]); if(bchar<0)or(bchar>255)then begin bchar:=-1;lkstarted:=false; lkoffset:=0;end else begin lkstarted:=true;lkoffset:=1;end;{1169:} k:=labelptr;if labelloc[k]+lkoffset>255 then begin lkoffset:=0; lkstarted:=false;repeat charremainder[labelchar[k]]:=lkoffset; while labelloc[k-1]=labelloc[k]do begin decr(k); charremainder[labelchar[k]]:=lkoffset;end;incr(lkoffset);decr(k); until lkoffset+labelloc[k]<256;end; if lkoffset>0 then while k>0 do begin charremainder[labelchar[k]]:= charremainder[labelchar[k]]+lkoffset;decr(k);end{:1169}; if bchlabel11 do begin put4bytes(tfmfile,dimenout(mem[p+1].int)); p:=mem[p].hh.rh;end;end{:1167};{1170:} for k:=0 to 255 do if skiptable[k]0 then put4bytes(tfmfile,2147483647)else put4bytes(tfmfile, -2147483647);end else put4bytes(tfmfile,dimenout(param[k])); if tfmchanged>0 then begin if tfmchanged=1 then printnl(1097)else begin printnl(40);printint(tfmchanged);print(1098);end;print(1099);end{:1171}; ifdef('STAT')if internal[10]>0 then{1172:}begin writeln(logfile,' '); if bchlabel0 then begin printnl(284);printint(totalshipped); print(1116);if totalshipped>1 then printchar(115);print(1117); print(firstfilename); if totalshipped>1 then begin if 31+(strstart[nextstr[firstfilename]]- strstart[firstfilename])+(strstart[nextstr[lastfilename]]-strstart[ lastfilename])>maxprintline then println;print(548);print(lastfilename); end;end{:1208};if logopened then begin writeln(logfile);aclose(logfile); selector:=selector-2;if selector=8 then begin printnl(1181); print(texmflogname);printchar(46);end;end;println; if(editnamestart<>0)and(interaction>0)then calledit(strpool, editnamestart,editnamelength,editline);end;{:1299}{1304:} procedure finalcleanup;label 10;var c:smallnumber;begin c:=curmod; if jobname=0 then openlogfile; while inputptr>0 do if(curinput.indexfield>15)then endtokenlist else endfilereading;while loopptr<>0 do stopiteration; while openparens>0 do begin print(1182);decr(openparens);end; while condptr<>0 do begin printnl(1183);printcmdmod(5,curif); if ifline<>0 then begin print(1184);printint(ifline);end;print(1185); 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=10 then begin selector:=8;printnl(1186);selector:=10;end; if c=1 then begin ifdef('INIMP')if iniversion then begin storememfile; goto 10;end;endif('INIMP')printnl(1187);goto 10;end;10:end;{:1304} {1305:}ifdef('INIMP')procedure initprim;begin{210:}primitive(430,42,1); primitive(431,42,2);primitive(432,42,3);primitive(433,42,4); primitive(434,42,5);primitive(435,42,6);primitive(436,42,7); primitive(437,42,8);primitive(438,42,9);primitive(439,42,10); primitive(440,42,11);primitive(441,42,12);primitive(442,42,13); primitive(443,42,14);primitive(444,42,15);primitive(445,42,16); primitive(446,42,17);primitive(447,42,18);primitive(448,42,19); primitive(449,42,20);primitive(450,42,21);primitive(451,42,22); primitive(452,42,23);primitive(453,42,24);primitive(454,42,25); primitive(455,42,26);primitive(456,42,27);primitive(457,42,28); primitive(458,42,29);primitive(459,42,30);primitive(460,42,31); primitive(461,42,32);primitive(462,42,33);{:210}{229:} primitive(321,49,0);primitive(91,65,0);eqtb[9760]:=eqtb[cursym]; primitive(93,66,0);primitive(125,67,0);primitive(123,48,0); primitive(58,80,0);eqtb[9762]:=eqtb[cursym];primitive(474,79,0); primitive(475,78,0);primitive(476,76,0);primitive(44,81,0); primitive(59,82,0);eqtb[9763]:=eqtb[cursym];primitive(92,10,0); primitive(477,20,0);primitive(478,61,0);primitive(479,34,0); bgloc:=cursym;primitive(480,59,0);primitive(481,62,0); primitive(482,29,0);primitive(468,83,0);eqtb[9767]:=eqtb[cursym]; egloc:=cursym;primitive(483,28,0);primitive(484,9,0); primitive(485,12,0);primitive(486,15,0);primitive(487,16,0); primitive(488,17,0);primitive(489,70,0);primitive(490,26,0); primitive(491,14,0);primitive(492,11,0);primitive(493,19,0); primitive(494,77,0);primitive(495,30,0);primitive(496,72,0); primitive(497,37,0);primitive(498,60,0);primitive(499,71,0); primitive(500,73,0);primitive(501,74,0);primitive(502,31,0);{:229}{647:} primitive(681,1,0);primitive(682,1,1);primitive(465,2,0); eqtb[9768]:=eqtb[cursym];primitive(466,3,0);eqtb[9769]:=eqtb[cursym]; {:647}{655:}primitive(695,18,1);primitive(696,18,2); primitive(697,18,55);primitive(698,18,46);primitive(699,18,51); primitive(469,18,0);eqtb[9765]:=eqtb[cursym];primitive(700,7,9772); primitive(701,7,9922);primitive(702,7,1);primitive(470,7,0); eqtb[9764]:=eqtb[cursym];{:655}{660:}primitive(703,63,0); primitive(704,63,1);primitive(64,63,2);primitive(705,63,3);{:660}{667:} primitive(716,58,9772);primitive(717,58,9922);primitive(718,58,10072); primitive(719,58,1);primitive(720,58,2);primitive(721,58,3);{:667}{681:} primitive(731,6,0);primitive(628,6,1);{:681}{712:}primitive(758,4,1); primitive(467,5,2);eqtb[9766]:=eqtb[cursym];primitive(759,5,3); primitive(760,5,4);{:712}{880:}primitive(347,35,30); primitive(348,35,31);primitive(349,35,32);primitive(350,35,33); primitive(351,35,34);primitive(352,35,35);primitive(353,35,36); primitive(354,35,37);primitive(355,36,38);primitive(356,36,39); primitive(357,36,40);primitive(358,36,41);primitive(359,36,42); primitive(360,36,43);primitive(361,36,44);primitive(362,36,45); primitive(363,36,46);primitive(364,36,47);primitive(365,36,48); primitive(366,36,49);primitive(367,36,50);primitive(368,36,51); primitive(369,36,52);primitive(370,36,53);primitive(371,36,54); primitive(372,36,55);primitive(373,36,56);primitive(374,36,57); primitive(375,36,58);primitive(376,36,59);primitive(377,36,60); primitive(378,36,61);primitive(379,36,62);primitive(380,36,63); primitive(381,36,64);primitive(382,36,65);primitive(383,36,66); primitive(384,36,67);primitive(385,36,68);primitive(386,36,69); primitive(387,36,70);primitive(388,36,71);primitive(389,36,72); primitive(390,36,73);primitive(391,36,74);primitive(392,36,75); primitive(393,36,76);primitive(394,36,77);primitive(395,36,78); primitive(396,36,79);primitive(397,36,80);primitive(398,36,81); primitive(399,36,82);primitive(400,38,83);primitive(402,36,85); primitive(401,36,84);primitive(403,36,86);primitive(404,36,87); primitive(405,36,88);primitive(43,45,89);primitive(45,45,90); primitive(42,57,91);primitive(47,56,92);eqtb[9761]:=eqtb[cursym]; primitive(406,47,93);primitive(310,47,94);primitive(407,47,95); primitive(408,54,96);primitive(60,52,97);primitive(409,52,98); primitive(62,52,99);primitive(410,52,100);primitive(61,53,101); primitive(411,52,102);primitive(422,39,115);primitive(423,39,116); primitive(424,39,117);primitive(425,39,118);primitive(426,39,119); primitive(427,39,120);primitive(428,39,121);primitive(429,39,122); primitive(38,50,103);primitive(412,57,104);primitive(413,57,105); primitive(414,57,106);primitive(415,57,107);primitive(416,57,108); primitive(417,57,109);primitive(418,57,110);primitive(419,57,111); primitive(420,57,112);primitive(421,47,113);{:880}{1030:} primitive(340,32,15);primitive(259,32,4);primitive(325,32,2); primitive(330,32,8);primitive(328,32,6);primitive(332,32,10); primitive(334,32,12);primitive(335,32,13);primitive(336,32,14);{:1030} {1035:}primitive(960,84,0);primitive(961,84,1);{:1035}{1041:} primitive(272,25,0);primitive(273,25,1);primitive(274,25,2); primitive(967,25,3);{:1041}{1044:}primitive(968,23,0); primitive(969,23,1);{:1044}{1054:}primitive(983,24,0); primitive(984,24,1);primitive(985,24,2);primitive(986,24,3); primitive(987,24,4);{:1054}{1069:}primitive(1006,69,0); primitive(1007,69,1);primitive(1008,69,2);primitive(1009,68,6); primitive(1010,68,10);primitive(1011,68,13);{:1069}{1083:} primitive(1020,21,4);primitive(1021,21,5);{:1083}{1103:} primitive(1034,27,0);primitive(1035,27,1);primitive(1036,27,2);{:1103} {1132:}primitive(1051,22,0);primitive(1052,22,1);primitive(1053,22,2); primitive(1054,22,3);primitive(1055,22,4);{:1132}{1139:} primitive(1073,75,0);primitive(1074,75,1);primitive(1075,75,5); primitive(1076,75,2);primitive(1077,75,6);primitive(1078,75,3); primitive(1079,75,7);primitive(1080,75,11);primitive(1081,75,128); {:1139};end;procedure inittab;var k:integer;begin{191:}rover:=24; mem[rover].hh.rh:=268435455;mem[rover].hh.lh:=1000; mem[rover+1].hh.lh:=rover;mem[rover+1].hh.rh:=rover; lomemmax:=rover+1000;mem[lomemmax].hh.rh:=0;mem[lomemmax].hh.lh:=0; for k:=memtop-3 to memtop do mem[k]:=mem[lomemmax];avail:=0; memend:=memtop;himemmin:=memtop-3;varused:=24; dynused:=memtop+1-(memtop-3);{362:}mem[14].int:=-32768;mem[15].int:=0; mem[17].int:=32768;mem[18].int:=0;mem[20].int:=0;mem[21].int:=65536; mem[13].hh.rh:=16;mem[16].hh.rh:=19;mem[19].hh.rh:=13;mem[13].hh.lh:=19; mem[16].hh.lh:=13;mem[19].hh.lh:=16{:362};{:191}{211:}intname[1]:=430; intname[2]:=431;intname[3]:=432;intname[4]:=433;intname[5]:=434; intname[6]:=435;intname[7]:=436;intname[8]:=437;intname[9]:=438; intname[10]:=439;intname[11]:=440;intname[12]:=441;intname[13]:=442; intname[14]:=443;intname[15]:=444;intname[16]:=445;intname[17]:=446; intname[18]:=447;intname[19]:=448;intname[20]:=449;intname[21]:=450; intname[22]:=451;intname[23]:=452;intname[24]:=453;intname[25]:=454; intname[26]:=455;intname[27]:=456;intname[28]:=457;intname[29]:=458; intname[30]:=459;intname[31]:=460;intname[32]:=461;intname[33]:=462; {:211}{221:}hashused:=9757;stcount:=0;hash[9770].rh:=464; hash[9768].rh:=465;hash[9769].rh:=466;hash[9766].rh:=467; hash[9767].rh:=468;hash[9765].rh:=469;hash[9764].rh:=470; hash[9763].rh:=59;hash[9762].rh:=58;hash[9761].rh:=47;hash[9760].rh:=91; hash[9759].rh:=41;hash[9757].rh:=471;eqtb[9759].lh:=64;{:221}{233:} mem[0].hh.rh:=0;mem[1].int:=0;{:233}{248:}mem[11].hh.lh:=9772; mem[11].hh.rh:=0;{:248}{541:}serialno:=0;mem[5].hh.rh:=5; mem[6].hh.lh:=5;mem[5].hh.lh:=0;mem[6].hh.rh:=0;{:541}{674:} mem[22].hh.b1:=0;mem[22].hh.rh:=9770;eqtb[9770].rh:=22; eqtb[9770].lh:=43;{:674}{732:}eqtb[9758].lh:=93;hash[9758].rh:=775; {:732}{899:}mem[9].hh.b1:=14;{:899}{1147:}mem[12].int:=1073741824; {:1147}{1158:}mem[8].int:=0;mem[7].hh.lh:=0;{:1158}{1177:} fontdsize[0]:=0;fontname[0]:=284;fontpsname[0]:=284;fontbc[0]:=1; fontec[0]:=0;charbase[0]:=0;widthbase[0]:=0;heightbase[0]:=0; depthbase[0]:=0;nextfmem:=0;lastfnum:=0;lastpsfnum:=0;{:1177}{1279:} if iniversion then memident:=1173;{:1279}end;endif('INIMP'){:1305} {1307:}ifdef('TEXMF_DEBUG')procedure debughelp;label 888,10; var k,l,m,n:integer;begin while true do begin;printnl(1188); fflush(stdout);m:=inputint(stdin); if m<0 then goto 10 else if m=0 then begin goto 888; 888:m:=0;{'BREAKPOINT'} end else begin n:=inputint(stdin);case m of{1308:}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,0,100000,0);10:print(n);11:checkmem(n>0); 12:searchmem(n);13:begin l:=inputint(stdin);printcmdmod(n,l);end; 14:for k:=0 to n do print(buffer[k]);15:panicking:=not panicking;{:1308} others:print(63)end;end;end;10:end;endif('TEXMF_DEBUG'){:1307}{:1296} {1298:}begin bounddefault:=250000;boundname:='main_memory'; setupboundvariable(addressof(mainmemory),boundname,bounddefault);; bounddefault:=100000;boundname:='pool_size'; setupboundvariable(addressof(poolsize),boundname,bounddefault);; bounddefault:=75000;boundname:='string_vacancies'; setupboundvariable(addressof(stringvacancies),boundname,bounddefault);; bounddefault:=5000;boundname:='pool_free'; setupboundvariable(addressof(poolfree),boundname,bounddefault);; bounddefault:=15000;boundname:='max_strings'; setupboundvariable(addressof(maxstrings),boundname,bounddefault);; bounddefault:=79;boundname:='error_line'; setupboundvariable(addressof(errorline),boundname,bounddefault);; bounddefault:=50;boundname:='half_error_line'; setupboundvariable(addressof(halferrorline),boundname,bounddefault);; bounddefault:=79;boundname:='max_print_line'; setupboundvariable(addressof(maxprintline),boundname,bounddefault);; if errorline>255 then errorline:=255; begin if mainmemorysupmainmemory then mainmemory:=supmainmemory end; memtop:=0+mainmemory;memmax:=memtop; begin if poolsizesuppoolsize then poolsize:=suppoolsize end; begin if stringvacanciessupstringvacancies then stringvacancies:=supstringvacancies end; begin if poolfreesuppoolfree then poolfree:=suppoolfree end; begin if maxstringssupmaxstrings then maxstrings:=supmaxstrings end; ifdef('INIMP')if iniversion then begin xmallocarray(mem,memtop-0); xmallocarray(strref,maxstrings);xmallocarray(nextstr,maxstrings); xmallocarray(strstart,maxstrings);xmallocarray(strpool,poolsize);end; endif('INIMP')history:=3;;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 emergencylinelengthmemtop then bad:=4;if 7919>9500 then bad:=5; if headersize mod 4<>0 then bad:=6; if(ligtablesize<255)or(ligtablesize>32510)then bad:=7;{:14}{169:} ifdef('INIMP')if memmax<>memtop then bad:=8; endif('INIMP')if memmax0)or(255<127)then bad:=9;if(0>0)or(268435455<32767)then bad:=10; if(0<0)or(255>268435455)then bad:=11; if(0<0)or(memmax>=268435455)then bad:=12; if maxstrings>268435455 then bad:=13;if bufsize>268435455 then bad:=14; if fontmax>268435455 then bad:=15; if(255<255)or(268435455<65535)then bad:=16;{:169}{222:} if 9771+maxinternal>268435455 then bad:=17;{:222}{232:} if 10222>268435455 then bad:=18;{:232}{528:} if 20+17*45>bistacksize then bad:=19;{:528}{754:} if memdefaultlength>maxint then bad:=20;{:754} if bad>0 then begin writeln(stdout, 'Ouch---my internal constants have been clobbered!','---case ',bad:1); goto 9999;end;initialize; ifdef('INIMP')if iniversion then begin if not getstringsstarted then goto 9999;inittab;initprim;initstruse:=strptr;initpoolptr:=poolptr; maxstrptr:=strptr;maxpoolptr:=poolptr;fixdateandtime;end; endif('INIMP')readyalready:=314159;1:{70:}selector:=8;tally:=0; termoffset:=0;fileoffset:=0;psoffset:=0;{:70}{76:} write(stdout,'This is MetaPost, Version 0.641'); write(stdout,versionstring);if memident>0 then print(memident);println; fflush(stdout);{:76}{761:}jobname:=0;logopened:=false;{:761};{1306:} begin{616:}begin inputptr:=0;maxinstack:=0;inopen:=0;openparens:=0; maxbufstack:=0;paramptr:=0;maxparamstack:=0;first:=1; curinput.startfield:=1;curinput.indexfield:=0; linestack[curinput.indexfield]:=0;curinput.namefield:=0;mpxname[0]:=1; forceeof:=false;if not initterminal then goto 9999; curinput.limitfield:=last;first:=last+1;end;{:616}{619:} scannerstatus:=0;{:619}; if(memident=0)or(buffer[curinput.locfield]=38)or dumpline then begin if memident<>0 then initialize;if not openmemfile then goto 9999; if not loadmemfile then begin wclose(memfile);goto 9999;end; wclose(memfile); while(curinput.locfield92 then startinput;end{:1306};history:=0; if troffmode then internal[32]:=65536; if startsym>0 then begin cursym:=startsym;backinput;end;maincontrol; finalcleanup;closefilesandterminate;9999:begin fflush(stdout); readyalready:=0;if(history<>0)and(history<>1)then uexit(1)else uexit(0); end;end.{:1298}