~ubuntu-branches/ubuntu/trusty/silo-llnl/trusty

« back to all changes in this revision

Viewing changes to src/pdb/pdpath.c

  • Committer: Bazaar Package Importer
  • Author(s): Alastair McKinstry
  • Date: 2011-01-02 00:03:01 UTC
  • Revision ID: james.westby@ubuntu.com-20110102000301-9s2hfsjrkguz6h4r
Tags: upstream-4.8
ImportĀ upstreamĀ versionĀ 4.8

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/*
 
2
Copyright (c) 1994 - 2010, Lawrence Livermore National Security, LLC.
 
3
LLNL-CODE-425250.
 
4
All rights reserved.
 
5
 
 
6
This file is part of Silo. For details, see silo.llnl.gov.
 
7
 
 
8
Redistribution and use in source and binary forms, with or without
 
9
modification, are permitted provided that the following conditions
 
10
are met:
 
11
 
 
12
   * Redistributions of source code must retain the above copyright
 
13
     notice, this list of conditions and the disclaimer below.
 
14
   * Redistributions in binary form must reproduce the above copyright
 
15
     notice, this list of conditions and the disclaimer (as noted
 
16
     below) in the documentation and/or other materials provided with
 
17
     the distribution.
 
18
   * Neither the name of the LLNS/LLNL nor the names of its
 
19
     contributors may be used to endorse or promote products derived
 
20
     from this software without specific prior written permission.
 
21
 
 
22
THIS SOFTWARE  IS PROVIDED BY  THE COPYRIGHT HOLDERS  AND CONTRIBUTORS
 
23
"AS  IS" AND  ANY EXPRESS  OR IMPLIED  WARRANTIES, INCLUDING,  BUT NOT
 
24
LIMITED TO, THE IMPLIED  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 
25
A  PARTICULAR  PURPOSE ARE  DISCLAIMED.  IN  NO  EVENT SHALL  LAWRENCE
 
26
LIVERMORE  NATIONAL SECURITY, LLC,  THE U.S.  DEPARTMENT OF  ENERGY OR
 
27
CONTRIBUTORS BE LIABLE FOR  ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 
28
EXEMPLARY, OR  CONSEQUENTIAL DAMAGES  (INCLUDING, BUT NOT  LIMITED TO,
 
29
PROCUREMENT OF  SUBSTITUTE GOODS  OR SERVICES; LOSS  OF USE,  DATA, OR
 
30
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 
31
LIABILITY, WHETHER  IN CONTRACT, STRICT LIABILITY,  OR TORT (INCLUDING
 
32
NEGLIGENCE OR  OTHERWISE) ARISING IN  ANY WAY OUT  OF THE USE  OF THIS
 
33
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
34
 
 
35
This work was produced at Lawrence Livermore National Laboratory under
 
36
Contract No.  DE-AC52-07NA27344 with the DOE.
 
37
 
 
38
Neither the  United States Government nor  Lawrence Livermore National
 
39
Security, LLC nor any of  their employees, makes any warranty, express
 
40
or  implied,  or  assumes  any  liability or  responsibility  for  the
 
41
accuracy, completeness,  or usefulness of  any information, apparatus,
 
42
product, or  process disclosed, or  represents that its use  would not
 
43
infringe privately-owned rights.
 
44
 
 
45
Any reference herein to  any specific commercial products, process, or
 
46
services by trade name,  trademark, manufacturer or otherwise does not
 
47
necessarily  constitute or imply  its endorsement,  recommendation, or
 
48
favoring  by  the  United  States  Government  or  Lawrence  Livermore
 
49
National Security,  LLC. The views  and opinions of  authors expressed
 
50
herein do not necessarily state  or reflect those of the United States
 
51
Government or Lawrence Livermore National Security, LLC, and shall not
 
52
be used for advertising or product endorsement purposes.
 
53
*/
 
54
/*
 
55
 * PDPATH.C - grammar driven parser for variable specifications
 
56
 *
 
57
 * Source Version: 2.0
 
58
 * Software Release #92-0043
 
59
 *
 
60
 */
 
61
#include "config.h" /* For a possible redefinition of setjmp/longjmp */
 
62
#if !defined(_WIN32)
 
63
#if HAVE_UNISTD_H
 
64
#include <unistd.h>
 
65
#endif
 
66
#endif
 
67
#include "pdb.h"
 
68
 
 
69
/* The fundamental operations are:
 
70
 *        GOTO    - goto the place in memory or on disk implied by the
 
71
 *                  locator on the top of the stack
 
72
 *        INDEX   - compute the hyper-space shape implied by the
 
73
 *                  dimensions on the top of the stack this implies
 
74
 *                  an offset from the current location and a
 
75
 *                  number of items (max) from the offset
 
76
 *                  the current location is changed by offset from
 
77
 *                  the previous location
 
78
 *        MEMBER  - item on the top of the stack is a member name
 
79
 *                  and implies an offset from the current location
 
80
 *                  the current location is changed by offset from
 
81
 *                  the previous location
 
82
 *        DEREF   - assuming the current location is a pointer in
 
83
 *                  memory or an itag on disk dereference so that
 
84
 *                  the current location is at the pointee
 
85
 *        DIGRESS - begin a subroutine which will result with a
 
86
 *                - new integer value on the stack upon completion
 
87
 *        CAST    - specify an output type that overrides the
 
88
 *                - file type
 
89
 */
 
90
 
 
91
#define MAXPARSEDEPTH 150
 
92
#define LASTTOK        42
 
93
#define STATEFLAG   -1000
 
94
 
 
95
#define GOTO_C    1
 
96
#define MEMBER_C  2
 
97
#define INDEX_C   3
 
98
#define CAST_C    4
 
99
#define DEREF_C   5
 
100
#define RESULT_C  6
 
101
 
 
102
#define ERRCODE      256
 
103
#define OPEN_PAREN   257
 
104
#define CLOSE_PAREN  258
 
105
#define STAR         259
 
106
#define DOT          260
 
107
#define ARROW        261
 
108
#define IDENTIFIER   262
 
109
#define COMMA        263
 
110
#define COLON        264
 
111
#define INTEGER      265
 
112
 
 
113
#define input()                                                              \
 
114
   FRAME(lex_bf)[FRAME(index)++]
 
115
 
 
116
#define unput(c)                                                             \
 
117
   (FRAME(index) = (--FRAME(index) < 0) ? 0 : FRAME(index),                  \
 
118
    FRAME(lex_bf)[FRAME(index)] = c)
 
119
 
 
120
#define GOT_TOKEN(tok)                                                       \
 
121
    {if (FRAME(index) == start+1)                                            \
 
122
        return(tok);                                                         \
 
123
     else                                                                    \
 
124
        {unput(c);                                                           \
 
125
         return(_PD_next_token(start));};}
 
126
 
 
127
#define FRAME(x)   frames[frame_n].x
 
128
#define CURRENT(x) FRAME(stack)[FRAME(n)].x
 
129
 
 
130
typedef struct s_locator locator;
 
131
typedef struct s_parse_frame parse_frame;
 
132
 
 
133
struct s_locator {
 
134
   char intype[MAXLINE];
 
135
   int cmmnd;
 
136
   int indirect;
 
137
   SC_address ad;
 
138
   long number;
 
139
   dimdes *dims;
 
140
   symblock *blocks;
 
141
   long n_struct_ptr;
 
142
   long n_array_items;
 
143
   symindir indir_info;
 
144
};
 
145
 
 
146
struct s_parse_frame {
 
147
   locator *stack;                      /* locator stack */
 
148
   long n;                              /* current top of stack */
 
149
   long nx;                             /* allocated size of stack */
 
150
   long diskaddr;
 
151
   char path[MAXLINE];
 
152
   int flag;
 
153
   char *lex_bf;
 
154
   char *lval;
 
155
   char *val;
 
156
   char *v[MAXPARSEDEPTH];              /* parser value stack */
 
157
   char **pv;                           /* top of parser value stack */
 
158
   int current_token;                   /* current input token number */
 
159
   int error;                           /* error recovery flag */
 
160
   int n_error;                 /* number of errors */
 
161
   int state;                           /* current state */
 
162
   int tmp;                             /* extra var (lasts between blocks) */
 
163
   int s[MAXPARSEDEPTH];                /* parser state stack */
 
164
   int *ps;                             /* top of parser state stack */
 
165
   int index;
 
166
};
 
167
 
 
168
static parse_frame      *frames = NULL;
 
169
static int              frame_n;
 
170
static int              frame_nx;
 
171
static PDBfile          *file_s;
 
172
static int              colon ;
 
173
static char             text[MAXLINE];
 
174
static char             msg[MAXLINE];
 
175
static long             num_val;
 
176
static char             outtype[MAXLINE];
 
177
 
 
178
static long             _PD_deref_addr (int) ;
 
179
static void             _PD_disp_rules (int,char**) ;
 
180
static void             _PD_do_cast (char*) ;
 
181
static void             _PD_do_deref (void) ;
 
182
static long             _PD_do_digress (char*) ;
 
183
static void             _PD_do_goto (char*) ;
 
184
static void             _PD_do_index (char*) ;
 
185
static void             _PD_do_member (char*,int) ;
 
186
static char *           _PD_get_type_member (PDBfile*,char*,char*,memdes*,
 
187
                                                 defstr**) ;
 
188
static long             _PD_index_deref (int,dimdes**,long*) ;
 
189
static int              _PD_is_member (char*,memdes*,HASHTAB*,long*) ;
 
190
static int              _PD_lex (void) ;
 
191
static long             _PD_member_deref (int) ;
 
192
static int              _PD_next_token (int) ;
 
193
static long             _PD_num_indirects (char*,HASHTAB*) ;
 
194
static void             _PD_parse (void) ;
 
195
static long             _PD_reduce (void) ;
 
196
static void             _PD_restore_stack (void) ;
 
197
static void             _PD_rl_frames (void) ;
 
198
static void             _PD_save_stack (void) ;
 
199
static void             _PD_shift (char*,char*,dimdes*,symblock*,long,
 
200
                                       long,int,int) ;
 
201
 
 
202
 
 
203
/*-------------------------------------------------------------------------
 
204
 * Function:    _lite_PD_effective_ep
 
205
 *
 
206
 * Purpose:     Look up the symbol table entry for the named quantity.
 
207
 *
 
208
 * Return:      Success:        An effective symbol table entry which
 
209
 *                              contains the type and dimensions of the
 
210
 *                              entire variable(!) and the disk address
 
211
 *                              and number of items referred to by the
 
212
 *                              hyper-index expression, if any.  If NAME
 
213
 *                              contains such a specification the returned
 
214
 *                              syment will be newly allocated.
 
215
 *
 
216
 *              Failure:        NULL
 
217
 *
 
218
 * Programmer:  Adapted from PACT PDB
 
219
 *              Mar  4, 1996  1:03 PM EST
 
220
 *
 
221
 * Modifications:
 
222
 *    Eric Brugger, Mon Dec  8 17:26:38 PST 1998
 
223
 *    I eliminated some memory leaks.
 
224
 *
 
225
 *-------------------------------------------------------------------------
 
226
 */
 
