-
-
Notifications
You must be signed in to change notification settings - Fork 10
/
main.asm
2101 lines (2089 loc) · 71.5 KB
/
main.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
;
; Title: BBC Basic Interpreter - Z80 version
; Command, Error and Lexical Analysis Module - "MAIN"
; Author: (C) Copyright R.T.Russell 1984
; Modified By: Dean Belfield
; Created: 03/05/2022
; Last Updated: 15/11/2023
;
; Modinfo:
; 07/05/1984: Version 2.3
; 01/03/1987: Version 3.0
; 03/05/2022: Modified by Dean Belfield to assemble with ZDS
; 28/09/2022: Tidied up KEYWDS and ERRWDS, Added KEYWDS and KEYWDL to XDEFs, entry point ONEDIT for *EDIT
; 12/01/2023: Added MOS C-style parameter processing routines and autoload functionality
; 26/02/2023: Text in comments are not detokenised, Tweaks for *EDIT and OSLOAD_TXT
; 24/03/2023: Removed TEST_FILENAME
; 28/03/2023: Tweaked for improved BYE command
; 19/05/2023: Fixed bug in ONEDIT1 for OSLOAD_TXT
; 15/11/2023: Startup message now includes Agon version
.ASSUME ADL = 0
INCLUDE "equs.inc"
SEGMENT CODE
XDEF _main
XDEF COLD
XDEF WARM
XDEF CLOOP
XDEF DELETE
XDEF LIST_
XDEF RENUM
XDEF AUTO
XDEF NEW
XDEF OLD
XDEF LOAD
XDEF SAVE
XDEF ERROR_
XDEF EXTERR
XDEF LOAD0
XDEF CLEAR
XDEF CRLF
XDEF OUTCHR
XDEF OUT_
XDEF FINDL
XDEF SETLIN
XDEF PBCDL
XDEF SAYLN
XDEF PUTVAR
XDEF GETVAR
XDEF GETDEF
XDEF CREATE
XDEF RANGE
XDEF LEXAN2
XDEF REPORT
XDEF TELL
XDEF SPACE_
XDEF KEYWDS
XDEF KEYWDL
XDEF ONEDIT
XDEF ONEDIT1
XDEF LISTIT
XDEF CLEAN
XREF LISTON
XREF ERRTXT
XREF OSINIT
XREF HIMEM
XREF PAGE_
XREF CHAIN0
XREF PROMPT
XREF ERRTRP
XREF ERRLIN
XREF AUTONO
XREF LINENO
XREF INCREM
XREF OSLINE
XREF COUNT
XREF NXT
XREF BUFFER
XREF XEQ
XREF TOP
XREF EXPRI
XREF SEARCH
XREF LTRAP
XREF LOMEM
XREF DECODE
XREF EXPRS
XREF OSSAVE
XREF ERR
XREF ERL
XREF TRACEN
XREF RESET
XREF OSSHUT
XREF OSLOAD
XREF FREE
XREF DYNVAR
XREF FILL
XREF OSWRCH
XREF WIDTH
XREF COMMA
XREF MUL16
XREF BRAKET
XREF X4OR5
XREF LOADN
XREF SFIX
XREF ITEMI
XREF FNPTR
XREF PROPTR
XREF CHECK
XREF TERMQ
XREF OSWRCHCH
XREF NEWIT
XREF BAD
XREF STAR_VERSION
;
; A handful of common token IDs
;
TERROR: EQU 85H
LINE_: EQU 86H
ELSE_: EQU 8BH
THEN: EQU 8CH
LINO: EQU 8DH
FN: EQU A4H
TO: EQU B8H
REN: EQU CCH
DATA_: EQU DCH
DIM: EQU DEH
FOR: EQU E3H
GOSUB: EQU E4H
GOTO: EQU E5H
TIF: EQU E7H
LOCAL_: EQU EAH
NEXT: EQU EDH
ON_: EQU EEH
PROC: EQU F2H
REM: EQU F4H
REPEAT: EQU F5H
RESTOR: EQU F7H
TRACE: EQU FCH
UNTIL: EQU FDH
;
; This defines the block of tokens that are pseudo-variables.
; There are two versions of each token, a GET and a SET
; Name : GET : SET
; ------:-----:----
; PTR : 8Fh : CFh
; PAGE : 90h : D0h
; TIME : 91h : D1h
; LOMEM : 92h : D2h
; HIMEM : 93h : D3h
;
; Examples:
; LET A% = PAGE : REM This is the GET version
; PAGE = 40000 : REM This is the SET version
;
TOKLO: EQU 8FH ; This defines the block of tokens that are pseudo-variables
TOKHI: EQU 93H ; PTR, PAGE, TIME, LOMEM, HIMEM
OFFSET: EQU CFH-TOKLO ; Offset to the parameterised SET versions
; The main routine
; IXU: argv - pointer to array of parameters
; C: argc - number of parameters
; Returns:
; HL: Error code, or 0 if OK
;
_main: LD HL, ACCS ; Clear the ACCS
LD (HL), 0
LD A, C
CP 2
JR Z, AUTOLOAD ; 2 parameters = autoload
JR C, COLD ; 1 parameter = normal start
CALL STAR_VERSION ; Output the AGON version
CALL TELL
DB "Usage:\n\r"
DB "RUN . <filename>\n\r", 0
LD HL, 0 ; The error code
RET
;
AUTOLOAD: LD.LIL HL, (IX+3) ; HLU: Address of filename
LD DE, ACCS ; DE: Destination address
$$: LD.LIL A, (HL) ; Fetch the filename byte
LD (DE), A ;
INC.LIL HL ; Increase the source pointer
INC E ; We only need to increase E as ACCS is on a page boundary
JR NZ, $B ; Loop until we hit a 0 byte
DEC E
LD A, CR
LD (DE), A ; Replace the 0 byte with a CR for BBC BASIC
;
COLD: POP HL ; Pop the return address to init off SPS
PUSH.LIL HL ; Stack it on SPL (*BYE will use this as the return address)
LD HL,STAVAR ; Cold start
LD SP,HL
LD (HL),10
INC L
LD (HL),9
INC L
XOR A
PURGE: LD (HL),A ; Clear scratchpad
INC L
JR NZ,PURGE
LD (OSWRCHCH), A ; Set default output channel to CONSOLE
LD A,37H ; Set LISTO sysvar; the bottom nibble is LISTO (7), top nibble is OPT (3)
LD (LISTON),A
LD HL,NOTICE
LD (ERRTXT),HL
CALL OSINIT ; Call the machine specific OS initialisation routines
LD (HIMEM),DE ; This returns HIMEM (ramtop) in DE - store in the HIMEM sysvar
LD (PAGE_),HL ; And PAGE in HL (where BASIC program storage starts) - store in PAGE sysvar
CALL NEWIT ; From what I can determine, NEWIT always returns with Z flag set
LD A,(ACCS) ; Check if there is a filename in ACCS
OR A
JP NZ,CHAIN0 ; Yes, so load and run
CALL STAR_VERSION ; Output the AGON version
CALL TELL ; Output the welcome message
DB "BBC BASIC (Z80) Version 3.00\n\r"
NOTICE: DB "(C) Copyright R.T.Russell 1987\n\r"
DB "\n\r", 0
;
WARM: DB F6H ; Opcode for OR? Maybe to CCF (the following SCF will be the operand)
;
; This is the main entry point for BASIC
;
CLOOP: SCF ; See above - not sure why this is here!
LD SP,(HIMEM)
CALL PROMPT ; Prompt user
LD HL,LISTON ; Pointer to the LISTO/OPT sysvar
LD A,(HL) ; Fetch the value
AND 0FH ; Bottom nibble: LISTO
OR 30H ; Top nibble: Default to OPT (3)
LD (HL),A ; Store back in
SBC HL,HL ; HL: 0
LD (ERRTRP),HL ; Clear ERRTRP sysvar
LD (ERRLIN),HL ; Clear ERRLIN sysvar (ON ERROR)
;
LD HL,(AUTONO) ; Get the auto line number
LD (LINENO),HL ; Store in line number
LD A,H ; If the auto line number is zero then
OR L
JR Z,NOAUTO ; We're not auto line numbering, so skip the next bit
;
; This section handles auto line numbering
;
PUSH HL ; Stack the line number
CALL PBCD ; Output the line number
POP HL ; Pop the line number back off the stack
LD BC,(INCREM) ; Load BC with Increment - but INCREM is just a byte; C is the value
LD B,0 ; So clear B
ADD HL,BC ; Add the increment to the line number
JP C,TOOBIG ; And error if we wrap
LD (AUTONO),HL ; Store the new auto line number
LD A,' ' ; Print a space
CALL OUTCHR
;
; This section invokes the line editor
;
NOAUTO: LD HL,ACCS ; Storage for the line editor (256 bytes)
CALL OSLINE ; Call the line editor in MOS
ONEDIT: CALL ONEDIT1 ; Enter the line into memory
CALL C,CLEAN ; Set TOP, write out &FFFF end of program marker
JP CLOOP ; Jump back to immediate mode
;
; This bit enters the line into memory
; Also called from OSLOAD_TXT
; Returns:
; F: C if a new line has been entered (CLEAN will need to be called)
;
ONEDIT1: XOR A ; Entry point after *EDIT
LD (COUNT),A
LD IY,ACCS
CALL LINNUM ; HL: The line number from the input buffer
CALL NXT ; Skip spaces
LD A,H ; HL: The line number will be 0 for immediate mode or when auto line numbering is used
OR L
JR Z,LNZERO ; Skip if there is no line number in the input buffer
LD (LINENO),HL ; Otherwise store it
;
; This bit does the lexical analysis and tokenisation
;
LNZERO: LD DE,BUFFER ; Buffer for tokenised BASIC
LD C,1 ; Left mode
CALL LEXAN2 ; Lexical analysis on the user input
LD (DE),A ; Terminator
XOR A
LD B,A
LD C,E ; BC: Line length
INC DE
LD (DE),A ; Zero next
LD HL,(LINENO) ; Get the line number
LD A,H ; Is it zero, i.e. a command with no line number?
OR L
LD IY,BUFFER ; Yes, so we're in immediate mode
JP Z,XEQ ; Execute it
;
; This section stores the BASIC line in memory
;
PUSH BC
PUSH HL
CALL SETTOP ; Set TOP sysvar
POP HL
CALL FINDL ; Find the address of the line
CALL Z,DEL ; Delete the existing line if found
POP BC
LD A,C ; Check for the line length being zero, i.e.
OR A ; the user has just entered a line number in the command line
RET Z ; If so, then don't do anything else
ADD A,4
LD C,A ; Length inclusive
PUSH DE ; DE: Line number (fetched from the call to FINDL)
PUSH BC ; BC: Line length
EX DE,HL ; DE: Address of the line in memory
LD HL,(TOP) ; HL: TOP (the first free location after the end of the BASIC program)
PUSH HL ; Stack TOP (current TOP value)
ADD HL,BC ; Add the line length to HL, the new TOP value
PUSH HL ; Stack HL (new TOP value)
INC H ; Add 256 to HL
XOR A
SBC HL,SP ; Check whether HL is in the same page as the current stack pointer
POP HL ; Pop HL (new TOP value)
JP NC,ERROR_ ; If HL is in the stack page, then error: "No room"
LD (TOP),HL ; Store new value of TOP
EX (SP),HL ; HL: TOP (current TOP value), top of stack now contains new TOP value
PUSH HL ; PUSH current TOP value
INC HL
OR A
SBC HL,DE ; DE: Address of the line in memory
LD B,H ; BC: Amount to move
LD C,L
POP HL ; HL: Destination (current TOP value)
POP DE ; DE: Source (new TOP value)
JR Z,ATEND ; If current TOP and new TOP are the same, i.e. adding a line at the end, then skip...
LDDR ; Otherwise, make space for the new line in the program
ATEND: POP BC ; BC: Line length
POP DE ; DE: Line number
INC HL ; HL: Destination address
LD (HL),C ; Store length
INC HL
LD (HL),E ; Store line number
INC HL
LD (HL),D
INC HL
LD DE,BUFFER ; DE: Location of the new, tokenised line
EX DE,HL ; HL: Location of the new, tokensied line, DE: Destination address in BASIC program
DEC C ; Subtract 3 from the number of bytes to copy to
DEC C ; compensate for the 3 bytes stored above (length and line number)
DEC C
LDIR ; Add the line to the BASIC program
SCF ; To flag we need to call CLEAN
RET
;
; List of tokens and keywords. If a keyword is followed by 0 then
; it will only match with the keyword followed immediately by
; a delimiter
;
KEYWDS: DB 80H, 'AND'
DB 94H, 'ABS'
DB 95H, 'ACS'
DB 96H, 'ADVAL'
DB 97H, 'ASC'
DB 98H, 'ASN'
DB 99H, 'ATN'
DB C6H, 'AUTO'
DB 9AH, 'BGET', 0
DB D5H, 'BPUT', 0
DB FBH, 'COLOUR'
DB FBH, 'COLOR'
DB D6H, 'CALL'
DB D7H, 'CHAIN'
DB BDH, 'CHR$'
DB D8H, 'CLEAR', 0
DB D9H, 'CLOSE', 0
DB DAH, 'CLG', 0
DB DBH, 'CLS', 0
DB 9BH, 'COS'
DB 9CH, 'COUNT', 0
DB DCH, 'DATA'
DB 9DH, 'DEG'
DB DDH, 'DEF'
DB C7H, 'DELETE'
DB 81H, 'DIV'
DB DEH, 'DIM'
DB DFH, 'DRAW'
DB E1H, 'ENDPROC', 0
DB E0H, 'END', 0
DB E2H, 'ENVELOPE'
DB 8BH, 'ELSE'
DB A0H, 'EVAL'
DB 9EH, 'ERL', 0
DB 85H, 'ERROR'
DB C5H, 'EOF', 0
DB 82H, 'EOR'
DB 9FH, 'ERR', 0
DB A1H, 'EXP'
DB A2H, 'EXT', 0
DB E3H, 'FOR'
DB A3H, 'FALSE', 0
DB A4H, 'FN'
DB E5H, 'GOTO'
DB BEH, 'GET$'
DB A5H, 'GET'
DB E4H, 'GOSUB'
DB E6H, 'GCOL'
DB 93H, 'HIMEM', 0
DB E8H, 'INPUT'
DB E7H, 'IF'
DB BFH, 'INKEY$'
DB A6H, 'INKEY'
DB A8H, 'INT'
DB A7H, 'INSTR('
DB C9H, 'LIST'
DB 86H, 'LINE'
DB C8H, 'LOAD'
DB 92H, 'LOMEM', 0
DB EAH, 'LOCAL'
DB C0H, 'LEFT$('
DB A9H, 'LEN'
DB E9H, 'LET'
DB ABH, 'LOG'
DB AAH, 'LN'
DB C1H, 'MID$('
DB EBH, 'MODE'
DB 83H, 'MOD'
DB ECH, 'MOVE'
DB EDH, 'NEXT'
DB CAH, 'NEW', 0
DB ACH, 'NOT'
DB CBH, 'OLD', 0
DB EEH, 'ON'
DB 87H, 'OFF'
DB 84H, 'OR'
DB 8EH, 'OPENIN'
DB AEH, 'OPENOUT'
DB ADH, 'OPENUP'
DB FFH, 'OSCLI'
DB F1H, 'PRINT'
DB 90H, 'PAGE', 0
DB 8FH, 'PTR', 0
DB AFH, 'PI', 0
DB F0H, 'PLOT'
DB B0H, 'POINT('
DB F2H, 'PROC'
DB B1H, 'POS', 0
DB CEH, 'PUT'
DB F8H, 'RETURN', 0
DB F5H, 'REPEAT'
DB F6H, 'REPORT', 0
DB F3H, 'READ'
DB F4H, 'REM'
DB F9H, 'RUN', 0
DB B2H, 'RAD'
DB F7H, 'RESTORE'
DB C2H, 'RIGHT$('
DB B3H, 'RND', 0
DB CCH, 'RENUMBER'
DB 88H, 'STEP'
DB CDH, 'SAVE'
DB B4H, 'SGN'
DB B5H, 'SIN'
DB B6H, 'SQR'
DB 89H, 'SPC'
DB C3H, 'STR$'
DB C4H, 'STRING$('
DB D4H, 'SOUND'
DB FAH, 'STOP', 0
DB B7H, 'TAN'
DB 8CH, 'THEN'
DB B8H, 'TO'
DB 8AH, 'TAB('
DB FCH, 'TRACE'
DB 91H, 'TIME', 0
DB B9H, 'TRUE', 0
DB FDH, 'UNTIL'
DB BAH, 'USR'
DB EFH, 'VDU'
DB BBH, 'VAL'
DB BCH, 'VPOS', 0
DB FEH, 'WIDTH'
DB D3H, 'HIMEM'
DB D2H, 'LOMEM'
DB D0H, 'PAGE'
DB CFH, 'PTR'
DB D1H, 'TIME'
;
; These are indexed from the ERRWDS table
;
DB 01H, 'Missing '
DB 02H, 'No such '
DB 03H, 'Bad '
DB 04H, ' range'
DB 05H, 'variable'
DB 06H, 'Out of'
DB 07H, 'No '
DB 08H, ' space'
KEYWDL: EQU $-KEYWDS
DW -1
;
; Error messages
;
ERRWDS: DB 7, 'room', 0 ; 0: No room
DB 6, 4, 0 ; 1: Out of range
DB 0 ; 2: *
DB 0 ; 3: *
DB 'Mistake', 0 ; 4: Mistake
DB 1, ',', 0 ; 5: Missing ,
DB 'Type mismatch', 0 ; 6: Type mismatch
DB 7, FN, 0 ; 7: No FN
DB 0 ; 8: *
DB 1, 34, 0 ; 9: Missing "
DB 3, DIM, 0 ; 10: Bad DIM
DB DIM, 8, 0 ; 11: DIM space
DB 'Not ', LOCAL_, 0 ; 12: Not LOCAL
DB 7, PROC, 0 ; 13: No PROC
DB 'Array', 0 ; 14: Array
DB 'Subscript', 0 ; 15: Subscript
DB 'Syntax error', 0 ; 16: Syntax error
DB 'Escape', 0 ; 17: Escape
DB 'Division by zero', 0 ; 18: Division by zero
DB 'String too long', 0 ; 19: String too long
DB 'Too big', 0 ; 20: Too big
DB '-ve root', 0 ; 21: -ve root
DB 'Log', 4, 0 ; 22: Log range
DB 'Accuracy lost', 0 ; 23: Accuracy lost
DB 'Exp', 4, 0 ; 24: Exp range
DB 0 ; 25: *
DB 2, 5, 0 ; 26: No such variable
DB 1, ')', 0 ; 27: Missing )
DB 3, 'HEX', 0 ; 28: Bad HEX
DB 2, FN, '/', PROC, 0 ; 29: No such FN/PROC
DB 3, 'call', 0 ; 30: Bad call
DB 'Arguments', 0 ; 31: Arguments
DB 7, FOR, 0 ; 32: No FOR
DB "Can't match ", FOR, 0 ; 33: Can't match FOR
DB FOR, ' ', 5, 0 ; 34: FOR variable
DB 0 ; 35: *
DB 7, TO, 0 ; 36: No TO
DB 0 ; 37: *
DB 7, GOSUB, 0 ; 38: No GOSUB
DB ON_, ' syntax', 0 ; 39: ON syntax
DB ON_, 4, 0 ; 40: ON range
DB 2, 'line', 0 ; 41: No such line
DB 6, ' ', DATA_, 0 ; 42: Out of DATA
DB 7, REPEAT, 0 ; 43: No REPEAT
DB 0 ; 44: *
DB 1, '#', 0 ; 45: Missing #
;
; COMMANDS:
;
; DELETE line,line
;
DELETE: CALL SETTOP ; Set TOP sysvar (first free byte at end of BASIC program)
CALL DLPAIR ; Get the line number pair - HL: BASIC program address, BC: second number (or 0 if missing)
DELET1: LD A,(HL) ; Check whether it's the last line
OR A
JR Z,WARMNC ; Yes, so do nothing
INC HL ; Skip the line length byte
LD E,(HL) ; Fetch the line number in DE
INC HL
LD D,(HL)
LD A,D ; If the line number is zero then
OR E
JR Z,CLOOP1 ; Do nothing
DEC HL ; Decrement BASIC program pointer back to length
DEC HL
EX DE,HL ; Check if we've gone past the terminating line
SCF
SBC HL,BC
EX DE,HL
JR NC,WARMNC ; Yes, so exit back to BASIC prompt
PUSH BC
CALL DEL ; Delete the line pointed to by HL
POP BC
JR DELET1 ; And loop round to the next line
;
; LISTO expr
;
LISTO: INC IY ; Skip "O" byte
CALL EXPRI ; Get expr
EXX
LD A,L
LD (LISTON),A ; Store in LISTON sysvar
CLOOP1: JP CLOOP
;
; LIST
; LIST line
; LIST line,line [IF string]
; LIST ,line
; LIST line,
;
LIST_: CP 'O' ; Check for O (LISTO)
JR Z,LISTO ; and jump to LISTO if zero
CALL DLPAIR ; Get the line number pair - HL: BASIC program address, BC: second number (or 0 if missing)
CALL NXT ; Skip space
CP TIF ; Check for IF clause (token IF)
LD A,0 ; Initialise the IF clause string length
JR NZ,LISTB ; If there is no IF clause, skip the next bit
;
INC IY ; Skip the IF token
CALL NXT ; And skip any spaces
EX DE,HL ; DE: Address in memory
PUSH IY ; LD IY, HL
POP HL ; HL is now the address of the tokenised line
LD A,CR
PUSH BC ; Stack the second line number arg
LD BC,256
CPIR ; Locate CR byte
LD A,C
CPL ; A: Substring length (of IF clause)
POP BC ; Restore the second line number arg
EX DE,HL ; HL: Address in memory
;
LISTB: LD E,A ; E: IF clause string length
LD A,B ; Check whether a second line number was passed (BC!=0)
OR C
JR NZ,LISTA ; If there isn't a second line number
DEC BC ; then we set it to the maximum of 65535
;
LISTA: EXX
LD IX,LISTON ; IX : Pointer to the LISTON (LISTO and OPT) sysvar
LD BC,0 ; BC': Indentation counter (C: FOR/NEXT, B: REPEAT/UNTIL)
EXX
LD A,20 ; Number of lines to list
;
LISTC: PUSH BC ; Save second line number
PUSH DE ; Save IF clause length
PUSH HL ; Save BASIC program counter
EX AF,AF'
;
; BBC BASIC for Z80 lines are stored as follows:
;
; - [LEN] [LSB] [MSB] [DATA...] [0x0D]: LSB, MSB = line number
; - [&00] [&FF] [&FF]: End of program marker
;
; This is the Russell format and different to the Wilson/Acorn format: https://www.beebwiki.mdfs.net/Program_format
;
LD A,(HL) ; Check for end of program marker
OR A ; If found
JR Z,WARMNC ; Jump to WARMNC (F=NC, so will jump to WARM)
;
; Check if past terminating line number
;
LD A,E ; A: IF clause length
INC HL ; Skip the length byte
LD E,(HL) ; Fetch the line number in DE
INC HL
LD D,(HL)
DEC HL ; Step HL back to the length byte
DEC HL
PUSH DE ; Push the line number on the stack
EX DE,HL ; HL: line number
SCF ; Do a 16-bit compare of HL and DE
SBC HL,BC
EX DE,HL
POP DE ; Restore the line number
WARMNC: JP NC,WARM ; If exceeded the terminating line number then jump to WARM
LD C,(HL) ; C: Line length + 4
LD B,A ; B: IF clause length
;
; Check if "UNLISTABLE":
;
LD A,D ; TODO: What is "UNLISTABLE?"
OR E
JP Z,CLOOP
;
; Check for IF clause:
;
INC HL ; Skip the length
INC HL ; Skip the line number
INC HL ; HL: Address of the tokenised BASIC line
DEC C ; C: Line length
DEC C
DEC C
DEC C
PUSH DE ; Save the line number
PUSH HL ; Save the BASIC program address
XOR A ;
CP B ; Check for an IF clause (B!=0)
PUSH IY ; LD IY, DE
POP DE ; DE: Address of the IF clause string in the input buffer
CALL NZ,SEARCH ; If there is an IF clause (B!=0) then search for it
POP HL ; Restore BASIC program address
POP DE ; Restore line number
PUSH IY
CALL Z,LISTIT ; List if no IF clause OR there is an IF clause match
POP IY
;
EX AF,AF'
DEC A ; Decrement line list counter
CALL LTRAP ; TODO: This destroys A - is this a bug I've introduced in LTRAP?
POP HL ; Restore BASIC program address to beginning of line
LD E,(HL) ; Fetch the length of line in DE
LD D,0
ADD HL,DE ; Go to the next line
POP DE ; Restore IF clause length
POP BC ; Restore second line number
JR LISTC ; Loop back to do next line
;
; RENUMBER
; RENUMBER start
; RENUMBER start,increment
; RENUMBER ,increment
;
RENUM: CALL CLEAR ; Uses the heap so clear all dynamic variables and function/procedure pointers
CALL PAIR ; Fetch the parameters - HL: start (NEW line number), BC: increment
EXX
LD HL,(PAGE_) ; HL: Top of program
LD DE,(LOMEM) ; DE: Start address of the heap
;
; Build the table
;
RENUM1: LD A,(HL) ; Fetch the line length byte
OR A ; Is it zero, i.e. the end of program marker?
JR Z,RENUM2 ; Yes, so skip to the next part
INC HL
LD C,(HL) ; BC: The OLD line number
INC HL
LD B,(HL)
LD A,B
OR C
JP Z,CLOOP ; If the line number is zero, then exit back to the command line
EX DE,HL ; DE: Pointer to BASIC program, HL: Pointer to heap
LD (HL),C ; Store the OLD line number in the heap
INC HL
LD (HL),B
INC HL
EXX ; HL: line number, BC: increment
PUSH HL ; HL: Stack the NEW line number value
ADD HL,BC ; Add the increment
JP C,TOOBIG ; If > 65535, then error: "Too big"
EXX ; DE: Pointer to BASIC program, HL: Pointer to heap
POP BC ; BC: Pop the NEW line number value off the stack
LD (HL),C ; Store the NEW line number in the heap
INC HL
LD (HL),B
INC HL
EX DE,HL ; HL: Pointer to BASIC program, DE: Pointer to heap
DEC HL ; Back up to the line length byte
DEC HL
XOR A ; Not sure why this is done here instead of LD B,0
LD B,A ; BC: Line length
LD C,(HL)
ADD HL,BC ; Advance HL to next line
EX DE,HL ; DE: Pointer to BASIC program, HL: Pointer to heap
PUSH HL
INC H ; Increment to next page
SBC HL,SP ; Subtract from SP
POP HL
EX DE, HL ; HL: Pointer to BASIC program, DE: Pointer to heap
JR C,RENUM1 ; Loop, as the heap pointer has not strayed into the stack page
CALL EXTERR ; Otherwise throw error: "RENUMBER space'
DB REN
DB 8
DB 0
;
; At this point a list of BASIC line numbers have been written to the heap
; as word pairs:
; - DW: The OLD line number
; - DW: The NEW line number
;
RENUM2: EX DE,HL ; HL: Pointer to the end of the heap
LD (HL),-1 ; Mark the end with FFFFh
INC HL
LD (HL),-1
LD DE,(LOMEM) ; DE: Pointer to the start of the heap
EXX
LD HL,(PAGE_) ; HL: Start of the BASIC program area
RENUM3: LD C,(HL) ; Fetch the first line length byte
LD A,C ; If it is zero, then no program, so...
OR A
JP Z,WARM ; Jump to warm start
EXX ; HL: Pointer to end of heap, DE: Pointer to start of heap
EX DE,HL ; DE: Pointer to end of heap, HL: Pointer to start of heap
INC HL ; Skip to the NEW line number
INC HL
LD E,(HL) ; DE: The NEW line number
INC HL
LD D,(HL)
INC HL
PUSH DE ; Stack the NEW line number
EX DE,HL ; HL: The NEW line number, DE: Pointer to the end of heap
LD (LINENO),HL ; Store the line number in LINENO
EXX ; HL: Pointer to the BASIC program area
POP DE ; DE: The NEW line number
INC HL
LD (HL),E ; Write out the NEW line number to the BASIC program
INC HL
LD (HL),D
INC HL
DEC C ; Subtract 3 from the line length to compensate for increasing HL by 3 above
DEC C
DEC C
LD B,0 ; BC: Line length
;
RENUM7: LD A,LINO ; A: The token code that precedes any line number encoded in BASIC (i.e. GOTO/GOSUB)
CPIR ; Search for the token
JR NZ,RENUM3 ; If not found, then loop to process the next line
;
; Having established this line contains at least one encoded line number, we need to update it to point to the new line number
;
PUSH BC ; Stack everything
PUSH HL
PUSH HL ; HL: Pointer to encoded line number
POP IY ; IY: Pointer to encoded line number
EXX
CALL DECODE ; Decode the encoded line number (in HL')
EXX ; HL: Decoded line number
LD B,H ; BC: Decoded line number
LD C,L
LD HL,(LOMEM) ; HL: Pointer to heap
;
; This section of code cross-references the decoded (OLD) line number with the list
; created previously in the global heap
;
RENUM4: LD E,(HL) ; DE: The OLD line number
INC HL
LD D,(HL)
INC HL
EX DE,HL ; HL: The OLD line number, DE: Pointer in the global heap
OR A ; Clear the carry and...
SBC HL,BC ; Compare by means of subtraction the OLD line number against the one in the heap
EX DE,HL ; HL: Pointer in the global heap
LD E,(HL) ; DE: The NEW line number
INC HL
LD D,(HL)
INC HL
JR C,RENUM4 ; Loop until there is a match (Z) or not (NC)
EX DE,HL ; DE: Pointer in the global heap
JR Z,RENUM5 ; If Z flag is set, there is an exact match to the decoded line number on the heap
;
CALL TELL ; Display this error if the line number is not found
DB 'Failed at '
DB 0
LD HL,(LINENO)
CALL PBCDL
CALL CRLF
JR RENUM6 ; And carry on renumbering
;
; This snippet re-encodes the line number in the BASIC program
;
RENUM5: POP DE ; DE: Pointer to the encoded line number in the listing
PUSH DE
DEC DE ; Back up a byte to the LINO token
CALL ENCODE ; Re-write the new line number out
RENUM6: POP HL ; HL: Pointer to the encoded line number in the listing
POP BC ; BC: The remaining line length
JR RENUM7 ; Carry on checking for any more encoded line numbers in this line
;
; AUTO
; AUTO start,increment
; AUTO start
; AUTO ,increment
;
AUTO: CALL PAIR ; Get the parameter pair (HL: first parameter, BC: second parameter)
LD (AUTONO),HL ; Store the start in AUTONO
LD A,C ; Increment is 8 bit (0-255)
LD (INCREM),A ; Store that in INCREM
JR CLOOP0 ; Jump back indirectly to the command loop via CLOOP0 (optimisation for size)
;
; BAD
; NEW
;
BAD: CALL TELL ; Output "Bad program" error
DB 3 ; Token for "BAD"
DB 'program'
DB CR
DB LF
DB 0 ; Falls through to NEW
;
NEW: CALL NEWIT ; Call NEWIT (clears program area and variables)
JR CLOOP0 ; Jump back indirectly to the command loop via CLOOP0 (optimisation for size)
;
; OLD
;
OLD: LD HL,(PAGE_) ; HL: The start of the BASIC program area
PUSH HL ; Stack it
INC HL ; Skip the potential length byte of first line of code
INC HL ; And the line number word
INC HL
LD BC,252 ; Look for a CR in the first 252 bytes of code; maximum line length
LD A,CR
CPIR
JR NZ,BAD ; If not found, then the first line of code is not a valid BBC BASIC code
LD A,L ; It could still be garbage though! Store the position in A; this requires
POP HL ; PAGE to be on a 256 page boundary, and is now the length of the first line
LD (HL),A ; Restore the length byte (this will have been set to 0 by NEW)
CALL CLEAN ; Further checks for bad program, set TOP, write out &FFFF end of program marker
CLOOP0: JP CLOOP ; Jump back to the command loop
;
; LOAD filename
;
LOAD: CALL EXPRS ; Get the filename
LD A,CR ; DE points to the last byte of filename in ACCS
LD (DE),A ; Terminate filename with a CR
CALL LOAD0 ; Load the file in, then CLEAN
CALL CLEAR ; Further checks for bad program, set TOP, write out &FFFF end of program marker
JR WARM0 ; Jump back to the command loop
;
; SAVE filename
;
SAVE: CALL SETTOP ; Set TOP sysvar
CALL EXPRS ; Get the filename
LD A,CR ; Terminate the filename with a CR
LD (DE),A
LD DE,(PAGE_) ; DE: Start of program memory
LD HL,(TOP) ; HL: Top of program memory
OR A ; Calculate program size (TOP-PAGE)
SBC HL,DE
LD B,H ; BC: Length of program in bytes
LD C,L
LD HL,ACCS ; HL: Address of the filename
CALL OSSAVE ; Call the SAVE routine in patch.asm
WARM0: JP WARM ; Jump back to the command loop
;
; ERROR
; Called whenever BASIC needs to halt with an error
; Error messages are indexed from 0
; Inputs:
; A: Error number
;
ERROR_: LD SP,(HIMEM) ; Set SP to HIMEM
LD HL,ERRWDS ; Index into the error string table
OR A ; We don't need to search for the first error
JR Z,ERROR1 ; So skip the search routine
;
; Search the error table for error #A
; HL will end up being the pointer into the correct error
; There is no bounds checking on this, so invalid error numbers will probably output garbage
;
LD B,A ; Store error number in B
EX AF,AF' ; Store error number in AF'
XOR A
ERROR0: CP (HL) ; Compare the character with 0 (the terminator byte)
INC HL ; Increment the string pointer
JR NZ,ERROR0 ; Loop until with hit a 0
DJNZ ERROR0 ; Decrements the error number and loop until 0
EX AF,AF' ; Restore the error number from AF'
;
; At this point HL points to the tokenised error string
;
ERROR1: PUSH HL ; Stack the error string pointer and fall through to EXTERR
;
; EXTERR
; Inputs:
; A: Error number
;
; This is the entry point for external errors, i.e. ones not in the ERRWDS table
; The error text immediately follows the CALL to EXTERR, for example:
; > CALL EXTERR
; > DB "Silly", 0
; So we can get the address of the string by popping the return address off the stack
;
EXTERR: POP HL ; Pop the error string pointer
LD (ERRTXT),HL ; Store in ERRTXT sysvar
LD SP,(HIMEM) ; Set SP to HIMEM
LD (ERR),A ; Store error number in ERR sysvar
CALL SETLIN ; Get line number
LD (ERL),HL ; Store in ERL sysvar
OR A ; Is error number 0?
JR Z,ERROR2 ; Yes, so skip the next bit as error number 0 is untrappable
;
LD HL,(ERRTRP) ; Check whether the error is trapped
LD A,H
OR L
PUSH HL ; HL: Error line
POP IY ; IY: HL
JP NZ,XEQ ; If error trapped, jump to XEQ
;
ERROR2: LD HL,0
LD (AUTONO),HL ; Cancel AUTO
LD (TRACEN),HL ; Cancel TRACE
CALL RESET ; Reset OPSYS
CALL CRLF ; Output newline
CALL REPORT ; Output the error message
CALL SAYLN ; Output " at line nnnn" message.
LD E,0 ; Close all files
CALL C,OSSHUT
CALL CRLF ; Output newline
JP CLOOP ; Back to CLOOP
;
; SUBROUTINES:
;
; LEX - SEARCH FOR KEYWORDS
; Inputs: HL = start of keyword table
; IY = start of match text
; Outputs: If found, Z-flag set, A=token.
; If not found, Z-flag reset, A=(IY).
; IY updated (if NZ, IY unchanged).
; Destroys: A,B,H,L,IY,F
;
LEX: LD HL,KEYWDS ; Address of the keywords table
;
LEX0: LD A,(IY) ; Fetch the character to match
LD B,(HL) ; B: The token from the keywords table
INC HL ; Increment the pointer in the keywords table