[comp.lang.forth] Allowing control structures in interpret state

toma@tekgvs.LABS.TEK.COM (Tom Almy) (12/30/89)

comp.lang.forth readers:

I wrote, about 8 years ago, an IC CAD program in Forth. While the original
ran on a TRS-80, currently people use it on 80386 PCs running UR/FORTH 386
(protected mode program). One unusual feature about this design environment
is that it has both a graphical and text interface. The text interface is
used to algorithmically define layout structures.

Of course the text language is built on top of Forth. In order to help
non-Forth people (in fact, non-programmers!) to use Forth I made several
changes to the user interface. I am including the code for one of these
here to eliven the group.

One of the problems with Forth for naive users is that control structures
can only be used in colon definitions. Since users of my CAD program often
want iterative control structures but seldom need to write their own
functions, this was quite a problem.  Some Forth variations (STOIC comes
first to mind) compile everything typed in and don't have this problem. I
solved the problem by having control structures force compilation if they
are executed outside of a colon definition. The result greatly enhances the
consistancy of Forth while causing no execution time penalty.

The idea is based on the transient colon definitions that I read about in
Forth Dimensions many years ago. I can't locate the article now to give
proper credit. I expanded on the idea, and eventually incorporated it into
the CAD program. This code is also available on the Laboratory Microsystems
BBS.

While this code is implementation specific (UR/Forth in this case) it should
port easily to other Forths. I have factored out the implementation dependent
stuff. The differences should be limited to 1) how to build definition headers
2) how to enter/leave compile state  and 3) how to trap errors.



The following code is Copyright (C) 1988, Thomas Almy.  All rights reserved.
You may freely use this code for non-commercial use only, providing credit
is given.

VARIABLE dataaddr   \ WHERE TO RESET DATA POINTER, DP (or HERE)

VARIABLE oldabt  \ old abort vector

VARIABLE bumper      \ nesting depth of control structures

1024 CONSTANT dpoffset  \ room for dictionary expansion
\ The transient definition is built this distance from HERE so that the
\ definition can itself add stuff to the dictionary
\ dpoffset represents the maximum number of bytes that the definition can add

\ UR/Forth dependent code to catch ABORT if an error occurs during compilation

: rstvec ( restore pointers and abort vector )
     dataaddr @ DP !		\ reset dictionary
     oldabt @ vABORT !		\ reset abort vector
     bumper OFF ;		\ reset counter to interpret state

: abort ( ABORT for when error occurs in :: definition )
     rstvec			\ reset everything
     ABORT ;			\ do original abort things

: setvec ( set pointer save values and abort vector )
     HERE dataaddr !		\ save dictionary pointer for later restore
     vABORT @ oldabt !		\ save old ABORT vector
     ['] abort vABORT !  ;	\ set new ABORT vector


\ defstart and defend are implementation specific on header structure
\ and manner of entering/exiting compiler
\ You can figure out most of this stuff four your system by looking at
\ what : and ; do.


: defstart ( build a definition start )
      EVEN 			\ force word allignment
      1 bumper !		\ say we are now transient compiling
      setvec			\ catch any ABORTs
      dpoffset ALLOT            \ allow dictionary space when defn is exec'ed
      HERE 12 + DUP PFA,  nest JMP, \ build code field (UR/Forth is DTC)
      PFA>LAST			\ lets system know where latest header is
      EVEN			\ force word allignment again
      !CSP                     	\ set marker for compilation errors
      [COMPILE] ]  ;		\ enter compile state



: defend
	?CSP ?COMP		\ error checks
	COMPILE unnest      	\ end definition (some systems this is EXIT)
	[COMPILE] [         	\ return to interpret state
	rstvec              	\ restore hooked ABORT vector, restore 
				\ dictionary pointer
	HERE dpoffset + EXECUTE \ exec the transient definition
;


: bumpup  ( routine -- )
     STATE @ IF		\ already compiling
       bumper @ IF 1 bumper +! THEN	\ nest deeper if transient defn
       EXECUTE				\ do the routine
     ELSE		\ not compiling -- start transient defn
       >R defstart
       ] 		\ not sure why (or if) this is needed????
       R> EXECUTE 	\ do the routine
     THEN ;