227
syment *
 
228
_lite_PD_effective_ep (PDBfile *file, char *name, int flag, char *fullname) {
 
229
 
 
230
   int          alloc_frames;
 
231
   dimdes       *dims;
 
232
   char         *type;
 
233
   long         numb, addr;
 
234
   symindir     indr;
 
235
   symblock     *sp;
 
236
   syment       *ep;
 
237
 
 
238
   /*
 
239
    * To improve performance and to accomodate certain unusual variable names
 
240
    *  such as domain names, see if the variable name is literally in the file
 
241
    */
 
242
   ep = lite_PD_inquire_entry(file, name, flag, fullname);
 
243
   if (ep != NULL) return(lite_PD_copy_syment(ep));
 
244
 
 
245
   alloc_frames = FALSE;
 
246
   if (frames == NULL) {
 
247
      alloc_frames = TRUE;
 
248
      frame_n  = 0;
 
249
      frame_nx = 4;
 
250
      frames   = FMAKE_N(parse_frame, frame_nx, "_PD_EFFECTIVE_EP:frames");
 
251
      FRAME(stack) = NULL;
 
252
      FRAME(nx) = 0;
 
253
   }
 
254
 
 
255
   FRAME(lex_bf) = lite_SC_strsavef(name, "char*:_PD_EFFECTIVE_EP:lex_bf");
 
256
   FRAME(index) = 0;
 
257
 
 
258
   FRAME(n) = 0L;
 
259
   if (FRAME(stack) == NULL) {
 
260
      FRAME(nx) += 10;
 
261
      FRAME(stack) = FMAKE_N(locator, 10, "_PD_EFFECTIVE_EP:loc_stack");
 
262
   }
 
263
 
 
264
   switch (setjmp(_lite_PD_trace_err)) {
 
265
   case ABORT:
 
266
      if ((fullname != NULL) && flag) strcpy(fullname, name);
 
267
      if (alloc_frames) _PD_rl_frames();
 
268
      return(NULL);
 
269
 
 
270
   case ERR_FREE:
 
271
      if (alloc_frames) _PD_rl_frames();
 
272
      return(NULL);
 
273
 
 
274
   default:
 
275
      memset(lite_PD_err, 0, MAXLINE);
 
276
      break;
 
277
   }
 
278
 
 
279
   /*
 
280
    * Copy these arguments into global (file static) variables.
 
281
    */
 
282
   file_s      = file;
 
283
   FRAME(flag) = flag;
 
284
 
 
285
   _PD_parse();
 
286
 
 
287
   _PD_reduce();
 
288
 
 
289
   dims = CURRENT(dims);
 
290
   type = CURRENT(intype);
 
291
   numb = CURRENT(number);
 
292
   indr = CURRENT(indir_info);
 
293
   addr = CURRENT(ad).diskaddr;
 
294
   sp   = CURRENT(blocks);
 
295
 
 
296
   ep = _lite_PD_mk_syment(type, numb, addr, &indr, dims);
 
297
 
 
298
   if (sp != NULL) {
 
299
      SFREE(PD_entry_blocks(ep));
 
300
      PD_entry_blocks(ep) = sp;
 
301
      lite_SC_mark(sp, 1);
 
302
   }
 
303
 
 
304
   SFREE(dims);
 
305
   SFREE(sp);
 
306
 
 
307
   if (fullname != NULL) strcpy(fullname, FRAME(path));
 
308
   if (alloc_frames) _PD_rl_frames();
 
309
 
 
310
   return(ep);
 
311
}
 
312
 
 
313
 
 
314
/*-------------------------------------------------------------------------
 
315
 * Function:    _PD_rl_frames
 
316
 *
 
317
 * Purpose:     Free the set parse frames.
 
318
 *
 
319
 * Return:      void
 
320
 *
 
321
 * Programmer:  Adapted from PACT PDB
 
322
 *              Mar  5, 1996  3:20 PM EST
 
323
 *
 
324
 * Modifications:
 
325
 *
 
326
 *-------------------------------------------------------------------------
 
327
 */
 
328
static void
 
329
_PD_rl_frames (void) {
 
330
 
 
331
   SFREE(FRAME(stack));
 
332
   SFREE(FRAME(lex_bf));
 
333
   SFREE(frames);
 
334
}
 
335
 
 
336
 
 
337
/*-------------------------------------------------------------------------
 
338
 * Function:    _PD_shift
 
339
 *
 
340
 * Purpose:     Perform a shift operation.
 
341
 *
 
342
 * Return:      void
 
343
 *
 
344
 * Programmer:  Adapted from PACT PDB
 
345
 *              Mar  6, 1996 11:21 AM EST
 
346
 *
 
347
 * Modifications:
 
348
 *    Eric Brugger, Mon Dec  8 17:26:38 PST 1998
 
349
 *    I added calls to lite_SC_mark to bump memory reference counts as
 
350
 *    appropriate.
 
351
 *
 
352
 *-------------------------------------------------------------------------
 
353
 */
 
354
/* ARGSUSED */
 
355
static void
 
356
_PD_shift (char *name, char *type, dimdes *dims, symblock *blocks,
 
357
           long numb, long addr, int indr, int cmmnd) {
 
358
 
 
359
   if (type[0] == '\0')
 
360
      lite_PD_error("NO TYPE SPECIFIED - _PD_SHIFT", PD_TRACE);
 
361
 
 
362
   if (frames == NULL) {
 
363
      frame_n  = 0;
 
364
      frame_nx = 2;
 
365
      frames   = FMAKE_N(parse_frame, frame_nx, "_PD_EFFECTIVE_EP:frames");
 
366
   }
 
367
 
 
368
   FRAME(n)++;
 
369
   if (FRAME(n) >= FRAME(nx)) {
 
370
      FRAME(nx) += 10;
 
371
      REMAKE_N(FRAME(stack), locator, FRAME(nx));
 
372
   }
 
373
 
 
374
   memset(FRAME(stack)+FRAME(n), 0, sizeof(locator));
 
375
 
 
376
   strcpy(CURRENT(intype), type);
 
377
 
 
378
   CURRENT(number)      = numb;
 
379
   CURRENT(ad.diskaddr) = addr;
 
380
   CURRENT(indirect)    = indr;
 
381
   CURRENT(dims)        = dims;
 
382
   CURRENT(blocks)      = blocks;
 
383
   CURRENT(cmmnd)       = cmmnd;
 
384
 
 
385
   lite_SC_mark(dims, 1);
 
386
   lite_SC_mark(blocks, 1);
 
387
}
 
388
 
 
389
 
 
390
/*-------------------------------------------------------------------------
 
391
 * Function:    _PD_reduce
 
392
 *
 
393
 * Purpose:     Reduce the parse three.  This means looping over the
 
394
 *              locator stack through the latest GOTO command and
 
395
 *              determining a new locator whose intype, dimensions, number,
 
396
 *              and address can be used to create a valid effective symbol
 
397
 *              table entry or an actual one.  If there is an intermediate
 
398
 *              expression on the stack it will be read and the value (which
 
399
 *              can only be an index) is returned.
 
400
 *
 
401
 * Return:      Success:        See above
 
402
 *
 
403
 *              Failure:        
 
404
 *
 
405
 * Programmer:  Adapted from PACT PDB
 
406
 *              Mar  5, 1996  3:05 PM EST
 
407
 *
 
408
 * Modifications:
 
409
 *    Eric Brugger, Mon Dec  8 17:26:38 PST 1998
 
410
 *    I added calls to lite_SC_mark to bump memory reference counts as
 
411
 *    appropriate.  I eliminated some memory leaks.
 
412
 *
 
413
 *-------------------------------------------------------------------------
 
414
 */
 
415
static long
 
416
_PD_reduce (void) {
 
417
 
 
418
   int i, nmn, nmx, cmnd;
 
419
   long addr, val, numb;
 
420
   char *type;
 
421
   dimdes *dims;
 
422
   symblock *sp;
 
423
   symindir iloc;
 
424
 
 
425
   val = 0L;
 
426
   nmx = FRAME(n);
 
427
 
 
428
   type = CURRENT(intype);
 
429
   numb = CURRENT(number);
 
430
   dims = CURRENT(dims);
 
431
   lite_SC_mark(dims, 1);
 
432
 
 
433
   /*
 
434
    * Find the most recent GOTO commmand.
 
435
    */
 
436
   for (i = nmx; i > 0; i--) {
 
437
      cmnd = FRAME(stack)[i].cmmnd;
 
438
      if (cmnd == GOTO_C) break;
 
439
   }
 
440
 
 
441
   nmn  = MAX(i, 1);
 
442
   addr = 0L;
 
443
 
 
444
   iloc.addr       = 0L;
 
445
   iloc.n_ind_type = 0L;
 
446
   iloc.arr_offs   = 0L;
 
447
 
 
448
   /*
 
449
    * Find the actual address of the specified object.
 
450
    */
 
451
   if (file_s->virtual_internal) {
 
452
      addr = FRAME(stack)[nmx].ad.diskaddr;
 
453
   } else {
 
454
      for (i = nmn; i <= nmx; i++) {
 
455
         cmnd = FRAME(stack)[i].cmmnd;
 
456
         if (cmnd == DEREF_C) {
 
457
            addr = _PD_deref_addr(i);
 
458
         } else if (cmnd == INDEX_C) {
 
459
            addr = _PD_index_deref(i, &dims, &numb);
 
460
            iloc = FRAME(stack)[i].indir_info;
 
461
         } else if (cmnd == MEMBER_C) {
 
462
            addr = _PD_member_deref(i);
 
463
         } else if (cmnd != CAST_C) {
 
464
            addr += FRAME(stack)[i].ad.diskaddr;
 
465
            FRAME(stack)[i].ad.diskaddr = addr;
 
466
         }
 
467
         SFREE(FRAME(stack)[i-1].dims);
 
468
         SFREE(FRAME(stack)[i-1].blocks);
 
469
      }
 
470
   }
 
471
 
 
472
   /*
 
473
    * This must be taken now because the address reduction may have
 
474
    * changed the original.
 
475
    */
 
476
   sp = CURRENT(blocks);
 
477
 
 
478
   FRAME(n) = nmn;
 
479
 
 
480
   /*
 
481
    * If we are not at the bottom of the locator stack we have
 
482
    * and intermediate expression which must by read in via _PD_rd_syment.
 
483
    */
 
484
   if (nmn != 1) {
 
485
      syment *ep;
 
486
 
 
487
      if (numb != 1L) {
 
488
         lite_PD_error("INTERMEDIATE MUST BE SCALAR INTEGER - _PD_REDUCE",
 
489
                       PD_TRACE);
 
490
      }
 
491
 
 
492
      ep = _lite_PD_mk_syment(CURRENT(intype), 1L, addr, NULL, NULL);
 
493
      _lite_PD_rd_syment(file_s, ep, "long", &val);
 
494
      _lite_PD_rl_syment(ep);
 
495
 
 
496
      FRAME(n)--;
 
497
 
 
498
   } else {
 
499
 
 
500
      /*
 
501
       * Otherwise we are at the end of the locator stack and the necessary
 
502
       * information to build an effective syment must be filled in the
 
503
       * bottom most locator
 
504
       */
 
505
 
 
506
      strcpy(CURRENT(intype), type);
 
507
 
 
508
      CURRENT(number)      = numb;
 
509
      CURRENT(ad.diskaddr) = addr;
 
510
      CURRENT(blocks)      = sp;
 
511
      CURRENT(dims)        = dims;
 
512
      CURRENT(indir_info)  = iloc;
 
513
      CURRENT(cmmnd)       = RESULT_C;
 
514
   }
 
515
 
 
516
   return(val);
 
517
}
 
