1 /* $Id: cextspec.c,v 1.17 1997/01/26 14:30:17 cim Exp $ */
2
3 /* Copyright (C) 1994, 1998 Sverre Hvammen Johansen,
4 * Department of Informatics, University of Oslo.
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; version 2.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
18
19 /* Inn og utlesing av externe spesifikasjoner */
20
21 /* TBD: Innlesing av identifikatorer mm m� gj�res mer robust. */
22
23 #include "const.h"
24 #include "dekl.h"
25 #include "filelist.h"
26 #include "newstr.h"
27 #include "cimcomp.h"
28 #include "extspec.h"
29 #include "name.h"
30
31 #if STDC_HEADERS || HAVE_STRING_H
32 #include <string.h>
33 #else /* not STDC_HEADERS and not HAVE_STRING_H */
34 #include <strings.h>
35 #endif /* not STDC_HEADERS and not HAVE_STRING_H */
36
37 #ifdef TIME_WITH_SYS_TIME
38 #include <sys/time.h>
39 #include <time.h>
40 #else
41 #ifdef HAVE_SYS_TIME_H
42 #include <sys/time.h>
43 #else
44 #include <time.h>
45 #endif
46 #endif
47
48 #ifdef STDC_HEADERS
49 #include <stdlib.h>
50 #else
51 double strtod ();
52 #endif
53
54 #include <obstack.h>
55 char *xmalloc();
56 void free();
57
58 #define obstack_chunk_alloc xmalloc
59 #define obstack_chunk_free free
60 static struct obstack osExtspec;
61
62 /* HUSK AT REKKEF\LGEN SKAL V[RE categ,type,kind
63 *
64 * Filen starter alltid med <tidsmerke><LF>
65 *
66 * Deklarasjon av en klasse:
67 *
68 * <categ><type><kind><navn><blank><'!'<prefiks navn><blank> | '&'>
69 * <fornest><blank><connest><blank><blno><blank><ent>
70 * <param.spec><virt. spec><hidden og protected spec><deklarasjoner><LF>
71 *
72 * Deklarasjon og spesifisering av prosedyre:
73 *
74 * <categ><type><kind><navn><blank><(if (type==TREF)<'!'qualnavn><blank>) |
75 * (if (categ==CCPROC)'^'<cnavn><blank>) | '&'>
76 * <blno><blank><ent><param.spec><LF>
77 *
78 *
79 * Spesifisering av vanlige parametere og deklarasjon av variable:
80 *
81 * <categ><type><kind><navn><blank><(if (type==TREF)<qualnavn><blank>)
82 * else if(type==TLABEL)<ent>) else tom>
83 * <(if (categ==CCONST)<value><blank>) | tom>
84 *
85 * Spesifisering av et array:
86 *
87 * <categ><type><kind><navn><blank><(if (type==TREF)<qualnavn><blank>) | tom>
88 * <dim>
89 *
90 * Spesifisering av EXTERNAL klasse eller prosedyre
91 *
92 * <&><type><kind><navn><blank><tidsmerke><blank><filnavn><LF>
93 *
94 *
95 * Alle filer slutter med en ekstra <LF> */
96
97 #define ENDOF_CLASS_PROC_FILE '\n'
98 #define START_NEW_EXTERNAL_SPEC '&'
99 #define PREFIKS_MARKER '!'
100 #define CPROC_MARKER '^'
101 #define NO_MARKER '$'
102 #define inchar(f) getc(f)
103 #define getval(f, i) { int tmp;fscanf(f,"%d",&tmp);i=tmp;}
104 #define getconst(f, i) { fscanf(f,"%d",&i);}
105
106 /******************************************************************************
107 INITEXTSPEC */
initExtspec()108 void initExtspec ()
109 {
110 obstack_init (&osExtspec);
111 }
112
113 /******************************************************************************
114 GETNAME */
115
getname(f)116 static char * getname (f) FILE *f;
117 {
118 int c;
119 char *s, *sx;
120 for (c= getc (f); c !=EOF && c != '\n' && c!= ' '; c= getc (f))
121 obstack_1grow (&osExtspec, c);
122
123 obstack_1grow (&osExtspec, 0);
124 s= obstack_finish (&osExtspec);
125 sx= tag (s);
126 obstack_free (&osExtspec, s);
127 return sx;
128 }
129
130 /* fscanf leter frem til neste \n eller blank (eller til slutten) men lar
131 * \n eller blank bli igjen.
132 * Hvis \n er forste tegn n}r fscanf kalles s} kastes dette tegnet.Men
133 * getc kalles etter fscanf s} vil denne returnere med \n.Derfor m} dette
134 * tegnet leses av etter at hvert navn er lest inn
135 * For � overf�re filnavn id til deklarasjonslageret */
136
137 char *timestamp=""; /* Det globale tidsmerket */
138 char *directive_timestamp="";
139 struct stamp *first_stamp;
140
141 static char timestampchars[63] =
142 {'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
143 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
144 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
145 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
146 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '_'};
147
148 /******************************************************************************
149 GETTIMESTAMP */
150
gettimestamp()151 void gettimestamp ()
152 {
153 #if GET_TIME_OF_DAY
154 static struct timeval tp;
155 static struct timezone tzp;
156 #endif
157
158 FILE *f;
159 int t, th;
160
161 if (strcmp (directive_timestamp, ""))
162 timestamp= directive_timestamp;
163 else if (option_reuse_timestamp && (f = searc_and_open_name_in_archlist
164 (extcodename, TRUE)) != NULL)
165 {
166 if (option_verbose)
167 fprintf (stderr, "Reading atr-file %s\n", extcodename);
168 /* Leser identifikasjon , som alltid ligger f|rst p} filen */
169 {
170 char r_buff[12];
171 r_buff[0] = '\0';
172 fscanf (f, "%11s\n", r_buff);
173 if (strcmp (r_buff, "/*Cim_atr*/"))
174 merror (5, extcodename);
175 }
176
177 timestamp= getname (f);
178 fclose (f);
179 }
180 else
181 {
182 #if GET_TIME_OF_DAY
183 gettimeofday (&tp, &tzp);
184 t = tp.tv_sec;
185 th = tp.tv_usec;
186 #else
187 t = time (NULL);
188 th = 0;
189 #endif
190 th /= 252;
191
192 obstack_1grow (&osExtspec, timestampchars[th - th / 63 * 63]);
193 th /= 63;
194 obstack_1grow (&osExtspec, timestampchars[th - th / 63 * 63]);
195 while (t != 0)
196 {
197 obstack_1grow (&osExtspec, timestampchars[t - t / 63 * 63]);
198 t /= 63;
199 }
200 obstack_1grow (&osExtspec, 0);
201 timestamp= obstack_finish (&osExtspec);
202 }
203 }
204
205 /******************************************************************************
206 GENATRFILENAMEFROMID */
207
208 static char *
genatrfilenamefromid(ident)209 genatrfilenamefromid (ident)
210 char *ident;
211 {
212 int i;
213 char *s, *sx;
214 obstack_grow (&osExtspec, ident, strlen (ident));
215 obstack_grow0 (&osExtspec, ".atr", 4);
216 s= obstack_finish (&osExtspec);
217
218 for (i = strlen (s) - 5; i >= 0; i--)
219 if (s[i] >= 'A' && s[i] <= 'Z')
220 s[i] += 32; /* LOWERCASE */
221 sx= tag (s);
222 obstack_free (&osExtspec, s);
223 return sx;
224 }
225
226 /******************************************************************************
227 GENATRFILENAMEFROMFILENAME */
228
229 static char *
genatrfilenamefromfilename(filename)230 genatrfilenamefromfilename (filename)
231 char *filename;
232 {
233 char *s, *sx;
234 int len = strlen (filename);
235
236 if (len >=4 && !strcmp (&filename[len - 4], ".atr"))
237 return (tag (filename));
238
239 if (len >=4 && !(strcmp (&filename[len - 4], ".sim")
240 && strcmp (&filename[len - 4], ".SIM")
241 && strcmp (&filename[len - 4], ".cim")
242 && strcmp (&filename[len - 4], ".CIM")))
243 obstack_grow (&osExtspec, filename, len - 4);
244 else
245 obstack_grow (&osExtspec, filename, len);
246
247 obstack_grow0 (&osExtspec, ".atr", 4);
248 s= obstack_finish (&osExtspec);
249 sx= tag (s);
250 obstack_free (&osExtspec, s);
251 return sx;
252 }
253
254 /******************************************************************************
255 EXTERNAL_IS_IN */
256
257 static char
external_is_in(ident,kind)258 external_is_in (ident, kind)
259 char *ident;
260 char kind;
261 {
262 struct DECL *rd;
263 struct BLOCK *rb;
264
265 rb = cblock;
266
267 for (rd = rb->parloc; rd != NULL; rd = rd->next)
268 if (rd->ident == ident && rd->kind == kind)
269 return (TRUE);
270
271 return (FALSE);
272 }
273
274 /******************************************************************************
275 NEXTDECL */
276
277 static char *lesinn ();
278
nextdecl(f,filename,timestamp)279 static nextdecl (f, filename, timestamp)
280 FILE *f; char *filename, *timestamp;
281 {
282 char type, kind, categ;
283 char tegn;
284 char *ident;
285
286 char codeclass=0;
287 char *rtname=NULL;
288
289 categ = getc (f);
290
291 if (categ == (char) EOF)
292 merror (5, filename);
293 if (categ == ENDOF_CLASS_PROC_FILE)
294 return (FALSE);
295 else if (categ == START_NEW_EXTERNAL_SPEC)
296 {
297 char *localTimestamp;
298 char *localFilename;
299 type = getc (f);
300 kind = getc (f);
301
302 ident = getname (f); /* Leser navnet */
303 localTimestamp= getname (f); /* tidsmerket */
304 localFilename= getname (f); /* filnavnet */
305
306 if (!external_is_in (ident, kind))
307 {
308 if (localTimestamp != lesinn (localFilename))
309 merror (4, filename);
310 }
311 return (TRUE);
312 }
313
314 type = getc (f);
315 kind = getc (f);
316 ident = getname (f);
317
318 switch (kind)
319 {
320 case KPROC:
321 case KCLASS:
322 tegn = getc (f);
323 if (tegn == PREFIKS_MARKER)
324 {
325 prefquantident = getname (f);
326 tegn = getc (f);
327 if (tegn == CPROC_MARKER)
328 {
329 rtname = getname (f);
330 if (categ != CCPROC)
331 codeclass = getc (f) - '0';
332 else
333 codeclass = CCCPROC;
334 }
335 else
336 ungetc (tegn, f);
337 }
338 else
339 {
340 prefquantident = 0;
341 if (tegn == CPROC_MARKER)
342 {
343 rtname = getname (f);
344 if (categ != CCPROC)
345 codeclass = getc (f) - '0';
346 else
347 codeclass = CCCPROC;
348 }
349 }
350 regDecl (ident, type, kind, categ);
351 beginBlock (kind);
352
353 cblock->timestamp= timestamp;
354 cblock->filename= filename;
355
356 if (kind == KCLASS)
357 {
358 getval (f, cblock->fornest);
359 getval (f, cblock->connest);
360 }
361 getval (f, cblock->ptypno);
362 if (getc (f) == '%')
363 cblock->blno = cblock->ptypno;
364 getval (f, cblock->ent);
365 /* Les inn parametere, virtuelle, hidden, protected og deklarasjoner */
366 while (nextdecl (f, filename, timestamp));
367 endBlock (rtname, codeclass);
368 break;
369 default:
370 if (type == TREF)
371 {
372 prefquantident = getname (f);
373 }
374 switch (categ)
375 {
376 case CCONST:
377 regDecl (ident, type, kind, categ);
378 if (type == TTEXT)
379 {
380 int i;
381 getval (f, i);
382 getc (f);
383 cblock->lastparloc->value.tval.txt= getname (f);
384 }
385 else if (type == TREAL)
386 {
387 char *s;
388 s= getname (f);
389 cblock->lastparloc->value.rval= strtod (s, NULL);
390 }
391 else
392 {
393 getconst (f, cblock->lastparloc->value.ival);
394 getc (f);
395 }
396 break;
397 default:
398 regDecl (ident, type, kind, categ);
399 if (type == TLABEL)
400 getconst (f, cprevdecl->plev);
401 break;
402 }
403 if (kind == KARRAY)
404 getval (f, cblock->lastparloc->dim);
405 }
406 return (TRUE);
407 }
408
409 /******************************************************************************
410 LESINN */
411
lesinn(filename)412 static char *lesinn (filename)
413 char *filename;
414 {
415 struct stamp *st;
416 char *timestamp;
417 FILE *f;
418
419 f = searc_and_open_name_in_archlist (filename, TRUE);
420 if (f == NULL) return (NULL);
421
422 if (option_verbose)
423 fprintf (stderr, "Reading atr-file %s\n", filename);
424 /* Leser identifikasjon , som alltid ligger f|rst p} filen */
425 {
426 char r_buff[12];
427 r_buff[0] = '\0';
428 fscanf (f, "%11s\n", r_buff);
429 if (strcmp (r_buff, "/*Cim_atr*/"))
430 merror (5, filename);
431 }
432
433 /* Leser tidsmerke */
434
435 timestamp= getname (f);
436
437 for (st = first_stamp; st != NULL; st = st->next)
438 if (st->timestamp == timestamp)
439 goto found;
440 st = (struct stamp *) obstack_alloc (&osExtspec, sizeof (struct stamp));
441 st->timestamp = timestamp;
442 st->next = first_stamp;
443 st->lest_inn = FALSE;
444 st->filename = filename;
445 first_stamp = st;
446 found:
447 if (st->filename != filename)
448 merror (11, filename);
449 st->lest_inn = TRUE;
450 /* Leser inn liste med tidsmerker */
451 while (getc (f) == ' ')
452 {
453 char *localTimestamp= getname (f);
454 char *localFilename= getname (f);
455
456 for (st = first_stamp; st != NULL; st = st->next)
457 if (st->timestamp == localTimestamp)
458 goto find_next;
459 st = (struct stamp *) obstack_alloc (&osExtspec, sizeof (struct stamp));
460 st->timestamp = localTimestamp;
461 st->next = first_stamp;
462 st->lest_inn = FALSE;
463 st->filename = localFilename;
464 first_stamp = st;
465 find_next:;
466 if (st->filename != localFilename)
467 merror (11, localFilename);
468 }
469
470 while (nextdecl (f, filename, timestamp));
471
472 fclose (f);
473 return (timestamp);
474 }
475
476 /******************************************************************************
477 LESINN_EXTERNAL_SPEC */
478
479 void
lesinn_external_spec(ident,filename,kind)480 lesinn_external_spec (ident, filename, kind)
481 char *ident;
482 char *filename;
483 char kind;
484 {
485 char *hprefquantident;
486 struct BLOCK *hcblock;
487 struct DECL *hclastdecl,
488 *rd;
489 hprefquantident = prefquantident;
490 hcblock = cblock;
491 hclastdecl = cblock->lastparloc;
492 if (filename == NULL)
493 filename = genatrfilenamefromid (ident);
494 else
495 filename = genatrfilenamefromfilename (filename);
496 if (!external_is_in (ident, kind))
497 {
498 if (lesinn (filename) == NULL)
499 {
500 merror (3, filename);
501 return;
502 }
503 }
504
505 /* Denne modulen skal ha categ=CEXTRMAIN */
506 if (hclastdecl == NULL)
507 rd = hcblock->parloc;
508 else
509 rd = hclastdecl;
510 for (; rd != NULL && rd->ident != ident; rd = rd->next);
511
512 if (rd != NULL)
513 rd->categ = CEXTRMAIN;
514
515 prefquantident = hprefquantident;
516 }
517
518 static char link;
519
520 /******************************************************************************
521 WRITE_INDENTATION */
write_indentation(f,level)522 write_indentation (f, level) FILE *f; int level;
523 {
524 int i;
525 fprintf (f, "\n");
526 for (i=1; i<=level; i++) fprintf (f, " ");
527 }
528
529 /******************************************************************************
530 WRITE_CHAR_MIF */
write_char_mif(f,c)531 static write_char_mif (f, c) FILE *f; unsigned char c;
532 {
533 if ((isprint (c)
534 #if ISO_LATIN
535 || c >= 160
536 #endif
537 ) && c != '!' && c != '"')
538 fprintf (f, "= '%c'", c);
539 else
540 fprintf (f, "= '!%d!'", c);
541 }
542
543 /******************************************************************************
544 WRITE_TEXT_MIF */
write_text_mif(f,s)545 static write_text_mif (f, s) FILE *f; unsigned char *s;
546 {
547 int i;
548 fprintf (f, "= \"");
549 for (i = 0; s[i]; i++)
550 if (s[i] == '\\')
551 {
552 char j = 0;
553 j = j * 8 + s[++i] - '0';
554 j = j * 8 + s[++i] - '0';
555 j = j * 8 + s[++i] - '0';
556 if (j == ' ')
557 putc (' ', f);
558 else
559 fprintf (f, "!%d!", j);
560 }
561 else
562 putc (s[i], f);
563 putc ('"', f);
564 }
565
566 /******************************************************************************
567 WRITE_DECL_MIF */
568
569 void
write_decl_mif(f,rd,level)570 static write_decl_mif (f, rd, level)
571 FILE *f; struct DECL *rd; int level;
572 {
573 if (rd->kind == KBLOKK || rd->kind == KPRBLK || rd->kind == KFOR ||
574 rd->kind == KINSP) return;
575 if (level == 0)
576 {
577 int i;
578 fprintf (f, "\n\n%% **************************************"
579 "************************************* %%\n%% ");
580 for (i= 75-strlen(rd->ident); i>0; i--)fprintf (f, " ");
581 fprintf (f, "%s %%", rd->ident);
582 }
583 write_indentation (f, level);
584 switch(rd->categ)
585 {
586 case CVALUE:
587 fprintf (f, "value: ");
588 break;
589 case CNAME:
590 fprintf (f, "name: ");
591 break;
592 case CVAR:
593 fprintf (f, "var: ");
594 break;
595 case CEXTR:
596 break;
597 case CEXTRMAIN:
598 break;
599 case CEXTROUT:
600 break;
601 case CHIDEN:
602 fprintf (f, "hidden ");
603 break;
604 case CPROT:
605 fprintf (f, "protected ");
606 break;
607 case CHIPRO:
608 fprintf (f, "hidden proteced ");
609 break;
610 case CCPROC:
611 fprintf (f, "external C procedure %s is "
612 ,rd->descr->rtname);
613 break;
614
615 }
616 switch(rd->type)
617 {
618 case TINTG:
619 fprintf (f, "integer ");
620 break;
621 case TREAL:
622 fprintf (f, "real ");
623 break;
624 break;
625 case TBOOL:
626 fprintf (f, "boolean ");
627 break;
628 case TCHAR:
629 fprintf (f, "character ");
630 break;
631 case TLABEL:
632 if (rd->kind == KARRAY) fprintf (f, "switch ");
633 else if (rd->categ != CLOCAL) fprintf (f, "label ");
634 break;
635 case TTEXT:
636 fprintf (f, "text ");
637 break;
638 case TREF:
639 fprintf (f, "ref (%s) ", rd->prefqual->ident);
640 break;
641 case TERROR:
642 break;
643 case TVARARGS:
644 break;
645 }
646 switch(rd->kind)
647 {
648 case KARRAY:
649 if (rd->type != TLABEL) fprintf (f, "array ");
650 break;
651 case KPROC:
652 fprintf (f, "procedure ");
653 break;
654 case KCLASS:
655 if (rd->prefqual != NULL && rd->prefqual != commonprefiks)
656 /* Prefiks klassens navn eller kvalifikasjon */
657 fprintf (f, "%s ", rd->prefqual->ident);
658 fprintf (f, "class ");
659 break;
660 }
661
662 fprintf (f, "%s", rd->ident);
663
664 if (rd->categ == CEXTR || rd->categ == CEXTRMAIN)
665 {
666 fprintf (f, "= \"%s %s\"", rd->descr->timestamp, rd->descr->filename);
667 }
668 else if (rd->kind == KPROC || rd->kind == KCLASS)
669 {
670 struct DECL *rdv;
671 struct BLOCK *rb;
672 struct DECL *rdx;
673 rb = rd->descr;
674 if (rd->categ == CEXTROUT)
675 rd->categ = CEXTR;
676
677 /* evt. parametere */
678 fprintf (f, " (");
679 for (rdx = rb->parloc; rdx != NULL && (rdx->categ == CDEFLT || rdx->categ == CNAME ||
680 rdx->categ == CVAR || rdx->categ == CVALUE)
681 ; rdx = rdx->next)
682 write_decl_mif (f, rdx, level+1);
683
684 fprintf (f, ")");
685
686 switch (rd->categ)
687 {
688 case CDEFLT:
689 case CNAME:
690 case CVAR:
691 case CVALUE:
692 case CVIRT:
693 break;
694 default:
695 fprintf (f, ";");
696 }
697
698 #if 0
699 /* Fornest,Connest,blno,ent */
700 if (rb->quant.kind == KCLASS)
701 fprintf (f, "\n%% f_c_b_e %d %d %d %d",
702 rb->fornest, rb->connest, rb->blno, rb->ent);
703 #endif
704
705 if (rb->quant.kind == KCLASS)
706 {
707 int i;
708 write_indentation (f, level);
709 fprintf (f, "virtual:");
710 /* evt. virtuelle spesifiksajoner , men bare de som er spesifisert */
711 /* i denne klassen. Ikke de akkumulerte. De akkumuleres opp av */
712 /* sjekkdekl senere */
713 i = (rb->quant.plev > 0) ? rb->quant.prefqual->descr->navirt
714 + rb->quant.prefqual->descr->navirtlab : 0;
715 for (rdv = rb->virt; i-- > 0; rdv = rdv->next);
716 for (; rdv != NULL; rdv = rdv->next)
717 write_decl_mif (f, rdv, level+1);
718
719 /* evt. spesifikasjoner av hidden og protected. */
720 for (rdv = rb->hiprot; rdv != NULL; rdv = rdv->next)
721 write_decl_mif (f, rdv, level+1);
722
723 write_indentation (f, level);
724 fprintf (f, "begin");
725 /* Lokale deklarasjoner NB Forutsetter at rdx peker p} forste
726 * deklarasjon */
727 for (; rdx != NULL; rdx = rdx->next)
728 write_decl_mif (f, rdx, level+1);
729 write_indentation (f, level);
730 fprintf (f, "end");
731 }
732 }
733 else
734 {
735 #if 0
736 if (rd->type == TLABEL)
737 fprintf (f, "\n%% ENT %d", rd->plev);
738 #endif
739 if (rd->categ == CCONST)
740 if (rd->type == TTEXT)
741 write_text_mif (f, rd->value.tval.txt);
742 else if (rd->type == TREAL)
743 {
744 char s[100];
745 int i;
746 sprintf (s, "= %.16le", rd->value.rval);
747 for (i=0; s[i]; i++)
748 if (s[i]=='e')
749 {
750 s[i]='&';
751 break;
752 }
753 fprintf (f, s);
754 }
755 else if (rd->type == TCHAR)
756 write_char_mif (f, rd->value.ival);
757 else
758 fprintf (f, "= %d", rd->value.ival);
759 if (rd->kind == KARRAY && rd->type != TLABEL)
760 {
761 int i;
762 fprintf (f, "( ");
763 for (i=2; i<= rd->dim; i++) fprintf (f, ", ");
764 fprintf (f, ")");
765 }
766 }
767
768 switch (rd->categ)
769 {
770 case CDEFLT:
771 case CNAME:
772 case CVAR:
773 case CVALUE:
774 if (rd->next!=NULL && (rd->next->categ == CDEFLT ||
775 rd->next->categ == CNAME ||
776 rd->next->categ == CVAR ||
777 rd->next->categ == CVALUE))
778 fprintf(f, ", ");
779 break;
780 case CLOCAL:
781 if (rd->type == TLABEL && rd->kind == KSIMPLE)
782 {
783 fprintf (f, ":");
784 break;
785 }
786 default:
787 fprintf (f, ";");
788 }
789 }
790
791 /******************************************************************************
792 WRITE_ALL_MIF */
793
write_all_mif()794 write_all_mif ()
795 {
796 /* Trenger ikke skrive ut lokale deklarasjoner i procedyrer */
797
798 struct DECL *rd;
799 struct stamp *st;
800 FILE *f;
801
802 char hcateg;
803
804 if ((f = fopen (mifcodename, "w")) == NULL)
805 merror (9, mifcodename);
806
807 /* Skriver f|rst ut identifikasjon til find */
808 fprintf (f, "%% Cim_mif");
809
810 #if 0
811 /* Skriver ut tidsmerke */
812 fprintf (f, "\n%%timestamp %s", timestamp);
813
814 /* Skriver ut tidsmerke til alle moduler */
815 for (st = first_stamp; st != NULL; st = st->next)
816 fprintf (f, "\n%% timestamp_other_module %s %s"
817 ,st->timestamp, st->filename);
818 #endif
819
820 for (rd = sblock->parloc; rd != NULL; rd = rd->next)
821 if (rd->categ == CEXTR) /* OK */ ;
822 else
823 if (rd->categ == CEXTRMAIN)
824 {
825 rd->categ = CEXTR;
826 write_decl_mif (f, rd, 0);
827 }
828 else
829 {
830 hcateg = rd->categ;
831 if (rd->categ != CCPROC) rd->categ = CEXTROUT;
832 if (rd->kind == KCLASS || rd->kind == KPROC)
833 write_decl_mif (f, rd, 0);
834 rd->categ = hcateg;
835 }
836 fprintf (f, "\n\n%%eof\n");
837 fclose (f);
838 }
839
840 /******************************************************************************
841 WRITE_DECL_EXT */
842
write_decl_ext(f,rd)843 static write_decl_ext (f, rd)
844 FILE *f; struct DECL *rd;
845 {
846 if (rd->kind == KBLOKK || rd->kind == KPRBLK || rd->kind == KFOR ||
847 rd->kind == KINSP) ;
848 else if (rd->categ == CEXTR || rd->categ == CEXTRMAIN)
849 fprintf (f, "&%c%c%s %s %s\n", rd->type, rd->kind
850 ,rd->ident, rd->descr->timestamp, rd->descr->filename);
851 else if (rd->kind == KPROC || rd->kind == KCLASS)
852 {
853 struct DECL *rdv;
854 struct BLOCK *rb;
855 rb = rd->descr;
856 if (rd->categ == CEXTROUT)
857 rd->categ = CEXTR;
858 /* Skriver ut <categ><type><kind><navn><blank> */
859 fprintf (f, "%c%c%c%s ", rd->categ, rd->type, rd->kind,
860 rd->ident);
861
862 if (rd->prefqual != NULL && rd->prefqual != commonprefiks)
863 /* Prefiks klassens navn eller kvalifikasjon */
864 fprintf (f, "%c%s ", PREFIKS_MARKER, rd->prefqual->ident);
865 else if (rd->categ == CCPROC) /* C-navnet */
866 fprintf (f, "%c%s ", CPROC_MARKER
867 ,rd->descr->rtname);
868 else
869 fprintf (f, "%c", NO_MARKER);
870
871 /* Fornest,Connest,blno,ent */
872 if (rb->quant.kind == KCLASS)
873 fprintf (f, "%d %d ", rb->fornest, rb->connest);
874 fprintf (f, "%d %d", rb->blno, rb->ent);
875
876 /* evt. parametere */
877 for (rd = rb->parloc; rd != NULL && (rd->categ == CDEFLT || rd->categ == CNAME ||
878 rd->categ == CVAR || rd->categ == CVALUE)
879 ; rd = rd->next)
880 write_decl_ext (f, rd);
881
882 if (rb->quant.kind == KCLASS)
883 {
884 int i;
885 /* evt. virtuelle spesifiksajoner , men bare de som er spesifisert */
886 /* i denne klassen. Ikke de akkumulerte. De akkumuleres opp av */
887 /* sjekkdekl senere */
888 i = (rb->quant.plev > 0) ? rb->quant.prefqual->descr->navirt
889 + rb->quant.prefqual->descr->navirtlab : 0;
890 for (rdv = rb->virt; i-- > 0; rdv = rdv->next);
891 for (; rdv != NULL; rdv = rdv->next)
892 write_decl_ext (f, rdv);
893
894 /* evt. spesifikasjoner av hidden og protected. */
895 for (rdv = rb->hiprot; rdv != NULL; rdv = rdv->next)
896 write_decl_ext (f, rdv);
897
898 /* Lokale deklarasjoner. NB Forutsetter at rd peker p} forste
899 * deklarasjon */
900 for (; rd != NULL; rd = rd->next)
901 write_decl_ext (f, rd);
902 }
903 fprintf (f, "%c", ENDOF_CLASS_PROC_FILE);
904 }
905 else
906 {
907 fprintf (f, "%c%c%c%s ", rd->categ, rd->type,
908 rd->kind, rd->ident);
909
910 if (rd->type == TREF)
911 fprintf (f, "%s ", rd->prefqual->ident);
912 else if (rd->type == TLABEL)
913 fprintf (f, "%d", rd->plev);
914
915 if (rd->categ == CCONST)
916 if (rd->type == TTEXT)
917 fprintf (f, "%d %s "
918 ,strlen (rd->value.tval.txt)
919 ,rd->value.tval.txt);
920 else if (rd->type == TREAL)
921 fprintf (f, "%.16e ", rd->value.rval);
922 else
923 fprintf (f, "%d ", rd->value.ival);
924 if (rd->kind == KARRAY)
925 fprintf (f, "%c", (rd->dim + ((short) '0')));
926 }
927 }
928
929 /******************************************************************************
930 WRITE_ALL_EXT */
931
write_all_ext()932 write_all_ext ()
933 {
934 /* Trenger ikke skrive ut lokale deklarasjoner i procedyrer */
935
936 struct DECL *rd;
937 struct stamp *st;
938 FILE *f;
939
940 char hcateg;
941
942 #if OPEN_FILE_IN_BINARY_MODE
943 if ((f = fopen (extcodename, "wb")) == NULL)
944 #else
945 if ((f = fopen (extcodename, "w")) == NULL)
946 #endif
947 merror (9, extcodename);
948
949 /* Skriver f|rst ut identifikasjon til find */
950 fprintf (f, "/*Cim_atr*/\n");
951
952 /* Skriver ut tidsmerke */
953 fprintf (f, "%s\n", timestamp);
954
955 /* Skriver ut tidsmerke til alle moduler */
956 for (st = first_stamp; st != NULL; st = st->next)
957 fprintf (f, " %s %s\n"
958 ,st->timestamp, st->filename);
959 fprintf (f, "\n");
960 for (rd = sblock->parloc; rd != NULL; rd = rd->next)
961 if (rd->categ == CEXTR) /* OK */ ;
962 else if (rd->categ == CEXTRMAIN)
963 {
964 rd->categ = CEXTR;
965 write_decl_ext (f, rd);
966 }
967 else
968 {
969 hcateg = rd->categ;
970 if (rd->categ != CCPROC) rd->categ = CEXTROUT;
971 if (rd->kind == KCLASS || rd->kind == KPROC)
972 write_decl_ext (f, rd);
973 rd->categ = hcateg;
974 }
975 fprintf (f, "%c", ENDOF_CLASS_PROC_FILE);
976 fclose (f);
977
978 if (option_write_mif) write_all_mif();
979 }
980
981 /******************************************************************************
982 MORE_MODULES */
983
more_modules()984 more_modules ()
985 {
986 FILE *f;
987 struct stamp *st;
988 char *localTimestamp;
989 for (st = first_stamp; st != NULL; st = st->next)
990 if (st->lest_inn == FALSE && (f = fopen (st->filename,
991 #if OPEN_FILE_IN_BINARY_MODE
992 "rb"
993 #else
994 "r"
995 #endif
996 )) != NULL)
997 {
998 char *newlink_moduler;
999 char r_buff[12];
1000
1001 /* Leser identifikasjon , som alltid ligger f|rst p} filen */
1002 r_buff[0] = '\0';
1003 fscanf (f, "%11s\n", r_buff);
1004 if (strcmp (r_buff, "/*Cim_atr*/"))
1005 merror (5, st->filename);
1006
1007 /* Leser tidsmerke */
1008
1009 localTimestamp= getname (f);
1010 if (localTimestamp == st->timestamp)
1011 {
1012 if (option_verbose)
1013 fprintf (stderr, "Reading atr-file %s\n", st->filename);
1014 insert_name_in_linklist
1015 (transform_name (st->filename, ".atr", ".o"), TRUE);
1016
1017 }
1018 }
1019 }
1020