Initial commit

1 files changed, 316 insertions, 0 deletions

diff --git a/pkg/proto/fields.x b/pkg/proto/fields.x
new file mode 100644
index 00000000..df700626
--- /dev/null
+++ b/pkg/proto/fields.x
@@ -0,0 +1,316 @@
+include <ctype.h>
+
+define	MAX_RANGES	100
+define 	MAX_FIELDS	100
+define 	MAX_LINES	10000
+define	LEN_WS		3
+
+# FIELDS -- Extract whitespace delimited fields from specified lines of 
+# an input list.  A new list consisting of the extracted fields is output.
+# Which lines and fields to extract is specified by the user.
+
+procedure t_fields ()
+
+pointer	sp, f_str, l_str, fin
+bool	quit, name
+int	list, fields[MAX_FIELDS], lines[3, MAX_LINES], nfields, nlines
+int	ranges[3,MAX_RANGES], nranges
+
+bool	clgetb()
+int	decode_ranges(), fi_decode_ranges(), clpopni(), clgfil()
+
+begin
+	# Allocate space on stack for char buffers
+	call smark (sp)
+	call salloc (f_str,  SZ_LINE, TY_CHAR)
+	call salloc (l_str,  SZ_LINE, TY_CHAR)
+	call salloc (fin,    SZ_LINE, TY_CHAR)
+
+	# Open template of input files
+	list = clpopni ("files")
+
+	# Get boolean parameters
+	quit = clgetb ("quit_if_missing")
+	name = clgetb ("print_file_names")
+
+	# Get the lines and fields to be extracted.  Decode ranges.
+	call clgstr ("fields", Memc[f_str], SZ_LINE)
+	call clgstr ("lines",  Memc[l_str], SZ_LINE)
+
+	# Don't impose ordering on field specification
+	if (fi_decode_ranges (Memc[f_str], ranges, MAX_RANGES, 1, 
+	    MAX_FIELDS, nranges) == ERR) {
+	    call error (0, "Error in field specification")
+	} else
+	    call fi_xpand (ranges, fields, nfields)
+
+	# Lines range will be accessed in ascending order
+	if (decode_ranges (Memc[l_str], lines, MAX_LINES, nlines) == ERR) 
+	    call error (0, "Error in line specification")
+
+	# While list of input files is not depleted, extract fields
+	while (clgfil (list, Memc[fin], SZ_FNAME) != EOF) 
+	    call fi_xtract (Memc[fin], lines, fields, nfields, quit, name)
+
+	call clpcls (list)
+	call sfree (sp)
+end
+
+
+# FI_XPAND -- expands the output from decode_ranges into an array.
+# The output array contains the ordinal of each element in the range; 
+# no ordering is imposed.
+
+procedure fi_xpand (ranges, out, num)
+
+int	ranges[3*MAX_RANGES] 		# Input ranges array
+int     out[MAX_LINES]			# Output unordered list
+int	num				# Number of entries in output list
+
+int	ip, number
+int	first, last, step
+
+begin
+
+	num = 0
+	for (ip=1; ranges[ip] != NULL; ip=ip+3) {
+	    first = ranges[ip]
+	    last = ranges[ip+1]
+	    step = ranges[ip+2]
+
+	    if (first == last) {
+		num = num + 1
+		out[num] = first
+		next
+	    }
+
+	    if (first > last)
+		step = -1 * step
+	    do number = first, last, step {
+		num = num + 1
+		out[num] = number
+	    }
+	}
+end
+
+
+# FI_DECODE_RANGES -- Parse a string containing a list of integer numbers or
+# ranges, delimited by either spaces or commas.  Return as output a list
+# of ranges defining a list of numbers, and the count of list numbers.
+# Range limits must be positive nonnegative integers.  ERR is returned as
+# the function value if a conversion error occurs.  The list of ranges is
+# delimited by a single NULL.
+
+int procedure fi_decode_ranges (range_string, ranges, max_ranges, minimum,
+    maximum, nvalues)
+
+char	range_string[SZ_LINE]	# Range string to be decoded
+int	ranges[3, max_ranges]	# Range array
+int	max_ranges		# Maximum number of ranges
+int	minimum, maximum	# Minimum and maximum range values allowed
+int	nvalues			# The number of values in the ranges
+
+int	ip, nrange, a, b, first, last, step, ctoi()
+
+begin
+	ip = 1
+	nrange = 1
+	nvalues = 0
+
+	while (nrange < max_ranges) {
+	    # Default values
+	    a = minimum
+	    b = maximum
+	    step = 1
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get first limit.
+	    # Must be a number, '-', 'x', or EOS.  If not return ERR.
+	    if (range_string[ip] == EOS) {			# end of list
+		if (nrange == 1) {
+		    # Null string defaults
+		    ranges[1, 1] = a
+		    ranges[2, 1] = b
+		    ranges[3, 1] = step
+		    ranges[1, 2] = NULL
+	    	    nvalues = (b - a) / step + 1
+		    return (OK)
+		} else {
+		    ranges[1, nrange] = NULL
+		    return (OK)
+		}
+	    } else if (range_string[ip] == '-')
+		;
+	    else if (range_string[ip] == 'x')
+		;
+	    else if (IS_DIGIT(range_string[ip])) {		# ,n..
+		if (ctoi (range_string, ip, a) == 0)
+		    return (ERR)
+	    } else
+		return (ERR)
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get last limit
+	    # Must be '-', or 'x' otherwise b = a.
+	    if (range_string[ip] == 'x')
+		;
+	    else if (range_string[ip] == '-') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, b) == 0)
+		        return (ERR)
+		} else if (range_string[ip] == 'x')
+		    ;
+		else
+		    return (ERR)
+	    } else
+		b = a
+
+	    # Skip delimiters
+	    while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		ip = ip + 1
+
+	    # Get step.
+	    # Must be 'x' or assume default step.
+	    if (range_string[ip] == 'x') {
+		ip = ip + 1
+	        while (IS_WHITE(range_string[ip]) || range_string[ip] == ',')
+		    ip = ip + 1
+		if (range_string[ip] == EOS)
+		    ;
+		else if (IS_DIGIT(range_string[ip])) {
+		    if (ctoi (range_string, ip, step) == 0)
+		        ;
+		} else if (range_string[ip] == '-')
+		    ;
+		else
+		    return (ERR)
+	    }
+
+	    # Output the range triple.
+	    first = a
+	    last = b
+	    ranges[1, nrange] = first
+	    ranges[2, nrange] = last
+	    ranges[3, nrange] = step
+	    nvalues = nvalues + abs (last - first) / step + 1
+	    nrange = nrange + 1
+	}
+
+	return (ERR)					# ran out of space
+end
+
+
+# FI_XTRACT -- filter out lines from which fields are to be extracted.
+# Called once per input file, FI_XTRACT calls FI_PRECORD to process
+# each extracted line.
+
+procedure fi_xtract (in_fname, lines, fields, nfields, quit, name)
+
+char	in_fname[SZ_FNAME]		# Input file name
+int	lines[3,MAX_LINES]		# Ranges of lines to be extracted
+int	fields[MAX_FIELDS]		# Fields to be extracted
+int	nfields				# Number of fields to extract
+bool	quit				# Quit if missing field (y/n)?
+bool	name				# Print file name in each line (y/n)?
+
+pointer	sp, lbuf
+int	in, in_line
+
+bool	is_in_range()
+int	open(), getlongline()
+errchk	salloc, open, getlongline, fi_precord
+
+begin
+	# Allocate space for line buffer
+	call smark (sp)
+	call salloc (lbuf, SZ_LINE, TY_CHAR)
+
+	# Open input file
+	in = open (in_fname, READ_ONLY, TEXT_FILE)
+
+	# Position to specified input line
+	in_line = 0
+	repeat {
+	    repeat {
+	        if (getlongline (in, Memc[lbuf], SZ_LINE, in_line) == EOF) {
+		    call close (in)
+		    call sfree (sp)
+	            return
+		}
+	    } until (is_in_range (lines, in_line))
+
+	    call fi_precord (in_fname, Memc[lbuf], fields, nfields, quit, name)
+	}	
+
+	call close (in)
+	call sfree (sp)
+end
+
+
+# FI_PRECORD -- extract and output a record of fields.
+
+procedure fi_precord (in_fname, linebuf, fields, nfields, quit, name)
+
+char	in_fname[SZ_FNAME]		# Name of input file
+int	linebuf[SZ_LINE]		# Line containing fields
+int	fields[MAX_FIELDS]		# List of fields to extract
+int	nfields				# Number of fields to extract
+bool	quit				# Quit if missing field (y/n)?
+bool	name				# Print name in output line (y/n)?
+
+char	word[SZ_LINE], white_space[LEN_WS]
+int	ip, in_field, out_field, i
+
+int	ctowrd()
+errchk	ctowrd
+
+begin
+	# Fill white space array to be used a field delimeter
+	do i = 1, LEN_WS
+	    call strcpy (" ", white_space[i], 1)
+
+	# Print file name as first field of output list?
+	if (name) {
+	    call printf ("%s%s")
+		call pargstr (in_fname)
+	        call pargstr (white_space)
+	}
+
+	# Position to specific field
+	for (i=1; i <= nfields; i=i+1) {
+	    out_field = fields[i]
+	    in_field = 0
+	    ip = 1
+
+	    repeat {
+		if (ctowrd (linebuf, ip, word, SZ_LINE) == 0) {
+		    if (quit) {
+			call eprintf ("Missing field in input. FILE: %s\n")
+			call pargstr (in_fname)
+			call error (0, "Missing field")
+		    } else {
+			call printf ("\n")
+			return
+		    }
+		} else
+		    in_field = in_field + 1
+	    } until (in_field == out_field)
+
+	    call printf ("%s%s")
+		call pargstr (word)
+	        call pargstr (white_space)
+	}
+
+	call printf ("\n")
+end