**********************  fig-FORTH  MODEL  **********************                                                                                     Through the courtesy of                                                                                                          FORTH INTEREST GROUP                                               P. O. BOX 1105                                              SAN CARLOS, CA. 94070                                                                                                                                                                                 RELEASE 1                                                 WITH COMPILER SECURITY                                                  AND                                                     VARIABLE LENGTH NAMES                                                                                                                                                             Further distribution must include the above notice.                                                                                                                                              7 load ;s                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ;s changed (.hpr'94):                                                                                                                   then    =>      endif                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   (  ERROR MESSAGES  )                                            EMPTY STACK                                                     DICTIONARY FULL                                                 HAS INCORRECT ADDRESS MODE                                      ISN'T UNIQUE                                                                                                                    DISC RANGE ?                                                    FULL STACK                                                      DISC ERROR !                                                                                                                                                                                                                                                                                                                                                                                                                                                    FORTH INTEREST GROUP                                 MAY 1, 1979(  ERROR MESSAGES  )                                            COMPILATION ONLY, USE IN DEFINITION                             EXECUTION ONLY                                                  CONDITIONALS NOT PAIRED                                         DEFINITION NOT FINISHED                                         IN PROTECTED DICTIONARY                                         USE ONLY WHEN LOADING                                           OFF CURRENT EDITING SCREEN                                      DECLARE VOCABULARY                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              ( FORTH INTEREST GROUP                        MAY 1, 1979 ( 6 )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 (  text,  line                                    WFR-79may01 )  forth definitions                                               vocabulary editor immediate                                                                                                    : text                        ( accept following text to pad *)   here c/l 1+ blanks word here pad c/l 1+ cmove ;                                                                               : line              ( relative to scr. leave address of line *)   dup -16 and 17 ?error                ( keep on this screen )    scr @ (line) drop ;                                                                                                            -->                                                                                                                                                                                                                                                                                                                            (  line editor                                    WFR-79may03 ) : where                  ( print screen # and image of error *)   dup b/scr /mod dup scr ! dup list ." scr # " decimal .          c/l * r# ! swap c/l /mod c/l * rot block + cr c/l type cr       dup r# +! here c@ - spaces 94 emit [compile] editor quit ;                                                                    editor definitions                                              : #locate                    ( levae cursor offset-2, line-1 *)   r# @ c/l /mod ;                                               : #lead                 ( line address-2, offset-1 to cursor *)   #locate line swap ;                                           : #lag              ( cursor address-2, count-1 after cursor *)   #lead dup >r + c/l r> - ;                                     : -move        ( move in block buffer addr from-2, line to-1 *)   line c/l cmove update ;                               -->                                                                     (  line editting commands                       WFR-79may03 )   : h                              ( hold numbered line at pad *)   line pad 1+ c/l dup pad c! cmove ;                            : e                               ( erase line-1 with blanks *)   line c/l blanks update ;                                                                                                      : s                             ( spread making line # blank *)   dup 1 - 14                    ( limit and first to move )       do i line i 1+ -move -1 +loop e ;                                                                                             : d                         ( delete line-1, but hold in pad *)   dup h 15 dup rot do i 1+ line i -move loop e ;                                                                                                                                        -->                                                                                                                                     (  line editting commands                         WFR-79may03 )                                                                 : m         ( move cursor by signed amount-1, print its line *)   r# +! cr space #lead type 95 emit #lag type #locate . drop ;                                                                  : t                     ( type line by #-1, save also in pad *)   dup c/l * r# ! dup h 0 m ;                                                                                                    : l scr @ 0 max list 0 m ;                  ( re-list screen *)                                                                 : l+ 1 scr +! l ;                              ( next screen *) : l- -1 scr +! l ;                         ( previous screen *)                                                                 -->                                                                                                                                                                                             (  line editting commands                          WFR-790105 )                                                                 : r pad 1+ swap -move ;      ( replace on line #-1, from pad *)                                                                 : p 1 text r ;                ( put following text on line-1 *)                                                                 : i dup s r ;             ( insert text from pad onto line # *)                                                                 : top 0 r# ! ;           ( home cursor to top left of screen *)                                                                                                                                                                                                                                                                 -->                                                                                                                                                                                             (  screen diting commands                        WFR-79apr27 )                                                                  : clear                           ( clear screen by number-1 *)   scr ! 16 0 do forth i editor e loop ;                                                                                         : flush                   ( write all updated blocks to disc *)   [ limit first - b/buf 4 + / ]            ( number of buffers)   literal 0 do 32767 buffer drop loop ;                                                                                         : copy                   ( duplicate screen-2, onto screen-1 *)   b/scr * offset @ + swap b/scr * b/scr over + swap               do dup forth i block 2 - ! 1+ update loop drop flush ;                                                                                                                                -->                                                                                                                                     (  double number support                         WFR-80apr24  )                                                                                                                         -->     (  operates on 32 bit double numbers or two 16-bit integers   ) forth definitions                                                                                                               : 2drop drop drop ;                      ( drop double number )                                                                 : 2dup over over ;                ( duplicate a double number )                                                                 : 2swap rot >r rot r> ; ( bring second double to top of stack )                                                                 editor definitions                                      -->                                                                                                                                                                                                     (  string match for editor                    PM-WFR-80apr25 )                                                                  : -text           ( address-3, count-2, address-1 --- )           swap -dup if    ( leave boolean matched=non-zero, nope=zero )    over + swap    ( neither address may be zero! )                 do dup c@ forth i c@ - if 0= leave else 1+ endif loop          else drop 0= endif ;                                                                                                                                                                  -->                                                                                                                                                                                                                                                                                                                                                                                                                                                                     (  string match for editor                    PM-WFR-80apr25 )                                                                  : match   ( cursor address-4, bytes left-3, string address-2, )           ( string count-1, ---  boolean-2, cursor movement-1 )   >r >r 2dup r> r> 2swap over + swap                              ( caddr-6, bleft-5, $addr-4, $len-3, caddr+bleft-2, caddr-1 )   do 2dup forth i -text                                            if >r 2drop r> - i swap - 0 swap 0 0 leave endif                             ( caddr bleft $addr $len or else 0 offset 0 0 )   loop 2drop             ( caddr-2, bleft-1, or 0-2, offset-1 )   swap 0= swap ;                                                                                                        -->                                                                                                                                                                                                                                                                     (  string editing commands                        WFR-79mar24 ) : 1line       ( scan line with cursor for match to pad text, *)                              ( update cursor, return boolean *)   #lag pad count match r# +! ;                                                                                                  : find  ( string at pad over full screen range, else error *)     begin 1023 r# @ <                                               if top pad here c/l 1+ cmove 0 error endif 1line until ;                                                                      : delete                    ( backwards at cursor by count-1 *)   >r #lag + forth r -              ( save blank fill location )   #lag r minus r# +!                          ( backup cursor )   #lead + swap cmove r> blanks update ; ( fill from end of txt)                                                                                                                         -->                                                                     (  string editor commands                         WFR-79mar24 )                                                                 : n find 0 m ;        ( find next occurance of previous text *)                                                                 : f 1 text n ;            ( find occurance of following text *)                                                                 : b pad c@ minus m ;          ( backup cursor by text in pad *)                                                                 : x 1 text find pad c@ delete 0 m ;  ( delete following text *)                                                                 : till   ( delete on cursor line, from cursor to text end *)      #lead + 1 text 1line 0= 0 ?error #lead + swap - delete 0 m ;                                                                                                                          -->                                                                                                                                     (  string editor commands                         WFR-79mar23 )                                                                 : c        ( spread at cursor and copy in the following text *)   1 text pad count                                                #lag rot over min >r                                            forth r r# +!                                 ( bump cursor )   r - >r                                      ( chars to save )   dup here r cmove                  ( from old cursor to here )   here #lead + r> cmove             ( here to cursor location )   r> cmove update                         ( pad to old cursor )   0 m ;                                    ( look at new line )                                                                                                                                                                                         -->                                                                                                                                     ( show helpscreen                                                                                                               : help scr @ >r 20 list r> scr ! ;                                                                                                                                                                      cr 21 list decimal forth definitions ." editor " ;S                     safe!                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ( single key editor commands                                          b         backup cursor by length of text in pad                c {text}  copy in the following text at cursor posn       ( n ) d         remove line no. ( n ), put it to pad            ( n ) e         blank line no. ( n )                                  f {text}  find following text                             ( n ) h         hold line no. ( n ) in pad                      ( n ) i         insert line no. ( n ) from pad                        l         list current screen                             ( n ) m         move cursor by ( n ) chars, show line & cursor        n         find next occurence of text ( after f )         ( n ) p {text}  put text until <enter> on line no. ( n )        ( n ) s         spread at line no. ( n ), insert an empty line  ( n ) r         replace line no. ( n ) with text from pad       ( n ) t         type line no. ( n ) and hold it in pad                x {text}  delete the following text                       ( miscellanous editor commands                                                                                                  ( n )     clear fill screen no. ( n ) with blanks               ( n1 n2 ) copy  copy from screen no. ( n1 ) to no. ( n2 )                                                                             flush     flush updated lines to screenfile                     l+ l-     list next, previous screen                            top       cursor to top left                                    till {text} delete on cursor line till end of text                                                                        help            show single key commands helpscreen             where           show where load-error occured, enter the editor                                                                                                                                                                                                                                                                                                                                                                                                                                         ;S                                                                                      forth  definitions   decimal                                            latest   12  +origin  !   ( top nfa )                           here     28  +origin  !   ( fence )                             here     30  +origin  !   ( dp )                            ' editor 6 + 32  +origin  !   ( voc-link )                                  here  fence   !      ;s                                                                                                                                                                                                                                                                                                                                                                                                                         