#include // 1 %EXTERNALSTRING(255)%SPEC ERRMSG #line 1 "regression-bugs-tmp/printfl2.imp" extern _imp_string /*%string(255)*/ ERRMSG; // 2 !%EXTERNALREALFNSPEC FRACPT(%LONGREAL R) // 3 // 4 // 5 %ROUTINE FRACTION(%REAL R, %INTEGER PLACES) #line 5 "regression-bugs-tmp/printfl2.imp" void FRACTION( float R, int PLACES ) #line 5 "regression-bugs-tmp/printfl2.imp" { __label__ _imp_endofblock; // 6 %RETURN %IF PLACES<=0 _imp_current_line = 6; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 6 "regression-bugs-tmp/printfl2.imp" if (((PLACES) > (0))) goto L_0002; #line 6 "regression-bugs-tmp/printfl2.imp" return; #line 6 "regression-bugs-tmp/printfl2.imp" L_0002:; // 7 PRINTSYMBOL('.') _imp_current_line = 7; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 7 "regression-bugs-tmp/printfl2.imp" _imp_PRINTSYMBOL(46); // 8 %WHILE PLACES>0 %CYCLE _imp_current_line = 8; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 8 "regression-bugs-tmp/printfl2.imp" L_0003:; #line 8 "regression-bugs-tmp/printfl2.imp" if (((PLACES) <= (0))) goto L_0004; // 9 R = FRACPT(R)*10.0 _imp_current_line = 9; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 9 "regression-bugs-tmp/printfl2.imp" R = (((double)(_imp_FRACPT(R))) * (10.0)); // 10 PLACES=PLACES-1 _imp_current_line = 10; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 10 "regression-bugs-tmp/printfl2.imp" PLACES = (((int)(PLACES)) - (1)); // 11 PRINTSYMBOL(INTPT(R)+'0') _imp_current_line = 11; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 11 "regression-bugs-tmp/printfl2.imp" _imp_PRINTSYMBOL((((int)(_imp_INTPT(R))) + (48))); // 12 %REPEAT _imp_current_line = 12; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 12 "regression-bugs-tmp/printfl2.imp" goto L_0003; #line 12 "regression-bugs-tmp/printfl2.imp" L_0004:; // 13 %END _imp_current_line = 13; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 13 "regression-bugs-tmp/printfl2.imp" return; _imp_endofblock: ; } // End of block FRACTION at level 1 // 14 // 15 // 16 ! %routine PRINT(%long %real X, %integer I, J) // 17 ! // 18 ! This routine transmits to the currently selected output stream the // 19 ! value of the real expression specified by the first parameter. The // 20 ! second and third parameters should be integer expressions // 21 ! specifying the number of places to be allowed before and after the // 22 ! decimal point. If the integer part needs more positions than are // 23 ! specified by the parameter, then more positions will be taken. One // 24 ! position is allowed for a sign which is printed only in the // 25 ! negative case. If necessary, the fractional part will be rounded. // 26 ! // 27 ! Examples: // 28 ! PRINT(A, 2, 3) // 29 ! PRINT(COS(A-B), 1, 10) // 30 ! // 31 ! {IMP77: The second parameter is interpreted in the same way as the // 32 ! second parameter of WRITE (described above).} // 33 // 34 // 35 ! %routine PRINT FL(%longreal X, %integer I) // 36 ! // 37 ! This routine transmits to the currently selected output stream the // 38 ! value of the real expression specified by the first parameter. The // 39 ! second parameter specifies the number of places to be allowed after // 40 ! the decimal point. The printed number takes up the specified // 41 ! number of places, plus 7 additional places. // 42 ! // 43 ! Example: // 44 ! PRINT FL(X,4) // 45 ! // 46 ! If X has the value 17.63584, this would be printed as 1.7636@ 1. // 47 ! The number is standardised in the range 1 <= X < 10. One position // 48 ! each is allowed for signs for mantissa and exponent; in each case // 49 ! the sign is only printed when negative. // 50 // 51 // 52 %EXTERNALROUTINE PRINTFL(%REAL R, %INTEGER P) #line 52 "regression-bugs-tmp/printfl2.imp" void PRINTFL( float R, int P ) #line 52 "regression-bugs-tmp/printfl2.imp" { __label__ _imp_endofblock; // 53 %INTEGER EXP,SIGN _imp_current_line = 53; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 53 "regression-bugs-tmp/printfl2.imp" int EXP; #line 53 "regression-bugs-tmp/printfl2.imp" int SIGN; // 54 SIGN=' ' _imp_current_line = 54; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 54 "regression-bugs-tmp/printfl2.imp" SIGN = 32; // 55 SIGN='-' %AND R=-R %IF R<0 _imp_current_line = 55; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 55 "regression-bugs-tmp/printfl2.imp" if (((R) >= (0))) goto L_0006; #line 55 "regression-bugs-tmp/printfl2.imp" SIGN = 45; #line 55 "regression-bugs-tmp/printfl2.imp" R = (-(R)); #line 55 "regression-bugs-tmp/printfl2.imp" L_0006:; // 56 PRINTSYMBOL(SIGN) _imp_current_line = 56; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 56 "regression-bugs-tmp/printfl2.imp" _imp_PRINTSYMBOL(SIGN); // 57 %IF R=0 %START _imp_current_line = 57; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 57 "regression-bugs-tmp/printfl2.imp" if (((R) != (0))) goto L_0007; // 58 EXP=-99 _imp_current_line = 58; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 58 "regression-bugs-tmp/printfl2.imp" EXP = (-99); // 59 %ELSE _imp_current_line = 59; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 59 "regression-bugs-tmp/printfl2.imp" goto L_0008; #line 59 "regression-bugs-tmp/printfl2.imp" L_0007:; // 60 %IF P<=0 %START _imp_current_line = 60; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 60 "regression-bugs-tmp/printfl2.imp" if (((P) > (0))) goto L_0009; // 61 R=R+0.5 _imp_current_line = 61; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 61 "regression-bugs-tmp/printfl2.imp" R = (((double)(R)) + (0.5)); // 62 %ELSE _imp_current_line = 62; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 62 "regression-bugs-tmp/printfl2.imp" goto L_000a; #line 62 "regression-bugs-tmp/printfl2.imp" L_0009:; /*promote*/ // 63 R=R+0.5*10\(-P) _imp_current_line = 63; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 63 "regression-bugs-tmp/printfl2.imp" R = ((R) + ((float)(((0.5) * ((double)(_imp_REXP(10, (-(P))))))))); // 64 %FINISH _imp_current_line = 64; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 64 "regression-bugs-tmp/printfl2.imp" L_000a:; // 65 EXP=0 _imp_current_line = 65; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 65 "regression-bugs-tmp/printfl2.imp" EXP = 0; // 66 EXP=EXP+1 %AND R=R*0.1 %WHILE R >=10.0 _imp_current_line = 66; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 66 "regression-bugs-tmp/printfl2.imp" L_000b:; #line 66 "regression-bugs-tmp/printfl2.imp" if (((R) < (10.0))) goto L_000c; #line 66 "regression-bugs-tmp/printfl2.imp" EXP = (((int)(EXP)) + (1)); #line 66 "regression-bugs-tmp/printfl2.imp" R = (((double)(R)) * (0.1)); #line 66 "regression-bugs-tmp/printfl2.imp" goto L_000b; #line 66 "regression-bugs-tmp/printfl2.imp" L_000c:; // 67 EXP=EXP-1 %AND R=R*10.0 %WHILE R< 1.0 _imp_current_line = 67; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 67 "regression-bugs-tmp/printfl2.imp" L_000e:; #line 67 "regression-bugs-tmp/printfl2.imp" if (((R) >= (1.0))) goto L_000f; #line 67 "regression-bugs-tmp/printfl2.imp" EXP = (((int)(EXP)) - (1)); #line 67 "regression-bugs-tmp/printfl2.imp" R = (((double)(R)) * (10.0)); #line 67 "regression-bugs-tmp/printfl2.imp" goto L_000e; #line 67 "regression-bugs-tmp/printfl2.imp" L_000f:; // 68 %FINISH _imp_current_line = 68; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 68 "regression-bugs-tmp/printfl2.imp" L_0008:; // 69 PRINTSYMBOL(INT PT(R)+'0') _imp_current_line = 69; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 69 "regression-bugs-tmp/printfl2.imp" _imp_PRINTSYMBOL((((int)(_imp_INTPT(R))) + (48))); // 70 FRACTION(R,P) _imp_current_line = 70; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 70 "regression-bugs-tmp/printfl2.imp" FRACTION(R, P); // 71 PRINTSYMBOL('@'); WRITE(EXP,1) _imp_current_line = 71; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 71 "regression-bugs-tmp/printfl2.imp" _imp_PRINTSYMBOL(64); _imp_current_line = 71; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 71 "regression-bugs-tmp/printfl2.imp" _imp_WRITE(EXP, 1); // 72 %END _imp_current_line = 72; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 72 "regression-bugs-tmp/printfl2.imp" return; _imp_endofblock: ; } // End of block PRINTFL at level 1 // 73 // 74 %EXTERNALROUTINE PRINT(%REAL R, %INTEGER B,A) #line 74 "regression-bugs-tmp/printfl2.imp" void PRINT( float R, int B, int A ) #line 74 "regression-bugs-tmp/printfl2.imp" { __label__ _imp_endofblock; // 75 %REAL RM _imp_current_line = 75; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 75 "regression-bugs-tmp/printfl2.imp" float RM; // 76 %CONSTINTEGER MAX INT= 8_377777777777 _imp_current_line = 76; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; // 77 %INTEGER SIGN _imp_current_line = 77; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 77 "regression-bugs-tmp/printfl2.imp" int SIGN; // 78 %ROUTINE P(%INTEGER N) _imp_current_line = 78; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 78 "regression-bugs-tmp/printfl2.imp" void P( int N ) #line 78 "regression-bugs-tmp/printfl2.imp" { __label__ _imp_endofblock; // 79 B = B-1 _imp_current_line = 79; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 79 "regression-bugs-tmp/printfl2.imp" B = (((int)(B)) - (1)); // 80 P(N//10) %IF N >= 10 _imp_current_line = 80; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 80 "regression-bugs-tmp/printfl2.imp" if (((N) < (10))) goto L_0011; #line 80 "regression-bugs-tmp/printfl2.imp" P(((long)((long)((int)(N)) / (long)((int)(10))))); #line 80 "regression-bugs-tmp/printfl2.imp" L_0011:; // 81 %IF SIGN # 0 %START _imp_current_line = 81; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 81 "regression-bugs-tmp/printfl2.imp" if (((SIGN) == (0))) goto L_0012; // 82 SPACES(B-1) _imp_current_line = 82; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 82 "regression-bugs-tmp/printfl2.imp" _imp_SPACES((((int)(B)) - (1))); // 83 PRINTSYMBOL(SIGN); SIGN = 0 _imp_current_line = 83; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 83 "regression-bugs-tmp/printfl2.imp" _imp_PRINTSYMBOL(SIGN); _imp_current_line = 83; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 83 "regression-bugs-tmp/printfl2.imp" SIGN = 0; // 84 %FINISH _imp_current_line = 84; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 84 "regression-bugs-tmp/printfl2.imp" L_0012:; // 85 PRINTSYMBOL(REM(N,10)+'0') _imp_current_line = 85; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 85 "regression-bugs-tmp/printfl2.imp" _imp_PRINTSYMBOL((((int)(_imp_REM(N, 10))) + (48))); // 86 %END _imp_current_line = 86; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 86 "regression-bugs-tmp/printfl2.imp" return; _imp_endofblock: ; } // End of block P at level 2 // 87 RM=|R| _imp_current_line = 87; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 87 "regression-bugs-tmp/printfl2.imp" RM = _imp_MOD(R); // 88 PRINTFL(R, B+A) %AND %RETURN %IF RM> MAX INT _imp_current_line = 88; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 88 "regression-bugs-tmp/printfl2.imp" if (((RM) <= ((-1)))) goto L_0013; #line 88 "regression-bugs-tmp/printfl2.imp" PRINTFL(R, (((int)(B)) + (A))); #line 88 "regression-bugs-tmp/printfl2.imp" return; #line 88 "regression-bugs-tmp/printfl2.imp" L_0013:; // 89 %IF A<=0 %START _imp_current_line = 89; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 89 "regression-bugs-tmp/printfl2.imp" if (((A) > (0))) goto L_0014; // 90 RM=RM+0.5 _imp_current_line = 90; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 90 "regression-bugs-tmp/printfl2.imp" RM = (((double)(RM)) + (0.5)); // 91 %ELSE _imp_current_line = 91; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 91 "regression-bugs-tmp/printfl2.imp" goto L_0015; #line 91 "regression-bugs-tmp/printfl2.imp" L_0014:; /*promote*/ // 92 RM=RM+0.5*10\(-A) _imp_current_line = 92; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 92 "regression-bugs-tmp/printfl2.imp" RM = ((RM) + ((float)(((0.5) * ((double)(_imp_REXP(10, (-(A))))))))); // 93 %FINISH _imp_current_line = 93; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 93 "regression-bugs-tmp/printfl2.imp" L_0015:; // 94 %IF B<=0 %THEN SIGN=0 %ELSE SIGN=' ' _imp_current_line = 94; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 94 "regression-bugs-tmp/printfl2.imp" if (((B) > (0))) goto L_0016; #line 94 "regression-bugs-tmp/printfl2.imp" SIGN = 0; #line 94 "regression-bugs-tmp/printfl2.imp" goto L_0017; #line 94 "regression-bugs-tmp/printfl2.imp" L_0016:; #line 94 "regression-bugs-tmp/printfl2.imp" SIGN = 32; #line 94 "regression-bugs-tmp/printfl2.imp" L_0017:; // 95 %IF R<0 %THEN SIGN='-' _imp_current_line = 95; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 95 "regression-bugs-tmp/printfl2.imp" if (((R) >= (0))) goto L_0018; #line 95 "regression-bugs-tmp/printfl2.imp" SIGN = 45; #line 95 "regression-bugs-tmp/printfl2.imp" L_0018:; // 96 P(INT PT(RM)); !THUS ALLOWING FOR -0.1 ETC. _imp_current_line = 96; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 96 "regression-bugs-tmp/printfl2.imp" P(_imp_INTPT(RM)); // 97 FRACTION(RM,A) _imp_current_line = 97; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 97 "regression-bugs-tmp/printfl2.imp" FRACTION(RM, A); // 98 %END _imp_current_line = 98; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 98 "regression-bugs-tmp/printfl2.imp" return; _imp_endofblock: ; } // End of block PRINT at level 1 // 99 // 100 %begin #line 100 "regression-bugs-tmp/printfl2.imp" int main(int argc, char **argv) { __label__ _imp_endofblock; _imp_initialise(argc, argv); // 101 %end _imp_current_line = 101; _imp_current_file = "regression-bugs-tmp/printfl2.imp"; #line 101 "regression-bugs-tmp/printfl2.imp" return 0; _imp_endofblock: ; } // End of block _imp_main at level 1 // 102 // 103 %ENDOFFILE #line 103 "regression-bugs-tmp/printfl2.imp" // End of file