-
Notifications
You must be signed in to change notification settings - Fork 3
/
basic2.mac
2967 lines (2744 loc) · 56.5 KB
/
basic2.mac
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
TITLE BASIC-11 interpreter
SUBTTL Exec part 2
.Z80
; Z80 port by Hector Peraza, 2016-2020
include BASDEF.INC
include BASTKN.INC
CR equ 0Dh
LF equ 0Ah
TAB equ 09h
public LET,FOR,IFX,ASSIGN,CALLS,CALLX,INT,GOSUB,IFEND
public LOCGET,FTOI1,ITOF,MKSTR,VFVAL,VFSTR,NEXT,RETURN
public GOTO,ON,INPUT,LINPUT,PRINT,READ,FNDVAR,SVAL
extrn SKPEOL,SKPOBJ,DNPACK,ALLOC,VAL,DISPAT,CKCTLC
extrn CHKISE,CHKOSE,RDNXBL,RDVFBL,WRVFBL,EVAL,CLRFAC
extrn $INTR,$SBR,STOP,ODEVTT,SETCOL,$TAB,MSG1,EXECUTE
extrn NUMSGN,SAVCH1,PUTCHR,ADDHLA,FLINE,CPHLDE,RETNTR
extrn $POLSH,$IPUSH,$FPOP,$FPSH1,$IR,$RI,$FPUSH,$UNPOL
extrn $IPOP,POPFAC,FRESTR,PSHFAC,CHKSTK,FPST,FPSTS,FPLD
extrn SUBSTK,FPLDS,ADDSTK,IGNORE,RCTLO,MSG,LINGET,SETFLG
extrn SKIPBL,EXPF,NUMCNV,FILEA,VFBLK,STROPR,STPR,CPDEHL
extrn NEGHL,NEGBC,CPBCHL
;-----------------------------------------------------------------------
cseg
; --- LET
LET: call FNDVAR ; find variable
ASSIGN: call GETVAR
ld a,(hl)
inc hl
cp T.EQ ; '=' token?
jp nz,snerr ; if not -> syntax error
call EVAL ; evaluate expression
jr c,asnstr ; jump if it was a string expression
ld a,(hl)
inc hl
cp T.EOL ; '\' token?
jp nz,snerr ; if not -> syntax error
call STOVAR ; assign numeric
jp EXECUTE
asnstr: ld a,(hl)
inc hl
cp T.EOL ; '\' token
jp nz,snerr ; syntax error
call STSVAR ; assign string
jp EXECUTE
; Get offset to variable from program code and index into symbol table.
; Returns DE = address of variable in symbol table.
FNDVAR: ld a,(hl) ; get next char
inc hl
or a
jp m,snerr ; if another token -> syntax error
ld d,a
ld e,(hl) ; get offset to variable (note order!)
inc hl
ex de,hl
ld bc,(SYMBOL)
add hl,bc ; index into symbol table
ex de,hl ; DE = var addr
ret
; --- IF
IFX: call EVAL ; evaluate expression (left side)
jp nc,ifn1 ; jump if numeric expr
; string comparison
ld a,(hl)
cp T.LE ; '<=' token
jr c,snerr ; if below -> syntax error
cp T.EQ+1 ; '=' token
jr nc,snerr ; if above -> syntax error
call CHKSTK
ld e,(hl)
inc hl
ld d,0
push de ; push token
call EVAL ; evaluate expression (right side)
jp nc,tmerr ; if numeric expr -> type mismatch
pop de ; pop address of right-side string into DE
pop bc ; pop saved token
ex (sp),hl ; pop address of left-side string into HL
push bc ; push token back
ld bc,0 ; clear lengths
ld a,h ; left side is null string?
and l
inc a
jr z,ifs1 ; jump if yes
ld b,(hl) ; else get length into B
ifs1: ld a,d ; right side is null string?
and e
inc a
jr z,ifs2 ; jump if yes
ld a,(de)
ld c,a ; else get length into C
ifs2: inc hl ; advance to start of both strings
inc hl
inc hl
inc de
inc de
inc de
jr ifs4
ifs3: ld a,(de)
cp (hl)
inc hl
inc de
jr nz,ifs11
ifs4: ld a,c ; check remaining length of right-side string
or a
jr z,ifs6 ; jump if at end
ld a,b ; check remaining length of left-side string
or a
jr z,ifs5 ; jump if at end
dec c
dec b
jr ifs3 ; else loop to compare chars
; end of left-side string
ifs5: ld a,(de) ; check right-side
cp ' ' ; space?
inc de
jr nz,ifs11 ; exit loop if not
dec c ; else try next char
jr nz,ifs5
jr ifs8 ; strings are equal (trailing spaces ignored)
; end of right-side string
ifs6: ld a,b ; check left-side remaining length
or a
jr z,ifs8 ; if zero, strings are the same
ifs7: ld a,' '
cp (hl) ; space? (note reverse comp. to set M flag)
inc hl
jr nz,ifs11 ; exit loop if not
djnz ifs7 ; else ignore
ifs8: pop de ; pop saved token
pop hl ; restore HL
ifs9: ld a,(hl)
inc hl
cp T.THEN ; THEN
jr z,ifs10
cp T.GOTO ; GOTO
jr nz,snerr ; syntax error
ifs10: ld a,e ; check saved token
cp T.LE ; '<=' token
jr z,ifn7
cp T.GE ; '>=' token
jr z,ifn7
cp T.EQ ; '=' token
jr z,ifn7
jp ifn10
snerr: rst 10h
db 06h ; syntax error
ifs11: jp m,ifn4 ; -> '>'
pop de ; pop saved token
pop hl ; restore HL
jr ifn2 ; -> '<'
; numeric comparison
ifn1: ld a,(hl)
cp T.LE ; '<=' token?
jr c,snerr ; if below -> syntax error
cp T.EQ+1 ; '=' token?
jr nc,snerr ; if above -> syntax error
call CHKSTK
call PSHFAC ; push FP accum on stack
ld bc,(CLCMOD)
push bc ; push CLCMOD
ld e,(hl)
inc hl
ld d,0
push de ; push token
call EVAL ; evaluate expression (right side)
jr c,tmerr ; if string expr -> type mismatch
pop de ; pop token
call SUBSTK ; subtract to compare numbers
jr z,ifs9
jp m,ifn5
ifn2: ld a,(hl)
inc hl
cp T.THEN ; THEN
jr z,ifn3
cp T.GOTO ; GOTO
jr nz,snerr ; syntax error
ifn3: ld a,e ; check saved token
cp T.LE ; '<=' token
jr z,ifn7
cp T.LT ; '<' token
jr z,ifn7
cp T.NE ; '<>' token
jr z,ifn7
jr ifn10
tmerr: rst 10h
db 1Eh ; type mismatch
ifn4: pop de ; pop saved token
pop hl ; restore HL
ifn5: ld a,(hl)
inc hl
cp T.THEN ; THEN
jr z,ifn6
cp T.GOTO ; GOTO
jr nz,snerr1 ; -> syntax error
ifn6: ld a,e ; check saved token
cp T.GE ; '>=' token
jr z,ifn7
cp T.GT ; '>' token
jr z,ifn7
cp T.NE ; '<>' token
jr z,ifn7
jr ifn10
ifn7: push hl ; save HL
call FLINE ; get offset to line
jr c,ifn9
ld a,(hl)
cp T.EOL ; '\' token?
jr nz,snerr1 ; if not -> syntax error
pop hl ; drop saved HL
ex de,hl
ld a,(hl) ; get offset to line
inc hl
ld h,(hl)
ld l,a
or h ; zero?
jr nz,ifn8 ; jump if not
rst 10h
db 05h ; else error -> undefined line number
ifn8: ld de,(CODE)
add hl,de ; obtain code address
jp EXECUTE ; continue execution from new point
ifn9: pop hl ; restore HL
dec hl
ld a,(hl)
inc hl
cp T.GOTO ; previous token was a GOTO?
jp nz,EXECUTE
jr snerr1 ; if yes -> syntax error
ifn10: call FLINE
jr nc,ifn12
ifn11: call SKPEOL ; find end of statement (or program line)
ld a,(hl)
cp T.EOF ; "end of program" token?
jp z,EXECUTE
call FLINE
jr c,ifn11 ; loop until found
jp EXECUTE
ifn12: ld a,(hl)
inc hl
cp T.EOL ; '\' token?
jr nz,snerr1 ; if not -> syntax error
jp EXECUTE
; --- IF END #
IFEND: call CHKISE ; get channel #, check for read, set IDEV
ld a,(hl) ; get next token
inc hl
cp T.THEN ; must be THEN
jr z,ife1
cp T.GOTO ; or GOTO
jr nz,snerr1
ife1: ld de,(IDEV) ; DE = chan descriptor address
ld a,d
or e
jr z,icnerr ; if zero -> illegal channel number
push de
pop ix
ld a,(ix+2) ; check buffer descriptor address
or (ix+3)
jr z,cnoerr ; if zero -> channel not open
bit 2,(ix+0) ; 0004h
jr nz,ifn7
jr ifn10
snerr1: rst 10h
db 06h ; syntax error
icnerr: rst 10h
db 16h ; illegal channel number
cnoerr: rst 10h
db 15h ; channel not open
; --- RETURN
RETURN: ld a,(hl)
inc hl
cp T.EOL ; end of line follows?
jr nz,snerr1 ; syntax error if not
ld de,(GSBCTR)
ld a,d
or e
jr z,rtnerr ; -> RETURN without GOSUB
dec de
ld (GSBCTR),de
ld a,d
or e
call z,RETNTR ; empty routine
inc de
ex de,hl
add hl,hl
ld bc,(PDL)
add hl,bc
ld a,(hl)
inc hl
ld h,(hl)
ld l,a
or h
jp nz,EXECUTE
rtnerr: rst 10h
db 26h ; RETURN without GOSUB
; --- FOR
FOR: dec hl
push hl ; save start of FOR statement for NEXT block
inc hl
call FNDVAR ; find variable
ld a,(de)
and 03h
jr z,snerr1 ; -> syntax error
ld a,(de)
and 0Ch
jr nz,snerr1 ; -> syntax error
ld a,(hl)
inc hl
cp T.EQ ; '=' must follow
jr nz,snerr1 ; else -> syntax error
ld (VARSAV),de ; save variable address
call EVAL ; evaluate expression
jp c,tmerr ; if string expr -> type mismatch
ld bc,-1
ld (SS1SAV),bc
call STOVAR ; store value
ld a,(hl)
inc hl
cp T.TO ; TO must follow
jr nz,snerr1
call EVAL ; evaluate expression
jp c,tmerr ; if string expr -> type mismatch
call FTOI
ld ix,SS1SAV ; IX = &SS1SAV
call FPST ; store FP accum into SS1SAV
ld bc,0
ld (FAC1),bc ; default step value is 1
inc bc
ld (FAC2),bc
ld a,(hl)
cp T.EOL ; end of statement?
jr z,for1 ; jump if yes
inc hl
cp T.STEP ; else can be only STEP
jp nz,snerr4 ; -> syntax error
call EVAL ; evaluate expression
jp c,tmerr ; if string expr -> type mismatch
ld a,(hl)
cp T.EOL ; end of statement?
jp nz,snerr4 ; nothing else allowed
for1: call FTOI
push hl
for2: call SKPEOL ; find end of statement (or program line)
ld a,(hl) ; get next program byte
or a ; token?
jp m,for3 ; branch if yes
inc hl ; else skip over variable
inc hl
for3: ld a,(hl)
cp T.EOF ; end of program?
jr z,fwnerr ; -> NEXT not found
cp T.NEXT ; NEXT
jr z,for4
cp T.FOR ; FOR?
jr nz,for2 ; loop if not
inc hl
call FNDVAR ; find variable
dec hl
push hl
ld hl,(VARSAV)
call CPHLDE ; same variable?
pop hl
jr nz,for2 ; loop if not
ld (CPSAVE),hl ; else is error
rst 10h
db 27h ; nested FOR statements with same control var
fwnerr: rst 10h
db 28h ; FOR without NEXT
; NEXT found
for4: inc hl
push hl ; save HL
ld de,10
add hl,de
if 0
call FNDVAR ; get variable address
else
ld a,(hl) ; get next char
inc hl
or a
jp m,for5 ; if another token -> syntax error
ld d,a
ld e,(hl) ; get offset to variable (note order!)
inc hl
ex de,hl
ld bc,(SYMBOL)
add hl,bc ; index into symbol table
ex de,hl ; DE = var addr
endif
ld a,(hl)
cp T.EOL ; '\' token must follow
jr nz,snerr3 ; else -> save HL -> syntax error
push hl
ld hl,(VARSAV)
call CPHLDE ; same variable?
pop hl
jr z,for6 ; jump if yes
pop bc ; drop saved HL, use new
jr for2 ; keep searching
for5: pop hl
jp snerr3 ; error -> save HL -> syntax error
; NEXT var matches
for6: pop de ; get old HL in DE
push de
ld hl,5
add hl,sp
ld a,(hl) ; store word (sp+2) to (de) swapping bytes
ld (de),a ; (addr of FOR statement)
inc de ; HL+1
dec hl
ld a,(hl) ; !!!TODO: better use static var (e.g. CPSAVE)
ld (de),a
ld ix,5
add ix,de ; IX = HL+6
call FPSTS ; store FP accum swapping bytes
pop hl ; restore old HL
ld ix,SS1SAV ; IX = &SS1SAV
call FPLD ; store number into FP accum
push hl
pop ix
inc ix
inc ix ; IX = HL+2
call FPSTS ; store FP accum swapping bytes
push hl
pop ix ; get HL into IX
ld b,(ix+6) ; get FOR limit (FAC1), note order!
ld c,(ix+7)
ld a,b
or c
jr nz,for7
ld b,(ix+8)
for7: push bc
ld bc,10
add hl,bc ; HL += 10
call PSHFAC ; push FP accum on stack
ld bc,(CLCMOD)
push bc ; push CLCMOD
call EVAL ; evaluate expression
call SUBSTK ; subtract to compare numbers
jr z,for10
jp m,for8
pop bc ; pop CLCMOD
ld a,b
or a
jp m,for11 ; jump if integer
jr for9
snerr3: ld (CPSAVE),hl
snerr4: rst 10h
db 06h ; syntax error
for8: pop bc
ld a,b
or a
jp p,for11
for9: pop bc ; drop word
pop bc ; drop word
push hl ; restore code pointer
pop ix
xor a
ld (ix-12),a
ld (ix-11),a
jp EXECUTE
for10: pop bc ; drop word
for11: pop hl ; restore code pointer
pop bc ; drop word
jp EXECUTE
; --- NEXT
NEXT: ld d,(hl) ; get address of FOR statement (note order!)
inc hl
ld e,(hl)
dec hl
push hl
ld hl,(SYMBOL)
call CPHLDE
pop hl
jp nc,nwferr ; if DE >= SYMBOL -> NEXT without FOR
ld a,(de)
inc de
cp T.FOR ; FOR
jp nz,nwferr ; -> NEXT without FOR
push hl
pop ix
ld a,(ix+10)
or a
jp m,snerr5 ; -> syntax error
ld b,a
ld c,(ix+11) ; note order!
push hl
ld hl,(SYMBOL)
add hl,bc
ld c,l
ld b,h
pop hl
ld a,(de)
inc de
cp (ix+10)
jp nz,nwferr ; -> NEXT without FOR
ld a,(de)
inc de
cp (ix+11)
jp nz,nwferr ; -> NEXT without FOR
ld a,(de)
cp T.EQ
jp nz,nwferr ; -> NEXT without FOR
ld (VARSAV),bc
ld e,c
ld d,b
push hl
pop ix
ld bc,6
add ix,bc ; IX = HL+6
call FPLDS ; store loop step value
call PSHFAC ; push FP accum on stack
ld bc,(FAC1)
ld a,b
or c
jr nz,next1
ld bc,-1
jr next2
next1: ld bc,1
next2: push bc
ld a,(de)
inc de
inc de
and 02h
jr nz,next3
call CLRFAC ; clear FP accum
ld a,(de)
ld c,a
inc de
ld a,(de)
ld b,a
ld (FAC2),bc
ld bc,-1 ; integer
ld (CLCMOD),bc
jr next4
next3: ld bc,1 ; float
ld (CLCMOD),bc
push de
pop ix ; IX = address of number
call FPLD ; load FP accum from IX
next4: ld ix,0
add ix,sp
ld c,(ix+2)
ld b,(ix+3)
ld a,b
or c
jr nz,next5
ld c,(ix+4)
ld b,(ix+5)
next5: ld (SS2SAV),bc
call ADDSTK ; add step value
call PSHFAC ; push result on stack
call PSHFAC ; twice
push hl
pop ix
inc ix
inc ix ; IX = HL+2
call FPLDS ; store loop limit
ld bc,(CLCMOD)
push bc ; push CLCMOD
call SUBSTK ; subtract to compare numbers
jr z,next8
jp p,next6
ld bc,(SS2SAV)
ld a,b
or a
jp m,next8
jr next7
next6: ld bc,(SS2SAV)
ld a,b
or a
jp p,next8
next7: xor a
ld (hl),a
inc hl
ld (hl),a
ld bc,11
add hl,bc ; HL += 12
pop bc ; restore stack
pop bc
jp EXECUTE ; end of FOR loop, continue after NEXT
next8: ld a,(hl)
inc hl
ld l,(hl) ; note order!
ld h,a
call POPFAC ; pop FP accum from stack
ld bc,-1
ld (SS1SAV),bc
call STOVAR ; assign value
jp IGNORE
nwferr: rst 10h
db 29h ; NEXT without FOR
snerr5: rst 10h
db 06h ; syntax error
; --- PRINT
PRINT: call ODEVTT ; set ODEV to terminal
ld a,(hl)
cp T.FILN ; '#' token?
jr nz,prnt1 ; jump if not
inc hl
call CHKOSE ; get channel #, check for write, set ODEV
ex de,hl
add hl,hl
ex de,hl ; DE = chan# * 2
ld a,d
or e
call nz,SETCOL ; if not zero, set COLUMN accordingly
ld a,(hl)
cp T.EOL ; '\' token?
jp z,prnt7 ; jump if yes
call chksep ; else require ':' or ','
prnt1: ld a,(hl)
cp T.USNG ; USING
jp z,PRU
prnt2: cp T.COM ; ',' token
jp z,prnt6
cp T.SEM ; ';' token
jp z,prnt7
cp T.EOL ; '\' token
jp z,prnt7
cp T.TAB ; TAB(
jp z,prnt15
ld bc,(T4)
push bc
call EVAL ; evaluate expression
jr c,prnt3 ; jump if string expr
pop bc
ld (T4),bc
xor a
ld (T1),a ; clear length
push hl
ld hl,-16
add hl,sp ; alloc buffer on stack [!!!TODO: use static buf?]
ld sp,hl
ld (T2),hl ; init pointer for SAVCH1 routine
call NUMSGN ; convert number
dw SAVCH1 ; output routine addr
ld a,(T1)
ld b,a
call prnt4 ; output string
ld hl,16
add hl,sp
ld sp,hl ; dealloc buffer
pop hl
call MSG1
db ' ',0
jr prnt7 ; go to next column
; string expression
prnt3: call FRESTR ; free string by clearing backpointer
pop bc
ld (T4),bc
ld a,d
or e
jr z,prnt7
dec de
ld a,(de) ; get length
ld b,a ; into B
inc de
inc de
inc de ; DE = start of string
push hl
ex de,hl
call prnt4 ; output string
pop hl
jr prnt7
prnt4: ld de,(ODEV)
ld a,d
or e
jr nz,prnt5
ld a,(WIDTH)
or a
jr z,prnt5
ld de,(COLUMN)
ld a,(de)
add a,b ; T1+COLUMN
ld c,a
ld a,(WIDTH)
cp c
call c,PRCRLF ; output newline if T1+COLUMN > WIDTH
prnt5: ld a,(hl) ; get char
inc hl
call PUTCHR ; output char
djnz prnt5 ; loop to print the whole string
ret
prnt6: call MSG1
db ' ',0
prnt7: ld a,(hl)
cp T.EOL ; '\' token
jr nz,prnt8
call PRCRLF ; output newline
jr prnt14
prnt8: cp T.COM ; ',' token
inc hl
jr nz,prnt12
prnt9: ld de,(COLUMN)
ld a,(de)
or a
jr z,prnt13
ld e,a ; E = COLUMN
ld bc,(ODEV)
ld a,b
or c
jr nz,prnt10
ld a,(WIDTH)
or a
jr z,prnt10
sub e
cp 14+1
jr nc,prnt10 ; if E > 14
call PRCRLF ; output newline
jr prnt13
prnt10: ld a,e ;!!!TODO!!! write this loop better
prnt11: sub 14
jr z,prnt13
jp p,prnt11 ; loop
call MSG1
db ' ',0
jr prnt9
prnt12: dec hl
ld a,(hl)
cp T.SEM ; ';' token
jp nz,prnt2
inc hl
prnt13: ld a,(hl)
cp T.EOL ; '\' token
jp nz,prnt2
prnt14: call ODEVTT
jp EXECUTE
prnt15: inc hl
call $TAB
jr prnt7
PRCRLF: call MSG1
db CR,LF,0
ret
; --- READ
READ: ld bc,-1 ;!!!TODO: use static var
push bc
jr inp3
; --- LINPUT
LINPUT: ld bc,1
jr inp1
; --- INPUT
INPUT: ld bc,0
inp1: push bc ; push READ/INPUT/LINPUT flag
ld de,(CODE)
call CPHLDE
jr c,inp2 ; if HL > CODE
rst 10h
db 2Ah ; illegal in immediate mode
inp2: ld bc,0
ld (T3),bc
ld (IDEV),bc
ld a,(hl)
cp T.FILN ; '#' token
jr nz,inp3
inc c ; note not 'inc bc'??
ld (T3),bc
inc hl
call CHKISE ; get channel #, check for read, set IDEV
call chksep ; require ':' or ','
inp3: ld bc,strcr
push bc ; push "CR"
inp4: ld a,(hl)
inc hl
or a
jp p,inp5 ; if not a token
rst 10h
db 06h ; else syntax error
inp5: ld d,a ; note order!
ld e,(hl)
inc hl
push hl
ld hl,(SYMBOL)
add hl,de
ex de,hl
ld hl,(T4)
ex (sp),hl ; push T4, restore HL
call GETVAR
pop bc
ld (T4),bc
inp6: pop de
push de
ld a,(de)
cp CR ; CR
jr z,inp7
or a
jr z,inp9
jp inp17
inp7: pop ix
pop bc ; get INPUT/LINPUT/READ flag
push bc
push ix
ld a,b
or a
jp p,inp14 ; jump if INPUT/LINPUT
push hl
ld hl,(PDL) ; get current DATA pointer
ld e,(hl)
inc hl
ld d,(hl)
pop hl
ld a,d
or e
jr z,ooderr ; if zero -> out of data
inc de ; test for 0FFFFh
ld a,d
or e
dec de
jr z,inp8 ; reset if -1
ld a,(de) ; get program byte
or a
jr z,inp9 ; jump if variable pointer
jr inp16
inp8: ld de,(CODE)
jr inp10
inp9: inc de ; skip over line number or variable
inc de
inp10: ld a,(de) ; get prog byte
or a
jp m,inp11 ; jump if token
inc de ; else skip line number or variable
inc de
inp11: ld a,(de) ; get token
inc de
cp T.DATA ; DATA?
jr z,inp12 ; jump if yes
dec de
cp T.EOF ; 'end of program' token?
jr z,inp13 ; error -> out of data
push hl
ex de,hl
call SKPEOL ; find end of statement (or program line)
ex de,hl
pop hl
jr inp10 ; loop
; DATA found
inp12: inc de ; skip over 'text' token
jr inp16
inp13: ld hl,(PDL)
xor a
ld (hl),a ; clear DATA pointer
inc hl
ld (hl),a
ooderr: rst 10h
db 2Bh ; out of data
inp14: ld bc,(T3)
ld a,b
or c
jr nz,inp15
call RCTLO ; rctrlo
call MSG
db '? ',0
inp15: call LINGET ; get line from terminal or file
jr c,ooderr ; -> out of data
call CKCTLC ; ^C detected?
jp c,STOP ; STOP if yes
ld de,LINE ; DE = begin of input buffer
inp16: pop ix
pop bc ; pop READ/INPUT/LINPUT flag
push bc
push ix
ld a,b
or c
jr z,inp17 ; jump if INPUT
ld a,b
or a
jp p,linp1 ; jump if LINPUT !!must be > 0, not >= 0 (LINPUT)
inp17: ld bc,(VARSAV)
ld a,(bc)
and 03h
jp z,linp3
call NEXTNB ; skip blanks and get char
jr nz,inp18 ; if not CR, comma or null
pop bc
push de
ld a,(de)
cp ','
jr z,inp23
jp inp6
inp18: pop bc
push de
ld c,e
ld b,d
call SVAL ; convert number
ld e,c
ld d,b
jr c,inp23
ld bc,(VARSAV)
ld a,(bc)
and 02h
jr nz,inp19
ld bc,(FAC1)
ld a,b
or c
jr nz,inp23
inp19: pop bc
push de ; replace DE on stack
call STOVAR ; assign value to variable
pop de
push de
inp20: ld a,(de)
cp CR
jr z,inp21
or a
jr z,inp21
cp ','
jr nz,inp23
pop bc
inc bc ; skip over delim in DATA or user input
push bc
inp21: ld a,(hl)
inc hl
cp T.COM ; ',' token
jp z,inp4
cp T.EOL ; '\' token?
jr nz,snerr6 ; no -> syntax error
pop bc
ex (sp),hl
ld a,h ; set flags from value in stack (READ/INPUT/LINPUT)
or a
pop hl ; then drop it
jp p,inp22 ;!!!must be >= 0; jump if INPUT/LINPUT
push hl
ld hl,(PDL)
ld (hl),c ; set new DATA pointer