home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / autofor.seq < prev    next >
Encoding:
Text File  |  1988-12-06  |  3.5 KB  |  86 lines
  1. \ AUTOFOR.SEQ   experimental auto forward referencing   by Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   This file contains the tools to allow automatic forward reference
  6. resolution of Forth words.  there is a runtime overhead which is
  7. equivalent to a DEFERed word.  Words that are forward referenced are
  8. automatically defined, and then when really defined, they are automatically
  9. resolved.
  10.  
  11. comment;
  12.  
  13. 0 value savein
  14.  
  15. : F]            ( -- )  \ Automatic defing of forward referenced words
  16.                         \ as they are encountered.
  17.                 state on
  18.         begin   ?stack
  19.                 >in @ !> savein                 \ Preserve >IN
  20.                 defined dup
  21.                 if      0>
  22.                         if    execute
  23.                         else   x,   then
  24.                 else    drop    %number  0=
  25.                         if      2drop           \ cleanup stack
  26.                                 reveal          \ include this definition
  27.                                 warning @
  28.                                 if      cr here count type
  29.                                         ."  creating forward reference"
  30.                                 then
  31.                                 savein !> >in   \ Restore >IN
  32.                                 here x,         \ compile HERE in existing def
  33.                                 defer           \ create a new DEFERed word
  34.                         else    double?
  35.                                 if          [compile] dliteral
  36.                                 else drop   [compile] literal   then
  37.                         then
  38.                 then    true done?
  39.         until   ;
  40.  
  41. : "fheader       ( str --- )    \ automatic forward reference resolution
  42.                                 \ version of "HEADER.
  43.                 spcheck
  44.                 dup find        recursive
  45.                 if      dup     (lit) "fheader > \ must be defined after &
  46.                                                  \ ONLY if its a DEFERed word
  47.                         over @rel>abs ['] number @rel>abs = and
  48.                         if      warning @
  49.                                 if      over cr count type
  50.                                         ."  forward reference resolved"
  51.                                 then
  52.                                 \ then resolve the reference
  53.                                 here over >body !
  54.                         then
  55.                 then    drop ( str )
  56.                 align  yhere 2- y@ cnhash  here cnhash  <>
  57.                 if      yhere here cnhash dup y@ rot umin swap
  58.                         y! ( >name hash entry )
  59.                 then    ,view
  60.                 yhere over current @ hash dup @  y,  ( link  ) ! ( current )
  61.                 yhere last ! ( remember nfa )
  62.                 yhere ?cs: rot  dup c@  width @  min 1+ >r  ( yh cs str )
  63.                 yhere ys: r@ cmovel ( copy str ) r> ydp +! align ( nam )
  64.                 128 swap ycset   128 yhere 1- ycset   ( delimiter bits )
  65.                 here y, ( cfa in header )
  66.                 yhere here cnhash 2+ y! ( valid stopper in next n hash entry)
  67.                 ;
  68.  
  69. : fheader       ( | name --- )
  70.                 bl word ?uppercase "fheader ;
  71.  
  72. : autofon       ( --- )
  73.                 ['] f] is ]
  74.                 ['] fheader is header ;
  75.  
  76. : autofoff      ( --- )
  77.                 ['] (]) is ]
  78.                 ['] <header> is header ;
  79.  
  80. \ we will now turn on automatic forward referencing
  81.  
  82. autofon         \ This enables it
  83.  
  84. warning on      \ still want to be warned whenever one occurs
  85.  
  86.