-- file: PLtoTF3Impl.mesa
-- Pascal-to-Mesa translator output, translated at September 23, 1986 1:41:45 pm PDT


DIRECTORY
  PascalBasic,
  PascalWizardFiles,
  PLtoTFPrivate,
  PLtoTFExternals;

PLtoTF3Impl: PROGRAM IMPORTS PascalBasic, PascalWizardFiles, PLtoTFPrivate EXPORTS PLtoTFPrivate = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, PLtoTFPrivate, PLtoTFExternals;
 GetFourBytes: PROCEDURE = 
BEGIN C:PascalInteger;
R:PascalInteger;Q:PascalInteger; DO GetNext[]; IF CurChar#32 THEN EXIT; ENDLOOP;R←0;
CurBytes.B0←0;CurBytes.B1←0;CurBytes.B2←0;CurBytes.B3←0;
IF CurChar=72  THEN R←16  ELSE IF CurChar=79  THEN R←8  ELSE BEGIN BEGIN
IF  INT[CharsOnLine]>0  THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "An octal (\"O\") or hex (\"H\") value is needed here"];
ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END;
IF R>0  THEN BEGIN  Q← 256 /R;DO GetNext[]; IF CurChar#32 THEN EXIT; ENDLOOP;
WHILE(( INT[CurChar]>=48)AND ( INT[CurChar]<=57))OR (( INT[CurChar]>=65)AND ( INT[CurChar]<=70)
)DO--60:--BEGIN IF  INT[CurChar]>=65  THEN CurChar←CurChar-7;
C←(R*CurBytes.B0)+( CurBytes.B1 /Q);
IF C>255  THEN BEGIN CurBytes.B0←0;CurBytes.B1←0;CurBytes.B2←0;
CurBytes.B3←0;
IF R=8  THEN BEGIN BEGIN IF  INT[CharsOnLine]>0  THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "Sorry, the maximum octal value is O 37777777777"];
ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP;
 END  ELSE BEGIN BEGIN IF  INT[CharsOnLine]>0  THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "Sorry, the maximum hex value is H FFFFFFFF"];ShowErrorContext[];
 END;DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END;
 END  ELSE IF CurChar>=48+R  THEN BEGIN BEGIN IF  INT[CharsOnLine]>0  THEN
{PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};PascalWriteLongString[file: @Output, item: "Illegal digit"];ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP;
 END  ELSE BEGIN CurBytes.B0←C;
CurBytes.B1←(R*( CurBytes.B1 MOD Q))+( CurBytes.B2 /Q);
CurBytes.B2←(R*( CurBytes.B2 MOD Q))+( CurBytes.B3 /Q);
CurBytes.B3←(R*( CurBytes.B3 MOD Q))+CurChar-48;GetNext[]; END; END ENDLOOP ;
--:60-- END; END;--:59----62:-- GetFix: PROCEDURE RETURNS[GetFixResult: FixWord] = 
BEGIN Negative:PascalBoolean;
Acc:PascalInteger;IntPart:PascalInteger;J:PascalInteger[0..7]; DO GetNext[];
 IF CurChar#32 THEN EXIT; ENDLOOP;Negative←FALSE;Acc←0;
IF(CurChar#82)AND (CurChar#68) THEN BEGIN BEGIN IF  INT[CharsOnLine]>0
 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};PascalWriteLongString[file: @Output, item: "An \"R\" or \"D\" value is needed here"];
ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END  ELSE BEGIN--63:
DO GetNext[];IF CurChar=45  THEN BEGIN CurChar←32;Negative←TRUE;
 END  ELSE IF CurChar=43  THEN CurChar←32; IF CurChar#32--:63-- THEN EXIT; ENDLOOP;
