-
Notifications
You must be signed in to change notification settings - Fork 1
/
tink.lst
9564 lines (9560 loc) · 852 KB
/
tink.lst
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
A Tinkerer's Assembler for the 6502/65c02/65816
Version BETA 17. Feb 2017
Copyright 2015-2017 Scot W. Stevenson <scot.stevenson@gmail.com>
This program comes with ABSOLUTELY NO WARRANTY
Code listing for file liaraforth.tasm
Generated on Mon Sep 18 01:38:30 2017
Target MPU: 65816
External files loaded: 5
Number of passes executed: 35
Number of steps executed: 11
Assembly time: 0.12549 seconds
Code origin: 005000
Bytes of machine code: 9056
LISTING:
Line Status/Type State/Width Address Bytes Instruction
1:000 | DONE cmt | em 8 8 | | | ; Liara Forth for the W65C265SXB
2:000 | DONE cmt | em 8 8 | | | ; Scot W. Stevenson <scot.stevenson@gmail.com>
3:000 | DONE cmt | em 8 8 | | | ; First version: 01. Apr 2016
4:000 | DONE cmt | em 8 8 | | | ; This version: 18. Sep 2017
5:000 | DONE wsp | em 8 8 | | |
6:000 | DONE cmt | em 8 8 | | | ; This code is written in Typist's Assembler Notation for the 65c02/65816
7:000 | DONE cmt | em 8 8 | | | ; See docs/MANUAL.md for more information
8:000 | DONE wsp | em 8 8 | | |
9:000 | DONE dir | em 8 8 | | | .mpu 65816
10:000 | DONE dir | em 8 8 | | | .origin 5000 start of code to save to built-in RAM
11:000 | DONE cmt | em 8 8 | | | ; .origin 8000 ; start of code to save to Flash memory
12:000 | DONE wsp | em 8 8 | | |
13:000 | DONE lbl | em 8 8 | 005000 | | code0 ; used to calculate UNUSED
14:000 | DONE wsp | em 8 8 | | |
15:000 | DONE cmt | em 8 8 | | | ; ===================================================================
16:000 | DONE cmt | em 8 8 | | | ; TOP INCLUDES
17:000 | DONE wsp | em 8 8 | | |
18:000 | DONE cmt | em 8 8 | | | ; Definitions for Liara Forth for the W65C265SXB
18:001 | DONE cmt | em 8 8 | | | ; Scot W. Stevenson <scot.stevenson@gmail.com>
18:002 | DONE cmt | em 8 8 | | | ; First version: 01. Apr 2016
18:003 | DONE cmt | em 8 8 | | | ; This version: 09. June 2017
18:004 | DONE wsp | em 8 8 | | |
18:005 | DONE cmt | em 8 8 | | | ; This file is included by liaraforth.tasm
18:006 | DONE wsp | em 8 8 | | |
18:007 | DONE cmt | em 8 8 | | | ; Note that Typist's Assembler Notation does not distinguish between
18:008 | DONE cmt | em 8 8 | | | ; upper andlower case. Variations in case are for human readers only.
18:009 | DONE wsp | em 8 8 | | |
18:010 | DONE cmt | em 8 8 | | | ; I/O facilities are handled in the separate kernel files. The definitions for
18:011 | DONE cmt | em 8 8 | | | ; multitasking are preliminary and will probably change
18:012 | DONE wsp | em 8 8 | | |
18:013 | DONE cmt | em 8 8 | | | ; ===================================================================
18:014 | DONE cmt | em 8 8 | | | ; MEMORY MAP
18:015 | DONE cmt | em 8 8 | | | ; We reuse the memory that the Mensch Monitor had been using
18:016 | DONE wsp | em 8 8 | | |
18:017 | DONE cmt | em 8 8 | | | ; TODO add any extra RAM in other banks
18:018 | DONE cmt | em 8 8 | | | ; TODO add stuff for multitasking
18:019 | DONE wsp | em 8 8 | | |
18:020 | DONE cmt | em 8 8 | | | ; 00:0000 +-------------------+ ram-start, dpage, user0
18:021 | DONE cmt | em 8 8 | | | ; | |
18:022 | DONE cmt | em 8 8 | | | ; | ^ Data Stack | <-- dsp
18:023 | DONE cmt | em 8 8 | | | ; | | |
18:024 | DONE cmt | em 8 8 | | | ; 00:0100 +-------------------+ dsp0, stack
18:025 | DONE cmt | em 8 8 | | | ; | |
18:026 | DONE cmt | em 8 8 | | | ; | ^ Return Stack | <-- rsp
18:027 | DONE cmt | em 8 8 | | | ; | | |
18:028 | DONE cmt | em 8 8 | | | ; 00:0200 +-------------------+ rsp0, buffer, buffer0
18:029 | DONE cmt | em 8 8 | | | ; | | |
18:030 | DONE cmt | em 8 8 | | | ; | v Input Buffer |
18:031 | DONE cmt | em 8 8 | | | ; | |
18:032 | DONE cmt | em 8 8 | | | ; 00:0300 +-------------------+ cp0
18:033 | DONE cmt | em 8 8 | | | ; | | |
18:034 | DONE cmt | em 8 8 | | | ; | v Dictionary | <-- cp
18:035 | DONE cmt | em 8 8 | | | ; | |
18:036 | DONE cmt | em 8 8 | | | ; (...) ~~~~~~~~~~~~~~~~~~~~~
18:037 | DONE cmt | em 8 8 | | | ; | |
18:038 | DONE cmt | em 8 8 | | | ; | |
18:039 | DONE cmt | em 8 8 | | | ; 00:7fff +-------------------+ ram-end
18:040 | DONE wsp | em 8 8 | | |
18:041 | DONE cmt | em 8 8 | | | ; Hard physical addresses
18:042 | DONE dir | em 8 8 | | | .equ ram-start 0000 start of installed RAM
18:043 | DONE dir | em 8 8 | | | .equ ram-end { 8000 - 1 } end of 32k installed RAM
18:044 | DONE wsp | em 8 8 | | |
18:045 | DONE cmt | em 8 8 | | | ; Soft physical addresses
18:046 | DONE dir | em 8 8 | | | .equ dpage ram-start direct page: 0000 - 00ff
18:047 | DONE dir | em 8 8 | | | .equ stack { 000000 + 0100 } return stack area: 0100 - 01ff
18:048 | DONE dir | em 8 8 | | | .equ buffer0 { stack + 0100 } buffer areas: 0200 - 02ff
18:049 | DONE wsp | em 8 8 | | |
18:050 | DONE cmt | em 8 8 | | | ; Defined locations
18:051 | DONE dir | em 8 8 | | | .equ user0 dpage user and system variables
18:052 | DONE dir | em 8 8 | | | .equ dsp0 { stack - 1 } initial Data Stack Pointer: 00ff
18:053 | DONE dir | em 8 8 | | | .equ stack0 { buffer0 - 1 } initial Return Stack Pointer: 01ff
18:054 | DONE wsp | em 8 8 | | |
18:055 | DONE cmt | em 8 8 | | | ; Buffers
18:056 | DONE dir | em 8 8 | | | .equ bsize 0080 size of input/output buffers
18:057 | DONE dir | em 8 8 | | | .equ buffer1 { buffer0 + 000080 } output buffer 0280 (UNUSED)
18:058 | DONE wsp | em 8 8 | | |
18:059 | DONE cmt | em 8 8 | | | ; Dictionary RAM
18:060 | DONE dir | em 8 8 | | | .equ cp0 { buffer1 + 000080 } Dictionary starts after last buffer
18:061 | DONE dir | em 8 8 | | | .equ cp-end { code0 - 1 } Last RAM byte available
18:062 | DONE wsp | em 8 8 | | |
18:063 | DONE cmt | em 8 8 | | | ; Other locations
18:064 | DONE dir | em 8 8 | | | .equ padoffset 0ff offset from CP to PAD (holds number strings)
18:065 | DONE wsp | em 8 8 | | |
18:066 | DONE wsp | em 8 8 | | |
18:067 | DONE cmt | em 8 8 | | | ; ===================================================================
18:068 | DONE cmt | em 8 8 | | | ; DIRECT PAGE ADDRESSES
18:069 | DONE wsp | em 8 8 | | |
18:070 | DONE cmt | em 8 8 | | | ; All are one cell (two bytes) long to prevent weird errors
18:071 | DONE cmt | em 8 8 | | | ; TODO rewrite with USER variables
18:072 | DONE dir | em 8 8 | | | .equ cp { 000000 + &00 } Compiler Pointer, 2 bytes
18:073 | DONE dir | em 8 8 | | | .equ dp { 000000 + &02 } Dictionary Pointer, 2 bytes
18:074 | DONE dir | em 8 8 | | | .equ workword { 000000 + &04 } nt (not xt) of word being compiled
18:075 | DONE dir | em 8 8 | | | .equ insrc { 000000 + &06 } Input Source for SOURCE-ID
18:076 | DONE dir | em 8 8 | | | .equ cib { 000000 + &08 } Address of current input buffer
18:077 | DONE dir | em 8 8 | | | .equ ciblen { 000000 + &10 } Length of current input buffer
18:078 | DONE dir | em 8 8 | | | .equ toin { 000000 + &12 } Pointer to CIB (>IN in Forth)
18:079 | DONE dir | em 8 8 | | | .equ output { 000000 + &14 } Jump target for EMIT
18:080 | DONE dir | em 8 8 | | | .equ input { 000000 + &16 } Jump target for KEY
18:081 | DONE dir | em 8 8 | | | .equ havekey { 000000 + &18 } Jump target for KEY?
18:082 | DONE dir | em 8 8 | | | .equ state { 000000 + &20 } STATE: -1 compile, 0 interpret
18:083 | DONE dir | em 8 8 | | | .equ base { 000000 + &22 } Radix for number conversion
18:084 | DONE dir | em 8 8 | | | .equ tohold { 000000 + &24 } Pointer for formatted output
18:085 | DONE dir | em 8 8 | | | .equ tmpbranch { 000000 + &26 } temp storage for 0BRANCH, BRANCH only
18:086 | DONE dir | em 8 8 | | | .equ tmp1 { 000000 + &28 } Temporary storage
18:087 | DONE dir | em 8 8 | | | .equ tmp2 { 000000 + &30 } Temporary storage
18:088 | DONE dir | em 8 8 | | | .equ tmp3 { 000000 + &32 } Temporary storage
18:089 | DONE dir | em 8 8 | | | .equ tmpdsp { 000000 + &34 } Temporary DSP (X) storage, 2 bytes
18:090 | DONE dir | em 8 8 | | | .equ tmptos { 000000 + &36 } Temporary TOS (Y) storage, 2 bytes
18:091 | DONE dir | em 8 8 | | | .equ nc_limit { 000000 + &38 } Holds limit for Native Compile size
18:092 | DONE dir | em 8 8 | | | .equ scratch { 000000 + &40 } 8 byte scratchpad (see UM/MOD)
18:093 | DONE wsp | em 8 8 | | |
18:094 | DONE wsp | em 8 8 | | |
18:095 | DONE cmt | em 8 8 | | | ; ===================================================================
18:096 | DONE cmt | em 8 8 | | | ; HELPER DEFINITIONS
18:097 | DONE wsp | em 8 8 | | |
18:098 | DONE cmt | em 8 8 | | | ; ASCII characters
18:099 | DONE dir | em 8 8 | | | .equ AscCC 03 break (Control-C) ASCII character
18:100 | DONE dir | em 8 8 | | | .equ AscBELL 07 ACSCII bell sound
18:101 | DONE dir | em 8 8 | | | .equ AscBS 08 backspace ASCII character
18:102 | DONE dir | em 8 8 | | | .equ AscLF 0a line feed ASCII character
18:103 | DONE dir | em 8 8 | | | .equ AscCR 0d carriage return ASCII character
18:104 | DONE dir | em 8 8 | | | .equ AscCN 0e ASCII CNTR-n (for next command)
18:105 | DONE dir | em 8 8 | | | .equ AscCP 10 ASCII CNTR-p (for previous command)
18:106 | DONE dir | em 8 8 | | | .equ AscESC 1b Escape ASCII character
18:107 | DONE dir | em 8 8 | | | .equ AscSP 20 space ASCII character
18:108 | DONE dir | em 8 8 | | | .equ AscDEL 7f DEL ASCII character
18:109 | DONE wsp | em 8 8 | | |
18:110 | DONE cmt | em 8 8 | | | ; Dictionary flags. The first four bits are currently unused
18:111 | DONE dir | em 8 8 | | | .equ CO 0001 Compile Only
18:112 | DONE dir | em 8 8 | | | .equ AN 0002 Always Native Compile
18:113 | DONE dir | em 8 8 | | | .equ IM 0004 Immediate Word
18:114 | DONE dir | em 8 8 | | | .equ NN 0008 Never Native Compile
18:115 | DONE wsp | em 8 8 | | |
19:000 | DONE wsp | em 8 8 | | |
20:000 | DONE cmt | em 8 8 | | | ; Hardware dependencies are isolated to a large degree in kernel files. Liara
21:000 | DONE cmt | em 8 8 | | | ; Forth ships with two such files: One (very ALPHA) for the crude65816 emulator,
22:000 | DONE cmt | em 8 8 | | | ; and one for the 265sxb board. Only use one. Which ever kernel file is used, it
23:000 | DONE cmt | em 8 8 | | | ; must contain at least the routines put_chr, get_chr and have_chr, which work
24:000 | DONE cmt | em 8 8 | | | ; on the A register
25:000 | DONE wsp | em 8 8 | | |
26:000 | DONE cmt | em 8 8 | | | ; Basic hardware routines for Liara Forth: 265SXB version
26:001 | DONE cmt | em 8 8 | | | ; Scot W. Stevenson <scot.stevenson@gmail.com>
26:002 | DONE cmt | em 8 8 | | | ; First version: 04. Jan 2017
26:003 | DONE cmt | em 8 8 | | | ; This version: 19. Mar 2017
26:004 | DONE wsp | em 8 8 | | |
26:005 | DONE cmt | em 8 8 | | | ; This section provides basic hardware interface to the 265SXB, providing at the
26:006 | DONE cmt | em 8 8 | | | ; very least the the PUT_CHR, GET_CHR and HAVE_CHR routines that Liara Forth
26:007 | DONE cmt | em 8 8 | | | ; uses. These MUST BE PRESENT. It is in its own section to make porting Forth
26:008 | DONE cmt | em 8 8 | | | ; to other machines easier.
26:009 | DONE wsp | em 8 8 | | |
26:010 | DONE cmt | em 8 8 | | | ; The code here is based on Andrew Jacobs' Basic Vector Handling for the
26:011 | DONE cmt | em 8 8 | | | ; W65C265SXB Development Board as part of the w65c265sxb-hacker project
26:012 | DONE cmt | em 8 8 | | | ; (https://github.com/andrew-jacobs/w65c265sxb-hacker). It is released under the
26:013 | DONE cmt | em 8 8 | | | ; following license:
26:014 | DONE cmt | em 8 8 | | | ;
26:015 | DONE cmt | em 8 8 | | | ; This work is made available under the terms of the Creative Commons
26:016 | DONE cmt | em 8 8 | | | ; Attribution-NonCommercial-ShareAlike 4.0 International license. Open the
26:017 | DONE cmt | em 8 8 | | | ; following URL to see the details.
26:018 | DONE cmt | em 8 8 | | | ; http://creativecommons.org/licenses/by-nc-sa/4.0/
26:019 | DONE wsp | em 8 8 | | |
26:020 | DONE cmt | em 8 8 | | | ; Original variable names from w65c256.inc are included in comments to make
26:021 | DONE cmt | em 8 8 | | | ; updates and changes easier
26:022 | DONE wsp | em 8 8 | | |
26:023 | DONE cmt | em 8 8 | | | ; ===================================================================
26:024 | DONE cmt | em 8 8 | | | ; HARDWARE DEFINITIONS
26:025 | DONE cmt | em 8 8 | | | ; These follow Andrew Jacobs' names, but lower case and with "hw_" prefixed.
26:026 | DONE cmt | em 8 8 | | | ; This is the only file where symbols with the hw_ prefix may be defined or used
26:027 | DONE wsp | em 8 8 | | |
26:028 | DONE cmt | em 8 8 | | | ; Baud rates are calculated by the formula { osc_freq/(16*baud_rate)-1 } which we
26:029 | DONE cmt | em 8 8 | | | ; can do on the fly at every assembly with the following parameters, or just calculate
26:030 | DONE cmt | em 8 8 | | | ; once and then define brg_value with:
26:031 | DONE cmt | em 8 8 | | | ;
26:032 | DONE cmt | em 8 8 | | | ; - For 9600 baud, use &23
26:033 | DONE cmt | em 8 8 | | | ; - For 19200 baud, use &11
26:034 | DONE wsp | em 8 8 | | |
26:035 | DONE cmt | em 8 8 | | | ; .equ osc_freq 3686400 ; SXB runs at 3.6864MHz
26:036 | DONE cmt | em 8 8 | | | ; .equ baud_rate 19200 ; ACIA baud rate
26:037 | DONE cmt | em 8 8 | | | ; .equ baud_rate 9600 ; ACIA baud rate
26:038 | DONE wsp | em 8 8 | | |
26:039 | DONE dir | em 8 8 | | | .equ brg_value &11 19200 baud
26:040 | DONE cmt | em 8 8 | | | ; .equ brg_value &23 ; 9600 baud
26:041 | DONE wsp | em 8 8 | | |
26:042 | DONE dir | em 8 8 | | | .equ hw_pd0 0df00 Port 0 Data Register
26:043 | DONE dir | em 8 8 | | | .equ hw_pd1 0df01 Port 1 Data Register
26:044 | DONE dir | em 8 8 | | | .equ hw_pd2 0df02 Port 2 Data Register
26:045 | DONE dir | em 8 8 | | | .equ hw_pd3 0df03 Port 3 Data Register
26:046 | DONE dir | em 8 8 | | | .equ hw_pdd0 0df04 Port 0 Data Direction Register
26:047 | DONE dir | em 8 8 | | | .equ hw_pdd1 0df05 Port 1 Data Direction Register
26:048 | DONE dir | em 8 8 | | | .equ hw_pdd2 0df06 Port 2 Data Direction Register
26:049 | DONE dir | em 8 8 | | | .equ hw_pdd3 0df07 Port 3 Data Direction Register
26:050 | DONE wsp | em 8 8 | | |
26:051 | DONE dir | em 8 8 | | | .equ hw_pd4 0df20 Port 4 Data Register
26:052 | DONE dir | em 8 8 | | | .equ hw_pd5 0df21 Port 5 Data Register
26:053 | DONE dir | em 8 8 | | | .equ hw_pd6 0df22 Port 6 Data Register
26:054 | DONE dir | em 8 8 | | | .equ hw_pd7 0df23 Port 7 Data Register
26:055 | DONE dir | em 8 8 | | | .equ hw_pdd4 0df24 Port 4 Data Direction Register
26:056 | DONE dir | em 8 8 | | | .equ hw_pdd5 0df25 Port 5 Data Direction Register
26:057 | DONE dir | em 8 8 | | | .equ hw_pdd6 0df26 Port 6 Data Direction Register
26:058 | DONE dir | em 8 8 | | | .equ hw_pcs7 0df27 Port 7 Chip Select
26:059 | DONE wsp | em 8 8 | | |
26:060 | DONE dir | em 8 8 | | | .equ hw_bcr 0df40 Bus Control Register
26:061 | DONE dir | em 8 8 | | | .equ hw_sscr 0df41 System Speed Control Register
26:062 | DONE dir | em 8 8 | | | .equ hw_tcr 0df42 Timer Control Register
26:063 | DONE dir | em 8 8 | | | .equ hw_ter 0df43 Timer Enable Register
26:064 | DONE dir | em 8 8 | | | .equ hw_tifr 0df44 Timer Interrupt Flag Register
26:065 | DONE dir | em 8 8 | | | .equ hw_eifr 0df45 Edge Interrupt Flag Register
26:066 | DONE dir | em 8 8 | | | .equ hw_tier 0df46 Timer Interrupt Enable Register
26:067 | DONE dir | em 8 8 | | | .equ hw_eier 0df47 Edge Interrupt Enable Register
26:068 | DONE dir | em 8 8 | | | .equ hw_uifr 0df48 UART Interrupt Flag Register
26:069 | DONE dir | em 8 8 | | | .equ hw_uier 0df49 UART Interrupt Enable Register
26:070 | DONE wsp | em 8 8 | | |
26:071 | DONE dir | em 8 8 | | | .equ hw_t0cl 0df60 Timer 0 Counter Low
26:072 | DONE dir | em 8 8 | | | .equ hw_t0ch 0df61 Timer 0 Counter High
26:073 | DONE dir | em 8 8 | | | .equ hw_t1cl 0df62 Timer 1 Counter Low
26:074 | DONE dir | em 8 8 | | | .equ hw_t1ch 0df63 Timer 1 Counter High
26:075 | DONE dir | em 8 8 | | | .equ hw_t2cl 0df64 Timer 2 Counter Low
26:076 | DONE dir | em 8 8 | | | .equ hw_t2ch 0df65 Timer 2 Counter High
26:077 | DONE dir | em 8 8 | | | .equ hw_t3cl 0df66 Timer 3 Counter Low
26:078 | DONE dir | em 8 8 | | | .equ hw_t3ch 0df67 Timer 3 Counter High
26:079 | DONE dir | em 8 8 | | | .equ hw_t4cl 0df68 Timer 4 Counter Low
26:080 | DONE dir | em 8 8 | | | .equ hw_t4ch 0df69 Timer 4 Counter High
26:081 | DONE dir | em 8 8 | | | .equ hw_t5cl 0df6a Timer 5 Counter Low
26:082 | DONE dir | em 8 8 | | | .equ hw_t5ch 0df6b Timer 5 Counter High
26:083 | DONE dir | em 8 8 | | | .equ hw_t6cl 0df6c Timer 6 Counter Low
26:084 | DONE dir | em 8 8 | | | .equ hw_t6ch 0df6d Timer 6 Counter High
26:085 | DONE dir | em 8 8 | | | .equ hw_t7cl 0df6e Timer 7 Counter Low
26:086 | DONE dir | em 8 8 | | | .equ hw_t7ch 0df6f Timer 7 Counter High
26:087 | DONE wsp | em 8 8 | | |
26:088 | DONE dir | em 8 8 | | | .equ hw_acsr0 0df70 UART 0 Control/Status Register
26:089 | DONE dir | em 8 8 | | | .equ hw_artd0 0df71 UART 0 Data Register
26:090 | DONE dir | em 8 8 | | | .equ hw_acsr1 0df72 UART 1 Control/Status Register
26:091 | DONE dir | em 8 8 | | | .equ hw_artd1 0df73 UART 1 Data Register
26:092 | DONE dir | em 8 8 | | | .equ hw_acsr2 0df74 UART 2 Control/Status Register
26:093 | DONE dir | em 8 8 | | | .equ hw_artd2 0df75 UART 2 Data Register
26:094 | DONE dir | em 8 8 | | | .equ hw_acsr3 0df76 UART 3 Control/Status Register
26:095 | DONE dir | em 8 8 | | | .equ hw_artd3 0df77 UART 3 Data Register
26:096 | DONE wsp | em 8 8 | | |
26:097 | DONE wsp | em 8 8 | | |
26:098 | DONE cmt | em 8 8 | | | ; ===================================================================
26:099 | DONE cmt | em 8 8 | | | ; RESET HARDWARE
26:100 | DONE cmt | em 8 8 | | | ; Call this during boot. Uses Port 0 for communication in the default setting.
26:101 | DONE cmt | em 8 8 | | | ; Note this does not reset the MPU, which is done by the main Forth code
26:102 | DONE lbl | em 8 8 | 005000 | | reset_hardware
26:103 | DONE ins | em 8 8 | 005000 | 78 | sei
26:104 | DONE ins | em 8 8 | 005001 | 18 | clc
26:105 | DONE ins | em 8 8 | 005002 | fb | xce
26:106 | DONE ctl | na 8 8 | | | .!native
26:107 | DONE ins | na 8 8 | 005003 | c2 10 | rep 10
26:108 | DONE ctl | na 8 16 | | | .!xy16
26:109 | DONE ins | na 8 16 | 005005 | e2 20 | sep 20
26:110 | DONE ctl | na 8 16 | | | .!a8
26:111 | DONE cmt | na 8 16 | | | ; temporarily reset the stack
26:112 | DONE ins | na 8 16 | 005007 | a2 ff 01 | ldx.# 01ff
26:113 | DONE ins | na 8 16 | 00500a | 9a | txs
26:114 | DONE wsp | na 8 16 | | |
26:115 | DONE ins | na 8 16 | 00500b | 9c 49 df | stz 00df49 UART Interrupt Enable Register (UIER)
26:116 | DONE wsp | na 8 16 | | |
26:117 | DONE ins | na 8 16 | 00500e | a9 c0 | lda.# 0c0 Ensure A15/AMS are output
26:118 | DONE ins | na 8 16 | 005010 | 8d 24 df | sta 00df24 Port 4 Data Direction Register (PDD4)
26:119 | DONE ins | na 8 16 | 005013 | 9c 20 df | stz 00df20 Select bank 0 (Port 4 Data Register, PD4)
26:120 | DONE wsp | na 8 16 | | |
26:121 | DONE ins | na 8 16 | 005016 | a9 10 | lda.# %00010000 Set UART0 to use timer 3
26:122 | DONE ins | na 8 16 | 005018 | 1c 42 df | trb 00df42 Timer Control Register (TCR)
26:123 | DONE ins | na 8 16 | 00501b | a9 0b | lda.# .lsb 00000b And set baud rate
26:124 | DONE ins | na 8 16 | 00501d | 8d 66 df | sta 00df66 Timer 3 Counter Low (T3CL)
26:125 | DONE ins | na 8 16 | 005020 | a9 00 | lda.# .msb 00000b
26:126 | DONE ins | na 8 16 | 005022 | 8d 67 df | sta 00df67 Timer 3 Counter High (T3CH)
26:127 | DONE ins | na 8 16 | 005025 | a9 08 | lda.# 08 Enable timer 3 (1<<3)
26:128 | DONE ins | na 8 16 | 005027 | 0c 43 df | tsb 00df43 Timer Enable Register (TER)
26:129 | DONE wsp | na 8 16 | | |
26:130 | DONE ins | na 8 16 | 00502a | a9 25 | lda.# %00100101 Set UART0 for 8-N-1
26:131 | DONE ins | na 8 16 | 00502c | 8d 70 df | sta 00df70 UART 0 Control/Status Register (ACSR0)
26:132 | DONE wsp | na 8 16 | | |
26:133 | DONE ins | na 8 16 | 00502f | c2 20 | rep 20
26:134 | DONE ctl | na 16 16 | | | .!a16
26:135 | DONE ins | na 16 16 | 005031 | 4c 64 50 | jmp 005064 we return with A as 8 bits
26:136 | DONE wsp | na 16 16 | | |
26:137 | DONE wsp | na 16 16 | | |
26:138 | DONE cmt | na 16 16 | | | ; ===================================================================
26:139 | DONE cmt | na 16 16 | | | ; PUT_CHR
26:140 | DONE cmt | na 16 16 | | | ; Wait until the last transmission has been completed then send the character
26:141 | DONE cmt | na 16 16 | | | ; in A. Destroys A. This handles all the register size stuff, and does not need to be
26:142 | DONE cmt | na 16 16 | | | ; called with a 8-bit Y register as TOS. This is only called directly by EMIT
26:143 | DONE cmt | na 16 16 | | | ; through the OUTPUT variable. In Forth, this is refered to as UART0
26:144 | DONE lbl | na 16 16 | 005034 | | put_chr
26:145 | DONE ins | na 16 16 | 005034 | e2 20 | sep 20
26:146 | DONE ctl | na 8 16 | | | .!a8
26:147 | DONE ins | na 8 16 | 005036 | 48 | pha
26:148 | DONE ins | na 8 16 | 005037 | a9 02 | lda.# 02 (1<<1)
26:149 | DONE wsp | na 8 16 | | |
26:150 | DONE lbl | na 8 16 | 005039 | | put_chr_wait
26:151 | DONE ins | na 8 16 | 005039 | 2c 48 df | bit 00df48 timer finished?
26:152 | DONE ins | na 8 16 | 00503c | f0 fb | beq 005039
26:153 | DONE wsp | na 8 16 | | |
26:154 | DONE ins | na 8 16 | 00503e | 68 | pla
26:155 | DONE ins | na 8 16 | 00503f | 8d 71 df | sta 00df71 transmit char
26:156 | DONE ins | na 8 16 | 005042 | c2 20 | rep 20
26:157 | DONE ctl | na 16 16 | | | .!a16
26:158 | DONE wsp | na 16 16 | | |
26:159 | DONE ins | na 16 16 | 005044 | 60 | rts
26:160 | DONE wsp | na 16 16 | | |
26:161 | DONE cmt | na 16 16 | | | ; ===================================================================
26:162 | DONE cmt | na 16 16 | | | ; GET_CHR
26:163 | DONE cmt | na 16 16 | | | ; Fetch the next character from the receive buffer waiting for some to arrive
26:164 | DONE cmt | na 16 16 | | | ; if the buffer is empty. This is handled by KEY through the INPUT variable
26:165 | DONE cmt | na 16 16 | | | ; Note the routine returns its value through A - getting it TOS is the caller's
26:166 | DONE cmt | na 16 16 | | | ; problem
26:167 | DONE lbl | na 16 16 | 005045 | | get_chr
26:168 | DONE ins | na 16 16 | 005045 | e2 20 | sep 20
26:169 | DONE ctl | na 8 16 | | | .!a8
26:170 | DONE ins | na 8 16 | 005047 | a9 01 | lda.# 01 (1<<0)
26:171 | DONE wsp | na 8 16 | | |
26:172 | DONE lbl | na 8 16 | 005049 | | get_chr_wait
26:173 | DONE ins | na 8 16 | 005049 | 2c 48 df | bit 00df48 Any data in RX buffer?
26:174 | DONE ins | na 8 16 | 00504c | f0 fb | beq 005049 No, keep waiting
26:175 | DONE ins | na 8 16 | 00504e | ad 71 df | lda 00df71 Yes, read it
26:176 | DONE ins | na 8 16 | 005051 | c2 20 | rep 20
26:177 | DONE ctl | na 16 16 | | | .!a16
26:178 | DONE ins | na 16 16 | 005053 | 29 ff 00 | and.# 00ff paranoid
26:179 | DONE wsp | na 16 16 | | |
26:180 | DONE ins | na 16 16 | 005056 | 60 | rts
26:181 | DONE wsp | na 16 16 | | |
26:182 | DONE cmt | na 16 16 | | | ; ===================================================================
26:183 | DONE cmt | na 16 16 | | | ; HAVE_CHR
26:184 | DONE cmt | na 16 16 | | | ; Check if the receive buffer contains any data and return C=1 if there is
26:185 | DONE cmt | na 16 16 | | | ; some. This should be handled by KEY? through the HAVEKEY variable
26:186 | DONE lbl | na 16 16 | 005057 | | have_chr
26:187 | DONE ins | na 16 16 | 005057 | 18 | clc
26:188 | DONE ins | na 16 16 | 005058 | e2 20 | sep 20
26:189 | DONE ctl | na 8 16 | | | .!a8
26:190 | DONE ins | na 8 16 | 00505a | ad 48 df | lda 00df48 read the status register
26:191 | DONE ins | na 8 16 | 00505d | 6a | ror.a shift hw_uart0r bit into carry
26:192 | DONE ins | na 8 16 | 00505e | c2 20 | rep 20
26:193 | DONE ctl | na 16 16 | | | .!a16
26:194 | DONE wsp | na 16 16 | | |
26:195 | DONE ins | na 16 16 | 005060 | 60 | rts
26:196 | DONE wsp | na 16 16 | | |
26:197 | DONE cmt | na 16 16 | | | ; END
27:000 | DONE cmt | na 16 16 | | | ; .include kernel_emu.tasm ; routines for crude65815 emulator
28:000 | DONE wsp | na 16 16 | | |
29:000 | DONE wsp | na 16 16 | | |
30:000 | DONE cmt | na 16 16 | | | ; ===================================================================
31:000 | DONE cmt | na 16 16 | | | ; DICTIONARY ROUTINES
32:000 | DONE wsp | na 16 16 | | |
33:000 | DONE cmt | na 16 16 | | | ; Word code routines are sorted alphabetically, except for the first three
34:000 | DONE cmt | na 16 16 | | | ; - COLD, ABORT, and QUIT - and a few others that flow into each other. The
35:000 | DONE cmt | na 16 16 | | | ; byte and cycle values are calculated without the RTS instruction.
36:000 | DONE wsp | na 16 16 | | |
37:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
38:000 | DONE cmt | na 16 16 | | | ; COLD ( -- ) X bytes / X Cycles
39:000 | DONE cmt | na 16 16 | | | ; Reset the Forth system. Use BYE to return to the Mensch Monitor.
40:000 | DONE lbl | na 16 16 | 005061 | | xt_cold
41:000 | DONE wsp | na 16 16 | | |
42:000 | DONE ins | na 16 16 | 005061 | 4c 00 50 | jmp 005000 don't use JSR, jump back to start
43:000 | DONE lbl | na 16 16 | 005064 | | start
44:000 | DONE dir | na 16 16 | | | .!native these should have been handled by hardware reset
45:000 | DONE dir | na 16 16 | | | .!a16
46:000 | DONE dir | na 16 16 | | | .!xy16
47:000 | DONE ins | na 16 16 | 005064 | 78 | sei
48:000 | DONE wsp | na 16 16 | | |
49:000 | DONE cmt | na 16 16 | | | ; Initialize the Return Stack (65816 stack)
50:000 | DONE ins | na 16 16 | 005065 | a2 ff 01 | ldx.# 0001ff 01ff
51:000 | DONE ins | na 16 16 | 005068 | 9a | txs
52:000 | DONE wsp | na 16 16 | | |
53:000 | DONE cmt | na 16 16 | | | ; Clear Data Stack. This is repeated in ABORT, but we have no
54:000 | DONE cmt | na 16 16 | | | ; choice if we want to load high-level words via EVALUATE
55:000 | DONE ins | na 16 16 | 005069 | a0 00 00 | ldy.# 0000
56:000 | DONE ins | na 16 16 | 00506c | a2 ff 00 | ldx.# 0000ff
57:000 | DONE wsp | na 16 16 | | |
58:000 | DONE cmt | na 16 16 | | | ; We start out in decimal mode
59:000 | DONE ins | na 16 16 | 00506f | a9 0a 00 | lda.# 000a
60:000 | DONE ins | na 16 16 | 005072 | 85 16 | sta.d 000016
61:000 | DONE wsp | na 16 16 | | |
62:000 | DONE cmt | na 16 16 | | | ; We start out with smaller words with less than 20 bytes being
63:000 | DONE cmt | na 16 16 | | | ; natively compiled, because this includes words like LSHIFT and MAX.
64:000 | DONE ins | na 16 16 | 005074 | a9 14 00 | lda.# &0020
65:000 | DONE ins | na 16 16 | 005077 | 85 26 | sta.d 000026
66:000 | DONE wsp | na 16 16 | | |
67:000 | DONE cmt | na 16 16 | | | ; set the OUTPUT vector to the default, which is always put_chr,
68:000 | DONE cmt | na 16 16 | | | ; but may have synonyms
69:000 | DONE ins | na 16 16 | 005079 | a9 34 50 | lda.# 005034
70:000 | DONE ins | na 16 16 | 00507c | 85 0e | sta.d 00000e
71:000 | DONE wsp | na 16 16 | | |
72:000 | DONE cmt | na 16 16 | | | ; set the INPUT vector to the default, which is always get_chr,
73:000 | DONE cmt | na 16 16 | | | ; but may have synonyms
74:000 | DONE ins | na 16 16 | 00507e | a9 45 50 | lda.# 005045
75:000 | DONE ins | na 16 16 | 005081 | 85 10 | sta.d 000010
76:000 | DONE wsp | na 16 16 | | |
77:000 | DONE cmt | na 16 16 | | | ; set the HAVE_KEY vector to the default, which is always
78:000 | DONE cmt | na 16 16 | | | ; have_chr, but may have synonyms
79:000 | DONE ins | na 16 16 | 005083 | a9 57 50 | lda.# 005057
80:000 | DONE ins | na 16 16 | 005086 | 85 12 | sta.d 000012
81:000 | DONE wsp | na 16 16 | | |
82:000 | DONE cmt | na 16 16 | | | ; The compiler pointer (CP) points to the first free byte
83:000 | DONE cmt | na 16 16 | | | ; in the Dictionary
84:000 | DONE ins | na 16 16 | 005088 | a9 00 03 | lda.# 000300
85:000 | DONE ins | na 16 16 | 00508b | 85 00 | sta.d 000000
86:000 | DONE wsp | na 16 16 | | |
87:000 | DONE ins | na 16 16 | 00508d | a9 00 02 | lda.# 000200
88:000 | DONE ins | na 16 16 | 005090 | 85 08 | sta.d 000008 input buffer
89:000 | DONE ins | na 16 16 | 005092 | 64 0a | stz.d 00000a input buffer starts empty
90:000 | DONE ins | na 16 16 | 005094 | 64 06 | stz.d 000006 SOURCE-ID is zero
91:000 | DONE ins | na 16 16 | 005096 | 64 14 | stz.d 000014 STATE is zero (interpret mode)
92:000 | DONE wsp | na 16 16 | | |
93:000 | DONE cmt | na 16 16 | | | ; The name token (nt) of DROP is always the first one in the
94:000 | DONE cmt | na 16 16 | | | ; new Dictionary, so we start off the Dictionary Pointer (DP)
95:000 | DONE cmt | na 16 16 | | | ; there. Anything that comes after that (with WORDS, before
96:000 | DONE cmt | na 16 16 | | | ; that) is high-level
97:000 | DONE ins | na 16 16 | 005098 | a9 ae 69 | lda.# 0069ae
98:000 | DONE ins | na 16 16 | 00509b | 85 02 | sta.d 000002
99:000 | DONE wsp | na 16 16 | | |
100:000 | DONE cmt | na 16 16 | | | ; Clear the screen, assumes vt100 terminal
101:000 | DONE ins | na 16 16 | 00509d | 20 66 5c | jsr 005c66
102:000 | DONE wsp | na 16 16 | | |
103:000 | DONE cmt | na 16 16 | | | ; Define high-level words via EVALUATE. At this point, whatever
104:000 | DONE cmt | na 16 16 | | | ; is in Y (TOS) is garbage, so we don't have to push it to the
105:000 | DONE cmt | na 16 16 | | | ; stack first
106:000 | DONE ins | na 16 16 | 0050a0 | ca | dex
107:000 | DONE ins | na 16 16 | 0050a1 | ca | dex
108:000 | DONE ins | na 16 16 | 0050a2 | ca | dex
109:000 | DONE ins | na 16 16 | 0050a3 | ca | dex
110:000 | DONE ins | na 16 16 | 0050a4 | a9 c3 6a | lda.# 006ac3
111:000 | DONE ins | na 16 16 | 0050a7 | 95 00 | sta.dx 00 Start address goes in NOS
112:000 | DONE ins | na 16 16 | 0050a9 | a0 ed 06 | ldy.# 0006ed length goes in TOS
113:000 | DONE wsp | na 16 16 | | |
114:000 | DONE ins | na 16 16 | 0050ac | 20 17 59 | jsr 005917
115:000 | DONE wsp | na 16 16 | | |
116:000 | DONE cmt | na 16 16 | | | ; fall through to ABORT
117:000 | DONE wsp | na 16 16 | | |
118:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
119:000 | DONE cmt | na 16 16 | | | ; ABORT ( -- ) 8+ bytes / X cycles
120:000 | DONE cmt | na 16 16 | | | ; Reset the parameter (data) stack pointer and continue as QUIT
121:000 | DONE cmt | na 16 16 | | | ; We can jump here via subroutine because we reset the stack pointer
122:000 | DONE cmt | na 16 16 | | | ; anyway. Flows into QUIT.
123:000 | DONE lbl | na 16 16 | 0050af | | xt_abort
124:000 | DONE ins | na 16 16 | 0050af | c2 20 | rep 20
124:001 | DONE ctl | na 16 16 | | | .!a16
125:000 | DONE cmt | na 16 16 | | | ; clear Data Stack
126:000 | DONE ins | na 16 16 | 0050b1 | a0 00 00 | ldy.# 0000
127:000 | DONE ins | na 16 16 | 0050b4 | a2 ff 00 | ldx.# 0000ff
128:000 | DONE wsp | na 16 16 | | |
129:000 | DONE wsp | na 16 16 | | |
130:000 | DONE cmt | na 16 16 | | | ; drops through to QUIT, z_abort is the same as z_quit.
131:000 | DONE wsp | na 16 16 | | |
132:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
133:000 | DONE cmt | na 16 16 | | | ; QUIT ( -- ) X bytes / X cycles
134:000 | DONE cmt | na 16 16 | | | ; Reset the input, clearning Return Stack. Jumps to QUIT do not have to be
135:000 | DONE cmt | na 16 16 | | | ; subroutine jumps as the Return Stack is cleared anyway. Liara Forth follows
136:000 | DONE cmt | na 16 16 | | | ; the ANSI Forth recommendation to use REFILL. Note we don't display the "ok"
137:000 | DONE cmt | na 16 16 | | | ; system prompt until after the first output, this follows Gforth.
138:000 | DONE lbl | na 16 16 | 0050b7 | | xt_quit
139:000 | DONE cmt | na 16 16 | | | ; clear Return Stack
140:000 | DONE ins | na 16 16 | 0050b7 | a9 ff 01 | lda.# 0001ff
141:000 | DONE ins | na 16 16 | 0050ba | 1b | tcs
142:000 | DONE wsp | na 16 16 | | |
143:000 | DONE cmt | na 16 16 | | | ; make sure Instruction Pointer is empty
144:000 | DONE cmt | na 16 16 | | | ; TODO move this someplace else or else it will end up in ROM
145:000 | DONE ins | na 16 16 | 0050bb | 9c 46 59 | stz 005946
146:000 | DONE wsp | na 16 16 | | |
147:000 | DONE cmt | na 16 16 | | | ; switch SOURCE-ID to zero (keyboard input)
148:000 | DONE ins | na 16 16 | 0050be | 64 06 | stz.d 000006
149:000 | DONE wsp | na 16 16 | | |
150:000 | DONE cmt | na 16 16 | | | ; switch to interpret state (STATE is zero)
151:000 | DONE ins | na 16 16 | 0050c0 | 64 14 | stz.d 000014
152:000 | DONE wsp | na 16 16 | | |
153:000 | DONE lbl | na 16 16 | 0050c2 | | quit_get_line
154:000 | DONE cmt | na 16 16 | | | ; Empty current input buffer
155:000 | DONE ins | na 16 16 | 0050c2 | 64 0a | stz.d 00000a
156:000 | DONE wsp | na 16 16 | | |
157:000 | DONE cmt | na 16 16 | | | ; Accept a line from the current input source
158:000 | DONE ins | na 16 16 | 0050c4 | 20 57 5d | jsr 005d57 ( -- f )
159:000 | DONE wsp | na 16 16 | | |
160:000 | DONE ins | na 16 16 | 0050c7 | 98 | tya force flag test
161:000 | DONE ins | na 16 16 | 0050c8 | d0 06 | bne 0050d0
162:000 | DONE wsp | na 16 16 | | |
163:000 | DONE cmt | na 16 16 | | | ; If REFILL returned a FALSE flag, something went wrong and we
164:000 | DONE cmt | na 16 16 | | | ; need to print an error message and reset the machine. We don't
165:000 | DONE cmt | na 16 16 | | | ; need to save TOS because we're going to clobber it anyway when we
166:000 | DONE cmt | na 16 16 | | | ; go back to ABORT.
167:000 | DONE ins | na 16 16 | 0050ca | a9 6a 72 | lda.# 00726a
168:000 | DONE ins | na 16 16 | 0050cd | 4c 70 6a | jmp 006a70
169:000 | DONE wsp | na 16 16 | | |
170:000 | DONE wsp | na 16 16 | | |
171:000 | DONE lbl | na 16 16 | 0050d0 | | quit_refill_successful
172:000 | DONE cmt | na 16 16 | | | ; Assume we have successfully accepted a string of input from
173:000 | DONE cmt | na 16 16 | | | ; a source, with address cib and length of input in ciblen. We
174:000 | DONE cmt | na 16 16 | | | ; arrive here still with the TRUE flag from REFILL as TOS (in Y)
175:000 | DONE ins | na 16 16 | 0050d0 | b4 00 | ldy.dx 00 drop TOS
176:000 | DONE ins | na 16 16 | 0050d2 | e8 | inx
177:000 | DONE ins | na 16 16 | 0050d3 | e8 | inx
178:000 | DONE wsp | na 16 16 | | |
179:000 | DONE cmt | na 16 16 | | | ; make >IN point to begining of buffer
180:000 | DONE ins | na 16 16 | 0050d4 | 64 0c | stz.d 00000c
181:000 | DONE wsp | na 16 16 | | |
182:000 | DONE cmt | na 16 16 | | | ; Main compile/execute routine
183:000 | DONE ins | na 16 16 | 0050d6 | 20 eb 69 | jsr 0069eb
184:000 | DONE wsp | na 16 16 | | |
185:000 | DONE cmt | na 16 16 | | | ; Test for Data Stack underflow. Our stack is so large in single
186:000 | DONE cmt | na 16 16 | | | ; user mode that we don't bother checking for overflow
187:000 | DONE ins | na 16 16 | 0050d9 | e0 00 01 | cpx.# 000100
188:000 | DONE ins | na 16 16 | 0050dc | 90 06 | bcc 0050e4 DSP must always be smaller (!) than DSP0
189:000 | DONE wsp | na 16 16 | | |
190:000 | DONE ins | na 16 16 | 0050de | a9 d0 72 | lda.# 0072d0
191:000 | DONE ins | na 16 16 | 0050e1 | 4c 70 6a | jmp 006a70
192:000 | DONE wsp | na 16 16 | | |
193:000 | DONE lbl | na 16 16 | 0050e4 | | quit_ok
194:000 | DONE cmt | na 16 16 | | | ; Display system prompt if all went well. If we're interpreting,
195:000 | DONE cmt | na 16 16 | | | ; this is " ok", if we're compiling, it's " compiled"
196:000 | DONE ins | na 16 16 | 0050e4 | a5 14 | lda.d 000014
197:000 | DONE ins | na 16 16 | 0050e6 | d0 05 | bne 0050ed
198:000 | DONE wsp | na 16 16 | | |
199:000 | DONE ins | na 16 16 | 0050e8 | a9 b0 71 | lda.# 0071b0
200:000 | DONE ins | na 16 16 | 0050eb | 80 03 | bra 0050f0
201:000 | DONE lbl | na 16 16 | 0050ed | | quit_compiled
202:000 | DONE ins | na 16 16 | 0050ed | a9 b4 71 | lda.# 0071b4 fall through to quit_print
203:000 | DONE lbl | na 16 16 | 0050f0 | | quit_print
204:000 | DONE ins | na 16 16 | 0050f0 | 20 76 6a | jsr 006a76
205:000 | DONE wsp | na 16 16 | | |
206:000 | DONE cmt | na 16 16 | | | ; Awesome line, everybody! Now get the next one
207:000 | DONE ins | na 16 16 | 0050f3 | 4c c2 50 | jmp 0050c2
208:000 | DONE wsp | na 16 16 | | |
209:000 | DONE lbl | na 16 16 | 0050f6 | | z_cold
210:000 | DONE lbl | na 16 16 | 0050f6 | | z_abort
211:000 | DONE lbl | na 16 16 | 0050f6 | | z_quit ; empty, no RTS required
212:000 | DONE wsp | na 16 16 | | |
213:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
214:000 | DONE cmt | na 16 16 | | | ; < "LESS" ( n m -- f ) X bytes / X cycles
215:000 | DONE cmt | na 16 16 | | | ; Return true flag if NOS < TOS. See
216:000 | DONE cmt | na 16 16 | | | ; http://www.6502.org/tutorials/compare_beyond.html for details on the
217:000 | DONE cmt | na 16 16 | | | ; comparisons
218:000 | DONE lbl | na 16 16 | 0050f6 | | xt_less
219:000 | DONE ins | na 16 16 | 0050f6 | 98 | tya
220:000 | DONE ins | na 16 16 | 0050f7 | a0 00 00 | ldy.# 0000 default is false
221:000 | DONE wsp | na 16 16 | | |
222:000 | DONE ins | na 16 16 | 0050fa | 38 | sec
223:000 | DONE ins | na 16 16 | 0050fb | f5 00 | sbc.dx 00
224:000 | DONE ins | na 16 16 | 0050fd | f0 08 | beq 005107 the same is not greater
225:000 | DONE ins | na 16 16 | 0050ff | 50 03 | bvc 005104 no overflow, skip ahead
226:000 | DONE wsp | na 16 16 | | |
227:000 | DONE cmt | na 16 16 | | | ; Deal with oveflow because we use signed numbers
228:000 | DONE ins | na 16 16 | 005101 | 49 00 80 | eor.# 8000 compliment negative flag
229:000 | DONE wsp | na 16 16 | | |
230:000 | DONE lbl | na 16 16 | 005104 | | less_no_ov
231:000 | DONE cmt | na 16 16 | | | ; if we're negative TOS > NOS
232:000 | DONE ins | na 16 16 | 005104 | 30 01 | bmi 005107
233:000 | DONE ins | na 16 16 | 005106 | 88 | dey
234:000 | DONE lbl | na 16 16 | 005107 | | less_nip
235:000 | DONE ins | na 16 16 | 005107 | e8 | inx
236:000 | DONE ins | na 16 16 | 005108 | e8 | inx
237:000 | DONE wsp | na 16 16 | | |
238:000 | DONE lbl | na 16 16 | 005109 | | z_less
238:001 | DONE ins | na 16 16 | 005109 | 60 | rts
239:000 | DONE wsp | na 16 16 | | |
240:000 | DONE wsp | na 16 16 | | |
241:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
242:000 | DONE cmt | na 16 16 | | | ; <> "NOT-EQUAL" ( n m -- f ) X bytes / X cycles
243:000 | DONE cmt | na 16 16 | | | ; Return true flag if TOS and NOS are not the same. This is just a different
244:000 | DONE cmt | na 16 16 | | | ; version of EQUAL, we repeat the code for speed reasons
245:000 | DONE lbl | na 16 16 | 00510a | | xt_not-equal
246:000 | DONE ins | na 16 16 | 00510a | 98 | tya
247:000 | DONE ins | na 16 16 | 00510b | a0 00 00 | ldy.# 0000 default value is false
248:000 | DONE wsp | na 16 16 | | |
249:000 | DONE ins | na 16 16 | 00510e | d5 00 | cmp.dx 00
250:000 | DONE ins | na 16 16 | 005110 | f0 01 | beq 005113
251:000 | DONE ins | na 16 16 | 005112 | 88 | dey wraps to 0FFFF (true)
252:000 | DONE wsp | na 16 16 | | |
253:000 | DONE lbl | na 16 16 | 005113 | | not-equal_equal ; yes, this is a silly name
254:000 | DONE ins | na 16 16 | 005113 | e8 | inx
255:000 | DONE ins | na 16 16 | 005114 | e8 | inx
256:000 | DONE wsp | na 16 16 | | |
257:000 | DONE lbl | na 16 16 | 005115 | | z_not-equal
257:001 | DONE ins | na 16 16 | 005115 | 60 | rts
258:000 | DONE wsp | na 16 16 | | |
259:000 | DONE wsp | na 16 16 | | |
260:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
261:000 | DONE cmt | na 16 16 | | | ; <# "LESSNUMBER" ( -- ) 8 bytes / X cycles
262:000 | DONE cmt | na 16 16 | | | ; Start the process to create pictured numeric output. The new string is
263:000 | DONE cmt | na 16 16 | | | ; constructed from back to front, saving the new character at the beginning of
264:000 | DONE cmt | na 16 16 | | | ; the output string. Since we use PAD as a starting address and work backward
265:000 | DONE cmt | na 16 16 | | | ; (!), the string is constructed in the space between the end of the dictionary
266:000 | DONE cmt | na 16 16 | | | ; (as defined by CP) and the PAD. This allows us to satisfy the ANS Forth
267:000 | DONE cmt | na 16 16 | | | ; condition that programs don't fool around with the PAD but still use its
268:000 | DONE cmt | na 16 16 | | | ; address. Code based on pForth, see
269:000 | DONE cmt | na 16 16 | | | ; http://pforth.googlecode.com/svn/trunk/fth/numberio.fth pForth is in the pubic
270:000 | DONE cmt | na 16 16 | | | ; domain. Forth is : <# PAD HLD ! ; we use the internal variable tohold instead
271:000 | DONE cmt | na 16 16 | | | ; of HLD.
272:000 | DONE lbl | na 16 16 | 005116 | | xt_lessnumber
273:000 | DONE ins | na 16 16 | 005116 | 20 5a 5c | jsr 005c5a
274:000 | DONE ins | na 16 16 | 005119 | 84 18 | sty.d 000018
275:000 | DONE wsp | na 16 16 | | |
276:000 | DONE ins | na 16 16 | 00511b | b4 00 | ldy.dx 00
277:000 | DONE ins | na 16 16 | 00511d | e8 | inx
278:000 | DONE ins | na 16 16 | 00511e | e8 | inx
279:000 | DONE wsp | na 16 16 | | |
280:000 | DONE lbl | na 16 16 | 00511f | | z_lessnumber
280:001 | DONE ins | na 16 16 | 00511f | 60 | rts
281:000 | DONE wsp | na 16 16 | | |
282:000 | DONE wsp | na 16 16 | | |
283:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
284:000 | DONE cmt | na 16 16 | | | ; > "GREATER" ( n m -- f ) X bytes / X cycles
285:000 | DONE cmt | na 16 16 | | | ; Return true flag if NOS > TOS. See
286:000 | DONE cmt | na 16 16 | | | ; http://www.6502.org/tutorials/compare_beyond.html for details on the
287:000 | DONE cmt | na 16 16 | | | ; comparisons
288:000 | DONE lbl | na 16 16 | 005120 | | xt_greater
289:000 | DONE ins | na 16 16 | 005120 | 98 | tya
290:000 | DONE ins | na 16 16 | 005121 | a0 00 00 | ldy.# 0000 default is false
291:000 | DONE wsp | na 16 16 | | |
292:000 | DONE ins | na 16 16 | 005124 | 38 | sec
293:000 | DONE ins | na 16 16 | 005125 | f5 00 | sbc.dx 00
294:000 | DONE ins | na 16 16 | 005127 | f0 08 | beq 005131 the same is not greater
295:000 | DONE ins | na 16 16 | 005129 | 50 03 | bvc 00512e no overflow, skip ahead
296:000 | DONE wsp | na 16 16 | | |
297:000 | DONE cmt | na 16 16 | | | ; Deal with oveflow because we use signed numbers
298:000 | DONE ins | na 16 16 | 00512b | 49 00 80 | eor.# 8000 compliment negative flag
299:000 | DONE wsp | na 16 16 | | |
300:000 | DONE lbl | na 16 16 | 00512e | | greater_no_ov
301:000 | DONE cmt | na 16 16 | | | ; if we're still positiv, TOS < NOS
302:000 | DONE ins | na 16 16 | 00512e | 10 01 | bpl 005131
303:000 | DONE ins | na 16 16 | 005130 | 88 | dey
304:000 | DONE lbl | na 16 16 | 005131 | | greater_nip
305:000 | DONE ins | na 16 16 | 005131 | e8 | inx
306:000 | DONE ins | na 16 16 | 005132 | e8 | inx
307:000 | DONE wsp | na 16 16 | | |
308:000 | DONE lbl | na 16 16 | 005133 | | z_greater
308:001 | DONE ins | na 16 16 | 005133 | 60 | rts
309:000 | DONE wsp | na 16 16 | | |
310:000 | DONE wsp | na 16 16 | | |
311:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
312:000 | DONE cmt | na 16 16 | | | ; >BODY "TOBODY" ( xt -- addr ) 3 bytes / 6 cycles
313:000 | DONE cmt | na 16 16 | | | ; Given a word's execution token (xt), return the address of the start of that
314:000 | DONE cmt | na 16 16 | | | ; word's parameter field (PFA). This is the address that HERE would return right
315:000 | DONE cmt | na 16 16 | | | ; after CREATE. This is a difficult word for STC Forths, because most words
316:000 | DONE cmt | na 16 16 | | | ; don't have a Code Field Area (CFA) to skip. We solve this by testing if the
317:000 | DONE cmt | na 16 16 | | | ; first three bytes of the body (that starts at xt) are subroutine jumps to
318:000 | DONE cmt | na 16 16 | | | ; DOVAR, DOCONST or DODOES
319:000 | DONE lbl | na 16 16 | 005134 | | xt_tobody
320:000 | DONE cmt | na 16 16 | | | ; In the header, xt already points to the CFA, which CREATE by
321:000 | DONE cmt | na 16 16 | | | ; default fills with a JSR to DOVAR
322:000 | DONE ins | na 16 16 | 005134 | e2 20 | sep 20
322:001 | DONE ctl | na 8 16 | | | .!a8
323:000 | DONE ins | na 8 16 | 005136 | b9 00 00 | lda.y 0000 see if we have a JSR instruction
324:000 | DONE ins | na 8 16 | 005139 | c9 20 | cmp.# 20
325:000 | DONE ins | na 8 16 | 00513b | c2 20 | rep 20
325:001 | DONE ctl | na 16 16 | | | .!a16
326:000 | DONE ins | na 16 16 | 00513d | d0 18 | bne 005157
327:000 | DONE wsp | na 16 16 | | |
328:000 | DONE cmt | na 16 16 | | | ; Okay, so we found a JSR instruction. But is it one of the
329:000 | DONE cmt | na 16 16 | | | ; right ones?
330:000 | DONE ins | na 16 16 | 00513f | c8 | iny
331:000 | DONE ins | na 16 16 | 005140 | b9 00 00 | lda.y 0000
332:000 | DONE wsp | na 16 16 | | |
333:000 | DONE ins | na 16 16 | 005143 | c9 e4 69 | cmp.# 0069e4
334:000 | DONE ins | na 16 16 | 005146 | f0 0d | beq 005155
335:000 | DONE ins | na 16 16 | 005148 | c9 ba 69 | cmp.# 0069ba
336:000 | DONE ins | na 16 16 | 00514b | f0 08 | beq 005155
337:000 | DONE ins | na 16 16 | 00514d | c9 d7 69 | cmp.# 0069d7
338:000 | DONE ins | na 16 16 | 005150 | f0 03 | beq 005155
339:000 | DONE wsp | na 16 16 | | |
340:000 | DONE cmt | na 16 16 | | | ; This is some other jump, so we go back to beginning of word
341:000 | DONE ins | na 16 16 | 005152 | 88 | dey restor original xt
342:000 | DONE ins | na 16 16 | 005153 | 80 02 | bra 005157
343:000 | DONE wsp | na 16 16 | | |
344:000 | DONE lbl | na 16 16 | 005155 | | tobody_have_cfa
345:000 | DONE cmt | na 16 16 | | | ; Got the right kind of jump. We've already increased the index
346:000 | DONE cmt | na 16 16 | | | ; by one, so we just have to add two
347:000 | DONE ins | na 16 16 | 005155 | c8 | iny
348:000 | DONE ins | na 16 16 | 005156 | c8 | iny drops through to end
349:000 | DONE wsp | na 16 16 | | |
350:000 | DONE lbl | na 16 16 | 005157 | | tobody_nojsr
351:000 | DONE cmt | na 16 16 | | | ; If we don't have a jump instruction, the xt already points to
352:000 | DONE cmt | na 16 16 | | | ; the PFA, because there is no CFA
353:000 | DONE cmt | na 16 16 | | | ; body
354:000 | DONE wsp | na 16 16 | | |
355:000 | DONE lbl | na 16 16 | 005157 | | z_tobody
355:001 | DONE ins | na 16 16 | 005157 | 60 | rts
356:000 | DONE wsp | na 16 16 | | |
357:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
358:000 | DONE cmt | na 16 16 | | | ; >IN "TOIN" ( -- addr ) 6 bytes / 12 cycles
359:000 | DONE cmt | na 16 16 | | | ; Return address where pointer to current char in input buffer lives (>IN)
360:000 | DONE lbl | na 16 16 | 005158 | | xt_to-in
361:000 | DONE ins | na 16 16 | 005158 | ca | dex
362:000 | DONE ins | na 16 16 | 005159 | ca | dex
363:000 | DONE ins | na 16 16 | 00515a | 94 00 | sty.dx 00
364:000 | DONE wsp | na 16 16 | | |
365:000 | DONE ins | na 16 16 | 00515c | a0 0c 00 | ldy.# 00000c >IN
366:000 | DONE lbl | na 16 16 | 00515f | | z_to-in
366:001 | DONE ins | na 16 16 | 00515f | 60 | rts
367:000 | DONE wsp | na 16 16 | | |
368:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
369:000 | DONE cmt | na 16 16 | | | ; >NUMBER ( ud addr u -- ud addr u ) X bytes / X cycles
370:000 | DONE cmt | na 16 16 | | | ; Convert a string to a double number. Logic here is based on the routine by
371:000 | DONE cmt | na 16 16 | | | ; Phil Burk of the same name in pForth; see
372:000 | DONE cmt | na 16 16 | | | ; https://github.com/philburk/pforth/blob/master/fth/numberio.fth the original
373:000 | DONE cmt | na 16 16 | | | ; Forth code. We arrive here from NUMBER which has made sure that we don't have
374:000 | DONE cmt | na 16 16 | | | ; to deal with a sign and we don't have to deal with a dot as a last character
375:000 | DONE cmt | na 16 16 | | | ; that signalizes double - this should be a pure number string.
376:000 | DONE cmt | na 16 16 | | | ; This routine calles UM*, which uses tmp1, tmp2 and tmp3, so we cannot access
377:000 | DONE cmt | na 16 16 | | | ; any of those.
378:000 | DONE lbl | na 16 16 | 005160 | | xt_tonumber
379:000 | DONE dir | na 16 16 | | | .!a16
380:000 | DONE cmt | na 16 16 | | | ; For the math routine, we move the inputs to the scratchpad to
381:000 | DONE cmt | na 16 16 | | | ; avoid having to fool around with the Data Stack.
382:000 | DONE cmt | na 16 16 | | | ;
383:000 | DONE cmt | na 16 16 | | | ; +-----+-----+-----+-----+-----+-----+-----+-----+
384:000 | DONE cmt | na 16 16 | | | ; | UD-LO | UD-HI | N | UD-HI-LO |
385:000 | DONE cmt | na 16 16 | | | ; | | | | |
386:000 | DONE cmt | na 16 16 | | | ; | S S+1 | S+2 S+3 | S+4 S+5 | S+6 S+7 |
387:000 | DONE cmt | na 16 16 | | | ; +-----+-----+-----+-----+-----+-----+-----+-----+
388:000 | DONE wsp | na 16 16 | | |
389:000 | DONE cmt | na 16 16 | | | ; The math routine works by converting one character to its
390:000 | DONE cmt | na 16 16 | | | ; numerical value (N) via DIGIT? and storing it in S+4 for
391:000 | DONE cmt | na 16 16 | | | ; the moment. We then multiply the UD-HI value with the radix
392:000 | DONE cmt | na 16 16 | | | ; (from BASE) using UM*, which returns a double-cell result. We
393:000 | DONE cmt | na 16 16 | | | ; discard the high cell of that result (UD-HI-HI) and store the
394:000 | DONE cmt | na 16 16 | | | ; low cell (UD-HI-LO) in S+6 for now. -- The second part is
395:000 | DONE cmt | na 16 16 | | | ; multiplying UD-LO with the radix. The high cell (UD-LO-HI)
396:000 | DONE cmt | na 16 16 | | | ; gets put in S+2, the low cell (HD-LO-LO) in S. We then use
397:000 | DONE cmt | na 16 16 | | | ; a version of D+ to add ( S S+2 ) and ( S+4 S+6) together,
398:000 | DONE cmt | na 16 16 | | | ; storing the result back in S and S+2, before we start another
399:000 | DONE cmt | na 16 16 | | | ; round with it as the new UD-LO and UD-HI.
400:000 | DONE wsp | na 16 16 | | |
401:000 | DONE cmt | na 16 16 | | | ; Fill the scratchpad. We arrive with ( ud-lo ud-hi addr u ).
402:000 | DONE cmt | na 16 16 | | | ; After this step, the original ud-lo and ud-hi will still be on
403:000 | DONE cmt | na 16 16 | | | ; the Data Stack, but will be ignored and later overwritten
404:000 | DONE ins | na 16 16 | 005160 | b5 04 | lda.dx 04 ud-lo
405:000 | DONE ins | na 16 16 | 005162 | 85 28 | sta.d 000028
406:000 | DONE ins | na 16 16 | 005164 | b5 02 | lda.dx 02 ud-hi
407:000 | DONE ins | na 16 16 | 005166 | 85 2a | sta.d 00002a
408:000 | DONE wsp | na 16 16 | | |
409:000 | DONE cmt | na 16 16 | | | ; We push down one on the Data Stack to use TOS for character
410:000 | DONE cmt | na 16 16 | | | ; conversion - now ( ud-lo ud-hi addr u u )
411:000 | DONE ins | na 16 16 | 005168 | ca | dex
412:000 | DONE ins | na 16 16 | 005169 | ca | dex
413:000 | DONE ins | na 16 16 | 00516a | 94 00 | sty.dx 00
414:000 | DONE wsp | na 16 16 | | |
415:000 | DONE lbl | na 16 16 | 00516c | | tonumber_loop
416:000 | DONE cmt | na 16 16 | | | ; Get one character
417:000 | DONE ins | na 16 16 | 00516c | a1 02 | lda.dxi 02
418:000 | DONE ins | na 16 16 | 00516e | a8 | tay ( ud-lo ud-hi addr u char )
419:000 | DONE wsp | na 16 16 | | |
420:000 | DONE cmt | na 16 16 | | | ; Convert one character. DIGIT? takes care of the correct
421:000 | DONE cmt | na 16 16 | | | ; register size for A and does a paranoid AND to make sure that
422:000 | DONE cmt | na 16 16 | | | ; B is zero, so we don't have to do any of that here.
423:000 | DONE ins | na 16 16 | 00516f | 20 ec 57 | jsr 0057ec ( char -- n -1 | char 0 )
424:000 | DONE wsp | na 16 16 | | |
425:000 | DONE cmt | na 16 16 | | | ; This gives us (ud-lo ud-hi addr u char f | n f ), so check the
426:000 | DONE cmt | na 16 16 | | | ; flag. If it is zero, we return what we have and let the caller
427:000 | DONE cmt | na 16 16 | | | ; (usually NUMBER) complain to the user
428:000 | DONE ins | na 16 16 | 005172 | 98 | tya
429:000 | DONE ins | na 16 16 | 005173 | d0 06 | bne 00517b
430:000 | DONE wsp | na 16 16 | | |
431:000 | DONE ins | na 16 16 | 005175 | b4 00 | ldy.dx 00
432:000 | DONE ins | na 16 16 | 005177 | e8 | inx
433:000 | DONE ins | na 16 16 | 005178 | e8 | inx
434:000 | DONE ins | na 16 16 | 005179 | 80 35 | bra 0051b0
435:000 | DONE wsp | na 16 16 | | |
436:000 | DONE lbl | na 16 16 | 00517b | | tonumber_ok
437:000 | DONE cmt | na 16 16 | | | ; Conversion was successful, so we're here with
438:000 | DONE cmt | na 16 16 | | | ; ( ud-lo ud-hi addr u n -1 ) and can start the math routine.
439:000 | DONE wsp | na 16 16 | | |
440:000 | DONE cmt | na 16 16 | | | ; Save N so we don't have to fool around with the Data Stack
441:000 | DONE ins | na 16 16 | 00517b | b5 00 | lda.dx 00
442:000 | DONE ins | na 16 16 | 00517d | 85 2c | sta.d 00002c
443:000 | DONE wsp | na 16 16 | | |
444:000 | DONE cmt | na 16 16 | | | ; Now multiply ud-hi (the one in the scratchpad, not the
445:000 | DONE cmt | na 16 16 | | | ; original one in the Data Stack) by the radix from BASE. We can
446:000 | DONE cmt | na 16 16 | | | ; clobber TOS and NOS
447:000 | DONE ins | na 16 16 | 00517f | a5 2a | lda.d 00002a
448:000 | DONE ins | na 16 16 | 005181 | 95 00 | sta.dx 00
449:000 | DONE ins | na 16 16 | 005183 | a4 16 | ldy.d 000016 ( ud-lo ud-hi addr u ud-hi base )
450:000 | DONE wsp | na 16 16 | | |
451:000 | DONE cmt | na 16 16 | | | ; UM* returns a double celled number
452:000 | DONE ins | na 16 16 | 005185 | 20 52 5f | jsr 005f52 ( ud-lo ud-hi addr u ud-hi-lo ud-hi-hi )
453:000 | DONE wsp | na 16 16 | | |
454:000 | DONE cmt | na 16 16 | | | ; Move ud-hi-lo to safety
455:000 | DONE ins | na 16 16 | 005188 | b5 00 | lda.dx 00 ud-hi-lo
456:000 | DONE ins | na 16 16 | 00518a | 85 2e | sta.d 00002e
457:000 | DONE wsp | na 16 16 | | |
458:000 | DONE cmt | na 16 16 | | | ; Now we multiply ud-lo, overwriting the stack entries
459:000 | DONE ins | na 16 16 | 00518c | a5 28 | lda.d 000028
460:000 | DONE ins | na 16 16 | 00518e | 95 00 | sta.dx 00 ( ud-lo ud-hi addr u ud-lo ud-hi-hi )
461:000 | DONE ins | na 16 16 | 005190 | a4 16 | ldy.d 000016 ( ud-lo ud-hi addr u ud-lo base )
462:000 | DONE wsp | na 16 16 | | |
463:000 | DONE ins | na 16 16 | 005192 | 20 52 5f | jsr 005f52 ( ud-lo ud-hi addr u ud-lo-lo ud-lo-hi )
464:000 | DONE ins | na 16 16 | 005195 | 84 2a | sty.d 00002a
465:000 | DONE ins | na 16 16 | 005197 | b5 00 | lda.dx 00
466:000 | DONE ins | na 16 16 | 005199 | 85 28 | sta.d 000028
467:000 | DONE wsp | na 16 16 | | |
468:000 | DONE cmt | na 16 16 | | | ; This is a faster version of D+
469:000 | DONE ins | na 16 16 | 00519b | a5 28 | lda.d 000028
470:000 | DONE ins | na 16 16 | 00519d | 18 | clc
471:000 | DONE ins | na 16 16 | 00519e | 65 2c | adc.d 00002c
472:000 | DONE ins | na 16 16 | 0051a0 | 85 28 | sta.d 000028 this is the new ud-lo
473:000 | DONE ins | na 16 16 | 0051a2 | a5 2a | lda.d 00002a
474:000 | DONE ins | na 16 16 | 0051a4 | 65 2e | adc.d 00002e
475:000 | DONE ins | na 16 16 | 0051a6 | 85 2a | sta.d 00002a this is the new ud-hi
476:000 | DONE wsp | na 16 16 | | |
477:000 | DONE cmt | na 16 16 | | | ; Clean up: Get rid of one of the two top elements on the Data
478:000 | DONE cmt | na 16 16 | | | ; Stack. NIP is faster if Y is TOS
479:000 | DONE ins | na 16 16 | 0051a8 | e8 | inx
480:000 | DONE ins | na 16 16 | 0051a9 | e8 | inx ( ud-lo ud-hi addr u ud-lo-hi )
481:000 | DONE wsp | na 16 16 | | |
482:000 | DONE cmt | na 16 16 | | | ; One character down
483:000 | DONE ins | na 16 16 | 0051aa | f6 02 | inc.dx 02 increase address
484:000 | DONE ins | na 16 16 | 0051ac | d6 00 | dec.dx 00 decrease length
485:000 | DONE wsp | na 16 16 | | |
486:000 | DONE ins | na 16 16 | 0051ae | d0 bc | bne 00516c
487:000 | DONE wsp | na 16 16 | | |
488:000 | DONE lbl | na 16 16 | 0051b0 | | tonumber_done
489:000 | DONE cmt | na 16 16 | | | ; Counter has reached zero or we have an error. In both cases,
490:000 | DONE cmt | na 16 16 | | | ; we clean up the Data Stack and return. We arrive here with
491:000 | DONE cmt | na 16 16 | | | ; ( ud-lo ud-hi addr u char ) if there was an error
492:000 | DONE cmt | na 16 16 | | | ; and ( ud-lo ud-hi addr u ud-lo ) if not
493:000 | DONE ins | na 16 16 | 0051b0 | b4 00 | ldy.dx 00
494:000 | DONE ins | na 16 16 | 0051b2 | e8 | inx
495:000 | DONE ins | na 16 16 | 0051b3 | e8 | inx ( ud-lo ud-hi addr u )
496:000 | DONE wsp | na 16 16 | | |
497:000 | DONE cmt | na 16 16 | | | ; The new ud-lo and ud-hi are still on the scratch pad
498:000 | DONE ins | na 16 16 | 0051b4 | a5 28 | lda.d 000028 new ud-lo
499:000 | DONE ins | na 16 16 | 0051b6 | 95 04 | sta.dx 04
500:000 | DONE ins | na 16 16 | 0051b8 | a5 2a | lda.d 00002a
501:000 | DONE ins | na 16 16 | 0051ba | 95 02 | sta.dx 02 new ud-hi
502:000 | DONE wsp | na 16 16 | | |
503:000 | DONE lbl | na 16 16 | 0051bc | | z_tonumber
503:001 | DONE ins | na 16 16 | 0051bc | 60 | rts
504:000 | DONE wsp | na 16 16 | | |
505:000 | DONE wsp | na 16 16 | | |
506:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
507:000 | DONE cmt | na 16 16 | | | ; >R "TOR" ( n -- ) (R: -- n ) 7 bytes / 22 cycles
508:000 | DONE cmt | na 16 16 | | | ; Move Top of Data Stack to Top of Return Stack
509:000 | DONE cmt | na 16 16 | | | ; TODO consider stripping PHA/PLA if natively compiled (see COMPILE,)
510:000 | DONE lbl | na 16 16 | 0051bd | | xt_tor
511:000 | DONE dir | na 16 16 | | | .!a16
512:000 | DONE cmt | na 16 16 | | | ; Save the return address. If this word is natively coded, this
513:000 | DONE cmt | na 16 16 | | | ; is a complete waste of nine cycles, but required for
514:000 | DONE cmt | na 16 16 | | | ; subroutine coding
515:000 | DONE ins | na 16 16 | 0051bd | 68 | pla
516:000 | DONE cmt | na 16 16 | | | ; --- cut for native coding ---
517:000 | DONE wsp | na 16 16 | | |
518:000 | DONE ins | na 16 16 | 0051be | 5a | phy the actual work
519:000 | DONE wsp | na 16 16 | | |
520:000 | DONE ins | na 16 16 | 0051bf | b4 00 | ldy.dx 00 DROP
521:000 | DONE ins | na 16 16 | 0051c1 | e8 | inx
522:000 | DONE ins | na 16 16 | 0051c2 | e8 | inx
523:000 | DONE wsp | na 16 16 | | |
524:000 | DONE cmt | na 16 16 | | | ; --- cut for native coding ---
525:000 | DONE ins | na 16 16 | 0051c3 | 48 | pha put return address back in place
526:000 | DONE wsp | na 16 16 | | |
527:000 | DONE lbl | na 16 16 | 0051c4 | | z_tor
527:001 | DONE ins | na 16 16 | 0051c4 | 60 | rts
528:000 | DONE wsp | na 16 16 | | |
529:000 | DONE wsp | na 16 16 | | |
530:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
531:000 | DONE cmt | na 16 16 | | | ; /STRING ( addr u n -- ) X bytes / X cycles
532:000 | DONE cmt | na 16 16 | | | ; Remove characters from front of string. Uses tmp1
533:000 | DONE cmt | na 16 16 | | | ; Forth version: ROT OVER + ROT ROT - ;
534:000 | DONE cmt | na 16 16 | | | ; TODO check for negative strings so 1 /STRING TYPE won't try to print the whole
535:000 | DONE cmt | na 16 16 | | | ; address space; follow Gforth in failing gracefully
536:000 | DONE lbl | na 16 16 | 0051c5 | | xt_slashstring
537:000 | DONE ins | na 16 16 | 0051c5 | 84 1c | sty.d 00001c
538:000 | DONE wsp | na 16 16 | | |
539:000 | DONE ins | na 16 16 | 0051c7 | b5 00 | lda.dx 00 length
540:000 | DONE ins | na 16 16 | 0051c9 | 38 | sec
541:000 | DONE ins | na 16 16 | 0051ca | e5 1c | sbc.d 00001c
542:000 | DONE ins | na 16 16 | 0051cc | a8 | tay
543:000 | DONE wsp | na 16 16 | | |
544:000 | DONE ins | na 16 16 | 0051cd | b5 02 | lda.dx 02 address
545:000 | DONE ins | na 16 16 | 0051cf | 18 | clc
546:000 | DONE ins | na 16 16 | 0051d0 | 65 1c | adc.d 00001c
547:000 | DONE ins | na 16 16 | 0051d2 | 95 02 | sta.dx 02
548:000 | DONE wsp | na 16 16 | | |
549:000 | DONE ins | na 16 16 | 0051d4 | e8 | inx
550:000 | DONE ins | na 16 16 | 0051d5 | e8 | inx
551:000 | DONE wsp | na 16 16 | | |
552:000 | DONE lbl | na 16 16 | 0051d6 | | z_slashstring
552:001 | DONE ins | na 16 16 | 0051d6 | 60 | rts
553:000 | DONE wsp | na 16 16 | | |
554:000 | DONE wsp | na 16 16 | | |
555:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
556:000 | DONE cmt | na 16 16 | | | ; . "DOT" ( n -- ) X bytes / X cycles
557:000 | DONE cmt | na 16 16 | | | ; Print value that is TOS followed by a single space. Forth code is
558:000 | DONE cmt | na 16 16 | | | ; DUP ABS 0 <# #S ROT SIGN #> TYPE SPACE Based on
559:000 | DONE cmt | na 16 16 | | | ; https://github.com/philburk/pforth/blob/master/fth/numberio.fth Since this is
560:000 | DONE cmt | na 16 16 | | | ; used interactively, and humans are slow (just ask GlaDOS), we focus on size.
561:000 | DONE lbl | na 16 16 | 0051d7 | | xt_dot
562:000 | DONE ins | na 16 16 | 0051d7 | 20 e7 58 | jsr 0058e7 ( n n )
563:000 | DONE ins | na 16 16 | 0051da | 20 b1 54 | jsr 0054b1 ( n n )
564:000 | DONE ins | na 16 16 | 0051dd | 20 98 53 | jsr 005398 ( n n 0 )
565:000 | DONE ins | na 16 16 | 0051e0 | 20 16 51 | jsr 005116 ( n n 0 )
566:000 | DONE ins | na 16 16 | 0051e3 | 20 b3 52 | jsr 0052b3 ( n ud )
567:000 | DONE ins | na 16 16 | 0051e6 | 20 81 5d | jsr 005d81 ( ud n )
568:000 | DONE ins | na 16 16 | 0051e9 | 20 e4 5d | jsr 005de4 ( ud )
569:000 | DONE ins | na 16 16 | 0051ec | 20 a4 52 | jsr 0052a4
570:000 | DONE ins | na 16 16 | 0051ef | 20 0b 5f | jsr 005f0b
571:000 | DONE ins | na 16 16 | 0051f2 | 20 c3 5e | jsr 005ec3
572:000 | DONE wsp | na 16 16 | | |
573:000 | DONE lbl | na 16 16 | 0051f5 | | z_dot
573:001 | DONE ins | na 16 16 | 0051f5 | 60 | rts
574:000 | DONE wsp | na 16 16 | | |
575:000 | DONE wsp | na 16 16 | | |
576:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
577:000 | DONE cmt | na 16 16 | | | ; ." "DOTQUOTE" ( -- ) X bytes / X cycles
578:000 | DONE cmt | na 16 16 | | | ; Compile string that is printed during run time. ANSI Forth wants this to be
579:000 | DONE cmt | na 16 16 | | | ; compile-only, even though everybody and their friend uses it for everything.
580:000 | DONE cmt | na 16 16 | | | ; We follow the book here, and recommend .( for general printing.
581:000 | DONE lbl | na 16 16 | 0051f6 | | xt_dotquote
582:000 | DONE ins | na 16 16 | 0051f6 | ca | dex
583:000 | DONE ins | na 16 16 | 0051f7 | ca | dex
584:000 | DONE ins | na 16 16 | 0051f8 | 94 00 | sty.dx 00
585:000 | DONE ins | na 16 16 | 0051fa | a0 22 00 | ldy.# 0022 ASCII for "
586:000 | DONE wsp | na 16 16 | | |
587:000 | DONE ins | na 16 16 | 0051fd | 20 a7 5c | jsr 005ca7
588:000 | DONE ins | na 16 16 | 005200 | 20 f4 5d | jsr 005df4
589:000 | DONE wsp | na 16 16 | | |
590:000 | DONE ins | na 16 16 | 005203 | f4 0b 5f | phe.# 005f0b
591:000 | DONE ins | na 16 16 | 005206 | 20 4f 6a | jsr 006a4f don't JSR/RTS
592:000 | DONE wsp | na 16 16 | | |
593:000 | DONE lbl | na 16 16 | 005209 | | z_dotquote
593:001 | DONE ins | na 16 16 | 005209 | 60 | rts
594:000 | DONE wsp | na 16 16 | | |
595:000 | DONE wsp | na 16 16 | | |
596:000 | DONE cmt | na 16 16 | | | ; -------------------------------------------------------------------
597:000 | DONE cmt | na 16 16 | | | ; .S "DOTS" ( -- ) X bytes / X cycles
598:000 | DONE cmt | na 16 16 | | | ; Print content of Data Stack non-distructively. Since this is for humans, we
599:000 | DONE cmt | na 16 16 | | | ; don't have to worry about speed. We follow the format of Gforth
600:000 | DONE cmt | na 16 16 | | | ; and print the number of elements first in brackets, followed by the Data Stack
601:000 | DONE cmt | na 16 16 | | | ; content (if present). Uses tmp3
602:000 | DONE lbl | na 16 16 | 00520a | | xt_dots
603:000 | DONE dir | na 16 16 | | | .!a16
604:000 | DONE dir | na 16 16 | | | .!xy16
605:000 | DONE ins | na 16 16 | 00520a | 20 61 58 | jsr 005861 ( -- u)
606:000 | DONE wsp | na 16 16 | | |
607:000 | DONE cmt | na 16 16 | | | ; Print stack depth in brackets
608:000 | DONE ins | na 16 16 | 00520d | a9 3c 00 | lda.# 3c
609:000 | DONE ins | na 16 16 | 005210 | 20 f1 58 | jsr 0058f1
610:000 | DONE wsp | na 16 16 | | |
611:000 | DONE cmt | na 16 16 | | | ; We keep a copy of the number of things on the stack to use as
612:000 | DONE cmt | na 16 16 | | | ; a counter further down
613:000 | DONE ins | na 16 16 | 005213 | ca | dex DUP
614:000 | DONE ins | na 16 16 | 005214 | ca | dex
615:000 | DONE ins | na 16 16 | 005215 | 94 00 | sty.dx 00
616:000 | DONE wsp | na 16 16 | | |
617:000 | DONE ins | na 16 16 | 005217 | 20 8e 6a | jsr 006a8e print unsigned number
618:000 | DONE wsp | na 16 16 | | |
619:000 | DONE ins | na 16 16 | 00521a | a9 3e 00 | lda.# 3e
620:000 | DONE ins | na 16 16 | 00521d | 20 f1 58 | jsr 0058f1
621:000 | DONE ins | na 16 16 | 005220 | 20 c3 5e | jsr 005ec3
622:000 | DONE wsp | na 16 16 | | |
623:000 | DONE cmt | na 16 16 | | | ; There will be a lot of cases where .S is used when the stack
624:000 | DONE cmt | na 16 16 | | | ; is empty. Get them first and exit quickly
625:000 | DONE ins | na 16 16 | 005223 | 98 | tya force flag test
626:000 | DONE ins | na 16 16 | 005224 | f0 18 | beq 00523e
627:000 | DONE wsp | na 16 16 | | |
628:000 | DONE lbl | na 16 16 | 005226 | | dots_not_empty
629:000 | DONE cmt | na 16 16 | | | ; We have at least one element on the stack, which used to be in
630:000 | DONE cmt | na 16 16 | | | ; Y as TOS, but is now NOS and therefore accessable by X. The
631:000 | DONE cmt | na 16 16 | | | ; depth of the Data Stack is in Y waiting to be used as
632:000 | DONE cmt | na 16 16 | | | ; a counter. We use this to our advantage.
633:000 | DONE ins | na 16 16 | 005226 | a9 fb 00 | lda.# 0000fb skip two garbage entries on stack
634:000 | DONE ins | na 16 16 | 005229 | 85 20 | sta.d 000020 use as pointer
635:000 | DONE wsp | na 16 16 | | |
636:000 | DONE lbl | na 16 16 | 00522b | | dots_loop
637:000 | DONE ins | na 16 16 | 00522b | b2 20 | lda.di 000020 LDA (TMP1)
638:000 | DONE ins | na 16 16 | 00522d | 5a | phy save our counter
639:000 | DONE ins | na 16 16 | 00522e | a8 | tay
640:000 | DONE ins | na 16 16 | 00522f | 20 d7 51 | jsr 0051d7 print one number, drops TOS
641:000 | DONE wsp | na 16 16 | | |
642:000 | DONE ins | na 16 16 | 005232 | ca | dex restore counter
643:000 | DONE ins | na 16 16 | 005233 | ca | dex
644:000 | DONE ins | na 16 16 | 005234 | 94 00 | sty.dx 00
645:000 | DONE ins | na 16 16 | 005236 | 7a | ply
646:000 | DONE wsp | na 16 16 | | |
647:000 | DONE ins | na 16 16 | 005237 | c6 20 | dec.d 000020 next stack entry
648:000 | DONE ins | na 16 16 | 005239 | c6 20 | dec.d 000020
649:000 | DONE wsp | na 16 16 | | |
650:000 | DONE ins | na 16 16 | 00523b | 88 | dey
651:000 | DONE ins | na 16 16 | 00523c | d0 ed | bne 00522b
652:000 | DONE wsp | na 16 16 | | |
653:000 | DONE lbl | na 16 16 | 00523e | | dots_done
654:000 | DONE cmt | na 16 16 | | | ; word so we save one byte by doing DROP the slow way
655:000 | DONE ins | na 16 16 | 00523e | 20 e2 58 | jsr 0058e2
656:000 | DONE wsp | na 16 16 | | |
657:000 | DONE lbl | na 16 16 | 005241 | | z_dots