104 lines
4.8 KiB
Plaintext
104 lines
4.8 KiB
Plaintext
* 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
|