home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 2 / 2611 / ical.mus next >
Encoding:
Text File  |  1991-01-25  |  3.3 KB  |  220 lines
  1. /* $Header: ical.mus,v 3.0.1.1 90/08/09 04:05:21 lwall Locked $
  2.  */
  3.  
  4. #include "EXTERN.h"
  5. #include "perl.h"
  6. extern int wantarray;
  7.  
  8. char *savestr();
  9.  
  10. static enum uservars {
  11.     UV_dummy,
  12. };
  13.  
  14. static enum usersubs {
  15.     US_and16,
  16.     US_or16,
  17.     US_xor16,
  18.     US_and32,
  19.     US_or32,
  20.     US_xor32,
  21.     US_select,
  22.     US_mingle,
  23. };
  24.  
  25. unsigned short    and16(), or16(), xor16();
  26. unsigned long    and32(), or32(), xor32();
  27. unsigned int    select(), mingle();
  28.  
  29. static int usersub();
  30. static int userset();
  31. static int userval();
  32.  
  33. int
  34. init_ical()
  35. {
  36.     struct ufuncs uf;
  37.     char *filename = "ical.c";
  38.  
  39.     uf.uf_set = userset;
  40.     uf.uf_val = userval;
  41.  
  42. #define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
  43.  
  44.     make_usub("and16",        US_and16,    usersub, filename);
  45.     make_usub("or16",        US_or16,    usersub, filename);
  46.     make_usub("xor16",        US_xor16,    usersub, filename);
  47.     make_usub("and32",        US_and32,    usersub, filename);
  48.     make_usub("or32",        US_or32,    usersub, filename);
  49.     make_usub("xor32",        US_xor32,    usersub, filename);
  50.     make_usub("select",        US_select,    usersub, filename);
  51.     make_usub("mingle",        US_mingle,    usersub, filename);
  52. };
  53.  
  54. static int
  55. usersub(ix, sp, items)
  56. int ix;
  57. register int sp;
  58. register int items;
  59. {
  60.     STR **st = stack->ary_array + sp;
  61.     register int i;
  62.     register char *tmps;
  63.     register STR *Str;        /* used in str_get and str_gnum macros */
  64.  
  65.     switch (ix) {
  66. CASE unsigned short and16
  67. I    unsigned short    n
  68. END
  69.  
  70. CASE unsigned short or16
  71. I    unsigned short    n
  72. END
  73.  
  74. CASE unsigned short xor16
  75. I    unsigned short    n
  76. END
  77.  
  78. CASE unsigned long and32
  79. I    unsigned long    n
  80. END
  81.  
  82. CASE unsigned long or32
  83. I    unsigned long    n
  84. END
  85.  
  86. CASE unsigned long xor32
  87. I    unsigned long    n
  88. END
  89.  
  90. CASE unsigned select
  91. I    unsigned    n1
  92. I    unsigned    n2
  93. END
  94.  
  95. CASE unsigned mingle
  96. I    unsigned short    n1
  97. I    unsigned short    n2
  98. END
  99.  
  100.     default:
  101.     fatal("Unimplemented user-defined subroutine");
  102.     }
  103.     return sp;
  104. }
  105.  
  106. static int
  107. userval(ix, str)
  108. int ix;
  109. STR *str;
  110. {
  111.     switch (ix) {
  112.     default:
  113.         break;
  114.     }
  115.     return 0;
  116. }
  117.  
  118. static int
  119. userset(ix, str)
  120. int ix;
  121. STR *str;
  122. {
  123.     switch (ix) {
  124.     default:
  125.     break;
  126.     }
  127.     return 0;
  128. }
  129.  
  130. /* INTERCAL Maths routines start here */
  131.  
  132. unsigned short and16(n)
  133. unsigned short n;
  134. {
  135.     unsigned short n1;
  136.  
  137.     n1 = (n >> 1) | ((n & 01) << 15);
  138.     return n & n1;
  139. }
  140.  
  141. unsigned long and32(n)
  142. unsigned long n;
  143. {
  144.     unsigned long n1;
  145.  
  146.     n1 = (n >> 1) | ((n & 01) << 31);
  147.     return n & n1;
  148. }
  149.  
  150. unsigned short or16(n)
  151. unsigned short n;
  152. {
  153.     unsigned short n1;
  154.  
  155.     n &= 0177777;
  156.     n1 = (n >> 1) | ((n & 01) << 15);
  157.     return n | n1;
  158. }
  159.  
  160. unsigned long or32(n)
  161. unsigned long n;
  162. {
  163.     unsigned long n1;
  164.  
  165.     n1 = (n >> 1) | ((n & 01) << 31);
  166.     return n | n1;
  167. }
  168.  
  169. unsigned short xor16(n)
  170. unsigned short n;
  171. {
  172.     unsigned short n1;
  173.  
  174.     n &= 0177777;
  175.     n1 = (n >> 1) | ((n & 01) << 15);
  176.     return n ^ n1;
  177. }
  178.  
  179. unsigned long xor32(n)
  180. unsigned long n;
  181. {
  182.     unsigned long n1;
  183.  
  184.     n1 = (n >> 1) | ((n & 01) << 31);
  185.     return n ^ n1;
  186. }
  187.  
  188. unsigned int select(n1, n2)
  189. unsigned int n1, n2;
  190. {
  191.     unsigned int result = 0, bit = 0;
  192.  
  193.     while (n2 != 0)
  194.     {
  195.         if (n2 & 01)
  196.         {
  197.             result |= (n1 & 01) << bit++;
  198.         }
  199.         n1 >>= 1;
  200.         n2 >>= 1;
  201.     }
  202.  
  203.     return result;
  204. }
  205.  
  206. unsigned int mingle(n1, n2)
  207. unsigned short n1, n2;
  208. {
  209.     unsigned int result = 0, bit = 0;
  210.  
  211.     while ((n1 != 0) || (n2 != 0))
  212.     {
  213.         result |= (((n1 & 01) << 1) | (n2 & 01)) << (2 * bit++);
  214.         n1 >>= 1;
  215.         n2 >>= 1;
  216.     }
  217.  
  218.     return(result);
  219. }
  220.