6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2024-06-01 06:41:37 +00:00
Code Issues Projects Releases Wiki Activity

First refactoring step to move all buffers/blocks related code to vf86bufs.fth

Browse Source 
and to make vf86core.fth independent of vf86bufs.fth.
This commit is contained in:
Philip Zembrod 2022-03-20 14:05:06 +01:00
parent 91c74f0830
commit c9a62fc7ff
2 changed files with 61 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
8086/msdos/src/vf86bufs.fth
View File

@ -14,6 +14,26 @@
\ *** Block No. 81, Hexblock 51
\ +load thru +thru --> rdepth depth ks 26 jul 87
: (load ( blk offset -- ) isfile@ >r
loadfile @ >r fromfile @ >r blk @ >r >in @ >r
>in ! blk ! isfile@ loadfile ! .status interpret
r> >in ! r> blk ! r> fromfile ! r> loadfile !
r> isfile ! ;
: load ( blk -- ) ?dup 0=exit 0 (load ;
: +load ( offset -- ) blk @ + load ;
: thru ( from to -- ) 1+ swap DO I load LOOP ;
: +thru ( off0 off1 -- ) 1+ swap DO I +load LOOP ;
: --> 1 blk +! >in off .status ; immediate
@ -22,19 +42,13 @@
\ buffer mechanism ks 04 okt 87
Variable isfile isfile off \ addr of file control block
Variable fromfile fromfile off \ fcb in kopieroperationen
Variable prev prev off \ Listhead
| Variable buffers buffers off \ Semaphor
$408 Constant b/buf \ physikalische Groesse
$400 Constant b/blk \ bytes/block
Defer r/w \ physikalischer Diskzugriff
Variable error# error# off \ Nummer des letzten Fehlers
Defer ?diskerror \ Fehlerbehandlung
\ *** Block No. 92, Hexblock 5c
@ -123,14 +137,15 @@
: (block ( blk file -- addr )
BEGIN (core? take readblk mark REPEAT ;
Code isfile@ ( -- addr )
D push isfile #) D mov Next end-code
\ : isfile@ ( -- addr ) isfile @ ;
: buffer ( blk -- addr ) isfile@ (buffer ;
: block ( blk -- addr ) isfile@ (block ;
: (blk-source ( -- addr len ) blk @ ?dup
IF loadfile @ (block b/blk exit THEN tib #tib @ ;
' (blk-source IS source
\ *** Block No. 97, Hexblock 61
@ -138,9 +153,11 @@
: update $80 prev @ 6+ 1+ ( Byte-Order! ) c! ;
: save-buffers buffers lock
: (save-buffers buffers lock
BEGIN updates? ?dup WHILE backup REPEAT buffers unlock ;
' (save-buffers IS save-buffers
: empty-buffers buffers lock prev
BEGIN @ ?dup WHILE dup emptybuf REPEAT buffers unlock ;
@ -148,13 +165,20 @@
BEGIN @ ?dup WHILE dup fclose REPEAT
save-buffers empty-buffers ;
: list ( scr -- ) dup capacity u<
IF scr ! ." Scr " scr @ .
." Dr " drv . isfile@ .file
l/s 0 DO cr I 2 .r space scr @ block
I c/l * + c/l -trailing type
LOOP cr exit
THEN 9 ?diskerror ;
\ *** Block No. 98, Hexblock 62
\ Allocating buffers ks 31 oct 86
$10000 Constant limit Variable first
: allotbuffer ( -- )
first @ r0 @ - b/buf 2+ u< ?exit
@ -168,4 +192,6 @@
: all-buffers BEGIN first @ allotbuffer first @ = UNTIL ;
| : init-buffers prev off limit first ! all-buffers ;
| : (init-buffers prev off limit first ! all-buffers ;
' (init-buffers IS init-buffers

52
8086/msdos/src/vf86core.fth
View File

@ -955,8 +955,11 @@ swap ]? C >in #) add
Variable loadfile loadfile off
: source ( -- addr len ) blk @ ?dup
IF loadfile @ (block b/blk exit THEN tib #tib @ exit ;
defer source
: (source ( -- addr len ) tib #tib @ ;
' (source IS source
: word ( char -- addr ) source (word ;
@ -1453,26 +1456,6 @@ Target Forth also definitions
Defer .status ' noop Is .status
: (load ( blk offset -- ) isfile@ >r
loadfile @ >r fromfile @ >r blk @ >r >in @ >r
>in ! blk ! isfile@ loadfile ! .status interpret
r> >in ! r> blk ! r> fromfile ! r> loadfile !
r> isfile ! ;
: load ( blk -- ) ?dup 0=exit 0 (load ;
\ *** Block No. 81, Hexblock 51
\ +load thru +thru --> rdepth depth ks 26 jul 87
: +load ( offset -- ) blk @ + load ;
: thru ( from to -- ) 1+ swap DO I load LOOP ;
: +thru ( off0 off1 -- ) 1+ swap DO I +load LOOP ;
: --> 1 blk +! >in off .status ; immediate
: rdepth ( -- +n ) r0 @ rp@ 2+ - 2/ ;
@ -1602,14 +1585,6 @@ Target Forth also definitions
&64 Constant c/l \ Screen line length
&16 Constant l/s \ lines per screen
: list ( scr -- ) dup capacity u<
IF scr ! ." Scr " scr @ .
." Dr " drv . isfile@ .file
l/s 0 DO cr I 2 .r space scr @ block
I c/l * + c/l -trailing type
LOOP cr exit
THEN 9 ?diskerror ;
@ -1634,6 +1609,23 @@ Target Forth also definitions
$E9 4 * >label >taskINT
$10000 Constant limit Variable first
Variable isfile isfile off \ addr of file control block
Code isfile@ ( -- addr )
D push isfile #) D mov Next end-code
\ : isfile@ ( -- addr ) isfile @ ;
| Variable buffers buffers off \ Semaphor
Defer r/w \ physikalischer Diskzugriff
Variable error# error# off \ Nummer des letzten Fehlers
Defer ?diskerror \ Fehlerbehandlung
Defer save-buffers ' noop IS save-buffers
Defer init-buffers ' noop IS init-buffers
include vf86bufs.fth