1 /* ******************************************************
 2    *                                                    *
 3    *                                                    *
 4    * Copyright (c) 1972 by Massachusetts Institute of   *
 5    * Technology and Honeywell Information Systems, Inc. *
 6    *                                                    *
 7    *                                                    *
 8    ****************************************************** */
 9 
10 dcxp1_: proc (base, exponent) returns (complex float bin (63));
11 
12 dcl (base, a, f) complex float bin (63),
13     (exponent, h, k, m) fixed bin (17);
14 
15 dcl       divide builtin;
16 
17 dcl  code_ ext entry (fixed bin (17));
18 
19           a = base;
20           k = exponent;
21 
22           f = 1.0e0;
23           if a = 0.0e0
24                then do;
25                if k>0 then goto clear;
26 
27                call code_ (14-sign (k));
28                goto clear;
29           end;
30 
31           if k = 0 then goto ret;
32           m = abs (k);
33 
34 loop:
35           h = divide(m,2,17,0);
36 
37           if h+h ^= m
38                then f = f*a;
39 
40           if h ^= 0
41                then do;
42                m = h;
43                a = a*a;
44                goto loop;
45           end;
46 
47           if k<0
48                then f = 1.0e0/f;
49 
50 ret:
51           return (f);
52 
53 clear:
54           return (a);
55 
56      end dcxp1_;