syment *
lite_PD_defent (PDBfile *file, char *name, char *outtype, long number,
dimdes *dims) {
long addr, bytespitem;
defstr *dp;
syment *ep;
char bf[MAXLINE], *lname;
ep = NULL;
switch (setjmp(_lite_PD_write_err)) {
case ABORT:
return(NULL);
case ERR_FREE:
return ep;
default:
memset(lite_PD_err, 0, MAXLINE);
break;
}
/*
* If there are pointers involved it is an error.
*/
dp = PD_inquire_type(file, outtype);
if (dp == NULL)
lite_PD_error("UNKNOWN FILE TYPE - _PD_DEFENT", PD_WRITE);
if (dp->n_indirects) {
lite_PD_error("CAN'T DEFINE ENTRY WITH INDIRECTS - _PD_DEFENT",
PD_WRITE);
}
ep = lite_PD_inquire_entry (file, name, FALSE, NULL);
if (ep == NULL) {
/*
* If this is a new entry.
*/
addr = file->chrtaddr;
ep = _lite_PD_mk_syment (outtype, number, addr, NULL, dims);
strcpy(bf, _lite_PD_fixname(file, name));
lname = lite_SC_firsttok(bf, ".([ ");
_lite_PD_e_install(lname, ep, file->symtab);
bytespitem = _lite_PD_lookup_size(outtype, file->chart);
ep = _lite_PD_extend_file(file, number*bytespitem) ? ep : NULL;
} else {
/*
* If this is only a new block.
*/
ep = _lite_PD_add_block(file, ep, dims) ? ep : NULL;
}
return ep;
}
/*-------------------------------------------------------------------------
* Function: lite_PD_cd
*
* Purpose: Change the current working directory. The directory
* may be specified by an absolute or relative path.
*
* Return: Success: TRUE
*
* Failure: FALSE
*
* Programmer: Adapted from PACT PDB
* Mar 4, 1996 11:41 AM EST
*
* Modifications:
*
*-------------------------------------------------------------------------
*/
int
lite_PD_cd (PDBfile *file, char *dirname) {
char name[MAXLINE];
syment *ep;
lite_PD_err[0] = '\0';
if (file == NULL) {
sprintf(lite_PD_err, "ERROR: BAD FILE ID - PD_CD\n");
return(FALSE);
}
if (dirname == NULL) {
strcpy(name, "/");
} else {
strcpy(name, _lite_PD_fixname(file, dirname));
if (name[strlen(name) - 1] != '/') strcat(name, "/");
}
ep = lite_PD_inquire_entry(file, name, FALSE, NULL);
if (ep == NULL) {
if (dirname == NULL) {
return(FALSE);
} else {
if (strcmp(name, "/") != 0) {
name[strlen(name) - 1] = '\0';
ep = lite_PD_inquire_entry(file, name, FALSE, NULL);
strcat(name, "/");
}
if (ep == NULL) {
sprintf(lite_PD_err, "ERROR: DIRECTORY %s NOT FOUND - PD_CD\n",
dirname);
return(FALSE);
}
}
}
if (strcmp(ep->type, "Directory") != 0) {
sprintf(lite_PD_err, "ERROR: BAD DIRECTORY %s - PD_CD\n", dirname);
return(FALSE);
} else {
if (file->current_prefix) SFREE(file->current_prefix);
file->current_prefix = lite_SC_strsavef(name, "char*:PD_CD:name");
}
return(TRUE);
}
int
lite_PD_write_as (PDBfile *file, char *name, char *intype, char *outtype,
lite_SC_byte *vr) {
syment *ep;
dimdes *dims;
char *lname, fullpath[MAXLINE];
strcpy(fullpath, _lite_PD_fixname(file, name));
lname = lite_SC_firsttok(fullpath, ".");
dims = _lite_PD_ex_dims(lname, file->default_offset, FALSE);
ep = _PD_write(file, name, intype, outtype, vr, dims, _append_flag);
if (ep != NULL) {
_lite_PD_rl_syment_d(ep);
return(TRUE);
} else {
return(FALSE);
}
}
/*-------------------------------------------------------------------------
* Function: lite_PD_get_attribute
*
* Purpose: Get the value of the specified attribute for the specified
* variable.
*
* Return: Success: Ptr to the attribute value
*
* Failure: NULL
*
* Programmer: Adapted from PACT PDB
* Mar 4, 1996 11:38 AM EST
*
* Modifications:
*
*-------------------------------------------------------------------------
*/
byte *
lite_PD_get_attribute (PDBfile *file, char *vr, char *at) {
byte *vl, **data;
attribute *attr;
attribute_value *avl;
char fullname[MAXLINE];
attr = PD_INQUIRE_ATTRIBUTE(at);
if (attr == NULL) {
sprintf(lite_PD_err, "ATTRIBUTE %s DOESN'T EXIST - PD_GET_ATTR", at);
return(NULL);
}
strcpy(fullname, _lite_PD_fixname(file, vr));
avl = PD_INQUIRE_ATTRIBUTE_VALUE(fullname);
if (avl == NULL) {
sprintf(lite_PD_err, "VARIABLE %s HAS NO ATTRIBUTES - PD_GET_ATTR",
fullname);
return(NULL);
}
data = attr->data;
if (data == NULL) {
sprintf(lite_PD_err, "ATTRIBUTE DATA %s DOESN'T EXIST - PD_GET_ATTR",
at);
return(NULL);
}
for (/*void*/; avl != NULL; avl = avl->next) {
if (strcmp(at, avl->attr->name) == 0) break;
}
if (avl == NULL) {
sprintf(lite_PD_err, "VARIABLE %s DOESN'T HAVE ATTRIBUTE %s - "
"PD_GET_ATTR", vr, at);
return(NULL);
}
vl = data[avl->indx];
return(vl);
}
static syment *
_PD_write (PDBfile *file, char *name, char *intype, char *outtype,
lite_SC_byte *vr, dimdes *dims, int appnd) {
int reset;
syment *ep;
long number, addr;
char bf[MAXLINE], fullpath[MAXLINE], *lname;
_append_flag = FALSE;
ep = NULL;
switch (setjmp(_lite_PD_write_err)) {
case ABORT : return(NULL);
case ERR_FREE : return(ep);
default : memset(lite_PD_err, 0, MAXLINE);
break;
}
if (file->mode == PD_OPEN) {
lite_PD_error("FILE OPENED IN READ-ONLY MODE - _PD_WRITE", PD_WRITE);
}
strcpy(fullpath, _lite_PD_fixname(file, name));
/*
* Append a new block to an existing entry if TRUE.
*/
if (appnd) {
strcpy(bf, fullpath);
/*
* Do this so that things such as a[20:20].b work properly
* NOTE: this also implies that a[20:20].b.c works while
* a.b[20:20].c doesn't
* for now this defines the semantics of append (10/6/93)
*/
lname = lite_SC_firsttok(bf, ".()[]");
ep = lite_PD_inquire_entry(file, lname, FALSE, NULL);
if (ep == NULL) {
lite_PD_error("CAN'T APPEND TO NON-EXISTING ENTRY - _PD_WRITE",
PD_WRITE);
}
_lite_PD_adj_dimensions(file, fullpath, ep);
/*
* Extend the syment.
*/
_lite_PD_add_block(file, ep, dims);
}
addr = file->chrtaddr;
ep = _lite_PD_effective_ep(file, fullpath, FALSE, NULL);
if (ep != NULL) {
/*
* If the variable already exists use the existing file info.
*/
addr = PD_entry_address(ep);
_lite_PD_rl_dimensions(dims);
lname = fullpath;
reset = FALSE;
} else {
/*
* If the variable doesn't exist define it to the file.
*/
number = _lite_PD_comp_num(dims);
ep = _lite_PD_mk_syment(outtype, number, addr, NULL, dims);
strcpy(bf, fullpath);
lname = lite_SC_firsttok(bf, ".([ ");
_lite_PD_e_install(lname, ep, file->symtab);
reset = TRUE;
}
if (file->virtual_internal) {
SC_address ad;
ad.memaddr = vr;
ep->blocks->diskaddr = ad.diskaddr;
lite_SC_mark(vr, 1);
ep = lite_PD_copy_syment(ep);
} else {
if (outtype == NULL) outtype = PD_entry_type(ep);
if (intype == NULL) intype = outtype;
/*
* Go to the correct address.
*/
if (io_seek(file->stream, addr, SEEK_SET)) {
lite_PD_error("FSEEK FAILED TO FIND CURRENT ADDRESS - _PD_WRITE",
PD_WRITE);
}
/*
* Do the low level write.
*/
if (!_lite_PD_hyper_write(file, lname, ep, vr, intype)) {
lite_PD_error("CAN'T WRITE VARIABLE - _PD_WRITE", PD_WRITE);
}
/*
* If the variable didn't previously exist we're at the end
* of the file.
*/
if (reset) {
file->chrtaddr = io_tell(file->stream);
if (file->chrtaddr == -1L) {
lite_PD_error("CAN'T FIND ADDRESS OF NEXT VARIABLE - _PD_WRITE",
PD_WRITE);
}
/*
* Make a releasable copy of the entry
* SX depends on this critically!!
*/
ep = lite_PD_copy_syment(ep);
}
}
return(ep);
}
/*-------------------------------------------------------------------------
* Function: lite_PD_open
*
* Purpose: Open an existing PDB file, extract the symbol table and
* structure chart.
*
* Return: Success: Ptr to the PDB file structure
*
* Failure: NULL
*
* Programmer: Adapted from the PACT PDB library
* Mar 4, 1996 10:26 AM EST
*
* Modifications:
*
* Robb Matzke, 4 Mar 1996
* Fixed indentation. Files can only be opened with mode `r'.
*
* Robb Matzke, 17 Apr 1996
* Added write capability back into the function, but it is protected
* with #ifdef PDB_WRITE.
*
* Mark C. Miller, Fri Apr 13 22:37:56 PDT 2012
* Changed mode string checks to strchr to accomodate wider variety
* of mode characters for new hash table size and open modes.
*
* Mark C. Miller, Thu Jun 14 13:25:02 PDT 2012
* Remove call to io_close in ABORT case. The file pointer may not
* have been properly initialized.
*-------------------------------------------------------------------------
*/
PDBfile *
lite_PD_open (char *name, char *mode) {
char str[MAXLINE], *token;
PDBfile *file=NULL;
static FILE *fp;
syment *ep;
#ifdef PDB_WRITE
/*
* If opened in write mode use PD_CREATE instead.
*/
if (strchr(mode,'w')) return lite_PD_create (name);
#else
assert (!strchr(mode,'r')) ;
#endif
switch (setjmp(_lite_PD_open_err)) {
case ABORT:
if (fp) io_close(fp);
return(NULL);
case ERR_FREE:
return(file);
default:
memset(lite_PD_err, 0, MAXLINE);
break;
}
/*
* Open the file
*/
strcpy(str, name);
#ifdef PDB_WRITE
fp = io_open(str, BINARY_MODE_RPLUS);
if (fp == NULL) {
if (strchr(mode,'r')) {
#endif
fp = io_open(str, BINARY_MODE_R);
if (fp == NULL) {
lite_PD_error("CAN'T OPEN FILE IN READ-ONLY MODE - PD_OPEN",
PD_OPEN);
}
#ifdef PDB_WRITE
} else if (strchr(mode,'a')) {
return lite_PD_create (name);
} else {
lite_PD_error("CAN'T OPEN FILE - PD_OPEN", PD_OPEN);
}
}
#endif
if (lite_PD_buffer_size != -1) {
if (io_setvbuf(fp, NULL, _IOFBF, (size_t) lite_PD_buffer_size)) {
lite_PD_error("CAN'T SET FILE BUFFER - PD_OPEN", PD_OPEN);
}
}
file = _lite_PD_mk_pdb(str, mode);
if (file == NULL) {
lite_PD_error("CAN'T ALLOCATE PDBFILE - PD_OPEN", PD_OPEN);
}
file->stream = fp;
#ifdef PDB_WRITE
if (strchr(mode,'a')) file->mode = PD_APPEND;
else file->mode = PD_OPEN;
#else
file->mode = PD_OPEN ;
#endif
/*
* Attempt to read an ASCII header.
*/
if (io_seek(fp, 0L, SEEK_SET)) {
_lite_PD_rl_pdb(file);
lite_PD_error("FSEEK FAILED TO FIND ORIGIN - PD_OPEN", PD_OPEN);
}
if (_lite_PD_rfgets(str, MAXLINE, fp) == NULL) {
_lite_PD_rl_pdb(file);
lite_PD_error("CAN'T READ THE FILE HEADER - PD_OPEN", PD_OPEN);
}
/*
* The first token should be the identifying header token.
*/
token = strtok(str, " ");
if (token == NULL) {
_lite_PD_rl_pdb(file);
lite_PD_error("FILE HEADER NOT ASCII - PD_OPEN", PD_OPEN);
}
if (strcmp(token, HeadTok) == 0) {
/*
* This is a PDB_SYSTEM_VERSION 2 or later file.
* Read the primitive data type formats which set the standard.
*/
if (!_lite_PD_rd_format(file)) {
_lite_PD_rl_pdb(file);
lite_PD_error("FAILED TO READ FORMATS - PD_OPEN", PD_OPEN);
}
} else if (strcmp(token, OldHeadTok) == 0) {
/*
* This is a pre-PDB_SYSTEM_VERSION 2 style file. The second token
* is the machine type that wrote the file. Set the file->std for
* machine type for PD_open the file->std is always the PDBfile standard.
* Alignment issues are not properly handled before PDB_SYSTEM_VERSION 3
* but do the best that we can.
*/
token = strtok(NULL, " ");
if (token == NULL)
{
_lite_PD_rl_pdb(file);
lite_PD_error("INCOMPLETE HEADER - PD_OPEN", PD_OPEN);
}
switch (atoi(token)) {
case IEEE_32_64:
file->std = _lite_PD_copy_standard(&lite_IEEEA_STD);
file->align = _lite_PD_copy_alignment(&lite_M68000_ALIGNMENT);
break;
case IEEE_32_96:
file->std = _lite_PD_copy_standard(&lite_IEEEB_STD);
file->align = _lite_PD_copy_alignment(&lite_M68000_ALIGNMENT);
break;
case INTEL_X86:
file->std = _lite_PD_copy_standard(&lite_INTELA_STD);
file->align = _lite_PD_copy_alignment(&lite_INTELA_ALIGNMENT);
break;
case CRAY_64:
file->std = _lite_PD_copy_standard(&lite_CRAY_STD);
file->align = _lite_PD_copy_alignment(&lite_UNICOS_ALIGNMENT);
break;
case VAX_11:
file->std = _lite_PD_copy_standard(&lite_VAX_STD);
file->align = _lite_PD_copy_alignment(&lite_DEF_ALIGNMENT);
break;
default:
file->std = _lite_PD_copy_standard(&lite_DEF_STD);
file->align = _lite_PD_copy_alignment(&lite_DEF_ALIGNMENT);
break;
}
/*
* To correctly handle the situation in which many PDBfiles are open
* at the same time always try to latch on to the file->host_std.
* Alignment issues are not properly handled before PDB_SYSTEM_VERSION 3
* but do the best that we can
*/
if (_lite_PD_compare_std(file->host_std, file->std,
file->host_align, file->align)) {
_lite_PD_rl_standard(file->std);
file->std = _lite_PD_copy_standard(file->host_std);
_lite_PD_rl_alignment(file->align);
file->align = _lite_PD_copy_alignment(file->host_align);
}
} else {
_lite_PD_rl_pdb(file);
lite_PD_error("BAD FILE HEADER - PD_OPEN", PD_OPEN);
}
/*
* Record the current file position as the location of the symbol table
* address and sequentially the chart address.
*/
file->headaddr = io_tell(fp);
if (file->headaddr == -1L) {
_lite_PD_rl_pdb(file);
lite_PD_error("CAN'T FIND HEADER ADDRESS - PD_OPEN", PD_OPEN);
}
/*
* Read the address of the symbol table and structure chart.
*/
if (_lite_PD_rfgets(str, MAXLINE, fp) == NULL) {
_lite_PD_rl_pdb(file);
lite_PD_error("CAN'T READ SYMBOL TABLE ADDRESS - PD_OPEN", PD_OPEN);
}
token = strtok(str, "\001");
if (token == NULL) {
_lite_PD_rl_pdb(file);
lite_PD_error("BAD STRUCTURE CHART ADDRESS - PD_OPEN", PD_OPEN);
}
file->chrtaddr = atol(token);
token = strtok(NULL, "\001");
if (token == NULL) {
_lite_PD_rl_pdb(file);
lite_PD_error("BAD SYMBOL TABLE ADDRESS - PD_OPEN", PD_OPEN);
}
file->symtaddr = atol(token);
/*
* Read the symbol table first so that the file pointer is positioned
* to the "extra" information, then read the "extra's" to get the
* alignment data, and finish with the structure chart which needs
* the alignment data
*/
/*
* Read the symbol table.
*/
if (io_seek(fp, file->symtaddr, SEEK_SET)) {
_lite_PD_rl_pdb(file);
lite_PD_error("FSEEK FAILED SYMBOL TABLE - PD_OPEN", PD_OPEN);
}
if (!_lite_PD_rd_symt(file)) {
_lite_PD_rl_pdb(file);
lite_PD_error("CAN'T READ SYMBOL TABLE - PD_OPEN", PD_OPEN);
}
/*
* Read the miscellaneous data.
*/
if (!_lite_PD_rd_extras(file)) {
_lite_PD_rl_pdb(file);
lite_PD_error("CAN'T READ MISCELLANEOUS DATA - PD_OPEN", PD_OPEN);
}
/*
* Initialize the pdb system defs and structure chart.
*/
_lite_PD_init_chrt(file);
/*
* Read the structure chart.
*/
if (io_seek(fp, file->chrtaddr, SEEK_SET)) {
_lite_PD_rl_pdb(file);
lite_PD_error("FSEEK FAILED STRUCTURE CHART - PD_OPEN", PD_OPEN);
}
if (!_lite_PD_rd_chrt(file)) {
_lite_PD_rl_pdb(file);
lite_PD_error("CAN'T READ STRUCTURE CHART - PD_OPEN", PD_OPEN);
}
ep = lite_PD_inquire_entry(file, PDB_ATTRIBUTE_TABLE, TRUE, NULL);
if (ep != NULL) {
if (!lite_PD_read(file, PDB_ATTRIBUTE_TABLE, &file->attrtab)) {
lite_PD_close(file);
lite_PD_error("FAILED TO READ ATTRIBUTE TABLE - PD_OPEN", PD_OPEN);
}
_lite_PD_convert_attrtab(file);
file->chrtaddr = PD_entry_address(ep);
_lite_PD_rl_syment(ep);
lite_SC_hash_rem(_lite_PD_fixname(file, PDB_ATTRIBUTE_TABLE),
file->symtab);
} else {
file->attrtab = NULL;
}
/*
* Position the file pointer to the location of the structure chart.
*/
if (io_seek(fp, file->chrtaddr, SEEK_SET)) {
lite_PD_close(file);
lite_PD_error("FSEEK FAILED CHART - PD_OPEN", PD_OPEN);
}
return(file);
}
int
lite_PD_mkdir (PDBfile *file, char *dirname) {
int dir;
char name[MAXLINE], head[MAXLINE];
char *s;
static int dir_num = 0;
lite_PD_err[0] = '\0';
if (file == NULL) {
sprintf(lite_PD_err, "ERROR: BAD FILE ID - PD_MKDIR\n");
return(FALSE);
}
if (dirname == NULL) {
sprintf(lite_PD_err, "ERROR: DIRECTORY NAME NULL - PD_MKDIR\n");
return(FALSE);
}
/*
* Define type "Directory", if it hasn't been already.
*/
if (!PD_has_directories(file)) {
if ((lite_PD_defncv(file, "Directory", 1, 0)) == NULL) return FALSE;
/*
* Write out the root directory.
*/
dir = dir_num;
if (!lite_PD_write(file, "/", "Directory", &dir)) return(FALSE);
dir_num++;
}
/*
* Build an absolute pathname.
*/
strcpy(name, _lite_PD_fixname(file, dirname));
if (name[strlen(name) - 1] != '/') strcat(name, "/");
/*
* Make sure this directory hasn't already been created.
*/
if (lite_PD_inquire_entry(file, name, FALSE, NULL) != NULL) {
sprintf(lite_PD_err, "ERROR: DIRECTORY %s ALREADY EXISTS - PD_MKDIR\n",
name);
return(FALSE);
}
/*
* Make sure the next higher level directory already exists.
*/
strcpy(head, name);
head[strlen(head) - 1] = '\0';
s = strrchr(head, '/');
if (s != NULL) {
s[1] = '\0';
if (lite_PD_inquire_entry(file, head, FALSE, NULL) == NULL) {
int hlen = strlen(head);
head[hlen?hlen-1:0] = '\0';
sprintf(lite_PD_err, "ERROR: DIRECTORY %s DOES NOT EXIST - "
"PD_MKDIR\n", head);
return(FALSE);
}
}
/*
* Write the directory variable.
*/
dir = dir_num;
if (!lite_PD_write(file, name, "Directory", &dir)) return(FALSE);
dir_num++;
return(TRUE);
}
