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