There is an interesting property of Fleet Forth's DO LOOP's. Detailed information is provided on Fleet Forth's DO LOOP's here.
Consider the word used to remove trailing blanks from the count of a string's address count pair, -TRAILING
Code:
: -TRAILING ( ADR CNT1 -- ADR CNT2 )
DUP 0
?DO
2DUP + 1- C@ BL <> ?LEAVE
1-
LOOP ;
Here is what gets compiled:
Code:
SEE -TRAILING
-TRAILING
6748 5002 DUP
6750 3293 0
6752 2358 (?DO) 6776
6756 5284 2DUP
6758 4884 +
6760 4815 1-
6762 3576 C@
6764 2709 BL
6766 4474 <>
6768 2128 ?LEAVE
6770 4815 1-
6772 2149 (LOOP) 6756
6776 2469 EXIT
30
OK
If the count is zero (?DO) will branch to the address which is stored in the cell which follows. This address (address 6776) is also present when (DO) is compiled. It is the address which is pushed on the return stack for any LEAVE or ?LEAVE . It is also the address used by (LOOP) if the DO LOOP runs to completion. If a different address is stored in the cell after (?DO) , the EXIT at address 6776 will not be reached.
Here is the word SPACE
Code:
: SPACE ( -- ) BL EMIT ;
Simple and to the point, it emits one space character.
Code:
SEE SPACE
SPACE
6661 2709 BL
6663 2931 EMIT
6665 2469 EXIT
6
OK
Notice that address 6665 in SPACE also has the word EXIT . If the address after the (?DO) in -TRAILING is replaced with this address, -TRAILING will work exactly as before. The only difference is the EXIT at the end of -TRAILING will not be reached. Not by (?DO) if the count of the string is zero, not by ?LEAVE if there are no more blanks in the string, and not by (LOOP) if the loop runs to completion. They will all branch to address 6665.
The following modification to the source will result in that change.
Code:
: -TRAILING ( ADR CNT1 -- ADR CNT2 )
DUP 0
?DO
2DUP + 1- C@ BL <> ?LEAVE
1-
LOOP -;
' SPACE >BODY 4 + HERE 2- @ 2- !
Dash semicolon -; finishes the definition without compiling EXIT . The phrase
' SPACE >BODY 4 +
returns the address where there is an EXIT , address 6665 in this case.
HERE 2- @ 2-
backs up to the address of the branch used by (LOOP) and follows it then backs up to the address of the branch used by (?DO) .
Finally, store ! changes the address to 6665.
Code:
SEE -TRAILING
-TRAILING
6748 5002 DUP
6750 3293 0
6752 2358 (?DO) 6665
6756 5284 2DUP
6758 4884 +
6760 4815 1-
6762 3576 C@
6764 2709 BL
6766 4474 <>
6768 2128 ?LEAVE
6770 4815 1-
6772 2149 (LOOP) 6756
28
OK
Okay, a minor savings of two bytes; however, there is no cost in performance. Here is another example. Fleet Forth's ID. TYPE and QTYPE . QTYPE is used by LIST since a BLOCK might not contain a screen of source. It could be virtual memory or some other type of data.
Code:
: ID. ( NFA -- )
1+
BEGIN
COUNT $7F 2DUP AND QEMIT >
UNTIL
DROP PAUSE ;
: TYPE ( ADR CNT -- )
0
?DO
COUNT EMIT
LOOP
DROP PAUSE ;
: QTYPE ( ADR CNT -- )
0
?DO
COUNT QEMIT
LOOP
DROP PAUSE ;
The following modification shaves six bytes off of TYPE and six bytes off of QTYPE .
Code:
: ID. ( NFA -- )
1+
BEGIN
COUNT $7F 2DUP AND QEMIT >
UNTIL
[ HERE >A ]
DROP PAUSE ;
: TYPE ( ADR CNT -- )
0
?DO
COUNT EMIT
LOOP -;
A@ HERE 2- @ 2- !
: QTYPE ( ADR CNT -- )
0
?DO
COUNT QEMIT
LOOP -;
A> HERE 2- @ 2- !
Since this technique is the epitome of highly non portable code, I will most likely confine its use to Fleet Forth's kernel and system loader.
To be clear, this type of DO LOOP places three parameters on the return stack: The address in the cell following (?DO) or (DO) , the loop limit, and the loop index (actually modified versions of the limit and index).
The loop words (?DO) LEAVE ?LEAVE (LOOP) and (+LOOP) all leave the loop by way of this address. (?DO) uses that address to avoid the loop entirely if the limit and initial index are identical.
If this type of DO LOOP were the norm, it would be interesting to see what other creative use could be made of it.
Login
Register
FAQ
Search
