1 /* ******************************************************
 2    *                                                    *
 3    *                                                    *
 4    * Copyright (c) 1972 by Massachusetts Institute of   *
 5    * Technology and Honeywell Information Systems, Inc. *
 6    *                                                    *
 7    *                                                    *
 8    ****************************************************** */
 9 
10 diexp_: procedure (base, exponent) returns (fixed binary (71));
11                                                             /*     compute integer base ** integer exponent     */
12 declare (base, exponent, h, i, j) fixed binary (17),
13          f fixed binary (71),
14          code_ entry (fixed binary);
15           i = base;
16           j = exponent;
17           f = 1;
18 if i = 0 then test: do;
19                if j > 0 then go to clear;
20                call code_ (5 - sign (j));
21                go to clear;
22           end test;
23           if j = 0 then go to finis;
24           if abs (i) = 1 then j = mod (j, 2);
25 else if j < 0 then clear: return (0);
26 loop:     h = divide (j, 2, 17, 0);
27           if h+h ^= j then f = f*i;
28 if h = 0 then finis: return (f);
29           j = h;
30           i = i*i;
31           go to loop;
32      end diexp_;