518
 
 
519
 
 
520
/*-------------------------------------------------------------------------
 
521
 * Function:    _PD_do_goto
 
522
 *
 
523
 * Purpose:     Carry out a goto command.  This should be starting out
 
524
 *              with something which is in the symbol table (it is an
 
525
 *              error if not).
 
526
 *
 
527
 * Return:      void
 
528
 *
 
529
 * Programmer:  Adapted from PACT PDB
 
530
 *              Mar  6, 1996 10:50 AM EST
 
531
 *
 
532
 * Modifications:
 
533
 *
 
534
 *-------------------------------------------------------------------------
 
535
 */
 
536
static void
 
537
_PD_do_goto (char *name) {
 
538
 
 
539
   char *type;
 
540
   int indr;
 
541
   long numb, addr;
 
542
   dimdes *dims;
 
543
   symblock *sp;
 
544
   syment *ep;
 
545
   defstr *dp;
 
546
 
 
547
   ep = lite_PD_inquire_entry(file_s, name, FRAME(flag), FRAME(path));
 
548
   if (ep == NULL) lite_PD_error("NON-EXISTENT ENTRY - _PD_DO_GOTO", PD_TRACE);
 
549
 
 
550
   /*
 
551
    * Shift the starting point information onto the locator stack.
 
552
    */
 
553
   numb = PD_entry_number(ep);
 
554
   addr = PD_entry_address(ep);
 
555
   type = PD_entry_type(ep);
 
556
   dims = PD_entry_dimensions(ep);
 
557
   sp   = PD_entry_blocks(ep);
 
558
 
 
559
   dp = _lite_PD_lookup_type(type, file_s->chart);
 
560
   if (dp == NULL) lite_PD_error("UNDEFINED TYPE - _PD_DO_GOTO", PD_TRACE);
 
561
   if (dp->size_bits && (addr > 0)) addr *= -SC_BITS_BYTE;
 
562
 
 
563
   /*
 
564
    * Indirect does NOT mean that the type is indirect but that the
 
565
    * entry in the symbol table refers to a dynamically allocated
 
566
    * quantity, hence indirect means no dimensions.
 
567
    */
 
568
   indr = (dims == NULL);
 
569
 
 
570
   _PD_shift(name, type, dims, sp, numb, addr, indr, GOTO_C);
 
571
}
 
572
 
 
573
 
 
574
/*-------------------------------------------------------------------------
 
575
 * Function:    _PD_do_member
 
576
 *
 
577
 * Purpose:     Carry out a member command.
 
578
 *
 
579
 * Return:      void
 
580
 *
 
581
 * Programmer:  Adapted from PACT PDB
 
582
 *              Mar  6, 1996 10:55 AM EST
 
583
 *
 
584
 * Modifications:
 
585
 *
 
586
 *-------------------------------------------------------------------------
 
587
 */
 
588
static void
 
589
_PD_do_member (char *name, int deref_flag) {
 
590
 
 
591
   char *type, t[MAXLINE];
 
592
   int indr;
 
593
   long addr, numb, nsitems;
 
594
   dimdes *dims;
 
595
   defstr *dp;
 
596
   memdes *desc, *nxt;
 
597
   HASHTAB *tab;
 
598
 
 
599
   if (file_s->virtual_internal) tab = file_s->host_chart;
 
600
   else tab = file_s->chart;
 
601
 
 
602
   /*
 
603
    * If we came here with the "->" syntax we will need to shift
 
604
    * a derefence onto the locator stack ahead of the member shift
 
605
    * also update the path while we're at it.
 
606
    */
 
607
   if (deref_flag) {
 
608
      _PD_do_deref();
 
609
      sprintf(t, "%s->%s", FRAME(path), name);
 
610
   } else {
 
611
      sprintf(t, "%s.%s", FRAME(path), name);
 
612
   }
 
613
 
 
614
   strcpy(FRAME(path), t);
 
615
 
 
616
   /*
 
617
    * NOTE: we had better be properly dereferenced at this point!!!!!!!
 
618
    * DO NOT IMAGINE THAT ANYTHING DIFFERENT CAN BE DONE!!!!!!
 
619
    */
 
620
   type = CURRENT(intype);
 
621
   if (_lite_PD_indirection(type))
 
622
      lite_PD_error("IMPROPERLY DEREFERENCED EXPRESSION - _PD_DO_MEMBER",
 
623
                    PD_TRACE);
 
624
 
 
625
   /*
 
626
    * Find the defstr whose members are to be searched.
 
627
    */
 
628
   dp = PD_inquire_table_type(tab, type);
 
629
   if (dp == NULL) lite_PD_error("UNKNOWN TYPE - _PD_DO_MEMBER", PD_TRACE);
 
630
 
 
631
   /*
 
632
    * Loop over the members accumulating offset to the new address
 
633
    * and the number of indirect members which will have to
 
634
    * be skipped over.
 
635
    */
 
636
   addr    = 0L;
 
637
   nsitems = 0L;
 
638
   for (desc = dp->members; desc != NULL; desc = nxt) {
 
639
      nxt = desc->next;
 
640
      if (_PD_is_member(name, desc, tab, &nsitems)) {
 
641
         type = _PD_get_type_member(file_s, FRAME(path), name, desc, &dp);
 
642
 
 
643
         addr = desc->member_offs;
 
644
         dims = desc->dimensions;
 
645
         numb = _lite_PD_comp_num(dims);
 
646
         indr = _lite_PD_indirection(type);
 
647
 
 
648
         if (file_s->virtual_internal) {
 
649
            SC_address ad;
 
650
 
 
651
            ad   = FRAME(stack)[FRAME(n)].ad;
 
652
            addr = ad.diskaddr + desc->member_offs;
 
653
         }
 
654
 
 
655
         /*
 
656
          * Shift the member onto the locator stack.
 
657
          */
 
658
         _PD_shift(name, type, dims, NULL,
 
659
                   numb, addr, indr, MEMBER_C);
 
660
         CURRENT(n_struct_ptr) = nsitems;
 
661
 
 
662
         return;
 
663
      }
 
664
   }
 
665
 
 
666
   lite_PD_error("UNKNOWN MEMBER - _PD_DO_MEMBER", PD_TRACE);
 
667
}
 
668
 
 
669
 
 
670
/*-------------------------------------------------------------------------
 
671
 * Function:    _PD_do_deref
 
672
 *
 
673
 * Purpose:     Carry out a deref command.
 
674
 *
 
675
 * Return:      void
 
676
 *
 
677
 * Programmer:  Adapted from PACT PDB
 
678
 *              Mar  6, 1996 10:47 AM EST
 
679
 *
 
680
 * Modifications:
 
681
 *
 
682
 *-------------------------------------------------------------------------
 
683
 */
 
684
static void
 
685
_PD_do_deref (void) {
 
686
 
 
687
   long addr;
 
688
   char t[MAXLINE];
 
689
 
 
690
   strcpy(t, CURRENT(intype));
 
691
 
 
692
   if (file_s->virtual_internal) {
 
693
      SC_address ad;
 
694
 
 
695
      ad         = FRAME(stack)[FRAME(n)].ad;
 
696
      ad.memaddr = *(char **) ad.memaddr;
 
697
      addr       = ad.diskaddr;
 
698
 
 
699
   } else {
 
700
      addr = 0L;
 
701
   }
 
702
 
 
703
   _PD_shift("", t, NULL, NULL, -1L, addr, 0, DEREF_C);
 
704
 
 
705
   /*
 
706
    * Since the shift added a new one this will dereference the current
 
707
    * locator.
 
708
    */
 
709
   lite_PD_dereference(CURRENT(intype));
 
710
}
 
711
 
 
712
 
 
713
/*-------------------------------------------------------------------------
 
714
 * Function:    _PD_do_index
 
715
 *
 
716
 * Purpose:     Carry out an index command.  This must always set the
 
717
 *              current location to point to the first element indexed.
 
718
 *              If more than one element is referenced then that information
 
719
 *              must be put into the locator for future action.
 
720
 *
 
721
 * Return:      void
 
722
 *
 
723
 * Programmer:  Adapted from PACT PDB
 
724
 *              Mar  6, 1996 10:52 AM EST
 
725
 *
 
726
 * Modifications:
 
727
 *
 
728
 *-------------------------------------------------------------------------
 
729
 */
 
730
static void
 
