-- file: WeaveId.mesa
-- Pascal-to-Mesa translator output, translated at September 15, 1985 4:11:16 pm PDT
DIRECTORY
PascalBasic,
PascalWizardFiles,
WeaveProcs,
WeaveProcArray,
WeaveVars;
WeaveId: PROGRAM IMPORTS PascalWizardFiles, WeaveProcs, WeaveProcArray, WeaveVars EXPORTS WeaveProcs = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, WeaveProcs, WeaveProcArray, WeaveVars;
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← P
MOD 2;
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;--:44----51:----:52----59:-- IdLookup: PROCEDURE[T: EightBits] RETURNS[IdLookupResult: NamePointer] =
BEGIN
I:PascalInteger[0..LongBufSize];H:PascalInteger[0..HashSize];K:PascalInteger[0..MaxBytes];W:PascalInteger[0..1];
L:PascalInteger[0..LongBufSize];P:NamePointer; L←IdLoc-IdFirst;--60:
H←Buffer↑[IdFirst];I←IdFirst+1;
WHILE INT[I]<IdLoc DO BEGIN H← (H+H+Buffer↑[I])MOD HashSize;I←I+1; END--:60-- ENDLOOP ;
--61:--P←Hash↑[H];
{WHILE P#0 DO BEGIN IF( INT[ByteStart↑[P+2]]-ByteStart↑[P]=L)AND ((Ilk↑[P]=T)OR (
(T=0)AND ( INT[Ilk↑[P]]>3))) THEN--62:--BEGIN I←IdFirst;K←ByteStart↑[P];
W← P MOD 2;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--:62--;P←Link↑[P]; END ENDLOOP ;P←NamePtr;
Link↑[P]←Hash↑[H];Hash↑[H]←P;EXITS Label31 => NULL};--:61--IF P=NamePtr THEN--63:
BEGIN W← NamePtr MOD 2;
IF INT[BytePtr↑[W]+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+2]>MaxNames 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;K←BytePtr↑[W];
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;Ilk↑[P]←T;
Xref↑[P]←0; END--:63--;IdLookupResult←P; END;--:59----67:
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--69:
BEGIN K←ByteStart↑[P];W← P MOD 2;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--:69--;Q←P;
IF C=0 THEN P←Link↑[Q] ELSE IF C=2 THEN P←Ilk↑[Q] ELSE GOTO Label31; END ENDLOOP ;--68:
W← NamePtr MOD 2;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;Xref↑[P]←0;
C←1;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;--:68--EXITS Label31 => NULL};IF C#1 THEN BEGIN BEGIN IF NOT PhaseOne THEN BEGIN PascalWriteLn[file: @TermOut
];PascalWriteLongString[file: @TermOut, item: "! Incompatible section names"];Error[]; END; END;P←0; END;
ModLookupResult←P; END;--:67----70:
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--69:--BEGIN K←ByteStart↑[P];W← P MOD 2;
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--:69--;
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 IF NOT PhaseOne THEN BEGIN
PascalWriteLn[file: @TermOut];PascalWriteLongString[file: @TermOut, item: "! Name does not match"];Error[]; END;
END ELSE BEGIN IF NOT PhaseOne THEN BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "! Ambiguous prefix"];Error[]; END; END;PrefixLookupResult←R; END;
END.