-- file: WeavePhaseIII.mesa
-- Pascal-to-Mesa translator output, translated at September 23, 1986 1:27:38 pm PDT
DIRECTORY
PascalBasic,
PascalWizardFiles,
WeaveProcs,
WeaveVars,
WeaveProcArray;
WeavePhaseIII: PROGRAM IMPORTS PascalBasic, PascalWizardFiles, WeaveProcs, WeaveVars, WeaveProcArray EXPORTS WeaveProcs = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, WeaveProcs, WeaveVars, WeaveProcArray;
Unbucket: PROCEDURE[D: EightBits] =
BEGIN C:AsciiCode;
FOR i:INT DECREASING IN [ INT[0 ].. INT[100 ]] DO C ← i; IF INT[Bucket↑[Collate↑[C]]]>0 THEN BEGIN IF
INT[ScrapPtr]>MaxScraps THEN BEGIN PascalWriteLn[file: @TermOut];
{PascalWriteLongString[file: @TermOut, item: "! Sorry, "]; PascalWriteLongString[file: @TermOut, item: "sorting"]; PascalWriteLongString[file: @TermOut, item: " capacity exceeded"]};Error[];
History←3;JumpOut[]; END;ScrapPtr←ScrapPtr+1;
--IF SCRAP←PTR>MAX←SORT←PTR THEN MAX←SORT←PTR:=SCRAP←PTR;
IF C=0 THEN Cat↑[ScrapPtr]←255 ELSE Cat↑[ScrapPtr]←D;
Trans↑[ScrapPtr]←Bucket↑[Collate↑[C]];Bucket↑[Collate↑[C]]←0; END ENDLOOP; END;
--:250----257:-- ModPrint: PROCEDURE[P: NamePointer]
=
BEGIN IF INT[P]>0 THEN BEGIN ModPrint[Link↑[P]];
BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←58; END;TokPtr←1;TextPtr←1;
ScrapPtr←0;StackPtr←0;CurState.ModeField←1;
TokMem↑[TokPtr]←P+30720;TokPtr←TokPtr+1;MakeOutput[];Footnote[0];
FinishLine[];ModPrint[Ilk↑[P]]; END; END;--:257----261:----PROCEDURE DEBUG←HELP;
-- LABEL 888,10;VAR K:SIXTEEN←BITS;BEGIN DEBUG←SKIPPED:=DEBUG←SKIPPED+1;
-- IF DEBUG←SKIPPED<DEBUG←CYCLE THEN GOTO 10;DEBUG←SKIPPED:=0;
-- WHILE TRUE DO BEGIN WRITE(TERM←OUT,'#');BREAK(TERM←OUT);
-- READ(TERM←IN,DDT);
-- IF DDT<0 THEN GOTO 10 ELSE IF DDT=0 THEN BEGIN GOTO 888;
-- 888:DDT:=0;
-- END ELSE BEGIN READ(TERM←IN,DD);CASE DDT OF 1:PRINT←ID(DD);
-- 2:PRINT←TEXT(DD);3:FOR K:=1 TO DD DO WRITE(TERM←OUT,XCHR[BUFFER[K]]);
-- 4:FOR K:=1 TO DD DO WRITE(TERM←OUT,XCHR[MOD←TEXT[K]]);
-- 5:FOR K:=1 TO OUT←PTR DO WRITE(TERM←OUT,XCHR[OUT←BUF[K]]);
-- 6:FOR K:=1 TO DD DO BEGIN PRINT←CAT(CAT[K]);WRITE(TERM←OUT,' ');END;
-- OTHERS:WRITE(TERM←OUT,'?')END;END;END;10:END;----:261----262:
PhaseIii: PROCEDURE
=
BEGIN--240:--
PhaseThree←TRUE;BEGIN PascalWriteLn[file: @TermOut];
PascalWriteLongString[file: @TermOut, item: "Writing the index..."]; END;
IF ChangeExists THEN BEGIN FinishLine[];--242:--BEGIN KModule←1;
WHILE NOT ChangedModule↑[KModule]DO KModule←KModule+1 ENDLOOP ;
BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←99;
IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←104;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←32; END;OutMod[KModule];
DO DO KModule←KModule+1 ; IF ChangedModule↑[KModule] THEN EXIT; ENDLOOP;
BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←44;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←32; END;OutMod[KModule];
IF KModule=ModuleCount THEN EXIT; ENDLOOP;BEGIN IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←46; END; END--:242--; END;FinishLine[];
BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←105;
IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←110;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←120; END;FinishLine[];--244:
FOR i:INT IN [ INT[0 ].. INT[127 ]] DO C ← i; Bucket↑[C]←0 ENDLOOP;
FOR i:INT IN [ INT[0 ].. INT[HashSize-1 ]] DO H ← i; NextName←Hash↑[H];
WHILE NextName#0 DO BEGIN CurName←NextName;
NextName←Link↑[CurName];
IF Xref↑[CurName]#0 THEN BEGIN C←ByteMem[ PascalMODPower2Mask[CurName ,1], ByteStart↑
[CurName]]↑;IF( INT[C]<=90)AND ( INT[C]>=65) THEN C←C+32;Blink↑[CurName]←Bucket↑[C];
Bucket↑[C]←CurName; END; END ENDLOOP ;--:244-- ENDLOOP;--251:--ScrapPtr←0;Unbucket[1];
WHILE INT[ScrapPtr]>0 DO BEGIN CurDepth←Cat↑[ScrapPtr];
IF(Blink↑[Trans↑[ScrapPtr]]=0)OR (CurDepth=255) THEN--253:
BEGIN CurName←Trans↑[ScrapPtr];--IF TROUBLE←SHOOTING THEN DEBUG←HELP;
DO BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←58; END;--254:
SELECT Ilk↑[CurName]FROM 0 =>IF INT[ByteStart↑[CurName+2]]-ByteStart↑[CurName]=1
THEN BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←124;
END ELSE BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←92; END;1 => NULL;
2 =>BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←57; END;
3 =>BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←46; END;
ENDCASE =>BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←38; END ;OutName[CurName]--:254
;--255:----256:--ThisXref←Xref↑[CurName];CurXref←0;
DO NextXref←Xmem↑[ThisXref].XlinkField;
Xmem↑[ThisXref].XlinkField←CurXref;CurXref←ThisXref;
ThisXref←NextXref; IF ThisXref=0--:256-- THEN EXIT; ENDLOOP;
DO BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←44;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←32; END;
CurVal←Xmem↑[CurXref].NumField;
IF INT[CurVal]<10240 THEN OutMod[CurVal] ELSE BEGIN BEGIN IF
OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;OutBuf↑[OutPtr]←92;
IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←91; END;OutMod[ INT[CurVal]-10240];
BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←93; END; END;CurXref←Xmem↑[CurXref].XlinkField;
IF CurXref=0 THEN EXIT; ENDLOOP;BEGIN IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←46; END;FinishLine--:255--[];
CurName←Blink↑[CurName]; IF CurName=0 THEN EXIT; ENDLOOP;ScrapPtr←ScrapPtr-1;
END--:253-- ELSE--252:--BEGIN NextName←Trans↑[ScrapPtr];
DO CurName←NextName;NextName←Blink↑[CurName];
CurByte← INT[ByteStart↑[CurName]]+CurDepth;CurBank← PascalMODPower2Mask[CurName ,1];
IF CurByte=ByteStart↑[CurName+2] THEN C←0 ELSE BEGIN C←ByteMem[
CurBank, CurByte]↑;IF( INT[C]<=90)AND ( INT[C]>=65) THEN C←C+32; END;
Blink↑[CurName]←Bucket↑[C];Bucket↑[C]←CurName; IF NextName=0 THEN EXIT; ENDLOOP;
ScrapPtr←ScrapPtr-1;Unbucket[CurDepth+1]; END--:252--; END--:251-- ENDLOOP ;
BEGIN IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←92;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←102;
IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←105;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←110; END;FinishLine[];--258:
ModPrint[Ilk↑[0]]--:258--;BEGIN IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←92;
IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←99;IF OutPtr=LineLength THEN BreakOut[];
OutPtr←OutPtr+1;OutBuf↑[OutPtr]←111;
IF OutPtr=LineLength THEN BreakOut[];OutPtr←OutPtr+1;
OutBuf↑[OutPtr]←110; END;FinishLine[];PascalWriteLongString[file: @TermOut, item: "Done."];--:240-- END;
END.