Quick Search:

View

Revision:
Expand:  
Changeset: MAIN:ragge:20090211155855

Diff

Diff from 1.17 to:

Annotations

Annotate by Age | Author | Mixed | None
/fisheye/browse/pcc/pcc/f77/fcom/misc.c

Annotated File View

ragge
1.17
1 /*      $Id: misc.c,v 1.17 2009/02/11 15:58:55 ragge Exp $      */
ragge
1.2
2 /*
3  * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
4  *
5  * Redistribution and use in source and binary forms, with or without
6  * modification, are permitted provided that the following conditions
7  * are met:
8  *
9  * Redistributions of source code and documentation must retain the above
10  * copyright notice, this list of conditions and the following disclaimer.
11  * Redistributions in binary form must reproduce the above copyright
12  * notice, this list of conditions and the following disclaimer in the
13  * documentation and/or other materials provided with the distribution.
14  * All advertising materials mentioning features or use of this software
15  * must display the following acknowledgement:
16  *      This product includes software developed or owned by Caldera
17  *      International, Inc.
18  * Neither the name of Caldera International, Inc. nor the names of other
19  * contributors may be used to endorse or promote products derived from
20  * this software without specific prior written permission.
21  *
22  * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA
23  * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
24  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
25  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
26  * DISCLAIMED.  IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE
27  * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
28  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
29  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
30  * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT,
31  * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
32  * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
33  * POSSIBILITY OF SUCH DAMAGE.
34  */
35
ragge
1.8
36 #include <string.h>
37
ragge
1.9
38 #include "defines.h"
ragge
1.2
39 #include "defs.h"
ragge
1.1
40
ragge
1.8
41 int max(intint);
ragge
1.1
42
ragge
1.4
43 void
ragge
1.1
44 cpn(nab)
45 register int n;
46 register char *a, *b;
47 {
48 while(--n >= 0)
49         *b++ = *a++;
50 }
51
52
ragge
1.3
53 int
ragge
1.1
54 eqn(nab)
55 register int n;
56 register char *a, *b;
57 {
58 while(--n >= 0)
59         if(*a++ != *b++)
60                 return(NO);
61 return(YES);
62 }
63
64
65
66
67
68
ragge
1.4
69 int
ragge
1.1
70 cmpstr(ablalb)    /* compare two strings */
71 register char *a, *b;
72 ftnint lalb;
73 {
74 register char *aend, *bend;
75 aend = a + la;
76 bend = b + lb;
77
78
79 if(la <= lb)
80         {
81         while(a < aend)
82                 if(*a != *b)
83                         return( *a - *b );
84                 else
85                         { ++a; ++b; }
86
87         while(b < bend)
88                 if(*b != ' ')
89                         return(' ' - *b);
90                 else
91                         ++b;
92         }
93
94 else
95         {
96         while(b < bend)
97                 if(*a != *b)
98                         return( *a - *b );
99                 else
100                         { ++a; ++b; }
101         while(a < aend)
102                 if(*a != ' ')
103                         return(*a - ' ');
104                 else
105                         ++a;
106         }
107 return(0);
108 }
109
110
111
112
113
114 chainp hookup(x,y)
115 register chainp xy;
116 {
117 register chainp p;
118
119 if(x == NULL)
120         return(y);
121
ragge
1.2
122 for(p = x ; p->chain.nextp ; p = p->chain.nextp)
ragge
1.1
123         ;
ragge
1.2
124 p->chain.nextp = y;
ragge
1.1
125 return(x);
126 }
127
128
129
ragge
1.5
130 struct bigblock *mklist(p)
ragge
1.1
131 chainp p;
132 {
ragge
1.5
133 register struct bigblock *q;
ragge
1.1
134
ragge
1.5
135 q = BALLO();
ragge
1.1
136 q->tag = TLIST;
ragge
1.5
137 q->b_list.listp = p;
ragge
1.1
138 return(q);
139 }
140
141
ragge
1.13
142 chainp
143 mkchain(bigptr pchainp q)
ragge
1.1
144 {
ragge
1.13
145         chainp r;
ragge
1.1
146
ragge
1.13
147         if(chains) {
148                 r = chains;
149                 chains = chains->chain.nextp;
150         } else
151                 r = ALLOC(chain);
152
153         r->chain.datap = p;
154         r->chain.nextp = q;
155         return(r);
ragge
1.1
156 }
157
158
159
160 char * varstr(ns)
161 register int n;
162 register char *s;
163 {
164 register int i;
165 static char name[XL+1];
166
167 for(i=0;  i<n && *s!=' ' && *s!='\0' ; ++i)
168         name[i] = *s++;
169
170 name[i] = '\0';
171
172 returnname );
173 }
174
175
176
177
178 char * varunder(ns)
179 register int n;
180 register char *s;
181 {
182 register int i;
183 static char name[XL+1];
184
185 for(i=0;  i<n && *s!=' ' && *s!='\0' ; ++i)
186         name[i] = *s++;
187
188 name[i] = '\0';
189
190 returnname );
191 }
192
193
194
195
196
197 char * nounder(ns)
198 register int n;
199 register char *s;
200 {
201 register int i;
202 static char name[XL+1];
203
204 for(i=0;  i<n && *s!=' ' && *s!='\0' ; ++s)
205         if(*s != '_')
206                 name[i++] = *s;
207
208 name[i] = '\0';
209
210 returnname );
211 }
212
ragge
1.11
213 /*
214  * Save a block on heap.
215  */
216 char *
217 copyn(int nchar *s)
ragge
1.1
218 {
ragge
1.11
219         char *p, *q;
ragge
1.1
220
ragge
1.11
221         p = q = ckalloc(n);
222         while(--n >= 0)
223                 *q++ = *s++;
224         return(p);
ragge
1.1
225 }
226
ragge
1.11
227 /*
228  * Save a string on heap.
229  */
230 char *
231 copys(char *s)
ragge
1.1
232 {
ragge
1.11
233         return(copyn(strlen(s)+1 , s));
ragge
1.1
234 }
235
ragge
1.11
236 /*
237  * convert a string to an int.
238  */
239 ftnint
240 convci(int nchar *s)
ragge
1.1
241 {
ragge
1.11
242         ftnint sum;
243         sum = 0;
244         while(n-- > 0)
245                 sum = 10*sum + (*s++ - '0');
246         return(sum);
ragge
1.1
247 }
248
249 char *convic(n)
250 ftnint n;
251 {
252 static char s[20];
253 register char *t;
254
255 s[19] = '\0';
256 t = s+19;
257
258 do      {
259         *--t = '0' + n%10;
260         n /= 10;
261         } while(n > 0);
262
263 return(t);
264 }
265
266
267
268 double convcd(ns)
269 int n;
270 register char *s;
271 {
272 char v[100];
273 register char *t;
274 if(n > 90)
275         {
276         err("too many digits in floating constant");
277         n = 90;
278         }
279 for(t = v ; n-- > 0 ; s++)
280         *t++ = (*s=='d' ? 'e' : *s);
281 *t = '\0';
282 returnatof(v) );
283 }
284
285
286
ragge
1.5
287 struct bigblock *mkname(ls)
ragge
1.1
288 int l;
289 register char *s;
290 {
291 struct hashentry *hp;
292 int hash;
ragge
1.5
293 register struct bigblock *q;
ragge
1.1
294 register int i;
295 char n[VL];
296
297 hash = 0;
298 for(i = 0 ; i<l && *s!='\0' ; ++i)
299         {
300         hash += *s;
301         n[i] = *s++;
302         }
303 hash %= MAXHASH;
304 whilei < VL )
305         n[i++] = ' ';
306
307 hp = hashtab + hash;
ragge
1.4
308 while((q = hp->varp))
ragge
1.5
309         ifhash==hp->hashval && eqn(VL,n,q->b_name.varname) )
ragge
1.1
310                 return(q);
311         else if(++hp >= lasthash)
312                 hp = hashtab;
313
314 if(++nintnames >= MAXHASH-1)
315         fatal("hash table full");
ragge
1.5
316 hp->varp = q = BALLO();
ragge
1.1
317 hp->hashval = hash;
318 q->tag = TNAME;
ragge
1.5
319 cpn(VLnq->b_name.varname);
ragge
1.1
320 return(q);
321 }
322
323
324
325 struct labelblock *mklabel(l)
326 ftnint l;
327 {
328 register struct labelblock *lp;
329
330 if(l == 0)
331         return(0);
332
333 for(lp = labeltab ; lp < highlabtab ; ++lp)
334         if(lp->stateno == l)
335                 return(lp);
336
337 if(++highlabtab >= labtabend)
338         fatal("too many statement numbers");
339
340 lp->stateno = l;
341 lp->labelno = newlabel();
342 lp->blklevel = 0;
343 lp->labused = NO;
344 lp->labdefined = NO;
345 lp->labinacc = NO;
346 lp->labtype = LABUNKNOWN;
347 return(lp);
348 }
349
ragge
1.3
350 int
ragge
1.1
351 newlabel()
352 {
ragge
1.17
353 returnlastlabno++ );
ragge
1.1
354 }
355
356
357 /* find or put a name in the external symbol table */
358
359 struct extsym *mkext(s)
360 char *s;
361 {
362 int i;
363 register char *t;
364 char n[XL];
365 struct extsym *p;
366
367 i = 0;
368 t = n;
369 while(i<XL && *s)
370         *t++ = *s++;
371 while(t < n+XL)
372         *t++ = ' ';
373
374 for(p = extsymtab ; p<nextext ; ++p)
375         if(eqn(XLnp->extname))
376                 returnp );
377
378 if(nextext >= lastext)
379         fatal("too many external symbols");
380
381 cpn(XLnnextext->extname);
382 nextext->extstg = STGUNKNOWN;
383 nextext->extsave = NO;
384 nextext->extp = 0;
385 nextext->extleng = 0;
386 nextext->maxleng = 0;
387 nextext->extinit = NO;
388 returnnextext++ );
389 }
390
391
392
393
394
395
396
397
ragge
1.5
398 struct bigblock *builtin(ts)
ragge
1.1
399 int t;
400 char *s;
401 {
402 register struct extsym *p;
ragge
1.5
403 register struct bigblock *q;
ragge
1.1
404
405 p = mkext(s);
406 if(p->extstg == STGUNKNOWN)
407         p->extstg = STGEXT;
408 else if(p->extstg != STGEXT)
409         {
410         err1("improper use of builtin %s"s);
411         return(0);
412         }
413
ragge
1.5
414 q = BALLO();
ragge
1.1
415 q->tag = TADDR;
416 q->vtype = t;
417 q->vclass = CLPROC;
418 q->vstg = STGEXT;
ragge
1.5
419 q->b_addr.memno = p - extsymtab;
ragge
1.1
420 return(q);
421 }
422
423
ragge
1.3
424 void
ragge
1.1
425 frchain(p)
426 register chainp *p;
427 {
428 register chainp q;
429
430 if(p==0 || *p==0)
431         return;
432
ragge
1.2
433 for(q = *pq->chain.nextp ; q = q->chain.nextp)
ragge
1.1
434         ;
ragge
1.2
435 q->chain.nextp = chains;
ragge
1.1
436 chains = *p;
437 *p = 0;
438 }
439
440
441 ptr cpblock(n,p)
442 register int n;
ragge
1.8
443 register void * p;
ragge
1.1
444 {
ragge
1.8
445 register char *q, *r = p;
ragge
1.1
446 ptr q0;
447
448 q = q0 = ckalloc(n);
449 while(n-- > 0)
ragge
1.8
450         *q++ = *r++;
ragge
1.1
451 return(q0);
452 }
453
454
ragge
1.8
455 int
ragge
1.1
456 max(a,b)
457 int a,b;
458 {
459 returna>b ? a : b);
460 }
461
462
463 ftnint lmax(ab)
464 ftnint ab;
465 {
466 returna>b ? a : b);
467 }
468
469 ftnint lmin(ab)
470 ftnint ab;
471 {
472 return(a < b ? a : b);
473 }
474
475
476
ragge
1.4
477 int
ragge
1.1
478 maxtype(t1t2)
479 int t1t2;
480 {
481 int t;
482
483 t = max(t1t2);
484 if(t==TYCOMPLEX && (t1==TYDREAL || t2==TYDREAL) )
485         t = TYDCOMPLEX;
486 return(t);
487 }
488
489
490
491 /* return log base 2 of n if n a power of 2; otherwise -1 */
ragge
1.4
492 int
ragge
1.9
493 flog2(n)
ragge
1.1
494 ftnint n;
495 {
496 int k;
497
498 /* trick based on binary representation */
499
500 if(n<=0 || (n & (n-1))!=0)
501         return(-1);
502
503 for(k = 0 ;  n >>= 1  ; ++k)
504         ;
505 return(k);
506 }
507
508
ragge
1.3
509 void
ragge
1.1
510 frrpl()
511 {
ragge
1.8
512 chainp rp;
ragge
1.1
513
514 while(rpllist)
515         {
ragge
1.8
516         rp = rpllist->rplblock.nextp;
ragge
1.15
517         ckfree(rpllist);
ragge
1.1
518         rpllist = rp;
519         }
520 }
521
ragge
1.4
522 void
ragge
1.1
523 popstack(p)
524 register chainp *p;
525 {
526 register chainp q;
527
528 if(p==NULL || *p==NULL)
529         fatal("popstack: stack empty");
ragge
1.2
530 q = (*p)->chain.nextp;
ragge
1.15
531 ckfree(*p);
ragge
1.1
532 *p = q;
533 }
534
535
536
ragge
1.8
537 struct bigblock *
538 callk(typenameargs)
ragge
1.1
539 int type;
540 char *name;
ragge
1.8
541 bigptr args;
ragge
1.1
542 {
ragge
1.5
543 register struct bigblock *p;
ragge
1.1
544
545 p = mkexpr(OPCALLbuiltin(type,name), args);
546 p->vtype = type;
547 return(p);
548 }
549
550
551
ragge
1.8
552 struct bigblock *
553 call4(typenamearg1arg2arg3arg4)
ragge
1.1
554 int type;
555 char *name;
ragge
1.5
556 bigptr arg1arg2arg3arg4;
ragge
1.1
557 {
ragge
1.7
558 struct bigblock *args;
ragge
1.1
559 args = mklistmkchain(arg1mkchain(arg2mkchain(arg3mkchain(arg4NULL)) ) ) );
560 returncallk(typenameargs) );
561 }
562
563
564
565
ragge
1.5
566 struct bigblock *call3(typenamearg1arg2arg3)
ragge
1.1
567 int type;
568 char *name;
ragge
1.5
569 bigptr arg1arg2arg3;
ragge
1.1
570 {
ragge
1.5
571 struct bigblock *args;
ragge
1.1
572 args = mklistmkchain(arg1mkchain(arg2mkchain(arg3NULL) ) ) );
573 returncallk(typenameargs) );
574 }
575
576
577
578
579
ragge
1.8
580 struct bigblock *
581 call2(typenamearg1arg2)
ragge
1.1
582 int type;
583 char *name;
ragge
1.5
584 bigptr arg1arg2;
ragge
1.1
585 {
ragge
1.8
586 bigptr args;
ragge
1.1
587
588 args = mklistmkchain(arg1mkchain(arg2NULL) ) );
589 returncallk(type,nameargs) );
590 }
591
592
593
594
ragge
1.5
595 struct bigblock *call1(typenamearg)
ragge
1.1
596 int type;
597 char *name;
ragge
1.5
598 bigptr arg;
ragge
1.1
599 {
600 returncallk(type,namemklist(mkchain(arg,0)) ));
601 }
602
603
ragge
1.5
604 struct bigblock *call0(typename)
ragge
1.1
605 int type;
606 char *name;
607 {
608 returncallk(typenameNULL) );
609 }
610
611
612
ragge
1.8
613 struct bigblock *
614 mkiodo(dospeclist)
ragge
1.1
615 chainp dospeclist;
616 {
ragge
1.5
617 register struct bigblock *q;
ragge
1.1
618
ragge
1.5
619 q = BALLO();
ragge
1.1
620 q->tag = TIMPLDO;
ragge
1.8
621 q->b_impldo.varnp = (struct bigblock *)dospec;
ragge
1.5
622 q->b_impldo.datalist = list;
ragge
1.1
623 return(q);
624 }
625
626
627
628
ragge
1.8
629 ptr 
ragge
1.15
630 ckalloc(int n)
ragge
1.1
631 {
ragge
1.15
632         ptr p;
ragge
1.1
633
ragge
1.16
634         if ((p = calloc(1, (unsignedn)) == NULL)
ragge
1.15
635                 fatal("out of memory");
ragge
1.16
636 #ifdef PCC_DEBUG
637         if (mflag)
638                 printf("ckalloc: sz %d ptr %p\n"np);
639 #endif
ragge
1.1
640         return(p);
ragge
1.15
641 }
ragge
1.1
642
ragge
1.15
643 void
644 ckfree(void *p)
645 {
ragge
1.16
646 #ifdef PCC_DEBUG
647         if (mflag)
648                 printf("ckfree: ptr %p\n"p);
649 #endif
ragge
1.15
650         free(p);
ragge
1.1
651 }
652
ragge
1.7
653 #if 0
ragge
1.5
654 int
ragge
1.1
655 isaddr(p)
ragge
1.5
656 register bigptr p;
ragge
1.1
657 {
ragge
1.5
658 if(p->tag == TADDR)
ragge
1.1
659         return(YES);
ragge
1.5
660 if(p->tag == TEXPR)
661         switch(p->b_expr.opcode)
ragge
1.1
662                 {
663                 case OPCOMMA:
ragge
1.5
664                         returnisaddr(p->b_expr.rightp) );
ragge
1.1
665
666                 case OPASSIGN:
667                 case OPPLUSEQ:
ragge
1.5
668                         returnisaddr(p->b_expr.leftp) );
ragge
1.1
669                 }
670 return(NO);
671 }
ragge
1.7
672 #endif
ragge
1.1
673
ragge
1.12
674 /*
675  * Return YES if not an expression.
676  */
ragge
1.4
677 int
ragge
1.12
678 addressable(bigptr p)
ragge
1.1
679 {
ragge
1.12
680         switch(p->tag) {
ragge
1.1
681         case TCONST:
682                 return(YES);
683
684         case TADDR:
ragge
1.5
685                 returnaddressable(p->b_addr.memoffset) );
ragge
1.1
686
687         default:
688                 return(NO);
689         }
690 }
691
692
ragge
1.4
693 int
ragge
1.1
694 hextoi(c)
695 register int c;
696 {
697 register char *p;
698 static char p0[17] = "0123456789abcdef";
699
700 for(p = p0 ; *p ; ++p)
701         if(*p == c)
702                 returnp-p0 );
703 return(16);
704 }
FishEye: Open Source License registered to PCC.
Your maintenance has expired. You can renew your license at http://www.atlassian.com/fisheye/renew
Atlassian FishEye, CVS analysis. (Version:1.6.3 Build:build-336 2008-11-04) - Administration - Page generated 2014-09-01 20:30 +0200