-- file: TangleProduce.mesa -- Pascal-to-Mesa translator output, translated at September 14, 1985 3:58:20 pm PDT DIRECTORY PascalBasic, PascalWizardFiles, TanglePrivate; TangleProduce: PROGRAM IMPORTS PascalWizardFiles, TanglePrivate EXPORTS TanglePrivate = PUBLIC BEGIN OPEN PascalBasic, PascalWizardFiles, TanglePrivate; FlushBuffer: PROCEDURE = BEGIN K:PascalInteger[0..OutBufSize];B:PascalInteger[0..OutBufSize]; B←BreakPtr; IF(SemiPtr#0)AND ( INT[OutPtr-SemiPtr]<=LineLength) THEN BreakPtr← SemiPtr;FOR i:INT IN [ INT[1 ].. INT[BreakPtr ]] DO K ← i; PascalWriteChar[file: @PascalFile, item: Xchr↑[OutBuf↑[K-1]]] ENDLOOP; PascalWriteLn[file: @PascalFile];Line←Line+1; IF Line MOD 100=0 THEN BEGIN PascalWriteLongString[file: @TermOut, item: "."]; IF Line MOD 500=0 THEN PascalWriteInteger[file: @TermOut, item: Line, fieldMinLength: 1];PascalTextBREAK[file: @TermOut]; END; IF INT[BreakPtr]<OutPtr THEN BEGIN IF OutBuf↑[BreakPtr]=32 THEN BEGIN BreakPtr←BreakPtr+1;IF INT[BreakPtr]>B THEN B←BreakPtr; END; FOR i:INT IN [ INT[BreakPtr ].. INT[OutPtr-1 ]] DO K ← i; OutBuf↑[K-BreakPtr]←OutBuf↑[K] ENDLOOP; END; OutPtr←OutPtr-BreakPtr;BreakPtr←B-BreakPtr;SemiPtr←0; IF INT[OutPtr]>LineLength THEN BEGIN BEGIN PascalWriteLn[file: @TermOut]; PascalWriteLongString[file: @TermOut, item: "! Long line must be truncated"];Error[]; END; OutPtr←LineLength; END; END;--:97----99:-- AppVal: PROCEDURE[V: PascalInteger] = BEGIN K:PascalInteger[0..OutBufSize]; K←OutBufSize;DO OutBuf↑[K]← V MOD 10; V← V /10;K←K-1; IF V=0 THEN EXIT; ENDLOOP;DO K←K+1; BEGIN OutBuf↑[OutPtr]←OutBuf↑[K]+48;OutPtr←OutPtr+1; END; IF K=OutBufSize THEN EXIT; ENDLOOP; END;--:99----101:-- SendOut: PROCEDURE[T: EightBits, V: SixteenBits] = BEGIN K:PascalInteger[0..LineLength];--102: DO {--Label20:--SELECT OutState FROM 1 =>IF T#3 THEN BEGIN BreakPtr←OutPtr; IF T=2 THEN BEGIN OutBuf↑[OutPtr]←32;OutPtr←OutPtr+1; END; END; 2 =>BEGIN BEGIN OutBuf↑[OutPtr]←44-OutApp;OutPtr←OutPtr+1; END; IF INT[OutPtr]>LineLength THEN FlushBuffer[];BreakPtr←OutPtr; END; 3,4 =>BEGIN--103: IF(OutVal<0)OR ((OutVal=0)AND ( INT[LastSign]<0)) THEN BEGIN OutBuf↑[OutPtr] ←45;OutPtr←OutPtr+1; END ELSE IF INT[OutSign]>0 THEN BEGIN OutBuf↑[OutPtr]←OutSign; OutPtr←OutPtr+1; END;AppVal[ABS[OutVal]]; IF INT[OutPtr]>LineLength THEN FlushBuffer[];--:103--OutState←OutState-2; GOTO Label20; END;5 =>--104:--BEGIN IF(T=3)OR (--105: ((T=2)AND (V=3)AND (((OutContrib↑[1]=68)AND (OutContrib↑[2]=73)AND ( OutContrib↑[3]=86))OR ((OutContrib↑[1]=77)AND (OutContrib↑[2]=79)AND ( OutContrib↑[3]=68))))OR ((T=0)AND ((V=42)OR (V=47)))--:105--) THEN BEGIN--103: IF(OutVal<0)OR ((OutVal=0)AND ( INT[LastSign]<0)) THEN BEGIN OutBuf↑[OutPtr] ←45;OutPtr←OutPtr+1; END ELSE IF INT[OutSign]>0 THEN BEGIN OutBuf↑[OutPtr]←OutSign; OutPtr←OutPtr+1; END;AppVal[ABS[OutVal]]; IF INT[OutPtr]>LineLength THEN FlushBuffer[];--:103--OutSign←43; OutVal←OutApp; END ELSE OutVal←OutVal+OutApp;OutState←3; GOTO Label20; END--:104--;0 =>IF T#3 THEN BreakPtr←OutPtr; ENDCASE => NULL--:102--; IF T#0 THEN FOR i:INT IN [ INT[1 ].. INT[V ]] DO K ← i; OutBuf↑[OutPtr]←OutContrib↑[K]; OutPtr←OutPtr+1; ENDLOOP ELSE BEGIN OutBuf↑[OutPtr]←V; OutPtr←OutPtr+1; END;IF INT[OutPtr]>LineLength THEN FlushBuffer[]; IF(T=0)AND ((V=59)OR (V=125)) THEN BEGIN SemiPtr←OutPtr; BreakPtr←OutPtr; END;IF INT[T]>=2 THEN OutState←1 ELSE OutState←0 ;EXIT; EXITS Label20 => NULL} ENDLOOP; END; --:101----106:-- SendSign: PROCEDURE[V: PascalInteger] = BEGIN SELECT OutState FROM 2,4 =>OutApp←OutApp*V;3 =>BEGIN OutApp←V; OutState←4; END;5 =>BEGIN OutVal←OutVal+OutApp;OutApp←V; OutState←4; END; ENDCASE =>BEGIN BreakPtr←OutPtr;OutApp←V; OutState←2; END ;LastSign←OutApp; END;--:106----107: SendVal: PROCEDURE[V: PascalInteger] = BEGIN {{SELECT OutState FROM 1 =>BEGIN--110: IF(OutPtr=BreakPtr+3)OR ((OutPtr=BreakPtr+4)AND (OutBuf↑[BreakPtr]=32 )) THEN IF((OutBuf↑[OutPtr-3]=68)AND (OutBuf↑[OutPtr-2]=73)AND (OutBuf↑ [OutPtr-1]=86))OR ((OutBuf↑[OutPtr-3]=77)AND (OutBuf↑[OutPtr-2]=79)AND ( OutBuf↑[OutPtr-1]=68)) THEN GOTO Label666--:110--;OutSign←32;OutState←3; OutVal←V;BreakPtr←OutPtr;LastSign←1; END;0 =>BEGIN--109: IF(OutPtr=BreakPtr+1)AND ((OutBuf↑[BreakPtr]=42)OR ( OutBuf↑[BreakPtr]=47)) THEN GOTO Label666--:109--;OutSign←0;OutState←3;OutVal←V; BreakPtr←OutPtr;LastSign←1; END;--108:--2 =>BEGIN OutSign←43; OutState←3;OutVal←OutApp*V; END;3 =>BEGIN OutState←5;OutApp←V; BEGIN PascalWriteLn[file: @TermOut]; PascalWriteLongString[file: @TermOut, item: "! Two numbers occurred without a sign between them"]; Error[]; END; END;4 =>BEGIN OutState←5;OutApp←OutApp*V; END; 5 =>BEGIN OutVal←OutVal+OutApp;OutApp←V;BEGIN PascalWriteLn[file: @TermOut]; PascalWriteLongString[file: @TermOut, item: "! Two numbers occurred without a sign between them"]; Error[]; END; END;--:108-- ENDCASE => GOTO Label666 ; GOTO Label10;EXITS Label666 => NULL};--111: IF V>=0 THEN BEGIN IF OutState=1 THEN BEGIN BreakPtr←OutPtr; BEGIN OutBuf↑[OutPtr]←32;OutPtr←OutPtr+1; END; END;AppVal[V]; IF INT[OutPtr]>LineLength THEN FlushBuffer[];OutState←1; END ELSE BEGIN BEGIN OutBuf↑[OutPtr]←40;OutPtr←OutPtr+1; END; BEGIN OutBuf↑[OutPtr]←45;OutPtr←OutPtr+1; END;AppVal[-V]; BEGIN OutBuf↑[OutPtr]←41;OutPtr←OutPtr+1; END; IF INT[OutPtr]>LineLength THEN FlushBuffer[];OutState←0; END--:111--;EXITS Label10 => NULL}; END; END.