Screen 0 not modified     
 0 \ CP/M 2.2 File-Interface (3.80a)                     UH 05Oct87
 1                                                                 
 2 Dieses File enthaelt das File-Interface von volksFORTH zu CP/M. 
 3 Damit ist Zugriff auf normale CP/M-Files moeglich.              
 4 Wenn ein File mit USE benutzt wird, beziehen sich alle Worte,   
 5 die mit dem Massenspeicher arbeiten, auf dieses File.           
 6                                                                 
 7 Benutzung:                                                      
 8   USE <name>       \ benutze ein schon existierendes File       
 9   FILE <name>      \ erzeuge ein Forthfile mit dem Namen <name>.
10   MAKE <name>      \ Erzeuge ein File mit <name> und ordne      
11                    \ es dem aktuellen Forthfile zu.             
12   MAKEFILE <name>  \ Erzeuge ein File mit CP/M und FORTH-Namen  
13                      <name>.                                    
14   INCLUDE <name>   \ Lade File mit Forthnamen <name> ab Screen 1
15   DOS RESET        \ zum Wechsel von Disketten. (Oh! CP/M)      
Screen 1 not modified     
 0 \ CP/M 2.2 File-Interface  load-Screen                UH 18Feb88
 1 OnlyForth                                                       
 2                                                                 
 3       2 load \ view numbers for this file                       
 4   3   4 thru \ DOS   File Functions                             
 5   5 $11 thru \ Forth File Functions                             
 6 $12 $16 thru \ User Interface                                   
 7                                                                 
 8 File source.scr     \  Define already existing Files            
 9 File fileint.scr    File startup.scr                            
