Home » Archimedes archive » Acorn User » AU 1997-10 A.adf » Extras » Apple][e/PD/BOB/ARMBOB/!ArmBob/progs/h/power

Apple][e/PD/BOB/ARMBOB/!ArmBob/progs/h/power

This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.

Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.

Tape/disk: Home » Archimedes archive » Acorn User » AU 1997-10 A.adf » Extras
Filename: Apple][e/PD/BOB/ARMBOB/!ArmBob/progs/h/power
Read OK:
File size: 034F bytes
Load address: 0000
Exec address: 0000
File contents
/* exponentiate        GCW  12/01/95

   power(x,y) defined if
       #  y is a positive integer
       #  y is a negative integer and x is a nonzero real
       #  y is a real and x is a positive real
   result has same type as x.
*/

power(x,y)
{
 switch (typeof(y))
 {
  case REAL:
    if (x < 0.0) quit("Positive real argument needed");
    else return (x > 0.0)?(exp(y*log(x))):0.0;
    break;
  case INTEGER:
    switch (typeof(x))
    {
     case REAL:
        return (y < 0)?fastpower(1.0/x,-y):fastpower(x,y);
        break;
     case INTEGER:
        if (y < 0) quit("Positive exponent needed");
        else return fastpower(x,y);
        break;
     }
     break;
 }
}

fastpower(x,y)
{
 if (y == 0) return (typeof(x) == REAL)?1.0:1;
 if (y == 1) return x;
 if (y%2) return x*fastpower(x*x,y/2);
 else return fastpower(x*x, y/2);
}
   
00000000  2f 2a 20 65 78 70 6f 6e  65 6e 74 69 61 74 65 20  |/* exponentiate |
00000010  20 20 20 20 20 20 20 47  43 57 20 20 31 32 2f 30  |       GCW  12/0|
00000020  31 2f 39 35 0a 0a 20 20  20 70 6f 77 65 72 28 78  |1/95..   power(x|
00000030  2c 79 29 20 64 65 66 69  6e 65 64 20 69 66 0a 20  |,y) defined if. |
00000040  20 20 20 20 20 20 23 20  20 79 20 69 73 20 61 20  |      #  y is a |
00000050  70 6f 73 69 74 69 76 65  20 69 6e 74 65 67 65 72  |positive integer|
00000060  0a 20 20 20 20 20 20 20  23 20 20 79 20 69 73 20  |.       #  y is |
00000070  61 20 6e 65 67 61 74 69  76 65 20 69 6e 74 65 67  |a negative integ|
00000080  65 72 20 61 6e 64 20 78  20 69 73 20 61 20 6e 6f  |er and x is a no|
00000090  6e 7a 65 72 6f 20 72 65  61 6c 0a 20 20 20 20 20  |nzero real.     |
000000a0  20 20 23 20 20 79 20 69  73 20 61 20 72 65 61 6c  |  #  y is a real|
000000b0  20 61 6e 64 20 78 20 69  73 20 61 20 70 6f 73 69  | and x is a posi|
000000c0  74 69 76 65 20 72 65 61  6c 0a 20 20 20 72 65 73  |tive real.   res|
000000d0  75 6c 74 20 68 61 73 20  73 61 6d 65 20 74 79 70  |ult has same typ|
000000e0  65 20 61 73 20 78 2e 0a  2a 2f 0a 0a 70 6f 77 65  |e as x..*/..powe|
000000f0  72 28 78 2c 79 29 0a 7b  0a 20 73 77 69 74 63 68  |r(x,y).{. switch|
00000100  20 28 74 79 70 65 6f 66  28 79 29 29 0a 20 7b 0a  | (typeof(y)). {.|
00000110  20 20 63 61 73 65 20 52  45 41 4c 3a 0a 20 20 20  |  case REAL:.   |
00000120  20 69 66 20 28 78 20 3c  20 30 2e 30 29 20 71 75  | if (x < 0.0) qu|
00000130  69 74 28 22 50 6f 73 69  74 69 76 65 20 72 65 61  |it("Positive rea|
00000140  6c 20 61 72 67 75 6d 65  6e 74 20 6e 65 65 64 65  |l argument neede|
00000150  64 22 29 3b 0a 20 20 20  20 65 6c 73 65 20 72 65  |d");.    else re|
00000160  74 75 72 6e 20 28 78 20  3e 20 30 2e 30 29 3f 28  |turn (x > 0.0)?(|
00000170  65 78 70 28 79 2a 6c 6f  67 28 78 29 29 29 3a 30  |exp(y*log(x))):0|
00000180  2e 30 3b 0a 20 20 20 20  62 72 65 61 6b 3b 0a 20  |.0;.    break;. |
00000190  20 63 61 73 65 20 49 4e  54 45 47 45 52 3a 0a 20  | case INTEGER:. |
000001a0  20 20 20 73 77 69 74 63  68 20 28 74 79 70 65 6f  |   switch (typeo|
000001b0  66 28 78 29 29 0a 20 20  20 20 7b 0a 20 20 20 20  |f(x)).    {.    |
000001c0  20 63 61 73 65 20 52 45  41 4c 3a 0a 20 20 20 20  | case REAL:.    |
000001d0  20 20 20 20 72 65 74 75  72 6e 20 28 79 20 3c 20  |    return (y < |
000001e0  30 29 3f 66 61 73 74 70  6f 77 65 72 28 31 2e 30  |0)?fastpower(1.0|
000001f0  2f 78 2c 2d 79 29 3a 66  61 73 74 70 6f 77 65 72  |/x,-y):fastpower|
00000200  28 78 2c 79 29 3b 0a 20  20 20 20 20 20 20 20 62  |(x,y);.        b|
00000210  72 65 61 6b 3b 0a 20 20  20 20 20 63 61 73 65 20  |reak;.     case |
00000220  49 4e 54 45 47 45 52 3a  0a 20 20 20 20 20 20 20  |INTEGER:.       |
00000230  20 69 66 20 28 79 20 3c  20 30 29 20 71 75 69 74  | if (y < 0) quit|
00000240  28 22 50 6f 73 69 74 69  76 65 20 65 78 70 6f 6e  |("Positive expon|
00000250  65 6e 74 20 6e 65 65 64  65 64 22 29 3b 0a 20 20  |ent needed");.  |
00000260  20 20 20 20 20 20 65 6c  73 65 20 72 65 74 75 72  |      else retur|
00000270  6e 20 66 61 73 74 70 6f  77 65 72 28 78 2c 79 29  |n fastpower(x,y)|
00000280  3b 0a 20 20 20 20 20 20  20 20 62 72 65 61 6b 3b  |;.        break;|
00000290  0a 20 20 20 20 20 7d 0a  20 20 20 20 20 62 72 65  |.     }.     bre|
000002a0  61 6b 3b 0a 20 7d 0a 7d  0a 0a 66 61 73 74 70 6f  |ak;. }.}..fastpo|
000002b0  77 65 72 28 78 2c 79 29  0a 7b 0a 20 69 66 20 28  |wer(x,y).{. if (|
000002c0  79 20 3d 3d 20 30 29 20  72 65 74 75 72 6e 20 28  |y == 0) return (|
000002d0  74 79 70 65 6f 66 28 78  29 20 3d 3d 20 52 45 41  |typeof(x) == REA|
000002e0  4c 29 3f 31 2e 30 3a 31  3b 0a 20 69 66 20 28 79  |L)?1.0:1;. if (y|
000002f0  20 3d 3d 20 31 29 20 72  65 74 75 72 6e 20 78 3b  | == 1) return x;|
00000300  0a 20 69 66 20 28 79 25  32 29 20 72 65 74 75 72  |. if (y%2) retur|
00000310  6e 20 78 2a 66 61 73 74  70 6f 77 65 72 28 78 2a  |n x*fastpower(x*|
00000320  78 2c 79 2f 32 29 3b 0a  20 65 6c 73 65 20 72 65  |x,y/2);. else re|
00000330  74 75 72 6e 20 66 61 73  74 70 6f 77 65 72 28 78  |turn fastpower(x|
00000340  2a 78 2c 20 79 2f 32 29  3b 0a 7d 0a 20 20 20     |*x, y/2);.}.   |
0000034f