-
Notifications
You must be signed in to change notification settings - Fork 0
/
barebones.lst
4118 lines (3852 loc) · 195 KB
/
barebones.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
; 64tass Turbo Assembler Macro V1.55.2200 listing file
; 64tass -Wall -Wmacro-prefix -Wshadow --verbose-list -o barebones.hex -L barebones.lst --intel-hex --m65816 barebones.asm
; Sun Feb 28 22:43:34 2021
;Offset ;Hex ;Monitor ;Source
;****** Processing input file: barebones.asm
; Copyright 2021 Piotr Meyer <[email protected]>
;
; Permission to use, copy, modify, and/or distribute this
; software for any purpose with or without fee is hereby
; granted, provided that the above copyright notice and
; this permission notice appear in all copies.
; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS
; ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
; EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
; INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
; WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
; TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE
; USE OR PERFORMANCE OF THIS SOFTWARE.
.cpu "65816"
.include "macros_inc.asm"
;****** Processing file: macros_inc.asm
; Set 8-bit accumulator
setaxs .macro
.endm
; Set 16-bit accumulator
setaxl .macro
.endm
; Set 8-bit accumulator
setas .macro
.endm
; Set 16-bit accumulator
setal .macro
.endm
; Set 8 bit index registers
setxs .macro
.endm
; Set 16-bit index registers
setxl .macro
.endm
sdb .macro ; Set the B (Data bank) register
.endm
;****** Return to file: barebones.asm
;----------------------------------------------------------
; # Description
;
; RETRO/816 - a port of RETRO Forth to C256 Foenix
; RETRO Forth was created by Charles Childers (crc)
; see: http://retroforth.org/
;
; Program is created for C256 Foenix computer but should be
; able to run on almost any compatible system.
;
; At this moment we provide single NGA machine with fixed
; addresses at ZP and in main memory, but there is a room
; for multiple, independent VMs
; ## porting
;
; Current version is designed to be run on C256 Foenix
; computer with Foenix Kernel loaded
; We need two functions to be supported:
; C256_GETCHW - "wait for char and return it in A"
; C256_PUTC - "print char from A to screen"
;
; ## memory layout in C256
;
; $0040 - begin of shared regions, used by various routines
; $00E0 - end of shared regions
; $00F0 - 16 bytes of 'temporary user variables;
;
; $2000 - begin of free space (test code in Foenix)
; $7FFF - end of free space
; $8000 - begin of CPU stack
; $FEFF - end of CPU stack
;
; XXX - move it to ZP
; $01:0000 - beginning NGA (memory), single segment (64k)
; 0000 - begin of data stack
; 03ff - end of data stack
; 0400 - beign of return
; 07ff - end of return stack
; .... - unused
; $02:0000 - start of main NGA memory
; $05:FFFF - end of main NGA memory
;
; $3a:0000 - beginning of NGA code (overwrites BASIC)
; ..
;
; ## implementation-specific notes
;
; There are few shortcuts and many inefficiences in code,
; it should be corrected or extend in future releases
;
; At this moment main pointers are somewhat inconsistent
; - IP counts CELLS when SP i RP count BYTES. It simplify
; code a lot
;
; IP - 16bit instruction pointer, thats means that
; system is able to use only FFFF cells
; unit: CELLS
;
; IPPTR - 24bit in-memory pointer, allows to use
; 4*FFFF memory. It should be equal to IP << 2
; unit: BYTES
;
; SP - 16bit, stack pointer
; unit: BYTES (inc/dec by 4 bytes)
;
; RP - 16bit, return addres stack pointer,
; unit: BYTES (inc/dec by 4 bytes)
;
; ## booting
;
; C256 boot process, as remainder:
;
; 1. after boot CPU PC gets addr from $FFFC,
; 2. that value points to $FF00 and following code
; CLC
; XCE
; JML $1000 - BOOT vector of Foenix Kernel
; 3. JML IBOOT - internal boot routine
; 4. ... and, finally JML $03:A0000 to init BASIC
;----------------------------------------------------------
; # constants
;
; note - unlike in 65c816 stacks in original NGA grows up,
=$0400 STACK_DEPTH = $0400 ; bytes: depth of data stack
=$0400 ADDRESSES = $0400 ; bytes: depth of address stack
=$020000 IMAGE_ADDR = $02_0000 ; bytes: base address in real memory
=$ffff CELL_MAX = $FFFF ; max allowed cell, IP is word-sized
=4 IMAGE_BANKS = 4 ; by 64k, max with word-sized IP
=4 CELL_SIZE = 4 ; bytes: single CELL size
; some sanitization checks
.cerror IMAGE_ADDR & $00FFFF != $0000, "IMAGE_ADDR should be bank-aligned!"
; TOS*, NOS*, TRS* and MEM* variant are accessed by indexed
; modes (,X and ,Y). Different base addresses (+0, +2) are
; used to access low and high words without extra inx/iny
=$0000 DSTACK = $0000 ; data stack addr, grows up
=$0000 NOSl = DSTACK ; second item (,X)
=2 NOSh = DSTACK + 2 ; second item (,X)
=4 TOSl = DSTACK + 4 ; current item, low word
=6 TOSh = DSTACK + 6 ; current item, high word
=$0400 RSTACK = $0400 ; return stack addr, grows up
=$0400 TRSl = RSTACK ; current stack item, low word
=1026 TRSh = RSTACK + 2 ; current stack item. high word
; XXX - only used for stacks, rip it off
=$01 MEM_SEGMENT = $01 ; memory bank segment: $01:xxxx
; nymber of devices supported by system
=2 NUM_DEVICES = 2
; ## debug variables (only for go65c816 emulator)
=$10 TRACE_ON = $10
=$11 TRACE_OFF = $11
=$20 KILL = $20
; ## FMX kernel vectors
=$104c C256_GETCHW = $104c ; get character (wait)
=$1018 C256_PUTC = $1018 ; put character
; ---------------------------------------------------------
; # local variables
;
* = $60
>0060 00 00 IP .word 0 ; instruction pointer - cells
>0062 00 00 00 00 IPPTR .dword 0 ; instruction pointer - bytes
>0066 00 00 SP .word 0 ; data stack pointer - bytes
>0068 00 00 RP .word 0 ; return stack pointer - bytes
>006a 00 00 00 00 CMD .dword 0 ; temporary for OP unboundling
>006e 00 00 00 00 TMP .dword 0 ; temporary
=$6e TMPa = TMP ; additional identifiers
>0072 00 00 00 00 TMPb .dword 0 ; for various cases
>0076 00 00 TMPc .word 0 ; at this moment inst_di
>0078 00 00 TMPd .word 0 ; ...
; ---------------------------------------------------------
; # main routine
;
* = $03A0000
.3a0000 main
.3a0000 18 clc clc
.3a0001 fb xce xce
.3a0002 main0
.3a0002 c2 30 rep #$30 REP #$30 ; set A&X long
.al
.xl
.3a0004 48 pha pha ; begin setdbr macro
.3a0005 08 php php
.3a0006 e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a0008 a9 3a lda #$3a lda #`msg_banner
.3a000a 48 pha pha
.3a000b ab plb plb
.databank `msg_banner
.3a000c 28 plp plp
.3a000d 68 pla pla ; end setdbr macro
.3a000e a2 dc 06 ldx #$06dc ldx #<>msg_banner
.3a0011 20 7d 01 jsr $3a017d jsr prints
.3a0014 20 32 00 jsr $3a0032 jsr prepare_vm
.3a0017 20 be 00 jsr $3a00be jsr execute
.3a001a 48 pha pha ; begin setdbr macro
.3a001b 08 php php
.3a001c e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a001e a9 3a lda #$3a lda #`msg_end
.3a0020 48 pha pha
.3a0021 ab plb plb
.databank `msg_end
.3a0022 28 plp plp
.3a0023 68 pla pla ; end setdbr macro
.3a0024 a2 39 07 ldx #$0739 ldx #<>msg_end
.3a0027 20 7d 01 jsr $3a017d jsr prints
.3a002a 22 4c 10 00 jsl $00104c jsl C256_GETCHW
.3a002e 5c 00 10 00 jmp $001000 jml $1000 ; BOOT
; ## preparing environment
;
; 1. clear memory region
; 2. clear stacks
; 3. copy image to memory region
;
.3a0032 prepare_vm
; 1. clear memory
.3a0032 48 pha pha ; begin setdbr macro
.3a0033 08 php php
.3a0034 e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a0036 a9 3a lda #$3a lda #`msg_mclean
.3a0038 48 pha pha
.3a0039 ab plb plb
.databank `msg_mclean
.3a003a 28 plp plp
.3a003b 68 pla pla ; end setdbr macro
.3a003c a2 00 07 ldx #$0700 ldx #<>msg_mclean
.3a003f 20 7d 01 jsr $3a017d jsr prints
.3a0042 e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a0044 c2 10 rep #$10 REP #$10 ; set X long
.xl
.3a0046 a9 02 lda #$02 lda #`IMAGE_ADDR
.3a0048 85 6e sta $6e sta TMP
.3a004a a0 04 00 ldy #$0004 ldy #IMAGE_BANKS
.3a004d a5 6e lda $6e mclean0 lda TMP
.3a004f 48 pha pha
.3a0050 ab plb plb
.3a0051 a2 00 00 ldx #$0000 ldx #$0000
.3a0054 9e 00 00 stz $3a0000,x mclean1 stz $0,b,x
.3a0057 e8 inx inx
.3a0058 d0 fa bne $3a0054 bne mclean1
.3a005a e6 6e inc $6e inc TMP
.3a005c 88 dey dey
.3a005d d0 ee bne $3a004d bne mclean0
; 2. clear stacks
.3a005f 48 pha pha ; begin setdbr macro
.3a0060 08 php php
.3a0061 e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a0063 a9 3a lda #$3a lda #`msg_sclean
.3a0065 48 pha pha
.3a0066 ab plb plb
.databank `msg_sclean
.3a0067 28 plp plp
.3a0068 68 pla pla ; end setdbr macro
.3a0069 a2 14 07 ldx #$0714 ldx #<>msg_sclean
.3a006c 20 7d 01 jsr $3a017d jsr prints
.3a006f 48 pha pha ; begin setdbr macro
.3a0070 08 php php
.3a0071 e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a0073 a9 01 lda #$01 lda #MEM_SEGMENT
.3a0075 48 pha pha
.3a0076 ab plb plb
.databank MEM_SEGMENT
.3a0077 28 plp plp
.3a0078 68 pla pla ; end setdbr macro
.3a0079 c2 20 rep #$20 REP #$20 ; set A long
.al
.3a007b a2 fe 03 ldx #$03fe ldx #STACK_DEPTH-2
.3a007e 9e 00 00 stz $010000,x prep0 stz #DSTACK,b,x
.3a0081 ca dex dex
.3a0082 ca dex dex
.3a0083 10 f9 bpl $3a007e bpl prep0
.3a0085 a2 fe 03 ldx #$03fe ldx #ADDRESSES-2
.3a0088 9e 00 04 stz $010400,x prep1 stz #RSTACK,b,x
.3a008b ca dex dex
.3a008c ca dex dex
.3a008d 10 f9 bpl $3a0088 bpl prep1
; 4. copy image
.3a008f 48 pha pha ; begin setdbr macro
.3a0090 08 php php
.3a0091 e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a0093 a9 3a lda #$3a lda #`msg_copy
.3a0095 48 pha pha
.3a0096 ab plb plb
.databank `msg_copy
.3a0097 28 plp plp
.3a0098 68 pla pla ; end setdbr macro
.3a0099 a2 27 07 ldx #$0727 ldx #<>msg_copy
.3a009c 20 7d 01 jsr $3a017d jsr prints
.3a009f e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a00a1 a0 7c 94 ldy #$947c ldy #IMAGE_SIZE
.3a00a4 a2 00 00 ldx #$0000 ldx #0
.databank ?
.3a00a7 bf 1d 08 3a lda $3a081d,x copy0 lda IMAGE_SRC,x
.3a00ab 9f 00 00 02 sta $020000,x sta IMAGE_ADDR,x
.3a00af e8 inx inx
.3a00b0 88 dey dey
.3a00b1 d0 f4 bne $3a00a7 bne copy0
; 4. set DBR to stack area
.3a00b3 48 pha pha ; begin setdbr macro
.3a00b4 08 php php
.3a00b5 e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a00b7 a9 01 lda #$01 lda #MEM_SEGMENT
.3a00b9 48 pha pha
.3a00ba ab plb plb
.databank MEM_SEGMENT
.3a00bb 28 plp plp
.3a00bc 68 pla pla ; end setdbr macro
.3a00bd 60 rts rts
; ## main execute loop
.3a00be execute
.3a00be c2 30 rep #$30 REP #$30 ; set A&X long
.al
.xl
.3a00c0 a9 04 00 lda #$0004 lda #CELL_SIZE
.3a00c3 85 68 sta $68 sta RP
.3a00c5 64 66 stz $66 stz SP
.3a00c7 64 60 stz $60 stz IP
.3a00c9 20 58 01 jsr $3a0158 jsr update_ipptr
.3a00cc 20 e2 00 jsr $3a00e2 execute0 jsr process_bundle
.3a00cf 42 04 wdm #$04 wdm #4 ; debugging - op count
.3a00d1 a5 68 lda $68 lda RP
.3a00d3 f0 0c beq $3a00e1 beq quit
.3a00d5 20 6f 01 jsr $3a016f jsr next_ipptr
.3a00d8 e6 60 inc $60 inc IP
.3a00da a5 60 lda $60 lda IP
.3a00dc c9 ff ff cmp #$ffff cmp #CELL_MAX ; NGA exit condition
.3a00df 90 eb bcc $3a00cc bcc execute0
.3a00e1 60 rts quit rts
; ### process 4 commands in bundle
.3a00e2 process_bundle
.3a00e2 a0 02 00 ldy #$0002 ldy #2
.3a00e5 b7 62 lda [$62],y lda [IPPTR],y ; 7 cycles
.3a00e7 85 6c sta $6c sta CMD+2
.3a00e9 a7 62 lda [$62] lda [IPPTR] ; also 7 cycles
.3a00eb 85 6a sta $6a sta CMD
.3a00ed 29 ff 00 and #$00ff and #$ff
.3a00f0 f0 05 beq $3a00f7 beq + ; skip .. (nop)
.3a00f2 0a asl a asl a
.3a00f3 aa tax tax
.3a00f4 fc 1c 01 jsr ($3a011c,x) jsr (#<>op_table,k,x)
.3a00f7 a5 6b lda $6b + lda CMD+1
.3a00f9 29 ff 00 and #$00ff and #$ff
.3a00fc f0 05 beq $3a0103 beq + ; skip .. (nop)
.3a00fe 0a asl a asl a
.3a00ff aa tax tax
.3a0100 fc 1c 01 jsr ($3a011c,x) jsr (#<>op_table,k,x)
.3a0103 a5 6c lda $6c + lda CMD+2
.3a0105 29 ff 00 and #$00ff and #$ff
.3a0108 f0 05 beq $3a010f beq + ; skip .. (nop)
.3a010a 0a asl a asl a
.3a010b aa tax tax
.3a010c fc 1c 01 jsr ($3a011c,x) jsr (#<>op_table,k,x)
.3a010f a5 6d lda $6d + lda CMD+3
.3a0111 29 ff 00 and #$00ff and #$ff
.3a0114 f0 05 beq $3a011b beq + ; bne/rts for -1 cycle
.3a0116 0a asl a asl a
.3a0117 aa tax tax
.3a0118 fc 1c 01 jsr ($3a011c,x) jsr (#<>op_table,k,x)
.3a011b 60 rts + rts
.3a011c op_table
>3a011c 90 01 .addr inst_no
>3a011e 91 01 .addr inst_li
>3a0120 ad 01 .addr inst_du
>3a0122 c3 01 .addr inst_dr
>3a0124 db 01 .addr inst_sw
>3a0126 f8 01 .addr inst_pu
>3a0128 12 02 .addr inst_po
>3a012a 31 02 .addr inst_ju
>3a012c 3f 02 .addr inst_ca
>3a012e 5b 02 .addr inst_cc
>3a0130 94 02 .addr inst_re
>3a0132 a6 02 .addr inst_eq
>3a0134 d0 02 .addr inst_ne
>3a0136 fa 02 .addr inst_lt
>3a0138 27 03 .addr inst_gt
>3a013a 54 03 .addr inst_fe
>3a013c e7 03 .addr inst_st
>3a013e 13 04 .addr inst_ad
>3a0140 2b 04 .addr inst_su
>3a0142 43 04 .addr inst_mu
>3a0144 a3 04 .addr inst_di
>3a0146 55 05 .addr inst_an
>3a0148 6c 05 .addr inst_or
>3a014a 83 05 .addr inst_xo
>3a014c 9a 05 .addr inst_sh
>3a014e 06 06 .addr inst_zr
>3a0150 27 06 .addr inst_ha
>3a0152 2d 06 .addr inst_ie
>3a0154 40 06 .addr inst_iq
>3a0156 4c 06 .addr inst_ii
;----------------------------------------------------------
; ## tooling routines
; ### updates IPPTR (in bytes) from IP field (in cells)
.3a0158 update_ipptr
.3a0158 a5 60 lda $60 lda IP
.3a015a 85 62 sta $62 sta IPPTR
.3a015c 64 64 stz $64 stz IPPTR+2
.3a015e 06 62 asl $62 asl IPPTR ; IPPTR = IP*4
.3a0160 26 64 rol $64 rol IPPTR+2
.3a0162 06 62 asl $62 asl IPPTR
.3a0164 26 64 rol $64 rol IPPTR+2
.3a0166 18 clc clc ; add base
.3a0167 a5 64 lda $64 lda IPPTR+2
.3a0169 69 02 00 adc #$0002 adc #`IMAGE_ADDR
.3a016c 85 64 sta $64 sta IPPTR+2
.3a016e 60 rts rts
; ### increases in-memory IPPTR pointer by CELL_SIZE
.3a016f next_ipptr
.3a016f a5 62 lda $62 lda IPPTR
.3a0171 18 clc clc
.3a0172 69 04 00 adc #$0004 adc #CELL_SIZE
.3a0175 85 62 sta $62 sta IPPTR
.3a0177 b0 01 bcs $3a017a bcs +
.3a0179 60 rts rts
.3a017a e6 64 inc $64 + inc IPPTR+2
.3a017c 60 rts rts
; ### print 0-terminated strings
; DBR - string segment
; X - string address
.3a017d prints .proc
.3a017d 08 php php
.3a017e e2 20 sep #$20 SEP #$20 ; set A short
.as
.3a0180 c2 10 rep #$10 REP #$10 ; set X long
.xl
.3a0182 bd 00 00 lda $010000,x prints0 lda $0,b,x
.3a0185 f0 07 beq $3a018e beq prints_done
.3a0187 22 18 10 00 jsl $001018 jsl C256_PUTC
.3a018b e8 inx inx
.3a018c 80 f4 bra $3a0182 bra prints0
.3a018e 28 plp prints_done plp
.3a018f 60 rts rts
.pend
;----------------------------------------------------------
; # NGA VM
;
; Implementation of nga VM, based on `vm/nga-c/nga.c` code.
; Current version may be suboptimal, but the goal is in most
; accurate implementation.
;
.al
.xl
; ---------------------------------------------------------
; ## .. ( 0) stack: - | - nop
.3a0190 inst_no
.3a0190 60 rts rts
; ---------------------------------------------------------
; ## li ( 1) stack: -n | - lit
;
; void inst_li() {
; sp++;
; ip++;
; TOS = memory[ip];
; }
.3a0191 inst_li
.3a0191 a5 66 lda $66 lda SP ; 4 cycles
.3a0193 18 clc clc ; 1 cycle
.3a0194 69 04 00 adc #$0004 adc #CELL_SIZE ; 3 cycles
.3a0197 85 66 sta $66 sta SP ; 4 cycles
.3a0199 aa tax tax ; 2 cycles
.3a019a e6 60 inc $60 inc IP
.3a019c 20 6f 01 jsr $3a016f jsr next_ipptr
.3a019f a7 62 lda [$62] lda [IPPTR]
.3a01a1 9d 04 00 sta $010004,x sta #TOSl,b,x
.3a01a4 a0 02 00 ldy #$0002 ldy #2
.3a01a7 b7 62 lda [$62],y lda [IPPTR],y
.3a01a9 9d 06 00 sta $010006,x sta #TOSh,b,x
; lda IP ; 4 cycles
; clc ; 1 cycle
; adc #4 ; 3 cycles
; sta IP ; 4 cycles
; tay ; 2 cycles
; lda #MEMl,b,y
; sta #TOSl,b,x
; lda #MEMh,b,y
; sta #TOSh,b,x
.3a01ac 60 rts rts
; ---------------------------------------------------------
; ## du ( 2) stack: n-nn | - dup
;
; void inst_du() {
; sp++;
; data[sp] = NOS; // it means TOS = NOS?
; }
.3a01ad inst_du
.3a01ad a5 66 lda $66 lda SP ; 4 cycles
.3a01af 18 clc clc ; 1 cycle
.3a01b0 69 04 00 adc #$0004 adc #CELL_SIZE ; 3 cycles
.3a01b3 85 66 sta $66 sta SP ; 4 cycles
.3a01b5 aa tax tax ; 2 cycles
.3a01b6 bd 00 00 lda $010000,x lda #NOSl,b,x
.3a01b9 9d 04 00 sta $010004,x sta #TOSl,b,x
.3a01bc bd 02 00 lda $010002,x lda #NOSh,b,x
.3a01bf 9d 06 00 sta $010006,x sta #TOSh,b,x
.3a01c2 60 rts rts
; ---------------------------------------------------------
; ## dr ( 3) stack: n- | - drop
;
; void inst_dr() {
; data[sp] = 0; // it means TOS=0?
; if (--sp < 0)
; ip = CELL_MAX;
; }
.3a01c3 inst_dr
.3a01c3 a6 66 ldx $66 ldx SP
.3a01c5 9e 04 00 stz $010004,x stz #TOSl,b,x
.3a01c8 9e 06 00 stz $010006,x stz #TOSh,b,x
.3a01cb 8a txa txa
.3a01cc 38 sec sec
.3a01cd e9 04 00 sbc #$0004 sbc #4
.3a01d0 85 66 sta $66 sta SP
.3a01d2 30 01 bmi $3a01d5 bmi inst_dr0
.3a01d4 60 rts rts
; IP+1 in exec loop == LIMIT == EXIT
.3a01d5 a9 fe ff lda #$fffe inst_dr0 lda #CELL_MAX-1
.3a01d8 85 60 sta $60 sta IP
.3a01da 60 rts rts
; ---------------------------------------------------------
; ## sw ( 4) stack: xy-xy | - swap
;
; void inst_dr() {
; data[sp] = 0; // it means TOS=0?
; if (--sp < 0)
; ip = CELL_MAX;
; }
.3a01db inst_sw
.3a01db a6 66 ldx $66 ldx SP
.3a01dd bc 04 00 ldy $010004,x ldy #TOSl,b,x ; TOS -> TMP
.3a01e0 bd 00 00 lda $010000,x lda #NOSl,b,x
.3a01e3 9d 04 00 sta $010004,x sta #TOSl,b,x ; NOS -> TOS
.3a01e6 98 tya tya
.3a01e7 9d 00 00 sta $010000,x sta #NOSl,b,x ; TMP -> NOS
.3a01ea bc 06 00 ldy $010006,x ldy #TOSh,b,x ; TOS -> TMP
.3a01ed bd 02 00 lda $010002,x lda #NOSh,b,x
.3a01f0 9d 06 00 sta $010006,x sta #TOSh,b,x ; NOS -> TOS
.3a01f3 98 tya tya
.3a01f4 9d 02 00 sta $010002,x sta #NOSh,b,x ; TMP -> NOS
.3a01f7 60 rts rts
; ---------------------------------------------------------
; ## pu ( 5) stack: n- | -n push
;
; void inst_pu() {
; rp++;
; TORS = TOS;
; inst_dr();
; }
.3a01f8 inst_pu
.3a01f8 a5 68 lda $68 lda RP ; 4 cycles
.3a01fa 18 clc clc ; 1 cycle
.3a01fb 69 04 00 adc #$0004 adc #CELL_SIZE ; 3 cycles
.3a01fe 85 68 sta $68 sta RP ; 4 cycles
.3a0200 a8 tay tay ; 2 cycles
.3a0201 a6 66 ldx $66 ldx SP
.3a0203 bd 04 00 lda $010004,x lda #TOSl,b,x
.3a0206 99 00 04 sta $010400,y sta #TRSl,b,y
.3a0209 bd 06 00 lda $010006,x lda #TOSh,b,x
.3a020c 99 02 04 sta $010402,y sta #TRSh,b,y
.3a020f 4c c3 01 jmp $3a01c3 jmp inst_dr
; ---------------------------------------------------------
; ## po ( 6) stack: -n | n- pop
;
; void inst_po() {
; sp++;
; TOS = TORS;
; rp--;
; }
.3a0212 inst_po
.3a0212 a5 66 lda $66 lda SP
.3a0214 18 clc clc
.3a0215 69 04 00 adc #$0004 adc #CELL_SIZE
.3a0218 85 66 sta $66 sta SP
.3a021a aa tax tax
.3a021b a4 68 ldy $68 ldy RP
.3a021d b9 00 04 lda $010400,y lda #TRSl,b,y
.3a0220 9d 04 00 sta $010004,x sta #TOSl,b,x
.3a0223 b9 02 04 lda $010402,y lda #TRSh,b,y
.3a0226 9d 06 00 sta $010006,x sta #TOSh,b,x
.3a0229 98 tya tya
.3a022a 38 sec sec
.3a022b e9 04 00 sbc #$0004 sbc #4
.3a022e 85 68 sta $68 sta RP
.3a0230 60 rts rts
; ---------------------------------------------------------
; ## ju ( 7) stack: a- | - jump
;
; void inst_ju() {
; ip = TOS - 1; // I'm not sure about that '-1'
; inst_dr();
; }
; PROBLEM THERE - SP is 16-bit and argument to JUMP may
; be 32bit XXX - check it in already created image
; BUT - current image < 64k, so there shouldn't be problems
.3a0231 inst_ju
.3a0231 a6 66 ldx $66 ldx SP
.3a0233 bd 04 00 lda $010004,x lda #TOSl,b,x
.3a0236 3a dec a dec a
.3a0237 85 60 sta $60 sta IP
.3a0239 20 58 01 jsr $3a0158 jsr update_ipptr
.3a023c 4c c3 01 jmp $3a01c3 jmp inst_dr
; ---------------------------------------------------------
; ## ca ( 8) stack: a- | -A call
;
; void inst_ca() {
; rp++;
; TORS = ip;
; ip = TOS - 1;
; inst_dr();
; }
.3a023f inst_ca
.3a023f a5 68 lda $68 lda RP
.3a0241 18 clc clc
.3a0242 69 04 00 adc #$0004 adc #CELL_SIZE
.3a0245 85 68 sta $68 sta RP
.3a0247 a8 tay tay
.3a0248 a5 60 lda $60 lda IP
.3a024a 99 00 04 sta $010400,y sta #TRSl,b,y
; for completness sake
.3a024d a6 66 ldx $66 ldx SP
.3a024f bd 04 00 lda $010004,x lda #TOSl,b,x
.3a0252 3a dec a dec a
.3a0253 85 60 sta $60 sta IP
.3a0255 20 58 01 jsr $3a0158 jsr update_ipptr
.3a0258 4c c3 01 jmp $3a01c3 jmp inst_dr
; ---------------------------------------------------------
; ## cc ( 9) stack: af- | -A conditional call
;
; void inst_cc() {
; CELL a, b;
; a = TOS; inst_dr(); /* Target */
; b = TOS; inst_dr(); /* Flag */
; if (b != 0) {
; rp++;
; TORS = ip;
; ip = a - 1;
; }
; }
.3a025b inst_cc
.3a025b a6 66 ldx $66 ldx SP ; a
.3a025d bd 04 00 lda $010004,x lda #TOSl,b,x
.3a0260 85 6e sta $6e sta TMP
.3a0262 20 c3 01 jsr $3a01c3 jsr inst_dr
.3a0265 a6 66 ldx $66 ldx SP
.3a0267 bd 04 00 lda $010004,x lda #TOSl,b,x
.3a026a d0 08 bne $3a0274 bne inst_cc_jmp
.3a026c bd 06 00 lda $010006,x lda #TOSh,b,x
.3a026f d0 03 bne $3a0274 bne inst_cc_jmp
.3a0271 4c c3 01 jmp $3a01c3 jmp inst_dr
.3a0274 20 c3 01 jsr $3a01c3 inst_cc_jmp jsr inst_dr ; for compatibility
.3a0277 a5 68 lda $68 lda RP
.3a0279 18 clc clc
.3a027a 69 04 00 adc #$0004 adc #CELL_SIZE
.3a027d 85 68 sta $68 sta RP
.3a027f a8 tay tay
.3a0280 a5 60 lda $60 lda IP
.3a0282 99 00 04 sta $010400,y sta #TRSl,b,y
.3a0285 a9 00 00 lda #$0000 lda #$0
.3a0288 99 02 04 sta $010402,y sta #TRSh,b,y ; only lower..
.3a028b a5 6e lda $6e lda TMP
.3a028d 3a dec a dec a
.3a028e 85 60 sta $60 sta IP
.3a0290 20 58 01 jsr $3a0158 jsr update_ipptr
.3a0293 60 rts rts
;jmp inst_dr
; ---------------------------------------------------------
; ## re (10) stack: - | A- return
;
; void inst_re() {
; ip = TORS;
; rp--;
; }
.3a0294 inst_re
.3a0294 a4 68 ldy $68 ldy RP
.3a0296 b9 00 04 lda $010400,y lda #TRSl,b,y
.3a0299 85 60 sta $60 sta IP
.3a029b 20 58 01 jsr $3a0158 jsr update_ipptr
.3a029e 98 tya tya
.3a029f 38 sec sec
.3a02a0 e9 04 00 sbc #$0004 sbc #4
.3a02a3 85 68 sta $68 sta RP
.3a02a5 60 rts rts
; ---------------------------------------------------------
; ## eq (11) stack: xy-f | - equality
;
; void inst_eq() {
; NOS = (NOS == TOS) ? -1 : 0;
; inst_dr();
; }
.3a02a6 inst_eq
.3a02a6 a6 66 ldx $66 ldx SP
.3a02a8 bd 00 00 lda $010000,x lda #NOSl,b,x
.3a02ab dd 04 00 cmp $010004,x cmp #TOSl,b,x
.3a02ae d0 17 bne $3a02c7 bne inst_eq_no
.3a02b0 bd 02 00 lda $010002,x lda #NOSh,b,x
.3a02b3 dd 06 00 cmp $010006,x cmp #TOSh,b,x
.3a02b6 d0 0f bne $3a02c7 bne inst_eq_no
.3a02b8 a9 ff ff lda #$ffff lda #<>-1
.3a02bb 9d 00 00 sta $010000,x sta #NOSl,b,x
.3a02be a9 ff ff lda #$ffff lda #>`-1
.3a02c1 9d 02 00 sta $010002,x sta #NOSh,b,x
.3a02c4 4c c3 01 jmp $3a01c3 jmp inst_dr
.3a02c7 9e 00 00 stz $010000,x inst_eq_no stz #NOSl,b,x
.3a02ca 9e 02 00 stz $010002,x stz #NOSh,b,x
.3a02cd 4c c3 01 jmp $3a01c3 jmp inst_dr
; ---------------------------------------------------------
; ## ne (12) stack: xy-f | - inequality
;
; void inst_eq() {
; NOS = (NOS != TOS) ? -1 : 0;
; inst_dr();
; }
.3a02d0 inst_ne
.3a02d0 a6 66 ldx $66 ldx SP
.3a02d2 bd 00 00 lda $010000,x lda #NOSl,b,x
.3a02d5 dd 04 00 cmp $010004,x cmp #TOSl,b,x
.3a02d8 d0 11 bne $3a02eb bne inst_ne_no
.3a02da bd 02 00 lda $010002,x lda #NOSh,b,x
.3a02dd dd 06 00 cmp $010006,x cmp #TOSh,b,x
.3a02e0 d0 09 bne $3a02eb bne inst_ne_no
.3a02e2 9e 00 00 stz $010000,x stz #NOSl,b,x
.3a02e5 9e 02 00 stz $010002,x stz #NOSh,b,x
.3a02e8 4c c3 01 jmp $3a01c3 jmp inst_dr
.3a02eb a9 ff ff lda #$ffff inst_ne_no lda #<>-1
.3a02ee 9d 00 00 sta $010000,x sta #NOSl,b,x
.3a02f1 a9 ff ff lda #$ffff lda #>`-1
.3a02f4 9d 02 00 sta $010002,x sta #NOSh,b,x
.3a02f7 4c c3 01 jmp $3a01c3 jmp inst_dr
; ---------------------------------------------------------
; ## lt (13) stack: xy-f | - less than
;
; void inst_eq() {
; NOS = (NOS < TOS) ? -1 : 0;
; inst_dr();
; }
; it should be a signed comparison then
; http://www.6502.org/tutorials/compare_beyond.html#5
.3a02fa inst_lt
.3a02fa a6 66 ldx $66 ldx SP
.3a02fc bd 00 00 lda $010000,x lda #NOSl,b,x
.3a02ff dd 04 00 cmp $010004,x cmp #TOSl,b,x
.3a0302 bd 02 00 lda $010002,x lda #NOSh,b,x
.3a0305 fd 06 00 sbc $010006,x sbc #TOSh,b,x
.3a0308 50 03 bvc $3a030d bvc inst_lt0 ; N eor V
.3a030a 49 80 00 eor #$0080 eor #$80
.3a030d 30 09 bmi $3a0318 inst_lt0 bmi inst_lt_lt
.3a030f 9e 00 00 stz $010000,x stz #NOSl,b,x
.3a0312 9e 02 00 stz $010002,x stz #NOSh,b,x
.3a0315 4c c3 01 jmp $3a01c3 jmp inst_dr
.3a0318 a9 ff ff lda #$ffff inst_lt_lt lda #<>-1
.3a031b 9d 00 00 sta $010000,x sta #NOSl,b,x
.3a031e a9 ff ff lda #$ffff lda #>`-1
.3a0321 9d 02 00 sta $010002,x sta #NOSh,b,x
.3a0324 4c c3 01 jmp $3a01c3 jmp inst_dr
; ---------------------------------------------------------
; ## gt (14) stack: xy-f | - greater than
;
; void inst_eq() {
; NOS = (NOS > TOS) ? -1 : 0;
; inst_dr();
; }
; it should be a signed comparison then
; http://www.6502.org/tutorials/compare_beyond.html#5
.3a0327 inst_gt
.3a0327 a6 66 ldx $66 ldx SP
.3a0329 bd 04 00 lda $010004,x lda #TOSl,b,x
.3a032c dd 00 00 cmp $010000,x cmp #NOSl,b,x
.3a032f bd 06 00 lda $010006,x lda #TOSh,b,x
.3a0332 fd 02 00 sbc $010002,x sbc #NOSh,b,x
.3a0335 50 03 bvc $3a033a bvc inst_gt0 ; N eor V
.3a0337 49 80 00 eor #$0080 eor #$80
.3a033a 30 09 bmi $3a0345 inst_gt0 bmi inst_gt_gt
.3a033c 9e 00 00 stz $010000,x stz #NOSl,b,x
.3a033f 9e 02 00 stz $010002,x stz #NOSh,b,x
.3a0342 4c c3 01 jmp $3a01c3 jmp inst_dr
.3a0345 a9 ff ff lda #$ffff inst_gt_gt lda #<>-1
.3a0348 9d 00 00 sta $010000,x sta #NOSl,b,x
.3a034b a9 ff ff lda #$ffff lda #>`-1
.3a034e 9d 02 00 sta $010002,x sta #NOSh,b,x
.3a0351 4c c3 01 jmp $3a01c3 jmp inst_dr
; ---------------------------------------------------------
; ## fe (15) stack: a-n | - fetch
;
; void inst_fe() {
; #ifndef NOCHECKS
; if (TOS >= CELL_MAX || TOS < -5) {
; ip = CELL_MAX;
; printf("\nERROR (nga/inst_fe): Fetch beyond valid memory range\n");
; exit(1);
; } else {
; #endif
; switch (TOS) {
; case -1: TOS = sp - 1; break;
; case -2: TOS = rp; break;
; case -3: TOS = CELL_MAX; break;
; case -4: TOS = CELL_MIN_VAL; break;
; case -5: TOS = CELL_MAX_VAL; break;
; default: TOS = memory[TOS]; break;
; }
; #ifndef NOCHECKS
; }
; #endif
; }
; XXX - there no checks now, as we don't have a way
; to report them
;
.3a0354 inst_fe
.3a0354 a6 66 ldx $66 ldx SP
.3a0356 bd 06 00 lda $010006,x lda #TOSh,b,x
.3a0359 30 27 bmi $3a0382 bmi inst_fe0 ; special values
.3a035b bd 04 00 lda $010004,x lda #TOSl,b,x ; only 16 bit
.3a035e 85 6e sta $6e sta TMP
.3a0360 64 70 stz $70 stz TMP+2
.3a0362 06 6e asl $6e asl TMP ; IPPTR = IP*4
.3a0364 26 70 rol $70 rol TMP+2
.3a0366 06 6e asl $6e asl TMP
.3a0368 26 70 rol $70 rol TMP+2
.3a036a 18 clc clc ; add base
.3a036b a5 70 lda $70 lda TMP+2
.3a036d 69 02 00 adc #$0002 adc #`IMAGE_ADDR
.3a0370 85 70 sta $70 sta TMP+2
.3a0372 a5 6e lda $6e lda TMP
.3a0374 a7 6e lda [$6e] lda [TMP]
.3a0376 9d 04 00 sta $010004,x sta #TOSl,b,x
.3a0379 a0 02 00 ldy #$0002 ldy #2
.3a037c b7 6e lda [$6e],y lda [TMP],y
.3a037e 9d 06 00 sta $010006,x sta #TOSh,b,x
.3a0381 60 rts rts
.3a0382 bd 04 00 lda $010004,x inst_fe0 lda #TOSl,b,x
.3a0385 1a inc a inc a ; it was -1?
.3a0386 d0 0c bne $3a0394 bne inst_fe1 ; no
.3a0388 a5 66 lda $66 lda SP ; "TOS = sp-1"
.3a038a 3a dec a dec a
.3a038b 4a lsr a lsr a ; SP in bytes
.3a038c 4a lsr a lsr a ; stack uses cells
.3a038d 9d 04 00 sta $010004,x sta #TOSl,b,x
.3a0390 9e 06 00 stz $010006,x stz #TOSh,b,x
.3a0393 60 rts rts
.3a0394 1a inc a inst_fe1 inc a ; it was -2?
.3a0395 d0 0b bne $3a03a2 bne inst_fe2