-
Notifications
You must be signed in to change notification settings - Fork 1
/
DragonROM.asm
executable file
·11427 lines (9245 loc) · 431 KB
/
DragonROM.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
;
; DragonROM.asm Disasembily of Dragon 32/64 Basic ROM.
;
; Disasembled 2006-08-14, P.Harvey-Smith.
;
; From this file you can assemble any of the Dragon basic ROMS.
;
; Define DRAGON64 to assemble for Dragon 64, 32K rom
; Define DRAGON64RAM to assemble for Dragon 64, 64K rom
;
; If neither are defined, a Dragon32 ROM will be generated.
;
; Changes :
;
; 2006-08-15, P.Harvey-Smith.
; Merged Dragon 32, 64 and 64 ram mode disassemblies, this file
; can now build to any of the Dragon ROMS.
;
; Re-wrote all CMPX, BRN, LDA, LDX, TST instruction hiding instructions
; using defines from romdefs.asm.
;
; Began systematic replacement of system variable reffrences in the
; $0000-$03FF reigon with symbolic names from romdefs.asm, this should
; make understanding the code easier.
;
; 2012-10-08, P.Harvey-Smith.
; Updated all unknown data tables to indicate their function by cross
; refferencing with "Colour Basic Unravelled" and "Extended Colour Basic Unravelled".
;
; 2020-03-02, P.Harvey-Smith.
; Finished commenting the entire file.
;
ifdef Dragon64ram
ORG $C000 ; Dragon 64 ram mode
else
ORG $8000 ; Dragon 32/64 ROM mode
endc
use romdefs.asm
use dgndefs.asm
use BasicTokens.asm
use samdefs.asm
use ascii.asm
use cpudefs.asm
; low RAM defs, not defined in romdefs.asm
Eval37 equ $37
Eval38 equ $38
Eval39 equ $39
Eval3A equ $3A
Eval3B equ $3B
Eval3C equ $3C
Eval3E equ $3E
Eval3F equ $3F
Eval40 equ $40
Eval41 equ $41
Eval42 equ $42
Eval43 equ $43
Eval44 equ $44
Eval45 equ $45
Eval46 equ $46
Eval47 equ $47
Eval48 equ $48
Eval49 equ $49
Eval4A equ $4A
Eval4B equ $4B
Eval4C equ $4C
Eval4D equ $4D
Eval4E equ $4E
EvalCF equ $CF
EvalD1 equ $D1
EvalD2 equ $D2
EvalD3 equ $D3
EvalD4 equ $D4
EvalD5 equ $D5
EvalD6 equ $D6
EvalD7 equ $D7
EvalD8 equ $D8
EvalD9 equ $D9
EvalDA equ $DA
EvalDB equ $DB
EvalDC equ $DC
RomBase: ; lable to mark beginning of ROM
;
; Basic vector table
;
BasicHWInit:
L8000 JMP >DoHWInit ; Hardware init, routine to chain to in Y
BasicSWInit:
L8003 JMP >DoSWInit ; Software Init
BasicKbdIn:
L8006 JMP >TextScanKbd ; Scan keyboard, if a key pressed return in A
BasicCursorB:
L8009 JMP >TextUpdateCurs ; Update cursor (blink)
BasicScreenOut:
L800C JMP >TextVDUOut ; Output char in A (to screen)
BasicPrintOut:
L800F JMP >PrinterOut ; Output char in A to printer
BasicJoyIn:
L8012 JMP >SysReadJoystick ; Read joysticks
BasicCassOn:
L8015 JMP >CasMotorOn ; Turn on cassette motor
BasicCassOff:
L8018 JMP >CasMotorOff ; Turn off cassette motor
CasWriteLeader:
L801B JMP >LBE68 ; Write leader to tape
BasicCassByOut:
L801E JMP >CasByteOut ; Output a byte in A to tape
BasicCassOnRd:
L8021 JMP >CasReadLeader ; Read leader and get ready top read data
BasicCassByIn:
L8024 JMP >CasByteIn ; Read a byte in from tape
BasicCassBitIn:
L8027 JMP >CasBitIn ; Read a bit from tape
BasicSerIn:
L802A JMP >DoSerialIn ; Read a byte from serial port (D64 only)
BasicSerOut:
L802D JMP >DoSerialOut ; Send a byte to serial port (D64 only)
BasicSetBaud:
L8030 JMP >DoSetBaud ; Set baud rate (D64 only)
;
; Basic keyword table (commands).
;
BasCommandWords
FCS /FOR/
FCS /GO/
FCS /REM/
FCS /'/
FCS /ELSE/
FCS /IF/
FCS /DATA/
FCS /PRINT/
FCS /ON/
FCS /INPUT/
FCS /END/
FCS /NEXT/
FCS /DIM/
FCS /READ/
FCS /LET/
FCS /RUN/
FCS /RESTORE/
FCS /RETURN/
FCS /STOP/
FCS /POKE/
FCS /CONT/
FCS /LIST/
FCS /CLEAR/
FCS /NEW/
FCS /DEF/
FCS /CLOAD/
FCS /CSAVE/
FCS /OPEN/
FCS /CLOSE/
FCS /LLIST/
FCS /SET/
FCS /RESET/
FCS /CLS/
FCS /MOTOR/
FCS /SOUND/
FCS /AUDIO/
FCS /EXEC/
FCS /SKIPF/
FCS /DEL/
FCS /EDIT/
FCS /TRON/
FCS /TROFF/
FCS /LINE/
FCS /PCLS/
FCS /PSET/
FCS /PRESET/
FCS /SCREEN/
FCS /PCLEAR/
FCS /COLOR/
FCS /CIRCLE/
FCS /PAINT/
FCS /GET/
FCS /PUT/
FCS /DRAW/
FCS /PCOPY/
FCS /PMODE/
FCS /PLAY/
FCS /DLOAD/
FCS /RENUM/
FCS /TAB(/
FCS /TO/
FCS /SUB/
FCS /FN/
FCS /THEN/
FCS /NOT/
FCS /STEP/
FCS /OFF/
FCS /+/
FCS /-/
FCS /*/
FCS "/"
FCS /^/
FCS /AND/
FCS /OR/
FCS />/
FCS /=/
FCS /</
FCS /USING/
;
; Keyword dispatch table (commands).
;
BasCommandDisp
FDB CmdFor
FDB CmdGo
FDB CmdREM
FDB CmdREM
FDB CmdREM
FDB CmdIF
FDB CmdData
FDB CmdPrint
FDB CmdON
FDB CmdInput
FDB CmdEnd
FDB CmdNext
FDB CmdDim
FDB CmdRead
FDB CmdLet
FDB CmdRun
FDB CmdRestore
FDB CmdReturn
FDB CmdStop
FDB CmdPoke
FDB CmdCont
FDB CmdList
FDB CmdClear
FDB CmdNew
FDB CmdDef
FDB CmdCload
FDB CmdCsave
FDB CmdOPEN
FDB LB64C
FDB CmdLList
FDB CmdSET
FDB CmdRESET
FDB CmdCLS
FDB CmdMOTOR
FDB CmdSOUND
FDB CmdAudio
FDB CmdExec
FDB CmdSKIPF
FDB CmdDelete
FDB CmdEdit
FDB CmdTron
FDB CmdTroff
FDB CmdLine
FDB CmdPCls
FDB CmdPset
FDB CmdPReset
FDB CmdScreen
FDB CmdPClear
FDB CmdColor
FDB CmdCircle
FDB CmdPaint
FDB CmdGet
FDB CmdPut
FDB GrDraw
FDB CmdPcopy
FDB CmdPmode
FDB CmdPlay
FDB CmdDload
FDB CmdRenum
;
; Basic keyword table (functions).
;
BasFunctionWords
FCS /SGN/
FCS /INT/
FCS /ABS/
FCS /POS/
FCS /RND/
FCS /SQR/
FCS /LOG/
FCS /EXP/
FCS /SIN/
FCS /COS/
FCS /TAN/
FCS /ATN/
FCS /PEEK/
FCS /LEN/
FCS /STR$/
FCS /VAL/
FCS /ASC/
FCS /CHR$/
FCS /EOF/
FCS /JOYSTK/
FCS /FIX/
FCS /HEX$/
FCS /LEFT$/
FCS /RIGHT$/
FCS /MID$/
FCS /POINT/
FCS /INKEY$/
FCS /MEM/
FCS /VARPTR/
FCS /INSTR/
FCS /TIMER/
FCS /PPOINT/
FCS /STRING$/
FCS /USR/
;
; Keyword dispatch table (functions).
;
BasFunctionDisp
FDB CmdSGN
FDB CmdINT
FDB CmdABS
FDB CmdPOS
FDB CmdRND
FDB CmdSQR
FDB CmdLOG
FDB CmdEXP
FDB CmdSIN
FDB CmdCOS
FDB CmdTAN
FDB CmdATN
FDB CmdPeek
FDB CmdLEN
FDB CmdSTRS
FDB CmdVAL
FDB CmdASC
FDB CmdCHRS
FDB CmdEOF
FDB CmdJoystk
FDB CmdFIX
FDB CmdHexS
FDB CmdLeftS
FDB CmdRightS
FDB CmdMidS
FDB CmdPoint
FDB CmdINKEYS
FDB CmdMEM
FDB CmdVarptr
FDB CmdInstr
FDB CmdTimer
FDB CmdPPoint
FDB CmdStringS
FDB CmdUSR
;
; this table contains precedences and dispatch addresses for arithmetic
; and logical operators - the negation operators do not act on two operands
; so 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
;
BasOperatorTable
FCB $79
FDB CmdPlus
FCB $79
FDB CmdMinus
FCB $7B
FDB CmdMultiply
FCB $7B
FDB CmdDivide
FCB $7F
FDB CmdExponet
FCB $50
FDB CmdAND
FCB $46
FDB CmdOR
BasErrorCodeTable:
D82A9 FCC "NF"
FCC "SN"
FCC "RG"
FCC "OD"
FCC "FC"
FCC "OV"
FCC "OM"
FCC "UL"
FCC "BS"
FCC "DD"
FCC "/0"
FCC "ID"
FCC "TM"
FCC "OS"
FCC "LS"
FCC "ST"
FCC "CN"
FCC "UF"
FCC "FD"
FCC "AO"
FCC "DN"
FCC "IO"
FCC "FM"
FCC "NO"
FCC "IE"
FCC "DS"
FCC "NE"
; offets into above table......
ErrNF EQU $00
ErrSN EQU $02
ErrRG EQU $04
ErrOD EQU $06
ErrFC EQU $08
ErrOV EQU $0A
ErrOM EQU $0C
ErrUL EQU $0E
ErrBS EQU $10
ErrDD EQU $12
ErrD0 EQU $14
ErrID EQU $16
ErrTM EQU $18
ErrOS EQU $1A
ErrLS EQU $1C
ErrST EQU $1E
ErrCN EQU $20
ErrUF EQU $22
ErrFD EQU $24
ErrAO EQU $26
ErrDN EQU $28
ErrIO EQU $2A
ErrFM EQU $2C
ErrNO EQU $2E
ErrIE EQU $30
ErrDS EQU $32
ErrNE EQU $34
MessError
FCC / ERROR/
FCB $00
MessIn
FCC / IN /
FCB $00
MessOK
FCB $0D
FCC /OK/
FCB $0D,$00
MessBreak
FCB $0D
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'
L82F7 LEAX 4,S ; point x to 3rd address on stack
L82F9 LDB #$12 ; $12 bytes on stack for each for loop
STX <BasTempPtr ; save pointer
LDA ,X ; get first byte
SUBA #$80 ; check for type of stack jump found
BNE L8318 ; branch if not for/next
LDX 1,X ; get index variable descriptor pointer
STX <BasTempPtr1 ; save it
LDX <BasTempVarDesc ; get index var being searched for
BEQ L8314 ; branch if default index variable, use var on stack
CMPX <BasTempPtr1 ; does the stack indexed variable match the one being searched for?
BEQ L8318 ; yes!
LDX <BasTempPtr ; restore initial pointer
ABX ; add $12 bytes to it
BRA L82F9 ; look for next block of data
L8314 LDX <BasTempPtr1 ; get 1st index var found and
STX <BasTempVarDesc ; save it as 'next' index
L8318 LDX <BasTempPtr ; point X to start of for/next data
TSTA ; set zero flag for for/next data
RTS
; check memory space for new top of arrays, and move array data
BasChkArrSpaceMv:
L831C BSR L8335 ; D= new bottom of free ram, is there room for stack?
; Move bytes from Eval43 (X) to Eval41 (U) until X= Eval47
; save final value in Eval45
L831E LDU <Eval41 ; point U to destination address (in Eval 41).
LEAU 1,U ; add 1 to compensate for first phsu
LDX <Eval43 ; point X at source address (in Eval 43).
LEAX 1,X ; add 1 compensate for first lda ,-x
L8326 LDA ,-X ; get a byte from source
PSHU A ; save in destination
CMPX <Eval47 ; done all yet?
BNE L8326 ; nope : keep moving
STU <Eval45 ; save result.
L8330 RTS
; check to see if there is room to store 2xB bytes in RAM
BasChkB2Free:
L8331 CLRA ; Convert B to a word.....
ASLB ; and * by 2
ADDD <BasVarEnd ; end of variables and programs
L8335 ADDD #StackBuf ; add stack buffer size, is there room for stack?
BCS BasOMError ; nope : error
STS <BasBotStack ; save stack pointer for compare
CMPD <BasBotStack ; are we going to be below the current stack?
BCS L8330 ; yes : no error
BasOMError:
L8342 LDB #ErrOM ; OM error code
SysErr:
L8344 JSR VectUserError ; hook user error handler
JSR VectSysError ; hook system error handler
JSR >BasicCassOff ; turn off tape
JSR >SndDisable ; disable sound output
JSR >BasResetStack ; reset basic stack, string stack, continue pointer
CLR <TextDevN ; set device number to screen
JSR >L90A5 ; send a CR to screen
JSR >TextOutQuestion ; send a '?' to screen
LDX #BasErrorCodeTable ; point to code table
SysErr2:
ABX ; adjust for error code in B
BSR L839E ; get char from X, send to screen
BSR L839E ; get char from X, send to screen
LDX #MessError-1 ; Point to ' error?' message
L8366 JSR >TextOutString ; send it to screen
LDA <BasCurrentLine ; get current line number
INCA ; test for direct mode (-1)
BEQ BasCmdMode ; yes, just enter command mode
JSR >L9573 ; print ' in ' linenumber.
;
; Print OK and enter command mode
;
BasCmdMode:
L8371 JSR >L90A5 ; send CR to screen
LDX #MessOK ; Point to 'OK' message
JSR >TextOutString ; send to screen
;
; Enter command mode
;
BasCmdMode2:
L837A JSR >LB5C6 ; get a line of input (from console)
LDU #$FFFF ; Set current line to -1, to flag command mode
STU <BasCurrentLine
BCS BasCmdMode2 ; loop again if terminated by break
TST <CasEOFFlag ; End of file ?
LBNE LB6FD ; branch if buffer empty, close input file
STX <BasAddrSigByte ; save X as current input pointer, this will enable direct mode.
; the line just entered will be interpreted
JSR <BasChrGet ; read next basic byte
BEQ BasCmdMode2 ; no line input, get another!
BCS L83A3 ; branch if numeric, there was a line number entered, add to program.
LDB #ErrDS ; direct statement in file error
TST <TextDevN ; check for input from console
BNE SysErr ; Not console : Error direct statement in file.
JSR >L8F67 ; Go and crunch (tokenize) the line
JMP >L84D6 ; Go execute the statement if in direct mode.
L839E LDA ,X+ ; get a character
JMP >L90FA ; send to console output
; Take a line from the line input program and add it to the basic program.
L83A3 JSR >BasGetLineNo ; convert line no to binary
L83A6 LDX <BasTempLine ; get converted line no
STX BasLinInpHead ; store in input line header
JSR >L8F67 ; go tokenize the line
STB <BasGenCount ; save the line length
BSR BasFindLineNo ; find out where to insert the line
BCS L83C6 ; branch if new line (does not exist).
LDD <Eval47 ; get absolute address of line number
SUBD ,X ; subtract the address of the next line no
ADDD <BasVarSimpleAddr ; add to current length of program
STD <BasVarSimpleAddr ; that will remove length of current line no from program.
LDU ,X ; point U to address of next line no
; delete old line from basic program
L83BE PULU A ; get a byte from old location
STA ,X+ ; store in new location
CMPX <BasVarSimpleAddr ; end of program ?
BNE L83BE ; nope : keep going
L83C6 LDA BasLinInpBuff ; check to see if there is a line in the buffer
BEQ L83E7 ; nope !
LDD <BasVarSimpleAddr ; save current end of program in Eval43
STD <Eval43
ADDB <BasGenCount ; Add the length of the crunched line
ADCA #$00 ; propogate carry to MSB
STD <Eval41 ; save new end in Eval41
JSR >BasChkArrSpaceMv ; check space available and move vars up
LDU #BasLinInpHead-2 ; Point U at line to be inserted
L83DB PULU A ; transfer bytes of line
STA ,X+
CMPX <Eval45 ; done all bytes?
BNE L83DB ; nope, keep going
LDX <Eval41 ; get and save new end of program
STX <BasVarSimpleAddr
L83E7 BSR BasVect1 ; Reset input pointer, clear variables and init
BSR BasVect2 ; Adjust start of next line addr
BRA BasCmdMode2 ; re-enter input loop
; calculate the start of line addresses for the basic program.
; This searches through the text of the basic program and re-generates the
; line linked list.
BasVect2:
L83ED LDX <BasStartProg ; get the address of the start of the program
L83EF LDD ,X ; get the link address
BEQ L8414 ; zero : end of program, finished
LEAU 4,X ; point U to beginning of this line's text (past line no & link)
L83F5 LDA ,U+ ; get a byte from line
BNE L83F5 ; End of line? (zero byte). nope loop again
STU ,X ; save link to next line in current line
LDX ,X ; follow link to next line
BRA L83EF ; loop to scan next line
; Find a line number in the basic program (in BasTempLine), return with
; carry set if line not found
BasFindLineNo:
L83FF LDD <BasTempLine ; get line to search for
LDX <BasStartProg ; point to start of program
L8403 LDU ,X ; get address of next line in U
BEQ L8410 ; end of program if zero, exit
CMPD 2,X ; compare searched line no with this line's number
BLS L8412 ; Found it : exit
LDX ,X ; follow link to next line
BRA L8403 ; continue search
L8410 ORCC #FlagCarry ; flag line no not found
L8412 STX <Eval47 ; save line pointer
L8414 RTS ; return
CmdNew:
L8415 BNE L8412 ; branch if param given, causes ?SN error
BasNew:
L8417 LDX <BasStartProg ; get start of prog in X
CLR ,X+ ; clear first line link address, to flag end of program
CLR ,X+
STX <BasVarSimpleAddr ; setup simple var pointer after end of prog
BasVect1:
L841F LDX <BasStartProg ; get start of prog in X
JSR >BasSetProgPtrX ; put pointer one before start of basic
; Erase all variables
; $8424
BasEraseVars
JSR VectResetBasMem ; call trap vector
LDX <AddrFWareRamTop ; get top of RAM used by basic
STX <BasVarStrTop ; set top of strings space this
JSR >CmdRestore ; do a RESTORE
LDX <BasVarSimpleAddr ; Get start of simple vars,
STX <BasVarArrayAddr ; set start of arrays to be the same
STX <BasVarEnd ; and end of arrays, so no vars
BasResetStack:
L8434 LDX #BasStrDescStack ; restet string stack pointer to bottom
STX <BasStrFirstFreeTemp ; of string stack
LDX ,S ; get return address off stack
LDS <AddrStack ; reset stack pointer
CLR ,-S ; put zero byte on stack
CLR <BasOldInputPtr ; reset 'CONT' address
CLR <BasOldInputPtr+1
CLR <BasDisArraySearch ; Clear the array disable flag
JMP ,X ; return to caller
; FOR command
;
; 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 floating point value of step;
; 8 step direction: $ff if negative, 0 if zero, 1 if positive
; 9-13 floating point value of `to' parameter
; 14,15 current line number
; 16,17 ram address of the end
CmdFor:
L8448 LDA #$80 ; save disable array search in BasDisArraySearch
STA <BasDisArraySearch
JSR >CmdLet ; set index variable to initial value
JSR >L82F7 ; search stack for for/next data
LEAS 2,S ; purge the return address from the stack
BNE L845A ; branch if index variable not already used
LDX <BasTempPtr ; get address+18 of matched for/next data
; 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
LEAS B,X
L845A LDB #$09 ; check for room for 18 bytes
JSR >BasChkB2Free
JSR >L861B ; get address of end of subline in X
LDD <BasCurrentLine ; save line address and number on stack
PSHS D,X
LDB #DTokTO ; Token for TO
JSR >VarCKChar ; Syntax check for TO
JSR >VarGetExprCC ; TM error if index set to string
JSR >L8872 ; evaluate expression
LDB <FP0SGN ; get floating point 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 #L8480 ; setup return address in Y
JMP >L891B ; Push Floating point accumulator onto stack
L8480 LDX #FPOnePointZero ; load address of FP 1.00 into X (default step value)
JSR >XtoFPA0 ; move (x) to floating point accumulator
JSR <BasChrGetCurr ; get current char from basic
CMPA #DTokSTEP ; STEP token?
BNE L8491 ; no, skip
JSR <BasChrGet ; skip over step token
JSR >L8872 ; Evaluate numeric expression (step value)
L8491 JSR >TestFPA0 ; check status of FPA
JSR >L8917 ; Save FPA and status on stack
LDD <BasTempVarDesc ; Get var descriptor pointer for the step variable
PSHS D ; save on stack
LDA #$80 ; get FOR flag and save on stack
PSHS A
; Main command interpretation loop
BasRun:
L849F JSR VectGetNextCmd ; call get next command hook
ANDCC #IntsEnable ; enable IRQ,FIRQ
BSR BasPollKeyboard ; scan keyboard
LDX <BasAddrSigByte ; get basic input pointer
STX <BasDirectTextPtr ; save it
LDA ,X+ ; get a byte from basic, move pointer
BEQ L84B5 ; End of line? Yep skip it
CMPA #':' ; colon ?
BEQ L84D6 ; Yep, deal with it
JSNerror
JMP >BasSNError ; Else Syntax error
L84B5 LDA ,X++ ; get MSB of address of next line
STA <BasBreakFlag ; save in stop/end flag
; cause a stop if addr < $8000
; cause and end if addr > $8000
LBEQ L8545 ; branch to stop
LDD ,X+ ; get current line number
STD <BasCurrentLine ; save current line no
STX <BasAddrSigByte ; save address of first byte of line
LDA <BasTronFlag ; get TRON flag
BEQ L84D6 ; not tracing skip
LDA #'[' ; print '['
JSR >TextOutChar
LDA <BasCurrentLine ; get line number (other half still in B).
JSR >TextOutNum16 ; print it
LDA #']' ; print closing ']'
JSR >TextOutChar
L84D6 JSR <BasChrGet ; get a char from basic
BSR L84DC ; go execute command
;84DA
BasBRARun:
BRA BasRun ; and then go back to main loop
L84DC BEQ L851A ; return if end of line
JSR VectCmdInterp ; call basic interpret ram hook
TSTA ; check for token, bit 7 set -ve
LBPL CmdLet ; no token do a LET by default (MS basic default).
CMPA #DTokRENUM ; beyond last command token handled by us?
BHI L84F5 ; yep : pass it on
LDX BasAddrCmdDisp ; point to dispatch table
BasDoDipatch:
ASLA ; calculate offset in table of command handler address
TFR A,B ; add to base of table
ABX
JSR <BasChrGet ; get next character from basic
L84F3 JMP [,X] ; Jump to command handler
L84F5 CMPA #$FF ; Check for secondary token
BEQ L8501 ; Yep : deal with it
CMPA #DTokLastC ; higher than last command?
BLS JSNerror ; no. error
JMP [BasAddrDskCmdDisp] ; yes, jump to secondary basic command handler (normally dos).
L8501 JSR <BasChrGet ; skip over secondary token marker
CMPA #DTokMIDS ; Token is MID$ ?
LBEQ DoMIDS ; yes, jump to it
CMPA #DTokTIMER ; Token is TIMER
LBEQ L9D51 ; yes, jump to it
JSR VectAccessScreen ; call vector
BRA JSNerror ; generate SN error
CmdRestore:
L8514 LDX <BasStartProg ; point at beginning of program -1
LEAX -1,X
L8518 STX <BasVarDataAddr ; set basic data pointer to beginning
L851A RTS ; return
BasPollKeyboard:
L851B JSR >BasicKbdIn ; Get a keystroke, if any?
BEQ L852A ; return if no key pressed
L8520 CMPA #$03 ; check for break?
BEQ CmdStop ; yes, break program.
CMPA #$13 ; check for pause? (CTRL-S)
BEQ TextWaitKey ; yes wait.....
STA <TextLastKey ; save pressed key
L852A RTS ; return
TextWaitKey:
L852B JSR >BasicKbdIn ; read keyboard
BEQ TextWaitKey ; keep waiting if no key pressed
BRA L8520 ; re-enter poll loop
CmdEnd:
L8532 JSR >LB65C ; Close files
JSR <BasChrGetCurr ; get current input char
BRA L853B
CmdStop:
L8539 ORCC #FlagCarry ; set carry flag
L853B BNE L8570
LDX <BasAddrSigByte ; Save current pos of basic input pointer
STX <BasDirectTextPtr
L8541 ROR <BasBreakFlag ; Rotate carry into break flag
LEAS 2,S ; drop return address
L8545 LDX <BasCurrentLine ; Get current line no
CMPX #$FFFF ; Direct mode ?
BEQ L8552 ; Yep : skip ahead
STX <BasContLine ; Save current line for CONT
LDX <BasDirectTextPtr ; save Basic text pointer
STX <BasOldInputPtr
L8552 CLR <TextDevN ; Make console default device no
LDX #MessBreak-1 ; point to break message
TST <BasBreakFlag ; branch to main loop of basic if end
LBPL BasCmdMode L8371
JMP >L8366 ; basic's main loop if stop
CmdCont:
L8560 BNE L8570 ; return if argument given
LDB #ErrCN ; can't continue error
LDX <BasOldInputPtr ; get continue address (input pointer)
LBEQ SysErr ; CN error if continue address is 0
STX <BasAddrSigByte ; reset basic's input pointer
LDX <BasContLine ; get continue line number
STX <BasCurrentLine ; set current line number to continue line no
L8570 RTS
CmdClear:
L8571 BEQ L859F ; Check for parameters, nope skip on
JSR >L8B23 ; get string space to clear
PSHS D ; save on stack
LDX <AddrFWareRamTop ; Get top of RAM as default cleared area
JSR <BasChrGetCurr ; get next character
BEQ L858A ; none, no top of basic ram specified
JSR >VarCKComma ; Check for comma, error if not
JSR >VarGet16Bit ; get ramtop spec
LEAX -1,X ; decrement by 1
CMPX <AddrRamTop ; Greater than physical RAM?
BHI L85A2 ; yep : OM Error?
L858A TFR X,D ; get RamTop into D
SUBD ,S++ ; adjust for string space
BCS L85A2 ; Generate OM error if < 0 bytes
TFR D,U ; U = bottom of cleared space
SUBD #StackBuf ; subtract stack buffer
BCS L85A2 ; Generate OM error if < 0 bytes
SUBD <BasVarSimpleAddr ; subtract start of variables
BCS L85A2 ; Generate OM error if < 0 bytes
STU <AddrStack ; Address of stack base
STX <AddrFWareRamTop ; Address of top of RAM used by basic
L859F JMP >BasEraseVars
L85A2 JMP >BasOMError ; generate out of memory error
CmdRun:
L85A5 JSR VectRunLink ; call ram vector
JSR >InitSndGraph ; Init sound and graphics constants
JSR >LB65C ; close any open files
JSR <BasChrGetCurr ; get current input character
LBEQ BasVect1 ; if no line no reset vars etc
JSR >BasEraseVars
BRA L85D2 ; skip ahead
CmdGo:
L85B9 TFR A,B ; save input char in b
L85BB JSR <BasChrGet ; get next char
CMPB #DTokTO ; is it a GOTO?
BEQ L85D7 ; yes : deal with it
CMPB #DTokSUB ; is it a GOSUB?
BNE L860A ; no error
LDB #$03 ; Check we have 3*2 bytes free (on stack)
JSR >BasChkB2Free
LDU <BasAddrSigByte ; get current input pointer
LDX <BasCurrentLine ; get current line no
LDA #DTokSUB ; sub token
PSHS A,X,U ; push basic subroutine return address/pointer
L85D2 BSR L85D7 ; Do a 'goto'
JMP >BasRun ; jump back to basic's main loop
L85D7 JSR <BasChrGetCurr ; get current input char
JSR >BasGetLineNo ; get line number from program
BSR L861E ; advance pointer to end of current line
LEAX 1,X ; point to start of next line
LDD BasTempLine ; get the destination line no
CMPD <BasCurrentLine ; is it the current line?
BHI L85E9 ; if destination is higher than current, search from current
BasSkipLineNo:
LDX <BasStartProg ; otherwise start from begiining of program
L85E9 JSR >L8403 ; go find line number
BCS BasULError ; undefined line number
BasSetProgPtrX:
L85EE LEAX -1,X ; move to just before start of line
STX <BasAddrSigByte ; set basic pointer to destination line
L85F2 RTS ; goto it!
CmdReturn:
L85F3 BNE L85F2 ; error : argument given
LDA #$FF ; put an illgal value in vardes,
STA <BasTempVarDesc ; so ignore for/next data on stack.
JSR >L82F7 ; check for return data on stack
TFR X,S ; reset stack pointer, purge 2 return addresses
CMPA #(DTokSUB-DTokFirstC) ; Sub token
BEQ L860D ; Yep, do return
D8602 LDB #ErrRG ; 'return without gosub' error
FCB Skip2 ; skip 2 bytes
BasULError
LDB #ErrUL ; 'undefined line' error
JMP >SysErr ; jump to error handler
L860A JMP >BasSNError ; Syntax error jump
L860D PULS A,X,U ; restore text pointer and line number
STX <BasCurrentLine ; restore line no
STU <BasAddrSigByte ; and text pointer
CmdData:
L8613 BSR L861B ; move input pointer to end of line or subline