NEW AUTO 3,1 *-------------------------------------- XDOS.Close ldy #$01 close all ? lda (A3L),y bne XDOS.CloseOne no, just one of them. sta cferr clear global close error. * lda #$00 start at the beginning. L4654 sta fcbptr save current low byte of pointer. tax get the level at which the file lda FCBs+FCB.FLEVEL,x was opened. cmp flevel if file's level is < global level bcc L4675 then don't close. lda FCBs+FCB.ID,x is this reference file open ? beq L4675 no, try next. jsr flush2 clean it out... bcs L46B6 return flush errors. jsr close2 update fcb & vcb ldy #$01 lda (A3L),y beq L4675 no error if close all. bcs L46B6 close error. L4675 lda fcbptr inc pointer to next fcb clc adc #FCB bcc L4654 branch if within same page. lda cferr on final close report logged errors. beq L46B4 branch if errors. rts (carry already set). *-------------------------------------- XDOS.CloseOne jsr flush1 flush file 1st (including updating bitmap) * bcs L46B6 branch if errors. bcc close2 php pha jsr close2 pla plp rts close2 ldx fcbptr lda FCBs+FCB.BUFID,x release file buffer jsr relbuffr bcs L46B6 jsr XDOS.FCBDevIDSelect stz FCBs,x free fcb too jsr XDOS.FindVCBForDevNum get vcb pointer. dec VCBs+VCB.OFCNT,x indicate one less file open. L46B4 clc rts L46B6 bcs L46E6 don't report close all error now. *-------------------------------------- XDOS.Flush ldy #$01 flush all ? lda (A3L),y bne flush1 no, just one of them. sta cferr clear global flush error. * lda #$00 start at the beginning. L46C3 sta fcbptr save current low byte of pointer. tax index to ref #. lda FCBs,x is this reference file open ? beq L46D1 no, try next. jsr flush2 clean it out... bcs L46E6 return anty errors. L46D1 lda fcbptr inc pointer to next fcb. clc adc #FCB bcc L46C3 branch if within same page L46D9 clc lda cferr on last flush, beq L46E0 branch if no logged errors. sec report error now L46E0 rts *-------------------------------------- flush2 jsr XDOS.GetFCBBufX must set up vcb & buffer locations 1st. bcc L46F1 branch if no error. L46E6 jmp glberr error so check for close or flush all. flush1 stz cferr for normal refnum flush, clear global error. jsr XDOS.GetFCB setup pointer to fcb user references. bcs L46E6 return any errors. L46F1 lda FCBs+FCB.ACCESS,x test to see if file is modified. and #$02 is it write enabled ? beq L46D9 branch if 'read only' lda FCBs+FCB.DIRTY,x has eof been modified ? bmi L4704 if yes. jsr XDOS.GetFCBStatus has data been modified ? and #$70 (was written to while it's been open?) beq L46D9 if not. L4704 jsr XDOS.GetFCBStatus and #$40 does current data buffer need to be beq L4710 written ? branch if not. jsr wfcbdat if so, go write it. bcs L46E6 if error. L4710 jsr XDOS.GetFCBStatus check to see if the index block (tree and #$80 files only) needs to be written. beq L471C branch if not. jsr wfcbidx bcs L46E6 return any errors. L471C ldy #0 jsr XDOS.FCBDevIDSelect X = FCBPtr L4723 lda FCBs+FCB.DEVID,x note: this code depends on the defined sta d_dev,y order of the file control block and the inx temporary directory area in 'work space' iny cpy #6 bne L4723 lda d_head read the directory header for this file ldx d_head+1 .DO LOWERCASE=1 jsr XDOS.ReadGBufAXDir .ELSE jsr XDOS.ReadGBufAX read DIR into the general purpose buffer. .FIN bcs L46E6 if error. jsr movhed0 move header info. lda d_entblk get address of directory block that ldx d_entblk+1 contains the file entry. cmp d_head test to see if it's the same block the bne .1 header is in. branch if not. cpx d_head+1 beq L4755 branch if header block = entry block .1 .DO LOWERCASE=1 jsr XDOS.ReadGBufAXDir .ELSE jsr XDOS.ReadGBufAX read DIR block with file entry in general buffer. .FIN L4755 jsr entcalc set up pointer to entry. jsr moventry move entry to temp entry buffer in ldx fcbptr 'work space'. update 'blocks used' count lda FCBs+FCB.UBLK,x sta d_usage lda FCBs+FCB.UBLK+1,x sta d_usage+1 ldy #0 and move in end of file mark whether L476C lda FCBs+FCB.EOF,x needed or not. sta d_eof,y iny cpy #$03 move all 3 bytes beq L4780 lda FCBs+FCB.1stBLK,x also move in the address of the file's sta d_filid,y first block since it might have changed inx since the file first opened. bne L476C branch always. L4780 ldx fcbptr lda FCBs+FCB.STYPE,x the last thing to update is storage asl type (y=fcbptr+2). shift into high asl nibble. asl asl sta scrtch lda d_stor get old type byte (might be the same). and #$0F strip off old type, ora scrtch add in the new type sta d_stor and put it away. jsr drevise go update directory. bcs glberr error. ldx fcbptr mark stz FCBs+FCB.DIRTY,x fcb/directory as undirty. lda d_dev see if bitmap should be written. cmp bmadev is it in same as current file ? bne L47B2 yes, put it on the disk if necessary. jsr upbmap go put it away. bcs glberr flush error L47B2 clc rts *-------------------------------------- * report error only if not a close all or flush all *-------------------------------------- glberr ldy #$01 pha lda (A3L),y bne L47C1 not an 'all' so report now clc pla sta cferr save for later rts L47C1 pla rts *-------------------------------------- XDOS.FCBDevIDSelect ldx fcbptr lda FCBs+FCB.DEVID,x sta DEVNUM rts *-------------------------------------- XDOS.SetFCBSType lsr lsr lsr lsr ldy fcbptr and save it in fcb. sta FCBs+FCB.STYPE,y rts *-------------------------------------- XDOS.ClrFCBStatus ldy fcbptr clear allocation states for data block lda FCBs+FCB.F,y and both levels of indexes/ and #$F8 sta FCBs+FCB.F,y indicates that either they exist now rts or unnecessary for current position. *-------------------------------------- XDOS.GetFCBStatus ldx fcbptr index to fcb. lda FCBs+FCB.F,x return status byte. rts *-------------------------------------- XDOS.SetFCBStatus ldx fcbptr ora FCBs+FCB.F,x sta FCBs+FCB.F,x rts *-------------------------------------- L47CA lda #MLI.E.LOCKED access error sec L47CD rts *-------------------------------------- XDOS.SetEOF jsr gfcbstyp can only move end of tree, sapling or seed. cmp #$04 tree type ? bcs L47CA if not then access error asl asl asl asl sta stortyp may be used later. lda FCBs+FCB.ACCESS,y and #$02 is write enabled to set new eof ? beq L47CA no, access error. jsr tstwprot hardware write protected ? bcs L47CA yes, access error. ldy fcbptr save old eof so it can be seen iny whether blocks need to be released iny upon contraction. ldx #$02 all 3 bytes of the eof L47EF lda FCBs+FCB.EOF,y sta oldeof,x dey dex bpl L47EF ldy #$04 ldx #$02 L47FD lda (A3L),y position mark to new eof sta tposll,x dey dex bpl L47FD ldx #$02 point to 3rd byte. L4808 lda oldeof,x see if eof moved backwards so blocks cmp tposll,x can be released. bcc eofset (branch if not) bne purge branch if blocks to be released dex bpl L4808 all 3 bytes eofset ldy #$04 ldx fcbptr place new end of file into fcb inx inx L481C lda (A3L),y sta FCBs+FCB.EOF,x dex dey cpy #$02 all 3 bytes moved ? bcs L481C no. jmp fcbused mark fcb as dirty. purge jsr flush1 make sure file is current bcs L47CD ldx datptr+1 pointer to index block inx inx stx zpt+1 (zero page conflict with dir buf ptr) ldx datptr stx zpt ldy fcbptr check if eof < mark iny iny ldx #$02 L4840 lda FCBs+FCB.MARK,y cmp tposll,x compare until not equal or carry clear. bcc L485F branch if eof > mark. bne L484E branch if eof < mark. dey dex bpl L4840 compare all 3 bytes L484E ldy fcbptr ldx #$00 L4853 lda tposll,x fake position, correct position will sta FCBs+FCB.MARK,y be made below... iny inx cpx #$03 move all 3 bytes bne L4853 L485F jsr tkfrecnt force free block count before releasing lda tposll blocks. prepare for purge of excess... sta dseed all blocks and bytes beyond new eof lda tposlh must be zero'd sta dsap and #$01 sta dseed+1 lda tposhi lsr sta dtree ror dsap pass position in terms of block & bytes. lda dseed now adjust for boundaries of $200 ora dseed+1 bne L48A2 branch if no adjustment necessary. lda dsap get correct block positions for sap sec and tree levels. sbc #$01 sta dsap deallocate for last (phantom) block lda #$02 and don't modify last data block. bcs L489F branch if tree level unaffected. dec dtree bpl L489F branch if new eof not zero lda #$00 sta dtree otherwise, make a null seed out of it. sta dsap L489F sta dseed+1 L48A2 ldy fcbptr also must pass file's 1st block address. lda FCBs+FCB.1stBLK,y sta firstbl lda FCBs+FCB.1stBLK+1,y sta firstbh stz deblock lastly, initialize # of blocks to stz deblock+1 be free'd. jsr detree deallocate blocks from tree. php save any error status until fcb pha is cleaned up. sec ldy fcbptr ldx #$00 L48C2 lda firstbl,x sta FCBs+FCB.1stBLK,y move in possible new first file block lda FCBs+FCB.UBLK,y address. adjust usage count also sbc deblock,x sta FCBs+FCB.UBLK,y iny inx txa and #$01 test for both bytes adjusted bne L48C2 without disturbing carry. lda stortyp get possibly modified storage type jsr XDOS.SetFCBSType jsr XDOS.ClrFCBStatus make it look as though position has jsr dvcbrev nothing allocated, update total blocks ldy fcbptr in fcb and correct position. iny iny ldx #$02 L48F2 lda FCBs+FCB.MARK,y tell 'rdposn' to go to correct sta tposll,x eor #$80 position from incorrect place. sta FCBs+FCB.MARK,y dey dex bpl L48F2 jsr rdposn go to correct position. bcc L490D if no error. tax otherwise, report latest error. pla plp txa restore latest error code to stack sec php pha save new error. * mark file as in need of a flush and update fcb with new end of file, * then flush it. L490D jsr eofset go mark and update jsr flush1 then go do the flush. bcc L491C branch if no error. tax save latest error. pla clean previous error off stack plp txa and restore latest error to stack. sec show error condition. php restore error status to stack pha and the error code. L491C pla report any errors that may have plp appeared. rts *-------------------------------------- XDOS.GetEOF ldx fcbptr index to end of file mark ldy #$02 and index to user's call parameters L4924 lda FCBs+FCB.EOF,x sta (A3L),y inx iny cpy #$05 bne L4924 loop until all 3 bytes moved clc no errors rts *-------------------------------------- XDOS.NewLine ldy #$02 adjust newline status for open file. lda (A3L),y on or off ? ldx fcbptr it will be 0 if off. sta FCBs+FCB.NLMASK,x set new line mask iny lda (A3L),y and move in 'new-line' byte sta FCBs+FCB.NLBYTE,x clc no error possible rts *-------------------------------------- XDOS.GetFileInfo jsr XDOS.FindFile look for file. bcc .1 no error. jsr XDOS.GetFileInfoVol bcs .9 .1 lda d_stor transfer bytes from internal order to lsr call spec via 'inftabl' translation lsr table but first change storage type to lsr external (low nibble) format. lsr sta d_stor ldy #$11 index to last of user's spec table. .2 lda inftabl-3,y and #$7F strip bit used by setinfo tax lda d_stor,x move directory info to call spec. table sta (A3L),y dey cpy #$03 bcs .2 if all info bytes moved, retn carry clr * clc .9 rts *-------------------------------------- XDOS.SetFileInfo jsr XDOS.FindFile get the file to work on. bcs L49CF if error. lda bubit see if backup bit can be cleared eor #$20 and d_attr and #$20 sta bkbitflg or preserve current... ldy #$0D init pointer to user supplied list. L49B9 ldx inftabl-3,y get index to corresponding 'd.' table. bmi L49C3 branch if parameter can't be set. lda (A3L),y sta d_stor,x L49C3 dey has user's request been satisfied ? cpy #$03 bcs L49B9 no, move next byte. and #$18 make sure no illegal access bits were beq L49D0 set !! branch if legal access. lda #MLI.E.LOCKED otherwise, access error. sec L49CF rts L49D0 ldy #$0B lda (A3L),y was clock null input ? bne XDOS.SetFileInfoEx.8 jmp drevise update with clock also... *-------------------------------------- XDOS.SetFileInfoEx jsr XDOS.FindFile bcs XDOS.GetFileInfoEx.RTS ldx #S.FIEX.BLKPTR+2-1 ldy #S.FIEX.BLKPTR+2-1+3 .2 lda (A3L),y sta d_stor,x dey dex bpl .2 XDOS.SetFileInfoEx.8 jmp drevise1 *-------------------------------------- XDOS.GetFileInfoEx jsr XDOS.FindFile bcc .1 jsr XDOS.GetFileInfoVol bcs .9 .1 ldx #S.FIEX.BLKPTR+2-1 ldy #S.FIEX.BLKPTR+2-1+3 .2 lda d_stor,x sta (A3L),y dey dex bpl .2 ldx #7 ldy #S.FIEX.ACL+7+3 .3 lda h_acl,x sta (A3L),y dey dex bpl .3 * clc .9 XDOS.GetFileInfoEx.RTS rts *-------------------------------------- XDOS.GetFileInfoVol cmp #MLI.E.INVPATH was it a root directory file ? sec (in case of no match) bne .9 if not, then error. lda #$F0 sta d_stor for get info, report proper storage type stz reql force a count of free blocks. stz reqh ldx vcbptr jsr tkfrecnt get a fresh count of free blocks on ldx vcbptr this volume. lda VCBs+VCB.FBLK+1,x return total blocks and total in use. sta reqh 1st transfer 'free' blocks to zpage lda VCBs+VCB.FBLK,x for later subtraction to determine sta reql the 'used' count. lda VCBs+VCB.TBLK+1,x transfer to 'd.' table as aux id sta d_auxid+1 (total block count is considered aux id pha for the volume) lda VCBs+VCB.TBLK,x sta d_auxid sec subtract and report the number of sbc reql blocks 'in use' sta d_usage pla sbc reqh sta d_usage+1 clc .9 rts *-------------------------------------- XDOS.ACL jsr XDOS.FindDirOrVol bcs .9 jsr XDOS.ReadGBuf_d_frst bcs .9 ldx #7 ldy #S.FIEX.ACL+3 lda (A3L),y beq .2 ldy #S.FIEX.ACL+7+3 .1 lda (A3L),y sta gbuf+$14,x dey dex bpl .1 .DO LOWERCASE=1 jmp XDOS.WriteGBufDir .ELSE jmp XDOS.WriteGBuf .FIN .2 ldy #S.FIEX.ACL+7+3 .3 lda gbuf+$14,x sta (A3L),y dey dex bpl .3 * clc .9 rts *-------------------------------------- XDOS.Rename jsr XDOS.CheckPath look for source (original) file. bcc XDOS.RenameFileDir if found. cmp #$40 trying to rename a volume ? bne L49FD no, return error. XDOS.RenameVol jsr XDOS.GetRenPath syntax new name. bcs L49FD rename error. ldy pathbuf find out if only rootname for new name iny lda pathbuf,y must be $FF if volume name only. bne L4A72 if not single name ldx vcbptr check for open files before changing. lda VCBs+VCB.OFCNT,x beq L49FF if volume not busy. lda #MLI.E.OPEN file busy error. L49FD sec rts L49FF ldy #0 get newname's length lda pathbuf,y ora #$F0 (root file storage type) jsr XDOS.UpdateHdr update root directory. bcs .9 rename error. ldy #$00 ldx vcbptr update vcb also. .1 lda pathbuf,y move new name to vcb. beq .8 sta VCBs,x iny next character inx bra .1 .8 * clc no errors .9 rts *-------------------------------------- XDOS.RenameFileDir jsr getnamptr set y = 1st char of path, x = 0. L4A21 lda pathbuf,y move original name to gbuf sta gbuf,x for later comparison to new name. bmi L4A2D if last character has been moved iny otherwise, get the next one. inx bra L4A21 L4A2D jsr XDOS.GetRenPath get new name syntaxed. bcs L4A74 rename error. jsr getnamptr set y = path, x = 0. lda pathbuf,y now compare new name with old name L4A38 cmp gbuf,x to make sure they are in the same dir. php save result of comparison. and #$F0 was last char really a count ? bne L4A46 if not. sty rnptr save pointer to next name, it might stx namptr be the last. L4A46 plp result of last comparison ? bne L4A52 branch if different character or count. inx bump pointers. iny lda pathbuf,y was it the last character ? bne L4A38 if not. clc no operation, names were the same. rts L4A52 ldy rnptr index to last name in the chain. lda pathbuf,y get last name length. sec adc rnptr tay lda pathbuf,y this byte should be $00 ! bne L4A72 if not, bad path error. ldx namptr index to last of original name lda gbuf,x sec adc namptr tax lda gbuf,x this byte should also be $00. beq L4A76 if so, continue processing. L4A72 lda #MLI.E.INVPATH bad pathname error. L4A74 sec rts L4A76 jsr XDOS.CheckPath test for duplicate file name. bcs L4A7F branch if file not found, which is ok !! lda #MLI.E.DUPFILE duplicate name error. sec rts L4A7F cmp #MLI.E.FNOTFND was it a valid file not found ? bne L4A74 no, rename error. jsr XDOS.GetPath syntax pathname of file to be changed. jsr XDOS.FindFile get all the info on this file. bcs L4A74 rename error. jsr tstopen is file in use ? lda #MLI.E.OPEN anticipate file busy error. bcs L4A74 error if in use. lda d_attr test bit which allows rename. and #$40 bne L4A9D branch if ok to rename lda #MLI.E.LOCKED otherwise, illegal access. .HS 2C BIT ABS L4A98 lda #MLI.E.INCFF L4A9B sec rts L4A9D lda d_stor find out which storage type. and #$F0 strip off name length. cmp #$D0 is it a directory ? beq L4AAE then ok. cmp #$40 is it a seed, sapling or tree ? bcs L4A98 file incompatible error. L4AAE jsr XDOS.GetRenPath since both names go into the directory, bcs L4A74 syntax the new name to get the local ldy rnptr name address. y = index to local name ldx pathbuf,y length. adj y to last char of new name. tya adc pathbuf,y tay L4ABE lda pathbuf,y move local name to dir entry workspace. sta d_stor,x dey dex bne L4ABE lda d_stor preserve file storage type. and #$F0 strip off old name length. tax ora pathbuf,y add in new name's length. sta d_stor cpx #$D0 that file must be changed also. bne L4AF0 branch if not directory type. jsr XDOS.ReadGBuf_d_frst bcs L4A74 errors. ldy rnptr change the header's name to match the lda pathbuf,y owner's new name. get local name length. ora #$E0 assume it's a header. jsr XDOS.UpdateHdr bcs L4A74 L4AF0 jmp drevise1 end by updating all path directories. *-------------------------------------- XDOS.Destroy jsr XDOS.FindFile look for file to be destroyed. bcs L4B66 if error. jsr tstopen is it open ? lda totent bne L4B64 error if open. stz reql force proper free count in volume. stz reqh (no disk access occurs if already jsr tstfrblk proper) bcc L4B39 no errors. cmp #MLI.E.VOLFULL was error a full disk ? bne L4B66 no, report error. L4B39 lda d_attr make sure ok to destroy file. * and #$80 * bne L4B45 bmi L4B45 lda #MLI.E.LOCKED access error jsr GP.P8errv L4B45 lda DEVNUM last device used. jsr twrprot1 test for write protected hardware bcs L4B66 before going thru deallocation. lda d_frst 'detree' needs first block address sta firstbl lda d_frst+1 sta firstbh lda d_stor find out which storage type. and #$F0 strip off name length. cmp #$40 is it a seed, sapling or tree ? bcc L4B68 branch if it is. bra L4BCF otherwise, test for directory destroy. L4B64 lda #MLI.E.OPEN file busy error. L4B66 sec can't be destroyed rts L4B68 sta stortyp destroy a tree file. save storage type. ldx #$05 * lda #$00 set 'detree' input variables, must be L4B6F stz stortyp,x in order: deblock, dtree, dsap, dseed. dex bne L4B6F loop until all zero'd. lda #$02 this avoids an extra file i/o and pre- sta dseed+1 vents destruction of any deleted data. inc delflag don't allow detree to zero index blocks. jsr detree make trees and saplings into seeds. dec delflag reset flag. bcs L4B93 (de-evolution) L4B85 ldx firstbh lda firstbl now deallocate seed. jsr XDOS.DeallocAX bcs L4B93 jsr upbmap L4B93 pha save possible error code. lda #$00 update directory to free entry space. sta d_stor cmp h_fcnt file entry wrap ? bne L4BA1 branch if no carry adjustment. dec h_fcnt+1 take carry from hi byte of file entries. L4BA1 dec h_fcnt mark header with one less file. jsr dvcbrev go update block count in vcb (ignore jsr drevise error, if any) and update dir last. tax save possible new error code, pla restore possible old error code. bcc L4BAF branch if last call succeeded. txa last call failed, use it's error code. L4BAF cmp #$01 adjust carry accordingly rts dvcbrev ldx vcbptr update block free count in vcb. point to vcb of correct device. lda deblock get # of blocks recently freed. adc VCBs+VCB.FBLK,x sta VCBs+VCB.FBLK,x update current free block count. lda deblock+1 adc VCBs+VCB.FBLK+1,x sta VCBs+VCB.FBLK+1,x stz VCBs+VCB.BMAPIDX,x force re-scan from 1st bitmap * lda #0 ????? rts L4BCD bcc L4B85 branch widened (always taken) L4BCF cmp #$D0 is this a directory file ? bne L4C1B no, file incompatible. jsr fndbmap make sure a buffer available for bitmap bcs L4C1A if error. jsr XDOS.ReadGBuf_d_frst read 1st block of directory into gbuf bcs L4C1A lda gbuf+37 do any files exist in this directory ? ora gbuf+38 bne L4C1Abis if so, access error. L4BF6 sta gbuf+4 make it an invalid subdirectory .DO LOWERCASE=1 jsr XDOS.WriteGBufDir .ELSE jsr XDOS.WriteGBuf .FIN bcs L4C1A L4BFE lda gbuf+2 get forward link. cmp #$01 test for null block into carry. ldx gbuf+3 get the rest of the block address. bne L4C0A branch if not null. bcc L4BCD was the low part null as well ? L4C0A jsr XDOS.DeallocAX free this block. bcs L4C1A lda gbuf+2 ldx gbuf+3 jsr XDOS.ReadGBufAX read next DIR block (no need to unpack) bcc L4BFE loop until all freed L4C1A rts L4C1Abis lda #MLI.E.LOCKED access error. .HS 2C BIT ABS L4C1B lda #MLI.E.INCFF file incompatible jsr GP.P8errv fcbused pha mark fcb as dirty so the directory will be flushed on 'flush'. phy save regs. ldy fcbptr lda #$80 mark fcb as dirty. sta FCBs+FCB.DIRTY,y save it back ply and restore regs. pla rts *-------------------------------------- XDOS.UpdateHdr ldx #$00 .1 sta gbuf+4,x inx iny lda pathbuf,y bne .1 .DO LOWERCASE=1 jmp XDOS.WriteGBufDir .ELSE jmp XDOS.WriteGBuf write changed header block. .FIN *-------------------------------------- getnamptr ldy #$00 return pointer to 1st name of path. bit prfxflg is this a prefixed name ? bmi .1 branch if not. ldy newpfxptr .1 ldx #$00 rts *-------------------------------------- MAN SAVE usr/src/prodos.fx/prodos.s.xdos.e LOAD usr/src/prodos.fx/prodos.s ASM