1000 * RECDOS4.M65
1010     .PAGE "READ DATA SECTOR"
1020 *
1030 * RDNXTS - read next sector
1040 *
1050 RDNXTS LDA FCBFLG,X if not upd mode
1060     BEQ RDNSO   br
1070     JMP WRTNXS  else write first
1080 RDNSO LDA FCBLSN,X if LSN not zero
1090     ORA FCBLSN+1,X
1100     BNE RDNS1   br
1110     SEC         else eof
1120     RTS 
1130 RDNS1 JSR MVLSN move link to current
1140     CLC         read
1150     JSR RWCSIO  current sector
1160     BMI RDIOER  br if i/o error
1170     LDY #125
1180     LDA (ZSBA),Y test for same file no
1190     AND #$FC    mask off sector bits
1200     CMP FCBFNO,X
1210     BNE RDFNMM  if not, then error
1220 * update FCB
1230     LDA (ZSBA),Y move link sector
1240     AND #3      mask off file no bits
1250     STA FCBLSN+1,X
1260     INY         get lower part of link sector #
1270     LDA (ZSBA),Y
1280     STA FCBLSN,X
1290     INY         inc to len byte
1300     LDA (ZSBA),Y get len byte
1310     PHA         save it
1320     LDA FCBSLT,X get sector len type
1330     BNE RDNS3   br if new type
1340     PLA         get len
1350     BMI RDNS2   br if old short sector
1360     LDA #125    else set full sector
1370 RDNS2 AND #$7F  turn off msb
1380     PHA         balance stack
1390 RDNS3 PLA 
1400     STA FCBMLN,X set max len
1410     LDA #0      set curr data len = 0
1420     STA FCBDLN,X
1430     CLC 
1440     RTS 
1450 RDIOER JSR ERRIO i/o error
1460 * file number mismatch
1470 RDFNMM LDA ICCOM,X recall cmnd
1480     CMP #$21    was this delete?
1490     BEQ RDDELE  br if delete
1500     JSR ERROR   otherwise, file number mismatch
1510     .BYTE $A4   (error # 164)
1520 RDDELE SEC      indicate eof to delete
1530     RTS 
1540     .PAGE "READ/WRITE DIR"
1550     .LOCAL 
1560 *
1570 * RDDIR/WRTDIR - read/write directory
1580 *
1590 RDDIR CLC       set read
1600     BCC DIRIO
1610 *
1620 WRTDIR SEC      set write
1630 * calls DSYSIO with lo byte dir sector in Y, file
1640 * dir buff in X/A (lo/hi) and r/w in carry
1650 DIRIO PHP       save read/write
1660     CLC 
1670     LDA CDIRS   CDIRS +
1680     ADC #$69    ((40*18)/2)+1 (is dir sector number)
1690     TAY         into Y (lo byte)
1700     PLP 
1710     LDX # >FILDIR file directory buffer in X/A
1720     LDA # <FILDIR
1730     BNE DSYSIO  (unconditional) go do system i/o
1740     .PAGE "READ/WRITE VTOC"
1750 *
1760 * RDVTOC/WRTVTOC - read/write VTOC
1770 *
1780 * read VTOC
1790 RDVTOC LDY #DVDWRQ if write reqd
1800     LDA (ZDRVA),Y non zero
1810     BNE :EXIT   VTOC already in buff, go
1820 * get VTOC length
1830     LDY ICDNOZ  get drive #
1840     LDA #$4A    assume ramdisk VTOC length
1850     CPY #8
1860     BEQ :RDSK   br if drive 8
1870     STY DCBDRV  drive # to DCB
1880     LDA #DCBCST get status
1890     STA DCBCMD
1900     JSR DHADR
1910     LDA #100    assume single density VTOC length
1920     LDY DVSTAT  ck status
1930     BPL :RDSK   br if single
1940     LDA #138    set enhanced VTOC length
1950 :RDSK LDY ICDNOZ drive # as displ in table (+1)
1960     STA DRVTBL-1,Y store VTOC length
1970     STA DRVTYP  also as drive type
1980 * read VTOC to drive buffer
1990     CLC         set read
2000     JSR DSYSIA  do i/o for enhanced VTOC
2010     JSR :SUB1   save enh VTOC
2020     LDY #DVDWRQ turn off write reqd
2030     STA (ZDRVA),Y
2040     CLC         set read
2050     JSR VTIO    do i/o for normal VTOC
2060     JSR :SUB2   recall enh VTOC
2070 :EXIT RTS 
2080 *
2090 * open VTOC (insure not write protected)
2100 *
2110 OPVTOC JSR RDVTOC read it, then write it
2120 *
2130 * write VTOC
2140 *
2150 WRTVTOC LDA #0  turn off write reqd
2160     LDY #DVDWRQ
2170     STA (ZDRVA),Y
2180     JSR :SUB1   save enh VTOC
2190     SEC         set write
2200     JSR VTIO    do i/o for normal VTOC
2210     JSR :SUB2   recall enh VTOC
2220     SEC         set write
2230     JMP DSYSIA  do i/o for enh VTOC & rtn
2240 * set up for VTOC read/write
2250 VTIO LDA ZDRVA+1 move buff addr to DCB
2260     LDX ZDRVA
2270     LDY #$68    move lo byte VTOC sector
2280 *
2290 * system i/o
2300 * expects buffer address in X/A (lo/hi)
2310 * and lo byte sector number in Y, sets hi byte sector # to 1
2320 *
2330 DSYSIO STY DCBSEC set sector for DCB
2340     LDY #1
2350     STY DCBSEC+1
2360 :LBL1 STA DCBBUF+1 set buff addr for DCB
2370     STX DCBBUF
2380     JSR BSIOR   go do i/o
2390     BPL :EXT    rtn if o.k.
2400     CPY #$83    was it data error?
2410     BEQ :ERR    br if was
2420     JMP ERRIO   else user problem
2430 :ERR JSR ERROR  fatal sys data i/o error
2440     .BYTE $A3   (error # 163)
2450 * read/write enhanced part of VTOC
2460 DSYSIA LDA DRVTYP get drive type
2470     BPL :EXT    exit if not enhanced
2480     PHP         save r/w
2490     LDA #0      set sector $400
2500     STA DCBSEC
2510     LDA #4
2520     STA DCBSEC+1
2530     LDA ZDRVA   bump VTOC buff addr by 16
2540     CLC 
2550     ADC #$10
2560     TAX         move lo byte in X
2570     LDA ZDRVA+1
2580     ADC #0      msb in accu
2590     PLP         recall r/w
2600     JMP :LBL1   and join system i/o
2610 * save enh VTOC and clear buffer area
2620 * SUB1/2 uses a 44 byte buffer area at end of misc storage
2630 :SUB1 LDY #100  index to single VTOC length
2640 :LBL2 LDA (ZDRVA),Y move enh VTOC
2650     STA Z-100,Y to temp buff
2660     LDA #0      clear enh VTOC buff
2670     STA (ZDRVA),Y
2680     INY 
2690     CPY #144    done?
2700     BNE :LBL2   not yet, cont
2710 :EXT RTS 
2720 * recall enh VTOC
2730 :SUB2 LDY DRVTYP get drive type
2740     BPL :LBL5   go if not enhanced
2750     LDY #100
2760 :LBL3 LDA Z-100,Y move enh VTOC from temp buff
2770     STA (ZDRVA),Y to VTOC buff
2780     INY 
2790     CPY #144    done?
2800     BNE :LBL3   cont if not done
2810 :LBL5 RTS 
2820     .PAGE "FREE SECTOR"
2830 *
2840 * FRESECT - free current sector
2850 * The lowest 3 bits of the 10 bits curr sector number is
2860 * used to get the appropriate bitmask from SECTAB. The
2870 * other 7 bits are used as offset in the VTOC bitmap.
2880 * The bit representing the curr sector is set, indicating
2890 * a free sector, and the sector count is incremented.
2900 *
2910 FRESECT LDA FCBCSN,X get CSN
2920     PHA 
2930     AND #7      mask off bit 3-7
2940     TAY         use bit 0-2 as index for SECTAB
2950     PLA 
2960     ORA FCBCSN+1,X
2970     BEQ FSRTS   exit if CSN = 0
2980     LDA SECTAB,Y get bit mask
2990     PHA         to stack
3000     LDA FCBCSN,X
3010     LDY #3      divide sector # by 8
3020 FS1 LSR FCBCSN+1,X to get byte number
3030     ROR A
3040     DEY 
3050     BNE FS1
3060     CLC 
3070     ADC #DVDSMP add offset to SMAP
3080     TAY         result is VTOC index
3090     PLA         recall bit mask
3100     ORA (ZDRVA),Y of bit to bit map
3110     STA (ZDRVA),Y and set result
3120     CPY #100    enh sector? assume normal free sector counter
3130     LDY #DVDNSA
3140     BCC :LBL4   br if not enh sector
3150     LDY #DVDESA enh, use enh free sector counter
3160 :LBL4 LDA (ZDRVA),Y incr number of sectors available
3170     CLC 
3180     ADC #1
3190     STA (ZDRVA),Y
3200     INY 
3210     LDA (ZDRVA),Y
3220     ADC #0
3230     STA (ZDRVA),Y
3240 FSRTS RTS 
3250     .PAGE "GET SECTOR"
3260 *
3270 * GET SECTOR -- get a free sector for use in FCB at
3280 * X reg. The sector number is placed in FCBLSN. The
3290 * search for a free sector starts at the DVDSMP byte.
3300 * Sectors are numbered sequentially from zero to
3310 * maxsm with the left bit of the DVDSMP being with zero.
3320 *
3330 GETSECTOR LDY #DVDSMP-1 set Y to start map-1
3340 GS1 INY         inc SMAP index
3350     CPY DRVTYP  at end of map?
3360     BCS GSERR   br if at end
3370     LDA (ZDRVA),Y get a map byte
3380     BEQ GS1     br no free sector in byte
3390 * allocate sector
3400     LDX #$FF    set bit counter = -1
3410 GS2 INX         shift map byte
3420     ASL A       until a free sector found
3430     BCC GS2
3440     LDA SECTAB,X get bit mask
3450     EOR (ZDRVA),Y bit set to zero to
3460     STA (ZDRVA),Y allocate sector
3470     TXA         stack bit mask index
3480     PHA 
3490     LDX CURFCB  recall curr FCB
3500 * calculate sector # (byte number * 8 + bit-value)
3510     TYA 
3520     SEC         index-DVDSMP
3530     SBC #DVDSMP
3540     STA FCBLSN,X byte number in bit map
3550     LDA #$C0    set bits to shift/rol 3 times
3560 :LUS ASL FCBLSN,X
3570     ROL A
3580     BCS :LUS
3590     STA FCBLSN+1,X msb link sector number
3600     PLA         recall bit mask index
3610     ORA FCBLSN,X or as bit 0-2
3620     STA FCBLSN,X in lsb of LSN
3630     CPY #100    enh sector? assume normal free sector counter
3640     LDY #DVDNSA
3650     BCC :LAB1   br if not enh
3660 * indicate enh sector used
3670     LDY #DVDESA use enh free sector counter
3680     LDA FCBSPR,X get file flag
3690     AND #$BF    reset bit 6
3700     ORA #1      set bit 0
3710     STA FCBSPR,X mark in use with enh sector
3720 * decr number of sectors available
3730 :LAB1 SEC 
3740     LDA (ZDRVA),Y
3750     SBC #1
3760     STA (ZDRVA),Y
3770     INY 
3780     LDA (ZDRVA),Y
3790     SBC #0
3800     STA (ZDRVA),Y
3810     LDY #5      VTOC changed, so
3820     TYA         set write required byte
3830     STA (ZDRVA),Y
3840     LDA FCBLSN+1,X rtn with LSN+1 in accu
3850     RTS 
3860 GSERR JSR ERROR disk full error
3870     .BYTE $A2   (error # 162)
3880     .PAGE "SETUP ROUTINE"
3890 *
3900 * SETUP - a routine used for all commands to set
3910 * up FMS control cells to access a particular file
3920 *
3930 SETUP STX CURFCB save FCB
3940     TSX         save entry stack level
3950     INX 
3960     INX 
3970     STX ENTSTK
3980     LDX ICDNOZ  move drive no
3990     STX DCBDRV  to DCB
4000     DEX         dec for access to tables
4010     LDA DBUFAL,X move drive buffer
4020     STA ZDRVA   addr to zero page ptr
4030     LDA DBUFAH,X
4040     STA ZDRVA+1
4050     LDA DRVTBL,X get drive type
4060     BEQ DERR1   br if not exists
4070     STA DRVTYP  set type
4080     LDX CURFCB  recall FCB
4090     LDY FCBBUF,X get sector buff #
4100     BNE SSBA    br if one is allocated
4110 * try to find a sector buffer
4120 GSB1 LDA SECTBL,Y
4130     BPL GSB5    br one found
4140     INY         inc try count
4150     CPY #8
4160     BCC GSB1    br more to try
4170     JSR ERROR   too many files open error
4180     .BYTE $A1   (error # 161)
4190 * allocate sector buffer
4200 GSB5 LDA #$80   allocate & indicate not free
4210     STA SECTBL,Y
4220     INY         incr buff number (so not zero) for FCBBUF
4230     TYA 
4240     STA FCBBUF,X put buff number + 1 into FCB
4250 * move buffer addr to zero page ptr
4260 SSBA DEY        decr to true offset
4270     TYA 
4280     LSR A       divide by 2
4290     PHA         save result
4300     LDA #0      possible carry from LSR A
4310     ROR A       to bit 7
4320     ADC SABUFL  so, bump ZSBA by $80
4330     STA ZSBA    if buff offset not even
4340     PLA         recall buff offset/2
4350     ADC SABUFH  add to sector buffer pointer
4360     STA ZSBA+1  and move to zero page
4370     RTS 
4380 DERR1 JSR ERROR drive number unknown error
4390     .BYTE $A0   (error # 160)
4400     .PAGE "FREE SECTOR BUFFERS"
4410 *
4420 * free sector buffers
4430 *
4440 FRESBUF LDY FCBBUF,X get buff no
4450     BEQ FSBR    br if none
4460     DEY         dec for table access
4470     LDA #0      free
4480     STA FCBBUF,X in FCB
4490     STA SECTBL,Y and table
4500 FSBR RTS 
4510     .PAGE "DATA SECTOR I/O"
4520 *
4530 * DSIO - data sector i/o
4540 *
4550 DSIO LDX ZSBA   sector buff addr moved
4560     STX DCBBUF  to DCB
4570     LDX ZSBA+1
4580     STX DCBBUF+1
4590     JMP BSIO    do the i/o and rtn
4600     .PAGE "WRITE DOS"
4610 *
4620 * WRTDOS - write DOS to disk
4630 *
4640 WRTDOS LDY FCBCSN,X move start addr
4650     LDA FCBCSN+1,X
4660     JSR SETDSO  write sector 1-3
4670     JSR WDO     write DOS
4680     JMP GREAT
4690 *
4700 * indicate DOS.SYS does not exists
4710 *
4720 DELDOS LDA #0   set file not exists
4730 * (re)write boot record
4740 DD1 STA DFSFLG
4750     LDA # >FMSORG move DOS start addr to DCB
4760     STA DCBBUF+1
4770     LDY # <FMSORG
4780     STY DCBBUF
4790 WRNBS INY       inc sector number lo byte
4800     LDA #0      sect number hi byte
4810     SEC         set carry for write
4820     JSR BSIO    do the write
4830     LDA DCBBUF  inc mem addr
4840     EOR #$80
4850     STA DCBBUF
4860     BMI :LBL6
4870     INC DCBBUF+1
4880 :LBL6 LDY DCBSEC test for write of all boot sectors
4890     CPY BRCNT
4900     BNE WRNBS   br not all
4910     RTS 
4920 * indicate DOS.SYS exists
4930 SETDSO STY DFLINK set link start
4940     STA DFLINK+1
4950     LDA #1      set file exists
4960     BNE DD1     (unconditional) go write sector 1-3
4970 * write FMS to DOS.SYS file
4980 WDO JSR MVSA    move file start addr to ICBAL/HZ
4990     LDA #125    set max sector data length to 125
5000     STA FCBMLN,X
5010 :LUS2 JSR MVDAT move 125 bytes to sector buffer
5020     LDA ICBALZ  if not end or past end of DOS
5030     CMP SASA
5040     LDA ICBAHZ
5050     SBC SASA+1
5060     BCS WD4
5070     JSR WRTNXS  then write next sector
5080     JMP :LUS2   and continue
5090 WD4 RTS         otherwise, done: CLOSE will write final sector
5100     .PAGE "TEST DOS FILE NAME"
5110 *
5120 * TSTDOS - test for DOS.SYS file name
5130 *
5140 TSTDOS LDX #0
5150     LDY CDIRD   current dir displ
5160 TDF1 LDA FILDIR+DFDPFN,Y test filename char
5170     CMP DFN,X   with DOS filename char
5180     BNE :LBLGD  br not match, rtn not equal
5190     INY 
5200     INX 
5210     CPX #11     look at 11 chars
5220     BNE TDF1    br if more, else rtn equal
5230 :LBLGD PHP      stack PSW
5240     LDX CURFCB  restore current FCB
5250     PLP         restore PSW
5260     RTS 
5270 DFN .BYTE "DOS     SYS"
5280     .PAGE "EXITS FROM FMS"
5290 *
5300 * error routine -- don't rtn, but get error code
5310 * just after JSR ERROR call
5320 *
5330 ERROR PLA       unstack rtn addr
5340     STA ZBUFP
5350     PLA 
5360     STA ZBUFP+1
5370     LDY #1      add one
5380     LDA (ZBUFP),Y get error code
5390 * return from FMS (to CIO)
5400 * expects status in accu
5410 RETURN LDX ENTSTK get entry stack ptr
5420     TXS         and restore
5430     LDX CURFCB  restore current FCB
5440     STA ICSTA,X put i/o error code in iocb
5450     TAY         and Y-register
5460     LDA SVDBYT  get saved data byte
5470     RTS 
5480 * test SIO status
5490 ERRIO LDA DCBSTA get i/o error code
5500     BMI RETURN  br if error
5510 *
5520 * exit points after normal operation
5530 *
5540 FGREAT LDX CURFCB (otherwise,) restore current FCB
5550     JSR FRESBUF free sector buffer
5560 *
5570 GREAT LDA #1    set all o.k.
5580     BNE RETURN  (unconditional)
5590     .PAGE "SWITCH PORTB"
5600 *
5610 * bank switching for XE ramdisk
5620 *
5630 * Memory management on XL/XE's is controlled by PORTB,
5640 * set to $FD at power-up.
5650 * - bit 0 controls o.s. ROM (1 = o.s. ROM, 0 = RAM)
5660 * - bit 1 controls Basic (1 = RAM, 0 = Basic ROM)
5670 * - bit 7 controls Self-test ROM (1 = RAM at $5000-57FF, 0 = Self-test)
5680 * - bits 2-6 are unused on the XL
5690 * XE's use bits 2-5 for bank switching, bit 6 is still unused
5700 * - bits 2-3 select a memory bank (0-3), which is only enabled
5710 *   if one or both of the following enable bits are reset
5720 * - bit 4 (CPE) for CPU bank enable (1 = main bank, 0 = extended bank)
5730 * - bit 5 (VBE) for video bank enable (1 = main bank, 0 = extended bank)
5740 * An enabled 16K bank is accessed at $4000-7FFF by the CPU
5750 * (if CPE) and/or Antic (if VBE)
5760 *
5770 * prepare, set critical i/o
5780 *
5790 XBANK LDY #1    set critical i/o
5800     STY CRITIC
5810     LDX XBFLG   (set to $FF)
5820     BMI :XB2    skip loop
5830     LDX RTCLOK+2 wait for vblank
5840 :XBL CPX RTCLOK+2
5850     BEQ :XBL
5860 :XB2 STY NMIEN  disable interrupts
5870     SEI 
5880 * select a memory bank
5890 * 0-3 in accu accesses mem bank # 0-3
5900 ; 4 accesses main memory by setting bit 4 (CPE)
5910 SBANK ASL A     shift bank # to bit 2 & 3
5920     ASL A
5930     STA ZBUFP+1 in temp reg
5940     LDA PORTB
5950     AND #$E3    clear bits 2-4
5960     ORA ZBUFP+1 or in bank #
5970     STA PORTB   do switching
5980     RTS 
5990 *
6000 * NDTXT -- used as msg by DUP's CHKD25
6010 *
6020 NDTXT .BYTE $7D clear screen
6030     .BYTE "Need DOS2.5,type Y RETURN",EOL
6040     .PAGE "MISC STORAGE"
6050 DRVTYP *= *+1   drive type (length of VTOC)
6060 RETRY *= *+1    i/o retry counter
6070 ENTSTK *= *+1   entry stack level
6080 DHOLES *= *+1   dir hole sector
6090 DHOLED *= *+1   dir hole displ
6100 DHFNUM *= *+1   dir hole file no
6110 CDIRD *= *+1    current dir displ
6120 CDIRS *= *+1    current dir sector
6130 SFNUM *= *+1    file number
6140 SVDBYT *= *+1   saved output data byte
6150 EXTSW *= *+1    index for file name decode
6160 SVD2 *= *+1     temp for convert digit (CVDIGIT)
6170 TEMP4 *= *+1    lock/unlock temp
6180 TEMP1 *= *+1    format mode flag/wild card flag for RENAME
6190 TEMP2 *= *+1    char count for LISTDIR
6200 TEMP3 *= *+1    temp for SIO cmd in BSIO
6210 BURTYP *= *+1   burst i/o type
6220 * following values are set by DINIT
6230 DRVTBL *= *+8   drive table, set to length of VTOC by RDVTOC, 0 = unused
6240 SECTBL *= *+8   positive if free to allocate, otherwise minus, set/reset by SETUP/FRESBUF
6250 DBUFAL *= *+8   VTOC buffer ptr for drive no
6260 DBUFAH *= *+8
6270 SABUFL *= *+1   start of sector buffers
6280 SABUFH *= *+1
6290 *
6300 FNAME *= *+11   file name
6310 AFNAME *= *+11  auxillary file name
6320 BURFLG *= *+1   burst flag
6330 Z   =   *       temp storage of enh VTOC
6340     .PAGE "FILE CONTROLE BLOCK"
6350 * put on same boundary as version 2.0
6360     *=  $1381
6370 FCB
6380 FCBFNO *= *+1   file #
6390 FCBOTC *= *+1   open type code
6400 FCBSPR *= *+1   curr file flag (set to $42, but changed to $03 if enh sector used)
6410 FCBSLT *= *+1   flag for new sector len type (set: new type, zero: DOS 1.0 format)
6420 FCBFLG *= *+1   working flag
6430 FCBMLN *= *+1   max sector data len
6440 FCBDLN *= *+1   curr sector buff data len
6450 FCBBUF *= *+1   sector buff no (1-8)
6460 FCBCSN *= *+2   curr sector no (0-1023)
6470 FCBLSN *= *+2   link/allocate sector #
6480 FCBSSN *= *+2   curr file relative sector #
6490 FCBCNT *= *+2   sector count
6500 FCBLEN = *-FCB  FCB length
6510     *=  FCBLEN*7+* allocate 7 more FCB's
6520 * open
6530 OPIN =  4       input
6540 OPOUT = 8       output
6550 OPDIR = 2       list directory
6560 OPAPND = 1      append
6570 * values for FCBFLG
6580 FCBFAS = $80    acq sectors
6590 FCBFSM = $40    sector modified
6600     .PAGE "FILE DIRECTORY"
6610 * file directory offsets
6620 DFDFL1 = 0      flag1 (1)
6630 DFDCNT = 1      sector counter (low)
6640 DFDSSN = 3      start sector no (low)
6650 DFDPFN = 5      primary file name (8)
6660 DFDELN = 16     entry length
6670 * values for file flag
6680 DFDEUU = 0      entry unused
6690 DFDEDE = $80    entry deleted
6700 DFDINU = $40    entry in use
6710 DFDOUT = 1      file opened for output
6720 DFDLOC = $20    entry locked
6730 DFDNLD = 2      file has new type sector len byte
6740 * with bit 6 reset, the value of 3 indicates entry in use
6750 * by a file which uses enhanced sector(s)
6760 *
6770 * file directory sector buffer
6780 *
6790 FILDIR *= *+128 resume file dir space
6800     .PAGE "VOLUME DIRECTORY"
6810 * VTOC offsets
6820 DVDTCD = 0      volume directory type code
6830 DVDMSN = 1      max sectors number (1)
6840 DVDNSA = 3      no sectors avail
6850 DVDWRQ = 5      write required
6860 DVDSMP = 10     sector map start
6870 DVDESA = 138    no enhanced sectors avail
6880     .LOCAL 
6890     .PAGE "RAMDISK ACCESS"
6900 *
6910 * read/write to ramdisk
6920 *
6930 DRIVE8 LDA DCBSEC lo sector in ZBUFP
6940     STA ZBUFP
6950     PHP         save read/write
6960     LDA DCBSEC+1 hi sector in accu
6970     ASL ZBUFP   sector * 2
6980     ROL A
6990     CMP #4      test for $400
7000     BCC :GOON   br if less (sector 0-511)
7010     PLP         otherwise, balance stack
7020     LDY #$8B    and rtn with device NAK error (# 139)
7030     BNE :EXIT
7040 * select bank
7050 * on entry: msb sector*2 (0-3) in accu
7060 * lsb sector*2 in ZBUFP
7070 :GOON JSR XBANK switch
7080     LDA ZBUFP
7090     SEC 
7100     ROR A
7110     LSR A
7120     STA BUFRHI  bit 6 set (point to $4000-7FFF area), plus sector/2
7130     LDA #0
7140     ROR A
7150     STA BUFRLO  bit 7 of lo pointer set if sector # not even
7160     LDA DCBBUF  move buff addr to zp ptr
7170     STA ZBUFP
7180     LDA DCBBUF+1
7190     STA ZBUFP+1
7200     LDY #$7F    index for 128 bytes
7210     PLP         recall read/write
7220     BCC :READ   go read
7230 * write to ramdisk
7240 :WRITE LDA (ZBUFP),Y move from buffer
7250     STA (BUFRLO),Y to mem bank
7260     DEY 
7270     BPL :WRITE
7280     BMI :DONE
7290 * read from ramdisk
7300 :READ LDA (BUFRLO),Y move from mem bank
7310     STA (ZBUFP),Y to buffer
7320     DEY 
7330     BPL :READ
7340 * select main memory
7350 :DONE LDA #4    select main
7360     JSR SBANK   switch
7370     LDY #$C0    enable NMI
7380     STY NMIEN
7390     LDY #0      clear critic i/o
7400     STY CRITIC
7410     CLI         enable IRQ
7420     INY         set o.k. status
7430 :EXIT RTS 
7440     .BYTE 0,0,0 filler bytes