WHILE( INT[CurChar]>=48)AND ( INT[CurChar]<=57)DO--64:
BEGIN Acc←Acc*10+CurChar-48;
IF Acc>=1024  THEN BEGIN BEGIN BEGIN IF  INT[CharsOnLine]>0  THEN {PascalWriteLongString[file: @Output, item: " "]
; PascalWriteLn[file: @Output]};PascalWriteLongString[file: @Output, item: "Real constants must be less than 1024"];ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END;Acc←0;
CurChar←32; END  ELSE GetNext[]; END--:64-- ENDLOOP ;IntPart←Acc;Acc←0;
IF CurChar=46  THEN--66:--BEGIN J←0;GetNext[];
WHILE( INT[CurChar]>=48)AND ( INT[CurChar]<=57)DO BEGIN IF  INT[J]<7  THEN BEGIN J←J+1;
FractionDigits↑[J]←2097152*(CurChar-48); END;GetNext[]; END ENDLOOP ;Acc←0;
WHILE  INT[J]>0 DO BEGIN Acc←FractionDigits↑[J]+( Acc /10);J←J-1; END ENDLOOP ;
Acc← (Acc+10)/20; END--:66--;
IF(Acc>=1048576)AND (IntPart=1023) THEN BEGIN BEGIN IF  INT[CharsOnLine]>0
 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};PascalWriteLongString[file: @Output, item: "Real constants must be less than 1024"];
ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP;
 END  ELSE Acc←IntPart*1048576+Acc; END;
IF Negative  THEN GetFixResult←-Acc  ELSE GetFixResult←Acc; END;--:62----75:
 SortIn: PROCEDURE[H: Pointer,D: FixWord] RETURNS[SortInResult: Pointer] = 
BEGIN P:Pointer;
 IF(D=0)AND (H#1) THEN SortInResult←0  ELSE BEGIN P←H;
WHILE D>=Memory↑[Link↑[P]]DO P←Link↑[P] ENDLOOP ;
IF(D=Memory↑[P])AND (P#H) THEN SortInResult←P  ELSE IF MemPtr=1032  THEN BEGIN
BEGIN IF  INT[CharsOnLine]>0  THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "Memory overflow: more than 1028 widths, etc"];ShowErrorContext[];
 END;{PascalWriteLongString[file: @Output, item: "Congratulations! It's hard to make this error."]; PascalWriteLn[file: @Output]};
SortInResult←P; END  ELSE BEGIN MemPtr←MemPtr+1;Memory↑[MemPtr]←D;
Link↑[MemPtr]←Link↑[P];Link↑[P]←MemPtr;Memory↑[H]←Memory↑[H]+1;
SortInResult←MemPtr; END; END; END;--:75----77:-- MinCover: PROCEDURE[H: Pointer,
D: FixWord] RETURNS[MinCoverResult: PascalInteger] = 
BEGIN P:Pointer;L:FixWord;M:PascalInteger; M←0;
P←Link↑[H];NextD←Memory↑[0];WHILE P#0 DO BEGIN M←M+1;L←Memory↑[P];
WHILE Memory↑[Link↑[P]]<=L+D DO P←Link↑[P] ENDLOOP ;P←Link↑[P];
IF Memory↑[P]-L<NextD  THEN NextD←Memory↑[P]-L; END ENDLOOP ;MinCoverResult←M; END;
--:77----78:-- Shorten: PROCEDURE[H: Pointer,M: PascalInteger] RETURNS[ShortenResult: FixWord] = 
BEGIN D:FixWord;
K:PascalInteger; IF Memory↑[H]>M  THEN BEGIN K←MinCover[H,0];D←NextD;
DO D←D+D;K←MinCover[H,D]; IF K<=M THEN EXIT; ENDLOOP;D← PascalDIVPower2[D ,1];K←MinCover[H,D];
WHILE K>M DO BEGIN D←NextD;K←MinCover[H,D]; END ENDLOOP ;ShortenResult←D;
 END  ELSE ShortenResult←0; END;--:78----80:-- SetIndices: PROCEDURE[H: Pointer,
D: FixWord] = 
BEGIN P:Pointer;Q:Pointer;M:Byte;L:FixWord; 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 ENDLOOP ;
Link↑[Q]←P;Memory↑[P]← PascalDIVPower2[(L+Memory↑[P]),1];Q←P;P←Link↑[P]; END ENDLOOP ;
Memory↑[H]←M; END;--:80----83:-- JunkError: PROCEDURE
 = 
BEGIN BEGIN IF  INT[CharsOnLine]>0  THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "There's junk here that is not in parentheses"];
ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END;--:83----86:
 ReadFourBytes: PROCEDURE[L: HeaderIndex] = 
BEGIN GetFourBytes[];
HeaderBytes↑[L]←CurBytes.B0;HeaderBytes↑[L+1]←CurBytes.B1;
HeaderBytes↑[L+2]←CurBytes.B2;HeaderBytes↑[L+3]←CurBytes.B3; END;

END.