home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / intercal.zip / src / cesspool.c < prev    next >
Text File  |  1996-09-03  |  15KB  |  591 lines
  1. /*****************************************************************************
  2.  
  3. NAME 
  4.     cesspool.c -- storage management and runtime support for INTERCAL
  5.  
  6. LICENSE TERMS
  7.     Copyright (C) 1996 Eric S. Raymond 
  8.  
  9.     This program is free software; you can redistribute it and/or modify
  10.     it under the terms of the GNU General Public License as published by
  11.     the Free Software Foundation; either version 2 of the License, or
  12.     (at your option) any later version.
  13.  
  14.     This program is distributed in the hope that it will be useful,
  15.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  16.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17.     GNU General Public License for more details.
  18.  
  19.     You should have received a copy of the GNU General Public License
  20.     along with this program; if not, write to the Free Software
  21.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23. ***************************************************************************/
  24. /* LINTLIBRARY */
  25. #include <stdio.h>
  26. #include <stdlib.h>
  27. #include <varargs.h>
  28. #include "sizes.h"
  29. #include "abcess.h"
  30. #include "lose.h"
  31.  
  32. #include "numerals.c"
  33.  
  34. /**********************************************************************
  35.  *
  36.  * The following functions manipulate the nexting stack
  37.  *
  38.  *********************************************************************/
  39.  
  40. #define MAXNEXT    80
  41.  
  42. int next[MAXNEXT];
  43. int nextindex = 0;
  44.  
  45. void pushnext(int n)
  46. {
  47.     if (nextindex < MAXNEXT)
  48.     next[nextindex++] = n;
  49.     else
  50.     lose(E123, lineno, (char *)NULL);
  51. }
  52.  
  53. unsigned int popnext(int n)
  54. {
  55.     nextindex -= n;
  56.     if (nextindex < 0) {
  57.     nextindex = 0;
  58.     return (unsigned int)-1;
  59.     }
  60.     return(next[nextindex]);
  61. }
  62.  
  63. unsigned int resume(unsigned int n)
  64. {
  65.     if (n == 0)
  66.     {
  67.     lose(E621, lineno, (char *)NULL);
  68.     return 0;
  69.     }
  70.     else if ((n = popnext(n)) == (unsigned int)-1)
  71.     {
  72.     lose(E632, lineno, (char *)NULL);
  73.     return 0;
  74.     }
  75.     return(n);
  76. }
  77.  
  78. /**********************************************************************
  79.  *
  80.  * The following functions implement the INTERCAL I/O model
  81.  *
  82.  *********************************************************************/
  83.  
  84. unsigned int pin(void)
  85. {
  86.     char        buf[BUFSIZ], *cp, *strtok();
  87.     unsigned int    result = 0;
  88.     int n;
  89.     extern int wimp_mode;
  90.  
  91.     if (fgets(buf, BUFSIZ, stdin) == (char *)NULL)
  92.     lose(E562, lineno, (char *)NULL);
  93.     buf[strlen(buf)-1] = '\0';
  94.  
  95.     if(wimp_mode) {
  96.     result = atoi(buf);
  97.     n = 1;
  98.     }
  99.     else
  100.     {
  101.     for(n=0,cp = strtok(buf, " ");cp;cp = strtok((char *)NULL, " "),n++)
  102.     {
  103.         int    digit = -1;
  104.         numeral    *np;
  105.  
  106.         for (np = numerals; np < numerals + sizeof(numerals)/sizeof(numeral); np++)
  107.         if (strcmp(np->name, cp) == 0)
  108.         {
  109.             digit = np->value;
  110.             break;
  111.         }
  112.  
  113.         if (digit == -1)
  114.         lose(E579, lineno, cp);
  115.  
  116.         if (result < 429496729 || (result == 429496729 && digit < 6))
  117.         result = result * 10 + digit;
  118.         else
  119.         lose(E533, lineno, (char *)NULL);
  120.     }
  121.     }
  122.     if (!n)
  123.     lose(E562, lineno, (char *)NULL);
  124.     if (result > (unsigned int)Max_large)
  125.     lose(E533, lineno, (char *)NULL);
  126.     return(result);
  127. }
  128.  
  129. /**********************************************************************
  130.  *
  131.  * Butchered Roman numerals implemented by
  132.  * Michael Ernst, mernst@theory.lcs.mit.edu. May 7, 1990
  133.  *
  134.  * The INTERCAL manual hints that 3999 should translate to MMMIM
  135.  * (compare MMMCMXCIX) without specifying what the translation is.
  136.  * That may be a typo; in any case, this implementation isn't that
  137.  * butchered.
  138.  *
  139.  *********************************************************************/
  140.  
  141. #define MAXDIGITS    10        /* max base 10 digits */
  142. #define MAXROMANS    (MAXDIGITS*4+1)    /* max chars in translation */
  143.  
  144. /*
  145.  * The first column tells how many of the succeeding columns are used.
  146.  * The other columns refer to the columns of br_equiv and br_overbar.
  147.  */
  148. static int br_trans[10][5] =
  149. {
  150.     {0, 0, 0, 0, 0},
  151.     {1, 0, 0, 0, 0},
  152.     {2, 0, 0, 0, 0},
  153.     {3, 0, 0, 0, 0},
  154.     {2, 1, 2, 0, 0},        /* or use {4, 0, 0, 0, 0} */
  155.     {1, 2, 0, 0, 0},
  156.     {2, 2, 1, 0, 0},
  157.     {3, 2, 1, 1, 0},
  158.     {4, 2, 1, 1, 1},
  159.     {2, 1, 3, 0, 0}
  160. };
  161.  
  162. /*
  163.  * butcher places in the string result the "butchered" Roman numeral for val.
  164.  * This string should be printed at the beginning of a line; it spans two
  165.  * lines and already contains newlines.
  166.  *
  167.  * 11/24/91 LHH:  Removed unnecessary final newline.
  168.  */
  169.  
  170. static void butcher(unsigned long val, char *result)
  171. {
  172.     int i, j;
  173.     int digitsig, digitval;
  174.     char res[MAXROMANS], ovb[MAXROMANS];
  175.  
  176.     /* We need FOUR columns because of the odd way that M and I interact. */
  177.     static char br_equiv[MAXDIGITS][4] =
  178.     {
  179.     {'I', 'I', 'V', 'X'}, {'X', 'X', 'L', 'C'},
  180.     {'C', 'C', 'D', 'M'}, {'M', 'I', 'V', 'X'},
  181.     {'X', 'X', 'L', 'C'}, {'C', 'C', 'D', 'M'},
  182.     {'M', 'i', 'v', 'x'}, {'x', 'x', 'l', 'c'},
  183.     {'c', 'c', 'd', 'm'}, {'m', 'i', 'v', 'x'},
  184.     };
  185.  
  186.     static char br_overbar[MAXDIGITS][4] =
  187.     {
  188.     {' ', ' ', ' ', ' '},
  189.     {' ', ' ', ' ', ' '},
  190.     {' ', ' ', ' ', ' '},
  191.     {' ', '_', '_', '_'},
  192.     {'_', '_', '_', '_'},
  193.     {'_', '_', '_', '_'},
  194.     {'_', ' ', ' ', ' '},
  195.     {' ', ' ', ' ', ' '},
  196.     {' ', ' ', ' ', ' '},
  197.     {' ', '_', '_', '_'},
  198.     };
  199.  
  200.     if (val == 0)
  201. /* Final newline will be added by puts.
  202.     (void) strcpy(result, "_\n \n");
  203. */
  204.     (void) strcpy(result, "_\n");
  205.     else
  206.     {
  207.     res[MAXROMANS-1] = 0;
  208.     ovb[MAXROMANS-1] = 0;
  209.     i = MAXROMANS-1;
  210.  
  211.     /* the significance of the current digit is 10 ** digitsig */
  212.     for (digitsig = 0; (digitsig < MAXDIGITS) && (val > 0); digitsig++)
  213.     {
  214.         digitval = val % 10;
  215.         for (j = br_trans[digitval][0]; j > 0; j--)
  216.         {
  217.         /* printf("In j loop: %d %d\n", j, i); */
  218.         res[--i] = br_equiv[digitsig][br_trans[digitval][j]];
  219.         ovb[i] = br_overbar[digitsig][br_trans[digitval][j]];
  220.         }
  221.         val = val / 10;
  222.     }
  223.  
  224.     j = i;
  225.     while ((*result++ = ovb[j++]))
  226.         continue;
  227.     *--result = '\n';
  228.  
  229.     j = i;
  230.     while ((*++result = res[j++]))
  231.         continue;
  232. /* Final newline will be added by puts.
  233.     *result++ = '\n';
  234. */
  235.     *result = '\0';
  236.     }
  237. }
  238.  
  239. void clockface(bool mode)
  240. /* enable or disable clockface mode (output IIII instead of IV) */
  241. {
  242.     if (mode)
  243.     {
  244.     /* clockface mode */
  245.     br_trans[4][0] = 4;
  246.     br_trans[4][1] = 0;
  247.     br_trans[4][2] = 0;
  248.     }
  249.     else
  250.     {
  251.     /* normal mode */
  252.     br_trans[4][0] = 2;
  253.     br_trans[4][1] = 1;
  254.     br_trans[4][2] = 2;
  255.     }
  256. }
  257.  
  258. void pout(unsigned int val)
  259. /* output in `butchered' Roman numerals; see manual, part 4.4.13 */
  260. {
  261.     char    result[2*MAXROMANS+1];
  262.     extern int wimp_mode;
  263.  
  264.     if(wimp_mode) {
  265.     printf("%u\n",val);
  266.     }
  267.     else {
  268.     butcher(val, result);
  269.     (void) puts(result);
  270.     }
  271.     fflush(stdout);
  272. }
  273.  
  274. /**********************************************************************
  275.  *
  276.  * The following two routines implement bitwise I/O.  They assume
  277.  * 8 bit characters, but there's no reason more general versions
  278.  * could not be written.
  279.  *
  280.  *********************************************************************/
  281.  
  282. void binin(unsigned int type, array *a, bool forget)
  283. {
  284.   static unsigned int lastin = 0;
  285.   int c, v;
  286.   unsigned int i;
  287.  
  288.   if (a->rank != 1)
  289.     lose(E241, lineno, (char *)NULL);
  290.  
  291.   for (i = 0 ; i < a->dims[0] ; i++) {
  292.     v = ((c=getchar()) == EOF) ? 256 : (c - lastin) % 256;
  293.     lastin = c;
  294.     if (!forget) {
  295.       if (type == TAIL)
  296.     a->data.tail[i] = v;
  297.       else
  298.     a->data.hybrid[i] = v;
  299.     }
  300.   }
  301. }
  302.  
  303. void binout(unsigned int type, array *a)
  304. {
  305.   static unsigned int lastout = 0;
  306.   unsigned int i, c;
  307.  
  308.   if (a->rank != 1)
  309.     lose(E241, lineno, (char *)NULL);
  310.  
  311.   for (i = 0 ; i < a->dims[0] ; i++) {
  312.     if (type == TAIL)
  313.       c = lastout - a->data.tail[i];
  314.     else
  315.       c = lastout - a->data.hybrid[i];
  316.     lastout = c;
  317.     c = (c & 0x0f) << 4 | (c & 0xf0) >> 4;
  318.     c = (c & 0x33) << 2 | (c & 0xcc) >> 2;
  319.     c = (c & 0x55) << 1 | (c & 0xaa) >> 1;
  320.     putchar(c);
  321.   }
  322. }
  323.  
  324. /**********************************************************************
  325.  *
  326.  * The following assignment function performs IGNORE and type checks
  327.  *
  328.  *********************************************************************/
  329.  
  330. unsigned int assign(char *dest, unsigned int type, bool forget,
  331.             unsigned int value)
  332. {
  333.   unsigned int retval;
  334.   if (type == ONESPOT || type == TAIL) {
  335.     if (value > (unsigned int)Max_small)
  336.       lose(E275, lineno, (char *)NULL);
  337.     if (forget)
  338.       retval = value;
  339.     else {
  340.       retval = *(type16*)dest;
  341.       *(type16*)dest = value;
  342.     }
  343.   }
  344.   else if (type == TWOSPOT || type == HYBRID) {
  345.     if (forget)
  346.       retval = value;
  347.     else {
  348.       retval = *(type32*)dest;
  349.       *(type32*)dest = value;
  350.     }
  351.   }
  352.   return retval;
  353. }
  354.  
  355. /**********************************************************************
  356.  *
  357.  * The following functions implement the INTERCAL array model
  358.  *
  359.  *********************************************************************/
  360.  
  361. char *aref(va_alist) va_dcl
  362. /* return a pointer to the array location specified by args */
  363. {
  364.   unsigned int type;
  365.   array *a;
  366.   unsigned int v;
  367.   va_list ap;
  368.   int address = 0;
  369.   unsigned int i;
  370.  
  371.   va_start(ap);
  372.   type = va_arg(ap, unsigned int);
  373.   a = va_arg(ap, array*);
  374.  
  375.   if (va_arg(ap, unsigned int) != a->rank)
  376.     lose(E241, lineno, (char *)NULL);
  377.  
  378.   for (i = 0 ; i < a->rank ; i++) {
  379.     v = va_arg(ap, unsigned int);
  380.     if (v == 0 || v > a->dims[i])
  381.       lose(E241, lineno, (char *)NULL);
  382.     address = address * a->dims[i] + v - 1;
  383.   }
  384.  
  385.   va_end(ap);
  386.  
  387.   if (type == TAIL)
  388.     return (char*)&a->data.tail[address];
  389.   else
  390.     return (char*)&a->data.hybrid[address];
  391. }
  392.  
  393. void resize(va_alist) va_dcl
  394. /* resize an array to the given shape */
  395. {
  396.   unsigned int type;
  397.   array *a;
  398.   bool forget;
  399.   unsigned int i, r, v;
  400.   va_list ap;
  401.   int prod = 1;
  402.  
  403.   va_start(ap);
  404.   type = va_arg(ap, unsigned int);
  405.   a = va_arg(ap, array*);
  406.   forget = va_arg(ap, bool);
  407.  
  408.   r = va_arg(ap, unsigned int);
  409.   if (!forget) {
  410.     a->rank = r;
  411.     if (a->dims)
  412.       free((char*)a->dims);
  413.     a->dims = (unsigned int*) malloc(a->rank * sizeof(unsigned int));
  414.     if (a->dims == NULL)
  415.       lose(E241, lineno, (char *)NULL);
  416.   }
  417.  
  418.   for (i = 0 ; i < r ; i++) {
  419.     v = va_arg(ap, unsigned int);
  420.     if (v == 0)
  421.       lose(E240, lineno, (char *)NULL);
  422.     if (!forget) {
  423.       a->dims[i] = v;
  424.       prod *= v;
  425.     }
  426.   }
  427.  
  428.   if (!forget) {
  429.     if (type == TAIL) {
  430.       if (a->data.tail)
  431.     free((char *)a->data.tail);
  432.       a->data.tail   = (type16*)malloc(prod * sizeof(type16));
  433.       if (a->data.tail == NULL)
  434.     lose(E241, lineno, (char *)NULL);
  435.     }
  436.     else {
  437.       if (a->data.hybrid)
  438.     free((char *)a->data.hybrid);
  439.       a->data.hybrid = (type32*)malloc(prod * sizeof(type32));
  440.       if (a->data.hybrid == NULL)
  441.     lose(E241, lineno, (char *)NULL);
  442.     }
  443.   }
  444.  
  445.   va_end(ap);
  446. }
  447.  
  448. /**********************************************************************
  449.  *
  450.  * The following functions implement save/retrieve
  451.  *
  452.  *********************************************************************/
  453.  
  454. typedef struct stashbox_t     /* this is a save-stack element */
  455. {
  456.     unsigned int type;          /* variable type */
  457.     unsigned int index;       /* variable's index within the type */
  458.     union              /* the data itself */
  459.     {
  460.     type16    onespot;
  461.     type32    twospot;
  462.     array    *a;
  463.     } save;
  464.     struct stashbox_t *next;  /* pointer to next-older stashbox */
  465. } stashbox;
  466.  
  467. static stashbox *first;
  468.  
  469. void stashinit(void)
  470. {
  471.   first = NULL;
  472. }
  473.  
  474. static stashbox *fetch(unsigned int type, unsigned int index)
  475. /* find a stashed variable in the save stack and extract it */
  476. {
  477.   stashbox **pp = &first, *sp = first;
  478.  
  479.   while (sp && (sp->type != type || sp->index != index)) {
  480.     pp = &sp->next;
  481.     sp = sp->next;
  482.   }
  483.   if (sp)
  484.     *pp = sp->next;
  485.  
  486.   return (sp);
  487. }
  488.  
  489. void stash(unsigned int type, unsigned int index, void *from)
  490. /* stash away the variable's value */
  491. {
  492.   /* create a new stashbox and push it onto the stack */
  493.   stashbox *sp = (stashbox*)malloc(sizeof(stashbox));
  494.   if (sp == NULL) lose(E222, lineno, (char *)NULL);
  495.   sp->next = first;
  496.   first = sp;
  497.  
  498.   /* store the variable in it */
  499.   sp->type = type;
  500.   sp->index = index;
  501.   if (type == ONESPOT)
  502.     memcpy((char *)&sp->save.onespot, from, sizeof(type16));
  503.   else if (type == TWOSPOT)
  504.     memcpy((char *)&sp->save.twospot, from, sizeof(type32));
  505.   else if (type == TAIL || type == HYBRID) {
  506.     array *a = (array*)from;
  507.     int prod;
  508.     unsigned int i;
  509.     sp->save.a = (array*)malloc(sizeof(array));
  510.     if (sp->save.a == NULL) lose(E222, lineno, (char *)NULL);
  511.     sp->save.a->rank = a->rank;
  512.     sp->save.a->dims = (unsigned int*)malloc(a->rank * sizeof(unsigned int));
  513.     if (sp->save.a->dims == NULL) lose(E222, lineno, (char *)NULL);
  514.     memcpy((char*)sp->save.a->dims, (char*)a->dims,
  515.        a->rank * sizeof(unsigned int));
  516.     prod = a->rank ? 1 : 0;
  517.     for (i = 0 ; i < a->rank ; i++) {
  518.       prod *= a->dims[i];
  519.     }
  520.     if (type == TAIL) {
  521.       sp->save.a->data.tail =
  522.     (type16*)malloc(prod * sizeof(type16));
  523.       if (sp->save.a->data.tail == NULL) lose(E222, lineno, (char *)NULL);
  524.       memcpy((char *)sp->save.a->data.tail,
  525.          (char*)a->data.tail, prod * sizeof(type16));
  526.     }
  527.     else {
  528.       sp->save.a->data.hybrid =
  529.     (type32*)malloc(prod * sizeof(type32));
  530.       if (sp->save.a->data.hybrid == NULL) lose(E222, lineno, (char *)NULL);
  531.       memcpy((char *)sp->save.a->data.hybrid,
  532.          (char*)a->data.hybrid, prod * sizeof(type32));
  533.     }
  534.   }
  535.   return;
  536. }
  537.  
  538. void retrieve(void *to, int type, unsigned int index, bool forget)
  539. /* restore the value of a variable from the save stack */
  540. {
  541.   stashbox *sp;
  542.  
  543.   if ((sp = fetch(type, index)) == (stashbox *)NULL)
  544.     lose(E436, lineno, (char *)NULL);
  545.   else if (!forget) {
  546.     if (type == ONESPOT)
  547.       memcpy(to, (char *)&sp->save.onespot, sizeof(type16));
  548.     else if (type == TWOSPOT)
  549.       memcpy(to, (char *)&sp->save.twospot, sizeof(type32));
  550.     else if (type == TAIL || type == HYBRID) {
  551.       array *a = (array*)to;
  552.       if (a->rank) {
  553.     free(a->dims);
  554.     if (type == TAIL)
  555.       free(a->data.tail);
  556.     else
  557.       free(a->data.hybrid);
  558.     memcpy(to, (char*)sp->save.a, sizeof(array));
  559.       }
  560.       free(sp->save.a);
  561.     }
  562.   }
  563.   else if (type == TAIL || type == HYBRID) {
  564.     free(sp->save.a->dims);
  565.     if (type == TAIL)
  566.       free(sp->save.a->data.tail);
  567.     else
  568.       free(sp->save.a->data.hybrid);
  569.     free(sp->save.a);
  570.   }
  571.   free(sp);
  572. }
  573.  
  574. /**********************************************************************
  575.  *
  576.  * The following function is used for random decision making
  577.  *
  578.  *********************************************************************/
  579.  
  580. unsigned int roll(unsigned int n)
  581. /* return TRUE on n% chance, FALSE otherwise */
  582. {
  583. #ifdef USG
  584.    return((unsigned int)(lrand48() % 100) < n);
  585. #else
  586.    return((unsigned int)(rand() % 100) < n);
  587. #endif /* UNIX */
  588. }
  589.  
  590. /* cesspool.c ends here */
  591.