! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. %ownstring(90) copyright = %C " Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved." ! !Modified 20/June/87 18.00 FTNREAL20 !**********************************************************************! !**********************************************************************! ! ! ! ! ! Support Procedures for Numeric Conversion ! ! ! ! of Real Numbers ! ! ! ! between Binary and Character Form ! ! ! ! ! !**********************************************************************! !**********************************************************************! !---History: ! ! %C FTNREAL20 includes FTN_HT and FTN_CONFIG. !%C code for cross-compiling from ICL2900 EMAS to an IEEE host %C has been removed. !%C derived from REAL9B (Sun), with REAL12 (Dell), and with %C FTNREAL15 (Gould). The histories of FTNREAL15 and REAL9B %C are included below: !%C FTNREAL15 further refinements for very small numbers %C incorporated to handle numbers such as 8.636185519999D-78. !%C FTNREAL14 modified to improve the precision acquired for %C values which at the bottom end of the range. !%C FTNREAL13 incorporates conditional compilation for Concept %C and NP. If targetted for NP, then procedure SCALE BY TEN %C will not perform rounding. The new conditional compilation %C is only applicable if HOST= GOULD. !%C FTNREAL12 incorporates copyright. !%C REAL9B.I 10/May/88 %C Had a bug in the *put code for intorange on the sun %C This code is superseded by assem3.s routines but may %C still be used by any new routines Andy may introduce %C and by fortran diagnostics. !%C F77REAL12 allows for targetting on the DELL. !%C all uses of the construct '\=' {not equals} have been %C replaced by '#' as per memorandum of 13/Oct/87. !%C merges REAL9 (Sun) with REAL8 (Whitechapel/DRS), and %C with FTNREAL11 (Gould). The history of FTNREAL11 is %C included below: !%C FTNREAL11 %C modified from FTNREAL10 and improves precision by %C rounding values in ADDITIONAL PRECISION up to the %C least significant digits used (in most cases this %C rounding is as would occur when rounding a REAL*8 %C to a REAL*4). !%C Also extends the rounding applied in FTNREAL10 to %C those cases where either PARAMb or POWERb are zero. !%C FTNREAL10 %C modified from FTNREAL9 and corrects loss of precision %C for 0.128125D03 by changing ADDITIONAL PRECISION (-3) !%C Also corrects loss of precision for 0.126412625D06 by %C applying rounding on PART2 based on PART1 before adding %C the two together. !%C Also, for efficiency, if SCALE BY TEN is passed a %C scale of 0 (ie multiply by 10 ** 0) then it returns %C immediately with the number to be scaled. !%C FTNREAL9 %C modified from FTNREAL8 and corrects loss of precision %C for numbers which uses 0.1 as power of ten. !%C FTNREAL8 %C modified from FTNREAL7 and corrects loss of precision %C for numbers less than 10.0 ** (-71). !%C FTNREAL7 %C modified from FTNREAL6 and incorporates a SCALE BY TEN %C procedure for GOULD to overcome the deficiency within %C the Powernode hardware whereby the bottom nibble is %C dropped in double precision multiplication and division. !%C F77REAL9 makes uses of the 68881 ftentox and log10x instuctions %C to get powers of ten and to bring values into range %C replacing the powers of ten and into range routines %C with 68881 instructions.Also for compatibility the %C power of ten table for the sun is derived from the %C ftentox instruction. !%C F77REAL8 modified for DRS in response to the IMP compiler %C re-interpreting R quote constants as the target %C form rather than the host form. !%C F77REAL7 modified to allow for cross-compilation from %C EMAS-A to DRS. !%C F77REAL6 modified to allow for VNS. %INCLUDE "ftnht.inc" %INCLUDE "fconfig.inc" !---Conditional Compilation Variables: ! ! ! %constinteger false= 0 ! %constinteger true = 1 ! !*********************************************************************** ! ! SPECIFICATIONS OF PROCEDURES DEFINED ! !*********************************************************************** ! %LONGLONGREALFNSPEC POWER OF TEN ( %INTEGER EXP) %LONGLONGREALFNSPEC INTO RANGE (%LONGLONGREAL X, %INTEGERNAME EXP) %IF HOST= Gould %THENSTART ! %LONGREALFNSPEC SCALE BY TEN (%LONGREAL VALUE, %INTEGER SCALE) %FINISH ! !*********************************************************************** ! ! CONSTANTS ! !*********************************************************************** ! %IF IEEE Mode= True %AND HOST# Sun3 %THENSTART ! ! ! DEFINE REAL CONSTANTS DIRECTLY IN IEEE STANDARD ! ! %CONSTLONGREALARRAY TABLE1 OF POWERS ( 0: 122)= %C %C {10.0 ** -305} R'009C16C5C5253575' , {10.0 ** -300} R'01A56E1FC2F8F358' , {10.0 ** -295} R'02B059949B708F29' , {10.0 ** -290} R'03B8F2B061AEA072' , {10.0 ** -285} R'04C308A831868AC8' , {10.0 ** -280} R'05CD0B15A491EB84' , {10.0 ** -275} R'06D62884F31E93FF' , {10.0 ** -270} R'07E0E7C9EEBC4449' , {10.0 ** -265} R'08E9CBAE7FE805B3' , {10.0 ** -260} R'09F3AE3591F5B4D9' , {10.0 ** -255} R'0AFE07B27DD78B14' , {10.0 ** -250} R'0C06E93F5DA2824B' , {10.0 ** -245} R'0D117AD428200C08' , {10.0 ** -240} R'0E1AAC0BF9B9E65C' , {10.0 ** -235} R'0F245962E2F6A490' , {10.0 ** -230} R'102F0CE4839198DA' , {10.0 ** -225} R'1137B08617A104EE' , {10.0 ** -220} R'124212DD4DE70913' , {10.0 ** -215} R'134B9408EEFEA838' , {10.0 ** -210} R'14550A6110D6A9B7' , {10.0 ** -205} R'15600D7B2E28C65C' , {10.0 ** -200} R'16687E92154EF7AC' , {10.0 ** -195} R'1772B010D3E1CF56' , {10.0 ** -190} R'187C83E7AD4E6EFE' , {10.0 ** -185} R'1985C162B168E70E' , {10.0 ** -180} R'1A90991A9BFA58C8' , {10.0 ** -175} R'1B99539E3A40DFB8' , {10.0 ** -170} R'1CA3529BA7D19EAF' , {10.0 ** -165} R'1DAD7BECC2F23AC1' , {10.0 ** -160} R'1EB67E9C127B6E74' , {10.0 ** -155} R'1FC1297872D9CBB5' , {10.0 ** -150} R'20CA2FE76A3F9475' , {10.0 ** -145} R'21D3FAAC3E3FA1F3' , {10.0 ** -140} R'22DE7C5F127BD87E' , {10.0 ** -135} R'23E7424348CA1C9B' , {10.0 ** -130} R'24F1BEBDF578B2F4' , {10.0 ** -125} R'25FB13AC9AAF4C0F' , {10.0 ** -120} R'2704A8729FC3DDB7' , {10.0 ** -115} R'280F8587E7083E2F' , {10.0 ** -110} R'29180C903F7379F1' , {10.0 ** -105} R'2A225915CD68C9F9' , {10.0 ** -100} R'2B2BFF2EE48E052F' , {10.0 ** -95 } R'2C355C2076BF9A55' , {10.0 ** -90 } R'2D404BD984990E6F' , {10.0 ** -85 } R'2E48DDBCC7F40BA6' , {10.0 ** -80 } R'2F52F8AC174D6123' , {10.0 ** -75 } R'305CF2B1970E7258' , {10.0 ** -70 } R'316615E91D8F359D' , {10.0 ** -65 } R'3270D9976A5D5297' , {10.0 ** -60 } R'3379B604AAACA626' , {10.0 ** -55 } R'34839DAE6F76D883' , {10.0 ** -50 } R'358DEE7A4AD4B81F' , {10.0 ** -45 } R'3696D601AD376AB9' , {10.0 ** -40 } R'37A16C262777579C' , {10.0 ** -35 } R'38AA95A5B7F87A0F' , {10.0 ** -30 } R'39B4484BFEEBC2A0' , {10.0 ** -25 } R'3ABEF2D0F5DA7DD9' , {10.0 ** -20 } R'3BC79CA10C924223' , {10.0 ** -15 } R'3CD203AF9EE75615' , {10.0 ** -10 } R'3DDB7CDFD9D7BDBB' , {10.0 ** -5 } R'3EE4F8B588E368F1' , {10.0 ** 0 } R'3FF0000000000000' , {10.0 ** 5 } R'40F86A0000000000' , {10.0 ** 10 } R'4202A05F20000000' , {10.0 ** 15 } R'430C6BF526340000' , {10.0 ** 20 } R'4415AF1D78B58C40' , {10.0 ** 25 } R'45208B2A2C280290' , {10.0 ** 30 } R'46293E5939A08CE9' , {10.0 ** 35 } R'4733426172C74D82' , {10.0 ** 40 } R'483D6329F1C35CA5' , {10.0 ** 45 } R'49466BB7F0435C9E' , {10.0 ** 50 } R'4A511B0EC57E6499' , {10.0 ** 55 } R'4B5A19E96A19FC41' , {10.0 ** 60 } R'4C63E9E4E4C2F344' , {10.0 ** 65 } R'4D6E62C4E38FF872' , {10.0 ** 70 } R'4E772EBAD6DDC73D' , {10.0 ** 75 } R'4F81AFD6EC0E1411' , {10.0 ** 80 } R'508AFCEF51F0FB5F' , {10.0 ** 85 } R'5194971956342AC8' , {10.0 ** 90 } R'529F6B0F092959C7' , {10.0 ** 95 } R'53A7F85DE8AD5C4E' , {10.0 ** 100 } R'54B249AD2594C37D' , {10.0 ** 105 } R'55BBE7ABD3781ECA' , {10.0 ** 110 } R'56C54A3047C694FE' , {10.0 ** 115 } R'57D03E29F5C2B18C' , {10.0 ** 120 } R'58D8C8DAC6A0342A' , {10.0 ** 125 } R'59E2E8BD69AA19CC' , {10.0 ** 130 } R'5AECDA62055B2D9D' , {10.0 ** 135 } R'5BF6035CE8B6203D' , {10.0 ** 140 } R'5D00CB70D24B7378' , {10.0 ** 145 } R'5E09A06D06E26112' , {10.0 ** 150 } R'5F138D352E5096AF' , {10.0 ** 155 } R'601DD55745CBB7ED' , {10.0 ** 160 } R'6126C2D4256FFCC3' , {10.0 ** 165 } R'62315D847AD00087' , {10.0 ** 170 } R'633A7F5245E5A2CF' , {10.0 ** 175 } R'6444374374F3C2C6' , {10.0 ** 180 } R'654ED8D34E547314' , {10.0 ** 185 } R'665788CCB6B2CE0C' , {10.0 ** 190 } R'6761F48EAF234AD3' , {10.0 ** 195 } R'686B65CA37FD3A0D' , {10.0 ** 200 } R'6974E718D7D7625A' , {10.0 ** 205 } R'6A7FE52048590673' , {10.0 ** 210 } R'6B88557F31326BBB' , {10.0 ** 215 } R'6C9290BA9A38C7D1' , {10.0 ** 220 } R'6D9C5416BB92E3E6' , {10.0 ** 225 } R'6EA59CE797FB817F' , {10.0 ** 230 } R'6FB07D457124123D' , {10.0 ** 235 } R'70B9292615C3AA54' , {10.0 ** 240 } R'71C33234DE7AD7E3' , {10.0 ** 245 } R'72CD4A7BEBFA31AA' , {10.0 ** 250 } R'73D658E3AB795204' , {10.0 ** 255 } R'74E10CB132C2FF63' , {10.0 ** 260 } R'75EA03FDE214CAF0' , {10.0 ** 265 } R'76F3D92BA28C7D15' , {10.0 ** 270 } R'77FE494034E79E5C' , {10.0 ** 275 } R'79071B42CC5CF601' , {10.0 ** 280 } R'7A11A0FC668AAC6F' , {10.0 ** 285 } R'7B1AE64521F7595E' , {10.0 ** 290 } R'7C2485CE9E7A065E' , {10.0 ** 295 } R'7D2F50AC6690F1F8' , {10.0 ** 300 } R'7E37E43C8800759C' , {10.0 ** 305 } R'7F423A516E82D9BA' ! ! !This table contains the Powers of Ten ! in the range 10**(-305) to 10**(305) ! in IEEE Standard form ! in double precision ! in steps of 5 %CONSTINTEGER B1= -( -305{the 1st power in TABLE1} // 5 {the step size}) ! !It is prefered if arrays start at subscript zero, and ! in bowing to this preference, yet still maintaining ! some level of readability this constant is added to ! any subscript value before accessing TABLE1 OF POWERS. %CONSTLONGREALARRAY TABLE2 OF POWERS ( 0: 10)= %C %C {10.0 ** -5 } R'3EE4F8B588E368F1' , {10.0 ** -4 } R'3F1A36E2EB1C432C' , {10.0 ** -3 } R'3F50624DD2F1A9FC' , {10.0 ** -2 } R'3F847AE147AE147B' , {10.0 ** -1 } R'3FB999999999999A' , {10.0 ** 0 } R'3FF0000000000000' , {10.0 ** 1 } R'4024000000000000' , {10.0 ** 2 } R'4059000000000000' , {10.0 ** 3 } R'408F400000000000' , {10.0 ** 4 } R'40C3880000000000' , {10.0 ** 5 } R'40F86A0000000000' ! ! !This table contains the Powers of Ten ! in the range 10**(-5) to 10**(5) %CONSTINTEGER B2= -( -5{which is the 1st power in TABLE2} ) ! !---as for B1 but applies to TABLE2 OF POWERS %CONSTLONGREAL Ten to the 305 = R'7F423A516E82D9BA' %CONSTLONGREAL Ten to the Minus 305 = R'009C16C5C5253575' %FINISHELSESTART %IF HOST= Sun3 %AND FP Chip# M68881 %THENSTART ! ! ! DEFINE REAL CONSTANTS DIRECTLY IN IEEE STANDARD ! ! %CONSTLONGREALARRAY TABLE1 OF POWERS ( 0: 122)= %C %C {This table was derived from the FTENTOX instruction} %C { on the M68881 floating point chip and should be } %C { used on M68000 hardware which does not have a } %C { M68881 coprocessor. } %C %C {10.0 ** -305} R'009C16C5C5253575' , {10.0 ** -300} R'01A56E1FC2F8F359' , {10.0 ** -295} R'02B059949B708F29' , {10.0 ** -290} R'03B8F2B061AEA071' , {10.0 ** -285} R'04C308A831868AC9' , {10.0 ** -280} R'05CD0B15A491EB84' , {10.0 ** -275} R'06D62884F31E93FF' , {10.0 ** -270} R'07E0E7C9EEBC444A' , {10.0 ** -265} R'08E9CBAE7FE805B3' , {10.0 ** -260} R'09F3AE3591F5B4D9' , {10.0 ** -255} R'0AFE07B27DD78B14' , {10.0 ** -250} R'0C06E93F5DA2824C' , {10.0 ** -245} R'0D117AD428200C08' , {10.0 ** -240} R'0E1AAC0BF9B9E65C' , {10.0 ** -235} R'0F245962E2F6A490' , {10.0 ** -230} R'102F0CE4839198DB' , {10.0 ** -225} R'1137B08617A104EE' , {10.0 ** -220} R'124212DD4DE70913' , {10.0 ** -215} R'134B9408EEFEA839' , {10.0 ** -210} R'14550A6110D6A9B8' , {10.0 ** -205} R'15600D7B2E28C65C' , {10.0 ** -200} R'16687E92154EF7AC' , {10.0 ** -195} R'1772B010D3E1CF55' , {10.0 ** -190} R'187C83E7AD4E6EFE' , {10.0 ** -185} R'1985C162B168E70E' , {10.0 ** -180} R'1A90991A9BFA58C8' , {10.0 ** -175} R'1B99539E3A40DFB8' , {10.0 ** -170} R'1CA3529BA7D19EAF' , {10.0 ** -165} R'1DAD7BECC2F23AC2' , {10.0 ** -160} R'1EB67E9C127B6E74' , {10.0 ** -155} R'1FC1297872D9CBB5' , {10.0 ** -150} R'20CA2FE76A3F9475' , {10.0 ** -145} R'21D3FAAC3E3FA1F3' , {10.0 ** -140} R'22DE7C5F127BD87E' , {10.0 ** -135} R'23E7424348CA1C9C' , {10.0 ** -130} R'24F1BEBDF578B2F4' , {10.0 ** -125} R'25FB13AC9AAF4C0F' , {10.0 ** -120} R'2704A8729FC3DDB7' , {10.0 ** -115} R'280F8587E7083E30' , {10.0 ** -110} R'29180C903F7379F2' , {10.0 ** -105} R'2A225915CD68C9F9' , {10.0 ** -100} R'2B2BFF2EE48E0530' , {10.0 ** -95 } R'2C355C2076BF9A55' , {10.0 ** -90 } R'2D404BD984990E6F' , {10.0 ** -85 } R'2E48DDBCC7F40BA6' , {10.0 ** -80 } R'2F52F8AC174D6123' , {10.0 ** -75 } R'305CF2B1970E7258' , {10.0 ** -70 } R'316615E91D8F359D' , {10.0 ** -65 } R'3270D9976A5D5297' , {10.0 ** -60 } R'3379B604AAACA626' , {10.0 ** -55 } R'34839DAE6F76D883' , {10.0 ** -50 } R'358DEE7A4AD4B81F' , {10.0 ** -45 } R'3696D601AD376AB9' , {10.0 ** -40 } R'37A16C262777579C' , {10.0 ** -35 } R'38AA95A5B7F87A0F' , {10.0 ** -30 } R'39B4484BFEEBC2A0' , {10.0 ** -25 } R'3ABEF2D0F5DA7DD9' , {10.0 ** -20 } R'3BC79CA10C924223' , {10.0 ** -15 } R'3CD203AF9EE75616' , {10.0 ** -10 } R'3DDB7CDFD9D7BDBB' , {10.0 ** -5 } R'3EE4F8B588E368F1' , {10.0 ** 0 } R'3FF0000000000000' , {10.0 ** 5 } R'40F86A0000000000' , {10.0 ** 10 } R'4202A05F20000000' , {10.0 ** 15 } R'430C6BF526340000' , {10.0 ** 20 } R'4415AF1D78B58C40' , {10.0 ** 25 } R'45208B2A2C280291' , {10.0 ** 30 } R'46293E5939A08CEA' , {10.0 ** 35 } R'4733426172C74D82' , {10.0 ** 40 } R'483D6329F1C35CA5' , {10.0 ** 45 } R'49466BB7F0435C9E' , {10.0 ** 50 } R'4A511B0EC57E649A' , {10.0 ** 55 } R'4B5A19E96A19FC41' , {10.0 ** 60 } R'4C63E9E4E4C2F344' , {10.0 ** 65 } R'4D6E62C4E38FF872' , {10.0 ** 70 } R'4E772EBAD6DDC73D' , {10.0 ** 75 } R'4F81AFD6EC0E1411' , {10.0 ** 80 } R'508AFCEF51F0FB5F' , {10.0 ** 85 } R'5194971956342AC8' , {10.0 ** 90 } R'529F6B0F092959C7' , {10.0 ** 95 } R'53A7F85DE8AD5C4F' , {10.0 ** 100 } R'54B249AD2594C37D' , {10.0 ** 105 } R'55BBE7ABD3781ECA' , {10.0 ** 110 } R'56C54A3047C694FE' , {10.0 ** 115 } R'57D03E29F5C2B18C' , {10.0 ** 120 } R'58D8C8DAC6A0342A' , {10.0 ** 125 } R'59E2E8BD69AA19CC' , {10.0 ** 130 } R'5AECDA62055B2D9E' , {10.0 ** 135 } R'5BF6035CE8B6203D' , {10.0 ** 140 } R'5D00CB70D24B7379' , {10.0 ** 145 } R'5E09A06D06E26112' , {10.0 ** 150 } R'5F138D352E5096AF' , {10.0 ** 155 } R'601DD55745CBB7ED' , {10.0 ** 160 } R'6126C2D4256FFCC3' , {10.0 ** 165 } R'62315D847AD00088' , {10.0 ** 170 } R'633A7F5245E5A2CF' , {10.0 ** 175 } R'6444374374F3C2C6' , {10.0 ** 180 } R'654ED8D34E547314' , {10.0 ** 185 } R'665788CCB6B2CE0C' , {10.0 ** 190 } R'6761F48EAF234AD4' , {10.0 ** 195 } R'686B65CA37FD3A0D' , {10.0 ** 200 } R'6974E718D7D7625A' , {10.0 ** 205 } R'6A7FE52048590673' , {10.0 ** 210 } R'6B88557F31326BBC' , {10.0 ** 215 } R'6C9290BA9A38C7D2' , {10.0 ** 220 } R'6D9C5416BB92E3E6' , {10.0 ** 225 } R'6EA59CE797FB817F' , {10.0 ** 230 } R'6FB07D457124123D' , {10.0 ** 235 } R'70B9292615C3AA54' , {10.0 ** 240 } R'71C33234DE7AD7E3' , {10.0 ** 245 } R'72CD4A7BEBFA31AB' , {10.0 ** 250 } R'73D658E3AB795205' , {10.0 ** 255 } R'74E10CB132C2FF63' , {10.0 ** 260 } R'75EA03FDE214CAF1' , {10.0 ** 265 } R'76F3D92BA28C7D15' , {10.0 ** 270 } R'77FE494034E79E5C' , {10.0 ** 275 } R'79071B42CC5CF601' , {10.0 ** 280 } R'7A11A0FC668AAC70' , {10.0 ** 285 } R'7B1AE64521F7595E' , {10.0 ** 290 } R'7C2485CE9E7A065F' , {10.0 ** 295 } R'7D2F50AC6690F1F8' , {10.0 ** 300 } R'7E37E43C8800759C' , {10.0 ** 305 } R'7F423A516E82D9BA' ! ! !This table contains the Powers of Ten ! in the range 10**(-305) to 10**(305) ! in IEEE Standard form ! in double precision ! in steps of 5 ! these values are in IEEE format ! and are the exact constants obtained ! from the M68881 ftentox instruction %CONSTINTEGER B1= -( -305{the 1st power in TABLE1} // 5 {the step size}) ! !It is prefered if arrays start at subscript zero, and ! in bowing to this preference, yet still maintaining ! some level of readability this constant is added to ! any subscript value before accessing TABLE1 OF POWERS. %CONSTLONGREALARRAY TABLE2 OF POWERS ( 0: 10)= %C %C {10.0 ** -5 } R'3EE4F8B588E368F1' , {10.0 ** -4 } R'3F1A36E2EB1C432C' , {10.0 ** -3 } R'3F50624DD2F1A9FC' , {10.0 ** -2 } R'3F847AE147AE147B' , {10.0 ** -1 } R'3FB999999999999A' , {10.0 ** 0 } R'3FF0000000000000' , {10.0 ** 1 } R'4024000000000000' , {10.0 ** 2 } R'4059000000000000' , {10.0 ** 3 } R'408F400000000000' , {10.0 ** 4 } R'40C3880000000000' , {10.0 ** 5 } R'40F86A0000000000' ! ! !This table contains the Powers of Ten ! in the range 10**(-5) to 10**(5) %CONSTINTEGER B2= -( -5{which is the 1st power in TABLE2} ) ! !---as for B1 but applies to TABLE2 OF POWERS %CONSTLONGREAL Ten to the 305 = R'7F423A516E82D9BA' %CONSTLONGREAL Ten to the Minus 305 = R'009C16C5C5253575' %FINISHELSESTART %IF HOST= IBM %THENSTART ! ! ! DEFINE REAL CONSTANTS IN 'EXCESS 64' NOTATION ! ! !CONSTLONGLONGREALARRAY TABLE OF POWERS (-78:75)= {?} %C %C {10.0 ** -78} R'001DA48CE468E7C772026520247D3556' , {10.0 ** -77} R'011286D80EC190DC73617F3416CE4156' , {10.0 ** -76} R'01B94470938FA89B73CEF808E40E8D5B' , {10.0 ** -75} R'0273CAC65C39C96174615B058E891859' , {10.0 ** -74} R'03485EBBF9A41DDC75DCD8E37915AF38' , {10.0 ** -73} R'042D3B357C0692AA760A078E2BAD8D83' , {This } {10.0 ** -72} R'051C45016D841BAA774644B8DB4C7872' , {10.0 ** -71} R'0611AB20E472914A786BEAF3890FCB47' , {table } {10.0 ** -70} R'06B0AF48EC79ACE878372D835A9DF0C7' , {10.0 ** -69} R'076E6D8D93CC0C1179227C7218A2B67C' , {was } {10.0 ** -68} R'084504787C5F878A7AB58DC74F65B20E' , {10.0 ** -67} R'092B22CB4DBBB4B67BB1789C919F8F49' , {acquired } {10.0 ** -66} R'0A1AF5BF109550F27C2EEB61DB03B98D' , {10.0 ** -65} R'0B10D9976A5D52977D5D531D28E253F8' , {from } {10.0 ** -64} R'0BA87FEA27A539E97DA53F2398D747B3' , {10.0 ** -63} R'0C694FF258C744327E0747763F868CD0' , {PD Stephens} {10.0 ** -62} R'0D41D1F7777C8A9F7F448CA9E7B41802' , {10.0 ** -61} R'0E29233AAAADD6A3008AD7EA30D08F01' , {10.0 ** -60} R'0F19B604AAACA6260136C6F25E825961' , {10.0 ** -59} R'101011C2EAABE7D702E23C577B1177DD' , {via } {10.0 ** -58} R'10A0B19D2AB70E6E02D65B6ACEAEAE9D' , {10.0 ** -57} R'11646F023AB269050345F922C12D2D22' , {the } {10.0 ** -56} R'123EC56164AF81A3044BBBB5B8BC3C35' , {10.0 ** -55} R'13273B5CDEEDB106050F55519375A5A1' , {IBM } {10.0 ** -54} R'1418851A0B548EA306C99552FC298785' , {10.0 ** -53} R'14F53304714D926506DFD53DD99F4B30' , {Assembler. } {10.0 ** -52} R'15993FE2C6D07B7F07ABE546A8038EFE' , {10.0 ** -51} R'165FC7EDBC424D2F08CB6F4C2902395F' , {10.0 ** -50} R'173BDCF495A9703D09DF258F99A163DB' , {10.0 ** -49} R'18256A18DD89E6260AAB7779C004DE69' , {It } {10.0 ** -48} R'1917624F8A762FD80B2B2AAC18030B02' , {10.0 ** -47} R'19E9D71B689DDE710BAFAAB8F01E6E11' , {is } {10.0 ** -46} R'1A9226712162AB070C0DCAB3961304CA' , {10.0 ** -45} R'1B5B5806B4DDAAE40D689EB03DCBE2FF' , {claimed } {10.0 ** -44} R'1C391704310A8ACE0EC1632E269F6DDF' , {10.0 ** -43} R'1D23AE629EA696C10F38DDFCD823A4AB' , {to } {10.0 ** -42} R'1E164CFDA3281E3810C38ABE071646EB' , {10.0 ** -41} R'1EDF01E85F912E3710A36B6C46DEC52F' , {evaluate } {10.0 ** -40} R'1F8B61313BBABCE211C62323AC4B3B3E' , {10.0 ** -39} R'20571CBEC554B60D12BBD5F64BAF0507' , {exactly } {10.0 ** -38} R'213671F73B54F1C8139565B9EF4D6324' , {10.0 ** -37} R'2222073A8515171D145D5F9435905DF7' , {and } {10.0 ** -36} R'23154484932D2E72155A5BBCA17A3ABA' , {10.0 ** -35} R'23D4AD2DBFC3D0771587955E4EC64B45' , {round } {10.0 ** -34} R'2484EC3C97DA624A16B4BD5AF13BEF0B' , {10.0 ** -33} R'255313A5DEE87D6E17B0F658D6C57567' , {to } {10.0 ** -32} R'2633EC47AB514E65182E99F7863B6960' , {10.0 ** -31} R'272073ACCB12D0FF193D203AB3E521DC' , {128 } {10.0 ** -30} R'2814484BFEEBC29F1A863424B06F352A' , {10.0 ** -29} R'28CAD2F7F5359A3B1A3E096EE45813A0' , {bits. } {10.0 ** -28} R'297EC3DAF94180651B06C5E54EB70C44' , {10.0 ** -27} R'2A4F3A68DBC8F03F1C243BAF513267AB' , {10.0 ** -26} R'2B318481895D96271D76A54D92BF80CB' , {10.0 ** -25} R'2C1EF2D0F5DA7DD81EAA27507BB7B07F' , {It } {10.0 ** -24} R'2D1357C299A88EA71F6A58924D52CE4F' , {10.0 ** -23} R'2DC16D9A0095928A1F2775B7053C0F18' , {is } {10.0 ** -22} R'2E78E480405D7B962058A9926345896F' , {10.0 ** -21} R'2F4B8ED0283A6D3D21F769FB7E0B75E5' , {also } {10.0 ** -20} R'302F39421924844622BAA23D2EC729AF' , {10.0 ** -19} R'311D83C94FB6D2AC2334A5663D3C7A0E' , {claimed } {10.0 ** -18} R'3212725DD1D243AB24A0E75FE645CC48' , {10.0 ** -17} R'32B877AA3236A4B4244909BEFEB9FAD5' , {to } {10.0 ** -16} R'33734ACA5F6226F025ADA6175F343CC5' , {10.0 ** -15} R'34480EBE7B9D5856266C87CE9B80A5FB' , {be } {10.0 ** -14} R'352D09370D4257362703D4E1213067BD' , {10.0 ** -13} R'361C25C26849768128C2650CB4BE40D6' , {fully } {10.0 ** -12} R'37119799812DEA1129197F27F0F6E886' , {10.0 ** -11} R'37AFEBFF0BCB24AA29FEF78F69A5153A' , {validated. } {10.0 ** -10} R'386DF37F675EF6EA2ADF5AB9A2072D44' , {10.0 ** -9} R'3944B82FA09B5A522BCB98B405447C4B' , {10.0 ** -8} R'3A2AF31DC46118732CBF3F70834ACDAF' , {10.0 ** -7} R'3B1AD7F29ABCAF482D5787A6520EC08D' , {10.0 ** -6} R'3C10C6F7A0B5ED8D2E36B4C7F3493858' , {10.0 ** -5} R'3CA7C5AC471B47842E230FCF80DC3372' , {10.0 ** -4} R'3D68DB8BAC710CB22F95E9E1B089A027' , {10.0 ** -3} R'3E4189374BC6A7EF309DB22D0E560419' , {10.0 ** -2} R'3F28F5C28F5C28F531C28F5C28F5C28F' , {10.0 ** -1} R'4019999999999999329999999999999A' , {10.0 ** 0} R'41100000000000003300000000000000' , {10.0 ** 1} R'41A00000000000003300000000000000' , {10.0 ** 2} R'42640000000000003400000000000000' , {10.0 ** 3} R'433E8000000000003500000000000000' , {10.0 ** 4} R'44271000000000003600000000000000' , {10.0 ** 5} R'45186A00000000003700000000000000' , {10.0 ** 6} R'45F42400000000003700000000000000' , {10.0 ** 7} R'46989680000000003800000000000000' , {10.0 ** 8} R'475F5E10000000003900000000000000' , {10.0 ** 9} R'483B9ACA000000003A00000000000000' , {10.0 ** 10} R'492540BE400000003B00000000000000' , {10.0 ** 11} R'4A174876E80000003C00000000000000' , {10.0 ** 12} R'4AE8D4A5100000003C00000000000000' , {10.0 ** 13} R'4B9184E72A0000003D00000000000000' , {10.0 ** 14} R'4C5AF3107A4000003E00000000000000' , {10.0 ** 15} R'4D38D7EA4C6800003F00000000000000' , {10.0 ** 16} R'4E2386F26FC100004000000000000000' , {10.0 ** 17} R'4F16345785D8A0004100000000000000' , {10.0 ** 18} R'4FDE0B6B3A7640004100000000000000' , {10.0 ** 19} R'508AC7230489E8004200000000000000' , {10.0 ** 20} R'5156BC75E2D631004300000000000000' , {10.0 ** 21} R'523635C9ADC5DEA04400000000000000' , {10.0 ** 22} R'5321E19E0C9BAB244500000000000000' , {10.0 ** 23} R'54152D02C7E14AF64680000000000000' , {10.0 ** 24} R'54D3C21BCECCEDA14600000000000000' , {10.0 ** 25} R'558459516140148447A0000000000000' , {10.0 ** 26} R'5652B7D2DCC80CD248E4000000000000' , {10.0 ** 27} R'5733B2E3C9FD080349CE800000000000' , {10.0 ** 28} R'58204FCE5E3E25024A61100000000000' , {10.0 ** 29} R'591431E0FAE6D7214B7CAA0000000000' , {10.0 ** 30} R'59C9F2C9CD04674E4BDEA40000000000' , {10.0 ** 31} R'5A7E37BE2022C0914C4B268000000000' , {10.0 ** 32} R'5B4EE2D6D415B85A4DCEF81000000000' , {10.0 ** 33} R'5C314DC6448D93384EC15B0A00000000' , {10.0 ** 34} R'5D1ED09BEAD87C034F78D8E640000000' , {10.0 ** 35} R'5E13426172C74D82502B878FE8000000' , {10.0 ** 36} R'5EC097CE7BC9071550B34B9F10000000' , {10.0 ** 37} R'5F785EE10D5DA46D51900F436A000000' , {10.0 ** 38} R'604B3B4CA85A86C4527A098A22400000' , {10.0 ** 39} R'612F050FE938943A53CC45F655680000' , {10.0 ** 40} R'621D6329F1C35CA454BFABB9F5610000' , {10.0 ** 41} R'63125DFA371A19E655F7CB54395CA000' , {10.0 ** 42} R'63B7ABC62705030555ADF14A3D9E4000' , {10.0 ** 43} R'6472CB5BD86321E3568CB6CE6682E800' , {10.0 ** 44} R'6547BF19673DF52E5737F2410011D100' , {10.0 ** 45} R'662CD76FE086B93C58E2F768A00B22A0' , {10.0 ** 46} R'671C06A5EC5433C6590DDAA16406F5A4' , {10.0 ** 47} R'68118427B3B4A05B5AC8A8A4DE845987' , {10.0 ** 48} R'68AF298D050E43955AD69670B12B7F41' , {10.0 ** 49} R'696D79F82328EA3D5BA61E066EBB2F89' , {10.0 ** 50} R'6A446C3B15F992665C87D2C40534FDB5' , {10.0 ** 51} R'6B2AC3A4EDBBFB805D14E3BA83411E91' , {10.0 ** 52} R'6C1ABA4714957D305E0D0E549208B31B' , {10.0 ** 53} R'6D10B46C6CDD6E3E5F0828F4DB456FF1' , {10.0 ** 54} R'6DA70C3C40A64E6C5F51999090B65F68' , {10.0 ** 55} R'6E6867A5A867F10360B2FFFA5A71FBA1' , {10.0 ** 56} R'6F4140C78940F6A2614FDFFC78873D45' , {10.0 ** 57} R'7028C87CB5C89A256271EBFDCB54864B' , {10.0 ** 58} R'71197D4DF19D60576367337E9F14D3EF' , {10.0 ** 59} R'71FEE50B7025C36A630802F236D04754' , {10.0 ** 60} R'729F4F2726179A22644501D762422C94' , {10.0 ** 61} R'7363917877CEC055656B21269D695BDD' , {10.0 ** 62} R'743E3AEB4AE138356662F4B82261D96A' , {10.0 ** 63} R'7526E4D30ECCC321675DD8F3157D27E2' , {10.0 ** 64} R'76184F03E93FF9F468DAA797ED6E38ED' , {10.0 ** 65} R'76F316271C7FC390688A8BEF464E3946' , {10.0 ** 66} R'7797EDD871CFDA3A695697758BF0E3CC' , {10.0 ** 67} R'785EF4A74721E8646A761EA977768E5F' , {10.0 ** 68} R'793B58E88C75313E6BC9D329EAAA18FC' , {10.0 ** 69} R'7A25179157C93EC76C3E23FA32AA4F9D' , {10.0 ** 70} R'7B172EBAD6DDC73C6D86D67C5FAA71C2' , {10.0 ** 71} R'7BE7D34C64A9C85D6D4460DBBCA87197' , {10.0 ** 72} R'7C90E40FBEEA1D3A6E4ABC8955E946FE' , {10.0 ** 73} R'7D5A8E89D75252446F6EB5D5D5B1CC5F' , {10.0 ** 74} R'7E3899162693736A70C531A5A58F1FBB' , {10.0 ** 75} R'7F235FADD81C282271BB3F07877973D5' !CONSTLONGLONGREAL Ten to the 75= R'7F235FADD81C282271BB3F07877973D5' !CONSTLONGLONGREAL Ten to the %C Minus 74= R'03485EBBF9A41DDC75DCD8E37915AF38' %FINISHELSESTART %IF HOST= Gould %OR HOST= VNS %THENSTART ! ! ! DEFINE DOUBLE PRECISION REAL CONSTANTS IN 'EXCESS 64' NOTATION ! ! %CONSTLONGREALARRAY TABLE OF POWERS (-78:75)= %C %C {10.0 ** -78} R'001DA48CE468E7C7' , {10.0 ** -77} R'011286D80EC190DC' , {10.0 ** -76} R'01B94470938FA89C' , {10.0 ** -75} R'0273CAC65C39C961' , {10.0 ** -74} R'03485EBBF9A41DDD' , {10.0 ** -73} R'042D3B357C0692AA' , {10.0 ** -72} R'051C45016D841BAA' , {10.0 ** -71} R'0611AB20E472914A' , {10.0 ** -70} R'06B0AF48EC79ACE8' , {10.0 ** -69} R'076E6D8D93CC0C11' , {10.0 ** -68} R'084504787C5F878B' , {10.0 ** -67} R'092B22CB4DBBB4B7' , {10.0 ** -66} R'0A1AF5BF109550F2' , {10.0 ** -65} R'0B10D9976A5D5297' , {10.0 ** -64} R'0BA87FEA27A539EB' , {10.0 ** -63} R'0C694FF258C74432' , {10.0 ** -62} R'0D41D1F7777C8A9F' , {10.0 ** -61} R'0E29233AAAADD6A4' , {10.0 ** -60} R'0F19B604AAACA626' , {10.0 ** -59} R'101011C2EAABE7D8' , {10.0 ** -58} R'10A0B19D2AB70E6F' , {10.0 ** -57} R'11646F023AB26905' , {10.0 ** -56} R'123EC56164AF81A3' , {10.0 ** -55} R'13273B5CDEEDB106' , {10.0 ** -54} R'1418851A0B548EA4' , {10.0 ** -53} R'14F53304714D9266' , {10.0 ** -52} R'15993FE2C6D07B80' , {10.0 ** -51} R'165FC7EDBC424D30' , {10.0 ** -50} R'173BDCF495A9703E' , {10.0 ** -49} R'18256A18DD89E627' , {10.0 ** -48} R'1917624F8A762FD8' , {10.0 ** -47} R'19E9D71B689DDE72' , {10.0 ** -46} R'1A9226712162AB07' , {10.0 ** -45} R'1B5B5806B4DDAAE4' , {10.0 ** -44} R'1C391704310A8ACF' , {10.0 ** -43} R'1D23AE629EA696C1' , {10.0 ** -42} R'1E164CFDA3281E39' , {10.0 ** -41} R'1EDF01E85F912E38' , {10.0 ** -40} R'1F8B61313BBABCE3' , {10.0 ** -39} R'20571CBEC554B60E' , {10.0 ** -38} R'213671F73B54F1C9' , {10.0 ** -37} R'2222073A8515171D' , {10.0 ** -36} R'23154484932D2E72' , {10.0 ** -35} R'23D4AD2DBFC3D078' , {10.0 ** -34} R'2484EC3C97DA624B' , {10.0 ** -33} R'255313A5DEE87D6F' , {10.0 ** -32} R'2633EC47AB514E65' , {10.0 ** -31} R'272073ACCB12D0FF' , {10.0 ** -30} R'2814484BFEEBC2A0' , {10.0 ** -29} R'28CAD2F7F5359A3B' , {10.0 ** -28} R'297EC3DAF9418065' , {10.0 ** -27} R'2A4F3A68DBC8F03F' , {10.0 ** -26} R'2B318481895D9627' , {10.0 ** -25} R'2C1EF2D0F5DA7DD9' , {10.0 ** -24} R'2D1357C299A88EA7' , {10.0 ** -23} R'2DC16D9A0095928A' , {10.0 ** -22} R'2E78E480405D7B96' , {10.0 ** -21} R'2F4B8ED0283A6D3E' , {10.0 ** -20} R'302F394219248447' , {10.0 ** -19} R'311D83C94FB6D2AC' , {10.0 ** -18} R'3212725DD1D243AC' , {10.0 ** -17} R'32B877AA3236A4B4' , {10.0 ** -16} R'33734ACA5F6226F1' , {10.0 ** -15} R'34480EBE7B9D5856' , {10.0 ** -14} R'352D09370D425736' , {10.0 ** -13} R'361C25C268497682' , {10.0 ** -12} R'37119799812DEA11' , {10.0 ** -11} R'37AFEBFF0BCB24AB' , {10.0 ** -10} R'386DF37F675EF6EB' , {10.0 ** -9} R'3944B82FA09B5A53' , {10.0 ** -8} R'3A2AF31DC4611874' , {10.0 ** -7} R'3B1AD7F29ABCAF48' , {10.0 ** -6} R'3C10C6F7A0B5ED8D' , {10.0 ** -5} R'3CA7C5AC471B4784' , {10.0 ** -4} R'3D68DB8BAC710CB3' , {10.0 ** -3} R'3E4189374BC6A7F0' , {10.0 ** -2} R'3F28F5C28F5C28F6' , {10.0 ** -1} R'401999999999999A' , {10.0 ** 0} R'4110000000000000' , {10.0 ** 1} R'41A0000000000000' , {10.0 ** 2} R'4264000000000000' , {10.0 ** 3} R'433E800000000000' , {10.0 ** 4} R'4427100000000000' , {10.0 ** 5} R'45186A0000000000' , {10.0 ** 6} R'45F4240000000000' , {10.0 ** 7} R'4698968000000000' , {10.0 ** 8} R'475F5E1000000000' , {10.0 ** 9} R'483B9ACA00000000' , {10.0 ** 10} R'492540BE40000000' , {10.0 ** 11} R'4A174876E8000000' , {10.0 ** 12} R'4AE8D4A510000000' , {10.0 ** 13} R'4B9184E72A000000' , {10.0 ** 14} R'4C5AF3107A400000' , {10.0 ** 15} R'4D38D7EA4C680000' , {10.0 ** 16} R'4E2386F26FC10000' , {10.0 ** 17} R'4F16345785D8A000' , {10.0 ** 18} R'4FDE0B6B3A764000' , {10.0 ** 19} R'508AC7230489E800' , {10.0 ** 20} R'5156BC75E2D63100' , {10.0 ** 21} R'523635C9ADC5DEA0' , {10.0 ** 22} R'5321E19E0C9BAB24' , {10.0 ** 23} R'54152D02C7E14AF7' , {10.0 ** 24} R'54D3C21BCECCEDA1' , {10.0 ** 25} R'5584595161401485' , {10.0 ** 26} R'5652B7D2DCC80CD3' , {10.0 ** 27} R'5733B2E3C9FD0804' , {10.0 ** 28} R'58204FCE5E3E2502' , {10.0 ** 29} R'591431E0FAE6D721' , {10.0 ** 30} R'59C9F2C9CD04674F' , {10.0 ** 31} R'5A7E37BE2022C091' , {10.0 ** 32} R'5B4EE2D6D415B85B' , {10.0 ** 33} R'5C314DC6448D9339' , {10.0 ** 34} R'5D1ED09BEAD87C03' , {10.0 ** 35} R'5E13426172C74D82' , {10.0 ** 36} R'5EC097CE7BC90716' , {10.0 ** 37} R'5F785EE10D5DA46E' , {10.0 ** 38} R'604B3B4CA85A86C4' , {10.0 ** 39} R'612F050FE938943B' , {10.0 ** 40} R'621D6329F1C35CA5' , {10.0 ** 41} R'63125DFA371A19E7' , {10.0 ** 42} R'63B7ABC627050306' , {10.0 ** 43} R'6472CB5BD86321E4' , {10.0 ** 44} R'6547BF19673DF52E' , {10.0 ** 45} R'662CD76FE086B93D' , {10.0 ** 46} R'671C06A5EC5433C6' , {10.0 ** 47} R'68118427B3B4A05C' , {10.0 ** 48} R'68AF298D050E4396' , {10.0 ** 49} R'696D79F82328EA3E' , {10.0 ** 50} R'6A446C3B15F99267' , {10.0 ** 51} R'6B2AC3A4EDBBFB80' , {10.0 ** 52} R'6C1ABA4714957D30' , {10.0 ** 53} R'6D10B46C6CDD6E3E' , {10.0 ** 54} R'6DA70C3C40A64E6C' , {10.0 ** 55} R'6E6867A5A867F104' , {10.0 ** 56} R'6F4140C78940F6A2' , {10.0 ** 57} R'7028C87CB5C89A25' , {10.0 ** 58} R'71197D4DF19D6057' , {10.0 ** 59} R'71FEE50B7025C36A' , {10.0 ** 60} R'729F4F2726179A22' , {10.0 ** 61} R'7363917877CEC055' , {10.0 ** 62} R'743E3AEB4AE13835' , {10.0 ** 63} R'7526E4D30ECCC321' , {10.0 ** 64} R'76184F03E93FF9F5' , {10.0 ** 65} R'76F316271C7FC391' , {10.0 ** 66} R'7797EDD871CFDA3A' , {10.0 ** 67} R'785EF4A74721E864' , {10.0 ** 68} R'793B58E88C75313F' , {10.0 ** 69} R'7A25179157C93EC7' , {10.0 ** 70} R'7B172EBAD6DDC73D' , {10.0 ** 71} R'7BE7D34C64A9C85D' , {10.0 ** 72} R'7C90E40FBEEA1D3A' , {10.0 ** 73} R'7D5A8E89D7525244' , {10.0 ** 74} R'7E3899162693736B' , {10.0 ** 75} R'7F235FADD81C2823' ! !This table was derived from the ! IBM Table of Powers of Ten above %CONSTLONGREAL Ten to the 75= R'7F235FADD81C2823' %CONSTLONGREAL Ten to the %C Minus 74= R'03485EBBF9A41DDD' %FINISH !if Gould or VNS %FINISH; !if not Amdahl %FINISH; !if not Sun3 with no M68881 %FINISH; !if not an IEEE HOST %EXTERNALLONGLONGREALFN POWER OF TEN {%ALIAS "S#POWEROFTEN" if Amdahl} {?} %C (%INTEGER EXP) ! ! ! ! ! A GLOBAL PROCEDURE WHICH RETURNS A GIVEN POWER ! ! OF TEN IN DOUBLE PRECISION IEEE FORM. ! ! ! %INTEGER I,J %if HOST= Sun3 %and FP Chip= M68881 %thenstart ! replaces table lookup by using on chip ! function (on m68881) to get power of ten *put_ {ftentoxl a6@(8),fp0} x'f22e' *put_ x'4012' *put_ x'8' *put_ {unlk a6} x'4e5e' *put_ {rts} x'4e75' %finishelsestart %IF HOST=Gould %ORC HOST= VNS %ORC HOST= IBM %THENRESULT= TABLE OF POWERS (EXP) %C %ELSESTART I = EXP // 5 J = EXP - (I*5) ! %IF I # 0 %THENRESULT= TABLE1 OF POWERS (I+B1) * TABLE2 OF POWERS (J+B2) %C %ELSERESULT= TABLE2 OF POWERS (J+B2) %FINISH %finish %END; !of POWER OF TEN ! ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. ! %if HOST= Sun3 %and FP Chip= M68881 %thenstart %EXTERNALLONGLONGREALFN INTO RANGE (%LONGLONGREAL X, %INTEGERNAME EXP) ! ! ! ! A PROCEDURE WHICH BRINGS THE VALUE OF THE GIVEN ! ! PARAMETER INTO THE RANGE 10.0> X >=1.0 ! ! !Additionally, the variable EXP is changed to reflect the ! magnitude (scale of 10) of the parameter. ! ! *put_ {fmovex fp2,a7@-} x'f227' *put_ x'6900' *put_ {fmoved a6@(8),fp0} x'f22e' *put_ x'5400' *put_ x'0008' *put_ {movl a6@(0x10),a0} x'206e' *put_ x'0010' *put_ {flog10x fp0,fp2} x'f200' *put_ x'0115' *put_ {fintrzx fp2,fp2} x'f200' {round log toward zero} *put_ x'0903' *put_ {ftentoxx fp2,fp1} x'f200' *put_ x'0892' *put_ {fcmpx fp1,fp0} x'f200' {if arg1=rounded result} *put_ x'0420' *put_ {faddl a0@,fp2} x'f210' {calculate exp} *put_ x'4122' *put_ {fmovel fp2,a0@} x'f210' *put_ x'6100' *put_ {fmovex a7@+,fp2} x'f21f' *put_ x'4900' *put_ {unlk a6} x'4e5e' *put_ {rts} x'4e75' %end; !of INTO RANGE (if Sun3 with MC68881) ! ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. ! %FINISHELSESTART %IF HOST= IBM %OR HOST= Gould %OR HOST= VNS %THENSTART %EXTERNALLONGLONGREALFN INTO RANGE {%ALIAS "S#INTORANGE" if IBM} {?} %C (%LONGLONGREAL X, %INTEGERNAME EXP) ! ! ! ! A PROCEDURE WHICH BRINGS THE VALUE OF THE GIVEN ! ! PARAMETER INTO THE RANGE 10.0> X >=1.0 ! ! !Additionally, the variable EXP is changed to reflect the ! magnitude (scale of 10) of the parameter. ! ! %INTEGER I; !a work variable %IF X>=10.0 %THENSTART ! ! The value is too large ! %IF X>=Ten to the 75 %THEN I=75 %ELSESTART {ELSE } I= 2 {find the scale of} I=I+1 %WHILE X>= TABLE OF POWERS(I) { the value } I=I-1 %FINISH; X =X/TABLE OF POWERS(I) EXP = EXP+I %FINISH %IF X<1.0 %THENSTART ! ! The value is too small ! X=X*10.0 %AND EXP=EXP-1 %WHILE X X >=1.0 ! ! !Note that there are two steps in scaling the value, the first is ! to bring it into the range 10.0**(5) - 10.0**(-5), and the ! second step to bring it into the range 10.0**( 1) - 10.0**(0). ! ! ! %INTEGER I,J %IF X>= 10.0 %THENSTART ! ! ! The Value is too Large ! ! %IF X< Ten to the 305 %THENSTART ! ! Bring the Value down to below 10(** 5) ! I= 1+B1 I= I+1 %WHILE X>= TABLE1 OF POWERS (I) I= I-1 %FINISHELSE {if X>= Ten to the 305} I= (305//5)+B1 {=122} X = X/TABLE1 OF POWERS (I) ! ! Now bring the value down to the range 10**1 - 10**0 ! J= 0+B2 J= J+1 %WHILE X>= TABLE2 OF POWERS (J) J= J-1 %AND X =X/TABLE2 OF POWERS (J) EXP= EXP + (I*5) + J - (B1*5 + B2) %FINISH {- correction factor as arrays start at 0} %IF X< 1.0 %THENSTART ! ! ! The Value is too Small ! ! %IF X= TABLE2 OF POWERS ( J) J=J-1 %AND X=X*TABLE2 OF POWERS (-J+B2+B2) EXP=EXP + (I*5) + J - (B1*5 + B2) %FINISH {- correction factor as arrays start at 0} ! ! Return ! %RESULT= X %END; !of INTO RANGE (if IEEE) ! ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. ! %FINISH %FINISH %IF HOST= Gould %THENSTART %EXTERNALLONGREALFN SCALE BY TEN (%LONGREAL X, %INTEGER SCALE) ! ! ! ! ! A GLOBAL PROCEDURE TO SCALE A LONGREAL BY A SPECIFIED ! ! OF TEN RETAINING AS MUCH ACCURACY AS POSSIBLE. ! ! !On GOULD Powernode machines, the hardware drops the last nibble !in double precision multiplications and division resulting in !inaccurate conversions from character to binary. This procedure !make two numbers out of the parameter and the required power of !ten and returns the sum of the four-way product of the individual !components. ! ! For Example: 1234 * 5678= (1200*5600) + (1200*78) ! + ( 34*5600) + ( 34*78) ! !---Assumptions: ! ! %c (a). will be called by IN NUMBER, hence %c (b). will not be called with zero %c (c). double precision parameter will be unsigned %LONGREAL POWERa {first/main component of MULTIPLE OF TEN} %LONGREAL POWERb { second component of MULTIPLE OF TEN} %LONGREAL PARAMa {first/main component of parameter} %LONGREAL PARAMb { second component of parameter} ! !Note: PARAMa is accurate and is in the range: 10 ** 9 <---> 1 ! PARAMb is accurate and is in the range: 10 ** 3 <---> 10 ** -6 ! POWERa is accurate and could be any value (but not zero) ! POWERb is NOT accurate and could be any value (including zero) %LONGREAL PART1 {parama * powera} %LONGREAL PART2 {parama * powerb} %LONGREAL PART3 {paramb * powera} %LONGREAL PART4 {paramb * powerb} %OWNLONGREAL ROUNDING= R'0000000000000008' !The exponent is filled by subtracting 1 from the exponent of PART1 !The rounding is added to PART2 prior to adding it to PART1 %CONSTLONGREALARRAY ADDITIONAL PRECISION (-78:75)= %C %C {10.0 ** -78} R'0000000000000000' , {10.0 ** -77} R'0000000000000000' , {10.0 ** -76} R'0000000000000000' , {10.0 ** -75} R'0000000000000000' , {10.0 ** -74} R'0000000000000000' , {10.0 ** -73} R'0000000000000000' , {10.0 ** -72} R'0000000000000000' , {10.0 ** -71} R'0000000000000000' , {10.0 ** -70} R'0000000000000000' , {10.0 ** -69} R'0000000000000000' , {10.0 ** -68} R'0000000000000000' , {10.0 ** -67} R'0000000000000000' , {10.0 ** -66} R'0000000000000000' , {10.0 ** -65} R'0000000000000000' , {10.0 ** -64} R'0000000000000000' , {10.0 ** -63} R'0000000000000000' , {10.0 ** -62} R'0000000000000000' , {10.0 ** -61} R'FF8AD7EA30D08F01' , {10.0 ** -60} R'0136C6F25E825961' , {10.0 ** -59} R'FDE23C577B1177DD' , {10.0 ** -58} R'FDD65B6B00000000' , {10.0 ** -57} R'0345F92300000000' , {10.0 ** -56} R'044BBBB600000000' , {10.0 ** -55} R'04F55519375A5A10' , {10.0 ** -54} R'F9C9955300000000' , {10.0 ** -53} R'F9DFD53E00000000' , {10.0 ** -52} R'F8ABE54700000000' , {10.0 ** -51} R'F7CB6F4C2902395F' , {10.0 ** -50} R'F6DF258F99A163DB' , {10.0 ** -49} R'F5AB777A00000000' , {10.0 ** -48} R'0B2B2AAC18030B02' , {10.0 ** -47} R'F4AFAAB900000000' , {10.0 ** -46} R'0BDCAB3961304CA0' , {10.0 ** -45} R'0D689EB03DCBE2FF' , {10.0 ** -44} R'F1C1632E269F6DDF' , {10.0 ** -43} R'0F38DDFD00000000' , {10.0 ** -42} R'EFC38ABE071646EB' , {10.0 ** -41} R'EFA36B6C46DEC52F' , {10.0 ** -40} R'EEC6232400000000' , {10.0 ** -39} R'EDBBD5F64BAF0507' , {10.0 ** -38} R'EC9565BA00000000' , {10.0 ** -37} R'145D5F9435905DF7' , {10.0 ** -36} R'155A5BBD00000000' , {10.0 ** -35} R'EA87955E4EC64B45' , {10.0 ** -34} R'E9B4BD5B00000000' , {10.0 ** -33} R'E8B0F69000000007' , {10.0 ** -32} R'182E99F7863B6960' , {10.0 ** -31} R'193D203AB3E521DC' , {10.0 ** -30} R'E586342500000000' , {10.0 ** -29} R'1A3E096F00000000' , {10.0 ** -28} R'1A6C5E5500000000' , {10.0 ** -27} R'1C243BAF513267AB' , {10.0 ** -26} R'1D76A54D92BF80CB' , {10.0 ** -25} R'E1AA27507BB7B07F' , {10.0 ** -24} R'1F6A58924D52CE4F' , {10.0 ** -23} R'1F2775B7053C0F18' , {10.0 ** -22} R'2058A9926345896F' , {10.0 ** -21} R'DF769F8000000000' , {10.0 ** -20} R'DDBAA23D2EC729AF' , {10.0 ** -19} R'2334A5663D3C7A0E' , {10.0 ** -18} R'DBA0E76000000000' , {10.0 ** -17} R'244909BF00000000' , {10.0 ** -16} R'DAADA6175F343CC5' , {10.0 ** -15} R'266C87CE9B80A5FB' , {10.0 ** -14} R'263D4E1213067BD0' , {10.0 ** -13} R'D7C2650CB4BE40D6' , {10.0 ** -12} R'29197F27F0F6E886' , {10.0 ** -11} R'D7EF78F69A5153A0' , {10.0 ** -10} R'D5DF5ABA00000000' , {10.0 ** -9} R'D4CB98B405447C4B' , {10.0 ** -8} R'D3BF3F70834ACDAF' , {10.0 ** -7} R'2D5787A6520EC08D' , {10.0 ** -6} R'2E36B4C800000000' , {10.0 ** -5} R'2E230FCF80DC3372' , {10.0 ** -4} R'D095E9E1B089A027' , {10.0 ** -3} R'CF9DB22E00000000' , {10.0 ** -2} R'CEC28F5C28F5C28F' , {10.0 ** -1} R'CD99999A00000000' , {10.0 ** 0} R'0000000000000000' , {10.0 ** 1} R'0000000000000000' , {10.0 ** 2} R'0000000000000000' , {10.0 ** 3} R'0000000000000000' , {10.0 ** 4} R'0000000000000000' , {10.0 ** 5} R'0000000000000000' , {10.0 ** 6} R'0000000000000000' , {10.0 ** 7} R'0000000000000000' , {10.0 ** 8} R'0000000000000000' , {10.0 ** 9} R'0000000000000000' , {10.0 ** 10} R'0000000000000000' , {10.0 ** 11} R'0000000000000000' , {10.0 ** 12} R'0000000000000000' , {10.0 ** 13} R'0000000000000000' , {10.0 ** 14} R'0000000000000000' , {10.0 ** 15} R'0000000000000000' , {10.0 ** 16} R'0000000000000000' , {10.0 ** 17} R'0000000000000000' , {10.0 ** 18} R'0000000000000000' , {10.0 ** 19} R'0000000000000000' , {10.0 ** 20} R'0000000000000000' , {10.0 ** 21} R'0000000000000000' , {10.0 ** 22} R'0000000000000000' , {10.0 ** 23} R'B980000000000000' , {10.0 ** 24} R'0000000000000000' , {10.0 ** 25} R'B8A0000000000000' , {10.0 ** 26} R'B7E4000000000000' , {10.0 ** 27} R'B6CE800000000000' , {10.0 ** 28} R'4A61100000000000' , {10.0 ** 29} R'4B7CAA0000000000' , {10.0 ** 30} R'B4DEA40000000000' , {10.0 ** 31} R'4C4B268000000000' , {10.0 ** 32} R'B2CEF81000000000' , {10.0 ** 33} R'B1C15B0A00000000' , {10.0 ** 34} R'4F78D8E640000000' , {10.0 ** 35} R'502B878FE8000000' , {10.0 ** 36} R'AFB34B9F10000000' , {10.0 ** 37} R'AE900F4370000000' , {10.0 ** 38} R'527A098A22400000' , {10.0 ** 39} R'ACCC45F655680000' , {10.0 ** 40} R'ABBFABBA00000000' , {10.0 ** 41} R'AB7CB54395CA0000' , {10.0 ** 42} R'AAADF14A3D9E4000' , {10.0 ** 43} R'A98CB6CE6682E800' , {10.0 ** 44} R'5737F2410011D100' , {10.0 ** 45} R'A7E2F76900000000' , {10.0 ** 46} R'58DDAA16406F5A40' , {10.0 ** 47} R'A5C8A8A500000000' , {10.0 ** 48} R'A5D69670B12B7F41' , {10.0 ** 49} R'A4A61E066EBB2F89' , {10.0 ** 50} R'A387D2C40534FDB5' , {10.0 ** 51} R'5D14E3BA83411E91' , {10.0 ** 52} R'5DD0E549208B31B0' , {10.0 ** 53} R'5E828FE000000000' , {10.0 ** 54} R'5F51999090B65F68' , {10.0 ** 55} R'9FB2FFFA5A71FBA1' , {10.0 ** 56} R'614FDFFC78873D45' , {10.0 ** 57} R'6271EBFE00000000' , {10.0 ** 58} R'6367337E9F14D3EF' , {10.0 ** 59} R'62802F236D047540' , {10.0 ** 60} R'644501D762422C94' , {10.0 ** 61} R'656B21269D695BDD' , {10.0 ** 62} R'6662F4B82261D96A' , {10.0 ** 63} R'675DD8F3157D27E2' , {10.0 ** 64} R'97DAA79800000000' , {10.0 ** 65} R'978A8BEF464E3946' , {10.0 ** 66} R'695697758BF0E3CC' , {10.0 ** 67} R'6A761EA977768E5F' , {10.0 ** 68} R'94C9D32A00000000' , {10.0 ** 69} R'6C3E23FA32AA4F9D' , {10.0 ** 70} R'9286D67C5FAA71C2' , {10.0 ** 71} R'6D4460DC00000000' , {10.0 ** 72} R'6E4ABC8955E946FE' , {10.0 ** 73} R'6F6EB5D600000000' , {10.0 ** 74} R'8FC531A600000000' , {10.0 ** 75} R'8EBB3F07877973D5' ! ! !This table has be derived by subtracting the corresponding ! longlongreal power from the equivalent longreal power ! and hence each entry represents the additional ! precision which is not available in a longreal array ! of powers of ten. %RESULT= X %IF SCALE= 0 ! ! the code below has no effect if X is to be multiplied by 10 ** 0 !---Initialise Parameter: ! ! PARAMa= X PARAMb= PARAMa INTEGER(ADDR(PARAMa)+4)= 0 INTEGER(ADDR(PARAMb) )= INTEGER(ADDR(PARAMb)) & X'FF000000' PARAMb= PARAMb + 0.0 ! normalise PARAMa= X %IF PARAMb= 0.0 !---Initialise Power of Ten: ! ! POWERa= TABLE OF POWERS (SCALE) %IF SCALE >-72 %THENSTART POWERb= POWERa INTEGER(ADDR(POWERa)+4)= 0 INTEGER(ADDR(POWERb) )= INTEGER(ADDR(POWERb)) & X'FF000000' POWERb=(POWERb + 0.0) + ADDITIONAL PRECISION (SCALE) ! normalise and add in additional precision %FINISHELSESTART POWERb= 0 !if we were not to handle SCALE less than -71 as a special !case then POWERb would be an unnormalised number less than !the smallest floating point value. Such a value becomes !zero once it is normalised either prior to a multiplication !or after an addition and hence takes no further part in the !arithmetic within this procedure. Thus we treat SCALE less !than 71 as a special case by assigning the whole of the !power of ten to PARAMa. %FINISH !---Perform Arithmetic (if one of the components are zero): ! ! %IF PARAMb= 0.0 %THENSTART PART1= PARAMa * POWERa PART2= PARAMa * POWERb %FINISHELSESTART %IF POWERb= 0.0 %THENSTART PART1= PARAMa * POWERa PART2= PARAMb * POWERa %FINISHELSESTART !---Perform Arithmetic (if none of the components are zero): ! ! PART1= PARAMa * POWERa PART2= PARAMa * POWERb PART3= PARAMb * POWERa PART4= PARAMb * POWERb %IF PART2> PART3 %THEN PART2= PART2 + (PART3 + PART4) %C %ELSE PART2= PART3 + (PART2 + PART4) %FINISH %FINISH %IF PART2= 0.0 %THENSTART %IF X< 1.0 %THENRESULT= X * TABLE OF POWERS (SCALE) ! ! abandon extended precision if X< 1.0 (happens when we are scaling ! X down to a very small number and consequently SCALE will be in ! the range of -1 to -16) and if PART2= 0.0 (implies that its actual ! value is too small to be representable). ! ! continuing extended precision under these circumstances will only ! lose us substantial precision. %RESULT= PART1 %FINISH %IF Cpu= NP1 %THENRESULT= PART1 + PART2 %C %ELSESTART !---Apply Rounding to PART2 (only if Concept): ! ! BYTEINTEGER(ADDR(ROUNDING))= BYTEINTEGER(ADDR(PART1)) - 1 %RESULT= PART1 + (PART2 + ROUNDING) %FINISH %END; !of SCALE BY TEN ! ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. ! %FINISH; !if Gould %ENDOFFILE ! ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. !