-
Notifications
You must be signed in to change notification settings - Fork 1
/
scmp3.asm
2026 lines (1875 loc) · 88.2 KB
/
scmp3.asm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
; This listing was reverse engineered and commented from a dump of the 8073N ROM
; It may look like valid SC/MP-III assembler, but probably isn't. This is purely for
; reference - not for feeding into an assembler program.
; Analysed and commented by Holger Veit (20140315)
; locations in on-chip RAM
FFC0 MULOV = X'ffc0 ; DW high 16 bit from MPY
FFC2 INPMOD = X'ffc2 ; DB input mode: X'00 interactive, <>0 in INPUT, 01: running
FFC3 CURRNT = X'ffc3 ; DW current line number executed
FFC5 RUNMOD = X'ffc5 ; DB runmode 'R', X'00
FFC6 EXTRAM = X'ffc6 ; DW start of variables (26 words)
FFC8 AESTK = X'ffc8 ; DW start of arithmetic stack (13 words)
FFCA SBRSTK = X'ffca ; DW start of GOSUB stack (10 words)
FFCC DOSTK = X'ffcc ; DW start of DO stack (10 words)
FFCE FORSTK = X'ffce ; DW start of FOR stack (28 words)
FFD0 BUFAD = X'ffd0 ; DW
FFD2 STACK = X'ffd2 ; DW top of stack
FFD4 TXTBGN = X'ffd4 ; DW start of program area
FFD6 TXTUNF = X'ffd6 ; DW
FFD8 TXTEND = X'ffd8 ; DW end of program area
FFDA DOPTR = X'ffda ; DW ptr to DO level?
FFDC FORPTR = X'ffdc ; DW ptr to FOR level?
FFDE SBRPTR = X'ffde ; DW ptr to GOSUB level?
FFE0 INTVEC = X'ffe0 ; DW current interrupt vector
FFE2 INTAVC = X'ffe2 ; DW Interrupt A vector
FFE4 INTBVC = X'ffe4 ; DW Interrupt B vector
FFE6 BRKFLG = X'ffe6 ; DB if 0 check for BREAK from serial
FFE7 NOINT = X'ffe7 ; DB flag to suppress INT after having set STAT
FFE8 ONE = X'ffe8 ; DW constant 1
FFEA ZERO = X'ffea ; DW constant 0
FFEC DLYTIM = X'ffec ; DW delay value for serial I/O
FFEE CONTP = X'ffee ; DW buffer pointer for CONT
FFF0 TMPF0 = X'fff0 ; DW temporary for moving program code for insertion
FFF2 TMPF2 = X'fff2 ; DW temp store for current program pointer
FFF4 RNDNUM = X'fff4 ; DW rnd number
FFF6 TMPF6 = X'fff6 ; DB,DW temporary
FFF8 UNUSE1 = X'fff8 ; DW unused
FFFB TMPFB = X'fffb ; DB,DW temporary
FFFC TMPFC = X'fffc ; DB,DW temporary (overlaps TMPFB)
FFFE TMPFE = X'fffe ; DW temporary, alias
; more constants
1000 RAMBASE = X'1000 ; start of RAM
8000 ROMBASE = X'8000 ; potential start of a ROM
FD00 BAUDFLG = X'FD00 ; address of baudrate selection bits
08 BS = X'08 ; back space
0D CR = X'0d ; carriage return
0A LF = X'0a ; line feed
15 NAK = X'15 ; CTRL-U, NAK
20 SPACE = ' ' ; space character
3E GTR = '>' ; prompt for interactive mode
3F QUEST = '?' ; prompt for input mode
5E CARET = '^' ; prefix for CTRL output
; interpreter starts here
; assumptions "should be" refer to 1K RAM at X'1000-X'13ff)
ORG 0
0000: 00 NOP ; lost byte because of PC preincrement
0001: 24 09 00 JMP COLD ; Jump to cold start
0004: 24 b9 08 JMP INTA ; Jump to interrupt a handler
0007: 24 be 08 JMP INTB ; Jump to interrupt b handler
000a: 84 00 80 COLD: LD EA, =ROMBASE ; bottom address of ROM
000d: 8d d4 COLD1: ST EA, TXTBGN ; set begin of text to ROM
000f: 84 00 10 LD EA, =RAMBASE ; set P2 to point to base of RAM
0012: 46 LD P2, EA ;
0013: 20 72 00 COLD2: JSR TSTRAM ; test for RAM at loc P2
0016: 7c fb BNZ COLD2 ; not zero: no RAM, loop
0018: 32 LD EA, P2 ; found RAM, get address
0019: bc 01 00 SUB EA, =1 ; subtract 1 to get the current position
001c: 7c f5 BNZ COLD2 ; is not at xx00, search next
001e: 74 20 BRA COLD3 ; found a page skip over call tbl, continue below
; short CALL table
0020: 3b 06 DW RELEXP-1 ; call 0 (RELEXP)
0022: ee 06 DW FACTOR-1 ; call 1 (FACTOR)
0024: 46 08 DW SAVOP-1 ; call 2 (SAVOP)
0026: 79 06 DW COMPAR-1 ; call 3 (COMPAR)
0028: 39 08 DW APUSH-1 ; call 4 (APUSH)
002a: 49 08 DW APULL-1 ; call 5 (APULL)
002c: 02 02 DW ENDCMD-1 ; call 6 (ENDCMD)
002e: 82 09 DW PUTC-1 ; call 7 (PUTC)
0030: 7d 09 DW CRLF-1 ; call 8 (CRLF)
0032: 4c 05 DW GETCHR-1 ; call 9 (GETCHR)
0034: 01 08 DW NEGATE-1 ; call 10 (NEGATE)
0036: 13 06 DW CMPTOK-1 ; call 11 (CMPTOK)
0038: 5d 05 DW EXPECT-1 ; call 12 (EXPECT c, offset)
003a: 94 05 DW NUMBER-1 ; call 13 (NUMBER, offset)
003c: 3e 05 DW PRTLN-1 ; call 14 (PRTLN)
003e: cc 08 DW ERROR-1 ; call 15 (ERROR)
; continues here from cold start
0040: 8d c6 COLD3: ST EA, EXTRAM ; arrive here with xx00, store it (should be X'1000)
0042: b4 00 01 ADD EA, =X'0100 ; add 256
0045: 8d d2 ST EA, STACK ; store as STACK address (should be X'1100)
0047: 45 LD SP, EA ; initialize stack pointer
0048: 20 72 00 COLD4: JSR TSTRAM ; check RAM at current pos P2 (should be X'1000)
004b: 6c fb BZ COLD4 ; advance until no longer RAM
; P2 points to last RAM+2
004d: c6 fe LD A, @fe, P2 ; subtract 2 from P2
004f: 32 LD EA, P2 ; get last RAM address
0050: 8d d8 ST EA, TXTEND ; store at end of text (should be X'13ff)
0052: 85 d4 LD EA, TXTBGN ; load begin of ROM text (X'8000)
0054: 46 LD P2, EA ; put into P2
0055: 20 72 00 JSR TSTRAM ; is there RAM?
0058: 6c 03 BZ COLD5 ; yes, skip
005a: 24 d9 01 JMP RUN ; no, this could be a ROM program, run it
005d: 85 d2 COLD5: LD EA, STACK ; get stack top
005f: bd d4 SUB EA, TXTBGN ; subtract begin of program
0061: 06 LD A, S ; get carry bit
0062: 64 04 BP COLD6 ; not set, skip
0064: 85 d2 LD EA, STACK ; get stack top
0066: 8d d4 ST EA, TXTBGN ; make it new TXTBGN
0068: c5 c5 COLD6: LD A, RUNMOD ; get mode
006a: e4 52 XOR A, ='R' ; is it 'R'?
006c: 6c 2c BZ MAINLP ; yes, skip
006e: 20 c0 05 JSR INITAL ; intialize all interpreter variables
0071: 74 1e BRA MAIN ; continue
; check RAM at loc P2; return 0 if found, nonzero if no RAM
0073: c6 01 TSTRAM: LD A, @1, P2 ; get value from RAM, autoincrement
0075: 48 LD E, A ; save old value into E (e.g. X'55)
0076: e4 ff XOR A, =ff ; complement value (e.g. X'AA)
0078: ca ff ST A, ff, P2 ; store it back (X'AA)
007a: e2 ff XOR A, ff, P2 ; read back and compare (should be X'00)
007c: 01 XCH A, E ; A=old value, E=X'00 (if RAM)
007d: ca ff ST A, ff, P2 ; store back old value
007f: e2 ff XOR A, ff, P2 ; read back and compare (should be X'00)
0081: 58 OR A, E ; or both tests, should be X'00 if RAM)
0082: 5c RET ; return zero, if RAM, nonzero if none
; NEW command
0083: 20 c0 05 NEW: JSR INITAL ; initialize interpreter variables
0086: c2 00 LD A, 0, P2 ; get a char from current program position (initially ROMBASE)
0088: e4 0d XOR A, =CR ; is char a CR?
008a: 6c 05 BZ MAIN ; yes, skip to program
008c: 10 CALL 0
008d: 15 CALL 5 ; APULL
008e: 24 0c 00 JMP COLD1 ; back to cold start
0091: 85 d4 MAIN: LD EA, TXTBGN ; get start of program area
0093: 8d d6 ST EA, TXTUNF ; store as end of program
0095: 46 LD P2, EA ; point P2 to it
0096: c4 7f LD A, =7f ; set end of program flag
0098: ca 00 ST A, 0, P2 ; at that position
; main interpreter loop
009a: 85 d2 MAINLP: LD EA, STACK ; reinitialize stack
009c: 45 LD SP, EA
009d: 85 c6 LD EA, EXTRAM ; start of RAM
009f: b4 34 00 ADD EA, =52 ; offset to AESTK
00a2: 8d c8 ST EA, AESTK ; set position of arithmetic stack
00a4: 47 LD P3, EA ; P3 is arith stack pointer
00a5: 20 e4 09 JSR INITBD ; initialize baud rate
00a8: 18 CALL 8 ; CRLF
00a9: c5 c2 LD A, INPMOD ; mode flag?
00ab: 6c 0c BZ MAINL1 ; zero, skip
; no, this is a break CTRL-C
00ad: 32 2 LD EA, P2 ; current pointion of buffer
00ae: 8d ee ST EA, CONTP ; save position (for CONT)
00b0: 22 11 09 PLI P2, =STOPMSG ; STOP message
00b3: 1e CALL 14 ; PRTLN
00b4: 5e POP P2 ; restore P2
00b5: 20 01 09 JSR PRTAT ; print AT line#
00b8: 18 MAINL1: CALL 8 ; CRLF
00b9: 85 c8 MAINL2: LD EA, AESTK ; initialize P3 with AESTK
00bb: 47 LD P3, EA
00bc: 84 00 00 LD EA, =0 ; initialize constant ZERO
00bf: 8d ea ST EA, ZERO
00c1: cd c2 ST A, INPMOD ; set cmd mode=0
00c3: c4 01 LD A, =1 ; initialize constant ONE
00c5: 8d e8 ST EA, ONE
00c7: 20 4c 08 JSR GETLN ; read a line into buffer
00ca: 19 CALL 9 ; GETCHR
00cb: 1d CALL 13 ; NUMBER
00cc: 85 DB =X'85 ; not a number, skip to DIRECT
00cd: 85 d4 LD EA, TXTBGN ; start of program
00cf: bd e8 SUB EA, ONE ; minus 1
00d1: bd d6 SUB EA, TXTUNF ; subtract end of program
00d3: 06 LD A, S ; get status
00d4: 64 02 BP MAINL3 ; overflow? no, skip
00d6: 1f CALL 15 ; ERROR
00d7: 01 DB =1 ; 1 (out of mem)
00d8: 32 MAINL3: LD EA, P2 ; get buffer pointer
00d9: 8d f0 ST EA, TMPF0 ; save it
00db: 20 6d 01 JSR FINDLN ; find line in program
00de: 7c 1b BNZ MAINL4 ; no match, skip
00e0: 56 PUSH P2 ; save p2 (line begin)
00e1: 20 91 01 JSR TOEOLN ; advance to end of line
00e4: 81 00 LD EA, 0, SP ; get line begin (P2)
00e6: 47 LD P3, EA ; into P3
00e7: 32 LD EA, P2 ; get end of line from TOEOLN
00e8: 1a CALL 10 ; NEGATE
00e9: 08 PUSH EA ; save -endline
00ea: b5 e8 ADD EA, ONE ; add one (for CR)
00ec: b5 d6 ADD EA, TXTUNF ; add end of program area
00ee: 8d fe ST EA, TMPFE ; store number of bytes to move
00f0: 3a POP EA ; restore -endline
00f1: b1 00 ADD EA, 0, SP ; subtract from start to get number of bytes to move
00f3: b5 d6 ADD EA, TXTUNF ; add end of program area
00f5: 8d d6 ST EA, TXTUNF ; set a new end of program
00f7: 20 5c 01 JSR BMOVE ; move area
00fa: 5e POP P2 ; restore start of line
; replace or add line
00fb: 32 MAINL4: LD EA, P2 ; copy into P3
00fc: 47 LD P3, EA
00fd: 85 f0 LD EA, TMPF0 ; buffer pointer
00ff: 46 LD P2, EA ; into P2
0100: 19 CALL 9 ; GETCHR
0101: e4 0d XOR A, =CR ; is it a single line number?
0103: 6c b4 BZ MAINL2 ; yes, ignore that
0105: 85 d0 LD EA, BUFAD ; address of buffer
0107: 46 LD P2, EA ; into P2
0108: 19 CALL 9 ; GETCHR
0109: 32 LD EA, P2 ; save buffer pointer
010a: 8d f6 ST EA, TMPF6
010c: 20 91 01 JSR TOEOLN ; advance to end of line
010f: 32 LD EA, P2 ; get end of line
0110: bd f6 SUB EA, TMPF6 ; subtract to get length of buffer
0112: 8d fe ST EA, TMPFE ; store number of bytes to move
0114: b5 d6 ADD EA, TXTUNF ; add temporary end of buffer
0116: bd d8 SUB EA, TXTEND ; store as new end of program
0118: bd e8 SUB EA, ONE ; subtract one
011a: 01 XCH A, E ; is result negative?
011b: 64 3e BP OMERR ; out of memory error
011d: 57 PUSH P3 ; save P3
011e: 85 d6 LD EA, TXTUNF ; get tmp area
0120: 46 LD P2, EA ; into P2
0121: 33 LD EA, P3 ; line to insert
0122: bd d6 SUB EA, TXTUNF ; subtract tmp buf
0124: 1a CALL 10 ; NEGATE
0125: 8d fb ST EA, TMPFB ; number of bytes to expand
0127: 58 OR A, E ; is result zero?
0128: 0a PUSH A ; save it for later check
0129: 85 d6 LD EA, TXTUNF ; tmp buf
012b: b5 fe ADD EA, TMPFE ; add length of line
012d: 8d d6 ST EA, TXTUNF ; store
012f: 47 LD P3, EA ; into P3
0130: c2 00 LD A, 0, P2 ; copy a byte
0132: cb 00 ST A, 0, P3
0134: 38 POP A ; restore result from above (sets Z flag)
0135: 6c 10 BZ MAINL6 ; was zero, skip
0137: c6 ff MAINL5: LD A, @X'ff, P2 ; otherwise copy backwards TMPFB bytes
0139: cf ff ST A, @X'ff, P3
013b: 9d fb DLD A, TMPFB ; decrement byte counter
013d: 7c f8 BNZ MAINL5
013f: c5 fc LD A, TMPFB+1
0141: 6c 04 BZ MAINL6 ; exit loop if zero
0143: 9d fc DLD A, TMPFB+1
0145: 74 f0 BRA MAINL5 ; loop
0147: 5f MAINL6: POP P3 ; restore target location
0148: 85 f6 LD EA, TMPF6
014a: 46 LD P2, EA ; restore source location
014b: 20 5c 01 JSR BMOVE ; move new line into program
014e: 24 b8 00 MAINL7: JMP MAINL2 ; done, continue in main loop
; parse a direct command
0151: c2 00 DIRECT: LD A, 0, P2 ; get char from buffer
0153: e4 0d XOR A, =CR ; is it a CR?
0155: 6c f7 BZ MAINL7 ; yes, continue in main loop
0157: 23 98 01 PLI P3, CMDTB1 ; load first CMD table
015a: 1b CALL 11 ; CMPTOK
; out of memory error
015b: 1f OMERR: CALL 15 ; ERROR
015c: 01 DB 1 ; 1 (out of memory)
;--------------------------------------------------------------------------------------------------
; move TMPFE bytes ascending from @P2 to @P3
015d: c6 01 BMOVE: LD A, @1, P2 ; get char from first pos
015f: cf 01 ST A, @1, P3 ; store into second
0161: 9d fe DLD A, TMPFE ; decrement byte counter 16 bit
0163: 7c f8 BNZ BMOVE
0165: c5 ff LD A, TMPFE+1
0167: 6c 04 BZ BMOVE1 ; exit if zero
0169: 9d ff DLD A, TMPFE+1
016b: 74 f0 BRA BMOVE ; loop
016d: 5c BMOVE1: RET
;--------------------------------------------------------------------------------------------------
; find line in program, 0 = found, 1 = insert before, -1 = not found, line in P2
; line number to find is on AESTK
016e: 85 d4 FINDLN: LD EA, TXTBGN ; get start of program
0170: 46 LD P2, EA ; into P2
0171: 32 FINDL1: LD EA, P2 ; get P2
0172: 8d fb ST EA, TMPFB ; save temporary
0174: 19 CALL 9 ; GETCHR
0175: 1d CALL 13 ; NUMBER
0176: 18 DB 18 ; skip if not number to FINDL4
0177: 15 CALL 5 ; APULL
0178: bb fe SUB EA, X'fe, P3 ; subtract number from the one on stack (the line number found)
017a: 01 XCH A, E ; is larger?
017b: 64 05 BP FINDL2 ; yes skip
017d: 20 91 01 JSR TOEOLN ; advance to end of line
0180: 74 ef BRA FINDL1 ; loop
0182: 58 FINDL2: OR A, E
0183: 6c 02 BZ FINDL3 ; is exactly the same?
0185: c4 01 LD A, =01 ; no, return 1
0187: 0a FINDL3: PUSH A
0188: 15 CALL 5 ; APULL
0189: 85 fb LD EA, TMPFB ; get start of this line
018b: 46 LD P2, EA ; into P2
018c: 38 POP A ; restore result
018d: 5c RET ; return with 0, if exact match, 1 if insert
018e: c4 ff FINDL4: LD A, =X'ff ; return with -1: end of program
0190: 74 f5 BRA FINDL3
;--------------------------------------------------------------------------------------------------
; advance to end of line
0192: c4 0d TOEOLN: LD A, =CR ; search for end of line
0194: 2e SSM P2 ; should be within next 256 bytes
0195: 74 17 BRA UCERR ; didn't find one, error 3
0197: 5c RET ; found one, return with P2 pointing to char after CR
;--------------------------------------------------------------------------------------------------
; set of DIRECT commands
0198: 4c.. CMDTB1: DB 'LIST'
019c: 93 DB X'93 ; to LIST
019d: 4e.. DB 'NEW'
01a0: 8a DB X'8a ; to NEW2
01a1: 52.. DB 'RUN'
01a4: b5 DB X'b5 ; to RUN
01a5: 43.. DB 'CONT'
01a9: a7 DB X'a7 ; to CONT
01aa: d2 DB X'd2 ; default case to EXEC1
;--------------------------------------------------------------------------------------------------
; NEW command
01ab: 24 82 00 NEW2: JMP NEW ; do new command
;--------------------------------------------------------------------------------------------------
01ae: 1f UCERR: CALL 15 ; ERROR
01af: 03 DB 3 ; 3 (unexpected char)
;--------------------------------------------------------------------------------------------------
; LIST command
01b0: 1d LIST: CALL 13 ; NUMBER
01b1: 03 DB 3 ; if no number, skip to LIST0
01b2: 74 03 BRA LIST1
01b4: 85 ea LIST0: LD EA, ZERO ; no number given, start with line 0
01b6: 14 CALL 4 ; APUSH put on stack
01b7: 20 6d 01 LIST1: JSR FINDLN ; find line in program, or next one
01ba: 19 LIST2: CALL 9 ; GETCHR from location found
01bb: 56 PUSH P2
01bc: 1d CALL 13 ; NUMBER
01bd: 0a DB X'0a ; if error, goto LIST3
01be: 15 CALL 5 ; APULL
01bf: 5e POP P2
01c0: 1e CALL 14 ; PRTLN
01c1: 18 CALL 8 ; CRLF
01c2: 20 1d 09 JSR CHKBRK ; test break
01c5: 74 f3 BRA LIST2
01c7: 5e LIST3: POP P2
01c8: 24 99 00 MAIN1: JMP MAINLP
;--------------------------------------------------------------------------------------------------
01cb: 54.. CMDTB6: DB 'THEN' ; then table
01cf: ad DB X'ad ; to EXEC1
01d0: ac DB X'ac ; default case to EXEC1
;--------------------------------------------------------------------------------------------------
; CONT command
01d1: 85 ee CONT: LD EA, CONTP ; restore program pointer from CONT
01d3: 46 LD P2, EA
01d4: c4 01 LD A, =01 ; set program mode
01d6: cd c2 ST A, INPMOD
01d8: 74 37 BRA ENDCM1
;--------------------------------------------------------------------------------------------------
; RUN command
01da: 20 c0 05 RUN: JSR INITAL ; initialize interpreter variables
01dd: c4 01 LD A, =01 ; set "running mode"
01df: cd c2 ST A, INPMOD
01e1: 85 d4 LD EA, TXTBGN ; start at first line
01e3: 46 LD P2, EA ; in buffer
01e4: 74 04 BRA RUN2 ; skip
01e6: c5 c2 RUN1: LD A, INPMOD
01e8: 6c de BZ MAIN1
01ea: 85 ea RUN2: LD EA, ZERO ; load 0
01ec: 14 CALL 4 ; APUSH
01ed: 20 70 01 RUN3: JSR FINDL1 ; find line from current position
01f0: 64 06 BP RUN4 ; found one
01f2: c4 00 LD A, =00 ; set 'not running'
01f4: cd c2 ST A, INPMOD
01f6: 74 d0 BRA MAIN1 ; back to mainloop
01f8: 1d RUN4: CALL 13 ; parse line NUMBER
01f9: 08 DB 8 ; not found: syntax error, goto SNERR1
01fa: 15 CALL 5 ; APULL line number
01fb: 8d c3 ST EA, CURRNT ; set as current line
01fd: 23 2e 02 EXEC1: PLI P3, =CMDTB2 ; run loop
0200: 1b CALL 11 ; process commands
0201: 1f SNERR1: CALL 15 ; ERROR
0202: 04 DB 4 ; 4 (syntax error)
;--------------------------------------------------------------------------------------------------
; handle end of CMD, check for break or interrupts... (call 6)
0203: 3a ENDCMD: POP EA ; drop return address
0204: c5 e7 LD A, ffe7 ; flag set?
0206: 7c 09 BNZ ENDCM1 ; yes, skip
0208: c5 c2 LD A, INPMOD ; interactive mode?
020a: 6c 05 BZ ENDCM1 ; yes skip
020c: 85 e0 LD EA, INTVEC ; interrupt pending?
020e: 58 OR A, E
020f: 7c 14 BNZ ENDCM3 ; yes, skip
0211: c4 00 ENDCM1: LD A, =0
0213: cd e7 ST A, NOINT
0215: 20 1d 09 JSR CHKBRK ; check for break
0218: 1c CALL 12 ; EXPECT
0219: 3a DB ':' ; colon?
021a: 03 DB X'03 ; no, to ENDCM2
021b: 74 e0 BRA EXEC1 ; continue run loop
021d: c6 01 ENDCM2: LD A, @1, P2 ; advance to next char
021f: e4 0d XOR A, =CR ; is it end of line?
0221: 7c 8b BNZ UCERR ; error unexpected char
0223: 74 c1 BRA RUN1 ; continue
0225: 85 e0 ENDCM3: LD EA, INTVEC ; get pending int vector
0227: 14 CALL 4 ; APUSH
0228: 85 ea LD EA, ZERO ;
022a: 8d e0 ST EA, INTVEC ; clear pending int
022c: 74 49 BRA GOSUB1 ; jump into GOSUB (process interrupt)
022e: 4c.. CMDTB2: DB 'LET'
0231: a6 DB X'a6 ; to LET
0232: 49.. DB 'IF'
0234: f3 DB X'f3 ; to IFCMD
0235: 4c.. DB 'LINK'
0239: f7 DB X'f7 ; to LINK
023a: 4e.. DB 'NEXT'
023e: 9c DB X'9c ; to NEXT
023f: 55.. DB 'UNTIL'
0244: db DB X'db ; to UNTIL
0245: 47.. DB 'GO'
0247: 96 DB X'96 ; to GOCMD
0248: 52.. DB 'RETURN'
024e: bd DB X'bd ; to RETURN
024f: 52.. DB 'REM'
0252: cf DB X'cf ; to REMCMD
0253: 80 DB X'80 ; default case to EXEC2
0254: 23 bf 02 EXEC2: PLI P3, =CMDTB7 ; load table 7
0257: 1b CALL 11 ; CMPTOK
;------------------------------------------------------------------------------
; forward to assignment
0258: 24 5a 04 LET: JMP ASSIGN ; ignore LET and continue with general assigment
;------------------------------------------------------------------------------
; forward to NEXT cmd
025b: 24 68 03 NEXT: JMP NEXT0 ; handle NEXT
;------------------------------------------------------------------------------
; handle GOTO or GOSUB
025e: 23 62 02 GOCMD: PLI P3, =CMDTB5 ; check for TO or SUB
0261: 1b CALL 11
0262: 54.. CMDTB5: DB 'TO'
0264: 85 DB X'85 ; to GOTO
0265: 53.. DB 'SUB'
0268: 8d DB X'8d
0269: 80 DB X'80 ; default case to GOTO
;------------------------------------------------------------------------------
; GOTO command
026a: 10 GOTO: CALL 0 ; RELEXP
026b: c4 01 LD A, =1 ;
026d: cd c2 ST A, INPMOD ; set 'running mode'
026f: 20 6d 01 JSR FINDLN ; find line in buffer
0272: 6c 84 BZ RUN4 ; skip to line number check
0274: 1f CALL 15 ; error
0275: 07 DB 7 ; 7 (goto target does not exist)
;------------------------------------------------------------------------------
; GOSUB command
0276: 10 GOSUB: CALL 0 ; RELEXP
0277: 85 de GOSUB1: LD EA, SBRPTR ; get SBR stack pointer
0279: 57 PUSH P3 ; save P3
027a: 47 LD P3, EA ; SBR stack in P3
027b: 85 cc LD EA, DOSTK ; mark do stack pointer
027d: cd f6 ST A, TMPF6 ; in temporary
027f: 33 LD EA, P3 ; get SBR stack ptr
0280: 20 c0 03 JSR CHKSBR ; check for overflow
0283: 32 LD EA, P2 ; get buffer pointer
0284: 8f 02 ST EA, @2, P3 ;
0286: 33 LD EA, P3 ; save new SBR pointer
0287: 8d de ST EA, SBRPTR
0289: 5f POP P3 ; restore P3
028a: 74 df BRA GOTO ; do GOTO
;------------------------------------------------------------------------------
; RETURN command
028c: 85 de RETURN: LD EA, SBRPTR ; get SBR ptr
028e: bd ca SUB EA, SBRSTK ; is stack empty?
0290: 6c 0c BZ RETERR ; yes error 8
0292: 85 de LD EA, SBRPTR ; decrement SBR ptr
0294: bc 02 00 SUB EA, =2
0297: 8d de ST EA, SBRPTR ; store it back
0299: 46 LD P2, EA ; into P2
029a: 82 00 LD EA, 0, P2 ; restore buffer pointer
029c: 46 LD P2, EA
029d: 16 CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
029e: 1f RETERR: CALL 15 ; ERROR
029f: 08 DB 8 ; 8 (return without gosub)
;------------------------------------------------------------------------------
; forward to UNTIL
02a0: 74 5f UNTIL: BRA UNTIL0 ; redirect to real code
;------------------------------------------------------------------------------
; REM
02a2: 20 91 01 REMCMD: CALL TOEOLN ; advance to end of line
02a5: c6 ff LD A, @X'ff, P2 ; back one char
02a7: 16 CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
; IF
02a8: 10 IFCMD: CALL 0 ; RELEXP get condition
02a9: 15 CALL 5 ; APULL pop it into EA
02aa: 58 OR A, E ; check for zero
02ab: 6c f5 BZ REMCMD ; false: advance to end of line
02ad: 23 cb 01 PLI P3, =CMDTB6 ; process THEN (may be missing)
02b0: 1b CALL 11 ; CMPTOK
;------------------------------------------------------------------------------
; LINK
02b1: 10 LINK: CALL 0 ; RELEXP get link address
02b2: 22 c2 04 PLI P2, DOLAL6-1 ; save P2, put return vector into P2
02b5: 15 CALL 5 ; APULL pop link address
02b6: 57 PUSH P3 ; push P3 on stack
02b7: 56 PUSH P2 ; put return vector on stack
02b8: bd e8 SUB EA, ONE ; adjust link address
02ba: 08 PUSH EA ; push on stack
02bb: 85 c6 LD EA, EXTRAM ; load P2 with base of variables
02bd: 46 LD P2, EA
02be: 5c RET ; return to link address
; note: the stack frame is (before RET):
; P2 = variables
; Top: linkaddress-1 (pulled by RET here)
; returnvector-1 (pulled by RET in called program)
; saved P3 (restored in returnvector stub)
; saved P2 (restored in returnvector stub)
;------------------------------------------------------------------------------
02bf: 46.. CMDTB7: DB 'FOR'
02c2: e4 DB X'e4 ; to FOR
02c3: 44.. DB 'DO'
02c5: a7 DB X'a7 ; to DO
02c6: 4f.. DB 'ON'
02c8: 8f DB X'8f ; to ON
02c9: 43.. DB 'CLEAR'
02ce: 85 DB X'85 ; to CLEAR
02cf: 80 DB X'80 ; to EXEC3
;------------------------------------------------------------------------------
; handle several commands for direct/program mode
02d0: 23 23 04 EXEC3: PLI P3, CMDTB8
02d3: 1b CALL 11 ; CMPTOK
;------------------------------------------------------------------------------
; CLEAR cmd
02d4: 20 c5 05 CLEAR: JSR INITA1 ; do warm initialization
02d7: 16 CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
; ON cmd
02d8: 10 ON: CALL 0 ; RELEXP get expression
02d9: 1c CALL 12 ; EXPECT check if comma follows
02da: 2c DB ','
02db: 01 DB 1 ; if not, continue next instruction
02dc: 15 ON1: CALL 5 ; APULL get expression
02dd: d4 01 AND A, =1 ; has it bit 0 set?
02df: 6c 07 BZ ON2 ; no, skip
02e1: cd e6 ST A, BRKFLG ; store nonzero in BRKFLG
02e3: 10 CALL 0 ; RELEXP get INTA vector expression
02e4: 15 CALL 5 ; APULL into EA
02e5: 8d e2 ST EA, INTAVC ; set as INTA call vector
02e7: 16 CALL 6 ; ENDCMD done
; assume here another bit set
02e8: 10 ON2: CALL 0 ; RELEXP get INTB vector expression
02e9: 15 CALL 5 ; APULL into EA
02ea: 8d e4 ST EA, INTBVC ; set as INTB call vector
02ec: 16 CALL 6 ; ENDCMD done
;------------------------------------------------------------------------------
; DO cmd
02ed: 85 da DO: LD EA, DOPTR ; get DO stack ptr
02ef: 57 PUSH P3 ; save P3
02f0: 47 LD P3, EA ; into P3
02f1: 85 ce LD EA, FORSTK ; put end of stack (FORSTK is adjacent)
02f3: cd f6 ST A, TMPF6 ; into temporary
02f5: 33 LD EA, P3 ; DO stack pointer
02f6: 20 c0 03 JSR CHKSBR ; check stack overflow
02f9: 32 LD EA, P2 ; get current program pointer
02fa: 8f 02 ST EA, @02, P3 ; push on DO stack
02fc: 33 LD EA, P3 ; and save new DO stack ptr
02fd: 5f POP P3 ; restore P3
02fe: 8d da DO1: ST EA, DOPTR
0300: 16 RET ; done
;------------------------------------------------------------------------------
;UNTIL command
0301: 10 UNTIL0: CALL 0 ; RELEXP get condition
0302: 85 da LD EA, DOPTR ; get DO stack ptr
0304: bd cc SUB EA, DOSTK ; subtrack stack base
0306: 58 OR A,E ; is empty?
0307: 7c 02 BNZ UNTIL1 ; no, continue
; otherwise throw error 11
0309: 1f CALL 15 ; ERROR
030a: 0b DB X'0b ; 11 (UNTIL without DO)
030b: 15 UNTIL1: CALL 5 ; APULL condition into EA
030c: 58 OR A,E ; is false?
030d: 6c 07 BZ UNTIL2 ; yes, skip
030f: 85 da LD EA, DOPTR ; no, discard DO loop from stack
0311: bc 02 00 SUB EA, =0002 ; 1 level
0314: 74 e8 BRA DO1 ; store back DO stack ptr and exit
0316: 85 da UNTIL2: LD EA, DOPTR ; do loop again
0318: 46 LD P2, EA ; get DO stack ptr
0319: 82 fe LD EA, X'fe, P2 ; get last level stored
031b: 46 LD P2, EA ; as new program pointer -> redo loop
031c: 16 RET ; done
;------------------------------------------------------------------------------
; for comparison of FOR keyword STEP
031d: 53 CMDTB9: DB 'STEP'
0321: 96 DB X'96 ; to FOR2
0322: 98 DB X'98 ; to FOR3
; for comparison of FOR keyword TO
0323: 54 CMDT10: DB 'TO'
0325: 8d DB X'8d ; to FOR1
0326: fd DB X'fd ; to SNERR2 (syntax error)
0327: 20 6c 05 FOR: JSR GETVAR ; get a variable address on stack
032a: 7a DB X'7a ; none found: goto SNERR2 (syntax error)
032b: 1c CALL 12 ; EXPECT a '='
032c: 3d DB '='
032d: 77 DB X'77 ; none found: goto SNERR2 (syntax error)
032e: 10 CALL 0 ; RELEXP get initial expression
032f: 23 23 03 PLI P3, =CMDT10 ; expect TO keyword (SNERR if not)
0332: 1b CALL 11 ; CMPTOK
0333: 10 FOR1: CALL 0 ; RELEXP get end expression
0334: 23 1d 03 PLI P3, =CMDTB9 ; check for STEP keyword, to FOR2 if found, to FOR3 if not
0337: 1b CALL 11 ; CMPTOK
0338: 10 FOR2: CALL 0 ; RELEXP get step expression
0339: 74 04 BRA FOR4 ; skip
033b: 85 e8 FOR3: LD EA, ONE ; push 1 as STEP on stack
033d: 8f 02 ST EA, @2, P3
033f: 85 dc FOR4: LD EA, FORPTR ; get the FOR stack ptr
0341: 56 PUSH P2 ; save current program ptr
0342: 46 LD P2, EA ; into P2
0343: 85 d0 LD EA, BUFAD ; put end of stack (BUFAD is adjacent)
0345: cd f6 ST A, TMPF6 ; into temporary
0347: 32 LD EA, P2 ; FOR stack ptr
0348: 20 c0 03 JSR CHKSBR ; check stack overflow
034b: 15 CALL 5 ; APULL restore step value
034c: 8e 02 ST EA, @2, P2 ; save at forstack+0
034e: 15 CALL 5 ; APULL restore end value
034f: 8e 02 ST EA, @2, P2 ; save at forstack+2
0351: 15 CALL 5 ; APULL restore initial value
0352: 09 LD T, EA ; save in T
0353: 15 CALL 5 ; APULL restore variable address
0354: 8d f6 ST EA, TMPF6 ; store address in temporary
0356: ce 01 ST A, @1, P2 ; save low offset of var at forstack+4
0358: 81 00 LD EA, 0, SP ; get current program ptr
035a: 8e 02 ST EA, @2, P2 ; save at forstack+5
035c: 32 LD EA, P2 ; save new FOR stack ptr
035d: 8d dc ST EA, FORPTR
035f: 85 f6 LD EA, TMPF6 ; get variable address
0361: 46 LD P2, EA ; into P2
0362: 0b LD EA, T ; initial value
0363: 8a 00 ST EA, 0, P2 ; save in variable
0365: 5e FOR5: POP P2 ; restore program pointer
0366: 16 CALL 6 ; ENDCMD
; note the FOR stack frame looks like the following:
; offset 0: DW step value
; offset 2: DW end value
; offset 4: DB variable low offset
; offset 5: DW program pointer of first statement of loop
0367: 1f NXERR: CALL 15 ; ERROR
0368: 0a DB 10 ; 10 (NEXT without FOR)
; NEXT command
0369: 20 6c 05 NEXT0: JSR GETVAR ; get variable address on stack
036c: 38 DB X'38 ; no var found, goto SNERR2 (syntax error)
036d: 15 CALL 5 ; APULL restore address
036e: 09 LD T, EA ; put into T
036f: 85 dc NEXT1: LD EA, FORPTR ; get FOR stack ptr
0371: bd ce SUB EA, FORSTK ; subtract base
0373: 6c f2 BZ NXERR ; is empty? yes, NEXT without FOR error
0375: 85 dc LD EA, FORPTR ; get FOR stack ptr again
0377: bc 07 00 SUB EA, =0007 ; discard current frame
037a: 8d dc ST EA, FORPTR ; save it for the case loop ends
037c: 56 PUSH P2 ; save program pointer
037d: 46 LD P2, EA ; point to base of current FOR frame
037e: 0b LD EA, T ; get var address
037f: fa 04 SUB A, 4, P2 ; subtract var addr of this frame
0381: 6c 03 BZ NEXT2 ; is the same?, yes skip (found)
0383: 5e POP P2 ; restore P2
0384: 74 e9 BRA NEXT1 ; try another loop - assume jump out of loop
0386: c2 01 NEXT2: LD A, 1, P2 ; step value (high byte)
0388: 64 09 BP NEXT3 ; is step positive? yes, skip
038a: 20 a5 03 JSR NXADD ; add step and compare with end value
038d: e4 ff XOR A, =X'ff ; compare with -1
038f: 6c BZ NEXT5 ; zero? yes, end of loop not yet reached
0391: 74 03 BRA NEXT4 ; skip
0393: 20 a5 03 NEXT3: JSR NXADD ; add step and compare with end value
0396: 64 cd NEXT4: BP FOR5 ; end of loop done, continue after NEXT
0398: 82 05 NEXT5: LD EA, 5, P2 ; get start of loop program pointer
039a: 5e POP P2 ; drop P2
039b: 46 LD P2, EA ; set start of loop again
039c: 85 dc LD FORPTR ; get FOR stack ptr
039e: b4 07 00 ADD EA, =0007 ; push loop frame again
03a1: 8d dc ST EA, FORPTR ; save new FOR ptr
03a3: 16 RET ; done
03a4: 1f SNERR2: CALL 15 ; ERROR
03a5: 04 DB 4 ; 4 (syntax error)
;------------------------------------------------------------------------------
; add step and compare with end value
03a6: 85 c6 NXADD: LD EA, EXTRAM ; variable base
03a8: c2 04 LD A, 4, P2 ; get variable offset
03aa: 57 PUSH P3 ; save P3
03ab: 47 LD P3, EA ; into EA
03ac: 83 00 LD EA, 0, P3 ; get variable value
03ae: b2 00 ADD EA, 0, P2 ; add step value
03b0: 8b 00 ST EA, 0, P3 ; store new variable
03b2: 5f POP P3 ; restore P3
03b3: ba 02 SUB EA, 2, P2 ; compare with end value
03b5: 6c 04 BZ NXADD2 ; same?
03b7: 01 XCH A, E ; no, swap: A = high byte
03b8: d4 80 NXADD1: AND A, =X'80 ; mask out sign bit
03ba: 5c RET ; return
03bb: 01 NXADD2: XCH A, E ; swap: A = high byte
03bc: 7c fa BNZ NXADD1 ; not same? get high byte
03be: c4 ff LD A, =X'ff ; set A = -1
03c0: 5c RET ; return
;------------------------------------------------------------------------------
; check for SBR stack overflow
; EA contains current stack pointer, TMPF6 contains limit
03c1: fd f6 CHKSBR: SUB A, TMPF6 ; subrack limit
03c3: 64 01 BP NSERR ; beyond limit?
03c5: 5c RET ; no, exit
; otherwise nesting too deep error
03c6: 1f NSERR: CALL 15 ; ERROR
03c7: 09 DB 9 ; 9 (nesting too deep)
;------------------------------------------------------------------------------
03c8: 1f SUERR: CALL 15 ; ERROR
03c9: 02 DB 2 ; 2 (stmt used improperly)
;------------------------------------------------------------------------------
; INPUT handler
03ca: c5 c2 INPUT0: LD A, INPMOD ; is in direct mode?
03cc: 6c fa BZ SUERR ; yes, this is an error!
03ce: 32 LD EA, P2 ; save current program ptr temporarily
03cf: 8d f2 ST EA, TMPF2
03d1: 20 6c 05 INPUT1: JSR GETVAR ; get variable address on stack
03d4: 29 DB X'29 ; no variable, goto INPUT3 (could be $)
03d5: c4 03 LD A, =03 ; set mode 3, swap buffers (P2 is input buffer)
03d7: 20 1a 04 JSR SWPBUF
03da: 20 4c 08 JSR GETLN ; get line into input buffer
03dd: 10 INPUT2: CALL 0 ; RELEXP get expression from input buffer
03de: 15 CALL 5 ; APULL into EA
03df: 09 LD T, EA ; save into T
03e0: 15 CALL 5 ; APULL get variable address
03e1: 57 PUSH P3 ; save P3
03e2: 47 LD P3, EA ; into P3
03e3: 0b LD EA, T ; obtain expression
03e4: 8b 00 ST EA, 0, P3 ; save into variable
03e6: 5f POP P3 ; restore P3
03e7: c4 01 LD A, =01 ; set mode 1, swap buffers (P2 is program ptr)
03e9: 20 1a 04 JSR SWPBUF
03ec: 1c CALL 12 ; EXPECT a comma
03ed: 2c DB ','
03ee: 2c DB X'2c ; if not found, exit via INPUT5
03ef: 20 6c 05 JSR GETVAR ; get another variable
03f2: d6 DB X'd6 ; if none found, goto SUERR (error 2)
; does not accept $ any more here
03f3: c4 03 LD A, =03 ; set mode 3, swap buffers (P2 is input buffer)
03f5: 20 1a 04 JSR SWPBUF
03f8: 1c CALL 12 ; EXPECT an optional comma in input buffer
03f9: 2c DB ','
03fa: 01 DB 1 ; none found, ignore
03fb: 74 e0 BRA INPUT2 ; process the next variable
; process $expr for string input
03fd: 1c INPUT3: CALL 12 ; EXPECT a $ here
03fe: 24 DB '$'
03ff: c9 DB X'c9 ; none found, goto SUERR
0400: 11 CALL 1 ; FACTOR get string buffer address
0401: c4 03 LD A, =03 ; set mode 3, swap buffers (P2 is input buffer)
0403: 20 1a 04 JSR SWPBUF
0406: 20 4c 08 JSR GETLN ; get line of input
0409: 15 CALL 5 ; APULL get buffer address
040a: 57 PUSH P3 ; save P3
040b: 47 LD P3, EA ; into P3
040c: c6 01 INPUT4: LD A, @1, P2 ; copy input from buffer into string
040e: cf 01 ST A, @1, P3
0410: e4 0d XOR A, =CR ; until CR seen
0412: 7c f8 BNZ INPUT4
0414: 5f POP P3 ; restore P3
0415: c4 01 LD A, =01 ; set mode 1 again, swap buffers (P2 is program ptr)
0417: 20 1a 04 JSR SWPBUF
041a: 16 INPUT5: CALL 6 ; ENDCMD done
;------------------------------------------------------------------------------
; save input mode and swap buffers
041b: cd c2 SWPBUF: ST A, INPMOD ; store new input mode
041d: 85 f0 LD EA, TMPF0 ; swap buffer addresses
041f: 4e XCH P2, EA ; TMPF0 normally contains input buffer address
0420: 8d f0 ST EA, TMPF0
0422: 5c RET
;------------------------------------------------------------------------------
; several more commands
0423: 44.. CMDTB8: DB 'DELAY'
0428: 9a DB X'9a ; to DELAY
0429: 49.. DB 'INPUT'
042e: 8f DB X'8f ; to INPUT
042f: 50.. DB 'PRINT'
0434: 8b DB X'8b ; to PRINT
0435: 50.. DB 'PR'
0437: 88 DB X'88 ; to PRINT
0438: 53.. DB 'STOP'
043c: 91 DB X'91 ; to STOP
043d: 9d DB X'9d ; default to ASSIGN
;------------------------------------------------------------------------------
; INPUT cmd
043e: 74 8a INPUT: BRA INPUT0 ; INPUT handler
;------------------------------------------------------------------------------
; PRINT cmd
0440: 24 c9 04 PRINT: JMP PRINT0 ; PRINT handler
;------------------------------------------------------------------------------
; DELAY cmd
0443: 10 DELAY: CALL 0 ; RELEXP get delay expression
0444: 15 CALL 5 ; APULL into EA
0445: a4 3f 00 LD T, =X'003f ; multiply with 63
0448: 2c MPY EA, T
0449: 0b LD EA, T ; into EA
044a: 20 ca 09 JSR DELAYC ; do delay
044d: 16 RET ; done
;------------------------------------------------------------------------------
; STOP cmd
044e: 24 99 00 STOP: JMP MAINLP ; directly enter main loop
;------------------------------------------------------------------------------
; left hand side (LHS) operators for assigment
0451: 53.. CMDTB4: DB 'STAT'
0455: 89 DB X'89 ; to STATLH
0456: 40 DB '@'
0457: 92 DB X'92 ; to ATLH
0458: 24 DB '$'
0459: b1 DB X'b1 ; to DOLALH
045a: 9e DB X'9e ; default case to ASSIG1
;------------------------------------------------------------------------------
; handle assignments
045b: 23 51 04 ASSIGN: PLI P3, CMDTB4
045e: 1b CALL 11 ; CMPTOK
;------------------------------------------------------------------------------
; STAT on left hand side
045f: 1c STATLH: CALL 12 ; EXPECT an equal symbol
0460: 3d DB '=' ;
0461: 67 DB X'67 ; not found, goto SNERR
0462: 10 CALL 0 ; RELEXP get the right hand side
0463: 15 CALL 5 ; APULL into EA
0464: 07 LD S, A ; put into SR (only low byte)
0465: c4 01 LD A, =1 ; suppress potential INT that could
0467: cd e7 ST A, NOINT ; result from changing SA/SB
0469: 16 CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
; @ on left hand side (POKE)
046a: 11 ATLH: CALL 1 ; FACTOR get non-boolean expression
046b: 1c CALL 12 ; EXPECT an equal symbol
046c: 3d DB '='
046d: 5b DB X'5b ; not found, goto SNERR (syntax error)
046e: 10 CALL 0 ; RELEXP get right hand side
046f: 15 CALL 5 ; APULL into EA
0470: 09 LD T, EA ; into T
0471: 15 CALL 5 ; APULL get target address
0472: 57 PUSH P3 ; save P3
0473: 47 LD P3, EA ; into P3
0474: 0b LD EA, T ; RHS into EA
0475: cb 00 ST A, 0, P3 ; store low byte at address
0477: 5f POP P3
0478: 16 RET
;------------------------------------------------------------------------------
; default case for assign (VAR = expr)
0479: 20 6c 05 ASSIG1: JSR GETVAR ; get a variable
047c: 4c DB X'4c ; if not var, goto DOLAL4 (assume $xxxx)
047d: 1c CALL 12 ; EXPECT an equal symbol
047e: 3d DB '='
047f: 49 DB X'49 ; not found, go to SNERR
0480: 10 CALL 0 ; RELEXP get right hand side
0481: 15 CALL 5 ; APULL into EA
0482: 09 LD T, EA ; into T
0483: 15 CALL 5 ; APULL get variable address
0484: 57 PUSH P3 ; save P3
0485: 47 LD P3, EA ; into P3
0486: 0b LD EA, T ; get RHS
0487: 8b 00 ST EA, 0, P3 ; store result into variable
0489: 5f POP P3 ; restore P3
048a: 16 CALL 6 ; ENDCMD done
;------------------------------------------------------------------------------
; $ on left hand side
048b: 11 DOLALH: CALL 1 ; FACTOR get target address
048c: 1c CALL 12 ; EXPECT an equal symbol
048d: 3d DB '='
048e: 3a DB X'3a ; if not found, goto SNERR
048f: c2 00 LD A, 0, P2 ; get next char from program
0491: e4 22 XOR A, X'22 ; is double quote?
0493: 7c 1c BNZ DOLAL3 ; not a constant string, may be string assign
0495: c6 01 LD A, @1, P2 ; skip over quote
0497: 15 CALL 5 ; APULL get target address
0498: 57 PUSH P3 ; save P3
0499: 47 LD P3, EA ; into P3
049a: c6 01 DOLAL1: LD A, @1, P2 ; get string char from program buffer
049c: e4 22 XOR A, =X'22 ; is double quote?
049e: 6c 0a BZ DOLAL2 ; yes, end of string, skip
04a0: e4 2f XOR A, =X'2f ; is CR?
04a2: 6c 22 BZ EQERR ; yes, ending quote missing error
04a4: e4 0d XOR A, =X'0d ; convert back to original char
04a6: cf 01 ST A, @1, P3 ; store into target buffer
04a8: 74 f0 BRA DOLAL1 ; loop
04aa: c4 0d DOLAL2: LD A, =CR ; terminate target string
04ac: cb 00 ST A, 0, P3
04ae: 5f POP P3 ; restore P3
04af: 19 CALL 9 ; GETCHR get next char from program
04b0: 16 CALL 6 ; ENDCMD done
; assume string assign
04b1: 1c DOLAL3: CALL 12 ; EXPECT a $
04b2: 24 DB '$'
04b3: 15 DB X'15 ; not found, goto SNERR
04b4: 11 CALL 1 ; FACTOR get source address
04b5: 15 CALL 5 ; APULL into EA
04b6: 56 PUSH P2 ; save P2
04b7: 46 LD P2, EA ; into P2
04b8: 15 DOLAL4: CALL 5 ; APULL get target address
04b9: 57 PUSH P3 ; save P3
04ba: 47 LD P3, EA ; into P3
04bb: c6 01 DOLAL5: LD A, @1, P2 ; move byte from source to targer
04bd: cf 01 ST A, @1, P3
04bf: e4 0d XOR A, =CR ; compare with CR
04c1: 7c f8 BNZ DOLAL5 ; not yet, continue copying
;------------------------------------------------------------------------------
; This location is also the return point form LINK
04c3: 5f DOLAL6: POP P3 ; restore P3
04c4: 5e POP P2 ; restore P2
04c5: 16 CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
04c6: 1f EQERR: CALL 15 ; ERROR
04c7: 06 DB 6 ; 6 (ending quote missing)
;------------------------------------------------------------------------------
04c8: 1f SNERR: CALL 15 ; ERROR
04c9: 04 DB 4 ; 4 (syntax error)
;------------------------------------------------------------------------------
; PRINT handler
04ca: c2 00 PRINT0: LD A, 0, P2 ; get char from program
04cc: e4 22 XOR A, X'22 ; is double quote?
04ce: 7c 11 BNZ PRINT2 ; no, not a string print
; print a string constant
04d0: c6 01 LD A, @1, P2 ; skip over quote
04d2: c6 01 PRINT1: LD A, @1, P2 ; get next char
04d4: e4 22 XOR A, =X'22 ; is double quote?
04d6: 6c 18 BZ PRINT4 ; yes, done with print