home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / gnu / f2c-1993.04.28-src.lha / f2c-1993.04.28 / src / intr.c < prev    next >
C/C++ Source or Header  |  1993-04-28  |  20KB  |  855 lines
  1. /****************************************************************
  2. Copyright 1990, 1992 by AT&T Bell Laboratories and Bellcore.
  3.  
  4. Permission to use, copy, modify, and distribute this software
  5. and its documentation for any purpose and without fee is hereby
  6. granted, provided that the above copyright notice appear in all
  7. copies and that both that the copyright notice and this
  8. permission notice and warranty disclaimer appear in supporting
  9. documentation, and that the names of AT&T Bell Laboratories or
  10. Bellcore or any of their entities not be used in advertising or
  11. publicity pertaining to distribution of the software without
  12. specific, written prior permission.
  13.  
  14. AT&T and Bellcore disclaim all warranties with regard to this
  15. software, including all implied warranties of merchantability
  16. and fitness.  In no event shall AT&T or Bellcore be liable for
  17. any special, indirect or consequential damages or any damages
  18. whatsoever resulting from loss of use, data or profits, whether
  19. in an action of contract, negligence or other tortious action,
  20. arising out of or in connection with the use or performance of
  21. this software.
  22. ****************************************************************/
  23.  
  24. #include "defs.h"
  25. #include "names.h"
  26.  
  27. void cast_args ();
  28.  
  29. union
  30.     {
  31.     int ijunk;
  32.     struct Intrpacked bits;
  33.     } packed;
  34.  
  35. struct Intrbits
  36.     {
  37.     char intrgroup /* :3 */;
  38.     char intrstuff /* result type or number of generics */;
  39.     char intrno /* :7 */;
  40.     char dblcmplx;
  41.     char dblintrno;    /* for -r8 */
  42.     };
  43.  
  44. /* List of all intrinsic functions.  */
  45.  
  46. LOCAL struct Intrblock
  47.     {
  48.     char intrfname[8];
  49.     struct Intrbits intrval;
  50.     } intrtab[ ] =
  51. {
  52. "int",         { INTRCONV, TYLONG },
  53. "real",     { INTRCONV, TYREAL, 1 },
  54.         /* 1 ==> real(TYDCOMPLEX) yields TYDREAL */
  55. "dble",     { INTRCONV, TYDREAL },
  56. "cmplx",     { INTRCONV, TYCOMPLEX },
  57. "dcmplx",     { INTRCONV, TYDCOMPLEX, 0, 1 },
  58. "ifix",     { INTRCONV, TYLONG },
  59. "idint",     { INTRCONV, TYLONG },
  60. "float",     { INTRCONV, TYREAL },
  61. "dfloat",    { INTRCONV, TYDREAL },
  62. "sngl",     { INTRCONV, TYREAL },
  63. "ichar",     { INTRCONV, TYLONG },
  64. "iachar",     { INTRCONV, TYLONG },
  65. "char",     { INTRCONV, TYCHAR },
  66. "achar",     { INTRCONV, TYCHAR },
  67.  
  68. /* any MAX or MIN can be used with any types; the compiler will cast them
  69.    correctly.  So rules against bad syntax in these expressions are not
  70.    enforced */
  71.  
  72. "max",         { INTRMAX, TYUNKNOWN },
  73. "max0",     { INTRMAX, TYLONG },
  74. "amax0",     { INTRMAX, TYREAL },
  75. "max1",     { INTRMAX, TYLONG },
  76. "amax1",     { INTRMAX, TYREAL },
  77. "dmax1",     { INTRMAX, TYDREAL },
  78.  
  79. "and",        { INTRBOOL, TYUNKNOWN, OPBITAND },
  80. "or",        { INTRBOOL, TYUNKNOWN, OPBITOR },
  81. "xor",        { INTRBOOL, TYUNKNOWN, OPBITXOR },
  82. "not",        { INTRBOOL, TYUNKNOWN, OPBITNOT },
  83. "lshift",    { INTRBOOL, TYUNKNOWN, OPLSHIFT },
  84. "rshift",    { INTRBOOL, TYUNKNOWN, OPRSHIFT },
  85.  
  86. "min",         { INTRMIN, TYUNKNOWN },
  87. "min0",     { INTRMIN, TYLONG },
  88. "amin0",     { INTRMIN, TYREAL },
  89. "min1",     { INTRMIN, TYLONG },
  90. "amin1",     { INTRMIN, TYREAL },
  91. "dmin1",     { INTRMIN, TYDREAL },
  92.  
  93. "aint",     { INTRGEN, 2, 0 },
  94. "dint",     { INTRSPEC, TYDREAL, 1 },
  95.  
  96. "anint",     { INTRGEN, 2, 2 },
  97. "dnint",     { INTRSPEC, TYDREAL, 3 },
  98.  
  99. "nint",     { INTRGEN, 4, 4 },
  100. "idnint",     { INTRGEN, 2, 6 },
  101.  
  102. "abs",         { INTRGEN, 6, 8 },
  103. "iabs",     { INTRGEN, 2, 9 },
  104. "dabs",     { INTRSPEC, TYDREAL, 11 },
  105. "cabs",     { INTRSPEC, TYREAL, 12, 0, 13 },
  106. "zabs",     { INTRSPEC, TYDREAL, 13, 1 },
  107.  
  108. "mod",         { INTRGEN, 4, 14 },
  109. "amod",     { INTRSPEC, TYREAL, 16, 0, 17 },
  110. "dmod",     { INTRSPEC, TYDREAL, 17 },
  111.  
  112. "sign",     { INTRGEN, 4, 18 },
  113. "isign",     { INTRGEN, 2, 19 },
  114. "dsign",     { INTRSPEC, TYDREAL, 21 },
  115.  
  116. "dim",         { INTRGEN, 4, 22 },
  117. "idim",     { INTRGEN, 2, 23 },
  118. "ddim",     { INTRSPEC, TYDREAL, 25 },
  119.  
  120. "dprod",     { INTRSPEC, TYDREAL, 26 },
  121.  
  122. "len",         { INTRSPEC, TYLONG, 27 },
  123. "index",     { INTRSPEC, TYLONG, 29 },
  124.  
  125. "imag",     { INTRGEN, 2, 31 },
  126. "aimag",     { INTRSPEC, TYREAL, 31, 0, 32 },
  127. "dimag",     { INTRSPEC, TYDREAL, 32 },
  128.  
  129. "conjg",     { INTRGEN, 2, 33 },
  130. "dconjg",     { INTRSPEC, TYDCOMPLEX, 34, 1 },
  131.  
  132. "sqrt",     { INTRGEN, 4, 35 },
  133. "dsqrt",     { INTRSPEC, TYDREAL, 36 },
  134. "csqrt",     { INTRSPEC, TYCOMPLEX, 37, 0, 38 },
  135. "zsqrt",     { INTRSPEC, TYDCOMPLEX, 38, 1 },
  136.  
  137. "exp",         { INTRGEN, 4, 39 },
  138. "dexp",     { INTRSPEC, TYDREAL, 40 },
  139. "cexp",     { INTRSPEC, TYCOMPLEX, 41, 0, 42 },
  140. "zexp",     { INTRSPEC, TYDCOMPLEX, 42, 1 },
  141.  
  142. "log",         { INTRGEN, 4, 43 },
  143. "alog",     { INTRSPEC, TYREAL, 43, 0, 44 },
  144. "dlog",     { INTRSPEC, TYDREAL, 44 },
  145. "clog",     { INTRSPEC, TYCOMPLEX, 45, 0, 46 },
  146. "zlog",     { INTRSPEC, TYDCOMPLEX, 46, 1 },
  147.  
  148. "log10",     { INTRGEN, 2, 47 },
  149. "alog10",     { INTRSPEC, TYREAL, 47, 0, 48 },
  150. "dlog10",     { INTRSPEC, TYDREAL, 48 },
  151.  
  152. "sin",         { INTRGEN, 4, 49 },
  153. "dsin",     { INTRSPEC, TYDREAL, 50 },
  154. "csin",     { INTRSPEC, TYCOMPLEX, 51, 0, 52 },
  155. "zsin",     { INTRSPEC, TYDCOMPLEX, 52, 1 },
  156.  
  157. "cos",         { INTRGEN, 4, 53 },
  158. "dcos",     { INTRSPEC, TYDREAL, 54 },
  159. "ccos",     { INTRSPEC, TYCOMPLEX, 55, 0, 56 },
  160. "zcos",     { INTRSPEC, TYDCOMPLEX, 56, 1 },
  161.  
  162. "tan",         { INTRGEN, 2, 57 },
  163. "dtan",     { INTRSPEC, TYDREAL, 58 },
  164.  
  165. "asin",     { INTRGEN, 2, 59 },
  166. "dasin",     { INTRSPEC, TYDREAL, 60 },
  167.  
  168. "acos",     { INTRGEN, 2, 61 },
  169. "dacos",     { INTRSPEC, TYDREAL, 62 },
  170.  
  171. "atan",     { INTRGEN, 2, 63 },
  172. "datan",     { INTRSPEC, TYDREAL, 64 },
  173.  
  174. "atan2",     { INTRGEN, 2, 65 },
  175. "datan2",     { INTRSPEC, TYDREAL, 66 },
  176.  
  177. "sinh",     { INTRGEN, 2, 67 },
  178. "dsinh",     { INTRSPEC, TYDREAL, 68 },
  179.  
  180. "cosh",     { INTRGEN, 2, 69 },
  181. "dcosh",     { INTRSPEC, TYDREAL, 70 },
  182.  
  183. "tanh",     { INTRGEN, 2, 71 },
  184. "dtanh",     { INTRSPEC, TYDREAL, 72 },
  185.  
  186. "lge",        { INTRSPEC, TYLOGICAL, 73},
  187. "lgt",        { INTRSPEC, TYLOGICAL, 75},
  188. "lle",        { INTRSPEC, TYLOGICAL, 77},
  189. "llt",        { INTRSPEC, TYLOGICAL, 79},
  190.  
  191. #if 0
  192. "epbase",    { INTRCNST, 4, 0 },
  193. "epprec",    { INTRCNST, 4, 4 },
  194. "epemin",    { INTRCNST, 2, 8 },
  195. "epemax",    { INTRCNST, 2, 10 },
  196. "eptiny",    { INTRCNST, 2, 12 },
  197. "ephuge",    { INTRCNST, 4, 14 },
  198. "epmrsp",    { INTRCNST, 2, 18 },
  199. #endif
  200.  
  201. "fpexpn",    { INTRGEN, 4, 81 },
  202. "fpabsp",    { INTRGEN, 2, 85 },
  203. "fprrsp",    { INTRGEN, 2, 87 },
  204. "fpfrac",    { INTRGEN, 2, 89 },
  205. "fpmake",    { INTRGEN, 2, 91 },
  206. "fpscal",    { INTRGEN, 2, 93 },
  207.  
  208. "" };
  209.  
  210.  
  211. LOCAL struct Specblock
  212.     {
  213.     char atype;        /* Argument type; every arg must have
  214.                    this type */
  215.     char rtype;        /* Result type */
  216.     char nargs;        /* Number of arguments */
  217.     char spxname[8];    /* Name of the function in Fortran */
  218.     char othername;        /* index into callbyvalue table */
  219.     } spectab[ ] =
  220. {
  221.     { TYREAL,TYREAL,1,"r_int" },
  222.     { TYDREAL,TYDREAL,1,"d_int" },
  223.  
  224.     { TYREAL,TYREAL,1,"r_nint" },
  225.     { TYDREAL,TYDREAL,1,"d_nint" },
  226.  
  227.     { TYREAL,TYSHORT,1,"h_nint" },
  228.     { TYREAL,TYLONG,1,"i_nint" },
  229.  
  230.     { TYDREAL,TYSHORT,1,"h_dnnt" },
  231.     { TYDREAL,TYLONG,1,"i_dnnt" },
  232.  
  233.     { TYREAL,TYREAL,1,"r_abs" },
  234.     { TYSHORT,TYSHORT,1,"h_abs" },
  235.     { TYLONG,TYLONG,1,"i_abs" },
  236.     { TYDREAL,TYDREAL,1,"d_abs" },
  237.     { TYCOMPLEX,TYREAL,1,"c_abs" },
  238.     { TYDCOMPLEX,TYDREAL,1,"z_abs" },
  239.  
  240.     { TYSHORT,TYSHORT,2,"h_mod" },
  241.     { TYLONG,TYLONG,2,"i_mod" },
  242.     { TYREAL,TYREAL,2,"r_mod" },
  243.     { TYDREAL,TYDREAL,2,"d_mod" },
  244.  
  245.     { TYREAL,TYREAL,2,"r_sign" },
  246.     { TYSHORT,TYSHORT,2,"h_sign" },
  247.     { TYLONG,TYLONG,2,"i_sign" },
  248.     { TYDREAL,TYDREAL,2,"d_sign" },
  249.  
  250.     { TYREAL,TYREAL,2,"r_dim" },
  251.     { TYSHORT,TYSHORT,2,"h_dim" },
  252.     { TYLONG,TYLONG,2,"i_dim" },
  253.     { TYDREAL,TYDREAL,2,"d_dim" },
  254.  
  255.     { TYREAL,TYDREAL,2,"d_prod" },
  256.  
  257.     { TYCHAR,TYSHORT,1,"h_len" },
  258.     { TYCHAR,TYLONG,1,"i_len" },
  259.  
  260.     { TYCHAR,TYSHORT,2,"h_indx" },
  261.     { TYCHAR,TYLONG,2,"i_indx" },
  262.  
  263.     { TYCOMPLEX,TYREAL,1,"r_imag" },
  264.     { TYDCOMPLEX,TYDREAL,1,"d_imag" },
  265.     { TYCOMPLEX,TYCOMPLEX,1,"r_cnjg" },
  266.     { TYDCOMPLEX,TYDCOMPLEX,1,"d_cnjg" },
  267.  
  268.     { TYREAL,TYREAL,1,"r_sqrt", 1 },
  269.     { TYDREAL,TYDREAL,1,"d_sqrt", 1 },
  270.     { TYCOMPLEX,TYCOMPLEX,1,"c_sqrt" },
  271.     { TYDCOMPLEX,TYDCOMPLEX,1,"z_sqrt" },
  272.  
  273.     { TYREAL,TYREAL,1,"r_exp", 2 },
  274.     { TYDREAL,TYDREAL,1,"d_exp", 2 },
  275.     { TYCOMPLEX,TYCOMPLEX,1,"c_exp" },
  276.     { TYDCOMPLEX,TYDCOMPLEX,1,"z_exp" },
  277.  
  278.     { TYREAL,TYREAL,1,"r_log", 3 },
  279.     { TYDREAL,TYDREAL,1,"d_log", 3 },
  280.     { TYCOMPLEX,TYCOMPLEX,1,"c_log" },
  281.     { TYDCOMPLEX,TYDCOMPLEX,1,"z_log" },
  282.  
  283.     { TYREAL,TYREAL,1,"r_lg10" },
  284.     { TYDREAL,TYDREAL,1,"d_lg10" },
  285.  
  286.     { TYREAL,TYREAL,1,"r_sin", 4 },
  287.     { TYDREAL,TYDREAL,1,"d_sin", 4 },
  288.     { TYCOMPLEX,TYCOMPLEX,1,"c_sin" },
  289.     { TYDCOMPLEX,TYDCOMPLEX,1,"z_sin" },
  290.  
  291.     { TYREAL,TYREAL,1,"r_cos", 5 },
  292.     { TYDREAL,TYDREAL,1,"d_cos", 5 },
  293.     { TYCOMPLEX,TYCOMPLEX,1,"c_cos" },
  294.     { TYDCOMPLEX,TYDCOMPLEX,1,"z_cos" },
  295.  
  296.     { TYREAL,TYREAL,1,"r_tan", 6 },
  297.     { TYDREAL,TYDREAL,1,"d_tan", 6 },
  298.  
  299.     { TYREAL,T