1 program TANGLE(webfile,changefile,Pascalfile,pool);label 9999;const{8:}
2 bufsize=100;maxbytes=45000;maxtoks=50000;maxnames=4000;maxtexts=2000;
3 hashsize=353;longestname=400;linelength=72;outbufsize=144;stacksize=50;
4 maxidlength=12;unambiglength=7;{:8}type{11:}ASCIIcode=0..255;{:11}{12:}
5 {:12}{37:}eightbits=0..255;
6 sixteenbits=0..65535;{:37}{39:}namepointer=0..maxnames;{:39}{43:}
7 textpointer=0..maxtexts;{:43}{78:}
8 outputstate=record endfield:sixteenbits;bytefield:sixteenbits;
9 namefield:namepointer;replfield:textpointer;modfield:0..12287;end;{:78}
10 var{9:}history:0..3;{:9}{13:}xord:array[char]of ASCIIcode;
11 xchr:array[ASCIIcode]of char;{:13}{20:}termout:text;{:20}{23:}
12 webfile:text;changefile:text;{:23}{25:}Pascalfile:text;
13 pool:text;{:25}{27:}buffer:array[0..bufsize]of ASCIIcode;{:27}{29:}
14 phaseone:boolean;{:29}{38:}
15 bytemem:packed array[0..1,0..maxbytes]of ASCIIcode;
16 tokmem:packed array[0..2,0..maxtoks]of eightbits;
17 bytestart:array[0..maxnames]of sixteenbits;
18 tokstart:array[0..maxtexts]of sixteenbits;
19 link:array[0..maxnames]of sixteenbits;
20 ilk:array[0..maxnames]of sixteenbits;
21 equiv:array[0..maxnames]of sixteenbits;
22 textlink:array[0..maxtexts]of sixteenbits;{:38}{40:}nameptr:namepointer;
23 stringptr:namepointer;byteptr:array[0..1]of 0..maxbytes;
24 poolchecksum:integer;{:40}{44:}textptr:textpointer;
25 tokptr:array[0..2]of 0..maxtoks;z:0..2;
26 {maxtokptr:array[0..2]of 0..maxtoks;}{:44}{50:}idfirst:0..bufsize;
27 idloc:0..bufsize;doublechars:0..bufsize;
28 hash,chophash:array[0..hashsize]of sixteenbits;
29 choppedid:array[0..unambiglength]of ASCIIcode;{:50}{65:}
30 modtext:array[0..longestname]of ASCIIcode;{:65}{70:}
31 lastunnamed:textpointer;{:70}{79:}curstate:outputstate;
32 stack:array[1..stacksize]of outputstate;stackptr:0..stacksize;{:79}{80:}
33 zo:0..2;{:80}{82:}bracelevel:eightbits;{:82}{86:}curval:integer;{:86}
34 {94:}outbuf:array[0..outbufsize]of ASCIIcode;outptr:0..outbufsize;
35 breakptr:0..outbufsize;semiptr:0..outbufsize;{:94}{95:}
36 outstate:eightbits;outval,outapp:integer;outsign:ASCIIcode;
37 lastsign:-1..+1;{:95}{100:}outcontrib:array[1..linelength]of ASCIIcode;
38 {:100}{124:}ii:integer;line:integer;otherline:integer;templine:integer;
39 limit:0..bufsize;loc:0..bufsize;inputhasended:boolean;changing:boolean;
40 {:124}{126:}changebuffer:array[0..bufsize]of ASCIIcode;
41 changelimit:0..bufsize;{:126}{143:}curmodule:namepointer;
42 scanninghex:boolean;{:143}{156:}nextcontrol:eightbits;{:156}{164:}
43 currepltext:textpointer;{:164}{171:}modulecount:0..12287;{:171}{179:}
44 {troubleshooting:boolean;ddt:integer;dd:integer;debugcycle:integer;
45 debugskipped:integer;termin:text;}{:179}{185:}{wo:0..1;}{:185}{30:}
46 {procedure debughelp;forward;}{:30}{31:}procedure error;
47 var j:0..outbufsize;k,l:0..bufsize;begin if phaseone then{32:}
48 begin if changing then write(termout,'. (change file ')else write(
49 termout,'. (');writeln(termout,'l.',line:1,')');
50 if loc>=limit then l:=limit else l:=loc;
51 for k:=1 to l do if buffer[k-1]=9 then write(termout,' ')else write(
52 termout,xchr[buffer[k-1]]);writeln(termout);
53 for k:=1 to l do write(termout,' ');
54 for k:=l+1 to limit do write(termout,xchr[buffer[k-1]]);
55 write(termout,' ');end{:32}else{33:}
56 begin writeln(termout,'. (l.',line:1,')');
57 for j:=1 to outptr do write(termout,xchr[outbuf[j-1]]);
58 write(termout,'... ');end{:33};{break(termout);}history:=2;
59 {debugskipped:=debugcycle;debughelp;}end;{:31}{34:}procedure jumpout;
60 begin goto 9999;end;{:34}procedure initialize;var{16:}i:0..255;{:16}
61 {41:}wi:0..1;{:41}{45:}zi:0..2;{:45}{51:}h:0..hashsize;{:51}begin{10:}
62 history:=0;{:10}{14:}xchr[32]:=' ';xchr[33]:='!';xchr[34]:='"';
63 xchr[35]:='#';xchr[36]:='$';xchr[37]:='%';xchr[38]:='&';xchr[39]:='''';
64 xchr[40]:='(';xchr[41]:=')';xchr[42]:='*';xchr[43]:='+';xchr[44]:=',';
65 xchr[45]:='-';xchr[46]:='.';xchr[47]:='/';xchr[48]:='0';xchr[49]:='1';
66 xchr[50]:='2';xchr[51]:='3';xchr[52]:='4';xchr[53]:='5';xchr[54]:='6';
67 xchr[55]:='7';xchr[56]:='8';xchr[57]:='9';xchr[58]:=':';xchr[59]:=';';
68 xchr[60]:='<';xchr[61]:='=';xchr[62]:='>';xchr[63]:='?';xchr[64]:='@';
69 xchr[65]:='A';xchr[66]:='B';xchr[67]:='C';xchr[68]:='D';xchr[69]:='E';
70 xchr[70]:='F';xchr[71]:='G';xchr[72]:='H';xchr[73]:='I';xchr[74]:='J';
71 xchr[75]:='K';xchr[76]:='L';xchr[77]:='M';xchr[78]:='N';xchr[79]:='O';
72 xchr[80]:='P';xchr[81]:='Q';xchr[82]:='R';xchr[83]:='S';xchr[84]:='T';
73 xchr[85]:='U';xchr[86]:='V';xchr[87]:='W';xchr[88]:='X';xchr[89]:='Y';
74 xchr[90]:='Z';xchr[91]:='[';xchr[92]:='\';xchr[93]:=']';xchr[94]:='^';
75 xchr[95]:='_';xchr[96]:='`';xchr[97]:='a';xchr[98]:='b';xchr[99]:='c';
76 xchr[100]:='d';xchr[101]:='e';xchr[102]:='f';xchr[103]:='g';
77 xchr[104]:='h';xchr[105]:='i';xchr[106]:='j';xchr[107]:='k';
78 xchr[108]:='l';xchr[109]:='m';xchr[110]:='n';xchr[111]:='o';
79 xchr[112]:='p';xchr[113]:='q';xchr[114]:='r';xchr[115]:='s';
80 xchr[116]:='t';xchr[117]:='u';xchr[118]:='v';xchr[119]:='w';
81 xchr[120]:='x';xchr[121]:='y';xchr[122]:='z';xchr[123]:='{';
82 xchr[124]:='|';xchr[125]:='}';xchr[126]:='~';xchr[0]:=' ';
83 xchr[127]:=' ';{:14}{17:}for i:=1 to 31 do xchr[i]:=' ';
84 for i:=128 to 255 do xchr[i]:=' ';{:17}{18:}
85 for i:=0 to 255 do xord[chr(i)]:=32;for i:=1 to 255 do xord[xchr[i]]:=i;
86 xord[' ']:=32;{:18}{21:}rewrite(termout,'TTY:');{:21}{26:}
87 rewrite(Pascalfile);rewrite(pool);{:26}{42:}
88 for wi:=0 to 1 do begin bytestart[wi]:=0;byteptr[wi]:=0;end;
89 bytestart[2]:=0;nameptr:=1;stringptr:=256;poolchecksum:=271828;{:42}
90 {46:}for zi:=0 to 2 do begin tokstart[zi]:=0;tokptr[zi]:=0;end;
91 tokstart[3]:=0;textptr:=1;z:=1 mod 3;{:46}{48:}ilk[0]:=0;equiv[0]:=0;
92 {:48}{52:}for h:=0 to hashsize-1 do begin hash[h]:=0;chophash[h]:=0;end;
93 {:52}{71:}lastunnamed:=0;textlink[0]:=0;{:71}{144:}scanninghex:=false;
94 {:144}{152:}modtext[0]:=32;{:152}{180:}{troubleshooting:=true;
95 debugcycle:=1;debugskipped:=0;troubleshooting:=false;debugcycle:=99999;
96 reset(termin,'TTY:','/I');}{:180}end;{:2}{24:}procedure openinput;
97 begin reset(webfile);reset(changefile);end;{:24}{28:}
98 function inputln(var f:text):boolean;var finallimit:0..bufsize;
99 begin limit:=0;finallimit:=0;
100 if eof(f)then inputln:=false else begin while not eoln(f)do begin buffer
101 [limit]:=xord[f^];get(f);limit:=limit+1;
102 if buffer[limit-1]<>32 then finallimit:=limit;
103 if limit=bufsize then begin while not eoln(f)do get(f);limit:=limit-1;
104 if finallimit>limit then finallimit:=limit;begin writeln(termout);
105 write(termout,'! Input line too long');end;loc:=0;error;end;end;
106 readln(f);limit:=finallimit;inputln:=true;end;end;{:28}{49:}
107 procedure printid(p:namepointer);var k:0..maxbytes;w:0..1;
108 begin if p>=nameptr then write(termout,'IMPOSSIBLE')else begin w:=p mod
110 for k:=bytestart[p]to bytestart[p+2]-1 do write(termout,xchr[bytemem[w,k
111 ]]);end;end;{:49}{53:}function idlookup(t:eightbits):namepointer;
112 label 31,32;var c:eightbits;i:0..bufsize;h:0..hashsize;k:0..maxbytes;
113 w:0..1;l:0..bufsize;p,q:namepointer;s:0..unambiglength;
114 begin l:=idloc-idfirst;{54:}h:=buffer[idfirst];i:=idfirst+1;
115 while i<idloc do begin h:=(h+h+buffer[i])mod hashsize;i:=i+1;end{:54};
117 while p<>0 do begin if bytestart[p+2]-bytestart[p]=l then{56:}
118 begin i:=idfirst;k:=bytestart[p];w:=p mod 2;
119 while(i<idloc)and(buffer[i]=bytemem[w,k])do begin i:=i+1;k:=k+1;end;
120 if i=idloc then goto 31;end{:56};p:=link[p];end;p:=nameptr;
121 link[p]:=hash[h];hash[h]:=p;31:{:55};if(p=nameptr)or(t<>0)then{57:}
122 begin if((p<>nameptr)and(t<>0)and(ilk[p]=0))or((p=nameptr)and(t=0)and(
123 buffer[idfirst]<>34))then{58:}begin i:=idfirst;s:=0;h:=0;
124 while(i<idloc)and(s<unambiglength)do begin if buffer[i]<>95 then begin
125 if buffer[i]>=97 then choppedid[s]:=buffer[i]-32 else choppedid[s]:=
126 buffer[i];h:=(h+h+choppedid[s])mod hashsize;s:=s+1;end;i:=i+1;end;
127 choppedid[s]:=0;end{:58};if p<>nameptr then{59:}
128 begin if ilk[p]=0 then begin if t=1 then begin writeln(termout);
129 write(termout,'! This identifier has already appeared');error;end;{60:}
131 if q=p then chophash[h]:=equiv[p]else begin while equiv[q]<>p do q:=
132 equiv[q];equiv[q]:=equiv[p];end{:60};end else begin writeln(termout);
133 write(termout,'! This identifier was defined before');error;end;
134 ilk[p]:=t;end{:59}else{61:}
135 begin if(t=0)and(buffer[idfirst]<>34)then{62:}begin q:=chophash[h];
136 while q<>0 do begin{63:}begin k:=bytestart[q];s:=0;w:=q mod 2;
137 while(k<bytestart[q+2])and(s<unambiglength)do begin c:=bytemem[w,k];
138 if c<>95 then begin if c>=97 then c:=c-32;
139 if choppedid[s]<>c then goto 32;s:=s+1;end;k:=k+1;end;
140 if(k=bytestart[q+2])and(choppedid[s]<>0)then goto 32;
141 begin writeln(termout);write(termout,'! Identifier conflict with ');end;
142 for k:=bytestart[q]to bytestart[q+2]-1 do write(termout,xchr[bytemem[w,k
143 ]]);error;q:=0;32:end{:63};q:=equiv[q];end;equiv[p]:=chophash[h];
144 chophash[h]:=p;end{:62};w:=nameptr mod 2;k:=byteptr[w];
145 if k+l>maxbytes then begin writeln(termout);
146 write(termout,'! Sorry, ','byte memory',' capacity exceeded');error;
147 history:=3;jumpout;end;
148 if nameptr>maxnames-2 then begin writeln(termout);
149 write(termout,'! Sorry, ','name',' capacity exceeded');error;history:=3;
150 jumpout;end;i:=idfirst;while i<idloc do begin bytemem[w,k]:=buffer[i];
151 k:=k+1;i:=i+1;end;byteptr[w]:=k;bytestart[nameptr+2]:=k;
152 nameptr:=nameptr+1;if buffer[idfirst]<>34 then ilk[p]:=t else{64:}
154 if l-doublechars=2 then equiv[p]:=buffer[idfirst+1]+32768 else begin
155 equiv[p]:=stringptr+32768;l:=l-doublechars-1;
156 if l>99 then begin writeln(termout);
157 write(termout,'! Preprocessed string is too long');error;end;
158 stringptr:=stringptr+1;write(pool,xchr[48+l div 10],xchr[48+l mod 10]);
159 poolchecksum:=poolchecksum+poolchecksum+l;
160 while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839;
161 i:=idfirst+1;while i<idloc do begin write(pool,xchr[buffer[i]]);
162 poolchecksum:=poolchecksum+poolchecksum+buffer[i];
163 while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839;
164 if(buffer[i]=34)or(buffer[i]=64)then i:=i+2 else i:=i+1;end;
165 writeln(pool);end;end{:64};end{:61};end{:57};idlookup:=p;end;{:53}{66:}
166 function modlookup(l:sixteenbits):namepointer;label 31;var c:0..4;
167 j:0..longestname;k:0..maxbytes;w:0..1;p:namepointer;q:namepointer;
168 begin c:=2;q:=0;p:=ilk[0];while p<>0 do begin{68:}begin k:=bytestart[p];
169 w:=p mod 2;c:=1;j:=1;
170 while(k<bytestart[p+2])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:=
172 if k=bytestart[p+2]then if j>l then c:=1 else c:=4 else if j>l then c:=3
173 else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};q:=p;
174 if c=0 then p:=link[q]else if c=2 then p:=ilk[q]else goto 31;end;{67:}
175 w:=nameptr mod 2;k:=byteptr[w];
176 if k+l>maxbytes then begin writeln(termout);
177 write(termout,'! Sorry, ','byte memory',' capacity exceeded');error;
178 history:=3;jumpout;end;
179 if nameptr>maxnames-2 then begin writeln(termout);
180 write(termout,'! Sorry, ','name',' capacity exceeded');error;history:=3;
181 jumpout;end;p:=nameptr;if c=0 then link[q]:=p else ilk[q]:=p;link[p]:=0;
182 ilk[p]:=0;c:=1;equiv[p]:=0;
183 for j:=1 to l do bytemem[w,k+j-1]:=modtext[j];byteptr[w]:=k+l;
184 bytestart[nameptr+2]:=k+l;nameptr:=nameptr+1;{:67};
185 31:if c<>1 then begin begin writeln(termout);
186 write(termout,'! Incompatible section names');error;end;p:=0;end;
187 modlookup:=p;end;{:66}{69:}
188 function prefixlookup(l:sixteenbits):namepointer;var c:0..4;
189 count:0..maxnames;j:0..longestname;k:0..maxbytes;w:0..1;p:namepointer;
190 q:namepointer;r:namepointer;begin q:=0;p:=ilk[0];count:=0;r:=0;
191 while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 2;c:=1;j:=1;
192 while(k<bytestart[p+2])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:=
194 if k=bytestart[p+2]then if j>l then c:=1 else c:=4 else if j>l then c:=3
195 else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};
196 if c=0 then p:=link[p]else if c=2 then p:=ilk[p]else begin r:=p;
197 count:=count+1;q:=ilk[p];p:=link[p];end;if p=0 then begin p:=q;q:=0;end;
198 end;if count<>1 then if count=0 then begin writeln(termout);
199 write(termout,'! Name does not match');error;
200 end else begin writeln(termout);write(termout,'! Ambiguous prefix');
201 error;end;prefixlookup:=r;end;{:69}{73:}
202 procedure storetwobytes(x:sixteenbits);
203 begin if tokptr[z]+2>maxtoks then begin writeln(termout);
204 write(termout,'! Sorry, ','token',' capacity exceeded');error;
205 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=x div 256;
206 tokmem[z,tokptr[z]+1]:=x mod 256;tokptr[z]:=tokptr[z]+2;end;{:73}{74:}
207 {procedure printrepl(p:textpointer);var k:0..maxtoks;a:sixteenbits;
209 begin if p>=textptr then write(termout,'BAD')else begin k:=tokstart[p];
210 zp:=p mod 3;while k<tokstart[p+3]do begin a:=tokmem[zp,k];
211 if a>=128 then[75:]begin k:=k+1;
212 if a<168 then begin a:=(a-128)*256+tokmem[zp,k];printid(a);
213 if bytemem[a mod 2,bytestart[a]]=34 then write(termout,'"')else write(
214 termout,' ');end else if a<208 then begin write(termout,'@<');
215 printid((a-168)*256+tokmem[zp,k]);write(termout,'@>');
216 end else begin a:=(a-208)*256+tokmem[zp,k];
217 write(termout,'@',xchr[123],a:1,'@',xchr[125]);end;
218 end[:75]else[76:]case a of 9:write(termout,'@',xchr[123]);
219 10:write(termout,'@',xchr[125]);12:write(termout,'@''');
220 13:write(termout,'@"');125:write(termout,'@$');0:write(termout,'#');
221 64:write(termout,'@@');2:write(termout,'@=');3:write(termout,'@\');
222 else write(termout,xchr[a])end[:76];k:=k+1;end;end;end;}{:74}{84:}
223 procedure pushlevel(p:namepointer);
224 begin if stackptr=stacksize then begin writeln(termout);
225 write(termout,'! Sorry, ','stack',' capacity exceeded');error;
226 history:=3;jumpout;end else begin stack[stackptr]:=curstate;
227 stackptr:=stackptr+1;curstate.namefield:=p;curstate.replfield:=equiv[p];
228 zo:=curstate.replfield mod 3;
229 curstate.bytefield:=tokstart[curstate.replfield];
230 curstate.endfield:=tokstart[curstate.replfield+3];curstate.modfield:=0;
231 end;end;{:84}{85:}procedure poplevel;label 10;
232 begin if textlink[curstate.replfield]=0 then begin if ilk[curstate.
233 namefield]=3 then{91:}begin nameptr:=nameptr-1;textptr:=textptr-1;
234 z:=textptr mod 3;{if tokptr[z]>maxtokptr[z]then maxtokptr[z]:=tokptr[z];
235 }tokptr[z]:=tokstart[textptr];
236 {byteptr[nameptr mod 2]:=byteptr[nameptr mod 2]-1;}end{:91};
237 end else if textlink[curstate.replfield]<maxtexts then begin curstate.
238 replfield:=textlink[curstate.replfield];zo:=curstate.replfield mod 3;
239 curstate.bytefield:=tokstart[curstate.replfield];
240 curstate.endfield:=tokstart[curstate.replfield+3];goto 10;end;
241 stackptr:=stackptr-1;if stackptr>0 then begin curstate:=stack[stackptr];
242 zo:=curstate.replfield mod 3;end;10:end;{:85}{87:}
243 function getoutput:sixteenbits;label 20,30,31;var a:sixteenbits;
244 b:eightbits;bal:sixteenbits;k:0..maxbytes;w:0..1;
245 begin 20:if stackptr=0 then begin a:=0;goto 31;end;
246 if curstate.bytefield=curstate.endfield then begin curval:=-curstate.
247 modfield;poplevel;if curval=0 then goto 20;a:=129;goto 31;end;
248 a:=tokmem[zo,curstate.bytefield];
249 curstate.bytefield:=curstate.bytefield+1;if a<128 then if a=0 then{92:}
250 begin pushlevel(nameptr-1);goto 20;end{:92}else goto 31;
251 a:=(a-128)*256+tokmem[zo,curstate.bytefield];
252 curstate.bytefield:=curstate.bytefield+1;if a<10240 then{89:}
253 begin case ilk[a]of 0:begin curval:=a;a:=130;end;
254 1:begin curval:=equiv[a]-32768;a:=128;end;2:begin pushlevel(a);goto 20;
256 while(curstate.bytefield=curstate.endfield)and(stackptr>0)do poplevel;
257 if(stackptr=0)or(tokmem[zo,curstate.bytefield]<>40)then begin begin
258 writeln(termout);write(termout,'! No parameter given for ');end;
259 printid(a);error;goto 20;end;{93:}bal:=1;
260 curstate.bytefield:=curstate.bytefield+1;
261 while true do begin b:=tokmem[zo,curstate.bytefield];
262 curstate.bytefield:=curstate.bytefield+1;
263 if b=0 then storetwobytes(nameptr+32767)else begin if b>=128 then begin
264 begin if tokptr[z]=maxtoks then begin writeln(termout);
265 write(termout,'! Sorry, ','token',' capacity exceeded');error;
266 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
267 end;b:=tokmem[zo,curstate.bytefield];
268 curstate.bytefield:=curstate.bytefield+1;
269 end else case b of 40:bal:=bal+1;41:begin bal:=bal-1;
270 if bal=0 then goto 30;end;
271 39:repeat begin if tokptr[z]=maxtoks then begin writeln(termout);
272 write(termout,'! Sorry, ','token',' capacity exceeded');error;
273 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
274 end;b:=tokmem[zo,curstate.bytefield];
275 curstate.bytefield:=curstate.bytefield+1;until b=39;else end;
276 begin if tokptr[z]=maxtoks then begin writeln(termout);
277 write(termout,'! Sorry, ','token',' capacity exceeded');error;
278 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
279 end;end;end;30:{:93};equiv[nameptr]:=textptr;ilk[nameptr]:=2;
280 w:=nameptr mod 2;k:=byteptr[w];
281 {if k=maxbytes then begin writeln(termout);
282 write(termout,'! Sorry, ','byte memory',' capacity exceeded');error;
283 history:=3;jumpout;end;bytemem[w,k]:=35;k:=k+1;byteptr[w]:=k;}
284 if nameptr>maxnames-2 then begin writeln(termout);
285 write(termout,'! Sorry, ','name',' capacity exceeded');error;history:=3;
286 jumpout;end;bytestart[nameptr+2]:=k;nameptr:=nameptr+1;
287 if textptr>maxtexts-3 then begin writeln(termout);
288 write(termout,'! Sorry, ','text',' capacity exceeded');error;history:=3;
289 jumpout;end;textlink[textptr]:=0;tokstart[textptr+3]:=tokptr[z];
290 textptr:=textptr+1;z:=textptr mod 3{:90};pushlevel(a);goto 20;end;
291 else begin writeln(termout);
292 write(termout,'! This can''t happen (','output',')');error;history:=3;
293 jumpout;end end;goto 31;end{:89};if a<20480 then{88:}begin a:=a-10240;
294 if equiv[a]<>0 then pushlevel(a)else if a<>0 then begin begin writeln(
295 termout);write(termout,'! Not present: <');end;printid(a);
296 write(termout,'>');error;end;goto 20;end{:88};curval:=a-20480;a:=129;
297 curstate.modfield:=curval;31:{if troubleshooting then debughelp;}
298 getoutput:=a;end;{:87}{97:}procedure flushbuffer;var k:0..outbufsize;
299 b:0..outbufsize;begin b:=breakptr;
300 if(semiptr<>0)and(outptr-semiptr<=linelength)then breakptr:=semiptr;
301 for k:=1 to breakptr do write(Pascalfile,xchr[outbuf[k-1]]);
302 writeln(Pascalfile);line:=line+1;
303 if line mod 100=0 then begin write(termout,'.');
304 if line mod 500=0 then write(termout,line:1);{break(termout);}end;
305 if breakptr<outptr then begin if outbuf[breakptr]=32 then begin breakptr
306 :=breakptr+1;if breakptr>b then b:=breakptr;end;
307 for k:=breakptr to outptr-1 do outbuf[k-breakptr]:=outbuf[k];end;
308 outptr:=outptr-breakptr;breakptr:=b-breakptr;semiptr:=0;
309 if outptr>linelength then begin begin writeln(termout);
310 write(termout,'! Long line must be truncated');error;end;
311 outptr:=linelength;end;end;{:97}{99:}procedure appval(v:integer);
312 var k:0..outbufsize;begin k:=outbufsize;repeat outbuf[k]:=v mod 10;
313 v:=v div 10;k:=k-1;until v=0;repeat k:=k+1;
314 begin outbuf[outptr]:=outbuf[k]+48;outptr:=outptr+1;end;
315 until k=outbufsize;end;{:99}{101:}procedure sendout(t:eightbits;
316 v:sixteenbits);label 20;var k:0..linelength;begin{102:}
317 20:case outstate of 1:if t<>3 then begin breakptr:=outptr;
318 if t=2 then begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;
319 2:begin begin outbuf[outptr]:=44-outapp;outptr:=outptr+1;end;
320 if outptr>linelength then flushbuffer;breakptr:=outptr;end;
322 if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45;
324 end else if outsign>0 then begin outbuf[outptr]:=outsign;
325 outptr:=outptr+1;end;appval(abs(outval));
326 if outptr>linelength then flushbuffer;{:103};outstate:=outstate-2;
327 goto 20;end;5:{104:}begin if(t=3)or({105:}
328 ((t=2)and(v=3)and(((outcontrib[1]=68)and(outcontrib[2]=73)and(outcontrib
329 [3]=86))or((outcontrib[1]=77)and(outcontrib[2]=79)and(outcontrib[3]=68))
330 ))or((t=0)and((v=42)or(v=47))){:105})then begin{103:}
331 if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45;
333 end else if outsign>0 then begin outbuf[outptr]:=outsign;
334 outptr:=outptr+1;end;appval(abs(outval));
335 if outptr>linelength then flushbuffer;{:103};outsign:=43;outval:=outapp;
336 end else outval:=outval+outapp;outstate:=3;goto 20;end{:104};
337 0:if t<>3 then breakptr:=outptr;else end{:102};
338 if t<>0 then for k:=1 to v do begin outbuf[outptr]:=outcontrib[k];
339 outptr:=outptr+1;end else begin outbuf[outptr]:=v;outptr:=outptr+1;end;
340 if outptr>linelength then flushbuffer;
341 if(t=0)and((v=59)or(v=125))then begin semiptr:=outptr;breakptr:=outptr;
342 end;if t>=2 then outstate:=1 else outstate:=0 end;{:101}{106:}
343 procedure sendsign(v:integer);
344 begin case outstate of 2,4:outapp:=outapp*v;3:begin outapp:=v;
345 outstate:=4;end;5:begin outval:=outval+outapp;outapp:=v;outstate:=4;end;
346 else begin breakptr:=outptr;outapp:=v;outstate:=2;end end;
347 lastsign:=outapp;end;{:106}{107:}procedure sendval(v:integer);
348 label 666,10;begin case outstate of 1:begin{110:}
349 if(outptr=breakptr+3)or((outptr=breakptr+4)and(outbuf[breakptr]=32))then
350 if((outbuf[outptr-3]=68)and(outbuf[outptr-2]=73)and(outbuf[outptr-1]=86)
351 )or((outbuf[outptr-3]=77)and(outbuf[outptr-2]=79)and(outbuf[outptr-1]=68
352 ))then goto 666{:110};outsign:=32;outstate:=3;outval:=v;
353 breakptr:=outptr;lastsign:=+1;end;0:begin{109:}
354 if(outptr=breakptr+1)and((outbuf[breakptr]=42)or(outbuf[breakptr]=47))
355 then goto 666{:109};outsign:=0;outstate:=3;outval:=v;breakptr:=outptr;
356 lastsign:=+1;end;{108:}2:begin outsign:=43;outstate:=3;outval:=outapp*v;
357 end;3:begin outstate:=5;outapp:=v;begin writeln(termout);
358 write(termout,'! Two numbers occurred without a sign between them');
359 error;end;end;4:begin outstate:=5;outapp:=outapp*v;end;
360 5:begin outval:=outval+outapp;outapp:=v;begin writeln(termout);
361 write(termout,'! Two numbers occurred without a sign between them');
362 error;end;end;{:108}else goto 666 end;goto 10;666:{111:}
363 if v>=0 then begin if outstate=1 then begin breakptr:=outptr;
364 begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;appval(v);
365 if outptr>linelength then flushbuffer;outstate:=1;
366 end else begin begin outbuf[outptr]:=40;outptr:=outptr+1;end;
367 begin outbuf[outptr]:=45;outptr:=outptr+1;end;appval(-v);
368 begin outbuf[outptr]:=41;outptr:=outptr+1;end;
369 if outptr>linelength then flushbuffer;outstate:=0;end{:111};10:end;
370 {:107}{113:}procedure sendtheoutput;label 2,21,22;var curchar:eightbits;
371 k:0..linelength;j:0..maxbytes;w:0..1;n:integer;
372 begin while stackptr>0 do begin curchar:=getoutput;
373 21:case curchar of 0:;{116:}
374 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,
375 89,90:begin outcontrib[1]:=curchar;sendout(2,1);end;
376 97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115
377 ,116,117,118,119,120,121,122:begin outcontrib[1]:=curchar-32;
378 sendout(2,1);end;130:begin k:=0;j:=bytestart[curval];w:=curval mod 2;
379 while(k<maxidlength)and(j<bytestart[curval+2])do begin k:=k+1;
380 outcontrib[k]:=bytemem[w,j];j:=j+1;
381 if outcontrib[k]>=97 then outcontrib[k]:=outcontrib[k]-32 else if
382 outcontrib[k]=95 then k:=k-1;end;sendout(2,k);end;{:116}{119:}
383 48,49,50,51,52,53,54,55,56,57:begin n:=0;repeat curchar:=curchar-48;
384 if n>=214748364 then begin writeln(termout);
385 write(termout,'! Constant too big');error;end else n:=10*n+curchar;
386 curchar:=getoutput;until(curchar>57)or(curchar<48);sendval(n);k:=0;
387 if curchar=101 then curchar:=69;if curchar=69 then goto 2 else goto 21;
388 end;125:sendval(poolchecksum);12:begin n:=0;curchar:=48;
389 repeat curchar:=curchar-48;if n>=268435456 then begin writeln(termout);
390 write(termout,'! Constant too big');error;end else n:=8*n+curchar;
391 curchar:=getoutput;until(curchar>55)or(curchar<48);sendval(n);goto 21;
392 end;13:begin n:=0;curchar:=48;
393 repeat if curchar>=65 then curchar:=curchar-55 else curchar:=curchar-48;
394 if n>=134217728 then begin writeln(termout);
395 write(termout,'! Constant too big');error;end else n:=16*n+curchar;
397 until(curchar>70)or(curchar<48)or((curchar>57)and(curchar<65));
398 sendval(n);goto 21;end;128:sendval(curval);46:begin k:=1;
399 outcontrib[1]:=46;curchar:=getoutput;
400 if curchar=46 then begin outcontrib[2]:=46;sendout(1,2);
401 end else if(curchar>=48)and(curchar<=57)then goto 2 else begin sendout(0
402 ,46);goto 21;end;end;{:119}43,45:sendsign(44-curchar);{114:}
403 4:begin outcontrib[1]:=65;outcontrib[2]:=78;outcontrib[3]:=68;
404 sendout(2,3);end;5:begin outcontrib[1]:=78;outcontrib[2]:=79;
405 outcontrib[3]:=84;sendout(2,3);end;6:begin outcontrib[1]:=73;
406 outcontrib[2]:=78;sendout(2,2);end;31:begin outcontrib[1]:=79;
407 outcontrib[2]:=82;sendout(2,2);end;24:begin outcontrib[1]:=58;
408 outcontrib[2]:=61;sendout(1,2);end;26:begin outcontrib[1]:=60;
409 outcontrib[2]:=62;sendout(1,2);end;28:begin outcontrib[1]:=60;
410 outcontrib[2]:=61;sendout(1,2);end;29:begin outcontrib[1]:=62;
411 outcontrib[2]:=61;sendout(1,2);end;30:begin outcontrib[1]:=61;
412 outcontrib[2]:=61;sendout(1,2);end;32:begin outcontrib[1]:=46;
413 outcontrib[2]:=46;sendout(1,2);end;{:114}39:{117:}begin k:=1;
414 outcontrib[1]:=39;repeat if k<linelength then k:=k+1;
415 outcontrib[k]:=getoutput;until(outcontrib[k]=39)or(stackptr=0);
416 if k=linelength then begin writeln(termout);
417 write(termout,'! String too long');error;end;sendout(1,k);
418 curchar:=getoutput;if curchar=39 then outstate:=6;goto 21;end{:117};
420 33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,95,96,
421 123,124{:115}:sendout(0,curchar);{121:}
422 9:begin if bracelevel=0 then sendout(0,123)else sendout(0,91);
423 bracelevel:=bracelevel+1;end;
424 10:if bracelevel>0 then begin bracelevel:=bracelevel-1;
425 if bracelevel=0 then sendout(0,125)else sendout(0,93);
426 end else begin writeln(termout);write(termout,'! Extra @}');error;end;
427 129:begin if bracelevel=0 then sendout(0,123)else sendout(0,91);
428 if curval<0 then begin sendout(0,58);sendval(-curval);
429 end else begin sendval(curval);sendout(0,58);end;
430 if bracelevel=0 then sendout(0,125)else sendout(0,93);end;{:121}
431 127:begin sendout(3,0);outstate:=6;end;2:{118:}begin k:=0;
432 repeat if k<linelength then k:=k+1;outcontrib[k]:=getoutput;
433 until(outcontrib[k]=2)or(stackptr=0);
434 if k=linelength then begin writeln(termout);
435 write(termout,'! Verbatim string too long');error;end;sendout(1,k-1);
436 end{:118};3:{122:}begin sendout(1,0);
437 while outptr>0 do begin if outptr<=linelength then breakptr:=outptr;
438 flushbuffer;end;outstate:=0;end{:122};else begin writeln(termout);
439 write(termout,'! Can''t output ASCII code ',curchar:1);error;end end;
440 goto 22;2:{120:}repeat if k<linelength then k:=k+1;
441 outcontrib[k]:=curchar;curchar:=getoutput;
442 if(outcontrib[k]=69)and((curchar=43)or(curchar=45))then begin if k<
443 linelength then k:=k+1;outcontrib[k]:=curchar;curchar:=getoutput;
444 end else if curchar=101 then curchar:=69;
445 until(curchar<>69)and((curchar<48)or(curchar>57));
446 if k=linelength then begin writeln(termout);
447 write(termout,'! Fraction too long');error;end;sendout(3,k);
448 goto 21{:120};22:end;end;{:113}{127:}function linesdontmatch:boolean;
449 label 10;var k:0..bufsize;begin linesdontmatch:=true;
450 if changelimit<>limit then goto 10;
451 if limit>0 then for k:=0 to limit-1 do if changebuffer[k]<>buffer[k]then
452 goto 10;linesdontmatch:=false;10:end;{:127}{128:}
453 procedure primethechangebuffer;label 22,30,10;var k:0..bufsize;
454 begin changelimit:=0;{129:}while true do begin line:=line+1;
455 if not inputln(changefile)then goto 10;if limit<2 then goto 22;
456 if buffer[0]<>64 then goto 22;
457 if(buffer[1]>=88)and(buffer[1]<=90)then buffer[1]:=buffer[1]+32;
458 if buffer[1]=120 then goto 30;
459 if(buffer[1]=121)or(buffer[1]=122)then begin loc:=2;
460 begin writeln(termout);write(termout,'! Where is the matching @x?');
461 error;end;end;22:end;30:{:129};{130:}repeat line:=line+1;
462 if not inputln(changefile)then begin begin writeln(termout);
463 write(termout,'! Change file ended after @x');error;end;goto 10;end;
464 until limit>0;{:130};{131:}begin changelimit:=limit;
465 if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k];
466 end{:131};10:end;{:128}{132:}procedure checkchange;label 10;
467 var n:integer;k:0..bufsize;begin if linesdontmatch then goto 10;n:=0;
468 while true do begin changing:=not changing;templine:=otherline;
469 otherline:=line;line:=templine;line:=line+1;
470 if not inputln(changefile)then begin begin writeln(termout);
471 write(termout,'! Change file ended before @y');error;end;changelimit:=0;
472 changing:=not changing;templine:=otherline;otherline:=line;
473 line:=templine;goto 10;end;{133:}
474 if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1
475 ]<=90)then buffer[1]:=buffer[1]+32;
476 if(buffer[1]=120)or(buffer[1]=122)then begin loc:=2;
477 begin writeln(termout);write(termout,'! Where is the matching @y?');
478 error;end;end else if buffer[1]=121 then begin if n>0 then begin loc:=2;
479 begin writeln(termout);
480 write(termout,'! Hmm... ',n:1,' of the preceding lines failed to match')
481 ;error;end;end;goto 10;end;end{:133};{131:}begin changelimit:=limit;
482 if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k];
483 end{:131};changing:=not changing;templine:=otherline;otherline:=line;
484 line:=templine;line:=line+1;
485 if not inputln(webfile)then begin begin writeln(termout);
486 write(termout,'! WEB file ended during a change');error;end;
487 inputhasended:=true;goto 10;end;if linesdontmatch then n:=n+1;end;
488 10:end;{:132}{135:}procedure getline;label 20;
489 begin 20:if changing then{137:}begin line:=line+1;
490 if not inputln(changefile)then begin begin writeln(termout);
491 write(termout,'! Change file ended without @z');error;end;buffer[0]:=64;
492 buffer[1]:=122;limit:=2;end;
493 if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1
494 ]<=90)then buffer[1]:=buffer[1]+32;
495 if(buffer[1]=120)or(buffer[1]=121)then begin loc:=2;
496 begin writeln(termout);write(termout,'! Where is the matching @z?');
497 error;end;end else if buffer[1]=122 then begin primethechangebuffer;
498 changing:=not changing;templine:=otherline;otherline:=line;
499 line:=templine;end;end;end{:137};if not changing then begin{136:}
501 if not inputln(webfile)then inputhasended:=true else if limit=
502 changelimit then if buffer[0]=changebuffer[0]then if changelimit>0 then
503 checkchange;end{:136};if changing then goto 20;end;loc:=0;
504 buffer[limit]:=32;end;{:135}{139:}
505 function controlcode(c:ASCIIcode):eightbits;
506 begin case c of 64:controlcode:=64;39:controlcode:=12;
507 34:controlcode:=13;36:controlcode:=125;32,9:controlcode:=136;
508 42:begin write(termout,'*',modulecount+1:1);{break(termout);}
509 controlcode:=136;end;68,100:controlcode:=133;70,102:controlcode:=132;
510 123:controlcode:=9;125:controlcode:=10;80,112:controlcode:=134;
511 84,116,94,46,58:controlcode:=131;38:controlcode:=127;
512 60:controlcode:=135;61:controlcode:=2;92:controlcode:=3;
513 else controlcode:=0 end;end;{:139}{140:}function skipahead:eightbits;
514 label 30;var c:eightbits;
515 begin while true do begin if loc>limit then begin getline;
516 if inputhasended then begin c:=136;goto 30;end;end;buffer[limit+1]:=64;
517 while buffer[loc]<>64 do loc:=loc+1;if loc<=limit then begin loc:=loc+2;
518 c:=controlcode(buffer[loc-1]);if(c<>0)or(buffer[loc-1]=62)then goto 30;
519 end;end;30:skipahead:=c;end;{:140}{141:}procedure skipcomment;label 10;
520 var bal:eightbits;c:ASCIIcode;begin bal:=0;
521 while true do begin if loc>limit then begin getline;
522 if inputhasended then begin begin writeln(termout);
523 write(termout,'! Input ended in mid-comment');error;end;goto 10;end;end;
524 c:=buffer[loc];loc:=loc+1;{142:}if c=64 then begin c:=buffer[loc];
525 if(c<>32)and(c<>9)and(c<>42)and(c<>122)and(c<>90)then loc:=loc+1 else
526 begin begin writeln(termout);
527 write(termout,'! Section ended in mid-comment');error;end;loc:=loc-1;
529 end end else if(c=92)and(buffer[loc]<>64)then loc:=loc+1 else if c=123
530 then bal:=bal+1 else if c=125 then begin if bal=0 then goto 10;
531 bal:=bal-1;end{:142};end;10:end;{:141}{145:}function getnext:eightbits;
532 label 20,30,31;var c:eightbits;d:eightbits;j,k:0..longestname;
533 begin 20:if loc>limit then begin getline;
534 if inputhasended then begin c:=136;goto 31;end;end;c:=buffer[loc];
535 loc:=loc+1;if scanninghex then{146:}
536 if((c>=48)and(c<=57))or((c>=65)and(c<=70))then goto 31 else scanninghex
538 case c of 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
539 ,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
540 ,112,113,114,115,116,117,118,119,120,121,122:{148:}
541 begin if((c=101)or(c=69))and(loc>1)then if(buffer[loc-2]<=57)and(buffer[
542 loc-2]>=48)then c:=0;if c<>0 then begin loc:=loc-1;idfirst:=loc;
543 repeat loc:=loc+1;d:=buffer[loc];
544 until((d<48)or((d>57)and(d<65))or((d>90)and(d<97))or(d>122))and(d<>95);
545 if loc>idfirst+1 then begin c:=130;idloc:=loc;end;end else c:=69;
546 end{:148};34:{149:}begin doublechars:=0;idfirst:=loc-1;
547 repeat d:=buffer[loc];loc:=loc+1;
548 if(d=34)or(d=64)then if buffer[loc]=d then begin loc:=loc+1;d:=0;
549 doublechars:=doublechars+1;
550 end else begin if d=64 then begin writeln(termout);
551 write(termout,'! Double @ sign missing');error;
552 end end else if loc>limit then begin begin writeln(termout);
553 write(termout,'! String constant didn''t end');error;end;d:=34;end;
554 until d=34;idloc:=loc-1;c:=130;end{:149};64:{150:}
555 begin c:=controlcode(buffer[loc]);loc:=loc+1;
556 if c=0 then goto 20 else if c=13 then scanninghex:=true else if c=135
557 then{151:}begin{153:}k:=0;
558 while true do begin if loc>limit then begin getline;
559 if inputhasended then begin begin writeln(termout);
560 write(termout,'! Input ended in section name');error;end;goto 30;end;
561 end;d:=buffer[loc];{154:}if d=64 then begin d:=buffer[loc+1];
562 if d=62 then begin loc:=loc+2;goto 30;end;
563 if(d=32)or(d=9)or(d=42)then begin begin writeln(termout);
564 write(termout,'! Section name didn''t end');error;end;goto 30;end;
565 k:=k+1;modtext[k]:=64;loc:=loc+1;end{:154};loc:=loc+1;
566 if k<longestname-1 then k:=k+1;if(d=32)or(d=9)then begin d:=32;
567 if modtext[k-1]=32 then k:=k-1;end;modtext[k]:=d;end;30:{155:}
568 if k>=longestname-2 then begin begin writeln(termout);
569 write(termout,'! Section name too long: ');end;
570 for j:=1 to 25 do write(termout,xchr[modtext[j]]);write(termout,'...');
571 if history=0 then history:=1;end{:155};
572 if(modtext[k]=32)and(k>0)then k:=k-1;{:153};
573 if k>3 then begin if(modtext[k]=46)and(modtext[k-1]=46)and(modtext[k-2]=
574 46)then curmodule:=prefixlookup(k-3)else curmodule:=modlookup(k);
575 end else curmodule:=modlookup(k);end{:151}
576 else if c=131 then begin repeat c:=skipahead;until c<>64;
577 if buffer[loc-1]<>62 then begin writeln(termout);
578 write(termout,'! Improper @ within control text');error;end;goto 20;end;
580 46:if buffer[loc]=46 then begin if loc<=limit then begin c:=32;
582 end else if buffer[loc]=41 then begin if loc<=limit then begin c:=93;
584 58:if buffer[loc]=61 then begin if loc<=limit then begin c:=24;
586 61:if buffer[loc]=61 then begin if loc<=limit then begin c:=30;
588 62:if buffer[loc]=61 then begin if loc<=limit then begin c:=29;
590 60:if buffer[loc]=61 then begin if loc<=limit then begin c:=28;
592 end else if buffer[loc]=62 then begin if loc<=limit then begin c:=26;
594 40:if buffer[loc]=42 then begin if loc<=limit then begin c:=9;
596 end else if buffer[loc]=46 then begin if loc<=limit then begin c:=91;
598 42:if buffer[loc]=41 then begin if loc<=limit then begin c:=10;
599 loc:=loc+1;end;end;{:147}32,9:goto 20;123:begin skipcomment;goto 20;end;
600 125:begin begin writeln(termout);write(termout,'! Extra }');error;end;
601 goto 20;end;else if c>=128 then goto 20 else end;
602 31:{if troubleshooting then debughelp;}getnext:=c;end;{:145}{157:}
603 procedure scannumeric(p:namepointer);label 21,30;
604 var accumulator:integer;nextsign:-1..+1;q:namepointer;val:integer;
605 begin{158:}accumulator:=0;nextsign:=+1;
606 while true do begin nextcontrol:=getnext;
607 21:case nextcontrol of 48,49,50,51,52,53,54,55,56,57:begin{160:}val:=0;
608 repeat val:=10*val+nextcontrol-48;nextcontrol:=getnext;
609 until(nextcontrol>57)or(nextcontrol<48){:160};
610 begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21;
611 end;12:begin{161:}val:=0;nextcontrol:=48;
612 repeat val:=8*val+nextcontrol-48;nextcontrol:=getnext;
613 until(nextcontrol>55)or(nextcontrol<48){:161};
614 begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21;
615 end;13:begin{162:}val:=0;nextcontrol:=48;
616 repeat if nextcontrol>=65 then nextcontrol:=nextcontrol-7;
617 val:=16*val+nextcontrol-48;nextcontrol:=getnext;
618 until(nextcontrol>70)or(nextcontrol<48)or((nextcontrol>57)and(
619 nextcontrol<65)){:162};begin accumulator:=accumulator+nextsign*(val);
620 nextsign:=+1;end;goto 21;end;130:begin q:=idlookup(0);
621 if ilk[q]<>1 then begin nextcontrol:=42;goto 21;end;
622 begin accumulator:=accumulator+nextsign*(equiv[q]-32768);nextsign:=+1;
623 end;end;43:;45:nextsign:=-nextsign;132,133,135,134,136:goto 30;
624 59:begin writeln(termout);
625 write(termout,'! Omit semicolon in numeric definition');error;end;
626 else {159:}begin begin writeln(termout);
627 write(termout,'! Improper numeric definition will be flushed');error;
628 end;repeat nextcontrol:=skipahead until(nextcontrol>=132);
629 if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;end;
630 accumulator:=0;goto 30;end{:159}end;end;30:{:158};
631 if abs(accumulator)>=32768 then begin begin writeln(termout);
632 write(termout,'! Value too big: ',accumulator:1);error;end;
633 accumulator:=0;end;equiv[p]:=accumulator+32768;end;{:157}{165:}
634 procedure scanrepl(t:eightbits);label 22,30,31,21;var a:sixteenbits;
635 b:ASCIIcode;bal:eightbits;begin bal:=0;
636 while true do begin 22:a:=getnext;case a of 40:bal:=bal+1;
637 41:if bal=0 then begin writeln(termout);write(termout,'! Extra )');
638 error;end else bal:=bal-1;39:{168:}begin b:=39;
639 while true do begin begin if tokptr[z]=maxtoks then begin writeln(
640 termout);write(termout,'! Sorry, ','token',' capacity exceeded');error;
641 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
642 end;if b=64 then if buffer[loc]=64 then loc:=loc+1 else begin writeln(
643 termout);write(termout,'! You should double @ signs in strings');error;
644 end;if loc=limit then begin begin writeln(termout);
645 write(termout,'! String didn''t end');error;end;buffer[loc]:=39;
646 buffer[loc+1]:=0;end;b:=buffer[loc];loc:=loc+1;
647 if b=39 then begin if buffer[loc]<>39 then goto 31 else begin loc:=loc+1
648 ;begin if tokptr[z]=maxtoks then begin writeln(termout);
649 write(termout,'! Sorry, ','token',' capacity exceeded');error;
650 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=39;tokptr[z]:=tokptr[z]+1;
651 end;end;end;end;31:end{:168};35:if t=3 then a:=0;{167:}
652 130:begin a:=idlookup(0);
653 begin if tokptr[z]=maxtoks then begin writeln(termout);
654 write(termout,'! Sorry, ','token',' capacity exceeded');error;
655 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=(a div 256)+128;
656 tokptr[z]:=tokptr[z]+1;end;a:=a mod 256;end;
657 135:if t<>135 then goto 30 else begin begin if tokptr[z]=maxtoks then
658 begin writeln(termout);
659 write(termout,'! Sorry, ','token',' capacity exceeded');error;
660 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=(curmodule div 256)+168;
661 tokptr[z]:=tokptr[z]+1;end;a:=curmodule mod 256;end;2:{169:}
662 begin begin if tokptr[z]=maxtoks then begin writeln(termout);
663 write(termout,'! Sorry, ','token',' capacity exceeded');error;
664 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=2;tokptr[z]:=tokptr[z]+1;
665 end;buffer[limit+1]:=64;
666 21:if buffer[loc]=64 then begin if loc<limit then if buffer[loc+1]=64
667 then begin begin if tokptr[z]=maxtoks then begin writeln(termout);
668 write(termout,'! Sorry, ','token',' capacity exceeded');error;
669 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=64;tokptr[z]:=tokptr[z]+1;
670 end;loc:=loc+2;goto 21;end;
671 end else begin begin if tokptr[z]=maxtoks then begin writeln(termout);
672 write(termout,'! Sorry, ','token',' capacity exceeded');error;
673 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=buffer[loc];
674 tokptr[z]:=tokptr[z]+1;end;loc:=loc+1;goto 21;end;
675 if loc>=limit then begin writeln(termout);
676 write(termout,'! Verbatim string didn''t end');error;
677 end else if buffer[loc+1]<>62 then begin writeln(termout);
678 write(termout,'! You should double @ signs in verbatim strings');error;
679 end;loc:=loc+2;end{:169};
680 133,132,134:if t<>135 then goto 30 else begin begin writeln(termout);
681 write(termout,'! @',xchr[buffer[loc-1]],' is ignored in Pascal text');
682 error;end;goto 22;end;136:goto 30;{:167}else end;
683 begin if tokptr[z]=maxtoks then begin writeln(termout);
684 write(termout,'! Sorry, ','token',' capacity exceeded');error;
685 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=a;tokptr[z]:=tokptr[z]+1;
686 end;end;30:nextcontrol:=a;{166:}
687 if bal>0 then begin if bal=1 then begin writeln(termout);
688 write(termout,'! Missing )');error;end else begin writeln(termout);
689 write(termout,'! Missing ',bal:1,' )''s');error;end;
690 while bal>0 do begin begin if tokptr[z]=maxtoks then begin writeln(
691 termout);write(termout,'! Sorry, ','token',' capacity exceeded');error;
692 history:=3;jumpout;end;tokmem[z,tokptr[z]]:=41;tokptr[z]:=tokptr[z]+1;
693 end;bal:=bal-1;end;end{:166};
694 if textptr>maxtexts-3 then begin writeln(termout);
695 write(termout,'! Sorry, ','text',' capacity exceeded');error;history:=3;
696 jumpout;end;currepltext:=textptr;tokstart[textptr+3]:=tokptr[z];
697 textptr:=textptr+1;if z=2 then z:=0 else z:=z+1;end;{:165}{170:}
698 procedure definemacro(t:eightbits);var p:namepointer;
699 begin p:=idlookup(t);scanrepl(t);equiv[p]:=currepltext;
700 textlink[currepltext]:=0;end;{:170}{172:}procedure scanmodule;
701 label 22,30,10;var p:namepointer;begin modulecount:=modulecount+1;{173:}
703 while true do begin 22:while nextcontrol<=132 do begin nextcontrol:=
704 skipahead;if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;
705 end;end;if nextcontrol<>133 then goto 30;nextcontrol:=getnext;
706 if nextcontrol<>130 then begin begin writeln(termout);
707 write(termout,'! Definition flushed, must start with ',
708 'identifier of length > 1');error;end;goto 22;end;nextcontrol:=getnext;
709 if nextcontrol=61 then begin scannumeric(idlookup(1));goto 22;
710 end else if nextcontrol=30 then begin definemacro(2);goto 22;
711 end else{174:}if nextcontrol=40 then begin nextcontrol:=getnext;
712 if nextcontrol=35 then begin nextcontrol:=getnext;
713 if nextcontrol=41 then begin nextcontrol:=getnext;
714 if nextcontrol=61 then begin begin writeln(termout);
715 write(termout,'! Use == for macros');error;end;nextcontrol:=30;end;
716 if nextcontrol=30 then begin definemacro(3);goto 22;end;end;end;end;
717 {:174};begin writeln(termout);
718 write(termout,'! Definition flushed since it starts badly');error;end;
719 end;30:{:173};{175:}case nextcontrol of 134:p:=0;135:begin p:=curmodule;
720 {176:}repeat nextcontrol:=getnext;until nextcontrol<>43;
721 if(nextcontrol<>61)and(nextcontrol<>30)then begin begin writeln(termout)
722 ;write(termout,'! Pascal text flushed, = sign is missing');error;end;
723 repeat nextcontrol:=skipahead;until nextcontrol=136;goto 10;end{:176};
724 end;else goto 10 end;{177:}storetwobytes(53248+modulecount);{:177};
726 if p=0 then begin textlink[lastunnamed]:=currepltext;
727 lastunnamed:=currepltext;
728 end else if equiv[p]=0 then equiv[p]:=currepltext else begin p:=equiv[p]
729 ;while textlink[p]<maxtexts do p:=textlink[p];textlink[p]:=currepltext;
730 end;textlink[currepltext]:=maxtexts;{:178};{:175};10:end;{:172}{181:}
731 {procedure debughelp;label 888,10;var k:integer;
732 begin debugskipped:=debugskipped+1;
733 if debugskipped<debugcycle then goto 10;debugskipped:=0;
734 while true do begin write(termout,'#');break(termout);read(termin,ddt);
735 if ddt<0 then goto 10 else if ddt=0 then begin goto 888;
737 end else begin read(termin,dd);case ddt of 1:printid(dd);
738 2:printrepl(dd);3:for k:=1 to dd do write(termout,xchr[buffer[k]]);
739 4:for k:=1 to dd do write(termout,xchr[modtext[k]]);
740 5:for k:=1 to outptr do write(termout,xchr[outbuf[k]]);
741 6:for k:=1 to dd do write(termout,xchr[outcontrib[k]]);
742 else write(termout,'?')end;end;end;10:end;}{:181}{182:}
743 begin initialize;{134:}openinput;line:=0;otherline:=0;changing:=true;
744 primethechangebuffer;changing:=not changing;templine:=otherline;
745 otherline:=line;line:=templine;limit:=0;loc:=1;buffer[0]:=32;
746 inputhasended:=false;{:134};
747 writeln(termout,'This is TANGLE, Version 4.4');{183:}phaseone:=true;
748 modulecount:=0;repeat nextcontrol:=skipahead;until nextcontrol=136;
749 while not inputhasended do scanmodule;{138:}
750 if changelimit<>0 then begin for ii:=0 to changelimit do buffer[ii]:=
751 changebuffer[ii];limit:=changelimit;changing:=true;line:=otherline;
752 loc:=changelimit;begin writeln(termout);
753 write(termout,'! Change file entry did not match');error;end;end{:138};
754 phaseone:=false;{:183};{for ii:=0 to 2 do maxtokptr[ii]:=tokptr[ii];}
755 {112:}if textlink[0]=0 then begin begin writeln(termout);
756 write(termout,'! No output was specified.');end;
757 if history=0 then history:=1;end else begin begin writeln(termout);
758 write(termout,'Writing the output file');end;{break(termout);}{83:}
759 stackptr:=1;bracelevel:=0;curstate.namefield:=0;
760 curstate.replfield:=textlink[0];zo:=curstate.replfield mod 3;
761 curstate.bytefield:=tokstart[curstate.replfield];
762 curstate.endfield:=tokstart[curstate.replfield+3];curstate.modfield:=0;
763 {:83};{96:}outstate:=0;outptr:=0;breakptr:=0;semiptr:=0;outbuf[0]:=0;
764 line:=1;{:96};sendtheoutput;{98:}breakptr:=outptr;semiptr:=0;
765 flushbuffer;if bracelevel<>0 then begin writeln(termout);
766 write(termout,'! Program ended at brace level ',bracelevel:1);error;end;
767 {:98};begin writeln(termout);write(termout,'Done.');end;end{:112};
768 9999:if stringptr>256 then{184:}begin begin writeln(termout);
769 write(termout,stringptr-256:1,' strings written to string pool file.');
771 for ii:=1 to 9 do begin outbuf[ii]:=poolchecksum mod 10;
772 poolchecksum:=poolchecksum div 10;end;
773 for ii:=9 downto 1 do write(pool,xchr[48+outbuf[ii]]);writeln(pool);
774 end{:184};{[186:]begin writeln(termout);
775 write(termout,'Memory usage statistics:');end;begin writeln(termout);
776 write(termout,nameptr:1,' names, ',textptr:1,' replacement texts;');end;
777 begin writeln(termout);write(termout,byteptr[0]:1);end;
778 for wo:=1 to 1 do write(termout,'+',byteptr[wo]:1);
779 if phaseone then for ii:=0 to 2 do maxtokptr[ii]:=tokptr[ii];
780 write(termout,' bytes, ',maxtokptr[0]:1);
781 for ii:=1 to 2 do write(termout,'+',maxtokptr[ii]:1);
782 write(termout,' tokens.');[:186];}{187:}
783 case history of 0:begin writeln(termout);
784 write(termout,'(No errors were found.)');end;1:begin writeln(termout);
785 write(termout,'(Did you see the warning message above?)');end;
786 2:begin writeln(termout);
787 write(termout,'(Pardon me, but I think I spotted something wrong.)');
788 end;3:begin writeln(termout);
789 write(termout,'(That was a fatal error, my friend.)');end;end{:187};
projects / nestedvm.git / blob