Parsing/RPN calculator algorithm: Difference between revisions
→{{header|360 Assembly}}: Section added
(Added Bracmat solution) |
PatGarrett (talk | contribs) (→{{header|360 Assembly}}: Section added) |
||
Line 22:
* [[Arithmetic evaluation]].
<br><br>
=={{header|360 Assembly}}==
{{trans|FORTRAN}}
For concision, only integer arithmetic is handled, but input numbers can be of any length. The formal task is not completed, but the spirit of it is.
<lang 360asm>* RPN calculator RC 25/01/2019
REVPOL CSECT
USING REVPOL,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
XPRNT TEXT,L'TEXT print expression !?
L R4,0 js=0 offset in stack
LA R5,0 ns=0 number of stack items
LA R6,0 jt=0 offset in text
LA R7,TEXT r7=@text
MVC CC,0(R7) cc first char of token
DO WHILE=(CLI,CC,NE,X'00') do while cc<>'0'x
MVC CTOK,=CL5' ' ctok=''
MVC CTOK(1),CC ctok=cc
CLI CC,C' ' if cc=' '
BE ITERATE then goto iterate
IF CLI,CC,GE,C'0',AND,CLI,CC,LE,C'9' THEN
MVC DEED,=C'Load' deed='Load'
XDECI R2,0(R7) r2=cint(text); r1=@text
ST R2,STACK(R4) stack(js)=cc
SR R1,R7 lt length of token
BCTR R1,0 lt-1
EX R1,MVCV MVC CTOK("R1"),0(R7)
AR R6,R1 jt+=lt-1
AR R7,R1 @text+=lt-1
LA R4,4(R4) js+=4
LA R5,1(R5) ns++
ELSE , else
MVC DEED,=C'Exec' deed='Exec'
LA R9,STACK-8(R4) @stack(j-1)
IF CLI,CC,EQ,C'+' THEN if cc='+' then
L R1,STACK-8(R4) stack(j-1)
A R1,STACK-4(R4) stack(j-1)+stack(j)
ST R1,0(R9) stack(j-1)=stack(j-1)+stack(j)
ENDIF , endif
IF CLI,CC,EQ,C'-' THEN if cc='-' then
L R1,STACK-8(R4) stack(j-1)
S R1,STACK-4(R4) stack(j-1)-stack(j)
ST R1,0(R9) stack(j-1)=stack(j-1)-stack(j)
ENDIF , endif
IF CLI,CC,EQ,C'*' THEN if cc='*' then
L R3,STACK-8(R4) stack(j-1)
M R2,STACK-4(R4) stack(j-1)*stack(j)
ST R3,0(R9) stack(j-1)=stack(j-1)*stack(j)
ENDIF , endif
IF CLI,CC,EQ,C'/' THEN if cc='/' then
L R2,STACK-8(R4) stack(j-1)
SRDA R2,32 for sign propagation
D R2,STACK-4(R4) stack(j-1)/stack(j)
ST R3,0(R9) stack(j-1)=stack(j-1)/stack(j)
ENDIF , endif
IF CLI,CC,EQ,C'^' THEN if cc='^' then
LA R3,1 r3=1
L R0,STACK-4(R4) r0=stack(j) [loop count]
EXPONENT M R2,STACK-8(R4) r3=r3*stack(j-1)
BCT R0,EXPONENT if r0--<>0 then goto exponent
ST R3,0(R9) stack(j-1)=stack(j-1)^stack(j)
ENDIF , endif
S R4,=F'4' js-=4
BCTR R5,0 ns--
ENDIF , endif
MVC PG,=CL80' ' clean buffer
MVC PG(4),DEED output deed
MVC PG+5(5),CTOK output cc
MVC PG+11(6),=C'Stack:' output
LA R2,1 i=1
LA R3,STACK @stack
LA R9,PG+18 @buffer
DO WHILE=(CR,R2,LE,R5) do i=1 to ns
L R1,0(R3) stack(i)
XDECO R1,XDEC edit stack(i)
MVC 0(5,R9),XDEC+7 output stack(i)
LA R2,1(R2) i=i+1
LA R3,4(R3) @stack+=4
LA R9,6(R9) @buffer+=6
ENDDO , enddo
XPRNT PG,L'PG print
ITERATE LA R6,1(R6) jt++
LA R7,1(R7) @text++
MVC CC,0(R7) cc next char
ENDDO , enddo
L R1,STACK stack(1)
XDECO R1,XDEC edit stack(1)
MVC XDEC(4),=C'Val=' output
XPRNT XDEC,L'XDEC print stack(1)
L R13,4(0,R13) restore previous savearea pointer
LM R14,R12,12(R13) restore previous context
XR R15,R15 rc=0
BR R14 exit
MVCV MVC CTOK(0),0(R7) patern mvc
TEXT DC C'3 4 2 * 1 5 - 2 3 ^ ^ / +',X'00'
STACK DS 16F stack(16)
DEED DS CL4
CC DS C
CTOK DS CL5
PG DS CL80
XDEC DS CL12
YREGS
END REVPOL</lang>
{{out}}
<pre>
3 4 2 * 1 5 - 2 3 ^ ^ / +
Load 3 Stack: 3
Load 4 Stack: 3 4
Load 2 Stack: 3 4 2
Exec * Stack: 3 8
Load 1 Stack: 3 8 1
Load 5 Stack: 3 8 1 5
Exec - Stack: 3 8 -4
Load 2 Stack: 3 8 -4 2
Load 3 Stack: 3 8 -4 2 3
Exec ^ Stack: 3 8 -4 8
Exec ^ Stack: 3 8 65536
Exec / Stack: 3 0
Exec + Stack: 3
Val= 3
</pre>
=={{header|Ada}}==
Line 109 ⟶ 235:
3.00012
Result = 3.00012</pre>
=={{header|ALGOL 68}}==
{{works with|ALGOL 68G|Any - tested with release 2.8.win32}}
| |||