-
Notifications
You must be signed in to change notification settings - Fork 0
/
double-dos.s
1884 lines (1650 loc) · 49.2 KB
/
double-dos.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
;;; ============================================================
;;; Disassembly of "Double-Duty DOS" by Jason Coleman
;;; From Compute! Magazine, Issue 89 (October 1987)
;;; ============================================================
.setcpu "6502"
.org $3000
.include "apple2.inc"
.include "apple2.mac"
.include "prodos.inc"
.include "dos33.inc"
INPUT_BUFFER := $200
UPPERCASE_MASK := $DF
;;; Monitor ROM entry points
CR := $FC62
COUT := $FDED
MOVE := $FE2C
;;; Zero Page Locations
STARTLO := $3C
STARTHI := $3D
ENDLO := $3E
ENDHI := $3F
DESTINATIONLO := $42
DESTINATIONHI := $43
TXTTAB := $67 ; Start of Applesoft program
VARTAB := $69 ; Start of Applesoft variables
PRGEND := $AF ; End of Applesoft program
;;; For character literals; sets high bit. (Like scrcode)
.define scrchar(c) ((c)|$80)
;;; ============================================================
;;; Entry Point
;;; ============================================================
;;; Request buffer from BASIC Interpreter
lda #$0A ; number of pages
jsr GETBUFR
bcc :+
lda #BI_ERR_PROGRAM_TOO_LARGE
jmp ERROUT
:
;; This relocation code updates any bytes in the code from the
;; original pages ($31...$3A) to the final pages returned by
;; GETBUFR. The code works by building a table of target pages
;; and updating most $3x bytes on source pages to the targets.
;; This handles both absolute addresses (e.g. JMP $3456) and
;; immediate values (e.g. LDA #$34). This only works because:
;; * 6502 opcodes $31-$37 and $39-$3F are unused in the code
;; * $38 (opcode SEC) is skipped by the update logic
;; * string data has high bytes set so is automatically skipped
;; * code on page $38 is explicitly patched with dedicated code
;; * constants mistakenly patched are explicitly restored
;; Build up target page table for source pages $31...$37
tax ; X = high byte of buffer
ldy #0
: txa
sta reloc_target_page_table,y
inx
iny
cpy #7
bcc :-
;; X = target page for page $38
stx explicit_patch1 ; explicit relocation patch (on page $38)
stx explicit_patch2 ; explicit relocation patch (on page $38)
;; Finish up target page table for source pages $39 and $3A
inx ; X = $39
txa
sta reloc_target_page_table,y
inx ; X = $3A
iny
txa
sta reloc_target_page_table,y
;; Update all pages to be relocated
ldy #$00 ; byte index in page
read_src_page := *+2
ploop: lda ExternalCommand,y
ldx #0 ; index in page tables
iloop: cmp reloc_start_page_table,x
beq write
inx
cpx #page_table_size
bcc iloop
;; Next byte
nextb: iny
bne ploop
;; Next page
inc read_src_page
inc write_src_page
lda read_src_page ; done?
cmp #(>reloc_end)+1
bcc ploop
bcs move_and_hook ; always
;; Update byte to target page
write: lda reloc_target_page_table,x
write_src_page := *+2
sta ExternalCommand,y
bne nextb ; always
page_table_size = 9
;;; Source pages
;;; ($38 is SEC so excluded)
reloc_start_page_table:
.byte $31, $32, $33, $34, $35, $36, $37, $39, $3A
;;; Target pages
reloc_target_page_table:
.res 9, 0
;;; Move into target buffer and hook into BI CMD syntaxing
move_and_hook:
lda #>ExternalCommand
sta STARTHI
lda #$37 ; explicit relocation patch restoration
sta explicit_patch3 ; (undoing the auto-patch above)
lda EXTRNCMD+1
sta extrncmd_hook+1
lda EXTRNCMD+2
sta extrncmd_hook+2
lda #>reloc_end
sta ENDHI
ldy #<reloc_end
sty ENDLO
.assert <reloc_end = $FF, error, "bad optimization"
iny ; Y = 0
sty STARTLO
sty DESTINATIONLO
sty EXTRNCMD+1
lda reloc_target_page_table
sta DESTINATIONHI
sta EXTRNCMD+2
jsr MOVE
;;; Print message
ldy #$00
: lda install_message_str,y
beq :+
jsr COUT
iny
bne :-
:
rts
install_message_str:
scrcode "DCAT, DSAVE, AND DLOAD NOW INSTALLED"
.byte $8D
scrcode "WRITTEN BY JASON COLEMAN, JULY, 1986"
.byte $8D
.byte $8D
;; Pad to page boundary
.res $3100 - *, 0
;;; ============================================================
;;; External Command Implementation
;;; ============================================================
ExternalCommand:
cld ; Expected by ProDOS
;; DCAT?
ldy #0
ldx #0
: lda INPUT_BUFFER,y
iny
cmp #scrchar(' ') ; skip whitespace
beq :-
and #UPPERCASE_MASK
cmp dcat_cmd_str,x
bne :+
inx
cpx #.strlen("DCAT")
beq DoDCAT
bne :- ; always
dcat_cmd_str:
scrcode "DCAT"
:
;; DLOAD?
ldy #0
ldx #0
: lda INPUT_BUFFER,y
iny
cmp #scrchar(' ') ; skip whitespace
beq :-
and #UPPERCASE_MASK
cmp dload_cmd_str,x
bne :+
inx
cpx #.strlen("DLOAD")
bne :-
jmp DoDLOAD
:
;; DSAVE?
ldy #0
ldx #0
: lda INPUT_BUFFER,y
iny
cmp #scrchar(' ') ; skip whitespace
beq :-
and #UPPERCASE_MASK
cmp dsave_cmd_str,x
bne :+
inx
cpx #.strlen("DSAVE")
bne :-
jmp DoDSAVE
:
;; Failed to match
sec
extrncmd_hook:
jmp $0000
dsave_cmd_str:
scrcode "DSAVE"
dload_cmd_str:
scrcode "DLOAD"
;;; ============================================================
;;; DCAT Command
;;; ============================================================
.proc DoDCAT
;; Ask BASIC.SYSTEM to parse command line for us
.assert .strlen("DCAT") = PBitsFlags::SD, error, "mismatch"
stx PBITS+1
dex
stx XLEN
lda #>DCATImpl
sta XTRNADDR+1
lda #<DCATImpl
sta XTRNADDR
lda #$00
sta XCNUM
lda #PBitsFlags::FNOPT
sta PBITS
clc
rts
;; Interpret parameters
DCATImpl:
;; Compute unit_num
lda VSLOT
sta DEFSLT
asl a
asl a
asl a
asl a
ldx VDRIV
stx DEFDRV
dex
beq :+
ora #$80 ; D1 -> D2
: sta rwts_params_unit_num
;; Read VTOC
lda #RWTSRead
sta rwts_params_op
lda #dos33::VTOCTrack
ldy #dos33::VTOCSector
sta rwts_params_track
sty rwts_params_sector
lda HIMEM+1
sta rwts_params_data_buf+1
lda #$00
sta rwts_params_data_buf
ldy #>rwts_params
lda #<rwts_params
jsr DoRWTS
bcc :+
jmp ErrIOError
:
jsr CR
ldy #dos33::VTOC::VolumeNumber
lda (HIMEM),y
sta $02
ldy #.strlen("DISK VOLUME")-1
: lda disk_volume_str,y
jsr COUT
dey
bpl :-
lda #scrchar(' ')
jsr COUT
lda $02 ; volume number
jsr PrintByte
jsr CR
jsr CR
;;; "Beneath Apple DOS" says first catalog T/S is VTOC bytes $01/$02.
;;; This code assumes the standard progression from T17/S15 through
;;; T17S01.
;;; TODO: Consider not hard-coding it.
cur_cat_sector_offset = $03
ldy #dos33::DefaultFirstCatalogSector
sty rwts_params_sector
sector_loop:
ldy #>rwts_params
lda #<rwts_params
jsr DoRWTS
bcc :+
jmp ErrIOError
:
lda HIMEM+1
sta $01
lda HIMEM
sta $00
ldy #dos33::FirstFileOffset
file_loop:
sty cur_cat_sector_offset
lda ($00),y ; +$00 "Track of first track/sector list sector"
bne L3205 ; $00 = entry is free
jmp exit_success
L3205: cmp #$FF ; $FF = entry is deleted
beq next_file
iny
iny ; +$02 "File type and flags"
;; Locked?
lda ($00),y
bmi L3217 ; high bit = locked
lda #scrchar(' ')
jsr COUT
jmp L321C
L3217: lda #scrchar('*')
jsr COUT
;; File type
L321C: lda ($00),y
and #$7F ; mask off type
.assert dos33::FileTypeText = 0, error, "mismatch"
beq type_t
cmp #dos33::FileTypeInteger
beq type_i
cmp #dos33::FileTypeApplesoft
beq type_a
cmp #dos33::FileTypeBinary
beq type_b
bne next_file ; always
type_t: lda #scrchar('T')
bne :+ ; always
type_i: lda #scrchar('I')
bne :+ ; always
type_a: lda #scrchar('A')
bne :+ ; always
type_b: lda #scrchar('B')
: jsr COUT
lda #scrchar(' ')
jsr COUT
;; Sectors
lda cur_cat_sector_offset
clc
adc #dos33::FileEntry::Length
tay
lda ($00),y
jsr PrintByte
lda #scrchar(' ')
jsr COUT
ldy cur_cat_sector_offset
iny
iny
iny ; +$03 - "File name (30 characters)
;; Filename
ldx #$00
L325D: lda ($00),y
jsr COUT
iny
inx
cpx #dos33::MaxFilenameLen-1
bne L325D
jsr CR
;; Pause?
lda KBD
bpl next_file
lda #$00
sta KBDSTRB
L3275: lda KBD
bpl L3275
lda #$00
sta KBDSTRB
next_file:
lda cur_cat_sector_offset
clc
adc #.sizeof(dos33::FileEntry)
tay
bcs next_sector
jmp file_loop
;;; "Beneath Apple DOS" says bytes $01/$02 of each catalog sector is
;;; T/S of next catalog sector. This code assumes the standard
;;; progression from T17/S15 through T17S01.
;;; TODO: Consider not hard-coding it.
next_sector:
dec rwts_params_sector
beq exit_success
jmp sector_loop
exit_success:
jsr CR
jsr CR
clc
lda #$00
rts
disk_volume_str:
scrcode "EMULOV KSID" ; "DISK VOLUME" reversed
.proc PrintByte
sta num
ldy #2 ; num digits - 1
dloop: lda #$00
pha
sloop: lda num
cmp digits_table,y
bcc :+
sbc digits_table,y
sta num
pla
clc
adc #1
pha
jmp sloop
: pla
ora #scrchar('0')
jsr COUT
dey
bpl dloop
rts
num: .byte 0
.byte 0 ; unused!
digits_table:
.byte 1, 10, 100
.endproc
.endproc
;;; ============================================================
;;; DLOAD Command
;;; ============================================================
;;; INPUT_BUFFER is used to hold the filename, length prefixed
;;; HIMEM points at RWTS buffer for catalog and track/sector list
;;; HIMEM+$200 is used for file data
.proc DoDLOAD
;; Parse command buffer
ldx #$00
: lda INPUT_BUFFER,y
iny
cmp #$8D ; CR
beq fail
cmp #scrchar(' ') ; skip whitespace
beq :-
;; Shuffle filename down to start of buffer
parse_loop:
cmp #$8D ; CR
beq done_name
cmp #scrchar(',')
beq done_name
cmp #$E0 ; lowercase plane?
bcc :+
and #UPPERCASE_MASK ; force to uppercase
: sta INPUT_BUFFER+1,x
inx
lda INPUT_BUFFER,y
iny
bne parse_loop
fail: sec
rts
done_name:
;; Truncate name if too long
cpx #dos33::MaxFilenameLen+1
bcc :+
ldx #dos33::MaxFilenameLen
;; Prefix buffer with name length
: stx INPUT_BUFFER
dey
sty XLEN
;; Let BASIC.SYSTEM parse arguments
lda #<DLOADImpl
sta XTRNADDR
lda #>DLOADImpl
sta XTRNADDR+1
lda #$00
sta XCNUM
lda #PBitsFlags::FNOPT
sta PBITS
lda #PBitsFlags::AD | PBitsFlags::SD
sta PBITS+1
clc
rts
;;; --------------------------------------------------
DLOADImpl:
;; Compute unit_num
lda VSLOT
sta DEFSLT
asl a
asl a
asl a
asl a
ldx VDRIV
stx DEFDRV
dex
beq :+
ora #$80 ; D1 -> D2
: sta rwts_params_unit_num
;; Search the catalog for a matching file entry
lda HIMEM+1
sta rwts_params_data_buf+1
lda #$00
sta rwts_params_data_buf
lda #dos33::VTOCTrack
sta rwts_params_track
lda #dos33::DefaultFirstCatalogSector
sta rwts_params_sector
catalog_sector_loop:
ldy #>rwts_params
lda #<rwts_params
jsr DoRWTS
bcc :+
jmp ErrIOError
:
lda #dos33::FirstFileOffset + dos33::FileEntry::Name
;; Check for filename match
entry_loop:
tay
ldx #0
cur_load_sector_offset = $02
sty cur_load_sector_offset
cloop: lda (HIMEM),y
beq ErrPathNotFound ; $00 in name; invalid entry, just fail
cmp INPUT_BUFFER+1,x
bne next_entry
inx
cpx INPUT_BUFFER
beq possible_match
iny
bne cloop
next_entry:
lda cur_load_sector_offset
clc
adc #.sizeof(dos33::FileEntry)
bcc entry_loop
;; Next catalog sector
ldy rwts_params_sector
dey
beq ErrPathNotFound
sty rwts_params_sector
bne catalog_sector_loop
ErrPathNotFound:
lda #BI_ERR_PATH_NOT_FOUND
sec
rts
possible_match:
cpx #dos33::MaxFilenameLen
beq found_match
iny
lda (HIMEM),y
cmp #scrchar(' ')
bne next_entry
inx
bne possible_match
;;; --------------------------------------------------
;;; Found a matching filename
found_match:
;; Look up track/sector of file's first track/sector list sector
ldy cur_load_sector_offset
dey
dey
dey ; Y = +`dos33::FileEntry::Track`
lda (HIMEM),y
bmi ErrPathNotFound
sta rwts_params_track
iny ; Y = +`dos33::FileEntry::Sector`
lda (HIMEM),y
sta rwts_params_sector
;; Set up buf for loading track/sector list (HIMEM + $200)
ldx rwts_params_data_buf+1
inx
inx
stx rwts_params_data_buf+1
tslist_buf_ptr := $06
;; ... and point `tslist_buf_ptr` at it too
stx tslist_buf_ptr+1
ldx #$00
stx tslist_buf_ptr
iny ; Y = +`dos33::FileTypeFlags`
;; Determine file type - Applesoft or binary?
lda (HIMEM),y
and #$7F ; mask off Locked bit
cmp #dos33::FileTypeApplesoft
beq load_applesoft
cmp #dos33::FileTypeBinary
bne :+
jmp load_binary
:
sec
lda #$0D
rts
;;; --------------------------------------------------
load_applesoft:
;; Load first sector of track/sector list
lda #<rwts_params
ldy #>rwts_params
jsr DoRWTS
bcc :+
jmp ErrIOError
:
;; Set up data load start location - Applesoft start in memory.
;;
;; We don't need to special case loading the first sector
;; because while the first two bytes encode the length (1) we
;; always just load whole sectors anyway so we can continue
;; without knowing the length, and (2) the BASIC program in
;; memory has a two byte length prefix at `(TXTTAB)` anyway.
lda TXTTAB
ldy TXTTAB+1
sec
sbc #$02
bcs :+
dey
: sta rwts_params_data_buf
sty rwts_params_data_buf+1
ldy #$00
sty load_type_flag ; 0 = Applesoft
iny ; Y = $01 = `dos33::TSList::NextTrack`
lda (tslist_buf_ptr),y
sta next_load_track
iny ; Y = $02 - `dos33::TSList::NextSector`
lda (tslist_buf_ptr),y
sta next_load_sector
ldy #$0C ; Y = $0C - `dos33::TSList::FirstDataT`
;; fall through
;;; --------------------------------------------------
tslist_offset := $02
;;; Read data sectors in Applesoft file. Reads until T/S list entries
;;; are exhausted, then jumps to `load_next_tslist_sector` which may
;;; jump back here.
;;; Enter with Y = offset in Track/Sector List buffer
load_applesoft_data_sector:
;; Look up next T/S in list
lda (tslist_buf_ptr),y
beq finish_applesoft_load
sta rwts_params_track
iny
lda (tslist_buf_ptr),y
iny
sta rwts_params_sector
sty tslist_offset
;; Load it
lda #<rwts_params
ldy #>rwts_params
jsr DoRWTS
bcc :+
jmp ErrIOError
:
ldy tslist_offset
beq load_next_tslist_sector
inc rwts_params_data_buf+1
lda rwts_params_data_buf+1
cmp HIMEM+1 ; don't allow loading over buffer
bcc load_applesoft_data_sector
lda #BI_ERR_PROGRAM_TOO_LARGE
rts
finish_applesoft_load:
;; Set up parameters for Applesoft program
lda rwts_params_data_buf
sta VARTAB
sta PRGEND
lda rwts_params_data_buf+1
sta VARTAB+1
sta PRGEND+1
ldy #$00
tya
dec TXTTAB
sta (TXTTAB),y
inc TXTTAB
clc
rts
;;; --------------------------------------------------
;;; Loads the next Track/Sector List sector. Used by both the
;;; Applesoft and Binary file loading loops; jumps back to appropriate
;;; caller using `load_type_flag`.
load_next_tslist_sector:
;; Store current data load pointer
lda rwts_params_data_buf
sta stash_data_buf_ptr
lda rwts_params_data_buf+1
sta stash_data_buf_ptr+1
;; Load into dedicated buffer
lda tslist_buf_ptr
sta rwts_params_data_buf
lda tslist_buf_ptr+1
sta rwts_params_data_buf+1
lda next_load_track
sta rwts_params_track
lda next_load_sector
sta rwts_params_sector
lda #<rwts_params
ldy #>rwts_params
jsr DoRWTS
bcc :+
jmp ErrIOError
:
;; Restore previous data load pointer
lda stash_data_buf_ptr
sta rwts_params_data_buf
lda stash_data_buf_ptr+1
sta rwts_params_data_buf+1
ldy #dos33::TSList::FirstDataT
lda load_type_flag
bne :+
jmp load_applesoft_data_sector ; expects Y = $0C
:
sty tslist_offset
jmp load_binary_data_sector ; just uses `tslist_offset`
;;; --------------------------------------------------
;;; $00 if Applesoft, binary otherwise
load_type_flag: .byte 0
stash_data_buf_ptr: .addr 0
next_load_sector: .byte 0
next_load_track: .byte 0
;;; --------------------------------------------------
load_binary:
;; Load first sector of track/sector list
lda #<rwts_params
ldy #>rwts_params
jsr DoRWTS
bcc :+
jmp ErrIOError
:
ldy #dos33::TSList::NextTrack
lda (tslist_buf_ptr),y
sta next_load_track
iny ; Y = $02 - `dos33::TSList::NextSector`
lda (tslist_buf_ptr),y
sta next_load_sector
ldy #dos33::TSList::FirstDataT
sty load_type_flag ; non-zero = binary
;; Unlike Applesoft, for Binary file we need to load the
;; first sector and extract the start address (first two
;; bytes) and length (next two bytes).
lda (tslist_buf_ptr),y
sta rwts_params_track
iny
lda (tslist_buf_ptr),y
iny
;; Y points at next T/S list entry
sty tslist_offset
sta rwts_params_sector
lda HIMEM+1
sta rwts_params_data_buf+1
ldy #$00
sty rwts_params_data_buf
lda #<rwts_params
ldy #>rwts_params
jsr DoRWTS
bcc :+
jmp ErrIOError
:
;; First sector loaded; determine load address
ldx VADDR+1 ; Use VADDR if passed
lda VADDR
ldy FBITS+1
bmi :+ ; A parameter was passed
ldy #$01 ; Not passed, use bytes +$00/+$01
lda (HIMEM),y
sta $04 ; unused!
dey ; Y = $00
tax
lda (HIMEM),y
sta $03 ; unused!
;; A,X = load address
:
cpx HIMEM+1 ; can't load past HIMEM
bcc :+
lda #BI_ERR_PROGRAM_TOO_LARGE
rts
:
;; A,X -= 4
sec
sbc #$04
bcs :+
dex
:
load_addr_stash = $08
sta load_addr_stash
stx load_addr_stash+1
;; Copy first page of data into place (offset by -4)
;; TODO: Does this trash the prior 4 bytes in memory?
ldy #0
: lda (HIMEM),y
sta (load_addr_stash),y
iny
bne :-
;; Target address for next page of data
lda load_addr_stash
sta rwts_params_data_buf
ldy load_addr_stash+1
iny
sty rwts_params_data_buf+1
;; fall through
;;; --------------------------------------------------
;;; Read data sectors in binary file. Reads until T/S list entries are
;;; exhausted, then jumps to `load_next_tslist_sector` which may jump
;;; back here.
;;; Enter with `tslist_offset` set correctly.
load_binary_data_sector:
ldy tslist_offset
bne :+
jmp load_next_tslist_sector
:
;; Look up next T/S in list
lda (tslist_buf_ptr),y
beq finish_binary_load
sta rwts_params_track
iny
lda (tslist_buf_ptr),y
sta rwts_params_sector
iny
sty tslist_offset
;; Load it
lda #<rwts_params
ldy #>rwts_params
jsr DoRWTS
bcc :+
jmp ErrIOError
:
inc rwts_params_data_buf+1
lda rwts_params_data_buf+1
cmp HIMEM+1
bcc load_binary_data_sector
lda #BI_ERR_PROGRAM_TOO_LARGE
rts
finish_binary_load:
clc
rts
.endproc
;;; ============================================================
;;; DSAVE Command
;;; ============================================================
.proc DoDSAVE
ldx #$00
: lda INPUT_BUFFER,y
iny
cmp #scrchar(' ')
beq :-
;; Shuffle filename down to start of buffer
parse_loop:
cmp #$8D ; CR
beq :+
cmp #scrchar(',')
beq :+
sta INPUT_BUFFER+1,x
inx
lda INPUT_BUFFER,y
iny
bne parse_loop
:
;; Prefix buffer with name length
stx INPUT_BUFFER
dey
sty XLEN
;; Let BASIC.SYSTEM parse arguments
lda #<DSAVEImpl
sta XTRNADDR
lda #>DSAVEImpl
sta XTRNADDR+1
lda #$00
sta XCNUM
lda #PBitsFlags::FNOPT
sta PBITS
lda #PBitsFlags::AD | PBitsFlags::L | PBitsFlags::SD
sta PBITS+1
clc
rts
DSAVEImpl:
ldx INPUT_BUFFER
bne :+
lda #BI_ERR_SYNTAX_ERROR
sec
rts
:
;; Truncate name if too long
cpx #dos33::MaxFilenameLen+1
bcc :+
lda #dos33::MaxFilenameLen
sta INPUT_BUFFER
:
;; Compute unit_num
lda VSLOT
sta DEFSLT
asl a
asl a
asl a
asl a
ldx VDRIV
stx DEFDRV
dex