731
_PD_do_index (char *expr) {
 
732
 
 
733
   int indr;
 
734
   long bpi, start, stop, step, numb, doff, addr;
 
735
   char t[MAXLINE], s[MAXLINE];
 
736
   char *type, *tok;
 
737
   dimdes *dims;
 
738
   symblock *sp;
 
739
 
 
740
   /*
 
741
    * Update the path.
 
742
    */
 
743
   sprintf(t, "%s[%s]", FRAME(path), expr);
 
744
   strcpy(FRAME(path), t);
 
745
 
 
746
   dims = CURRENT(dims);
 
747
   type = CURRENT(intype);
 
748
   doff = PD_get_offset(file_s);
 
749
 
 
750
   if (dims != NULL) {
 
751
      strcpy(t, type);
 
752
      lite_PD_dereference(t);
 
753
      numb = _lite_PD_hyper_number(file_s, expr, 1L, dims, &start);
 
754
      indr = FALSE;
 
755
   } else if (_lite_PD_indirection(type)) {
 
756
      _PD_do_deref();
 
757
 
 
758
      /*
 
759
       * Find the offset which will be the first part of the
 
760
       * index expression find the number of items requested.
 
761
       */
 
762
      strcpy(t, expr);
 
763
      tok = lite_SC_firsttok(t, ",");
 
764
 
 
765
      strcpy(s, tok);
 
766
      tok = strtok(s, ":");
 
767
      if (tok == NULL) {
 
768
         lite_PD_error("BAD INDEX EXPRESSION - _PD_DO_INDEX", PD_TRACE);
 
769
      }
 
770
 
 
771
      start = lite_SC_stoi(tok) - doff;
 
772
 
 
773
      tok = strtok(NULL, ":");
 
774
      if (tok == NULL) stop = start;
 
775
      else stop = lite_SC_stoi(tok) - doff;
 
776
 
 
777
      step = lite_SC_stoi(strtok(NULL, ":"));
 
778
      if (step == 0L) step = 1L;
 
779
 
 
780
      numb = (stop - start)/step + 1;
 
781
 
 
782
 
 
783
      strcpy(t, CURRENT(intype));
 
784
      indr = TRUE;
 
785
 
 
786
   } else {
 
787
      lite_PD_error("CAN'T INDEX OBJECT - _PD_DO_INDEX", PD_TRACE);
 
788
   }
 
789
 
 
790
   bpi = _lite_PD_lookup_size(t, file_s->chart);
 
791
 
 
792
   if (file_s->virtual_internal) {
 
793
      SC_address ad;
 
794
 
 
795
      ad   = FRAME(stack)[FRAME(n)].ad;
 
796
      addr = ad.diskaddr;
 
797
 
 
798
   } else {
 
799
      addr = 0L;
 
800
   }
 
801
 
 
802
   addr += start*bpi;
 
803
 
 
804
   sp = CURRENT(blocks);
 
805
 
 
806
   _PD_shift(expr, t, dims, sp, numb, addr, indr, INDEX_C);
 
807
 
 
808
   CURRENT(n_array_items) = start;
 
809
}
 
810
 
 
811
 
 
812
/*-------------------------------------------------------------------------
 
813
 * Function:    _PD_do_cast
 
814
 *
 
815
 * Purpose:     Carry out a CAST command.
 
816
 *
 
817
 * Return:      void
 
818
 *
 
819
 * Programmer:  Adapted from PACT PDB
 
820
 *              Mar  6, 1996 10:47 AM EST
 
821
 *
 
822
 * Modifications:
 
823
 *
 
824
 *-------------------------------------------------------------------------
 
825
 */
 
826
static void
 
827
_PD_do_cast (char *type) {
 
828
 
 
829
   int in;
 
830
   long n, da;
 
831
   char t[MAXLINE], s[MAXLINE];
 
832
   symblock *sp;
 
833
   dimdes *dm;
 
834
 
 
835
   /*
 
836
    * Update the path.
 
837
    */
 
838
   sprintf(t, "(%s) %s", type, FRAME(path));
 
839
   strcpy(FRAME(path), t);
 
840
 
 
841
   da = CURRENT(ad.diskaddr);
 
842
   in = CURRENT(indirect);
 
843
   n  = CURRENT(number);
 
844
   sp = CURRENT(blocks);
 
845
   dm = CURRENT(dims);
 
846
 
 
847
   strcpy(s, CURRENT(intype));
 
848
 
 
849
   _PD_shift("", s, dm, sp, n, da, in, CAST_C);
 
850
 
 
851
   strcpy(outtype, type);
 
852
}
 
853
 
 
854
 
 
855
/*-------------------------------------------------------------------------
 
856
 * Function:    _PD_do_digress
 
857
 *
 
858
 * Purpose:     Carry out a digress command.
 
859
 *
 
860
 * Return:      Success:        
 
861
 *
 
862
 *              Failure:        
 
863
 *
 
864
 * Programmer:  Adapted from PACT PDB
 
865
 *              Mar  6, 1996 10:49 AM EST
 
866
 *
 
867
 * Modifications:
 
868
 *
 
869
 *-------------------------------------------------------------------------
 
870
 */
 
871
/* ARGSUSED */
 
872
static long
 
873
_PD_do_digress (char *expr) {
 
874
 
 
875
   long val;
 
876
   char t[MAXLINE];
 
877
 
 
878
   /*
 
879
    * Save the path.
 
880
    * NOTE: this doesn't support more than one level of recursion!!
 
881
    */
 
882
   strcpy(t, FRAME(path));
 
883
 
 
884
   val = _PD_reduce();    
 
885
 
 
886
   /*
 
887
    * Restore the path.
 
888
    */
 
889
   strcpy(FRAME(path), t);
 
890
 
 
891
   return(val);
 
892
}
 
893
 
 
894
 
 
895
/*-------------------------------------------------------------------------
 
896
 * Function:    _PD_is_member
 
897
 *
 
898
 * Purpose:     Determine whether or not the given member is the named
 
899
 *              member and return true iff it is.  Also return the updated
 
900
 *              number of struct indirections to track via the arg list.
 
901
 *
 
902
 * Return:      Success:        true or false
 
903
 *
 
904
 *              Failure:        never fails
 
905
 *
 
906
 * Programmer:  Adapted from PACT PDB
 
907
 *              Mar  6, 1996 11:18 AM EST
 
908
 *
 
909
 * Modifications:
 
910
 *
 
911
 *-------------------------------------------------------------------------
 
912
 */
 
913
/* ARGSUSED */
 
914
static int
 
915
_PD_is_member (char *name, memdes *desc, HASHTAB *tab, long *pns) {
 
916
 
 
917
 
 
918
   if (strcmp(desc->name, name) == 0) {
 
919
      /*
 
920
       * If this is the member say so.
 
921
       */
 
922
      return(TRUE);
 
923
   } else {
 
924
      /*
 
925
       * Count up the number of indirects in the structure which will
 
926
       * be skipped.
 
927
       */
 
928
      if (_lite_PD_indirection(desc->type)) {
 
929
         *pns += _lite_PD_member_items(desc->member);
 
930
      }
 
931
      return(FALSE);
 
932
   }
 
933
}
 
934
 
 
935
 
 
936
/*-------------------------------------------------------------------------
 
937
 * Function:    _PD_get_type_member
 
938
 *
 
939
 * Purpose:     Get the true type of the member.  Handle any casts.
 
940
 *
 
941
 * Return:      Success:        The type.
 
942
 *
 
943
 *              Failure:        
 
944
 *
 
945
 * Programmer:  Adapted from PACT PDB
 
946
 *              Mar  6, 1996 11:15 AM EST
 
947
 *
 
948
 * Modifications:
 
949
 *
 
950
 *-------------------------------------------------------------------------
 
951
 */
 
952
/* ARGSUSED */
 
953
static char *
 
954
_PD_get_type_member (PDBfile *file, char *path_name, char *name,
 
955
                     memdes *desc, defstr **pdp) {
 
956
 
 
957
   char *mtype;
 
958
   HASHTAB *tab;
 
959
 
 
960
   if (file->virtual_internal) tab = file->host_chart;
 
961
   else tab = file->chart;
 
962
 
 
963
   *pdp = PD_inquire_table_type(tab, desc->base_type);
 
964
   if (*pdp == NULL)
 
965
      lite_PD_error("UNDEFINED TYPE - _PD_GET_TYPE_MEMBER", PD_TRACE);
 
966
 
 
967
   if (desc->cast_offs < 0L) {
 
968
      mtype = desc->type;
 
969
   } else {
 
970
      if (file->virtual_internal) {
 
971
         SC_address ad;
 
972
 
 
973
         ad    = FRAME(stack)[FRAME(n)].ad;
 
974
         mtype = DEREF(ad.memaddr + desc->cast_offs);
 
975
         if (mtype == NULL) {
 
976
            if (DEREF(ad.memaddr + desc->member_offs) == NULL) {
 
977
               mtype = desc->type;
 
978
            } else {
 
979
               lite_PD_error("NULL CAST TO NON-NULL MEMBER - "
 
980
                             "_PD_GET_TYPE_MEMBER", PD_TRACE);
 
981
            }
 
982
         }
 
983
 
 
984
      } else {
 
985
         char s[MAXLINE], c;
 
986
         int i;
 
987
 
 
988
         /*
 
989
          * Build the path of the member which points to the real type.
 
990
          */
 
991
         strcpy(s, path_name);
 
992
         for (i = strlen(s) - 1; i >= 0; i--) {
 
993
            c = s[i];
 
994
            if ((c == '>') || (c == '.')) break;
 
995
         }
 
996
         s[i+1] = '\0';
 
997
         strcat(s, desc->cast_memb);
 
998
 
 
999
         _PD_save_stack();
 
1000
 
 
1001
         /*
 
1002
          * Read the real type in.
 
1003
          */
 
1004
         lite_PD_read(file, s, &mtype);
 
1005
         if (mtype == NULL) mtype = desc->type;
 
1006
 
 
1007
         _PD_restore_stack();
 
1008
      }
 
1009
   }
 
1010
 
 
1011
   return(mtype);
 
1012
}
 
1013
 
 
1014
 
 
1015
/*-------------------------------------------------------------------------
 
1016
 * Function:    _PD_save_stack
 
1017
 *
 
1018
 * Purpose:     Save the state of the current parse.
 
1019
 *
 
1020
 * Return:      void
 
1021
 *
 
1022
 * Programmer:  Adapted from PACT PDB
 
1023
 *              Mar  6, 1996 11:31 AM EST
 
1024
 *
 
1025
 * Modifications:
 
1026
 *
 
1027
 *-------------------------------------------------------------------------
 
1028
 */
 
1029
static void
 
1030
_PD_save_stack (void) {
 
1031
 
 
1032
   frame_n++;
 
1033
   if (frame_n >= frame_nx) {
 
1034
      frame_nx += 2;
 
1035
      REMAKE_N(frames, parse_frame, frame_nx);
 
1036
   }
 
1037
 
 
1038
   memset(&frames[frame_n], 0, sizeof(parse_frame));
 
1039
}
 
1040
 
 
1041
 
 
1042
/*-------------------------------------------------------------------------
 
1043
 * Function:    _PD_restore_stack
 
1044
 *
 
1045
 * Purpose:     Restore the state of the previous parse.
 
1046
 *
 
1047
 * Return:      void
 
1048
 *
 
1049
 * Programmer:  Adapted from PACT PDB
 
1050
 *              Mar  6, 1996 11:31 AM EST
 
1051
 *
 
1052
 * Modifications:
 
1053
 *
 
1054
 *-------------------------------------------------------------------------
 
1055
 */
 
1056
static void
 
1057
_PD_restore_stack (void) {
 
1058
 
 
1059
   SFREE(FRAME(stack));
 
1060
   SFREE(FRAME(lex_bf));
 
1061
   frame_n--;
 
1062
}
 
