|
|
1.1 root 1: /* Copyright Bell Telephone Laboratories Whippany, N.J.
2:
3: * /////////////////////////////////////
4: * /////////////////////////////////////
5: * /////////////// dim.c ///////////////
6: * /// J. P. Hawkins WH X4610 8C-001 ///
7: * ///// Fri Aug 24 17:24:13 1979 //////
8: * /////////////////////////////////////
9: * /////////////////////////////////////
10:
11: * Array allocator for
12: * BITE
13: * Reference: Donald.E.Knuth
14: * "Fundamental Algorithms"
15: * Vol. 1 PP 296,298
16: *
17: * Storage is allocated so that:
18: *
19: * LOC(ARRAY[I,J,K,L]) = BASEADDR + a1*I + a2*J + a3*K + L
20: *
21: * The constants a1,a2,a3,a4 ... ak-1 are calculated at dimension time
22: * and stored as part of the header in the array data.
23: * The storage of these constants could be saved by doing a calculation
24: * every time an array element is referenced. The tradeoff is access
25: * speed versus some core real estate.
26: *
27: * +---------------+ BEGINNING OF ALLOCATED SPACE
28: * | | NUMBER OF DIMENSIONS
29: * +---------------+
30: * | I1 | DIMENSION 1
31: * +---------------+
32: * | I2 | DIMENSION 2
33: * +---------------+
34: * | I3 | DIMENSION 3
35: * +---------------+
36: * | ............ |
37: * +---------------+
38: * | Ik | DIMENSION k
39: * +---------------+
40: * | a1 | Constants a1 .... ak-1
41: * +---------------+
42: * | ............ |
43: * +---------------+
44: * | ak-1 |
45: * +---------------+
46: * | | BEGINNING OF DATA AREA
47: * +---------------+
48: * | |
49: * ~~ ~~
50: * | |
51: * +---------------+
52: * | |
53: * +---------------+
54: */
55: /* "@(#) dim.c: V 1.4 3/4/81" */
56: /*
57: *
58: * ////// DIMENSION STATEMENT //////
59: */
60: /* "@(#) dim.c: V 1.4 3/4/81" */
61: #include "bas.h"
62: extern char *hicore;
63: extern int _comflg; /* common flag */
64: char * asymtab[26][11]; /* array name symbol table */
65: #ifdef STRINGS
66: char * sasymtab[26][11]; /* string array name symbol table */
67: #endif
68:
69: dim()
70: {
71: char *clptr; /* temp pointer used for class */
72: char expfld[40]; /* expression field */
73: int type;
74:
75: clptr = expr;
76: type = class(&clptr,expfld);
77: switch(type)
78: {
79: case VACLASS:
80: return(ndim());
81: break;
82: #ifdef STRINGS
83: case SACLASS:
84: return(sdim());
85: break;
86: #endif
87: default:
88: error(inst.thing.linno, 21); /* BAD DIMENSION SYNTAX */
89: return(-1);
90: }
91: return 0;
92: }
93: #ifdef STRINGS
94: /*
95: * String dimension
96: */
97: sdim()
98: {
99: char arname[3]; /* array symbol name */
100: double dimlist[MAXDIM]; /* dimension list */
101: double numdim; /* number of dimensions */
102: int totsiz; /* space to be allocated */
103: unsigned int bytsiz; /* same as totsiz in int form */
104: register int *iptr;
105: int i;
106:
107: int j,k; /* symbol table indicies */
108:
109:
110: /*
111: * GET ARRAY SYMBOL NAME, NUMBER IF DIMENSIONS &
112: * PUT THE VALUE OF EACH DIMENSION IN DIMLIST
113: */
114: if(getdims(expr,arname,&numdim,dimlist) < 0)
115: return(-1);
116: if(numdim == 1.0) /* if one dim specified */
117: {
118: dimlist[1] = 1.0; /* it's an N X 1 array */
119: }
120: j = arname[0] - 'a'; /* compute j subscript */
121:
122: /*
123: * compute k subscript
124: */
125: if(arname[1] == '\0') /* if no numeric part */
126: k = 0; /* then k = 0th column */
127: else
128: k = arname[1] - '0' + 1;
129:
130: /*
131: * SET SYMBOL TABLE POINTER
132: */
133: if(sasymtab[j][k] == 0)
134: {
135: alloc(&sasymtab[j][k],sizeof(int));
136: }
137: else
138: {
139: if(_comflg) /* if vars commoned */
140: return(0); /* just no_op */
141: error(inst.thing.linno, 23); /* REDUNDANT DIM STATEMENT */
142: return(-1);
143: }
144: /*
145: * CALCULATE MEMORY NEEDED FOR DATA
146: */
147: totsiz = (int)(dimlist[0] * dimlist[1]);
148:
149: totsiz += 2; /* add space for header */
150:
151: totsiz = sizeof(int) * totsiz; /* convert to size in bytes */
152: /*
153: * IF TOTSIZ IS GREATER THAN HIGHEST POS 16 BIT INTEGER,
154: * FORCE IT TO EQUAL THAT MAX SO THAT SIZE CHECK FAILS.
155: * OTHERWISE BYTSIZ WILL CONVERT TO 0 AND APPEAR TO BE
156: * LEGALLY SMALL.
157: */
158: if(totsiz > 32767) totsiz = 32767;
159: bytsiz = totsiz; /* convert size to integer */
160: /*
161: * Return error if not enough space left
162: */
163: if((hicore - bytsiz) <= linptr)
164: {
165: error(inst.thing.linno, 24); /* NOT ENOUGH ADDITIONAL CORE */
166: return(-1);
167: }
168: i = (int)hicore - (int)bytsiz;
169: while((unsigned)hicore > i)
170: {
171: *hicore = '\0'; /* zero each location in array */
172: hicore -= 1;
173: }
174:
175: iptr = (int *)sasymtab[j][k]; /* get pointer to header */
176: *--iptr = (int)numdim; /* put in number of dims */
177: *--iptr = (int)dimlist[0]; /* put in XMAX */
178: *--iptr = (int)dimlist[1]; /* put in YMAX */
179: return(0);
180: }
181: #endif
182: /*
183: * Numerical dimension
184: */
185: ndim()
186: {
187: char *putflot(),*getflot();
188: char arname[3]; /* array symbol name */
189: double conlist[MAXDIM]; /* list of constants a1 -- ak-1 */
190: double dimlist[MAXDIM]; /* dimension list */
191: double numdim; /* number of dimensions */
192: double numcon; /* number of constants */
193: double totsiz; /* space to be allocated in float */
194: unsigned int bytsiz; /* same as totsiz in int form */
195:
196: register char *ptr;
197: register i;
198: register x;
199: int j,k; /* symbol table indicies */
200:
201: ptr = expr; /* get pointer to command argument string */
202:
203: /*
204: * GET ARRAY SYMBOL NAME, NUMBER IF DIMENSIONS &
205: * PUT THE VALUE OF EACH DIMENSION IN DIMLIST
206: */
207: if(getdims(expr,arname,&numdim,dimlist) < 0)
208: return(-1);
209:
210: /*
211: * CALCULATE CONSTANTS a1....ak-1
212: * and PUT THEM IN CONLIST
213: */
214: for(x=1; dimlist[x] != 0.0; x++)
215: {
216: conlist[x-1] = 1; /* init this entry */
217: for(i=x; dimlist[i] != 0.0; i++)
218: {
219: conlist[x-1] *= (dimlist[i] );
220: }
221: }
222: conlist[x-1] = 0.0;
223: numcon = x-1; /* number of constants */
224: j = arname[0] - 'a'; /* compute j subscript */
225:
226: /*
227: * compute k subscript
228: */
229: if(arname[1] == '\0') /* if no numeric part */
230: k = 0; /* then k = 0th column */
231: else
232: k = arname[1] - '0' + 1;
233:
234: /*
235: * SET SYMBOL TABLE POINTER
236: */
237: if(asymtab[j][k] == 0)
238: alloc(&asymtab[j][k],PREC);
239: else
240: {
241: if(_comflg) /* if vars commoned */
242: return(0); /* just no_op */
243: error(inst.thing.linno, 23); /* REDUNDANT DIM STATEMENT */
244: return(-1);
245: }
246:
247: totsiz = 1.0;
248: /*
249: * CALCULATE MEMORY NEEDED FOR DATA
250: */
251: for(i=0; dimlist[i] != 0.0; i++)
252: {
253: totsiz *= dimlist[i];
254: }
255:
256: totsiz += numdim + numcon; /* add space needed for dimensions
257: and constants */
258:
259: totsiz = PREC * totsiz; /* convert to size in bytes */
260: /*
261: * IF TOTSIZ IS GREATER THAN HIGHEST POS 16 BIT INTEGER,
262: * FORCE IT TO EQUAL THAT MAX SO THAT SIZE CHECK FAILS.
263: * OTHERWISE BYTSIZ WILL CONVERT TO 0 AND APPEAR TO BE
264: * LEGALLY SMALL.
265: */
266: if(totsiz > 32767.0) totsiz = 32767.0;
267: bytsiz = totsiz; /* convert size to integer */
268: /*
269: * Return error if not enough space left
270: */
271: if((hicore - bytsiz) <= linptr)
272: {
273: error(inst.thing.linno, 24); /* NOT ENOUGH ADDITIONAL CORE */
274: return(-1);
275: }
276: i = (int)hicore - (int)bytsiz;
277: while((unsigned)hicore > i)
278: {
279: *hicore = '\0'; /* zero each location in array */
280: hicore -= 1;
281: }
282:
283: ptr = asymtab[j][k]; /* get pointer to header */
284: /*
285: * PUT NUMBER OF DIMENSIONS IN HEADER
286: */
287: ptr = putflot(numdim, ptr);
288:
289: /*
290: * PUT DIMENSIONS IN HEADER
291: */
292: for(i=0; dimlist[i] != 0.0; i++)
293: ptr = putflot(dimlist[i], ptr);
294:
295: /*
296: * PUT CONSTANT LIST IN HEADER
297: */
298: for(i=0; conlist[i] != 0.0; i++)
299: ptr = putflot(conlist[i], ptr);
300: return(0);
301: }
302: /*
303: *
304: * ////// PUTFLOT //////
305: *
306: * Copy floating point number into allocated memory
307: * return new pointer value
308: */
309: char *
310: putflot(value,ptr)
311: double value;
312: char *ptr;
313: {
314: register char *p; /* register pointer */
315: register i; /* regster index */
316:
317: p = ptr; /* set reister to address */
318:
319: varbyts.var = value; /* stuff float into byte template */
320:
321: /*
322: * copy float number into allocated space
323: * byte by byte from top down
324: */
325: for(i=PREC-1; i>=0; --i)
326: *--p = varbyts.var4th[i];
327:
328: return(p); /* return new pointer value */
329: }
330:
331: /*
332: * ////// GETFLOT //////
333: *
334: * Copy floating point number OUT of allocated memory
335: * return the floating point value in *valptr
336: * return the next pointer down
337: */
338: char *
339: getflot(valptr,ptr)
340: double *valptr;
341: char *ptr;
342: {
343: register char *p; /* register pointer */
344: register i; /* register index */
345:
346: p = ptr; /* set register to address */
347:
348: for(i=PREC-1; i>=0; --i)
349: varbyts.var4th[i] = *--p;
350:
351: *valptr = varbyts.var; /* return the value to calling routine */
352:
353: return(p); /* return new pointer */
354: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.