-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathintbasic.system.s
1981 lines (1653 loc) · 51.3 KB
/
intbasic.system.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
.include "apple2.inc"
.include "apple2.mac"
.include "opcodes.inc"
;;; ============================================================
;;; Memory map
;;; ============================================================
;;; Main Memory ROM
;;; $FFFF +-----------+ +-----------+
;;; $F800 | ProDOS | | Monitor |
;;; | | +-----------+
;;; | | | Applesoft |
;;; $E000 | +-----------+ | |
;;; | | ProDOS | | |
;;; $D000 +----+-----------+ +-----------+
;;; | Firmware |
;;; | I/O |
;;; $C000 +-----------+ +-----------+
;;; | ProDOS GP |
;;; $BF00 +-----------+
;;; | Command |
;;; | Processor |
;;; $B625 +-----------+ Initialize
;;; | IntBASIC |
;;; | |
;;; | |
;;; $A000 +-----------+ BASIC_START
;;; | IO_BUFFER |
;;; $9C00 +-----------+ HIMEM
;;; | Program |
;;; | | |
;;; | v |
;;; : :
;;; : :
;;; | ^ |
;;; | | |
;;; | Variables |
;;; $0800 +-----------+ LOMEM
;;; | Text Pg.1 |
;;; $0400 +-----------+
;;; | (free)... |
;;; $0300 +-----------+
;;; | Input Buf |
;;; $0200 +-----------+
;;; | Stack |
;;; $0100 +-----------+
;;; | Zero Page |
;;; $0000 +-----------+
;;;
;;; ============================================================
;;; Equates
;;; ============================================================
;;; Monitor Equates
CSWL = $36
A1L = $3c ;general purpose
A1H = $3d ;general purpose
A2L = $3e ;general purpose
A2H = $3f ;general purpose
A4L = $42 ;general purpose
A4H = $43 ;general purpose
HOME = $FC58
MOVE = $FE2C
PRBYTE = $FDDA
COUT = $FDED
;;; ProDOS Equates
MLI := $BF00
DEVNUM := $BF30
BITMAP := $BF58
BITMAP_SIZE = 24
DATELO := $BF90
TIMELO := $BF92
QUIT = $65
CREATE = $C0
DESTROY = $C1
RENAME = $C2
SET_FILE_INFO = $C3
GET_FILE_INFO = $C4
ON_LINE = $C5
SET_PREFIX = $C6
GET_PREFIX = $C7
OPEN = $C8
READ = $CA
WRITE = $CB
CLOSE = $CC
GET_EOF = $D1
FILE_ENTRY_SIZE = $27
FT_TXT = $04
FT_BIN = $06
FT_DIR = $0F
FT_INT = $FA
FT_IVR = $FB
FT_BAS = $FC
FT_SYS = $FF
ERR_FILE_NOT_FOUND = $46
ERR_DUPLICATE_FILENAME = $47
ERR_INCOMPATIBLE_FILE_FORMAT = $4A
ZP_SAVE_ADDR := $3A ; ProDOS owns this ZP chunk
ZP_SAVE_LEN = $15
;;; ============================================================
;;; Macros
;;; ============================================================
.define _is_immediate(arg) (.match (.mid (0, 1, {arg}), #))
.define _immediate_value(arg) (.right (.tcount ({arg})-1, {arg}))
.macro LDXY arg1
.if _is_immediate {arg1}
ldx #<_immediate_value {arg1}
ldy #>_immediate_value {arg1}
.else
ldx arg1
ldy arg1+1
.endif
.endmacro
.macro STXY addr
stx addr
sty addr+1
.endmacro
.macro COPY16 arg1, arg2
LDXY arg1
STXY arg2
.endmacro
.macro MLI_CALL call, params
jsr MLI
.byte call
.addr params
.endmacro
;;; ============================================================
;;; System Program
;;; ============================================================
IO_BUFFER := $9C00
OUR_HIMEM := IO_BUFFER
BASIC_START := $A000 ; Update `BITMAP` code if this changes
PATHBUF := $280
PATH2 := $2C0
.define STARTUP_FILE_NAME "HELLO"
;;; ProDOS Interpreter Protocol
;;; ProDOS 8 Technical Reference Manual
;;; 5.1.5.1 - Starting System Programs
.org $2000
jmp start
.byte $EE, $EE ; Interpreter signature
.byte $41 ; path buffer length
path: .byte .strlen(STARTUP_FILE_NAME), STARTUP_FILE_NAME
.res path+$41-*,0 ; path buffer
;;; Just used to test if startup file exists
gfi_startup:
.byte $A ; param_count (in)
.addr PATHBUF ; pathname (in)
.byte 0 ; access (out)
.byte 0 ; file_type (out)
.word 0 ; aux_type (out)
.byte 0 ; storage_type (out)
.word 0 ; blocks_used (out)
.word 0 ; mod_date (out)
.word 0 ; mod_time (out)
.word 0 ; create_date (out)
.word 0 ; create_time (out)
;;; Shown if startup file does not exist
banner:
;; "----------------------------------------"
scrcode " INTEGER BASIC"
.byte $8D
scrcode " COPYRIGHT 1977, APPLE COMPUTER INC."
.byte $8D
.byte 0
start:
;;; --------------------------------------------------
;;; Copy path somewhere safe
ldx path
stx PATHBUF
beq done_path
;; Non-empty path - copy it
: lda path,x
sta PATHBUF,x
dex
bpl :-
done_path:
;;; --------------------------------------------------
;;; Set PREFIX if blank
ON_LINE_BUF = PATH2+1
MLI_CALL GET_PREFIX, prefix_params
lda PATH2
bne prefix_ok
lda DEVNUM
sta on_line_unit_num
MLI_CALL ON_LINE, on_line_params
lda ON_LINE_BUF
and #$0F ; mask off length
tax
inx
stx PATH2
lda #'/'
sta PATH2+1
MLI_CALL SET_PREFIX, prefix_params
prefix_ok:
;;; --------------------------------------------------
;;; Display banner (if startup file not present)
MLI_CALL GET_FILE_INFO, gfi_startup
beq skip_banner
do_banner:
jsr HOME
ldx #0
: lda banner,x
beq done_banner
jsr COUT
inx
bne :- ; always
skip_banner:
;; Unless Open- or Solid-Apple is down, hook END/ERRMESS to QUIT
lda BUTN0
ora BUTN1
bmi done_banner
lda #OPC_JMP_abs
LDXY #reloc__QuitFromIntBASIC
sta reloc + (intbasic__WARM - BASIC_START)
STXY reloc + (intbasic__WARM+1 - BASIC_START)
done_banner:
;;; --------------------------------------------------
;;; Bug fixes
GR_TOKEN = 76
LDXY #reloc__OurSETGR
stx reloc + (intbasic__VERBADRL - BASIC_START) + GR_TOKEN
sty reloc + (intbasic__VERBADRH - BASIC_START) + GR_TOKEN
;;; --------------------------------------------------
;;; Hook CALL instruction
lda #OPC_JMP_abs
LDXY #reloc__OurCALL
sta reloc + (intbasic__CALL - BASIC_START) + 3
STXY reloc + (intbasic__CALL - BASIC_START) + 4
;;; --------------------------------------------------
;;; Configure system bitmap
ldx #BITMAP_SIZE-1
lda #0
: sta BITMAP,x
dex
bpl :-
lda #%11001111 ; ZP, Stack, Text Page 1
sta BITMAP
.assert BASIC_START = $A000, error, "Keep BASIC_START and BITMAP in sync"
lda #%11111111
sta BITMAP+$A*2 ; Pages $A0-$A7
sta BITMAP+$A*2+1 ; Pages $A8-$AF
sta BITMAP+$B*2 ; Pages $B0-$B7
sta BITMAP+$B*2+1 ; Pages $B8-$BF (ProDOS global page)
;;; --------------------------------------------------
;;; Relocate INTBASIC and our stub up to target
COPY16 #reloc, A1L
COPY16 #reloc+sizeof_reloc-1, A2L
COPY16 #BASIC_START, A4L
ldy #0
jsr MOVE
;; Hook the command parser
LDXY #reloc__CommandHook
STXY intbasic__GETCMD+3
;; Hook the output routine
jsr reloc__HookCSW
;; Start it up
jmp reloc__Initialize
.out .sprintf("MEM: Bootstrap is $%04X bytes", * - $2000)
;;; --------------------------------------------------
;;; GET/SET_PREFIX
prefix_params:
prefix_param_count: .byte 1 ; in
prefix_pathname: .addr PATH2 ; in
;;; ON_LINE
on_line_params:
on_line_param_count: .byte 2 ; in
on_line_unit_num: .byte 1 ; in
on_line_data_buffer: .addr ON_LINE_BUF ; in
;;; ============================================================
;;; Integer BASIC Implementation
;;; ============================================================
.proc reloc
.org ::BASIC_START
.assert * .mod $200 = 0, error, "must be even-page aligned"
.out .sprintf("MEM: $%04X BASIC_START", *)
.scope intbasic
.include "IntegerBASIC_cc65.s"
.endscope ; intbasic
;;; ============================================================
;;; Initializer
;;; ============================================================
.out .sprintf("MEM: $%04X Command Handler", *)
;;; Load program (if given) and invoke Integer BASIC
.proc Initialize
jsr SwapZP ; ProDOS > IntBASIC
jsr intbasic::COLD
LDXY #OUR_HIMEM
STXY intbasic::HIMEM
jsr intbasic::NEW ; reset PP, PV, stacks
jsr SwapZP ; IntBASIC > ProDOS
;; Do we have a path?
lda PATHBUF
beq warm
jsr LoadINTFile
bne warm
;; Run it
jsr SwapZP ; ProDOS > IntBASIC
jmp intbasic::RUN
;; Show prompt
warm: jsr SwapZP ; ProDOS > IntBASIC
jmp intbasic::WARM
.endproc ; Initialize
;;; ============================================================
;;; Input: Path to load in `PATHBUF`
;;; Output: ProDOS error code in A ($00 = success)
;;; Assert: ProDOS ZP swapped in
.proc LoadINTFile
;; Check type, bail if not INT
lda #FT_INT
jsr GetFileInfoRequireType
bne finish
;; Open the file
jsr Open
bne finish
;; --------------------------------------------------
;; Compute the load address
;; Get file size
MLI_CALL GET_EOF, geteof_params
bne close
;; In theory we should check geteof_eof+2 and fail
;; if > 64k, but how would such a file be created?
;; At this point we're committed - reset HIMEM
LDXY #OUR_HIMEM
STXY intbasic::HIMEM
;; Set up zero page locations for the calculation
jsr SwapZP ; ProDOS > IntBASIC
LDXY geteof_eof
STXY intbasic::ACC
STXY rw_request_count
;; On any error, fail the load
JmpMEMFULL := intbasic_err
BcsJmpMEMFULL := intbasic_err
@LF118 := intbasic_err
;; ..................................................
;; Logic c/o IntBASIC's LOAD routine
;; (z: addressing to ensure desired wrap-around)
ldx #$ff
sec
@Loop: lda z:intbasic::HIMEM+1,x ;AUX = HIMEM - ACC
sbc z:intbasic::ACC+1,x
sta z:intbasic::AUX+1,x
inx
beq @Loop
bcc JmpMEMFULL
lda intbasic::PV ;compare PV to AUX
cmp intbasic::AUX
lda intbasic::PV+1
sbc intbasic::AUX+1
bcs BcsJmpMEMFULL
lda intbasic::ACC ;is ACC zero?
bne @LF107
lda intbasic::ACC+1
beq @LF118 ;yes
@LF107: lda intbasic::AUX ;PP = AUX
sta intbasic::PP
lda intbasic::AUX+1
sta intbasic::PP+1
;; ..................................................
;; Load address c/o IntBASIC's program pointer
COPY16 intbasic::PP, rw_data_buffer
jsr SwapZP ; IntBASIC > ProDOS
jsr Read
close: jsr Close
finish: rts
;; Failure with IntBASIC ZP swapped in - restore ProDOS and flag error
intbasic_err:
jsr SwapZP ; IntBASIC > ProDOS
lda #ERR_INCOMPATIBLE_FILE_FORMAT
bne close ; always
.endproc ; LoadINTFile
;;; ============================================================
;;; Helpers, to save space
.proc GetFileInfo
lda #$A ; param count for GET_FILE_INFO
sta gfi_param_count
MLI_CALL GET_FILE_INFO, gfi_params
rts
.endproc
.proc Open
MLI_CALL OPEN, open_params
pha
lda open_ref_num
sta geteof_ref_num
sta rw_ref_num
sta close_ref_num
pla
rts
.endproc
.proc Read
MLI_CALL READ, rw_params
rts
.endproc
.proc Close
pha
MLI_CALL CLOSE, close_params
pla
rts
.endproc
;;; ============================================================
;;; ProDOS Parameter Blocks
;;; GET_FILE_INFO / SET_FILE_INFO
gfi_params:
gfi_param_count: .byte 0 ; in, populated at runtime
gfi_pathname: .addr PATHBUF ; in
gfi_access: .byte 0 ; out
gfi_file_type: .byte 0 ; out
gfi_aux_type: .word 0 ; out
gfi_storage_type: .byte 0 ; out
gfi_blocks_used: .word 0 ; out
gfi_mod_date: .word 0 ; out
gfi_mod_time: .word 0 ; out
gfi_create_date: .word 0 ; out
gfi_create_time: .word 0 ; out
;;; OPEN
open_params:
open_param_count: .byte 3 ; in
open_pathname: .addr PATHBUF ; in
open_io_buffer: .addr IO_BUFFER ; in
open_ref_num: .byte 0 ; out
;;; GET_EOF
geteof_params:
geteof_param_count: .byte 2 ; in
geteof_ref_num: .byte 0 ; in, populated at runtime
geteof_eof: .res 3, 0 ; out
;;; READ/WRITE
rw_params:
rw_param_count: .byte 4 ; in
rw_ref_num: .byte 0 ; in, populated at runtime
rw_data_buffer: .addr 0 ; in, populated at runtime
rw_request_count: .word 0 ; in, populated at runtime
rw_trans_count: .word 0 ; out
;;; CLOSE
close_params:
close_param_count: .byte 1 ; in
close_ref_num: .byte 0 ; in, populated at runtime
;;; GET/SET_PREFIX
prefix_params:
prefix_param_count: .byte 1 ; in
prefix_pathname: .addr PATHBUF ; in
;;; QUIT
quit_params:
quit_param_count: .byte 4 ; in
quit_type: .byte 0 ; in
quit_res1: .word 0 ; reserved
quit_res2: .byte 0 ; reserved
quit_res3: .word 0 ; reserved
;;; CREATE
create_params:
create_param_count: .byte 7 ; in
create_pathname: .addr PATHBUF ; in
create_access: .byte $C3 ; in
create_file_type: .byte 0 ; in, populated at runtime
create_aux_type: .word 0 ; in
create_storage_type: .byte 0 ; in
create_date: .word 0 ; in
create_time: .word 0 ; in
;;; DESTROY
destroy_params:
destroy_param_count: .byte 1 ; in
destroy_pathname: .addr PATHBUF ; in
;;; RENAME
rename_params:
rename_param_count: .byte 2 ; in
rename_pathname: .addr PATH2 ; in
rename_new_pathname: .addr PATHBUF ; in
;;; ============================================================
;;; Swap a chunk of the zero page that both IntBASIC and ProDOS use
;;; Preserves: A,P
.proc SwapZP
php
pha
ldx #ZP_SAVE_LEN-1
: lda ZP_SAVE_ADDR,x
ldy zp_stash,x
sta zp_stash,x
tya
sta ZP_SAVE_ADDR,x
dex
bpl :-
pla
plp
rts
zp_stash:
.res ::ZP_SAVE_LEN
.endproc ; SwapZP
;;; ============================================================
;;; Command Hook
;;; ============================================================
.enum ParseFlags
path = %00000001 ; parse path
path_opt = %00000010 ; path is optional (not an error if empty)
path2 = %00000100 ; parse second path (for RENAME)
slotnum = %00001000 ; slot number (for PR#)
address = %00010000 ; parse An
length = %00100000 ; parse Ln
ignore = %10000000 ; ignore all (for MON/NOMON)
.endenum
;;; Command Hook - replaces MON_NXTCHAR call in GETCMD to
;;; allow extra commands to be added.
;;; Assert: Called with IntBASIC ZP swapped in
.proc CommandHook
jsr intbasic::MON_NXTCHAR
sta save_a ; last char pressed
stx save_x ; position in input buffer
jsr HookCSW ; needed after IN#3
jsr ExecBuffer
bcc :+
;; Pass buffer on to IntBASIC to parse
save_a := *+1
lda #$00 ; self-modified
save_x := *+1
ldx #$00 ; self-modified
rts
:
;; Pass an empty buffer on to IntBASIC
ldx #0
lda #$8D ; CR
sta intbasic::IN,x
rts
.endproc ; CommandHook
;;; ============================================================
;;; Executes the command in the input buffer ($200)
;;; Output: C=0 if valid, C=1 if not (e.g. let IntBASIC take it)
;;; Note: On syntax error, calls `intbasic::ERRMESS` (resets stack, etc)
;;; Assert: Called with IntBASIC ZP swapped in
.proc ExecBuffer
ldx #0 ; X = offset in cmdtable
stx cmdnum
stx PATHBUF ; initialize to zero on each parse
;; Check command
loop: ldy #0 ; Y = offset in buffer
jsr SkipSpaces
: lda cmdtable,x
beq dispatch
cmp intbasic::IN,y
bne next
inx
iny
bne :- ; always
;; Next command
: inx
next: lda cmdtable,x
bne :-
inc cmdnum
inx
lda cmdtable,x
bne loop
;; No match
pass: sec
rts
;; Dispatch to matching command
dispatch:
cmdnum := *+1
ldx #$00 ; self-modified
lda cmdproclo,x
sta disp
lda cmdprochi,x
sta disp+1
lda cmdparse,x
sta parse_flags
;; ..............................
;; Parse arguments
lda parse_flags
.assert ParseFlags::ignore = $80, error, "enum mismatch"
bpl :+
clc
rts
:
and #ParseFlags::path
beq :+
jsr ParsePath
bne :+
ora cmdnum ; if RUN (idx 0), yield to IntBASIC
beq pass
lda parse_flags ; was it optional?
and #ParseFlags::path_opt
beq syn ; required, so error
:
lda parse_flags
and #ParseFlags::path2
beq :+
jsr ParseComma
bne syn
jsr ParsePath
beq syn
:
jsr ParseParams
bcs syn
lda parse_flags
and #ParseFlags::slotnum
beq :+
jsr ParseSlotNum
bcs syn
:
;; Anything remaining (except spaces) is an error
jsr SkipSpaces
cmp #$8D
bne syn
;; ..............................
;; Actual dispatch
jsr SwapZP ; IntBASIC > ProDOS
disp := *+1
jsr $FFFF ; self-modified
jsr SwapZP ; ProDOS > IntBASIC
bmi syn
bne :+
clc
rts
:
;; ..............................
;; Show error messages
;; ProDOS error
pha
ldx #0
: lda message,x
beq :+
jsr intbasic::MON_COUT
inx
bne :- ; always
: pla
jsr PRBYTE
jsr intbasic::MON_CROUT
jmp intbasic::ERRMESS+3
;; Syntax error
syn: ldy #<intbasic::ErrMsg02 ;"SYNTAX"
jmp intbasic::ERRMESS
message:
.byte $87 ; BELL
scrcode "*** PRODOS ERR $"
.byte 0
NUM_CMDS = 21
cmdtable:
scrcode "RUN" ; must be 0 for special handling
.byte 0
scrcode "BYE"
.byte 0
scrcode "SAVE"
.byte 0
scrcode "LOAD"
.byte 0
scrcode "CHAIN"
.byte 0
scrcode "PREFIX"
.byte 0
scrcode "CATALOG" ; must precede "CAT"
.byte 0
scrcode "CAT"
.byte 0
scrcode "DELETE"
.byte 0
scrcode "RENAME"
.byte 0
scrcode "BSAVE"
.byte 0
scrcode "BLOAD"
.byte 0
scrcode "BRUN"
.byte 0
scrcode "PR#"
.byte 0
scrcode "MON"
.byte 0
scrcode "NOMON"
.byte 0
scrcode "LOCK"
.byte 0
scrcode "UNLOCK"
.byte 0
scrcode "STORE"
.byte 0
scrcode "RESTORE"
.byte 0
scrcode "-"
.byte 0
.byte 0 ; sentinel
MonCmd := 0 ; ignored
NomonCmd := 0
cmdproclo:
.byte <RunCmd,<QuitCmd,<SaveCmd,<LoadCmd,<ChainCmd,<PrefixCmd,<CatCmd,<CatCmd,<DeleteCmd,<RenameCmd,<BSaveCmd,<BLoadCmd,<BRunCmd,<PRCmd,<MonCmd,<NomonCmd,<LockCmd,<UnlockCmd,<StoreCmd,<RestoreCmd,<DashCmd
cmdprochi:
.byte >RunCmd,>QuitCmd,>SaveCmd,>LoadCmd,>ChainCmd,>PrefixCmd,>CatCmd,>CatCmd,>DeleteCmd,>RenameCmd,>BSaveCmd,>BLoadCmd,>BRunCmd,>PRCmd,>MonCmd,>NomonCmd,>LockCmd,>UnlockCmd,>StoreCmd,>RestoreCmd,>DashCmd
.assert * - cmdproclo = NUM_CMDS * 2, error, "table size"
cmdparse:
.byte ParseFlags::path | ParseFlags::path_opt ; RUN
.byte 0 ; BYE
.byte ParseFlags::path ; SAVE
.byte ParseFlags::path ; LOAD
.byte ParseFlags::path ; CHAIN
.byte ParseFlags::path | ParseFlags::path_opt ; PREFIX
.byte ParseFlags::path | ParseFlags::path_opt ; CATALOG
.byte ParseFlags::path | ParseFlags::path_opt ; CAT
.byte ParseFlags::path ; DELETE
.byte ParseFlags::path | ParseFlags::path2 ; RENAME
.byte ParseFlags::path | ParseFlags::address | ParseFlags::length ; BSAVE
.byte ParseFlags::path | ParseFlags::address ; BLOAD
.byte ParseFlags::path | ParseFlags::address ; BRUN
.byte ParseFlags::slotnum ; PR#
.byte ParseFlags::ignore ; MON
.byte ParseFlags::ignore ; NOMON
.byte ParseFlags::path ; LOCK
.byte ParseFlags::path ; UNLOCK
.byte ParseFlags::path ; STORE
.byte ParseFlags::path ; RESTORE
.byte ParseFlags::path ; -
.assert * - cmdparse = NUM_CMDS, error, "table size"
parse_flags:
.byte 0
;;; ============================================================
;;; Advance Y, and get next character.
;;; Output: A = char, Z=1 if CR or ',' or ' '
.proc AdvanceAndGetNextChar
iny
.assert * = GetNextChar, error, "fall through"
.endproc
;;; ============================================================
;;; Note: Doesn't advance Y
;;; Output: A = char, Z=1 if CR or ',' or ' '
.proc GetNextChar
lda intbasic::IN,y
cmp #','|$80
beq ret
cmp #' '|$80
beq ret
cmp #$8D ; CR
ret: rts
.endproc ; GetNextChar
;;; ============================================================
;;; Parse path from command line into `PATHBUF`; skips leading spaces,
;;; stops on newline or comma.
;;; Input: Y = end of command in `intbasic::IN`
;;; Output: `PATHBUF` is length-prefixed path, A=length, w/ Z set
;;; Previous `PATHBUF` copied to `PATH2`
;;; Assert: `PATHBUF` is valid
.proc ParsePath
;; Copy first path to PATH2
ldx PATHBUF
stx PATH2
beq start
: lda PATHBUF,x
sta PATH2,x
dex
bne :-
start:
;; Get next path
jsr SkipSpaces
ldx #0
jsr GetNextChar
cmp #'/'|$80 ; must start with /
beq loop ; or alpha
cmp #'A'|$80
bcc done
loop: jsr GetNextChar
beq done ; if CR or ','
and #$7F
sta PATHBUF+1,x
inx
iny
bne loop ; always
done: stx PATHBUF
txa
rts
.endproc ; ParsePath
;;; ============================================================
;;; Skip over spaces in input buffer
;;; Input: Y = current position
;;; Output: Y = new position, A = char at new position, X unchanged
.proc SkipSpaces
: lda intbasic::IN,y
iny
cmp #' '|$80
beq :-
dey
rts
.endproc ; SkipSpaces
;;; ============================================================
;;; Tries to consume a comma from the input; skips leading spaces
;;; Output: Z=1 if comma seen, Z=0 otherwise
.proc ParseComma
jsr SkipSpaces
cmp #','|$80
bne ret
iny
lda #0 ; set Z=1 after INY
ret: rts
.endproc ; ParseComma
;;; ============================================================
;;; Output: C=1 on syntax error, C=0 and `slotnum` populated otherwise
.proc ParseSlotNum
jsr GetNextChar
cmp #'0'|$80
bcc syn
cmp #'7'|$80+1
bcs syn
and #$0F
sta slotnum
iny
clc
rts
syn: sec
rts
.endproc ; ParseSlotNum
;;; ============================================================
;;; Parse ,A<addr> and ,L<len> params if present (and ignore ,V<vol>)
;;;
;;; Input: Y = parse position in `intbasic::IN`
;;; Output: `param_addr` and `param_len` populated (or $0000)
;;; C=1 on syntax error, C=0 otherwise
.proc ParseParams
;; Init all params to 0
ldx #(param_end - param_start)-1
lda #0
sta seen_params
: sta param_start,x
dex
bpl :-
;; Parse an arg
loop: jsr ParseComma
bne ok ; nope - we're done
jsr SkipSpaces
NUM_PARAMS = 3
ldx #NUM_PARAMS-1
: cmp param_table,x
beq get
dex
bpl :-
syn: sec
rts
ok: clc
rts
param_table: ; parameter name
.byte 'V'|$80, 'A'|$80, 'L'|$80
.assert * - param_table = NUM_PARAMS, error, "table size"
flag_table: ; flag in `parse_flags` (0=ignored)
.byte 0, ParseFlags::address, ParseFlags::length
.assert * - flag_table = NUM_PARAMS, error, "table size"
offset_table: ; offset from `param_start` to store value
.byte 0, param_addr - param_start, param_len - param_start
.assert * - offset_table = NUM_PARAMS, error, "table size"
get: txa ; A = table offset
pha
jsr GetVal
pla
bcs syn
tax ; X = table offset
;; Validate we want this argument, note it was seen
lda flag_table,x
beq loop ; ignored (V)
and parse_flags
beq syn ; not wanted
ora seen_params
sta seen_params