1063
 
 
1064
 
 
1065
/*-------------------------------------------------------------------------
 
1066
 * Function:    _PD_deref_addr
 
1067
 *
 
1068
 * Purpose:     Dereference a pointer and return the correct address
 
1069
 *              of the pointee.  The entire parse tree is avaiable to
 
1070
 *              provide all necessary context.
 
1071
 *
 
1072
 * Return:      Success:        
 
1073
 *
 
1074
 *              Failure:        
 
1075
 *
 
1076
 * Programmer:  Adapted from PACT PDB
 
1077
 *              Mar  5, 1996  4:11 PM EST
 
1078
 *
 
1079
 * Modifications:
 
1080
 *    Eric Brugger, Mon Dec  8 17:26:38 PST 1998
 
1081
 *    I added calls to lite_SC_mark to bump memory reference counts as
 
1082
 *    appropriate.
 
1083
 *
 
1084
 *-------------------------------------------------------------------------
 
1085
 */
 
1086
static long
 
1087
_PD_deref_addr (int n) {
 
1088
 
 
1089
   long addr, numb, bpi;
 
1090
   char *type;
 
1091
   HASHTAB *tab;
 
1092
   FILE *fp;
 
1093
   dimdes *dims;
 
1094
   symblock *sp;
 
1095
 
 
1096
   tab  = file_s->chart;
 
1097
   type = FRAME(stack)[n-1].intype;
 
1098
   bpi  = _lite_PD_lookup_size(type, tab);
 
1099
 
 
1100
   /*
 
1101
    * Handle the case of in memory pointers.
 
1102
    */
 
1103
   if (file_s->virtual_internal) {
 
1104
      addr = FRAME(stack)[n].ad.diskaddr;
 
1105
      numb = FRAME(stack)[n].number;
 
1106
   } else {
 
1107
      /*
 
1108
       * Handle the case of file pointers
 
1109
       */
 
1110
      PD_itag itag;
 
1111
 
 
1112
      addr = FRAME(stack)[n-1].ad.diskaddr;
 
1113
      numb = FRAME(stack)[n-1].number;
 
1114
 
 
1115
      /*
 
1116
       * Get past the level that contains the dereference
 
1117
       * NOTE: PDB declines to write top level pointers which are
 
1118
       *       useless numbers, it starts in with the pointees and
 
1119
       *       hence the start of such objects are the itags of the
 
1120
       *       pointees.
 
1121
       */
 
1122
      if (!_lite_PD_indirection(type)) addr += numb*bpi;
 
1123
 
 
1124
      fp = file_s->stream;
 
1125
      if (io_seek(fp, addr, SEEK_SET)) {
 
1126
         lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_DEREF_ADDR",
 
1127
                       PD_TRACE);
 
1128
      }
 
1129
 
 
1130
      _lite_PD_rd_itag(file_s, &itag);
 
1131
 
 
1132
      addr = io_tell(fp);
 
1133
      numb = itag.nitems;
 
1134
 
 
1135
      if (!_lite_PD_indirection(FRAME(stack)[n].intype)) {
 
1136
         sp = FMAKE(symblock, "_PD_DEREF_ADDR:sp");
 
1137
         sp->number   = numb;
 
1138
         sp->diskaddr = addr;
 
1139
 
 
1140
         if ((n + 1) == FRAME(n)) {
 
1141
            dims = _lite_PD_mk_dimensions(file_s->default_offset, numb);
 
1142
         } else {
 
1143
            dims = NULL;
 
1144
         }
 
1145
 
 
1146
         FRAME(stack)[n].blocks = sp;
 
1147
         FRAME(stack)[n].dims   = dims;
 
1148
 
 
1149
         if (n < FRAME(n)) {
 
1150
            if (FRAME(stack)[n+1].cmmnd == INDEX_C) {
 
1151
               FRAME(stack)[n+1].blocks = sp;
 
1152
               FRAME(stack)[n+1].dims   = dims;
 
1153
               lite_SC_mark(sp, 1);
 
1154
               lite_SC_mark(dims, 1);
 
1155
            }
 
1156
         }
 
1157
      }
 
1158
   }
 
1159
 
 
1160
   FRAME(stack)[n].number      = numb;
 
1161
   FRAME(stack)[n].ad.diskaddr = addr;
 
1162
 
 
1163
   return(addr);
 
1164
}
 
1165
 
 
1166
 
 
1167
/*-------------------------------------------------------------------------
 
1168
 * Function:    _PD_index_deref
 
1169
 *
 
1170
 * Purpose:     Handle indexing where a pointered type was just
 
1171
 *              dereferenced.  This will mean skipping over itags and
 
1172
 *              other pointees.
 
1173
 *
 
1174
 * Return:      Success:        
 
1175
 *
 
1176
 *              Failure:        
 
1177
 *
 
1178
 * Programmer:  Adapted from PACT PDB
 
1179
 *              Mar  5, 1996  4:20 PM EST
 
1180
 *
 
1181
 * Modifications:
 
1182
 *    Eric Brugger, Mon Dec  8 17:26:38 PST 1998
 
1183
 *    I added calls to lite_SC_mark to bump memory reference counts as
 
1184
 *    appropriate.  I eliminated some memory leaks.
 
1185
 *
 
1186
 *-------------------------------------------------------------------------
 
1187
 */
 
1188
static long
 
1189
_PD_index_deref (int n, dimdes **pdims, long *pnumb) {
 
1190
 
 
1191
   long indx, addr, numb, naitems, bpi;
 
1192
   char *type, *typc, *typp;
 
1193
   symblock *nsp;
 
1194
   symindir iloc;
 
1195
   FILE *fp;
 
1196
   HASHTAB *tab;
 
1197
 
 
1198
   nsp = NULL;
 
1199
 
 
1200
   iloc.addr       = 0L;
 
1201
   iloc.n_ind_type = 0L;
 
1202
   iloc.arr_offs   = 0L;
 
1203
 
 
1204
   if (file_s->virtual_internal) {
 
1205
      /*
 
1206
       * Handle in memory indexing.
 
1207
       */
 
1208
      addr = FRAME(stack)[n].ad.diskaddr;
 
1209
   } else {
 
1210
      /*
 
1211
       * Handle file indexing.
 
1212
       * Start at the address before the latest DEREF.
 
1213
       */
 
1214
      typp = FRAME(stack)[n-1].intype;
 
1215
      type = FRAME(stack)[n].intype;
 
1216
      typc = FRAME(stack)[n+1].intype;
 
1217
      indx = FRAME(stack)[n].n_array_items;
 
1218
 
 
1219
      fp  = file_s->stream;
 
1220
      tab = file_s->chart;
 
1221
 
 
1222
      iloc.n_ind_type = _PD_num_indirects(type, tab);
 
1223
      iloc.arr_offs   = indx;
 
1224
 
 
1225
      /*
 
1226
       * In order to know where to go you have to know whether the
 
1227
       * next thing on the locator stack dereferences a pointer
 
1228
       */
 
1229
      if (((n < FRAME(n)) && _lite_PD_indirection(typc)) ||
 
1230
          _lite_PD_indirection(typp)) {
 
1231
         numb = FRAME(stack)[n-1].number;
 
1232
         if ((indx < 0) || (numb < indx))
 
1233
            lite_PD_error("INDEX OUT OF BOUNDS - _PD_INDEX_DEREF", PD_TRACE);
 
1234
 
 
1235
         /*
 
1236
          * Handle GOTO, DEREF, INDEX.
 
1237
          */
 
1238
         if (FRAME(stack)[n-1].cmmnd == DEREF_C) {
 
1239
            addr = FRAME(stack)[n-2].ad.diskaddr;
 
1240
            if (io_seek(fp, addr, SEEK_SET))
 
1241
               lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_INDEX_DEREF",
 
1242
                             PD_TRACE);
 
1243
 
 
1244
            /*
 
1245
             * Skip over the thing that was DEREF'd to where its
 
1246
             * pointees begin.
 
1247
             */
 
1248
            addr = _lite_PD_skip_over(file_s, 1L, TRUE);
 
1249
 
 
1250
            /*
 
1251
             * Skip over all items before the indexed one.
 
1252
             */
 
1253
            numb    = _PD_num_indirects(type, tab);
 
1254
            naitems = indx*MAX(1, numb);
 
1255
            addr    = _lite_PD_skip_over(file_s, naitems, FALSE);
 
1256
 
 
1257
         } else {
 
1258
            /*
 
1259
             * Handle GOTO, INDEX.
 
1260
             */
 
1261
            addr = FRAME(stack)[n-1].ad.diskaddr;
 
1262
 
 
1263
            if (!_lite_PD_indirection(typp)) {
 
1264
               bpi   = _lite_PD_lookup_size(typp, tab);
 
1265
               addr += numb*bpi;
 
1266
               if (io_seek(fp, addr, SEEK_SET))
 
1267
                  lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_INDEX_DEREF",
 
1268
                                PD_TRACE);
 
1269
 
 
1270
               /*
 
1271
                * Skip over all items before the indexed one.
 
1272
                */
 
1273
               numb    = _PD_num_indirects(typp, tab);
 
1274
               naitems = indx*MAX(1, numb);
 
1275
               addr    = _lite_PD_skip_over(file_s, naitems, FALSE);
 
1276
            } else {
 
1277
               /* NOTE: if we get here, then we have an array of pointers (the
 
1278
                *       data for which is not written by PDB - the pointers are
 
1279
                *       meaningless numbers) consequently we are staring at the
 
1280
                *       ITAG of the first pointee
 
1281
                */
 
1282
               PD_itag itag;
 
1283
 
 
1284
               /*
 
1285
                * Be sure that we are at the first ITAG.
 
1286
                */
 
1287
               if (io_seek(fp, addr, SEEK_SET))
 
1288
                  lite_PD_error("FSEEK FAILED - _PD_INDEX_DEREF",
 
1289
                                PD_TRACE);
 
1290
 
 
1291
               *pdims = NULL;
 
1292
 
 
1293
               /*
 
1294
                * Skip over to the indexed element.
 
1295
                */
 
1296
               numb    = _PD_num_indirects(typp, tab);
 
1297
               naitems = indx*MAX(1, numb);
 
1298
               addr    = _lite_PD_skip_over(file_s, naitems, FALSE);
 
1299
 
 
1300
               _lite_PD_rd_itag(file_s, &itag);
 
1301
               if (!itag.flag) {
 
1302
                  if (io_seek(fp, addr, SEEK_SET))
 
1303
                     lite_PD_error("FSEEK FAILED - _PD_INDEX_DEREF",
 
1304
                                   PD_TRACE);
 
1305
                  _lite_PD_rd_itag(file_s, &itag);
 
1306
               }
 
1307
 
 
1308
               numb   = itag.nitems;
 
1309
               *pnumb = numb;
 
1310
               FRAME(stack)[n].number   = numb;
 
1311
 
 
1312
               /*
 
1313
                * After doing one index the next thing has to be contiguous.
 
1314
                */
 
1315
               SFREE(FRAME(stack)[n+1].blocks);
 
1316
 
 
1317
               addr   = io_tell(fp);
 
1318
            }
 
1319
         }
 
1320
      } else {
 
1321
         /*
 
1322
          * Handle direct types simply.
 
1323
          * GOTCHA: it is a temporary measure to pass the old dimensions
 
1324
          *         up the stack the correct thing to do is to distinguish
 
1325
          *         between the dimensions of the source and the effective
 
1326
          *         dimension of the target.  This will never be right until
 
1327
          *         then.
 
1328
          */
 
1329
         symblock *sp;
 
1330
         long nbl, nbb;
 
1331
 
 
1332
         if (*pdims == NULL) {
 
1333
            *pdims = FRAME(stack)[n].dims;
 
1334
            lite_SC_mark(FRAME(stack)[n].dims, 1);
 
1335
         }
 
1336
 
 
1337
         SFREE(FRAME(stack)[n].dims);
 
1338
         FRAME(stack)[n].dims = FRAME(stack)[n-1].dims;
 
1339
         lite_SC_mark(FRAME(stack)[n-1].dims, 1);
 
1340
         addr  = FRAME(stack)[n-1].ad.diskaddr;
 
1341
 
 
1342
         sp    = FRAME(stack)[n].blocks;
 
1343
         numb  = FRAME(stack)[n].ad.diskaddr;
 
1344
         bpi   = _lite_PD_lookup_size(type, tab);
 
1345
 
 
1346
         nbl       = FRAME(stack)[n-1].number;
 
1347
         iloc.addr = addr + nbl*bpi;
 
1348
 
 
1349
         /*
 
1350
          * Deal with multiblock entries.
 
1351
          */
 
1352
         nsp = NULL;
 
1353
 
 
1354
         /* NOTE: it is not the most general thing to assume that bitstreams
 
1355
          *       (indicated by negative addresses) must be contiguous although
 
1356
          *       all current examples are
 
1357
          */
 
1358
         if ((sp != NULL) && (addr >= 0)) {
 
1359
            nbl = lite_SC_arrlen(sp)/sizeof(symblock);
 
1360
 
 
1361
            /*
 
1362
             * Find out which block we got into.
 
1363
             */
 
1364
            while (TRUE) {
 
1365
               nbb  = sp->number*bpi;
 
1366
               addr = sp->diskaddr;
 
1367
               if (numb < nbb) break;
 
1368
 
 
1369
               numb -= nbb;
 
1370
               sp++;
 
1371
               nbl--;
 
1372
            }
 
1373
 
 
1374
            iloc.addr = addr + nbb;
 
1375
 
 
1376
            /*
 
1377
             * Make a copy of the remaining blocks for the effective entry.
 
1378
             */
 
1379
            if (nbl > 0) {
 
1380
               int i;
 
1381
 
 
1382
               nsp = FMAKE_N(symblock, nbl, "_PD_INDEX_DEREF:nsp");
 
1383
               for (i = 0; i < nbl; i++) nsp[i] = *sp++;
 
1384
            }
 
1385
 
 
1386
            /*
 
1387
             * Adjust the first block to be consistent with the rest
 
1388
             * of the locator.
 
1389
             */
 
1390
            nsp[0].number   -= numb/bpi;
 
1391
            nsp[0].diskaddr  = addr + numb;
 
1392
         }
 
1393
 
 
1394
         if (addr < 0) {
 
1395
            defstr *dp;
 
1396
 
 
1397
            dp = PD_inquire_table_type(tab, type);
 
1398
            addr -= (numb/bpi)*dp->size_bits;
 
1399
         } else {
 
1400
            *pnumb = FRAME(stack)[n].number;
 
1401
            addr += numb;
 
1402
         }
 
1403
      }
 
