diff --git a/8080/CPM/cpmfiles/test-blk.fth b/8080/CPM/cpmfiles/test-blk.fth index 66f9810..cd456d2 100644 --- a/8080/CPM/cpmfiles/test-blk.fth +++ b/8080/CPM/cpmfiles/test-blk.fth @@ -1,5 +1,5 @@ -include logfile.fth +include log2file.fb \ so that include with block file gets tested ' noop Is .status logopen diff --git a/8080/CPM/cpmfiles/v4th.com b/8080/CPM/cpmfiles/v4th.com index be6bbe1..1d99df3 100644 Binary files a/8080/CPM/cpmfiles/v4th.com and b/8080/CPM/cpmfiles/v4th.com differ diff --git a/8080/CPM/cpmfiles/v4thblk.com b/8080/CPM/cpmfiles/v4thblk.com index 2e7cf41..a3e0acd 100644 Binary files a/8080/CPM/cpmfiles/v4thblk.com and b/8080/CPM/cpmfiles/v4thblk.com differ diff --git a/8080/CPM/cpmfiles/v4thblk.fth b/8080/CPM/cpmfiles/v4thblk.fth index 14712d0..623e58e 100644 --- a/8080/CPM/cpmfiles/v4thblk.fth +++ b/8080/CPM/cpmfiles/v4thblk.fth @@ -5,10 +5,10 @@ Target definitions $100 here! include vf-core.fth include vf-io.fth - include vf-bufs.fth include vf-sys.fth include vf-bdos.fth include vf-file.fth + include vf-bufs.fth include vf-end.fth cr .( unresolved: ) .unresolved ( ' .blk is .status ) diff --git a/8080/CPM/cpmfiles/vf-bufs.fth b/8080/CPM/cpmfiles/vf-bufs.fth index 6274848..daab700 100644 --- a/8080/CPM/cpmfiles/vf-bufs.fth +++ b/8080/CPM/cpmfiles/vf-bufs.fth @@ -212,3 +212,25 @@ Target Dos also l/s 0 DO cr I 2 .r space scr @ block I c/l * + c/l -trailing type LOOP cr ; + + +Variable loadfile + +: (load ( blk offset -- ) + isfile push loadfile push fromfile push blk push >in push + >in ! blk ! isfile@ loadfile ! .status interpret ; + +: load ( blk --) ?dup 0=exit 0 (load ; +' load IS include-load + + +\ *** Block No. 85, Hexblock 55 + +\ +load thru +thru --> rdepth depth 20Oct86 + +: +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 diff --git a/8080/CPM/cpmfiles/vf-file.fth b/8080/CPM/cpmfiles/vf-file.fth index f31925c..a94ee7c 100644 --- a/8080/CPM/cpmfiles/vf-file.fth +++ b/8080/CPM/cpmfiles/vf-file.fth @@ -1,4 +1,6 @@ +Target Dos also + : cr+ex@ ( fcb -- cr+256*ex ) dup &34 + c@ swap &14 + c@ $100 * + ; : cr+ex! ( cr+256*ex fcb -- ) @@ -61,10 +63,14 @@ | : interpret-via-tib BEGIN freadline >r .status >in off interpret r> UNTIL ; + Defer include-load +| : block-not-implemented 1 abort" block file access not implemented" ; + ' block-not-implemented IS include-load + : include-isfile ( -- ) increc push 0 isfile@ cr+ex! isfile@ increadrec Abort" can't read start of file" - probe-for-fb IF 1 load exit THEN + probe-for-fb IF 1 include-load exit THEN incfile push isfile@ incfile ! savetib >r interpret-via-tib r> restoretib incfile @ 2+ closefile Abort" error closing file" ; diff --git a/8080/CPM/cpmfiles/vf-io.fth b/8080/CPM/cpmfiles/vf-io.fth index b5c6d83..368efb4 100644 --- a/8080/CPM/cpmfiles/vf-io.fth +++ b/8080/CPM/cpmfiles/vf-io.fth @@ -1,5 +1,7 @@ \ *** Block No. 84, Hexblock 54 +Target + \ .status push load 20Oct86 Defer .status ' noop Is .status @@ -8,26 +10,6 @@ Defer .status ' noop Is .status : push ( addr -- ) r> swap dup >r @ >r pull >r >r ; restrict -Variable loadfile - -: (load ( blk offset -- ) - isfile push loadfile push fromfile push blk push >in push - >in ! blk ! isfile@ loadfile ! .status interpret ; - -: load ( blk --) ?dup 0=exit 0 (load ; - - - -\ *** Block No. 85, Hexblock 55 - -\ +load thru +thru --> rdepth depth 20Oct86 - -: +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/ ; : depth ( -- +n) sp@ s0 @ swap - 2/ ; diff --git a/8080/CPM/cpmfiles/vf-sys.fth b/8080/CPM/cpmfiles/vf-sys.fth index 8c9ce96..9d064e7 100644 --- a/8080/CPM/cpmfiles/vf-sys.fth +++ b/8080/CPM/cpmfiles/vf-sys.fth @@ -1,5 +1,7 @@ \ *** Block No. 104, Hexblock 68 +Target + \ endpoints of forget 01Jul86 | : |? ( nfa -- flag ) c@ $20 and ;