99 lines
2.9 KiB
Plaintext
99 lines
2.9 KiB
Plaintext
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* STKMTH
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
subroutine STKMATH( answer, stack)
|
||
|
|
|
||
|
|
* This routine perform arithmetic and logical operations on a
|
||
|
|
* postfix stack. Used by some of the Pro*verb user exits.
|
||
|
|
|
||
|
|
|
||
|
|
IF stack = "" THEN RETURN
|
||
|
|
IF NUM(stack<1>) THEN
|
||
|
|
IF answer THEN answer:= @FM:stack<1> ELSE answer = stack<1>
|
||
|
|
DEL stack<1>
|
||
|
|
CALL $STKMATH(answer, stack)
|
||
|
|
END ELSE
|
||
|
|
op = stack<1>
|
||
|
|
DEL stack<1>
|
||
|
|
c = DCOUNT(answer,@FM)-1
|
||
|
|
|
||
|
|
BEGIN CASE
|
||
|
|
|
||
|
|
CASE op = "+"
|
||
|
|
t = answer<c>+answer<c+1>
|
||
|
|
|
||
|
|
CASE op = "-"
|
||
|
|
t = answer<c>-answer<c+1>
|
||
|
|
|
||
|
|
CASE op = "*"
|
||
|
|
t = answer<c>*answer<c+1>
|
||
|
|
|
||
|
|
CASE op = "/"
|
||
|
|
t = answer<c>/answer<c+1>
|
||
|
|
|
||
|
|
CASE op = "&"
|
||
|
|
IF answer<c> and answer<c+1> THEN t = 1 ELSE t = 0
|
||
|
|
|
||
|
|
CASE op = "!"
|
||
|
|
IF answer<c> or answer<c+1> THEN t = 1 ELSE t = 0
|
||
|
|
|
||
|
|
CASE op = "#"
|
||
|
|
* THE ONLY UNARY OPERATOR
|
||
|
|
IF answer<c+1> THEN t = 0 ELSE t = 1
|
||
|
|
IF c THEN answer:= @FM
|
||
|
|
|
||
|
|
CASE op = "<"
|
||
|
|
IF answer<c+1> < answer<c> THEN t = 1 ELSE t = 0
|
||
|
|
|
||
|
|
CASE op = "<="
|
||
|
|
IF answer<c+1> <= answer<c> THEN t = 1 ELSE t = 0
|
||
|
|
|
||
|
|
CASE op = ">"
|
||
|
|
IF answer<c+1> > answer<c> THEN t = 1 ELSE t = 0
|
||
|
|
|
||
|
|
CASE op = ">="
|
||
|
|
IF answer<c+1> >= answer<c> THEN t = 1 ELSE t = 0
|
||
|
|
|
||
|
|
CASE op = "#<"
|
||
|
|
IF answer<c+1> >= answer<c> THEN t = 1 ELSE t = 0
|
||
|
|
|
||
|
|
CASE op = "#>"
|
||
|
|
IF answer<c+1> <= answer<c> THEN t = 1 ELSE t = 0
|
||
|
|
|
||
|
|
|
||
|
|
CASE op = "?"
|
||
|
|
* terminator symbol
|
||
|
|
stack = ""
|
||
|
|
RETURN
|
||
|
|
CASE 1
|
||
|
|
PRINT "ill formed string"
|
||
|
|
stack = ""
|
||
|
|
answer = ""
|
||
|
|
RETURN
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
DEL answer<c>
|
||
|
|
DEL answer<c>
|
||
|
|
IF answer THEN answer:= @FM:t ELSE answer = t
|
||
|
|
IF stack THEN CALL $STKMATH( answer, stack)
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
END
|