6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2025-01-02 14:30:35 +00:00
Code Issues Projects Releases Wiki Activity

Code cleanup of vf-file1.fth - move read-seq into vf-bdos, some renames and

Browse Source 
some words made headerless.
This commit is contained in:
Philip Zembrod 2024-11-09 16:35:32 +01:00
parent 5877b0e3e2
commit bab3568724
4 changed files with 31 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
8080/CPM/Makefile
View File

@ -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" \

8
8080/CPM/src/sfileint.fth
View File

@ -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 @ = ;

2
8080/CPM/src/vf-bdos.fth
View File

@ -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 ;

58
8080/CPM/src/vf-file1.fth
View File

@ -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" ;