Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Posting-Version: version B 2.10.2 9/18/84; site watnot.UUCP Path: utzoo!watmath!watnot!ccplumb From: ccplumb@watnot.UUCP (Colin Plumb) Newsgroups: net.lang.forth Subject: FORTH control structures - A proposal Message-ID: <12093@watnot.UUCP> Date: Sun, 19-Oct-86 23:08:28 EDT Article-I.D.: watnot.12093 Posted: Sun Oct 19 23:08:28 1986 Date-Received: Tue, 21-Oct-86 21:55:06 EDT Reply-To: ccplumb@watnot.UUCP (Colin Plumb) Followup-To: net.lang.forth Distribution: net Organization: U of Waterloo, Ontario Lines: 250 Keywords: if else then begin while repeat until do leave loop +loop Summary: Adding functionality to existing FORTH control structures : LINE-EATER 80 EXPECT DROP ; In the July, 1986 issue of _Dr. Dobb's Journal of Software Tools_ (the annual FORTH issue), George W. Shaw II proposes some extensions to the standard FORTH control structures. While I think some of his ideas are good, I feel that they got rather mangled somewhere along the way. (i.e. Aren't implemented well.) Herein are some of my suggestions. The main idea in George Shaw's article was that of using linked lists instead of the stack to store information about forward branches. Since a cell has to be allocated after BRANCH or ?BRANCH in a definition to store the branch address, which isn't available until the branch is resolved, it can be put to use to allow a BEGIN-WHILE loop to have the structure: "BEGIN", any number of "WHILE"s (including 0), and "REPEAT" or "UNTIL", as in this example: : FOO BEGIN aaa WHILE bbb WHILE ccc UNTIL ; where the linked list uses a variable as its head pointer, resulting in this dictionary organization jusrt before "until" resolves the works: {header stuff} aaa ?BRANCH ___ bbb ?BRANCH ___ ccc ^ | ^ | ^ STACK ----------+ null <+ +-------------+ +----- LIST-PTR and, after UNTIL, we have: +--------------------------------------------+ v | {header stuff} aaa ?BRANCH ___ bbb ?BRANCH ___ ccc ?BRANCH ___ | | ^ +-------------->+------------------+ which is just as it should be. This can also be used to allow a word such as THENS, which fixes all the IF aaa IF bbb IF ccc THEN THEN THEN stuff that you often have to wade through. Before the first THEN, things would look like this: {header stuff} ?BRANCH ___ aaa ?BRANCH ___ bbb ?BRANCH ___ ccc | ^ | ^ | ^ null <-+ +-------------+ +-------------+ +- IF-PTR and THENS could resolve the whole linked list like so: {header stuff} ?BRANCH ___ aaa ?BRANCH ___ bbb ?BRANCH ___ ccc | | | ^ +-------------->+-------------->+------+ as it should be. Just plain THEN would just resolve the last link of the list. ELSE would change the list from this: {header stuff} ?BRANCH ___ aaa | ^ null <-+ +---- IF-PTR to this: +-----------------+ | v {header stuff} ?BRANCH ___ aaa BRANCH ___ | ^ null <-+ +--- IF-PTR by just patching the last link of the list. The other control word which can benifit from this is the F-83 standard LEAVE, which branches _immediately_ to past the end of the loop. Since there is no constant number of LEAVEs in a DO-LOOP, the stack can't be used to store forward branch addresses for LOOP to patch. A linked list works admirably int this application. Since DO-LOOPs and BEGINs can be nested, it is necessary to put the head pointer for the outer loop on the stack while the inner loop uses it for bookkeeping. Since DO and BEGIN already use the stack to store backwards-branch information, the addition of an extra value there should not upset anyone else's compile-time use of the stack. One really wonderful (I modestly think) consequence of this system is that IF, ELSE, and THEN make _no_ use of the stack whatsoever at compile time, thus allowing words like this: : BAR aaa BEGIN bbb IF ccc REPEAT ddd THEN eee ; That is, looping constructs such as BEGIN and REPEAT can be put inside IF statements. The most crying need for this is in the use of a LEAVE command. It's easy to write: : HUNT 0 1000 DO aaa IF ." Search succeeds for n = " . LEAVE THEN bbb LOOP ; but how do you add a "Search fails" message, to be printed if the loop ends by reaching 1000 with no result? The answer is: : HUNT 0 1000 DO aaa IF ." Success! n = " . ELSE bbb LOOP ." Failed" THEN ; which I think is rather more elegant than putting a flag on the stack and testing it after the LOOP. The only catch is that a DO-LOOP puts some values on the return stack, which have to be cleaned up before EXIT sees them and crashes the system. An ENDLOOP word can be added somewhere between IF and ELSE to straighten this out: : ENDLOOP ( --) R> ( save return address to calling word) R> R> 2DROP ( get rid of index and limit) >R ( put return address back) ; This use of intersecting control structures is quite commonly used in interpreted BASIC (yes, I admit it, that's where I started), and I don't see why I should have to give up a useful control structure when using a better language. Now, the guts of this article: the code. Note: If you can think up better names for any of the words I use in this code, I'd loove to hear them. I _do_ use a few clumsy multi-word names, which isn't great. ******* WARNING: This code is UNTESTED. It is in no ******* ******* way guaranteed to work, and in fact probably ****** ***** _won't_ work the forst time around. Good luck! ***** ( A few things you might not have - F-83 standard and otherwise) : 0! 0 SWAP ! ; ( fairly obvious) : >MARK HERE 2 ALLOT ; ( -- addr) ( see F-83 standard) : >RESOLVE HERE SWAP ! ; ( addr --) ( ditto) : LISTMARK ( addr --) ( mark forward branch origin using list "addr") HERE SWAP DUP ( here addr addr) @ ( here addr list-head) , ( here addr) ( point this link to last one) ! ; ( ) ( make list-ptr point to this link) : >LISTRESOLVE ( addr --) ( resolve forward branch) DUP @ ( addr list-head) DUP @ ( addr list-head new-list-head) ROT ! ( list-head) (make list-ptr point to previous link) >RESOLVE ; ( ) ( do standard resolution stuff) : >RESOLVELIST ( addr --) ( resolve entire list) DUP 0! @ ( list-head) ( go down one link and set list-ptr to null) BEGIN DUP WHILE ( list-head) ( when the list-head is null, we've reached the end) DUP @ SWAP ( new-list-head list-head) >RESOLVE ( new-list-head) ( resolve this link) REPEAT ( null) DROP ; ( ) : IF ( --) COMPILE ?BRANCH ( just like regular IF) IF-LIST >LISTMARK ; ( mark forward branch) ; IMMEDIATE : ELSE ( --) COMPILE BRANCH IF-LIST >LISTMARK ( These two lines are rather tricky) IF-LIST @ >LISTRESOLVE ( Follow the algorithm to prove they work) ; IMMEDIATE : THEN ( --) IF-LIST >LISTRESOLVE ( does this need explaining?) ; IMMEDIATE : THENS ( --) ( like THEN THEN THEN...., as often as necessary) IF-LIST >RESOLVELIST ; IMMEDIATE : BEGIN ( -- old-list-ptr back-branch-ptr) BEGIN-LIST DUP @ ( 'list-ptr contents-of-list-ptr) SWAP 0! ( old-list-ptr) ( The list-ptr now contains null, ready for this nesting level) LISTMARK ; IMMEDIATE : REPEAT ( old-list-ptr back-branch-ptr --) COMPILE BRANCH RESOLVELIST ( old-list-ptr 'list-ptr) ! ( ) ; IMMEDIATE : UNTIL ( old-list-ptr back-branch-ptr --) ( The stack comments here are the same as those for REPEAT. These comments on what's going on also apply to REPEAT.) COMPILE ?BRANCH RESOLVELIST ( Make all the WHILEs point to just past the UNTIL, keeping a copy of the address of BEGIN-LIST...) ! ( ...to restore the old list pointer to) ; IMMEDIATE : DO ( -- old-list-ptr back-branch-ptr) DO-LIST DUP @ ( 'list-ptr old-list-ptr) ( save old DO-LIST) SWAP 0! ( old-list-ptr) ( set DO-LIST to null) COMPILE (DO) ( old-list-ptr) ( DO run-time part) LISTMARK ; IMMEDIATE : LOOP ( old-list-ptr back-branch-ptr --) ( see BEGIN and UNTIL for comments) COMPILE (LOOP) RESOLVELIST ! ; IMMEDIATE : +LOOP ( old-list-ptr back-branch-ptr --) COMPILE (+LOOP) RESOLVELIST ! ; IMMEDIATE : ENDLOOP ( --) ( clear LOOP's gunk off the return stack) R> R> R> 2DROP >R ; ( you've seen the comments already!) EXIT ( ignore final comments) Note: I did copy quite a bit of the preceeding code from the DDJ article. DDJ has a policy of allowing use of any code published therein for non-commercial use. If you intend to sell this code in a product, you might want to talk to them (M&T Publishing, Inc., 501 Galveston Dr., Redwood City, CA 94063, U.S.A.) first. Myself, I've no objections *whatsoever* to *any* use of these ideas - I'd find it highly flattering. I'd like it even better if you'd tell me about it, or even give me a copy. Since George Shaw is proposing this as a new standard, I don't think he'll mind anyone spreading it around. (I'm proposing mine as a *better* standard) I hope you find this interesting! - Colin Plumb (ccplumb@watnot.UUCP) Quote: : LIFE BEGIN 5 0 DO WORK LOOP SLEEP SLEEP REPEAT ; ( See? With these new control structures you don't need AGAIN or 0 UNTIL!)