/* @(#)prepc4.c 17.1.1.1 (ESO-DMD) 01/25/02 17:37:38 */ /*=========================================================================== Copyright (C) 1995 European Southern Observatory (ESO) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, MA 02139, USA. Correspondence concerning ESO-MIDAS should be addressed as follows: Internet e-mail: midas@eso.org Postal address: European Southern Observatory Data Management Division Karl-Schwarzschild-Strasse 2 D 85748 Garching bei Muenchen GERMANY ===========================================================================*/ /*+++++++++++++++++++ MIDAS monitor routines PREPC4 +++++++++++++++++++++++++ .LANGUAGE C .IDENTIFICATION Module PREPC4 .ENVIRONMENT VMS and UNIX .AUTHOR K. Banse ESO - Garching .COMMENTS holds DO_KEYS, IMMEDIATE, DESCR_ACCESS .KEYWORDS MIDAS monitor .VERSION [1.00] 870908: built from FORTRAN version 3.23 of 870325 020123 last modif -------------------------------------------------------------------------*/ #include #include #include #include #include #include static int work_size = 0; static char *work_str; static char warnmess[] = "Warning: Superfluous chars. on right hand side"; /* */ #ifdef __STDC__ int DO_KEYS(char key_task, char *prompt) #else int DO_KEYS(key_task,prompt) /*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE handle INQUIRE, DELETE, READ, COPY + WRITE/KEY here directly .ALGORITHM use ST interfaces in C to access the keywords .RETURNS status: MIDAS error codes ------------------------------------------------------------------*/ char key_task /* IN: = R, D, I, L, C or W */; char *prompt /* IN: points to prompt in case of I(nquire) */; #endif { int cnvno, *ibuf, iall; int first, bytelem, noelem; int sbytelem, snoelem; int lkey, klen, nb, wr_remote; int stat, kk, n, nn, start, slen, copy_1; int iwa[5], errflg; int unit, nullo; register int nr; long int since; char k_type[4], type[16], cc[4], keyname[32], *cbuf, substr[24]; char *xbuf, type_save[4]; char myfram[200]; float *rbuf, rall, rwa[2]; double *dbuf, dall, dwa[2]; if (work_size == 0) { work_size = 800; /* start with buffer for 800 chars. */ work_str = malloc((unsigned int)work_size); } dbuf = (double *)work_str; ibuf = (int *)work_str; rbuf = (float *)work_str; cbuf = work_str; copy_1 = 0; errflg = 1; /* default error_str to 2. token */ ERRORS.SYS = 5; /* default to invalid syntax */ ERRO_LOG = 1; /* save lower level errors ... */ /* branch according to action */ if (key_task == 'R') { /*--------- read keys -----------*/ since = 0; /* earliest time */ if (TOKEN[1].STR[0] == '?') TOKEN[1].STR[0] = '*'; if (TOKEN[3].STR[0] != '?') { /* convert time */ kk = CGN_CNVT(TOKEN[3].STR,1,1,&iall,&rall,&dall); if (kk <= 0) iall = 0; since = (long int) iall; } ERRORS.SYS = 51; /* display or really read key(s) */ if ((server.MODE == 1) && (server.FUNC == 30)) /* that's a XCKRDx */ { lkey = CGN_INDEXC(TOKEN[1].STR,'/'); (void) strncpy(keyname,TOKEN[1].STR,lkey); keyname[lkey] = '\0'; start = lkey + 1; slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,type,15); MID_TYPCHK(type,cc,&nn); type[0] = cc[0]; bytelem = nn; slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,substr,20); n = CGN_CNVT(substr,1,1,&first,rwa,dwa); slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,substr,20); n = CGN_CNVT(substr,1,1,&noelem,rwa,dwa); cnvno = 1; /* in case SCKRDx fails */ if (type[0] == 'I') { iwa[0] = 1; *ibuf = 0; stat = SCKRDI(keyname,first,noelem,&cnvno,ibuf,&unit,&nullo); } else if (type[0] == 'R') { iwa[0] = 2; *rbuf = 0.0; stat = SCKRDR(keyname,first,noelem,&cnvno,rbuf,&unit,&nullo); } else if (type[0] == 'D') { iwa[0] = 4; *dbuf = 0.0; stat = SCKRDD(keyname,first,noelem,&cnvno,dbuf,&unit,&nullo); } else { iwa[0] = 3; *cbuf = '\0'; stat = SCKRDC(keyname,bytelem,first,noelem,&cnvno,cbuf,&unit,&nullo); } iwa[1] = cnvno; iwa[2] = unit; iwa[3] = nullo; iwa[4] = stat; if (type[0] == 'I') stat = inmail(10,(char *)ibuf,iwa); /* send it */ else if (type[0] == 'R') stat = inmail(10,(char *)rbuf,iwa); /* send it */ else if (type[0] == 'D') stat = inmail(10,(char *)dbuf,iwa); /* send it */ else { iwa[1] *= bytelem; stat = inmail(10,cbuf,iwa); /* send it */ } return (0); } stat = MID_DSPKEY(TOKEN[1].STR,TOKEN[2].STR[0],since); if (stat != ERR_NORMAL) goto sect_1334; else return (0); /* that's it */ } else if (key_task == 'D') { /*--------- delete keys -------------*/ stat = MID_DELKEY(TOKEN[1].STR); /* delete key */ if (stat != ERR_NORMAL) goto sect_1333; else return (0); /* finished */ } /*----------------------------- define/write/inquire/copy keys -----------------------------*/ write_loop: (void) strcpy(keyname,TOKEN[1].STR); lkey = CGN_INDEXC(keyname,'/'); /* test, if default is taken */ if ((server.MODE == 1) && (server.FUNC == 20)) /* that's a XCKWRx */ wr_remote = 1; else wr_remote = 0; /* handle default or specific key specs */ if (lkey <= 0) /* yes - all defaults */ { if (key_task == 'L') goto sect_1334; /* not good for DEFINE/LOCAL */ if (MID_FNDKEY(keyname,k_type,&sbytelem,&snoelem,&since,&unit) < 0) goto sect_1333; /* wrong syntax... */ first = 1; if ( (k_type[0] == 'C') && (sbytelem > 1) ) (void) sprintf(type,"C*%d",sbytelem); else { type[0] = k_type[0]; type[1] = '\0'; } bytelem = sbytelem; noelem = snoelem; } else if (lkey > KEY_NAMELEN) /* avoid too long keynames */ { ERRORS.SYS = 51; goto sect_1334; } else /* no. we have to extract everything... */ { start = lkey + 1; slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,type,15); MID_TYPCHK(type,cc,&nn); if (cc[0] == ' ') { ERRORS.SYS = 50; goto sect_1334; } type[0] = cc[0]; bytelem = nn; slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,substr,20); if (slen >= 1) { n = CGN_CNVT(substr,1,2,iwa,rwa,dwa); if (n < 1) goto sect_1334; first = iwa[0]; if (n > 1) SCTPUT("Warning: superfluous chars. in start element..."); slen = CGN_EXTRSS(TOKEN[1].STR,TOKEN[1].LEN,'/',&start,substr,20); } if (slen < 1) goto sect_1334; n = CGN_CNVT(substr,1,2,iwa,rwa,dwa); if (n < 1) goto sect_1334; noelem = iwa[0]; if (n > 1) SCTPUT("Warning: superfluous chars. in last element..."); keyname[lkey] = '\0'; if (key_task == 'L') { stat = MID_TSTKEY(keyname); /* check against system names */ if (stat != ERR_NORMAL) { ERRORS.SYS = 51; goto sect_1334; } if ( (TOKEN[4].STR[0] == '+') && ((TOKEN[4].STR[1] == 'l') || (TOKEN[4].STR[1] == 'L')) ) key_task = 'l'; /* also for lower levels! */ } else /* check ,if key already exists */ { n = MID_FNDKEY(keyname,k_type,&sbytelem,&nb,&since,&unit); if (n < 0) { if (key_task == 'C') /* for COPY/KEY the source key must exist... */ { ERRORS.SYS = 52; goto sect_1334; } } else { if ( (type[0] != k_type[0]) || (nn != sbytelem) ) { ERRORS.SYS = 50; errflg = 2; goto sect_1334; } else goto copy_check; } } klen = noelem + first - 1; stat = MID_DEFKEY(keyname,key_task,type,klen,&unit); if (stat != ERR_NORMAL) goto sect_1333; } /* if it's COPY/KEY, we have to read the source key */ copy_check: if (key_task == 'C') { if (copy_1 == 0) { /* now check, if we get key from different Midas unit */ if (MONIT.COUNT > 3) { if (strncmp(TOKEN[3].STR,"IDI",3) == 0) /* unit in IDISERV */ { int fid; nn = CGN_COPY(myfram,FRONT.STARTUP); (void) strcpy(&myfram[nn],"IDISERV"); fid = osaopen(myfram,READ); if (fid > 0) { nn = osaread(fid,TOKEN[3].STR,4); osaclose(fid); } } /* save companion unit */ stat = SCKWRC("OUTPUTC",1,TOKEN[3].STR,70,2,&unit); MID_MOVKEY("O",myfram); /* close own keyfile */ nn = CGN_COPY(myfram,FRONT.STARTUP); (void) strcpy(&myfram[nn],"FORGR .KEY"); myfram[nn+5] = CGN_UPPER(TOKEN[3].STR[0]); myfram[nn+6] = CGN_UPPER(TOKEN[3].STR[1]); stat = MID_MOVKEY("IM",myfram); /* get other keyfile in */ if ( stat != ERR_NORMAL) { myfram[nn+5] = FRONT.DAZUNIT[0]; myfram[nn+6] = FRONT.DAZUNIT[1]; stat = MID_MOVKEY("IM",myfram); ERRORS.SYS = 100; errflg = -1; (void) strcpy(LINE.STR,"could not open background keyfile"); goto sect_1334; } } if (type[0] == 'I') stat = SCKRDI(keyname,first,noelem,&cnvno,ibuf,&unit,&nullo); else if (type[0] == 'R') stat = SCKRDR(keyname,first,noelem,&cnvno,rbuf,&unit,&nullo); else if (type[0] == 'D') stat = SCKRDD(keyname,first,noelem,&cnvno,dbuf,&unit,&nullo); else stat = SCKRDC(keyname,bytelem,first,noelem,&cnvno,cbuf,&unit,&nullo); if (stat != ERR_NORMAL) goto sect_1333; if (MONIT.COUNT > 3) { (void) MID_MOVKEY("O",myfram); /* close background keyfile */ myfram[nn+5] = FRONT.DAZUNIT[0]; myfram[nn+6] = FRONT.DAZUNIT[1]; stat = MID_MOVKEY("IM",myfram); } TOKEN[1].LEN = CGN_COPY(TOKEN[1].STR,TOKEN[2].STR); copy_1 = 1; /* because we have to loop once */ type_save[0] = type[0]; goto write_loop; } else { if (type_save[0] != type[0]) { ERRORS.SYS = 53; goto sect_1334; } if (cnvno > noelem) cnvno = noelem; if (type[0] == 'I') stat = SCKWRI(keyname,ibuf,first,cnvno,&unit); else if (type[0] == 'R') stat = SCKWRR(keyname,rbuf,first,cnvno,&unit); else if (type[0] == 'D') stat = SCKWRD(keyname,dbuf,first,cnvno,&unit); else stat = SCKWRC(keyname,bytelem,cbuf,first,cnvno,&unit); if (stat == ERR_NORMAL) goto ok_return; else goto sect_1333; } } /* if it's INQUIRE/KEY, we have to prompt */ if (key_task == 'I') { char myprompt[88]; if (KIWORDS[OFF_MODE+2] != 0) { ERRORS.SYS = 56; /* not possible in background... */ goto sect_1334; } if ( *prompt == ' ') /* build default prompt string */ { (void) strcpy(myprompt,"Enter values for key "); (void) strcpy(&myprompt[21],keyname); (void) strcat(myprompt,":"); } else { slen = (int) strlen(prompt); if ( (prompt[0] == '"') && (slen > 2) && (prompt[slen-1] == '"') ) { slen -= 2; (void) strncpy(myprompt,(prompt+1),slen); myprompt[slen] = '\0'; } else (void) strcpy(myprompt,prompt); for (nr=slen-1; nr>0; nr--) /* get rid of trailing blanks */ { if (myprompt[nr] != ' ') { myprompt[nr+1] = '\0'; break; } } } CGN_UPCOPY(substr,TOKEN[3].STR,5); if (strncmp(substr,"FLUSH",5) == 0) /* if par3 = FLUSH, */ { /* clear input buffer */ ostopen(); kk = ostin(); if (kk > 0) n = ostread(KAUX.OUT,kk,0); ostclose(); } if (type[0] == 'I') stat = SCKPRI(myprompt,keyname,first,noelem,&cnvno,ibuf,&unit,&nullo); else if (type[0] == 'R') stat = SCKPRR(myprompt,keyname,first,noelem,&cnvno,rbuf,&unit,&nullo); else if (type[0] == 'D') stat = SCKPRD(myprompt,keyname,first,noelem,&cnvno,dbuf,&unit,&nullo); else stat = SCKPRC(myprompt,keyname,bytelem,first,noelem,&cnvno, cbuf,&unit,&nullo); if ((stat != ERR_NORMAL) && (stat != ERR_NODATA)) { KIWORDS[OFF_AUX+6] = 0; /* clear AUX_MODE(7) */ goto sect_1333; } else { KIWORDS[OFF_AUX+6] = cnvno; /* AUX_MODE(7) <= no. of elements */ goto ok_return; } } /* for WRITE/KEY convert to binary if it's not a character keyword */ if (type[0] == 'C') goto char_key; /* character stuff not handled here */ if (type[0] == 'I') nb = 1; else if (type[0] == 'R') nb = 2; else nb = 4; if (wr_remote == 1) { iwa[0] = nb; /* the data type */ iwa[1] = noelem; if (nb == 1) /* get the data from Client */ stat = inmail(11,(char *)ibuf,iwa); else if (nb == 2) stat = inmail(11,(char *)rbuf,iwa); else stat = inmail(11,(char *)dbuf,iwa); cnvno = noelem; } else { if (MONIT.COUNT < 3) { if (nb == 1) /* emulate ALL option with zeros */ ibuf[0] = 0; else if (nb == 2) rbuf[0] = 0.0; else dbuf[0] = 0.0; cnvno = 1; TOKEN[3].STR[0] = 'A'; } else cnvno = CGN_CNVT(TOKEN[2].STR,nb,noelem,ibuf,rbuf,dbuf); } if (cnvno <= 0) { errflg = 2; ERRORS.SYS = 100; goto sect_1334; } /* check for ALL option */ if ( (TOKEN[3].STR[0] == 'A') || (TOKEN[3].STR[0] == 'a') ) { if (type[0] == 'I') { iall = *ibuf; kk = noelem * II_SIZE; if (kk > work_size) { free(work_str); /* free old memory + allocate new one */ work_size = kk; work_str = malloc((unsigned int)work_size); ibuf = (int *) work_str; } for (nr=0; nr work_size) { free(work_str); /* free old memory + allocate new one */ work_size = kk; work_str = malloc((unsigned int)work_size); rbuf = (float *) work_str; } for (nr=0; nr work_size) { free(work_str); /* free old memory + allocate new one */ work_size = kk; work_str = malloc((unsigned int)work_size); dbuf = (double *) work_str; } for (nr=0; nr work_size) { free(work_str); /* free old memory + allocate new one */ work_size = nn; work_str = malloc((unsigned int)work_size); cbuf = work_str; } if (wr_remote == 1) /* it's an XCKWRC call */ { iwa[0] = 3; iwa[1] = nn; stat = inmail(11,cbuf,iwa); } else { if (KIWORDS[OFF_AUX+4] == 0) /* AUX_MODE(5) is double_quote flag */ { slen = TOKEN[2].LEN - 1; if ( (TOKEN[2].STR[0] == '"') && (slen > 1) && (TOKEN[2].STR[slen] == '"') ) { (void) strcpy(TOKEN[2].STR,&TOKEN[2].STR[1]); TOKEN[2].STR[--slen] = '\0'; TOKEN[2].LEN = slen; } } if ( (TOKEN[3].STR[0] == 'A') || (TOKEN[3].STR[0] == 'a') ) { /* handle ALL option ... */ kk = 0; xbuf = cbuf; for (nr=0; nr= TOKEN[2].LEN) kk = 0; } } else { (void) strcpy(cbuf,TOKEN[2].STR); if (TOKEN[2].LEN < nn) { kk = TOKEN[2].LEN; xbuf = cbuf + kk; for (nr=kk; nr] 4) a single entry in a table, specified via TABLE,COL,ROW .ALGORITHM for 1) just return(0) for 2) use module DESCR_ACCESS for 3) use modules PIXEL_ACCES for 4) use module TABLE_ACCESS .RETURNS int =1 for 2) and 3) and 4) =0 for 1) = -1, if a bug ----------------------------------------------------------------*/ { static char kname[] = "L$L$L$ "; int unit, iav, nullo; int iwa[2], kk, elem, size; float rwa[2]; double dwa[2]; char savtoken[MAX_TOKEN], type[10]; if (CGN_INDEXC(TOKEN[0].STR,'[') > 0) /* frame access */ { kname[6] = 'R'; (void) strcpy(savtoken,TOKEN[0].STR); /* save result spec. */ TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,kname); kk = KEYCOMP(0,2,type); TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,savtoken); if (kk == 0) (void) SCKRDR(kname,1,1,&iav,rwa,&unit,&nullo); else { ERRORS.INDEX = 2; return (-1); } TOKEN[0].STR[TOKEN[0].LEN-1] = '\0'; kk = PIXEL_ACCESS(1,TOKEN[0].STR,rwa); /* leave closing ] out.. */ if (kk != 0) return (-1); else return (1); } kk = CGN_INDEXC(TOKEN[0].STR,','); if (kk <= 0) return (0); /* TOKEN[0].STR must be keyword */ /* we are left with table or descriptor settings */ type[0] = ' '; if (CGN_INDEXC(&TOKEN[0].STR[kk+1],',') >= 0) { TABLE_ACCESS(2,TOKEN[0].STR,iwa,rwa,TOKEN[2].STR, dwa,type,&size); if (type[0] == ' ') /* something wrong */ { ERRORS.INDEX = 0; return (-1); } if (type[0] != 'C') { if (TOKEN[2].STR[0] == 'n') TOKEN[2].STR[0] = 'N'; if (TOKEN[2].STR[0] != 'N') /* avoid NULL setting */ { kname[6] = type[0]; (void) strcpy(savtoken,TOKEN[0].STR); /* save result descr. */ TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,kname); kk = KEYCOMP(0,2,type); TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,savtoken); if (kk == 0) (void) strcpy(TOKEN[2].STR,kname); else { ERRORS.INDEX = 2; return (-1); } } } else if (MONIT.COUNT > 3) (void) printf("%s\n",warnmess); TABLE_ACCESS(1,TOKEN[0].STR,iwa,rwa,TOKEN[2].STR, dwa,type,&size); } else { DESCR_ACCESS(2,TOKEN[0].STR,iwa,rwa,TOKEN[2].STR, dwa,type,&elem,&size); if (type[0] == ' ') /* something wrong */ { ERRORS.INDEX = 0; return (-1); } if (type[0] != 'C') { kname[6] = type[0]; (void) strcpy(savtoken,TOKEN[0].STR); /* save result descr. */ TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,kname); kk = KEYCOMP(0,2,type); TOKEN[0].LEN = CGN_COPY(TOKEN[0].STR,savtoken); if (kk == 0) (void) strcpy(TOKEN[2].STR,kname); else { ERRORS.INDEX = 2; return (-1); } } else if (MONIT.COUNT > 3) (void) printf("%s\n",warnmess); DESCR_ACCESS(1,TOKEN[0].STR,iwa,rwa,TOKEN[2].STR, dwa,type,&elem,&size); } if (type[0] != ' ') return (1); else return (-1); /* that's bad ... */ } /* */ void DESCR_ACCESS(flag,string,ival,rval,cval,dval,type,elem,size) /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .PURPOSE replace string FILE,DESCR(...) or FILE[...:...],DESCR(...) with the contents of descr DESCR(...) or fill descr specified by FILE,DESCR(...) with given value .ALGORITHM read relevant element of descr + convert it to ASCII or fill it with a given value .RETURNS nothing ----------------------------------------------------------------------*/ int flag /* IN: = 0, read descr \ = 1, write descr \ = 2, get type, size of descr */; char *string /* IN: file,descr(...) terminated by \0 */; int *ival /* IO: integer value to be read or written */; float *rval /* IN/OUT: real value to be read or written */; char *cval /* IO: character value to be read or written \ or it holds the name of the keyword to \ be read for flag=1 and nonchar. type */; double *dval /* IO: double prec. value to be read or written */; char *type /* OUT: type of descr: I,R,CHAR*..,D \ = ' ', if something wrong */; int *elem /* OUT: element accessed */; int *size /* IO: max length on input (for char. parms.) \ length of value returned (for 'flag' = 0) */; { int entrx, first, bytelem; int unit, iav, nullo; int sfirst, sbytelem, stat, kk, n, last, ity; register int nr; char descr[50]; if (work_size == 0) { work_size = MAX_TOKEN; work_str = malloc((unsigned int)work_size); } iav = CGN_INDEXC(string,']')+1; /* test for: frame[...],descr */ kk = CGN_INDEXC(&string[iav],','); /* split up frame + descr */ kk += iav; (void) strncpy(work_str,string, kk); work_str[kk] = '\0'; *type = ' '; /* init to failure */ (void) FRAMACC('O',work_str,0,&entrx); /* open image or table */ if (entrx < 0) { ERRORS.SYS = 44; /* could not open */ return; } /* find out, if descr exists */ DSCR_PARSE(entrx,(string+kk+1),descr,type,&sbytelem,elem,&sfirst,&last); nullo = -1; /* indicate, that we do not test for null values */ if (*type == 'I') ity = 1; else if (*type == 'R') ity = 2; else if (*type == 'C') ity = 3; else if (*type == 'D') ity = 4; else if (*type == 'L') ity = 5; else { ERRORS.SYS = 85; /* wrong descriptor */ return; } if (flag == 2) /* just get type of descr */ { *(type+1) = '\0'; return; } if (ity != 3) { /* handle integer, real, double precision alike */ *size = 1; first = *elem; if (flag == 0) /* read... */ { if (ity == 1) stat = SCDRDI(entrx,descr,first,1,&iav,ival,&unit,&nullo); else if (ity == 2) stat = SCDRDR(entrx,descr,first,1,&iav,rval,&unit,&nullo); else if (ity == 4) stat = SCDRDD(entrx,descr,first,1,&iav,dval,&unit,&nullo); else stat = SCDRDL(entrx,descr,first,1,&iav,ival,&unit,&nullo); } else /* write... */ { if (ity == 1) { (void) SCKRDI(cval,1,1,&iav,ival,&unit,&nullo); stat = SCDWRI(entrx,descr,ival,first,1,&unit); } else if (ity == 2) { (void) SCKRDR(cval,1,1,&iav,rval,&unit,&nullo); stat = SCDWRR(entrx,descr,rval,first,1,&unit); } else if (ity == 4) { (void) SCKRDD(cval,1,1,&iav,dval,&unit,&nullo); stat = SCDWRD(entrx,descr,dval,first,1,&unit); } else { (void) SCKRDI(cval,1,1,&iav,ival,&unit,&nullo); stat = SCDWRL(entrx,descr,ival,first,1,&unit); } } } else { /* handle character descriptor here */ bytelem = sbytelem; first = sfirst--; /* first is original `sfirst' */ if (last < 0) kk = -last; else kk = last; kk -= sfirst; if (flag == 0) { CGN_FILL(cval,' ',*size); if (kk < *size) *size = kk; /* minimize... */ else kk = *size; if (sbytelem == 1) /* flat string */ { stat = SCDRDC(entrx,descr,1,first, kk,&iav,cval,&unit,&nullo); kk = iav; /* kk <= *size ... */ } else { if (kk+sfirst > sbytelem) kk = sbytelem - sfirst; if (bytelem > work_size) { free(work_str); /* free old memory + allocate new one */ work_size = bytelem; work_str = malloc((unsigned int)work_size); } stat = SCDRDC(entrx,descr,bytelem,*elem,1,&iav,work_str,&unit,&nullo); (void) strncpy(cval,work_str+sfirst,kk); } if (stat == ERR_NORMAL) { *size = kk; for (nr=0; nr0; nr--) /* cut off trailing blanks */ { if (cval[nr] != ' ') { *size = nr + 1; return; } } } } } else { n = (int) strlen(cval); if (KIWORDS[OFF_AUX+4] == 0) { if ((*cval == '"') && (*(cval+n-1) == '"')) { /* drop the enclosing quotes */ cval ++; n -= 2; } } if ((last < 0) && (kk > n)) kk = n; if (sbytelem == 1) /* flat char. string */ { if (n >= kk) stat = SCDWRC(entrx,descr,1,cval,first,kk,&unit); else { if (kk > work_size) { free(work_str); /* free old memory + allocate new one */ work_size = kk; work_str = malloc((unsigned int)work_size); } (void) strncpy(work_str,cval,n); CGN_FILL(work_str+n,' ',(kk-n)); stat = SCDWRC(entrx,descr,1,work_str,first,kk,&unit); } } else { if (sbytelem > work_size) { free(work_str); /* free old memory + allocate new one */ work_size = sbytelem; work_str = malloc((unsigned int)work_size); } stat = SCDRDC(entrx,descr,bytelem,*elem,1,&iav,work_str,&unit,&nullo); if (stat == ERR_NORMAL) { if (n >= kk) (void) strncpy(work_str+sfirst,cval,kk); else { (void) strncpy(work_str+sfirst,cval,n); CGN_FILL(work_str+sfirst+n,' ',(kk-n)); } stat = SCDWRC(entrx,descr,bytelem,work_str,*elem,1,&unit); } } } } if (stat != ERR_NORMAL) { ERRORS.STATUS = stat; /* save low level error */ ERRORS.SYS = 85; } }