-- file: MFSymbolsImpl2.mesa
-- Pascal-to-Mesa translator output, translated at October 31, 1985 4:28:01 pm PST
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFProcArray,
MFInteraction,
MFMemory,
MFSymbols,
MFInput,
MFParsing;
MFSymbolsImpl2: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFMemory, MFSymbols, MFInput, MFParsing EXPORTS MFSymbols = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFMemory, MFSymbols, MFInput, MFParsing;
ShowMacro: PROCEDURE[P: Halfword,Q,L: PascalInteger] =
BEGIN
R:Halfword; P←Mem[P]↑.Hh.Rh;
{WHILE INT[Mem[P]↑.Hh.Lh]>7 DO BEGIN R←Mem[P]↑.Hh.Rh;Mem[P]↑.Hh.Rh←0;
ShowTokenList[P,0,L,0];Mem[P]↑.Hh.Rh←R;P←R;
IF L>0 THEN L←L-Tally ELSE GOTO Label10; END ENDLOOP ;Tally←0;
SELECT Mem[P]↑.Hh.Lh FROM 0 =>Print[369];1,2,3 =>BEGIN PrintChar[60];
PrintCmdMod[56,Mem[P]↑.Hh.Lh];Print[370]; END;4 =>Print[371];5 =>Print[372];
6 =>Print[373];7 =>Print[374]; ENDCASE;ShowTokenList[Mem[P]↑.Hh.Rh,Q,L-Tally,0];
EXITS Label10 => NULL}; END;--:227----232:-- InitBigNode: PROCEDURE[P: Halfword] =
BEGIN Q:Halfword;
S:SmallNumber; S←BigNodeSize↑[Mem[P]↑.Hh.B0];Q←GetNode[S];
DO S←S-2;Mem[ INT[Q]+S]↑.Hh.B0←19;Mem[ INT[Q]+S+1]↑.Int←0;
Mem[ INT[Q]+S]↑.Hh.B1← PascalDIVPower2[(S),1]+5;Mem[ INT[Q]+S]↑.Hh.Rh←0; IF S=0 THEN EXIT; ENDLOOP;Mem[Q]↑.Hh.Rh←P;
Mem[ INT[P]+1]↑.Int←Q; END;--:232----233:-- IdTransform: PROCEDURE RETURNS[IdTransformResult: Halfword]
=
BEGIN P, Q, R:Halfword; P←GetNode[2];Mem[P]↑.Hh.B0←13;
Mem[P]↑.Hh.B1←11;Mem[ INT[P]+1]↑.Int←0;InitBigNode[P];Q←Mem[ INT[P]+1]↑.Int;
R← INT[Q]+12;DO R← INT[R]-2;Mem[R]↑.Hh.B0←16;Mem[ INT[R]+1]↑.Int←0; IF R=Q THEN EXIT; ENDLOOP;
Mem[ INT[Q]+5]↑.Int←65536;Mem[ INT[Q]+11]↑.Int←65536;IdTransformResult←P; END;--:233
--234:-- NewRoot: PROCEDURE[X: Halfword] =
BEGIN P:Halfword;
P←GetNode[2];Mem[P]↑.Hh.B0←0;Mem[P]↑.Hh.B1←0;Mem[P]↑.Hh.Rh←X;
Eqtb↑[X].Rh←P; END;--:234----235:-- PrintVariableName: PROCEDURE[P: Halfword]
=
BEGIN Q:Halfword;R:Halfword;
{WHILE INT[Mem[P]↑.Hh.B1]>=5 DO--237:
BEGIN SELECT Mem[P]↑.Hh.B1 FROM 5 =>PrintChar[120];6 =>PrintChar[121];
7 =>Print[377];8 =>Print[378];9 =>Print[379];10 =>Print[380];
11 =>BEGIN Print[381];PrintInt[P-0]; GOTO Label10; END; ENDCASE;Print[382];
P←Mem[ INT[P]-2*(Mem[P]↑.Hh.B1-5)]↑.Hh.Rh; END--:237-- ENDLOOP ;Q←0;
WHILE INT[Mem[P]↑.Hh.B1]>1 DO--236:
BEGIN {IF Mem[P]↑.Hh.B1=3 THEN BEGIN R←NewNumTok[Mem[ INT[P]+2]↑.Int];
DO P←Mem[P]↑.Hh.Rh; IF Mem[P]↑.Hh.B1=4 THEN EXIT; ENDLOOP;
END ELSE IF Mem[P]↑.Hh.B1=2 THEN BEGIN P←Mem[P]↑.Hh.Rh; GOTO Label40;
END ELSE BEGIN IF Mem[P]↑.Hh.B1#4 THEN Confusion[376];R←GetAvail[];
Mem[R]↑.Hh.Lh←Mem[ INT[P]+2]↑.Hh.Lh; END;Mem[R]↑.Hh.Rh←Q;Q←R;
EXITS Label40 => NULL};P←Mem[ INT[P]+2]↑.Hh.Rh; END--:236-- ENDLOOP ;R←GetAvail[];Mem[R]↑.Hh.Lh←Mem[P]↑.Hh.Rh;
Mem[R]↑.Hh.Rh←Q;IF Mem[P]↑.Hh.B1=1 THEN Print[375];
ShowTokenList[R,0,2147483647,Tally];FlushTokenList[R];EXITS Label10 => NULL}; END;--:235
--238:-- Interesting: PROCEDURE[P: Halfword] RETURNS[InterestingResult: PascalBoolean] =
BEGIN T:SmallNumber;
IF Internal↑[3]>0 THEN InterestingResult←TRUE ELSE BEGIN T←Mem[P]↑.Hh.B1
;IF INT[T]>=5 THEN IF T#11 THEN T←Mem[Mem[ INT[P]-2*(T-5)]↑.Hh.Rh]↑.Hh.B1;
InterestingResult←(T#11); END; END;--:238----239:
NewStructure: PROCEDURE[P: Halfword] RETURNS[NewStructureResult: Halfword] =
BEGIN Q, R:Halfword;
SELECT Mem[P]↑.Hh.B1 FROM 0 =>BEGIN Q←Mem[P]↑.Hh.Rh;R←GetNode[2];
Eqtb↑[Q].Rh←R; END;3 =>--240:--BEGIN Q←P;DO Q←Mem[Q]↑.Hh.Rh;
IF Mem[Q]↑.Hh.B1=4 THEN EXIT; ENDLOOP;Q←Mem[ INT[Q]+2]↑.Hh.Rh;R← INT[Q]+1;DO Q←R;
R←Mem[R]↑.Hh.Rh; IF R=P THEN EXIT; ENDLOOP;R←GetNode[3];Mem[Q]↑.Hh.Rh←R;
Mem[ INT[R]+2]↑.Int←Mem[ INT[P]+2]↑.Int; END--:240--;4 =>--241:--BEGIN Q←Mem[ INT[P]+2]↑.Hh.Rh;
R←Mem[ INT[Q]+1]↑.Hh.Lh;DO Q←R;R←Mem[R]↑.Hh.Rh; IF R=P THEN EXIT; ENDLOOP;R←GetNode[3];
Mem[Q]↑.Hh.Rh←R;Mem[ INT[R]+2]↑←Mem[ INT[P]+2]↑;
IF Mem[ INT[P]+2]↑.Hh.Lh=0 THEN BEGIN Q← INT[Mem[ INT[P]+2]↑.Hh.Rh]+1;
WHILE Mem[Q]↑.Hh.Rh#P DO Q←Mem[Q]↑.Hh.Rh ENDLOOP ;Mem[Q]↑.Hh.Rh←R; END; END--:241--;
ENDCASE =>Confusion[383];Mem[R]↑.Hh.Rh←Mem[P]↑.Hh.Rh;Mem[R]↑.Hh.B0←21;
Mem[R]↑.Hh.B1←Mem[P]↑.Hh.B1;Mem[ INT[R]+1]↑.Hh.Lh←P;Mem[P]↑.Hh.B1←2;
Q←GetNode[3];Mem[P]↑.Hh.Rh←Q;Mem[ INT[R]+1]↑.Hh.Rh←Q;Mem[ INT[Q]+2]↑.Hh.Rh←R;
Mem[Q]↑.Hh.B0←0;Mem[Q]↑.Hh.B1←4;Mem[Q]↑.Hh.Rh←17;Mem[ INT[Q]+2]↑.Hh.Lh←0;
NewStructureResult←R; END;--:239----242:
FindVariable: PROCEDURE[T: Halfword] RETURNS[FindVariableResult: Halfword] =
BEGIN
P, Q, R, S:Halfword;Pp, Qq, Rr, Ss:Halfword;N:PascalInteger;
SaveWord:MemoryWord; P←Mem[T]↑.Hh.Lh;T←Mem[T]↑.Hh.Rh;
{IF Eqtb↑[P].Lh MOD 83#41 THEN BEGIN FindVariableResult←0; GOTO Label10; END;
IF Eqtb↑[P].Rh=0 THEN NewRoot[P];P←Eqtb↑[P].Rh;Pp←P;
WHILE T#0 DO BEGIN--243:
IF Mem[Pp]↑.Hh.B0#21 THEN BEGIN IF INT[Mem[Pp]↑.Hh.B0]>21 THEN BEGIN
FindVariableResult←0; GOTO Label10; END;Ss←NewStructure[Pp];IF P=Pp THEN P←Ss;
Pp←Ss; END;IF Mem[P]↑.Hh.B0#21 THEN P←NewStructure[P]--:243--;
IF INT[T]<HiMemMin THEN--244:--BEGIN N←Mem[ INT[T]+1]↑.Int;
Pp←Mem[Mem[ INT[Pp]+1]↑.Hh.Lh]↑.Hh.Rh;Q←Mem[Mem[ INT[P]+1]↑.Hh.Lh]↑.Hh.Rh;
SaveWord←Mem[ INT[Q]+2]↑;Mem[ INT[Q]+2]↑.Int←2147483647;S← INT[P]+1;DO R←S;
S←Mem[S]↑.Hh.Rh; IF N<=Mem[ INT[S]+2]↑.Int THEN EXIT; ENDLOOP;
IF N=Mem[ INT[S]+2]↑.Int THEN P←S ELSE BEGIN P←GetNode[3];Mem[R]↑.Hh.Rh←P;
Mem[P]↑.Hh.Rh←S;Mem[ INT[P]+2]↑.Int←N;Mem[P]↑.Hh.B1←3;Mem[P]↑.Hh.B0←0; END;
Mem[ INT[Q]+2]↑←SaveWord; END--:244-- ELSE--245:--BEGIN N←Mem[T]↑.Hh.Lh;
Ss←Mem[ INT[Pp]+1]↑.Hh.Lh;DO Rr←Ss;Ss←Mem[Ss]↑.Hh.Rh;
IF N<=Mem[ INT[Ss]+2]↑.Hh.Lh THEN EXIT; ENDLOOP;
IF N<Mem[ INT[Ss]+2]↑.Hh.Lh THEN BEGIN Qq←GetNode[3];Mem[Rr]↑.Hh.Rh←Qq;
Mem[Qq]↑.Hh.Rh←Ss;Mem[ INT[Qq]+2]↑.Hh.Lh←N;Mem[Qq]↑.Hh.B1←4;Mem[Qq]↑.Hh.B0←0;
Mem[ INT[Qq]+2]↑.Hh.Rh←Pp;Ss←Qq; END;IF P=Pp THEN BEGIN P←Ss;Pp←Ss;
END ELSE BEGIN Pp←Ss;S←Mem[ INT[P]+1]↑.Hh.Lh;DO R←S;S←Mem[S]↑.Hh.Rh;
IF N<=Mem[ INT[S]+2]↑.Hh.Lh THEN EXIT; ENDLOOP;
IF N=Mem[ INT[S]+2]↑.Hh.Lh THEN P←S ELSE BEGIN Q←GetNode[3];Mem[R]↑.Hh.Rh←Q;
Mem[Q]↑.Hh.Rh←S;Mem[ INT[Q]+2]↑.Hh.Lh←N;Mem[Q]↑.Hh.B1←4;Mem[Q]↑.Hh.B0←0;
Mem[ INT[Q]+2]↑.Hh.Rh←P;P←Q; END; END; END--:245--;T←Mem[T]↑.Hh.Rh; END ENDLOOP ;
IF INT[Mem[Pp]↑.Hh.B0]>=21 THEN IF Mem[Pp]↑.Hh.B0=21 THEN Pp←Mem[ INT[Pp]+1]↑.Hh.Lh
ELSE BEGIN FindVariableResult←0; GOTO Label10; END;
IF Mem[P]↑.Hh.B0=21 THEN P←Mem[ INT[P]+1]↑.Hh.Lh;
IF Mem[P]↑.Hh.B0=0 THEN BEGIN IF Mem[Pp]↑.Hh.B0=0 THEN BEGIN Mem[Pp]↑.Hh.B0
←15;Mem[ INT[Pp]+1]↑.Int←0; END;Mem[P]↑.Hh.B0←Mem[Pp]↑.Hh.B0;Mem[ INT[P]+1]↑.Int←0;
END;FindVariableResult←P;EXITS Label10 => NULL}; END;--:242----246:----257:
FlushBelowVariable: PROCEDURE[P: Halfword] =
BEGIN Q, R:Halfword;
IF Mem[P]↑.Hh.B0#21 THEN RecycleValue[P] ELSE BEGIN Q←Mem[ INT[P]+1]↑.Hh
.Rh;WHILE Mem[Q]↑.Hh.B1=3 DO BEGIN FlushBelowVariable[Q];R←Q;
Q←Mem[Q]↑.Hh.Rh;FreeNode[R,3]; END ENDLOOP ;R←Mem[ INT[P]+1]↑.Hh.Lh;Q←Mem[R]↑.Hh.Rh;
RecycleValue[R];
IF INT[Mem[P]↑.Hh.B1]<=1 THEN FreeNode[R,2] ELSE FreeNode[R,3];
DO FlushBelowVariable[Q];R←Q;Q←Mem[Q]↑.Hh.Rh;FreeNode[R,3];
IF Q=17 THEN EXIT; ENDLOOP;Mem[P]↑.Hh.B0←0; END; END;--:247
FlushVariable: PROCEDURE[P,T: Halfword,DiscardSuffixes: PascalBoolean]
=
BEGIN Q, R:Halfword;N:Halfword;
{WHILE T#0 DO BEGIN IF Mem[P]↑.Hh.B0#21 THEN GOTO Label10;
N←Mem[T]↑.Hh.Lh;T←Mem[T]↑.Hh.Rh;IF N=0 THEN BEGIN R← INT[P]+1;
Q←Mem[R]↑.Hh.Rh;
WHILE Mem[Q]↑.Hh.B1=3 DO BEGIN FlushVariable[Q,T,DiscardSuffixes];
IF T=0 THEN IF Mem[Q]↑.Hh.B0=21 THEN R←Q ELSE BEGIN Mem[R]↑.Hh.Rh←Mem[Q]↑
.Hh.Rh;FreeNode[Q,3]; END ELSE R←Q;Q←Mem[R]↑.Hh.Rh; END ENDLOOP ; END;
P←Mem[ INT[P]+1]↑.Hh.Lh;DO R←P;P←Mem[P]↑.Hh.Rh; IF INT[Mem[ INT[P]+2]↑.Hh.Lh]>=N THEN EXIT; ENDLOOP;
IF Mem[ INT[P]+2]↑.Hh.Lh#N THEN GOTO Label10; END ENDLOOP ;
IF DiscardSuffixes THEN FlushBelowVariable[P] ELSE BEGIN IF Mem[P]↑.Hh.
B0=21 THEN P←Mem[ INT[P]+1]↑.Hh.Lh;RecycleValue[P]; END;EXITS Label10 => NULL}; END;--:246----248:
UndType: PROCEDURE[P: Halfword] RETURNS[UndTypeResult: SmallNumber]
=
BEGIN SELECT Mem[P]↑.Hh.B0 FROM 0,1 =>UndTypeResult←0;2,3 =>UndTypeResult←3;
4,5 =>UndTypeResult←5;6,7,8 =>UndTypeResult←7;9,10 =>UndTypeResult←10;11,12 =>UndTypeResult←12;
13,14,15 =>UndTypeResult←Mem[P]↑.Hh.B0;16,17,18,19 =>UndTypeResult←15; ENDCASE; END;--:248
--249:-- ClearSymbol: PROCEDURE[P: Halfword,Saving: PascalBoolean] =
BEGIN Q:Halfword;
Q←Eqtb↑[P].Rh;
SELECT Eqtb↑[P].Lh MOD 83 FROM 10,53,44,49 =>IF NOT Saving THEN DeleteMacRef[
Q];41 =>IF Q#0 THEN IF Saving THEN Mem[Q]↑.Hh.B1←1 ELSE BEGIN
FlushBelowVariable[Q];FreeNode[Q,2]; END; ENDCASE => NULL;
Eqtb↑[P]←Eqtb↑[2241]; END;--:249----252:-- SaveVariable: PROCEDURE[Q: Halfword]
=
BEGIN P:Halfword; IF SavePtr#0 THEN BEGIN P←GetNode[2];
Mem[P]↑.Hh.Lh←Q;Mem[P]↑.Hh.Rh←SavePtr;Mem[ INT[P]+1]↑.Hh←Eqtb↑[Q];SavePtr←P;
END;ClearSymbol[Q,(SavePtr#0)]; END;--:252----253:
SaveInternal: PROCEDURE[Q: Halfword] =
BEGIN P:Halfword;
IF SavePtr#0 THEN BEGIN P←GetNode[2];Mem[P]↑.Hh.Lh← INT[2241]+Q;
Mem[P]↑.Hh.Rh←SavePtr;Mem[ INT[P]+1]↑.Int←Internal↑[Q];SavePtr←P; END; END;
--:253----254:-- Unsave: PROCEDURE =
BEGIN Q:Halfword;P:Halfword;
WHILE Mem[SavePtr]↑.Hh.Lh#0 DO BEGIN Q←Mem[SavePtr]↑.Hh.Lh;
IF INT[Q]>2241 THEN BEGIN IF Internal↑[8]>0 THEN BEGIN BeginDiagnostic[];
PrintNl[384];Print[IntName↑[Q-(2241)]];PrintChar[61];
PrintScaled[Mem[ INT[SavePtr]+1]↑.Int];PrintChar[125];EndDiagnostic[FALSE];
END;Internal↑[Q-(2241)]←Mem[ INT[SavePtr]+1]↑.Int;
END ELSE BEGIN IF Internal↑[8]>0 THEN BEGIN BeginDiagnostic[];
PrintNl[384];Print[Hash↑[Q].Rh];PrintChar[125];EndDiagnostic[FALSE];
END;ClearSymbol[Q,FALSE];Eqtb↑[Q]←Mem[ INT[SavePtr]+1]↑.Hh;
IF Eqtb↑[Q].Lh MOD 83=41 THEN BEGIN P←Eqtb↑[Q].Rh;
IF P#0 THEN Mem[P]↑.Hh.B1←0; END; END;P←Mem[SavePtr]↑.Hh.Rh;
FreeNode[SavePtr,2];SavePtr←P; END ENDLOOP ;P←Mem[SavePtr]↑.Hh.Rh;
BEGIN Mem[SavePtr]↑.Hh.Rh←Avail;Avail←SavePtr;DynUsed←DynUsed-1;
END;SavePtr←P; END;--:254----264:-- ShowCmdMod: PROCEDURE[C,M: PascalInteger] =
BEGIN BeginDiagnostic[];
PrintNl[123];PrintCmdMod[C,M];PrintChar[125];EndDiagnostic[FALSE];
END;--:625----634:--
ShowContext: PROCEDURE =
BEGIN OldSetting:PascalInteger[0..5];
--640:--I:PascalInteger[0..BufSize];L:PascalInteger;M:PascalInteger;N:PascalInteger[0..ErrorLine];P:PascalInteger;
Q:PascalInteger;--:640-- FilePtr←InputPtr;
InputStack↑[FilePtr]←CurInput;
{WHILE TRUE DO BEGIN CurInput←InputStack↑[FilePtr];--635:
IF(FilePtr=InputPtr)OR ( INT[CurInput.IndexField]<=6)OR (CurInput.
IndexField#10)OR (CurInput.LocField#0) THEN BEGIN Tally←0;
OldSetting←Selector;IF( INT[CurInput.IndexField]<=6) THEN BEGIN--636:
IF INT[CurInput.NameField]<=1 THEN IF(CurInput.NameField=0)AND (FilePtr=0
) THEN PrintNl[470] ELSE PrintNl[471] ELSE IF CurInput.NameField=2 THEN
PrintNl[472] ELSE BEGIN PrintNl[473];
PrintInt[Line+( INT[CurInput.LocField]-CurInput.StartField)]; END;
PrintChar[32]--:636--;--643:--BEGIN L←Tally;Tally←0;Selector←4;
TrickCount←1000000; END;
IF INT[CurInput.LimitField]>0 THEN FOR i:INT
IN [ INT[CurInput.StartField ].. INT[ INT[CurInput.LimitField]-1 ]] DO I ← i; IF I=CurInput.LocField THEN BEGIN
FirstCount←Tally;TrickCount←Tally+1+ErrorLine-HalfErrorLine;
IF TrickCount<ErrorLine THEN TrickCount←ErrorLine; END;
Print[Buffer↑[I]];--:643-- ENDLOOP; END ELSE BEGIN--637:
SELECT CurInput.IndexField FROM 7 =>PrintNl[474];8 =>--638:
BEGIN PrintNl[479];P←ParamStack↑[CurInput.LimitField];
IF P#0 THEN IF Mem[P]↑.Hh.Rh=1 THEN PrintExp[P,0] ELSE ShowTokenList[P
,0,20,Tally];Print[480]; END--:638--;9 =>PrintNl[475];
10 =>IF CurInput.LocField=0 THEN PrintNl[476] ELSE PrintNl[477];
11 =>PrintNl[478];12 =>BEGIN PrintLn[];
IF CurInput.NameField#0 THEN Print[Hash↑[CurInput.NameField].Rh] ELSE
--639:--BEGIN P←ParamStack↑[CurInput.LimitField];
IF P=0 THEN ShowTokenList[ParamStack↑[ INT[CurInput.LimitField]+1],0,20,
Tally] ELSE BEGIN Q←P;WHILE Mem[Q]↑.Hh.Rh#0 DO Q←Mem[Q]↑.Hh.Rh ENDLOOP ;
Mem[Q]↑.Hh.Rh←ParamStack↑[ INT[CurInput.LimitField]+1];
ShowTokenList[P,0,20,Tally];Mem[Q]↑.Hh.Rh←0; END; END--:639--;Print[369];
END; ENDCASE =>PrintNl[63]--:637--;--644:--BEGIN L←Tally;Tally←0;
Selector←4;TrickCount←1000000; END;
IF CurInput.IndexField#12 THEN ShowTokenList[CurInput.StartField,
CurInput.LocField,100000,0] ELSE ShowMacro[CurInput.StartField,
CurInput.LocField,100000]--:644--; END;Selector←OldSetting;--642:
IF TrickCount=1000000 THEN BEGIN FirstCount←Tally;
TrickCount←Tally+1+ErrorLine-HalfErrorLine;
IF TrickCount<ErrorLine THEN TrickCount←ErrorLine; END;
IF Tally<TrickCount THEN M←Tally-FirstCount ELSE M←
TrickCount-FirstCount;IF L+FirstCount<=HalfErrorLine THEN BEGIN P←0;
N←L+FirstCount; END ELSE BEGIN Print[148];
P←L+FirstCount-HalfErrorLine+3;N←HalfErrorLine; END;
FOR i:INT IN [ INT[P ].. INT[FirstCount-1 ]] DO Q ← i; PrintChar[TrickBuf↑[ PascalMODPower2Mask[Q ,63]]] ENDLOOP;
PrintLn[];FOR i:INT IN [ INT[1 ].. INT[N ]] DO Q ← i; PrintChar[32] ENDLOOP;
IF M+N<=ErrorLine THEN P←FirstCount+M ELSE P←FirstCount+(ErrorLine
-N-3);
FOR i:INT IN [ INT[FirstCount ].. INT[P-1 ]] DO Q ← i; PrintChar[TrickBuf↑[ PascalMODPower2Mask[Q ,63]]] ENDLOOP;
IF M+N>ErrorLine THEN Print[148]--:642--; END--:635--;
IF( INT[CurInput.IndexField]<=6) THEN IF( INT[CurInput.NameField]>2)OR (FilePtr=0
) THEN GOTO Label30;FilePtr←FilePtr-1; END ENDLOOP ;
EXITS Label30 => NULL};CurInput←InputStack↑[InputPtr]; END;--:634----648:
END.