{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}