-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathBASIC disassembly-source.txt
2164 lines (2147 loc) · 36.6 KB
/
BASIC disassembly-source.txt
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
; ----------------------------------------------------------------------------
;Micro-Soft Altair BASIC 3.2 (4K) - Annotated Disassembly
;
;Copyright 1975, Bill Gates, Paul Allen, Monte Davidoff
;Source: http://altairbasic.org/ compiled by Reuben Harris
;Additional cleanup, relocation by Charles Mangin, March, 2019
; ----------------------------------------------------------------------------
ORG 00
Start DI
JMP Init
DW 0490h
DW 07F9h
SyntaxCheck MOV A,M ;A=Byte of BASIC program.
XTHL ;HL=return address.
CMP M ;Compare to byte expected.
INX H ;Return address++;
XTHL ;
JNZ SyntaxError ;Error if not what was expected.
NextChar INX H
MOV A,M
CPI 0x3A
RNC
JMP NextChar_tail
OutChar PUSH PSW
LDA TERMINAL_X
JMP OutChar_tail
NOP
CompareHLDE MOV A,H
SUB D
RNZ
MOV A,L
SUB E
RET
TERMINAL_Y DB 01
TERMINAL_X DB 00
FTestSign LDA FACCUM+3
ORA A
JNZ FTestSign_tail
RET
PushNextWord XTHL
SHLD L003A+1
POP H
MOV C,M
INX H
MOV B,M
INX H
PUSH B
L003A JMP L003A
KW_INLINE_FNS DW Sgn
DW Int
DW Abs
DW FunctionCallError
DW Sqr
DW Rnd
DW Sin
KW_ARITH_OP_FNS DB 79h
DW FAdd ;+
DB 79h
DW FSub ;-
DB 7Ch
DW FMul ;*
DB 7Ch
DW FDiv ;/
KEYWORDS DB 454EC4h ;"END" 80
DB 464FD2h ; "FOR"
DB 4E4558D4h ; "NEXT" 82
DB 444154C1h ; "DATA" 83
DB 494E5055D4h ; "INPUT" 84
DB 4449CDh ; "DIM" 85
DB 524541C4h ; "READ" 86
DB 4C45D4h ; "LET" 87
DB 474F54CFh ; "GOTO" 88
DB 5255CEh ; "RUN" 89
DB 49C6h ; "IF" 8A
DB 524553544F52C5h ; "RESTORE" 8B
DB 474F5355C2h ; "GOSUB" 8C
DB 5245545552CEh ; "RETURN" 8D
DB 5245CDh ; "REM" 8E
DB 53544FD0h ; "STOP" 8F
DB 5052494ED4h ; "PRINT" 90
DB 4C4953D4h ; "LIST" 91
DB 434C4541D2h ; "CLEAR" 92
DB 4E45D7h ; "NEW" 93
;
DB 544142A8h ; "TAB(" 94
DB 54CFh ; "TO" 95
DB 544845CEh ; "THEN" 96
DB 535445D0h ; "STEP" 97
;
DB 0xAB ; "+" 98
DB 0xAD ; "-" 99
DB 0xAA ; "*" 9A
DB 0xAF ; "/" 9B
DB 0xBE ; ">" 9C
DB 0xBD ; "=" 9D
DB 0xBC ; "<" 9E
;
DB 5347CEh ; "SGN" 9F
DB 494ED4h ; "INT" A0
DB 4142D3h ; "ABS" A1
DB 5553D2h ; "USR" A2
DB 5351D2h ; "SQR" A3
DB 524EC4h ; "RND" A4
DB 5349CEh ; "SIN" A5
;
DB 0x00 ;
;
KW_GENERAL_FNS DW Stop ;END
DW For ;FOR
DW Next ;NEXT
DW FindNextStatement ;DATA
DW Input ;INPUT
DW Dim ;DIM
DW Read ;READ
DW Let ;LET
DW Goto ;GOTO
DW Run ;RUN
DW If ;IF
DW Restore ;RESTORE
DW Gosub ;GOSUB
DW Return ;RETURN
DW Rem ;REM
DW Stop ;STOP
DW Print ;PRINT
DW List ;LIST
DW Clear ;CLEAR
DW New ;NEW
ERROR_CODES DB 4EC6h ;"NF" NEXT without FOR.
DB 53CEh ;"SN" Syntax Error
DB 52C7h ;"RG" RETURN without GOSUB.
DB 4FC4h ;"OD" Out of Data
DB 46C3h ;"FC" Illegal Function Call
DB 4FD6h ;"OV" Overflow.
DB 4FCDh ;"OM" Out of memory.
DB 55D3h ;"US" Undefined Subroutine
DB 42D3h ;"BS" Bad Subscript
DB 44C4h ;"DD" Duplicate Definition
DB 2FB0h ;"\0" Division by zero.
DB 49C4h ;"ID" Invalid in Direct mode.
DB ',' ;
LINE_BUFFER DW 0000,0000,0000,0000h ;72 chars
DW 0000,0000,0000,0000h ;
DW 0000,0000,0000,0000h ;
DW 0000,0000,0000,0000h ;
DW 0000,0000,0000,0000h ;
DW 0000,0000,0000,0000h ;
DW 0000,0000,0000,0000h ;
DW 0000,0000,0000,0000h ;
DW 0000,0000,0000,0000h ;
DIM_OR_EVAL DB 00h ;
INPUT_OR_READ DB 00h ;
PROG_PTR_TEMP DW 0000h ;
L015F DW 0000h ;
CURRENT_LINE DW 0000h ;
STACK_TOP DW 0F1Ah ; RELOCATE***
PROGRAM_BASE DW 0000h ;
VAR_BASE DW 0000h ;
VAR_ARRAY_BASE DW 0000h ;
VAR_TOP DW 0000h ;
DATA_PROG_PTR DW 0000h ;
FACCUM DB 00000000h ;
FTEMP DB 00h ;
FBUFFER DW 0000,0000,0000
DW 0000,0000,0000
DB 00 ;
szError DB 0x20,0x45,0x52,0x52,0x4F,0xD2,0x00 ;" ERROR\0"
szIn DB 0x20,0x49,0x4E,0xA0,0x00 ;" IN \0"
szOK DB 0x0D,0x4F,0xCB,0x0D,0x00 ;"\rOK\r\0"
GetFlowPtr LXI H,0004h ;HL=SP+4 (ie get word
DAD SP ;just past return addr)
MOV A,M ;
INX H ;
CPI 0x81 ;'FOR'?
RNZ ;Return if not 'FOR'
RST 6 ; RST PushNextWord ;PUSH (HL)
XTHL ;POP HL (ie HL=(HL))
RST 4 ; RST CompareHLDE ;HL==DE?
LXI B,000Dh ;
POP H ;Restore HL
RZ ;Return if var ptrs match.
DAD B ;HL+=000D
JMP GetFlowPtr+4 ;Loop
CopyMemoryUp CALL CheckEnoughMem;
PUSH B ;Exchange BC with HL.
XTHL ;
POP B ;
CopyMemLoop RST 4 ;HL==DE?
MOV A,M ;
STAX B ;
RZ ;Exit if DE reached.
DCX B ;
DCX H ;
JMP CopyMemLoop ;
CheckEnoughVarSpace PUSH H ;
LHLD VAR_TOP ;
MVI B,00h ;BC=C*4
DAD B ;
DAD B ;
CALL CheckEnoughMem;
POP H ;
RET ;
CheckEnoughMem PUSH D ;
XCHG ;
LXI H,0xFFDE ;HL=-34 (extra 2 bytes for return address)
DAD SP ;
RST 4 ;
XCHG ;
POP D ;
RNC ;
OutOfMemory MVI E,0Ch ;
DB 01 ;LXI B,.... ;
SyntaxError MVI E,02h ;
DB 01 ;LXI B,.... ;
DivideByZero MVI E,14h ;
Error CALL ResetStack ;
CALL NewLine ;
LXI H,ERROR_CODES ;
MOV D,A ;
MVI A,'?' ;Print '?'
RST 03 ;RST OutChar ;
DAD D ;HL points to error code.
MOV A,M ;
RST 03 ;RST OutChar 11 011 111 ;Print first char of code.
RST 02 ;RST NextChar 11 010 111 ;
RST 03 ;RST OutChar ;Print second char of code.
LXI H,szError ;Print " ERROR".
CALL PrintString ;
LHLD CURRENT_LINE ;
MOV A,H ;
ANA L ;
INR A ;
CNZ PrintIN ;
DB 01 ;LXI B,.... ;LXI over Stop and fall into Main
Stop RNZ ;Syntax Error if args.
POP B ;Lose return address.
Main LXI H,szOK ;
CALL Init ;
GetNonBlankLine LXI H,0xFFFF ;
SHLD CURRENT_LINE ;
CALL InputLine ;
RST 02 ;RST NextChar ;
INR A ;
DCR A ;
JZ GetNonBlankLine ;
PUSH PSW
CALL LineNumberFromStr
PUSH D
CALL Tokenize
MOV B,A
POP D
POP PSW
JNC Exec
StoreProgramLine PUSH D ;Push line number
PUSH B ;Push line length
RST 02 ;RST NextChar ;Get first char of line
ORA A ;Zero set if line is empty (ie removing a line)
PUSH PSW ;Preserve line-empty flag
CALL FindProgramLine ;Get nearest program line address in BC.
PUSH B ;Push line address.
JNC InsertProgramLine ;If line doesn't exist, jump ahead to insert it.
RemoveProgramLine XCHG ;DE=Next line address.
LHLD VAR_BASE ;
RemoveLine LDAX D ;Move byte of program remainder down
STAX B ;in memory.
INX B ;
INX D ;
RST 4 ;Loop until DE==VAR_BASE, ie whole
JNZ RemoveLine ;program remainder done.
MOV H,B ;
MOV L,C ;Update VAR_BASE from BC.
SHLD VAR_BASE ;
InsertProgramLine POP D ;DE=Line address (from 224)
POP PSW ;Restore line-empty flag (see above)
JZ UpdateLinkedList;If line is empty, then we don't need to insert it so can jump ahead.
LHLD VAR_BASE ;
XTHL ;HL = Line length (see 21D)
POP B ;BC = VAR_BASE
DAD B ;HL = VAR_BASE + line length.
PUSH H ;
CALL CopyMemoryUp ;Move remainder of program so there's enough space for the new line.
POP H ;
SHLD VAR_BASE ;Update VAR_BASE
XCHG ;HL=Line address, DE=VAR_BASE
MOV M,H ;???
INX H ;Skip over next line ptr (updated below)
INX H ;
POP D ;DE = line number (see 21C)
MOV M,E ;Write line number to program line memory.
INX H ;
MOV M,D ;
INX H ;
CopyFromBuffer LXI D,LINE_BUFFER ;Copy the line into the program.
LDAX D ;
MOV M,A ;
INX H ;
INX D ;
ORA A ;
JNZ CopyFromBuffer+3;
UpdateLinkedList CALL ResetAll ;
INX H ;
XCHG ;
L0265 MOV H,D ;
MOV L,E ;
MOV A,M ;If the pointer to the next line is a null
INX H ;word then we've reached the end of the
ORA M ;program, job is done, and we can jump back
JZ GetNonBlankLine ;to let the user type in the next line.
INX H ;Skip over line number.
INX H ;
INX H ;
XRA A ;
L0271 CMP M ;
INX H ;
JNZ L0271 ;
XCHG ;
MOV M,E ;
INX H ;
MOV M,D ;
JMP L0265 ;
FindProgramLine LHLD PROGRAM_BASE ;
MOV B,H ;BC=this line
MOV C,L ;
MOV A,M ;If we've found two consecutive
INX H ;null bytes, then we've reached the end
ORA M ;of the program and so return.
DCX H ;
RZ ;
PUSH B ;Push this line address
RST 6 ;Push (next line address)
RST 6 ;Push (this line number)
POP H ;HL = this line number
RST 4 ;Compare line numbers
POP H ;HL = next line address
POP B ;BC = this line address
CMC ;
RZ ;Return carry set if line numbers match.
CMC ;
RNC ;Return if we've reached a line number greater than the one required.
JMP FindProgramLine+3
New RNZ
LHLD PROGRAM_BASE
XRA A
MOV M,A
INX H
MOV M,A
INX H
SHLD VAR_BASE
Run RNZ
ResetAll LHLD PROGRAM_BASE
DCX H
Clear SHLD PROG_PTR_TEMP
CALL Restore
LHLD VAR_BASE
SHLD VAR_ARRAY_BASE
SHLD VAR_TOP
ResetStack POP B
LHLD STACK_TOP
SPHL
XRA A
MOV L,A
PUSH H
PUSH B
LHLD PROG_PTR_TEMP
RET
InputLineWith MVI A,'?' ;Print '?'
RST 03 ;RST OutChar ;
MVI A,' ' ;Print ' '
RST 03 ;RST OutChar ;
CALL InputLine ;
INX H ;
Tokenize MVI C,05 ;Initialise line length to 5.
LXI D,LINE_BUFFER ;ie, output ptr is same as input ptr at start.
MOV A,M ;
CPI ' ' ;
JZ WriteChar ;
MOV B,A ;
CPI '"' ;
JZ FreeCopy ;
ORA A ;
JZ Exit ;
PUSH D ;Preserve output ptr.
MVI B,00 ;Initialise Keyword ID to 0.
LXI D,KEYWORDS-1 ;
PUSH H ;Preserve input ptr.
DB 3Eh ;LXI over get-next-char
KwCompare RST 02 ; RST 01 ; SyntaxCheck0 ;Get next input char
INX D ;
LDAX D ;Get keyword char to compare with.
ANI 7Fh ;Ignore bit 7 of keyword char.
JZ NotAKeyword ;If keyword char==0, then end of keywords reached.
CMP M ;Keyword char matches input char?
JNZ NextKeyword ;If not, jump to get next keyword.
LDAX D ;
ORA A ;
JP KwCompare ;
POP PSW ;Remove input ptr from stack. We don't need it.
MOV A,B ;A=Keyword ID
ORI 0x80 ;Set bit 7 (indicates a keyword)
DB 0xF2 ;JP .... ;LXI trick again.
NotAKeyword POP H ;Restore input ptr
MOV A,M ;and get input char
POP D ;Restore output ptr
WriteChar INX H ;Advance input ptr
STAX D ;Store output char
INX D ;Advance output ptr
INR C ;C++ (arf!).
SUI 8Eh ;If it's not the
JNZ Tokenize+5 ;
MOV B,A ;B=0
FreeCopyLoop MOV A,M ;A=Input char
ORA A ;If char is null then exit
JZ Exit ;
CMP B ;If input char is term char then
JZ WriteChar ;we're done free copying.
FreeCopy INX H ;
STAX D ;
INR C ;
INX D ;
JMP FreeCopyLoop ;
NextKeyword POP H ;Restore input ptr
PUSH H ;
INR B ;Keyword ID ++;
XCHG ;HL=keyword table ptr
NextKwLoop ORA M ;Loop until
INX H ;bit 7 of previous
JP NextKwLoop ;keyword char is set.
XCHG ;DE=keyword ptr, HL=input ptr
JMP KwCompare+2 ;
Exit LXI H,LINE_BUFFER-1 ;
STAX D ;
INX D ;
STAX D ;
INX D ;
STAX D ;
RET ;
Backspace DCR B ;Char count--;
DCX H ;Input ptr--;
RST 03 ;RST OutChar ;Print backspace char.
JNZ InputNext ;
ResetInput RST 03 ;RST OutChar ;
CALL NewLine ;
InputLine LXI H,LINE_BUFFER ;
MVI B,01 ;
InputNext CALL InputChar ;
CPI 0x0D ;
JZ TerminateInput ;
CPI ' ' ;If < ' '
JC InputNext ;or
CPI 0x7D ;> '}'
JNC InputNext ;then loop back.
CPI '@' ;
JZ ResetInput ;
CPI '_' ;
JZ Backspace ;
MOV C,A ;
MOV A,B ;
CPI 0x48 ;
MVI A,07 ;
JNC L036A ;
MOV A,C ;Write char to LINE_BUFFER.
MOV M,C ;
INX H ;
INR B ;
L036A RST 03 ;RST OutChar ;
JMP InputNext ;
OutChar_tail CPI 0x48 ;
CZ NewLine ;
INR A ;
STA TERMINAL_X ;
WaitTermReady IN 00 ;
ANI 80h ;
JNZ WaitTermReady ;
POP PSW ;
OUT 01 ;
RET ;
InputChar IN 00 ;
ANI 01 ;
JNZ InputChar ;
IN 01 ;
ANI 7Fh ;
RET ;
List CALL LineNumberFromStr
RNZ
POP B ;?why get return address?
CALL FindProgramLine
PUSH B
ListNextLine POP H
RST 6
POP B
MOV A,B
ORA C
JZ Main
CALL TestBreakKey
PUSH B
CALL NewLine
RST 6
XTHL
CALL PrintInt
MVI A,' '
POP H
ListChar RST 03 ;RST OutChar
MOV A,M
ORA A
INX H
JZ ListNextLine
JP ListChar
SUI 7Fh ;A is now keyword index + 1.
MOV C,A
PUSH H
LXI D,KEYWORDS
PUSH D
ToNextKeyword LDAX D
INX D
ORA A
JP ToNextKeyword
DCR C
POP H
JNZ ToNextKeyword-1
PrintKeyword MOV A,M
ORA A
JM ListChar-1
RST 03 ;RST OutChar
INX H
JMP PrintKeyword
For CALL Let
XTHL
CALL GetFlowPtr
POP D
JNZ L03E2
DAD B
SPHL
L03E2 XCHG
MVI C,08
CALL CheckEnoughVarSpace
PUSH H
CALL FindNextStatement
XTHL
PUSH H
LHLD CURRENT_LINE
XTHL
RST 01 ; SyntaxCheck; SyntaxCheck
DB 95h ;KWID_TO
CALL EvalExpression
PUSH H
CALL FCopyToBCDE
POP H
PUSH B
PUSH D
LXI B,8100h
MOV D,C
MOV E,D
MOV A,M
CPI 0x97 ;KWID_STEP
MVI A,01h
JNZ PushStepValue
CALL EvalExpression+1
PUSH H
CALL FCopyToBCDE
RST 05 ; FTestSign
POP H
PushStepValue PUSH B
PUSH D
PUSH PSW
INX SP
PUSH H
LHLD PROG_PTR_TEMP
XTHL
EndOfForHandler MVI B,0x81
PUSH B
INX SP
ExecNext CALL TestBreakKey
MOV A,M
CPI ':'
JZ Exec
ORA A
JNZ SyntaxError
INX H
MOV A,M
INX H
ORA M
INX H
JZ Main
MOV E,M
INX H
MOV D,M
XCHG
SHLD CURRENT_LINE
XCHG
Exec RST 02 ;RST NextChar
LXI D,ExecNext
PUSH D
RZ
SUI 80h
JC Let
CPI 0x14
JNC SyntaxError
RLC ;BC = A*2
MOV C,A
MVI B,00h
XCHG
LXI H,KW_GENERAL_FNS
DAD B
MOV C,M
INX H
MOV B,M
PUSH B
XCHG
RST 02 ;RST NextChar
RET
NextChar_tail CPI ' '
JZ NextChar
CPI '0'
CMC
INR A
DCR A
RET
Restore XCHG
LHLD PROGRAM_BASE
DCX H
L046E SHLD DATA_PROG_PTR
XCHG
RET
TestBreakKey IN 00 ;Exit if no key pressed.
ANI 01 ;
RNZ ;
CALL InputChar ;
CPI 0x03 ;Break key?
JMP Stop
CharIsAlpha MOV A,M
CPI 'A'
RC
CPI 'Z'+1
CMC
RET
GetSubscript RST 02 ;RST NextChar
CALL EvalExpression
RST 05 ; FTestSign
JM FunctionCallError
LDA FACCUM+3
CPI 0x90
JC FAsInteger
FunctionCallError MVI E,08h
JMP Error
LineNumberFromStr DCX H
LXI D,0000
NextLineNumChar RST 02 ;RST NextChar
RNC
PUSH H
PUSH PSW ;Preserve flags
LXI H,1998h ;Decimal 6552
RST 4
JC SyntaxError
MOV H,D
MOV L,E
DAD D
DAD H
DAD D
DAD H
POP PSW
SUI '0'
MOV E,A
MVI D,00h
DAD D
XCHG
POP H
JMP NextLineNumChar
Gosub MVI C,03h
CALL CheckEnoughVarSpace
POP B
PUSH H
PUSH H
LHLD CURRENT_LINE
XTHL
MVI D,0x8C
PUSH D
INX SP
PUSH B
Goto CALL LineNumberFromStr
RNZ
CALL FindProgramLine
MOV H,B
MOV L,C
DCX H
RC
MVI E,0Eh
JMP Error
Return RNZ
MVI D,0xFF
CALL GetFlowPtr
SPHL
CPI 0x8C
MVI E,04h
JNZ Error
POP H
SHLD CURRENT_LINE
LXI H,ExecNext
XTHL
FindNextStatement DB 013Ah ;LXI B,..3A
Rem DB 10h
NOP
FindNextStatementLoop MOV A,M
ORA A
RZ
CMP C
RZ
INX H
JMP FindNextStatementLoop
Let CALL GetVar
RST 01 ; SyntaxCheck
DB 9Dh
AssignVar PUSH D
CALL EvalExpression
XTHL
SHLD PROG_PTR_TEMP
PUSH H
CALL FCopyToMem
POP D
POP H
RET
If CALL EvalExpression
MOV A,M
CALL FPush
MVI D,00
GetCompareOpLoop SUI 9Ch ; KWID_>
JC GotCompareOp
CPI 0x03
JNC GotCompareOp
CPI 0x01
RAL
ORA D
MOV D,A
RST 02 ;RST NextChar
JMP GetCompareOpLoop
GotCompareOp MOV A,D
ORA A
JZ SyntaxError
PUSH PSW
CALL EvalExpression
RST 01 ; SyntaxCheck
DB 96h ;KWID_THEN
DCX H
POP PSW
POP B
POP D
PUSH H
PUSH PSW
CALL FCompare
INR A
RAL
POP B
ANA B
POP H
JZ Rem
RST 02 ;RST NextChar
JC Goto
JMP Exec+5
DCX H
RST 02 ;RST NextChar
Print JZ NewLine
RZ
CPI '"'
CZ PrintString-1
JZ Print-2
CPI 0x94 ;KWID_TAB
JZ Tab
PUSH H
CPI ','
JZ ToNextTabBreak
CPI ';'
JZ ExitTab
POP B
CALL EvalExpression
PUSH H
CALL FOut
CALL PrintString
MVI A,' '
RST 03 ;RST OutChar
POP H
JMP Print-2
TerminateInput MVI M,00h
LXI H,LINE_BUFFER-1
NewLine MVI A,0Dh
STA TERMINAL_X
RST 03 ;RST OutChar
MVI A,0Ah
RST 03 ;RST OutChar
LDA TERMINAL_Y
PrintNullLoop DCR A
STA TERMINAL_X
RZ
PUSH PSW
XRA A
RST 03 ;RST OutChar
POP PSW
JMP PrintNullLoop
INX H
PrintString MOV A,M
ORA A
RZ
INX H
CPI '"'
RZ
RST 03 ;RST OutChar
CPI 0x0D
CZ NewLine
JMP PrintString
ToNextTabBreak LDA TERMINAL_X
CPI 0x38
CNC NewLine
JNC ExitTab
CalcSpaceCount SUI 0Eh
JNC CalcSpaceCount
CMA
JMP PrintSpaces
Tab CALL GetSubscript
RST 01 ; SyntaxCheck
DB 29h ;')'
DCX H
PUSH H
LDA TERMINAL_X
CMA
ADD E
JNC ExitTab
PrintSpaces INR A
MOV B,A
MVI A,' '
PrintSpaceLoop RST 03 ;RST OutChar
DCR B
JNZ PrintSpaceLoop
ExitTab POP H
RST 02 ;RST NextChar
JMP Print+3
Input PUSH H
LHLD CURRENT_LINE
MVI E,16h
INX H
MOV A,L
ORA H
JZ Error
CALL InputLineWith
JMP L05FA+1
Read PUSH H
LHLD DATA_PROG_PTR
L05FA ORI 0xAF
;XRA A
STA INPUT_OR_READ
XTHL
DB 01 ;LXI B,....
ReadNext RST 01 ; SyntaxCheck
DB 2Ch ;','
CALL GetVar
XTHL
PUSH D
MOV A,M
CPI ','
JZ GotDataItem
ORA A
JNZ SyntaxError
LDA INPUT_OR_READ
ORA A
INX H
JNZ NextDataLine+1
MVI A,'?'
RST 03 ;RST OutChar
CALL InputLineWith
GotDataItem POP D
INX H
CALL AssignVar
XTHL
DCX H
RST 02 ;RST NextChar
JNZ ReadNext
POP D
LDA INPUT_OR_READ
ORA A
RZ
XCHG
JNZ L046E
NextDataLine POP H
RST 6
MOV A,C
ORA B
MVI E,06h
JZ Error
INX H
RST 02 ;RST NextChar
CPI 0x83 ;KWID_DATA
JNZ NextDataLine
POP B
JMP GotDataItem
Next CALL GetVar
SHLD PROG_PTR_TEMP
CALL GetFlowPtr
SPHL
PUSH D
MOV A,M
INX H
PUSH PSW
PUSH D
MVI E,00h
JNZ Error
CALL FLoadFromMem
XTHL
PUSH H
CALL FAddMem
POP H
CALL FCopyToMem
POP H
CALL FLoadBCDEfromMem
PUSH H
CALL FCompare
POP H
POP B
SUB B
CALL FLoadBCDEfromMem
JZ ForLoopIsComplete
XCHG
SHLD CURRENT_LINE
MOV L,C
MOV H,B
JMP EndOfForHandler
ForLoopIsComplete SPHL
LHLD PROG_PTR_TEMP
JMP ExecNext
EvalExpression DCX H
MVI D,00h
PUSH D
MVI C,01h
CALL CheckEnoughVarSpace
CALL EvalTerm
SHLD L015F
ArithParse LHLD L015F
POP B
MOV A,M
MVI D,00h
SUI 0x98 ;KWID_PLUS
RC
CPI 0x04
RNC
MOV E,A
RLC
ADD E
MOV E,A
LXI H,KW_ARITH_OP_FNS
DAD D
MOV A,B
MOV D,M
CMP D
RNC
INX H
PUSH B
LXI B,ArithParse
PUSH B
MOV C,D ;???
CALL FPush
MOV D,C
RST 6
LHLD L015F
JMP EvalExpression+3
EvalTerm RST 02 ;RST NextChar
JC FIn
CALL CharIsAlpha
JNC EvalVarTerm
CPI 0x98 ;KWID_PLUS
JZ EvalTerm
CPI '.'
JZ FIn
CPI 0x99 ;KWID_MINUS
JZ EvalMinusTerm
SUI 9Fh
JNC EvalInlineFn
EvalBracketed RST 01 ; SyntaxCheck
DB 28h ;'('
CALL EvalExpression
RST 01 ; SyntaxCheck
DB 29h ;')'
RET
EvalMinusTerm CALL EvalTerm
PUSH H
CALL FNegate
POP H
RET
EvalVarTerm CALL GetVar
PUSH H
XCHG
CALL FLoadFromMem
POP H
RET
EvalInlineFn MVI B,00h
RLC
MOV C,A
PUSH B