10 LISTFLAG = 0
20         .IF LISTFLAG=0
30         .OPT NO LIST
40         .ENDIF 
50 ;SAVE#D3:ARC:ARC.M65
60 ;ASM,,#D3:ARC:ARC.OBJ
70 ;
80 ;    ** SUPER ARC 2.4 **
90 ; By: Robert Puff  01/24/89
0100 ;
0110     *=  $2000
0120     RTS 
0130 ;
0140 DLIST1 .BYTE $70,$70,$70,$42
0150 DL1SC .WORD 0
0160     .BYTE 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,$41
0170     .WORD DLIST1
0180 DLIST2 .BYTE 112,112,112,112,112,112,112,112,112,112,112,112,112,112,$42
0190     .WORD LINE1
0200     .BYTE $41
0210     .WORD DLIST2
0220 LINE1 .SBYTE " Compacting                             "
0230 ;
0240 ASMTEMP = *
0250 ;
0260 PRZP =  $80
0270 SBZLEN = $82    ;3 BYTES
0280 DBZLEN = $85    ;3 BYTES
0290 CRC =   $88
0300 SRCLEN = $8A    ;3 BYTES
0310 REPFLG = $8D    ;PACKING VARS:
0320 LASTBY = $8E
0330 COUNTR = $8F
0340 NOLAST = $90
0350 SAVEB = $91
0360 SAVEB2 = $EF
0370 PAKLEN = $92    ;3 BYTES
0380 ;
0390 ;
0400 CLEAR_FLG = $95
0410 OFFSET = $96
0420 CHAR =  $97
0430 BITS =  $98
0440 FREE_ENT = $99
0450 CODE =  $9B
0460 B_OUT = $9D     ;3 BYTES
0470 DISP =  $A0
0480 KLUDGE = $A2
0490 TIME =  $A3
0500 DATE =  $A5
0510 ;
0520 ;
0530 QUERY = $A7
0540 SBUFF = $A8
0550 SBLEN = $AA
0560 DBUFF = $AC
0570 DBLEN = $AF
0580 SCROFF = $B1
0590 SWAPFLG = $C2
0600 PRINTEMP = $C3  ;WORD
0610 PREBFR = $C5
0620 TEMP2 = $C7
0630 ;
0640 ONEDRIVE = $C9
0650 BATCHFLG = $CA
0660 SRCFLEN = $CB
0670 DOSSTACK = $CC
0680 CRUNONLY = $CD
0690 PASSFLG = $CE
0700 SPARTAF = $CF
0710 PASSLOC = $D0
0720 PASSLEN = $D1
0730 ONETIME = $D2
0740 MYDOS = $D3
0750 ;
0760 N_BITS = $F0
0770 FIRST_CMP = $F1
0780 MAXCODE = $F2
0790 B_REF = $F4
0800 B_LAST = $F6
0810 IN_COUNT = $F8
0820 IVAR =  $FA
0830 ENT =   $FC
0840 ;
0850 ;
0860 INITPT1 LDA 709
0870     STA RESTCLR
0880     LDA 710
0890     STA RESTCLR+1
0900     LDA $6A
0910     CMP #$C0
0920     BCS CLC1
0930     LDA $0700
0940     CMP #'S
0950     BEQ CLC1
0960     LDA $D301
0970     AND #2
0980     BNE CLC1
0990     LDA $03F8
1000     ORA $03FA
1010     BNE CLC1
1020     INC $03F8
1030     LDA $D301
1040     ORA #2
1050     STA $D301
1060     LDA #$C0
1070     STA $6A
1080     JSR CLOSE0
1090     JSR DOIO
1100     .BYTE 0,3
1110     .WORD EDEV,0,$0C
1120 CLC1 JSR CLOSE1
1130     JSR CLOSE2
1140     JSR CLOSE3
1150     JSR DOIO
1160     .BYTE $30,3 ;OPEN K:
1170     .WORD KDEV,0,4
1180     LDA $58
1190     STA DL1SC
1200     LDA $59
1210     STA DL1SC+1
1220     LDA $02E5
1230     SEC 
1240     SBC #[ENDOFPRG+$512E]&255
1250     STA SBLEN
1260     LDA $02E6
1270     SBC #[ENDOFPRG+$512E]/256
1280     STA SBLEN+1
1290 ;
1300     LDA $02E6
1310     SEC 
1320     SBC $02E8
1330     CMP #$74
1340     BCS MEMOK
1350     LDX #OUTMEM&255
1360     LDY #OUTMEM/256
1370     JSR PRINT
1380     PLA 
1390     PLA 
1400     JMP DUMPOUT
1410 OUTMEM .BYTE 155,"Error: Not enough free memory!}",155,0
1420 MEMOK LSR SBLEN+1
1430     ROR SBLEN
1440     LDA #[ENDOFPRG+$512E]&255
1450     STA SBUFF
1460     CLC 
1470     ADC SBLEN
1480     STA DBUFF
1490     LDA #[ENDOFPRG+$512E]/256
1500     STA SBUFF+1
1510     ADC SBLEN+1
1520     STA DBUFF+1
1530     LDA SBLEN
1540     STA DBLEN
1550     LDA SBLEN+1
1560     STA DBLEN+1
1570     LDA #ENDOFPRG&255
1580     STA PREBFR
1590     LDA #ENDOFPRG/256
1600     STA PREBFR+1
1610     LDA #[ENDOFPRG+$4E2D]&255
1620     STA FNBUFF
1630     LDA #[ENDOFPRG+$4E2D]/256
1640     STA FNBUFF+1
1650     LDA #0
1660     STA BATCHFLG
1670     STA SCROFF
1680     STA SCROFF
1690     STA QUERY
1700     STA SWAPFLG
1710     STA CRUNONLY
1720     STA PASSFLG
1730     STA SPARTAF
1740     STA MYDOS
1750     STA ADDFLAG
1760     INC SCROFF
1770     LDA #$CC
1780     STA 709
1790     LDA #$92
1800     STA 710
1810     LDA $0700
1820     CMP #'S
1830     BNE NOPM001
1840     INC SPARTAF
1841 NOPM001 LDY #0
1842     LDA ($0A),Y
1843     CMP #$4C    ;CMD PROC DOS?
1844     BNE NOPM0
1845     LDY #3
1846     LDA ($0A),Y
1847     CMP #$4C
1848     BNE NOPM0
1850     LDA $0A
1860     CLC 
1870     ADC #3
1880     STA CRNAME+1
1890     LDA $0B
1900     ADC #0
1910     STA CRNAME+2
1920     JSR CRNAM2
1930     BEQ NOPARM
1940     LDY #33
1950     LDX #0
1960 SP1 LDA ($0A),Y
1970     STA SFNAME,X
1980     CMP #$9B
1990     BEQ SP2A
2000     INX 
2010     INY 
2020     BNE SP1
2030 NOPARM RTS 
2040 NOPM0 JMP NOPARM0
2050 SP2A JMP SP2
2060 ;
2070 CRNAM2 LDY #10
2080     LDA ($0A),Y
2090     PHA 
2100     JSR CRNAME
2110     PLA 
2120     LDY #10
2130     CMP ($0A),Y
2140     RTS 
2150 CRNAME JMP $FFFF
2160 ;
2170     *=  ASMTEMP
2180 ;
2190 SFNAME .DS 88
2200 DFNAME .DS 88
2210 HEADER .DS 29
2220 DFPATH .DS 60
2230 DSTDNS .DS 12
2240 DNSTMP .DS 12
2250 PASSWORD .DS 21
2260 NOTLOC .DS 3
2270 FTEMP .DS 40
2280 RESTCLR .DS 2
2290 EOFFLG BRK 
2300 FNBUFF .WORD 0
2310 FNLOC .WORD 0
2320 MOREPASS .BYTE 0,0,0
2330 ADDFLAG .BYTE 0
2340 ;
2350     .INCLUDE #D3:ARC:ARC2.M65
2360 ;
2370 ENTSRC LDA #$40
2380     STA $02BE   ;FORCE UPPER CASE
2390     JSR DOIO
2400     .BYTE 0,5
2410     .WORD SFNAME,80,$0C
2420     BMI ?EC1
2430     LDA $0348,X
2440     CMP #3
2450     BCS NINS2
2460 ?EC1 PLA 
2470     PLA 
2480     JMP MAIN
2490 ;
2500 NINS2 LDA SFNAME
2510     LDA SFNAME
2520     CMP #'D
2530     BNE IN26
2540     LDA SFNAME+1
2550     CMP #'1
2560     BCC IN26
2570     CMP #$3B
2580     BCC IN2L
2590 IN26 LDY $0348
2600     DEY 
2610 IN2K LDA SFNAME,Y
2620     STA SFNAME+2,Y
2630     DEY 
2640     BPL IN2K
2650     LDA #'D
2660     STA SFNAME  ;add "D:"
2670     LDA #':
2680     STA SFNAME+1
2690     INC $0348
2700     INC $0348   ;ADD 2
2710 IN2L RTS 
2720 ;
2730 SAVSCR LDA 84
2740     STA FREE_ENT
2750     LDA 85
2760     STA FREE_ENT+1
2770     LDA #$1F
2780     STA 752
2790     JSR EOUTCH
2800     JSR SETVAR
2810     LDX #4
2820     LDY #0
2830     STY 752
2840 DIR1 LDA (CODE),Y
2850     STA (PRZP),Y
2860     INY 
2870     BNE DIR1
2880     INC CODE+1
2890     INC PRZP+1
2900     DEX 
2910     BNE DIR1
2920     RTS 
2930 ;
2940 RSTSCR JSR SETVAR
2950     LDY #0
2960     STY 84
2970     STY 85
2980     INY 
2990     STY 752
3000     LDA #$1F
3010     JSR EOUTCH
3020     LDA #$1E
3030     JSR EOUTCH
3040     DEC 752
3050     LDX #4
3060     LDY #0
3070 DIR9Q LDA (PRZP),Y
3080     STA (CODE),Y
3090     INY 
3100     BNE DIR9Q
3110     INC PRZP+1
3120     INC CODE+1
3130     DEX 
3140     BNE DIR9Q
3150     LDA FREE_ENT
3160     STA 84
3170     LDA FREE_ENT+1
3180     STA 85
3190     LDA #$1F
3200     JSR EOUTCH
3210     LDA #$1E
3220     JSR EOUTCH
3230     LDA #0
3240     TAY 
3250     STA ($58),Y
3260     RTS 
3270 ;
3280 SETVAR LDX #1
3290 SVR1 LDA $58,X
3300     STA CODE,X
3310     LDA PREBFR,X
3320     STA PRZP,X
3330     DEX 
3340     BPL SVR1
3350     RTS 
3360 ;
3370 ;
3380 GETPASS LDX #GETPS1&255
3390     LDY #GETPS1/256
3400     JSR PRINT
3410     JSR DOIO
3420     .BYTE 0,5
3430     .WORD PASSWORD,21,$0C
3440     BPL GPS1
3450 GPS0 LDA #0
3460     STA PASSFLG
3470     LDY OFFTAB2+5
3480     LDX #0
3490 GPS2 LDA NOTAB,X
3500     STA TITLEM,Y
3510     INY 
3520     INX 
3530     CPX #3
3540     BCC GPS2
3550     RTS 
3560 GPS1 LDY $0348
3570     STY PASSLEN ;(LEN+1)
3580     DEY 
3590     BEQ GPS0
3600     DEY 
3610 GPS3 LDA PASSWORD,Y
3620     AND #$7F
3630     CMP #$60
3640     BCC GPS4
3650     SBC #$20    ;CONVERT TO UPPER
3660 GPS4 STA PASSWORD,Y
3670     DEY 
3680     BPL GPS3
3690     RTS 
3700 ;
3710 SCREENON LDA #DLIST1&255
3720     LDX #DLIST1/256
3730     BNE SCR1
3740 ;
3750 SCREENOFF LDY #27
3760     LDA #0
3770 SCR2 STA LINE1+12,Y
3780     DEY 
3790     BPL SCR2
3800     INY 
3810 SCR3 LDA DFNAME,Y
3820     CMP #$20
3830     BEQ SCR4
3840     CMP #$9B
3850     BEQ SCR4
3860     SEC 
3870     SBC #$20
3880     STA LINE1+12,Y
3890     INY 
3900     CPY #28
3910     BCC SCR3
3920 SCR4 LDA #DLIST2&255
3930     LDX #DLIST2/256
3940 SCR1 STA $0230
3950     STX $0231
3960     RTS 
3970 ;
3980 KILLF LDX #DELM&255
3990     LDY #DELM/256
4000     JSR PRINT
4010     JSR CLOSE1
4020     JSR ENTSRC
4030     LDX #REALM&255
4040     LDY #REALM/256
4050     JSR PRINT
4060     JSR GETYESNO
4070     CMP #1
4080     BEQ KIL1
4090     JMP MAIN
4100 KIL1 JSR DOIO
4110     .BYTE $10,33 ;DELETE
4120     .WORD SFNAME,0,0
4130     BPL KIL2
4140     STY $D4
4150     LDA #0
4160     STA $D5
4170     JSR ERT11   ;WILL NOT RETURN
4180 KIL2 LDX #OKMS1&255
4190     LDY #OKMS1/256
4200     JSR PRINT
4210 KIL3 JMP ERT2
4220 ;
4230 GETYESNO JSR KGETCH
4240     CMP #$9B
4250     BNE GY1
4260     LDA #'N
4270 GY1 AND #$1F
4280     CMP #$1B
4290     BNE GY2
4300     JSR ERETURN
4310     LDA #0      ;NO, ESC
4320     SEC 
4330     RTS 
4340 GY2 CMP #$19    ;Y?
4350     BNE GY3
4360     LDA #'Y
4370     JSR EOUTCH
4380     JSR ERETURN
4390     LDA #1
4400     CLC 
4410     RTS 
4420 GY3 CMP #$0E
4430     BNE GETYESNO
4440     LDA #'N
4450     JSR EOUTCH
4460     JSR ERETURN
4470     LDA #0
4480     CLC 
4490     RTS 
4500 ;
4510 DODN5 STX $0304
4520     STY $0305
4530     LDA #12
4540     STA $0308
4550     STA $0306
4560     LDA #0
4570     STA $0309
4580     STA $030A
4590     STA $030B
4600     LDA #$40
4610     STA $0303
4620     LDA #'N
4630     STA $0302
4640     LDA #$31
4650     STA $0300
4660     BCC DODN1
4670     ASL $0303
4680     INC $0302
4690 DODN1 JSR $E459
4700     RTS 
4710 ;
4720 CHKSD LDA SWAPFLG
4730     BEQ CHKS1
4740     LDA SFNAME+1
4750     CMP #':
4760     BNE CHKS2
4770     LDA #'1
4780 CHKS2 STA PRINTEMP
4790     LDA DFNAME+1
4800     CMP #':
4810     BNE CHKS3
4820     LDA #'1
4830 CHKS3 CMP PRINTEMP
4840     BNE CHKS1
4850     LDA #0
4860     STA SCROFF
4870     SEC 
4880     RTS 
4890 CHKS1 CLC 
4900     RTS 
4910 ;
4920 DOSOUR JSR CHKSD
4930     BCS DOSR1
4940     RTS 
4950 DOSR1 LDA ONEDRIVE
4960     CMP #1
4970     BEQ CHKS1
4980     LDA SPARTAF
4990     BEQ DOSRX
5000     JSR CLOSE2
5010     JSR ERRORTRAP
5020 DOSRX LDA #1
5030     STA ONEDRIVE
5040     JSR SCREENON
5050     LDX #INSRC&255
5060     LDY #INSRC/256
5070     JSR PRINT
5080     JSR KGETCH
5090     RTS 
5100 ;
5110 DODEST JSR CHKSD
5120     BCS DOSR2
5130     RTS 
5140 DOSR2 LDA ONEDRIVE
5150     CMP #2
5160     BEQ CHKS1
5170     LDA #2
5180     STA ONEDRIVE
5190     JSR SCREENON
5200     LDX #INDES&255
5210     LDY #INDES/256
5220     JSR PRINT
5230     JSR KGETCH
5240     RTS 
5250 ;
5260 WHDRV .BYTE 155,155,"Which drive to format?",0
5270 WHDNS .BYTE 155,155,"[1] Single or [2] Double Density?",0
5280 SUREM .BYTE 155,"Format, Are you sure?",0
5290 FMTER .BYTE 155,"Error: Bad Format! Check Disk/Drive}",155,0
5300 FMOK .BYTE 155,"Format Completed.  Press RETURN",155,0
5310 DELM .BYTE "D",155,155,"Enter complete filename to delete:",155,0
5320 REALM .BYTE 155,"Delete this file, are you sure?",0
5330 OKMS1 .BYTE 155,"File has been deleted!",0
5340 GETPS1 .BYTE 155,"Enter encryption password:",155,0
5350 ;
5360 FORMAT LDX #WHDRV&255
5370     LDY #WHDRV/256
5380     JSR PRINT
5390 FM1 JSR KGETCH
5400     AND #$7F
5410     CMP #$1B
5420     BNE FM2
5430     RTS 
5440 FM2 CMP #'1
5450     BCC FM1
5460     CMP #$3A
5470     BCS FM1
5480     STA DNSTMP+1
5490     AND #$0F
5500     STA $0301
5510     ORA #$30
5520     JSR EOUTCH
5530     LDA #'D
5540     STA DNSTMP
5550     LDA #':
5560     STA DNSTMP+2
5570     LDA #$9B
5580     STA DNSTMP+3
5590     LDX #DSTDNS&255
5600     LDY #DSTDNS/256
5610     CLC 
5620     JSR DODN5
5630     CPY #138
5640     BCS FM10
5650     LDX #WHDNS&255
5660     LDY #WHDNS/256
5670     JSR PRINT
5680 FM4 JSR KGETCH
5690     AND #$7F
5700     CMP #$1B
5710     BNE FM5
5720     RTS 
5730 FM5 CMP #$31
5740     BEQ FM6
5750     CMP #$32
5760     BNE FM4
5770 FM6 PHA 
5780     JSR EOUTCH
5790     JSR ERETURN
5800     PLA 
5810     AND #1
5820     BNE FM6A
5830     STA DSTDNS+7 ;is 0
5840     LDA #4
5850     STA DSTDNS+5
5860     LDA #1
5870     STA DSTDNS+6
5880     BNE FM7
5890 FM6A LDA #$80
5900     STA DSTDNS+7
5910     ASL A
5920     STA DSTDNS+5
5930     STA DSTDNS+6
5940 FM7 SEC 
5950     LDX #DSTDNS&255
5960     LDY #DSTDNS/256
5970     JSR DODN5
5980     JSR SETDOS
5990 FM10 LDX #SUREM&255
6000     LDY #SUREM/256
6010     JSR PRINT
6020     LDA #$FF
6030     STA 764
6040     JSR GETYESNO
6050     CMP #0
6060     BEQ FM9
6070     JSR CLOSE2
6080     JSR DOIO
6090     .BYTE $20,254
6100     .WORD DNSTMP,0,0
6110     BPL FM12
6120     LDX #FMTER&255
6130     LDY #FMTER/256
6140     JSR PRINT
6150     JSR KGETCH
6160 FM9 RTS 
6170 ;
6180 FM12 LDX #FMOK&255
6190     LDY #FMOK/256
6200     JSR PRINT
6210     JSR KGETCH
6220     RTS 
6230 ;
6240 SETDOS LDA #$FF
6250     STA 8
6260     JMP ($0C)
6270 ;
6280 ENDOFPRG
6290 ;
6300 CALCMEM
6310     LDY #0
6320 EMD7 LDA $031A,Y
6330     CMP #'E
6340     BEQ EMD8
6350     INY 
6360     INY 
6370     INY 
6380     BNE EMD7
6390 EMD8 LDA $031B,Y
6400     STA $1A
6410     LDA $031C,Y
6420     STA $1B
6430     LDY #0
6440     LDA ($1A),Y
6450     STA EMD4+1
6460     INY 
6470     LDA ($1A),Y
6480     STA EMD3+1
6490     LDY #6
6500     LDA ($1A),Y
6510     STA EMD2+1
6520     INY 
6530     LDA ($1A),Y
6540     STA EMD1+1
6550 ;
6560     JMP INITPT1
6570 ;
6580 NOPARM0 LDY #0
6590 NP1 LDX #0
6600 NP5 LDA $1B00,Y ;MYDOS CHECK
6610     CMP CHECKT,X
6620     BEQ NP2
6630 NP4 CPX #0
6640     BEQ NP3
6650     DEY 
6660     DEX 
6670     JMP NP4
6680 NP3 INY 
6690     CPY #$FF
6700     BCC NP1
6710     RTS         ;NOPE!
6720 NP2 INY 
6730     INX 
6740     CPX #7      ;ALL 7 BYTES?
6750     BCC NP5
6760     STX MYDOS   ;YUP
6770     RTS 
6780 CHECKT .BYTE "D1:AUTORU"
6790 ;
6800 NOPARM9 RTS 
6810 SP2 INX 
6820     STX SRCFLEN
6830     JSR CRNAME
6840     BEQ NOPARM9 ;CR AFTER 1ST ENTRY?
6850     LDY #33
6860     INC BATCHFLG
6870 ;
6880 SP31 LDX #0
6890 SP3 LDA ($0A),Y
6900     STA DFPATH,X
6910     CMP #$9B    ;GET PATHNAME
6920     BEQ SP42
6930     INX 
6940     INY 
6950     BNE SP3
6960     BEQ NOPARM9
6970 ;
6980 SP42 LDY #10    ;GET BUFOFF
6990     LDA ($0A),Y
7000     TAY 
7010     LDA $0A
7020     CLC 
7030     ADC #63
7040     STA PRZP
7050     LDA $0B
7060     ADC #0
7070     STA PRZP+1
7080     LDA (PRZP),Y
7090     CMP #$9B
7100     BEQ NOPARM9 ;NO PARMS
7110     INY 
7120     LDA (PRZP),Y
7130     CMP #'/
7140     BNE NOPARM9
7150     INY 
7160 SP6 LDA (PRZP),Y
7170     CMP #'S
7180     BEQ SP7
7190     CMP #'Q
7200     BEQ SP8
7210     CMP #'C
7220     BEQ SP9
7230     CMP #'P
7240     BEQ SP13
7250     CMP #'A
7260     BEQ SP12
7270     CMP #'X
7280     BEQ SP9A
7290     CMP #$20
7300     BEQ SP20
7310 SP19 LDA #0
7320     STA PASSFLG
7330     RTS 
7340 ;
7350 SP7 LDA #0
7360     STA SCROFF
7370 ;
7380 SP10 INY 
7390     BNE SP6
7400     RTS 
7410 ;
7420 SP8 INC QUERY
7430     BNE SP10
7440 ;
7450 SP9 INC CRUNONLY
7460     BNE SP10
7470 ;
7480 SP12 INC ADDFLAG
7490     BNE SP10
7500 ;
7510 SP9A INC SWAPFLG
7520     BNE SP10
7530 ;
7540 SP13 INC PASSFLG
7550     BNE SP10
7560 ;
7570 SP20 INY 
7580     LDA PASSFLG
7590     BEQ SP19
7600     LDX #0
7610 SP21 LDA (PRZP),Y
7620     AND #$7F
7630     CMP #$60
7640     BCC SP23
7650     SBC #$20    ;CONVERT TO UPPER
7660 SP23 STA PASSWORD,X
7670     CMP #$1B
7680     BEQ SP22
7690     CMP #$20
7700     BEQ SP22
7710     INY 
7720     INX 
7730     CPX #21
7740     BCC SP21
7750     BCS SP19
7760 SP22 INX 
7770     STX PASSLEN
7780     RTS 
7790 ;
7800 EDEV .BYTE "E:",155
7810 KDEV .BYTE "K:",155
7820 ;
7830     .OPT LIST
7840     RTS 
7850 WASTED = *-ENDOFPRG
7860       .IF LISTFLAG=0
7870       .OPT NO LIST
7880       .ENDIF 
7890     *=  $02E0
7900     .WORD INIT
