/
string.s
786 lines (753 loc) · 18.8 KB
/
string.s
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
.segment "CODE"
; ----------------------------------------------------------------------------
; "STR$" FUNCTION
; ----------------------------------------------------------------------------
STR:
jsr CHKNUM
ldy #$00
jsr FOUT1
pla
pla
LD353:
lda #<(STACK2-1)
ldy #>(STACK2-1)
.if STACK2 > $0100
bne STRLIT
.else
beq STRLIT
.endif
; ----------------------------------------------------------------------------
; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
; ADDRESS IS IN FAC+3,4 AND WHOSE LENGTH IS IN A-REG
; ----------------------------------------------------------------------------
STRINI:
ldx FAC_LAST-1
ldy FAC_LAST
stx DSCPTR
sty DSCPTR+1
; ----------------------------------------------------------------------------
; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
; ADDRESS IS IN Y,X AND WHOSE LENGTH IS IN A-REG
; ----------------------------------------------------------------------------
STRSPA:
jsr GETSPA
stx FAC+1
sty FAC+2
sta FAC
rts
; ----------------------------------------------------------------------------
; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
; AND TERMINATED BY $00 OR QUOTATION MARK
; RETURN WITH DESCRIPTOR IN A TEMPORARY
; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
; ----------------------------------------------------------------------------
STRLIT:
ldx #$22
stx CHARAC
stx ENDCHR
; ----------------------------------------------------------------------------
; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
; AND TERMINATED BY $00, (CHARAC), OR (ENDCHR)
;
; RETURN WITH DESCRIPTOR IN A TEMPORARY
; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
; ----------------------------------------------------------------------------
STRLT2:
sta STRNG1
sty STRNG1+1
sta FAC+1
sty FAC+2
ldy #$FF
L3298:
iny
lda (STRNG1),y
beq L32A9
cmp CHARAC
beq L32A5
cmp ENDCHR
bne L3298
L32A5:
cmp #$22
beq L32AA
L32A9:
clc
L32AA:
sty FAC
tya
adc STRNG1
sta STRNG2
ldx STRNG1+1
bcc L32B6
inx
L32B6:
stx STRNG2+1
lda STRNG1+1
.ifdef CONFIG_NO_INPUTBUFFER_ZP
beq LD399
cmp #>INPUTBUFFER
.elseif .def(AIM65)
beq LD399
cmp #$01
.endif
bne PUTNEW
LD399:
tya
jsr STRINI
ldx STRNG1
ldy STRNG1+1
jsr MOVSTR
; ----------------------------------------------------------------------------
; STORE DESCRIPTOR IN TEMPORARY DESCRIPTOR STACK
;
; THE DESCRIPTOR IS NOW IN FAC, FAC+1, FAC+2
; PUT ADDRESS OF TEMP DESCRIPTOR IN FAC+3,4
; ----------------------------------------------------------------------------
PUTNEW:
ldx TEMPPT
cpx #TEMPST+9
bne PUTEMP
ldx #ERR_FRMCPX
JERR:
jmp ERROR
PUTEMP:
lda FAC
sta 0,x
lda FAC+1
sta 1,x
lda FAC+2
sta 2,x
ldy #$00
stx FAC_LAST-1
sty FAC_LAST
.ifdef CONFIG_2
sty FACEXTENSION
.endif
dey
sty VALTYP
stx LASTPT
inx
inx
inx
stx TEMPPT
rts
; ----------------------------------------------------------------------------
; MAKE SPACE FOR STRING AT BOTTOM OF STRING SPACE
; (A)=# BYTES SPACE TO MAKE
;
; RETURN WITH (A) SAME,
; AND Y,X = ADDRESS OF SPACE ALLOCATED
; ----------------------------------------------------------------------------
GETSPA:
lsr DATAFLG
L32F1:
pha
eor #$FF
sec
adc FRETOP
ldy FRETOP+1
bcs L32FC
dey
L32FC:
cpy STREND+1
bcc L3311
bne L3306
cmp STREND
bcc L3311
L3306:
sta FRETOP
sty FRETOP+1
sta FRESPC
sty FRESPC+1
tax
pla
rts
L3311:
ldx #ERR_MEMFULL
lda DATAFLG
bmi JERR
jsr GARBAG
lda #$80
sta DATAFLG
pla
bne L32F1
; ----------------------------------------------------------------------------
; SHOVE ALL REFERENCED STRINGS AS HIGH AS POSSIBLE
; IN MEMORY (AGAINST HIMEM), FREEING UP SPACE
; BELOW STRING AREA DOWN TO STREND.
; ----------------------------------------------------------------------------
GARBAG:
.ifdef CONST_MEMSIZ
ldx #<CONST_MEMSIZ
lda #>CONST_MEMSIZ
.else
ldx MEMSIZ
lda MEMSIZ+1
.endif
FINDHIGHESTSTRING:
stx FRETOP
sta FRETOP+1
ldy #$00
sty FNCNAM+1
.ifdef CONFIG_2
sty FNCNAM ; GC bugfix!
.endif
lda STREND
ldx STREND+1
sta LOWTR
stx LOWTR+1
lda #TEMPST
ldx #$00
sta INDEX
stx INDEX+1
L333D:
cmp TEMPPT
beq L3346
jsr CHECK_VARIABLE
beq L333D
L3346:
lda #BYTES_PER_VARIABLE
sta DSCLEN
lda VARTAB
ldx VARTAB+1
sta INDEX
stx INDEX+1
L3352:
cpx ARYTAB+1
bne L335A
cmp ARYTAB
beq L335F
L335A:
jsr CHECK_SIMPLE_VARIABLE
beq L3352
L335F:
sta HIGHDS
stx HIGHDS+1
lda #$03 ; OSI GC bugfix -> $04 ???
sta DSCLEN
L3367:
lda HIGHDS
ldx HIGHDS+1
L336B:
cpx STREND+1
bne L3376
cmp STREND
bne L3376
jmp MOVE_HIGHEST_STRING_TO_TOP
L3376:
sta INDEX
stx INDEX+1
.ifdef CONFIG_SMALL
ldy #$01
.else
ldy #$00
lda (INDEX),y
tax
iny
.endif
lda (INDEX),y
php
iny
lda (INDEX),y
adc HIGHDS
sta HIGHDS
iny
lda (INDEX),y
adc HIGHDS+1
sta HIGHDS+1
plp
bpl L3367
.ifndef CONFIG_SMALL
txa
bmi L3367
.endif
iny
lda (INDEX),y
.ifdef CONFIG_CBM1_PATCHES
jsr LE7F3 ; XXX patch, call into screen editor
.else
.ifdef CONFIG_11
ldy #$00 ; GC bugfix
.endif
asl a
adc #$05
.endif
adc INDEX
sta INDEX
bcc L33A7
inc INDEX+1
L33A7:
ldx INDEX+1
L33A9:
cpx HIGHDS+1
bne L33B1
cmp HIGHDS
beq L336B
L33B1:
jsr CHECK_VARIABLE
beq L33A9
; ----------------------------------------------------------------------------
; PROCESS A SIMPLE VARIABLE
; ----------------------------------------------------------------------------
CHECK_SIMPLE_VARIABLE:
.ifndef CONFIG_SMALL
lda (INDEX),y
bmi CHECK_BUMP
.endif
iny
lda (INDEX),y
bpl CHECK_BUMP
iny
; ----------------------------------------------------------------------------
; IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST
; ----------------------------------------------------------------------------
CHECK_VARIABLE:
lda (INDEX),y
beq CHECK_BUMP
iny
lda (INDEX),y
tax
iny
lda (INDEX),y
cmp FRETOP+1
bcc L33D5
bne CHECK_BUMP
cpx FRETOP
bcs CHECK_BUMP
L33D5:
cmp LOWTR+1
bcc CHECK_BUMP
bne L33DF
cpx LOWTR
bcc CHECK_BUMP
L33DF:
stx LOWTR
sta LOWTR+1
lda INDEX
ldx INDEX+1
sta FNCNAM
stx FNCNAM+1
lda DSCLEN
sta Z52
; ----------------------------------------------------------------------------
; ADD (DSCLEN) TO PNTR IN INDEX
; RETURN WITH Y=0, PNTR ALSO IN X,A
; ----------------------------------------------------------------------------
CHECK_BUMP:
lda DSCLEN
clc
adc INDEX
sta INDEX
bcc L33FA
inc INDEX+1
L33FA:
ldx INDEX+1
ldy #$00
rts
; ----------------------------------------------------------------------------
; FOUND HIGHEST NON-EMPTY STRING, SO MOVE IT
; TO TOP AND GO BACK FOR ANOTHER
; ----------------------------------------------------------------------------
MOVE_HIGHEST_STRING_TO_TOP:
.ifdef CONFIG_2
lda FNCNAM+1 ; GC bugfix
ora FNCNAM
.else
ldx FNCNAM+1
.endif
beq L33FA
lda Z52
.ifndef CONFIG_10A
sbc #$03
.else
and #$04
.endif
lsr a
tay
sta Z52
lda (FNCNAM),y
adc LOWTR
sta HIGHTR
lda LOWTR+1
adc #$00
sta HIGHTR+1
lda FRETOP
ldx FRETOP+1
sta HIGHDS
stx HIGHDS+1
jsr BLTU2
ldy Z52
iny
lda HIGHDS
sta (FNCNAM),y
tax
inc HIGHDS+1
lda HIGHDS+1
iny
sta (FNCNAM),y
jmp FINDHIGHESTSTRING
; ----------------------------------------------------------------------------
; CONCATENATE TWO STRINGS
; ----------------------------------------------------------------------------
CAT:
lda FAC_LAST
pha
lda FAC_LAST-1
pha
jsr FRM_ELEMENT
jsr CHKSTR
pla
sta STRNG1
pla
sta STRNG1+1
ldy #$00
lda (STRNG1),y
clc
adc (FAC_LAST-1),y
bcc L3454
ldx #ERR_STRLONG
jmp ERROR
L3454:
jsr STRINI
jsr MOVINS
lda DSCPTR
ldy DSCPTR+1
jsr FRETMP
jsr MOVSTR1
lda STRNG1
ldy STRNG1+1
jsr FRETMP
jsr PUTNEW
jmp FRMEVL2
; ----------------------------------------------------------------------------
; GET STRING DESCRIPTOR POINTED AT BY (STRNG1)
; AND MOVE DESCRIBED STRING TO (FRESPC)
; ----------------------------------------------------------------------------
MOVINS:
ldy #$00
lda (STRNG1),y
pha
iny
lda (STRNG1),y
tax
iny
lda (STRNG1),y
tay
pla
; ----------------------------------------------------------------------------
; MOVE STRING AT (Y,X) WITH LENGTH (A)
; TO DESTINATION WHOSE ADDRESS IS IN FRESPC,FRESPC+1
; ----------------------------------------------------------------------------
MOVSTR:
stx INDEX
sty INDEX+1
MOVSTR1:
tay
beq L3490
pha
L3487:
dey
lda (INDEX),y
sta (FRESPC),y
tya
bne L3487
pla
L3490:
clc
adc FRESPC
sta FRESPC
bcc L3499
inc FRESPC+1
L3499:
rts
; ----------------------------------------------------------------------------
; IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR
; ----------------------------------------------------------------------------
FRESTR:
jsr CHKSTR
; ----------------------------------------------------------------------------
; IF STRING DESCRIPTOR POINTED TO BY FAC+3,4 IS
; A TEMPORARY STRING, RELEASE IT.
; ----------------------------------------------------------------------------
FREFAC:
lda FAC_LAST-1
ldy FAC_LAST
; ----------------------------------------------------------------------------
; IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS
; A TEMPORARY STRING, RELEASE IT.
; ----------------------------------------------------------------------------
FRETMP:
sta INDEX
sty INDEX+1
jsr FRETMS
php
ldy #$00
lda (INDEX),y
pha
iny
lda (INDEX),y
tax
iny
lda (INDEX),y
tay
pla
plp
bne L34CD
cpy FRETOP+1
bne L34CD
cpx FRETOP
bne L34CD
pha
clc
adc FRETOP
sta FRETOP
bcc L34CC
inc FRETOP+1
L34CC:
pla
L34CD:
stx INDEX
sty INDEX+1
rts
; ----------------------------------------------------------------------------
; RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT
; ----------------------------------------------------------------------------
FRETMS:
.ifdef KBD
cpy #$00
.else
cpy LASTPT+1
.endif
bne L34E2
cmp LASTPT
bne L34E2
sta TEMPPT
sbc #$03
sta LASTPT
ldy #$00
L34E2:
rts
; ----------------------------------------------------------------------------
; "CHR$" FUNCTION
; ----------------------------------------------------------------------------
CHRSTR:
jsr CONINT
txa
pha
lda #$01
jsr STRSPA
pla
ldy #$00
sta (FAC+1),y
pla
pla
jmp PUTNEW
; ----------------------------------------------------------------------------
; "LEFT$" FUNCTION
; ----------------------------------------------------------------------------
LEFTSTR:
jsr SUBSTRING_SETUP
cmp (DSCPTR),y
tya
SUBSTRING1:
bcc L3503
lda (DSCPTR),y
tax
tya
L3503:
pha
SUBSTRING2:
txa
SUBSTRING3:
pha
jsr STRSPA
lda DSCPTR
ldy DSCPTR+1
jsr FRETMP
pla
tay
pla
clc
adc INDEX
sta INDEX
bcc L351C
inc INDEX+1
L351C:
tya
jsr MOVSTR1
jmp PUTNEW
; ----------------------------------------------------------------------------
; "RIGHT$" FUNCTION
; ----------------------------------------------------------------------------
RIGHTSTR:
jsr SUBSTRING_SETUP
clc
sbc (DSCPTR),y
eor #$FF
jmp SUBSTRING1
; ----------------------------------------------------------------------------
; "MID$" FUNCTION
; ----------------------------------------------------------------------------
MIDSTR:
lda #$FF
sta FAC_LAST
jsr CHRGOT
cmp #$29
beq L353F
jsr CHKCOM
jsr GETBYT
L353F:
jsr SUBSTRING_SETUP
.ifdef CONFIG_2
beq GOIQ
.endif
dex
txa
pha
clc
ldx #$00
sbc (DSCPTR),y
bcs SUBSTRING2
eor #$FF
cmp FAC_LAST
bcc SUBSTRING3
lda FAC_LAST
bcs SUBSTRING3
; ----------------------------------------------------------------------------
; COMMON SETUP ROUTINE FOR LEFT$, RIGHT$, MID$:
; REQUIRE ")"; POP RETURN ADRS, GET DESCRIPTOR
; ADDRESS, GET 1ST PARAMETER OF COMMAND
; ----------------------------------------------------------------------------
SUBSTRING_SETUP:
jsr CHKCLS
pla
.ifndef CONFIG_11
sta JMPADRS+1
pla
sta JMPADRS+2
.else
tay
pla
sta Z52
.endif
pla
pla
pla
tax
pla
sta DSCPTR
pla
sta DSCPTR+1
.ifdef CONFIG_11
lda Z52
pha
tya
pha
.endif
ldy #$00
txa
.ifndef CONFIG_2
beq GOIQ
.endif
.ifndef CONFIG_11
inc JMPADRS+1
jmp (JMPADRS+1)
.else
rts
.endif
; ----------------------------------------------------------------------------
; "LEN" FUNCTION
; ----------------------------------------------------------------------------
LEN:
jsr GETSTR
SNGFLT1:
jmp SNGFLT
; ----------------------------------------------------------------------------
; IF LAST RESULT IS A TEMPORARY STRING, FREE IT
; MAKE VALTYP NUMERIC, RETURN LENGTH IN Y-REG
; ----------------------------------------------------------------------------
GETSTR:
jsr FRESTR
ldx #$00
stx VALTYP
tay
rts
; ----------------------------------------------------------------------------
; "ASC" FUNCTION
; ----------------------------------------------------------------------------
ASC:
jsr GETSTR
beq GOIQ
ldy #$00
lda (INDEX),y
tay
.ifndef CONFIG_11A
jmp SNGFLT1
.else
jmp SNGFLT
.endif
; ----------------------------------------------------------------------------
GOIQ:
jmp IQERR
; ----------------------------------------------------------------------------
; SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION
; TO SINGLE BYTE IN X-REG
; ----------------------------------------------------------------------------
GTBYTC:
jsr CHRGET
; ----------------------------------------------------------------------------
; EVALUATE EXPRESSION AT TXTPTR, AND
; CONVERT IT TO SINGLE BYTE IN X-REG
; ----------------------------------------------------------------------------
GETBYT:
jsr FRMNUM
; ----------------------------------------------------------------------------
; CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG
; ----------------------------------------------------------------------------
CONINT:
jsr MKINT
ldx FAC_LAST-1
bne GOIQ
ldx FAC_LAST
jmp CHRGOT
; ----------------------------------------------------------------------------
; "VAL" FUNCTION
; ----------------------------------------------------------------------------
VAL:
jsr GETSTR
bne L35AC
jmp ZERO_FAC
L35AC:
ldx TXTPTR
ldy TXTPTR+1
stx STRNG2
sty STRNG2+1
ldx INDEX
stx TXTPTR
clc
adc INDEX
sta DEST
ldx INDEX+1
stx TXTPTR+1
bcc L35C4
inx
L35C4:
stx DEST+1
ldy #$00
lda (DEST),y
pha
lda #$00
sta (DEST),y
jsr CHRGOT
jsr FIN
pla
ldy #$00
sta (DEST),y
; ----------------------------------------------------------------------------
; COPY STRNG2 INTO TXTPTR
; ----------------------------------------------------------------------------
POINT:
ldx STRNG2
ldy STRNG2+1
stx TXTPTR
sty TXTPTR+1
rts