PIPS
genread.y
Go to the documentation of this file.
1 %{
2 /*
3 
4  $Id: read.y 1361 2016-07-01 11:57:40Z coelho $
5 
6  Copyright 1989-2014 MINES ParisTech
7 
8  This file is part of NewGen.
9 
10  NewGen is free software: you can redistribute it and/or modify it under the
11  terms of the GNU General Public License as published by the Free Software
12  Foundation, either version 3 of the License, or any later version.
13 
14  NewGen is distributed in the hope that it will be useful, but WITHOUT ANY
15  WARRANTY; without even the implied warranty of MERCHANTABILITY or
16  FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
17  License for more details.
18 
19  You should have received a copy of the GNU General Public License along with
20  NewGen. If not, see <http://www.gnu.org/licenses/>.
21 
22 */
23 
24 /* The syntax of objects printed by GEN_WRITE. */
25 
26 #include <stdio.h>
27 #include <stdlib.h>
28 #include <stdint.h>
29 #include <string.h>
30 
31 #include "genC.h"
32 #include "newgen_include.h"
33 
34 extern void newgen_lexer_position(FILE *);
35 
36 #define YYERROR_VERBOSE 1 /* better error messages by bison */
37 
38 extern int genread_input(void);
39 extern void yyerror(const char*);
40 extern FILE * genread_in;
41 
42 /* This constant should be adapted to the particular need of the application */
43 
44 /* set to 10000 by BC - necessary in PIPS for DYNA */
45 /* Should be a compilation option ? */
46 /* CA: pb avec COX si a 10000...
47  p'tet mauvaise recursion dans le parser de newgen?
48 */
49 #define YYMAXDEPTH 100000
50 
51 /* User selectable options. */
52 
53 int warn_on_ref_without_def_in_read_tabulated = false;
54 
55 /* Where the root will be. */
56 
57 gen_chunk *Read_chunk ;
58 
59 /* The SHARED_TABLE
60  * maps a shared pointer number to its gen_chunk pointer value.
61  * warning: big hack.
62  */
63 static size_t shared_number;
64 static size_t shared_size;
65 static gen_chunk ** shared_table ;
66 
67 /* The GEN_TABULATED_NAMES hash table maps ids to index in the table of
68  the tabulated domains. In case of multiple definition, if the previous
69  value is negative, then it came from a REF (by READ_TABULATED) and
70  no error is reported. */
71 
72 /* Management of forward references in read */
73 
74 int newgen_allow_forward_ref = false;
75 
76 static void * read_external(int);
77 static gen_chunk * make_def(gen_chunk *);
78 static gen_chunk * make_ref(int, gen_chunk *);
79 static gen_chunk * chunk_for_domain(int);
80 
81 static stack current_chunk;
82 static stack current_chunk_index;
83 static stack current_chunk_size;
84 
85 %}
86 
87 %token CHUNK_BEGIN
88 %token VECTOR_BEGIN
89 %token ARROW_BEGIN
90 %token READ_BOOL
91 %token TABULATED_BEGIN
92 %token LP
93 %token RP
94 %token LC
95 %token RC
96 %token LB
97 %token SHARED_POINTER
98 %token READ_EXTERNAL
99 %token READ_DEF
100 %token READ_REF
101 %token READ_NULL
102 
103 %token READ_LIST_UNDEFINED
104 %token READ_SET_UNDEFINED
105 %token READ_ARRAY_UNDEFINED
106 %token READ_STRING
107 
108 %union {
109  gen_chunk chunk ;
110  gen_chunk *chunkp ;
111  cons *consp ;
112  intptr_t val ;
113  char * s;
114  double d;
115  char c;
116 }
117 
118 %term READ_UNIT
119 %term <c> READ_CHAR
120 %term <val> READ_INT
121 %term <d> READ_FLOAT
122 %type <s> READ_STRING
123 %type <chunk> Data Basis
124 %type <chunkp> Chunk String Contents
125 %type <consp> Sparse_Datas Datas
126 %type <val> Int Shared_chunk Type
127 %type <void> Datas2 Datas3
128 
129 %%
130 Read : Nb_of_shared_pointers Contents
131  {
132  Read_chunk = $2;
133 
134  free(shared_table);
135 
136  message_assert("stacks are emty",
137  stack_size(current_chunk)==0 &&
138  stack_size(current_chunk_index)==0 &&
139  stack_size(current_chunk_size)==0);
140 
141  stack_free(&current_chunk);
142  stack_free(&current_chunk_index);
143  stack_free(&current_chunk_size);
144  YYACCEPT;
145  }
146  ;
147 
148 Nb_of_shared_pointers
149  : Int
150  {
151  size_t i;
152  shared_number = 0;
153  shared_size = $1;
154  shared_table = (gen_chunk **)alloc($1*sizeof(gen_chunk*));
155  for (i=0; i<shared_size; i++)
156  shared_table[i] = gen_chunk_undefined;
157 
158  current_chunk = stack_make(0, 0, 0);
159  current_chunk_index = stack_make(0, 0, 0);
160  current_chunk_size = stack_make(0, 0, 0);
161  }
162  ;
163 
164 Contents: Chunk
165  {
166  $$ = $1;
167  }
168  | TABULATED_BEGIN Type Datas2 RP
169  {
170  $$ = (gen_chunk*) alloc(sizeof(gen_chunk));
171  $$->i = $2;
172  }
173  ;
174 
175 Chunk
176  : Shared_chunk CHUNK_BEGIN Type
177  {
178  gen_chunk * x = chunk_for_domain($3);
179  stack_push((void*)(Domains[$3].size), current_chunk_size);
180 
181  if ($1)
182  {
183  shared_table[$1-1] = x;
184  stack_push(x, current_chunk);
185  }
186  else
187  {
188  stack_push(x, current_chunk);
189  }
190  x->i = $3;
191  if (Domains[$3].tabulated)
192  {
193  (x+1)->i = 0; /* tabulated number */
194  stack_push((void*)2, current_chunk_index);
195  }
196  else
197  {
198  stack_push((void*)1, current_chunk_index);
199  }
200  }
201  Datas3 RP
202  {
203  $$ = stack_pop(current_chunk);
204  void *ci = stack_pop(current_chunk_index),
205  *cs = stack_pop(current_chunk_size);
206  message_assert("all data copied", ci == cs );
207  }
208 ;
209 
210 Shared_chunk
211  : LB Int { $$ = $2; }
212  | { $$ = 0; }
213 ;
214 
215 Type: Int
216  {
217  $$ = gen_type_translation_old_to_actual($1);
218  }
219 ;
220 
221 /* We should avoid to build explicit lists, as we know what we are reading? */
222 Datas
223  : Datas Data { $$ = CONS( CHUNK, $2.p, $1 ); }
224  | { $$ = NIL; }
225 ;
226 
227 /* no list is built as it is not needed */
228 Datas2
229  : Datas2 Data { }
230  | { }
231 ;
232 
233 Datas3
234  : Datas3 Data
235  {
236  size_t i = (size_t) stack_pop(current_chunk_index);
237  size_t size = (size_t) stack_head(current_chunk_size);
238  gen_chunk * current = stack_head(current_chunk);
239  if (i >= size) {
240  char * s;
241  int n = asprintf(
242  &s, "wrong index: %d not in [0,%d)", (int) i, (int) size);
243  message_assert("asprintf ok", n >= 0);
244  yyerror(s);
245  }
246  *(current+i) = $2;
247  stack_push((void *)(i+1), current_chunk_index);
248  }
249  | /* empty */ { }
250 ;
251 
252 Sparse_Datas: Sparse_Datas Int Data { /* index, value */
253  $$ = CONS(CONSP, CONS(INT, $2, CONS(CHUNK, $3.p, NIL)), $1);
254  }
255  | { $$ = NIL; }
256  ;
257 
258 Data : Basis { $$ = $1; }
259  | READ_LIST_UNDEFINED { $$.l = list_undefined; }
260  | LP Datas RP { $$.l = gen_nreverse($2); } /* list */
261  | READ_SET_UNDEFINED { $$.t = set_undefined; }
262  | LC Int Datas RC
263  {
264  $$.t = set_make( $2 ) ;
265  MAPL( cp, {
266  switch( $2 ) {
267  case set_int:
268  set_add_element( $$.t, $$.t, (char *)cp->car.i ) ;
269  break ;
270  default:
271  set_add_element( $$.t, $$.t, cp->car.s ) ;
272  break ;
273  }}, $3 ) ;
274  gen_free_list( $3 ) ;
275  }
276  | READ_ARRAY_UNDEFINED { $$.p = array_undefined ; }
277  | VECTOR_BEGIN Int Sparse_Datas RP
278  {
279  gen_chunk *kp ;
280  cons *cp ;
281  int i ;
282 
283  kp = (gen_chunk *)alloc( $2*sizeof( gen_chunk )) ;
284 
285  for( i=0 ; i != $2 ; i++ ) {
286  kp[ i ].p = gen_chunk_undefined ;
287  }
288  for( cp=$3 ; cp!=NULL ; cp=cp->cdr ) {
289  cons *pair = CONSP( CAR( cp )) ;
290  int index = INT(CAR(pair));
291  gen_chunk val = CAR(CDR(pair));
292  assert(index>=0 && index<$2);
293  kp[index] = val;
294 
295  gen_free_list(pair); /* free */
296  }
297 
298  gen_free_list($3);
299  $$.p = kp ;
300  }
301  | ARROW_BEGIN Datas RP {
302  hash_table h = hash_table_make( hash_chunk, 0 ) ;
303  cons *cp ;
304 
305  for( cp = gen_nreverse($2) ; cp != NULL ; cp=cp->cdr->cdr ) {
306  gen_chunk *k = (gen_chunk *)alloc(sizeof(gen_chunk));
307  gen_chunk *v = (gen_chunk *)alloc(sizeof(gen_chunk));
308 
309  *k = CAR( cp ) ;
310  *v = CAR( CDR( cp )) ;
311  hash_put( h, (char *)k, (char *)v ) ;
312  }
313  gen_free_list( $2 ) ;
314  $$.h = h ;
315  }
316  | Chunk { $$.p = $1 ; }
317  | SHARED_POINTER Int
318  {
319  message_assert("shared is defined",
320  shared_table[$2-1]!=gen_chunk_undefined);
321  $$.p = shared_table[$2-1];
322  }
323  ;
324 
325 Basis : READ_UNIT { $$.u = 1; }
326  | READ_BOOL Int { $$.b = $2; }
327  | READ_CHAR { $$.c = $1; }
328  | Int { $$.i = $1; }
329  | READ_FLOAT { $$.f = $1; }
330  | String { $$ = *$1 ; }
331  | READ_EXTERNAL Int { $$.s = (char*) read_external($2); }
332  | READ_DEF Chunk { $$.p = make_def($2); }
333  | READ_REF Type String { $$.p = make_ref($2, $3); }
334  | READ_NULL { $$.p = gen_chunk_undefined ; }
335  ;
336 
337 Int : READ_INT { $$ = $1; }
338  ;
339 
340 String : READ_STRING {
341  gen_chunk *obj = (gen_chunk *)alloc(sizeof(gen_chunk));
342  obj->s = $1;
343  $$ = obj;
344  }
345 
346 %%
347 
348 static gen_chunk * chunk_for_domain(int domain)
349 {
350  gen_chunk * cp;
351  check_domain(domain);
352  cp = (gen_chunk*) alloc(sizeof(gen_chunk)*Domains[domain].size);
353  cp->i = domain;
354  return cp;
355 }
356 
357 /* YYERROR manages a syntax error while reading an object. */
358 
359 void yyerror(const char * s)
360 {
361  int c, n=40;
362  newgen_lexer_position(stderr);
363  fprintf(stderr, "%s before ", s);
364 
365  while (n-->0 && ((c=genread_input()) != EOF))
366  putc(c, stderr);
367 
368  fprintf(stderr, "\n\n");
369 
370  fatal("Incorrect object written by GEN_WRITE\n", (char *) NULL);
371 }
372 
373 /* READ_EXTERNAL reads external types on stdin */
374 
375 static void * read_external(int which)
376 {
377  struct gen_binding *bp;
378  union domain *dp;
379  extern int genread_input();
380 
381  which = gen_type_translation_old_to_actual(which);
382  message_assert("consistent domain number", which>=0 && which<MAX_DOMAIN);
383 
384  bp = &Domains[ which ] ;
385  dp = bp->domain ;
386 
387  if( dp->ba.type != EXTERNAL_DT ) {
388  fatal( "gen_read: undefined external %s\n", bp->name ) ;
389  /*NOTREACHED*/
390  }
391  if( dp->ex.read == NULL ) {
392  user( "gen_read: uninitialized external %s\n", bp->name ) ;
393  return( NULL ) ;
394  }
395  if( genread_input() != ' ' ) {
396  fatal( "read_external: white space expected\n", (char *)NULL ) ;
397  /*NOTREACHED*/
398  }
399  /*
400  Attention, ce qui suit est absolument horrible. Les fonctions
401  suceptibles d'etre appelees a cet endroit sont:
402  - soit des fonctions 'user-written' pour les domaines externes
403  non geres par NewGen
404  - soit la fonctions gen_read pour les domaines externes geres
405  par NewGen
406 
407  Dans le 1er cas, il faut passer la fonction de lecture d'un caractere
408  (yyinput) a la fonction de lecture du domaine externe (on ne peut pas
409  passer le pointeur de fichier car lex bufferise les caracteres en
410  entree). Dans le second cas, il faut passer le pointeur de fichier a
411  cause de yacc/lex.
412 
413  Je decide donc de passer les deux parametres: pointeur de fichier et
414  pointeur de fonction de lecture. Dans chaque cas, l'un ou l'autre sera
415  ignore.
416  */
417  return (*(dp->ex.read))(genread_in, genread_input);
418 }
419 
420 /* MAKE_DEF defines the object CHUNK of name STRING to be in the tabulation
421  table INT. domain translation is handled before in Chunk.
422  */
423 static gen_chunk * make_def(gen_chunk * gc)
424 {
425  int domain = gc->i;
426  string id = (gc+2)->s;
427  return gen_enter_tabulated(domain, id, gc, newgen_allow_forward_ref);
428 }
429 
430 /* MAKE_REF references the object of hash name STRING in the tabulation table
431  INT. Forward references are dealt with here.
432  */
433 static gen_chunk * make_ref(int domain, gen_chunk * st)
434 {
435  gen_chunk * cp = gen_find_tabulated(st->s, domain);
436 
437  if (gen_chunk_undefined_p(cp))
438  {
439  if (newgen_allow_forward_ref)
440  {
441  cp = (gen_chunk*) alloc(sizeof(gen_chunk)*Domains[domain].size);
442  cp->i = domain;
443  (cp+1)->i = 0; /* no number yet */
444  (cp+2)->s = st->s; /* TAKEN! */
445  cp = gen_do_enter_tabulated(domain, st->s, cp, true);
446  }
447  else
448  {
449  user("make_ref: forward references to %s prohibited\n", st->s) ;
450  }
451  }
452  else
453  {
454  free(st->s);
455  }
456 
457  free(st);
458  return cp;
459 }