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: }