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 \ benutze ein schon existierendes File 9 FILE \ erzeuge ein Forthfile mit dem Namen . 10 MAKE \ Erzeuge ein File mit und ordne 11 \ es dem aktuellen Forthfile zu. 12 MAKEFILE \ Erzeuge ein File mit CP/M und FORTH-Namen 13 . 14 INCLUDE \ Lade File mit Forthnamen 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