-
Notifications
You must be signed in to change notification settings - Fork 7
/
Copy pathCCP.s
1186 lines (1186 loc) · 34.5 KB
/
CCP.s
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
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ÑHANDLE' IF CHAR<' '
3960 CMP #$3D ;CHAR='='?
3970 BEQ CHEND ;YES,RETURN Z=0
3980 CMP #$5F ;CHAR='<Ñ'?
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'