From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001 From: Joe Hunkeler Date: Tue, 11 Aug 2015 16:51:37 -0400 Subject: Repatch (from linux) of OSX IRAF --- sys/qpoe/qpexparse.gx | 410 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 410 insertions(+) create mode 100644 sys/qpoe/qpexparse.gx (limited to 'sys/qpoe/qpexparse.gx') diff --git a/sys/qpoe/qpexparse.gx b/sys/qpoe/qpexparse.gx new file mode 100644 index 00000000..c6f40042 --- /dev/null +++ b/sys/qpoe/qpexparse.gx @@ -0,0 +1,410 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include +include "../qpex.h" + +.help qpexparse +.nf -------------------------------------------------------------------------- +QPEXPARSE -- Code to parse an event attribute expression, producing a binary +range list as output. + + nranges = qpex_parse[ird] (expr, xs, xe, xlen) + +The calling sequence for the parse routine is shown above. The arguments XS +and XE are pointers to dynamically allocated arrays of length XLEN and type +[IRD]. These arrays should be allocated in the calling program before calling +the parser, and deallocated when no longer needed. Reallocation to increase +the array length is automatic if the arrays fill during parsing. DTYPE should +be the same datatype as the attribute with which the list is associated. + +The form of an event attribute expression may be a list of values, + + attribute = n +or + attribute = m, n, ... + +a list of inclusive or exclusive ranges, + + attribute = m:n, !p:q + +including open ranges, + + attribute = :n, p:q + +or any combination of the above (excluding combinations of bitmasks and values +or ranges, which are mutually exclusive): + + attribute = :n, a, b, p:q, !(m, e:f) + +Parenthesis may be used for grouping where desired, e.g., + + attribute = (:n, a, b, p:q, !(m, e:f)) + +An additional form of the event attribute expression allows use of a bitmask +to specify the acceptable values, e.g., + + attribute = %17B +or + attribute = !%17B + +however, bitmasks are incompatible with range lists, and should be recognized +and dealt with elsewhere (bitmasks may not be combined with range lists in +the same expression term). + +We are concerned here only with the attribute value list itself, i.e., +everything to the right of the equals sign in the examples above. This list +should be extracted and placed into a string containing a single line of +text before we are called. Attribute value lists may be any length, but +backslash continuation, file inclusion (or whatever means is used to form +the attribute value list) is assumed to be handled at a higher level. + +The output of this package is an ordered boolean valued binary range list +with type integer, real, or double breakpoints (i.e., the breakpoints are the +same datatype as the attribute itself, but the range values are zero or one). +The range list defines the initial value, final value, and any interior +breakpoints where the attribute value changes state. Expression optimization +is used to minimize the number of breakpoints (i.e., eliminate redundant +breakpoints, such as a range within a range). + +Output range list format: + + xs[1] xe[1] + xs[2] xe[2] + ... + xs[N] xe[N] + +Where each range is inclusive and only "true" ranges are shown. If XS[1] is +LEFT a open-left range (:n) is indicated; if XE[N] is RIGHT an open-right +range (n:) is indicated. In an integer range list, isolated points appear +as a single range with (xe[i]=xs[i]). In a real or double range list, +isolated points are represented as finite ranges with a width on the order of +the machine epsilon. +.endhelp --------------------------------------------------------------------- + +define DEF_XLEN 256 # default output range list length +define INC_XLEN 256 # increment to above +define DEF_VLEN 512 # default breakpoint list length +define INC_VLEN 512 # increment to above +define MAX_NEST 20 # parser stack depth + +define STEP 1 # step at boundary of closed range +define ZERO 1000 # step at boundary of open range + +define XV Mem$t[xv+($1)-1] # reference x position values +define UV Memi[uv+($1)-1] # unique flags for x value pairs +define SV Memi[sv+($1)-1] # reference breakpoint step values + + +# QPEX_PARSE -- Convert the given attribute value list into a binary +# range list, returning the number of ranges as the function value. + +int procedure qpex_parse$t (expr, xs, xe, xlen) + +char expr[ARB] #I attribute value list to be parsed +pointer xs #U pointer to array of start-range values +pointer xe #U pointer to array of end-range values +int xlen #U allocated length of XS, XE arrays + +bool range +pointer xv, uv, sv +PIXEL xstart, xend, xmin, temp, x, n_xs, n_xe +int vlen, nrg, ip, op, ch, ip_start, i, j, jval, r1, r2, y, v, ov, dy +int token[MAX_NEST], tokval[MAX_NEST], lev, itemp, umin +errchk syserr, malloc, realloc +define pop_ 91 + +$if (datatype == si) +int qp_ctoi() +define fp_equal$t($1==$2) +$else +double dtemp +bool bval, fp_equal$t() +int qp_ctod() +$endif + +begin + vlen = DEF_VLEN + call malloc (xv, vlen, TY_PIXEL) + call malloc (uv, vlen, TY_INT) + call malloc (sv, vlen, TY_INT) + + lev = 0 + nrg = 0 + + # Parse the expression string and compile the raw, unoptimized + # breakpoint list in the order in which the breakpoints occur in + # the string. + + for (ip=1; expr[ip] != EOS; ) { + # Skip whitespace. + for (ch=expr[ip]; IS_WHITE(ch) || ch == '\n'; ch=expr[ip]) + ip = ip + 1 + + # Extract and process token. + switch (ch) { + case EOS: + # At end of string. + if (lev > 0) + goto pop_ + else + break + + case ',': + # Comma list token delmiter. + ip = ip + 1 + goto pop_ + + case '!', '(': + # Syntactical element - push on stack. + ip = ip + 1 + lev = lev + 1 + if (lev > MAX_NEST) + call syserr (SYS_QPEXLEVEL) + token[lev] = ch + tokval[lev] = nrg + 1 + + case ')': + # Close parenthesized group and pop parser stack. + ip = ip + 1 + if (lev < 1) + call syserr (SYS_QPEXMLP) + else if (token[lev] != '(') + call syserr (SYS_QPEXRPAREN) + lev = lev - 1 + goto pop_ + + default: + # Process a range term. + ip_start = ip + + # Scan the M in M:N. + $if (datatype == si) + if (qp_ctoi (expr, ip, xstart) <= 0) + xstart = LEFT$T + $else + if (qp_ctod (expr, ip, dtemp) <= 0) + xstart = LEFT$T + else + xstart = dtemp + $endif + + # Scan the : in M:N. The notation M-N is also accepted, + # provided the token - immediately follows the token M. + + while (IS_WHITE(expr[ip])) + ip = ip + 1 + range = (expr[ip] == ':') + if (range) + ip = ip + 1 + else if (!IS_LEFT$T (xstart)) { + range = (expr[ip] == '-') + if (range) + ip = ip + 1 + } + + # Scan the N in M:N. + if (range) { + $if (datatype == si) + if (qp_ctoi (expr, ip, xend) <= 0) + xend = RIGHT$T + $else + if (qp_ctod (expr, ip, dtemp) <= 0) + xend = RIGHT$T + else + xend = dtemp + $endif + } else + xend = xstart + + # Fix things if the user entered M:M explicitly. + if (range) + if (fp_equal$t (xstart, xend)) + range = false + + # Expand a single point into a range. For an integer list + # this produces M:M+1; for a floating list M-eps:M+eps. + # Verify ordering and that something recognizable was scanned. + + if (!range) { + if (IS_LEFT$T(xstart)) + call syserr (SYS_QPEXBADRNG) + $if (datatype == si) + xend = xstart + 1 + $endif + } else { + if (xstart > xend) { + temp = xstart; xstart = xend; xend = temp + } + $if (datatype == si) + if (!IS_RIGHT$T(xend)) + xend = xend + 1 + $endif + } + + # Make more space if vectors fill up. + if (nrg+4 > vlen) { + vlen = vlen + INC_VLEN + call realloc (xv, vlen, TY_PIXEL) + call realloc (uv, vlen, TY_INT) + call realloc (sv, vlen, TY_INT) + } + + # Save range on intermediate breakpoint list. + nrg = nrg + 1 + XV(nrg) = xstart + UV(nrg) = 0 + SV(nrg) = STEP + + nrg = nrg + 1 + XV(nrg) = xend + UV(nrg) = 1 + SV(nrg) = -STEP +pop_ + # Pop parser stack. + if (lev > 0) + if (token[lev] == '!') { + # Invert a series of breakpoints. + do i = tokval[lev], nrg { + if (SV(i) == STEP) # invert + SV(i) = -ZERO + else if (SV(i) == -STEP) + SV(i) = ZERO + else if (SV(i) == ZERO) # undo + SV(i) = -STEP + else if (SV(i) == -ZERO) + SV(i) = STEP + } + lev = lev - 1 + } + } + } + + # If the first range entered by the user is an exclude range, + # e.g., "(!N)" or "(!(expr))" this implies that all other values + # are acceptable. Add the open range ":" to the end of the range + # list to indicate this, i.e., convert "!N" to ":,!N". + + if (SV(1) == -ZERO) { + nrg = nrg + 1 + XV(nrg) = LEFT$T + UV(nrg) = 0 + SV(nrg) = STEP + + nrg = nrg + 1 + XV(nrg) = RIGHT$T + UV(nrg) = 1 + SV(nrg) = -STEP + } + + # Sort the breakpoint list. + do j = 1, nrg { + xmin = XV(j); umin = UV(j) + jval = j + do i = j+1, nrg { + $if (datatype == rd) + bval = (XV(i) < xmin) + if (!bval) + if (abs (XV(i) - xmin) < 1.0E-5) + bval = (fp_equal$t(XV(i),xmin) && UV(i) < umin) + if (bval) { + $else + if (XV(i) < xmin || (XV(i) == xmin && UV(i) < umin)) { + $endif + xmin = XV(i); umin = UV(i) + jval = i + } + } + if (jval != j) { + temp = XV(j); XV(j) = XV(jval); XV(jval) = temp + itemp = UV(j); UV(j) = UV(jval); UV(jval) = itemp + itemp = SV(j); SV(j) = SV(jval); SV(jval) = itemp + } + } + + # Initialize the output arrays if they were passed in as null. + if (xlen <= 0) { + xlen = DEF_XLEN + call malloc (xs, xlen, TY_PIXEL) + call malloc (xe, xlen, TY_PIXEL) + } + + # Collapse sequences of redundant breakpoints into a single + # breakpoint, clipping the running sum value to the range 0-1. + # Accumulate and output successive nonzero ranges. + + op = 1 + ov = 0 + y = 0 + + for (r1=1; r1 <= nrg; r1=r2+1) { + # Get a range of breakpoint entries for a single XV position. + for (r2=r1; r2 <= nrg; r2=r2+1) { + $if (datatype == si) + if (XV(r2) != XV(r1)) + break + $else + bval = (UV(r2) != UV(r1)) + if (!bval) { + bval = (abs (XV(r2) - XV(r1)) > 1.0E-5) + if (!bval) + bval = !fp_equal$t(XV(r2),XV(r1)) + } + if (bval) + break + $endif + } + r2 = r2 - 1 + + # Collapse into a single breakpoint. + x = XV(r1) + dy = SV(r1) + do i = r1 + 1, r2 + dy = dy + SV(i) + y = y + dy + + # Clip value to the range 0-1. + v = max(0, min(1, y)) + + # Accumulate a range of nonzero value. This eliminates redundant + # points lying within a range which is already set high. + + if (v == 1 && ov == 0) { + n_xs = x + ov = 1 + } else if (v == 0 && ov == 1) { + $if (datatype == si) + if (IS_RIGHT$T(x)) + n_xe = x + else + n_xe = x - 1 + $else + n_xe = x + $endif + ov = 2 + } + + # Output a range. + if (ov == 2) { + if (op > xlen) { + xlen = xlen + INC_XLEN + call realloc (xs, xlen, TY_PIXEL) + call realloc (xe, xlen, TY_PIXEL) + } + + Mem$t[xs+op-1] = n_xs + Mem$t[xe+op-1] = n_xe + op = op + 1 + + ov = 0 + } + } + + # All done; discard breakpoint buffers. + call mfree (xv, TY_PIXEL) + call mfree (uv, TY_INT) + call mfree (sv, TY_INT) + + return (op - 1) +end -- cgit