{2:}{4:}{$C-,A+,D-}{[$C+,D+]}{:4}
PROGRAM TANGLE(WEB←FILE,CHANGE←FILE,PASCAL←FILE,POOL);LABEL 9999;
CONST{8:}BUF←SIZE=5000;MAX←BYTES=45000;MAX←TOKS=50000;MAX←NAMES=4000;
MAX←TEXTS=2000;HASH←SIZE=353;LONGEST←NAME=400;LINE←LENGTH=72;
OUT←BUF←SIZE=144;STACK←SIZE=50;MAX←ID←LENGTH=72;UNAMBIG←LENGTH=12;{:8}
TYPE{11:}ASCII←CODE=0..127;{:11}{12:}TEXT←FILE=PACKED FILE OF CHAR;{:12}
{37:}EIGHT←BITS=0..255;SIXTEEN←BITS=0..65535;{:37}{39:}
NAME←POINTER=0..MAX←NAMES;{:39}{43:}TEXT←POINTER=0..MAX←TEXTS;{:43}{78:}
OUTPUT←STATE=RECORD END←FIELD:SIXTEEN←BITS;BYTE←FIELD:SIXTEEN←BITS;
NAME←FIELD:NAME←POINTER;REPL←FIELD:TEXT←POINTER;MOD←FIELD:0..12287;END;
{:78}VAR{9:}HISTORY:0..3;{:9}{13:}XORD:ARRAY[CHAR]OF ASCII←CODE;
XCHR:ARRAY[ASCII←CODE]OF CHAR;{:13}{20:}TERM←OUT:TEXT←FILE;{:20}{23:}
WEB←FILE:TEXT←FILE;CHANGE←FILE:TEXT←FILE;{:23}{25:}
PASCAL←FILE:TEXT←FILE;POOL:TEXT←FILE;{:25}{27:}
BUFFER:ARRAY[0..BUF←SIZE]OF ASCII←CODE;{:27}{29:}PHASE←ONE:BOOLEAN;{:29}
{38:}BYTE←MEM:PACKED ARRAY[0..1,0..MAX←BYTES]OF ASCII←CODE;
TOK←MEM:PACKED ARRAY[0..2,0..MAX←TOKS]OF EIGHT←BITS;
BYTE←START:ARRAY[0..MAX←NAMES]OF SIXTEEN←BITS;
TOK←START:ARRAY[0..MAX←TEXTS]OF SIXTEEN←BITS;
LINK:ARRAY[0..MAX←NAMES]OF SIXTEEN←BITS;
ILK:ARRAY[0..MAX←NAMES]OF SIXTEEN←BITS;
EQUIV:ARRAY[0..MAX←NAMES]OF SIXTEEN←BITS;
TEXT←LINK:ARRAY[0..MAX←TEXTS]OF SIXTEEN←BITS;{:38}{40:}
NAME←PTR:NAME←POINTER;STRING←PTR:NAME←POINTER;
BYTE←PTR:ARRAY[0..1]OF 0..MAX←BYTES;POOL←CHECK←SUM:INTEGER;{:40}{44:}
TEXT←PTR:TEXT←POINTER;TOK←PTR:ARRAY[0..2]OF 0..MAX←TOKS;Z:0..2;
{MAX←TOK←PTR:ARRAY[0..2]OF 0..MAX←TOKS;}{:44}{50:}ID←FIRST:0..BUF←SIZE;
ID←LOC:0..BUF←SIZE;DOUBLE←CHARS:0..BUF←SIZE;
HASH,CHOP←HASH:ARRAY[0..HASH←SIZE]OF SIXTEEN←BITS;
CHOPPED←ID:ARRAY[0..UNAMBIG←LENGTH]OF ASCII←CODE;{:50}{65:}
MOD←TEXT:ARRAY[0..LONGEST←NAME]OF ASCII←CODE;{:65}{70:}
LAST←UNNAMED:TEXT←POINTER;{:70}{79:}CUR←STATE:OUTPUT←STATE;
STACK:ARRAY[1..STACK←SIZE]OF OUTPUT←STATE;STACK←PTR:0..STACK←SIZE;{:79}
{80:}ZO:0..2;{:80}{82:}BRACE←LEVEL:EIGHT←BITS;{:82}{86:}CUR←VAL:INTEGER;
{:86}{94:}OUT←BUF:ARRAY[0..OUT←BUF←SIZE]OF ASCII←CODE;
OUT←PTR:0..OUT←BUF←SIZE;BREAK←PTR:0..OUT←BUF←SIZE;
SEMI←PTR:0..OUT←BUF←SIZE;{:94}{95:}OUT←STATE:EIGHT←BITS;
OUT←VAL,OUT←APP:INTEGER;OUT←SIGN:ASCII←CODE;LAST←SIGN:-1..+1;{:95}{100:}
OUT←CONTRIB:ARRAY[1..LINE←LENGTH]OF ASCII←CODE;{:100}{124:}LINE:INTEGER;
OTHER←LINE:INTEGER;TEMP←LINE:INTEGER;LIMIT:0..BUF←SIZE;LOC:0..BUF←SIZE;
INPUT←HAS←ENDED:BOOLEAN;CHANGING:BOOLEAN;{:124}{126:}
CHANGE←BUFFER:ARRAY[0..BUF←SIZE]OF ASCII←CODE;CHANGE←LIMIT:0..BUF←SIZE;
{:126}{143:}CUR←MODULE:NAME←POINTER;SCANNING←HEX:BOOLEAN;{:143}{156:}
NEXT←CONTROL:EIGHT←BITS;{:156}{164:}CUR←REPL←TEXT:TEXT←POINTER;{:164}
{171:}MODULE←COUNT:0..12287;{:171}{179:}{TROUBLE←SHOOTING:BOOLEAN;
DDT:INTEGER;DD:INTEGER;DEBUG←CYCLE:INTEGER;DEBUG←SKIPPED:INTEGER;
TERM←IN:TEXT←FILE;}{:179}{185:}{WO:0..1;}{:185}{188:}
PROCEDURE TTY←RESET(VAR F:TEXT←FILE);EXTERNAL;
PROCEDURE TTY←REWRITE(VAR F:TEXT←FILE);EXTERNAL;
PROCEDURE FILE←RESET(VAR F:TEXT←FILE;EXT:ALFA);EXTERNAL;
PROCEDURE FILE←REWRITE(VAR F:TEXT←FILE;EXT:ALFA);EXTERNAL;
PROCEDURE FILE←CLOSE(VAR F:TEXT←FILE);EXTERNAL;
FUNCTION FILE←GET←POS(VAR F:TEXT←FILE):INTEGER;EXTERNAL;{:188}{30:}
{PROCEDURE DEBUG←HELP;FORWARD;}{:30}{31:}PROCEDURE ERROR;
VAR J:0..OUT←BUF←SIZE;K,L:0..BUF←SIZE;BEGIN IF PHASE←ONE THEN{32:}
BEGIN IF LOC>=LIMIT THEN L:=LIMIT ELSE L:=LOC;
IF CHANGING THEN WRITELN(TERM←OUT,'. (change file pos:',FILE←GET←POS(
CHANGE←FILE)-(LIMIT-L)-2:1,')')ELSE WRITELN(TERM←OUT,'. (pos:',
FILE←GET←POS(WEB←FILE)-(LIMIT-L)-2:1,')');
FOR K:=1 TO L DO IF BUFFER[K-1]=9 THEN WRITE(TERM←OUT,' ')ELSE WRITE(
TERM←OUT,XCHR[BUFFER[K-1]]);WRITELN(TERM←OUT);
FOR K:=1 TO L DO WRITE(TERM←OUT,' ');
FOR K:=L+1 TO LIMIT DO WRITE(TERM←OUT,XCHR[BUFFER[K-1]]);
WRITE(TERM←OUT,' ');END{:32}ELSE{33:}
BEGIN WRITELN(TERM←OUT,'. (pos:',FILE←GET←POS(PASCAL←FILE)+OUT←PTR:1,')'
);FOR J:=1 TO OUT←PTR DO WRITE(TERM←OUT,XCHR[OUT←BUF[J-1]]);
WRITE(TERM←OUT,'... ');END{:33};BREAK(TERM←OUT);HISTORY:=2;{DEBUG←HELP;}
END;{:31}{34:}PROCEDURE JUMP←OUT;BEGIN GOTO 9999;END;{:34}
PROCEDURE INITIALIZE;VAR{16:}I:0..255;{:16}{41:}WI:0..1;{:41}{45:}
ZI:0..2;{:45}{51:}H:0..HASH←SIZE;{:51}BEGIN{10:}HISTORY:=0;{:10}{14:}
XCHR[32]:=' ';XCHR[33]:='!';XCHR[34]:='"';XCHR[35]:='#';XCHR[36]:='$';
XCHR[37]:='%';XCHR[38]:='&';XCHR[39]:='''';XCHR[40]:='(';XCHR[41]:=')';
XCHR[42]:='*';XCHR[43]:='+';XCHR[44]:=',';XCHR[45]:='-';XCHR[46]:='.';
XCHR[47]:='/';XCHR[48]:='0';XCHR[49]:='1';XCHR[50]:='2';XCHR[51]:='3';
XCHR[52]:='4';XCHR[53]:='5';XCHR[54]:='6';XCHR[55]:='7';XCHR[56]:='8';
XCHR[57]:='9';XCHR[58]:=':';XCHR[59]:=';';XCHR[60]:='<';XCHR[61]:='=';
XCHR[62]:='>';XCHR[63]:='?';XCHR[64]:='@';XCHR[65]:='A';XCHR[66]:='B';
XCHR[67]:='C';XCHR[68]:='D';XCHR[69]:='E';XCHR[70]:='F';XCHR[71]:='G';
XCHR[72]:='H';XCHR[73]:='I';XCHR[74]:='J';XCHR[75]:='K';XCHR[76]:='L';
XCHR[77]:='M';XCHR[78]:='N';XCHR[79]:='O';XCHR[80]:='P';XCHR[81]:='Q';
XCHR[82]:='R';XCHR[83]:='S';XCHR[84]:='T';XCHR[85]:='U';XCHR[86]:='V';
XCHR[87]:='W';XCHR[88]:='X';XCHR[89]:='Y';XCHR[90]:='Z';XCHR[91]:='[';
XCHR[92]:='\';XCHR[93]:=']';XCHR[94]:='↑';XCHR[95]:='←';XCHR[96]:='`';
XCHR[97]:='a';XCHR[98]:='b';XCHR[99]:='c';XCHR[100]:='d';XCHR[101]:='e';
XCHR[102]:='f';XCHR[103]:='g';XCHR[104]:='h';XCHR[105]:='i';
XCHR[106]:='j';XCHR[107]:='k';XCHR[108]:='l';XCHR[109]:='m';
XCHR[110]:='n';XCHR[111]:='o';XCHR[112]:='p';XCHR[113]:='q';
XCHR[114]:='r';XCHR[115]:='s';XCHR[116]:='t';XCHR[117]:='u';
XCHR[118]:='v';XCHR[119]:='w';XCHR[120]:='x';XCHR[121]:='y';
XCHR[122]:='z';XCHR[123]:='{';XCHR[124]:='|';XCHR[125]:='}';
XCHR[126]:='~';XCHR[0]:=' ';XCHR[127]:=' ';{:14}{17:}
FOR I:=1 TO 31 DO XCHR[I]:=CHR(I);{:17}{18:}
FOR I:=0 TO 255 DO XORD[CHR(I)]:=32;FOR I:=1 TO 126 DO XORD[XCHR[I]]:=I;
{:18}{21:}TTY←REWRITE(TERM←OUT);{:21}{26:}
FILE←REWRITE(PASCAL←FILE,'pas       ');FILE←REWRITE(POOL,'pool      ');
{:26}{42:}FOR WI:=0 TO 1 DO BEGIN BYTE←START[WI]:=0;BYTE←PTR[WI]:=0;END;
BYTE←START[2]:=0;NAME←PTR:=1;STRING←PTR:=128;POOL←CHECK←SUM:=271828;
{:42}{46:}FOR ZI:=0 TO 2 DO BEGIN TOK←START[ZI]:=0;TOK←PTR[ZI]:=0;END;
TOK←START[3]:=0;TEXT←PTR:=1;Z:=1 MOD 3;{:46}{48:}ILK[0]:=0;EQUIV[0]:=0;
{:48}{52:}FOR H:=0 TO HASH←SIZE-1 DO BEGIN HASH[H]:=0;CHOP←HASH[H]:=0;
END;{:52}{71:}LAST←UNNAMED:=0;TEXT←LINK[0]:=0;{:71}{144:}
SCANNING←HEX:=FALSE;{:144}{152:}MOD←TEXT[0]:=32;{:152}{180:}
{TROUBLE←SHOOTING:=TRUE;DEBUG←CYCLE:=1;DEBUG←SKIPPED:=0;
TROUBLE←SHOOTING:=FALSE;DEBUG←CYCLE:=99999;RESET(TERM←IN,'TTY:','/I');}
{:180}END;{:2}{24:}PROCEDURE OPEN←INPUT;
BEGIN FILE←RESET(WEB←FILE,'web       ');
FILE←RESET(CHANGE←FILE,'changes   ');END;{:24}{28:}
FUNCTION INPUT←LN(VAR F:TEXT←FILE):BOOLEAN;VAR FINAL←LIMIT:0..BUF←SIZE;
BEGIN LIMIT:=0;FINAL←LIMIT:=0;
IF EOF(F)THEN INPUT←LN:=FALSE ELSE BEGIN WHILE NOT EOLN(F)DO BEGIN
BUFFER[LIMIT]:=XORD[F↑];GET(F);LIMIT:=LIMIT+1;
IF BUFFER[LIMIT-1]<>32 THEN FINAL←LIMIT:=LIMIT;
IF LIMIT=BUF←SIZE THEN BEGIN WHILE NOT EOLN(F)DO GET(F);LIMIT:=LIMIT-1;
BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,'! Input line too long');END;
LOC:=0;ERROR;END;END;READLN(F);LIMIT:=FINAL←LIMIT;INPUT←LN:=TRUE;END;
END;{:28}{49:}PROCEDURE PRINT←ID(P:NAME←POINTER);VAR K:0..MAX←BYTES;
W:0..1;
BEGIN IF P>=NAME←PTR THEN WRITE(TERM←OUT,'IMPOSSIBLE')ELSE BEGIN W:=P
MOD 2;
FOR K:=BYTE←START[P]TO BYTE←START[P+2]-1 DO WRITE(TERM←OUT,XCHR[BYTE←MEM
[W,K]]);END;END;{:49}{53:}FUNCTION ID←LOOKUP(T:EIGHT←BITS):NAME←POINTER;
LABEL 31,32;VAR C:EIGHT←BITS;I:0..BUF←SIZE;H:0..HASH←SIZE;
K:0..MAX←BYTES;W:0..1;L:0..BUF←SIZE;P,Q:NAME←POINTER;
S:0..UNAMBIG←LENGTH;BEGIN L:=ID←LOC-ID←FIRST;{54:}H:=BUFFER[ID←FIRST];
I:=ID←FIRST+1;WHILE I<ID←LOC DO BEGIN H:=(H+H+BUFFER[I])MOD HASH←SIZE;
I:=I+1;END{:54};{55:}P:=HASH[H];
WHILE P<>0 DO BEGIN IF BYTE←START[P+2]-BYTE←START[P]=L THEN{56:}
BEGIN I:=ID←FIRST;K:=BYTE←START[P];W:=P MOD 2;
WHILE(I<ID←LOC)AND(BUFFER[I]=BYTE←MEM[W,K])DO BEGIN I:=I+1;K:=K+1;END;
IF I=ID←LOC THEN GOTO 31;END{:56};P:=LINK[P];END;P:=NAME←PTR;
LINK[P]:=HASH[H];HASH[H]:=P;31:{:55};IF(P=NAME←PTR)OR(T<>0)THEN{57:}
BEGIN IF((P<>NAME←PTR)AND(T<>0)AND(ILK[P]=0))OR((P=NAME←PTR)AND(T=0)AND(
BUFFER[ID←FIRST]<>34))THEN{58:}BEGIN I:=ID←FIRST;S:=0;H:=0;
WHILE(I<ID←LOC)AND(S<UNAMBIG←LENGTH)DO BEGIN BEGIN IF BUFFER[I]>=97 THEN
CHOPPED←ID[S]:=BUFFER[I]-32 ELSE CHOPPED←ID[S]:=BUFFER[I];
H:=(H+H+CHOPPED←ID[S])MOD HASH←SIZE;S:=S+1;END;I:=I+1;END;
CHOPPED←ID[S]:=0;END{:58};IF P<>NAME←PTR THEN{59:}
BEGIN IF ILK[P]=0 THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! This identifier has already appeared');ERROR;END;{60:}
Q:=CHOP←HASH[H];
IF Q=P THEN CHOP←HASH[H]:=EQUIV[P]ELSE BEGIN WHILE EQUIV[Q]<>P DO Q:=
EQUIV[Q];EQUIV[Q]:=EQUIV[P];END{:60};END ELSE BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! This identifier was defined before');ERROR;END;
ILK[P]:=T;END{:59}ELSE{61:}
BEGIN IF(T=0)AND(BUFFER[ID←FIRST]<>34)THEN{62:}BEGIN Q:=CHOP←HASH[H];
WHILE Q<>0 DO BEGIN{63:}BEGIN K:=BYTE←START[Q];S:=0;W:=Q MOD 2;
WHILE(K<BYTE←START[Q+2])AND(S<UNAMBIG←LENGTH)DO BEGIN C:=BYTE←MEM[W,K];
BEGIN IF C>=97 THEN C:=C-32;IF CHOPPED←ID[S]<>C THEN GOTO 32;S:=S+1;END;
K:=K+1;END;IF(K=BYTE←START[Q+2])AND(CHOPPED←ID[S]<>0)THEN GOTO 32;
BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,'! Identifier conflict with ');
END;
FOR K:=BYTE←START[Q]TO BYTE←START[Q+2]-1 DO WRITE(TERM←OUT,XCHR[BYTE←MEM
[W,K]]);ERROR;Q:=0;32:END{:63};Q:=EQUIV[Q];END;EQUIV[P]:=CHOP←HASH[H];
CHOP←HASH[H]:=P;END{:62};W:=NAME←PTR MOD 2;K:=BYTE←PTR[W];
IF K+L>MAX←BYTES THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;
IF NAME←PTR>MAX←NAMES-2 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','name',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;I:=ID←FIRST;
WHILE I<ID←LOC DO BEGIN BYTE←MEM[W,K]:=BUFFER[I];K:=K+1;I:=I+1;END;
BYTE←PTR[W]:=K;BYTE←START[NAME←PTR+2]:=K;NAME←PTR:=NAME←PTR+1;
IF BUFFER[ID←FIRST]<>34 THEN ILK[P]:=T ELSE{64:}BEGIN ILK[P]:=1;
IF L-DOUBLE←CHARS=2 THEN EQUIV[P]:=BUFFER[ID←FIRST+1]+32768 ELSE BEGIN
EQUIV[P]:=STRING←PTR+32768;L:=L-DOUBLE←CHARS-1;
IF L>99 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Preprocessed string is too long');ERROR;END;
STRING←PTR:=STRING←PTR+1;
WRITE(POOL,XCHR[48+L DIV 10],XCHR[48+L MOD 10]);
POOL←CHECK←SUM:=POOL←CHECK←SUM+POOL←CHECK←SUM+L;
WHILE POOL←CHECK←SUM>536870839 DO POOL←CHECK←SUM:=POOL←CHECK←SUM
-536870839;I:=ID←FIRST+1;
WHILE I<ID←LOC DO BEGIN WRITE(POOL,XCHR[BUFFER[I]]);
POOL←CHECK←SUM:=POOL←CHECK←SUM+POOL←CHECK←SUM+BUFFER[I];
WHILE POOL←CHECK←SUM>536870839 DO POOL←CHECK←SUM:=POOL←CHECK←SUM
-536870839;IF(BUFFER[I]=34)OR(BUFFER[I]=64)THEN I:=I+2 ELSE I:=I+1;END;
WRITELN(POOL);END;END{:64};END{:61};END{:57};ID←LOOKUP:=P;END;{:53}{66:}
FUNCTION MOD←LOOKUP(L:SIXTEEN←BITS):NAME←POINTER;LABEL 31;VAR C:0..4;
J:0..LONGEST←NAME;K:0..MAX←BYTES;W:0..1;P:NAME←POINTER;Q:NAME←POINTER;
BEGIN C:=2;Q:=0;P:=ILK[0];WHILE P<>0 DO BEGIN{68:}
BEGIN K:=BYTE←START[P];W:=P MOD 2;C:=1;J:=1;
WHILE(K<BYTE←START[P+2])AND(J<=L)AND(MOD←TEXT[J]=BYTE←MEM[W,K])DO BEGIN
K:=K+1;J:=J+1;END;
IF K=BYTE←START[P+2]THEN IF J>L THEN C:=1 ELSE C:=4 ELSE IF J>L THEN C:=
3 ELSE IF MOD←TEXT[J]<BYTE←MEM[W,K]THEN C:=0 ELSE C:=2;END{:68};Q:=P;
IF C=0 THEN P:=LINK[Q]ELSE IF C=2 THEN P:=ILK[Q]ELSE GOTO 31;END;{67:}
W:=NAME←PTR MOD 2;K:=BYTE←PTR[W];
IF K+L>MAX←BYTES THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;
IF NAME←PTR>MAX←NAMES-2 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','name',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;P:=NAME←PTR;
IF C=0 THEN LINK[Q]:=P ELSE ILK[Q]:=P;LINK[P]:=0;ILK[P]:=0;C:=1;
EQUIV[P]:=0;FOR J:=1 TO L DO BYTE←MEM[W,K+J-1]:=MOD←TEXT[J];
BYTE←PTR[W]:=K+L;BYTE←START[NAME←PTR+2]:=K+L;NAME←PTR:=NAME←PTR+1;{:67};
31:IF C<>1 THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Incompatible section names');ERROR;END;P:=0;END;
MOD←LOOKUP:=P;END;{:66}{69:}
FUNCTION PREFIX←LOOKUP(L:SIXTEEN←BITS):NAME←POINTER;VAR C:0..4;
COUNT:0..MAX←NAMES;J:0..LONGEST←NAME;K:0..MAX←BYTES;W:0..1;
P:NAME←POINTER;Q:NAME←POINTER;R:NAME←POINTER;BEGIN Q:=0;P:=ILK[0];
COUNT:=0;R:=0;WHILE P<>0 DO BEGIN{68:}BEGIN K:=BYTE←START[P];W:=P MOD 2;
C:=1;J:=1;
WHILE(K<BYTE←START[P+2])AND(J<=L)AND(MOD←TEXT[J]=BYTE←MEM[W,K])DO BEGIN
K:=K+1;J:=J+1;END;
IF K=BYTE←START[P+2]THEN IF J>L THEN C:=1 ELSE C:=4 ELSE IF J>L THEN C:=
3 ELSE IF MOD←TEXT[J]<BYTE←MEM[W,K]THEN C:=0 ELSE C:=2;END{:68};
IF C=0 THEN P:=LINK[P]ELSE IF C=2 THEN P:=ILK[P]ELSE BEGIN R:=P;
COUNT:=COUNT+1;Q:=ILK[P];P:=LINK[P];END;IF P=0 THEN BEGIN P:=Q;Q:=0;END;
END;IF COUNT<>1 THEN IF COUNT=0 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Name does not match');ERROR;
END ELSE BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,'! Ambiguous prefix');
ERROR;END;PREFIX←LOOKUP:=R;END;{:69}{73:}
PROCEDURE STORE←TWO←BYTES(X:SIXTEEN←BITS);
BEGIN IF TOK←PTR[Z]+2>MAX←TOKS THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=X DIV 256;
TOK←MEM[Z,TOK←PTR[Z]+1]:=X MOD 256;TOK←PTR[Z]:=TOK←PTR[Z]+2;END;{:73}
{74:}{PROCEDURE PRINT←REPL(P:TEXT←POINTER);VAR K:0..MAX←TOKS;
A:SIXTEEN←BITS;ZP:0..2;
BEGIN IF P>=TEXT←PTR THEN WRITE(TERM←OUT,'BAD')ELSE BEGIN K:=TOK←START[P
];ZP:=P MOD 3;WHILE K<TOK←START[P+3]DO BEGIN A:=TOK←MEM[ZP,K];
IF A>=128 THEN[75:]BEGIN K:=K+1;
IF A<168 THEN BEGIN A:=(A-128)*256+TOK←MEM[ZP,K];PRINT←ID(A);
IF BYTE←MEM[A MOD 2,BYTE←START[A]]=34 THEN WRITE(TERM←OUT,'"')ELSE WRITE
(TERM←OUT,' ');END ELSE IF A<208 THEN BEGIN WRITE(TERM←OUT,'@<');
PRINT←ID((A-168)*256+TOK←MEM[ZP,K]);WRITE(TERM←OUT,'@>');
END ELSE BEGIN A:=(A-208)*256+TOK←MEM[ZP,K];
WRITE(TERM←OUT,'@',XCHR[123],A:1,'@',XCHR[125]);END;
END[:75]ELSE[76:]CASE A OF 9:WRITE(TERM←OUT,'@',XCHR[123]);
10:WRITE(TERM←OUT,'@',XCHR[125]);12:WRITE(TERM←OUT,'@''');
13:WRITE(TERM←OUT,'@"');125:WRITE(TERM←OUT,'@$');0:WRITE(TERM←OUT,'#');
64:WRITE(TERM←OUT,'@@');2:WRITE(TERM←OUT,'@=');3:WRITE(TERM←OUT,'@\');
OTHERS:WRITE(TERM←OUT,XCHR[A])END[:76];K:=K+1;END;END;END;}{:74}{84:}
PROCEDURE PUSH←LEVEL(P:NAME←POINTER);
BEGIN IF STACK←PTR=STACK←SIZE THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','stack',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END ELSE BEGIN STACK[STACK←PTR]:=CUR←STATE;
STACK←PTR:=STACK←PTR+1;CUR←STATE.NAME←FIELD:=P;
CUR←STATE.REPL←FIELD:=EQUIV[P];ZO:=CUR←STATE.REPL←FIELD MOD 3;
CUR←STATE.BYTE←FIELD:=TOK←START[CUR←STATE.REPL←FIELD];
CUR←STATE.END←FIELD:=TOK←START[CUR←STATE.REPL←FIELD+3];
CUR←STATE.MOD←FIELD:=0;END;END;{:84}{85:}PROCEDURE POP←LEVEL;LABEL 10;
BEGIN IF TEXT←LINK[CUR←STATE.REPL←FIELD]=0 THEN BEGIN IF ILK[CUR←STATE.
NAME←FIELD]=3 THEN{91:}BEGIN NAME←PTR:=NAME←PTR-1;TEXT←PTR:=TEXT←PTR-1;
Z:=TEXT←PTR MOD 3;
{IF TOK←PTR[Z]>MAX←TOK←PTR[Z]THEN MAX←TOK←PTR[Z]:=TOK←PTR[Z];}
TOK←PTR[Z]:=TOK←START[TEXT←PTR];
{BYTE←PTR[NAME←PTR MOD 2]:=BYTE←PTR[NAME←PTR MOD 2]-1;}END{:91};
END ELSE IF TEXT←LINK[CUR←STATE.REPL←FIELD]<MAX←TEXTS THEN BEGIN
CUR←STATE.REPL←FIELD:=TEXT←LINK[CUR←STATE.REPL←FIELD];
ZO:=CUR←STATE.REPL←FIELD MOD 3;
CUR←STATE.BYTE←FIELD:=TOK←START[CUR←STATE.REPL←FIELD];
CUR←STATE.END←FIELD:=TOK←START[CUR←STATE.REPL←FIELD+3];GOTO 10;END;
STACK←PTR:=STACK←PTR-1;
IF STACK←PTR>0 THEN BEGIN CUR←STATE:=STACK[STACK←PTR];
ZO:=CUR←STATE.REPL←FIELD MOD 3;END;10:END;{:85}{87:}
FUNCTION GET←OUTPUT:SIXTEEN←BITS;LABEL 20,30,31;VAR A:SIXTEEN←BITS;
B:EIGHT←BITS;BAL:SIXTEEN←BITS;K:0..MAX←BYTES;W:0..1;
BEGIN 20:IF STACK←PTR=0 THEN BEGIN A:=0;GOTO 31;END;
IF CUR←STATE.BYTE←FIELD=CUR←STATE.END←FIELD THEN BEGIN CUR←VAL:=-
CUR←STATE.MOD←FIELD;POP←LEVEL;IF CUR←VAL=0 THEN GOTO 20;A:=129;GOTO 31;
END;A:=TOK←MEM[ZO,CUR←STATE.BYTE←FIELD];
CUR←STATE.BYTE←FIELD:=CUR←STATE.BYTE←FIELD+1;
IF A<128 THEN IF A=0 THEN{92:}BEGIN PUSH←LEVEL(NAME←PTR-1);GOTO 20;
END{:92}ELSE GOTO 31;A:=(A-128)*256+TOK←MEM[ZO,CUR←STATE.BYTE←FIELD];
CUR←STATE.BYTE←FIELD:=CUR←STATE.BYTE←FIELD+1;IF A<10240 THEN{89:}
BEGIN CASE ILK[A]OF 0:BEGIN CUR←VAL:=A;A:=130;END;
1:BEGIN CUR←VAL:=EQUIV[A]-32768;A:=128;END;2:BEGIN PUSH←LEVEL(A);
GOTO 20;END;3:BEGIN{90:}
WHILE(CUR←STATE.BYTE←FIELD=CUR←STATE.END←FIELD)AND(STACK←PTR>0)DO
POP←LEVEL;
IF(STACK←PTR=0)OR(TOK←MEM[ZO,CUR←STATE.BYTE←FIELD]<>40)THEN BEGIN BEGIN
WRITELN(TERM←OUT);WRITE(TERM←OUT,'! No parameter given for ');END;
PRINT←ID(A);ERROR;GOTO 20;END;{93:}BAL:=1;
CUR←STATE.BYTE←FIELD:=CUR←STATE.BYTE←FIELD+1;
WHILE TRUE DO BEGIN B:=TOK←MEM[ZO,CUR←STATE.BYTE←FIELD];
CUR←STATE.BYTE←FIELD:=CUR←STATE.BYTE←FIELD+1;
IF B=0 THEN STORE←TWO←BYTES(NAME←PTR+32767)ELSE BEGIN IF B>=128 THEN
BEGIN BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=B;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;B:=TOK←MEM[ZO,CUR←STATE.BYTE←FIELD];
CUR←STATE.BYTE←FIELD:=CUR←STATE.BYTE←FIELD+1;
END ELSE CASE B OF 40:BAL:=BAL+1;41:BEGIN BAL:=BAL-1;
IF BAL=0 THEN GOTO 30;END;
39:REPEAT BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=B;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;B:=TOK←MEM[ZO,CUR←STATE.BYTE←FIELD];
CUR←STATE.BYTE←FIELD:=CUR←STATE.BYTE←FIELD+1;UNTIL B=39;OTHERS:END;
BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=B;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;END;END;30:{:93};EQUIV[NAME←PTR]:=TEXT←PTR;
ILK[NAME←PTR]:=2;W:=NAME←PTR MOD 2;K:=BYTE←PTR[W];
{IF K=MAX←BYTES THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;BYTE←MEM[W,K]:=35;K:=K+1;BYTE←PTR[W]:=K;}
IF NAME←PTR>MAX←NAMES-2 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','name',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;BYTE←START[NAME←PTR+2]:=K;NAME←PTR:=NAME←PTR+1;
IF TEXT←PTR>MAX←TEXTS-3 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','text',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TEXT←LINK[TEXT←PTR]:=0;
TOK←START[TEXT←PTR+3]:=TOK←PTR[Z];TEXT←PTR:=TEXT←PTR+1;
Z:=TEXT←PTR MOD 3{:90};PUSH←LEVEL(A);GOTO 20;END;
OTHERS:BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! This can''t happen (','output',')');ERROR;HISTORY:=3;
JUMP←OUT;END END;GOTO 31;END{:89};IF A<20480 THEN{88:}BEGIN A:=A-10240;
IF EQUIV[A]<>0 THEN PUSH←LEVEL(A)ELSE IF A<>0 THEN BEGIN BEGIN WRITELN(
TERM←OUT);WRITE(TERM←OUT,'! Not present: <');END;PRINT←ID(A);
WRITE(TERM←OUT,'>');ERROR;END;GOTO 20;END{:88};CUR←VAL:=A-20480;A:=129;
CUR←STATE.MOD←FIELD:=CUR←VAL;31:{IF TROUBLE←SHOOTING THEN DEBUG←HELP;}
GET←OUTPUT:=A;END;{:87}{97:}PROCEDURE FLUSH←BUFFER;
VAR K:0..OUT←BUF←SIZE;B:0..OUT←BUF←SIZE;BEGIN B:=BREAK←PTR;
IF(SEMI←PTR<>0)AND(OUT←PTR-SEMI←PTR<=LINE←LENGTH)THEN BREAK←PTR:=
SEMI←PTR;FOR K:=1 TO BREAK←PTR DO WRITE(PASCAL←FILE,XCHR[OUT←BUF[K-1]]);
WRITELN(PASCAL←FILE);LINE:=LINE+1;
IF LINE MOD 100=0 THEN BEGIN WRITE(TERM←OUT,'.');
IF LINE MOD 500=0 THEN WRITE(TERM←OUT,LINE:1);BREAK(TERM←OUT);END;
IF BREAK←PTR<OUT←PTR THEN BEGIN IF OUT←BUF[BREAK←PTR]=32 THEN BEGIN
BREAK←PTR:=BREAK←PTR+1;IF BREAK←PTR>B THEN B:=BREAK←PTR;END;
FOR K:=BREAK←PTR TO OUT←PTR-1 DO OUT←BUF[K-BREAK←PTR]:=OUT←BUF[K];END;
OUT←PTR:=OUT←PTR-BREAK←PTR;BREAK←PTR:=B-BREAK←PTR;SEMI←PTR:=0;
IF OUT←PTR>LINE←LENGTH THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Long line must be truncated');ERROR;END;
OUT←PTR:=LINE←LENGTH;END;END;{:97}{99:}PROCEDURE APP←VAL(V:INTEGER);
VAR K:0..OUT←BUF←SIZE;BEGIN K:=OUT←BUF←SIZE;REPEAT OUT←BUF[K]:=V MOD 10;
V:=V DIV 10;K:=K-1;UNTIL V=0;REPEAT K:=K+1;
BEGIN OUT←BUF[OUT←PTR]:=OUT←BUF[K]+48;OUT←PTR:=OUT←PTR+1;END;
UNTIL K=OUT←BUF←SIZE;END;{:99}{101:}PROCEDURE SEND←OUT(T:EIGHT←BITS;
V:SIXTEEN←BITS);LABEL 20;VAR K:0..LINE←LENGTH;BEGIN{102:}
20:CASE OUT←STATE OF 1:IF T<>3 THEN BEGIN BREAK←PTR:=OUT←PTR;
IF T=2 THEN BEGIN OUT←BUF[OUT←PTR]:=32;OUT←PTR:=OUT←PTR+1;END;END;
2:BEGIN BEGIN OUT←BUF[OUT←PTR]:=44-OUT←APP;OUT←PTR:=OUT←PTR+1;END;
IF OUT←PTR>LINE←LENGTH THEN FLUSH←BUFFER;BREAK←PTR:=OUT←PTR;END;
3,4:BEGIN{103:}
IF(OUT←VAL<0)OR((OUT←VAL=0)AND(LAST←SIGN<0))THEN BEGIN OUT←BUF[OUT←PTR]
:=45;OUT←PTR:=OUT←PTR+1;
END ELSE IF OUT←SIGN>0 THEN BEGIN OUT←BUF[OUT←PTR]:=OUT←SIGN;
OUT←PTR:=OUT←PTR+1;END;APP←VAL(ABS(OUT←VAL));
IF OUT←PTR>LINE←LENGTH THEN FLUSH←BUFFER;{:103};OUT←STATE:=OUT←STATE-2;
GOTO 20;END;5:{104:}BEGIN IF(T=3)OR({105:}
((T=2)AND(V=3)AND(((OUT←CONTRIB[1]=68)AND(OUT←CONTRIB[2]=73)AND(
OUT←CONTRIB[3]=86))OR((OUT←CONTRIB[1]=77)AND(OUT←CONTRIB[2]=79)AND(
OUT←CONTRIB[3]=68))))OR((T=0)AND((V=42)OR(V=47))){:105})THEN BEGIN{103:}
IF(OUT←VAL<0)OR((OUT←VAL=0)AND(LAST←SIGN<0))THEN BEGIN OUT←BUF[OUT←PTR]
:=45;OUT←PTR:=OUT←PTR+1;
END ELSE IF OUT←SIGN>0 THEN BEGIN OUT←BUF[OUT←PTR]:=OUT←SIGN;
OUT←PTR:=OUT←PTR+1;END;APP←VAL(ABS(OUT←VAL));
IF OUT←PTR>LINE←LENGTH THEN FLUSH←BUFFER;{:103};OUT←SIGN:=43;
OUT←VAL:=OUT←APP;END ELSE OUT←VAL:=OUT←VAL+OUT←APP;OUT←STATE:=3;GOTO 20;
END{:104};0:IF T<>3 THEN BREAK←PTR:=OUT←PTR;OTHERS:END{:102};
IF T<>0 THEN FOR K:=1 TO V DO BEGIN OUT←BUF[OUT←PTR]:=OUT←CONTRIB[K];
OUT←PTR:=OUT←PTR+1;END ELSE BEGIN OUT←BUF[OUT←PTR]:=V;
OUT←PTR:=OUT←PTR+1;END;IF OUT←PTR>LINE←LENGTH THEN FLUSH←BUFFER;
IF(T=0)AND((V=59)OR(V=125))THEN BEGIN SEMI←PTR:=OUT←PTR;
BREAK←PTR:=OUT←PTR;END;IF T>=2 THEN OUT←STATE:=1 ELSE OUT←STATE:=0 END;
{:101}{106:}PROCEDURE SEND←SIGN(V:INTEGER);
BEGIN CASE OUT←STATE OF 2,4:OUT←APP:=OUT←APP*V;3:BEGIN OUT←APP:=V;
OUT←STATE:=4;END;5:BEGIN OUT←VAL:=OUT←VAL+OUT←APP;OUT←APP:=V;
OUT←STATE:=4;END;OTHERS:BEGIN BREAK←PTR:=OUT←PTR;OUT←APP:=V;
OUT←STATE:=2;END END;LAST←SIGN:=OUT←APP;END;{:106}{107:}
PROCEDURE SEND←VAL(V:INTEGER);LABEL 666,10;
BEGIN CASE OUT←STATE OF 1:BEGIN{110:}
IF(OUT←PTR=BREAK←PTR+3)OR((OUT←PTR=BREAK←PTR+4)AND(OUT←BUF[BREAK←PTR]=32
))THEN IF((OUT←BUF[OUT←PTR-3]=68)AND(OUT←BUF[OUT←PTR-2]=73)AND(OUT←BUF[
OUT←PTR-1]=86))OR((OUT←BUF[OUT←PTR-3]=77)AND(OUT←BUF[OUT←PTR-2]=79)AND(
OUT←BUF[OUT←PTR-1]=68))THEN GOTO 666{:110};OUT←SIGN:=32;OUT←STATE:=3;
OUT←VAL:=V;BREAK←PTR:=OUT←PTR;LAST←SIGN:=+1;END;0:BEGIN{109:}
IF(OUT←PTR=BREAK←PTR+1)AND((OUT←BUF[BREAK←PTR]=42)OR(OUT←BUF[BREAK←PTR]=
47))THEN GOTO 666{:109};OUT←SIGN:=0;OUT←STATE:=3;OUT←VAL:=V;
BREAK←PTR:=OUT←PTR;LAST←SIGN:=+1;END;{108:}2:BEGIN OUT←SIGN:=43;
OUT←STATE:=3;OUT←VAL:=OUT←APP*V;END;3:BEGIN OUT←STATE:=5;OUT←APP:=V;
BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Two numbers occurred without a sign between them');
ERROR;END;END;4:BEGIN OUT←STATE:=5;OUT←APP:=OUT←APP*V;END;
5:BEGIN OUT←VAL:=OUT←VAL+OUT←APP;OUT←APP:=V;BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Two numbers occurred without a sign between them');
ERROR;END;END;{:108}OTHERS:GOTO 666 END;GOTO 10;666:{111:}
IF V>=0 THEN BEGIN IF OUT←STATE=1 THEN BEGIN BREAK←PTR:=OUT←PTR;
BEGIN OUT←BUF[OUT←PTR]:=32;OUT←PTR:=OUT←PTR+1;END;END;APP←VAL(V);
IF OUT←PTR>LINE←LENGTH THEN FLUSH←BUFFER;OUT←STATE:=1;
END ELSE BEGIN BEGIN OUT←BUF[OUT←PTR]:=40;OUT←PTR:=OUT←PTR+1;END;
BEGIN OUT←BUF[OUT←PTR]:=45;OUT←PTR:=OUT←PTR+1;END;APP←VAL(-V);
BEGIN OUT←BUF[OUT←PTR]:=41;OUT←PTR:=OUT←PTR+1;END;
IF OUT←PTR>LINE←LENGTH THEN FLUSH←BUFFER;OUT←STATE:=0;END{:111};10:END;
{:107}{113:}PROCEDURE SEND←THE←OUTPUT;LABEL 2,21,22;
VAR CUR←CHAR:EIGHT←BITS;K:0..LINE←LENGTH;J:0..MAX←BYTES;W:0..1;
N:INTEGER;BEGIN WHILE STACK←PTR>0 DO BEGIN CUR←CHAR:=GET←OUTPUT;
21:CASE CUR←CHAR OF 0:;{116:}
65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,
89,90:BEGIN OUT←CONTRIB[1]:=CUR←CHAR;SEND←OUT(2,1);END;
97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115
,116,117,118,119,120,121,122:BEGIN OUT←CONTRIB[1]:=CUR←CHAR-32;
SEND←OUT(2,1);END;130:BEGIN K:=0;J:=BYTE←START[CUR←VAL];
W:=CUR←VAL MOD 2;
WHILE(K<MAX←ID←LENGTH)AND(J<BYTE←START[CUR←VAL+2])DO BEGIN K:=K+1;
OUT←CONTRIB[K]:=BYTE←MEM[W,J];J:=J+1;
IF OUT←CONTRIB[K]>=97 THEN OUT←CONTRIB[K]:=OUT←CONTRIB[K]-32;END;
SEND←OUT(2,K);END;{:116}{119:}48,49,50,51,52,53,54,55,56,57:BEGIN N:=0;
REPEAT CUR←CHAR:=CUR←CHAR-48;
IF N>=214748364 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Constant too big');ERROR;END ELSE N:=10*N+CUR←CHAR;
CUR←CHAR:=GET←OUTPUT;UNTIL(CUR←CHAR>57)OR(CUR←CHAR<48);SEND←VAL(N);K:=0;
IF CUR←CHAR=101 THEN CUR←CHAR:=69;
IF CUR←CHAR=69 THEN GOTO 2 ELSE GOTO 21;END;
125:SEND←VAL(POOL←CHECK←SUM);12:BEGIN N:=0;CUR←CHAR:=48;
REPEAT CUR←CHAR:=CUR←CHAR-48;
IF N>=268435456 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Constant too big');ERROR;END ELSE N:=8*N+CUR←CHAR;
CUR←CHAR:=GET←OUTPUT;UNTIL(CUR←CHAR>55)OR(CUR←CHAR<48);SEND←VAL(N);
GOTO 21;END;13:BEGIN N:=0;CUR←CHAR:=48;
REPEAT IF CUR←CHAR>=65 THEN CUR←CHAR:=CUR←CHAR-55 ELSE CUR←CHAR:=
CUR←CHAR-48;IF N>=134217728 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Constant too big');ERROR;END ELSE N:=16*N+CUR←CHAR;
CUR←CHAR:=GET←OUTPUT;
UNTIL(CUR←CHAR>70)OR(CUR←CHAR<48)OR((CUR←CHAR>57)AND(CUR←CHAR<65));
SEND←VAL(N);GOTO 21;END;128:SEND←VAL(CUR←VAL);46:BEGIN K:=1;
OUT←CONTRIB[1]:=46;CUR←CHAR:=GET←OUTPUT;
IF CUR←CHAR=46 THEN BEGIN OUT←CONTRIB[2]:=46;SEND←OUT(1,2);
END ELSE IF(CUR←CHAR>=48)AND(CUR←CHAR<=57)THEN GOTO 2 ELSE BEGIN
SEND←OUT(0,46);GOTO 21;END;END;{:119}43,45:SEND←SIGN(44-CUR←CHAR);{114:}
4:BEGIN OUT←CONTRIB[1]:=65;OUT←CONTRIB[2]:=78;OUT←CONTRIB[3]:=68;
SEND←OUT(2,3);END;5:BEGIN OUT←CONTRIB[1]:=78;OUT←CONTRIB[2]:=79;
OUT←CONTRIB[3]:=84;SEND←OUT(2,3);END;6:BEGIN OUT←CONTRIB[1]:=73;
OUT←CONTRIB[2]:=78;SEND←OUT(2,2);END;31:BEGIN OUT←CONTRIB[1]:=79;
OUT←CONTRIB[2]:=82;SEND←OUT(2,2);END;24:BEGIN OUT←CONTRIB[1]:=58;
OUT←CONTRIB[2]:=61;SEND←OUT(1,2);END;26:BEGIN OUT←CONTRIB[1]:=60;
OUT←CONTRIB[2]:=62;SEND←OUT(1,2);END;28:BEGIN OUT←CONTRIB[1]:=60;
OUT←CONTRIB[2]:=61;SEND←OUT(1,2);END;29:BEGIN OUT←CONTRIB[1]:=62;
OUT←CONTRIB[2]:=61;SEND←OUT(1,2);END;30:BEGIN OUT←CONTRIB[1]:=61;
OUT←CONTRIB[2]:=61;SEND←OUT(1,2);END;32:BEGIN OUT←CONTRIB[1]:=46;
OUT←CONTRIB[2]:=46;SEND←OUT(1,2);END;{:114}39:{117:}BEGIN K:=1;
OUT←CONTRIB[1]:=39;REPEAT IF K<LINE←LENGTH THEN K:=K+1;
OUT←CONTRIB[K]:=GET←OUTPUT;UNTIL(OUT←CONTRIB[K]=39)OR(STACK←PTR=0);
IF K=LINE←LENGTH THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! String too long');ERROR;END;SEND←OUT(1,K);
CUR←CHAR:=GET←OUTPUT;IF CUR←CHAR=39 THEN OUT←STATE:=6;GOTO 21;END{:117};
{115:}
33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,95,96,
123,124{:115}:SEND←OUT(0,CUR←CHAR);{121:}
9:BEGIN IF BRACE←LEVEL=0 THEN SEND←OUT(0,123)ELSE SEND←OUT(0,91);
BRACE←LEVEL:=BRACE←LEVEL+1;END;
10:IF BRACE←LEVEL>0 THEN BEGIN BRACE←LEVEL:=BRACE←LEVEL-1;
IF BRACE←LEVEL=0 THEN SEND←OUT(0,125)ELSE SEND←OUT(0,93);
END ELSE BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,'! Extra @}');ERROR;END;
129:BEGIN IF BRACE←LEVEL=0 THEN SEND←OUT(0,123)ELSE SEND←OUT(0,91);
IF CUR←VAL<0 THEN BEGIN SEND←OUT(0,58);SEND←VAL(-CUR←VAL);
END ELSE BEGIN SEND←VAL(CUR←VAL);SEND←OUT(0,58);END;
IF BRACE←LEVEL=0 THEN SEND←OUT(0,125)ELSE SEND←OUT(0,93);END;{:121}
127:BEGIN SEND←OUT(3,0);OUT←STATE:=6;END;2:{118:}BEGIN K:=0;
REPEAT IF K<LINE←LENGTH THEN K:=K+1;OUT←CONTRIB[K]:=GET←OUTPUT;
UNTIL(OUT←CONTRIB[K]=2)OR(STACK←PTR=0);
IF K=LINE←LENGTH THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Verbatim string too long');ERROR;END;SEND←OUT(1,K-1);
END{:118};3:{122:}BEGIN SEND←OUT(1,0);
WHILE OUT←PTR>0 DO BEGIN IF OUT←PTR<=LINE←LENGTH THEN BREAK←PTR:=OUT←PTR
;FLUSH←BUFFER;END;OUT←STATE:=0;END{:122};OTHERS:BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Can''t output ASCII code ',CUR←CHAR:1);ERROR;END END;
GOTO 22;2:{120:}REPEAT IF K<LINE←LENGTH THEN K:=K+1;
OUT←CONTRIB[K]:=CUR←CHAR;CUR←CHAR:=GET←OUTPUT;
IF(OUT←CONTRIB[K]=69)AND((CUR←CHAR=43)OR(CUR←CHAR=45))THEN BEGIN IF K<
LINE←LENGTH THEN K:=K+1;OUT←CONTRIB[K]:=CUR←CHAR;CUR←CHAR:=GET←OUTPUT;
END ELSE IF CUR←CHAR=101 THEN CUR←CHAR:=69;
UNTIL(CUR←CHAR<>69)AND((CUR←CHAR<48)OR(CUR←CHAR>57));
IF K=LINE←LENGTH THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Fraction too long');ERROR;END;SEND←OUT(3,K);
GOTO 21{:120};22:END;END;{:113}{127:}FUNCTION LINES←DONT←MATCH:BOOLEAN;
LABEL 10;VAR K:0..BUF←SIZE;BEGIN LINES←DONT←MATCH:=TRUE;
IF CHANGE←LIMIT<>LIMIT THEN GOTO 10;
IF LIMIT>0 THEN FOR K:=0 TO LIMIT-1 DO IF CHANGE←BUFFER[K]<>BUFFER[K]
THEN GOTO 10;LINES←DONT←MATCH:=FALSE;10:END;{:127}{128:}
PROCEDURE PRIME←THE←CHANGE←BUFFER;LABEL 22,30,10;VAR K:0..BUF←SIZE;
BEGIN CHANGE←LIMIT:=0;{129:}WHILE TRUE DO BEGIN LINE:=LINE+1;
IF NOT INPUT←LN(CHANGE←FILE)THEN GOTO 10;IF LIMIT<2 THEN GOTO 22;
IF BUFFER[0]<>64 THEN GOTO 22;
IF(BUFFER[1]>=88)AND(BUFFER[1]<=90)THEN BUFFER[1]:=BUFFER[1]+32;
IF BUFFER[1]=120 THEN GOTO 30;
IF(BUFFER[1]=121)OR(BUFFER[1]=122)THEN BEGIN LOC:=2;
BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,'! Where is the matching @x?');
ERROR;END;END;22:END;30:{:129};{130:}REPEAT LINE:=LINE+1;
IF NOT INPUT←LN(CHANGE←FILE)THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Change file ended after @x');ERROR;END;GOTO 10;END;
UNTIL LIMIT>0;{:130};{131:}BEGIN CHANGE←LIMIT:=LIMIT;
FOR K:=0 TO LIMIT DO CHANGE←BUFFER[K]:=BUFFER[K];END{:131};10:END;{:128}
{132:}PROCEDURE CHECK←CHANGE;LABEL 10;VAR N:INTEGER;K:0..BUF←SIZE;
BEGIN IF LINES←DONT←MATCH THEN GOTO 10;N:=0;
WHILE TRUE DO BEGIN CHANGING:=NOT CHANGING;TEMP←LINE:=OTHER←LINE;
OTHER←LINE:=LINE;LINE:=TEMP←LINE;LINE:=LINE+1;
IF NOT INPUT←LN(CHANGE←FILE)THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Change file ended before @y');ERROR;END;
CHANGE←LIMIT:=0;CHANGING:=NOT CHANGING;TEMP←LINE:=OTHER←LINE;
OTHER←LINE:=LINE;LINE:=TEMP←LINE;GOTO 10;END;{133:}
IF LIMIT>1 THEN IF BUFFER[0]=64 THEN BEGIN IF(BUFFER[1]>=88)AND(BUFFER[1
]<=90)THEN BUFFER[1]:=BUFFER[1]+32;
IF(BUFFER[1]=120)OR(BUFFER[1]=122)THEN BEGIN LOC:=2;
BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,'! Where is the matching @y?');
ERROR;END;END ELSE IF BUFFER[1]=121 THEN BEGIN IF N>0 THEN BEGIN LOC:=2;
BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Hmm... ',N:1,' of the preceding lines failed to match'
);ERROR;END;END;GOTO 10;END;END{:133};{131:}BEGIN CHANGE←LIMIT:=LIMIT;
FOR K:=0 TO LIMIT DO CHANGE←BUFFER[K]:=BUFFER[K];END{:131};
CHANGING:=NOT CHANGING;TEMP←LINE:=OTHER←LINE;OTHER←LINE:=LINE;
LINE:=TEMP←LINE;LINE:=LINE+1;
IF NOT INPUT←LN(WEB←FILE)THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! WEB file ended during a change');ERROR;END;
INPUT←HAS←ENDED:=TRUE;GOTO 10;END;IF LINES←DONT←MATCH THEN N:=N+1;END;
10:END;{:132}{135:}PROCEDURE GET←LINE;LABEL 20;
BEGIN 20:IF CHANGING THEN{137:}BEGIN LINE:=LINE+1;
IF NOT INPUT←LN(CHANGE←FILE)THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Change file ended without @z');ERROR;END;
BUFFER[0]:=64;BUFFER[1]:=122;LIMIT:=2;END;
IF LIMIT>1 THEN IF BUFFER[0]=64 THEN BEGIN IF(BUFFER[1]>=88)AND(BUFFER[1
]<=90)THEN BUFFER[1]:=BUFFER[1]+32;
IF(BUFFER[1]=120)OR(BUFFER[1]=121)THEN BEGIN LOC:=2;
BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,'! Where is the matching @z?');
ERROR;END;END ELSE IF BUFFER[1]=122 THEN BEGIN PRIME←THE←CHANGE←BUFFER;
CHANGING:=NOT CHANGING;TEMP←LINE:=OTHER←LINE;OTHER←LINE:=LINE;
LINE:=TEMP←LINE;END;END;END{:137};IF NOT CHANGING THEN BEGIN{136:}
BEGIN LINE:=LINE+1;
IF NOT INPUT←LN(WEB←FILE)THEN INPUT←HAS←ENDED:=TRUE ELSE IF LIMIT=
CHANGE←LIMIT THEN IF BUFFER[0]=CHANGE←BUFFER[0]THEN IF CHANGE←LIMIT>0
THEN CHECK←CHANGE;END{:136};IF CHANGING THEN GOTO 20;END;LOC:=0;
BUFFER[LIMIT]:=32;END;{:135}{139:}
FUNCTION CONTROL←CODE(C:ASCII←CODE):EIGHT←BITS;
BEGIN CASE C OF 64:CONTROL←CODE:=64;39:CONTROL←CODE:=12;
34:CONTROL←CODE:=13;36:CONTROL←CODE:=125;32,9:CONTROL←CODE:=136;
42:BEGIN WRITE(TERM←OUT,'*',MODULE←COUNT+1:1);BREAK(TERM←OUT);
CONTROL←CODE:=136;END;68,100:CONTROL←CODE:=133;70,102:CONTROL←CODE:=132;
123:CONTROL←CODE:=9;125:CONTROL←CODE:=10;80,112:CONTROL←CODE:=134;
84,116,94,46,58:CONTROL←CODE:=131;38:CONTROL←CODE:=127;
60:CONTROL←CODE:=135;61:CONTROL←CODE:=2;92:CONTROL←CODE:=3;
OTHERS:CONTROL←CODE:=0 END;END;{:139}{140:}
FUNCTION SKIP←AHEAD:EIGHT←BITS;LABEL 30;VAR C:EIGHT←BITS;
BEGIN WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GET←LINE;
IF INPUT←HAS←ENDED THEN BEGIN C:=136;GOTO 30;END;END;
BUFFER[LIMIT+1]:=64;WHILE BUFFER[LOC]<>64 DO LOC:=LOC+1;
IF LOC<=LIMIT THEN BEGIN LOC:=LOC+2;C:=CONTROL←CODE(BUFFER[LOC-1]);
IF(C<>0)OR(BUFFER[LOC-1]=62)THEN GOTO 30;END;END;30:SKIP←AHEAD:=C;END;
{:140}{141:}PROCEDURE SKIP←COMMENT;LABEL 10;VAR BAL:EIGHT←BITS;
C:ASCII←CODE;BEGIN BAL:=0;
WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GET←LINE;
IF INPUT←HAS←ENDED THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Input ended in mid-comment');ERROR;END;GOTO 10;END;
END;C:=BUFFER[LOC];LOC:=LOC+1;{142:}IF C=64 THEN BEGIN C:=BUFFER[LOC];
IF(C<>32)AND(C<>9)AND(C<>42)AND(C<>122)AND(C<>90)THEN LOC:=LOC+1 ELSE
BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Section ended in mid-comment');ERROR;END;LOC:=LOC-1;
GOTO 10;
END END ELSE IF(C=92)AND(BUFFER[LOC]<>64)THEN LOC:=LOC+1 ELSE IF C=123
THEN BAL:=BAL+1 ELSE IF C=125 THEN BEGIN IF BAL=0 THEN GOTO 10;
BAL:=BAL-1;END{:142};END;10:END;{:141}{145:}
FUNCTION GET←NEXT:EIGHT←BITS;LABEL 20,30,31;VAR C:EIGHT←BITS;
D:EIGHT←BITS;J,K:0..LONGEST←NAME;
BEGIN 20:IF LOC>LIMIT THEN BEGIN GET←LINE;
IF INPUT←HAS←ENDED THEN BEGIN C:=136;GOTO 31;END;END;C:=BUFFER[LOC];
LOC:=LOC+1;IF SCANNING←HEX THEN{146:}
IF((C>=48)AND(C<=57))OR((C>=65)AND(C<=70))THEN GOTO 31 ELSE SCANNING←HEX
:=FALSE{:146};
CASE C OF 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
,112,113,114,115,116,117,118,119,120,121,122:{148:}
BEGIN IF((C=101)OR(C=69))AND(LOC>1)THEN IF(BUFFER[LOC-2]<=57)AND(BUFFER[
LOC-2]>=48)THEN C:=0;IF C<>0 THEN BEGIN LOC:=LOC-1;ID←FIRST:=LOC;
REPEAT LOC:=LOC+1;D:=BUFFER[LOC];
UNTIL((D<48)OR((D>57)AND(D<65))OR((D>90)AND(D<97))OR(D>122))AND(D<>95);
IF LOC>ID←FIRST+1 THEN BEGIN C:=130;ID←LOC:=LOC;END;END ELSE C:=69;
END{:148};34:{149:}BEGIN DOUBLE←CHARS:=0;ID←FIRST:=LOC-1;
REPEAT D:=BUFFER[LOC];LOC:=LOC+1;
IF(D=34)OR(D=64)THEN IF BUFFER[LOC]=D THEN BEGIN LOC:=LOC+1;D:=0;
DOUBLE←CHARS:=DOUBLE←CHARS+1;
END ELSE BEGIN IF D=64 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Double @ sign missing');ERROR;
END END ELSE IF LOC>LIMIT THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! String constant didn''t end');ERROR;END;D:=34;END;
UNTIL D=34;ID←LOC:=LOC-1;C:=130;END{:149};64:{150:}
BEGIN C:=CONTROL←CODE(BUFFER[LOC]);LOC:=LOC+1;
IF C=0 THEN GOTO 20 ELSE IF C=13 THEN SCANNING←HEX:=TRUE ELSE IF C=135
THEN{151:}BEGIN{153:}K:=0;
WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GET←LINE;
IF INPUT←HAS←ENDED THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Input ended in section name');ERROR;END;GOTO 30;END;
END;D:=BUFFER[LOC];{154:}IF D=64 THEN BEGIN D:=BUFFER[LOC+1];
IF D=62 THEN BEGIN LOC:=LOC+2;GOTO 30;END;
IF(D=32)OR(D=9)OR(D=42)THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Section name didn''t end');ERROR;END;GOTO 30;END;
K:=K+1;MOD←TEXT[K]:=64;LOC:=LOC+1;END{:154};LOC:=LOC+1;
IF K<LONGEST←NAME-1 THEN K:=K+1;IF(D=32)OR(D=9)THEN BEGIN D:=32;
IF MOD←TEXT[K-1]=32 THEN K:=K-1;END;MOD←TEXT[K]:=D;END;30:{155:}
IF K>=LONGEST←NAME-2 THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Section name too long: ');END;
FOR J:=1 TO 25 DO WRITE(TERM←OUT,XCHR[MOD←TEXT[J]]);
WRITE(TERM←OUT,'...');IF HISTORY=0 THEN HISTORY:=1;END{:155};
IF(MOD←TEXT[K]=32)AND(K>0)THEN K:=K-1;{:153};
IF K>3 THEN BEGIN IF(MOD←TEXT[K]=46)AND(MOD←TEXT[K-1]=46)AND(MOD←TEXT[K
-2]=46)THEN CUR←MODULE:=PREFIX←LOOKUP(K-3)ELSE CUR←MODULE:=MOD←LOOKUP(K)
;END ELSE CUR←MODULE:=MOD←LOOKUP(K);END{:151}
ELSE IF C=131 THEN BEGIN REPEAT C:=SKIP←AHEAD;UNTIL C<>64;
IF BUFFER[LOC-1]<>62 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Improper @ within control text');ERROR;END;GOTO 20;
END;END{:150};{147:}
46:IF BUFFER[LOC]=46 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=32;
LOC:=LOC+1;END;
END ELSE IF BUFFER[LOC]=41 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=93;
LOC:=LOC+1;END;END;
58:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=24;
LOC:=LOC+1;END;END;
61:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=30;
LOC:=LOC+1;END;END;
62:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=29;
LOC:=LOC+1;END;END;
60:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=28;
LOC:=LOC+1;END;
END ELSE IF BUFFER[LOC]=62 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=26;
LOC:=LOC+1;END;END;
40:IF BUFFER[LOC]=42 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=9;
LOC:=LOC+1;END;
END ELSE IF BUFFER[LOC]=46 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=91;
LOC:=LOC+1;END;END;
42:IF BUFFER[LOC]=41 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=10;
LOC:=LOC+1;END;END;{:147}32,9:GOTO 20;123:BEGIN SKIP←COMMENT;GOTO 20;
END;OTHERS:END;31:{IF TROUBLE←SHOOTING THEN DEBUG←HELP;}GET←NEXT:=C;END;
{:145}{157:}PROCEDURE SCAN←NUMERIC(P:NAME←POINTER);LABEL 21,30;
VAR ACCUMULATOR:INTEGER;NEXT←SIGN:-1..+1;Q:NAME←POINTER;VAL:INTEGER;
BEGIN{158:}ACCUMULATOR:=0;NEXT←SIGN:=+1;
WHILE TRUE DO BEGIN NEXT←CONTROL:=GET←NEXT;
21:CASE NEXT←CONTROL OF 48,49,50,51,52,53,54,55,56,57:BEGIN{160:}VAL:=0;
REPEAT VAL:=10*VAL+NEXT←CONTROL-48;NEXT←CONTROL:=GET←NEXT;
UNTIL(NEXT←CONTROL>57)OR(NEXT←CONTROL<48){:160};
BEGIN ACCUMULATOR:=ACCUMULATOR+NEXT←SIGN*(VAL);NEXT←SIGN:=+1;END;
GOTO 21;END;12:BEGIN{161:}VAL:=0;NEXT←CONTROL:=48;
REPEAT VAL:=8*VAL+NEXT←CONTROL-48;NEXT←CONTROL:=GET←NEXT;
UNTIL(NEXT←CONTROL>55)OR(NEXT←CONTROL<48){:161};
BEGIN ACCUMULATOR:=ACCUMULATOR+NEXT←SIGN*(VAL);NEXT←SIGN:=+1;END;
GOTO 21;END;13:BEGIN{162:}VAL:=0;NEXT←CONTROL:=48;
REPEAT IF NEXT←CONTROL>=65 THEN NEXT←CONTROL:=NEXT←CONTROL-7;
VAL:=16*VAL+NEXT←CONTROL-48;NEXT←CONTROL:=GET←NEXT;
UNTIL(NEXT←CONTROL>70)OR(NEXT←CONTROL<48)OR((NEXT←CONTROL>57)AND(
NEXT←CONTROL<65)){:162};BEGIN ACCUMULATOR:=ACCUMULATOR+NEXT←SIGN*(VAL);
NEXT←SIGN:=+1;END;GOTO 21;END;130:BEGIN Q:=ID←LOOKUP(0);
IF ILK[Q]<>1 THEN BEGIN NEXT←CONTROL:=42;GOTO 21;END;
BEGIN ACCUMULATOR:=ACCUMULATOR+NEXT←SIGN*(EQUIV[Q]-32768);NEXT←SIGN:=+1;
END;END;43:;45:NEXT←SIGN:=-NEXT←SIGN;132,133,135,134,136:GOTO 30;
59:BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Omit semicolon in numeric definition');ERROR;END;
OTHERS:{159:}BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Improper numeric definition will be flushed');ERROR;
END;REPEAT NEXT←CONTROL:=SKIP←AHEAD UNTIL(NEXT←CONTROL>=132);
IF NEXT←CONTROL=135 THEN BEGIN LOC:=LOC-2;NEXT←CONTROL:=GET←NEXT;END;
ACCUMULATOR:=0;GOTO 30;END{:159}END;END;30:{:158};
IF ABS(ACCUMULATOR)>=32768 THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Value too big: ',ACCUMULATOR:1);ERROR;END;
ACCUMULATOR:=0;END;EQUIV[P]:=ACCUMULATOR+32768;END;{:157}{165:}
PROCEDURE SCAN←REPL(T:EIGHT←BITS);LABEL 22,30,31;VAR A:SIXTEEN←BITS;
B:ASCII←CODE;BAL:EIGHT←BITS;BEGIN BAL:=0;
WHILE TRUE DO BEGIN 22:A:=GET←NEXT;CASE A OF 40:BAL:=BAL+1;
41:IF BAL=0 THEN BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,'! Extra )');
ERROR;END ELSE BAL:=BAL-1;39:{168:}BEGIN B:=39;
WHILE TRUE DO BEGIN BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(
TERM←OUT);WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');
ERROR;HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=B;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;
IF B=64 THEN IF BUFFER[LOC]=64 THEN LOC:=LOC+1 ELSE BEGIN WRITELN(
TERM←OUT);WRITE(TERM←OUT,'! You should double @ signs in strings');
ERROR;END;IF LOC=LIMIT THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! String didn''t end');ERROR;END;BUFFER[LOC]:=39;
BUFFER[LOC+1]:=0;END;B:=BUFFER[LOC];LOC:=LOC+1;
IF B=39 THEN BEGIN IF BUFFER[LOC]<>39 THEN GOTO 31 ELSE BEGIN LOC:=LOC+1
;BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=39;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;END;END;END;31:END{:168};
35:IF T=3 THEN A:=0;{167:}130:BEGIN A:=ID←LOOKUP(0);
BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=(A DIV 256)+128;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;A:=A MOD 256;END;
135:IF T<>135 THEN GOTO 30 ELSE BEGIN BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN
BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=(CUR←MODULE DIV 256)+168;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;A:=CUR←MODULE MOD 256;END;2:{169:}
BEGIN BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=2;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;BUFFER[LIMIT+1]:=64;
WHILE BUFFER[LOC]<>64 DO BEGIN BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN
WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=BUFFER[LOC];
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;LOC:=LOC+1;
IF LOC<LIMIT THEN IF(BUFFER[LOC]=64)AND(BUFFER[LOC+1]=64)THEN BEGIN
BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=64;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;LOC:=LOC+2;END;END;
IF LOC>=LIMIT THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Verbatim string didn''t end');ERROR;
END ELSE IF BUFFER[LOC+1]<>62 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! You should double @ signs in verbatim strings');ERROR;
END;LOC:=LOC+2;END{:169};
133,132,134:IF T<>135 THEN GOTO 30 ELSE BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! @',XCHR[BUFFER[LOC-1]],' is ignored in Pascal text');
ERROR;END;GOTO 22;END;136:GOTO 30;{:167}OTHERS:END;
BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=A;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;END;30:NEXT←CONTROL:=A;{166:}
IF BAL>0 THEN BEGIN IF BAL=1 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Missing )');ERROR;END ELSE BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Missing ',BAL:1,' )''s');ERROR;END;
WHILE BAL>0 DO BEGIN BEGIN IF TOK←PTR[Z]=MAX←TOKS THEN BEGIN WRITELN(
TERM←OUT);WRITE(TERM←OUT,'! Sorry, ','token',' capacity exceeded');
ERROR;HISTORY:=3;JUMP←OUT;END;TOK←MEM[Z,TOK←PTR[Z]]:=41;
TOK←PTR[Z]:=TOK←PTR[Z]+1;END;BAL:=BAL-1;END;END{:166};
IF TEXT←PTR>MAX←TEXTS-3 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Sorry, ','text',' capacity exceeded');ERROR;
HISTORY:=3;JUMP←OUT;END;CUR←REPL←TEXT:=TEXT←PTR;
TOK←START[TEXT←PTR+3]:=TOK←PTR[Z];TEXT←PTR:=TEXT←PTR+1;
IF Z=2 THEN Z:=0 ELSE Z:=Z+1;END;{:165}{170:}
PROCEDURE DEFINE←MACRO(T:EIGHT←BITS);VAR P:NAME←POINTER;
BEGIN P:=ID←LOOKUP(T);SCAN←REPL(T);EQUIV[P]:=CUR←REPL←TEXT;
TEXT←LINK[CUR←REPL←TEXT]:=0;END;{:170}{172:}PROCEDURE SCAN←MODULE;
LABEL 22,30,10;VAR P:NAME←POINTER;BEGIN MODULE←COUNT:=MODULE←COUNT+1;
{173:}NEXT←CONTROL:=0;
WHILE TRUE DO BEGIN 22:WHILE NEXT←CONTROL<=132 DO BEGIN NEXT←CONTROL:=
SKIP←AHEAD;IF NEXT←CONTROL=135 THEN BEGIN LOC:=LOC-2;
NEXT←CONTROL:=GET←NEXT;END;END;IF NEXT←CONTROL<>133 THEN GOTO 30;
NEXT←CONTROL:=GET←NEXT;
IF NEXT←CONTROL<>130 THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Definition flushed, must start with ',
'identifier of length > 1');ERROR;END;GOTO 22;END;
NEXT←CONTROL:=GET←NEXT;
IF NEXT←CONTROL=61 THEN BEGIN SCAN←NUMERIC(ID←LOOKUP(1));GOTO 22;
END ELSE IF NEXT←CONTROL=30 THEN BEGIN DEFINE←MACRO(2);GOTO 22;
END ELSE{174:}IF NEXT←CONTROL=40 THEN BEGIN NEXT←CONTROL:=GET←NEXT;
IF NEXT←CONTROL=35 THEN BEGIN NEXT←CONTROL:=GET←NEXT;
IF NEXT←CONTROL=41 THEN BEGIN NEXT←CONTROL:=GET←NEXT;
IF NEXT←CONTROL=61 THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Use == for macros');ERROR;END;NEXT←CONTROL:=30;END;
IF NEXT←CONTROL=30 THEN BEGIN DEFINE←MACRO(3);GOTO 22;END;END;END;END;
{:174};BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Definition flushed since it starts badly');ERROR;END;
END;30:{:173};{175:}CASE NEXT←CONTROL OF 134:P:=0;
135:BEGIN P:=CUR←MODULE;{176:}REPEAT NEXT←CONTROL:=GET←NEXT;
UNTIL NEXT←CONTROL<>43;
IF(NEXT←CONTROL<>61)AND(NEXT←CONTROL<>30)THEN BEGIN BEGIN WRITELN(
TERM←OUT);WRITE(TERM←OUT,'! Pascal text flushed, = sign is missing');
ERROR;END;REPEAT NEXT←CONTROL:=SKIP←AHEAD;UNTIL NEXT←CONTROL=136;
GOTO 10;END{:176};END;OTHERS:GOTO 10 END;{177:}
STORE←TWO←BYTES(53248+MODULE←COUNT);{:177};SCAN←REPL(135);{178:}
IF P=0 THEN BEGIN TEXT←LINK[LAST←UNNAMED]:=CUR←REPL←TEXT;
LAST←UNNAMED:=CUR←REPL←TEXT;
END ELSE IF EQUIV[P]=0 THEN EQUIV[P]:=CUR←REPL←TEXT ELSE BEGIN P:=EQUIV[
P];WHILE TEXT←LINK[P]<MAX←TEXTS DO P:=TEXT←LINK[P];
TEXT←LINK[P]:=CUR←REPL←TEXT;END;TEXT←LINK[CUR←REPL←TEXT]:=MAX←TEXTS;
{:178};{:175};10:END;{:172}{181:}{PROCEDURE DEBUG←HELP;LABEL 888,10;
VAR K:INTEGER;BEGIN DEBUG←SKIPPED:=DEBUG←SKIPPED+1;
IF DEBUG←SKIPPED<DEBUG←CYCLE THEN GOTO 10;DEBUG←SKIPPED:=0;
WHILE TRUE DO BEGIN WRITE(TERM←OUT,'#');BREAK(TERM←OUT);
READ(TERM←IN,DDT);
IF DDT<0 THEN GOTO 10 ELSE IF DDT=0 THEN BEGIN GOTO 888;
888:DDT:=0;
END ELSE BEGIN READ(TERM←IN,DD);CASE DDT OF 1:PRINT←ID(DD);
2:PRINT←REPL(DD);3:FOR K:=1 TO DD DO WRITE(TERM←OUT,XCHR[BUFFER[K]]);
4:FOR K:=1 TO DD DO WRITE(TERM←OUT,XCHR[MOD←TEXT[K]]);
5:FOR K:=1 TO OUT←PTR DO WRITE(TERM←OUT,XCHR[OUT←BUF[K]]);
6:FOR K:=1 TO DD DO WRITE(TERM←OUT,XCHR[OUT←CONTRIB[K]]);
OTHERS:WRITE(TERM←OUT,'?')END;END;END;10:END;}{:181}{182:}
BEGIN INITIALIZE;{134:}OPEN←INPUT;LINE:=0;OTHER←LINE:=0;CHANGING:=TRUE;
PRIME←THE←CHANGE←BUFFER;CHANGING:=NOT CHANGING;TEMP←LINE:=OTHER←LINE;
OTHER←LINE:=LINE;LINE:=TEMP←LINE;LIMIT:=0;LOC:=1;BUFFER[0]:=32;
INPUT←HAS←ENDED:=FALSE;{:134};
WRITELN(TERM←OUT,'This is Tangle 2.7 for Cedar 6.0');{183:}
PHASE←ONE:=TRUE;MODULE←COUNT:=0;REPEAT NEXT←CONTROL:=SKIP←AHEAD;
UNTIL NEXT←CONTROL=136;WHILE NOT INPUT←HAS←ENDED DO SCAN←MODULE;{138:}
IF CHANGE←LIMIT<>0 THEN BEGIN FOR LOC:=0 TO CHANGE←LIMIT DO BUFFER[LOC]
:=CHANGE←BUFFER[LOC];LIMIT:=CHANGE←LIMIT;CHANGING:=TRUE;
LINE:=OTHER←LINE;LOC:=CHANGE←LIMIT;BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Change file entry did not match');ERROR;END;END{:138};
PHASE←ONE:=FALSE;{:183};{FOR ZO:=0 TO 2 DO MAX←TOK←PTR[ZO]:=TOK←PTR[ZO];
}{112:}IF TEXT←LINK[0]=0 THEN BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! No output was specified.');END;
IF HISTORY=0 THEN HISTORY:=1;END ELSE BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'Writing the output file');END;BREAK(TERM←OUT);{83:}
STACK←PTR:=1;BRACE←LEVEL:=0;CUR←STATE.NAME←FIELD:=0;
CUR←STATE.REPL←FIELD:=TEXT←LINK[0];ZO:=CUR←STATE.REPL←FIELD MOD 3;
CUR←STATE.BYTE←FIELD:=TOK←START[CUR←STATE.REPL←FIELD];
CUR←STATE.END←FIELD:=TOK←START[CUR←STATE.REPL←FIELD+3];
CUR←STATE.MOD←FIELD:=0;{:83};{96:}OUT←STATE:=0;OUT←PTR:=0;BREAK←PTR:=0;
SEMI←PTR:=0;OUT←BUF[0]:=0;LINE:=1;{:96};SEND←THE←OUTPUT;{98:}
BREAK←PTR:=OUT←PTR;SEMI←PTR:=0;FLUSH←BUFFER;
IF BRACE←LEVEL<>0 THEN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'! Program ended at brace level ',BRACE←LEVEL:1);ERROR;
END;{:98};BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,'Done.');END;END{:112};
9999:IF STRING←PTR>128 THEN{184:}BEGIN BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,STRING←PTR-128:1,' strings written to string pool file.')
;END;WRITE(POOL,'*');
FOR STRING←PTR:=1 TO 9 DO BEGIN OUT←BUF[STRING←PTR]:=POOL←CHECK←SUM MOD
10;POOL←CHECK←SUM:=POOL←CHECK←SUM DIV 10;END;
FOR STRING←PTR:=9 DOWNTO 1 DO WRITE(POOL,XCHR[48+OUT←BUF[STRING←PTR]]);
WRITELN(POOL);END{:184};{[186:]BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'Memory usage statistics:');END;BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,NAME←PTR:1,' names, ',TEXT←PTR:1,' replacement texts;');
END;BEGIN WRITELN(TERM←OUT);WRITE(TERM←OUT,BYTE←PTR[0]:1);END;
FOR WO:=1 TO 1 DO WRITE(TERM←OUT,'+',BYTE←PTR[WO]:1);
WRITE(TERM←OUT,' bytes, ',MAX←TOK←PTR[0]:1);
FOR ZO:=1 TO 2 DO WRITE(TERM←OUT,'+',MAX←TOK←PTR[ZO]:1);
WRITE(TERM←OUT,' tokens.');[:186];}FILE←CLOSE(WEB←FILE);
FILE←CLOSE(CHANGE←FILE);FILE←CLOSE(PASCAL←FILE);FILE←CLOSE(POOL);{187:}
CASE HISTORY OF 0:BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'(No errors were found.)');END;1:BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'(Did you see the warning message above?)');END;
2:BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'(Pardon me, but I think I spotted something wrong.)');
END;3:BEGIN WRITELN(TERM←OUT);
WRITE(TERM←OUT,'(That was a fatal error, my friend.)');END;END{:187};
WRITELN(TERM←OUT);END.{:182}