-
Notifications
You must be signed in to change notification settings - Fork 4
/
mainpart.s65
12498 lines (10515 loc) · 245 KB
/
mainpart.s65
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
;-------------------------------------------------------------------------
KEEP_DELETE_LINE_MEMSET = false
KEEP_CLEAR_5B1_TO_600_MEMSET = false
KEEP_DETOKENIZE_ONE_LINE_MEMSET = false
KEEP_9E1D_MEMSET = false
; I strip out the memmove calls one at a time...
KEEP_B8DB_MEMMOVE = false
KEEP_BF73_MEMMOVE = false
KEEP_A8C0_MEMMOVE = false
;-------------------------------------------------------------------------
ENABLE_DEBUG = false
;-------------------------------------------------------------------------
LINE_NUMBER_TOKEN=$8d
REM_TOKEN=$f4
; max length of text of line, +1.
LINE_LENGTH_LIMIT=$fc
; if true, CTRL+up/down = move cursor to first/last line of screen.
;
; if false, CTRL+up/down = move cursor between program lines
ORIGINAL_CTRL_UP_DOWN=true
; if X bit 7 clear: set options byte to X, return old value
; if X bit 7 set: leave options alone, return old value
OPTIONS_OSBYTE=26
OPTION_SHIFT_ESCAPE=1
OPTION_EDIT_MODE=2
;-------------------------------------------------------------------------
; Language entry point modes.
;
LANGUAGE_MODE_NORMAL=1
LANGUAGE_MODE_SHIFT_ESCAPE=2
LANGUAGE_MODE_ZSAVE=$80
LANGUAGE_MODE_ZRUN=$81
;-------------------------------------------------------------------------
; SLRE---1-
; S=service
; L=language
; R=copro relocation
; E=electron soft key
.if HI||RELOCATABLE
ROM_FLAGS = %11100010
.else
ROM_FLAGS = %11000010
.endif
;-------------------------------------------------------------------------
;-------------------------------------------------------------------------
.section service
.block
osbyte_var: .function index
.cerror index<$a6||index>$ff,"bad OSBYTE"
.endf $190+index
.if BUILD_TYPE==4
push_addrs: .macro
.for i=0,i<len(\1),i+=1
lda \1[i]
pha
.next
.endm
pop_addrs: .macro
.for i=len(\1)-1,i>=0,i-=1
pla
sta \1[i]
.next
.endm
push_and_copy_addrs: .macro
.for i=0,i<len(\1),i+=1
lda \1[i]
pha
lda \2+i
sta \1[i]
.next
.endm
pop_and_copy_addrs: .macro
.for i=len(\1)-1,i>=0,i-=1
lda \1[i]
sta \2+i
pla
sta \1[i]
.next
.endm
; Y/X points to string on entry. On exit, $70/$71
; holds result and $72 holds final status register
; value.
jmp test_atoi ;+0
; random thing I wanted to test.
jmp language.clear_5B1_to_600 ;+3
; random thing I wanted to test.
jmp test_detokenize_one_line_memset ;+6
; random thing I wanted to test.
jmp test_loc_9e1d_memset ;+9
; ; A/X/Y as per memset. Changes $70.
jmp test_memset ;+12
; X=replacement byte
; Y=# chars to remove
; ($72) is pointer
; changes $70
jmp test_B0BB ;+15
test_B0BB: .proc
addrs:=(byte_25,byte_26,byte_27,byte_28)
push_and_copy_addrs addrs,$70
txa
jsr language.sub_B0BB
pop_and_copy_addrs addrs,$70
rts
.pend
test_loc_9e1d_memset: .proc
addrs:=(byte_C,byte_D,byte_3A)
push_addrs addrs
lda language.sub_9DEA.loc_9e2e
pha
lda #$60
sta language.sub_9DEA.loc_9e2e
jsr language.sub_9DEA.loc_9e1d
pla
sta language.sub_9DEA.loc_9e2e
pop_addrs addrs
rts
.pend
test_detokenize_one_line_memset: .proc
addrs:=(byte_C,byte_D,byte_2C,byte_3A)
push_addrs addrs
lda #$ff ;make it just do the memset
sta byte_2C
jsr language.detokenize_one_line
pop_addrs addrs
rts
.pend
test_memset: .proc
addrs:=(byte_C,byte_D,byte_3A)
sta $70
push_addrs addrs
lda $70
jsr language.memset
pop_addrs addrs
rts
.pend
test_atoi: .proc
addrs:=(byte_C,byte_D,byte_3E,byte_3F)
push_addrs addrs
stx byte_C
sty byte_D
jsr language.atoi
php
pla
sta $72
lda byte_3E
sta $70
lda byte_3F
sta $71
pop_addrs addrs
rts
.pend
.endif
rom_start:
JMP language.language_entry
JMP svc
.byte ROM_FLAGS
.byte copyright-rom_start ;
.byte $FF
aTheBasicEditor_0:
.text "The "
.if HI
.text "HI"
.endif
.text "BASIC Editor"
.if ENABLE_DEBUG
.text " (DEBUG)"
.endif
.text 0
.text VER
.if ELECTRON
.text "E"
.endif
.if RELOCATABLE
.text "r"
.endif
copyright:
.byte 0
aC1984Acornsoft:
; was "(C) 1984 Acornsoft". Sorry, Acornsoft!
.text "(C)",0
.if HI||RELOCATABLE
; this address gets fixed up by make_reloc, based on
; the relocation value in the altrom.
.word LANG_BASE
.word 0
.endif
; A = code, X = ROM number, Y = parameter.
svc: .proc
pha
cmp #4
beq svc_star
.if !HI
cmp #6
beq svc_brk
.endif
cmp #7
beq svc_osbyte
cmp #9
beq svc_help
done:
pla
ldx $f4
rts
claimed:
pla
lda #0
ldx $f4
rts
.pend
;-------------------------------------------------------------------------
svc_star: .proc
tya
pha
.if HI
; if there's no Tube, just ignore the request - this
; gives the non-HI ROM a chance, if it's there, or a
; Bad Command, if it isn't (since the HI language code
; can't run in the IO processor).
ldx osbyte_var($ea)
inx
bne ply_and_svc_done
.endif
check_be:
; *...
lda ($f2),Y
and #$df
cmp #"B"
bne ply_and_svc_done
; *B....
iny
iny
lda ($f2),Y
cmp #13
bne ply_and_svc_done
check_command:
; *B?|M
dey
lda ($f2),y
ldx #LANGUAGE_MODE_NORMAL
cmp #"E"
beq enter_language
ldx #LANGUAGE_MODE_ZSAVE
cmp #"Z"
beq enter_language
ldx #LANGUAGE_MODE_ZRUN
cmp #"R"
beq enter_language
; fall through
.pend
ply_and_svc_done: .block
pla
tay
jmp svc.done
.bend
;-------------------------------------------------------------------------
enter_language: .proc
; set the user flag for the language entry point.
lda #1
jsr osbyte
ldx $f4
lda #$8e ;enter language ROM
jmp osbyte
.pend
;-------------------------------------------------------------------------
svc_help: .proc
lda ($f2),Y
cmp #" "
beq print_help
cmp #13
bne svc.done
print_help:
tya
pha
jsr osnewl
ldy #0
print_help_name_loop:
lda aTheBasicEditor_0,Y
bne +
lda #32
+
jsr oswrch
iny
cpy #aC1984Acornsoft-aTheBasicEditor_0
bne print_help_name_loop
jsr osnewl
jmp ply_and_svc_done
.pend
;-------------------------------------------------------------------------
svc_brk: .proc
jsr language.get_options
and #OPTION_SHIFT_ESCAPE
beq svc.done
tya
pha
ldy osbyte_var($ba) ;ROM active at last BRK (MasRef
;D.2-56)
cpy osbyte_var($bb) ;ROM number of socket containing
;BASIC (MasRef D.2-57)
bne ply_and_svc_done;taken if not BRK in BASIC
; MasRef D.6-1
lda $fd ;error address LSB
sta $f6 ;osrdsc address LSB
lda $fe ;... MSB
sta $f7 ;... MSB
; Y=rom #
jsr osrdsc
cmp #17 ;was it Escape?
bne ply_and_svc_done ;taken if not Escape
jsr language.poll_shift
bne ply_and_svc_done ;taken shift not pressed
; Shift+ESCAPE pressed during BASIC...
lda #$7e ;acknowledge escape (MasRef D.2-37)
jsr osbyte
ldx #LANGUAGE_MODE_SHIFT_ESCAPE
jmp enter_language
.pend
;-------------------------------------------------------------------------
svc_osbyte: .proc
lda $ef
cmp #OPTIONS_OSBYTE
bne svc.done
; save off old value
lda $df0,x
pha
; update value, if X bit 7 clear
lda $f0
bmi +
sta $df0,x
+
; return old value in X
pla
sta $f0
jmp svc.claimed
.pend
;-------------------------------------------------------------------------
osbyte_x00_yff:
ldx #$00
osbyte_yff:
ldy #$ff
jmp osbyte
;-------------------------------------------------------------------------
; get_default_wordv: .proc
; lda $ffb7
; sta $a8
; lda $ffb8
; sta $a9
; ldy #<wordv
; lda ($a8),y ;lsb
; tax
; lda ($a8),y ;msb
; tay
; rts
; .pend
; osword_hook: .proc
; sta $ef
; stx $f0
; sty $f1
; jsr get_default_wordv
; jsr call_osword
; php
; pha
; txa
; pha
; tya
; pha
; bcc not_us
; lda #$fc ;read language ROM number (AUG 243)
; jsr osbyte_x00_yff
; sta $ef
; lda #$bb ;read BASIC ROM number
; jsr osbyte_x00_yff
; txa
; tsx
; cmp $ef
; bne not_us ;taken if not BASIC ROM
; ; poll SHIFT
; lda #$81 ;poll for key (MasRef D.2-38)
; ldx #$ff ;-1, shift
; jsr osbyte_yff
; inx
; bne not_us ;taken if X!=$ff, i.e., shift not
; ;pressed
; ; Shift+ESCAPE pressed during BASIC...
; lda #$7e ;acknowledge escape (MasRef D.2-37)
; jsr osbyte
; ldx #LANGUAGE_MODE_NORMAL
; jmp enter_language
; not_us:
; pla
; tay
; pla
; tax
; pla
; sta $ef
; plp
; rts
; call_osword:
; lda $f0
; stx $f0
; tax
; lda $f1
; sty $f1
; tay
; lda $ef
; jmp ($f0)
; .pend
;-------------------------------------------------------------------------
.bend
.send service
;-------------------------------------------------------------------------
.section language
language: .block
; .logical LANG_BASE+(*-SVC_BASE)
init_language_entry_mode: .proc
; read the user flag that was set by the service call
; 4 handler.
lda #1
ldx #0
jsr osbyte
stx language_entry_mode
cpx #LANGUAGE_MODE_ZSAVE
beq zsave
cpx #LANGUAGE_MODE_ZRUN
beq zrun
ret:
rts
zsave:
jsr saving_message
jsr zsave_command
jmp exit_and_OLD
zrun:
jsr saving_message
jsr zsave_command
jmp exit_and_OLD_and_RUN
saving_message:
lda #1
sta editor_mode_id ; 1=command mode, 2=edit mode
jsr find_program_name
bcc ret
jsr print_next_string
.text "Saving: ",255
jsr print_program_name
jmp osnewl
.pend
language_entry: .proc
CMP #1 ; normal language entry?
BEQ language_start
RTS
language_start:
.if ENABLE_DEBUG
jsr reset_debug_values
.endif
JSR init_brkv_and_oshwm
JSR clear_line_commands
JSR sub_B358
LDX #5
STX tab_value
LDX #$60 ; '`'
STX cursor_size
LDX #0
STX search_string_length
INX
STX is_insert_mode ; 0=overtype 1=insert
STX is_scroll_on ; 1=scroll, 0=noscroll
LDA #$E4
JSR osbyte_with_y0
JSR clear_5B1_to_600
ldx #$ff
JSR get_HIMEM_for_mode_X
LDA #0
STA background_colour
sta case_insensitive_search
LDA #7
STA foreground_colour
JSR sub_8314
JSR find_program
BCC language_start_good_program
JSR clear_program
JSR clear_5B1_to_600
language_start_good_program:
jsr init_language_entry_mode
LDA #$D2
JSR osbyte_with_x0_y0 ;suppress sound
jsr print_next_string
.byte 254 ;allow control chars
.byte 3 ;printer off
.byte 6 ;enable VDU drivers
.byte 4 ;use text cursor
.byte 26 ;restore default windows
.byte 12 ;CLS
.byte 15 ;disable paged mode
.byte 20 ;reset VDU19 stuff
.byte 17,7 ;COLOUR7
.byte 17,128 ;COLOUR128
.byte 255
command_prompt_loop:
LDX #$FF
TXS
JSR initialise
JSR find_program
BCS loc_8147
JSR is_program_empty ; sets C if no program
BCS loc_8147
LDA current_line_no_msb
STA byte_2B
LDA current_line_no_lsb
STA byte_2C
JSR find_line_by_number ; finds a line, given a line number
;
; Entry:
; byte_2B: line number MSB
; byte_2C: line number LSB
;
; Exit:
; (byte_2B) points to most suitable line
LDY #1
LDA (byte_2B),Y
BPL loc_8144
JSR sub_AA77 ; swap byte_2B with unk_2F, swap byte_2C with unk_30
loc_8144:
JSR save_line_number ; saves line number from program.
;
; Entry:
; (byte_2b) points to current line
;
; Exit:
; current_line_no_msb, current_line_no_lsb = the line number
loc_8147:
; do a one-time check for SHIFT+ESCAPE - if entered
; due to SHIFT+ESCAPE, and the options byte says edit
; mode was the last one used, go to edit mode.
lda language_entry_mode
cmp #LANGUAGE_MODE_SHIFT_ESCAPE
bne + ;not SHIFT+ESCAPE, or we already
;checked
; pretend it was entered with LANGUAGE_MODE_NORMAL
lda #LANGUAGE_MODE_NORMAL
sta language_entry_mode
jsr get_options
and #OPTION_EDIT_MODE
beq + ;taken if last mode wasn't edit mode
jmp enter_edit_mode
+
jsr clear_edit_mode_option
JSR print_command_prompt
JSR do_command_line
command_loop:
LDA editor_mode_id ; 1=command mode, 2=edit mode
CMP #2 ; edit mode?
BNE command_prompt_loop ; branch taken if command mode already
; leave edit mode
LDA byte_15
BEQ loc_8163
LDA current_line_no_msb
STA byte_50
LDA current_line_no_lsb
STA byte_51
JMP command_prompt_loop
loc_8163:
LDA byte_6C1
CMP #-1
BEQ command_prompt_loop
STA byte_3A
LDA byte_6C0
STA byte_39
LDY #1
LDA (byte_39),Y
STA byte_50
INY
LDA (byte_39),Y
STA byte_51
JMP command_prompt_loop
; End of function language_entry
.pend
;-------------------------------------------------------------------------
init_brkv_and_oshwm: .proc
CLI
CLD
LDA #<brk_handler
STA $202 ; BRKV+0
LDA #>brk_handler
STA $203 ; BRKV+1
LDA #0
STA oshwm
STA unk_6AD
LDA #$83
JSR OSBYTE ; Read OSHWM
STY oshwm+1 ; $18 = MSB
LDA #$82
JSR OSBYTE ; Read machine higher order address
STX higher_order_address
STY higher_order_address+1
LDA #0
STA unk_6B8
LDA #$A
STA unk_6B9
RTS
.pend
get_HIMEM_for_mode_X: .proc
LDY higher_order_address
INY
BNE is_tube
LDY higher_order_address+1
INY
BEQ is_not_tube
is_tube:
lda #<LANG_BASE
sta HIMEM+0
lda #>LANG_BASE
sta HIMEM+1
RTS
is_not_tube:
lda #132 ;read HIMEM for current MODE
cpx #$ff
beq get_HIMEM
LDA #133 ;read HIMEM for given MODE
get_HIMEM:
JSR OSBYTE
STX HIMEM
STY HIMEM+1
RTS
; End of function validate_mode
.pend
print_command_prompt: .proc
bit should_cls_before_command_prompt
bpl +
lsr should_cls_before_command_prompt
lda #12
jsr oswrch
+
LDA byte_15
BEQ loc_82CB
jsr display_error_message
loc_82CB:
jsr print_bytes_free
jsr print_next_string
.text ' '
.if ENABLE_DEBUG
.text 'D'
.endif
.text '>',255
LDA is_insert_mode ; 0=overtype 1=insert
PHA
LDA cursor_size
PHA
.if !ELECTRON
LDA #0
.else
LDA #1
.endif
STA is_insert_mode ; 0=overtype 1=insert
LDA #$60 ; '`'
STA cursor_size
JSR reset_cursor_shape
PLA
STA cursor_size
PLA
STA is_insert_mode ; 0=overtype 1=insert
RTS
.pend
display_error_message: .proc
JSR OSNEWL
LDX #$4F ; 'O'
LDY #$28 ; '('
loc_82AE:
LDA $5D7,Y
CMP #$20 ; ' '
BNE loc_82BA
DEY
BNE loc_82AE
LDX #$27 ; '''
loc_82BA:
TXA
LDX #<unk_5B1
LDY #>unk_5B1
JSR print_n_chars
JSR OSNEWL
JSR OSNEWL
JMP beep
.pend
get_text_window_left_bottom:
LDX #8
LDA #$A0
JMP OSBYTE
; End of function get_text_window_left_bottom
clear_program:
LDY #0
LDA #$D
STA (oshwm),Y
INY
LDA #-1
STA (oshwm),Y
JSR find_program
LDA #0
STA current_line_no_msb
LDA #$A
STA current_line_no_lsb
JSR sub_B358
JMP clear_line_commands
; End of function clear_program
sub_8314:
LDA #0
STA current_line_no_msb
STA current_line_no_lsb
STA byte_50
STA byte_51
RTS
; End of function sub_8314
find_program:
LDA #0
STA is_bad_program
STA byte_38
STA byte_C
STA byte_D
PHA
LDA #$FF
PHA
PHA
LDA oshwm+1
STA byte_39
find_program_scan_line:
LDY #0
LDA (byte_38),Y ; get first char in line
CMP #$D ; is it the required 13?
BEQ line_start_ok
bad_program:
PLA
PLA
PLA
INC is_bad_program ;?is_bad_program=1
LDA #1 ;"Bad program"
JSR get_error ; A = error code
SEC ; bad program
RTS
line_start_ok:
INY
LDA (byte_38),Y ; line MSB
BPL scan_valid_line ; if +ve, not end
; reached end, so set TOP to just past the terminating $FF
CLC
LDA byte_38
ADC #2
STA TOP
LDA #0
ADC byte_39
; gone past the relevant HIMEM?
STA TOP+1
CMP HIMEM+1
BCC TOP_in_bounds
BNE force_mode_7
LDA HIMEM
CMP TOP
BCS TOP_in_bounds
force_mode_7:
; Switch to mode 135, in an attempt to get as much
; room as possible. Worst case, you just get Mode 7.
jsr print_next_string
.text 254
.text 22,135
.text 255
LDX #$ff
JSR get_HIMEM_for_mode_X
LDA #3 ;"No room - Mode reset"
JSR get_error ; A = error code
TOP_in_bounds:
PLA
PLA
PLA
BEQ find_program_good_program
JSR sub_8495
find_program_good_program:
CLC
RTS
; (seems to be maintaining its own notion of line numbering - not sure what for - it never does anything particular if it encounters a discrepancy)
scan_valid_line:
LDA byte_C
BMI loc_8387
CLC
LDA byte_D
ADC #10
STA byte_D
BCC loc_8387
INC byte_C
loc_8387:
PLA
BMI loc_83A0
CMP (byte_38),Y
BEQ loc_8392
BCC loc_83A0
BCS loc_839A
loc_8392:
INY
PLA
CMP (byte_38),Y
BCS loc_839B
BCC loc_83A1
loc_839A:
PLA
loc_839B:
PLA
LDA #1
PHA
PHA
loc_83A0:
PLA
loc_83A1: