	TITLE 'SIEVE.ALC - FIND PRIME NUMBERS USING SIEVE'
*
* AUTHOR. DON HIGGINS.
* DATE.   12/19/86.
* REMARKS. LIST PRIMES ENDING IN 999 UP TO 100,000 (MAXPRIME VALUE)
*          USING 100,000 BYTE TABLE AND SIEVE ROUTINE
*
* 01/16/87 MODIFY TO USE BXLE AND CLCL SCAN FOR NEXT PRIME
* 03/01/87 MODIFY TO USE GMAIN INSTEAD OF DIRECT FQE ACCESS
* 05/20/87 UPDATE TIMINGS FOR PC/370 R2.0
*
SIEVE    CSECT
	LR    BASE,ENTRY
	USING SIEVE,BASE
	LA    R2,=C' $'
	SVC   WTO
	LA    R2,=C'SIEVE.ALC PROGRAM TO PRINT PRIMES ENDING$'
	SVC   WTO
	LA    R2,=C'IN 999 UP TO 100,000 USING 100,000 BYTE TABLE$'
	SVC   WTO
	LA    R2,=C'AND SIEVE ROUTINE. START AND ENDING TIME,$'
	SVC   WTO
	LA    R2,=C'AND 370 INSTRUCTION COUNT ARE ALSO PRINTED.$'
	SVC   WTO
	LA    R2,=C'TIME = 176 SECONDS ON  4.77 MHZ  8088 PC.$'
	SVC   WTO
	LA    R2,=C'TIME =  63 SECONDS ON  6    MHZ 80286 PC/AT.$'
	SVC   WTO
	LA    R2,=C'TIME =  37 SECONDS ON 10    MHZ 80286 PS/2-50.$'
	SVC   WTO
	LA    R2,=C'TIME =  31 SECONDS ON 12    MHZ 80286 COMPAQ.$'
	SVC   WTO
	LA    R2,=C'TIME =  20 SECONDS ON 16    MHZ 80386 COMPAQ.$'
	SVC   WTO
	LA    R2,=C' $'
	SVC   WTO
	L     ENTRY,=V(PET)
	BALR  LINK,ENTRY     PRINT STARTING TIME
	BAL   LINK,INIT      INIT REGS AND TABLE WITH 2,3 MARKED
	LA    NUMBER,5
	LA    NEXT,999       NEXT TARGET NUMBER WITH 999'S
MAINLOOP EQU   *
	BAL   LINK,MARKDUP   MARK DUPLICATES OF NUMBER
	BAL   LINK,FINDNEXT  FIND NEXT PRIME
	BZ    MAINEOJ        EXIT IF NONE FOUND
	CLR   NUMBER,NEXT
	BL    MAINLOOP       LOOP IF NUMBER < NEXT TARGET
	LA    NEXT,1000(NEXT)
	BNE   CHKEOJ
	BAL   LINK,PRTNUM    PRINT NUMBER IF EQUAL TO TARGET
CHKEOJ   EQU   *
	CL    NUMBER,=A(MAXPRIME)
	BL    MAINLOOP       LOOP IF NUMBER < MAXPRIME
MAINEOJ  EQU   *
	L     ENTRY,=V(PET)
	BALR  LINK,ENTRY    PRINT ENDING TIME
	SVC   EXIT
	TITLE 'INIT - INITIALIZE TABLE WITH PRIME INDICATORS'
INIT     EQU   *
	L     R1,=A(MAXPRIME)
	SVC   GMAIN   ALLOCATE TABLE FROM FREE MEMORY
	LTR   R0,R0
	BNZ   INITERR
	LR    TABS,R2
	LR    TABE,R2
	A     TABE,=A(MAXPRIME)
	MVC   0(6,TABS),INITDATA
	LRA   R3,0(TABS)
	L     R2,=A(MAXPRIME-6)
	MVCP  6(R2,TABS),0,R3  INIT TABLE WITH 2,3 DUP. MARKED
	BR    LINK
INITERR  EQU   *
	LA    R2,=C'INSUFFICIENT MEMORY FOR TABLE$'
	SVC   WTO
	SVC   TRACE
	DC    C'BUG '
	SVC   EXIT
	TITLE 'PRTNUM - PRINT PRIME NUMBER'
PRTNUM   EQU   *
	CVD   NUMBER,PWORK
	MVC   DNUM,DMASK
	ED    DNUM,PWORK+4
	LA    R2,DNUM
	SVC   WTO
	BR    LINK
	TITLE 'MARKDUP - MARK DUPLICATES IN TABLE'
MARKDUP  EQU   *
	LA    DUP,0(NUMBER,TABS)
	BXH   DUP,NUMBER,MARKEXIT  EXIT IF DUP > TABE
MARKLOOP EQU   *
	MVI   0(DUP),NOTPRIME
	BXLE  DUP,NUMBER,MARKLOOP  LOOP IF DUP <= TABE
MARKEXIT EQU   *
	BR    LINK
	TITLE 'FINDNEXT - FIND NEXT PRIME IN TABLE'
FINDNEXT EQU   *
	LA    R0,1(NUMBER,TABS)
	LR    R1,TABE
	SR    R1,R0
	BNH   FINDEOF  EOF IF SCAN LENGTH NOT > 0
	LM    R2,R3,=A(0,NOTPRIME*X'1000000')
	CLCL  R0,R2    SCAN FOR NEXT PRIME
	BE    FINDEOF  EOF IF NO PRIME FOUND
	SR    R0,TABS
	LR    NUMBER,R0
	BR    LINK  EXIT WITH NZ FOR PRIME
FINDEOF  EQU   *
	SR    R0,R0 FORCE ZERO CC FOR END OF TABLE
	BR    LINK
	TITLE 'COMMON DATA'
	LTORG
*
*  SVC'S
*
EXIT     EQU   0
TRACE    EQU   9
GMAIN    EQU   10   R1=LENGTH, R2=ADDRESS, R0=RC (0=OK)
WTO      EQU   209
*
*  REGISTERS
*
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
DUP      EQU   4
TABS     EQU   5
NUMBER   EQU   6   R6/R7 USED IN BXLE/BXH
TABE     EQU   7
TWO      EQU   9
NEXT     EQU   10
BASE     EQU   12
LINK     EQU   14
ENTRY    EQU   15
*
* DATA
*
MAXPRIME EQU   100000 (100,000=200 SEC, 10,000=20 SEC FOR QUICK TEST)
PRIME    EQU   0
NOTPRIME EQU   1
PWORK    DC    D'0'
DMASK    DC    X'40206B2020206B202020'
DNUM     DC    CL10' Z,ZZZ,ZZZ',C'$'
*
* INITDATA ELIMINATES 2'S AND 3'S FROM TABLE
*
INITDATA DC    AL1(NOTPRIME,PRIME,NOTPRIME,NOTPRIME,NOTPRIME,PRIME)
*
*  DSECTS
*
ASCB     DSECT
ASCBIDR  DS    CL4
ASCBNEXT DS    A     NEXT ASCB  OR ZERO
ASCBPREV DS    A     PREVIOUS ASCB OR ZERO
ASCBASO  DS    A     VIRTUAL ADDRESS SPACE ORIGIN
ASCBASL  DS    A     VIRTUAL ADDRESS SPACE LENGTH
ASCBASF  DS    A     RELATIVE ADDRESS OF FREE SPACE QUEUE OR ZERO
ASCBASE  DS    A     RELATIVE ADDRESS OF ENTRY POINT USED BY ATTACH
ASCBEXIT DS    A     RELATIVE ADDRESS OF EXIT IN PREV. ADDR. SPACE
	END   SIEVE
