0100     .OPT NO LIST
0110 ;##############################
0120 ;#                            #
0130 ;#  192K RAMDISK CONTROLLER   #
0140 ;#    FOR ATARI 256K XL/XE    #
0150 ;#                            #
0160 ;# STICHTING ATARI GEBRUIKERS #
0170 ;#       HARDWARE GROUP       #
0180 ;#        POSTBUS 2095        #
0190 ;#  5202 CB s'HERTOGENBOSCH   #
0200 ;#                            #
0210 ;#----------------------------#
0220 ;#                            #
0230 ;# CONTRIBUTING PROGRAMMERS:  #
0240 ;#                            #
0250 ;#       CLAUS BUCHHOLTZ      #
0260 ;#       PETER WALGREEN       #
0270 ;#        GUUS ASSMANN        #
0280 ;#         TON v.ROSMALEN     #
0290 ;#        KARL LUBARSKY       #
0300 ;#                            #
0310 ;#----------------------------#
0320 ;#                            #
0330 ;# 256K XL/XE MEMORY UPGRADE  #
0340 ;#  DESIGN BY GUUS ASSMANN    #
0350 ;#                            #
0360 ;#----------------------------#
0370 ;#                            #
0380 ;#     PROGRAM EDITED AND     #
0390 ;#         COMPILED BY        #
0400 ;#        KARL LUBARSKY       #
0410 ;#                            #
0420 ;#----------------------------#
0430 ;#                            #
0440 ;# STICHTING ATARI GEBRUIKERS #
0450 ;#       POSTBUS 180          #
0460 ;#     4130 ED  VIANEN        #
0470 ;#                            #
0480 ;##############################
0490 ;
0500 ;
0510 ;
0520 ; OPTIONS: Drive numbers and density
0530 ; Note: if DENSITY=DOUBLE
0540 ;      then DRIVEA=DRIVEB !!!
0550 ;
0560 ;
0570 ;
0580 DRIVEA = 3
0590 DRIVEB = 4
0600 DENSITY = SINGLE
0610 ;
0620 ;
0630 ; SYS.EQUATES: 
0640 ;
0650 ;
0660 SINGLE = $80    ;Sector lengths
0670 DOUBLE = $00
0680 DDEVIC = $0300  ;SIO Device Control Block
0690 DUNIT = $0301
0700 DCOMND = $0302
0710 DSTATS = $0303
0720 DBUFLO = $0304
0730 DBYTLO = $0308
0740 DAUX1 = $030A
0750 ICHID = $0340
0760 ICDNO = $0341
0770 ICCOM = $0342
0780 ICSTA = $0343
0790 ICBAL = $0344
0800 ICBAH = $0345
0810 ICPTL = $0346
0820 ICPTH = $0347
0830 ICBLL = $0348
0840 ICBLH = $0349
0850 ICAX1 = $034A
0860 ICAX2 = $034B
0870 CIOV =  $E456
0880 DOSINI = $0C
0890 CHKSUM = $31    ;Temporary checksum
0900 BUFRLO = $32    ;Temporary pointer to user's buffer
0910 ZTEMP = $34     ;Temporary miscellaneous use
0920 ZTEM2 = $38     ;Temporary miscellaneous use
0930 STACKP = $0318  ;Stack pointer save
0940 PORTB = $D301   ;PIA port B-memory control register
0950 PORTA = $D300   ;PIA port A register
0960 PACTL = $D302   ;PIA port A control register
0970 NMIEN = $D40E
0980 ;
0990 ;
1000 ; Check for 64,128 or 256 K
1010 ;
1020 ; Load-time code - Copy OS into RAM
1030 ;
1040     *=  $3000
1050 ;
1060 ;
1070 TXT130 .BYTE "$)......   "
1080     .BYTE "Setting up ATARI 130XE Ram Disk",$9B
1090     .BYTE ".....            "
1100     .BYTE " please wait"
1110 TXT256 .BYTE "$)......   "
1120     .BYTE "Setting up ATARI 256Kb Ram Disk",$9B
1130     .BYTE ".....            "
1140     .BYTE " please wait"
1150 ;
1160 ; IF $D0=1 THEN 130XE
1170 ;
1180 ; IF $D0=2 THEN 256Kb XL
1190 ;
1200 GO
1210     LDY #2      ;START TEST
1220     STY $4444
1230     LDA PORTB
1240     STA $CC
1250     AND #$AF
1260     STA PORTB
1270     DEY 
1280     STY $4444
1290     LDA $CC
1300     STA PORTB
1310     CPY $4444
1320     BEQ NOXE
1330     LDA $CC
1340     AND #$EF
1350     STA PORTB
1360     CPY $4444
1370     BNE XL256
1380 XE130 LDA #1
1390     STA $D0
1400     BNE NOXE
1410 XL256 LDA #2
1420     STA $D0
1430 NOXE LDA $CC
1440     STA PORTB
1450     LDA $D0
1460     CMP #1
1470     BEQ XE
1480     CMP #2
1490     BEQ XL
1500     RTS 
1510 XL  JSR PTEXT
1520     JMP COS
1530 XE  LDX #0
1540     LDA #11
1550     STA ICCOM,X
1560     LDA #TXT130&255
1570     STA ICBAL,X
1580     LDA #TXT130/256
1590     STA ICBAH,X
1600     LDA #71
1610     STA ICBLL,X
1620     LDA #0
1630     STA ICBLH,X
1640     JSR CIOV
1650     LDA #8
1660     STA 1920
1670     STA 2953
1680     LDA $070A
1690     ORA #$80
1700     STA $070A
1710     JSR $07E0
1720     LDX #$20
1730     LDA #254
1740     STA ICCOM,X
1750     LDA #DRVNUM&255
1760     STA ICBAL,X
1770     LDA #DRVNUM/256
1780     STA ICBAH,X
1790     LDA #0
1800     STA ICAX1,X
1810     STA ICAX2,X
1820     JSR CIOV
1830     LDX #$20
1840     LDA #3
1850     STA ICCOM,X
1860     LDA #DUP1&255
1870     STA ICBAL,X
1880     LDA #DUP1/256
1890     STA ICBAH,X
1900     LDA #4
1910     STA ICAX1,X
1920     LDA #0
1930     STA ICAX2,X
1940     JSR CIOV
1950     LDA #7
1960     STA ICCOM,X
1970     LDA #0
1980     STA ICBAL,X
1990     STA ICBLL,X
2000     LDA #$50
2010     STA ICBAH,X
2020     STA ICBLH,X
2030     JSR CIOV
2040     BPL NXT
2050     CPY #$88
2060     BEQ NXT
2070     RTS 
2080 NXT LDA #12
2090     STA ICCOM,X
2100     JSR CIOV
2110     LDA #3
2120     LDX #$20
2130     STA ICCOM,X
2140     LDA #DUP8&255
2150     STA ICBAL,X
2160     LDA #DUP8/256
2170     STA ICBAH,X
2180     LDA #8
2190     STA ICAX1,X
2200     LDA #0
2210     STA ICAX2,X
2220     JSR CIOV
2230     LDA #11
2240     STA ICCOM,X
2250     LDA #$00
2260     STA ICBAL,X
2270     LDA #$50
2280     STA ICBAH,X
2290     LDA #$11
2300     STA ICBLL,X
2310     LDA #$14
2320     STA ICBLH,X
2330     JSR CIOV
2340     LDA #12
2350     STA ICCOM,X
2360     JSR CIOV
2370     LDA #3
2380     LDX #$20
2390     STA ICCOM,X
2400     LDA #MEM8&255
2410     STA ICBAL,X
2420     LDA #MEM8/256
2430     STA ICBAH,X
2440     LDA #8
2450     STA ICAX1,X
2460     LDA #0
2470     STA ICAX2,X
2480     JSR CIOV
2490     LDA #12
2500     STA ICCOM,X
2510     JSR CIOV
2520     LDA #'8
2530     STA $153F
2540     RTS 
2550 DRVNUM .BYTE "D8:",$9B
2560 DUP1 .BYTE "D1:DUP.SYS",$9B
2570 DUP8 .BYTE "D8:DUP.SYS",$9B
2580 MEM8 .BYTE "D8:MEM.SAV",$9B
2590 COS LDA #$C0    ;Zero page pointer
2600     STA $CC
2610 ;
2620     STA $CE
2630     LDA #0
2640     STA $CB
2650     STA $CD
2660     LDY #$00
2670 LOOP
2680     LDA NMIEN   ;Disable NMI interrupts
2690     PHA         ;Save NMIEN
2700     AND #$00
2710     STA NMIEN
2720     SEI         ;Disable IRQ
2730     LDA ($CB),Y ;Copy OS
2740     PHA         ;save value
2750     LDA PORTB
2760     EOR #1      ;Disable OS Rom
2770     STA PORTB
2780     PLA 
2790     STA ($CD),Y
2800     LDA PORTB
2810     EOR #1      ;Enable OS Rom
2820     STA PORTB
2830     PLA 
2840     STA NMIEN   ;Restore NMIEN
2850     CLI         ;Enable IRQ
2860     INY 
2870     BNE LOOP
2880     LDX $CC
2890     CPX #$CB    ;Skip pages $CC to D7
2900     BNE NXPG
2910     LDX #$D7
2920     STX $CE
2930 NXPG
2940     INC $CE
2950     INX 
2960     STX $CC
2970     BNE LOOP
2980     LDA PORTB
2990     EOR #$01    ;Enable RAM OS
3000 ;
3010     STA PORTB
3020     STX PORTA   ;PA7 = 0
3030     RTS 
3040 ;
3050 PTEXT
3060     LDX #0
3070     LDA #11
3080     STA ICCOM,X
3090     LDA #TXT256&255
3100     STA ICBAL,X
3110     LDA #TXT256/256
3120     STA ICBAH,X
3130     LDA #71
3140     STA ICBLL,X
3150     LDA #0
3160     STA ICBLH,X
3170     JSR CIOV
3180     RTS 
3190     *=  $02E2
3200     .WORD GO
3210 ;
3220 ;
3230 ; Ramdisk controller code
3240 ; RAMDISK CODE REPLACES XL/XE 
3250 ;    INTERNATIONAL CHAR.SET   
3260     *=  $CC00
3270 ;
3280 ;
3290 HOOK
3300     CLC         ;Hook into all SIO calls
3310     LDA DDEVIC
3320     ADC DUNIT
3330     LDY #$00    ;Drive A offset
3340     CMP #$31+DRIVEA ;Right drive number ?
3350     BEQ HOOKED
3360     LDY #$80    ;DRIVEB offset
3370     CMP #$31+DRIVEB
3380     BEQ HOOKED
3390 OLDVEC = *+1
3400     JMP *       ;If not go to SIO
3410 HOOKED
3420     TSX         ;If so intercept
3430     STX STACKP  ;Save stack pointer
3440     STY ZTEM2   ;Store offset
3450     LDA DCOMND  ;Examine command
3460     CMP #'!     ;Format ?
3470     BNE NOFMT
3480     JMP FORMAT
3490 NOFMT
3500     CMP #'P     ;Put sector ?
3510     BNE NOPUT
3520     JMP PUTSEC
3530 NOPUT
3540     CMP #'R     ;Read sector ?
3550     BNE NOSET
3560     JMP GETSEC
3570 NOSET
3580     CMP #'S     ;Read status ?
3590     BNE NOSTT
3600     JMP STATUS
3610 NOSTT
3620     CMP #'W     ;Write sector ?
3630     BNE NAKRET
3640     JMP PUTSEC
3650 ;
3660 ; Returns-Restore stack pointer,report error status and return
3670 ;
3680 NAKRET
3690     LDX STACKP
3700     TXS 
3710     LDY #139    ;NAK error for improper cmnd
3720     STY DSTATS
3730     LDA #0
3740     STA PAFLG
3750     JMP PAOUT
3760 ERRRET
3770     LDX STACKP
3780     TXS 
3790     LDY #144    ;Bad sector erro
3800     STY DSTATS
3810     LDA #0
3820     STA PAFLG
3830     JMP PAOUT
3840 SUCRET
3850     LDX STACKP
3860     TXS 
3870     LDY #1      ;No error
3880     STY DSTATS
3890     LDA #0
3900     STA PAFLG
3910     JMP PAOUT
3920 ;
3930 ; Subroutine - Set pointer to user buffer
3940 ;
3950 SETBUF
3960     LDA DBUFLO  ;Move from DCB to zero page
3970     STA BUFRLO
3980     LDA DBUFLO+1
3990     STA BUFRLO+1
4000     RTS 
4010 ;
4020 ; Subroutine - Prepare to acces sector of ramdisk
4030 ;
4040 SETSEC
4050     LDA #DENSITY
4060     STA SECLEN  ;Set sector length
4070     LDA DAUX1+1 ;Check sector #
4080     BNE NDTZ
4090     LDA DAUX1
4100     BEQ OUTRS   ;Sector 0 invalid
4110     CMP #4
4120     BCS INRNS
4130     LDA #$80    ;Sectors 1-3 always 128 bytes long
4140     STA SECLEN
4150     BNE INRNS
4160 OUTRS
4170     JMP NAKRET  ;Sector # out of range
4180 NDTZ
4190     CMP #2      ;Check for sector
4200     BCC INRNS
4210     BNE OUTRS
4220     LDA #$D0
4230     CMP DAUX1
4240     BCC OUTRS
4250 INRNS
4260     LDA DAUX1   ;Sector # valid
4270     STA ZTEMP
4280     LDA DAUX1+1
4290     ASL ZTEMP
4300     ROL A       ;Divide # by 64-Result is bank #, remainder is page #
4310     ASL ZTEMP
4320     ROL A
4330     ADC #4      ;Bank #
4340     TAX 
4350     LDA ZTEMP
4360     LSR A
4370     LSR A
4380     ADC #$40    ;Remainder+64
4390 ;
4400 ; Subroutine- Prepaire to switch banks;
4410 ; X is bank, A is page #
4420 ;
4430 SETBNK
4440     STA ZTEM2+1 ;Save page #
4450     LDA #$80    ;PA7 output
4460     STA PAFLG
4470     JSR PAOUT
4480     LDA PORTB
4490     STA PBN     ;Normal bank
4500     AND #$A3
4510     STA PB      ;Bank 0
4520     LDA #0
4530     STA PA
4540     TXA         ;Bank# in accu
4550     CLC 
4560     CMP #$0C    ;Bank# <12 ?
4570     BCC SBNKA   ;Yes,jump
4580     LDA #$80    ;Banks 12 to 15
4590     STA PA      ;PA7 = 1
4600 SBNKA
4610     TXA         ;Bank# in accu
4620     CLC 
4630     CMP #8      ;Bank# <8 ?
4640     BCC SBNKB   ;Yes, jump
4650     LDA #$40    ;Banks 8 to 15
4660     ORA PB
4670     STA PB      ;PB4 & PB6= 1
4680 SBNKB
4690     TXA         ;Bank# in accu
4700     AND #3      ;Only bits 0 and 1
4710     ASL A
4720     ASL A       ;Shift 2 pos left
4730     ORA PB
4740     STA PB      ;Bank X in PB
4750     LDA $FFFA   ;NMI vector
4760     STA ZTEMP
4770     LDA $FFFB
4780     STA ZTEMP+1
4790     LDY #0
4800     LDA #$40    ;RTI opcode
4810     SEI         ;Disable IRQ
4820     STA (ZTEMP),Y ;Place RTI in NMI routine-disables NMI
4830     RTS         ;Leave 0 in Y, bank # in X
4840 ;
4850 ; Format routine
4860 ;
4870 FORMAT
4880     LDX #4      ;Clear banks 4 to F
4890 CLOOP1
4900     LDA #$40
4910     JSR SETBNK  ;Prepare for switch
4920     LDA PA
4930     STA PORTA
4940     LDA PB
4950     STA PORTB   ;Switch bank in
4960     TYA 
4970 CLOOP2
4980     STA (ZTEM2),Y ;Zero entire sector
4990     INY 
5000     CPY SECLEN
5010     BNE CLOOP2
5020     TAY 
5030     INC ZTEM2+1 ;Next page
5040     BPL CLOOP2
5050     LDA PBN
5060     STA PORTB   ;Switch bank out
5070     LDA #0
5080     STA PORTA
5090     LDA NMI
5100     STA (ZTEMP),Y ;Enable interrupts
5110     CLI 
5120     INX         ;Next bank
5130     CPX #$10    ;Done ?
5140     BCC CLOOP1
5150     JSR SETBUF
5160     LDA #$FF    ;Return a sector with 2 FF's and the rest 0's
5170     LDY #0
5180 FLOOP
5190     CPY #2
5200     BNE NOTFF
5210     LDA #0
5220 NOTFF
5230     STA (BUFRLO),Y
5240     INY 
5250     CPY SECLEN
5260     BNE FLOOP
5270     JMP SUCRET  ;Done
5280 ;
5290 ; Write sector routine
5300 ;
5310 PUTSEC
5320     JSR SETBUF
5330     LDA #0
5340     STA CHKSUM  ;Zero checksum
5350     JSR SETSEC  ;Point to ramdisk sector
5360 PLOOP
5370     LDA (BUFRLO),Y ;Get byte from user's buffer
5380     LDX PA
5390     STX PORTA
5400     LDX PB
5410     STX PORTB   ;Switch bank
5420     STA (ZTEM2),Y ;Put byte into ramdisk
5430     LDX PBN
5440     STX PORTB   ;Normal bank
5450     LDX #0
5460     STX PORTA
5470     CLC 
5480     ADC CHKSUM  ;Add byte to checksum
5490     STA CHKSUM
5500     INY 
5510     CPY SECLEN  ;Proper sector lenhth
5520     BNE PLOOP
5530     LDX #$0F    ;Bank F holds checksum table
5540     LDA DAUX1
5550     ASL A
5560     LDA DAUX1+1
5570     ROL A
5580     ORA #$60    ;Sector # indexes checksum table
5590     JSR SETBNK
5600     LDA DAUX1
5610     AND #$7F
5620     TAY 
5630     LDA CHKSUM
5640     LDX PA
5650     STX PORTA
5660     LDX PB
5670     STX PORTB   ;Switch bank
5680     STA (ZTEM2),Y ;Store checksum
5690     LDX PBN
5700     STX PORTB   ;Normal bank
5710     LDX #0
5720     STX PORTA
5730     LDY #0
5740     LDA NMI
5750     STA (ZTEMP),Y ;Enable interrupts
5760     CLI 
5770     JMP SUCRET  ;Done
5780 ;
5790 ; Read sector routine
5800 ;
5810 GETSEC
5820     JSR SETBUF
5830     LDA #0
5840     STA CHKSUM  ;Zero checksum
5850     JSR SETSEC
5860 GLOOP
5870     LDX PA
5880     STX PORTA
5890     LDX PB
5900     STX PORTB   ;Switch bank
5910     LDA (ZTEM2),Y ;Get byte from ramdisk
5920     LDX PBN
5930     STX PORTB   ;Normal bank
5940     LDX #0
5950     STX PORTA
5960     STA (BUFRLO),Y ;Put byte into user's buffer
5970     CLC 
5980     ADC CHKSUM  ;Add to checksum
5990     STA CHKSUM
6000     INY 
6010     CPY SECLEN  ;Proper sector length
6020     BNE GLOOP
6030     LDX #$0F    ;Bank F for checksum table
6040     LDA DAUX1
6050     ASL A
6060     LDA DAUX1+1
6070     ROL A
6080     ORA #$60
6090     JSR SETBNK
6100     LDA DAUX1
6110     AND #$7F
6120     TAY 
6130     LDX PA
6140     STX PORTA
6150     LDX PB
6160     STX PORTB   ;Switch bank
6170     LDA (ZTEM2),Y ;Set original checksum
6180     LDX PBN
6190     STX PORTB   ;Normal bank
6200     LDX #0
6210     STX PORTA
6220     TAX 
6230     LDY #0
6240     LDA NMI
6250     STA (ZTEMP),Y ;Enable interrupts
6260     CLI 
6270     CPX CHKSUM  ;Compare checksums
6280     BEQ SCSOK
6290     JMP ERRRET  ;If different bad sector
6300 SCSOK
6310     JMP SUCRET  ;If same, done
6320 ;
6330 ; Read status routine
6340 ;
6350 STATUS
6360     JSR SETBUF
6370     LDY #3      ;Returns 4 bytes
6380     LDA #0      ;All 0's
6390 SLOOP
6400     STA (BUFRLO),Y
6410     DEY 
6420     BPL SLOOP
6430     CMP #DENSITY
6440     BNE SDONE
6450     LDA #$20
6460     INY 
6470     STA (BUFRLO),Y ;First byte tells density of drive
6480 SDONE
6490     JMP SUCRET  ;Done
6500 ;
6510 ;Subroutine for PA7 output
6520 ;
6530 PAOUT
6540 ;
6550     LDA PACTL
6560     EOR #4
6570     STA PACTL
6580     LDA PAFLG
6590     STA PORTA
6600     LDA PACTL
6610     EOR #4
6620     STA PACTL
6630     LDA #0
6640     STA PORTA
6650     RTS 
6660 ;
6670 ; Variable storage area
6680 ;
6690 PAFLG *= *+1    ;Flag PORTA,$80=output,0=input
6700 PA  *=  *+1     ;value of mem.contr.reg. for selected bank
6710 PB  *=  *+1     ;Value of mem.contr.reg. for selected bank
6720 PBN *=  *+1     ;Value of mem.contr.reg. for normal bank
6730 NMI *=  *+1     ;First opcode in NMI routine-Used to restore NMI
6740 SECLEN *= *+1   ;Length of current sector
6750 ;
6760 ; RESET initialisation routine
6770 ;
6780     *=  $0100   ;Hidden (hopefully !!!)
6790 ;
6800 NEWINI
6810     DEC PORTB   ;Enable RAM OS
6820     LDA #$80
6830     STA PAFLG
6840     JSR PAOUT
6850 OLDINI = *+1
6860     JSR *       ;Call original DOSINI routine
6870 MODINI
6880     LDA #NEWINI&$FF ;Set hook for next RESET
6890     STA DOSINI
6900     LDA #NEWINI/$0100
6910     STA DOSINI+1
6920     RTS 
6930 ;
6940 ; Load-time code-Install ramdisk
6950 ;
6960     *=  $4200
6970 DO
6980     LDA $D0
6990     CMP #2
7000     BEQ CONT
7010     JMP END
7020 CONT
7030     LDA $E45A   ;Save original SIO vector
7040     STA OLDVEC
7050     LDA $E45B
7060     STA OLDVEC+1
7070     LDA #HOOK&$FF ;Install new SIO vector
7080     STA $E45A
7090     LDA #HOOK/$0100
7100     STA $E45B
7110     LDA $FFFA   ;Save first opcode in NMI routine
7120     STA $CB
7130     LDA $FFFB
7140     STA $CC
7150     LDY #0
7160     LDA ($CB),Y
7170     STA NMI
7180     LDA DOSINI  ;Save original dosini vector
7190     STA OLDINI
7200     LDA DOSINI+1
7210     STA OLDINI+1
7220     JSR MODINI  ;Install new one
7230     LDA $070A
7240     ORA #12     ;DRIVE #3&4
7250     STA $070A
7260     JSR $07E0   ;Reinitialize FMS to show ramdisk present
7270     JMP BEG     ;Done
7280 ;
7290 ;
7300 ;FORMAT CODE - Format Ramdisk
7310 ;
7320     *=  $4300
7330     .BYTE "D4:",9 B
7340     .BYTE "D3:",9 B
7350 ;
7360 BEG
7370     LDX #$20    ;IOCB # 2
7380     LDA #$FE    ;FORMAT D4:
7390     STA ICCOM,X
7400     LDA #0
7410     STA ICBAL,X
7420     LDA #$43
7430     STA ICBAH,X
7440     JSR CIOV
7450     BPL DRIV3
7460     RTS 
7470 ;
7480 DRIV3
7490     LDA #$FE
7500     STA ICCOM,X
7510     LDA #4
7520     STA ICBAL,X
7530     LDA #$43
7540     STA ICBAH,X
7550     JSR CIOV
7560     BPL DUPOPN
7570     RTS         ;Error-return
7580 ;
7590     *=  $4340
7600 ;
7610 ;DUPLICATE DUP TO RAMDISK
7620 ;
7630     .BYTE "D1:DUP.SYS",9 B
7640 ;
7650 DUPOPN
7660 ;
7670     LDX #$20    ;IOCB # 2
7680     LDA #$03    ;OPEN D1:DUP.SYS
7690     STA ICCOM,X ;FOR READ
7700     LDA #$40
7710     STA ICBAL,X
7720     LDA #$43
7730     STA ICBAH,X
7740     LDA #$04
7750     STA ICAX1,X
7760     LDA #0
7770     STA ICAX2,X
7780     JSR CIOV
7790     BPL DUPRD
7800     RTS         ;Error-return
7810 ;
7820 ;
7830 ;READ D1:DUP.SYS
7840 ;
7850 DUPRD
7860 ;
7870     LDA #7      ;GET BINARY RECORD
7880     STA ICCOM,X
7890     LDA #0
7900     STA ICBAL,X ;BUFFER AT $5000
7910     LDA #$50
7920     STA ICBAH,X
7930     LDA #$00
7940     STA ICBLL,X ;$220B BYTES (8715)
7950     LDA #$23
7960     STA ICBLH,X
7970     JSR CIOV
7980     BPL DUPCL1
7990     CPY #$88    ;END OF FILE ?
8000     BEQ DUPCL1
8010     RTS         ;Error-return
8020 ;
8030 ;
8040 ;CLOSE # 2
8050 ;
8060 DUPCL1
8070 ;
8080     LDA #$0C    ;CLOSE D1:DUP.SYS
8090     STA ICCOM,X
8100     JSR CIOV
8110     BPL DUPOPN1
8120     RTS         ;Error-return
8130 ;
8140 ;WRITE D4:DUP.SYS
8150 ;
8160 ;
8170     *=  $43A0
8180 ;
8190     .BYTE "D4:DUP.SYS",9 B
8200 ;
8210 DUPOPN1
8220 ;
8230     LDX #$20    ;IOCB # 2
8240     LDA #$03    ;OPEN D4:DUP.
8250     STA ICCOM,X ;FOR WRITE
8260     LDA #$A0
8270     STA ICBAL,X
8280     LDA #$43
8290     STA ICBAH,X
8300     LDA #$08
8310     STA ICAX1,X
8320     LDA #0
8330     STA ICAX2,X
8340     JSR CIOV
8350     BPL DUPWRT
8360     RTS         ;Error-return
8370 ;
8380 ;
8390 ;WRITE D4:DUP.SYS
8400 ;
8410 DUPWRT
8420 ;
8430     LDA #$0B    ;PUT BINARY RECORD
8440     STA ICCOM,X
8450     LDA #0
8460     STA ICBAL,X ;BUFFER AT $5000
8470     LDA #$50
8480     STA ICBAH,X
8490     LDA #$11
8500     STA ICBLL,X ;$1411 BYTES
8510     LDA #$14
8520     STA ICBLH,X
8530     JSR CIOV
8540     BPL DUPCL2
8550     RTS         ;Error-return
8560 ;
8570 ;
8580 ;CLOSE # 2
8590 ;
8600 DUPCL2
8610 ;
8620     LDA #$0C    ;CLOSE D4:DUP.SYS
8630     STA ICCOM,X
8640     JSR CIOV
8650     BPL FIN
8660     RTS         ;Error-return
8670 ;
8680 ;
8690 ;WRITE  MEM.SAV TO DRIVE #4
8700 ;
8710 FIN
8720     LDX #$20
8730     LDA #3
8740     STA ICCOM,X
8750     LDA #MEM4&255
8760     STA ICBAL,X
8770     LDA #MEM4/256
8780     STA ICBAH,X
8790     LDA #8
8800     STA ICAX1,X
8810     LDA #0
8820     STA ICAX2,X
8830     JSR CIOV
8840     LDA #12     ;CLOSE MEM.SAV
8850     LDX #$20
8860     STA ICCOM,X
8870     JSR CIOV
8880 ;
8890 ;
8900 ;
8910     LDA #'4
8920     STA $153F
8930 END LDA #11     ;CLEAN UP THE
8940     LDX #$00    ;SCREEN
8950     STA ICCOM,X
8960     LDA #CLS&255
8970     STA ICBAL,X ;THANK-YOU
8980     LDA #CLS/256
8990     STA ICBAH,X
9000     LDA #1
9010     STA ICBLL,X
9020     LDA #0
9030     STA ICBLH,X
9040     JMP CIOV
9050 CLS .BYTE $7D
9060 MEM4 .BYTE "D4:MEM.SAV"
9070     *=  $02E2
9080     .WORD DO    ;AND GOODBYE!