6502.org Forum  Projects  Code  Documents  Tools  Forum
It is currently Sun Nov 10, 2024 5:05 am

All times are UTC




Post new topic Reply to topic  [ 3 posts ] 
Author Message
PostPosted: Fri Dec 30, 2011 9:44 pm 
Online
User avatar

Joined: Fri Aug 30, 2002 1:09 am
Posts: 8538
Location: Southern California
In this topic, I mentioned writing 32-bit DO LOOP words, 2BOUNDS 2DO 2?DO 2I 2LEAVE 2?LEAVE 2UNLOOP 2LOOP 2+LOOP and four internals. I am posting the code here. Bruce, if you want to put it on the wiki, be my guest; also Mike, to link to it on the code section of this website. If there are any corrections or improvements, they will show up on the URL above first.

Edit: Moved to my own website, at http://wilsonminesco.com/Forth/32DOLOOP.FTH . It's also still at my portion of our son's website but gradually things will all get moved to my own.

_________________
http://WilsonMinesCo.com/ lots of 6502 resources
The "second front page" is http://wilsonminesco.com/links.html .
What's an additional VIA among friends, anyhow?


Top
 Profile  
Reply with quote  
PostPosted: Sun Apr 20, 2014 1:58 am 
Offline
User avatar

Joined: Sun Jun 30, 2013 10:26 pm
Posts: 1948
Location: Sacramento, CA, USA
Garth, I just noticed that F83 uses a "fudge-factored" index that ensures that LOOP and +LOOP are finished if and only if the overflow flag is set during the index update. This greatly simplifies those two words, at the expense of a bit more work in DO and I

Have you considered trying this modification with your 32-bit versions? If not, I don't mind giving it a try and letting you know how it goes. I've already completed the 65m32 versions (untested until I can get my simulator up and running):
Code:
                 |  429 ;-------------------------------------------------------------
00000182:0000017a|  430         HEAD not_imm, '(DO)'
00000183:8428444f|  430
00000184:29000000|  430
                 |  431 XDO:   ; ( n1|u1 n2|u2 -- R: -- sys1 sys2 )               (DO)
                 |  432 ; '83 and ANSI standard loops terminate when the boundary
                 |  433 ;   of limit-1 and limit is crossed, in either direction.
                 |  434 ; This can be conveniently implemented by making the limit
                 |  435 ;   $80000000, so that arithmetic overflow logic can detect
                 |  436 ;   crossing.  This trick is from Laxen & Perry F83.
                 |  437 ; Fudge-factor = $80000000 - limit, to be added to the
                 |  438 ;   start value.  The fudge-factor is stored in place of
                 |  439 ;   limit on the rstack, and is used by I and J to retrieve
                 |  439 ;   the unmodified index values.
00000185:00000186|  440         .dw  .+1
00000186:50000000|  441         tab             ; Save initial index in b
00000187:40070000|  442         lda  #$80000000 ; Get limit from 2OS and
00000188:80000000|  442
00000189:1a020000|  443         sub  ,x+        ;   transform it into "fudge-factor"
0000018a:62020000|  444         pda  ,x+        ; Push it on rstack in place of limit
0000018b:f10c0000|  445         adb  ,s         ; Modified index = index + fudge
0000018c:b30c0000|  446         phb             ; Push modified index on rstack
0000018d:5c0ffebf|  447         bra  _next
                 |  448 ;-------------------------------------------------------------
0000018e:00000183|  449         HEAD not_imm, '(LOOP)'
0000018f:86284c4f|  449
00000190:4f502900|  449
                 |  450 XLOOP: ; ( R: sys1 sys2 -- | sys1 sys2 )                (LOOP)
                 |  451 ; Run-time code for LOOP.  Add 1 to index, loop until
                 |  452 ;   "fudge-factored" overflow, clean up rstack on exit
00000191:00000192|  453         .dw  .+1
00000192:a3020000|  454         sta  ,-x
00000193:40060001|  455         lda  #1
00000194:5c0e0004|  456         bra  XPLOOP+1
                 |  457 ;-------------------------------------------------------------
