forked from scotws/TaliForth2
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathed.asm
1713 lines (1373 loc) · 65.2 KB
/
ed.asm
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
; ed6502 - Ed-like line-based editor for Tali Forth 2
; Scot W. Stevenson <[email protected]>
; First version: 13. Okt 2018
; This version: 28. Dec 2018
; Ed is a line-orientated editor for Tali Forth 2 based on the classic Unix
; editor of the same name. It is included because a) I like line editors and
; this is my project, so there, and b) as a very simple editor that will work
; even if there is no vt100 terminal support, just with ASCII if needs be. For
; further information on ed, see
; https://en.wikipedia.org/wiki/Ed_(text_editor)
; https://www.gnu.org/software/ed/ed.html
; https://www.gnu.org/software/ed/manual/ed_manual.html
; https://sanctum.geek.nz/arabesque/actually-using-ed/
; http://www.psue.uni-hannover.de/wise2017_2018/material/ed.pdf
; We start editor from Forth with
;
; ed ( -- addr u )
;
; The return values ( addr u ) are the address and length of the text written.
; If no text was written, u is zero and addr is undefined.
; In the working memory, the text is stored as a simple linked list of lines.
; Each node consists of three 16-bit entries:
; - pointer to next entry (0 for end of list)
; - pointer to beginning of string ( addr )
; - length of string ( u )
; The editor only works in interaction with slow humans, so speed is not
; a primary concern. We try to keep the size down instead.
; Where to put variables is a bit of a problem. To convert the numbers, we need
; UM/MOD, which uses the scratchpad, and ACCEPT uses tmp1, tmp2, and tmp3 at
; some point, so we either have to pay very close attention, or we do something
; else. After some experimenting, it seems that the easiest way for this sort
; of hybrid Forth/assembler system is to keep the parameters for the commands
; on the Data Stack in the form of ( para1 para2 ):
; TOS: parameter 2 (after the comma)
; NOS: parameter 1 (before the comma)
; The third and fourth entries on the stack are the ( addr-t u-t ) entries the
; text will be/has been written to, or u as 0 if nothing was defined.
; We also need a pointer to the beginning of the text (first node of the list),
; the number of the current line, and a flag to mark if the text has been
; changed. We have six bytes of zero page reserved for any editor to use. Note
; that this means that we can't use two editors at the same time, which won't
; be a problem until we can multitask.
.alias ed_head editor1 ; pointer to first list element (addr) (2 bytes)
.alias ed_cur editor2 ; current line number (1 is first line) (2 bytes)
.alias ed_flags editor3 ; Flags used by ed, where
; bit 7 parameters - 0: none, 1: have at least one parameter
; bit 6 changed - 0: text not changed, 1: text was changed
; bit 0 printing - 0: no line numbers (p), 1: with line numbers (n)
; Byte editor3+1 is currently unused
.scope
ed6502:
; Start a new empty linked list at HERE. This is also
; the current line
stz ed_head
stz ed_head+1
; The current line is 0, because we start counting at
; line 1 for the humans
stz ed_cur
stz ed_cur+1
; At the beginning, we have no parameters (bit 7), no line
; numbers (bit 0), and nothing was changed (bit 6)
stz ed_flags
; We put zeros as placeholders for the text we've written to
; (the "target") on the stack. Because the stack picture is
; going to get very confusing very fast, we'll mark them
; specially with "-t" suffixes in the stack comments.
jsr xt_zero
jsr xt_zero ; ( addr-t u-t )
jsr xt_cr
_input_loop:
; Set parameter flag to none (bit 7); default printing is
; without line numbers (bit 0). We leave the changed flag (bit
; 6) because we might be coming from a previous add
lda #%10000001
trb ed_flags
; We really don't want to have to write a complete
; parser for such a simple editor, so we walk through the
; possibilities the hard way. Get input from the user. This
; routine handles any errors from REFILL
jsr _get_input
; If we were not given an empty line, see what we were given
lda ciblen
bne _command_mode
; We were given an empty line. Advance one line, print it, and
; make it the new current line
dex
dex ; ( addr-t u-t ? )
lda ed_cur
sta 0,x
lda ed_cur+1
sta 1,x ; ( addr-t u-t u )
; This counts as having a parameter
lda #%10000000
tsb ed_flags
jsr xt_one_plus ; ( addr-t u-t u+1 )
jsr _is_valid_line
bcs +
; New line number is not legal, abort
jmp _error_1drop
*
; We have a legal line number, but we need two entries on
; the parameter list (four if you count the target
; address) to be able to work with the rest of the program.
jsr xt_zero ; ( addr-t u-t u+1 0 )
jmp _line_number_only_from_external
_command_mode:
; We were given something other than an empty line. Set the
; parameter variables to zero as the default. There is no line
; zero, because we're coding for normal, sane humans, not weird
; computer people. Some commands like "a" will take a "line 0",
; however. We use the ed_flags bit 7 to signal if we are
; without parameters.
jsr xt_zero ; parameter 1 is NOS ( addr-t u-t 0 )
jsr xt_zero ; parameter 2 is TOS ( addr-t u-t 0 0 )
; We start off by taking care of any parameters. These can be
; '%' for the complete text, '$' for the last line, a line
; number, or a line number followed by a ',' and then either
; the '$' for the last line or another number. (The original
; Unix ed has more options, but we're ignoring them for the
; moment.) In pseudocode, what we are doing in this stage looks
; something like this:
; case char = '.':
; para1 = current line
;
; case char = '$':
; para1 = last line
;
; case char = '%' or ',':
; para1 = 1
; para2 = last line
;
; case char = ';':
; para1 = current line
; para2 = last line
;
; case number:
; para1 = number
; get next char
;
; if char = ',':
; get next char
;
; case char = '$':
; para2 = last line
;
; case number:
; para2 = number
;
; else error
;
; else get previous char
;
; else error
;
; get next char
; process command char
; We use the Y register as an offset to the beginning of the
; character input buffer (cib) because we're never going to
; have more than 255 characters of input with ed and we don't
; want to have to duplicate the complete machinery required for
; >IN. In other words, >IN has no meaning for ed. This means
; that every jmp to _check_command must have Y in a defined
; state, which is different from the rest of Tali Forth.
; Parameter processing could probably be handled more
; efficiently with a loop construct similar to the way the
; commands are taken care of below. We'll revisit this once ed
; is feature complete, because of the evils of premature
; optimization.
_prefix_dot:
; --- . --- Designate current line for further operations
lda (cib)
cmp #$2e ; ASCII '.'
bne _prefix_dollar
jsr _have_text
lda ed_cur
sta 2,x
lda ed_cur+1
sta 3,x ; ( addr-t u-t cur 0 )
; We have a parameter
lda #%10000000
tsb ed_flags
; If we were only given a '.', we print the current line and are
; done
lda ciblen
dec ; sets Z if A was 1
bne +
; We know that we have some text and the number of the last
; line was provided by _last_line, so in theory we don't have
; to check if this is a legal line number. However, we keep one
; entry point, so the check is repeated further down. Call it
; paranoia.
jmp _line_number_only_from_external
*
; We have processed the first parameter, and know that we have
; more than just a dot here. We now need to see if the next
; character is a comma or a command character. To do this, we
; need to modify the stack to ( addr-t u-t para1 0 addr u )
dex
dex
dex
dex
lda cib
sta 2,x
lda cib+1
sta 3,x
lda ciblen
sta 0,x
lda ciblen+1
sta 1,x
jsr xt_one_minus ; ( addr-t u-t para1 0 addr u-1 )
jsr xt_swap ; ( addr-t u-t para1 0 u-1 addr )
jsr xt_one_plus ; ( addr-t u-t para1 0 u-1 addr+1 )
jsr xt_swap ; ( addr-t u-t para1 0 addr+1 u-1 )
jmp _check_for_para2
_prefix_dollar:
; --- $ --- Designate last line for further operations
lda (cib)
cmp #'$
bne _prefix_percent
jsr _have_text
inx
inx ; ( addr-t u-t 0 )
jsr _last_line ; ( addr-t u-t 0 para1 )
jsr xt_swap ; SWAP ( addr-t u-t para1 0 )
; We have a parameter
lda #%10000000
tsb ed_flags
; If we were only given a '$', we print the last line and are
; done
lda ciblen
dec ; sets Z if A was 1
bne +
; We know that we have some text and the number of the last
; line was provided by _last_line, so in theory we don't have
; to check if this is a legal line number. However, we keep one
; entry point for the moment and repeat the check further down
; out of paranoia
jmp _line_number_only_from_external
*
; We are one character into the input buffer cib, so we advance
; Y as the index accordingly
ldy #01
jmp _check_command
_prefix_percent:
; --- % and , --- Designate whole text for futher operations
lda (cib)
cmp #$25 ; ASCII '%'
beq _whole_text
cmp #$2c ; ASCII ','
bne _prefix_semicolon
_whole_text:
; If there is no text yet, print an error
jsr _have_text
; We have at least one line of text. The first parameter
; is therefore line one, the second the last line
lda #01
sta 2,x ; LSB of NOS is para 1
stz 3,x ; ( addr-t u-t para1 0 )
_semicolon_entry:
; Get the number (not the address) of the last line and
; store it as the second parameter
inx
inx ; DROP ( addr-t u-t para1 )
jsr _last_line ; ( addr-t u-t para1 para2 )
; We have a parameter
lda #%10000000
tsb ed_flags
; We are one character into the input buffer cib, so we advance
; Y as the index accordingly
ldy #01
jmp _check_command
_prefix_semicolon:
; --- ; --- Designate from current line to end of text
lda (cib)
cmp #$3b ; ASCII ';'
bne _prefix_number
jsr _have_text
; The first parameter is the current line
lda ed_cur
sta 2,x
lda ed_cur+1
sta 3,x ; ( addr-t u-t cur 0 )
; The second parameter is the last line. We've done this part
; before for the '%' and ',' parameters, so we reuse that code
bra _semicolon_entry
_prefix_number:
; --- <NUM> --- Check if we have been given a number
; We use the built-in Forth routines for this, which involves
; calling >NUMBER, which calls UM*, which uses tmp1, tmp2, and
; tmp3. So we can't use any of those temporary variables. We
; arrive here with ( addr-t u-t 0 0 ), which doesn't help us at
; all because the string we are looking at is in ( cib ciblen )
; Set up >NUMBER using CIB and CIBLEN as the location of the
; string to check. First, though, add the "accumulator" of
; >NUMBER as a double number, that is, to single-cell numbers
jsr xt_zero
jsr xt_zero ; ( addr-t u-t 0 0 0 0 )
dex
dex
dex
dex ; ( addr-t u-t 0 0 0 0 ? ? )
lda cib
sta 2,x
lda cib+1
sta 3,x ; ( addr-t u-t 0 0 0 0 cib ? )
lda ciblen
sta 0,x
lda ciblen+1
sta 1,x ; ( addr-t u-t 0 0 0 0 cib ciblen )
jsr xt_to_number ; ( addr-t u-t 0 0 ud addr2 u2 )
; If we converted all the characters in the string (u2 is
; zero), then the user just gave us a line number to
; jump to and nothing else. Otherwise, take another look
lda 0,x
ora 1,x
bne _have_unconverted_chars
; We must have a line number and nothing else. Make this
; the current line number and print the line. Remember
; that at this point, the line number still could be a zero
inx
inx
inx
inx ; 2DROP ( addr-t u-t 0 0 ud )
jsr xt_d_to_s ; D>S ( addr-t u-t 0 0 u )
jsr xt_not_rote ; -ROT ( addr-t u-t u 0 0 )
inx
inx ; ( addr-t u-t u 0 ) drop through
_line_number_only_from_external:
jsr xt_swap ; ( addr-t u-t 0 u )
jsr _is_valid_line
bcs +
; This is not a valid line number, so we bail
jmp _error_2drop
*
; Legal line number, so make it the current number
jsr xt_swap ; ( addr-t u-t u 0 )
jsr _para1_to_cur
; We have a parameter
lda #%10000000
tsb ed_flags
jmp _cmd_p_from_external
_have_unconverted_chars:
; We have some unconverted characters left. If none of the
; characters were converted, we probably just got a
; command character and need to skip the rest of the prefix
; processing. In this case, the number of unconverted
; characters is equal to the length of the string.
jsr xt_dup ; ( addr-t u-t 0 0 ud addr2 u2 u2 )
dex
dex ; ( addr-t u-t 0 0 ud addr2 u2 u2 ? )
lda ciblen
sta 0,x
lda ciblen+1
sta 1,x ; ( addr-t u-t 0 0 ud addr2 u2 u2 ciblen )
jsr xt_equal ; ( addr-t u-t 0 0 ud addr2 u2 f )
lda 0,x
ora 1,x
beq _no_command_yet
; The length of the input string is equal to the length of the
; unprocessed string that >NUMBER returned. Put differently,
; the first character isn't a number. We know that it isn't '$'
; or '%' either, so we assume that it's a command character.
; Clear up the stack and process that command character
txa
clc
adc #10
tax ; ( addr-t u-t 0 0 )
; If we weren't given a number, this means we didn't explicitly
; get a 0 either. So we don't have a parameter. This is the
; default case, but out of paranoia we explicity clear the flag
lda #%10000000
trb ed_flags
; We don't have any offset, so we go with Y as zero
ldy #00
jmp _check_command
_no_command_yet:
; There actually seems to be a parameter number present.
; Save the number we converted as the first parameter. We
; arrive here with ( addr-t u-t 0 0 ud addr2 u2 f ) from
; >NUMBER. To avoid too long stack comments, we leave the
; target addresses out in this next code segment.
inx
inx ; ( ... 0 0 ud addr2 u2 )
jsr xt_to_r ; >R ( ... 0 0 ud addr2 ) (R: u2)
jsr xt_not_rote ; -ROT ( ... 0 0 addr2 ud ) (R: u2)
jsr xt_d_to_s ; D>S ( ... 0 0 addr2 para1 ) (R: u2)
lda 0,x ; LSB
sta 6,x
lda 1,x ; MSB
sta 7,x ; ( ... para1 0 addr2 para1 ) (R: u2)
inx
inx ; ( addr-t u-t para1 0 addr2 ) (R: u2)
jsr xt_r_from ; R> ( addr-t u-t para1 0 addr2 u2 ) fall through
; We have a parameter
lda #%10000000
tsb ed_flags
_check_for_para2:
; That was the first parameter. If the next character is
; a comma, then there is a second parameter (another number
; or '$'). Otherwise we expect a command. This is the entry
; point if the first character was a dot (eg '.,3p')
lda (2,x)
cmp #$2c ; ASCII code for ',' (comma)
beq _got_comma
; It's not a comma, so it's going to be a command character.
; We need to figure out how many digits our number has so
; we can adjust Y as the offset. We don't have to do this with
; 16 bit because no input string is going to be that long
sec
lda ciblen
sbc 0,x
tay
; Remove the leftover stuff from >NUMBER
inx
inx
inx
inx ; 2DROP ( addr-t u-t para1 0 )
jmp _check_command
_got_comma:
; It's a comma, so we have a second parameter. The next
; character can either be '$' to signal the end of the text
; or another number. First, though, move to that next char
inc 2,x
bne +
inc 3,x ; ( addr-t u-t para1 0 addr2+1 u2 )
*
lda 1,x
beq +
dec 1,x
*
dec 0,x ; ( addr-t u-t para1 0 addr2+1 u2-1 )
; See if this is an end-of-line '$'
lda (2,x)
cmp #$24 ; ASCII for '$'
bne _para2_not_dollar
; It's a dollar sign, which means para2 is the number of the
; last line of the text. We need to adjust Y as the offset. We
; assume that no command line will be longer than 255
; characters in ed so we can get away with just looking at
; the LSB
sec
lda ciblen
sbc 2,x
tay
; However, we need to move Y up by one because we were on the
; '$' and not on the character after that
iny
phy
; Dump all the stuff from >NUMBER off the stack. This saves
; one byte compared to six INX instructions, and a byte saved
; is a byte earned.
txa
clc
adc #06
tax ; ( addr-t u-t para1 )
jsr _last_line ; ( addr-t u-t para1 para2 )
ply
jmp _check_command
_para2_not_dollar:
; It's not a dollar sign, so it is either another number or an
; error. We try for a number first. We arrive here with ( para1
; 0 addr2+1 u2-1 ), which u2-1 pointing to the first mystery
; character after the comma. Again, we skip the ( addr-t u-t )
; at the beginning of the stack comment here.
jsr xt_to_r ; >R ( ... para1 0 addr2+1 ) (R: u2-1)
jsr xt_zero ; 0 ( ... para1 0 addr2+1 0 ) (R: u2-1)
jsr xt_zero ; 0 ( ... para1 0 addr2+1 0 0 ) (R: u2-1)
jsr xt_rot ; ROT ( ... para1 0 0 0 addr2+1 ) (R: u2-1)
jsr xt_r_from ; R> ( ... para1 0 0 0 addr2+1 u2-1)
; We'll need a copy of the length of the rest of the string to
; see if we've actually done any work
jsr xt_dup ; DUP ( ... para1 0 0 0 addr2+1 u2-1 u2-1)
jsr xt_to_r ; >R ( ... para1 0 0 0 addr2+1 u2-1 ) (R: u2-1)
jsr xt_to_number ; >NUMBER ( ... para1 0 ud addr3 u3 ) (R: u2-1)
; If the original string and the leftover string have the same
; length, then nothing was converted and we have an error
jsr xt_dup ; DUP ( ... para1 0 ud addr3 u3 u3 ) (R: u2-1)
jsr xt_r_from ; R> ( ... para1 0 ud addr3 u3 u3 u2-1 )
jsr xt_equal ; = ( ... para1 0 ud addr3 u3 f )
lda 0,x
ora 1,x
beq _second_number
; The strings are the same length, so nothing was converted, so
; we have an error. We have to get all that stuff off the
; stack first
txa
clc
adc #12
tax ; back to ( addr-t u-t )
jmp _error
_second_number:
; We have a second number, so we add it to para2. We arrive here
; with ( para1 0 ud addr3 u3 f )
inx
inx ; ( addr-t u-t para1 0 ud addr3 u3 )
; Calculate the offset for Y
sec
lda ciblen
sbc 0,x
pha
; Clean up the stack
jsr xt_two_drop ; 2DROP ( addr-t u-t para1 0 ud )
jsr xt_d_to_s ; D>S ( addr-t u-t para1 0 para2 )
jsr xt_nip ; NIP ( addr-t u-t para1 para2 )
ply
; fall through to _check_command
_check_command:
; At this point, we assume that we have handled any parameters
; which are now in their place on the stack, which must have
; the format ( addr-t u-t para1 para2 ). Also, any offset to CIB
; is going to be in Y. Bit 7 in ed_flags signals if we have
; a parameter or not.
; Command character checking works by comparing the char we
; have at CIB+Y with a list of legal characters. The index in
; the list is the index of the command's routine in a jump
; table. The list itself is zero-terminated, which is okay
; because we've taken care of any legal parameters.
lda (cib),y ; get mystery char from input
sta tmp1
; We're going to need X for the jump table, so it has to
; take a break from being the Data Stack Pointer (DSP). Pushing
; X to the stack uses less space than storing in the reserved
; space on the Zero Page
phx
ldx #00
_cmd_loop:
lda ed_cmd_list,x
beq _illegal_command ; zero marks end of list
cmp tmp1
beq _found_cmd
; No match, next char
inx
bra _cmd_loop
_illegal_command:
; Whatever the user gave us, we don't recognize it
plx
jmp _error_2drop
_found_cmd:
; We have a command match. Because this is the 65c02 and not
; the 65816, we can only use JMP (addr,x) and not a subroutine
; jump. That sucks.
txa
asl
tax ; X * 2 for table
; Note we're jumping with the DSP still on the stack, so each
; command routine has to pull it into X the very first thing
; with its very own PLX. There doesn't seem to be a sane way to
; avoid this.
jmp (ed_cmd_table,x)
_next_command:
; Clean up the stack and return to the input loop. We
; arrive here with ( addr-t u-t para1 para2 ). The called
; command routines have taken care of putting the DSP (that's
; X) back the way it should be
inx
inx
inx
inx ; ( addr-t u-t ) Fall through
_next_command_empty:
; The beginning of the input loop takes care of resetting the
; parameter flag
jmp _input_loop
_all_done:
; That's enough for ed today. We have to clear out the input
; buffer or else the Forth main main loop will react to the
; last input command
stz ciblen
stz ciblen+1
; Clean up the stack
jsr xt_two_drop ; 2DROP ( addr-t u-t )
rts
; === COMMAND ROUTINES ====
; We enter all command subroutines with ( addr-t u-t para1 para2 ) and the DSP
; still on the Return Stack. This means that the first oder of business is to
; restore the DSP with PLX -- remember this when you add new commands. At this
; point, we don't need the offset in Y anymore so we are free to use it as we
; please.
; There is potential to rewrite many of the command routines with an abstract
; construct in the form of (pseudocode):
; f = cmd ; command such as d, p, n, as a function
; map f range(para1, para2)
; That is, have one routine with a looping structure and pass the actual work
; as a function. However, this is 8-bit assembler and not, say, Haskell, so
; that abstraction will wait for a future round of refracturing when we have
; everything complete and working.
; -------------------------
_cmd_a:
; a -- Add text after current/given line. If no line is given, we use
; the current line. We accept the number '0' and then start adding at
; the very beginning. The second parameter is always ignored. This
; routine is used by i as well.
plx
; We don't care about para2, because a just adds stuff starting
; the line we were given
inx
inx ; DROP ( addr-t u-t para1 )
; If we weren't given a parameter, make the current line the
; parameter
bit ed_flags
bmi _cmd_a_have_para
lda ed_cur
sta 0,x
lda ed_cur+1
sta 1,x ; ( addr-t u-t cur ) drop through
_entry_cmd_i:
; This is where i enters with a parameter that is calculated to
; be one before the current line, or given line, or so that we
; accept 0. We are ( addr-t u-t num )
_cmd_a_have_para:
jsr _num_to_addr ; ( addr-t u-t addr1 )
jsr xt_cr
_next_string_loop:
; This is where we land when we are continuing in with another
; string after the first one. ( addr-t u-t addr1 )
jsr _get_input
; If there is only one character and that character is a
; dot, we're done with adding text and switch back to command
; mode
lda (cib)
cmp #$2e ; ASCII for '.'
bne _add_line
; So it's a dot, but that the only character in the line?
; We want the length to be one character exactly
ldy ciblen
cpy #01
bne _add_line
ldy ciblen+1
bne _add_line
; Yes, it is a dot, so we're done adding lines.
inx
inx
; The string is stored and the new node is full. Time to set the
; changed flag
lda #%01000000
tsb ed_flags
jsr xt_cr
jmp _input_loop
_add_line:
; Break the linked list so we can insert another node
jsr xt_dup ; DUP ( addr-t u-t addr1 addr1 )
jsr xt_here ; HERE ( addr-t u-t addr1 addr1 here )
jsr xt_swap ; SWAP ( addr-t u-t addr1 here addr1 )
jsr xt_fetch ; @ ( addr-t u-t addr1 here addr2 )
jsr xt_comma ; , ( addr-t u-t addr1 here )
; We're going to need that HERE for the next line if more
; than one line is added. This is a good time to save it on
; the stack
jsr xt_tuck ; TUCK ( addr-t u-t here addr1 here )
; We have now saved the link to the next node at HERE, which is
; where the CP was pointing. CP has been advanced by one cell,
; but we still have the original as HERE on the stack. That
; address now has to go where addr2 was before.
jsr xt_swap ; SWAP ( addr-t u-t here here addr1 )
jsr xt_store ; ! ( addr-t u-t here )
; Thus concludes the mucking about with node links. Now we have
; to create a new header. The CP we access with HERE points to
; the cell after the new node address, which is where we want
; to put ( ) for the new string
jsr xt_here ; HERE ( addr-t u-t here here2)
; Reserve two cells (four bytes on the 65c02) for the ( addr u )
; of the new string
lda cp
clc
adc #04
sta cp
bcc +
inc cp+1
*
; HERE now points to after the new header. Since we're really
; going to add something, we can increase the current line
; number
inc ed_cur
bne +
inc ed_cur+1
*
; We have the new line sitting in ( cib ciblen ) and need to
; a) move it somewhere safe and b) get ready for the next
; line. We arrive here with ( addr-t u-t here here2 ), where here2
; is where the new string needs to be. The MOVE command we're
; going to use has the format ( addr1 addr2 u )
jsr xt_here ; HERE ( addr-t u-t here here2 here3 )
jsr xt_dup ; DUP ( addr-t u-t here here2 here3 here3 )
dex
dex ; ( addr-t u-t here here2 here3 here3 ? )
lda cib
sta 0,x
lda cib+1
sta 1,x ; ( addr-t u-t here here2 here3 here3 cib )
jsr xt_swap ; SWAP ( addr-t u-t here here2 here3 cib here3 )
dex
dex ; ( addr-t u-t here here2 here3 cib here3 ? )
lda ciblen
sta 0,x
lda ciblen+1
sta 1,x ; ( addr-t u-t here here2 here3 cib here3 ciblen )
jsr xt_move ; ( addr-t u-t here here2 here3 )
; We need to adjust CP be the length of the string
clc
lda cp
adc ciblen
sta cp
bcc +
lda cp+1
adc ciblen+1
sta cp+1
*
; The string is now moved safely out of the input buffer to the
; main memory at ( here3 ciblin ). Now we have to fix that
; fact in the header. We start with the address.
jsr xt_over ; OVER ( addr-t u-t here here2 here3 here2 )
jsr xt_store ; ! ( addr-t u-t here here2 )
jsr xt_one_plus ; 1+
jsr xt_one_plus ; 1+ ( addr-t u-t here here2+2 )
jsr xt_dup ; DUP ( addr-t u-t here here2+2 here2+2 )
lda ciblen
sta 2,x
lda ciblen+1
sta 3,x ; ( addr-t u-t here ciblen here2+2 )
jsr xt_store ; ! ( addr-t u-t here )
; Add a line feed for visuals
jsr xt_cr
; Remeber that original HERE we've been dragging along all the
; time? Now we find out why. We return to the loop to pick up
; the next input
jmp _next_string_loop
; -------------------------
_cmd_d:
; d -- Delete one or more lines. This might have to be coded as
; a subroutine because other commands such as 'c' might be easier to
; implement that way. Note that a lot of this code is very similar to
; the loop for 'p'. We arrive here with ( addr-t u-t para1 para2 )
plx
jsr _have_text
jsr _no_line_zero
; At least the first line is valid. Most common case is one
; line, so we check to see if we even have a second parameter.
lda 0,x
ora 1,x
bne +
; The second parameter is a zero, so delete one line
jsr xt_over ; ( addr-t u-t para1 0 para1 )
jsr _cmd_d_common ; ( addr-t u-t para1 0 )
bra _cmd_d_done
*
; We have been given a range. Make sure that the second
; parameter is legal. We arrive here with ( addr-t u-t para1 para2 )
jsr _is_valid_line ; result is in C flag
bcs _cmd_d_loop
; para2 is not valid. Complain and abort
jmp _error_2drop
_cmd_d_loop:
; Seems to be a legal range. Walk through and delete If para1
; is larger than para2, we're done. Note that Unix ed throws an
; error if we start out that way, we might do that in future as
; well. This is not the same code as for 'p', because we have
; to delete from the back
jsr xt_two_dup ; 2DUP ( addr-t u-t para1 para2 para1 para2 )
jsr xt_greater_than ; > ( addr-t u-t para1 para2 f )
lda 0,x
ora 1,x
bne _cmd_d_done_with_flag
; Para2 is still larger or the same size as para1, so we
; continue
inx
inx ; Get rid of the flag from >
jsr xt_dup ; DUP ( addr-t u-t para1 para2 para2 )
jsr _cmd_d_common ; ( addr-t u-t para1 para2 )
jsr xt_one_minus ; 1- ( addr-t u-t para1 para2-1 )
bra _cmd_d_loop
_cmd_d_done_with_flag:
inx ; ( addr-t u-t para1 para2 )
inx
; The current line is set to the first line minus
; one. Since we don't accept '0d', this at least
; hast to be one
lda 2,x
bne +
dec 3,x
*
dec 2,x
lda 2,x
sta ed_cur
lda 3,x
sta ed_cur+1 ; drop through to _cmd_d_done
_cmd_d_done:
; Text has changed, set flag
lda #%01000000
tsb ed_flags
jsr xt_cr
jmp _next_command
_cmd_d_common:
; Internal subroutine to delete a single line when given the line
; number TOS. Consumes TOS. What we do is take the link to the next
; node and put it in the previous node. The caller is responsible
; for setting ed_changed. We arrive here with ( u )
jsr xt_dup ; DUP ( addr-t u-t u u )
jsr _num_to_addr ; ( addr-t u-t u addr )
jsr xt_fetch ; @ ( addr-t u-t u addr1 )
jsr xt_swap ; SWAP ( addr-t u-t addr1 u )
jsr xt_one_minus ; 1- ( addr-t u-t addr1 u-1 )
jsr _num_to_addr ; ( addr-t u-t addr1 addr-1 )
jsr xt_store ; ! ( addr-t u-t )
rts
; -------------------------
_cmd_equ:
; = --- Print the given line number or the current line number if no
; value is given. This is useful if you want to know what the number of
; the last line is ("$=")
plx
; If we don't have a text, we follow Unix ed's example and
; print a zero. It would seem to make more sense to throw an
; error, but who are we to argue with Unix.
lda ed_head
ora ed_head+1