forked from mist64/msbasic
-
Notifications
You must be signed in to change notification settings - Fork 1
/
eval.s
788 lines (761 loc) · 17 KB
/
eval.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
786
787
788
.segment "CODE"
; ----------------------------------------------------------------------------
; "NEXT" STATEMENT
; ----------------------------------------------------------------------------
NEXT:
bne NEXT1
ldy #$00
beq NEXT2
NEXT1:
jsr PTRGET
NEXT2:
sta FORPNT
sty FORPNT+1
jsr GTFORPNT
beq NEXT3
ldx #$00
GERR:
beq JERROR
NEXT3:
txs
.ifndef CONFIG_2
inx
inx
inx
inx
.endif
txa
.ifdef CONFIG_2
clc
adc #$04
pha
adc #BYTES_FP+1
sta DEST
pla
.else
inx
inx
inx
inx
inx
.ifndef CONFIG_SMALL
inx
.endif
stx DEST
.endif
ldy #>STACK
jsr LOAD_FAC_FROM_YA
tsx
lda STACK+BYTES_FP+4,x
sta FACSIGN
lda FORPNT
ldy FORPNT+1
jsr FADD
jsr SETFOR
ldy #>STACK
jsr FCOMP2
tsx
sec
sbc STACK+BYTES_FP+4,x
beq L2C22
lda STACK+2*BYTES_FP+5,x
sta CURLIN
lda STACK+2*BYTES_FP+6,x
sta CURLIN+1
lda STACK+2*BYTES_FP+8,x
sta TXTPTR
lda STACK+2*BYTES_FP+7,x
sta TXTPTR+1
L2C1F:
jmp NEWSTT
L2C22:
txa
adc #2*BYTES_FP+7
tax
txs
jsr CHRGOT
cmp #$2C
bne L2C1F
jsr CHRGET
jsr NEXT1
; ----------------------------------------------------------------------------
; EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC
; ----------------------------------------------------------------------------
FRMNUM:
jsr FRMEVL
; ----------------------------------------------------------------------------
; MAKE SURE (FAC) IS NUMERIC
; ----------------------------------------------------------------------------
CHKNUM:
clc
.byte $24
; ----------------------------------------------------------------------------
; MAKE SURE (FAC) IS STRING
; ----------------------------------------------------------------------------
CHKSTR:
sec
; ----------------------------------------------------------------------------
; MAKE SURE (FAC) IS CORRECT TYPE
; IF C=0, TYPE MUST BE NUMERIC
; IF C=1, TYPE MUST BE STRING
; ----------------------------------------------------------------------------
CHKVAL:
bit VALTYP
bmi L2C41
bcs L2C43
L2C40:
rts
L2C41:
bcs L2C40
L2C43:
ldx #ERR_BADTYPE
JERROR:
jmp ERROR
; ----------------------------------------------------------------------------
; EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE
; RESULT IN FAC. WORKS FOR BOTH STRING AND NUMERIC
; EXPRESSIONS.
; ----------------------------------------------------------------------------
FRMEVL:
ldx TXTPTR
bne L2C4E
dec TXTPTR+1
L2C4E:
dec TXTPTR
ldx #$00
.byte $24
FRMEVL1:
pha
txa
pha
lda #$01
jsr CHKMEM
jsr FRM_ELEMENT
lda #$00
sta CPRTYP
FRMEVL2:
jsr CHRGOT
L2C65:
sec
sbc #TOKEN_GREATER
bcc L2C81
cmp #$03
bcs L2C81
cmp #$01
rol a
eor #$01
eor CPRTYP
cmp CPRTYP
bcc SNTXERR
sta CPRTYP
jsr CHRGET
jmp L2C65
L2C81:
ldx CPRTYP
bne FRM_RELATIONAL
bcs L2D02
adc #$07
bcc L2D02
adc VALTYP
bne L2C92
jmp CAT
L2C92:
adc #$FF
sta INDEX
asl a
adc INDEX
tay
FRM_PRECEDENCE_TEST:
pla
cmp MATHTBL,y
bcs FRM_PERFORM1
jsr CHKNUM
L2CA3:
pha
L2CA4:
jsr FRM_RECURSE
pla
ldy LASTOP
bpl PREFNC
tax
beq GOEX
bne FRM_PERFORM2
; ----------------------------------------------------------------------------
; FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
; ----------------------------------------------------------------------------
FRM_RELATIONAL:
lsr VALTYP
txa
rol a
ldx TXTPTR
bne L2CBB
dec TXTPTR+1
L2CBB:
dec TXTPTR
ldy #$1B
sta CPRTYP
bne FRM_PRECEDENCE_TEST
PREFNC:
cmp MATHTBL,y
bcs FRM_PERFORM2
bcc L2CA3
; ----------------------------------------------------------------------------
; STACK THIS OPERATION AND CALL FRMEVL FOR
; ANOTHER ONE
; ----------------------------------------------------------------------------
FRM_RECURSE:
lda MATHTBL+2,y
pha
lda MATHTBL+1,y
pha
jsr FRM_STACK1
lda CPRTYP
jmp FRMEVL1
SNTXERR:
jmp SYNERR
; ----------------------------------------------------------------------------
; STACK (FAC)
; THREE ENTRY POINTS:
; 1, FROM FRMEVL
; 2, FROM "STEP"
; 3, FROM "FOR"
; ----------------------------------------------------------------------------
FRM_STACK1:
lda FACSIGN
ldx MATHTBL,y
; ----------------------------------------------------------------------------
; ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE
; ----------------------------------------------------------------------------
FRM_STACK2:
tay
pla
sta INDEX
.ifndef CONFIG_2B
inc INDEX ; bug: assumes not on page boundary
; bug exists on AppleSoft II
.endif
pla
sta INDEX+1
.ifdef CONFIG_2B
inc INDEX
bne LEB69
inc INDEX+1
LEB69:
.endif
tya
pha
; ----------------------------------------------------------------------------
; ENTER HERE FROM "FOR", WITH (INDEX) = STEP,
; TO PUSH INITIAL VALUE OF "FOR" VARIABLE
; ----------------------------------------------------------------------------
FRM_STACK3:
jsr ROUND_FAC
.ifndef CONFIG_SMALL
lda FAC+4
pha
.endif
lda FAC+3
pha
lda FAC+2
pha
lda FAC+1
pha
lda FAC
pha
jmp (INDEX)
L2D02:
ldy #$FF
pla
GOEX:
beq EXIT
; ----------------------------------------------------------------------------
; PERFORM STACKED OPERATION
;
; (A) = PRECEDENCE BYTE
; STACK: 1 -- CPRMASK
; 5 -- (ARG)
; 2 -- ADDR OF PERFORMER
; ----------------------------------------------------------------------------
FRM_PERFORM1:
cmp #$64
beq L2D0E
jsr CHKNUM
L2D0E:
sty LASTOP
FRM_PERFORM2:
pla
lsr a
sta CPRMASK
pla
sta ARG
pla
sta ARG+1
pla
sta ARG+2
pla
sta ARG+3
pla
.ifndef CONFIG_SMALL
sta ARG+4
pla
.endif
sta ARGSIGN
eor FACSIGN
sta SGNCPR
EXIT:
lda FAC
rts
; ----------------------------------------------------------------------------
; GET ELEMENT IN EXPRESSION
;
; GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT
; TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC.
; ----------------------------------------------------------------------------
FRM_ELEMENT:
lda #$00
sta VALTYP
L2D31:
jsr CHRGET
bcs L2D39
L2D36:
jmp FIN
L2D39:
jsr ISLETC
bcs FRM_VARIABLE
.ifdef CONFIG_CBM_ALL
cmp #$FF
bne LCDC1
lda #<CON_PI
ldy #>CON_PI
jsr LOAD_FAC_FROM_YA
jmp CHRGET
CON_PI:
.byte $82,$49,$0f,$DA,$A1
LCDC1:
.endif
cmp #$2E
beq L2D36
cmp #TOKEN_MINUS
beq MIN
cmp #TOKEN_PLUS
beq L2D31
cmp #$22
bne NOT_
; ----------------------------------------------------------------------------
; STRING CONSTANT ELEMENT
;
; SET Y,A = (TXTPTR)+CARRY
; ----------------------------------------------------------------------------
STRTXT:
lda TXTPTR
ldy TXTPTR+1
adc #$00
bcc L2D57
iny
L2D57:
jsr STRLIT
jmp POINT
; ----------------------------------------------------------------------------
; "NOT" FUNCTION
; IF FAC=0, RETURN FAC=1
; IF FAC<>0, RETURN FAC=0
; ----------------------------------------------------------------------------
NOT_:
cmp #TOKEN_NOT
bne L2D74
ldy #$18
bne EQUL
; ----------------------------------------------------------------------------
; COMPARISON FOR EQUALITY (= OPERATOR)
; ALSO USED TO EVALUATE "NOT" FUNCTION
; ----------------------------------------------------------------------------
EQUOP:
jsr AYINT
lda FAC_LAST
eor #$FF
tay
lda FAC_LAST-1
eor #$FF
jmp GIVAYF
L2D74:
.ifdef SYM1
cmp #TOKEN_USR
bne LCC8A
jmp LCDBD
LCC8A:
cmp #$26
bne LCC91
jmp LCDFE
LCC91:
.endif
cmp #TOKEN_FN
bne L2D7B
jmp L31F3
L2D7B:
cmp #TOKEN_SGN
bcc PARCHK
jmp UNARY
; ----------------------------------------------------------------------------
; EVALUATE "(EXPRESSION)"
; ----------------------------------------------------------------------------
PARCHK:
jsr CHKOPN
jsr FRMEVL
CHKCLS:
lda #$29
.byte $2C
CHKOPN:
lda #$28
.byte $2C
CHKCOM:
lda #$2C
; ----------------------------------------------------------------------------
; UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR
; ----------------------------------------------------------------------------
SYNCHR: ; XXX all CBM code calls SYNCHR instead of CHKCOM
ldy #$00
cmp (TXTPTR),y
bne SYNERR
jmp CHRGET
; ----------------------------------------------------------------------------
SYNERR:
ldx #ERR_SYNTAX
jmp ERROR
; ----------------------------------------------------------------------------
MIN:
ldy #$15
EQUL:
pla
pla
jmp L2CA4
; ----------------------------------------------------------------------------
FRM_VARIABLE:
jsr PTRGET
FRM_VARIABLE_CALL = *-1
sta FAC_LAST-1
sty FAC_LAST
.ifdef CONFIG_CBM_ALL
lda VARNAM
ldy VARNAM+1
.endif
ldx VALTYP
beq L2DB1
.ifdef CONFIG_CBM_ALL
.ifdef CONFIG_CBM1_PATCHES
jmp PATCH2
clc
LCE3B:
.else
ldx #$00
stx STRNG1+1
bit FAC+4
bpl LCE53
cmp #$54 ; T
bne LCE53
.endif
cpy #$C9 ; I$
bne LCE53
jsr LCE76
sty EXPON
dey
sty STRNG2
ldy #$06
sty INDX
ldy #$24
jsr LDD3A
jmp LD353
LCE53:
.endif
.ifdef CONFIG_2
.ifndef CBM2
; bugfix?
; fixed on AppleSoft II, not on any CBM
ldx #$00
stx STRNG1+1
.endif
.endif
rts
L2DB1:
.ifndef CONFIG_SMALL
ldx VALTYP+1
bpl L2DC2
ldy #$00
lda (FAC+3),y
tax
iny
lda (FAC+3),y
tay
txa
jmp GIVAYF
L2DC2:
.endif
.ifdef CONFIG_CBM1_PATCHES
jmp PATCH3
.byte $19
.endif
.ifdef CBM2
bit FAC+4
bpl LCE90
cmp #$54
bne LCE82
.endif
.ifndef CONFIG_CBM_ALL
jmp LOAD_FAC_FROM_YA
.endif
.ifdef CONFIG_CBM_ALL
LCE69:
cpy #$49
.ifdef CBM1
bne LCE82
.else
bne LCE90
.endif
jsr LCE76
tya
ldx #$A0
jmp LDB21
LCE76:
.ifdef CBM1
lda #$FE
ldy #$01
.else
lda #$8B
ldy #$00
.endif
sei
jsr LOAD_FAC_FROM_YA
cli
sty FAC+1
rts
LCE82:
cmp #$53
bne LCE90
cpy #$54
bne LCE90
lda Z96
jmp FLOAT
LCE90:
lda FAC+3
ldy FAC+4
jmp LOAD_FAC_FROM_YA
.endif
; ----------------------------------------------------------------------------
UNARY:
asl a
pha
tax
jsr CHRGET
cpx #<(TOKEN_LEFTSTR*2-1)
bcc L2DEF
jsr CHKOPN
jsr FRMEVL
jsr CHKCOM
jsr CHKSTR
pla
tax
lda FAC_LAST
pha
lda FAC_LAST-1
pha
txa
pha
jsr GETBYT
pla
tay
txa
pha
jmp L2DF4
L2DEF:
jsr PARCHK
pla
tay
L2DF4:
lda UNFNC-TOKEN_SGN-TOKEN_SGN+$100,y
sta JMPADRS+1
lda UNFNC-TOKEN_SGN-TOKEN_SGN+$101,y
sta JMPADRS+2
.if .def(KBD)
jsr LF47D
.else
jsr JMPADRS
.endif
jmp CHKNUM
; ----------------------------------------------------------------------------
OR:
ldy #$FF
.byte $2C
; ----------------------------------------------------------------------------
TAND:
ldy #$00
sty EOLPNTR
jsr AYINT
lda FAC_LAST-1
eor EOLPNTR
sta CHARAC
lda FAC_LAST
eor EOLPNTR
sta ENDCHR
jsr COPY_ARG_TO_FAC
jsr AYINT
lda FAC_LAST
eor EOLPNTR
and ENDCHR
eor EOLPNTR
tay
lda FAC_LAST-1
eor EOLPNTR
and CHARAC
eor EOLPNTR
jmp GIVAYF
; ----------------------------------------------------------------------------
; PERFORM RELATIONAL OPERATIONS
; ----------------------------------------------------------------------------
RELOPS:
jsr CHKVAL
bcs STRCMP
lda ARGSIGN
ora #$7F
and ARG+1
sta ARG+1
lda #<ARG
ldy #$00
jsr FCOMP
tax
jmp NUMCMP
; ----------------------------------------------------------------------------
; STRING COMPARISON
; ----------------------------------------------------------------------------
STRCMP:
lda #$00
sta VALTYP
dec CPRTYP
jsr FREFAC
sta FAC
stx FAC+1
sty FAC+2
lda ARG_LAST-1
ldy ARG_LAST
jsr FRETMP
stx ARG_LAST-1
sty ARG_LAST
tax
sec
sbc FAC
beq L2E74
lda #$01
bcc L2E74
ldx FAC
lda #$FF
L2E74:
sta FACSIGN
ldy #$FF
inx
STRCMP1:
iny
dex
bne L2E84
ldx FACSIGN
NUMCMP:
bmi CMPDONE
clc
bcc CMPDONE
L2E84:
lda (ARG_LAST-1),y
cmp (FAC+1),y
beq STRCMP1
ldx #$FF
bcs CMPDONE
ldx #$01
CMPDONE:
inx
txa
rol a
and CPRMASK
beq L2E99
lda #$FF
L2E99:
jmp FLOAT
.ifdef SYM1
LCDBD:
jsr CHRGET
jsr CHKOPN
jsr FRMEVL
jsr CHRGOT
cmp #$29
beq LCDF1
jsr AYINT
lda FAC+4
ldy FAC+3
sta USR+1
sty USR+2
LCDD8:
jsr CHKCOM
jsr FRMEVL
jsr CHRGOT
cmp #$29
beq LCDF1
jsr AYINT
lda FAC+3
pha
lda FAC+4
pha
jmp LCDD8
LCDF1:
jsr CHRGET
jsr AYINT
lda FAC+3
ldy FAC+4
jmp USR
LCDFE:
lda ZD4
pha
lda ZD3
pha
jsr CHRGET
cmp #$22
bne LCE49
jsr CHRGET
jsr LCE2B
tax
jsr CHRGOT
jsr LCE2B
pha
jsr CHRGOT
cmp #$22
bne LCE48
jsr CHRGET
pla
tay
pla
pla
txa
jmp GIVAYF
LCE2B:
jsr ASCNIB
bcs LCE47
pha
jsr CHRGET
jsr ASCNIB
sta FAC+4
bcs LCE46
jsr CHRGET
pla
asl a
asl a
asl a
asl a
ora FAC+4
rts
LCE46:
pla
LCE47:
pla
LCE48:
pla
LCE49:
pla
sta ZD3
pla
sta ZD4
jmp ZERO_FAC
.endif