Jump to content

Photo

FORTH and BASIC graphic program comparison


9 replies to this topic

#1 TheBF OFFLINE  

TheBF

    Star Raider

  • 94 posts

Posted Wed Apr 5, 2017 10:49 PM

I have been amazed at the level of BASIC programs people are generating here for TI-99.

I spent many hours a few decades ago (ya that sounds weird to me too) inside XB myself.

 

To continue my torture I decided to add TI-BASIC style GRAPHIC words to CAMEL99.

 

Out of curiosity I wrote a program with the new additions and then duplicated it in TI-BASIC.

 

I was amazed at how with these higher level functions the two programs lined up.

 

However I did have make a quick and dirty random number generator. :_(

Raw Forth like Assembler is pretty low level. But that's the game with it. Raise the level.

 

I have some 10 second videos but they need converting and it's late.

I will do it another day.  (*EDIT* VIDEO IS ATTACHED)

 

By the way, the color set numbers are correct because Forth accesses  32 color sets

provided by the VDP chip so char 131 is in it's color set 16.

( Graphics test program  )

VARIABLE RND#
HEX
: SCRAMBLE   ( -- n) 83D6 @ 8379 C@ * C3E9 XOR ; ( we had to build a random number generator)
: RANDOMIZE  ( -- ) SCRAMBLE RND# ! ;            ( named it like TI-BASIC )

: RND  ( n -- )                                  ( this one too )
        RND# @ SCRAMBLE XOR >< ABS
        DUP RND# ! SWAP MOD ;

DECIMAL
: RND(X)   ( -- x) 23 RND 1+ ;       ( no sense in repeating the math)
: RND(Y)   ( -- y) 31 RND 1+ ;       ( when it is so easy to call it )
: RND(C)   ( -- c) 15 RND 1+ ;

HEX" FFFF 0000 FFFF 0000" 131 CHARDEF ( 20 CALL CHAR(159,F0F00F0FF0F00F0F")  )
: STUFF                              ( 25 REM STUFF  name of routine)
BEGIN CLEAR                          ( 30 CALL CLEAR) ( BEGIN is like line# 30, to jump back to)
      RND(C) SCREEN                  ( 40 CALL SCREEN(INT(RND*16)+1) )
      16 RND(C) RND(C) COLOR         ( 50 CALL COLOR(16,INT(RND*16)+1,INT(RND*16)+1) )
      RND(Y) 0 ?DO                   ( 60 FOR I=1 TO INT(RND*32)+1 )
      RND(Y) RND(X) 131 RND(X) VCHAR ( 70 CALL VCHAR(INT(RND*24)+1,INT(RND*32)+1,159,INT(RND*24)+1))
      LOOP                           ( 80 NEXT I )
      20000 0 DO                     ( 90 FOR X=1 TO 200 ) ( yes loops are about 100x faster)
      LOOP                           ( 100 NEXT X )
      KEY? ABORT" *Break"            ( 105 REM FORTH loops don't have BREAK built-in)
AGAIN ;                              ( 110 GOTO 30  )  ( actually GOTO BEGIN )


Attached Files


Edited by TheBF, Thu Apr 6, 2017 8:10 AM.


#2 Lee Stewart ONLINE  

Lee Stewart

    River Patroller

  • 3,101 posts
  • Location:Silver Run, Maryland

Posted Thu Apr 6, 2017 8:33 AM

Very nice!

 

I must say, though, that the TI Basic and CAMEL99 Forth programs are not directly comparable when it comes to the RND function.  RND in TI Basic, TI Extended Basic, TurboForth, TI Forth and fbForth does not randomize the random-number seed. It produces a reproducible pseudo-random-number sequence with the same starting seed, which is typical of RND in most (all?) computer languages to allow for adequate debugging.  The 16-bit seed for all of the above-enumerated languages is at >83C0, which is set to a truly random value at the instant the user selects an item on the TI-99/4A startup menu screen.  TI Basic actually sets >83C0 unconditionally to >3767 when it starts.  XB continues to increment >83C0 (each VDP interrupt?) until a Basic program is started and resumes incrementing until another program start.  The Forths let it be.

 

Regarding the speed comparison of your two programs, I dare say the biggest slow-down for the TI Basic program is RND() because RND() is working on a floating point number, which is 8 bytes long!  TI Basic’s RND() calls the GPL RAND function for each of the bytes at least once—so, a minimum of 8 times.  Before RANDing the 7 mantissa digits, RND() calls RAND up to 63 times, decrementing the exponent byte (starts at >3B) each time, until RAND returns a non-zero value or the exponent byte = 0.  In the extremely unlikely event that RAND never returned non-zero while RND() was working on the exponent, RND() would make 70 calls to RAND, changing >83C0 each time!  To summarize, TI Basic’s RND() makes 8 – 70 calls to the GPL RAND function every time it runs, rarely coming anywhere near the 70-call end, however.

 

...lee



#3 RXB OFFLINE  

RXB

    River Patroller

  • 2,448 posts
  • Location:Vancouver, Washington, USA

Posted Thu Apr 6, 2017 9:52 AM

RXB does not use the TI Extended Basic RND it uses the TI Basic RND instead which is considerable faster than every other XB out there.

 

 

Test 2 got deleted as it was a bad video.

 



#4 TheBF OFFLINE  

TheBF

    Star Raider

  • Topic Starter
  • 94 posts

Posted Thu Apr 6, 2017 12:04 PM

Very nice!

 

I must say, though, that the TI Basic and CAMEL99 Forth programs are not directly comparable when it comes to the RND function.  RND in TI Basic, TI Extended Basic, TurboForth, TI Forth and fbForth does not randomize the random-number seed. It produces a reproducible pseudo-random-number sequence with the same starting seed, which is typical of RND in most (all?) computer languages to allow for adequate debugging.  The 16-bit seed for all of the above-enumerated languages is at >83C0, which is set to a truly random value at the instant the user selects an item on the TI-99/4A startup menu screen.  TI Basic actually sets >83C0 unconditionally to >3767 when it starts.  XB continues to increment >83C0 (each VDP interrupt?) until a Basic program is started and resumes incrementing until another program start.  The Forths let it be.

 

Regarding the speed comparison of your two programs, I dare say the biggest slow-down for the TI Basic program is RND() because RND() is working on a floating point number, which is 8 bytes long!  TI Basic’s RND() calls the GPL RAND function for each of the bytes at least once—so, a minimum of 8 times.  Before RANDing the 7 mantissa digits, RND() calls RAND up to 63 times, decrementing the exponent byte (starts at >3B) each time, until RAND returns a non-zero value or the exponent byte = 0.  In the extremely unlikely event that RAND never returned non-zero while RND() was working on the exponent, RND() would make 70 calls to RAND, changing >83C0 each time!  To summarize, TI Basic’s RND() makes 8 – 70 calls to the GPL RAND function every time it runs, rarely coming anywhere near the 70-call end, however.

 

...lee

 

Wow that is a lot of overhead for a random number.  I will look into how you do it in a "system compatible" way. 

​Thanks for the continued schooling Lee

 

BF



#5 Lee Stewart ONLINE  

Lee Stewart

    River Patroller

  • 3,101 posts
  • Location:Silver Run, Maryland

Posted Thu Apr 6, 2017 5:52 PM

 

Wow that is a lot of overhead for a random number.  I will look into how you do it in a "system compatible" way. 

​Thanks for the continued schooling Lee

 

BF

 

:)

 

Yeah—and as Rich (RXB) has noted many times before, TI Extended Basic’s RND() does its own thing and takes even longer (much longer) than TI Basic’s RND().  One of these days, perhaps, I will attempt to see how XB does it.  And, even though I made a point of the possible maximum 70 times RAND can be called by TIB’s RND(), I would be willing to bet it rarely gets called more than 10 times, which would mean the first 2 calls to RAND both return 0.

 

Re “continued schooling”, I suspect that can get a little irritating, but I usually cannot help myself, particularly when someone makes the mistake  :grin: of appearing to listen.

 

...lee



#6 RXB OFFLINE  

RXB

    River Patroller

  • 2,448 posts
  • Location:Vancouver, Washington, USA

Posted Fri Apr 7, 2017 1:11 AM

Yea I can save you the hassle of looking it is due to using Floating Point ALL THE TIME for all calculations unlike TI Basic RND that only return the Floating Point result.

[0898]               * Initialize random number generator 
[0899] A28D 31,00,0A INTRND MOVE 10,G@X2SEED,V@RNDX2
       A290 A3,A0,A2
       A293 95
[0900] A294 00              RTN
[0901] A295 42,03,23 X2SEED BYTE >42,>03,>23,>15,>00 * =   33521, X2 INITIAL VAL
       A298 15,00
[0902] A29A 43,02,3E X1SEED BYTE >43,>02,>3E,>2A,>17 * = 2624223, X1 INITIAL VAL
       A29D 2A,17
[0903]               ***********************************************************
[0904]               *                                                         *
[0905]               * RXB PATCH REPLACEMENT CODE FOR RND WITH TI BASIC RND    *
[0906]               *                                                         *
[0907]               ***********************************************************
[0908]               *           PSEUDO-RANDOM NUMBER GENERATOR
[0909]               *      X(N+1) = (A*X(N)+C) MOD M;  RND = X/M
[0910]               *    WHERE:                 X = X2 * 1E7 + X1
[0911]               *                           A = A2 * 1E7 + A1
[0912]               *                           C = C2 * 1E7 + C1
[0913]               *                           M = 1E14
[0914]               * ASSUMPTIONS:
[0915]               *  (1) All numbers are integers; fractional parts are
[0916]               *      truncated
[0917]               *  (2) If the variables listed below start in the ranges

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0016 
EQUATES EXEC-359
[0918]               *     specified. They will also end in the ranges specified
[0919]               *
[0920]               * CONSTANTS: 0 <= A2 < 5E6 ; 0 <= C2 < 1E7
[0921]               *            0 <= A1 < 5E6 ; 0 <= C1 < 1E7
[0922]               * VARIABLES: 0 <= X2 < 1E7 ; 0 <= T1 <= 1E14 ; 0 <= T2 < 1E
[0923]               *            0 <= X1 < 1E7 ; 0 <= T3 <= 1E14 ; 0 <= T4 < 1E
[0924]               *
[0925]               *        STACK USAGE:
[0926]               *            CONSTANT REFS      CONTANT REFS    CONTANT REF
[0927]               * +---------+      IN/OUT            IN/OUT          IN/OUT
[0928]               * | STACK+4 | X2*A1(F)(H)       --    ----      --    ----
[0929]               * +---------+
[0930]               * | STACK+3 |   T2 (C)(J)       --    ----      --    ----
[0931]               * +---------+
[0932]               * | STACK+2 |   T1 (B)(D)   new X1   (E)(N)     --    ----
[0933]               * +---------+
[0934]               * | STACK+1 |old X1(A)(G)       T3   (K)(L) new X2   (M)(P)
[0935]               * +---------+
[0936]               ***********************************************************
[0937]               * COMPUTE NEW VALUE FOR X1, SAVE IT IN V@RNDX1
[0938]               *                             STACK
[0939]               *                               SREFS   FAC CONTENTS
[0940]               * NRND   MOVE 5,V@RNDX1,@FAC        FAC = X1
[0941]               *        MOVE 5,V@RNDX1,@FAC        fAC = X1
[0942]               *        CLR  @FAC5                 FAC = CLR
[0943]               *        DCLR @FAC6                 FAC = CLR
[0944]               *        XML  VPUSH          (A)    FAC = X1
[0945]               *        MOVE 8,G@RNDA1,@ARG        ARG = A1
[0946]               *        XML  FMUL                  FAC = X1*A1
[0947]               *        MOVE 8,G@RNDC1,@ARG        ARG = C1
[0948]               *        XML  FADD               T1=FAC = X1*A1+C1
[0949]               *        XML  VPUSH          (B)    FAC = T1
[0950]               *        MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
[0951]               *        XML  FMUL                  FAC = T1/1E7
[0952]               *        CALL GRINT              T2=FAC = INT(T1/1E7)
[0953]               *        XML  VPUSH          (C)    FAC = T2
[0954]               *        MOVE 8,G@RNDEP,@ARG        ARG = 1E7
[0955]               *        XML  FMUL                  FAC = T2*1E7
[0956]               *        DSUB 8,@VSPTR
[0957]               *        XML  SSUB           (D) X1=FAC = T1-T2*1E7
[0958]               *        MOVE 5,@FAC,V@RNDX1        FAC = X1 (new)
[0959]               *        XML  VPUSH          (E)    FAC = X1
[0960]               * COMPUTE NEW VALUE FOR X2, SAVE IT IN V@RNDX2
[0961]               *        MOVE 5,V@RNDX2,@FAC        FAC = X2
[0962]               *        CLR  @FAC5                 FAC = CLR
[0963]               *        DCLR @FAC6                 FAC = CLR
[0964]               *        MOVE 8,G@RNDA1,@ARG        ARG = A1
[0965]               *        XML  FMUL                  FAC = X2*A1
[0966]               *        DADD 8,@VSPTR
[0967]               *        XML  VPUSH          (F)    FAC = X2*A1
[0968]               *        DSUB 24,@VSPTR
[0969]               *        XML  VPOP           (G)    FAC = X1
[0970]               *        DADD 32,@VSPTR
[0971]               *        MOVE 8,G@RNDA2,@ARG        ARG = A2
[0972]               *        XML  FMUL                  FAC = X1*A2
[0973]               *        XML  SADD           (H)    FAC = X2*A1+X1*A2
[0974]               *        MOVE 8,G@RNDC2,@ARG        ARG = C2
[0975]               *        XML  FADD                  FAC = X2*A1+X1*A2
[0976]               *        XML  SADD           (J) T3=FAC = X2*A1+X1*A2
[0977]               *        DSUB 16,@VSPTR
[0978]               *        XML  VPUSH          (K)    FAC = T3
[0979]               *        MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
[0980]               *        XML  FMUL                  FAC = T3/1E7
[0981]               *        CALL GRINT              T4=FAC = INT(T3/1E7)

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0017 
EQUATES EXEC-359
[0982]               *        MOVE 8,G@RNDEP,@ARG        ARG = 1E7
[0983]               *        XML  FMUL                  FAC = T4*1E7
[0984]               *        XML  SSUB           (L) X2=FAC = T3-T4*1E7
[0985]               *        MOVE 5,@FAC,V@RNDX2        FAC = X2 (new)
[0986]               * COMPUTE NEW VALUE FOR RND, LEAVE IT IN FAC
[0987]               *        MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
[0988]               *        XML  FMUL                  FAC = X2/1E7
[0989]               *       XML  VPUSH          (M)    FAC = X2/1E7
[0990]               *        DADD 8,@VSPTR
[0991]               *        XML  VPOP           (N)    FAC = X1
[0992]               *        XML  FMUL                  FAC = X1/1E7
[0993]               *        XML  FMUL                  FAC = X1/1E14
[0994]               *        XML  SADD           (P)RND=FAC = (X2/1E7)+(X1/1E14
[0995]               *        XML  CONT
[0996]               ***********************************************************
[0997]               * CONSTANTS FOR THE RANDOM NUMBER ROUTINE
[0998]               * RNDA2  BYTE >43,>01,>2B,>59,>52,>00,>00,>00 * = 1438982
[0999]               * RNDA1  BYTE >42,>2A,>08,>15,>00,>00,>00,>00 * = 0420821
[1000]               * RNDC2  BYTE >43,>02,>0B,>20,>30,>00,>00,>00 * = 2113248
[1001]               * RNDC1  BYTE >43,>06,>36,>05,>13,>00,>00,>00 * = 6540519
[1002] A29F 43,0A,00 RNDEP  BYTE >43,>0A,>00,>00,>00,>00,>00,>00 * = 1E7
       A2A2 00,00,00
       A2A5 00,00
[1003] A2A7 3C,0A,00 RNDEM  BYTE >3C,>0A,>00,>00,>00,>00,>00,>00 * = 1/1E7
       A2AA 00,00,00
       A2AD 00,00
[1004]               ***********************************************************
[1005]               * RXB BASIC RND REPLACEMENT FROM TI BASIC
[1006] A2AF BE,4A,3F NRND   ST   >3F,@FAC       * Exponent    
[1007] A2B2 BE,10,4B        ST   >4B,@VAR5      * Loop counter
[1008] A2B5 02,63    NRND1  RAND >63            * 0?
[1009] A2B7 8E,78           CZ   @RANDOM        * No, go on
[1010] A2B9 42,C5           BR   NRND3     
[1011] A2BB 92,4A           DEC  @FAC           * 0?
[1012] A2BD 8E,4A           CZ   @FAC           * End with 0
[1013] A2BF 62,D2           BS   NRND4          * Go on
[1014] A2C1 42,B5           BR   NRND1
[1015] A2C3 02,63    NRND2  RAND >63            * Till 100
[1016] A2C5 BC,90,10 NRND3  ST   @RANDOM,*VAR5  * All digits
       A2C8 78
[1017] A2C9 D6,10,51        CEQ  >51,@VAR5      * Till >8351
[1018] A2CC 62,D4           BS   NRND5 
[1019] A2CE 90,10           INC  @VAR5          * Increase loop counter
[1020] A2D0 42,C3           BR   NRND2 
[1021] A2D2 86,4B    NRND4  CLR  @FAC1          * Set 0
[1022] A2D4 0F,75    NRND5  XML  CONT
[1023]               ***********************************************************


#7 TheBF OFFLINE  

TheBF

    Star Raider

  • Topic Starter
  • 94 posts

Posted Sat Apr 8, 2017 11:00 AM

 

:)

 

Yeah—and as Rich (RXB) has noted many times before, TI Extended Basic’s RND() does its own thing and takes even longer (much longer) than TI Basic’s RND().  One of these days, perhaps, I will attempt to see how XB does it.  And, even though I made a point of the possible maximum 70 times RAND can be called by TIB’s RND(), I would be willing to bet it rarely gets called more than 10 times, which would mean the first 2 calls to RAND both return 0.

 

Re “continued schooling”, I suspect that can get a little irritating, but I usually cannot help myself, particularly when someone makes the mistake  :grin: of appearing to listen.

 

...lee

 

lol.  Well I am old enough to know that I know very little. So I will continue listening.

 

By the way, for some reason I missed the fact that VCHAR and HCHAR could accept 32k character count until

I read the BASIC manual again. duh!

 

So I went back to the bible (TurboForth) to look at the ASM method.

 

You pointed out that in FBForth you re-wrote these things in ASM because they were so slow.

 

My HCHAR is fast because it uses VMBW.

 

My new VCHAR in Forth is about 1/3 the speed of Turbo Forth

which is not a bad number for a Forth vs pure ASM comparison.

 

I had to resort to a gratuitous variable. I will think it over more.

But this is an interesting example where stack juggling items 3 deep is a pain in the butt.

I could get to 1/2 speed of ASM probably by hand coding the LIMIT check inside the loop.

More...

( C/L is characters per line)
​( L/SCR is lines per screen )

: >VPOS ( col row -- VPOS) C/L@ * +  ;  ( calc VDP address from  col & row)

VARIABLE T
: VCHAR  ( col row char cnt -- ) ( parameter order not ideal so we shuffle)
         0 L/SCR 1- >VPOS 1-  T !  ( calc. the 1st screen limit)
         >R >R               ( -- x y ) ( push char & cnt to rstack)
         >VPOS               ( -- vdpaddr)  ( calc the Video position in memory)
         R> SWAP             ( -- char vadr) ( get the char and reverse order)
         R> 0                ( -- char vadr cnt index) ( all that crap to get this)
         ?DO                 ( -- char vadr) ( let 'er rip)
            2DUP VC!         ( write char to video memory)
            C/L+
            DUP T @ >        ( check for end of screen) 
            IF  T @ - THEN   
         LOOP
         2DROP ;


BF



#8 Lee Stewart ONLINE  

Lee Stewart

    River Patroller

  • 3,101 posts
  • Location:Silver Run, Maryland

Posted Sat Apr 8, 2017 11:38 AM

For more on VCHAR and HCHAR , see my my little dissertation and Mark and my exchange in the fbForth thread at post #1356 ff.

 

...lee



#9 RXB OFFLINE  

RXB

    River Patroller

  • 2,448 posts
  • Location:Vancouver, Washington, USA

Posted Sun Apr 9, 2017 3:02 AM

RXB has CALL HPUT(row,col,string,...) or CALL VPUT(row,col,variable$,...) and just for added measure CALL HGET(row,col,variable$,...) or CALL VGET(row,col,variable$,...)

 

These are much more powerful then HCHAR or VCHAR by a long shot. Also much more useful then GCHAR as you can fetch a string instead of just a single character.

 

But I did in RXB improve all of them by allowing more than one fetch at a time per call as in CALL GCHAR(row, col,variable,row2,col2,variable2,row3,col3,variable3,....)



#10 TheBF OFFLINE  

TheBF

    Star Raider

  • Topic Starter
  • 94 posts

Posted Sun Apr 9, 2017 8:28 AM

 

Yea I can save you the hassle of looking it is due to using Floating Point ALL THE TIME for all calculations unlike TI Basic RND that only return the Floating Point result.

[0898]               * Initialize random number generator 
[0899] A28D 31,00,0A INTRND MOVE 10,G@X2SEED,V@RNDX2
       A290 A3,A0,A2
       A293 95
[0900] A294 00              RTN
[0901] A295 42,03,23 X2SEED BYTE >42,>03,>23,>15,>00 * =   33521, X2 INITIAL VAL
       A298 15,00
[0902] A29A 43,02,3E X1SEED BYTE >43,>02,>3E,>2A,>17 * = 2624223, X1 INITIAL VAL
       A29D 2A,17
[0903]               ***********************************************************
[0904]               *                                                         *
[0905]               * RXB PATCH REPLACEMENT CODE FOR RND WITH TI BASIC RND    *
[0906]               *                                                         *
[0907]               ***********************************************************
[0908]               *           PSEUDO-RANDOM NUMBER GENERATOR
[0909]               *      X(N+1) = (A*X(N)+C) MOD M;  RND = X/M
[0910]               *    WHERE:                 X = X2 * 1E7 + X1
[0911]               *                           A = A2 * 1E7 + A1
[0912]               *                           C = C2 * 1E7 + C1
[0913]               *                           M = 1E14
[0914]               * ASSUMPTIONS:
[0915]               *  (1) All numbers are integers; fractional parts are
[0916]               *      truncated
[0917]               *  (2) If the variables listed below start in the ranges

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0016 
EQUATES EXEC-359
[0918]               *     specified. They will also end in the ranges specified
[0919]               *
[0920]               * CONSTANTS: 0 <= A2 < 5E6 ; 0 <= C2 < 1E7
[0921]               *            0 <= A1 < 5E6 ; 0 <= C1 < 1E7
[0922]               * VARIABLES: 0 <= X2 < 1E7 ; 0 <= T1 <= 1E14 ; 0 <= T2 < 1E
[0923]               *            0 <= X1 < 1E7 ; 0 <= T3 <= 1E14 ; 0 <= T4 < 1E
[0924]               *
[0925]               *        STACK USAGE:
[0926]               *            CONSTANT REFS      CONTANT REFS    CONTANT REF
[0927]               * +---------+      IN/OUT            IN/OUT          IN/OUT
[0928]               * | STACK+4 | X2*A1(F)(H)       --    ----      --    ----
[0929]               * +---------+
[0930]               * | STACK+3 |   T2 (C)(J)       --    ----      --    ----
[0931]               * +---------+
[0932]               * | STACK+2 |   T1 (B)(D)   new X1   (E)(N)     --    ----
[0933]               * +---------+
[0934]               * | STACK+1 |old X1(A)(G)       T3   (K)(L) new X2   (M)(P)
[0935]               * +---------+
[0936]               ***********************************************************
[0937]               * COMPUTE NEW VALUE FOR X1, SAVE IT IN V@RNDX1
[0938]               *                             STACK
[0939]               *                               SREFS   FAC CONTENTS
[0940]               * NRND   MOVE 5,V@RNDX1,@FAC        FAC = X1
[0941]               *        MOVE 5,V@RNDX1,@FAC        fAC = X1
[0942]               *        CLR  @FAC5                 FAC = CLR
[0943]               *        DCLR @FAC6                 FAC = CLR
[0944]               *        XML  VPUSH          (A)    FAC = X1
[0945]               *        MOVE 8,G@RNDA1,@ARG        ARG = A1
[0946]               *        XML  FMUL                  FAC = X1*A1
[0947]               *        MOVE 8,G@RNDC1,@ARG        ARG = C1
[0948]               *        XML  FADD               T1=FAC = X1*A1+C1
[0949]               *        XML  VPUSH          (B)    FAC = T1
[0950]               *        MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
[0951]               *        XML  FMUL                  FAC = T1/1E7
[0952]               *        CALL GRINT              T2=FAC = INT(T1/1E7)
[0953]               *        XML  VPUSH          (C)    FAC = T2
[0954]               *        MOVE 8,G@RNDEP,@ARG        ARG = 1E7
[0955]               *        XML  FMUL                  FAC = T2*1E7
[0956]               *        DSUB 8,@VSPTR
[0957]               *        XML  SSUB           (D) X1=FAC = T1-T2*1E7
[0958]               *        MOVE 5,@FAC,V@RNDX1        FAC = X1 (new)
[0959]               *        XML  VPUSH          (E)    FAC = X1
[0960]               * COMPUTE NEW VALUE FOR X2, SAVE IT IN V@RNDX2
[0961]               *        MOVE 5,V@RNDX2,@FAC        FAC = X2
[0962]               *        CLR  @FAC5                 FAC = CLR
[0963]               *        DCLR @FAC6                 FAC = CLR
[0964]               *        MOVE 8,G@RNDA1,@ARG        ARG = A1
[0965]               *        XML  FMUL                  FAC = X2*A1
[0966]               *        DADD 8,@VSPTR
[0967]               *        XML  VPUSH          (F)    FAC = X2*A1
[0968]               *        DSUB 24,@VSPTR
[0969]               *        XML  VPOP           (G)    FAC = X1
[0970]               *        DADD 32,@VSPTR
[0971]               *        MOVE 8,G@RNDA2,@ARG        ARG = A2
[0972]               *        XML  FMUL                  FAC = X1*A2
[0973]               *        XML  SADD           (H)    FAC = X2*A1+X1*A2
[0974]               *        MOVE 8,G@RNDC2,@ARG        ARG = C2
[0975]               *        XML  FADD                  FAC = X2*A1+X1*A2
[0976]               *        XML  SADD           (J) T3=FAC = X2*A1+X1*A2
[0977]               *        DSUB 16,@VSPTR
[0978]               *        XML  VPUSH          (K)    FAC = T3
[0979]               *        MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
[0980]               *        XML  FMUL                  FAC = T3/1E7
[0981]               *        CALL GRINT              T4=FAC = INT(T3/1E7)

99/4 GPL-ASSEMBLER (Pass 3) correct                                   PAGE 0017 
EQUATES EXEC-359
[0982]               *        MOVE 8,G@RNDEP,@ARG        ARG = 1E7
[0983]               *        XML  FMUL                  FAC = T4*1E7
[0984]               *        XML  SSUB           (L) X2=FAC = T3-T4*1E7
[0985]               *        MOVE 5,@FAC,V@RNDX2        FAC = X2 (new)
[0986]               * COMPUTE NEW VALUE FOR RND, LEAVE IT IN FAC
[0987]               *        MOVE 8,G@RNDEM,@ARG        ARG = 1/1E7
[0988]               *        XML  FMUL                  FAC = X2/1E7
[0989]               *       XML  VPUSH          (M)    FAC = X2/1E7
[0990]               *        DADD 8,@VSPTR
[0991]               *        XML  VPOP           (N)    FAC = X1
[0992]               *        XML  FMUL                  FAC = X1/1E7
[0993]               *        XML  FMUL                  FAC = X1/1E14
[0994]               *        XML  SADD           (P)RND=FAC = (X2/1E7)+(X1/1E14
[0995]               *        XML  CONT
[0996]               ***********************************************************
[0997]               * CONSTANTS FOR THE RANDOM NUMBER ROUTINE
[0998]               * RNDA2  BYTE >43,>01,>2B,>59,>52,>00,>00,>00 * = 1438982
[0999]               * RNDA1  BYTE >42,>2A,>08,>15,>00,>00,>00,>00 * = 0420821
[1000]               * RNDC2  BYTE >43,>02,>0B,>20,>30,>00,>00,>00 * = 2113248
[1001]               * RNDC1  BYTE >43,>06,>36,>05,>13,>00,>00,>00 * = 6540519
[1002] A29F 43,0A,00 RNDEP  BYTE >43,>0A,>00,>00,>00,>00,>00,>00 * = 1E7
       A2A2 00,00,00
       A2A5 00,00
[1003] A2A7 3C,0A,00 RNDEM  BYTE >3C,>0A,>00,>00,>00,>00,>00,>00 * = 1/1E7
       A2AA 00,00,00
       A2AD 00,00
[1004]               ***********************************************************
[1005]               * RXB BASIC RND REPLACEMENT FROM TI BASIC
[1006] A2AF BE,4A,3F NRND   ST   >3F,@FAC       * Exponent    
[1007] A2B2 BE,10,4B        ST   >4B,@VAR5      * Loop counter
[1008] A2B5 02,63    NRND1  RAND >63            * 0?
[1009] A2B7 8E,78           CZ   @RANDOM        * No, go on
[1010] A2B9 42,C5           BR   NRND3     
[1011] A2BB 92,4A           DEC  @FAC           * 0?
[1012] A2BD 8E,4A           CZ   @FAC           * End with 0
[1013] A2BF 62,D2           BS   NRND4          * Go on
[1014] A2C1 42,B5           BR   NRND1
[1015] A2C3 02,63    NRND2  RAND >63            * Till 100
[1016] A2C5 BC,90,10 NRND3  ST   @RANDOM,*VAR5  * All digits
       A2C8 78
[1017] A2C9 D6,10,51        CEQ  >51,@VAR5      * Till >8351
[1018] A2CC 62,D4           BS   NRND5 
[1019] A2CE 90,10           INC  @VAR5          * Increase loop counter
[1020] A2D0 42,C3           BR   NRND2 
[1021] A2D2 86,4B    NRND4  CLR  @FAC1          * Set 0
[1022] A2D4 0F,75    NRND5  XML  CONT
[1023]               ***********************************************************

 

This is great stuff. Thanks!

 

BF


  • RXB likes this




0 user(s) are browsing this forum

0 members, 0 guests, 0 anonymous users