From bab3568724e0f04cd427eca8c798eb3a5a87dfff Mon Sep 17 00:00:00 2001 From: Philip Zembrod Date: Sat, 9 Nov 2024 16:35:32 +0100 Subject: [PATCH] Code cleanup of vf-file1.fth - move read-seq into vf-bdos, some renames and some words made headerless. --- 8080/CPM/Makefile | 2 +- 8080/CPM/src/sfileint.fth | 8 ++---- 8080/CPM/src/vf-bdos.fth | 2 ++ 8080/CPM/src/vf-file1.fth | 58 +++++++++++++++++---------------------- 4 files changed, 31 insertions(+), 39 deletions(-) diff --git a/8080/CPM/Makefile b/8080/CPM/Makefile index cda56c5..7b82a7b 100644 --- a/8080/CPM/Makefile +++ b/8080/CPM/Makefile @@ -216,7 +216,7 @@ test3.log: \ tests/empty.fb) | emu ./emulator/run-in-runcpm.sh \ "v4th3 sfileint.fth" \ - "include-inner" \ + "include-isfile" \ "onlyforth" \ "include test-blk.fth" \ "bye" \ diff --git a/8080/CPM/src/sfileint.fth b/8080/CPM/src/sfileint.fth index 64d8075..c60fc2f 100644 --- a/8080/CPM/src/sfileint.fth +++ b/8080/CPM/src/sfileint.fth @@ -84,8 +84,6 @@ Constant b/fcb : drive! ( drv -- ) $0E bdos ; : search0 ( dosfcb -- dir ) $11 bdosa ; : searchnext ( dosfcb -- dir ) $12 bdosa ; -: read-seq ( dosfcb -- f ) $14 bdosa dos-error? ; -: write-seq ( dosfcb -- f ) $15 bdosa dos-error? ; : createfile ( dosfcb -- f ) $16 bdosa dos-error? ; : size ( dos -- size ) dup $23 bdos dosfcb> record @ ; : drive@ ( -- drv ) 0 $19 bdosa ; @@ -371,12 +369,12 @@ Forth definitions : loadfrom ( n -- ) isfile push fromfile push use load close ; : include ( -- ) - rec-offset push isfile push fromfile push + increc-offset push isfile push fromfile push use cr file? - include-inner + include-isfile incfile @ IF increc @ incfile @ cr+ex! - incfile @ readrec Abort" error re-reading after include" + incfile @ increadrec Abort" error re-reading after include" THEN ; : eof ( -- f ) isfile@ dup filesize @ swap record @ = ; diff --git a/8080/CPM/src/vf-bdos.fth b/8080/CPM/src/vf-bdos.fth index d5c79a1..8a156ec 100644 --- a/8080/CPM/src/vf-bdos.fth +++ b/8080/CPM/src/vf-bdos.fth @@ -89,6 +89,8 @@ $5C Constant fcb : reset ( -- ) 0 &13 bdos ; : openfile ( fcb -- f ) &15 bdosa dos-error? ; : closefile ( fcb -- f ) &16 bdosa dos-error? ; +: read-seq ( fcb -- f ) $14 bdosa dos-error? ; +: write-seq ( fcb -- f ) $15 bdosa dos-error? ; : dma! ( dma -- ) &26 bdos ; : rec@ ( fcb -- f ) &33 bdosa ; : rec! ( fcb -- f ) &34 bdosa ; diff --git a/8080/CPM/src/vf-file1.fth b/8080/CPM/src/vf-file1.fth index 1766322..f31925c 100644 --- a/8080/CPM/src/vf-file1.fth +++ b/8080/CPM/src/vf-file1.fth @@ -1,18 +1,13 @@ - \ target dos also target definitions - - \ ' 2+ | Alias >dosfcb - : read-seq ( dosfcb -- f ) $14 bdosa dos-error? ; - : cr+ex@ ( fcb -- cr+256*ex ) dup &34 + c@ swap &14 + c@ $100 * + ; : cr+ex! ( cr+256*ex fcb -- ) >r $100 u/mod r@ &14 + c! r> &34 + c! ; - variable tibeof tibeof off - $1a constant ctrl-z +| variable tibeof tibeof off +| $1a constant ctrl-z - : eolf? ( c -- f ) +| : 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 @@ -22,20 +17,20 @@ variable incfile variable increc - variable rec-offset - $80 constant dmabuf - $ff constant dmabuf-last + variable increc-offset +| $80 constant dmabuf +| $ff constant dmabuf-last - : readrec ( fcb -- f ) + : increadrec ( fcb -- f ) dup cr+ex@ increc ! - rec-offset off dmabuf dma! >dosfcb read-seq ; + increc-offset off dmabuf dma! >dosfcb read-seq ; - : inc-fgetc ( -- c ) - rec-offset @ b/rec u< 0= - IF incfile @ readrec IF ctrl-z exit THEN THEN - rec-offset @ dmabuf + c@ 1 rec-offset +! ; +| : inc-fgetc ( -- c ) + increc-offset @ b/rec u< 0= + IF incfile @ increadrec IF ctrl-z exit THEN THEN + increc-offset @ dmabuf + c@ 1 increc-offset +! ; - : freadline ( -- eof ) +| : 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 @@ -44,35 +39,32 @@ ." extra chars ignored" cr BEGIN inc-fgetc eolf? 1+ UNTIL tibeof @ ; - : probe-for-fb ( -- flag ) +| : probe-for-fb ( -- flag ) dmabuf BEGIN dup c@ #lf = IF drop 0 exit THEN 1+ dup dmabuf-last u> UNTIL drop 1 ; - $50 constant /stash - create stash[ /stash allot here constant ]stash - variable stash> stash[ stash> ! +| $50 constant /stash +| create stash[ /stash allot here | constant ]stash +| variable stash> stash[ stash> ! +| : clear-tibstash stash[ stash> ! ; - : savetib ( -- n ) +| : savetib ( -- n ) #tib @ >in @ - dup stash> @ + ]stash u> abort" tib stash overflow" >r tib >in @ + stash> @ r@ cmove r@ stash> +! r> ; - : restoretib ( n -- ) +| : restoretib ( n -- ) dup >r negate stash> +! stash> @ tib r@ cmove r> #tib ! >in off ; - : interpret-via-tib +| : interpret-via-tib BEGIN freadline >r .status >in off interpret r> UNTIL ; - : include-inner ( -- ) + : include-isfile ( -- ) increc push 0 isfile@ cr+ex! - isfile@ readrec Abort" can't read start of file" + isfile@ increadrec Abort" can't read start of file" probe-for-fb IF 1 load exit THEN - \ ." stream include " incfile push isfile@ incfile ! - savetib >r interpret-via-tib - \ ." before isfile@ closefile" - incfile @ 2+ closefile Abort" error closing file" - \ ." after isfile@ closefile" - r> restoretib ; + savetib >r interpret-via-tib r> restoretib + incfile @ 2+ closefile Abort" error closing file" ;