: bumpdown
     bumper @ IF	\ if we are in transient definition
       -1 bumper +!	\ one less nesting -- execute if out of all nestings
       bumper @ 0= IF  defend  THEN
     THEN ;

\ Original transient colon definition functions.
\ these are really obsolete now!

: ::  ( just compile and execute what follows )
      defstart                 ( build start )
      ;

: ;;  ( alternative way, other than the new ";" to end :: definition )
      defend ;  IMMEDIATE


\ Redefinition of some "compile only" words, so that they can be used in
\ interpret state.

: IF  ['] IF bumpup ; IMMEDIATE
: THEN [COMPILE] THEN bumpdown ; IMMEDIATE
: DO  ['] DO bumpup ; IMMEDIATE
: ?DO ['] ?DO bumpup ; IMMEDIATE
: LOOP [COMPILE] LOOP bumpdown ; IMMEDIATE
: +LOOP [COMPILE] +LOOP bumpdown ; IMMEDIATE
: BEGIN ['] BEGIN bumpup ; IMMEDIATE
: UNTIL [COMPILE] UNTIL bumpdown ; IMMEDIATE
: REPEAT [COMPILE] REPEAT bumpdown ; IMMEDIATE
: CASE ['] CASE bumpup ; IMMEDIATE
: ENDCASE [COMPILE] ENDCASE bumpdown ; IMMEDIATE
: ; bumper @ IF defend ELSE [COMPILE] ; THEN ; IMMEDIATE

\ The following *SHOULD* have been the 83 Standard definition!
\ This has nothing to do with the above code, but is nice for completeness

: ."  STATE @ IF [COMPILE] ." ELSE
      ASCII " WORD  COUNT TYPE THEN  ;  IMMEDIATE


EXCISE dataaddr  bumpdown	\ UR/Forth'ism to toss unneeded headers



Tom Almy
toma@tekgvs.labs.tek.com
Standard Disclaimers Apply

wmb@SUN.COM (Mitch Bradley) (12/30/89)

Here's an implementation of interpreted control structures that
can be loaded directly on top of F83 (and presumably F-PC too).

Although conceived and developed entirely independently from Tom Almy's
recently-posted version, it is remarkably similar in many respects.
In fact, the actual version that I use inside my own kernel is even
more similar to Tom's version (in terms of error handling and location
of the transient area away from HERE).

You are free to use this code for any purpose whatever, including
commercial use.  For several years, I have been encouraging other
implementors to include this facility in all their systems, just because
it is so easy and useful that it is stupid for Forth not to have it.
I have also proposed that the ANSI standard remove the "compilation
only" restriction from control structures, based on the use of this
technique.  (If the proposal passes, I'll be pretty surprised, though).

To guard against aborts, it's a good idea to include the following
code inside QUIT:   level @  if  saved-dp @ here - allot  then

For more information, see:  Interpreting Control Structures - The Right Way,
1987 FORML Proceedings.



variable saved-dp  variable level

: +level  ( -- )
   level @  if
      \ If in compile state, just increment level
      1 level +!
   else state @ 0=  if
      \ If interpret state, switch to compile state
      1 level !
      here saved-dp ! \ Remember the start
      r> ['] ]  >body >r >r \ Execute ] after the caller
   then
;

: -level  ( -- )
   state @ 0=  abort" Conditionals not paired"
   level @  if
      -1 level +!  level @ 0=  if
          compile exit     \ Finish the definition
   saved-dp @ here - allot  \ Reclaim the memory
   [compile] [     \ Enter interpret state
          here >r     \ Execute the definition
      then
   then
;

: begin  +level  [compile] begin  ; immediate
: do     +level  [compile] do     ; immediate
: ?do    +level  [compile] ?do    ; immediate
: if     +level  [compile] if     ; immediate
: then   [compile] then   -level  ; immediate
: loop   [compile] loop   -level  ; immediate
: +loop  [compile] +loop  -level  ; immediate
: until  [compile] until  -level  ; immediate
: again  [compile] again  -level  ; immediate
: repeat [compile] repeat -level  ; immediate