-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathtinyBASIC.asm
More file actions
3386 lines (3102 loc) · 182 KB
/
tinyBASIC.asm
File metadata and controls
3386 lines (3102 loc) · 182 KB
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
page 0 ; suppress page headings in listing file
include "bitfuncs.inc"
cpu MK3850
;==================================================================================
; tiny BASIC for the F8 - Jerry D. Fox - Dr. Dobbs #39 Oct 1979
;
; modified for DASM - 6/28/2012 www.seanriddle.com
; modified for SBCF8 - 11/10/2020 Tetsuya Suzuki
; modified for the AS macro assembler (http: //john.ccac.rwth-aachen.de: 8000/as/) - Jim Loos 09/23/2024
; serial I/O functions for tiny BASIC by Jim Loos 09/23/2024
; mini-monitor (BASIC 'MON' command) by Jim Loos 09/23/2024
;==================================================================================
romtop equ 00000H ; start of EPROM
ramtop equ 08000H ; start of RAM
; registers used by serial I/O functions
bitcnt equ 00H ; number of bits to send/receive
txdata equ 01H ; character to be transmitted
rxdata equ 01H ; received character
; VT100 Escape sequences
CLS equ "\e[2J\e[H" ; clear screen and home cursor
SGR0 equ "\e[0m" ; turn off character attributes
SGR1 equ "\e[1m" ; turn bold mode on
SGR2 equ "\e[2m" ; turn low intensity mode on
SGR4 equ "\e[4m" ; turn underline mode on
SGR5 equ "\e[5m" ; turn blinking mode on
SGR7 equ "\e[7m" ; turn reverse video on
org romtop
; cold start
cstart: clr
outs ledport ; turn off yellow LEDs
outs serialport ; set serial input and output lines high (idle or MARK)
dci tinybasictxt
pi putstr ; print "tiny BASIC for the MK3850 SBC..."
; rnd initialize
dci ranpnt ; rnd pointer
clr ; clear A
st ; write
st ; write
jmp newt ; go setup TXTU
; R3 = format number
; R4 = current character being processed
; R5 is a flag for strings
; R9 is the status save reg
; scratch storage
; 26-27 TXTU unfilled text addr
; 30-31 currnt current TBP
; 32-33 skinp save input stack
; 34-35 skgos save gosub stack
; save order top-down
; 36-37 lopvar loop variable
; 40-41 loppt text pointer
; 42-43 lopln line number
; 44-45 lopinc increment
; 46-47 loplmt limit
; 52-53 temp pointer for read-data
; 50-51 restore pointer for read-dat
start: dci stack ; setup
lr Q,DC ; stack reg Q
clr ; zero
lisl 7 ; scratch
st1: lisu 3 ; area
lr S,A ; 30-37
lisu 5 ; and
lr D,A ; 50-57
br7 st1 ; 30-37
lr 5,A ; clear string flag for direct
lisu 2 ; reset ISAR
pi ttcr ; CR,LF
lr 8,A ; set for prtstg
dci prompt ; output
pi prtstg ; prompt
st2: li '>' ; load
lr txdata,A ; prompt character
pi getln ; get a line
lr H,DC ; save eol
lr A,HL ; low order
lr 6,A ; byte in R6
dci buff ; start of line
pi tstnum ; see if a number
ds 1 ; number?
bnz st3 ; branch if a number
lr H,DC ; save TBP
jmp direct ; a command
st3: li lo(-2) ; backup DC
adc ; to hex line #
pi pushdc ; save bol
lr A,I ; store
st ; hex
lr A,D ; line
st ; number
lr A,HL ; low order byte
com ; of begin
inc ; make it -
as 6 ; save #
lr 6,A ; of chars
pi fndln ; find line #
pi pushdc ; save addr
xdc ; in DC1 also
lr DC,H ; save in DC0 also
lisl 6 ; put TXTU
pi pushsr ; on the stack top
; at this point DC0=DC1=found line add
bz fline ; branch if found line
bnc nline ; branch if past TXTU
br insert ; branch if between 2 lines
; delete line pointed to by DC1
; move H thru TXTU up
; DC0=line following found line
; DC1=found line
fline: lm ; get past
lm ; line #
pi fndnxt ; find next line *from* in DC0
pi mvup ; delete the line
; DC1 has the updated TXTU addr (76)
xdc ; has updated TXTU
lr H,DC ; into H
lisl 6 ; set ISAR to TXTU
lr A,HU ; new
lr I,A ; TXTU
lr A,HL ; addr
lr D,A ; in TXTU
pi poprt ; clear old TXTU
pi pushsr ; new TXTU on the stack top
; insert between 2 lines
insert: lr A,6 ; load line length
ci 3 ; any text?
bz start ; no just delete
; move TXTU(DC0) thru found line(stack
; top) to TXTU+R4 (DC1)
pi txck ; update TXTU
xdc ; setup the move
pi mvdown ; move down
br st4 ; move in new line
; new line
nline: pi txck ; update TXTU
; move in new line
; setup DC0 and DC1 for new line move
st4: pi pulldc ; *to* found line
xdc ; in DC1
pi pulldc ; *from* found line
st5: lm ; load a byte
xdc ; switch DC
st ; store it
xdc ; reset DC
ds 6 ; dec byte count
bnz st5 ; branch if more
jmp st2 ; next record
; this routine exits with
; DC0=new TXTU, DC1=old TXTU
; see if txt area is left
; if room update TXTU by R4
txck: lr K,P ; save return
pi pulldc ; get TXTU
xdc ; save TXTU in DC1
dci txte ; text end addr
pi pushdc ; on the stack
xdc ; put
lr H,DC ; TXTU
xdc ; in
lr DC,H ; both DC0 and DC1
lr A,6 ; update TXTU
adc ; with new line length
lr H,DC ; new TXTU in 10-11
lisl 6 ; TXTU ISAR addr
lr A,HU ; store
lr I,A ; new
lr A,HL ; TXTU
lr D,A ; in 26-27
pi comt ; compare txte-TXTU
bc txc1 ; branch if more room
jmp asorry ; no more room
txc1: pk ; return
; output contents of accum
; input a line
getln: lr K,P ; save return
pi pushrt ; push it
li 72 ; buffer
lr 8,A ; length
lr A,txdata ; load lead character
get1: dci buff ; buffer addr
get2: lr txdata,A ; output
pi tty0 ; the byte
pi ttyi ; get a character
ni 7FH ; turn parity off
ci 7FH ; rubout?
bz get3 ; branch if yes
ci 08H ; backspace?
bnz get4 ; branch if not
; backup DC0 to delete a char
get3: li lo(-1) ; backup
adc ; DC0
lr A,8 ; adjust
inc ; the
lr 8,A ; counter
li 08H ; set backspace
; lr H,DC ; echo
; lm ; the last
; lr DC,H ; character
br get2 ; dont store
get4: ci 7DH ; delete line?
bnz get5 ; branch if not alt-mode
pi ttcr ; output CR,LF
li 5EH ; and up arrow
br get1 ; and start over
get5: ci 0AH ; LF?
bz get2 ; ignore it
ci 0 ; null?
bz get2 ; ignore it
st ; store in buff
ds 8 ; check buff room
bz get3 ; branch if no more room
ci 0DH ; CR?
bnz get2 ; branch if not cr
pi ttcr ; output CR,LF
jmp pullrt ; return
; if TXTU=present DC then stop looking
; this routing looks for a line number
; the line number is in scratch 20-21
; CC=0 found line, CC=+ past a number,
; CC=- past end of text
; for a fndl entry DC points to line number
fndln: dci txtb ; load begin of text addr
fndl: lr K,P ; save return
fnd1: lisl 6 ; set ISAR to TXTU
pi pushdc ; put present TBP on the stack
pi comt ; addr-TXTU skip lr H,DC and LISL 0
bnc fnd2 ; branch if not the end
clr ; set
lr 9,A ; status
lr W,J ; to no carry
fndr: pk ; return
fnd2: lisl 4 ; put the
lm ; text
lr I,A ; number
lm ; on
lr D,A ; the
pi pushsr+1 ; stack
pi comx ; text-input
bc fndr ; branch if past or equal
lm ; get past
lm ; line number
br fnd4 ; look for next line
; DC must be set past line # for this entr
fndnxt: lr K,P ; save return
fnd4: lm ; load next char
ci 0DH ; CR?
bnz fnd4 ; branch if not
br fnd1 ; keep looking
; DC points to line to print
prtln: lr K,P ; save
pi pushrt ; return
lisl 0 ; set ISAR
lm ; load
lr I,A ; the
lm ; number
lr I,A ; into 20-21
lis 4 ; set number
lr 3,A ; of chars to print
pi prtnum ; convert and print
pi pblk ; print a blank
clr ; set end char
lr 8,A ; to zero
pi prtstg ; print a string
jmp pullrt ; return
; print until match of R4
; or a CR is found
prtstg: lr K,P ; save
pi pushrt ; return
prt1: lm ; load a char
lr 4,A ; save char
lr txdata,A ; save the character in the tx buffer
xs 8 ; see if a match
bz prt2 ; return if a match
pi tty0 ; output a char
lr A,4 ; did we output
ci 0DH ; a CR?
bnz prt1 ; branch if not
prt2: jmp pullrt ; return
; print number in R20-21
prtnum: lr K,P ; save return
pi pushrt ; addr on the stack
; routine to convert hex to decimal
; hex number must be in scratch 20-21
; changes scratch 22-23 and 24-25
pi chksgn ; check sign
lisl 2 ; set scratch
clr ; 22-23
lr I,A ; to
lis 10 ; decimal
lr D,A ; 10
pi pushsr ; put a 10 on the stack
lr A,3 ; save
lr 4,A ; format #
xcv1: pi divide ; divide by 10
pi push20 ; save digit(remainder)
lisl 4 ; move the
pi pushsr ; result
pi pull20 ; to 20-21
ds 4 ; dec digit counter
lr A,I ; see if
xs S ; exclusive or and
as D ; add to check for zero
bnz xcv1 ; branch if more
xcv2: ds 4 ; need to pad blanks?
bm xcv3 ; branch if we dont
pi pblk ; print a blank
br xcv2 ; see if we need more blanks
xcv3: lr A,8 ; output
br xcv5 ; the sign
xcv4: pi pullsr ; get a digit
ci 10 ; last one?
bz xcv6 ; branch if last
oi 30H ; ASCII
xcv5: lr txdata,A ; output reg
pi tty0 ; output
br xcv4 ; another
xcv6: jmp pullrt ; return
; output a blank
pblk: li ' ' ; load a blank
lr txdata,A ; output reg
jmp tty0 ; go print
; check for ' or " type string
; R8 has the present byte
; CC=0 for a drop thru return
qstring: lr K,P ; save
pi pushrt ; return
lr A,4 ; get char
ci '\'' ; string?
bnz qst4 ; not ' maybe "
qst1: lr 8,A ; load end char
lm ; get past it
pi prtstg ; print string
qst2: pi poprt ; pull return into 12-13
lr A,4 ; was the last a CR
ci 0DH ; CR?
bnz qst3 ; branch if not CR
jmp rnxl ; run next line
qst3: pi char ; get next char
xs 4 ; set CC=0 for drop thru return
pk ; return
qst4: ci '"' ; string?
bz qst1 ; go load end char
qst5: ci 5FH ; a back arrow
bnz qst6 ; branch if not
lis 0DH ; output just a CR
lr txdata,A ; output reg
pi tty1 ; output the CR
lm ; get past <
br qst2 ; go drop thru return
qst6: jmp pullrt ; return and branch
; see if variable or array
; if so put addr in DC1, TBP in DC0
testvl: lr A,4 ; load character
ai 0C0H ; subtract @
bm tvr ; branch if not a variable
lr J,W ; save status
lr 2,A ; save variable
ci 26 ; a-z?
bm tvr ; branch if not
lr K,P ; save
pi pushrt ; return
pi skip ; inc DC and get next char
ci '$' ; a string?
bnz tvs ; branch not a string
lr A,9 ; save status
lr 5,A ; set as string
pi skip ; get next character
tvs: lr W,J ; restore status
bnz tv1 ; branch if a variable
pi parn ; (should be next)
pi mv2021 ; move 20-21 to 22-23
pi addd ; double index
bp tvt ; branch if not too big
; may be @(-index)
lr A,5 ; change status
com ; of the
inc ; previous
lr 5,A ; string just in case
lr A,I ; see if
inc ; lt -255
bnz tve ; branch if not
lr A,D ; make
com ; low
inc ; positive
ci 52 ; @(-index) past z?
bp tv2 ; branch if it isnt
tve: jmp qhow ; error
tvt: xdc ; save TBP
dci varbgn ; begin of array
lr H,DC ; into 10-11
pi mv2021 ; move 2*index into 22-23
lr A,HU ; so we
lr I,A ; can
lr A,HL ; put begin
lr D,A ; in 20-21
pi subd ; varbgn-index
lisl 6 ; put TXTU
pi pushsr ; on the stack
pi comp ; TXTU-@ (index)
bnc tvd ; branch if room left
xdc ; get TBP
qsorry: pi pushdc ; save TBP
asorry: dci sorry
jmp error ; process error
tvd: sr 1 ; make status+CR 0
pi pushsr ; move var addr
pi pulldc ; to DC
br tv3 ; go return
; A-Z variable
tv1: lr A,2 ; load variable
sl 1 ; var index*2
tv2: xdc ; save TBP
dci varbgn ; get
adc ; variable addr
tv3: xdc ; DC0=TBP, DC1=var addr
jmp pullrt
tvr: pop ; fast return
; test an item pointed to by DC
; the number and (20-21) will contain
; the hex conversion of it
; if R1=0 not a number
tstnum: lr K,P ; save return
lisl 0 ; set ISAR
clr ; zero
lr I,A ; lead
lr D,A ; bytes
inc ; set R1 for no number
lr 1,A ; and digit counter
ts1: pi char ; get next char
ci 2FH ; see
bp ts2 ; if
ci 39H ; a
bp ts3 ; decimal
ts2: pk ; return
ts3: sl 4 ; strip
sr 4 ; ascii
lr 2,A ; save the digit
ds 1 ; set R1 for a number found
pi mv2021 ; move 20-21 to 22-23
clr ; zero R20
lr I,A ; and
lr S,A ; R21
lis 10 ; multiply
lr 7,A ; existing digits
pi mult ; by 10
lisl 1 ; now
lr A,S ; add
as 2 ; the
lr D,A ; new
lr A,S ; digit
lnk ; to the
lr S,A ; accumulated result
lm ; skip this byte
bp ts1 ; branch if no overflow
qhow: pi pushdc ; save TBP
ahow: dci how
jmp error
; DC1 must point to table
; DC0 points to word
; reg H points to DC0
direct: dci tab1 ; command table
exec: xdc ; in DC1
lr DC,H ; DC0=tiny basic pointer(TBP)
li lo(-1) ; set R1
lr 1,A ; to -1
ex1: lm ; load from tb line
xdc ; get table addr
ci '.' ; period?
bz ex3 ; branch if yes
cm ; compare
xdc ; put TBP back in DC0
bz ex1 ; branch if a match
; here no match
lr A,1 ; backup
adc ; TBP
xdc ; and get the
adc ; last accessed
lm ; table byte
ns 1 ; an addr?
bm ex4 ; branch if it was
; look for addr
ex2: lm ; load
ns 1 ; an addr?
bp ex2 ; branch if not
lm ; get low byte
br exec ; restore word addr
; found a period
ex3: lm ; load next char
ns 1 ; an addr?
bp ex3 ; branch if not
ex4: sl 1 ; turn sign
sr 1 ; bit off
lr KU,A ; save hi order
lm ; load
lr KL,A ; low order
xdc ; get tb pointer in DC0
pk ; call routine
; skinp in 32-33
inperr: lisl 2 ; setup skinp ISAR
lr A,I ; restore
lr QU,A ; the
lr A,D ; old
lr QL,A ; stack
pi pull20 ; restore currnt
lisu 2 ; reset ISAR
pi pulldc ; clear stack
pi pulldc ; get original TBP
input: pi pushdc ; save TBP in case of error
ip1: pi char ; get next char
pi qstring ; see if a string
bnz ip2 ; branch not a string
pi testvl ; variable?
bm ip4 ; branch if not
br ip3 ; branch if a variable
; here not a string
ip2: pi pushdc ; save TBP for prtstg
pi testvl ; variable?
bp $+5 ; branch if a car
jmp qwhat ; error
lr H,DC ; save TBP
lm ; save
lr 7,A ; this byte
clr ; and
lr DC,H ; store
st ; a zero
lr 8,A ; for end of string
pi pulldc ; get TBP
pi prtstg ; print string
li lo(-1) ; backup
adc ; DC
lr H,DC ; save TBP
lr A,7 ; and restore
st ; char
lr DC,H ; restore TBP
; here an input variable
ip3: pi pushdc ; save TBP
lisu 3 ; save
pi push20 ; currnt
li lo(-1) ; set currnt
lr S,A ; to minus
lisl 2 ; ISAR for skinp
lr A,QU ; save
lr I,A ; the
lr A,QL ; stack
lr I,A ; pointer
lisu 2 ; reset ISAR
xdc ; save
pi pushdc ; variable addr
; prompt for input
li ':' ; prompt
lr txdata,A ; char
pi getln ; get a line
dci buff ; input addr
lr A,5 ; setup
lr 9,A ; string
lr W,J ; status
bm ipx ; branch if not a string
pi pulldc ; get var addr
pi buftov ; move buf to var
br ips ; continue
ipx: pi expr ; evaluate expr
pi pulldc ; get var addr
lr A,I ; store the value
st ; into
lr A,D ; the
st ; variable
ips: lisu 3 ; restore
pi pullsr ; currnt
lisu 2 ; restore
pi pulldc ; TBP
ip4: pi poprt ; clear stack
pi ignbk ; get next char
ci ',' ; comma?
bz input ; branch if more
; see if proper end
fini: li lo(-1) ; backup
adc ; TBP
fin: pi finish ; finish
jmp qwhat ; return here is an error
; here if no let
deflt: pi ignbk ; get next char
ci 0DH ; an empty line
bnz $+5 ; branch not empty
jmp rnxl ; it's OK, get next line
lr DC,H ; restore TBP
let: pi setval ; get variable
lr A,4 ; restore char
ci ',' ; comma?
lm ; get past this char
bz let ; do it again
br fini ; finish up
; print a string or number
; R3 is the format number
print: lis 6 ; set
lr 3,A ; digit counter
pi ignbk ; get next char
ci ';' ; ';' multiple record?
bnz pr1 ; branch if not
pi ttcr ; just a CR,LF
jmp rsml ; run same line
pr1: ci 0DH ; CR?
bnz pr2 ; branch if not CR
pi ttcr ; just CR,LF
jmp rnxl ; run next line
pr2: ci '#' ; format change?
bnz pr3 ; branch if not
pi expr ; evaluate format
lisl 1 ; get format out
lr A,I ; of 20-21
lr 3,A ; into R3
ds 3 ; adjust format
br pr4 ; check for comma
pr3: li lo(-1) ; backup
adc ; TBP
pi qstring ; see if a string
bnz pr6 ; branch if not a string
; drops thru if string or back
pr4: lr A,4 ; load char
ci ',' ; comma?
bnz pr5 ; branch if not comma
lm ; get past comma
pi finish ; go finish up line
br pr2 ; continue
pr5: pi ttcr ; list end so CR,LF
jmp fin ; finish up
pr6: pi expr ; evaluate expression
; see if a string (600)
lr A,5 ; get string flag
lr 9,A ; into
lr W,J ; status reg
bm pr7 ; branch if not string
ds 5 ; clear string flag
xdc ; save TBP
dci buff ; addr of string
clr ; get string
lr 8,A ; terminator
pi prtstg ; go print string
xdc ; restore TBP
br pr8 ; continue
pr7: pi prtnum ; print the number
pr8: pi char ; get next char
br pr4 ; look for comma
gosub: pi save ; save for parameters
pi expr ; evaluate expr
pi pushdc ; save TBP
pi fndln ; find target line
bz gos1 ; branch if found
jmp ahow ; error
gos1: lisu 3 ; set
pi push20 ; save currnt
lisl 4 ; save
pi pushsr ; skgos
lr A,QU ; put stack
lr I,A ; pointer
lr A,QL ; into
lr I,A ; skgos
clr ; zero
lr I,A ; lopvar
lr I,A ; in scratch
jmp rtsl ; run the line
return: pi endcr ; look for CR
lisu 3 ; set ISAR
lisl 4 ; to skgos
lr A,I ; load hi
xs S ; exclusive or and
as D ; and add to check for 0
bnz ret1 ; branch if not
jmp qwhat ; didnt exist
ret1: lr A,I ; load
lr QU,A ; stack pointer
lr A,D ; from
lr QL,A ; skgos
pi pullsr ; load old skgos
pi pull20 ; load currnt
pi pulldc ; restore TBP
xdc ; save DC
pi restor ; go restore
xdc ; restore TBP
pi fin ; finish up
what: db "WHAT?"
db 0DH
how: db "HOW?"
db 0DH
; 3E6-3FF used by FAIRBUG
sorry: db "SORRY"
db 0DH
db " FAIRBUG USES"
db "3E6-3FF"
db "9ABCDEF"
; LIST (CR) lists all saved lines
; LIST n (CR) from n down
; LIST n,# (CR) will list
; # lines from n down
list: pi tstnum ; see if a number
ds 1 ; was it?
bz lis4 ; branch if it was not
lr A,4 ; see if the
ci ',' ; next one is a comma
bnz lis4 ; branch if it isnt
pi pushsr ; save the line #
pi skip ; get the next char
pi tstnum ; and the next number
ds 1 ; was it a number
bnz lis1 ; branch if it was
jmp qwhat ; else error
lis1: lr A,S ; is the
as i ; num of lines gt 255
bz lis3 ; branch if it isnt
lis2: jmp qhow ; else error
lis3: lr A,S ; load the
lr 6,A ; number of lines to print
as D ; see if zero
bz lis2 ; error if it is
pi pullsr ; restore begin line #
lis 1 ; set list flag for n,#
br lis5 ; to list #,n
lis4: clr ; set list flag
lis5: lr 5,A ; to no n
pi endcr ; get past CR
pi fndln ; find a line
bnc lis7 ; branch if past TXTU
lis6: pi prtln ; print a line
pi fndl ; get next line
bnc lis7 ; branch if past TXTU
lr A,5 ; see if looping
as 5 ; on n
bz lis6 ; branch if not
ds 6 ; dec n
bnz lis6 ; and loop
lis7: jmp start ; go prompt
; clear text area
new: pi endcr ; clear text line
newt: dci txtb ; begin addr
lr H,DC ; in 10-11
lisu 2 ; set ISAR for initial entry
lisl 6 ; set ISAR to TXTU
lr A,HU ; reset
lr I,A ; to
lr A,HL ; the beginning
lr D,A ; of text area
jmp start ; restart
stop: pi endcr ; find CR
jmp start ; restart
; if true run same line
; if not true run next line
if: pi expr ; evaluate the expression
lr A,I ; see if
xs S ; exclusive or and
as D ; add to check for zero
bz rem ; branch if it is
jmp rsml ; run same line
; remark is a false if
rem: pi fndnxt ; find the next line
bnc if1 ; branch past the end
jmp rtsl ; run next line
if1: jmp start ; no more text
; for var=expr to expr skip expr
for: pi save ; save for variable
pi setval ; get variable
li lo(-2) ; backup
xdc ; DC1
adc ; to get var addr
pi pushdc ; on the stack
xdc ; restore TBP
lisu 3 ; put variable
lisl 6 ; addr into
pi pullsr ; lopvar
lisu 2 ; reset ISAR
dci tab5 ; go look
jmp exec ; for 'to'
fr1: pi expr ; evaluate limit
pi push20 ; loplmt(46-47) on stack
dci tab6 ; go look
jmp exec ; for 'step'
fr2: pi expr ; evaluate increment
br fr4 ; branch around default of 1
fr3: clr ; no 'skip', set
lr I,A ; increment
inc ; to
lr D,A ; one
fr4: pi push20 ; lopinc(44-45)
lisu 3 ; use currnt
pi push20 ; as lopln(42-43)
pi pushdc ; and TBP as loppt(40-41)
lr DC,Q ; stack addr in dc
pi refor ; put them all in scratch
lisu 3 ; set ISAR for lopvar
lr DC,Q ; save
xdc ; original stack addr
lr DC,Q ; reset DC0
fr5: lr H,DC ; temp save
lr Q,DC ; new stack addr
lm ; see if
om ; the end
bnz fr6 ; branch if not
xdc ; restore original
br fr8 ; stack addr
fr6: lisl 6 ; set ISAR for lopvar
pi comt ; compare to lcpvar
lis 10 ; go down to
adc ; the next level
bnz fr5 ; branch if found
li lo(-1) ; get
adc ; from addr
xdc ; restore original stack addr
lr Q,DC ; put
pi pushdc ; on the stack top
xdc ; put
lr H,DC ; from
xdc ; in both
lr DC,H ; DC0 and DC1
lis 10 ; to addr is
adc ; from+10
xdc ; in DC1
pi mvdown ; move the stack down 10 bytes worth
lr DC,H ; restore
fr8: lr Q,DC ; stack addr
lisu 4 ; restore
pi push20 ; TBP by using
pi pulldc ; loppt
lisu 2 ; reset ISAR
jmp fin ; finish up
; next var
next: pi char ; get next char
pi testvl ; test variable
xdc ; car addr in DC0
bp $+6 ; branch around error jump
nx0: xdc ; restore TBP
jmp qwhat ; error
pi pushdc ; put var addr(lopvar)
pi pull20 ; into 20-21
nx1: lisu 3 ; set ISAR
lisl 6 ; to lopvar
lr A,I ; see
as S ; if
xs D ; its zero
bz nx0 ; branch if zero an error
pi pushsr ; put lopvar
lisu 2 ; on the stack top
pi comp ; compare next variable
bz nx2 ; to lopvar & b if eq
pi restor ; restore next level
br nx1 ; keep looking
; need to add lopinc to the
; variable lopvar points to
nx2: pi save+1 ; put everything back skip xdc
xdc ; save TBP
pi push20 ; get addr of
pi pulldc ; lopvar in DC
lr H,DC ; save lopvar addr
lm ; put
lr I,A ; value
lm ; of lopvar
lr I,A ; in 20-21
lr DC,Q ; save
lis 6 ; setup
adc ; temp stack
lr Q,DC ; to get lopinc(44-45)
pi pullsr+1 ; into 22-23 (skip lr H,DC)
pi addd ; index=index+lopinc
lr A,I ; store
st ; the
lr A,D ; incremented
st ; lopvar
pi comx ; compare(limit-index)
lr DC,Q ; save the
lr H,DC ; original stack addr
bz nx4 ; branch if not done
; here assuming lopinc is +, it could
; be - so both gt and lt must be checked
; backup temp Q by 4 bytes to lopinc
li lo(-4) ; reset temp stack
adc ; to lopinc
clr ; see
om ; if minus
bm nx3 ; branch if negative inc
lr W,J ; restore status
bm nx5 ; + inc, br if done(-)
br nx4 ; not done
nx3: lr W,J ; restore status
bp nx5 ;- inc, br if done(+)
; still looping, set currnt=lopvar
; and DC0=loppt the new TBP-
nx4: lr DC,Q ; reset
li lo(-8) ; stack
adc ; to point
lr Q,DC ; to loppt(40-41)
lr DC,H ; save
xdc ; original stack in DC1
pi pulldc ; get TBP=loppt
lisu 3 ; set
pi pull20 ; currnt=lopln
lisu 2 ; reset ISAR
xdc ; reset
lr Q,DC ; stack pointer
br nx6 ; go finish line
nx5: lr DC,H ; reset original
lr Q,DC ; stack
pi restor ; get next for-next level
nx6: xdc ; restore TBP
jmp fin ; finish up
; read A,B$,@(i),@$(i)
read: pi char ; get next char
pi testvl ; a variable?
pi pushdc ; save TBP
bp $+5
rea1: jmp awhat ; error
lisu 5 ; set ISAR
lisl 2 ; to temp pointer
lr A,I ; get present
lr HU,A ; data
lr A,D ; addr
lr HL,A ; into