/
vtl02sg.a65
2161 lines (2138 loc) · 60.8 KB
/
vtl02sg.a65
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
;234567890123456789012345678901234567890123456789012345
;
; In the Kingswood AS65 assembler some of the options
; below must be set manually.
;
; .lf vtl02ca2.lst (set -l in commandline)
; .cr 6502 (is default)
; .tf vtl02ca2.obj,ap1 (set -s2 in commandline)
;-----------------------------------------------------;
; VTL-2 for the 6502 (VTL02C) ;
; Original Altair 680b version by ;
; Frank McCoy and Gary Shannon 1977 ;
; 2012: Adapted to the 6502 by Michael T. Barry ;
; Thanks to sbprojects.com for a very nice assembler! ;
;-----------------------------------------------------;
; Copyright (c) 2012, Michael T. Barry
; Revision B (c) 2015, Michael T. Barry
; Revision C (c) 2015, Michael T. Barry
; All rights reserved.
;
; Redistribution and use in source and binary forms,
; with or without modification, are permitted,
; provided that the following conditions are met:
;
; 1. Redistributions of source code must retain the
; above copyright notice, this list of conditions
; and the following disclaimer.
; 2. Redistributions in binary form must reproduce the
; above copyright notice, this list of conditions
; and the following disclaimer in the documentation
; and/or other materials provided with the
; distribution.
;
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS
; AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED
; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
; SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
; IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
; ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;-----------------------------------------------------;
; Except for the differences discussed below, VTL02 was
; designed to duplicate the OFFICIALLY DOCUMENTED
; behavior of Frank's 680b version, detailed here:
; http://www.altair680kit.com/manuals/Altair_
; 680-VTL-2%20Manual-05-Beta_1-Searchable.pdf
; These versions ignore all syntax errors and plow
; through VTL-2 programs with the assumption that
; they are "correct", but in their own unique ways,
; so any claims of compatibility are null and void
; for VTL-2 code brave (or stupid) enough to stray
; from the beaten path.
;
; Differences between the 680b and 6502 versions:
; * {&} and {*} are initialized on entry.
; * Division by zero returns 65535 for the quotient and
; the dividend for the remainder (the original 6800
; version froze).
; * The 6502 has NO 16-bit registers (other than PC)
; and less overall register space than the 6800,
; so the interpreter reserves some obscure VTL02C
; variables {@ $ ( ) 0 1 2 3 4 5 6 7 8 9 < > : ?}
; for its internal use (the 680b version used a
; similar tactic, but differed in the details).
; The deep nesting of parentheses also puts {; < =}
; in danger of corruption. For example, executing
; the statement A=((((((((1)))))))) sets both {A}
; and {;} to the value 1.
; * Users wishing to call a machine language subroutine
; via the system variable {>} must first set the
; system variable {"} to the proper address vector
; (for example, "=768).
; * The x register is used to point to a simple VTL02C
; variable (it can't point explicitly to an array
; element like the 680b version because it's only
; 8-bits). In the comments, var[x] refers to the
; 16-bit contents of the zero-page variable pointed
; to by register x (residing at addresses x, x+1).
; * The y register is used as a pointer offset inside
; a VTL02C statement (easily handling the maximum
; statement length of about 128 bytes). In the
; comments, @[y] refers to the 16-bit address
; formed by adding register y to the value in {@}.
; * The structure and flow of this interpreter are
; similar to the 680b version, but have been
; reorganized in a more 6502-friendly format (the
; 6502 has no 'bsr' instruction, so the 'stuffing'
; of subroutines within 128 bytes of the caller is
; only advantageous for conditional branches).
; * This version is based on the original port, which
; was wound rather tightly, in a failed attempt to
; fit it into 768 bytes like the 680b version; many
; structured programming principles were sacrificed
; in that effort. The 6502 simply requires more
; instructions than the 6800 does to manipulate 16-
; bit quantities, but the overall execution speed
; should be comparable due to the 6502's slightly
; lower average clocks/instruction ratio. As it is
; now, it fits into 1KB with just a few bytes to
; spare, but is more feature-laden than the 680b
; interpreter whence it came. Beginning with
; Revision C, I tried to strike a tasteful balance
; between execution speed and code size, but I
; stubbornly kept it under 1024 ROMable bytes and
; used only documented op-codes that were supported
; by the original NMOS 6502 (without the ROR bug).
; I may have missed a few optimizations -- further
; suggestions are welcome.
; * VTL02C is my free gift (?) to the world. It may be
; freely copied, shared, and/or modified by anyone
; interested in doing so, with only the stipulation
; that any liabilities arising from its use are
; limited to the price of VTL02C (nothing).
;-----------------------------------------------------;
; 2015: Revision B included some space optimizations
; (suggested by dclxvi) and enhancements
; (suggested by mkl0815 and Klaus2m5):
;
; * Bit-wise operators & | ^ (and, or, xor)
; Example: A=$|128) Get a char and set hi-bit
;
; * Absolute addressed 8-bit memory load and store
; via the {< @} facility:
; Example: <=P) Point to the I/O port at P
; @=@&254^128) Clear low-bit & flip hi-bit
;
; * Starting with VTL02B, the space character is no
; longer a valid user variable nor a "valid" binary
; operator. It's now only significant as a numeric
; constant terminator and as a place-holder in
; strings and program listings, where it may be
; used to improve human readability (at a slight
; cost in execution speed and memory consumption).
; Example:
; * (VTL-2)
; 1000 A=1) Init loop index
; 1010 ?=A) Print index
; 1020 ?="") Newline
; 1030 A=A+1) Update index
; 1040 #=A<10*1010) Loop until done
;
; * (VTL02B)
; 1000 A = 1 ) Init loop index
; 1010 ? = A ) Print index
; 1020 ? = "" ) Newline
; 1030 A = A + 1 ) Update index
; 1040 # = A < 10 * 1010 ) Loop until done
;
; 2015: Revision C includes further enhancements
; (suggested by Klaus2m5):
;
; * "THEN" and "ELSE" operators [ ]
; A[B returns 0 if A is 0, otherwise returns B.
; A]B returns B if A is 0, otherwise returns 0.
;
; * Some effort was made to balance interpreter code
; density with interpreter performance, while
; remaining within the 1KB constraint. Structured
; programming principles remained at low priority.
;
;-----------------------------------------------------;
; VTL02 for the 2m5 emulated 6502 SBC
; - released: 10-dec-2015
; - codename: speedy Gonzales
; - based on VTL02C, changes by Klaus2m5
;
; spaces in expressions are allowed on input but are
; removed from the stored program and listing.
;
; added a timer variable {/} with 10ms increments.
;
; the {?} input variable no longer accepts an
; expression as input. Only a number is accepted.
;
; added braces as shift operators.
; A}B shifts A by B bits to the right.
; A{B shifts A by B bits to the left.
; result is unpredictable if B > 16
;
; an expression missing the initial {=} operator
; is converted by duplicating the leftmost variable
; and inserting a {=}. {N+1} becomes {N=N+1}.
;
; added a statement delimiter {;} allowing multi
; statement lines.
; branch to same line is now allowed.
; {?="..."} & unmatched {)} (used for comments) can
; not be continued.
;
; added load and save facility to user call {>}
; "=0;>=13 loads program 13 from EEPROM
; "=1;>=42 saves current program to EEPROM as 42
; requires emulator version >= 0.83c
;
; line numbers >= 65280 are now reserved for the
; following fast return & goto features.
; added a gosub stack, depth = 16 address words.
; {==...} is a gosub and pushes the return address
; of the next line.
; {#==} is a return and pops the address when the
; result is the special line numer asigned to {=}.
; added a 31 line addresses acronym label array.
; lowercase characters and symbols in the $60-$7e
; range are used to address the array. the array
; is populated with the address of a line when a
; character in the allowed range preceeds the line
; number.
;
; example (prints the first 1000 prime numbers):
; 10 /=0;Q=d;V=5;U=25;X=1000
; 20 N=2;==b
; 30 N+1;==b
; 40 N+2;==b
; a100 N+2;==b
; 120 N+4;==b
; 150 #=a
; b200 #=N<U[Q;Q=c;V+2;U=V*V
; c300 D=5
; e310 A=N/D;#=%]=;D+2;#=D>V[d
; 320 A=N/D;#=%]=;D+4;#=D<V[e
; d400 ?=N;?=""
; 420 X=X-1;#=X[=
; 435 ?="Execution time: ";
; 445 ?=//100;$=46;#=%>10[465;?=0
; 465 ?=%;?=" seconds"
;
; added message service including error messages
; runtime errors:
; 233 EEPROM file corrupted
; 234 EEPROM file has incompatible format
; 237 EEPROM not responding
; 238 EEPROM full - file not saved
; 239 EEPROM file not found
; 240 array pointer exceeds reserved VTL RAM
; 241 user call pointer inside reserved VTL RAM
; 248 duplicate label
; 249 undefined label or empty return stack
; errors during program line input:
; 242 invalid or missing operator
; 243 invalid or missing target variable
; 244 value or variable missing after operator
; 245 missing closing parenthesis
; 246 out of memory (*-&)
; 247 overlap in input buffer, split program line
;
; internal changes:
; added required atomic variable fetch & store.
; replaced some jsr calls with inline code
; for skpbyte:, getbyte:, plus:, minus:.
; replaced cvbin calls to mul: & plus: with custom
; inline multiply by 10 & digit adder.
; removed simulation from startup of eval:.
; mainloop uses inline code to advance to next
; sequential program line.
; find: is now only used for true branches.
; added decimal to binary conversion on line entry
; avoiding the runtime conversion.
; abbreviated getting a simple variable in getval:.
; bypassed setting a simple variable in exec:.
; added inline divide by 10 to prnum:.
; fixed statement delimiter not overriding mismatched
; parentheses.
; merged oper: into getval: and progr: into exec:
; added a check for ctrl-c & ctrl-z during goto to
; allow user escape from a loop.
;
;-----------------------------------------------------;
; VTL02C variables occupy RAM addresses $0080 to $00ff,
; and are little-endian, in the 6502 tradition.
; The use of lower-case and some control characters for
; variable names is allowed, but not recommended; any
; attempts to do so would likely result in chaos, due
; to aliasing with upper-case and system variables.
; Variables tagged with an asterisk are used internally
; by the interpreter and may change without warning.
; {@ $ ( ) 0..9 : > ?} are (usually) intercepted by
; the interpreter, so their internal use by VTL02C is
; "safe". The same cannot be said for {; < =}, so be
; careful!
at = $80 ; {@}* internal pointer / mem byte
; VTL02C standard user variable space
; {A B C .. X Y Z [ \ ] ^ _}
; VTL02C system variable space
space = $c0 ; { }* gosub & return stack pointer
; Starting with VTL02B:
; the space character is no longer a valid user
; variable nor a "valid" binary operator. It is
; now only significant as a numeric constant
; terminator and as a place-holder in strings
; and program listings.
bang = $c2 ; {!} return line number
quote = $c4 ; {"} user ml subroutine vector
pound = $c6 ; {#} current line number
dolr = $c8 ; {$}* temp storage / char i/o
remn = $ca ; {%} remainder of last division
ampr = $cc ; {&} pointer to start of array
tick = $ce ; {'} pseudo-random number
lparen = $d0 ; {(}* temp line # / begin sub-exp
rparen = $d2 ; {)}* temp storage / end sub-exp
star = $d4 ; {*} pointer to end of free mem
; $d6 ; {+ , - .} valid variables
; (1) $fe ; {/} 10ms count up timer
; Interpreter argument stack space
arg = $e0 ; {0 1 2 3 4 5 6 7 8 9}*
; Rarely used variables and argument stack overflow
; = $f4 ; {:}* array variable header
semico = $f6 ; {;}* statement delimiter
lthan = $f8 ; {<}* user memory byte pointer
equal = $fa ; {=}* temp / gosub & return stack
gthan = $fc ; {>}* temp / call ML subroutine
ques = $fe ; {?}* temp / terminal i/o
;
nulstk = $01ff ; system stack resides in page 1
; (1) additional configurable variables and operators
timr_var = '/' ; 10 ms count up variable
timr_adr = timr_var*2|$80
;-----------------------------------------------------;
; Equates for a 48K+ Apple 2 (original, +, e, c, gs)
;ESC = 27 ; "Cancel current input line" key
;BS = 8 ; "Delete last keypress" key
;OP_OR = '!' ; Bit-wise OR operator
;linbuf = $0200 ; input line buffer
;prgm = $0800 ; VTL02C program grows from here
;himem = $8000 ; ... up to the top of user RAM
;vtl02c = $8000 ; interpreter cold entry point
; (warm entry point is startok)
;KBD = $c000 ; 128 + keypress if waiting
;KEYIN = $fd0c ; apple monitor keyin routine
;COUT = $fded ; apple monitor charout routine
;-----------------------------------------------------;
; Equates for the 2m5 SBC emulator
ESC = 27 ; "Cancel current input line" key
BS = 8 ; "Delete last keypress" key
OP_OR = '|' ; Bit-wise OR operator
lblary = $0100 ; array with goto labels, 64 bytes
vtlstck = $0140 ; gosub stack space, 32 bytes
; the following spaces overlap by $20 bytes to allow
; statement expansion by 2 for max 16 statements
prgbuf = $0200 ; program line buffer, 128 bytes
linbuf = $0220 ; input line buffer, 128 bytes
prgm = $02a0 ; VTL02C program grows from here
himem = $7600 ; ... up to the top of user RAM
vtl02c = $f600 ; interpreter cold entry point
; (warm entry point is startok)
io_area = $bf00 ;configure emulator I/O
acia_tx = io_area+$f0 ;acia tx data register
acia_rx = io_area+$f0 ;acia rx data register
timr_ie = io_area+$fe ;timer interrupt enable bit 0
timr_fl = io_area+$ff ;timer flags, bit 0 = 10ms tick
diag = io_area+$fc ;diag reg, bit 7 = exit to mon
dma_cmd = io_area+$f7 ;dma command register
dma_sta = io_area+$f7 ;dma status register
dma_dat = io_area+$f8 ;dma data register
;=====================================================;
org vtl02c
;-----------------------------------------------------;
; Initialize program area pointers and start VTL02C
;
lda #lo(prgm)
sta ampr ; {&} -> empty program
lda #hi(prgm)
sta ampr+1
lda #lo(himem)
sta star ; {*} -> top of user RAM
lda #hi(himem)
sta star+1
ldx #msgvtl ; identify VTL
jsr vmsg
startok:
sec ; request "OK" message
reset:
lda #0 ; clear label array & gosub stack
ldx #$5f
reset1:
sta lblary,x
dex
bpl reset1
sta space ; clear pointer to user stack
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Start/restart VTL02C command line with program intact
;
start:
cld ; a sensible precaution
ldx #lo(nulstk)
txs ; drop whatever is on the stack
bcc user ; skip "OK" if carry clear
ldx #msgok
jsr vmsg
user:
lda #0 ; last line # = direct mode
sta pound
sta pound+1
jsr inln ; input a line from the user
lda linbuf ; check for line label char
cmp #$60
bcc user1
iny ; skip label char
user1:
ldx #pound ; cvbin destination = {#}
jsr cvbin ; skip line number if exists
bne stmnt ; insert line
ldy #0 ; no line label
jsr syntax ; check syntax & convert numbers
user2:
ldy #4
lda #lo(prgbuf); direct mode
sta at ; {@} -> input line buffer
lda #hi(prgbuf)
sta at+1
jmp exec ; execute a direct mode statement
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Delete/insert/replace program line or list program
;
stmnt:
jsr syntax ; check syntax & convert numbers
clc
lda pound
ora pound+1 ; {#} = 0?
bne jskp2 ; no: delete/insert/replace line
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; List program to terminal and restart "OK" prompt
; entry: Carry must be clear
; uses: findln:, outch:, prnum:, prstr:, {@ ( )}
; exit: to command line via findln:
;
list_:
jsr findln ; find program line >= {#}
ldx #0
lda (at,x) ; print label
bpl list1
lda #' ' ; previous syntax error in line
list1:
jsr outch
ldx #lparen ; line number for prnum
jsr prnum ; print the line number
lda #' ' ; print a space instead of the
jsr outch ; line length byte
lda #0 ; zero for delimiter
jsr prstr ; print the rest of the line
lda (at,x) ; check for syntax error
bpl list_
ldx #msgerr+1 ; without cr
jsr verrs ; print syntax error
jmp list_
jskp2:
lda lblary+62 ; label array clear ?
beq skp2 ; then skip clearing it
lda #0 ; clear label array & gosub stack
ldx #$5f
clr_ls:
sta lblary,x
dex
bpl clr_ls
sta space ; clear pointer to user stack
;-----------------------------------------------------;
; Delete/insert/replace program line and restart the
; command prompt (no "OK" means success)
; entry: Carry must be clear
; uses: find:, start:, linbuf, {@ > # & * (}
;
skp2:
jsr find ; point {@} to first line >= {#}
bcs insrt
eor pound ; if line doesn't already exist
bne insrt ; then skip deletion process
cpx pound+1
bne insrt
tax ; x = 0
lda (at),y
tay ; y = length of line to delete
eor #-1
adc ampr ; {&} = {&} - y
sta ampr
bcs delt
dec ampr+1
delt:
lda at
sta gthan ; {>} = {@}
lda at+1
sta gthan+1
delt2:
lda gthan
cmp ampr ; delete the line
lda gthan+1
sbc ampr+1
bcs insrt
lda (gthan),y
sta (gthan,x)
inc gthan
bne delt2
inc gthan+1
bcc delt2 ; (always taken)
insrt:
ldx #0
lda prgbuf+3 ; get line size
cmp #5 ; empty line ?
beq jstart ; yes: end after delete
tay
clc
adc ampr ; calculate new program end
sta gthan ; {>} = {&} + length
txa
adc ampr+1
sta gthan+1
lda gthan
cmp star ; if {>} >= {*} then the program
lda gthan+1 ; won't fit in available RAM,
sbc star+1 ; so drop the stack and abort
bcc slide
lda #$f6 ; report out of memory
sta prgm ; flag program incomplete
jmp verr
slide:
lda ampr
bne slide2
dec ampr+1
slide2:
dec ampr
lda ampr
cmp at
lda ampr+1
sbc at+1
bcc move ; slide open a gap inside the
lda (ampr,x) ; program just big enough to
sta (ampr),y ; hold the new line
bcs slide ; (always taken)
move:
ldy prgbuf+3 ; move line to program
move2:
dey
lda prgbuf,y
sta (at),y
cpy #0
bne move2
lda gthan
sta ampr ; {&} = {>}
lda gthan+1
sta ampr+1
jstart:
clc
jmp start ; drop stack, restart cmd prompt
;-----------------------------------------------------;
; Point @[y] to the first/next program line >= {#}
; entry: (cc): start search at beginning of program
; (cs): start search at next line
; ({@} -> beginning of current line)
; used by: list_:, progr:
; uses: find:, jstart:, prgm, {@ # & (}
; exit: if line not found then abort to "OK" prompt
; else {@} -> found line, x:a = {#} = {(} =
; actual line number, y = 2, (cc)
; 10 bytes
findln:
jsr find ; find first/next line >= {#}
bcs jstart ; if end then restart "OK" prompt
sta pound ; {#} = {(}
stx pound+1
rts
;-----------------------------------------------------;
; {?="...} handler; called from exec:
; List line handler; called from list_:
; 2 bytes
prstr:
iny ; skip over the " or length byte
tax ; x = delimiter, fall through
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Print a string at @[y]
; x holds the delimiter char, which is skipped over,
; not printed (a null byte is always a delimiter)
; If a key was pressed, it pauses for another keypress
; before returning. If either of those keys was a
; ctrl-C, it drops the stack and restarts the "OK"
; prompt with the user program intact
; entry: @[y] -> string, x = delimiter char
; uses: inch:, inkey:, jstart:, outch:, execrts:
; exit: (normal) @[y] -> null or byte after delimiter
; (ctrl-C) drop the stack & restart "OK" prompt
;
prmsg:
lda #0
sta arg
sta arg+1
txa
cmp (at),y ; found delimiter or null?
beq prmsg2 ; yes: finish up
lda (at),y
beq prmsg2
; insert to decode packed constant
bpl prmsg1
iny ; is binary constant
cmp #$fd
bcs prmsg3
and #$7f ; is single byte
sta arg
jmp prmsg4
prmsg3: ; is word
lsr a ; $00 bytes low->N, high->C
ror a
bpl prmsg5 ; skip low byte
lda (at),y
sta arg
iny
prmsg5:
bcc prmsg4 ; skip high byte
lda (at),y
sta arg+1
iny
prmsg4:
txa
pha
ldx #arg ; print constant
jsr prnum
pla
tax
bpl prmsg
; end decode constant
prmsg1:
jsr outch ; no: print char to terminal
iny ; and loop (with safety escape)
bpl prmsg
prmsg2:
tax ; save closing delimiter
jsr inkey ; any key = pause/resume?
txa ; retrieve closing delimiter
beq outnl ; always \n after null delimiter
pro_skp: ; inline skpbyte
iny
lda (at),y
cmp #' '
beq pro_skp ; end inline
cmp #';' ; if trailing char is not ';'
bne outnl ; print \n
rts ; else suppress the \n
outnl:
lda #$0d ; \n to terminal
jmp outch
;-----------------------------------------------------;
; Execute (hopefully) valid VTL02C statements at @[y]
; exec: will continue until drop to direct mode
; entry: @[y] -> left-side of statement
; uses: nearly everything
; exit: note to machine language subroutine {>=...}
; users: no registers or variables are
; required to be preserved except the system
; stack pointer, the text base pointer {@},
; and the original line number {(}
; {>=...;..} requires {$} to be preserved
; if there is a {"} directly after the assignment
; operator, the statement will execute as {?="...},
; regardless of the variable named on the left side
;
exec:
lda (at),y ; inline getbyte
beq execend1 ; do nothing with a null statement
cmp #')' ; same for a full-line comment
beq execend1
iny
cmp #'A' ; variables < {A} ?
bcc exec_byp
; simple variable
asl a ; form simple variable address
ora #$80 ; mapping function is (a*2)|128
sta arg
lda #0
sta arg+1
lda (at),y ; '=' is next
iny ; skip space +1
ldx #arg+2
jsr eval
pha
sty dolr+1
lda arg+2
ldy #0
exec3:
sei ; force timer consistency
sta (arg),y
adc tick+1 ; store arg[{1}] in the left-side
rol a ; variable
tax
iny
lda arg+3
sta (arg),y
cli ; force timer consistency end
adc tick ; pseudo-randomize {'}
rol a
sta tick+1
stx tick
execend:
ldy dolr+1 ; restore line index
pla
iny
cmp #';' ; statement delimiter ?
beq exec ; continue with next statement
execend1:
lda pound ; direct mode ?
ora pound+1
beq jstart4
prog_nxt:
ldy #3 ; point {@} to next line address
ldx at+1 ; current line address
lda at
clc
adc (at),y ; {@} low + offset
bcc prg_n1
inx ; {@} high + carry
prg_n1:
cpx ampr+1 ; exceeds end of program?
bcc prg_n2 ; no
bne jstart4 ; yes - exit to direct mode
cmp ampr
bcs jstart4
prg_n2: ; (cc)
stx at+1 ; next line address valid!
sta at
ldy #1
lda (at),y
sta pound ; {#} = current line number
iny
lda (at),y
sta pound+1
ldy #4
jmp exec ; loop next line
jstart4:
sec
jmp start
; special variables including array
exec_byp:
ldx #arg ; initialize argument pointer
jsr convp ; arg[{0}] -> left-side variable
exec_gb3: ; inline getbyte + skpbyte
lda (at),y
iny ; skip space +1
lda (at),y
cmp #'"' ; yes: print the string with
beq exec2
ldx #arg+2 ; point eval to arg[{1}]
jsr eval ; evaluate right-side in arg[{1}]
pha
sty dolr+1 ; save to continue same line
lda arg+2
ldy #0
ldx arg+1 ; was left-side an array element?
bne exec3 ; yes: skip to default actions
ldx arg
cpx #at ; if {@=...} statement then poke
beq poke ; low half of arg[{1}] to ({<})
cpx #dolr ; if {$=...} statement then print
beq joutch ; arg[{1}] as ASCII character
cpx #ques ; if {?=...} statement then print
beq prnum0 ; arg[{1}] as unsigned decimal
cpx #gthan ; if {>=...} statement then call
beq usr ; user-defined ml routine
cpx #pound ; if {#=...} statement then goto
beq goto ; arg[{1}] as line number
cpx #equal ; if {==...} statement then gosub
beq gosub ; arg[{1}] as line number
jmp exec3 ; defaults to store variable
exec2:
jsr prstr ; trailing ';' check & return
jmp execend1
gosub:
lda pound ; is direct mode ?
ora pound+1
beq gosub3 ; return to commandline
lda at ; calculate next line address
ldy #3
clc
adc (at),y ; add to offset
tax
lda #0
adc at+1
cmp ampr+1 ; address beyond end of program ?
bcc gosub2
bne gosub3
cpx ampr
bcc gosub2
gosub3:
lda #0 ; then return ends program
tax
gosub2:
ldy space ; load VTL user stack pointer
sta vtlstck,y ; push high
txa
sta vtlstck+1,y ; push low
iny
iny
tya
and #$1f ; wrap around upper linimt
sta space ; save VTL user stack pointer
lda #pound ; point to standard line #
sta arg
ldy #0 ; restore Y
lda arg+2
goto:
tax ; save line # low
ora arg+3 ; fall through ?
bne goto1
jmp execend
poke:
sta (lthan),y ; store low byte
jmp execend
joutch:
jsr outch ; print character
jmp execend
prnum0:
ldx #arg+2 ; x -> arg[{1}], fall through
jsr prnum
jmp execend
usr:
tax ; jump to user ml routine with
lda quote+1 ; load/save vector?
bne usr1
lda quote
beq usr_load
cmp #1
beq usr_save
usr1:
lda quote+1
cmp star+1
bcc usr_err
bne usr2
lda quote
cmp star
bcc usr_err
usr2:
lda arg+3 ; arg[{1}] in a:x (MSB:LSB)
jsr usrq
jmp execend
usr_load:
jmp load
usr_save:
jmp save
usrq:
jmp (quote) ; {"} must point to valid 6502 code
usr_err:
lda #$f1
jmp verrcr
goto_abort:
jsr test_abort ; check for ctrl-c or ctrl-z
goto1:
lda acia_rx ; allow user abort
bne goto_abort
lda pound ; set {!} as return line #
sta bang
lda pound+1
sta bang+1
inc bang ; + 1
bne goto11
inc bang+1
goto11:
pla ; true goto
lda lblary+62 ; label array populated ?
beq ldaray ; no: populate now !
ldarayx:
ldy arg+3 ; is physical address pointer ?
cpy #$ff
beq goto3
ora pound ; direct mode ?
beq goto12
cpy pound+1 ; set carry flag for find
bne goto2
cpx pound
bne goto2
ldy #4 ; same line - start over
jmp exec
goto5:
txa ; build address to label array
and #$1f
asl a
tay
lda lblary,y ; load address from array
sta at
iny
lda lblary,y ; load address from array
sta at+1
bne goto7 ; if initialized
goto_err:
lda #$f9 ; undefined label or empty stack
jmp verrcr
jstart3:
sec ; print OK
jmp start
goto12:
clc ; from start of prog
goto2:
stx pound ; line # goto - store target
sty pound+1
jsr find
bcs jstart3 ; end of program
sta pound
stx pound+1
iny ; y = 3
jmp exec
goto3:
cpx #'=' ; from stack ?
bne goto5 ; else is label
ldy space ; load stack pointer
bne goto4
ldy #$20 ; wrap around
goto4:
dey ; load new address from stack
lda vtlstck,y
sta at
dey
lda vtlstck,y
beq goto_err ; if not initialized
sta at+1
sty space ; save stack pointer
goto7:
ldy #1 ; load line #
lda (at),y
sta pound
iny
lda (at),y
sta pound+1
ldy #4
jmp exec
; populate the acronym label array
ldaray:
txa
pha
lda #hi(prgm)
tax
lda #lo(prgm)
jmp ldaray2
ldaraylp:
ldy #0
lda (gthan),y ; is label ?
bmi ldaray_mis
cmp #$60
bcc ldaray1 ; no: skip load
and #$1f ; make index to label array
asl a
tax
lda lblary+1,x ; duplicate label ?
bne ldaray_dup
lda gthan ; line address -> array
sta lblary,x
lda gthan+1
sta lblary+1,x
ldaray1:
ldy #3 ; add offset to next line
lda gthan
ldx gthan+1
clc
adc (gthan),y ; add offset
bcc ldaray2
inx
ldaray2:
sta gthan
stx gthan+1
cpx ampr+1 ; end of program ?
bcc ldaraylp ; no: loop next line
bne ldaray3
cmp ampr
bcc ldaraylp
ldaray3:
sty lblary+62 ; mark populated
pla
tax
lda pound+1
jmp ldarayx
ldaray_dup:
lda #$f8 ; duplicate label !
ldaray_mis:
pha
ldy #1
lda (gthan),y ; line number
sta pound
iny
lda (gthan),y ; line number
sta pound+1
lda #0 ; clear label array & gosub stack
ldx #$5f
ldaray_clr:
sta lblary,x
dex
bpl ldaray_clr
pla ; post error code
jmp verr
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Print an unsigned decimal number (0..65535) in var[x]
; entry: var[x] = number to print
; uses: outch:, gthan