/
combined.asm
10210 lines (9564 loc) · 452 KB
/
combined.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
************************************************************************
;
; Microsoft Color Computer Basic
UART EQU $A000
RECEV EQU UART+1
TRANS EQU UART+1
USTAT EQU UART
UCTRL EQU UART
BS EQU 8 ; BACKSPACE
CR EQU $D ; ENTER KEY
ESC EQU $1B ; ESCAPE CODE
SPACE EQU $20 ; SPACE (BLANK)
STKBUF EQU 58 ; STACK BUFFER ROOM
LBUFMX EQU 250 ; MAX NUMBER OF CHARS IN A BASIC LINE
MAXLIN EQU $FA ; MAXIMUM MS BYTE OF LINE NUMBER
* PSEUDO OPS
SKP1 EQU $21 ; OP CODE OF BRN - SKIP ONE BYTE
SKP2 EQU $8C ; OP CODE OF CMPX # - SKIP TWO BYTES
SKP1LD EQU $86 ; OP CODE OF LDA # - SKIP THE NEXT BYTE
* ; AND LOAD THE VALUE OF THAT BYTE INTO ACCA - THIS
* ; IS USUALLY USED TO LOAD ACCA WITH A NON ZERO VALUE
RTS_LOW EQU $15 ; 6850 ACIA CONTROL REGISTER: RX INT DISABLED, RTS LOW, TX INT DISABLED, 8N1, CLK/16
ORG 0
ENDFLG RMB 1 ; STOP/END FLAG: POSITIVE=STOP, NEG=END
CHARAC RMB 1 ; TERMINATOR FLAG 1
ENDCHR RMB 1 ; TERMINATOR FLAG 2
TMPLOC RMB 1 ; SCRATCH VARIABLE
IFCTR RMB 1 ; IF COUNTER - HOW MANY IF STATEMENTS IN A LINE
DIMFLG RMB 1 ; *DV* ARRAY FLAG 0=EVALUATE, 1=DIMENSIONING
VALTYP RMB 1 ; *DV* *PV TYPE FLAG: 0=NUMERIC, $FF=STRING
GARBFL RMB 1 ; *TV STRING SPACE HOUSEKEEPING FLAG
ARYDIS RMB 1 ; DISABLE ARRAY SEARCH: 00=ALLOW SEARCH
INPFLG RMB 1 ; *TV INPUT FLAG: READ=0, INPUT<>0
RELFLG RMB 1 ; *TV RELATIONAL OPERATOR FLAG
TEMPPT RMB 2 ; *PV TEMPORARY STRING STACK POINTER
LASTPT RMB 2 ; *PV ADDR OF LAST USED STRING STACK ADDRESS
TEMPTR RMB 2 ; TEMPORARY POINTER
TMPTR1 RMB 2 ; TEMPORARY DESCRIPTOR STORAGE (STACK SEARCH)
FPA2 RMB 4 ; FLOATING POINT ACCUMULATOR #2 MANTISSA
BOTSTK RMB 2 ; BOTTOM OF STACK AT LAST CHECK
TXTTAB RMB 2 ; *PV BEGINNING OF BASIC PROGRAM
VARTAB RMB 2 ; *PV START OF VARIABLES
ARYTAB RMB 2 ; *PV START OF ARRAYS
ARYEND RMB 2 ; *PV END OF ARRAYS (+1)
FRETOP RMB 2 ; *PV START OF STRING STORAGE (TOP OF FREE RAM)
STRTAB RMB 2 ; *PV START OF STRING VARIABLES
FRESPC RMB 2 ; UTILITY STRING POINTER
MEMSIZ RMB 2 ; *PV TOP OF STRING SPACE
OLDTXT RMB 2 ; SAVED LINE NUMBER DURING A "STOP"
BINVAL RMB 2 ; BINARY VALUE OF A CONVERTED LINE NUMBER
OLDPTR RMB 2 ; SAVED INPUT PTR DURING A "STOP"
TINPTR RMB 2 ; TEMPORARY INPUT POINTER STORAGE
DATTXT RMB 2 ; *PV 'DATA' STATEMENT LINE NUMBER POINTER
DATPTR RMB 2 ; *PV 'DATA' STATEMENT ADDRESS POINTER
DATTMP RMB 2 ; DATA POINTER FOR 'INPUT' & 'READ'
VARNAM RMB 2 ; *TV TEMP STORAGE FOR A VARIABLE NAME
VARPTR RMB 2 ; *TV POINTER TO A VARIABLE DESCRIPTOR
VARDES RMB 2 ; TEMP POINTER TO A VARIABLE DESCRIPTOR
RELPTR RMB 2 ; POINTER TO RELATIONAL OPERATOR PROCESSING ROUTINE
TRELFL RMB 1 ; TEMPORARY RELATIONAL OPERATOR FLAG BYTE
* FLOATING POINT ACCUMULATORS #3,4 & 5 ARE MOSTLY
* USED AS SCRATCH PAD VARIABLES.
** FLOATING POINT ACCUMULATOR #3 :PACKED: ($40-$44)
V40 RMB 1
V41 RMB 1
V42 RMB 1
V43 RMB 1
V44 RMB 1
** FLOATING POINT ACCUMULATOR #4 :PACKED: ($45-$49)
V45 RMB 1
V46 RMB 1
V47 RMB 1
V48 RMB 2
** FLOATING POINT ACCUMULATOR #5 :PACKED: ($4A-$4E)
V4A RMB 1
V4B RMB 2
V4D RMB 2
** FLOATING POINT ACCUMULATOR #0
FP0EXP RMB 1 ; *PV FLOATING POINT ACCUMULATOR #0 EXPONENT
FPA0 RMB 4 ; *PV FLOATING POINT ACCUMULATOR #0 MANTISSA
FP0SGN RMB 1 ; *PV FLOATING POINT ACCUMULATOR #0 SIGN
COEFCT RMB 1 ; POLYNOMIAL COEFFICIENT COUNTER
STRDES RMB 5 ; TEMPORARY STRING DESCRIPTOR
FPCARY RMB 1 ; FLOATING POINT CARRY BYTE
** FLOATING POINT ACCUMULATOR #1
FP1EXP RMB 1 ; *PV FLOATING POINT ACCUMULATOR #1 EXPONENT
FPA1 RMB 4 ; *PV FLOATING POINT ACCUMULATOR #1 MANTISSA
FP1SGN RMB 1 ; *PV FLOATING POINT ACCUMULATOR #1 SIGN
RESSGN RMB 1 ; SIGN OF RESULT OF FLOATING POINT OPERATION
FPSBYT RMB 1 ; FLOATING POINT SUB BYTE (FIFTH BYTE)
COEFPT RMB 2 ; POLYNOMIAL COEFFICIENT POINTER
LSTTXT RMB 2 ; CURRENT LINE POINTER DURING LIST
CURLIN RMB 2 ; *PV CURRENT LINE # OF BASIC PROGRAM, $FFFF = DIRECT
DEVCFW RMB 1 ; *TV TAB FIELD WIDTH
DEVLCF RMB 1 ; *TV TAB ZONE
DEVPOS RMB 1 ; *TV PRINT POSITION
DEVWID RMB 1 ; *TV PRINT WIDTH
RSTFLG RMB 1 ; *PV WARM START FLAG: $55=WARM, OTHER=COLD
RSTVEC RMB 2 ; *PV WARM START VECTOR - JUMP ADDRESS FOR WARM START
TOPRAM RMB 2 ; *PV TOP OF RAM
IKEYIM RMB 1 ; *TV INKEY$ RAM IMAGE
ZERO RMB 2 ; *PV DUMMY - THESE TWO BYTES ARE ALWAYS ZERO
* THE FOLLOWING BYTES ARE MOVED DOWN FROM ROM
LPTCFW RMB 1 ; 16
LPTLCF RMB 1 ; 112
LPTWID RMB 1 ; 132
LPTPOS RMB 1 ; 0
EXECJP RMB 2 ; LB4AA
* THIS ROUTINE PICKS UP THE NEXT INPUT CHARACTER FROM
* BASIC. THE ADDRESS OF THE NEXT BASIC BYTE TO BE
* INTERPRETED IS STORED AT CHARAD.
GETNCH INC <CHARAD+1 ; *PV INCREMENT LS BYTE OF INPUT POINTER
BNE GETCCH ; *PV BRANCH IF NOT ZERO (NO CARRY)
INC <CHARAD ; *PV INCREMENT MS BYTE OF INPUT POINTER
GETCCH FCB $B6 ; *PV OP CODE OF LDA EXTENDED
CHARAD RMB 2 ; *PV THESE 2 BYTES CONTAIN ADDRESS OF THE CURRENT
* * CHARACTER WHICH THE BASIC INTERPRETER IS
* * PROCESSING
JMP BROMHK ; JUMP BACK INTO THE BASIC RUM
VAB RMB 1 ; = LOW ORDER FOUR BYTES OF THE PRODUCT
VAC RMB 1 ; = OF A FLOATING POINT MULTIPLICATION
VAD RMB 1 ; = THESE BYTES ARE USE AS RANDOM DATA
VAE RMB 1 ; = BY THE RND STATEMENT
* EXTENDED BASIC VARIABLES
TRCFLG RMB 1 ; *PV TRACE FLAG 0=OFF ELSE=ON
USRADR RMB 2 ; *PV ADDRESS OF THE START OF USR VECTORS
* EXTENDED BASIC SCRATCH PAD VARIABLES
VCF RMB 2
VD1 RMB 2
VD3 RMB 2
VD5 RMB 2
VD7 RMB 1
VD8 RMB 1
VD9 RMB 1
VDA RMB 1
SW3VEC RMB 3
SW2VEC RMB 3
SWIVEC RMB 3
NMIVEC RMB 3
IRQVEC RMB 3
FRQVEC RMB 3
USRJMP RMB 3 ; JUMP ADDRESS FOR BASIC'S USR FUNCTION
RVSEED RMB 1 ; * FLOATING POINT RANDOM NUMBER SEED EXPONENT
RMB 4 ; * MANTISSA: INITIALLY SET TO $804FC75259
**** USR FUNCTION VECTOR ADDRESSES (EX BASIC ONLY)
USR0 RMB 2 ; USR 0 VECTOR
RMB 2 ; USR 1
RMB 2 ; USR 2
RMB 2 ; USR 3
RMB 2 ; USR 4
RMB 2 ; USR 5
RMB 2 ; USR 6
RMB 2 ; USR 7
RMB 2 ; USR 8
RMB 2 ; USR 9
STRSTK RMB 8*5 ; STRING DESCRIPTOR STACK
LINHDR RMB 2 ; LINE INPUT BUFFER HEADER
LINBUF RMB LBUFMX+1 ; BASIC LINE INPUT BUFFER
STRBUF RMB 41 ; STRING BUFFER
PROGST RMB 1 ; START OF PROGRAM SPACE
* INTERRUPT VECTORS
* ORG $FFF2
*SWI3 RMB 2
*SWI2 RMB 2
*FIRQ RMB 2
*IRQ RMB 2
*SWI RMB 2
*NMI RMB 2
*RESETV RMB 2
ORG $C000
* JUMP TO BASIC COLD START AT START OF ROM FOR CONVENIENCE
JMP RESVEC
* CONSOLE IN
LA171 BSR KEYIN ; GET A CHARACTER FROM CONSOLE IN
BEQ LA171 ; LOOP IF NO KEY DOWN
RTS
*
* THIS ROUTINE GETS A KEYSTROKE FROM THE KEYBOARD IF A KEY
* IS DOWN. IT RETURNS ZERO TRUE IF THERE WAS NO KEY DOWN.
*
*
LA1C1
KEYIN LDA USTAT
BITA #1
BEQ NOCHAR
LDA RECEV
ANDA #$7F
RTS
NOCHAR CLRA
RTS
* CONSOLE OUT
PUTCHR BSR WAITACIA
PSHS A ;
CMPA #CR ; IS IT CARRIAGE RETURN?
BEQ NEWLINE ; YES
STA TRANS
INC LPTPOS ; INCREMENT CHARACTER COUNTER
LDA LPTPOS ; CHECK FOR END OF LINE PRINTER LINE
CMPA LPTWID ; AT END OF LINE PRINTER LINE?
BLO PUTEND ; NO
NEWLINE CLR LPTPOS ; RESET CHARACTER COUNTER
BSR WAITACIA
LDA #13
STA TRANS
BSR WAITACIA
LDA #10 ; DO LINEFEED AFTER CR
STA TRANS
PUTEND PULS A ;
RTS
WAITACIA PSHS A
WRWAIT LDA USTAT
BITA #2
BEQ WRWAIT
PULS A ;
RTS
*
RESVEC
LA00E LDS #LINBUF+LBUFMX+1 ; SET STACK TO TOP OF LINE INPUT BUFFER
LDA RSTFLG ; GET WARM START FLAG
CMPA #$55 ; IS IT A WARM START?
BNE BACDST ; NO - D0 A COLD START
LDX RSTVEC ; WARM START VECTOR
LDA ,X ; GET FIRST BYTE OF WARM START ADDR
CMPA #$12 ; IS IT NOP?
BNE BACDST ; NO - DO A COLD START
JMP ,X ; YES, G0 THERE
* COLD START ENTRY
BACDST LDX #PROGST+1 ; POINT X TO CLEAR 1ST 1K OF RAM
LA077 CLR ,--X ; MOVE POINTER DOWN TWO-CLEAR BYTE
LEAX 1,X ; ADVANCE POINTER ONE
BNE LA077 ; KEEP GOING IF NOT AT BOTTOM OF PAGE 0
LDX #PROGST ; SET TO START OF PROGRAM SPACE
CLR ,X+ ; CLEAR 1ST BYTE OF BASIC PROGRAM
STX TXTTAB ; BEGINNING OF BASIC PROGRAM
LA084 LDA 2,X ; LOOK FOR END OF MEMORY
COMA ; * COMPLEMENT IT AND PUT IT BACK
STA 2,X ; * INTO SYSTEM MEMORY
CMPA 2,X ; IS IT RAM?
BNE LA093 ; BRANCH IF NOT (ROM, BAD RAM OR NO RAM)
LEAX 1,X ; MOVE POINTER UP ONE
COM 1,X ; RE-COMPLEMENT TO RESTORE BYTE
BRA LA084 ; KEEP LOOKING FOR END OF RAM
LA093 STX TOPRAM ; SAVE ABSOLUTE TOP OF RAM
STX MEMSIZ ; SAVE TOP OF STRING SPACE
STX STRTAB ; SAVE START OF STRING VARIABLES
LEAX -200,X ; CLEAR 200 - DEFAULT STRING SPACE TO 200 BYTES
STX FRETOP ; SAVE START OF STRING SPACE
TFR X,S ; PUT STACK THERE
LDX #LA10D ; POINT X TO ROM SOURCE DATA
LDU #LPTCFW ; POINT U TO RAM DESTINATION
LDB #18 ; MOVE 18 BYTES
JSR LA59A ; MOVE 18 BYTES FROM ROM TO RAM
LDU #IRQVEC ; POINT U TO NEXT RAM DESTINATION
LDB #4 ; MOVE 4 MORE BYTES
JSR LA59A ; MOVE 4 BYTES FROM ROM TO RAM
LDA #$39
STA LINHDR-1 ; PUT RTS IN LINHDR-1
JSR LAD19 ; G0 DO A 'NEW'
* EXTENDED BASIC INITIALISATION
LDX #USR0 ; INITIALIZE ADDRESS OF START OF
STX USRADR ; USR JUMP TABLE
* INITIALIZE THE USR CALLS TO 'FC ERROR'
LDU #LB44A ; ADDRESS OF 'FC ERROR' ROUTINE
LDB #10 ; 10 USR CALLS IN EX BASIC
L8031 STU ,X++ ; STORE 'FC' ERROR AT USR ADDRESSES
DECB ; FINISHED ALL 10?
BNE L8031 ; NO
* INITIALISE ACIA
LDA #RTS_LOW ; DIV16 CLOCK -> 7372800 / 4 / 16 = 115200
STA UCTRL
LDX #LA147-1 ; POINT X TO COLOR BASIC COPYRIGHT MESSAGE
JSR LB99C ; PRINT 'COLOR BASIC'
LDX #BAWMST ; WARM START ADDRESS
STX RSTVEC ; SAVE IT
LDA #$55 ; WARM START FLAG
STA RSTFLG ; SAVE IT
BRA LA0F3 ; GO TO BASIC'S MAIN LOOP
BAWMST NOP ; NOP REQ'D FOR WARM START
JSR LAD33 ; DO PART OF A NEW
LA0F3 JMP LAC73 ; GO TO MAIN LOOP OF BASIC
*
* FIRQ SERVICE ROUTINE
BFRQSV
RTI
*
* THESE BYTES ARE MOVED TO ADDRESSES $76 - $85 THE DIRECT PAGE
LA10D FCB 16 ; TAB FIELD WIDTH
FCB 64 ; LAST TAB ZONE
FCB 80 ; PRINTER WIDTH
FCB 0 ; LINE PRINTER POSITION
FDB LB44A ; ARGUMENT OF EXEC COMMAND - SET TO 'FC' ERROR
* LINE INPUT ROUTINE
INC CHARAD+1
BNE LA123
INC CHARAD
LA123 LDA >0000
JMP BROMHK
*
* THESE BYTES ARE MOVED TO ADDRESSES $A7-$B1
JMP BIRQSV ; IRQ SERVICE
JMP BFRQSV ; FIRQ SERVICE
JMP LB44A ; USR ADDRESS FOR 8K BASIC (INITIALIZED TO 'FC' ERROR)
FCB $80 ; *RANDOM SEED
FDB $4FC7 ; *RANDON SEED OF MANTISSA
FDB $5259 ; *.811635157
* BASIC COMMAND INTERPRETATION TABLE ROM IMAGE
COMVEC FCB 50 ; 50 BASIC COMMANDS
FDB LAA66 ; POINTS TO RESERVED WORDS
FDB LAB67 ; POINTS TO JUMP TABLE FOR COMMANDS
FCB 29 ; 29 BASIC SECONDARY COMMANDS
FDB LAB1A ; POINTS TO SECONDARY FUNCTION RESERVED WORDS
FDB LAA29 ; POINTS TO SECONDARY FUNCTION JUMP TABLE
FDB 0 ; NO MORE TABLES (RES WORDS=0)
FDB 0 ; NO MORE TABLES
FDB 0 ; NO MORE TABLES
FDB 0 ; NO MORE TABLES
FDB 0 ; NO MORE TABLES
FDB 0 ; NO MORE TABLES (SECONDARY FNS =0)
* COPYRIGHT MESSAGES
LA147 FCC "6809 EXTENDED BASIC"
FCB CR
FCC "(C) 1982 BY MICROSOFT"
LA156 FCB CR,CR
LA165 FCB $00
LA35F PSHS X,B,A ; SAVE REGISTERS
LDX LPTCFW ; TAB FIELD WIDTH AND TAB ZONE
LDD LPTWID ; PRINTER WIDTH AND POSITION
LA37C STX DEVCFW ; SAVE TAB FIELD WIDTH AND ZONE
STB DEVPOS ; SAVE PRINT POSITION
STA DEVWID ; SAVE PRINT WIDTH
PULS A,B,X,PC ; RESTORE REGISTERS
* THIS IS THE ROUTINE THAT GETS AN INPUT LINE FOR BASIC
* EXIT WITH BREAK KEY: CARRY = 1
* EXIT WITH ENTER KEY: CARRY = 0
LA38D
LA390 CLR IKEYIM ; RESET BREAK CHECK KEY TEMP KEY STORAGE
LDX #LINBUF+1 ; INPUT LINE BUFFER
LDB #1 ; ACCB CHAR COUNTER: SET TO 1 TO ALLOW A
* BACKSPACE AS FIRST CHARACTER
LA39A JSR LA171 ; GO GET A CHARACTER FROM CONSOLE IN
CMPA #BS ; BACKSPACE
BNE LA3B4 ; NO
DECB ; YES - DECREMENT CHAR COUNTER
BEQ LA390 ; BRANCH IF BACK AT START OF LINE AGAIN
LEAX -1,X ; DECREMENT BUFFER POINTER
BRA LA3E8 ; ECHO CHAR TO SCREEN
LA3B4 CMPA #$15 ; SHIFT RIGHT ARROW?
BNE LA3C2 ; NO
* YES, RESET BUFFER TO BEGINNING AND ERASE CURRENT LINE
LA3B8 DECB ; DEC CHAR CTR
BEQ LA390 ; GO BACK TO START IF CHAR CTR = 0
LDA #BS ; BACKSPACE?
JSR PUTCHR ; SEND TO CONSOLE OUT (SCREEN)
BRA LA3B8 ; KEEP GOING
LA3C2 CMPA #3 ; BREAK KEY?
ORCC #1 ; SET CARRY FLAG
BEQ LA3CD ; BRANCH IF BREAK KEY DOWN
LA3C8 CMPA #CR ; ENTER KEY?
BNE LA3D9 ; NO
LA3CC CLRA ; CLEAR CARRY FLAG IF ENTER KEY - END LINE ENTRY
LA3CD PSHS CC ; SAVE CARRY FLAG
JSR LB958 ; SEND CR TO SCREEN
CLR ,X ; MAKE LAST BYTE IN INPUT BUFFER = 0
LDX #LINBUF ; RESET INPUT BUFFER POINTER
PULS CC,PC ; RESTORE CARRY FLAG
* INSERT A CHARACTER INTO THE BASIC LINE INPUT BUFFER
LA3D9 CMPA #$20 ; IS IT CONTROL CHAR?
BLO LA39A ; BRANCH IF CONTROL CHARACTER
CMPA #'z+1 ; *
BCC LA39A ; * IGNORE IF > LOWER CASE Z
CMPB #LBUFMX ; HAVE 250 OR MORE CHARACTERS BEEN ENTERED?
BCC LA39A ; YES, IGNORE ANY MORE
STA ,X+ ; PUT IT IN INPUT BUFFER
INCB ; INCREMENT CHARACTER COUNTER
LA3E8 JSR PUTCHR ; ECHO IT TO SCREEN
BRA LA39A ; GO SET SOME MORE
* EXEC
EXEC BEQ LA545 ; BRANCH IF NO ARGUMENT
JSR LB73D ; EVALUATE ARGUMENT - ARGUMENT RETURNED IN X
STX EXECJP ; STORE X TO EXEC JUMP ADDRESS
LA545 JMP [EXECJP] ; GO DO IT
* BREAK CHECK
LA549 JMP LADEB ; GO DO BREAK KEY CHECK
* INKEY$
INKEY LDA IKEYIM ; WAS A KEY DOWN IN THE BREAK CHECK?
BNE LA56B ; YES
JSR KEYIN ; GO GET A KEY
LA56B CLR IKEYIM ; CLEAR INKEY RAM IMAGE
STA FPA0+3 ; STORE THE KEY IN FPA0
LBNE LB68F ; CONVERT FPA0+3 TO A STRING
STA STRDES ; SET LENGTH OF STRING = 0 IF NO KEY DOWN
JMP LB69B ; PUT A NULL STRING ONTO THE STRING STACK
* MOVE ACCB BYTES FROM (X) TO (U)
LA59A LDA ,X+ ; GET BYTE FROM X
STA ,U+ ; STORE IT AT U
DECB ; MOVED ALL BYTES?
BNE LA59A ; NO
LA5A1 RTS
LA5C4 RTS
** THIS ROUTINE WILL SCAN OFF THE FILE NAME FROM A BASIC LINE
** AND RETURN A SYNTAX ERROR IF THERE ARE ANY CHARACTERS
** FOLLOWING THE END OF THE NAME
LA5C7 JSR GETCCH ; GET CURRENT INPUT CHAR FROM BASIC LINE
LA5C9 BEQ LA5C4 ; RETURN IF END OF LINE
JMP LB277 ; SYNTAX ERROR IF ANY MORE CHARACTERS
* IRQ SERVICE
BIRQSV
LA9C5 RTI ; RETURN FROM INTERRUPT
* SET CARRY IF NUMERIC - RETURN WITH
* ZERO FLAG SET IF ACCA = 0 OR 3A(:) - END
* OF BASIC LINE OR SUB LINE
BROMHK CMPA #'9+1 ; IS THIS CHARACTER >=(ASCII 9)+1?
BHS LAA28 ; BRANCH IF > 9; Z SET IF = COLON
CMPA #SPACE ; SPACE?
BNE LAA24 ; NO - SET CARRY IF NUMERIC
JMP GETNCH ; IF SPACE, GET NECT CHAR (IGNORE SPACES)
LAA24 SUBA #'0 ; * SET CARRY IF
SUBA #-'0 ; * CHARACTER > ASCII 0
LAA28 RTS
* DISPATCH TABLE FOR SECONDARY FUNCTIONS
* TOKENS ARE PRECEEDED BY $FF
* FIRST SET ALWAYS HAS ONE PARAMETER
FUNC_TAB
LAA29 FDB SGN ; SGN
FDB INT ; INT
FDB ABS ; ABS
FDB USRJMP ; USR
TOK_USR EQU *-FUNC_TAB/2+$7F
TOK_FF_USR EQU *-FUNC_TAB/2+$FF7F
FDB RND ; RND
FDB SIN ; SIN
FDB PEEK ; PEEK
FDB LEN ; LEN
FDB STR ; STR$
FDB VAL ; VAL
FDB ASC ; ASC
FDB CHR ; CHR$
FDB ATN ; ATN
FDB COS ; COS
FDB TAN ; TAN
FDB EXP ; EXP
FDB FIX ; FIX
FDB LOG ; LOG
FDB POS ; POS
FDB SQR ; SQR
FDB HEXDOL ; HEX$
* LEFT, RIGHT AND MID ARE TREATED SEPARATELY
FDB LEFT ; LEFT$
TOK_LEFT EQU *-FUNC_TAB/2+$7F
FDB RIGHT ; RIGHT$
FDB MID ; MID$
TOK_MID EQU *-FUNC_TAB/2+$7F
* REMAINING FUNCTIONS
FDB INKEY ; INKEY$
TOK_INKEY EQU *-FUNC_TAB/2+$7F
FDB MEM ; MEM
FDB VARPT ; VARPTR
FDB INSTR ; INSTR
FDB STRING ; STRING$
NUM_SEC_FNS EQU *-FUNC_TAB/2
* THIS TABLE CONTAINS PRECEDENCES AND DISPATCH ADDRESSES FOR ARITHMETIC
* AND LOGICAL OPERATORS - THE NEGATION OPERATORS DO NOT ACT ON TWO OPERANDS
* S0 THEY ARE NOT LISTED IN THIS TABLE. THEY ARE TREATED SEPARATELY IN THE
* EXPRESSION EVALUATION ROUTINE. THEY ARE:
* UNARY NEGATION (-), PRECEDENCE &7D AND LOGICAL NEGATION (NOT), PRECEDENCE $5A
* THE RELATIONAL OPERATORS < > = ARE ALSO NOT LISTED, PRECEDENCE $64.
* A PRECEDENCE VALUE OF ZERO INDICATES END OF EXPRESSION OR PARENTHESES
*
LAA51 FCB $79
FDB LB9C5 ; +
FCB $79
FDB LB9BC ; -
FCB $7B
FDB LBACC ; *
FCB $7B
FDB LBB91 ; /
FCB $7F
FDB L8489 ; EXPONENTIATION
FCB $50
FDB LB2D5 ; AND
FCB $46
FDB LB2D4 ; OR
* THIS IS THE RESERVED WORD TABLE
* FIRST PART OF THE TABLE CONTAINS EXECUTABLE COMMANDS
LAA66 FCC "FO" ; 80
FCB $80+'R
FCC "G" ; 81
FCB $80+'O
TOK_GO EQU $81
FCC "RE" ; 82
FCB $80+'M
FCB ''+$80 ; 83
FCC "ELS" ; 84
FCB $80+'E
FCC "I" ; 85
FCB $80+'F
FCC "DAT" ; 86
FCB $80+'A
FCC "PRIN" ; 87
FCB $80+'T
FCC "O" ; 88
FCB $80+'N
FCC "INPU" ; 89
FCB $80+'T
FCC "EN" ; 8A
FCB $80+'D
FCC "NEX" ; 8B
FCB $80+'T
FCC "DI" ; 8C
FCB $80+'M
FCC "REA" ; 8D
FCB $80+'D
FCC "RU" ; 8E
FCB $80+'N
FCC "RESTOR" ; 8F
FCB $80+'E
FCC "RETUR" ; 90
FCB $80+'N
FCC "STO" ; 91
FCB $80+'P
FCC "POK" ; 92
FCB $80+'E
FCC "CON" ; 93
FCB $80+'T
FCC "LIS" ; 94
FCB $80+'T
FCC "CLEA" ; 95
FCB $80+'R
FCC "NE" ; 96
FCB $80+'W
FCC "EXE" ; 97
FCB $80+'C
FCC "TRO" ; 98
FCB $80+'N
FCC "TROF" ; 99
FCB $80+'F
FCC "DE" ; 9A
FCB $80+'L
FCC "DE" ; 9B
FCB $80+'F
FCC "LIN" ; 9C
FCB $80+'E
FCC "RENU" ; 9D
FCB $80+'M
FCC "EDI" ; 9E
FCB $80+'T
* END OF EXECUTABLE COMMANDS. THE REMAINDER OF THE TABLE ARE NON-EXECUTABLE TOKENS
FCC "TAB" ; 9F
FCB $80+'(
TOK_TAB EQU $9F
FCC "T" ; A0
FCB $80+'O
TOK_TO EQU $A0
FCC "SU" ; A1
FCB $80+'B
TOK_SUB EQU $A1
FCC "THE" ; A2
FCB $80+'N
TOK_THEN EQU $A2
FCC "NO" ; A3
FCB $80+'T
TOK_NOT EQU $A3
FCC "STE" ; A4
FCB $80+'P
TOK_STEP EQU $A4
FCC "OF" ; A5
FCB $80+'F
FCB '++$80 ; A6
TOK_PLUS EQU $A6
FCB '-+$80 ; A7
TOK_MINUS EQU $A7
FCB '*+$80 ; A8
FCB '/+$80 ; A9
FCB '^+$80 ; AA
FCC "AN" ; AB
FCB $80+'D
FCC "O" ; AC
FCB $80+'R
FCB '>+$80 ; AD
TOK_GREATER EQU $AD
FCB '=+$80 ; AE
TOK_EQUALS EQU $AE
FCB '<+$80 ; AF
FCC "F" ; B0
FCB $80+'N
TOK_FN EQU $B0
FCC "USIN" ; B1
FCB $80+'G
TOK_USING EQU $B1
*
* FIRST SET ALWAYS HAS ONE PARAMETER
LAB1A FCC "SG" ; 80
FCB $80+'N
FCC "IN" ; 81
FCB $80+'T
FCC "AB" ; 82
FCB $80+'S
FCC "US" ; 83
FCB $80+'R
FCC "RN" ; 84
FCB $80+'D
FCC "SI" ; 85
FCB $80+'N
FCC "PEE" ; 86
FCB $80+'K
FCC "LE" ; 87
FCB $80+'N
FCC "STR" ; 88
FCB $80+'$
FCC "VA" ; 89
FCB $80+'L
FCC "AS" ; 8A
FCB $80+'C
FCC "CHR" ; 8B
FCB $80+'$
FCC "AT" ; 8C
FCB $80+'N
FCC "CO" ; 8D
FCB $80+'S
FCC "TA" ; 8E
FCB $80+'N
FCC "EX" ; 8F
FCB $80+'P
FCC "FI" ; 90
FCB $80+'X
FCC "LO" ; 91
FCB $80+'G
FCC "PO" ; 92
FCB $80+'S
FCC "SQ" ; 93
FCB $80+'R
FCC "HEX" ; 94
FCB $80+'$
* LEFT, RIGHT AND MID ARE TREATED SEPARATELY
FCC "LEFT" ; 95
FCB $80+'$
FCC "RIGHT" ; 96
FCB $80+'$
FCC "MID" ; 97
FCB $80+'$
* REMAINING FUNCTIONS
FCC "INKEY" ; 98
FCB $80+'$
FCC "ME" ; 99
FCB $80+'M
FCC "VARPT" ; 9A
FCB $80+'R
FCC "INST" ; 9B
FCB $80+'R
FCC "STRING" ; 9C
FCB $80+'$
*
* DISPATCH TABLE FOR COMMANDS TOKEN #
CMD_TAB
LAB67 FDB FOR ; 80
FDB GO ; 81
FDB REM ; 82
TOK_REM EQU *-CMD_TAB/2+$7F
FDB REM ; 83 (')
TOK_SNGL_Q EQU *-CMD_TAB/2+$7F
FDB REM ; 84 (ELSE)
TOK_ELSE EQU *-CMD_TAB/2+$7F
FDB IF ; 85
TOK_IF EQU *-CMD_TAB/2+$7F
FDB DATA ; 86
TOK_DATA EQU *-CMD_TAB/2+$7F
FDB PRINT ; 87
TOK_PRINT EQU *-CMD_TAB/2+$7F
FDB ON ; 88
FDB INPUT ; 89
TOK_INPUT EQU *-CMD_TAB/2+$7F
FDB END ; 8A
FDB NEXT ; 8B
FDB DIM ; 8C
FDB READ ; 8D
FDB RUN ; 8E
FDB RESTOR ; 8F
FDB RETURN ; 90
FDB STOP ; 91
FDB POKE ; 92
FDB CONT ; 93
FDB LIST ; 94
FDB CLEAR ; 95
FDB NEW ; 96
FDB EXEC ; 97
FDB TRON ; 98
FDB TROFF ; 99
FDB DEL ; 9A
FDB DEF ; 9B
FDB LINE ; 9C
FDB RENUM ; 9D
FDB EDIT ; 9E
TOK_HIGH_EXEC EQU *-CMD_TAB/2+$7F
* ERROR MESSAGES AND THEIR NUMBERS AS USED INTERNALLY
LABAF FCC "NF" ; 0 NEXT WITHOUT FOR
FCC "SN" ; 1 SYNTAX ERROR
FCC "RG" ; 2 RETURN WITHOUT GOSUB
FCC "OD" ; 3 OUT OF DATA
FCC "FC" ; 4 ILLEGAL FUNCTION CALL
FCC "OV" ; 5 OVERFLOW
FCC "OM" ; 6 OUT OF MEMORY
FCC "UL" ; 7 UNDEFINED LINE NUMBER
FCC "BS" ; 8 BAD SUBSCRIPT
FCC "DD" ; 9 REDIMENSIONED ARRAY
FCC "/0" ; 10 DIVISION BY ZERO
FCC "ID" ; 11 ILLEGAL DIRECT STATEMENT
FCC "TM" ; 12 TYPE MISMATCH
FCC "OS" ; 13 OUT OF STRING SPACE
FCC "LS" ; 14 STRING TOO LONG
FCC "ST" ; 15 STRING FORMULA TOO COMPLEX
FCC "CN" ; 16 CAN'T CONTINUE
FCC "FD" ; 17 BAD FILE DATA
FCC "AO" ; 18 FILE ALREADY OPEN
FCC "DN" ; 19 DEVICE NUMBER ERROR
FCC "IO" ; 20 I/O ERROR
FCC "FM" ; 21 BAD FILE MODE
FCC "NO" ; 22 FILE NOT OPEN
FCC "IE" ; 23 INPUT PAST END OF FILE
FCC "DS" ; 24 DIRECT STATEMENT IN FILE
* ADDITIONAL ERROR MESSAGES ADDED BY EXTENDED BASIC
L890B FCC "UF" ; 25 UNDEFINED FUNCTION (FN) CALL
L890D FCC "NE" ; 26 FILE NOT FOUND
LABE1 FCC " ERROR"
FCB $00
LABE8 FCC " IN "
FCB $00
LABED FCB CR
LABEE FCC "OK"
FCB CR,$00
LABF2 FCB CR
FCC "BREAK"
FCB $00
* SEARCH THE STACK FOR 'GOSUB/RETURN' OR 'FOR/NEXT' DATA.
* THE 'FOR/NEXT' INDEX VARIABLE DESCRIPTOR ADDRESS BEING
* SOUGHT IS STORED IN VARDES. EACH BLOCK OF FOR/NEXT DATA IS 18
* BYTES WITH A $80 LEADER BYTE AND THE GOSUB/RETURN DATA IS 5 BYTES
* WITH AN $A6 LEADER BYTE. THE FIRST NON "FOR/NEXT" DATA
* IS CONSIDERED 'GOSUB/RETURN'
LABF9 LEAX 4,S ; POINT X TO 3RD ADDRESS ON STACK - IGNORE THE
* FIRST TWO RETURN ADDRESSES ON THE STACK
LABFB LDB #18 ; 18 BYTES SAVED ON STACK FOR EACH 'FOR' LOOP
STX TEMPTR ; SAVE POINTER
LDA ,X ; GET 1ST BYTE
SUBA #$80 ; * CHECK FOR TYPE OF STACK JUMP FOUND
BNE LAC1A ; * BRANCH IF NOT 'FOR/NEXT'
LDX 1,X ; = GET INDEX VARIABLE DESCRIPTOR
STX TMPTR1 ; = POINTER AND SAVE IT IN TMPTR1
LDX VARDES ; GET INDEX VARIABLE BEING SEARCHED FOR
BEQ LAC16 ; BRANCH IF DEFAULT INDEX VARIABLE - USE THE
* ; FIRST 'FOR/NEXT' DATA FOUND ON STACK
* ; IF NO INDEX VARIABLE AFTER 'NEXT'
CMPX TMPTR1 ; DOES THE STACK INDEX MATCH THE ONE
* ; BEING SEARCHED FOR?
BEQ LAC1A ; YES
LDX TEMPTR ; * RESTORE INITIAL POINTER, ADD
ABX ; * 18 TO IT AND LOOK FOR
BRA LABFB ; * NEXT BLOCK OF DATA
LAC16 LDX TMPTR1 ; = GET 1ST INDEX VARIABLE FOUND AND
STX VARDES ; = SAVE AS 'NEXT' INDEX
LAC1A LDX TEMPTR ; POINT X TO START OF 'FOR/NEXT' DATA
TSTA ; SET ZERO FLAG IF 'FOR/NEXT' DATA
RTS
* CHECK FOR MEMORY SPACE FOR NEW TOP OF
* ARRAYS AND MOVE ARRAYS TO NEW LOCATION
LAC1E BSR LAC37 ; ACCD = NEW BOTTOM OF FREE RAM - IS THERE
* ; ROOM FOR THE STACK?
* MOVE BYTES FROM V43(X) TO V41(U) UNTIL (X) = V47 AND
* SAVE FINAL VALUE OF U IN V45
LAC20 LDU V41 ; POINT U TO DESTINATION ADDRESS (V41)
LEAU 1,U ; ADD ONE TO U - COMPENSATE FOR FIRST PSHU
LDX V43 ; POINT X TO SOURCE ADDRESS (V43)
LEAX 1,X ; ADD ONE - COMPENSATE FOR FIRST LDA ,X
LAC28 LDA ,-X ; GRAB A BYTE FROM SOURCE
PSHU A ; MOVE IT TO DESTINATION
CMPX V47 ; DONE?
BNE LAC28 ; NO - KEEP MOVING BYTES
STU V45 ; SAVE FINAL DESTINATION ADDRESS
LAC32 RTS
* CHECK TO SEE IF THERE IS ROOM TO STORE 2*ACCB
* BYTES IN FREE RAM - OM ERROR IF NOT
LAC33 CLRA ; * ACCD CONTAINS NUMBER OF EXTRA
ASLB ; * BYTES TO PUT ON STACK
ADDD ARYEND ; END OF PROGRAM AND VARIABLES
LAC37 ADDD #STKBUF ; ADD STACK BUFFER - ROOM FOR STACK?
BCS LAC44 ; BRANCH IF GREATER THAN $FFFF
STS BOTSTK ; CURRENT NEW BOTTOM OF STACK STACK POINTER
CMPD BOTSTK ; ARE WE GOING TO BE BELOW STACK?
BCS LAC32 ; YES - NO ERROR
LAC44 LDB #6*2 ; OUT OF MEMORY ERROR
* ERROR SERVICING ROUTINE
LAC46 JSR LAD33 ; RESET STACK, STRING STACK, CONTINUE POINTER
JSR LB95C ; SEND A CR TO SCREEN
JSR LB9AF ; SEND A '?' TO SCREEN
LDX #LABAF ; POINT TO ERROR TABLE
LAC60 ABX ; ADD MESSAGE NUMBER OFFSET
BSR LACA0 ; * GET TWO CHARACTERS FROM X AND
BSR LACA0 ; * SEND TO CONSOLE OUT (SCREEN)
LDX #LABE1-1 ; POINT TO "ERROR" MESSAGE
LAC68 JSR LB99C ; PRINT MESSAGE POINTED TO BY X
LDA CURLIN ; GET CURRENT LINE NUMBER (CURL IN)
INCA ; TEST FOR DIRECT MODE
BEQ LAC73 ; BRANCH IF DIRECT MODE
JSR LBDC5 ; PRINT 'IN ****'
* THIS IS THE MAIN LOOP OF BASIC WHEN IN DIRECT MODE
LAC73 JSR LB95C ; MOVE CURSOR TO START OF LINE
LDX #LABED ; POINT X TO 'OK', CR MESSAGE
JSR LB99C ; PRINT 'OK', CR
LAC7C JSR LA390 ; GO GET AN INPUT LINE
LDU #$FFFF ; THE LINE NUMBER FOR DIRECT MODE IS $FFFF
STU CURLIN ; SAVE IT IN CURLIN
BCS LAC7C ; BRANCH IF LINE INPUT TERMINATED BY BREAK
STX CHARAD ; SAVE (X) AS CURRENT INPUT POINTER - THIS WILL
* ENABLE THE 'LIVE KEYBOARD' (DIRECT) MODE. THE
* LINE JUST ENTERED WILL BE INTERPRETED
JSR GETNCH ; GET NEXT CHARACTER FROM BASIC
BEQ LAC7C ; NO LINE INPUT - GET ANOTHER LINE
BCS LACA5 ; BRANCH IF NUMER1C - THERE WAS A LINE NUMBER BEFORE
* THE STATEMENT ENTERED, SO THIS STATEMENT
* WILL BE MERGED INTO THE BASIC PROGRAM
JSR LB821 ; GO CRUNCH LINE
JMP LADC0 ; GO EXECUTE THE STATEMENT (LIVE KEYBOARD)
*
LACA0 LDA ,X+ ; GET A CHARACTER
JMP LB9B1 ; SEND TO CONSOLE OUT
* TAKE A LINE FROM THE LINE INPUT BUFFER
* AND INSERT IT INTO THE BASIC PROGRAM
LACA5 JSR LAF67 ; CONVERT LINE NUMBER TO BINARY
LACA8 LDX BINVAL ; GET CONVERTED LINE NUMBER
STX LINHDR ; STORE IT IN LINE INPUT HEADER
JSR LB821 ; GO CRUNCH THE LINE
STB TMPLOC ; SAVE LINE LENGTH
BSR LAD01 ; FIND OUT WHERE TO INSERT LINE
BCS LACC8 ; RANCH IF LINE NUMBER DOES NOT ALREADY EXIST
LDD V47 ; GET ABSOLUTE ADDRESS OF LINE NUMBER
SUBD ,X ; SUBTRACT ADDRESS OF NEXT LINE NUMBER
ADDD VARTAB ; * ADD TO CURRENT END OF PROGRAM - THIS WILL REMOVE
STD VARTAB ; * THE LENGTH OF THIS LINE NUMBER FROM THE PROGRAM
LDU ,X ; POINT U TO ADDRESS OF NEXT LINE NUMBER
* DELETE OLD LINE FROM BASIC PROGRAM
LACC0 PULU A ; GET A BYTE FROM WHAT'S LEFT OF PROGRAM
STA ,X+ ; MOVE IT DOWN
CMPX VARTAB ; COMPARE TO END OF BASIC PROGRAM
BNE LACC0 ; BRANCH IF NOT AT END
LACC8 LDA LINBUF ; * CHECK TO SEE IF THERE IS A LINE IN
BEQ LACE9 ; * THE BUFFER AND BRANCH IF NONE
LDD VARTAB ; = SAVE CURRENT END OF
STD V43 ; = PROGRAM IN V43
ADDB TMPLOC ; * ADD LENGTH OF CRUNCHED LINE,
ADCA #0 ; * PROPOGATE CARRY AND SAVE NEW END
STD V41 ; * OF PROGRAM IN V41
JSR LAC1E ; = MAKE SURE THERE'S ENOUGH RAM FOR THIS
* = LINE & MAKE A HOLE IN BASIC FOR NEW LINE
LDU #LINHDR-2 ; POINT U TO LINE TO BE INSERTED
LACDD PULU A ; GET A BYTE FROM NEW LINE
STA ,X+ ; INSERT IT IN PROGRAM
CMPX V45 ; * COMPARE TO ADDRESS OF END OF INSERTED
BNE LACDD ; * LINE AND BRANCH IF NOT DONE
LDX V41 ; = GET AND SAVE
STX VARTAB ; = END OF PROGRAM
LACE9 BSR LAD21 ; RESET INPUT POINTER, CLEAR VARIABLES, INITIALIZE
BSR LACEF ; ADJUST START OF NEXT LINE ADDRESSES
BRA LAC7C ; EENTER BASIC'S INPUT LOOP
* COMPUTE THE START OF NEXT LINE ADDRESSES FOR THE BASIC PROGRAM
LACEF LDX TXTTAB ; POINT X TO START OF PROGRAM
LACF1 LDD ,X ; GET ADDRESS OF NEXT LINE
BEQ LAD16 ; RETURN IF END OF PROGRAM
LEAU 4,X ; POINT U TO START OF BASIC TEXT IN LINE
LACF7 LDA ,U+ ; * SKIP THROUGH THE LINE UNTIL A
BNE LACF7 ; * ZERO (END OF LINE) IS FOUND
STU ,X ; SAVE THE NEW START OF NEXT LINE ADDRESS
LDX ,X ; POINT X TO START OF NEXT LINE
BRA LACF1 ; KEEP GOING
*
* FIND A LINE NUMBER IN THE BASIC PROGRAM
* RETURN WITH CARRY SET IF NO MATCH FOUND
LAD01 LDD BINVAL ; GET THE LINE NUMBER TO FIND
LDX TXTTAB ; BEGINNING OF PROGRAM
LAD05 LDU ,X ; GET ADDRESS OF NEXT LINE NUMBER
BEQ LAD12 ; BRANCH IF END OF PROG
CMPD 2,X ; IS IT A MATCH?
BLS LAD14 ; CARRY SET IF LOWER; CARRY CLEAR IF MATCH
LDX ,X ; X = ADDRESS OF NEXT LINE
BRA LAD05 ; KEEP LOOPING FOR LINE NUMBER
LAD12 ORCC #1 ; SET CARRY FLAG
LAD14 STX V47 ; SAVE MATCH LINE NUMBER OR NUMBER OF LINE JUST AFTER
* ; WHERE IT SHOULD HAVE BEEN
LAD16 RTS
* NEW
NEW BNE LAD14 ; BRANCH IF ARGUMENT GIVEN
LAD19 LDX TXTTAB ; GET START OF BASIC
CLR ,X+ ; * PUT 2 ZERO BYTES THERE - ERASE
CLR ,X+ ; * THE BASIC PROGRAM
STX VARTAB ; AND THE NEXT ADDRESS IS NOW THE END OF PROGRAM
LAD21 LDX TXTTAB ; GET START OF BASIC
JSR LAEBB ; PUT INPUT POINTER ONE BEFORE START OF BASIC
* ERASE ALL VARIABLES
LAD26 LDX MEMSIZ ; * RESET START OF STRING VARIABLES
STX STRTAB ; * TO TOP OF STRING SPACE
JSR RESTOR ; RESET 'DATA' POINTER TO START OF BASIC
LDX VARTAB ; * GET START OF VARIABLES AND USE IT
STX ARYTAB ; * TO RESET START OF ARRAYS
STX ARYEND ; RESET END OF ARRAYS
LAD33 LDX #STRSTK ; * RESET STRING STACK POINTER TO
STX TEMPPT ; * BOTTOM OF STRING STACK
LDX ,S ; GET RETURN ADDRESS OFF STACK
LDS FRETOP ; RESTORE STACK POINTER
CLR ,-S ; PUT A ZERO BYTE ON STACK - TO CLEAR ANY RETURN OF
* ; FOR/NEXT DATA FROM THE STACK
CLR OLDPTR ; RESET 'CONT' ADDRESS SO YOU
CLR OLDPTR+1 ; 'CAN'T CONTINUE'
CLR ARYDIS ; CLEAR THE ARRAY DISABLE FLAG
JMP ,X ; RETURN TO CALLING ROUTINE - THIS IS NECESSARY
* ; SINCE THE STACK WAS RESET
*
* FOR
*
* THE FOR COMMAND WILL STORE 18 BYTES ON THE STACK FOR
* EACH FOR-NEXT LOOP WHICH IS BEING PROCESSED. THESE
* BYTES ARE DEFINED AS FOLLOWS: 0- $80 (FOR FLAG);
* 1,2=INDEX VARIABLE DESCRIPTOR POINTER; 3-7=FP VALUE OF STEP;
* 8=STEP DIRECTION: $FF IF NEGATIVE; 0 IF ZERO; 1 IF POSITIVE;
* 9-13=FP VALUE OF 'TO' PARAMETER;
* 14,15=CURRENT LINE NUMBER; 16,17=RAM ADDRESS OF THE END
* OF THE LINE CONTAINING THE 'FOR' STATEMENT
FOR LDA #$80 ; * SAVE THE DISABLE ARRAY FLAG IN VO8
STA ARYDIS ; * DO NOT ALLOW THE INDEX VARIABLE TO BE AN ARRAY
JSR LET ; SET INDEX VARIABLE TO INITIAL VALUE
JSR LABF9 ; SEARCH THE STACK FOR 'FOR/NEXT' DATA
LEAS 2,S ; PURGE RETURN ADDRESS OFF OF THE STACK
BNE LAD59 ; BRANCH IF INDEX VARIABLE NOT ALREADY BEING USED
LDX TEMPTR ; GET (ADDRESS + 18) OF MATCHED 'FOR/NEXT' DATA
LEAS B,X ; MOVE THE STACK POINTER TO THE BEGINNING OF THE
* MATCHED 'FOR/NEXT' DATA SO THE NEW DATA WILL
* OVERLAY THE OLD DATA. THIS WILL ALSO DESTROY
* ALL OF THE 'RETURN' AND 'FOR/NEXT' DATA BELOW
* THIS POINT ON THE STACK
LAD59 LDB #$09 ; * CHECK FOR ROOM FOR 18 BYTES
JSR LAC33 ; * IN FREE RAM
JSR LAEE8 ; GET ADDR OF END OF SUBLINE IN X
LDD CURLIN ; GET CURRENT LINE NUMBER
PSHS X,B,A ; SAVE LINE ADDR AND LINE NUMBER ON STACK
LDB #TOK_TO ; TOKEN FOR 'TO'
JSR LB26F ; SYNTAX CHECK FOR 'TO'
JSR LB143 ; 'TM' ERROR IF INDEX VARIABLE SET TO STRING
JSR LB141 ; EVALUATE EXPRESSION
*
LDB FP0SGN ; GET FPA0 MANTISSA SIGN
ORB #$7F ; FORM A MASK TO SAVE DATA BITS OF HIGH ORDER MANTISSA
ANDB FPA0 ; PUT THE MANTISSA SIGN IN BIT 7 OF HIGH ORDER MANTISSA
STB FPA0 ; SAVE THE PACKED HIGH ORDER MANTISSA
LDY #LAD7F ; LOAD FOLLOWING ADDRESS INTO Y AS A RETURN
JMP LB1EA ; ADDRESS - PUSH FPA0 ONTO THE STACK
LAD7F LDX #LBAC5 ; POINT X TO FLOATING POINT NUMBER 1.0 (DEFAULT STEP VALUE)
JSR LBC14 ; MOVE (X) TO FPA0
JSR GETCCH ; GET CURRENT INPUT CHARACTER