/*------------------------------------------------------------------------- * Function: _lite_SC_pr_tok * * Purpose: Returns a pointer to the first token and points S to * the next element in the string. * * Return: Success: First token in S * * Failure: NULL * * Programmer: Adapted from PACT SCORE * Mar 12, 1996 * * Modifications: * *------------------------------------------------------------------------- */ char * _lite_SC_pr_tok (char *s, char *delim) { int i, j; if (!s) return NULL; i = strcspn(s, delim); j = strlen(s); if ((i == 0) && (i != j)) { s++; return(lite_SC_firsttok(s, delim)); } s[i] = '\0'; strcpy(tokbuffer, s); /* * Take care of last token in string. */ if (i == j) *s = '\0'; else strcpy(s, s+i+1); s += strlen(s) + 1; strcpy(s, tokbuffer); return(s); }
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; }
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); } }
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); }