1000 * RECDOS3.M65 1010 .PAGE "RENAME" 1020 .LOCAL 1030 * 1040 * XRENAME - rename a file or files 1050 * 1060 XRENAME JSR FNDCODE decode file name 1070 JSR FNDCNX go decode next file name 1080 LDX #10 move new filename 1090 :LBL1 LDA FNAME,X 1100 STA AFNAME,X 1110 DEX 1120 BPL :LBL1 1130 JSR XSTAT decode old filename, dont rtn if not in directory 1140 XRN1 JSR TSTLOCK test lock 1150 JSR TSTDOS test old file entry 1160 PHP indicate DOS in stacked PSW 1170 LDX #0 1180 STX TEMP1 1190 LDY CDIRD get index to filename in dir sector 1200 * move filename from AFNAME to dir entry 1210 XRN2 LDA FNAME,X don't change wild card 1220 CMP #'? 1230 BNE :LBL2 1240 DEC TEMP1 indicate wild card 1250 CMP AFNAME,X ck with new name 1260 BNE :LBL3 br to error exit if not also a '?' 1270 :LBL2 LDA AFNAME,X get new name char 1280 CMP #'? wild card? 1290 BEQ XRN3 skip if so 1300 STA FILDIR+DFDPFN,Y otherwise, store new char 1310 XRN3 INY 1320 INX 1330 CPX #11 1340 BNE XRN2 loop until done 1350 PLP unstack PSW to indicate (no) DOS 1360 BNE :LBL4 1370 JSR DELDOS tell no DOS if DOS.SYS was renamed 1380 :LBL4 JSR TSTDOS test new file entry 1390 BNE :LBL5 skip if no DOS 1400 LDX CDIRD otherwise, set index 1410 LDA FILDIR+DFDSSN+1,X 1420 LDY FILDIR+DFDSSN,X A,Y new DOS start sector 1430 JSR SETDSO go write sector one 1440 :LBL5 JSR WRTDIR go write cur dir record 1450 LDA TEMP1 wild card used? 1460 BEQ :LBL6 no, done 1470 JSR CSFDIR yes, cont search of dir 1480 BCC XRN1 br if found another 1490 :LBL6 JMP FGREAT go to good ending 1500 :LBL3 JMP FNDERR file name error 1510 .PAGE "DELETE" 1520 * 1530 * XDELETE - delete all filenames that match 1540 * 1550 XDELETE JSR XSTAT decode filename & search dir, don't rtn if not found 1560 XDELX JSR XDEL0 delete 1570 JSR TSTDOS was it DOS? 1580 BNE XDELY br if not 1590 JSR DELDOS otherwise re-write boot record 1600 XDELY JSR WRTDIR write dir entry 1610 JSR CSFDIR look for next match 1620 BCC XDELX br if found 1630 JSR WRTVTOC write VTOC 1640 JMP FGREAT done 1650 * 1660 XDEL0 JSR OPVTOC don't rtn if disk write protected 1670 LDY CDIRD get dir displ 1680 JSR TSTLOCK go test lock 1690 LDA #DFDEDE load deleted flag 1700 STA FILDIR+DFDFL1,Y delete file 1710 JSR DFRDSU read first sector 1720 XDEL2 JSR FRESECT free cur sector 1730 JSR RDNXTS read next sector 1740 BCC XDEL2 1750 LDY #DVDWRQ turn on write required 1760 TYA 1770 STA (ZDRVA),Y 1780 :EXIT RTS 1790 .PAGE "LOCK AND UNLOCK" 1800 * 1810 * XLOCK - lock a file 1820 * XUNLOCK - unlock a file 1830 * 1840 XLOCK LDA #DFDLOC set lock 1850 .BYTE $2C skip word by nonsense instruction 1860 * 1870 XUNLOCK LDA #0 set unlock 1880 * common continuation 1890 STA TEMP4 1900 JSR XSTAT decode file name and find 1st match 1910 XLC1 LDY CDIRD get current displ 1920 LDA FILDIR+DFDFL1,Y get lock byte 1930 AND #$DF turn off lock 1940 ORA TEMP4 or in lock/unlock 1950 STA FILDIR+DFDFL1,Y set new lock byte 1960 JSR WRTDIR go write 1970 JSR CSFDIR look for next match 1980 BCC XLC1 br found 1990 JMP FGREAT else done 2000 * 2010 * TSTLOCK - test file locked 2020 * don't rtn if file locked 2030 * 2040 TSTLOCK LDY CDIRD get dir displ 2050 LDA FILDIR+DFDFL1,Y load lock byte 2060 AND #DFDLOC mask lock bit 2070 BEQ :EXIT br & rtn if not locked 2080 JSR ERROR error: file locked 2090 .BYTE $A7 (error # 167) 2100 .PAGE "POINT" 2110 * 2120 * XPOINT - point request 2130 * 2140 * sets diskette location of next byte to be read or written 2150 * (file must have been opened for update) 2160 * expects sector number in ICAUX3/4 (lsb/msb) 2170 * and relative sector displacement in ICAUX5 2180 * 2190 XPOINT LDA FCBFLG,X if acquire sectors 2200 BMI PERR1 point invalid 2210 LDA ICAUX4,X if request is not same as current 2220 CMP FCBCSN+1,X 2230 BNE XP1 then br 2240 LDA ICAUX3,X 2250 CMP FCBCSN,X 2260 BEQ XP2 else no need to change 2270 XP1 LDA FCBFLG,X if not modified 2280 BEQ XP1A br 2290 JSR WRCSIO else write it 2300 LDA #0 2310 STA FCBFLG,X 2320 XP1A LDA ICAUX4,X 2330 STA FCBLSN+1,X 2340 LDA ICAUX3,X 2350 STA FCBLSN,X 2360 JSR RDNSO read req sector 2370 BCS XPERR 2380 XP2 LDA ICAUX5,X test req data len 2390 CMP FCBMLN,X less then max 2400 BCC XP3 2410 BEQ XP3 2420 XPERR JSR ERROR if not then: point data length error 2430 .BYTE $A6 (error # 166) 2440 XP3 STA FCBDLN,X set new data len 2450 JMP GREAT 2460 PERR1 JSR ERROR error: invalid point 2470 .BYTE $AB (error # 171) 2480 .PAGE "NOTE" 2490 * 2500 * XNOTE - execute note request 2510 * 2520 * returns the diskette location of next byte to be read or 2530 * written 2540 * sector number in ICAUX3/4 (lsb/msb) 2550 * relative sector displ in ICAUX5 2560 * 2570 XNOTE LDA FCBDLN,X data length value 2580 STA ICAUX5,X to aux5 2590 LDA FCBCSN,X current sector number (lo) 2600 STA ICAUX3,X to aux3 2610 LDA FCBCSN+1,X curr sec no (hi) 2620 STA ICAUX4,X to aux4 2630 JMP GREAT 2640 .PAGE "LIST DIRECTORY" 2650 .LOCAL 2660 * 2670 * LISTDIR -- list the directory, called by DFMOPN 2680 * GDCHAR -- get next dir character, called by DFMGET 2690 * 2700 * the directory is listed via open list directory 2710 * function. Each dir entry that matches the file 2720 * spec is converted to a printable format into a 2730 * sector buffer. The get byte entry is used to get 2740 * the printable characters one at a time. The last 2750 * line printed is always a count of the number of 2760 * sectors remaining available. 2770 * 2780 * Files invisible to single density DOS 2.0 will have their 2790 * names placed between brackets if ICAUX1 has bit 0 set. 2800 * A directory opened with ICAUX1 set to 7 will return with 2810 * brackets, if necessary. The traditional ICAUX1 value 2820 * of 6 will not. 2830 * 2840 LISTDIR JSR SFDIR search for a file name 2850 BCC LDENT1 br if found 2860 * prepare SECTORS FREE line 2870 LDCNT JSR RDVTOC read VTOC 2880 LDY #DVDESA get enhanced # sector available (lo byte) 2890 LDA (ZDRVA),Y 2900 LDY #DVDNSA add to # sector available 2910 CLC 2920 ADC (ZDRVA),Y 2930 PHA save on stack 2940 INY do hi byte 2950 LDA (ZDRVA),Y get # sector available 2960 LDY #DVDESA+1 2970 ADC (ZDRVA),Y add to enhanced # sector 2980 TAX save hi byte in X reg 2990 PLA 3000 TAY lo byte in Y reg 3010 TXA hi byte in accu 3020 LDX #0 set char cnt = 0 3030 STX TEMP2 3040 JSR CVDX and convert 3050 LDY #3 set to position 3 3060 TXA put there a blank or a '+' 3070 STA (ZSBA),Y 3080 INY incr to position 4 3090 MVFSCM LDA FSCM-4,Y text 'FREE SECTORS' 3100 STA (ZSBA),Y 3110 INY 3120 CPY #$10 3130 BNE MVFSCM loop until 16 bytes 3140 JSR CVDY do eol 3150 GDCRTN JMP GREAT and rtn 3160 * get next dir char 3170 GDCHAR LDY TEMP2 get count of chars sent 3180 BPL :LBL1 br if o.k. 3190 JMP PEOF set to $80 if all done 3200 :LBL1 LDA (ZSBA),Y get next char 3210 STA SVDBYT in SVDBYT 3220 INC TEMP2 inc count 3230 CMP #EOL test if eol done 3240 BNE GDCRTN br not eol 3250 CPY #17 was this an entry 3260 BCS LDENT br if it was 3270 LDA #$80 else indicate end 3280 STA TEMP2 in char counter 3290 JMP FGREAT done 3300 * look for more matches 3310 LDENT JSR CSFDIR search for next match 3320 BCS LDCNT br no more matches 3330 * 3340 LDENT1 JSR FDENT format entry 3350 JMP GREAT done 3360 * message 3370 FSCM .BYTE "FREE SECTORS" 3380 * format dir entry into a sector buffer 3390 FDENT LDX CDIRD get curr dir displ 3400 LDY #0 start at displ zero 3410 LDA #$20 start with a blank 3420 STA (ZSBA),Y 3430 LDA FILDIR+DFDFL1,X 3440 AND #DFDLOC but if file locked 3450 BEQ LD1 3460 LDA #'* change to asterix 3470 STA (ZSBA),Y 3480 LD1 INY 3490 LDA #$20 followed by a blank 3500 STA (ZSBA),Y 3510 INY 3520 LD2 LDA FILDIR+DFDPFN,X move the 12 char 3530 STA (ZSBA),Y file name 3540 INX 3550 INY 3560 CPY #13 3570 BCC LD2 3580 LDA #$20 followed by a blank 3590 STA (ZSBA),Y 3600 INY 3610 STY TEMP2 save line index 3620 LDX CDIRD recall file dir index 3630 * place brackets if necessary 3640 LDA ICAX1Z get aux1 3650 ROR A 3660 BCC :SKIP skip brackets if bit 0 zero 3670 LDA FILDIR+DFDFL1,X get flag 3680 ROR A 3690 BCC :SKIP no brackets if bit 0 zero 3700 DEY else, change last blank 3710 LDA #'> to right bracket 3720 STA (ZSBA),Y 3730 LDY #1 change bracket at position 1 3740 LDA #'< to left bracket 3750 STA (ZSBA),Y 3760 :SKIP LDY FILDIR+DFDCNT,X set A,Y to sector count 3770 LDA FILDIR+DFDCNT+1,X 3780 * calculate decimal sector cnt 3790 CVDX LDX #100 convert and move 3800 JSR CVDIGIT 100s digit 3810 LDX #10 3820 JSR CVDIGIT 10s digit 3830 LDX #1 3840 JSR CVDIGIT 1s digit 3850 LDX #$20 prepare for a trailing blank 3860 TYA test if any value left 3870 BEQ :L4 no, skip the '+' 3880 LDX #'+ otherwise, change to plus 3890 :L4 LDY #17 then put out 3900 CVDY LDA #EOL an eol 3910 STA (ZSBA),Y 3920 LDY #0 3930 STY TEMP2 set char cnt = 0 3940 RTS done 3950 * convert digit 3960 CVDIGIT STX SVD2 save digit value 3970 LDX #$FF 3980 CVD1 STA ZBUFP+1 save current value hi 3990 STY ZBUFP and lo 4000 INX inc digit counter 4010 SEC subtract digit value 4020 LDA ZBUFP from curr value 4030 SBC SVD2 4040 TAY 4050 LDA ZBUFP+1 4060 SBC #0 4070 BCC STDIGIT if gone minus, done 4080 CPX #9 otherwise, check for 9 (don't exceed 999) 4090 BNE CVD1 if not equal, do again 4100 STDIGIT TXA digit to accu 4110 ORA #$30 plus ascii zero 4120 LDY TEMP2 get output index 4130 STA (ZSBA),Y and set digit 4140 INC TEMP2 inc output index 4150 LDA ZBUFP+1 load value hi 4160 LDY ZBUFP and value lo 4170 RTS 4180 .PAGE "FILE NAME DECODE" 4190 * 4200 * FNDCODE -- decode a file name 4210 * 4220 * The user filename is pointed to by ICBAL/H. It is 4230 * on the form P.X where P is the primary file name 4240 * (1 to 8 chars) and X is the extended file name 4250 * (0 to 3 chars). The period is optional (if not 4260 * present, then no extension). The decoded file 4270 * name will be 11 chars in length. The P field will 4280 * be left justified in the 1st 8 bytes. The X field 4290 * will be left justified in the last 3 bytes. Blanks 4300 * are used to pad the fields to full size. If the 4310 * user specified P or X fields contain more than 4320 * 8 or 3 chars, then the extra chars are ignored. 4330 * The '*' wild card char will cause the rest of the 4340 * field to be filled with the '?' wild card char. Any 4350 * non-alphanumeric char terminates the filename. 4360 * 4370 FNDCODE LDY #2 find the ':' 4380 FD0A LDA (ICBALZ),Y 4390 DEY 4400 BMI FNDERR br if not 2nd or 3rd place 4410 CMP #': 4420 BNE FD0A not found, try again 4430 INY found, restore index 4440 * decode next char 4450 FNDCNX INY inc ICBALZ index to start of primary fn 4460 LDA #8 set primary fn length 4470 LDX #0 index to FNAME 4480 :LBL5 STA EXTSW set length of field 4490 :LUS LDA (ICBALZ),Y get char 4500 CMP #'. was char field seperator 4510 BNE FD3 br if not 4520 * process period 4530 CPX #8 at end of P field 4540 BNE :LBL4 br if so 4550 INY otherwise, advance to extender field 4560 LDA #11 set P + X field length 4570 BNE :LBL5 (always) 4580 :LBL4 BCC :L6 br if index less than field length to pad with blanks 4590 * process chars 4600 FD3 CMP #'* test for asterix wild cards 4610 BNE FD4 br if not 4620 LDA #'? 4630 CPX EXTSW end of field? 4640 BCS FD6 yes, advance to next field 4650 BCC FD6A no, pad field with question marks 4660 * NOTE: 4670 * Contrary to DOS 2.0, this version accepts numeric and 4680 * alpha chars in all positions, including a primary 4690 * filename beginning with a numeric. Lowercase is accepted 4700 * as input, but changed to, and handled as, uppercase. 4710 FD4 CMP #'? was it ? wild card 4720 BEQ FD6 yes, br 4730 CMP #'0 is char numeric 4740 BCC FD5 br not numeric (period or end of name) 4750 CMP #'9+1 test numeric hi 4760 BCC FD6 o.k., br 4770 AND #$DF change lowercase to upper 4780 CMP #'A is char alpha 4790 BCC FD5 br not alpha 4800 CMP #'Z+1 test hi alpha 4810 BCC FD6 o.k., br 4820 * process period or non legal char 4830 FD5 LDA #11 set P + X field length 4840 STA EXTSW 4850 CPX #11 complete file name moved? 4860 BEQ :LBL3 br if so 4870 :L6 LDA #$20 otherwise, pad with blanks 4880 BNE FD6A (always) 4890 * char to FNAME 4900 FD6 INY 4910 FD6A CPX EXTSW end of field? 4920 BEQ :LUS br if so 4930 STA FNAME,X otherwise, set char into name 4940 INX inc to next char 4950 BNE :LUS (always) 4960 * test filename 4970 :LBL3 LDA FNAME is first char fname a blank 4980 CMP #$20 4990 BEQ FNDERR yes, error 5000 LDX CURFCB no, restore FCB 5010 RTS 5020 * error exit 5030 FNDERR JSR ERROR file name error 5040 .BYTE $A5 (error # 165) 5050 .PAGE "DIRECTORY SEARCH" 5060 .LOCAL 5070 * 5080 * SFDIR -- search file directory 5090 * CSFDIR -- continue search 5100 * 5110 * The file directory is searched for the filename in FNAME. The 5120 * search starts at the central sector+1 and will continue for 5130 * up to a total of 8 sectors. When testing for FNAME match, '?' 5140 * FNAME chars will always match the corresponding dir filename 5150 * char. If a match is found CDIRS contains the relative 5160 * directory sector number (0-7) and CDIRD (and the Y reg) 5170 * contains the displacement of the entry. After a match has 5180 * been found, the directory can be searched for another match 5190 * via the CSFDIR entry point. If a match has not been found then 5200 * DHOLES and DHOLED will point to a directory hole that can be 5210 * used. If DHOLED = FF then the directory is full. The carry 5220 * is returned clear if file found, set if file not found. 5230 * 5240 * Dir entries are flaged: 5250 * bit 7 - deleted (if set) 5260 * 6 - in use 5270 * 5 - locked 5280 * 1 - created by DOS 2 5290 * 0 - open for output if bit 6 set 5300 * - in used by enh sectors if bit 6 zero 5310 * 5320 SFDIR LDA #$FF init to -1 5330 STA DHOLES dir hole sector 5340 STA CDIRS curr dir sector 5350 STA SFNUM file number 5360 LDA #$70 init to -16 (-entry length) 5370 STA CDIRD curr dir displ 5380 * 5390 CSFDIR INC SFNUM 5400 CLC 5410 LDA CDIRD CDIRD = CDIRD + entry len 5420 ADC #DFDELN 5430 BPL SFD2 if result <128 then br, else at end of dir sect 5440 INC CDIRS inc to next dir sector 5450 LDA #8 test end of dir 5460 CMP CDIRS 5470 BCC SFD1 br not end 5480 BEQ SDRTN 5490 SFD1 JSR RDDIR read the next dir record 5500 LDA #0 set dir displ = 0 5510 SFD2 STA CDIRD set new dir displ 5520 TAY put displ in Y as index 5530 LDA FILDIR+DFDFL1,Y get flag 1 5540 BEQ SFDSH br if unused (end of used entries) 5550 BMI SFDSH br if deleted 5560 AND #$43 mask off lock bit 5570 CMP #3 is it enhanced sector file? 5580 BEQ :LBL1 br if so 5590 AND #DFDOUT if open output 5600 BNE CSFDIR don't find it 5610 * entry in use, test for match 5620 :LBL1 LDX #0 test match on 11 chars 5630 SFD3 LDA FNAME,X file name char 5640 CMP #'? is fnc wild card 5650 BEQ SFD4 then it matches 5660 CMP FILDIR+DFDPFN,Y else it must match for real 5670 BNE CSFDIR if not match then try next 5680 SFD4 INX inc char count 5690 INY 5700 CPX #11 test all 5710 BNE SFD3 and continue check 5720 CLC we have a match 5730 BCC SDRTN 5740 * empty or deleted 5750 SFDSH LDA DHOLES if DHOLES not minus 5760 BPL SFDSH1 then already have a good hole 5770 LDA CDIRS else, move curr displ sector 5780 STA DHOLES and current dir displ 5790 LDA CDIRD to hole sector and displ 5800 STA DHOLED 5810 LDA SFNUM save hole 5820 STA DHFNUM file number 5830 SFDSH1 LDA FILDIR+DFDFL1,Y if hole was deleted 5840 BMI CSFDIR entry then continue, else we are at end of 5850 SEC used entries thus file not found 5860 SDRTN LDX CURFCB restore FCB 5870 RTS 5880 .PAGE "STATUS SUBROUTINE" 5890 * 5900 * search for a file (don't rtn if not found) 5910 * 5920 XSTAT JSR FNDCODE decode file name 5930 JSR SFDIR search for file 5940 BCS :ERR br not found 5950 RTS rtn if o.k. 5960 :ERR JMP OPNER1 not found, so go with error 170 (file not found) 5970 .PAGE "WRITE DATA SECTOR" 5980 * 5990 * WRTNXS - write next sector 6000 * 6010 WRTNXS LDA FCBFLG,X if acquiring sectors 6020 BMI WRTN1 then no update 6030 * process update 6040 ASL A if sector not modified 6050 BPL WRU1 then skip write 6060 ASL A 6070 STA FCBFLG,X turn off flag bits 6080 JSR WRCSIO write current sector 6090 BMI WRNERR br if bad i/o 6100 WRU1 JMP RDNXTS else read next sector 6110 * process no update 6120 WRTN1 JSR GETSECTOR get a new sector 6130 * entry point for write last sector, called from CLOSE 6140 WRTLSEC LDA FCBDLN,X get data len 6150 LDY #127 into last byte 6160 STA (ZSBA),Y of sector 6170 WRTN2 LDA FCBLSN+1,X move link sector 6180 ORA FCBFNO,X plus file number 6190 LDY #125 to bytes 125-126 6200 STA (ZSBA),Y of sector buff 6210 INY 6220 LDA FCBLSN,X link sector in msb/lsb order (10 bits) 6230 STA (ZSBA),Y 6240 JSR WRCSIO write sector 6250 BPL WRTN5 br no error 6260 WRNERR LDA #0 close file 6270 STA FCBOTC,X 6280 LDA DCBSTA recover error status 6290 JMP RETURN 6300 * update FCB 6310 WRTN5 INC FCBCNT,X inc sector count 6320 BNE WRTN6 6330 INC FCBCNT+1,X 6340 WRTN6 JSR MVLSN link acquired sector to curr 6350 LDA #0 6360 STA FCBLSN,X set link to zero 6370 STA FCBLSN+1,X 6380 STA FCBDLN,X data length also 6390 LDA #125 set max data length 6400 STA FCBMLN,X 6410 CLC 6420 RTS 6430 * 6440 WRCSIO SEC set for write curr sector 6450 * read/write current sector (# in FCBCSN) 6460 RWCSIO LDA FCBCSN+1,X 6470 LDY FCBCSN,X 6480 JMP DSIO 6490 * move link sector no to current sect no 6500 MVLSN LDA FCBLSN,X move link 6510 STA FCBCSN,X 6520 LDA FCBLSN+1,X 6530 STA FCBCSN+1,X 6540 RTS