00000195:0000018f|  458         HEAD not_imm, '(+LOOP)'
00000196:87282b4c|  458
00000197:4f4f5029|  458
                 |  459 XPLOOP: ; ( n --  R: sys1 sys2 -- | sys1 sys2 )        (+LOOP)
                 |  460 ; Run-time code for +LOOP.  Add n to index, loop until
                 |  461 ;   "fudge-factored" overflow, clean up rstack on exit
00000198:00000199|  462         .dw  .+1
00000199:110c0000|  463         add  ,s         ; index += TOS, set V if done
0000019a:a10c0000|  464         sta  ,s
0000019b:62020000|  465         lda  ,x+        ; Get new TOS
0000019c:5c8fffda|  466         bvc  BRANCH+1   ; Not done: loop
0000019d:dc0c0002|  467         inc  #2,s       ; Done: clean up rstack
0000019e:5c0fffe1|  468         bra  _bump      ;   and skip the loop branch offset
                 |  469 ;-------------------------------------------------------------
0000019f:00000196|  470     HEAD not_imm, 'I'
000001a0:81490000|  470
                 |  471 I:     ; ( -- n  R: sys1 sys2 -- sys1 sys2 )                 I
                 |  472 ; Copy innermost loop index from rstack
000001a1:000001a2|  473         .dw  .+1
000001a2:a3020000|  474         sta  ,-x        ; Make room in TOS
000001a3:410c0000|  475         lda  ,s         ; Get fudged index from rstack
000001a4:190c0001|  476         sub  1,s        ; Un-fudge it
000001a5:5c0ffea7|  477         bra  _next
                 |  478 ;-------------------------------------------------------------
000001a6:000001a0|  479         HEADER  not_imm, 'J'
000001a7:814a0000|  479
                 |  480 JJ:    ; ( -- n R: 4*sys -- 4*sys )                          J
                 |  481 ; Get the second loop index from rstack
000001a8:000001a9|  482         .dw  .+1
000001a9:a3020000|  483         sta  ,-x        ; Make room in TOS
000001aa:410c0002|  484         lda  2,s        ; Get fudged index from rstack
000001ab:190c0003|  485         sub  3,s        ; Un-fudge it
000001ac:5c0ffea0|  486         bra  _next
                 |  487 ;-------------------------------------------------------------
000001ad:000001a7|  488         HEADER  not_imm, 'UNLOOP'
000001ae:86554e4c|  488
000001af:4f4f5000|  488
                 |  489 UNLOOP: ; ( -- R: sys1 sys2 -- )   Drop loop parms      UNLOOP
000001b0:000001b1|  490         .dw  .+1
000001b1:dc0c0002|  491         inc  #2,s       ; Done: clean up rstack
000001b2:5c0ffe9a|  492         bra  _next
                 |  156 ;-------------------------------------------------------------

Mike


Top
 Profile  
Reply with quote  
PostPosted: Sun Apr 20, 2014 3:06 am 
Online
User avatar

Joined: Fri Aug 30, 2002 1:09 am
Posts: 8538
Location: Southern California
barrym95838 wrote:
Garth, I just noticed that F83 uses a "fudge-factored" index that ensures that LOOP and +LOOP are finished if and only if the overflow flag is set during the index update. This greatly simplifies those two words, at the expense of a bit more work in DO and I

Have you considered trying this modification with your 32-bit versions?

The commercial Forth we started with when I did the ATE shown in my project pages on this site did something similar. Actually they made it so the cell at the top of the return stack was a difference instead of the index value itself, so that loop (the internal compiled by LOOP) would not have to compare it to the limit. It led to extra debugging time when I did something slightly out of the ordinary in a loop, so it and I are not on good terms, and I swore that when I change what's left of the original material that's not from FIG so I could publish my version, I would go back to the other way of doing it. :mrgreen:

In my '816 Forth, the normal way only leads to one extra instruction CMP 3,S for loop, although +loop gets a little more complex.

_________________
http://WilsonMinesCo.com/ lots of 6502 resources
The "second front page" is http://wilsonminesco.com/links.html .
What's an additional VIA among friends, anyhow?


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 3 posts ] 

All times are UTC


Who is online

Users browsing this forum: No registered users and 2 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to: