Most of the code in this section is by Andrew Plotkin, and derives from test cases used to check the floating-point extensions to Glulx.
12#Ifdef TARGET_GLULX;1314[ REAL_NUMBER_TY_Say fp;15 print (Float) fp;16];1718[ REAL_NUMBER_TY_Compare r1 r2;19 @jflt r1 r2 ?less;20 @jfeq r1 r2 0 ?same;21 return 1;22 .same; return 0;23 .less; return -1;24];2526[ NUMBER_TY_to_REAL_NUMBER_TY int real; @numtof int real; return real; ];27[ REAL_NUMBER_TY_to_NUMBER_TY real int; @ftonumn real int; return int; ];2829[ REAL_NUMBER_TY_Sin in out; @sin in out; return out; ];30[ REAL_NUMBER_TY_Cos in out; @cos in out; return out; ];31[ REAL_NUMBER_TY_Tan in out; @tan in out; return out; ];32[ REAL_NUMBER_TY_Arcsin in out; @asin in out; return out; ];33[ REAL_NUMBER_TY_Arccos in out; @acos in out; return out; ];34[ REAL_NUMBER_TY_Arctan in out; @atan in out; return out; ];3536[ REAL_NUMBER_TY_Sinh in tmp out;37 @exp in tmp;38 @fsub M_0 in in;39 @exp in out;40 @fadd tmp out out;41 @fmul out M_HALF out;42 return out;43];4445[ REAL_NUMBER_TY_Cosh in tmp out;46 @exp in tmp;47 @fsub M_0 in in;48 @exp in out;49 @fsub tmp out out;50 @fmul out M_HALF out;51 return out;52];5354[ REAL_NUMBER_TY_Tanh in tmp out;55 tmp = REAL_NUMBER_TY_Sinh(in);56 in = REAL_NUMBER_TY_Cosh(in);57 @fdiv tmp in out;58 return out;59];6061[ REAL_NUMBER_TY_Reciprocal in out; @fdiv M_1 in out; return out; ];62[ REAL_NUMBER_TY_Negate in out; @fsub M_0 in out; return out; ];63[ REAL_NUMBER_TY_Plus x y out; @fadd x y out; return out; ];64[ REAL_NUMBER_TY_Minus x y out; @fsub x y out; return out; ];65[ REAL_NUMBER_TY_Times x y out; @fmul x y out; return out; ];66[ REAL_NUMBER_TY_Divide x y out; @fdiv x y out; return out; ];67[ REAL_NUMBER_TY_Remainder x y r q; @fmod x y r q; return r; ];68[ REAL_NUMBER_TY_Approximate x y quotient out;69 @fdiv x y quotient;70 @fadd quotient M_HALF quotient;71 @floor quotient quotient;72 @fmul quotient y out;73 return out;74];75[ REAL_NUMBER_TY_Root x out; @sqrt x out; return out; ];76[ REAL_NUMBER_TY_Cube_Root x out; @pow x M_THIRD out; return out; ];77[ REAL_NUMBER_TY_Pow x y out; @pow x y out; return out; ];78[ REAL_NUMBER_TY_Exp x out; @exp x out; return out; ];79[ REAL_NUMBER_TY_Log x out; @log x out; return out; ];80[ REAL_NUMBER_TY_BLog x n d out;81 @log x out;82 if (n == 10) d = M_LOG10;83 else {84 @numtof n d;85 @log d d;86 }87 @fdiv out d out;88 return out;89];90[ REAL_NUMBER_TY_Floor x out; @floor x out; return out; ];91[ REAL_NUMBER_TY_Ceiling x out; @ceil x out; return out; ];92[ REAL_NUMBER_TY_Abs x; return x & $7fffffff; ];93[ REAL_NUMBER_TY_Nan x; @jisnan x ?Nan; rfalse; .Nan; rtrue; ];9495Constant M_0 = $0;96Constant M_1 = $3F800000;97Constant M_HALF = $3F000000; ! 1/398Constant M_THIRD = $3EAAAAAB; ! 1/399Constant M_LOG10 = $40135D8E; ! log(10)100Constant M_N1 = $BF800000; ! -1101Constant M_PI = $40490FDB;102Constant M_NPI = $C0490FDB;103Constant M_2PI = $40C90FDB; ! 2*pi104Constant M_PI2 = $3FC90FDB; ! pi/2105Constant M_NPI2 = $BFC90FDB; 106Constant M_E = $402DF854;107Constant M_E2 = $40EC7326; ! e^2108Constant M_N0 = $80000000; ! negative zero109Constant M_INF = $7F800000; ! infinity110Constant M_NINF = $FF800000; ! negative infinity111Constant M_NAN = $7F800001; ! one of many NaN values112Constant M_NNAN = $FF800001; ! another, with a sign bit113114! Floating-point parsing routines.115116! Parse a float from a text buffer. Returns a float value, or FLOAT_NAN if117! no value was understood.118!119! The recognized format, if you'll pardon a slightly bastardized regexp120! syntax, is "S?D*(PD*)?(ES?D+)?" where S is a sign character "+" or "-",121! D is a decimal digit "0" to "9", P is a decimal point ".",122! and E is the exponential modifier "E" or "e".123!124! For flexibility, the string "M10^" is also accepted for E, where M is125! "X", "x", "*", or the multiplication sign @{D7}. Optional spaces are126! allowed before and after the M sign. (But only for the "10^" form of127! the exponent, not the "e" form.)128!129! This routine does not try to recognize special names for infinity or NaN,130! but it can return FLOAT_INFINITY or FLOAT_NINFINITY if the exponent is too131! large.132!133! This routine relies on floating-point math. Therefore, the same string134! may parse to slightly different float values on different interpreters!135! Be warned.136!137! If useall is true, this insists on using all len characters from the buffer.138! (It returns FLOAT_NAN if any unrecognized characters are left over.)139! Contrariwise, if useall is false, unused characters at the end of the buffer140! are fine. (But not at the beginning; the float must start at the beginning141! of the buffer.)142! 143[ FloatParse buf len useall144 res ix val ch ten negative intpart fracpart fracdiv145 expon expnegative count;146147! print "FloatParse <";148! for (ix=0: ix<len: ix++) print (char) buf->ix;149! print ">^";150151 if (len == 0)152 return FLOAT_NAN;153154 ix = 0;155 negative = false;156 intpart = 0;157 fracpart = 0;158 @numtof 10 ten;159160! Sign character (optional)161 ch = buf->ix;162 if (ch == '-') {163 negative = true;164 ix++;165 }166 else if (ch == '+') {167 ix++;168 }169170! Some digits (optional)171 for (count=0 : ix<len : ix++, count++) {172 ch = buf->ix;173 if (ch < '0' || ch > '9')174 break;175 val = (ch - '0');176 @numtof val val;177 @fmul intpart ten intpart;178 @fadd intpart val intpart;179 }180181! Decimal point and more digits (optional)182 if (ix<len && buf->ix == '.') {183 ix++;184 @numtof 1 fracdiv;185 for ( : ix<len : ix++, count++) {186 ch = buf->ix;187 if (ch < '0' || ch > '9')188 break;189 val = (ch - '0');190 @numtof val val;191 @fmul fracpart ten fracpart;192 @fadd fracpart val fracpart;193 @fmul fracdiv ten fracdiv;194 }195 @fdiv fracpart fracdiv fracpart;196 }197198! If there are no digits before *or* after the decimal point, fail.199 if (count == 0)200 return FLOAT_NAN;201202! Combine the integer and fractional parts.203 @fadd intpart fracpart res;204205! Exponent (optional)206 if (ix<len && buf->ix == 'e' or 'E' or ' ' or '*' or 'x' or 'X' or $D7) {207 if (buf->ix == 'e' or 'E') {208! no spaces, just the 'e'209 ix++;210 if (ix == len)211 return FLOAT_NAN;212 }213 else {214! any number of spaces, "*", any number of spaces more, "10^"215 while (ix < len && buf->ix == ' ')216 ix++;217 if (ix == len)218 return FLOAT_NAN;219 if (buf->ix ~= '*' or 'x' or 'X' or $D7)220 return FLOAT_NAN;221 ix++;222 while (ix < len && buf->ix == ' ')223 ix++;224 if (ix == len)225 return FLOAT_NAN;226 if (buf->ix ~= '1')227 return FLOAT_NAN;228 ix++;229 if (buf->ix ~= '0')230 return FLOAT_NAN;231 ix++;232 if (buf->ix ~= $5E)233 return FLOAT_NAN;234 ix++;235 }236237! Sign character (optional)238 expnegative = false;239 ch = buf->ix;240 if (ch == '-') {241 expnegative = true;242 ix++;243 }244 else if (ch == '+') {245 ix++;246 }247248 expon = 0;249! Some digits (mandatory)250 for (count=0 : ix<len : ix++, count++) {251 ch = buf->ix;252 if (ch < '0' || ch > '9')253 break;254 expon = 10*expon + (ch - '0');255 }256257 if (count == 0)258 return FLOAT_NAN;259260 if (expnegative)261 expon = -expon;262263 if (expon) {264 @numtof expon expon;265 @pow ten expon val;266 @fmul res val res;267 }268 }269270 if (negative) {271! set the value's sign bit272 res = $80000000 | res;273 }274275 if (useall && ix ~= len)276 return FLOAT_NAN;277 return res;278];279280! An I6 grammar routine (GPR) for floats. On success, this returns281! GPR_NUMBER and stores a value in the global parsed_number.282!283! This is quite a nuisance, actually, because "." is a word separator.284! Also, we want to accept command sequences like "type 4. look"! So we285! need to collect a set of words made up of digits, signs, periods, and286! the letter "e", but without any intervening whitespace, and excluding287! a trailing period.288!289! (This will fail to correctly parse "type 4.e", but I think that is a290! small flaw. A player would more likely try "type 4. e" or, really,291! not concatenate commands at all. It will also parse "type 4. on keyboard"292! as two commands, even though "4." is a legitimate float literal.293! Contrariwise, "type 4. x me" will be taken as one command. (Because the "x"294! *could* be a continuation of the float, and I don't back up when it turns295! out not to be.) I don't plan to worry about these cases.)296297[ FLOAT_TOKEN buf bufend ix ch firstwd newstart newlen lastchar lastwasdot;298 if (wn > num_words)299 return GPR_FAIL;300301! We're going to collect a set of words. Start with zero words.302 firstwd = wn;303 buf = WordAddress(wn);304 bufend = buf;305 lastchar = 0;306307 while (wn <= num_words) {308 newstart = WordAddress(wn);309 if (newstart ~= bufend) {310! There's whitespace between the previous word and this one.311! Whitespace is okay around an asterisk...312 if ((lastchar ~= '*' or 'x' or 'X' or $D7)313 && (newstart->0 ~= '*' or 'x' or 'X' or $D7)) {314! But around any other character, it's not.315! Don't include the new word.316 break;317 }318 }319 newlen = WordLength(wn);320 for (ix=0 : ix<newlen : ix++) {321 ch = newstart->ix;322 if (~~((ch >= '0' && ch <= '9')323 || (ch == '-' or '+' or 'E' or 'e' or '.' or 'x' or 'X' or '*' or $D7 or $5E)))324 break;325 }326 if (ix < newlen) {327! This word contains an invalid character.328! Don't include the new word.329 break;330 }331! Okay, include it.332 bufend = newstart + newlen;333 wn++;334 lastchar = (bufend-1)->0;335 lastwasdot = (newlen == 1 && lastchar == '.');336 }337338 if (wn > firstwd && lastwasdot) {339! Exclude a trailing period.340 wn--;341 bufend--;342 }343344 if (wn == firstwd) {345! No words accepted.346 return GPR_FAIL;347 }348349 parsed_number = FloatParse(buf, bufend-buf, true);350 if (parsed_number == FLOAT_NAN)351 return GPR_FAIL;352 return GPR_NUMBER;353];354355! Floating-point printing routines. (These are based on code in356! Glulxercise.inf, but modified.)357358! Print a float. This uses exponential notation ("[-]N.NNNe[+-]NN") if359! the exponent is not between 6 and -4. If it is (that is, if the360! absolute value is near 1.0) then it uses decimal notation ("[-]NNN.NNNNN").361! The precision is the number of digits after the decimal point362! (at least one, no more than eight). The default is five, because363! beyond that rounding errors creep in, and even exactly-represented364! float values are printed with trailing fudgy digits.365! Trailing zeroes are trimmed.366[ Float val prec pval;367 pval = val & $7FFFFFFF;368369 @jz pval ?UseFloatDec;370 @jfge pval $49742400 ?UseFloatExp; ! 1000000.0371 @jflt pval $38D1B717 ?UseFloatExp; ! 0.0001372373 .UseFloatDec;374 return FloatDec(val, prec);375 .UseFloatExp;376 return FloatExp(val, prec);377];378379Array PowersOfTen --> 1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000;380381! Print a float in exponential notation: "[-]N.NNNe[+-]NN".382! The precision is the number of digits after the decimal point383! (at least one, no more than eight). The default is five, because384! beyond that rounding errors creep in, and even exactly-represented385! float values are printed with trailing fudgy digits.386! Trailing zeroes are trimmed.387[ FloatExp val prec log10val expo fexpo idig ix pow10;388 if (prec == 0)389 prec = 5;390 if (prec > 8)391 prec = 8;392 pow10 = PowersOfTen --> prec;393394! Knock off the sign bit first.395 if (val & $80000000) {396 @streamchar '-';397 val = val & $7FFFFFFF;398 }399400 @jisnan val ?IsNan;401 @jisinf val ?IsInf;402403 if (val == $0) {404 expo = 0;405 idig = 0;406 jump DoPrint;407 }408409! Take as an example val=123.5, with precision=6. The desired410! result is "1.23000e+02".411412 @log val sp;413 @fdiv sp $40135D8E log10val; ! $40135D8E is log(10)414 @floor log10val fexpo;415 @ftonumn fexpo expo;416! expo is now the exponent (as an integer). For our example, expo=2.417418 @fsub log10val fexpo sp;419 @numtof prec sp;420 @fadd sp sp sp;421 @fmul sp $40135D8E sp;422 @exp sp sp;423! The stack value is now exp((log10val - fexpo + prec) * log(10)).424! We've shifted the decimal point left by expo digits (so that425! it's after the first nonzero digit), and then right by prec426! digits. In our example, that would be 1235000.0.427 @ftonumn sp idig;428! Round to an integer, and we have 1235000. Notice that this is429! exactly the digits we want to print (if we stick a decimal point430! after the first).431432 .DoPrint;433434 if (idig >= 10*pow10) {435! Rounding errors have left us outside the decimal range of436! [1.0, 10.0) where we should be. Adjust to the next higher437! exponent.438 expo++;439 @div idig 10 idig;440 }441442! Trim off trailing zeroes, as long as there's at least one digit443! after the decimal point. (Delete this stanza if you want to444! keep the trailing zeroes.)445 while (prec > 1) {446 @mod idig 10 sp;447 @jnz sp ?DoneTrimming;448 @div pow10 10 pow10;449 @div idig 10 idig;450 prec--;451 }452 .DoneTrimming;453454 for (ix=0 : ix<=prec : ix++) {455 @div idig pow10 sp;456 @mod sp 10 sp;457 @streamnum sp;458 if (ix == 0)459 @streamchar '.';460 @div pow10 10 pow10;461 }462463! Print the exponent. There are two conventions coded here: the464! programmatic ("1.0e+00") and the literary ("1.0 x 10^0").465 #ifndef FLOAT_PROGRAMMING_EXPONENTS;466 PrintMultiplicationSign();467 @streamstr "10";468 @streamchar $5E;469 @streamnum expo;470 #ifnot;471! Convention is to use at least two digits.472 @streamchar 'e';473 if (expo < 0) {474 @streamchar '-';475 @neg expo expo;476 }477 else {478 @streamchar '+';479 }480 if (expo < 10)481 @streamchar '0';482 @streamnum expo;483 #endif; ! FLOAT_PROGRAMMING_EXPONENTS484485 rtrue;486487 .IsNan;488 PrintNan();489 rtrue;490491 .IsInf;492 PrintInfinity();493 rtrue;494];495496! Print a float in decimal notation: "[-]NNN.NNNNN".497! The precision is the number of digits after the decimal point498! (at least one, no more than eight). The default is five, because499! beyond that rounding errors creep in, and even exactly-represented500! float values are printed with trailing fudgy digits.501! Trailing zeroes are trimmed.502[ FloatDec val prec log10val int fint extra0 frac idig ix pow10;503 if (prec == 0)504 prec = 5;505 if (prec > 8)506 prec = 8;507 pow10 = PowersOfTen --> prec;508509! Knock off the sign bit first.510 if (val & $80000000) {511 @streamchar '-';512 val = val & $7FFFFFFF;513 }514515 @jisnan val ?IsNan;516 @jisinf val ?IsInf;517518! Take as an example val=123.5, with precision=6. The desired result519! is "123.50000".520521 extra0 = 0;522 @fmod val $3F800000 frac fint; ! $3F800000 is 1.0.523 @ftonumz fint int;524! This converts the integer part of the value to an integer value;525! in our example, 123.526527 if (int == $7FFFFFFF) {528! Looks like the integer part of the value is bigger than529! we can store in an int variable. (It could be as large530! as 3e+38.) We're going to have to use a log function to531! reduce it by some number of factors of 10, and then pad532! with zeroes.533 @log fint sp;534 @fdiv sp $40135D8E log10val; ! $40135D8E is log(10)535 @ftonumz log10val extra0;536 @sub extra0 8 extra0;537! extra0 is the number of zeroes we'll be padding with.538 @numtof extra0 sp;539 @fsub log10val sp sp;540 @fmul sp $40135D8E sp;541 @exp sp sp;542! The stack value is now exp((log10val - extra0) * log(10)).543! We've shifted the decimal point far enough left to leave544! about eight digits, which is all we can print as an integer.545 @ftonumz sp int;546 }547548! Print the integer part.549 @streamnum int;550 for (ix=0 : ix<extra0 : ix++)551 @streamchar '0';552553 @streamchar '.';554555! Now we need to print the frac part, which is .5.556557 @log frac sp;558 @fdiv sp $40135D8E log10val; ! $40135D8E is log(10)559 @numtof prec sp;560 @fadd log10val sp sp;561 @fmul sp $40135D8E sp;562 @exp sp sp;563! The stack value is now exp((frac + prec) * log(10)).564! We've shifted the decimal point right by prec565! digits. In our example, that would be 50000.0.566 @ftonumn sp idig;567! Round to an integer, and we have 50000. Notice that this is568! exactly the (post-decimal-point) digits we want to print.569570 .DoPrint;571572 if (idig >= pow10) {573! Rounding errors have left us outside the decimal range of574! [0.0, 1.0) where we should be. I'm not sure this is possible,575! actually, but we'll just adjust downward.576 idig = pow10 - 1;577 }578579! Trim off trailing zeroes, as long as there's at least one digit580! after the decimal point. (Delete this stanza if you want to581! keep the trailing zeroes.)582 while (prec > 1) {583 @mod idig 10 sp;584 @jnz sp ?DoneTrimming;585 @div pow10 10 pow10;586 @div idig 10 idig;587 prec--;588 }589 .DoneTrimming;590591 @div pow10 10 pow10;592 for (ix=0 : ix<prec : ix++) {593 @div idig pow10 sp;594 @mod sp 10 sp;595 @streamnum sp;596 @div pow10 10 pow10;597 }598 rtrue;599600 .IsNan;601 PrintNan();602 rtrue;603604 .IsInf;605 PrintInfinity();606 rtrue;607];608609[ PrintInfinity;610 @streamunichar $221E;611! @streamstr "Inf";612];613614[ PrintNan;615 @streamunichar $26a0;616! @streamstr "NaN";617];618619[ PrintMultiplicationSign;620 print " ";621 @streamunichar $D7;622 print " ";623! @streamstr " x ";624];625626#Ifnot; ! TARGET_GLULX627628[ REAL_NUMBER_TY_Say real; print real; ]; ! Needs to exist, but likely never used629630[ REAL_NUMBER_TY_Compare r1 r2; return UnsignedCompare(r1, r2); ];631632#Endif; ! TARGET_GLULX