forked from iruka-git/SCMP3Emulator
-
Notifications
You must be signed in to change notification settings - Fork 0
/
nibl3.asm
2058 lines (1905 loc) · 69.7 KB
/
nibl3.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)
cpu 8070
; locations in on-chip RAM
MULOV = 0xffc0 ; DW high 16 bit from MPY
INPMOD = 0xffc2 ; DB input mode: 0x00 interactive, <>0 in INPUT, 01: running
CURRNT = 0xffc3 ; DW current line number executed
RUNMOD = 0xffc5 ; DB runmode 'R', 0x00
EXTRAM = 0xffc6 ; DW start of variables (26 words)
AESTK = 0xffc8 ; DW start of arithmetic stack (13 words)
SBRSTK = 0xffca ; DW start of GOSUB stack (10 words)
DOSTK = 0xffcc ; DW start of DO stack (10 words)
FORSTK = 0xffce ; DW start of FOR stack (28 words)
BUFAD = 0xffd0 ; DW
STACK = 0xffd2 ; DW top of stack
TXTBGN = 0xffd4 ; DW start of program area
TXTUNF = 0xffd6 ; DW
TXTEND = 0xffd8 ; DW end of program area
DOPTR = 0xffda ; DW ptr to DO level?
FORPTR = 0xffdc ; DW ptr to FOR level?
SBRPTR = 0xffde ; DW ptr to GOSUB level?
INTVEC = 0xffe0 ; DW current interrupt vector
INTAVC = 0xffe2 ; DW Interrupt A vector
INTBVC = 0xffe4 ; DW Interrupt B vector
BRKFLG = 0xffe6 ; DB if 0 check for BREAK from serial
NOINT = 0xffe7 ; DB flag to suppress INT after having set STAT
ONE = 0xffe8 ; DW constant 1
ZERO = 0xffea ; DW constant 0
DLYTIM = 0xffec ; DW delay value for serial I/O
CONTP = 0xffee ; DW buffer pointer for CONT
TMPF0 = 0xfff0 ; DW temporary for moving program code for insertion
TMPF2 = 0xfff2 ; DW temp store for current program pointer
RNDNUM = 0xfff4 ; DW rnd number
TMPF6 = 0xfff6 ; DB,DW temporary
UNUSE1 = 0xfff8 ; DW unused
TMPFB = 0xfffb ; DB,DW temporary
TMPFC = 0xfffc ; DB,DW temporary (overlaps TMPFB)
TMPFE = 0xfffe ; DW temporary, alias
; more constants
RAMBASE = 0x1000 ; start of RAM
ROMBASE = 0x1400 ; potential start of a ROM (BASIC AREA)
BAUDFLG = 0xFD00 ; address of baudrate selection bits
BS = 0x08 ; back space
CR = 0x0d ; carriage return
LF = 0x0a ; line feed
NAK = 0x15 ; CTRL-U, NAK
SPACE = ' ' ; space character
GTR = '>' ; prompt for interactive mode
QUEST = '?' ; prompt for input mode
CARET = '^' ; prefix for CTRL output
; interpreter starts here
; assumptions "should be" refer to 1K RAM at 0x1000-0x13ff)
ORG 0
NOP ; lost byte because of PC preincrement
JMP COLD ; Jump to cold start
JMP INTA ; Jump to interrupt a handler
JMP INTB ; Jump to interrupt b handler
COLD: LD EA, =ROMBASE ; bottom address of ROM
COLD1: ST EA, TXTBGN ; set begin of text to ROM
LD EA, =RAMBASE ; set P2 to point to base of RAM
LD P2, EA ;
COLD2: JSR TSTRAM1 ; test for RAM at loc P2
BNZ COLD2 ; not zero: no RAM, loop
LD EA, P2 ; found RAM, get address
SUB EA, =1 ; subtract 1 to get the current position
BNZ COLD2 ; is not at xx00, search next
BRA COLD3 ; found a page skip over call tbl, continue below
; short CALL table
DW RELEXP-1 ; call 0 (RELEXP)
DW FACTOR-1 ; call 1 (FACTOR)
DW SAVOP-1 ; call 2 (SAVOP)
DW COMPAR-1 ; call 3 (COMPAR)
DW APUSH-1 ; call 4 (APUSH)
DW APULL-1 ; call 5 (APULL)
DW ENDCMD-1 ; call 6 (ENDCMD)
DW PUTC-1 ; call 7 (PUTC)
DW CRLF-1 ; call 8 (CRLF)
DW GETCHR-1 ; call 9 (GETCHR)
DW NEGATE-1 ; call 10 (NEGATE)
DW CMPTOK-1 ; call 11 (CMPTOK)
DW EXPECT-1 ; call 12 (EXPECT c, offset)
DW NUMBER-1 ; call 13 (NUMBER, offset)
DW PRTLN-1 ; call 14 (PRTLN)
DW ERROR-1 ; call 15 (ERROR)
; continues here from cold start
COLD3: ST EA, EXTRAM ; arrive here with xx00, store it (should be 0x1000)
ADD EA, =0x0100 ; add 256
ST EA, STACK ; store as STACK address (should be 0x1100)
LD SP, EA ; initialize stack pointer
COLD4: JSR TSTRAM1 ; check RAM at current pos P2 (should be 0x1000)
BZ COLD4 ; advance until no longer RAM
; P2 points to last RAM+2
LD A, @-2, P2 ; subtract 2 from P2
LD EA, P2 ; get last RAM address
ST EA, TXTEND ; store at end of text (should be 0x13ff)
LD EA, TXTBGN ; load begin of ROM text (0x8000)
LD P2, EA ; put into P2
JSR TSTRAM1 ; is there RAM?
BZ COLD5 ; yes, skip
JMP RUN ; no, this could be a ROM program, run it
COLD5: LD EA, STACK ; get stack top
SUB EA, TXTBGN ; subtract begin of program
LD A, S ; get carry bit
BP COLD6 ; not set, skip
LD EA, STACK ; get stack top
ST EA, TXTBGN ; make it new TXTBGN
COLD6: LD A, RUNMOD ; get mode
XOR A, ='R' ; is it 'R'?
BZ MAINLP ; yes, skip
JSR INITAL ; intialize all interpreter variables
BRA MAIN ; continue
ENDRAM1:
LD A, =0xff ; if P2>=0x8000 then return NonZero(RAM END)
RET
TSTRAM1:
LD EA,P2
LD A,E
SUB A, =0x80
BP ENDRAM1
; check RAM at loc P2; return 0 if found, nonzero if no RAM
TSTRAM: LD A, @1, P2 ; get value from RAM, autoincrement
LD E, A ; save old value into E (e.g. 0x55)
XOR A, =0xff ; complement value (e.g. 0xAA)
ST A, -1, P2 ; store it back (0xAA)
XOR A, -1, P2 ; read back and compare (should be 0x00)
XCH A, E ; A=old value, E=0x00 (if RAM)
ST A, -1, P2 ; store back old value
XOR A, -1, P2 ; read back and compare (should be 0x00)
OR A, E ; or both tests, should be 0x00 if RAM)
RET ; return zero, if RAM, nonzero if none
; NEW command
NEW: JSR INITAL ; initialize interpreter variables
LD A, 0, P2 ; get a char from current program position (initially ROMBASE)
XOR A, =CR ; is char a CR?
BZ MAIN ; yes, skip to program
CALL 0
CALL 5 ; APULL
JMP COLD1 ; back to cold start
MAIN: LD EA, TXTBGN ; get start of program area
ST EA, TXTUNF ; store as end of program
LD P2, EA ; point P2 to it
LD A, =0x7f ; set end of program flag
ST A, 0, P2 ; at that position
; main interpreter loop
MAINLP: LD EA, STACK ; reinitialize stack
LD SP, EA
LD EA, EXTRAM ; start of RAM
ADD EA, =52 ; offset to AESTK
ST EA, AESTK ; set position of arithmetic stack
LD P3, EA ; P3 is arith stack pointer
JSR INITBD ; initialize baud rate
CALL 8 ; CRLF
LD A, INPMOD ; mode flag?
BZ MAINL2 ; zero, skip
; no, this is a break CTRL-C
LD EA, P2 ; current pointion of buffer
ST EA, CONTP ; save position (for CONT)
PLI P2, =STOPMSG ; STOP message
CALL 14 ; PRTLN
POP P2 ; restore P2
JSR PRTAT ; print AT line#
MAINL1: CALL 8 ; CRLF
MAINL2: LD EA, AESTK ; initialize P3 with AESTK
LD P3, EA
LD EA, =0 ; initialize constant ZERO
ST EA, ZERO
ST A, INPMOD ; set cmd mode=0
LD A, =1 ; initialize constant ONE
ST EA, ONE
JSR GETLN ; read a line into buffer
CALL 9 ; GETCHR
CALL 13 ; NUMBER
DB 0x85 ; not a number, skip to DIRECT
LD EA, TXTBGN ; start of program
SUB EA, ONE ; minus 1
SUB EA, TXTUNF ; subtract end of program
LD A, S ; get status
BP MAINL3 ; overflow? no, skip
CALL 15 ; ERROR
DB 1 ; 1 (out of mem)
MAINL3: LD EA, P2 ; get buffer pointer
ST EA, TMPF0 ; save it
JSR FINDLN ; find line in program
BNZ MAINL4 ; no match, skip
PUSH P2 ; save p2 (line begin)
JSR TOEOLN ; advance to end of line
LD EA, 0, SP ; get line begin (P2)
LD P3, EA ; into P3
LD EA, P2 ; get end of line from TOEOLN
CALL 10 ; NEGATE
PUSH EA ; save -endline
ADD EA, ONE ; add one (for CR)
ADD EA, TXTUNF ; add end of program area
ST EA, TMPFE ; store number of bytes to move
POP EA ; restore -endline
ADD EA, 0, SP ; subtract from start to get number of bytes to move
ADD EA, TXTUNF ; add end of program area
ST EA, TXTUNF ; set a new end of program
JSR BMOVE ; move area
POP P2 ; restore start of line
; replace or add line
MAINL4: LD EA, P2 ; copy into P3
LD P3, EA
LD EA, TMPF0 ; buffer pointer
LD P2, EA ; into P2
CALL 9 ; GETCHR
XOR A, =CR ; is it a single line number?
BZ MAINL2 ; yes, ignore that
LD EA, BUFAD ; address of buffer
LD P2, EA ; into P2
CALL 9 ; GETCHR
LD EA, P2 ; save buffer pointer
ST EA, TMPF6
JSR TOEOLN ; advance to end of line
LD EA, P2 ; get end of line
SUB EA, TMPF6 ; subtract to get length of buffer
ST EA, TMPFE ; store number of bytes to move
ADD EA, TXTUNF ; add temporary end of buffer
SUB EA, TXTEND ; store as new end of program
SUB EA, ONE ; subtract one
XCH A, E ; is result negative?
BP OMERR ; out of memory error
PUSH P3 ; save P3
LD EA, TXTUNF ; get tmp area
LD P2, EA ; into P2
LD EA, P3 ; line to insert
SUB EA, TXTUNF ; subtract tmp buf
CALL 10 ; NEGATE
ST EA, TMPFB ; number of bytes to expand
OR A, E ; is result zero?
PUSH A ; save it for later check
LD EA, TXTUNF ; tmp buf
ADD EA, TMPFE ; add length of line
ST EA, TXTUNF ; store
LD P3, EA ; into P3
LD A, 0, P2 ; copy a byte
ST A, 0, P3
POP A ; restore result from above (sets Z flag)
BZ MAINL6 ; was zero, skip
MAINL5: LD A, @-1, P2 ; otherwise copy backwards TMPFB bytes
ST A, @-1, P3
DLD A, TMPFB ; decrement byte counter
BNZ MAINL5
LD A, TMPFB+1
BZ MAINL6 ; exit loop if zero
DLD A, TMPFB+1
BRA MAINL5 ; loop
MAINL6: POP P3 ; restore target location
LD EA, TMPF6
LD P2, EA ; restore source location
JSR BMOVE ; move new line into program
MAINL7: JMP MAINL2 ; done, continue in main loop
; parse a direct command
DIRECT: LD A, 0, P2 ; get char from buffer
XOR A, =CR ; is it a CR?
BZ MAINL7 ; yes, continue in main loop
PLI P3, =CMDTB1 ; load first CMD table
CALL 11 ; CMPTOK
; out of memory error
OMERR: CALL 15 ; ERROR
DB 1 ; 1 (out of memory)
;--------------------------------------------------------------------------------------------------
; move TMPFE bytes ascending from @P2 to @P3
BMOVE: LD A, @1, P2 ; get char from first pos
ST A, @1, P3 ; store into second
DLD A, TMPFE ; decrement byte counter 16 bit
BNZ BMOVE
LD A, TMPFE+1
BZ BMOVE1 ; exit if zero
DLD A, TMPFE+1
BRA BMOVE ; loop
BMOVE1: RET
;--------------------------------------------------------------------------------------------------
; find line in program, 0 = found, 1 = insert before, -1 = not found, line in P2
; line number to find is on AESTK
FINDLN: LD EA, TXTBGN ; get start of program
LD P2, EA ; into P2
FINDL1: LD EA, P2 ; get P2
ST EA, TMPFB ; save temporary
CALL 9 ; GETCHR
CALL 13 ; NUMBER
DB 0x18 ; skip if not number to FINDL4
CALL 5 ; APULL
SUB EA, -2, P3 ; subtract number from the one on stack (the line number found)
XCH A, E ; is larger?
BP FINDL2 ; yes skip
JSR TOEOLN ; advance to end of line
BRA FINDL1 ; loop
FINDL2: OR A, E
BZ FINDL3 ; is exactly the same?
LD A, =01 ; no, return 1
FINDL3: PUSH A
CALL 5 ; APULL
LD EA, TMPFB ; get start of this line
LD P2, EA ; into P2
POP A ; restore result
RET ; return with 0, if exact match, 1 if insert
FINDL4: LD A, =0xff ; return with -1: end of program
BRA FINDL3
;--------------------------------------------------------------------------------------------------
; advance to end of line
TOEOLN: LD A, =CR ; search for end of line
SSM P2 ; should be within next 256 bytes
BRA UCERR ; didn't find one, error 3
RET ; found one, return with P2 pointing to char after CR
;--------------------------------------------------------------------------------------------------
; set of DIRECT commands
CMDTB1: DB 'LIST'
DB 0x93 ; to LIST
DB 'NEW'
DB 0x8a ; to NEW2
DB 'RUN'
DB 0xb5 ; to RUN
DB 'CONT'
DB 0xa7 ; to CONT
DB 0xd2 ; default case to EXEC1
;--------------------------------------------------------------------------------------------------
; NEW command
NEW2: JMP NEW ; do new command
;--------------------------------------------------------------------------------------------------
UCERR: CALL 15 ; ERROR
DB 3 ; 3 (unexpected char)
;--------------------------------------------------------------------------------------------------
; LIST command
LIST: CALL 13 ; NUMBER
DB 3 ; if no number, skip to LIST0
BRA LIST1
LIST0: LD EA, ZERO ; no number given, start with line 0
CALL 4 ; APUSH put on stack
LIST1: JSR FINDLN ; find line in program, or next one
LIST2: CALL 9 ; GETCHR from location found
PUSH P2
CALL 13 ; NUMBER
DB 0x0a ; if error, goto LIST3
CALL 5 ; APULL
POP P2
CALL 14 ; PRTLN
CALL 8 ; CRLF
JSR CHKBRK ; test break
BRA LIST2
LIST3: POP P2
MAIN1: JMP MAINLP
;--------------------------------------------------------------------------------------------------
CMDTB6: DB 'THEN' ; then table
DB 0xad ; to EXEC1
DB 0xac ; default case to EXEC1
;--------------------------------------------------------------------------------------------------
; CONT command
CONT: LD EA, CONTP ; restore program pointer from CONT
LD P2, EA
LD A, =01 ; set program mode
ST A, INPMOD
BRA ENDCM1
;--------------------------------------------------------------------------------------------------
; RUN command
RUN: JSR INITAL ; initialize interpreter variables
LD A, =01 ; set "running mode"
ST A, INPMOD
LD EA, TXTBGN ; start at first line
LD P2, EA ; in buffer
BRA RUN2 ; skip
RUN1: LD A, INPMOD
BZ MAIN1
RUN2: LD EA, ZERO ; load 0
CALL 4 ; APUSH
RUN3: JSR FINDL1 ; find line from current position
BP RUN4 ; found one
LD A, =00 ; set 'not running'
ST A, INPMOD
BRA MAIN1 ; back to mainloop
RUN4: CALL 13 ; parse line NUMBER
DB 8 ; not found: syntax error, goto SNERR1
CALL 5 ; APULL line number
ST EA, CURRNT ; set as current line
EXEC1: PLI P3, =CMDTB2 ; run loop
CALL 11 ; process commands
SNERR1: CALL 15 ; ERROR
DB 4 ; 4 (syntax error)
;--------------------------------------------------------------------------------------------------
; handle end of CMD, check for break or interrupts... (call 6)
ENDCMD: POP EA ; drop return address
LD A, 0xffe7 ; flag set?
BNZ ENDCM1 ; yes, skip
LD A, INPMOD ; interactive mode?
BZ ENDCM1 ; yes skip
LD EA, INTVEC ; interrupt pending?
OR A, E
BNZ ENDCM3 ; yes, skip
ENDCM1: LD A, =0
ST A, NOINT
JSR CHKBRK ; check for break
CALL 12 ; EXPECT
DB ':' ; colon?
DB 0x03 ; no, to ENDCM2
BRA EXEC1 ; continue run loop
ENDCM2: LD A, @1, P2 ; advance to next char
XOR A, =CR ; is it end of line?
BNZ UCERR ; error unexpected char
BRA RUN1 ; continue
ENDCM3: LD EA, INTVEC ; get pending int vector
CALL 4 ; APUSH
LD EA, ZERO ;
ST EA, INTVEC ; clear pending int
BRA GOSUB1 ; jump into GOSUB (process interrupt)
CMDTB2: DB 'LET'
DB 0xa6 ; to LET
DB 'IF'
DB 0xf3 ; to IFCMD
DB 'LINK'
DB 0xf7 ; to LINK
DB 'NEXT'
DB 0x9c ; to NEXT
DB 'UNTIL'
DB 0xdb ; to UNTIL
DB 'GO'
DB 0x96 ; to GOCMD
DB 'RETURN'
DB 0xbd ; to RETURN
DB 'REM'
DB 0xcf ; to REMCMD
DB 0x80 ; default case to EXEC2
EXEC2: PLI P3, =CMDTB7 ; load table 7
CALL 11 ; CMPTOK
;------------------------------------------------------------------------------
; forward to assignment
LET: JMP ASSIGN ; ignore LET and continue with general assigment
;------------------------------------------------------------------------------
; forward to NEXT cmd
NEXT: JMP NEXT0 ; handle NEXT
;------------------------------------------------------------------------------
; handle GOTO or GOSUB
GOCMD: PLI P3, =CMDTB5 ; check for TO or SUB
CALL 11
CMDTB5: DB 'TO'
DB 0x85 ; to GOTO
DB 'SUB'
DB 0x8d
DB 0x80 ; default case to GOTO
;------------------------------------------------------------------------------
; GOTO command
GOTO: CALL 0 ; RELEXP
GOTO1: LD A, =1 ;
ST A, INPMOD ; set 'running mode'
JSR FINDLN ; find line in buffer
BZ RUN4 ; skip to line number check
CALL 15 ; error
DB 7 ; 7 (goto target does not exist)
;------------------------------------------------------------------------------
; GOSUB command
GOSUB: CALL 0 ; RELEXP
GOSUB1: LD EA, SBRPTR ; get SBR stack pointer
PUSH P3 ; save P3
LD P3, EA ; SBR stack in P3
LD EA, DOSTK ; mark do stack pointer
ST A, TMPF6 ; in temporary
LD EA, P3 ; get SBR stack ptr
JSR CHKSBR ; check for overflow
LD EA, P2 ; get buffer pointer
ST EA, @2, P3 ;
LD EA, P3 ; save new SBR pointer
ST EA, SBRPTR
POP P3 ; restore P3
BRA GOTO1 ; do GOTO
;------------------------------------------------------------------------------
; RETURN command
RETURN: LD EA, SBRPTR ; get SBR ptr
SUB EA, SBRSTK ; is stack empty?
BZ RETERR ; yes error 8
LD EA, SBRPTR ; decrement SBR ptr
SUB EA, =2
ST EA, SBRPTR ; store it back
LD P2, EA ; into P2
LD EA, 0, P2 ; restore buffer pointer
LD P2, EA
CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
RETERR: CALL 15 ; ERROR
DB 8 ; 8 (return without gosub)
;------------------------------------------------------------------------------
; forward to UNTIL
UNTIL: BRA UNTIL0 ; redirect to real code
;------------------------------------------------------------------------------
; REM
REMCMD: JSR TOEOLN ; advance to end of line
LD A, @-1, P2 ; back one char
CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
; IF
IFCMD: CALL 0 ; RELEXP get condition
CALL 5 ; APULL pop it into EA
OR A, E ; check for zero
BZ REMCMD ; false: advance to end of line
PLI P3, =CMDTB6 ; process THEN (may be missing)
CALL 11 ; CMPTOK
;------------------------------------------------------------------------------
; LINK
LINK: CALL 0 ; RELEXP get link address
PLI P2, =DOLAL6-1 ; save P2, put return vector into P2
CALL 5 ; APULL pop link address
PUSH P3 ; push P3 on stack
PUSH P2 ; put return vector on stack
SUB EA, ONE ; adjust link address
PUSH EA ; push on stack
LD EA, EXTRAM ; load P2 with base of variables
LD P2, EA
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)
;------------------------------------------------------------------------------
CMDTB7: DB 'FOR'
DB 0xe4 ; to FOR
DB 'DO'
DB 0xa7 ; to DO
DB 'ON'
DB 0x8f ; to ON
DB 'CLEAR'
DB 0x85 ; to CLEAR
DB 0x80 ; to EXEC3
;------------------------------------------------------------------------------
; handle several commands for direct/program mode
EXEC3: PLI P3, =CMDTB8
CALL 11 ; CMPTOK
;------------------------------------------------------------------------------
; CLEAR cmd
CLEAR: JSR INITA1 ; do warm initialization
CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
; ON cmd
ON: CALL 0 ; RELEXP get expression
CALL 12 ; EXPECT check if comma follows
DB ','
DB 1 ; if not, continue next instruction
ON1: CALL 5 ; APULL get expression
AND A, =1 ; has it bit 0 set?
BZ ON2 ; no, skip
ST A, BRKFLG ; store nonzero in BRKFLG
CALL 0 ; RELEXP get INTA vector expression
CALL 5 ; APULL into EA
ST EA, INTAVC ; set as INTA call vector
CALL 6 ; ENDCMD done
; assume here another bit set
ON2: CALL 0 ; RELEXP get INTB vector expression
CALL 5 ; APULL into EA
ST EA, INTBVC ; set as INTB call vector
CALL 6 ; ENDCMD done
;------------------------------------------------------------------------------
; DO cmd
DO: LD EA, DOPTR ; get DO stack ptr
PUSH P3 ; save P3
LD P3, EA ; into P3
LD EA, FORSTK ; put end of stack (FORSTK is adjacent)
ST A, TMPF6 ; into temporary
LD EA, P3 ; DO stack pointer
JSR CHKSBR ; check stack overflow
LD EA, P2 ; get current program pointer
ST EA, @02, P3 ; push on DO stack
LD EA, P3 ; and save new DO stack ptr
POP P3 ; restore P3
DO1: ST EA, DOPTR
CALL 6 ; ENDCMD done
;; RET ; done
;------------------------------------------------------------------------------
;UNTIL command
UNTIL0: CALL 0 ; RELEXP get condition
LD EA, DOPTR ; get DO stack ptr
SUB EA, DOSTK ; subtrack stack base
OR A,E ; is empty?
BNZ UNTIL1 ; no, continue
; otherwise throw error 11
CALL 15 ; ERROR
DB 0x0b ; 11 (UNTIL without DO)
UNTIL1: CALL 5 ; APULL condition into EA
OR A,E ; is false?
BZ UNTIL2 ; yes, skip
LD EA, DOPTR ; no, discard DO loop from stack
SUB EA, =0002 ; 1 level
BRA DO1 ; store back DO stack ptr and exit
UNTIL2: LD EA, DOPTR ; do loop again
LD P2, EA ; get DO stack ptr
LD EA, -2, P2 ; get last level stored
LD P2, EA ; as new program pointer -> redo loop
CALL 6 ; ENDCMD
;; RET ; done
;------------------------------------------------------------------------------
; for comparison of FOR keyword STEP
CMDTB9: DB 'STEP'
DB 0x96 ; to FOR2
DB 0x98 ; to FOR3
; for comparison of FOR keyword TO
CMDT10: DB 'TO'
DB 0x8d ; to FOR1
DB 0xfd ; to SNERR2 (syntax error)
FOR: JSR GETVAR ; get a variable address on stack
DB 0x7a ; none found: goto SNERR2 (syntax error)
CALL 12 ; EXPECT a '='
DB '='
DB 0x77 ; none found: goto SNERR2 (syntax error)
CALL 0 ; RELEXP get initial expression
PLI P3, =CMDT10 ; expect TO keyword (SNERR if not)
CALL 11 ; CMPTOK
FOR1: CALL 0 ; RELEXP get end expression
PLI P3, =CMDTB9 ; check for STEP keyword, to FOR2 if found, to FOR3 if not
CALL 11 ; CMPTOK
FOR2: CALL 0 ; RELEXP get step expression
BRA FOR4 ; skip
FOR3: LD EA, ONE ; push 1 as STEP on stack
ST EA, @2, P3
FOR4: LD EA, FORPTR ; get the FOR stack ptr
PUSH P2 ; save current program ptr
LD P2, EA ; into P2
LD EA, BUFAD ; put end of stack (BUFAD is adjacent)
ST A, TMPF6 ; into temporary
LD EA, P2 ; FOR stack ptr
JSR CHKSBR ; check stack overflow
CALL 5 ; APULL restore step value
ST EA, @2, P2 ; save at forstack+0
CALL 5 ; APULL restore end value
ST EA, @2, P2 ; save at forstack+2
CALL 5 ; APULL restore initial value
LD T, EA ; save in T
CALL 5 ; APULL restore variable address
ST EA, TMPF6 ; store address in temporary
ST A, @1, P2 ; save low offset of var at forstack+4
LD EA, 0, SP ; get current program ptr
ST EA, @2, P2 ; save at forstack+5
LD EA, P2 ; save new FOR stack ptr
ST EA, FORPTR
LD EA, TMPF6 ; get variable address
LD P2, EA ; into P2
LD EA, T ; initial value
ST EA, 0, P2 ; save in variable
FOR5: POP P2 ; restore program pointer
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
NXERR: CALL 15 ; ERROR
DB 10 ; 10 (NEXT without FOR)
; NEXT command
NEXT0: JSR GETVAR ; get variable address on stack
DB 0x38 ; no var found, goto SNERR2 (syntax error)
CALL 5 ; APULL restore address
LD T, EA ; put into T
NEXT1: LD EA, FORPTR ; get FOR stack ptr
SUB EA, FORSTK ; subtract base
BZ NXERR ; is empty? yes, NEXT without FOR error
LD EA, FORPTR ; get FOR stack ptr again
SUB EA, =0007 ; discard current frame
ST EA, FORPTR ; save it for the case loop ends
PUSH P2 ; save program pointer
LD P2, EA ; point to base of current FOR frame
LD EA, T ; get var address
SUB A, 4, P2 ; subtract var addr of this frame
BZ NEXT2 ; is the same?, yes skip (found)
POP P2 ; restore P2
BRA NEXT1 ; try another loop - assume jump out of loop
NEXT2: LD A, 1, P2 ; step value (high byte)
BP NEXT3 ; is step positive? yes, skip
JSR NXADD ; add step and compare with end value
XOR A, =0xff ; compare with -1
BZ NEXT5 ; zero? yes, end of loop not yet reached
BRA NEXT4 ; skip
NEXT3: JSR NXADD ; add step and compare with end value
NEXT4: BP FOR5 ; end of loop done, continue after NEXT
NEXT5: LD EA, 5, P2 ; get start of loop program pointer
POP P2 ; drop P2
LD P2, EA ; set start of loop again
LD EA, FORPTR ; get FOR stack ptr
ADD EA, =0007 ; push loop frame again
ST EA, FORPTR ; save new FOR ptr
CALL 6 ; ENDCMD
;; RET ; done
SNERR2: CALL 15 ; ERROR
DB 4 ; 4 (syntax error)
;------------------------------------------------------------------------------
; add step and compare with end value
NXADD: LD EA, EXTRAM ; variable base
LD A, 4, P2 ; get variable offset
PUSH P3 ; save P3
LD P3, EA ; into EA
LD EA, 0, P3 ; get variable value
ADD EA, 0, P2 ; add step value
ST EA, 0, P3 ; store new variable
POP P3 ; restore P3
SUB EA, 2, P2 ; compare with end value
BZ NXADD2 ; same?
XCH A, E ; no, swap: A = high byte
NXADD1: AND A, =0x80 ; mask out sign bit
RET ; return
NXADD2: XCH A, E ; swap: A = high byte
BNZ NXADD1 ; not same? get high byte
LD A, =0xff ; set A = -1
RET ; return
;------------------------------------------------------------------------------
; check for SBR stack overflow
; EA contains current stack pointer, TMPF6 contains limit
CHKSBR: SUB A, TMPF6 ; subrack limit
BP NSERR ; beyond limit?
RET ; no, exit
; otherwise nesting too deep error
NSERR: CALL 15 ; ERROR
DB 9 ; 9 (nesting too deep)
;------------------------------------------------------------------------------
SUERR: CALL 15 ; ERROR
DB 2 ; 2 (stmt used improperly)
;------------------------------------------------------------------------------
; INPUT handler
INPUT0: LD A, INPMOD ; is in direct mode?
BZ SUERR ; yes, this is an error!
LD EA, P2 ; save current program ptr temporarily
ST EA, TMPF2
INPUT1: JSR GETVAR ; get variable address on stack
DB 0x29 ; no variable, goto INPUT3 (could be $)
LD A, =03 ; set mode 3, swap buffers (P2 is input buffer)
JSR SWPBUF
JSR GETLN ; get line into input buffer
INPUT2: CALL 0 ; RELEXP get expression from input buffer
CALL 5 ; APULL into EA
LD T, EA ; save into T
CALL 5 ; APULL get variable address
PUSH P3 ; save P3
LD P3, EA ; into P3
LD EA, T ; obtain expression
ST EA, 0, P3 ; save into variable
POP P3 ; restore P3
LD A, =01 ; set mode 1, swap buffers (P2 is program ptr)
JSR SWPBUF
CALL 12 ; EXPECT a comma
DB ','
DB 0x2c ; if not found, exit via INPUT5
JSR GETVAR ; get another variable
DB 0xd6 ; if none found, goto SUERR (error 2)
; does not accept $ any more here
LD A, =03 ; set mode 3, swap buffers (P2 is input buffer)
JSR SWPBUF
CALL 12 ; EXPECT an optional comma in input buffer
DB ','
DB 1 ; none found, ignore
BRA INPUT2 ; process the next variable
; process $expr for string input
INPUT3: CALL 12 ; EXPECT a $ here
DB '$'
DB 0xc9 ; none found, goto SUERR
CALL 1 ; FACTOR get string buffer address
LD A, =03 ; set mode 3, swap buffers (P2 is input buffer)
JSR SWPBUF
JSR GETLN ; get line of input
CALL 5 ; APULL get buffer address
PUSH P3 ; save P3
LD P3, EA ; into P3
INPUT4: LD A, @1, P2 ; copy input from buffer into string
ST A, @1, P3
XOR A, =CR ; until CR seen
BNZ INPUT4
POP P3 ; restore P3
LD A, =01 ; set mode 1 again, swap buffers (P2 is program ptr)
JSR SWPBUF
INPUT5: CALL 6 ; ENDCMD done
;------------------------------------------------------------------------------
; save input mode and swap buffers
SWPBUF: ST A, INPMOD ; store new input mode
LD EA, TMPF0 ; swap buffer addresses
XCH P2, EA ; TMPF0 normally contains input buffer address
ST EA, TMPF0
RET
;------------------------------------------------------------------------------
; several more commands
CMDTB8: DB 'DELAY'
DB 0x9a ; to DELAY
DB 'INPUT'
DB 0x8f ; to INPUT
DB 'PRINT'
DB 0x8b ; to PRINT
DB 'PR'
DB 0x88 ; to PRINT
DB 'STOP'
DB 0x91 ; to STOP
DB 0x9d ; default to ASSIGN
;------------------------------------------------------------------------------
; INPUT cmd
INPUT: BRA INPUT0 ; INPUT handler
;------------------------------------------------------------------------------
; PRINT cmd
PRINT: JMP PRINT0 ; PRINT handler
;------------------------------------------------------------------------------
; DELAY cmd
DELAY: CALL 0 ; RELEXP get delay expression
CALL 5 ; APULL into EA
LD T, =0x003f ; multiply with 63
MPY EA, T
LD EA, T ; into EA
JSR DELAYC ; do delay
CALL 6 ; ENDCMD
;;; RET ; done
;------------------------------------------------------------------------------
; STOP cmd
STOP: JMP MAINLP ; directly enter main loop
;------------------------------------------------------------------------------
; left hand side (LHS) operators for assigment
CMDTB4: DB 'STAT'
DB 0x89 ; to STATLH
DB '@'
DB 0x92 ; to ATLH
DB '$'
DB 0xb1 ; to DOLALH
DB 0x9e ; default case to ASSIG1
;------------------------------------------------------------------------------
; handle assignments
ASSIGN: PLI P3, =CMDTB4
CALL 11 ; CMPTOK
;------------------------------------------------------------------------------
; STAT on left hand side
STATLH: CALL 12 ; EXPECT an equal symbol
DB '=' ;
DB 0x67 ; not found, goto SNERR
CALL 0 ; RELEXP get the right hand side
CALL 5 ; APULL into EA
LD S, A ; put into SR (only low byte)
LD A, =1 ; suppress potential INT that could
ST A, NOINT ; result from changing SA/SB
CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
; @ on left hand side (POKE)
ATLH: CALL 1 ; FACTOR get non-boolean expression
CALL 12 ; EXPECT an equal symbol
DB '='
DB 0x5b ; not found, goto SNERR (syntax error)
CALL 0 ; RELEXP get right hand side
CALL 5 ; APULL into EA
LD T, EA ; into T
CALL 5 ; APULL get target address
PUSH P3 ; save P3
LD P3, EA ; into P3
LD EA, T ; RHS into EA
ST A, 0, P3 ; store low byte at address
POP P3
CALL 6 ; ENDCMD
;;; RET
;------------------------------------------------------------------------------
; default case for assign (VAR = expr)
ASSIG1: JSR GETVAR ; get a variable
DB 0x4c ; if not var, goto DOLAL4 (assume $xxxx)
CALL 12 ; EXPECT an equal symbol
DB '='
DB 0x49 ; not found, go to SNERR
CALL 0 ; RELEXP get right hand side
CALL 5 ; APULL into EA
LD T, EA ; into T
CALL 5 ; APULL get variable address
PUSH P3 ; save P3
LD P3, EA ; into P3
LD EA, T ; get RHS
ST EA, 0, P3 ; store result into variable
POP P3 ; restore P3
CALL 6 ; ENDCMD done
;------------------------------------------------------------------------------
; $ on left hand side
DOLALH: CALL 1 ; FACTOR get target address
CALL 12 ; EXPECT an equal symbol
DB '='
DB 0x3a ; if not found, goto SNERR
LD A, 0, P2 ; get next char from program
XOR A, =0x22 ; is double quote?
BNZ DOLAL3 ; not a constant string, may be string assign
LD A, @1, P2 ; skip over quote
CALL 5 ; APULL get target address
PUSH P3 ; save P3
LD P3, EA ; into P3
DOLAL1: LD A, @1, P2 ; get string char from program buffer
XOR A, =0x22 ; is double quote?
BZ DOLAL2 ; yes, end of string, skip
XOR A, =0x2f ; is CR?
BZ EQERR ; yes, ending quote missing error
XOR A, =0x0d ; convert back to original char
ST A, @1, P3 ; store into target buffer
BRA DOLAL1 ; loop
DOLAL2: LD A, =CR ; terminate target string
ST A, 0, P3
POP P3 ; restore P3
CALL 9 ; GETCHR get next char from program
CALL 6 ; ENDCMD done
; assume string assign
DOLAL3: CALL 12 ; EXPECT a $
DB '$'
DB 0x15 ; not found, goto SNERR
CALL 1 ; FACTOR get source address
CALL 5 ; APULL into EA
PUSH P2 ; save P2
LD P2, EA ; into P2
DOLAL4: CALL 5 ; APULL get target address
PUSH P3 ; save P3
LD P3, EA ; into P3
DOLAL5: LD A, @1, P2 ; move byte from source to targer
ST A, @1, P3
XOR A, =CR ; compare with CR
BNZ DOLAL5 ; not yet, continue copying
;------------------------------------------------------------------------------
; This location is also the return point form LINK
DOLAL6: POP P3 ; restore P3
POP P2 ; restore P2
CALL 6 ; ENDCMD
;------------------------------------------------------------------------------
EQERR: CALL 15 ; ERROR
DB 6 ; 6 (ending quote missing)
;------------------------------------------------------------------------------