VolksForth/8080/CPM/include.fb

\ include for stream sources for cp/m                phz 10apr23                                                                \ loadscreen content while debugging read-seq esp. dos-error?                                                                     1 +load  \ /tib tibeof eolf?                                    create tib  /tib 1+ allot    variable #tib #tib off             2 3 +thru                                                       : pushfile r> isfile push fromfile push >r ; restrict           : iopen ( -- )                                                  pushfile  use  cr file?                                                       isfile@ incfile !   b/rec rec-offset c!           incpos push  incpos off  incpos 2+ dup push off                 0 incfile @ record 1- c! ;                                      : iread ( -- )                                                   freadline cr . cr tib #tib @ type cr ;                                                                                       \ load screen                                        phz 06mai23                                                                  onlyforth dos also forth definitions                                                                                            : idos-error?  ( n -- f )  0<> ;                                : iread-seq  ( dosfcb -- f )  $14 bdosa  idos-error? ;                                                                          1 6 +thru                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     \ fib /fib #fib eolf?                                phz 07mai23                                                                  context @ dos also context !                                    $50 constant /tib                                               variable tibeof tibeof off                                      $1a constant ctrl-z                                                                                                             : eolf? ( c -- f )                                                \ f=-1: not yet eol; store c and continue                       \ f=0: eol but not yet eof; return line and flag continue       \ f=1: eof: return line and flag eof                           tibeof off                                                       dup #lf = IF drop 0 exit THEN                                   ctrl-z = IF tibeof on  1 ELSE -1 THEN ;                                                                                                                                                     \ incfile incpos inc-fgetc                           phz 07mai23                                                                  variable incfile                                                variable incpos 2 allot                                         create rec-offset 1 allot   $80 constant dmabuf                                                                                 : inc-fgetc  ( -- c )                                             rec-offset c@ b/rec u< 0= IF dmabuf dma!                          incfile @ drive  iread-seq IF ctrl-z exit THEN                  0 rec-offset c! THEN                                          rec-offset c@ dup 1+ rec-offset c! dmabuf + c@                ; \\                                                              incfile @ f.handle @ 0= IF                                        incpos 2@  incfile @  fseek THEN                              incfile @ fgetc                                                 incpos 2@ 1. d+ incpos 2! ;                                 \ freadline probe-for-fb                             phz 06okt22                                                                  : freadline ( -- eof )                                          tib /tib bounds DO                                                inc-fgetc dup eolf? under 0< IF I c! ELSE drop THEN             0< 0= IF I tib - #tib ! ENDLOOP tibeof @ exit THEN            LOOP /tib #tib !                                                ." warning: line exteeds max " /tib . cr                        ." extra chars ignored" cr                                      BEGIN inc-fgetc eolf? 1+ UNTIL tibeof @ ;                                                                                     | : probe-for-fb  ( -- flag )                                       \ probes whether current file name has no .FTH extension      isfile@ extension dup @ $dfdf and $5446 =                       swap 2+ c@ $df and $48 = and not ;                                                                                            \ save/restoretib                                    phz 06okt22                                                                  $50 constant /stash                                             create stash[  /stash allot  here constant ]stash               variable stash>   stash[ stash> !                                                                                               : savetib  ( -- n )                                                 #tib @ >in @ -  dup stash> @ + ]stash u>                          abort" tib stash overflow"   >r                               tib >in @ +  stash> @  r@ cmove                                 r@ stash> +!  r> ;                                                                                                          : restoretib  ( n -- )                                              dup >r negate stash> +!   stash> @ tib r@ cmove                 r> #tib !  >in off ;                                                                                                      \ interpret-via-tib include                          phz 07mai23                                                                  : interpret-via-tib                                             BEGIN freadline >r .status >in off  interpret  r> UNTIL ;                                                                       : pushfile r> isfile push fromfile push >r ; restrict           : include ( -- )                                                pushfile  use  cr file?                                         probe-for-fb                IF 1 load       exit THEN           incfile push  isfile@ incfile !   b/rec rec-offset c!           incpos push  incpos off  incpos 2+ dup push off                 0 incfile @ record 1- c!                                        savetib >r  interpret-via-tib close  r> restoretib ;            : (stashquit  stash[ stash> !  (quit ;                          : stashrestore  ['] (stashquit IS 'quit ;                       ' stashrestore IS 'restart                                    \ \                                                  phz 05apr22\\                                                                : \  blk @ IF >in @ negate  c/l mod  >in +!                          ELSE #tib @ >in ! THEN ; immediate                                                                                       \ : \needs  have 0=exit                                         \      blk @ IF >in @ negate  c/l mod  >in +!                   \      ELSE #tib @ >in ! THEN ;