234 lines
5.9 KiB
Plaintext
234 lines
5.9 KiB
Plaintext
PROGRAM EVAL
|
|
|
|
!
|
|
! arithmetic expression evaluator
|
|
!
|
|
|
|
!$KEY
|
|
|
|
LABEL 98,100,110
|
|
|
|
DIM STACK$[50]
|
|
|
|
PROCEDURE DISEGNA_STACK
|
|
!$RCODE="LOCATE 3,1"
|
|
!$RCODE="COLOR 0,7"
|
|
PRINT(TAB(35);"S T A C K";TAB(79);)
|
|
!$RCODE="COLOR 7,0"
|
|
FOR TT=1 TO 38 DO
|
|
IF TT>=20 THEN
|
|
!$RCODE="LOCATE 3+TT-19,40"
|
|
ELSE
|
|
!$RCODE="LOCATE 3+TT,1"
|
|
END IF
|
|
IF TT=NS THEN PRINT(">";) ELSE PRINT(" ";) END IF
|
|
PRINT(RIGHT$(STR$(TT),2);"³ ";STACK$[TT];" ")
|
|
END FOR
|
|
REPEAT
|
|
GET(Z$)
|
|
UNTIL LEN(Z$)<>0
|
|
END PROCEDURE
|
|
|
|
PROCEDURE COMPATTA_STACK
|
|
IF NS>1 THEN
|
|
R=1
|
|
WHILE R<NS DO
|
|
IF INSTR(OP_LIST$,STACK$[R])=0 AND INSTR(OP_LIST$,STACK$[R+1])=0 THEN
|
|
FOR R1=R TO NS-1 DO
|
|
STACK$[R1]=STACK$[R1+1]
|
|
END FOR
|
|
NS=NS-1
|
|
END IF
|
|
R=R+1
|
|
END WHILE
|
|
END IF
|
|
DISEGNA_STACK
|
|
END PROCEDURE
|
|
|
|
PROCEDURE CALC_ARITM
|
|
L=NS1
|
|
WHILE L<=NS2 DO
|
|
IF STACK$[L]="^" THEN
|
|
IF L>=NS2 THEN GOTO 100 END IF
|
|
N1#=VAL(STACK$[L-1]) N2#=VAL(STACK$[L+1]) NOP=NOP-1
|
|
IF STACK$[L]="^" THEN
|
|
RI#=N1#^N2#
|
|
END IF
|
|
STACK$[L-1]=STR$(RI#)
|
|
N=L
|
|
WHILE N<=NS2-2 DO
|
|
STACK$[N]=STACK$[N+2]
|
|
N=N+1
|
|
END WHILE
|
|
NS2=NS2-2
|
|
L=NS1-1
|
|
END IF
|
|
L=L+1
|
|
END WHILE
|
|
|
|
L=NS1
|
|
WHILE L<=NS2 DO
|
|
IF STACK$[L]="*" OR STACK$[L]="/" THEN
|
|
IF L>=NS2 THEN GOTO 100 END IF
|
|
N1#=VAL(STACK$[L-1]) N2#=VAL(STACK$[L+1]) NOP=NOP-1
|
|
IF STACK$[L]="*" THEN RI#=N1#*N2# ELSE RI#=N1#/N2# END IF
|
|
STACK$[L-1]=STR$(RI#)
|
|
N=L
|
|
WHILE N<=NS2-2 DO
|
|
STACK$[N]=STACK$[N+2]
|
|
N=N+1
|
|
END WHILE
|
|
NS2=NS2-2
|
|
L=NS1-1
|
|
END IF
|
|
L=L+1
|
|
END WHILE
|
|
|
|
L=NS1
|
|
WHILE L<=NS2 DO
|
|
IF STACK$[L]="+" OR STACK$[L]="-" THEN
|
|
EXIT IF L>=NS2
|
|
N1#=VAL(STACK$[L-1]) N2#=VAL(STACK$[L+1]) NOP=NOP-1
|
|
IF STACK$[L]="+" THEN RI#=N1#+N2# ELSE RI#=N1#-N2# END IF
|
|
STACK$[L-1]=STR$(RI#)
|
|
N=L
|
|
WHILE N<=NS2-2 DO
|
|
STACK$[N]=STACK$[N+2]
|
|
N=N+1
|
|
END WHILE
|
|
NS2=NS2-2
|
|
L=NS1-1
|
|
END IF
|
|
L=L+1
|
|
END WHILE
|
|
100:
|
|
IF NOP<2 THEN ! operator priority
|
|
DB#=VAL(STACK$[NS1])
|
|
ELSE
|
|
IF NOP<3 THEN
|
|
DB#=VAL(STACK$[NS1+2])
|
|
ELSE
|
|
DB#=VAL(STACK$[NS1+4])
|
|
END IF
|
|
END IF
|
|
END PROCEDURE
|
|
|
|
PROCEDURE SVOLGI_PAR
|
|
NPA=NPA-1
|
|
FOR J=NS TO 1 STEP -1 DO
|
|
EXIT IF STACK$[J]="("
|
|
END FOR
|
|
IF J=0 THEN
|
|
NS1=1 NS2=NS CALC_ARITM
|
|
NERR=7
|
|
ELSE
|
|
FOR R=J TO NS-1 DO
|
|
STACK$[R]=STACK$[R+1]
|
|
END FOR
|
|
NS1=J NS2=NS-1 CALC_ARITM
|
|
IF NS1=2 THEN NS1=1 STACK$[1]=STACK$[2] END IF
|
|
NS=NS1
|
|
COMPATTA_STACK
|
|
END IF
|
|
END PROCEDURE
|
|
|
|
BEGIN
|
|
OP_LIST$="+-*/^("
|
|
NOP=0 NPA=0 NS=1 K$=""
|
|
STACK$[1]="@" ! init stack
|
|
|
|
PRINT(CHR$(12);)
|
|
INPUT(LINE,EXPRESSION$)
|
|
|
|
FOR W=1 TO LEN(EXPRESSION$) DO
|
|
LOOP
|
|
CODE=ASC(MID$(EXPRESSION$,W,1))
|
|
IF (CODE>=48 AND CODE<=57) OR CODE=46 THEN
|
|
K$=K$+CHR$(CODE)
|
|
W=W+1 IF W>LEN(EXPRESSION$) THEN GOTO 98 END IF
|
|
ELSE
|
|
EXIT IF K$=""
|
|
IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF
|
|
IF FLAG=0 THEN STACK$[NS]=K$ ELSE STACK$[NS]=STR$(VAL(K$)*FLAG) END IF
|
|
K$="" FLAG=0
|
|
EXIT
|
|
END IF
|
|
END LOOP
|
|
IF CODE=43 THEN K$="+" END IF
|
|
IF CODE=45 THEN K$="-" END IF
|
|
IF CODE=42 THEN K$="*" END IF
|
|
IF CODE=47 THEN K$="/" END IF
|
|
IF CODE=94 THEN K$="^" END IF
|
|
|
|
CASE CODE OF
|
|
43,45,42,47,94->
|
|
IF MID$(EXPRESSION$,W+1,1)="-" THEN FLAG=-1 W=W+1 END IF
|
|
IF INSTR(OP_LIST$,STACK$[NS])<>0 THEN
|
|
NERR=5
|
|
ELSE
|
|
NS=NS+1 STACK$[NS]=K$ NOP=NOP+1
|
|
IF NOP>=2 THEN
|
|
FOR J=NS TO 1 STEP -1 DO
|
|
IF STACK$[J]<>"(" THEN
|
|
CONTINUE FOR
|
|
END IF
|
|
IF J<NS-2 THEN
|
|
EXIT
|
|
ELSE
|
|
GOTO 110
|
|
END IF
|
|
END FOR
|
|
NS1=J+1 NS2=NS CALC_ARITM
|
|
NS=NS2 STACK$[NS]=K$
|
|
REGISTRO_X#=VAL(STACK$[NS-1])
|
|
END IF
|
|
END IF
|
|
110:
|
|
END ->
|
|
|
|
40->
|
|
IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF
|
|
STACK$[NS]="(" NPA=NPA+1
|
|
IF MID$(EXPRESSION$,W+1,1)="-" THEN FLAG=-1 W=W+1 END IF
|
|
END ->
|
|
|
|
41->
|
|
SVOLGI_PAR
|
|
IF NERR=7 THEN
|
|
NERR=0 NOP=0 NPA=0 NS=1
|
|
ELSE
|
|
IF NERR=0 OR NERR=1 THEN
|
|
DB#=VAL(STACK$[NS])
|
|
REGISTRO_X#=DB#
|
|
ELSE
|
|
NOP=0 NPA=0 NS=1
|
|
END IF
|
|
END IF
|
|
END ->
|
|
|
|
OTHERWISE
|
|
NERR=8
|
|
END CASE
|
|
K$=""
|
|
DISEGNA_STACK
|
|
END FOR
|
|
|
|
98:
|
|
IF K$<>"" THEN
|
|
IF NS>1 OR (NS=1 AND STACK$[1]<>"@") THEN NS=NS+1 END IF
|
|
IF FLAG=0 THEN STACK$[NS]=K$ ELSE STACK$[NS]=STR$(VAL(K$)*FLAG) END IF
|
|
END IF
|
|
DISEGNA_STACK
|
|
IF INSTR(OP_LIST$,STACK$[NS])<>0 THEN
|
|
NERR=6
|
|
ELSE
|
|
WHILE NPA<>0 DO
|
|
SVOLGI_PAR
|
|
END WHILE
|
|
IF NERR<>7 THEN NS1=1 NS2=NS CALC_ARITM END IF
|
|
END IF
|
|
NS=1 NOP=0 NPA=0
|
|
!$RCODE="LOCATE 23,1"
|
|
IF NERR>0 THEN PRINT("Internal Error #";NERR) ELSE PRINT("Value is ";DB#) END IF
|
|
END PROGRAM
|