diff options
author | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
---|---|---|
committer | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
commit | 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch) | |
tree | 4464880c571602d54f6ae114729bf62a89518057 /pkg/cl/decl.c | |
download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'pkg/cl/decl.c')
-rw-r--r-- | pkg/cl/decl.c | 878 |
1 files changed, 878 insertions, 0 deletions
diff --git a/pkg/cl/decl.c b/pkg/cl/decl.c new file mode 100644 index 00000000..0cfef489 --- /dev/null +++ b/pkg/cl/decl.c @@ -0,0 +1,878 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#define import_spp +#define import_libc +#define import_stdio +#include <iraf.h> + +#include "config.h" +#include "clmodes.h" +#include "operand.h" +#include "mem.h" +#include "grammar.h" +#include "opcodes.h" +#include "param.h" +#include "task.h" +#include "errs.h" +#include "construct.h" +#include "ytab.h" /* pick up yacc token #defines */ +#include "proto.h" + + +/* + * DECL -- contains routines used by the parser for referencing parameters + * and for parameter declarations. + */ + +extern int cldebug; + +char *badopt = "Invalid %s option for `%s'."; +char *illegal_opt = "Illegal option for `%s'."; +char *dup_def = "Duplicate definition of `%s' ignored.\n"; + + +/* GETLIMITS -- Get the limits for the n'th index of a parameter. + * Returns ERR if the parameter is not defined, or has fewer than n indexes. + */ +int +getlimits ( + char *pname, + int n, + int *i1, + int *i2 +) +{ + struct param *pp; + char *pk, *t, *p, *f; + int dim; + short *len, *off; + + breakout (pname, &pk, &t, &p, &f); + pp = paramsrch (pk, t, p); + + /* Paramsrch calls error if it cannot find the param, so we + * needn't check here. + */ + if (!(pp->p_type & PT_ARRAY)) + return (ERR); + + dim = pp->p_val.v_a->a_dim; + if (n >= dim) + return (ERR); + + len = &(pp->p_val.v_a->a_len); + len = len + 2*n; + off = len + 1; + + *i1 = *off; + *i2 = *off + *len - 1; + return (OK); +} + + +/* GET_DIM -- Get the dimensionality of an parameter. If not an array return 0. + */ +int +get_dim (char *pname) +{ + struct param *pp, *lookup_param(); + char *pk, *t, *p, *f; + int dim; + + breakout (pname, &pk, &t, &p, &f); + + /* We can't use paramsrch here because the string we are + * looking for might be a builtin, and paramsrch would fail. + */ + pp = lookup_param (pk, t, p); + + if (pp == NULL || (XINT) pp == ERR) + dim = -1; + else if (!(pp->p_type & PT_ARRAY)) + dim = 0; + else + dim = pp->p_val.v_a->a_dim; + + return (dim); +} + + +/* MAKETYPE -- Set the type of a parameter. + */ +int +maketype (int type, int list) +{ + register int p = -1; + + switch (type) { + case V_BOOL: p = OT_BOOL; + break; + case V_INT: p = OT_INT; + break; + case V_REAL: p = OT_REAL; + break; + case V_STRING: p = OT_STRING; + break; + case V_FILE: p = OT_STRING | PT_FILNAM; + break; + case V_GCUR: p = OT_STRING | PT_GCUR; + break; + case V_IMCUR: p = OT_STRING | PT_IMCUR; + break; + case V_UKEY: p = OT_STRING | PT_UKEY; + break; + case V_PSET: p = OT_STRING | PT_PSET; + break; + case V_STRUCT: p = OT_STRING | PT_STRUCT; + break; + } + + if (list) + p |= PT_LIST; + + return (p); +} + + +/* DO_ARRAYINIT -- Initialize an array from values in a declaration statement. + * This routine must also allocate the array descriptor block. + * + * On entry the control stack contains pointers to operands containing + * the initialization info. Buried beneath this may be the dimension + * and offset information needed for the the array descriptor. The + * dimensionality of the array is passed in nindex, except when + * the user wishes to default the dimension of a one-dimensional + * array to the number of values in the initialization block. + * In that case nindex has been passed as 0. + * + * This program ASSUMES that successive calls to memneed return + * contiguous blocks of memory. This is because we don't know + * the size of the array at first, and we can only allocate the + * space needed to hold the values which have been initialized. + * After we have popped the stack down to array descriptor info + * we may find that some values are not initialized and so we + * may need to allocate more memory. + */ +void +do_arrayinit ( + struct param *pp, + int nval, + int nindex +) +{ + int block1, block2, dim, asiz, asiz2, asiz2x, bastype, i; + int slen; + short *off, *len; + struct arr_desc *parr; + struct operand *o; + union arrhead ar; + + if (cldebug) + eprintf ("do_arrayinit: nindex=%d nval=%d\n", nindex, nval); + bastype = pp->p_type & OT_BASIC; + if (bastype == OT_STRING) + slen = pp->p_lenval; + + dim = nindex; + if (dim == 0) + dim = 1; + asiz = 0; + + /* Allocate an array descriptor. + */ + parr = (struct arr_desc *) memneed (2+dim); + + if (nval > 0) { + asiz = nval; + if (bastype == OT_REAL) + asiz = dtoi (asiz); + block1 = (int) memneed (asiz); + ar.a_i = (int *) block1; + i = nval; + + while (i--) { + o = (struct operand *) pop(); + + switch (bastype) { + + case OT_BOOL: + if (o->o_type != OT_BOOL && o->o_type != OT_INT) { + eprintf ("Invalid type in array initialization.\n"); + *(ar.a_i + i) = INDEFL; + } else + *(ar.a_i + i) = o->o_val.v_i; + break; + + case OT_INT: + if (o->o_type != OT_INT) { + eprintf ("Invalid type in array initialization.\n"); + *(ar.a_i + i) = INDEFL; + } else + *(ar.a_i + i) = o->o_val.v_i; + break; + + case OT_REAL: + switch (o->o_type) { + case OT_INT: + ar.a_r[i] = (double) (o->o_val.v_i); + break; + case OT_REAL: + ar.a_r[i] = o->o_val.v_r; + break; + default: + eprintf ("Invalid type in array initialization.\n"); + ar.a_r[i] = INDEFR; + break; + } + break; + + case OT_STRING: + ar.a_s[i] = o->o_val.v_s; + } /* End of switch. */ + } + } + + /* Get array descriptor info. + */ + if (nindex > 0) { + len = &(parr->a_len); + off = &(parr->a_off); + parr->a_dim = nindex; + + asiz2 = 1; + + i = nindex; + while (i--) { + off[2*i] = pop(); + len[2*i] = pop(); + asiz2 *= len[2*i]; + } + + if (bastype == OT_REAL) + asiz2x = dtoi (asiz2); + else + asiz2x = asiz2; + + if (asiz2x > asiz) { /* Need to allocate more space. */ + block2 = (int) memneed (asiz2x-asiz); + + if (nval == 0) { + block1 = block2; + ar.a_i = (int *) block1; + } + + if (btoi(block2-block1) != asiz) + cl_error (E_IERR, "Memory sync error during array init.\n"); + + /* Initialize undefined elements. + */ + for (i = nval; i < asiz2; i++) + switch (bastype) { + case OT_INT: + case OT_BOOL: + ar.a_i[i] = INDEFL; + break; + case OT_REAL: + ar.a_r[i] = INDEFR; + break; + case OT_STRING: + ar.a_s[i] = memneed (btoi(slen)); + *(ar.a_s[i]) = '\0'; + *(ar.a_s[i] + SZ_FNAME - 1) = '\0'; + } + } else if (nval > asiz2) + /* We just leave the extra values in the dictionary. + * It's not serious enough to make it an error. + */ + eprintf ("Warning: Too many initialization values for `%s'.\n", + pp->p_name); + + } else { /* User didn't give dimensions. */ + parr->a_len = nval; + parr->a_off = 1; + parr->a_dim = 1; + } + + /* At this point initialized string parameters point to the string + * which was returned as an operand. Many array elements could + * point to the same storage. Allocate a constant amount + * of storage for each of the initialized strings and copy + * the initial value into it. + */ + if (bastype == OT_STRING) { + for (i=0; i<nval; i++) { + char *s; + s = memneed (btoi (slen)); + strncpy (s, ar.a_s[i], slen-1); + *(s+SZ_FNAME-1) = '\0'; + ar.a_s[i] = s; + } + } + + /* Finally connect the various elements. + */ + pp->p_val.v_a = parr; + pp->p_aval = ar; +} + + +/* DO_SCALARINIT -- Initialize a scalar. Mostly copied from ADDPARAM. + */ +void +do_scalarinit ( + struct param *pp, + int inited +) +{ + struct operand *o, undefoper; + extern char *e_invaldef; + int len, bastype; + char *s; + + pp->p_valo.o_type = bastype = pp->p_type & OT_BASIC; + + if (inited) { + o = (struct operand *)pop(); + if (o->o_type == OT_STRING) + s = o->o_val.v_s; + else + s = undefval; + } else { + o = &undefoper; + s = undefval; + undefoper.o_type = OT_STRING; + undefoper.o_val.v_s = undefval; + } + + if (pp->p_type & (PT_LIST|PT_FILNAM|PT_PSET)) { + if (o->o_type != OT_STRING) + cl_error (E_UERR, e_invaldef, pp->p_name); + + pp->p_val.v_s = memneed (btoi(SZ_FNAME)); + pp->p_val.v_s[SZ_FNAME-1] = '\0'; + + if (pvaldefined (pp, s)) { + char *p; + + /* Change a whitespace-only filename into a null string; this + * makes it easier for users to check null filenames in + * scripts. It makes sense anyway since these are invalid + * filenames. + */ + p = s; + while (*p == ' ' || *p == '\t') + p++; + if (*p == '\0' || *p == '\n') + pp->p_val.v_s[0] = '\0'; + else + strncpy (pp->p_val.v_s, s, SZ_FNAME-1); + } else + pp->p_val.v_s[0] = '\0'; + + if (pp->p_type & PT_LIST) + pp->p_listval = memneed (btoi(SZ_LINE)); + + pp->p_valo.o_type = OT_STRING; + + } else if (pp->p_type & (PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY)) { + if (o->o_type != OT_STRING) + cl_error(E_UERR, e_invaldef, pp->p_name); + + len = pp->p_lenval; + pp->p_val.v_s = memneed (btoi (len)); + + if (pvaldefined (pp, s)) + strcpy (pp->p_val.v_s, s); + else + pp->p_val.v_s[0] = '\0'; + + pp->p_val.v_s[len-1] = '\0'; /* the permanent eos */ + pp->p_valo.o_type = OT_STRING; + + } else if (bastype == OT_STRING || (s != NULL && *s == PF_INDIRECT)) { + /* Strings are stored like structs, but are inited from s. + * OT_INDEF/UNDEF refer to p_val. + */ + pp->p_lenval = SZ_LINE; + if (pvaldefined (pp, s)) { + /* String was something conventional. If shorter than SZ_LINE + * call memneed() to allocate sufficient space and copy + * the value into it. + */ + char *news; + + pp->p_valo.o_type = OT_STRING; + len = strlen (s) + 1; /* allow for eos */ + news = memneed (btoi (pp->p_lenval)); + + if (len < pp->p_lenval) { + strcpy (news, s); + s = news; + } else { + pp->p_lenval = len; + pp->p_val.v_s = s; + } + + } else { + /* Either no string was given or it was INDEF/UNDEF. + */ + len = SZ_LINE; + s = memneed (btoi (pp->p_lenval)); + } + + pp->p_val.v_s = s; + pp->p_val.v_s[len-1] = '\0'; /* add the permanent eos */ + pp->p_maxo.o_type = OT_INT; + + } else { + /* Simple non-string type. + */ + if (inited) + pp->p_valo = *o; + else + pp->p_valo.o_type = bastype | OT_UNDEF; + } + + if (cldebug) + eprintf ("do_scalar_init: pp->p_flags=%o\n", pp->p_flags); +} + + +/* SCANFTYPE -- Get file type for file parameter. + */ +int +scanftype ( + struct param *pp, + struct operand *o +) +{ + int type; + char *s; + + if (o->o_type != OT_STRING) + return (ERR); + + type = 0; + s = o->o_val.v_s; + + while (*++s != '\0') + switch (*s) { + case 'b': case 'B': type |= PT_FBIN; break; + case 'n': case 'N': type |= PT_FNOE; break; + case 'r': case 'R': type |= PT_FER; break; + case 't': case 'T': type |= PT_FTXT; break; + case 'w': case 'W': type |= PT_FEW; break; + default: return (ERR); + } + + pp->p_type |= type; + return (OK); +} + + +/* C_SCANMODE -- Get the mode for a parameter. + */ +int +c_scanmode ( + struct param *pp, + struct operand *o +) +{ + if (o->o_type != OT_STRING) + return (ERR); + + pp->p_mode = scanmode (o->o_val.v_s); + return (OK); +} + + +/* SCANLEN -- Get the length for structs and strings. + */ +int +scanlen ( + struct param *pp, + struct operand *o +) +{ + if (o->o_type != OT_INT || + !(pp->p_type & (OT_STRING|PT_LIST|PT_STRUCT))) + return (ERR); + + pp->p_lenval = o->o_val.v_i; + return (OK); +} + + +/* SCANMIN -- Get the minimum for a parameter. + */ +int +scanmin ( + struct param *pp, + struct operand *o +) +{ + int bastype, otype; + + bastype = pp->p_type & OT_BASIC; + otype = o->o_type; + + if (pp->p_type & (OT_BOOL|PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET)) + return (ERR); + + if (otype == OT_STRING) + if ((bastype == OT_STRING || *(o->o_val.v_s) == PF_INDIRECT)) { + + /* Filename, enumerated string, or indirect reference. + */ + pp->p_mino.o_type = OT_STRING; + pp->p_min.v_s = memneed (btoi(PF_SZMINSTR)); + pp->p_min.v_s[PF_SZMINSTR-1] = '\0'; + strncpy (pp->p_min.v_s, o->o_val.v_s, PF_SZMINSTR-1); + pp->p_flags &= ~P_UMIN; + return (OK); + } + + pushop (o); + opcast (bastype); + pp->p_mino = popop(); + + pp->p_flags &= ~P_UMIN; + return (OK); +} + + +/* SCANENUM -- Get the legal values for an enumerated string an store in the + * min field of the parameter. + */ +int +scanenum ( + register struct param *pp, + register struct operand *o +) +{ + register int bastype; + + bastype = pp->p_type & OT_BASIC; + + if (bastype != OT_STRING || o->o_type != OT_STRING) + return (ERR); + + return (scanmin (pp, o)); +} + + +/* SCANMAX -- Get the maximum for a param. + */ +int +scanmax ( + struct param *pp, + struct operand *o +) +{ + int otype; + + otype = pp->p_type & OT_BASIC; + + if (pp->p_type & (OT_BOOL|PT_STRUCT|PT_GCUR|PT_IMCUR|PT_UKEY|PT_PSET)) + return (ERR); + + if (otype == OT_STRING && o->o_type == OT_STRING) + if (*o->o_val.v_s == '@') { + /* Filename, enumerated string, or indirect reference. + */ + pp->p_maxo.o_type = OT_STRING; + pp->p_max.v_s = memneed (btoi(PF_SZMAXSTR)); + pp->p_max.v_s[PF_SZMAXSTR-1] = '\0'; + strncpy (pp->p_max.v_s, o->o_val.v_s, PF_SZMAXSTR-1); + + pp->p_flags &= ~P_UMAX; + return (OK); + } + + /* Type is equivalent to a simple non-string wrt mins. + */ + pushop (o); + opcast (otype); + pp->p_maxo = popop(); + pp->p_flags &= ~P_UMAX; + return (OK); +} + + +/* PROC_PARAMS -- Check that all of the parameters in the procedure statement + * are now defined. If the mode for these parameters is not declared + * set it to AUTO mode. Also rearrange the parameters so they + * agree with order of definition in the procedure statement. + */ +void +proc_params (int npar) +{ + struct operand *o; + struct param *pp, *fp, *lp, *op, *tp; + + if (npar <= 0) + goto setmodes_; + + fp = lp = NULL; + + while (npar--) { + o = (struct operand *) pop(); + if (o->o_type != OT_STRING) + cl_error (E_UERR,"Invalid parameter in procedure statement.\n"); + + if (npar >= MAX_PROC_PARAMS) + eprintf ( + "Too many parameters: `%s' cannot be used positionally.", + o->o_val.v_s); + + parlist [npar] = o; + + pp = paramfind (parse_pfile, o->o_val.v_s, 0, YES); + if (pp == NULL) + cl_error (E_UERR, "Required parameter `%s' not defined.", + o->o_val.v_s); + + if (pp->p_mode & M_HIDDEN) { + /* This parameter was declared as hidden, but was in the + * procedure statement. Override it with a mode of auto, + * giving the user a warning. + */ + eprintf ("Warning: mode for parameter `%s' overridden.\n", + pp->p_name); + pp->p_mode &= ~M_HIDDEN; + pp->p_mode |= M_AUTO; + } else if (!pp->p_mode) + pp->p_mode = M_AUTO; + + tp = parse_pfile->pf_pp; + op = NULL; + + /* Since we've already found pp, this loop must terminate with a + * break. + */ + while (tp != NULL) { + if (tp == pp) + break; + else { + op = tp; + tp = tp->p_np; + } + } + + /* Take param out of list and add to properly ordered list. + */ + if (op == NULL) + parse_pfile->pf_pp = tp->p_np; + else + op->p_np = tp->p_np; + + if (lp == NULL) + lp = tp; + + tp->p_np = fp; + fp = tp; + } + + lp->p_np = parse_pfile->pf_pp; + parse_pfile->pf_pp = fp; + + while (fp->p_np != NULL) /* Find last parameter. */ + fp = fp->p_np; + parse_pfile->pf_lastpp = fp; + +setmodes_: + /* Insure that all parameters have a mode. The default in a procedure + * script is hidden. + */ + tp = parse_pfile->pf_pp; + while (tp != NULL) { + if (!tp->p_mode) + tp->p_mode = M_HIDDEN; + tp = tp->p_np; + } +} + + +/* INITPARAM -- Get a new parameter and initialize appropriate fields. + */ +struct param * +initparam ( + struct operand *op, + int isparam, + int type, + int list +) +{ + struct param *pp; + extern char *e_lookparm; + int slen; + + pp = paramfind (parse_pfile, op->o_val.v_s, 0, YES); + + if (pp == NULL) { + pp = newparam (parse_pfile); + + slen = strlen(op->o_val.v_s) + 1; + pp->p_name = memneed (btoi(slen)); + strcpy (pp->p_name, op->o_val.v_s); + pp->p_type = maketype (type, list); + + /* Do not initialize the mode of a parameter in a procedure + * script. They will be initialized in proc_params(). + */ + if (parse_state != PARSE_PARAMS) { + if (isparam) + pp->p_mode = M_HIDDEN; + else + pp->p_mode = M_LOCAL; + } + + pp->p_mino.o_type = 0; + pp->p_maxo.o_type = 0; + pp->p_flags |= (P_UMAX|P_UMIN); + pp->p_prompt = undefval; + pp->p_lenval = SZ_FNAME; + + } else if (pp == (struct param *) ERR) { + cl_error (E_UERR, e_lookparm, op->o_val.v_s); + + } else { + pp = NULL; + eprintf (dup_def, op->o_val.v_s); + } + + return (pp); +} + + +/* PROCSCRIPT -- Is this a procedure script? + */ +int +procscript (FILE *fp) +{ + char *p, buf[PF_MAXLIN+1]; + int result; + long fpos; + + result = NO; + fpos = 0L; + + while (fgets (buf, PF_MAXLIN, fp) != NULL) { + for (p = buf; *p == ' ' || *p == '\t'; p++) + ; + if (strncmp (p, "procedure", 9) == 0) { + result = YES; + break; + } else if ((*p == '#') || (*p == '\n')) { + fpos = ftell (fp); + continue; + } else + break; + } + + /* Rewind the file so that the parser sees the procedure statement. + * If NOT a procedure script, rewind the file entirely, as the lexical + * analyzer needs to see the comments to work properly (because of the + * #{ ... #} lexmodes toggle sequences). + */ + if (result) + fseek (fp, fpos, 0); + else + fseek (fp, 0L, 0); + + return (result); +} + + +/* SKIP_TO -- Within a file, skip to the statement beginning with the key. + */ +int +skip_to ( + FILE *fp, + char *key +) +{ + char *p, buf[PF_MAXLIN+1]; + int count, len; + long fpos; + + len = strlen (key); + count = 0; + fpos = 0L; + + while (fgets (buf, PF_MAXLIN, fp) != NULL) { + + count++; + for (p = buf; *p == ' ' || *p == '\t'; p++) + ; + + if (strncmp (p, key, len) == 0) { + /* Seek back to beginning of line. + */ + fseek (fp, fpos, 0L); + return (--count); + } + + fpos = ftell (fp); + } + + return (ERR); +} + + +/* DO_OPTION -- Set parameter attributes which have been explicitly + * defined by the user. + */ +void +do_option ( + struct param *pp, + struct operand *oo, + struct operand *o +) +{ + char *opt; + + /* Determine the options and take appropriate action. + */ + opt = oo->o_val.v_s; + + if (!strcmp (opt, "mode")) { + /* (There is a scanmode() in pfiles.c.) + */ + if (c_scanmode (pp, o) == ERR) + cl_error (E_UERR, badopt, "MODE", pp->p_name); + + } else if (!strcmp (opt, "filetype")) { + if (scanftype (pp, o) == ERR) + cl_error (E_UERR, badopt, "FILETYPE", pp->p_name); + + } else if (!strcmp (opt, "min")) { + if (scanmin (pp, o) == ERR) + cl_error (E_UERR, badopt, "MIN", pp->p_name); + + } else if (!strcmp (opt, "max")) { + if (scanmax (pp, o) == ERR) + cl_error (E_UERR, badopt, "MAX", pp->p_name); + + } else if (!strcmp (opt, "enum")) { + if (scanenum (pp, o) == ERR) + cl_error (E_UERR, badopt, "ENUM", pp->p_name); + + } else if (!strcmp (opt, "len") || !strcmp (opt, "length")) { + if (scanlen (pp, o) == ERR) + cl_error (E_UERR, badopt,"LEN", pp->p_name); + + } else if (!strcmp (opt, "prompt")) { + int slen; + + if (o->o_type != OT_STRING) + cl_error (E_UERR, badopt, "PROMPT", pp->p_name); + + slen = btoi (strlen(o->o_val.v_s) + 1); + pp->p_prompt = memneed (slen); + strcpy (pp->p_prompt, o->o_val.v_s); + + } else + cl_error (E_UERR, illegal_opt, pp->p_name); +} |