1: #include "lint.h"
   2: #ifndef lint
   3: static char sccs_id[] = "@(#)util.c	2.2	8/13/82";
   4: #endif lint
   5: #include <stdio.h>
   6: #include <ape.h>
   7: move(a,b)
   8: MINT *a,*b; /* copies a onto b; a is left unchanged */
   9: {   int i,j;
  10:     xfree(b);
  11:     b->len=a->len;
  12:     if((i=a->len)<0) i = -i;
  13:     if(i==0) return;
  14:     b->val=xalloc(i,"move");
  15:     for(j=0;j<i;j++)
  16:         b->val[j]=a->val[j];
  17:     return;
  18: }
  19: 
  20: short *xalloc(nint,s)
  21: char *s;
  22: {   short *i;
  23:     char *malloc();
  24: 
  25:     i=(short *)malloc((unsigned)((nint+2)*sizeof(short)));
  26: #ifdef DBG
  27:     fprintf(stderr,"%s: %d words at %o\n",s,nint,i);
  28: #endif
  29:     if (i!=NULL) return(i);
  30:     fprintf(stderr,"can\'t allocate for %s: %d words\n",s,nint);
  31:     aperror("ape: no free space");
  32:     return(0);
  33: }
  34: aperror(s) char *s;
  35: {
  36:     fprintf(stderr,"%s\n",s);
  37:     ignore(fflush(stdout));
  38:     sleep(2);
  39:     abort();
  40: }
  41: 
  42: new(pa)
  43: PMINT *pa;
  44: /* Pascal-like initializer; gives a zero structure */
  45: {
  46:     char *calloc();
  47: 
  48:     *pa =  (PMINT) calloc (1,sizeof(MINT));
  49: }
  50: 
  51: mcan(a)
  52: MINT *a; /* "removes" excess zeroes */
  53: {   int i,j;
  54: 
  55:     if((i=a->len)==0) return;
  56:     else if(i<0) i= -i;
  57:     for(j=i;j>0 && a->val[j-1]==0;j--);
  58:     if(j==i) return;
  59:     if(j==0)
  60:     {   xfree(a);
  61:         return;
  62:     }
  63:     if(a->len > 0) a->len=j;
  64:     else a->len = -j;
  65: }
  66: 
  67: MINT *shtom(n)
  68: short n;
  69: {
  70:     MINT *a;
  71: 
  72:     new(&a);
  73:     if(n>0)
  74:     {   a->len=1;
  75:         a->val=xalloc(1,"itom1");
  76:         *a->val=n;
  77:         return(a);
  78:     }
  79:     else if(n<0)
  80:     {   a->len = -1;
  81:         a->val=xalloc(1,"itom2");
  82:         *a->val= -n;
  83:         return(a);
  84:     }
  85:     else    /* I think the new makes this unnecessary */
  86:     {   /*a->len=0;*/
  87:         return(a);
  88:     }
  89: }
  90: 
  91: MINT *ltom(ln)
  92: long ln;
  93: {
  94:     if (ln < SHORT && (-ln) <SHORT)
  95:         {
  96:         return(itom((int)ln));
  97:         }
  98:     else
  99:     {
 100:     PMINT a;
 101: 
 102:     new(&a);
 103:     if (ln < 0L)
 104:         {
 105:         a->len = -2;
 106:         ln = -ln;
 107:         }
 108:     else a->len = 2;
 109:     if (ln > 0L)
 110:         {
 111:         a->val = xalloc(2,"ltom1");
 112:         a->val[1] = ln/SHORT;
 113:         a->val[0] = ln%SHORT;
 114:         return (a);
 115:         }
 116:     aperror("ltom problem");
 117:     return (NULL);
 118:     }
 119: }
 120: 
 121: makemint(a,ln)
 122: PMINT a;
 123: long int ln;
 124: {
 125:     PMINT here;
 126: 
 127:     here = ltom(ln);
 128:     move (here, a);
 129:     afree(here);
 130: }

Defined functions

aperror defined in line 34; used 9 times
ltom defined in line 91; used 6 times
makemint defined in line 121; used 5 times
shtom defined in line 67; used 4 times

Defined variables

sccs_id defined in line 3; never used
Last modified: 1983-07-23
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 845
Valid CSS Valid XHTML 1.0 Strict