1 /* ******************************************************
  2    *                                                    *
  3    *                                                    *
  4    * Copyright (c) 1972 by Massachusetts Institute of   *
  5    * Technology and Honeywell Information Systems, Inc. *
  6    *                                                    *
  7    *                                                    *
  8    ****************************************************** */
  9 
 10 csin_: proc (number) returns (complex float bin (27));
 11 
 12 dcl (number, a, b) complex float bin (27);
 13 dcl (sinx, cosx, sinhy, coshy) float bin (27),
 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.028e0
 26                then do;
 27                call code_ (29);
 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)) >= 170141182.0e30
 38                then do;
 39                call code_ (30);
 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           if b = 0.0e0
 67                then do;
 68                call code_ (36);
 69 
 70                return (170141182.0e30*sinx);
 71           end;
 72 
 73           b = a/b;
 74 
 75 ret:
 76           return (b);
 77 
 78 ccos_: entry (number) returns (complex float bin (27));
 79 
 80           i = 0;
 81 
 82           goto csins;
 83 
 84 ctan_: entry (number) returns (complex float bin (27));
 85 
 86           i = 2;
 87 
 88           goto csins;
 89 
 90 csinh_: entry (number) returns (complex float bin (27));
 91 
 92           i = -1;
 93 
 94 csinhs:
 95           real (a) = -imag (number);
 96           imag (a) = real (number);
 97 
 98           goto test;
 99 
100 ccosh_: entry (number) returns (complex float bin (27));
101 
102           i = 0;
103           goto csinhs;
104 
105 ctanh_: entry (number) returns (complex float bin (27));
106 
107           i = -2;
108           goto csinhs;
109 
110      end csin_;