
 1000  *--------------------------------
 1010  *SAVE S.USRND S-C
 1020  *--------------------------------
 1030  *      FROM CALL APPLE, JAN 1983, PAGE 29-34
 1040  *--------------------------------
 1050         .OR $300
 1060         .TF B.USRND
 1070  *--------------------------------
 1080  NORMALIZE.FAC       .EQ $E82E
 1090  FMUL.FAC.BY.YA      .EQ $E97F
 1100  LOAD.ARG.FROM.YA    .EQ $E9E3
 1110  FDIV.ARG.BY.YA      .EQ $EA5C
 1120  LOAD.FAC.FROM.YA    .EQ $EAF9
 1130  STORE.FAC.AT.YX.ROUNDED .EQ $EB2B
 1140  COPY.FAC.TO.ARG     .EQ $EB66
 1150  AS.INT              .EQ $EC23
 1160  *--------------------------------
 1170  USER.VECTOR         .EQ $0A THRU $0C
 1180  FAC                 .EQ $9D THRU $A2
 1190  FAC.SIGN            .EQ $A2
 1200  CNTR                .EQ $A5
 1210  *--------------------------------
 1220  LINK   LDA #$4C     "JMP" OPCODE
 1230         STA USER.VECTOR
 1240         LDA #RANDOM
 1250         STA USER.VECTOR+1
 1260         LDA /RANDOM
 1270         STA USER.VECTOR+2
 1280         RTS
 1290  *--------------------------------
 1300  *      R = USR (X)
 1310  *      IF X < 0 THEN RESEED WITH ABS(X)
 1320  *      IF X = 0 THEN R = REPEAT OF PREVIOUS VALUE
 1330  *      IF 0 < X < 2 THEN GENERATE NEXT SEED AND RETURN
 1340  *                    0 <= R < 1
 1350  *      IF X >= 2 THEN R = INT(RND*X)
 1360  *--------------------------------
 1370  RANDOM
 1380         LDA FAC.SIGN CHECK FOR RESEEDING
 1390         BMI .2       ...YES
 1400         LDA FAC      CHECK FOR X=0
 1410         BNE .1       ...NO, X=RANGE
 1420         LDA #SEED
 1430         LDY /SEED
 1440         JSR LOAD.ARG.FROM.YA
 1450         JMP .5
 1460  *---X --> RANGE------------------
 1470  .1     LDX #RANGE
 1480         LDY /RANGE
 1490         JSR STORE.FAC.AT.YX.ROUNDED   $EB2B
 1500  *---SEED --> FAC-----------------
 1510         LDA #SEED
 1520         LDY /SEED
 1530         JSR LOAD.FAC.FROM.YA  $EAF9
 1540  *---PREPARE SEED-----------------
 1550  .2     LDA #0       MAKE SEED POSITIVE
 1560         STA FAC.SIGN
 1570         LDA FAC      LIMIT SEED TO 67099547
 1580         CMP #$9A
 1590         BCC .3
 1600         LDA #$9A
 1610         STA FAC
 1620         JSR MODULO
 1630  *---(8192*SEED) MOD 67099547-----
 1640  .3     LDA #13
 1650         STA CNTR
 1660  .4     INC FAC
 1670         JSR MODULO
 1680         DEC CNTR
 1690         BNE .4
 1700  *---SEED/67099547----------------
 1710         LDX #SEED
 1720         LDY /SEED
 1730         JSR STORE.FAC.AT.YX.ROUNDED
 1740         JSR COPY.FAC.TO.ARG  $EB66
 1750  .5     LDA #FLT67
 1760         LDY /FLT67
 1770         JSR FDIV.ARG.BY.YA $EA5C
 1780  *---SCALE TEST-------------------
 1790         LDA RANGE
 1800         CMP #$82     IS RANGE BETWEEN ZERO AND ONE?
 1810         BCC .6       ...YES
 1820  *---SCALE------------------------
 1830         LDA #RANGE
 1840         LDY /RANGE
 1850         JSR FMUL.FAC.BY.YA   $E97F
 1860         JSR AS.INT  $EC23
 1870  *---RETURN-----------------------
 1880  .6     RTS
 1890  *--------------------------------
 1900  MODULO
 1910         LDY #0
 1920         LDA FAC
 1930         CMP #$9A
 1940         BCC .3       < 67099547
 1950         BEQ .1       67099547...
 1960         LDY #4
 1970  .1     SEC
 1980         LDA FAC+4    LSB
 1990         SBC MAN67+3,Y
 2000         PHA
 2010         LDA FAC+3
 2020         SBC MAN67+2,Y
 2030         PHA
 2040         LDA FAC+2
 2050         SBC MAN67+1,Y
 2060         PHA
 2070         LDA FAC+1
 2080         SBC MAN67+0,Y
 2090         PHA
 2100         BCC .2       <67099547
 2110         PLA
 2120         STA FAC+1
 2130         PLA
 2140         STA FAC+2
 2150         PLA
 2160         STA FAC+3
 2170         PLA
 2180         STA FAC+4
 2190         JMP NORMALIZE.FAC  $E82E
 2200  .2     PLA
 2210         PLA
 2220         PLA
 2230         PLA
 2240  .3     RTS
 2250  *--------------------------------
 2260  RANGE  .HS 81.00000000
 2270  SEED   .HS 81.00000000
 2280  FLT67  .HS 9A.7FF6E6C0    = 67,099,547
 2290  MAN67  .HS FFF6E6C0
 2300         .HS 7FFB7360
 2310  *--------------------------------