1404
   }
 
1405
 
 
1406
   SFREE(FRAME(stack)[n].blocks);
 
1407
   FRAME(stack)[n].blocks      = nsp;
 
1408
   FRAME(stack)[n].ad.diskaddr = addr;
 
1409
   FRAME(stack)[n].indir_info  = iloc;
 
1410
 
 
1411
   return(addr);
 
1412
}
 
1413
 
 
1414
 
 
1415
/*-------------------------------------------------------------------------
 
1416
 * Function:    _PD_member_deref
 
1417
 *
 
1418
 * Purpose:     Find the member where a pointered type was just
 
1419
 *              dereferenced.  This will mean skipping over itags and
 
1420
 *              other pointees.
 
1421
 *
 
1422
 * Return:      Success:        
 
1423
 *
 
1424
 *              Failure:        
 
1425
 *
 
1426
 * Programmer:  Adapted from PACT PDB
 
1427
 *              Mar  5, 1996  4:38 PM EST
 
1428
 *
 
1429
 * Modifications:
 
1430
 *
 
1431
 *-------------------------------------------------------------------------
 
1432
 */
 
1433
static long
 
1434
_PD_member_deref (int n) {
 
1435
 
 
1436
   long addr, nsitems;
 
1437
   char *type;
 
1438
 
 
1439
   /*
 
1440
    * Handle in memory members.
 
1441
    */
 
1442
   if (file_s->virtual_internal) {
 
1443
      addr = FRAME(stack)[n].ad.diskaddr;
 
1444
   } else {
 
1445
      /*
 
1446
       * Handle file members.
 
1447
       */
 
1448
      int indir, cmmnd;
 
1449
      long bpi, numb;
 
1450
 
 
1451
      cmmnd = FRAME(stack)[n-1].cmmnd;
 
1452
      indir = _lite_PD_indirection(FRAME(stack)[n].intype);
 
1453
      if ((cmmnd == GOTO_C) && indir) {
 
1454
         addr = FRAME(stack)[n-1].ad.diskaddr;
 
1455
         type = FRAME(stack)[n-1].intype;
 
1456
         numb = FRAME(stack)[n-1].number;
 
1457
         bpi  = _lite_PD_lookup_size(type, file_s->chart);
 
1458
 
 
1459
         addr += bpi*numb;
 
1460
 
 
1461
         if (io_seek(file_s->stream, addr, SEEK_SET))
 
1462
            lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_MEMBER_DEREF",
 
1463
                          PD_TRACE);
 
1464
 
 
1465
      } else if ((cmmnd != INDEX_C) && indir) {
 
1466
         addr = FRAME(stack)[n-2].ad.diskaddr;
 
1467
 
 
1468
         if (io_seek(file_s->stream, addr, SEEK_SET))
 
1469
            lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_MEMBER_DEREF",
 
1470
                          PD_TRACE);
 
1471
 
 
1472
         /*
 
1473
          * Skip over the thing that was DEREF'd to where its pointees begin.
 
1474
          */
 
1475
         addr = _lite_PD_skip_over(file_s, 1L, TRUE);
 
1476
         
 
1477
      } else {
 
1478
         /*
 
1479
          * Start at the address in the previous locator.
 
1480
          */
 
1481
         addr = FRAME(stack)[n-1].ad.diskaddr;
 
1482
      }
 
1483
 
 
1484
      /*
 
1485
       * Handle indirect types differently from direct ones.
 
1486
       */
 
1487
      type = FRAME(stack)[n].intype;
 
1488
      if (_lite_PD_indirection(type)) {
 
1489
         nsitems = FRAME(stack)[n].n_struct_ptr;
 
1490
 
 
1491
         if (io_seek(file_s->stream, addr, SEEK_SET))
 
1492
            lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_MEMBER_DEREF",
 
1493
                          PD_TRACE);
 
1494
 
 
1495
         /*
 
1496
          * Skip over all items before the specified member.
 
1497
          */
 
1498
         addr = _lite_PD_skip_over(file_s, nsitems, FALSE);
 
1499
         
 
1500
      } else {
 
1501
         /*
 
1502
          * Handle direct types simply.
 
1503
          */
 
1504
         addr += FRAME(stack)[n].ad.diskaddr;
 
1505
      }
 
1506
   }
 
1507
 
 
1508
   FRAME(stack)[n].ad.diskaddr = addr;
 
1509
 
 
1510
   return(addr);
 
1511
}
 
1512
 
 
1513
 
 
1514
/*-------------------------------------------------------------------------
 
1515
 * Function:    _lite_PD_skip_over
 
1516
 *
 
1517
 * Purpose:     Given a number of units, skip over that many units
 
1518
 *              including subunits referenced by the top level units.  If
 
1519
 *              noind is true don't pick up the additional indirects.
 
1520
 *
 
1521
 * Return:      Success:        
 
1522
 *
 
1523
 *              Failure:        
 
1524
 *
 
1525
 * Programmer:  Adapted from PACT PDB
 
1526
 *              Mar  5, 1996  4:56 PM EST
 
1527
 *
 
1528
 * Modifications:
 
1529
 *     Brad Whitlock, Wed Feb 23 19:01:08 PST 2000
 
1530
 *     Added code to skip some logic when an itag cannot be read.
 
1531
 *
 
1532
 *-------------------------------------------------------------------------
 
1533
 */
 
1534
long
 
1535
_lite_PD_skip_over (PDBfile *file, long skip, int noind) {
 
1536
 
 
1537
   long bytepitem, addr;
 
1538
   int indir;
 
1539
   FILE *fp;
 
1540
   HASHTAB *tab;
 
1541
   PD_itag itag;
 
1542
 
 
1543
   fp  = file->stream;
 
1544
   tab = file->chart;
 
1545
 
 
1546
   while (skip-- > 0L)
 
1547
   {
 
1548
       if(TRUE == _lite_PD_rd_itag(file, &itag))
 
1549
       {
 
1550
           /*
 
1551
            * Note whether this is an indirection.
 
1552
            */
 
1553
           indir = _lite_PD_indirection(itag.type);
 
1554
 
 
1555
           /*
 
1556
            * If noind is TRUE don't pick up the indirects.
 
1557
            */
 
1558
          if (noind == FALSE)
 
1559
          {
 
1560
              /*
 
1561
               * If it is an indirection we have more to skip over.
 
1562
               */
 
1563
              if (indir) skip += itag.nitems;
 
1564
 
 
1565
              /*
 
1566
               * If it is a structure with indirections we have more to
 
1567
               * skip over.
 
1568
               */
 
1569
             skip += itag.nitems*_PD_num_indirects(itag.type, tab);
 
1570
          }
 
1571
 
 
1572
          /*
 
1573
           * If it was not a NULL pointer find it.
 
1574
           */
 
1575
          if ((itag.addr != -1L) && (itag.nitems != 0L))
 
1576
          {
 
1577
              if (!itag.flag && (skip == -1))
 
1578
              {
 
1579
                  if (io_seek(fp, itag.addr, SEEK_SET))
 
1580
                      lite_PD_error("CAN'T FIND REAL DATA - _PD_SKIP_OVER",
 
1581
                                    PD_TRACE);
 
1582
                  _lite_PD_rd_itag(file, &itag);
 
1583
              }
 
1584
 
 
1585
              /*
 
1586
               * Layered indirects have no "data" bytes written out to be
 
1587
               * skipped over.
 
1588
               */
 
1589
              if (!indir)
 
1590
              {
 
1591
                  bytepitem = _lite_PD_lookup_size(itag.type, tab);
 
1592
                  if (bytepitem == -1)
 
1593
                      lite_PD_error("CAN'T FIND NUMBER OF BYTES - _PD_SKIP_OVER",
 
1594
                                    PD_TRACE);
 
1595
              }
 
1596
              else
 
1597
              {
 
1598
                  bytepitem = 0;
 
1599
              }
 
1600
 
 
1601
              /*
 
1602
               * If its here, step over the data.
 
1603
               */
 
1604
              if (itag.flag && (skip > -1))
 
1605
              {
 
1606
                  addr = bytepitem*itag.nitems;
 
1607
                  if (!indir)
 
1608
                      if (io_seek(fp, addr, SEEK_CUR))
 
1609
                          lite_PD_error("CAN'T SKIP TO ADDRESS - _PD_SKIP_OVER",
 
1610
                                        PD_TRACE);
 
1611
              }
 
1612
          }
 
1613
      } /* end if (_lite_PD_rd_itag(...) == TRUE). */
 
1614
   } /* end while */
 
1615
 
 
1616
   addr = io_tell(fp);
 
1617
 
 
1618
   return(addr);
 
1619
}
 
