-- file: TangleId.mesa
-- Pascal-to-Mesa translator output, translated at September 23, 1986 11:39:50 am PDT
DIRECTORY
PascalBasic,
PascalWizardFiles,
TanglePrivate,
TangleProcArray;
TangleId: PROGRAM IMPORTS PascalBasic, PascalWizardFiles, TanglePrivate, TangleProcArray EXPORTS TanglePrivate = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, TanglePrivate, TangleProcArray;
PrintId: PROCEDURE[P: NamePointer] =
BEGIN K:PascalInteger[0..MaxBytes];
W:PascalInteger[0..1];
IF INT[P]>=NamePtr THEN PascalWriteLongString[file: @TermOut, item: "IMPOSSIBLE"] ELSE BEGIN W← PascalMODPower2Mask[P
,1];
FOR i:INT IN [ INT[ByteStart↑[P]].. INT[ INT[ByteStart↑[P+2]]-1 ]] DO K ← i; PascalWriteChar[file: @TermOut, item: Xchr↑[ByteMem
[W, K]↑]] ENDLOOP; END; END;--:49----53:-- IdLookup: PROCEDURE[T: EightBits] RETURNS[IdLookupResult: NamePointer]
=
BEGIN C:EightBits;I:PascalInteger[0..BufSize];H:PascalInteger[0..HashSize];
K:PascalInteger[0..MaxBytes];W:PascalInteger[0..1];L:PascalInteger[0..BufSize];P, Q:NamePointer;
S:PascalInteger[0..UnambigLength]; L←IdLoc-IdFirst;--54:--H←Buffer↑[IdFirst];
I←IdFirst+1;WHILE INT[I]<IdLoc DO BEGIN H← (H+H+Buffer↑[I])MOD HashSize;
I←I+1; END--:54-- ENDLOOP ;--55:--P←Hash↑[H];
{WHILE P#0 DO BEGIN IF INT[ByteStart↑[P+2]]-ByteStart↑[P]=L THEN--56:
BEGIN I←IdFirst;K←ByteStart↑[P];W← PascalMODPower2Mask[P ,1];
WHILE( INT[I]<IdLoc)AND (Buffer↑[I]=ByteMem[W, K]↑)DO BEGIN I←I+1;K←K+1; END ENDLOOP ;
IF I=IdLoc THEN GOTO Label31; END--:56--;P←Link↑[P]; END ENDLOOP ;P←NamePtr;
Link↑[P]←Hash↑[H];Hash↑[H]←P;EXITS Label31 => NULL};--:55--IF(P=NamePtr)OR (T#0) THEN--57:
BEGIN IF((P#NamePtr)AND (T#0)AND (Ilk↑[P]=0))OR ((P=NamePtr)AND (T=0)AND (
Buffer↑[IdFirst]#34)) THEN--58:--BEGIN I←IdFirst;S←0;H←0;
WHILE( INT[I]<IdLoc)AND ( INT[S]<UnambigLength)DO BEGIN BEGIN IF INT[Buffer↑[I]]>=97 THEN
ChoppedId↑[S]←Buffer↑[I]-32 ELSE ChoppedId↑[S]←Buffer↑[I];
H← (H+H+ChoppedId↑[S])MOD HashSize;S←S+1; END;I←I+1; END ENDLOOP ;
ChoppedId↑[S]←0; END--:58--;IF P#NamePtr THEN--59:
BEGIN IF Ilk↑[P]=0 THEN BEGIN BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "! This identifier has already appeared"];Error[]; END;--60:
Q←ChopHash↑[H];
IF Q=P THEN ChopHash↑[H]←Equiv↑[P] ELSE BEGIN WHILE Equiv↑[Q]#P DO Q←
Equiv↑[Q] ENDLOOP ;Equiv↑[Q]←Equiv↑[P]; END--:60--; END ELSE BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "! This identifier was defined before"];Error[]; END;
Ilk↑[P]←T; END--:59-- ELSE--61:
BEGIN IF(T=0)AND (Buffer↑[IdFirst]#34) THEN--62:--BEGIN Q←ChopHash↑[H];
WHILE Q#0 DO BEGIN--63:--BEGIN K←ByteStart↑[Q];S←0;W← PascalMODPower2Mask[Q ,1];
{WHILE( INT[K]<ByteStart↑[Q+2])AND ( INT[S]<UnambigLength)DO BEGIN C←ByteMem[W, K]↑;
BEGIN IF INT[C]>=97 THEN C←C-32;IF ChoppedId↑[S]#C THEN GOTO Label32;S←S+1; END;
K←K+1; END ENDLOOP ;IF(K=ByteStart↑[Q+2])AND (ChoppedId↑[S]#0) THEN GOTO Label32;
BEGIN PascalWriteLn[file: @TermOut];PascalWriteLongString[file: @TermOut, item: "! Identifier conflict with "];
END;
FOR i:INT IN [ INT[ByteStart↑[Q]].. INT[ INT[ByteStart↑[Q+2]]-1 ]] DO K ← i; PascalWriteChar[file: @TermOut, item: Xchr↑[ByteMem
[W, K]↑]] ENDLOOP;Error[];Q←0;EXITS Label32 => NULL}; END--:63--;Q←Equiv↑[Q]; END ENDLOOP ;Equiv↑[P]←ChopHash↑[H];
ChopHash↑[H]←P; END--:62--;W← PascalMODPower2Mask[NamePtr ,1];K←BytePtr↑[W];
IF INT[K+L]>MaxBytes THEN BEGIN PascalWriteLn[file: @TermOut];
{PascalWriteLongString[file: @TermOut, item: "! Sorry, "]; PascalWriteLongString[file: @TermOut, item: "byte memory"]; PascalWriteLongString[file: @TermOut, item: " capacity exceeded"]};Error[];
History←3;JumpOut[]; END;
IF INT[NamePtr]>MaxNames-2 THEN BEGIN PascalWriteLn[file: @TermOut];
{PascalWriteLongString[file: @TermOut, item: "! Sorry, "]; PascalWriteLongString[file: @TermOut, item: "name"]; PascalWriteLongString[file: @TermOut, item: " capacity exceeded"]};Error[];
History←3;JumpOut[]; END;I←IdFirst;
WHILE INT[I]<IdLoc DO BEGIN ByteMem[W, K]↑←Buffer↑[I];K←K+1;I←I+1; END ENDLOOP ;
BytePtr↑[W]←K;ByteStart↑[NamePtr+2]←K;NamePtr←NamePtr+1;
IF Buffer↑[IdFirst]#34 THEN Ilk↑[P]←T ELSE--64:--BEGIN Ilk↑[P]←1;
IF L-DoubleChars=2 THEN Equiv↑[P]←Buffer↑[IdFirst+1]+32768 ELSE BEGIN
Equiv↑[P]←StringPtr+32768;L←L-DoubleChars-1;
IF INT[L]>99 THEN BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "! Preprocessed string is too long"];Error[]; END;
StringPtr←StringPtr+1;
{PascalWriteChar[file: @Pool, item: Xchr↑[ 48+L /10]]; PascalWriteChar[file: @Pool, item: Xchr↑[ 48+L MOD 10]]};
PoolCheckSum←PoolCheckSum+PoolCheckSum+L;
WHILE PoolCheckSum>536870839 DO PoolCheckSum←PoolCheckSum
-536870839 ENDLOOP ;I←IdFirst+1;
WHILE INT[I]<IdLoc DO BEGIN PascalWriteChar[file: @Pool, item: Xchr↑[Buffer↑[I]]];
PoolCheckSum←PoolCheckSum+PoolCheckSum+Buffer↑[I];
WHILE PoolCheckSum>536870839 DO PoolCheckSum←PoolCheckSum
-536870839 ENDLOOP ;IF(Buffer↑[I]=34)OR (Buffer↑[I]=64) THEN I←I+2 ELSE I←I+1; END ENDLOOP ;
PascalWriteLn[file: @Pool]; END; END--:64--; END--:61--; END--:57--;IdLookupResult←P; END;--:53----66:
ModLookup: PROCEDURE[L: SixteenBits] RETURNS[ModLookupResult: NamePointer] =
BEGIN C:PascalInteger[0..4];
J:PascalInteger[0..LongestName];K:PascalInteger[0..MaxBytes];W:PascalInteger[0..1];P:NamePointer;Q:NamePointer;
C←2;Q←0;P←Ilk↑[0];{WHILE P#0 DO BEGIN--68:
BEGIN K←ByteStart↑[P];W← PascalMODPower2Mask[P ,1];C←1;J←1;
WHILE( INT[K]<ByteStart↑[P+2])AND ( INT[J]<=L)AND (ModText↑[J]=ByteMem[W, K]↑)DO BEGIN
K←K+1;J←J+1; END ENDLOOP ;
IF K=ByteStart↑[P+2] THEN IF INT[J]>L THEN C←1 ELSE C←4 ELSE IF INT[J]>L THEN C←
3 ELSE IF INT[ModText↑[J]]<ByteMem[W, K]↑ THEN C←0 ELSE C←2; END--:68--;Q←P;
IF C=0 THEN P←Link↑[Q] ELSE IF C=2 THEN P←Ilk↑[Q] ELSE GOTO Label31; END ENDLOOP ;--67:
W← PascalMODPower2Mask[NamePtr ,1];K←BytePtr↑[W];
IF INT[K]+L>MaxBytes THEN BEGIN PascalWriteLn[file: @TermOut];
{PascalWriteLongString[file: @TermOut, item: "! Sorry, "]; PascalWriteLongString[file: @TermOut, item: "byte memory"]; PascalWriteLongString[file: @TermOut, item: " capacity exceeded"]};Error[];
History←3;JumpOut[]; END;
IF INT[NamePtr]>MaxNames-2 THEN BEGIN PascalWriteLn[file: @TermOut];
{PascalWriteLongString[file: @TermOut, item: "! Sorry, "]; PascalWriteLongString[file: @TermOut, item: "name"]; PascalWriteLongString[file: @TermOut, item: " capacity exceeded"]};Error[];
History←3;JumpOut[]; END;P←NamePtr;
IF C=0 THEN Link↑[Q]←P ELSE Ilk↑[Q]←P;Link↑[P]←0;Ilk↑[P]←0;C←1;
Equiv↑[P]←0;FOR i:INT IN [ INT[1 ].. INT[L ]] DO J ← i; ByteMem[W, INT[K+J]-1]↑←ModText↑[J] ENDLOOP;
BytePtr↑[W]← INT[K]+L;ByteStart↑[NamePtr+2]← INT[K]+L;NamePtr←NamePtr+1;--:67--EXITS Label31 => NULL};IF C#1 THEN BEGIN BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "! Incompatible section names"];Error[]; END;P←0; END;
ModLookupResult←P; END;--:66----69:
PrefixLookup: PROCEDURE[L: SixteenBits] RETURNS[PrefixLookupResult: NamePointer] =
BEGIN C:PascalInteger[0..4];
Count:PascalInteger[0..MaxNames];J:PascalInteger[0..LongestName];K:PascalInteger[0..MaxBytes];W:PascalInteger[0..1];
P:NamePointer;Q:NamePointer;R:NamePointer; Q←0;P←Ilk↑[0];
Count←0;R←0;WHILE P#0 DO BEGIN--68:--BEGIN K←ByteStart↑[P];W← PascalMODPower2Mask[P ,1];
C←1;J←1;
WHILE( INT[K]<ByteStart↑[P+2])AND ( INT[J]<=L)AND (ModText↑[J]=ByteMem[W, K]↑)DO BEGIN
K←K+1;J←J+1; END ENDLOOP ;
IF K=ByteStart↑[P+2] THEN IF INT[J]>L THEN C←1 ELSE C←4 ELSE IF INT[J]>L THEN C←
3 ELSE IF INT[ModText↑[J]]<ByteMem[W, K]↑ THEN C←0 ELSE C←2; END--:68--;
IF C=0 THEN P←Link↑[P] ELSE IF C=2 THEN P←Ilk↑[P] ELSE BEGIN R←P;
Count←Count+1;Q←Ilk↑[P];P←Link↑[P]; END;IF P=0 THEN BEGIN P←Q;Q←0; END;
END ENDLOOP ;IF Count#1 THEN IF Count=0 THEN BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "! Name does not match"];Error[];
END ELSE BEGIN PascalWriteLn[file: @TermOut];PascalWriteLongString[file: @TermOut, item: "! Ambiguous prefix"];
Error[]; END;PrefixLookupResult←R; END;--:69----73:
StoreTwoBytes: PROCEDURE[X: SixteenBits]
=
BEGIN IF INT[TokPtr↑[Z]+2]>MaxToks THEN BEGIN PascalWriteLn[file: @TermOut];
{PascalWriteLongString[file: @TermOut, item: "! Sorry, "]; PascalWriteLongString[file: @TermOut, item: "token"]; PascalWriteLongString[file: @TermOut, item: " capacity exceeded"]};Error[];
History←3;JumpOut[]; END;TokMem[Z, TokPtr↑[Z]]↑← PascalDIVPower2[X ,8];
TokMem[Z, TokPtr↑[Z]+1]↑← PascalMODPower2Mask[X ,255];TokPtr↑[Z]←TokPtr↑[Z]+2; END;--:73
END.