-
Notifications
You must be signed in to change notification settings - Fork 0
/
zeus_assembler.z80
4522 lines (4409 loc) · 155 KB
/
zeus_assembler.z80
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
FREE: EQU &DA
LOAD: EQU &103
BOX: EQU &130
ASCII: EQU &133
FILE_INFO: EQU &18D
NUM16: EQU 35
INDSIZ: EQU "z"-"A"*2 ;
CR: EQU 0 ; ASCII CARRIAGE RETURN
SPACE: EQU &20 ; ASCII SPACE
CTOK: EQU &71 ; TOKEN FOR UNCONDIT. OPND KW "C"
CCOND: EQU &8B ; TOKEN FOR CONDITIONAL OPND KW "C
XYMASK: EQU &FB ; MASK TO RECOGNISE IX/IY TOKENS
IXORIY: EQU &1A ; COMMON VALUE OF IX/IY TOKENS
INTTOK: EQU &90 ; OPERAND TOKEN FOR "INTEGER"
ORGTOK: EQU 1 ; TOKEN FOR "ORG" PSEUDO-OP
EQUTOK: EQU 2 ; TOKEN FOR "EQU" PSEUDO-OP
DEFLTK: EQU 3 ; TOKEN FOR "DEFL" PSEUDO-OP
DEFBTK: EQU 5
DEFWTK: EQU 6
DEFSTK: EQU 7 ; TOKEN FOR "DEFS" PSEUDO-OP
MDATTOK: EQU 9 ; TOKEN FOR "MDAT" PSEUDO-OP
DEFMTK: EQU 8 ; TOKEN FOR "DEFM" PSUEDO-OP
PLUTOK: EQU 7 ; TOKEN FOR MONADIC PLUS
MINTOK: EQU 15 ; TOKEN FOR MONADIC MINUS
LBTOK: EQU &B0 ; TOKEN FOR "("
EXPTOK: EQU &35 ; TOKEN FOR EXPONENTIATION
ASKTOK: EQU &3D ; TOKEN FOR MULTIPLY
MAXFSK: EQU 10 ; MAX SIZE OF ARITHMETIC
LABSIZ: EQU 14
MAXASK: EQU 20 ; MAX SIZE OF ARITH STACK
LBFSZ: EQU 64 ; LINE BUFFER CAPACITY
ACBSIZ: EQU 64 ; SIZE OF ASSD CODE BUFFER
SPERL: EQU 5 ; NO OF SYMBOLS PER LINE ???
T#A: EQU 128
T#ADC: EQU T#A+1
T#ADD: EQU T#ADC+1
T#AF: EQU T#ADD+1
T#AND: EQU T#AF+1
T#B: EQU T#AND+1
T#BC: EQU T#B+1
T#BIT: EQU T#BC+1
T#C: EQU T#BIT+1
T#CALL: EQU T#C+1
T#CCF: EQU T#CALL+1
T#CP: EQU T#CCF+1
T#CPD: EQU T#CP+1
T#CPDR: EQU T#CPD+1
T#CPI: EQU T#CPDR+1
T#CPIR: EQU T#CPI+1
T#CPL: EQU T#CPIR+1
T#D: EQU T#CPL+1
T#DAA: EQU T#D+1
T#DE: EQU T#DAA+1
T#DEC: EQU T#DE+1
T#DEFB: EQU T#DEC+1
T#DEFM: EQU T#DEFB+1
T#DEFS: EQU T#DEFM+1
T#DEFW: EQU T#DEFS+1
T#DI: EQU T#DEFW+1
T#DJNZ: EQU T#DI+1
T#DUMP: EQU T#DJNZ+1
T#E: EQU T#DUMP+1
T#EI: EQU T#E+1
T#EQU: EQU T#EI+1
T#EX: EQU T#EQU+1
T#EXX: EQU T#EX+1
T#H: EQU T#EXX+1
T#HALT: EQU T#H+1
T#HL: EQU T#HALT+1
T#I: EQU T#HL+1
T#IM: EQU T#I+1
T#IN: EQU T#IM+1
T#INC: EQU T#IN+1
T#IND: EQU T#INC+1
T#INDR: EQU T#IND+1
T#INI: EQU T#INDR+1
T#INIR: EQU T#INI+1
T#IX: EQU T#INIR+1
T#IY: EQU T#IX+1
T#JP: EQU T#IY+1
T#JR: EQU T#JP+1
T#L: EQU T#JR+1
T#LD: EQU T#L+1
T#LDD: EQU T#LD+1
T#LDDR: EQU T#LDD+1
T#LDI: EQU T#LDDR+1
T#LDIR: EQU T#LDI+1
T#LIST: EQU T#LDIR+1
T#M: EQU T#LIST+1
T#MDAT: EQU T#M+1
T#NC: EQU T#MDAT+1
T#NEG: EQU T#NC+1
T#NOP: EQU T#NEG+1
T#NZ: EQU T#NOP+1
T#OFF: EQU T#NZ+1
T#ON: EQU T#OFF+1
T#OR: EQU T#ON+1
T#ORG: EQU T#OR+1
T#OTDR: EQU T#ORG+1
T#OTIR: EQU T#OTDR+1
T#OUT: EQU T#OTIR+1
T#OUTD: EQU T#OUT+1
T#OUTI: EQU T#OUTD+1
T#P: EQU T#OUTI+1
T#PE: EQU T#P+1
T#PO: EQU T#PE+1
T#POP: EQU T#PO+1
T#PUSH: EQU T#POP+1
T#R: EQU T#PUSH+1
T#RES: EQU T#R+1
T#RET: EQU T#RES+1
T#RETI: EQU T#RET+1
T#RETN: EQU T#RETI+1
T#RL: EQU T#RETN+1
T#RLA: EQU T#RL+1
T#RLC: EQU T#RLA+1
T#RLCA: EQU T#RLC+1
T#RLD: EQU T#RLCA+1
T#RR: EQU T#RLD+1
T#RRA: EQU T#RR+1
T#RRC: EQU T#RRA+1
T#RRCA: EQU T#RRC+1
T#RRD: EQU T#RRCA+1
T#RST: EQU T#RRD+1
T#SBC: EQU T#RST+1
T#SCF: EQU T#SBC+1
T#SET: EQU T#SCF+1
T#SLA: EQU T#SET+1
T#SLL: EQU T#SLA+1
T#SP: EQU T#SLL+1
T#SRA: EQU T#SP+1
T#SRL: EQU T#SRA+1
T#SUB: EQU T#SRL+1
T#XOR: EQU T#SUB+1
T#Z: EQU T#XOR+1
T#DEFL: EQU T#Z+1
T#DEFC: EQU T#DEFL+1
ORG &8000
DUMP 9,0 ; 10
JP START
JP VYRAZX
START: CALL INITA
MAIN1: LD A,(PASSNO)
INC A
LD (PASSNO),A ; SAVE IN PASS NO. STORE
CP 3
RET Z ; RETURN TO SYSTEM MONITOR
LD HL,(MEMTOP)
LD DE,(SYMEND)
AND A
SBC HL,DE
LD (TABFREE),HL
CALL PASS ; PERFORM 1 PASS
LD IX,INFO
SCF
RET Z ; ESC = ERROR
JR MAIN1 ; GO DO ANOTHER PASS
INFO:
ERRORS: DB 0
LABELS: DW 0
TABFREE: DW 0
LINECNT: DW 0
DSTPTR: DS 3
CODESTART: DS 3
CO: LD A,C
JP 16
;
INDEX: LD HL,INDTAB
LD DE,INDTAB+2
LD BC,(SYMEND)
LD (INDTAB),BC
LD BC,INDSIZ-2
LDIR
LD IX,SYMTAB
LD IY,INDTAB
LD C,"A"
LD B,INDSIZ/2
SADA: LD A,(IX)
AND A
RET Z
ADD 4
LD E,A
LD D,0
LD A,(IX+1)
SADA2: CP C
JR NZ,NOTPRESENT
PUSH IX
POP HL
LD (IY),L
INC IY
LD (IY),H
INC IY
ADD IX,DE
SADA4: LD A,(IX)
AND A
RET Z
LD A,(IX+1)
CP C
JR NZ,SADA3
LD A,(IX)
ADD 4
LD E,A
LD D,0
ADD IX,DE
JR SADA4
SADA3: INC C
DJNZ SADA
RET
NOTPRESENT: INC IY
INC IY
INC C
JR SADA2
;*
;PRINT LINE AT POS 13,1 FROM LINBUF
EXPLINE: LD A,22
RST 16
LD A,13
RST 16
LD A,1
RST 16
LD HL,LINBUF
LD A,(HL)
CP 15
JR NC,EXP0
INC HL
LD B,A
EXP1: LD A,(HL)
INC HL
PUSH BC
RST 16
POP BC
DJNZ EXP1
LD A,":"
RST 16
EXP0: LD A,(HL)
CP CR
RET Z
INC HL
CP 128
CALL NC,TOKEN
CALL C,16
JR EXP0
TOKEN: PUSH AF
PUSH HL
LD HL,TOKENY
SUB 128
LD C,A
TOKEN1: DEC C
JP M,TOKEN2
TOKEN3: BIT 7,(HL)
INC HL
JR Z,TOKEN3
JR TOKEN1
TOKEN2: LD A,(HL)
AND 127
RST 16
BIT 7,(HL)
INC HL
JR Z,TOKEN2
LD A," "
RST 16
POP HL
POP AF
RET
;*
;GET LINE FROM SOURCE AND INCR. LINECNT
;*
GETLINE: PUSH BC
PUSH DE
PUSH HL
DI
IN A,(250)
EX AF,AF'
LD A,(SRCPTR)
LD HL,(SRCPTR+1)
BIT 6,H
JR Z,GETL2
RES 6,H
INC A
LD (SRCPTR),A
LD (SRCPTR+1),HL
GETL2: OUT (250),A
GETL4: LD A,(HL)
LD (BUFFER),A
AND A
JR Z,GETL1
CP 2
JR NZ,GETL3
INC HL
INC HL
JR GETL4
GETL3: LD C,(HL)
LD B,0
LD DE,BUFFER
LDIR
GETL1: LD (SRCPTR+1),HL
EX AF,AF'
OUT (250),A
LD HL,(LINECNT)
INC HL
LD (LINECNT),HL
EI
POP HL
POP DE
POP BC
LD A,(BUFFER)
AND A
JR NZ,FULL
LD HL,AFLAGS
BIT 3,(HL)
RES 3,(HL)
JR NZ,GETLINE1 ; KONIEC INCLUDE
SET 1,(HL)
RET
FULL: LD A,(BUFFER+1)
CP ";"
JR Z,GETLINE
RET
GETLINE1: LD A,(SRC2)
LD HL,(SRC2+1)
LD (SRCPTR),A
LD (SRCPTR+1),HL
JR GETLINE
;*
;PERFORM A PASS
;*
PASS: CALL INITP ; INITIALIZE FOR PASS
PASS1: CALL INITL ; INITIALIZE FOR LINE
RET Z ; IF ESC
LD A,(AFLAGS)
BIT 1,A
RET NZ ; BOLO END OF FILE
CALL GLIN ; ODSTRAN KOMENTARE
CALL GLAB ; GET LABEL
JR Z,PASS4 ; JMP IF NO MORE PROC. REQD.
CALL GETOR ; GET OPERATOR TOKEN
JR Z,PASS4 ; JUMP IF NO MORE PROC. REQD.
LD A,(ORTKBF)
CP MDATTOK ; TOKEN FOR MDAT ?
JR NZ,PASS2
CALL PLAB
CALL MDATS
JR PASS5
PASS2: CP DEFMTK ; TOKEN FOR "DEFM"?
JR NZ,PASS31
CALL DEFMS ; YES, PROCESS ITS OPERAND
JR PASS5
PASS31: CP 13 ; INC/DEC GROUP
JR NZ,PASS32
LD A,(ORTKBF+1)
AND A
JR NZ,PASS32
LD HL,(LINPNT)
LD A,(HL)
CP 34
JR NZ,PASS32 ; INC "XXX"
CALL INCLUDE
CALL PLAB
JR PASS4
PASS32: CP DEFBTK
JR Z,PASS34
CP DEFWTK
JR NZ,PASS3
PASS34: CALL PDEF
JR PASS5
PASS3: CALL GTOD ; NEITHER, PROCESS NORMAL OPERANDS
JR Z,PASS4 ; JMP IF NO MORE PROC. REQD.
PASS5: CALL PTOK ; PROCESS TOKENS
PASS4: CALL PRFLO ; PERFORM RELEVANT OUTPUT
LD HL,AFLAGS
BIT 4,(HL)
RES 4,(HL)
SCF
JR Z,PASS1 ; GO PROCESS ANOTHER LINE IF
XOR A
RET ; FATAL ERROR
INITA: OR &20
LD (PAGE),A
XOR A
LD (PASSNO),A
LD (SYMTAB),A ; CLEAR SYMBOL TABLE
LD (ERRORS),A
LD (AFLAGS),A
LD (NOINC),A
LD HL,0
LD (LABELS),HL
LD HL,SYMTAB ; PUT SYMBOL TABLE START ADDR
LD (SYMEND),HL ; INTO "END OF SYMBOL TABLE" STORE
IN A,(250)
DI
EX AF,AF'
LD A,31
OUT (250),A
LD HL,&5101
XOR A
CP (HL)
JR Z,N3
INC HL
JR $-4
N3: EX AF,AF'
OUT (250),A
EI
LD A,L
LD (CRANGE),A
RET
INITP: XOR A
LD (DUMPF),A
INC A
LD (DSTPTR),A
LD HL,0
LD (DSTPTR+1),HL
LD (CODESTART),A
LD (CODESTART+1),HL
LD A,(PAGE)
LD (LINECNT),HL ; POCITANIE RIADKOV
LD (SRCPTR),A
INC HL
LD (SRCPTR+1),HL
LD HL,32768
LD (ADREFC),HL
LD A,(PASSNO)
ADD "0"
LD (PNO),A
LD HL,PT
CALL CONST
LD HL,(LABELS)
RST 40
DB NUM16
LD HL,PT2
CALL CONST
LD HL,(TABFREE)
RST 40
DB NUM16
LD A,(PASSNO)
CP 2
CALL Z,INDEX
RET
PT: DB 22,12,1
DM "Pass # "
PNO: DB "1"
DM " | Labels "
DB -1
PT2: DM " | Tabfree "
DB -1
INITL: PUSH BC ; SAVE REGS
PUSH HL
XOR A ; CLEAR ACC
LD HL,ASSCOD ; SET PNTR TO ASSD CODE BUFFER
LD (MEMPTR),HL
LD B,ACBSIZ ; LOAD CNTR WITH SIZE OF BUFFER
INITL1: LD (HL),A ; CLEAR A LOCATION
INC HL ; INCR PNTR
DJNZ INITL1 ; LOOP UNTIL DONE
LD (ASCDNO),A ; SET "BYTES ASSD CODE" = 0
LD (ODBT1),A ; CLEAR OPERAND TOKEN BUFFERS
LD (ODBT2),A
LD HL,0 ; CLEAR OPERAND INTEGER BUFFERS
LD (ODINT1),HL
LD (ODINT2),HL
LD (ORTKBF),HL ; CLEAR OPERATOR TOKEN BUFFER
LD HL,(ADREFC) ; COPY ADDR REF CNTR
LD (ADDISR),HL ; INTO ADDR DIS REG
LD A,SPACE ; PUT SPACE CHAR IN ERROR BUFFER
LD (ERRBUF),A
LD HL,AFLAGS ; SET PNTR TO ASSEMBLER FLAGS
RES 0,(HL) ; CLEAR ADDR DISCONTINUITY FLAG
RES 1,(HL) ; CLEAR "END" FLAG
CALL GETLINE
LD A,&F7
IN A,(&F9)
AND 32
POP HL
POP BC
RET
;*
;GET LINE FROM READER
;*
GLIN: PUSH HL ; SAVE REGS
PUSH DE
PUSH BC
LD HL,LINBUF ; SET POINTER TO LINE BUFFER
GLIN1: LD A,(HL) ; GET CHAR FROM READER
CP CR ; IS IT CR?
JR Z,GLIN4
CP ";" ; SET COMMENT FLAG IF ";"
JR NZ,GLIN7
LD (HL),CR
JR GLIN4
GLIN7: CP 34 ; PUT IN BUFFER
PUSH AF
CALL Z,STR
POP AF
JR Z,GLIN1
INC HL
JR GLIN1
GLIN4: DEC HL
LD A,(HL)
CP "'"
JR NZ,GLIN2
DEC HL
LD A,(HL)
INC HL
CP T#AF
JR NZ,GLIN2
LD (HL),CR
GLIN2: POP BC ; REPLACE REGS
POP DE
POP HL
RET
;*
;GET LABEL
;LOCATES LABEL (IF ANY) IN LINBUF AND PUTS IT IN LABBUF.
;LEAVES POINTER TO CHARACTER AFTER LABEL IN LINPNT.
;ZERO SET IF NOTHING ELSE TO PROCESS
;*
GLAB: PUSH HL ; SAVE REGS
PUSH DE
PUSH BC
LD HL,LINBUF ; SET POINTER TO LINE BUFFER
LD DE,LABBUF ; SET POINTER TO LABEL BUFFE
GLAB1: LD A,(HL) ; SCAN TO FIRST NON SPACE CH
CP LABSIZ+1
JR NC,GLAB6 ; UMIESTNI LABEL DO BUFERA
LD (DE),A
INC HL
INC DE
LD B,A
GLAB9: LD A,(HL)
LD (DE),A
INC HL
INC DE
DJNZ GLAB9
LD A,(HL)
CP CR
JR NZ,GLAB4
LD (HL),T#EQU
INC HL ; TREBA HO ZAZNAMENAT
LD (HL),"$"
INC HL
LD (HL),CR
DEC HL
DEC HL
JR GLAB4
GLAB6: LD HL,LINBUF ; RIADOK BEZ LABEL
XOR A ; SET "NO LABEL IN BUFFER"
LD (LABBUF),A
GLAB4: LD (LINPNT),HL ; RIADOK Z LABEL
XOR A ; CLEAR ZERO FLAG
INC A
GLAB8: POP BC
POP DE
POP HL
RET
;*
;GET OPERATOR TOKEN,
;LOCATES OPERATOR (IF ANY) AND PUTS TOKEN AND VALUE FOR IT IN O.
;LEAVES POINTER TO CHARACTER AFTER OPERATOR IN LINPNT
;ZERO FLAG SET IF NOTHING ELSE TO PROCESS.
;*
GETOR: PUSH HL ; SAVE REGISTERS
PUSH DE
PUSH BC
EXX
PUSH HL
PUSH DE
PUSH BC
LD HL,(LINPNT) ; FETCH POINTER TO LINE BUFFER
GETOR1: LD A,(HL)
GETOR5: CP T#A ; TOKEN?
JR C,GETOR3 ; NO, SYNTAX ERROR
LD DE,SYMBUF ; SET POINTER TO SYMBOL BUFFE
LD A,1 ; SET COUNT = 0
LD (DE),A ; PUT CHAR IN OPERATOR BUFFE
INC DE
LD A,(HL) ; GET TOKEN
LDI ; INCR LINBUF POINTER
EXX ; SET UP PARAMETERS FOR OPTOK
LD DE,ORTKBF
CALL FORL ; GET TOKENS FROM LIST
EXX
JR Z,GETOR3 ; INVALID SYNTAX, NOT IN LIST
GETOR2: LD (LINPNT),HL ; DEPOSIT LINE BUFFER POINTER
XOR A ; CLEAR ZERO FLAG
INC A
GETOR7: POP BC ; RECOVER REGISTERS
POP DE
POP HL
EXX
POP BC
POP DE
POP HL
RET
GETOR3: CALL DNOPS ; RESERVE 4 DEFAULT NOP"S
CALL ADJARC ; ADJUST ADDRESS REF COUNTER
XOR A ; SET ZERO FLAG
JR GETOR7
;*
;GET OPERAND TOKENS AND VALUES
;LOCATES OPERANDS (IF ANY) AND SETS TOKENS FOR THEM IN ODBT1/OD2
;AND CORRESPONDING INTEGER VALUES (IF ANY) IN ODINT1/ODINT2.
;ZERO FLAG SET IF NOTHING ELSE TO PROCESS
;*
GTOD: PUSH IX ; SAVE REGISTERS
PUSH IY
PUSH HL
PUSH DE
PUSH BC
EXX
PUSH HL
PUSH DE
PUSH BC
LD HL,(LINPNT) ; GET LINE BUFFER POINTER
LD B,0 ; CLEAR B (OPERAND COUNTER,
; "BRACKETS" FLAG & "QUOTE" FLAG)
GTOD1: CALL SCNSP ; SCAN TO FIRST NON SPACE CHAR
CP "," ; IS IT A COMMA?
JR NZ,GTOD2
BIT 0,B ; YES, FOUND 1 OPERAND?
JP Z,GTOD25 ; NO, SYNTAX ERROR
INC HL ; YES, SCAN TO NEXT NON SP CHAR
CALL SCNSP
JR GTOD3
GTOD2: CP CR ; IS IT A CR ?
JP Z,GTOD24
GTOD3: PUSH HL ; NO, SET POINTER TO START
POP IX ; OF OPERAND IN IX
RES 6,B ; CLEAR QUOTE FLAG
GTOD4: LD A,(HL) ; GET CHAR IN A
CP 34 ; IS IT A "?
JR NZ,GTOD18 ; JUMP IF NOT
LD A,B ; COMPLEMENT QUOTE FLAG
XOR %01000000
LD B,A
JR GTOD28 ; AND CONTINUE TO SCAN
GTOD18: CP CR ; IS IT CR?
JR Z,GTOD5 ; FOUND DELIMITER, JUMP
CP SPACE ; IS IT SPACE
JR Z,GTOD27 ; JUMP IF SO
CP "," ; IS IT A COMMA?
JR Z,GTOD27 ; JUMP IF SO
CP ";" ; IS IT ; ?
JR NZ,GTOD28 ; CONTINUE SCAN OF NONE OF THESE
GTOD27: BIT 6,B ; IS QUOTE FLAG SET?
JR Z,GTOD5 ; JUMP IF NOT, FOUND DELIMITER
GTOD28: INC HL ; POINT TO NEXT CHAR
JR GTOD4 ; AND LOOP
GTOD5: PUSH HL ; SET POINTER (IY) TO CHAR
POP IY ; AFTER END OF OPERAND
INC B ; INCR # OF OPERANDS FOUND
LD A,B ; IS IT > 2 ?
AND 3
CP 3
JP Z,GTOD25 ; MOC VELA OPERATOROV
RES 7,B ; CLEAR BRACKETS FLAG
LD A,(IX) ; DOES IT START WITH ( ?
CP "("
JR NZ,GTOD6
LD A,(IY-1) ; DOES IT END WITH ) ?
CP ")"
JR NZ,GTOD6
SET 7,B ; SET BRACKETS FLAG IN B
INC IX ; AND CLOSE IN POINTERS
DEC IY
GTOD6: PUSH IX ; GET POINTER TO START OF OPERAND
POP HL
LD DE,SYMBUF+1 ; SET POINTER TO SYMBUF
LD C,0 ; ZERO CHAR COUNT
LD A,(HL) ; FETCH A CHAR
CALL ALPHA ; IS IT A LETTER?
JR C,GTOD9
; EVALUATE EXPRESSION
GTOD7: ; CP 34 ; NOT LETTER, IS IT "?
; JR NZ,GTOD8
LD (DE),A ; SAVE IT IN BUFFER
INC HL ; POINT TO CHAR FOLLOWING
INC C ; INCREMENT COUNT
GTOD8: LD A,C ; PUT COUNT IN SYMBUF
LD (SYMBUF),A
AND A ; IF COUNT=0 THEN
JR Z,GTOD9 ; GO TO EVAL EXPRESSION
EXX ; GET OPERAND KEYWORD TOKEN
LD HL,OPKLST
LD DE,TEMP
LD C,1 ; 1 BYTE PER TOKEN
CALL OPTOK
EXX
JR Z,GTOD9 ; JUMP IF NO KEYWORD FOUND
LD C,A ; SAVE TOKEN IN C
CP CTOK ; TOKEN FOR C?
JR NZ,GTOD12
LD A,(ORTKBF)
BIT 7,A ; IS OPERATOR CONDITIONAL?
JR Z,GTOD12
LD C,CCOND ; TOKEN FOR CONDITIONAL "C"
GTOD12: LD A,C ; GET TOKEN
AND XYMASK ; IS IT IX/IY ?
CP IXORIY
JR NZ,GTOD14
LD A,(HL) ; GET FOLLOWING CHAR
CP "+"
JR Z,GTOD13
CP "-"
JR NZ,GTOD14
GTOD13: LD A,C ; CONVERT TOKEN TO DUMMY VALUE
AND 15
OR &C0
LD C,A
PUSH HL ; CLOSE POINTER IN TO START OF EXPRESS
POP IX
CALL EVAL ; GET VALUE OF EXPRESSION IN HL
JR Z,GTOD25 ; SYNTAX ERROR
BIT 0,B ; FOUND 1 OPERAND?
JR Z,GTOD15
LD (ODINT1),HL ; SAVE VALUE IN 1ST OPERAND BUFFER
JR GTOD11
GTOD15: LD (ODINT2),HL ; SAVE VALUE IN 2ND OPND BUFF
JR GTOD11
GTOD14: PUSH IY ; END OF OPERAND?
POP DE
AND A ; CLEAR CARRY FLAG
SBC HL,DE
JR NZ,GTOD25 ; SYNTAX ERROR
JR GTOD11
GTOD9: CALL EVAL ; EVALUATE EXPRESSION
; RESULT IN HL
JR Z,GTOD25 ; SYNTAX ERROR
BIT 0,B ; FOUND 1 OPERAND?
JR Z,GTOD17
LD (ODINT1),HL ; SAVE VALUE IN FIRST OPERAND BUFFER
JR GTOD16
GTOD17: LD (ODINT2),HL ; SAVE VALUE IN 2ND OPND BUFF
GTOD16: LD C,INTTOK ; SET TOKEN FOR "INTEGER"
GTOD11: BIT 7,B ; WAS IT IN BRACKETS?
JR Z,GTOD21 ; NO
LD HL,BKLST ; YES, CHECK IF VALID, POINT TO LIST
GTOD20: LD A,(HL) ; GET A TOKEN
INC HL ; POINT TO REPLACEMENT TOKEN
AND A ; IS TOKEN 0 ?
JR Z,GTOD25 ; YES, NOT IN LIST, SYN. ERR.
CP C ; IS IT EQUAL TO ACTUAL TOKEN?
JR Z,GTOD19 ; YES, GO REPLACE IT
INC HL ; POINT TO NEXT TOKEN
JR GTOD20
GTOD19: LD C,(HL) ; REPLACE TOKEN WITH
; BRACKETTED VERSION.
INC IY ; OPEN OUR FINAL POINTER AGAIN
GTOD21: LD A,C ; SAVE TOKEN IN RELEVANT BUFFER
BIT 0,B ; FOUND 1 OPERAND?
JR Z,GTOD22
LD (ODBT1),A ; SAVE TOKEN IN 1ST OPND BUFF
JR GTOD23
GTOD22: LD (ODBT2),A ; SAVE TOKEN IN 2ND OPND BUFF
GTOD23: PUSH IY ; POINT AT NEXT THING
POP HL
JP GTOD1 ; GO PROCESS NEXT TOKEN
GTOD24: XOR A ; CLEAR ZERO FLAG
INC A
GTOD26: POP BC ; REPLACE SAVED REGISTERS
POP DE
POP HL
EXX
POP BC
POP DE
POP HL
POP IY
POP IX
RET
GTOD25: CALL DNOPS ; APPEND DEFAULT NOP"S
CALL ADJARC ; ADJUST ADDRESS REF COUNTER
XOR A
JR GTOD26
;*
;EVALUATE AN EXPRESSION
;ON ENTRY AND EXIT:
; IX POINTS AT FIRST CHAR OF EXPRESSION
; IY POINTS AT CHAR AFTER END OF EXPRESSION
;ON EXIT:
; HL CONTAINS VALUE OF EXPRESSION
; AND ZERO FLAG IS SET IF SYNTAX ERROR
;*
EVAL: PUSH DE ; SAVE REGISTERS
PUSH BC
EXX
PUSH BC
XOR A ; CLEAR ROUTINE FLAG REGISTER
LD B,A
EXX
LD (ARCNT),A ; CLEAR STACKS
LD (FCNT),A
PUSH IX ; POINT TO START OF EXPR.
POP HL
EVAL1: PUSH IY ; END OF EXPRESSION?
POP DE ; I.E. HL=IY ?
EX DE,HL
AND A ; CLEAR CARRY
SBC HL,DE
EX DE,HL
JP Z,EOEX ; END OF EXPRESSION
JP C,EVAL6 ; END OF EXPRESSION ERROR
LD A,(HL) ; GET A CHAR
CALL DIGIT ; IS IT A DIGIT?
JR C,LIT ; YES, GO PROCESS LITERAL
CP "&"
SCF
JR Z,LIT
CP "%"
SCF
JR Z,LIT
CALL ALPHA ; IS IT A LETTER?
JR C,SYMB ; YES, GO PROCESS SYMBOL
CP "." ; IS IT A "."?
JR Z,MCF ; YES, GO PROCESS M/CHAR FUNCTION
CP 34 ; IS IT A "?
JR Z,ASC ; YES, GO PROC. ASCII CHAR
CP "(" ; IS IT A "("?
JP Z,LBKT ; YES, GO PROC. LEFT BRKT
CP ")" ; IS IT ")"?
JP Z,RBKT ; YES, GO PROC. R.H. BRKT
CP "$" ; IS IT "$"?
JR Z,CURLC ; YES, GO PROC. CURR. LOC.
SCHF: CALL PSCF ; PROCESS AS SINGLE CHAR. FUNCTION
JP Z,EVAL3 ; INVALID CHAR ERROR
JR FUN
LIT: CALL PLIT ; PROCESS AS LITERAL
JR OPND
SYMB: CALL PSYMB
JR OPND
ASC: CALL PASC ; PROCESS OS ASCII STRING
JR OPND
CURLC: LD DE,(ADREFC) ; CURRENT VALUE OF ADDR REF
; COUNTER REQUIRED
INC HL ; POINT TO NEXT EXPR CHAR
JR OPND1
OPND: JP C,EVAL4 ; "VALUE" ERROR
OPND1: CALL PUDE ; PUSH VALUE (IN DE) ONTO
; ARITHMETIC STACK
JP Z,EVAL5 ; STACK OVERFLOW ERROR
EXX ; SET "LAST UNIT" FLAG
SET 0,B
EXX
JR EVAL1
MCF: CALL PMCF
JP Z,EVAL6 ; SYNTAX ERROR
FUN: LD A,(FTOKR) ; GET FUNCTION TOKEN
CP PLUTOK ; IS IT TOKEN FOR +?
JR Z,FUN1
CP MINTOK ; IS IT TOKEN FOR -?
JR NZ,FUN2
; +/-
FUN1: EXX ; WAS LAST UNIT START/(/FUNCTION ?
BIT 0,B
EXX
JR Z,FUN3
ADD A,&5D ; CHANGE TOKEN TO DIADIC
LD (FTOKR),A
JR FUN3
FUN2: CP &3D ; DIADIC FUNCTION
JR C,FUN3
EXX ; WAS LAST UNIT START/(/FUNCTION?
BIT 0,B
EXX
JP Z,EVAL6 ; SYNTAX ERROR
FUN3: CALL POFU ; GET PREVIOUS FUNCTION
JR Z,FUN4 ; NO PREVIOUS FUN, PUSH NEW ONE
LD E,A ; SAVE TOP OF STACK IN E
LD A,(FTOKR) ; GET NEW FUNCTION TOKEN
AND 7 ; MASK OFF PRIORITY BITS IN NEW OPR
LD B,A ; SAVE IN B
LD A,E
AND 7 ; MASK OFF PRIORITY BITS OF TOS
CP B ; COMPARE PRIORITIES
JR NC,FUN5 ; GO DO A FUNCTION
; NEW FUNCTION HAS HIGHER
; PRIORITY SO PUSH IT ON
; STACK.
LD A,E ; FIRST PUSH BACK TOP OF STACK
CALL PUFU
FUN4: LD A,(FTOKR) ; THEN PUSH NEW FUNCTION
CALL PUFU
JR Z,EVAL5 ; STACK OVERFLOW ERROR
EXX ; CLEAR "LAST UNIT" FLAG
RES 0,B
EXX
JP EVAL1
FUN5: LD A,E ; PUT T O S IN ACC
CALL FUNC ; PERFORM A FUNCTION
JR Z,EVAL6 ; SYNTAX ERROR
JR FUN3 ; GO TRY NEXT FUNCTION ON STACK
;..................................................
LBKT: INC HL ; POINT TO NEXT EXPR CHAR
LD A,LBTOK ; SET TOKEN FOR "("
CALL PUFU ; PUSH ON FUNCTION STACK
JR Z,EVAL5 ; STACK OVERFLOW ERROR
EXX ; CLEAR "LAST UNIT" FLAG
RES 0,B
EXX
JP EVAL1
;..................................................
RBKT: INC HL
RBKT2: CALL POFU ; POP FUNCTION STACK
JR Z,EVAL7 ; EMPTY, BALANCE ERROR
CP LBTOK ; IS IT A (?
JR Z,RBKT1
CALL FUNC ; PERFORM THE FUNCTION
JR Z,EVAL6 ; SYNTAX ERROR
JR RBKT2 ; MORE OPS TO DO ?
RBKT1: EXX ; SET "LAST UNIT" FLAG
SET 0,B
EXX
JP EVAL1
;.................................................
; END OF EXPRESSION
EOEX: CALL POFU ; POP FUNCTION STACK
JR Z,EOEX1 ; NO MORE FUNCTIONS
CP LBTOK
JR Z,EVAL7 ; BALANCE ERROR
CALL FUNC ; PERFORM THE FUNCTION
JR Z,EVAL6 ; SYNTAX ERROR
JR EOEX
EOEX1: CALL PODE ; GET EXPR VALUE IN DE
JR Z,EVAL6 ; SYNTAX ERROR (STACK EMPTY)
LD A,(ARCNT) ; CHECK IF STACK NOW EMPTY
AND A
JR NZ,EVAL6 ; SYNTAX ERROR
EX DE,HL
EXX
BIT 1,B ; TEST FOR ARITH OVERFLOW
EXX
JR Z,EOEX2
LD C,"A"
EOEX4: CALL ERROR ; INDICATE ARITH OVERFLOW
EOEX2: XOR A ; CLEAR ZERO FLAG
INC A
EOEX3: EXX
POP BC
EXX
POP BC
POP DE
RET
EVAL3: LD C,"I"
JR EVAL8
EVAL4: LD C,"V" ; VALUE ERROR
LD HL,0 ; SET RESULT=0
JR EOEX4 ; NOT FATAL
EVAL5: LD C,"O" ; STACK OVERFLOW ERROR
JR EVAL8
EVAL6: LD C,"S" ; SYNTAX ERROR
JR EVAL8
EVAL7: LD C,"B" ; BALANCE ERROR
EVAL8: CALL ERROR ; SET ERROR INDICATOR
XOR A ; SET ZERO (ERROR) FLAG
JR EOEX3 ; AND PREPARE TO EXIT
;*
;PROCESS LITERAL.
;THIS SUBROUTINE INCLUDES PBIN, PDEC,
;PHEX, POCT.
;ON ENTRY:
; HL POINTS TO FIRST CHAR OF LITERAL
;ON EXIT:
; HL POINTS TO CHAR AFTER LITERAL