<< Home | About Forth | About TurboForth | Download | Language Reference | Resources | Tutorials | YouTube >>
; ______ _ _ _____ ______ ; | ____(_) | |_ _| / / __ \ ; | |__ _| | ___ | | / / | | | ; | __| | | |/ _ \ | | / /| | | | ; | | | | | __/ _| |_ / / | |__| | ; |_| |_|_|\___| |_____/_/ \____/ ; File IO implementation ; FILE ( s-addr s-len buf-addr -- ) ; Builds a PAB in the buffer whose address is passed as buf_addr using the data ; in the string represented by s_addr and s_len. ; For example: ; FBUF: PRINTER ; S" PIO.CR DV80O" PRINTER FILE ; The above builds a PAB in the buffer called PRINTER which references the PIO ; device. Subsequent file IO words that wish to send data to the PIO shall use ; the buffer name to reference it: ; e.g. ; PRINTER #OPEN DROP ( open PIO and drop success/fail flag) ; S" HELLO WORLD" PRINTER #PUT DROP ; ( write HELLO WORLD to the PIO and drop success/fail flag) ; ; Internally, FILE builds a PAB in the buffer which will be used by #OPEN and ; all file IO words. ; Word 0 of the reserved memory is used to point to the actual PAB in VDP ; memory. Enough space should be reserved (with ALLOT) in the buffer to hold the ; PAB and the filename. ; ; The string which specifies the file name and file characteristics is defined ; as below. ; The filename *must* come first followed by a space character. After that, the ; file options can be specified in any order. ; ; File Options: ; F=Fixed - Fixed record type ; V=Variable - Variable record type ; ; D=Display - Display data type ; L=InternaL - Internal data type ; ; U=Update - Update file mode ; O=Output - Output file mode ; I=Input - Inoput file mode ; A=Append - Append file mode ; ; S=Sequential - Sequential file type ; R=Relative - Relative file type ; ; Note that Internal type files require L ; this is because I is used to specify INPUT _file clr r8 ; zero the record length accumulator mov *stack+,r10 ; pop buffer address from stack ; zero the first 10 bytes of the alloted buffer ; (holds the PAB data - no need to zero the filename length byte or the ; file, as they'll be populated later) mov r10,r13 ; copy buffer address li r1,10 ; number of bytes to clear _ficll clr *r13+ ; clear two bytes in buffer dect r1 ; decrement counter jne _ficll ; repeat if not finished ; transfer filename to PAB... clr r6 ; byte ops mov @2(stack),r0 ; address of string in pad mov r10,r1 ; copy buffer address ai r1,12 ; point to 1st filename byte clr r2 ; filename length tfnl movb *r0+,r6 ; get a character dec *stack ; decrement string length ci r6,' '*256 ; space? jeq wfnlb ; jump if yes movb r6,*r1+ ; otherwise copy the byte inc r2 ; increment length count jmp tfnl ; and repeat ; write filename length byte... wfnlb swpb r2 ; get length in high byte movb r2,@11(r10) ; move length byte into length byte position ; process file options... fdochr movb *r0+,r6 ; get a character dec *stack ; end of string? jlt fdone ; jump if yes ci r6,' '*256 ; is it a space? jeq fdochr ; if yes then ignore it ci r6,'9'*256 ; found a digit? jle fdodig ; if so then do digit ; the option is a character. ; process it against the allowed list of characters li r7,foopts ; pointer to options list li r13,10 ; 10 options in the list fnxtop cb r6,*r7 ; compare a character jeq ffopt ; jump if match detected inc r7 ; move to next charater in list dec r13 ; decrement count jne fnxtop ; check next option jmp fdochr ; check next character ; process numeric digit fdodig mov r8,r9 ; copy accumulator sla r8,3 ; multiply accumulator by 8 sla r9,1 ; multiply copy by 2 a r9,r8 ; add them - we just did a multiply by 10 ; (MPY needs consecutive registers, and sometimes its just too much ; like hard work, know what I mean?) srl r6,8 ; shift byte into low byte ai r6,-48 ; remove ascii offset a r6,r8 ; add to accumulator clr r6 ; byte ops jmp fdochr ; process next character ; set file option... ffopt ai r7,-20 ; point to appropriate mask byte (the bits ; to reset) movb @3(r10),r1 ; get flag byte from PAB szcb *r7,r1 ; reset appropriate bit(s) ai r7,10 ; point to bits table (the bits to set) socb *r7,r1 ; set appropriate bit(s) movb r1,@3(r10) ; write it back ai r7,10 ; restore pointer jmp fdochr ; process next character in the string fdone swpb r8 ; get record length in msb movb r8,@6(r10) ; move it into the pab ; dect stack ; pop length ; dect stack ; pop address c *stack+,*stack+ ; pop length & address jmp fexit fomask byte >10,>10 ; F & V mask byte >08,>08 ; D & I mask byte >06,>06,>06,>06 ; U O I & A masks byte >01,>01 ; S & R masks bitmsk byte >00,>10 ; F & V bits byte >00,>08 ; D & I bits byte >00,>02,>04,>06 ; U O I & A bits byte >00,>01 ; S & R bits foopts text 'FVDLUOIASR' ; file options (L=internaL) ; #OPEN ( file_addr -- t|f ) ; Opens a file with the file name and attributes specified in the buffer ; starting at file_addr. ; The buffer (actually a PAB) is set-up with FILE. ; E.g. FBUF: SERIAL ; S" RS232.BA=9600 DV80SO" SERIAL FILE ; SERIAL #OPEN ; The above shall attempt to open the serial port for output as a Display ; Variable 80 type file. ; ; #OPEN leaves a FALSE on the stack if the file was opened sucessfully. ; If the file could not be opened then it leaves a TRUE on the stack. ; This allows easy trapping with ABORT" as shown below: ; SERIAL #OPEN ABORT" Could not open serial port" ; ; In the event of a file error, IOERR can be read to get the DSR error code. ; If IOERR returns -1 (>FFFF) then this means that no free file IO slots were ; found. A maximum of 3 open files is supported (2 if block files are also to ; be used). Note that block files are immediately closed after they are accessed ; for either reading or writing, so 3 generic file io streams are available ; when no blocks files are being used. ; find a free file slot... _fopen li r0,falloc ; address of file allocation table li r2,3 ; three slots nxtslt mov *r0,r1 ; first slot address jgt foend ; if msb is not set then the slot is empty inct r0 ; otherwise move to next slot address dec r2 ; and try it jne nxtslt ; no free slots... sorry, no can do... seto @errnum ; set ioerr to -1 (no available files) seto *stack ; leave a TRUE on the stack b @retB0 ; ok, the slot is free... foend mov *stack,r10 ; cpu pab address mov r1,*r10 ; store vdp address of the free PAB in word ; 0 of CPU RAM PAB mov r1,r2 ; copy the vdp address ori r2,>8000 ; set its most-sig bit to indicate this slot ; is in use mov r2,*r0 ; write it back falloc table ai r1,40 ; record buffer in vdp is 40 bytes after PAB mov r1,@4(r10) ; store it in bytes 2 & 3 of the PAB ai r1,-40 ; restore r1 to point to PAB address in VDP ; transfer the PAB in CPU RAM to the appropriate place in VDP mov r1,r0 ; get in r0 for VMBW mov r0,r8 ; keep a copy mov r10,r1 ; source address inct r1 ; move past word 0 in CPU PAB (vdp address ; pointer) li r2,40 ; byte count bl @_vmbw0 ; write it to VDP ai r8,9 ; adjust vdp address copy to point to ; filename length byte mov r8,@namptr ; store in >8356 as per DSR requirements blwp @dsrlnk ; call dos data 8 ; disk op parameter, level 3 command jeq _foerr ; jump if an error clr *stack ; set top of stack to FALSE (success) clr @errnum ; clear io error jmp fexit ; the file could not be opened _foerr srl r0,8 ; move error code to lower byte mov r0,@errnum ; set disk io error number seto *stack ; set true flag (failure) jmp fexit ; #CLOSE ( fid -- ) ; closes a file ; Where a file is opened thus: S" DSK1.README DV80IS" #OPEN MYFILE ; the following will close the same file: MYFILE #CLOSE _fclos bl @dodcmd data close*256 ; now reset the pab pointer in the file allocation table... ; r13 holds the vdp address of the start of the pab li r1,falloc ; address of file allocation table li r2,3 ; 3 entries in the table _fclop mov *r1,r6 ; get an entry andi r6,>7fff ; remove msb c r6,r13 ; found the entry? jeq _fcfnd ; jump if yes inct r1 ; try next word dec r2 ; decrement counter jne _fclop ; repeat if not finished _fcxit jmp fexit _fcfnd mov r13,*r1 ; move address (with msb reset) back into ; file allocation table jmp _fcxit ; #GET ( buff_addr fid -- t|f ) ; reads a line of input from the file specified by fid. ; The address of an appropriately sized buffer must be supplied. ; If the read is successful, the buffer is filled with the data read from the ; input device, with the first cell being the length count of the data ; immediately following it. ; This can be converted into a address/length pair with COUNT. ; Returns: ; False if successful ; True if not successful ; This allows trapping with ABORT" as follows: ; MYFILE #GET ABORT" Could not read from the file" ; If the read fails, IOERR is set to the error code, otherwise it is zero'd _fget bl @dodcmd ; read from disk