Update cpmfiles

This commit is contained in:
Philip Zembrod 2024-11-12 06:28:27 +01:00
parent 26cc7a839a
commit cc88009bce
8 changed files with 35 additions and 23 deletions

View File

@ -1,5 +1,5 @@
include logfile.fth include log2file.fb \ so that include with block file gets tested
' noop Is .status ' noop Is .status
logopen logopen

Binary file not shown.

Binary file not shown.

View File

@ -5,10 +5,10 @@ Target definitions $100 here!
include vf-core.fth include vf-core.fth
include vf-io.fth include vf-io.fth
include vf-bufs.fth
include vf-sys.fth include vf-sys.fth
include vf-bdos.fth include vf-bdos.fth
include vf-file.fth include vf-file.fth
include vf-bufs.fth
include vf-end.fth include vf-end.fth
cr .( unresolved: ) .unresolved ( ' .blk is .status ) cr .( unresolved: ) .unresolved ( ' .blk is .status )

View File

@ -212,3 +212,25 @@ Target Dos also
l/s 0 DO l/s 0 DO
cr I 2 .r space scr @ block I c/l * + c/l -trailing type cr I 2 .r space scr @ block I c/l * + c/l -trailing type
LOOP cr ; 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

View File

@ -1,4 +1,6 @@
Target Dos also
: cr+ex@ ( fcb -- cr+256*ex ) : cr+ex@ ( fcb -- cr+256*ex )
dup &34 + c@ swap &14 + c@ $100 * + ; dup &34 + c@ swap &14 + c@ $100 * + ;
: cr+ex! ( cr+256*ex fcb -- ) : cr+ex! ( cr+256*ex fcb -- )
@ -61,10 +63,14 @@
| : interpret-via-tib | : interpret-via-tib
BEGIN freadline >r .status >in off interpret r> UNTIL ; 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 ( -- ) : include-isfile ( -- )
increc push 0 isfile@ cr+ex! increc push 0 isfile@ cr+ex!
isfile@ increadrec Abort" can't read start of file" 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 ! incfile push isfile@ incfile !
savetib >r interpret-via-tib r> restoretib savetib >r interpret-via-tib r> restoretib
incfile @ 2+ closefile Abort" error closing file" ; incfile @ 2+ closefile Abort" error closing file" ;

View File

@ -1,5 +1,7 @@
\ *** Block No. 84, Hexblock 54 \ *** Block No. 84, Hexblock 54
Target
\ .status push load 20Oct86 \ .status push load 20Oct86
Defer .status ' noop Is .status Defer .status ' noop Is .status
@ -8,26 +10,6 @@ Defer .status ' noop Is .status
: push ( addr -- ) r> swap dup >r @ >r pull >r >r ; : push ( addr -- ) r> swap dup >r @ >r pull >r >r ;
restrict 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/ ; : rdepth ( -- +n) r0 @ rp@ 2+ - 2/ ;
: depth ( -- +n) sp@ s0 @ swap - 2/ ; : depth ( -- +n) sp@ s0 @ swap - 2/ ;

View File

@ -1,5 +1,7 @@
\ *** Block No. 104, Hexblock 68 \ *** Block No. 104, Hexblock 68
Target
\ endpoints of forget 01Jul86 \ endpoints of forget 01Jul86
| : |? ( nfa -- flag ) c@ $20 and ; | : |? ( nfa -- flag ) c@ $20 and ;