\\ Streamfiles laden 31aug97py blicherweise ldt man FORTH-Programme von FORTH-blichen Blk-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 groe Porgramm- teile lassen sich leicher berschauen. Hier also ist eine Load-Utility fr 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 nchsten 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 20feb00py | : loading ( n >in -- ) >r 1- dup line ! skiplines r> refill IF >in ! 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 ( n >in -- ) ['] throw >r open isfile@ cmax input-file ['] loading catch close dup IF saveerr THEN ; : #load 1 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 ;
No newline at end of file
\\ Streamfiles laden 31aug97py blicherweise ldt man FORTH-Programme von FORTH-blichen Blk-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 groe Porgramm- teile lassen sich leicher berschauen. Hier also ist eine Load-Utility fr 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 nchsten 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 ;
