64 lines
2.6 KiB
Text
64 lines
2.6 KiB
Text
* Casting out nines 08/02/2017
|
|
CASTOUT CSECT
|
|
USING CASTOUT,R13 base register
|
|
B 72(R15) skip savearea
|
|
DC 17F'0' savearea
|
|
STM R14,R12,12(R13) prolog
|
|
ST R13,4(R15) " <-
|
|
ST R15,8(R13) " ->
|
|
LR R13,R15 " addressability
|
|
L R1,LOW low
|
|
XDECO R1,XDEC edit low
|
|
MVC PGT+4(4),XDEC+8 output low
|
|
L R1,HIGH high
|
|
XDECO R1,XDEC edit high
|
|
MVC PGT+12(4),XDEC+8 output low
|
|
L R1,BASE base
|
|
XDECO R1,XDEC edit base
|
|
MVC PGT+24(4),XDEC+8 output base
|
|
XPRNT PGT,L'PGT print buffer
|
|
L R2,BASE base
|
|
BCTR R2,0 -1
|
|
ST R2,RM rm=base-1
|
|
LA R8,PG ipg=0
|
|
SR R7,R7 j=0
|
|
L R6,LOW i=low
|
|
DO WHILE=(C,R6,LE,HIGH) do i=low to high
|
|
LR R5,R6 i
|
|
SR R4,R4 clear for div
|
|
D R4,RM /rm
|
|
LR R2,R4 r2=i mod rm
|
|
LR R5,R6 i
|
|
MR R4,R6 i*i
|
|
SR R4,R4 clear for div
|
|
D R4,RM /rm
|
|
IF CR,R2,EQ,R4 THEN if (i//rm)=(i*i//rm) then
|
|
LA R7,1(R7) j=j+1
|
|
XDECO R6,XDEC edit i
|
|
MVC 0(4,R8),XDEC+8 output i
|
|
LA R8,4(R8) ipg=ipg+4
|
|
IF C,R7,EQ,=F'20' THEN if j=20 then
|
|
XPRNT PG,L'PG print buffer
|
|
LA R8,PG ipg=0
|
|
SR R7,R7 j=0
|
|
MVC PG,=CL80' ' clear buffer
|
|
ENDIF , end if
|
|
ENDIF , end if
|
|
LA R6,1(R6) i=i+1
|
|
ENDDO , end do i
|
|
IF LTR,R7,NE,R7 THEN if j<>0 then
|
|
XPRNT PG,L'PG print buffer
|
|
ENDIF , end if
|
|
L R13,4(0,R13) epilog
|
|
LM R14,R12,12(R13) " restore
|
|
XR R15,R15 " rc=0
|
|
BR R14 exit
|
|
LOW DC F'1' low
|
|
HIGH DC F'500' high
|
|
BASE DC F'10' base
|
|
RM DS F rm
|
|
PGT DC CL80'for ... to ... base ...' buffer
|
|
PG DC CL80' ' buffer
|
|
XDEC DS CL12 temp for xdeco
|
|
YREGS
|
|
END CASTOUT
|