( PC-DOS File Interface for PC/FORTH+ 12/28/83 ) Copyright (c) 1983 by Ray Duncan, Laboratory Microsystems, Inc. 4147 Beethoven Street, Los Angeles, CA 90066 File created from PC/FORTH version DOS20.SCR 20 September 1983 Converted for PC/FORTH+ 2.0 on 25 December 1983 Important functional note: SEEK-ABS, SEEK-REL, SEEK-EOF, ?FILESIZE, and ?OFFSET accept or return SINGLE stack cell offsets in the PC/FORTH+ version and DOUBLE stack cell offsets in the PC/FORTH (16-bit) version. Otherwise, the same high level code will run on top of either interface. ( Handle Control Block 9/14/83 This file/record interface for MS-DOS and PC-DOS 2.0 uses a new construct which is called a "Handle Control Block". The HCB is used by FORTH to store the file specification, the 16 bit handle assigned by DOS, and certain other parameters and flags. Each HCB is created by a defining word; when the name of the HCB is executed it returns the handle and a pointer to a data area: offset contents 0-1 handle 2-3 FORTH flags, 0 if file not opened/created 4 length of file specification string 5+ ASCIIZ file spec. terminated by 0 byte ) ( Directory Control Block 9/19/83 This PC-DOS interface also uses a new construct called a "Directory Control Block" which is similar to the "Handle Control Block". The DCB is used by FORTH to store a path specification which can be used to create, change, or delete subdirectories. Each DCB is created by a defining word; when the name of the DCB is executed it returns a pointer to the data area: offset contents 0 length of path specification string 1+ ASCIIZ path spec. terminated by 0 byte maximum length 63 characters ) ( System messages ) empty stack dictionary full has incorrect address mode is redefined is undefined disk address out of range stack overflow disk error BASE must be DECIMAL missing decimal point PC/FORTH+ 2.0 Laboratory Microsystems( System messages ) compilation only, use in definition execution only conditionals not paired definition not finished in protected dictionary use only when loading off current editing screen declare vocabulary illegal dimension in array definition negative array index array index too large ( 8086 Assembler messages ) 16 bit register not allowed 8 bit register not allowed address out of range immediate data value not allowed missing source register missing destination register illegal operation illegal operand instruction not implemented illegal destination register illegal source register illegal condition code register mismatch destination address missing ( PC-DOS 1.x File and Record interface 01/01/84 ) ( modified for PC/FORTH+ 2/20/83 ) FORTH DEFINITIONS DECIMAL ( used in the form: FCB fcb-name ) : FCB CREATE HERE 165 ERASE 165 ALLOT DOES> ; ( length of fcb, displacement to actual i/o buffer ) 37 CONSTANT BUFFER-OFFSET ( fcb-addr --- ) : SET-DMA BUFFER-OFFSET + set-dta ; ( fcb-addr --- ) : ?BUFFER-ADDR BUFFER-OFFSET + ; --> ( PC-DOS 1.x File and Record interface 01/01/84 ) ( for all file operations, status code = 0FFh if ) ( operation failed, zero if operation successful. ) ( fcb-addr --- status-code ) : >fdos SWAP ADDR>FDOS DROP 255 AND ; : OPEN-FILE 15 >fdos ; : CLOSE-FILE 16 >fdos ; : MAKE-FILE 22 >fdos ; : DELETE-FILE 19 >fdos ; : SEARCH-FILE 17 >fdos ; : NEXT-FILE 18 >fdos ; : RENAME-FILE 23 >fdos ; --> ( PC-DOS 1.x File and Record interface 01/01/84 ) ( for all record operations, status code = buffer address ) ( if operation successful, zero if operation failed. ) ( fcb-addr --- status-code ) : READ-SEQ DUP DUP SET-DMA 20 >fdos AND 0= IF BUFFER-OFFSET + ELSE DROP 0 THEN ; : WRITE-SEQ DUP DUP SET-DMA 21 >fdos AND 0= IF BUFFER-OFFSET + ELSE DROP 0 THEN ; ( fcb-addr record-number --- status-code ) : READ-RANDOM OVER 33 + W! DUP DUP SET-DMA 33 >fdos 0= IF BUFFER-OFFSET + ELSE DROP 0 THEN ; : WRITE-RANDOM OVER 33 + W! DUP DUP SET-DMA 34 >fdos 0= IF BUFFER-OFFSET + ELSE DROP 0 THEN ; --> ( PC-DOS 1.x File and Record interface 03/20/83 ) : PARSE-FILENM ( fcb-addr filename-addr --- ) SWAP DUP 37 ERASE 1 parse-filename ABORT" Illegal File Specification" ; --> ( PC-DOS 1.x File and Record interface 03/20/83 ) : (FILENAME) R@ S&O>ADDR COUNT 2+ R> + >R PARSE-FILENM ; : FILENAME ( fcb-addr --- ) STATE @ IF COMPILE (FILENAME) BL DUP WORD DUP C@ 2+ ALLOT COUNT + 1+ C! ELSE BL WORD 1+ PARSE-FILENM THEN ; IMMEDIATE : INPUT-FILENAME ( fcb-addr --- ) ." Enter file specification: " HERE 30 EXPECT HERE PARSE-FILENM ; ;S ( PC-DOS 2.0 File Interface for PC/FORTH+ 09/21/83 Copyright 1983 Ray Duncan, Laboratory Microsystems Inc. ) : CHECK-VERSION WSIZE 4 <> IF CR CR ." This file requires PC/FORTH+ version 2.00 or greater." CR CR 7 EMIT QUIT THEN ; CHECK-VERSION FORGET CHECK-VERSION CR CR .( Now loading PC-DOS 2.0 interface code.) CR HEX 080 CONSTANT SCRATCH_BUFF DECIMAL --> ( PC-DOS 2.0 File Interface ASCIIZ" 09/21/83 Compiling: stores the string preceded by 1-byte count and terminated by a zero byte. Executing: leaves addr of count byte on the stack. ) : (ASCIIZ") R@ S&O>ADDR DUP C@ 1+ R> + >R ; : ASCIIZ" ?COMP COMPILE (ASCIIZ") ASCII " WORD C@ 1+ DUP HERE C! ALLOT 0 C, ; IMMEDIATE --> ( PC-DOS 2.0 File Interface status codes 09/14/83 ) DECIMAL ( status --- ) : .STATUS BASE @ >R HEX CR CR ." Status = " DUP . ." H --- " CASE -1 OF ." end-of-file" ENDOF 0 OF ." successful call " ENDOF 1 OF ." invalid function number" ENDOF 2 OF ." file not found" ENDOF 3 OF ." path not found" ENDOF 4 OF ." no handles left" ENDOF 5 OF ." access denied" ENDOF 6 OF ." invalid handle " ENDOF 7 OF ." memory control blocks destroyed" ENDOF --> ( PC-DOS 2.0 File Interface status codes 09/14/83 ) 8 OF ." insufficient memory " ENDOF 9 OF ." invalid memory block address " ENDOF 10 OF ." invalid environment" ENDOF 11 OF ." invalid format" ENDOF 12 OF ." invalid access code" ENDOF 13 OF ." invalid data " ENDOF 15 OF ." invalid drive was specified" ENDOF 16 OF ." attempted to remove the current directory" ENDOF 17 OF ." not same device" ENDOF 18 OF ." no more files" ENDOF 100 OF ." disk full" ENDOF 101 OF ." file not open" ENDOF --> ( PC-DOS 2.0 File Interface status codes 09/14/83 ) ( otherwise ) ." unknown " ENDCASE R> BASE ! CR CR ." Stack contents:" CR .STACK ; --> ( PC-DOS 2.0 File Interface dump handle block 09/21/83 Display contents of Handle Control Block: handle_pars --- ) : .HCB BASE @ >R HEX CR DROP DUP CR ." Handle addr = " U. DUP W@ CR ." Handle = " U. DUP 2+ W@ CR ." Handle stat = " U. 4 + DUP 1+ SWAP C@ CR ." Filespec = " TYPE CR CR R> BASE ! ; ( display contents of directory control block: directory_par --- ) : .DCB COUNT TYPE ; --> ( PC-DOS 2.0 File Interface display attribute 09/21/83 ) HEX ( attrib --- ) : .ATTRIB BASE @ >R HEX DUP CR ." File attribute = " . ." : " DUP 01 AND IF ." read-only " THEN DUP 02 AND IF ." hidden " THEN DUP 04 AND IF ." system " THEN DUP 08 AND IF ." volume " THEN DUP 10 AND IF ." subdirectory " THEN DUP 20 AND IF ." archive " THEN CR DROP R> BASE ! ; --> system files IBMBIO.COM and IBMDOS.COM marked as 01+02+04 ( PC-DOS 2.0 File Interface Handle 09/21/83 build file handle compiling: HANDLE handle_block_name automatically sets file specification to NUL executing: --- pfa dos_handle if file open --- pfa 0 if file not open ) HEX : HANDLE CREATE 0 C, 0 C, 0 C, 0 C, ( handle, status ) HERE 40 ERASE ( zero out filespec area ) 03 C, ASCII N C, ASCII U C, ( length & ) ASCII L C, 0 C, ( NUL filename ) 03C ALLOT ( allow max filespec space) DOES> DUP W@ ; ( return address, handle ) --> ( PC-DOS 2.0 File Interface Directory 09/21/83 Build directory control block. compiling: DIRECTORY directory_block_name automatically sets path specification to \ executing: --- pfa for use by MKDIR, CHDIR, and RMDIR ) : DIRECTORY CREATE HERE 40 ERASE 1 C, ASCII \ C, 03E ALLOT DOES> ; DIRECTORY ROOT ( preallocate a DCB for the root directory ) --> ( PC-DOS 2.0 File Primitives Predefined Handles 09/21/83 ( store handle into HCB, set flags = file prev opened ) : handle-enable ( handle_pars handle --- ) SWAP DROP OVER W! 1 SWAP 2+ W! ; ( these standard handles are pre-defined by PC-DOS 2.0 and do not need to be opened before use. STD-INPUT and STD-OUTPUT can be redirected, the other three may not. ) HANDLE STD-INPUT STD-INPUT 0 handle-enable HANDLE STD-OUTPUT STD-OUTPUT 1 handle-enable HANDLE STD-ERROR STD-ERROR 2 handle-enable HANDLE STD-AUX STD-AUX 3 handle-enable HANDLE STD-LIST STD-LIST 4 handle-enable --> ( PC-DOS 2.0 File Interface MAKE-FILE 09/21/83 handle_par --- 0 if successful ___ <>0 if error status ) : MAKE-FILE DROP DUP 5 + ADDR>S&O make DUP 0< IF SWAP 0 OVER W! 0 SWAP 2+ W! NEGATE ELSE OVER W! 1 SWAP 2+ W! 0 THEN ; --> ( PC-DOS 2.0 File Interface OPEN-FILE 09/21/83 Open a file for read and write access. If the file carries the read-only attribute, this function will fail; use OPEN-FILE-R/O instead. handle_par --- 0 if successful ___ <>0 if error status ) : OPEN-FILE DROP DUP 5 + ADDR>S&O ( addr ) 2 ( access_type ) open DUP 0< IF SWAP 0 OVER W! 0 SWAP 2+ W! NEGATE ELSE OVER W! 1 SWAP 2+ W! 0 THEN ; --> ( PC-DOS 2.0 File Interface OPEN-FILE-R/O 09/21/83 Open a file for read access only. Any write function will fail regardless of the file's attribute. handle_par --- 0 if successful ___ <>0 if error status ) : OPEN-FILE-R/O DROP DUP 5 + ADDR>S&O ( addr ) 0 ( access_type ) open DUP 0< IF SWAP 0 OVER W! 0 SWAP 2+ W! NEGATE ELSE OVER W! 1 SWAP 2+ W! 0 THEN ; --> ( PC-DOS 2.0 File Interface CLOSE-FILE 09/21/83 handle_par --- 0 if successful ___ <>0 if error status ) : CLOSE-FILE close DUP 0< IF SWAP DROP NEGATE ELSE SWAP 0 OVER W! 0 SWAP 2+ W! DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface KILL-FILE 09/21/83 handle_par --- 0 if successful ___ <>0 if error status ) : KILL-FILE OVER 2+ W@ ( if file open, close it to release handle) IF 2DUP CLOSE-FILE DROP THEN DROP DUP 5 + ADDR>S&O delete DUP 0< IF SWAP DROP NEGATE ELSE SWAP 0 OVER W! 0 SWAP 2+ W! DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface GET-ATTRIB 09/21/83 handle_par --- Attrib ZERO if successful ___ <>0 if error status ) : GET-ATTRIB DROP 5 + ADDR>S&O 0 0 chmode DUP 0< IF NEGATE ( return error status) ELSE 0 THEN ; --> ( PC-DOS 2.0 File Interface SET-ATTRIB 09/21/83 handle_par attrib --- ZERO if successful --- <>0 if error status ) : SET-ATTRIB >R DROP 5 + ADDR>S&O R> 1 chmode DUP 0< IF NEGATE ( return error status) ELSE DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface READ 09/21/83 handle_par bytes buffer_addr --- bytes_read 0 success --- -1 EOF --- >0 error status) : READ ADDR>S&O read SWAP DROP DUP 0> IF 0 ELSE DUP 0= IF DROP -1 ELSE NEGATE THEN THEN ; --> ( PC-DOS 2.0 File Interface WRITE 09/21/83 handle_par bytes buffer_addr --- bytes_written 0 success --- >0 error stat.) : WRITE 1 PICK >R ( save copy of length) ADDR>S&O write SWAP DROP DUP 0< IF NEGATE R> DROP ELSE DUP R> <> IF DROP 100 ( if bytes written ) ELSE 0 ( don't match request) THEN ( disk must be full ) THEN ; --> ( PC-DOS 2.0 File Interface SEEK-ABS 09/21/83 move the file pointer to an absolute byte offset handle_par offset --- 0 success --- <>0 status ) : SEEK-ABS 0 SWAP ( method: absolute offset ) lseek DUP 0< IF NEGATE ELSE DROP 0 THEN SWAP DROP ; --> ( PC-DOS 2.0 File Interface SEEK-REL 09/21/83 move the file pointer to an offset relative to current loc. handle_par offset --- 0 success --- <>0 status ) : SEEK-REL 1 SWAP lseek DUP 0< IF NEGATE ELSE DROP 0 THEN SWAP DROP ; --> ( PC-DOS 2.0 File Interface SEEK-EOF 09/21/83 move the file pointer to an offset relative to EOF handle_par offset --- 0 success --- <>0 status ) : SEEK-EOF 2 SWAP lseek DUP 0< IF NEGATE ELSE DROP 0 THEN SWAP DROP ; --> ( PC-DOS 2.0 File Interface ?OFFSET 09/21/83 return the current absolute byte offset of file pointer handle_par --- offset ) : ?OFFSET SWAP DROP 1 0 lseek DUP 0< IF DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface ?FILESIZE 09/21/83 return the size of the file in bytes handle_par --- size ) : ?FILESIZE SWAP DROP 2 0 lseek DUP 0< IF DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface GET-DIR 09/21/83 Get the current directory for specified drive. ASCIIZ string is left in SCRATCH_BUFF. Drive code is integer 0-63; 0=default, 1=A, etc. Do not use this call between SEARCH-FIRST and SEARCH-NEXT. drive --- 0 success --- <>0 error status ) : GET-DIR getdir DUP 0< IF NEGATE ELSE DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface .DIR 09/21/83 display current directory for specified drive drive --- ) : .DIR getdir DROP 03F 0 DO I SAVE-BUFFERS + C@ ?DUP IF EMIT ELSE LEAVE THEN LOOP ; --> ( PC-DOS 2.0 File Interface .FILENAME 09/21/83 Display path/file specification in HCB handle_pars --- ) : .FILENAME DROP 4 + COUNT TYPE ; --> ( PC-DOS 2.0 File Interface SEARCH-FIRST 09/30/83 Search for the first file matching path/file specification. Returned parameters are placed in SCRATCH_BUFF. See page D-49 of PCDOS 2.0 Manual. handle_pars attrib --- 0 success --- <>0 error status ) : SEARCH-FIRST SWAP DROP SWAP 5 + ADDR>S&O SWAP find DUP 0< IF NEGATE ELSE DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface SEARCH-NEXT 09/21/83 Search for the next file matching path/file specification. Must be preceded by SEARCH-FIRST. Inputs to function are assumed to be in SCRATCH_BUFF, returned parameters are left at same location. This function takes no inputs from the stack! See page D-49 of PC-DOS 2.0 Manual. --- 0 success --- <>0 error status ) : SEARCH-NEXT next DUP 0< IF NEGATE ELSE DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface RENAME 09/21/83 Rename a file. Can be used to move files from one directory to another. Drive cannot be changed. handle1_pars handle2_pars --- 0 success --- <>0 ERROR status ) : RENAME-FILE DROP >R DROP 5 + ADDR>S&O R> 5 + ADDR>S&O rename DUP 0< IF NEGATE ELSE DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface INPUT-FILENAME 09/21/83 Read a file specification from the terminal into the handle control block. handle_pars --- ) : here-length 0 BEGIN DUP HERE + C@ WHILE 1+ REPEAT ; : INPUT-FILENAME DROP DUP >R ( save PFA ) 4 + 40 ERASE ( clear out old file specification ) HERE 03F EXPECT ( read console ) HERE R@ 5 + ( from, to addresses) here-length DUP R> 4 + C! ( store length ) CMOVE ; ( into handle block ) --> ( PC-DOS 2.0 File Interface FILENAME 09/21/83 ( runtime routine for FILENAME, compiled followed by a string literal inside a colon definition ) : filename DROP DUP 4 + 40 ERASE R@ S&O>ADDR C@ OVER 4 + C! 5 + R@ S&O>ADDR 1+ SWAP R@ S&O>ADDR C@ CMOVE R@ S&O>ADDR C@ 2+ R> + >R ; --> ( PC-DOS 2.0 File Interface FILENAME, cont. 09/21/83 If executing, move a file specification from the input stream into the designated handle control block. If compiling, save the file spec. as a string literal which is moved into the handle block at execution time. handle_pars --- ) : FILENAME STATE @ IF COMPILE filename BL DUP WORD DUP C@ 2+ ALLOT COUNT + 1+ C! ELSE DROP DUP 40 ERASE BL WORD C@ OVER 4 + C! HERE 1+ SWAP 5 + HERE C@ CMOVE THEN ; IMMEDIATE --> ( PC-DOS 2.0 File Interface MKDIR 09/21/83 Make a new subdirectory. directory_par --- status ) : MAKE-DIR 1+ ADDR>S&O mkdir DUP 0< IF NEGATE ELSE DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface CHDIR 09/21/83 Change the current subdirectory. directory_par --- status ) : CHANGE-DIR chdir DUP 0< IF NEGATE ELSE DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface RMDIR 09/21/83 Remove subdirectory. directory_par --- status ) : KILL-DIR 1+ ADDR>S&O rmdir DUP 0< IF NEGATE ELSE DROP 0 THEN ; --> ( PC-DOS 2.0 File Interface INPUT-DIRNAME 09/21/83 Read a file specification from the terminal into the handle control block. directory_par --- ) : INPUT-DIRNAME DUP >R ( save PFA ) 40 ERASE ( clear out old dir. specification ) HERE 03F EXPECT ( read console ) HERE R@ 1+ ( from, to addresses) here-length DUP R> C! ( store length ) CMOVE ; ( into dir. block ) --> ( PC-DOS 2.0 File Interface DIRNAME 09/21/83 runtime routine for DIRNAME, compiled followed by a string literal inside a colon definition ) : dirname DUP 40 ERASE R@ S&O>ADDR C@ OVER C! 1+ R@ S&O>ADDR 1+ SWAP R@ S&O>ADDR C@ CMOVE R@ S&O>ADDR C@ 2+ R> + >R ; --> ( PC-DOS 2.0 File Interface DIRNAME, cont. 09/21/83 If executing, move a dir. specification from the input stream into the designated dir. control block. If compiling, save the dir. spec. as a string literal which is moved into the directory block at execution time. directory_par --- ) : DIRNAME STATE @ IF COMPILE dirname BL DUP WORD DUP C@ 2+ ALLOT COUNT + 1+ C! ELSE DUP 40 ERASE BL WORD C@ OVER C! HERE 1+ SWAP 1+ HERE C@ CMOVE THEN ; IMMEDIATE --> ( PC-DOS 2.0 File Interface End of load 09/21/83 ) DECIMAL CR CR .( PC-DOS 2.0 interface compilation completed.) CR SP@ DP @ - U. .( bytes left in dictionary.) CR CR ;S ( Demo program to dump a file using DOS2.0 interface 09/15/83 ) FORTH DEFINITIONS DECIMAL VARIABLE DUMP-BASE : DUMP-BUFFER ( addr n --- ) OVER DUMP-BASE ! BASE @ >R HEX CR CR 5 SPACES 16 0 DO I 3 .R LOOP 2 SPACES 16 0 DO I 0 <# # #> TYPE LOOP CR OVER + SWAP DO CR I DUMP-BASE @ - 0 4 D.R SPACE I 16 + I 2DUP DO I C@ SPACE 0 <# # # #> TYPE LOOP 2 SPACES DO I C@ DUP 32 < OVER 126 > OR IF DROP 46 THEN EMIT LOOP 16 +LOOP CR R> BASE ! ; --> ( Demo program to dump a file using DOS2.0 interface 09/15/83 ) HANDLE FILE1 VARIABLE BUFFER 128 ALLOT -1 CONSTANT EOF VARIABLE RECORD : GET-FILENAME CR CR ." Enter Path and Filename: " FILE1 INPUT-FILENAME CR CR ; --> ( Demo program to dump a file using DOS2.0 interface 09/15/83 ) : OPEN-IT FILE1 OPEN-FILE IF CR ." Can't open file" CR QUIT THEN ; : CLOSE-IT FILE1 CLOSE-FILE DROP ; : READ-IT FILE1 128 BUFFER READ ; : DUMP-FILE DECIMAL GET-FILENAME OPEN-IT 0 RECORD ! CR CR ." Push any key to abort dump." CR CR BEGIN ?TERMINAL IF KEY DROP CR CR QUIT THEN READ-IT EOF <> WHILE DROP CR CR ." Record " RECORD @ . BUFFER 128 DUMP-BUFFER 1 RECORD +! REPEAT CR CR CLOSE-IT ; ;S ( Test standard input and output handles 09/16/83 ) ( note that a carriage return and line feed are appended to the input string and are included in the length returned by READ ) DECIMAL ( uses default buffer at 80 H for text I/O ) : TEST-IT CLEARSCREEN ." Test standard input/output handles." CR CR ." Enter max of 80 bytes of text, " ." followed by a carriage return." CR CR STD-INPUT 80 ( length ) 128 ( buffer ) READ DROP CR CR DUP . ." bytes were read from the standard input." CR CR ." Here is what you entered:" CR CR >R STD-OUTPUT R> ( length ) 128 ( buffer) WRITE CR CR DROP . ." bytes were written to the standard output." CR CR ; ( Convert screen file to standard text file 09/17/83 ) FORTH DEFINITIONS DECIMAL HANDLE IFILE ( input file ) HANDLE OFILE ( output file ) VARIABLE BUFFER 128 ALLOT 13 CONSTANT ASCII_CR 10 CONSTANT ASCII_LF -1 CONSTANT EOF --> ( Convert screen file to standard text file 09/17/83 ) ( --- ) : GET_FILE_NAMES BEGIN CR CR ." Enter name of source file: " IFILE INPUT-FILENAME CR ." Enter name of destination file: " OFILE INPUT-FILENAME CR CR ." Source file = " IFILE .FILENAME CR ." Destination file = " OFILE .FILENAME CR CR ." OK? " KEY DUP EMIT 32 OR ASCII y = UNTIL CR CR ; --> ( Convert screen file to standard text file 09/17/83 ) ( --- ) : OPEN_FILES IFILE OPEN-FILE IF CR ." Source file not found" CR QUIT THEN OFILE MAKE-FILE IF CR ." Can't make destination file" CR QUIT THEN ; ( --- ) : CLOSE_FILES IFILE CLOSE-FILE IF CR ." Error closing source file" CR THEN OFILE CLOSE-FILE IF CR ." Error closing destination file" CR THEN ; --> ( Convert screen file to standard text file 09/17/83 ) ( --- status ) : READ_FORTH_LINE IFILE 64 BUFFER READ ; ( --- length ) : FORTH_TO_TXT BUFFER 64 -TRAILING SWAP DROP ASCII_CR OVER BUFFER + C! 1+ ASCII_LF OVER BUFFER + C! 1+ ; --> ( Convert screen file to standard text file 09/17/83 ) ( length --- ) : WRITE_TXT_LINE >R OFILE R@ BUFFER WRITE IF CR ." Error writing destination file" CR QUIT THEN R> <> IF CR ." Destination media is full" CR QUIT THEN ; --> ( Convert screen file to standard text file 09/17/83 ) : CONVERT CLEARSCREEN ." Convert screen file to standard text file" GET_FILE_NAMES OPEN_FILES CR ." Processing..." BEGIN READ_FORTH_LINE EOF <> WHILE DROP FORTH_TO_TXT WRITE_TXT_LINE REPEAT CR CR IFILE ?FILESIZE CR ." Source file = " . ." bytes" OFILE ?FILESIZE CR ." Destination file = " . ." bytes" CLOSE_FILES CR CR ." Conversion completed." CR CR ; ( Illustration of creating & changing subdirectories 09/19/83 ) DIRECTORY SUB1 ( establish directory control block ) SUB1 DIRNAME \SUB1 ( insert subdirectory name ) HANDLE FILE1 ( establish handle control block ) FILE1 FILENAME QUACK.XYZ ( insert file name into HCB ) SUB1 MAKE-DIR .STATUS ( create subdirectory ) SUB1 CHANGE-DIR .STATUS ( change current directory to SUB1 ) FILE1 MAKE-FILE .STATUS ( create a file in sub1 ) ROOT CHANGE-DIR .STATUS ( change current directory to \ )
