-- file: PLtoTF2Impl.mesa
-- Pascal-to-Mesa translator output, translated at September 23, 1986 1:41:45 pm PDT
DIRECTORY
PascalBasic,
PascalWizardFiles,
PLtoTFPrivate,
PLtoTFExternals;
PLtoTF2Impl: PROGRAM IMPORTS PascalWizardFiles, PLtoTFPrivate EXPORTS PLtoTFPrivate = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, PLtoTFPrivate, PLtoTFExternals;
SkipToEndOfItem: PROCEDURE =
BEGIN L:PascalInteger; L←Level;
WHILE Level>=L DO BEGIN WHILE Loc=Limit DO FillBuffer[] ENDLOOP ;Loc←Loc+1;
IF Buffer↑[Loc]=') THEN Level←Level-1 ELSE IF Buffer↑[Loc]='( THEN Level
←Level+1; END ENDLOOP ;
IF InputHasEnded THEN BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "File ended unexpectedly: No closing \")\""];ShowErrorContext[]; END;
CurChar←32; END;--:33----35:-- FinishTheProperty: PROCEDURE
=
BEGIN WHILE CurChar=32 DO GetNext[] ENDLOOP ;
IF CurChar#41 THEN BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "Junk after property value will be ignored"];ShowErrorContext[];
END;SkipToEndOfItem[]; END;--:35----42:-- Lookup: PROCEDURE =
BEGIN K:PascalInteger[0..20];
J:PascalInteger[0..500];NotFound:PascalBoolean;--43:--CurHash←CurName↑[1];
FOR i:INT IN [ INT[2 ].. INT[NameLength ]] DO K ← i; CurHash←
(CurHash+CurHash+CurName↑[K])MOD 101--:43-- ENDLOOP;NotFound←TRUE;
WHILE NotFound DO BEGIN IF CurHash=0 THEN CurHash←100 ELSE CurHash
←CurHash-1;
IF Hash↑[CurHash]=0 THEN NotFound←FALSE ELSE BEGIN J←Start↑[Hash↑
[CurHash]];
IF Start↑[Hash↑[CurHash]+1]=J+NameLength THEN BEGIN NotFound←FALSE;
FOR i:INT IN [ INT[1 ].. INT[NameLength ]] DO K ← i; IF Dictionary↑[J+K-1]#CurName↑[K] THEN
NotFound←TRUE ENDLOOP; END; END; END ENDLOOP ;NamePtr←Hash↑[CurHash]; END;--:42----45:
EnterName: PROCEDURE[V: Byte] =
BEGIN K:PascalInteger[0..20];
FOR i:INT IN [ INT[1 ].. INT[NameLength ]] DO K ← i; CurName↑[K]←CurName↑[K+20-NameLength]
ENDLOOP;Lookup[];Hash↑[CurHash]←StartPtr;Equiv↑[StartPtr]←V;
FOR i:INT IN [ INT[1 ].. INT[NameLength ]] DO K ← i; Dictionary↑[DictPtr]←CurName↑[K];
DictPtr←DictPtr+1; ENDLOOP;StartPtr←StartPtr+1;
Start↑[StartPtr]←DictPtr; END;--:45----49:-- GetName: PROCEDURE
=
BEGIN Loc←Loc+1;Level←Level+1;CurChar←32;
WHILE CurChar=32 DO GetNext[] ENDLOOP ;
IF( INT[CurChar]>41)OR ( INT[CurChar]<40) THEN Loc←Loc-1;NameLength←0;
GetLetterOrDigit[];
WHILE CurChar#32 DO BEGIN IF NameLength=20 THEN CurName↑[1]←88 ELSE
NameLength←NameLength+1;CurName↑[NameLength]←CurChar;
GetLetterOrDigit[]; END ENDLOOP ;Lookup[];
IF NamePtr=0 THEN BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "Sorry, I don't know that property name"];ShowErrorContext[]; END;
CurCode←Equiv↑[NamePtr]; END;--:49----51:-- GetByte: PROCEDURE RETURNS[GetByteResult: Byte]
=
BEGIN Acc:PascalInteger;T:AsciiCode; DO GetNext[]; IF CurChar#32 THEN EXIT; ENDLOOP;
T←CurChar;Acc←0;DO GetNext[]; IF CurChar#32 THEN EXIT; ENDLOOP;IF T=67 THEN--52:
IF( INT[CurChar]>=33)AND ( INT[CurChar]<=126)AND (( INT[CurChar]<40)OR ( INT[CurChar]>41)) THEN
Acc←Xord↑[Buffer↑[Loc]] ELSE BEGIN BEGIN IF INT[CharsOnLine]>0 THEN {
PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};PascalWriteLongString[file: @Output, item: "\"C\" value must be standard ASCII and not a paren"];
ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END--:52
ELSE IF T=68 THEN--53:
BEGIN WHILE( INT[CurChar]>=48)AND ( INT[CurChar]<=57)DO BEGIN Acc←Acc*10+CurChar
-48;
IF Acc>255 THEN BEGIN BEGIN BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "This value shouldn't exceed 255"];ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END;Acc←0;
CurChar←32; END ELSE GetNext[]; END ENDLOOP ;
BEGIN IF( INT[CurChar]>41)OR ( INT[CurChar]<40) THEN Loc←Loc-1; END; END--:53
ELSE IF T=79 THEN--54:
BEGIN WHILE( INT[CurChar]>=48)AND ( INT[CurChar]<=55)DO BEGIN Acc←Acc*8+CurChar
-48;
IF Acc>255 THEN BEGIN BEGIN BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "This value shouldn't exceed '377"];ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END;Acc←0;
CurChar←32; END ELSE GetNext[]; END ENDLOOP ;
BEGIN IF( INT[CurChar]>41)OR ( INT[CurChar]<40) THEN Loc←Loc-1; END; END--:54
ELSE IF T=72 THEN--55:
BEGIN WHILE(( INT[CurChar]>=48)AND ( INT[CurChar]<=57))OR (( INT[CurChar]>=65)AND (
INT[CurChar]<=70))DO BEGIN IF INT[CurChar]>=65 THEN CurChar←CurChar-7;
Acc←Acc*16+CurChar-48;
IF Acc>255 THEN BEGIN BEGIN BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "This value shouldn't exceed \"FF"];ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END;Acc←0;
CurChar←32; END ELSE GetNext[]; END ENDLOOP ;
BEGIN IF( INT[CurChar]>41)OR ( INT[CurChar]<40) THEN Loc←Loc-1; END; END--:55
ELSE IF T=70 THEN--56:
BEGIN IF CurChar=66 THEN Acc←2 ELSE IF CurChar=76 THEN Acc←4 ELSE IF
CurChar#77 THEN Acc←18;GetNext[];
IF CurChar=73 THEN Acc←Acc+1 ELSE IF CurChar#82 THEN Acc←18;
GetNext[];
IF CurChar=67 THEN Acc←Acc+6 ELSE IF CurChar=69 THEN Acc←Acc+12 ELSE
IF CurChar#82 THEN Acc←18;
IF Acc>=18 THEN BEGIN BEGIN BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "Illegal face code, I changed it to MRR"];ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END;Acc←0; END;
END--:56-- ELSE BEGIN BEGIN IF INT[CharsOnLine]>0 THEN {PascalWriteLongString[file: @Output, item: " "]; PascalWriteLn[file: @Output]};
PascalWriteLongString[file: @Output, item: "You need \"C\" or \"D\" or \"O\" or \"H\" or \"F\" here"];
ShowErrorContext[]; END;
DO GetNext []; IF(CurChar=40)OR (CurChar=41) THEN EXIT; ENDLOOP; END;CurChar←32;
GetByteResult←Acc; END;--:51----59:--
END.