First stream file include implementation, as yet with incomplete EOF detection.

8080/CPM/Makefile

@@ -22,10 +22,12 @@ msdos:
 %.fth: %.fb ../../tools/fb2fth.py
 	../../tools/fb2fth.py $< $@
 
-inctest.log: $(patsubst %, $(cpmfilesdir)/%, volks4th.com include.fb) \
+inctest.log: $(patsubst %, $(cpmfilesdir)/%, \
+    volks4th.com include.fb inctest.fth) \
     | emu
 	echo "volks4th" > $(runcpmdir)/input.script
 	echo "include include.fb" >> $(runcpmdir)/input.script
+	echo "xinclude inctest.fth" >> $(runcpmdir)/input.script
 	echo "bye" >> $(runcpmdir)/input.script
 	echo "exit" >> $(runcpmdir)/input.script
 	./emulator/run-in-runcpm.sh volks4th

8080/CPM/include.fth

@@ -1,26 +1,31 @@
 
 \ *** Block No. 0, Hexblock 0
 
-\ include for stream sources for cp/m                phz 02apr22
+\ 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 ;
 
 
 \ *** Block No. 1, Hexblock 1
 
-\ load screen                                        phz 06feb22
+\ 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
 
@@ -32,19 +37,14 @@
 
 
 
-
-
-
-
-
 \ *** Block No. 2, Hexblock 2
 
-\ fib /fib #fib eolf?                                phz 05apr22
+\ fib /fib #fib eolf?                                phz 06okt22
 
   context @ dos also context !
   $50 constant /tib
   variable tibeof tibeof off
-\\
+
   : eolf? ( c -- f )
     \ f=-1: not yet eol; store c and continue
     \ f=0: eol but not yet eof; return line and flag continue
@@ -58,46 +58,46 @@
 
 \ *** Block No. 3, Hexblock 3
 
-\ incfile incpos inc-fgetc                           phz 05apr22
+\ 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 ." eof" -1 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! ;
 
-
-
-
-
-
-
 \ *** Block No. 4, Hexblock 4
 
-\ freadline probe-for-fb                             phz 05apr22
+\ freadline probe-for-fb                             phz 06okt22
 
   : freadline ( -- eof )
-( tib /tib bounds DO
+  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 @ $5446 = swap 2+ c@ $48 = and not ;
+  isfile@ extension dup @ $dfdf and $5446 =
-
+  swap 2+ c@ $df and $48 = and not ;
 
 
 \ *** Block No. 5, Hexblock 5
 
-\ save/restoretib                                    phz 05apr22
+\ save/restoretib                                    phz 06okt22
-\\
+
   $50 constant /stash
   create stash[  /stash allot  here constant ]stash
   variable stash>   stash[ stash> !
@@ -115,19 +115,19 @@
 
 \ *** Block No. 6, Hexblock 6
 
-\ interpret-via-tib include                          phz 05apr22
+\ interpret-via-tib include                          phz 07mai23
-
+  : xinterpret  tib #tib @ type cr ;
-( : interpret-via-tib
+  : interpret-via-tib
-  BEGIN freadline >r .status >in off interpret
+  BEGIN freadline >r .status >in off xinterpret
-  r> UNTIL ; )
+  r> UNTIL ;
   : pushfile r> isfile push fromfile push >r ; restrict
-  : include ( -- )
+  : xinclude ( -- )
-  pushfile  use  cr file?
+  pushfile  use  cr file? cr
   probe-for-fb                IF 1 load       exit THEN
-  incfile push  isfile@ incfile ! ; \\
+  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
@@ -150,3 +150,22 @@
 
 
 
+
+\ *** Block No. 8, Hexblock 8
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

8080/CPM/inctest.fth

@@ -0,0 +1,4 @@
+0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcde
+@123456789ABCDEF0123456789abcdef0123456789abcdef0123456789abcde
+A123456789abcdef0123456789abcdef0123456789abcdef0123456789abcde
+B123456789ABCDEF0123456789abcdef0123456789abcdef0123456789abcde