\ 28 jun 88 DOS loads higher level file functions which go beyond including a screen file. Calls to MS-DOS are implemented and used for directory manipulation. These functions may not work for versions before MS-DOS 3.0. \ MS-DOS file handling cas 11nov05 Onlyforth \needs Assembler 2 loadfrom asm.fb : fswap isfile@ fromfile @ isfile ! fromfile ! ; $80 Constant dta | : COMSPEC ( -- string ) [ dos ] $2C @ ( DOS-environment:seg) 8 ds@ filename &60 lmove filename counted &60 min filename place filename ; 1 &12 +thru .( MS-DOS Extension loaded ) cr Onlyforth \ moving blocks ks 04 okt 87 | : full? ( -- flag ) prev BEGIN @ dup @ 0= UNTIL 6 + @ 0< ; : used? ( blk -- f ) block count b/blk 1- swap skip nip 0<> ; | : (copy ( from to -- ) full? IF save-buffers THEN isfile@ fromfile @ - IF dup used? Abort" target block not empty" THEN dup isfile@ core? IF prev @ emptybuf THEN isfile@ 0= IF offset @ + THEN isfile@ rot fromfile @ (block 6 - 2! update ; \ moving blocks ks 04 okt 87 | : blkmove ( from to quan -- ) 3 arguments save-buffers >r over r@ + over u> >r 2dup u< r> and IF r@ r@ d+ r> 0 ?DO -1 -2 d+ 2dup (copy LOOP ELSE r> 0 ?DO 2dup (copy 1 1 d+ LOOP THEN save-buffers 2drop ; : copy ( from to -- ) 1 blkmove ; : convey ( blk1 blk2 to.blk -- ) 3 arguments >r 2dup swap - >r fswap dup capacity 1- > isfile@ 0<> and fswap r> r@ + capacity 1- > isfile@ 0<> and or >r 1+ over - dup 0> not r> or Abort" nein" r> swap blkmove ; \ MORE extending forth files ks 10 okt 87 Dos also definitions | : addblock ( blk -- ) dup buffer dup b/blk blank isfile@ f.size dup 2@ b/blk 0 d+ rot 2! swap isfile@ fblock! ; Forth definitions : more ( n -- ) 1 arguments isfile@ IF capacity swap bounds ?DO I addblock LOOP close exit THEN drop ; \ file eof? create dta-addressing ks 03 apr 88 Dos definitions : ftime ( -- mm hh ) isfile@ f.time @ $20 u/mod nip $40 u/mod ; : fdate ( -- dd mm yy ) isfile@ f.date @ $20 u/mod $10 u/mod &80 + ; : .when base push decimal fdate rot 3 .r ." ." swap 2 .r ." ." 2 .r ftime 3 .r ." :" 2 .r ; \ ks 20 m„r 88 : (.fcb ( fcb -- ) dup .file ?dup 0=exit pushfile isfile ! &13 tab ." is" isfile@ f.handle @ 2 .r isfile@ f.size 2@ 7 d.r .when space isfile@ f.name count type ; Forth definitions : files file-link BEGIN @ dup WHILE cr dup (.fcb stop? UNTIL drop ; : ?file isfile@ (.fcb ; \ dir make makefile ks 25 okt 87 Forth definitions : killfile close isfile@ f.name filename >asciz ~unlink drop ; : emptyfile isfile@ 0=exit isfile@ f.name filename >asciz 0 ~creat ?diskerror isfile@ f.handle ! isfile@ f.size 4 erase ; : make close name isfile@ fname! emptyfile ; : makefile File last @ name> execute emptyfile ; \ getpath ks 10 okt 87 Dos definitions | &40 Constant pathlen | Create pathes 0 c, pathlen allot | : (setpath ( string -- ) count dup pathlen u> Abort" path too long" pathes place ; | : getpath ( +n -- string / ff ) >r 0 pathes count r> 0 DO rot drop Ascii ; skip stash Ascii ; scan LOOP drop over - ?dup IF here place here dup count + 1- c@ ?" :\" ?exit Ascii \ here append exit THEN 0= ; \ pathsearch .path path ks 09 okt 87 : pathsearch ( string -- asciz *f ) dup >r (fsearch dup 0= IF rdrop exit THEN 2drop 0 0 BEGIN drop 1+ dup getpath ?dup 0= IF drop r> filename >asciz 2 exit THEN r@ count 2 pick attach (fsearch 0= UNTIL nip rdrop false ; ' pathsearch Is fsearch Forth definitions : .path pathes count type ; : path name nullstring? IF .path exit THEN (setpath ; \ call another executable file ks 04 aug 87 Dos definitions | Create cpb 0 , \ inherit parent environment dta , ds@ , $5C , ds@ , $6C , ds@ , Label ssave 0 , | Code ~exec ( asciz -- *f ) I push R push U push S ssave #) mov cpb # R mov $4B00 # A mov $21 int C: D mov D D: mov D S: mov D E: mov ssave #) S mov CS not ?[ A A xor A push $2F # A+ mov $21 int E: A mov A D: mov C: A mov A E: mov R I mov dta # W mov $40 # C mov rep movs A D: mov A pop ]? A W xchg dta # D mov $1A # A+ mov $21 int W D mov U pop R pop I pop Next end-code \ calling MS-DOS thru forth interpreter ks 19 m„r 88 | : execute? ( extension -- *f ) count filename count Ascii . scan drop swap 2dup 1+ erase move filename 1+ ~exec ; : fcall ( string -- ) count filename place ds@ cpb 4+ ! " .EXE" execute? dup IF drop " .COM" execute? THEN ?diskerror ; : fdos ( string -- ) dta $80 erase " /c " count dta place count dta attach status push status off .status COMSPEC fcall curat? at ; \ some msdos calls cas 10nov05 : dos: Create ," Does> count here place Ascii " parse here attach here fdos ; Forth definitions dos: dir dir " dos: ren ren " dos: md md " dos: cd cd " dos: rd rd " dos: fcopy copy " dos: delete del " dos: ftype type " \ msdos call ks 23 okt 88 : msdos savevideo status push status off .status flush dta off COMSPEC fcall restorevideo ; : call name source >in @ /string c/l umin dta place dta dta >asciz drop [compile] \ status push status off .status fcall curat? at ; \ time date ks 19 m„r 88 Dos definitions : ftime ( -- mm hh ) open isfile@ f.time @ $20 u/mod nip $40 u/mod ; : fdate ( -- dd mm yy ) open isfile@ f.date @ $20 u/mod $10 u/mod &80 + ; \ ~lseek position? ks 10 okt 87 Dos definitions Code ~lseek ( d handle method -- d' ) R W mov D A mov R pop C pop D pop $42 # A+ mov $21 int W R mov CS not ?[ A push Next ]? A D xchg ;c: ?diskerror ; Forth definitions : position? ( -- dfaddr ) isfile@ f.handle @ 0= Abort" file not open" 0 0 isfile@ f.handle @ 1 ~lseek ;