%title "Evaluate a string expression" %ident "V1-005" function long str_evaluate (string expression & ,long dot & ,long q & ,long z & ,long result) !+ ! Version: V1-005 ! ! Facility: Library routines. ! ! Abstract: Evaluate a string expression. ! ! Environment: User mode. ! ! History: ! ! 27-Nov-1989, DBS, Version V1-001 ! 001 - Original version. ! 01-Dec-1989, DBS; Version V1-002 ! 002 - Added call to lib$int_over () to disable integer overflows. ! 09-Apr-1990, DBS; Version V1-003 ! 003 - Check for upper and lowercase q's and z's. (An oversight earlier.) ! 18-Dec-1995, DBS; Version V1-004 ! 004 - Converted from FORTRAN to BASIC. ! 19-Jan-1996, DBS; Version V1-005 ! 005 - Added code to optionally include lib$int_over - which is different ! on the alpha - set /variant to the hw_model value ($getsyi). !- !++ ! Functional Description: ! This routine will take a string and parse and evaluate the simple ! arithmetic expression contained within it. The evaluation does not ! handle any form of bracketing and the string is parsed from left to ! right and terminates on any error or end of string. ! Valid operators are (all operations are INTEGER): ! + addition ! - subtraction ! * multiplication ! / division ! exclamation mark logical OR ! # logical XOR ! & logical AND ! _ logical NOT ! The following symbols are accepted and will be given the values passed, ! "." and "Q" and "Z". ! [Because of the history of this routine and its original use, these ! values have the following meaning: ! . the current location (or address) ! Q the last value displayed ! Z the base location (or address)] ! ! Calling Sequence: ! ! call str_evaluate (expression, dot, q, z, result) ! ! Formal Argument(s): ! expression.rt.ds The string containing the expression to be evaluated. ! dot.rl.r The value to use for ".". ! q.rl.r The value to use for "Q". ! z.rl.r The value to use for "Z". ! result.wl.r Somewhere to return the answer. ! ! Implicit Inputs: ! None ! ! Implicit Outputs: ! None ! ! Completion Codes: ! Similar to those returned by the ots$cvt routines. ! ! Side Effects: ! None !-- option type = explicit, & constant type = integer, & size = (integer long, real double) ! External references (and includes) %include "$SSDEF" %from %library "SYS$LIBRARY:BASIC$STARLET.TLB" %if (%variant < 1024) %then ! it's a VAX external long function lib$int_over %end %if external long function lib_cvt_t_l external long function str_len ! Type declarations for constants declare long constant disable_ = 0 declare long constant false = 0 declare string constant operator_list = "+-*/!&#" declare long constant true = -1 ! Type declarations for variables declare long cvtstatus declare long do_compliment declare long expression_len declare long first declare long keep_looking declare long last declare string operator declare long total declare long vvalue %sbttl "Mainline" !+ ! Mainline !- mainline: %if (%variant < 1024) %then ! it's a VAX call lib$int_over (disable_) %end %if str_evaluate = ss$_normal ! be optimistic expression_len = str_len (expression) if (expression_len = 0) then str_evaluate = ss$_ivchar else result = 0 total = 0 first = 1 operator = "+" while (first <= expression_len) last = first keep_looking = true while (keep_looking) if (last >= expression_len) then keep_looking = false else if (pos(operator_list,seg$(expression,last,last),1) <> 0) then last = last - 1 keep_looking = false else last = last + 1 end if !(pos(operator_list,seg$(expression,last,last),1) <> 0) end if !(last >= expression_len) then next if (seg$(expression, first, first) = "_") then do_compliment = true first = first + 1 else do_compliment = false end if !(seg$(expression, first, first) = "_") then if (seg$(expression, first, last) = ".") then vvalue = dot cvtstatus = ss$_normal else if ((seg$(expression, first, last) = "Q") & or (seg$(expression, first, last) = "q")) then vvalue = q cvtstatus = ss$_normal else if ((seg$(expression, first, last) = "Z") & or (seg$(expression, first, last) = "z")) then vvalue = z cvtstatus = ss$_normal else cvtstatus = lib_cvt_t_l (seg$(expression, first, last), vvalue) end if !((seg$(expression, first, last) = "Z") & end if !((seg$(expression, first, last) = "Q") & end if !((seg$(expression, first, last) = ".") & if ((cvtstatus and 1) <> 1) then first = expression_len + 1 str_evaluate = cvtstatus else if (do_compliment) then vvalue = (not vvalue) end if !(do_compliment) then if (operator = "+") then total = total + vvalue else if (operator = "-") then total = total - vvalue else if (operator = "*") then total = total*vvalue else if (operator = "!") then total = (total or vvalue) else if (operator = "&") then total = (total and vvalue) else if (operator = "#") then total = (total xor vvalue) else if (operator = "/") then if (vvalue = 0) then first = expression_len + 1 str_evaluate = ss$_intdiv else total = total/vvalue end if !(vvalue = 0) then end if !(operator = "/") then end if !(operator = "#") then end if !(operator = "&") then end if !(operator = " ") then end if !(operator = "*") then end if !(operator = "-" then end if !(operator = "+") then if (last < expression_len) then operator = seg$(expression, last+1, last+1) end if !(last < expression_len) then first = last + 2 end if !((cvtstatus and 1) <> 1) then next result = total end if !(expression_len = 0) then end function