2
Copyright (c) 1994 - 2010, Lawrence Livermore National Security, LLC.
6
This file is part of Silo. For details, see silo.llnl.gov.
8
Redistribution and use in source and binary forms, with or without
9
modification, are permitted provided that the following conditions
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
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.
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.
35
This work was produced at Lawrence Livermore National Laboratory under
36
Contract No. DE-AC52-07NA27344 with the DOE.
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.
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.
55
* PDPATH.C - grammar driven parser for variable specifications
58
* Software Release #92-0043
61
#include "config.h" /* For a possible redefinition of setjmp/longjmp */
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
91
#define MAXPARSEDEPTH 150
93
#define STATEFLAG -1000
103
#define OPEN_PAREN 257
104
#define CLOSE_PAREN 258
108
#define IDENTIFIER 262
114
FRAME(lex_bf)[FRAME(index)++]
117
(FRAME(index) = (--FRAME(index) < 0) ? 0 : FRAME(index), \
118
FRAME(lex_bf)[FRAME(index)] = c)
120
#define GOT_TOKEN(tok) \
121
{if (FRAME(index) == start+1) \
125
return(_PD_next_token(start));};}
127
#define FRAME(x) frames[frame_n].x
128
#define CURRENT(x) FRAME(stack)[FRAME(n)].x
130
typedef struct s_locator locator;
131
typedef struct s_parse_frame parse_frame;
134
char intype[MAXLINE];
146
struct s_parse_frame {
147
locator *stack; /* locator stack */
148
long n; /* current top of stack */
149
long nx; /* allocated size of stack */
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 */
168
static parse_frame *frames = NULL;
171
static PDBfile *file_s;
173
static char text[MAXLINE];
174
static char msg[MAXLINE];
176
static char outtype[MAXLINE];
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*,
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,
203
/*-------------------------------------------------------------------------
204
* Function: _lite_PD_effective_ep
206
* Purpose: Look up the symbol table entry for the named quantity.
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.
218
* Programmer: Adapted from PACT PDB
219
* Mar 4, 1996 1:03 PM EST
222
* Eric Brugger, Mon Dec 8 17:26:38 PST 1998
223
* I eliminated some memory leaks.
225
*-------------------------------------------------------------------------
228
_lite_PD_effective_ep (PDBfile *file, char *name, int flag, char *fullname) {
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
242
ep = lite_PD_inquire_entry(file, name, flag, fullname);
243
if (ep != NULL) return(lite_PD_copy_syment(ep));
245
alloc_frames = FALSE;
246
if (frames == NULL) {
250
frames = FMAKE_N(parse_frame, frame_nx, "_PD_EFFECTIVE_EP:frames");
255
FRAME(lex_bf) = lite_SC_strsavef(name, "char*:_PD_EFFECTIVE_EP:lex_bf");
259
if (FRAME(stack) == NULL) {
261
FRAME(stack) = FMAKE_N(locator, 10, "_PD_EFFECTIVE_EP:loc_stack");
264
switch (setjmp(_lite_PD_trace_err)) {
266
if ((fullname != NULL) && flag) strcpy(fullname, name);
267
if (alloc_frames) _PD_rl_frames();
271
if (alloc_frames) _PD_rl_frames();
275
memset(lite_PD_err, 0, MAXLINE);
280
* Copy these arguments into global (file static) variables.
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);
296
ep = _lite_PD_mk_syment(type, numb, addr, &indr, dims);
299
SFREE(PD_entry_blocks(ep));
300
PD_entry_blocks(ep) = sp;
307
if (fullname != NULL) strcpy(fullname, FRAME(path));
308
if (alloc_frames) _PD_rl_frames();
314
/*-------------------------------------------------------------------------
315
* Function: _PD_rl_frames
317
* Purpose: Free the set parse frames.
321
* Programmer: Adapted from PACT PDB
322
* Mar 5, 1996 3:20 PM EST
326
*-------------------------------------------------------------------------
329
_PD_rl_frames (void) {
332
SFREE(FRAME(lex_bf));
337
/*-------------------------------------------------------------------------
338
* Function: _PD_shift
340
* Purpose: Perform a shift operation.
344
* Programmer: Adapted from PACT PDB
345
* Mar 6, 1996 11:21 AM EST
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
352
*-------------------------------------------------------------------------
356
_PD_shift (char *name, char *type, dimdes *dims, symblock *blocks,
357
long numb, long addr, int indr, int cmmnd) {
360
lite_PD_error("NO TYPE SPECIFIED - _PD_SHIFT", PD_TRACE);
362
if (frames == NULL) {
365
frames = FMAKE_N(parse_frame, frame_nx, "_PD_EFFECTIVE_EP:frames");
369
if (FRAME(n) >= FRAME(nx)) {
371
REMAKE_N(FRAME(stack), locator, FRAME(nx));
374
memset(FRAME(stack)+FRAME(n), 0, sizeof(locator));
376
strcpy(CURRENT(intype), type);
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;
385
lite_SC_mark(dims, 1);
386
lite_SC_mark(blocks, 1);
390
/*-------------------------------------------------------------------------
391
* Function: _PD_reduce
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.
401
* Return: Success: See above
405
* Programmer: Adapted from PACT PDB
406
* Mar 5, 1996 3:05 PM EST
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.
413
*-------------------------------------------------------------------------
418
int i, nmn, nmx, cmnd;
419
long addr, val, numb;
428
type = CURRENT(intype);
429
numb = CURRENT(number);
430
dims = CURRENT(dims);
431
lite_SC_mark(dims, 1);
434
* Find the most recent GOTO commmand.
436
for (i = nmx; i > 0; i--) {
437
cmnd = FRAME(stack)[i].cmmnd;
438
if (cmnd == GOTO_C) break;
445
iloc.n_ind_type = 0L;
449
* Find the actual address of the specified object.
451
if (file_s->virtual_internal) {
452
addr = FRAME(stack)[nmx].ad.diskaddr;
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;
467
SFREE(FRAME(stack)[i-1].dims);
468
SFREE(FRAME(stack)[i-1].blocks);
473
* This must be taken now because the address reduction may have
474
* changed the original.
476
sp = CURRENT(blocks);
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.
488
lite_PD_error("INTERMEDIATE MUST BE SCALAR INTEGER - _PD_REDUCE",
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);
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
506
strcpy(CURRENT(intype), type);
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;
520
/*-------------------------------------------------------------------------
521
* Function: _PD_do_goto
523
* Purpose: Carry out a goto command. This should be starting out
524
* with something which is in the symbol table (it is an
529
* Programmer: Adapted from PACT PDB
530
* Mar 6, 1996 10:50 AM EST
534
*-------------------------------------------------------------------------
537
_PD_do_goto (char *name) {
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);
551
* Shift the starting point information onto the locator stack.
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);
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;
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.
568
indr = (dims == NULL);
570
_PD_shift(name, type, dims, sp, numb, addr, indr, GOTO_C);
574
/*-------------------------------------------------------------------------
575
* Function: _PD_do_member
577
* Purpose: Carry out a member command.
581
* Programmer: Adapted from PACT PDB
582
* Mar 6, 1996 10:55 AM EST
586
*-------------------------------------------------------------------------
589
_PD_do_member (char *name, int deref_flag) {
591
char *type, t[MAXLINE];
593
long addr, numb, nsitems;
599
if (file_s->virtual_internal) tab = file_s->host_chart;
600
else tab = file_s->chart;
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.
609
sprintf(t, "%s->%s", FRAME(path), name);
611
sprintf(t, "%s.%s", FRAME(path), name);
614
strcpy(FRAME(path), t);
617
* NOTE: we had better be properly dereferenced at this point!!!!!!!
618
* DO NOT IMAGINE THAT ANYTHING DIFFERENT CAN BE DONE!!!!!!
620
type = CURRENT(intype);
621
if (_lite_PD_indirection(type))
622
lite_PD_error("IMPROPERLY DEREFERENCED EXPRESSION - _PD_DO_MEMBER",
626
* Find the defstr whose members are to be searched.
628
dp = PD_inquire_table_type(tab, type);
629
if (dp == NULL) lite_PD_error("UNKNOWN TYPE - _PD_DO_MEMBER", PD_TRACE);
632
* Loop over the members accumulating offset to the new address
633
* and the number of indirect members which will have to
638
for (desc = dp->members; desc != NULL; desc = nxt) {
640
if (_PD_is_member(name, desc, tab, &nsitems)) {
641
type = _PD_get_type_member(file_s, FRAME(path), name, desc, &dp);
643
addr = desc->member_offs;
644
dims = desc->dimensions;
645
numb = _lite_PD_comp_num(dims);
646
indr = _lite_PD_indirection(type);
648
if (file_s->virtual_internal) {
651
ad = FRAME(stack)[FRAME(n)].ad;
652
addr = ad.diskaddr + desc->member_offs;
656
* Shift the member onto the locator stack.
658
_PD_shift(name, type, dims, NULL,
659
numb, addr, indr, MEMBER_C);
660
CURRENT(n_struct_ptr) = nsitems;
666
lite_PD_error("UNKNOWN MEMBER - _PD_DO_MEMBER", PD_TRACE);
670
/*-------------------------------------------------------------------------
671
* Function: _PD_do_deref
673
* Purpose: Carry out a deref command.
677
* Programmer: Adapted from PACT PDB
678
* Mar 6, 1996 10:47 AM EST
682
*-------------------------------------------------------------------------
685
_PD_do_deref (void) {
690
strcpy(t, CURRENT(intype));
692
if (file_s->virtual_internal) {
695
ad = FRAME(stack)[FRAME(n)].ad;
696
ad.memaddr = *(char **) ad.memaddr;
703
_PD_shift("", t, NULL, NULL, -1L, addr, 0, DEREF_C);
706
* Since the shift added a new one this will dereference the current
709
lite_PD_dereference(CURRENT(intype));
713
/*-------------------------------------------------------------------------
714
* Function: _PD_do_index
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.
723
* Programmer: Adapted from PACT PDB
724
* Mar 6, 1996 10:52 AM EST
728
*-------------------------------------------------------------------------
731
_PD_do_index (char *expr) {
734
long bpi, start, stop, step, numb, doff, addr;
735
char t[MAXLINE], s[MAXLINE];
743
sprintf(t, "%s[%s]", FRAME(path), expr);
744
strcpy(FRAME(path), t);
746
dims = CURRENT(dims);
747
type = CURRENT(intype);
748
doff = PD_get_offset(file_s);
752
lite_PD_dereference(t);
753
numb = _lite_PD_hyper_number(file_s, expr, 1L, dims, &start);
755
} else if (_lite_PD_indirection(type)) {
759
* Find the offset which will be the first part of the
760
* index expression find the number of items requested.
763
tok = lite_SC_firsttok(t, ",");
766
tok = strtok(s, ":");
768
lite_PD_error("BAD INDEX EXPRESSION - _PD_DO_INDEX", PD_TRACE);
771
start = lite_SC_stoi(tok) - doff;
773
tok = strtok(NULL, ":");
774
if (tok == NULL) stop = start;
775
else stop = lite_SC_stoi(tok) - doff;
777
step = lite_SC_stoi(strtok(NULL, ":"));
778
if (step == 0L) step = 1L;
780
numb = (stop - start)/step + 1;
783
strcpy(t, CURRENT(intype));
787
lite_PD_error("CAN'T INDEX OBJECT - _PD_DO_INDEX", PD_TRACE);
790
bpi = _lite_PD_lookup_size(t, file_s->chart);
792
if (file_s->virtual_internal) {
795
ad = FRAME(stack)[FRAME(n)].ad;
804
sp = CURRENT(blocks);
806
_PD_shift(expr, t, dims, sp, numb, addr, indr, INDEX_C);
808
CURRENT(n_array_items) = start;
812
/*-------------------------------------------------------------------------
813
* Function: _PD_do_cast
815
* Purpose: Carry out a CAST command.
819
* Programmer: Adapted from PACT PDB
820
* Mar 6, 1996 10:47 AM EST
824
*-------------------------------------------------------------------------
827
_PD_do_cast (char *type) {
831
char t[MAXLINE], s[MAXLINE];
838
sprintf(t, "(%s) %s", type, FRAME(path));
839
strcpy(FRAME(path), t);
841
da = CURRENT(ad.diskaddr);
842
in = CURRENT(indirect);
844
sp = CURRENT(blocks);
847
strcpy(s, CURRENT(intype));
849
_PD_shift("", s, dm, sp, n, da, in, CAST_C);
851
strcpy(outtype, type);
855
/*-------------------------------------------------------------------------
856
* Function: _PD_do_digress
858
* Purpose: Carry out a digress command.
864
* Programmer: Adapted from PACT PDB
865
* Mar 6, 1996 10:49 AM EST
869
*-------------------------------------------------------------------------
873
_PD_do_digress (char *expr) {
880
* NOTE: this doesn't support more than one level of recursion!!
882
strcpy(t, FRAME(path));
889
strcpy(FRAME(path), t);
895
/*-------------------------------------------------------------------------
896
* Function: _PD_is_member
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.
902
* Return: Success: true or false
904
* Failure: never fails
906
* Programmer: Adapted from PACT PDB
907
* Mar 6, 1996 11:18 AM EST
911
*-------------------------------------------------------------------------
915
_PD_is_member (char *name, memdes *desc, HASHTAB *tab, long *pns) {
918
if (strcmp(desc->name, name) == 0) {
920
* If this is the member say so.
925
* Count up the number of indirects in the structure which will
928
if (_lite_PD_indirection(desc->type)) {
929
*pns += _lite_PD_member_items(desc->member);
936
/*-------------------------------------------------------------------------
937
* Function: _PD_get_type_member
939
* Purpose: Get the true type of the member. Handle any casts.
941
* Return: Success: The type.
945
* Programmer: Adapted from PACT PDB
946
* Mar 6, 1996 11:15 AM EST
950
*-------------------------------------------------------------------------
954
_PD_get_type_member (PDBfile *file, char *path_name, char *name,
955
memdes *desc, defstr **pdp) {
960
if (file->virtual_internal) tab = file->host_chart;
961
else tab = file->chart;
963
*pdp = PD_inquire_table_type(tab, desc->base_type);
965
lite_PD_error("UNDEFINED TYPE - _PD_GET_TYPE_MEMBER", PD_TRACE);
967
if (desc->cast_offs < 0L) {
970
if (file->virtual_internal) {
973
ad = FRAME(stack)[FRAME(n)].ad;
974
mtype = DEREF(ad.memaddr + desc->cast_offs);
976
if (DEREF(ad.memaddr + desc->member_offs) == NULL) {
979
lite_PD_error("NULL CAST TO NON-NULL MEMBER - "
980
"_PD_GET_TYPE_MEMBER", PD_TRACE);
989
* Build the path of the member which points to the real type.
991
strcpy(s, path_name);
992
for (i = strlen(s) - 1; i >= 0; i--) {
994
if ((c == '>') || (c == '.')) break;
997
strcat(s, desc->cast_memb);
1002
* Read the real type in.
1004
lite_PD_read(file, s, &mtype);
1005
if (mtype == NULL) mtype = desc->type;
1007
_PD_restore_stack();
1015
/*-------------------------------------------------------------------------
1016
* Function: _PD_save_stack
1018
* Purpose: Save the state of the current parse.
1022
* Programmer: Adapted from PACT PDB
1023
* Mar 6, 1996 11:31 AM EST
1027
*-------------------------------------------------------------------------
1030
_PD_save_stack (void) {
1033
if (frame_n >= frame_nx) {
1035
REMAKE_N(frames, parse_frame, frame_nx);
1038
memset(&frames[frame_n], 0, sizeof(parse_frame));
1042
/*-------------------------------------------------------------------------
1043
* Function: _PD_restore_stack
1045
* Purpose: Restore the state of the previous parse.
1049
* Programmer: Adapted from PACT PDB
1050
* Mar 6, 1996 11:31 AM EST
1054
*-------------------------------------------------------------------------
1057
_PD_restore_stack (void) {
1059
SFREE(FRAME(stack));
1060
SFREE(FRAME(lex_bf));
1065
/*-------------------------------------------------------------------------
1066
* Function: _PD_deref_addr
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.
1076
* Programmer: Adapted from PACT PDB
1077
* Mar 5, 1996 4:11 PM EST
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
1084
*-------------------------------------------------------------------------
1087
_PD_deref_addr (int n) {
1089
long addr, numb, bpi;
1096
tab = file_s->chart;
1097
type = FRAME(stack)[n-1].intype;
1098
bpi = _lite_PD_lookup_size(type, tab);
1101
* Handle the case of in memory pointers.
1103
if (file_s->virtual_internal) {
1104
addr = FRAME(stack)[n].ad.diskaddr;
1105
numb = FRAME(stack)[n].number;
1108
* Handle the case of file pointers
1112
addr = FRAME(stack)[n-1].ad.diskaddr;
1113
numb = FRAME(stack)[n-1].number;
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
1122
if (!_lite_PD_indirection(type)) addr += numb*bpi;
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",
1130
_lite_PD_rd_itag(file_s, &itag);
1135
if (!_lite_PD_indirection(FRAME(stack)[n].intype)) {
1136
sp = FMAKE(symblock, "_PD_DEREF_ADDR:sp");
1138
sp->diskaddr = addr;
1140
if ((n + 1) == FRAME(n)) {
1141
dims = _lite_PD_mk_dimensions(file_s->default_offset, numb);
1146
FRAME(stack)[n].blocks = sp;
1147
FRAME(stack)[n].dims = dims;
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);
1160
FRAME(stack)[n].number = numb;
1161
FRAME(stack)[n].ad.diskaddr = addr;
1167
/*-------------------------------------------------------------------------
1168
* Function: _PD_index_deref
1170
* Purpose: Handle indexing where a pointered type was just
1171
* dereferenced. This will mean skipping over itags and
1178
* Programmer: Adapted from PACT PDB
1179
* Mar 5, 1996 4:20 PM EST
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.
1186
*-------------------------------------------------------------------------
1189
_PD_index_deref (int n, dimdes **pdims, long *pnumb) {
1191
long indx, addr, numb, naitems, bpi;
1192
char *type, *typc, *typp;
1201
iloc.n_ind_type = 0L;
1204
if (file_s->virtual_internal) {
1206
* Handle in memory indexing.
1208
addr = FRAME(stack)[n].ad.diskaddr;
1211
* Handle file indexing.
1212
* Start at the address before the latest DEREF.
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;
1219
fp = file_s->stream;
1220
tab = file_s->chart;
1222
iloc.n_ind_type = _PD_num_indirects(type, tab);
1223
iloc.arr_offs = indx;
1226
* In order to know where to go you have to know whether the
1227
* next thing on the locator stack dereferences a pointer
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);
1236
* Handle GOTO, DEREF, INDEX.
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",
1245
* Skip over the thing that was DEREF'd to where its
1248
addr = _lite_PD_skip_over(file_s, 1L, TRUE);
1251
* Skip over all items before the indexed one.
1253
numb = _PD_num_indirects(type, tab);
1254
naitems = indx*MAX(1, numb);
1255
addr = _lite_PD_skip_over(file_s, naitems, FALSE);
1259
* Handle GOTO, INDEX.
1261
addr = FRAME(stack)[n-1].ad.diskaddr;
1263
if (!_lite_PD_indirection(typp)) {
1264
bpi = _lite_PD_lookup_size(typp, tab);
1266
if (io_seek(fp, addr, SEEK_SET))
1267
lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_INDEX_DEREF",
1271
* Skip over all items before the indexed one.
1273
numb = _PD_num_indirects(typp, tab);
1274
naitems = indx*MAX(1, numb);
1275
addr = _lite_PD_skip_over(file_s, naitems, FALSE);
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
1285
* Be sure that we are at the first ITAG.
1287
if (io_seek(fp, addr, SEEK_SET))
1288
lite_PD_error("FSEEK FAILED - _PD_INDEX_DEREF",
1294
* Skip over to the indexed element.
1296
numb = _PD_num_indirects(typp, tab);
1297
naitems = indx*MAX(1, numb);
1298
addr = _lite_PD_skip_over(file_s, naitems, FALSE);
1300
_lite_PD_rd_itag(file_s, &itag);
1302
if (io_seek(fp, addr, SEEK_SET))
1303
lite_PD_error("FSEEK FAILED - _PD_INDEX_DEREF",
1305
_lite_PD_rd_itag(file_s, &itag);
1310
FRAME(stack)[n].number = numb;
1313
* After doing one index the next thing has to be contiguous.
1315
SFREE(FRAME(stack)[n+1].blocks);
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
1332
if (*pdims == NULL) {
1333
*pdims = FRAME(stack)[n].dims;
1334
lite_SC_mark(FRAME(stack)[n].dims, 1);
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;
1342
sp = FRAME(stack)[n].blocks;
1343
numb = FRAME(stack)[n].ad.diskaddr;
1344
bpi = _lite_PD_lookup_size(type, tab);
1346
nbl = FRAME(stack)[n-1].number;
1347
iloc.addr = addr + nbl*bpi;
1350
* Deal with multiblock entries.
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
1358
if ((sp != NULL) && (addr >= 0)) {
1359
nbl = lite_SC_arrlen(sp)/sizeof(symblock);
1362
* Find out which block we got into.
1365
nbb = sp->number*bpi;
1366
addr = sp->diskaddr;
1367
if (numb < nbb) break;
1374
iloc.addr = addr + nbb;
1377
* Make a copy of the remaining blocks for the effective entry.
1382
nsp = FMAKE_N(symblock, nbl, "_PD_INDEX_DEREF:nsp");
1383
for (i = 0; i < nbl; i++) nsp[i] = *sp++;
1387
* Adjust the first block to be consistent with the rest
1390
nsp[0].number -= numb/bpi;
1391
nsp[0].diskaddr = addr + numb;
1397
dp = PD_inquire_table_type(tab, type);
1398
addr -= (numb/bpi)*dp->size_bits;
1400
*pnumb = FRAME(stack)[n].number;
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;
1415
/*-------------------------------------------------------------------------
1416
* Function: _PD_member_deref
1418
* Purpose: Find the member where a pointered type was just
1419
* dereferenced. This will mean skipping over itags and
1426
* Programmer: Adapted from PACT PDB
1427
* Mar 5, 1996 4:38 PM EST
1431
*-------------------------------------------------------------------------
1434
_PD_member_deref (int n) {
1440
* Handle in memory members.
1442
if (file_s->virtual_internal) {
1443
addr = FRAME(stack)[n].ad.diskaddr;
1446
* Handle file members.
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);
1461
if (io_seek(file_s->stream, addr, SEEK_SET))
1462
lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_MEMBER_DEREF",
1465
} else if ((cmmnd != INDEX_C) && indir) {
1466
addr = FRAME(stack)[n-2].ad.diskaddr;
1468
if (io_seek(file_s->stream, addr, SEEK_SET))
1469
lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_MEMBER_DEREF",
1473
* Skip over the thing that was DEREF'd to where its pointees begin.
1475
addr = _lite_PD_skip_over(file_s, 1L, TRUE);
1479
* Start at the address in the previous locator.
1481
addr = FRAME(stack)[n-1].ad.diskaddr;
1485
* Handle indirect types differently from direct ones.
1487
type = FRAME(stack)[n].intype;
1488
if (_lite_PD_indirection(type)) {
1489
nsitems = FRAME(stack)[n].n_struct_ptr;
1491
if (io_seek(file_s->stream, addr, SEEK_SET))
1492
lite_PD_error("FSEEK FAILED TO FIND DATA - _PD_MEMBER_DEREF",
1496
* Skip over all items before the specified member.
1498
addr = _lite_PD_skip_over(file_s, nsitems, FALSE);
1502
* Handle direct types simply.
1504
addr += FRAME(stack)[n].ad.diskaddr;
1508
FRAME(stack)[n].ad.diskaddr = addr;
1514
/*-------------------------------------------------------------------------
1515
* Function: _lite_PD_skip_over
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.
1525
* Programmer: Adapted from PACT PDB
1526
* Mar 5, 1996 4:56 PM EST
1529
* Brad Whitlock, Wed Feb 23 19:01:08 PST 2000
1530
* Added code to skip some logic when an itag cannot be read.
1532
*-------------------------------------------------------------------------
1535
_lite_PD_skip_over (PDBfile *file, long skip, int noind) {
1537
long bytepitem, addr;
1548
if(TRUE == _lite_PD_rd_itag(file, &itag))
1551
* Note whether this is an indirection.
1553
indir = _lite_PD_indirection(itag.type);
1556
* If noind is TRUE don't pick up the indirects.
1561
* If it is an indirection we have more to skip over.
1563
if (indir) skip += itag.nitems;
1566
* If it is a structure with indirections we have more to
1569
skip += itag.nitems*_PD_num_indirects(itag.type, tab);
1573
* If it was not a NULL pointer find it.
1575
if ((itag.addr != -1L) && (itag.nitems != 0L))
1577
if (!itag.flag && (skip == -1))
1579
if (io_seek(fp, itag.addr, SEEK_SET))
1580
lite_PD_error("CAN'T FIND REAL DATA - _PD_SKIP_OVER",
1582
_lite_PD_rd_itag(file, &itag);
1586
* Layered indirects have no "data" bytes written out to be
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",
1602
* If its here, step over the data.
1604
if (itag.flag && (skip > -1))
1606
addr = bytepitem*itag.nitems;
1608
if (io_seek(fp, addr, SEEK_CUR))
1609
lite_PD_error("CAN'T SKIP TO ADDRESS - _PD_SKIP_OVER",
1613
} /* end if (_lite_PD_rd_itag(...) == TRUE). */
1622
/*-------------------------------------------------------------------------
1623
* Function: _PD_num_indirects
1625
* Purpose: Count up the number of members of the given structure
1626
* with indirect references.
1628
* Return: Success: Number of indirect references.
1630
* Failure: lite_PD_error()
1632
* Programmer: Adapted from PACT PDB
1633
* Mar 6, 1996 11:06 AM EST
1637
*-------------------------------------------------------------------------
1640
_PD_num_indirects (char *type, HASHTAB *tab) {
1645
mtype = _lite_PD_member_base_type(type);
1646
dp = PD_inquire_table_type(tab, mtype);
1650
lite_PD_error("CAN'T FIND TYPE - _PD_NUM_INDIRECTS", PD_TRACE);
1653
return(dp->n_indirects);
1656
/*--------------------------------------------------------------------------*/
1657
/* LEXICAL SCANNER ROUTINES */
1658
/*--------------------------------------------------------------------------*/
1661
/*-------------------------------------------------------------------------
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:
1670
* CLOSE_PAREN ) or ]
1676
* INTEGER octal, decimal, or hexidecimal integer
1677
* IDENTIFIER just about anything else (no white space)
1679
* Return: Success: The value of the lexical token.
1681
* Failure: 0 if at the end of the input string.
1683
* Programmer: Adapted from PACT PDB
1684
* Mar 5, 1996 4:27 PM EST
1688
*-------------------------------------------------------------------------
1695
start = FRAME(index);
1700
if (FRAME(index) == start+1) {
1705
return(_PD_next_token(start));
1710
GOT_TOKEN(OPEN_PAREN);
1714
GOT_TOKEN(CLOSE_PAREN);
1731
if (FRAME(index) == start+2) {
1736
return(_PD_next_token(start));
1747
/*-------------------------------------------------------------------------
1748
* Function: _PD_next_token
1750
* Purpose: Figure out whether the specified token is an identifier
1751
* or an integer and take the apropriate action.
1757
* Programmer: Adapted from PACT PDB
1758
* Mar 6, 1996 11:04 AM EST
1762
*-------------------------------------------------------------------------
1765
_PD_next_token (int start) {
1768
char *end, s[MAXLINE], *tok;
1770
nc = FRAME(index) - start;
1771
strncpy(s, FRAME(lex_bf)+start, nc);
1775
* Eliminate whitespace from either end of the token.
1776
* NOTE: things like "a b" are illegal anyway.
1778
tok = strtok(s, " \t\f\n\r");
1781
num_val = _lite_SC_strtol(text, &end, 0);
1782
tok = text + strlen(text);
1783
if (tok == end) return(INTEGER);
1784
else return(IDENTIFIER);
1788
/*-------------------------------------------------------------------------
1789
* Function: _PD_parse
1791
* Purpose: Parse an expression which is in the lexical buffer of the
1792
* current parse frame.
1794
* Return: Success: TRUE
1798
* Programmer: Adapted from PACT PDB
1799
* Mar 5, 1996 2:19 PM EST
1803
*-------------------------------------------------------------------------
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 */
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,
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};
1839
static int negative_one = -1;
1842
* Initialize externals - _PD_parse may be called more than once.
1844
FRAME(pv) = &FRAME(v)[negative_one];
1845
FRAME(ps) = &FRAME(s)[negative_one];
1851
FRAME(current_token) = -1;
1855
lstate = FRAME(state);
1860
* loop as expressions are pushed onto the stack.
1864
* Put a state and value onto the stacks.
1866
if (++lps >= &FRAME(s)[MAXPARSEDEPTH])
1867
lite_PD_error("STACK OVERFLOW - _PD_PARSE", PD_TRACE);
1870
*++lpv = FRAME(val);
1873
* We have a new state - find out what to do.
1876
if (n > STATEFLAG) {
1877
if ((FRAME(current_token) < 0) &&
1878
((FRAME(current_token) = _PD_lex()) < 0))
1879
FRAME(current_token) = 0;
1884
n += FRAME(current_token);
1885
if ((n >= 0) && (n < LASTTOK)) {
1887
if (chk[n] == FRAME(current_token)) {
1888
FRAME(current_token) = -1;
1889
FRAME(val) = FRAME(lval);
1892
if (FRAME(error) > 0) FRAME(error)--;
1902
if ((FRAME(current_token) < 0) &&
1903
((FRAME(current_token) = _PD_lex()) < 0))
1904
FRAME(current_token) = 0;
1907
* Look through exception table.
1911
while ((*xi != -1) || (xi[1] != lstate)) {
1915
while ((*(xi += 2) >= 0) && (*xi != FRAME(current_token))) /*void*/ ;
1922
* Check for syntax error.
1925
if (FRAME(error) > 0)
1926
lite_PD_error("SYNTAX ERROR - _PD_PARSE", PD_TRACE);
1930
* Reduction by production n.
1932
FRAME(tmp) = n; /* value to switch over */
1933
pvt = lpv; /* top of value stack */
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.
1945
FRAME(val) = lpv[1];
1949
lstate = pgo[n] + *lps + 1;
1950
if ((lstate >= LASTTOK) ||
1951
(chk[lstate = act[lstate]] != -n)) {
1952
lstate = act[pgo[n]];
1960
FRAME(val) = lpv[1];
1964
lstate = pgo[n] + *lps + 1;
1966
if ((lstate >= LASTTOK) ||
1967
(chk[lstate = act[lstate]] != -n)) {
1968
lstate = act[pgo[n]];
1972
* Save until reenter driver code.
1974
FRAME(state) = lstate;
1978
_PD_disp_rules(FRAME(tmp), pvt);
1982
lstate = FRAME(state);
1987
/*-------------------------------------------------------------------------
1988
* Function: _PD_disp_rules
1990
* Purpose: Dispatch on the specified rule.
1994
* Programmer: Adapted from PACT PDB
1995
* Mar 5, 1996 4:14 PM EST
1999
*-------------------------------------------------------------------------
2002
_PD_disp_rules (int rule, char **pvt) {
2006
/* variable_expression :
2008
* | OPEN_PAREN type CLOSE_PAREN variable_expression
2011
_PD_do_cast(pvt[-2]);
2027
sprintf(msg, "%s *", pvt[-1]);
2031
/* unary_expression :
2032
* postfix_expression
2033
* | STAR variable_expression
2039
/* postfix_expression :
2040
* primary_expression
2043
_PD_do_goto(pvt[-0]);
2046
/* | postfix_expression OPEN_PAREN index_expression CLOSE_PAREN */
2048
_PD_do_index(pvt[-1]);
2052
/* | postfix_expression DOT primary_expression */
2054
_PD_do_member(pvt[-0], FALSE);
2057
/* | postfix_expression ARROW primary_expression */
2059
_PD_do_member(pvt[-0], TRUE);
2062
/* index_expression :
2064
* | index_expression COMMA range
2067
sprintf(msg, "%s,%s", pvt[-2], pvt[-0]);
2070
FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:COMMA");
2074
* | index COLON index
2077
if (strcmp(pvt[-2], pvt[-0]) != 0) colon = TRUE;
2078
sprintf(msg, "%s:%s", pvt[-2], pvt[-0]);
2081
FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:COLON");
2084
/* | index COLON index COLON index */
2086
if (strcmp(pvt[-4], pvt[-2]) != 0) colon = TRUE;
2087
sprintf(msg, "%s:%s:%s", pvt[-4], pvt[-2], pvt[-0]);
2091
FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:COLON:COLON");
2094
/* index : INTEGER */
2096
sprintf(msg, "%ld", num_val);
2097
FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:INTEGER");
2100
/* | variable_expression */
2102
sprintf(msg, "%ld", _PD_do_digress(pvt[-0]));
2103
FRAME(val) = lite_SC_strsavef(msg, "char*:PARSE:VARIABLE_EXPRESSION");
2106
/* primary_expression : IDENTIFIER */
2109
lite_PD_error("HYPERINDEX ON NON-TERMINAL NODE - _PD_DISP_RULES",