1 /* ******************************************************
  2    *                                                    *
  3    *                                                    *
  4    * Copyright (c) 1972 by Massachusetts Institute of   *
  5    * Technology and Honeywell Information Systems, Inc. *
  6    *                                                    *
  7    *                                                    *
  8    ****************************************************** */
  9 
 10 dcsin_: proc (number) returns (complex float bin (63));
 11 
 12 dcl (number, a, b) complex float bin (63),
 13     (sinx, cosx, sinhy, coshy) float bin (63),
 14           (abs, cos, cosh, imag, real, sin, sinh) builtin,
 15      i fixed bin (17);
 16 
 17 dcl  code_ ext entry (fixed bin (17));
 18 
 19           i = 1;
 20 
 21 csins:
 22           a = number;
 23 
 24 test:
 25           if abs (imag (a))>88.018e0
 26                then do;
 27                call code_ (61);
 28 
 29                sinhy,
 30                coshy = 170141182.0e30;
 31           end;
 32           else do;
 33                sinhy = sinh (imag (a));
 34                coshy = cosh (imag (a));
 35           end;
 36 
 37           if abs (real (a)) >= 18104398509481984.0e0
 38                then do;
 39                call code_ (62);
 40 
 41                return (0.0e0);
 42           end;
 43 
 44           sinx = sin (real (a));
 45           cosx = cos (real (a));
 46 
 47           if i>0
 48                then do;
 49                real (a) = sinx*coshy;
 50                imag (a) = cosx*sinhy;
 51           end;
 52           else if i<0
 53                then do;
 54                real (a) = cosx*sinhy;
 55                imag (a) = -sinx*coshy;
 56 
 57                i = -i;
 58           end;
 59 
 60           if i = 1 then return (a);
 61 
 62           real (b) = cosx*coshy;
 63           imag (b) = -sinx*sinhy;
 64 
 65           if i = 0 then goto ret;
 66 
 67           if b = 0.0e0
 68                then do;
 69                call code_ (64);
 70                return (170141182.0e30*sinx);
 71           end;
 72 
 73           b = a/b;
 74 
 75 ret:
 76           return (b);
 77 
 78 dccos_: entry (number) returns (complex float bin (63));
 79 
 80           i = 0;
 81           goto csins;
 82 
 83 dctan_: entry (number) returns (complex float bin (63));
 84 
 85           i = 2;
 86           goto csins;
 87 
 88 dcsinh_: entry (number) returns (complex float bin (63));
 89 
 90           i = -1;
 91 
 92 csinhs:
 93           real (a) = -imag (number);
 94           imag (a) = real (number);
 95 
 96           goto test;
 97 
 98 dccosh_: entry (number) returns (complex float bin (63));
 99 
100           i = 0;
101           goto csinhs;
102 
103 dctanh_: entry (number) returns (complex float bin (63));
104 
105           i = -2;
106           goto csinhs;
107 
108      end dcsin_;