BLOCK NUMBER 55

( CF83-12: RS-DOS File Handling Word Set - Load Block )         
( Copyright [ c ] 1992 by BDS Software )                        
decimal                                                         
cr cr .( Loading RS-DOS File Handling Word Set )                
: thrx ( +n1 +n2 -- ) 1+ swap cr do i dup 55 - cr 3 spaces      
     ." Loading Block " space . ." of 20 " load loop ;          
56 75 thrx                                                      
cr cr .( RS-DOS File Handling Word Set LOADED. )                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                

BLOCK NUMBER 56

( CF83-12: RS-DOS File Handling - 01/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal         variable cgp    variable dadr   variable daf    
variable dfg    variable dft    variable dnb    variable fdn    
variable fdof   variable fexe   variable flen   variable fsa    
variable ngp    variable ngr    variable tfnel  variable tfnep  
variable tlen   variable tsa    create tfne 12 allot            
create tfnen 8 allot            create tfnex 3 allot  16 base ! 
create dski$ ( +n1 +n2 +n3 addr -- ) here dup 2- ! BD51 , 05AE ,
     A16E , 9112 ,              decimal                         
: cgts ( +n1 -- +n2 +n3 ) 2 /mod dup 16 > if 1+ then swap 0= if 
     1 else 10 then ;                                           
: mv1e ( -- ) 8965 tsa @ tlen @ cmove ;                         
: mv1ne ( -- ) tlen @ 0> if 8965 tsa @ tlen @ 2299 min cmove    
     then 2299 tsa +! -2299 tlen +! ;                           
: mve ( -- ) tlen @ 0> if 8960 tsa @ tlen @ cmove then ;        

BLOCK NUMBER 57

( CF83-12: RS-DOS File Handling - 02/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal     : mvg ( -- ) tlen @ 0> if 8960 tsa @ tlen @ 2304 min
                 cmove then 2304 tsa +! -2304 tlen +! ;         
: mng ( -- ) ngp @ dup cgp ! 8704 + c@ ngp ! 1 ngr +! ;         
: gpre ( -- ) 8961 @ dup flen ! tlen ! 8963 @ dup fsa ! tsa ! ; 
: gpost ( -- ) 8960 tlen @ + 3 + @ fdof @ + fexe ! ;            
: gpost1 ( -- ) 8965 tlen @ + 3 + @ fdof @ + fexe ! ;           
: gtb1 ( +n1 +n2 -- ) cgts dup 9 + swap do over over i 8960 256 
     i dup 9 > if 10 - else 1- then * + dski$ loop drop drop ;  
: gpngp ( -- ) ngp @ 67 > not if fdn @ ngp @ cgts 11264 dski$   
     then ;                                                     
: sfgn ( -- ) dfg @ dup cgp ! 8704 + c@ ngp ! 1 ngr ! ;         
: ptfne ( -- ) tfne 12 255 fill ;                               
: ctfne ( char -- ) dup 46 = swap 47 = or if tfnel @ tfnep !    
     then ;                                                     

BLOCK NUMBER 58

( CF83-12: RS-DOS File Handling - 03/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: ptfnea ( -- ) tfnen 8 32 fill tfnex 3 32 fill ;               
: mtfnen ( -- ) tfne tfnen tfnep @ 13 < if tfnep @ 1- else tfnel
     @ then dup 8 > if drop 8 then cmove ;                      
: mtfnex ( -- ) tfnep @ 13 < if tfne tfnep @ + tfnex tfnel @    
     tfnep @ - dup 3 > if drop 3 then cmove then ;              
: dvtfne ( -- ) tfne 8 + tfne 9 + 3 cmove> 46 tfne 8 + c! ;     
16 base !        variable freen  variable lastn                 
: rov52 ( -- ) freen @ 54F4 ! lastn @ 54FB ! 17 556C c! 96 556D 
     ! 5303 55D9 ! ;                                            
decimal                                                         
                                                                
                                                                
                                                                

BLOCK NUMBER 59

( CF83-12: RS-DOS File Handling - 04/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: stfne ( -- ) 0 tfnel ! 13 tfnep ! 12 0 do tfne i + c@ dup 255 
     = not if 1 tfnel +! ctfne else drop then loop ;            
: flod ( -- ) 255 ngp ! sfgn fdn @ cgp @ gtb1 gpngp gpre fsa @  
     fdof @ + dup fsa ! tsa ! gpost1 ngp @ 67 > if mv1e else    
     mv1ne begin mng ngp @ 67 > not while fdn @ cgp @ gtb1 gpngp
     mvg tlen @ 0> if gpost then repeat tlen @ 0> if fdn @ cgp @
     gtb1 gpost mve then then ;                                 
: gdi ( addr -- ) dup 11 + c@ dft ! dup 12 + c@ daf ! dup 13 +  
     c@ dfg ! 14 + @ dnb ! ;                                    
: cfne ( addr -- [ false ] or [ addr true ] ) -1 11 0 do over i 
     + c@ tfne i + c@ = not if drop 0 then loop dup 0= if swap  
     drop then ;                                                
                                                                

BLOCK NUMBER 60

( CF83-12: RS-DOS File Handling - 05/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: sfne ( -- [ false ] or [ addr true ] ) 0 8960 dadr ! 72 0 do  
     dadr @ cfne dup 0= if drop then 32 dadr +! loop dup 0= not 
     if rot drop then ;                                         
: ftb0 ( +n -- ) 17 2 8704 dski$ ;                              
: dtb1 ( +n -- ) 12 3 do dup 17 i 8960 256 i 3 - * + dski$ loop 
     drop ;                                                     
: cvtfne ( -- ) stfne ptfnea mtfnen mtfnex ptfne tfnen tfne 8   
     cmove tfnex tfne 8 + 3 cmove ;                             
: flodf ( +n -- ) fdn ! cvtfne fdn @ ftb0 fdn @ dtb1 sfne if gdi
     flod else ." File not found " then ;                       
16 base !                                                       
create jmp ( addr -- ) here dup 2- ! 3410 , 3710 , 6E84 ,       
decimal         variable sexec                                  

BLOCK NUMBER 61

( CF83-12: RS-DOS File Handling - 06/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal : lsyst4 ( -- ) dvtfne 52 tfne 11 + c! fdn @ flodf rov52
     20992 jmp ; : lsyst3 ( -- ) dvtfne 51 tfne 11 + c! fdn @   
     flodf lsyst4 ; : lsyst2 235 c@ fdn ! dvtfne 50 tfne 11 + c!
     fdn @ flodf lsyst3 ; : lsysf3 ( -- ) dvtfne 51 tfne 11 + c!
     rov52 20992 jmp ; : lsysf2 ( -- ) 235 c@ fdn ! dvtfne 50   
     tfne 11 + c! fdn flodf lsysf3 ;                            
: ldm4 ( -- ) dvtfne 52 tfne 11 + c! fdn @ flodf rov52 fexe @   
     execute ; : ldm3 ( -- ) dvtfne 51 tfne 11 + c! fdn @ flodf 
     ldm4 ; : ldm2 ( -- ) 235 c@ fdn ! dvtfne 50 tfne 11 + c!   
     fdn @ flodf ldm3 ; : ldmf3 ( -- ) dvtfne 51 tfne 11 + c!   
     fdn @ flodf rov52 fexe @ execute ; : ldmf2 ( -- ) 235 c@   
     fdn ! dvtfne 50 tfne 11 + c! fdn @ flodf ldmf3 ;           
variable ssdum  variable ssdum1                                 
                                                                

BLOCK NUMBER 62

( CF83-12: RS-DOS File Handling - 07/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal         variable b5ha   variable gfre   variable ngls   
variable nfgn   variable nfl    variable nlp    variable rgran  
variable td0    variable td1    variable tdec   variable sdec   
create b5h 5 allot              create tdir 32 allot  16 base ! 
create dsko$ ( +n1 +n2 +n3 addr -- ) here dup 2- ! BD51 , 0CAE ,
     A16E , 9112 ,              decimal                         
: b0tf ( +n -- ) 17 2 8704 dsko$ ;                              
: b1td ( +n -- ) 12 3 do dup 17 i 8960 256 i 3 - * + dsko$ loop 
     drop ;                                                     
: b1tg ( +n1 +n2 -- ) cgts dup 9 + swap do over over i 8960 256 
     i dup 9 > if 10 - else 1- then * + dsko$ loop drop drop ;  
: fnfg ( +n -- ) begin dup 8704 + c@ 255 = not while 1+ repeat  
     nfgn ! ;                                                   
: rb5h ( -- ) b5h b5ha @ 5 cmove ;                              

BLOCK NUMBER 63

( CF83-12: RS-DOS File Handling - 08/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: sb5h ( -- ) tsa @ tlen @ + b5ha ! b5ha @ b5h 5 cmove 255 b5ha 
     @ c! 0 b5ha @ 1+ ! fexe @ b5ha @ 3 + ! 5 tlen +! ;         
: svf1 ( -- ) 0 8960 c! flen @ 8961 ! fsa @ 8963 ! tsa @ 8965   
     tlen @ cmove 255 8965 tlen @ + c! 0 8965 tlen @ + 1+ ! fexe
     @ 8965 tlen @ + 3 + ! ngls @ 192 + 8704 nfgn @ + c! fdn @  
     b0tf fdn @ nfgn @ b1tg ;                                   
: svg1 ( -- ) 0 8960 c! flen @ 8961 ! fsa @ 8963 ! tsa @ 8965   
     2299 cmove fdn @ nfgn @ b1tg 2299 tsa +! -2299 tlen +! ;   
: svg ( -- ) 8704 nfgn @ + nfgn @ 1+ fnfg nfgn @ swap c! tsa @  
     8960 2304 cmove fdn @ nfgn @ b1tg 2304 tsa +! -2304 tlen +!
     ;                                                          
: calcsb ( -- ) flen @ 10 + 0 2304 um/mod drop 0 256 um/mod swap
     dup 0= not if swap 1+ else swap then ngls ! dnb ! ;        

BLOCK NUMBER 64

( CF83-12: RS-DOS File Handling - 09/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: sdirx ( -- ) 72 0 do 8960 i 32 * + dup c@ dup 0= swap 255 = or
     if leave then drop loop tfne over 11 cmove 2 over 11 + c! 0
     over 12 + c! 0 fnfg nfgn @ over 13 + c! dnb @ swap 14 + !  
     fdn @ b1td ;                                               
: fre ( -- ) 0 gfre ! 68 0 do i 8704 + c@ 255 = if 1 gfre +!    
     then loop ;                                                
: fsav ( -- ) calcsb sb5h sdirx flen @ 2295 u< if svf1 else svg1
     begin tlen @ 2304 > while svg repeat svg ngls @ 192 + 8704 
     nfgn @ + c! fdn @ b0tf then rb5h ;      16 base !          
: mkazqp ( -- ) 10CE 52B7 ! 0800 52B9 ! 3410 52BB ! 8E01 52BD ! 
DA9F 52BF ! FA8E 52C1 ! 0000 52C3 ! BF01 52C5 ! D8BF 52C7 !     
01D1 52C9 ! 0F2E 52CB ! 7F01 52CD ! D50F 52CF ! 2D35 52D1 !     
1010 52D3 ! 8E59 52D5 ! 738E 52D7 ! 6E91 52DB ! ;   decimal     

BLOCK NUMBER 65

( CF83-12: RS-DOS File Handling - 10/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: fsavf ( +n u1 u2 u3 u4 -- ) fexe ! swap dup dup fsa ! tsa ! - 
     1+ dup flen ! tlen ! dup fexe @ + fexe ! fsa @ + fsa ! fdn 
     ! tlen @ 10 + 0 2304 um/mod swap 0= not if 1+ then dup     
     rgran ! fdn @ ftb0 fre gfre @ > if                         
     ." Insufficient disk space " else cvtfne fdn @ dtb1 fsav   
     then ;                   16 base !                         
: mod52 ( -- ) here freen ! 1F @ lastn ! ['] ssdum 4 - @ 54FB ! 
     ['] ssdum1 4 - @ 54F4 ! 1212 556C ! 12 556E c! 1212 557A ! 
     52B7 55D9 ! ;                                              
: ssystp ( +n -- ) fdn ! mod52 mkazqp ['] lsyst2 52D9 ! fdn @ 0 
     3200 ['] ssdum1 4 - @ 1- 5200 fsavf ;                      
: ssysts ( +n -- ) fdn ! mod52 mkazqp ['] lsysf2 52D9 ! fdn @ 0 
     3200 here 1- 5200 fsavf ;                 decimal          

BLOCK NUMBER 66

( CF83-12: RS-DOS File Handling - 11/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal 16 base !                                               
: savmp ( +n -- ) fdn ! mod52 mkazqp ['] ldm2 52D9 ! fdn @ 0    
     3200 ['] ssdum1 4 - @ 1- 5200 fsavf ;                      
: savms ( +n -- ) fdn ! mod52 mkazqp ['] ldmf2 52D9 ! fdn @ 0   
     3200 here 1- 5200 fsavf ;                                  
: svp2 ( -- ) fdn @ 0 0 03FF 5200 fsavf ;                       
: svp3 ( -- ) fdn @ 0 0800 31FF 5200 fsavf ;   decimal          
: mtfne1 ( -- ) dvtfne 50 tfne 11 + c! ;                        
: mtfne2 ( -- ) dvtfne 51 tfne 11 + c! ;                        
: mtfne3 ( -- ) dvtfne 52 tfne 11 + c! ;                        
: kilf ( +n -- ) fdn ! cvtfne fdn @ ftb0 fdn @ dtb1 sfne if dup 
     gdi 0 swap c! 255 ngp ! sfgn 255 8704 cgp @ + c! begin ngp 
     @ 67 > not while mng 255 8704 cgp @ + c! repeat fdn @ b0tf 
     fdn @ b1td else ." File not found " then ;                 

BLOCK NUMBER 67

( CF83-12: RS-DOS File Handling - 12/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: srchq ( -- flag ) cr ." File already exists - Overwrite (Y/N)?
 " key dup dup emit 89 = swap 121 = or ;                        
: ovwrt ( -- ) fdn @ kilf dvtfne fsavf ;                        
: ovwrt? ( -- ) srchq if ovwrt else 5 0 do drop loop then ;     
: rplc? ( +n -- ) fdn ! fdn @ ftb0 fdn @ dtb1 cvtfne sfne dvtfne
     if drop ovwrt? else fsavf then ;                           
16 base !                                                       
: svpf3 ( -- ) fdn @ 0 0800 31FF sexec @ fsavf ;                
: ssyst4 ( -- ) fdn @ 0 ['] ssdum1 4 - @ here 1- 5200 fsavf ;   
: savm4 ( -- ) fdn @ 0 ['] ssdum1 4 - @ here 1- sexec @ fsavf ; 
decimal                                                         
                                                                
                                                                

BLOCK NUMBER 68

( CF83-12: RS-DOS File Handling - 13/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
: pdi ( addr -- ) dft @ over 11 + c! daf @ over 12 + c! dfg @   
     over 13 + c! dnb @ swap 14 + ! ;                           
: free ( +n -- ) ftb0 fre gfre @ u. ;                           
: cng ( -- ) sfgn begin ngp @ 68 < while mng repeat ;           

BLOCK NUMBER 69

( CF83-12: RS-DOS File Handling - 14/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: lfne ( addr -- ) dup 8 type 46 emit 8 + 3 type 1 nfl +! ;     
: sdire ( addr -- ) lfne 4 spaces ;                             
: dire ( addr -- ) 3 spaces dup lfne 3 spaces gdi dft @ u. space
     daf @ 0= if 66 else 65 then emit 2 spaces cng ngr @ u. ;   
: pdh ( +n -- ) cr ." Directory of Drive " u. cr cr 2 nlp ! ;   
: pmp ( -- ) cr ."       - more - " key 3 = if cr ." ok" abort  
     then cr cr 1 nlp ! ;                                       
: ckfn ( addr -- flag ) c@ 0= ;                                 
: ckfne ( addr -- flag ) c@ 255 = ;                             
: pde ( -- ) cr 5 spaces nfl @ u. ."  Files   " fre gfre @ u.   
     ."  Grans free " 20 spaces ;                               
                                                                
                                                                

BLOCK NUMBER 70

( CF83-12: RS-DOS File Handling - 15/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: csde ( -- ) dadr @ dup dup ckfn swap ckfne or if drop else    
     sdire 1 sdec +! sdec @ 4 = if 0 sdec ! then then 32 dadr +!
     ;                                                          
: sdir ( +n -- ) dup dup pdh ftb0 dtb1 8960 dadr ! 0 sdec ! 0   
     nfl ! 72 0 do csde loop sdec @ 4 < if cr then pde ;        
: cldl ( -- ) dadr @ dup ckfn if drop else dire cr 1 nlp +! then
     32 dadr +! ;                                               
: dir ( +n -- ) cr dup dup pdh ftb0 dtb1 8960 dadr ! 0 nfl ! 72 
     0 do dadr @ ckfne if leave then cldl nlp @ 22 < not if pmp 
     then loop pde ;                                            
: pckfh ( -- ) ." Check File " tfne 8 type 46 emit tfne 8 + 3   
     type cr 0 fdof ! ;                                         
: pckfb ( -- ) cr ." Last Sector Bytes: " dnb @ u. ;            

BLOCK NUMBER 71

( CF83-12: RS-DOS File Handling - 16/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: pckft ( -- ) cr ." File Type:         " dft @ 0= if           
     ." BASIC Program " then dft @ 1 = if                       
     ." BASIC Data File " then dft @ 2 = if                     
     ." Machine Language Program or File " then dft @ 3 = if    
     ." Text Editor Source File " then ;                        
: pckff ( -- ) cr ." File Format:       " daf @ 0= if           
     ." Binary " else ." ASCII " then ;                         
: pckfg ( -- ) cr ." Gran Numbers:      " ;                     
: pckfn ( -- ) cr ." Last Gran Sectors: " ngp @ 192 - u. ;      
: pckfs ( -- ) cr ." Start Address:     " fsa @ u. ;            
: pckfe ( -- ) cr ." End Address:       " fsa @ flen @ 1- + u.  
     ;                                                          
: pckfl ( -- ) cr ." Length, Bytes:     " flen @ u. ;           

BLOCK NUMBER 72

( CF83-12: RS-DOS File Handling - 17/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: pckfx ( -- ) cr ." Execution Address: " fexe @ u. ;           
: pckfz ( -- ) sfgn fdn @ cgp @ gtb1 gpre cgp @ u. ngp @ 67 > if
     gpost1 else -2299 tlen +! begin mng -2304 tlen +! cgp @ u. 
     ngp @ 67 > until 2304 tlen +! fdn @ cgp @ gtb1 gpost then  
     ;                                                          
: pckfy ( -- ) cvtfne sfne if gdi pckfh pckft pckff pckfg pckfz 
     pckfn pckfb dft @ 2 = if pckfs pckfe pckfl pckfx then cr   
     else ." File not found " then ;                            
: ckfile ( +n -- ) cr cr fdn ! 32 word 1+ tfne 12 cmove fdn @   
     ftb0 fdn @ dtb1 pckfy ;                                    
                                                                
                                                                
                                                                

BLOCK NUMBER 73

( CF83-12: RS-DOS File Handling - 18/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: ckdir ( +n -- ) cr dup pdh dup fdn ! ftb0 72 0 do 255 ngp !   
     fdn @ dtb1 8960 i 32 * + dup dup dup ckfne if drop drop    
     drop leave then ckfn not if tfne 8 cmove 46 tfne 8 + c!    
     8 + tfne 9 + 3 cmove pckfy pmp else drop drop then loop    
     pde ;                                                      
: fload ( +n1 +n2 -- ) fdof ! 32 word 1+ tfne 12 cmove flodf ;  
: fsave ( +n u1 u2 u3 u4 -- ) 32 word 1+ tfne 12 cmove 4 pick   
     rplc? ;                                                    
: kill ( +n -- ) 32 word 1+ tfne 12 cmove kilf ;                
: tdcomp ( -- ) 12 0 do td0 @ i + c@ dup td1 @ i + c@ dup rot   
     swap < if drop drop leave then > if td0 @ tdir 32 cmove    
     td1 @ td0 @ 32 cmove tdir td1 @ 32 cmove 1 tdec +! leave   
     then loop ;                                                

BLOCK NUMBER 74

( CF83-12: RS-DOS File Handling - 19/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: tdrun ( -- ) 0 tdec ! 71 0 do 8960 i 32 * + td0 ! 8960 i 1+ 32
     * + td1 ! tdcomp loop ;                                    
: sortdir ( +n -- ) fdn ! fdn @ dtb1 begin tdrun tdec @ 0= until
     fdn @ b1td ;                                               
: ssystf ( +n -- ) here 32768 u< if ssysts mtfne1 svp2 mtfne2   
     svp3 else ssystp mtfne1 svp2 mtfne2 svp3 mtfne3 ssyst4     
     then ;                                                     
: ovsys ( -- ) fdn @ kilf dvtfne fdn @ ssystf ;                 
: ovsys? ( -- ) srchq if ovsys then ;                           
: rsys? ( +n -- ) fdn ! fdn @ ftb0 fdn @ dtb1 cvtfne sfne dvtfne
     if drop ovsys? else fdn @ ssystf then ;                    
: save-system ( +n -- ) 32 word 1+ tfne 12 cmove 2560 6144 255  
     fill rsys? ;                                               

BLOCK NUMBER 75

( CF83-12: RS-DOS File Handling - 20/20 )                       
( Copyright  [ c ]  1992 by BDS Software )                      
decimal                                                         
: ssmf ( +n -- ) here 32768 u< if savms mtfne1 svp2 mtfne2 svpf3
     else savmp mtfne1 svp2 mtfne2 svp3 mtfne3 savm4 then ;     
: ovsm ( -- ) fdn @ kilf dvtfne fdn @ ssmf ;                    
: ovsm? ( -- ) srchq if ovsm then ;                             
: rsm? ( +n -- ) fdn ! fdn @ ftb0 fdn @ dtb1 cvtfne sfne dvtfne 
     if drop ovsm? else fdn @ ssmf then ;                       
: savem ( +n addr -- ) sexec ! 32 word 1+ tfne 12 cmove 2560    
     6144 255 fill rsm? ;