|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/3 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/3 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 2540 (0x9ec)
Types: s3xseg
Names: »S$ASSPL«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »S$ASSPL«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »S$ASSPL«
OPTIONS NODECK 0001
$ASSPR TITLE ' PRIME NUMBER TEST PROGRAM' 0002
* 0003
* THIS PROGRAM READS A NUMBER FROM THE CONSOLE DISPLAY DATA SWITCHES, TESTS IT FOR 0004
* PRIMENESS, AND INDICATES THE RESULTS ON THE MESSAGE DISPLAY UNIT. 0005
* 0006
* THERE ARE THREE HALT CODES USED IN THIS PROGRAM: 0007
*
* HALT CODE MEANING: 0008
* EN ENTER A NUMBER TO BE TESTED. IF NUMBER ENTERED IS ZERO THE 0009
* PROGRAM TERMINATES. 0010
* IP NUMBER IS PRIME. 0011
* NP NUMBER IS NOT PRIME. 0012
* 0013
$ASSPR START 0 0014
USING *,XR1 ESTABLISH BASE REGISTER 0015
LA *,XR1 LOAD BASE REGISTER 0016
BEGIN HPL X'2F',X'7C' 'EN' HALT 0017
SNS SENSE(,XR1),0 SENSE THE DATA SWITCHES 0018
CLC SENSE(2,XR1),ZERO(,XR1) TEST INDICATION TO QUIT 0019
JNE PREPAR NUMBER TO TEST 0020
B 4 GO TO END OF JOB 0021
DC XL1'84' 0022
* 0023
* PREPARE THE INPUT NUMBER. 0024
PREPAR CLC SENSE(2,XR1),THREE(,XR1) TEST FOR ONE,TWO AND THREE 0025
JNH PRIME# CALL ONE, TWO AND THREE PRIME 0026
TBN SENSE(,XR1),X'01' TEST FOR EVEN 0027
JF NPRIME EVEN, NOT PRIME 0028
MVC TEST#(2,XR1),TWO(,XR1) 0029
MVC END#+1(2,XR1),SENSE(,XR1) DIVIDE INPUT BY TWO 0030
MVI END#-1(,XR1),0 TO USE FOR END TESTING 0031
ALC END#+1(3,XR1),END#+1(,XR1) 0032
ALC END#+1(3,XR1),END#+1(,XR1) 0033
ALC END#+1(3,XR1),END#+1(,XR1) 0034
ALC END#+1(3,XR1),END#+1(,XR1) 0035
ALC END#+1(3,XR1),END#+1(,XR1) 0036
ALC END#+1(3,XR1),END#+1(,XR1) 0037
ALC END#+1(3,XR1),END#+1(,XR1) 0038
* 0039
* MAIN TEST LOOP 0040
LOOPST ALC TEST#(2,XR1),ONE(,XR1) INCREMENT TEST 0041
CLC TEST#(2,XR1),END#(,XR1) TEST FOR COMPLETE 0042
JH PRIME# COMPLETE, CALL IT PRIME 0043
MVC TEMPAR(2,XR1),SENSE(,XR1) MAKE COPY AND 0044
SUBTR SLC TEMPAR(2,XR1),TEST#(,XR1) FIND REMAINDER 0045
BP SUBTR(,XR1) BY SUBTRACTING 0046
BNZ LOOPST(,XR1) REMAINDER NOT ZERO 0047
* 0048
* NUMBER NOT PRIME 0049
NPRIME HPL X'3E',X'2F' NOT PRIME (NP) HALT 0050
B BEGIN(,XR1) GO BACK TO BEGINING 0051
* 0052
* NUMBER IS PRIME 0053
PRIME# HPL X'3E',X'03' IS PRIME (IP) HALT 0054
B BEGIN(,XR1) GO BACK TO BEGINING 0055
EJECT 0056
* 0057
* DATA AREA'S 0058
ZERO DC IL2'0' BINARY ZERO 0059
ONE DC XL2'0001' ONE 0060
TWO DC BL2'00000010' TWO 0061
THREE DC AL2(3) THREE 0062
SENSE DS CL2 0063
END# DS CL2 0064
DS CL1 0065
TEMPAR DS CL2 0066
TEST# DS CL2 0067
XR1 EQU 1 BASE REGISTER 0068
END $ASSPR 0069