********************************
* Start Qforth file system
********************************
 
*
* Word "fcreate" - creates file or directory
*
 
WORD99 ASC 'fcreate '
 DW FCREATE
 
FCREATE LDA #07 ; 7 parameters
 STA WPARMS
 
 STZ WPARMS+$0B ; Set up creation time
 STZ WPARMS+$0A
 
 STZ WPARMS+9 ; Set up creation date
 STZ WPARMS+8
 
 LDA #01 ; Storage type (seedling file)
 STA WPARMS+7
 
 JSR POPDATA ; Set up auxiliary filetype
 STY WPARMS+5
 STX WPARMS+6
 
 JSR POPDATA ; Set up filetype
 STY WPARMS+4
 
 LDA #$C3 ; Set up access privileges for file
 STA WPARMS+3
 
 JSR POPDATA ; Set up address of pathname
 STY PNTR
 STX PNTR+1
 
 LDA #FILENM3
 STA WPARMS+1
 STA PNTR2
 LDA #/FILENM3
 STA WPARMS+2
 STA PNTR2+1
 
 JSR CONVFNAM ; Convert filename to ProDOS format
 
 JSR MLI
 DFB $C0 ; Create code
 DW WPARMS
; Execution falls through into HANDLERR
*
* Handle ProDOS errors
*
 
HANDLERR BCS :ERR
 LDY #00 ; No error - push 0 on stack
 LDX #00
 JMP PUSHDATA
 
:ERR TAY ; Error, so push error # on stack
 LDX #00
 JMP PUSHDATA
 
*
* Convert filename to ProDOS format
*
 
CONVFNAM LDY #00 ; Convert filename to ProDOS format
:LOOP LDA (PNTR),Y
 BEQ :FINIS
 INY
 STA (PNTR2),Y
 BRA :LOOP
 
:FINIS TYA ; Set up length byte of filename
 STA (PNTR2)
 RTS
 
*
* Table of filename buffers
*
 
FNAMTBLL DFB #FILENM0,#FILENM1,#FILENM2
FNAMTBLH DFB #/FILENM0,#/FILENM1,#/FILENM2
 
*
* Table of file buffers
*
 
FBUFTBLL DFB #FILEBUF0,#FILEBUF1,#FILEBUF2
FBUFTBLH DFB #/FILEBUF0,#FILEBUF1,#FILEBUF2
 
*
* Table of reference #s
*
 
CFILE DS 1
 
FREFTBL DS 3
 
*
* MLI parameter storage area
*
 
WPARMS DS 20 ; MLI parameters used by words
 
*
* Word "fdestroy" - destory file or directory
*
 
WORD100 ASC 'fdestroy '
 DW FDESTROY
 
FDESTROY LDA #01 ; Only one parameter
 STA WPARMS
 
 JSR POPDATA ; Set up address of pathname
 STY PNTR
 STX PNTR+1
 
 LDA #FILENM3
 STA WPARMS+1
 STA PNTR2
 LDA #/FILENM3
 STA WPARMS+2
 STA PNTR2+1
 
 JSR CONVFNAM ; Convert filename to ProDOS format
 
 JSR MLI ; Call MLI
 DFB $C1 ; Destroy code
 DW WPARMS
 
 JMP HANDLERR ; Handle error, if any
 
*
* Word "fstat" - find out various things about file
*
 
WORD101 ASC 'fstat '
 DW FSTAT
 
FSTAT LDA #10 ; Ten parameters
 STA WPARMS
 
 JSR POPDATA ; Get address of pathname
 STY WPARMS+1
 STX WPARMS+2
 
 JSR MLI ; Call MLI with GET_FILE_INFO
 DFB $C4
 DW WPARMS
 
 PHP
 PHA
 
 LDY WPARMS+4 ; Push filetype
 LDX #00
 JSR PUSHDATA
 
 LDY WPARMS+5 ; Push auxiliary filetype
 LDX WPARMS+6
 JSR PUSHDATA
 
 LDY WPARMS+8 ; Disk blocks used
 LDX WPARMS+9
 JSR PUSHDATA
 
 PLA
 PLP
 JMP HANDLERR
 