1620
 
 
1621
 
 
1622
/*-------------------------------------------------------------------------
 
1623
 * Function:    _PD_num_indirects
 
1624
 *
 
1625
 * Purpose:     Count up the number of members of the given structure
 
1626
 *              with indirect references.
 
1627
 *
 
1628
 * Return:      Success:        Number of indirect references.
 
1629
 *
 
1630
 *              Failure:        lite_PD_error()
 
1631
 *
 
1632
 * Programmer:  Adapted from PACT PDB
 
1633
 *              Mar  6, 1996 11:06 AM EST
 
1634
 *
 
1635
 * Modifications:
 
1636
 *
 
1637
 *-------------------------------------------------------------------------
 
1638
 */
 
1639
static long
 
1640
_PD_num_indirects (char *type, HASHTAB *tab) {
 
1641
 
 
1642
   char *mtype;
 
1643
   defstr *dp;
 
1644
 
 
1645
   mtype = _lite_PD_member_base_type(type);
 
1646
   dp    = PD_inquire_table_type(tab, mtype);
 
1647
   SFREE(mtype);
 
1648
 
 
1649
   if (dp == NULL) {
 
1650
      lite_PD_error("CAN'T FIND TYPE - _PD_NUM_INDIRECTS", PD_TRACE);
 
1651
   }
 
1652
 
 
1653
   return(dp->n_indirects);
 
1654
}
 
1655
 
 
1656
/*--------------------------------------------------------------------------*/
 
1657
/*                          LEXICAL SCANNER ROUTINES                        */
 
1658
/*--------------------------------------------------------------------------*/
 
1659
 
 
1660
 
 
1661
/*-------------------------------------------------------------------------
 
1662
 * Function:    _PD_lex
 
1663
 *
 
1664
 * Purpose:     Lexical scanner called by the generated parser.  Text of
 
1665
 *              identifiers is put in the global variable TEXT.  The
 
1666
 *              numerical value of an integer token is put in the global
 
1667
 *              variable NUM_VAL.  Legal token values are:
 
1668
 *
 
1669
 *              OPEN_PAREN       ( or [                                   
 
1670
 *              CLOSE_PAREN      ) or ]                                   
 
1671
 *              DOT              .                                        
 
1672
 *              COMMA            ,                                        
 
1673
 *              COLON            :                                        
 
1674
 *              STAR             *                                        
 
1675
 *              ARROW            ->                                       
 
1676
 *              INTEGER          octal, decimal, or hexidecimal integer   
 
1677
 *              IDENTIFIER       just about anything else (no white space)
 
1678
 *              
 
1679
 * Return:      Success:        The value of the lexical token.
 
1680
 *
 
1681
 *              Failure:        0 if at the end of the input string.
 
1682
 *
 
1683
 * Programmer:  Adapted from PACT PDB
 
1684
 *              Mar  5, 1996  4:27 PM EST
 
1685
 *
 
1686
 * Modifications:
 
1687
 *
 
1688
 *-------------------------------------------------------------------------
 
1689
 */
 
1690
static int
 
1691
_PD_lex (void) {
 
1692
 
 
1693
   int c, d, start;
 
1694
 
 
1695
   start = FRAME(index);
 
1696
   while (TRUE) {
 
1697
      c = input();
 
1698
      switch (c) {
 
1699
      case '\0' :
 
1700
         if (FRAME(index) == start+1) {
 
1701
            unput(c);
 
1702
            return(0);
 
1703
         } else {
 
1704
            unput(c);
 
1705
            return(_PD_next_token(start));
 
1706
         }
 
1707
 
 
1708
      case '(' :
 
1709
      case '[' :
 
1710
         GOT_TOKEN(OPEN_PAREN);
 
1711
 
 
1712
      case ')' :
 
1713
      case ']' :
 
1714
         GOT_TOKEN(CLOSE_PAREN);
 
1715
 
 
1716
      case '.' :
 
1717
         GOT_TOKEN(DOT);
 
1718
 
 
1719
      case ',' :
 
1720
         GOT_TOKEN(COMMA);
 
1721
 
 
1722
      case ':' :
 
1723
         GOT_TOKEN(COLON);
 
1724
 
 
1725
      case '*' :
 
1726
         GOT_TOKEN(STAR);
 
1727
 
 
1728
      case '-' :
 
1729
         d = input();
 
1730
         if (d == '>') {
 
1731
            if (FRAME(index) == start+2) {
 
1732
               return(ARROW);
 
1733
            } else {
 
1734
               unput(d);
 
1735
               unput(c);
 
1736
               return(_PD_next_token(start));
 
1737
            }
 
1738
         }
 
1739
 
 
1740
      default :
 
1741
         break;
 
1742
      }
 
1743
   }
 
1744
}
 
1745
 
 
1746
 
 
1747
/*-------------------------------------------------------------------------
 
1748
 * Function:    _PD_next_token
 
1749
 *
 
1750
 * Purpose:     Figure out whether the specified token is an identifier
 
1751
 *              or an integer and take the apropriate action.
 
1752
 *
 
1753
 * Return:      Success:        
 
1754
 *
 
1755
 *              Failure:        
 
1756
 *
 
1757
 * Programmer:  Adapted from PACT PDB
 
1758
 *              Mar  6, 1996 11:04 AM EST
 
1759
 *
 
1760
 * Modifications:
 
1761
 *
 
1762
 *-------------------------------------------------------------------------
 
1763
 */
 
1764
static int
 
1765
_PD_next_token (int start) {
 
1766
 
 
1767
   int nc;
 
1768
   char *end, s[MAXLINE], *tok;
 
1769
 
 
1770
   nc = FRAME(index) - start;
 
1771
   strncpy(s, FRAME(lex_bf)+start, nc);
 
1772
   s[nc] = '\0';
 
1773
 
 
1774
   /*
 
1775
    * Eliminate whitespace from either end of the token.
 
1776
    * NOTE: things like "a b" are illegal anyway.
 
1777
    */
 
1778
   tok = strtok(s, " \t\f\n\r");
 
1779
   strcpy(text, tok);
 
1780
 
 
1781
   num_val = _lite_SC_strtol(text, &end, 0);
 
1782
   tok     = text + strlen(text);
 
1783
   if (tok == end) return(INTEGER);
 
1784
   else return(IDENTIFIER);
 
1785
}
 
1786
 
 
1787
 
 
1788
/*-------------------------------------------------------------------------
 
1789
 * Function:    _PD_parse
 
1790
 *
 
1791
 * Purpose:     Parse an expression which is in the lexical buffer of the
 
1792
 *              current parse frame.
 
1793
 *
 
1794
 * Return:      Success:        TRUE
 
1795
 *
 
1796
 *              Failure:        FALSE
 
1797
 *
 
1798
 * Programmer:  Adapted from PACT PDB
 
1799
 *              Mar  5, 1996  2:19 PM EST
 
1800
 *
 
1801
 * Modifications:
 
1802
 *
 
1803
 *-------------------------------------------------------------------------
 
1804
 */
 
1805
static void
 
