NewOuter(2);	       OK:=false;{fail after both alternatives tried}	    end         end   else{Sr=1,2}   if Adjacent(R0)   then begin{two adjacent points - needs special care}      if (hi.edge=hin) and (hi.cardinality=finite) then      begin         case Sr of	 1:begin lo:=hi; lo.edge:=lin;	   end;	 2:hi.edge:=hout;	 end;         AtEnd;      end      else if (lo.edge=lin) and (lo.cardinality=finite) then       begin         case Sr of	 1:lo.edge:=lout;	 2:begin hi:=lo; hi.edge:=hin;	   end;	 end;         AtEnd;      end else {cant be narrowed} Sr:=-1;   end{adjacent} else   begin      if (lo.mantissa < 0) and (hi.mantissa > 0) then      begin         MidM:=0; MidE:=0;      end else      begin         AlignUp(hi.exp,hi.mantissa,lo.exp,-lo.mantissa,EDiff,M0,M1,Dummy);         MDiff:=M0+M1;         MidM:=MDiff div 2 - M1;	 MidE:=EDiff;      end;      if MidM >= 0 then NormalizeDn(MidE,MidM,Mid,Dummy)      		   else NormalizeUp(MidE,MidM,Mid,Dummy);      case Sr of      1:begin lo:=Mid; lo.edge:=lin;        end;      2:begin hi:=Mid; hi.edge:=hout;        end;      end;            AtEnd;   end;{if Sr}   AlignUp(hi.exp,hi.mantissa,lo.exp,-lo.mantissa,EDiff,M0,M1,Dummy);   MDiff:=M0+M1;   DCurr.RHalve[OldPC]:=GetReal(EDiff,MDiff); end;{with}end;{execlinh}procedure execmult(var Sr:State;T0,T1,T2:Int;var R0,R1,R2:Int;var OK:boolean);var Q0,Q1,Q2:Int;   procedure multS(S0,S1:Sreal;var U,D:Sreal);   var M,E:integer;       Closed,Clu,Cld:boolean;   begin      M:=S0.mantissa*S1.mantissa;(*DumpS(S0);write('//');DumpS(S1);write(M);*)      Closed:=(S0.edge in [hin,lin]) and (S1.edge in [hin,lin]);      if ((S0.mantissa=0) and (S0.edge in [hin,lin])) or         ((S1.mantissa=0) and (S1.edge in [hin,lin]))      then Closed:=true;       Clu:=Closed; Cld:=Closed;      if (S0.cardinality=infinite) or (S1.cardinality=infinite) then      begin         if M < 0 then begin D:=MinusInfS; U:=MinusInfS; end else	 if M > 0 then begin D:=PlusInfS; U:=PlusInfS; end else	 begin {M=0} D:=ZeroS; U:=ZeroS; end;	 Closed:=((S0.cardinality=infinite)and(S0.edge in [hin,lin]))or	         ((S1.cardinality=infinite)and(S1.edge in [hin,lin]));	 Clu:=Closed;Cld:=Closed;      end      else{everybody finite}      begin         E:=S0.exp+S1.exp-Digits;	 NormalizeUp(E,M,U,Clu);	 NormalizeDn(E,M,D,Cld);      end;      if Clu then U.edge:=hin else U.edge:=hout;      if Cld then D.edge:=lin else D.edge:=lout;      (*writeln(E);DumpS(U);write('::');DumpS(D);writeln;*)   end;{multS}            procedure mult(Ta,Tb:Int;var R:Int);   var U0,U1,U2,U3,U4,U5,D0,D1,D2,D3,D4,D5:Sreal;   begin      multS(Ta.hi,Tb.hi,U0,D0);      multS(Ta.hi,Tb.lo,U1,D1);      multS(Ta.lo,Tb.hi,U2,D2);      multS(Ta.lo,Tb.lo,U3,D3);      maxS(U0,U1,U4);maxS(U2,U3,U5);maxS(U4,U5,R.hi);      minS(D0,D1,D4);minS(D2,D3,D5);minS(D4,D5,R.lo);   end;      procedure InvS(S:Sreal;var W:Sreal);   var E,M,Rem:integer;       Closed:boolean;   begin      Closed:= S.edge in [hin,lin];      if (S.cardinality = infinite) then         W:=ZeroS      else      if (S.mantissa = 0) then         case S.edge of	 hin,hout:W:=MinusInfS;	 lin,lout:W:=PlusInfS;	 end      else      begin         M:=(Maxinf*Maxinf) div S.mantissa;	 Rem:=(Maxinf*Maxinf) mod S.mantissa;	 if Rem < 0 then halt;	 E:=-S.exp;	 case S.edge of	 lin,lout: begin 	     	      if (Rem > 0) and (M > 0) then 		      begin M:=M+1;Closed:=false; 		      end;		      NormalizeUp(E,M,W,Closed);	           end;	 hin,hout: begin 	     	      if (Rem > 0) and (M < 0) then 		      begin M:=M-1;Closed:=false;		      end;		      NormalizeDn(E,M,W,Closed);	           end;	 end;      end;            if Closed then         case S.edge of         hin:W.edge:=lin;         lin:W.edge:=hin;         end      else         case S.edge of	 hin,hout:W.edge:=lout;	 lin,lout:W.edge:=hout;	 end;         end;{InvS}	       procedure Inv(T:Int;var X:Int;Pos:boolean);   {1/T positive -> X}   {If 1/T splits to two intervals then use Pos to select which to use}   begin      if (T.lo.mantissa < 0) and (T.hi.mantissa > 0) then         if (T.lo.cardinality=infinite) and (T.hi.cardinality=infinite) then	    X:=All	 else if Pos then	 begin InvS(T.hi,X.lo); X.hi:=PlusInfS; X.hi.edge:=hin;	 end else 	 begin InvS(T.lo,X.hi); X.lo:=MinusInfS; X.lo.edge:=lin;	 end      else      begin InvS(T.hi,X.lo); InvS(T.lo,X.hi);      end;   end;{Inv}      procedure divi(Ta,Tb:Int;var R:Int);   var X:Int;   begin      if (Tb.lo.mantissa < 0) and (Tb.hi.mantissa > 0) then         if (Ta.lo.mantissa < 0) and (Ta.hi.mantissa > 0) then	 { need do nothing as R will be set to [inf,inf]}	 else	          begin	    {if both same sign get positive side of inverse}	    {else get negative}	    Inv(Tb,X,(Ta.hi.mantissa <= 0) = (R.hi.mantissa <= 0));	    mult(Ta,X,R);	 end      else {Tb wont give split inverse}      begin         Inv(Tb,X,true);	 mult(Ta,X,R);      end;(*DumpInt(Tb);writeln('//');DumpInt(X);writeln;DumpInt(Ta);writeln('\\');DumpInt(R);writeln;*)   end;      function Split(T:Int):boolean;   begin      Split:=(T.lo.mantissa<0) and (T.hi.mantissa>0)       	      and ((T.lo.cardinality=finite) or (T.hi.cardinality=finite));   end;{Split}   function Zin(T:Int):boolean;   {check if 0 in range of interval}   begin      if (T.lo.mantissa > 0) then Zin:=false else      if (T.lo.mantissa = 0) then	 Zin:=(T.lo.edge=lin) else      if (T.hi.mantissa < 0) then Zin:=false else      if (T.hi.mantissa = 0) then         Zin:=(T.hi.edge=hin)       else         Zin:=true;   end;{Zin}   begin{execmult}   case Sr of   0,10:begin        if T2=Zero then           if (T1=Zero) or (T0=Zero) then Sr:=-1           else	   if not Zin(T0) then begin R1:=Zero; Sr:=-1; end else	   if not Zin(T1) then begin R0:=Zero; Sr:=-1; end 	   else           begin              NewOuter(11); NewOuter(12);OK:=false;                end        else if (Sr=0) then        begin	   if (T0.hi.mantissa > 0) and (T0.lo.mantissa < 0) and Split(T1)            then  begin NewOuter(1); NewOuter(2); OK:=false; end           else if (T1.hi.mantissa > 0) and 	           (T1.lo.mantissa < 0) and Split(T0)                 then  begin NewOuter(3); NewOuter(4); OK:=false; end;	end;     end;   1:begin R0.lo:=ZeroS; R0.lo.edge:=lin; T0:=R0; Sr:=10;     end;   2:begin R0.hi:=ZeroS; R0.hi.edge:=hout; T0:=R0; Sr:=10;     end;   3:begin R1.lo:=ZeroS; R1.lo.edge:=lin; T1:=R1; Sr:=10;     end;   4:begin R1.hi:=ZeroS; R1.hi.edge:=hout; T1:=R1; Sr:=10;     end;   11:begin R0:=Zero; Sr:=-1;      end;   12:begin R1:=Zero; Sr:=-1;      end;   end;      if OK and (Sr<>-1) then   begin      mult(T0,T1,Q2); Inter(R2,Q2,R2);      Q1:=R1; divi(T2,T0,Q1); Inter(R1,Q1,R1);      Q0:=R0; divi(T2,T1,Q0); Inter(R0,Q0,R0);      Sr:=10;   end;end;{execmult}procedure execadd(T0,T1,T2:Int;var R0,R1,R2:Int);  procedure addhi(S0,S1:Sreal; var S2:Sreal);  var Closed:boolean;  Exp,M0,M1:integer;  begin{addhi}  with S2 do  begin     if (S0.cardinality=infinite)or(S1.cardinality=infinite) then     begin          S2:=PlusInfS;        Closed:=((S0.cardinality=infinite)and(S0.edge=hin))or	        ((S1.cardinality=infinite)and(S1.edge=hin));     end else     begin        Closed:=(S0.edge=hin)and(S1.edge=hin);        AlignUp(S0.exp,S0.mantissa,S1.exp,S1.mantissa,Exp,M0,M1,Closed);	NormalizeUp(Exp,M0+M1,S2,Closed)     end;     if Closed then S2.edge:=hin else S2.edge:=hout;  end;  end;{addhi}    procedure addlo(S0,S1:Sreal; var S2:Sreal);  var Closed:boolean;  Exp,M0,M1:integer;  begin{addlo}  with S2 do  begin     if (S0.cardinality=infinite)or(S1.cardinality=infinite) then     begin          S2:=MinusInfS;        Closed:=((S0.cardinality=infinite)and(S0.edge=lin))or	        ((S1.cardinality=infinite)and(S1.edge=lin));     end else     begin        Closed:=(S0.edge=lin)and(S1.edge=lin);        AlignUp(S0.exp,-S0.mantissa,S1.exp,-S1.mantissa,Exp,M0,M1,Closed);	NormalizeUp(Exp,M0+M1,S2,Closed); mantissa:=-mantissa;     end;     if Closed then S2.edge:=lin else S2.edge:=lout;  end;  end;{addlo}    procedure subhi(S0,S1:Sreal; var S2:Sreal);  var Closed:boolean;  Exp,M0,M1:integer;  begin{subhi}  with S2 do  begin     if (S0.cardinality=infinite)or(S1.cardinality=infinite) then     begin          S2:=PlusInfS;        Closed:=((S0.cardinality=infinite)and(S0.edge=hin))or	        ((S1.cardinality=infinite)and(S1.edge=lin));     end else     begin        Closed:=(S0.edge=hin)and(S1.edge=lin);        AlignUp(S0.exp,S0.mantissa,S1.exp,-S1.mantissa,Exp,M0,M1,Closed);	NormalizeUp(Exp,M0+M1,S2,Closed);     end;     if Closed then S2.edge:=hin else S2.edge:=hout;  end;  end;{subhi}    procedure sublo(S0,S1:Sreal; var S2:Sreal);  var Closed:boolean;  Exp,M0,M1:integer;  begin{sublo}  with S2 do  begin     if (S0.cardinality=infinite)or(S1.cardinality=infinite) then     begin          S2:=MinusInfS;        Closed:=((S0.cardinality=infinite)and(S0.edge=lin))or	        ((S1.cardinality=infinite)and(S1.edge=hin));     end else     begin        Closed:=(S0.edge=lin)and(S1.edge=hin);        AlignUp(S0.exp,-S0.mantissa,S1.exp,S1.mantissa,Exp,M0,M1,Closed);	NormalizeUp(Exp,M0+M1,S2,Closed);mantissa:=-mantissa;     end;     if Closed then S2.edge:=lin else S2.edge:=lout;  end;  end;{sublo}  begin{execadd}   addhi(T0.hi,T1.hi,R2.hi);   addlo(T0.lo,T1.lo,R2.lo);      subhi(T2.hi,T0.lo,R1.hi);   sublo(T2.lo,T0.hi,R1.lo);      subhi(T2.hi,T1.lo,R0.hi);   sublo(T2.lo,T1.hi,R0.lo);end;{execadd}procedure execintgr(var Sr:State; var R:Int);        procedure floor (var R : Sreal);  var sign , dum : boolean ;      E, M ,t    : integer ;    begin     sign := false ;     with R do        begin           if (mantissa < 0) then              begin                 sign := true ;                 mantissa := - mantissa ;              end ;           if (exp <= 0) then              begin                 if sign or ((mantissa = 0) & (edge = hout)) then                    begin                       M := 1 ;                        sign := true ;                    end                  else                    M := 0 ;                 E := Digits ;                 NormalizeUp (E,M,R,dum) ;                 edge := hin ;              end                    else {exp >0}              if (exp <= Digits) then                 begin                    M := 1 ;                    E := exp ;                    while (E < Digits) do                       begin                          M := M * 10 ;                          E := E + 1 ;                       end ;                    t := mantissa mod M ;                    M := mantissa div M ;                    if (sign & ((edge = hout) or(t > 0))) then                       M := M + 1 ;                     if (not sign & (t = 0)) & (edge = hout) then                       M := M - 1 ;                    E := Digits ;                    NormalizeUp (E,M,R,dum) ;                    edge := hin ;                 end               else                 if ((edge = hout)&(exp = (Digits+1))) & (not sign & (mantissa = Splitman)) then                    begin                       mantissa := Maxman ;                       exp := Digits ;                       edge := hin ;                    end ;           if sign then              mantissa := - mantissa ;        end ;{with R}  end ; {floor}   procedure ceiling (var R : Sreal);  var sign , dum : boolean ;      E, M , t   : integer ;    begin     sign := false ;     with R do        begin           if (mantissa < 0) then              begin                 sign := true ;                 mantissa := - mantissa ;              end ;           if (exp <= 0) then              begin                 if sign or ((mantissa = 0) & (edge = lin)) then                    M := 0                  else                    M := 1 ;                 E := Digits ;                 NormalizeDn (E,M,R,dum) ;                 edge := lin ;              end                    else {exp > 0}              if (exp <= Digits) then                 begin                    M := 1 ;                    E := exp ;                    while (E < Digits) do                       begin                          M := M * 10 ;                          E := E + 1 ;                       end ;                    t := mantissa mod M ;                    M := mantissa div M ;                    if ( not sign & ((edge = lout) or(t > 0))) then                       M := M + 1 ;                    if (sign & (t = 0)) & (edge = lout) then                       M := M - 1 ;                    E := Digits ;                    NormalizeDn (E,M,R,dum) ;                    edge := lin ;                 end               else                 if ((edge = lout)&(exp = (Digits+1))) & (sign & (mantissa = Splitman)) then                    begin                       mantissa := Maxman ;                       exp := Digits ;                       edge := lin ;                    end ;           if sign then              mantissa := - mantissa ;        end ;{with R}  end ; {ceiling} begin   with R do      begin(*         writeln ('IN EXECINTGR :') ;         writeln ;         writeln ('HI : ', hi.mantissa , hi.exp) ;         writeln ;         writeln ('LO : ', lo.mantissa , lo.exp) ;         writeln ;*)         if (hi.cardinality <> infinite) then            floor (hi) ;         if (lo.cardinality <> infinite) then            ceiling (lo) ;         if ((hi.mantissa = lo.mantissa) & (hi.exp = lo.exp)) then            Sr := - 1 ;(*         writeln ('OUT EXECINTGR :') ;         writeln ;         writeln ('HI : ', hi.mantissa , hi.exp) ;         writeln ;         writeln ('LO : ', lo.mantissa , lo.exp) ;         writeln ;*)      end ;end;{execintgr}