Initial commit

1 files changed, 616 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/stxtools/vexcompile.y b/pkg/utilities/nttools/stxtools/vexcompile.y
new file mode 100644
index 00000000..4b2cd958
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/vexcompile.y
@@ -0,0 +1,616 @@
+%{
+
+include	<lexnum.h>
+include	<ctype.h>
+include <fset.h>
+include	"vex.h"
+
+define	YYMAXDEPTH	64
+define	YYOPLEN		1
+define	yyparse		vex_parse
+
+# Tokens generated by xyacc have been moved to vex.h
+
+%L
+
+%}
+
+%token		Y_WRONG Y_LPAR Y_RPAR Y_COMMA 
+%token		Y_VAR Y_INT Y_REAL Y_DOUBLE
+%token		Y_FN1 Y_FN2 Y_IF Y_THEN Y_ELSE Y_DONE 
+
+%left		Y_OR
+%left		Y_AND
+%right		Y_NOT
+%nonassoc	Y_EQ Y_NE
+%nonassoc	Y_LT Y_GT Y_LE Y_GE
+%left		Y_ADD Y_SUB
+%left		Y_MUL Y_DIV
+%right		Y_NEG
+%right		Y_POW
+
+%%
+
+stmt	:	ifexpr Y_DONE {
+			# Normal exit. Code a stop instruction
+			call vex_addcode (Y_DONE)
+			return (OK)
+		}
+	|	error {
+			return (ERR)
+		}
+	;
+
+ifexpr	:	Y_IF expr Y_THEN expr Y_ELSE ifexpr {
+			# Code an if instruction
+			call vex_addcode (Y_IF)
+		}
+	|	expr {
+			# Null action
+		}
+	;
+
+expr	:	Y_VAR {
+			# Code a push variable instruction
+			call vex_addcode (Y_VAR)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_INT {
+			# Code a push variable instruction
+			call vex_addcode (Y_INT)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_REAL {
+			# Code a push variable instruction
+			call vex_addcode (Y_REAL)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_DOUBLE {
+			# Code a push variable instruction
+			call vex_addcode (Y_DOUBLE)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_FN1 Y_LPAR expr Y_RPAR {
+			# Code a single argument function call
+			call vex_addcode (Y_FN1)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_FN2 Y_LPAR expr Y_COMMA expr Y_RPAR {
+			# Code a double argument function call
+			call vex_addcode (Y_FN2)
+			call vex_addstr (Memi[$1])
+		}
+	|	Y_SUB expr %prec Y_NEG {
+			# Code a negation instruction
+			call vex_addcode (Y_NEG)
+		}
+	|	Y_NOT expr {
+			# Code a logical not
+			call vex_addcode (Y_NOT)
+		}
+	|	expr Y_POW expr {
+			# Code an exponentiation instruction
+			call vex_addcode (Y_POW)
+		}
+	|	expr Y_MUL expr {
+			# Code a multiply instruction
+			call vex_addcode (Y_MUL)
+		}
+	|	expr Y_DIV expr {
+			# Code a divide instruction
+			call vex_addcode (Y_DIV)
+		}
+	|	expr Y_ADD expr {
+			# Code an addition instruction
+			call vex_addcode (Y_ADD)
+		}
+	|	expr Y_SUB expr {
+			# Code a subtraction instruction
+			call vex_addcode (Y_SUB)
+		}
+	|	expr Y_LT expr {
+			# Code a less than instruction
+			call vex_addcode (Y_LT)
+		}
+	|	expr Y_GT expr {
+			# Code a greater than instruction
+			call vex_addcode (Y_GT)
+		}
+	|	expr Y_LE expr {
+			# Code a less than or equal instruction
+			call vex_addcode (Y_LE)
+		}
+	|	expr Y_GE expr {
+			# Code a greater than instruction
+			call vex_addcode (Y_GE)
+		}
+	|	expr Y_EQ expr {
+			# Code a logical equality instruction
+			call vex_addcode (Y_EQ)
+		}
+	|	expr Y_NE expr {
+			# Code a logical inequality instruction
+			call vex_addcode (Y_NE)
+		}
+	|	expr Y_AND expr {
+			# Code a logical and instruction
+			call vex_addcode (Y_AND)
+		}
+	|	expr Y_OR expr {
+			# Code a logical or instruction
+			call vex_addcode (Y_OR)
+		}
+	|	Y_LPAR expr Y_RPAR {
+			# Null action
+		}
+	;
+
+%%
+
+# VEX_COMPILE -- Compile an expression, producing pseudocode
+#
+# This procedure takes a string containing a fortran expression and produces
+# pseudocode that can be evaluated by vex_eval(). The pseudocode is stored in
+# structure adressed by the pointer returned as the function value. This 
+# structure is freed by calling vex_free(). If the string begins with an @ 
+# symbol, the rest of the string is treated as a the name of a file which
+# contains the expression. The expression can contain all the fortran 
+# operators, including logical and relational operators and supports all the
+# fortran intrinsic functions which can take real arguments. It also supports
+# conditional expressions of the form: if <expr> then <expr> else <expr>
+# Variables must follow the fortran rules, and may be up to 31 characters long.
+# All variables and constants are treated as real numbers. A variable may
+# contain non-alphanumeric characters if it is preceded by a dollar sign, in
+# which case all characters until the next blank are part of the variable name.
+#
+# B.Simon	21-May-90	Original
+# B.Simon	19-Apr-91	Revised to handle multiple types
+# B.Simon	31-Mar-94	Better syntax error message
+# B.Simon	15-Oct-98	Embed strings in pseudocode
+
+pointer procedure vex_compile (expr)
+
+char	expr[ARB]	# i: Expression to be parsed
+#--
+include	"vex.com"
+
+int	ic, fd, len
+bool	debug
+pointer	sp, pcode
+
+data	debug	/ false /
+
+int	open(), stropen(), strlen(), fstati(), yyparse()
+
+int	vex_gettok ()
+extern	vex_gettok
+
+begin
+	# Open the expression as a file
+
+	for (ic = 1; IS_WHITE(expr[ic]); ic = ic + 1)
+	    ;
+
+	if (expr[ic] == '@') {
+	    fd = open (expr[ic+1], READ_ONLY, TEXT_FILE)
+	    len = fstati (fd, F_FILESIZE) + 1
+
+	} else {
+	    len = strlen (expr[ic]) + 1
+	    fd = stropen (expr[ic], len, READ_ONLY)
+	}
+
+	# Create pseudocode structure
+
+	call malloc (pcode, SZ_VEXSTRUCT, TY_STRUCT)
+
+	call malloc (VEX_CODE(pcode), 2 * len, TY_INT)
+	call stk_init (VEX_STACK(pcode))
+
+	# Initialize parsing common block
+
+	call smark (sp)
+	call salloc (line, SZ_LINE, TY_CHAR)
+
+	ch = line
+	Memc[line] = EOS
+
+	ncode = 0
+	maxcode = 2 * len
+	code = VEX_CODE(pcode)
+	stack = VEX_STACK(pcode)
+
+	# Parse expression to produce reverse polish code
+
+	if (yyparse (fd, debug, vex_gettok) == ERR) {
+	    call eprintf ("%s\n%*t^\n")
+	    call pargstr (Memc[line])
+	    call pargi (ch-line)
+
+	    call error (1, "Syntax error in expression")
+	}
+
+	# Clean up and return pseudocode structure
+
+	call stk_clear (VEX_STACK(pcode))
+
+	call close (fd)
+	call sfree (sp)
+	return (pcode)
+end
+
+# VEX_GETTOK -- Get the next token from the input
+
+int procedure vex_gettok (fd, value)
+
+int	fd		# i: File containing expression to be lexed
+pointer	value		# o: Address on parse stack to store token
+#--
+include	"vex.com"
+
+double	constant
+int	ic, jc, nc, type, index
+int	idftype[4], keytype[3], btype[9]
+pointer	sp, errmsg, token
+
+string  fn1tok	FN1STR
+string	fn2tok	FN2STR
+
+string	idftok	"indefi indefr indefd indef"
+data	idftype	/ Y_INT, Y_REAL, Y_DOUBLE, Y_REAL /
+
+string	keytok	"if then else"
+data	keytype	/ Y_IF, Y_THEN, Y_ELSE /
+
+string	btoken  ".or. .and. .eq. .ne. .lt. .gt. .le. .ge. .not."
+data	btype   / Y_OR, Y_AND, Y_EQ, Y_NE, Y_LT, Y_GT, Y_LE, Y_GE, Y_NOT /
+
+string	badsymb "Operator not recognized (%s)"
+
+int	getline(), lexnum(), ctod(), stridxs(), word_match()
+
+begin
+	# Allocate dynamic memory for strings
+
+	call smark (sp)
+	call salloc (errmsg, SZ_LINE, TY_CHAR)
+	call malloc (token, MAX_TOKEN, TY_CHAR)
+
+	# Skip over leading white space and comments
+
+	while (Memc[ch] <= BLANK || Memc[ch] == CMTCHAR) {
+
+	    # If all characters have been read from the current line 
+	    # or a comment character was found, get the next line
+
+	    if (Memc[ch] == EOS || Memc[ch] == CMTCHAR) {
+		ch = line
+		if (getline (fd, Memc[line]) == EOF) {
+		    Memc[ch] = EOS
+		    break
+		}
+	    } else {
+		ch = ch + 1
+	    }
+	}
+
+	# The token type is determined from the first character in the token
+
+	Memc[token] = EOS
+
+	# End of expression token
+
+	if (Memc[ch] == EOS) {
+	    type = Y_DONE
+
+	# Numeric constant is too difficult to parse,
+	# Pass the job to lexnum and ctod
+
+	} else if (IS_DIGIT(Memc[ch])) {
+
+	    ic = 1
+	    index = lexnum (Memc[ch], ic, nc)
+	    if (index != LEX_REAL) {
+		type = Y_INT
+	    } else if (nc > 8) {
+		type = Y_DOUBLE
+	    } else {
+		jc = stridxs ("dD", Memc[ch])
+		if (jc == 0 || jc > nc) {
+		    type = Y_REAL
+		} else {
+		    type = Y_DOUBLE
+		}
+	    }
+
+	    ic = 1
+	    nc = ctod (Memc[ch], ic, constant)
+	    nc = min (nc, MAX_TOKEN)
+
+	    call strcpy (Memc[ch], Memc[token], nc)
+	    ch = ch + ic - 1
+
+	# Token is alphanumeric. Determine what type of token
+
+	} else if (IS_ALPHA (Memc[ch])) {
+
+	    # Gather characters in token
+
+	    for (ic = 1; ic <= MAX_TOKEN; ic = ic + 1) {
+		if (Memc[ch] != '_' && ! IS_ALNUM(Memc[ch]))
+		    break
+
+		if (IS_UPPER(Memc[ch]))	
+		    Memc[token+ic-1] = TO_LOWER(Memc[ch])
+		else
+		    Memc[token+ic-1] = Memc[ch]
+		ch = ch + 1
+	    }
+	    Memc[token+ic-1] = EOS
+
+	    # Check to see if token is string "INDEF"
+
+	    index = word_match (Memc[token], idftok)
+
+	    if (index > 0) {
+		type = idftype[index]
+		call strupr (Memc[token])
+
+	    } else {
+
+		# Check to see if token is function or keyword name
+		# If not, add it as a new variable
+
+		index = word_match (Memc[token], fn1tok)
+		if (index > 0) {
+		    type = Y_FN1
+
+		} else {
+		    index = word_match (Memc[token], fn2tok)
+		    if (index > 0) {
+			type = Y_FN2
+
+		    } else {
+			index = word_match (Memc[token], keytok)
+			if (index > 0) {
+			    type = keytype[index]
+			    Memc[token] = EOS
+			} else {
+			    type = Y_VAR
+			}
+		    }
+		}
+	    }
+
+	# Tokens beginning with a dot are numbers or boolean operators
+
+	} else if (Memc[ch] == DOT) {
+
+	    if (IS_DIGIT (Memc[ch+1])) {
+		ic = 1
+		index = lexnum (Memc[ch], ic, nc)
+
+		if (index != LEX_REAL) {
+		    type = Y_INT
+		} else if (nc < 9) {
+		    type = Y_REAL
+		} else {
+		    type = Y_DOUBLE
+		}
+
+		ic = 1
+		nc = ctod (Memc[ch], ic, constant)
+		nc = min (nc, MAX_TOKEN)
+
+		call strcpy (Memc[ch], Memc[token], nc)
+		ch = ch + ic - 1
+
+	    } else {
+
+		# Gather characters in token
+
+		ch = ch + 1
+		Memc[token] = DOT
+		for (ic = 2; ic < MAX_TOKEN && Memc[ch] != DOT; ic = ic + 1) {
+		    if (Memc[ch] == EOS)
+			break
+		    if (IS_UPPER(Memc[ch]))	
+			Memc[token+ic-1] = TO_LOWER(Memc[ch])
+		    else
+			Memc[token+ic-1] = Memc[ch]
+		    ch = ch + 1
+		}
+
+		Memc[token+ic-1] = Memc[ch]
+		Memc[token+ic] = EOS
+		ch = ch + 1
+
+		index = word_match (Memc[token], btoken)
+		if (type > 0) {
+		    type = btype[index]
+		} else {
+		    call sprintf (Memc[errmsg], SZ_LINE, badsymb)
+		    call pargstr (Memc[token])
+		    call error (1, Memc[errmsg])
+		}
+	    }
+
+	# Characters preceded by a dollar sign are identifiers
+
+	} else if (Memc[ch] == DOLLAR) {
+
+	    ch = ch + 1
+	    for (ic = 1; ic <= MAX_TOKEN && Memc[ch] > BLANK; ic = ic + 1) {
+		if (IS_UPPER(Memc[ch]))	
+		    Memc[token+ic-1] = TO_LOWER(Memc[ch])
+		else
+		    Memc[token+ic-1] = Memc[ch]
+		ch = ch + 1
+	    }
+	    Memc[token+ic-1] = EOS
+
+	    type = Y_VAR
+
+	# Anything else is a symbol
+	
+	} else {
+	    switch (Memc[ch]) {
+	    case '*':
+		if (Memc[ch+1] != '*') {
+		    type = Y_MUL
+		} else {
+		    type = Y_POW
+		    ch = ch + 1
+		}
+	    case '/':
+		type = Y_DIV
+	    case '+':
+		type = Y_ADD
+	    case '-':
+		type = Y_SUB
+	    case '(':
+		type = Y_LPAR
+	    case ')':
+		type = Y_RPAR
+	    case ',':
+		type = Y_COMMA
+	    case '<':
+		if (Memc[ch+1] != '=') {
+		   type = Y_LT
+		} else {
+		   type = Y_LE
+		   ch = ch + 1
+		}
+	    case '>':
+		if (Memc[ch+1] != '=') {
+		   type = Y_GT
+		} else {
+		   type = Y_GE
+		   ch = ch + 1
+		}
+	    case '|':
+		if (Memc[ch+1] != '|') {
+		   type = Y_WRONG
+		} else {
+		   type = Y_OR
+		   ch = ch + 1
+		}
+	    case '&':
+		if (Memc[ch+1] != '&') {
+		   type = Y_WRONG
+		} else {
+		   type = Y_AND
+		   ch = ch + 1
+		}
+	    case '=':
+		if (Memc[ch+1] != '=') {
+		   type = Y_WRONG
+		} else {
+		   type = Y_EQ
+		   ch = ch + 1
+		}
+	    case '!':
+		if (Memc[ch+1] != '=') {
+		   type = Y_NOT
+		} else {
+		   type = Y_NE
+		   ch = ch + 1
+		}
+	    default:
+		Memc[ch+1] = EOS
+		call sprintf (Memc[errmsg], SZ_LINE, badsymb)
+		    call pargstr (Memc[ch])
+		call error (1, Memc[errmsg])
+	    }
+
+	    ch = ch + 1
+	}
+
+	# 
+	if (Memc[token] == EOS) {
+	    call mfree (token, TY_CHAR)
+	    token = NULL
+	}
+
+	Memi[value] = token
+	return (type)
+end
+
+# VEX_ADDCODE -- Add an instruction to the code array
+
+procedure vex_addcode (type)
+
+int	type		# i: Instruction type
+#--
+include	"vex.com"
+
+begin
+
+	if (ncode == maxcode)
+	    call error (1, "Expression too complex")
+	else {
+	    Memi[code] = type
+	    code = code + 1
+	    ncode = ncode + 1
+	}
+
+end
+
+# VEX_ADDSTR -- Embed a string constant in the pseudo-code
+
+procedure vex_addstr (token)
+
+pointer	token		# u: Pointer to token string
+#--
+include "vex.com"
+
+int	ic
+
+begin
+	if (token == NULL)
+	    call error (1, "Expression token missing")
+
+	if (Memc[token] == EOS)
+	    call error (1, "Expression token blank")
+
+	ic = 0
+	repeat {
+	    ic = ic + 1
+
+	    if (ncode == maxcode)
+		call error (1, "Expression too complex")
+	    else {
+		Memi[code] = Memc[token+ic-1]
+		code = code + 1
+		ncode = ncode + 1
+	    }
+
+	} until (Memc[token+ic-1] == EOS)
+
+	call mfree (token, TY_CHAR)
+end
+
+# VEX_GETSTR -- Retrieve a token string from the pseudocode array
+
+procedure vex_getstr (op, token, maxch)
+
+pointer	op		# u: Location of token string in pseudocode
+char	token[ARB]	# o: Token string
+int	maxch		# i: Maximum length of token
+#--
+int	ic
+
+begin
+	# The token begins one position after op and is 
+	# termminated by an EOS
+
+	ic = 0
+	repeat {
+	    ic = ic + 1
+	    op = op + 1
+	    if (ic <= maxch)
+		token[ic] = Memi[op]
+
+	} until (Memi[op] == EOS)
+
+end