{2:}{4:}{$MODE ISO}{$Q+}{$R+}{:4}PROGRAM TANGLE(OUTPUT);LABEL 9999;
CONST{8:}BUFSIZE=100;MAXBYTES=45000;MAXTOKS=65000;MAXNAMES=4000;
MAXTEXTS=2000;HASHSIZE=353;LONGESTNAME=400;LINELENGTH=72;OUTBUFSIZE=144;
STACKSIZE=50;MAXIDLENGTH=12;UNAMBIGLENGT=7;
{:8}TYPE{11:}ASCIICODE=0..255;{:11}{12:}TEXTFILE=TEXT;
{:12}{37:}EIGHTBITS=0..255;SIXTEENBITS=0..65535;
{:37}{39:}NAMEPOINTER=0..MAXNAMES;{:39}{43:}TEXTPOINTER=0..MAXTEXTS;
{:43}{78:}OUTPUTSTATE=RECORD ENDFIELD:SIXTEENBITS;BYTEFIELD:SIXTEENBITS;
NAMEFIELD:NAMEPOINTER;REPLFIELD:TEXTPOINTER;MODFIELD:0..12287;END;
{:78}VAR{9:}HISTORY:0..3;{:9}{13:}XORD:ARRAY[CHAR]OF ASCIICODE;
XCHR:ARRAY[ASCIICODE]OF CHAR;{:13}{23:}WEBFILE:TEXTFILE;
CHANGEFILE:TEXTFILE;{:23}{25:}PASCALFILE:TEXTFILE;POOL:TEXTFILE;
{:25}{27:}BUFFER:ARRAY[0..BUFSIZE]OF ASCIICODE;
{:27}{29:}PHASEONE:BOOLEAN;
{:29}{38:}BYTEMEM:PACKED ARRAY[0..1,0..MAXBYTES]OF ASCIICODE;
TOKMEM:PACKED ARRAY[0..3,0..MAXTOKS]OF EIGHTBITS;
BYTESTART:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
TOKSTART:ARRAY[0..MAXTEXTS]OF SIXTEENBITS;
LINK:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
ILK:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
EQUIV:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
TEXTLINK:ARRAY[0..MAXTEXTS]OF SIXTEENBITS;{:38}{40:}NAMEPTR:NAMEPOINTER;
STRINGPTR:NAMEPOINTER;BYTEPTR:ARRAY[0..1]OF 0..MAXBYTES;
POOLCHECKSUM:INTEGER;{:40}{44:}TEXTPTR:TEXTPOINTER;
TOKPTR:ARRAY[0..3]OF 0..MAXTOKS;Z:0..3;
{MAXTOKPTR:ARRAY[0..3]OF 0..MAXTOKS;}{:44}{50:}IDFIRST:0..BUFSIZE;
IDLOC:0..BUFSIZE;DOUBLECHARS:0..BUFSIZE;
HASH,CHOPHASH:ARRAY[0..HASHSIZE]OF SIXTEENBITS;
CHOPPEDID:ARRAY[0..UNAMBIGLENGT]OF ASCIICODE;
{:50}{65:}MODTEXT:ARRAY[0..LONGESTNAME]OF ASCIICODE;
{:65}{70:}LASTUNNAMED:TEXTPOINTER;{:70}{79:}CURSTATE:OUTPUTSTATE;
STACK:ARRAY[1..STACKSIZE]OF OUTPUTSTATE;STACKPTR:0..STACKSIZE;
{:79}{80:}ZO:0..3;{:80}{82:}BRACELEVEL:EIGHTBITS;
{:82}{86:}CURVAL:INTEGER;
{:86}{94:}OUTBUF:ARRAY[0..OUTBUFSIZE]OF ASCIICODE;OUTPTR:0..OUTBUFSIZE;
BREAKPTR:0..OUTBUFSIZE;SEMIPTR:0..OUTBUFSIZE;
{:94}{95:}OUTSTATE:EIGHTBITS;OUTVAL,OUTAPP:INTEGER;OUTSIGN:ASCIICODE;
LASTSIGN:-1..+1;{:95}{100:}OUTCONTRIB:ARRAY[1..LINELENGTH]OF ASCIICODE;
{:100}{124:}II:INTEGER;LINE:INTEGER;OTHERLINE:INTEGER;TEMPLINE:INTEGER;
LIMIT:0..BUFSIZE;LOC:0..BUFSIZE;INPUTHASENDE:BOOLEAN;CHANGING:BOOLEAN;
{:124}{126:}CHANGEBUFFER:ARRAY[0..BUFSIZE]OF ASCIICODE;
CHANGELIMIT:0..BUFSIZE;{:126}{143:}CURMODULE:NAMEPOINTER;
SCANNINGHEX:BOOLEAN;{:143}{156:}NEXTCONTROL:EIGHTBITS;
{:156}{164:}CURREPLTEXT:TEXTPOINTER;{:164}{171:}MODULECOUNT:0..12287;
{:171}{179:}{TROUBLESHOOT:BOOLEAN;DDT:INTEGER;DD:INTEGER;
DEBUGCYCLE:INTEGER;DEBUGSKIPPED:INTEGER;}{:179}{185:}{WO:0..1;}
{:185}{30:}{PROCEDURE DEBUGHELP;FORWARD;}{:30}{31:}PROCEDURE ERROR;
VAR J:0..OUTBUFSIZE;K,L:0..BUFSIZE;
BEGIN IF PHASEONE THEN{32:}BEGIN IF CHANGING THEN WRITE(
'. (change file ')ELSE WRITE('. (');WRITELN(OUTPUT,'l.',LINE:1,')');
IF LOC>=LIMIT THEN L:=LIMIT ELSE L:=LOC;
FOR K:=1 TO L DO IF BUFFER[K-1]=9 THEN WRITE(' ')ELSE WRITE(XCHR[BUFFER[
K-1]]);WRITELN(OUTPUT);FOR K:=1 TO L DO WRITE(' ');
FOR K:=L+1 TO LIMIT DO WRITE(XCHR[BUFFER[K-1]]);WRITE(' ');
END{:32}ELSE{33:}BEGIN WRITELN(OUTPUT,'. (l.',LINE:1,')');
FOR J:=1 TO OUTPTR DO WRITE(XCHR[OUTBUF[J-1]]);WRITE('... ');END{:33};;
HISTORY:=2;{DEBUGSKIPPED:=DEBUGCYCLE;DEBUGHELP;}END;
{:31}{34:}PROCEDURE JUMPOUT;BEGIN GOTO 9999;END;
{:34}PROCEDURE INITIALIZE;VAR{16:}I:0..255;{:16}{41:}WI:0..1;
{:41}{45:}ZI:0..3;{:45}{51:}H:0..HASHSIZE;{: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]:=' ';
FOR I:=128 TO 255 DO XCHR[I]:=' ';
{:17}{18:}FOR I:=0 TO 255 DO XORD[CHR(I)]:=32;
FOR I:=1 TO 255 DO XORD[XCHR[I]]:=I;XORD[' ']:=32;
{:18}{26:}IF PARAMCOUNT<>4 THEN BEGIN WRITELN('Usage: ',PARAMSTR(0),
' web_file change_file Pascal_file pool_file');HALT(1);END;
ASSIGN(PASCALFILE,PARAMSTR(3));ASSIGN(POOL,PARAMSTR(4));{$I-}IORESULT;
REWRITE(PASCALFILE);
IF IORESULT<>0 THEN BEGIN WRITELN('Could not open Pascal file: ',
PARAMSTR(3));HALT(1);END;IORESULT;REWRITE(POOL);
IF IORESULT<>0 THEN BEGIN WRITELN('Could not open pool file: ',PARAMSTR(
4));HALT(1);END;{$I+}{:26}{42:}FOR WI:=0 TO 1 DO BEGIN BYTESTART[WI]:=0;
BYTEPTR[WI]:=0;END;BYTESTART[2]:=0;NAMEPTR:=1;STRINGPTR:=256;
POOLCHECKSUM:=271828;{:42}{46:}FOR ZI:=0 TO 3 DO BEGIN TOKSTART[ZI]:=0;
TOKPTR[ZI]:=0;END;TOKSTART[4]:=0;TEXTPTR:=1;Z:=1 MOD 4;
{:46}{48:}ILK[0]:=0;EQUIV[0]:=0;
{:48}{52:}FOR H:=0 TO HASHSIZE-1 DO BEGIN HASH[H]:=0;CHOPHASH[H]:=0;END;
{:52}{71:}LASTUNNAMED:=0;TEXTLINK[0]:=0;{:71}{144:}SCANNINGHEX:=FALSE;
{:144}{152:}MODTEXT[0]:=32;{:152}{180:}{TROUBLESHOOT:=TRUE;
DEBUGCYCLE:=1;DEBUGSKIPPED:=0;TROUBLESHOOT:=FALSE;DEBUGCYCLE:=99999;}
{:180}END;{:2}{24:}PROCEDURE OPENINPUT;
BEGIN ASSIGN(WEBFILE,PARAMSTR(1));ASSIGN(CHANGEFILE,PARAMSTR(2));{$I-}
IORESULT;RESET(WEBFILE);
IF IORESULT<>0 THEN BEGIN WRITELN('Could not open web file: ',PARAMSTR(1
));HALT(1);END;IORESULT;RESET(CHANGEFILE);
IF IORESULT<>0 THEN BEGIN WRITELN('Could not open change file: ',
PARAMSTR(2));HALT(1);END;{$I+}END;
{:24}{28:}FUNCTION INPUTLN(VAR F:TEXTFILE):BOOLEAN;
VAR FINALLIMIT:0..BUFSIZE;BEGIN LIMIT:=0;FINALLIMIT:=0;
IF EOF(F)THEN INPUTLN:=FALSE ELSE BEGIN WHILE NOT EOLN(F)DO BEGIN BUFFER
[LIMIT]:=XORD[F^];GET(F);LIMIT:=LIMIT+1;
IF BUFFER[LIMIT-1]<>32 THEN FINALLIMIT:=LIMIT;
IF LIMIT=BUFSIZE THEN BEGIN WHILE NOT EOLN(F)DO GET(F);LIMIT:=LIMIT-1;
IF FINALLIMIT>LIMIT THEN FINALLIMIT:=LIMIT;BEGIN WRITELN(OUTPUT);
WRITE('! Input line too long');END;LOC:=0;ERROR;END;END;READLN(F);
LIMIT:=FINALLIMIT;INPUTLN:=TRUE;END;END;
{:28}{49:}PROCEDURE PRINTID(P:NAMEPOINTER);VAR K:0..MAXBYTES;W:0..1;
BEGIN IF P>=NAMEPTR THEN WRITE('IMPOSSIBLE')ELSE BEGIN W:=P MOD 2;
FOR K:=BYTESTART[P]TO BYTESTART[P+2]-1 DO WRITE(XCHR[BYTEMEM[W,K]]);END;
END;{:49}{53:}FUNCTION IDLOOKUP(T:EIGHTBITS):NAMEPOINTER;LABEL 31,32;
VAR C:EIGHTBITS;I:0..BUFSIZE;H:0..HASHSIZE;K:0..MAXBYTES;W:0..1;
L:0..BUFSIZE;P,Q:NAMEPOINTER;S:0..UNAMBIGLENGT;BEGIN L:=IDLOC-IDFIRST;
{54:}H:=BUFFER[IDFIRST];I:=IDFIRST+1;
WHILE I<IDLOC DO BEGIN H:=(H+H+BUFFER[I])MOD HASHSIZE;I:=I+1;END{:54};
{55:}P:=HASH[H];
WHILE P<>0 DO BEGIN IF BYTESTART[P+2]-BYTESTART[P]=L THEN{56:}BEGIN I:=
IDFIRST;K:=BYTESTART[P];W:=P MOD 2;
WHILE(I<IDLOC)AND(BUFFER[I]=BYTEMEM[W,K])DO BEGIN I:=I+1;K:=K+1;END;
IF I=IDLOC THEN GOTO 31;END{:56};P:=LINK[P];END;P:=NAMEPTR;
LINK[P]:=HASH[H];HASH[H]:=P;31:{:55};
IF(P=NAMEPTR)OR(T<>0)THEN{57:}BEGIN IF((P<>NAMEPTR)AND(T<>0)AND(ILK[P]=0
))OR((P=NAMEPTR)AND(T=0)AND(BUFFER[IDFIRST]<>34))THEN{58:}BEGIN I:=
IDFIRST;S:=0;H:=0;
WHILE(I<IDLOC)AND(S<UNAMBIGLENGT)DO BEGIN IF BUFFER[I]<>95 THEN BEGIN IF
BUFFER[I]>=97 THEN CHOPPEDID[S]:=BUFFER[I]-32 ELSE CHOPPEDID[S]:=BUFFER[
I];H:=(H+H+CHOPPEDID[S])MOD HASHSIZE;S:=S+1;END;I:=I+1;END;
CHOPPEDID[S]:=0;END{:58};
IF P<>NAMEPTR THEN{59:}BEGIN IF ILK[P]=0 THEN BEGIN IF T=1 THEN BEGIN
WRITELN(OUTPUT);WRITE('! This identifier has already appeared');ERROR;
END;{60:}Q:=CHOPHASH[H];
IF Q=P THEN CHOPHASH[H]:=EQUIV[P]ELSE BEGIN WHILE EQUIV[Q]<>P DO Q:=
EQUIV[Q];EQUIV[Q]:=EQUIV[P];END{:60};END ELSE BEGIN WRITELN(OUTPUT);
WRITE('! This identifier was defined before');ERROR;END;ILK[P]:=T;
END{:59}ELSE{61:}BEGIN IF(T=0)AND(BUFFER[IDFIRST]<>34)THEN{62:}BEGIN Q:=
CHOPHASH[H];WHILE Q<>0 DO BEGIN{63:}BEGIN K:=BYTESTART[Q];S:=0;
W:=Q MOD 2;
WHILE(K<BYTESTART[Q+2])AND(S<UNAMBIGLENGT)DO BEGIN C:=BYTEMEM[W,K];
IF C<>95 THEN BEGIN IF C>=97 THEN C:=C-32;
IF CHOPPEDID[S]<>C THEN GOTO 32;S:=S+1;END;K:=K+1;END;
IF(K=BYTESTART[Q+2])AND(CHOPPEDID[S]<>0)THEN GOTO 32;
BEGIN WRITELN(OUTPUT);WRITE('! Identifier conflict with ');END;
FOR K:=BYTESTART[Q]TO BYTESTART[Q+2]-1 DO WRITE(XCHR[BYTEMEM[W,K]]);
ERROR;Q:=0;32:END{:63};Q:=EQUIV[Q];END;EQUIV[P]:=CHOPHASH[H];
CHOPHASH[H]:=P;END{:62};W:=NAMEPTR MOD 2;K:=BYTEPTR[W];
IF K+L>MAXBYTES THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','byte memory',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;IF NAMEPTR>MAXNAMES-2 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','name',' capacity exceeded');ERROR;HISTORY:=3;JUMPOUT;
END;I:=IDFIRST;WHILE I<IDLOC DO BEGIN BYTEMEM[W,K]:=BUFFER[I];K:=K+1;
I:=I+1;END;BYTEPTR[W]:=K;BYTESTART[NAMEPTR+2]:=K;NAMEPTR:=NAMEPTR+1;
IF BUFFER[IDFIRST]<>34 THEN ILK[P]:=T ELSE{64:}BEGIN ILK[P]:=1;
IF L-DOUBLECHARS=2 THEN EQUIV[P]:=BUFFER[IDFIRST+1]+32768 ELSE BEGIN
EQUIV[P]:=STRINGPTR+32768;L:=L-DOUBLECHARS-1;
IF L>99 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Preprocessed string is too long');ERROR;END;
STRINGPTR:=STRINGPTR+1;WRITE(POOL,XCHR[48+L DIV 10],XCHR[48+L MOD 10]);
POOLCHECKSUM:=POOLCHECKSUM+POOLCHECKSUM+L;
WHILE POOLCHECKSUM>536870839 DO POOLCHECKSUM:=POOLCHECKSUM-536870839;
I:=IDFIRST+1;WHILE I<IDLOC DO BEGIN WRITE(POOL,XCHR[BUFFER[I]]);
POOLCHECKSUM:=POOLCHECKSUM+POOLCHECKSUM+BUFFER[I];
WHILE POOLCHECKSUM>536870839 DO POOLCHECKSUM:=POOLCHECKSUM-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};IDLOOKUP:=P;END;
{:53}{66:}FUNCTION MODLOOKUP(L:SIXTEENBITS):NAMEPOINTER;LABEL 31;
VAR C:0..4;J:0..LONGESTNAME;K:0..MAXBYTES;W:0..1;P:NAMEPOINTER;
Q:NAMEPOINTER;BEGIN C:=2;Q:=0;P:=ILK[0];
WHILE P<>0 DO BEGIN{68:}BEGIN K:=BYTESTART[P];W:=P MOD 2;C:=1;J:=1;
WHILE(K<BYTESTART[P+2])AND(J<=L)AND(MODTEXT[J]=BYTEMEM[W,K])DO BEGIN K:=
K+1;J:=J+1;END;
IF K=BYTESTART[P+2]THEN IF J>L THEN C:=1 ELSE C:=4 ELSE IF J>L THEN C:=3
ELSE IF MODTEXT[J]<BYTEMEM[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:=NAMEPTR MOD 2;K:=BYTEPTR[W];
IF K+L>MAXBYTES THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','byte memory',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;IF NAMEPTR>MAXNAMES-2 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','name',' capacity exceeded');ERROR;HISTORY:=3;JUMPOUT;
END;P:=NAMEPTR;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 BYTEMEM[W,K+J-1]:=MODTEXT[J];BYTEPTR[W]:=K+L;
BYTESTART[NAMEPTR+2]:=K+L;NAMEPTR:=NAMEPTR+1;{:67};
31:IF C<>1 THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Incompatible section names');ERROR;END;P:=0;END;MODLOOKUP:=P;
END;{:66}{69:}FUNCTION PREFIXLOOKUP(L:SIXTEENBITS):NAMEPOINTER;
VAR C:0..4;COUNT:0..MAXNAMES;J:0..LONGESTNAME;K:0..MAXBYTES;W:0..1;
P:NAMEPOINTER;Q:NAMEPOINTER;R:NAMEPOINTER;BEGIN Q:=0;P:=ILK[0];COUNT:=0;
R:=0;WHILE P<>0 DO BEGIN{68:}BEGIN K:=BYTESTART[P];W:=P MOD 2;C:=1;J:=1;
WHILE(K<BYTESTART[P+2])AND(J<=L)AND(MODTEXT[J]=BYTEMEM[W,K])DO BEGIN K:=
K+1;J:=J+1;END;
IF K=BYTESTART[P+2]THEN IF J>L THEN C:=1 ELSE C:=4 ELSE IF J>L THEN C:=3
ELSE IF MODTEXT[J]<BYTEMEM[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(OUTPUT);
WRITE('! Name does not match');ERROR;END ELSE BEGIN WRITELN(OUTPUT);
WRITE('! Ambiguous prefix');ERROR;END;PREFIXLOOKUP:=R;END;
{:69}{73:}PROCEDURE STORETWOBYTE(X:SIXTEENBITS);
BEGIN IF TOKPTR[Z]+2>MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=X DIV 256;
TOKMEM[Z,TOKPTR[Z]+1]:=X MOD 256;TOKPTR[Z]:=TOKPTR[Z]+2;END;
{:73}{74:}{PROCEDURE PRINTREPL(P:TEXTPOINTER);VAR K:0..MAXTOKS;
A:SIXTEENBITS;ZP:0..3;
BEGIN IF P>=TEXTPTR THEN WRITE('BAD')ELSE BEGIN K:=TOKSTART[P];
ZP:=P MOD 4;WHILE K<TOKSTART[P+4]DO BEGIN A:=TOKMEM[ZP,K];
IF A>=128 THEN[75:]BEGIN K:=K+1;
IF A<168 THEN BEGIN A:=(A-128)*256+TOKMEM[ZP,K];PRINTID(A);
IF BYTEMEM[A MOD 2,BYTESTART[A]]=34 THEN WRITE('"')ELSE WRITE(' ');
END ELSE IF A<208 THEN BEGIN WRITE('@<');
PRINTID((A-168)*256+TOKMEM[ZP,K]);WRITE('@>');
END ELSE BEGIN A:=(A-208)*256+TOKMEM[ZP,K];
WRITE('@',XCHR[123],A:1,'@',XCHR[125]);END;
END[:75]ELSE[76:]CASE A OF 9:WRITE('@',XCHR[123]);
10:WRITE('@',XCHR[125]);12:WRITE('@''');13:WRITE('@"');125:WRITE('@$');
0:WRITE('#');64:WRITE('@@');2:WRITE('@=');3:WRITE('@\');
ELSE WRITE(XCHR[A])END[:76];K:=K+1;END;END;END;}
{:74}{84:}PROCEDURE PUSHLEVEL(P:NAMEPOINTER);
BEGIN IF STACKPTR=STACKSIZE THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','stack',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END ELSE BEGIN STACK[STACKPTR]:=CURSTATE;STACKPTR:=STACKPTR+1;
CURSTATE.NAMEFIELD:=P;CURSTATE.REPLFIELD:=EQUIV[P];
ZO:=CURSTATE.REPLFIELD MOD 4;
CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+4];CURSTATE.MODFIELD:=0;
END;END;{:84}{85:}PROCEDURE POPLEVEL;LABEL 10;
BEGIN IF TEXTLINK[CURSTATE.REPLFIELD]=0 THEN BEGIN IF ILK[CURSTATE.
NAMEFIELD]=3 THEN{91:}BEGIN NAMEPTR:=NAMEPTR-1;TEXTPTR:=TEXTPTR-1;
Z:=TEXTPTR MOD 4;{IF TOKPTR[Z]>MAXTOKPTR[Z]THEN MAXTOKPTR[Z]:=TOKPTR[Z];
}TOKPTR[Z]:=TOKSTART[TEXTPTR];
{BYTEPTR[NAMEPTR MOD 2]:=BYTEPTR[NAMEPTR MOD 2]-1;}END{:91};
END ELSE IF TEXTLINK[CURSTATE.REPLFIELD]<MAXTEXTS THEN BEGIN CURSTATE.
REPLFIELD:=TEXTLINK[CURSTATE.REPLFIELD];ZO:=CURSTATE.REPLFIELD MOD 4;
CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+4];GOTO 10;END;
STACKPTR:=STACKPTR-1;IF STACKPTR>0 THEN BEGIN CURSTATE:=STACK[STACKPTR];
ZO:=CURSTATE.REPLFIELD MOD 4;END;10:END;
{:85}{87:}FUNCTION GETOUTPUT:SIXTEENBITS;LABEL 20,30,31;
VAR A:SIXTEENBITS;B:EIGHTBITS;BAL:SIXTEENBITS;K:0..MAXBYTES;W:0..1;
BEGIN 20:IF STACKPTR=0 THEN BEGIN A:=0;GOTO 31;END;
IF CURSTATE.BYTEFIELD=CURSTATE.ENDFIELD THEN BEGIN CURVAL:=-CURSTATE.
MODFIELD;POPLEVEL;IF CURVAL=0 THEN GOTO 20;A:=129;GOTO 31;END;
A:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
IF A<128 THEN IF A=0 THEN{92:}BEGIN PUSHLEVEL(NAMEPTR-1);GOTO 20;
END{:92}ELSE GOTO 31;A:=(A-128)*256+TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
IF A<10240 THEN{89:}BEGIN CASE ILK[A]OF 0:BEGIN CURVAL:=A;A:=130;END;
1:BEGIN CURVAL:=EQUIV[A]-32768;A:=128;END;2:BEGIN PUSHLEVEL(A);GOTO 20;
END;
3:BEGIN{90:}WHILE(CURSTATE.BYTEFIELD=CURSTATE.ENDFIELD)AND(STACKPTR>0)DO
POPLEVEL;
IF(STACKPTR=0)OR(TOKMEM[ZO,CURSTATE.BYTEFIELD]<>40)THEN BEGIN BEGIN
WRITELN(OUTPUT);WRITE('! No parameter given for ');END;PRINTID(A);ERROR;
GOTO 20;END;{93:}BAL:=1;CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
WHILE TRUE DO BEGIN B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
IF B=0 THEN STORETWOBYTE(NAMEPTR+32767)ELSE BEGIN IF B>=128 THEN BEGIN
BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;
B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+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 TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;
B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;UNTIL B=39;ELSE END;
BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;END;END;
30:{:93};EQUIV[NAMEPTR]:=TEXTPTR;ILK[NAMEPTR]:=2;W:=NAMEPTR MOD 2;
K:=BYTEPTR[W];{IF K=MAXBYTES THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','byte memory',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;BYTEMEM[W,K]:=35;K:=K+1;BYTEPTR[W]:=K;}
IF NAMEPTR>MAXNAMES-2 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','name',' capacity exceeded');ERROR;HISTORY:=3;JUMPOUT;
END;BYTESTART[NAMEPTR+2]:=K;NAMEPTR:=NAMEPTR+1;
IF TEXTPTR>MAXTEXTS-4 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','text',' capacity exceeded');ERROR;HISTORY:=3;JUMPOUT;
END;TEXTLINK[TEXTPTR]:=0;TOKSTART[TEXTPTR+4]:=TOKPTR[Z];
TEXTPTR:=TEXTPTR+1;Z:=TEXTPTR MOD 4{:90};PUSHLEVEL(A);GOTO 20;END;
ELSE BEGIN WRITELN(OUTPUT);WRITE('! This can''t happen (','output',')');
ERROR;HISTORY:=3;JUMPOUT;END END;GOTO 31;END{:89};
IF A<20480 THEN{88:}BEGIN A:=A-10240;
IF EQUIV[A]<>0 THEN PUSHLEVEL(A)ELSE IF A<>0 THEN BEGIN BEGIN WRITELN(
OUTPUT);WRITE('! Not present: <');END;PRINTID(A);WRITE('>');ERROR;END;
GOTO 20;END{:88};CURVAL:=A-20480;A:=129;CURSTATE.MODFIELD:=CURVAL;
31:{IF TROUBLESHOOT THEN DEBUGHELP;}GETOUTPUT:=A;END;
{:87}{97:}PROCEDURE FLUSHBUFFER;VAR K:0..OUTBUFSIZE;B:0..OUTBUFSIZE;
BEGIN B:=BREAKPTR;
IF(SEMIPTR<>0)AND(OUTPTR-SEMIPTR<=LINELENGTH)THEN BREAKPTR:=SEMIPTR;
FOR K:=1 TO BREAKPTR DO WRITE(PASCALFILE,XCHR[OUTBUF[K-1]]);
WRITELN(PASCALFILE);LINE:=LINE+1;
IF LINE MOD 100=0 THEN BEGIN WRITE('.');
IF LINE MOD 500=0 THEN WRITE(LINE:1);;END;
IF BREAKPTR<OUTPTR THEN BEGIN IF OUTBUF[BREAKPTR]=32 THEN BEGIN BREAKPTR
:=BREAKPTR+1;IF BREAKPTR>B THEN B:=BREAKPTR;END;
FOR K:=BREAKPTR TO OUTPTR-1 DO OUTBUF[K-BREAKPTR]:=OUTBUF[K];END;
OUTPTR:=OUTPTR-BREAKPTR;BREAKPTR:=B-BREAKPTR;SEMIPTR:=0;
IF OUTPTR>LINELENGTH THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Long line must be truncated');ERROR;END;OUTPTR:=LINELENGTH;END;
END;{:97}{99:}PROCEDURE APPVAL(V:INTEGER);VAR K:0..OUTBUFSIZE;
BEGIN K:=OUTBUFSIZE;REPEAT OUTBUF[K]:=V MOD 10;V:=V DIV 10;K:=K-1;
UNTIL V=0;REPEAT K:=K+1;BEGIN OUTBUF[OUTPTR]:=OUTBUF[K]+48;
OUTPTR:=OUTPTR+1;END;UNTIL K=OUTBUFSIZE;END;
{:99}{101:}PROCEDURE SENDOUT(T:EIGHTBITS;V:SIXTEENBITS);LABEL 20;
VAR K:0..LINELENGTH;
BEGIN{102:}20:CASE OUTSTATE OF 1:IF T<>3 THEN BEGIN BREAKPTR:=OUTPTR;
IF T=2 THEN BEGIN OUTBUF[OUTPTR]:=32;OUTPTR:=OUTPTR+1;END;END;
2:BEGIN BEGIN OUTBUF[OUTPTR]:=44-OUTAPP;OUTPTR:=OUTPTR+1;END;
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;BREAKPTR:=OUTPTR;END;
3,4:BEGIN{103:}IF(OUTVAL<0)OR((OUTVAL=0)AND(LASTSIGN<0))THEN BEGIN
OUTBUF[OUTPTR]:=45;OUTPTR:=OUTPTR+1;
END ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=OUTSIGN;
OUTPTR:=OUTPTR+1;END;APPVAL(ABS(OUTVAL));
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;{:103};OUTSTATE:=OUTSTATE-2;
GOTO 20;END;
5:{104:}BEGIN IF(T=3)OR({105:}((T=2)AND(V=3)AND(((OUTCONTRIB[1]=68)AND(
OUTCONTRIB[2]=73)AND(OUTCONTRIB[3]=86))OR((OUTCONTRIB[1]=77)AND(
OUTCONTRIB[2]=79)AND(OUTCONTRIB[3]=68))))OR((T=0)AND((V=42)OR(V=47)))
{:105})THEN BEGIN{103:}IF(OUTVAL<0)OR((OUTVAL=0)AND(LASTSIGN<0))THEN
BEGIN OUTBUF[OUTPTR]:=45;OUTPTR:=OUTPTR+1;
END ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=OUTSIGN;
OUTPTR:=OUTPTR+1;END;APPVAL(ABS(OUTVAL));
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;{:103};OUTSIGN:=43;OUTVAL:=OUTAPP;
END ELSE OUTVAL:=OUTVAL+OUTAPP;OUTSTATE:=3;GOTO 20;END{:104};
0:IF T<>3 THEN BREAKPTR:=OUTPTR;ELSE END{:102};
IF T<>0 THEN FOR K:=1 TO V DO BEGIN OUTBUF[OUTPTR]:=OUTCONTRIB[K];
OUTPTR:=OUTPTR+1;END ELSE BEGIN OUTBUF[OUTPTR]:=V;OUTPTR:=OUTPTR+1;END;
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;
IF(T=0)AND((V=59)OR(V=125))THEN BEGIN SEMIPTR:=OUTPTR;BREAKPTR:=OUTPTR;
END;IF T>=2 THEN OUTSTATE:=1 ELSE OUTSTATE:=0 END;
{:101}{106:}PROCEDURE SENDSIGN(V:INTEGER);
BEGIN CASE OUTSTATE OF 2,4:OUTAPP:=OUTAPP*V;3:BEGIN OUTAPP:=V;
OUTSTATE:=4;END;5:BEGIN OUTVAL:=OUTVAL+OUTAPP;OUTAPP:=V;OUTSTATE:=4;END;
ELSE BEGIN BREAKPTR:=OUTPTR;OUTAPP:=V;OUTSTATE:=2;END END;
LASTSIGN:=OUTAPP;END;{:106}{107:}PROCEDURE SENDVAL(V:INTEGER);
LABEL 666,10;
BEGIN CASE OUTSTATE OF 1:BEGIN{110:}IF(OUTPTR=BREAKPTR+3)OR((OUTPTR=
BREAKPTR+4)AND(OUTBUF[BREAKPTR]=32))THEN IF((OUTBUF[OUTPTR-3]=68)AND(
OUTBUF[OUTPTR-2]=73)AND(OUTBUF[OUTPTR-1]=86))OR((OUTBUF[OUTPTR-3]=77)AND
(OUTBUF[OUTPTR-2]=79)AND(OUTBUF[OUTPTR-1]=68))THEN GOTO 666{:110};
OUTSIGN:=32;OUTSTATE:=3;OUTVAL:=V;BREAKPTR:=OUTPTR;LASTSIGN:=+1;END;
0:BEGIN{109:}IF(OUTPTR=BREAKPTR+1)AND((OUTBUF[BREAKPTR]=42)OR(OUTBUF[
BREAKPTR]=47))THEN GOTO 666{:109};OUTSIGN:=0;OUTSTATE:=3;OUTVAL:=V;
BREAKPTR:=OUTPTR;LASTSIGN:=+1;END;{108:}2:BEGIN OUTSIGN:=43;OUTSTATE:=3;
OUTVAL:=OUTAPP*V;END;3:BEGIN OUTSTATE:=5;OUTAPP:=V;
BEGIN WRITELN(OUTPUT);
WRITE('! Two numbers occurred without a sign between them');ERROR;END;
END;4:BEGIN OUTSTATE:=5;OUTAPP:=OUTAPP*V;END;
5:BEGIN OUTVAL:=OUTVAL+OUTAPP;OUTAPP:=V;BEGIN WRITELN(OUTPUT);
WRITE('! Two numbers occurred without a sign between them');ERROR;END;
END;{:108}ELSE GOTO 666 END;GOTO 10;
666:{111:}IF V>=0 THEN BEGIN IF OUTSTATE=1 THEN BEGIN BREAKPTR:=OUTPTR;
BEGIN OUTBUF[OUTPTR]:=32;OUTPTR:=OUTPTR+1;END;END;APPVAL(V);
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;OUTSTATE:=1;
END ELSE BEGIN BEGIN OUTBUF[OUTPTR]:=40;OUTPTR:=OUTPTR+1;END;
BEGIN OUTBUF[OUTPTR]:=45;OUTPTR:=OUTPTR+1;END;APPVAL(-V);
BEGIN OUTBUF[OUTPTR]:=41;OUTPTR:=OUTPTR+1;END;
IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;OUTSTATE:=0;END{:111};10:END;
{:107}{113:}PROCEDURE SENDTHEOUTPU;LABEL 2,21,22;VAR CURCHAR:EIGHTBITS;
K:0..LINELENGTH;J:0..MAXBYTES;W:0..1;N:INTEGER;
BEGIN WHILE STACKPTR>0 DO BEGIN CURCHAR:=GETOUTPUT;
21:CASE CURCHAR 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 OUTCONTRIB[1]:=CURCHAR;SENDOUT(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 OUTCONTRIB[1]:=CURCHAR-32;
SENDOUT(2,1);END;130:BEGIN K:=0;J:=BYTESTART[CURVAL];W:=CURVAL MOD 2;
WHILE(K<MAXIDLENGTH)AND(J<BYTESTART[CURVAL+2])DO BEGIN K:=K+1;
OUTCONTRIB[K]:=BYTEMEM[W,J];J:=J+1;
IF OUTCONTRIB[K]>=97 THEN OUTCONTRIB[K]:=OUTCONTRIB[K]-32 ELSE IF
OUTCONTRIB[K]=95 THEN K:=K-1;END;SENDOUT(2,K);END;
{:116}{119:}48,49,50,51,52,53,54,55,56,57:BEGIN N:=0;
REPEAT CURCHAR:=CURCHAR-48;IF N>=214748364 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Constant too big');ERROR;END ELSE N:=10*N+CURCHAR;
CURCHAR:=GETOUTPUT;UNTIL(CURCHAR>57)OR(CURCHAR<48);SENDVAL(N);K:=0;
IF CURCHAR=101 THEN CURCHAR:=69;IF CURCHAR=69 THEN GOTO 2 ELSE GOTO 21;
END;125:SENDVAL(POOLCHECKSUM);12:BEGIN N:=0;CURCHAR:=48;
REPEAT CURCHAR:=CURCHAR-48;IF N>=268435456 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Constant too big');ERROR;END ELSE N:=8*N+CURCHAR;
CURCHAR:=GETOUTPUT;UNTIL(CURCHAR>55)OR(CURCHAR<48);SENDVAL(N);GOTO 21;
END;13:BEGIN N:=0;CURCHAR:=48;
REPEAT IF CURCHAR>=65 THEN CURCHAR:=CURCHAR-55 ELSE CURCHAR:=CURCHAR-48;
IF N>=134217728 THEN BEGIN WRITELN(OUTPUT);WRITE('! Constant too big');
ERROR;END ELSE N:=16*N+CURCHAR;CURCHAR:=GETOUTPUT;
UNTIL(CURCHAR>70)OR(CURCHAR<48)OR((CURCHAR>57)AND(CURCHAR<65));
SENDVAL(N);GOTO 21;END;128:SENDVAL(CURVAL);46:BEGIN K:=1;
OUTCONTRIB[1]:=46;CURCHAR:=GETOUTPUT;
IF CURCHAR=46 THEN BEGIN OUTCONTRIB[2]:=46;SENDOUT(1,2);
END ELSE IF(CURCHAR>=48)AND(CURCHAR<=57)THEN GOTO 2 ELSE BEGIN SENDOUT(0
,46);GOTO 21;END;END;{:119}43,45:SENDSIGN(44-CURCHAR);
{114:}4:BEGIN OUTCONTRIB[1]:=65;OUTCONTRIB[2]:=78;OUTCONTRIB[3]:=68;
SENDOUT(2,3);END;5:BEGIN OUTCONTRIB[1]:=78;OUTCONTRIB[2]:=79;
OUTCONTRIB[3]:=84;SENDOUT(2,3);END;6:BEGIN OUTCONTRIB[1]:=73;
OUTCONTRIB[2]:=78;SENDOUT(2,2);END;31:BEGIN OUTCONTRIB[1]:=79;
OUTCONTRIB[2]:=82;SENDOUT(2,2);END;24:BEGIN OUTCONTRIB[1]:=58;
OUTCONTRIB[2]:=61;SENDOUT(1,2);END;26:BEGIN OUTCONTRIB[1]:=60;
OUTCONTRIB[2]:=62;SENDOUT(1,2);END;28:BEGIN OUTCONTRIB[1]:=60;
OUTCONTRIB[2]:=61;SENDOUT(1,2);END;29:BEGIN OUTCONTRIB[1]:=62;
OUTCONTRIB[2]:=61;SENDOUT(1,2);END;30:BEGIN OUTCONTRIB[1]:=61;
OUTCONTRIB[2]:=61;SENDOUT(1,2);END;32:BEGIN OUTCONTRIB[1]:=46;
OUTCONTRIB[2]:=46;SENDOUT(1,2);END;{:114}39:{117:}BEGIN K:=1;
OUTCONTRIB[1]:=39;REPEAT IF K<LINELENGTH THEN K:=K+1;
OUTCONTRIB[K]:=GETOUTPUT;UNTIL(OUTCONTRIB[K]=39)OR(STACKPTR=0);
IF K=LINELENGTH THEN BEGIN WRITELN(OUTPUT);WRITE('! String too long');
ERROR;END;SENDOUT(1,K);CURCHAR:=GETOUTPUT;
IF CURCHAR=39 THEN OUTSTATE:=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}:SENDOUT(0,CURCHAR);
{121:}9:BEGIN IF BRACELEVEL=0 THEN SENDOUT(0,123)ELSE SENDOUT(0,91);
BRACELEVEL:=BRACELEVEL+1;END;
10:IF BRACELEVEL>0 THEN BEGIN BRACELEVEL:=BRACELEVEL-1;
IF BRACELEVEL=0 THEN SENDOUT(0,125)ELSE SENDOUT(0,93);
END ELSE BEGIN WRITELN(OUTPUT);WRITE('! Extra @}');ERROR;END;
129:BEGIN K:=2;
IF BRACELEVEL=0 THEN OUTCONTRIB[1]:=123 ELSE OUTCONTRIB[1]:=91;
IF CURVAL<0 THEN BEGIN OUTCONTRIB[K]:=58;CURVAL:=-CURVAL;K:=K+1;END;
N:=10;WHILE CURVAL>=N DO N:=10*N;REPEAT N:=N DIV 10;
OUTCONTRIB[K]:=48+(CURVAL DIV N);CURVAL:=CURVAL MOD N;K:=K+1;UNTIL N=1;
IF OUTCONTRIB[2]<>58 THEN BEGIN OUTCONTRIB[K]:=58;K:=K+1;END;
IF BRACELEVEL=0 THEN OUTCONTRIB[K]:=125 ELSE OUTCONTRIB[K]:=93;
SENDOUT(1,K);END;{:121}127:BEGIN SENDOUT(3,0);OUTSTATE:=6;END;
2:{118:}BEGIN K:=0;REPEAT IF K<LINELENGTH THEN K:=K+1;
OUTCONTRIB[K]:=GETOUTPUT;UNTIL(OUTCONTRIB[K]=2)OR(STACKPTR=0);
IF K=LINELENGTH THEN BEGIN WRITELN(OUTPUT);
WRITE('! Verbatim string too long');ERROR;END;SENDOUT(1,K-1);END{:118};
3:{122:}BEGIN SENDOUT(1,0);
WHILE OUTPTR>0 DO BEGIN IF OUTPTR<=LINELENGTH THEN BREAKPTR:=OUTPTR;
FLUSHBUFFER;END;OUTSTATE:=0;END{:122};ELSE BEGIN WRITELN(OUTPUT);
WRITE('! Can''t output ASCII code ',CURCHAR:1);ERROR;END END;GOTO 22;
2:{120:}REPEAT IF K<LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=CURCHAR;
CURCHAR:=GETOUTPUT;
IF(OUTCONTRIB[K]=69)AND((CURCHAR=43)OR(CURCHAR=45))THEN BEGIN IF K<
LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=CURCHAR;CURCHAR:=GETOUTPUT;
END ELSE IF CURCHAR=101 THEN CURCHAR:=69;
UNTIL(CURCHAR<>69)AND((CURCHAR<48)OR(CURCHAR>57));
IF K=LINELENGTH THEN BEGIN WRITELN(OUTPUT);WRITE('! Fraction too long');
ERROR;END;SENDOUT(3,K);GOTO 21{:120};22:END;END;
{:113}{127:}FUNCTION LINESDONTMAT:BOOLEAN;LABEL 10;VAR K:0..BUFSIZE;
BEGIN LINESDONTMAT:=TRUE;IF CHANGELIMIT<>LIMIT THEN GOTO 10;
IF LIMIT>0 THEN FOR K:=0 TO LIMIT-1 DO IF CHANGEBUFFER[K]<>BUFFER[K]THEN
GOTO 10;LINESDONTMAT:=FALSE;10:END;{:127}{128:}PROCEDURE PRIMETHECHAN;
LABEL 22,30,10;VAR K:0..BUFSIZE;BEGIN CHANGELIMIT:=0;
{129:}WHILE TRUE DO BEGIN LINE:=LINE+1;
IF NOT INPUTLN(CHANGEFILE)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(OUTPUT);WRITE('! Where is the matching @x?');ERROR;END;
END;22:END;30:{:129};{130:}REPEAT LINE:=LINE+1;
IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Change file ended after @x');ERROR;END;GOTO 10;END;
UNTIL LIMIT>0;{:130};{131:}BEGIN CHANGELIMIT:=LIMIT;
IF LIMIT>0 THEN FOR K:=0 TO LIMIT-1 DO CHANGEBUFFER[K]:=BUFFER[K];
END{:131};10:END;{:128}{132:}PROCEDURE CHECKCHANGE;LABEL 10;
VAR N:INTEGER;K:0..BUFSIZE;BEGIN IF LINESDONTMAT THEN GOTO 10;N:=0;
WHILE TRUE DO BEGIN CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;
OTHERLINE:=LINE;LINE:=TEMPLINE;LINE:=LINE+1;
IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Change file ended before @y');ERROR;END;CHANGELIMIT:=0;
CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
LINE:=TEMPLINE;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(OUTPUT);WRITE('! Where is the matching @y?');ERROR;END;
END ELSE IF BUFFER[1]=121 THEN BEGIN IF N>0 THEN BEGIN LOC:=2;
BEGIN WRITELN(OUTPUT);
WRITE('! Hmm... ',N:1,' of the preceding lines failed to match');ERROR;
END;END;GOTO 10;END;END{:133};{131:}BEGIN CHANGELIMIT:=LIMIT;
IF LIMIT>0 THEN FOR K:=0 TO LIMIT-1 DO CHANGEBUFFER[K]:=BUFFER[K];
END{:131};CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
LINE:=TEMPLINE;LINE:=LINE+1;
IF NOT INPUTLN(WEBFILE)THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! WEB file ended during a change');ERROR;END;INPUTHASENDE:=TRUE;
GOTO 10;END;IF LINESDONTMAT THEN N:=N+1;END;10:END;
{:132}{135:}PROCEDURE GETLINE;LABEL 20;
BEGIN 20:IF CHANGING THEN{137:}BEGIN LINE:=LINE+1;
IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! 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(OUTPUT);WRITE('! Where is the matching @z?');ERROR;END;
END ELSE IF BUFFER[1]=122 THEN BEGIN PRIMETHECHAN;
CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
LINE:=TEMPLINE;END;END;END{:137};
IF NOT CHANGING THEN BEGIN{136:}BEGIN LINE:=LINE+1;
IF NOT INPUTLN(WEBFILE)THEN INPUTHASENDE:=TRUE ELSE IF CHANGELIMIT>0
THEN CHECKCHANGE;END{:136};IF CHANGING THEN GOTO 20;END;LOC:=0;
BUFFER[LIMIT]:=32;END;
{:135}{139:}FUNCTION CONTROLCODE(C:ASCIICODE):EIGHTBITS;
BEGIN CASE C OF 64:CONTROLCODE:=64;39:CONTROLCODE:=12;
34:CONTROLCODE:=13;36:CONTROLCODE:=125;32,9:CONTROLCODE:=136;
42:BEGIN WRITE('*',MODULECOUNT+1:1);;CONTROLCODE:=136;END;
68,100:CONTROLCODE:=133;70,102:CONTROLCODE:=132;123:CONTROLCODE:=9;
125:CONTROLCODE:=10;80,112:CONTROLCODE:=134;
84,116,94,46,58:CONTROLCODE:=131;38:CONTROLCODE:=127;
60:CONTROLCODE:=135;61:CONTROLCODE:=2;92:CONTROLCODE:=3;
ELSE CONTROLCODE:=0 END;END;{:139}{140:}FUNCTION SKIPAHEAD:EIGHTBITS;
LABEL 30;VAR C:EIGHTBITS;
BEGIN WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
IF INPUTHASENDE 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:=CONTROLCODE(BUFFER[LOC-1]);IF(C<>0)OR(BUFFER[LOC-1]=62)THEN GOTO 30;
END;END;30:SKIPAHEAD:=C;END;{:140}{141:}PROCEDURE SKIPCOMMENT;LABEL 10;
VAR BAL:EIGHTBITS;C:ASCIICODE;BEGIN BAL:=0;
WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
IF INPUTHASENDE THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! 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)THEN LOC:=LOC+1 ELSE BEGIN BEGIN WRITELN(
OUTPUT);WRITE('! 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 GETNEXT:EIGHTBITS;
LABEL 20,30,31;VAR C:EIGHTBITS;D:EIGHTBITS;J,K:0..LONGESTNAME;
BEGIN 20:IF LOC>LIMIT THEN BEGIN GETLINE;
IF INPUTHASENDE THEN BEGIN C:=136;GOTO 31;END;END;C:=BUFFER[LOC];
LOC:=LOC+1;
IF SCANNINGHEX THEN{146:}IF((C>=48)AND(C<=57))OR((C>=65)AND(C<=70))THEN
GOTO 31 ELSE SCANNINGHEX:=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;IDFIRST:=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>IDFIRST+1 THEN BEGIN C:=130;IDLOC:=LOC;END;END ELSE C:=69;
END{:148};34:{149:}BEGIN DOUBLECHARS:=0;IDFIRST:=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;
DOUBLECHARS:=DOUBLECHARS+1;
END ELSE BEGIN IF D=64 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Double @ sign missing');ERROR;
END END ELSE IF LOC>LIMIT THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! String constant didn''t end');ERROR;END;D:=34;END;UNTIL D=34;
IDLOC:=LOC-1;C:=130;END{:149};
64:{150:}BEGIN C:=CONTROLCODE(BUFFER[LOC]);LOC:=LOC+1;
IF C=0 THEN GOTO 20 ELSE IF C=13 THEN SCANNINGHEX:=TRUE ELSE IF C=135
THEN{151:}BEGIN{153:}K:=0;
WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
IF INPUTHASENDE THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! 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(OUTPUT);
WRITE('! Section name didn''t end');ERROR;END;GOTO 30;END;K:=K+1;
MODTEXT[K]:=64;LOC:=LOC+1;END{:154};LOC:=LOC+1;
IF K<LONGESTNAME-1 THEN K:=K+1;IF(D=32)OR(D=9)THEN BEGIN D:=32;
IF MODTEXT[K-1]=32 THEN K:=K-1;END;MODTEXT[K]:=D;END;
30:{155:}IF K>=LONGESTNAME-2 THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Section name too long: ');END;
FOR J:=1 TO 25 DO WRITE(XCHR[MODTEXT[J]]);WRITE('...');
IF HISTORY=0 THEN HISTORY:=1;END{:155};
IF(MODTEXT[K]=32)AND(K>0)THEN K:=K-1;{:153};
IF K>3 THEN BEGIN IF(MODTEXT[K]=46)AND(MODTEXT[K-1]=46)AND(MODTEXT[K-2]=
46)THEN CURMODULE:=PREFIXLOOKUP(K-3)ELSE CURMODULE:=MODLOOKUP(K);
END ELSE CURMODULE:=MODLOOKUP(K);
END{:151}ELSE IF C=131 THEN BEGIN REPEAT C:=SKIPAHEAD;UNTIL C<>64;
IF BUFFER[LOC-1]<>62 THEN BEGIN WRITELN(OUTPUT);
WRITE('! 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 SKIPCOMMENT;GOTO 20;END;
125:BEGIN BEGIN WRITELN(OUTPUT);WRITE('! Extra }');ERROR;END;GOTO 20;
END;ELSE IF C>=128 THEN GOTO 20 ELSE END;
31:{IF TROUBLESHOOT THEN DEBUGHELP;}GETNEXT:=C;END;
{:145}{157:}PROCEDURE SCANNUMERIC(P:NAMEPOINTER);LABEL 21,30;
VAR ACCUMULATOR:INTEGER;NEXTSIGN:-1..+1;Q:NAMEPOINTER;VAL:INTEGER;
BEGIN{158:}ACCUMULATOR:=0;NEXTSIGN:=+1;
WHILE TRUE DO BEGIN NEXTCONTROL:=GETNEXT;
21:CASE NEXTCONTROL OF 48,49,50,51,52,53,54,55,56,57:BEGIN{160:}VAL:=0;
REPEAT VAL:=10*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
UNTIL(NEXTCONTROL>57)OR(NEXTCONTROL<48){:160};
BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(VAL);NEXTSIGN:=+1;END;GOTO 21;
END;12:BEGIN{161:}VAL:=0;NEXTCONTROL:=48;
REPEAT VAL:=8*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
UNTIL(NEXTCONTROL>55)OR(NEXTCONTROL<48){:161};
BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(VAL);NEXTSIGN:=+1;END;GOTO 21;
END;13:BEGIN{162:}VAL:=0;NEXTCONTROL:=48;
REPEAT IF NEXTCONTROL>=65 THEN NEXTCONTROL:=NEXTCONTROL-7;
VAL:=16*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
UNTIL(NEXTCONTROL>70)OR(NEXTCONTROL<48)OR((NEXTCONTROL>57)AND(
NEXTCONTROL<65)){:162};BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(VAL);
NEXTSIGN:=+1;END;GOTO 21;END;130:BEGIN Q:=IDLOOKUP(0);
IF ILK[Q]<>1 THEN BEGIN NEXTCONTROL:=42;GOTO 21;END;
BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(EQUIV[Q]-32768);NEXTSIGN:=+1;
END;END;43:;45:NEXTSIGN:=-NEXTSIGN;132,133,135,134,136:GOTO 30;
59:BEGIN WRITELN(OUTPUT);
WRITE('! Omit semicolon in numeric definition');ERROR;END;
ELSE{159:}BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Improper numeric definition will be flushed');ERROR;END;
REPEAT NEXTCONTROL:=SKIPAHEAD UNTIL(NEXTCONTROL>=132);
IF NEXTCONTROL=135 THEN BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;END;
ACCUMULATOR:=0;GOTO 30;END{:159}END;END;30:{:158};
IF ABS(ACCUMULATOR)>=32768 THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Value too big: ',ACCUMULATOR:1);ERROR;END;ACCUMULATOR:=0;END;
EQUIV[P]:=ACCUMULATOR+32768;END;
{:157}{165:}PROCEDURE SCANREPL(T:EIGHTBITS);LABEL 22,30,31,21;
VAR A:SIXTEENBITS;B:ASCIICODE;BAL:EIGHTBITS;BEGIN BAL:=0;
WHILE TRUE DO BEGIN 22:A:=GETNEXT;CASE A OF 40:BAL:=BAL+1;
41:IF BAL=0 THEN BEGIN WRITELN(OUTPUT);WRITE('! Extra )');ERROR;
END ELSE BAL:=BAL-1;39:{168:}BEGIN B:=39;
WHILE TRUE DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT
);WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;
IF B=64 THEN IF BUFFER[LOC]=64 THEN LOC:=LOC+1 ELSE BEGIN WRITELN(OUTPUT
);WRITE('! You should double @ signs in strings');ERROR;END;
IF LOC=LIMIT THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! 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 TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=39;TOKPTR[Z]:=TOKPTR[Z]+1;END;END;END;
END;31:END{:168};35:IF T=3 THEN A:=0;{167:}130:BEGIN A:=IDLOOKUP(0);
BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=(A DIV 256)+128;TOKPTR[Z]:=TOKPTR[Z]+1;
END;A:=A MOD 256;END;
135:IF T<>135 THEN GOTO 30 ELSE BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN
BEGIN WRITELN(OUTPUT);WRITE('! Sorry, ','token',' capacity exceeded');
ERROR;HISTORY:=3;JUMPOUT;END;
TOKMEM[Z,TOKPTR[Z]]:=(CURMODULE DIV 256)+168;TOKPTR[Z]:=TOKPTR[Z]+1;END;
A:=CURMODULE MOD 256;END;
2:{169:}BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=2;TOKPTR[Z]:=TOKPTR[Z]+1;END;
BUFFER[LIMIT+1]:=64;
21:IF BUFFER[LOC]=64 THEN BEGIN IF LOC<LIMIT THEN IF BUFFER[LOC+1]=64
THEN BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=64;TOKPTR[Z]:=TOKPTR[Z]+1;END;
LOC:=LOC+2;GOTO 21;END;
END ELSE BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=BUFFER[LOC];TOKPTR[Z]:=TOKPTR[Z]+1;END;
LOC:=LOC+1;GOTO 21;END;IF LOC>=LIMIT THEN BEGIN WRITELN(OUTPUT);
WRITE('! Verbatim string didn''t end');ERROR;
END ELSE IF BUFFER[LOC+1]<>62 THEN BEGIN WRITELN(OUTPUT);
WRITE('! 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(OUTPUT);
WRITE('! @',XCHR[BUFFER[LOC-1]],' is ignored in Pascal text');ERROR;END;
GOTO 22;END;136:GOTO 30;{:167}ELSE END;
BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=A;TOKPTR[Z]:=TOKPTR[Z]+1;END;END;
30:NEXTCONTROL:=A;
{166:}IF BAL>0 THEN BEGIN IF BAL=1 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Missing )');ERROR;END ELSE BEGIN WRITELN(OUTPUT);
WRITE('! Missing ',BAL:1,' )''s');ERROR;END;
WHILE BAL>0 DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(
OUTPUT);WRITE('! Sorry, ','token',' capacity exceeded');ERROR;
HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=41;TOKPTR[Z]:=TOKPTR[Z]+1;
END;BAL:=BAL-1;END;END{:166};
IF TEXTPTR>MAXTEXTS-4 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Sorry, ','text',' capacity exceeded');ERROR;HISTORY:=3;JUMPOUT;
END;CURREPLTEXT:=TEXTPTR;TOKSTART[TEXTPTR+4]:=TOKPTR[Z];
TEXTPTR:=TEXTPTR+1;IF Z=3 THEN Z:=0 ELSE Z:=Z+1;END;
{:165}{170:}PROCEDURE DEFINEMACRO(T:EIGHTBITS);VAR P:NAMEPOINTER;
BEGIN P:=IDLOOKUP(T);SCANREPL(T);EQUIV[P]:=CURREPLTEXT;
TEXTLINK[CURREPLTEXT]:=0;END;{:170}{172:}PROCEDURE SCANMODULE;
LABEL 22,30,10;VAR P:NAMEPOINTER;BEGIN MODULECOUNT:=MODULECOUNT+1;
{173:}NEXTCONTROL:=0;
WHILE TRUE DO BEGIN 22:WHILE NEXTCONTROL<=132 DO BEGIN NEXTCONTROL:=
SKIPAHEAD;IF NEXTCONTROL=135 THEN BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;
END;END;IF NEXTCONTROL<>133 THEN GOTO 30;NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL<>130 THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Definition flushed, must start with ',
'identifier of length > 1');ERROR;END;GOTO 22;END;NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL=61 THEN BEGIN SCANNUMERIC(IDLOOKUP(1));GOTO 22;
END ELSE IF NEXTCONTROL=30 THEN BEGIN DEFINEMACRO(2);GOTO 22;
END ELSE{174:}IF NEXTCONTROL=40 THEN BEGIN NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL=35 THEN BEGIN NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL=41 THEN BEGIN NEXTCONTROL:=GETNEXT;
IF NEXTCONTROL=61 THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Use == for macros');ERROR;END;NEXTCONTROL:=30;END;
IF NEXTCONTROL=30 THEN BEGIN DEFINEMACRO(3);GOTO 22;END;END;END;END;
{:174};BEGIN WRITELN(OUTPUT);
WRITE('! Definition flushed since it starts badly');ERROR;END;END;
30:{:173};{175:}CASE NEXTCONTROL OF 134:P:=0;135:BEGIN P:=CURMODULE;
{176:}REPEAT NEXTCONTROL:=GETNEXT;UNTIL NEXTCONTROL<>43;
IF(NEXTCONTROL<>61)AND(NEXTCONTROL<>30)THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! Pascal text flushed, = sign is missing');ERROR;END;
REPEAT NEXTCONTROL:=SKIPAHEAD;UNTIL NEXTCONTROL=136;GOTO 10;END{:176};
END;ELSE GOTO 10 END;{177:}STORETWOBYTE(53248+MODULECOUNT);{:177};
SCANREPL(135);
{178:}IF P=0 THEN BEGIN TEXTLINK[LASTUNNAMED]:=CURREPLTEXT;
LASTUNNAMED:=CURREPLTEXT;
END ELSE IF EQUIV[P]=0 THEN EQUIV[P]:=CURREPLTEXT ELSE BEGIN P:=EQUIV[P]
;WHILE TEXTLINK[P]<MAXTEXTS DO P:=TEXTLINK[P];TEXTLINK[P]:=CURREPLTEXT;
END;TEXTLINK[CURREPLTEXT]:=MAXTEXTS;{:178};{:175};10:END;
{:172}{181:}{PROCEDURE DEBUGHELP;LABEL 888,10;VAR K:INTEGER;
BEGIN DEBUGSKIPPED:=DEBUGSKIPPED+1;
IF DEBUGSKIPPED<DEBUGCYCLE THEN GOTO 10;DEBUGSKIPPED:=0;
WHILE TRUE DO BEGIN BEGIN WRITELN(OUTPUT);WRITE('#');END;;
READ(INPUT,DDT);IF DDT<0 THEN GOTO 10 ELSE IF DDT=0 THEN BEGIN GOTO 888;
888:DDT:=0;
END ELSE BEGIN READ(INPUT,DD);CASE DDT OF 1:PRINTID(DD);2:PRINTREPL(DD);
3:FOR K:=1 TO DD DO WRITE(XCHR[BUFFER[K]]);
4:FOR K:=1 TO DD DO WRITE(XCHR[MODTEXT[K]]);
5:FOR K:=1 TO OUTPTR DO WRITE(XCHR[OUTBUF[K]]);
6:FOR K:=1 TO DD DO WRITE(XCHR[OUTCONTRIB[K]]);ELSE WRITE('?')END;END;
END;10:END;}{:181}{182:}BEGIN INITIALIZE;{134:}OPENINPUT;LINE:=0;
OTHERLINE:=0;CHANGING:=TRUE;PRIMETHECHAN;CHANGING:=NOT CHANGING;
TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;LINE:=TEMPLINE;LIMIT:=0;LOC:=1;
BUFFER[0]:=32;INPUTHASENDE:=FALSE;{:134};
WRITELN(OUTPUT,'This is TANGLE-FPC, 3rd ed.');{183:}PHASEONE:=TRUE;
MODULECOUNT:=0;REPEAT NEXTCONTROL:=SKIPAHEAD;UNTIL NEXTCONTROL=136;
WHILE NOT INPUTHASENDE DO SCANMODULE;
{138:}IF CHANGELIMIT<>0 THEN BEGIN FOR II:=0 TO CHANGELIMIT-1 DO BUFFER[
II]:=CHANGEBUFFER[II];LIMIT:=CHANGELIMIT;CHANGING:=TRUE;LINE:=OTHERLINE;
LOC:=CHANGELIMIT;BEGIN WRITELN(OUTPUT);
WRITE('! Change file entry did not match');ERROR;END;END{:138};
PHASEONE:=FALSE;{:183};{FOR II:=0 TO 3 DO MAXTOKPTR[II]:=TOKPTR[II];}
{112:}IF TEXTLINK[0]=0 THEN BEGIN BEGIN WRITELN(OUTPUT);
WRITE('! No output was specified.');END;IF HISTORY=0 THEN HISTORY:=1;
END ELSE BEGIN BEGIN WRITELN(OUTPUT);WRITE('Writing the output file');
END;;{83:}STACKPTR:=1;BRACELEVEL:=0;CURSTATE.NAMEFIELD:=0;
CURSTATE.REPLFIELD:=TEXTLINK[0];ZO:=CURSTATE.REPLFIELD MOD 4;
CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+4];CURSTATE.MODFIELD:=0;
{:83};{96:}OUTSTATE:=0;OUTPTR:=0;BREAKPTR:=0;SEMIPTR:=0;OUTBUF[0]:=0;
LINE:=1;{:96};SENDTHEOUTPU;{98:}BREAKPTR:=OUTPTR;SEMIPTR:=0;FLUSHBUFFER;
IF BRACELEVEL<>0 THEN BEGIN WRITELN(OUTPUT);
WRITE('! Program ended at brace level ',BRACELEVEL:1);ERROR;END;{:98};
BEGIN WRITELN(OUTPUT);WRITE('Done.');END;END{:112};
IF STRINGPTR>256 THEN{184:}BEGIN BEGIN WRITELN(OUTPUT);
WRITE(STRINGPTR-256:1,' strings written to string pool file.');END;
WRITE(POOL,'*');FOR II:=1 TO 9 DO BEGIN OUTBUF[II]:=POOLCHECKSUM MOD 10;
POOLCHECKSUM:=POOLCHECKSUM DIV 10;END;
FOR II:=9 DOWNTO 1 DO WRITE(POOL,XCHR[48+OUTBUF[II]]);WRITELN(POOL);
END{:184};CLOSE(PASCALFILE);CLOSE(POOL);
9999:{[186:]BEGIN WRITELN(OUTPUT);WRITE('Memory usage statistics:');END;
BEGIN WRITELN(OUTPUT);
WRITE(NAMEPTR:1,' names, ',TEXTPTR:1,' replacement texts;');END;
BEGIN WRITELN(OUTPUT);WRITE(BYTEPTR[0]:1);END;
FOR WO:=1 TO 1 DO WRITE('+',BYTEPTR[WO]:1);
IF PHASEONE THEN FOR II:=0 TO 3 DO MAXTOKPTR[II]:=TOKPTR[II];
WRITE(' bytes, ',MAXTOKPTR[0]:1);
FOR II:=1 TO 3 DO WRITE('+',MAXTOKPTR[II]:1);WRITE(' tokens.');[:186];}
{187:}CASE HISTORY OF 0:BEGIN WRITELN(OUTPUT);
WRITE('(No errors were found.)');END;1:BEGIN WRITELN(OUTPUT);
WRITE('(Did you see the warning message above?)');END;
2:BEGIN WRITELN(OUTPUT);
WRITE('(Pardon me, but I think I spotted something wrong.)');END;
3:BEGIN WRITELN(OUTPUT);WRITE('(That was a fatal error, my friend.)');
END;END;WRITELN(OUTPUT);HALT(HISTORY){:187};END.{:182}