OSDN Git Service

* config/alpha/vms.h (INCLUDE_DEFAULTS): Add /gnu/lib/gcc-lib/include.
[pf3gnuchains/gcc-fork.git] / gcc / ch / inout.c
1 /* Implement I/O-related actions for CHILL.
2    Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000
3    Free Software Foundation, Inc.
4    
5    This file is part of GNU CC.
6    
7    GNU CC is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 2, or (at your option)
10    any later version.
11    
12    GNU CC is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16    
17    You should have received a copy of the GNU General Public License
18    along with GNU CC; see the file COPYING.  If not, write to
19    the Free Software Foundation, 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 #include "config.h"
23 #include "system.h"
24 #include "tree.h"
25 #include "ch-tree.h"
26 #include "rtl.h"
27 #include "lex.h"
28 #include "flags.h"
29 #include "input.h"
30 #include "assert.h"
31 #include "toplev.h"
32
33 /* set non-zero if input text is forced to lowercase */
34 extern int ignore_case;
35
36 /* set non-zero if special words are to be entered in uppercase */
37 extern int special_UC;
38
39 static int intsize_of_charsexpr         PARAMS ((tree));
40 static tree add_enum_to_list            PARAMS ((tree, tree));
41 static void build_chill_io_list_type    PARAMS ((void));
42 static void build_io_types              PARAMS ((void));
43 static void declare_predefined_file     PARAMS ((const char *, const char *));
44 static tree build_access_part           PARAMS ((void));
45 static tree textlocation_mode           PARAMS ((tree));
46 static int check_assoc                  PARAMS ((tree, int, const char *));
47 static tree assoc_call                  PARAMS ((tree, tree, const char *));
48 static int check_transfer               PARAMS ((tree, int, const char *));
49 static int connect_process_optionals    PARAMS ((tree, tree *, tree *, tree));
50 static tree connect_text                PARAMS ((tree, tree, tree, tree));
51 static tree connect_access              PARAMS ((tree, tree, tree, tree));
52 static int check_access                 PARAMS ((tree, int, const char *));
53 static int check_text                   PARAMS ((tree, int, const char *));
54 static tree get_final_type_and_range    PARAMS ((tree, tree *, tree *));
55 static void process_io_list             PARAMS ((tree, tree *, tree *, rtx *,
56                                                 int, int));
57 static void check_format_string         PARAMS ((tree, tree, int));
58 static int get_max_size                 PARAMS ((tree));
59
60 /* association mode */
61 tree association_type_node;
62 /* initialzier for association mode */
63 tree association_init_value;
64
65 /* NOTE: should be same as in runtime/chillrt0.c */
66 #define STDIO_TEXT_LENGTH    1024
67 /* mode of stdout, stdin, stderr*/
68 static tree stdio_type_node;
69
70 /* usage- and where modes */
71 tree usage_type_node;
72 tree where_type_node;
73
74 /* we have to distinguish between io-list-type for WRITETEXT
75    and for READTEXT. WRITETEXT does not process ranges and
76    READTEXT must get pointers to the variables.
77    */
78 /* variable to hold the type of the io_list */
79 static tree chill_io_list_type = NULL_TREE;
80
81 /* the type for the enum tables */
82 static tree enum_table_type = NULL_TREE;
83
84 /* structure to save enums for later use in compilation */
85 typedef struct save_enum_names
86 {
87   struct save_enum_names  *forward;
88   tree                    name;
89   tree                    decl;
90 } SAVE_ENUM_NAMES;
91
92 static SAVE_ENUM_NAMES *used_enum_names = (SAVE_ENUM_NAMES *)0;
93
94 typedef struct save_enum_values
95 {
96   long                    val;
97   struct save_enum_names  *name;
98 } SAVE_ENUM_VALUES;
99
100 typedef struct save_enums
101 {
102   struct save_enums       *forward;
103   tree                    context;
104   tree                    type;
105   tree                    ptrdecl;
106   long                    num_vals;
107   struct save_enum_values *vals;
108 } SAVE_ENUMS;
109
110 static SAVE_ENUMS       *used_enums = (SAVE_ENUMS *)0;
111
112 \f
113 /* Function collects all enums are necessary to collect, makes a copy of
114    the value and returns a VAR_DECL external to current function describing
115    the pointer to a name table, which will be generated at the end of
116    compilation
117    */
118
119 static tree add_enum_to_list (type, context)
120      tree  type;
121      tree  context;
122 {
123   tree          tmp;
124   SAVE_ENUMS            *wrk = used_enums;
125   SAVE_ENUM_VALUES      *vals;
126   SAVE_ENUM_NAMES       *names;
127     
128   while (wrk != (SAVE_ENUMS *)0)
129     {
130       /* search for this enum already in use */
131       if (wrk->context == context && wrk->type == type)
132         {
133           /* yes, found. look if the ptrdecl is valid in this scope */
134           tree   var  = DECL_NAME (wrk->ptrdecl);
135           tree   decl = lookup_name (var);
136             
137           if (decl == NULL_TREE)
138             {
139               /* no, not valid in this context, declare it */
140               decl = decl_temp1 (var, build_pointer_type (TREE_TYPE (enum_table_type)),
141                                  0, NULL_TREE, 1, 0);
142             }
143           return decl;
144         }
145         
146       /* next one */
147       wrk = wrk->forward;
148     }
149     
150   /* not yet found -- generate an entry */
151   wrk = (SAVE_ENUMS *)xmalloc (sizeof (SAVE_ENUMS));
152   wrk->forward = used_enums;
153   used_enums = wrk;
154     
155   /* generate the pointer decl */
156   wrk->ptrdecl = get_unique_identifier ("ENUMTABPTR");
157   wrk->ptrdecl = decl_temp1 (wrk->ptrdecl, build_pointer_type (TREE_TYPE (enum_table_type)),
158                              0, NULL_TREE, 1, 0);
159
160   /* save information for later use */
161   wrk->context = context;
162   wrk->type = type;
163
164   /* insert the names and values */
165   tmp = TYPE_FIELDS (type);
166   wrk->num_vals = list_length (tmp);
167   vals = (SAVE_ENUM_VALUES *)xmalloc (sizeof (SAVE_ENUM_VALUES) * wrk->num_vals);
168   wrk->vals = vals;
169     
170   while (tmp != NULL_TREE)
171     {
172       /* search if name is already in use */
173       names = used_enum_names;
174       while (names != (SAVE_ENUM_NAMES *)0)
175         {
176           if (names->name == TREE_PURPOSE (tmp))
177             break;
178           names = names->forward;
179         }
180       if (names == (SAVE_ENUM_NAMES *)0)
181         {
182           /* we have to insert one */
183           names = (SAVE_ENUM_NAMES *)xmalloc (sizeof (SAVE_ENUM_NAMES));
184           names->forward = used_enum_names;
185           used_enum_names = names;
186           names->decl = NULL_TREE;
187           names->name = TREE_PURPOSE (tmp);
188         }
189       vals->name = names;
190       vals->val = TREE_INT_CST_LOW (TREE_VALUE (tmp));
191         
192       /* next entry in enum */
193       vals++;
194       tmp = TREE_CHAIN (tmp);
195     }
196     
197   /* return the generated decl */
198   return wrk->ptrdecl;
199 }
200
201 \f
202 static void
203 build_chill_io_list_type ()
204 {
205   tree list = NULL_TREE;
206   tree result, enum1, listbase;
207   tree io_descriptor;
208   tree decl1, decl2;
209   tree forcharstring, forset_W, forset_R, forboolrange;
210
211   tree forintrange, intunion, forsetrange, forcharrange;
212   tree long_type, ulong_type, union_type;
213     
214   long_type = long_integer_type_node;
215   ulong_type = long_unsigned_type_node;
216
217   if (chill_io_list_type != NULL_TREE)
218     /* already done */
219     return;
220
221   /* first build the enum for the desriptor */
222   enum1 = start_enum (NULL_TREE);
223   result = build_enumerator (get_identifier ("__IO_UNUSED"),
224                              NULL_TREE);
225   list = chainon (result, list);
226     
227   result = build_enumerator (get_identifier ("__IO_ByteVal"),
228                              NULL_TREE);
229   list = chainon (result, list);
230     
231   result = build_enumerator (get_identifier ("__IO_UByteVal"),
232                              NULL_TREE);
233   list = chainon (result, list);
234     
235   result = build_enumerator (get_identifier ("__IO_IntVal"),
236                              NULL_TREE);
237   list = chainon (result, list);
238     
239   result = build_enumerator (get_identifier ("__IO_UIntVal"),
240                              NULL_TREE);
241   list = chainon (result, list);
242     
243   result = build_enumerator (get_identifier ("__IO_LongVal"),
244                              NULL_TREE);
245   list = chainon (result, list);
246     
247   result = build_enumerator (get_identifier ("__IO_ULongVal"),
248                              NULL_TREE);
249   list = chainon (result, list);
250
251   result = build_enumerator (get_identifier ("__IO_ByteLoc"),
252                              NULL_TREE);
253   list = chainon (result, list);
254     
255   result = build_enumerator (get_identifier ("__IO_UByteLoc"),
256                              NULL_TREE);
257   list = chainon (result, list);
258     
259   result = build_enumerator (get_identifier ("__IO_IntLoc"),
260                              NULL_TREE);
261   list = chainon (result, list);
262     
263   result = build_enumerator (get_identifier ("__IO_UIntLoc"),
264                              NULL_TREE);
265   list = chainon (result, list);
266     
267   result = build_enumerator (get_identifier ("__IO_LongLoc"),
268                              NULL_TREE);
269   list = chainon (result, list);
270     
271   result = build_enumerator (get_identifier ("__IO_ULongLoc"),
272                              NULL_TREE);
273   list = chainon (result, list);
274
275   result = build_enumerator (get_identifier ("__IO_ByteRangeLoc"),
276                              NULL_TREE);
277   list = chainon (result, list);
278     
279   result = build_enumerator (get_identifier ("__IO_UByteRangeLoc"),
280                              NULL_TREE);
281   list = chainon (result, list);
282     
283   result = build_enumerator (get_identifier ("__IO_IntRangeLoc"),
284                              NULL_TREE);
285   list = chainon (result, list);
286     
287   result = build_enumerator (get_identifier ("__IO_UIntRangeLoc"),
288                              NULL_TREE);
289   list = chainon (result, list);
290     
291   result = build_enumerator (get_identifier ("__IO_LongRangeLoc"),
292                              NULL_TREE);
293   list = chainon (result, list);
294     
295   result = build_enumerator (get_identifier ("__IO_ULongRangeLoc"),
296                              NULL_TREE);
297   list = chainon (result, list);
298
299   result = build_enumerator (get_identifier ("__IO_BoolVal"),
300                              NULL_TREE);
301   list = chainon (result, list);
302     
303   result = build_enumerator (get_identifier ("__IO_BoolLoc"),
304                              NULL_TREE);
305   list = chainon (result, list);
306     
307   result = build_enumerator (get_identifier ("__IO_BoolRangeLoc"),
308                              NULL_TREE);
309   list = chainon (result, list);
310
311   result = build_enumerator (get_identifier ("__IO_SetVal"),
312                              NULL_TREE);
313   list = chainon (result, list);
314
315   result = build_enumerator (get_identifier ("__IO_SetLoc"),
316                              NULL_TREE);
317   list = chainon (result, list);
318
319   result = build_enumerator (get_identifier ("__IO_SetRangeLoc"),
320                              NULL_TREE);
321   list = chainon (result, list);
322
323   result = build_enumerator (get_identifier ("__IO_CharVal"),
324                              NULL_TREE);
325   list = chainon (result, list);
326     
327   result = build_enumerator (get_identifier ("__IO_CharLoc"),
328                              NULL_TREE);
329   list = chainon (result, list);
330     
331   result = build_enumerator (get_identifier ("__IO_CharRangeLoc"),
332                              NULL_TREE);
333   list = chainon (result, list);
334     
335   result = build_enumerator (get_identifier ("__IO_CharStrLoc"),
336                              NULL_TREE);
337   list = chainon (result, list);
338     
339   result = build_enumerator (get_identifier ("__IO_CharVaryingLoc"),
340                              NULL_TREE);
341   list = chainon (result, list);
342     
343   result = build_enumerator (get_identifier ("__IO_BitStrLoc"),
344                              NULL_TREE);
345   list = chainon (result, list);
346
347   result = build_enumerator (get_identifier ("__IO_RealVal"),
348                              NULL_TREE);
349   list = chainon (result, list);
350     
351   result = build_enumerator (get_identifier ("__IO_RealLoc"),
352                              NULL_TREE);
353   list = chainon (result, list);
354     
355   result = build_enumerator (get_identifier ("__IO_LongRealVal"),
356                              NULL_TREE);
357   list = chainon (result, list);
358     
359   result = build_enumerator (get_identifier ("__IO_LongRealLoc"),
360                              NULL_TREE);
361   list = chainon (result, list);
362 #if 0    
363   result = build_enumerator (get_identifier ("_IO_Pointer"),
364                              NULL_TREE);
365   list = chainon (result, list);
366 #endif    
367
368   result = finish_enum (enum1, list);
369   pushdecl (io_descriptor = build_decl (TYPE_DECL,
370                                         get_identifier ("__tmp_IO_enum"),
371                                         result));
372   /* prevent seizing/granting of the decl */
373   DECL_SOURCE_LINE (io_descriptor) = 0;
374   satisfy_decl (io_descriptor, 0);
375
376   /* build type for enum_tables */
377   decl1 = build_decl (FIELD_DECL, get_identifier ("value"),
378                       long_type);
379   DECL_INITIAL (decl1) = NULL_TREE;
380   decl2 = build_decl (FIELD_DECL, get_identifier ("name"),
381                       build_pointer_type (char_type_node));
382   DECL_INITIAL (decl2) = NULL_TREE;
383   TREE_CHAIN (decl1) = decl2;
384   TREE_CHAIN (decl2) = NULL_TREE;
385   result = build_chill_struct_type (decl1);
386   pushdecl (enum_table_type = build_decl (TYPE_DECL,
387                                           get_identifier ("__tmp_IO_enum_table_type"),
388                                           result));
389   DECL_SOURCE_LINE (enum_table_type) = 0;
390   satisfy_decl (enum_table_type, 0);
391
392   /* build type for writing a set mode */
393   decl1 = build_decl (FIELD_DECL, get_identifier ("value"),
394                       long_type);
395   DECL_INITIAL (decl1) = NULL_TREE;
396   listbase = decl1;
397     
398   decl2 = build_decl (FIELD_DECL, get_identifier ("name_table"),
399                       build_pointer_type (TREE_TYPE (enum_table_type)));
400   DECL_INITIAL (decl2) = NULL_TREE;
401   TREE_CHAIN (decl1) = decl2;
402   decl1 = decl2;
403   TREE_CHAIN (decl2) = NULL_TREE;
404     
405   result = build_chill_struct_type (listbase);
406   pushdecl (forset_W = build_decl (TYPE_DECL,
407                                    get_identifier ("__tmp_WIO_set"),
408                                    result));
409   DECL_SOURCE_LINE (forset_W) = 0;
410   satisfy_decl (forset_W, 0);
411
412   /* build type for charrange */
413   decl1 = build_decl (FIELD_DECL, get_identifier ("ptr"),
414                       build_pointer_type (char_type_node));
415   DECL_INITIAL (decl1) = NULL_TREE;
416   listbase = decl1;
417     
418   decl2 = build_decl (FIELD_DECL, get_identifier ("lower"),
419                       long_type);
420   DECL_INITIAL (decl2) = NULL_TREE;
421   TREE_CHAIN (decl1) = decl2;
422   decl1 = decl2;
423     
424   decl2 = build_decl (FIELD_DECL, get_identifier ("upper"),
425                       long_type);
426   DECL_INITIAL (decl2) = NULL_TREE;
427   TREE_CHAIN (decl1) = decl2;
428   TREE_CHAIN (decl2) = NULL_TREE;
429     
430   result = build_chill_struct_type (listbase);
431   pushdecl (forcharrange = build_decl (TYPE_DECL,
432                                        get_identifier ("__tmp_IO_charrange"),
433                                        result));
434   DECL_SOURCE_LINE (forcharrange) = 0;
435   satisfy_decl (forcharrange, 0);
436     
437   /* type for integer range */
438   decl1 = build_tree_list (NULL_TREE,
439                            build_decl (FIELD_DECL,
440                                        get_identifier ("_slong"),
441                                        long_type));
442   listbase = decl1;
443
444   decl2 = build_tree_list (NULL_TREE,
445                            build_decl (FIELD_DECL,
446                                        get_identifier ("_ulong"),
447                                        ulong_type));
448   TREE_CHAIN (decl1) = decl2;
449   TREE_CHAIN (decl2) = NULL_TREE;
450
451   decl1 = grok_chill_variantdefs (NULL_TREE, listbase, NULL_TREE);
452   TREE_CHAIN (decl1) = NULL_TREE;
453   result = build_chill_struct_type (decl1);
454   pushdecl (intunion = build_decl (TYPE_DECL,
455                                    get_identifier ("__tmp_IO_long"),
456                                    result));
457   DECL_SOURCE_LINE (intunion) = 0;
458   satisfy_decl (intunion, 0);
459
460   decl1 = build_decl (FIELD_DECL,
461                       get_identifier ("ptr"),
462                       ptr_type_node);
463   listbase = decl1;
464
465   decl2 = build_decl (FIELD_DECL,
466                       get_identifier ("lower"),
467                       TREE_TYPE (intunion));
468   TREE_CHAIN (decl1) = decl2;
469   decl1 = decl2;
470
471   decl2 = build_decl (FIELD_DECL,
472                       get_identifier ("upper"),
473                       TREE_TYPE (intunion));
474   TREE_CHAIN (decl1) = decl2;
475   TREE_CHAIN (decl2) = NULL_TREE;
476
477   result = build_chill_struct_type (listbase);
478   pushdecl (forintrange = build_decl (TYPE_DECL,
479                                       get_identifier ("__tmp_IO_intrange"),
480                                       result));
481   DECL_SOURCE_LINE (forintrange) = 0;
482   satisfy_decl (forintrange, 0);
483
484   /* build structure for bool range */
485   decl1 = build_decl (FIELD_DECL,
486                       get_identifier ("ptr"),
487                       ptr_type_node);
488   DECL_INITIAL (decl1) = NULL_TREE;
489   listbase = decl1;
490
491   decl2 = build_decl (FIELD_DECL,
492                       get_identifier ("lower"),
493                       ulong_type);
494   DECL_INITIAL (decl2) = NULL_TREE;
495   TREE_CHAIN (decl1) = decl2;
496   decl1 = decl2;
497
498   decl2 = build_decl (FIELD_DECL,
499                       get_identifier ("upper"),
500                       ulong_type);
501   DECL_INITIAL (decl2) = NULL_TREE;
502   TREE_CHAIN (decl1) = decl2;
503   TREE_CHAIN (decl2) = NULL_TREE;
504
505   result = build_chill_struct_type (listbase);
506   pushdecl (forboolrange = build_decl (TYPE_DECL,
507                                        get_identifier ("__tmp_RIO_boolrange"),
508                                        result));
509   DECL_SOURCE_LINE (forboolrange) = 0;
510   satisfy_decl (forboolrange, 0);
511
512   /* build type for reading a set */
513   decl1 = build_decl (FIELD_DECL, get_identifier ("ptr"),
514                       ptr_type_node);
515   DECL_INITIAL (decl1) = NULL_TREE;
516   listbase = decl1;
517     
518   decl2 = build_decl (FIELD_DECL, get_identifier ("length"),
519                       long_type);
520   DECL_INITIAL (decl2) = NULL_TREE;
521   TREE_CHAIN (decl1) = decl2;
522   decl1 = decl2;
523
524   decl2 = build_decl (FIELD_DECL, get_identifier ("name_table"),
525                       build_pointer_type (TREE_TYPE (enum_table_type)));
526   DECL_INITIAL (decl2) = NULL_TREE;
527   TREE_CHAIN (decl1) = decl2;
528   TREE_CHAIN (decl2) = NULL_TREE;
529     
530   result = build_chill_struct_type (listbase);
531   pushdecl (forset_R = build_decl (TYPE_DECL,
532                                    get_identifier ("__tmp_RIO_set"),
533                                    result));
534   DECL_SOURCE_LINE (forset_R) = 0;
535   satisfy_decl (forset_R, 0);
536     
537   /* build type for setrange */
538   decl1 = build_decl (FIELD_DECL, get_identifier ("ptr"),
539                       ptr_type_node);
540   DECL_INITIAL (decl1) = NULL_TREE;
541   listbase = decl1;
542     
543   decl2 = build_decl (FIELD_DECL, get_identifier ("length"),
544                       long_type);
545   DECL_INITIAL (decl2) = NULL_TREE;
546   TREE_CHAIN (decl1) = decl2;
547   decl1 = decl2;
548     
549   decl2 = build_decl (FIELD_DECL, get_identifier ("name_table"),
550                       build_pointer_type (TREE_TYPE (enum_table_type)));
551   DECL_INITIAL (decl2) = NULL_TREE;
552   TREE_CHAIN (decl1) = decl2;
553   decl1 = decl2;
554     
555   decl2 = build_decl (FIELD_DECL, get_identifier ("lower"),
556                       long_type);
557   DECL_INITIAL (decl2) = NULL_TREE;
558   TREE_CHAIN (decl1) = decl2;
559   decl1 = decl2;
560     
561   decl2 = build_decl (FIELD_DECL, get_identifier ("upper"),
562                       long_type);
563   DECL_INITIAL (decl2) = NULL_TREE;
564   TREE_CHAIN (decl1) = decl2;
565   TREE_CHAIN (decl2) = NULL_TREE;
566     
567   result = build_chill_struct_type (listbase);
568   pushdecl (forsetrange = build_decl (TYPE_DECL,
569                                       get_identifier ("__tmp_RIO_setrange"),
570                                       result));
571   DECL_SOURCE_LINE (forsetrange) = 0;
572   satisfy_decl (forsetrange, 0);
573
574   /* build structure for character string */
575   decl1 = build_decl (FIELD_DECL, 
576                       get_identifier ("string"),
577                       build_pointer_type (char_type_node));
578   DECL_INITIAL (decl1) = NULL_TREE;
579   listbase = decl1;
580     
581   decl2 = build_decl (FIELD_DECL, 
582                       get_identifier ("string_length"),
583                       ulong_type);
584   DECL_INITIAL (decl2) = NULL_TREE;
585   TREE_CHAIN (decl1) = decl2;
586   decl1 = decl2;
587   TREE_CHAIN (decl2) = NULL_TREE;
588     
589   result = build_chill_struct_type (listbase);
590   pushdecl (forcharstring = build_decl (TYPE_DECL,
591                                         get_identifier ("__tmp_IO_forcharstring"), result));
592   DECL_SOURCE_LINE (forcharstring) = 0;
593   satisfy_decl (forcharstring, 0);
594
595   /* build the union */
596   decl1 = build_tree_list (NULL_TREE,
597                            build_decl (FIELD_DECL,
598                                        get_identifier ("__valbyte"),
599                                        signed_char_type_node));
600   listbase = decl1;
601
602   decl2 = build_tree_list (NULL_TREE,
603                            build_decl (FIELD_DECL,
604                                        get_identifier ("__valubyte"),
605                                        unsigned_char_type_node));
606   TREE_CHAIN (decl1) = decl2;
607   decl1 = decl2;
608     
609   decl2 = build_tree_list (NULL_TREE,
610                            build_decl (FIELD_DECL,
611                                        get_identifier ("__valint"),
612                                        chill_integer_type_node)); 
613   TREE_CHAIN (decl1) = decl2;
614   decl1 = decl2;
615     
616   decl2 = build_tree_list (NULL_TREE,
617                            build_decl (FIELD_DECL,
618                                        get_identifier ("__valuint"),
619                                        chill_unsigned_type_node));
620   TREE_CHAIN (decl1) = decl2;
621   decl1 = decl2;
622
623   decl2 = build_tree_list (NULL_TREE,
624                            build_decl (FIELD_DECL,
625                                        get_identifier ("__vallong"),
626                                        long_type));
627   TREE_CHAIN (decl1) = decl2;
628   decl1 = decl2;
629     
630   decl2 = build_tree_list (NULL_TREE,
631                            build_decl (FIELD_DECL,
632                                        get_identifier ("__valulong"),
633                                        ulong_type));
634   TREE_CHAIN (decl1) = decl2;
635   decl1 = decl2;
636     
637   decl2 = build_tree_list (NULL_TREE,
638                            build_decl (FIELD_DECL,
639                                        get_identifier ("__locint"),
640                                        ptr_type_node));
641   TREE_CHAIN (decl1) = decl2;
642   decl1 = decl2;
643
644   decl2 = build_tree_list (NULL_TREE,
645                            build_decl (FIELD_DECL,
646                                        get_identifier ("__locintrange"),
647                                        TREE_TYPE (forintrange)));
648   TREE_CHAIN (decl1) = decl2;
649   decl1 = decl2;
650
651   decl2 = build_tree_list (NULL_TREE,
652                            build_decl (FIELD_DECL,
653                                        get_identifier ("__valbool"),
654                                        boolean_type_node));
655   TREE_CHAIN (decl1) = decl2;
656   decl1 = decl2;
657
658   decl2 = build_tree_list (NULL_TREE,
659                            build_decl (FIELD_DECL,
660                                        get_identifier ("__locbool"),
661                                        build_pointer_type (boolean_type_node)));
662   TREE_CHAIN (decl1) = decl2;
663   decl1 = decl2;
664
665   decl2 = build_tree_list (NULL_TREE,
666                            build_decl (FIELD_DECL,
667                                        get_identifier ("__locboolrange"),
668                                        TREE_TYPE (forboolrange)));
669   TREE_CHAIN (decl1) = decl2;
670   decl1 = decl2;
671
672   decl2 = build_tree_list (NULL_TREE,
673                            build_decl (FIELD_DECL,
674                                        get_identifier ("__valset"),
675                                        TREE_TYPE (forset_W)));
676   TREE_CHAIN (decl1) = decl2;
677   decl1 = decl2;
678
679   decl2 = build_tree_list (NULL_TREE,
680                            build_decl (FIELD_DECL,
681                                        get_identifier ("__locset"),
682                                        TREE_TYPE (forset_R)));
683   TREE_CHAIN (decl1) = decl2;
684   decl1 = decl2;
685
686   decl2 = build_tree_list (NULL_TREE,
687                            build_decl (FIELD_DECL,
688                                        get_identifier ("__locsetrange"),
689                                        TREE_TYPE (forsetrange)));
690   TREE_CHAIN (decl1) = decl2;
691   decl1 = decl2;
692
693   decl2 = build_tree_list (NULL_TREE,
694                            build_decl (FIELD_DECL,
695                                        get_identifier ("__valchar"),
696                                        char_type_node));
697   TREE_CHAIN (decl1) = decl2;
698   decl1 = decl2;
699     
700   decl2 = build_tree_list (NULL_TREE,
701                            build_decl (FIELD_DECL,
702                                        get_identifier ("__locchar"),
703                                        build_pointer_type (char_type_node)));
704   TREE_CHAIN (decl1) = decl2;
705   decl1 = decl2;
706
707   decl2 = build_tree_list (NULL_TREE,
708                            build_decl (FIELD_DECL,
709                                        get_identifier ("__loccharrange"),
710                                        TREE_TYPE (forcharrange)));
711   TREE_CHAIN (decl1) = decl2;
712   decl1 = decl2;
713
714   decl2 = build_tree_list (NULL_TREE,
715                            build_decl (FIELD_DECL,
716                                        get_identifier ("__loccharstring"),
717                                        TREE_TYPE (forcharstring)));
718   TREE_CHAIN (decl1) = decl2;
719   decl1 = decl2;
720
721   decl2 = build_tree_list (NULL_TREE,
722                            build_decl (FIELD_DECL,
723                                        get_identifier ("__valreal"),
724                                        float_type_node));
725   TREE_CHAIN (decl1) = decl2;
726   decl1 = decl2;
727     
728   decl2 = build_tree_list (NULL_TREE,
729                            build_decl (FIELD_DECL,
730                                        get_identifier ("__locreal"),
731                                        build_pointer_type (float_type_node)));
732   TREE_CHAIN (decl1) = decl2;
733   decl1 = decl2;
734     
735   decl2 = build_tree_list (NULL_TREE,
736                            build_decl (FIELD_DECL,
737                                        get_identifier ("__vallongreal"),
738                                        double_type_node));
739   TREE_CHAIN (decl1) = decl2;
740   decl1 = decl2;
741
742   decl2 = build_tree_list (NULL_TREE,
743                            build_decl (FIELD_DECL,
744                                        get_identifier ("__loclongreal"),
745                                        build_pointer_type (double_type_node)));
746   TREE_CHAIN (decl1) = decl2;
747   decl1 = decl2;
748
749 #if 0    
750   decl2 = build_tree_list (NULL_TREE,
751                            build_decl (FIELD_DECL,
752                                        get_identifier ("__forpointer"),
753                                        ptr_type_node));
754   TREE_CHAIN (decl1) = decl2;
755   decl1 = decl2;
756 #endif
757
758   TREE_CHAIN (decl2) = NULL_TREE;
759     
760   decl1 = grok_chill_variantdefs (NULL_TREE, listbase, NULL_TREE);
761   TREE_CHAIN (decl1) = NULL_TREE;
762   result = build_chill_struct_type (decl1);
763   pushdecl (union_type = build_decl (TYPE_DECL,
764                                      get_identifier ("__tmp_WIO_union"),
765                                      result));
766   DECL_SOURCE_LINE (union_type) = 0;
767   satisfy_decl (union_type, 0);
768     
769   /* now build the final structure */
770   decl1 = build_decl (FIELD_DECL, get_identifier ("__t"),
771                       TREE_TYPE (union_type));
772   DECL_INITIAL (decl1) = NULL_TREE;
773   listbase = decl1;
774
775   decl2 = build_decl (FIELD_DECL, get_identifier ("__descr"),
776                       long_type);
777     
778   TREE_CHAIN (decl1) = decl2;
779   TREE_CHAIN (decl2) = NULL_TREE;
780     
781   result = build_chill_struct_type (listbase);
782   pushdecl (chill_io_list_type = build_decl (TYPE_DECL,
783                                              get_identifier ("__tmp_IO_list"),
784                                              result));
785   DECL_SOURCE_LINE (chill_io_list_type) = 0;
786   satisfy_decl (chill_io_list_type, 0);
787 }
788 \f
789 /* build the ASSOCIATION, ACCESS and TEXT mode types */
790 static void
791 build_io_types ()
792 {
793   tree listbase, decl1, decl2, result, association;
794   tree acc, txt, tloc;
795   tree enum1, tmp;
796
797   /* the association mode */
798   listbase = build_decl (FIELD_DECL,
799                          get_identifier ("flags"),
800                          long_unsigned_type_node);
801   DECL_INITIAL (listbase) = NULL_TREE;
802   decl1 = listbase;
803
804   decl2 = build_decl (FIELD_DECL,
805                       get_identifier ("pathname"),
806                       ptr_type_node);
807   DECL_INITIAL (decl2) = NULL_TREE;
808   TREE_CHAIN (decl1) = decl2;
809   decl1 = decl2;
810
811   decl2 = build_decl (FIELD_DECL,
812                       get_identifier ("access"),
813                       ptr_type_node);
814   DECL_INITIAL (decl2) = NULL_TREE;
815   TREE_CHAIN (decl1) = decl2;
816   decl1 = decl2;
817
818   decl2 = build_decl (FIELD_DECL,
819                       get_identifier ("handle"),
820                       integer_type_node);
821   DECL_INITIAL (decl2) = NULL_TREE;
822   TREE_CHAIN (decl1) = decl2;
823   decl1 = decl2;
824
825   decl2 = build_decl (FIELD_DECL,
826                       get_identifier ("bufptr"),
827                       ptr_type_node);
828   DECL_INITIAL (decl2) = NULL_TREE;
829   TREE_CHAIN (decl1) = decl2;
830   decl1 = decl2;
831
832   decl2 = build_decl (FIELD_DECL,
833                       get_identifier ("syserrno"),
834                       long_integer_type_node);
835   DECL_INITIAL (decl2) = NULL_TREE;
836   TREE_CHAIN (decl1) = decl2;
837   decl1 = decl2;
838
839   decl2 = build_decl (FIELD_DECL,
840                       get_identifier ("usage"),
841                       char_type_node);
842   DECL_INITIAL (decl2) = NULL_TREE;
843   TREE_CHAIN (decl1) = decl2;
844   decl1 = decl2;
845
846   decl2 = build_decl (FIELD_DECL,
847                       get_identifier ("ctl_pre"),
848                       char_type_node);
849   DECL_INITIAL (decl2) = NULL_TREE;
850   TREE_CHAIN (decl1) = decl2;
851   decl1 = decl2;
852
853   decl2 = build_decl (FIELD_DECL,
854                       get_identifier ("ctl_post"),
855                       char_type_node);
856   DECL_INITIAL (decl2) = NULL_TREE;
857   TREE_CHAIN (decl1) = decl2;
858   TREE_CHAIN (decl2) = NULL_TREE;
859
860   result = build_chill_struct_type (listbase);
861   pushdecl (association = build_decl (TYPE_DECL,
862                                       ridpointers[(int)RID_ASSOCIATION],
863                                       result));
864   DECL_SOURCE_LINE (association) = 0;
865   satisfy_decl (association, 0);
866   association_type_node = TREE_TYPE (association);
867   TYPE_NAME (association_type_node) = association;
868   CH_NOVELTY (association_type_node) = association;
869   CH_TYPE_NONVALUE_P(association_type_node) = 1;
870   CH_TYPE_NONVALUE_P(association) = 1;
871
872   /* initialiser for association type */
873   tmp = convert (char_type_node, integer_zero_node);
874   association_init_value =
875     build_nt (CONSTRUCTOR, NULL_TREE,
876       tree_cons (NULL_TREE, integer_zero_node,            /* flags */
877         tree_cons (NULL_TREE, null_pointer_node,          /* pathname */
878           tree_cons (NULL_TREE, null_pointer_node,        /* access */
879             tree_cons (NULL_TREE, integer_minus_one_node, /* handle */
880               tree_cons (NULL_TREE, null_pointer_node,    /* bufptr */
881                 tree_cons (NULL_TREE, integer_zero_node,  /* syserrno */
882                   tree_cons (NULL_TREE, tmp,              /* usage */
883                     tree_cons (NULL_TREE, tmp,            /* ctl_pre */
884                       tree_cons (NULL_TREE, tmp,          /* ctl_post */
885                                  NULL_TREE))))))))));
886
887   /* the type for stdin, stdout, stderr */
888   /* text part */
889   decl1 = build_decl (FIELD_DECL,
890                       get_identifier ("flags"),
891                       long_unsigned_type_node);
892   DECL_INITIAL (decl1) = NULL_TREE;
893   listbase = decl1;
894
895   decl2 = build_decl (FIELD_DECL,
896                       get_identifier ("text_record"),
897                       ptr_type_node);
898   DECL_INITIAL (decl2) = NULL_TREE;
899   TREE_CHAIN (decl1) = decl2;
900   decl1 = decl2;
901
902   decl2 = build_decl (FIELD_DECL,
903                       get_identifier ("access_sub"),
904                       ptr_type_node);
905   DECL_INITIAL (decl2) = NULL_TREE;
906   TREE_CHAIN (decl1) = decl2;
907   decl1 = decl2;
908
909   decl2 = build_decl (FIELD_DECL,
910                       get_identifier ("actual_index"),
911                       long_unsigned_type_node);
912   DECL_INITIAL (decl2) = NULL_TREE;
913   TREE_CHAIN (decl1) = decl2;
914   TREE_CHAIN (decl2) = NULL_TREE;
915   txt = build_chill_struct_type (listbase);
916
917   /* access part */
918   decl1 = build_decl (FIELD_DECL,
919                       get_identifier ("flags"),
920                       long_unsigned_type_node);
921   DECL_INITIAL (decl1) = NULL_TREE;
922   listbase = decl1;
923
924   decl2 = build_decl (FIELD_DECL,
925                       get_identifier ("reclength"),
926                       long_unsigned_type_node);
927   DECL_INITIAL (decl2) = NULL_TREE;
928   TREE_CHAIN (decl1) = decl2;
929   decl1 = decl2;
930   
931   decl2 = build_decl (FIELD_DECL,
932                       get_identifier ("lowindex"),
933                       long_integer_type_node);
934   DECL_INITIAL (decl2) = NULL_TREE;
935   TREE_CHAIN (decl1) = decl2;
936   decl1 = decl2;
937
938   decl2 = build_decl (FIELD_DECL,
939                       get_identifier ("highindex"),
940                       long_integer_type_node);
941   DECL_INITIAL (decl2) = NULL_TREE;
942   TREE_CHAIN (decl1) = decl2;
943   decl2 = decl1;
944
945   decl2 = build_decl (FIELD_DECL,
946                       get_identifier ("association"),
947                       ptr_type_node);
948   DECL_INITIAL (decl2) = NULL_TREE;
949   TREE_CHAIN (decl1) = decl2;
950   decl1 = decl2;
951
952   decl2 = build_decl (FIELD_DECL,
953                       get_identifier ("base"),
954                       long_unsigned_type_node);
955   DECL_INITIAL (decl2) = NULL_TREE;
956   TREE_CHAIN (decl1) = decl2;
957   decl1 = decl2;
958
959   decl2 = build_decl (FIELD_DECL,
960                       get_identifier ("storelocptr"),
961                       ptr_type_node);
962   DECL_INITIAL (decl2) = NULL_TREE;
963   TREE_CHAIN (decl1) = decl2;
964   decl1 = decl2;
965
966   decl2 = build_decl (FIELD_DECL,
967                       get_identifier ("rectype"),
968                       long_integer_type_node);
969   DECL_INITIAL (decl2) = NULL_TREE;
970   TREE_CHAIN (decl1) = decl2;
971   TREE_CHAIN (decl2) = NULL_TREE;
972   acc = build_chill_struct_type (listbase);
973
974   /* the location */
975   tmp = build_string_type (char_type_node, build_int_2 (STDIO_TEXT_LENGTH, 0));
976   tloc = build_varying_struct (tmp);
977
978   /* now the final mode */
979   decl1 = build_decl (FIELD_DECL, get_identifier ("txt"), txt);
980   listbase = decl1;
981
982   decl2 = build_decl (FIELD_DECL, get_identifier ("acc"), acc);
983   TREE_CHAIN (decl1) = decl2;
984   decl1 = decl2;
985
986   decl2 = build_decl (FIELD_DECL, get_identifier ("tloc"), tloc);
987   TREE_CHAIN (decl1) = decl2;
988   decl1 = decl2;
989
990   decl2 = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
991                            void_type_node);
992   TREE_CHAIN (decl1) = decl2;
993   decl1 = decl2;
994
995   decl2 = build_decl (CONST_DECL, get_identifier ("__textlength"),
996                       integer_type_node);
997   DECL_INITIAL (decl2) = build_int_2 (STDIO_TEXT_LENGTH, 0);
998   TREE_CHAIN (decl1) = decl2;
999   decl1 = decl2;
1000
1001   decl2 = build_decl (CONST_DECL, get_identifier ("__dynamic"),
1002                       integer_type_node);
1003   DECL_INITIAL (decl2) = integer_zero_node;
1004   TREE_CHAIN (decl1) = decl2;
1005   TREE_CHAIN (decl2) = NULL_TREE;
1006
1007   result = build_chill_struct_type (listbase);
1008   pushdecl (tmp = build_decl (TYPE_DECL,
1009                               get_identifier ("__stdio_text"),
1010                               result));
1011   DECL_SOURCE_LINE (tmp) = 0;
1012   satisfy_decl (tmp, 0);
1013   stdio_type_node = TREE_TYPE (tmp);
1014   CH_IS_TEXT_MODE (stdio_type_node) = 1;
1015
1016   /* predefined usage mode */
1017   enum1 = start_enum (NULL_TREE);
1018   listbase = NULL_TREE;
1019   result = build_enumerator (
1020             get_identifier ((ignore_case || ! special_UC) ? "readonly" : "READONLY"),
1021                              NULL_TREE);
1022   listbase = chainon (result, listbase);
1023   result = build_enumerator (
1024             get_identifier ((ignore_case || ! special_UC) ? "writeonly" : "WRITEONLY"),
1025                              NULL_TREE);
1026   listbase = chainon (result, listbase);
1027   result = build_enumerator (
1028             get_identifier ((ignore_case || ! special_UC) ? "readwrite" : "READWRITE"),
1029                              NULL_TREE);
1030   listbase = chainon (result, listbase);
1031   result = finish_enum (enum1, listbase);
1032   pushdecl (tmp = build_decl (TYPE_DECL,
1033                               get_identifier ((ignore_case || ! special_UC) ? "usage" : "USAGE"),
1034                               result));
1035   DECL_SOURCE_LINE (tmp) = 0;
1036   satisfy_decl (tmp, 0);
1037   usage_type_node = TREE_TYPE (tmp);
1038   TYPE_NAME (usage_type_node) = tmp;
1039   CH_NOVELTY (usage_type_node) = tmp;
1040
1041   /* predefined where mode */
1042   enum1 = start_enum (NULL_TREE);
1043   listbase = NULL_TREE;
1044   result = build_enumerator (
1045             get_identifier ((ignore_case || ! special_UC) ? "first" : "FIRST"),
1046                              NULL_TREE);
1047   listbase = chainon (result, listbase);
1048   result = build_enumerator (
1049             get_identifier ((ignore_case || ! special_UC) ? "same" : "SAME"),
1050                              NULL_TREE);
1051   listbase = chainon (result, listbase);
1052   result = build_enumerator (
1053             get_identifier ((ignore_case || ! special_UC) ? "last" : "LAST"),
1054                              NULL_TREE);
1055   listbase = chainon (result, listbase);
1056   result = finish_enum (enum1, listbase);
1057   pushdecl (tmp = build_decl (TYPE_DECL,
1058                               get_identifier ((ignore_case || ! special_UC) ? "where" : "WHERE"),
1059                               result));
1060   DECL_SOURCE_LINE (tmp) = 0;
1061   satisfy_decl (tmp, 0);
1062   where_type_node = TREE_TYPE (tmp);
1063   TYPE_NAME (where_type_node) = tmp;
1064   CH_NOVELTY (where_type_node) = tmp;
1065 }
1066 \f
1067 static void
1068 declare_predefined_file (name, assembler_name)
1069      const char *name;
1070      const char *assembler_name;
1071 {
1072   tree decl = build_lang_decl (VAR_DECL, get_identifier (name),
1073                                stdio_type_node);
1074   DECL_ASSEMBLER_NAME (decl) = get_identifier(assembler_name);
1075   TREE_STATIC (decl) = 1;
1076   TREE_PUBLIC (decl) = 1;
1077   DECL_EXTERNAL (decl) = 1;
1078   DECL_IN_SYSTEM_HEADER (decl) = 1;
1079   make_decl_rtl (decl, 0, 1);
1080   pushdecl (decl);
1081 }
1082 \f
1083
1084 /* initialisation of all IO/related functions, types, etc. */
1085 void
1086 inout_init ()
1087 {
1088   /* We temporarily reset the maximum_field_alignment to zero so the
1089      compiler's init data structures can be compatible with the
1090      run-time system, even when we're compiling with -fpack. */
1091   unsigned int save_maximum_field_alignment = maximum_field_alignment;
1092
1093   extern tree chill_predefined_function_type;
1094   tree endlink = void_list_node;
1095   tree bool_ftype_ptr_ptr_int;
1096   tree ptr_ftype_ptr_ptr_int;
1097   tree luns_ftype_ptr_ptr_int;
1098   tree int_ftype_ptr_ptr_int;
1099   tree ptr_ftype_ptr_ptr_int_ptr_int_ptr_int;
1100   tree void_ftype_ptr_ptr_int_ptr_int_ptr_int;
1101   tree void_ftype_ptr_ptr_int;
1102   tree void_ftype_ptr_ptr_int_int_int_long_ptr_int;
1103   tree ptr_ftype_ptr_int_ptr_ptr_int;
1104   tree void_ftype_ptr_int_ptr_luns_ptr_int;
1105   tree void_ftype_ptr_ptr_ptr_int;
1106   tree void_ftype_ptr_int_ptr_int;
1107   tree void_ftype_ptr_int_ptr_int_ptr_int_ptr_int;
1108
1109   maximum_field_alignment = 0;
1110
1111   builtin_function ((ignore_case || ! special_UC) ? "associate" : "ASSOCIATE",
1112                     chill_predefined_function_type,
1113                     BUILT_IN_ASSOCIATE, BUILT_IN_NORMAL, NULL_PTR);
1114   builtin_function ((ignore_case || ! special_UC) ? "connect" : "CONNECT",
1115                     chill_predefined_function_type,
1116                     BUILT_IN_CONNECT, BUILT_IN_NORMAL, NULL_PTR);
1117   builtin_function ((ignore_case || ! special_UC) ? "create" : "CREATE",
1118                     chill_predefined_function_type,
1119                     BUILT_IN_CREATE, BUILT_IN_NORMAL, NULL_PTR);
1120   builtin_function ((ignore_case || ! special_UC) ? "delete" : "DELETE",
1121                     chill_predefined_function_type,
1122                     BUILT_IN_CH_DELETE, BUILT_IN_NORMAL, NULL_PTR);
1123   builtin_function ((ignore_case || ! special_UC) ? "disconnect" : "DISCONNECT",
1124                     chill_predefined_function_type,
1125                     BUILT_IN_DISCONNECT, BUILT_IN_NORMAL, NULL_PTR);
1126   builtin_function ((ignore_case || ! special_UC) ? "dissociate" : "DISSOCIATE",
1127                     chill_predefined_function_type,
1128                     BUILT_IN_DISSOCIATE, BUILT_IN_NORMAL, NULL_PTR);
1129   builtin_function ((ignore_case || ! special_UC) ? "eoln" : "EOLN",
1130                     chill_predefined_function_type,
1131                     BUILT_IN_EOLN, BUILT_IN_NORMAL, NULL_PTR);
1132   builtin_function ((ignore_case || ! special_UC) ? "existing" : "EXISTING",
1133                     chill_predefined_function_type,
1134                     BUILT_IN_EXISTING, BUILT_IN_NORMAL, NULL_PTR);
1135   builtin_function ((ignore_case || ! special_UC) ? "getassociation" : "GETASSOCIATION",
1136                     chill_predefined_function_type,
1137                     BUILT_IN_GETASSOCIATION, BUILT_IN_NORMAL, NULL_PTR);
1138   builtin_function ((ignore_case || ! special_UC) ? "gettextaccess" : "GETTEXTASSCESS",
1139                     chill_predefined_function_type,
1140                     BUILT_IN_GETTEXTACCESS, BUILT_IN_NORMAL, NULL_PTR);
1141   builtin_function ((ignore_case || ! special_UC) ? "gettextindex" : "GETTEXTINDEX",
1142                     chill_predefined_function_type,
1143                     BUILT_IN_GETTEXTINDEX, BUILT_IN_NORMAL, NULL_PTR);
1144   builtin_function ((ignore_case || ! special_UC) ? "gettextrecord" : "GETTEXTRECORD",
1145                     chill_predefined_function_type,
1146                     BUILT_IN_GETTEXTRECORD, BUILT_IN_NORMAL, NULL_PTR);
1147   builtin_function ((ignore_case || ! special_UC) ? "getusage" : "GETUSAGE",
1148                     chill_predefined_function_type,
1149                     BUILT_IN_GETUSAGE, BUILT_IN_NORMAL, NULL_PTR);
1150   builtin_function ((ignore_case || ! special_UC) ? "indexable" : "INDEXABLE",
1151                     chill_predefined_function_type,
1152                     BUILT_IN_INDEXABLE, BUILT_IN_NORMAL, NULL_PTR);
1153   builtin_function ((ignore_case || ! special_UC) ? "isassociated" : "ISASSOCIATED",
1154                     chill_predefined_function_type,
1155                     BUILT_IN_ISASSOCIATED, BUILT_IN_NORMAL, NULL_PTR);
1156   builtin_function ((ignore_case || ! special_UC) ? "modify" : "MODIFY",
1157                     chill_predefined_function_type,
1158                     BUILT_IN_MODIFY, BUILT_IN_NORMAL, NULL_PTR);
1159   builtin_function ((ignore_case || ! special_UC) ? "outoffile" : "OUTOFFILE",
1160                     chill_predefined_function_type,
1161                     BUILT_IN_OUTOFFILE, BUILT_IN_NORMAL, NULL_PTR);
1162   builtin_function ((ignore_case || ! special_UC) ? "readable" : "READABLE",
1163                     chill_predefined_function_type,
1164                     BUILT_IN_READABLE, BUILT_IN_NORMAL, NULL_PTR);
1165   builtin_function ((ignore_case || ! special_UC) ? "readrecord" : "READRECORD",
1166                     chill_predefined_function_type,
1167                     BUILT_IN_READRECORD, BUILT_IN_NORMAL, NULL_PTR);
1168   builtin_function ((ignore_case || ! special_UC) ? "readtext" : "READTEXT",
1169                     chill_predefined_function_type,
1170                     BUILT_IN_READTEXT, BUILT_IN_NORMAL, NULL_PTR);
1171   builtin_function ((ignore_case || ! special_UC) ? "sequencible" : "SEQUENCIBLE",
1172                     chill_predefined_function_type,
1173                     BUILT_IN_SEQUENCIBLE, BUILT_IN_NORMAL, NULL_PTR);
1174   builtin_function ((ignore_case || ! special_UC) ? "settextaccess" : "SETTEXTACCESS",
1175                     chill_predefined_function_type,
1176                     BUILT_IN_SETTEXTACCESS, BUILT_IN_NORMAL, NULL_PTR);
1177   builtin_function ((ignore_case || ! special_UC) ? "settextindex" : "SETTEXTINDEX",
1178                     chill_predefined_function_type,
1179                     BUILT_IN_SETTEXTINDEX, BUILT_IN_NORMAL, NULL_PTR);
1180   builtin_function ((ignore_case || ! special_UC) ? "settextrecord" : "SETTEXTRECORD",
1181                     chill_predefined_function_type,
1182                     BUILT_IN_SETTEXTRECORD, BUILT_IN_NORMAL, NULL_PTR);
1183   builtin_function ((ignore_case || ! special_UC) ? "variable" : "VARIABLE",
1184                     chill_predefined_function_type,
1185                     BUILT_IN_VARIABLE, BUILT_IN_NORMAL, NULL_PTR);
1186   builtin_function ((ignore_case || ! special_UC) ? "writeable" : "WRITEABLE",
1187                     chill_predefined_function_type,
1188                     BUILT_IN_WRITEABLE, BUILT_IN_NORMAL, NULL_PTR);
1189   builtin_function ((ignore_case || ! special_UC) ? "writerecord" : "WRITERECORD",
1190                     chill_predefined_function_type,
1191                     BUILT_IN_WRITERECORD, BUILT_IN_NORMAL, NULL_PTR);
1192   builtin_function ((ignore_case || ! special_UC) ? "writetext" : "WRITETEXT",
1193                     chill_predefined_function_type,
1194                     BUILT_IN_WRITETEXT, BUILT_IN_NORMAL, NULL_PTR);
1195
1196   /* build function prototypes */
1197   bool_ftype_ptr_ptr_int = 
1198     build_function_type (boolean_type_node,
1199       tree_cons (NULL_TREE, ptr_type_node,
1200         tree_cons (NULL_TREE, ptr_type_node,
1201           tree_cons (NULL_TREE, integer_type_node,
1202             endlink))));
1203   ptr_ftype_ptr_ptr_int_ptr_int_ptr_int = 
1204     build_function_type (ptr_type_node,
1205       tree_cons (NULL_TREE, ptr_type_node,
1206         tree_cons (NULL_TREE, ptr_type_node,
1207           tree_cons (NULL_TREE, integer_type_node,
1208             tree_cons (NULL_TREE, ptr_type_node,
1209               tree_cons (NULL_TREE, integer_type_node,
1210                 tree_cons (NULL_TREE, ptr_type_node,
1211                   tree_cons (NULL_TREE, integer_type_node,
1212                     endlink))))))));
1213   void_ftype_ptr_ptr_int = 
1214     build_function_type (void_type_node,
1215       tree_cons (NULL_TREE, ptr_type_node,
1216         tree_cons (NULL_TREE, ptr_type_node,
1217           tree_cons (NULL_TREE, integer_type_node,
1218             endlink))));
1219   void_ftype_ptr_ptr_int_ptr_int_ptr_int = 
1220     build_function_type (void_type_node,
1221       tree_cons (NULL_TREE, ptr_type_node,
1222         tree_cons (NULL_TREE, ptr_type_node,
1223           tree_cons (NULL_TREE, integer_type_node,
1224             tree_cons (NULL_TREE, ptr_type_node,
1225               tree_cons (NULL_TREE, integer_type_node,
1226                 tree_cons (NULL_TREE, ptr_type_node,
1227                   tree_cons (NULL_TREE, integer_type_node,
1228                     endlink))))))));
1229   void_ftype_ptr_ptr_int_int_int_long_ptr_int =
1230     build_function_type (void_type_node,
1231       tree_cons (NULL_TREE, ptr_type_node,
1232         tree_cons (NULL_TREE, ptr_type_node,
1233           tree_cons (NULL_TREE, integer_type_node,
1234             tree_cons (NULL_TREE, integer_type_node,
1235               tree_cons (NULL_TREE, integer_type_node,
1236                 tree_cons (NULL_TREE, long_integer_type_node,
1237                   tree_cons (NULL_TREE, ptr_type_node,
1238                     tree_cons (NULL_TREE, integer_type_node,
1239                       endlink)))))))));
1240   ptr_ftype_ptr_ptr_int = 
1241     build_function_type (ptr_type_node,
1242       tree_cons (NULL_TREE, ptr_type_node,
1243         tree_cons (NULL_TREE, ptr_type_node,
1244           tree_cons (NULL_TREE, integer_type_node,
1245             endlink))));
1246   int_ftype_ptr_ptr_int = 
1247     build_function_type (integer_type_node,
1248       tree_cons (NULL_TREE, ptr_type_node,
1249         tree_cons (NULL_TREE, ptr_type_node,
1250           tree_cons (NULL_TREE, integer_type_node,
1251             endlink))));
1252   ptr_ftype_ptr_int_ptr_ptr_int = 
1253     build_function_type (ptr_type_node,
1254       tree_cons (NULL_TREE, ptr_type_node,
1255         tree_cons (NULL_TREE, integer_type_node,
1256           tree_cons (NULL_TREE, ptr_type_node,
1257             tree_cons (NULL_TREE, ptr_type_node,
1258               tree_cons (NULL_TREE, integer_type_node,
1259                 endlink))))));
1260   void_ftype_ptr_int_ptr_luns_ptr_int = 
1261     build_function_type (void_type_node,
1262       tree_cons (NULL_TREE, ptr_type_node,
1263         tree_cons (NULL_TREE, integer_type_node,
1264           tree_cons (NULL_TREE, ptr_type_node,
1265             tree_cons (NULL_TREE, long_unsigned_type_node,
1266               tree_cons (NULL_TREE, ptr_type_node,
1267                 tree_cons (NULL_TREE, integer_type_node,
1268                   endlink)))))));
1269   luns_ftype_ptr_ptr_int = 
1270     build_function_type (long_unsigned_type_node,
1271       tree_cons (NULL_TREE, ptr_type_node,
1272         tree_cons (NULL_TREE, ptr_type_node,
1273           tree_cons (NULL_TREE, integer_type_node,
1274             endlink))));
1275   void_ftype_ptr_ptr_ptr_int = 
1276     build_function_type (void_type_node,
1277       tree_cons (NULL_TREE, ptr_type_node,
1278         tree_cons (NULL_TREE, ptr_type_node,
1279           tree_cons (NULL_TREE, ptr_type_node,
1280             tree_cons (NULL_TREE, integer_type_node,
1281               endlink)))));
1282   void_ftype_ptr_int_ptr_int = 
1283     build_function_type (void_type_node,
1284       tree_cons (NULL_TREE, ptr_type_node,
1285         tree_cons (NULL_TREE, integer_type_node,
1286           tree_cons (NULL_TREE, ptr_type_node,
1287             tree_cons (NULL_TREE, integer_type_node,
1288               endlink)))));
1289   void_ftype_ptr_int_ptr_int_ptr_int_ptr_int =
1290     build_function_type (void_type_node,
1291       tree_cons (NULL_TREE, ptr_type_node,
1292         tree_cons (NULL_TREE, integer_type_node,
1293           tree_cons (NULL_TREE, ptr_type_node,
1294             tree_cons (NULL_TREE, integer_type_node,
1295               tree_cons (NULL_TREE, ptr_type_node,
1296                 tree_cons (NULL_TREE, integer_type_node,
1297                   tree_cons (NULL_TREE, ptr_type_node,
1298                     tree_cons (NULL_TREE, integer_type_node,
1299                       endlink)))))))));
1300
1301   builtin_function ("__associate", ptr_ftype_ptr_ptr_int_ptr_int_ptr_int,
1302                     0, NOT_BUILT_IN, NULL_PTR);
1303   builtin_function ("__connect", void_ftype_ptr_ptr_int_int_int_long_ptr_int,
1304                     0, NOT_BUILT_IN, NULL_PTR);
1305   builtin_function ("__create", void_ftype_ptr_ptr_int,
1306                     0, NOT_BUILT_IN, NULL_PTR);
1307   builtin_function ("__delete", void_ftype_ptr_ptr_int,
1308                     0, NOT_BUILT_IN, NULL_PTR);
1309   builtin_function ("__disconnect", void_ftype_ptr_ptr_int,
1310                     0, NOT_BUILT_IN, NULL_PTR);
1311   builtin_function ("__dissociate", void_ftype_ptr_ptr_int,
1312                     0, NOT_BUILT_IN, NULL_PTR);
1313   builtin_function ("__eoln", bool_ftype_ptr_ptr_int,
1314                     0, NOT_BUILT_IN, NULL_PTR);
1315   builtin_function ("__existing", bool_ftype_ptr_ptr_int,
1316                     0, NOT_BUILT_IN, NULL_PTR);
1317   builtin_function ("__getassociation", ptr_ftype_ptr_ptr_int,
1318                     0, NOT_BUILT_IN, NULL_PTR);
1319   builtin_function ("__gettextaccess", ptr_ftype_ptr_ptr_int,
1320                     0, NOT_BUILT_IN, NULL_PTR);
1321   builtin_function ("__gettextindex", luns_ftype_ptr_ptr_int,
1322                     0, NOT_BUILT_IN, NULL_PTR);
1323   builtin_function ("__gettextrecord", ptr_ftype_ptr_ptr_int,
1324                     0, NOT_BUILT_IN, NULL_PTR);
1325   builtin_function ("__getusage", int_ftype_ptr_ptr_int,
1326                     0, NOT_BUILT_IN, NULL_PTR);
1327   builtin_function ("__indexable", bool_ftype_ptr_ptr_int,
1328                     0, NOT_BUILT_IN, NULL_PTR);
1329   builtin_function ("__isassociated", bool_ftype_ptr_ptr_int,
1330                     0, NOT_BUILT_IN, NULL_PTR);
1331   builtin_function ("__modify", void_ftype_ptr_ptr_int_ptr_int_ptr_int,
1332                     0, NOT_BUILT_IN, NULL_PTR);
1333   builtin_function ("__outoffile", bool_ftype_ptr_ptr_int,
1334                     0, NOT_BUILT_IN, NULL_PTR);
1335   builtin_function ("__readable", bool_ftype_ptr_ptr_int,
1336                     0, NOT_BUILT_IN, NULL_PTR);
1337   builtin_function ("__readrecord", ptr_ftype_ptr_int_ptr_ptr_int,
1338                     0, NOT_BUILT_IN, NULL_PTR);
1339   builtin_function ("__readtext_f", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
1340                     0, NOT_BUILT_IN, NULL_PTR);
1341   builtin_function ("__readtext_s", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
1342                     0, NOT_BUILT_IN, NULL_PTR);
1343   builtin_function ("__sequencible", bool_ftype_ptr_ptr_int,
1344                     0, NOT_BUILT_IN, NULL_PTR);
1345   builtin_function ("__settextaccess", void_ftype_ptr_ptr_ptr_int,
1346                     0, NOT_BUILT_IN, NULL_PTR);
1347   builtin_function ("__settextindex", void_ftype_ptr_int_ptr_int,
1348                     0, NOT_BUILT_IN, NULL_PTR);
1349   builtin_function ("__settextrecord", void_ftype_ptr_ptr_ptr_int,
1350                     0, NOT_BUILT_IN, NULL_PTR);
1351   builtin_function ("__variable", bool_ftype_ptr_ptr_int,
1352                     0, NOT_BUILT_IN, NULL_PTR);
1353   builtin_function ("__writeable", bool_ftype_ptr_ptr_int,
1354                     0, NOT_BUILT_IN, NULL_PTR);
1355   builtin_function ("__writerecord", void_ftype_ptr_int_ptr_luns_ptr_int,
1356                     0, NOT_BUILT_IN, NULL_PTR);
1357   builtin_function ("__writetext_f", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
1358                     0, NOT_BUILT_IN, NULL_PTR);
1359   builtin_function ("__writetext_s", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
1360                     0, NOT_BUILT_IN, NULL_PTR);
1361
1362   /* declare ASSOCIATION, ACCESS, and TEXT modes */
1363   build_io_types ();
1364
1365   /* declare the predefined text locations */
1366   declare_predefined_file ((ignore_case || ! special_UC) ?  "stdin" : "STDIN",
1367                            "chill_stdin");
1368   declare_predefined_file ((ignore_case || ! special_UC) ?  "stdout" : "STDOUT",
1369                            "chill_stdout");
1370   declare_predefined_file ((ignore_case || ! special_UC) ?  "stderr" : "STDERR",
1371                            "chill_stderr");
1372
1373   /* last, but not least, build the chill IO-list type */
1374   build_chill_io_list_type ();
1375
1376   maximum_field_alignment = save_maximum_field_alignment;
1377 }
1378 \f
1379 /* function returns the recordmode of an ACCESS */
1380 tree
1381 access_recordmode (access)
1382      tree access;
1383 {
1384   tree field;
1385
1386   if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
1387     return NULL_TREE;
1388   if (! CH_IS_ACCESS_MODE (access))
1389     return NULL_TREE;
1390
1391   field = TYPE_FIELDS (access);
1392   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
1393     {
1394       if (TREE_CODE (field) == TYPE_DECL &&
1395           DECL_NAME (field) == get_identifier ("__recordmode"))
1396         return TREE_TYPE (field);
1397     }
1398   return void_type_node;
1399 }
1400
1401 /* function invalidates the recordmode of an ACCESS */
1402 void
1403 invalidate_access_recordmode (access)
1404      tree access;
1405 {
1406   tree field;
1407
1408   if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
1409     return;
1410   if (! CH_IS_ACCESS_MODE (access))
1411     return;
1412
1413   field = TYPE_FIELDS (access);
1414   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
1415     {
1416       if (TREE_CODE (field) == TYPE_DECL &&
1417           DECL_NAME (field) == get_identifier ("__recordmode"))
1418         {
1419           TREE_TYPE (field) = error_mark_node;
1420           return;
1421         }
1422     }
1423 }
1424
1425 /* function returns the index mode of an ACCESS if there is one,
1426    otherwise NULL_TREE */
1427 tree
1428 access_indexmode (access)
1429      tree access;
1430 {
1431   tree field;
1432
1433   if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
1434     return NULL_TREE;
1435   if (! CH_IS_ACCESS_MODE (access))
1436     return NULL_TREE;
1437
1438   field = TYPE_FIELDS (access);
1439   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
1440     {
1441       if (TREE_CODE (field) == TYPE_DECL &&
1442           DECL_NAME (field) == get_identifier ("__indexmode"))
1443         return TREE_TYPE (field);
1444     }
1445   return void_type_node;
1446 }
1447
1448 /* function returns one if an ACCESS was specified DYNAMIC, otherwise zero */
1449 tree
1450 access_dynamic (access)
1451      tree access;
1452 {
1453   tree field;
1454
1455   if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
1456     return NULL_TREE;
1457   if (! CH_IS_ACCESS_MODE (access))
1458     return NULL_TREE;
1459
1460   field = TYPE_FIELDS (access);
1461   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
1462     {
1463       if (TREE_CODE (field) == CONST_DECL)
1464         return DECL_INITIAL (field);
1465     }
1466   return integer_zero_node;
1467 }
1468
1469 /*
1470    returns a structure like
1471    STRUCT (data STRUCT (flags ULONG,
1472                         reclength ULONG,
1473                         lowindex LONG,
1474                         highindex LONG,
1475                         association PTR,
1476                         base ULONG,
1477                         store_loc PTR,
1478                         rectype LONG),
1479    this is followed by a
1480    TYPE_DECL __recordmode recordmode ? recordmode : void_type_node
1481    TYPE_DECL __indexmode  indexmode  ? indexmode  : void_type_node
1482    CONST_DECL __dynamic   dynamic ? integer_one_node : integer_zero_node
1483 */
1484
1485 static tree
1486 build_access_part ()
1487 {
1488   tree listbase, decl;
1489
1490   listbase = build_decl (FIELD_DECL, get_identifier ("flags"),
1491                          long_unsigned_type_node);
1492   decl = build_decl (FIELD_DECL, get_identifier ("reclength"),
1493                      long_unsigned_type_node);
1494   listbase = chainon (listbase, decl);
1495   decl = build_decl (FIELD_DECL, get_identifier ("lowindex"),
1496                      long_unsigned_type_node);
1497   listbase = chainon (listbase, decl);
1498   decl = build_decl (FIELD_DECL, get_identifier ("highindex"),
1499                      long_integer_type_node);
1500   listbase = chainon (listbase, decl);
1501   decl = build_decl (FIELD_DECL, get_identifier ("association"),
1502                      ptr_type_node);
1503   listbase = chainon (listbase, decl);
1504   decl = build_decl (FIELD_DECL, get_identifier ("base"),
1505                      long_unsigned_type_node);
1506   listbase = chainon (listbase, decl);
1507   decl = build_decl (FIELD_DECL, get_identifier ("storelocptr"),
1508                      ptr_type_node);
1509   listbase = chainon (listbase, decl);
1510   decl = build_decl (FIELD_DECL, get_identifier ("rectype"),
1511                      long_integer_type_node);
1512   listbase = chainon (listbase, decl);
1513   return build_chill_struct_type (listbase);
1514 }
1515
1516 tree
1517 build_access_mode (indexmode, recordmode, dynamic)
1518      tree indexmode;
1519      tree recordmode;
1520      int dynamic;
1521 {
1522   tree type, listbase, decl, datamode;
1523
1524   if (indexmode != NULL_TREE && TREE_CODE (indexmode) == ERROR_MARK)
1525     return error_mark_node;
1526   if (recordmode != NULL_TREE && TREE_CODE (recordmode) == ERROR_MARK)
1527     return error_mark_node;
1528
1529   datamode = build_access_part ();
1530   
1531   type = make_node (RECORD_TYPE);
1532   listbase = build_decl (FIELD_DECL, get_identifier ("data"),
1533                          datamode);
1534   TYPE_FIELDS (type) = listbase;
1535   decl = build_lang_decl (TYPE_DECL, get_identifier ("__recordmode"),
1536                           recordmode == NULL_TREE ? void_type_node : recordmode);
1537   chainon (listbase, decl);
1538   decl = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
1539                           indexmode == NULL_TREE ? void_type_node : indexmode);
1540   chainon (listbase, decl);
1541   decl = build_decl (CONST_DECL, get_identifier ("__dynamic"),
1542                      integer_type_node);
1543   DECL_INITIAL (decl) = dynamic ? integer_one_node : integer_zero_node;
1544   chainon (listbase, decl);
1545   CH_IS_ACCESS_MODE (type) = 1;
1546   CH_TYPE_NONVALUE_P (type) = 1;
1547   return type;
1548 }
1549 \f
1550 /*
1551   returns a structure like:
1552   STRUCT (txt STRUCT (flags ULONG,
1553                       text_record PTR,
1554                       access_sub PTR,
1555                       actual_index LONG),
1556           acc STRUCT (flags ULONG,
1557                       reclength ULONG,
1558                       lowindex LONG,
1559                       highindex LONG,
1560                       association PTR,
1561                       base ULONG,
1562                       store_loc PTR,
1563                       rectype LONG),
1564           tloc CHARS(textlength) VARYING;
1565           )
1566   followed by
1567   TYPE_DECL __indexmode indexmode ? indexmode : void_type_node
1568   CONST_DECL __text_length
1569   CONST_DECL __dynamic  dynamic ? integer_one_node : integer_zero_node
1570 */
1571 tree
1572 build_text_mode (textlength, indexmode, dynamic)
1573      tree textlength;
1574      tree indexmode;
1575      int dynamic;
1576 {
1577   tree txt, acc, listbase, decl, type, tltype;
1578   tree savedlength = textlength;
1579
1580   if (indexmode != NULL_TREE && TREE_CODE (indexmode) == ERROR_MARK)
1581     return error_mark_node;
1582   if (textlength == NULL_TREE || TREE_CODE (textlength) == ERROR_MARK)
1583     return error_mark_node;
1584
1585   /* build the structure */
1586   listbase = build_decl (FIELD_DECL, get_identifier ("flags"),
1587                          long_unsigned_type_node);
1588   decl = build_decl (FIELD_DECL, get_identifier ("text_record"),
1589                      ptr_type_node);
1590   listbase = chainon (listbase, decl);
1591   decl = build_decl (FIELD_DECL, get_identifier ("access_sub"),
1592                      ptr_type_node);
1593   listbase = chainon (listbase, decl);
1594   decl = build_decl (FIELD_DECL, get_identifier ("actual_index"),
1595                      long_integer_type_node);
1596   listbase = chainon (listbase, decl);
1597   txt = build_chill_struct_type (listbase);
1598
1599   acc = build_access_part ();
1600
1601   type = make_node (RECORD_TYPE);
1602   listbase = build_decl (FIELD_DECL, get_identifier ("txt"), txt);
1603   TYPE_FIELDS (type) = listbase;
1604   decl = build_decl (FIELD_DECL, get_identifier ("acc"), acc);
1605   chainon (listbase, decl);
1606   /* the text location */
1607   tltype = build_string_type (char_type_node, textlength);
1608   tltype = build_varying_struct (tltype);
1609   decl = build_decl (FIELD_DECL, get_identifier ("tloc"),
1610                      tltype);
1611   chainon (listbase, decl);
1612   /* the index mode */
1613   decl = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
1614                           indexmode == NULL_TREE ? void_type_node : indexmode);
1615   chainon (listbase, decl);
1616   /* save dynamic */
1617   decl = build_decl (CONST_DECL, get_identifier ("__textlength"),
1618                      integer_type_node);
1619   if (TREE_CODE (textlength) == COMPONENT_REF)
1620     /* FIXME: we cannot use one and the same COMPONENT_REF twice, so build
1621        another one */
1622     savedlength = build_component_ref (TREE_OPERAND (textlength, 0),
1623                                        TREE_OPERAND (textlength, 1));
1624   DECL_INITIAL (decl) = savedlength;
1625   chainon (listbase, decl);
1626   /* save dynamic */
1627   decl = build_decl (CONST_DECL, get_identifier ("__dynamic"),
1628                      integer_type_node);
1629   DECL_INITIAL (decl) = dynamic ? integer_one_node : integer_zero_node;
1630   chainon (listbase, decl);
1631   CH_IS_TEXT_MODE (type) = 1;
1632   CH_TYPE_NONVALUE_P (type) = 1;
1633   return type;
1634 }
1635
1636 tree
1637 check_text_length (length)
1638      tree length;
1639 {
1640   if (length == NULL_TREE || TREE_CODE (length) == ERROR_MARK)
1641     return length;
1642   if (TREE_TYPE (length) == NULL_TREE
1643       || !CH_SIMILAR (TREE_TYPE (length), integer_type_node))
1644     {
1645       error ("non-integral text length");
1646       return integer_one_node;
1647     }
1648   if (TREE_CODE (length) != INTEGER_CST)
1649     {
1650       error ("non-constant text length");
1651       return integer_one_node;
1652     }
1653   if (compare_int_csts (LE_EXPR, length, integer_zero_node))
1654     {
1655       error ("text length must be greater than 0");
1656       return integer_one_node;
1657     }
1658   return length;
1659 }
1660
1661 tree
1662 text_indexmode (text)
1663      tree text;
1664 {
1665   tree field;
1666
1667   if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
1668     return NULL_TREE;
1669   if (! CH_IS_TEXT_MODE (text))
1670     return NULL_TREE;
1671
1672   field = TYPE_FIELDS (text);
1673   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
1674     {
1675       if (TREE_CODE (field) == TYPE_DECL)
1676         return TREE_TYPE (field);
1677     }
1678   return void_type_node;
1679 }
1680
1681 tree
1682 text_dynamic (text)
1683      tree text;
1684 {
1685   tree field;
1686
1687   if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
1688     return NULL_TREE;
1689   if (! CH_IS_TEXT_MODE (text))
1690     return NULL_TREE;
1691
1692   field = TYPE_FIELDS (text);
1693   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
1694     {
1695       if (TREE_CODE (field) == CONST_DECL &&
1696           DECL_NAME (field) == get_identifier ("__dynamic"))
1697         return DECL_INITIAL (field);
1698     }
1699   return integer_zero_node;
1700 }
1701
1702 tree
1703 text_length (text)
1704      tree text;
1705 {
1706   tree field;
1707
1708   if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
1709     return NULL_TREE;
1710   if (! CH_IS_TEXT_MODE (text))
1711     return NULL_TREE;
1712
1713   field = TYPE_FIELDS (text);
1714   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
1715     {
1716       if (TREE_CODE (field) == CONST_DECL &&
1717           DECL_NAME (field) == get_identifier ("__textlength"))
1718         return DECL_INITIAL (field);
1719     }
1720   return integer_zero_node;
1721 }
1722
1723 static tree
1724 textlocation_mode (text)
1725      tree text;
1726 {
1727   tree field;
1728
1729   if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
1730     return NULL_TREE;
1731   if (! CH_IS_TEXT_MODE (text))
1732     return NULL_TREE;
1733
1734   field = TYPE_FIELDS (text);
1735   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
1736     {
1737       if (TREE_CODE (field) == FIELD_DECL &&
1738           DECL_NAME (field) == get_identifier ("tloc"))
1739         return TREE_TYPE (field);
1740     }
1741   return NULL_TREE;
1742 }
1743 \f
1744 static int
1745 check_assoc (assoc, argnum, errmsg)
1746      tree assoc;
1747      int argnum;
1748      const char *errmsg;
1749 {
1750   if (assoc == NULL_TREE || TREE_CODE (assoc) == ERROR_MARK)
1751     return 0;
1752
1753   if (! CH_IS_ASSOCIATION_MODE (TREE_TYPE (assoc)))
1754     {
1755       error ("argument %d of %s must be of mode ASSOCIATION", argnum, errmsg);
1756       return 0;
1757     }
1758   if (! CH_LOCATION_P (assoc))
1759     {
1760       error ("argument %d of %s must be a location", argnum, errmsg);
1761       return 0;
1762     }
1763   return 1;
1764 }
1765
1766 tree
1767 build_chill_associate (assoc, fname, attr)
1768      tree assoc;
1769      tree fname;
1770      tree attr;
1771 {
1772   tree arg1 = NULL_TREE, arg2 = NULL_TREE, arg3 = NULL_TREE, arg4 = NULL_TREE,
1773   arg5 = NULL_TREE, arg6, arg7;
1774   int had_errors = 0;
1775   tree result;
1776
1777   /* make some checks */
1778   if (fname == NULL_TREE || TREE_CODE (fname) == ERROR_MARK)
1779     return error_mark_node;
1780
1781   /* check the association */
1782   if (! check_assoc (assoc, 1, "ASSOCIATION"))
1783     had_errors = 1;
1784   else
1785     /* build a pointer to the association */
1786     arg1 = force_addr_of (assoc);
1787
1788   /* check the filename, must be a string */
1789   if (CH_CHARS_TYPE_P (TREE_TYPE (fname)) ||
1790       (flag_old_strings && TREE_CODE (fname) == INTEGER_CST &&
1791        TREE_CODE (TREE_TYPE (fname)) == CHAR_TYPE))
1792     {
1793       if (int_size_in_bytes (TREE_TYPE (fname)) == 0)
1794         {
1795           error ("argument 2 of ASSOCIATE must not be an empty string");
1796           had_errors = 1;
1797         }
1798       else
1799         {
1800           arg2 = force_addr_of (fname);
1801           arg3 = size_in_bytes (TREE_TYPE (fname));
1802         }
1803     }
1804   else if (chill_varying_string_type_p (TREE_TYPE (fname)))
1805     {
1806       arg2 = force_addr_of (build_component_ref (fname, var_data_id));
1807       arg3 = build_component_ref (fname, var_length_id);
1808     }
1809   else
1810     {
1811       error ("argument 2 to ASSOCIATE must be a string");
1812       had_errors = 1;
1813     }
1814
1815   /* check attr argument, must be a string too */
1816   if (attr == NULL_TREE)
1817     {
1818       arg4 = null_pointer_node;
1819       arg5 = integer_zero_node;
1820     }
1821   else
1822     {
1823       attr = TREE_VALUE (attr);
1824       if (attr == NULL_TREE || TREE_CODE (attr) == ERROR_MARK)
1825         had_errors = 1;
1826       else
1827         {
1828           if (CH_CHARS_TYPE_P (TREE_TYPE (attr)) ||
1829               (flag_old_strings && TREE_CODE (attr) == INTEGER_CST &&
1830                TREE_CODE (TREE_TYPE (attr)) == CHAR_TYPE))
1831             {
1832               if (int_size_in_bytes (TREE_TYPE (attr)) == 0)
1833                 {
1834                   arg4 = null_pointer_node;
1835                   arg5 = integer_zero_node;
1836                 }
1837               else
1838                 {
1839                   arg4 = force_addr_of (attr);
1840                   arg5 = size_in_bytes (TREE_TYPE (attr));
1841                 }
1842             }
1843           else if (chill_varying_string_type_p (TREE_TYPE (attr)))
1844             {
1845               arg4 = force_addr_of (build_component_ref (attr, var_data_id));
1846               arg5 = build_component_ref (attr, var_length_id);
1847             }
1848           else
1849             {
1850               error ("argument 3 to ASSOCIATE must be a string");
1851               had_errors = 1;
1852             }
1853         }
1854     }
1855
1856   if (had_errors)
1857     return error_mark_node;
1858
1859   /* other arguments */
1860   arg6 = force_addr_of (get_chill_filename ());
1861   arg7 = get_chill_linenumber ();
1862
1863   result = build_chill_function_call (
1864      lookup_name (get_identifier ("__associate")),
1865             tree_cons (NULL_TREE, arg1,
1866               tree_cons (NULL_TREE, arg2,
1867                 tree_cons (NULL_TREE, arg3,
1868                   tree_cons (NULL_TREE, arg4,
1869                     tree_cons (NULL_TREE, arg5,
1870                       tree_cons (NULL_TREE, arg6,
1871                         tree_cons (NULL_TREE, arg7, NULL_TREE))))))));
1872   
1873   TREE_TYPE (result) = build_chill_pointer_type (TREE_TYPE (assoc));
1874   return result;
1875 }
1876
1877 static tree
1878 assoc_call (assoc, func, name)
1879      tree assoc;
1880      tree func;
1881      const char *name;
1882 {
1883   tree arg1, arg2, arg3;
1884   tree result;
1885
1886   if (! check_assoc (assoc, 1, name))
1887     return error_mark_node;
1888
1889   arg1 = force_addr_of (assoc);
1890   arg2 = force_addr_of (get_chill_filename ());
1891   arg3 = get_chill_linenumber ();
1892
1893   result = build_chill_function_call (func,
1894             tree_cons (NULL_TREE, arg1,
1895               tree_cons (NULL_TREE, arg2,
1896                 tree_cons (NULL_TREE, arg3, NULL_TREE))));
1897   return result;
1898 }
1899
1900 tree
1901 build_chill_isassociated (assoc)
1902      tree assoc;
1903 {
1904   tree result = assoc_call (assoc,
1905                             lookup_name (get_identifier ("__isassociated")),
1906                             "ISASSOCIATED");
1907   return result;
1908 }
1909
1910 tree
1911 build_chill_existing (assoc)
1912      tree assoc;
1913 {
1914   tree result = assoc_call (assoc,
1915                             lookup_name (get_identifier ("__existing")),
1916                             "EXISTING");
1917   return result;
1918 }
1919
1920 tree
1921 build_chill_readable (assoc)
1922      tree assoc;
1923 {
1924   tree result = assoc_call (assoc,
1925                             lookup_name (get_identifier ("__readable")),
1926                             "READABLE");
1927   return result;
1928 }
1929
1930 tree
1931 build_chill_writeable (assoc)
1932      tree assoc;
1933 {
1934   tree result = assoc_call (assoc,
1935                             lookup_name (get_identifier ("__writeable")),
1936                             "WRITEABLE");
1937   return result;
1938 }
1939
1940 tree
1941 build_chill_sequencible (assoc)
1942      tree assoc;
1943 {
1944   tree result = assoc_call (assoc,
1945                             lookup_name (get_identifier ("__sequencible")),
1946                             "SEQUENCIBLE");
1947   return result;
1948 }
1949
1950 tree
1951 build_chill_variable (assoc)
1952      tree assoc;
1953 {
1954   tree result = assoc_call (assoc,
1955                             lookup_name (get_identifier ("__variable")),
1956                             "VARIABLE");
1957   return result;
1958 }
1959
1960 tree
1961 build_chill_indexable (assoc)
1962      tree assoc;
1963 {
1964   tree result = assoc_call (assoc,
1965                             lookup_name (get_identifier ("__indexable")),
1966                             "INDEXABLE");
1967   return result;
1968 }
1969
1970 tree
1971 build_chill_dissociate (assoc)
1972      tree assoc;
1973 {
1974   tree result = assoc_call (assoc,
1975                             lookup_name (get_identifier ("__dissociate")),
1976                             "DISSOCIATE");
1977   return result;
1978 }
1979
1980 tree
1981 build_chill_create (assoc)
1982      tree assoc;
1983 {
1984   tree result = assoc_call (assoc,
1985                             lookup_name (get_identifier ("__create")),
1986                             "CREATE");
1987   return result;
1988 }
1989
1990 tree
1991 build_chill_delete (assoc)
1992      tree assoc;
1993 {
1994   tree result = assoc_call (assoc,
1995                             lookup_name (get_identifier ("__delete")),
1996                             "DELETE");
1997   return result;
1998 }
1999
2000 tree
2001 build_chill_modify (assoc, list)
2002      tree assoc;
2003      tree list;
2004 {
2005   tree arg1 = NULL_TREE, arg2 = NULL_TREE, arg3 = NULL_TREE, arg4 = NULL_TREE,
2006   arg5 = NULL_TREE, arg6, arg7;
2007   int had_errors = 0, numargs;
2008   tree fname = NULL_TREE, attr = NULL_TREE;
2009   tree result;
2010
2011   /* check the association */
2012   if (! check_assoc (assoc, 1, "MODIFY"))
2013     had_errors = 1;
2014   else
2015     arg1 = force_addr_of (assoc);
2016
2017   /* look how much arguments we have got */
2018   numargs = list_length (list);
2019   switch (numargs)
2020     {
2021     case 0:
2022       break;
2023     case 1:
2024       fname = TREE_VALUE (list);
2025       break;
2026     case 2:
2027       fname = TREE_VALUE (list);
2028       attr = TREE_VALUE (TREE_CHAIN (list));
2029       break;
2030     default:
2031       error ("too many arguments in call to MODIFY");
2032       had_errors = 1;
2033       break;
2034     }
2035
2036   if (fname !=  NULL_TREE && fname != null_pointer_node)
2037     {
2038       if (CH_CHARS_TYPE_P (TREE_TYPE (fname)) ||
2039           (flag_old_strings && TREE_CODE (fname) == INTEGER_CST &&
2040            TREE_CODE (TREE_TYPE (fname)) == CHAR_TYPE))
2041         {
2042           if (int_size_in_bytes (TREE_TYPE (fname)) == 0)
2043             {
2044               error ("argument 2 of MODIFY must not be an empty string");
2045               had_errors = 1;
2046             }
2047           else
2048             {
2049               arg2 = force_addr_of (fname);
2050               arg3 = size_in_bytes (TREE_TYPE (fname));
2051             }
2052         }
2053       else if (chill_varying_string_type_p (TREE_TYPE (fname)))
2054         {
2055           arg2 = force_addr_of (build_component_ref (fname, var_data_id));
2056           arg3 = build_component_ref (fname, var_length_id);
2057         }
2058       else
2059         {
2060           error ("argument 2 to MODIFY must be a string");
2061           had_errors = 1;
2062         }
2063     }
2064   else
2065     {
2066       arg2 = null_pointer_node;
2067       arg3 = integer_zero_node;
2068     }
2069
2070   if (attr != NULL_TREE && attr != null_pointer_node)
2071     {
2072       if (CH_CHARS_TYPE_P (TREE_TYPE (attr)) ||
2073           (flag_old_strings && TREE_CODE (attr) == INTEGER_CST &&
2074            TREE_CODE (TREE_TYPE (attr)) == CHAR_TYPE))
2075         {
2076           if (int_size_in_bytes (TREE_TYPE (attr)) == 0)
2077             {
2078               arg4 = null_pointer_node;
2079               arg5 = integer_zero_node;
2080             }
2081           else
2082             {
2083               arg4 = force_addr_of (attr);
2084               arg5 = size_in_bytes (TREE_TYPE (attr));
2085             }
2086         }
2087       else if (chill_varying_string_type_p (TREE_TYPE (attr)))
2088         {
2089           arg4 = force_addr_of (build_component_ref (attr, var_data_id));
2090           arg5 = build_component_ref (attr, var_length_id);
2091         }
2092       else
2093         {
2094           error ("argument 3 to MODIFY must be a string");
2095           had_errors = 1;
2096         }
2097     }
2098   else
2099     {
2100       arg4 = null_pointer_node;
2101       arg5 = integer_zero_node;
2102     }
2103
2104   if (had_errors)
2105     return error_mark_node;
2106
2107   /* other arguments */
2108   arg6 = force_addr_of (get_chill_filename ());
2109   arg7 = get_chill_linenumber ();
2110
2111   result = build_chill_function_call (
2112      lookup_name (get_identifier ("__modify")),
2113             tree_cons (NULL_TREE, arg1,
2114               tree_cons (NULL_TREE, arg2,
2115                 tree_cons (NULL_TREE, arg3,
2116                   tree_cons (NULL_TREE, arg4,
2117                     tree_cons (NULL_TREE, arg5,
2118                       tree_cons (NULL_TREE, arg6,
2119                         tree_cons (NULL_TREE, arg7, NULL_TREE))))))));
2120   
2121   return result;
2122 }
2123 \f
2124 static int
2125 check_transfer (transfer, argnum, errmsg)
2126      tree transfer;
2127      int argnum;
2128      const char *errmsg;
2129 {
2130   int result = 0;
2131
2132   if (transfer == NULL_TREE || TREE_CODE (transfer) == ERROR_MARK)
2133     return 0;
2134
2135   if (CH_IS_ACCESS_MODE (TREE_TYPE (transfer)))
2136     result = 1;
2137   else if (CH_IS_TEXT_MODE (TREE_TYPE (transfer)))
2138     result = 2;
2139   else
2140     {
2141       error ("argument %d of %s must be an ACCESS or TEXT mode", argnum, errmsg);
2142       return 0;
2143     }
2144   if (! CH_LOCATION_P (transfer))
2145     {
2146       error ("argument %d of %s must be a location", argnum, errmsg);
2147       return 0;
2148     }
2149   return result;
2150 }
2151
2152 /* define bits in an access/text flag word.
2153    NOTE: this must be consistent with runtime/iomodes.h */
2154 #define IO_TEXTLOCATION 0x80000000
2155 #define IO_INDEXED      0x00000001
2156 #define IO_TEXTIO       0x00000002
2157 #define IO_OUTOFFILE    0x00010000
2158 \f
2159 /* generated initialisation code for ACCESS and TEXT.
2160    functions gets called from do_decl. */
2161 void init_access_location (decl, type)
2162      tree decl;
2163      tree type;
2164 {
2165   tree recordmode = access_recordmode (type);
2166   tree indexmode = access_indexmode (type);
2167   int flags_init = 0;
2168   tree data = build_component_ref (decl, get_identifier ("data"));
2169   tree lowindex = integer_zero_node;
2170   tree highindex = integer_zero_node;
2171   tree rectype, reclen;
2172
2173   /* flag word */
2174   if (indexmode != NULL_TREE && indexmode != void_type_node)
2175     {
2176       flags_init |= IO_INDEXED;
2177       lowindex = convert (integer_type_node, TYPE_MIN_VALUE (indexmode));
2178       highindex = convert (integer_type_node, TYPE_MAX_VALUE (indexmode));
2179     }
2180
2181   expand_expr_stmt (
2182     build_chill_modify_expr (
2183       build_component_ref (data, get_identifier ("flags")),
2184         build_int_2 (flags_init, 0)));
2185
2186   /* record length */
2187   if (recordmode == NULL_TREE || recordmode == void_type_node)
2188     {
2189       reclen = integer_zero_node;
2190       rectype = integer_zero_node;
2191     }
2192   else if (chill_varying_string_type_p (recordmode))
2193     {
2194       tree fields = TYPE_FIELDS (recordmode);
2195       tree len1, len2;
2196
2197       /* don't count any padding bytes at end of varying */
2198       len1 = size_in_bytes (TREE_TYPE (fields));
2199       fields = TREE_CHAIN (fields);
2200       len2 = size_in_bytes (TREE_TYPE (fields));
2201       reclen = fold (build (PLUS_EXPR, long_integer_type_node, len1, len2));
2202       rectype = build_int_2 (2, 0);
2203     }
2204   else
2205     {
2206       reclen = size_in_bytes (recordmode);
2207       rectype = integer_one_node;
2208     }
2209   expand_expr_stmt (
2210     build_chill_modify_expr (
2211       build_component_ref (data, get_identifier ("reclength")), reclen));
2212
2213   /* record type */
2214   expand_expr_stmt (
2215     build_chill_modify_expr (
2216       build_component_ref (data, get_identifier ("rectype")), rectype));
2217
2218   /* the index */
2219   expand_expr_stmt (
2220     build_chill_modify_expr (
2221       build_component_ref (data, get_identifier ("lowindex")), lowindex));
2222   expand_expr_stmt (
2223     build_chill_modify_expr (
2224       build_component_ref (data, get_identifier ("highindex")), highindex));
2225
2226   /* association */
2227   expand_expr_stmt (
2228     build_chill_modify_expr (
2229       build_chill_component_ref (data, get_identifier ("association")),
2230         null_pointer_node));
2231
2232   /* storelocptr */
2233   expand_expr_stmt (
2234     build_chill_modify_expr (
2235       build_component_ref (data, get_identifier ("storelocptr")), null_pointer_node));
2236 }
2237
2238 void init_text_location (decl, type)
2239      tree decl;
2240      tree type;
2241 {
2242   tree indexmode = text_indexmode (type);
2243   unsigned long accessflags = 0;
2244   unsigned long textflags = IO_TEXTLOCATION;
2245   tree lowindex = integer_zero_node;
2246   tree highindex = integer_zero_node;
2247   tree data, tloc, tlocfields, len1, len2, reclen;
2248
2249   if (indexmode != NULL_TREE && indexmode != void_type_node)
2250     {
2251       accessflags |= IO_INDEXED;
2252       lowindex = convert (integer_type_node, TYPE_MIN_VALUE (indexmode));
2253       highindex = convert (integer_type_node, TYPE_MAX_VALUE (indexmode));
2254     }
2255
2256   tloc = build_component_ref (decl, get_identifier ("tloc"));
2257   /* fill access part of text location */
2258   data = build_component_ref (decl, get_identifier ("acc"));
2259   /* flag word */
2260   expand_expr_stmt (
2261     build_chill_modify_expr (
2262       build_component_ref (data, get_identifier ("flags")),
2263         build_int_2 (accessflags, 0)));
2264
2265   /* record length, don't count any padding bytes at end of varying */
2266   tlocfields = TYPE_FIELDS (TREE_TYPE (tloc));
2267   len1 = size_in_bytes (TREE_TYPE (tlocfields));
2268   tlocfields = TREE_CHAIN (tlocfields);
2269   len2 = size_in_bytes (TREE_TYPE (tlocfields));
2270   reclen = fold (build (PLUS_EXPR, long_integer_type_node, len1, len2));
2271   expand_expr_stmt (
2272     build_chill_modify_expr (
2273       build_component_ref (data, get_identifier ("reclength")),
2274         reclen));
2275
2276   /* the index */
2277   expand_expr_stmt (
2278     build_chill_modify_expr (
2279       build_component_ref (data, get_identifier ("lowindex")), lowindex));
2280   expand_expr_stmt (
2281     build_chill_modify_expr (
2282       build_component_ref (data, get_identifier ("highindex")), highindex));
2283
2284   /* association */
2285   expand_expr_stmt (
2286     build_chill_modify_expr (
2287       build_chill_component_ref (data, get_identifier ("association")),
2288         null_pointer_node));
2289
2290   /* storelocptr */
2291   expand_expr_stmt (
2292     build_chill_modify_expr (
2293       build_component_ref (data, get_identifier ("storelocptr")),
2294         null_pointer_node));
2295
2296   /* record type */
2297   expand_expr_stmt (
2298     build_chill_modify_expr (
2299       build_component_ref (data, get_identifier ("rectype")),
2300         build_int_2 (2, 0))); /* VaryingChars */
2301
2302   /* fill text part */
2303   data = build_component_ref (decl, get_identifier ("txt"));
2304   /* flag word */
2305   expand_expr_stmt (
2306     build_chill_modify_expr (
2307       build_component_ref (data, get_identifier ("flags")),
2308         build_int_2 (textflags, 0)));
2309
2310   /* pointer to text record */
2311   expand_expr_stmt (
2312     build_chill_modify_expr (
2313       build_component_ref (data, get_identifier ("text_record")),
2314         force_addr_of (tloc)));
2315
2316   /* pointer to the access */
2317   expand_expr_stmt (
2318     build_chill_modify_expr (
2319       build_component_ref (data, get_identifier ("access_sub")),
2320         force_addr_of (build_component_ref (decl, get_identifier ("acc")))));
2321
2322   /* actual length */
2323   expand_expr_stmt (
2324     build_chill_modify_expr (
2325       build_component_ref (data, get_identifier ("actual_index")),
2326         integer_zero_node));
2327
2328   /* length of text record */
2329   expand_expr_stmt (
2330     build_chill_modify_expr (
2331       build_component_ref (tloc, get_identifier (VAR_LENGTH)),
2332         integer_zero_node));
2333 }
2334 \f
2335 static int
2336 connect_process_optionals (optionals, whereptr, indexptr, indexmode)
2337      tree optionals;
2338      tree *whereptr;
2339      tree *indexptr;
2340      tree indexmode;
2341 {
2342   tree where = NULL_TREE, theindex = NULL_TREE;
2343   int had_errors = 0;
2344
2345   if (optionals != NULL_TREE)
2346     {
2347       /* get the where expression */
2348       where = TREE_VALUE (optionals);
2349       if (where == NULL_TREE || TREE_CODE (where) == ERROR_MARK)
2350         had_errors = 1;
2351       else
2352         {
2353           if (! CH_IS_WHERE_MODE (TREE_TYPE (where)))
2354             {
2355               error ("argument 4 of CONNECT must be of mode WHERE");
2356               had_errors = 1;
2357             }
2358           where = convert (integer_type_node, where);
2359         }
2360       optionals = TREE_CHAIN (optionals);
2361     }
2362   if (optionals != NULL_TREE)
2363     {
2364       theindex = TREE_VALUE (optionals);
2365       if (theindex == NULL_TREE || TREE_CODE (theindex) == ERROR_MARK)
2366         had_errors = 1;
2367       else
2368         {
2369           if (indexmode == void_type_node)
2370             {
2371               error ("index expression for ACCESS without index");
2372               had_errors = 1;
2373             }
2374           else if (! CH_COMPATIBLE (theindex, indexmode))
2375             {
2376               error ("incompatible index mode");
2377               had_errors = 1;
2378             }
2379         }
2380     }
2381   if (had_errors)
2382     return 0;
2383
2384   *whereptr = where;
2385   *indexptr = theindex;
2386   return 1;
2387 }
2388
2389 static tree
2390 connect_text (assoc, text, usage, optionals)
2391      tree assoc;
2392      tree text;
2393      tree usage;
2394      tree optionals;
2395 {
2396   tree where = NULL_TREE, theindex = NULL_TREE;
2397   tree indexmode = text_indexmode (TREE_TYPE (text));
2398   tree result, what_where, have_index, what_index;
2399
2400   /* process optionals */
2401   if (!connect_process_optionals (optionals, &where, &theindex, indexmode))
2402     return error_mark_node;
2403
2404   what_where = where == NULL_TREE ? integer_zero_node : where;
2405   have_index = theindex == NULL_TREE ? integer_zero_node
2406                                      : integer_one_node;
2407   what_index = theindex == NULL_TREE ? integer_zero_node
2408                                      : convert (integer_type_node, theindex);
2409   result = build_chill_function_call (
2410              lookup_name (get_identifier ("__connect")),
2411                tree_cons (NULL_TREE, force_addr_of (text),
2412                  tree_cons (NULL_TREE, force_addr_of (assoc),
2413                    tree_cons (NULL_TREE, convert (integer_type_node, usage),
2414                      tree_cons (NULL_TREE, what_where,
2415                        tree_cons (NULL_TREE, have_index,
2416                          tree_cons (NULL_TREE, what_index,
2417                            tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2418                              tree_cons (NULL_TREE, get_chill_linenumber (),
2419                                         NULL_TREE)))))))));
2420   return result;
2421 }
2422
2423 static tree
2424 connect_access (assoc, transfer, usage, optionals)
2425      tree assoc;
2426      tree transfer;
2427      tree usage;
2428      tree optionals;
2429 {
2430   tree where = NULL_TREE, theindex = NULL_TREE;
2431   tree indexmode = access_indexmode (TREE_TYPE (transfer));
2432   tree result, what_where, have_index, what_index;
2433
2434   /* process the optionals */
2435   if (! connect_process_optionals (optionals, &where, &theindex, indexmode))
2436     return error_mark_node;
2437
2438   /* now the call */
2439   what_where = where == NULL_TREE ? integer_zero_node : where;
2440   have_index = theindex == NULL_TREE ? integer_zero_node : integer_one_node;
2441   what_index = theindex == NULL_TREE ? integer_zero_node : convert (integer_type_node, theindex);
2442   result = build_chill_function_call (
2443              lookup_name (get_identifier ("__connect")),
2444                tree_cons (NULL_TREE, force_addr_of (transfer),
2445                  tree_cons (NULL_TREE, force_addr_of (assoc),
2446                    tree_cons (NULL_TREE, convert (integer_type_node, usage),
2447                      tree_cons (NULL_TREE, what_where,
2448                        tree_cons (NULL_TREE, have_index,
2449                          tree_cons (NULL_TREE, what_index,
2450                            tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2451                              tree_cons (NULL_TREE, get_chill_linenumber (),
2452                                         NULL_TREE)))))))));
2453   return result;
2454 }
2455
2456 tree
2457 build_chill_connect (transfer, assoc, usage, optionals)
2458      tree transfer;
2459      tree assoc;
2460      tree usage;
2461      tree optionals;
2462 {
2463   int had_errors = 0;
2464   int what = 0;
2465   tree result = error_mark_node;
2466
2467   if (! check_assoc (assoc, 2, "CONNECT"))
2468     had_errors = 1;
2469
2470   /* check usage */
2471   if (usage == NULL_TREE || TREE_CODE (usage) == ERROR_MARK)
2472     return error_mark_node;
2473
2474   if (! CH_IS_USAGE_MODE (TREE_TYPE (usage)))
2475     {
2476       error ("argument 3 to CONNECT must be of mode USAGE");
2477       had_errors = 1;
2478     }
2479   if (had_errors)
2480     return error_mark_node;
2481
2482   /* look what we have got */
2483   what = check_transfer (transfer, 1, "CONNECT");
2484   switch (what)
2485     {
2486     case 1:
2487       /* we have an ACCESS */
2488       result = connect_access (assoc, transfer, usage, optionals);
2489       break;
2490     case 2:
2491       /* we have a TEXT */
2492       result = connect_text (assoc, transfer, usage, optionals);
2493       break;
2494     default:
2495       result = error_mark_node;
2496     }
2497   return result;
2498 }
2499
2500 static int
2501 check_access (access, argnum, errmsg)
2502      tree access;
2503      int argnum;
2504      const char *errmsg;
2505 {
2506   if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
2507     return 1;
2508
2509   if (! CH_IS_ACCESS_MODE (TREE_TYPE (access)))
2510     {
2511       error ("argument %d of %s must be of mode ACCESS", argnum, errmsg);
2512       return 0;
2513     }
2514   if (! CH_LOCATION_P (access))
2515     {
2516       error ("argument %d of %s must be a location", argnum, errmsg);
2517       return 0;
2518     }
2519   return 1;
2520 }
2521
2522 tree
2523 build_chill_readrecord (access, optionals)
2524      tree access;
2525      tree optionals;
2526 {
2527   int len;
2528   tree recordmode, indexmode, dynamic, result;
2529   tree index = NULL_TREE, location = NULL_TREE;
2530
2531   if (! check_access (access, 1, "READRECORD"))
2532     return error_mark_node;
2533
2534   recordmode = access_recordmode (TREE_TYPE (access));
2535   indexmode = access_indexmode (TREE_TYPE (access));
2536   dynamic = access_dynamic (TREE_TYPE (access));
2537
2538   /* process the optionals */
2539   len = list_length (optionals);
2540   if (indexmode != void_type_node)
2541     {
2542       /* we must have an index */
2543       if (!len)
2544         {
2545           error ("too few arguments in call to `readrecord'");
2546           return error_mark_node;
2547         }
2548       index = TREE_VALUE (optionals);
2549       if (index == NULL_TREE || TREE_CODE (index) == ERROR_MARK)
2550         return error_mark_node;
2551       optionals = TREE_CHAIN (optionals);
2552       if (! CH_COMPATIBLE (index, indexmode))
2553         {
2554           error ("incompatible index mode");
2555           return error_mark_node;
2556         }
2557     }
2558
2559   /* check the record mode, if one */
2560   if (optionals != NULL_TREE)
2561     {
2562       location = TREE_VALUE (optionals);
2563       if (location == NULL_TREE || TREE_CODE (location) == ERROR_MARK)
2564         return error_mark_node;
2565       if (recordmode != void_type_node &&
2566           ! CH_COMPATIBLE (location, recordmode))
2567         {
2568
2569           error ("incompatible record mode");
2570           return error_mark_node;
2571         }
2572       if (TYPE_READONLY_PROPERTY (TREE_TYPE (location)))
2573         {
2574           error ("store location must not be READonly");
2575           return error_mark_node;
2576         }
2577       location = force_addr_of (location);
2578     }
2579   else
2580     location = null_pointer_node;
2581
2582   index = index == NULL_TREE ? integer_zero_node : convert (integer_type_node, index);
2583   result = build_chill_function_call (
2584             lookup_name (get_identifier ("__readrecord")),
2585               tree_cons (NULL_TREE, force_addr_of (access),
2586                 tree_cons (NULL_TREE, index,
2587                   tree_cons (NULL_TREE, location,
2588                     tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2589                       tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))))));
2590
2591   TREE_TYPE (result) = build_chill_pointer_type (recordmode);
2592   return result;
2593 }
2594
2595 tree
2596 build_chill_writerecord (access, optionals)
2597      tree access;
2598      tree optionals;
2599 {
2600   int had_errors = 0, len;
2601   tree recordmode, indexmode, dynamic;
2602   tree index = NULL_TREE, location = NULL_TREE;
2603   tree result;
2604
2605   if (! check_access (access, 1, "WRITERECORD"))
2606     return error_mark_node;
2607
2608   recordmode = access_recordmode (TREE_TYPE (access));
2609   indexmode = access_indexmode (TREE_TYPE (access));
2610   dynamic = access_dynamic (TREE_TYPE (access));
2611
2612   /* process the optionals */
2613   len = list_length (optionals);
2614   if (indexmode != void_type_node && len != 2)
2615     {
2616       error ("too few arguments in call to `writerecord'");
2617       return error_mark_node;
2618     }
2619   if (indexmode != void_type_node)
2620     {
2621       index = TREE_VALUE (optionals);
2622       if (index == NULL_TREE || TREE_CODE (index) == ERROR_MARK)
2623         return error_mark_node;
2624       location = TREE_VALUE (TREE_CHAIN (optionals));
2625       if (location == NULL_TREE || TREE_CODE (location) == ERROR_MARK)
2626         return error_mark_node;
2627     }
2628   else
2629     location = TREE_VALUE (optionals);
2630
2631   /* check the index */
2632   if (indexmode != void_type_node)
2633     {
2634       if (! CH_COMPATIBLE (index, indexmode))
2635         {
2636           error ("incompatible index mode");
2637           had_errors = 1;
2638         }
2639     }
2640   /* check the record mode */
2641   if (recordmode == void_type_node)
2642     {
2643       error ("transfer to ACCESS without record mode");
2644       had_errors = 1;
2645     }
2646   else if (! CH_COMPATIBLE (location, recordmode))
2647     {
2648       error ("incompatible record mode");
2649       had_errors = 1;
2650     }
2651   if (had_errors)
2652     return error_mark_node;
2653
2654   index = index == NULL_TREE ? integer_zero_node : convert (integer_type_node, index);
2655
2656   result = build_chill_function_call (
2657              lookup_name (get_identifier ("__writerecord")),
2658                tree_cons (NULL_TREE, force_addr_of (access),
2659                  tree_cons (NULL_TREE, index,
2660                    tree_cons (NULL_TREE, force_addr_of (location),
2661                      tree_cons (NULL_TREE, size_in_bytes (TREE_TYPE (location)),
2662                        tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2663                          tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE)))))));
2664   return result;
2665 }
2666
2667 tree
2668 build_chill_disconnect (transfer)
2669      tree transfer;
2670 {
2671   tree result;
2672
2673   if (! check_transfer (transfer, 1, "DISCONNECT"))
2674     return error_mark_node;
2675   result = build_chill_function_call (
2676              lookup_name (get_identifier ("__disconnect")),
2677                tree_cons (NULL_TREE, force_addr_of (transfer),
2678                  tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2679                    tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
2680   return result;
2681 }
2682
2683 tree
2684 build_chill_getassociation (transfer)
2685      tree transfer;
2686 {
2687   tree result;
2688
2689   if (! check_transfer (transfer, 1, "GETASSOCIATION"))
2690     return error_mark_node;
2691
2692   result = build_chill_function_call (
2693             lookup_name (get_identifier ("__getassociation")),
2694               tree_cons (NULL_TREE, force_addr_of (transfer),
2695                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2696                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
2697   TREE_TYPE (result) = build_chill_pointer_type (association_type_node);
2698   return result;
2699 }
2700
2701 tree
2702 build_chill_getusage (transfer)
2703      tree transfer;
2704 {
2705   tree result;
2706
2707   if (! check_transfer (transfer, 1, "GETUSAGE"))
2708     return error_mark_node;
2709
2710   result = build_chill_function_call (
2711             lookup_name (get_identifier ("__getusage")),
2712               tree_cons (NULL_TREE, force_addr_of (transfer),
2713                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2714                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
2715   TREE_TYPE (result) = usage_type_node;
2716   return result;
2717 }
2718
2719 tree
2720 build_chill_outoffile (transfer)
2721      tree transfer;
2722 {
2723   tree result;
2724
2725   if (! check_transfer (transfer, 1, "OUTOFFILE"))
2726     return error_mark_node;
2727
2728   result = build_chill_function_call (
2729              lookup_name (get_identifier ("__outoffile")),
2730                tree_cons (NULL_TREE, force_addr_of (transfer),
2731                  tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2732                    tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
2733   return result;
2734 }
2735 \f
2736 static int
2737 check_text (text, argnum, errmsg)
2738      tree text;
2739      int argnum;
2740      const char *errmsg;
2741 {
2742   if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
2743     return 0;
2744   if (! CH_IS_TEXT_MODE (TREE_TYPE (text)))
2745     {
2746       error ("argument %d of %s must be of mode TEXT", argnum, errmsg);
2747       return 0;
2748     }
2749   if (! CH_LOCATION_P (text))
2750     {
2751       error ("argument %d of %s must be a location", argnum, errmsg);
2752       return 0;
2753     }
2754   return 1;
2755 }
2756
2757 tree
2758 build_chill_eoln (text)
2759      tree text;
2760 {
2761   tree result;
2762
2763   if (! check_text (text, 1, "EOLN"))
2764     return error_mark_node;
2765
2766   result = build_chill_function_call (
2767              lookup_name (get_identifier ("__eoln")),
2768                tree_cons (NULL_TREE, force_addr_of (text),
2769                  tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2770                    tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
2771   return result;
2772 }
2773
2774 tree
2775 build_chill_gettextindex (text)
2776      tree text;
2777 {
2778   tree result;
2779
2780   if (! check_text (text, 1, "GETTEXTINDEX"))
2781     return error_mark_node;
2782
2783   result = build_chill_function_call (
2784              lookup_name (get_identifier ("__gettextindex")),
2785                tree_cons (NULL_TREE, force_addr_of (text),
2786                  tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2787                    tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
2788   return result;
2789 }
2790
2791 tree
2792 build_chill_gettextrecord (text)
2793      tree text;
2794 {
2795   tree textmode, result;
2796
2797   if (! check_text (text, 1, "GETTEXTRECORD"))
2798     return error_mark_node;
2799
2800   textmode = textlocation_mode (TREE_TYPE (text));
2801   if (textmode == NULL_TREE)
2802     {
2803       error ("TEXT doesn't have a location");  /* FIXME */
2804       return error_mark_node;
2805     }
2806   result = build_chill_function_call (
2807             lookup_name (get_identifier ("__gettextrecord")),
2808               tree_cons (NULL_TREE, force_addr_of (text),
2809                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2810                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
2811   TREE_TYPE (result) = build_chill_pointer_type (textmode);
2812   CH_DERIVED_FLAG (result) = 1;
2813   return result;
2814 }
2815
2816 tree
2817 build_chill_gettextaccess (text)
2818      tree text;
2819 {
2820   tree access, refaccess, acc, decl, listbase;
2821   tree tlocmode, indexmode, dynamic;
2822   tree result;
2823   unsigned int save_maximum_field_alignment = maximum_field_alignment;
2824
2825   if (! check_text (text, 1, "GETTEXTACCESS"))
2826     return error_mark_node;
2827
2828   tlocmode = textlocation_mode (TREE_TYPE (text));
2829   indexmode = text_indexmode (TREE_TYPE (text));
2830   dynamic = text_dynamic (TREE_TYPE (text));
2831
2832   /* we have to build a type for the access */
2833   acc = build_access_part ();
2834   access = make_node (RECORD_TYPE);
2835   listbase = build_decl (FIELD_DECL, get_identifier ("data"), acc);
2836   TYPE_FIELDS (access) = listbase;
2837   decl = build_lang_decl (TYPE_DECL, get_identifier ("__recordmode"),
2838                           tlocmode);
2839   chainon (listbase, decl);
2840   decl = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
2841                           indexmode);
2842   chainon (listbase, decl);
2843   decl = build_decl (CONST_DECL, get_identifier ("__dynamic"),
2844                      integer_type_node);
2845   DECL_INITIAL (decl) = dynamic;
2846   chainon (listbase, decl);
2847   maximum_field_alignment = 0;
2848   layout_chill_struct_type (access);
2849   maximum_field_alignment = save_maximum_field_alignment;
2850   CH_IS_ACCESS_MODE (access) = 1;
2851   CH_TYPE_NONVALUE_P (access) = 1;
2852
2853   refaccess = build_chill_pointer_type (access);
2854
2855   result = build_chill_function_call (
2856             lookup_name (get_identifier ("__gettextaccess")),
2857               tree_cons (NULL_TREE, force_addr_of (text),
2858                 tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2859                   tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
2860   TREE_TYPE (result) = refaccess;
2861   CH_DERIVED_FLAG (result) = 1;
2862   return result;
2863 }
2864
2865 tree
2866 build_chill_settextindex (text, expr)
2867      tree text;
2868      tree expr;
2869 {
2870   tree result;
2871
2872   if (! check_text (text, 1, "SETTEXTINDEX"))
2873     return error_mark_node;
2874   if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
2875     return error_mark_node;
2876   result = build_chill_function_call (
2877              lookup_name (get_identifier ("__settextindex")),
2878                tree_cons (NULL_TREE, force_addr_of (text),
2879                  tree_cons (NULL_TREE, expr,
2880                    tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2881                      tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE)))));
2882   return result;
2883 }
2884
2885 tree
2886 build_chill_settextaccess (text, access)
2887      tree text;
2888      tree access;
2889 {
2890   tree result;
2891   tree textindexmode, accessindexmode;
2892   tree textrecordmode, accessrecordmode;
2893
2894   if (! check_text (text, 1, "SETTEXTACCESS"))
2895     return error_mark_node;
2896   if (! check_access (access, 2, "SETTEXTACCESS"))
2897     return error_mark_node;
2898
2899   textindexmode = text_indexmode (TREE_TYPE (text));
2900   accessindexmode = access_indexmode (TREE_TYPE (access));
2901   if (textindexmode != accessindexmode)
2902     {
2903       if (! chill_read_compatible (textindexmode, accessindexmode))
2904         {
2905           error ("incompatible index mode for SETETEXTACCESS");
2906           return error_mark_node;
2907         }
2908     }
2909   textrecordmode = textlocation_mode (TREE_TYPE (text));
2910   accessrecordmode = access_recordmode (TREE_TYPE (access));
2911   if (textrecordmode != accessrecordmode)
2912     {
2913       if (! chill_read_compatible (textrecordmode, accessrecordmode))
2914         {
2915           error ("incompatible record mode for SETTEXTACCESS");
2916           return error_mark_node;
2917         }
2918     }
2919   result = build_chill_function_call (
2920              lookup_name (get_identifier ("__settextaccess")),
2921                tree_cons (NULL_TREE, force_addr_of (text),
2922                  tree_cons (NULL_TREE, force_addr_of (access),
2923                    tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2924                      tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE)))));
2925   return result;
2926 }
2927
2928 tree
2929 build_chill_settextrecord (text, charloc)
2930      tree text;
2931      tree charloc;
2932 {
2933   tree result;
2934   int had_errors = 0;
2935   tree tlocmode;
2936
2937   if (! check_text (text, 1, "SETTEXTRECORD"))
2938     return error_mark_node;
2939   if (charloc == NULL_TREE || TREE_CODE (charloc) == ERROR_MARK)
2940     return error_mark_node;
2941
2942   /* check the location */
2943   if (! CH_LOCATION_P (charloc))
2944     {
2945       error ("parameter 2 must be a location");
2946       return error_mark_node;
2947     }
2948   tlocmode = textlocation_mode (TREE_TYPE (text));
2949   if (! chill_varying_string_type_p (TREE_TYPE (charloc)))
2950     had_errors = 1;
2951   else if (int_size_in_bytes (tlocmode) != int_size_in_bytes (TREE_TYPE (charloc)))
2952     had_errors = 1;
2953   if (had_errors)
2954     {
2955       error ("incompatible modes in parameter 2");
2956       return error_mark_node;
2957     }
2958   result = build_chill_function_call (
2959              lookup_name (get_identifier ("__settextrecord")),
2960                tree_cons (NULL_TREE, force_addr_of (text),
2961                  tree_cons (NULL_TREE, force_addr_of (charloc),
2962                    tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2963                      tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE)))));
2964   return result;
2965 }
2966 \f
2967 /* process iolist for READ- and WRITETEXT */
2968
2969 /* function walks through types as long as they are ranges,
2970    returns the type and min- and max-value form starting type.
2971    */
2972
2973 static tree
2974 get_final_type_and_range (item, low, high)
2975      tree  item;
2976      tree *low;
2977      tree *high;
2978 {
2979   tree  wrk = item;
2980     
2981   *low = TYPE_MIN_VALUE (wrk);
2982   *high = TYPE_MAX_VALUE (wrk);
2983   while (TREE_CODE (wrk) == INTEGER_TYPE &&
2984          TREE_TYPE (wrk) != NULL_TREE &&
2985          TREE_CODE (TREE_TYPE (wrk)) == INTEGER_TYPE &&
2986          TREE_TYPE (TREE_TYPE (wrk)) != NULL_TREE)
2987     wrk = TREE_TYPE (wrk);
2988     
2989   return (TREE_TYPE (wrk));
2990 }
2991
2992 static void
2993 process_io_list (exprlist, iolist_addr, iolist_length, iolist_rtx, do_read,
2994                  argoffset)
2995      tree exprlist;
2996      tree *iolist_addr;
2997      tree *iolist_length;
2998      rtx *iolist_rtx;
2999      int do_read;
3000      int argoffset;
3001 {
3002   tree idxlist;
3003   int idxcnt;
3004   int iolen;
3005   tree iolisttype, iolist;
3006
3007   if (exprlist == NULL_TREE)
3008     return;
3009   
3010   iolen = list_length (exprlist);
3011   
3012   /* build indexlist for the io list */
3013   idxlist = build_tree_list (NULL_TREE,
3014                              build_chill_range_type (NULL_TREE,
3015                                                      integer_one_node,
3016                                                      build_int_2 (iolen, 0)));
3017   
3018   /* build the io-list type */
3019   iolisttype = build_chill_array_type (TREE_TYPE (chill_io_list_type), 
3020                                        idxlist, 0, NULL_TREE);
3021   
3022   /* declare the iolist */
3023   iolist = build_decl (VAR_DECL, get_unique_identifier (do_read ? "RDTEXT" : "WRTEXT"),
3024                        iolisttype);
3025   
3026   /* we want to get a variable which gets marked unused after
3027      the function call, This is a little bit tricky cause the 
3028      address of this variable will be taken and therefor the variable
3029      gets moved out one level. However, we REALLY don't need this
3030      variable again. Solution: push 2 levels and do pop and free
3031      twice at the end. */
3032   push_temp_slots ();
3033   push_temp_slots ();
3034   *iolist_rtx = assign_temp (TREE_TYPE (iolist), 0, 1, 0);
3035   DECL_RTL (iolist) = *iolist_rtx;
3036
3037   /* process the exprlist */
3038   idxcnt = 1;
3039   while (exprlist != NULL_TREE)
3040     {
3041       tree item = TREE_VALUE (exprlist);
3042       tree idx = build_int_2 (idxcnt++, 0);
3043       const char *fieldname = 0;
3044       const char *enumname = 0;
3045       tree array_ref = build_chill_array_ref_1 (iolist, idx);
3046       tree item_type;
3047       tree range_low = NULL_TREE, range_high = NULL_TREE;
3048       int have_range = 0;
3049       tree item_addr = null_pointer_node;
3050       int referable = 0;
3051       int readonly = 0;
3052
3053       /* next value in exprlist */
3054       exprlist = TREE_CHAIN (exprlist);
3055       if (item == NULL_TREE || TREE_CODE (item) == ERROR_MARK)
3056         continue;
3057
3058       item_type = TREE_TYPE (item);
3059       if (item_type == NULL_TREE)
3060         {
3061           if (TREE_CODE (item) == COND_EXPR || TREE_CODE (item) == CASE_EXPR)
3062             error ("conditional expression not allowed in this context");
3063           else
3064             error ("untyped expression as argument %d", idxcnt + 1 + argoffset);
3065           continue;
3066         }
3067       else if (TREE_CODE (item_type) == ERROR_MARK)
3068         continue;
3069           
3070       if (TREE_CODE (item_type) == REFERENCE_TYPE)
3071         {
3072           item_type = TREE_TYPE (item_type);
3073           item = convert (item_type, item);
3074         }
3075
3076       /* check for a range */
3077       if (TREE_CODE (item_type) == INTEGER_TYPE &&
3078           TREE_TYPE (item_type) != NULL_TREE)
3079         {
3080           /* we have a range. NOTE, however, on writetext we don't process ranges  */
3081           item_type = get_final_type_and_range (item_type,
3082                                                 &range_low, &range_high);
3083           have_range = 1;
3084         }
3085
3086       readonly = TYPE_READONLY_PROPERTY (item_type);
3087       referable = CH_REFERABLE (item);
3088       if (referable)
3089         item_addr = force_addr_of (item);
3090       /* if we are in read and have readonly we can't do this */
3091       if (readonly && do_read)
3092         {
3093           item_addr = null_pointer_node;
3094           referable = 0;
3095         }
3096
3097       /* process different types */
3098       if (TREE_CODE (item_type) == INTEGER_TYPE)
3099         {
3100           int type_size = TREE_INT_CST_LOW (TYPE_SIZE (item_type));
3101           tree to_assign = NULL_TREE;
3102
3103           if (do_read && referable)
3104             {
3105               /* process an integer in case of READTEXT and expression is
3106                  referable and not READONLY */
3107               to_assign = item_addr;
3108               if (have_range)
3109                 {
3110                   /* do it for a range */
3111                   tree t, __forxx, __ptr, __low, __high;
3112                   tree what_upper, what_lower;
3113
3114                   /* determine the name in the union of lower and upper */
3115                   if (TREE_UNSIGNED (item_type))
3116                     fieldname = "_ulong";
3117                   else
3118                     fieldname = "_slong";
3119
3120                   switch (type_size)
3121                     {
3122                     case 8:
3123                       if (TREE_UNSIGNED (item_type))
3124                         enumname = "__IO_UByteRangeLoc";
3125                       else
3126                         enumname = "__IO_ByteRangeLoc";
3127                       break;
3128                     case 16:
3129                       if (TREE_UNSIGNED (item_type))
3130                         enumname = "__IO_UIntRangeLoc";
3131                       else
3132                         enumname = "__IO_IntRangeLoc";
3133                       break;
3134                     case 32:
3135                       if (TREE_UNSIGNED (item_type))
3136                         enumname = "__IO_ULongRangeLoc";
3137                       else
3138                         enumname = "__IO_LongRangeLoc";
3139                       break;
3140                     default:
3141                       error ("cannot process %d bits integer for READTEXT argument %d",
3142                              type_size, idxcnt + 1 + argoffset);
3143                       continue;
3144                     }
3145
3146                   /* set up access to structure */
3147                   t = build_component_ref (array_ref,
3148                                            get_identifier ("__t"));
3149                   __forxx = build_component_ref (t, get_identifier ("__locintrange"));
3150                   __ptr = build_component_ref (__forxx, get_identifier ("ptr"));
3151                   __low = build_component_ref (__forxx, get_identifier ("lower"));
3152                   what_lower = build_component_ref (__low, get_identifier (fieldname));
3153                   __high = build_component_ref (__forxx, get_identifier ("upper"));
3154                   what_upper = build_component_ref (__high, get_identifier (fieldname));
3155
3156                   /* do the assignments */
3157                   expand_assignment (__ptr, item_addr, 0, 0);
3158                   expand_assignment (what_lower, range_low, 0, 0);
3159                   expand_assignment (what_upper, range_high, 0, 0);
3160                   fieldname = 0;
3161                 }
3162               else
3163                 {
3164                   /* no range */
3165                   fieldname = "__locint";
3166                   switch (type_size)
3167                     {
3168                     case 8:
3169                       if (TREE_UNSIGNED (item_type))
3170                         enumname = "__IO_UByteLoc";
3171                       else
3172                         enumname = "__IO_ByteLoc";
3173                       break;
3174                     case 16:
3175                       if (TREE_UNSIGNED (item_type))
3176                         enumname = "__IO_UIntLoc";
3177                       else
3178                         enumname = "__IO_IntLoc";
3179                       break;
3180                     case 32:
3181                       if (TREE_UNSIGNED (item_type))
3182                         enumname = "__IO_ULongLoc";
3183                       else
3184                         enumname = "__IO_LongLoc";
3185                       break;
3186                     default:
3187                       error ("cannot process %d bits integer for READTEXT argument %d",
3188                              type_size, idxcnt + 1 + argoffset);
3189                       continue;
3190                     }
3191                 }
3192             }
3193           else
3194             {
3195               /* process an integer in case of WRITETEXT */
3196               to_assign = item;
3197               switch (type_size)
3198                 {
3199                 case 8:
3200                   if (TREE_UNSIGNED (item_type))
3201                     {
3202                       enumname = "__IO_UByteVal";
3203                       fieldname = "__valubyte";
3204                     }
3205                   else
3206                     {
3207                       enumname = "__IO_ByteVal";
3208                       fieldname = "__valbyte";
3209                     }
3210                   break;
3211                 case 16:
3212                   if (TREE_UNSIGNED (item_type))
3213                     {
3214                       enumname = "__IO_UIntVal";
3215                       fieldname = "__valuint";
3216                     }
3217                   else
3218                     {
3219                       enumname = "__IO_IntVal";
3220                       fieldname = "__valint";
3221                     }
3222                   break;
3223                 case 32:
3224                 try_long:
3225                   if (TREE_UNSIGNED (item_type))
3226                     {
3227                       enumname = "__IO_ULongVal";
3228                       fieldname = "__valulong";
3229                     }
3230                   else
3231                     {
3232                       enumname = "__IO_LongVal";
3233                       fieldname = "__vallong";
3234                     }
3235                   break;
3236                 case 64:
3237                   /* convert it back to {unsigned}long. */
3238                   if (TREE_UNSIGNED (item_type))
3239                     item_type = long_unsigned_type_node;
3240                   else
3241                     item_type = long_integer_type_node;
3242                   item = convert (item_type, item);
3243                   goto try_long;
3244                 default:
3245                   /* This kludge is because the lexer gives literals
3246                      the type long_long_{integer,unsigned}_type_node.  */
3247                   if (TREE_CODE (item) == INTEGER_CST)
3248                     {
3249                       if (int_fits_type_p (item, long_integer_type_node))
3250                         {
3251                           item_type = long_integer_type_node;
3252                           item = convert (item_type, item);
3253                           goto try_long;
3254                         }
3255                       if (int_fits_type_p (item, long_unsigned_type_node))
3256                         {
3257                           item_type = long_unsigned_type_node;
3258                           item = convert (item_type, item);
3259                           goto try_long;
3260                         }
3261                     }
3262                   error ("cannot process %d bits integer WRITETEXT argument %d",
3263                          type_size, idxcnt + 1 + argoffset);
3264                   continue;
3265                 }
3266             }
3267           if (fieldname)
3268             {
3269               tree      t, __forxx;
3270               
3271               t = build_component_ref (array_ref,
3272                                        get_identifier ("__t"));
3273               __forxx = build_component_ref (t, get_identifier (fieldname));
3274               expand_assignment (__forxx, to_assign, 0, 0);
3275             }
3276         }
3277       else if (TREE_CODE (item_type) == CHAR_TYPE)
3278         {
3279           tree  to_assign = NULL_TREE;
3280
3281           if (do_read && readonly)
3282             {
3283               error ("argument %d is READonly", idxcnt + 1 + argoffset);
3284               continue;
3285             }
3286           if (do_read)
3287             {
3288               if (! referable)
3289                 {
3290                   error ("argument %d must be referable", idxcnt + 1 + argoffset);
3291                   continue;
3292                 }
3293               if (have_range)
3294                 {
3295                   tree t, forxx, ptr, lower, upper;
3296
3297                   t = build_component_ref (array_ref, get_identifier ("__t"));
3298                   forxx = build_component_ref (t, get_identifier ("__loccharrange"));
3299                   ptr = build_component_ref (forxx, get_identifier ("ptr"));
3300                   lower = build_component_ref (forxx, get_identifier ("lower"));
3301                   upper = build_component_ref (forxx, get_identifier ("upper"));
3302                   expand_assignment (ptr, item_addr, 0, 0);
3303                   expand_assignment (lower, range_low, 0, 0);
3304                   expand_assignment (upper, range_high, 0, 0);
3305
3306                   fieldname = 0;
3307                   enumname = "__IO_CharRangeLoc";
3308                 }
3309               else
3310                 {
3311                   to_assign = item_addr;
3312                   fieldname = "__locchar";
3313                   enumname = "__IO_CharLoc";
3314                 }
3315             }
3316           else
3317             {
3318               to_assign = item;
3319               enumname = "__IO_CharVal";
3320               fieldname = "__valchar";
3321             }
3322           
3323           if (fieldname)
3324             {
3325               tree t, forxx;
3326
3327               t = build_component_ref (array_ref, get_identifier ("__t"));
3328               forxx = build_component_ref (t, get_identifier (fieldname));
3329               expand_assignment (forxx, to_assign, 0, 0);
3330             }
3331         }
3332       else if (TREE_CODE (item_type) == BOOLEAN_TYPE)
3333         {
3334           tree to_assign = NULL_TREE;
3335
3336           if (do_read && readonly)
3337             {
3338               error ("argument %d is READonly", idxcnt + 1 + argoffset);
3339               continue;
3340             }
3341           if (do_read)
3342             {
3343               if (! referable)
3344                 {
3345                   error ("argument %d must be referable", idxcnt + 1 + argoffset);
3346                   continue;
3347                 }
3348               if (have_range)
3349                 {
3350                   tree t, forxx, ptr, lower, upper;
3351
3352                   t = build_component_ref (array_ref, get_identifier ("__t"));
3353                   forxx = build_component_ref (t, get_identifier ("__locboolrange"));
3354                   ptr = build_component_ref (forxx, get_identifier ("ptr"));
3355                   lower = build_component_ref (forxx, get_identifier ("lower"));
3356                   upper = build_component_ref (forxx, get_identifier ("upper"));
3357                   expand_assignment (ptr, item_addr, 0, 0);
3358                   expand_assignment (lower, range_low, 0, 0);
3359                   expand_assignment (upper, range_high, 0, 0);
3360
3361                   fieldname = 0;
3362                   enumname = "__IO_BoolRangeLoc";
3363                 }
3364               else
3365                 {
3366                   to_assign = item_addr;
3367                   fieldname = "__locbool";
3368                   enumname = "__IO_BoolLoc";
3369                 }
3370             }
3371           else
3372             {
3373               to_assign = item;
3374               enumname = "__IO_BoolVal";
3375               fieldname = "__valbool";
3376             }
3377           if (fieldname)
3378             {
3379               tree      t, forxx;
3380               
3381               t = build_component_ref (array_ref, get_identifier ("__t"));
3382               forxx = build_component_ref (t, get_identifier (fieldname));
3383               expand_assignment (forxx, to_assign, 0, 0);
3384             }
3385         }
3386       else if (TREE_CODE (item_type) == ENUMERAL_TYPE)
3387         {
3388           /* process an enum */
3389           tree table_name;
3390           tree context_of_type;
3391           tree t;
3392
3393           /* determine the context of the type.
3394              if TYPE_NAME (item_type) == NULL_TREE
3395              if TREE_CODE (item) == INTEGER_CST
3396              context = NULL_TREE -- this is wrong but should work for now
3397              else
3398              context = DECL_CONTEXT (item)
3399              else
3400              context = DECL_CONTEXT (TYPE_NAME (item_type)) */
3401
3402           if (TYPE_NAME (item_type) == NULL_TREE)
3403             {
3404               if (TREE_CODE (item) == INTEGER_CST)
3405                 context_of_type = NULL_TREE;
3406               else
3407                 context_of_type = DECL_CONTEXT (item);
3408             }
3409           else
3410             context_of_type = DECL_CONTEXT (TYPE_NAME (item_type));
3411               
3412           table_name = add_enum_to_list (item_type, context_of_type);
3413           t = build_component_ref (array_ref, get_identifier ("__t"));
3414
3415           if (do_read && readonly)
3416             {
3417               error ("argument %d is READonly", idxcnt + 1 + argoffset);
3418               continue;
3419             }
3420           if (do_read)
3421             {
3422               if (! referable)
3423                 {
3424                   error ("argument %d must be referable", idxcnt + 1 + argoffset);
3425                   continue;
3426                 }
3427               if (have_range)
3428                 {
3429                   tree forxx, ptr, len, nametable, lower, upper;
3430
3431                   forxx = build_component_ref (t, get_identifier ("__locsetrange"));
3432                   ptr = build_component_ref (forxx, get_identifier ("ptr"));
3433                   len = build_component_ref (forxx, get_identifier ("length"));
3434                   nametable = build_component_ref (forxx, get_identifier ("name_table"));
3435                   lower = build_componen