10                                                                 
11 ' (makeview     Is makeview                                     
12 ' remove-files  Is custom-remove                                
13 ' file-r/w      Is r/w                                          
14 ' noop          Is drvinit                                      
15 \      include startup.scr \ load Standard System               
Screen 2 not modified     
 0 \ Build correct view-numbers for this file           UUH 19Nov87
 1                                                                 
 2 | : fileintview ( -- )  $400 blk @ + ;                          
 3                                                                 
 4 ' fileintview Is makeview                                       
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 3 not modified     
 0 \ File Control Blocks                                 UH 18Feb88
 1 Dos definitions also                                            
 2 | : Fcbyte ( n len -- len' )  Create over c, + does> c@ + ;     
 3 &11 Constant filenamelen                                        
 4 0              2 | Fcbyte nextfile  immediate                   
 5                1   Fcbyte drive    ' drive | Alias >dosfcb      
 6  filenamelen 3 -   Fcbyte filename                              
 7                3   Fcbyte extension                             
 8            &21 + \ ex, s1, s2, rc, d0, ... dn, cr               
 9                2   Fcbyte record    \  r0, r1                   
10               1+ \ r2                                           
11                2   Fcbyte opened                                
12                2   Fcbyte fileno                                
13                2   Fcbyte filesize  \ in 128-Byte-Records       
14                4   Fcbyte position                              
15 Constant b/fcb                                                  
Screen 4 not modified     
 0 \ dos primitives                                      UH 10Oct87
 1                                                                 
 2 ' 2-  | Alias body>             ' 2- | Alias dosfcb>            
 3                                                                 
 4 : drive!     ( drv    --      )     $0E bdos ;                  
 5 : search0    ( dosfcb -- dir  )     $11 bdosa ;                 
 6 : searchnext ( dosfcb -- dir  )     $12 bdosa ;                 
 7 : read-seq   ( dosfcb -- f    )     $14 bdosa dos-error? ;      
 8 : write-seq  ( dosfcb -- f    )     $15 bdosa dos-error? ;      
 9 : createfile ( dosfcb -- f    )     $16 bdosa dos-error? ;      
10 : size       ( dos    -- size ) dup $23 bdos dosfcb> record @ ; 
11 : drive@     (        -- drv  )   0 $19 bdosa ;                 
12 : killfile   ( dosfcb --      )     $13 bdos ;                  
13                                                                 
14                                                                 
15                                                                 
Screen 5 not modified     
 0 \ File sizes                                          UH 05Oct87
 1                                                                 
 2 : (capacity  ( fcb -- n )  \ filecapacity in blocks             
 3     filesize @  rec/blk  u/mod swap 0= ?exit 1+ ;               
 4                                                                 
 5 : in-range ( block fcb -- )                                     
 6     (capacity u< not Abort" beyond capacity!" ;                 
 7                                                                 
 8 Forth definitions                                               
 9                                                                 
10 : capacity ( -- n )    isfile@  (capacity ;                     
11                                                                 
12 Dos definitions                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 6 not modified     
 0 \ (open                                               UH 18Feb88
 1                                                                 
 2 : (open  ( fcb -- )                                             
 3     dup opened @ IF drop exit THEN   dup position  0. rot 2!    
 4     dup >dosfcb openfile  Abort" not found!"  dup opened on     
 5     dup >dosfcb size  swap filesize ! ;                         
 6                                                                 
 7 : (make  ( fcb -- )                                             
 8    dup >dosfcb killfile                                         
 9    dup >dosfcb createfile Abort" directory full!"               
10    dup position 0. rot 2!                                       
11    dup filesize off   opened on  offset off ;                   
12                                                                 
13 : file-r/w  ( buffer block fcb f  -- f )                        
14     over 0= Abort" no Direct Disk IO supported! "               
15     >r  dup  (open   2dup in-range r> (r/w ;                    
Screen 7 not modified     
 0 \ Print Filenames                                     UH 10Oct87
 1                                                                 
 2 : .file ( fcb -- ) 0 case? IF ." DIRECT"  exit THEN             
 3          fcb dosfcb> case? IF ." DEFAULT" exit THEN             
 4          body> >name .name ;                                    
 5                                                                 
 6 : .drive   ( fcb -- ) drive c@ ?dup 0=exit                      
 7      [ Ascii A 1- ] Literal + emit  Ascii : emit ;              
 8                                                                 
 9 : .dosfile ( fcb -- )  dup filename  8 -trailing type           
10     Ascii . emit           extension 3           type ;         
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 8 not modified     
 0 \ Print Filenames                                     UH 10Oct87
 1                                                                 
 2 : tab ( -- ) col &59 > IF cr exit THEN                          
 3         &20  col &20 mod  -  0 max  spaces ;                    
 4                                                                 
 5 : .fcb  ( fcb -- )  dup fileno @  3 u.r tab                     
 6      dup .file tab dup .drive dup .dosfile                      
 7      tab dup opened @ IF ." opened" ELSE ." closed" THEN        
 8      3 spaces  base push  decimal   (capacity  3 u.r  ."  kB" ; 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 9 not modified     
 0 \ Filenames                                           UH 05Oct87
 1                                                                 
 2 : !name ( addr len fcb -- )                                     
 3      dup >r filename filenamelen bl fill                        
 4      over 1+ c@  Ascii : =                                      
 5      IF over c@ [ Ascii A 1- ] Literal - >r 2 /string r>        
 6      ELSE 0 THEN  r@ drive c! r> dup filename 2swap             
 7      filenamelen 1+ min bounds                                  
 8      ?DO  I c@ Ascii . =                                        
 9          IF drop dup  extension ELSE  I c@ over c! 1+ THEN      
10      LOOP 2drop ;                                               
11                                                                 
12 : !fcb  ( fcb -- )  dup opened off   name count rot !name ;     
13                                                                 
14                                                                 
15                                                                 
Screen 10 not modified     
 0 \ Print Directory                                     UH 18Nov87
 1                                                                 
 2 | Create dirbuf  b/rec allot    dirbuf b/rec erase              
 3 | Create fcb0    b/fcb allot    fcb0   b/fcb erase              
 4                                                                 
 5 | : wildchard?  ( f c -- f' )  Ascii * = IF drop Ascii ? THEN ; 
 6 | : (expand ( addr len -- )  false -rot bounds                  
 7      ?DO  I c@  wildchard? dup ?dup IF I c! THEN  LOOP drop ;   
 8 | : expand ( fcb -- )  \ expand * to ???                        
 9      dup filename 8 (expand   extension 3 (expand ;             
10                                                                 
11 : (dir  ( addr len -- )                                         
12     fcb0 !name fcb0 expand  dirbuf dma!  fcb0 >dosfcb search0   
13     BEGIN dup dos-error? not                                    
14     WHILE  $20 * dirbuf + dosfcb> tab .dosfile                  
15            fcb0 >dosfcb searchnext  stop? UNTIL  drop ;         
Screen 11 not modified     
 0 \ File List                                           UH 10Oct87
 1                                                                 
 2 User file-link   file-link off                                  
 3                                                                 
 4 | : #file ( -- n )   file-link @ dup IF fileno c@ THEN 1+ ;     
 5                                                                 
 6                                                                 
 7 Forth definitions                                               
 8                                                                 
 9 : forthfiles ( -- )                                             
10    file-link @                                                  
11    BEGIN dup WHILE  cr  dup .fcb  @ stop? UNTIL drop ;          
12                                                                 
13 Dos definitions                                                 
14                                                                 
15                                                                 
Screen 12 not modified     
 0 \ Close a file                                        UH 10Oct87
 1                                                                 
 2 ' save-buffers >body $0C + @ | Alias backup                     
 3                                                                 
 4 | : filebuffer?  ( fcb -- fcb bufaddr/flag )                    
 5    prev  BEGIN @ dup WHILE  2dup 2+ @ = UNTIL ;                 
 6                                                                 
 7 | : flushfile  ( fcb -- )  \ flush file buffers                 
 8      BEGIN  filebuffer?  ?dup  WHILE                            
 9             dup backup  emptybuf  REPEAT  drop ;                
10                                                                 
11 : (close  ( fcb -- )  \ close file in fcb                       
12    dup flushfile                                                
13    dup opened  dup @ 0= IF 2drop exit THEN  off                 
14    >dosfcb closefile Abort" not found!" ;                       
15                                                                 
Screen 13 not modified     
 0 \ Create fcbs                                         UH 10Oct87
 1                                                                 
 2 : !files ( fcb -- )  dup  isfile ! fromfile ! ;                 
 3                                                                 
 4 ' r@ | Alias newfcb                                             
 5                                                                 
 6 Forth definitions                                               
 7                                                                 
 8 : File  ( -- )                                                  
 9    Create here >r   b/fcb allot  newfcb b/fcb erase             
10           last @ count $1F and  newfcb !name                    
11           #file   newfcb fileno !                               
12           file-link @  newfcb nextfile !   r> file-link !       
13    Does> !files ;                                               
14                                                                 
15 : direct     0 !files ;                                         
Screen 14 not modified     
 0 \ flush buffers & misc.                  UH 10Oct87   UH 28Nov87
 1 Dos definitions                                                 
 2                                                                 
 3 : save-files  ( -- )  file-link BEGIN  @ ?dup  WHILE            
 4      dup opened @ IF dup >dosfcb closefile drop THEN  REPEAT ;  
 5                                                                 
 6 ' save-files Is save-dos-buffers                                
 7                                                                 
 8 \ : close-files  ( -- )  file-link                              
 9 \     BEGIN  @ ?dup  WHILE  dup (close  REPEAT ;                
10                                                                 
11 Forth definitions                                               
12                                                                 
13 : file?   isfile@ .file ;  \ print current file                 
14                                                                 
15 : list  ( n -- )   3 spaces  file? list ;                       
Screen 15 not modified     
 0 \ words for viewing                                   UH 10Oct87
 1                                                                 
 2 Forth definitions                                               
 3                                                                 
 4 | $200 Constant viewoffset \ max. %512 kB files                 
 5                                                                 
 6 : (makeview  ( -- n )  \ calc. view filed for a name            
 7    blk @ dup  0= ?exit                                          
 8    loadfile @ ?dup IF fileno @ viewoffset * + THEN ;            
 9                                                                 
10 : (view      ( blk -- blk' ) \ select file and leave block      
11    dup 0=exit                                                   
12    viewoffset u/mod  file-link                                  
13    BEGIN @ dup WHILE 2dup fileno @ = UNTIL                      
14    !files drop ;        \ not found: direct access              
15                                                                 
Screen 16 not modified     
 0 \ FORGETing files                                     UH 10Oct87
 1                                                                 
 2 | : remove?      ( dic symb addr -- dic symb addr f )           
 3      dup heap? IF  2dup u> exit THEN 2 pick over 1+ u< ;        
 4                                                                 
 5                                                                 
 6 | : remove-files ( dic symb -- dic symb )  \ flush files !      
 7      isfile@      remove? nip  IF direct       THEN             
 8      fromfile @   remove? nip  IF fromfile off THEN             
 9      file-link                                                  
10      BEGIN @ ?dup WHILE remove? IF dup (close THEN REPEAT       
11      file-link remove ;                                         
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 17 not modified     
 0 \ print a list of all buffers                         UH 20Oct86
 1                                                                 
 2 : .buffers                                                      
 3    prev BEGIN  @ ?dup WHILE  stop? abort" stopped"              
 4            cr dup u. dup 2+ @ dup 1+                            
 5            IF ."    Block: " over 4+ @ 5 .r                     
 6               ."    File : " [ Dos ] .file                      
 7               dup 6 + @ 0< IF ."     updated" THEN              
 8            ELSE ." Buffer empty" drop THEN  REPEAT ;            
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 18 not modified     
 0 \ File Interface User words                           UH 11Oct87
 1                                                                 
 2 | : same ( addr -- )  >in ! ;                                   
 3 : open      isfile@ (open   offset off ;                        
 4 : close     isfile@ (close ;                                    
 5 : assign    close   isfile@ !fcb  open ;                        
 6 : make      isfile@ dup !fcb   (make ;                          
 7                                                                 
 8 | : isfile?  ( addr -- addr f )    \ is adr a fcb?              
 9   file-link BEGIN  @ dup 0=exit 2dup body> = UNTIL drop true ;  
10                                                                 
11 : use       >in @ name find \ create a fcb if not present       
12             IF isfile? IF execute drop  exit THEN THEN drop     
13             dup same File   same ' execute  open ;              
14                                                                 
15                                                                 
Screen 19 not modified     
 0 \ File Interface User words                           UH 25May88
 1                                                                 
 2 : makefile     >in @   File  dup  same ' execute  same make ;   
 3 : emptyfile    isfile@ >dosfcb createfile ;                     
 4                                                                 
 5 : from         isfile push use ;                                
 6 : loadfrom     ( n -- )                                         
 7                isfile push  fromfile push  use load   close ;   
 8 : include      1 loadfrom ;                                     
 9                                                                 
10 : eof ( -- f ) isfile@  dup filesize @ swap record @ = ;        
11                                                                 
12 : files        " *.*" count (dir ;                              
13 : files"       Ascii " word count 2dup upper (dir ;             
14                                                                 
15 ' files Alias dir     ' files" Alias dir"                       
Screen 20 not modified     
 0 \ extend Files                                        UH 20Nov87
 1                                                                 
 2 | : >fileend   isfile@ >dosfcb size drop ;                      
 3                                                                 
 4 | : addblock  ( n -- )  \ add block n to file                   
 5      dup buffer under   b/blk  bl fill                          
 6      isfile@   rec/blk  over filesize +!  false file-r/w        
 7      IF close Abort" disk full!" THEN ;                         
 8                                                                 
 9 : more ( n -- )   open >fileend                                 
10    capacity swap bounds  ?DO I addblock LOOP close              
11    open close ;                                                 
12                                                                 
13 : Drive: ( n -- n' ) dup Constant 1+ Does> @ drive! ;           
14 0   Drive: a:   Drive: b:   Drive: c:   Drive: d:               
15 5 + Drive: j:  drop                                             
Screen 21 not modified     
 0 \ save memory-image as disk-file                      UH 29Nov86
 1                                                                 
 2 Forth definitions                                               
 3                                                                 
 4 : savefile ( from count -- ) \ filename                         
 5    isfile push  makefile bounds                                 
 6    ?DO I dma!  isfile@ >dosfcb write-seq  Abort" disk full!"    
 7        b/rec +LOOP  close ;                                     
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 22 not modified     
 0 \ Status                                              UH 10OCt87
 1                                                                 
 2                                                                 
 3 : .blk ( -- )   blk @ ?dup 0=exit                               
 4    dup 1 = IF cr file? THEN base push hex ."  Blk " . ?cr ;     
 5                                                                 
 6 ' .blk Is .status                                               
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 23 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 24 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 25 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 26 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 27 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 28 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 29 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 30 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
Screen 31 not modified     
 0                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
