diff options
Diffstat (limited to 'pkg/bench/xctest')
| -rw-r--r-- | pkg/bench/xctest/README | 2 | ||||
| -rw-r--r-- | pkg/bench/xctest/columns.x | 74 | ||||
| -rw-r--r-- | pkg/bench/xctest/lintran.x | 370 | ||||
| -rw-r--r-- | pkg/bench/xctest/mkpkg | 25 | ||||
| -rw-r--r-- | pkg/bench/xctest/table.x | 111 | ||||
| -rw-r--r-- | pkg/bench/xctest/tokens.x | 140 | ||||
| -rw-r--r-- | pkg/bench/xctest/unique.x | 46 | ||||
| -rw-r--r-- | pkg/bench/xctest/words.x | 44 | ||||
| -rw-r--r-- | pkg/bench/xctest/x_lists.x | 10 |
9 files changed, 822 insertions, 0 deletions
diff --git a/pkg/bench/xctest/README b/pkg/bench/xctest/README new file mode 100644 index 00000000..724ec929 --- /dev/null +++ b/pkg/bench/xctest/README @@ -0,0 +1,2 @@ +This directory is an example of a small IRAF package, used to benchmark the +time required to compile and link a small package. diff --git a/pkg/bench/xctest/columns.x b/pkg/bench/xctest/columns.x new file mode 100644 index 00000000..ee52abc5 --- /dev/null +++ b/pkg/bench/xctest/columns.x @@ -0,0 +1,74 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include <chars.h> +include <error.h> + +define MAX_FILES 12 + +.help columns +.nf___________________________________________________________________ +COLUMNS -- convert a multicolumn file into a multifile column. + One file `sdastemp.n' is produced with each column in a + Separate file. + +usage: COLUMNS number_of_columns File_name +.endhelp______________________________________________________________ + + +# COLUMNS.X -- SDAS support utility +# +# This routine allows SDAS to treat multicolumn tables +# as simple CL lists. Each column in the table is referenced in +# SDAS by a different parameter, pointing in the .par file to +# a different list. This routine is a preprocessor which takes +# a multicolumn file and generates a multifile column. +# +# To allow for column headers in the multicolumn file, +# any line which begins with a `#' will be ignored. +# All data is transferred as text. + +procedure t_columns() + +char fname[SZ_FNAME], outfile[SZ_FNAME], outroot[SZ_FNAME] +char line[SZ_LINE], word[SZ_LINE], filenum[SZ_FNAME] +int numcols, infile +int outnum[MAX_FILES] +int nchar, nfile, ip +int clgeti(), open(), getline(), itoc(), ctowrd() +errchk open, getline + +begin + + # Get the number of columns and the input file name + call clgstr ("filename", fname, SZ_FNAME) + numcols = clgeti ("numcols") + call clgstr ("outroot", outroot, SZ_FNAME) + + # Open all the files + infile = open (fname, READ_ONLY, TEXT_FILE) + for (nfile=1; nfile <= numcols; nfile=nfile+1) { + nchar = itoc (nfile, filenum, 2) + call strcpy ( outroot, outfile, SZ_FNAME) + call strcat ( filenum, outfile, SZ_FNAME) + outnum[nfile] = open (outfile, NEW_FILE, TEXT_FILE) + } + + # Separate each line of the input file + while (getline(infile, line) != EOF) { + if ((line[1] != '#') && (line[1] != '\n')) { + ip = 1 + for (nfile=1; nfile <= numcols; nfile=nfile+1) { + nchar = ctowrd (line, ip, word, SZ_LINE) + call strcat ('\n',word, SZ_LINE) + call putline (outnum[nfile], word) + } + } + } + + # close the files + call close(infile) + for (nfile=1; nfile <= numcols; nfile=nfile+1) { + call close(outnum[nfile]) + } +end diff --git a/pkg/bench/xctest/lintran.x b/pkg/bench/xctest/lintran.x new file mode 100644 index 00000000..fe0ffdbc --- /dev/null +++ b/pkg/bench/xctest/lintran.x @@ -0,0 +1,370 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <pattern.h> +include <ctype.h> + +define MAX_FIELDS 100 # Maximum number of fields in list +define TABSIZE 8 # Spacing of tab stops +define LEN_TR 9 # Length of structure TR + +# The TR transformation descriptor structure. + +define X1 Memr[P2R($1)] # Input origin +define Y1 Memr[P2R($1+1)] +define XSCALE Memr[P2R($1+2)] # Scale factors +define YSCALE Memr[P2R($1+3)] +define THETA Memr[P2R($1+4)] # Rotation angle +define X2 Memr[P2R($1+5)] # Output origin +define Y2 Memr[P2R($1+6)] +define COS_THETA Memr[P2R($1+7)] +define SIN_THETA Memr[P2R($1+8)] + + +# LINTRAN -- Performs a linear translation on each element of the +# input list, producing a transformed list as output. + +procedure t_lintran() + +char in_fname[SZ_FNAME] +int list +pointer sp, tr +int xfield, yfield, min_sigdigits + +int clgeti(), clpopni(), clgfil() + +begin + # Allocate memory for transformation parameters structure + call smark (sp) + call salloc (tr, LEN_TR, TY_STRUCT) + + # Call procedure to get parameters and fill structure + call lt_initialize_transform (tr) + + # Get field numbers from cl + xfield = clgeti ("xfield") + yfield = clgeti ("yfield") + min_sigdigits = clgeti("min_sigdigits") + + # Open template of input files + list = clpopni ("files") + + # While input list is not depleted, open file and transform list + while (clgfil (list, in_fname, SZ_FNAME) != EOF) + call lt_transform_file (in_fname, xfield, yfield, min_sigdigits, tr) + + # Close template + call clpcls (list) + call sfree (sp) +end + + +# LT_INITIALIZE_TRANSFORM -- gets parameter values relevant to the +# transformation from the cl. List entries will be transformed +# in procedure lt_transform. Scaling is performed +# first, followed by translation and then rotation. + +procedure lt_initialize_transform (tr) + +pointer tr + +bool clgetb() +real clgetr() + +begin + # Get parameters from cl + X1(tr) = clgetr ("x1") # (x1,y1) = crnt origin + Y1(tr) = clgetr ("y1") + XSCALE(tr) = clgetr ("xscale") + YSCALE(tr) = clgetr ("yscale") + THETA(tr) = clgetr ("angle") + if (! clgetb ("radians")) + THETA(tr) = THETA(tr) / 57.29577951 + X2(tr) = clgetr ("x2") # (x2,y2) = new origin + Y2(tr) = clgetr ("y2") + + # The following terms are constant for a given transformation. + # They are calculated once and saved in the structure. + + COS_THETA(tr) = cos (THETA(tr)) + SIN_THETA(tr) = sin (THETA(tr)) +end + + +# LT_TRANSFORM_FILE -- This procedure is called once for each file +# in the input list. For each line in the input file that isn't +# blank or comment, the line is transformed. Blank and comment +# lines are output unaltered. + +procedure lt_transform_file (in_fname, xfield, yfield, min_sigdigits, tr) + +char in_fname[ARB] +int xfield, yfield +pointer tr + +char outbuf[SZ_LINE] +int nfields, nchars, max_fields, in, nline +int nsdig_x, nsdig_y, offset, min_sigdigits +pointer sp, field_pos, linebuf, inbuf, ip +double x, y, xt, yt +int getline(), lt_get_num(), open() + +begin + call smark (sp) + call salloc (inbuf, SZ_LINE, TY_CHAR) + call salloc (linebuf, SZ_LINE, TY_CHAR) + call salloc (field_pos, MAX_FIELDS, TY_INT) + + max_fields = MAX_FIELDS + + # Open input file + in = open (in_fname, READ_ONLY, TEXT_FILE) + + for (nline=1; getline (in, Memc[inbuf]) != EOF; nline = nline + 1) { + for (ip=inbuf; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == '#') { + # Pass comment lines on to the output unchanged. + call putline (STDOUT, Memc[inbuf]) + next + } else if (Memc[ip] == '\n' || Memc[ip] == EOS) { + # Blank lines too. + call putline (STDOUT, Memc[inbuf]) + next + } + + # Expand tabs into blanks, determine field offsets. + call strdetab (Memc[inbuf], Memc[linebuf], SZ_LINE, TABSIZE) + call lt_find_fields (Memc[linebuf], Memi[field_pos], + max_fields, nfields) + + if (xfield > nfields || yfield > nfields) { + call eprintf ("Not enough fields in file '%s', line %d\n") + call pargstr (in_fname) + call pargi (nline) + call putline (STDOUT, Memc[linebuf]) + next + } + + offset = Memi[field_pos + xfield-1] + nchars = lt_get_num (Memc[linebuf+offset-1], x, nsdig_x) + if (nchars == 0) { + call eprintf ("Bad x value in file '%s' at line %d:\n") + call pargstr (in_fname) + call pargi (nline) + call putline (STDOUT, Memc[linebuf]) + next + } + + offset = Memi[field_pos + yfield-1] + nchars = lt_get_num (Memc[linebuf+offset-1], y, nsdig_y) + if (nchars == 0) { + call eprintf ("Bad y value in file '%s' at line %d:\n") + call pargstr (in_fname) + call pargi (nline) + call putline (STDOUT, Memc[linebuf]) + next + } + + call lt_transform (x, y, xt, yt, tr) + + call lt_pack_line (Memc[linebuf], outbuf, SZ_LINE, Memi[field_pos], + nfields, xfield, yfield, xt, yt, nsdig_x, nsdig_y, min_sigdigits) + + call putline (STDOUT, outbuf) + } + + call sfree (sp) + call close (in) +end + + +# LT_FIND_FIELDS -- This procedure finds the starting column for each field +# in the input line. These column numbers are returned in the array +# field_pos; the number of fields is also returned. + +procedure lt_find_fields (linebuf, field_pos, max_fields, nfields) + +char linebuf[SZ_LINE] +int field_pos[max_fields],max_fields, nfields +bool in_field +int ip, field_num + +begin + field_num = 1 + field_pos[1] = 1 + in_field = false + + for (ip=1; linebuf[ip] != '\n' && linebuf[ip] != EOS; ip=ip+1) { + if (! IS_WHITE(linebuf[ip])) + in_field = true + else if (in_field) { + in_field = false + field_num = field_num + 1 + field_pos[field_num] = ip + } + } + + field_pos[field_num+1] = ip + nfields = field_num +end + + +# LT_GET_NUM -- The field entry is converted from character to double +# in preparation for the transformation. The number of significant +# digits is counted and returned as an argument; the number of chars in +# the number is returned as the function value. + +int procedure lt_get_num (linebuf, dval, nsdig) + +char linebuf[SZ_LINE] +int nsdig +double dval +char ch +int nchar, ip + +int gctod() + +begin + ip = 1 + nsdig = 0 + nchar = gctod (linebuf, ip, dval) + if (nchar == 0 || IS_INDEFD (dval)) + return (nchar) + + # Skip leading white space. + ip = 1 + repeat { + ch = linebuf[ip] + if (! IS_WHITE(ch)) + break + ip = ip + 1 + } + + # Count signifigant digits + for (; ! IS_WHITE(ch) && ch != '\n' && ch != EOS; ch=linebuf[ip]) { + if (IS_DIGIT (ch)) + nsdig = nsdig + 1 + ip = ip + 1 + } + return (nchar) +end + + +# LT_TRANSFORM -- The linear transformation is performed in this procedure. +# First the coordinates are scaled, then rotated and translated. The +# transformed coordinates are returned. + +procedure lt_transform (x, y, xt, yt, tr) + +double x, y, xt, yt +pointer tr +double xtemp, ytemp + +begin + # Subtract off current origin: + if (IS_INDEFD (x)) + xt = INDEFD + else { + xt = x - X1(tr) + } + if (IS_INDEFD (y)) + yt = INDEFD + else { + yt = y - Y1(tr) + } + + # Scale and rotate coordinates: + if (THETA(tr) == 0) { + if (!IS_INDEFD (xt)) + xt = xt * XSCALE(tr) + X2(tr) + if (!IS_INDEFD (yt)) + yt = yt * YSCALE(tr) + Y2(tr) + return + + } else if (IS_INDEFD(xt) || IS_INDEFD(yt)) { + # Non-zero angle and either coordinate indefinite results in + # both transformed coordinates = INDEFD + xt = INDEFD + yt = INDEFD + return + } + + # Rotation for non-zero angle and both coordinates defined + xtemp = xt * XSCALE(tr) + ytemp = yt * YSCALE(tr) + + xt = xtemp * COS_THETA(tr) - ytemp * SIN_THETA(tr) + yt = xtemp * SIN_THETA(tr) + ytemp * COS_THETA(tr) + + # Now shift the rotated coordinates + xt = xt + X2(tr) + yt = yt + Y2(tr) +end + + +# LT_PACK_LINE -- Fields are packed into the outbuf buffer. Transformed +# fields are converted to strings; other fields are copied from +# the input line to output buffer. + +procedure lt_pack_line (inbuf, outbuf, maxch, field_pos, nfields, + xfield, yfield, xt, yt, nsdig_x, nsdig_y, min_sigdigits) + +char inbuf[ARB], outbuf[maxch] +int maxch, field_pos[ARB], nfields, xfield, yfield, nsdig_x, nsdig_y +int min_sigdigits +double xt, yt + +char field[SZ_LINE] +int num_field, width, op + +int gstrcpy() + +begin + # Initialize output pointer. + op = 1 + + do num_field = 1, nfields { + width = field_pos[num_field + 1] - field_pos[num_field] + + if (num_field == xfield) { + call lt_format_field (xt, field, maxch, nsdig_x, width, + min_sigdigits) + } else if (num_field == yfield) { + call lt_format_field (yt, field, maxch, nsdig_y, width, + min_sigdigits) + } else { + # Put "width" characters from inbuf into field + call strcpy (inbuf[field_pos[num_field]], field, width) + } + + # Fields must be delimited by at least one blank. + if (num_field > 1 && !IS_WHITE (field[1])) { + outbuf[op] = ' ' + op = op + 1 + } + + # Copy "field" to output buffer. + op = op + gstrcpy (field, outbuf[op], maxch) + } + + outbuf[op] = '\n' + outbuf[op+1] = EOS +end + + +# LT_FORMAT_FIELD -- A transformed coordinate is written into a string +# buffer. The output field is of (at least) the same width and significance +# as the input list entry. + +procedure lt_format_field (dval, wordbuf, maxch, nsdig, width, min_sigdigits) + +char wordbuf[maxch] +int width, nsdig, maxch, min_sigdigits +double dval + +begin + call sprintf (wordbuf, maxch, "%*.*g") + call pargi (width) + call pargi (max (min_sigdigits, nsdig)) + call pargd (dval) +end diff --git a/pkg/bench/xctest/mkpkg b/pkg/bench/xctest/mkpkg new file mode 100644 index 00000000..87b4c792 --- /dev/null +++ b/pkg/bench/xctest/mkpkg @@ -0,0 +1,25 @@ +# Make the LISTS package + +$call relink +$exit + +relink: + $set LIBS = "-lxtools" + + $update libpkg.a + $omake x_lists.x + $link x_lists.o libpkg.a $(LIBS) + ; + +clean: + $delete libpkg.a x_lists.o x_lists.e + ; + +libpkg.a: + table.x <ctype.h> + words.x + tokens.x <ctotok.h> + unique.x + lintran.x <pattern.h> <ctype.h> + columns.x <ctype.h> <chars.h> <error.h> + ; diff --git a/pkg/bench/xctest/table.x b/pkg/bench/xctest/table.x new file mode 100644 index 00000000..75e0a3e3 --- /dev/null +++ b/pkg/bench/xctest/table.x @@ -0,0 +1,111 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> + +# Read a list of strings from the standard input or a list of files and +# assemble them into a nicely formatted table. If reading from multiple +# input files, make a separate table for each. There is no fixed limit +# to the size of the table which can be formatted. The table is not +# sorted; this should be done as a separate operation if desired. + +define INIT_STRBUF 512 +define STRBUF_INCREMENT 1024 +define INIT_MAXSTR 64 +define MAXSTR_INCREMENT 128 + + +procedure t_table() + +int list, first_col, last_col, ncols, maxstrlen +int fd, nextch, nstrings, maxch, sz_strbuf, max_strings, ip +pointer sp, strbuf, fname, stroff +int strlen(), fscan(), nscan(), clpopni() +int clgfil(), open(), envgeti(), clplen(), clgeti() + +begin + # Allocate buffers. The string buffer "strbuf", and associated list + # of offsets "stroff" will be reallocated later if they fill up. + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + call malloc (strbuf, INIT_STRBUF, TY_CHAR) + call malloc (stroff, INIT_MAXSTR, TY_INT) + + + # Get various table formatting parameters from CL. + ncols = clgeti ("ncols") + first_col = clgeti ("first_col") + last_col = clgeti ("last_col") + + # Attempt to read the terminal x-dimension from the environment, + # if the user did not specify a valid "last_col". No good reason + # to abort if cannot find environment variable. + if (last_col == 0) + iferr (last_col = envgeti ("ttyncols")) + last_col = 80 + + # Set maximum string length to size of an output line if max length + # not given. + maxstrlen = clgeti ("maxstrlen") + if (maxstrlen == 0) + maxch = last_col - first_col + 1 + else + maxch = min (maxstrlen, last_col - first_col + 1) + + max_strings = INIT_MAXSTR + sz_strbuf = INIT_STRBUF + + + # Read the contents of each file into a big string buffer. Print a + # separate table for each file. + + list = clpopni ("input_files") + + while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) { + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + nextch = 1 + nstrings = 0 + + # If printing several tables, label each with the name of the file. + if (clplen (list) > 1) { + call printf ("\n==> %s <==\n") + call pargstr (Memc[fname]) + } + + while (fscan (fd) != EOF) { + call gargstr (Memc[strbuf+nextch-1], maxch) + # Ignore blank lines and faulty scans. + if (nscan() == 0) + next + for (ip=strbuf+nextch-1; IS_WHITE (Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == '\n' || Memc[ip] == EOS) + next + + # Save one indexed string index for strtbl. + Memi[stroff+nstrings] = nextch + nextch = nextch + strlen (Memc[strbuf+nextch-1]) + 1 + + # Check buffers, make bigger if necessary. + if (nextch + maxch >= sz_strbuf) { + sz_strbuf = sz_strbuf + STRBUF_INCREMENT + call realloc (strbuf, sz_strbuf, TY_CHAR) + } + # Add space for more string offsets if too many strings. + nstrings = nstrings + 1 + if (nstrings > max_strings) { + max_strings = max_strings + MAXSTR_INCREMENT + call realloc (stroff, max_strings, TY_INT) + } + } + + # Print the table on the standard output. + call strtbl (STDOUT, Memc[strbuf], Memi[stroff], nstrings, + first_col, last_col, maxch, ncols) + } + + call clpcls (list) + call mfree (strbuf, TY_CHAR) + call mfree (stroff, TY_INT) + call sfree (sp) +end diff --git a/pkg/bench/xctest/tokens.x b/pkg/bench/xctest/tokens.x new file mode 100644 index 00000000..c8793748 --- /dev/null +++ b/pkg/bench/xctest/tokens.x @@ -0,0 +1,140 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctotok.h> + +.help tokens +.nf ___________________________________________________________________________ +TOKENS -- Break the input up into a series of tokens. The makeup of the +various tokens is defined by the FMTIO primitive ctotok, which is not very +sophisticated, and does not claim to recognize the tokens for any particular +language (though it does reasonably well for most modern languages). Comments +can be deleted if desired, and newlines may be passed on to the output as +tokens. + +Comments are delimited by user specified strings. Only strings which are also +recognized by ctotok() as legal tokens may be used as comment delimiters. +If newline marks the end of a comment, the end_comment string should be given +as "eol". Examples of acceptable comment conventions are ("#", eol), +("/*", "*/"), ("{", "}"), and ("!", eol). Fortran style comments ("^{c}",eol) +can be stripped by filtering with match beforehand. + +Each token is passed to the output on a separate line. Multiple newline +tokens are compressed to a single token (a blank line). If newline is not +desired as an output token, it is considered whitespace and serves only to +delimit tokens. +.endhelp ______________________________________________________________________ + +define SZ_COMDELIMSTR 20 # Comment delimiter string. + +procedure t_tokens() + +bool ignore_comments, comment_delimiter_is_eol +bool in_comment, pass_newlines +char begin_comment[SZ_COMDELIMSTR], end_comment[SZ_COMDELIMSTR] +int fd, list, token, last_token, last_nscan +pointer sp, fname, tokbuf, outstr, ip, op + +bool streq(), clgetb() +int clpopni(), clgfil(), fscan(), nscan(), open(), ctocc() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (tokbuf, SZ_LINE, TY_CHAR) + call salloc (outstr, SZ_LINE, TY_CHAR) + + # If comments are to be ignored, get comment delimiters. + ignore_comments = clgetb ("ignore_comments") + if (ignore_comments) { + call clgstr ("begin_comment", begin_comment, SZ_COMDELIMSTR) + call clgstr ("end_comment", end_comment, SZ_COMDELIMSTR) + comment_delimiter_is_eol = streq (end_comment, "eol") + } else { + # Set begin_comment to null string to ensure that we never + # enter skip comment mode. This requires that we check for the + # EOS token before the begin_comment token below. + begin_comment[1] = EOS + } + + # Is newline a token? + pass_newlines = clgetb ("newlines") + + + # Merge all input files into a single stream of tokens on the standard + # output. + list = clpopni ("files") + + while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) { + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + last_token = NULL + + while (fscan (fd) != EOF) { + # Break input line into a stream of tokens. + repeat { + last_nscan = nscan() + call gargtok (token, Memc[tokbuf], SZ_LINE) + + # If "nscan" did not increment (actually impossible with + # gargtok) the line has been exhausted. + if (nscan() == last_nscan) + break + + # If busy ignoring a comment, check for delimiter. + if (in_comment) { + if (comment_delimiter_is_eol && + (token == TOK_NEWLINE || token == TOK_EOS)) { + in_comment = false + if (pass_newlines && last_token != TOK_NEWLINE) { + call printf ("\n") + last_token = TOK_NEWLINE + } + break + } else if (streq (Memc[tokbuf], end_comment)) { + in_comment = false + next + } else + next + } + + # If we get here, we are not processing a comment. + + if (token == TOK_NEWLINE) { + if (pass_newlines && last_token != TOK_NEWLINE) + call printf ("\n") + last_token = TOK_NEWLINE + break + + } else if (token == TOK_EOS) { + # EOS is not counted as a token (do not set last_token, + # do not generate any output). + break + + } else if (streq (Memc[tokbuf], begin_comment)) { + in_comment = true + # Do not change last_token, since comment token + # is to be ignored. + next + + } else if (token == TOK_STRING) { + # Convert control characters into printable + # sequences before printing string token. + op = outstr + for (ip=tokbuf; Memc[ip] != EOS; ip=ip+1) + op = op + ctocc (Memc[ip], Memc[op], SZ_LINE) + call printf ("\"%s\"\n") + call pargstr (Memc[outstr]) + + } else { # most tokens + call printf ("%s\n") + call pargstr (Memc[tokbuf]) + } + + last_token = token + } + } + call close (fd) + } + + call clpcls (list) + call sfree (sp) +end diff --git a/pkg/bench/xctest/unique.x b/pkg/bench/xctest/unique.x new file mode 100644 index 00000000..fcabfe00 --- /dev/null +++ b/pkg/bench/xctest/unique.x @@ -0,0 +1,46 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# UNIQUE -- Pass only unique lines from the (presumably sorted) standard +# input to the standard output. In other words, if a sequence of identical +# lines are found in the input, only one copy is passed to the output. + +procedure t_unique() + +int list, fd +pointer sp, fname, old_line, new_line, temp +bool streq() +int getline(), clpopni(), clgfil(), clplen(), open() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (old_line, SZ_LINE, TY_CHAR) + call salloc (new_line, SZ_LINE, TY_CHAR) + + list = clpopni ("files") + + while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) { + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + if (clplen (list) > 1) { + call printf ("\n\n==> %s <==\n") + call pargstr (Memc[fname]) + } + + Memc[old_line] = EOS + + while (getline (fd, Memc[new_line]) != EOF) { + if (streq (Memc[old_line], Memc[new_line])) + next + call putline (STDOUT, Memc[new_line]) + + # Swap buffers. + temp = old_line + old_line = new_line + new_line = temp + } + + call close (fd) + } + + call sfree (sp) +end diff --git a/pkg/bench/xctest/words.x b/pkg/bench/xctest/words.x new file mode 100644 index 00000000..42f4f97e --- /dev/null +++ b/pkg/bench/xctest/words.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# WORDS -- Break the input up into a series of words or strings. A word +# is a sequence of characters delimited by whitespace or newline. A string +# is delimited by single or double quotes, and may not span more than a single +# line. + +procedure t_words() + +int fd, list, last_nscan +pointer sp, fname, word +int clpopni(), clgfil(), fscan(), nscan(), open() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (word, SZ_LINE, TY_CHAR) + + list = clpopni ("files") + + while (clgfil (list, Memc[fname], SZ_FNAME) != EOF) { + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + + # We do not know how may "words" there are on a line; get words + # until no more. + while (fscan (fd) != EOF) + repeat { + # When nscan() does not increment after a call to gargwrd(), + # we are all done. + last_nscan = nscan() + call gargwrd (Memc[word], SZ_LINE) + if (nscan() > last_nscan) { + call printf ("%s\n") + call pargstr (Memc[word]) + } else + break + } + + call close (fd) + } + + call clpcls (list) + call sfree (sp) +end diff --git a/pkg/bench/xctest/x_lists.x b/pkg/bench/xctest/x_lists.x new file mode 100644 index 00000000..01229e61 --- /dev/null +++ b/pkg/bench/xctest/x_lists.x @@ -0,0 +1,10 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# Process configuration of the LISTS package. + +task table = t_table, + tokens = t_tokens, + unique = t_unique, + words = t_words, + lintran = t_lintran, + columns = t_columns |