Path: utzoo!utgpu!jarvis.csri.toronto.edu!clyde.concordia.ca!uunet!zephyr.ens.tek.com!tekcrl!tekgvs!toma From: toma@tekgvs.LABS.TEK.COM (Tom Almy) Newsgroups: comp.lang.forth Subject: Allowing control structures in interpret state Message-ID: <6581@tekgvs.LABS.TEK.COM> Date: 29 Dec 89 19:33:08 GMT Reply-To: toma@tekgvs.LABS.TEK.COM (Tom Almy) Organization: Tektronix, Inc., Beaverton, OR. Lines: 153 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