src/dynoplibs/obscure.ops

   1 /*
   2  * $Id$
   3 ** obscure.ops
   4 */
   5
   6 BEGIN_OPS_PREAMBLE
   7
   8 #include <math.h>
   9
  10 END_OPS_PREAMBLE
  11
  12 =head1 NAME
  13
  14 obscure.ops - Obscure Mathematical Opcodes
  15
  16 =cut
  17
  18 =head1 DESCRIPTION
  19
  20 Parrot's library of obscure mathematical ops. These turn common
  21 trig expressions into a single op.
  22
  23 To use this library of ops, add this directive to your PIR:
  24
  25  .loadlib 'obscure_ops'
  26
  27 =cut
  28
  29
  30 ###############################################################################
  31
  32 =head2 Obscure trigonometric operations
  33
  34 Reference:
  35
  36     Abramowitz, M. and Stegum, C. A. (Eds.). Handbook of Mathematical
  37     Functions with Formulas, Graphs, and Mathematical Tables, 9th printing.
  38     New York: Dover, p. 78, 1972.
  39
  40 =over 4
  41
  42 =cut
  43
  44
  45 ########################################
  46
  47 =item B<covers>(out NUM, in NUM)
  48
  49 Set $1 to the coversine (in radians) of $2.
  50
  51 =cut
  52
  53 inline op covers(out NUM, in NUM) :advanced_math {
  54     $1 = 1.0 - sin($2);
  55 }
  56
  57
  58 ########################################
  59
  60 =item B<exsec>(out NUM, in NUM)
  61
  62 Set $1 to the exsecant of $2 (given in radians).
  63
  64 =cut
  65
  66
  67 inline op exsec(out NUM, in NUM) :advanced_math {
  68     $1 = (1.0 / cos($2)) - 1.0;
  69 }
  70
  71
  72 ########################################
  73
  74 =item B<hav>(out NUM, in NUM)
  75
  76 Set $1 to the haversine (in radians) of $2.
  77
  78 =cut
  79
  80 inline op hav(out NUM, in NUM) {
  81     $1 = 0.5 * (1.0 - cos($2));
  82 }
  83
  84
  85 ########################################
  86
  87 =item B<vers>(out NUM, in NUM)
  88
  89 Set $1 to the versine (in radians) of $2.
  90
  91 =cut
  92
  93 inline op vers(out NUM, in NUM) :advanced_math {
  94     $1 = 1.0 - cos($2);
  95 }
  96
  97 ########################################
  98
  99 =item B<gcd>(out INT, in INT, in INT)
 100
 101 Greatest Common divisor of $2 and $3.
 102
 103 =cut
 104
 105 inline op gcd(out INT, in INT, in INT) :advanced_math {
 106     INTVAL p = 0;
 107     INTVAL a = $2 < 0 ? -$2 : $2;
 108     INTVAL b = $3 < 0 ? -$3 : $3;
 109
 110     if (a==0) { $1=b; goto NEXT(); }
 111     if (b==0) { $1=a; goto NEXT(); }
 112
 113     while (!((a | b) & 1)) {
 114         a>>=1;
 115         b>>=1;
 116         p++;
 117     }
 118
 119     while (a>0) {
 120         if (!(a & 1)) a>>=1;
 121         else if (!(b & 1)) b>>=1;
 122         else if (a<b)      b = (b-a)>>1;
 123         else               a = (a-b)>>1;
 124     }
 125
 126     $1 = b<<p;
 127 }
 128
 129
 130 ########################################
 131
 132 =item B<lcm>(out INT, in INT, in INT)
 133
 134 Least Common Multiple of $2 and $3
 135
 136 =cut
 137
 138 inline op lcm(out INT, in INT, in INT) :advanced_math {
 139     INTVAL gcd = 0;
 140     INTVAL p = 0;
 141     INTVAL a = $2 < 0 ? -$2 : $2;
 142     INTVAL b = $3 < 0 ? -$3 : $3;
 143     INTVAL saved_var1 = a, saved_var2 = b;
 144
 145     if (a==0 || b==0) { $1=0; goto NEXT(); }
 146
 147     while (!((a | b) & 1)) {
 148         a>>=1;
 149         b>>=1;
 150         p++;
 151     }
 152
 153     while (a>0) {
 154         if (!(a & 1)) a>>=1;
 155         else if (!(b & 1)) b>>=1;
 156         else if (a<b)      b = (b-a)>>1;
 157         else               a = (a-b)>>1;
 158     }
 159
 160     gcd = b<<p;
 161     saved_var1 /= gcd;
 162     $1 = saved_var1*saved_var2;
 163 }
 164
 165 ########################################
 166
 167 =item B<fact>(out INT, in INT)
 168
 169 =item B<fact>(out NUM, in INT)
 170
 171 Factorial, n!. Calculates the product of 1 to N.
 172
 173 =cut
 174
 175 inline op fact(out INT, in INT) :advanced_math {
 176     /* Coercing a negative to a UINT can get pretty ugly
 177      * in this situation. */
 178     INTVAL i = $2;
 179     UINTVAL q = 1;
 180     while (i>0) {
 181         q = q*i;
 182         i--;
 183     }
 184     $1 = q;
 185 }
 186
 187 inline op fact(out NUM, in INT) :advanced_math {
 188     /* Coercing a negative to a UINT can get pretty ugly
 189      * in this situation. */
 190     INTVAL i = $2;
 191     FLOATVAL q = 1;
 192     while (i>0) {
 193         q = q*i;
 194         i--;
 195     }
 196     $1 = q;
 197 }
 198
 199
 200
 201 =back
 202
 203 =cut
 204
 205
 206 ###############################################################################
 207
 208 =head1 COPYRIGHT
 209
 210 Copyright (C) 2001-2009, Parrot Foundation.
 211
 212 =head1 LICENSE
 213
 214 This program is free software. It is subject to the same license
 215 as the Parrot interpreter itself.
 216
 217 =cut
 218
 219
 220 /*
 221  * Local variables:
 222  *   c-file-style: "parrot"
 223  * End:
 224  * vim: expandtab shiftwidth=4:
 225  */