1806
_PD_parse (void) {
 
1807
 
 
1808
   char **pvt;
 
1809
   register char **lpv;         /* top of value stack */
 
1810
   register int *lps;           /* top of state stack */
 
1811
   register int lstate;         /* current state */
 
1812
   register int  n;             /* internal state number info */
 
1813
   register int len;
 
1814
 
 
1815
   static int exca[] = {-1, 1, 0, -1, -2, 0,} ;
 
1816
   static int act[]  = { 3, 29,  5, 26, 24,  7,  7,  9, 19, 25,
 
1817
                         3, 18,  5, 10, 17,  7, 11, 12, 14, 15,
 
1818
                         20,  1, 16,  4,  6,  8, 13,  2,  0,  0,
 
1819
                         0,  0,  0,  0,  0, 23, 21, 22, 28,  0,
 
1820
                         27, 30} ;
 
1821
   static int pact[] = { -247, -1000, -1000,  -255,  -244,  -247,
 
1822
                         -1000, -1000,  -240, -1000,
 
1823
                         -257,  -256,  -256, -1000,  -247, -1000,
 
1824
                         -254, -1000,  -261, -1000,
 
1825
                         -1000, -1000, -1000, -1000, -1000,  -257,
 
1826
                         -257, -1000,  -263,  -257, -1000};
 
1827
   static int pgo[] = {0, 20, 27, 25, 23, 24, 22, 14, 11};
 
1828
   static int r1[]  = {0, 1, 1, 1, 3, 3, 2, 2, 4, 4,
 
1829
                       4, 4, 6, 6, 7, 7, 7, 8, 8, 5};
 
1830
   static int r2[]  = {0, 2, 9, 1, 3, 5,  2, 5, 3, 9,
 
1831
                       7, 7, 2, 7, 2, 7, 11, 3, 3, 3};
 
1832
   static int chk[] = {-1000,  -1,  -2, 257,  -4, 259,  -5, 262,  -3, 262,
 
1833
                       257, 260, 261,  -1, 258, 259,  -6,  -7,  -8, 265,
 
1834
                       -1,  -5,  -5,  -1, 258, 263, 264,  -7,  -8, 264, -8};
 
1835
   static int def[] = { 3, -2,  1, 0, 6, 3, 8, 19,  0,  4,
 
1836
                        3,  0,  0, 7, 3, 5, 0, 12, 14, 17,
 
1837
                        18, 10, 11, 2, 9, 3, 3, 13, 15,  3, 16};
 
1838
 
 
1839
   static int negative_one = -1;
 
1840
 
 
1841
   /*
 
1842
    * Initialize externals - _PD_parse may be called more than once.
 
1843
    */
 
1844
   FRAME(pv) = &FRAME(v)[negative_one];
 
1845
   FRAME(ps) = &FRAME(s)[negative_one];
 
1846
 
 
1847
   FRAME(state)         = 0;
 
1848
   FRAME(tmp)           = 0;
 
1849
   FRAME(n_error)       = 0;
 
1850
   FRAME(error)         = 0;
 
1851
   FRAME(current_token) = -1;
 
1852
 
 
1853
   lpv    = FRAME(pv);
 
1854
   lps    = FRAME(ps);
 
1855
   lstate = FRAME(state);
 
1856
 
 
1857
   colon = FALSE;
 
1858
 
 
1859
   /*
 
1860
    * loop as expressions are pushed onto the stack.
 
1861
    */
 
1862
   for (;;) {
 
1863
      /*
 
1864
       * Put a state and value onto the stacks.
 
1865
       */
 
1866
      if (++lps >= &FRAME(s)[MAXPARSEDEPTH])
 
1867
         lite_PD_error("STACK OVERFLOW - _PD_PARSE", PD_TRACE);
 
1868
 
 
1869
      *lps   = lstate;
 
1870
      *++lpv = FRAME(val);
 
1871
 
 
1872
      /*
 
1873
       * We have a new state - find out what to do.
 
1874
       */
 
1875
      n = pact[lstate];
 
1876
      if (n > STATEFLAG) {
 
1877
         if ((FRAME(current_token) < 0) &&
 
1878
             ((FRAME(current_token) = _PD_lex()) < 0))
 
1879
            FRAME(current_token) = 0;
 
1880
 
 
1881
         /*
 
1882
          * Valid shift.
 
1883
          */
 
1884
         n += FRAME(current_token);
 
1885
         if ((n >= 0) && (n < LASTTOK)) {
 
1886
            n = act[n];
 
1887
            if (chk[n] == FRAME(current_token)) {
 
1888
               FRAME(current_token) = -1;
 
1889
               FRAME(val) = FRAME(lval);
 
1890
 
 
1891
               lstate = n;
 
1892
               if (FRAME(error) > 0) FRAME(error)--;
 
1893
               continue;
 
1894
            }
 
1895
         }
 
1896
      }
 
1897
 
 
1898
      n = def[lstate];
 
1899
      if (n == -2) {
 
1900
         int *xi;
 
1901
 
 
1902
         if ((FRAME(current_token) < 0) &&
 
1903
             ((FRAME(current_token) = _PD_lex()) < 0))
 
1904
            FRAME(current_token) = 0;
 
1905
 
 
1906
         /*
 
1907
          * Look through exception table.
 
1908
          */
 
1909
         xi = exca;
 
1910
 
 
1911
         while ((*xi != -1) || (xi[1] != lstate)) {
 
1912
            xi += 2;
 
1913
         }
 
1914
 
 
1915
         while ((*(xi += 2) >= 0) && (*xi != FRAME(current_token))) /*void*/ ;
 
1916
 
 
1917
         n = xi[1];
 
1918
         if (n < 0) return;
 
1919
      }
 
1920
 
 
1921
      /*
 
1922
       * Check for syntax error.
 
1923
       */
 
1924
      if (n == 0) {
 
1925
         if (FRAME(error) > 0)
 
1926
            lite_PD_error("SYNTAX ERROR - _PD_PARSE", PD_TRACE);
 
1927
      }
 
1928
 
 
1929
      /*
 
1930
       * Reduction by production n.
 
1931
       */
 
1932
      FRAME(tmp) = n;           /* value to switch over */
 
1933
      pvt = lpv;                        /* top of value stack */
 
1934
 
 
1935
      /*
 
1936
       * Look in goto table for next state.
 
1937
       * If r2[n] doesn't have the low order bit set
 
1938
       * then there is no action to be done for this reduction
 
1939
       * and no saving/unsaving of registers done.
 
1940
       */
 
1941
      len = r2[n];
 
1942
      if (!(len & 01)) {
 
1943
         len >>= 1;
 
1944
         lpv -= len;
 
1945
         FRAME(val) = lpv[1];
 
1946
 
 
1947
         n = r1[n];
 
1948
         lps -= len;
 
1949
         lstate = pgo[n] + *lps + 1;
 
1950
         if ((lstate >= LASTTOK) ||
 
1951
             (chk[lstate = act[lstate]] != -n)) {
 
1952
            lstate = act[pgo[n]];
 
1953
         }
 
1954
 
 
1955
         continue;
 
1956
      }
 
1957
 
 
1958
      len >>= 1;
 
1959
      lpv -= len;
 
1960
      FRAME(val) = lpv[1];
 
1961
 
 
1962
      n   = r1[n];
 
1963
      lps -= len;
 
1964
      lstate = pgo[n] + *lps + 1;
 
1965
         
 
1966
      if ((lstate >= LASTTOK) ||
 
1967
          (chk[lstate = act[lstate]] != -n)) {
 
1968
         lstate = act[pgo[n]];
 
1969
      }
 
1970
 
 
1971
      /*
 
1972
       * Save until reenter driver code.
 
1973
       */
 
1974
      FRAME(state) = lstate;
 
1975
      FRAME(ps)    = lps;
 
1976
      FRAME(pv)    = lpv;
 
1977
 
 
1978
      _PD_disp_rules(FRAME(tmp), pvt);
 
1979
 
 
1980
      lpv    = FRAME(pv);
 
1981
      lps    = FRAME(ps);
 
1982
      lstate = FRAME(state);
 
1983
   }
 
1984
}
 
1985
 
 
1986
 
 
1987
/*-------------------------------------------------------------------------
 
1988
 * Function:    _PD_disp_rules
 
1989
 *
 
1990
 * Purpose:     Dispatch on the specified rule.
 
1991
 *
 
1992
 * Return:      void
 
1993
 *
 
1994
 * Programmer:  Adapted from PACT PDB
 
1995
 *              Mar  5, 1996  4:14 PM EST
 
1996
 *
 
1997
 * Modifications:
 
1998
 *
 
1999
 *-------------------------------------------------------------------------
 
2000
 */
 
2001
static void
 
2002
_PD_disp_rules (int rule, char **pvt) {
 
2003
 
 
2004
   switch (rule) {
 
2005
 
 
2006
      /* variable_expression :
 
2007
       *      unary_expression
 
2008
       *    | OPEN_PAREN type CLOSE_PAREN variable_expression
 
2009
       */
 
2010
   case 2:
 
2011
      _PD_do_cast(pvt[-2]);
 
2012
      break;
 
2013
 
 
2014
      /*    | */
 
2015
   case 3:
 
2016
      break;
 
2017
 
 
2018
      /* type :
 
2019
       *      IDENTIFIER
 
2020
       */
 
2021
   case 4:
 
2022
      FRAME(val) = text;
 
2023
      break;
 
2024
 
 
2025
      /*    | type STAR */
 
2026
   case 5:
 
2027
      sprintf(msg, "%s *", pvt[-1]);
 
2028
      FRAME(val) = msg;
 
2029
      break;
 
2030
 
 
2031
      /* unary_expression :
 
2032
       *      postfix_expression
 
2033
       *    | STAR variable_expression
 
2034
       */
 
2035
   case 7:
 
2036
      _PD_do_deref();
 
2037
      break;
 
2038
 
 
2039
      /* postfix_expression :
 
2040
       *      primary_expression
 
2041
       */
 
2042
   case 8:
 
2043
      _PD_do_goto(pvt[-0]);
 
2044
      break;
 
2045
 
 
2046
      /*    | postfix_expression OPEN_PAREN index_expression CLOSE_PAREN */
 
2047
   case 9:
 
2048
      _PD_do_index(pvt[-1]);
 
2049
      SFREE(pvt[-1]);
 
2050
      break;
 
2051
 
 
2052
      /*    | postfix_expression DOT primary_expression */
 
2053
   case 10:
 
2054
      _PD_do_member(pvt[-0], FALSE);
 
2055
      break;
 
2056
 
 
2057
      /*    | postfix_expression ARROW primary_expression */
 
2058
   case 11:
 
2059
      _PD_do_member(pvt[-0], TRUE);
 
2060
      break;
 
2061
 
 
2062
      /* index_expression :
 
2063
       *         range
 
2064
       *       | index_expression COMMA range
 
2065
       */
 
2066
   case 13:
 
2067
      sprintf(msg, "%s,%s", pvt[-2], pvt[-0]);
 
2068
      SFREE(pvt[-2]);
 
2069
      SFREE(pvt[-0]);
 
2070
      FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:COMMA");
 
2071
      break;
 
2072
 
 
2073
      /* range : index
 
2074
       *       | index COLON index
 
2075
       */
 
2076
   case 15:
 
2077
      if (strcmp(pvt[-2], pvt[-0]) != 0) colon = TRUE;
 
2078
      sprintf(msg, "%s:%s", pvt[-2], pvt[-0]);
 
2079
      SFREE(pvt[-2]);
 
2080
      SFREE(pvt[-0]);
 
2081
      FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:COLON");
 
2082
      break;
 
2083
 
 
2084
      /*       | index COLON index COLON index */
 
2085
   case 16:
 
2086
      if (strcmp(pvt[-4], pvt[-2]) != 0) colon = TRUE;
 
2087
      sprintf(msg, "%s:%s:%s", pvt[-4], pvt[-2], pvt[-0]);
 
2088
      SFREE(pvt[-4]);
 
2089
      SFREE(pvt[-2]);
 
2090
      SFREE(pvt[-0]);
 
2091
      FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:COLON:COLON");
 
2092
      break;
 
2093
 
 
2094
      /* index : INTEGER */
 
2095
   case 17:
 
2096
      sprintf(msg, "%ld", num_val);
 
2097
      FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:INTEGER");
 
2098
      break;
 
2099
 
 
2100
      /*       | variable_expression */
 
2101
   case 18:
 
2102
      sprintf(msg, "%ld", _PD_do_digress(pvt[-0]));
 
2103
      FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:VARIABLE_EXPRESSION");
 
2104
      break;
 
2105
 
 
2106
      /* primary_expression : IDENTIFIER */
 
2107
   case 19:
 
2108
      if (colon)
 
2109
         lite_PD_error("HYPERINDEX ON NON-TERMINAL NODE - _PD_DISP_RULES",
 
2110
                       PD_TRACE);
 
2111
      FRAME(val) = text;
 
2112
      break;
 
2113
   }
 
2114
}