1 /* ******************************************************
 2    *                                                    *
 3    *                                                    *
 4    * Copyright (c) 1972 by Massachusetts Institute of   *
 5    * Technology and Honeywell Information Systems, Inc. *
 6    *                                                    *
 7    *                                                    *
 8    ****************************************************** */
 9 
10 dxp12_: procedure (base, exponent) returns (float binary (63));
11 
12 declare (base, a, f) float binary (63),
13         (exponent, h, k, m) fixed binary (71);
14 dcl  code_ ext entry (fixed bin);
15 dcl       (abs, divide, sign) builtin;
16           a = base;
17           k = exponent;
18           f = 1.e0;
19 if a = 0.0e0 then test: do;
20 if k > 0 then clear: return (a);
21                call code_ (3 - sign (k));
22                go to clear;
23           end test;
24           if k = 0 then go to finis;
25           m = abs (k);
26 loop:     h = divide (m, 2, 71, 0);
27           if h+h ^= m then f = f*a;
28           if h = 0 then go to invert;
29           m = h;
30           a = a*a;
31           go to loop;
32 invert:   if k < 0 then f = 1.e0 / f;
33 finis:    return (f);
34      end dxp12_;