PRIMEDE  CSECT
         USING  PRIMEDE,R13
         B      80(R15)            skip savearea
         DC     17F'0'             savearea
         DC     CL8'PRIMEDE'
         STM    R14,R12,12(R13)
         ST     R13,4(R15)
         ST     R15,8(R13)
         LR     R13,R15            end prolog
         LA     R2,0
         LA     R3,1023
         LA     R4,1024
         MR     R2,R4
         ST     R3,N               n=1023*1024
         LA     R5,WBUFFER
         LA     R6,0
         L      R1,N               n
         XDECO  R1,0(R5)
         LA     R5,12(R5)
         MVC    0(3,R5),=C' : '
         LA     R5,3(R5)
         LA     R0,2
         ST     R0,I               i=2
WHILE1   EQU    *                  do while(i<=n/2)
         L      R2,N
         SRA    R2,1
         L      R4,I
         CR     R4,R2              i<=n/2
         BH     EWHILE1
WHILE2   EQU    *                  do while(n//i=0)
         L      R3,N
         LA     R2,0
         D      R2,I
         LTR    R2,R2              n//i=0
         BNZ    EWHILE2
         ST     R3,N               n=n/i
         ST     R3,M               m=n
         L      R1,I               i
         XDECO  R1,WDECO
         MVC    0(5,R5),WDECO+7
         LA     R5,5(R5)
         MVI    OK,X'01'           ok
         B      WHILE2
EWHILE2  EQU    *
         L      R4,I
         CH     R4,=H'2'           if i=2 then
         BNE    NE2
         LA     R0,3
         ST     R0,I               i=3
         B      EIFNE2
NE2      L      R2,I               else
         LA     R2,2(R2)
         ST     R2,I               i=i+2
EIFNE2   B      WHILE1
EWHILE1  EQU    *
         CLI    OK,X'01'           if ^ok then
         BE     NOTPRIME
         MVC    0(7,R5),=C'[prime]'
         LA     R5,7(R5)
         B      EPRIME
NOTPRIME L      R1,M               m
         XDECO  R1,WDECO
         MVC    0(5,R5),WDECO+7
EPRIME   XPRNT  WBUFFER,80         put
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)
         XR     R15,R15
         BR     R14
N        DS     F
I        DS     F
M        DS     F
OK       DC     X'00'
WBUFFER  DC     CL80' '
WDECO    DS     CL16
         YREGS
         END    PRIMEDE