aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/stxtools/vexcompile.y
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/utilities/nttools/stxtools/vexcompile.y')
-rw-r--r--pkg/utilities/nttools/stxtools/vexcompile.y616
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
generated by cgit (git 2.34.1) at 2025-09-20 14:05:38 -0400