forked from z80playground/cpm-fat
-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathtiny-basic.asm
2023 lines (1795 loc) · 83.5 KB
/
tiny-basic.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
; *************************************************************
;
; TINY BASIC FOR INTEL 8080
; VERSION 2.1
; BY LI-CHEN WANG
; MODIFIED AND TRANSLATED
; TO INTEL MNEMONICS
; BY ROGER RAUSKOLB
; 10 OCTOBER,1976
; @COPYLEFT
; ALL WRONGS RESERVED
;
; *************************************************************
; Converted to Z80 mneumonics
; and styled for PASMO assembler
; ready to run on my "Z80 Playground" SBC
; by John Squires, October 2020
; TODO:
; * Tell the user that ctrl-c is break, etc.
; * Make a nicer intro screen.
; *** ZERO PAGE SUBROUTINES ***
; The original code used the zero page calls, "rst 08h"
; thru "rst 38h" for some functions, in order to keep the
; code size even smaller. However, the use of the "RST" commands
; means that this program always has to run from location 0
; and can never be assembled to a different location.
; I decided to remove all the RST stuff, so that this code
; could eventually be run under CP/M or loaded at a different
; location in memory.
; How to assemble:
; Use PASMO
; This version is intended for inclusion in the Z80 Playground EEPROM as a demo
; of what wonders can be performed!
; So it will begin at whatever address the EEPROM boot loader sets it to.
; It will be living in the bottom 32K of EEROM, and have
; access to the top 32K of RAM.
CR equ 0DH
LF equ 0AH
; Define a macro called DWA to store addresses in a special format.
; Hi-byte is stored first (big-endian) with bit 7 set.
; Lo-byte is stored second, with no special modification.
DWA MACRO v
DB v>>8+128
DB v & 0FFH
ENDM
TBSTART:
LD SP,TBSTACK ; *** COLD START ***
LD A,0FFH
JP INIT
TSTC: EX (SP),HL ; *** TSTC (was "rst 08h") ***
CALL IGNBLK ; IGNORE BLANKS AND
CP (HL) ; TEST CHARACTER
TC1: INC HL ; COMPARE THE BYTE THAT
JP Z,TC2 ; FOLLOWS THE CALL to this function
PUSH BC ; WITH THE TEXT (DE->)
LD C,(HL) ; IF NOT =, ADD THE 2ND
LD B,0 ; BYTE THAT FOLLOWS THE
ADD HL,BC ; RST TO THE OLD PC
POP BC ; I.E., DO A RELATIVE
DEC DE ; JUMP IF NOT =
TC2: INC DE ; IF =, SKIP THOSE BYTES
INC HL ; AND CONTINUE
EX (SP),HL
RET
CRLF: LD A,CR ; *** CRLF ***
OUTC: PUSH AF ; *** OUTC (was "rst 10h") ***
LD A,(OCSW) ; PRINT CHARACTER ONLY
OR A ; IF OCSW SWITCH IS ON
OC2: JP NZ,OC3 ; IT IS ON
POP AF ; IT IS OFF
RET ; RESTORE AF AND RETURN
OC3:
in a,(uart_LSR) ; check UART is ready to send.
bit 5,a ; zero flag set to true if bit 5 is 0
jp z,OC3 ; zero = not ready for next char yet.
POP AF ; UART IS READY, GET OLD "A" BACK
OUT (uart_tx_rx),A ; AND SEND IT OUT
CP CR ; WAS IT CR?
RET NZ ; NO, FINISHED
OC4:
in a,(uart_LSR) ; check UART is ready to send.
bit 5,a ; zero flag set to true if bit 5 is 0
jp z,OC4 ; zero = not ready for next char yet.
LD A,LF ; YES, WE SEND LF TOO
out (uart_tx_rx),a
LD A,CR ; GET CR BACK IN A
RET
EXPR: CALL EXPR2 ; *** EXPR (was "rst 18h") ***
PUSH HL ; EVALUATE AN EXPRESSION
JP EXPR1 ; REST OF IT AT EXPR1
COMP: LD A,H ; *** COMP (was "rst 20h") ***
CP D ; COMPARE HL WITH DE
RET NZ ; RETURN CORRECT C AND
LD A,L ; Z FLAGS
CP E ; BUT OLD A IS LOST
RET
IGNBLK:
LD A,(DE) ; *** IGNBLK (was "rst 28h") ***
CP 20H ; IGNORE BLANKS
RET NZ ; IN TEXT (WHERE DE->)
INC DE ; AND RETURN THE FIRST
JP IGNBLK ; NON-BLANK CHAR. IN A
FINISH:
POP AF ; *** FINISH (was "rst 30h") ***
CALL FIN ; CHECK END OF COMMAND
JP QWHAT ; PRINT "WHAT?" IF WRONG
TSTV:
CALL IGNBLK ; *** TSTV (was "rst 38h") ***
SUB '@' ; TEST VARIABLES.
RET C ; < @ means NOT A VARIABLE
JP NZ,TV1 ; NOT "@" ARRAY
INC DE ; IT IS THE "@" ARRAY
CALL PARN ; @ SHOULD BE FOLLOWED
ADD HL,HL ; BY (EXPR) AS ITS INDEX
JP C,QHOW ; IS INDEX TOO BIG?
PUSH DE ; WILL IT OVERWRITE
EX DE,HL ; TEXT?
CALL SIZE ; FIND SIZE OF FREE
CALL COMP ; AND CHECK THAT
JP C,ASORRY ; IF SO, SAY "SORRY"
LD HL,VARBGN ; IF NOT GET ADDRESS
CALL SUBDE ; OF @(EXPR) AND PUT IT
POP DE ; IN HL
RET ; C FLAG IS CLEARED
TV1:
; by this point A holds the index
; of the variable
; 0 = the array "@"
; 1 - 26 = A - Z
; 33 - 58 = a - z
; lowercase needs adjusting to be uppercase
cp 33
jr c,upper_var
cp 59
jr nc,upper_var
sub 32 ; lowercase it
upper_var:
CP 1BH ; NOT @, IS IT A TO Z?
CCF ; IF NOT RETURN C FLAG
RET C
INC DE ; IF A THROUGH Z
LD HL,VARBGN ; COMPUTE ADDRESS OF
RLCA ; THAT VARIABLE
ADD A,L ; AND RETURN IT IN HL
LD L,A ; WITH C FLAG CLEARED
LD A,0
ADC A,H
LD H,A
RET
TSTNUM: LD HL,0 ; *** TSTNUM ***
LD B,H ; TEST IF THE TEXT IS
CALL IGNBLK ; A NUMBER
TN1: CP 30H ; IF NOT, RETURN 0 IN
RET C ; B AND HL
CP 3AH ; IF NUMBERS, CONVERT
RET NC ; TO BINARY IN HL AND
LD A,0F0H ; SET B TO # OF DIGITS
AND H ; IF H>255, THERE IS NO
JP NZ,QHOW ; ROOM FOR NEXT DIGIT
INC B ; B COUNTS # OF DIGITS
PUSH BC
LD B,H ; HL=10*HL+(NEW DIGIT)
LD C,L
ADD HL,HL ; WHERE 10* IS DONE BY
ADD HL,HL ; SHIFT AND ADD
ADD HL,BC
ADD HL,HL
LD A,(DE) ; AND (DIGIT) IS FROM
INC DE ; STRIPPING THE ASCII
AND 0FH ; CODE
ADD A,L
LD L,A
LD A,0
ADC A,H
LD H,A
POP BC
LD A,(DE) ; DO THIS DIGIT AFTER
JP P,TN1 ; DIGIT. S SAYS OVERFLOW
QHOW: PUSH DE ; *** ERROR "HOW?" ***
AHOW: LD DE,HOW
JP ERROR
HOW: DB 'HOW?'
DB CR
OK: DB 'OK'
DB CR
WHAT: DB 'WHAT?'
DB CR
SORRY: DB 'SORRY'
DB CR
; *************************************************************
; *** MAIN ***
; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
; AND STORES IT IN THE MEMORY.
; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO
; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE
; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF
; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED
; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM
; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE
; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT".
; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS
; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN
; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0.
RSTART: LD SP,TBSTACK
ST1: CALL CRLF ; AND JUMP TO HERE
LD DE,OK ; DE->STRING
SUB A ; A=0
CALL PRTSTG ; PRINT STRING UNTIL CR
LD HL,ST2+1 ; LITERAL 0
LD (CURRNT),HL ; CURRENT->LINE # = 0
ST2: LD HL,0
LD (LOPVAR),HL
LD (STKGOS),HL
ST3: LD A,3EH ; PROMPT '>' AND
CALL GETLN ; READ A LINE
PUSH DE ; DE->END OF LINE
LD DE,BUFFER ; DE->BEGINNING OF LINE
CALL TSTNUM ; TEST IF IT IS A NUMBER
CALL IGNBLK
LD A,H ; HL=VALUE OF THE # OR
OR L ; 0 IF NO # WAS FOUND
POP BC ; BC->END OF LINE
JP Z,DIRECT
DEC DE ; BACKUP DE AND SAVE
LD A,H ; VALUE OF LINE # THERE
LD (DE),A
DEC DE
LD A,L
LD (DE),A
PUSH BC ; BC,DE->BEGIN, END
PUSH DE
LD A,C
SUB E
PUSH AF ; A=# OF BYTES IN LINE
CALL FNDLN ; FIND THIS LINE IN SAVE
PUSH DE ; AREA, DE->SAVE AREA
JP NZ,ST4 ; NZ:NOT FOUND, INSERT
PUSH DE ; Z:FOUND, DELETE IT
CALL FNDNXT ; FIND NEXT LINE
; DE->NEXT LINE
POP BC ; BC->LINE TO BE DELETED
LD HL,(TXTUNF) ; HL->UNFILLED SAVE AREA
CALL MVUP ; MOVE UP TO DELETE
LD H,B ; TXTUNF->UNFILLED AREA
LD L,C
LD (TXTUNF),HL ; UPDATE
ST4: POP BC ; GET READY TO INSERT
LD HL,(TXTUNF) ; BUT FIRST CHECK IF
POP AF ; THE LENGTH OF NEW LINE
PUSH HL ; IS 3 (LINE # AND CR)
CP 3 ; THEN DO NOT INSERT
JP Z,RSTART ; MUST CLEAR THE STACK
ADD A,L ; COMPUTE NEW TXTUNF
LD L,A
LD A,0
ADC A,H
LD H,A ; HL->NEW UNFILLED AREA
LD DE,TXTEND ; CHECK TO SEE IF THERE
CALL COMP ; IS ENOUGH SPACE
JP NC,QSORRY ; SORRY, NO ROOM FOR IT
LD (TXTUNF),HL ; OK, UPDATE TXTUNF
POP DE ; DE->OLD UNFILLED AREA
CALL MVDOWN
POP DE ; DE->BEGIN, HL->END
POP HL
CALL MVUP ; MOVE NEW LINE TO SAVE
JP ST3 ; AREA
; *************************************************************
; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE
; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST
; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS
; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS:
; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART'
; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE
; GO BACK TO 'RSTART'.
; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE
; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.)
; *************************************************************
; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO ***
; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
; 'STOP(CR)' GOES BACK TO 'RSTART'
; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE
; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
; THERE ARE 3 MORE ENTRIES IN 'RUN':
; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET
; LINE, AND JUMP TO 'RUNTSL' TO DO IT.
NEW: CALL ENDCHK ; *** NEW(CR) ***
LD HL,TXTBGN
LD (TXTUNF),HL
STOP: CALL ENDCHK ; *** STOP(CR) ***
JP RSTART
TBDIR: ; *** DIR(CR) ***
; This does a directory listing.
call ENDCHK
; Clear files counter
xor a
ld (tb_dir_count), a
; Open /TBASIC folder
ld hl, TINY_BASIC_FOLDER_NAME
call open_file
; Then open *
ld hl, STAR_DOT_STAR
call open_file
; Loop through, printing the file names, one per line
tb_dir_loop:
cp USB_INT_DISK_READ
jr z, tbasic_dir_loop_good
ld a, (tb_dir_count)
cp 0
jp nz, RSTART
call message
db 'No files found.',13,10,0
jp RSTART
tbasic_dir_loop_good:
ld a, RD_USB_DATA0
call send_command_byte
call read_data_byte ; Find out how many bytes there are to read
call read_data_bytes_into_buffer ; read them into disk_buffer
cp 32 ; Did we read at least 32 bytes?
jr nc, tb_dir_good_length
tb_dir_next:
ld a, FILE_ENUM_GO ; Go to next entry in the directory
call send_command_byte
call read_status_byte
jp tb_dir_loop
tb_dir_good_length:
ld a, (disk_buffer+11)
and $16 ; Check for hidden or system files, or directories
jp nz, tb_dir_next ; and skip accordingly.
tb_it_is_not_system:
ld hl, tb_dir_count
inc (hl)
; Show filename from diskbuffer
ld b, 8
ld hl, disk_buffer
tb_dir_show_name_loop:
ld a, (hl)
call print_a
inc hl
djnz tb_dir_show_name_loop
ld a, '.'
call print_a
ld b, 3
tb_dir_show_extension_loop:
ld a, (hl)
call print_a
inc hl
djnz tb_dir_show_extension_loop
call newline
jp tb_dir_next
SAVE: ; *** SAVE "filename" ***
; This Saves the current program to USB Drive with the given name.
push de
call get_program_size
pop de
ld a, h
or l
cp 0
jr nz, save_continue
call message
db 'No program yet to save!',13,10,0
jp RSTART
save_continue:
call READ_QUOTED_FILENAME
call does_file_exist
call z, tb_erase_file
call close_file
;call message
;db 'Creating file...',13,10,0
ld hl, TINY_BASIC_FOLDER_NAME
call open_file
ld de, filename_buffer
call create_file
jr z, tb_save_continue
call message
db 'Could not create file.',13,10,0
jp RSTART
get_program_size:
; Gets the total size of the program, in bytes, into hl
ld de,TXTBGN
ld hl, (TXTUNF)
or a
sbc hl, de
ret
tb_save_continue:
ld a, BYTE_WRITE
call send_command_byte
; Send number of bytes we are about to write, as 16 bit number, low first
call get_program_size
ld a, l
call send_data_byte
ld a, h
call send_data_byte
ld hl, TXTBGN
call write_loop
call close_file
jp RSTART
LOAD: ; *** LOAD "filename" ***
; This Loads a program from USB Drive
call READ_QUOTED_FILENAME
call does_file_exist
jr z, load_can_do
tb_file_not_found
call message
db 'File not found.',13,10,0
jp RSTART
load_can_do:
ld hl, TINY_BASIC_FOLDER_NAME
call open_file
ld hl, filename_buffer
call open_file
ld a, BYTE_READ
call send_command_byte
ld a, 255 ; Request all of the file
call send_data_byte
ld a, 255 ; Yes, all!
call send_data_byte
ld a, GET_STATUS
call send_command_byte
call read_data_byte
ld hl, TXTBGN ; Get back the target address
tb_load_loop1:
cp USB_INT_DISK_READ
jr nz, tb_load_finished
push hl
call disk_on
ld a, RD_USB_DATA0
call send_command_byte
call read_data_byte
pop hl
call read_data_bytes_into_hl
push hl
call disk_off
ld a, BYTE_RD_GO
call send_command_byte
ld a, GET_STATUS
call send_command_byte
call read_data_byte
pop hl
jp tb_load_loop1
tb_load_finished:
ld (TXTUNF), hl
call close_file
jp RSTART
ERASE: ; *** ERASE "filename" ***
; This erases a file
call READ_QUOTED_FILENAME
call does_file_exist
jr nz, tb_file_not_found
call tb_erase_file
jp RSTART
EXIT: ; When tinybasic is launched it is called
; from the monitor.
;
; So we know the ROM is mapped.
;
; We could preserve the stack and merely RET
; but instead we'll just jump to the 0x0000
; address.
jp 0x0000
tb_erase_file:
;call message
;db 'Erasing file...',13,10,0
ld a, SET_FILE_NAME
call send_command_byte
ld hl, filename_buffer
call send_data_string
ld a, FILE_ERASE
call send_command_byte
call read_status_byte
ret
does_file_exist:
; Looks on disk for a file. Returns Z if file exists.
ld hl, TINY_BASIC_FOLDER_NAME
call open_file
ld hl, filename_buffer
jp open_file
RUN: CALL ENDCHK ; *** RUN(CR) ***
LD DE,TXTBGN ; FIRST SAVED LINE
RUNNXL: LD HL,0 ; *** RUNNXL ***
CALL FNDLP ; FIND WHATEVER LINE #
JP C,RSTART ; C:PASSED TXTUNF, QUIT
RUNTSL: EX DE,HL ; *** RUNTSL ***
LD (CURRNT),HL ; SET 'CURRENT'->LINE #
EX DE,HL
INC DE ; BUMP PASS LINE #
INC DE
RUNSML: CALL CHKIO ; *** RUNSML ***
LD HL,TAB2-1 ; FIND COMMAND IN TAB2
JP EXEC ; AND EXECUTE IT
GOTO: CALL EXPR ; *** GOTO EXPR ***
PUSH DE ; SAVE FOR ERROR ROUTINE
CALL ENDCHK ; MUST FIND A CR
CALL FNDLN ; FIND THE TARGET LINE
JP NZ,AHOW ; NO SUCH LINE #
POP AF ; CLEAR THE PUSH DE
JP RUNTSL ; GO DO IT
; *************************************************************
; *** LIST *** & PRINT ***
; LIST HAS TWO FORMS:
; 'LIST(CR)' LISTS ALL SAVED LINES
; 'LIST #(CR)' START LIST AT THIS LINE #
; YOU CAN STOP THE LISTING BY CONTROL C KEY
; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK-
; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS
; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS
; SPECIFIED, 6 POSITIONS WILL BE USED.
; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
; DOUBLE QUOTES.
; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
; A $ means print an ascii character, so 'PRINT $72,$107' will print "Hi"
; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST
; ENDED WITH A COMMA, NO (CRLF) IS GENERATED.
LIST: CALL TSTNUM ; TEST IF THERE IS A #
CALL ENDCHK ; IF NO # WE GET A 0
CALL FNDLN ; FIND THIS OR NEXT LINE
LS1: JP C,RSTART ; C:PASSED TXTUNF
CALL PRTLN ; PRINT THE LINE
CALL CHKIO ; STOP IF HIT CONTROL-C
CALL FNDLP ; FIND NEXT LINE
JP LS1 ; AND LOOP BACK
PRINT: LD C,6 ; C = # OF SPACES
CALL TSTC ; Test for ";"
DB 3BH
DB PR2-$-1
CALL CRLF ; GIVE CR-LF AND
JP RUNSML ; CONTINUE SAME LINE
PR2: CALL TSTC ; Test for (CR)
DB CR
DB PR0-$-1
CALL CRLF ; ALSO GIVE CR-LF AND
JP RUNNXL ; GO TO NEXT LINE
PR0: CALL TSTC ; ELSE IS IT FORMAT? e.g. #4 = format 4 digits long
DB '#'
DB PR1-$-1
CALL EXPR ; YES, EVALUATE EXPR.
LD C,L ; AND SAVE IT IN C
JP PR3 ; LOOK FOR MORE TO PRINT
PR1: CALL TSTC ; Is it a "$"? e.g. $65 will print 'A'
DB '$'
DB PRNOTDOLLAR-$-1
CALL EXPR ; Evaluate the expression, which will result in an 16 bit number in hl
ld a, h ; If hl > 255 show error
or a
jr nz, PR_ERROR
ld a, l ; Get just bottom 8 bits
cp 32
jr c, PR_ERROR
cp 127
jr c, PR_ASCII
PR_ERROR:
ld a, '*'
PR_ASCII:
CALL OUTC
jp PR3 ; Look for more to print
PRNOTDOLLAR:
CALL QTSTG ; OR IS IT A STRING?
JP PR8 ; IF NOT, MUST BE EXPR.
PR3: CALL TSTC ; IF ",", GO FIND NEXT
DB ','
DB PR6-$-1
CALL FIN ; IN THE LIST.
JP PR0 ; LIST CONTINUES
PR6: CALL CRLF ; LIST ENDS
CALL FINISH
PR8: CALL EXPR ; EVALUATE THE EXPR
PUSH BC
CALL PRTNUM ; PRINT THE VALUE
POP BC
JP PR3 ; MORE TO PRINT?
; *************************************************************
; *** GOSUB *** & RETURN ***
; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'
; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
; SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED
; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
; THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS
; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS'
; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS
; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT
; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE
; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
GOSUB: CALL PUSHA ; SAVE THE CURRENT "FOR"
CALL EXPR ; PARAMETERS
PUSH DE ; AND TEXT POINTER
CALL FNDLN ; FIND THE TARGET LINE
JP NZ,AHOW ; NOT THERE. SAY "HOW?"
LD HL,(CURRNT) ; FOUND IT, SAVE OLD
PUSH HL ; 'CURRNT' OLD 'STKGOS'
LD HL,(STKGOS)
PUSH HL
LD HL,0 ; AND LOAD NEW ONES
LD (LOPVAR),HL
ADD HL,SP
LD (STKGOS),HL
JP RUNTSL ; THEN RUN THAT LINE
RETURN: CALL ENDCHK ; THERE MUST BE A CR
LD HL,(STKGOS) ; OLD STACK POINTER
LD A,H ; 0 MEANS NOT EXIST
OR L
JP Z,QWHAT ; SO, WE SAY: "WHAT?"
LD SP,HL ; ELSE, RESTORE IT
POP HL
LD (STKGOS),HL ; AND THE OLD 'STKGOS'
POP HL
LD (CURRNT),HL ; AND THE OLD 'CURRNT'
POP DE ; OLD TEXT POINTER
CALL POPA ; OLD "FOR" PARAMETERS
CALL FINISH ; AND WE ARE BACK HOME
; *************************************************************
; *** FOR *** & NEXT ***
; 'FOR' HAS TWO FORMS:
; 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND 'FOR VAR=EXP1 TO EXP2'
; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
; EXP3=1. (I.E., WITH A STEP OF +1.)
; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE
; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3
; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN
; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME-
; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
; BEFORE THE NEW ONE OVERWRITES IT.
; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME
; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
; IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED.
; (PURGED FROM THE STACK..)
; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED
; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN
; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT
; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO
; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT
; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA
; IS PURGED AND EXECUTION CONTINUES.
FOR: CALL PUSHA ; SAVE THE OLD SAVE AREA
CALL SETVAL ; SET THE CONTROL VAR.
DEC HL ; HL IS ITS ADDRESS
LD (LOPVAR),HL ; SAVE THAT
LD HL,TAB5-1 ; USE 'EXEC' TO LOOK
JP EXEC ; FOR THE WORD 'TO'
FR1: CALL EXPR ; EVALUATE THE LIMIT
LD (LOPLMT),HL ; SAVE THAT
LD HL,TAB6-1 ; USE 'EXEC' TO LOOK
JP EXEC ; FOR THE WORD 'STEP'
FR2: CALL EXPR ; FOUND IT, GET STEP
JP FR4
FR3: LD HL,1H ; NOT FOUND, SET TO 1
FR4: LD (LOPINC),HL ; SAVE THAT TOO
FR5: LD HL,(CURRNT) ; SAVE CURRENT LINE #
LD (LOPLN),HL
EX DE,HL ; AND TEXT POINTER
LD (LOPPT),HL
LD BC,0AH ; DIG INTO STACK TO
LD HL,(LOPVAR) ; FIND 'LOPVAR'
EX DE,HL
LD H,B
LD L,B ; HL=0 NOW
ADD HL,SP ; HERE IS THE STACK
DB 3EH
FR7: ADD HL,BC ; EACH LEVEL IS 10 DEEP
LD A,(HL) ; GET THAT OLD 'LOPVAR'
INC HL
OR (HL)
JP Z,FR8 ; 0 SAYS NO MORE IN IT
LD A,(HL)
DEC HL
CP D ; SAME AS THIS ONE?
JP NZ,FR7
LD A,(HL) ; THE OTHER HALF?
CP E
JP NZ,FR7
EX DE,HL ; YES, FOUND ONE
LD HL,0H
ADD HL,SP ; TRY TO MOVE SP
LD B,H
LD C,L
LD HL,0AH
ADD HL,DE
CALL MVDOWN ; AND PURGE 10 WORDS
LD SP,HL ; IN THE STACK
FR8: LD HL,(LOPPT) ; JOB DONE, RESTORE DE
EX DE,HL
CALL FINISH ; AND CONTINUE
NEXT: CALL TSTV ; GET ADDRESS OF VAR.
JP C,QWHAT ; NO VARIABLE, "WHAT?"
LD (VARNXT),HL ; YES, SAVE IT
NX0: PUSH DE ; SAVE TEXT POINTER
EX DE,HL
LD HL,(LOPVAR) ; GET VAR. IN 'FOR'
LD A,H
OR L ; 0 SAYS NEVER HAD ONE
JP Z,AWHAT ; SO WE ASK: "WHAT?"
CALL COMP ; ELSE WE CHECK THEM
JP Z,NX3 ; OK, THEY AGREE
POP DE ; NO, LET'S SEE
CALL POPA ; PURGE CURRENT LOOP
LD HL,(VARNXT) ; AND POP ONE LEVEL
JP NX0 ; GO CHECK AGAIN
NX3: LD E,(HL) ; COME HERE WHEN AGREED
INC HL
LD D,(HL) ; DE=VALUE OF VAR.
LD HL,(LOPINC)
PUSH HL
LD A,H
XOR D
LD A,D
ADD HL,DE ; ADD ONE STEP
JP M,NX4
XOR H
JP M,NX5
NX4: EX DE,HL
LD HL,(LOPVAR) ; PUT IT BACK
LD (HL),E
INC HL
LD (HL),D
LD HL,(LOPLMT) ; HL->LIMIT
POP AF ; OLD HL
OR A
JP P,NX1 ; STEP > 0
EX DE,HL ; STEP < 0
NX1: CALL CKHLDE ; COMPARE WITH LIMIT
POP DE ; RESTORE TEXT POINTER
JP C,NX2 ; OUTSIDE LIMIT
LD HL,(LOPLN) ; WITHIN LIMIT, GO
LD (CURRNT),HL ; BACK TO THE SAVED
LD HL,(LOPPT) ; 'CURRNT' AND TEXT
EX DE,HL ; POINTER
CALL FINISH
NX5: POP HL
POP DE
NX2: CALL POPA ; PURGE THIS LOOP
CALL FINISH
; *************************************************************
; *** REM *** IF *** INPUT *** & LET (& DEFLT) ***
; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS.
; NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE
; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE
; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
; EXECUTION CONTINUES AT THE NEXT LINE.
; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR
; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN
; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE
; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING
; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR.
; AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
; THIS IS HANDLED IN 'INPERR'.
; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE.
; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
; THIS IS DONE BY 'DEFLT'.
REM: LD HL,0H ; *** REM ***
DB 3EH ; THIS IS LIKE 'IF 0'
IFF: CALL EXPR ; *** IF ***
LD A,H ; IS THE EXPR.=0?
OR L
JP NZ,RUNSML ; NO, CONTINUE
CALL FNDSKP ; YES, SKIP REST OF LINE
JP NC,RUNTSL ; AND RUN THE NEXT LINE
JP RSTART ; IF NO NEXT, RE-START
INPERR: LD HL,(STKINP) ; *** INPERR ***
LD SP,HL ; RESTORE OLD SP
POP HL ; AND OLD 'CURRNT'
LD (CURRNT),HL
POP DE ; AND OLD TEXT POINTER
POP DE ; REDO INPUT
INPUT: ; *** INPUT ***
IP1: PUSH DE ; SAVE IN CASE OF ERROR
CALL QTSTG ; IS NEXT ITEM A STRING?
JP IP2 ; NO
CALL TSTV ; YES, BUT FOLLOWED BY A
JP C,IP4 ; VARIABLE? NO.
JP IP3 ; YES. INPUT VARIABLE
IP2: PUSH DE ; SAVE FOR 'PRTSTG'
CALL TSTV ; MUST BE VARIABLE NOW
JP C,QWHAT ; "WHAT?" IT IS NOT?
LD A,(DE) ; GET READY FOR 'PRTSTR'
LD C,A
SUB A
LD (DE),A
POP DE
CALL PRTSTG ; PRINT STRING AS PROMPT
LD A,C ; RESTORE TEXT
DEC DE
LD (DE),A
IP3: PUSH DE ; SAVE TEXT POINTER
EX DE,HL
LD HL,(CURRNT) ; ALSO SAVE 'CURRNT'
PUSH HL
LD HL,IP1 ; A NEGATIVE NUMBER
LD (CURRNT),HL ; AS A FLAG
LD HL,0H ; SAVE SP TOO
ADD HL,SP
LD (STKINP),HL
PUSH DE ; OLD HL
LD A,3AH ; PRINT THIS TOO
CALL GETLN ; AND GET A LINE
LD DE,BUFFER ; POINTS TO BUFFER
CALL EXPR ; EVALUATE INPUT
NOP ; CAN BE 'CALL ENDCHK'
NOP
NOP
POP DE ; OK, GET OLD HL
EX DE,HL
LD (HL),E ; SAVE VALUE IN VAR.
INC HL
LD (HL),D
POP HL ; GET OLD 'CURRNT'
LD (CURRNT),HL
POP DE ; AND OLD TEXT POINTER
IP4: POP AF ; PURGE JUNK IN STACK
CALL TSTC ; IS NEXT CH. ','?
DB ','
DB IP5-$-1
JP IP1 ; YES, MORE ITEMS.
IP5: CALL FINISH
DEFLT: LD A,(DE) ; *** DEFLT ***
CP CR ; EMPTY LINE IS OK
JP Z,LT1 ; ELSE IT IS 'LET'
LET: CALL SETVAL ; *** LET ***
CALL TSTC ; SET VALUE TO VAR.
DB ','
DB LT1-$-1
JP LET ; ITEM BY ITEM
LT1: CALL FINISH ; UNTIL FINISH
; *************************************************************
; *** EXPR ***
; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
; <EXPR>::<EXPR2>
; <EXPR2><REL.OP.><EXPR2>
; WHERE <REL.OP.> IS ONE OF THE OPERATORS IN TAB8 AND THE
; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
; <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....)
; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
; <EXPR3>::=<EXPR4>(* OR /><EXPR4>)(....)
; <EXPR4>::=<VARIABLE>
; <FUNCTION>
; (<EXPR>)
; <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
; AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
; <EXPR4> CAN BE AN <EXPR> IN PARANTHESE.
EXPR1: LD HL,TAB8-1 ; LOOKUP REL.OP.
JP EXEC ; GO DO IT
XP11: CALL XP18 ; REL.OP.">="
RET C ; NO, RETURN HL=0
LD L,A ; YES, RETURN HL=1