-
-
Notifications
You must be signed in to change notification settings - Fork 10
/
eval.asm
1617 lines (1609 loc) · 37.1 KB
/
eval.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
; Expression Evaluation & Arithmetic Module - "EVAL"
; Author: (C) Copyright R.T.Russell 1984
; Modified By: Dean Belfield
; Created: 03/05/2022
; Last Updated: 14/08/2023
;
; Modinfo:
; 07/05/1984: Version 2.3
; 01/03/1987: Modified to use external FPP
; 08/03/1987: Version 3.0
; 30/09/1992: INSTR bug fixed
; 03/05/2022: Modified by Dean Belfield to assemble with ZDS
; 26/07/2022: Fixed bug with INT caused when converting source to run on ZDS
; 19/08/2022: INKEY1 is now XREFd
; 19/05/2023: Added COUNT1 to XDEF and call to GETPORT for GET(x,y)
; 14/08/2023: Added INKEY(-n) support (requires MOS 1.04)
.ASSUME ADL = 0
INCLUDE "equs.inc"
INCLUDE "macros.inc"
INCLUDE "mos_api.inc" ; In MOS/src
SEGMENT CODE
XDEF EXPR
XDEF EXPRN
XDEF EXPRI
XDEF EXPRS
XDEF ITEMI
XDEF LOADN
XDEF LOAD4
XDEF CONS
XDEF DLOAD5
XDEF LOADS
XDEF SFIX
XDEF VAL0
XDEF SEARCH
XDEF SWAP
XDEF TEST
XDEF DECODE
XDEF HEXSTR
XDEF STR
XDEF ZERO
XDEF PUSHS
XDEF POPS
XDEF COMMA
XDEF BRAKET
XDEF NXT
XDEF COUNT0
XDEF COUNT1
XDEF TRUE
XREF ADVAL
XREF FN
XREF POINT
XREF USR
XREF SYNTAX
XREF ERROR_
XREF CHECK
XREF GETVAR
XREF LISTON
XREF RANGE
XREF FPP
XREF GETCSR
XREF CHANEL
XREF OSSTAT
XREF OSBGET
XREF LOMEM
XREF HIMEM
XREF PAGE_
XREF TOP
XREF ERL
XREF ERR
XREF COUNT
XREF OSOPEN
XREF GETEXT
XREF GETPTR
XREF GETIME
XREF GETIMS
XREF LEXAN2
XREF RANDOM
XREF STORE5
XREF GETSCHR
XREF OSRDCH
XREF OSKEY
XREF INKEY1
XREF GETPORT
;
; BINARY FLOATING POINT REPRESENTATION:
; 32 BIT SIGN-MAGNITUDE NORMALIZED MANTISSA
; 8 BIT EXCESS-128 SIGNED EXPONENT
; SIGN BIT REPLACES MANTISSA MSB (IMPLIED "1")
; MANTISSA=0 & EXPONENT=0 IMPLIES VALUE IS ZERO.
;
; BINARY INTEGER REPRESENTATION:
; 32 BIT 2'S-COMPLEMENT SIGNED INTEGER
; "EXPONENT" BYTE = 0 (WHEN PRESENT)
;
; NORMAL REGISTER ALLOCATION: MANTISSA - HLH'L'
; EXPONENT - C
;
;
; Table of addresses for functions
;
FUNTOK: EQU 8DH ; First token number
;
FUNTBL: DW DECODE ; Line number
DW OPENIN ; OPENIN
DW PTR ; PTR
DW PAGEV ; PAGE
DW TIMEV ; TIME
DW LOMEMV ; LOMEM
DW HIMEMV ; HIMEM
DW ABSV ; ABS
DW ACS ; ACS
DW ADVAL ; ADVAL
DW ASC ; ASC
DW ASN ; ASN
DW ATN ; ATN
DW BGET ; BGET
DW COS ; COS
DW COUNTV ; COUNT
DW DEG ; DEG
DW ERLV ; ERL
DW ERRV ; ERR
DW EVAL_ ; EVAL
DW EXP ; EXP
DW EXT ; EXT
DW ZERO ; FALSE
DW FN ; FN
DW GET ; GET
DW INKEY ; INKEY
DW INSTR ; INSTR(
DW INT_ ; INT
DW LEN ; LEN
DW LN ; LN
DW LOG ; LOG
DW NOTK ; NOT
DW OPENUP ; OPENUP
DW OPENOT ; OPENOUT
DW PI ; PI
DW POINT ; POINT(
DW POS ; POS
DW RAD ; RAD
DW RND ; RND
DW SGN ; SGN
DW SIN ; SIN
DW SQR ; SQR
DW TAN ; TAN
DW TOPV ; TO(P)
DW TRUE ; TRUE
DW USR ; USR
DW VAL ; VAL
DW VPOS ; VPOS
DW CHRS ; CHRS
DW GETS ; GETS
DW INKEYS ; INKEYS
DW LEFTS ; LEFTS(
DW MIDS ; MIDS(
DW RIGHTS ; RIGHTS(
DW STRS ; STR$
DW STRING_ ; STRINGS(
DW EOF ; EOF
;
FUNTBL_END: EQU $
TCMD: EQU FUNTOK+(FUNTBL_END-FUNTBL)/2
;
ANDK: EQU 80H
DIVK: EQU 81H
EORK: EQU 82H
MODK: EQU 83H
ORK: EQU 84H
;
SOPTBL: DW SLE ; <= (STRING)
DW SNE ; <>
DW SGE ; >=
DW SLT ; <
DW SEQ ; =
DW SGT ; >
;
; EXPR - VARIABLE-TYPE EXPRESSION EVALUATION
; Expression type is returned in A'F':
; Numeric - A' bit 7=0, F' sign bit cleared.
; String - A' bit 7=1, F' sign bit set.
; Floating-point or integer result returned in HLH'L'C
; Integer result denoted by C=0 and HLH'L' non-zero.
; String result returned in string accumulator, DE set.
;
; Hierarchy is: (1) Variables, functions, constants, bracketed expressions.
; (2) ^
; (3) * / MOD DIV
; (4) + -
; (5) = <> <= >= > <
; (6) AND
; (7) EOR OR
;
; Level 7: EOR and OR
;
EXPR: CALL EXPR1 ; Get first operator by calling Level 6
EXPR0A: CP EORK ; Is operator EOR?
JR Z,EXPR0B ; Yes, so skip to next bit
CP ORK ; Is operator OR
RET NZ ; No, so return
;
EXPR0B: CALL SAVE ; Save first operand
CALL EXPR1 ; Get second operand
CALL DOIT ; Do the operation
JR EXPR0A ; And continue
;
; Level 6: AND
;
EXPR1: CALL EXPR2 ; Get first operator by calling Level 5
EXPR1A: CP ANDK ; Is operator AND?
RET NZ ; No, so return
CALL SAVE ; Save first operand
CALL EXPR2 ; Get second operand
CALL DOIT ; Do the operation
JR EXPR1A ; And continue
;
; Level 5: Comparisons
;
EXPR2: CALL EXPR3 ; Get first operator by calling Level 4
CALL RELOP? ; Is it ">", "=" or "<"?
RET NZ ; No, so return
LD B,A ; Store the first operator in B
INC IY ; Bump over operator
CALL NXT ;
CALL RELOP? ; Is it a compound operator?
JR NZ,EXPR2B ; No, so skip next bit
INC IY ; Bump over operator
CP B ; Compare with first
JP Z,SYNTAX ; Trap illegal combinations ">>", "==", "<<" (but not "><", "=>", "=<")
ADD A,B
LD B,A ; B: Unique code for the compound operator
EXPR2B: LD A,B ; A: Code for the operator/compound operator
EX AF,AF'
JP M,EXPR2S ; If it is a string, then branch here to handle it
EX AF,AF'
SUB 4
CP '>'-4
JR NZ,EXPR2C
ADD A,2
EXPR2C: CALL SAVE1
CALL EXPR3
CALL DOIT ; NB: Must NOT be "JP DOIT"
RET
;
EXPR2S: EX AF,AF' ; Handle string comparisons
DEC A
AND 7
CALL PUSHS ; Save string on the stack
PUSH AF ; Save the operator
CALL EXPR3 ; Get the second string
EX AF,AF'
JP P,TYPE_
POP AF
LD C,E ; Length of string #2
POP DE
LD HL,0
ADD HL,SP
LD B,E ; Length of string #1
PUSH DE
LD DE,ACCS
EX DE,HL
CALL DISPT2
POP DE
EX DE,HL
LD H,0
ADD HL,SP
LD SP,HL
EX DE,HL
XOR A ; Numeric marker
LD C,A ; Integer marker
EX AF,AF'
LD A,(IY)
RET
;
; Level 4: + and -
;
EXPR3: CALL EXPR4 ; Get first operator by calling Level 3
EXPR3A: CP '-' ; Is it "-"?
JR Z,EXPR3B ; Yes, so skip the next bit
CP '+' ; Is it "+"?
RET NZ ; No, so return
EX AF,AF' ; Get the type
JP M,EXPR3S ; Branch here if string
EX AF,AF'
EXPR3B: CALL SAVE ; Save the first operator
CALL EXPR4 ; Fetch the second operator
CALL DOIT ; Do the operation
JR EXPR3A ; And continue
;
EXPR3S: EX AF,AF' ; Handle string concatenation
INC IY ; Bump past the "+"
CALL PUSHS ; Save the string on the stack
CALL EXPR4 ; Fetch the second operator
EX AF,AF'
JP P,TYPE_ ; If it is not a string, then Error: "Type mismatch"
LD C,E ; C: String length
POP DE
PUSH DE
LD HL,ACCS
LD D,H
LD A,C
OR A
JR Z,EXP3S3
LD B,L
LD L,A ; Source
ADD A,E
LD E,A ; Destination
LD A,19
JP C,ERROR_ ; A carry indicates string > 255 bytes, so Error: "String too long"
PUSH DE
DEC E
DEC L
LDDR ; Copy
POP DE
EXP3S3: EXX
POP BC
CALL POPS ; Restore from stack
EXX
OR 80H ; Flag as a string
EX AF,AF'
LD A,(IY) ; Fetch the next character
JR EXPR3A ; And continue
;
; Level 3: * / MOD DIV
;
EXPR4: CALL EXPR5 ; Get first operator by calling Level 2
EXPR4A: CP '*' ; "*" is valid
JR Z,EXPR4B
CP '/' ; "/" is valid
JR Z,EXPR4B
CP MODK ; MOD token is valid
JR Z,EXPR4B
CP DIVK ; DIV token is valid
RET NZ ; And return if it is anything else
EXPR4B: CALL SAVE
CALL EXPR5
CALL DOIT
JR EXPR4A
;
; Level 2: ^
;
EXPR5: CALL ITEM ; Get variable
OR A ; Test type
EX AF,AF' ; Save type
EXPR5A: CALL NXT ; Skip spaces
CP '^' ; Is the operator "^"?
RET NZ ; No, so return
CALL SAVE ; Save first operand
CALL ITEM ; Get second operand
OR A ; Test type
EX AF,AF' ; Save type
CALL DOIT ; Do the operation
JR EXPR5A ; And continue
;
; Evaluate a numeric expression
;
EXPRN: CALL EXPR ; Evaluate expression
EX AF,AF' ; Get the type
RET P ; And return if it is a number
JR TYPE_ ; Otherwise Error: "Type mismatch"
;
; Evaluate a fixed-point expression
;
EXPRI: CALL EXPR ; Evaluate the expression
EX AF,AF' ; Get the type
JP P,SFIX ; If it is numeric, then convert to fixed-point notation
JR TYPE_ ; Otherwise Error: "Type mismatch"
;
; Evaluate a string expression
;
EXPRS: CALL EXPR ; Evaluate the expression
EX AF,AF' ; Get the type
RET M ; And return if it is a string
JR TYPE_ ; Otherwise Error: "Type mismatch"
;
; Get a numeric variable
;
ITEMN: CALL ITEM ; Get the variable
OR A ; Test the type
RET P ; And return if it is a number
JR TYPE_ ; Otherwise Error: "Type mismatch"
;
; Get a fixed-point variable
;
ITEMI: CALL ITEM ; Get the variable
OR A ; Test the type
JP P,SFIX ; If it is numeric, then convert to fixed-point notation
JR TYPE_ ; Otherwise Error: "Type mismatch"
;
; Get a string variable
;
ITEMS: CALL ITEM ; Get the variable
OR A ; Test the type
RET M ; If it is a string, then return
; ; Otherwise
TYPE_: LD A,6 ; Error: "Type mismatch"
JP ERROR_
;
; Evaluate a bracketed expression
;
ITEM1: CALL EXPR ; Evaluate the expression
CALL BRAKET ; Check for closing bracket
EX AF,AF'
RET
;
; HEX - Get hexadecimal constant.
; Inputs: ASCII string at (IY)
; Outputs: Integer result in H'L'HL, C=0, A7=0.
; IY updated (points to delimiter)
;
HEX: CALL ZERO ; Set result to 0
CALL HEXDIG ; Fetch the character from IY
JR C,BADHEX ; If invalid HEX character, then Error: "Bad HEX"
HEX1: INC IY ; Move pointer to next character
AND 0FH ; Clear the top nibble
LD B,4 ; Loop counter
;
HEX2: EXX ; Shift the result left B (4) times. This makes
ADD HL,HL ; space for the incoming nibble in the least significant 4 bits
EXX ; .
ADC HL,HL ; .
DJNZ HEX2 ; And loop
EXX
OR L ; OR in the digit
LD L,A
EXX
;
CALL HEXDIG ; Fetch the next character
JR NC,HEX1 ; If it is a HEX digit then loop
XOR A ; Clear A
RET
;
BADHEX: LD A,28
JP ERROR_ ; Error: "Bad HEX"
;
; MINUS - Unary minus.
; Inputs: IY = text pointer
; Outputs: Numeric result, same type as argument.
; Result in H'L'HLC
;
MINUS: CALL ITEMN ; Get the numeric argument
MINUS0: DEC C ; Check exponent (C)
INC C ; If it is zero, then it's either a FP zero or an integer
JR Z,NEGATE ; So do an integer negation
;
LD A,H ; Do a FP negation by
XOR 80H ; Toggling the sign bit (H)
LD H,A
XOR A ; Numeric marker
RET
;
NEGATE: EXX ; This section does a two's complement negation on H'L'HLC
LD A,H ; First do a one's complement by negating all the bytes
CPL
LD H,A
LD A,L
CPL
LD L,A
EXX
LD A,H
CPL
LD H,A
LD A,L
CPL
LD L,A
ADD1: EXX ; Then add 1
INC HL
LD A,H
OR L
EXX
LD A,0 ; Numeric marker
RET NZ
INC HL
RET
;
; ITEM - VARIABLE TYPE NUMERIC OR STRING ITEM.
; Item type is returned in A: Bit 7=0 numeric.
; Bit 7=1 string.
; Numeric item returned in HLH'L'C.
; String item returned in string accumulator,
; DE addresses byte after last (E=length).
;
ITEM: CALL CHECK ; Check there's at least a page of free memory left and Error: "No room" if not
CALL NXT ; Skip spaces
INC IY ; Move to the prefix character
CP '&' ; If `&`
JR Z,HEX ; Then get a HEX constant
CP '-' ; If `-`
JR Z,MINUS ; Then get a negative number
CP '+' ; If `+`
JR Z,ITEMN ; Then just fetch the number (unary plus)
CP '(' ; If `(`
JR Z,ITEM1 ; Start of a bracketed expression
CP 34 ; If `"`
JR Z,CONS ; Start of a string constant
CP TCMD ; Is it out of range of the function table?
JP NC,SYNTAX ; Error: "Syntax Error"
CP FUNTOK ; If it is in range, then
JP NC,DISPAT ; It's a function
DEC IY
CP ':'
JR NC,ITEM2 ;VARIABLE?
CP '0'
JR NC,CON ;NUMERIC CONSTANT
CP '.'
JR Z,CON ;NUMERIC CONSTANT
ITEM2: CALL GETVAR ;VARIABLE
JR NZ,NOSUCH
OR A
JP M,LOADS ;STRING VARIABLE
LOADN: OR A
JR Z,LOAD1 ;BYTE VARIABLE
LD C,0
BIT 0,A
JR Z,LOAD4 ;INTEGER VARIABLE
LOAD5: LD C,(IX+4)
LOAD4: EXX
LD L,(IX+0)
LD H,(IX+1)
EXX
LD L,(IX+2)
LD H,(IX+3)
RET
;
LOAD1: LD HL,0
EXX
LD H,0
LD L,(IX+0)
EXX
LD C,H
RET
;
NOSUCH: JP C,SYNTAX
LD A,(LISTON)
BIT 5,A
LD A,26
JR NZ,ERROR0 ;"No such variable"
NOS1: INC IY
CALL RANGE
JR NC,NOS1
LD IX,PC
XOR A
LD C,A
JR LOAD4
;
;CONS - Get string constant from ASCII string.
; Inputs: ASCII string at (IY)
; Outputs: Result in string accumulator.
; D = MS byte of ACCS, E = string length
; A7 = 1 (string marker)
; IY updated
;
CONS: LD DE,ACCS ; DE: Pointer to the string accumulator
CONS3: LD A,(IY) ; Fetch the first character and
INC IY ; Increment the pointer
CP '"' ; Check for start quote
JR Z,CONS2 ; Yes, so jump to the bit that parses the string
;
CONS1: LD (DE),A ; Store the character in the string accumulator
INC E ; Increment the string accumulator pointer
CP CR ; Is it CR
JR NZ,CONS3 ; No, so keep looping
;
LD A,9
ERROR0: JP ERROR_ ; Throw error "Missing '"'
;
CONS2: LD A,(IY) ; Fetch the next character
CP '"' ; Check for end quote?
INC IY ; Increment the pointer
JR Z,CONS1 ; It is the end of string marker so jump to the end routine
DEC IY ;
LD A,80H ; String marker
RET
;
;CON - Get unsigned numeric constant from ASCII string.
; Inputs: ASCII string at (IY).
; Outputs: Variable-type result in HLH'L'C
; IY updated (points to delimiter)
; A7 = 0 (numeric marker)
;
CON: PUSH IY
POP IX
LD A,36
CALL FPP
JR C,ERROR0
PUSH IX
POP IY
XOR A
RET
;
DLOAD5: LD B,(IX+4)
EXX
LD E,(IX+0)
LD D,(IX+1)
EXX
LD E,(IX+2)
LD D,(IX+3)
RET
;
LOADS: LD DE,ACCS
RRA
JR NC,LOADS2 ;FIXED STRING
CALL LOAD4
EXX
LD A,L
EXX
OR A
LD C,A
LD A,80H ;STRING MARKER
RET Z
LD B,0
LDIR
RET
LOADS2: LD A,(HL)
LD (DE),A
INC HL
CP CR
LD A,80H ;STRING MARKER
RET Z
INC E
JR NZ,LOADS2
RET ;RETURN NULL STRING
;
;VARIABLE-TYPE FUNCTIONS:
;
;Result returned in HLH'L'C (floating point)
;Result returned in HLH'L' (C=0) (integer)
;Result returned in string accumulator & DE (string)
;All registers destroyed.
;IY (text pointer) updated.
;Bit 7 of A indicates type: 0 = numeric, 1 = string.
;
;
;POS - horizontal cursor position.
;VPOS - vertical cursor position.
;EOF - return status of file.
;BGET - read byte from file.
;INKEY - as GET but wait only n centiseconds.
;GET - wait for keypress and return ASCII value.
;GET(n) - input from Z80 port n.
;ASC - ASCII value of string.
;LEN - length of string.
;LOMEM - location of dynamic variables.
;HIMEM - top of available RAM.
;PAGE - start of current text page.
;TOP - address of first free byte after program.
;ERL - line number where last error occurred.
;ERR - number of last error.
;COUNT - number of printing characters since CR.
;Results are integer numeric.
;
POS: CALL GETCSR
EX DE,HL
JR COUNT1
VPOS: CALL GETCSR
JR COUNT1
EOF: CALL CHANEL
CALL OSSTAT
JP Z,TRUE
JP ZERO
BGET: CALL CHANEL ; Channel number
CALL OSBGET
LD L,A
JR COUNT0
INKEY: CALL ITEMI ; Get the argument
BIT 7, H ; Check the sign
EXX ; HL: The argument
JP NZ, INKEYM ; It's negative, so do INKEY(-n)
CALL INKEY0 ; Do INKEY(n)
JR ASC0 ; Return a numeric value
GET: CALL NXT
CP '('
JP Z, GETPORT ; New code in patch.z80
GET0: CALL GETS
JR ASC1
ASC: CALL ITEMS
ASC0: XOR A
CP E
JP Z,TRUE ; Null string
ASC1: LD HL,(ACCS)
JR COUNT0
LEN: CALL ITEMS
EX DE,HL
JR COUNT0
LOMEMV: LD HL,(LOMEM)
JR COUNT1
HIMEMV: LD HL,(HIMEM)
JR COUNT1
PAGEV: LD HL,(PAGE_)
JR COUNT1
TOPV: LD A,(IY)
INC IY ; SKIP "P"
CP 'P'
JP NZ,SYNTAX ; Throw "Syntax Error"
LD HL,(TOP)
JR COUNT1
ERLV: LD HL,(ERL)
JR COUNT1
ERRV: LD HL,(ERR)
JR COUNT0
COUNTV: LD HL,(COUNT)
COUNT0: LD H,0
COUNT1: EXX
XOR A
LD C,A ; Integer marker
LD H,A
LD L,A
RET
;
;OPENIN - Open a file for reading.
;OPENOUT - Open a file for writing.
;OPENUP - Open a file for reading or writing.
;Result is integer channel number (0 if error)
;
OPENOT: XOR A
DB 21H ;SKIP NEXT 2 BYTES
OPENUP: LD A,2
DB 21H ;SKIP NEXT 2 BYTES
OPENIN: LD A,1
PUSH AF ;SAVE OPEN TYPE
CALL ITEMS ;FILENAME
LD A,CR
LD (DE),A
POP AF ;RESTORE OPEN TYPE
ADD A,-1 ;AFFECT FLAGS
LD HL,ACCS
CALL OSOPEN
LD L,A
JR COUNT0
;
;EXT - Return length of file.
;PTR - Return current file pointer.
;Results are integer numeric.
;
EXT: CALL CHANEL
CALL GETEXT
JR TIME0
;
PTR: CALL CHANEL
CALL GETPTR
JR TIME0
;
;TIME - Return current value of elapsed time.
;Result is integer numeric.
;
TIMEV: LD A,(IY)
CP '$'
JR Z,TIMEVS
CALL GETIME
TIME0: PUSH DE
EXX
POP HL
XOR A
LD C,A
RET
;
;TIME$ - Return date/time string.
;Result is string
;
TIMEVS: INC IY ;SKIP $
CALL GETIMS
LD A,80H ;MARK STRING
RET
;
;String comparison:
;
SLT: CALL SCP
RET NC
JR TRUE
;
SGT: CALL SCP
RET Z
RET C
JR TRUE
;
SGE: CALL SCP
RET C
JR TRUE
;
SLE: CALL SCP
JR Z,TRUE
RET NC
JR TRUE
;
SNE: CALL SCP
RET Z
JR TRUE
;
SEQ: CALL SCP
RET NZ
TRUE: LD A,-1
EXX
LD H,A
LD L,A
EXX
LD H,A
LD L,A
INC A
LD C,A
RET
;
;PI - Return PI (3.141592654)
;Result is floating-point numeric.
;
PI: LD A,35
JR FPP1
;
;ABS - Absolute value
;Result is numeric, variable type.
;
ABSV: LD A,16
JR FPPN
;
;NOT - Complement integer.
;Result is integer numeric.
;
NOTK: LD A,26
JR FPPN
;
;DEG - Convert radians to degrees
;Result is floating-point numeric.
;
DEG: LD A,21
JR FPPN
;
;RAD - Convert degrees to radians
;Result is floating-point numeric.
;
RAD: LD A,27
JR FPPN
;
;SGN - Return -1, 0 or +1
;Result is integer numeric.
;
SGN: LD A,28
JR FPPN
;
;INT - Floor function
;Result is integer numeric.
;
INT_: LD A,23
JR FPPN
;
;SQR - square root
;Result is floating-point numeric.
;
SQR: LD A,30
JR FPPN
;
;TAN - Tangent function
;Result is floating-point numeric.
;
TAN: LD A,31
JR FPPN
;
;COS - Cosine function
;Result is floating-point numeric.
;
COS: LD A,20
JR FPPN
;
;SIN - Sine function
;Result is floating-point numeric.
;
SIN: LD A,29
JR FPPN
;
;EXP - Exponential function
;Result is floating-point numeric.
;
EXP: LD A,22
JR FPPN
;
;LN - Natural log.
;Result is floating-point numeric.
;
LN: LD A,24
JR FPPN
;
;LOG - base-10 logarithm.
;Result is floating-point numeric.
;
LOG: LD A,25
JR FPPN
;
;ASN - Arc-sine
;Result is floating-point numeric.
;
ASN: LD A,18
JR FPPN
;
;ATN - arc-tangent
;Result is floating-point numeric.
;
ATN: LD A,19
JR FPPN
;
;ACS - arc-cosine
;Result is floating point numeric.
;
ACS: LD A,17
FPPN: PUSH AF
CALL ITEMN
POP AF
FPP1: CALL FPP
JP C,ERROR_
XOR A
RET
;
;SFIX - Convert to fixed-point notation
;
SFIX: LD A,38
JR FPP1
;
;SFLOAT - Convert to floating-point notation
;
SFLOAT: LD A,39
JR FPP1
;
;VAL - Return numeric value of string.
;Result is variable type numeric.
;
VAL: CALL ITEMS
VAL0: XOR A
LD (DE),A
LD IX,ACCS
LD A,36
JR FPP1
;
;EVAL - Pass string to expression evaluator.
;Result is variable type (numeric or string).
;
EVAL_: CALL ITEMS
LD A,CR
LD (DE),A
PUSH IY
LD DE,ACCS
LD IY,ACCS
LD C,0
CALL LEXAN2 ;TOKENISE
LD (DE),A
INC DE
XOR A
CALL PUSHS ;PUT ON STACK
LD IY,2
ADD IY,SP
CALL EXPR
POP IY
ADD IY,SP
LD SP,IY ;ADJUST STACK POINTER
POP IY
EX AF,AF'
RET
;
;RND - Random number function.
; RND gives random integer 0-&FFFFFFFF
; RND(-n) seeds random number & returns -n.
; RND(0) returns last value in RND(1) form.
; RND(1) returns floating-point 0-0.99999999.
; RND(n) returns random integer 1-n.
;
RND: LD IX,RANDOM
CALL NXT
CP '('
JR Z,RND5 ;ARGUMENT FOLLOWS
CALL LOAD5
RND1: RR C
LD B,32
RND2: EXX ;CALCULATE NEXT
ADC HL,HL
EXX
ADC HL,HL
BIT 3,L
JR Z,RND3
CCF
RND3: DJNZ RND2
RND4: RL C ;SAVE CARRY
CALL STORE5 ;STORE NEW NUMBER
XOR A
LD C,A
RET
RND5: CALL ITEMI
LD IX,RANDOM
BIT 7,H ;NEGATIVE?
SCF
JR NZ,RND4 ;SEED
CALL TEST
PUSH AF
CALL SWAP
EXX
CALL LOAD5
CALL NZ,RND1 ;NEXT IF NON-ZERO