10 LISTFLAG = 0
20         .IF LISTFLAG=0
30         .OPT NO LIST
40         .ENDIF 
50 ;SAVE#D3:ARC:UNARC.M65
60 ;ASM,,#D3:ARC:UNARC.OBJ
70 ;
80 ;    ** SUPER UNARC 2.4 **
90 ; By: Robert Puff  02/01/88
0100 ;
0110     *=  $2000
0120     RTS 
0130 ;
0140 PRZP =  $80
0150 SBZLEN = $82    ;3 BYTES
0160 DBZLEN = $85    ;3 BYTES
0170 CRC =   $88
0180 ALFFLG = $8A
0190 FILLEN = $8B    ;3 BYTES
0200 DATA =  $8E
0210 INTEGER = $8F
0220 BPOS =  $91
0230 NUMNODES = $93
0240 IINT =  $95
0250 CURIN = $97
0260 PACKLEN = $99   ;3 BYTES
0270 ;
0280 CLEAR_FLG = $8E
0290 OFFSET = $8F
0300 SIZE =  $90
0310 N_BITS = $9C
0320 R_OFF = $9D
0330 BITS =  $9E
0340 BP  =   $9F
0350 MAXCODE = $A1
0360 FREE_ENT = $A3
0370 CODE =  $A5
0380 DLEFLG = $A7
0390 NCRDATA = $A8
0400 OLDCODE = $A9
0410 FINCHAR = $AB
0420 STACKP = $C5
0430 INCODE = $AF
0440 ;
0450 L0169 = $A7     ;WORD
0460 L0170 = $A9     ;WORD
0470 L0176 = $AB     ;WORD
0480 L0173 = $AD     ;1BYTE
0490 L0174 = $AE     ;1BYTE
0500 L0180 = $AF     ;WORD
0510 ;
0520 QUERY = $B1
0530 SBUFF = $B2
0540 SBLEN = $B4
0550 DBUFF = $B6
0560 DBLEN = $B8
0570 LISTFLG = $BA
0580 SCROFF = $BB
0590 SWAPFLG = $BC
0600 PRINTEMP = $BD  ;WORD
0610 PREBFR = $BF
0620 SUFBFR = $C1
0630 STACKR = $C3    ;ALL WORDS
0640 ONEDRIVE = $C7
0650 BATCHFLG = $C8
0660 DSTLEN = $C9
0670 SRCLEN = $CA
0680 DOSSTACK = $CB
0690 OVERFLG = $CC
0700 TIMEFLG = $CD
0710 PASSFLG = $CE
0720 SPARTAF = $CF
0730 PASSLOC = $D0
0740 PASSLEN = $D1
0750 ;
0760 ;
0770 DLIST1 .BYTE $70,$70,$70,$42
0780 DL1SC .WORD 0
0790     .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
0800     .WORD DLIST1
0810 DLIST2 .BYTE 112,112,112,112,112,112,112,112,112,112,112,112,112,112,$42
0820     .WORD LINE1
0830     .BYTE $41
0840     .WORD DLIST2
0850 LINE1 .SBYTE "                                        "
0860 ;
0870 ASMTEMP = *
0871 MOVECODE = [ENDOFPRG-[DLIST1-1]]+$6F00
0880 ;
0890 CHKEXRM LDA #0
0900     STA XEMEM
0910     LDA 709
0920     STA RESTCLR
0930     LDA 710
0940     STA RESTCLR+1 ;SAVE COLOR
0950     LDY #$7F
0960 MLJ1 LDA CHKEXR1,Y
0970     STA MOVECODE,Y
0980     DEY 
0990     BPL MLJ1
0991     SEI 
0992     LDA #0
0993     STA $D40E
1000     JSR MOVECODE ;CHECK FOR XE
1010     BCC MLJ2
1020     LDY #0
1030     .BYTE $2C
1040 MLJ3 LDY #7
1050     LDX #0
1060 MLJ4 LDA MEMTAB,Y
1070     STA XEMEM,X
1080     INY 
1090     INX 
1100     CPX #7
1110     BCC MLJ4
1120     LDX #ENDOFPRG&255
1130     LDY #ENDOFPRG/256
1131 MLJ5 LDA #$C0
1132     STA $D40E
1133     CLI 
1140     RTS 
1150 ;
1160 MLJ2 JSR MOVECODE+[CHKAXL-CHKEXR1]
1170     BCS MLJ3
1180     LDX #ENDOFPRG2&255
1190     LDY #ENDOFPRG2/256
1200     BNE MLJ5
1210 MEMTAB .BYTE 1,$EF,0,$FF,$10,1,$D3
1220     .BYTE 2,0,1,0,0,$FF,$CF
1230 ;
1240 ;
1250 CHKEXR1 LDY #$FF
1260     LDX $4000
1270     LDA $D301
1280     AND #$EF
1290     STY $4000
1300     STA $D301
1310     INY 
1320     ORA #$10
1330     PHA 
1340     LDA $4000
1350     STA DATA
1360     PLA 
1370     STY $4000
1380     STA $D301
1390     DEY 
1400     CPY $4000
1410     STX $4000
1420     BEQ CMZ1
1430     CLC 
1440     RTS 
1450 CMZ1 LDA $D301
1460     AND #$EF
1470     LDX DATA
1480     STA $D301
1490     STX $4000
1500     ORA #$10
1510     STA $D301
1520     SEC 
1530     RTS 
1540 ;
1550 CHKAXL LDX #0
1560     STX $CFFF
1570     LDY $4000
1580     STX $4000
1590     INX 
1600     STX $CFFF
1620     LDA $4000
1650     STX $4000
1660     DEX 
1661     STX $CFFF
1670     CPX $4000
1680     STY $4000
1690     BEQ CMZ2
1700     CLC 
1710     RTS 
1720 ;
1730 CMZ2 INX 
1740     STX $CFFF
1760     STA $4000
1770     DEX 
1780     STX $CFFF
1790     SEC 
1800     RTS 
1810 ;
1820 CALCMEM2
1830     STX PREBFR
1840     STY PREBFR+1
1850     STX SUFBFR
1860     TYA 
1870     CLC 
1880     ADC #8192/256 ;8K FOR PREBFR
1890     STA SUFBFR+1
1900     STX STACKR
1910     ADC #4096/256 ;4K FOR SUFBFR
1920     STA STACKR+1
1930     STX SBUFF
1940     ADC #4096/256 ;4K FOR STACK
1950     STA SBUFF+1
1960     LDA $02E5
1970     SEC 
1980     SBC SBUFF
1990     TAY 
2000     LDA $02E6   ;MEMTOP
2010     SBC SBUFF+1
2020     LSR A
2030     STA SBLEN+1
2040     STA DBLEN+1
2050     TYA 
2060     ROR A
2070     STA SBLEN
2080     STA DBLEN
2090     CLC 
2100     ADC SBUFF
2110     STA DBUFF
2120     LDA DBLEN+1
2130     ADC SBUFF+1
2140     STA DBUFF+1
2150 ;
2160     LDA #0
2170     STA BATCHFLG
2180     STA LISTFLG
2190     STA SCROFF
2200     STA QUERY
2210     STA SWAPFLG
2220     STA OVERFLG
2230     STA TIMEFLG
2240     STA PASSFLG
2250     STA SPARTAF
2260     INC SCROFF  ;DEFAULTS TO OFF
2270     LDA #$CC
2280     STA 709     ;IMPROVE COLOR
2290     LDA #$92
2300     STA 710
2310     RTS 
2320 ;
2330     *=  ASMTEMP
2340 ;
2350 SFNAME .DS 88
2360 DFNAME .DS 88
2370 HEADER .DS 29
2380 DFPATH .DS 41
2390 DSTDNS .DS 12
2400 DNSTMP .DS 12
2410 PASSWORD .DS 21
2420 FNTEMP .DS 11
2430 FNMASK .DS 11
2440 ;
2450 SCRON BRK 
2460 RESTCLR .WORD 0
2470 ;
2480 ;
2490     .INCLUDE #D3:ARC:UNARC2.M65
2500 ;
2510 ENTSRC LDA #$40
2520     STA $02BE   ;FORCE UPPER CASE
2530     JSR DOIO
2540     .BYTE 0,5   ;GETLINE
2550     .WORD SFNAME,80,12
2551     BMI ESR1
2560     LDA $0348,X
2570     CMP #3
2580     BCS NINS2
2590 ESR1 PLA 
2600     PLA 
2610     JMP MAIN
2620 ;
2630 NINS2 LDA SFNAME
2640     CMP #'D
2650     BNE IN26
2660     LDA SFNAME+1
2670     CMP #'1
2680     BCC IN26
2690     CMP #$3B
2700     BCC IN2L
2710 IN26 LDY $0348
2720     DEY 
2730 IN2K LDA SFNAME,Y
2740     STA SFNAME+2,Y
2750     DEY 
2760     BPL IN2K
2770     LDA #'D
2780     STA SFNAME  ;add "D:"
2790     LDA #':
2800     STA SFNAME+1
2810     INC $0348
2820     INC $0348   ;ADD 2
2830 IN2L RTS 
2840 ;
2850 GETPASS LDX #GETPS1&255
2860     LDY #GETPS1/256
2870     JSR PRINT
2880     JSR DOIO
2890     .BYTE 0,5   ;GETLINE
2900     .WORD PASSWORD,21,12
2910     BPL GPS1
2920 GPS0 LDA #0
2930     STA PASSFLG
2940     LDY OFFTAB2+5
2950     LDX #0
2960 GPS2 LDA NOTAB,X
2970     STA TITLEM,Y
2980     INY 
2990     INX 
3000     CPX #3
3010     BCC GPS2
3020     RTS 
3030 GPS1 LDY $0348
3040     STY PASSLEN ;(LEN+1)
3050     DEY 
3060     BEQ GPS0
3070     DEY 
3080 GPS3 LDA PASSWORD,Y
3090     AND #$7F
3100     CMP #$60
3110     BCC GPS4
3120     SBC #$20    ;CONVERT TO UPPER
3130 GPS4 STA PASSWORD,Y
3140     DEY 
3150     BPL GPS3
3160     RTS 
3170 ;
3180 SCREENON LDA #DLIST1&255
3190     LDX #DLIST1/256
3200     BNE SCR1
3210 ;
3220 SCREENOFF LDA #DLIST2&255
3230     LDX #DLIST2/256
3240 SCR1 STA $0230
3250     STX $0231
3260     RTS 
3270 ;
3280 KILLF LDX #DELM&255
3290     LDY #DELM/256
3300     JSR PRINT
3310     JSR CLOSE1
3320     JSR ENTSRC
3330     LDX #REALM&255
3340     LDY #REALM/256
3350     JSR PRINT
3360     JSR GETYESNO
3370     CMP #1
3380     BEQ KIL1
3390     JMP MAIN
3400 KIL1 JSR DOIO
3410     .BYTE $10,33
3420     .WORD SFNAME,0,0
3430     BPL KIL2
3440     STY $D4
3450     LDA #0
3460     STA $D5
3470     JSR ERT11   ;WILL NOT RETURN
3480 KIL2 LDX #OKMS1&255
3490     LDY #OKMS1/256
3500     JSR PRINT
3510 KIL3 JMP ERT2
3520 ;
3530 GETYESNO JSR KGETCH
3540     CMP #$9B
3550     BNE GY1
3560     LDA #'N
3570 GY1 AND #$1F
3580     CMP #$1B
3590     BNE GY2
3600     JSR ERETURN
3610     LDA #0      ;NO, ESC
3620     SEC 
3630     RTS 
3640 GY2 CMP #$19    ;Y?
3650     BNE GY3
3660     LDA #'Y
3670     JSR EOUTCH
3680     JSR ERETURN
3690     LDA #1
3700     CLC 
3710     RTS 
3720 GY3 CMP #$0E
3730     BNE GETYESNO
3740     LDA #'N
3750     JSR EOUTCH
3760     JSR ERETURN
3770     LDA #0
3780     CLC 
3790     RTS 
3800 ;
3810 DOIO PLA 
3820     STA $1A
3830     PLA 
3840     STA $1B
3850     LDY #1
3860     LDA ($1A),Y
3870     TAX 
3880     INY 
3890     LDA ($1A),Y
3900     STA $0342,X
3910     INY 
3920     LDA ($1A),Y
3930     STA $0344,X
3940     INY 
3950     LDA ($1A),Y
3960     STA $0345,X
3970     INY 
3980     LDA ($1A),Y
3990     STA $0348,X
4000     INY 
4010     LDA ($1A),Y
4020     STA $0349,X
4030     INY 
4040     LDA ($1A),Y
4050     STA $034A,X
4060     INY 
4070     LDA ($1A),Y
4080     STA $034B,X
4090     TYA 
4100     CLC 
4110     ADC $1A
4120     TAY 
4130     LDA #0
4140     ADC $1B
4150     PHA 
4160     TYA 
4170     PHA 
4180     JMP $E456
4190 ;
4200 DODN5 STX $0304
4210     STY $0305
4220     LDA #12
4230     STA $0308
4240     LDA #0
4250     STA $0309
4260     STA $030A
4270     STA $030B
4280     LDA #$40
4290     STA $0303
4300     LDA #'N
4310     STA $0302
4320     LDA #$31
4330     STA $0300
4340     BCC DODN1
4350     ASL $0303
4360     INC $0302
4370 DODN1 JMP $E459
4380 ;
4390 CHKSD LDA SWAPFLG
4400     BEQ CHKS1
4410     LDA SFNAME+1
4420     CMP #':
4430     BNE CHKS2
4440     LDA #'1
4450 CHKS2 STA PRINTEMP
4460     LDA DFNAME+1
4470     CMP #':
4480     BNE CHKS3
4490     LDA #'1
4500 CHKS3 CMP PRINTEMP
4510     BNE CHKS1
4520     LDA #0
4530     STA SCROFF
4540     SEC 
4550     RTS 
4560 CHKS1 CLC 
4570     RTS 
4580 ;
4590 DOSOUR JSR CHKSD
4600     BCS DOSR1
4610     RTS 
4620 DOSR1 LDA ONEDRIVE
4630     CMP #1
4640     BEQ CHKS1
4650     LDA SPARTAF
4660     BEQ DOSRX   ;IF SPARTA,
4670     JSR CLOSE2  ;CLOSE THE IOCB
4680     JSR ERRORTRAP
4690 DOSRX LDA #1
4700     STA ONEDRIVE
4710     JSR SCREENON
4720     LDX #INSRC&255
4730     LDY #INSRC/256
4740     JSR PRINT
4750     JSR KGETCH
4760     RTS 
4770 ;
4780 DODEST JSR CHKSD
4790     BCS DOSR2
4800     RTS 
4810 DOSR2 LDA ONEDRIVE
4820     CMP #2
4830     BEQ CHKS1
4840     LDA #2
4850     STA ONEDRIVE
4860     JSR SCREENON
4870     LDX #INDES&255
4880     LDY #INDES/256
4890     JSR PRINT
4900     JSR KGETCH
4910     RTS 
4920 ;
4930 SAVSCR LDA $58
4940     STA CODE
4950     LDA $59
4960     STA CODE+1
4970     LDA 84
4980     STA FREE_ENT
4990     LDA 85
5000     STA FREE_ENT+1
5010     LDA #$1F
5020     STA 752
5030     JSR EOUTCH
5040     LDY #0
5050     STY 752
5060     LDA STACKR
5070     STA PRZP
5080     LDA STACKR+1
5090     STA PRZP+1
5100     LDX #4
5110 DIR1 LDA (CODE),Y
5120     STA (PRZP),Y
5130     INY 
5140     BNE DIR1
5150     INC CODE+1
5160     INC PRZP+1
5170     DEX 
5180     BNE DIR1
5190     RTS 
5200 ;
5210 RSTSCR LDA $58
5220     STA CODE
5230     LDA $59
5240     STA CODE+1
5250     LDA STACKR
5260     STA PRZP
5270     LDA STACKR+1
5280     STA PRZP+1
5290     STA 752
5300     LDA #0
5310     STA 84
5320     STA 85
5330     LDA #$1F
5340     JSR EOUTCH
5350     LDA #$1E
5360     JSR EOUTCH
5370     LDY #0
5380     STY 752
5390     LDX #4
5400 DIR9 LDA (PRZP),Y
5410     STA (CODE),Y
5420     INY 
5430     BNE DIR9
5440     INC PRZP+1
5450     INC CODE+1
5460     DEX 
5470     BNE DIR9
5480     LDA FREE_ENT
5490     STA 84
5500     LDA FREE_ENT+1
5510     STA 85
5520     LDA #$1F
5530     JSR EOUTCH  ;->
5540     LDA #$1E
5550     JSR EOUTCH
5560     LDA #0
5570     TAY 
5580     STA ($58),Y
5590     RTS 
5600 ;
5610 ;
5620 WHDRV .BYTE 155,155,"Which drive to format?",0
5630 WHDNS .BYTE 155,155,"[1] Single or [2] Double Density?",0
5640 SUREM .BYTE 155,"Format, Are you sure?",0
5650 FMTER .BYTE 155,"Error: Bad Format! Check Disk/Drive}",155,0
5660 FMOK .BYTE 155,"Format Completed.  Press RETURN",155,0
5670 DELM .BYTE "D",155,155,"Enter complete filename to delete:",155,0
5680 REALM .BYTE 155,"Delete this file, are you sure?",0
5690 OKMS1 .BYTE 155,"File has been deleted!",0
5700 GETPS1 .BYTE 155,"Enter decryption password:",155,0
5710 ;
5720 FORMAT LDX #WHDRV&255
5730     LDY #WHDRV/256
5740     JSR PRINT
5750 FM1 JSR KGETCH
5760     AND #$7F
5770     CMP #$1B
5780     BNE FM2
5790     RTS 
5800 FM2 CMP #'1
5810     BCC FM1
5820     CMP #$3A
5830     BCS FM1
5840     STA DNSTMP+1
5850     AND #$0F
5860     STA $0301
5870     ORA #$30
5880     JSR EOUTCH
5890     LDA #'D
5900     STA DNSTMP
5910     LDA #':
5920     STA DNSTMP+2
5930     LDA #$9B
5940     STA DNSTMP+3
5950     LDX #DSTDNS&255
5960     LDY #DSTDNS/256
5970     CLC 
5980     JSR DODN5
5990     CPY #138
6000     BCS FM10
6010     LDX #WHDNS&255
6020     LDY #WHDNS/256
6030     JSR PRINT
6040 FM4 JSR KGETCH
6050     AND #$7F
6060     CMP #$1B
6070     BNE FM5
6080     RTS 
6090 FM5 CMP #$31
6100     BEQ FM6
6110     CMP #$32
6120     BNE FM4
6130 FM6 PHA 
6140     JSR EOUTCH
6150     JSR ERETURN
6160     PLA 
6170     AND #1
6180     BNE FM6A
6190     STA DSTDNS+7 ;is 0
6200     LDA #4
6210     STA DSTDNS+5
6220     LDA #1
6230     STA DSTDNS+6
6240     BNE FM7     ;branch always
6250 FM6A LDA #$80
6260     STA DSTDNS+7
6270     ASL A
6280     STA DSTDNS+5
6290     STA DSTDNS+6
6300 FM7 SEC 
6310     LDX #DSTDNS&255
6320     LDY #DSTDNS/256
6330     JSR DODN5
6340     JSR SETDOS
6350 FM10 LDX #SUREM&255
6360     LDY #SUREM/256
6370     JSR PRINT
6380     LDA #$FF
6390     STA 764
6400     JSR GETYESNO
6410     CMP #0
6420     BEQ FM9
6430     JSR CLOSE2
6440     JSR DOIO
6450     .BYTE $20,254
6460     .WORD DNSTMP,0,0
6470     BPL FM12
6480     LDX #FMTER&255
6490     LDY #FMTER/256
6500     JSR PRINT
6510     JSR KGETCH
6520 FM9 RTS 
6530 ;
6540 FM12 LDX #FMOK&255
6550     LDY #FMOK/256
6560     JSR PRINT
6570     JSR KGETCH
6580     RTS 
6590 ;
6600 SETDOS LDA #$FF
6610     STA 8
6620     JMP ($0C)
6630 ;
6640 PROCESS LDY #-1
6650     LDX #0
6660 PL0 INY 
6670     LDA (PRZP),Y
6680     CMP #$9B
6690     BEQ PL5
6700     CMP #'*
6710     BNE PL1
6720     LDA #'?     ;fill with ?'s
6730 PL2 STA FNTEMP,X
6740     INX 
6750 PL4 CPX #11
6760     BEQ PL99
6770     CPX #8
6780     BEQ PL0
6790     BNE PL2
6800 PL1 CMP #'.
6810     BNE PL3
6820     LDA #$20    ;fill remaider
6830     BNE PL4     ;with spaces
6840 PL3 STA FNTEMP,X
6850     INX 
6860     CPX #11
6870     BCC PL0
6880 PL99 RTS 
6890 PL5 CPX #11
6900     BCS PL99
6910     LDA #$20
6920     STA FNTEMP,X
6930     INX 
6940     JMP PL5
6950 ;
6960 ;
6970 ; UN-SQUASHING CODE:
6980 ;
6990 SQUASH LDA XEMEM
7000     BEQ SQA1
7010     JMP SQUASH2
7020 SQA1 LDX #NOMEMSG&255
7030     LDY #NOMEMSG/256
7040     JSR PRINT
7050     JMP ERT2
7060 ;
7070 NOMEMSG .BYTE 155,"You need >=128K memory to unsquash!",0
7080 ;Subroutines to access XE memory
7090 ;
7100 ENDOFPRG2
7110 ;
7120 XEMEMPUT PHA 
7130     JSR [SETUPLOC-XEMEMPUT]+$0580
7140     PLA 
7150     STA (PRZP),Y
7160     TXA 
7170     INY 
7180     STA (PRZP),Y
7190     JMP [BANKOFF-XEMEMPUT]+$0580
7200 ;
7210 XEMEMGET JSR [SETUPLOC-XEMEMPUT]+$0580
7220     INY 
7230     LDA (PRZP),Y
7240     TAX 
7250     DEY 
7260     LDA (PRZP),Y
7270     JMP [BANKOFF-XEMEMPUT]+$0580
7280 ;
7290 SETUPLOC LDA CODE
7300     ASL A
7310     STA PRZP
7320     LDA CODE+1
7330     ROL A
7340     ORA #$40
7350     STA PRZP+1
7360     LDA MAPREG
7370     STA PRINTEMP
7380     LDA MAPREG+1
7390     STA PRINTEMP+1
7400     LDY #0
7410     LDA (PRINTEMP),Y
7420     AND [MAPAND-XEMEMPUT]+$0580
7430     ORA [MAPORA-XEMEMPUT]+$0580
7440     STA (PRINTEMP),Y
7441     SEI 
7442     STY $D40E
7450     RTS 
7460 ;
7470 BANKOFF LDY #0
7480     PHA 
7490     LDA (PRINTEMP),Y
7500     AND [MAPAND1-XEMEMPUT]+$0580
7510     ORA [MAPORA1-XEMEMPUT]+$0580
7520     STA (PRINTEMP),Y
7521     LDA #$C0
7522     STA $D40E
7523     CLI 
7530     PLA 
7540     RTS 
7550 ;
7560 ;the above code resides at $580
7570 ;
7580 XEMEM .BYTE 1
7590 MAPAND .BYTE $EF
7600 MAPORA .BYTE 0
7610 MAPAND1 .BYTE $FF
7620 MAPORA1 .BYTE $10
7630 MAPREG .WORD $D301
7640 ;
7650 SQUASH2 LDX #9
7660     STX N_BITS
7670     LDY #0
7680     STY CLEAR_FLG
7690     STY OFFSET
7700     STY SIZE
7710     DEY 
7720     STY MAXCODE
7730     LDA MAXCODEH-8,X
7740     STA MAXCODE+1
7750     LDA #13
7760     STA MAXBITS
7770     LDA PREBFR
7780     STA PRINTEMP
7790     LDA PREBFR+1
7800     STA PRINTEMP+1
7810     LDY #0
7820 SDY2 TYA 
7830     STA (PRINTEMP),Y
7840     INY 
7850     BNE SDY2
7860 ;
7870     LDY #[SQUASH2-XEMEMPUT]&255
7880 SDY2P LDA XEMEMPUT,Y
7890     STA $0580,Y
7900     DEY 
7910     BPL SDY2P
7920     LDA #1
7930     STA FREE_ENT
7940     STA FREE_ENT+1
7950 ;
7960     JSR GETCODE
7970     STA OLDCODE+1
7980     STA FINCHAR+1
7990     LDA CODE
8000     STA OLDCODE
8010     STA FINCHAR
8020     JSR SQPUT2
8030     LDA SUFBFR
8040     STA STACKP
8050     LDA SUFBFR+1
8060     STA STACKP+1
8070 ;
8080 SDY3 JSR GETCODE
8090     LDX CODE
8100     BNE SDY3AA
8110     CMP #1
8120     BNE SDY3AA
8130     STA FREE_ENT+1
8140     STA CLEAR_FLG
8150     STX FREE_ENT
8160     JSR GETCODE
8170     LDX CODE
8180 ;
8190 SDY3AA STX INCODE
8200     STA INCODE+1
8210     TAY 
8220     TXA 
8230     SEC 
8240     SBC FREE_ENT
8250     TYA 
8260     SBC FREE_ENT+1
8270     BCC SDY3B
8280     LDA FINCHAR
8290     JSR PUTSSTACK
8300 SDY3C LDA OLDCODE
8310     STA CODE
8320     LDA OLDCODE+1
8330     STA CODE+1
8340 ;
8350 SDY3B LDA CODE+1
8360     BEQ SDY3D
8370     LDA CODE
8380     CLC 
8390     ADC PREBFR
8400     STA PRZP
8410     LDA CODE+1
8420     ADC PREBFR+1
8430     STA PRZP+1
8440     LDY #0
8450     LDA (PRZP),Y
8460     JSR PUTSSTACK
8470 SDY3E JSR [XEMEMGET-XEMEMPUT]+$0580
8480     STA CODE
8490     STX CODE+1
8500     JMP SDY3B
8510 ;
8520 PUTSSTACK LDY #0
8530     STA (STACKP),Y
8540     INC STACKP
8550     BNE SPSK1
8560     INC STACKP+1
8570     LDA STACKP+1
8580     SEC 
8590     SBC SUFBFR+1
8600     CMP #$23
8610     BCC SPSK1
8620     PLA 
8630     PLA 
8640     JMP NGNN
8650 SPSK1 RTS 
8660 ;
8670 SDY3D LDA CODE
8680     CLC 
8690     ADC PREBFR
8700     STA PRZP
8710     LDA CODE+1
8720     ADC PREBFR+1
8730     STA PRZP+1
8740     LDY #0
8750     LDA (PRZP),Y
8760     STA FINCHAR
8770     STY FINCHAR+1
8780     JSR PUTSSTACK
8790 ;
8800 SDY3G LDA STACKP
8810     BNE SDY3H
8820     DEC STACKP+1
8830 SDY3H DEC STACKP
8840     LDY #0
8850     LDA (STACKP),Y
8860     JSR SQPUT2
8870     LDA STACKP
8880     CMP SUFBFR
8890     BNE SDY3G
8900     LDA STACKP+1
8910     CMP SUFBFR+1
8920     BNE SDY3G
8930 ;
8940     LDA FREE_ENT
8950     STA CODE
8960     LDA FREE_ENT+1
8970     STA CODE+1
8980     CMP #$20
8990     BCS SDY4
9000 ;
9010     LDA OLDCODE
9020     LDX OLDCODE+1
9030     JSR $0580   ;putcode
9040     LDA CODE
9050     CLC 
9060     ADC PREBFR
9070     STA PRZP
9080     LDA CODE+1
9090     ADC PREBFR+1
9100     STA PRZP+1
9110     LDY #0
9120     LDA FINCHAR
9130     STA (PRZP),Y
9140     INC FREE_ENT
9150     BNE SDY4
9160     INC FREE_ENT+1
9170 SDY4 LDA INCODE
9180     STA OLDCODE
9190     LDA INCODE+1
9200     STA OLDCODE+1
9210     JMP SDY3
9220 ;
9230 ;
9240 ENDOFPRG
9250 ;
9260 CALCMEM
9270     LDY #0
9280 EMD7 LDA $031A,Y ;LOOK FOR E:
9290     CMP #'E
9300     BEQ EMD8
9310     INY 
9320     INY 
9330     INY 
9340     BNE EMD7
9350 EMD8 LDA $031B,Y
9360     STA $E0
9370     LDA $031C,Y
9380     STA $E1
9390     LDY #0
9400     LDA ($E0),Y
9410     STA EMD4+1  ;MODIFY CODE!
9420     INY 
9430     LDA ($E0),Y
9440     STA EMD3+1
9450     LDY #6
9460     LDA ($E0),Y
9470     STA EMD2+1
9480     INY 
9490     LDA ($E0),Y
9500     STA EMD1+1
9510 ;
9520     LDA $6A     ;RAMTOP
9530     CMP #$C0    ;48K?
9540     BCS CLC1
9550     LDA $0700   ;SPUDDO?
9560     CMP #'S
9570     BEQ CLC1    ;DON'T DO BASIC IF SPARTADOS IS LOADED
9580     LDA $D301
9590     AND #2
9600     BNE CLC1
9610     LDA $03F8
9620     ORA $03FA
9630     BNE CLC1
9640     INC $03F8
9650     LDA $D301
9660     ORA #2      ;DISABLE BASIC
9670     STA $D301
9680     LDA #$C0
9690     STA $6A
9700     JSR CLOSE0
9710     JSR DOIO
9720     .BYTE 0,3   ;DO A GR.0
9730     .WORD EDEV,0,12
9740 CLC1 JSR CLOSE1
9750     JSR CLOSE2
9760     JSR CLOSE3
9770     JSR DOIO    ;OPEN K:
9780     .BYTE $30,3
9790     .WORD KDEV,0,4
9800     LDA $58     ;SCREEN MEM
9810     STA DL1SC
9820     LDA $59
9830     STA DL1SC+1
9840     JSR CHKEXRM
9850     JSR CALCMEM2
9860 ;
9870     LDA $02E6   ;MEMHI
9880     SEC 
9890     SBC $02E8   ;MEMLO
9900     CMP #$68
9910     BCS MEMOK
9920     LDX #OUTMEM&255
9930     LDY #OUTMEM/256
9940     JSR PRINT
9950     PLA 
9960     PLA 
9970     JMP DUMPOUT
9980 OUTMEM .BYTE 155,"Error: Not enough free memory!}",155,0
9990 ;
010000 MEMOK
010010   LDA $0700
010020   CMP #'S     ;SPUDDO?
010030   BNE NOP1
010040   INC SPARTAF
010050 NOP1 LDY #0
010060   LDA ($0A),Y
010070   CMP #$4C    ;CMD PROC DOS?
010080   BNE NOPARM
010090   LDY #3
010100   LDA ($0A),Y
010110   CMP #$4C    ;SAME
010120   BNE NOPARM
010130   LDA $0A
010140   CLC 
010150   ADC #3
010160   STA CRNAME+1
010170   LDA $0B
010180   ADC #0
010190   STA CRNAME+2
010200   JSR CRNAM2
010210   BEQ NOPARM
010220   LDY #33     ;GET COMFNAME ADR
010230   LDX #0
010240 SP1 LDA ($0A),Y
010250   STA SFNAME,X
010260   CMP #$9B
010270   BEQ SP2
010280   CMP #$20    ;DOS XL
010290   BEQ SP2
010300   INX 
010310   INY 
010320   BNE SP1
010330 ;
010340 NOPARM RTS 
010350 ;
010360 CRNAM2 LDY #10
010370   LDA ($0A),Y
010380   PHA 
010390   JSR CRNAME
010400   PLA 
010410   LDY #10
010420   CMP ($0A),Y
010430   RTS 
010440 CRNAME JMP $FFFF
010450 ;
010460 SP2 INX 
010470   STX SRCLEN
010480   LDY #10     ;GET BUFOFF
010490   LDA ($0A),Y
010500   TAY 
010510   LDA $0A
010520   CLC 
010530   ADC #63
010540   STA CURIN
010550   LDA $0B
010560   ADC #0
010570   STA CURIN+1
010580   LDA (CURIN),Y
010590   CMP #$9B
010600   BEQ NOPARM  ;CR AFTER 1ST ENTRY?
010610   INY 
010620   INC BATCHFLG
010630   LDA (CURIN),Y
010640   CMP #'/
010650   BNE SP31
010660   INY 
010670   LDA (CURIN),Y
010680   CMP #'L
010690   BNE SP32    ;CHECK FOR /L
010700   INC LISTFLG
010710   RTS 
010720 ;
010730 SP32 DEY 
010740 ;
010750 SP31 LDX #0
010760 SP3 LDA (CURIN),Y
010770   STA DFPATH,X
010780   CMP #$9B    ;GET PATHNAME
010790   BEQ SP42
010800   CMP #$20
010810   BEQ SP42
010820   INX 
010830   INY 
010840   BNE SP3
010850   BEQ NOPARM
010860 ;
010870 SP42
010880   LDA #$9B
010890   STA DFPATH,X
010900   CPX #1
010910   BNE SP43
010920   STA DFPATH+3
010930   LDA DFPATH
010940   STA DFPATH+1
010950   LDA #'D
010960   STA DFPATH
010970   LDA #':
010980   STA DFPATH+2
010990 ;
011000 SP43 STY CODE ;temporary
011010   JSR DODSTN  ;parse fname
011020   LDY CODE
011030   LDA (CURIN),Y
011040   CMP #$9B
011050   BNE SP4
011060 SP45 RTS 
011070 ;
011080 SP4 INY 
011090   LDA (CURIN),Y
011100   CMP #'/
011110   BNE SP45
011120   INY 
011130 SP6 LDA (CURIN),Y
011140   CMP #'S
011150   BEQ SP7
011160   CMP #'Q
011170   BEQ SP8
011180   CMP #'T
011190   BEQ SP11
011200   CMP #'P
011210   BEQ SP13
011220   CMP #'O
011230   BEQ SP12
011240   CMP #'X
011250   BEQ SP11A
011260   CMP #$20
011270   BEQ SP20
011280 SP19 LDA #0
011290   STA PASSFLG
011300   RTS 
011310 ;
011320 SP7 LDA #0
011330   STA SCROFF
011340 ;
011350 SP10 INY 
011360   BNE SP6
011370   RTS 
011380 ;
011390 SP8 INC QUERY
011400   BNE SP10
011410 ;
011420 SP11 INC TIMEFLG
011430   BNE SP10
011440 ;
011450 SP11A INC SWAPFLG
011460   BNE SP10
011470 ;
011480 SP12 INC OVERFLG
011490   BNE SP10
011500 ;
011510 SP13 INC PASSFLG
011520   BNE SP10
011530 ;
011540 SP20 INY 
011550   LDA PASSFLG
011560   BEQ SP19
011570   LDX #0
011580 SP21 LDA (CURIN),Y
011590   AND #$7F
011600   CMP #$60
011610   BCC SP23
011620   SBC #$20    ;CONVERT TO UPPER
011630 SP23 STA PASSWORD,X
011640   CMP #$1B
011650   BEQ SP22
011660   CMP #$20
011670   BEQ SP22
011680   INY 
011690   INX 
011700   CPX #21
011710   BCC SP21
011720   BCS SP19
011730 SP22 INX 
011740   STX PASSLEN
011750   RTS 
011760 ;
011770 EDEV .BYTE "E:",155
011780 KDEV .BYTE "K:",155
011790 ;
011800   .OPT LIST
011810   RTS 
011820 WASTED = *-ENDOFPRG
011830     .IF LISTFLAG=0
011840     .OPT NO LIST
011850     .ENDIF 
011860   *=  $02E0
011870   .WORD INIT
