OUP-M/CCP.s

780			;OUP/M CCP WRITTEN BY LIO,QI-WEN
790			;ON AUG. 1982 
800		*=$D000
810		JMP	MAIN
820		;6502 CP/M CCP 
830		;******************************************* 
840		STACKB=$FF	
850		IBUBCC=$EE80						;MAX CHAR ADDRESS 
860		IBUBC=$EE81							;BUFF COUNTER 
870		IBUFB=$EE82							;FIRST CHAR IN BUFF 
880		IBUFBA=$EF02			
890		IBUFBB=$EF04			
900		IBUFC	.WORD IBUBC			
910		IBUFF	.WORD IBUFB			
920		IBUFPA	.WORD IBUFB					;PTR,INIT IBUFB 
930		IBUFPB	.WORD IBUFBB
940		FCBB=$EE01
950		FCBBB=FCBB+1 
960		FCBBC=FCBB+$10
970		FCBBD=FCBB+$20 
980		RETVAL=FCBB+$23
990		FCBP	.WORD FCBB
1000	FCBPB	.WORD FCBBB 
1010	FCBPC	.WORD FCBBC 
1020	FCBBP	.WORD FCBBD
1030			DSKNUM=FCBB+$42				;POINTES THE NUMBER OF
1040			WRKPLA=FCBB+$43				;WORK ELEMENT 
1050			WRKPLB=FCBB+$44
1060			WRKPLC=FCBB+$45
1070			WRKPLD=FCBB+$46 
1080	WRKPPB .WORD WRKPLB 
1090			RBC=$0067
1100			RHL=$0069
1110			RDE=$006D					;REPLACE Z80 DE,HL,BC 
1120			RWK=$006B
1130			RWQ=$0060
1140			RNW=$0062
1150			DMAD=$E965
1160	SUBTBL 	.WORD SUBPGO
1170			STRTD=$0200 
1180	SUBPGO	.WORD $2710					;10,000 
1190			.WORD $03E8					;1,000 
1200			.WORD $0064					;100 
1210			.WORD $000A					;10 
1220	MSGAD1	.WORD MSGVER
1230	CMDTAB *BYTE 'DIR ERA TYPESAVEREN USER' 
1240;
1250;
1260	TABADD	.WORD CMDTAB
1270	ADRTAB	.WORD PDIR,PERA,PTYPE,PSAVE,PREN 
1280			.WORD PUSER,PTRANS
1290	TBLAD2	.WORD ADRTAB
1300	RDERRA .WORD RDERR
1310	NOFERA .WORD NOFERR
1320	MSGAD3 .WORD MSGADI
1330			BDOS=$D93F
1340	MSGAD5 .WORD MSGAD4
1350	MSGAD7 .WORD MSGAD6
1360	MSGDD9 .WORD MSGDD8
1370	MSGBA2 .WORD MSGBA1
1380	;***********************************************
1390	;SUBROUTINE
1400	;***********************************************
1410	CHROUT	STA RDE						;OUTPUT CHAR TO E
1420			LDX #$02					
1430			JMP BDOS					;PRINT A CHARACTER
1440	CHROB	STA WRKPLC					;FOR SAVING RBC
1450			LDA RBC				
1460			STA RWQ				
1470			LDA RBC+1				
1480			STA RWQ+1				
1490			LDA WRKPLC				
1500			JSR CHROUT					;TO PRINT A CHAR
1510			LDA RWQ						;FOR RESTORE RBC
1520			STA RBC					
1530			LDA RWQ+1				
1540			STA	RBC+1				
1550			RTS				
1560	CRLF	LDA #$0D					;'CR' TO A 
1570			JSR CHROB					;OUTPUT 'CR' 
1580			LDA #$0A					;'LF' TO A 
1590			JMP CHROB					;OUTPUT 'LF'
1600	SPACE	LDA #$20					;' ' TO A
1610			JMP CHROB		
1620	;PRINT STRING UNTIL 'NUL',MESSAGE POINTER IN RDE
1630	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1640	STRIOA	JSR CRLF					;OUTPUT 'CR' 'LF'
1650			LDA RBC						;GET MESSAGE POINTER
1660			STA RHL	
1670			LDA RBC+1	
1680			STA RHL+1					;NOW RHL POINTES MESSAGE
1690	;PRINT STRING ,MESSAGE IN RHL
1700	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1710	STRIOB	LDY #$00					;CLEAR Y
1720			LDA (RHL),Y					;GET A CHAR
1730			BNE LOOP1					;CHAR='NUL'?
1740			RTS							;YES,END PRINT AND RETURN 
1750	LOOP1	INY							;NO,
1760			STY RWQ		
1770			JSR CHROUT					;OUTPUT A CHAR
1780			LDY RWQ		
1790			JMP STRIOB+2				;CONTINUE
1800	RSTDSK	LDX #$0A					;RESET DISK OPERATION
1810;
1820;
1830;
1840;
1850;
1860;
1870			JMP BDOS
1880	SELDSK	LDX #$13					;SELECT DISK OPERATION
1890			JMP BDOS
1900	;THE FOLLOWING 8 ROUTINES CALL BDOS THEN
1910	;RETURN VALUE TO RETVAL ,A+1RETURN
1920	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1930	CDOSRT	LDA RDE 
1940			LDY RDE+1 
1950	CDOSR1	JSR BDOS
1960			STA RETVAL					;RETURN VALUE TO 'RETVAL' 
1970			CLC			
1980			ADC	#$01					;A+1,THEN RETURN 
1990			RTS			
2000	OPNFLB	LDX #$16					;OPEN DISK FILE
2010			JMP CDOSRT			
2020	OPNFL	LDA #$00			
2030			STA FCBBD					;CLEAR SOME PLACE OF FCB
2040			JSR FCBTOD					;FCBP TO RDE
2050			JMP OPNFLB					;TO OPEN FILE
2060	CLSFIL	LDX #$17					;CLOSE FILE
2070			JMP CDOSRT					;
2080	SERFST	LDX #$1C					;SEARCH FOR FIRST
2090			JMP CDOSRT			
2100	SERNXT	LDX #$1D					;SEARH FOR THE NEXT
2110			JMP CDOSR1				
2120	SERFIL	JSR FCBTOD					;FCBP TO RDE
2130			JMP SERFST				
2140	FCBTOD	LDA FCBP					;FOR FCB TO RDE
2150			STA RDE		
2160			LDA FCBP+1 
2170			STA RDE+1 
2180			RTS
2190	DELFIL	LDX #$15					;DELETE FILE
2200	;THE FOLLOWING ROUTINE CALLING CDOSB 
2210	;RETURN ZERO IF SUCCESS
2220	;-------------------------------------
2230			LDY #$21 
2240	CDOSB	LDA RDE
2250			LDY RDE+1 
2260			JSR BDOS 
2270			CLC
2280			RTS							;RETURN VALUE<>0 IF FALSE 
2290	RDSEQB	LDX #$18					;READ SEQUENTIAL
2300			JMP CDOSB	
2310	RDSEQ	JSR FCBTOD					;FCB TO RDE		
2320			JMP RDSEQB					;TO READ SEQUENTIAL
2330	WRSEQ	LDX #$19					;WRITE SEQUENTIAL
2340			JMP CDOSB	
2350	MAKFIL	LDX #$14					;MAKE FILE
2360			JMP CDOSRT					;RETURN VALUE TO 'RETVAL'
2370	RENFIL	LDA RDE	
2380			LDY RDE+1	
2390			LDX #$1E					;RENAME FILE
2400			JMP BDOS	
2410	GETCOD	LDA #$FF	
2420			STA RDE						;$FF TO E
2430	SETCOD	LDX  #$11					;SET/GET ESER CODE
2440			JMP BDOS					;RETURN USER CODE IF 'GET'
2450	;PRINT PAGE	
2460	;------------	
2470	PRNPG1	JSR SPACE	
2480			JSR SPACE	
2490			LDY #$21					;PAGE POSITION
2500			LDA	(RHL),Y					;GET PAGE NUMB. 
2510			STA	FCBB+$25				;SAVE 
2520			INY	
2530			LDA (RHL),Y					;GET PAGE MSB 
2540			STA FCBB+$26				;SAVE
2550			CLC 	
2560			ROR FCBB+$26
2570			ROR	FCBB+$25
2580	PRNPG2	LDY #06						;IF PAGE 000-999
2590	NXTDIG	LDX #00						;INIT DIGIT COUNT
2600	SUBEM	LDA FCBB+$25				;FETCH LSBY
2610			SEC	
2620			SBC	SUBTBL,Y				;-LSBT OF TAB 
2630			STA	FCBB+$25				;RETURN TO MEMORY 
2640			LDA	FCBB+$26				;FETCH MSBY
2650			INY
2660			SBC	SUBTBL,Y				;-MSBY OF TAB 
2670			BCC	ADBACK					;IF RESULT IS '-'
2680			STA	FCBB+$26				;NO
2690			INX	
2700			DEY							;PTR LSBY IN TABLE
2710			JMP	SUBEM					;LOOP
2720	ADBACK	DEY							;PTR LSBY IN TABLE
2730			LDA	FCBB+$25				;FETCH LSBY 
2740			ADC	SUBTBL,Y				;+LSBY OF TAB 
2750			STA	FCBB+$25	
2760			TXA							;DIGIT COUNT TO A 
2770			ORA	#$30					;CONVERT TO ASCII	
2780			STY	RNW						;SAVE 
2790			JSR	CHROUT					;OUT DIGIT
2800			LDY	RNW						;RESTORE Y
2810			INY	
2820;	
2830			INY							;PTR TO NEXT TABLE
2840;	
2850			CPY	#$0A	
2860;	
2870			BCC	NXTDIG					;LOOP
2880			LDA	FCBB+$25	
2890			ORA	DSKNUM	
2900			ORA	#$30					;CONVERT TO ASCII
2910			JMP CHROUT					;PRINT REMAINDER
2920	;CHANGE LOWER CASE TO UPPER CASE
2930	;----------------------------------------
2940	CUPCAS	CMP #$61					;CHAR>=LOWER CASE A ?
2950			BCS LOPU1					;NO,
2960			RTS							;YES,RETURN
2970	LOPU1	CMP #$7C					;CHAR<LOWER CASE Z+1?
2980			BCC LOPU2					;NO,GO TO LOPU2
2990			RTS							;YES,RETURN
3000	LOPU2	AND #$5F					;LOWER CASE TO UPPER CASE
3010			RTS
3020	;COLD START,($01FF)=0:ROUTINE SHOW OP VERSION
3030	;WARM START,($01FF)<>0:ROUTINE HANDLE IN BUFF
3040	;----------------------------------------
3050	INBUFL	LDA $01FF					;'COLD START'?
3060			CMP #$FF
3070			BNE MJN						;NO,
3080			JSR CRLF
3090			LDA MSGAD1
3100			STA RHL
3110			LDA MSGAD1+1				;P
3120			STA RHL+1					;RHL POINTES 'CP/M VERSION--'
3130			JSR STRIOB					;PRINT MESSAGE STRING
3140			JSR ENDINB					;YES TO FILL 0 TO $01FF
3150	MJN 	JMP START
3160	INBUFA	LDA	#$80					;BUFF SIZE 
3170			STA	IBUBCC					;SAVE BUFF SIZE
3180			LDA	#IBUBCC					;BUFF ADDRESS 
3190			LDY	#IBUBCC/256
3200			LDX	#$06					;INPUT BUFF LINE 
3210			JSR	BDOS			
3220			LDA	#IBUBC			
3230			STA	RHL			
3240			LDA	#IBUBC/256			
3250			STA	RHL+1					;RHL POINTES INPUT BUFFER 
3260			LDX	IBUBC					;X AS COUNTER FOR NUMB OF CHAR 
3270			LDY	#$00			
3280	LOPIB1	INC	RHL			
3290			TXA				
3300			BEQ	BUFEND					;NUMB.OF CHAR=0,BRANCH 
3310			LDA	(RHL),Y					;NO,GET A CHAR
3320			JSR	CUPCAS					;LOWER CASE TO UPPER CASE
3330			STA	(RHL),Y					;SAVE UPPER CHAR 
3340			DEX							;COUNTER-1=0 ? 
3350			JMP	LOPIB1					;CONTINUE
3360	BUFEND	STA (RHL),Y					;0 TO (RHL)
3370			LDA IBUFF
3380			STA	IBUFPA
3390			LDA IBUFF+1
3400			STA	IBUFPA+1				;IBUFPA POINTES HEAD OF BUFF
3410			RTS
3420	CSTATD	LDX #$09
3430			JSR BDOS
3440			PHA
3450			PLA							;FLAGE=O?
3460			BNE LOPCS1					;NO,BREANCH
3470			RTS							;YES,RETURN
3480	LOPCS1	LDX #$01					;CONSOLE INPUT OPERATION
3490			JSR BDOS		
3500			PHA		
3510			PLA							;FLAGE Z=O?
3520			RTS
3530	RETDKN	LDX #$0C					;RETURN CURRENT DISK
3540			JMP BDOS
3550	STDMAI	LDA #DMAD
3560			STA RDE
3570			LDA #DMAD/256
3580			STA RDE+1					;RDE POINTES $0080BUF
3590	SETDMA	LDX #$12					;SET DMA OPERATION
3600			LDA RDE			
3610			LDY RDE+1			
3620			JMP BDOS			
3630	ENDINB	LDA #$00			
3640			STA $01FF					;0 TO STACK
3650			LDA DSKNUM			
3660			JSR SELDSK					;SELECT CURRENT DISK
3670			RTS			
3680	CMDEND	JSR							;OUTPUT 'CR''LF'
3690			LDA							;IN BUFF TO RWK REF'3120'
3700			STA			
3710			LDA	IBUFPB+1				;
3720			STA	RWK+1					;RWK POINTES IN BUFF
3730			LDY #$00			
3740	LOPCN1	LDA (RWK),Y					;GET A CHAR 
3750			CMP #$20					;CHAR=' '? 
3760			BEQ ERENDC					;YES
3770			PHA			
3780			PLA							;CHAR='0'
3790			BEQ ERENDC					;Y,
3800			JSR	CHROUT					;OUTPUT CHAR
3810			INC RWK	
3820			JMP LOPCN1					;CONTINUE
3830	ERENDC	LDA #$3F	
3840			JSR CHROUT					;OUTPUT '?'
3850			JSR CRLF					;OUTPUT 'CR' 'LF'
3860			JSR ENDINB					;TO END COMMAND 
3870			JMP START			
3880	;CHECK SPECIAL CHARACTER
3890	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3900	CHARCK	JSR RDRDE					;READ (RED)
3910			CMP #$00
3920			BEQ CHEND					;RETURN IF CHAR='NUL' 
3930			CMP	#$20					;NO,CHECK CHAR=' '?
3940			BEQ	CHEND					;YES,RETURN 
3950			BCC	CMDEND					;GO 'ERROR<4F>HANDLE' IF CHAR<' '
3960			CMP #$3D					;CHAR='='?
3970			BEQ	CHEND					;YES,RETURN Z=0
3980			CMP #$5F					;CHAR='<<3C>'?
3990			BEQ CHEND
4000			CMP	#$2E					;CHAR='.'? 
4010			BEQ CHEND			
4020			CMP	#$3A					;CHAR=':'? 
4030			BEQ CHEND			
4040			CMP	#$3B					;CHAR=';'?
4050			BEQ CHEND			
4060			CMP	#$3C					;CHAR='<'?
4070			BEQ CHEND 			
4080			CMP #$3E					;CHAR='>'?
4090			BEQ CHEND 			
4100	CHEND	RTS 			
4110	RDRDE	STY WRKPLD+1 				;SAVE Y
4120			LDY #$00	
4130			LDA (RDE),Y					;GET A CHAR 
4140			LDY WRKPLD+1				;RESTORE
4150			RTS
4160	;SKIP ' '
4170	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4180	SKPBLK	JSR RDRDE					;GET A CHAR.
4190			CMP #$00			
4200			BEQ KPND					;'BUFF-END'
4210			CMP	#$20					;CHAR=' '? 
4220			BNE KPND					;NO,RETURN
4230			INC RDE						;GET NEXT CHAR
4240			JMP SKPBLK					;LOOP 
4250	KPND	RTS
4260 ;********************************************
4270 ;FILL FCB FROM FCB'POINTER'+(A)
4280 ;********************************************
4290	FIFCBM	CLC			
4300			ADC RHL						;(A)+(L)
4310			STA RHL						;TO (L)
4320			BCC FIEND					;RETURN IF FLAG C=0
4330			INC RHL+1					;NO,(H)+1
4340	FIEND	RTS
4350	;FILL FCB FROM BEGINNING OF FCB
4360	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4370	FIFCBB	LDA #$00
4380	FIFCB	PHA
4390			LDA FCBP
4400			STA RHL
4410			LDA FCBP+1 
4420			STA RHL+1					;RHL POINTES FCB
4430			PLA			
4440			JSR FIFCBM					;(RHL)+(A) TO RHL 
4450			LDA RHL
4460			STA RWK
4470			LDA RHL+1
4480			STA RWK+1					;SAVE INITIAL VALUE OF RHL 
4490			LDA #$00			
4500			STA WRKPLA					;CLEAR
4510			STA WRKPLD					;'WRKPLD'AS COUNTER FOR RDE 
4520			LDA IBUFPA			
4530			STA RDE			
4540			LDA IBUFPA+1			
4550			STA RDE+1					;RDE POINTES INPUT BUFF 
4560			JSR SKPBLK					;TO SKIP ' '
4570			LDA RDE	
4580			STA IBUFPB	
4590			LDA RDE+1	
4600			STA IBUFPB+1				;SAVE NEW POINTER IN IBUFPB 
4610			LDY #$00			
4620			INC RDE						;PRT 2 CHAR 
4630			JSR RDRDE					;GET 2'S CHAR 
4640			CMP #$3A					;':'?
4650			BEQ FIDKNN					;YES,FILL DSKNUMB
4660			LDA #$00		
4670			STA (RWK),Y					;FILL PCB
4680			LDA DSKNUM					;CURRENT DISK
4690			STA WRKPLA					;SAVE REQ.DSKNUM 
4700			DEC RDE						;RET 1'S CHAR IN BUFF
4710			JMP FINAME			
4720	FIDKNN	DEC	RDE						;PTR 1'S CHAR IN BUFF
4730			JSR RDRDE			
4740			SEC			
4750			SBC #$40			
4760			STA RWQ			
4770			STA WRKPLA					;SAVE REG.DSKNUM
4780			DEC WRKPLA			
4790	MEDJN	STA	(RWK),Y					;FILL 'D'TO PCB
4800			INC RDE		
4810			INC RDE						;PTR 3'CHAR IN BUFF
4320	;
4830	;FILL 'NAME' IN FCB
4840	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4850	FINAME	LDX #$08					;X AS COUNTER FOR 8 CHAR
4860			LDA #$20
4870			STA RNW						;INIT ' '
4880	LOPFII	JSR CHARCK					;CHECK SPECIALCHAR
4890			BEQ	FIBLK1					;TO FILL ' 'IF RET Z=0
4900			INY		
4910			CMP #$2A					;CHAR='*'?
4920			BNE	FICHAR					;NO,TO FILL CHAR 
4930			LDA #$3F					;YES,'?'TO A
4940			STA (RWK),Y		
4950			STA RNW
4960			JMP FINEXT 
4970	FICHAR	STA (RWK),Y					;A CHAR TO FCB
4980			LDA #$20 	
4990			STA RNW	
5000	FINEXT	INC RDE						;POINTES NEXT CHAR 
5010			DEX							;COUNT X-1=0?
5020			BNE LOPFI1					;NO,LOOP
5030;	
5040	;TO FIND THE END OF NAME
5050	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
5060	FINDSG	JSR CHARCK					;TO CHECK SPECIAL CHAR
5070			BEQ	FITYP					;TO FILL TYPE IF RET Z=0
5080			INC RDE
5090			JMP FINDSG					;LOOP
5100	;
5110	;TO FILL ' ' IN FCB
5120	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
5130	FIBLKT	PHA
5140	FIBLK	INY
5150			LDA	RNW						;' ' OR ? TO A
5160			STA (RWK,Y)					;' ' TO FCB
5170			DEX							;COUNTER X-1=0?
5180			BNE FIBLK					;LOOP
5190			PLA
5200	;TO FILL TYPE IN FCB
5210	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
5220	FITYP	LDX #$20
5230			STX RNW
5240			LDX #$03					;X AS COUNTER FOR 3 CHAR
5250			CMP #$2E					;CHAR='>'?
5260			BNE FIBLKT					;NO,FILL ' 'IN FBC
5270			INC RDE						;RDE POINTES NEXT CHAR
5280	LOPTP	JSR CHARCK					;CHECK SPECIAL CHAR
5290			BEQ FIBLKT					;TO FILL ' 'IF RET Z=0
5300			INY
5310			CMP #$2A					;CHAR='*'?
5320			BNE FILLCH					;NO,TO FILL CHAR
5330			LDA #$3F					;'?' TO A
5340			STA (RWK),Y					;'?'AS TYPE TO FCB
5350			STA RNW
5360			INC RDE						;PTR NEXT CHAR
5370			JMP NEXTP					;TO FILL NEXT CHAR
5380	FILCH	STA (RWK),Y					;CHAR TO FCB
5390			LDA #$20
5400			STA RNW
5410			INC RDE						;RDE POINTER NEXT CHAR
5420	NEXTP	DEX							;COUNTER X-1=0?
5430			BNE LOPTP					;NO,LOOP
5440	;TO FIND THE END OF COMMAND
5450	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
5460	;
5470	;
5480	;
5490	;
5500	;
5510	;
5520	;
5530	;
5540	;
5550	BLNKJ1	JMP FIND5
5560	FNDEDG	JSR CHARCK					;TO CHECK SPECIAL CHAR.
5570			BNE FIND5					;IF RETURN Z=0
5580			INC RDE						;POINTES NEXT
5590			JMP FNDEDG					;LOOP
5600	FIBLKT	INY
5610			LDA RNW						;' ' OR ? TO A
5620			STA (RWK),Y					;' ' TO FCB
5630			DEX							;COUNTER X-1=0?
5640			BNE FIBLKT					;NO,LOOP
5650	FIND5	LDX #$03					;X AS COUNTER FOR 3'NUL'
5660	LOPFEN	INY
5670			LDA #$00					;'NUL' TO A
5680			STA (RWK),Y					;TO FCB 
5690			DEX							;COUNTER X-1=0? 
5700			BNE LOPFEN					;NO,LOOP
5710			LDA RDE
5720			STA IBUFPA
5730			LDA RDE+1
5740			STA IBUFPA+1				;SAVE INPUT BUFFER
5750	CKQUEN	LDY #$00		
5760			STY RBC
5770			LDX #$0B 					;X AS COUNTER FOR 11CHAR 
5780	;COMPUTE '?'NUMBER IN FCB
5790	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
5800	CHKOUE	INY							;SCAN FCB
5810			LDA	(RWK),Y					;GET A CHAR FROM FCB
5820			CMP	#$3F					;CHAR='?'?
5830			BNE	NEXCH					;NO,GO TO NEXT CHER
5840			INC RBC						;C AS COUNTER FOR '?'NUMBER
5850	NEXCH	DEX							;COUNTER X-1=0?
5860			BNE	CHKQUE 					;NO,LOOP 
5870			LDA RBC
5880			RTS
5890	;COMPARE THE COMMAND IN FCB WITH NAME TABLE
5900	;RETURN A=0 TO 6 WHICH POINTES COMMAND POSITION
5910 	;*******************************************
5920	CMDCMP	LDA TABADD
5930			STA RWK
5940			LDA TABADD+1
5950			STA RWK+1					;RWK POINTES COMMAND TABLE 
5960			LDY #$00				
5970			LDX #$00					;X AS COUNTER FOR 6 COMMANDS
5980	LOPCM	TXA		
5990			CMP #$06					;COUNTER X>=6? 
6000			BCS CMPEND					;YES,JUMP 
6010			LDA FCBPB 		
6020			STA RDE		
6030			LDA FCBPB+1 		
6040			STA RDE+1					;RDE PTR COMMAND NAME 
6050			LDA #$04		
6060			STA RHL						;HL AS COUNTER FOR COMPARE 4 C
6070	CMPBGN	JSR RDRDE					;GET A CHAR FROM FCB
6080			CMP (RWK),Y					;EQUAL?
6090			BNE CHGNX1					;NO,TO CHANGE NEXT COMMAND 
6100			INC RDE						;YES
6110			INY		
6120			DEC RHL						;COUNTER-1=0? 
6130			BNE CMPBGN					;NO,CONTINUE 
6140			JSR RDRDE					;YES,4 CHAR EQUAL 
6150			CMP #$20					;' ' ?
6160			BNE	CHGNX2					;NO.COMPARE AGAIN
6170	;		LDA RDE
6180	;		STA IBUFPA
6190	;		LDA RDE+1
6200	;		STA IBUFPA+1				;PTR END OF COMMAND NAME??
6210			TXA							;YES,GET POSITION OF TABLE 
6220	CMPEND	RTS
6230	CHGNX1	INY
6240			DEC	RHL						;#4COUNTER -1=0? 
6250			BNE	CHGNX1					;NO,LOOP
6260	CHGNX2	INX
6270			JMP	LOPCM					;CONTINUE
6280	;SEPARATE USER CODE WITH DISK NUMB. 
6290	;SET USER CODE,SELECT CURRENT DISK
6300	;*******************************************
6310	MAIN	PHA
6320			JSR	RSTDSK					;RESET DISK SYSTEM
6330			PLA		
6340			STA	DSKNUM					;CURRENT DISK TO 'DSKNUM' 
6350			JSR	SELDSK					;TO SELECT CURRENT DISK 
6360			JMP	INBUFL					;VERSION SHOW?
6370	;*******************************************
6380	;START AFTER ENDING EACH CONSOLE COMMAND
6390	;*******************************************
6400	START	LDX #$22
6410			JSR BDOS
6420			LDX #$FE
6430			TXS							;$FE TO SP
6440			LDA DSKNUM
6450			JSR SELDSK
6460			JSR CRLF					;OUTPUT 'CR' 'LF'
6470			JSR RETDKN					;RETURN CURRENT DISK
6480			CLC		
6490			ADC #$41					;CHANGE DISK NUMB.TO CHA 
6500			JSR	CHROUT					;OUTPUT 'A' OR 'B'- -
6510			LDA #$3E					;'>' TO A
6520			JSR CHROUT					;OUTPUT '>'
6530			JSR INBUFA					;RECEIVE MESSAGE FROM CONSOLE 
6540			LDA	IBUBC+$2				;2'S CHAR IN BUFF
6550			CMP #$3A					;':'?
6560			BEO BPSDK		
6570	ENTRYA	LDA #DMAD		
6530			STA RDE		
6590			LDA #DMAD/256		
6600			STA RDE+1					;RDE POINTES DMA ADDRESS
6610			JSR SETDMA					;SET DMA
6620			JSR FIFCBB					;FILL COMMAND IN FCB,RET '?'CO
6630			BNE CMDND1					;IF RET'?'COUNT<>0,ERR COMMAND
6640			JSR CMDCMP					;TO COMPARE COMMAND
6650	;BASED ON TAB POSITION RETURNED BY 'CMDCMP' 
6660	;,PROGRAM JUMP TO DIFFERENCE ENTRY
6670	;*******************************************
6680			STA	RWK						;SAVE RETURN VALUE 
6690			LDA TBLAD2					;ENTRY ADDR.TABLE TO A
6700			STA RHL
6710			LDA TBLAD2+1				;
6720;
6730;
6740;
6750;
6760			STA RHL+1					;RHL POINTES ENTRY ADDR.TABLE
6770			LDA	RWK
6780			CLC
6790			ADC	RWK						;(RETURN VALUE)*2
6800			ADC	RHL						;
6810			STA RHL
6820			LDA #$00					;REMAIN FLAGE C
6830			ADC RHL+1
6840			STA RHL+1					;TABL.HEAD+(RET.VAL.)*2
6850			LDY #$00
6860			LDA (RHL),Y
6870			STA RWK
6880			INY
6890			LDA (RHL),Y
6900			STA RWK+1
6910			JMP (RWK)					;TO DIFFERENCE ENTRY
6920	CMDNDI	JMP CMDEND					;END ERR.COMMAND
6930	BPSDK	LDA IBUBC+$3				;3'S CHAR
6940			CMP #$00					;'00'?
6950			BNE ENTRYA					;NOT A: OR B:COMMAND
6960			JMP PSDK					;A: OR B: COMMAND
6970 ;SOME LOCAL SUBROUTINES
6980 ;*************************
6990 ;OUTPUT ERROR MESSAGE
7000 ;~~~~~~~~~~~~~~~~~~~~
7010	PRTERI	LDA RDERRA					;MESSAGE ADDR.TO A
7020			STA RBC
7030			LDA RDERRA+1
7040			STA RBC+1					;RBC POINTES 'MESSAGE'
7050			JMP STRIOA					;OUTPUT 'DEAD ERROR'
7060	PRTER2	LDA NOFERA					;MESSAGE ADDR. TO A
7070			STA RBC
7080			LDA NOFERA+1
7090			STA RBC+1					;RBC POINTES 'MESSAGE' 
7100			JMP STRIOA					;OUTPUT 'NO FILE'
7110	;'DIGIT' HANDLE FOR PAGE & USER CODE
7120	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
7130	DIGHD	JSR FIFCBB					;FILL 'DIGIT' IN FCB 
7140;			LDA WRKPLA
7150;			BNE DIGEN1					;ERR.END
7160			LDA #$00
7170			STA RWQ						;RWQ FOR SAVING HIGH BITS 
7180			LDA FCBPB					;
7190			STA RHL
7200			LDA FCBPB+1
7210			STA RHL+1					;RHL POINTES FCB
7220			LDY #$00
7230			LDX #$0B					;X AS COUNTER FOR 11 CHAR.
7240	LOPDIG	LDA (RHL),Y 				;GET A CHAR
7250			CMP #$20					;CHAR=' '? 
7260			BEQ	SKPEN1					;YES,JUMP TO END 
7270			INY							;NO,
7280			SEC
7290			SBC #$30					;CHAR-'0'BIAS 
7300			CMP #$0A					;CHAR<=9?
7310			BCS DIGEN1					;NO, END ERR.COMMAND 
7320			STA RWK						;SAV ELOWER BITS 
7330			LDA RWQ						;HIGH BITS TO A
7340			AND #$E0
7350			BNE DIGEN1					;TO END ERR.COMMAND IF A<>0
7360			LDA RWQ 
7370			CLC
7380			ROR A
7390			ROR A
7400			ROR A
7410			ROR A
7420			ROR A
7430			ROR A						;(A)LEFT SHIFT 4 
7440			ADC RWQ						;OVERFLOW? 
7450			BCS DIGEN1					;YES,ERR. 
7460			ADC RWQ						;OVERFLOW? 
7470			BCS DIGEN1					;YES,ERR.
7480			ADC RWK						;ADD LOW BITS 
7490			BCS DIGEN1					;ERR.IF OVERFLOW 
7500			STA RWQ						;SAVE NEW HIGH BITS 
7510			DEX							;COUNTER X-1=0? 
7520			BNE LOPDIG					;NO,LOOP
7530			RTS							
7540	DIGEN1	JMP CMDEND					;TO END ERR.COMMAND 
7550	SKPEN1	LDA (RHL),Y					;GET A CHAR 
7560			CMP #$20					;CHAR=' '?
7570			BNE DIGEN1					;NO,ERR.
7580			INY							
7590			DEX							;COUNTER X-1=0? 
7600			BNE SKPEN1					;NO,LOOP
7610			LDA RWQ						;'DIGIT' TO A ,RETURN
7620			RTS							
7630	;MOVE ROUTINE
7640	;~~~~~~~~~~~~~~~~~~~~~~
7650	MV3CHR	LDX #$03					;X AS COUNTER FOR MOVING 3 BYT
7660	BLKMOV	LDY #$00
7670	BLKMO2	LDA (RHL),Y					;GET CHAR 
7680			STA (RDE),Y					;SAVE CHAR
7690			INY
7700			DEX							;COUNTER X-1=0? 
7710			BNE BLKMO2					;LOOP
7720			RTS
7730	;COMPUTE DIR.ADDR.&GET ACHAR.
7740	;~~~~~~~~~~~~~~~~~~~~~~~~~~~
7750	DMACUN	LDY	#DMAD 
7760			STY RHL
7770			LDY #DMAD/256
7780			STY	RHL+1					;RHL POINTES DMA ADDR. 
7790			CLC
7800			ADC RBC						;(C):DIR,RELATIV.POSITION 
7810			JSR	FIFCBM					;RHL+A TO RHL
7820			LDY #$00
7830			LDA	(RHL),Y					;GET A CHAR
7840			RTS
7850	;*******************************************
7860	;A:,B:,C:----,COMMAND
7870	;*******************************************
7880	PSDK	LDA IBUBC+$1				;DISK CHAR 
7890			SEC
7900			SBC #$41					;DISK NUMBER 
7910			PHA
7920			JSR SELDSK					;CHANR-DSK
7930			PLA
7940			STA DSKNUM
7950			JMP START
7960 ;*************************************
7970 ;DIR COMMAND HANDLE ROUTINE
7980 ;*************************************
7990	PDIR	JSR FIFCBB					;FILL FILE NAME IN FCB
8000			LDA WRKPLA 
8010			JSR SELDSK 
8020			LDA FCBPB 
8030			STA RHL
8040			LDA FCBPB+1 
8050			STA RHL+1					;RHL POINTES FCB
8060			LDY #$00
8070			STY FCBB+$0C				;CLARE SOME PLACE
8080			LDA (RHL),Y					;GET FIRST CHAR FOR D-NAME 
8090			CMP #$20					;CHAR=' '?
8100			ENE BRNCHB					;NO,BEGIN TO SEARCH FILE 
8110			LUX #$0B					;YES,X AS COUNTER FOR 11 CHAR 
8120	PATCHQ	LDA #$3F					;'?' TO A
8130			STA (RHL),Y					;'?' TO FCB
8140			INY
3150			DEX							;COUNTER X-1=0? 
8160			BNE PATCHQ					;NO,LOOP
8170	BRNCHB	LDA #$00
8180;
8190			STA RWK						;CLEAR COUNTER'RWK' 
8200			JSR	CRLF					;OUT 'CR' 'LF' 
8210			LDA	WRKPLA					;REQ.DISK
8220			CLC
8230			ADC #$41					;TO DISK NUMB. 
8240			JSR CHROB					;OUT DISK NAME
8250			LDA #$3A					;: TO A
8260			JSR CHROB					;OUT ':' 
8270			JSR SERFIL					;SEARCH FOR THE FIRST 
8280			BNE LOPDIR					;SEARCH SUCCESS,JUMP TO
8290			JSR PRTER2					;SEARCH FALSE,PRINT'NO FILE'
8300			JMP DIREND					;TO END COMMAND
8310	LOPDIR	LDA RETVAL					;RET VALUSE TO A
8320			ROR A
8330			ROR A
8340			ROR A 
8350			ROR A
8360			AND #$60
8370			STA RBC						;(RET VALUES*32) TO RBC
8380			STA RWQ
8390			LDA #$0A					;CHECK PROTECT
8400			JSR DMACUN					;COUNT DIR ADDRESS
8410			EMT NXTDR2					;
8420			LDA RWK
8430			INC RWK						;COUNTER+1
8440			AND #$03
3450			STA RWQ+1					;SAVE
8460			BNE WARMR
8470			JSR CRLF
8480			INC RWK
8490			JMP COMMON
8500	WARMR	JSR SPACE					;OUTPUT ' '
3510			JSR SPACE					;OUT ' '
8520			JSR SPACE					;OUT ' '
8530	COMMON	JSR SPACE					;OUTPUT ' '
8540			LDA RWQ
8550			STA RBC						;(C):RET.VAL.*32
8560			LDX #$01					;X AS COUNTER,INITIAL VAL 1
8570			SIX RNW						;SAVE 'X'REG.
8580	ONEDIR LDA RNW						;CHAR COUNTER TO A
8590			JSR DMACUN					;GET CHAR
8600			AND #$7F
8610			JSR CHROB					;OUT CHAR
8620			LDX RNW
8630			CPX #$08					;END FILE NAME ? 
8640;
8650;
8660;
8670;
8680;
8690			BNE MEDIR2
8700			JSR SPACE					;INSERT ' '
8710			LDX RNW
8720	MEDIR2	CPX	#$0C					;END TYPE?
8730			BEQ NXTDR2
8740			INC RNW
8750			BNE ONEDIR
8760	NXTDR2	LDA #$00
8770			JSR	DMACUN					;RHL PTR FCB 
8780			LDA	RHL
8790			STA	RDE
8800			LDA	RHL+1
8810			STA	RDE+1					;RDE PTR FCB
8820			LDA	FCBB
8830			LDY	#$00
8840			STA	(RHL),Y					;WRITE DSK TO FCB' 
8850			LDX	#$20					;COUNT PAGE NUMB.
8860			JSR	CDOSRT
8870			JSR	PRNPG1					;PRINT PAGE
8880			JSR	CSTATD					;GET CONSOLE STATUE 
8890			BNE	DIREND					;IF STAT.<>0,JUMP 
8900			JSR	SERNXT					;SEARCH FOR NEXT
8910			BEQ	DIREND
8920			JMP	LOPDIR
8930	DIREND	LDA	RWK						;COUNTER TO A
8940			JMP PEND
8950	;*************************************
8960	;* ERA COMMAND HANDLE ROUTINE		 *
8970	;*************************************
8980	PERA	JSR FIFCBB					;FILL FILE NAME IN FCB
8990			CMP #$0B					;RETURN IF RET '?'COUNT.=11
9000			BNE DELEFI					;NO,GO DELETE FILE
9010			LDA MSSAD3					;YES,ERR.
9020			STA RBC
9030			LDA MSGAD3+1				;
9040			STA RBC+1					;RBC POINTES MESSAGE'ALL(Y/N)?
9050			JSR STRIOA					;OUTPUT 'ALL (Y/N)?'
9060			JSR INBUFA					;WAIT FOR ANSWER
9070			LDA IBUBC					;INPUT BUFF COUNTER TO A
9080			CMP #$01					;BUFF COUNTER=1?
9090			BNE ERAEN1					;NO,GO TO END COMMAND
9100			LDA IBUFB					;YES,GET CHAR
9110			CMP #$59					;CHAR='Y'?
9120			BNE ERAEN1					;NO,ERR. JUMP
9130			INC IBUFPA					;PTR BUFF IN BUFF
9140	DELEFI	JSR	FCBTOD					;FCB PTR RDE
9150			JSR	DELFIL					;DELECT FILE ,A=0~3IF SUCCESS
9160			CMP	#$FF					;RET VAL.=$FF IF FALSE
9170			BEQ	ERAEN2					;FALSE,JUMP
9180			JMP	PEND					;SUCCESS,END
9190	ERAEN1	JMP START
9200	ERAEN2	JSR	PRTER2					;OUT 'NO FILE'
9210			JMP PEND
9220	;***********************************************
9230	;* TYPE COMMAND HANDLE ROUTINE					*
9240	;***********************************************
9250	PTYPE	JSR	FIFCBB					;FILL FILE NAME IN FCB
9260			BNE TYPEN1					;IF RET '?'COUNT<>0,GO TO END
9270			LDA WRKPLA
9280			JSR SELDSK
9290			JSR OPNFL					;OPEN FILE
9300			BEQ ERENDT					;OPEN FALSE,JUMP
9310			JSR CRLF					;SUCCESS,OUTPUT 'CR''LF'
9320	WRTTP	LDY #DMAD
9330			STY RHL
9340			LDY #DMAD/256
9350			STY RHL+1					;RHL POINTES DMAD
9360	TPBEGN	JSR RDSEQ					;READ DISK
9370			BNE TEND					;IF READ FALSE
9380			LDY #$00
9390	MEDTY	LDA (RHL),Y					;GET CHAR
9400			CMP #$1A					;CHAR=CTL-Z?,EOF? 
9410			BEQ BLNKT					;YES
9420			STY RNW 
9430			JSR CHROUT					;NO,OUTPUT A CHAR 
9440			JSR CSTATD					;GET CONSOLE STATUES 
9450			BNE BLNKT					;IF STATUES<>0,GO END
9460			LDY RNW
9470			INY
9480			CPY #$80					;TYPE 128 CHAR 
9490			BNE MEDTY					;NO,LOOP
9500			JMP TPBEGN 
9510	BLNKT	JMP PEND  
9520	TEND	CMP #$01					;'1'SHOWS EOF  
9530			BEQ BLNKT					;YES
9540			JSR PRTER1					;NO,OUTPUT'READ ERROR'
9550	ERENDT	NOP
9560	TYPEN1	JMP CMDEND					;TO END ERR. COMMAND
9570	BLNKS	JMP SAEND
9580	;******************************************
9590	;* SAVE COMMAND HANDLE ROUTINE				*
9600	;******************************************
9610	PSAVE	JSR DIGHD 					;FILL PAGE NUMB. RET NUMBER
9620			PHA				
9630			JSR FIFCBB					;FILL FILE NAME IN FCB,RET'?# 
9640			BNE TYPEN1					;'?'COUNT.<>0,ERR. GO ERR END
9650			LDA WRKPLA		
9660			JSR SELDSK		
9670			JSR FCBTOD					;FCB POINTER TO RDE
9680			JSR DELFIL					;DELECT FILE IF IT EXISTED
9690			JSR FCBTOD					;
9700			JSR MAKFIL					;MAKE FILE,RET'0'IF FALSE 
9710			BEO BLNKS					;FALSE,JUMP TO END
9720			LDA #$00		
9730			STA RWK+1		
9740			STA FCBBD					;CLEAR SOME PLACE
9750			CLC				
9760			PLA				
9770			STA RWK		
9780			ADC RWK						;NUMB.*2
9790			BCC ENTR1					;LOW BITS NO'C' JUMP
9800			INC RWK+1					;ADD'C'
9810	ENTR1	STA RWK						;PAGE N*2 TO RWK
9820			LDA #STRTD		
9830			STA RDE			
9840			LDA #STRTD/256	
9850			STA RDE+1		
9860	SAVBGN	LDA RWK	
9870			ORA RWK+1	
9880			BEO SFINSH					;CHECK PAGE NUMB.=0? 
9890			LDA RWK						;YES,END
9900			SEC	
9910			SBC #$01 
9920			BCS ENTR2 
9930			DEC RWK+1
9940	ENTR2	STA RWK
9950			LDA	#$80					;128 BYTES 
9960			CLC
9970			ADC	RDE						;+128
9980			STA RHL
9990			LDA RDE+1
10000			ADC #$00
10010			STA	RHL+1					;RHL POINTES NEXT RDE A@@R.
10020			JSR SETDMA					;USINC RDE,SET DMA
10030			JSR FCBTOD					;R@E POINTES FCB
10040			JSR WRSEQ					;WRITE SEQUANTIAL,RET 0 IF SUCCE 
10050			BNE SAEND					;WRIPA FALSE(ERRRRRR* AJD 
10060			LDA RHL
10070			STA RDE
10080			LDA RHL+1
10090			STA	RDE+1					;RDE POINTES NEW DIA ADDR. 
10100			JMP	SAVBGN					;LOOP
10110	SFINISH	JSR	FCBTOD					;RDE POINTES FCB
10120			JSR	CLSFIL					;CLOSE BILE
10130			CMP	#$00					;RETURN=0.CLOSE FALSE
10140			BNE	SAEND2					;SUCCASS,JUMPTO--
10150	SAEND	JSR	CRLF					;OUTPUT 'CR' 'LF'
10160			LDA MSOAD5
10170			STA RHL
10180			LDA MSGAD5+1
10190			STA RHL+1					;RHH POINPES 'NK SPACE'
10200			JSR STRIOB					;OUT 'NO SPACE'
10210	SAEND2	JSR	STDMAI					;INITIAL DMA ADDR.
10220			JMP PEND
10230	ERENDZ	JMP CMDEND					;END ERR.
10240	;************************************ 
10250	;* RENAME COMMAND HANDLE ROUTINE
10260	;************************************ 
10270	PREN	JSR FIFCBB					;FILL FILE NAME IN FCB,RET
10280			BNE ERENDZ					;IF RET'?'COUNTER<>0,ERR.
10290			LDA	WRKPLA					;REQUIRED DISK NO.TO A
10300			STA	WRKPLC					;SAVE
10310			LDA FCBP					;NO REPEAT NAME,
10320			STA RHL
10330			LDA FCBP+1
10340			STA	RHL+1					;RHL POINTES NEW FILE NAME FCB
10350			LDA FCBPC
10360			STA RDE
10370			LDA FCBPC+1
10380			STA RDE+1					;RDE POINTES TEMP.SAVE ARE
10390			LDX #$10					;X AS COUNTER FOR MOVING16 CHA
10400			JSR BLKMOV					;MOVE NEW NAME TO TEMP.AREA
10410			LDA IBUFPA
10420			STA	RDE
10430			LDA IBUFPA+1				;
10440			STA RDE+1					;RDE POINTES INPUT BUFFER
10450			JSR	SKPBLK					;TO SKIP ' '
10460			CMP	#$3D					;CHAR='='?
10470			BEQ	FIOLDN					;YES,JUMP TO FILL OLD NAME
10480			CMP	#$5F 					;CHAR='<-`? 
10490			BNE ERENDN 					;NO,ERR. JUMP
10500	FIOLDN	CLC
10510			LDA RDE
10520			ADC #$01
10530			STA IBUFPA
10540			LDA #$00
10550			ADC RDE+1
10560			STA IBUFPA+1				;MODIFY IN-BUFF PTR 
10570			JSR FIFCBB					;FILL OLD FILE NAME 
10580			BNE ERENDN					;RET '?'COUNT.<>0,ERR. 
10590			LDA FCBBC					;OLD DSK IN FCB
10600			BEQ USNEWN
10610			LDA FCBB
10620			BEQ USNEWN					;(A)=0,G0,USE NEW FILE DSK
10630			LDA WRKPLA
10640			CMP WRKPLC					;COMPARE NEW DSK WITH OLD D 
10650			BNE ERENDJ					;ERR.
10660	USNEWN	LDA FCBBC
10670			ORA FCBB
10680			STA FCBB
10690			STA FCBBC
10700			LDA FCBPC
10710			STA RDE
10720			LDA FCBPC+1
10730			STA RDE+1					;RDE PTRNEWFILE
10740			JSR SERFIL+3				;SEACH NEW FILE
10750			BNE ERENDR
10760			JSR SERFIL					;SEARCH FOR OLD NAME FILE
10770			BEQ PRTEND					;SEARCH FALSE,'NO FIRE'
10780			JSR FCBTOD					;SUCCESS,RDE POINT.FCB
10790			JSR RENFIL					;RENAME FILE
10800			JMP FEND					;NORMALLY END
10810	PRTEND	JSR PRTER2					;OUTPUT 'NO FILE'
10820			JMP FEND
10830	ERENDN	JMP CMDEND					;ERR.
10840	ERENDR	JSR CRLF					;OUTPUT 'CR' 'LF'
10850			LDA MSOAD7
10860			STA RHL
10870			LDA MSGAD7+1				;
10880			STA RHL+1					;RHL POINTES'FILE EXISTS`
10890			JSR STRIOB					;PRINT
10900			JMP PEND
10910	ERENDJ	JMP CMDEND					;END ERR.
10920	;******************************************
10930	;* USER COMMAND HANDLE ROUTINE
10940	;******************************************
10950	PUSER	JSR DIGHD					;FILL 'DIGIT'IN FCB COUNT
10960			CMP #$10					;USER CODE>=16?
10970			BCS ERENDJ					;YES,ERR. TO END
10980			LDX FCBBB
10990			CPX #$20					;1'S CHAR=' '? 
11000			BEQ ERENDJ 					;YES,ERR.
11010			JSR SETCOD					;SET USER CODE
11020	BLKTR	JMP PEND
11030	;******************************************
11040	;* TRANSIENT PROGRAM COMMAND HANDLE ROUTINE
11050	;******************************************
11060	;PTRANS LDA FCBB ;GET DSK NUMB. IN FCB
11010	;
11080	PTRANS	LDA WRKPLA
11090	;		STA DSKNUM
11100	;		DEC DSKNUM					;TO CHANGE CURRENT DISK
11110	;		JSR WRTDKN					;SAVE CURRENT DISK #0004
11120			JSR SELDSK
11130			LDA #FCBB 					;FCB ADDRESS
11140			STA RWK
11150			LDA #FCBB/256
11160			STA RWK+1 					;RWK PIR FCB
11170			JSR CKQUEN 					;COUNT'?'
11180			BNE ERENDJ 					;JUMP TO END ERR.COMMAND
11190			LDA IBUFPA+1
11200			PHA
11210			LDA IBUFPA
11220			PHA
11230	FICOM	LDA FCBB+9 					;TYPE 1'SCHAR
11240			CMP #$20
11250			BNE	ERENDJ 
11260			LDA	FCBP
11270			CLC	
11280			ADC	#$09
11290			STA	RDE
11300			LDA	#$00
11310			ADC	FCBP+1
11320			STA	RDE+1					;RDE POINTES (FCBP+8) 
11330			LDA	MSGDD9
11340			STA	RHL
11350			LDA	MSGDD9+1
11360			STA	RHL+1					;RHL POINTES 'COM' 
11370			JSR	MV3CHR					;FILL 'COM'IN FCB 
11380			JSR	OPNFL					;OPEN FILE
11390			BEQ	BLKJ6					;OPEN FALSE,ERR.
11400			LDA	#STRTD					;OPEN SUCCESS,
11410			STA	RWK
11420			LDA	#STRTD/256
11430			STA	RWK+1					;RWK POINTES INPUT ADDR,
11440	RDDSK	LDA RWK 
11450			STA	RDE
11460			LDA	RWK+1
11470			STA	RDE+1					;RDE POINTES INPUT ADDRESS 
11480			JSR	SETDMA					;SET DMA
11490			JSR	FCBTOD					;RDE POINTES FCB
11500			JSR	RDSEQB					;READ SEOUENTIAL,RETO IF SUCCES 
11510			BNE	RDEND					;REAR FALSE,GO END
11520			CLC
11530			LDA RWK						;GET INPUT ADDR.
11540			ADC #$80					;+128 BYTES
11550			STA RWK
11560			LDA #$00
11570			ADC RWK+1
11580			STA RWK+1					;RWK SAVE NEW INPUT ADDR. 
11590			CMP	#$B0					;CHECK OVER LOAD?
11600			BCS BLKJ7					;OVER,ERR.
11610			JMP RDDSK					;NO,LOOP
11620	BLKJ6	JMP PRTERB	
11630	BLKJ7	JMP PRTERP	
11640	RDEND	CMP #$01					;CHECK EOF?	
11650			BNE BLKJ7					;NO,ERR.
11660			JSR FIFCBB					;FILL FILENAME FOLLOWING COMMA. 
11670			INC WRKPLA	
11680			LDA WRKPLA					;FIRST FILE DSK TO A
11690			STA FCBB					;FILL
11700			STA RWQ						;SAVE
11710			LDA #$10					;FOR FILLING SECOND FILE NAME 
11720			JSR FIFCB					;SECOND FILE NAME TO FCB 
11730			LDA RWQ						;FIRST FILE DISK TO A
11740			STA FCBB+16					;AS SECOND FILE DISK		
11750			LDA #$00
11760			STA FCBB+32					;CLEAR A BYTE
11770			LDA #$10
11780			STA RDE
11790			LDA #$EF
11800			STA RDE+1					;RDE PTR $EF10 FOR 2'S FILE NAM 
11810			LDA FCBP
11820			STA RHL
11830			LDA FCBP+1
11840			STA RHL+1					;RHL POINTES FCB
11850			LDX #$21					;X AS COUNTER FOR 33CHAR
11860			JSR BLKMOV					;MOVE FROM FCB TO NEW SAVE AREA
11870;
11880;
11890;
11900;
11910;
11920;	
11930			PLA
11940			STA RHL
11950			PLA
11960			STA RHL+1					;RHL POINTES INPUT BUFFER 
11970			LDY #$00
11980	FNBLK	LDA (RHL),Y					;GET CHAR 
11990			BEQ MVEND
12000			CMP #$20					;CHAR=' '/
12010			BNE	NEWLIN					;Y,JMP
12020			LDA $#01
12030			JSR FIFCBM					;RHL+1
12040			JMP	FNBLK					;LOOP
12050	NEWLIN	LDX #$00					;INITIAL COUNTER X=0
12060			LDA #DMAD
12070			STA RDE
12030			LDA #DMAD/256
12090			STA RDE+1
12100			INC RDE						;RDE PTR $E965 FOR SAVING OTHER
12110			LDY #$00
12120	MVSTAR	LDA (RHL),Y
12130			STA (RDE),Y					;MOVE A CHAR
12140			BEQ MVEND					;IF CHAR=0,ST0P MOVING
12150			INX							;COUNTER X+1 
12160			INY
12170			JMP MVSTAR					;LOOP 
12180	MVEND	TXA
12190			LDY #$00		
12200			DEC RDE		
12210			STA (RDE),Y					;$E965 SAVE INFO, COUNTER
12220	;FROM $E966 TO E966+(E965 COUNT) SAVE ALL PARAME.
12230	;FROM $EF10 TO EF30 SAVE SAVE TWO COMMAND INCL.DSK
12240	;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
12250	;*************************************************
12260			JSR CRLF					;OUTPUT 'CR' 'LF'
12270			JSR STDMAI					;SET DMA=DMAD
12280	EXECUT	JSR	STRTD 					;GO TO EXECUTE PROGRAM
12290			LDA	DSKNUM					;CURRENT DISK
12300			JSR SELDSK					;SELECT CURRENT DISK
12310			JMP START		
12320	PRTERB	NOP
12330			JMP CMDEND					;ERR.END
12340	PRTERP	JSR	CRLF					;OUTPUT 'CR' 'LF'
12350			LDA MSGBA2
12360			STA RHL
12370			LDA MSGBA2+1				;
12380			STA RHL+1					;RHL POINTES 'BAD LOAD'
12390			JSR STRIOB					;PRINT 
12400			JMP	PEND
12410	PEND	JSR FIFCBB					;FILL REMAIN SOMETHING 
12420			LDA FCBBB					;GET CHAR FROM FCB
12430			SEC
12440			SBC #$20					;SUB ' 'VALUE 
12450			ORA WRKPLA
12460			BNE PENER					;(A)<>0,ERR,END 
12470			JMP START					;END NORMALLY
12480	PENER	JMP CMDEND					;
12490	MSGVER	.BYTE 'O.U.6502 CP/M VERSION',$0D,$0A
12500			.BYTE ' DIR ERA TYPE SAVE REN B:',$00
12510;
12520;
12530;
12540;
12550;
12560	RDERR	.BYTE 'READ ERROR',$00
12570	NOFERR	.BYTE 'NO FILE',$00
12580	MSGADI	.BYTE 'ALL (Y/N)?',$00
12590	MSGAD4	.BYTE 'NO SPACE',$00
12600	MSGAD6	.BYTE 'FILE EXISTS',$00
12610	MSGDD8	.BYTE 'COM'
12620	MSGBA1	.BYTE 'BAD L0AD',$00
12630			.END