\\ Streamfiles laden                                   31aug97py                                                                 Üblicherweise lädt man FORTH-Programme von FORTH-üblichen Blök-ken, es soll aber angeblich Leute geben, denen dort der Platz   zu klein ist, um übersichtliche Programme zu gestalten.          Die Vorteile der Streamfiles sind jedoch nicht zu übersehen,   auch wenn man dann einen externen Editor benutzt: Sie sparen    Platz, lassen sich komfortabler editieren und große Porgramm-   teile lassen sich leicher überschauen.                           Hier also ist eine Load-Utility für Streamfiles. Screenfiles   kann man mit SCR>FILE in FILEOP.SCR in Streamfiles umwandeln,   man muß allerdings darauf achten, daß der Scr # 0 zumindest     durch \\ wegkommentiert ist und daß man im Loadscreen das       xx xx +THRU streicht. Falls Kommentare durch \\ abgetrennt sind,muß man darauf achten, daß hier bis zur nächsten durch 16 teil- baren Zeile übersprungen wird.                                  \ Loadscreen                                           04mar00py                                                                DOS also Memory also                                                                                                            | User foldpos  foldpos off                                                                                                     $100 Constant cmax                                                                                                              1 8 +thru                                                                                                                       toss toss    current @ context !                                                                                                                                                                                                                                                                                                                                                                \ pos readline                                         04mar00py                                                                : fpos  loadfile @ filepos ;                    macro           : pos@  ( -- pos len ) loadfile @ filesize 2@ ; macro           : -eof?  pos@ < ;                               macro                                                                           : stream@ ( -- addr count )  pos@ over dup >r - >r r@ 0=          IF  drop pad r> rdrop EXIT  THEN  loadfile @ over -$1000 and    $1000 FindMP @ $1000 rot $FFF and /string r> min r@ fpos !      loadfile @ filesize @ r> - min ;                              : read? ( -- ) fpos @ $FFF and 0= prev @ and dup                  IF emptybuf EXIT THEN drop ;                                  : skipLF  ( -- )  read?                                           stream@ 0> IF c@ #lf = IF 1 fpos +! THEN ELSE drop THEN ;                                                                                                                                     \ pos readline                                         04mar00py                                                                : (readline ( maxlen -- string len rest )                         stream@ rot umin 2dup #lf scan dup >r                           nip - dup fpos +! 2dup + 1- c@ #cr = + 0 max r> ;             : readline ( buffer maxlen -- len ) fpos @ foldpos !  under       BEGIN dup (readline >r dup                                            0<= IF  2drop nip - skipLF rdrop  EXIT  THEN                    under 4 pick swap move                                          /string  read?  r> 0= WHILE  dup 0= UNTIL                       nip - skipLF  EXIT  THEN nip - 1 fpos +! ;                                                                                                                                                                                                                                                                                                                                              \ #load                                                28may00py| : skiplines ( n -- ) 0 ?DO tib max#tib @ readline drop LOOP ; : refill ( -- flag )  >in off                                     blk @     IF  1 blk +!  blk @ capacity < exit  THEN             line @ 0< IF  line @ -1 =  dup                                                IF  ."  skipped" cr query  THEN  exit THEN        -eof? dup IF  >tib @ HLock                                                    tib max#tib @ readline #tib !                                   >tib @ HUnlock  1 line +!  THEN ;               : save-input ( -- x1 .. xn n )  >in @                             blk @ dup    IF  2 exit  THEN  drop                             line @ 0< 0= IF  line @ foldpos @ 3 exit  THEN  1 ;           : restore-input ( x1 .. xn n -- flag )  3 case?                   IF    fpos ! line ! tib max#tib @ readline #tib !               ELSE  2 =  IF  blk !  THEN  THEN  >in ! 0 ;                                                                                   \ #load                                                22sep11py                                                                | : loading ( >in -- )  >in !                                       refill IF  BEGIN interpret refill 0= UNTIL  THEN ;          : input-file ( file maxtib -- )                                   r> ['] deltib >r                                                loadfile push  rot loadfile !  fpos off                         line push  blk push  >in push  >r                               blk off  line off  >in off  newtib  ;                                                                                         : (load ( >in -- )                                                ['] throw >r  open isfile@ cmax input-file                      ['] loading catch  close  dup IF  saveerr  THEN ;             : (#load  ( n >in -- ) >r  1- dup line !  skiplines  r> (load ; : #load  0 (load ;                                                                                                              \ #include                                             09aug07py                                                                : #include  isfile push  fromfile push  USE  #load close ;                                                                      : str?  ( file -- flag )  open dup filesize @ 0=                  IF  filename >len + 3 - 3 s" .fb" drop -text 0=  EXIT  THEN     0 over (block  $100 rot filesize @ umin                         2dup #lf scan nip 0<> -rot 0 scan nip 0= and close ;                                                                          : include ( -- )  isfile push  fromfile push  USE                 isfile@ str? IF  .status #load  ELSE  1 load  THEN  close ;                                                                   also  -options                                                  :noname  ">tib include  2 ;  IS -i                              previous                                                                                                                        \ #list                                                11mar00py                                                                : more? ( n -- n / t )  dup 0<> IF  1- stop? or exit  THEN  drop  ." more?" key clrline  $FF and  #esc case? ?dup ?exit           $03 case? ?dup ?exit  bl = IF  rows 3 - exit  THEN  0 ;                                                                       : #list  ( -- ) >in @ bl word c@                                  IF  >in !  isfile push  fromfile push  USE                      ELSE  drop open  THEN  loadfile push  isfile@ loadfile !        fpos off  1  rows 2-                                            BEGIN  cr  -eof?  WHILE more? dup 0< 0=  WHILE                         over 4 u.r  space                                               BEGIN  $100 (readline 0=  WHILE  type  REPEAT  type             skipLF  >r 1+ r>  REPEAT  THEN  2drop close ;                                                                                                                                          \ Kommentarzeichen                                     17jul98py: \   blk @  IF compile \ ELSE #tib @ >in ! THEN ; immediate    ' \ alias #! immediate                                          : \\  blk @  IF compile \\  ELSE  line @ 0< ?exit                 BEGIN pad max#tib @ readline drop 1 line +! line @ $F and             0= UNTIL                                                  #tib @ >in ! THEN ; immediate                                 : \\\  loadfile @ filesize @ fpos ! compile \ ; immediate       | : ?refill  source nip >in @ = IF refill 0= ELSE false THEN ;  | : parse*  parse + source + over <> swap 1- c@ '* = ;          | :  _)  BEGIN  ') parse* drop  ?EXIT  ?refill  UNTIL ;         | : _*)  BEGIN  ') parse*  and  ?EXIT  ?refill  UNTIL ;         | : _*/  BEGIN  '/ parse*  and  ?EXIT  ?refill  UNTIL ;         | : _*\  BEGIN  '\ parse*  and  ?EXIT  ?refill  UNTIL ;         | : Com: Create ' A, immediate  DOES> perform ;                 Com: ( _)       Com: (* _*)     Com: /* _*/     Com: \* _*\     \ ANS Forth words                                      13may09py: read-line ( c-addr u1 fileid -- u2 flag ior )                   loadfile push loadfile ! pos@ =                                 IF  2drop 0 0 0  EXIT  THEN                                     ['] readline catch true swap ;                                | Create crlf 1 \needs unix 1+ c, #cr                                         c, #lf c,                                         : write-line ( c-addr u1 fileid -- ior ) dup >r                   write-file  dup 0=  IF drop crlf count r> write-file            ELSE  rdrop  THEN ;                                           : include-file ( fileid -- )                                      isfile push isfile ! ['] #load catch                            isfile@ close-file throw throw ;                              : included ( c-addr u -- ) r/o open-file throw include-file ;   : included? ( c-addr u -- ) r/o open-file 0=                      IF  include-file  ELSE  drop  THEN ;