home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frostbyte's 1980s DOS Shareware Collection
/
floppyshareware.zip
/
floppyshareware
/
FORTH
/
QF251.EXE
/
KDOS.SCR
< prev
next >
Wrap
Text File
|
1988-07-10
|
18KB
|
1 lines
\ Load Dos 2.0 Interface 5 /15/88 3 VIEW#-T ! 2 9 thru decimal \ String Tools 5 /15/88CREATE ASCIZ-BUF 256 ALLOT : >ASCIZ ( adr len -- adr' ) 254 min ASCIZ-BUF 2DUP + OFF SWAP CMOVE ASCIZ-BUF ; : ZLENGTH ( addr -- len ) 0 SWAP BEGIN COUNT WHILE SWAP 1+ SWAP REPEAT DROP ; : TYPEZ ( adr -- ) DUP ZLENGTH TYPE ; \ Extended DOS Calls 5 /15/88HEX LABEL EDOS-RETURN AX PUSH U< IF FALSE # BX MOV ELSE TRUE # BX MOV THEN NEXT CODE (LDOS) ( dx ds cx bx ax -- ax f ) DS DI MOV BX AX MOV BX POP CX POP DS POP DX POP 21 INT DI DS MOV EDOS-RETURN #) JMP END-CODE : EDOS ( dx cx bx ax -- ax f) >R >R >R CSEG R> R> R> (LDOS) ; ( directory functions ) \ : MKDIR ( adr -- ec f ) 0 0 3900 EDOS ; \ : RMDIR ( adr -- ec f ) 0 0 3A00 EDOS ; : CHDIR ( adr -- ec f ) 0 0 3B00 EDOS ; CODE GETDIR ( adr drive -- ec f ) BX DX MOV AX POP SI PUSH AX SI MOV 47 # AH MOV 21 INT SI POP EDOS-RETURN #) JMP END-CODE \ file management 5 /15/88HEX : FCREAT ( adr attribute -- ec f ) 0 3C00 EDOS ; : FOPEN ( adr access -- ec f ) 0 0 ROT 3D00 + EDOS ; : FCLOSE ( handle -- ec f ) 0 0 ROT 3E00 EDOS ; : FDELETE ( adr -- ec f ) 0 0 4100 EDOS ; CODE CHMOD ( adr attribute func -- n ec f ) BX AX MOV CX POP DX POP 43 # AH MOV 21 INT CX PUSH EDOS-RETURN #) JMP END-CODE : FIND1 ( adr attribute -- ec f ) 0 4E00 EDOS ; : FIND+ ( -- ec f ) 0 0 0 4F00 EDOS ; \ file i/o 7 /10/88HEX : FREAD ( adr len handle -- len' f ) 3F00 EDOS ; : FWRITE ( adr len handle -- len' f ) 4000 EDOS ; CODE LSEEK? ( handle d#bytes func -- l f ) BX AX MOV 42 # AH MOV CX POP DX POP BX POP 21 INT DX PUSH AX PUSH U< IF FALSE # BX MOV ELSE TRUE # BX MOV THEN NEXT END-CODE CODE (FREE) ( drive# -- total b/sec avail sec/cluster ) BX DX MOV 36 # AH MOV 21 INT DX PUSH CX PUSH BX PUSH AX BX MOV NEXT END-CODE : FREE ( drive# -- d#bytes ) (FREE) ROT * UM* ROT DROP ; \ errors 5 /15/88: .ERROR2 ( err -- err ) dup 1 = abort" invalid function" dup 2 = abort" file not found" dup 3 = abort" path not found" dup 4 = abort" no free handles" dup 5 = abort" access denied" dup 6 = abort" invalid handle" dup 7 = abort" memory scrambled" dup 8 = abort" insufficient memory" dup 9 = abort" invalid memory block address" dup 10 = abort" invalid environment" dup 11 = abort" invalid format" dup 12 = abort" invalid access code" dup 13 = abort" invalid data" ; \ errors 5 /15/88: .ERROR ( err flag -- err ) if exit then .error2 dup 15 = abort" invalid drive specification" ( continued ) dup 16 = abort" cannot remove current directory" dup 17 = abort" not same device" true abort" unknown error" ; \ 02OCT87GEB: REWIND-FILE ( handle -- ) 0. 0 LSEEK? .ERROR 2DROP ; : FILE-SIZE ( handle -- d# ) DUP 0. 2 LSEEK? .ERROR SWAP ROT REWIND-FILE ; : HOPEN ( -- handle ) BL WORD COUNT >ASCIZ 0 FOPEN .ERROR ; : CLOSE ( handle -- ) FCLOSE .ERROR DROP ; : GET-DRIVE ( -- c ) 0 19 BDOS ASCII A + ; load screen 3 VIEW#-T ! set view number load the screens base was changed \ String Tools 5 /15/88ASCIZ-BUF 256 byte buffer for strings >ASCIZ ( adr len -- adr' ) make a null terminated string for MSDOS ZLENGTH ( addr -- len ) get the length of a null terminated string TYPEZ ( adr -- ) type a null terminated string \ Extended DOS Calls 5 /15/88HEX EDOS-RETURN a common return point (LDOS) ( dx ds cx bx ax -- ax f ) The common dos call primitive EDOS ( dx cx bx ax -- ax f) dos call using code segment ( directory functions ) \ MKDIR ( adr -- ec f ) make a directory \ RMDIR ( adr -- ec f ) remove a directory CHDIR ( adr -- ec f ) primitive change directory GETDIR ( adr drive -- ec f ) \ file management 5 /15/88 FCREAT ( adr attribute -- ec f ) file create FOPEN ( adr access -- ec f ) file open FCLOSE ( handle -- ec f ) handle file close FDELETE ( adr -- ec f ) file delete CHMOD ( adr attribute func -- n ec f ) FIND1 ( adr attribute -- ec f ) search dir for first match FIND+ ( -- ec f ) search for next match \ file i/o 5 /15/88 FREAD ( adr len handle -- len' f ) read from a file FWRITE ( adr len handle -- len' f ) write to a file CODE LSEEK? ( handle d#bytes func -- h l f ) go to a point in a file CODE (FREE) ( drive# -- total b/sec avail sec/cluster ) given a drive number return available info FREE ( drive# -- d#bytes ) like (FREE) but return double byte remaining size \ errors 5 /15/88.ERROR2 ( err -- err ) error reporting, note that this version of F83 does not allow compilation across screen boundries. \ errors 5 /15/88.ERROR ( err flag -- err ) the rest of the error reporting \ 02OCT87GEBREWIND-FILE ( handle -- ) move dos file pointer to begining of file FILE-SIZE ( handle -- d# ) return double file size HOPEN ( -- handle ) open the file of the following name CLOSE ( handle -- ) close a file of the given handle GET-DRIVE ( -- c ) return a character of the current default drive