*
* Word "fopen" - open a file
*
 
WORD102 ASC 'fopen '
 DW FOPEN
 
FOPEN LDA #03 ; Three parameters
 STA WPARMS
 
 JSR POPDATA ; Set up address of pathname
 STY PNTR
 STX PNTR+1
 
 JSR POPDATA ; Set up filename buffer
 STY CFILE
 LDA FNAMTBLL,Y
 STA WPARMS+1
 STA PNTR2
 LDA FNAMTBLH,Y
 STA WPARMS+2
 STA PNTR2+1
 
 LDA FBUFTBLL,Y ; Set up address of file buffer
 STA WPARMS+3
 LDA FBUFTBLH,Y
 STA WPARMS+4
 
 JSR CONVFNAM ; Convert filename
 
 JSR MLI ; Call MLI
 DFB $C8 ; Open code
 DW WPARMS
 
 PHP
 PHA
 
 LDA WPARMS+5 ; Store reference # for future use
 LDY CFILE
 STA FREFTBL,Y
 
 PLA
 PLP
 
 JMP HANDLERR ; Handle error, if any
 
*
* Word "fposition" - set current file marker position
*
 
WORD103 ASC 'fposition '
 DW FPOSIT
 
FPOSIT LDA #02 ; Two parameters
 STA WPARMS
 
 JSR POPDATA ; Set up file position
 STY WPARMS+2
 STX WPARMS+3
 
 JSR POPDATA
 STY WPARMS+4
 
 JSR POPDATA ; Set up reference number
 LDA FREFTBL,Y
 STA WPARMS+1
 
 JSR MLI
 DFB $CE ; Set_Mark call
 DW WPARMS
 
 JMP HANDLERR ; Handle error, if any
 
*
* Word "fread" - read a file
*
 
WORD104 ASC 'fread '
 DW FREAD
 
FREAD LDA #04 ; Four parameters
 STA WPARMS
 
 JSR POPDATA ; Set up requested length
 STY WPARMS+4
 STX WPARMS+5
 
 JSR POPDATA ; Set up address of data buffer
 STY WPARMS+2
 STX WPARMS+3
 
 JSR POPDATA ; Set up reference number
 LDA FREFTBL,Y
 STA WPARMS+1
 
 JSR MLI ; Call MLI
 DFB $CA ; Read code
 DW WPARMS
 
 PHP
 PHA
 
 LDY WPARMS+6 ; Return actual read length
 LDX WPARMS+7
 JSR PUSHDATA
 
 PLA
 PLP
 
 JMP HANDLERR ; Handle error, if any
 
*
* Word "fwrite" - write a file
*
 
WORD105 ASC 'fwrite '
 DW FWRITE
 
FWRITE LDA #04 ; Four parameters
 STA WPARMS
 
 JSR POPDATA ; Set up requested length
 STY WPARMS+4
 STX WPARMS+5
 
 JSR POPDATA ; Set up address of data buffer
 STY WPARMS+2
 STX WPARMS+3
 
 JSR POPDATA ; Set up reference number
 LDA FREFTBL,Y
 STA WPARMS+1
 
 JSR MLI ; Call MLI
 DFB $CB ; Write code
 DW WPARMS
 
 PHP
 PHA
 
 LDY WPARMS+6 ; Return actual write length
 LDX WPARMS+7
 JSR PUSHDATA
 
 PLA
 PLP
 
 JMP HANDLERR ; Handle error, if any
 
*
* Word "fclose" - close file
*
 
WORD106 ASC 'fclose '
 DW FCLOSE
 
FCLOSE LDA #01 ; One parameter
 STA WPARMS
 
 JSR POPDATA ; Set up reference number
 LDA FREFTBL,Y
 STA WPARMS+1
 
 JSR MLI ; Call MLI
 DFB $CC ; Close code
 DW WPARMS
 
 JMP HANDLERR ; Handle error, if any
 
********************************
* End Qforth file system
********************************
