{2:}PROGRAM PLTOTF(PL←FILE,TFM←FILE,OUTPUT);CONST{3:}BUF←SIZE=60;
MAX←HEADER←BYTES=100;MAX←PARAM←WORDS=30;{:3}TYPE{17:}BYTE=0..255;
ASCII←CODE=32..127;{:17}{57:}FOUR←BYTES=RECORD B0:BYTE;B1:BYTE;B2:BYTE;
B3:BYTE;END;{:57}{61:}FIX←WORD=INTEGER;{:61}{68:}
HEADER←INDEX=0..MAX←HEADER←BYTES;{:68}{71:}POINTER=0..1032;{:71}{137:}
BYTE←FILE=PACKED FILE OF 0..255;{:137}VAR{5:}PL←FILE:TEXT;{:5}{15:}
TFM←FILE:BYTE←FILE;{:15}{18:}XORD:ARRAY[CHAR]OF ASCII←CODE;{:18}{21:}
LINE:INTEGER;GOOD←INDENT:INTEGER;INDENT:INTEGER;LEVEL:INTEGER;{:21}{23:}
LEFT←LN,RIGHT←LN:BOOLEAN;LIMIT:0..BUF←SIZE;LOC:0..BUF←SIZE;
BUFFER:ARRAY[1..BUF←SIZE]OF CHAR;INPUT←HAS←ENDED:BOOLEAN;{:23}{25:}
CHARS←ON←LINE:0..8;{:25}{30:}CUR←CHAR:ASCII←CODE;{:30}{36:}
START:ARRAY[1..66]OF 0..500;DICTIONARY:ARRAY[0..500]OF ASCII←CODE;
START←PTR:0..66;DICT←PTR:0..500;{:36}{38:}
CUR←NAME:ARRAY[1..20]OF ASCII←CODE;NAME←LENGTH:0..20;NAME←PTR:0..66;
{:38}{39:}HASH:ARRAY[0..100]OF 0..66;CUR←HASH:0..100;{:39}{44:}
EQUIV:ARRAY[0..66]OF BYTE;CUR←CODE:BYTE;{:44}{58:}CUR←BYTES:FOUR←BYTES;
{:58}{65:}FRACTION←DIGITS:ARRAY[1..7]OF INTEGER;{:65}{67:}
HEADER←BYTES:ARRAY[HEADER←INDEX]OF BYTE;HEADER←PTR:HEADER←INDEX;
DESIGN←SIZE:FIX←WORD;DESIGN←UNITS:FIX←WORD;SEVEN←BIT←SAFE←FLAG:BOOLEAN;
LIG←KERN:ARRAY[0..511]OF FOUR←BYTES;NL:0..511;UNUSED←LABEL:BOOLEAN;
KERN:ARRAY[0..256]OF FIX←WORD;NK:0..256;
EXTEN:ARRAY[0..255]OF FOUR←BYTES;NE:0..256;
PARAM:ARRAY[1..MAX←PARAM←WORDS]OF FIX←WORD;NP:0..MAX←PARAM←WORDS;
CHECK←SUM←SPECIFIED:BOOLEAN;{:67}{72:}MEMORY:ARRAY[POINTER]OF FIX←WORD;
MEM←PTR:POINTER;LINK:ARRAY[POINTER]OF POINTER;
CHAR←WD:ARRAY[BYTE]OF POINTER;CHAR←HT:ARRAY[BYTE]OF POINTER;
CHAR←DP:ARRAY[BYTE]OF POINTER;CHAR←IC:ARRAY[BYTE]OF POINTER;
CHAR←TAG:ARRAY[BYTE]OF 0..3;CHAR←REMAINDER:ARRAY[BYTE]OF 0..255;{:72}
{76:}NEXT←D:FIX←WORD;{:76}{79:}INDEX:ARRAY[POINTER]OF BYTE;{:79}{81:}
C:BYTE;{:81}{99:}KRN←PTR:0..256;{:99}{108:}SEVEN←UNSAFE:BOOLEAN;{:108}
{112:}LIG←PTR:0..511;{:112}{117:}DELTA:FIX←WORD;{:117}{121:}BC:BYTE;
EC:BYTE;LH:BYTE;LF:0..32767;NOT←FOUND:BOOLEAN;TEMP←WIDTH:FIX←WORD;{:121}
{124:}J:0..MAX←HEADER←BYTES;P:POINTER;Q:1..4;PAR←PTR:0..MAX←PARAM←WORDS;
{:124}{138:}OUTPUT:TEXT;{:138}{136:}PROCEDURE TTY←REWRITE(VAR F:TEXT);
EXTERNAL;PROCEDURE BYTE←FILE←REWRITE(VAR F:BYTE←FILE;EXT:ALFA);EXTERNAL;
PROCEDURE FILE←RESET(VAR F:TEXT;EXT:ALFA);EXTERNAL;
PROCEDURE FILE←CLOSE(VAR F:TEXT);EXTERNAL;
PROCEDURE BYTE←FILE←CLOSE(VAR F:BYTE←FILE);EXTERNAL;
PROCEDURE WRITE←BYTE(VAR F:BYTE←FILE;B:0..255);BEGIN WRITE(F,B)END;
{:136}PROCEDURE INITIALIZE;VAR{19:}K:0..127;{:19}{40:}H:0..100;{:40}
{69:}D:HEADER←INDEX;{:69}{73:}C:BYTE;{:73}
BEGIN WRITELN('This is PLtoTF 2.3 for Cedar 6.0');{6:}
FILE←RESET(PL←FILE,'pl      ');{:6}{16:}
BYTE←FILE←REWRITE(TFM←FILE,'tfm       ');{:16}{20:}
FOR K:=0 TO 127 DO XORD[CHR(K)]:=127;XORD[' ']:=32;XORD['!']:=33;
XORD['"']:=34;XORD['#']:=35;XORD['$']:=36;XORD['%']:=37;XORD['&']:=38;
XORD['''']:=39;XORD['(']:=40;XORD[')']:=41;XORD['*']:=42;XORD['+']:=43;
XORD[',']:=44;XORD['-']:=45;XORD['.']:=46;XORD['/']:=47;XORD['0']:=48;
XORD['1']:=49;XORD['2']:=50;XORD['3']:=51;XORD['4']:=52;XORD['5']:=53;
XORD['6']:=54;XORD['7']:=55;XORD['8']:=56;XORD['9']:=57;XORD[':']:=58;
XORD[';']:=59;XORD['<']:=60;XORD['=']:=61;XORD['>']:=62;XORD['?']:=63;
XORD['@']:=64;XORD['A']:=65;XORD['B']:=66;XORD['C']:=67;XORD['D']:=68;
XORD['E']:=69;XORD['F']:=70;XORD['G']:=71;XORD['H']:=72;XORD['I']:=73;
XORD['J']:=74;XORD['K']:=75;XORD['L']:=76;XORD['M']:=77;XORD['N']:=78;
XORD['O']:=79;XORD['P']:=80;XORD['Q']:=81;XORD['R']:=82;XORD['S']:=83;
XORD['T']:=84;XORD['U']:=85;XORD['V']:=86;XORD['W']:=87;XORD['X']:=88;
XORD['Y']:=89;XORD['Z']:=90;XORD['[']:=91;XORD['\']:=92;XORD[']']:=93;
XORD['↑']:=94;XORD['←']:=95;XORD['`']:=96;XORD['a']:=97;XORD['b']:=98;
XORD['c']:=99;XORD['d']:=100;XORD['e']:=101;XORD['f']:=102;
XORD['g']:=103;XORD['h']:=104;XORD['i']:=105;XORD['j']:=106;
XORD['k']:=107;XORD['l']:=108;XORD['m']:=109;XORD['n']:=110;
XORD['o']:=111;XORD['p']:=112;XORD['q']:=113;XORD['r']:=114;
XORD['s']:=115;XORD['t']:=116;XORD['u']:=117;XORD['v']:=118;
XORD['w']:=119;XORD['x']:=120;XORD['y']:=121;XORD['z']:=122;
XORD['{']:=123;XORD['|']:=124;XORD['}']:=125;XORD['~']:=126;{:20}{22:}
LINE:=0;GOOD←INDENT:=0;INDENT:=0;LEVEL:=0;{:22}{24:}LIMIT:=0;LOC:=0;
LEFT←LN:=TRUE;RIGHT←LN:=TRUE;INPUT←HAS←ENDED:=FALSE;{:24}{26:}
CHARS←ON←LINE:=0;{:26}{37:}START←PTR:=1;START[1]:=0;DICT←PTR:=0;{:37}
{41:}FOR H:=0 TO 100 DO HASH[H]:=0;{:41}{70:}CHECK←SUM←SPECIFIED:=FALSE;
FOR D:=0 TO 18*4-1 DO HEADER←BYTES[D]:=0;HEADER←BYTES[8]:=11;
HEADER←BYTES[9]:=85;HEADER←BYTES[10]:=78;HEADER←BYTES[11]:=83;
HEADER←BYTES[12]:=80;HEADER←BYTES[13]:=69;HEADER←BYTES[14]:=67;
HEADER←BYTES[15]:=73;HEADER←BYTES[16]:=70;HEADER←BYTES[17]:=73;
HEADER←BYTES[18]:=69;HEADER←BYTES[19]:=68;
FOR D:=48 TO 59 DO HEADER←BYTES[D]:=HEADER←BYTES[D-40];
DESIGN←SIZE:=10*1048576;DESIGN←UNITS:=1048576;
SEVEN←BIT←SAFE←FLAG:=FALSE;HEADER←PTR:=18*4;NL:=0;UNUSED←LABEL:=FALSE;
NK:=0;NE:=0;NP:=0;{:70}{74:}FOR C:=0 TO 255 DO BEGIN CHAR←WD[C]:=0;
CHAR←HT[C]:=0;CHAR←DP[C]:=0;CHAR←IC[C]:=0;CHAR←TAG[C]:=0;
CHAR←REMAINDER[C]:=0;END;MEMORY[0]:=2147483647;MEMORY[1]:=0;LINK[1]:=0;
MEMORY[2]:=0;LINK[2]:=0;MEMORY[3]:=0;LINK[3]:=0;MEMORY[4]:=0;LINK[4]:=0;
MEM←PTR:=4;{:74}END;{:2}{27:}PROCEDURE SHOW←ERROR←CONTEXT;
VAR K:0..BUF←SIZE;BEGIN WRITELN(' (line ',LINE:1,').');
IF NOT LEFT←LN THEN WRITE('...');FOR K:=1 TO LOC DO WRITE(BUFFER[K]);
WRITELN(' ');IF NOT LEFT←LN THEN WRITE('   ');
FOR K:=1 TO LOC DO WRITE(' ');FOR K:=LOC+1 TO LIMIT DO WRITE(BUFFER[K]);
IF RIGHT←LN THEN WRITELN(' ')ELSE WRITELN('...');CHARS←ON←LINE:=0;END;
{:27}{28:}PROCEDURE FILL←BUFFER;BEGIN LEFT←LN:=RIGHT←LN;LIMIT:=0;LOC:=0;
IF LEFT←LN THEN BEGIN IF LINE>0 THEN READLN(PL←FILE);LINE:=LINE+1;END;
IF EOF(PL←FILE)THEN BEGIN LIMIT:=1;BUFFER[1]:=')';RIGHT←LN:=FALSE;
INPUT←HAS←ENDED:=TRUE;
END ELSE BEGIN WHILE(LIMIT<BUF←SIZE-1)AND(NOT EOLN(PL←FILE))DO BEGIN
LIMIT:=LIMIT+1;READ(PL←FILE,BUFFER[LIMIT]);END;BUFFER[LIMIT+1]:=' ';
RIGHT←LN:=EOLN(PL←FILE);IF LEFT←LN THEN{29:}
BEGIN WHILE(LOC<LIMIT)AND(BUFFER[LOC+1]=' ')DO LOC:=LOC+1;
IF LOC<LIMIT THEN BEGIN IF LEVEL=0 THEN IF LOC=0 THEN GOOD←INDENT:=
GOOD←INDENT+1 ELSE BEGIN IF GOOD←INDENT>=10 THEN BEGIN IF CHARS←ON←LINE>
0 THEN WRITELN(' ');
WRITE('Warning: Indented line occurred at level zero');
SHOW←ERROR←CONTEXT;END;GOOD←INDENT:=0;INDENT:=0;
END ELSE IF INDENT=0 THEN IF(LOC DIV LEVEL)*LEVEL=LOC THEN BEGIN INDENT
:=LOC DIV LEVEL;GOOD←INDENT:=1;
END ELSE GOOD←INDENT:=0 ELSE IF INDENT*LEVEL=LOC THEN GOOD←INDENT:=
GOOD←INDENT+1 ELSE BEGIN IF GOOD←INDENT>=10 THEN BEGIN IF CHARS←ON←LINE>
0 THEN WRITELN(' ');WRITE('Warning: Inconsistent indentation; ',
'you are at parenthesis level ',LEVEL:1);SHOW←ERROR←CONTEXT;END;
GOOD←INDENT:=0;INDENT:=0;END;END;END{:29};END;END;{:28}{31:}
PROCEDURE GET←LETTER←OR←DIGIT;
BEGIN WHILE(LOC=LIMIT)AND(NOT RIGHT←LN)DO FILL←BUFFER;
IF LOC=LIMIT THEN CUR←CHAR:=32 ELSE BEGIN CUR←CHAR:=XORD[BUFFER[LOC+1]];
IF CUR←CHAR>=97 THEN CUR←CHAR:=CUR←CHAR-32;
IF((CUR←CHAR>=48)AND(CUR←CHAR<=57))OR((CUR←CHAR>=65)AND(CUR←CHAR<=90))
THEN LOC:=LOC+1 ELSE CUR←CHAR:=32;END;END;{:31}{32:}PROCEDURE GET←NEXT;
BEGIN WHILE LOC=LIMIT DO FILL←BUFFER;LOC:=LOC+1;
CUR←CHAR:=XORD[BUFFER[LOC]];
IF CUR←CHAR>=97 THEN IF CUR←CHAR<=122 THEN CUR←CHAR:=CUR←CHAR-32 ELSE
BEGIN IF CUR←CHAR=127 THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(
' ');WRITE('Illegal character in the file');SHOW←ERROR←CONTEXT;END;
CUR←CHAR:=63;END;
END ELSE IF(CUR←CHAR<=41)AND(CUR←CHAR>=40)THEN LOC:=LOC-1;END;{:32}{33:}
PROCEDURE SKIP←TO←END←OF←ITEM;VAR L:INTEGER;BEGIN L:=LEVEL;
WHILE LEVEL>=L DO BEGIN WHILE LOC=LIMIT DO FILL←BUFFER;LOC:=LOC+1;
IF BUFFER[LOC]=')'THEN LEVEL:=LEVEL-1 ELSE IF BUFFER[LOC]='('THEN LEVEL
:=LEVEL+1;END;
IF INPUT←HAS←ENDED THEN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('File ended unexpectedly: No closing ")"');SHOW←ERROR←CONTEXT;END;
CUR←CHAR:=32;END;{:33}{35:}PROCEDURE FINISH←THE←PROPERTY;
BEGIN WHILE CUR←CHAR=32 DO GET←NEXT;
IF CUR←CHAR<>41 THEN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('Junk after property value will be ignored');SHOW←ERROR←CONTEXT;
END;SKIP←TO←END←OF←ITEM;END;{:35}{42:}PROCEDURE LOOKUP;VAR K:0..20;
J:0..500;NOT←FOUND:BOOLEAN;BEGIN{43:}CUR←HASH:=CUR←NAME[1];
FOR K:=2 TO NAME←LENGTH DO CUR←HASH:=(CUR←HASH+CUR←HASH+CUR←NAME[K])MOD
101{:43};NOT←FOUND:=TRUE;
WHILE NOT←FOUND DO BEGIN IF CUR←HASH=0 THEN CUR←HASH:=100 ELSE CUR←HASH
:=CUR←HASH-1;
IF HASH[CUR←HASH]=0 THEN NOT←FOUND:=FALSE ELSE BEGIN J:=START[HASH[
CUR←HASH]];
IF START[HASH[CUR←HASH]+1]=J+NAME←LENGTH THEN BEGIN NOT←FOUND:=FALSE;
FOR K:=1 TO NAME←LENGTH DO IF DICTIONARY[J+K-1]<>CUR←NAME[K]THEN
NOT←FOUND:=TRUE;END;END;END;NAME←PTR:=HASH[CUR←HASH];END;{:42}{45:}
PROCEDURE ENTER←NAME(V:BYTE);VAR K:0..20;
BEGIN FOR K:=1 TO NAME←LENGTH DO CUR←NAME[K]:=CUR←NAME[K+20-NAME←LENGTH]
;LOOKUP;HASH[CUR←HASH]:=START←PTR;EQUIV[START←PTR]:=V;
FOR K:=1 TO NAME←LENGTH DO BEGIN DICTIONARY[DICT←PTR]:=CUR←NAME[K];
DICT←PTR:=DICT←PTR+1;END;START←PTR:=START←PTR+1;
START[START←PTR]:=DICT←PTR;END;{:45}{49:}PROCEDURE GET←NAME;
BEGIN LOC:=LOC+1;LEVEL:=LEVEL+1;CUR←CHAR:=32;
WHILE CUR←CHAR=32 DO GET←NEXT;
IF(CUR←CHAR>41)OR(CUR←CHAR<40)THEN LOC:=LOC-1;NAME←LENGTH:=0;
GET←LETTER←OR←DIGIT;
WHILE CUR←CHAR<>32 DO BEGIN IF NAME←LENGTH=20 THEN CUR←NAME[1]:=88 ELSE
NAME←LENGTH:=NAME←LENGTH+1;CUR←NAME[NAME←LENGTH]:=CUR←CHAR;
GET←LETTER←OR←DIGIT;END;LOOKUP;
IF NAME←PTR=0 THEN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('Sorry, I don''t know that property name');SHOW←ERROR←CONTEXT;END;
CUR←CODE:=EQUIV[NAME←PTR];END;{:49}{51:}FUNCTION GET←BYTE:BYTE;
VAR ACC:INTEGER;T:ASCII←CODE;BEGIN REPEAT GET←NEXT;UNTIL CUR←CHAR<>32;
T:=CUR←CHAR;ACC:=0;REPEAT GET←NEXT;UNTIL CUR←CHAR<>32;IF T=67 THEN{52:}
IF(CUR←CHAR>=33)AND(CUR←CHAR<=126)AND((CUR←CHAR<40)OR(CUR←CHAR>41))THEN
ACC:=XORD[BUFFER[LOC]]ELSE BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(
' ');WRITE('"C" value must be standard ASCII and not a paren');
SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END{:52}
ELSE IF T=68 THEN{53:}
BEGIN WHILE(CUR←CHAR>=48)AND(CUR←CHAR<=57)DO BEGIN ACC:=ACC*10+CUR←CHAR
-48;
IF ACC>255 THEN BEGIN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This value shouldn''t exceed 255');SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END;ACC:=0;
CUR←CHAR:=32;END ELSE GET←NEXT;END;
BEGIN IF(CUR←CHAR>41)OR(CUR←CHAR<40)THEN LOC:=LOC-1;END;END{:53}
ELSE IF T=79 THEN{54:}
BEGIN WHILE(CUR←CHAR>=48)AND(CUR←CHAR<=55)DO BEGIN ACC:=ACC*8+CUR←CHAR
-48;
IF ACC>255 THEN BEGIN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This value shouldn''t exceed ''377');SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END;ACC:=0;
CUR←CHAR:=32;END ELSE GET←NEXT;END;
BEGIN IF(CUR←CHAR>41)OR(CUR←CHAR<40)THEN LOC:=LOC-1;END;END{:54}
ELSE IF T=72 THEN{55:}
BEGIN WHILE((CUR←CHAR>=48)AND(CUR←CHAR<=57))OR((CUR←CHAR>=65)AND(
CUR←CHAR<=70))DO BEGIN IF CUR←CHAR>=65 THEN CUR←CHAR:=CUR←CHAR-7;
ACC:=ACC*16+CUR←CHAR-48;
IF ACC>255 THEN BEGIN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This value shouldn''t exceed "FF');SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END;ACC:=0;
CUR←CHAR:=32;END ELSE GET←NEXT;END;
BEGIN IF(CUR←CHAR>41)OR(CUR←CHAR<40)THEN LOC:=LOC-1;END;END{:55}
ELSE IF T=70 THEN{56:}
BEGIN IF CUR←CHAR=66 THEN ACC:=2 ELSE IF CUR←CHAR=76 THEN ACC:=4 ELSE IF
CUR←CHAR<>77 THEN ACC:=18;GET←NEXT;
IF CUR←CHAR=73 THEN ACC:=ACC+1 ELSE IF CUR←CHAR<>82 THEN ACC:=18;
GET←NEXT;
IF CUR←CHAR=67 THEN ACC:=ACC+6 ELSE IF CUR←CHAR=69 THEN ACC:=ACC+12 ELSE
IF CUR←CHAR<>82 THEN ACC:=18;
IF ACC>=18 THEN BEGIN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('Illegal face code, I changed it to MRR');SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END;ACC:=0;END;
END{:56}ELSE BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('You need "C" or "D" or "O" or "H" or "F" here');
SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END;CUR←CHAR:=32;
GET←BYTE:=ACC;END;{:51}{59:}PROCEDURE GET←FOUR←BYTES;VAR C:INTEGER;
R:INTEGER;Q:INTEGER;BEGIN REPEAT GET←NEXT;UNTIL CUR←CHAR<>32;R:=0;
CUR←BYTES.B0:=0;CUR←BYTES.B1:=0;CUR←BYTES.B2:=0;CUR←BYTES.B3:=0;
IF CUR←CHAR=72 THEN R:=16 ELSE IF CUR←CHAR=79 THEN R:=8 ELSE BEGIN BEGIN
IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('An octal ("O") or hex ("H") value is needed here');
SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END;
IF R>0 THEN BEGIN Q:=256 DIV R;REPEAT GET←NEXT;UNTIL CUR←CHAR<>32;
WHILE((CUR←CHAR>=48)AND(CUR←CHAR<=57))OR((CUR←CHAR>=65)AND(CUR←CHAR<=70)
)DO{60:}BEGIN IF CUR←CHAR>=65 THEN CUR←CHAR:=CUR←CHAR-7;
C:=(R*CUR←BYTES.B0)+(CUR←BYTES.B1 DIV Q);
IF C>255 THEN BEGIN CUR←BYTES.B0:=0;CUR←BYTES.B1:=0;CUR←BYTES.B2:=0;
CUR←BYTES.B3:=0;
IF R=8 THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('Sorry, the maximum octal value is O 37777777777');
SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);
END ELSE BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('Sorry, the maximum hex value is H FFFFFFFF');SHOW←ERROR←CONTEXT;
END;REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END;
END ELSE IF CUR←CHAR>=48+R THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN
WRITELN(' ');WRITE('Illegal digit');SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);
END ELSE BEGIN CUR←BYTES.B0:=C;
CUR←BYTES.B1:=(R*(CUR←BYTES.B1 MOD Q))+(CUR←BYTES.B2 DIV Q);
CUR←BYTES.B2:=(R*(CUR←BYTES.B2 MOD Q))+(CUR←BYTES.B3 DIV Q);
CUR←BYTES.B3:=(R*(CUR←BYTES.B3 MOD Q))+CUR←CHAR-48;GET←NEXT;END;END;
{:60};END;END;{:59}{62:}FUNCTION GET←FIX:FIX←WORD;VAR NEGATIVE:BOOLEAN;
ACC:INTEGER;INT←PART:INTEGER;J:0..7;BEGIN REPEAT GET←NEXT;
UNTIL CUR←CHAR<>32;NEGATIVE:=FALSE;ACC:=0;
IF(CUR←CHAR<>82)AND(CUR←CHAR<>68)THEN BEGIN BEGIN IF CHARS←ON←LINE>0
THEN WRITELN(' ');WRITE('An "R" or "D" value is needed here');
SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END ELSE BEGIN{63:}
REPEAT GET←NEXT;IF CUR←CHAR=45 THEN BEGIN CUR←CHAR:=32;NEGATIVE:=TRUE;
END ELSE IF CUR←CHAR=43 THEN CUR←CHAR:=32;UNTIL CUR←CHAR<>32{:63};
WHILE(CUR←CHAR>=48)AND(CUR←CHAR<=57)DO{64:}
BEGIN ACC:=ACC*10+CUR←CHAR-48;
IF ACC>=1024 THEN BEGIN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ')
;WRITE('Real constants must be less than 1024');SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END;ACC:=0;
CUR←CHAR:=32;END ELSE GET←NEXT;END{:64};INT←PART:=ACC;ACC:=0;
IF CUR←CHAR=46 THEN{66:}BEGIN J:=0;GET←NEXT;
WHILE(CUR←CHAR>=48)AND(CUR←CHAR<=57)DO BEGIN IF J<7 THEN BEGIN J:=J+1;
FRACTION←DIGITS[J]:=2097152*(CUR←CHAR-48);END;GET←NEXT;END;ACC:=0;
WHILE J>0 DO BEGIN ACC:=FRACTION←DIGITS[J]+(ACC DIV 10);J:=J-1;END;
ACC:=(ACC+10)DIV 20;END{:66};
IF(ACC>=1048576)AND(INT←PART=1023)THEN BEGIN BEGIN IF CHARS←ON←LINE>0
THEN WRITELN(' ');WRITE('Real constants must be less than 1024');
SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);
END ELSE ACC:=INT←PART*1048576+ACC;END;
IF NEGATIVE THEN GET←FIX:=-ACC ELSE GET←FIX:=ACC;END;{:62}{75:}
FUNCTION SORT←IN(H:POINTER;D:FIX←WORD):POINTER;VAR P:POINTER;
BEGIN IF(D=0)AND(H<>1)THEN SORT←IN:=0 ELSE BEGIN P:=H;
WHILE D>=MEMORY[LINK[P]]DO P:=LINK[P];
IF(D=MEMORY[P])AND(P<>H)THEN SORT←IN:=P ELSE IF MEM←PTR=1032 THEN BEGIN
BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('Memory overflow: more than 1028 widths, etc');SHOW←ERROR←CONTEXT;
END;WRITELN('Congratulations! It''s hard to make this error.');
SORT←IN:=P;END ELSE BEGIN MEM←PTR:=MEM←PTR+1;MEMORY[MEM←PTR]:=D;
LINK[MEM←PTR]:=LINK[P];LINK[P]:=MEM←PTR;MEMORY[H]:=MEMORY[H]+1;
SORT←IN:=MEM←PTR;END;END;END;{:75}{77:}FUNCTION MIN←COVER(H:POINTER;
D:FIX←WORD):INTEGER;VAR P:POINTER;L:FIX←WORD;M:INTEGER;BEGIN M:=0;
P:=LINK[H];NEXT←D:=MEMORY[0];WHILE P<>0 DO BEGIN M:=M+1;L:=MEMORY[P];
WHILE MEMORY[LINK[P]]<=L+D DO P:=LINK[P];P:=LINK[P];
IF MEMORY[P]-L<NEXT←D THEN NEXT←D:=MEMORY[P]-L;END;MIN←COVER:=M;END;
{:77}{78:}FUNCTION SHORTEN(H:POINTER;M:INTEGER):FIX←WORD;VAR D:FIX←WORD;
K:INTEGER;BEGIN IF MEMORY[H]>M THEN BEGIN K:=MIN←COVER(H,0);D:=NEXT←D;
REPEAT D:=D+D;K:=MIN←COVER(H,D);UNTIL K<=M;D:=D DIV 2;K:=MIN←COVER(H,D);
WHILE K>M DO BEGIN D:=NEXT←D;K:=MIN←COVER(H,D);END;SHORTEN:=D;
END ELSE SHORTEN:=0;END;{:78}{80:}PROCEDURE SET←INDICES(H:POINTER;
D:FIX←WORD);VAR P:POINTER;Q:POINTER;M:BYTE;L:FIX←WORD;BEGIN Q:=H;
P:=LINK[Q];M:=0;WHILE P<>0 DO BEGIN M:=M+1;L:=MEMORY[P];INDEX[P]:=M;
WHILE MEMORY[LINK[P]]<=L+D DO BEGIN P:=LINK[P];INDEX[P]:=M;END;
LINK[Q]:=P;MEMORY[P]:=(L+MEMORY[P])DIV 2;Q:=P;P:=LINK[P];END;
MEMORY[H]:=M;END;{:80}{83:}PROCEDURE JUNK←ERROR;
BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('There''s junk here that is not in parentheses');
SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END;{:83}{86:}
PROCEDURE READ←FOUR←BYTES(L:HEADER←INDEX);BEGIN GET←FOUR←BYTES;
HEADER←BYTES[L]:=CUR←BYTES.B0;HEADER←BYTES[L+1]:=CUR←BYTES.B1;
HEADER←BYTES[L+2]:=CUR←BYTES.B2;HEADER←BYTES[L+3]:=CUR←BYTES.B3;END;
{:86}{87:}PROCEDURE READ←BCPL(L:HEADER←INDEX;N:BYTE);VAR K:HEADER←INDEX;
BEGIN K:=L;WHILE CUR←CHAR=32 DO GET←NEXT;
WHILE(CUR←CHAR<>40)AND(CUR←CHAR<>41)DO BEGIN IF K<L+N THEN K:=K+1;
IF K<L+N THEN HEADER←BYTES[K]:=CUR←CHAR;GET←NEXT;END;
IF K=L+N THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('String is too long; its first ',N-1:1,' characters will be kept')
;SHOW←ERROR←CONTEXT;END;K:=K-1;END;HEADER←BYTES[L]:=K-L;
WHILE K<L+N-1 DO BEGIN K:=K+1;HEADER←BYTES[K]:=0;END;END;{:87}{96:}
PROCEDURE CHECK←TAG(C:BYTE);BEGIN CASE CHAR←TAG[C]OF 0:;
1:BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This character already appeared in a LIGTABLE LABEL');
SHOW←ERROR←CONTEXT;END;2:BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This character already has a NEXTLARGER spec');
SHOW←ERROR←CONTEXT;END;3:BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This character already has a VARCHAR spec');SHOW←ERROR←CONTEXT;
END;END;END;{:96}{106:}PROCEDURE PRINT←OCTAL(C:BYTE);
BEGIN WRITE('''',(C DIV 64):1,((C DIV 8)MOD 8):1,(C MOD 8):1);END;{:106}
{128:}PROCEDURE OUT←SCALED(X:FIX←WORD);VAR Z:REAL;N:BYTE;M:0..65535;
BEGIN IF ABS(X/DESIGN←UNITS)>=16.0 THEN BEGIN WRITELN(
'The relative dimension',X/1048576:1:3,' is too large.');
WRITE('  (Must be less than 16*designsize');
IF DESIGN←UNITS<>1048576 THEN WRITE(' =',DESIGN←UNITS/65536:1:3,
' designunits');WRITELN(')');X:=0;END;
IF X<0 THEN WRITE←BYTE(TFM←FILE,255)ELSE WRITE←BYTE(TFM←FILE,0);
IF DESIGN←UNITS=1048576 THEN BEGIN IF X<0 THEN X:=X+16777216;
N:=X DIV 65536;M:=X MOD 65536;END ELSE BEGIN Z:=(X/DESIGN←UNITS)*16.0;
IF Z<0 THEN Z:=Z+256.0;N:=TRUNC(Z);M:=TRUNC(65536.0*(Z-N));END;
WRITE←BYTE(TFM←FILE,N);WRITE←BYTE(TFM←FILE,M DIV 256);
WRITE←BYTE(TFM←FILE,M MOD 256);END;{:128}{134:}PROCEDURE PARAM←ENTER;
BEGIN{48:}NAME←LENGTH:=5;CUR←NAME[16]:=83;CUR←NAME[17]:=76;
CUR←NAME[18]:=65;CUR←NAME[19]:=78;CUR←NAME[20]:=84;ENTER←NAME(21);
NAME←LENGTH:=5;CUR←NAME[16]:=83;CUR←NAME[17]:=80;CUR←NAME[18]:=65;
CUR←NAME[19]:=67;CUR←NAME[20]:=69;ENTER←NAME(22);NAME←LENGTH:=7;
CUR←NAME[14]:=83;CUR←NAME[15]:=84;CUR←NAME[16]:=82;CUR←NAME[17]:=69;
CUR←NAME[18]:=84;CUR←NAME[19]:=67;CUR←NAME[20]:=72;ENTER←NAME(23);
NAME←LENGTH:=6;CUR←NAME[15]:=83;CUR←NAME[16]:=72;CUR←NAME[17]:=82;
CUR←NAME[18]:=73;CUR←NAME[19]:=78;CUR←NAME[20]:=75;ENTER←NAME(24);
NAME←LENGTH:=7;CUR←NAME[14]:=88;CUR←NAME[15]:=72;CUR←NAME[16]:=69;
CUR←NAME[17]:=73;CUR←NAME[18]:=71;CUR←NAME[19]:=72;CUR←NAME[20]:=84;
ENTER←NAME(25);NAME←LENGTH:=4;CUR←NAME[17]:=81;CUR←NAME[18]:=85;
CUR←NAME[19]:=65;CUR←NAME[20]:=68;ENTER←NAME(26);NAME←LENGTH:=10;
CUR←NAME[11]:=69;CUR←NAME[12]:=88;CUR←NAME[13]:=84;CUR←NAME[14]:=82;
CUR←NAME[15]:=65;CUR←NAME[16]:=83;CUR←NAME[17]:=80;CUR←NAME[18]:=65;
CUR←NAME[19]:=67;CUR←NAME[20]:=69;ENTER←NAME(27);NAME←LENGTH:=4;
CUR←NAME[17]:=78;CUR←NAME[18]:=85;CUR←NAME[19]:=77;CUR←NAME[20]:=49;
ENTER←NAME(28);NAME←LENGTH:=4;CUR←NAME[17]:=78;CUR←NAME[18]:=85;
CUR←NAME[19]:=77;CUR←NAME[20]:=50;ENTER←NAME(29);NAME←LENGTH:=4;
CUR←NAME[17]:=78;CUR←NAME[18]:=85;CUR←NAME[19]:=77;CUR←NAME[20]:=51;
ENTER←NAME(30);NAME←LENGTH:=6;CUR←NAME[15]:=68;CUR←NAME[16]:=69;
CUR←NAME[17]:=78;CUR←NAME[18]:=79;CUR←NAME[19]:=77;CUR←NAME[20]:=49;
ENTER←NAME(31);NAME←LENGTH:=6;CUR←NAME[15]:=68;CUR←NAME[16]:=69;
CUR←NAME[17]:=78;CUR←NAME[18]:=79;CUR←NAME[19]:=77;CUR←NAME[20]:=50;
ENTER←NAME(32);NAME←LENGTH:=4;CUR←NAME[17]:=83;CUR←NAME[18]:=85;
CUR←NAME[19]:=80;CUR←NAME[20]:=49;ENTER←NAME(33);NAME←LENGTH:=4;
CUR←NAME[17]:=83;CUR←NAME[18]:=85;CUR←NAME[19]:=80;CUR←NAME[20]:=50;
ENTER←NAME(34);NAME←LENGTH:=4;CUR←NAME[17]:=83;CUR←NAME[18]:=85;
CUR←NAME[19]:=80;CUR←NAME[20]:=51;ENTER←NAME(35);NAME←LENGTH:=4;
CUR←NAME[17]:=83;CUR←NAME[18]:=85;CUR←NAME[19]:=66;CUR←NAME[20]:=49;
ENTER←NAME(36);NAME←LENGTH:=4;CUR←NAME[17]:=83;CUR←NAME[18]:=85;
CUR←NAME[19]:=66;CUR←NAME[20]:=50;ENTER←NAME(37);NAME←LENGTH:=7;
CUR←NAME[14]:=83;CUR←NAME[15]:=85;CUR←NAME[16]:=80;CUR←NAME[17]:=68;
CUR←NAME[18]:=82;CUR←NAME[19]:=79;CUR←NAME[20]:=80;ENTER←NAME(38);
NAME←LENGTH:=7;CUR←NAME[14]:=83;CUR←NAME[15]:=85;CUR←NAME[16]:=66;
CUR←NAME[17]:=68;CUR←NAME[18]:=82;CUR←NAME[19]:=79;CUR←NAME[20]:=80;
ENTER←NAME(39);NAME←LENGTH:=6;CUR←NAME[15]:=68;CUR←NAME[16]:=69;
CUR←NAME[17]:=76;CUR←NAME[18]:=73;CUR←NAME[19]:=77;CUR←NAME[20]:=49;
ENTER←NAME(40);NAME←LENGTH:=6;CUR←NAME[15]:=68;CUR←NAME[16]:=69;
CUR←NAME[17]:=76;CUR←NAME[18]:=73;CUR←NAME[19]:=77;CUR←NAME[20]:=50;
ENTER←NAME(41);NAME←LENGTH:=10;CUR←NAME[11]:=65;CUR←NAME[12]:=88;
CUR←NAME[13]:=73;CUR←NAME[14]:=83;CUR←NAME[15]:=72;CUR←NAME[16]:=69;
CUR←NAME[17]:=73;CUR←NAME[18]:=71;CUR←NAME[19]:=72;CUR←NAME[20]:=84;
ENTER←NAME(42);NAME←LENGTH:=20;CUR←NAME[1]:=68;CUR←NAME[2]:=69;
CUR←NAME[3]:=70;CUR←NAME[4]:=65;CUR←NAME[5]:=85;CUR←NAME[6]:=76;
CUR←NAME[7]:=84;CUR←NAME[8]:=82;CUR←NAME[9]:=85;CUR←NAME[10]:=76;
CUR←NAME[11]:=69;CUR←NAME[12]:=84;CUR←NAME[13]:=72;CUR←NAME[14]:=73;
CUR←NAME[15]:=67;CUR←NAME[16]:=75;CUR←NAME[17]:=78;CUR←NAME[18]:=69;
CUR←NAME[19]:=83;CUR←NAME[20]:=83;ENTER←NAME(28);NAME←LENGTH:=13;
CUR←NAME[8]:=66;CUR←NAME[9]:=73;CUR←NAME[10]:=71;CUR←NAME[11]:=79;
CUR←NAME[12]:=80;CUR←NAME[13]:=83;CUR←NAME[14]:=80;CUR←NAME[15]:=65;
CUR←NAME[16]:=67;CUR←NAME[17]:=73;CUR←NAME[18]:=78;CUR←NAME[19]:=71;
CUR←NAME[20]:=49;ENTER←NAME(29);NAME←LENGTH:=13;CUR←NAME[8]:=66;
CUR←NAME[9]:=73;CUR←NAME[10]:=71;CUR←NAME[11]:=79;CUR←NAME[12]:=80;
CUR←NAME[13]:=83;CUR←NAME[14]:=80;CUR←NAME[15]:=65;CUR←NAME[16]:=67;
CUR←NAME[17]:=73;CUR←NAME[18]:=78;CUR←NAME[19]:=71;CUR←NAME[20]:=50;
ENTER←NAME(30);NAME←LENGTH:=13;CUR←NAME[8]:=66;CUR←NAME[9]:=73;
CUR←NAME[10]:=71;CUR←NAME[11]:=79;CUR←NAME[12]:=80;CUR←NAME[13]:=83;
CUR←NAME[14]:=80;CUR←NAME[15]:=65;CUR←NAME[16]:=67;CUR←NAME[17]:=73;
CUR←NAME[18]:=78;CUR←NAME[19]:=71;CUR←NAME[20]:=51;ENTER←NAME(31);
NAME←LENGTH:=13;CUR←NAME[8]:=66;CUR←NAME[9]:=73;CUR←NAME[10]:=71;
CUR←NAME[11]:=79;CUR←NAME[12]:=80;CUR←NAME[13]:=83;CUR←NAME[14]:=80;
CUR←NAME[15]:=65;CUR←NAME[16]:=67;CUR←NAME[17]:=73;CUR←NAME[18]:=78;
CUR←NAME[19]:=71;CUR←NAME[20]:=52;ENTER←NAME(32);NAME←LENGTH:=13;
CUR←NAME[8]:=66;CUR←NAME[9]:=73;CUR←NAME[10]:=71;CUR←NAME[11]:=79;
CUR←NAME[12]:=80;CUR←NAME[13]:=83;CUR←NAME[14]:=80;CUR←NAME[15]:=65;
CUR←NAME[16]:=67;CUR←NAME[17]:=73;CUR←NAME[18]:=78;CUR←NAME[19]:=71;
CUR←NAME[20]:=53;ENTER←NAME(33);{:48};END;PROCEDURE NAME←ENTER;
BEGIN{47:}EQUIV[0]:=0;NAME←LENGTH:=8;CUR←NAME[13]:=67;CUR←NAME[14]:=72;
CUR←NAME[15]:=69;CUR←NAME[16]:=67;CUR←NAME[17]:=75;CUR←NAME[18]:=83;
CUR←NAME[19]:=85;CUR←NAME[20]:=77;ENTER←NAME(1);NAME←LENGTH:=10;
CUR←NAME[11]:=68;CUR←NAME[12]:=69;CUR←NAME[13]:=83;CUR←NAME[14]:=73;
CUR←NAME[15]:=71;CUR←NAME[16]:=78;CUR←NAME[17]:=83;CUR←NAME[18]:=73;
CUR←NAME[19]:=90;CUR←NAME[20]:=69;ENTER←NAME(2);NAME←LENGTH:=11;
CUR←NAME[10]:=68;CUR←NAME[11]:=69;CUR←NAME[12]:=83;CUR←NAME[13]:=73;
CUR←NAME[14]:=71;CUR←NAME[15]:=78;CUR←NAME[16]:=85;CUR←NAME[17]:=78;
CUR←NAME[18]:=73;CUR←NAME[19]:=84;CUR←NAME[20]:=83;ENTER←NAME(3);
NAME←LENGTH:=12;CUR←NAME[9]:=67;CUR←NAME[10]:=79;CUR←NAME[11]:=68;
CUR←NAME[12]:=73;CUR←NAME[13]:=78;CUR←NAME[14]:=71;CUR←NAME[15]:=83;
CUR←NAME[16]:=67;CUR←NAME[17]:=72;CUR←NAME[18]:=69;CUR←NAME[19]:=77;
CUR←NAME[20]:=69;ENTER←NAME(4);NAME←LENGTH:=6;CUR←NAME[15]:=70;
CUR←NAME[16]:=65;CUR←NAME[17]:=77;CUR←NAME[18]:=73;CUR←NAME[19]:=76;
CUR←NAME[20]:=89;ENTER←NAME(5);NAME←LENGTH:=4;CUR←NAME[17]:=70;
CUR←NAME[18]:=65;CUR←NAME[19]:=67;CUR←NAME[20]:=69;ENTER←NAME(6);
NAME←LENGTH:=16;CUR←NAME[5]:=83;CUR←NAME[6]:=69;CUR←NAME[7]:=86;
CUR←NAME[8]:=69;CUR←NAME[9]:=78;CUR←NAME[10]:=66;CUR←NAME[11]:=73;
CUR←NAME[12]:=84;CUR←NAME[13]:=83;CUR←NAME[14]:=65;CUR←NAME[15]:=70;
CUR←NAME[16]:=69;CUR←NAME[17]:=70;CUR←NAME[18]:=76;CUR←NAME[19]:=65;
CUR←NAME[20]:=71;ENTER←NAME(7);NAME←LENGTH:=6;CUR←NAME[15]:=72;
CUR←NAME[16]:=69;CUR←NAME[17]:=65;CUR←NAME[18]:=68;CUR←NAME[19]:=69;
CUR←NAME[20]:=82;ENTER←NAME(8);NAME←LENGTH:=9;CUR←NAME[12]:=70;
CUR←NAME[13]:=79;CUR←NAME[14]:=78;CUR←NAME[15]:=84;CUR←NAME[16]:=68;
CUR←NAME[17]:=73;CUR←NAME[18]:=77;CUR←NAME[19]:=69;CUR←NAME[20]:=78;
ENTER←NAME(9);NAME←LENGTH:=8;CUR←NAME[13]:=76;CUR←NAME[14]:=73;
CUR←NAME[15]:=71;CUR←NAME[16]:=84;CUR←NAME[17]:=65;CUR←NAME[18]:=66;
CUR←NAME[19]:=76;CUR←NAME[20]:=69;ENTER←NAME(10);NAME←LENGTH:=9;
CUR←NAME[12]:=67;CUR←NAME[13]:=72;CUR←NAME[14]:=65;CUR←NAME[15]:=82;
CUR←NAME[16]:=65;CUR←NAME[17]:=67;CUR←NAME[18]:=84;CUR←NAME[19]:=69;
CUR←NAME[20]:=82;ENTER←NAME(11);NAME←LENGTH:=9;CUR←NAME[12]:=80;
CUR←NAME[13]:=65;CUR←NAME[14]:=82;CUR←NAME[15]:=65;CUR←NAME[16]:=77;
CUR←NAME[17]:=69;CUR←NAME[18]:=84;CUR←NAME[19]:=69;CUR←NAME[20]:=82;
ENTER←NAME(20);NAME←LENGTH:=6;CUR←NAME[15]:=67;CUR←NAME[16]:=72;
CUR←NAME[17]:=65;CUR←NAME[18]:=82;CUR←NAME[19]:=87;CUR←NAME[20]:=68;
ENTER←NAME(51);NAME←LENGTH:=6;CUR←NAME[15]:=67;CUR←NAME[16]:=72;
CUR←NAME[17]:=65;CUR←NAME[18]:=82;CUR←NAME[19]:=72;CUR←NAME[20]:=84;
ENTER←NAME(52);NAME←LENGTH:=6;CUR←NAME[15]:=67;CUR←NAME[16]:=72;
CUR←NAME[17]:=65;CUR←NAME[18]:=82;CUR←NAME[19]:=68;CUR←NAME[20]:=80;
ENTER←NAME(53);NAME←LENGTH:=6;CUR←NAME[15]:=67;CUR←NAME[16]:=72;
CUR←NAME[17]:=65;CUR←NAME[18]:=82;CUR←NAME[19]:=73;CUR←NAME[20]:=67;
ENTER←NAME(54);NAME←LENGTH:=10;CUR←NAME[11]:=78;CUR←NAME[12]:=69;
CUR←NAME[13]:=88;CUR←NAME[14]:=84;CUR←NAME[15]:=76;CUR←NAME[16]:=65;
CUR←NAME[17]:=82;CUR←NAME[18]:=71;CUR←NAME[19]:=69;CUR←NAME[20]:=82;
ENTER←NAME(55);NAME←LENGTH:=7;CUR←NAME[14]:=86;CUR←NAME[15]:=65;
CUR←NAME[16]:=82;CUR←NAME[17]:=67;CUR←NAME[18]:=72;CUR←NAME[19]:=65;
CUR←NAME[20]:=82;ENTER←NAME(56);NAME←LENGTH:=3;CUR←NAME[18]:=84;
CUR←NAME[19]:=79;CUR←NAME[20]:=80;ENTER←NAME(57);NAME←LENGTH:=3;
CUR←NAME[18]:=77;CUR←NAME[19]:=73;CUR←NAME[20]:=68;ENTER←NAME(58);
NAME←LENGTH:=3;CUR←NAME[18]:=66;CUR←NAME[19]:=79;CUR←NAME[20]:=84;
ENTER←NAME(59);NAME←LENGTH:=3;CUR←NAME[18]:=82;CUR←NAME[19]:=69;
CUR←NAME[20]:=80;ENTER←NAME(60);NAME←LENGTH:=3;CUR←NAME[18]:=69;
CUR←NAME[19]:=88;CUR←NAME[20]:=84;ENTER←NAME(60);NAME←LENGTH:=7;
CUR←NAME[14]:=67;CUR←NAME[15]:=79;CUR←NAME[16]:=77;CUR←NAME[17]:=77;
CUR←NAME[18]:=69;CUR←NAME[19]:=78;CUR←NAME[20]:=84;ENTER←NAME(0);
NAME←LENGTH:=5;CUR←NAME[16]:=76;CUR←NAME[17]:=65;CUR←NAME[18]:=66;
CUR←NAME[19]:=69;CUR←NAME[20]:=76;ENTER←NAME(70);NAME←LENGTH:=3;
CUR←NAME[18]:=76;CUR←NAME[19]:=73;CUR←NAME[20]:=71;ENTER←NAME(71);
NAME←LENGTH:=3;CUR←NAME[18]:=75;CUR←NAME[19]:=82;CUR←NAME[20]:=78;
ENTER←NAME(72);NAME←LENGTH:=4;CUR←NAME[17]:=83;CUR←NAME[18]:=84;
CUR←NAME[19]:=79;CUR←NAME[20]:=80;ENTER←NAME(73);{:47};PARAM←ENTER;END;
PROCEDURE READ←LIG←KERN;VAR KRN←PTR:0..256;C:BYTE;BEGIN{94:}
BEGIN WHILE LEVEL=1 DO BEGIN WHILE CUR←CHAR=32 DO GET←NEXT;
IF CUR←CHAR=40 THEN{95:}BEGIN GET←NAME;
IF CUR←CODE=0 THEN SKIP←TO←END←OF←ITEM ELSE IF(CUR←CODE<70)OR(CUR←CODE>
73)THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This property name doesn''t belong in a LIGTABLE list');
SHOW←ERROR←CONTEXT;END;SKIP←TO←END←OF←ITEM;
END ELSE BEGIN CASE CUR←CODE OF 70:{97:}BEGIN C:=GET←BYTE;CHECK←TAG(C);
IF NL>255 THEN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('LIGTABLE with more than 255 commands cannot have further labels')
;SHOW←ERROR←CONTEXT;END ELSE BEGIN CHAR←TAG[C]:=1;CHAR←REMAINDER[C]:=NL;
UNUSED←LABEL:=TRUE;END;END{:97};71:{98:}BEGIN LIG←KERN[NL].B0:=0;
LIG←KERN[NL].B1:=GET←BYTE;LIG←KERN[NL].B2:=0;LIG←KERN[NL].B3:=GET←BYTE;
IF NL=511 THEN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('LIGTABLE should never exceed 511 LIG/KRN commands');
SHOW←ERROR←CONTEXT;END ELSE NL:=NL+1;UNUSED←LABEL:=FALSE;END{:98};
72:{100:}BEGIN LIG←KERN[NL].B0:=0;LIG←KERN[NL].B1:=GET←BYTE;
LIG←KERN[NL].B2:=128;KERN[NK]:=GET←FIX;KRN←PTR:=0;
WHILE KERN[KRN←PTR]<>KERN[NK]DO KRN←PTR:=KRN←PTR+1;
IF KRN←PTR=NK THEN BEGIN IF NK<256 THEN NK:=NK+1 ELSE BEGIN BEGIN IF
CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('At most 256 different kerns are allowed');SHOW←ERROR←CONTEXT;END;
KRN←PTR:=255;END;END;LIG←KERN[NL].B3:=KRN←PTR;
IF NL=511 THEN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('LIGTABLE should never exceed 511 LIG/KRN commands');
SHOW←ERROR←CONTEXT;END ELSE NL:=NL+1;UNUSED←LABEL:=FALSE;END{:100};
73:{101:}BEGIN IF NL=0 THEN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('Why STOP? You haven''t started');SHOW←ERROR←CONTEXT;
END ELSE BEGIN IF UNUSED←LABEL THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN
WRITELN(' ');WRITE('STOP after LABEL invalidates the label');
SHOW←ERROR←CONTEXT;END;
FOR C:=0 TO 255 DO IF(CHAR←TAG[C]=1)AND(CHAR←REMAINDER[C]=NL)THEN
CHAR←TAG[C]:=0;UNUSED←LABEL:=FALSE;END;LIG←KERN[NL-1].B0:=128;END;
END{:101};END;FINISH←THE←PROPERTY;END;END{:95}
ELSE IF CUR←CHAR=41 THEN SKIP←TO←END←OF←ITEM ELSE JUNK←ERROR;END;
BEGIN LOC:=LOC-1;LEVEL:=LEVEL+1;CUR←CHAR:=41;END;END{:94};END;
PROCEDURE READ←CHAR←INFO;BEGIN{102:}BEGIN C:=GET←BYTE;{107:}
BEGIN IF CHARS←ON←LINE=8 THEN BEGIN WRITELN(' ');CHARS←ON←LINE:=1;
END ELSE BEGIN IF CHARS←ON←LINE>0 THEN WRITE(' ');
CHARS←ON←LINE:=CHARS←ON←LINE+1;END;PRINT←OCTAL(C);END{:107};
WHILE LEVEL=1 DO BEGIN WHILE CUR←CHAR=32 DO GET←NEXT;
IF CUR←CHAR=40 THEN{103:}BEGIN GET←NAME;
IF CUR←CODE=0 THEN SKIP←TO←END←OF←ITEM ELSE IF(CUR←CODE<51)OR(CUR←CODE>
56)THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This property name doesn''t belong in a CHARACTER list');
SHOW←ERROR←CONTEXT;END;SKIP←TO←END←OF←ITEM;
END ELSE BEGIN CASE CUR←CODE OF 51:CHAR←WD[C]:=SORT←IN(1,GET←FIX);
52:CHAR←HT[C]:=SORT←IN(2,GET←FIX);53:CHAR←DP[C]:=SORT←IN(3,GET←FIX);
54:CHAR←IC[C]:=SORT←IN(4,GET←FIX);55:BEGIN CHECK←TAG(C);CHAR←TAG[C]:=2;
CHAR←REMAINDER[C]:=GET←BYTE;END;56:{104:}
BEGIN IF NE=256 THEN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('At most 256 VARCHAR specs are allowed');SHOW←ERROR←CONTEXT;
END ELSE BEGIN CHECK←TAG(C);CHAR←TAG[C]:=3;CHAR←REMAINDER[C]:=NE;
EXTEN[NE].B0:=0;EXTEN[NE].B1:=0;EXTEN[NE].B2:=0;EXTEN[NE].B3:=0;
WHILE LEVEL=2 DO BEGIN WHILE CUR←CHAR=32 DO GET←NEXT;
IF CUR←CHAR=40 THEN{105:}BEGIN GET←NAME;
IF CUR←CODE=0 THEN SKIP←TO←END←OF←ITEM ELSE IF(CUR←CODE<57)OR(CUR←CODE>
60)THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This property name doesn''t belong in a VARCHAR list');
SHOW←ERROR←CONTEXT;END;SKIP←TO←END←OF←ITEM;
END ELSE BEGIN CASE CUR←CODE-(57)OF 0:EXTEN[NE].B0:=GET←BYTE;
1:EXTEN[NE].B1:=GET←BYTE;2:EXTEN[NE].B2:=GET←BYTE;
3:EXTEN[NE].B3:=GET←BYTE;END;FINISH←THE←PROPERTY;END;END{:105}
ELSE IF CUR←CHAR=41 THEN SKIP←TO←END←OF←ITEM ELSE JUNK←ERROR;END;
NE:=NE+1;BEGIN LOC:=LOC-1;LEVEL:=LEVEL+1;CUR←CHAR:=41;END;END;END{:104};
END;FINISH←THE←PROPERTY;END;END{:103}
ELSE IF CUR←CHAR=41 THEN SKIP←TO←END←OF←ITEM ELSE JUNK←ERROR;END;
IF CHAR←WD[C]=0 THEN CHAR←WD[C]:=SORT←IN(1,0);BEGIN LOC:=LOC-1;
LEVEL:=LEVEL+1;CUR←CHAR:=41;END;END{:102};END;PROCEDURE READ←INPUT;
BEGIN{82:}CUR←CHAR:=32;REPEAT WHILE CUR←CHAR=32 DO GET←NEXT;
IF CUR←CHAR=40 THEN{84:}BEGIN GET←NAME;
IF CUR←CODE=0 THEN SKIP←TO←END←OF←ITEM ELSE IF CUR←CODE>11 THEN BEGIN
BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This property name doesn''t belong on the outer level');
SHOW←ERROR←CONTEXT;END;SKIP←TO←END←OF←ITEM;END ELSE BEGIN{85:}
CASE CUR←CODE OF 1:BEGIN CHECK←SUM←SPECIFIED:=TRUE;READ←FOUR←BYTES(0);
END;2:{88:}BEGIN NEXT←D:=GET←FIX;
IF(NEXT←D<1048576)OR(NEXT←D>=1073741824)THEN BEGIN IF CHARS←ON←LINE>0
THEN WRITELN(' ');WRITE('The design size must be between 1 and 1024');
SHOW←ERROR←CONTEXT;END ELSE DESIGN←SIZE:=NEXT←D;END{:88};3:{89:}
BEGIN NEXT←D:=GET←FIX;
IF NEXT←D<=0 THEN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('The number of units per design size must be positive');
SHOW←ERROR←CONTEXT;END ELSE DESIGN←UNITS:=NEXT←D;END{:89};
4:READ←BCPL(8,40);5:READ←BCPL(48,20);6:HEADER←BYTES[71]:=GET←BYTE;
7:{90:}BEGIN WHILE CUR←CHAR=32 DO GET←NEXT;
IF CUR←CHAR=84 THEN SEVEN←BIT←SAFE←FLAG:=TRUE ELSE IF CUR←CHAR=70 THEN
SEVEN←BIT←SAFE←FLAG:=FALSE ELSE BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(
' ');WRITE('The flag value should be "TRUE" or "FALSE"');
SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);END{:90};8:{91:}
BEGIN C:=GET←BYTE;
IF C<18 THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('HEADER indices should be 18 or more');SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);
END ELSE IF 4*C+4>MAX←HEADER←BYTES THEN BEGIN BEGIN IF CHARS←ON←LINE>0
THEN WRITELN(' ');
WRITE('This HEADER index is too big for my present table size');
SHOW←ERROR←CONTEXT;END;
REPEAT GET←NEXT UNTIL(CUR←CHAR=40)OR(CUR←CHAR=41);
END ELSE BEGIN WHILE HEADER←PTR<4*C DO BEGIN HEADER←BYTES[HEADER←PTR]:=0
;HEADER←PTR:=HEADER←PTR+1;END;READ←FOUR←BYTES(4*C);HEADER←PTR:=4*C+4;
END;END{:91};9:{92:}
BEGIN WHILE LEVEL=1 DO BEGIN WHILE CUR←CHAR=32 DO GET←NEXT;
IF CUR←CHAR=40 THEN{93:}BEGIN GET←NAME;
IF CUR←CODE=0 THEN SKIP←TO←END←OF←ITEM ELSE IF(CUR←CODE<20)OR(CUR←CODE>=
51)THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('This property name doesn''t belong in a FONTDIMEN list');
SHOW←ERROR←CONTEXT;END;SKIP←TO←END←OF←ITEM;
END ELSE BEGIN IF CUR←CODE=20 THEN C:=GET←BYTE ELSE C:=CUR←CODE-20;
IF C=0 THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN WRITELN(' ');
WRITE('PARAMETER index must not be zero');SHOW←ERROR←CONTEXT;END;
SKIP←TO←END←OF←ITEM;
END ELSE IF C>MAX←PARAM←WORDS THEN BEGIN BEGIN IF CHARS←ON←LINE>0 THEN
WRITELN(' ');
WRITE('This PARAMETER index is too big for my present table size');
SHOW←ERROR←CONTEXT;END;SKIP←TO←END←OF←ITEM;
END ELSE BEGIN WHILE NP<C DO BEGIN NP:=NP+1;PARAM[NP]:=0;END;
PARAM[C]:=GET←FIX;FINISH←THE←PROPERTY;END;END;END{:93}
ELSE IF CUR←CHAR=41 THEN SKIP←TO←END←OF←ITEM ELSE JUNK←ERROR;END;
BEGIN LOC:=LOC-1;LEVEL:=LEVEL+1;CUR←CHAR:=41;END;END{:92};
10:READ←LIG←KERN;11:READ←CHAR←INFO;END{:85};FINISH←THE←PROPERTY;END;
END{:84}ELSE IF(CUR←CHAR=41)AND NOT INPUT←HAS←ENDED THEN BEGIN BEGIN IF
CHARS←ON←LINE>0 THEN WRITELN(' ');WRITE('Extra right parenthesis');
SHOW←ERROR←CONTEXT;END;LOC:=LOC+1;CUR←CHAR:=32;
END ELSE IF NOT INPUT←HAS←ENDED THEN JUNK←ERROR;
UNTIL INPUT←HAS←ENDED{:82};END;PROCEDURE CORR←AND←CHECK;VAR C:BYTE;
LIG←PTR:0..511;G:BYTE;BEGIN{109:}{110:}
IF UNUSED←LABEL THEN BEGIN FOR C:=0 TO 255 DO IF(CHAR←TAG[C]=1)AND(
CHAR←REMAINDER[C]=NL)THEN CHAR←TAG[C]:=0;
WRITELN('Last LIGTABLE LABEL was not used.');END;
IF NL>0 THEN LIG←KERN[NL-1].B0:=128{:110};SEVEN←UNSAFE:=FALSE;
FOR C:=0 TO 255 DO IF CHAR←WD[C]<>0 THEN{111:}CASE CHAR←TAG[C]OF 0:;
1:{113:}BEGIN IF CHAR←WD[C]=0 THEN BEGIN WRITE(
'There''s a LABEL but no CHARACTER spec for ');PRINT←OCTAL(C);
WRITELN('.');CHAR←WD[C]:=SORT←IN(1,0);END;LIG←PTR:=CHAR←REMAINDER[C];
REPEAT IF LIG←KERN[LIG←PTR].B2<128 THEN BEGIN BEGIN G:=LIG←KERN[LIG←PTR]
.B1;IF(G>=128)AND(C<128)THEN SEVEN←UNSAFE:=TRUE;
IF CHAR←WD[G]=0 THEN BEGIN CHAR←WD[G]:=SORT←IN(1,0);
WRITE('LIG character generated by',' ');PRINT←OCTAL(C);
WRITELN(' had no CHARACTER spec.');END;END;
BEGIN G:=LIG←KERN[LIG←PTR].B3;
IF(G>=128)AND(C<128)THEN SEVEN←UNSAFE:=TRUE;
IF CHAR←WD[G]=0 THEN BEGIN CHAR←WD[G]:=SORT←IN(1,0);
WRITE('LIG character generated by',' ');PRINT←OCTAL(C);
WRITELN(' had no CHARACTER spec.');END;END;
END ELSE BEGIN G:=LIG←KERN[LIG←PTR].B1;
IF(G>=128)AND(C<128)THEN SEVEN←UNSAFE:=TRUE;
IF CHAR←WD[G]=0 THEN BEGIN CHAR←WD[G]:=SORT←IN(1,0);
WRITE('KRN character generated by',' ');PRINT←OCTAL(C);
WRITELN(' had no CHARACTER spec.');END;END;LIG←PTR:=LIG←PTR+1;
UNTIL LIG←KERN[LIG←PTR-1].B0=128;END{:113};2:BEGIN G:=CHAR←REMAINDER[C];
IF(G>=128)AND(C<128)THEN SEVEN←UNSAFE:=TRUE;
IF CHAR←WD[G]=0 THEN BEGIN CHAR←WD[G]:=SORT←IN(1,0);
WRITE('The character NEXTLARGER than',' ');PRINT←OCTAL(C);
WRITELN(' had no CHARACTER spec.');END;END;3:{114:}
BEGIN IF EXTEN[CHAR←REMAINDER[C]].B0>0 THEN BEGIN G:=EXTEN[
CHAR←REMAINDER[C]].B0;IF(G>=128)AND(C<128)THEN SEVEN←UNSAFE:=TRUE;
IF CHAR←WD[G]=0 THEN BEGIN CHAR←WD[G]:=SORT←IN(1,0);
WRITE('TOP piece of character',' ');PRINT←OCTAL(C);
WRITELN(' had no CHARACTER spec.');END;END;
IF EXTEN[CHAR←REMAINDER[C]].B1>0 THEN BEGIN G:=EXTEN[CHAR←REMAINDER[C]].
B1;IF(G>=128)AND(C<128)THEN SEVEN←UNSAFE:=TRUE;
IF CHAR←WD[G]=0 THEN BEGIN CHAR←WD[G]:=SORT←IN(1,0);
WRITE('MID piece of character',' ');PRINT←OCTAL(C);
WRITELN(' had no CHARACTER spec.');END;END;
IF EXTEN[CHAR←REMAINDER[C]].B2>0 THEN BEGIN G:=EXTEN[CHAR←REMAINDER[C]].
B2;IF(G>=128)AND(C<128)THEN SEVEN←UNSAFE:=TRUE;
IF CHAR←WD[G]=0 THEN BEGIN CHAR←WD[G]:=SORT←IN(1,0);
WRITE('BOT piece of character',' ');PRINT←OCTAL(C);
WRITELN(' had no CHARACTER spec.');END;END;
BEGIN G:=EXTEN[CHAR←REMAINDER[C]].B3;
IF(G>=128)AND(C<128)THEN SEVEN←UNSAFE:=TRUE;
IF CHAR←WD[G]=0 THEN BEGIN CHAR←WD[G]:=SORT←IN(1,0);
WRITE('REP piece of character',' ');PRINT←OCTAL(C);
WRITELN(' had no CHARACTER spec.');END;END;END{:114};END{:111};
IF SEVEN←BIT←SAFE←FLAG AND SEVEN←UNSAFE THEN WRITELN(
'The font is not really seven-bit-safe!');{115:}
IF NL>0 THEN FOR LIG←PTR:=0 TO NL-1 DO IF LIG←KERN[LIG←PTR].B2<128 THEN
BEGIN C:=LIG←KERN[LIG←PTR].B3;
IF CHAR←WD[C]=0 THEN BEGIN LIG←KERN[LIG←PTR].B3:=0;
IF CHAR←WD[0]=0 THEN CHAR←WD[0]:=SORT←IN(1,0);
WRITE('Unused ','LIG step',' refers to nonexistent character ');
PRINT←OCTAL(C);WRITELN('!');END;END ELSE BEGIN C:=LIG←KERN[LIG←PTR].B1;
IF CHAR←WD[C]=0 THEN BEGIN LIG←KERN[LIG←PTR].B1:=0;
IF CHAR←WD[0]=0 THEN CHAR←WD[0]:=SORT←IN(1,0);
WRITE('Unused ','KRN step',' refers to nonexistent character ');
PRINT←OCTAL(C);WRITELN('!');END;END;
IF NE>0 THEN FOR G:=0 TO NE-1 DO BEGIN BEGIN C:=EXTEN[G].B0;
IF C>0 THEN IF CHAR←WD[C]=0 THEN BEGIN EXTEN[G].B0:=0;
IF CHAR←WD[0]=0 THEN CHAR←WD[0]:=SORT←IN(1,0);
WRITE('Unused ','VARCHAR TOP',' refers to nonexistent character ');
PRINT←OCTAL(C);WRITELN('!');END;END;BEGIN C:=EXTEN[G].B1;
IF C>0 THEN IF CHAR←WD[C]=0 THEN BEGIN EXTEN[G].B1:=0;
IF CHAR←WD[0]=0 THEN CHAR←WD[0]:=SORT←IN(1,0);
WRITE('Unused ','VARCHAR MID',' refers to nonexistent character ');
PRINT←OCTAL(C);WRITELN('!');END;END;BEGIN C:=EXTEN[G].B2;
IF C>0 THEN IF CHAR←WD[C]=0 THEN BEGIN EXTEN[G].B2:=0;
IF CHAR←WD[0]=0 THEN CHAR←WD[0]:=SORT←IN(1,0);
WRITE('Unused ','VARCHAR BOT',' refers to nonexistent character ');
PRINT←OCTAL(C);WRITELN('!');END;END;BEGIN C:=EXTEN[G].B3;
IF CHAR←WD[C]=0 THEN BEGIN EXTEN[G].B3:=0;
IF CHAR←WD[0]=0 THEN CHAR←WD[0]:=SORT←IN(1,0);
WRITE('Unused ','VARCHAR REP',' refers to nonexistent character ');
PRINT←OCTAL(C);WRITELN('!');END;END;END{:115};FOR C:=0 TO 255 DO{116:}
IF CHAR←TAG[C]=2 THEN BEGIN G:=CHAR←REMAINDER[C];
WHILE(G<C)AND(CHAR←TAG[G]=2)DO G:=CHAR←REMAINDER[G];
IF G=C THEN BEGIN CHAR←TAG[C]:=0;
WRITE('A cycle of NEXTLARGER characters has been broken at ');
PRINT←OCTAL(C);WRITELN('.');END;END{:116};{118:}DELTA:=SHORTEN(1,255);
SET←INDICES(1,DELTA);
IF DELTA>0 THEN WRITELN('I had to round some ','width','s by',(((DELTA+1
)DIV 2)/1048576):1:7,' units.');DELTA:=SHORTEN(2,15);
SET←INDICES(2,DELTA);
IF DELTA>0 THEN WRITELN('I had to round some ','height','s by',(((DELTA
+1)DIV 2)/1048576):1:7,' units.');DELTA:=SHORTEN(3,15);
SET←INDICES(3,DELTA);
IF DELTA>0 THEN WRITELN('I had to round some ','depth','s by',(((DELTA+1
)DIV 2)/1048576):1:7,' units.');DELTA:=SHORTEN(4,63);
SET←INDICES(4,DELTA);
IF DELTA>0 THEN WRITELN('I had to round some ','italic correction',
's by',(((DELTA+1)DIV 2)/1048576):1:7,' units.');{:118}{:109}END;{:134}
{135:}BEGIN TTY←REWRITE(OUTPUT);INITIALIZE;NAME←ENTER;READ←INPUT;
WRITELN('.');CORR←AND←CHECK;{120:}{122:}LH:=HEADER←PTR DIV 4;
NOT←FOUND:=TRUE;BC:=0;
WHILE NOT←FOUND DO IF(CHAR←WD[BC]>0)OR(BC=255)THEN NOT←FOUND:=FALSE ELSE
BC:=BC+1;NOT←FOUND:=TRUE;EC:=255;
WHILE NOT←FOUND DO IF(CHAR←WD[EC]>0)OR(EC=0)THEN NOT←FOUND:=FALSE ELSE
EC:=EC-1;IF BC>EC THEN BC:=1;MEMORY[1]:=MEMORY[1]+1;
MEMORY[2]:=MEMORY[2]+1;MEMORY[3]:=MEMORY[3]+1;MEMORY[4]:=MEMORY[4]+1;
LF:=6+LH+(EC-BC+1)+MEMORY[1]+MEMORY[2]+MEMORY[3]+MEMORY[4]+NL+NK+NE+NP;
{:122};{123:}WRITE←BYTE(TFM←FILE,(LF)DIV 256);
WRITE←BYTE(TFM←FILE,(LF)MOD 256);WRITE←BYTE(TFM←FILE,(LH)DIV 256);
WRITE←BYTE(TFM←FILE,(LH)MOD 256);WRITE←BYTE(TFM←FILE,(BC)DIV 256);
WRITE←BYTE(TFM←FILE,(BC)MOD 256);WRITE←BYTE(TFM←FILE,(EC)DIV 256);
WRITE←BYTE(TFM←FILE,(EC)MOD 256);
WRITE←BYTE(TFM←FILE,(MEMORY[1])DIV 256);
WRITE←BYTE(TFM←FILE,(MEMORY[1])MOD 256);
WRITE←BYTE(TFM←FILE,(MEMORY[2])DIV 256);
WRITE←BYTE(TFM←FILE,(MEMORY[2])MOD 256);
WRITE←BYTE(TFM←FILE,(MEMORY[3])DIV 256);
WRITE←BYTE(TFM←FILE,(MEMORY[3])MOD 256);
WRITE←BYTE(TFM←FILE,(MEMORY[4])DIV 256);
WRITE←BYTE(TFM←FILE,(MEMORY[4])MOD 256);
WRITE←BYTE(TFM←FILE,(NL)DIV 256);WRITE←BYTE(TFM←FILE,(NL)MOD 256);
WRITE←BYTE(TFM←FILE,(NK)DIV 256);WRITE←BYTE(TFM←FILE,(NK)MOD 256);
WRITE←BYTE(TFM←FILE,(NE)DIV 256);WRITE←BYTE(TFM←FILE,(NE)MOD 256);
WRITE←BYTE(TFM←FILE,(NP)DIV 256);WRITE←BYTE(TFM←FILE,(NP)MOD 256);{:123}
;{125:}IF NOT CHECK←SUM←SPECIFIED THEN{126:}BEGIN CUR←BYTES.B0:=BC;
CUR←BYTES.B1:=EC;CUR←BYTES.B2:=BC;CUR←BYTES.B3:=EC;
FOR C:=BC TO EC DO IF CHAR←WD[C]>0 THEN BEGIN TEMP←WIDTH:=MEMORY[CHAR←WD
[C]];
IF DESIGN←UNITS<>1048576 THEN TEMP←WIDTH:=TRUNC((TEMP←WIDTH/DESIGN←UNITS
)*1048576.0);TEMP←WIDTH:=TEMP←WIDTH+(C+4)*4194304;
CUR←BYTES.B0:=(CUR←BYTES.B0+CUR←BYTES.B0+TEMP←WIDTH)MOD 255;
CUR←BYTES.B1:=(CUR←BYTES.B1+CUR←BYTES.B1+TEMP←WIDTH)MOD 253;
CUR←BYTES.B2:=(CUR←BYTES.B2+CUR←BYTES.B2+TEMP←WIDTH)MOD 251;
CUR←BYTES.B3:=(CUR←BYTES.B3+CUR←BYTES.B3+TEMP←WIDTH)MOD 247;END;
HEADER←BYTES[0]:=CUR←BYTES.B0;HEADER←BYTES[1]:=CUR←BYTES.B1;
HEADER←BYTES[2]:=CUR←BYTES.B2;HEADER←BYTES[3]:=CUR←BYTES.B3;END{:126};
HEADER←BYTES[4]:=DESIGN←SIZE DIV 16777216;
HEADER←BYTES[5]:=(DESIGN←SIZE DIV 65536)MOD 256;
HEADER←BYTES[6]:=(DESIGN←SIZE DIV 256)MOD 256;
HEADER←BYTES[7]:=DESIGN←SIZE MOD 256;
IF NOT SEVEN←UNSAFE THEN HEADER←BYTES[68]:=128;
FOR J:=0 TO HEADER←PTR-1 DO WRITE←BYTE(TFM←FILE,HEADER←BYTES[J]);{:125};
{127:}INDEX[0]:=0;
FOR C:=BC TO EC DO BEGIN WRITE←BYTE(TFM←FILE,INDEX[CHAR←WD[C]]);
WRITE←BYTE(TFM←FILE,INDEX[CHAR←HT[C]]*16+INDEX[CHAR←DP[C]]);
WRITE←BYTE(TFM←FILE,INDEX[CHAR←IC[C]]*4+CHAR←TAG[C]);
WRITE←BYTE(TFM←FILE,CHAR←REMAINDER[C]);END{:127};{129:}
FOR Q:=1 TO 4 DO BEGIN WRITE←BYTE(TFM←FILE,0);WRITE←BYTE(TFM←FILE,0);
WRITE←BYTE(TFM←FILE,0);WRITE←BYTE(TFM←FILE,0);P:=LINK[Q];
WHILE P>0 DO BEGIN OUT←SCALED(MEMORY[P]);P:=LINK[P];END;END;{:129};
{130:}IF NL>0 THEN FOR LIG←PTR:=0 TO NL-1 DO BEGIN WRITE←BYTE(TFM←FILE,
LIG←KERN[LIG←PTR].B0);WRITE←BYTE(TFM←FILE,LIG←KERN[LIG←PTR].B1);
WRITE←BYTE(TFM←FILE,LIG←KERN[LIG←PTR].B2);
WRITE←BYTE(TFM←FILE,LIG←KERN[LIG←PTR].B3);END;
IF NK>0 THEN FOR KRN←PTR:=0 TO NK-1 DO OUT←SCALED(KERN[KRN←PTR]){:130};
{131:}
IF NE>0 THEN FOR C:=0 TO NE-1 DO BEGIN WRITE←BYTE(TFM←FILE,EXTEN[C].B0);
WRITE←BYTE(TFM←FILE,EXTEN[C].B1);WRITE←BYTE(TFM←FILE,EXTEN[C].B2);
WRITE←BYTE(TFM←FILE,EXTEN[C].B3);END;{:131};{132:}
FOR PAR←PTR:=1 TO NP DO BEGIN IF PAR←PTR=1 THEN{133:}
BEGIN IF PARAM[1]<0 THEN BEGIN PARAM[1]:=PARAM[1]+1073741824;
WRITE←BYTE(TFM←FILE,(PARAM[1]DIV 16777216)+192);
END ELSE WRITE←BYTE(TFM←FILE,PARAM[1]DIV 16777216);
WRITE←BYTE(TFM←FILE,(PARAM[1]DIV 65536)MOD 256);
WRITE←BYTE(TFM←FILE,(PARAM[1]DIV 256)MOD 256);
WRITE←BYTE(TFM←FILE,PARAM[1]MOD 256);END{:133}
ELSE OUT←SCALED(PARAM[PAR←PTR]);END{:132}{:120};FILE←CLOSE(PL←FILE);
BYTE←FILE←CLOSE(TFM←FILE);END.{:135}